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)