commit 6097d69

Add prg/ascii.font and prg/robots.tal

  1@@ -0,0 +1,387 @@
  2+\\ "Robots" game (similar to the BSD games "robots" game)
  3+\\ (This file is public domain.)
  4+
  5+|0000
  6+  @PlayerX $1
  7+  @PlayerY $1
  8+  @NumRobots $1
  9+  @Level $1
 10+  @Score $2
 11+  @HiScore $2
 12+
 13+\\ Playfield size (including the border) is 0x28 by 0x22
 14+|d8de @Playfield \_@1-! @Playfield- $102 @Playfield+ $1 @Playfield++
 15+\:Playfield \_8> \@PlayfieldH
 16+
 17+|0100
 18+  \\ Colours
 19+  #1ef8 #08 DEO2
 20+  #1e7d #0a DEO2
 21+  #1e58 #0c DEO2
 22+  \\ Size
 23+  #0140 #22 DEO2
 24+  #0120 #24 DEO2
 25+  \\ Sound
 26+  #0000 #38 DEO2
 27+  #0004 #3a DEO2
 28+  ;Wave #3c DEO2
 29+  \\ Others
 30+  #0126 DEO
 31+  ;inputVec #80 DEO2
 32+  \\ Random number seed
 33+  #c4 DEI #c1 DEI ADD #c5 DEI INC2 ;prng64/x STA2
 34+  #c9 DEI #c6 DEI INC2 ;prng64/y STA2
 35+
 36+@title
 37+  cls
 38+  sound 33fc 35fc 37f8 3afc 00f9 3afc 0000
 39+  #1008 locate
 40+  #8202 showc
 41+  #01 showi 20 "ROBOTS 20 00
 42+  #8202 showc
 43+  #0b10 locate
 44+  #01 showi "Push 20 "space 20 "to 20 "begin 00
 45+  #0120 locate
 46+  #01 showi "Last 20 "score: 20 00
 47+  .Score LDZ2 #03 shown
 48+  #0121 locate
 49+  #01 showi "High 20 "score: 20 00
 50+  .HiScore LDZ2 #03 shown
 51+  [@ input #20 NEQ ]?
 52+  #00 DUPk .Score STZ2 .Level STZ
 53+
 54+@beginlevel
 55+  sound 2efc 33fc 35fc 37fc 3afc 3ffc 0000
 56+  \\ Add walls and floors
 57+  ;Playfield [@
 58+    STH2k ;Playfield+ LTH2
 59+    STH2rk #fefe GTH2
 60+    STHrk INC .Playfield++ LTH
 61+    ORA ORA DUP ADD STH2rk STA STH2r
 62+  INC2 DUP [? POP .Playfield ]@ OVR ]? POP2
 63+  ;NumRobots STZ
 64+  \\ Add robots
 65+  LIT2 f8 -Level LDZ SUB [@
 66+    #01
 67+    #253f random #1f3f random ;Playfield+ ADD2
 68+    LDAk [? .NumRobots LDZk INC SWP STZ ]@
 69+    STA
 70+  INC DUP ]? POP
 71+  \\ Add player
 72+  #253f random #1f3f random ;Playfield+ ADD2 STH2k .PlayerX STZ2
 73+  \\ If there is a robot where the player is, destroy the robot
 74+  .NumRobots LDZ LDArk STHr SUB .NumRobots STZ
 75+  #00 STH2r STA
 76+
 77+@game
 78+  redraw input #7f AND #0007 SFT2 ;KeyMap ADD2 LDA2 ORAk ROT ROT JCN2 !game
 79+
 80+@KeyMap $0100
 81+%Key { \:KeyMap \_@1-:!#@g:++@,P }
 82+
 83+"t Key
 84+  \\ Teleport player to a vacant cell
 85+  [@
 86+    #253f random #1f3f random ;Playfield+ ADD2 STH2k .PlayerX STZ2
 87+    STH2r LDA
 88+  ]?
 89+  step
 90+  sound 40fe 41fe 43fe 44fe 46fe 47fe 49fe 4afe 0000
 91+  !game
 92+
 93+"w Key
 94+  \\ Wait until all robots are broken; add extra points
 95+  .Score LDZ2 ;NumRobots LDZ ADD2 .Score STZ2
 96+  [@ step ]!
 97+
 98+"b Key "1 Key
 99+  #ff01 !move1
100+"j Key "2 Key
101+  #0001 !move1
102+"n Key "3 Key
103+  #0101 !move1
104+"h Key "4 Key
105+  #ff00 !move1
106+20 Key ". Key "5 Key
107+  #0000 @move1 move [? sound 37f8 30f8 0000 ]@ !game
108+"l Key "6 Key
109+  #0100 !move1
110+"y Key "7 Key
111+  #feff !move1
112+"k Key "8 Key
113+  #ffff !move1
114+"u Key "9 Key
115+  #00ff !move1
116+
117+"B Key
118+  #ff01 !moveM
119+"J Key
120+  #0001 !moveM
121+"N Key
122+  #0101 !moveM
123+"H Key
124+  #ff00 !moveM
125+"> Key
126+  #0000 @moveM [@ DUP2 move ]? POP2 !game
127+"L Key
128+  #0100 !moveM
129+"Y Key
130+  #feff !moveM
131+"K Key
132+  #ffff !moveM
133+"U Key
134+  #00ff !moveM
135+
136+"x Key
137+  .PlayerX LDZ2 ;Playfield- SUB2 locate #820d showc
138+  input POP !game
139+
140+"? Key
141+  cls
142+  #0101 locate #03 showi "yku 00
143+  #0102 locate #03 showi "h.l 00 #01 showi 20 "Walk 00
144+  #0103 locate #03 showi "bjn 00
145+  #1101 locate #03 showi "YKU 00
146+  #1102 locate #03 showi "H>L 00 #01 showi 20 "Run 00
147+  #1103 locate #03 showi "BJN 00
148+  #0105 locate LIT2 "t 03 showc #01 showi 20 "Teleport 20 "at 20 "random 00
149+  #0107 locate LIT2 "w 03 showc #01 showi 20 "Wait 20 "for 20 "next 20 "level 00
150+  #0109 locate LIT2 "x 03 showc #01 showi 20 "Reveal 20 "player 00
151+  input POP !game
152+
153+@move ( dir* -- ok )
154+  \\ New coordinates of player
155+  \\ (don't worry about carry, since the walls will take care of that)
156+  .PlayerX LDZ2 ADD2
157+  LDAk ?&bad \\ Cannot move into an occupied cell
158+  \\ Cannot move if cell in direction is robot
159+  ( south ) INC2k LDA #01 EQU ?&bad
160+  ( southwest ) DUP2 #ff01 ADD2 LDA #01 EQU ?&bad
161+  ( southeast ) OVR INC OVR INC LDA #01 EQU ?&bad
162+  ( north ) DUP2 #01 SUB LDA #01 EQU ?&bad
163+  ( northwest,west ) DUP2 #0101 SUB2 LDA2 ORA #01 AND ?&bad
164+  ( northeast,east ) DUP2 #00ff ADD2 LDA2 ORA #01 AND ?&bad
165+  \\ It is safe, so move the player
166+  .PlayerX STZ2
167+  #01 !step
168+  &bad POP2 #00 JMP2r
169+
170+@step ( -- )
171+  \\ Move robots by quadrants
172+  ( north ) #ffff lines
173+  ( south ) #0001 lines
174+  ( east ) #0100 lines
175+  ( west ) #ff00 lines
176+  ( northwest ) #ff00 #ffff quads
177+  ( northeast ) #ffff #0100 quads
178+  ( southeast ) #0100 #0001 quads
179+  ( southwest ) #0001 #ff00 quads
180+  \\ Check if game lost
181+  .PlayerX LDZ2 LDA #00 EQU [?
182+    redraw
183+    sound 3ffa 3afa 36fa 33fa 0000
184+    #0000 locate
185+    #02 showi 20 "GAME 20 "OVER 20 00
186+    #1c23 locate
187+    #01 showi "q=quit 00
188+    .PlayerX LDZ2 ;Playfield- SUB2 locate #8402 showc
189+    [@ input LIT "q EOR ]?
190+    POP2r
191+    .Score LDZ2 .HiScore LDZ2 LTH2 ?title
192+    .Score LDZ2 .HiScore STZ2 !title
193+  ]@
194+  \\ Check if game is completed
195+  .NumRobots LDZ [?
196+    .Level LDZk DUP #f7 LTH ADD SWP STZ
197+    POP2r !beginlevel
198+  ]@
199+  JMP2r
200+
201+@lines ( dir* -- )
202+  ,&dir STR2
203+  LITr -PlayerX LDZ2r
204+  &loop
205+    STH2rk LIT2 &dir $2 ADD2 LDAk
206+    DUP #02 EQU ?&stop
207+    #01 NEQ [?
208+      LITr 00 STH2k STAr
209+      STH2rk LDA [? #01 !&put ]@
210+      STH2rk LDA #01 NEQ [? addscore ]@
211+      addscore
212+      #04 &put STH2rk STA
213+    ]@
214+    POP2r STH2 !&loop
215+  &stop POP POP2 POP2r JMP2r
216+
217+@quads ( dir1* dir2* -- )
218+  ADD2k ,lines/dir STR2
219+  .PlayerX LDZ2 [& .PlayerX LDZ2 OVR2 ADD2 ]@
220+  STH2 ,&dir STR2
221+  &loop
222+    STH2rk LDA #02 EQU ?&stop
223+    DUP2r LIT2r &dir $2 ADD2r
224+    LIT2r :&loop ROT2r !lines/loop
225+  &stop POP2r JMP2r
226+
227+@addscore ( -- )
228+  .NumRobots LDZk #01 SUB SWP STZ
229+  .Score LDZ2k #000a ADD2 ROT STZ2
230+  sound 31fe 0000
231+  JMP2r
232+
233+@redraw ( -- )
234+  cls
235+  .Playfield [@
236+    #00 OVR .Playfield- SUB locate
237+    .PlayfieldH [@
238+      SWPk LDA #0007 SFT2 ;Tiles ADD2 LDA2 showc
239+    INC DUP ]? POP
240+  INC DUP ]? POP
241+  .PlayerX LDZ2 ;Playfield- SUB2 locate #8303 showc
242+  \\ fallthrough
243+@status ( -- )
244+  #0000 locate
245+  #01 showi "Level: 00
246+  ;Level LDZ #02 shown
247+  #1c00 locate
248+  #01 showi "Remain: 00
249+  ;NumRobots LDZ #02 shown
250+  #0023 locate
251+  #01 showi "Score: 00
252+  .Score LDZ2 #03 shown
253+  #1c23 locate
254+  #01 showi "?=help 00
255+  JMP2r
256+
257+@inputVec
258+  #c6 DEI ;prng64/x LDA SUB DUP #00 EQU ADD ;prng64/x STA
259+  #83 DEI DUP [? POP @input BRK ]@ JMP2r
260+
261+@cls ( -- )
262+  #0000 DUP2 #28 DEO2 #2a DEO2
263+  #802e DEO #c02e DEO
264+  JMP2r
265+
266+@locate ( x y -- )
267+  #0005 SFT2 #2a DEO2
268+  #0005 SFT2 #28 DEO2
269+  JMP2r
270+
271+@showc ( char color -- )
272+  SWP #0005 SFT2 ;Font ADD2 #2c DEO2
273+  #2f DEO
274+  JMP2r
275+
276+@showi ( color -- )
277+  ,&color STR
278+  [@
279+    LDArk STHr INC2r DUP [? POP JMP2r ]@
280+    #0005 SFT2 ;Font ADD2 #2c DEO2
281+    LIT2 &color 002f DEO
282+  ]!
283+
284+@shown ( number* color -- )
285+  ,showi/color STR
286+  LITr 00
287+  [@
288+    #000a DIV2k STH2k MUL2 SUB2
289+    STH2 SWP2r STH2r
290+    NIPr LITr 30 ADDr
291+  ORAk ]?
292+  POP2
293+  [@ STHr ,showi/color LDR showc STHrk ]?
294+  POPr
295+  JMP2r
296+
297+@sound ( -- )
298+  STH2rk ,&addr STR2
299+  #00 ,&time STR
300+  [@ LDA2rk STH2r ORA INC2r INC2r ]?
301+  [; #20 DEO2 JMP2r ]@
302+  LIT &time $1
303+  DUP [?
304+    POP LIT2 &addr $2 LDA2k
305+    ORAk [? NIP2 DUP2 #3e DEO2 #20 DEO2 BRK ]@
306+    STH
307+    DUP #00 EQU #01 SUB SWP
308+    #3e DEO2
309+    INC2 INC2 ,&addr STR2
310+    STHr
311+  ]@ INC ,&time STR BRK
312+
313+@prng64 ( -- number* )
314+  ( returns the next number in a (2^32-1)-long sequence )
315+  ( http://b2d-f9r.blogspot.com/2010/08/16-bit-xorshift-rng-now-with-more.html )
316+  LIT2 &x 0001
317+  DUP2 #50 SFT2 EOR2
318+  DUP2 #03 SFT2 EOR2
319+  LIT2 &y 0001 DUP2 ,&x STR2
320+  DUP2 #01 SFT2 EOR2 EOR2
321+  ,&y STR2k POP
322+  JMP2r
323+
324+@random ( limit mask -- number )
325+  ,&m STR STHk
326+  [@
327+    POP
328+    prng64 ADD LIT &m 00 AND
329+    DUP STHrk GTH
330+  ]?
331+  POPr JMP2r
332+
333+@Tiles
334+  8003 ( empty )
335+  8102 ( robot )
336+  7f01 ( wall )
337+  3f01 ( unused )
338+  8401 ( broken )
339+
340+@Wave 00 7f ff 80
341+
342+\_@20'8*- \@Font \~ascii.font
343+
344+  \-........ ( 80 )
345+  \-........
346+  \-........
347+  \-...11...
348+  \-...11...
349+  \-........
350+  \-........
351+  \-........;
352+
353+  \-........ ( 81 )
354+  \-.1....1.
355+  \-..1..1..
356+  \-...11...
357+  \-...11...
358+  \-..1..1..
359+  \-.1....1.
360+  \-........;
361+
362+  \-........ ( 82 )
363+  \-...11...
364+  \-..1111..
365+  \-.111111.
366+  \-.111111.
367+  \-..1111..
368+  \-...11...
369+  \-........;
370+
371+  \-........ ( 83 )
372+  \-...11...
373+  \-..1..1..
374+  \-.1....1.
375+  \-.1....1.
376+  \-..1..1..
377+  \-...11...
378+  \-........;
379+
380+  \-....1... ( 84 )
381+  \-.1..1.1.
382+  \-..1.11..
383+  \-11111...
384+  \-...11111
385+  \-..11.1..
386+  \-.1.1..1.
387+  \-...1....;
388+