Chestnut's Multimedia Mania/MM_MANIA.ISO/games/stars/stars.bas

BASIC Source File | 1991-09-26 | 8KB | 131 lines

1 ON ERROR GOTO 2
2 IF PEEK(&H10) = 1 THEN CLS : PRINT "Program requires EGA color": END
10 DIM x(4576), y(4576): RANDOMIZE TIMER + VAL(MID$(DATE$, 4, 2))
11 ON ERROR GOTO 60100
12 GOTO 30000
13 IF rv > 995 THEN co = 14: RETURN
14 IF rv > 985 THEN co = 9: RETURN
15 IF rv > 970 THEN co = 12: RETURN
16 co = 11: RETURN
20 SCREEN 9, , 1, 1: CLS
30 PSET (INT(RND * 640), INT(RND * 350))
35 FOR x = 1 TO 25: PRESET (INT(RND * 640), INT(RND * 350)): NEXT x
40 IF INKEY$ > "" THEN RETURN ELSE 30
1000 'weighted
1005 pi = 3.14159: rc = pi / 180'define pi and radian converter
1010 GOSUB 17000
1090 SCREEN 9, , 0, 0: CLS : LOCATE 8, 24: PRINT "Press <1> Change preset parameters": LOCATE 10, 24: PRINT "Press <ENTER> to continue"
1100 i$ = INKEY$: z9 = VAL(i$): IF i$ = "1" THEN GOSUB 15000: GOTO 1120 ELSE IF i$ <> CHR$(13) THEN 1100
1110 GOSUB 15110'load array, buffer in original text
1120 GOSUB 19000: IF doit = 1 THEN GOSUB 50000
1205 strs = 1: time = TIMER: t1 = 0: t0 = 0
1210 FOR sr = 1 TO 4575
1215 nb = INT(RND * sr) + 1: IF sr = 1 THEN nb = 0
1216 IF ff = 1 THEN nb = INT(RND * 4575) + 1
1220 nx = nb: ny = nb
1300 'gets angle
1305 an = RND * 361
1310 an = an * (pi / 180)'convert to radians
1400 'gets radial distance
1410 ds = (RND * 65315) + 1
1420 ds = rg * 640 * 1 / SQR(ds)'ds=rg*(640-sqr(ds)):ds=rg*sqr(ds)'ds=rg*log(ds)
1500 'convert polar to cartesian
1510 xx = ds * COS(an)
1520 yy = ds * SIN(an)
1530 xa = xa + xx: ya = ya + yy: i = i + 1
1550 x = xx + x(nx): y = yy + y(ny)
1600 'trap off-screen values
1605 x1 = x1 + x: y1 = y1 + x
1610 IF x < 0 OR y < 0 THEN 1215
1620 IF x > 640 OR y > 350 THEN 1215
1700 'record coordinates of a new point
1710 x(sr) = x: y(sr) = y
1800 'display new point
1805 xp = xp + x: yp = yp + y: ii = ii + 1
1808 co = 15: rv = RND * 1000: IF rv > 950 THEN GOSUB 13
1810 PSET (x, y), co
1820 IF cu = 1 THEN PRESET (x(sr + 1), y(sr + 1)), 0
1830 IF INKEY$ <> "" THEN t1 = t1 + ((TIMER - time)): t0 = t0 + ((TIMER - time) / 60): GOSUB 14000: time = TIMER
1840 NEXT sr: IF time > TIMER THEN time = 0
1900 t1 = t1 + ((TIMER - time)): t0 = t0 + ((TIMER - time) / 60)
1910 ge = ge + 1
1920 pn = pn + 1: IF doit = 1 AND pn >= gs THEN GOSUB 50000
1930 ff = 1: SOUND 3000, .1
1940 time = TIMER: GOTO 1210
14000 'interupt
14030 SCREEN 9, , 0, 0: CLS
14080 LOCATE 2, 2: PRINT "Intrupt after"; ge; "generations": IF ge = o THEN 14125
14085 PRINT : PRINT USING "Total calculating time " + STRING$(LEN(STR$(INT(t0))), "#"); INT(t0); : PRINT USING ".##"; (t1 - (INT(t1))) / 1.6666666666#
14095 PRINT : PRINT USING "   Time per generation " + STRING$(LEN(STR$(INT(t1 / ge / 60))), "#"); INT(t1 / ge / 60); : PRINT USING ".##"; (t1 - (INT(t1))) / 1.6666666666#
14125 PRINT : PRINT "Screen widths = Infinity"
14127 PRINT : PRINT "  Mean drift X"; xa / i, "Y"; ya / i
14131 PRINT : PRINT "    Mean cal X"; INT(x1 / i), "Y"; INT(y1 / i)
14135 PRINT : PRINT "Mean plotted X"; INT(xp / ii), "Y"; INT(yp / ii)
14139 PRINT : PRINT "Plotted points"; ii; " rejects"; i - ii
14140 PRINT : PRINT "Press <1> to change parameters": PRINT "      <2> Continue as is": PRINT "      <3> Exit the program": PRINT "Press choice <1 or 3>"
14150 i$ = INKEY$: z9 = VAL(i$): IF i$ = "" THEN 14150 ELSE IF z9 < 1 OR z9 > 3 THEN 14150
14160 ON z9 GOSUB 15000, 14410, 14500
14400 SCREEN 9, , 1, 1
14410 RETURN
14500 GOSUB 60000: GOTO 14000
15000 SCREEN 9, , 0, 0: CLS : LOCATE 8, 25: PRINT "Current interaction radius ="; rg
15010 LOCATE 10, 32: INPUT "Change to"; rg$
15020 IF VAL(rg$) > 0 THEN rg = VAL(rg$)
15050 CLS : SCREEN 9, , 0, 0: LOCATE 8, 5: PRINT "Press <1> to unplot `dying' stars (pixels). Otherwise they remain on screen": LOCATE 10, 26: PRINT "<ANY OTHER KEY> to continue"
15060 i$ = INKEY$: IF i$ = "1" THEN cu = 1 ELSE IF i$ = "" THEN 15060
15070 CLS : SCREEN 9, , 0, 0: LOCATE 8, 11: PRINT "Normally press <1>. This causes new points to be calculated": LOCATE 9, 11: PRINT "as a probability function of the whole array"
15080 i$ = INKEY$: IF i$ = "1" THEN ff = 1 ELSE IF i$ = "" THEN 15080
15090 CLS : SCREEN 9, , 0, 0: LOCATE 8, 12: PRINT "Press <1> for auto storage to disk, <ANY OTHER KEY> to continue"
15100 i$ = INKEY$: IF i$ = "1" THEN doit = 1: GOSUB 45000 ELSE IF i$ = "" THEN 15100
15110 CLS : SCREEN 9, , 0, 0: LOCATE 8, 16: PRINT "<1> Formation of clusters from random distribution": LOCATE 10, 16: PRINT "<2> Growth from fixed points": IF strs = 1 THEN 15150
15115 LOCATE 12, 29: PRINT "Press choice <1 or 2>"
15120 i$ = INKEY$: rd = VAL(i$): IF rd <> 1 AND rd <> 2 THEN 15120
15130 ON rd GOSUB 18200, 18500, 15180
15140 SCREEN 9, , 1, 1: CLS : RETURN
15150 LOCATE 12, 16: PRINT "<3> Continue with current option": LOCATE 14, 29: PRINT "Press choice <1 to 3>:"
15160 i$ = INKEY$: rd = VAL(i$): IF rd < 1 OR rd > 3 THEN 15160
15170 ON rd GOSUB 18200, 18500, 15190
15175 GOTO 15140
15180 SCREEN 9, , 1, 1: RETURN
15190 RETURN 15180
17000 'record coordinates of a new point
17100 rg = 2: cu = 1: RETURN
18200 ff = 1'random array
18210 strs = 0: CLS : SCREEN 9, , 0, 0: : LOCATE 8, 15: PRINT "Filling array with random positions. Please wait ..."
18220 FOR zz = 1 TO 4575: LOCATE 10, 37: PRINT zz: x(zz) = INT(RND * 640): y(zz) = INT(RND * 350): NEXT zz: RETURN
18500 'two body
18520 strs = 0: CLS : SCREEN 9, , 0, 0: : LOCATE 8, 25: PRINT "Filling array. Please wait ..."
18525 hs = sl / 2: zz = bb + hs: x(0) = 400: y(0) = 260
18530 FOR z = 1 TO 2287: LOCATE 10, 37: PRINT z: x(z) = 220: y(z) = 90: NEXT z
18540 FOR z = 2288 TO 4575: LOCATE 10, 37: PRINT z: x(z) = 400: y(z) = 260: NEXT z
18550 RETURN
19000 'display buffer
19010 FOR zz = 1 TO 4575: PSET (x(zz), y(zz)): NEXT zz: RETURN
30000 strs = 0: SCREEN 9, , 0, 0: CLS : LOCATE 2, 30: PRINT "Are The Stars Randon": LOCATE 4, 33: PRINT "April 29, 1989";
30010 LOCATE 8, 28: PRINT "<"; : COLOR 14: PRINT "1"; : COLOR 15: PRINT "> Pure Random": LOCATE 10, 28: PRINT "<"; : COLOR 14: PRINT "2"; : COLOR 15: PRINT "> Weighted (prejudiced)"
30020 LOCATE 12, 28: PRINT "<"; : COLOR 14: PRINT "3"; : COLOR 15: PRINT "> Exit the Program"
30030 LOCATE 16, 30: PRINT "Press Choice <"; : COLOR 14: PRINT "1"; : COLOR 15: PRINT " - "; : COLOR 14: PRINT "3"; : COLOR 15: PRINT ">"
30040 LOCATE 20, 1: PRINT "Original program for the Color Computer by"
30050 PRINT TAB(16); "Philip Mclaughlin, 712 Roberts St., Denton, TX, 76201"
30060 LOCATE 23, 1: PRINT "Converted to the PC by"
30070 PRINT TAB(12); "James Huckabey, 3621-A Fraser Street, Bellingham, WA, 98226"; : sl = 4575: bb = 1
30100 i$ = INKEY$: z = VAL(i$): IF i$ = "1" THEN GOSUB 20 ELSE IF i$ = "2" THEN GOSUB 1000 ELSE IF i$ = "3" THEN GOSUB 60000: GOTO 30000 ELSE 30100
30999 GOTO 30000
45000 'set every how many generations
45010 SCREEN 9, , 0, 0: CLS : LOCATE 8, 21: PRINT "Save to disk every how many generations"; : INPUT gs$: IF VAL(gs$) > 0 THEN gs = VAL(gs$): pn = 0 ELSE doit = 0
45020 RETURN
50000 'save to disk
50010 pn = 0
50050 fr$ = "GEN" + RIGHT$(STR$(ge), LEN(STR$(ge)) - 1) + ".PIC"
50110 OPEN fr$ FOR OUTPUT AS #1: FOR z1 = 1 TO 4575: WRITE #1, x(z1), y(z1): NEXT z1: CLOSE #1: RETURN
52000 SCREEN 9, , 0, 0: CLS : FILES: LOCATE 8, 21: PRINT "Leave blank and press <ENTER> to exit"'single frame to disk
52100 LOCATE 10, 10: INPUT "Input name of frame to be saved (up to 8 characters +.PIC)"; fr$: IF fr$ = CHR$(13) THEN RETURN
52110 IF LEN(fr$) > 12 OR RIGHT$(fr$, 4) <> ".PIC" THEN 52000 ELSE 50110
60000 CLS : LOCATE 10, 21: PRINT "Are you sure you want to exit the program": LOCATE 12, 32: PRINT "Press <Y> or <N>"
60010 i$ = INKEY$: IF i$ = "N" OR i$ = "n" THEN RETURN ELSE IF i$ <> "Y" AND i$ <> "y" THEN 60010
60020 CLS : END
60100 SCREEN 9, , 0, 0: LOCATE 23, 1: PRINT "Error"; ERR; "in line"; ERL
60110 IF INKEY$ = "" THEN 60110
60120 END