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
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
|
#!/usr/bin/env -S guile -e main -s
!#
;;; extract-green-color --- Extract green color from a photo of LCD Writing Tablet.
;;; Copyright © 2021 Masaya Tojo <masaya@tojo.tokyo>
;;;
;;; This file is part of extract-green-color.
;;;
;;; Extract-green-color is free software; you can redistribute
;;; it and/or modify it under the terms of the GNU General Public
;;; License as published by the Free Software Foundation; either
;;; version 3 of the License, or (at your option) any later version.
;;;
;;; Extract-green-color is distributed in the hope that it will
;;; be useful, but WITHOUT ANY WARRANTY; without even the implied
;;; warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
;;; See the GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with extract-green-color. If not, see
;;; <http://www.gnu.org/licenses/>.
(use-modules (cv)
((cv idata) #:prefix idata:)
(srfi srfi-8)
(ice-9 getopt-long)
(ice-9 match))
(define (rgb->hsv r g b)
(let* ((max* (max r g b))
(min* (min r g b)) (max-min* (- max* min*)))
(let ((h (cond
((= max* min*) #f)
((= b min*) (+ (* 60 (/ (- g r) max-min*)) 60))
((= r min*) (+ (* 60 (/ (- b g) max-min*)) 180))
(else (+ (* 60 (/ (- r b) max-min*)) 300))))
(s (/ max-min* max*))
(v (/ max* 256.0)))
(values h s v))))
(define (im-resize* img new-w)
(match img
((w h _ _)
(im-resize img new-w (floor (* h (/ new-w w)))))))
(define* (extract-green-color img
hue-minus-threshold
hue-plus-threshold
saturation-threshold
value-treshold)
(match img
((w h _ _)
(let ((out (im-make w h 3 0)))
(do ((i 0 (1+ i)))
((= i h))
(do ((j 0 (1+ j)))
((= j w))
(let ((r (im-fast-ref img i j 0))
(g (im-fast-ref img i j 1))
(b (im-fast-ref img i j 2)))
(receive (h s v) (rgb->hsv r g b)
(when (and h
(<= (- 120 hue-minus-threshold)
h
(+ 120 hue-plus-threshold))
(>= s saturation-threshold)
(>= s value-treshold))
(idata:im-fast-set! out i j 0 r)
(idata:im-fast-set! out i j 1 g)
(idata:im-fast-set! out i j 2 b))))))
out))))
(define (show-usage)
(format (current-error-port)
"Usage: extract-green-color.scm [OPTION]... input-file output-file
Extract green color from input-file and save to output-file.
Options:
-r, --hue-red hue threshold to express distance to red (default 60)
-b, --hue-blue hue threshold to express distance to blue (default 60)
-s, --saturation saturation threshold (default 0)
-v, --value value threshold (default 0)
-h, --help show this help
-V, --version show version information
"))
(define (show-version)
(format (current-error-port)
"extract-green-color.scm 2.0~%"))
(define (main args)
(let* ((option-spec `((version (single-char #\V))
(help (single-char #\h))
(hue-red (single-char #\r) (value #t) (predicate ,string->number))
(hue-blue (single-char #\b) (value #t) (predicate ,string->number))
(saturation (single-char #\s) (value #t) (predicate ,string->number))
(value (single-char #\v) (value #t) (predicate ,string->number))))
(options (getopt-long args option-spec)))
(when (option-ref options 'help #f)
(show-usage)
(exit 1))
(when (option-ref options 'version #f)
(show-version)
(exit 1))
(unless (= 2 (length (option-ref options '() '())))
(format (current-error-port) "extract-green-color.scm: non-option argument count must be 2~%")
(show-usage)
(exit 1))
(match-let (((input-file output-file) (option-ref options '() '())))
(im-save (extract-green-color (im-load input-file)
(string->number (option-ref options 'hue-red "60"))
(string->number (option-ref options 'hue-blue "60"))
(string->number (option-ref options 'saturation "0.0"))
(string->number (option-ref options 'value "0.0")))
output-file))))
|
