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.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
;; Previous Versions: 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)
  
  (current-directory (find-system-path 'temp-dir))
  
  ;; 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)
    (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?)
    (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)
    (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])
    (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)))
  )