From 8c22161119b7499746764a1ae2229257e2a38f16 Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Tue, 13 Jun 2023 11:38:01 -0500
Subject: Update license to god willing license

---
 apple.scm | 44 +++++++++++++++++++++++---------------------
 1 file changed, 23 insertions(+), 21 deletions(-)

(limited to 'apple.scm')

diff --git a/apple.scm b/apple.scm
index abc5b8d..0364cf4 100755
--- a/apple.scm
+++ b/apple.scm
@@ -21,7 +21,7 @@ See COPYING for details.
         (matchable)
         (stty))
 
-(define (log* . xs)
+#;(define (log* . xs)
   (with-output-to-port (current-error-port)
     (lambda ()
       (for-each (lambda (x) (display x) (display " ") x)
@@ -45,17 +45,18 @@ See COPYING for details.
                                        game-cleanup)))))
 
 (define (game-exit-message msg)
-  (cond
-   ((eq? msg 'win)
-    (print "Congrats!")
-    #t)
-   ((eq? msg 'lose)
-    (print "Better luck next time.")
-    #t)
-   ((and (pair? msg)
-         (eq? (car msg) 'error))
-    (apply error "An error occurred" (cdr error))
-    #f)))
+  (cond ((and (pair? msg)
+              (eq? (car msg) 'error))
+         (apply error "An error occurred" msg)
+         #f)
+        (else
+         (cond
+          ((eq? msg 'win)
+           (print "Congrats!"))
+          ((eq? msg 'lose)
+           (print "Better luck next time.")))
+         (print "Final score: " (score))
+         #t)))
 
 ;;; Parameters
 (define me (make-parameter #f))
@@ -63,10 +64,11 @@ See COPYING for details.
 (define fruit (make-parameter #f))
 (define world (make-parameter #f))
 (define game-end (make-parameter #f))
+(define score (make-parameter 0))
 
 (define fruits
-  (make-parameter (list (with-attrs '(yellow) ")")
-                        (with-attrs '(green) "ò")
+  (make-parameter (list (with-attrs '(green) "ò")
+                        (with-attrs '(yellow) ")")
                         (with-attrs '(magenta) "%")
                         (with-attrs '(blue) "*"))))
 
@@ -110,7 +112,7 @@ See COPYING for details.
 
 (define (game-intro)
   (draw #<#END
-        #erase-screen
+
         A P P L E!
         a Spring Lisp Game Jam 2023 entry
         by Case Duckworth <acdw@acdw.net>
@@ -325,7 +327,7 @@ END
 ;;; hacky-end
 
 (define (handle-collision a b)
-  (log* (thing-name a) (thing-name b))
+  #;(log* (thing-name a) (thing-name b))
   (cond
    ((or (and (me? a) (snake-head? b))
         (and (snake-head? a) (me? b)))
@@ -346,13 +348,13 @@ END
               #f)
   (thing-pos-randomize! (fruit))
   (thing-look-set! (fruit) (random-choice (fruits)))
-  (snake-length-set! (snake) (+ (random-int 4 7) (snake-length (snake)))))
+  (snake-length-set! (snake) (+ (random-int 4 7) (snake-length (snake))))
+  (score (+ 5 (score))))
 
 (define (game-win)
   (draw (cursor-move 10 10)
         "YOU WIN!                     ")
   (sleep 1)
-  (flush-input)
   (readch)
   ((game-end) 'win))
 
@@ -360,7 +362,6 @@ END
   (draw (cursor-move 10 10)
         "YOU LOSE :(                  ")
   (sleep 1)
-  (flush-input)
   (readch)
   ((game-end) 'lose))
 
@@ -480,7 +481,8 @@ END
                               (snake-length snake)))
       (for-each (lambda (t) (thing-place! t))
                 (snake-tail snake))
-      (snake-mtime-set! snake now))))
+      (snake-mtime-set! snake now)
+      (score (+ 1 (score))))))
 
 (define (direction->velocity direction)
   (case direction
@@ -563,7 +565,7 @@ END
             (snake-move-toward snake (fruit)))
            ;; Otherwise, move toward `me'
            (else (snake-move-toward snake (me))))))
-    (unless (eq? direction new-dir)
+    #;(unless (eq? direction new-dir)
       (log* direction new-dir))
     ;; Don't let the snake double back into itself
     (cond
-- 
cgit 1.4.1-21-gabe81