jsbasic/samples/sample.columns.txt
Joshua Bell 6278f871fb Several sample fixes/improvements by Alan Ratliff
**In "Simple Pong" I eliminated the problem of the bouncing ball erasing the bottom wall of the field, created a means of scoring points (when the ball gets past a paddle and hits the "back wall", the other player scores a point -- one point each time the ball gets past the paddle, so that multiple impacts that typically occur don't count a point each), and allowed the possibility of equiangular bouncing off the paddles, instead of always just bouncing straight back along the same trajectory.

Also, this game isn't really suited for "paddle"-type control on this platform, as there is typically just one mouse for that purpose, not practical for two players. However, with key-control, the comments cited a problem of needing to be able to handle multiple keystrokes. As it was, when one player pressed a directional key, their paddle would start moving and not stop until it hit its upper/lower limit. It would stop, though, if a non-operational key were pressed, or one of the other player's keys. This latter meant that one player hitting a key to move their paddle would stop the other player's paddle from moving, which was where the real problem occurred. Underlying this was the fact all movement was controlled by the single last key pressed. I changed it by introducing variables to control the movement of each paddle which would be set by the appropriate keystrokes. I also added a specific key for each player to stop their paddle's motion, as well as duplicate directional keys so that each player's key group would be suitable for either the left or right hand: with either hand they could press "down" with the index finger, "stop" with the middle finger, and "up" with the fourth finger.

***With "Hangman", I did the usual random-seeding, avoided the initial-keystroke-termination problem, and simplified the word-choosing algorithm, and set it to go through all words in a difficulty-group, then continue by choosing among the 9 words in that group least-recently used. I also incorporated level-change options in the new-game menu, and I greatly reduced the code for the circle-drawing routine (while still utilizing principles of geometry), and re-organized the parts-drawing routines so the "smiley face" routine could be simplified.

***Next is the "Door Detector" game program. Its problems were subtle ones, principally that it would occasionally crash with an "Illegal quantity error in line 320". This concerned the value of "G" that was assigned as COLOR. This crash was quirky, as the program maintained the value of G between 0 and 15 in some places, but not others, while supposedly the value given to COLOR is not "Illegal" unless it's outside the byte-range 0-255; within that range the value merely has its lower nybble isolated to serve as the COLOR value. I put in a tweak to print the value of G to be used in line 320, and upon a crash it was shown as 50. I'm not sure why it occurred this way, but I figured that a way to be safe would be to just *always* ensure that G is kept in the range 0 to 15.

The program also had the "standard" problem that it didn't seed the random-number generator, so it always played an identical "game sequence" every time, instead of different permutaions as you'd normally expect with "random numbers".

Another "subtle" shortcoming I noticed concerned the fact that in successive "rooms" within a game, the "Death Zone" is an incrementally "thick" border region around the room, and in any given room the "exit" could be randomly placed right next to the "Death Zone's" edge, and as the player would start the next room where the previous room's exit was, a next-to-Death-Zone exit would mean the player would start the next room IN the Death Zone (its innermost layer). As it happened, in the one game-sequence that occurred, the final room's exit in the first game was along the Death Zone's edge, but as it was the FINAL room anyway, the next-room starting location was not an issue. I figured, though, that with the game properly randomized, the issue COULD come up, so I now use line 50 (commented in 40) to bump the player out of the Death Zone if they're starting a room within the Zone.

***With "Columns" there was the usual lack of random seeding, and again a rather drab color scheme for the lower number of colors. I also reduced the maximum number of colors by one, so that it would never use both of the indistinguishable grays. Also a comment on line 2840 mentioned a "Future animated splash screen", so I created one.

***The primary problem with "Chase" was lack of random seeding, so it always played the same sequence of games, which would wear out quickly. There were also a few duplicate line numbers I eliminated. The game presentation could also be improved by simply VTABbing up to display each new board layout over the old one, rather than scrolling up for new diagrams. Also, I documented in the instructions how a player should expect to encounter impossible situations frequently, and just move on when that happens; and I generally streamlined the code considerably, including cleaning up messy text displays.

***With "Gaussian distribution 2D", trying an example resulted in an "Illegal quantity in line 160". This was caused by the hires X coordinate just exceeding the maximum 279, apparently due to imprecise calculations. Reducing the designated maximum (assigned to 'w') in line 30 to a value of 278 seems to clear this up. I also reduced the maximum Y a bit so the diagram would not butt against the text on screen-line 21. In addition, there were a few (i.e. redundant) explicit expressions of the value of PI, all then multiplied by 2 to obtain 2PI; I replaced these with one derivation of PI/4 via ATN(1), multiplied by 8 to obtain 2PI, and stored it in variable 'p2' (for "PI * 2").

***With "Original Series Enterprise" I created a much more accurate depiction of said entity. To be honest, it really isn't Gil Keidar's anymore, it's mine...

***Finally, with "Prime Factors", the old version, in a number of cases, did not produce the correct results. I have fixed that problem. I also replaced its series of like multiplications (e.g. 2x2x2x2x2x2) with a base^exponent exprression (2^6).
2024-02-19 11:03:15 -08:00

335 lines
13 KiB
Plaintext

10 rem Columns for Applesoft BASIC
20 rem Programmed by Arthur Allen
30 rem Based on Columns by Jay Geertsen
50 def fnsym(i) = int (symbols * rnd(1)) + 1 : def fncolr(i) = asc(mid$("@AFDCMKLEBGIHNJO",i + 1,1)) - 64
60 dim array(40, 42), erase(25)
70 dim shape(2), nshape(3), check(40, 42)
90 gosub 2840: rem Interactive pre-screen
350 home
360 rem Fill in borders in array
370 rem Fill bottom row
380 for fill = 0 to width + 6
390 array(fill, height+1) = 15
400 next fill
410 rem Fill left and right sides
420 for fill = 0 to height + 3
430 array(left, fill) = 15
440 array(left+width+1, fill) = 15
450 next fill
455 if renew then vtab 21 : htab left + int(width/2) + 1 : print "^" : rem print only if replay selected
460 rem Prefill board
465 gosub 4320 : rem blank out part of screen above prefill
470 guess = 1
480 if rows = 0 goto 720 : rem Skip if rows = 0, otherwise loop will still execute once
540 for i = 3 to width + 2
550 for j = height - rows + 1 to height
555 cycle = 0
570 rem Top of while flag loop
580 flag = 0
583 rem Set i back by one if a stable cell (one that won't trip a three in a row) isn't found in 10 attempts. Set i to 3 if i is less than 3
585 cycle = cycle + 1
587 if cycle > 10 then guess = guess + 1 : vtab 22 : print "Attempt: "; guess; ", x pos: "; i; " " : i = i - 1 : if i < 3 then i = 3
590 candidate = fnsym(0)
600 rem Proximity checking
610 if array(i - 1, j) = candidate then if array(i - 2, j) = candidate then flag = 1 : rem same symbol horz left
620 if array(i, j - 1) = candidate then if array(i, j - 2) = candidate then flag = 1 : rem same symbol up
630 if array(i - 1, j - 1) = candidate then if array(i - 2, j - 2) = candidate then flag = 1 : rem same symbol diag left & up
640 if array(i - 1, j + 1) = candidate then if array(i - 2, j + 2) = candidate then flag = 1 : rem same symbol diag left & down
660 if flag goto 570 : rem Back to top of while flag loop
670 array(i, j) = candidate
680 color= fncolr(candidate)
690 plot i, j
700 next j
710 next i
720 rem Pick piece for initial Next window
730 rem Pick shape
740 for s = 0 to 2
750 nshape(s) = fnsym(0)
780 next s
790 rem Make turn
800 x = int(width/2) + 2
810 y = 0
820 rem Copy Next to current shape, get new Next
830 for s = 0 to 2
840 shape(s) = nshape(s)
910 nshape(s) = fnsym(0)
920 color= fncolr(nshape(s))
930 plot width + 5, s
940 next s
1020 t1 = time
1050 bot = 0
1060 drop = 0
1120 rem Check for end of play
1130 rem Check for conflict
1140 cfl = array(x, y) or array(x, y+1) or array(x, y+2)
1145 if cfl then gosub 3000 : goto 350 : rem end of game, go to front end
1150 rem Make move loop
1160 if drop then t1 = 1
1170 for clock = 0 to t1
1180 if peek (49152) > 127 then gosub 1320 : rem Process input if input detected
1190 next clock
1200 y1 = y : x1 = x
1210 y = y + 1
1220 cfl = 0
1240 if not bot then gosub 1670 : rem Move piece
1260 if cfl goto 2060 : rem Add to shape & check for complete three in a row
1270 if not bot then 1150 : rem Back to top of Make move loop, else force to bottom
1280 y = y - 1 : xdr = 1
1290 color= 0 : vlin y, y+2 at x : rem Erase shape
1300 y = y + 1 : xdr = 0
1310 goto 1530 : rem Send piece to bottom
1320 rem Process input
1330 for s = 0 to 1 : a = PEEK (49152) : s = a > 127 : next
1340 get g$
1350 if g$ = " " goto 1970 : rem Check for rotate
1360 s = (g$ = "D" or a = 138) * 2 + (g$ = "K" or a = 149) - (g$ = "J" or a = 136)
1370 if s goto 1590 : rem move left/right/down
1390 if g$ = "M" then bot = 1 : return : rem Send piece to bottom
1400 if g$ = "S" then drop = 1 : rem Speed up piece
1410 if g$ = "P" goto 2580 : rem Pause game
1415 if g$ = "R" goto 460 : rem restart at prefill
1420 return
1530 rem Send piece to bottom
1540 y = y + 1
1545 cfl = 0
1550 if array(x, y+2) then cfl = 1 : rem Check for conflict
1560 if cfl then y = y - 1 : gosub 2010 : goto 2070 : rem Draw, then Add to bottom
1570 goto 1540
1580 rem shift piece left, right, or down
1590 y1 = y : x1 = x : s = (s<2) * s
1600 x = x + s : y = y + not s
1630 rem move piece
1670 cfl = 0
1680 if array(x, y) or array(x, y+1) or array(x, y+2) then cfl = 1 : rem Check for conflict
1700 if cfl then x = x1 : y = y1 : return : rem Return old values
1710 color= 0
1720 vlin y1, y1+2 at x1
1730 goto 2010
1960 rem Rotate
1970 swap = shape (2)
1980 shape (2) = shape (1)
1990 shape (1) = shape (0)
2000 shape (0) = swap
2010 for s = 0 to 2 : rem Draw shape, called from 1560 & 1730
2020 color= fncolr(shape(s))
2030 plot x, y+s
2040 next s
2050 return
2060 rem Check field
2070 rem Add shape to board
2080 for s = 0 to 2
2090 array(x, y + s) = shape(s)
2100 next s
2110 rem While found (contol at line 2340. End of loop at 2560)
2120 found = 0
2130 rem Initialize array
2140 for i = 3 to width + 3
2150 for j = 0 to height
2160 check(i, j) = 0
2170 next j
2180 next i
2190 rem Start checking for three in a row
2200 for j = 2 to height
2210 for i = 3 to width + 2
2220 if not array(i, j) goto 2320 : rem Skip dead cells
2230 rem Check horizontal
2240 if array(i, j) = array(i - 1, j) and array(i, j) = array(i + 1, j) then check(i - 1, j) = 1 : check(i, j) = 1 : check(i + 1, j) =1 : found = 1
2250 rem Check vertical
2260 if array(i, j) = array(i, j - 1) and array(i, j) = array(i, j + 1) then check(i, j - 1) = 1 : check(i, j) = 1 : check(i, j + 1) = 1 : found = 1 : rem vtab 21 : htab 1 : print "2260 found vertical, j+1 = "; j+1; : rem temp code
2270 rem Check diagonal left
2280 if array(i, j) = array(i - 1, j - 1) and array(i, j) = array(i + 1, j + 1) then check(i - 1, j - 1) = 1 : check(i, j) = 1 : check(i + 1, j + 1) = 1 : found = 1
2290 rem Check diagonal right
2300 if array(i, j) = array(i + 1, j - 1) and array(i, j) = array(i - 1, j + 1) then check(i + 1, j - 1) = 1 : check(i, j) = 1 : check(i - 1, j + 1) = 1 : found = 1
2310 rem End if skip dead cells
2320 next i
2330 next j
2335 gosub 2740 : rem Count cells to be removed.
2357 rem while not found control:
2340 if not found goto 800 : rem Goto Make turn
2350 rem Flash cells
2355 rem gosub 2610 : rem Draw parallel field of check cells
2360 for blink = 0 to 1
2370 color= 0
2380 for j = 2 to height
2390 for i = 3 to width + 2
2400 if check(i, j) then plot i, j
2410 next i
2420 next j
2430 for j = 2 to height
2440 for i = 3 to width + 2
2450 if check(i, j) then color= fncolr(array(i, j)) : plot i, j
2460 next i
2470 next j
2480 next blink
2490 rem Remove cells from board
2500 for i = 3 to width + 2
2505 offset = 0
2510 for j = height to 0 step -1
2520 if not check(i,j) then array(i, j + offset) = array(i, j) : color= fncolr(array(i, j)): plot i, j + offset
2530 if check(i, j) then offset = offset + 1
2540 next j
2550 next i
2555 if renew then if rows > 0 then if check(left + int(width/2),height) goto 460 : rem end of screen, go to prefill board
2560 goto 2110 : rem To top of while found loop
2570 rem End of Check field subroutine
2580 rem Pause game
2590 if peek (49152) = 141 then get g$ : return
2600 goto 2580
2740 rem Count deleted cells
2745 nowdead = 0
2750 for j = 2 to height
2760 for i = 3 to width + 2
2770 if check (i, j) then dead = dead + 1: nowdead = nowdead + 1
2780 next i
2790 next j
2800 vtab 22 : htab 1 : print "Cleared: "; nowdead; : call -868
2810 print : print "Total:" spc(3) dead
2820 return
2830 rem Front end screen
2840 gosub 5000 : rem Show animated splash screen
2860 rem setup default values and screen
2870 rows = 20 : rem Prefill rows
2880 width = 6
2890 symbols = 5
2900 renew = 1 : rem replay value (yes = 1/no = 0)
2920 height = 39 : rem Full GR screen with text window. Cannot be larger than 39
2930 left = 2
2935 rem End of game gosubs to here, past splash screen and default values
3000 time = 500 : sd=RND(-PEEK(79)*999-PEEK(78))
3005 gosub 4200 : home : print "--> Replay on cleared cell above ^ "; : gosub 4180 : print
3010 htab 5 : print "Width (3 - 34) "; width; tab(24) "[ENTER] to start"
3020 htab 5 : print "Prefill (0 - 30) "; rows
3030 htab 5 : print "Colors (3 - 13) "; symbols;
3040 if cfl then htab 26 : print "[ESC] to exit"; : htab 1
3050 vtab 21 : choice = 21 : rem vtab position of menu choice
4000 rem Process Input
4020 for s = 0 to 1 : a = PEEK (49152) : s = a > 127 : next : get g$
4050 i = (g$ = "D" or g$ = "M" or a = 138) - (g$ = "I" or a = 139)
4060 if i then i = choice + i : htab 1 : print spc(3) : choice = ((i = 20) - (i = 25)) * 4 + i : vtab choice : htab 1 : print "-->"; : goto 4020 : rem up/down
4070 if a = 141 then return : rem enter/return to start the game. This is why Process Input is not a subroutine
4075 if cfl and a = 155 then pop : home : print : print "BYE!" : end
4080 a = (g$ = "K" or a = 149) - (g$ = "J" or a = 136)
4090 on not a goto 4020 : on choice - 20 gosub 4130,4140,4150,4160
4092 on not a goto 4020 : vtab choice : htab asc(mid$("dTVU",choice - 20,1)) - 64
4094 if choice > 21 then print i spc(1) : on choice/12 gosub 4200,4250 : if choice = 23 and (rows = a or not rows) then vtab 21 : htab 36 : a=2
4095 if choice = 21 or a = 2 then gosub 4180 : htab 1
4100 vtab choice : goto 4020
4120 rem Left & Right Choices
4130 renew = 1 - renew: a = rows : return : rem toggle Renew
4140 i = width + a : a = (i > 2 and i < 35) * a : width = width + a : return : rem width
4150 i = rows + a : a = (i >= 0 and i < 31) * a : rows = rows + a : return : rem prefill height
4160 i = symbols + a : a = (i > 2 and i < 14) * a : symbols = symbols + a : return : rem colors
4180 print mid$("N/ANO YES",(rows > 0) * (renew + 1) * 3 + 1,3); : return
4200 gr : color= 15 : rem Draw white borders
4210 vlin 0, height at left
4220 vlin 0, height at left + width + 1
4240 rem Draw top line to indicate prefill height.
4250 if not rows then return
4260 for s = 3 to width + 2
4270 color= fncolr(fnsym(1))
4290 plot s, height - rows + 1
4300 next
4310 return
4320 rem Blank out the part of screen above prefill. Called at start of every screen, and on an "R" press
4330 color = 0 : rem black
4340 for j = left + 1 to width + 2
4350 vlin 0, height - rows at j
4360 for i = 0 to height - rows : array(j,i) = 0 : next i,j
4370 return
4990 rem Animated splash screen by Alan Ratliff
5000 pr#0 : gr : color= 3 : vlin 1,9 at 2 : plot 3,28 : plot 3,38 : plot 4,0 : plot 4,10 : plot 5, 29 : plot 5,37
5010 vlin 13,37 at 32 : vlin 16,34 at 26 : vlin 11,24 at 16 : vlin 14,27 at 11
5020 home : color= 1 : vlin 29,37 at 7 : plot 8,0 : plot 8,10 : plot 9,28 : plot 9, 38 : vlin 1,9 at 10
5030 vlin 14,30 at 36 : vlin 15,36 at 22 : vlin 16,32 at 2 : plot 30,11 : plot 13,25 : vlin 2,8 at 17
5040 color= 11 : vlin 0,10 at 12 : plot 13,38 : plot 14,10 : plot 15, 38
5050 vlin 15,38 at 30 : vlin 13,34 at 20 : vlin 11,24 at 6 : plot 26,13
5060 color= 9 : vlin 28,37 at 17 : plot 18,10 : plot 19,38 : vlin 0,9 at 20
5070 vlin 17,33 at 34 : vlin 12,37 at 24 : vlin 8,23 at 9 : plot 12,36
5080 color= 13 : vlin 0,10 at 22 : vlin 30,31 at 23 : vlin 4,6 at 24 : vlin 30,31 at 25 : vlin 0,10 at 26
5090 vlin 17,36 at 14 : vlin 14,35 at 4 : plot 34,12 : vlin 2,9 at 7
5100 color= 4 : vlin 0,10 at 28 : vlin 30,31 at 29 : vlin 4,6 at 30 : vlin 35,36 at 31 : vlin 0,10 at 32
5110 vlin 14,30 at 18 : plot 37,2 : plot 37,8 : plot 34,36 : plot 26,38 : plot 2,12 : plot 2,36 : vlin 30,37 at 10 : vlin 1,8 at 5
5120 color= 6 : vlin 1,4 at 34 : plot 34,9 : plot 35,28 : plot 35,33 : plot 35,38 : plot 36,0 : plot 36,5 : plot 36,10 : plot 37,29 : vlin 34,37 at 37
5130 vlin 14,37 at 28 : vlin 21,31 at 8 : plot 19,4 : plot 13,13 : vlin 1,8 at 15 : vlin 27,33 at 12
5140 for i = 1 to 2000 : next i : a = 21 ^ not a : for a = a to (a > 1) * 37 + 14 : for s = 2 to 18 step 2
5150 for i = 0 to 1 : k = a - (s + i + 18) * (a > 20) : k = (k > 0 and k < 15) * k : on not k goto 5400 : y = 39 - s * 2
5160 for j = 0 to y step y : x = sgn(1-j) * i + s + j : y = x / 2 : y = int(y) = y : k = abs(k) : if y then k = -k
5170 h = sgn(k) : y = 28 - y * 18 - k : for y = y to h * 10 + y step h : color= scrn(x,y+h) : plot x,y : next
5180 color= 0 : hlin x,x - h at y : next
5400 next i,s,a : a = 1.5 : for x = 34 to 37 : color= (a<2) * 8 + a : a = a * 2 : y = x * 2
5410 hlin 39 - x,x at 79 - y : hlin 39 - x,x at y - 41 : next
5420 htab 9 : print "Created by JAY GEERTSEN"
5430 for a = 1 to 12000 : next a
5440 print : htab 5 : print "Applesoft coding by ARTHUR ALLEN"
5580 rem Key guide screen
5590 for a = 1 to 48000 : next a : text : home
5600 vtab 3 : print "Keys used:" : print
5610 print "<-- or J to move piece left"
5620 print "--> or K to move piece right"
5630 print "<SPACE> to rotate colors downward"
5640 print " |" spc(4) "M to send piece to bottom"
5650 print " | or D to force piece down"
5660 print "\|/" spc(3) "S to speed up piece"
5670 htab 7 : print "R to restart at prefill level"
5680 htab 7 : print "P to pause game"
5690 vtab 21 : print "Press a key to choose game settings"
5700 print : print "(or <-- or --> to see Splash again) "; : get g$
5710 i = asc(g$) : a = i = 21 : on i = 8 or a goto 5000 : home : return