Check-in [14e16b667a]
Not logged in

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

Overview
Comment:reorganized some code, implemented flexbox layout, added full css color names, more demos
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:14e16b667a7593ae5c837cb2cc634c31fd9c1551
User & Date: aldo 2016-09-09 11:43:26
Context
2016-09-09
12:01
added demo screenshots check-in: 65efcbde7c user: aldo tags: trunk
11:43
reorganized some code, implemented flexbox layout, added full css color names, more demos check-in: 14e16b667a user: aldo tags: trunk
2016-09-06
09:54
added support for multiline text in label check-in: ac3d1dbdb1 user: aldo tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Deleted README.md.

1
2
3
4
5
6
# miogui
MIOGUI - More Immediate Operation GUI - Develop GUI in scheme in incremental & immediate mode!

Alpha version! Need some cleanup and some more widgets & demos...

You'll need chez scheme 9.4 and thunderchez
<
<
<
<
<
<












Added css-color.ss.











































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165

(define color-list
  '((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)
    (blanchedalmond 	255 235 205)
    (blue 	0 0 255)
    (blueviolet 	138 43 226)
    (brown 	165 42 42)
    (burlywood 	222 184 135)
    (cadetblue 	95 158 160)
    (chartreuse 	127 255 0)
    (chocolate 	210 105 30)
    (coral 	255 127 80)
    (cornflowerblue 	100 149 237)
    (cornsilk 	255 248 220)
    (crimson 	220 20 60)
    (cyan 	0 255 255)
    (darkblue 	0 0 139)
    (darkcyan 	0 139 139)
    (darkgoldenrod 	184 134 11)
    (darkgray 	169 169 169)
    (darkgreen 	0 100 0)
    (darkkhaki 	189 183 107)
    (darkmagenta 	139 0 139)
    (darkolivegreen 	85 107 47)
    (darkorange 	255 140 0)
    (darkorchid 	153 50 204)
    (darkred 	139 0 0)
    (darksalmon 	233 150 122)
    (darkseagreen 	143 188 143)
    (darkslateblue 	72 61 139)
    (darkslategray 	47 79 79)
    (darkturquoise 	0 206 209)
    (darkviolet 	148 0 211)
    (deeppink 	255 20 147)
    (deepskyblue 	0 191 255)
    (dimgray 	105 105 105)
    (dodgerblue 	30 144 255)
    (firebrick 	178 34 34)
    (floralwhite 	255 250 240)
    (forestgreen 	34 139 34)
    (fuchsia 	255 0 255)
    (gainsboro 	220 220 220)
    (ghostwhite 	248 248 255)
    (gold 	255 215 0)
    (goldenrod 	218 165 32)
    (gray 	128 128 128)
    (green 	0 128 0)
    (greenyellow 	173 255 47)
    (honeydew 	240 255 240)
    (hotpink 	255 105 180)
    (indianred 	205 92 92)
    (indigo 	75 0 130)
    (ivory 	255 255 240)
    (khaki 	240 230 140)
    (lavender 	230 230 250)
    (lavenderblush 	255 240 245)
    (lawngreen 	124 252 0)
    (lemonchiffon 	255 250 205)
    (lightblue 	173 216 230)
    (lightcoral 	240 128 128)
    (lightcyan 	224 255 255)
    (lightgoldenrodyellow 	250 250 210)
    (lightgreen 	144 238 144)
    (lightgrey 	211 211 211)
    (lightpink 	255 182 193)
    (lightsalmon 	255 160 122)
    (lightseagreen 	32 178 170)
    (lightskyblue 	135 206 250)
    (lightslategray 	119 136 153)
    (lightsteelblue 	176 196 222)
    (lightyellow 	255 255 224)
    (lime 	0 255 0)
    (limegreen 	50 205 50)
    (linen 	250 240 230)
    (magenta 	255 0 255)
    (maroon 	128 0 0)
    (mediumaquamarine 	102 205 170)
    (mediumblue 	0 0 205)
    (mediumorchid 	186 85 211)
    (mediumpurple 	147 112 219)
    (mediumseagreen 	60 179 113)
    (mediumslateblue 	123 104 238)
    (mediumspringgreen 	0 250 154)
    (mediumturquoise 	72 209 204)
    (mediumvioletred 	199 21 133)
    (midnightblue 	25 25 112)
    (mintcream 	245 255 250)
    (mistyrose 	255 228 225)
    (moccasin 	255 228 181)
    (navajowhite 	255 222 173)
    (navy 	0 0 128)
    (oldlace 	253 245 230)
    (olive 	128 128 0)
    (olivedrab 	107 142 35)
    (orange 	255 165 0)
    (orangered 	255 69 0)
    (orchid 	218 112 214)
    (palegoldenrod 	238 232 170)
    (palegreen 	152 251 152)
    (paleturquoise 	175 238 238)
    (palevioletred 	219 112 147)
    (papayawhip 	255 239 213)
    (peachpuff 	255 218 185)
    (peru 	205 133 63)
    (pink 	255 192 203)
    (plum 	221 160 221)
    (powderblue 	176 224 230)
    (purple 	128 0 128)
    (red 	255 0 0)
    (rosybrown 	188 143 143)
    (royalblue 	65 105 225)
    (saddlebrown 	139 69 19)
    (salmon 	250 128 114)
    (sandybrown 	244 164 96)
    (seagreen 	46 139 87)
    (seashell 	255 245 238)
    (sienna 	160 82 45)
    (silver 	192 192 192)
    (skyblue 	135 206 235)
    (slateblue 	106 90 205)
    (slategray 	112 128 144)
    (snow 	255 250 250)
    (springgreen 	0 255 127)
    (steelblue 	70 130 180)
    (tan 	210 180 140)
    (teal 	0 128 128)
    (thistle 	216 191 216)
    (tomato 	255 99 71)
    (turquoise 	64 224 208)
    (violet 	238 130 238)
    (wheat 	245 222 179)
    (white 	255 255 255)
    (whitesmoke 	245 245 245)
    (yellow 	255 255 0)
    (yellowgreen 	154 205 50)))

(define color-table 
  (begin (let ([t (make-eq-hashtable)])
	   (for-each (lambda (p)
		       (hashtable-set! t (car p) (cdr p)))
		     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 #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)]))

Changes to css.ss.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
76
77
78
79
...
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150

151

152
153

154
155
156
157
158
159
160
161
162

163
164

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
;;
;; 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)
			(line-height 1.2)
			(z-index auto)]
		     [button ==>
			     (width 100) 
			     (height 50) 
			     (color red)
			     (background-color (rgbf 0 1 0 0.5))
			     (border-style solid)
			     (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 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 ==> 
			    (padding 10) (width 100 %) (border-style solid)
			    (border-width 1) (border-color black)]
		     [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-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)
   (let-values ([(keys values) (hashtable-entries ht)])
     (vector->list (vector-map list keys values))))

(define (alist->hashtable alist)
  (define hash (make-eq-hashtable))
................................................................................
  (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))







<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|









|
>
|
>
|
|
>
|
|
|
|
|
|
|
|
|
>
|
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|

|

|







10
11
12
13
14
15
16


17





















































18
19
20
21
22
23
24
..
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
;;
;; 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 stylesheet (make-parameter '()))






















































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

Added demo1.ss.

























































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
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
108

(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 100) 
			     (height 50) 
			     (color red)
			     (background-color (rgbf 0 1 0 0.5))
			     (border-style solid)
			     (border-color red)
			     (border-width 1) 
			     (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)
		      (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 ==> 
			    (padding 10) (width 100 %) (border-style solid)
			    (border-width 1) (border-color black)]
		     [label ==>
			     (color black) (padding 5) (height 25)
			     (border-width 1) (border-color blue)]
		     [hslider ==> (height 40) (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-style none)
				 (border-radius 4)]
		     [(id slider1) ==> (width expand) (padding 5)] 
		     [(id slider2) ==> (width 25) (height expand) (padding 2)]
		     ))

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

(miogui-user-render
 (lambda ()
    (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 "123455\n54321\nabcde")
					    )))) 
	   
	   (hslider 'slider1 slider-state)))

  (debug-tooltip)))

(init-sdl "DEMO1")

(miogui-run)

Added demo2.ss.































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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

(include "miogui.ss")

(stylesheet '(  [button ==>
			(width 100) 
			(height 50) 
			(color red)
			(background-color (rgbf 0.1 0.1 0.8 1))
			(border-style solid)
			(border-color (rgbf 0 0 0.9 1))
			(border-width 1) 
			(border-radius 7)
			(padding 10)
			(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)]

		[panel ==> 
		       (padding 10) (width 200 ) (height 200) 
		       (border-style solid) (background-color red)
		       (border-width 1) (border-color black)]
		[label ==>
		       (color black) (padding 5) 
		       (border-width 1) (border-color blue)]
		[slider ==> (height 20) (color black) (padding 2)]

		[(id panel-1) ==> 
		 (width 100 %) (height 89 %) (top 0) (left 0) (position absolute) 
		 (background-color (rgb 125 125 125))
		 (display flex)
		 (justify-content space-around)
		 (align-items flex-center)
		 (flex-direction column)]
		[(id label1) ==>
		 (align-self stretch)
		 (height 50)]
		))


(init-sdl "buttons")

(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"))
	   (when (button 'button3 (format "FPS: ~,2F" mi-stat-fps))
		 (printf "BUTTON3 CLICKED!\n"))
	   (label 'label1 "GOOD MORNING!")))
  (debug-tooltip)))

(miogui-run)

Added demo3.ss.























































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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

(include "miogui.ss")

(stylesheet '(  [panel ==> 
		       (padding 10) 
		       (border-style solid) 
		       (background-color red)
		       (border-width 1) 
		       (border-color black)]
		[label ==>
		 (align-self flex-start)
		       (color red) 
		       (padding 5) 
		       (border-width 1) 
		       (border-color blue)]

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

		[(class second) ==>
		 (align-self flex-center) ]
		[(class third) ==>
		 (align-self flex-end)
		 (order 2) (color blue) ]
		[(class fourth) ==>
		 (align-self stretch) 
		 (align-self flex-end) ]

		[(class great) ==> 
		 (position absolute) (display flex)
		 (background-color (rgb 125 125 125))]

		[(id panel1) ==> 
		 (width 500) (height 100) (top 10)
		 (flex-direction row)
		 (justify-content flex-end)]

		[(id panel2) ==> 
		 (width 200) (height 220) (top 120)
		 (flex-direction column)
		 (justify-content flex-start)]

		[(id panel3) ==> 
		 (width 200) (height 220) (top 120) (left 220)
		 (flex-direction column-reverse)
		 (justify-content space-around)]
		[(id panel4) ==> 
		 (width 500) (height 100) (top 350) (left 30)
		 (flex-direction row-reverse)
		 (justify-content space-between)]))

(init-sdl "FLEXBOX1 align-items")

(fps 25)
(miogui-user-render
 (lambda ()
  (define some-labels (lambda ()
			(p10e ([mi-class 'first])
			      (label (mi-id 'l1) "l1: flex-start"))
			(p10e ([mi-class 'second])
			      (label (mi-id 'l2) "l2: flex-center"))
			(p10e ([mi-class 'third]) 
			      (label (mi-id 'l3) "l3: flex-end , order 1"))
			(p10e ([mi-class 'fourth])
			      (label (mi-id 'l4) "l4: stretch"))))

  (p10e ([mi-class 'great])
        (panel 'panel1 some-labels)
        (panel 'panel2 some-labels)
        (panel 'panel3 some-labels)
	(panel 'panel4 some-labels))
  (debug-tooltip)))

(miogui-run)

Changes to element.ss.

11
12
13
14
15
16
17
18
19
20
21
22
23
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
..
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
108
109
110
111
112
113
114
115
116
117
118
119


















120
121
122
123
124







125









126
127
128
129
130
131
132
133
134
135
136
137
138
139

140
141
142

143

144
145
146
147
148
149
150
151
...
161
162
163
164
165
166
167

168
169
170








;; 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 line-height)
	  (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)

  (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 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)
................................................................................
      (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-line-height-set! element (style-query style 'line-height 1.2))

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

















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

  (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-z-index) (mi-element-z-index (mi-el)))
(define (mi-line-height) (mi-element-line-height (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))















|









|
>
>
>
>
>
>
>
>
>
>







>









>







 







<

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

|
|
|
|
|
|

|






|
|


|
|
|
|
|
|
|

|
|
|
|

<
|
|

|
|
|
|
|

|
|
|
|

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
|
|
>
>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
|
|
|
|

|
|
|
|
|
|

<
<
>
|
|
|
>
|
>
|







 







>

<

>
>
>
>
>
>
>
>
11
12
13
14
15
16
17
18
19
20
21
22
23
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
..
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
108
109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182


183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
...
207
208
209
210
211
212
213
214
215

216
217
218
219
220
221
222
223
224
;; 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 children)
	  (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 line-height)
	  (mutable padding) (mutable margin)
	  (mutable content-size)
	  (mutable z-index)
	  (mutable display)
	  (mutable justify-content)
	  (mutable flex-direction)
	  (mutable flex)
	  (mutable direction)
	  (mutable align-items) (mutable align-self)
	  (mutable min-width) (mutable min-height)
	  (mutable text-align)
	  (mutable box-sizing)
	  (mutable order)))
  
(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)
  ;(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 pseudo]
	      [parent parent]
	      [children '()]
	      [(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)
................................................................................
      (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)
  (unless id
    (set! id (mi-id id)))
  (let-values ([(last-x last-y last-w last-h) (get-last-coords id)])
    (let ([old-style (widget-old-style id)]
	  [element #f] [td #f] [style #f] [pseudo #f])


      (when (and (number? last-w) (number? last-h) (region-hit? last-x last-y last-w last-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 'static))
      
      (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-line-height-set! element (style-query style 'line-height 1.2))

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

      (mi-element-display-set! element (style-query style 'display 'block))

      (mi-element-justify-content-set! element (style-query style 'justify-content 'flex-start))
      (mi-element-align-items-set! element (style-query style 'align-items 'stretch))
      (mi-element-align-self-set! element (style-query style 'align-self 'auto))
      (mi-element-flex-direction-set! element (style-query style 'flex-direction 'row))
      (mi-element-flex-set! element (style-query style 'flex '1))
      (mi-element-min-width-set! element (style-query style 'min-width 0))
      (mi-element-min-height-set! element (style-query style 'min-height 0))
      (mi-element-text-align-set! element (style-query style 'text-align 'left))
      (mi-element-direction-set! element (style-query style 'direction 'ltr))
      (mi-element-box-sizing-set! element (style-query style 'box-sizing 'border-box))
      (mi-element-order-set! element (style-query style 'order 0))
      
      (let ([display (style-query style 'display 'block)])
	(mi-element-display-set! element display)    
	(case display
	  [block
	   (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))]
	  [flex
					;(mi-element-x-set! element last-x)
					;(mi-element-y-set! element last-y)
					;(mi-element-w-set! element last-w)
					;(mi-element-h-set! element last-h)
					;(mi-element-add-child (mi-element-parent element) element)
	   #t
	   ]
	  [else (printf "create-element: error wrong value for display: ~d~n" display)]))

      (cond [(eq? (mi-element-display (mi-element-parent element)) 'flex)
	     (mi-element-x-set! element last-x)
	     (mi-element-y-set! element last-y)
	     (mi-element-w-set! element last-w)
	     (mi-element-h-set! element last-h)
	     (mi-element-add-child (mi-element-parent element) element)])

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




      (parameterize ([mi-el element])
	(let* ([r (thunk)]
	       [sz (mi-element-content-size element)])
	  (hashtable-set! layout-state id #f)
	  (hashtable-set! content-size-table id sz)
	  (hashtable-set! element-table id element)
	  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-z-index) (mi-element-z-index (mi-el)))
(define (mi-line-height) (mi-element-line-height (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) (hashtable-ref element-table id #f))
(define mi-id
  (case-lambda 
    [() (mi-element-id (mi-el))]
    [(id)
     (let ([x (if id 
		  (symbol->string id)
		  (format "~d" (length (mi-element-children (mi-el)) )))]) 
       (string->symbol (string-append (symbol->string (mi-id)) "-" x)))]))

Changes to event-loop.ss.

11
12
13
14
15
16
17



18
19

20
21
22
23
24
25
26
27
28
29
30
31
32

33
34
35
36
37
38
39
40
41
42
43
..
90
91
92
93
94
95
96

97
98
99
100
101
102
;; 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 ") (display-condition x)(newline) #;(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 
................................................................................
       ;;(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"))







>
>
>
|

>













>



|







 







>






11
12
13
14
15
16
17
18
19
20
21
22
23
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
..
95
96
97
98
99
100
101
102
103
104
105
106
107
108
;; 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 miogui-user-render (make-parameter values))


(define (miogui-run)
  (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)))
       (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-style-set! el `((width ,(mi-window-width)) (height ,(mi-window-height))))
	 (mi-element-position-set! el 'absolute))

       (guard (x [else (printf "ERROR IN RENDER ") (display-condition x)(newline) #;(sleep-s 1) #f])
	      (render-stuff (miogui-user-render)))
       
       (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 
................................................................................
       ;;(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))
       (mi-frame-number (+ (mi-frame-number) 1))
       ;(sdl-delay (exact (truncate (/ 1000. (fps)))))
       (my-local-repl)
       (loop)
       )))
       (sdl-capture-mouse #f)
       (printf "exiting event loop\n"))

Changes to layout.ss.

9
10
11
12
13
14
15
16


17
18
19
20
21
22
23
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
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
108


109
110
111





112
113



114





;;     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 (mi-el-by-id id)])
    (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)
				   (+ h* (* 2 margin)))
			     (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))













>
>











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

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



|
|







 







|
>




<




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









>
>
|
|
|
>
>
>
>
>


>
>
>
|
>
>
>
>
>
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
...
248
249
250
251
252
253
254
255
256
257
258
259
260

261
262
263
264

265
266
267
268


269
270
271

272
273
274






























275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
;;     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 (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 (mi-el-by-id id)])
    (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)][p-h (mi-element-h parent)]
	 [p-x (mi-element-x parent)][p-y (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)]
	        [w (style-query (mi-element-style e) 'min-width 0)]
		[h (style-query (mi-element-style e) 'min-height 0)])
	   (let-values ([(max-w max-h)
			 (if (list? csz)
			     (values (max w (+ (car csz) (* (mi-element-padding e) 2)))
				     (max h (+ (cadr csz) (* (mi-element-padding e) 2))))
			     (values w h))])
	     (cons max-w max-h))))
       (define n-w 1) ;; this will be needed when wrap 
       (define n-h 1)
       (define (calc-max-size l n)
	 (let loop ([count 0] [e l] [w 0] [h 0])
	   (if (or (null? e) (= count n)) 
	       (cons w h)
	       (let ([sz (default-size (car e))])
		 ;(printf "~d ~d~n" (mi-element-id (car e)) sz)
		 (loop (+ count 1) (cdr e) 
		       (max (* n-w p-w) w (car sz)) 
		       (max (* n-h p-h) h (cdr sz)))))))
       (define (calc-total-size l n)
	 (let loop ([count 0] [e l] [w 0] [h 0])
	   (if (or (null? e) (= count n)) 
	       (cons w h)
	       (let ([sz (default-size (car e))])
		 ;(printf "~d ~d~n" (mi-element-id (car e)) sz)
		 (loop (+ count 1) (cdr e) 
		       (+ w (car sz))
		       (+ h (cdr sz)))))))
       (let* (
	     ;; msz: this is a simplification. when we'll implement wrap then this 
	     ;; must be moved inside the for-each somehow
	      [dir? (case flex-direction [(row row-reverse) #t] [(column column-reverse) #f])] 
	      #;[reverse? (case flex-direction
			  [(column row) #f] 
			  [(column-reverse row-reverse) #t])] 
	      [n-items (length children)]
	      [msz (calc-max-size children n-items)]
	      [tsz (calc-total-size children n-items)]
	      [max-w (car msz)] [max-h (cdr msz)]
	      [tot-w (car tsz)] [tot-h (cdr tsz)]
	      [main-tot     (if dir? tot-w tot-h)]
	      [p-main-pos   (if dir? p-x   p-y)]
	      [p-main-size  (if dir? max-w max-h)]
	      [p-cross-pos  (if dir? p-y   p-x)] 
	      [p-cross-size (if dir? max-h max-w)]
	      [free-space (- p-main-size main-tot)]
	      [first-main-pos 
	       (case justify-content 
		 [(flex-start space-between) p-main-pos]
		 [flex-end (+ p-main-pos free-space)]
		 [center (+ p-main-pos (/ free-space 2))]
		 [space-around (+ p-main-pos (/ free-space (+ n-items 1)))])]
	      [next-main-pos first-main-pos]) 
	 ;(printf "main-tot: ~d p-main-size: ~d n-items ~d free-space: ~d first-main-pos ~d~n" main-tot  p-main-size n-items free-space first-main-pos)
      (for-each (lambda (e)
		  (let* ([align-self (mi-element-align-self e)] 
			 [flex (mi-element-flex e)]
			 [x 0] [y 0] [w (mi-element-w e)] [h (mi-element-h e)]
			 [dsz (default-size e)]
			 [main-pos   (if dir? x y)]
			 [main-size  (if dir? (car dsz) (cdr dsz))]
			 [cross-pos  (if dir? y x)]
			 [cross-size (if dir? (cdr dsz) (car dsz))])
		      ;; ALIGN-ITEMS : cross line alignment
			 (case (if (eq? align-self 'auto) align-items align-self) 
			   [flex-start 
			    (set! cross-pos p-cross-pos)]
			   [flex-end
			    (set! cross-pos (- (+ p-cross-pos p-cross-size ) cross-size))]
			   [flex-center
			    (set! cross-pos (+ p-cross-pos 
					       (- (/ p-cross-size 2) (/ cross-size 2))))]
			   [baseline (printf "layout-flex: error baseline not supported! defaulting to flex-start~n")
				     (set! cross-pos p-cross-pos)]
			   [stretch
			    (set! cross-pos p-cross-pos)
			    (set! cross-size p-cross-size)])

		      ;; JUSTIFY-CONTENT : main line alignment
			 (case justify-content
			   [(flex-start flex-end)
			    (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 (/ free-space (- n-items 1))))]
			   [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))
			    (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))
			    (set! new-w (max new-w cross-size))])
			 (case flex-direction
			   [row
			    (mi-element-x-set! e main-pos)]
			   [row-reverse
			    (let ([rel-main-pos (- main-pos )])
			      (mi-element-x-set! e (- (+ p-main-pos p-main-size) 
						      (- main-pos p-main-pos) 
						      main-size )))]
			   [column
			    (mi-element-y-set! e main-pos)]
			   [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 element x y w h w* h* margin padding parent p-id p-x p-y p-w p-h p-padding)
  (define state  (hashtable-ref layout-state (mi-element-id parent) #f))
  (match state
    [(s-x s-y s-w s-h) 
     (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)
		    (+ h* (* 2 margin)))
	      (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 (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)];(style-query (mi-element-style element) 'width 0)]
	 [h (mi-element-h element)];(style-query (mi-element-style element) 'height 0)]
	 [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])]
	 )
    (check-arg number? w* layout-element)
    (check-arg number? h* layout-element)
    (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)]

		  [p-x (mi-element-x parent)]
		  [p-y (mi-element-y parent)]
		  [p-w (mi-element-w parent)]
		  [p-h (mi-element-h parent)])

	     (case (mi-element-display element)
	       ['block 
		(layout-block element x y w h w* h* margin padding 
			      parent p-id p-x p-y p-w p-h p-padding)]


	       #;
	       ['flex
		(layout-flex-add-item element)

		#;
		(layout-flex  element x y w h w* h* margin padding 
		parent p-id p-x p-y p-w p-h p-padding)]))])))































(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)
  (case (mi-element-display element)
    [block
     (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))]
    [flex
     (mi-element-children-set! element '())]
    [else
     (printf "start-layout: wrong display: ~d~n" (mi-element-display element))]))

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

  (case (mi-element-display element)
    [block
     (hashtable-set! layout-state (mi-element-id element) #f)]
    [flex
     #t
     (layout-flex element)]
    [else
     (printf "start-layout: wrong display: ~d~n" (mi-element-display element))]))

Changes to miogui.ss.

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
..
78
79
80
81
82
83
84
85
86

(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 "render.ss")

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

(event-loop)
  







|
|
|
|
|
|



|






|
>











>





|







 







<
|
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
..
80
81
82
83
84
85
86

87

(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 window-title)
  (assert (= 0 (sdl-init (sdl-initialization 'video))))
  
  (mi-window (sdl-create-window window-title 100 100 
				(mi-window-width) (mi-window-height) 
				(sdl-window-flags 'shown 'resizable)))
  (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))))

(define (fini-sdl)
  (sdl-destroy-window (mi-window)))

(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))
(define mi-frame-number (make-parameter 0))

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

(include "utils.ss")
(include "css-color.ss")
(include "draw.ss")

(include "css.ss")

(include "layout.ss")

(include "transition.ss")
................................................................................

(include "render.ss")

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


  

Changes to render.ss.

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
..
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
108
109
		     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)
  (draw-all)

................................................................................
		   (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\n54321")
					    (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))))








|







 







<
<
<

|
<
<
<
<

|

<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
|



|


26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
..
48
49
50
51
52
53
54



55
56




57
58
59

































60


61
62
63
64
65
66
67
		     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)
  (draw-all)

................................................................................
		   (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)
  (render-prepare)

































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

Changes to utils.ss.

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
108
109
110

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







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<




|







69
70
71
72
73
74
75























76
77
78
79
80
81
82
83
84
85
86
87

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

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
























;; 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))))]

Changes to widgets.ss.

40
41
42
43
44
45
46

47
48
49
50
51
52
53
54
55
56

57
58
59
60
61
62
63
..
77
78
79
80
81
82
83

84
85
86
87
88
89
90
91
92
93
94
95
96
	 (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)
  (import (only (srfi s14 char-sets) char-set)
	  (only (thunder-utils) string-split))
................................................................................
			      (let ([extents (draw-text/centered (car l) (+ x* (/ w 2)) (+ y h*))])
			      (set! h* (+ h* (* (mi-line-height) (cadr extents))))
			      (set! w* (max w* (car extents)))
			      (loop (cdr l))))))
		      (mi-element-content-size-set! (mi-el) (list w* h*)))
		    #f)))


(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







>





|
|
|
|
|
>







 







>





|







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
..
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
	 (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/centered text
					(+ 0 x (/ w 2)) 
					(+ 0 y (/ h 2)))])
       (mi-element-content-size-set! (mi-el) extents))
     
     (and (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))
................................................................................
			      (let ([extents (draw-text/centered (car l) (+ x* (/ w 2)) (+ y h*))])
			      (set! h* (+ h* (* (mi-line-height) (cadr extents))))
			      (set! w* (max w* (car extents)))
			      (loop (cdr l))))))
		      (mi-element-content-size-set! (mi-el) (list w* h*)))
		    #f)))

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