Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | improved css system, validation, inherit, initial |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
44e44daf1ab5e28c1581962acb458504 |
User & Date: | aldo 2016-09-09 17:29:54 |
Context
2016-09-12
| ||
17:26 | fixed multiline text label check-in: 5c8595d58b user: aldo tags: trunk | |
2016-09-09
| ||
17:29 | improved css system, validation, inherit, initial check-in: 44e44daf1a user: aldo tags: trunk | |
13:26 | minor bug in demo3.ss check-in: 8239be5117 user: aldo tags: trunk | |
Changes
Changes to demos/demo1.ss.
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 |
(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)) |
> > | | |
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 |
(background-color black) (transition-duration 1)] [(id panel-1) ==> (width 100 %) (height 89 %) (top 0) (left 0) (position absolute) (background-color (rgb 125 125 125))] [(> (id panel-1) button) ==> (width 27 %) (height 10 %)] [panel ==> (background-color white) (padding 10) (width 100 %) (border-style solid) (border-width 1) (border-color black)] [label ==> (background-color white) (color black) (padding 5) (height 25) (border-width 1) (border-color blue)] [hslider ==> (height 40) (color black) (background-color white) ] [(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)) |
Changes to demos/demo2.ss.
23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
[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)] )) |
| | |
23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
[panel ==>
(padding 10) (width 200 ) (height 200)
(border-style solid) (background-color red)
(border-width 1) (border-color black)]
[label ==>
(color black) (padding 5)
(background-color white)]
[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 center)
(flex-direction column)]
[(id label1) ==>
(align-self stretch)
(height 50)]
))
|
Changes to demos/demo3.ss.
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
..
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
(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) ] [(class great) ==> ................................................................................ (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) |
|
|
|
|
>
|
|
|
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
..
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
(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) (background-color white)] [(class first) ==> (align-self flex-start) (min-height 40) (min-width 160)] [(class second) ==> (align-self center) ] [(class third) ==> (align-self flex-end) (order 2) (color blue) ] [(class fourth) ==> (align-self stretch) ] [(class great) ==> ................................................................................ (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: 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 draw.ss.
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
(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)
|
| |
62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
(draw! (lambda () (when bg-color (draw-path) (with-cairo (mi-cr) (set-source-color bg-color) (fill))) (when (not (memq border-style '(none hidden))) (draw-path) (with-cairo (mi-cr) (set-line-width bw) (set-source-color border-color) (stroke)))))) (define (draw-text/centered text x y) |
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 .. 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 ... 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 ... 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) ................................................................................ (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) (if (and (list? r) (< (length r) 2)) (car r) r)) (define (style-query style attr default) (let ([r (hashtable-ref style attr default)]) (value-or-list r))) (define (create-element el id activable thunk) (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-w) (mi-element-w (mi-el))) (define (mi-h) (mi-element-h (mi-el))) (define (mi-font-style) (mi-element-font-style (mi-el))) (define (mi-font-weight) (mi-element-font-weight (mi-el))) (define (mi-font-size) (mi-element-font-size (mi-el))) (define (mi-font-family) (mi-element-font-family (mi-el))) (define (mi-color) (mi-element-color (mi-el))) (define (mi-bg-color) (mi-element-bg-color (mi-el))) (define (mi-border-radius) (mi-element-border-radius (mi-el))) (define (mi-border-color) (mi-element-border-color (mi-el))) (define (mi-border-width) (mi-element-border-width (mi-el))) (define (mi-border-style) (mi-element-border-style (mi-el))) (define (mi-z-index) (mi-element-z-index (mi-el))) (define (mi-line-height) (mi-element-line-height (mi-el))) ................................................................................ (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)))])) |
| < < < < < < < < < | | < < | | < < < < > | > | > > > > > > > > > > > > > | > > > > | > < | < < < < < < < < < < < < < < < < < | | | | | < < < < < < < < < < < < < < < | < | | | | | | | < < < < < | | | > | > < < < < < | | | | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
11 12 13 14 15 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 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 ... 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 ... 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 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 |
;; 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 x) (mutable y) (mutable w) (mutable h) (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) ................................................................................ (case k [el el] [id id] [class class] [pseudo pseudo] [parent parent] [children '()] [style (make-eq-hashtable)] [(x y w h) 0] [else #f])) (vector->list (record-type-field-names (record-type-descriptor mi-element)))))) (define mi-el (make-parameter #f)) (define (value-or-list r) (if (and (list? r) (< (length r) 2)) (car r) r)) (define (style-query style attr default) (let ([r (hashtable-ref style attr default)]) (value-or-list r))) (define (mi-style-query element attr default inherited) (let* ([r (hashtable-ref (mi-element-style element) attr #f)] [v (if r (value-or-list r) (if inherited 'inherit default))]) (case v [inherit (cond [(mi-element-parent element) => (lambda (parent) (mi-style-query (mi-element-parent element) attr default inherited))] [else default])] [initial default] [else v]))) (define (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) (mi-element-style-set! element style) (set! td (mi-style-query element 'transition-duration 0 #f)) (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-x-set! element (mi-element-left element)) (mi-element-y-set! element (mi-element-top element)) (mi-element-w-set! element (mi-element-width element)) (mi-element-h-set! element (mi-element-height element)) (case (mi-element-display element) [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 #t ] [else (printf "create-element: error wrong value for display: ~d~n" display)]) (cond [(and (mi-element-parent element) (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)]) ;(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)] )) (p10e ([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-w) (mi-element-w (mi-el))) (define (mi-h) (mi-element-h (mi-el))) (define (mi-font-style) (mi-element-font-style (mi-el))) (define (mi-font-weight) (mi-element-font-weight (mi-el))) (define (mi-font-size) (mi-element-font-size (mi-el))) (define (mi-font-family) (mi-element-font-family (mi-el))) (define (mi-color) (mi-element-color (mi-el))) (define (mi-bg-color) (mi-element-background-color (mi-el))) (define (mi-border-radius) (mi-element-border-radius (mi-el))) (define (mi-border-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-line-height) (mi-element-line-height (mi-el))) ................................................................................ (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))] [(sub-id) (let ([x (if sub-id (symbol->string sub-id) (format "~d" (length (mi-element-children (mi-el)) )))]) (string->symbol (string-append (symbol->string (mi-id)) "-" x)))])) (define-syntax define-css-element (lambda (x) (syntax-case x() [(_ name default inherited transformer validator ...) (with-syntax ([function-name (datum->syntax #'name (string->symbol (string-append "mi-element-" (symbol->string (syntax->datum #'name)))))] ) #`(begin (define (function-name element) (let ([v (mi-style-query element 'name default inherited)]) (if (or (validator v) ...) (transformer element v) (errorf 'function-name "invalid attribute value ~d for element ~d" v (mi-element-id element)))))))]))) (define (i-t element x) x) (define (in-list-validator . values) (lambda (v) (memq v values))) (define-css-element position 'static #f i-t (in-list-validator 'static 'relative 'absolute)) (define-css-element padding 0 #f i-t number?) (define-css-element margin 0 #f i-t number?) (define (color-validator v) (or (color? v) (symbol? v) (and (list? v) (<= 4 (length v) 5)))) ;;TODO IMPROVE THIS (define (color-transformer e v) (->color v)) (define-css-element border-color 'black #f color-transformer color-validator) (define-css-element border-style 'none #f i-t ;;not yet supported: 'dotted 'dashed 'double 'groove 'ridge 'inset 'outset (in-list-validator 'none 'hidden 'solid)) (define (border-width-transformer element width) (if (number? width) width (case width [thin 0.5] [medium 1] [thick 2]))) (define-css-element border-width 'medium #f border-width-transformer number? (in-list-validator 'medium 'thin 'thick)) (define-css-element border-radius 0 #f i-t number?) (define-css-element color 'black #t color-transformer color-validator) (define-css-element background-color 'transparent #f color-transformer color-validator) (define-css-element font-family "sans" #t i-t string?) (define (font-size-transformer element sz) (if (number? sz) sz (case sz [medium 12] [large 14] [small 10] [smaller (- (mi-element-font-size (mi-element-parent element)) 2)] [larger (+ (mi-element-font-size (mi-element-parent element)) 2)] [x-small 8] [x-large 16] [xx-small 7] [xx-large 18]))) (define-css-element font-size 'medium #t font-size-transformer number? (in-list-validator 'medium 'large 'small 'smaller 'larger 'x-small 'x-large 'xx-small 'xx-large)) ;;;normal|bold ; these are not supported: bolder|lighter|number (define-css-element font-weight 'normal #t i-t (in-list-validator 'normal 'bold)) (define-css-element font-style 'normal #t i-t (in-list-validator 'normal 'italic 'oblique)) (define (line-height-transformer e v) (if (number? v) v 1.2)) (define (eq-validator s) (lambda (x) (eq? s x))) (define-css-element line-height 'normal #t line-height-transformer number? (eq-validator 'normal)) (define-css-element display 'block #f i-t (in-list-validator 'block 'flex)) ;; TODO: ADD SUPPORT FOR 'none (define-css-element justify-content 'flex-start #f i-t ;; WARNING: STRETCH IS A MIOGUI EXTENSION (in-list-validator 'flex-start 'flex-end 'space-around 'space-between 'center 'stretch)) (define-css-element align-items 'stretch #f i-t (in-list-validator 'flex-start 'flex-end 'center 'stretch)) (define-css-element align-self 'auto #f i-t (in-list-validator 'auto 'flex-start 'flex-end 'center 'stretch)) (define-css-element flex-direction 'row #f i-t (in-list-validator 'row 'column 'row-reverse 'column-reverse)) (define-css-element flex 1 #f i-t number?) (define-css-element min-width 0 #f i-t number? list?) (define-css-element min-height 0 #f i-t number? list?) (define-css-element text-align 0 #f i-t number? list?) (define-css-element box-sizing 'border-box #f i-t (eq-transformer 'border-box)) (define-css-element order 0 #f i-t number?) (define (z-index-transformer element v) (if (number? v) v (let ([parent (mi-element-parent element)]) (if parent (mi-element-z-index parent) 0)))) (define-css-element z-index 'auto #f z-index-transformer number? (eq-validator 'auto)) (define-css-element left 0 #f i-t number?) (define-css-element top 0 #f i-t number?) (define-css-element width 'auto #f i-t number? list? (in-list-validator 'auto 'expand)) (define-css-element height 'auto #f i-t number? list? (in-list-validator 'auto 'expand)) |
Changes to event-loop.ss.
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 |
(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 |
| > > > > | < > |
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 |
(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 (make-mi-element 'null 'null #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 (alist->hashtable `((z-index 0) (width ,(mi-window-width)) (height ,(mi-window-height)) (position absolute))))) (guard (x [else (printf "ERROR IN RENDER ") (display-condition x)(newline) #;(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 |
Changes to layout.ss.
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 .. 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 ... 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 ... 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 |
;; =>>>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)] ................................................................................ [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 ................................................................................ [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)]) ................................................................................ [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 |
| | | | | | |
36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 .. 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 ... 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 ... 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 |
;; =>>>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)] ................................................................................ [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 (mi-element-min-width e)] [h (mi-element-min-height e)]) (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 ................................................................................ [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))] [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)]) ................................................................................ [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] [auto (+ (* 2 padding) (if (list? csz) (car csz) 0))] [else w])] [h* (case h [expand 0] [auto (+ (* 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 |