diff --git a/build.ss b/build.ss new file mode 100755 index 0000000..d0b2239 --- /dev/null +++ b/build.ss @@ -0,0 +1,8 @@ +#!/usr/bin/env gxi + +(import :std/build-script) + +(defbuild-script + '("uniplot/braille" + "uniplot/lineplot") + optimize: #t) diff --git a/demo.ss b/demo.ss new file mode 100755 index 0000000..3a32cc5 --- /dev/null +++ b/demo.ss @@ -0,0 +1,13 @@ +#!/usr/bin/env gxi + +(export main) + +(import :std/misc/string + :dlozeve/fancy/format + :dlozeve/uniplot/lineplot) + +(def (main . args) + (let* ((xs (iota 1000 0 0.01)) + (ys1 (map cos xs)) + (ys2 (map sin xs))) + (displayln (line-plot [xs ys1 ys2])))) diff --git a/uniplot/braille.ss b/uniplot/braille.ss new file mode 100644 index 0000000..b13c2a4 --- /dev/null +++ b/uniplot/braille.ss @@ -0,0 +1,60 @@ +(export #t) + +(import :std/iter + :std/misc/list + :std/misc/string + :gerbil/gambit/hvectors + :gerbil/gambit/bits + :dlozeve/fancy/format) + +(def +braille-signs+ + (list->u8vector (map (lambda (c) (- (char->integer c) (char->integer #\⠀))) + (string->list "⡀⠄⠂⠁⢀⠠⠐⠈")))) + +(def (make-braille-canvas n m) + (def canvas-n (+ (quotient n 4) (if (zero? (remainder n 4)) 0 1))) + (def canvas-m (+ (quotient m 2) (if (zero? (remainder m 2)) 0 1))) + (def vec (make-vector canvas-n #f)) + (for ((i (in-range canvas-n))) + (vector-set! vec i (make-u8vector canvas-m 0))) + vec) + +(def (braille-canvas-ref canvas i j) + (def c (u8vector-ref (vector-ref canvas (quotient i 4)) (quotient j 2))) + (def offset (u8vector-ref +braille-signs+ + (+ (remainder i 4) (* 4 (remainder j 2))))) + (any-bits-set? c offset)) + +(def (braille-canvas-set! canvas i j v) + (def old-offset (u8vector-ref (vector-ref canvas (quotient i 4)) (quotient j 2))) + (def update-offset (u8vector-ref +braille-signs+ + (+ (remainder i 4) (* 4 (remainder j 2))))) + (def new-char (if v + (bitwise-ior old-offset update-offset) + (bitwise-and old-offset (bitwise-not update-offset)))) + (u8vector-set! (vector-ref canvas (quotient i 4)) (quotient j 2) new-char)) + +(def (canvas->string canvas) + (def chars (for/collect ((i (in-range (vector-length canvas) 0 -1))) + (def row (vector-ref canvas (1- i))) + (for/collect ((j (in-range (u8vector-length row)))) + (integer->char (+ (char->integer #\⠀) (u8vector-ref row j)))))) + (list->string (flatten (map (lambda (l) (append1 l #\newline)) chars)))) + +(def (indexf pred . lsts) + (find pred (apply map list lsts))) + +(def (canvases->string canvases (colors '(red green cyan yellow magenta white))) + (def canvases-str (map canvas->string canvases)) + (def size (string-length (car canvases-str))) + (apply str + (for/collect ((i (in-range size))) + (let* ((characters (map (lambda (s) (string-ref s i)) canvases-str)) + (char-color (indexf (lambda (x) (or (char=? (car x) #\newline) + (char>? (car x) #\⠀))) + characters colors))) + (if char-color + (str (graphics-style [(cadr char-color)]) + (car char-color) + (graphics-style)) + #\⠀))))) diff --git a/uniplot/lineplot.ss b/uniplot/lineplot.ss new file mode 100644 index 0000000..ece0da4 --- /dev/null +++ b/uniplot/lineplot.ss @@ -0,0 +1,42 @@ +(export #t) + +(import :std/iter + :std/misc/list + :std/misc/string + :dlozeve/uniplot/braille + :dlozeve/fancy/format) + +(def (scale-fn lo hi) + (lambda (x) (/ (- x lo) (- hi lo)))) + +(def (draw-canvas xs ys x-scale-fn y-scale-fn width: (width 160) height: (height 80)) + (def canvas (make-braille-canvas (1+ height) (1+ width))) + (for ((x xs) (y ys)) + (braille-canvas-set! canvas + (inexact->exact (floor (* height (y-scale-fn y)))) + (inexact->exact (floor (* width (x-scale-fn x)))) + #t)) + canvas) + +(def (line-plot lsts width: (width 160) height: (height 80)) + (match lsts + ([ys] (canvas->string + (draw-canvas (iota (length ys)) ys + (scale-fn 0 (length ys)) + (scale-fn (apply min ys) (apply max ys)) + width: width height: height))) + ([xs ys] (canvas->string + (draw-canvas xs ys + (scale-fn (apply min xs) (apply max xs)) + (scale-fn (apply min ys) (apply max ys)) + width: width height: height))) + ([xs . yss] + (canvases->string + (let* ((x-scale-fn (scale-fn (apply min xs) (apply max xs))) + (all-ys (flatten yss)) + (min-ys (apply min all-ys)) + (max-ys (apply max all-ys)) + (y-scale-fn (scale-fn min-ys max-ys))) + (for/collect ((ys yss)) + (draw-canvas xs ys x-scale-fn y-scale-fn + width: width height: height)))))))