home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib29b.dsk / SCREEN.CODER.bas < prev    next >
BASIC Source File  |  2023-02-26  |  12KB  |  169 lines
  1. 10  REM  **********************
  2. 20  REM  * SCREEN.CODER       *
  3. 30  REM  *  BY                *
  4. 40  REM  * KEITH STATTENFIELD *
  5. 50  REM  * COPYRIGHT 1986 BY  *
  6. 60  REM  * MICROSPARC, INC.   *
  7. 70  REM  * CONCORD, MA  01742 *
  8. 80  REM  **********************
  9. 90  DIM C(15):C(1) = 1:K = 0:L% = 150
  10. 100  POKE 216,0:HT = 13:SN = 3:Q$ =  CHR$(34)
  11. 110 SI$(1) = "RUN PROGRAM"
  12. 120 SI$(2) = "RUN DEMO"
  13. 130 SI$(3) = "QUIT"
  14. 140  TEXT : HOME : HTAB 13: PRINT "SCREEN CODER": PRINT "  COPYRIGHT 1986 BY MICROSPARC, INC."
  15. 150 CS = 1
  16. 160  FOR X = 1 TO SN: IF X = CS  THEN  INVERSE 
  17. 170  VTAB HL +6 +X +X *(SN <10): HTAB HT: PRINT SI$(X): NORMAL 
  18. 180  NEXT X
  19. 190  VTAB 23: INVERSE : PRINT "<-";: NORMAL : PRINT " ";: INVERSE : PRINT "->";: NORMAL : PRINT " TO SELECT .... ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " TO EXECUTE."
  20. 200  POKE  -16368,0
  21. 210 K =  PEEK( -16384): IF K <128  THEN 210
  22. 220  POKE  -16368,0:K = K -128: IF K < >8  AND K < >21  AND K < >13  THEN 210
  23. 230 OS = CS
  24. 240  IF K = 8  THEN CS = CS -1:CS = CS *(CS >0) +SN *(CS = 0): GOSUB 300: GOTO 210
  25. 250  IF K = 21  THEN CS = CS +1:CS = CS *(CS < = SN) +(CS = SN +1): GOSUB 300: GOTO 210
  26. 260  ON CS GOSUB 280,270,290: GOTO 140
  27. 270  GOSUB 1220: RETURN 
  28. 280  GOTO 320
  29. 290  TEXT : HOME : END 
  30. 300  VTAB HL +6 +OS +OS *(SN <10): HTAB HT: PRINT SI$(OS)
  31. 310  VTAB HL +6 +CS +CS *(SN <10): INVERSE : HTAB HT: PRINT SI$(CS): NORMAL : RETURN 
  32. 320  TEXT : HOME : HTAB 13: PRINT "SCREEN CODER": HTAB 9: PRINT "BY KEITH STATTENFIELD"
  33. 330  PRINT "  COPYRIGHT 1986 BY MICROSPARC, INC.": POKE 34,4
  34. 340  GOSUB 640
  35. 350  ONERR  GOTO 1150: PRINT  CHR$(4)"VERIFY"RR$(1)
  36. 360  POKE  -16304,0: POKE  -16298,0: POKE  -16301,0: POKE 34,20: HOME : PRINT : PRINT  CHR$(4)"BLOAD ";RR$(1);",A1024"
  37. 370  PRINT  CHR$(4)"OPEN "RR$(2): PRINT  CHR$(4)"DELETE "RR$(2): PRINT  CHR$(4)"OPEN "RR$(2): PRINT  CHR$(4)"WRITE "RR$(2)
  38. 380 TXT = 1:LN =  VAL(RR$(3)):INC =  VAL(RR$(4)):XS =  VAL(RR$(5)):XE =  VAL(RR$(6)):YS =  VAL(RR$(7)):YE =  VAL(RR$(8))
  39. 390 CR = 0: IF RR$(9) = "C"  THEN CR = 1
  40. 400 C = 0:A$ = "GR:": COLOR= 0:CS = 15: IF TXT  THEN A$ = "COLOR=0:FOR P=" + STR$(YS) +" TO " + STR$(YE) +":HLIN " + STR$(XS) +"," + STR$(XE) +" AT P:NEXT P:"
  41. 410  IF CR  THEN  FOR CS = 1 TO 15: IF C(CS) = 0  THEN 610
  42. 420  FOR Y = YS TO YE
  43. 430  FOR X = XS TO XE
  44. 440 CX =  SCRN( X,Y): COLOR= CS: PLOT X,Y: COLOR= CX: PLOT X,Y:HL = 0:VL = 0: IF CX = 0  THEN 600
  45. 450  IF CR  AND CX < >CS  THEN C(CX) = 1: GOTO 600
  46. 460  IF X = 39  THEN 500
  47. 470  FOR P = X TO XE: IF  SCRN( P,Y) = CX  THEN  NEXT 
  48. 480  IF P = X  THEN 500
  49. 490 HL = P -X:X1 = P -1
  50. 500  IF Y = 39  THEN 540
  51. 510  FOR P = Y TO YE: IF  SCRN( X,P) = CX  THEN  NEXT 
  52. 520  IF P = Y  THEN 540
  53. 530 VL = P -Y:Y1 = P -1
  54. 540  COLOR= 0: IF HL = 1  AND VL = 1  THEN B$ = "PLOT " + STR$(X) +"," + STR$(Y):: PLOT X,Y: GOTO 570
  55. 550  COLOR= 0: IF HL  AND HL >VL  THEN B$ = "HLIN " + STR$(X) +"," + STR$(X1) +" AT " + STR$(Y): HLIN X,X1 AT Y:X = X1: GOTO 570
  56. 560  IF VL  AND VL > = HL  THEN B$ = "VLIN" + STR$(Y) +"," + STR$(Y1) +" AT " + STR$(X): VLIN Y,Y1 AT X: GOTO 570
  57. 570  IF CX < >CL  THEN A$ = A$ +"COLOR=" + STR$(CX) +":":CL = CX
  58. 580 A$ = A$ +B$: IF  LEN(A$) <L%  THEN A$ = A$ +":": GOTO 600
  59. 590  PRINT LN;A$:LN = LN +INC:BY = BY + LEN(A$) + LEN( STR$(LN)) +1:A$ = ""
  60. 600  NEXT X,Y: IF  LEN(A$) >0  THEN  PRINT LN;A$:A$ = "":LN = LN +INC
  61. 610  IF CR  THEN  NEXT CS
  62. 620  PRINT  CHR$(4)"CLOSE": TEXT : HOME : VTAB 10: PRINT "DONE": END 
  63. 630  REM   INPUT SUBROUTINE
  64. 640  READ MX: DIM RR$(MX):MZ = 0: HOME : VTAB 23: PRINT "<RETURN> TO ACCEPT, <ESC> FOR MENU": POKE 35,22
  65. 650  FOR MM = 1 TO MX
  66. 660 :: READ VV: READ HH: READ QQ$: READ QC$
  67. 670 QB$ = RR$(MM): IF QB$ = ""  THEN QB$ = QC$
  68. 680 :: GOSUB 740:RR$(MM) = QB$: GOSUB 910: IF MZ  THEN  PRINT  CHR$(7);: GOTO 680
  69. 690  NEXT 
  70. 700  VTAB 23: HTAB 1: CALL  -958: PRINT "ALL OK? ";: GET CH$: IF CH$ = "Y"  OR CH$ =  CHR$(121)  THEN 730
  71. 710  IF CH$ < >"N"  AND CH$ < > CHR$(110)  THEN  PRINT  CHR$(7);: GOTO 700
  72. 720  PRINT : VTAB 23: PRINT "<RETURN> TO ACCEPT, <ESC> FOR MENU": RESTORE : READ MX: HOME : GOTO 650
  73. 730  RETURN 
  74. 740  VTAB VV: HTAB 1: PRINT QQ$: CALL  -958:
  75. 750  VTAB VV: HTAB HH: PRINT ":"QB$;: HTAB HH +1
  76. 760  GET QA$: PRINT QA$;: IF QA$ =  CHR$(27)  THEN  CLEAR : GOTO 90
  77. 770  IF  ASC(QA$) <32  AND QA$ < > CHR$(13)  THEN  PRINT  CHR$(7);: GOTO 740
  78. 780  IF QA$ =  CHR$(13)  THEN  RETURN 
  79. 790 QB$ = QA$: CALL  -868
  80. 800  GET QA$: PRINT QA$;
  81. 810  IF QA$ =  CHR$(13)  THEN  GOTO 870
  82. 820  IF QA$ =  CHR$(8)  THEN  GOSUB 880: GOTO 800
  83. 830  IF QA$ =  CHR$(27)  THEN  CLEAR : GOTO 90
  84. 840  IF  ASC(QA$) <32  THEN  VTAB VV: GOTO 800
  85. 850  IF  LEN(QB$) <18  THEN QB$ = QB$ +QA$: GOTO 800
  86. 860  PRINT  CHR$(7);: CALL  -1008: GOTO 800
  87. 870  RETURN 
  88. 880  IF QB$ = ""  THEN  CALL  -1036: RETURN 
  89. 890  IF  LEN(QB$) >1  THEN QB$ =  LEFT$(QB$, LEN(QB$) -1): PRINT " ";: CALL  -1008: RETURN 
  90. 900 QB$ = "": PRINT " ";: CALL  -1008: RETURN 
  91. 910 MZ = 0: IF MM = 1  OR MM = 2  THEN  RETURN 
  92. 920  IF MM < >3  THEN 950
  93. 930  IF  VAL(RR$(3)) >60000  OR  VAL(RR$(3)) <0  THEN MZ = 1
  94. 940  RETURN 
  95. 950  IF MM < >4  THEN 980
  96. 960  IF  VAL(RR$(4)) >100  OR  VAL(RR$(4)) <1  THEN MZ = 1
  97. 970  RETURN 
  98. 980  IF MM < >5  THEN 1010
  99. 990  IF  VAL(RR$(5)) <0  OR  VAL(RR$(5)) >39  THEN MZ = 1
  100. 1000  RETURN 
  101. 1010  IF MM < >6  THEN 1040
  102. 1020  IF  VAL(RR$(6)) < VAL(RR$(5))  OR  VAL(RR$(6)) >39  THEN MZ = 1
  103. 1030  RETURN 
  104. 1040  IF MM < >7  THEN 1070
  105. 1050  IF  VAL(RR$(7)) <0  OR  VAL(RR$(7)) >39  THEN MZ = 1
  106. 1060  RETURN 
  107. 1070  IF MM < >8  THEN 1110
  108. 1080  IF  VAL(RR$(8)) < VAL(RR$(7))  OR  VAL(RR$(8)) >39  THEN MZ = 1
  109. 1090  RETURN 
  110. 1100  IF MM < >9  THEN 1120
  111. 1110  IF RR$(9) < >"F"  AND RR$(9) < >"C"  THEN MZ = 1
  112. 1120  RETURN 
  113. 1130  DATA   9,8,21 ,INPUT FILE,SCREEN,9,21,OUTPUT FILE,LINEFILE,10,21,STARTING LINE NO.,"10",11,21,INCREMENT,"10"
  114. 1140  DATA  12,21,X START,"0",13,21,X END,"39",14,21,Y START,"0",15, 21,Y END,"39",16,21,COLOR/FULL SCREEN?,F
  115. 1150 ER =  PEEK(222):EL =  PEEK(219) *256 + PEEK(218)
  116. 1160  POKE 216,0: TEXT : HOME : VTAB 7: PRINT  CHR$(4)"CLOSE"
  117. 1170  IF ER = 6  THEN  PRINT "FILE NOT FOUND": GOTO 1210
  118. 1180  IF ER = 8  THEN  PRINT "I/O ERROR": GOTO 1210
  119. 1190  IF ER = 16  THEN  PRINT "SYNTAX ERROR IN LINE "EL: GOTO 1210
  120. 1200  PRINT "UNANTICIPATED ERROR IN LINE "EL
  121. 1210  VTAB 23: PRINT "PRESS <RETURN> TO RESTART";: GET CH$: CALL  -3288: RESTORE : CLEAR : GOTO 90
  122. 1220  HOME : VTAB 7: PRINT "HERE'S AN EXAMPLE OF COLOR DRAWING": PRINT "GENERATED BY THE COLOR DECODING OPTION ."
  123. 1230  PRINT "THE PROGRAM LINES TO CREATE THE DRAWING": PRINT "WERE GENERATED ENTIRELY BY THIS PROGRAM!"
  124. 1240  VTAB 23: PRINT "PRESS <RETURN> TO CONTINUE";: GET CH$: GOSUB 1290
  125. 1250  TEXT : HOME : VTAB 7: PRINT "AND NOW, AN EXAMPLE OF TEXT SCREEN": PRINT "DECODING!"
  126. 1260  VTAB 23: PRINT "PRESS <RETURN> TO CONTINUE";: GET CH$: GOSUB 1380
  127. 1270  TEXT : HOME 
  128. 1280  RETURN 
  129. 1290  GR : COLOR= 0: FOR P = 0 TO 39: HLIN 0,39 AT P: NEXT P: COLOR= 1: HLIN 29,31 AT 3: HLIN 29,31 AT 4: VLIN 5,15 AT 30: VLIN 5,15 AT 31: HLIN 1,6 AT 7: HLIN 1,7 AT 8: VLIN 9,15 AT 2
  130. 1300  VLIN 9,15 AT 3: VLIN 9,15 AT 6: VLIN 9,15 AT 7: VLIN 14,15 AT 5: VLIN 22,37 AT 16: VLIN 22,37 AT 17: VLIN 22,38 AT 18: VLIN 22,38 AT 22: VLIN 22,37 AT 23: VLIN 22,36 AT 24
  131. 1310  VLIN 23,35 AT 15: VLIN 23,38 AT 19: VLIN 23,37 AT 20: VLIN 23,38 AT 21: VLIN 23,35 AT 25: VLIN 24,31 AT 14: VLIN 24,31 AT 26: VLIN 25,28 AT 13: VLIN 25,28 AT 27:
  132. 1320  COLOR= 4: VLIN 7,15 AT 35: HLIN 36,38 AT 7: VLIN 8,14 AT 34: HLIN 36,39 AT 8: VLIN 9,11 AT 38: VLIN 9,11 AT 39: VLIN 10,11 AT 36: VLIN 10,11 AT 37: HLIN 36,39 AT 14: HLIN 36,38 AT 15
  133. 1330  COLOR= 6: VLIN 3,4 AT 10: VLIN 3,4 AT 11: HLIN 9,11 AT 7: HLIN 9,11 AT 8: VLIN 9,15 AT 10: VLIN 9,15 AT 11:
  134. 1340  COLOR= 7: HLIN 21,23 AT 3: HLIN 21,23 AT 4: VLIN 5,15 AT 22: VLIN 5,15 AT 23: HLIN 24,26 AT 7: HLIN 24,27 AT 8: VLIN 9,15 AT 26: VLIN 9,14 AT 27: VLIN 14,15 AT 24: VLIN 14,15 AT 25
  135. 1350  COLOR= 12: VLIN 18,19 AT 22: VLIN 19,20 AT 21: VLIN 20,22 AT 20:
  136. 1360  COLOR= 15: HLIN 13,15 AT 3: HLIN 13,15 AT 4: VLIN 5,15 AT 14: VLIN 5,15 AT 15: HLIN 16,18 AT 7: HLIN 16,19 AT 8: VLIN 9,15 AT 18: VLIN 9,14 AT 19: VLIN 14,15 AT 16: VLIN 14,15 AT 17
  137. 1370  HTAB 1: VTAB 23: CALL  -958: PRINT "PRESS <RETURN> TO CONTINUE";: GET CH$: RETURN 
  138. 1380  COLOR= 0: FOR P = 0 TO 37: HLIN 0,39 AT P: NEXT P: COLOR= 1: PLOT 19,2: PLOT 12,4: PLOT 27,4: PLOT 2,16: PLOT 21,16: PLOT 21,18: PLOT 4,20: PLOT 4,24:
  139. 1390  COLOR= 2: PLOT 14,0: PLOT 23,0: PLOT 8,2: PLOT 6,4: PLOT 17,4: PLOT 23,4: PLOT 28,4: PLOT 23,12: PLOT 3,16: PLOT 3,18: PLOT 5,20: PLOT 5,24: PLOT 4,28: PLOT 13,28:
  140. 1400  COLOR= 3: HLIN 12,13 AT 0: PLOT 19,0: PLOT 17,2: PLOT 2,4: PLOT 22,4: PLOT 25,4: PLOT 29,4: PLOT 34,4: HLIN 21,22 AT 12: PLOT 0,16: PLOT 2,18: PLOT 2,20: PLOT 21,22
  141. 1410  PLOT 2,24: PLOT 21,26: PLOT 0,28: HLIN 11,12 AT 28:
  142. 1420  COLOR= 4: PLOT 21,0: PLOT 14,2: PLOT 18,2: HLIN 20,21 AT 2: PLOT 28,2: PLOT 10,4: PLOT 4,12: PLOT 2,14: PLOT 5,14: PLOT 1,16: PLOT 4,16: PLOT 8,18: PLOT 3,20: PLOT 6,20
  143. 1430  PLOT 4,22: PLOT 3,24: PLOT 6,24: PLOT 4,26:
  144. 1440  COLOR= 5: HLIN 15,16 AT 0: PLOT 22,0: PLOT 12,2: PLOT 22,2: PLOT 26,2: PLOT 3,12: PLOT 9,12: HLIN 24,25 AT 12: PLOT 1,14: PLOT 4,14: PLOT 10,14: PLOT 24,14: PLOT 28,14
  145. 1450  PLOT 12,16: PLOT 4,18: PLOT 6,18: PLOT 2,22: PLOT 2,26: PLOT 7,28: HLIN 14,15 AT 28:
  146. 1460  COLOR= 6: PLOT 24,2: PLOT 15,4: PLOT 6,12: PLOT 7,14: PLOT 25,14: PLOT 6,28: PLOT 21,28:
  147. 1470  COLOR= 7: PLOT 8,4: PLOT 7,16:
  148. 1480  COLOR= 8: PLOT 15,2: PLOT 9,4: PLOT 14,4: PLOT 0,20: PLOT 0,22:
  149. 1490  COLOR= 9: PLOT 9,2: PLOT 13,2: PLOT 25,2: PLOT 5,4: PLOT 7,4: PLOT 13,4: PLOT 18,4: PLOT 21,4: PLOT 32,4: PLOT 0,12: PLOT 7,12: PLOT 8,14: PLOT 22,14: PLOT 26,14: PLOT 5,16
  150. 1500  PLOT 10,16: PLOT 0,18: PLOT 22,22: PLOT 0,24: PLOT 0,26: PLOT 22,26:
  151. 1510  COLOR= 10: HLIN 0,11 AT 1: PLOT 18,1: HLIN 24,39 AT 1: HLIN 0,7 AT 3: PLOT 10,3: PLOT 16,3: HLIN 29,39 AT 3: HLIN 0,1 AT 5: PLOT 11,5: PLOT 16,5: PLOT 19,5: HLIN 30,31 AT 5
  152. 1520  HLIN 35,39 AT 5: HLIN 0,39 AT 7: HLIN 0,39 AT 9: HLIN 0,39 AT 11: PLOT 20,12: PLOT 5,13: HLIN 10,19 AT 13: HLIN 27,39 AT 13: PLOT 20,14: PLOT 6,15: HLIN 11,19 AT 15
  153. 1530  HLIN 29,39 AT 15: PLOT 20,16: PLOT 8,17: PLOT 13,17: HLIN 16,19 AT 17: HLIN 23,39 AT 17: PLOT 20,18: HLIN 9,19 AT 19: HLIN 23,39 AT 19: PLOT 20,20: PLOT 1,21: HLIN 7,19 AT 21
  154. 1540  HLIN 22,39 AT 21: PLOT 20,22: PLOT 1,23: HLIN 5,19 AT 23: HLIN 23,39 AT 23: PLOT 20,24: PLOT 1,25: HLIN 7,19 AT 25: HLIN 22,39 AT 25: PLOT 20,26: PLOT 1,27: HLIN 5,19 AT 27
  155. 1550  HLIN 23,39 AT 27: PLOT 20,28: PLOT 5,29: PLOT 10,29: HLIN 18,19 AT 29: HLIN 22,39 AT 29: HLIN 0,39 AT 31: HLIN 0,39 AT 33: HLIN 0,39 AT 35: HLIN 0,39 AT 37:
  156. 1560  COLOR= 11: PLOT 11,2: HLIN 12,15 AT 5: PLOT 20,13: PLOT 20,15: HLIN 20,22 AT 17: HLIN 20,22 AT 19: HLIN 20,21 AT 21: HLIN 20,22 AT 23: HLIN 20,21 AT 25: HLIN 20,22 AT 27
  157. 1570  PLOT 17,29: PLOT 20,29:
  158. 1580  COLOR= 12: PLOT 13,1: HLIN 15,17 AT 1: HLIN 19,22 AT 1: VLIN 2,3 AT 27: PLOT 8,3: HLIN 11,13 AT 3: PLOT 15,3: PLOT 19,3: HLIN 22,26 AT 3: PLOT 28,3: PLOT 30,4: HLIN 2,3 AT 5
  159. 1590  HLIN 7,9 AT 5: PLOT 17,5: HLIN 20,22 AT 5: PLOT 24,5: PLOT 27,5: PLOT 29,5: HLIN 32,34 AT 5: VLIN 12,13 AT 8: HLIN 0,1 AT 13: HLIN 6,7 AT 13: VLIN 13,17 AT 9: PLOT 22,13
  160. 1600  HLIN 24,26 AT 13: VLIN 14,15 AT 21: VLIN 14,15 AT 27: PLOT 0,15: HLIN 7,8 AT 15: PLOT 10,15: HLIN 22,26 AT 15: PLOT 28,15: PLOT 2,17: HLIN 5,7 AT 17: HLIN 10,12 AT 17
  161. 1610  HLIN 14,15 AT 17: HLIN 0,2 AT 19: HLIN 4,7 AT 19: PLOT 4,21: HLIN 2,4 AT 23: PLOT 4,25: VLIN 27,29 AT 2: HLIN 3,4 AT 27: VLIN 28,29 AT 8: VLIN 28,29 AT 9: HLIN 0,1 AT 29
  162. 1620  PLOT 3,29: PLOT 6,29: PLOT 12,29: HLIN 14,16 AT 29: PLOT 21,29:
  163. 1630  COLOR= 13: PLOT 12,1: PLOT 14,1: PLOT 23,1: PLOT 9,3: PLOT 14,3: HLIN 17,18 AT 3: VLIN 3,4 AT 20: PLOT 21,3: HLIN 4,6 AT 5: PLOT 10,5: PLOT 18,5: PLOT 23,5: HLIN 25,26 AT 5
  164. 1640  PLOT 28,5: HLIN 2,4 AT 13: PLOT 21,13: PLOT 23,13: HLIN 1,5 AT 15: HLIN 0,1 AT 17: HLIN 3,4 AT 17: PLOT 5,18: PLOT 3,19: PLOT 8,19: PLOT 0,21: HLIN 2,3 AT 21: HLIN 5,6 AT 21
  165. 1650  PLOT 0,23: PLOT 0,25: HLIN 2,3 AT 25: HLIN 5,6 AT 25: PLOT 0,27: PLOT 4,29: PLOT 7,29: PLOT 11,29: PLOT 13,29:
  166. 1660  COLOR= 14: PLOT 17,0: PLOT 23,2: PLOT 33,4: PLOT 35,4: PLOT 1,12: PLOT 26,12: PLOT 23,14: PLOT 6,16: PLOT 11,16: PLOT 14,16: PLOT 16,16: PLOT 1,18: PLOT 7,18: PLOT 3,22
  167. 1670  PLOT 3,26: PLOT 16,28:
  168. 1680  COLOR= 15: PLOT 20,0: PLOT 3,4: PLOT 24,4: PLOT 0,14: PLOT 15,16: PLOT 1,28: PLOT 3,28: PLOT 5,28: PLOT 17,28:
  169. 1690  HTAB 1: VTAB 23: CALL  -958: PRINT "PRESS <RETURN> TO CONTINUE";: GET CH$: RETURN