Joseph Ferano
26c53e0a19
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.
365 lines
17 KiB
Plaintext
365 lines
17 KiB
Plaintext
;;;; raylib [core] example - input gestures testbed
|
|
;;;;
|
|
;;;; examples/core/core_input_gestures_testbed.c, the four-star one and the
|
|
;;;; hardest of the ten. It runs, and it is the example that pushed hardest on
|
|
;;;; the language. Four things it needed, in descending order of how much they
|
|
;;;; cost.
|
|
;;;;
|
|
;;;; **An enum converts to an integer, when you say so.** The C treats the
|
|
;;;; gesture as the raw bitfield it is and compares it with `<` and `>`:
|
|
;;;; `currentGesture > 255` picks out the two pinches, `> 15` the four swipes,
|
|
;;;; `!= 4` excludes hold, `< 3` admits tap and double-tap. `get-gesture-
|
|
;;;; detected` answers an `rl/Gesture`, and that used to end the discussion —
|
|
;;;;
|
|
;;;; i32 converts a number, found rl/Gesture
|
|
;;;;
|
|
;;;; — so the three range tests were spelled out as keyword equalities, one
|
|
;;;; arm per member. They are `(> (i32 g) 255)`, `(> (i32 g) 15)` and
|
|
;;;; `(< (i32 g) 3)` now, still behind the named predicates below, and the fix
|
|
;;;; is not brevity: the enumerated version was *wrong about the future*. A
|
|
;;;; gesture raylib adds later falls silently out of a list of four members,
|
|
;;;; where the C's `> 15` catches it. The range test is the honest reading of
|
|
;;;; a bitfield and now it is the one written.
|
|
;;;;
|
|
;;;; The rule the refusal came from is unchanged and worth keeping: an enum is
|
|
;;;; its own type in the checker, so `:tpa` is an error at the call site
|
|
;;;; instead of a number that is wrong later, and a bare integer still does not
|
|
;;;; fit an `rl/Gesture` parameter. `(i32 g)` does not weaken that — it is
|
|
;;;; named, and it is at the site. The rule was "an integer must not arrive
|
|
;;;; silently", not "an integer is dangerous".
|
|
;;;;
|
|
;;;; The `!= 4` stays a keyword comparison, `(not (= g :hold))`. That one was
|
|
;;;; never a range test; it is a single member, and the C's 4 is a magic
|
|
;;;; number the keyword reads better than.
|
|
;;;;
|
|
;;;; **No sin or cos.** The prelude has sqrt-f32 — one `declare` over libm,
|
|
;;;; with a comment explaining why it is not a builtin — and nothing else
|
|
;;;; transcendental. The protractor needs both, so they are two more `declare`
|
|
;;;; lines here, in the same shape. They link: libm is already on the line.
|
|
;;;;
|
|
;;;; **No string formatting.** A number can be made into a string now —
|
|
;;;; (string (i64->bytes n)) — but a *format* still cannot: f64->bytes is
|
|
;;;; "%g", with no way to ask for two decimal places. The C prints the angle
|
|
;;;; with `TextFormat("%f", ...)`, finds the decimal point with
|
|
;;;; `TextFindIndex` and cuts two digits past it with `TextSubtext`;
|
|
;;;; `draw-f32` in examples/digits.flan does the whole thing in one call, and
|
|
;;;; rounds rather than truncating — which is the one place this screen
|
|
;;;; differs from the C's by a digit.
|
|
;;;;
|
|
;;;; **No local fixed arrays.** The C declares `char gestureLog[20][12]` and
|
|
;;;; `Vector2 touchPosition[32]` inside main. A `let` binding takes no type
|
|
;;;; annotation, so a fixed array can only be a top-level `defvar` or a literal
|
|
;;;; with every element written out — thirty-two Vector2s, here. They are
|
|
;;;; `defvar`s, which is what the C's storage amounts to anyway.
|
|
;;;;
|
|
;;;; The log itself came out simpler than the C's: the names are compile-time
|
|
;;;; literals, so a slot holds a `string` and there is no TextCopy and no
|
|
;;;; twelve-byte truncation.
|
|
|
|
(import rl "vendor:raylib")
|
|
(import d "digits.flan")
|
|
|
|
(defconst screen-width 800)
|
|
(defconst screen-height 450)
|
|
|
|
(defconst pi f32 3.14159265)
|
|
|
|
(defconst gesture-log-size 20)
|
|
(defconst max-touch-count 32)
|
|
|
|
(defvar gesture-log [gesture-log-size string])
|
|
;; The C's inverted circular queue: the index counts DOWN and wraps at the top,
|
|
;; so the newest entry is always at gesture-log-index and the draw loop walks
|
|
;; forward from there. Starting at the size rather than at size-1 is the C's
|
|
;; too — the first write decrements before storing.
|
|
(defvar gesture-log-index i32)
|
|
(defvar previous-gesture rl/Gesture)
|
|
(defvar last-gesture rl/Gesture)
|
|
(defvar gesture-color rl/Color)
|
|
(defvar log-mode i32)
|
|
(defvar current-angle f32)
|
|
(defvar touch-positions [max-touch-count rl/Vector2])
|
|
|
|
;; ── The comparisons the C makes on the raw bitfield ─────────────────
|
|
;;
|
|
;; A gesture is a flag: 1, 2, 4, 8 … up to 512, so the ranges are the C's way
|
|
;; of asking which family a gesture belongs to. (i32 g) is what lets that be
|
|
;; written; they are named here rather than inline because a bare 255 at a
|
|
;; call site says nothing, and because a gesture raylib adds later lands in
|
|
;; the right family without this file being edited.
|
|
|
|
(defn pinch? [g rl/Gesture] bool ; the C's `> 255`
|
|
(> (i32 g) 255))
|
|
|
|
(defn swipe? [g rl/Gesture] bool ; the C's `> 15`
|
|
(> (i32 g) 15))
|
|
|
|
(defn tapish? [g rl/Gesture] bool ; the C's `< 3`
|
|
(< (i32 g) 3))
|
|
|
|
;; Two orderings these impose, both of them the C's as well. A pinch is above
|
|
;; 255 and therefore above 15, so swipe? has to be asked after the pinches
|
|
;; rather than before; and tapish? admits :none, which is 0, so it belongs
|
|
;; under a :none guard. The C's switch over single members hides both; a range
|
|
;; test cannot.
|
|
|
|
(defn gesture-name [g rl/Gesture] string
|
|
(cond
|
|
(= g :none) "None"
|
|
(= g :tap) "Tap"
|
|
(= g :double-tap) "Double Tap"
|
|
(= g :hold) "Hold"
|
|
(= g :drag) "Drag"
|
|
(= g :swipe-right) "Swipe Right"
|
|
(= g :swipe-left) "Swipe Left"
|
|
(= g :swipe-up) "Swipe Up"
|
|
(= g :swipe-down) "Swipe Down"
|
|
(= g :pinch-in) "Pinch In"
|
|
(= g :pinch-out) "Pinch Out"
|
|
:else "Unknown"))
|
|
|
|
(defn gesture-color-of [g rl/Gesture] rl/Color
|
|
(cond
|
|
(= g :tap) rl/blue
|
|
(= g :double-tap) rl/skyblue
|
|
(= g :drag) rl/lime
|
|
;; The two pinches are above 255 and so are above 15 as well: swipe? is a
|
|
;; range test and has to be asked after them, not before. The C gets this
|
|
;; for free by being a switch over single members.
|
|
(= g :pinch-in) rl/violet
|
|
(= g :pinch-out) rl/orange
|
|
(swipe? g) rl/red
|
|
:else rl/black))
|
|
|
|
;; ── The log ─────────────────────────────────────────────────────────
|
|
|
|
;; The C's four log modes, as a truth table rather than as nested ifs:
|
|
;; 0 shows repeated events
|
|
;; 1 hides repeated events
|
|
;; 2 shows repeated events but hides hold
|
|
;; 3 hides repeated events and hides hold
|
|
(defn should-log? [g rl/Gesture] bool
|
|
(cond
|
|
(= g :none) false
|
|
(= log-mode 3) (or (and (not (= g :hold)) (not (= g previous-gesture)))
|
|
(tapish? g))
|
|
(= log-mode 2) (not (= g :hold))
|
|
(= log-mode 1) (not (= g previous-gesture))
|
|
:else true))
|
|
|
|
(defn push-log [g rl/Gesture] ()
|
|
(set previous-gesture g)
|
|
(set gesture-color (gesture-color-of g))
|
|
(when (<= gesture-log-index 0) (set gesture-log-index gesture-log-size))
|
|
(set gesture-log-index (- gesture-log-index 1))
|
|
(set (at gesture-log gesture-log-index) (gesture-name g)))
|
|
|
|
;; ── Drawing ─────────────────────────────────────────────────────────
|
|
|
|
(defconst last-x 165)
|
|
(defconst last-y 130)
|
|
(defconst prot-x f32 266.0)
|
|
(defconst prot-y f32 315.0)
|
|
(defconst angle-length f32 90.0)
|
|
|
|
(defn swipe-box [gx i32 gy i32 which rl/Gesture] ()
|
|
(rl/draw-rectangle gx gy 20 20
|
|
(if (= last-gesture which) rl/red rl/lightgray)))
|
|
|
|
(defn draw-last-gesture [touch-count i32] ()
|
|
(rl/draw-text "Last gesture" (+ last-x 33) (- last-y 47) 20 rl/black)
|
|
(rl/draw-text "Swipe Tap Pinch Touch" (+ last-x 17)
|
|
(- last-y 18) 10 rl/black)
|
|
|
|
(swipe-box (+ last-x 20) last-y :swipe-up)
|
|
(swipe-box last-x (+ last-y 20) :swipe-left)
|
|
(swipe-box (+ last-x 40) (+ last-y 20) :swipe-right)
|
|
(swipe-box (+ last-x 20) (+ last-y 40) :swipe-down)
|
|
|
|
(rl/draw-circle (+ last-x 80) (+ last-y 16) 10.0
|
|
(if (= last-gesture :tap) rl/blue rl/lightgray))
|
|
;; segments 0 lets raylib pick the count from the radius.
|
|
(rl/draw-ring (rl/Vector2 {.x (f32 (+ last-x 103)) .y (f32 (+ last-y 16))})
|
|
6.0 11.0 0.0 360.0 0
|
|
(if (= last-gesture :drag) rl/lime rl/lightgray))
|
|
(rl/draw-circle (+ last-x 80) (+ last-y 43) 10.0
|
|
(if (= last-gesture :double-tap) rl/skyblue rl/lightgray))
|
|
(rl/draw-circle (+ last-x 103) (+ last-y 43) 10.0
|
|
(if (= last-gesture :double-tap) rl/skyblue rl/lightgray))
|
|
|
|
;; The two pairs of arrowheads, pointing outward for pinch-out and inward
|
|
;; for pinch-in. Counter-clockwise winding, or raylib culls them.
|
|
(let [out-c (if (= last-gesture :pinch-out) rl/orange rl/lightgray)
|
|
in-c (if (= last-gesture :pinch-in) rl/violet rl/lightgray)]
|
|
(rl/draw-triangle (rl/Vector2 {.x (f32 (+ last-x 122)) .y (f32 (+ last-y 16))})
|
|
(rl/Vector2 {.x (f32 (+ last-x 137)) .y (f32 (+ last-y 26))})
|
|
(rl/Vector2 {.x (f32 (+ last-x 137)) .y (f32 (+ last-y 6))})
|
|
out-c)
|
|
(rl/draw-triangle (rl/Vector2 {.x (f32 (+ last-x 147)) .y (f32 (+ last-y 6))})
|
|
(rl/Vector2 {.x (f32 (+ last-x 147)) .y (f32 (+ last-y 26))})
|
|
(rl/Vector2 {.x (f32 (+ last-x 162)) .y (f32 (+ last-y 16))})
|
|
out-c)
|
|
(rl/draw-triangle (rl/Vector2 {.x (f32 (+ last-x 125)) .y (f32 (+ last-y 33))})
|
|
(rl/Vector2 {.x (f32 (+ last-x 125)) .y (f32 (+ last-y 53))})
|
|
(rl/Vector2 {.x (f32 (+ last-x 140)) .y (f32 (+ last-y 43))})
|
|
in-c)
|
|
(rl/draw-triangle (rl/Vector2 {.x (f32 (+ last-x 144)) .y (f32 (+ last-y 43))})
|
|
(rl/Vector2 {.x (f32 (+ last-x 159)) .y (f32 (+ last-y 53))})
|
|
(rl/Vector2 {.x (f32 (+ last-x 159)) .y (f32 (+ last-y 33))})
|
|
in-c))
|
|
|
|
;; Four pips, one per simultaneous touch raylib reports.
|
|
(dotimes [i 4]
|
|
(rl/draw-circle (+ last-x 180) (+ (+ last-y 7) (* i 15)) 5.0
|
|
(if (<= touch-count i) rl/lightgray gesture-color))))
|
|
|
|
(defn draw-log [] ()
|
|
(rl/draw-text "Log" 10 10 20 rl/black)
|
|
;; Forward from the newest, wrapping — the inverted queue read the right way
|
|
;; round.
|
|
(dotimes [i gesture-log-size]
|
|
(let [ii (% (+ gesture-log-index i) gesture-log-size)]
|
|
(rl/draw-text (at gesture-log ii) 10 (- (+ 10 410) (* i 20)) 20
|
|
(if (= i 0) gesture-color rl/lightgray))))
|
|
|
|
;; The two mode buttons. Maroon means the mode that button controls is on.
|
|
(let [b1 (rl/Rectangle {.x 53.0 .y 7.0 .width 48.0 .height 26.0})
|
|
b2 (rl/Rectangle {.x 108.0 .y 7.0 .width 36.0 .height 26.0})]
|
|
(rl/draw-rectangle-rec b1 (if (or (= log-mode 1) (= log-mode 3))
|
|
rl/maroon rl/gray))
|
|
(rl/draw-text "Hide" 60 10 10 rl/white)
|
|
(rl/draw-text "Repeat" 60 20 10 rl/white)
|
|
(rl/draw-rectangle-rec b2 (if (or (= log-mode 2) (= log-mode 3))
|
|
rl/maroon rl/gray))
|
|
(rl/draw-text "Hide" 115 10 10 rl/white)
|
|
(rl/draw-text "Hold" 115 20 10 rl/white)))
|
|
|
|
(defn draw-protractor [] ()
|
|
(rl/draw-text "Angle" (+ (i32 prot-x) 55) (+ (i32 prot-y) 76) 10 rl/black)
|
|
;; The C's TextFormat/TextFindIndex/TextSubtext dance to get two decimals,
|
|
;; in one call. It rounds where the C truncated, so the last digit can
|
|
;; differ by one.
|
|
(d/draw-f32 current-angle 2 (+ (i32 prot-x) 55) (+ (i32 prot-y) 92) 20
|
|
gesture-color)
|
|
|
|
(rl/draw-circle-v (rl/Vector2 {.x prot-x .y prot-y}) 80.0 rl/white)
|
|
(rl/draw-line-ex (rl/Vector2 {.x (- prot-x 90.0) .y prot-y})
|
|
(rl/Vector2 {.x (+ prot-x 90.0) .y prot-y}) 3.0 rl/lightgray)
|
|
(rl/draw-line-ex (rl/Vector2 {.x prot-x .y (- prot-y 90.0)})
|
|
(rl/Vector2 {.x prot-x .y (+ prot-y 90.0)}) 3.0 rl/lightgray)
|
|
(rl/draw-line-ex (rl/Vector2 {.x (- prot-x 80.0) .y (- prot-y 45.0)})
|
|
(rl/Vector2 {.x (+ prot-x 80.0) .y (+ prot-y 45.0)}) 3.0
|
|
rl/green)
|
|
(rl/draw-line-ex (rl/Vector2 {.x (- prot-x 80.0) .y (+ prot-y 45.0)})
|
|
(rl/Vector2 {.x (+ prot-x 80.0) .y (- prot-y 45.0)}) 3.0
|
|
rl/green)
|
|
|
|
(rl/draw-text "0" (+ (i32 prot-x) 96) (- (i32 prot-y) 9) 20 rl/black)
|
|
(rl/draw-text "30" (+ (i32 prot-x) 74) (- (i32 prot-y) 68) 20 rl/black)
|
|
(rl/draw-text "90" (- (i32 prot-x) 11) (- (i32 prot-y) 110) 20 rl/black)
|
|
(rl/draw-text "150" (- (i32 prot-x) 100) (- (i32 prot-y) 68) 20 rl/black)
|
|
(rl/draw-text "180" (- (i32 prot-x) 124) (- (i32 prot-y) 9) 20 rl/black)
|
|
(rl/draw-text "210" (- (i32 prot-x) 100) (+ (i32 prot-y) 50) 20 rl/black)
|
|
(rl/draw-text "270" (- (i32 prot-x) 18) (+ (i32 prot-y) 92) 20 rl/black)
|
|
(rl/draw-text "330" (+ (i32 prot-x) 72) (+ (i32 prot-y) 50) 20 rl/black)
|
|
|
|
;; The needle. The C's +90 puts 0 degrees on the right, and sin feeding x
|
|
;; against cos feeding y is what rotates it the way the dial is labelled.
|
|
(unless (= current-angle 0.0)
|
|
(let [rad (/ (* (+ current-angle 90.0) pi) 180.0)]
|
|
(rl/draw-line-ex (rl/Vector2 {.x prot-x .y prot-y})
|
|
(rl/Vector2 {.x (+ (* angle-length (sin-f32 rad)) prot-x)
|
|
.y (+ (* angle-length (cos-f32 rad)) prot-y)})
|
|
3.0 gesture-color))))
|
|
|
|
(defn main [] ()
|
|
(rl/init-window screen-width screen-height
|
|
"raylib [core] example - input gestures testbed")
|
|
(defer (rl/close-window))
|
|
|
|
;; A zeroed Color has an alpha of 0 and is invisible; the C initialises this
|
|
;; to opaque black. Same for the log index, which starts at the SIZE.
|
|
(set gesture-color rl/black)
|
|
(set gesture-log-index gesture-log-size)
|
|
(set log-mode 1)
|
|
|
|
(rl/set-target-fps 60)
|
|
|
|
(let [b1 (rl/Rectangle {.x 53.0 .y 7.0 .width 48.0 .height 26.0})
|
|
b2 (rl/Rectangle {.x 108.0 .y 7.0 .width 36.0 .height 26.0})]
|
|
(until (rl/window-should-close?)
|
|
;; Update
|
|
(let [g (rl/get-gesture-detected)
|
|
touch-count (min max-touch-count (rl/get-touch-point-count))]
|
|
|
|
;; The C filters hold out of the "last gesture" display, because hold
|
|
;; repeats every frame and would drown everything else.
|
|
(when (and (and (not (= g :none)) (not (= g :hold)))
|
|
(not (= g previous-gesture)))
|
|
(set last-gesture g))
|
|
|
|
;; The two mode buttons toggle one bit each of log-mode.
|
|
(when (rl/mouse-button-released? :left)
|
|
(let [m (rl/get-mouse-position)]
|
|
(when (rl/collision-point-rec? m b1)
|
|
(set log-mode (cond (= log-mode 3) 2
|
|
(= log-mode 2) 3
|
|
(= log-mode 1) 0
|
|
:else 1)))
|
|
(when (rl/collision-point-rec? m b2)
|
|
(set log-mode (cond (= log-mode 3) 1
|
|
(= log-mode 2) 0
|
|
(= log-mode 1) 3
|
|
:else 2)))))
|
|
|
|
(when (should-log? g) (push-log g))
|
|
|
|
;; The protractor reads the pinch angle for a pinch, the drag angle for
|
|
;; a swipe, and sits at 0 for everything else. These are the C's
|
|
;; `> 255` / `> 15` / `> 0` — see the header for why they are spelled
|
|
;; this way.
|
|
(cond
|
|
(pinch? g) (set current-angle (rl/get-gesture-pinch-angle))
|
|
(swipe? g) (set current-angle (rl/get-gesture-drag-angle))
|
|
(not (= g :none)) (set current-angle 0.0)
|
|
:else (do))
|
|
|
|
(dotimes [i touch-count]
|
|
(set (at touch-positions i) (rl/get-touch-position i)))
|
|
|
|
;; Draw
|
|
(rl/begin-drawing)
|
|
(rl/clear-background rl/raywhite)
|
|
|
|
(rl/draw-text "*" 165 12 10 rl/black)
|
|
(rl/draw-text "Example optimized for Web/HTML5\non Smartphones with Touch Screen."
|
|
175 12 10 rl/black)
|
|
(rl/draw-text "*" 165 42 10 rl/black)
|
|
(rl/draw-text "While running on Desktop Web Browsers,\ninspect and turn on Touch Emulation."
|
|
175 42 10 rl/black)
|
|
|
|
(draw-last-gesture touch-count)
|
|
(draw-log)
|
|
(draw-protractor)
|
|
|
|
;; The pointer itself: every live touch, or the mouse when there is no
|
|
;; touchscreen. The halo is the gesture colour faded, which is what
|
|
;; `fade` was bound for.
|
|
(unless (= g :none)
|
|
(if (> touch-count 0)
|
|
(do
|
|
(dotimes [i touch-count]
|
|
(let [p (at touch-positions i)]
|
|
(rl/draw-circle-v p 50.0 (rl/fade gesture-color 0.5))
|
|
(rl/draw-circle-v p 5.0 gesture-color)))
|
|
;; Two fingers: the line between them, thinner while pinching
|
|
;; out, which is the C's only use of the raw 512.
|
|
(when (= touch-count 2)
|
|
(rl/draw-line-ex (at touch-positions 0) (at touch-positions 1)
|
|
(if (= g :pinch-out) 8.0 12.0) gesture-color)))
|
|
(let [m (rl/get-mouse-position)]
|
|
(rl/draw-circle-v m 35.0 (rl/fade gesture-color 0.5))
|
|
(rl/draw-circle-v m 5.0 gesture-color))))
|
|
|
|
(rl/end-drawing)))))
|