#|
Copyright 2012,2013 Andrei Mikhailov

This file is part of bystroTeX.

bystroTeX is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

bystroTeX is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with bystroTeX.  If not, see <http://www.gnu.org/licenses/>.
|#

(module slides racket
  (require scribble/core scribble/base scribble/html-properties scribble/decode scriblib/render-cond)
  (require "common.rkt")
  (require setup/dirs)
  (require scribble/decode)

  (require (planet jaymccarthy/sqlite))
  (require racket/vector)
  (require racket/list)
  (require racket/dict)
  (require racket/system racket/file)

  (require racket/provide-syntax)
  
  (require (prefix-in xml: xml) (prefix-in xml: xml/path))
;; ---------------------------------------------------------------------------------------------------
                                        ; Global variables
  (provide (struct-out bystro))
  (struct bystro (
                  formula-processor
                  formula-database-name
                  formula-dir-name
                  formula-size 
                  autoalign-adjust
                  manual-base-alignment
                  )
          #:mutable)
  (provide (contract-out 
                                        ; Mutable configuration options
            [bystro-conf bystro?]))
  (define bystro-conf (bystro (find-executable-path "amkhlv-java-formula.sh")
                              "formulas.sqlite"
                              "formulas"
                              25
                              1
                              (- 2)
                              ))
  (define slide-part-number 0)
  (define slide-number 0)
  (define slidename "SLIDE")
  (define content '())
  (define formulanumber 0)
  (define formula-ref-dict '())
  (define singlepage-mode #f)
  (define running-database #f)
;; ---------------------------------------------------------------------------------------------------


;; ---------------------------------------------------------------------------------------------------
  (define (bystro-css-element-from-file filename)
    (make-element 
     (make-style #f (list (make-css-addition filename))) '())    
    )
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
                                        ; Titlepage initialization
   [bystro-titlepage-init (->* () (#:singlepage-mode boolean?) element?)]))
  (define (bystro-titlepage-init #:singlepage-mode [spm #f])
    (if spm
        (begin 
          (set! singlepage-mode #t)
          (bystro-css-element-from-file "misc.css")
          (bystro-css-element-from-file "slide.css")
          )
        (bystro-css-element-from-file "slide-title.css")
        )
    )
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
                                        ; Slide continuation after pause
   [after-pause (->* () 
                           (#:tag (or/c symbol? string? #f)) 
                           #:rest (listof (or/c part? pre-flow?) )
                           (or/c part? nested-flow?))]))  
  (define (after-pause #:tag [tg #f] . more-content)
    (set! slide-part-number (+ 1 slide-part-number))
    (when (pair? more-content)
      (set! content (append  content  more-content )))
    (let ([ stl (if (slide-part-number . < . 2) 
                    (list 'non-toc 'no-toc 'unnumbered 'hidden 'hidden-number 'quiet)
                    (list 'non-toc 'no-toc 'unnumbered 'hidden 'toc-hidden 'hidden-number 'quiet))]
          [ nm  (if (slide-part-number . < . 2)
                    slidename 
                    (if (pair? slidename) 
                        (append slidename (list " " (number->string slide-part-number)))
                        (string-append slidename " " (number->string slide-part-number))))]     
          [ tgs (if tg (list (list 'part tg)) (list)) ]
          )
      (if singlepage-mode 
          (decode (list
                   (title-decl 
                    #f 
                    tgs 
                    #f 
                    (style 
                        #f 
                      (list 'non-toc 'no-toc 'unnumbered 'hidden 'toc-hidden 'hidden-number 'quiet)) 
                    "")
                   more-content))
          ;; (decode more-content)
          (decode (list
                   (title-decl #f tgs #f (style #f stl) nm)
                   (decode content))))))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; removes the most recent after-pause
   [remove-slide (-> void?)]))
  (define (remove-slide)
    (if (pair? content) 
        (set! content (reverse (cdr (reverse content))))
        (error "nothing to remove !")))
;; ---------------------------------------------------------------------------------------------------
  (define (fn-to-collect-slide-link slide-shortname slide-title slide-num)
    (lambda (ci) 
      (collect-put! ci `(amkhlv-slide ,slide-shortname ,slide-num) slide-title)))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
                                        ; slide
            [slide (->* (content?) 
                               (#:tag (or/c symbol? string? #f) #:showtitle boolean?) 
                               #:rest (listof (or/c pre-flow? part-start?) )
                               (or/c part? nested-flow?))]))  
  (define (slide stitle #:tag [tg #f] #:showtitle [sttl #f] . init-content)
    (set! slide-number (+ 1 slide-number))
    (set! slide-part-number 0)
    (set! slidename (if tg 
                        tg 
                        (regexp-replace #px"\\s" stitle "_")))
    (if singlepage-mode         
        (decode (list
                 (title-decl 
                  #f 
                  (if tg (list (list 'part tg)) (list)) 
                  #f 
                  (style #f (list 'non-toc 'no-toc 'unnumbered 'hidden 'hidden-number 'quiet))
                  stitle)
                 (linebreak)
                 (if sttl (para (clr "blue" (larger stitle)) (linebreak)) "")
                 (bystro-css-element-from-file "misc.css")
                 (bystro-css-element-from-file "slide.css")
                 (collect-element 
                  (make-style #f '()) 
                  "" 
                  (fn-to-collect-slide-link slidename stitle slide-number))
                 init-content))
        (begin
          (set! content 
                (list 
                 (title-decl 
                  #f 
                  '() 
                  #f 
                  (style #f (list 'non-toc 'no-toc 'unnumbered 'hidden 'hidden-number 'quiet))
                  stitle)
                 (if sttl (para (clr "blue" (larger stitle)) (linebreak)) "")
                 (bystro-css-element-from-file "misc.css")
                 (bystro-css-element-from-file "slide.css")
                 (collect-element 
                  (make-style #f '()) 
                  "" 
                  (fn-to-collect-slide-link slidename stitle slide-number))
                 init-content))
          (after-pause  #:tag tg))))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; initialize formula collection dir and database
   [bystro-initialize-formula-collection 
    (-> db?)]))
  (define (bystro-initialize-formula-collection)
    (unless (directory-exists? (string->path (bystro-formula-dir-name bystro-conf)))
      (make-directory (string->path (bystro-formula-dir-name bystro-conf))))
    (let* ([mydb (open (string->path (bystro-formula-database-name bystro-conf)))]
           [query (prepare mydb "select name from SQLITE_MASTER")]
           [tbls (step* query)]
           )
      (and (not (for/or ([tbl tbls]) (equal? (vector-ref tbl 0) "formulas")))
           (exec/ignore mydb "CREATE TABLE formulas (tex, scale, filename, depth, tags)")
           )
      (finalize query)
      (set! running-database mydb)
      mydb))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; enumerate a formula
   [number-for-formula (-> string? string?)]))
  (define (number-for-formula lbl)
    (set! formulanumber (+ 1 formulanumber))
    (set! formula-ref-dict 
          (if (dict-has-key? formula-ref-dict lbl) 
              formula-ref-dict ;; do nothing if already registered such label
              (cons (cons lbl formulanumber) formula-ref-dict)))
    (string-append "(" (number->string formulanumber) ")"))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
                                        ; reference a formula
   [ref-formula (-> string? string?)]))
  (define (ref-formula lbl)
    (number->string (cdr (assoc lbl formula-ref-dict))))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
            [bystro-command-to-typeset-formula (-> path-string? string? number? string? string?)]))
  (define (bystro-command-to-typeset-formula shell-command-path texstring size filename)
    (define-values (pr outport inport errport) 
      (subprocess #f #f #f shell-command-path))
    (display "\n")
    (xml:write-xml/content
     (xml:xexpr->xml `(formula ((size ,(number->string size)) (filename ,filename)) ,texstring)))
    (xml:write-xml/content
     (xml:xexpr->xml `(formula ((size ,(number->string size)) (filename ,filename)) ,texstring)) 
     inport)
    (close-output-port inport)
    (let* (
           [report-xml (xml:read-xml outport)]
           [report-xexpr (xml:xml->xexpr (xml:document-element report-xml))]
           [found-error (xml:se-path* '(error) report-xexpr)]
           )
      (close-input-port outport)
      (close-input-port errport)
      (if found-error
          (begin 
            (display (string-append found-error "<--- ERROR processing LaTeX formula: \n" texstring))
            (error "*** please make corrections and run again ***")
            )
          ;; if no error, return the depth (as a string):
          (xml:se-path* '(depth) report-xexpr))))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; corresponds to \equation in LaTeX
   [bystro-equation (->* ((listof string?) 
                          #:size natural-number/c) 
                         (#:label (or/c string? #f))
                         nested-flow?)]))
  (define (bystro-equation x
                           #:size n 
                           #:label [l #f] 
                           ) 
    (nested   
     (make-table 
      (make-style #f 
                  (list 
                   (make-attributes (list (cons 'style "width:100%;")))
                   (make-table-cells 
                    (list (list (make-style #f (list 'center)) (make-style #f (list 'right)))))))
      (list (list 
             (para (keyword-apply bystro-formula '() '() x #:size n #:align #f #:use-depth #t))
             (para (if l (elemtag l (number-for-formula l)) "")))))))
;; ---------------------------------------------------------------------------------------------------
  (define (aligned-formula manual-adj use-depth depth aa-adj filepath sz)
    (element 
        (bystro-elemstyle 
         (cond
          [manual-adj (string-append 
                       "vertical-align:-" 
                       (number->string (+ aa-adj depth (- (round (/ (* manual-adj sz) 18))))) 
                       "px")]
          [use-depth (string-append 
                      "vertical-align:-" 
                      (number->string (+ aa-adj depth)) 
                      "px" )]
          [else "vertical-align:middle"]))
      (image  filepath)))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; inline formula
            [bystro-formula (->* () 
                                 (#:shell-command path?
                                  #:database db? 
                                  #:formulas-in-dir string?
                                  #:size natural-number/c 
                                  #:align (or/c (integer-in (- 99) 99) #f) 
                                  #:use-depth boolean? 
                                  #:aa-adjust (integer-in (- 99) 99)
                                  ) 
                                 #:rest (listof string?) 
                                 element? )]))
  (define (bystro-formula 
           #:shell-command [shell-command-path (bystro-formula-processor bystro-conf)]
           #:database [mydb running-database]
           #:formulas-in-dir [formdir (bystro-formula-dir-name bystro-conf)]
           #:size [bsz (bystro-formula-size bystro-conf)] 
           #:align [align #f] 
           #:use-depth [use-depth #f] 
           #:aa-adjust [aa-adj (bystro-autoalign-adjust bystro-conf)] 
           . tex)
    (let* (
           [query (prepare 
                   mydb
                   (string-append 
                    "select filename,depth  from formulas where scale = ? and tex = ?"
                    ))]
           [row  (begin (load-params query bsz (apply string-append tex))
                        (step query)
                        )]
           [totalnumber (vector-ref (car (cdr (select mydb "select count(*) from formulas"))) 0)]
           )
      (finalize query)
      (if row
          (aligned-formula 
           align 
           use-depth 
           (string->number (vector-ref row 1)) 
           aa-adj 
           (build-path formdir (string-append (vector-ref row 0) ".png")) 
           bsz)
          (let* 
              ([formnum (totalnumber . + . 1)]
               [filename (string-append formdir "/" (number->string formnum) ".png")]
               [insert-stmt (prepare mydb "insert into formulas values (?,?,?,?,?)")]
               [dpth-str (bystro-command-to-typeset-formula 
                          shell-command-path 
                          (apply string-append tex) 
                          bsz 
                          filename)])
            (run insert-stmt (apply string-append tex) bsz (number->string formnum) dpth-str "")
            (finalize insert-stmt)
            (aligned-formula 
             align 
             use-depth 
             (string->number dpth-str) 
             aa-adj 
             (build-path filename) 
             bsz)))))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; table of contents on the title-slide
   [bystro-toc (-> delayed-block?)]))
  (define (bystro-toc)
    (make-delayed-block 
     (lambda (renderer pt ri) 
       (let ([ks (resolve-get-keys pt ri (lambda (key)
                                           (eq? (car key) 'amkhlv-slide)))])
         (apply 
          nested 
          (apply 
           append
           (for/list ([k (sort ks < #:key (lambda (k) (caddr k)))])
             (list (seclink (car (cdr k)) (resolve-get pt ri k)) (linebreak)))))))))
;; ---------------------------------------------------------------------------------------------------
)