mrtex2im.ss
;; mrtex2im is a scheme port of the tex2im facility available at:
;; http://www.nought.de/tex2im.php
;;
;;
;; Paulo J. Matos <pocm@soton.ac.uk>
;; University of Southampton, UK
;;
;; Current Version: 0.3 31/05/2007
;; * Parameterized current-directory within procedures,
;;   having it parameterized on whole module, caused problems in other modules.
;; Previous Versions:
;; --> 0.2 11/03/2007
;; * Added new argument keyword to tex2im function (debug-latex-on?=
;; * Now upon error raises exceptions
;; * Sends subprocesses output to /dev/null
;; * Added doc.txt
;; * Provides (besides tex2im) all the expections and the setup parameters for the paths
;; --> 0.1 (2006)
;;
;;;;;;;;;;;;;;;;;;;;
;;
;; For more information refer to the doc.txt file
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module mrtex2im mzscheme
  ;; Scheme Port of the tex2im utility
  (require (lib "kw.ss")
           (lib "class.ss")
           (lib "process.ss")
           (lib "mred.ss" "mred")
           (lib "file.ss")
           (lib "port.ss"))
  
  (provide tex2im
           tex2im:latex-exception
           tex2im:dvips-exception
           tex2im:convert-exception
           setup-latex-path
           setup-dvips-path
           setup-convert-path)
  
  ;; Exceptions thrown
  (define tex2im:latex-exception 'tex2im:latex-exception)
  (define tex2im:dvips-exception 'tex2im:dvips-exception)
  (define tex2im:convert-exception 'tex2im:convert-exception)
  
  ;; Default paths
  (define setup-latex-path (make-parameter (build-path "/usr/bin/latex")))
  (define setup-dvips-path (make-parameter (build-path "/usr/bin/dvips")))
  (define setup-convert-path (make-parameter (build-path "/usr/bin/convert")))
  
  (define (get-string-from-port fileport)
    ;; returns a string with the file contents
    (let loop ((str "") (line (read-line fileport)))
      (if (eof-object? line)
          str
          (loop (string-append str "\n" line)
                (read-line fileport)))))
  
  ;; Displays the log file for the file name
  (define (display-latex-log-file file)
    (parameterize ([current-directory (find-system-path 'temp-dir)])
      (let* ([log-filename (string-append (path->string file) ".log")]
             [filefp (open-input-file log-filename)])
        (display (get-string-from-port filefp))
        (close-input-port filefp))))
  
  ;; Given a file path with latex code returns a path with the respective eps file.
  (define (run-latex/dvips file debug-latex-on?)
    (parameterize ([current-directory (find-system-path 'temp-dir)])
      (let ([dvi-file (string-append (path->string file) ".dvi")]
            [eps-file (string-append (path->string file) ".eps")])
        (cond [(not (zero? (parameterize ((current-output-port (open-output-nowhere))
                                          (current-error-port (open-output-nowhere))) ;; Sends output to null
                             (system*/exit-code (setup-latex-path) "-interaction=batchmode" (path->string file)))))
               (printf "WARNING: Error generating latex file.~n")
               (if debug-latex-on? ;; debug is on so output log
                   (begin 
                     (printf "DEBUG: Here's latex log file:~n")
                     (display-latex-log-file file)))
               (raise tex2im:latex-exception)]
              [(not (zero? (parameterize ((current-output-port (open-output-nowhere))
                                          (current-error-port (open-output-nowhere))) ;; Sends output to null
                             (system*/exit-code (setup-dvips-path) "-o" eps-file "-E" dvi-file))))
               (printf "WARNING: Error generating eps file.~n")
               (raise tex2im:dvips-exception)]
              [else ;; everything went fine
               eps-file]))))
  
  (define (run-convert trans? aa? bgcolor res file)
    (parameterize ([current-directory (find-system-path 'temp-dir)])
      (let ([png-file (string-append file ".png")])
        (if trans?
            (parameterize ((current-output-port (open-output-nowhere))
                           (current-error-port (open-output-nowhere)))
              (system*/exit-code (setup-convert-path)
                                 "+adjoin"
                                 (if aa? "-antialias" "+antialias")
                                 "-transparent" bgcolor
                                 "-density"
                                 res
                                 file
                                 png-file))
            (parameterize ((current-output-port (open-output-nowhere))
                           (current-error-port (open-output-nowhere)))
              (system*/exit-code (setup-convert-path)
                                 "+adjoin"
                                 (if aa? "-antialias" "+antialias")
                                 "-density"
                                 res
                                 file
                                 png-file)))
        png-file)))
  
  
  (define/kw (tex2im str-or-path ;; Latex string or path to input file
                     #:key
                     [resolution "150x150"]
                     [bgcolor "white"]
                     [fgcolor "black"]
                     [transparency #f]
                     [noformula #f]
                     [anti-aliasing #t]
                     [extra-header (build-path (find-system-path 'home-dir) ".tex2im-header")]
                     [debug-latex-on? #f])
    (parameterize ([current-directory (find-system-path 'temp-dir)])
      (let ([tmp-file (make-temporary-file)])
        (with-output-to-file tmp-file
          (lambda ()
            ;; Output header
            (printf "\\documentclass[12pt]{article} \\usepackage{color} \\usepackage[dvips]{graphicx} \\pagestyle{empty}")
            ;; Output header in file
            (if (file-exists? extra-header)
                (printf (call-with-input-file extra-header
                          (lambda (fileport)
                            (get-string-from-port fileport)))))
            (printf "\\pagecolor{~a} \\begin{document} {\\color{~a}" bgcolor fgcolor)
            (if (not noformula) (printf "\\begin{eqnarray*}"))
            (if (string? str-or-path)
                ;; latex code is in string
                (printf str-or-path)
                ;; latex code is in file
                (printf (call-with-input-file str-or-path
                          (lambda (fileport)
                            (get-string-from-port fileport)))))
            (if (not noformula) (printf "\\end{eqnarray*}"))
            (printf "}\\end{document}"))
          'truncate)
        (make-object bitmap%
          (run-convert transparency anti-aliasing bgcolor resolution 
                       (run-latex/dvips tmp-file debug-latex-on?))
          'png
          #f))))
  )