kitty-gridlock/src/Main.cake

(comptime-define-symbol 'Unix)
(comptime-cond ('No-Kitty-Main)
               (true
                (comptime-define-symbol 'Kitty-Main)))

;; Until GameLib is relocatable, we will build from it; All comptime paths in this file are relative
;; to Dependencies/gamelib!
;; (add-cakelisp-search-directory "Dependencies/gamelib/src")
;; (set-cakelisp-option cakelisp-src-dir "Dependencies/gamelib/Dependencies/cakelisp/src")
;; (add-cakelisp-search-directory "Dependencies/gamelib/Dependencies/cakelisp/runtime")
(add-cakelisp-search-directory "src" "Dependencies/cakelisp/runtime"
                               ;; kitty-gridlock src
                               "../../src")

(import "SDL.cake" "Math.cake" ;; GameLib
        "PuzzleIO.cake" ;; kitty-gridlock
        ;; "Decompression.cake" ;; kitty-gridlock ;; Not used for runtime game
        &comptime-only "Macros.cake" "BuildTools.cake") ;; cakelisp/runtime

(c-import "<stdio.h>" "<stdlib.h>"
          "SDL.h" "SDL_syswm.h" "SDL_timer.h" "SDL_render.h" "SDL_rwops.h"
          ;; For round()
          "<math.h>")

;; This doesn't work for some reason. I had to override SDLActivity::setOrientationBis() instead
;; (undefine-constant SDL_HINT_ORIENTATIONS) ;; Silence warning
;; (define-constant SDL_HINT_ORIENTATIONS "Portrait")

;;
;; Constants
;;

;; (var debug-log-enabled bool true)
(var debug-log-enabled bool false)

;; (var g-show-fps bool true)
(var g-show-fps bool false)

;; TODO: Actually look at frame rate and adjust accordingly
;; This fixed GPU "coil whine" which I was getting running at 5400hz (completely unnecessary)
(var todo-arbitrary-delay-ms int 10)

(define-constant DATA_DIR "data/")

(defmacro in-data-dir (path-in-data string)
  (tokenize-push output
                 (static-string-combine DATA_DIR (token-splice path-in-data)))
  (return true))

;; Made for OnePlus 6T screen
(var g-window-width (const int) 1080)
(var g-window-height (const int) 2340)
(var g-window-safe-area-margin-px (const int) 40)

(defstruct-local grid-vec2
    X int
    Y int)

;; Game board constants
;; Note that these assume portrait aspect ratio by basing the size on the smaller dimension
(var g-game-board-outer-size-px (const int) (- g-window-width (* 2 g-window-safe-area-margin-px)))
(var g-game-board-outer-top-left-px (const vec2)
     (array g-window-safe-area-margin-px (/ (- g-window-height g-game-board-outer-size-px) 2)))
(var g-game-board-grid-size (const int) 6)
(var g-game-board-win-cell (const grid-vec2) (array 5 2))
;; Use the nearest even pixel for pixel-perfect game board
(var g-game-board-margin-px (const int)
     (/ (% g-game-board-outer-size-px g-game-board-grid-size) 2))
;; With margins of 2px, that becomes 996, or 166 pixels per column
(var g-game-board-cell-size-px (const int)
     (/ (- g-game-board-outer-size-px g-game-board-margin-px) g-game-board-grid-size))
(var g-game-board-inner-top-left-px (const vec2)
     (array (+ (vec-x g-game-board-outer-top-left-px) g-game-board-margin-px)
            (+ (vec-y g-game-board-outer-top-left-px) g-game-board-margin-px)))


;;
;; Game board state
;;

(defun-local grid-vec2-add (a grid-vec2 b grid-vec2 &return grid-vec2)
  (var result grid-vec2)
  (set (vec-x result) (+ (vec-x a) (vec-x b)))
  (set (vec-y result) (+ (vec-y a) (vec-y b)))
  (return result))

(defstruct-local board-piece
    grid-position grid-vec2 ;; Always from the top left
    moving-position vec2 ;; Floating point for animation, smooth dragging

    num-cells int ;; If 0, piece is empty
    is-vertical bool

    is-wall bool
    is-primary-piece bool

    label char)

;; Pieces are stored separately, then their positions inform occupied state, which is used to check
;; movement constraints. g-empty-cell = empty cell. Values are indices into g-game-board-pieces. Used to
;; easily pick from tap/click
(def-type-alias BoardPieceIndex char)
;; Previously, I used -1 as empty cell. On Android, it did not like that, and I'm not sure why
(var g-empty-cell char 127)
(var g-game-board-spatial-state ([] 6 ([] 6 BoardPieceIndex)) (array g-empty-cell))

;; Max pieces is determined as follows:
;; 6x6 grid = 36 squares
;; Minimum moveable piece size = 2 squares. Wall size = 1 square; max 2 walls
;; 36 squares / 2 (min piece size) = 13; if two walls, need 14
(var g-game-board-pieces ([] 14 board-piece) (array 0))

(defun-local game-board-reset-pieces ()
  (memset g-game-board-pieces 0 (sizeof g-game-board-pieces)))

(defmacro on-each-board-piece (piece-pointer-name symbol piece-index-name symbol
                               &rest body any)
  (tokenize-push
   output
   (var (token-splice piece-index-name) int 0)
   (each-in-array
    g-game-board-pieces (token-splice piece-index-name)
    (var (token-splice piece-pointer-name) (* board-piece)
         (addr (at (token-splice piece-index-name) g-game-board-pieces)))
    (token-splice-rest body tokens)))
  (return true))

(defmacro on-each-existing-board-piece (piece-pointer-name symbol piece-index-name symbol
                                        &rest body any)
  (tokenize-push
   output
   (on-each-board-piece
    (token-splice piece-pointer-name) (token-splice piece-index-name)
    (when (path (token-splice piece-pointer-name) > num-cells)
      (token-splice-rest body tokens))))
  (return true))

(defun-local game-board-print ()
  (var row int 0)
  (each-in-range
   g-game-board-grid-size row
   (each-in-range
    g-game-board-grid-size column
    (var index BoardPieceIndex (at row column g-game-board-spatial-state))
    (if (and (>= index 0) (field (at index g-game-board-pieces) num-cells))
        (scope
         (var piece-in-cell (* board-piece) (addr (at index g-game-board-pieces)))
         (var label char (path piece-in-cell > label))
         (fprintf stderr "%c " (? label label '#')))
        (fprintf stderr ". ")))
   (fprintf stderr "\n")))

(defun-local print-board-piece (piece (* (const board-piece)) index int)
  (SDL_Log "Piece %c ([%d] %p )
\n\tgrid-position %d %d
\n\tmoving-position %f %f
\n\tnum-cells %d
\n\tis-vertical %d
\n\tis-wall %d
\n\tis-primary-piece %d\n\n"
           (path piece > label) index piece
           (field (path piece > grid-position) X) (field (path piece > grid-position) Y)
           (field (path piece > moving-position) X) (field (path piece > moving-position) Y)
           (path piece > num-cells)
           (path piece > is-vertical)
           (path piece > is-wall)
           (path piece > is-primary-piece)))

(defun-local is-within-grid (coordinate grid-vec2 &return bool)
  (return (and (>= (vec-x coordinate) 0)
               (>= (vec-y coordinate) 0)
               (< (vec-x coordinate) g-game-board-grid-size)
               (< (vec-y coordinate) g-game-board-grid-size))))

(defun-local game-board-sync-occupied-state (&return bool)
  ;; Zero out to make overlap validation easy
  (memset g-game-board-spatial-state g-empty-cell
          (sizeof g-game-board-spatial-state))
  (on-each-existing-board-piece
   piece piece-index
   (when debug-log-enabled
     (print-board-piece piece piece-index))

   (var num-cells int (path piece > num-cells))

   (scope ;; Validate that piece does not go off board
    (unless (is-within-grid (path piece > grid-position))
      (SDL_Log "error: Piece %p origin is off board! Must abort occupied state sync\n" piece)
      (return false))
    (if (path piece > is-vertical)
        (block ;; Vertical
            (when (> (+ num-cells (vec-y (path piece > grid-position))) g-game-board-grid-size)
              (SDL_Log "error: Piece %p vertical is off board! Must abort occupied state sync\n" piece)
              (return false)))
        (block ;; Horizontal
            (when (> (+ num-cells (vec-x (path piece > grid-position))) g-game-board-grid-size)
              (SDL_Log "error: Piece %p horizontal is off board! Must abort occupied state sync\n" piece)
              (return false)))))

   (each-in-range
    num-cells cell-offset
    (var cell-to-set grid-vec2 (array 0))
    (if (path piece > is-vertical)
        (block ;; Vertical
            (set (vec-x cell-to-set) (vec-x (path piece > grid-position)))
          (set (vec-y cell-to-set) (+ cell-offset (vec-y (path piece > grid-position)))))
        (block ;; Horizontal
            (set (vec-x cell-to-set) (+ cell-offset (vec-x (path piece > grid-position))))
          (set (vec-y cell-to-set) (vec-y (path piece > grid-position)))))

    (var occupy-space-pointer (* BoardPieceIndex)
         (addr (at (vec-y cell-to-set) (vec-x cell-to-set) g-game-board-spatial-state)))
    (when (!= g-empty-cell (deref occupy-space-pointer))
      (SDL_Log "error: Piece %d overlapping %d at (%d, %d)! Aborting\n"
               piece-index (deref occupy-space-pointer)
               (vec-xy cell-to-set))
      (return false))
    (set (deref occupy-space-pointer) piece-index)))

  (when debug-log-enabled
    (game-board-print))

  (return true))

(defun-local game-board-piece-from-char (board-char char piece-cell-position grid-vec2)
  (when (= board-char 'x') ;; Handle walls specially
    (on-each-board-piece
     piece piece-index
     (unless (= 0 (field (deref piece) label))
       (continue))
     (set (field (deref piece) label) board-char)
     (set (field (deref piece) grid-position) piece-cell-position)
     (set (field (deref piece) is-wall) true)
     (incr (field (deref piece) num-cells))
     (break))
    (return))

  (on-each-board-piece
   piece piece-index
   (cond
     ((= board-char (field (deref piece) label)) ;; Existing piece
      (cond ;; Determine direction
        ((> (vec-x piece-cell-position) (vec-x (field (deref piece) grid-position)))
         (set (field (deref piece) is-vertical) false))
        ((> (vec-y piece-cell-position) (vec-y (field (deref piece) grid-position)))
         (set (field (deref piece) is-vertical) true)))
      (incr (field (deref piece) num-cells))
      (break))
     ((= 0 (field (deref piece) label)) ;; New piece
      (set (field (deref piece) label) board-char)
      (set (field (deref piece) grid-position) piece-cell-position)
      (set (field (deref piece) is-primary-piece) (= board-char 'A'))
      (incr (field (deref piece) num-cells))
      (break)))))

;; (The following text is copied from  [[https://www.michaelfogleman.com/rush/][Michael Fogleman's Rush Hour database]]
;; ([[https://web.archive.org/web/20201101044241/https://www.michaelfogleman.com/rush/][archive.org]]),
;; for easier reference)
;; The database is a simple text file with just a few columns. There is one row for every valid
;; (solvable, minimal) cluster. The columns are: number of moves, board description, and cluster
;; size (number of reachable states).
;; The board description is a 36-character string representing the state of the unsolved board. It
;; is a 6x6 2D array in row-major order. The characters in the description follow these simple rules:
;; - o empty cell
;; - x wall (fixed obstacle)
;; - A primary piece (red car)
;; - B - Z all other pieces
;; I used lowercase ~o~ instead of periods ~.~ for the empty cells in the database so that the
;; entire board description can be selected with a double-click.
;; Example format:
;; 60 IBBxooIooLDDJAALooJoKEEMFFKooMGGHHHM 2332
(defun-local game-board-load (board-string (* (const char)) &return bool)
  (game-board-reset-pieces)

  (var board-char (* (const char)) board-string)
  (while (< (- board-char board-string) 36)
    (cond
      ((= (deref board-char) 'o')
       (debug-log "empty\n")) ;; Empty space
      (true ;; Wall or piece
       (var char-index int (- board-char board-string))
       (var piece-cell-position grid-vec2 (array (% char-index g-game-board-grid-size)
                                                 (/ char-index g-game-board-grid-size)))
       (debug-log "[%d] '%c' = (%d %d)\n" char-index (deref board-char) (vec-xy piece-cell-position))
       (game-board-piece-from-char (deref board-char) piece-cell-position)))
    (incr board-char))

  (game-board-sync-occupied-state)

  (return true))

;; Loaded by PuzzleIO.cake
(defstruct puzzle-data
  num-moves char
  num-states int
  board ([] 36 char))

(var-global g-puzzle-list (* puzzle-data) null)
(var-global g-num-puzzles int 0)

(var g-current-puzzle (* puzzle-data) null)

(defun-local game-piece-grid-position-to-screen-position (piece (* (const board-piece)) &return vec2)
  (var piece-position vec2 (array (to-float (vec-x (path piece > grid-position)))
                                  (to-float (vec-y (path piece > grid-position)))))
  ;; Transfer to pixel space
  (set piece-position (vec2-multiply (array (repeat g-game-board-cell-size-px)) piece-position))
  ;; Add board offset
  (set piece-position (vec2-add piece-position g-game-board-inner-top-left-px))
  (return piece-position))

(defun-local game-piece-position-to-screen-position (piece (* (const board-piece)) &return vec2)
  (var piece-position vec2 (game-piece-grid-position-to-screen-position piece))
  ;; Add in moving position
  (set piece-position (vec2-add piece-position (path piece > moving-position)))
  (return piece-position))

(defun-local game-piece-get-screen-size (piece (* (const board-piece)) &return vec2)
  (var piece-grid-size vec2
       (array
        (? (path piece > is-vertical) 1.f (to-float (path piece > num-cells)))
        (? (path piece > is-vertical) (to-float (path piece > num-cells)) 1.f)))
  (var piece-size vec2 (array (repeat g-game-board-cell-size-px)))
  (set piece-size (vec2-multiply piece-size piece-grid-size))
  (return piece-size))

(defun-local is-within-game-piece (piece (* (const board-piece)) screen-point-to-test vec2 &return bool)
  (var piece-top-left-px vec2 (game-piece-position-to-screen-position piece))
  (var piece-bottom-right-px vec2 (game-piece-get-screen-size piece))
  (set piece-bottom-right-px (vec2-add piece-top-left-px piece-bottom-right-px))
  ;; (SDL_Log "%f %f -> %f %f vs. (%f %f)\n" (vec-xy piece-top-left-px) (vec-xy piece-bottom-right-px)
  ;; (vec-xy screen-point-to-test))
  (return
    (and
     (>= (vec-x screen-point-to-test) (vec-x piece-top-left-px))
     (>= (vec-y screen-point-to-test) (vec-y piece-top-left-px))
     (< (vec-x screen-point-to-test) (vec-x piece-bottom-right-px))
     (< (vec-y screen-point-to-test) (vec-y piece-bottom-right-px)))))

(defun-local pick-game-piece-from-screen-position (position vec2 &return (* board-piece))
  (var board-position vec2 (vec2-subtract position g-game-board-inner-top-left-px))
  (var grid-position grid-vec2
       (array (/ (type-cast (vec-x board-position) int) g-game-board-cell-size-px)
              (/ (type-cast (vec-y board-position) int) g-game-board-cell-size-px)))

  (unless (is-within-grid grid-position)
    (return null))

  (var piece-index char
       (at (vec-y grid-position) (vec-x grid-position) g-game-board-spatial-state))
  (unless (!= g-empty-cell piece-index)
    (return null))
  (var piece (* board-piece) (addr (at piece-index g-game-board-pieces)))
  (unless (is-within-game-piece piece position)
    (return null))
  (return piece))

(defun-local clamp-within (moving float minimum float maximum float &return float)
  (when (< moving minimum)
    (return minimum))
  (when (> moving maximum)
    (return maximum))
  (return moving))

(defun-local constrain-piece-moving-position (piece (* (const board-piece))
                                                    delta-position vec2 &return vec2)
  (when (path piece > is-wall)
    (return (array 0.f 0.f)))

  (var constrained-position vec2 delta-position)
  (if (path piece > is-vertical) ;; Constrain on axes
      (set (vec-x constrained-position) 0.f)
      (set (vec-y constrained-position) 0.f))

  ;; Constrain based on empty spaces
  (var min-position grid-vec2 (array 0))
  (var max-position grid-vec2 (array 0))
  (var position-delta-increase grid-vec2 (array 0))
  (var position-delta-decrease grid-vec2 (array 0))
  (var nearest-adjacent-cell grid-vec2 (path piece > grid-position))
  (var furthest-adjacent-cell grid-vec2 (path piece > grid-position))
  (if (path piece > is-vertical)
      (block
          (set (vec-y position-delta-increase) 1)
        (set (vec-y position-delta-decrease) -1)
        (set (vec-y nearest-adjacent-cell) (- (vec-y nearest-adjacent-cell) 1))
        (set (vec-y furthest-adjacent-cell)
             (+ (vec-y (path piece > grid-position)) (path piece > num-cells))))
      (block
          (set (vec-x position-delta-increase) 1)
        (set (vec-x position-delta-decrease) -1)
        (set (vec-x nearest-adjacent-cell) (- (vec-x nearest-adjacent-cell) 1))
        (set (vec-x furthest-adjacent-cell)
             (+ (vec-x (path piece > grid-position)) (path piece > num-cells)))))

  (defstruct scan-direction
    start-position grid-vec2
    delta grid-vec2
    is-increasing bool)
  (var directions ([] 2 scan-direction)
       (array
        (array furthest-adjacent-cell position-delta-increase true)
        (array nearest-adjacent-cell position-delta-decrease false)))
  (each-in-array
   directions i
   (var direction (* scan-direction) (addr (at i directions)))
   (var scan-position grid-vec2 (path direction > start-position))
   (while (is-within-grid scan-position)
     (var space-index int (at (vec-y scan-position) (vec-x scan-position)
                              g-game-board-spatial-state))
     (if (= g-empty-cell space-index)
         (block
             (if (path direction > is-increasing)
                 (set max-position (grid-vec2-add max-position (path direction > delta)))
                 (set min-position (grid-vec2-add min-position (path direction > delta))))
           (set scan-position (grid-vec2-add scan-position (path direction > delta))))
         ;; Anything other than empty space can immediately break us out
         (break))))

  (var min-delta-px vec2 (array (* g-game-board-cell-size-px (to-float (vec-x min-position)))
                                (* g-game-board-cell-size-px (to-float (vec-y min-position)))))
  (var max-delta-px vec2 (array (* g-game-board-cell-size-px (to-float (vec-x max-position)))
                                (* g-game-board-cell-size-px (to-float (vec-y max-position)))))
  (if (path piece > is-vertical)
      (set (vec-y constrained-position)
           (clamp-within (vec-y constrained-position) (vec-y min-delta-px) (vec-y max-delta-px)))
      (set (vec-x constrained-position)
           (clamp-within (vec-x constrained-position) (vec-x min-delta-px) (vec-x max-delta-px))))

  (return constrained-position))

(defun-local is-in-win-state (&return bool)
  (var win-square-index BoardPieceIndex (at (vec-y g-game-board-win-cell)
                                            (vec-x g-game-board-win-cell)
                                            g-game-board-spatial-state))
  (when (!= g-empty-cell win-square-index)
    (var piece (* board-piece) (addr (at win-square-index g-game-board-pieces)))
    (return (path piece > is-primary-piece)))
  (return false))

(defstruct-local move-action
    piece (* board-piece)
    delta-position grid-vec2)

;; Circular buffer
(var g-action-buffer ([] 128 move-action) (array 0))
(var g-action-buffer-write-head (* move-action) g-action-buffer)

(defun-local reset-action-buffer ()
  (memset g-action-buffer 0 (sizeof g-action-buffer)))

(var g-current-move-count int 0)
(var g-has-won-puzzle bool false)
(var g-num-puzzles-won int 0)

(defun-local make-action (piece (* board-piece) delta-position grid-vec2)
  (set (path g-action-buffer-write-head > piece) piece)
  (set (path g-action-buffer-write-head > delta-position) delta-position)
  (incr g-action-buffer-write-head)
  (when (>= (- g-action-buffer-write-head g-action-buffer) (array-size g-action-buffer))
    (set g-action-buffer-write-head g-action-buffer))
  (incr g-current-move-count))

(defun-local undo-action ()
  (var action-buffer-read-head (* move-action) (- g-action-buffer-write-head 1))
  (when (< action-buffer-read-head g-action-buffer)
    (set action-buffer-read-head (+ g-action-buffer
                                    (- (array-size g-action-buffer) 1))))

  ;; Nothing to do, the undo buffer is empty
  (var piece (* board-piece) (path action-buffer-read-head > piece))
  (when (= piece null)
    (return))

  ;; Undo the action
  (scope
   (var invert-movement (const grid-vec2) (array -1 -1))
   (var undo-movement grid-vec2 (path action-buffer-read-head > delta-position))
   (set (vec-x undo-movement) (* (vec-x undo-movement) (vec-x invert-movement)))
   (set (vec-y undo-movement) (* (vec-y undo-movement) (vec-y invert-movement)))

   (set (path piece > grid-position) (grid-vec2-add (path piece > grid-position) undo-movement))
   ;; Because pieces tween back to their positions, we will add back in the undid position to the
   ;; move position for a nice transition
   (var relative-movement vec2
        (array
         (* g-game-board-cell-size-px
            (to-float (vec-x (path action-buffer-read-head > delta-position))))
         (* g-game-board-cell-size-px
            (to-float (vec-y (path action-buffer-read-head > delta-position))))))
   (set (path piece > moving-position) (vec2-add (path piece > moving-position) relative-movement))
   (decr g-current-move-count)
   (game-board-sync-occupied-state))

  (set (path action-buffer-read-head > piece) null)
  (set (path action-buffer-read-head > delta-position) (array 0 0))

  (set g-action-buffer-write-head action-buffer-read-head))

;; Future work: A puzzle list ID would facilitate expansion puzzle databases not ruining progression
(defstruct-local progression-puzzle
    index int ;; into g-puzzle-list
    is-solved bool)

(var g-progression-puzzles (* progression-puzzle) null)
(var g-num-progression-puzzles int 0)
(var g-current-progression-puzzle (* progression-puzzle) null)

(defun-local pick-random-progression-puzzle ()
  (set g-current-progression-puzzle (addr (at (mod (rand) g-num-progression-puzzles)
                                              g-progression-puzzles))))

(defun-local game-board-load-next-puzzle ()
  (when g-num-progression-puzzles
    (var g-previous-progression-puzzle (* progression-puzzle) g-current-progression-puzzle)
    (pick-random-progression-puzzle)

    (var num-attempts int 1)
    ;; Reasonable given how many puzzles someone might do in one sitting vs. total num puzzles
    (var max-num-attempts int 200)
    ;; Don't try too hard when the data set is small
    (when (< g-num-progression-puzzles max-num-attempts)
      (set max-num-attempts (* 2 g-num-progression-puzzles)))

    (while (or (= g-previous-progression-puzzle g-current-progression-puzzle) ;; Try to ensure change
               (path g-current-progression-puzzle > is-solved)) ;; Only pick non-solved
      (pick-random-progression-puzzle)
      (incr num-attempts)
      (when (= num-attempts max-num-attempts)
        (SDL_Log "Max attempts reached for random puzzle! Has the app not been restarted in a long time?\n")
        (break)))
    (unless (< (path g-current-progression-puzzle > index) g-num-puzzles)
      (SDL_Log "error: Progression puzzle index out of range!\n")
      (return))
    (set g-current-puzzle (addr (at (path g-current-progression-puzzle > index)
                                    g-puzzle-list)))
    (game-board-load (path g-current-puzzle > board)))
  (set g-current-move-count 0)
  (set g-has-won-puzzle false)
  (reset-action-buffer))

(var g-progression-file-version (const int) 2)
(var g-progression-file-name ([] 512 char) (array 0))

(defun-local create-progression-puzzles ()
  (when g-progression-puzzles (free (type-cast g-progression-puzzles (* void))))
  (unless g-num-progression-puzzles
    (SDL_Log "error: expected g-num-progression-puzzles to be set before create-progression-puzzles\n")
    (return))
  (set g-progression-puzzles
       (type-cast (calloc g-num-progression-puzzles
                          (sizeof (type progression-puzzle))) (* progression-puzzle))))

;; If no previous progression is stored, we need to create the initial state from the puzzle
;; database. All puzzles are added and marked as unsolved
(defun-local initialize-progression-puzzles-from-database ()
  (SDL_Log "Creating puzzle progression state from database\n")
  (unless g-num-puzzles
    (SDL_Log "error: no puzzles in database")
    (return))
  (set g-num-progression-puzzles g-num-puzzles)
  (create-progression-puzzles)
  (each-in-range g-num-progression-puzzles i
                 (set (field (at i g-progression-puzzles) index) i)
                 (set (field (at i g-progression-puzzles) is-solved) false)))

(defun-local set-progression-file-name ()
  (if-c-preprocessor-defined
   __ANDROID__
   ;; Must save in this directory unless you're okay with the file being nuked on app update
   ;; See e.g. http://www.dinomage.com/2013/05/howto-sdl-on-android-part-2-platform-details/
   (snprintf g-progression-file-name (array-size g-progression-file-name)
             "%s/progression.bin" (SDL_AndroidGetInternalStoragePath))
   (snprintf g-progression-file-name (array-size g-progression-file-name)
             "progression.bin")))

;; TODO: All of these reads and writes should check their error codes...
(defun-local write-progression-data ()
  (set-progression-file-name)
  (var progression-file (* SDL_RWops) (SDL_RWFromFile g-progression-file-name "w"))
  (if progression-file
      (scope
       (SDL_WriteLE32 progression-file g-progression-file-version)
       (SDL_WriteLE32 progression-file g-num-puzzles-won)
       (SDL_WriteLE32 progression-file g-num-progression-puzzles)
       ;; Write all of them, even solved ones; read-progression-data will read them one-by-one and
       ;; remove solved puzzles
       (SDL_RWwrite progression-file g-progression-puzzles (sizeof (type progression-puzzle))
                    g-num-progression-puzzles)
       (SDL_RWclose progression-file))
      (SDL_Log "warning: failed to save progression file\n")))

(defun-local read-progression-data ()
  (set-progression-file-name)
  (var progression-file (* SDL_RWops) (SDL_RWFromFile g-progression-file-name "r"))
  (if progression-file
      (scope
       (var version int (SDL_ReadLE32 progression-file))
       (unless (= version g-progression-file-version)
         (SDL_Log "warning: failed to load progression file (version mismatch). Progress will be lost\n")
         (initialize-progression-puzzles-from-database)
         (SDL_RWclose progression-file)
         (return))
       (set g-num-puzzles-won (SDL_ReadLE32 progression-file))

       ;; Read the puzzles in, filtering out completed ones
       (set g-num-progression-puzzles (SDL_ReadLE32 progression-file))
       (create-progression-puzzles)
       (var num-unsolved-puzzles int 0)
       (each-in-range
        g-num-progression-puzzles i
        (var current-puzzle progression-puzzle)
        (SDL_RWread progression-file (addr current-puzzle) (sizeof current-puzzle) 1)
        (when (field current-puzzle is-solved)
          (continue))
        (set (at num-unsolved-puzzles g-progression-puzzles) current-puzzle)
        (incr num-unsolved-puzzles))

       ;; Free empty space from all the solved puzzles last time the game was played
       (when (and g-num-progression-puzzles
                  (!= g-num-progression-puzzles num-unsolved-puzzles))
         (set g-progression-puzzles
              (type-cast (realloc g-progression-puzzles
                                  (* (sizeof (type progression-puzzle)) num-unsolved-puzzles))
                         (* progression-puzzle)))
         (set g-num-progression-puzzles num-unsolved-puzzles))

       (SDL_Log "%d unsolved puzzles remaining\n" g-num-progression-puzzles)

       (SDL_RWclose progression-file))
      (scope ;; File didn't exist or something
       (SDL_Log "warning: failed to load progression file. This is fine if it's the first run\n")
       (initialize-progression-puzzles-from-database))))

;;
;; UI (immediate-mode)
;;

(defstruct-local input-state
    pointer-position vec2
    is-pointer-pressed bool
    start-pressed-position vec2
    was-clicked bool) ;; Click on pointer release

(defun-local update-input-state (in-state (* input-state) mouse-position vec2 is-pressed bool)
  (set (path in-state > pointer-position) mouse-position)

  (var is-entering-press bool (and (not (path in-state > is-pointer-pressed))
                                   is-pressed))
  (var is-exiting-press bool (and (path in-state > is-pointer-pressed)
                                  (not is-pressed)))

  ;; Clicks only count on release so you can move off a button mid-press to not do action
  (set (path in-state > was-clicked) is-exiting-press)

  (when is-entering-press
    (set (path in-state > start-pressed-position) mouse-position))

  (set (path in-state > is-pointer-pressed) is-pressed))

(defun-local is-within-aabb (point-to-test vec2 upper-left vec2 size vec2 &return bool)
  (var bottom-right vec2 (vec2-add upper-left size))
  (return
    (and
     (>= (vec-x point-to-test) (vec-x upper-left))
     (>= (vec-y point-to-test) (vec-y upper-left))
     (< (vec-x point-to-test) (vec-x bottom-right))
     (< (vec-y point-to-test) (vec-y bottom-right)))))

(defun-local do-button (in-state (* input-state)
                                 position vec2 size vec2
                                 renderer (* SDL_Renderer)
                                 texture (* SDL_Texture) ;; Assumes whole texture drawn
                                 &return bool) ;; Returns whether clicked
  (when (and renderer texture)
    (var dest-rect SDL_Rect (array (vec-xy-to-int position)
                                   (vec-xy-to-int size)))
    (unless (= 0 (SDL_RenderCopy renderer texture null (addr dest-rect)))
      (sdl-print-error)))

  (return (and (path in-state > was-clicked)
               (is-within-aabb (path in-state > pointer-position) position size)
               ;; So releasing on a button you didn't start pressing won't do action
               (is-within-aabb (path in-state > start-pressed-position) position size))))

(defstruct-local font-glyph
    symbol char
    position SDL_Rect)
(var g-font-atlas ([] font-glyph)
     (array
      (array '1' (array 3 13 88 130))
      (array '2' (array 108 13 97 129))
      (array '3' (array 221 13 92 124))
      (array '4' (array 329 21 79 125))
      (array '5' (array 425 15 79 125))
      (array '6' (array 513 16 82 118))
      (array '7' (array 601 18 91 111))
      (array '8' (array 692 13 92 115))
      (array '9' (array 788 13 88 126))
      (array '0' (array 894 17 83 116))
      (array '/' (array 981 14 80 139))))

(defun-local pick-font-glyph-from-character (symbol char &return (* font-glyph))
  (each-in-array
   g-font-atlas i
   (when (= symbol (field (at i g-font-atlas) symbol))
     (return (addr (at i g-font-atlas)))))
  (return null))

(defun-local draw-string (renderer (* SDL_Renderer) font-texture (* SDL_Texture)
                                   text (* (const char)) position vec2)
  (var current-position vec2 position)
  (each-char-in-string-const
   text current-char
   (var glyph (* font-glyph) (pick-font-glyph-from-character (deref current-char)))
   (unless glyph ;; Missing character
     (continue))

   (var dest-rect SDL_Rect (path glyph > position))
   (var src-rect SDL_Rect (path glyph > position))
   (set (field dest-rect x) (to-float (vec-x current-position)))
   (set (field dest-rect y) (to-float (vec-y current-position)))
   (unless (= 0 (SDL_RenderCopy renderer font-texture
                                (addr src-rect) (addr dest-rect)))
     (sdl-print-error))
   (set (vec-x current-position) (+ (vec-x current-position) (field src-rect w)))))

;;
;; Helpers
;;

(defun-local sdl-intialize-2d-renderer (renderer-out (* (* SDL_Renderer)) window (* SDL_Window)
                                                     &return bool)
  (var num-render-drivers int (SDL_GetNumRenderDrivers))
  (unless num-render-drivers
    (return false))
  (var i int 0)
  (each-in-range
   num-render-drivers i
   (var driver-info SDL_RendererInfo (array 0))
   (unless (= 0 (SDL_GetRenderDriverInfo i (addr driver-info)))
     (return false))
   (SDL_Log "Renderer [%d]: %s\n
\tHardware accelerated: %s\n
\tRender to texture:    %s\n
\tMax texture width:    %d\n
\tMax texture height:   %d\n
\n"
            i (field driver-info name)
            (? (bit-and (field driver-info flags) SDL_RENDERER_ACCELERATED) "yes" "no")
            (? (bit-and (field driver-info flags) SDL_RENDERER_TARGETTEXTURE) "yes" "no")
            (field driver-info max_texture_width)
            (field driver-info max_texture_height)))

  (var macoy-beast-driver (const int) 0)
  (var selected-renderer int macoy-beast-driver)
  (SDL_Log "Using renderer %d\n" selected-renderer)
  (set (deref renderer-out) (SDL_CreateRenderer window selected-renderer SDL_RENDERER_ACCELERATED))
  (unless (deref renderer-out)
    (sdl-print-error)
    (return false))
  (return true))

(defun-local sdl-texture-from-bmp (filename (* (const char)) renderer (* SDL_Renderer)
                                            &return (* SDL_Texture))
  (var surface (* SDL_Surface) (SDL_LoadBMP filename))
  (unless surface
    (SDL_Log "Failed to load surface from BMP %s\n" filename)
    (sdl-print-error)
    (return null))

  (var texture (* SDL_Texture)
       (SDL_CreateTextureFromSurface renderer surface))
  ;; No need to hold on to surface after texture has been created
  (SDL_FreeSurface surface)
  (unless texture (sdl-print-error))
  (return texture))

(defun-local sdl-texture-from-bmp-color-to-transparent
    (filename (* (const char)) renderer (* SDL_Renderer) r char g char b char
              &return (* SDL_Texture))
  (var surface (* SDL_Surface) (SDL_LoadBMP filename))
  (unless surface
    (SDL_Log "Failed to load surface from BMP %s\n" filename)
    (sdl-print-error)
    (return null))

  (SDL_SetColorKey surface SDL_TRUE (SDL_MapRGB (path surface > format) r g b))

  (var texture (* SDL_Texture)
       (SDL_CreateTextureFromSurface renderer surface))
  ;; No need to hold on to surface after texture has been created
  (SDL_FreeSurface surface)
  (unless texture (sdl-print-error))
  (return texture))

(defun-local sdl-print-time-delta (start-num-perf-ticks Uint64 label (* (const char)))
  (var performance-num-ticks-per-second (const Uint64) (SDL_GetPerformanceFrequency))

  (var current-counter-ticks Uint64 (SDL_GetPerformanceCounter))
  (var frame-diff-ticks Uint64 (- current-counter-ticks start-num-perf-ticks))
  (var delta-time float (/ frame-diff-ticks
                           (to-float performance-num-ticks-per-second)))

  (SDL_Log "---  %s at %f seconds\n" label delta-time))

;; Factor 0 to 1
(defun-local vec2-interpolate (factor float from vec2 to vec2 &return vec2)
  (return (array
           (interpolate-range (vec-x from) (vec-x to)
                              0.f 1.f factor)
           (interpolate-range (vec-y from) (vec-y to)
                              0.f 1.f factor))))

(defun-local vec2-is-zero (vec vec2 &return bool)
  (return (and (= 0.f (vec-x vec))
               (= 0.f (vec-y vec)))))

;;
;; Main
;;

;; On return null, play the game, else, exit for returned reason
(defun-local do-main-menu (renderer (* SDL_Renderer)
                                    main-menu-texture (* SDL_Texture)
                                    &return (* (const char)))
  (var exit-reason (* (const char)) null)
  (var in-state input-state (array 0))
  (while (not exit-reason)
    (var event SDL_Event)
    (while (SDL_PollEvent (addr event))
      (when (= (field event type) SDL_QUIT)
        (set exit-reason "Window event")))
    (var currentKeyStates (* (const Uint8))  (SDL_GetKeyboardState null))
    (when (at SDL_SCANCODE_ESCAPE currentKeyStates)
      (set exit-reason "Escape pressed"))

    (unless (= 0 (SDL_RenderCopy renderer main-menu-texture
                                 null null))
      (sdl-print-error)
      (set exit-reason "Render error"))

    (var mouse-x int 0)
    (var mouse-y int 0)
    (var mouse-button-state Uint32 (SDL_GetMouseState (addr mouse-x) (addr mouse-y)))
    (when (bit-and mouse-button-state SDL_BUTTON_LMASK)
      ;; Play the game!
      (return null))

    (SDL_RenderPresent renderer)
    (SDL_Delay todo-arbitrary-delay-ms))
  (return exit-reason))

(comptime-cond
 ('Kitty-Main
(defun main (num-args int args ([] (* char)) &return int)
  (SDL_Log "Kitty Gridlock\n\n
Created by Macoy Madson <macoy@macoy.me>.\n
https://macoy.me/code/macoy/kitty-gridlock\n
Copyright (c) 2021 Macoy Madson.\n
Licensed under GPL-3.0-or-later.\n
Rush Hour database from Michael Fogleman.\n\n")

  ;; Useful reference for creating assets
  (debug-log "Window and board dimensions:\n
\twindow width:                 %d\n
\twindow height:                %d\n
\twindow safe area margin px:   %d\n
\tgame board outer size px:     %d\n
\tgame board outer top left px: %.2f %.2f\n
\tgame board grid size:         %d\n
\tgame board margin px:         %d\n
\tgame board cell size px:      %d\n
\tgame board inner top left px: %.2f %.2f\n\n"
             g-window-width
             g-window-height
             g-window-safe-area-margin-px
             g-game-board-outer-size-px
             (vec-xy g-game-board-outer-top-left-px)
             g-game-board-grid-size
             g-game-board-margin-px
             g-game-board-cell-size-px
             (vec-xy g-game-board-inner-top-left-px))

  ;;
  ;; Initialization
  ;;

  (var window (* SDL_Window) null)
  (unless (sdl-initialize-for-2d (addr window) "Kitty Gridlock"
                                 g-window-width g-window-height)
    (return 1))

  (var performance-num-ticks-per-second (const Uint64) (SDL_GetPerformanceFrequency))
  (var start-load-ticks Uint64 (SDL_GetPerformanceCounter))

  (var renderer (* SDL_Renderer) null)
  (unless (sdl-intialize-2d-renderer (addr renderer) window) (return 1))

  ;; Scale the render to fit the window
  (SDL_RenderSetLogicalSize renderer g-window-width g-window-height)

  (scope ;; Show loading screen
   (var loading-texture (* SDL_Texture) (sdl-texture-from-bmp (in-data-dir "Loading.bmp")
                                                              renderer))
   (unless loading-texture (return 1))
   (SDL_RenderClear renderer)
   (var loading-width int (* 2 200)) ;; Scale it up a bit
   (var loading-height int (* 2 80))
   (var loading-rect SDL_Rect (array (/ (- g-window-width loading-width) 2)
                                     (/ (- g-window-height loading-height) 2)
                                     loading-width loading-height))
   (unless (= 0 (SDL_RenderCopy renderer loading-texture null (addr loading-rect)))
     (sdl-print-error)
     (return 1))
   (SDL_RenderPresent renderer)
   (SDL_DestroyTexture loading-texture))

  (sdl-print-time-delta start-load-ticks "Loading screen displayed")

  (unless (read-puzzles-binary (in-data-dir "puzzles.bin")) (return 1))
  (sdl-print-time-delta start-load-ticks "Puzzles loaded")

  (read-progression-data)
  (sdl-print-time-delta start-load-ticks "Progression loaded")

  (var main-menu-texture (* SDL_Texture)
       (sdl-texture-from-bmp (in-data-dir "MainMenu.bmp") renderer))
  (unless main-menu-texture (return 1))

  (var background-texture (* SDL_Texture) (sdl-texture-from-bmp (in-data-dir "Board.bmp")
                                                                renderer))
  (unless background-texture (return 1))
  (var background-night-texture (* SDL_Texture) (sdl-texture-from-bmp (in-data-dir "Board_Night.bmp")
                                                                      renderer))
  (unless background-night-texture (return 1))

  (var pieces-texture (* SDL_Texture)
       (sdl-texture-from-bmp-color-to-transparent
        (in-data-dir "Pieces.bmp")
        renderer
        0xff 0x00 0xd3))
  (unless pieces-texture (return 1))
  ;; Texture atlas
  (var piece-primary-origin (const vec2) (array 334.f 525.f))
  (var piece-2-1-origin (const vec2) (array 534.f 686.f))
  (var piece-3-1-origin (const vec2) (array 516.f 841.f))
  (var piece-1-2-origin (const vec2) (array 853.f 519.f))
  (var piece-1-3-origin (const vec2) (array 843.f 9.f))
  (var wall-a-origin (const vec2) (array 674.f 507.f))
  (var wall-b-origin (const vec2) (array 342.f 682.f))

  ;; Why doesn't this work?
  ;; (var win-texture (* SDL_Texture)
  ;;      (sdl-texture-from-bmp-color-to-transparent
  ;;       (in-data-dir "Win.bmp")
  ;;       renderer
  ;;       0xff 0x00 0xd3))
  (var win-texture (* SDL_Texture)
       (sdl-texture-from-bmp
        (in-data-dir "Win.bmp") renderer))
  (unless win-texture (return 1))

  (var theme-button-texture (* SDL_Texture)
       (sdl-texture-from-bmp
        (in-data-dir "Theme_Button.bmp") renderer))
  (unless theme-button-texture (return 1))
  (var undo-button-texture (* SDL_Texture)
       (sdl-texture-from-bmp
        (in-data-dir "Undo_Button.bmp") renderer))
  (unless undo-button-texture (return 1))
  (var next-button-texture (* SDL_Texture)
       (sdl-texture-from-bmp
        (in-data-dir "Next_Button.bmp") renderer))
  (unless next-button-texture (return 1))

  (var font-texture (* SDL_Texture)
       (sdl-texture-from-bmp
        (in-data-dir "Font.bmp") renderer))
  (unless font-texture (return 1))

  (var textures-to-destroy ([] (* SDL_Texture))
       (array main-menu-texture
              background-texture
              pieces-texture
              win-texture
              theme-button-texture
              undo-button-texture
              next-button-texture
              font-texture))

  (sdl-print-time-delta start-load-ticks "Textures loaded")

  (srand (type-cast (SDL_GetPerformanceCounter) int))

  ;; (game-board-load "IBBxooIooLDDJAALooJoKEEMFFKooMGGHHHM")
  (game-board-load-next-puzzle)

  ;;
  ;; Game loop
  ;;
  (var delta-time float 0.016f) ;; Made up but reasonable frame time
  (var last-frame-perf-count Uint64 (* delta-time performance-num-ticks-per-second))
  (var recent-n-perf-counts ([] 10 Uint64) (array 0))
  (var recent-n-perf-counts-write-head int 0)

  (var is-day-mode bool false)
  (var selected-piece (* board-piece) null)
  (var selection-start-position vec2 (array 0))

  (var in-state input-state (array 0))

  (sdl-print-time-delta start-load-ticks "Game loop starting")

  (var exit-reason (* (const char)) null)

  (set exit-reason (do-main-menu renderer main-menu-texture))

  (while (not exit-reason)
    (var event SDL_Event)
    (while (SDL_PollEvent (addr event))
      (when (= (field event type) SDL_QUIT)
        (set exit-reason "Window event")))
    (var currentKeyStates (* (const Uint8))  (SDL_GetKeyboardState null))
    (when (at SDL_SCANCODE_ESCAPE currentKeyStates)
      (set exit-reason "Escape pressed"))

    (var mouse-x int 0)
    (var mouse-y int 0)
    (var mouse-button-state Uint32 (SDL_GetMouseState (addr mouse-x) (addr mouse-y)))
    (var mouse-position vec2 (array (to-float mouse-x) (to-float mouse-y)))
    (scope ;; Scale mouse position to match logical rendering positions
     (var window-width int 1)
     (var window-height int 1)
     (SDL_GetWindowSize window (addr window-width) (addr window-height))
     (var logical-width int 1)
     (var logical-height int 1)
     (SDL_RenderGetLogicalSize renderer (addr logical-width) (addr logical-height))
     (when (or (= 0 window-width)
               (= 0 window-height)
               (= 0 logical-width)
               (= 0 logical-height))
       (set exit-reason "error: window or logical dimension will cause divide by zero")
       (break))
     (var to-logical-scale vec2
          (array
           (/ (to-float logical-width) window-width)
           (/ (to-float logical-height) window-height)))
     ;; (SDL_Log "Window scale %f %f\n" (vec-xy to-logical-scale))
     (var logical-aspect-ratio float (/ logical-width (to-float logical-height)))
     (var window-aspect-ratio float (/ window-width (to-float window-height)))
     (if (> window-aspect-ratio logical-aspect-ratio) ;; Remove centering for correct scaling
         (block
             (var total-margin float
                  (- window-width (* window-width (/ logical-aspect-ratio window-aspect-ratio))))
           (set (vec-x to-logical-scale) (/ logical-width (- window-width total-margin)))
           (var decentered float
                (/ total-margin
                   2.f))
           (set (vec-x mouse-position)
                (- (vec-x mouse-position)
                   decentered)))
         (block
             (var total-margin float
                  (- window-height (* window-height (/ window-aspect-ratio logical-aspect-ratio))))
           (set (vec-y to-logical-scale) (/ logical-height (- window-height total-margin)))
           (var decentered float
                (/ total-margin
                   2.f))
           (set (vec-y mouse-position)
                (- (vec-y mouse-position)
                   decentered))))
     (set mouse-position (vec2-multiply mouse-position to-logical-scale)))

    (update-input-state (addr in-state) mouse-position
                        (bit-and mouse-button-state SDL_BUTTON_LMASK))

    (if (bit-and mouse-button-state SDL_BUTTON_LMASK)
        (block
            (unless selected-piece ;; If holding, allow dragging even when not exactly on piece
              (set selection-start-position mouse-position)
              (set selected-piece (pick-game-piece-from-screen-position mouse-position))))
        (when selected-piece
          ;; Selection released; let block finish move and update grid
          (var delta-grid-movement grid-vec2
               (array
                (type-cast
                 (round
                  (/ (vec-x (path selected-piece > moving-position))
                     g-game-board-cell-size-px)) int)
                (type-cast
                 (round
                  (/ (vec-y (path selected-piece > moving-position))
                     g-game-board-cell-size-px)) int)))
          (debug-log "%f %f becomes %d %d\n"
                     (vec-x (path selected-piece > moving-position))
                     (vec-y (path selected-piece > moving-position))
                     (vec-xy delta-grid-movement))
          (var new-position grid-vec2
               (grid-vec2-add (path selected-piece > grid-position) delta-grid-movement))
          (unless (is-within-grid new-position)
            (set exit-reason "Piece movement constraints failed to keep piece on board")
            (break))
          (when (or (!= 0 (vec-x delta-grid-movement))
                    (!= 0 (vec-y delta-grid-movement)))
            (make-action selected-piece delta-grid-movement)
            (set (path selected-piece > grid-position) new-position)
            ;; Remove the moving position difference from changing grid position, b/c moving is relative
            (set (vec-x (path selected-piece > moving-position))
                 (- (vec-x (path selected-piece > moving-position))
                    (* g-game-board-cell-size-px (vec-x delta-grid-movement))))
            (set (vec-y (path selected-piece > moving-position))
                 (- (vec-y (path selected-piece > moving-position))
                    (* g-game-board-cell-size-px (vec-y delta-grid-movement))))
            (game-board-sync-occupied-state))
          (set selected-piece nullptr)))

    (SDL_RenderClear renderer)

    (unless (= 0 (SDL_RenderCopy renderer (? is-day-mode background-texture background-night-texture)
                                 null null))
      (sdl-print-error)
      (set exit-reason "Render error"))

    (scope ;; UI
     (when (do-button (addr in-state) (array 10.f 10.f) (array 166.f 166.f)
                      renderer theme-button-texture)
       (set is-day-mode (not is-day-mode)))
     (when (do-button (addr in-state) (array 190.f 1900.f) (array 166.f 166.f)
                      renderer undo-button-texture)
       (unless selected-piece ;; Don't allow undo while also moving another piece
         (undo-action)))
     (when (do-button (addr in-state) (array 724.f 1900.f) (array 166.f 166.f)
                      renderer next-button-texture)
       (game-board-load-next-puzzle)))

    (on-each-existing-board-piece ;; Draw pieces
     piece piece-index
     (if (= selected-piece piece)
         (scope
          (var piece-position vec2 (game-piece-grid-position-to-screen-position piece))
          (var mouse-delta-pos vec2 (vec2-subtract mouse-position selection-start-position))
          (set (path piece > moving-position)
               (constrain-piece-moving-position piece mouse-delta-pos)))
         ;; Reset positions on release
         (when (not (vec2-is-zero (path piece > moving-position)))
           (var ease-position vec2 (vec2-interpolate
                                    (/ delta-time 0.1f)
                                    (path piece > moving-position) (array 0.f 0.f)))
           ;; Make sure it's not always approaching smaller and smaller values
           (when (< (fabs (vec-x ease-position)) 0.001f)
             (set (vec-x ease-position) 0.f))
           (when (< (fabs (vec-y ease-position)) 0.001f)
             (set (vec-y ease-position) 0.f))
           (set (path piece > moving-position) ease-position)))

     (var piece-position vec2 (game-piece-position-to-screen-position piece))
     (var piece-size vec2 (game-piece-get-screen-size piece))

     (var selected-piece-origin vec2 piece-2-1-origin)
     (cond ((path piece > is-primary-piece) ;; Pick atlas texture coords for piece
            (set selected-piece-origin piece-primary-origin))
           ((path piece > is-wall)
            (set selected-piece-origin wall-a-origin))
           ((and (path piece > is-vertical) (= 3 (path piece > num-cells)))
            (set selected-piece-origin piece-1-3-origin))
           ((and (path piece > is-vertical) (= 2 (path piece > num-cells)))
            (set selected-piece-origin piece-1-2-origin))
           ((and (not (path piece > is-vertical)) (= 2 (path piece > num-cells)))
            (set selected-piece-origin piece-2-1-origin))
           ((and (not (path piece > is-vertical)) (= 3 (path piece > num-cells)))
            (set selected-piece-origin piece-3-1-origin)))

     (var dest-rect SDL_Rect (array (vec-xy-to-int piece-position)
                                    (vec-xy-to-int piece-size)))
     (var src-rect SDL_Rect (array (vec-xy-to-int selected-piece-origin)
                                   (vec-xy-to-int piece-size)))
     (unless (= 0 (SDL_RenderCopy renderer pieces-texture
                                  (addr src-rect) (addr dest-rect)))
       (sdl-print-error)
       (set exit-reason "Render error")))

    ;; Turn count
    (draw-formatted-string (array 570.f 15.f) "%d/%d" g-current-move-count
                           (? g-current-puzzle (path g-current-puzzle > num-moves) 0))

    (draw-formatted-string (array 190.f 15.f) "%d" g-num-puzzles-won)

    (when g-show-fps ;; Frame rate
      (draw-formatted-string (array 700.f 2100.f) "%d" (type-cast (/ 1.f delta-time) int)))

    (when (is-in-win-state)
      (unless g-has-won-puzzle
        (set g-has-won-puzzle true)
        (incr g-num-puzzles-won)
        (when g-current-progression-puzzle
          (set (path g-current-progression-puzzle > is-solved) true))
        (write-progression-data))
      (var dest-rect SDL_Rect (array 60 140 960 500))
      (unless (= 0 (SDL_RenderCopy renderer win-texture null (addr dest-rect)))
        (sdl-print-error)
        (set exit-reason "Render error")))

    (SDL_RenderPresent renderer)

    (var current-counter-ticks Uint64 (SDL_GetPerformanceCounter))
    (var frame-diff-ticks Uint64 (- current-counter-ticks last-frame-perf-count))
    (set last-frame-perf-count current-counter-ticks)

    (set (at recent-n-perf-counts-write-head recent-n-perf-counts)
         frame-diff-ticks)
    (incr recent-n-perf-counts-write-head)
    (when  (>= recent-n-perf-counts-write-head (array-size recent-n-perf-counts))
      (set recent-n-perf-counts-write-head 0))

    (set delta-time (/ frame-diff-ticks
                       (to-float performance-num-ticks-per-second)))
    ;; (SDL_Log "%lu %f %fhz\n" frame-diff-ticks delta-time (/ 1.f delta-time))
    (SDL_Delay todo-arbitrary-delay-ms))

  (scope ;; Frame time
   (var num-timings int (array-size recent-n-perf-counts))
   (SDL_Log "Recent %d frame timings (fixed sleep of %d ms):\n" num-timings todo-arbitrary-delay-ms)
   (each-in-array
    recent-n-perf-counts i
    (var delta-time float (/ (at i recent-n-perf-counts)
                             (to-float performance-num-ticks-per-second)))
    (unless delta-time (continue))
    (SDL_Log "\t%f %fhz\n" delta-time (/ 1.f delta-time))))

  ;;
  ;; Shutdown
  ;;
  (when exit-reason
    (SDL_Log "Exiting. Reason: %s\n" exit-reason))

  (write-progression-data)

  (when g-puzzle-list
    (free (type-cast g-puzzle-list (* void)))
    (set g-puzzle-list null))

  (when g-progression-puzzles
    (free (type-cast g-progression-puzzles (* void)))
    (set g-progression-puzzles null))

  (each-in-array
   textures-to-destroy i
   (SDL_DestroyTexture (at i textures-to-destroy)))

  (SDL_DestroyRenderer renderer)

  (sdl-shutdown window)

  (return 0))
))
;;
;; Macros and generators
;;

(defmacro debug-log (&rest arguments any)
  (tokenize-push
   output
   (when debug-log-enabled
     (SDL_Log (token-splice-rest arguments tokens))))
  (return true))

(defgenerator define-constant (define-name symbol value any)
  (var define-statement (const ([] CStatementOperation))
       (array
        (array Keyword "#define" -1)
        (array Expression null 1)
        (array Keyword " " -1)
        (array Expression null 2)
        (array KeywordNoSpace "\n" -1)))
  (return (c-statement-out define-statement)))

(defgenerator undefine-constant (define-name symbol)
  (var define-statement (const ([] CStatementOperation))
       (array
        (array Keyword "#undef" -1)
        (array Expression null 1)
        (array KeywordNoSpace "\n" -1)))
  (return (c-statement-out define-statement)))

;; Necessary to create e.g. in C PREFIX "_my_thing"
(defgenerator static-string-combine (string-A any string-B any)
  (var statement (const ([] CStatementOperation))
       (array
        (array Expression null 1)
        (array Keyword " " -1)
        (array Expression null 2)))
  (return (c-statement-out statement)))

;; cakelisp's tokenizer doesn't properly parse ' '
(defgenerator space-hack ()
  (var statement (const ([] CStatementOperation))
       (array
        (array Keyword "' '" -1)))
  (return (c-statement-out statement)))

(defgenerator if-c-preprocessor-defined (preprocessor-symbol symbol
                                                             true-block (index any) false-block (index any))
  (var statement (const ([] CStatementOperation))
       (array
        (array Keyword "#ifdef" -1)
        (array Expression null 1)
        (array KeywordNoSpace "\n" -1)
        (array Statement null 2)
        (array KeywordNoSpace "#else" -1)
        (array KeywordNoSpace "\n" -1)
        (array Statement null 3)
        (array KeywordNoSpace "#endif" -1)
        (array KeywordNoSpace "\n" -1)))
  (return (c-statement-out statement)))

(defgenerator c-for (initializer any conditional any update any &rest &optional body any)
  (var statement (const ([] CStatementOperation))
       (array
        (array Keyword "for" -1)
        (array OpenParen null -1)
        (array Statement null 1)
        (array Expression null 2)
        (array Keyword ";" -1)
        (array Expression null 3)
        (array CloseParen null -1)
        (array OpenBlock null -1)
        (array Body null 4)
        (array CloseBlock null -1)))
  (return (c-statement-out statement)))

(defmacro c-statement-out (statement-operation symbol)
  (tokenize-push
   output
   (CStatementOutput environment context tokens startTokenIndex
                     (token-splice statement-operation)
                     (array-size (token-splice statement-operation))
                     output))
  (return true))

(defmacro repeat (thing any)
  (tokenize-push
   output
   (token-splice thing) (token-splice thing))
  (return true))

(defmacro vec-xy-to-int (vec symbol)
  (tokenize-push
   output
   (type-cast (vec-x (token-splice vec)) int)
   (type-cast (vec-y (token-splice vec)) int))
  (return true))

(defmacro to-float (expression any)
  (tokenize-push
   output
   (type-cast (token-splice expression) float))
  (return true))

;; This only works for arrays where the size is known at compile-time
(defmacro each-in-array (array-name symbol iterator-name symbol &rest body any)
  (tokenize-push
   output
   (scope
    (each-in-range (array-size (token-splice array-name)) (token-splice iterator-name)
                   (token-splice-rest body tokens))))
  (return true))

;; Note: Will reevaluate the range expression each iteration
(defmacro each-in-range (range any iterator-name symbol &rest body any)
  (tokenize-push
   output
   (c-for (var (token-splice iterator-name) int 0)
          (< (token-splice iterator-name) (token-splice range))
          (incr (token-splice iterator-name))
          (token-splice-rest body tokens)))
  (return true))

(defmacro each-char-in-string (start-char any iterator-name symbol &rest body any)
  (tokenize-push
   output
   (c-for (var (token-splice iterator-name) (* char) (token-splice start-char))
          (deref (token-splice iterator-name))
          (incr (token-splice iterator-name))
          (token-splice-rest body tokens)))
  (return true))

(defmacro each-char-in-string-const (start-char any iterator-name symbol &rest body any)
  (tokenize-push
   output
   (c-for (var (token-splice iterator-name) (* (const char)) (token-splice start-char))
          (deref (token-splice iterator-name))
          (incr (token-splice iterator-name))
          (token-splice-rest body tokens)))
  (return true))

(defmacro draw-formatted-string (position any format-string string &rest arguments any)
  (tokenize-push
   output
   (scope
    (var format-buffer ([] 64 char) (array 0))
    (var num-printed int
         (snprintf format-buffer (array-size format-buffer)
                   (token-splice format-string)
                   (token-splice-rest arguments tokens)))
    (set (at num-printed format-buffer) 0)
    (draw-string renderer font-texture format-buffer (token-splice position))))
  (return true))

;;
;; Building
;;
(defun-comptime generate-puzzles-list (manager (& ModuleManager) module (* Module) &return bool)
  (var puzzles-text (* (const char)) "../../data/puzzles.txt")
  (var puzzles-binary (* (const char)) "../../data/puzzles.bin")

  ;; Already built?
  (unless (fileIsMoreRecentlyModified puzzles-text puzzles-binary)
    (Log "generate-puzzles-list: Puzzles list already built\n")
    (return true))

  (unless (fileExists puzzles-text)
    (Log "generate-puzzles-list: Building puzzles list from database\n")
    (run-process-sequential-or
     ;; Note that we're still relative to Dependencies/gamelib
     ("./Dependencies/cakelisp/bin/cakelisp" "--execute" "../../src/Decompression.cake")
     (Log "generate-puzzles-list: Failed to run Decompression for puzzle database reading\n")
     (return false))
    (unless (fileExists puzzles-text)
      (Logf "generate-puzzles-list: Successfully executed Decompression, but didn't find
 %s. Are paths incorrect?\n" puzzles-text)
      (return false)))

  (run-process-sequential-or
   ;; Note that we're still relative to Dependencies/gamelib
   ("./Dependencies/cakelisp/bin/cakelisp" "--execute" "../../src/PuzzleIO.cake")
   (Log "generate-puzzles-list: Failed to run PuzzleIO for puzzle database reading\n")
   (return false))

  (unless (fileExists puzzles-binary)
    (Log "generate-puzzles-list: Successfully executed PuzzleIO, but didn't find
 data/puzzles.bin. Are paths incorrect?\n")
    (return false))
  (return true))

;; Because we have the list of modules from manager, we could actually generate the Android.mk file
;; in ../../Android/app/jni/src/ so that it automatically adds modules we import. For now I won't
;; do that, but a much bigger project would be well served by such a feature.
(defun-comptime copy-src-files-to-android (manager (& ModuleManager) module (* Module) &return bool)
  (Log "copy-src-files-to-android: Copying files to SDL Android project\n")

  (unless (fileExists "../../data/puzzles.bin")
    (Log "copy-src-files-to-android: Didn't find data/puzzles.bin. Has generate-puzzles-list not
 been executed yet?\n")
    (return false))

  (run-process-sequential-or
   ;; Note that we're still relative to Dependencies/gamelib
   ("rsync" "--verbose" "--recursive" "--update"
            "--exclude=puzzles.txt"
            "../../data"
            "../../Android/app/src/main/assets/")
   (Log "copy-src-files-to-android: failed to sync data/ to Android assets folder\n
This tool requires rsync to be installed.\n")
   (return false))
  (run-process-sequential-or
   ;; Note that we're still relative to Dependencies/gamelib
   ("rsync" "--verbose" "--recursive" "--update"
            "--exclude=*.o" "--exclude=kitty-gridlock" "--exclude=*Cache.cake"
            "cakelisp_cache/HandmadeMath-Kitty/"
            "../../Android/app/jni/src/")
   (Log "copy-src-files-to-android: failed to sync src/ to Android assets folder\n
This tool requires rsync to be installed.\n")
   (return false))
  (return true))

(comptime-cond
 ('Kitty-Main
  (add-compile-time-hook-module pre-build generate-puzzles-list)
  ;; Order matters here, because we want to copy the generated puzzles list to android
  (add-compile-time-hook-module pre-build copy-src-files-to-android :priority-decrease 1)
  ))

(module-use-sdl-build-options)

(comptime-cond
 ('Kitty-Main
  ;; Note that this executable still pulls .so files from Dependencies
  (set-cakelisp-option executable-output "../../kitty-gridlock")))

;; This ensures we still find SDL even after we've relocated the executable
(add-library-runtime-search-directory "Dependencies/gamelib/Dependencies/SDL/buildSDLBuild/lib")

;; Use build label to make it easier to find in cakelisp_cache
(add-build-config-label "Kitty")