From 8e06e913c944aaf83dda69160b758eded73a8bb1 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Tue, 30 May 2023 23:25:11 -0500
Subject: Add take*

---
 game.scm | 31 ++++++++++++++++++++++++-------
 1 file changed, 24 insertions(+), 7 deletions(-)

(limited to 'game.scm')

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.
         (yolk erase)
         (yolk cursor)
         (srfi 1)
+        (srfi 18)
         (matchable)
         (stty))
 
@@ -77,6 +78,7 @@ See COPYING for details.
                       (else)))
                (else)))
             (else))
+          (snake-step (snake) (world))
           (world-draw (world))
           (loop (if done? 'done (readch)))))))
 
@@ -272,10 +274,13 @@ See COPYING for details.
                (make-thing 'snake-head "<" 60 20 2
                            '((dir . (-1 0))))
                (list (make-thing 'snake-tail "-" 61 20 2 '())
-                     (make-thing 'snake-tail "-" 62 20 2 '())
-                     (make-thing 'snake-tail "-" 63 20 2 '())
-                     (make-thing 'snake-tail "-" 64 20 2 '())
-                     (make-thing 'snake-tail "-" 65 20 2 '())))))
+                     #;(make-thing 'snake-tail "-" 62 20 2 '())
+                     #;(make-thing 'snake-tail "-" 63 20 2 '())
+                     #;(make-thing 'snake-tail "-" 64 20 2 '())
+                     #;(make-thing 'snake-tail "-" 65 20 2 '())))))
+
+(define (snake-init snake)
+  #f)
 
 (define (snake-x snake)
   (thing-x (snake-head snake)))
@@ -289,8 +294,20 @@ See COPYING for details.
 (define (snake-direction snake)
   (thing-attr-get (snake-head snake) 'dir))
 
-(define (snake-init snake)
-  (let loop (())))
+(define (take* xs n)
+  ;;; Like `take' from SRFI 1, but doesn't choke on too-short lists.
+  (unless (and (integer? n)
+               (> n 0))
+    (error "Must take non-negative integer" n))
+  (let loop ((xs xs)
+             (n n)
+             (acc '()))
+    (if (or (null? xs)
+            (zero? n))
+        (reverse acc)
+        (loop (cdr xs)
+              (- n 1)
+              (cons (car xs) acc)))))
 
 (define (snake-step snake world)
   (let ((new-tail (make-thing 'snake-tail
@@ -308,7 +325,7 @@ See COPYING for details.
     (for-each (lambda (t) (world-set! world (thing-x t) (thing-y t) #f))
               (snake-tail snake))
     (snake-tail-set! snake
-                     (take (cons new-tail
+                     (take* (cons new-tail
                                  (snake-tail snake))
                            (snake-length snake)))
     (for-each (lambda (t) (thing-place! world t))
-- 
cgit 1.4.1-21-gabe81