| Paint glimmer with nothing under it f554a01 nandi 12d ago | 1 | (ns glimmer-gfx.raster |
| 2 | "Software rasterizer over an int-array of 0xRRGGBB. Nothing here knows what |
| 3 | a window is -- and nothing here calls into Java. aget/aset/int-array/abs are |
| 4 | all clojure.core; the ^ints/^long hints are hints, not calls." |
| 5 | (:require [clojure.string :as str])) |
| 6 | |
| 7 | (defrecord Buf [^ints px ^long w ^long h]) |
| 8 | |
| 9 | (defn buf [w h] (->Buf (int-array (* w h)) w h)) |
| 10 | |
| 11 | (defn clear [{:keys [^ints px]} ^long c] |
| 12 | (let [c (int c)] (dotimes [i (alength px)] (aset px i c)))) |
| 13 | |
| 14 | (defn px! |
| 15 | [{:keys [^ints px ^long w ^long h]} ^long x ^long y ^long c] |
| 16 | (when (and (>= x 0) (< x w) (>= y 0) (< y h)) |
| 17 | (aset px (unchecked-add (unchecked-multiply y w) x) (int c)))) |
| 18 | |
| 19 | (defn rect! |
| 20 | "Filled, clipped." |
| 21 | [{:keys [^ints px ^long w ^long h]} x0 y0 rw rh c] |
| 22 | (let [x1 (min w (+ x0 rw)) y1 (min h (+ y0 rh)) |
| 23 | c (int c)] |
| 24 | (loop [y (max 0 y0)] |
| 25 | (when (< y y1) |
| 26 | (let [row (unchecked-multiply y w)] |
| 27 | (loop [x (max 0 x0)] |
| 28 | (when (< x x1) |
| 29 | (aset px (unchecked-add row x) c) |
| 30 | (recur (inc x))))) |
| 31 | (recur (inc y)))))) |
| 32 | |
| 33 | (defn line! |
| 34 | "Bresenham. ponytail: no AA -- add Wu's if the jaggies bother you." |
| 35 | [b x0 y0 x1 y1 c] |
| 36 | (let [dx (abs (- x1 x0)) dy (- (abs (- y1 y0))) |
| 37 | sx (if (< x0 x1) 1 -1) sy (if (< y0 y1) 1 -1)] |
| 38 | (loop [x x0 y y0 err (+ dx dy)] |
| 39 | (px! b x y c) |
| 40 | (when-not (and (= x x1) (= y y1)) |
| 41 | (let [e2 (* 2 err)] |
| 42 | (recur (if (>= e2 dy) (+ x sx) x) |
| 43 | (if (<= e2 dx) (+ y sy) y) |
| 44 | (cond-> err (>= e2 dy) (+ dy) (<= e2 dx) (+ dx)))))))) |
| 45 | |
| 46 | ;; ------------------------------------------------------------------ 3x5 font |
| 47 | ;; Authored as strings so a glyph is readable and fixable in place. |
| 48 | |
| 49 | (def ^:private glyphs |
| 50 | (->> ["A.#.|#.#|###|#.#|#.#" "B##.|#.#|##.|#.#|##." "C.##|#..|#..|#..|.##" |
| 51 | "D##.|#.#|#.#|#.#|##." "E###|#..|##.|#..|###" "F###|#..|##.|#..|#.." |
| 52 | "G.##|#..|#.#|#.#|.##" "H#.#|#.#|###|#.#|#.#" "I###|.#.|.#.|.#.|###" |
| 53 | "J..#|..#|..#|#.#|.#." "K#.#|#.#|##.|#.#|#.#" "L#..|#..|#..|#..|###" |
| 54 | "M#.#|###|###|#.#|#.#" "N##.|#.#|#.#|#.#|#.#" "O.#.|#.#|#.#|#.#|.#." |
| 55 | "P##.|#.#|##.|#..|#.." "Q.#.|#.#|#.#|###|.##" "R##.|#.#|##.|#.#|#.#" |
| 56 | "S.##|#..|.#.|..#|##." "T###|.#.|.#.|.#.|.#." "U#.#|#.#|#.#|#.#|.##" |
| 57 | "V#.#|#.#|#.#|#.#|.#." "W#.#|#.#|###|###|#.#" "X#.#|#.#|.#.|#.#|#.#" |
| 58 | "Y#.#|#.#|.#.|.#.|.#." "Z###|..#|.#.|#..|###" |
| 59 | "0###|#.#|#.#|#.#|###" "1.#.|##.|.#.|.#.|###" "2##.|..#|.#.|#..|###" |
| 60 | "3##.|..#|.#.|..#|##." "4#.#|#.#|###|..#|..#" "5###|#..|##.|..#|##." |
| 61 | "6.##|#..|###|#.#|###" "7###|..#|.#.|.#.|.#." "8###|#.#|###|#.#|###" |
| 62 | "9###|#.#|###|..#|##." |
| 63 | " ...|...|...|...|..." "....|...|...|...|.#." ":...|.#.|...|.#.|..." |
| 64 | "-...|...|###|...|..." "/..#|..#|.#.|#..|#.." "%#.#|..#|.#.|#..|#.#" |
| 65 | "(.#.|#..|#..|#..|.#." ")#..|.#.|.#.|.#.|#.."] |
| 66 | (map (fn [s] [(first s) (->> (subs s 1) (remove #{\|}) (partition 3) |
| 67 | (mapv str/join))])) |
| 68 | (into {}))) |
| 69 | |
| 70 | (def ^:const glyph-w 4) ; 3px + 1px gap |
| 71 | |
| 72 | (defn text! |
| 73 | "Draws s at (x,y), scaled. Unknown chars render blank." |
| 74 | ([b x y s c] (text! b x y s c 2)) |
| 75 | ([b x y s c k] |
| 76 | (let [s (str/upper-case (str s))] |
| 77 | (dotimes [i (count s)] |
| 78 | (when-let [g (glyphs (nth s i))] |
| 79 | (dotimes [row 5] |
| 80 | (dotimes [col 3] |
| 81 | (when (= \# (nth (g row) col)) |
| 82 | (rect! b (+ x (* k (+ (* i glyph-w) col))) (+ y (* k row)) k k c))))))))) |
| 83 | |
| 84 | (defn text-w ^long [s ^long k] (* k glyph-w (count s))) |