home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / AD.ZIP / ADPRTC.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  6.2 KB  |  136 lines
  1. 10  ON ERROR GOTO 3940
  2. 30  GOTO 480
  3. 70  CLS:COLOR 3,0,1:LOCATE  12,30:PRINT "QUIT?  <Y>es or <N>o?":COLOR 14,0:LOCATE 12,38:PRINT "Y":LOCATE 12,47:PRINT "N":COLOR 3,0:GOSUB 35000
  4. 80  Y$=INKEY$:IF Y$="" THEN 80
  5. 90  IF Y$="n" OR Y$="N" THEN RUN"adprt"
  6. 100  IF Y$="y" OR Y$="Y" THEN 110 ELSE 70
  7. 110  CLS:LOCATE 12,30:PRINT "GOODBYE":SYSTEM
  8. 120  REM
  9. 130  REM              PRINT
  10. 140  GOSUB 6000
  11. 200  RUN"adprt
  12. 480  GOSUB 3000:GOSUB 6000:CLS:GOSUB 1020
  13. 490  X3$="FILE = ":X4$=SPACE$(12):X5$="FUNCTION = ":X1$="PRINT "
  14. 500  X2$=" - COMPLETE FILE":LOCATE 25,10:COLOR 1,7,1:PRINT X3$;FILE$;X4$;X5$;X1$;X2$;:COLOR 3,0
  15. 515  LOCATE 20,40:PRINT SPACE$(39):LOCATE 21,40:PRINT SPACE$(39):LOCATE 22,40:PRINT SPACE$(20):LOCATE 23,40:PRINT SPACE$(20)
  16. 520  GOSUB 2400
  17. 540  GOSUB 1950
  18. 550  MP1=LP1*6-9:K=1
  19. 560  GET #4,NN+1:I=VAL(V$(16)):IK=0
  20. 565  M1=10:M2=36:M3=39:M4=39:M5=40
  21. 570  FOR L=1 TO 2
  22. 575  IF IK=NN THEN IK=NN+1:GOTO 700 ELSE IK=IK+1
  23. 580  GET #4,I
  24. 582  FOR J= 1 TO 7 :A(J,L)=VAL(V$(J)):NEXT
  25. 584  A(8,L)=VAL(V$(13)):A(9,L)=VAL(V$(12)):A2=A(2,L)
  26. 586  W$(6,L)=MID$(V$(5),5,A(5,L))+", "+MID$(V$(6),5,A(6,L))+"  "+MID$(V$(7),5,A(7,L))
  27. 588  A2=A(2,L):IF T$="N" THEN A9=M3-A(2,L):GOTO 590 ELSE A9=M3-A(8,L)-A(2,L)
  28. 590  IF A9=>A(1,L) THEN 598
  29. 592  A1=INSTR(1,MID$(V$(1),5,A(1,L))," "):IF A1<=0 THEN A$=MID$(V$(1),5,1)+".":A(1,L)=2:GOTO 600
  30. 594  IF A1<A9 THEN A$=MID$(V$(1),5,A1-1):A(1,L)=A1-1:GOTO 600
  31. 596  IF (A1<A(1,L) AND A1<A9) THEN A$=MID$(V$(1),5,1)+". "+MID$(V$(1),6+A1,1)+".":A(1,L)=5:GOTO 600:ELSE A$=MID$(V$(1),5,1)+".":A(1,L)=2:GOTO 600
  32. 598  A$=MID$(V$(1),5,A(1,L))
  33. 600  A(5,L)=M2-A(5,L)-A(6,L)-A(7,L):IF T$="N" THEN W$(1,L)=A$+" "+MID$(V$(2),5,A(2,L)):GOTO 606
  34. 602  W$(1,L)=MID$(V$(13),5,A(8,L))+A$+" "+MID$(V$(2),5,A(2,L))
  35. 606  IF A(9,L) = 0 AND A(3,L)=0 THEN W$(2,L)=MID$(V$(4),5,M3):W$(4,L)="":W$(5,L)="":W$(3,L)=W$(6,L):A(2,L)=M1:A(3,L)=A(5,L):A(4,L)=M5:A(5,L)=M5:GOTO 624
  36. 608  IF A(9,L) = 0 AND A(3,L)<>0 THEN 610 ELSE 612
  37. 610  W$(2,L)=MID$(V$(3),5,M3):W$(3,L)=MID$(V$(4),5,M3):W$(4,L)=W$(6,L):W$(5,L)="":A(2,L)=M1:A(3,L)=A(2,L):A(4,L)=A(5,L):A(5,L)=M5:GOTO 624
  38. 612  IF A(9,L) <> 0 AND A(3,L)<>0 THEN 614 ELSE 620
  39. 614  W$(2,L)=MID$(V$(12),5,M3):W$(3,L)=MID$(V$(3),5,M3):W$(4,L)=MID$(V$(4),5,M3):A(2,L)=M1:W$(5,L)=W$(6,L):A(3,L)=M1:A(4,L)=M1:GOTO 624
  40. 620  IF A(9,L) <>0 AND A(3,L)=0 THEN 622 ELSE 624
  41. 622  W$(2,L)=MID$(V$(12),5,M3):W$(3,L)=MID$(V$(4),5,M3):W$(4,L)=W$(6,L):W$(5,L)="":A(2,L)=M1:A(3,L)=A(2,L):A(4,L)=A(5,L):A(5,L)=M5:GOTO 624
  42. 624  IF T$="N" THEN A(1,L)=M4-A(1,L)-A2 ELSE A(1,L)=M4-A(1,L)-A2-A(8,L)
  43. 630  W$(10,L)=MID$(V$(10),5,12):W$(11,L)=MID$(V$(11),5,12):A(10,L)=16:A(11,L)=16
  44. 635  W$(8,L)=MID$(V$(8),5,VAL(V$(8))):A(8,L)=VAL(V$(8))
  45. 640  I=VAL(V$(14)):NEXT
  46. 700  IF MP<MP1-3 THEN 750 ELSE K=K+1
  47. 710  IF LP$="N" OR LP$="n" THEN 740 ELSE PRINT "Advance paper and hit any key to continue";:GOSUB 35010
  48. 720  Y$=INKEY$:IF Y$="" THEN 720 ELSE LOCATE 24,1:PRINT SPACE$(50);
  49. 730  PRINT #5,  TAB(35);"-";K;" -":PRINT #5, :PRINT #5,  :MP=6:GOTO 750
  50. 740  PRINT #5, CHR$(12):PRINT #5, :PRINT #5,  TAB(35);"- ";K;" -":PRINT #5, :PRINT #5, :MP=5
  51. 750  IF IK=NN+1 THEN 960
  52. 770  FOR J=1 TO 3:PRINT #5,  TAB(4);W$(J,1);SPACE$(A(J,1));W$(J,2):NEXT
  53. 775  IF W$(4,1)="" AND W$(4,2)="" THEN 780 ELSE PRINT #5,  TAB(4);W$(4,1);SPACE$(A(4,1));W$(4,2):MP=MP+1
  54. 780  IF W$(5,1)="" AND W$(5,2)="" THEN 820 ELSE PRINT #5,  TAB(4);W$(5,1);SPACE$(A(5,1));W$(5,2):MP=MP+1
  55. 820  PRINT #5,  TAB(4);"* TELEPHONE ";SPACE$(28);"* TELEPHONE"
  56. 830  PRINT #5,  TAB(9);"HOME:    ";W$(10,1);SPACE$(A(10,1));"   HOME:    ";W$(10,2)
  57. 840  PRINT #5,  TAB(9);"OFFICE:  ";W$(11,1);SPACE$(A(11,1));"   OFFICE:  ";W$(11,2)
  58. 850  MP=MP+8
  59. 860  IF A(8,1)=0 AND A(8,2)=0  THEN 870
  60. 865  IF A(8,1)=0 AND A(8,2)<>0 THEN PRINT #5, TAB(44);"* BIRTHDAY:  "W$(8,2):MP=MP+1:GOTO 870
  61. 866  IF A(8,1)<>=0 AND A(8,2)=0 THEN PRINT #5, TAB(4);"* BIRTHDAY:  "W$(8,1):MP=MP+1:GOTO 870
  62. 867  A(8,1)=27-A(8,1):PRINT #5,  TAB(4);"* BIRTHDAY:  ";W$(8,1);SPACE$(A(8,1));"* BIRTHDAY:  ";W$(8,2):MP=MP+1
  63. 870  PRINT #5, :PRINT #5,
  64. 875  Y$=INKEY$:IF Y$=CHR$(27) THEN GOSUB 2500
  65. 880  IF IK=>NN THEN 940
  66. 890  IF FRE(1)>1000 THEN 570
  67. 900  CHAIN "ADPRTC.BAS",920,ALL
  68. 920  GOSUB 6000
  69. 930  GOTO 570
  70. 940  CLOSE #4
  71. 950  RUN"adprt"
  72. 960  FOR J= 1 TO 5:PRINT #5,  TAB(4);W$(J,1):NEXT
  73. 990  PRINT #5,  TAB(6);"TELEPHONE ":PRINT #5,  TAB(9);"HOME:    ";W$(10,1):PRINT #5,  TAB(9);"OFFICE:  ";W$(11,1)
  74. 995  IF A(8,1)<>=0 THEN PRINT #5, TAB(4);"* BIRTHDAY:  "W$(8,1)
  75. 1000  PRINT #5,  :PRINT #5,
  76. 1010  RUN"adprt"
  77. 1020  LOCATE 12,15:COLOR 14,0:PRINT "Do you want to use the Title of Courtesy?"
  78. 1030  LOCATE 14,30:COLOR 3,0:PRINT "<Y>es or <N>o?":LOCATE 14,31:COLOR 14,0:PRINT "Y":LOCATE 14,40:PRINT "N":COLOR 3,0:GOSUB 35030
  79. 1040  T$=INKEY$:IF T$="" THEN 1040 ELSE T$=CHR$(ASC(T$) AND &HDF):RETURN
  80. 1950  REM
  81. 2110  PRINT #5, 
  82. 2120  PRINT #5,  SPACE$(TN);T1$
  83. 2130  B=VAL(LEFT$(DATE$,2))
  84. 2140  PRINT #5, :PRINT #5,  SPACE$(30);DQ$(B);" ";MID$(DATE$,4,2);", 19";RIGHT$(DATE$,2):PRINT #5, 
  85. 2150  PRINT #5, 
  86. 2160  MP =10
  87. 2170  RETURN
  88. 2400  COLOR 0,7:LOCATE 21,1:PRINT "TURN ON PRINTER AND HIT ANY KEY":COLOR 3,0:GOSUB 35010
  89. 2410  GOSUB 5000
  90. 2420  LOCATE 21,1:PRINT SPACE$(40):LOCATE 21,10:COLOR 16,7:PRINT "WORKING":COLOR 3,0
  91. 2430  LOCATE 23,1:COLOR 10,0:PRINT "Hit <Esc> to stop printing.":COLOR 3,0
  92. 2440  RETURN
  93. 2500  COLOR 10,0:LOCATE 21,1:PRINT "Hit any key to continue PRINTING":GOSUB 35010
  94. 2510  LOCATE 23,1:COLOR 10,0:PRINT "Hit KEY F6 - Return to Menu.":COLOR 3,0
  95. 2520  GOSUB 5000:GOSUB 2420:RETURN
  96. 3000  O5$=CHR$(218)+CHR$(196)+CHR$(191):O6$=CHR$(179)+" "+CHR$(179):O7$=CHR$(192)+CHR$(196)+CHR$(217)
  97. 3010  O$=CHR$(219):O2$=CHR$(221):O1$="F KEYS:"+O$+O$+"F1:MAIN menu"+O2$+"F2:PRINT-MAIL menu"+O2$+"F6:PRINT menu"+O2$+"F8:NAMES"+O2$+"F4:NOTES"
  98. 3020  DIM DQ$(12):FOR I= 1 TO 12:READ DQ$(I):NEXT
  99. 3030  DATA JANUARY, FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  100. 3040  WIDTH "LPT1:",82
  101. 3050  OPEN "TEMPOR.TEM" FOR INPUT AS #1
  102. 3055  INPUT #1, FILE$,FILM$,FIL$:CLOSE #1
  103. 3056  OPEN FILM$ FOR INPUT AS #2
  104. 3060  INPUT #2,Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$:CLOSE #2
  105. 3065  DIM V$(16),W$(13,2),A(13,2)
  106. 3070  IF PT$="I" THEN OPEN "LPT1:" FOR OUTPUT AS #5:GOTO 3090
  107. 3080  OPEN "LPT2:" FOR OUTPUT AS #5
  108. 3090  OPEN FILE$ AS #4 LEN = 356
  109. 3100  FIELD #4, 19 AS V$(1), 19 AS V$(2), 18 AS V$(13), 34 AS V$(12), 34 AS V$(3), 34 AS V$(4), 19 AS V$(5), 14 AS V$(6), 16 AS V$(7), 12 AS V$(8), 84 AS V$(9), 19 AS V$(10), 19 AS V$(11), 5 AS V$(14), 5 AS V$(15), 5 AS V$(16)
  110. 3120  FILN$=FIL$+".NTE"
  111. 3130  RETURN
  112. 3840  RUN"adprt.bas"
  113. 3940  IF ERR = 27 THEN CLS:LOCATE 25,10:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"PRINTER ERROR ":COLOR 7,1:LOCATE 1,1
  114. 3950  IF ERR = 27 THEN PRINT "CHECK THE PRINTER":FOR I= 1 TO 500:NEXT I:RUN"adprt"
  115. 3970  IF ERR =53 THEN CLS:LOCATE 10,15:PRINT "File containing KEYS used in NOTES does not exist.":LOCATE 12,22:PRINT "Return to EDIT program to create file." :LOCATE 18,30:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35030:Y$=INPUT$(1):RESUME 140
  116. 3981  CLS:LOCATE 10,28:PRINT "ERROR ";ERR;" ENCOUNTERED":LOCATE 18,26:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35030
  117. 3982  Y$=INKEY$:IF Y$="" THEN 3982
  118. 3985  RESUME 140
  119. 5000  Y$=INKEY$:IF Y$="" THEN LOCATE 3,69:PRINT TIME$:GOTO 5000 ELSE RETURN
  120. 5200  A$="EDIT":Y1=2:GOTO 5250
  121. 5205  A$="PRINT":Y1=6:GOTO 5250
  122. 5210  A$="DELETE":Y1=3:GOTO 5250
  123. 5220  A$="SORT":Y1=4:GOTO 5250
  124. 5230  A$="SEARCH":Y1=5:GOTO 5250
  125. 5240  A$="MAIN":Y1=1
  126. 5250  CLS:LOCATE 25,25:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS":;COLOR 3,0:LOCATE 12,21:PRINT "PLEASE WAIT, LOADING ";A$;" ROUTINES"
  127. 5260  IF Y1=6 THEN RUN "ADPRT.BAS"
  128. 5270  A$="AD"+A$:RUN A$
  129. 6000  ON KEY(8) GOSUB 3840:KEY(8) ON:ON KEY(7) GOSUB 3840:KEY(7) ON
  130. 6010  ON KEY(1) GOSUB 5240:ON KEY(2) GOSUB 5200:KEY(1) ON:KEY(2) ON:ON KEY(3) GOSUB 5210:KEY(3) ON:ON KEY(4) GOSUB 5220:KEY(4) ON:ON KEY(5) GOSUB 5230:ON KEY(6) GOSUB 130:KEY(6) ON:KEY(5) ON
  131. 6020  RETURN
  132. 9201  OSUB 3490
  133. 35000  IF SND$="N" THEN RETURN ELSE FOR SS%=1 TO 4:SOUND 500*SS%,2:NEXT:RETURN
  134. 35010  IF SND$="N" THEN RETURN ELSE FOR SS%=1 TO 3:SOUND 1000*SS%,1:NEXT:FOR SS%= 3 TO 1:SOUND 1000*SS%,1:NEXT:RETURN
  135. 35030  IF SND$="N" THEN RETURN ELSE SOUND 750,2:SOUND 30000,2:SOUND 750,2:RETURN
  136.