Joseph Ferano
5d65dcf1c8
The gestures testbed declared sinf and cosf at the top of its own file, which is a copy in every file that wants an angle. The reason sqrt is a declare does not transplant: IEEE-754 makes sqrt correctly rounded and requires nothing of the kind for sinf, so these two are the one place in the prelude where native and wasm32 may disagree bit for bit. That is written down beside them, along with what the fix would be if a program ever needs trig that agrees across targets. Float abs stays unwrapped for the reason integer abs is -- it is (max x (- 0.0 x)) over two builtins. The integer caveat does not carry over and the note says so: -0.0 answers +0.0 and a NaN answers a NaN, both checked.
342 lines
16 KiB
Plaintext
342 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 does not convert to an integer.** 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
|
|
;;;;
|
|
;;;; i32 converts a number, found rl/Gesture
|
|
;;;;
|
|
;;;; so none of those comparisons can be written. They are spelled out below as
|
|
;;;; named predicates over keyword equalities — `pinch?`, `swipe?`, `tapish?`.
|
|
;;;; That is arguably better source than the magic numbers were, and it is
|
|
;;;; strictly more checkable, but it is not a choice: it is the only shape
|
|
;;;; available, and a gesture raylib adds later would silently fall out of
|
|
;;;; `swipe?` where the C's `> 15` would have caught it.
|
|
;;;;
|
|
;;;; **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 ─────────────────
|
|
;;
|
|
;; See the header: an rl/Gesture will not convert to an i32, so `> 255` and
|
|
;; friends are these instead.
|
|
|
|
(defn pinch? [g rl/Gesture] bool ; the C's `> 255`
|
|
(or (= g :pinch-in) (= g :pinch-out)))
|
|
|
|
(defn swipe? [g rl/Gesture] bool ; the C's `> 15`
|
|
(or (or (= g :swipe-right) (= g :swipe-left))
|
|
(or (= g :swipe-up) (= g :swipe-down))))
|
|
|
|
(defn tapish? [g rl/Gesture] bool ; the C's `< 3`
|
|
(or (= g :tap) (= g :double-tap)))
|
|
|
|
(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
|
|
(swipe? g) rl/red
|
|
(= g :pinch-in) rl/violet
|
|
(= g :pinch-out) rl/orange
|
|
: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)))))
|