Apache License
                           Version 2.0, January 2004
                        http://www.apache.org/licenses/

   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION

   1. Definitions.
................................................................................
      of your accepting any such warranty or additional liability.

   END OF TERMS AND CONDITIONS

   APPENDIX: How to apply the Apache License to your work.

      To apply the Apache License to your work, attach the following
      boilerplate notice, with the fields enclosed by brackets "{}"
      replaced with your own identifying information. (Don't include
      the brackets!)  The text should be enclosed in the appropriate
      comment syntax for the file format. We also recommend that a
      file or class name and description of purpose be included on the
      same "printed page" as the copyright notice for easier
      identification within third-party archives.

   Copyright {yyyy} {name of copyright owner}

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

       http://www.apache.org/licenses/LICENSE-2.0

   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.

                                 Apache License
                           Version 2.0, January 2004
                        http://www.apache.org/licenses/

   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION

   1. Definitions.
................................................................................
      of your accepting any such warranty or additional liability.

   END OF TERMS AND CONDITIONS

   APPENDIX: How to apply the Apache License to your work.

      To apply the Apache License to your work, attach the following
      boilerplate notice, with the fields enclosed by brackets "[]"
      replaced with your own identifying information. (Don't include
      the brackets!)  The text should be enclosed in the appropriate
      comment syntax for the file format. We also recommend that a
      file or class name and description of purpose be included on the
      same "printed page" as the copyright notice for easier
      identification within third-party archives.

   Copyright [yyyy] [name of copyright owner]

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

       http://www.apache.org/licenses/LICENSE-2.0

   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.

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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 default-stylesheet '(box ))

(define stylesheet '([* ==> 
			(position static)
			(box-sizing border-box)
			(font-family "Sans")
			(font-size 12)]
		     [button ==>
		       (width 100) 
		      (height 50) 
		      (color red)
		      (background-color (rgbf 0 1 0 0.5))
		      (border-color red)
		      (border-width 1) 
		      (border-radius 7) ]
		     [(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)]
		     ;[(or button (id button1)) ==> (width 300)]
		     [(id button1) ==>
		      (font-weight bold)
		      (padding 7)]
		     [(id button2) ==> (left 200) (top 200) (width expand !important)
		      (background-color black)
		      (transition-duration 0.2)]
		     [(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 ==> 
			    (padding 10) (width 100 %)]
		     [label ==>
			     (color black) (padding 5)
			     (border-width 1) (border-color blue)]
		     [slider ==> (height 20) (color black)]
		     [(id lbl2) ==> (width 90 %) (margin 0)]
		     [(id tg1) ==> (border-width 1) (border-color red) (background-color red)
		      (width expand) (height 200) (padding 5)]
		     [(id panel-2) ==> (height 200) (width expand) (border-color red) (border-width 1)]
		     [(id tg1::panel) ==>  (height 100 ) (width expand)]
		     [(id tg1::button) ==> (height 50  ) (width expand)]
		     [(> (id panel-1) slider) ==> (width expand) (margin 5)]
		     [(> (id tg1::panel) panel)
			  ==> (width expand) (height expand) ]
		     [(> (id panel3) label) ==> (width expand)]
		     [slider-box ==> (background-color blue) (border-color red) ]
		     [(id slider1) ==> (height 25) (width expand) (padding 5)] 
		     [(id slider2) ==> (width 25) (height expand) (padding 2)]
		     ))

(define (hashtable->alist ht)
   (let-values ([(keys values) (hashtable-entries ht)])
     (vector->list (vector-map list keys values))))

(define (alist->hashtable alist)
  (define hash (make-eq-hashtable))
  (for-each
   (lambda (x)  
     (hashtable-set! hash (car x) (if (and (list? x) (< (length x) 2)) 
				      (cadr x) 
				      (cadr x)))
     (hashtable-ref hash (car x) #f))
   alist)
  hash)

(define (compare-specifity x y)
  ;(printf "~d ~d~n" x y)
    (cond
     [(< (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]))
(define (preprocess-attrs element aa)
  (define parent (mi-element-parent element))
  (let loop ([l aa] [res '()])
    (if (null? l) res
	(let* ([x (car l)]
	       [attr (car x)] [val (cdr x)])
	  ;(printf "attr: ~d val: ~d ~n" attr val)
	  (loop (cdr l)
		(append ;(case attr
			#;[(border) `((border-top ,@val) 
				    (border-left ,@val) 
				    (border-bottom ,@val) 
				    (border-right ,@val))]
		 (match val 
			[(v '% . y) (cond [(eq? attr 'width)
					   (list 
					    (append 
					     (list attr (* (/ v 100.)
							   (mi-element-h parent)) ) y))]
					   [(eq? attr 'height)
					    (list (append
						   (list attr (* (/ v 100.)
								 (mi-element-h parent))) y))])]
			[else (list x)])
		      res))))))

;(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 parent (mi-element-parent element))
  (define pseudo (mi-element-pseudo element))
  (define el (mi-element-el element))
  (define style (mi-style))
  
  (define matches '())
  (define hash (make-eq-hashtable))
  (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* specifity)
		 ; (printf "selector: ~d id: ~d pseudo: ~d~n" selector id* pseudo*)
		  (match selector
			 ['%%style (match specifity [(a b c d e) (list 1 b c d e)])]
			 [('id (? (cut eq? <> id*) x)) (match specifity [(a b c d e) (list a (+ 1 b) c d e)])]
			 [('class (? (cut eq? <> class*) x)) (match specifity [(a b c d e) (list a b (+ 1 c) d e)])] 
			 [(': (? (cut eq? <> pseudo*) x)) (match specifity [(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* specifity) 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* specifity) 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)
					 specifity))]
			 ;[('+ e f) (for-each (cut process-selector <> '+) sel)]
			 ['* '(0 0 0 0 1)]
			 [(? (cut eq? <> element*) e) 
			  (match specifity [(a b c d e) (list a b c (+ d 1) e)])]
			 [else 
			  ;;(printf "~d does not match~n" (car selectors)) 
			  specifity]))
		(let ([sp (process-selector (car selectors) 'type id class el pseudo '(0 0 0 0 0))])
		  ;(printf "Specifity: ~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-specifity (car x) (car y))) 
	 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))))

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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 (round-rect x y width height corner-radius)
  (let* ([cr (mi-cr)]
	 [pi 3.1415926536]
	 [aspect 1.0] ;;     /* aspect ratio */
	 [radius (/ corner-radius aspect)]
	 [degrees (/ pi 180.0)])

    (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))
    (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 (draw-rect x y w h)
  (define bw (mi-border-width))
  (define border-color (mi-border-color))

  (when (mi-bg-color)
	(with-cairo (mi-cr)
	      ;(cairo-scale 640 480)
	      (set-source-color (mi-bg-color))
	      (if (> (mi-border-radius) 0)
		  (round-rect (+ x bw) (+ y bw) (- w bw) (- h bw) (mi-border-radius))
		  (cairo-rectangle (mi-cr) (+ x bw) (+ y bw) (- w bw) (- h bw)))
	      (fill-preserve)))
  (with-cairo (mi-cr)
	      ;(cairo-scale 640 480)
	      (set-line-width bw)
	      (set-source-color border-color)
	      (stroke)))

(define (draw-text/centered text x y)
  (check-arg string? text draw-text/centered)
  (check-arg number? x draw-text/centered)
  (check-arg number? y draw-text/centered)

  (cairo-set-font-size (mi-cr) (mi-font-size))
  (cairo-select-font-face  (mi-cr) (string-append (mi-font-family) (string #\nul))
			   (cairo-font-slant (mi-font-style)) ;; normal|italic|oblique
			   (cairo-font-weight (mi-font-weight))) ;; normal|bold
 
  (let ([extents (cairo-text-extents-create)])
    (cairo-text-extents (mi-cr) text extents)
    (let-struct extents cairo-text-extents-t (width height x-bearing y-bearing)
;		(printf "x ~d y ~d~n" x y)
		(cairo-set-source-color (mi-cr) (mi-color))
		(cairo-move-to (mi-cr) 
			       (- x (/ width 2) x-bearing)
			       (- y (/ height 2) y-bearing))
		(cairo-show-text (mi-cr) text)
		(list width height))))

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

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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-record-type (mi-element make-mi-element% mi-element?)
  (fields el id class parent
	  (mutable style) (mutable pseudo)
	  (mutable layout-state) (mutable position) (mutable x) (mutable y) (mutable w) (mutable h) 
	  (mutable color) (mutable bg-color)
	  (mutable border-width) (mutable border-color) (mutable border-style) (mutable border-radius)  
	  (mutable transition-duration) 
	  (mutable font-family) (mutable font-size) (mutable font-weight) (mutable font-style)
	  (mutable padding) (mutable margin)
	  (mutable content-size)))
  
(define element-table (make-eq-hashtable))

(define style-table (make-eq-hashtable))
(define content-size-table (make-eq-hashtable))

(define (make-mi-element el id class pseudo parent)
  (apply make-mi-element% 
	 (map 
	  (lambda (k) 
	    (case k
	      [el el]
	      [id id]
	      [class class]
	      [pseudo pseudo]
	      [parent parent]
	      [(x y w h margin padding) 0]
	      [else #f]))
	  (vector->list (record-type-field-names (record-type-descriptor mi-element))))))

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

(define (value-or-list r)
  (if (and (list? r) (< (length r) 2))
      (car r)
      r))

(define (style-query style attr default)
  (let ([r (hashtable-ref style attr default)])
    (value-or-list r)))


(define (create-element el id activable thunk)
  (let ([old-style (widget-old-style id)]
	[element #f] [td #f] [style #f] [pseudo #f])
    (define-values (x y w h) (get-last-coords id))

    (when (and (number? w) (number? h) (region-hit? x y w h))
	  (mi-hot-item id)
	  (when (and activable (not (mi-active-item)) (mi-mouse-down?))
		(mi-active-item id))
	  (if (eq? (mi-active-item) id)
	      (set! pseudo 'pressed)
	      (set! pseudo 'hover)))

  (set! element (make-mi-element el id (mi-class) pseudo (mi-el)))
  
  (set! style (stylesheet-resolve element))
  (hashtable-set! style-table id style)
  
  (set! td (style-query style 'transition-duration 0))

  (when (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-content-size-set! element (hashtable-ref content-size-table id #f))
  (mi-element-style-set! element style)
  (mi-element-position-set! element (style-query style 'position 'absolute))
  
  (mi-element-padding-set! element (style-query style 'padding 0))
  (mi-element-margin-set! element (style-query style 'margin 0))

  (mi-element-border-color-set! element (->color (style-query style 'border-color 'black)))
  (mi-element-border-style-set! element (style-query style 'border-style 'none))
  (mi-element-border-width-set! element (style-query style 'border-width 1))
  (mi-element-border-radius-set! element (style-query style 'border-radius 0))

  (mi-element-color-set! element (->color (style-query style 'color 'white)))
  (mi-element-bg-color-set! element (->color (style-query style 'background-color 'white)))

  (mi-element-font-family-set! element (style-query style 'font-family "Sans"))
  (mi-element-font-size-set! element (style-query style 'font-size 12))
  (mi-element-font-weight-set! element (style-query style 'font-weight 'normal))
  (mi-element-font-style-set! element (style-query style 'font-style 'normal))

  (mi-element-x-set! element (style-query style 'left 0))
  (mi-element-y-set! element (style-query style 'top 0))
  (mi-element-w-set! element (style-query style 'width 'none))
  (mi-element-h-set! element (style-query style 'height 'none))

  (let-values ([(x y w h) (layout-element element)])
    (mi-element-x-set! element x)
    (mi-element-y-set! element y)
    (mi-element-w-set! element w)
    (mi-element-h-set! element h))

  ;(define border (style-query style 'border 'none))
  ;
  ;; (define-values (border-type border-width border-color)
  ;;   (match border 
  ;; 	   ['none (values 'none 0 #f)] 
  ;; 	   [(solid ,width ,color) (values 'solid width color)] ))

  (hashtable-set! element-table id element)
  (hashtable-set! layout-state id #f)
  (parameterize ([mi-el element])
		(let* ([r (thunk)]
		      [sz (mi-element-content-size element)])
		  (hashtable-set! content-size-table id sz)
		  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-bg-color (mi-el)))
(define (mi-border-radius) (mi-element-border-radius (mi-el)))
(define (mi-border-color) (mi-element-border-color (mi-el)))
(define (mi-border-width) (mi-element-border-width (mi-el)))
(define (mi-border-style) (mi-element-border-style (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 '()))

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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.

;(trace make-mi-element)
(define (event-loop)
  (define last-frame-time (current-time))
  (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)))
       (let ([el (make-mi-element 'window 'window-1 #f #f #f)])
	 (mi-el 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-position-set! el 'absolute))

       (guard (x [else (printf "ERROR IN RENDER ") (print-condition x) #;(sleep-s 1) #f])
	      (render-stuff))
       
       (let poll-event-loop ()
	 (sdl-let-ref-call 
	  sdl-poll-event ((e sdl-event-t &)) result
	  ;(printf "~d ~d\n" e result)
	  (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 (event-keyboard-keysym-sym e)]
				   [sym-name (sdl-keycode-ref sym)])
			      (printf "keydown ~x ~d\n" sym (sdl-keycode-ref sym))
			      (if (eq? sym-name 'q) (quit)))]
		   [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 )
				(if (string=? text "q") (quit)))]
		   [mousemotion (let* ([mousemotion (ftype-&ref sdl-event-t (motion) e)])
				  (let-struct mousemotion sdl-mouse-motion-event-t
					      (x y xrel yrel state)
					      (mi-mouse-x x) (mi-mouse-y y)
					      (if (region-hit? 0 0 (mi-window-width) (mi-window-height))
						  (sdl-capture-mouse #t)
						  (sdl-capture-mouse #f))
					      ;(printf "mouse moved ~d ~d ~d ~d ~d" x y xrel yrel state)
					      ))]
		   [mousewheel (let* ([wheel (ftype-&ref sdl-event-t (wheel) e)])
				 (let-struct wheel sdl-mouse-wheel-event-t (x y window-id)
					     (printf "mouse wheel ~d ~d\n" x y)))]
		   
		   [mousebuttondown (let* ([button (event-mouse-button e)]
					   [button-name (sdl-button-ref button)])
				      (printf "mouse down ~d ~d\n" button button-name)
				      (when (eq? button-name 'left)
					    (mi-mouse-down? #t)))]
		   [mousebuttonup (let* ([button (event-mouse-button e)]
					 [button-name (sdl-button-ref button)])
				    (printf "mouse up ~d ~d\n" button button-name)
				    (when (eq? button-name 'left)
					  (mi-mouse-down? #f)))]
		   [windowevent 
		    (let-struct (ftype-&ref sdl-event-t (window) e) sdl-window-event-t (event)
				(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))))
       ;;(sleep (make-time 'time-duration (exact (truncate (* 10e6  (/ 60. (fps))))) 0))
              
       ;;FIXME, compute the sleep time from the difference of last frame and fps
       (sleep-s (/ 1. (fps)))
       ;(let ([t (time-nanosecond (time-difference (current-time) last-frame-time ))])
       ;  (printf "t: ~d ms ~d fps~n" (exact->inexact (/ t 1000000)) (exact->inexact (/ 1000000000 t))))
       (set! last-frame-time (current-time))
       ;(sdl-delay (exact (truncate (/ 1000. (fps)))))
       (my-local-repl)
       (loop)
       )))
       (sdl-capture-mouse #f)
       (printf "exiting event loop\n"))

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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 layout-state (make-eq-hashtable))

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

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

(define (layout-element element)  

  (check-arg mi-element? element layout-element)

  (let* ([position (mi-element-position element)]
	 [x (if (eq? position 'static) 0 (mi-element-x element))]
	 [y (if (eq? position 'static) 0 (mi-element-y element))]
	 [w (mi-element-w element)]
	 [h (mi-element-h element)]
	 [margin (mi-element-margin element)]
	 [padding (mi-element-padding element)]
	 [parent (mi-element-parent element)]
	 [p-padding (mi-element-padding parent)]
	 [csz (mi-element-content-size element)]
	 [w* (case w 
	       [expand 0]
	       [none (+ (* 2 padding) (if (list? csz) (car csz) 0))]
	       [else w])]
	 [h* (case h
	       [expand 0]
	       [none  (+ (* 2 padding) (if (list? csz) (cadr csz) 0))]
	       [else h])]
	 )
   ; (printf "h ~d w ~d h* ~d w* ~d position ~d csz ~d~n" h w h* w* position csz)
    (cond [(eq? position 'absolute)
 	   (values x y w* h*)] ;; FIXME absolute should positioned relative to the nearest positioned ancestor (e.g. not static)
	  [else 
	   (let* ([p-id (mi-element-id parent)]
		  [state (hashtable-ref layout-state (mi-element-id parent) #f)]
		  [p-x (mi-element-x parent)]
		  [p-y (mi-element-y parent)]
		  [p-w (mi-element-w parent)]
		  [p-h (mi-element-h parent)])
		  ;; (printf "state: ~d x ~d y ~d w ~d h ~d p-x ~d p-y ~d p-w ~d p-h ~d upd ~d~n" state x y w h p-x p-y p-w p-h update)
	     (match state
		    [(s-x s-y s-w s-h) 
		     ;(printf "w: ~d~n" w)
		     
		     (let-values 
			 ([(new-state ret)
			  (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* (- p-w (* 2 p-padding) (* 2 margin) )))
			    (if (eq? h 'expand) (set! h* (- p-h (* 2 p-padding) (* 2 margin) )))
			    (values
			     (list (+ x p-x p-padding margin) 
				   (+ y s-y s-h) 
				   (+ w*  2 margin)
				   (max (+ h* (* 2 margin)) s-h))
			     (list (+ x p-x p-padding margin) 
				   (+ y margin s-y s-h)
				   w* 
				   h*))]
			   [else 
			    ;; SAME LINE
			    (if (eq? w 'expand) (set! w* (- p-w s-w (* 2 p-padding) (* 2 margin) )))
			    (if (eq? h 'expand) (set! h* (- p-h (* 2 p-padding) (* 2 margin) )))
			    (values
			     (list (+ x s-x s-w margin) 
				   (+ y s-y)
				   (+ x w* margin)
				   (max (+ h* margin)  s-h))
			     (list (+ x s-x s-w margin)
				   (+ y margin s-y)
				   w* 
				   h*))])])
		       (hashtable-set! layout-state p-id new-state)
		       (apply values ret))]
		    [else (values 0 0 0 0)]))])))

(define (mi-force-break id)
  (check-arg symbol? id mi-force-break)
  (let ([coord (hashtable-ref layout-state id #f)])
    (if coord
	(hashtable-set! layout-state id (match coord [(x y w h) (list 99999999 0 0 (+ h y))])))))
  
(define (start-layout element)
  (check-arg mi-element? element start-layout)
  (hashtable-set! layout-state (mi-element-id element) 
		  (list (+ (mi-element-padding element) (mi-element-x element)) 
			(+ (mi-element-padding element) (mi-element-y element)) 0 0)))
(define (end-layout element)
  (check-arg mi-element? element end-layout)
  (hashtable-set! layout-state (mi-element-id element) #f))

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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
(import (chezscheme)
	(sdl2)
	(cairo))

(debug-level 3)
(optimize-level 0)
(sdl-library-init)
(cairo-library-init)

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

(define (init-sdl)
  (assert (= 0 (sdl-init (sdl-initialization 'video))))
  
  (mi-window (sdl-create-window  "Hello World!" 100 100 
				(mi-window-width) (mi-window-height) 
				(sdl-window-flags 'shown)))
  (assert (not (ftype-pointer-null? (mi-window))))
  
  (mi-renderer (sdl-create-renderer (mi-window) -1 
				    (sdl-renderer-flags 'accelerated)));;; 'presentvsync)))
  (assert (not (ftype-pointer-null? (mi-renderer))))

  (mi-sdl-texture (sdl-create-texture (mi-renderer) (sdl-pixelformat 'argb-8888) 
				      (sdl-texture-access 'streaming) 
				      (mi-window-width) (mi-window-height))))

(init-sdl)

(define mi-mouse-x (make-parameter 0))
(define mi-mouse-y (make-parameter 0))
(define mi-mouse-down? (make-parameter #f))
(define mi-hot-item (make-parameter #f))
(define mi-active-item (make-parameter #f))
(define mi-active-window 'none)
(define mi-cr (make-parameter #f))
(define mi-cairo-surface (make-parameter #f))

(define fps (make-parameter 25))

(import (srfi s26 cut)) 
(import (matchable))

(include "utils.ss")

(include "draw.ss")

(include "css.ss")

(include "layout.ss")

(include "transition.ss")

(include "element.ss")

(include "widgets.ss")

(include "render.ss")

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

(event-loop)
  

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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 (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 0 0 0) ; 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 '())))
   (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 stat-fps 0)
(define toggle (make-parameter #f))
(define tg1-state (make-parameter #f))

(define slider-state 
  (make-parameter 0.25 
		  (lambda (x) 
		    (fps (+ 1 (* 100 x)))
		    x)))

(define (render-stuff&)
  (render-prepare)
  (panel 'panel-1
	 (lambda () 
	   (if (button 'button1 "CIAO")
	       (printf "BUTTON CLICKED!\n"))
	   (if (button 'button2 "NAMAST66E")
	       (printf "BUTTON CLICKED NAMASTE!\n"))
	   (mi-force-break 'panel-1)
	   (when (button 'button3 (format "FPS: ~,2F" 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 'lbl3 "123455")
					    (mi-force-break 'panel3)
					    (label 'lbl4 "67890")))))
	   
	   (hslider 'slider1 slider-state)))

  (debug-tooltip)
  
  (render-finish))

(define (render-stuff )
  (render-stuff&)
  (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! stat-fps (/ 1. (time-float d)))
    (set! last-frame (current-time))))

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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.

(import (nanomsg))
(nanomsg-library-init)
(define my-local-repl-sock (nn-socket AF_SP NN_REP))
(define my-local-repl-eid (nn-bind my-local-repl-sock "tcp://127.0.0.1:9888"))

(define (my-local-repl)
  (call/cc 
   (lambda (return)
     (let* ([buf (box #t)]
	    [r (nn-recv my-local-repl-sock buf NN_MSG NN_DONTWAIT)])
       (when r
	     (printf "in my-local-repl ~d~n" (utf8->string (unbox buf)))
	     (with-input-from-string (utf8->string (unbox buf))
	       (lambda ()
		 (let ([pr (call-with-string-output-port
			    (lambda (p)
			      (parameterize 
			       ([current-output-port p])
				 (guard (e [else (print-condition e) ])
					(let* ([token (read)]
					       [x (eval token (interaction-environment))])
					  (pretty-print x))))))])
			  (nn-send my-local-repl-sock (string->utf8 pr) 0)))))))))

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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 transitions (make-eq-hashtable))


(define (widget-old-style id)
  (check-arg symbol? id widget-old-style)
  (hashtable-ref style-table id (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))]
   [else 0]))

(define (color->list c)
  (list (color-r c) (color-g c) (color-b c) (color-a c)))

(define (list->color c)
  (apply make-color c))

(define (number-transition a b r)
  (check-arg number? a number-transition)
  (check-arg number? b number-transition)
  (check-arg number? r number-transition)

  (+ a (* (- b a) r)))

(define (color-transition color1 color2 ratio)
  (check-arg color? color1 color-transition)
  (check-arg color? color2 color-transition)
  (check-arg number? ratio color-transition)
  
  (apply make-color
	 (map (lambda (f)
		(number-transition (f color1) (f color2) ratio) )
	      (list color-r color-g color-b color-a))))

;  (list->color (map (lambda (a b) (+ a (* (- b a) ratio))) 
;		    (color->list color1) (color->list color2))))
(define style? hashtable?)

(define (start-transition element style-a style-b)
  (check-arg mi-element? element start-transition)
  (check-arg style? style-a start-transition)
  (check-arg style? style-b start-transition)

  ;(printf "starting transition of ~d from ~d to ~d" (mi-element-id element) (hashtable->alist style-a) (hashtable->alist style-b))
  (let ([time (current-time)])
    (hashtable-set! transitions (mi-element-id element) (list time style-a style-b))))

(define (end-transition element)
  (check-arg mi-element? element end-transition)
  (hashtable-delete! transitions (mi-element-id element)))

(define (eventually-end-transition element duration)
  (check-arg mi-element? element eventually-end-transition)
  (check-arg number? duration eventually-end-transition)

  (let ([t (hashtable-ref transitions (mi-element-id element) #f)])
    (if (and t (> (time-float (time-difference (current-time) (car t))) duration))
	(end-transition element)
	#f)))

(define (style-transition style-a style-b ratio)
  (check-arg style?  style-a style-transition)
  (check-arg style?  style-b style-transition)
  (check-arg number? ratio style-transition)

  (alist->hashtable
   (map (lambda (a)
	 (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 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-color) 
		(list name (color-transition (->color val) (->color val2) ratio))]
	       [else a])))
       (hashtable->alist style-a))))

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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-syntax check-arg
  (lambda (stx)
    (syntax-case stx ()
      [(_ pred val caller)
       (and (identifier? #'val) (identifier? #'caller))
       #'(unless (pred val)
		 (assertion-violationf 'caller "check-arg failed (~d ~d:~d) " 'pred 'val val))])))


(define (print-condition e)
  (printf "~d: ~d with irritants ~d~n" 
	  (if (who-condition? e) (condition-who e) 'unknown)
	  (if (message-condition? e) (condition-message e) "")
	  (if (irritants-condition? e) (condition-irritants e) "")))

(define (region-hit? x y w h)
  (check-arg number? x region-hit?)
  (check-arg number? y region-hit?)
  (check-arg number? w region-hit?)
  (check-arg number? h region-hit?)

  (not (or (< (mi-mouse-x) x) (< (mi-mouse-y) y)
	   (>= (mi-mouse-x) (+ x w))
	   (>= (mi-mouse-y) (+ y h)))))

(define (float-sec->time-duration d)
  (check-arg number? d float-sec->time-duration)
  (if (>= d 1) 
      (let ([trunc (exact (truncate d))])
	(make-time 'time-duration (exact (truncate (* 1000000000 (- d trunc)))) trunc))
      (make-time 'time-duration (exact (truncate (* 1000000000 d))) 0)))

(define (sleep-s s)
  (check-arg number? s sleep-s)
  (sleep (float-sec->time-duration s)))

(define-ftype-allocator new-uint32 uint32)
(define-ftype-allocator new-int int)

;; (let ([format (new-uint32)] [access (new-int)] [w (new-int)] [h (new-int)])
;;   (sdl-query-texture tex format access w h)
;;   (printf "~x ~d ~d ~d\n" format access w h))

;; (sdl-let-ref-call sdl-query-texture 
;; 		  (tex (format uint32) (access int) (w int) ( h int)) 
;; 		  result
;; 		  (printf "~x ~d ~d ~d -> ~d\n" format access w h result) )

;; (define r (new-struct sdl-rect-t (x 0) (y 0) (w 10) (h 10)))

;; (let-struct r sdl-rect-t (x y w h) 
;; 	    (printf "~d ~d ~d ~d\n" x y w h)

;; 	    ;(sdl-delay 1000)
;; 	    )

(define (time-float x)
  (check-arg time? x time-float)
  (+ (time-second x) (/ (time-nanosecond x) 10e8)))

(define color-table '((black (0 0 0 1))
		      (white (1 1 1 1))
		      (red (1 0 0 1))
		      (green (0 1 0 1))
		      (blue (0 0 1 1))
		      (transparent (0 0 0 0))))

(define (name->color x)
  (check-arg symbol? x name->color)
  (cond [(assq x color-table) => (lambda (y) (apply make-color (cadr y)))]
	[else #f]))

(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 #f])]
    [else (errorf '->color "unknown color ~d" x)]))


;; FIXME FIND A WAY TO CREATE A MACRO THAT GENERATES A UNIQUE ID EACH TIME IT IS EXPANDED
;; 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)

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

;; * MIOGUI *
;;
;; Copyright 2016 Aldo Nicolas Bruno
;;
;; Licensed under the Apache License, Version 2.0 (the "License");
;; you may not use this file except in compliance with the License.
;; You may obtain a copy of the License at
;;
;;     http://www.apache.org/licenses/LICENSE-2.0
;;
;; 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 (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)
     (draw-text/centered text (+ 0 x (/ w 2)) (+ 0 y (/ h 2)))
     
     ;;return
     (and (not (mi-mouse-down?))
	  (eq? (mi-hot-item) id)
	  (eq? (mi-active-item) id)))))

(define (label id text)
  (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 ([extents (draw-text/centered text (+ 0 x (/ w 2)) (+ 0 y (/ h 2)))])
		      (mi-element-content-size-set! (mi-el) extents))
		    #f)))

(define (box id text)
  (create-element 'box id #f
		  (lambda ()
		    (define-values (x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h)))
		    (draw-rect x y w h))))

(define (debug-tooltip)
  (define id (mi-hot-item))
  (when id
	(let-values ([(x y w h) (get-last-coords id)])
	  (if (region-hit? x y w h)
	      (parameterize ([mi-style `((position absolute) 
					 (left ,(mi-mouse-x)) 
					 (top ,(mi-mouse-y)) )])
			    (label (symbol-append id "::debug") (symbol->string id)))))))


(define (hslider id state)
  (create-element 'hslider id #t
   (lambda ()
     (let-values ([(x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h))])
       (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 ()
		  (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 (> 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) (values (mi-x) (mi-y) (mi-w) (mi-h))])
       (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 ()
		  (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))
	     (cond [(not (= (state) val))
		    (state val)
		    #t]
		   [else #f])))))))