Joseph Ferano
afec482722
The first ten of raylib's core list, ported. Seven new bindings and the named colour palette; nothing else was added, because a binding called by nothing is the same as not having bound it. The gaps they found are the point. No number reaches draw-text: i64->bytes answers [u8], draw-text wants a string, and nothing bridges — five of the ten wanted TextFormat and got a glyph table instead. And an enum parameter cannot be driven by a loop variable: the index is an i32, the parameter is an enum, neither converts, and a second declare-c with an i32 face is refused because one C function gets one binding. Two correct rules that compose into a wall. None of the gaps expected blocked anything: no generics, no allocator, no Vec, no escaping closure, no block-scoped defer. These are input-and-draw programs over fixed-size state, which is the shape the language has.
346 lines
16 KiB
Plaintext
346 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**, as everywhere. 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")
|
|
|
|
;; libm, as the prelude declares sqrtf. Not declare-c: these take a float and
|
|
;; answer a float in C's own convention with no struct anywhere, which is what
|
|
;; plain `declare` is for.
|
|
(declare sin-f32 [x f32] f32 "sinf")
|
|
(declare cos-f32 [x f32] f32 "cosf")
|
|
|
|
(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)))))
|