me/guix
Archived
1
0
Fork 0
Code Activity

marionette: Allow passing custom OCR arguments.

Browse source 
* gnu/build/marionette.scm (%default-ocrad-arguments): New variable.
(invoke-ocrad-ocr, invoke-tesseract-ocr, marionette-screen-text)
[ocr-arguments]: New argument.

Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
This commit is contained in:
Bruno Victal 2023-06-30 14:58:12 +01:00 • committed by Maxim Cournoyer
parent b9bd1bcce9
commit 6a86e2d13a
No known key found for this signature in database
GPG key ID: 1260E46482E63562
1 changed files with 31 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

41
gnu/build/marionette.scm
View file

@ -1,7 +1,8 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com> ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com> ;;; Copyright © 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -36,6 +37,7 @@
wait-for-unix-socket wait-for-unix-socket
marionette-control marionette-control
wait-for-screen-text wait-for-screen-text
%default-ocrad-arguments
%qwerty-us-keystrokes %qwerty-us-keystrokes
marionette-type marionette-type
@ -287,23 +289,30 @@ Monitor\")."
;; The "quit" command terminates QEMU immediately, with no output. ;; The "quit" command terminates QEMU immediately, with no output.
(unless (string=? command "quit") (wait-for-monitor-prompt monitor))))) (unless (string=? command "quit") (wait-for-monitor-prompt monitor)))))
(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad")) (define %default-ocrad-arguments
'("--invert" "--scale=10"))
(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad")
(ocr-arguments %default-ocrad-arguments))
"Invoke the OCRAD command on image, and return the recognized text." "Invoke the OCRAD command on image, and return the recognized text."
(let* ((pipe (open-pipe* OPEN_READ ocrad "-i" "-s" "10" image)) (let* ((command (string-join `(,ocrad ,@ocr-arguments ,image)))
(pipe (open-input-pipe command))
(text (get-string-all pipe))) (text (get-string-all pipe)))
(unless (zero? (close-pipe pipe)) (unless (zero? (close-pipe pipe))
(error "'ocrad' failed" ocrad)) (error "'ocrad' failed" ocrad))
text)) text))
(define* (invoke-tesseract-ocr image #:key (tesseract "tesseract")) (define* (invoke-tesseract-ocr image #:key (tesseract "tesseract")
(ocr-arguments '()))
"Invoke the TESSERACT command on IMAGE, and return the recognized text." "Invoke the TESSERACT command on IMAGE, and return the recognized text."
(let* ((output-basename (tmpnam)) (let* ((output-basename (tmpnam))
(output-basename* (string-append output-basename ".txt"))) (output-basename* (string-append output-basename ".txt"))
(arguments (cons* image output-basename ocr-arguments)))
(dynamic-wind (dynamic-wind
(const #t) (const #t)
(lambda () (lambda ()
(let ((exit-val (status:exit-val (let ((exit-val (status:exit-val
(system* tesseract image output-basename)))) (apply system* tesseract arguments))))
(unless (zero? exit-val) (unless (zero? exit-val)
(error "'tesseract' failed" tesseract)) (error "'tesseract' failed" tesseract))
(call-with-input-file output-basename* get-string-all))) (call-with-input-file output-basename* get-string-all)))
@ -311,7 +320,8 @@ Monitor\")."
(false-if-exception (delete-file output-basename)) (false-if-exception (delete-file output-basename))
(false-if-exception (delete-file output-basename*)))))) (false-if-exception (delete-file output-basename*))))))
(define* (marionette-screen-text marionette #:key (ocr "ocrad")) (define* (marionette-screen-text marionette #:key (ocr "ocrad")
ocr-arguments)
"Take a screenshot of MARIONETTE, perform optical character "Take a screenshot of MARIONETTE, perform optical character
recognition (OCR), and return the text read from the screen as a string, along recognition (OCR), and return the text read from the screen as a string, along
the screen dump image used. Do this by invoking OCR, which should be the file the screen dump image used. Do this by invoking OCR, which should be the file
@ -324,14 +334,22 @@ if it is not needed."
;; Process it via the OCR. ;; Process it via the OCR.
(cond (cond
((string-contains ocr "ocrad") ((string-contains ocr "ocrad")
(values (invoke-ocrad-ocr image #:ocrad ocr) image)) (values (invoke-ocrad-ocr image
#:ocrad ocr
#:ocr-arguments
(or ocr-arguments %default-ocrad-arguments))
image))
((string-contains ocr "tesseract") ((string-contains ocr "tesseract")
(values (invoke-tesseract-ocr image #:tesseract ocr) image)) (values (invoke-tesseract-ocr image
#:tesseract ocr
#:ocr-arguments (or ocr-arguments '()))
image))
(else (error "unsupported ocr command")))) (else (error "unsupported ocr command"))))
(define* (wait-for-screen-text marionette predicate (define* (wait-for-screen-text marionette predicate
#:key #:key
(ocr "ocrad") (ocr "ocrad")
ocr-arguments
(timeout 30) (timeout 30)
pre-action pre-action
post-action) post-action)
@ -359,7 +377,10 @@ Likewise for POST-ACTION, except it runs at the end of a successful OCR."
'ocr-text: last-text 'ocr-text: last-text
'screendump: screendump-backup)) 'screendump: screendump-backup))
(let* ((_ (and (procedure? pre-action) (pre-action))) (let* ((_ (and (procedure? pre-action) (pre-action)))
(text screendump (marionette-screen-text marionette #:ocr ocr)) (text screendump
(marionette-screen-text marionette
#:ocr ocr
#:ocr-arguments ocr-arguments))
(_ (and (procedure? post-action) (post-action))) (_ (and (procedure? post-action) (post-action)))
(result (predicate text))) (result (predicate text)))
(cond (result (cond (result