basic sokoban player let's GO

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,9 +41,17 @@
 ;; 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))))
@@ -49,13 +60,21 @@
   
   (redraw)
   (input-loop
-   (lambda (c)
+   (lambda (c break)
-     (if (undo? c)
+     (cond
-         (undo!)
+      [(undo? c) (undo!)]
-         (push! (step (car state-stack) c)))
+      ;; 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)))))

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

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