(import
 (owl toplevel)
 (raylib))

(define width 400)
(define height width)
(define sz (/ width 10))
(define step sz)

(define (kp? state k) (and (eqv? state 'ready) (key-pressed? k)))

(define speed 10)
(define (move-by state pos)
  (cond
   ((eqv? state 'moving-r) (values (+ (car pos) speed) (cadr pos)))
   ((eqv? state 'moving-l) (values (- (car pos) speed) (cadr pos)))
   ((eqv? state 'moving-u) (values (car pos) (- (cadr pos) speed)))
   ((eqv? state 'moving-d) (values (car pos) (+ (cadr pos) speed)))
   (else
    (values (car pos) (cadr pos)))))

(define (maybe-animate state pos)
  (lets ((x y (move-by state pos)))
    (if (and (= (modulo x step) 0)
             (= (modulo y step) 0))
        (values x y 'ready)
        (values x y state))))

(define (get-state state q)
  (cond
   ((not (eqv? state 'ready)) (values state q))
   ((< (length q) 1)          (values state q))
   ((eqv? (car q) 'a)         (values 'moving-l (cdr q)))
   ((eqv? (car q) 'd)         (values 'moving-r (cdr q)))
   ((eqv? (car q) 's)         (values 'moving-d (cdr q)))
   ((eqv? (car q) 'w)         (values 'moving-u (cdr q)))
   (else
    (error "unreachable" (list state q)))))

(lambda (_)
  (set-target-fps! 30)
  (with-window
   width height ""
   (let loop ((pos '(0 0)) (state 'ready) (q '()))
     (lets ((x y state (maybe-animate state pos))
            (pos (list x y))
            (q (if (key-pressed? key-w) (append q (list 'w)) q))
            (q (if (key-pressed? key-s) (append q (list 's)) q))
            (q (if (key-pressed? key-a) (append q (list 'a)) q))
            (q (if (key-pressed? key-d) (append q (list 'd)) q))
            (state q (get-state state q)))
       (draw
        (clear-background #xff222222)
        (draw-rectangle-rounded (append pos (list sz sz)) 0.3 10 red)
        (draw-text-simple (symbol->string state) '(0 0) 18 white)
        (draw-fps (list 0 (- height 24))))
       (if (window-should-close?)
           0
           (loop pos state q))))))