home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Nibble Magazine
/
nib22b.dsk
/
CROSSWIND.bas
< prev
next >
Wrap
BASIC Source File
|
2023-02-26
|
9KB
|
228 lines
10 REM **********************
20 REM * *
30 REM * CROSSWIND *
40 REM * BY CARL FIELDS *
50 REM * COPYRIGHT (C) 1984 *
60 REM * BY MICROSPARC, INC *
70 REM * CONCORD, MA 01742 *
80 REM * *
90 REM **********************
100 REM
110 GOTO 1740: REM INITIALIZE
120 REM MAIN CALCULATION SUBR
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
140 FOR I = C(1) TO C(3):SP(C(6) +I) = INT(C(17) *SP(I) +C(11)): NEXT
150 HPLOT (00 +SP(7)),(00 +SP(8))
160 HPLOT (C(0) +SP(7)),(C(15) -SP(9))
170 HPLOT (C(16) -SP(8)),(C(15) -SP(9))
180 VL(4) = SQR((WV(1) -VL(1)) ^C(2) +(WV(2) -VL(2)) ^C(2) +(WV(3) -VL(3)) ^C(2))
190 FOR I = C(1) TO C(3)
200 XL(I) = GA(I) +IX *RD *VL(4) *(WV(I) -VL(I))
210 SP(I) = SP(I) +VL(I) *T1 +C(11) *XL(I) *T1 *T1
220 VL(I) = VL(I) +XL(I) *T1
230 NEXT
240 TM = TM +T1:TM = INT((TM +C1) *C(10))/C(10)
250 VTAB (23): HTAB (1): CALL -868
260 PRINT PX$(0);TM;: HTAB 20: PRINT PX$(14);: PRINT INT(SP(1) -SP(4) -C(10))
270 IF TM >C(11) AND SP(3) <C(1) GOTO 290
280 GOTO 130
290 AA = AA/C1:AV = AV/C1:WV(2) = -WV(2): RETURN
300 REM COMMAND PROMPT
310 HOME :J = FRE(0): VTAB (21): HTAB (1)
320 PRINT "VERT ANGLE = ";: PRINT INT(AV);" ";
330 PRINT "AZITH. ANGLE = "; INT(AA)
340 NN = WV(4)
350 PRINT "WIND VEL. = ";: PRINT INT(NN);" ";
360 IF WV(1) = 0 THEN WV(1) = .000001
370 NN = WV(5)
380 PRINT "WIND ANG. = ";: PRINT INT(NN)
390 PRINT "ENTER K, V, A, P, N, R, E, OR H (HELP)"
400 GET I$
410 IF I$ = "K" THEN GOSUB 520
420 IF I$ = "V" THEN GOSUB 1000
430 IF I$ = "A" THEN GOSUB 1030
440 IF I$ = "P" THEN GOSUB 690
450 IF I$ = "H" THEN GOSUB 1590
460 IF I$ = "N" THEN GOSUB 1070
470 IF I$ = "E" THEN TEXT : HOME : END
480 IF I$ = "R" THEN GOSUB 590
490 IF I$ < >"R" AND I$ < >"P" AND I$ < >"N" THEN VTAB 23: GOSUB 1720
500 IF I$ = "H" OR I$ = "P" THEN GOSUB 590
510 GOTO 300: REM END MAIN MENU
520 REM SET UP MAIN CALC
530 HOME :TM = 0:WV(2) = -WV(2)
540 SP(1) = 110 -SP(4)
550 SP(2) = SP(5):SP(6) = 1:SP(3) = 1
560 AA = AA *C1:AV = AV *C1
570 VL(1) = VL(0) * COS(AA) * COS(AV):VL(2) = VL(0) * SIN(AA) * -1 * COS(AV):VL(3) = VL(0) * SIN(AV)
580 GOSUB 130: RETURN
590 REM DRAW FIELD
600 HGR : HCOLOR= 3: HPLOT 0,80 TO 260,80: HPLOT 180,0 TO 180,159
610 HPLOT 0,160 TO 0,0 TO 180,0: HPLOT 0,159 TO 260,160
620 HPLOT 260,80 TO 260,160: HPLOT 216,155 TO 225,155
630 HPLOT 216,160 TO 216,140: HPLOT 225,160 TO 225,140
640 FOR I = 0 TO 4: HPLOT 0,(15 *I) TO 15,15 +(15 *I): NEXT
650 FOR I = 0 TO 4: HPLOT 165,(15 *I) TO 180,15 +(15 *I): NEXT
660 FOR J = 0 TO 180 STEP 15: HPLOT J,0 TO J,80
670 HPLOT J +1,36: HPLOT J +1,45
680 NEXT : RETURN
690 REM PARAMETER TABLE
700 TEXT : HOME : PRINT
710 PRINT TAB( 14);"PARAMETERS"
720 PRINT :T = 38
730 PL(1) = RG(3):PL(2) = RD:PL(3) = IX: REM LOAD TEMP ARRAY
740 PL(4) = MV:PL(5) = SP(4)
750 PL(6) = SP(5):PL(7) = VL(0)
760 FOR I = 1 TO 8: PRINT " ";I;". " +PX$(I); TAB( 36);
770 IF I = 3 THEN PRINT STR$(IX): GOTO 800
780 IF I = 8 THEN PRINT W$: GOTO 800
790 NN = PL(I): GOSUB 1560
800 NEXT
810 PRINT : PRINT : PRINT "ENTER NUMBER OF PARAMETER TO BE CHANGED"
820 PRINT "(ZERO FOR NO CHANGES) ";: INPUT "";QQ$
830 IF QQ$ = "0" GOTO 970
840 IF QQ$ = "8" THEN GOSUB 1450: GOTO 960
850 QQ = VAL(QQ$)
860 IF QQ <1 OR QQ >7 GOTO 700: REM CHECK
870 IF (QQ - INT(QQ)) < >0 GOTO 690
880 PRINT "ENTER NEW VALUE FOR: ": PRINT TAB( 10);PX$(QQ); TAB( 35)
890 GOSUB 1350
900 IF II > = LL(QQ) AND II < = UL(QQ) GOTO 930
910 PRINT PX$(15)
920 GOSUB 1720: GOTO 690
930 PL(QQ) = II
940 RG(3) = PL(1):RD = PL(2): REM UNLOAD
950 IX = PL(3):MV = PL(4):SP(4) = PL(5):SP(5) = PL(6):VL(0) = PL(7)
960 GOTO 690
970 IF FL = 1 THEN FL = 0: GOTO 990
980 GOSUB 590
990 RETURN
1000 REM NEW VERT. ANG. SUBR
1010 T = 18:I2 = 9:TP = AV: GOSUB 1270:AV = TP
1020 RETURN
1030 REM NEW AZITH. ANG. SUBR
1040 T = 18:I2 = 10:TP = AA
1050 GOSUB 1270:AA = TP
1060 RETURN
1070 REM NEW WIND VEL.
1080 TEXT : HOME
1090 IF W$ = "RND" THEN GOSUB 1150: GOTO 1140
1100 FOR J = 11 TO 12:TP = WV(J -7)
1110 I2 = J
1120 GOSUB 1270:WV(J -7) = TP: NEXT
1130 GOSUB 1400
1140 GOSUB 590: RETURN
1150 REM RANDOM WIND VEL.
1160 WV(5) = 360 * RND(2)
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
1180 WV(4) = MV * RND(3)
1190 GOSUB 1400
1200 T = 35
1210 PRINT "WIND VEL. CALCULATED USING ";QT$;"RND";QT$;" OPTION"
1220 NN = WV(4)
1230 PRINT PX$(11);: GOSUB 1560
1240 NN = WV(5)
1250 PRINT PX$(12);: GOSUB 1560
1260 GOSUB 1720: RETURN
1270 REM NUMBER INPUT SUBR
1280 PRINT : PRINT : PRINT "OPTION: CHANGE VALUE OF ";PX$(I2)
1290 NN = TP:T = 21
1300 PRINT "CURRENT VALUE = ";: GOSUB 1560
1310 PRINT "NEW VALUE = ";: GOSUB 1350
1320 IF II > = LL(I2) AND II = <UL(I2) THEN TP = II: GOTO 1340
1330 PRINT PX$(15): GOSUB 1720: GOTO 1270
1340 RETURN
1350 REM NUMERIC INPUT CHK SUBR
1360 ONERR GOTO 2110: REM SET ONERR ROUTINE
1370 INPUT "";II
1380 POKE 216,0: REM TURN OFF ONERR
1390 RETURN
1400 REM WIND VEL. COMPONENTS
1410 WV(1) = WV(4) * COS(WV(5) *C1):WV(2) = WV(4) * SIN(WV(5) *C1)
1420 IF WV(5) >180 THEN WV(5) = -360 +WV(5)
1430 IF WV(5) < -180 THEN WV(5) = 360 +WV(5)
1440 RETURN
1450 REM CHG. WIND VEL. SELECT. OPT.
1460 TEXT : HOME
1470 PRINT "CURRENT WIND VEL. SELECT MODE IS ";QT$;W$;QT$
1480 PRINT "DO YOU WANT TO CHANGE?"
1490 INPUT "";I$
1500 IF RIGHT$(I$,1) = "N" GOTO 1550
1510 IF RIGHT$(I$,1) = "Y" GOTO 1530
1520 GOTO 1450
1530 IF W$ = "RND" THEN W$ = "INP": GOTO 1550
1540 W$ = "RND"
1550 RETURN
1560 REM DEC. PT. PRINT SUBR
1570 P$ = RIGHT$( STR$( INT(NN +.005)) +"." + RIGHT$( STR$( INT((NN +100) *100 +.5)),2),100): POKE 36,T - LEN(P$): PRINT P$
1580 RETURN
1590 REM HELP SUBR
1600 TEXT : HOME
1610 PRINT TAB( 12)"MAIN MENU OPTIONS:": PRINT
1620 PRINT "K - KICK FOOTBALL"
1630 PRINT "V - CHANGE VERT. ANGLE"
1640 PRINT "A - CHANGE AZIMUTHAL ANGLE"
1650 PRINT "P - GO TO PARAMETER TABLE"
1660 PRINT "N - NEW WIND CONDITIONS"
1670 PRINT " (SELECTION MODE FROM PARM. LIST)"
1680 PRINT "R - REDRAWS FIELD"
1690 PRINT "E - END"
1700 PRINT "H - PRINTS THIS MESSAGE "
1710 RETURN
1720 REM PAUSE
1730 PRINT : PRINT "PRESS ANY KEY TO CONTINUE";: GET QX$: RETURN
1740 REM INITIALIZE
1750 NOTRACE : TEXT : HOME
1760 LOMEM: 16385
1770 DIM SP(9),WV(5),XL(3),VL(4),RG(3),GA(3),C(17)
1780 FOR I = 4 TO 6: READ SP(I): NEXT
1790 DATA 50,27,0
1800 RD = 1.0:IX = 0.012:AV = 45.
1810 FOR I = 0 TO 17: READ C(I): NEXT
1820 DATA 0,1,2,3,4,5,6,7,8,9,10,.5,53,120,110,159,261,1.5
1830 RG(3) = 1.0:C1 = 0.01745:VL(0) = 50.0:FL = 1
1840 W$ = "RND":QT$ = CHR$(34)
1850 DIM PL(9),LL(13),UL(13),PX$(15)
1860 GA(3) = -10.72:T1 = .1:MV = 18
1870 FOR I = 1 TO 12: READ PX$(I): NEXT
1880 DATA REL. GRAVITY (VERT.)
1890 DATA REL. AIR DENSITY
1900 DATA INTERACTION COEFFICIENT
1910 DATA MAX. WIND VEL.
1920 DATA INIT. DOWNFIELD DISTANCE
1930 DATA INIT. CROSSFIELD DISTANCE
1940 DATA INITIAL KICK VELOCITY
1950 DATA WIND VELOCITY SELECTOR
1960 DATA VERTICAL ANGLE
1970 DATA AZIMUTHAL ANGLE
1980 DATA WIND VEL.
1990 DATA WIND ANGLE
2000 PX$(0) = "TIME = ":PX$(14) = "DISTANCE = "
2010 PX$(15) = "ENTRY OUT OF ALLOWED RANGE"
2020 FOR I = 1 TO 12
2030 READ LL(I): READ UL(I): NEXT
2040 DATA 0,1E37,0,1000,0,1000,00000,1000
2050 DATA 0,100,0,53
2060 DATA 0000,+150,0,0,0,180,-360,360
2070 DATA 0000,+1000,-360,360
2080 GOSUB 2160: GOSUB 1720
2090 GOSUB 1590: GOSUB 1720
2100 GOSUB 1070: GOTO 300
2110 REM ERROR TRAPPER
2120 L = PEEK(222): IF L = 69 THEN PRINT "ENTRY TOO LARGE -- RE-ENTER": RESUME
2130 IF L = 254 THEN PRINT "IMPROPER ENTRY -- RE-ENTER": RESUME
2140 PRINT "UNTRAPPABLE ERROR IN LINE"; PEEK(218) + PEEK(219) *256
2150 END
2160 REM PROGM. DESC.
2170 PRINT : HTAB (16)
2180 INVERSE : PRINT "CROSSWIND"
2190 NORMAL : PRINT : PRINT TAB( 13)"BY CARL FIELDS"
2200 PRINT : PRINT "CROSSWIND SIMULATES KICKING A FOOTBALL"
2210 PRINT "ON A WINDY DAY. THE MAIN SCREEN"
2220 PRINT "DISPLAY IS A THREE-VIEW DRAWING OF THE"
2230 PRINT "FIELD. A 'HELP' MESSAGE IS AVAILABLE"
2240 PRINT "TO DESCRIBE OPTIONS FROM THIS MAIN"
2250 PRINT "DISPLAY. ADDITIONAL PROGRAM PARAMETERS"
2260 PRINT "CAN BE CHANGED FROM A SPECIAL MENU."
2270 PRINT : PRINT "THE 'HELP' MESSAGE IS GIVEN NEXT.": PRINT : PRINT "** COPYRIGHT 1984 BY MICROSPARC, INC. **": PRINT
2280 RETURN