diff options
-rwxr-xr-x | game.scm | 31 |
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)) |