summaryrefslogtreecommitdiff
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
parentf25c9ebc805565ae517c87c6b904bde0661bee46 (diff)
downloadpatches-fe933833504c90eb40b0d2c71847675b31c142b4.tar
patches-fe933833504c90eb40b0d2c71847675b31c142b4.tar.gz
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.
-rw-r--r--gnu/build/marionette.scm33
-rw-r--r--gnu/tests/base.scm16
2 files changed, 49 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")
diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index 9a265309c0..3be1c55b41 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -31,6 +31,8 @@
#:use-module (gnu services mcron)
#:use-module (gnu services shepherd)
#:use-module (gnu services networking)
+ #:use-module (gnu packages imagemagick)
+ #:use-module (gnu packages ocr)
#:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix monads)
@@ -241,6 +243,20 @@ info --version")
marionette)
(file-exists? "tty1.ppm")))
+ (test-assert "screen text"
+ (let ((text (marionette-screen-text marionette
+ #:ocrad
+ #$(file-append ocrad
+ "/bin/ocrad"))))
+ ;; Check whether the welcome message and shell prompt are
+ ;; displayed. Note: OCR confuses "y" and "V" for instance, so
+ ;; we cannot reliably match the whole text.
+ (and (string-contains text "This is the GNU")
+ (string-contains text
+ (string-append
+ "root@"
+ #$(operating-system-host-name os))))))
+
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))