#|
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
  (define eraseme '())
  (provide (struct-out bystro))
  (struct bystro (
                  formula-processor
                  formula-database-name
                  formula-dir-name
                  formula-size 
                  autoalign-adjust
                  manual-base-alignment
                  )
          #:mutable)
  (define configuration (bystro (find-executable-path "amkhlv-java-formula.sh")
                                "formulas.sqlite"
                                "formulas"
                                25
                                1
                                (- 2)
                                ))
  (provide display-configuration)
  (define (display-configuration s) 
    (display "\n")
    (display eraseme)
    (set! eraseme (cons (string-append s " | ") eraseme))
    (display (string-append "\n---" s "----\n"))
    (display (bystro-formula-dir-name configuration))
    (display "\n-------\n")
    )
  (provide (contract-out
                                        ; configures the bystro-conf
            [configure-bystroTeX-using (-> bystro? void?)]))
  (define (configure-bystroTeX-using c)
    (set! configuration c))
  (struct current (
                   slide-part-number
                   slide-number
                   slidename
                   content
                   formulanumber
                   formula-ref-dict
                   singlepage-mode
                   running-database
                   )
          #:mutable)
  (define state 
    (current 0 0 "SLIDE" '() 0 '() #f #f)) ; this is the global state
  (provide display-state)
  (define  (display-state s)
    (display (string-append "\n==========" s "=========\n"))
    (display (current-slidename state))
    (display (current-content state))
    (display (current-singlepage-mode state))
    (display (string-append "\n^^^^^^^^^^^^" s "^^^^^^^^\n"))
    )
;; ---------------------------------------------------------------------------------------------------
  (define to-hide (list 'non-toc 'no-toc 'unnumbered 'hidden 'hidden-number 'quiet))
;; ---------------------------------------------------------------------------------------------------
  (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-current-singlepage-mode! state #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-current-slide-part-number! state (+ 1 (current-slide-part-number state)))
    (when (pair? more-content)
      (set-current-content! state (append (current-content state) more-content)))
    (let ([stl (if ((current-slide-part-number state) . < . 2) 
                   to-hide
                   (cons 'toc-hidden to-hide))]
          [nm  (if ((current-slide-part-number state) . < . 2)
                   (current-slidename state)
                   (if (pair? (current-slidename state))
                       (append 
                        (current-slidename state) 
                        (list " " (number->string (current-slide-part-number state))))
                       (string-append 
                        (current-slidename state) 
                        " " 
                        (number->string (current-slide-part-number state)))))]     
          [tgs (if tg (list (list 'part tg)) (list))])
      (if (current-singlepage-mode state)
          (begin
                                        ;(display-state "inside after-pause, singlepage")
            (decode (list (title-decl #f tgs #f (style #f (cons 'toc-hidden to-hide)) "") 
                          more-content)))
          (begin
                                        ;(display-state "inside after-pause, multipage")
            (decode 
             (cons (title-decl #f tgs #f (style #f stl) nm)
                   (current-content state))
             )))))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; removes the most recent after-pause
   [remove-slide (-> void?)]))
  (define (remove-slide)
    (if (pair? (current-content state)) 
        (set-current-content! state (reverse (cdr (reverse (current-content state)))))
        (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-current-slide-number! state (+ 1 (current-slide-number state)))
    (set-current-slide-part-number! state 0)
    (set-current-slidename! state (if tg 
                                      tg 
                                      (regexp-replace #px"\\s" stitle "_")))
    ;(display-state "in slide")
    (if (current-singlepage-mode state)
        (decode (list
                 (title-decl 
                  #f 
                  (if tg (list (list 'part tg)) (list)) 
                  #f 
                  (style #f to-hide)
                  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 
                   (current-slidename state) 
                   stitle 
                   (current-slide-number state)))
                 init-content))
        (begin
          ;(display "multipage\n")
          (set-current-content!
           state
           (list 
            ;; (title-decl
            ;;  #f
            ;;  (if tg (list (list 'part tg)) (list))
            ;;  #f
            ;;  (style #f to-hide)
            ;;  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 
              (current-slidename state) 
              stitle 
              (current-slide-number state)))
            init-content))
          ;(display-state "before calling afterpause")
          (after-pause  #:tag tg))))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; initialize formula collection dir and database
   [bystro-initialize-formula-collection 
    (-> bystro? db?)]))
  (define (bystro-initialize-formula-collection bstr)
    ;(display-configuration "in bystro-init")
    (display "\n --- initializing formula collection in the directory: ")
    (display (bystro-formula-dir-name bstr))
    (display "\n --- using the sqlite file: ")
    (display (bystro-formula-database-name bstr))
    (unless (directory-exists? (string->path (bystro-formula-dir-name bstr)))
      (make-directory (string->path (bystro-formula-dir-name bstr))))
    (let* ([mydb (open (string->path (bystro-formula-database-name bstr)))]
           [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-current-running-database! state mydb)
      mydb))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; enumerate a formula
   [number-for-formula (-> string? string?)]))
  (define (number-for-formula lbl)
    (set-current-formulanumber! state (+ 1 (current-formulanumber state)))
    (set-current-formula-ref-dict! 
     state
     (if (dict-has-key? (current-formula-ref-dict state) lbl) 
         (current-formula-ref-dict state) ;; do nothing if already registered such label
         (cons (cons lbl (current-formulanumber state)) (current-formula-ref-dict state))))
    (string-append "(" (number->string (current-formulanumber state)) ")"))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
                                        ; reference a formula
   [ref-formula (-> string? string?)]))
  (define (ref-formula lbl)
    (number->string (cdr (assoc lbl (current-formula-ref-dict state)))))
;; ---------------------------------------------------------------------------------------------------
  (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 
                       "display:inline;white-space:nowrap;vertical-align:-" 
                       (number->string (+ aa-adj depth (- (round (/ (* manual-adj sz) 18))))) 
                       "px")]
          [use-depth (string-append 
                      "display:inline;white-space:nowrap;vertical-align:-" 
                      (number->string (+ aa-adj depth)) 
                      "px" )]
          [else "display:inline;white-space:nowrap;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 configuration)]
           #:database [mydb (current-running-database state)]
           #:formulas-in-dir [formdir (bystro-formula-dir-name configuration)]
           #:size [bsz (bystro-formula-size configuration)] 
           #:align [align #f] 
           #:use-depth [use-depth #f] 
           #:aa-adjust [aa-adj (bystro-autoalign-adjust configuration)] 
           . 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)))))))))
;; ---------------------------------------------------------------------------------------------------
)