(module slides racket
  (require scribble/base scribble/core scribble/html-properties 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)

  (define formula-basicsize 24)
  (define dbfilename "formulas.sqlite")


                                        ; Global variables:
  (define slidenumber 0)
  (define slidename "SLIDE")
  (define content '())
  (define formulanumber 0)
  (define formula-ref-dict '())


  (provide/contract
                                        ; titlepage initialization
   [amkhlv/titlepage-init (-> element?)])
  (define (amkhlv/titlepage-init)
    (make-element 
     (make-style #f (list (make-css-addition 
                           "slide-title.css"
                           )))
     '()))


  (provide/contract
                                        ; slide continuation after pause
   [amkhlv/afterpause (->* () (#:tag (or/c symbol? string? #f)) #:rest (listof pre-flow?) part?)])  
  (define (amkhlv/afterpause #:tag [tg #f] . more-content)
    (set! slidenumber (+ 1 slidenumber))
    (when (pair? more-content)
      (set! content (append  content (list (apply nested more-content)) )))
    (let ([ stl (if (slidenumber . < . 2)
                    (list 'non-toc 'no-toc 'unnumbered 'hidden )
                    (list 'non-toc 'no-toc 'unnumbered 'hidden 'toc-hidden))]
          [ nm  (if (slidenumber . < . 2)
                    slidename 
                    (if (pair? slidename) 
                        (append slidename (list " " (number->string slidenumber)))
                        (string-append slidename " " (number->string slidenumber))))]     
          [ tgs (if tg (list (list 'part tg)) (list)) ]
          )
      (decode (list
               (title-decl #f tgs #f (style #f stl) nm)
               (apply nested content)))
      )
    )


  (provide/contract 
                                        ; 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
                                        ; slide
   [amkhlv/slide (->* (content?) 
                      (#:tag (or/c symbol? string? #f) #:showtitle boolean?) 
                      #:rest (listof pre-flow?) 
                      part?)])  
  (define (amkhlv/slide stitle #:tag [tg #f] #:showtitle [sttl #f] . init-content)
    (set! slidenumber 0)
    (set! slidename (if tg tg stitle))
    (set! content (list 
                   (apply nested (list
                                  (let ((style (make-style #f
                                                           (list (make-css-addition 
                                                                  "misc.css"
                                                                   )))))
                                    (make-element style '()))
                                  (make-element 
                                   (make-style #f (list (make-css-addition 
                                                         "slide.css"
                                                         )))
                                   '())
                                  (if sttl 
                                      (para (amkhlv/clr "blue" (larger stitle)) (linebreak))  
                                      "")))
                   init-content))
    (amkhlv/afterpause  #:tag tg)
    )

  
  (provide/contract [larger-2 (->* () () #:rest (listof pre-content?) element?)])
  (define larger-2 (compose larger larger))
  (provide/contract [larger-3 (->* () () #:rest (listof pre-content?) element?)])
  (define larger-3 (compose larger larger larger))
  (provide/contract [larger-4 (->* () () #:rest (listof pre-content?) element?)])
  (define larger-4 (compose larger larger larger larger))
  (provide/contract [smaller-2 (->* () () #:rest (listof pre-content?) element?)])
  (define smaller-2 (compose smaller smaller))
  (provide/contract [smaller-3 (->* () () #:rest (listof pre-content?) element?)])
  (define smaller-3 (compose smaller smaller smaller))
  (provide/contract [smaller-4 (->* () () #:rest (listof pre-content?) element?)])
  (define smaller-4 (compose smaller smaller smaller smaller))


  (provide/contract 
                                        ; initialize formula collection dir and database
   [amkhlv/initialize-formula-collection 
    (-> string? string? db?)])
  (define (amkhlv/initialize-formula-collection dbfilename formdirname)
    (unless (directory-exists? (string->path formdirname))
      (make-directory (string->path formdirname)))
    (let* ([mydb (open (string->path dbfilename))]
           [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)
      mydb
      )
    )

  
  (provide/contract 
                                        ; 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
                                        ; reference a formula
   [amkhlv/ref-formula (-> string? string?)])
  (define (amkhlv/ref-formula lbl)
    (number->string (cdr (assoc lbl formula-ref-dict))))


  (provide/contract
   [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  (port->string errport)]
          )
      (close-output-port outport)
      (close-input-port  errport)
      (close-input-port inport)
      (if ((string-length err-string) . > . 0)
          (begin 
            (display err-string)
            (display (string-append "*** error processing LaTeX formula ***\n" texstring))
            (error "*** please make corrections and run again ***")
            )
          dpth-string)
      )
    )

  (define (aligned-formula manual-adj ud depth aa-adj filepath sz)
    (element 
        (amkhlv/elemstyle 
         (if manual-adj 
             (string-append "vertical-align:" (number->string  (round (/ (* manual-adj sz) 10))) "px") 
             (if ud (string-append 
                     "vertical-align:-" (number->string (+ aa-adj depth)) "px" )
                 "vertical-align:middle")))
      (image  filepath))
    )


  (provide/contract 
                                        ; display-style math
   [amkhlv/equation (->* ((listof string?) #:hspace natural-number/c #:size natural-number/c #:shell-command path?
                          #:database db? #:formulas-in-dir string?) 
                         (#:label (or/c string? #f) #:aa-adjust (integer-in (- 99) 99))
                         nested-flow? )])
  ;; (provide amkhlv/equation)
  (define (amkhlv/equation x
                           #:hspace hs #:label [l #f] #:size n #:shell-command fproc #:aa-adjust [aaa 0] 
                           #:database mydb #:formulas-in-dir formdir 
                           ) 
    (apply centered 
           (list 
            (keyword-apply amkhlv/formula '() '() x
                           #:shell-command fproc #:size n #:align #f #:use-depth #t #:aa-adjust aaa
                           #:database mydb #:formulas-in-dir formdir 
                           ) 
            (hspace hs)
            (if l (elemtag l (amkhlv/number-for-formula l)) "") )))


  (provide/contract 
                                        ; insert formula using jeuclid and sqlite
   [amkhlv/formula (->* (#:database db? #:formulas-in-dir string?) 
                        (#:shell-command path?
                         #: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 #f]
           #:size [s formula-basicsize] #:align [algn #f] #:use-depth [ud #f] #:aa-adjust [aa-adj 0] 
           #:database mydb #:formulas-in-dir formdir . tex)
    (let* (
           [query (prepare 
                   mydb
                   (string-append 
                    "select filename,depth  from formulas where scale = ? and tex = ?"
                    ))]
           [row  (begin (load-params query s (apply string-append tex))
                        (step query)
                        )]
           [totalnumber (vector-ref (car (cdr (select mydb "select count(*) from formulas"))) 0)]
           )
      (finalize query)
      (if row
          (aligned-formula 
           algn ud (string->number (vector-ref row 1)) aa-adj (build-path 
                           formdir 
                           (string-append (vector-ref row 0) ".png")) 
           s)
          (let* (
                 [formnum (if (totalnumber . > . 0)
                              (+ 1 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) s filename)]
                 )
            (run insert-stmt (apply string-append tex) s (number->string formnum) dpth-str "")
            (finalize insert-stmt)
            (aligned-formula algn ud (string->number dpth-str) aa-adj (build-path filename) s) 
            )
          )
      )
    )

  )