(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)

;; ---------------------------------------------------------------------------------------------------
                                        ; 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
            [amkhlv/conf bystro?]))
  (define amkhlv/conf (bystro (find-executable-path "amkhlv-java-formula.sh")
                              "formulas.sqlite"
                              "formulas"
                              25
                              1
                              (- 2)
                              ))
  (define slide-part-number 0)
  (define slidename "SLIDE")
  (define content '())
  (define formulanumber 0)
  (define formula-ref-dict '())
  (define singlepage-mode #f)
  (define running-database #f)
;; ---------------------------------------------------------------------------------------------------


;; ---------------------------------------------------------------------------------------------------
  (define (amkhlv/css-element-from-file filename)
    (make-element 
     (make-style #f (list (make-css-addition filename))) '())    
    )
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
                                        ; Titlepage initialization
   [amkhlv/titlepage-init (->* () (#:singlepage-mode boolean?) element?)]))
  (define (amkhlv/titlepage-init #:singlepage-mode [spm #f])
    (if spm
        (begin 
          (set! singlepage-mode #t)
          (amkhlv/css-element-from-file "misc.css")
          (amkhlv/css-element-from-file "slide.css")
          )
        (amkhlv/css-element-from-file "slide-title.css")
        )
    )
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
                                        ; Slide continuation after pause
   [amkhlv/afterpause (->* () 
                           (#:tag (or/c symbol? string? #f)) 
                           #:rest (listof pre-flow?) 
                           (or/c part? nested-flow?))]))  
  (define (amkhlv/afterpause #:tag [tg #f] . more-content)
    (set! slide-part-number (+ 1 slide-part-number))
    (when (pair? more-content)
      (set! content (append  content (list (apply nested more-content)) )))
    (let ([ stl (if (slide-part-number . < . 2) 
                    (list 'non-toc 'no-toc 'unnumbered 'hidden )
                    (list 'non-toc 'no-toc 'unnumbered 'hidden 'toc-hidden))]
          [ 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 stl) "")
                   (apply nested more-content)))
          (decode (list
                   (title-decl #f tgs #f (style #f stl) nm)
                   (apply nested content)))
          )
      )
    )
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; removes the most recent after-pause
   [amkhlv/remove (-> void?)]))
  (define (amkhlv/remove)
    (if (pair? content) 
        (set! content (reverse (cdr (reverse content))))
        (error "nothing to remove !")))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
                                        ; slide
            [amkhlv/slide (->* (content?) 
                               (#:tag (or/c symbol? string? #f) #:showtitle boolean?) 
                               #:rest (listof pre-flow?) 
                               (or/c part? nested-flow?))]))  
  (define (amkhlv/slide stitle #:tag [tg #f] #:showtitle [sttl #f] . init-content)
    (set! slide-part-number 0)
    (set! slidename (if tg tg stitle))
    (if singlepage-mode         
        (begin
          (decode (list
                   (title-decl #f 
                               (if tg (list (list 'part tg)) (list)) 
                               #f 
                               (style #f (list))
                               stitle)
                   (apply nested init-content)))
          )
        (begin
          (set! content (list 
                         (apply 
                          nested 
                          (list
                           (if sttl 
                               (para (amkhlv/clr "blue" (larger stitle)) (linebreak))  
                               "")
                           (amkhlv/css-element-from-file "misc.css")
                           (amkhlv/css-element-from-file "slide.css")
                           ))
                         init-content))
          (amkhlv/afterpause  #:tag tg))))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; initialize formula collection dir and database
   [amkhlv/initialize-formula-collection 
    (-> db?)]))
  (define (amkhlv/initialize-formula-collection)
    (unless (directory-exists? (string->path (bystro-formula-dir-name amkhlv/conf)))
      (make-directory (string->path (bystro-formula-dir-name amkhlv/conf))))
    (let* ([mydb (open (string->path (bystro-formula-database-name amkhlv/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
   [amkhlv/number-for-formula (-> string? string?)]))
  (define (amkhlv/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
   [amkhlv/ref-formula (-> string? string?)]))
  (define (amkhlv/ref-formula lbl)
    (number->string (cdr (assoc lbl formula-ref-dict))))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out 
   [amkhlv/command-to-typeset-formula (-> path-string? string? number? string? string?)]))
  (define (amkhlv/command-to-typeset-formula shell-command-path texstring size filename)
    (define-values (pr inport outport errport) 
      (subprocess #f #f #f shell-command-path texstring (number->string size) filename))
    (let* ([dpth-string (read-line inport 'any)]
           [err-string  (read-line errport 'any)]
           )
      (close-output-port outport)
      (close-input-port  errport)
      (close-input-port inport)
      (if (and ((string-length err-string) . > . 3) (not (equal? err-string "OK")))
          (begin 
            (display (string-append err-string "<---"))
            (display (string-append "*** error processing LaTeX formula ***\n" texstring))
            (error "*** please make corrections and run again ***")
            )
          dpth-string)))
;; ---------------------------------------------------------------------------------------------------
  (provide (contract-out  
                                        ; corresponds to \equation in LaTeX
   [amkhlv/equation (->* ((listof string?) 
                          #:size natural-number/c) 
                         (#:label (or/c string? #f))
                         nested-flow?)]))
  (define (amkhlv/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 amkhlv/formula '() '() x #:size n #:align #f #:use-depth #t))
             (para (if l (elemtag l (amkhlv/number-for-formula l)) "")))))))
;; ---------------------------------------------------------------------------------------------------
  (define (aligned-formula manual-adj use-depth depth aa-adj filepath sz)
    (element 
        (amkhlv/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
            [amkhlv/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 (amkhlv/formula 
           #:shell-command [shell-command-path (bystro-formula-processor amkhlv/conf)]
           #:database [mydb running-database]
           #:formulas-in-dir [formdir (bystro-formula-dir-name amkhlv/conf)]
           #:size [bsz (bystro-formula-size amkhlv/conf)] 
           #:align [align #f] 
           #:use-depth [use-depth #f] 
           #:aa-adjust [aa-adj (bystro-autoalign-adjust amkhlv/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 (amkhlv/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)))))
;; ---------------------------------------------------------------------------------------------------

  )