scheme-sokoban/tic80-loop.scm

(define (draw-level-sprites l)
  ;; (large-render)
  ;; Screen is 15x9 dimensions
  ;; Player is at 8 and 5
  ;; x-axis starts at 0
  ;; y-axis starts at 0
  ;;
  ;; (small-render)
  ;; Screen is 30x17 dimensions
  ;; Player is at 15 and 9
  ;; x-axis starts at 0
  ;; y-axis starts at 0
  ;;
  ;; cutoff is 10 tall or 14 wide
  (define large-level?
    (or (>= (level-rows l) 10)
        (>= (level-cols l) 14)))
  (define (get-sprite-value c i j)
    (define t (level-ref l j i))
    (cond
     ((eq? (tile-type t) 'floor) (if large-level? 35 0))
     ((eq? (tile-type t) 'goal-square) (if large-level? 36 2))
     ((eq? (tile-type t) 'box-on-goal-square) (if large-level? 37 4))
     ((eq? (tile-type t) 'box) (if large-level? 38 6))
     ((eq? (tile-type t) 'player-on-goal-square) (if large-level? 39 8))
     ((eq? (tile-type t) 'player) (if large-level? 40 10))
     ((eq? (tile-type t) 'wall) (if large-level? 41 12))
     (else (error "tile type invalid" t))))
    
  (define p (find-player l))
  (define x-start (- (tile-col p) (if large-level? 15 8)))
  (define y-start (- (tile-row p) (if large-level? 9 5)))
  (define x-end (+ x-start (if large-level? 30 15)))
  (define y-end (+ y-start (if large-level? 17 9)))
  (let loop ((i x-start)
             (j y-start)
             (screen-x 0)
             (screen-y 0))
    (cond
     ((and (< i x-end) (< j y-end))
      (t80::spr (get-sprite-value l i j) screen-x screen-y -1 1 0 0 2 2)
      (loop (+ i 1) j (+ screen-x (if large-level? 8 16)) screen-y))
     ((< j y-end)
      (loop x-start (+ j 1) 0 (+ screen-y (if large-level? 8 16)))))))

(define (draw-menu-sprites)
  ;; 6 high, 30 wide
  (define x-start 0)
  (define y-start 0)
  (define x-end (+ x-start 29))
  (define y-end (+ y-start 5))
  (define (get-sprite-value i j)
    (cond
     ((and (= i 0) (= j 0)) 32)
     ((and (= i 0) (= j (- y-end 1))) 64)
     ((and (= i (- x-end 1)) (= j 0)) 34)
     ((and (= i (- x-end 1)) (= j (- y-end 1))) 66)
     ((= i 0) 48)
     ((= j 0) 33)
     ((= i (- x-end 1)) 50)
     ((= j (- y-end 1)) 65)
     (else 49)))
  (let loop ((i x-start)
             (j y-start)
             (screen-x 0)
             (screen-y 88))
    (cond
     ((and (< i x-end) (< j y-end))
      (t80::spr (get-sprite-value i j) screen-x screen-y -1 1 0 0 1 1)
      (loop (+ i 1) j (+ screen-x 8) screen-y))
     ((< j y-end)
      (loop x-start (+ j 1) 0 (+ screen-y 8))))))

(define (refresh-output!)
  (t80::cls 1)

  ;; sprites & status text
  (cond
   ((current-level)
    (draw-level-sprites (current-level))
    (let ((level-status (string-split (render-level-status (current-level)) "\n")))
      (t80::print (list-ref level-status 0) 120 0 12 #t)
      (t80::print (list-ref level-status 1) 216 8 12 #t)))
   (else
    (t80::spr 192 30 0 -1 3 0 0 4 4)
    (t80::print "BOX ZOMBIE" 120 65 12)))

  ;; menu text
  (cond
   ((current-menu)
    (draw-menu-sprites)
    (t80::print (render-menu (current-menu)) 8 96))))

(define a-held? #f)
(define b-held? #f)
(define x-held? #f)
(define y-held? #f)
(define time-up-held +inf.0)
(define time-down-held +inf.0)
(define time-left-held +inf.0)
(define time-right-held +inf.0)

(define (write-progress! global-state)
  (define progress-tracker (global-progress global-state))
  (define p1 (assoc 0 progress-tracker))
  (define p2 (assoc 1 progress-tracker))
  (define p3 (assoc 2 progress-tracker))
  (define v1 (if p1 (cdr p1) 0))
  (define v2 (if p2 (* 512 (cdr p2)) 0))
  (define v3 (if p3 (* 512 512 (cdr p3)) 0))
  (define total (+ v1 v2 v3))
  (t80::pmem 0 total))

(define (read-progress! global-state)
  (define result (t80::pmem 0))
  (define v1 (modulo result 512))
  (define v2 (modulo (quotient result 512) 512))
  (define v3 (modulo (quotient (quotient result 512) 512) 512))
  (define progress-tracker
   (list (cons 0 v1)
         (cons 1 v2)
         (cons 2 v3)))
  (global-progress-set! global-state progress-tracker))

(define (global-game-event-handler sym)
  (define (sokoban-exit)
    (t80::exit))
  (define (sokoban-victory-sound)
    (t80::music 1 -1 -1 #f))
  (define (sokoban-level-music)
    (t80::music 0 -1 -1 #t))
  (case sym
    ((kill) (sokoban-exit))
    ((victory-sound) (sokoban-victory-sound))
    ((level-music) (sokoban-level-music))
    (else (error "event not recognized" sym))))

(define (TIC)
  (unless global-game-state
    (set! global-game-state (make-global-state #f #f #f global-game-event-handler))

    (read-progress! global-game-state)
    (open-main-menu! global-game-state))

  (refresh-output!)

  (write-progress! global-game-state)

  (cond
   ((t80::btn 0)
    (cond
     ((> time-up-held 30)
      (api-push-input! '((command . "UP")))
      (set! time-up-held 0))
     (else
      (set! time-up-held (+ 1 time-up-held)))))
   (else
    (set! time-up-held +inf.0)))
  (cond
   ((t80::btn 1)
    (cond
     ((> time-down-held 30)
      (api-push-input! '((command . "DOWN")))
      (set! time-down-held 0))
     (else
      (set! time-down-held (+ 1 time-down-held)))))
   (else
    (set! time-down-held +inf.0)))
  (cond
   ((t80::btn 2)
    (cond
     ((> time-left-held 30)
      (api-push-input! '((command . "LEFT")))
      (set! time-left-held 0))
     (else
      (set! time-left-held (+ 1 time-left-held)))))
   (else
    (set! time-left-held +inf.0)))
  (cond
   ((t80::btn 3)
    (cond
     ((> time-right-held 30)
      (api-push-input! '((command . "RIGHT")))
      (set! time-right-held 0))
     (else
      (set! time-right-held (+ 1 time-right-held)))))
   (else
    (set! time-right-held +inf.0)))
  (cond
   ((t80::btn 4)
    (if (not a-held?)
        (api-push-input! '((command . "A"))))
    (set! a-held? #t))
   (else
    (set! a-held? #f)))
  (cond
   ((t80::btn 5)
    (if (not b-held?)
        (api-push-input! '((command . "B"))))
    (set! b-held? #t))
   (else
    (set! b-held? #f)))
  (cond
   ((t80::btn 6)
    (if (not x-held?)
        (api-push-input! '((command . "X"))))
    (set! x-held? #t))
   (else
    (set! x-held? #f)))
  (cond
   ((t80::btn 7)
    (if (not y-held?)
        (api-push-input! '((command . "Y"))))
    (set! y-held? #t))
   (else
    (set! y-held? #f))))