flan/examples/core-input-gestures-testbed.fln

375 lines
16 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 == :gesture-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.fln 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 `once` or a literal
;;;; with every element written out — thirty-two Vector2s, here. They are
;;;; `once`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.fln"
const screen-width = 800
const screen-height = 450
const pi: f32 = 3.14159265
const gesture-log-size = 20
const max-touch-count = 32
once gesture-log: [gesture-log-size str]
;; 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.
once gesture-log-index: i32
once previous-gesture: rl/Gesture
once last-gesture: rl/Gesture
once gesture-color: rl/Color
once log-mode: i32
once current-angle: f32
once 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.
fn is-pinch(g: rl/Gesture) -> bool ; the C's `> 255`
i32(g) > 255
fn is-swipe(g: rl/Gesture) -> bool ; the C's `> 15`
i32(g) > 15
fn is-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 is-swipe has to be asked after the pinches
;; rather than before; and is-tapish admits :gesture-none, which is 0, so it
;; belongs under a :gesture-none guard. The C's switch over single members
;; hides both; a range test cannot.
fn gesture-name(g: rl/Gesture) -> str
if g == :gesture-none
"None"
elif g == :gesture-tap
"Tap"
elif g == :gesture-double-tap
"Double Tap"
elif g == :gesture-hold
"Hold"
elif g == :gesture-drag
"Drag"
elif g == :gesture-swipe-right
"Swipe Right"
elif g == :gesture-swipe-left
"Swipe Left"
elif g == :gesture-swipe-up
"Swipe Up"
elif g == :gesture-swipe-down
"Swipe Down"
elif g == :gesture-pinch-in
"Pinch In"
elif g == :gesture-pinch-out
"Pinch Out"
else
"Unknown"
fn gesture-color-of(g: rl/Gesture) -> rl/Color
if g == :gesture-tap
rl/blue
elif g == :gesture-double-tap
rl/skyblue
elif g == :gesture-drag
rl/lime
;; The two pinches are above 255 and so are above 15 as well: is-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.
elif g == :gesture-pinch-in
rl/violet
elif g == :gesture-pinch-out
rl/orange
elif is-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
fn is-should-log(g: rl/Gesture) -> bool
if g == :gesture-none
false
elif log-mode == 3
(not g == :gesture-hold and not g == previous-gesture) or is-tapish(g)
elif log-mode == 2
not g == :gesture-hold
elif log-mode == 1
not g == previous-gesture
else
true
fn push-log(g: rl/Gesture) -> ()
previous-gesture = g
gesture-color = gesture-color-of(g)
if gesture-log-index <= 0
gesture-log-index = gesture-log-size
gesture-log-index -= 1
gesture-log[gesture-log-index] = gesture-name(g)
;; ── Drawing ─────────────────────────────────────────────────────────
const last-x = 165
const last-y = 130
const prot-x: f32 = 266.0
const prot-y: f32 = 315.0
const angle-length: f32 = 90.0
fn swipe-box(gx: i32, gy: i32, which: rl/Gesture) -> ()
rl/draw-rectangle(gx, gy, 20, 20,
if last-gesture == which then rl/red else rl/lightgray)
fn 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, :gesture-swipe-up)
swipe-box(last-x, last-y + 20, :gesture-swipe-left)
swipe-box(last-x + 40, last-y + 20, :gesture-swipe-right)
swipe-box(last-x + 20, last-y + 40, :gesture-swipe-down)
rl/draw-circle(last-x + 80, last-y + 16, 10.0,
if last-gesture == :gesture-tap then rl/blue else 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 == :gesture-drag then rl/lime else rl/lightgray)
rl/draw-circle(last-x + 80, last-y + 43, 10.0,
if last-gesture == :gesture-double-tap then rl/skyblue else rl/lightgray)
rl/draw-circle(last-x + 103, last-y + 43, 10.0,
if last-gesture == :gesture-double-tap then rl/skyblue else 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 == :gesture-pinch-out then rl/orange else rl/lightgray
let in-c =
if last-gesture == :gesture-pinch-in then rl/violet else 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.
for i in range(4)
rl/draw-circle(last-x + 180, (last-y + 7) + i * 15, 5.0,
if touch-count <= i then rl/lightgray else gesture-color)
fn draw-log() -> ()
rl/draw-text("Log", 10, 10, 20, rl/black)
;; Forward from the newest, wrapping — the inverted queue read the right way
;; round.
for i in range(gesture-log-size)
let ii = (gesture-log-index + i) % gesture-log-size
rl/draw-text(gesture-log[ii], 10, 10 + 410 - i * 20, 20,
if i == 0 then gesture-color else 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}
let b2 = rl/Rectangle{.x 108.0 .y 7.0 .width 36.0 .height 26.0}
rl/draw-rectangle-rec(b1,
if log-mode == 1 or log-mode == 3 then rl/maroon else 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 log-mode == 2 or log-mode == 3 then rl/maroon else rl/gray)
rl/draw-text("Hide", 115, 10, 10, rl/white)
rl/draw-text("Hold", 115, 20, 10, rl/white)
fn 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)
fn 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.
gesture-color = rl/black
gesture-log-index = gesture-log-size
log-mode = 1
rl/set-target-fps(60)
let b1 = rl/Rectangle{.x 53.0 .y 7.0 .width 48.0 .height 26.0}
let 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()
let 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.
if (not g == :gesture-none and not g == :gesture-hold) and not g == previous-gesture
last-gesture = g
;; The two mode buttons toggle one bit each of log-mode.
if rl/is-mouse-button-released(:mouse-left)
let m = rl/get-mouse-position()
if rl/check-collision-point-rec(m, b1)
log-mode =
if log-mode == 3
2
elif log-mode == 2
3
elif log-mode == 1
0
else
1
if rl/check-collision-point-rec(m, b2)
log-mode =
if log-mode == 3
1
elif log-mode == 2
0
elif log-mode == 1
3
else
2
if is-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.
if is-pinch(g)
current-angle = rl/get-gesture-pinch-angle()
elif is-swipe(g)
current-angle = rl/get-gesture-drag-angle()
elif not g == :gesture-none
current-angle = 0.0
else
()
for i in range(touch-count)
touch-positions[i] = rl/get-touch-position(i)
;; Draw
rl/with-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 == :gesture-none):
if touch-count > 0
for i in range(touch-count)
let p = 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.
if touch-count == 2
rl/draw-line-ex(touch-positions[0], touch-positions[1],
if g == :gesture-pinch-out then 8.0 else 12.0,
gesture-color)
else
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)