guile-sokoban/engine.scm

109 lines
2.7 KiB
Scheme

(define-module (engine)
#:export (game-loop))
(use-modules (ice-9 format)
(srfi srfi-26))
;; tbh i'm just making these part of the interface so you can case and such
(define-values (u d l r) (values 'u 'd 'l 'r))
(define (set-raw-mode!)
(system "stty raw -echo"))
(define (unset-raw-mode!)
(system "stty -raw echo"))
(define* (clear #:optional (port (current-output-port)))
(format port "\x1b[0m\x1b[2J\x1b[H"))
;; TODO: customizable keybindings
;; #\sub is C-z
(define (undo? c) (memv c '(#\u #\z #\delete #\sub)))
(define (restart? c) (memv c '(#\r)))
(define (quit? c) (memv c '(#\q)))
;; TODO: redo (relatively low prio)
(define (u? c) (memv c '(#\w #\k u)))
(define (d? c) (memv c '(#\s #\j d)))
(define (l? c) (memv c '(#\a #\h l)))
(define (r? c) (memv c '(#\d #\l r)))
(define (c->udlr c)
(cond
[(u? c) u]
[(d? c) d]
[(l? c) l]
[(r? c) r]
[else #f]))
;; step : state -> udlr -> state
;; render : state -> ()
;; that's it lol
(define* (game-loop init step #:key (done? (const #f)) (render (cut format #t "~a\n" <>)))
(define state-stack (list init))
(define (redraw)
(dynamic-wind
unset-raw-mode!
(lambda ()
(clear)
(render (car state-stack)))
set-raw-mode!))
(define (undo!)
(unless (null? (cdr state-stack))
(set! state-stack (cdr state-stack))))
(define (push! state)
(set! state-stack (cons state state-stack)))
(redraw)
(input-loop
(lambda (c break)
(cond
[(undo? c) (undo!)]
;; that's right, you can undo your restart
;; but don't if you're already at the beginning ofc
[(restart? c) (unless (equal? init (car state-stack)) (push! init))]
[(c->udlr c) => (lambda (c) (push! (step (car state-stack) c)))]
[else (format #t "what does ~a even mean\r\n" c)])
(when (done? (car state-stack))
(redraw)
(break))
(redraw))))
(define* (input-loop handle-input #:optional (should-quit? quit?))
(dynamic-wind
set-raw-mode!
(lambda ()
(define escaped? #f)
(define open-bracketed? #f)
(while #t
(let ([c (read-char)])
(when (and escaped? open-bracketed?)
(set! c (case c
[(#\A) u]
[(#\B) d]
[(#\C) r]
[(#\D) l]
[else (error "idk this escape[" c)]))
(set! escaped? #f)
(set! open-bracketed? #f))
(when (and escaped? (eqv? c #\[))
(set! open-bracketed? #t)
(continue))
(when (eqv? c #\esc)
(set! escaped? #t)
(continue))
(when (should-quit? c)
(break))
(handle-input c break))))
unset-raw-mode!))