1 files changed, 76 insertions, 39 deletions

@@ -37,7 +37,7 @@ See COPYING for details.
                                                   "<" 20 20 2)
                                       (list)))
                    (fruit (make-thing 'fruit (world)
-                                      (random-choice (fruits)) 10 20 1)))
+                                      (random-choice (fruits)) 10 20 2)))
       (case (dynamic-wind game-setup
                           game-loop
                           game-cleanup)
@@ -143,7 +143,7 @@ See COPYING for details.
         (loop (random-x world) (random-y world))
         (values x y))))
 
-(define (random-choice . choices)
+(define (random-choice choices)
   (list-ref choices (random-int (length choices))))
 
 ;;; Drawing stuff
@@ -218,6 +218,7 @@ See COPYING for details.
                  (thing-place! (wall w x y)))
                 (else)))
              world)
+  (draw-title world 10 10)
   (thing-pos-randomize! (me))
   (thing-place! (me))
   (thing-pos-randomize! (snake-head (snake)))
@@ -232,6 +233,14 @@ See COPYING for details.
     (thing-x-set! thing x)
     (thing-y-set! thing y)))
 
+(define (draw-title world x y)
+    (for-each thing-place!
+              (list (make-thing 'a world (with-attrs '(italic dim) "A") x y 0)
+                    (make-thing 'p world (with-attrs '(italic dim) "P") (+ x 2) y 0)
+                    (make-thing 'p world (with-attrs '(italic dim) "P") (+ x 4) y 0)
+                    (make-thing 'p world (with-attrs '(italic dim) "L") (+ x 6) y 0)
+                    (make-thing 'p world (with-attrs '(italic dim) "E") (+ x 8) y 0))))
+
 ;;; Things
 
 (define-record-type <thing>
@@ -247,20 +256,6 @@ See COPYING for details.
 (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))
 
@@ -299,21 +294,40 @@ See COPYING for details.
 (define (snake-head? x)
   (and (thing? x)
        (eq? 'snake-head (thing-name x))))
+
+(define (fruit? x)
+  (and (thing? x)
+       (eq? 'fruit (thing-name x))))
 ;;; hacky-end
 
 (define (handle-collision a b)
+  (log* (thing-name a) (thing-name b))
   (cond
    ((or (and (me? a) (snake-head? b))
         (and (snake-head? a) (me? b)))
     (game-lose))
+   ((or (and (fruit? a) (snake-head? b))
+        (and (snake-head? a) (fruit? b)))
+    (snake-eat-fruit))
    ((or (and (snake-head? a) (thing? b))
         (and (thing? a) (snake-head? b)))
     (game-win))
    (else)))
 
+(define (snake-eat-fruit)
+  #;(log* "snake eat fruit")
+  (world-set! (thing-world (fruit))
+              (thing-x (fruit))
+              (thing-y (fruit))
+              #f)
+  (thing-pos-randomize! (fruit))
+  (thing-look-set! (fruit) (random-choice (fruits)))
+  (snake-length-set! (snake) (+ (random-int 4 7) (snake-length (snake)))))
+
 (define (game-win)
   (draw (cursor-move 10 10)
         "YOU WIN!")
+  (sleep 1)
   (readch)
   (newline)
   ((game-end) 'win))
@@ -321,6 +335,7 @@ See COPYING for details.
 (define (game-lose)
   (draw (cursor-move 10 10)
         "YOU LOSE :(")
+  (sleep 1)
   (readch)
   (newline)
   ((game-end) 'lose))
@@ -463,13 +478,39 @@ See COPYING for details.
                      ((left) "<")
                      ((up) "^"))))
 
+(define (distance thing-a thing-b)
+  (sqrt (+ (expt (abs (- (thing-x thing-a)
+                         (thing-x thing-b)))
+                 2)
+           (expt (abs (- (thing-y thing-a)
+                         (thing-y thing-b)))
+                 2))))
+
+(define (snake-move-toward snake thing)
+  (let ((tx (thing-x thing))
+        (ty (thing-y thing))
+        (sx (snake-x snake))
+        (sy (snake-y snake)))
+    (cond
+     ((< sx tx)
+      (if (> (abs (- sx tx))
+             (abs (- sy ty)))
+          'right
+          (if (< sy ty) 'down 'up)))
+     ((> sx tx)
+      (if (> (abs (- sx tx))
+             (abs (- sy ty)))
+          'left
+          (if (< sy ty) 'down 'up)))
+     ((= sx tx) (cond
+                 ((<= sy ty) 'down)
+                 ((> sy ty) 'up)))
+     ;; Otherwise, keep going how we're going
+     (else (snake-direction snake)))))
+
 (define (snake-decide-move snake) ; snake => direction
   (let* ((head (snake-head snake))
          (direction (snake-direction snake))
-         (snake-x (snake-x snake))
-         (snake-y (snake-y snake))
-         (me-x (thing-x (me)))
-         (me-y (thing-y (me)))
          (new-dir
           ;; Initial decision
           (cond
@@ -478,7 +519,7 @@ See COPYING for details.
            ((eq? (thing-below head) 'me) 'down)
            ((eq? (thing-to-right head) 'me) 'right)
            ((eq? (thing-to-left head) 'me) 'left)
-           ;; Otherwise, if about to collide with something, dodge it.
+           ;; If about to collide with something, dodge it.
            ((or (and (thing-above head)
                      (eq? direction 'up))
                 (and (thing-below head)
@@ -489,35 +530,31 @@ See COPYING for details.
                 (and (thing-to-left head)
                      (eq? direction 'left)))
             (if (thing-above head) 'down 'up))
+           ;; If close to the fruit, get it
+           ((> 5 (distance (snake-head snake) (fruit)))
+            (snake-move-toward snake (fruit)))
            ;; Otherwise, move toward `me'
-           ((< snake-x me-x)
-            (if (> (abs (- snake-x me-x))
-                   (abs (- snake-y me-y)))
-                'right
-                (if (< snake-y me-y) 'down 'up)))
-           ((> snake-x me-x)
-            (if (> (abs (- snake-x me-x))
-                   (abs (- snake-y me-y)))
-                'left
-                (if (< snake-y me-y) 'down 'up)))
-           ((= snake-x me-x) (cond
-                              ((< snake-y me-y) 'down)
-                              ((> snake-y me-y) 'up)
-                              (else ((game-end) 'lose))))
-           ;; Otherwise, keep going how we're going
-           (else (snake-direction snake)))))
+           (else (snake-move-toward snake (me))))))
+    (unless (eq? direction new-dir)
+      (log* direction new-dir))
     ;; Don't let the snake double back into itself
     (cond
      ((or (and (eq? direction 'right)
                (eq? new-dir 'left))
           (and (eq? direction 'left)
                (eq? new-dir 'right)))
-      (if (< snake-y me-y) 'down 'up))
+      (snake-direction-set! snake (if (< (snake-x snake) (thing-y (me)))
+                                      'down
+                                      'up))
+      (snake-decide-move snake))
      ((or (and (eq? direction 'up)
                (eq? new-dir 'down))
           (and (eq? direction 'down)
                (eq? new-dir 'up)))
-      (if (< snake-x me-x) 'right 'left))
+      (snake-direction-set! snake (if (< (snake-x snake) (thing-y (me)))
+                                      'right
+                                      'left))
+      (snake-decide-move snake))
      (else new-dir))))
 
 (define (snake-update-direction! snake)