about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2023-05-30 23:25:11 -0500
committerCase Duckworth2023-05-30 23:25:11 -0500
commit8e06e913c944aaf83dda69160b758eded73a8bb1 (patch)
tree0522ac0eecf225e78370a32c6364362d154f02a6
parent2021-05-30 (diff)
downloadapple-8e06e913c944aaf83dda69160b758eded73a8bb1.tar.gz
apple-8e06e913c944aaf83dda69160b758eded73a8bb1.zip
Add take*
-rwxr-xr-xgame.scm31
1 files changed, 24 insertions, 7 deletions
diff --git a/game.scm b/game.scm index 12809b7..4df071c 100755 --- a/game.scm +++ b/game.scm
@@ -18,6 +18,7 @@ See COPYING for details.
18 (yolk erase) 18 (yolk erase)
19 (yolk cursor) 19 (yolk cursor)
20 (srfi 1) 20 (srfi 1)
21 (srfi 18)
21 (matchable) 22 (matchable)
22 (stty)) 23 (stty))
23 24
@@ -77,6 +78,7 @@ See COPYING for details.
77 (else))) 78 (else)))
78 (else))) 79 (else)))
79 (else)) 80 (else))
81 (snake-step (snake) (world))
80 (world-draw (world)) 82 (world-draw (world))
81 (loop (if done? 'done (readch))))))) 83 (loop (if done? 'done (readch)))))))
82 84
@@ -272,10 +274,13 @@ See COPYING for details.
272 (make-thing 'snake-head "<" 60 20 2 274 (make-thing 'snake-head "<" 60 20 2
273 '((dir . (-1 0)))) 275 '((dir . (-1 0))))
274 (list (make-thing 'snake-tail "-" 61 20 2 '()) 276 (list (make-thing 'snake-tail "-" 61 20 2 '())
275 (make-thing 'snake-tail "-" 62 20 2 '()) 277 #;(make-thing 'snake-tail "-" 62 20 2 '())
276 (make-thing 'snake-tail "-" 63 20 2 '()) 278 #;(make-thing 'snake-tail "-" 63 20 2 '())
277 (make-thing 'snake-tail "-" 64 20 2 '()) 279 #;(make-thing 'snake-tail "-" 64 20 2 '())
278 (make-thing 'snake-tail "-" 65 20 2 '()))))) 280 #;(make-thing 'snake-tail "-" 65 20 2 '())))))
281
282(define (snake-init snake)
283 #f)
279 284
280(define (snake-x snake) 285(define (snake-x snake)
281 (thing-x (snake-head snake))) 286 (thing-x (snake-head snake)))
@@ -289,8 +294,20 @@ See COPYING for details.
289(define (snake-direction snake) 294(define (snake-direction snake)
290 (thing-attr-get (snake-head snake) 'dir)) 295 (thing-attr-get (snake-head snake) 'dir))
291 296
292(define (snake-init snake) 297(define (take* xs n)
293 (let loop (()))) 298 ;;; Like `take' from SRFI 1, but doesn't choke on too-short lists.
299 (unless (and (integer? n)
300 (> n 0))
301 (error "Must take non-negative integer" n))
302 (let loop ((xs xs)
303 (n n)
304 (acc '()))
305 (if (or (null? xs)
306 (zero? n))
307 (reverse acc)
308 (loop (cdr xs)
309 (- n 1)
310 (cons (car xs) acc)))))
294 311
295(define (snake-step snake world) 312(define (snake-step snake world)
296 (let ((new-tail (make-thing 'snake-tail 313 (let ((new-tail (make-thing 'snake-tail
@@ -308,7 +325,7 @@ See COPYING for details.
308 (for-each (lambda (t) (world-set! world (thing-x t) (thing-y t) #f)) 325 (for-each (lambda (t) (world-set! world (thing-x t) (thing-y t) #f))
309 (snake-tail snake)) 326 (snake-tail snake))
310 (snake-tail-set! snake 327 (snake-tail-set! snake
311 (take (cons new-tail 328 (take* (cons new-tail
312 (snake-tail snake)) 329 (snake-tail snake))
313 (snake-length snake))) 330 (snake-length snake)))
314 (for-each (lambda (t) (thing-place! world t)) 331 (for-each (lambda (t) (thing-place! world t))