From dda8b325b562d957250c05a26a702f4536d5601e Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 2 Aug 2022 20:19:42 +0200
Subject: Add handling of graphical chars.

---
 img-parse.scm | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 81 insertions(+)
 create mode 100644 img-parse.scm

(limited to 'img-parse.scm')

diff --git a/img-parse.scm b/img-parse.scm
new file mode 100644
index 0000000..4033c41
--- /dev/null
+++ b/img-parse.scm
@@ -0,0 +1,81 @@
+(define-module (img-parse)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-88)
+  :use-module (v3)
+  :use-module (hnh util)
+  :use-module (cv)
+  :export (parse-immage
+           parse-image-file
+           lookup-table))
+
+
+(define colors
+  `((B . ,(v3 0 0 255))
+    (BL . ,(v3 0 0 0))
+    (C . ,(v3 0 255 255))
+    (G . ,(v3 0 255 0))
+    (M . ,(v3 255 0 255))
+    (R . ,(v3 255 0 0))
+    (W . ,(v3 255 255 255))
+    (Y . ,(v3 255 255 0))))
+
+
+(define (parse-image img)
+  (reverse
+   (map (lambda (pair)
+          (let ((v (apply v3
+                          (map (lambda (i) (im-ref img (car pair) (cadr pair) i))
+                               (iota 3)))))
+            (car
+             (find-min
+              (map (lambda (c) (cons (car c) (abs (- v (cdr c)))))
+                   colors)
+              cdr))))
+        (cross-product
+         (list 0 (floor-quotient (im-height img) 2) (1- (im-height img)))
+         (list 0 (1- (im-width img)))))))
+
+(define parse-image-file (compose parse-image im-load))
+
+;; (parse-image img)
+;; => (W W W W B W)
+;; A B
+;; C D
+;; E F
+
+
+;; (define img (im-load "/home/hugo/.cache/texttv/img/15963642.gif"))
+
+
+;; bas 16
+;;  1  2
+;;  4  8
+;; 10 20
+
+(define (range from to)
+  (iota (1+ (- to from)) from))
+
+
+;; scheme@(img-parse) [5]> (map (lambda (x) (cons x (vector-ref v x))) (iota (vector-length v)))
+
+(define lookup-table
+  (let ((v (make-vector (expt 2 6))))
+
+    (vector-set! v 0 #\space)
+    ;; right half block
+    (vector-set! v #x15 (integer->char #x2590))
+    ;; left half block, should technically be U+2586, but the API
+    ;; works on the assumption that that character doesn't exist,
+    ;; and instead outputs an inverted right half block
+    (vector-set! v #x2a (integer->char #x2590))
+    ;; Full block, same argument about inversion as above
+    (vector-set! v #x3f #\space) ; but inverted
+
+    (for-each (lambda (x) (vector-set! v x (integer->char (+ x -1 #x1fb00))))
+              (range 1 #x14))
+    (for-each (lambda (x) (vector-set! v x (integer->char (+ x -2 #x1fb00))))
+              (range #x16 #x29))
+    (for-each (lambda (x) (vector-set! v x (integer->char (+ x -3 #x1fb00))))
+              (range #x2b #x3e))
+
+    v))
-- 
cgit v1.2.3