From c3481952e04eb79056ed5510f91c597ccb5dddd7 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Thu, 1 Jun 2023 16:30:09 -0500
Subject: Change name to apple and add makefile

---
 .gitignore |   3 +
 README.md  |   7 +-
 apple.scm  | 408 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 game.scm   | 408 -------------------------------------------------------------
 makefile   |  16 +++
 5 files changed, 430 insertions(+), 412 deletions(-)
 create mode 100644 .gitignore
 create mode 100755 apple.scm
 delete mode 100755 game.scm
 create mode 100644 makefile

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..6430706
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,3 @@
+*.link
+apple
+apple-bin.scm
\ No newline at end of file
diff --git a/README.md b/README.md
index a8d553a..9951e43 100644
--- a/README.md
+++ b/README.md
@@ -1,14 +1,13 @@
 # 2023 Lisp Game Jam Entry
-## "Game"
+## "Apple"
 
-Yeah I don't have a good name yet.  I'm just playing around and trying to get characters on the screen right now.
+*Apple* is a reverse snake --- you're an apple trying to avoid the snake.
 
 ## Dependencies
 
 - chicken scheme (`csi`) with eggs:
   - matchable
   - r7rs
-  - srfi-18
   - stty
 - my ansi library, [yolk][]
 
@@ -16,7 +15,7 @@ Yeah I don't have a good name yet.  I'm just playing around and trying to get ch
 
 ## Running
 
-Run `./game.scm` in this directory.
+Run `./apple.scm` in this directory.  Alternatively, run `make` to build a static binary and run that instead.
 
 ## License
 
diff --git a/apple.scm b/apple.scm
new file mode 100755
index 0000000..5dae4eb
--- /dev/null
+++ b/apple.scm
@@ -0,0 +1,408 @@
+#!/bin/sh
+#| -*- scheme -*-
+exec csi -R r7rs -ss "$0" "$@"
+apple --- 2023 lisp game jam
+(C) Case Duckworth <acdw@acdw.net>
+Distributed under the terms of the LATCRIFPL, v1.0.
+See COPYING for details.
+|#
+
+(import (scheme base)
+        (scheme time)
+        (scheme write)
+        (chicken io)
+        (chicken port)
+        (chicken random)
+        (yolk common)
+        (yolk xterm)
+        (yolk erase)
+        (yolk cursor)
+        (yolk attrs)
+        (matchable)
+        (stty))
+
+(define (log* . xs)
+  (with-output-to-port (current-error-port)
+    (lambda ()
+      (for-each (lambda (x) (display x) (display " ") x)
+                xs)
+      (newline))))
+
+(define (main args)
+  (parameterize ((world (make-world 80 25)))
+    (parameterize ((me (let-values (((x y) (random-point (world))))
+                         (make-thing 'me (world)
+                                     (with-attrs '(red) "ó") x y 2)))
+                   (snake (let-values (((x y) (random-point (world))))
+                            (make-snake (world) 5 (current-jiffy) 100 'left
+                                        (make-thing 'snake-head (world)
+                                                    "<" x y 2)
+                                        (list (make-thing 'snake-tail (world)
+                                                          "-" (+ 1 x) y 2))))))
+      (dynamic-wind game-setup
+                    game-loop
+                    game-cleanup)))
+  #t)
+
+(define me (make-parameter #f))
+(define world (make-parameter #f))
+(define snake (make-parameter #f))
+
+(define (game-setup)
+  ;; Prepare terminal
+  (stty '(raw (not echo)))
+  (set-buffering-mode! (current-input-port) #:none 1)
+  (set-buffering-mode! (current-output-port) #:none 1)
+  (draw alt-buffer-enable
+        erase-screen
+        (cursor-save)
+        invisible-cursor)
+  ;; Set up world
+  (world-init (world))
+  (world-draw (world)))
+
+(define (game-cleanup)
+  ;; Restore terminal
+  (stty '(cooked echo))
+  (draw cursor-home
+        (cursor-restore)
+        alt-buffer-disable
+        visible-cursor))
+
+(define (game-loop)
+  (call/cc
+   (lambda (return)
+     (let loop ((now (current-jiffy)))
+       (handle-input return)
+       (snake-step (snake) now)
+       (world-draw (world))
+       (loop (current-jiffy))))))
+
+(define (handle-input done)
+  (if (char-ready?)
+      (match (readch)
+        (#\q (done))
+        (#\k (up!))
+        (#\j (down!))
+        (#\l (right!))
+        (#\h (left!))
+        ;; Escape characters
+        (#\escape (match (readch)
+                    (#\[ (match (readch)
+                           (#\A (up!))
+                           (#\B (down!))
+                           (#\C (right!))
+                           (#\D (left!))
+                           (_ #f)))
+                    (_ #f)))
+        (x (log* x)))
+      #f))
+
+(define (readch)
+  (let ((c (integer->char (read-byte))))
+    c))
+
+;;; random
+
+(define random-int
+  (case-lambda
+    (() (pseudo-random-integer 100))
+    ((max) (pseudo-random-integer max))
+    ((min max)
+     (let ((max (if (> max min) max min))
+           (min (if (< min max) min max)))
+       (+ min (pseudo-random-integer (- max min)))))))
+
+(define (random-x world)
+  (random-int 1 (- (world-width world) 1)))
+
+(define (random-y world)
+  (random-int 1 (- (world-height world) 1)))
+
+(define (random-point world)
+  (let loop ((x (random-x world))
+             (y (random-y world)))
+    (if (world-get world x y)
+        (loop (random-x world) (random-y world))
+        (values x y))))
+
+;;; Drawing stuff
+
+(define (draw . instructions)
+  (for-each (lambda (i)
+              (cond
+               ((string? i) (display i))
+               ((list? i) (apply draw i))
+               (else (error "Don't know how to draw" i))))
+            instructions))
+
+;;; World
+
+(define-record-type <world>
+  (%make-world width height map)
+  world?
+  (width world-width world-width-set!)
+  (height world-height world-height-set!)
+  (map world-map world-map-set!))
+
+(define (in-bounds? world x y)
+  (or (< x (world-width world))
+      (> x 0)
+      (< y (world-height world))
+      (> y 0)))
+
+(define (coords->index world x y)
+  (if (in-bounds? world x y)
+      (+ x (* (world-width world) y))
+      (error "Out of bounds"
+             (list (world-width world) (world-height world))
+             (list x y))))
+
+(define (world-get world x y)
+  (vector-ref (world-map world) (coords->index world x y)))
+
+(define (world-set! world x y obj)
+  (vector-set! (world-map world)
+               (coords->index world x y)
+               obj))
+
+(define (make-world width height)
+  (%make-world width height (make-vector (* width height) #f)))
+
+(define (for-world proc world)
+  (do ((y 1 (+ y 1)))
+      ((= y (world-height world)) #t)
+    (do ((x 1 (+ x 1)))
+        ((= x (world-width world)) #t)
+      (proc world x y))))
+
+(define (world-draw world)
+  (draw cursor-home)
+  (for-world (lambda (w x y)
+               (cond
+                ((thing? (world-get w x y))
+                 (draw (cursor-move x y)
+                       (thing-look (world-get w x y))))
+                (else
+                 (draw (cursor-move x y)
+                       " "))))
+             world))
+
+(define (world-init world)
+  (for-world (lambda (w x y)
+               (cond
+                ((or (= x 1)
+                     (= y 1)
+                     (= x (- (world-width world) 1))
+                     (= y (- (world-height world) 1)))
+                 (thing-place! (wall w x y)))
+                (else)))
+             world)
+  (thing-place! (me))
+  (thing-place! (snake-head (snake)))
+  (for-each (lambda (t) (thing-place! t))
+            (snake-tail (snake))))
+
+;;; Things
+
+(define-record-type <thing>
+  (make-thing name world look x y z)
+  thing?
+  (name thing-name)
+  (world thing-world thing-world-set!)
+  (look thing-look thing-look-set!)
+  (x thing-x thing-x-set!)
+  (y thing-y thing-y-set!)
+  (z thing-z thing-z-set!))
+
+(define (wall w x y)
+  (make-thing 'wall w "#" x y 100))
+
+(define (thing-attr-get thing attr)
+  (let ((x (assoc attr (thing-attrs thing))))
+    (if x
+        (cdr x)
+        #f)))
+
+(define (thing-attr-set! thing attr val)
+  (let ((x (assoc attr (thing-attrs thing))))
+    (if x
+        (set-cdr! x val)
+        (thing-attrs-set! thing
+                          (cons (cons attr val)
+                                (thing-attrs thing))))))
+
+(define (thing-place! thing)
+  (world-set! (thing-world thing) (thing-x thing) (thing-y thing) thing))
+
+(define (thing-move! thing x y)
+  (let ((world (thing-world thing)))
+    (world-set! world (thing-x thing) (thing-y thing) #f)
+    (thing-x-set! thing x)
+    (thing-y-set! thing y)
+    (world-set! world x y thing)))
+
+(define (thing-move-relative! thing dx dy)
+  (let* ((world (thing-world thing))
+         (new-x (+ (thing-x thing) dx))
+         (new-y (+ (thing-y thing) dy))
+         (other (world-get world new-x new-y)))
+    (cond
+     ((and (thing? other)
+           (> (thing-z other) (thing-z thing))))
+     (else
+      (cond ((< new-x 1)
+             (set! new-x 1))
+            ((> new-x (- (world-width world) 1))
+             (set! new-x (- (world-width world) 1))))
+      (cond ((< new-y 1)
+             (set! new-y 1))
+            ((> new-y (- (world-height world) 1))
+             (set! new-y (- (world-height world) 1))))
+      (thing-move! thing new-x new-y)))))
+
+(define (thing-up! thing)
+  (thing-move-relative! thing 0 -1))
+
+(define (thing-down! thing)
+  (thing-move-relative! thing 0 1))
+
+(define (thing-right! thing)
+  (thing-move-relative! thing 1 0))
+
+(define (thing-left! thing)
+  (thing-move-relative! thing -1 0))
+
+(define (up!) (thing-up! (me)))
+(define (down!) (thing-down! (me)))
+(define (left!) (thing-left! (me)))
+(define (right!) (thing-right! (me)))
+
+(define (thing-above thing)
+  (if (< (thing-y thing) 1)
+      #f
+      (world-get (thing-world thing)
+                 (thing-x thing)
+                 (- (thing-y thing) 1))))
+
+(define (thing-below thing)
+  (if (> (thing-y thing) (world-height (thing-world thing)))
+      #f
+      (world-get (thing-world thing)
+                 (thing-x thing)
+                 (+ (thing-y thing) 1))))
+
+(define (thing-to-left thing)
+  (if (< (thing-x thing) 1)
+      #f
+      (world-get (thing-world thing)
+                 (- (thing-x thing) 1)
+                 (thing-y thing))))
+
+(define (thing-to-right thing)
+  (if (> (thing-x thing) (world-width (thing-world thing)))
+      #f
+      (world-get (thing-world thing)
+                 (+ (thing-x thing) 1)
+                 (thing-y thing)
+                 )))
+
+;;; snake
+
+(define-record-type <snake>
+  (make-snake world length mtime wait direction head tail)
+  snake?
+  (length snake-length snake-length-set!)
+  (world snake-world snake-world-set!)
+  (mtime snake-mtime snake-mtime-set!)
+  (direction snake-direction snake-direction-set!)
+  (wait snake-wait snake-wait-set!)
+  (head snake-head snake-head-set!)
+  (tail snake-tail snake-tail-set!))
+
+(define (snake-x snake)
+  (thing-x (snake-head snake)))
+
+(define (snake-y snake)
+  (thing-y (snake-head snake)))
+
+(define (snake-z snake)
+  (thing-z (snake-head snake)))
+
+(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 now)
+  (when (> now (+ (snake-mtime snake) (snake-wait snake)))
+    (let ((new-tail (make-thing 'snake-tail (snake-world snake)
+                                (if (snake-vertical? snake)
+                                    "|"
+                                    "-")
+                                (snake-x snake)
+                                (snake-y snake)
+                                (snake-z snake))))
+      (snake-update-head! snake)
+      (apply thing-move-relative!
+             (snake-head snake)
+             (direction->velocity (snake-direction snake)))
+      (snake-update-direction! snake)
+      (for-each (lambda (t) (world-set! (snake-world snake)
+                                   (thing-x t)
+                                   (thing-y t)
+                                   #f))
+                (snake-tail snake))
+      (snake-tail-set! snake
+                       (take* (cons new-tail
+                                    (snake-tail snake))
+                              (snake-length snake)))
+      (for-each (lambda (t) (thing-place! t))
+                (snake-tail snake))
+      (snake-mtime-set! snake now))))
+
+(define (direction->velocity direction)
+  (case direction
+    ((up) '(0 -1))
+    ((down) '(0 1))
+    ((left) '(-1 0))
+    ((right) '(1 0))
+    (else direction)))
+
+(define (snake-vertical? snake)
+  (or (eq? (snake-direction snake) 'up)
+      (eq? (snake-direction snake) 'down)))
+
+(define (snake-update-head! snake)
+  (thing-look-set! (snake-head snake)
+                   (case (snake-direction snake)
+                     ((right) ">")
+                     ((down) "v")
+                     ((left) "<")
+                     ((up) "^"))))
+
+(define (snake-update-direction! snake)
+  (let ((head (snake-head snake)))
+    (case (snake-direction snake)
+      ((up)
+       (when (thing-above head)
+         (snake-direction-set! snake 'left)))
+      ((down)
+       (when (thing-below head)
+         (snake-direction-set! snake 'right)))
+      ((left)
+       (when (thing-to-left head)
+         (snake-direction-set! snake 'down)))
+      ((right)
+       (when (thing-to-right head)
+         (snake-direction-set! snake 'up))))))
diff --git a/game.scm b/game.scm
deleted file mode 100755
index 7a43720..0000000
--- a/game.scm
+++ /dev/null
@@ -1,408 +0,0 @@
-#!/bin/sh
-#| -*- scheme -*-
-exec csi -R r7rs -ss "$0" "$@"
-game --- 2023 lisp game jam
-(C) Case Duckworth <acdw@acdw.net>
-Distributed under the terms of the LATCRIFPL, v1.0.
-See COPYING for details.
-|#
-
-(import (scheme base)
-        (scheme time)
-        (scheme write)
-        (chicken io)
-        (chicken port)
-        (chicken random)
-        (yolk common)
-        (yolk xterm)
-        (yolk erase)
-        (yolk cursor)
-        (yolk attrs)
-        (matchable)
-        (stty))
-
-(define (log* . xs)
-  (with-output-to-port (current-error-port)
-    (lambda ()
-      (for-each (lambda (x) (display x) (display " ") x)
-                xs)
-      (newline))))
-
-(define (main args)
-  (parameterize ((world (make-world 80 25)))
-    (parameterize ((me (let-values (((x y) (random-point (world))))
-                         (make-thing 'me (world)
-                                     (with-attrs '(red) "ó") x y 2)))
-                   (snake (let-values (((x y) (random-point (world))))
-                            (make-snake (world) 5 (current-jiffy) 100 'left
-                                        (make-thing 'snake-head (world)
-                                                    "<" x y 2)
-                                        (list (make-thing 'snake-tail (world)
-                                                          "-" (+ 1 x) y 2))))))
-      (dynamic-wind game-setup
-                    game-loop
-                    game-cleanup)))
-  #t)
-
-(define me (make-parameter #f))
-(define world (make-parameter #f))
-(define snake (make-parameter #f))
-
-(define (game-setup)
-  ;; Prepare terminal
-  (stty '(raw (not echo)))
-  (set-buffering-mode! (current-input-port) #:none 1)
-  (set-buffering-mode! (current-output-port) #:none 1)
-  (draw alt-buffer-enable
-        erase-screen
-        (cursor-save)
-        invisible-cursor)
-  ;; Set up world
-  (world-init (world))
-  (world-draw (world)))
-
-(define (game-cleanup)
-  ;; Restore terminal
-  (stty '(cooked echo))
-  (draw cursor-home
-        (cursor-restore)
-        alt-buffer-disable
-        visible-cursor))
-
-(define (game-loop)
-  (call/cc
-   (lambda (return)
-     (let loop ((now (current-jiffy)))
-       (handle-input return)
-       (snake-step (snake) now)
-       (world-draw (world))
-       (loop (current-jiffy))))))
-
-(define (handle-input done)
-  (if (char-ready?)
-      (match (readch)
-        (#\q (done))
-        (#\k (up!))
-        (#\j (down!))
-        (#\l (right!))
-        (#\h (left!))
-        ;; Escape characters
-        (#\escape (match (readch)
-                    (#\[ (match (readch)
-                           (#\A (up!))
-                           (#\B (down!))
-                           (#\C (right!))
-                           (#\D (left!))
-                           (_ #f)))
-                    (_ #f)))
-        (x (log* x)))
-      #f))
-
-(define (readch)
-  (let ((c (integer->char (read-byte))))
-    c))
-
-;;; random
-
-(define random-int
-  (case-lambda
-    (() (pseudo-random-integer 100))
-    ((max) (pseudo-random-integer max))
-    ((min max)
-     (let ((max (if (> max min) max min))
-           (min (if (< min max) min max)))
-       (+ min (pseudo-random-integer (- max min)))))))
-
-(define (random-x world)
-  (random-int 1 (- (world-width world) 1)))
-
-(define (random-y world)
-  (random-int 1 (- (world-height world) 1)))
-
-(define (random-point world)
-  (let loop ((x (random-x world))
-             (y (random-y world)))
-    (if (world-get world x y)
-        (loop (random-x world) (random-y world))
-        (values x y))))
-
-;;; Drawing stuff
-
-(define (draw . instructions)
-  (for-each (lambda (i)
-              (cond
-               ((string? i) (display i))
-               ((list? i) (apply draw i))
-               (else (error "Don't know how to draw" i))))
-            instructions))
-
-;;; World
-
-(define-record-type <world>
-  (%make-world width height map)
-  world?
-  (width world-width world-width-set!)
-  (height world-height world-height-set!)
-  (map world-map world-map-set!))
-
-(define (in-bounds? world x y)
-  (or (< x (world-width world))
-      (> x 0)
-      (< y (world-height world))
-      (> y 0)))
-
-(define (coords->index world x y)
-  (if (in-bounds? world x y)
-      (+ x (* (world-width world) y))
-      (error "Out of bounds"
-             (list (world-width world) (world-height world))
-             (list x y))))
-
-(define (world-get world x y)
-  (vector-ref (world-map world) (coords->index world x y)))
-
-(define (world-set! world x y obj)
-  (vector-set! (world-map world)
-               (coords->index world x y)
-               obj))
-
-(define (make-world width height)
-  (%make-world width height (make-vector (* width height) #f)))
-
-(define (for-world proc world)
-  (do ((y 1 (+ y 1)))
-      ((= y (world-height world)) #t)
-    (do ((x 1 (+ x 1)))
-        ((= x (world-width world)) #t)
-      (proc world x y))))
-
-(define (world-draw world)
-  (draw cursor-home)
-  (for-world (lambda (w x y)
-               (cond
-                ((thing? (world-get w x y))
-                 (draw (cursor-move x y)
-                       (thing-look (world-get w x y))))
-                (else
-                 (draw (cursor-move x y)
-                       " "))))
-             world))
-
-(define (world-init world)
-  (for-world (lambda (w x y)
-               (cond
-                ((or (= x 1)
-                     (= y 1)
-                     (= x (- (world-width world) 1))
-                     (= y (- (world-height world) 1)))
-                 (thing-place! (wall w x y)))
-                (else)))
-             world)
-  (thing-place! (me))
-  (thing-place! (snake-head (snake)))
-  (for-each (lambda (t) (thing-place! t))
-            (snake-tail (snake))))
-
-;;; Things
-
-(define-record-type <thing>
-  (make-thing name world look x y z)
-  thing?
-  (name thing-name)
-  (world thing-world thing-world-set!)
-  (look thing-look thing-look-set!)
-  (x thing-x thing-x-set!)
-  (y thing-y thing-y-set!)
-  (z thing-z thing-z-set!))
-
-(define (wall w x y)
-  (make-thing 'wall w "#" x y 100))
-
-(define (thing-attr-get thing attr)
-  (let ((x (assoc attr (thing-attrs thing))))
-    (if x
-        (cdr x)
-        #f)))
-
-(define (thing-attr-set! thing attr val)
-  (let ((x (assoc attr (thing-attrs thing))))
-    (if x
-        (set-cdr! x val)
-        (thing-attrs-set! thing
-                          (cons (cons attr val)
-                                (thing-attrs thing))))))
-
-(define (thing-place! thing)
-  (world-set! (thing-world thing) (thing-x thing) (thing-y thing) thing))
-
-(define (thing-move! thing x y)
-  (let ((world (thing-world thing)))
-    (world-set! world (thing-x thing) (thing-y thing) #f)
-    (thing-x-set! thing x)
-    (thing-y-set! thing y)
-    (world-set! world x y thing)))
-
-(define (thing-move-relative! thing dx dy)
-  (let* ((world (thing-world thing))
-         (new-x (+ (thing-x thing) dx))
-         (new-y (+ (thing-y thing) dy))
-         (other (world-get world new-x new-y)))
-    (cond
-     ((and (thing? other)
-           (> (thing-z other) (thing-z thing))))
-     (else
-      (cond ((< new-x 1)
-             (set! new-x 1))
-            ((> new-x (- (world-width world) 1))
-             (set! new-x (- (world-width world) 1))))
-      (cond ((< new-y 1)
-             (set! new-y 1))
-            ((> new-y (- (world-height world) 1))
-             (set! new-y (- (world-height world) 1))))
-      (thing-move! thing new-x new-y)))))
-
-(define (thing-up! thing)
-  (thing-move-relative! thing 0 -1))
-
-(define (thing-down! thing)
-  (thing-move-relative! thing 0 1))
-
-(define (thing-right! thing)
-  (thing-move-relative! thing 1 0))
-
-(define (thing-left! thing)
-  (thing-move-relative! thing -1 0))
-
-(define (up!) (thing-up! (me)))
-(define (down!) (thing-down! (me)))
-(define (left!) (thing-left! (me)))
-(define (right!) (thing-right! (me)))
-
-(define (thing-above thing)
-  (if (< (thing-y thing) 1)
-      #f
-      (world-get (thing-world thing)
-                 (thing-x thing)
-                 (- (thing-y thing) 1))))
-
-(define (thing-below thing)
-  (if (> (thing-y thing) (world-height (thing-world thing)))
-      #f
-      (world-get (thing-world thing)
-                 (thing-x thing)
-                 (+ (thing-y thing) 1))))
-
-(define (thing-to-left thing)
-  (if (< (thing-x thing) 1)
-      #f
-      (world-get (thing-world thing)
-                 (- (thing-x thing) 1)
-                 (thing-y thing))))
-
-(define (thing-to-right thing)
-  (if (> (thing-x thing) (world-width (thing-world thing)))
-      #f
-      (world-get (thing-world thing)
-                 (+ (thing-x thing) 1)
-                 (thing-y thing)
-                 )))
-
-;;; snake
-
-(define-record-type <snake>
-  (make-snake world length mtime wait direction head tail)
-  snake?
-  (length snake-length snake-length-set!)
-  (world snake-world snake-world-set!)
-  (mtime snake-mtime snake-mtime-set!)
-  (direction snake-direction snake-direction-set!)
-  (wait snake-wait snake-wait-set!)
-  (head snake-head snake-head-set!)
-  (tail snake-tail snake-tail-set!))
-
-(define (snake-x snake)
-  (thing-x (snake-head snake)))
-
-(define (snake-y snake)
-  (thing-y (snake-head snake)))
-
-(define (snake-z snake)
-  (thing-z (snake-head snake)))
-
-(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 now)
-  (when (> now (+ (snake-mtime snake) (snake-wait snake)))
-    (let ((new-tail (make-thing 'snake-tail (snake-world snake)
-                                (if (snake-vertical? snake)
-                                    "|"
-                                    "-")
-                                (snake-x snake)
-                                (snake-y snake)
-                                (snake-z snake))))
-      (snake-update-head! snake)
-      (apply thing-move-relative!
-             (snake-head snake)
-             (direction->velocity (snake-direction snake)))
-      (snake-update-direction! snake)
-      (for-each (lambda (t) (world-set! (snake-world snake)
-                                   (thing-x t)
-                                   (thing-y t)
-                                   #f))
-                (snake-tail snake))
-      (snake-tail-set! snake
-                       (take* (cons new-tail
-                                    (snake-tail snake))
-                              (snake-length snake)))
-      (for-each (lambda (t) (thing-place! t))
-                (snake-tail snake))
-      (snake-mtime-set! snake now))))
-
-(define (direction->velocity direction)
-  (case direction
-    ((up) '(0 -1))
-    ((down) '(0 1))
-    ((left) '(-1 0))
-    ((right) '(1 0))
-    (else direction)))
-
-(define (snake-vertical? snake)
-  (or (eq? (snake-direction snake) 'up)
-      (eq? (snake-direction snake) 'down)))
-
-(define (snake-update-head! snake)
-  (thing-look-set! (snake-head snake)
-                   (case (snake-direction snake)
-                     ((right) ">")
-                     ((down) "v")
-                     ((left) "<")
-                     ((up) "^"))))
-
-(define (snake-update-direction! snake)
-  (let ((head (snake-head snake)))
-    (case (snake-direction snake)
-      ((up)
-       (when (thing-above head)
-         (snake-direction-set! snake 'left)))
-      ((down)
-       (when (thing-below head)
-         (snake-direction-set! snake 'right)))
-      ((left)
-       (when (thing-to-left head)
-         (snake-direction-set! snake 'down)))
-      ((right)
-       (when (thing-to-right head)
-         (snake-direction-set! snake 'up))))))
diff --git a/makefile b/makefile
new file mode 100644
index 0000000..dbdbe9f
--- /dev/null
+++ b/makefile
@@ -0,0 +1,16 @@
+# 'apple'
+
+CSC = csc -static
+
+apple: apple-bin.scm
+	$(CSC) $< -o $@
+
+apple-bin.scm: apple.scm
+	@echo "writing apple-bin.scm"
+	@echo '(import (scheme process-context))' > $@
+	@echo '(include "$<")' >> $@
+	@echo '(main (cdr (command-line)))' >> $@
+
+.PHONY: clean
+clean:
+	rm apple-bin.scm *.link
-- 
cgit 1.4.1-21-gabe81