(define color-list
  '((transparent 0 0 0 0)
    (aliceblue 	240 248 255)
    (antiquewhite 	250 235 215)
    (aqua 	0 255 255)
    (aquamarine 	127 255 212)
    (azure 	240 255 255)
    (beige 	245 245 220)
    (bisque 	255 228 196)
    (black 	0 0 0)

		     color-list)
	   t)))

(define (name->color x)
  (check-arg symbol? x name->color)
  (cond [(hashtable-ref color-table x #f) 
	 => (lambda (y) (apply make-color (map (lambda (x) (exact->inexact (/ x 255))) y) ))]
	[else (errorf 'name->color "unknown color ~d" x)]))

(define (->color x)
  (cond
    [(color? x) x]
    [(symbol? x) (name->color x)]
    [(list? x) (case (car x) 
		 [(rgb rgba) (apply make-color (map (cut / <> 255) (cdr x)))]
		 [(rgbf rgbaf)  (apply make-color (cdr x))]
		 [else (errorf '->color "unknown color ~d" x)])]
    [else (errorf '->color "unknown color ~d" x)]))

				      (cadr x) 
				      (cadr x))])
       (hashtable-set! hash (car x) v)
       v))
   alist)
  hash)

(define (compare-specificity x y)
  ;(printf "~d ~d~n" x y)
    (cond
     [(equal? x y) #f]
     [(< (list-ref x 0) (list-ref y 0)) #t]
     [(> (list-ref x 0) (list-ref y 0)) #f]
     [(< (list-ref x 1) (list-ref y 1)) #t]
     [(> (list-ref x 1) (list-ref y 1)) #f]
     [(< (list-ref x 2) (list-ref y 2)) #t]
     [(> (list-ref x 2) (list-ref y 2)) #f]
     [(< (list-ref x 3) (list-ref y 3)) #t]
     [else #f]))
























(include "css-preprocess.ss")

;(define (preprocess-attrs aa) aa)

(define (stylesheet-resolve element)
  (import (only (srfi s1 lists) last drop-right fold))
  (define id (mi-element-id element))
  (define class (mi-element-class element))

  (define entries+style (append (list `(%%style ==>  ,@style)) (stylesheet)))
  (let loop ([entries entries+style] [props '()])
    (unless (null? entries)
	    (let ([e (car entries)])
	      (let ([selectors (reverse (cdr (memq '==> (reverse e))))]
		    [attribs (preprocess-attrs element (cdr (memq '==> e)))])
		(define null-spec '(0 0 0 0 0))
		(define (process-selector selector type id* class* element* pseudo* specificity)
		 ;(printf "selector: ~d id: ~d pseudo: ~d~n" selector id* pseudo*)
		  (match selector
		    ['%%style (match specificity [(a b c d e) (list 1 b c d e)])]
		    [('id (? (cut eq? <> id*) x)) 
		     (match specificity [(a b c d e) (list a (+ 1 b) c d e)])]
		    [('class (? (cut eq? <> class*) x)) 
		     (match specificity [(a b c d e) (list a b (+ 1 c) d e)])] 
		    [(': (? (cut memq <> pseudo*) x)) (match specificity [(a b c d e) (list a b (+ 1 c) d e)])]
		    [('and sel ...) 
		     (let ([l (map (cut process-selector <> 'and 
					id* class* element* pseudo* specificity) sel)])
					;(printf "L: ~d\n" l)
		       (if (let loop ([l l])
			     (if (null? l) #t
				 (if (equal? null-spec (car l)) #f
				     (loop (cdr l)))))
			   (fold (lambda (x acc) (map + x acc)) null-spec l)
			   null-spec))]
		    [('or sel ...) 
		     (apply map + (map (cut process-selector <> 'or 
					    id* class* element* pseudo* specificity) sel))]
		    [('> e f) 
		     (let ([a (process-selector e '>e 
						(mi-element-id parent) 
						(mi-element-class parent)
						(mi-element-el parent)
						(mi-element-pseudo parent)
						null-spec)]
			   [b (process-selector f '>f id class el pseudo null-spec)])
		       (if (not (or (equal? a null-spec) (equal? b null-spec)))
			   (map + a b)
			   specificity))]
					;[('+ e f) (for-each (cut process-selector <> '+) sel)]
		    ['* '(0 0 0 0 1)]
		    [(? (cut eq? <> element*) e) 
		     (match specificity [(a b c d e) (list a b c (+ d 1) e)])]
		    [else 
		     ;;(printf "~d does not match~n" (car selectors)) 
		     specificity]))
		(let ([sp (process-selector (car selectors) 'type id class el pseudo '(0 0 0 0 0))])
					;(printf "Specificity: ~d~n" sp)
		  (unless (equal? sp null-spec)
		    (set! matches (cons (cons sp attribs) matches))))))
	    (loop (cdr entries) '())))
  ;(pretty-print matches)
  (for-each
   (lambda (x)
     (for-each (lambda (pair)
		 ;(printf "pair: ~d~n" pair)
		 (let ([val (cdr pair)]
		       [e (hashtable-ref hash (car pair) #f)])
		   (if (= 1 (length val))
		       (set! val (car val)))
		   ;(printf "k: ~d e: ~d val: ~d~n" (car pair) e val)
		   (if (not (and e (pair? e) (eq? (last e) '!important))) 
		       (hashtable-set! hash (car pair) val))))
	       (cdr x)))
   (sort (lambda (x y) 
	   (compare-specificity (car x) (car y))) 
	 (reverse matches)))
  
  (alist->hashtable 
   (map 
    (lambda (x)
      ;;(printf "x: ~d cdr ~d ~d~n" x (cdr x) (and (list? (cadr x)) 1 (last (cdr x))))
      (if (and (list? (cadr x)) (eq? (last (cadr x)) '!important))
	 (cons (car x) (drop-right (cadr x) 1))
	 (if (and (list? (cadr x)) (< (length (cadr x)) 2))
	     (cons (car x) (cadr x))
	     (cons (car x) (cdr x)))))
   (hashtable->alist hash))))

(include "miogui.ss")

(stylesheet '([* ==> 
			(position static)
			(box-sizing border-box)
			(font-family "Sans")
			(font-size 12)
			(line-height 1.2)
			(z-index auto)
			(text-align left)]
		     [button ==>
			     (width 160) 
			     (height 50) 
			     (color red)
			     (background-color (rgbf 0 1 0 0.5))
			     (border-style solid)
			     (border-color red)
			     (border-width 1) 
			     (padding 20)
			     (border-radius 7)
			     (text-align center)]
		     [(and button (: hover)) ==> (border-color green) (background-color blue)]
		     [(and (: hover) (id button2)) ==> (background-color (rgbf 0.5 0.5 0.5)) (color blue)]
		     [(and (: pressed) (id button2)) ==>
		      (background-color (rgb 200 200 200)) (color blue) (transition-duration 0)]
		     [(> * (id button1)) ==> (border-width 4)]
		     [(id button1) ==>
		      (font-weight bold)]

		     [(id button2) ==> (left 200) (top 200) (width 150 !important)
		      (background-color black)
		      (transition-duration 1)]
		     [(id panel-1) ==> 
		      (width 100 %) (height 89 %) (top 0) (left 0) (position absolute) 
		      (background-color (rgb 125 125 125))]
		     [(> (id panel-1) button) ==> (width 27 %) (height 10 %)]
		     [panel ==> 
			    (background-color white)
			    (padding 10) (width 100 %) (border-style solid)
			    (border-width 1) (border-color black)]
		     [label ==>
			    (background-color white) 
			     (color black) (padding 5) (height 25) 
			     (border-width 1) (border-color blue)]
		     [hslider ==> (height 40) (color black) (background-color white)
			      (text-align center) ]
		     [(id lbl2) ==> (width 90 %) (margin 0)]
		     [(id tg1) ==> (border-width 1) (border-color red) (background-color red)
		      (width expand)  (height 230) (padding 5)]
		     [(id panel-2) ==> (height 200) (width expand) 
		      (border-color red) (border-width 1)]
		     [(id tg1::panel) ==>  (width expand)]
		     [(id tg1::button) ==> (height 50  ) (width expand)]
		     [(> (id panel-1) slider) ==> (width expand) (margin 5)]
		     [(> (id tg1::panel) panel)
			  ==> (width expand) (height auto) ]
		     [(> (id panel3) label) ==> (width expand) ]
		     [slider-box ==> (background-color blue) (border-style none)
				 (border-radius 4) ]
		     [(id slider1) ==> (width expand) (padding 5)] 
		     [(id slider2) ==> (width 25) (height expand) (padding 2)]
		     ))

    (panel 'panel-1
	 (lambda () 
	   (if (button 'button1 "CIAO")
	       (printf "BUTTON CLICKED!\n"))
	  
	   (if (button 'button2 "NAMASTE")
	       (printf "BUTTON CLICKED NAMASTE!\n"))

	   (mi-force-break 'panel-1)

	   (when (button 'button3 (format "FPS: ~,2F" mi-stat-fps))
		 (printf "BUTTON3 CLICKED!\n")
		 (toggle (not (toggle))))

	   (p10e ([mi-style '((width 200) (height 20))])
		 (label 'lbl-active (format "~d" (mi-active-item)))
		 (label 'lbl-hot (format "~d" (mi-hot-item)))
		 (label 'lbl-md (format "~d" (mi-mouse-down?))))

	   (mi-force-break 'panel-1)
		 
	   (if (toggle) 
	       (panel 'panel-2 
		      (lambda ()
			(label 'lbl1 "lalalala"))))
	   
	   (toggle-panel 'tg1 tg1-state
			 (lambda ()
			   (vslider 'slider2 slider-state)
			   (panel 'panel3 (lambda ()
					    (label 'lbl4 "67890")
					    (mi-force-break 'panel3)
					    (label 'lbl3 "111\n54321\n\nabcde\nabcde")
					    ))))

	   (hslider 'slider1 slider-state)))

  (debug-tooltip)
  ))

(init-sdl "DEMO1")

(miogui-run)

(include "miogui.ss")

(stylesheet '( [* ==> (font-family "Sans")]
	       [button ==>  
			(color red)
			(background-color (rgbf 0.1 0.1 0.8 1))

			(border 1 solid (rgbf 0 0 0.9 1))

			(border-radius 6)
			(padding 10)
			(font-size 15)
			(text-align center)
			(transition-duration 0.2)]
		[(and button (: hover)) ==> 
		 (border-color green) (background-color (rgbf 0.2 0.2 0.9 1))]
		[(> button label) ==> (color white)]
		[(and button (: pressed)) ==>
		 (background-color (rgb 200 200 200)) 
		 (color blue)
		 (transition-duration 0)]
		[(: focus) ==> 
		 (outline-style solid)
		 (outline-width 3) 
		 (outline-color (rgba 20 20 20 150))]
		[panel ==>  
		       (padding 10) (width 200 ) (height 200) 
		       (border 1 solid black) (background-color red)]

		[label ==> 
		       (color black) (padding 5) 
		       (background-color white)]
		[slider ==> (height 20) (color black) (padding 2)]

		[(id panel-1) ==> 
		 (width 600) (height 480) (top 0) (left 0) (position absolute) 
		 (background-color (rgb 125 125 125))
		 (display flex)
		 (justify-content space-around)
		 (align-items center)
		 (flex-direction column)]
		[(id label1) ==>
		 (align-self stretch)]
		[ button ==> (text-align center)]
		[ label ==> (text-align center)]
		[(or textline intline floline) 
		 ==> 
		 (border-left 15 solid red)
		 (color black) (border-style solid) 
		 (background-color white)
		 (padding 5)
		 (min-width 200)]

		[intline ==>  (text-align center) ]
		[floline ==> (text-align right)]
		))


(init-sdl "buttons")
(define my-text (make-parameter "some editable text!"))
(define my-int (make-parameter 543210))
(define my-flo (make-parameter 3.141592))
(miogui-user-render
 (lambda ()
  ;(fps 25)
  (panel 'panel-1
	 (lambda () 
	   (if (button 'button1 "BUTTON 1")
	       (printf "BUTTON 1 CLICKED!\n"))
	   
	   (if (button 'button2 (format "FRAME NUMBER: ~d" (mi-frame-number)))
	       (printf "BUTTON 2 CLICKED!\n"))

		[label ==>
		 (align-self flex-start)
		 (text-align center)
		 (color red) 
		 (padding 5) 
		 (border-width 1) 
		 (border-color blue)
		 (border-left-width 5)
		 (background-color white)]

		[(class first) ==>
		 (align-self flex-start)
		 (min-height 40) (min-width 160)]
		[(class second) ==>
		 (align-self center) ]

;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(define draw-pool '())
(define (round-rect x y width height br)
  (define-values (tlrx tlry trrx trry brrx brry blrx blry)
    (match br
	   [((tlrx tlry) (trrx trry) (brrx brry) (blrx blry))
	    (values tlrx tlry trrx trry brrx brry blrx blry)]
	   [else
	    (values 0 0 0 0 0 0 0 0)]))
  
  ;(define (h x) (car x)) (define (y x) (cadr x))
  ;(printf "br: ~d~n" br)
  (let* ([cr (mi-cr)]
	 [pi 3.1415926536] 
	 [aspect 1.0] ;;     /* aspect ratio */
	 [degrees (/ pi 180.0)])

    (cairo-new-sub-path cr)
    (cairo-save cr)
    (cairo-translate cr 
     		     (- (+ x  width) trrx)
     		     (+ y trry))    
    (if (and (< 0 trrx) (< 0 trry))
	(cairo-scale cr trrx trry))
    (cairo-arc cr 0 0 1 (* -90 degrees) (* 0 degrees))
    (cairo-restore cr)

    ;; (cairo-arc cr (- (+ x  width) (car top-left-r)) (+ y (cadr top-left-r)) 
    ;; 	       radius (* -90 degrees) (* 0 degrees))
    ;; (cairo-arc cr (- (+ x width) radius) (- (+ y height) radius) radius (* 0 degrees) (* 90 degrees))
    ;; (cairo-arc cr (+ x radius) (- (+ y height) radius) radius (* 90 degrees) (* 180 degrees))
    ;; (cairo-arc cr (+ x radius) (+ y radius) radius (* 180 degrees) (* 270 degrees))
    (cairo-close-path cr)))


(define (round-rect* x y width height border corner-radius )
  (define (setup-border i)
    (let ([x (list-ref border i)])
      (cairo-set-line-width (mi-cr) (car x))
      (cairo-set-source-color (mi-cr) (caddr x))))
  ;(set! corner-radius (min corner-radius (/ width 2) (/ height 2)))
  (let* ([cr (mi-cr)]
	 [pi 3.1415926536] 
	 [aspect 1.0] ;;     /* aspect ratio */
;	 [radius (/ corner-radius aspect)]

	 [radius 0]
	 [degrees (/ pi 180.0)])

    (cairo-move-to cr (+ x radius) y)
    (cairo-line-to cr (- (+ x width) radius) y )
    (setup-border 0)
    (cairo-stroke cr)

    (cairo-new-sub-path cr)
    (cairo-arc cr (- (+ x  width) radius) (+ y radius) radius (* -90 degrees) (* 0 degrees))
    (cairo-arc cr (- (+ x width) radius) (- (+ y height) radius) radius (* 0 degrees) (* 90 degrees))
    (setup-border 1)
    (cairo-stroke cr)

    (cairo-move-to cr (+ x radius) (+ y height))
    (cairo-line-to cr (- (+ x width) radius) (+ y height))
    (setup-border 2)
    (cairo-stroke cr)

    (cairo-new-sub-path cr)  
    (cairo-arc cr (+ x radius) (- (+ y height) radius) radius (* 90 degrees) (* 180 degrees))
    (cairo-arc cr (+ x radius) (+ y radius) radius (* 180 degrees) (* 270 degrees))
    (setup-border 3)
    (cairo-stroke cr)
    #;(cairo-close-path cr)))


(define (draw! thunk)
  (define z-index (mi-z-index))
  (when (layout-ready?)
	(let ([x (assq z-index draw-pool)])
	  (if x
	      (set-cdr! x (cons thunk (cdr x)))
	      (set! draw-pool (cons (cons z-index (list thunk)) 
			      draw-pool))))))
  
(define (draw-all)
  (let ([z-ordered-draw (sort (lambda (x y) (< (car x) (car y))) draw-pool)])
    (for-each (lambda (x) 
		(for-each (lambda (y) (y))
			    (reverse (cdr x))))
		z-ordered-draw))
 (set! draw-pool '()))

(define (mi-draw-border)
  (draw-rect* (mi-x) (mi-y) (mi-w) (mi-h) (mi-bg-color) (mi-border)
	      (mi-border-radius)))

(define (mi-draw-outline)
  (define width (mi-outline-width))
  (draw-rect (- (mi-x) width) (- (mi-y) width)
	     (+ (mi-w) width) (+ (mi-h) width)
	     (mi-outline-style) (mi-outline-color) 
	     width
	     (->color 'transparent)
	     (mi-border-radius)))

(define (draw-rect x y w h border-style border-color bw bg-color border-radius)
  (define (draw-path)
    (if (equal? border-radius '((0 0) (0 0) (0 0) (0 0)))
	(cairo-rectangle (mi-cr) (+ x bw) (+ y bw) (- w bw) (- h bw)))
	(round-rect (+ x bw) (+ y bw) (- w bw) (- h bw) border-radius))
  
  (draw! 
   (lambda ()
     (when bg-color
       (draw-path)
       (with-cairo (mi-cr)
		   (set-source-color bg-color)
		   (fill)))
     (when (not (memq border-style '(none hidden)))
       (draw-path)
       (with-cairo (mi-cr)
		   (set-line-width bw)
		   (set-source-color border-color)
		   (stroke))))))

(define (draw-rect* x y w h bg-color border  border-radius)

  (define (draw-path)
    (round-rect* x y w h border border-radius)) 
  (define (draw-bg)
    (round-rect x y w h border-radius))
  (draw! 
   (lambda ()
     (when bg-color
	   (draw-bg)
	   (with-cairo (mi-cr)
		       (set-source-color bg-color)
		       (fill)))
     
	   (draw-path))))

(define (text-extents text)
  (define font-size (mi-font-size))
  (define font-family (mi-font-family))
  (define font-style (mi-font-style))
  (define font-weight (mi-font-weight))
  (define text-align (mi-text-align))
  (define color (mi-color))

  (check-arg string? text draw-text)

  (let ([extents (cairo-text-extents-create)])
    (cairo-set-font-size (mi-cr) font-size)
    (cairo-select-font-face  (mi-cr) (string-append font-family (string #\nul))
					    (cairo-font-slant font-style) ;; normal|italic|oblique
					    (cairo-font-weight font-weight)) ;; normal|bold
    (cairo-text-extents (mi-cr) text extents)
    (let-struct extents cairo-text-extents-t 
		(width height x-bearing y-bearing x-advance y-advance)
		(list width height x-bearing y-bearing x-advance y-advance))))

(define-syntax cast
  (syntax-rules ()
    [(_ ftype fptr)
     (make-ftype-pointer ftype
			 (ftype-pointer-address fptr))]))

(define (*int ptr) (ftype-ref int () ptr))

(define (show-text cr text x y font-size)
  (define glyphs* (cairo-glyph*-create))
  (define glyph-count (cairo-int-create))
  (define clusters* (cairo-text-cluster*-create))
  (define cluster-count (cairo-int-create))
  (define clusterflags (cairo-text-cluster-flags-create))
  (define scaled-face (cairo-get-scaled-font cr))
  (define clusters #f)
  (define glyphs #f)
  
  (ftype-set! void* () (cast void* clusters*) 0)
  (ftype-set! void* () (cast void* glyphs*) 0)

  ;; THIS COULD BE CACHED SOMEWHERE?
  (unless (eq? 'success
	       (cairo-scaled-font-text-to-glyphs
		scaled-face x y text (string-length text)
		glyphs* glyph-count
		clusters* cluster-count
		clusterflags))
	  (raise (error 'show-text "stat error" stat)))

  (set! clusters (cairo-guard-pointer (ftype-&ref cairo-text-cluster-t* (*) clusters*)))
  (set! glyphs (cairo-guard-pointer (ftype-&ref cairo-glyph-t* (*) glyphs*)))

  ;; WE COULD USE cairo-show-glyphs instead?
  (let loop ([glyph-index 0] [byte-index 0] [i 0])
    (when (< i (*int cluster-count))
	  (let* ([cluster       (ftype-&ref cairo-text-cluster-t () clusters i)]
		 [clusterglyphs (ftype-&ref cairo-glyph-t () glyphs glyph-index)]
		 [extents (cairo-text-extents-create)])
	    (let-struct
	     cluster cairo-text-cluster-t (num-glyphs num-bytes)
	     (cairo-scaled-font-glyph-extents scaled-face clusterglyphs (*int glyph-count) extents)
	     ;;(printf "extents: status: ~d num-glyphs: ~d num-bytes: ~d~n" (cairo-status cr) num-glyphs num-bytes)
	     (with-cairo cr
			 (glyph-path clusterglyphs num-glyphs)
			 (set-line-width 0)
			 (fill-preserve)
			 (stroke))
	     (loop (+ glyph-index num-glyphs)
		   (+ byte-index num-bytes)
		   (+ i 1)))))))


(define (draw-text text x y w h)
  (define font-size (mi-font-size))
  (define font-family (mi-font-family))
  (define font-style (mi-font-style))
  (define font-weight (mi-font-weight))
  (define text-align (mi-text-align))
  (define color (mi-color))

  (check-arg string? text draw-text)
  (check-arg number? x draw-text)
  (check-arg number? y draw-text)
  
  (let ([extents (cairo-text-extents-create)])
       (cairo-set-font-size (mi-cr) font-size)
       (cairo-select-font-face  (mi-cr) (string-append font-family (string #\nul))
				(cairo-font-slant font-style) ;; normal|italic|oblique
				(cairo-font-weight font-weight)) ;; normal|bold
       (cairo-text-extents (mi-cr) text extents)
       (let-struct extents cairo-text-extents-t 
		   (width height x-bearing y-bearing x-advance y-advance)
		   (draw!
		    (lambda ()
		      ;(printf "font-family: ~d~n" font-family)
		      (cairo-set-font-size (mi-cr) font-size)
		      (cairo-select-font-face  (mi-cr) (string-append font-family (string #\nul))
					       (cairo-font-slant font-style) ;; normal|italic|oblique
					       (cairo-font-weight font-weight)) ;; normal|bold


		      (cairo-set-source-color (mi-cr) color)
		      (cairo-identity-matrix (mi-cr))
		      (case text-align
			[left
			 (cairo-translate (mi-cr) x (+ y height))]


			[center

			 (cairo-translate (mi-cr) (- (+ x (/ w 2)) (/ width 2)) (+ y height))]

			[right

			 (cairo-translate (mi-cr) (- (+ x w) width x-bearing) (+ y height))]
			[else
			 (cairo-translate (mi-cr) x (+ y height))])
		      
		      (show-text (mi-cr) text 0 0 font-size)
		      
		      (cairo-identity-matrix (mi-cr))))
		   
		   (list x-advance height))))

(define (draw-text/padding text x y w h)
  (draw-text text 
	     (+ (mi-padding) x)
	     (+ (mi-padding) y)
	     (- w (* 2 (mi-padding)))
	     (- h (* 2 (mi-padding)))))

(define (draw-box id class style)
  #t
  )

;; limitations under the License.

(define-record-type (mi-element make-mi-element% mi-element?)
  (fields el id class parent 
	  (mutable children)
	  (mutable style) 
	  (mutable pseudo)
	  (mutable mi-state) 
	  (mutable x) (mutable y) (mutable w) (mutable h) 
	  (mutable content-size)
	  (mutable layout-state)))

(define (mi-element->string e)
  (format "id: ~d el: ~d\nxywh: ~d ~d ~d ~d\ncontent-size: ~d\npseudo: ~d\nstyle: ~d\n" 
	  (mi-element-id e) (mi-element-el e)
	  (mi-element-x e) (mi-element-y e)
	  (mi-element-w e) (mi-element-h e)
	  (mi-element-content-size e)
	  (mi-element-pseudo e)
	  (fold (lambda (x acc) (string-append acc (format "~d" x) "\n")) ""
			(hashtable->alist (mi-element-style e)))))
  
(define element-table (make-eq-hashtable))

(define old-element-table (make-eq-hashtable))


(define (make-mi-element el id class parent)
  ;(printf "make-mi-element ~d ~d ~d~n" el id class )
  (apply make-mi-element% 
	 (map 
	  (lambda (k) 
	    (case k
	      [el el]
	      [id id]
	      [class class]
	      [pseudo '()]
	      [parent parent]
	      [mi-state #f]
	      [children '()]
	      [style (make-eq-hashtable)]
	      [(x y w h) 0]
	      [else #f]))
	  (vector->list (record-type-field-names (record-type-descriptor mi-element))))))

(define mi-el (make-parameter #f))

      [inherit 
       (cond [(mi-element-parent element)
	      => (lambda (parent)
		   (mi-style-query (mi-element-parent element) attr default inherited))]
	     [else default])]
      [initial default]
      [else v])))

(define (mi-element-pseudo-append! element pseudo)
  (mi-element-pseudo-set! element (append (mi-element-pseudo element)
					  pseudo)))

(define (check-activable element old-element activable)
  (define id (mi-element-id element))
  (when old-element
	(when activable
	      (when (not (mi-kbd-item))
		    (mi-kbd-item id)
	      (printf "KBD ITEM: ~d~n" id))
	      (when (eq? (mi-kbd-item) id)
		    (mi-element-pseudo-append! element '(focus))
		    (when (mi-key)
			  (case (mi-key)
			    [tab
			     (if (memq 'shift (mi-keymod))
				 (mi-kbd-item (mi-last-activable))
				 (mi-kbd-item #f))
			     (mi-key #f)]
			    [return
			     (mi-hot-item id) (mi-active-item id)
			     (mi-key #f)
			     ])))
	      (mi-last-activable id))
	
	(when (region-hit? (mi-element-x old-element) (mi-element-y old-element)
		     (mi-element-w old-element) (mi-element-h old-element))
	      (mi-hot-item id)
	      (when (and activable (not (mi-active-item)) (mi-mouse-down?))
		    (mi-active-item id)
		    (mi-kbd-item id))
	      (mi-element-pseudo-append!
		element
			(if (eq? (mi-active-item) id)
			    '(pressed)
			    '(hover))))))

(define (create-element el id activable thunk)
  (define element (mi-el-by-id id))
  (define parent (mi-el))
  (define old-element (hashtable-ref old-element-table id #f))

  (p10e ([mi-el element])



	;; (printf "id ~d old-element: ~d~n " id old-element)
	(when 
	 ;; if we just created the element and we are after the first pass then
	 ;; we'll need to wait until the next frame to create it
	 (or (eq? (mi-state) 'first) element)

	 (if element
	     (unless id
		     (set! id (mi-id id))))
	 (case (mi-state)



	   [ready 
	    (mi-draw-border)
	    (mi-draw-outline)
	    ]
	   [first

	    (set! element (make-mi-element el id (mi-class) parent))
	    (mi-el element)


	    (check-activable element old-element activable)








	    

	    (let ([style (guard (e [else (printf "ops in stylesheet resolve: ") 
					 (display-condition e)
					 (newline) (raise e)])
				(stylesheet-resolve element))]

		  [td 0])
	      (when old-element 
		    (let ([old-style (mi-element-style old-element) ] )
		      (set! td (mi-style-query element 'transition-duration 0 #f))
		      
		      (when (and (> td 0) (not (compare-hashes style old-style)))
			    (let ([tr (hashtable-ref transitions id #f)])
			      (if tr ;; already in transition
				  (start-transition element (style-transition 
							     (list-ref tr 1) (list-ref tr 2)
							     (get-transition-ratio tr td)) style)
				  (start-transition element old-style style)))))
	      
		    (let ([tr (hashtable-ref transitions id #f)])
		      (when tr
			    (set! style (style-transition (list-ref tr 1) (list-ref tr 2) 
							  (get-transition-ratio tr td)))))
		    (eventually-end-transition element td))
		    

	      (mi-element-style-set! element style)) ;;STYLE STUFF
	    
	    (hashtable-set! element-table id element)







	    (cond [(eq? (mi-element-position element) 'absolute)







		   (absolute-position element)])
	    (cond [(mi-element-parent element) 






		   (mi-element-add-child (mi-element-parent element) element)])])









	 (p10e ([mi-style '()])
	       (let* ([r (thunk)])




		 r)))))


(define (mi-x) (mi-element-x (mi-el)))
(define (mi-y) (mi-element-y (mi-el)))
(define (mi-w) (mi-element-w (mi-el)))
(define (mi-h) (mi-element-h (mi-el)))
(define (mi-font-style) (mi-element-font-style (mi-el)))
(define (mi-font-weight) (mi-element-font-weight (mi-el)))
(define (mi-font-size) (mi-element-font-size (mi-el)))
(define (mi-font-family) (mi-element-font-family (mi-el)))
(define (mi-color) (mi-element-color (mi-el)))
(define (mi-bg-color) (mi-element-background-color (mi-el)))
(define (mi-border-radius) (mi-element-border-radius (mi-el)))
(define (mi-border) (mi-element-border (mi-el)))
(define (mi-border-left)
  (list-ref (mi-border) 3))
(define (mi-border-top)
  (list-ref (mi-border) 0))
(define (mi-border-right)
  (list-ref (mi-border) 1))
(define (mi-border-bottom)
  (list-ref (mi-border) 2))

(define (mi-border-left-width)
  (car (mi-border-left)))
(define (mi-border-left-style)
  (cadr (mi-border-left)))
(define (mi-border-left-color)
  (caddr (mi-border-left)))

(define (mi-border-right-width)
  (car (mi-border-right)))
(define (mi-border-right-style)
  (cadr (mi-border-right)))
(define (mi-border-right-color)
  (caddr (mi-border-right)))

(define (mi-border-top-width)
  (car (mi-border-top)))

(define (mi-border-top-style)
  (cadr (mi-border-top)))
(define (mi-border-top-color)
  (caddr (mi-border-top)))

(define (mi-border-bottom-width)
  (car (mi-border-bottom)))
(define (mi-border-bottom-style)
  (cadr (mi-border-bottom)))
(define (mi-border-bottom-color)
  (caddr (mi-border-bottom)))



(define (mi-outline-color) (mi-element-outline-color (mi-el)))
(define (mi-outline-width) (mi-element-outline-width (mi-el)))
(define (mi-outline-style) (mi-element-outline-style (mi-el)))
(define (mi-z-index) (mi-element-z-index (mi-el)))
(define (mi-line-height) (mi-element-line-height (mi-el)))
(define (mi-text-align) (mi-element-text-align (mi-el)))
(define (mi-parent) (mi-element-parent (mi-el)))
(define (mi-padding) (mi-element-padding (mi-el)))
(define mi-class (make-parameter #f))
(define mi-style (make-parameter '()))
(define (mi-display) (mi-element-display (mi-el)))

(define (mi-el-by-id id) 
  (let ([e (hashtable-ref element-table id #f)])
    ;(printf "Mi-el-by-id: ~d ~d~n" id (if e #t #f))
    e))
(define mi-id
  (case-lambda 
    [() (mi-element-id (mi-el))]
    [(sub-id)
     (let ([x (if sub-id 
		  (symbol->string sub-id)
		  (format "~d" (if (mi-el) (length (mi-element-children (mi-el)) ) 0)))]) 
       (string->symbol (string-append (symbol->string (mi-id)) "-" x)))]))


(define (mi-wset id name value)
  (putprop id name value))

(define (mi-wget id name default)
  (getprop id name default))

;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

;(trace make-mi-element)
(define miogui-user-render (make-parameter values))

(define mi-current-window (make-parameter #f))

(define mi-pause (make-parameter #f))
(define mi-step (make-parameter #f))
(define (miogui-run)
  (import (only (thunder-utils) print-stack-trace))
  (define last-frame-time (current-time))

  (mi-frame-number 0)
  (printf "starting event loop..\n")
  (sdl-start-text-input)
  (call/cc 
   (lambda (quit)
     (let loop ()
       ;;(define (sdl-poll-event* . x)
       ;; (with-interrupts-disabled (apply sdl-poll-event x)))
       (when (or (not (mi-pause)) (mi-step))
	     (mi-step #f)
	     (let ([el (make-mi-element 'window 'window-1 #f 
					(make-mi-element 'null 'null #f #f))])
	       (mi-el el)
	       (mi-current-window el)
	       (mi-element-w-set! el (mi-window-width))
	       (mi-element-h-set! el (mi-window-height))
	       (mi-element-x-set! el 0)
	       (mi-element-y-set! el 0)
	       (mi-element-style-set! el (alist->hashtable 
					  `((z-index 0)
					    (width ,(mi-window-width)) 
					    (height ,(mi-window-height))
					    (position absolute)))))
	     
	     (guard (x [else (printf "ERROR IN RENDER ") 
			     (display-condition x) (newline)
			     (print-stack-trace 15)
			     (newline)
			     (printf "STOPPED: PRESS ctrl-c to continue or ctrl-s to step or ctrl-q to quit~n")
			     (mi-pause #t)])
		    (render-stuff (miogui-user-render)))
	     
	     ;;FIXME, compute the sleep time from the difference of last frame and fps
	     (sleep-s (/ 1. (fps)))
	     (set! last-frame-time (current-time))
	     (mi-frame-number (+ (mi-frame-number) 1))
	     )
       
       (let poll-event-loop ()
	 (sdl-let-ref-call 
	  sdl-poll-event ((e sdl-event-t &)) result
					;(printf "~d ~d\n" e result)
	 ; (sleep-s 0.02)
	  (when (not (zero? result))
		(let-struct 
		 e sdl-event-t (type)
		 (case (sdl-event-type-ref type)
		   [quit (printf "quit\n") (quit)]
		   [keydown (let* ([sym (sdl-event-keyboard-keysym-sym e)]
				   [mod (sdl-event-keyboard-keysym-mod e)]
				   [sym-name (sdl-keycode-ref sym)])
			      (printf "keydown ~x ~x ~d ~d\n" sym mod (sdl-keycode-ref sym) 
				      (sdl-keymod-decode mod))
			      (mi-keymod (append (list sym-name) (sdl-keymod-decode mod)))
			      (mi-key (sdl-keycode-ref sym))
			      (when (memq 'ctrl (mi-keymod))
				    (case sym-name 
				      [q (quit)]
				      [p (mi-pause #t)]
				      [c (mi-pause #f)]
				      [s (mi-step #t)])))]
		   [keyup (let* ([sym (sdl-event-keyboard-keysym-sym e)]
				 [sym-name (sdl-keycode-ref sym)])
			      (printf "keyup ~x ~d\n" sym sym-name)
			      (mi-keymod (remove sym-name (mi-keymod)))
			      )]
		   [textinput (let* ([ti (ftype-&ref sdl-event-t (text) e)]
				     [text (char*-array->string
					    (ftype-&ref sdl-text-input-event-t (text) ti) 32)])
				(printf "text input \"~d\"\n" text )
				(mi-txt text))]
		   [mousemotion (let* ([mousemotion (ftype-&ref sdl-event-t (motion) e)])
				  (let-struct mousemotion sdl-mouse-motion-event-t

				(let ([we (sdl-window-event-enum-ref event)])
				  #t))]
				  ;(printf "windowevent ~d\n" we)))]
				  ;(case we
				  ;  [enter (sdl-capture-mouse #t)])))]
				    ;[leave (sdl-capture-mouse #f)]))]
				    
		   [mousebuttondown (printf "mousebuttondown\n")]
		   ))
		(poll-event-loop))))

       







       (my-local-repl)
       (loop)
       )))
       (sdl-capture-mouse #f)
       (printf "exiting event loop\n"))

;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(import (only (srfi s1 lists) fold))

;(define layout-state (make-eq-hashtable))

(define (get-last-coords id)
  (check-arg symbol? id get-last-coords)

  (let ([e (hashtable-ref old-element-table id #f)])
    (if e 
	(parameterize ([mi-el e])
		      (values (mi-x) (mi-y) (mi-w) (mi-h)))
	(values 0 0 0 0))))

;; flex-direction: row(default)|row-reverse|column|column-reverse|initial|inherit;
;; justify-content: flex-start (default) | flex-end | center | space-between | space-around
;; align-items: flex-start (default) | flex-end | center | baseline | stretch
;; flex-wrap: nowrap (default) | wrap | wrap-reverse
;; align-content: stretch (default) | flex-start | flex-end | center | space-between | space-around
;; flex: number. where number will be used to do a proportion. default 1
;; =>>>WE DONT SUPPORT SUCH STUFF:  flex: flex-grow flex-shrink flex-basis|auto|initial|inherit; default: 0 1 auto
;; align-self: auto (default) | stretch  | flex-start | flex-end | center | space-between | space-around
(define (layout-flex parent)
  ;(printf "layout-flex ~d~n" parent)  (mi-element-id parent) (mi-element-children parent))
  (let ( [justify-content (mi-element-justify-content parent)]
	 [align-items (mi-element-align-items parent)]
	 [flex-direction (mi-element-flex-direction parent)] 
	 ;[direction (mi-element-direction parent)]
	 [children 
	  (sort (lambda (a b) 


		  (< (mi-element-order a) (mi-element-order b)))
		(reverse (mi-element-children parent)))]
	 [current-x 0] [current-y 0]
	 [p-w (- (mi-element-w parent) (* 2 (mi-element-padding parent)))]
	 [p-h (- (mi-element-h parent) (* 2 (mi-element-padding parent)))]
	 [p-x (+ (mi-element-padding parent ) (mi-element-x parent))]
	 [p-y (+ (mi-element-padding parent) (mi-element-y parent))]
	 [new-w 0] [new-h 0])
     (let ([total-w    (fold (lambda (e acc) (+ acc (mi-element-w e)))    0 children)]
	   [total-h    (fold (lambda (e acc) (+ acc (mi-element-h e)))    0 children)]
	   [flex-total (fold (lambda (e acc) (+ acc (mi-element-flex e))) 0 children)]
	   )
       (define (default-size e)
	 (let* ([csz (mi-element-content-size e)]

			    (set! main-pos next-main-pos)
			    (set! next-main-pos (+ main-pos main-size))]
			   [center 
			    (set! main-pos next-main-pos)
			    (set! next-main-pos (+ main-pos main-size))]
			   [space-between 
			    (set! main-pos next-main-pos)
			    (set! next-main-pos (+ main-pos main-size 
						   (if (> n-items 1)
						       (/ free-space (- n-items 1))
						       0)))]
			   [space-around 
			    (set! main-pos next-main-pos)
			    (set! next-main-pos (+ main-pos main-size (/ free-space (+ n-items 1) )))]
			   [stretch ;;NON STANDARD! :D
			    (set! main-size (* (/ flex flex-total) p-main-size))]
			   
			   [else (printf "layout-flex: error unsupported justify-content: ~d~n" 
					 justify-content)])
			 (cond
			  [dir? ; row
			    (mi-element-y-set! e cross-pos)
			    (mi-element-w-set! e main-size)
			    (mi-element-h-set! e cross-size)
			    ;; FIXME: this is calculated differently with wrap.
			    (set! new-w (+ new-w main-size))
			    ;(printf "id ~d new-h ~d cross-size ~d~n" (mi-element-id e) new-h cross-size)
			    (set! new-h (max new-h cross-size))]
			   [else ; column
			    (mi-element-x-set! e cross-pos)
			    (mi-element-h-set! e main-size)
			    (mi-element-w-set! e cross-size)
			    ;; FIXME: this is calculated differently with wrap.
			    (set! new-h (+ new-h main-size))

			   [column-reverse
			    (let ([rel-main-pos (- main-pos p-main-pos)])
			      (mi-element-y-set! e (- (+ p-main-pos p-main-size) 
						      (- main-pos p-main-pos) 
						      main-size )))])
			   
			 #;(printf "~d size ~d ~d ~d ~d ~d ~d~n" (mi-element-id e) main-pos main-size cross-pos cross-size new-w new-h)))
		children)
      (mi-element-content-size-set! parent (list new-w new-h))))))

(define (mi-element-add-child parent element)
  ;(printf "child add: ~d > ~d~n" (mi-element-id parent) (mi-element-id element))
  (mi-element-children-set! parent (cons element (mi-element-children parent))))

(define (layout-block parent)
  ;(printf "layout-block ~d ls ~d~n" (mi-element-id parent) (mi-state))
  (let* ([children 
	  (sort (lambda (a b) 
		  (< (mi-element-order a) (mi-element-order b)))
		(reverse  (mi-element-children parent)))]
	[n-items (length children)]
	[current-x 0] [current-y 0]
	[p-padding (mi-element-padding parent)]
	[p-w (case (mi-state) 
		  [first (if (number? (mi-element-width parent))
			     (mi-element-width parent)
			     0)]
		  [second (mi-element-w parent)])]
	[p-h (case (mi-state) 
		  [first (if (number? (mi-element-height parent))
			     (mi-element-height parent)
			     0)]
		  [second (mi-element-h parent)]) ]
	[p-x (+ p-padding (mi-element-x parent))]
	[p-y (+ p-padding (mi-element-y parent))]
	[new-w 0] [new-h 0]
	[s-x p-x] [s-y p-y] [s-w 0] [s-h 0])
   ;(printf "parent id ~d xywh ~d ~d ~d ~d ~d ~n" (mi-element-id parent) p-x p-y p-w p-h  p-padding)
    (for-each 
     (lambda (e)
       (cond [(eq? (mi-element-el e) 'force-break)
	     (set! s-x +inf.0)]
	     [(eq? (mi-element-position e) 'absolute) 
	      (layout-element e)]
	     [else
	      (layout-element e)
	      (let*([position (mi-element-position e)]
		 [x (case position [static 0] [relative (mi-element-left e)])]
		 [y (case position [static 0] [relative (mi-element-top e)])]
		 [h (mi-element-height e)]
		 [w (mi-element-width e)]
		 [w-max (let loop ([p parent][m 0])
		      (if p (if (number? (mi-element-width p))
				(- (mi-element-width p) m)
				(loop (mi-element-parent p) (+ m (* 2 (mi-element-padding p)))))
			  0))]
		 [h-max (let loop ([p parent] [m 0]) 
		      (if p (if (number? (mi-element-height p))
				(- (mi-element-height p) m)
				(loop (mi-element-parent p)  (+ m (* 2 (mi-element-padding p)))))
			  0))]
		 [margin (mi-element-margin e)]
		 [padding (mi-element-padding e)]
		 [parent (mi-element-parent e)]
		 [csz (mi-element-content-size e)]
		 [sz-w (+ (* 2 padding) (if (list? csz) (car csz) 0))]
		 [sz-h (+ (* 2 padding) (if (list? csz) (cadr csz) 0))]
		 [w* (case w 
			    [expand 0]
			    [auto sz-w]
			    [else (max w sz-w)])]
		 [h* (case h
			    [expand 0]
			    [auto  sz-h]
			    [else (max h sz-h)])])
	   ;(printf "block ~d ~d ~d ~d ~d ~d ~d ~d s: ~d ~d ~d ~d padding ~d max: ~d ~d~n" (mi-element-id e) x y w h w* h* csz s-x s-y s-w s-h padding w-max h-max)
	     (cond 
	      #;[(equal? `(s-x s-y s-w s-h) '(0 0 0 0))
	      (values (list (+ p-x margin p-padding)))]
	      [(> (+ w* s-w s-x (* 2 p-padding)) p-w)
	       ;; LINE BREAK
	       (if (eq? w 'expand) (set! w* (max w* w-max)))
	       (if (eq? h 'expand) (set! h* (max h* h-max)))
	       (mi-element-x-set! e (+ x p-x  margin))
	       (mi-element-y-set! e (+ y margin s-y s-h))
	       (set! s-x (+ x p-x margin))
	       (set! s-y (+ y s-y s-h))
	       (set! s-w (+ w*  2 margin))
	       (set! s-h (+ h* (* 2 margin)))]




	      [else 
	       ;; SAME LINE
	       (if (eq? w 'expand) (set! w* (- w-max s-w )))
	       (if (eq? h 'expand) (set! h* (- h-max s-h (* 2 (mi-padding)))))
	       
	       (mi-element-x-set! e (+ x s-x s-w margin))
	       (mi-element-y-set! e (+ y margin s-y))
	       (set! s-x (+ x s-x s-w margin))
	       (set! s-y (+ y s-y))
	       (set! s-w (+ x w* margin))
	       (set! s-h (max (+ h* margin) s-h))])

	     (mi-element-w-set! e w*) 
	     (mi-element-h-set! e h*)

	     ;(printf "block ~d x ~d y ~d w ~d h ~d ~n" 
		     (mi-element-id e) (mi-element-x e)
		     (mi-element-y e) (mi-element-w e) (mi-element-h e))]
	     ))
     children)
    (mi-element-content-size-set! parent (list s-w (+ s-h (- s-y p-y))))
    (mi-element-w-set! parent (max s-w p-w))
    (mi-element-h-set! parent (+ s-h (- s-y p-y)))
    #;(printf "s-y p-y s-h ~d ~d ~d sz: ~d wh: ~d ~d~n" s-y p-y s-h 
	    (mi-element-content-size parent) 
	    (mi-element-w parent) (mi-element-h parent))
    ))


(define (absolute-position element)
  (check-arg mi-element? element layout-element)
  (let* ( [x (mi-element-left element)]
	  [y (mi-element-top element)]

	  [w (mi-element-width element)];(style-query (mi-element-style element) 'width 0)]
	  [h (mi-element-height element)];(style-query (mi-element-style element) 'height 0)]

	  [padding (mi-element-padding element)]


	  [csz (mi-element-content-size element)]
	  [sz-w (+ (if (list? csz) (car csz) 0)  (* 2 padding))]
	  [sz-h (+ (if (list? csz) (cadr csz) 0) (* 2 padding))]
	  [w* (case w 

		[auto sz-w]
		[else (max sz-w w)])]
	  [h* (case h

		[auto sz-h]
		[else (max sz-h h)])])

	  (check-arg number? w* layout-element)
	  (check-arg number? h* layout-element) 

	  ;; FIXME absolute should positioned relative to the nearest positioned ancestor (e.g. not static)


    (mi-element-x-set! element x)
    (mi-element-y-set! element y)
    (mi-element-w-set! element w*)
    (mi-element-h-set! element h*)
    (mi-element-layout-state-set! element #t)))










(define (mi-force-break id)
  (check-arg symbol? id mi-force-break)
  (mi-element-add-child (mi-el-by-id id) (make-mi-element 'force-break  #f #f id)))





;; (case (mi-element-display element)
;;     [(flex block)




;;      (mi-element-children-set! element '())]
;;     [else
;;      (printf "start-layout: unsupported display: ~d~n" (mi-element-display element))]))

(define (layout-element element)
  (check-arg mi-element? element layout-element)
  ;(printf "layout element ~d~n" (mi-element-id element))
  (case (mi-element-position element)
    [absolute
     (absolute-position element)])
  (case (mi-element-display element)
    [block
     (layout-block element)]
    [flex

     (layout-flex element)]
    [else #f]))
    

;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

#!chezscheme




(debug-level 3)
(optimize-level 0)
(sdl-library-init)
(cairo-library-init)
(print-record #f)
(run-cp0 (lambda (cp0 x) x))

(import (chezscheme)
	(sdl2)
	(cairo))

(define mi-window (make-parameter #f))
(define mi-renderer (make-parameter #f))
(define mi-window-width (make-parameter 640))
(define mi-window-height (make-parameter 480))
(define mi-sdl-texture (make-parameter #f))

(include "css.ss")

(include "layout.ss")

(include "transition.ss")

(include "element.ss")
(include "css-element.ss")

(include "widgets.ss")

(include "render.ss")

(include "repl.ss")
      
(include "event-loop.ss")

  

;;
;; Unless required by applicable law or agreed to in writing, software
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(define mi-state (make-parameter 'first))
(define (layout-ready?) (eq? (mi-state) 'ready))

(define (render-prepare)
  (define tex (mi-sdl-texture))
  (define r0 (make-ftype-pointer sdl-rect-t 0))
  
  (sdl-set-render-draw-color (mi-renderer) 0 0 0 1)
  (sdl-render-clear (mi-renderer))
  (mi-cairo-surface 
   (sdl-let-ref-call sdl-lock-texture 
		     (tex r0 (pixels void*) (pitch int)) 
		     return
		     (cairo-image-surface-create-for-data 
		      (make-ftype-pointer unsigned-8 pixels)
		      (cairo-format 'argb-32) (mi-window-width) (mi-window-height) pitch)))
  
  (mi-cr (cairo-create (mi-cairo-surface)))

  (with-cairo (mi-cr)
	      (set-source-rgb 1 1 1) ; blank scrren
	      (rectangle 0 0 (mi-window-width) (mi-window-height))
	      (fill))
  (mi-hot-item #f))




(define (render-finish)
  (if (not (mi-mouse-down?))
      (mi-active-item #f)
      (if (not (mi-active-item))
	  (mi-active-item '())))
  (draw-all)
  
  (sdl-unlock-texture (mi-sdl-texture))
  (sdl-render-copy (mi-renderer) (mi-sdl-texture)
		   (make-ftype-pointer sdl-rect-t 0) 
		   (make-ftype-pointer sdl-rect-t 0))
  
  (sdl-render-present (mi-renderer))
  (collect)
  (sdl-free-garbage))

(define last-frame (current-time))

(define mi-stat-fps 0)

(define (render-stuff user-render-func)
  (set! old-element-table element-table)
  (set! element-table (make-eq-hashtable))
  (render-prepare)

  (p10e ([mi-state 'first])
	;(printf "LAYOUT PASS: ~d~n" 'first)
	(user-render-func))

  (layout-element (mi-current-window))

  (p10e ([mi-state 'ready])
	;(printf "LAYOUT PASS: ~d~n" 'ready)
	(user-render-func))

  (render-finish)
  
  (let ([d (time-difference (current-time) last-frame)])
    ;(printf "frame-duration: ~d~n" (time-float d))
    ;(printf "fps: ~d~n" (/ 1. (time-float d)))
    (set! mi-stat-fps (/ 1. (time-float d)))
    (set! last-frame (current-time))))

;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(define transitions (make-eq-hashtable))






(define (get-transition-ratio trans duration)
  (cond 
   [(zero? duration) 1.0]
   [trans
    (let* ([t (current-time)]
	   [d (time-float (time-difference t (car trans)))])
      (/ d duration))]

	 (define name (car a))
	 (define val (value-or-list (cadr a)))
	 (define val2 (style-query style-b name val))
	 ;(printf "name val val2 ~d ~d ~d~n" name val val2)
	 (if (equal? val val2)
	     a
	     (case name
	       [(width height min-width min-height left top border-radius border-width font-size padding margin) 
		(if (and (number? val) (number? val2))
		    (list name (number-transition val val2 ratio))
		    (list name val2))]
	       [(color background-color border-left-color border-bottom-color border-right-color border-bottom-color)
		(list name (guard (e [else (->color val2)])
			     (color-transition (->color val) (->color val2) ratio)))]
	       [(border-color)
		(list name (map (lambda (c c2)
				  (color-transition c c2 ratio))
				val val2))]
	       [else (list name val2)])))
       (hashtable->alist style-a))))

;; USE make-compile-time-value perhaps
 
(alias p10e parameterize)

(define (compare-hashes a b)
  (check-arg hashtable? a compare-hashes)
  (check-arg hashtable? b compare-hashes)
  ;(printf "~d ~d ~d~n" (mi-id) (hashtable->alist a) (hashtable->alist b))
  (letrec ([cmp (lambda (x y) 
		  (< (symbol-hash (car x)) (symbol-hash (car y))))]
	   [sort-hash (lambda (x)
			(sort cmp (hashtable->alist x)))])
    (equal? (sort-hash a) (sort-hash b))))

(define (none? x)
  (eq? x 'none))

(define (not-none? x)
  (not (none? x)))

(define (panel id children-thunk)
  ;(define-values (x y w h) (get-last-coords id))
  (create-element 
   'panel id #f 
   (lambda ()
     ;(printf "panel element: ~d ~d ~d ~d ~d~n" (mi-el) (mi-x) (mi-y) (mi-w) (mi-h))
     ;(draw-rect (mi-x) (mi-y) (mi-w) (mi-h))
     ;(start-layout (mi-el))
     (children-thunk)
     ;(end-layout (mi-el))
     )))

(define (symbol-append sym s)
  (string->symbol (string-append (symbol->string sym) s)))

(define (toggle-panel id state children-thunk)
  ;(define-values (x y w h) (get-last-coords id))
  (create-element 
   'toggle-panel id #f
   (lambda ()
     ;(printf "toggle-panel element: ~d ~d ~d ~d ~d~n" (mi-el) (mi-x) (mi-y) (mi-w) (mi-h)) 
     ;(draw-rect (mi-x) (mi-y) (mi-w) (mi-h))
     ;(start-layout (mi-el))
     (if (button (symbol-append id "::button") "HI")
	 (state (not (state))))
     (when (state)
	   (mi-force-break id)
	   (panel (symbol-append id "::panel") 
		  children-thunk))
     ;(end-layout (mi-el))
     ))
  (state))


(define (button id text)
  (create-element 'button id #t
   (lambda ()
     (define-values (x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h)))
     ;(draw-rect x y w h)
     (let ([extents (draw-text/padding text x y w h)])
       (mi-element-content-size-set! (mi-el) extents))
     
     (and (layout-ready?) 
	  (not (mi-mouse-down?))
	  (eq? (mi-hot-item) id)
	  (eq? (mi-active-item) id)))))

(define (label id text)
  (import (only (srfi s14 char-sets) char-set)
	  (only (thunder-utils) string-split))
  (create-element 'label id #f
		  (lambda ()
		    (define-values (x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h)))
		    ;(draw-rect x y w h)
		    (let ([lines (string-split text (char-set #\newline))]
			  [x* (+ (mi-padding) x)] 
			  [y* (+ (mi-padding) y)] 
			  [w* 0]
			  [h* (* (mi-line-height) (mi-font-size))])
		      (if (= 1 (length lines))
			  (let ([extents (draw-text/padding (car lines) x y w h)])
			    (set! w* (car extents)))
			  (let loop ([l lines])
			    (unless (null? l)
			      (let ([extents (draw-text (car l) x* y* 
							(- w (* 2 (mi-padding) ))
							h*)])
				(set! y* (+ y* (* (mi-line-height) (mi-font-size))))
				(set! w* (max w* (car extents)))
				(loop (cdr l))))))
		      (set! h* (* (length lines) (* (mi-line-height) (mi-font-size))))
		      (mi-element-content-size-set! (mi-el) (list w* h*)))
		    #f)))

(define (menu id text thunk)
  (if (button (symbol-append id "::button") text)
      (mi-wset id 'showmenu (not (mi-wget id 'showmenu #f))))
  (when (mi-wget id 'showmenu #f)
    (p10e ([mi-style '((position absolute) (left 10) (top 10)
		       (display flex) (flex-direction column) (align-items stretch))])
	  (panel (symbol-append id "::panel") 
		 thunk))))

(define (debug-tooltip)
  (define id (mi-hot-item))
  (when (and id (memq 'lalt (mi-keymod )))
	(let-values ([(x y w h) (get-last-coords id)])
	  (if (region-hit? x y w h)
	      (p10e ([mi-style `((z-index 1)
					 (position absolute) 
					 (left ,(+ 5 (mi-mouse-x)))
					 (top ,(+ 5 (mi-mouse-y))))])
			    (label (symbol-append id "::debug") 
				   (mi-element->string (mi-el-by-id id))))))))

(define (hslider id state)
  (create-element 'hslider id #t
   (lambda ()
     (let-values ([(x y w h) (get-last-coords id)])
       ;(draw-rect x y w h)
       ;(start-layout (mi-el))
       (let ([l (* (- w (* 2 (mi-padding)) 20) (state))])
	 (p10e ([mi-style `((width 20) (height expand) (position relative) (left ,l))])
	       (create-element 
		'slider-box (symbol-append id "::box") #t
		(lambda () #t
		  #;(let-values ([(x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h))])
		    (draw-rect x y w h))))))
       ;(end-layout (mi-el))
       (let ([extents (draw-text/padding (format "~,3F" (state)) x y w h)])
	 (mi-element-content-size-set! (mi-el) extents))
       
       (when (and (> w 0) (eq? (mi-active-item) id))
	     (let ([val (/ (- (mi-mouse-x) x) w)])
	       (if (< val 0) (set! val 0))
	       (if (> val 1) (set! val 1))
	     (cond [(not (= (state) val))
		    (state val)
		    #t]
		   [else #f])))))))
  

(define (vslider id state)
  (create-element 'vslider id #t
   (lambda ()
     (let-values ([(x y w h) (get-last-coords id)])
       ;(draw-rect x y w h)
       ;(start-layout (mi-el))
       (let ([l (* (- h (* 2 (mi-padding)) 20) (state))])
	 (p10e ([mi-style `((width expand) (height 20) (position relative) (top ,l))])
	       (create-element 
		'slider-box (symbol-append id "::box") #t
		(lambda () #t
		  #;(let-values ([(x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h))])
		    (draw-rect x y w h))))))
       ;(end-layout (mi-el))
       ;(let ([extents (draw-text/centered (format "~,3F" (state)) (+ 0 x (/ w 2)) (+ 0 y (/ h 2)))])
       ;(mi-element-content-size-set! (mi-el) extents))
       
       (when (and (> h 0) (eq? (mi-active-item) id))
	     (let ([val (/ (- (mi-mouse-y) y) h)])
	       (if (< val 0) (set! val 0))
	       (if (> val 1) (set! val 1))

     (define (cursor-pos-move dir)
       (let ([cp (cursor-pos)])
	 (cond
	  [(and (< dir 0) (> cp 0))
	   (mi-wset id 'cursor-pos (- cp 1))]
	  [(and (> dir 0) (< cp (string-length (text))))
	   (mi-wset id 'cursor-pos (+ cp 1))])))
     ;(draw-rect x y w h)
     (if (> (cursor-pos) (string-length (text)))
	 (mi-wset id 'cursor-pos (string-length (text))))

     (when (eq? (mi-kbd-item) id)
       (let ([txt (text)]
	     [txt-len (string-length (text))])
	 (case (mi-key)