home *** CD-ROM | disk | FTP | other *** search
/ Nibble Magazine / nib22b.dsk / CREATE.bas < prev    next >
BASIC Source File  |  2023-02-26  |  11KB  |  251 lines

  1. 10  REM  ********1.16.85*********
  2. 20  REM  *       CREATE         *
  3. 30  REM  *    BY GARY KNOX      *
  4. 40  REM  *  COPYRIGHT (C) 1984  *
  5. 50  REM  *  BY MICROSPARC, INC  *
  6. 60  REM  *  CONCORD, MA. 01742  *
  7. 70  REM  ************************
  8. 80 :
  9. 90  REM ****SET UP ROUTINES****
  10. 100 D$ =  CHR$(4):R$ =  CHR$(13): TEXT : HOME 
  11. 110  IF  PEEK(2791) = 15  AND  PEEK(2793) = 32  AND  PEEK(104) = 64  THEN 140
  12. 120  VTAB 10: PRINT "ONE MOMENT.....": IF  PEEK(104) < >64  THEN  POKE 103,1: POKE 104,64: POKE 16384,0: PRINT D$"RUN CREATE"
  13. 130  PRINT D$"BLOAD SCRN": PRINT D$"BLOAD GOLF.SHAPES": POKE 232,231: POKE 233,10
  14. 140 DI = 3
  15. 150  DIM SX(50),SY(50),SH(50)
  16. 160  DIM N$(50),KQ(50),DI$(50)
  17. 170  HOME 
  18. 180  TEXT : VTAB 10: CALL  -868: INPUT "ENTER NAME OF THE COURSE ";N$: IF N$ = ""  THEN  PRINT  CHR$(4)"RUN GOLF"
  19. 190  REM  ****CHECK COURSE NAME****
  20. 200 N$ = "G" +N$
  21. 210  FOR I = 1 TO  LEN(N$): IF ( MID$ (N$,I,1) <"A"  OR  MID$ (N$,I,1) >"Z")  AND ( VAL( MID$ (N$,I,1)) = 0)  THEN  CALL  -958: PRINT "INVALID FILE NAME": GOTO 180
  22. 220  NEXT 
  23. 230  IF  LEN(N$) >7  THEN  CALL  -958: PRINT "COURSE NAME MAY BE NO LONGER THAN SIX   CHARACTERS": GOTO 180
  24. 240  ONERR  GOTO 2460
  25. 250  PRINT D$;"OPEN COURSE.LIST"
  26. 260  PRINT D$;"READ COURSE.LIST"
  27. 270  INPUT NUM: IF NUM = 0  THEN 350
  28. 280  FOR K = 1 TO NUM
  29. 290  INPUT M$,KQ
  30. 300  IF M$ < >N$  THEN 340
  31. 310  VTAB 15: PRINT "*** SORRY,COURSE " RIGHT$(N$, LEN(N$) -1): PRINT "*** IS ALREADY ON THE DISK."
  32. 320  PRINT "*** USE ANOTHER COURSE NAME."
  33. 330 F = 1: GOTO 350
  34. 340  NEXT K
  35. 350  PRINT D$;"CLOSE COURSE.LIST"
  36. 360  IF F = 1  THEN F = 0: GOTO 180
  37. 370 :
  38. 380  REM ****CREATE GOLF HOLE****
  39. 390 :
  40. 400  ONERR  GOTO 2350
  41. 410  HOME : VTAB 11: PRINT "(MAXIMUM OF 10)": VTAB 10: INPUT "ENTER NUMBER OF HOLES FOR THE COURSE";A$:H =  VAL(A$): IF H < = 0  OR H >10  THEN 410
  42. 420  PRINT : PRINT : PRINT "EACH HOLE REQUIRES ABOUT 36 SECTORS": PRINT "YOUR COURSE WILL REQUIRE ";H *36;" SECTORS.": PRINT : PRINT "CONTINUE? (Y/N)": GET K$: IF K$ < >"Y"  THEN  PRINT : PRINT  CHR$(4)"RUN GOLF"
  43. 430  FOR KQ = 1 TO H: HGR : GOSUB 1900
  44. 440 :
  45. 450  REM ****GET SHAPE DATA****
  46. 460 :
  47. 470  FOR K = 1 TO 6
  48. 480  READ S$,SN,SS,R,CLR
  49. 490  IF K >2  THEN  HOME : VTAB 22: PRINT "ANY "S$" ON HOLE "KQ" ?": VTAB 24: PRINT "ENTER Y OR N ";: GET A$: IF A$ = "N"  THEN 980
  50. 500  IF K >2  AND A$ < >"Y"  THEN 490
  51. 510  HOME : SCALE= SS: ROT= 0:QQ = SS:R = 0:F = 0
  52. 520  INVERSE 
  53. 530 :
  54. 540  REM ****PUT SHAPE ON SCREEN***
  55. 550 :
  56. 560  VTAB 22: HTAB (26 - LEN(S$))/2: PRINT "POSITION FOR THE "S$
  57. 570  NORMAL 
  58. 580  VTAB 23: INPUT "HOW MANY LINES FROM THE LEFT ";A$:LE =  VAL(A$)
  59. 590  VTAB 23: CALL  -868: INPUT "HOW MANY LINES FROM THE TOP ";A$:LT =  VAL(A$)
  60. 600 X = 10 *LE:Y = 10 *LT: IF X >260  OR Y >150  THEN  HOME : VTAB 21: INVERSE : PRINT "TRY AGAIN": NORMAL : GOTO 560
  61. 610  IF X < = 0  OR Y < = 0  THEN  HOME : VTAB 21: INVERSE : PRINT "TRY AGAIN": NORMAL : GOTO 560
  62. 620  ROT= R: XDRAW SN AT X,Y
  63. 630  HOME : VTAB 22: PRINT "CHANGE THE "S$" POSITION? Y/N ? ";: GET A$: IF A$ = "Y"  THEN  XDRAW SN AT X,Y: GOTO 510
  64. 640  IF A$ < >"N"  THEN 630
  65. 650 TX = X:TY = Y
  66. 660  IF K = 2  THEN  XDRAW SN AT X,Y: HCOLOR= CLR: DRAW SN AT X,Y: GOTO 910
  67. 670  IF K = 3  THEN  XDRAW SN AT X,Y: HCOLOR= CLR: DRAW SN AT X,Y: GOTO 910
  68. 680  IF K >3  THEN  XDRAW SN AT X,Y: HCOLOR= CLR: DRAW SN AT X,Y: GOTO 880
  69. 690 :
  70. 700  REM ****ROTATE TEE****
  71. 710 :
  72. 720  HOME : VTAB 21: HTAB (23 - LEN(S$))/2: INVERSE : PRINT "POSITION FOR THE "S$: NORMAL 
  73. 730  VTAB 22: CALL  -868: PRINT "R=CLOCKWISE E=CNTRCLOCKWISE F=FINISHED"
  74. 740  CALL  -868: HTAB 10: PRINT "C=CHANGE TEE POSITION"
  75. 750  XDRAW SN AT X,Y: ROT= R: XDRAW SN AT X,Y
  76. 760  HTAB 1: VTAB 24: CALL  -868: PRINT "PRESS KEY YOU WANT..";: GET A$
  77. 770  IF A$ = "F"  THEN 910
  78. 780  IF A$ = "R"  THEN R = R +8: GOTO 820
  79. 790  IF A$ = "E"  THEN R = R -8: GOTO 820
  80. 800  IF A$ = "C"  THEN  XDRAW SN AT X,Y: GOTO 510
  81. 810  GOTO 760
  82. 820  IF R <0  THEN R = 56
  83. 830  IF R >64  THEN R = 8
  84. 840  GOTO 750
  85. 850 :
  86. 860  REM ****MOVE SHAPE****
  87. 870 :
  88. 880  HOME :DI = DI -1: IF DI >0  THEN  POKE  -16303,0: GOSUB 1610: POKE  -16304,0: POKE  -16301,0: POKE  -16297,0
  89. 890 C = 0:TX = X:TY = Y:TI = 1
  90. 900  GOSUB 1690
  91. 910  IF K = 1  THEN XT = TX:YT = TY
  92. 920  IF K = 2  THEN XG = TX:YG = TY
  93. 930 ZZ =  FRE(0)
  94. 940  IF K <3  THEN 980
  95. 950  HOME : VTAB 23: PRINT "MORE "S$"S ? Y/N? ";: GET A$: IF A$ = "N"  THEN 980
  96. 960  IF A$ < >"Y"  THEN 950
  97. 970  GOTO 510
  98. 980  NEXT K
  99. 990 K = Q +1
  100. 1000 :
  101. 1010  REM ****ERASE BOUNDARY NUMBERS****
  102. 1020 :
  103. 1030  HCOLOR= 0
  104. 1040  FOR J = 151 TO 159: HPLOT 0,J TO 279,J: NEXT J: FOR J = 0 TO 159: HPLOT 263,J TO 279,J: NEXT J
  105. 1050  HOME : VTAB 21: PRINT "SAVING HOLE "KQ" ........."
  106. 1060 EL = 1
  107. 1070  ONERR  GOTO 2350
  108. 1080  PRINT : PRINT D$;"BSAVE"N$".HOLE"KQ",A$2000,L$1FFF"
  109. 1090  POKE  -16303,0: HOME :C = 0:F = 0
  110. 1100 :
  111. 1110  REM ****DETERMINE PAR****
  112. 1120 :
  113. 1130  VTAB 10: PRINT "TO HELP YOU DETERMINE 'PAR' FOR HOLE "KQ
  114. 1140  PRINT "YOU MUST MOVE THE GOLF BALL ALONG": PRINT "THE FAIRWAY TO THE GREEN."
  115. 1150  GOSUB 2020:C = 0:TI = 2
  116. 1160  POKE  -16304,0: POKE  -16301,0: POKE  -16297,0
  117. 1170 CLR = 3:SN = 5: SCALE= 1
  118. 1180 B$ = ""
  119. 1190 C = 0:X = XT:Y = YT:CX = 0:CY = 0
  120. 1200  GOSUB 1690
  121. 1210  POKE  -16303,0: HOME : RESTORE 
  122. 1220  VTAB 5: PRINT "THE DISTANCE TO HOLE # "KQ
  123. 1230  VTAB 8: HTAB 15:C =  INT(2.2 *C): PRINT C" YARDS"
  124. 1240  VTAB 12: INPUT "ENTER PAR YOU WANT FOR THIS HOLE:";A$:PAR =  VAL(A$): IF PAR < = 1  THEN  VTAB 22: PRINT "TRY AGAIN...": GOTO 1240
  125. 1250 :
  126. 1260  REM ****PUT DATA ON DISK****
  127. 1270 :
  128. 1280 EL = 2
  129. 1290  PRINT D$;"OPEN"N$"."KQ
  130. 1300  PRINT D$;"WRITE"N$"."KQ
  131. 1310  PRINT C;R$;PAR
  132. 1320  PRINT XT;R$;YT;R$;XG;R$;YG
  133. 1330  PRINT D$;"CLOSE"N$"."KQ
  134. 1340 Q = 0
  135. 1350  NEXT KQ
  136. 1360  TEXT : HOME : VTAB 10: PRINT "ONE MOMENT PLEASE....."
  137. 1370  IF NUM = 0  THEN NUM = NUM +1: GOTO 1470
  138. 1380 EL = 3
  139. 1390  PRINT D$;"OPEN COURSE.LIST"
  140. 1400  PRINT D$;"READ COURSE.LIST"
  141. 1410  INPUT NUM:NUM = NUM +1
  142. 1420  FOR K = 1 TO NUM -1
  143. 1430  INPUT N$(K),KQ(K)
  144. 1440  NEXT K
  145. 1450  PRINT D$;"CLOSE COURSE.LIST"
  146. 1460 EL = 4
  147. 1470  PRINT D$;"OPEN COURSE.LIST"
  148. 1480  PRINT D$;"WRITE COURSE.LIST"
  149. 1490  PRINT NUM
  150. 1500  IF NUM = 1  THEN 1540
  151. 1510  FOR K = 1 TO NUM -1
  152. 1520  PRINT N$(K);R$;KQ(K)
  153. 1530  NEXT K
  154. 1540  PRINT N$;R$;H
  155. 1550  PRINT D$;"CLOSE COURSE.LIST"
  156. 1560  TEXT : HOME : VTAB 10: PRINT "ONE MOMENT PLEASE....."
  157. 1570  PRINT D$;"RUN GOLF"
  158. 1580  REM ****ROUTINES****
  159. 1590  REM ****INSTRUCTIONS****
  160. 1600 :
  161. 1610  VTAB 5: PRINT "TO MOVE THE SHAPE USE THESE KEYS..": VTAB 8: PRINT "Q=MOVE UP AND LEFT": PRINT "W=MOVE UP": PRINT "E= MOVE UP AND RIGHT"
  162. 1620  PRINT "A=MOVE LEFT": PRINT "D=MOVE RIGHT": PRINT "Z= MOVE DOWN AND LEFT"
  163. 1630  PRINT "X=MOVE DOWN": PRINT "C=MOVE DOWN AND RIGHT": PRINT : PRINT "F=FINISHED MOVING ": PRINT "B=ERASE BY BACKING UP"
  164. 1640  GOSUB 2020
  165. 1650  RETURN 
  166. 1660 :
  167. 1670  REM ****DRAW ROUTINE****
  168. 1680 :
  169. 1690  INVERSE : VTAB 21: HTAB 16: PRINT "Q  W  E": NORMAL : PRINT "PRESS A KEY";: INVERSE : HTAB 16: PRINT "A     D": HTAB 16: PRINT "Z  X  C": NORMAL 
  170. 1700  PRINT "F = FINISHED      B = BACK UP AND ERASE";: VTAB 1
  171. 1710 B$ = ""
  172. 1720  GET A$
  173. 1730  IF A$ = "F"  THEN 1860
  174. 1740  GOSUB 2060
  175. 1750  IF A$ < >"B"  THEN 1790
  176. 1760  IF A$ = "B"  THEN  HCOLOR= 0: DRAW SN AT X,Y:C = C -1:F = 1
  177. 1770  IF C =  <0  THEN A$ = B$:B$ = "": GOTO 1740
  178. 1780 A$ =  RIGHT$(B$,1):B$ =  LEFT$(B$, LEN(B$) -1): GOTO 1740
  179. 1790  IF F = 0  OR TI = 2  THEN 1830
  180. 1800  HCOLOR= 0: DRAW SN AT X,Y:X = X -CX:Y = Y -CY: HCOLOR= CLR:F = 0
  181. 1810  DRAW SN AT X,Y
  182. 1820  GOTO 1720
  183. 1830  IF TI = 2  AND  LEN(B$) = 254  THEN B$ =  RIGHT$(B$, LEN(B$) -1): GOTO 1850
  184. 1840  IF  LEN(B$) = 254  THEN Q = Q +1:SX(Q) = X:SY(Q) = Y:TX = X:TY = Y:SH(Q) = SN:DI$(Q) = B$:B$ = ""
  185. 1850 C = C +1:X = X +CX:Y = Y +CY:B$ = B$ +A$: HCOLOR= CLR: DRAW SN AT X,Y: GOTO 1720
  186. 1860  RETURN 
  187. 1870 :
  188. 1880  REM ****DRAW BOUNDARY****
  189. 1890 :
  190. 1900  HCOLOR= 3: HPLOT 0,0 TO 0,150 TO 260,150 TO 260,0 TO 0,0: FOR KK = 0 TO 260  STEP 10: HPLOT KK,148 TO KK,152: HPLOT KK,0 TO KK,2: NEXT KK
  191. 1910  HPLOT 1,0 TO 1,150: HPLOT 259,150 TO 259,0
  192. 1920  FOR KK = 0 TO 150  STEP 10: HPLOT 0,KK TO 2,KK: HPLOT 258,KK TO 263,KK: NEXT KK
  193. 1930 :
  194. 1940  REM ****DRAW NUMBERS****
  195. 1950 :
  196. 1960  SCALE= 1: HCOLOR= 3
  197. 1970  FOR KK = 1 TO 39: READ RR,SN,XC,YC: ROT= RR: DRAW SN AT XC,YC: NEXT KK
  198. 1980  RETURN 
  199. 1990 :
  200. 2000  REM ****GET KEYPRESS****
  201. 2010 :
  202. 2020  VTAB 24: HTAB 5: PRINT "PRESS THE ";: INVERSE : PRINT "RETURN";: NORMAL : PRINT " KEY TO GO ON...";: GET A$: HOME : RETURN 
  203. 2030 :
  204. 2040  REM ****GET DRAWING MOVES****
  205. 2050 :
  206. 2060  IF A$ = "Q"  THEN CX =  -1:CY =  -1: GOTO 2140
  207. 2070  IF A$ = "W"  THEN CX = 0:CY =  -1: GOTO 2140
  208. 2080  IF A$ = "E"  THEN CX = 1:CY =  -1: GOTO 2140
  209. 2090  IF A$ = "A"  THEN CX =  -1:CY = 0: GOTO 2140
  210. 2100  IF A$ = "D"  THEN CX = 1:CY = 0: GOTO 2140
  211. 2110  IF A$ = "Z"  THEN CX =  -1:CY = 1: GOTO 2140
  212. 2120  IF A$ = "X"  THEN CX = 0:CY = 1: GOTO 2140
  213. 2130  IF A$ = "C"  THEN CX = 1:CY = 1: GOTO 2140
  214. 2140  RETURN 
  215. 2150  GOTO 250
  216. 2160 :
  217. 2170  REM ****NUMBER SHAPE DATA****
  218. 2180 :
  219. 2190  DATA 0,7,265,12,0,8,268,22,0, 9,265,32,0,10,268,42,0,11,265,52
  220. 2200  DATA 32,12,268,57,0,13,265,72,0,14,265,82,0,12,265,92,0,7,265,102
  221. 2210  DATA 0,6,269,102,0,7,265,112,0,7,270,112,0,7,265,122,0,8 ,273,122
  222. 2220  DATA 0,7,265,132,0,9 ,270,131,0,7,265,142,0,10,273,142,0,8,21,159
  223. 2230  DATA 0,10,41,159,32,12,61,152,0,14,80,159,0,7,98,159,0,6,101,159
  224. 2240  DATA 0,7,115,159,0,8,123,159,0,7,135,159,0,10,143,159,0,7,155,159
  225. 2250  DATA 32,12,163,152,0,7,175,159,0,14,181,159,0,8,199,159,0,6,201,159
  226. 2260  DATA 0,8,219,159,0,8,225,159,0,8,239,159,0,10,244,159
  227. 2270 :
  228. 2280  REM ****SHAPE DATA****
  229. 2290 :
  230. 2300  DATA  "TEE",2,1,  0,3,"GREEN",15,1,  0,6,"TREE",3,2  ,0,1,"ROUGH",4,2,  6,5  
  231. 2310  DATA    "SANDTRAP",4,2  ,0,7,"WATER",3,2  ,58,2   
  232. 2320 :
  233. 2330  REM *** DISK ERROR TRAP ***
  234. 2340 :
  235. 2350  CALL  -3288:ER =  PEEK(222)
  236. 2360  IF ER = 4  THEN  PRINT "DISK WRITE PROTECTED": GOTO 2430
  237. 2370  IF ER = 6  THEN  PRINT "FILE NOT FOUND": GOTO 2430
  238. 2380  IF ER = 8  THEN  PRINT "DISK I/O ERROR": GOTO 2430
  239. 2390  IF ER = 9  THEN  PRINT "DISK FULL": GOTO 2430
  240. 2400  IF ER = 10  THEN  PRINT "FILE LOCKED": GOTO 2430
  241. 2410  IF ER = 11  OR ER = 13  THEN  PRINT "FILE NAME ERROR": INPUT "ENTER A NEW FILE NAME";N$:N$ = "G" +N$
  242. 2420  PRINT "ERROR #";ER" IN LINE "; PEEK(218) + PEEK(219) *256
  243. 2430  PRINT "PRESS ANY KEY TO CONTINUE": GET K$: PRINT 
  244. 2440  ON EL GOTO 1050,1290,1360,1470
  245. 2450  GOTO 180
  246. 2460  CALL  -3288: PRINT D$"CLOSE": IF  PEEK(222) < >5  THEN  PRINT "DISK ERROR #"; PEEK(222): PRINT "PRESS A KEY TO TRY AGAIN": GET K$: PRINT : HOME : GOTO 180
  247. 2470  PRINT D$;"CLOSE COURSE.LIST"
  248. 2480  PRINT D$;"OPEN COURSE.LIST"
  249. 2490  PRINT D$;"WRITE COURSE.LIST"
  250. 2500  PRINT 0
  251. 2510  PRINT D$;"CLOSE COURSE.LIST": GOTO 250