sokoban-test.scm

#!/usr/bin/guile -s
!#

(use-modules (srfi srfi-1))

(define (dir-to-vec dir)
    (case dir
        ('left '(-1 0))
        ('right '(1 0))
        ('up '(0 -1))
        ('down '(0 1))
    )
)

(define (add-vec a b)
    (list
        (+ (list-ref a 0) (list-ref b 0))
        (+ (list-ref a 1) (list-ref b 1))
    )
)

(define (display-world world)
    (for-each (lambda (row)
        (display row)
        (newline)
    ) world)
)

(define (world-at world pos)
    (list-ref
        (list-ref world (list-ref pos 1))
        (list-ref pos 0)
    )
)

(define (transform-at x i proc)
    (define x-left (take x i))
    (define x-right (drop x (+ i 1)))
    (define x-target (list-ref x i))

    (list
        (concatenate
            (list x-left (list (proc x-target)) x-right)
        )
        x-target
    )
)

(define (set-world-at world pos val)
    (define x (list-ref pos 0))
    (define y (list-ref pos 1))

    (list-ref (transform-at world y (lambda (row)
        (list-ref (transform-at row x (lambda (x) val)) 0)
    )) 0)
)

(define (move-brick world pos dir)
    (define move-vec (dir-to-vec dir))
    (define world2 (set-world-at world pos 'empty))
    (set-world-at world2 (add-vec pos move-vec) 'brick)
)

(define (play world player move-dir)
    (define move-vec (dir-to-vec move-dir))
    (define player-dest (add-vec player move-vec))

    (case (world-at world player-dest)
        ('empty (list world player-dest))
        ('wall (list world player))
        ('brick (list (move-brick world player-dest move-dir) player-dest))
    )
)

(define initial-world '(
    (wall wall wall wall wall)
    (wall empty empty empty wall)
    (wall empty brick empty wall)
    (wall empty empty empty wall)
    (wall wall wall wall wall)
))

(define initial-player '(1 1))

(define initial-state (list initial-world initial-player))

(define moves '(right down right down left))

(define final-state (fold (lambda (move-dir state)
    (define world (list-ref state 0))
    (define player (list-ref state 1))
    (play world player move-dir)
) initial-state moves))

(display-world (list-ref final-state 0))
(display (list-ref final-state 1))
(newline)

;;; output:
;;; (wall wall wall wall wall)
;;; (wall empty empty empty wall)
;;; (wall empty empty empty wall)
;;; (wall brick empty empty wall)
;;; (wall wall wall wall wall)
;;; (2 3)