diff --git a/sand.flan b/sand.flan index 90f5d42..6d46dbb 100644 --- a/sand.flan +++ b/sand.flan @@ -207,6 +207,136 @@ (rl/draw-texture-ex brush-mirrored (rl/Vector2 {:x 110.0 :y 46.0}) 0.0 2.0 rl/white))) +;; ── Sound ────────────────────────────────────────────────────────── +;; +;; Nothing in this section can be in the acceptance table and the reason is +;; sharper than "it needs a GL context": a Sound is a buffer the miniaudio +;; mixer owns, so it does not exist until init-audio-device has found a +;; device, and a machine with no sound server gets a zeroed struct and a +;; warning. What CAN be asserted headlessly is the Wave the sound is made +;; from — test/programs/raylib-audio.flan does exactly that — so the split +;; here is real and not an excuse: the samples are checked, the playing is +;; only listened to. +;; +;; The tone is generated rather than loaded because a .wav in the repository +;; would be an asset to maintain for one plink, and because generating it is +;; what gives load-sound-from-wave and export-wave a call site that is not a +;; test. + +(defconst tone-rate 22050) +(defconst tone-frames 4410) ; 0.2 s +(defconst tone-path "/tmp/flan-sand-tone.wav") + +;; Little-endian signed 16-bit PCM, two bytes per frame, written as bytes +;; because that is what a Wave's `data` is: the element width is `sample-size`, +;; a run-time number, and no Flan type says what the buffer holds. +(defvar tone-pcm [8820 u8]) + +(defn write-sample [i i32 v i32] + (set (at tone-pcm (* i 2)) (u8 (bit-and v 255))) + (set (at tone-pcm (+ (* i 2) 1)) (u8 (bit-and (>> v 8) 255)))) + +;; A square wave that decays to nothing over its length, which is the +;; cheapest thing that sounds like a plink rather than a click. `period` is +;; the half-period in frames, so a smaller one is a higher note. +(defn build-tone [period i32] + (dotimes [i tone-frames] + (let [amp (/ (* 9000 (- tone-frames i)) tone-frames)] + (write-sample i (if (= 0 (% (/ i period) 2)) amp (- 0 amp)))))) + +(defvar audio-ok bool) +(defvar tone rl/Sound) +(defvar tone-ok bool) +(defvar music rl/Music) +(defvar music-ok bool) +(defvar music-on bool) + +(defn start-audio [] + (rl/init-audio-device) + (set audio-ok (rl/audio-device-ready?)) + (unless audio-ok + (print-line "sand: no audio device — the grains are silent")) + (build-tone 40) + (let [w (rl/Wave {:frame-count (u32 tone-frames) :sample-rate (u32 tone-rate) + :sample-size 16 :channels 1 + :data (addr (at tone-pcm 0))})] + (when audio-ok + (set tone (rl/load-sound-from-wave w)) + (set tone-ok (rl/sound-valid? tone)) + (rl/set-sound-volume tone 0.25) + (rl/set-sound-pan tone 0.5) + ;; The same samples out to a file and straight back in as a stream, so + ;; the Music side has a call site without an asset in the repository. + ;; A Sound is resident and a Music is decoded as it plays, which is the + ;; whole difference, and update-music-stream in the loop below is the + ;; visible consequence of it. + (when (rl/export-wave w tone-path) + (set music (rl/load-music-stream tone-path)) + (set music-ok (rl/music-valid? music)) + (when music-ok + (set (.looping music) true) + (rl/set-music-volume music 0.15) + (rl/set-music-pitch music 0.5))))) + (rl/set-master-volume 0.6)) + +(defn stop-audio [] + (when music-ok (rl/unload-music-stream music)) + (when tone-ok (rl/unload-sound tone)) + (rl/close-audio-device)) + +;; Every plink goes through here, so a silent build — no device, or a wave +;; that would not load — is one branch and not a guard at every call site. +(defn plink [pitch f32] + (when tone-ok + (rl/set-sound-pitch tone pitch) + (rl/play-sound tone))) + +(defn toggle-music [] + (when music-ok + (set music-on (not music-on)) + (if music-on + (rl/play-music-stream music) + (rl/pause-music-stream music)))) + +;; ── The scene, off-screen ─────────────────────────────────────────── +;; +;; The world is drawn into a render texture and the render texture is drawn to +;; the screen, which is what a post-process pass or a pixel-perfect upscale +;; would hang off. There is nothing to assert here either — LoadRenderTexture +;; makes a GL framebuffer object and answers an id of 0 with no context — so +;; the fallback below is not defensive padding, it is what keeps the program +;; honest when the framebuffer is not there. +;; +;; The source rectangle's height is NEGATIVE on purpose. raylib renders into a +;; framebuffer bottom-up, so drawing the result the right way up needs the +;; flip, and getting it wrong is a world that is upside down rather than an +;; error. + +(defvar scene rl/RenderTexture2D) +(defvar scene-ok bool) + +(defn load-scene [] + (set scene (rl/load-render-texture screen-width screen-height)) + (set scene-ok (rl/render-texture-valid? scene)) + (unless scene-ok + (print-line "sand: no render texture — drawing straight to the screen"))) + +;; ── The font ──────────────────────────────────────────────────────── +;; +;; get-font-default needs a window: the default font is loaded as part of +;; init-window and LoadFontDefault is not exported, which is the same fact +;; that makes the plain measure-text answer 0 headless. The Font family IS +;; assertable — test/programs/raylib-font.flan builds one by hand and has +;; raylib measure with it — so what is left here is the drawing, and the +;; drawing is looked at. + +(defvar hud-font rl/Font) +(defvar hud-font-ok bool) + +(defn load-hud-font [] + (set hud-font (rl/get-font-default)) + (set hud-font-ok (rl/font-valid? hud-font))) + ;; ── The view ──────────────────────────────────────────────────────── ;; ;; begin-mode-2d and end-mode-2d were bound along with Camera2D and then @@ -279,8 +409,27 @@ (defn game-update [] (when (rl/key-pressed? :r) (clear-grid)) (move-view) + ;; key-released? and mouse-button-pressed? were bound and called by nothing + ;; at all, which is the same as not having bound them. They are the two + ;; halves nothing else here uses: space cycles the colour when it comes back + ;; UP, and the right button resets the view the instant it goes DOWN, so the + ;; two edges are told apart by eye rather than only in the source. + (when (rl/key-released? :space) (next-color) (plink 1.4)) + (when (rl/mouse-button-pressed? :right) (reset-view) (plink 0.6)) + (when (rl/mouse-button-pressed? :left) (plink 1.0)) + (when (rl/key-pressed? :m) (toggle-music)) + ;; The pad, when there is one. Pressed and released are separate events here + ;; too, for the same reason. + (when (rl/gamepad-available? 0) + (when (rl/gamepad-button-pressed? 0 :right-face-down) (plink 1.2)) + (when (rl/gamepad-button-released? 0 :right-face-down) (next-color)) + (when (rl/gamepad-button-down? 0 :middle-right) (clear-grid))) (when (rl/mouse-button-down? :left) (paint)) (when (rl/mouse-button-released? :left) (next-color)) + ;; Once a frame, every frame, or the stream runs dry and the music stops + ;; without saying anything. This is the whole difference between a Music and + ;; a Sound. + (when music-on (rl/update-music-stream music)) (step)) (defn draw-grid [] @@ -341,11 +490,20 @@ ;; visible rather than merely different. (defn draw-hud [] (let [title "SAND" - keys "arrows pan , . zoom 0 reset r clear" + keys "arrows pan , . zoom 0 reset r clear space colour m music" ;; measure-text is what sizes the panel, so the box fits the string ;; rather than a number somebody guessed. Headless it answers 0 for ;; everything, which is why it is not in the acceptance table. - w (max (rl/measure-text title 30) (rl/measure-text keys 20)) + ;; + ;; The title is measured with the Font form instead, which takes a + ;; float size and a spacing the integer form has no way to express — + ;; and then drawn with the matching draw-text-ex, so the box and the + ;; letters agree. That agreement is the check: measure with one and + ;; draw with the other and the panel is visibly the wrong width. + title-w (if hud-font-ok + (i32 (.x (rl/measure-text-ex hud-font title 30.0 4.0))) + (rl/measure-text title 30)) + w (max title-w (rl/measure-text keys 20)) h 72 x 24 y (- (rl/get-screen-height) (+ h 24)) @@ -357,7 +515,10 @@ (rl/draw-rectangle-rounded-lines panel (f32 0.2) 8 (rl/get-color 0x404060FF)) (rl/draw-rectangle-rounded-lines-ex panel (f32 0.2) 8 (f32 2.0) (rl/get-color 0x6060A0FF)) - (rl/draw-text title x y 30 rl/white) + (if hud-font-ok + (rl/draw-text-ex hud-font title (rl/Vector2 {:x (f32 x) :y (f32 y)}) + 30.0 4.0 rl/white) + (rl/draw-text title x y 30 rl/white)) (rl/draw-text keys x (+ y 40) 20 (rl/get-color 0xA0A0B0FF)) ;; The palette, along the bottom right. The selected colour is the one @@ -371,6 +532,18 @@ (when (= i current-color) (rl/draw-circle-lines cx sh (f32 22.0) rl/white)))) + ;; The selected index as a digit, drawn one codepoint at a time. There + ;; is no string formatting in the language yet, so this is the only way + ;; a number reaches the screen at all — and get-glyph-index is what says + ;; whether the default font has the digit before it is asked for. + (when hud-font-ok + (let [cp (+ 48 current-color)] + (when (> (rl/get-glyph-index hud-font cp) 0) + (rl/draw-text-codepoint hud-font cp + (rl/Vector2 {:x (f32 (- sw 24)) + :y (f32 (- sh 96))}) + 30.0 rl/white)))) + ;; A zoom read-out with no number in it, because there is no string ;; formatting yet: the bar's length is the zoom. draw-rectangle-rec, ;; draw-rectangle-v and draw-rectangle-lines are the three remaining @@ -406,16 +579,118 @@ (f32 30.0) (f32 34.0) spin (+ spin (f32 270.0)) 32 rl/white))))) -(defn game-draw [] - (rl/clear-background rl/black) + +;; ── Gamepads, touch and gestures ──────────────────────────────────── +;; +;; None of this can be asserted anywhere, and the reason is worth stating +;; rather than assuming. With no pad attached, gamepad-available? is false, +;; every button predicate is false and every axis reads 0.0 — which is exactly +;; what a wrapper with its two int arguments exchanged would report. Touch and +;; gestures are the same: they are fed by raylib's own event polling inside a +;; frame loop, so they answer nothing at all headless. A test would be +;; asserting that two zeroes are equal. +;; +;; So they are drawn, and the only check they get is that moving a stick moves +;; the marker. Every read-out below is asymmetric on purpose — the stick dot +;; is offset by x and y separately, and the trigger bars are different lengths +;; — so a crossed wrapper is visible rather than merely different. +(defn draw-input-state [] + (let [ox (f32 200.0) + oy (f32 90.0) + r (f32 34.0)] + (when (rl/gamepad-available? 0) + ;; The ring only appears when raylib says a pad is there, which is what + ;; separates "centred stick" from "no pad" — both of which are a dot in + ;; the middle otherwise. + (rl/draw-circle-lines (i32 ox) (i32 oy) r (rl/get-color 0x6060A0FF)) + (let [p (rl/Vector2 {:x (+ ox (* (rl/get-gamepad-axis-movement 0 :left-x) r)) + :y (+ oy (* (rl/get-gamepad-axis-movement 0 :left-y) r))})] + (rl/draw-circle-v p (f32 5.0) rl/white)) + ;; The two triggers as bars of different lengths, so exchanging them is + ;; visible. They rest at -1 and not at 0, which raylib does not + ;; normalise and neither does this — hence the +1. + (let [lt (+ (f32 1.0) (rl/get-gamepad-axis-movement 0 :left-trigger)) + rt (+ (f32 1.0) (rl/get-gamepad-axis-movement 0 :right-trigger))] + (rl/draw-rectangle-v (rl/Vector2 {:x (+ ox (f32 46.0)) :y (- oy (f32 12.0))}) + (rl/Vector2 {:x (* lt (f32 30.0)) :y (f32 8.0)}) + (rl/get-color 0x8080C0FF)) + (rl/draw-rectangle-v (rl/Vector2 {:x (+ ox (f32 46.0)) :y (+ oy (f32 4.0))}) + (rl/Vector2 {:x (* rt (f32 50.0)) :y (f32 8.0)}) + (rl/get-color 0x8080C0FF))) + ;; One pip per axis the pad reports, and one per face button that is + ;; NOT up — gamepad-button-up? rather than -down? so the negative form + ;; has a call site of its own. + (dotimes [i (rl/get-gamepad-axis-count 0)] + (rl/draw-pixel (+ (i32 ox) (* i 4)) (+ (i32 oy) 44) rl/white)) + (unless (rl/gamepad-button-up? 0 :right-face-down) + (rl/draw-circle (+ (i32 ox) 110) (i32 oy) (f32 6.0) rl/white)) + ;; -1 when nothing is pressed, which is why this is an i32 and not a + ;; GamepadButton: the answer is outside the enum. + (when (>= (rl/get-gamepad-button-pressed) 0) + (rl/draw-circle (+ (i32 ox) 130) (i32 oy) (f32 6.0) + (rl/get-color 0xFFC000FF)))) + + ;; Touch. On a desktop the count is 0 but point 0 still follows the + ;; mouse, so the ring below is what says a real touchscreen is there. + (dotimes [i (rl/get-touch-point-count)] + (rl/draw-circle-lines-v (rl/get-touch-position i) (f32 18.0) + (rl/get-color 0xA0A0FFFF)) + (rl/draw-pixel (rl/get-touch-x) (rl/get-touch-y) rl/white) + (rl/draw-pixel-v (rl/Vector2 {:x (f32 (rl/get-touch-point-id i)) + :y (f32 4.0)}) + rl/white)) + + ;; And the gesture, if any: a bar as long as the hold has lasted, and the + ;; drag vector drawn from the centre of the ring. + (unless (= (rl/get-gesture-detected) :none) + (rl/draw-rectangle (i32 ox) (+ (i32 oy) 54) + (i32 (* (f32 60.0) (rl/get-gesture-hold-duration))) + 8 rl/white) + (when (rl/gesture-detected? :drag) + (let [d (rl/get-gesture-drag-vector)] + (rl/draw-line-v (rl/Vector2 {:x ox :y oy}) + (rl/Vector2 {:x (+ ox (* (.x d) (f32 200.0))) + :y (+ oy (* (.y d) (f32 200.0)))}) + (rl/get-color 0xFFC000FF)))) + (when (rl/gesture-detected? :pinch-in) + (let [q (rl/get-gesture-pinch-vector)] + (rl/draw-circle-v (rl/Vector2 {:x (+ ox (* (.x q) (f32 200.0))) + :y (+ oy (* (.y q) (f32 200.0)))}) + (f32 4.0) rl/white)))))) + +(defn draw-world [] ;; Everything between these two is in world space and moves with the camera. (rl/begin-mode-2d view) (draw-grid) (draw-world-cursor) - (rl/end-mode-2d) + (rl/end-mode-2d)) + +(defn game-draw [] + ;; The world goes into the render texture first, if there is one. Note the + ;; clear inside the texture mode: the framebuffer keeps last frame's pixels + ;; otherwise, which looks like a trail and not like a bug. + (when scene-ok + (rl/begin-texture-mode scene) + (rl/clear-background rl/black) + (draw-world) + (rl/end-texture-mode)) + (rl/clear-background rl/black) + ;; Then the texture, upside down on purpose: raylib renders into a + ;; framebuffer bottom-up, so a negative source height is the correction and + ;; not a trick. Without a framebuffer the world is drawn straight to the + ;; screen and nothing else changes. + (if scene-ok + (rl/draw-texture-rec (.texture scene) + (rl/Rectangle {:x 0.0 :y 0.0 + :width (f32 screen-width) + :height (f32 (- 0 screen-height))}) + (rl/Vector2 {:x 0.0 :y 0.0}) + rl/white) + (draw-world)) ;; And everything after it is in screen pixels again. (draw-brush) (draw-hud) + (draw-input-state) (rl/draw-fps 20 20)) (defn main [] @@ -430,6 +705,18 @@ (load-brush) (defer (rl/unload-texture brush)) (defer (rl/unload-texture brush-mirrored)) + ;; The same rule for the framebuffer and the default font, and a third one + ;; for the mixer: the audio device is its own subsystem and does not come + ;; with the window, so it is opened and closed on its own. + (load-scene) + (defer (rl/unload-render-texture scene)) + (load-hud-font) + (start-audio) + (defer (stop-audio)) + ;; Gestures are off until something asks for them. Everything, because the + ;; read-out draws whichever one arrives, and because the parameter is a set + ;; of flags rather than one member — see the note on the Gesture enum. + (rl/set-gestures-enabled rl/gesture-all) ;; The dev agent listens on a socket for redefinitions and hands them over; ;; (agent/poll) below is where they are installed. Building without --dev is ;; fine — nothing has cells to install into, so a module is refused on the