home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib25a.dsk / SEPTEMBER.1985 / SERPENTS.COIL.bas < prev    next >
BASIC Source File  |  2023-02-26  |  13KB  |  270 lines
  1. 10  REM **********************
  2. 20  REM *   SERPENTS.COIL    *
  3. 30  REM * BY JAMES R. BROWN  *
  4. 40  REM * & CAMERON MITCHELL *
  5. 50  REM *  NIBBLE SEPT 1985  *
  6. 60  REM * COPYRIGHT (C) 1985 *
  7. 70  REM * BY MICROSPARC, INC *
  8. 80  REM * CONCORD, MA  01742 *
  9. 90  REM **********************
  10. 100  IF  PEEK(104) < >96  THEN  POKE 103,1: POKE 104,96: POKE 24576,0: PRINT  CHR$(4)"RUN SERPENTS.COIL"
  11. 110  GOTO 620
  12. 120  REM PLOT STORM ROUTINE
  13. 130  POKE  -16368,0:DF = 1:OX =  -1:OY =  -1:ID = 1:EF = 0
  14. 140  FOR I = 1 TO F -1
  15. 150  IF XL(I +1) < >XL(I)  THEN  GOTO 230
  16. 160  IF YL(I +1) = YL(I)  THEN 460
  17. 170 Y = YL(I):X = XL(I):DY = 1
  18. 180  IF YL(I +1) <YL(I)  THEN DY =  -1
  19. 190 Y = Y +DY
  20. 200  FOR K = 1 TO 50: NEXT K: GOSUB 490: IF EF  THEN I = F -1: NEXT : TEXT : GOTO 1460
  21. 210  IF Y = YL(I +1) GOTO 450
  22. 220  GOTO 190
  23. 230  IF YL(I +1) < >YL(I) GOTO 300
  24. 240 Y = YL(I):X = XL(I):DX = 1
  25. 250  IF XL(I +1) <XL(I)  THEN DX =  -1
  26. 260 X = X +DX
  27. 270  FOR K = 1 TO 50: NEXT K: GOSUB 490: IF EF  THEN I = F -1: NEXT : TEXT : GOTO 1460
  28. 280  IF X = XL(I +1) GOTO 450
  29. 290  GOTO 260
  30. 300 B = (YL(I +1) -YL(I))/(XL(I +1) -XL(I))
  31. 310 X = XL(I):Y = YL(I):DX = 1:DY = 1
  32. 320  IF XL(I +1) <XL(I)  THEN DX =  -1
  33. 330  IF YL(I +1) <YL(I)  THEN DY =  -1
  34. 340 G1 = FALSE:G2 = FALSE:YH = YL(I) +B *(DX +X -XL(I))
  35. 350  IF  ABS(YH -Y) >.5  THEN G1 = TRUE
  36. 360  IF  ABS(YH -Y) >1.5  THEN G2 = TRUE
  37. 370  IF G1  AND   NOT G2  THEN X = X +DX:Y = Y +DY: GOTO 400
  38. 380  IF   NOT G1  THEN X = X +DX: GOTO 400
  39. 390  IF G2  THEN Y = Y +DY
  40. 400  GOSUB 490: IF EF  THEN I = F -1: NEXT : TEXT : GOTO 1460
  41. 410  IF X = XL(I +1)  AND Y = YL(I +1)  THEN  GOTO 450
  42. 420  IF X = XL(I +1)  THEN DX = 0
  43. 430  IF Y = YL(I +1)  THEN DY = 0
  44. 440  GOTO 340
  45. 450  POKE 230,64: HPLOT XL(I),YL(I) TO XL(I +1),YL(I +1): POKE 230,32
  46. 460  NEXT I
  47. 470  CALL 768
  48. 480  POKE  -16368,0: GET Y$: PRINT : TEXT : GOTO 1460
  49. 490 DF =  -DF:G1 = FALSE: IF OX >7  AND OX <273  AND OY >7  AND OY <185  THEN G1 = TRUE
  50. 500  IF ID - INT(ID/4) *4 = 1  THEN RT = 0
  51. 510  IF ID - INT(ID/4) *4 = 2  THEN RT = 48
  52. 520  IF ID - INT(ID/4) *4 = 3  THEN RT = 32
  53. 530  IF ID - INT(ID/4) *4 = 0  THEN RT = 16
  54. 540  IF DF <0  AND G1  THEN  XDRAW 7 AT OX,OY
  55. 550  IF DF >0  AND G1  THEN  XDRAW 8 AT OX,OY
  56. 560  ROT= RT:OX = X:OY = Y: IF DF <0  THEN ID = ID +1
  57. 570 G1 = FALSE: IF OX >7  AND OX <273  AND OY >7  AND OY <185  THEN G1 = TRUE
  58. 580  IF DF >0  AND G1  THEN  XDRAW 7 AT X,Y
  59. 590  IF DF <0  AND G1  THEN  XDRAW 8 AT X,Y
  60. 600  IF  PEEK( -16384) = 155  THEN I = F -1:EF = 1: POKE  -16368,0: GOSUB 1700: RETURN 
  61. 610  RETURN 
  62. 620  DIM LTD(50),LNG(50),XL(50),YL(50)
  63. 630  ONERR  GOTO 2660:IER = 0
  64. 640 TRUE = 1:FALSE = 0:MFLAG = FALSE
  65. 650 D$ =  CHR$(4): HCOLOR= 3: ROT= 0: SCALE= 1
  66. 660  GOTO 710
  67. 670  PRINT : PRINT : PRINT : HTAB 6: PRINT "PRESS <RETURN> TO CONTINUE";: GET Y$: PRINT : RETURN 
  68. 680  DRAW 1 AT 160,0: DRAW 2 AT 163,188: DRAW 3 AT 132,118: DRAW 4 AT 239,29: DRAW 6 AT 0,13
  69. 690  HPLOT 0,0 TO 279,0 TO 279,188 TO 0,188 TO 0,0
  70. 700  RETURN 
  71. 710  PRINT  CHR$(4);"BLOAD SH.BIG,A$1000": POKE 232,0: POKE 233,16: POKE  -16304,0: POKE  -16297,0: POKE  -16302,0: POKE 230,32: CALL 62450
  72. 720  GOSUB 680
  73. 730  FOR X = 768 TO 801: READ XX: POKE X,XX: NEXT : PRINT D$"BLOAD SH.ALPHA,A$900"
  74. 740  HOME : POKE  -16301,0: POKE 232,0: POKE 233,9: GOSUB 1170: POKE 233,16: HPLOT 0,159 TO 279,159: HOME : VTAB 22: PRINT "** COPYRIGHT 1985 BY MICROSPARC, INC **": VTAB 20: GOSUB 670: POKE  -16302,0
  75. 750 :
  76. 760  REM   ***MAIN MENU***
  77. 770 :
  78. 780 X =  FRE(0): REM    HOUSEKEEPING
  79. 790  TEXT : HOME : HTAB 5: INVERSE : PRINT "SERPENT'S COIL MAIN MENU": NORMAL : VTAB 5
  80. 800  PRINT "1.  BEGIN NEW HURRICANE FILE": PRINT 
  81. 810  PRINT "2.  UPDATE/EDIT CURRENT HURRICANE": PRINT 
  82. 820  PRINT "3.  LOAD HURRICANE FILE": PRINT 
  83. 830  PRINT "4.  PLOT MENU": PRINT 
  84. 840  PRINT "5.  QUIT"
  85. 850  INVERSE : VTAB 20: HTAB 1: PRINT "ENTER 1 - 5 ";: NORMAL : GET Y$: IF Y$ <"1"  OR Y$ >"5"  THEN  PRINT  CHR$(7);: GOTO 850
  86. 860  PRINT Y$;:Y =  VAL(Y$): ON Y GOTO 1260,1080,890,1450,870
  87. 870  HOME : VTAB 12: INPUT "ARE YOU SURE YOU WANT TO QUIT? (Y/N)";Y$: ON Y$ < >"Y" GOTO 780: HOME : END 
  88. 880 :
  89. 890  REM   ****UPDATE CURRENT HURRICANE****
  90. 900 :
  91. 910  HOME : VTAB 12
  92. 920  PRINT "NAME OF HURRICANE (? FOR CATALOG):": INPUT "";HU$:YH = FALSE
  93. 930  IF  LEFT$(HU$,2) = "H."  THEN HU$ =  MID$ (HU$,3)
  94. 940  IF  LEFT$(HU$,1) = "?"  THEN  HOME : PRINT D$"CATALOG": GOTO 920
  95. 950  IF HU$ = "" GOTO 780
  96. 960 DX = 2: PRINT D$"VERIFY H.";HU$
  97. 970 I = 0:ED = 0
  98. 980  PRINT D$;"OPEN H.";HU$
  99. 990  PRINT D$;"READ H.";HU$
  100. 1000  INPUT NAME$
  101. 1010  INPUT DA$
  102. 1020 I = I +1
  103. 1030  INPUT LTD(I)
  104. 1040  INPUT LNG(I)
  105. 1050  GOTO 1020
  106. 1060  PRINT D$;"CLOSE H."HU$
  107. 1070 F = I -1: IF YH = TRUE  THEN  GOTO 1450
  108. 1080  IF HU$ = ""  THEN  HOME : VTAB 12: PRINT  CHR$(7)"NO HURRICANE FILE HAS BEEN LOADED": PRINT : PRINT "PRESS <RETURN> TO RETURN TO MAIN MENU": GET Y$: PRINT : GOTO 780
  109. 1090  HOME : VTAB 12: PRINT "DO YOU WANT TO EDIT THE RECORDS?(Y/N)";: GET Y$: PRINT : IF Y$ = "Y"  THEN  GOSUB 1850
  110. 1100  IF   NOT ED GOTO 1130
  111. 1110  HOME : PRINT "SAVE IN FILE H.";HU$;: PRINT "(Y/N) ";: GET Y$: PRINT Y$: IF Y$ = "Y" GOTO 2450
  112. 1120  IF Y$ < >"N"  THEN 1110
  113. 1130  GOTO 1450
  114. 1140 :
  115. 1150  REM   ***OPENING SCREEN TITLE***
  116. 1160 :
  117. 1170 Y$ = "THE":X = 203:Y = 6: GOSUB 1220
  118. 1180 Y$ = "SERPENT":X = 189:Y = 8: GOSUB 1220:X = X +56:Y$ = "S": GOSUB 1220
  119. 1190 Y$ = "COIL":X = 203:Y = 10: GOSUB 1220
  120. 1200  HPLOT 238,60 TO 238,62
  121. 1210  RETURN 
  122. 1220  FOR I = 1 TO  LEN(Y$)
  123. 1230  DRAW  ASC( MID$ (Y$,I,1)) -64 AT X +(I -1) *7,Y *8
  124. 1240  NEXT I: RETURN 
  125. 1250 :
  126. 1260  REM   ***BEGIN NEW HURRICANE***
  127. 1270 :
  128. 1280 ED = 1: HOME : VTAB 15: INPUT "ENTER NEW HURRICANE NAME: ";HU$: IF HU$ = "" GOTO 780
  129. 1290 NAME$ = HU$: PRINT : INPUT "ENTER  DATE: ";DA$
  130. 1300  HOME : VTAB 23: INVERSE : PRINT "ENTER";: NORMAL : PRINT " <RETURN> TO TERMINATE": PRINT "ALLOWABLE RANGES:": PRINT "10.0 DEG N <= LATITUDE  <= 36.9 DEG N": PRINT "59.1 DEG W <= LONGITUDE <= 99.0 DEG W": VTAB 1: POKE 35,19
  131. 1310 K = 1
  132. 1320  PRINT "RECORD #";K
  133. 1330  INPUT "LATITUDE NORTH: ";A$: IF  VAL(A$) >0  THEN LTD(K) =  VAL(A$): GOTO 1350
  134. 1340 F = K -1: POKE 35,24: GOTO 1380
  135. 1350  INPUT "LONGITUDE WEST: ";A$:LNG(K) =  VAL(A$): IF LNG(K) = 0 GOTO 1340
  136. 1360  IF   NOT ((LTD(K) =  >10  AND LTD(K) < = 36.9)  AND (LNG(K) > = 59.1  AND LNG(K) < = 99))  THEN  GOSUB 1400: GOTO 1320
  137. 1370 K = K +1: HOME : GOTO 1320
  138. 1380  POKE 35,24: GOTO 1090
  139. 1390  GOTO 1110
  140. 1400  PRINT  CHR$(7): HOME : PRINT "THE ALLOWABLE RANGES FOR": PRINT "LATITUDE AND LONGITUDE ARE:": PRINT : PRINT : PRINT "10.0 DEG N <= LATITUDE  <= 36.9 DEG N": PRINT "59.1 DEG W <= LONGITUDE <= 99.0 DEG W"
  141. 1410  GOSUB 670: HOME : RETURN 
  142. 1420 :
  143. 1430  REM   ****PLOT MENU****
  144. 1440 :
  145. 1450  GOSUB 1690: IF   NOT MFLAG  THEN  GOSUB 1700
  146. 1460  HOME : VTAB 2: HTAB 7: INVERSE : PRINT "CHART PLOT MENU": NORMAL : VTAB 5
  147. 1470  PRINT "1. OVERLAY WITH 5 DEG X 5 DEG GRID ": PRINT 
  148. 1480  PRINT "2. PLOT THE STORM ": PRINT 
  149. 1490  IF   NOT MFLAG  THEN  PRINT "3. BEGIN MULTIPLE STORM PLOT": PRINT : GOTO 1510
  150. 1500  PRINT "3. TERMINATE MULTIPLE STORM PLOT": PRINT 
  151. 1510  PRINT "4. CLEAR FOR NEW PLOT"
  152. 1520  PRINT 
  153. 1530  PRINT "5. SAVE THE PICTURE ON DISK": PRINT 
  154. 1540  PRINT "6. DISPLAY MAP": PRINT 
  155. 1550  PRINT "7. MAIN MENU"
  156. 1560  INVERSE : VTAB 23: PRINT "PRESS <ESC> TO STOP PLOT": NORMAL 
  157. 1570  VTAB 21: HTAB 1: PRINT "ENTER 1 - 7 ";: NORMAL : GET Y$: IF Y$ <"1"  OR Y$ >"7"  THEN  PRINT  CHR$(7);: GOTO 1570
  158. 1580  PRINT Y$:Y =  VAL(Y$): GOSUB 1690
  159. 1590  ON Y GOTO 2350,1710,1600,1670,2130,1660,760
  160. 1600  IF MFLAG = FALSE  THEN MFLAG = TRUE: GOTO 1620
  161. 1610 MFLAG = FALSE
  162. 1620 :
  163. 1630  IF MFLAG  THEN  HOME : PRINT "NOTE:  THE MULTIPLE PLOT OPTION": PRINT "      DOES TWO THINGS - ": PRINT : PRINT : PRINT " 1. DISABLES AUTOMATIC CLEARING": PRINT "     OF THE STORM PLOT."
  164. 1640  IF MFLAG  THEN  PRINT : PRINT " 2. PREVENTS DISPLAYING STORM NAME": PRINT "    AND DATE": GOSUB 670
  165. 1650  GOTO 1460
  166. 1660  POKE  -16297,0: POKE  -16304,0: GOTO 480
  167. 1670  GOSUB 1700: GOTO 1460
  168. 1680  HOME : END 
  169. 1690  HOME : VTAB 12: HTAB 14: PRINT "WORKING...": RETURN 
  170. 1700  ROT= 0: POKE 230,64: POKE  -16297,0: CALL 62450: GOSUB 680: POKE 230,32: CALL 768: RETURN 
  171. 1710  IF HU$ = "" GOTO 1080
  172. 1720  IF F <2  THEN  HOME : TEXT : VTAB 12: PRINT "CURRENT HURRICANE FILE": PRINT "MUST HAVE MORE THAN ONE POINT.": PRINT : PRINT "PRESS <RETURN> FOR PLOT MENU": GET Z$: PRINT : GOTO 1450
  173. 1730  IF   NOT MFLAG  THEN  GOSUB 2180
  174. 1740  POKE  -16302,0: POKE  -16304,0: POKE  -16297,0
  175. 1750  FOR I = 1 TO F
  176. 1760  IF F < = 1  THEN I = F: NEXT : GOTO 780
  177. 1770  IF   NOT ((LTD(I) =  >10  AND LTD(I) < = 36.9)  AND (LNG(I) > = 59.1  AND LNG(I) < = 99))  THEN I = F: NEXT : TEXT : GOSUB 1400: GOTO 780
  178. 1780 XL(I) =  INT((99 -LNG(I)) *7)
  179. 1790 YL(I) =  INT((37 -LTD(I)) *7)
  180. 1800  NEXT I
  181. 1810  GOTO 130
  182. 1820 :
  183. 1830  REM   ****MINI EDITOR****
  184. 1840 :
  185. 1850 ED = 1: FOR I = F +1 TO 50:LTD(I) = 0:LNG(I) = 0: NEXT 
  186. 1860  POKE 34,2: VTAB 4
  187. 1870  HOME : PRINT " RECORD  LATITUDE  LONGITUDE "
  188. 1880  PRINT "   #      NORTH       WEST": PRINT : REM 3/6/7 SPACES
  189. 1890  FOR J = 1 TO F
  190. 1900 Y = J: GOSUB 2570:P$ = "  " +Y$
  191. 1910 Y = LTD(J): GOSUB 2610:P$ = P$ +"       " +Y$: REM 7 SPACES
  192. 1920 Y = LNG(J): GOSUB 2610:P$ = P$ +"       " +Y$: REM 7 SPACES
  193. 1930  PRINT P$
  194. 1940  IF (J - INT(J/16) *16) = 0  AND J < >F  THEN  INVERSE : HTAB 3: PRINT "PRESS <RETURN> FOR MORE";: NORMAL : GET Y$: PRINT 
  195. 1950  NEXT J
  196. 1960  GOSUB 670
  197. 1970  VTAB 24: POKE 35,23: INVERSE : PRINT "PRESS <RETURN> TO TERMINATE": NORMAL : VTAB 5
  198. 1980  HOME : PRINT : PRINT "EDIT RECORD # (A TO ADD TO END):": INPUT "";Y$:Y =  INT( VAL(Y$)): IF Y$ = "A"  THEN Y = F +1:F = Y: GOTO 2010
  199. 1990  IF Y$ = "" GOTO 2090
  200. 2000  IF Y <1  OR Y >F  THEN  PRINT  CHR$(7): GOTO 1980
  201. 2010  HTAB 30: INVERSE : PRINT LTD(Y);: NORMAL : HTAB 1: INPUT "LATITUDE NORTH: ";Y$
  202. 2020  IF Y$ = ""  THEN 2040
  203. 2030 LTD(Y) =  VAL(Y$)
  204. 2040  HTAB 30: INVERSE : PRINT LNG(Y);: NORMAL : HTAB 1: INPUT "LONGTITUDE WEST: ";Y$
  205. 2050  IF Y$ = ""  THEN 2070
  206. 2060 LNG(Y) =  VAL(Y$)
  207. 2070  IF   NOT ((LTD(Y) =  >10  AND LTD(Y) < = 36.9)  AND (LNG(Y) > = 59.1  AND LNG(Y) < = 99))  THEN  GOSUB 1400: GOTO 2010
  208. 2080  GOTO 1980
  209. 2090  PRINT "AGAIN?(Y/N) ";: GET Y$: PRINT 
  210. 2100  IF Y$ = "Y"  THEN  VTAB 24: CALL  -868: GOTO 1870
  211. 2110  POKE 34,0: POKE 35,24: HOME : RETURN 
  212. 2120  REM    ****SAVE PICTURE****
  213. 2130  HOME : VTAB 16: HTAB 5: INPUT "NAME OF FILE: ";HU$
  214. 2140  HOME : VTAB 16: HTAB 5: PRINT "NOW SAVING FILE ";HU$
  215. 2150 DX = 3: PRINT D$"BSAVE";HU$;",A$2000,L$2000"
  216. 2160  GOTO 1450
  217. 2170  REM    NAME AND DATE SECTION 
  218. 2180  POKE 232,0: POKE 233,9: POKE 230,64: ROT= 0
  219. 2190 LH =  LEN(NAME$):LD =  LEN(DA$):X = 5:Y = 170:LE = LH:Y$ = NAME$
  220. 2200  HCOLOR= 0:I = LH *7: IF LD >LH  THEN I = LD *7
  221. 2210  FOR J = 1 TO 22: HPLOT 1,165 +J TO I +3,165 +J: NEXT J: HCOLOR= 3
  222. 2220  HPLOT 1,165 TO I +3,165 TO I +3,188
  223. 2230  FOR K = 1 TO 2
  224. 2240  FOR J = 1 TO LE
  225. 2250 L =  ASC( MID$ (Y$,J,1))
  226. 2260  IF L > = 65  AND L < = 90  THEN  DRAW L -64 AT X,Y
  227. 2270  IF L > = 44  AND L < = 57  THEN  DRAW L -17 AT X,Y
  228. 2280 X = X +7
  229. 2290  NEXT J
  230. 2300 LE = LD:Y$ = DA$:Y = 180:X = 5
  231. 2310  NEXT K
  232. 2320  CALL 768: POKE 232,0: POKE 233,16: POKE 230,32
  233. 2330  RETURN 
  234. 2340  REM   ****GRID OVERLAY SECTION****
  235. 2350  POKE 230,64
  236. 2360  FOR J = 13 TO 153  STEP 35
  237. 2370  FOR I = 27 TO 272  STEP 35
  238. 2380  DRAW 5 AT I,J
  239. 2390  NEXT I
  240. 2400  NEXT J
  241. 2410  POKE 232,0: POKE 233,9: ROT= 0
  242. 2420  DRAW 39 AT 90,5: DRAW 36 AT 97,5: DRAW 23 AT 104,5: DRAW 38 AT 195,5: DRAW 31 AT 202,5: DRAW 23 AT 209,5: DRAW 37 AT 260,5: DRAW 31 AT 267,5: DRAW 23 AT 274,5
  243. 2430  DRAW 34 AT 4,48: DRAW 31 AT 11,48: DRAW 14 AT 18,48: DRAW 33 AT 4,117: DRAW 31 AT 11,117: DRAW 14 AT 18,117: POKE 233,16
  244. 2440  CALL 768: POKE 230,32: GOTO 1460
  245. 2450  REM ****HURRICANE DATA SAVE**** 
  246. 2460  PRINT D$;"OPEN H.";HU$
  247. 2470  PRINT D$;"WRITE H.";HU$
  248. 2480  PRINT HU$
  249. 2490  PRINT DA$
  250. 2500  FOR I = 1 TO F
  251. 2510  IF LTD(I) = 0  OR LNG(I) = 0 GOTO 2540
  252. 2520  PRINT LTD(I)
  253. 2530  PRINT LNG(I)
  254. 2540  NEXT I
  255. 2550  PRINT D$;"CLOSE H.";HU$
  256. 2560 ED = 0: GOTO 1450
  257. 2570  REM  ****FORMATTING INTEGERS****
  258. 2580 Y$ =  STR$(Y)
  259. 2590  IF  LEN(Y$) = 1  THEN Y$ = " " +Y$
  260. 2600  RETURN 
  261. 2610  REM  ****FORMATTING REAL NUMBERS****
  262. 2620 Y = Y *10
  263. 2630 Y$ =  STR$(Y)
  264. 2640 Y$ =  LEFT$(Y$,2) +"." + RIGHT$(Y$,1)
  265. 2650  RETURN 
  266. 2660 EE =  PEEK(222):EL =  PEEK(218) +256 * PEEK(219): CALL  -3288: IF EE = 5  THEN 1060
  267. 2670  IF EE = 255  THEN  TEXT : GOSUB 1700: GOTO 1450
  268. 2680  IF EE = 6  OR (EE = 16  AND DX = 2)  THEN  HOME : VTAB 12: PRINT  CHR$(7);"FILE H."HU$" DOES NOT EXIST": GOSUB 670:HU$ = "": GOTO 780
  269. 2690  TEXT : PRINT  CHR$(7);"ERROR # ";EE;" AT STATEMENT # ";EL;: CALL  -868: GOSUB 670: ON DX = 3 GOTO 1460: GOTO 780
  270. 2700  DATA 169,0,133,25,133,27,169,32,133,26,169,64,133,28,160,0,177,27,145,25,200,208,249,230,26,230,28,169,64,197,26,208,239,96