blob: 4033c411b00c7ba029167af1e3c83a4690fecb51 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
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))
|
