diff options
Diffstat (limited to 'apple.scm')
-rwxr-xr-x | apple.scm | 44 |
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 |