flan/examples/core-input-gestures.flan
Joseph Ferano 26c53e0a19 Every defn in the tree states its return type, and Unit is written ()
The mechanical half, ahead of the parser change that needs it. tools/unit-return.py
fills the empty slot with () and rewrites Unit as () wherever a type is spelled --
(Fn [i32] Unit), (Map i32 Unit), a return type written out.

Deciding whether a defn already had a return type is the whole difficulty, and
the script does it the way parse.ml did: is_type_form is transcribed rather than
improved, because being identical to the parser it replaces is what makes the
sweep meaning-preserving. It is re-runnable, so the lanes that branched before
this can have the same pass at merge:

    python3 tools/unit-return.py .
    python3 tools/unit-return.py --in-strings test/test_flan.ml test/test_acceptance.ml \
        test/test_session.ml emacs/test-flan-dev.el emacs/test-flan-mode.el
    python3 tools/unit-return.py --raw-ml lib/prelude.ml
    python3 tools/unit-return.py --in-html web/index.html

-v logs every defn it saw and what it decided, which is how a sweep of 440 sites
gets reviewed at all. Embedded modes pool a file's type declarations across all
its fragments, because a snippet split across concatenation -- decls ^ "(defn f
[s [u8]] Cursor ...)" -- cannot see the names the other half declared; pooled
names count only in bare-symbol position, for the same reason the prelude's do.
A fragment that cuts off mid-form is skipped rather than guessed at. Five sites
in test_flan.ml still needed a hand, and they are in this commit.

Two things ride along because the sweep needs them: parse.ml reads a lone () as
the return type of a function with no body, which was not a shape the old
optional slot could produce; and the map refusals name () rather than Unit, since
that is now the spelling a caller wrote.
2026-09-12 23:06:40 +07:00

111 lines
4.6 KiB
Plaintext

;;;; raylib [core] example - input gestures
;;;;
;;;; examples/core/core_input_gestures.c. Needed `fade`, now bound.
;;;;
;;;; The C keeps `char gestureStrings[20][32]` and TextCopy's a name into the
;;;; next slot. Flan has no mutable character buffer and no way to copy into
;;;; one, but it does not need either: the names are compile-time literals, so
;;;; the log is a `[20 string]` and a slot holds the literal itself. That is
;;;; strictly better than the C — no truncation at 32 bytes, no copy — and it
;;;; is only possible because every string that ever goes into the log is
;;;; known at compile time. A log of strings the program had BUILT could not be
;;;; written at all.
;;;;
;;;; The C's `switch (currentGesture)` over the ten gesture values is a `cond`
;;;; of keyword equalities. `get-gesture-detected` answers an `rl/Gesture` and
;;;; `(= g :tap)` compares against a member by name, checked at compile time —
;;;; so a typo here is an error and the C's `default: break` has nothing to
;;;; catch.
;;;;
;;;; A slot that has not been written yet holds a zero-length string, because a
;;;; `defvar` with no initialiser is all-bytes-zero and a string is ptr+len —
;;;; a null pointer with a length of 0. draw-text draws nothing for it. That is
;;;; the C's `{ "" }` initialiser arriving by a different route, and it is why
;;;; resetting the log below only has to reset the counter.
(import rl "vendor:raylib")
(defconst screen-width 800)
(defconst screen-height 450)
(defconst max-gesture-strings 20)
(defvar gesture-log [max-gesture-strings string])
(defvar gestures-count i32)
(defvar current-gesture rl/Gesture)
(defvar last-gesture rl/Gesture)
;; The C's switch, as a function. `:else` is its `default:` — an unnamed
;; gesture logs the empty string, which draws nothing, which is what falling
;; through the C's switch without a TextCopy leaves in the slot.
(defn gesture-name [g rl/Gesture] string
(cond
(= g :tap) "GESTURE TAP"
(= g :double-tap) "GESTURE DOUBLETAP"
(= g :hold) "GESTURE HOLD"
(= g :drag) "GESTURE DRAG"
(= g :swipe-right) "GESTURE SWIPE RIGHT"
(= g :swipe-left) "GESTURE SWIPE LEFT"
(= g :swipe-up) "GESTURE SWIPE UP"
(= g :swipe-down) "GESTURE SWIPE DOWN"
(= g :pinch-in) "GESTURE PINCH IN"
(= g :pinch-out) "GESTURE PINCH OUT"
:else ""))
(defn main [] ()
(rl/init-window screen-width screen-height
"raylib [core] example - input gestures")
(defer (rl/close-window))
(rl/set-target-fps 60)
(let [touch-area (rl/Rectangle {.x 220.0 .y 10.0
.width (- (f32 screen-width) 230.0)
.height (- (f32 screen-height) 20.0)})]
(until (rl/window-should-close?)
;; Update
(set last-gesture current-gesture)
(set current-gesture (rl/get-gesture-detected))
(let [touch (rl/get-touch-position 0)]
(when (and (rl/collision-point-rec? touch touch-area)
(not (= current-gesture :none))
(not (= current-gesture last-gesture)))
(set (at gesture-log gestures-count) (gesture-name current-gesture))
(set gestures-count (+ gestures-count 1))
;; Full: start over. The stale slots below the counter are never
;; drawn, so they do not have to be cleared the way the C clears
;; them — the loop below is bounded by gestures-count.
(when (>= gestures-count max-gesture-strings)
(set gestures-count 0)))
;; Draw
(rl/begin-drawing)
(rl/clear-background rl/raywhite)
(rl/draw-rectangle-rec touch-area rl/gray)
(rl/draw-rectangle 225 15 (- screen-width 240) (- screen-height 30)
rl/raywhite)
(rl/draw-text "GESTURES TEST AREA" (- screen-width 270)
(- screen-height 40) 20 (rl/fade rl/gray 0.5))
(dotimes [i gestures-count]
(if (= 0 (% i 2))
(rl/draw-rectangle 10 (+ 30 (* 20 i)) 200 20
(rl/fade rl/lightgray 0.5))
(rl/draw-rectangle 10 (+ 30 (* 20 i)) 200 20
(rl/fade rl/lightgray 0.3)))
;; The newest entry in maroon and the rest in dark grey, as the C
;; has it.
(rl/draw-text (at gesture-log i) 35 (+ 36 (* 20 i)) 10
(if (< i (- gestures-count 1)) rl/darkgray rl/maroon)))
(rl/draw-rectangle-lines 10 29 200 (- screen-height 50) rl/gray)
(rl/draw-text "DETECTED GESTURES" 50 15 10 rl/gray)
(unless (= current-gesture :none)
(rl/draw-circle-v touch 30.0 rl/maroon))
(rl/end-drawing)))))