1 files changed, 115 insertions, 0 deletions
diff --git a/extract-green-color.scm b/extract-green-color.scm
new file mode 100755
index 0000000..2d56d6b
--- /dev/null
+++ b/extract-green-color.scm
@@ -0,0 +1,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:
+  -m, --hue-minus       hue threshold to express distance to red (default 60)
+  -p, --hue-plus        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 1.0~%"))
+
+(define (main args)
+  (let* ((option-spec `((version (single-char #\V))
+                        (help (single-char #\h))
+                        (hue-minus (single-char #\m) (value #t) (predicate ,string->number))
+                        (hue-plus (single-char #\p) (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-minus "60"))
+                                    (string->number (option-ref options 'hue-plus "60"))
+                                    (string->number (option-ref options 'saturation "0.0"))
+                                    (string->number (option-ref options 'value "0.0")))
+               output-file))))