summaryrefslogtreecommitdiff
path: root/gnu/build/marionette.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2016-11-23 13:56:42 +0100
committerLudovic Courtès <ludo@gnu.org>2016-11-23 21:13:18 +0100
commitfe933833504c90eb40b0d2c71847675b31c142b4 (patch)
tree4b776d6adea59fd6aa68391b80058abc2a997d9c /gnu/build/marionette.scm
parentf25c9ebc805565ae517c87c6b904bde0661bee46 (diff)
marionette: Add 'marionette-screen-text' using OCR.
* gnu/build/marionette.scm (marionette-screen-text): New procedure. * gnu/tests/base.scm (run-basic-test)["screen text"]: New test.
Diffstat (limited to 'gnu/build/marionette.scm')
-rw-r--r--gnu/build/marionette.scm33
1 files changed, 33 insertions, 0 deletions
diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index 70b737fc57..8070b6b439 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -21,10 +21,12 @@
#:use-module (srfi srfi-26)
#:use-module (rnrs io ports)
#:use-module (ice-9 match)
+ #:use-module (ice-9 popen)
#:export (marionette?
make-marionette
marionette-eval
marionette-control
+ marionette-screen-text
%qwerty-us-keystrokes
marionette-type))
@@ -171,6 +173,37 @@ pcsys_monitor\")."
(newline monitor)
(wait-for-monitor-prompt monitor))))
+(define* (marionette-screen-text marionette
+ #:key
+ (ocrad "ocrad"))
+ "Take a screenshot of MARIONETTE, perform optical character
+recognition (OCR), and return the text read from the screen as a string. Do
+this by invoking OCRAD (file name for GNU Ocrad's command)"
+ (define (random-file-name)
+ (string-append "/tmp/marionette-screenshot-"
+ (number->string (random (expt 2 32)) 16)
+ ".ppm"))
+
+ (let ((image (random-file-name)))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (marionette-control (string-append "screendump " image)
+ marionette)
+
+ ;; Tell Ocrad to invert the image colors (make it black on white) and
+ ;; to scale the image up, which significantly improves the quality of
+ ;; the result. In spite of this, be aware that OCR confuses "y" and
+ ;; "V" and sometimes erroneously introduces white space.
+ (let* ((pipe (open-pipe* OPEN_READ ocrad
+ "-i" "-s" "10" image))
+ (text (get-string-all pipe)))
+ (unless (zero? (close-pipe pipe))
+ (error "'ocrad' failed" ocrad))
+ text))
+ (lambda ()
+ (false-if-exception (delete-file image))))))
+
(define %qwerty-us-keystrokes
;; Maps "special" characters to their keystrokes.
'((#\newline . "ret")