An application to display interactive slide presentations.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 
 
 

1277 lines
53 KiB

(set-cakelisp-option cakelisp-src-dir "Dependencies/cakelisp/src")
(set-cakelisp-option cakelisp-lib-dir "Dependencies/cakelisp/bin")
(add-cakelisp-search-directory "Dependencies/gamelib/src")
(add-cakelisp-search-directory "Dependencies/cakelisp/runtime")
(add-cakelisp-search-directory "src")
(import
;; Cakelisp
"CHelpers.cake"
;; GameLib
"Introspection.cake" "SDL.cake" "DynamicArray.cake" "Dictionary.cake" "DataBundle.cake"
"Math.cake" "SDLFontAtlas.cake" "FreeType.cake")
(c-import "<stdio.h>"
&with-decls "<stdint.h>")
(var s-draw-atlases bool false)
(var s-enable-debug-overlay bool false) ;; F1
(bundle-file s-start-ubuntu-regular-font s-end-ubuntu-regular-font
(unsigned char) "data/Fonts/Ubuntu-R.ttf")
(bundle-file s-start-ubuntu-mono-font s-end-ubuntu-mono-font
(unsigned char) "data/Fonts/UbuntuMono-R.ttf")
(define-keybind s-quit-keybind (array SDL_SCANCODE_Q keybind-modifier-flags-ctrl))
(define-keybind s-next-slide-keybind (array SDL_SCANCODE_RIGHT)
(array SDL_SCANCODE_DOWN)
(array SDL_SCANCODE_SPACE)
(array SDL_SCANCODE_RETURN)
(array SDL_SCANCODE_PAGEDOWN))
(define-keybind s-previous-slide-keybind (array SDL_SCANCODE_LEFT)
(array SDL_SCANCODE_UP)
(array SDL_SCANCODE_BACKSPACE)
(array SDL_SCANCODE_PAGEUP))
(define-keybind s-toggle-debug-overlay-keybind (array SDL_SCANCODE_F1))
(define-keybind s-toggle-fullscreen-keybind (array SDL_SCANCODE_F11))
(define-keybind s-attack-keybind (array SDL_SCANCODE_1))
(define-keybind s-attack-2-keybind (array SDL_SCANCODE_2))
(define-keybind s-attack-3-keybind (array SDL_SCANCODE_3))
(define-keybind s-attack-4-keybind (array SDL_SCANCODE_4))
(define-keybind s-attack-5-keybind (array SDL_SCANCODE_5))
(defstruct-local power-keybind
bind (addr keybind)
power-id (addr (const char)))
(var s-power-keybinds (array power-keybind)
(array
(array (addr s-attack-2-keybind) "fireball")
(array (addr s-attack-3-keybind) "iceStorm")
(array (addr s-attack-4-keybind) "leaking-fireball")
(array (addr s-attack-5-keybind) "rocks")))
(var s-key-states sdl-key-states (array 0))
(defmacro preslog (format string &optional &rest arguments any)
(if arguments
(scope
(tokenize-push output
(fprintf stderr (token-splice format) (token-splice-rest arguments tokens))))
(scope
(tokenize-push output
(fprintf stderr (token-splice format)))))
(return true))
;;
;; Slides
;;
(def-introspect-struct slide-data
heading (array 256 char)
body (array 1024 char)
;; Set body font to monospace
is-code bool
trigger (array 64 char))
(def-introspect-struct presentation-data
slides (array 256 slide-data) ('array-allow-subset))
(bundle-file s-start-presentation s-end-presentation
(const char) "data/DrivingCodeWithData.cakedata")
;;
;; Game
;;
(bundle-file s-start-wizard-spritesheet s-end-wizard-spritesheet
(unsigned char) "assets/wizard.bmp")
(bundle-file s-start-boar-spritesheet s-end-boar-spritesheet
(unsigned char) "assets/boar.bmp")
(bundle-file s-start-ground-bmp s-end-ground-bmp
(unsigned char) "assets/Ground.bmp")
(bundle-file s-start-fireball-spritesheet s-end-fireball-spritesheet
(unsigned char) "assets/fireball.bmp")
(bundle-file s-start-smoke-explosion-spritesheet s-end-smoke-explosion-spritesheet
(unsigned char) "assets/smokeExplosion.bmp")
(bundle-file s-start-explosion-spritesheet s-end-explosion-spritesheet
(unsigned char) "assets/explosion.bmp")
(bundle-file s-start-ice-explosion-spritesheet s-end-ice-explosion-spritesheet
(unsigned char) "assets/iceExplosion.bmp")
(bundle-file s-start-rocks-spritesheet s-end-rocks-spritesheet
(unsigned char) "assets/rocks.bmp")
(forward-declare (struct SDL_Texture))
(def-introspect-struct spritesheet
id (array 64 char)
texture (addr SDL_Texture) (ignore)
width int
height int
frame-width int
frame-height int
scale-factor int)
(defstruct-local animation
start-frame-index (unsigned char)
end-frame-index (unsigned char)
flip SDL_RendererFlip
next-animation (addr animation))
(var spritesheet-wizard (addr spritesheet) null) ;; Populated from data
(var anim-wizard-idle animation (array 0 5 SDL_FLIP_HORIZONTAL null))
(var anim-wizard-damage animation (array 31 35 SDL_FLIP_HORIZONTAL
(addr anim-wizard-idle)))
;; Long attack
(var anim-wizard-attack animation (array 14 31 SDL_FLIP_HORIZONTAL
(addr anim-wizard-idle)))
(var anim-wizard-fast-attack animation (array 7 13 SDL_FLIP_HORIZONTAL
(addr anim-wizard-idle)))
(var anim-wizard-jump-in animation (array 7 13 SDL_FLIP_HORIZONTAL
(addr anim-wizard-idle)))
;; (var wizard-attack-effect-frame int 10)
(var wizard-attack-effect-frame int 28)
(var spritesheet-boar (addr spritesheet) null) ;; Populated from data
(var anim-boar-idle animation (array 0 6 SDL_FLIP_HORIZONTAL
null))
(var anim-boar-jump-in animation (array 23 34 SDL_FLIP_HORIZONTAL
(addr anim-boar-idle)))
(var anim-boar-damage animation (array (+ (* 3 6) 3) (+ (* 3 6) 5) SDL_FLIP_HORIZONTAL
(addr anim-boar-idle)))
(var spritesheet-fireball (addr spritesheet) null) ;; Populated from data
(var anim-fireball-idle animation (array 0 2 SDL_FLIP_NONE
null))
(var spritesheet-smoke-explosion (addr spritesheet) null) ;; Populated from data
(var anim-smoke-explosion-idle animation (array 0 4 SDL_FLIP_NONE
null))
(var spritesheet-explosion (addr spritesheet) null) ;; Populated from data
(var spritesheet-ice-explosion (addr spritesheet) null) ;; Populated from data
(var spritesheet-rocks (addr spritesheet) null) ;; Populated from data
(var c-animation-frame-rate (const float) 0.1f)
;; Returns whether the next animation should be started instead
(defun-local animation-get-current-frame (;; This can be modified if there is a (anim > next-animation)
anim (addr (const animation))
animation-start-ticks Uint64
frame-rate float
;; Not valid if the next animation should be played
frame-index-out (addr int)
&return bool)
(var num-frames int (- (+ 1 (path anim > end-frame-index)) ;; TODO: Off by one?
(path anim > start-frame-index)))
(var loop-rate float (* frame-rate num-frames))
(var animation-time-seconds float
(/ (- (SDL_GetPerformanceCounter) animation-start-ticks)
(type-cast (SDL_GetPerformanceFrequency) float)))
(when (and (path anim > next-animation)
(> animation-time-seconds loop-rate))
(return false))
(var-cast-to current-frame int
(interpolate-range
0.f (type-cast num-frames float)
0.f loop-rate
(- animation-time-seconds
(* loop-rate (truncf (/ animation-time-seconds loop-rate))))))
(set (deref frame-index-out) (+ current-frame (path anim > start-frame-index)))
(return true))
(defun-local render-animation (renderer (addr SDL_Renderer)
sprite (addr spritesheet)
;; This can be modified if there is a (anim > next-animation)
anim (addr (addr (const animation)))
animation-start-ticks Uint64
frame-rate float
x int y int)
(var sprite-width int (/ (path sprite > width) (path sprite > frame-width)))
(var sprite-height int (/ (path sprite > height) (path sprite > frame-height)))
(var current-frame int 0)
(while (not (animation-get-current-frame (deref anim) animation-start-ticks frame-rate
(addr current-frame)))
(set (deref anim) (path (deref anim) > next-animation)))
(var frame-x int (mod current-frame
(path sprite > frame-width)))
(var frame-y int (/ current-frame
(path sprite > frame-width)))
(var source-rectangle SDL_Rect
(array (* frame-x sprite-width) (* frame-y sprite-height)
sprite-width
sprite-height))
(var destination-rectangle SDL_Rect
(array x y
(* (path sprite > scale-factor) sprite-width)
(* (path sprite > scale-factor) sprite-height)))
(unless (= 0 (SDL_RenderCopyEx renderer (path sprite > texture)
(addr source-rectangle) (addr destination-rectangle)
0.f null ;; no rotation
(path (deref anim) > flip)))
(sdl-print-error)))
;;
;; Power and effect system
;;
(defenum operation-type
operation-type-play-effect
operation-type-expire-on-animation-end
operation-type-damage
operation-type-spawn-power
operation-type-set-value
operation-type-add-to-value
operation-type-if-equals
operation-type-if-string-equals
operation-type-if-greater-than-or-equal
operation-type-end)
(var c-open-if-blocks (array operation-type)
(array operation-type-if-equals
operation-type-if-string-equals
operation-type-if-greater-than-or-equal))
(def-introspect-struct operation
type int ;; operation-type
string-a (array 32 char)
string-b (array 32 char))
(defun-local parse-power-operations (operations (addr (const char))
&return (addr operation)) ;; dynarray
(var new-operations (addr operation) null)
(defstruct operation-reader
type operation-type
keyword (addr (const char))
num-arguments char)
(var readers (array operation-reader)
(array
(array
operation-type-play-effect
"PlayEffect" 2)
(array
operation-type-expire-on-animation-end
"Expire" 0)
(array
operation-type-damage
"DamageEnemy" 0)
(array
operation-type-spawn-power
"SpawnPower" 1)
(array
operation-type-set-value
"SetValue" 2)
(array
operation-type-add-to-value
"AddToValue" 2)
(array
operation-type-if-equals
"IfEquals" 2)
(array
operation-type-if-string-equals
"IfStringEquals" 2)
(array
operation-type-if-greater-than-or-equal
"IfGreaterThanOrEqual" 2)
(array
operation-type-end
"End" 0)))
(defenum read-state
read-state-looking-for-keyword
read-state-reading-arguments)
(var state read-state read-state-looking-for-keyword)
(var new-operation operation)
(var current-operation-reader (addr operation-reader) null)
(var argument-index int 0)
(each-char-in-string-const operations current-char
(cond
((= state read-state-looking-for-keyword)
(when (and (!= ' ' (deref current-char))
(!= '\n' (deref current-char))
(!= '\r' (deref current-char)))
(var argument-end (addr (const char)) null)
(each-char-in-string-const current-char end-char
(set argument-end end-char)
(when (or (= ' ' (deref end-char))
(= '\n' (deref end-char))
(= '\r' (deref end-char)))
(break)))
;; The very last character of the string needs a special case to pull it in
(unless (at 1 argument-end)
(incr argument-end))
(each-item-addr-in-array readers i reader (addr operation-reader)
(when (= 0 (strncmp (path reader > keyword) current-char (- argument-end current-char)))
(preslog "Found keyword %s\n" (path reader > keyword))
(memset (addr new-operation) 0 (sizeof new-operation))
(set (field new-operation type) (path reader > type))
(if (path reader > num-arguments)
(scope
(set argument-index 0)
(set state read-state-reading-arguments)
(set current-operation-reader reader))
;; No arguments, push now
(dynarray-push new-operations new-operation))
(break)))
;; Always advance by words in this state
(set current-char argument-end)))
((= state read-state-reading-arguments)
(when (and (!= ' ' (deref current-char))
(!= '\n' (deref current-char))
(!= '\r' (deref current-char)))
(var argument-end (addr (const char)) null)
(each-char-in-string-const current-char end-char
(set argument-end end-char)
(when (or (= ' ' (deref end-char))
(= '\n' (deref end-char))
(= '\r' (deref end-char)))
(break)))
;; The very last character of the string needs a special case to pull it in
(unless (at 1 argument-end)
(incr argument-end))
(preslog "Argument [%d] found: " argument-index)
(fwrite current-char (sizeof char) (- argument-end current-char) stderr)
(preslog "\n")
(cond
((= argument-index 0)
(strncpy (field new-operation string-a) current-char (- argument-end current-char)))
((= argument-index 1)
(strncpy (field new-operation string-b) current-char (- argument-end current-char))))
(incr argument-index)
(when (>= argument-index (path current-operation-reader > num-arguments))
(dynarray-push new-operations new-operation)
(set state read-state-looking-for-keyword))
(set current-char argument-end)))))
(return new-operations))
(def-introspect-struct power
id (array 32 char)
;; Operations
on-create (array 2048 char)
on-update (array 2048 char)
;; Parsed at runtime, though they could be written by hand if you wanted
parsed-on-create-operations (addr operation) ('dynarray)
parsed-on-update-operations (addr operation) ('dynarray))
(forward-declare (struct animation))
(def-introspect-struct animation-data
id (array 32 char)
start-frame int
end-frame int
flip-horizontal bool
next-animation-id (array 32 char)
runtime-anim (addr animation) (ignore))
(def-introspect-struct power-system
sprites (array 16 spritesheet) ('array-allow-subset)
animations (array 16 animation-data) ('array-allow-subset)
powers (array 16 power) ('array-allow-subset))
(var s-power-system power-system (array 0))
(var s-power-system-runtime-animations (array 16 animation) (array 0))
(bundle-file s-start-power-system s-end-power-system
(const char) "data/PowerSystem.cakedata")
(defun-local power-system-initialize (&return bool)
(scope
;; TODO: Take string size rather than requiring null terminator
(var power-system-string-length int (- s-end-power-system s-start-power-system))
(var-cast-to power-system-string-null-terminated (addr char)
(malloc (+ 1 power-system-string-length)))
(defer (free power-system-string-null-terminated))
(strncpy power-system-string-null-terminated s-start-power-system power-system-string-length)
(set (at power-system-string-length power-system-string-null-terminated) 0)
(unless (read-introspect-struct-s-expr
power-system--metadata
(addr s-power-system)
power-system-string-null-terminated
malloc
null)
(preslog "Failed to read power system data\n")
(return false)))
(each-item-addr-in-array (field s-power-system powers) i current-power (addr power)
(unless (at 0 (path current-power > id))
(continue))
(set (path current-power > parsed-on-create-operations)
(parse-power-operations (path current-power > on-create)))
(set (path current-power > parsed-on-update-operations)
(parse-power-operations (path current-power > on-update))))
(each-item-addr-in-array (field s-power-system animations)
animation-index anim-data (addr animation-data)
(unless (at 0 (path anim-data > id))
(continue))
(var runtime-anim (addr animation)
(addr (at animation-index s-power-system-runtime-animations)))
(set (path runtime-anim > start-frame-index) (path anim-data > start-frame))
(set (path runtime-anim > end-frame-index) (path anim-data > end-frame))
(set (path runtime-anim > flip) (? (path anim-data > flip-horizontal)
SDL_FLIP_HORIZONTAL
SDL_FLIP_NONE))
(set (path anim-data > runtime-anim) runtime-anim))
;; Fix up references
(each-item-addr-in-array (field s-power-system animations)
animation-index anim-data (addr animation-data)
(unless (at 0 (path anim-data > id))
(continue))
(when (at 0 (path anim-data > next-animation-id))
(each-item-addr-in-array (field s-power-system animations)
other-animation-index other-anim-data (addr animation-data)
(unless (= 0 (strcmp (path anim-data > next-animation-id)
(path other-anim-data > id)))
(continue))
(set (field (at animation-index s-power-system-runtime-animations) next-animation)
(addr (at other-animation-index s-power-system-runtime-animations))))))
(return true))
(defstruct-local effect
sprite (addr spritesheet) ;; null = empty slot
anim (addr (const animation))
animation-start-ticks Uint64
life-start-ticks Uint64
num-frames-since-spawned int
power-id (addr (const char))
x int
y int
velocity-x int
velocity-y int
relative-spawn-x int
relative-spawn-y int
expire-on-animation-end bool
user-0 int)
(var s-effects (array 16 effect) (array 0))
(defstruct-local actor
x int
y int
anim (addr (const animation))
animation-start-ticks Uint64)
(var g-wizard-hero actor (array 0))
(var g-boar-enemy actor (array 0))
(defstruct-local power-context
effect-data (addr effect)
;; If 0, spawn at the wizard
start-x int
start-y int)
(defun-local update-effects (renderer (addr SDL_Renderer)
boar (addr actor))
(each-in-array s-effects i
(var current-effect (addr effect) (addr (at i s-effects)))
(unless (path current-effect > sprite)
(continue))
(unless (path current-effect > animation-start-ticks)
(set (path current-effect > animation-start-ticks) (SDL_GetPerformanceCounter)))
(unless (path current-effect > life-start-ticks)
(set (path current-effect > life-start-ticks) (SDL_GetPerformanceCounter)))
(when c-animation-frame-rate
(var lifetime-seconds float
(/ (- (SDL_GetPerformanceCounter) (path current-effect > life-start-ticks))
(type-cast (SDL_GetPerformanceFrequency) float)))
(set (path current-effect > num-frames-since-spawned) (/ lifetime-seconds c-animation-frame-rate)))
(when (path current-effect > power-id)
(preslog "Execute %s [%d] frame %d\n" (path current-effect > power-id) i
(path current-effect > num-frames-since-spawned))
(var context power-context (array 0))
(set (field context effect-data) current-effect)
(execute-power (addr context) (path current-effect > power-id) power-execute-type-update))
;; Expire after final frame
(when (or (= (path current-effect > anim) (addr anim-smoke-explosion-idle))
(path current-effect > expire-on-animation-end))
(var num-frames int (- (+ 1 (path current-effect > anim > end-frame-index)) ;; TODO: Off by one?
(path current-effect > anim > start-frame-index)))
(var loop-rate float (* c-animation-frame-rate num-frames))
(unless loop-rate
(set loop-rate c-animation-frame-rate))
(var animation-time-seconds float
(/ (- (SDL_GetPerformanceCounter) (path current-effect > animation-start-ticks))
(type-cast (SDL_GetPerformanceFrequency) float)))
(when (> animation-time-seconds loop-rate)
(set (path current-effect > sprite) null)
(continue)))
;; TODO: Frame independence
(set (path current-effect > x) (+ (path current-effect > x) (path current-effect > velocity-x)))
(set (path current-effect > y) (+ (path current-effect > y) (path current-effect > velocity-y)))
(render-animation renderer (path current-effect > sprite)
(addr (path current-effect > anim))
(path current-effect > animation-start-ticks)
c-animation-frame-rate
(path current-effect > x) (path current-effect > y))
;; Colliding power with boar
;; Don't damage boar if already smoke
(when (and (> (path current-effect > x) (path boar > x))
(!= (path current-effect > anim) (addr anim-smoke-explosion-idle)))
;; Auto convert non-powers to smoke
(when (not (path current-effect > power-id))
(set (path current-effect > sprite) spritesheet-smoke-explosion)
(set (path current-effect > velocity-x) 0)
(set (path current-effect > velocity-y) 0)
(set (path current-effect > y) (- (path current-effect > y) 75))
(set (path current-effect > anim) (addr anim-smoke-explosion-idle))
(set (path current-effect > animation-start-ticks) (SDL_GetPerformanceCounter))
(unless (= (path boar > anim) (addr anim-boar-damage))
(set (path boar > anim) (addr anim-boar-damage))
(set (path boar > animation-start-ticks) (SDL_GetPerformanceCounter)))))))
(defun-local get-free-effect (&return (addr effect))
(each-item-addr-in-array s-effects i current-effect (addr effect)
(unless (path current-effect > sprite)
(memset current-effect 0 (sizeof (type effect)))
(return current-effect)))
(return null))
(defun-local resolve-value-from-name (context (addr power-context)
name (addr (const char))
&return (addr int))
(unless (path context > effect-data)
(return null))
(defstruct name-value-pair
name (addr (const char))
value (addr int))
(var name-values (array name-value-pair)
(array
(array "positionX" (addr (path context > effect-data > x)))
(array "positionY" (addr (path context > effect-data > y)))
(array "velocityX" (addr (path context > effect-data > velocity-x)))
(array "velocityY" (addr (path context > effect-data > velocity-y)))
(array "relativeSpawnX" (addr (path context > effect-data > relative-spawn-x)))
(array "relativeSpawnY" (addr (path context > effect-data > relative-spawn-y)))
(array "lifetimeFrameCount" (addr (path context > effect-data > num-frames-since-spawned)))
(array "user0" (addr (path context > effect-data > user-0)))
(array "enemyX" (addr (field g-boar-enemy x)))
(array "enemyY" (addr (field g-boar-enemy y)))
(array "heroX" (addr (field g-wizard-hero x)))
(array "heroY" (addr (field g-wizard-hero y)))))
(each-item-addr-in-array name-values i pair (addr name-value-pair)
(unless (= 0 (strcmp (path pair > name) name))
(continue))
(return (path pair > value)))
;; (preslog "No value %s bound to context\n" name)
(return null))
;; Literals are static, i.e. don't call from multiple threads or expect to stick around
(defun-local resolve-value-or-literal-from-string (context (addr power-context)
name-or-literal (addr (const char))
&return (addr int))
(var-static literal-value int 0)
(var value-out (addr int) (resolve-value-from-name context name-or-literal))
(unless value-out
(set literal-value (strtol name-or-literal null 10))
(set value-out (addr literal-value)))
(return value-out))
(defun-local resolve-string-value-from-name (context (addr power-context)
name (addr (const char))
&return (addr (const char)))
(unless (path context > effect-data)
(return null))
(defstruct name-value-pair
name (addr (const char))
value (addr (const char)))
(var name-values (array name-value-pair)
(array
(array "currentEffect" (path context > effect-data > sprite > id))))
(each-item-addr-in-array name-values i pair (addr name-value-pair)
(unless (= 0 (strcmp (path pair > name) name))
(continue))
(return (path pair > value)))
;; (preslog "No value %s bound to context\n" name)
(return null))
(defun-local resolve-string-value-or-literal-from-string (context (addr power-context)
name-or-literal (addr (const char))
&return (addr (const char)))
(var value-out (addr (const char)) (resolve-string-value-from-name context name-or-literal))
(unless value-out
(set value-out name-or-literal))
(return value-out))
(defenum power-execute-type
power-execute-type-create
power-execute-type-update)
(forward-declare (struct effect) (struct power-context))
(var c-wizard-start-effect-x int 186)
(var c-wizard-start-effect-y int 64)
(defun find-end-index (operations (addr operation) start-index int
&return int)
(var depth int 0)
(each-in-interval start-index (dynarray-length operations) i
(var this-op (addr operation) (addr (at i operations)))
(each-in-array c-open-if-blocks if-block-open-index
(when (= (path this-op > type)
(at if-block-open-index c-open-if-blocks))
(incr depth)
(break)))
(when (= (path this-op > type) operation-type-end)
(when depth
(decr depth))
(unless depth
(return i))))
(return (- 1 (dynarray-length operations))))
(defun execute-power (context (addr power-context)
id (addr (const char))
execute-type power-execute-type)
(var power-to-execute (addr power) null)
(each-item-addr-in-array (field s-power-system powers) power-index current-power (addr power)
(unless (and (at 0 (path current-power > id))
(= 0 (strcmp (path current-power > id) id)))
(continue))
(set power-to-execute current-power)
(break))
(unless power-to-execute
(preslog "Could not find power %s to activate\n" id)
(return))
(var operations-to-run (addr operation) null)
(cond
((= execute-type power-execute-type-create)
(set operations-to-run (path power-to-execute > parsed-on-create-operations)))
((= execute-type power-execute-type-update)
(set operations-to-run (path power-to-execute > parsed-on-update-operations))))
(each-item-addr-in-dynarray operations-to-run
operation-index op (addr operation)
(cond
((= (path op > type) operation-type-spawn-power)
(var spawn-power-context power-context (array 0))
(when (path context > effect-data)
(set-fields spawn-power-context
start-x (+ (path context > effect-data > x)
(path context > effect-data > relative-spawn-x))
start-y (+ (path context > effect-data > y)
(path context > effect-data > relative-spawn-y))))
(execute-power (addr spawn-power-context) (path op > string-a)
power-execute-type-create))
((= (path op > type) operation-type-play-effect)
(var new-effect (addr effect) (? (path context > effect-data)
(path context > effect-data)
(get-free-effect)))
(unless new-effect
(preslog "No more effect slots\n")
(return))
(preslog "Create effect %s with animation %s\n" (path op > string-a) (path op > string-b))
(each-item-addr-in-array (field s-power-system sprites)
sprite-index sprite (addr spritesheet)
(unless (= 0 (strcmp (path sprite > id) (path op > string-a)))
(continue))
(set (path new-effect > sprite) sprite)
(break))
(each-item-addr-in-array (field s-power-system animations)
animation-index anim-data (addr animation-data)
(unless (= 0 (strcmp (path anim-data > id) (path op > string-b)))
(continue))
(set (path new-effect > anim) (path anim-data > runtime-anim))
(break))
(if (and (path new-effect > anim)
(path new-effect > sprite))
(scope
(cond
((or (path context > start-x)
(path context > start-y))
(set (path new-effect > x) (path context > start-x))
(set (path new-effect > y) (path context > start-y)))
((path context > effect-data)
(set (path new-effect > x) (path context > effect-data > x))
(set (path new-effect > y) (path context > effect-data > y)))
(true
(set (path new-effect > x) (+ c-wizard-start-effect-x (field g-wizard-hero x)))
(set (path new-effect > y) (+ c-wizard-start-effect-y (field g-wizard-hero y)))))
(set (path context > effect-data) new-effect)
(set (path new-effect > animation-start-ticks) (SDL_GetPerformanceCounter))
(set (path new-effect > life-start-ticks) (SDL_GetPerformanceCounter))
(set (path new-effect > power-id) (path power-to-execute > id)))
(scope
(set (path new-effect > sprite) null)
(preslog "Could not create effect: missing sprite or animation\n"))))
((= (path op > type) operation-type-expire-on-animation-end)
(when (path context > effect-data)
(set (path context > effect-data > expire-on-animation-end) true)))
((= (path op > type) operation-type-damage)
(set (field g-boar-enemy anim) (addr anim-boar-damage))
(set (field g-boar-enemy animation-start-ticks) (SDL_GetPerformanceCounter)))
((= (path op > type) operation-type-set-value)
(var value-out (addr int) (resolve-value-from-name
context (path op > string-a)))
(var set-value-to (addr int) (resolve-value-or-literal-from-string
context (path op > string-b)))
(if (and value-out set-value-to)
;; (preslog "Setting %s to %s\n" (path op > string-a) (path op > string-b))
(set (deref value-out) (deref set-value-to))
(preslog "Failed to set %s to %s (not bound)\n" (path op > string-a) (path op > string-b))))
((= (path op > type) operation-type-add-to-value)
(var value-out (addr int) (resolve-value-from-name
context (path op > string-a)))
(var add-value (addr int) (resolve-value-or-literal-from-string
context (path op > string-b)))
(if (and value-out add-value)
;; (preslog "Setting %s to %s\n" (path op > string-a) (path op > string-b))
(set (deref value-out) (+ (deref value-out) (deref add-value)))
(preslog "Failed to add to %s %s (not bound)\n" (path op > string-a) (path op > string-b))))
((= (path op > type) operation-type-if-equals)
(var value-a (addr int) (resolve-value-or-literal-from-string
context (path op > string-a)))
(var value-b (addr int) (resolve-value-or-literal-from-string
context (path op > string-b)))
(when (and value-a value-b)
(unless (= (deref value-a) (deref value-b))
(set operation-index (find-end-index operations-to-run operation-index)))))
((= (path op > type) operation-type-if-string-equals)
(var value-a (addr (const char)) (resolve-string-value-or-literal-from-string
context (path op > string-a)))
(var value-b (addr (const char)) (resolve-string-value-or-literal-from-string
context (path op > string-b)))
(when (and value-a value-b)
(unless (= 0 (strcmp value-a value-b))
(set operation-index (find-end-index operations-to-run operation-index)))))
((= (path op > type) operation-type-if-greater-than-or-equal)
(var value-a (addr int) (resolve-value-or-literal-from-string
context (path op > string-a)))
(var value-b (addr int) (resolve-value-or-literal-from-string
context (path op > string-b)))
(when (and value-a value-b)
(unless (>= (deref value-a) (deref value-b))
(set operation-index (find-end-index operations-to-run operation-index))))))))
;;
;; Main
;;
(defenum effect-id
effect-id-none
effect-id-fireball
effect-id-power-0)
(comptime-cond
('Windows
(c-import "<windows.h>")
(add-static-link-objects "User32.lib")))
(defun main (&return int)
(comptime-cond
('Windows
(SetProcessDpiAwarenessContext DPI_AWARENESS_CONTEXT_SYSTEM_AWARE)))
(data-bundle-load-all-resources)
(SDL_GL_SetAttribute SDL_GL_CONTEXT_MAJOR_VERSION 4)
(SDL_GL_SetAttribute SDL_GL_CONTEXT_MINOR_VERSION 6)
(SDL_SetHint SDL_HINT_RENDER_VSYNC "1")
(var window (addr SDL_Window) null)
(unless (sdl-initialize-for-2d (addr window) "Presentation" 1920 1080)
(preslog "Failed to initialize SDL\n")
(return 1))
(defer (sdl-shutdown window))
;; -1 = pick driver that is compatible with what we want
(var renderer (addr SDL_Renderer) (SDL_CreateRenderer window -1 SDL_RENDERER_ACCELERATED))
(unless renderer
(sdl-print-error)
(return 1))
(defer (SDL_DestroyRenderer renderer))
;;
;; Fonts
;;
(var device-dpi (unsigned char) 144)
;; 1 point = 1/72". Accurate if device-dpi is properly set
(defstruct font-atlas-texture
atlas font-atlas
texture (addr SDL_Texture)
;; Only needed before it is built
start-file-data (addr (unsigned char))
end-file-data (addr (unsigned char))
font-size-points (unsigned char))
(var font-atlases (array font-atlas-texture)
(array
(array ;; Heading font, 1080p
(array 0) null
s-start-ubuntu-regular-font s-end-ubuntu-regular-font
38)
(array ;; Body font, 1080p
(array 0) null
s-start-ubuntu-regular-font s-end-ubuntu-regular-font
20)
(array ;; Body code font, 1080p
(array 0) null
s-start-ubuntu-mono-font s-end-ubuntu-mono-font
20)
(array ;; Heading font, 4k
(array 0) null
s-start-ubuntu-regular-font s-end-ubuntu-regular-font
58)
(array ;; Body font, 4k
(array 0) null
s-start-ubuntu-regular-font s-end-ubuntu-regular-font
34)
(array ;; Body code font, 4k
(array 0) null
s-start-ubuntu-mono-font s-end-ubuntu-mono-font
34)))
(var heading-font-index-1080p (const int) 0)
(var body-font-index-1080p (const int) 1)
(var body-code-font-index-1080p (const int) 2)
(var heading-font-index-4k (const int) 3)
(var body-font-index-4k (const int) 4)
(var body-code-font-index-4k (const int) 5)
(var heading-font-index int heading-font-index-1080p)
(var body-font-index int body-font-index-1080p)
(var body-code-font-index int body-code-font-index-1080p)
(defer
(each-item-addr-in-array font-atlases i font (addr font-atlas-texture)
(free-font-atlas (addr (path font > atlas)))
(when (path font > texture)
(SDL_DestroyTexture (path font > texture)))))
(each-item-addr-in-array font-atlases i font (addr font-atlas-texture)
(unless (make-font-atlas-and-texture renderer
(addr (path font > atlas))
(addr (path font > texture))
(path font > start-file-data)
(- (path font > end-file-data) (path font > start-file-data))
device-dpi
(path font > font-size-points))
(return 1)))
(unless (power-system-initialize)
(return 1))
(defer (free-introspect-struct-fields power-system--metadata (addr s-power-system) free))
(defstruct spritesheets-to-prepare
id (addr (const char))
sprite (addr (addr spritesheet))
start-data (addr (unsigned char))
end-data (addr (unsigned char)))
(var prepare-spritesheets (array spritesheets-to-prepare)
(array
(array "wizard" (addr spritesheet-wizard)
s-start-wizard-spritesheet s-end-wizard-spritesheet)
(array "boar" (addr spritesheet-boar)
s-start-boar-spritesheet s-end-boar-spritesheet)
(array "fireball" (addr spritesheet-fireball)
s-start-fireball-spritesheet s-end-fireball-spritesheet)
(array "smoke-explosion" (addr spritesheet-smoke-explosion)
s-start-smoke-explosion-spritesheet s-end-smoke-explosion-spritesheet)
(array "explosion" (addr spritesheet-explosion)
s-start-explosion-spritesheet s-end-explosion-spritesheet)
(array "ice-explosion" (addr spritesheet-ice-explosion)
s-start-ice-explosion-spritesheet s-end-ice-explosion-spritesheet)
(array "rocks" (addr spritesheet-rocks)
s-start-rocks-spritesheet s-end-rocks-spritesheet)))
(each-item-addr-in-array prepare-spritesheets i sheet (addr spritesheets-to-prepare)
;; Associate sheets with sprites from power system
(each-item-addr-in-array (field s-power-system sprites) i sprite (addr spritesheet)
(when (= 0 (strcmp (path sheet > id) (path sprite > id)))
(set (deref (path sheet > sprite)) sprite)))
(unless (deref (path sheet > sprite))
(preslog "Spritesheet data for %s missing in power system\n" (path sheet > id))
(return 1))
(var texture (addr SDL_Texture)
(sdl-texture-from-bmp-data renderer (path sheet > start-data) (path sheet > end-data)))
(unless texture
(return 1))
(set (path (deref (path sheet > sprite)) > texture) texture))
(defer
(each-item-addr-in-array prepare-spritesheets i sheet (addr spritesheets-to-prepare)
(SDL_DestroyTexture (path (deref (path sheet > sprite)) > texture))))
(var ground-texture (addr SDL_Texture)
(sdl-texture-from-bmp-data renderer s-start-ground-bmp s-end-ground-bmp))
(unless ground-texture
(return 1))
(defer (SDL_DestroyTexture ground-texture))
;; current-key-states is owned by SDL, but we own last-frame-states
(defer (dynarray-free (field s-key-states last-frame-states)))
(var presentation presentation-data (array 0))
(scope
;; TODO: Take string size rather than requiring null terminator
(var presentation-string-length int (- s-end-presentation s-start-presentation))
(var-cast-to presentation-string-null-terminated (addr char)
(malloc (+ 1 presentation-string-length)))
(defer (free presentation-string-null-terminated))
(strncpy presentation-string-null-terminated s-start-presentation presentation-string-length)
(set (at presentation-string-length presentation-string-null-terminated) 0)
(unless (read-introspect-struct-s-expr
presentation-data--metadata
(addr presentation)
presentation-string-null-terminated
malloc
null)
(preslog "Failed to read presentation data\n")
(return 1)))
(defer (free-introspect-struct-fields presentation-data--metadata (addr presentation) free))
(var current-slide-index int 0)
(var slide-start-ticks Uint64 0)
(var ground-width int 1359)
(var ground-height int 450)
;; (var wizard-height int 106) ;; Unused
;; (var boar-height int 178)
(var wizard-ground-height int 80)
(var boar-ground-height int 220)
(set (field g-wizard-hero anim) (addr anim-wizard-jump-in))
(set (field g-boar-enemy anim) (addr anim-boar-jump-in))
(var should-render-wizard bool false)
(var should-render-boar bool false)
(var should-render-ground bool false)
(var queued-effect effect-id effect-id-none)
(var queued-power-id (addr (const char)) null)
(var sequential-cycle-index int 0)
(var power-cycle-id (addr (const char)) null)
(var c-cycle-rate-ticks Uint64 (* 4 (SDL_GetPerformanceFrequency)))
(var last-power-cycle-ticks Uint64 0)
(var enable-fullscreen bool false)
(var upscale-to-4k bool false)
(var exit-reason (addr (const char)) null)
(while true
(var event SDL_Event)
(while (SDL_PollEvent (addr event))
(when (= (field event type) SDL_QUIT)
(set exit-reason "Window event")))
(var num-keys int 0)
(set (field s-key-states this-frame-states) (SDL_GetKeyboardState (addr num-keys)))
(when (keybind-tapped (addr s-quit-keybind) (addr s-key-states))
(set exit-reason "Quit keybind pressed"))
(when (keybind-tapped (addr s-toggle-fullscreen-keybind) (addr s-key-states))
(set enable-fullscreen (not enable-fullscreen))
(if enable-fullscreen
(SDL_SetWindowFullscreen window SDL_WINDOW_FULLSCREEN_DESKTOP)
(SDL_SetWindowFullscreen window 0)))
;; Slide motion
(var start-frame-slide-index int current-slide-index)
(when (keybind-tapped (addr s-next-slide-keybind) (addr s-key-states))
(set slide-start-ticks (SDL_GetPerformanceCounter))
(incr current-slide-index)
(unless (at 0 (field (at current-slide-index (field presentation slides)) heading))
(set current-slide-index (- current-slide-index 1))))
(when (keybind-tapped (addr s-previous-slide-keybind) (addr s-key-states))
(set slide-start-ticks (SDL_GetPerformanceCounter))
(decr current-slide-index)
(when (< current-slide-index 0)
(set current-slide-index 0)))
;; Slide changed; handle triggers
(when (!= start-frame-slide-index current-slide-index)
(var current-slide (addr slide-data)
(addr (at current-slide-index (field presentation slides))))
(when (at 0 (path current-slide > trigger))
(cond
((= 0 (strcmp (path current-slide > trigger) "enter-wizard"))
(set-fields g-wizard-hero
animation-start-ticks (SDL_GetPerformanceCounter)
anim (addr anim-wizard-jump-in))
(set should-render-wizard true))
((= 0 (strcmp (path current-slide > trigger) "enter-boar"))
(set-fields g-boar-enemy
animation-start-ticks (SDL_GetPerformanceCounter)
anim (addr anim-boar-jump-in))
(set should-render-boar true))
((= 0 (strcmp (path current-slide > trigger) "show-ground"))
(set should-render-ground true))
(true
(preslog "Unrecognized trigger: %s" (path current-slide > trigger))))))
(var slide (addr slide-data) (addr (at current-slide-index (field presentation slides))))
;; Debug keys
(when (keybind-tapped (addr s-toggle-debug-overlay-keybind) (addr s-key-states))
(set s-enable-debug-overlay (not s-enable-debug-overlay)))
(var true-window-width int 0)
(var true-window-height int 0)
(SDL_GetWindowSize window (addr true-window-width) (addr true-window-height))
(if (> true-window-height 1440)
(scope
(unless upscale-to-4k
(preslog "Now upscaling 2x\n"))
(set heading-font-index heading-font-index-4k)
(set body-font-index body-font-index-4k)
(set body-code-font-index body-code-font-index-4k)
(set upscale-to-4k true))
(scope
(when upscale-to-4k
(preslog "No longer upscaling\n"))
(set heading-font-index heading-font-index-1080p)
(set body-font-index body-font-index-1080p)
(set body-code-font-index body-code-font-index-1080p)
(set upscale-to-4k false)))
(var virtual-window-width int true-window-width)
(var virtual-window-height int true-window-height)
;; We always master to 1080p in "game space". Text is all true window relative
(when upscale-to-4k
(set virtual-window-width 1920)
(set virtual-window-height 1080))
(set-fields g-wizard-hero
x (type-cast (* virtual-window-width 0.08f) int)
y (- virtual-window-height (/ ground-height 2) wizard-ground-height))
(when (and
(!= (field g-wizard-hero anim) (addr anim-wizard-attack))
(keybind-tapped (addr s-attack-keybind) (addr s-key-states)))
(set-fields g-wizard-hero
animation-start-ticks (SDL_GetPerformanceCounter)
anim (addr anim-wizard-attack))
(set queued-effect effect-id-fireball))
(var power-cycle-index int
(? (= 0 (strcmp (path slide > trigger) "power-cycle-display"))
sequential-cycle-index
(mod (rand) (array-size s-power-keybinds))))
(each-item-addr-in-array s-power-keybinds i power-key (addr power-keybind)
(when (and
(!= (field g-wizard-hero anim) (addr anim-wizard-attack))
(or (keybind-tapped (path power-key > bind) (addr s-key-states))
(and (or (= 0 (strcmp (path slide > trigger) "power-cycle-display"))
(= 0 (strcmp (path slide > trigger) "random-power-cycle")))
(= i power-cycle-index)
(>= (- (SDL_GetPerformanceCounter) last-power-cycle-ticks) c-cycle-rate-ticks))))
(set last-power-cycle-ticks (SDL_GetPerformanceCounter))
(set power-cycle-id (path power-key > power-id))
(incr sequential-cycle-index)
(when (>= sequential-cycle-index (array-size s-power-keybinds))
(set sequential-cycle-index 0))
(set-fields g-wizard-hero
animation-start-ticks (SDL_GetPerformanceCounter)
anim (addr anim-wizard-attack))
(set queued-power-id (path power-key > power-id))))
(when (and (= (field g-wizard-hero anim) (addr anim-wizard-attack))
(or (!= queued-effect effect-id-none)
queued-power-id))
(var current-frame int 0)
(var current-anim (addr (const animation)) (field g-wizard-hero anim))
(when (or (not (animation-get-current-frame current-anim
(field g-wizard-hero animation-start-ticks) c-animation-frame-rate
(addr current-frame)))
(= current-frame wizard-attack-effect-frame))
(cond
((= queued-effect effect-id-fireball)
(var new-effect (addr effect) (get-free-effect))
(set (path new-effect > sprite) spritesheet-fireball)
(set (path new-effect > anim) (addr anim-fireball-idle))
(var mouse-x int 0)
(var mouse-y int 0)
(SDL_GetMouseState (addr mouse-x) (addr mouse-y))
(if (and mouse-x mouse-y s-enable-debug-overlay)
(scope
(set (path new-effect > x) mouse-x)
(set (path new-effect > y) mouse-y))
(scope
(set (path new-effect > x) (+ c-wizard-start-effect-x (field g-wizard-hero x)))
(set (path new-effect > y) (+ c-wizard-start-effect-y (field g-wizard-hero y)))))
(set (path new-effect > velocity-x) 25))
(queued-power-id
(var context power-context (array 0))
(execute-power (addr context) queued-power-id power-execute-type-create)))
(set queued-effect effect-id-none)
(set queued-power-id null)))
(SDL_SetRenderDrawColor renderer 11 19 40 255)
(SDL_RenderClear renderer)
(when s-draw-atlases
(defstruct atlas-set
atlas (addr font-atlas)
texture (addr SDL_Texture))
(var atlases-to-draw (array atlas-set)
(array (array (addr (field (at heading-font-index font-atlases) atlas))
(field (at heading-font-index font-atlases) texture))
(array (addr (field (at body-code-font-index font-atlases) atlas))
(field (at body-code-font-index font-atlases) texture))))
(each-in-array atlases-to-draw i
(var source-rectangle SDL_Rect
(array 0 0
(path (at i atlases-to-draw) . atlas > width)
(path (at i atlases-to-draw) . atlas > height)))
(var destination-rectangle SDL_Rect
(array (* (+ 50 (path (at i atlases-to-draw) . atlas > width)) i) 0
(path (at i atlases-to-draw) . atlas > width)
(path (at i atlases-to-draw) . atlas > height)))
(unless (= 0 (SDL_RenderCopy renderer (path (at i atlases-to-draw) . texture)
(addr source-rectangle) (addr destination-rectangle)))
(sdl-print-error)
(set exit-reason "SDL failed to render font atlas"))))
(var slide-time-seconds float (/ (- (SDL_GetPerformanceCounter) slide-start-ticks)
(type-cast (SDL_GetPerformanceFrequency) float)))
(when should-render-ground
(when upscale-to-4k
(SDL_RenderSetScale renderer 2.f 2.f))
(defer (SDL_RenderSetScale renderer 1.f 1.f))
(var source-rectangle SDL_Rect
(array 0 0
ground-width
ground-height))
(var destination-rectangle SDL_Rect
(array 0 (- virtual-window-height ground-height)
virtual-window-width
ground-height))
(unless (= 0 (SDL_RenderCopy renderer ground-texture
(addr source-rectangle) (addr destination-rectangle)))
(sdl-print-error)
(set exit-reason "SDL failed to render ground")))
(render-string
renderer (addr (field (at heading-font-index font-atlases) atlas))
(field (at heading-font-index font-atlases) texture)
(/ true-window-width 4.5f) (/ true-window-height 8)
(path slide > heading))
(if (path slide > is-code)
(scope
(if (= 0 (strcmp (path slide > trigger) "power-cycle-display"))
(scope
(var power-update-str (addr (const char)) null)
(each-item-addr-in-array (field s-power-system powers) power-index current-power (addr power)
(unless (= 0 (strcmp (path current-power > id) power-cycle-id))
(continue))
(set power-update-str (path current-power > on-update))
(break))
(render-string
renderer (addr (field (at body-code-font-index font-atlases) atlas))
(field (at body-code-font-index font-atlases) texture)
(/ true-window-width 4) (/ true-window-height 4)
power-update-str))
(render-string
renderer (addr (field (at body-code-font-index font-atlases) atlas))
(field (at body-code-font-index font-atlases) texture)
(/ true-window-width 4) (/ true-window-height 4)
(path slide > body))))
(render-string
renderer (addr (field (at body-font-index font-atlases) atlas))
(field (at body-font-index font-atlases) texture)
(/ true-window-width 4) (/ true-window-height 4)
(path slide > body)))
(scope
(when upscale-to-4k
(SDL_RenderSetScale renderer 2.f 2.f))
(defer (SDL_RenderSetScale renderer 1.f 1.f))
(when should-render-wizard
(unless (field g-wizard-hero animation-start-ticks)
(set (field g-wizard-hero animation-start-ticks) (SDL_GetPerformanceCounter)))
(render-animation
renderer spritesheet-wizard (addr (field g-wizard-hero anim))
(field g-wizard-hero animation-start-ticks) c-animation-frame-rate
(field g-wizard-hero x) (field g-wizard-hero y)))
(set-fields g-boar-enemy
x (type-cast (* virtual-window-width 0.70f) int)
y (- virtual-window-height (/ ground-height 2) boar-ground-height))
(when should-render-boar
(unless (field g-boar-enemy animation-start-ticks)
(set (field g-boar-enemy animation-start-ticks) (SDL_GetPerformanceCounter)))
(render-animation
renderer spritesheet-boar (addr (field g-boar-enemy anim))
(field g-boar-enemy animation-start-ticks) c-animation-frame-rate
(field g-boar-enemy x)
(field g-boar-enemy y)))
(update-effects renderer (addr g-boar-enemy)))
(when s-enable-debug-overlay
(var buffer (array 256 char) (array 0))
(var mouse-x int 0)
(var mouse-y int 0)
(SDL_GetMouseState (addr mouse-x) (addr mouse-y))
(snprintf buffer (- (array-size buffer) 1) "Mouse: %4d %4d Percent of window: %.2f %.2f Wizard relative: %4d %4d"
mouse-x mouse-y
(/ mouse-x (type-cast true-window-width float)) (/ mouse-y (type-cast true-window-height float))
(- mouse-x (field g-wizard-hero x)) (- mouse-y (field g-wizard-hero y)))
(render-string
renderer (addr (field (at body-code-font-index font-atlases) atlas))
(field (at body-code-font-index font-atlases) texture)
10 (- true-window-height 20)
buffer))
;; #"#
;; result= FT_Set_Char_Size(typeface, 0, (16 * 64), 300, 300);
;; if (!((result== FT_Err_Ok)))
;; {
;; fprintf(stderr, "error: encountered error %d while %s\n", result, "setting character size");
;; FT_Done_Face(typeface);
;; FT_Done_FreeType(freetypeLibrary);
;; return 1;
;; }#"#)
(SDL_RenderPresent renderer)
(SDL_UpdateWindowSurface window)
(dynarray-set-length (field s-key-states last-frame-states) num-keys)
(memcpy (field s-key-states last-frame-states) (field s-key-states this-frame-states) num-keys)
(when exit-reason
(break)))
(when exit-reason
(preslog "Exited reason: %s\n" exit-reason))
(return 0))
(comptime-cond
('Windows
(add-c-build-dependency "PresentationWinMain.cpp")
(set-cakelisp-option executable-output "Presentation.exe"))
(true
(set-cakelisp-option executable-output "presentation")))