Apple-2-SW
/
jsbasic
mirror of https://github.com/inexorabletash/jsbasic.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Various game fixes and enhancements by Alan Ratliff

This commit is contained in:
Joshua Bell 2020-06-20 15:49:59 -07:00
parent 8d91265d3b
commit c64c10e5d2
4 changed files with 409 additions and 586 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

176
samples/sample.puzzler.txt
View File

@ -1,85 +1,91 @@
0 PR#0 0 PR#0
10 DIM PP(16),NU(16) 10 DEF FN R(X) = INT ( RND (1) * X) + 1: DEF FN M4(Y) = Y - INT (Y / 4) * 4: DIM NU(16)
20 POKE - 16368,0 15 R$ = "4567RTYUFGHJVBNM":P$ = "ABCD..........N...IJK.L..PO...E.FHM..G"
30 TEXT : HOME : VTAB 4: HTAB 14: PRINT "THE PUZZLER" 20 POKE - 16368,0
40 VTAB 15: HTAB 12: PRINT "BY GREGG BUNTIN" 30 TEXT : HOME : VTAB 4: HTAB 14: PRINT "THE PUZZLER"
50 FOR I = 1 TO 2000: NEXT I 40 VTAB 15: HTAB 12: PRINT "by Gregg Buntin"
60 VTAB 20: PRINT "DO YOU WISH INSTRUCTIONS ";: INPUT I$ 50 FOR I = 1 TO 2000: NEXT I
70 IF I$ < > "Y" THEN 190 60 VTAB 20: PRINT "Do you wish instructions";: INPUT I$
80 HOME : VTAB 2: HTAB 14: PRINT "THE PUZZLER" 70 IF LEFT$ (I$,1) < > "Y" THEN 190
90 VTAB 4: PRINT "THE OBJECT OF THIS GAME IS TO GET ALL OF": PRINT "THE NUMBERS IN ORDER FROM 1 TO 15" 80 HOME : VTAB 2: HTAB 14: PRINT "THE PUZZLER"
100 PRINT "THE COMMANDS ARE" SPC( 13);: INVERSE : PRINT "A": NORMAL : HTAB 30: PRINT ":": HTAB 30: PRINT ":" 90 VTAB 4: PRINT "The object of this game is to get all ofthe numbers in order from 1 to 15."
110 HTAB 25: INVERSE : PRINT "<-";: NORMAL : PRINT " - ";: INVERSE : PRINT "->": NORMAL 100 PRINT : PRINT "The basic command keys are:";: HTAB 36: INVERSE : PRINT "A": NORMAL : HTAB 36: PRINT ":": HTAB 36: PRINT ":"
120 : HTAB 30: PRINT ":": HTAB 30: PRINT ":": INVERSE : HTAB 30: PRINT "Z": NORMAL 110 HTAB 33: INVERSE : PRINT "<-";: NORMAL : PRINT " + ";: INVERSE : PRINT "->";: NORMAL : PRINT
130 PRINT : PRINT "BY MEANS OF THESE COMMANDS YOU WILL ": PRINT "EXCHANGE THE BLANK SPACE WITH THE NUMBER";: PRINT "IN THE UP,DOWN,LEFT OR RIGHT POSITIONS" 120 PRINT "By means of these keys you" TAB( 36) ":": PRINT "will exchange the blank" TAB( 36) ":"
150 : VTAB 21: PRINT SPC( 8)"PRESS <ESC> TO START GAME" 130 PRINT "space with the number in the";: INVERSE : HTAB 36: PRINT "Z": NORMAL
160 K = PEEK ( - 16384): IF K < 127 THEN 160 140 PRINT "up,down,left or right positions."
170 IF K = 155 THEN 190 145 PRINT : PRINT : PRINT "Alternatively, use the [mouse] and [END]key, or any highlighted key in the"
180 GOTO 160 148 PRINT "displayed diagram, to move up to ALL thetiles in a row or column at once!"
190 POKE - 16368,0: HOME : VTAB 4: HTAB 14: PRINT "THE PUZZLER": VTAB 12 150 VTAB 24: PRINT SPC( 7)"Press <ESC> to start game";
200 PRINT "Type N to start a (N)EW GAME" 160 K = PEEK ( - 16384): IF K < > 155 THEN 160
220 K = PEEK ( - 16384): IF K < 127 THEN 220 190 POKE - 16368,0: HOME : VTAB 4: HTAB 14: PRINT "THE PUZZLER": VTAB 12
230 IF K = 206 THEN 260 200 PRINT "Type N to start a (N)EW GAME"
240 IF K = 211 THEN 740 220 K = PEEK ( - 16384): IF K = 155 GOTO 480
250 GOTO 220 230 ON K < > 206 GOTO 220: POKE - 16368,0
260 HOME : PRINT "SCRAMBLING PUZZLE.............." 260 HOME : PRINT "SCRAMBLING PUZZLE.............."
261 FOR I = 1 TO 16 262 I = RND ( - PEEK (79) * 999 - PEEK (78)): REM RANDOM SEED
270 Q = INT ( RND (1) * 16) + 1 265 FOR I = 1 TO 16:NU(I) = I: NEXT
280 IF PP(Q) THEN 270 270 FOR I = 1 TO 40:Q = FN R(15)
290 PP(Q) = 1:NU(I) = Q: NEXT 280 K = FN R(14):K = (K > = Q) + K
300 TEXT : HOME : GR : COLOR= 12 290 X = NU(Q):NU(Q) = NU(K):NU(K) = X: NEXT
310 FOR I = 0 TO 19: HLIN 0 + I,39 - I AT I: HLIN 0 + I,39 - I AT 39 - I 292 A = FN R(16):Y = 16: X = 4: ON A < 13 GOSUB 580
320 VLIN 0 + I,39 - I AT I: VLIN 0 + I,39 - I AT 39 - I: NEXT 295 X = 1: ON A < Y GOSUB 580
330 COLOR= 1: FOR I = 9 TO 29 STEP 10: HLIN 0,39 AT I: VLIN 0,39 AT I: NEXT 300 TEXT : HOME : GR : COLOR= 12
340 COLOR= 0: HLIN 0,39 AT 39: VLIN 0,39 AT 39 310 FOR I = 0 TO 18: Q = 38 - I: HLIN I,Q AT I: HLIN I,Q AT Q
350 FOR I = 1 TO 16:FLAG = 1:PL = I: GOSUB 370 320 VLIN I,Q AT I: VLIN I,Q AT Q: NEXT : PLOT 19,19
360 NEXT I: GOTO 520 330 COLOR= 1: FOR I = 9 TO 29 STEP 10: HLIN 0,38 AT I: VLIN 0,38 AT I: NEXT
370 IF PL = 1 OR PL = 5 OR PL = 9 OR PL = 13 THEN X = 1 350 FOR PL = 1 TO 16: GOSUB 380: REM DISPLAY WHOLE GRID
380 IF NU(PL) = 16 THEN RETURN 360 NEXT :PL = A: PRINT "At any time,": PRINT "press <ESC>": PRINT "to exit.": GOTO 440
390 IF PL = 2 OR PL = 6 OR PL = 10 OR PL = 14 THEN X = 11 365 REM 370-430, 840-930 - ROUTINE TO DISPLAY NUMBERS
400 IF PL = 3 OR PL = 7 OR PL = 11 OR PL = 15 THEN X = 21 370 COLOR= 12: GOTO 390
410 IF PL = 4 OR PL = 8 OR PL = 12 OR PL = 16 THEN X = 31 380 COLOR= 2
420 IF PL < 5 THEN Y = 2 390 IF NU(PL) = 16 THEN RETURN
430 IF PL > 4 AND PL < 9 THEN Y = 12 400 Q = PL - 1: GOSUB 600
440 IF PL > 8 AND PL < 13 THEN Y = 22 410 Q = NU(PL) > 9: ON Q GOSUB 870
450 IF PL > 12 THEN Y = 32 420 X = Q * 2 + X + 2
460 COLOR= 12: IF FLAG = 1 THEN COLOR= 2:FLAG = 0 430 Q = NU(PL) - Q * 10: ON Q + 1 GOTO 840,870,880,850,890,900,910,920,840,930
470 IF NU(PL) > 9 THEN 500 435 REM DISPLAY ACTIVE-KEY GRID
480 X = X + 2 440 VTAB 21: GOSUB 825: I = I + 1: FOR Y = 0 TO 3: IF Y THEN PRINT
490 ON NU(PL) GOTO 850,860,870,880,890,900,910,920,930,1100,1110 450 HTAB 17: FOR X = 1 TO 4: K = (X = I) + (Y = Q): IF K THEN INVERSE
500 GOSUB 850:X = X + 4 460 PRINT MID$ (R$,Y * 4 + X,K < 2);: NORMAL : PRINT TAB( X * 2 + 17): NEXT : NEXT
510 ON NU(PL) - 9 GOTO 840,850,860,870,880,890 465 REM GET KEY, MOVE TILE TO EMPTY SPACE
520 FOR I = 1 TO 16: IF NU(I) = 16 THEN PL = I: GOTO 540 470 K = ( PEEK (49250) > 127) * 301 + PEEK ( - 16384): IF K < 128 THEN 470
530 NEXT 480 POKE - 16368,0
540 K = PEEK ( - 16384): IF K < 127 THEN 540 490 IF K = 155 THEN TEXT : HOME : PRINT "BYE-BYE": END
545 POKE - 16368,0 500 IF K > 300 GOTO 610: REM "BUTTON" ([END] KEY) PRESSED
550 IF K = 193 THEN 630 510 IF K > 179 AND K < 218 THEN Q = ASC ( MID$ (P$,K - 179,1)) - 65: IF Q > = O THEN GOSUB 600: GOTO 630
560 IF K = 218 THEN 650 520 K = INT ((K = 193 OR K = 218 OR K = 136 OR K = 149) * K / 7)
570 IF K = 136 THEN 670 530 IF NOT K GOTO 470
580 IF K = 149 THEN 690 540 I = K < 22:A = (K - 29) * 2
610 IF K = 155 THEN TEXT : HOME : PRINT "BYE-BYE": END 550 IF K < 20 = FN M4(PL) AND I OR (A + 8.5 - PL) * A * NOT I < 0 GOTO 470
620 GOTO 540 560 IF I THEN A = K - 20
630 IF PL < 5 THEN 520 570 GOSUB 770: GOTO 810
640 A = - 4: GOTO 710 580 FOR Y = Y TO A + X STEP -X:NU(Y) = NU(Y - X): NEXT : NU(Y) = 16: RETURN
650 IF PL > 12 THEN 520 600 GOSUB 830:X = I * 10 + 1:Y = Q * 10 + 2: RETURN
660 A = 4: GOTO 710 605 REM HANDLE "JOYSTICK" (MOUSE) AND MULTIPLE TILES
670 IF PL = 1 OR PL = 5 OR PL = 9 OR PL = 13 THEN 520 606 REM INTERPRET TRUE MOUSE POSITION (PC) BASED ON ITS CURSOR
680 A = - 1: GOTO 710 610 X = PDL (0) / 6.4: Y = PDL(1) * .1875: K = SCRN (X,Y)
690 IF PL = 4 OR PL = 8 OR PL = 12 OR PL = 16 THEN 520 620 IF K < > 2 AND K < > 12 OR Y > 38 GOTO 470
700 A = 1: GOTO 710 630 GOSUB 825: X = INT (X / 10) - I
710 T = PL:PL = PL + A:FLAG = 0: GOSUB 370 640 Y = INT (Y / 10) - Q
720 NU(T) = NU(PL):NU(PL) = 16:PL = PL - A 650 IF NOT X = NOT Y GOTO 470
730 FLAG = 1: GOSUB 370: GOTO 520 660 A = SGN(Y) * 4 + SGN (X): FOR K = 1 TO ABS (X + Y): GOSUB 770: NEXT
830 END 670 ON PEEK (49250) > 127 GOTO 670: GOTO 810
840 VLIN Y,Y + 5 AT X: VLIN Y,Y + 5 AT X + 2: PLOT X + 1,Y: PLOT X + 1,Y + 5: RETURN 770 PL = PL + A: GOSUB 370
850 VLIN Y,Y + 5 AT X + 1: PLOT X,Y: HLIN X,X + 2 AT Y + 5: RETURN 780 NU(PL - A) = NU(PL):NU(PL) = 16:PL = PL - A
860 HLIN X,X + 2 AT Y: VLIN Y,Y + 2 AT X + 2: PLOT X + 1,Y + 2: VLIN Y + 3,Y + 5 AT X: HLIN X,X + 2 AT Y + 5: RETURN 790 GOSUB 380:PL = PL + A: RETURN
870 HLIN X,X + 2 AT Y: HLIN X + 1,X + 2 AT Y + 2: HLIN X,X + 2 AT Y + 5: VLIN Y,Y + 5 AT X + 2: RETURN 800 REM TEST FOR SOLVED PUZZLE
880 VLIN Y,Y + 5 AT X + 2: VLIN Y,Y + 2 AT X: PLOT X + 1,Y + 2: RETURN 810 Q = 0: FOR I = 1 TO 16: Q = NU(I) < > I OR Q: NEXT : IF Q GOTO 440
890 HLIN X,X + 2 AT Y: VLIN Y,Y + 2 AT X: PLOT X + 1,Y + 2: VLIN Y + 3,Y + 4 AT X + 2: HLIN X,X + 1 AT Y + 5: RETURN 820 HOME : PRINT "CONGRATULATIONS!": PRINT : GOTO 200
900 VLIN Y + 1,Y + 5 AT X: HLIN X + 1,X + 2 AT Y: VLIN Y + 2,Y + 5 AT X + 2: HLIN X,X + 2 AT Y + 2: HLIN X,X + 2 AT Y + 5: RETURN 825 Q = PL - 1
910 HLIN X,X + 2 AT Y: VLIN Y,Y + 5 AT X + 2: RETURN 830 I = FN M4(Q):Q = INT (Q / 4): RETURN
920 VLIN Y,Y + 5 AT X: VLIN Y,Y + 5 AT X + 2: PLOT X + 1,Y: PLOT X + 1,Y + 2: PLOT X + 1,Y + 5: RETURN 840 VLIN Y,Y + 4 AT X
930 HLIN X,X + 2 AT Y: VLIN Y + 1,Y + 5 AT X + 2: HLIN X,X + 2 AT Y + 2: VLIN Y,Y + 2 AT X: HLIN X,X + 1 AT Y + 5: RETURN 850 IF Q THEN PLOT X + 1,Y + 2
860 HLIN X,X + 1 AT Y: HLIN X,X + 2 AT Y + 5: VLIN Y,Y + 4 AT X + 2: RETURN
870 VLIN Y,Y + 5 AT X + 1: PLOT X,Y + 1: HLIN X,X + 2 AT Y + 5: RETURN
880 HLIN X,X + 2 AT Y: VLIN Y,Y + 2 AT X + 2: PLOT X + 1,Y + 2: VLIN Y + 3,Y + 5 AT X: HLIN X,X + 2 AT Y + 5: RETURN
890 VLIN Y,Y + 5 AT X + 2: VLIN Y,Y + 3 AT X: PLOT X + 1,Y + 3: RETURN
900 HLIN X,X + 2 AT Y: VLIN Y,Y + 2 AT X: PLOT X + 1,Y + 2: VLIN Y + 3,Y + 4 AT X + 2: HLIN X,X + 1 AT Y + 5: RETURN
910 VLIN Y + 1,Y + 5 AT X: HLIN X + 1,X + 2 AT Y: VLIN Y + 2,Y + 5 AT X + 2: PLOT X + 1,Y + 2: PLOT X + 1,Y + 5: RETURN
920 HLIN X,X + 2 AT Y: VLIN Y,Y + 5 AT X + 2: RETURN
930 VLIN Y,Y + 5 AT X + 2: VLIN Y,Y + 2 AT X: PLOT X + 1,Y: PLOT X + 1,Y + 2: HLIN X,X + 1 AT Y + 5: RETURN

360
samples/sample.raindrops.txt
View File

@ -1,199 +1,161 @@
0 REM Nicdem25's awesome game 0 REM Nicdem25's awesome game
100 REM Catch the raindrop 100 REM Catch the raindrop
101 rem Game design by Nicholas Merchant, age 10 101 rem Game design by Nicholas Merchant, age 10
102 rem Programming mostly by his dad with Nicholas 102 rem Programming mostly by his dad with Nicholas
103 rem version 1.7, August 2011 103 rem version 1.7, August 2011
111 clear: home 111 PR# 0:TEXT: home
115 print " Nicdem25games":? 115 print " Nicdem25games":?:?" CATCH THE RAINDROP":?
:?" CATCH THE RAINDROP":? 116 print " Version 1.7":? " August 2011":?
116 print " Version 1.7": 117 rem print " Programmed by JRM":?
:? " August 2011":? 118 rem print " Concept by Nicholas Merchant"
117 rem print " Programmed by JRM":?
118 rem print " Concept by Nicholas Merchant" 121 ?:?"Game controls: ":?
122 ?" Left arrow (move left)"
121 ?:?"Game controls: ":? 123 ?" Right arrow (move right)":?" Down arrow (stop movement)"
122 ?" Left arrow (move left)" 124 ?" <SPACEBAR> (pause game)
123 ?" Right arrow (move right)" 125 ?" Q (quit)."
124 ?" <SPACEBAR> (pause game) 126 ?
125 ?" Q (quit)."
126 ? 130 ?"Powerdrops:"
131 ?" + = extra life"
130 ?"Powerdrops:" 132 ?" E = expanded paddle":REM WAS NOT LISTED BECAUSE DISABLED
131 ?" + = extra life" 133 ?" $ = 10 points"
133 ?" $ = 10 points" 134 ?" s = slow down"
134 ?" s = slow down" 140 ?: Input "Press <RETURN> to begin.";A$
135 ?
140 ?: Input "Press <RETURN> to begin.";A$ 150 home:a = RND (-PEEK(79)*999 - PEEK(78)):REM RESEED RANDOM NUMBER AT START OF GAME
151 let level = 1:score = 0
150 home 152 let lives = 4:REM RENUMBER lives 4 TO 1 INSTEAD OF 3 TO 0
151 let level = 1 155 let D$="*": rem default raindrop character
152 let lives = 3 156 let pwl = 2:pdec = 0: rem length of paddle expansion when "E" powerup is caught
155 let D$="*": rem default raindrop character
156 let pwl = 2: rem length of paddle expansion when powerup is caught 170 let bottomofscreen = 17: rem variable for how far the rain falls
180 let sp = 2000: rem sp is the variable that controls speed of rain
170 let bottomofscreen = 17: rem variable for how far the rain falls 182 REM draw the bottom of screen
180 let sp = 2000: rem sp is the variable that controls speed of rain 184 vtab bottomofscreen +1:for a = 1 to 40:?"^";:next a
189 REM draw the bottom of screen 186 vtab bottomofscreen +3:?" Nicdem25: Catch the raindrop"
190 for a = 1 to 40: vtab bottomofscreen +1: htab a: ?"^";:next a 188 vtab 23:print "Score: "score" Level: "level" Lives: "lives;
196 vtab bottomofscreen +3:?" Nicdem25: Catch the raindrop"
197 vtab 23:print "Score: "score" Level: "level" Lives: "lives;
191 REM Initial paddle position variable: p1 is the horizontal offset
192 REM PL is the paddle length in characters
191 REM Initial paddle position variable: p1 is the horizontal offset 193 let p1 = 18
192 REM PL is the paddle length in characters 194 let oldpos = p1
193 let p1 = 18 195 let PL = 10:let OPL = PL: rem OPL is the original paddle length
194 let oldpos = p1
195 let PL = 10:let OPL = PL: rem OPL is the original paddle length
200 REM ++++++++++++++++++++++++++++
201 rem subroutine: falling raindrop
200 REM ++++++++++++++++++++++++++++ 202 rem ++++++++++++++++++++++++++++
201 rem subroutine: falling raindrop
202 rem ++++++++++++++++++++++++++++ 220 REM LINES 135, 230, 316-317, 400-410, 515-600, 1212-1550 DELETED
240 let x = int(rnd(1)*31)+5:REM OLD MULTIPLIER 30 MADE x=35 IMPOSSIBLE
230 x = RND (-RND (1)): rem reseed random number 241 rem assign a random x axis value for drop, 5<=x<=35
240 let x = int(rnd(1)*30)+5
241 rem assign a random x axis value for drop, 5<=x<=35 250 for y = 1 to bottomofscreen - 1
260 htab x: vtab y + 1
250 for y = 1 to bottomofscreen - 1 270 print D$;:rem draw drop at position <x,y>
260 htab x: vtab y + 1
270 print D$;:rem draw drop at position <x,y> 271 rem delay loop controls speed: speed increases with level up to max
275 for n = 1 to sp: next n
271 rem delay loop controls speed: speed increases with level up to max
275 for n = 1 to sp: next n 276 gosub 900: rem do paddle subroutine
276 gosub 900: rem do paddle subroutine 278 htab x: vtab y + 1: ?" ":rem erase old drop
279 next y
278 htab x: vtab y + 1: ?" ":rem erase old drop
279 next y
280 REM did you catch the raindrop?
284 rem missed the drop
285 if x < p1 or x > p1+PL then lives = lives -1:goto 340
280 REM did you catch the raindrop?
284 rem missed the drop 290 rem caught the drop
285 if x < p1 or x > p1+PL then lives = lives -1:goto 320 291 print chr$(7): REM make a sound for catching the drop
292 let score = score + 1
290 rem caught the drop 293 if D$ = "+" then let lives = lives + 1
291 print chr$(7): REM make a sound for catching the drop 294 if D$ = "E" then gosub 2000: rem expand paddle, set power timer
292 let score = score + 1 295 if D$ = "s" then let sp=sp+350: rem s slows down drops
293 if D$ = "+" then let lives = lives + 1 296 if D$ = "$" then let score = score + 9: if score/10 <> int(score/10) then let level = level + 1
294 if D$ = "E" then gosub 2000: rem expand paddle, set power timer
295 if D$ = "s" then let sp=sp+350: rem s slows down drops
296 if D$ = "$" then let score = score + 9:if score/10 <> int(score/10) then let level = level + 1 300 rem check if score is a multiple of 10: if so, level up
303 if score/10 = int(score/10) then let level = level + 1:let counter=1
304 rem every five levels, add a life
300 rem check if score is a multiple of 10: if so, level up 305 if counter =1 and level/5 = int(level/5) then let counter=0:gosub 700
303 if score/10 = int(score/10) then let level = level + 1:let counter=1
309 rem speed up if score is a multiple of 10
304 rem every five levels, add a life 310 if score/10 = int(score/10) then gosub 800
305 if counter =1 and level/5 = int(level/5) then let counter=0:gosub 700
314 rem powertime counter: expanded paddle length lasts five raindrops
309 rem speed up if score is a multiple of 10 315 if ptime then ptime = ptime - pdec: if ptime < pdec then VTAB bott:HTAB p1:?SPC(1):HTAB p1 + PL:?" ":p1 = p1 + 1:PL = PL - pwl:pdec = pdec - 6 ^ ((PL - OPL) / pwl)
310 if score/10 = int(score/10) then gosub 800
340 vtab 23
314 rem powertime counter: expanded paddle length lasts five raindrops 350 print "Score: "score" Level: "level" Lives: "lives" ";
315 rem let ptime = ptime - 1
316 rem if ptime < 0 then let ptime = 0 360 if NOT lives goto 9000:rem lost last life: go to end routine
317 rem if ptime = 0 then let PL = OPL
420 let n = INT(RND(1)*10+.5):REM CONVERT RANDOM NUMBER TO INTEGERS 0-10 (NEW LINE #420 FROM #511)
320 if lives = -1 then goto 9000:rem lost last life: go to end routine 425 REM OLD LOGIC EXCLUDED "E" EXPANSION POWER-UP OWING TO BUGS THEREWITH (NOW FIXED)
430 powerup = (n < (sp < 990) + 4) * n + NOT n:REM NEW IN-LINE FORMULATION, INCLUDING powerup FOR "E", "SLOW DOWN" ONLY WHEN FAST
340 vtab 23 440 D$ = MID$("*+$Es",powerup + 1,1):GOTO 200:REM SET CHAR FROM STRING, GO BACK TO START NEW RAINDROP
350 print "Score: "score" Level: "level" Lives: "lives" ";
400 REM powerups: powerup 1 = expand, powerup 2 = extra life 700 rem ++++++
405 let powerup = 0 710 rem lives up subroutine
720 rem ++++++
410 n = RND (-RND (1)): rem reseed random number 730 if (int(score/10)+1)/5 = (int(int(score/10)+1))/5 then let lives = lives +2
511 let n = rnd(1) 750 return
515 if n < 0.15 then let powerup = 1
520 if n >= 0.2 and n < 0.3 then let powerup = 2
530 if n >= 0.3 and n < 0.4 then let powerup = 3 800 rem +++++++
810 rem speed up subroutine
550 rem powerup characters 820 rem ++++++
560 if powerup = 0 then let D$ = "*" 850 let sp = sp - ((level-1)*100)
570 if powerup = 1 then let D$ = "+" 855 if sp < 400 then let sp = 400
580 if powerup = 2 then let D$ = "s" 890 return
590 if powerup = 3 then let D$ = "$"
900 REM ++++++++++++++++
600 goto 200:rem go back and start a new raindrop 901 REM GET PLAYER INPUT
902 REM ++++++++++++++++
700 rem ++++++ 903 IF PEEK (49152) > 127 THEN K$=CHR$(PEEK (49152)-128): REM SEE IF KEY(S) PRESSED
710 rem lives up subroutine 904 IF K$ = "Q" THEN goto 9000
720 rem ++++++ 905 if K$ = " " then gosub 5000
730 if (int(score/10)+1)/5 = (int(int(score/10)+1))/5 then let lives = lives +2 924 let oldpos = p1
750 return 935 if K$ = CHR$(8) then let p1 = p1 - 1
946 if K$ = CHR$(21) then let p1 = p1 + 1
950 if p1 < 1 then let p1 = 1
800 rem +++++++ 965 if p1 > 40-PL then let p1 = 40-PL
810 rem speed up subroutine 979 POKE 49168,0: REM reset keyboard input address (clear keyboard strobe)
820 rem ++++++
850 let sp = sp - ((level-1)*100) 999 REM +++++++++++
855 if sp < 400 then let sp = 400 1000 REM Draw paddle
890 return 1001 rem +++++++++++
1200 vtab bottomofscreen: b = oldpos < p1:htab p1 - b:?SPC(b)
900 REM ++++++++++++++++++++++++++++++++++++++++ 1205 for b = 0 to PL:?"-";
901 REM GET PLAYER INPUT 1210 next b:?SPC(oldpos > p1):RETURN
902 REM ++++++++++++++++++++++++++++++++++++++++
903 IF PEEK (49152) > 127 THEN K$=CHR$(PEEK (49152)-128): REM SEE IF KEY(S) PRESSED
904 IF K$ = "Q" THEN goto 9000 2000 REM increase paddle length; set power timer to five drops
905 if K$ = " " then gosub 5000 2010 let PL=PL+pwl
924 let oldpos = p1 2020 let ptime = ptime * 6 + 5:pdec = 6 ^ ((PL - OPL) / pwl - 1) + pdec:REM HANDLE MULTIPLE EXPANSION
935 if K$ = CHR$(8) then let p1 = p1 - 1 2025 p1 = p1 - (p1 > 1) - (p1 + PL = 40):REM REPOSITION PADDLE LEFTWARD AS NEEDED
946 if K$ = CHR$(21) then let p1 = p1 + 1 2030 return
950 if p1 < 1 then let p1 = 1
965 if p1 > 40-PL then let p1 = 40-PL 5000 rem pause
979 POKE 49168,0: REM reset keyboard input address (clear keyboard strobe) 5010 htab 4:vtab 4:input "Paused: press <RETURN> to resume";K$
5020 htab 4:vtab 4: CALL -868:?:REM ERASE PAUSE-MESSAGE LINE
5040 let K$ = ""
999 REM +++++++++++ 5050 return
1000 REM Draw paddle
1001 rem +++++++++++ 9000 vtab 11:htab 16:print "GAME OVER":?
9010 print " Play again (Y/N)?"
1215 for b = 0 to PL 9015 get A$
1210 vtab bottomofscreen: htab p1 + b: ?"-"; 9020 if A$ = "Y" then goto 150
1211 next b 9030 if A$ = "N" then ?" Bye!":end
9040 goto 9000
1212 if oldpos < p1 then gosub 1220
1214 if oldpos > p1 then gosub 1225
1219 return
1220 REM erase old left edge of paddle subroutine
1221 vtab bottomofscreen: htab oldpos: ?" ";
1224 return
1225 REM erase old right edge of paddle subroutine
1228 vtab bottomofscreen: htab oldpos + PL: ?" ";
1230 return
1500 rem erase expanded paddle when power time is up
1510 for i = 1 to pwl
1515 if oldpos + i > 40 then goto 1530
1520 htab oldpos + i: ?" ";
1530 next i
1550 return
2000 REM increase paddle length; set power timer to five drops
2010 let PL=PL+pwl
2020 let ptime = 5
2030 return
5000 rem pause
5010 htab 4:vtab 4:input "Paused: press <RETURN> to resume";K$
5020 htab 4:vtab 4:? " "
5040 let K$ = ""
5050 return
9000 vtab 11:htab 16:print "GAME OVER":?
9010 print " Play again (Y/N)?"
9015 get A$
9020 if A$ = "Y" then goto 150
9030 if A$ = "N" then ?" Bye!":end
9040 goto 9000

39
samples/sample.spaceattack.txt
View File

@ -1,41 +1,42 @@
10 GOTO 100: REM SPACE ATTACK! BY ALAN RATLIFF, (C) 1979 & 2020 10 GOTO 100: REM SPACE ATTACK! BY ALAN RATLIFF, (C) 1979 & 2020
15 REM ADAPTED FOR "Applesoft BASIC in Javascript" 15 REM ADAPTED FOR "Applesoft BASIC in Javascript"
20 T = SCRN( U,V) = W: COLOR= RC: PLOT U,V 20 T = SCRN( U,V) = W: COLOR= 12 - R * 3: PLOT U,V
25 IF U = E AND V = E THEN PRINT B$;:BR = BR - 1: VTAB 22: HTAB 40: PRINT BR;: POKE 49233,0: FOR T = 1 TO 800: NEXT: POKE 49232,0: ON 1 + NOT BR GOTO 155,220 25 IF U = E AND V = E THEN PRINT B$;:BR = BR - I: VTAB 22: HTAB 40: PRINT BR;: POKE 49233,0: FOR T = I TO 800: NEXT: POKE 49232,0: ON 1 + NOT BR GOTO 155,220
30 IF T THEN COLOR= W: PLOT U,V: GOTO 190 30 IF T THEN COLOR= W: PLOT U,V: GOTO 190
40 X = INT ( PDL(Z) * D):Y = INT ( PDL(I) * D2): IF Y > 38 THEN Y = 38 40 X = INT ( PDL(Z) * D):Y = INT ( PDL(I) * D2): IF Y > 38 THEN Y = 38
50 IF X < > P OR Y < > Q THEN COLOR= Z: GOSUB 95:P = X:Q = Y: GOSUB 90: IF SCRN( U,V) = W GOTO 190 50 IF X < > P OR Y < > Q THEN COLOR= Z: GOSUB 95:P = X:Q = Y: GOSUB 90: IF SCRN( U,V) = W GOTO 190
55 L = (L + I) * (L < H): IF L GOTO 40 55 L = (L + I) * (L < H): IF L GOTO 40
58 N = (NN = I) + N:NN = NN - NOT NOT NN:K = K + WV:K = (K < N) * K:U = ABS (U(K)) - I:V = V(K):R = (U(K) < Z) + I
60 B = (R - ( ABS (E - U) < R)) * SGN (E - U):C = (R - (ABS (E - V) < R)) * SGN (E - V) 60 B = (R - ( ABS (E - U) < R)) * SGN (E - U):C = (R - (ABS (E - V) < R)) * SGN (E - V)
70 IF B AND C THEN B = ( ABS ((E - V) / (E - U)) < J) * B:C = ( ABS ((E - U) / (E - V)) < J) * C 70 IF B AND C THEN B = ( ABS ((E - V) / (E - U)) < J) * B:C = ( ABS ((E - U) / (E - V)) < J) * C
80 COLOR= Z: PLOT U,V: U = U + B:V = V + C: GOTO 20 80 COLOR= Z: PLOT U,V:U = U + B:V = V + C:U(K) = SGN(U(K)) * (U + I):V(K) = V: GOTO 20
90 COLOR= G: PLOT E,E: COLOR= W 90 COLOR= G: PLOT E,E: COLOR= W
95 HLIN P,P + I AT Q: HLIN P,P + I AT Q + I: RETURN 95 HLIN P,P + I AT Q: HLIN P,P + I AT Q + I: RETURN
100 PR# 0: TEXT : HOME : VTAB 2: HTAB 13 100 PR# 0: TEXT : HOME : VTAB 2: HTAB 13: DEF FN M(T) = ( PEEK (49250) > 127) * 2 + ( PEEK (49249) > 127)
105 INVERSE : PRINT " SPACE ATTACK! ": NORMAL : PRINT : HTAB 13: PRINT "BY ALAN RATLIFF" 105 INVERSE : PRINT " SPACE ATTACK! ": NORMAL : PRINT : HTAB 13: PRINT "BY ALAN RATLIFF"
110 VTAB 7: PRINT " HIT THE ENEMY MISSILES BEFORE THEY HIT": PRINT " YOUR GREEN BASE---WATCH OUT FOR THE": PRINT " FAST BLUE ONES! (WHICH SCORE DOUBLE)" 110 VTAB 7: PRINT " USE THE [MOUSE] TO HIT THE ENEMY": PRINT " MISSILES BEFORE THEY HIT YOUR GREEN": PRINT " BASE---WATCH OUT FOR THE FAST BLUE": PRINT " MISSILES! (WHICH SCORE DOUBLE)"
115 VTAB 11: PRINT " THE FARTHER FROM BASE YOU HIT THE": PRINT " MISSILES, THE MORE YOU SCORE." 115 VTAB 12: PRINT " THE FARTHER FROM BASE YOU HIT THE": PRINT " MISSILES, THE MORE YOU SCORE."
120 VTAB 14: PRINT " GET A BONUS BASE EVERY 2000 POINTS!" 120 VTAB 15: PRINT " GET A BONUS BASE EVERY 2000 POINTS!"
122 PRINT " (BUT THE MISSILES COME FASTER....": HTAB 9: PRINT "AND SCORE MORE POINTS!)" 122 PRINT " (BUT THE MISSILES COME FASTER....": HTAB 9: PRINT "AND SCORE MORE POINTS!)"
125 VTAB 19: PRINT "THE GAME ENDS WHEN THE MISSILES HAVE HITFIVE BASES (PLUS BONUS BASES)." 125 VTAB 19: PRINT "THE GAME ENDS WHEN THE MISSILES HAVE HITFIVE BASES (PLUS BONUS BASES)."
130 VTAB 23: PRINT "PRESS THE [HOME KEY] TO BEGIN..." 130 VTAB 23: PRINT "PRESS [HOME] FOR THE FIRST ATTACK WAVE;": PRINT "PRESS [END] FOR THE SECOND ATTACK WAVE.";
135 IF PEEK (49249) < 128 GOTO 135 135 T = FN M(0): IF NOT T GOTO 135
140 Z = 0:I = 1:D = 1 / 6.7:D2 = 1 / 5.5:G = 12:W = 15:E = 20:J = 2:F = 58.5:B$ = CHR$ (7) 140 Z = 0:I = 1:D = I / 6.7:D2 = I / 5.5:G = 12:W = 15:E = 20:J = 2:F = 58.5:B$ = CHR$ (7)
142 HOME : VTAB 11: HTAB 19: PRINT "BOOM!" 142 HOME : VTAB 11: HTAB 19: PRINT "BOOM!"
145 GR : HOME :S = 0:M = 5:H = 80:P = INT (PDL (Z) * D):Q = INT ( PDL (I) * D2): IF Q > 38 THEN Q = 38 145 GR : HOME :WV = T = 2:S = Z:M = 5:H = 80:P = INT (PDL (Z) * D):Q = INT ( PDL (I) * D2): IF Q > 38 THEN Q = 38
150 VTAB 22: PRINT "SCORE: 0" TAB( 28)"BASES LEFT: 5";:BR = 5 150 VTAB 22: PRINT "SCORE: 0" TAB( 28)"BASES LEFT: 5";:BR = 5
152 R = RND ( - PEEK (79) * 999 - PEEK (78)) 152 R = RND ( - PEEK (79) * 999 - PEEK (78)):N = I:K = Z
155 GOSUB 90 155 GOSUB 90
165 VTAB 22: HTAB 15: PRINT SPC( 10) 165 VTAB 22: HTAB 15: PRINT SPC( 10):T = Z
170 R = INT ( RND (I) * 156):U = (F - ABS (R - F)) * (R < 117): IF U > 39 THEN U = 39 170 FOR X = Z TO T:R = INT ( RND (I) * 156):U = (F - ABS (R - F)) * (R < 117): IF U > 39 THEN U = 39
175 V = (F - ABS (R - 97.5)) * (R > 39): IF V > 39 THEN V = 39 175 V = (F - ABS (R - 97.5)) * (R > 39): IF V > 39 THEN V = 39
185 R = INT ( RND (I) * 1.1) + I:RC = 12 - R * 3: GOTO 20 185 R = INT ( RND (I) * 1.1) + I:T = N * X + K * NOT X: U(T) = (3 - R * 2) * (U + I):V(T) = V: NEXT : GOTO 20
190 U = U - E:V = V - E:SC = INT ( SQR (U * U + V * V) - I) * R * M 190 U = U - E:V = V - E:SC = INT ( SQR (U * U + V * V) - I) * R * M
195 S = S + SC: VTAB 22: HTAB 8: PRINT S;B$ 195 S = S + SC: VTAB 22: HTAB 8: PRINT S;B$
205 IF INT (S / 2E3) = INT ((S - SC) / 2E3) GOTO 165 205 IF INT (S / 2E3) = INT ((S - SC) / 2E3) GOTO 165
210 FLASH : VTAB 22: HTAB 15: PRINT "BONUS BASE"B$;: NORMAL 210 FLASH : VTAB 22: HTAB 15: PRINT "BONUS BASE"B$;: NORMAL
215 BR = BR + I: HTAB 40: PRINT BR;: H = INT (H * .8):M = M + I: GOTO 170 215 BR = BR + I: HTAB 40: PRINT BR;:H = INT ((WV / 10 + .8) * H * N / (N + WV)):M = M + WV + I:NN = (N + 10) * WV:T = WV: GOTO 170
220 PRINT "PRESS [HOME KEY] TO PLAY AGAIN,": PRINT "OR ANY OTHER KEY TO EXIT."; 220 PRINT "PRESS [HOME] FOR NEW FIRST WAVE, [END]": PRINT "FOR NEW SECOND WAVE; ANY OTHER KEY:EXIT";
225 IF PEEK (49249) > 127 GOTO 145 225 T = FN M(Z): IF T GOTO 145
230 IF PEEK (49152) < 128 GOTO 225 230 IF PEEK (49152) < 128 GOTO 225
235 POKE 49168,0: HTAB I: VTAB 23: CALL - 958 235 POKE 49168,Z: HTAB I: VTAB 23: CALL - 958: PRINT : PRINT "BYE FOR NOW!";

420
samples/sample.tetris.txt
View File

@ -1,16 +1,17 @@
10 rem Tetris code 10 rem Tetris code
90 gosub 4550 : rem Title screen and random number seed 80 DEF FN SHCOLR(a) = ASC(MID$("@ACFIKLM",a + 1,1)) - 64
90 gosub 4550 : rem Title screen
100 time = 500 100 time = 500
110 height = 39 : rem Cannot be larger than 47 110 height = 39 : rem Cannot be larger than 47 (REALLY 39)
120 left = 0 120 left = 0
130 width = 9 130 width = 9
140 dim array(width + 1, height + 1), erase(height) 140 dim array(width + 1, height + 1), erase(height)
145 dim sh(7), tl(4) 145 dim sp(7), tl(4)
150 gr 150 gr
160 home 160 home
170 if height > 39 then poke - 16302,0 : rem Extend graphics screen past text window if height is too large 165 gosub 1850 : rem Set up shapes at bottom of screen
175 gosub 1850 : rem Set up shapes at bottom of screen
177 gosub 4240 : rem Set up total line labels 170 gosub 4240 : rem Set up total line labels
180 color= 15 : rem Draw borders 180 color= 15 : rem Draw borders
190 vlin 0, height at left 190 vlin 0, height at left
200 vlin 0, height at left + width + 1 200 vlin 0, height at left + width + 1
@ -22,198 +23,88 @@
240 next fill 240 next fill
245 rem Fill left and right sides 245 rem Fill left and right sides
250 for fill = 0 to height + 1 250 for fill = 0 to height
260 array(0, fill) = 15 260 array(0, fill) = 15 : erase(fill) = 0
270 array(left+width+1, fill) = 15 265 FOR a = 1 TO width : array(a,fill) = 0 : NEXT
280 next fill 270 array(width+1, fill) = 15
275 next fill
285 eg=0 280 sd = RND (-PEEK(79) * 999 - PEEK(78)): rem random number seed
285 eg=0 : tt = 0
290 gosub 3250: rem Choose piece 290 gosub 3250: rem Choose piece
295 lshape = shape 295 lshape = shape
300 rem Start playing 300 rem Start playing
310 Gosub 2020: rem Make turn 310 gosub 2020: rem Make turn
320 if not eg then 310 320 if not eg then 310
330 end
340 rem Shape routines 325 REM END OF GAME
345 rem Suggestion for shape definitions with improved lookup speed. Format an array as DN(shape, rot, coord, block) where coord is either the x or y corrdinate, and block is an element (1 - 4) in the shape. This function will return a value of -2, -1, 0, +1 or +2 as an offset of the current x, y position. 330 VTAB 23 : HTAB 21 : PRINT "GAME OVER"
340 HTAB 20 : PRINT "PLAY AGAIN?";
350 a = PEEK(49152) : IF a < 128 GOTO 350
360 POKE 49168,0 : a = a - (a > 223) * 32
365 IF a = 206 THEN HTAB 20 : PRINT " GOODBYE FOR NOW!"; : END
370 IF a <> 217 GOTO 350
380 COLOR= 0 : FOR a = 1 TO width : VLIN 0,height AT a : NEXT
390 GOSUB 1700 : HOME : GOTO 170
350 rem Shape 1, rot 1; straight piece vertical 395 REM CREATE SHAPE ARRAYS, READ SHAPE DATA (VARIANT OF OLD SUGGESTION)
360 a1 = x - 2 : b1 = y 400 DIM D1(7,4),D2(7,4),D3(7,4),D4(7,4),E1(7,4),E2(7,4),E3(7,4),E4(7,4)
370 a2 = x - 1 : b2 = y 410 FOR x = 1 TO 7
380 a3 = x : b3 = y 420 FOR y = 1 TO (x > 1 AND x < 5) * 2 + (x <> 5) + 1
390 a4 = x + 1 : b4 = y 430 READ D1(x,y),E1(x,y), D2(x,y),E2(x,y), D3(x,y),E3(x,y), D4(x,y),E4(x,y)
400 return 440 NEXT y,x
450 RETURN
410 rem Shape 1, rot 2; straight piece horizontal 490 rem Shape data
420 a1 = x : b1 = y - 1
430 a2 = x : b2 = y
440 a3 = x : b3 = y + 1
450 a4 = x : b4 = y + 2
460 return
470 rem Shape 2, rot 1; L shape vertical 500 DATA -2,0, -1,0, 0,0, 1,0: rem Shape 1, rot 1; straight piece horizontal
480 a1 = x - 1 : b1 = y 510 DATA 0,-1, 0,0, 0,1, 0,2: rem Shape 1, rot 2; straight piece vertical
490 a2 = x : b2 = y
500 a3 = x + 1 : b3 = y
510 a4 = x + 1 : b4 = y - 1
520 return
530 rem Shape 2, rot 2; L shape horizontal 520 DATA -1,0, 0,0, 1,0, 1,-1: rem Shape 2, rot 1; L shape horizontal
540 a1 = x - 1 : b1 = y - 1 530 DATA -1,-1, 0,-1, 0,0, 0,1:rem Shape 2, rot 2; L shape vertical
550 a2 = x : b2 = y - 1 590 DATA -1,1, -1,0, 0,0, 1,0: rem Shape 2, rot 3
560 a3 = x : b3 = y 650 DATA 0,-1, 0,0, 0,1, 1,1: rem Shape 2, rot 4
570 a4 = x : b4 = y + 1
580 return
590 rem Shape 2, rot 3 710 DATA -1,0, 0,0, 1,0, 1,1: rem shape 3, rot 1; Reverse L shape
600 a1 = x - 1 : b1 = y + 1 770 DATA 1,-1, 0,-1, 0,0, 0,1: rem shape 3, rot 2
610 a2 = x - 1 : b2 = y 830 DATA -1,-1, -1,0, 0,0, 1,0:rem shape 3, rot 3
620 a3 = x : b3 = y 840 DATA 0,-1, 0,0, 0,1, -1,1: rem shape 3, rot 4
630 a4 = x + 1 : b4 = y
640 return
650 rem Shape 2, rot 4 850 DATA 0,-1, -1,0, 0,0, 1,0: rem shape 4, rot 1; T shape
660 a1 = x : b1 = y - 1 860 DATA 0,-1, -1,0, 0,0, 0,1: rem shape 4, rot 2
670 a2 = x : b2 = y 870 DATA -1,0, 0,0, 1,0, 0,1: rem shape 4, rot 3
680 a3 = x : b3 = y + 1 880 DATA 0,-1, 0,0, 1,0, 0,1: rem shape 4, rot 4
690 a4 = x + 1 : b4 = y + 1
700 return
710 rem shape 3, rot 1; Reverse L shape 890 DATA 0,-1, 1,-1, 0,0, 1,0: rem shape 5; square
720 a1 = x - 1 : b1 = y
730 a2 = x : b2 = y
740 a3 = x + 1 : b3 = y
750 a4 = x + 1 : b4 = y + 1
760 return
770 rem shape 3, rot 4 900 DATA 0,0, 1,0, -1,1, 0,1: rem shape 6, rot 1; S shape
780 a1 = x : b1 = y - 1 910 DATA 0,-1, 0,0, 1,0, 1,1: rem shape 6, rot 2
790 a2 = x : b2 = y
800 a3 = x : b3 = y + 1
810 a4 = x - 1 : b4 = y + 1
820 return
830 rem shape 3, rot 3 920 DATA -1,-1, 0,-1, 0,0, 1,0:rem shape 7, rot 1; Z shape
840 a1 = x - 1 : b1 = y - 1 930 DATA 0,-1, -1,0, 0,0, -1,1:rem shape 7, rot 2
850 a2 = x - 1 : b2 = y
860 a3 = x : b3 = y
870 a4 = x + 1 : b4 = y
880 return
890 rem shape 3, rot 2 1490 rem Shape "directory"
900 a1 = x + 1 : b1 = y - 1 1500 a1 = D1(shape,rt) + x : b1 = E1(shape,rt) + y
910 a2 = x : b2 = y - 1 1510 a2 = D2(shape,rt) + x : b2 = E2(shape,rt) + y
920 a3 = x : b3 = y 1520 a3 = D3(shape,rt) + x : b3 = E3(shape,rt) + y
930 a4 = x : b4 = y + 1 1530 a4 = D4(shape,rt) + x : b4 = E4(shape,rt) + y
940 return 1540 return
950 rem shape 4, rot 1; T shape 1590 rem PAUSE
960 a1 = x : b1 = y - 1 1600 VTAB 23 : HTAB 20 : PRINT "== PAUSED =="; : HTAB 20
970 a2 = x - 1 : b2 = y 1610 FOR a = 0 TO 1 : a = PEEK(49152) > 127 : NEXT
980 a3 = x : b3 = y 1620 POKE 49168,0 : CALL -868
990 a4 = x + 1 : b4 = y 1630 RETURN
1000 return
1010 rem shape 4, rot 2 1690 REM ERASE SHAPE IN "NEXT" WINDOW
1020 a1 = x : b1 = y - 1 1700 x = left + width + 5 : rem Offset shape for drawing in Next window
1030 a2 = x - 1 : b2 = y 1710 y = 1 : rt = 1
1040 a3 = x : b3 = y 1720 shape = lshape
1050 a4 = x : b4 = y + 1 1730 xdr = 1 : rem Set variable for erasing shape in last "next" window
1060 return
1070 rem shape 4, rot 3 1760 rem Draw shape
1080 a1 = x - 1 : b1 = y 1770 color= 0 : if not xdr then color= FN SHCOLR(shape)
1090 a2 = x : b2 = y
1100 a3 = x + 1 : b3 = y
1120 a4 = x : b4 = y + 1
1130 return
1140 rem shape 4, rot 4
1150 a1 = x : b1 = y - 1
1160 a2 = x : b2 = y
1170 a3 = x + 1 : b3 = y
1180 a4 = x : b4 = y + 1
1190 return
1200 rem shape 5; square
1210 a1 = x : b1 = y - 1
1220 a2 = x + 1 : b2 = y - 1
1230 a3 = x : b3 = y
1240 a4 = x + 1 : b4 = y
1250 return
1260 rem shape 6, rot 1; S shape
1270 a1 = x : b1 = y
1280 a2 = x + 1 : b2 = y
1290 a3 = x - 1 : b3 = y + 1
1300 a4 = x : b4 = y + 1
1310 return
1320 rem shape 6, rot 2
1330 a1 = x : b1 = y - 1
1340 a2 = x : b2 = y
1350 a3 = x + 1 : b3 = y
1360 a4 = x + 1 : b4 = y + 1
1370 return
1380 rem shape 7, rot 1; Z shape
1390 a1 = x - 1 : b1 = y - 1
1400 a2 = x : b2 = y - 1
1410 a3 = x : b3 = y
1420 a4 = x + 1 : b4 = y
1430 return
1440 rem shape 7, rot 2
1450 a1 = x : b1 = y - 1
1460 a2 = x - 1 : b2 = y
1470 a3 = x : b3 = y
1480 a4 = x - 1 : b4 = y + 1
1490 return
1500 rem Shape directory
1510 if shape <> 1 then 1570 : return
1520 if rt = 1 then gosub 350
1525 if rt = 2 then gosub 410
1560 return
1570 if shape <> 2 then 1620
1580 if rt = 1 then gosub 470 : return
1590 if rt = 2 then gosub 530 : return
1600 if rt = 3 then gosub 590 : return
1605 if rt = 4 then gosub 650
1610 return
1620 if shape <> 3 then 1670
1630 if rt = 1 then gosub 710 : return
1640 if rt = 2 then gosub 890 : return
1650 if rt = 3 then gosub 830 : return
1655 if rt = 4 then gosub 770 : return
1660 return
1670 if shape <> 4 then 1710
1680 if rt = 1 then gosub 950 : return
1690 if rt = 2 then gosub 1010 : return
1700 if rt = 3 then gosub 1070 : return
1705 if rt = 4 then gosub 1140 : return
1710 if shape = 5 then gosub 1200 : return
1720 if shape <> 6 then 1740
1730 if rt = 1 then gosub 1260 : return
1733 if rt = 2 then gosub 1320
1735 return
1740 if shape <> 7 then 1760
1750 if rt = 1 then gosub 1380 : return
1755 if rt = 2 then gosub 1440
1760 return
1770 rem Draw shape
1780 color= shape
1785 if xdr then color= 0
1790 gosub 1500 : rem get shape from directory 1790 gosub 1500 : rem get shape from directory
1800 plot a1, b1 1800 plot a1, b1
1810 plot a2, b2 1810 plot a2, b2
@ -223,9 +114,9 @@
1850 rem Set up shapes at bottom of screen 1850 rem Set up shapes at bottom of screen
1860 rt = 1 1860 rt = 1
1870 y = 37 1870 x = 14
1880 x = 14 1880 for shape = 1 to 7
1890 for shape = 1 to 7 1890 y = 38 - (shape = 3 OR shape = 6)
1900 gosub 1770 : rem Draw shape 1900 gosub 1770 : rem Draw shape
1910 x = x + 4 1910 x = x + 4
1920 next shape 1920 next shape
@ -236,23 +127,15 @@
1950 cfl = 0 1950 cfl = 0
1960 gosub 1500 : rem Shape directory 1960 gosub 1500 : rem Shape directory
1965 if a1 < 0 or b1 < 0 or a2 < 0 or b2 < 0 or a3 < 0 or b3 < 0 or a4 < 0 or b4 < 0 then cfl = 1 : return 1965 if a1 < 0 or b1 < 0 or a2 < 0 or b2 < 0 or a3 < 0 or b3 < 0 or a4 < 0 or b4 < 0 then cfl = 1 : return
1970 if array(a1, b1) then cfl = 1 : return 1970 cfl = array(a1, b1) or array(a2, b2) or array(a3, b3) or array(a4, b4)
1980 if array(a2, b2) then cfl = 1 : return
1990 if array(a3, b3) then cfl = 1 : return
2000 if array(a4, b4) then cfl = 1 : return
2010 return 2010 return
2020 rem Make turn 2020 rem Make turn
2023 null = peek (49168) : rem Reset keyboard strobe 2030 null = peek (49168) : rem Reset keyboard strobe
2025 t1 = time 2040 t1 = time
2030 y = 1 2050 bot = 0
2033 bot = 0 2060 drop = 0
2035 drop = 0 2070 gosub 1700 : rem Draw (erase) shape in "next" window
2040 x = 1 + left + width + 4 : rem Offset shape for drawing in Next window
2050 rt = 1
2055 shape = lshape
2060 xdr = 1 : rem Set variable for erasing shape in last "next" window
2070 gosub 1770 : rem Draw (erase) shape
2080 xdr = 0 2080 xdr = 0
2090 ns = lshape 2090 ns = lshape
2100 gosub 3250 : rem Pick shape 2100 gosub 3250 : rem Pick shape
@ -278,63 +161,39 @@
3210 y = y + 1 3210 y = y + 1
3215 cfl = 0 3215 cfl = 0
3220 if not bot then gosub 4740 : rem Move piece 3220 if not bot then gosub 4740 : rem Move piece
3230 if cfl then gosub 3660 : return : rem Add to shape & check for complete line 3230 if cfl goto 3660 : rem Add to shape & check for complete line
3233 if not bot then 3180 : rem Back to top of Make move loop, else force to bottom 3233 if not bot goto 3180 : rem Back to top of Make move loop, else force to bottom
3235 y = y - 1 : xdr = 1 3235 y = y - 1 : xdr = 1
3239 gosub 1770 : rem Draw shape (erase) 3239 gosub 1770 : rem Draw shape (erase)
3242 y = y + 1 : xdr = 0 3242 y = y + 1 : xdr = 0
3245 gosub 4430 : return : rem Send piece to bottom 3245 goto 4440 : rem Send piece to bottom
3250 rem Pick shape 3250 rem Pick shape
3260 shape = 1 + int (7 * rnd(sd)) 3260 shape = int (rnd(sd) * 7) + 1
3270 return 3270 return
3280 rem Process input 3280 rem Process input
3285 a = PEEK (49152) 3285 a = PEEK (49152)
3290 get g$ 3290 get g$
3300 if g$ = " " then gosub 3470 : return : rem Check for rotate 3300 if g$ = " " goto 3480 : rem Check for rotate
3310 if g$ = "J" or a = 136 then gosub 3350 : return : rem Check for move left 3310 if g$ = "J" or a = 136 then a = -1 : goto 4720 : rem Check for move left
3320 if g$ = "K" or a = 149 then gosub 3410 : return : rem Check for move right 3320 if g$ = "K" or a = 149 then a = 1 : goto 4720 : rem Check for move right
3325 if g$ = "D" or a = 138 then gosub 4480 : return : rem Force down 3325 if g$ = "D" or a = 138 goto 4480 : rem Force down
3330 if g$ = "M" then bot = 1 : return : rem Send piece to bottom 3330 if g$ = "M" then bot = 1 : return : rem Send piece to bottom
3335 if g$ = "S" then drop = 1 : rem Speed up piece 3335 if g$ = "S" then drop = 1 : rem Speed up piece
3337 if g$ = "P" then gosub 4700 : return : rem Pause game 3337 if g$ = "P" then goto 1600 : rem Pause game
3340 return 3340 return
3350 rem Check for move left 3470 rem Check for rotate (SHAPE 5 DOES NOT CHANGE)
3360 x1 = x : y1 = y : r1 = rt 3480 if shape = 5 then return
3370 x = x - 1 3490 r1 = rt : x1 = x : y1 = y
3380 gosub 4740 : rem Move piece 3500 gosub 3600 : rem Rotate directory
3400 return 3510 goto 4740 : rem Move piece
3410 rem Check for move right 3590 rem Rotate directory
3420 x1 = x : y1 = y : r1 = rt 3600 if shape = 1 or shape > 5 then rt = 3 - rt : return : rem Two way rotate
3430 x = x + 1 3610 if shape < 5 then rt = (rt < 4) * rt + 1 : rem Four way rotate
3450 gosub 4740 : rem Move piece 3620 return
3460 return
3470 rem Check for rotate
3480 r1 = rt : x1 = x : y1 = y
3490 gosub 3530 : rem Rotate directory
3510 gosub 4740 : rem Move piece
3520 return
3530 rem Rotate directory
3540 if shape = 1 or shape = 7 or shape = 6 then gosub 3570 : return : rem Two way rotate
3550 if shape = 2 or shape = 3 or shape = 4 then gosub 3600 : return : rem Four way rotate
3560 return
3570 rem Two way rotate
3580 if rt = 1 then rt = 2 : return
3585 if rt = 2 then rt = 1
3590 return
3600 rem Four way rotate
3610 if rt = 1 then rt = 2 : return
3620 if rt = 2 then rt = 3 : return
3630 if rt = 3 then rt = 4 : return
3640 rt = 1
3650 return
3660 rem Check for complete line 3660 rem Check for complete line
3665 gosub 3770 : rem Add piece to board 3665 gosub 3770 : rem Add piece to board
@ -343,12 +202,12 @@
3677 if y + 2 = > height then dw = height 3677 if y + 2 = > height then dw = height
3680 for row = y - 1 to dw 3680 for row = y - 1 to dw
3690 hit = 0 3690 hit = 0
3700 for c = left + 1 to width + left 3700 for c = 1 to width
3710 if not array (c, row) then hit = 1 3710 if not array (c, row) then hit = 1
3720 next c 3720 next c
3730 if not hit then erase(row) = 1 : line = line + 1 3730 if not hit then erase(row) = 1 : line = line + 1
3740 next row 3740 next row
3750 if line then gosub 3850 : rem Blink & erase lines 3750 if line goto 3850 : rem Blink & erase lines
3760 return 3760 return
3770 rem Add to board 3770 rem Add to board
@ -372,12 +231,11 @@
3920 next row 3920 next row
3925 for zz = 0 to 300 : next zz : rem Time delay 3925 for zz = 0 to 300 : next zz : rem Time delay
3930 next blink 3930 next blink
3933 gosub 4020 : rem Restack shape 3933 goto 4020 : rem Restack shape
3940 return
3950 rem Redraw line 3950 rem Redraw line
3960 for c = left + 1 to left + width 3960 for c = 1 to width
3980 color= array(c, row) 3980 color= FN SHCOLR(array(c, row))
3990 plot c, row 3990 plot c, row
4000 next c 4000 next c
4010 return 4010 return
@ -391,7 +249,7 @@
4045 if not erase (row) then gosub 4080 : goto 4060 : rem Shift row 4045 if not erase (row) then gosub 4080 : goto 4060 : rem Shift row
4050 if erase (row) then sh = sh + 1 : erase (row) = 0 4050 if erase (row) then sh = sh + 1 : erase (row) = 0
4060 row = row - 1 4060 row = row - 1
4065 if row + sh > 0 then 4043 4065 if row + sh > 0 then 4044
4070 return 4070 return
4080 rem Shift row 4080 rem Shift row
@ -399,7 +257,7 @@
4090 for c = 1 to width 4090 for c = 1 to width
4095 if array (c, row) then hit = 1 :rem If there is an active cell, it's not a completely blank line. 4095 if array (c, row) then hit = 1 :rem If there is an active cell, it's not a completely blank line.
4100 array (c, row + sh) = array (c, row) 4100 array (c, row + sh) = array (c, row)
4110 color= array (c, row) 4110 color= FN SHCOLR(array (c, row))
4120 plot c, row + sh 4120 plot c, row + sh
4130 next c 4130 next c
4135 if not hit then l1 = l1 + 1 : rem If the line is completely blank 4135 if not hit then l1 = l1 + 1 : rem If the line is completely blank
@ -409,76 +267,73 @@
4160 rem calculate & print total shapes picked 4160 rem calculate & print total shapes picked
4170 sp (shape) = sp (shape) + 1 4170 sp (shape) = sp (shape) + 1
4190 vtab 21 4190 vtab 21
4200 htab 10 + (shape * 4) 4200 htab shape * 4 + 10
4210 print sp(shape); 4210 print sp(shape);
4230 return 4230 return
4240 rem set up total line labels 4240 rem set up total line labels
4245 htab 1 4250 htab 1: vtab 21 : print "SIN"
4250 vtab 21 : print "SIN" 4260 print "DOU" : print "TRI"
4255 htab 1 4270 print "TET" tab (10) "TOT";
4260 vtab 22 : print "DOU" 4280 FOR a = 0 TO 4 : tl(a) = 0 : NEXT
4265 htab 1 4290 FOR a = 1 TO 7 : sp(a) = 0 : NEXT
4270 vtab 23 : print "TRI"
4275 htab 1
4280 vtab 24 : print "TET";
4285 htab 24
4290 htab 10 : print "TOT";
4300 return 4300 return
4310 rem calculate & print total lines cleared 4310 rem calculate & print total lines cleared
4320 tl (line) = tl (line) + 1 : tt = tt + line 4320 tl(line) = tl(line) + 1 : tt = tt + line
4350 htab 7 4350 htab 6
4360 vtab 20 + line 4360 vtab 20 + line
4370 print tl (line); 4370 print tl(line);
4390 htab 15 4390 htab 15
4400 vtab 24 4400 vtab 24
4410 print tt; 4410 print tt;
4420 return 4420 return
4430 rem Send piece to bottom 4430 rem Send piece to bottom - DROP IT DOWN UNTIL "CONFLICT" OCCURS (HITS OTHER PIECES OR BOTTOM)
4440 y = y + 1 4440 y = y + 1
4450 gosub 1940 : rem Check for conflict 4450 gosub 1940 : rem Check for conflict
4460 if cfl then y = y - 1 : gosub 1770 : gosub 3660 : return : rem Draw, Add to bottom 4460 if cfl then y = y - 1 : gosub 1770 : goto 3660 : rem Draw, Add to bottom
4470 goto 4440 4470 goto 4440
4480 rem Force piece down 4480 rem Force piece down
4490 y1 = y : x1 = x : r1 = rt 4490 y1 = y : x1 = x : r1 = rt
4500 y = y + 1 4500 y = y + 1
4510 gosub 4740 : rem Move piece 4510 goto 4740 : rem Move piece
4540 return
4550 rem Title screen and random number seed 4550 rem Title screen
4555 pr#0 4555 pr#0
4560 text : home 4560 text : home
4570 print "Tetris for Applesoft BASIC" 4570 print "Tetris for Applesoft BASIC"
4580 print "Programed by Arthur Allen" 4580 print "Programmed by Arthur Allen"
4590 print "Based on Tetris by Alexey Pajitnov" 4590 print "Based on Tetris by Alexey Pajitnov"
4680 print 4600 print : print : print "Keys:"
4690 print "Press Enter to begin" 4610 print "<-- or J to move piece left"
4620 print "--> or K to move piece right"
4630 print "<SPACE> to rotate piece anti-clockwise"
4640 print " | M to send piece to bottom"
4650 print " | or D to force piece down"
4660 print "\|/ S to speed up piece"
4670 htab 7 : print "P to pause game"
4680 print : GOSUB 400 : REM READ SHAPE DATA
4690 INPUT "Press Enter to begin";g$
4695 RETURN
4700 for sd = 0 to 9999999 4710 rem PREPARE TO MOVE PIECE LEFT OR RIGHT, THEN MOVE IT
4710 if peek (49152) = 141 then get g$ : null = peek (49168) : return 4720 x1 = x : y1 = y : r1 = rt : x = x + a
4712 null = peek (49168) : rem Reset keyboard strobe
4715 a = rnd (sd)
4720 next sd
4730 goto 4700
4740 rem move piece 4730 rem move piece
4750 c1 = a1 : d1 = b1 4740 c1 = a1 : d1 = b1
4760 c2 = a2 : d2 = b2 4760 c2 = a2 : d2 = b2
4770 c3 = a3 : d3 = b3 4770 c3 = a3 : d3 = b3
4780 c4 = a4 : d4 = b4 4780 c4 = a4 : d4 = b4
4790 gosub 1940 : rem Check for conflict 4790 gosub 1940 : rem Check for conflict
4795 rem vtab 21 : htab 1 : print "4795 Move piece: x, y , g$, cfl "; x; " "; y; " "; g$; cfl; : rem temp code 4800 if cfl goto 4900 : rem Return old values
4796 rem if y = 40 then vtab 22 : htab 1 : print "4796 y=40, cfl = "; cfl
4800 if cfl then gosub 4890 : return : rem Return old values
4805 color= 0 4805 color= 0
4810 plot c1, d1 4810 plot c1, d1
4820 plot c2, d2 4820 plot c2, d2
4830 plot c3, d3 4830 plot c3, d3
4840 plot c4, d4 4840 plot c4, d4
4845 color= shape 4845 color= FN SHCOLR(shape)
4850 plot a1, b1 4850 plot a1, b1
4860 plot a2, b2 4860 plot a2, b2
4870 plot a3, b3 4870 plot a3, b3
@ -493,8 +348,7 @@
4940 rt = r1 4940 rt = r1
4950 x = x1 4950 x = x1
4960 y = y1 4960 y = y1
4965 gosub 1500 : rem Shape directory 4965 goto 1500 : rem Shape directory
4970 return
4980 rem Clear top of shape 4980 rem Clear top of shape
4990 color= 0 4990 color= 0
@ -504,4 +358,4 @@
5030 next c 5030 next c
5040 return 5040 return
5050 rem End of listing 5050 rem End of listing