about summary refs log tree commit diff stats
path: root/apple.scm
diff options
context:
space:
mode:
Diffstat (limited to 'apple.scm')
-rwxr-xr-xapple.scm44
1 files changed, 23 insertions, 21 deletions
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.
21 (matchable) 21 (matchable)
22 (stty)) 22 (stty))
23 23
24(define (log* . xs) 24#;(define (log* . xs)
25 (with-output-to-port (current-error-port) 25 (with-output-to-port (current-error-port)
26 (lambda () 26 (lambda ()
27 (for-each (lambda (x) (display x) (display " ") x) 27 (for-each (lambda (x) (display x) (display " ") x)
@@ -45,17 +45,18 @@ See COPYING for details.
45 game-cleanup))))) 45 game-cleanup)))))
46 46
47(define (game-exit-message msg) 47(define (game-exit-message msg)
48 (cond 48 (cond ((and (pair? msg)
49 ((eq? msg 'win) 49 (eq? (car msg) 'error))
50 (print "Congrats!") 50 (apply error "An error occurred" msg)
51 #t) 51 #f)
52 ((eq? msg 'lose) 52 (else
53 (print "Better luck next time.") 53 (cond
54 #t) 54 ((eq? msg 'win)
55 ((and (pair? msg) 55 (print "Congrats!"))
56 (eq? (car msg) 'error)) 56 ((eq? msg 'lose)
57 (apply error "An error occurred" (cdr error)) 57 (print "Better luck next time.")))
58 #f))) 58 (print "Final score: " (score))
59 #t)))
59 60
60;;; Parameters 61;;; Parameters
61(define me (make-parameter #f)) 62(define me (make-parameter #f))
@@ -63,10 +64,11 @@ See COPYING for details.
63(define fruit (make-parameter #f)) 64(define fruit (make-parameter #f))
64(define world (make-parameter #f)) 65(define world (make-parameter #f))
65(define game-end (make-parameter #f)) 66(define game-end (make-parameter #f))
67(define score (make-parameter 0))
66 68
67(define fruits 69(define fruits
68 (make-parameter (list (with-attrs '(yellow) ")") 70 (make-parameter (list (with-attrs '(green) "ò")
69 (with-attrs '(green) "ò") 71 (with-attrs '(yellow) ")")
70 (with-attrs '(magenta) "%") 72 (with-attrs '(magenta) "%")
71 (with-attrs '(blue) "*")))) 73 (with-attrs '(blue) "*"))))
72 74
@@ -110,7 +112,7 @@ See COPYING for details.
110 112
111(define (game-intro) 113(define (game-intro)
112 (draw #<#END 114 (draw #<#END
113 #erase-screen 115
114 A P P L E! 116 A P P L E!
115 a Spring Lisp Game Jam 2023 entry 117 a Spring Lisp Game Jam 2023 entry
116 by Case Duckworth <acdw@acdw.net> 118 by Case Duckworth <acdw@acdw.net>
@@ -325,7 +327,7 @@ END
325;;; hacky-end 327;;; hacky-end
326 328
327(define (handle-collision a b) 329(define (handle-collision a b)
328 (log* (thing-name a) (thing-name b)) 330 #;(log* (thing-name a) (thing-name b))
329 (cond 331 (cond
330 ((or (and (me? a) (snake-head? b)) 332 ((or (and (me? a) (snake-head? b))
331 (and (snake-head? a) (me? b))) 333 (and (snake-head? a) (me? b)))
@@ -346,13 +348,13 @@ END
346 #f) 348 #f)
347 (thing-pos-randomize! (fruit)) 349 (thing-pos-randomize! (fruit))
348 (thing-look-set! (fruit) (random-choice (fruits))) 350 (thing-look-set! (fruit) (random-choice (fruits)))
349 (snake-length-set! (snake) (+ (random-int 4 7) (snake-length (snake))))) 351 (snake-length-set! (snake) (+ (random-int 4 7) (snake-length (snake))))
352 (score (+ 5 (score))))
350 353
351(define (game-win) 354(define (game-win)
352 (draw (cursor-move 10 10) 355 (draw (cursor-move 10 10)
353 "YOU WIN! ") 356 "YOU WIN! ")
354 (sleep 1) 357 (sleep 1)
355 (flush-input)
356 (readch) 358 (readch)
357 ((game-end) 'win)) 359 ((game-end) 'win))
358 360
@@ -360,7 +362,6 @@ END
360 (draw (cursor-move 10 10) 362 (draw (cursor-move 10 10)
361 "YOU LOSE :( ") 363 "YOU LOSE :( ")
362 (sleep 1) 364 (sleep 1)
363 (flush-input)
364 (readch) 365 (readch)
365 ((game-end) 'lose)) 366 ((game-end) 'lose))
366 367
@@ -480,7 +481,8 @@ END
480 (snake-length snake))) 481 (snake-length snake)))
481 (for-each (lambda (t) (thing-place! t)) 482 (for-each (lambda (t) (thing-place! t))
482 (snake-tail snake)) 483 (snake-tail snake))
483 (snake-mtime-set! snake now)))) 484 (snake-mtime-set! snake now)
485 (score (+ 1 (score))))))
484 486
485(define (direction->velocity direction) 487(define (direction->velocity direction)
486 (case direction 488 (case direction
@@ -563,7 +565,7 @@ END
563 (snake-move-toward snake (fruit))) 565 (snake-move-toward snake (fruit)))
564 ;; Otherwise, move toward `me' 566 ;; Otherwise, move toward `me'
565 (else (snake-move-toward snake (me)))))) 567 (else (snake-move-toward snake (me))))))
566 (unless (eq? direction new-dir) 568 #;(unless (eq? direction new-dir)
567 (log* direction new-dir)) 569 (log* direction new-dir))
568 ;; Don't let the snake double back into itself 570 ;; Don't let the snake double back into itself
569 (cond 571 (cond