(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)
                                        ; Global variables:
  (define slidenumber 0)
  (define slidename "SLIDE")
  (define content '())
  (define formulanumber 0)
  (define formula-ref-dict '())
  (define singlepage-mode #f)

  (define (amkhlv/css-element-from-file filename)
    (make-element 
     (make-style #f (list (make-css-addition filename))) '())    
    )

  (provide/contract
                                        ; 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
                                        ; 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! 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)) ]
          )
      (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 
                                        ; 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?) 
                      (or/c part? nested-flow?))])  
  (define (amkhlv/slide stitle #:tag [tg #f] #:showtitle [sttl #f] . init-content)
    (set! slidenumber 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 [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  (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)
      )
    )

  (define (aligned-formula manual-adj ud depth aa-adj filepath sz)
    (element 
        (amkhlv/elemstyle 
         (if manual-adj 
             (string-append "vertical-align:-" (number->string  
                                               (+ aa-adj depth (- (round (/ (* manual-adj sz) 18))))) 
                            "px")
             ; (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 
                           ) 
    (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
                             #:shell-command fproc #:size n #:align #f #:use-depth #t #:aa-adjust aaa
                             #:database mydb #:formulas-in-dir formdir 
                             ))
             (para (if l (elemtag l (amkhlv/number-for-formula l)) "") ))))))

  (provide/contract 
                                        ; table filling 100% of width
   [amkhlv/longtable (->* ((listof (listof block?)) 
                           #:styless (listof 
                                      (listof 
                                       (listof 
                                        (or/c 'left 'right 'center 'top 'baseline 'bottom 'vcenter)))))
                          (#:width (integer-in 1 100))
                          nested-flow? )])
  (define (amkhlv/longtable bss #:styless ass #:width [w 100])
    (nested
     (make-table
      (make-style #f
                  (list
                   (make-attributes (list (cons 'style (string-append "width:" (number->string w) "%;"))))
                   (make-table-cells
                    (map 
                     (lambda (x) 
                       (map 
                        (lambda (y) (make-style #f y))
                        x))
                     ass))))
      bss)))

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

  )