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

  1. 10  REM  **********************
  2. 20  REM  *                    *
  3. 30  REM  *     CROSSWIND      *
  4. 40  REM  * BY CARL FIELDS     *
  5. 50  REM  * COPYRIGHT (C) 1984 *
  6. 60  REM  * BY MICROSPARC, INC *
  7. 70  REM  * CONCORD, MA  01742 *
  8. 80  REM  *                    *
  9. 90  REM  **********************
  10. 100  REM 
  11. 110  GOTO 1740: REM INITIALIZE
  12. 120  REM  MAIN CALCULATION SUBR
  13. 130  IF SP(1) <C(0)  OR SP(1) >C(13)  OR SP(2) <C(0)  OR SP(2) >C(12)  OR SP(3) >C(13) GOTO 180
  14. 140  FOR I = C(1) TO C(3):SP(C(6) +I) =  INT(C(17) *SP(I) +C(11)): NEXT 
  15. 150  HPLOT (00 +SP(7)),(00 +SP(8))
  16. 160  HPLOT (C(0) +SP(7)),(C(15) -SP(9))
  17. 170  HPLOT (C(16) -SP(8)),(C(15) -SP(9))
  18. 180 VL(4) =  SQR((WV(1) -VL(1)) ^C(2) +(WV(2) -VL(2)) ^C(2) +(WV(3) -VL(3)) ^C(2))
  19. 190  FOR I = C(1) TO C(3)
  20. 200 XL(I) = GA(I) +IX *RD *VL(4) *(WV(I) -VL(I))
  21. 210 SP(I) = SP(I) +VL(I) *T1 +C(11) *XL(I) *T1 *T1
  22. 220 VL(I) = VL(I) +XL(I) *T1
  23. 230  NEXT 
  24. 240 TM = TM +T1:TM =  INT((TM +C1) *C(10))/C(10)
  25. 250  VTAB (23): HTAB (1): CALL  -868
  26. 260  PRINT PX$(0);TM;: HTAB 20: PRINT PX$(14);: PRINT  INT(SP(1) -SP(4) -C(10))
  27. 270  IF TM >C(11)  AND SP(3) <C(1) GOTO 290
  28. 280  GOTO 130
  29. 290 AA = AA/C1:AV = AV/C1:WV(2) =  -WV(2): RETURN 
  30. 300  REM  COMMAND PROMPT
  31. 310  HOME :J =  FRE(0): VTAB (21): HTAB (1)
  32. 320  PRINT "VERT ANGLE = ";: PRINT  INT(AV);"  ";
  33. 330  PRINT "AZITH. ANGLE = "; INT(AA)
  34. 340 NN = WV(4)
  35. 350  PRINT "WIND VEL.  = ";: PRINT  INT(NN);"  ";
  36. 360  IF WV(1) = 0  THEN WV(1) = .000001
  37. 370 NN = WV(5)
  38. 380  PRINT "WIND ANG.    = ";: PRINT  INT(NN)
  39. 390  PRINT "ENTER K, V, A, P, N, R, E, OR H (HELP)"
  40. 400  GET I$
  41. 410  IF I$ = "K"  THEN  GOSUB 520
  42. 420  IF I$ = "V"  THEN  GOSUB 1000
  43. 430  IF I$ = "A"  THEN  GOSUB 1030
  44. 440  IF I$ = "P"  THEN  GOSUB 690
  45. 450  IF I$ = "H"  THEN  GOSUB 1590
  46. 460  IF I$ = "N"  THEN  GOSUB 1070
  47. 470  IF I$ = "E"  THEN  TEXT : HOME : END 
  48. 480  IF I$ = "R"  THEN  GOSUB 590
  49. 490  IF I$ < >"R"  AND I$ < >"P"  AND I$ < >"N"  THEN  VTAB 23: GOSUB 1720
  50. 500  IF I$ = "H"  OR I$ = "P"  THEN  GOSUB 590
  51. 510  GOTO 300: REM END MAIN MENU
  52. 520  REM SET UP MAIN CALC
  53. 530  HOME :TM = 0:WV(2) =  -WV(2)
  54. 540 SP(1) = 110 -SP(4)
  55. 550 SP(2) = SP(5):SP(6) = 1:SP(3) = 1
  56. 560 AA = AA *C1:AV = AV *C1
  57. 570 VL(1) = VL(0) * COS(AA) * COS(AV):VL(2) = VL(0) * SIN(AA) * -1 * COS(AV):VL(3) = VL(0) * SIN(AV)
  58. 580  GOSUB 130: RETURN 
  59. 590  REM DRAW FIELD
  60. 600  HGR : HCOLOR= 3: HPLOT 0,80 TO 260,80: HPLOT 180,0 TO 180,159
  61. 610  HPLOT 0,160 TO 0,0 TO 180,0: HPLOT 0,159 TO 260,160
  62. 620  HPLOT 260,80 TO 260,160: HPLOT 216,155 TO 225,155
  63. 630  HPLOT 216,160 TO 216,140: HPLOT 225,160 TO 225,140
  64. 640  FOR I = 0 TO 4: HPLOT 0,(15 *I) TO 15,15 +(15 *I): NEXT 
  65. 650  FOR I = 0 TO 4: HPLOT 165,(15 *I) TO 180,15 +(15 *I): NEXT 
  66. 660  FOR J = 0 TO 180  STEP 15: HPLOT J,0 TO J,80
  67. 670  HPLOT J +1,36: HPLOT J +1,45
  68. 680  NEXT : RETURN 
  69. 690  REM PARAMETER TABLE
  70. 700  TEXT : HOME : PRINT 
  71. 710  PRINT  TAB( 14);"PARAMETERS"
  72. 720  PRINT :T = 38
  73. 730 PL(1) = RG(3):PL(2) = RD:PL(3) = IX: REM LOAD TEMP ARRAY
  74. 740 PL(4) = MV:PL(5) = SP(4)
  75. 750 PL(6) = SP(5):PL(7) = VL(0)
  76. 760  FOR I = 1 TO 8: PRINT " ";I;". " +PX$(I); TAB( 36);
  77. 770  IF I = 3  THEN  PRINT  STR$(IX): GOTO 800
  78. 780  IF I = 8  THEN  PRINT W$: GOTO 800
  79. 790 NN = PL(I): GOSUB 1560
  80. 800  NEXT 
  81. 810  PRINT : PRINT : PRINT "ENTER NUMBER OF PARAMETER TO BE CHANGED"
  82. 820  PRINT "(ZERO FOR NO CHANGES) ";: INPUT "";QQ$
  83. 830  IF QQ$ = "0" GOTO 970
  84. 840  IF QQ$ = "8"  THEN  GOSUB 1450: GOTO 960
  85. 850 QQ =  VAL(QQ$)
  86. 860  IF QQ <1  OR QQ >7 GOTO 700: REM  CHECK
  87. 870  IF (QQ - INT(QQ)) < >0 GOTO 690
  88. 880  PRINT "ENTER NEW VALUE FOR: ": PRINT  TAB( 10);PX$(QQ); TAB( 35)
  89. 890  GOSUB 1350
  90. 900  IF II > = LL(QQ)  AND II < = UL(QQ) GOTO 930
  91. 910  PRINT PX$(15)
  92. 920  GOSUB 1720: GOTO 690
  93. 930 PL(QQ) = II
  94. 940 RG(3) = PL(1):RD = PL(2): REM UNLOAD
  95. 950 IX = PL(3):MV = PL(4):SP(4) = PL(5):SP(5) = PL(6):VL(0) = PL(7)
  96. 960  GOTO 690
  97. 970  IF FL = 1  THEN FL = 0: GOTO 990
  98. 980  GOSUB 590
  99. 990  RETURN 
  100. 1000  REM NEW VERT. ANG. SUBR
  101. 1010 T = 18:I2 = 9:TP = AV: GOSUB 1270:AV = TP
  102. 1020  RETURN 
  103. 1030  REM NEW AZITH. ANG. SUBR
  104. 1040 T = 18:I2 = 10:TP = AA
  105. 1050  GOSUB 1270:AA = TP
  106. 1060  RETURN 
  107. 1070  REM NEW WIND VEL.
  108. 1080  TEXT : HOME 
  109. 1090  IF W$ = "RND"  THEN  GOSUB 1150: GOTO 1140
  110. 1100  FOR J = 11 TO 12:TP = WV(J -7)
  111. 1110 I2 = J
  112. 1120  GOSUB 1270:WV(J -7) = TP: NEXT 
  113. 1130  GOSUB 1400
  114. 1140  GOSUB 590: RETURN 
  115. 1150  REM RANDOM WIND VEL.
  116. 1160 WV(5) = 360 * RND(2)
  117. 1170 TP =  RND(2): IF ((WV(5) <45)  OR (WV(5) >135  AND WV(5) <225)  OR (WV(5) >315))  AND TP >.4  THEN  GOTO 1160
  118. 1180 WV(4) = MV * RND(3)
  119. 1190  GOSUB 1400
  120. 1200 T = 35
  121. 1210  PRINT "WIND VEL. CALCULATED USING ";QT$;"RND";QT$;" OPTION"
  122. 1220 NN = WV(4)
  123. 1230  PRINT PX$(11);: GOSUB 1560
  124. 1240 NN = WV(5)
  125. 1250  PRINT PX$(12);: GOSUB 1560
  126. 1260  GOSUB 1720: RETURN 
  127. 1270  REM NUMBER INPUT SUBR
  128. 1280  PRINT : PRINT : PRINT "OPTION: CHANGE VALUE OF ";PX$(I2)
  129. 1290 NN = TP:T = 21
  130. 1300  PRINT "CURRENT VALUE = ";: GOSUB 1560
  131. 1310  PRINT "NEW VALUE     = ";: GOSUB 1350
  132. 1320  IF II > = LL(I2)  AND II =  <UL(I2)  THEN TP = II: GOTO 1340
  133. 1330  PRINT PX$(15): GOSUB 1720: GOTO 1270
  134. 1340  RETURN 
  135. 1350  REM NUMERIC INPUT CHK SUBR
  136. 1360  ONERR  GOTO 2110: REM SET ONERR ROUTINE
  137. 1370  INPUT "";II
  138. 1380  POKE 216,0: REM TURN OFF ONERR
  139. 1390  RETURN 
  140. 1400  REM WIND VEL. COMPONENTS
  141. 1410 WV(1) = WV(4) * COS(WV(5) *C1):WV(2) = WV(4) * SIN(WV(5) *C1)
  142. 1420  IF WV(5) >180  THEN WV(5) =  -360 +WV(5)
  143. 1430  IF WV(5) < -180  THEN WV(5) = 360 +WV(5)
  144. 1440  RETURN 
  145. 1450  REM CHG. WIND VEL. SELECT. OPT.
  146. 1460  TEXT : HOME 
  147. 1470  PRINT "CURRENT WIND VEL. SELECT MODE IS ";QT$;W$;QT$
  148. 1480  PRINT "DO YOU WANT TO CHANGE?"
  149. 1490  INPUT "";I$
  150. 1500  IF  RIGHT$(I$,1) = "N" GOTO 1550
  151. 1510  IF  RIGHT$(I$,1) = "Y" GOTO 1530
  152. 1520  GOTO 1450
  153. 1530  IF W$ = "RND"  THEN W$ = "INP": GOTO 1550
  154. 1540 W$ = "RND"
  155. 1550  RETURN 
  156. 1560  REM DEC. PT. PRINT SUBR
  157. 1570 P$ =  RIGHT$( STR$( INT(NN +.005)) +"." + RIGHT$( STR$( INT((NN +100) *100 +.5)),2),100): POKE 36,T - LEN(P$): PRINT P$
  158. 1580  RETURN 
  159. 1590  REM HELP SUBR
  160. 1600  TEXT : HOME 
  161. 1610  PRINT  TAB( 12)"MAIN MENU OPTIONS:": PRINT 
  162. 1620  PRINT "K - KICK FOOTBALL"
  163. 1630  PRINT "V - CHANGE VERT. ANGLE"
  164. 1640  PRINT "A - CHANGE AZIMUTHAL ANGLE"
  165. 1650  PRINT "P - GO TO PARAMETER TABLE"
  166. 1660  PRINT "N - NEW WIND CONDITIONS"
  167. 1670  PRINT "    (SELECTION MODE FROM PARM. LIST)"
  168. 1680  PRINT "R - REDRAWS FIELD"
  169. 1690  PRINT "E - END"
  170. 1700  PRINT "H - PRINTS THIS MESSAGE "
  171. 1710  RETURN 
  172. 1720  REM PAUSE
  173. 1730  PRINT : PRINT "PRESS ANY KEY TO CONTINUE";: GET QX$: RETURN 
  174. 1740  REM INITIALIZE
  175. 1750  NOTRACE : TEXT : HOME 
  176. 1760  LOMEM: 16385
  177. 1770  DIM SP(9),WV(5),XL(3),VL(4),RG(3),GA(3),C(17)
  178. 1780  FOR I = 4 TO 6: READ SP(I): NEXT 
  179. 1790  DATA 50,27,0
  180. 1800 RD = 1.0:IX = 0.012:AV = 45.
  181. 1810  FOR I = 0 TO 17: READ C(I): NEXT 
  182. 1820  DATA  0,1,2,3,4,5,6,7,8,9,10,.5,53,120,110,159,261,1.5
  183. 1830 RG(3) = 1.0:C1 = 0.01745:VL(0) = 50.0:FL = 1
  184. 1840 W$ = "RND":QT$ =  CHR$(34)
  185. 1850  DIM PL(9),LL(13),UL(13),PX$(15)
  186. 1860 GA(3) =  -10.72:T1 = .1:MV = 18
  187. 1870  FOR I = 1 TO 12: READ PX$(I): NEXT 
  188. 1880  DATA REL. GRAVITY (VERT.)
  189. 1890  DATA REL. AIR DENSITY
  190. 1900  DATA INTERACTION COEFFICIENT
  191. 1910  DATA  MAX. WIND VEL.
  192. 1920  DATA INIT. DOWNFIELD DISTANCE
  193. 1930  DATA INIT. CROSSFIELD DISTANCE
  194. 1940  DATA INITIAL KICK VELOCITY
  195. 1950  DATA WIND VELOCITY SELECTOR
  196. 1960  DATA VERTICAL ANGLE
  197. 1970  DATA AZIMUTHAL ANGLE
  198. 1980  DATA WIND VEL.
  199. 1990  DATA WIND ANGLE
  200. 2000 PX$(0) = "TIME = ":PX$(14) = "DISTANCE = "
  201. 2010 PX$(15) = "ENTRY OUT OF ALLOWED RANGE"
  202. 2020  FOR I = 1 TO 12
  203. 2030  READ LL(I): READ UL(I): NEXT 
  204. 2040  DATA  0,1E37,0,1000,0,1000,00000,1000
  205. 2050  DATA 0,100,0,53
  206. 2060  DATA  0000,+150,0,0,0,180,-360,360
  207. 2070  DATA    0000,+1000,-360,360
  208. 2080  GOSUB 2160: GOSUB 1720
  209. 2090  GOSUB 1590: GOSUB 1720
  210. 2100  GOSUB 1070: GOTO 300
  211. 2110  REM ERROR TRAPPER
  212. 2120 L =  PEEK(222): IF L = 69  THEN  PRINT "ENTRY TOO LARGE -- RE-ENTER": RESUME 
  213. 2130  IF L = 254  THEN  PRINT "IMPROPER ENTRY -- RE-ENTER": RESUME 
  214. 2140  PRINT "UNTRAPPABLE ERROR IN LINE"; PEEK(218) + PEEK(219) *256
  215. 2150  END 
  216. 2160  REM PROGM. DESC.
  217. 2170  PRINT : HTAB (16)
  218. 2180  INVERSE : PRINT "CROSSWIND"
  219. 2190  NORMAL : PRINT : PRINT  TAB( 13)"BY CARL FIELDS"
  220. 2200  PRINT : PRINT "CROSSWIND SIMULATES KICKING A FOOTBALL"
  221. 2210  PRINT "ON A WINDY DAY.  THE MAIN SCREEN"
  222. 2220  PRINT "DISPLAY IS A THREE-VIEW DRAWING OF THE"
  223. 2230  PRINT "FIELD.  A 'HELP' MESSAGE IS AVAILABLE"
  224. 2240  PRINT "TO DESCRIBE OPTIONS FROM THIS MAIN"
  225. 2250  PRINT "DISPLAY.  ADDITIONAL PROGRAM PARAMETERS"
  226. 2260  PRINT "CAN BE CHANGED FROM A SPECIAL MENU."
  227. 2270  PRINT : PRINT "THE 'HELP' MESSAGE IS GIVEN NEXT.": PRINT : PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **": PRINT 
  228. 2280  RETURN