(allowed ()
   "!work" "!canvasTest" "@lib.css" )
(allow "!setCanvasSize")

(load
   "@lib/http.l" "@lib/xhtml.l" "@lib/form.l"
   "@lib/canvas.l" "@lib/svg.l" )

(allow "!mk.svg")

################################################################################
#            S V G    H  E L P E R     M E T H O D S
################################################################################


(de rndrect (X Y DX DY R Fill Stroke)
   (msg (glue " " (list "rndrect " X Y DX DY R Fill Stroke)))
   (prin
      "<rect x=\"" X
      "\" y=\"" Y
      "\" width=\"" DX
      "\" height=\"" DY
      "\" rx=\"" R
      "\" ry=\"" R
      "\" fill=\"" (or Fill "none")
      "\" stroke=\"" (or Stroke (if Fill "none" "black"))
      "\" stroke-width=\"" *StrokeWidth "\"" )
   (and *Style (htStyle @))
   (prinl "/>") )

(de <mysvg> (W H Z *DX *DY P . "Prg")
   (msg (glue " " (list "mksvg " W H Z *DX *DY P . "Prg")))
   (prin
      "<svg version=\"1.1\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink"
      "\" width=\"" (if (num? Z) (* @ W) (pack W Z))
      "\" height=\"" (if (num? Z) (* @ H) (pack H Z))
      "\" viewBox=\"0 0 " *DX " " *DY "\""
      (if P "" " preserveAspectRatio=\"none\""))
   (dfltCss "svg")
   (prinl ">")
   (let *Pos 0
      (prog1
         (run "Prg")
         (prinl "</svg>") ) ) )


(de gridline (Stroke . @)
   (prin "<polyline fill=\"none\" stroke=\"" Stroke "\" stroke-width=\"" *StrokeWidth "\" stroke-dasharray=\"1 9\" points=\"" (next))
   (while (args)
      (prin " " (next)) )
   (prin "\"")
   (and *Style (htStyle @))
   (prinl "/>") )

(de drawGrid ()
   (msg "draing grid")
   (let? G 100
      (for (X 0 (>= 1000 X) (+ X G))
         (for (Y 0 (>= 1000 Y) (+ Y G))
            (when (=0 X) ( gridline "blue"  X Y 1000 Y) ) # horiz lines
            (when (=0 Y) ( gridline "red"  X 0 X 100) ( gridline "black"  X 200 X 1000) )  # vertical lines
 ) ) ) )



(de makeSvg ()
   (<mysvg> 100 100 "%" 1000 1000 NIL # suitable for 10 x 10 grid with each
      (drawGrid)
#      (window 0 0 100 100 (rndrect 0 0 100 100 15 NIL "red")
#         (down 20)  (font ( 30 . "Courier") (ps 0 "A" '(s "1"))))
       (drawTiles)
 ) )

(de mk.svg (Page)
   (msg "mk.svg ")
   (httpHead "image/svg+xml" 0)
   (ht:Out *Chunked
      (makeSvg) ) )



################################################################################
#            T I L E   H E L P E R S
################################################################################


(de tileValue (L)
   (cond
      ( (= L " ")  1)
      ( (member L '(a e i o u))  1)
      ( (member L '(z q x))  5)
      (T 2)
 ) )


(de vowel (Let)
   (cond
      ( (member Let '(a e i o u " "))  T)
      (T NIL)
 ) )

(de numVowels (Lst)
   (let S 0
      (mapcar '((X) (when (vowel X) (inc 'S))) Lst)
      S)
   )

# rules for a  list of letters to be good
(de areLettersOk (Lst)
   (let V (numVowels Lst)
      (cond
         ((> V 5 )  NIL) # no more than 5 vowels
         ((< V 3 )  NIL) # at least 3 vowels needed
         (T T) # ok by deafult
         ) ) )


################################################################################
#            T I L E    M E T H O D S
################################################################################


(class +Tile)
# x y : location of upper left corner in a grid 1000 x 1000
# l   : letter tile represents
# v   : value of the tile
# f : the fill color of the tile
# s : the color of the tile edges
# sx, sy, r (tile width, height and radius copied from tile manager...constants)

(dm T (X Y L F S Sx Sy R)
   (=: x X)
   (=: y Y)
   (=: l L)
   (=: v (tileValue L))
   (=: f F)
   (=: s S)
   (=: sx Sx)
   (=: sy Sy)
   (=: r R)
 )

(dm move> (NX NY) (:= x NX) (:= y NY))

(dm name> () (if (= " " (: l)) "--" (uppc (: l))))

(dm draw> ()
   (window (: x) (: y) (: sx) (: sy) (rndrect  6 6  (- (: sx) 12) (- (: sy) 12) (: r) (: f) (: s))
      (down (/ sy 5))  (font ( 30 . "Courier") (ps 0 (name> This (: l))  (list 's (: v)))) )
 )


################################################################################
#            T I L E M G R    M E T H O D S
################################################################################

(class +TileMgr)

# some static class members
# LetList: list of letters in the alphabet
# LetNum: amounts of letters in a pile of 180 letters

(var Letters . (a b c d e f g h i j k l m n o p q r s t u v w x y z " "))  # unmodifiable
(var Counts . (16 3 3 6 22 3 4 4 16 2 4 6 4 9 14 3 2 9 8 9 8 3 3 2 3 2 12)) # unmodifiable
(var TotTiles 0)
(var LetterAmounts NIL) # created by init
(var LetterList NIL) # list of 10 letters finally selected
(var NumLetters . 10 )
(var Sx . 0)         # Sx : width and height of the tile
(var Sy . 0)         # Sy : width and height of the tile
(var R . 0)          # R     : the radius of the rounded edges in the tile rectangle
(var TileList NIL)   # list of 10 tiles, one per letter in Letter List

(dm genLetters> ()
   (let Lst NIL
      (while (> 10 (length Lst))
         (setq Lst
            (make
               (do (get This 'NumLetters)
                  (setq  R (rand 1 (car  (get This 'TotTiles)) ))
                                        # find the character whose cum count corresponds to random var
                  (setq X (car (find '((X) (if (> (caddr  X) R) (car X) NIL)) (get This 'LetterAmounts))))
                  (link X)
                  ) ) )
         # (println "Trying" Lst (numVowels Lst))
         # check if the list is good
         (unless (areLettersOk Lst) (setq Lst NIL))
         )

      # (println "Final" Lst (numVowels Lst))
      (put This 'LetterList Lst) ) )


(dm makeTiles> ()
   (let ( Lst NIL
         SX  (get This 'Sx)
         SY  (get This 'Sy)
         RR  (get This 'R) )
      (setq Lst
         (make
            (for (I . X) (get This 'LetterList)
               (link (new '(+Tile) (* SX (- I 1)) 0 X "yellow" "red" SX SY RR ) ) ) ) )
      (put This 'TileList Lst) ) )


(dm init> (SX SY Radius)
  (let
     (N (get This 'Counts)
      L  (get This 'Letters)
      S 0
      R (if (=0 Radius) (/ SX 6) Radius) )
       (put This 'Sx SX)
       (put This 'Sy SY)
       (put This 'R R)
       (put This 'LetterAmounts (make (mapcar '((X Y) (inc 'S Y) (link (cons X Y (cons S))) ) L N)))
       (set (car (prop This 'TotTiles)) (apply + N)) )
       (genLetters> This)
       (makeTiles> This) # one tile per letter
 )


################################################################################
#            G R I D  T I L E   M E T H O D S
################################################################################

# each grid tile is same size as a +Tile (sx, sy)
# grid has 12 rows and 10 columns
# row 1 is used for the initial tiles to be placed
# row number 2 is unused
# the grid is laid out as a 1d array
# col1, col2, col3 ....

(de gridPxlToId (X Y) # X and Y are pixel locations with respect to *W and *H
   (let
      (I (/ X *Wt)
       J (/ Y *Ht)
       )
      (msg (glue "," (list  X Y *Wt *Ht I J *Nc (+ I 1 (* *Nc J)))))
      (+ I 1 (* *Nc J)) ) )

################################################################################
#            M A I N   M E T H O D S
################################################################################

(de drawTiles ()
   (for (I . Obj) (get '+TileMgr 'TileList)
      (msg (glue " " (list "drawTiles " I " -> " (get Obj 'l))))
      (draw> Obj) ) )

(de drawImage ()
   (csDrawImage (sesId (pack "!mk.svg?" (ht:Fmt This *Cnt)))
      0                                 # X
      0                                 # Y
      ) )

(de drawCanvas (Id Dly F X Y X2 Y2)
   (msg "Draw canvas start")
   (inc *Cnt)
   (unless (= NIL F) (msg (glue "," (list  F X Y X2 Y2 "G" (gridPxlToId X Y)))))
   (if *Upd  (prog1  (make (drawImage)) (msg "Draw canvas done")) (prog1 NIL (msg "Draw canvas noop")))
 )


# These two variables myst be set before canvasTest as it uses a read macro
(setq *PctW 60)
(setq *PctH 80)

(de setCanvasSize (W H)
   #(msg (glue " " (list "setCanvasSize" W H)))
   (setq *W W)
   (setq *H H) )

(de canvasTest ()
   (action
      (html 0 "Canvas Test1" "@lib.css"
         '(
           (onload .
              `(glue ";"
                 (list
                    "var form = document.getElementById('$formID')"
                    # "alert('hi' + form.clientHeight)"
                    "var cnvsDiv = document.getElementById('$canvasID')"
                    `(glue "" (list "var cnvsWidth = \"width:\" + String(" *PctW " * 0.01 *form.clientWidth) + \"px;\" "))
                    `(glue "" (list "var cnvsHeight = \"height:\" + String(" *PctH " * 0.01 * form.clientHeight) + \"px;\" "))
                    "var cnvsCol = \"background-color: orange; padding: 10px; margin:10px;\""
                    "var cnvsStyle = cnvsHeight + cnvsWidth + cnvsCol"
                    `(glue "" (list "cnvsDiv.setAttribute(\"style\","  "cnvsStyle" ")"))
                    "var cs = getComputedStyle(cnvsDiv)"
                    "var widthPxls = parseInt(cs.getPropertyValue('width'), 10)"
                    "var heightPxls = parseInt(cs.getPropertyValue('height'), 10)"
                    "var canvas = document.getElementById('$testID')"
                    `(glue "*" (list  "canvas.width = widthPxls " 90 "0.01"))
                    `(glue "*" (list  "canvas.height = heightPxls " 90 "0.01"))
                    "lisp(null, \"setCanvasSize\", canvas.width, canvas.height)"
                    "lisp(null, 'console', '--> onload: draw canvas start', widthPxls, heightPxls, canvas.width, canvas.height, document.body.scrollHeight)"
                    "drawCanvas('$testID', -1)"
                    "lisp(null, 'console', '+++ onload: drawCanvas done')"
 ) ) )
           (onresize .
              `(glue ";"
                 (list
                    "var form = document.getElementById('$formID')"
                    # "alert('hi' + form.clientHeight)"
                    "var cnvsDiv = document.getElementById('$canvasID')"
                    `(glue "" (list "var cnvsWidth = \"width:\" + String(" *PctW " * 0.01 *form.clientWidth) + \"px;\" "))
                    `(glue "" (list "var cnvsHeight = \"height:\" + String(" *PctH " * 0.01 * form.clientHeight) + \"px;\" "))
                    "var cnvsCol = \"background-color: orange; padding: 10px; margin:10px;\""
                    "var cnvsStyle = cnvsHeight + cnvsWidth + cnvsCol"
                    `(glue "" (list "cnvsDiv.setAttribute(\"style\","  "cnvsStyle" ")"))
                    "var cs = getComputedStyle(cnvsDiv)"
                    "var widthPxls = parseInt(cs.getPropertyValue('width'), 10)"
                    "var heightPxls = parseInt(cs.getPropertyValue('height'), 10)"
                    "var canvas = document.getElementById('$testID')"
                    `(glue "*" (list  "canvas.width = widthPxls " 90 "0.01"))
                    `(glue "*" (list  "canvas.height = heightPxls " 90 "0.01"))
                    "lisp(null, \"setCanvasSize\", canvas.width, canvas.height)"
                    "lisp(null, 'console', '---> onresize: draw canvas start', widthPxls, heightPxls, canvas.width, canvas.height, document.body.scrollHeight)"
                    "drawCanvas('$testID', -1)"
                    "lisp(null, 'console', '+++ onresize: drawCanvas done')"
 ) ) )
           )
         (form '((id . "$formID")  (style . "position:absolute;top:5px; bottom:5px;left:5px;right:5px;background-color:blue"))
            ( <div> '((id . "$canvasID") (style . "background-color; orange;padding: 10px; margin:10px"))
                  (<canvas> "$testID" "600" "800")
               )
            (<div> '((id . "$floatID") (width . "100%") (height . "20%") (style . "backgroundColor:green")))
 ) ) ) )
<post>
(de setup ()
   (setq *Upd 1)
   (setq *Cnt 0)
   (setq *W 600)
   (setq *H 800)
   (setq *Nr 12) # number of rows of grid tiles in grid
   (setq *Nc 10) # number of columns of grid tiles in grid
   (setq *Wt (/ *W *Nc)) # width of each tile
   (setq *Ht (/ *H *Nr)) # height of each tile
   (seed (time))
   (init> '+TileMgr 100 100 15) # virtual scale not actual pixels

   # (createTiles)
 )

(de work ()
   (app)
   (setup)
   (redirect (baseHRef) *SesId "!canvasTest") )

(server 8080 "!work")

# ./pil draw2Rects.l +