Browse Source

Update for Cakelisp type changes, macros

master
Macoy Madson 5 months ago
parent
commit
f344c620c2
  1. 2
      Dependencies/cakelisp
  2. 2
      Dependencies/gamelib
  3. 36
      src/FontAtlas.cake
  4. 324
      src/Presentation.cake

2
Dependencies/cakelisp

@ -1 +1 @@
Subproject commit 1e57e84ce6a925336a9355fa56975565e11e2322
Subproject commit 4e0dcb1b99c1caee5248424bc5f824d5686de3d8

2
Dependencies/gamelib

@ -1 +1 @@
Subproject commit 0aa40a6cb5ad84be9153bbdade3837564c3e1de9
Subproject commit 90abbc4fe00e31e59a2155236e20ddf01984c3d3

36
src/FontAtlas.cake

@ -24,16 +24,16 @@
y int16_t)
(defstruct font-atlas
glyph-lookup-table (* glyph-entry) ;; dictionary
kerning-lookup-table (* kerning-entry) ;; dictionary
pixel-buffer (* (unsigned char)) ;; malloc'd
glyph-lookup-table (addr glyph-entry) ;; dictionary
kerning-lookup-table (addr kerning-entry) ;; dictionary
pixel-buffer (addr (unsigned char)) ;; malloc'd
width uint16_t
height uint16_t
;; Default line spacing (baseline-to-baseline
font-height uint16_t)
(defun free-font-atlas (font-atlas-to-free (* font-atlas))
(defun free-font-atlas (font-atlas-to-free (addr font-atlas))
(dict-free (path font-atlas-to-free > glyph-lookup-table))
(dict-free (path font-atlas-to-free > kerning-lookup-table))
(free (path font-atlas-to-free > pixel-buffer)))
@ -41,15 +41,15 @@
(defun font-atlas-make-character-pair (character-a char
character-b char
&return uint16_t)
(return (bit-or (bit-<< character-a 8) character-b)))
(return (bit-or (bit-shift-<< character-a 8) character-b)))
;; Returns 0 for success or anything else for failure
(defun build-font-atlas (font-face (* (const (unsigned char)))
(defun build-font-atlas (font-face (addr (const (unsigned char)))
font-face-size (unsigned int)
device-dpi (unsigned int)
character-height-points (unsigned char)
enable-subpixel-antialiasing bool
font-atlas-out (* font-atlas) &return int)
font-atlas-out (addr font-atlas) &return int)
(var freetype-library FT_Library)
(var result int
(FT_Init_FreeType (addr freetype-library)))
@ -78,7 +78,7 @@
start-character char
end-character-inclusive char)
;; This is a bit silly
(var ranges-to-render ([] ascii-glyph-range)
(var ranges-to-render (array ascii-glyph-range)
(array (array 'a' 'z') (array 'A' 'Z') (array '0' '9') (array ' ' '/') (array ':' '@')
(array '[' '`') (array '{' '~')))
@ -88,17 +88,17 @@
(var pixel-buffer-size (unsigned int) (* atlas-width atlas-height num-components-per-pixel))
(set (path font-atlas-out > pixel-buffer)
(type-cast (malloc pixel-buffer-size)
(* (unsigned char))))
(addr (unsigned char))))
(memset (path font-atlas-out > pixel-buffer) 0 pixel-buffer-size)
(set (path font-atlas-out > width) atlas-width)
(set (path font-atlas-out > height) atlas-height)
(set (path font-atlas-out > font-height) (bit->> (path typeface > size > metrics . height) 6))
(set (path font-atlas-out > font-height) (bit-shift->> (path typeface > size > metrics . height) 6))
(var atlas-write-x uint16_t 0)
(var atlas-write-y uint16_t 0)
(var atlas-tallest-character-this-row uint16_t 0)
(each-in-array ranges-to-render range-index
(var range (* ascii-glyph-range) (addr (at range-index ranges-to-render)))
(var range (addr ascii-glyph-range) (addr (at range-index ranges-to-render)))
(each-in-range (- (+ 1 (path range > end-character-inclusive)) (path range > start-character))
character-offset-from-start
(var character char (+ character-offset-from-start (path range > start-character)))
@ -142,18 +142,18 @@
(set (field new-glyph-entry height) num-rows)
(set (field new-glyph-entry to-origin-left) (path typeface > glyph > bitmap_left))
(set (field new-glyph-entry to-origin-top) (path typeface > glyph > bitmap_top))
(set (field new-glyph-entry advance-x) (bit->> (path typeface > glyph > advance . x) 6))
(set (field new-glyph-entry advance-x) (bit-shift->> (path typeface > glyph > advance . x) 6))
(dict-set-struct (path font-atlas-out > glyph-lookup-table) new-glyph-entry)
;; TODO: This can become a memcpy if we can get FreeType to render to our same format
(each-in-range num-rows row
(each-in-range num-columns column
(var current-pixel (* (unsigned char))
(var current-pixel (addr (unsigned char))
(addr
(at (+ (* num-components-per-freetype-pixel column)
(* row (path typeface > glyph > bitmap . pitch)))
(path typeface > glyph > bitmap . buffer))))
(var current-pixel-out (* (unsigned char))
(var current-pixel-out (addr (unsigned char))
(addr
(at (* num-components-per-pixel
(+ (+ column atlas-write-x) (* (+ atlas-write-y row) atlas-width)))
@ -178,7 +178,7 @@
;; Build kerning lookup table
(each-in-array ranges-to-render range-index-a
(var range-a (* ascii-glyph-range) (addr (at range-index-a ranges-to-render)))
(var range-a (addr ascii-glyph-range) (addr (at range-index-a ranges-to-render)))
(each-in-range (- (+ 1 (path range-a > end-character-inclusive)) (path range-a > start-character))
character-offset-from-start
(var character-a char (+ character-offset-from-start (path range-a > start-character)))
@ -187,7 +187,7 @@
(continue))
(each-in-array ranges-to-render range-index-b
(var range-b (* ascii-glyph-range) (addr (at range-index-b ranges-to-render)))
(var range-b (addr ascii-glyph-range) (addr (at range-index-b ranges-to-render)))
(each-in-range (- (+ 1 (path range-b > end-character-inclusive)) (path range-b > start-character))
character-offset-from-start
(var character-b char (+ character-offset-from-start (path range-b > start-character)))
@ -205,8 +205,8 @@
(var character-pair uint16_t (font-atlas-make-character-pair
character-a character-b))
(set (field new-kerning-entry key) character-pair)
(set (field new-kerning-entry x) (bit->> (field kerning x) 6))
(set (field new-kerning-entry y) (bit->> (field kerning y) 6))
(set (field new-kerning-entry x) (bit-shift->> (field kerning x) 6))
(set (field new-kerning-entry y) (bit-shift->> (field kerning y) 6))
(dict-set-struct (path font-atlas-out > kerning-lookup-table)
new-kerning-entry))))))

324
src/Presentation.cake

@ -47,9 +47,9 @@
(define-keybind s-attack-5-keybind (array SDL_SCANCODE_5))
(defstruct-local power-keybind
bind (* keybind)
power-id (* (const char)))
(var s-power-keybinds ([] 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")
@ -73,14 +73,14 @@
;;
(def-introspect-struct slide-data
heading ([] 256 char)
body ([] 1024 char)
heading (array 256 char)
body (array 1024 char)
;; Set body font to monospace
is-code bool
trigger ([] 64 char))
trigger (array 64 char))
(def-introspect-struct presentation-data
slides ([] 256 slide-data) ('array-allow-subset))
slides (array 256 slide-data) ('array-allow-subset))
(bundle-file s-start-presentation s-end-presentation
(const char) "data/DrivingCodeWithData.cakedata")
@ -116,8 +116,8 @@
(forward-declare (struct SDL_Texture))
(def-introspect-struct spritesheet
id ([] 64 char)
texture (* SDL_Texture) (ignore)
id (array 64 char)
texture (addr SDL_Texture) (ignore)
width int
height int
frame-width int
@ -128,9 +128,9 @@
start-frame-index (unsigned char)
end-frame-index (unsigned char)
flip SDL_RendererFlip
next-animation (* animation))
next-animation (addr animation))
(var spritesheet-wizard (* spritesheet) null) ;; Populated from data
(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)))
@ -144,7 +144,7 @@
;; (var wizard-attack-effect-frame int 10)
(var wizard-attack-effect-frame int 28)
(var spritesheet-boar (* spritesheet) null) ;; Populated from data
(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
@ -152,26 +152,26 @@
(var anim-boar-damage animation (array (+ (* 3 6) 3) (+ (* 3 6) 5) SDL_FLIP_HORIZONTAL
(addr anim-boar-idle)))
(var spritesheet-fireball (* spritesheet) null) ;; Populated from data
(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 (* spritesheet) null) ;; Populated from data
(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 (* spritesheet) null) ;; Populated from data
(var spritesheet-ice-explosion (* spritesheet) null) ;; Populated from data
(var spritesheet-rocks (* spritesheet) null) ;; Populated from data
(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 (* (const animation))
anim (addr (const animation))
animation-start-ticks Uint64
frame-rate float
;; Not valid if the next animation should be played
frame-index-out (* int)
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)))
@ -193,10 +193,10 @@
(set (deref frame-index-out) (+ current-frame (path anim > start-frame-index)))
(return true))
(defun-local render-animation (renderer (* SDL_Renderer)
sprite (* spritesheet)
(defun-local render-animation (renderer (addr SDL_Renderer)
sprite (addr spritesheet)
;; This can be modified if there is a (anim > next-animation)
anim (* (* (const animation)))
anim (addr (addr (const animation)))
animation-start-ticks Uint64
frame-rate float
x int y int)
@ -245,25 +245,25 @@
operation-type-if-greater-than-or-equal
operation-type-end)
(var c-open-if-blocks ([] operation-type)
(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 ([] 32 char)
string-b ([] 32 char))
string-a (array 32 char)
string-b (array 32 char))
(defun-local parse-power-operations (operations (* (const char))
&return (* operation)) ;; dynarray
(var new-operations (* operation) null)
(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 (* (const char))
keyword (addr (const char))
num-arguments char)
(var readers ([] operation-reader)
(var readers (array operation-reader)
(array
(array
operation-type-play-effect
@ -302,7 +302,7 @@
(var state read-state read-state-looking-for-keyword)
(var new-operation operation)
(var current-operation-reader (* operation-reader) null)
(var current-operation-reader (addr operation-reader) null)
(var argument-index int 0)
(each-char-in-string-const operations current-char
(cond
@ -310,7 +310,7 @@
(when (and (!= ' ' (deref current-char))
(!= '\n' (deref current-char))
(!= '\r' (deref current-char)))
(var argument-end (* (const char)) null)
(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))
@ -320,7 +320,7 @@
;; 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 (* operation-reader)
(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))
@ -339,7 +339,7 @@
(when (and (!= ' ' (deref current-char))
(!= '\n' (deref current-char))
(!= '\r' (deref current-char)))
(var argument-end (* (const char)) null)
(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))
@ -365,37 +365,37 @@
(return new-operations))
(def-introspect-struct power
id ([] 32 char)
id (array 32 char)
;; Operations
on-create ([] 2048 char)
on-update ([] 2048 char)
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 (* operation) ('dynarray)
parsed-on-update-operations (* operation) ('dynarray))
parsed-on-create-operations (addr operation) ('dynarray)
parsed-on-update-operations (addr operation) ('dynarray))
(forward-declare (struct animation))
(def-introspect-struct animation-data
id ([] 32 char)
id (array 32 char)
start-frame int
end-frame int
flip-horizontal bool
next-animation-id ([] 32 char)
next-animation-id (array 32 char)
runtime-anim (* animation) (ignore))
runtime-anim (addr animation) (ignore))
(def-introspect-struct power-system
sprites ([] 16 spritesheet) ('array-allow-subset)
animations ([] 16 animation-data) ('array-allow-subset)
powers ([] 16 power) ('array-allow-subset))
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 ([] 16 animation) (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")
@ -404,7 +404,7 @@
(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 (* char)
(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)
@ -418,7 +418,7 @@
(preslog "Failed to read power system data\n")
(return false)))
(each-item-addr-in-array (field s-power-system powers) i current-power (* power)
(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)
@ -427,10 +427,10 @@
(parse-power-operations (path current-power > on-update))))
(each-item-addr-in-array (field s-power-system animations)
animation-index anim-data (* animation-data)
animation-index anim-data (addr animation-data)
(unless (at 0 (path anim-data > id))
(continue))
(var runtime-anim (* animation)
(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))
@ -440,12 +440,12 @@
(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 (* animation-data)
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 (* animation-data)
other-animation-index other-anim-data (addr animation-data)
(unless (= 0 (strcmp (path anim-data > next-animation-id)
(path other-anim-data > id)))
(continue))
@ -454,12 +454,12 @@
(return true))
(defstruct-local effect
sprite (* spritesheet) ;; null = empty slot
anim (* (const animation))
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 (* (const char))
power-id (addr (const char))
x int
y int
velocity-x int
@ -469,27 +469,27 @@
expire-on-animation-end bool
user-0 int)
(var s-effects ([] 16 effect) (array 0))
(var s-effects (array 16 effect) (array 0))
(defstruct-local actor
x int
y int
anim (* (const animation))
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 (* effect)
effect-data (addr effect)
;; If 0, spawn at the wizard
start-x int
start-y int)
(defun-local update-effects (renderer (* SDL_Renderer)
boar (* actor))
(defun-local update-effects (renderer (addr SDL_Renderer)
boar (addr actor))
(each-in-array s-effects i
(var current-effect (* effect) (addr (at i s-effects)))
(var current-effect (addr effect) (addr (at i s-effects)))
(unless (path current-effect > sprite)
(continue))
@ -551,23 +551,23 @@
(set (path boar > anim) (addr anim-boar-damage))
(set (path boar > animation-start-ticks) (SDL_GetPerformanceCounter)))))))
(defun-local get-free-effect (&return (* effect))
(each-item-addr-in-array s-effects i current-effect (* effect)
(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 (* power-context)
name (* (const char))
&return (* int))
(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 (* (const char))
value (* int))
(var name-values ([] 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)))
@ -581,7 +581,7 @@
(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 (* name-value-pair)
(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)))
@ -589,40 +589,40 @@
(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 (* power-context)
name-or-literal (* (const char))
&return (* int))
(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 (* int) (resolve-value-from-name context name-or-literal))
(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 (* power-context)
name (* (const char))
&return (* (const char)))
(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 (* (const char))
value (* (const char)))
(var name-values ([] 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 (* name-value-pair)
(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 (* power-context)
name-or-literal (* (const char))
&return (* (const char)))
(var value-out (* (const char)) (resolve-string-value-from-name context name-or-literal))
(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))
@ -636,11 +636,11 @@
(var c-wizard-start-effect-x int 186)
(var c-wizard-start-effect-y int 64)
(defun find-end-index (operations (* operation) start-index int
(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 (* operation) (addr (at i operations)))
(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))
@ -653,11 +653,11 @@
(return i))))
(return (- 1 (dynarray-length operations))))
(defun execute-power (context (* power-context)
id (* (const char))
(defun execute-power (context (addr power-context)
id (addr (const char))
execute-type power-execute-type)
(var power-to-execute (* power) null)
(each-item-addr-in-array (field s-power-system powers) power-index current-power (* power)
(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))
@ -667,7 +667,7 @@
(preslog "Could not find power %s to activate\n" id)
(return))
(var operations-to-run (* operation) null)
(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)))
@ -675,21 +675,20 @@
(set operations-to-run (path power-to-execute > parsed-on-update-operations))))
(each-item-addr-in-dynarray operations-to-run
operation-index op (* operation)
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 (field spawn-power-context start-x)
(+ (path context > effect-data > x)
(path context > effect-data > relative-spawn-x)))
(set (field spawn-power-context start-y)
(+ (path context > effect-data > y)
(path context > effect-data > relative-spawn-y))))
(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 (* effect) (? (path context > effect-data)
(var new-effect (addr effect) (? (path context > effect-data)
(path context > effect-data)
(get-free-effect)))
(unless new-effect
@ -697,13 +696,13 @@
(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 (* spritesheet)
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 (* animation-data)
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))
@ -736,43 +735,43 @@
(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 (* int) (resolve-value-from-name
(var value-out (addr int) (resolve-value-from-name
context (path op > string-a)))
(var set-value-to (* int) (resolve-value-or-literal-from-string
(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 (* int) (resolve-value-from-name
(var value-out (addr int) (resolve-value-from-name
context (path op > string-a)))
(var add-value (* int) (resolve-value-or-literal-from-string
(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 (* int) (resolve-value-or-literal-from-string
(var value-a (addr int) (resolve-value-or-literal-from-string
context (path op > string-a)))
(var value-b (* int) (resolve-value-or-literal-from-string
(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 (* (const char)) (resolve-string-value-or-literal-from-string
(var value-a (addr (const char)) (resolve-string-value-or-literal-from-string
context (path op > string-a)))
(var value-b (* (const char)) (resolve-string-value-or-literal-from-string
(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 (* int) (resolve-value-or-literal-from-string
(var value-a (addr int) (resolve-value-or-literal-from-string
context (path op > string-a)))
(var value-b (* int) (resolve-value-or-literal-from-string
(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))
@ -782,14 +781,14 @@
;; Text rendering
;;
(defun-local render-string (renderer (* SDL_Renderer) font (* font-atlas) font-texture (* SDL_Texture)
x int y int str (* (const char)))
(defun-local render-string (renderer (addr SDL_Renderer) font (addr font-atlas) font-texture (addr SDL_Texture)
x int y int str (addr (const char)))
(var write-x int x)
(var write-y int y)
(var tab-width int 100)
(scope ;; Get tab width based on space advance
(var space-key char ' ')
(var glyph (* glyph-entry) (dict-ptr-at (path font > glyph-lookup-table) space-key))
(var glyph (addr glyph-entry) (dict-ptr-at (path font > glyph-lookup-table) space-key))
(when glyph
(set tab-width (* 4 (path glyph > advance-x)))))
@ -808,7 +807,7 @@
(continue)))
(var search-key char (deref current-char))
(var glyph (* glyph-entry) (dict-ptr-at (path font > glyph-lookup-table) search-key))
(var glyph (addr glyph-entry) (dict-ptr-at (path font > glyph-lookup-table) search-key))
(unless glyph ;; fallback
(set search-key '?')
(set glyph (dict-ptr-at (path font > glyph-lookup-table) search-key)))
@ -832,14 +831,14 @@
(when (and s-enable-kerning (+ 1 current-char))
(var character-pair uint16_t (font-atlas-make-character-pair
(deref current-char) (at 1 current-char)))
(var kerning (* kerning-entry)
(var kerning (addr kerning-entry)
(dict-ptr-at (path font > kerning-lookup-table) character-pair))
(when kerning
(set write-x (+ write-x (path kerning > x)))))))
(defun-local make-font-atlas-and-texture (renderer (* SDL_Renderer)
font-atlas-out (* font-atlas) font-texture-out (* (* SDL_Texture))
font-data (* (const (unsigned char))) font-data-size (unsigned int)
(defun-local make-font-atlas-and-texture (renderer (addr SDL_Renderer)
font-atlas-out (addr font-atlas) font-texture-out (addr (addr SDL_Texture))
font-data (addr (const (unsigned char))) font-data-size (unsigned int)
device-dpi (unsigned int)
font-size-points (unsigned char)
&return bool)
@ -852,7 +851,7 @@
(return false))
(scope
(var font-surface (* SDL_Surface)
(var font-surface (addr SDL_Surface)
(SDL_CreateRGBSurfaceWithFormatFrom
(path font-atlas-out > pixel-buffer)
(path font-atlas-out > width)
@ -869,11 +868,11 @@
(return false)))
(return true))
(defun-local sdl-texture-from-bmp-data (renderer (* SDL_Renderer)
data-start (* (unsigned char))
data-end (* (unsigned char))
&return (* SDL_Texture))
(var surface (* SDL_Surface)
(defun-local sdl-texture-from-bmp-data (renderer (addr SDL_Renderer)
data-start (addr (unsigned char))
data-end (addr (unsigned char))
&return (addr SDL_Texture))
(var surface (addr SDL_Surface)
(SDL_LoadBMP_RW (SDL_RWFromMem data-start (- data-end data-start))
;; freesrc (free the RWOps)
1))
@ -881,7 +880,7 @@
(sdl-print-error)
(return null))
(defer (SDL_FreeSurface surface))
(var texture (* SDL_Texture) (SDL_CreateTextureFromSurface renderer surface))
(var texture (addr SDL_Texture) (SDL_CreateTextureFromSurface renderer surface))
(unless texture
(sdl-print-error)
(return null))
@ -910,14 +909,14 @@
(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 (* SDL_Window) null)
(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 (* SDL_Renderer) (SDL_CreateRenderer window -1 SDL_RENDERER_ACCELERATED))
(var renderer (addr SDL_Renderer) (SDL_CreateRenderer window -1 SDL_RENDERER_ACCELERATED))
(unless renderer
(sdl-print-error)
(return 1))
@ -932,13 +931,13 @@
(defstruct font-atlas-texture
atlas font-atlas
texture (* SDL_Texture)
texture (addr SDL_Texture)
;; Only needed before it is built
start-file-data (* (unsigned char))
end-file-data (* (unsigned char))
start-file-data (addr (unsigned char))
end-file-data (addr (unsigned char))
font-size-points (unsigned char))
(var font-atlases ([] font-atlas-texture)
(var font-atlases (array font-atlas-texture)
(array
(array ;; Heading font, 1080p
(array 0) null
@ -976,12 +975,12 @@
(var body-code-font-index int body-code-font-index-1080p)
(defer
(each-item-addr-in-array font-atlases i font (* font-atlas-texture)
(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 (* font-atlas-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))
@ -996,11 +995,11 @@
(defer (free-introspect-struct-fields power-system--metadata (addr s-power-system) free))
(defstruct spritesheets-to-prepare
id (* (const char))
sprite (* (* spritesheet))
start-data (* (unsigned char))
end-data (* (unsigned char)))
(var prepare-spritesheets ([] 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)
@ -1017,25 +1016,25 @@
(array "rocks" (addr spritesheet-rocks)
s-start-rocks-spritesheet s-end-rocks-spritesheet)))
(each-item-addr-in-array prepare-spritesheets i sheet (* spritesheets-to-prepare)
(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 (* spritesheet)
(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 (* SDL_Texture)
(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 (* spritesheets-to-prepare)
(each-item-addr-in-array prepare-spritesheets i sheet (addr spritesheets-to-prepare)
(SDL_DestroyTexture (path (deref (path sheet > sprite)) > texture))))
(var ground-texture (* SDL_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))
@ -1048,7 +1047,7 @@
(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 (* char)
(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)
@ -1080,17 +1079,17 @@
(var should-render-ground bool false)
(var queued-effect effect-id effect-id-none)
(var queued-power-id (* (const char)) null)
(var queued-power-id (addr (const char)) null)
(var sequential-cycle-index int 0)
(var power-cycle-id (* (const char)) null)
(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 (* (const char)) null)
(var exit-reason (addr (const char)) null)
(while true
(var event SDL_Event)
(while (SDL_PollEvent (addr event))
@ -1122,7 +1121,7 @@
(set current-slide-index 0)))
;; Slide changed; handle triggers
(when (!= start-frame-slide-index current-slide-index)
(var current-slide (* slide-data)
(var current-slide (addr slide-data)
(addr (at current-slide-index (field presentation slides))))
(when (at 0 (path current-slide > trigger))
(cond
@ -1139,7 +1138,7 @@
(true
(preslog "Unrecognized trigger: %s" (path current-slide > trigger))))))
(var slide (* slide-data) (addr (at current-slide-index (field presentation slides))))
(var slide (addr slide-data) (addr (at current-slide-index (field presentation slides))))
;; Debug keys
(when (keybind-tapped (addr s-toggle-kerning-keybind) (addr s-key-states))
@ -1175,8 +1174,9 @@
(set virtual-window-width 1920)
(set virtual-window-height 1080))
(set (field g-wizard-hero x) (type-cast (* virtual-window-width 0.08f) int))
(set (field g-wizard-hero y) (- virtual-window-height (/ ground-height 2) wizard-ground-height))
(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))
@ -1189,7 +1189,7 @@
(? (= 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 (* power-keybind)
(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))
@ -1210,14 +1210,14 @@
(or (!= queued-effect effect-id-none)
queued-power-id))
(var current-frame int 0)
(var current-anim (* (const animation)) (field g-wizard-hero anim))
(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 (* effect) (get-free-effect))
(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)
@ -1242,9 +1242,9 @@
(when s-draw-atlases
(defstruct atlas-set
atlas (* font-atlas)
texture (* SDL_Texture))
(var atlases-to-draw ([] 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))
@ -1293,8 +1293,8 @@
(scope
(if (= 0 (strcmp (path slide > trigger) "power-cycle-display"))
(scope
(var power-update-str (* (const char)) null)
(each-item-addr-in-array (field s-power-system powers) power-index current-power (* power)
(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))
@ -1342,7 +1342,7 @@
(update-effects renderer (addr g-boar-enemy)))
(when s-enable-debug-overlay
(var buffer ([] 256 char) (array 0))
(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))

Loading…
Cancel
Save