engine: i mean yeah that works

This commit is contained in:
mehbark 2025-04-28 16:37:45 -04:00
parent e5615419b1
commit abb1733099

91
engine.scm Executable file
View file

@ -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)))))