#lang scheme/base
;; Pdf page traversal using pdftoppm

(require "mfile.ss"
         "netpbm.ss"
         scheme/system)

;; External command wrappers.
(define (fsystem . args)
  (let ((cmd (apply format args)))
    ;; (printf "> ~a\n" cmd)
    (system cmd)))

(define (pdf->pam mfile first [nb 1])
  (car
   (mdir->list
    (with-mdir
     `(("doc.pdf" . ,mfile))
     (lambda ()
       (fsystem
        "pdftoppm doc.pdf -f ~a -l ~a doc ; ls -l"
        first (+ first nb -1)))))))

;; This needs netpbm original (not present in the Debian clone).

(define (csepdjvu mfile)
  (mdir-refs
   (with-mdir
    `(("in" . ,mfile))
    (lambda () (fsystem "csepdjvu -d 300 in page.djvu; ls -l page.djvu")))
   "page.djvu"))

(define (make-viewer cmd)
  (lambda (mfile)
    (with-mdir `(("doc" . ,mfile))
               (lambda () (fsystem "~a doc" cmd)))))

(define djview (make-viewer "djview"))


(define mf make-mfile)


(debug-temp-dir)


;(define p10.pam (pdf->pam (make-mfile "/tmp/test.pdf") 4))
;(define p10.djvu (pam->djvu p10.pam))

(define jpeg2djvu
  (compose csepdjvu pbmtodjvurle pamtopnm pamditherbw jpegtopnm))

(define jpegs
  (parameterize
      ((current-directory "/home/tom/healing/edit/JPG"))
    (let ((mfiles (map mf (directory-list))))
      (list (car mfiles))
      )))

(define djvus (map jpeg2djvu jpegs))


; (directory-list "/home/tom/healing/edit")