Joseph Ferano
d803078699
sin and cos in the prelude rather than copied per file, with the caveat sqrt does not have: IEEE-754 makes sqrt correctly rounded and requires nothing of the kind for sine, so these are the one place the prelude may disagree bit for bit between native and wasm32. A program hashing output across targets must not route the hash through one. Arithmetic folds left over as many operands as you write, and so does the constant folder, which otherwise refused (defconst n (* 2 3 4)) after the checker had accepted it. One operand is refused by name: there is no unary minus, and the message points at (- 0 x), which is what the prelude writes. The typed let binding is a grammar question and is written up rather than guessed at. The break banner premise had gone stale -- check.sh already runs that demo under a timeout and keeps what it printed.
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)))))
|