[bug#64356] [PATCH v3 2/4] marionette: Allow passing custom OCR arguments.

[Bruno Victal]

* gnu/build/marionette.scm (invoke-ocrad-ocr, invoke-tesseract-ocr)
(marionette-screen-text): New 'ocr-arguments' argument.
---
 gnu/build/marionette.scm | 32 +++++++++++++++++++++++---------
 1 file changed, 23 insertions(+), 9 deletions(-)

diff --git a/gnu/build/marionette.scm b/gnu/build/marionette.scm
index b8fba61d06..df69d6d17e 100644
--- a/gnu/build/marionette.scm
+++ b/gnu/build/marionette.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -287,23 +288,27 @@ (define (marionette-control command marionette)
      ;; The "quit" command terminates QEMU immediately, with no output.
      (unless (string=? command "quit") (wait-for-monitor-prompt monitor)))))
 
-(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad"))
+(define* (invoke-ocrad-ocr image #:key (ocrad "ocrad")
+                           (ocr-arguments '("--invert" "--scale=10")))
   "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)))
     (unless (zero? (close-pipe pipe))
       (error "'ocrad' failed" ocrad))
     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."
   (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
       (const #t)
       (lambda ()
         (let ((exit-val (status:exit-val
-                         (system* tesseract image output-basename))))
+                         (apply system* tesseract arguments))))
           (unless (zero? exit-val)
             (error "'tesseract' failed" tesseract))
           (call-with-input-file output-basename* get-string-all)))
@@ -311,7 +316,8 @@ (define* (invoke-tesseract-ocr image #:key (tesseract 
"tesseract"))
         (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
 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
@@ -324,14 +330,19 @@ (define* (marionette-screen-text marionette #:key (ocr 
"ocrad"))
   ;; Process it via the OCR.
   (cond
    ((string-contains ocr "ocrad")
-    (values (invoke-ocrad-ocr image #:ocrad ocr) image))
+    (values (invoke-ocrad-ocr image
+                              #:ocrad ocr
+                              #:ocr-arguments ocr-arguments) image))
    ((string-contains ocr "tesseract")
-    (values (invoke-tesseract-ocr image #:tesseract ocr) image))
+    (values (invoke-tesseract-ocr image
+                                  #:tesseract ocr
+                                  #:ocr-arguments ocr-arguments) image))
    (else (error "unsupported ocr command"))))
 
 (define* (wait-for-screen-text marionette predicate
                                #:key
                                (ocr "ocrad")
+                               ocr-arguments
                                (timeout 30)
                                pre-action
                                post-action)
@@ -359,7 +370,10 @@ (define* (wait-for-screen-text marionette predicate
                  'ocr-text: last-text
                  'screendump: screendump-backup))
         (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)))
                (result (predicate text)))
           (cond (result
-- 
2.39.2