diff --git a/engine.scm b/engine.scm new file mode 100755 index 0000000..d2ecbaf --- /dev/null +++ b/engine.scm @@ -0,0 +1,91 @@ +#! /usr/bin/env guile -e main -s +!# + +(use-modules (ice-9 format) + (srfi srfi-26)) + +(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))) + +;; 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 #:optional (render (cut format #t "~a\r\n" <>))) + (define state-stack (list init)) + (define (redraw) (clear) (render (car state-stack))) + (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) + (if (undo? c) + (undo!) + (push! (step (car state-stack) c))) + (redraw)))) + +(define* (input-loop handle-input #:optional (should-quit? (lambda (c) (eqv? c #\q)))) + (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)))) + unset-raw-mode!)) + +(define (main . args) + (game-loop 0 (lambda (state c) (+ state (list-index '(u d l r) c)))))