@ -18,7 +18,7 @@
&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.h" "SDL_syswm.h" "SDL_timer.h" "SDL_render.h" "SDL_rwops.h"
;; For round()
"<math.h>" )
@ -40,6 +40,8 @@
;; This fixed GPU "coil whine" which I was getting running at 5400hz (completely unnecessary)
( var todo-arbitrary-delay-ms int 10 )
( var g-save-file-name ( * ( const char ) ) "progression.bin" )
( define-constant DATA_DIR "data/" )
( defmacro in-data-dir ( path-in-data string )
@ -455,6 +457,8 @@
( 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 )
@ -500,13 +504,37 @@
( set g-action-buffer-write-head action-buffer-read-head ) )
( defun game-board-load-next-puzzle ( )
( defun-local game-board-load-next-puzzle ( )
( when g-num-puzzles
( set g-current-puzzle ( addr ( at ( mod ( rand ) g-num-puzzles ) 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 ) 1 )
( defun-local write-progression-data ( )
( var save-file ( * SDL_RWops ) ( SDL_RWFromFile g-save-file-name "w" ) )
( if save-file
( scope
( SDL_WriteLE32 save-file g-progression-file-version )
( SDL_WriteLE32 save-file g-num-puzzles-won )
( SDL_RWclose save-file ) )
( printf "warning: failed to save progression file\n" ) ) )
( defun-local read-progression-data ( )
( var save-file ( * SDL_RWops ) ( SDL_RWFromFile g-save-file-name "r" ) )
( if save-file
( scope
( var version int ( SDL_ReadLE32 save-file ) )
( unless ( = version g-progression-file-version )
( printf "warning: failed to load progression file (version mismatch). Progress will be lost\n" )
( SDL_RWclose save-file )
( return ) )
( set g-num-puzzles-won ( SDL_ReadLE32 save-file ) )
( SDL_RWclose save-file ) )
( printf "warning: failed to load progression file\n" ) ) )
;;
;; UI (immediate-mode)
;;
@ -578,11 +606,10 @@
( array '/ ' ( array 981 14 80 139 ) ) ) )
( defun-local pick-font-glyph-from-character ( symbol char &return ( * font-glyph ) )
( var i int 0 )
( while ( < i ( array-size g-font-atlas ) )
( when ( = symbol ( field ( at i g-font-atlas ) symbol ) )
( return ( addr ( at i g-font-atlas ) ) ) )
( incr i ) )
( 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 )
@ -769,6 +796,8 @@ Rush Hour database from Michael Fogleman.\n\n")
( unless ( read-puzzles-binary ( in-data-dir "puzzles.bin" ) ) ( return 1 ) )
( sdl-print-time-delta start-load-ticks "Puzzles loaded" )
( read-progression-data )
( var background-texture ( * SDL_Texture ) ( sdl-texture-from-bmp ( in-data-dir "Board.bmp" )
renderer ) )
( unless background-texture ( return 1 ) )
@ -1038,23 +1067,20 @@ Rush Hour database from Michael Fogleman.\n\n")
( sdl-print-error )
( set exit-reason "Render error" ) ) )
( scope ;; Turn count
( var turns-buffer ( [] 8 char ) ( array 0 ) )
( var num-printed int
( snprintf turns-buffer ( array-size turns-buffer )
"%d/%d" g-current-move-count ( ? g-current-puzzle ( path g-current-puzzle > num-moves ) 0 ) ) )
( set ( at num-printed turns-buffer ) 0 )
( draw-string renderer font-texture turns-buffer ( array 600.f 10.f ) ) )
;; Turn count
( draw-formatted-string ( array 600.f 10.f ) "%d/%d" g-current-move-count
( ? g-current-puzzle ( path g-current-puzzle > num-moves ) 0 ) )
( draw-formatted-string ( array 300.f 10.f ) "%d" g-num-puzzles-won )
( when g-show-fps ;; Frame rate
( var fps-buffer ( [] 5 char ) ( array 0 ) )
( var num-printed int
( snprintf fps-buffer ( array-size fps-buffer )
"%d" ( type-cast ( / 1.f delta-time ) int ) ) )
( set ( at num-printed fps-buffer ) 0 )
( draw-string renderer font-texture fps-buffer ( array 700.f 2100.f ) ) )
( 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 )
( 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 )
@ -1080,12 +1106,11 @@ Rush Hour database from Michael Fogleman.\n\n")
( 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 )
( var i int 0 )
( while ( < i num-timings )
( var delta-time float ( / ( at i recent-n-perf-counts )
( type-cast performance-num-ticks-per-second float ) ) )
( SDL_Log "\t%f %fhz\n" delta-time ( / 1.f delta-time ) )
( incr i ) ) )
( each-in-array
recent-n-perf-counts i
( var delta-time float ( / ( at i recent-n-perf-counts )
( type-cast performance-num-ticks-per-second float ) ) )
( SDL_Log "\t%f %fhz\n" delta-time ( / 1.f delta-time ) ) ) )
;;
;; Shutdown
@ -1093,13 +1118,14 @@ Rush Hour database from Michael Fogleman.\n\n")
( 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 ) )
( var i int 0 )
( while ( < i ( array-size textures-to-destroy ) )
( SDL_DestroyTexture ( at i textures-to-destroy ) )
( incr i ) )
( each-in-array
textures-to-destroy i
( SDL_DestroyTexture ( at i textures-to-destroy ) ) )
( SDL_DestroyRenderer renderer )
@ -1179,16 +1205,29 @@ Rush Hour database from Michael Fogleman.\n\n")
( type-cast ( token-splice expression ) float ) )
( return true ) )
( defmacro each-in-array ( array-name symbol iterator-name symbol &rest body any )
( tokenize-push
output
( var ( token-splice iterator-name ) int 0 )
( var next-iterator int 0 ) ;; TODO needs unique name
( while ( < next-iterator ( array-size ( token-splice array-name ) ) )
( set ( token-splice iterator-name ) next-iterator )
( incr next-iterator )
( token-splice-rest body tokens ) ) )
( scope
( var ( token-splice iterator-name ) int 0 )
( var next-iterator int 0 ) ;; TODO needs unique name
( while ( < next-iterator ( array-size ( token-splice array-name ) ) )
( set ( token-splice iterator-name ) next-iterator )
( incr next-iterator )
( 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 ) )
;;