Check-in [989c34f966]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:added support for z-index css
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:989c34f966b00d8b2f12495468b611c28fa2a618
User & Date: aldo 2016-09-06 09:07:31
Context
2016-09-06
09:08
added remote-repl check-in: 0da0d1eefe user: aldo tags: trunk
09:07
added support for z-index css check-in: 989c34f966 user: aldo tags: trunk
09:06
use display-condition instead of our print-condition, improved repl check-in: 1cb1fedb47 user: aldo tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to css.ss.

16
17
18
19
20
21
22
23

24
25
26
27
28
29
30
..
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
..
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72

(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-style solid)
			     (border-color red)
................................................................................
		     [(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 50 !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 ==> 
................................................................................
		      (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-style none)
				 (border-radius 4)]
		     [(id slider1) ==> (height 25) (width expand) (padding 5)] 
		     [(id slider2) ==> (width 25) (height expand) (padding 2)]
		     ))

(define (hashtable->alist ht)







|
>







 







|







 







|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
..
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73

(define default-stylesheet '(box ))

(define stylesheet '([* ==> 
			(position static)
			(box-sizing border-box)
			(font-family "Sans")
			(font-size 12)
			(z-index auto)]
		     [button ==>
			     (width 100) 
			     (height 50) 
			     (color red)
			     (background-color (rgbf 0 1 0 0.5))
			     (border-style solid)
			     (border-color red)
................................................................................
		     [(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 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 ==> 
................................................................................
		      (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-style none)
				 (border-radius 4)]
		     [(id slider1) ==> (height 25) (width expand) (padding 5)] 
		     [(id slider2) ==> (width 25) (height expand) (padding 2)]
		     ))

(define (hashtable->alist ht)

Changes to draw.ss.

9
10
11
12
13
14
15


16
17
18
19
20
21
22
..
24
25
26
27
28
29
30

















31
32
33




34
35
36
37
38


39
40
41
42
43
44
45
46
47
48
49
50
51
52






53
54
55
56





57
58
59
60
61
62
63
64

65
66
67
68
69
70
71
72
73
74
75
;;     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))




  (define (draw-path)
    (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))))



  (when (mi-bg-color)
	(draw-path)
	(with-cairo (mi-cr)
	      ;(cairo-scale 640 480)
	      (set-source-color (mi-bg-color))
	      (fill)))
  (when (not-none? (mi-border-style))
	(draw-path)
	(with-cairo (mi-cr)
		    (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
  )







>
>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>



>
>
>
>

|
|

|
>
>
|
|
|
<
|
|
|
|
|
|
|
|


>
>
>
>
>
>



<
>
>
>
>
>
|
|
|
|
|
<
<
<
>
|
|
|
|
|
|





9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
..
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95



96
97
98
99
100
101
102
103
104
105
106
107
;;     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 draw-pool '())

(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! thunk)
  (define z-index (mi-z-index))
  (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 (draw-rect x y w h)
  (define bw (mi-border-width))
  (define border-color (mi-border-color))
  (define border-radius (mi-border-radius))
  (define bg-color (mi-bg-color))
  (define border-style (mi-border-style))

  (define (draw-path)
    (if (> border-radius 0)
	(round-rect (+ x bw) (+ y bw) (- w bw) (- h bw) border-radius)
	(cairo-rectangle (mi-cr) (+ x bw) (+ y bw) (- w bw) (- h bw))))
  
  (draw! 
   (lambda ()
     (when bg-color
       (draw-path)
       (with-cairo (mi-cr)

		   (set-source-color bg-color)
		   (fill)))
     (when (not-none? border-style)
       (draw-path)
       (with-cairo (mi-cr)
		   (set-line-width bw)
		   (set-source-color border-color)
		   (stroke))))))

(define (draw-text/centered text x y)
  (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 color (mi-color))

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

  (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)
		(draw!
		 (lambda ()
		   (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
		   



		   
					;		(printf "x ~d y ~d~n" x y)
		   (cairo-set-source-color (mi-cr) 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
  )

Changes to element.ss.

19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
..
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
..
95
96
97
98
99
100
101

102
103
104
105
106
107
108
...
114
115
116
117
118
119
120





121
122
123
124
125
126
127
...
145
146
147
148
149
150
151

152
153
154
155
156
157

158
	  (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)
................................................................................
	  (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))
................................................................................
  (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-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)] ))
................................................................................
(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 '()))


(define (mi-el-by-id id) (hashtable-ref element-table id #f))







|
>







 







|







 







>







 







>
>
>
>
>







 







>






>

19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
..
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
...
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
...
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
	  (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)
	  (mutable z-index)))
  
(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)
................................................................................
	  (lambda (k) 
	    (case k
	      [el el]
	      [id id]
	      [class class]
	      [pseudo pseudo]
	      [parent parent]
	      [(x y w h margin padding z-index) 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))
................................................................................
  (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-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))

  (let ([z-index (style-query style 'z-index 'auto)])
    (if (eq? z-index 'auto)
	(mi-element-z-index-set! element (mi-element-z-index (mi-element-parent element)))
	z-index))

  ;(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)] ))
................................................................................
(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-z-index) (mi-element-z-index (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-el-by-id id) (hashtable-ref element-table id #f))

Changes to render.ss.

32
33
34
35
36
37
38


39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
  (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)







>
>
|



|
|
|
|







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
  (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)
  (draw-all)

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

Changes to widgets.ss.

80
81
82
83
84
85
86
87

88
89
90
91
92
93
94


(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







|
>







80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95


(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 `((z-index 1)
					 (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