mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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.
This commit is contained in:
parent
f25c9ebc80
commit
fe93383350
2 changed files with 49 additions and 0 deletions
|
@ -21,10 +21,12 @@ (define-module (gnu build marionette)
|
|||
#: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 @@ (define (marionette-control command marionette)
|
|||
(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")
|
||||
|
|
|
@ -31,6 +31,8 @@ (define-module (gnu tests base)
|
|||
#: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 @@ (define marionette
|
|||
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)))))
|
||||
|
||||
|
|
Loading…
Reference in a new issue