C $STORAGE:2 C C C ******************************************************* C * * C * The following Subroutines are used for the * C * Standard Headers for all ROCKSOFT programs * C * * C ******************************************************* C C SUBROUTINE MHEAD(PGM,AUTHOR,YEAR,REV,DATE) C C This routine prints the copyright header C IMPLICIT INTEGER (A-Z) CHARACTER PGM*21,AUTHOR*21,TITLE*40,RELOC*11 CHARACTER RAMDSK*80,TYPE*6,ONE*1,TWO*1,DATE*8,REV*2,YEAR*4 LOGICAL*2 CHECK C C DRAW TWO BOXES ON SCREEN C HEIGHT=5 WIDTH=80 HORZ=1 VERT=2 TITLE=' ' TLEN=0 TATTR=0 BATTR=0 CALL CLS CALL BOLD CALL BOX(HEIGHT,WIDTH,HORZ,VERT,TITLE,TLEN,TATTR,BATTR) VERT=16 HEIGHT=8 CALL BOLD CALL BOX(HEIGHT,WIDTH,HORZ,VERT,TITLE,TLEN,TATTR,BATTR) C C NOW, START OUT WITH THE MAJOR HEADING C CALL UPTOP(4,4) WRITE(*,'(23X,A28,\)') 'DEC Rainbow 100 Software by:' C C SECOND, DRAW THE ROCKSOFT LOGO C CALL UPTOP(4,10) CALL BOLD CALL DHTOP WRITE(*,100) 100 FORMAT(12X,'* ROCKSOFT *',\) CALL UPTOP(4,11) CALL BOLD CALL DHBOT WRITE(*,100) CALL OFF C C NOW PRINT OTHER ASSORTED GOODIES C CALL UPTOP(4,13) WRITE(*,'(28X,A13,A4,\)') 'Copyright (c)',YEAR C WRITE(RAMDSK,'(A21,A7,A2)') PGM,', Ver. ',REV CALL SQUISH(RAMDSK,30) TYPE='LEFT ' CALL JUSTIF(TYPE,RAMDSK,30) CALL UPTOP(4,18) CALL BOLD WRITE(*,'(9X,A9,\)') 'Program: ' CALL OFF WRITE(*,'(A30,\)') RAMDSK C CALL UPTOP(4,19) CALL BOLD WRITE(*,'(9X,A9,\)') 'Author : ' CALL OFF WRITE(*,'(A21,\)') AUTHOR C C CHECK FOR DATE FILE IN THE MEMORY DRIVE C CALL BLINK CALL BOLD INQUIRE(FILE='F:TODAY.DAT',EXIST=CHECK) IF(CHECK.EQV..TRUE.) THEN OPEN(UNIT=5,FILE='F:TODAY.DAT') READ(5,'(A8)') DATE CLOSE(5) CALL UPTOP(4,21) WRITE(*,200) 200 FORMAT(9X,'Please Press to Begin Execution ',\) READ(*,'(A1)') ONE ELSE 300 CONTINUE CALL UPTOP(4,21) WRITE(*,350) 350 FORMAT(9X,'Please Enter TODAY"S Date (MM/DD/YY): [ / / ]',\) CALL CURLT(10) READ(*,'(A8,\)',ERR=300) DATE WRITE(RAMDSK,'(A8)') DATE READ(RAMDSK,375,ERR=300) IMON,ONE,IDAY,TWO,IYEAR 375 FORMAT(I2,A1,I2,A1,I2) C C CHECK IF DATE ENTERED MAKES SENSE C IF((ONE.NE.'/') .OR. (TWO.NE.'/') .OR. A (IMON.LE.0) .OR. (IMON.GT.12) .OR. B (IDAY.LE.0) .OR. (IDAY.GT.32) .OR. C (IYEAR.LE.80) .OR. (IYEAR.GT.99)) THEN CALL UPTOP (4,22) WRITE(*,'(9X,A32,\)') 'Invalid DATE Entered - Try Again' CALL BELL GOTO 300 ENDIF ENDIF C C THATS ALL FOR NOW FOLKS C 900 CONTINUE CALL OFF CALL CLS RETURN END C C C SUBROUTINE TOP(PGM,DATE) C C This Routine displays the STANDARD Screen Header C CHARACTER PGM*21,DATE*8,TODAY*28,RELOC*11 C C CONVERT DATE, THEN PRINT HEADER C CALL CLS CALL DATETD(DATE,TODAY) CALL BOLD CALL DHTOP CALL LOCATE(1,1,RELOC) WRITE(*,'(A11,A21)') RELOC,PGM CALL DHBOT CALL LOCATE(1,2,RELOC) WRITE(*,'(A11,A21)') RELOC,PGM CALL OFF C C PRINT TODAYS DATE C CALL LOCATE(53,3,RELOC) WRITE(*,'(A11,A28)') RELOC,TODAY C C DRAW A SOLID LINE C CALL BOLD CALL ULINE CALL LOCATE(1,4,RELOC) WRITE(*,'(A11,80X)') RELOC CALL OFF RETURN END C C C SUBROUTINE HEADER(OPTION) C C This Routine Displays the OPTION under the Header (TOP) C CHARACTER OPTION*25,RELOC*11 C CALL LOCATE(1,3,RELOC) WRITE(*,'(A11,A9,\)') RELOC,'Option : ' CALL BOLD CALL BLINK WRITE(*,'(A25,\)') OPTION CALL OFF CALL MOVEIT(1,5) RETURN END C C C SUBROUTINE PHEAD(PAGE,UNIT,PGM,DATE,YEAR,REV) C C This Rouitne prints the STANDARD Printer Header C INTEGER PAGE,UNIT CHARACTER PGM*21,DATE*8,YEAR*4,REV*2 CHARACTER TYPE*6,STRING*80,TODAY*28 C C CONVERT DATE TO ALPHA, CENTER PROGRAM NAME C CALL DATETD(DATE,TODAY) TYPE='CENTER' STRING=PGM CALL JUSTIF(TYPE,STRING,21) C C INCREMENT PAGE COUNTER, START DRAWING HEADER C PAGE=PAGE+1 WRITE(UNIT,100) PAGE 100 FORMAT(1H1,/,2X,'DEC Rainbow 100 Software',45X,'Page ',I2) WRITE(UNIT,200) REV,YEAR,TODAY 200 FORMAT(2X,'Ver. ',A2,', (c) ',A4,' by Rocksoft',19X,A28) C C PRINT THE PROGRAM NAME FOR REFERENCE C WRITE(UNIT,300) 300 FORMAT(1X,'*',76('-'),'*') WRITE(UNIT,'(29X,A21)') STRING WRITE(UNIT,300) C C THAT ALL FOR NOW FOLKS C RETURN END