(module common racket
  (require scribble/core scribble/base scribble/html-properties scriblib/render-cond)
  (require setup/dirs)
  (require mzlib/etc)

  #|
  The function amkhlv/css-file-path() will not be used, because I decided 
  that the .css files should be local to each slideshow
  |#
  (provide amkhlv/css-file-path)
  (define (amkhlv/css-file-path cssname) (build-path 
                                          (this-expression-source-directory) 
                                          (string->path (string-append "css/" cssname))))

  #| 
  Provides relative path for e.g.:
  @(hyperlink (amkhlv/path-to-link "../document.pdf") "here")
  |#
  (provide/contract
   [amkhlv/path-to-link (-> path-string? string?)])
  (define amkhlv/path-to-link
    (lambda (relpath)
      (string-append "file://" (path->string (path->complete-path (expand-user-path relpath))))
     )
   )

  #| 
  javascript injection
  |#
  (provide/contract 
   [amkhlv/js (->* () () #:rest (listof string?) element?)])
  (define (amkhlv/js . body)
    (make-element 
     (make-style #f (list (make-script-property "text/javascript" body)))
     '()
     )
    )

  #|
  javascript from URL
  |#
  (provide/contract 
   [amkhlv/js-url (-> string? element?)])
  (define (amkhlv/js-url url)
    (amkhlv/js "document.write(\"<script src='"  url  "'/><\\/script>\");"))

  #|
  This is a very universal style selector for element
  |#
  (provide/contract 
   [amkhlv/elemstyle (-> string? style?)])
  (define (amkhlv/elemstyle s)
    (make-style #f  (cons (make-attributes (list (cons 'style s)))
                          (style-properties plain))))

  #|
  A table
  |#
  (provide amkhlv/rectangular-table?)
  (define (amkhlv/rectangular-table? a)
    (and (list? a) 
         (for/and ([y a]) (list? y))
         (let ([ly (length a)])
           (and ((length a) . > . 0)
                (let ([lx (length (car a))])
                  (and (lx . > . 0)
                       (for/and ([z (cdr a)]) 
                                (= (length z) lx))))))))
  (provide/contract
            [amkhlv/table (->* (amkhlv/rectangular-table?) (#:orient (or/c 'hor 'vert)) table?)])
  (define (amkhlv/table listofrows #:orient [dirn #f])
    (let* (
           [cell-style-suffix (if dirn
                                  (if (equal? dirn 'hor) 
                                      "-hor"
                                      "-vert")
                                  "")]
           [generic-cell-style
            (make-style (string-append "amktablecell" cell-style-suffix) '())]
           [topleft-cell-style
            (make-style (string-append "amktabletopleftcell" cell-style-suffix) '())]
           [left-cell-style
            (make-style (string-append "amktableleftcell" cell-style-suffix) '())]
           [top-cell-style
            (make-style (string-append "amktabletopcell" cell-style-suffix) '())]
           [style-def-first-row 
            (cons topleft-cell-style
                  (map (lambda (x) top-cell-style) (cdr (car listofrows)))
                  )]
           [style-def-generic-row
            (cons left-cell-style
                  (map (lambda (x) generic-cell-style) (cdr (car listofrows)))
                  )]
           [style-def
            (cons style-def-first-row
                  (map (lambda (x) style-def-generic-row) (cdr listofrows))
                  )]
           )
      (make-table (make-style #f (list (make-table-cells style-def)))
                  (map (lambda (x) 
                         (map (lambda (y) 
                                (if (block? y)
                                    y
                                    (make-paragraph plain y)))
                              x) 
                         )
                       listofrows))))

  (provide/contract [amkhlv/verb 
                     (->* (string?) (#:indent exact-nonnegative-integer?) #:rest (listof string?) block?)])
  (define (nolinebreaks p)
    (make-table
     (make-style #f '())
     (map (lambda (x)
            (list
             (make-paragraph (make-style #f (list 'div)) 
                             (paragraph-content (car x))))
            )
          (table-blockss p)))
    )
  (define amkhlv/verb (compose nolinebreaks verbatim))
  

  (provide/contract 
                                        ; colored text
   [amkhlv/clr (->* ((or/c string? (list/c byte? byte? byte?))) () #:rest (listof content?) element?)]) 
  (define (amkhlv/clr clr-name . txt)
    (element (style #f (list (color-property clr-name))) 
      txt))

 )