109 lines
2.7 KiB
Scheme
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!))
|