diff options
| -rw-r--r-- | gnu/build/marionette.scm | 33 | ||||
| -rw-r--r-- | gnu/tests/base.scm | 16 |
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))))) |