diff --git a/engine.scm b/engine.scm old mode 100755 new mode 100644 index d2ecbaf..76be36b --- a/engine.scm +++ b/engine.scm @@ -1,9 +1,10 @@ -#! /usr/bin/env guile -e main -s -!# +(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!) @@ -19,6 +20,8 @@ ;; #\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) @@ -38,24 +41,40 @@ ;; step : state -> udlr -> state ;; render : state -> () ;; that's it lol -(define* (game-loop init step #:optional (render (cut format #t "~a\r\n" <>))) +(define* (game-loop init step #:key (done? (const #f)) (render (cut format #t "~a\n" <>))) (define state-stack (list init)) - (define (redraw) (clear) (render (car state-stack))) + + (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) - (if (undo? c) - (undo!) - (push! (step (car state-stack) c))) + (lambda (c break) + (cond + [(undo? c) (undo!)] + ;; that's right, you can undo your restart + [(restart? c) (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? (lambda (c) (eqv? c #\q)))) +(define* (input-loop handle-input #:optional (should-quit? quit?)) (dynamic-wind set-raw-mode! (lambda () @@ -84,8 +103,5 @@ (when (should-quit? c) (break)) - (handle-input c)))) + (handle-input c break)))) unset-raw-mode!)) - -(define (main . args) - (game-loop 0 (lambda (state c) (+ state (list-index '(u d l r) c))))) diff --git a/min-steps.scm b/min-steps.scm index 8139795..76bb17e 100755 --- a/min-steps.scm +++ b/min-steps.scm @@ -5,8 +5,8 @@ (srfi srfi-9 gnu) (srfi srfi-11) (srfi srfi-43) - (rnrs io ports) (ice-9 control) + (rnrs io ports) (ice-9 arrays)) (define (insert-sorted! x xs <) diff --git a/player.scm b/player.scm new file mode 100755 index 0000000..b97cb11 --- /dev/null +++ b/player.scm @@ -0,0 +1,50 @@ +#! /usr/bin/env guile -e main -s +!# + +(add-to-load-path ".") +(use-modules (engine) + (rnrs io ports) + (ice-9 regex)) +(load "min-steps.scm") + +(define help "\ +usage: player.scm puzzle-file [puzzle-number] + +If puzzle-number is zero or omitted, treat the entire file as one puzzle. +") + +(define (make-puzzle-number-regexp n) + (make-regexp (format #f "\\s*;+\\s*~a[^0-9]*$" n) regexp/newline)) + +(define (load-puzzle path number) + (define n (string->number number)) + (or n (error "bad number" number)) + (define src (call-with-input-file path get-string-all)) + (string->board + (cond + [(zero? n) src] + [else + (define start (match:end (regexp-exec (make-puzzle-number-regexp n) src))) + (define end (match:start (regexp-exec (make-puzzle-number-regexp (1+ n)) src start))) + (substring src start end)]))) + +;; i thought it was (main . args) instead of (main args), oops +(define (main args) + (apply + (case-lambda* + [(_ puzzle-file #:optional (puzzle-number 0)) + (when (member puzzle-file '("--help" "-h")) + (display help) + (exit)) + + (game-loop + (load-puzzle puzzle-file puzzle-number) + (lambda (b c) + (case c + [(u) (board-step b 0 -1)] + [(d) (board-step b 0 1)] + [(l) (board-step b -1 0)] + [(r) (board-step b 1 0)])) + #:done? board-won?)] + [_ (display _) (display help) (exit 1)]) + args))