home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / gwbasic / lister / lister.bas next >
Encoding:
BASIC Source File  |  1985-09-15  |  7.1 KB  |  166 lines
  1. 10 ' LISTER, TO LIST BASIC PROGRAMS SAVED IN ASCI FORMAT
  2. 15 SCREEN 0,0,0:WIDTH 80:COLOR 7,0,0
  3. 20 CLS:INPUT "ENTER NAME OF PROGRAM TO BE LISTED";FLNM$
  4. 21 FLNM1$=FLNM$
  5. 30 PRINT :PRINT "HAS PROGRAM  `";FLNM$; " ' BEEN SAVED AS ASCI FILE  (Y/N) "
  6. 40 Q$=INPUT$(1)
  7. 50 IF Q$="Y" THEN GOTO 90
  8. 60 IF Q$<>"N" THEN 40
  9. 70 TEMP$="LIS-TEMP.BAS":PROGRAM$="LISTER":LINUM=80:CHAIN "CONVERT.SUB",65000!,ALL
  10. 80 FLNM$="LIS-TEMP.BAS"
  11. 90 ON ERROR GOTO 0
  12. 100 SCREEN 0:CLS:DEFINT A-Z
  13. 110 DIM PREFER$(20)
  14. 120 LINE INPUT "TODAY'S DATE: ";TODAY$
  15. 130 ' SET INITIAL FORMAT
  16. 140 L.MGN=5:R.MGN=75:B.MGN=8:LN.SPA=1:PG.LEN=66:PG.WID=80:DB.WID=20
  17. 150 HEADER$="":INDENT$=SPACE$(8)
  18. 160 ' INITIALIZE THE PRINTER, COMPLAIN IF IT'S OFF-LINE
  19. 170 ON ERROR GOTO 1460
  20. 180 LPRINT CHR$(24);CHR$(127);CHR$(18);:WIDTH"LPT1:",80
  21. 190 ON ERROR GOTO 0
  22. 200 ' DEFINE F-KEYS
  23. 210 KEY 1,"LT MARGIN AT: "
  24. 220 KEY 2,"RT MARGIN AT: "
  25. 230 KEY 3,"BOTTOM BLANKS:"
  26. 240 KEY 4,"WIDTH (MAX'M):"
  27. 250 KEY 5,"SINGLE SPACE"+CHR$(13)
  28. 260 KEY 6,"DOUBLE SPACE"+CHR$(13)
  29. 270 KEY 7,"P'GRAM NAME: "
  30. 280 KEY 8,"HEADER: "
  31. 290 KEY 9,"REVIEW"+CHR$(13)
  32. 300 KEY 10," BEGIN"
  33. 310 KEY ON:LOCATE 23,1
  34. 320 ' CALL ATTENTION TO F-KEYS
  35. 330 ARROW$=STRING$(20,"-")
  36. 340 PRINT ARROW$;:COLOR 0,7
  37. 350 PRINT "USE F-KEYS TO SET THE LISTING FORMAT";:COLOR 7,0:PRINT ARROW$
  38. 360 RESTORE:FOR I=0 TO 9:READ FKEY$(I):NEXT
  39. 370 DATA LT,RT,BO,WI,SI,DO,P',HE,RE," B"
  40. 380 ' SET UP LIST OF PREFERRED BREAKPOINTS
  41. 390 FOR IP = 0 TO 20: READ Z$: IF Z$<>"END" THEN PREFER$(IP)=Z$: NEXT IP
  42. 400 IP=IP-1
  43. 410 DATA " ELSE " ," THEN ", ": ", " PRINT"
  44. 420 DATA " IF ", " '", " OR ", " AND ", ";"
  45. 430 DATA "=", " ", "+", "*",  ",", END
  46. 435 LOCATE 2,1:GOTO 800
  47. 440 'LOOP FOR ADJUSTING  RUNTIME PARAMETERS
  48. 450 LINE INPUT Z$
  49. 460 FOR I=0 TO 10:IF LEFT$(Z$,2)=FKEY$(I) GOTO 470 ELSE NEXT : GOTO 450
  50. 470 ON I+1 GOTO 490,500,510,700,550,560,580,530,790,910
  51. 480 ' MARGIN SETTING ROUTINES
  52. 490 GOSUB 1520:L.MGN=NUMBA:GOTO 450
  53. 500 GOSUB 1520:R.MGN=NUMBA:GOTO 450
  54. 510 GOSUB 1520:B.MGN=NUMBA:GOTO 450
  55. 520 ' ESTABLISH PAGE HEADERS
  56. 530 HEADER$=MID$(Z$,9):GOTO 450
  57. 540 ' SINGLE OR DOUBLE SPACE OUTPUT
  58. 550 LN.SPA=1:GOTO 450
  59. 560 LN.SPA=2:GOTO 450
  60. 570 ' GET NAME OF PROGRAM TO BE LISTED
  61. 580 FLNM$=MID$(Z$,13)
  62. 590 IF LEFT$(FLNM$,1)=" " THEN FLNM$=MID$(FLNM$,2):GOTO 590
  63. 600 ' IF THERE'S NO HEADER YET FAKE IT WITH FILE NAME
  64. 610 ' REMOVE FILE EXTENSION FROM FLNM$ IF NEEDED
  65. 620 IF HEADER$ <> "" THEN 680
  66. 630 HEADER$=FLNM$:Q = LEN(HEADER$)
  67. 640 FOR Q1 = 1 TO Q
  68. 650 IF MID$(HEADER$,Q1,1)="." THEN HEADER$=LEFT$(HEADER$,Q1-1)
  69. 660 NEXT Q1
  70. 670 HEADER$ = CHR$(34)+HEADER$+CHR$(34)
  71. 680 GOTO 450
  72. 690 ' PASS MAX-PAGE-WIDTH PARAMETER TO THE MX80 PRINTER
  73. 700 GOSUB 1520
  74. 710 IF NUMBA>132 THEN PRINT "MAXIMUM PAGE WIDTH IS LIMITED TO 132 CHARACTERS":GOTO 450
  75. 720 IF NUMBA>80 AND NUMBA<133 THEN LPRINT CHR$(20); CHR$(15);: WIDTH "LPT1:",132 ELSE WIDTH "LPT1:",80
  76. 730 IF NUMBA>66 AND NUMBA<81 THEN LPRINT CHR$(18);CHR$(20);
  77. 740 DBL.WID=20
  78. 750 IF NUMBA>40 AND NUMBA <67 THEN  LPRINT CHR$(15);:DBL.WID=14
  79. 760 IF NUMBA<41 THEN LPRINT CHR$(18);:DBL.WID=14
  80. 770 PG.WID=NUMBA
  81. 780 GOTO 450
  82. 790 ' DISPLAY CURRENT PARAMETERS
  83. 791 CLS
  84. 800 PRINT : PRINT "LEFT MARGIN AT";L.MGN
  85. 810 PRINT "RIGHT MARGIN AT";R.MGN
  86. 820 PRINT MID$(STR$(B.MGN),2);" BLANK LINES AT PAGE BOTTOM"
  87. 830 PRINT "MAXIMUM PAGE WIDTH IS";PG.WID
  88. 840 IF LN.SPA=2 THEN PRINT "DOUBLE";ELSE PRINT "SINGLE";
  89. 850 PRINT " LINE SPACING"
  90. 860 PRINT "PROGRAM NAME: ";FLNM1$
  91. 870 PRINT "HEADER: ";:IF HEADER$="" THEN GOSUB 1560 ELSE PRINT HEADER$
  92. 880 PRINT
  93. 890 GOTO 450
  94. 900 ' CHECK PARAMETERS BEFORE ACTUALLY TRYING TO LIST THE PROGRAM
  95. 910 LN.LEN=R.MGN-L.MGN+1:  IF L.MGN<1 OR L.MGN>R.MGN-20 OR R.MGN<L.MGN+20 OR R.MGN>PG.WID-2 OR B.MGN<5 OR PG.WID<LN.LEN OR LEN(HEADER$)>LN.LEN-10         THEN BEEP:PRINT "CAN'T BEGIN. CHECK THE MARGIN & WIDTH SPECIFICATIONS or LENGTH OF HEADER":GOTO 340
  96. 920 ' IF READING A FILE FROM TAPE-THIS STATEMENT SHOULD BE FLNM$="CASL"+FLNM$
  97. 930 ' OPEN THE FILE, COMPLAIN IF NOT POSSIBLE TO DO IT
  98. 940 ON ERROR GOTO 1490
  99. 950 OPEN FLNM$ FOR INPUT AS #1
  100. 960 ON ERROR GOTO 0
  101. 970 LPRINT
  102. 980 ' TITLE THE FIRST PAGE WITH THE HEADER AND -IF AVAILABLE- THE DATE
  103. 990 LPRINT CHR$(DBL.WID); TAB(L.MGN); HEADER$;: IF TODAY$="" THEN LPRINT ELSE LPRINT", LISTED ";TODAY$
  104. 1000 LPRINT :LPRINT
  105. 1010 ' FORMAT THE HEADER TO APPEAR AT UPPER RIGHT ON LATTER PAGES
  106. 1020 HEADER$=SPACE$(LN.LEN-LEN(HEADER$)-10)+HEADER$
  107. 1030 ' GET THE NEXT BASIC LINE,QUIT IF END OF FILE
  108. 1040 PG.NUM=1:LN.CNT=4
  109. 1050 IF EOF(1) GOTO 1580
  110. 1060 LINE INPUT #1,TAPE$:IF TAPE$="" GOTO 1060
  111. 1070 ' RIGHT JUSTIFY THE LINE NUMBER
  112. 1080 TAPE$=SPACE$(6-INSTR(TAPE$," "))+TAPE$
  113. 1090 ' CMNT.SW GOVERNS THE BLANK LINE AHEAD OF COMMENT LINE
  114. 1100 IF MID$(TAPE$,7,1)<>"'" THEN CMNT.SW=0
  115. 1110 IF MID$(TAPE$,7,3)<>"REM" THEN CMNT.SW=0
  116. 1120 ' BREAK THE BASIC LINE INTO PRINTER LINES
  117. 1130 FOR J = 0 TO 9
  118. 1140 IF CMNT.SW=0 AND MID$(TAPE$,7,1)="'" THEN LN$(J)="":J=J+1:CMNT.SW=1
  119. 1150 IF CMNT.SW=0 AND MID$(TAPE$,7,3)="REM" THEN LN$(J)="":J=J+1:CMNT.SW=1
  120. 1160 ' IT'S EASY IF THE WHOLE LINE FITS AT ONCE
  121. 1170 IF LEN(TAPE$)<LN.LEN THEN LN$(J)=TAPE$:GOTO 1330
  122. 1180 ' ELSE, CHECK FOR PREFERRED BREAKPOINTS
  123. 1190 FOR K=0 TO IP
  124. 1200 SITE=0: K$=PREFER$(K)
  125. 1210 HI.SITE=SITE:IF SITE<9 THEN SITE=9
  126. 1220 SITE=INSTR(SITE+1,TAPE$,K$)
  127. 1230 IF SITE >0 AND SITE<=LN.LEN GOTO 1210
  128. 1240 IF HI.SITE=0 THEN NEXT K
  129. 1250 IF HI.SITE=0 THEN HI.SITE=LN.LEN
  130. 1260 ' HI.SITE NOW POINTS TO THE RIGHTMOST BEST BREAKPOINT
  131. 1270 ' SPLIT THE LINE THERE AND INDENT ALL BUT THE FIRST ONE
  132. 1280 LN$(J)=LEFT$(TAPE$,HI.SITE)
  133. 1290 TAPE$=MID$(TAPE$,HI.SITE+1)
  134. 1300 TAPE$=INDENT$+TAPE$
  135. 1310 NEXT J
  136. 1320 ' WILL THE PACK OF PRINTER LINES FIT ON THIS PAGE
  137. 1330 IF LN.CNT<PG.LEN-B.MGN-LN.SPA*(J+1) GOTO 1400
  138. 1340 ' NO, SO BEGIN A NEW PAGE WITH HEADER AND PAGE NUMBER
  139. 1350 PG.NUM=PG.NUM+1
  140. 1360 LPRINT CHR$(12)
  141. 1370 LPRINT CHR$(DBL.WID);TAB(L.MGN);HEADER$;", PAGE";PG.NUM
  142. 1380 LPRINT:LPRINT:LN.CNT=4
  143. 1390 ' EVERYTHING IS GUARANTEED TO FIT, PRINT IT ALL
  144. 1400 FOR L=0 TO J:LPRINT CHR$(DBL.WID); TAB(L.MGN); LN$(L): IF LN.SPA=2 THEN LPRINT
  145. 1410 NEXT L
  146. 1420 ' UPDATE THE LINE COUNT FOR THIS PAGE, AND CYCLE AGAIN
  147. 1430 LN.CNT=LN.CNT+(J+1)*LN.SPA
  148. 1440 GOTO 1050
  149. 1450 ' THE OPERATER- ALERT FOR OFF-LINE PRINTER
  150. 1460 PRINT: BEEP: PRINT"THE LINE PRINTER ISN'T READY. CHECK IT .....":PRINT
  151. 1470 RESUME 180
  152. 1480 ' THE OPERATOR- ALERT FOR A LACK OF DISKETTE DATA
  153. 1490 CLOSE:PRINT:BEEP: PRINT"PROBLEMS WITH THE DISKETTE. CHECK IT....."
  154. 1500 RESUME 950
  155. 1510 ' SUBR TO DECODE A NUMERIC PARAMETER INPUT
  156. 1520 NUMBA=VAL(MID$(Z$,15))
  157. 1530 IF NUMBA=0 THEN  BEEP: PRINT"<<NUMBER REQUIRED>>"
  158. 1540 RETURN
  159. 1550 ' SUBR TO NOTE THE LACK OF A FILE NAME OR HEADER
  160. 1560 COLOR 0,7:PRINT"  NONE SPECIFIED  ";:COLOR 7,0:PRINT:RETURN
  161. 1570 ' ORDERLY EXIT. RESET THE PRINTER AND F-KEYS, THEN EXIT
  162. 1580 LPRINT CHR$(18); CHR$(20): WIDTH "LPT1:",80: BEEP: CLOSE: KEY OFF
  163. 1590 KEY 1,"LIST ":KEY 2,"RUN"+CHR$(13):KEY 3,"LOAD"+CHR$(34):KEY 4,"CLS"+CHR$(13):KEY 5,"CONT"+CHR$(13):KEY 6,"SAVE"+CHR$(34):KEY 7,"TRON"+CHR$(13):KEY 8,"TROFF"+CHR$(13):KEY 9,"CLS:FILES"+CHR$(13):KEY 10,"SCREEN 0,0,0"+CHR$(13)
  164. 1600 IF Q$="" THEN KILL"LIS-TEMP.BAS"
  165. 1610 KEY ON:END
  166.