Many hyperlinks are disabled.
Use anonymous login
to enable hyperlinks.
Overview
Comment: | added textline editor, added text-align css support |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | trunk |
Files: | files | file ages | folders |
SHA1: |
a2511885eee6021eb3a6c29d6ccb03b3 |
User & Date: | aldo 2016-09-12 22:09:31 |
Context
2016-09-13
| ||
10:47 | added floline and intline widgets, updated demo2 check-in: fe241039a3 user: aldo tags: trunk | |
2016-09-12
| ||
22:09 | added textline editor, added text-align css support check-in: a2511885ee user: aldo tags: trunk | |
17:28 | added basic keyboard support check-in: bcc0c5730e user: aldo tags: trunk | |
Changes
Changes to demos/demo1.ss.
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
(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)]
|
| > |
38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 |
(background-color white)
(padding 10) (width 100 %) (border-style solid)
(border-width 1) (border-color black)]
[label ==>
(background-color white)
(color black) (padding 5) (height 25)
(border-width 1) (border-color blue)]
[hslider ==> (height 40) (color black) (background-color white)
(text-align center) ]
[(id lbl2) ==> (width 90 %) (margin 0)]
[(id tg1) ==> (border-width 1) (border-color red) (background-color red)
(width expand) (height 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)]
|
Changes to demos/demo2.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 |
(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 640) (height 480) (top 0) (left 0) (position absolute) (background-color (rgb 125 125 125)) (display flex) (justify-content space-around) (align-items center) (flex-direction column)] [(id label1) ==> (align-self stretch)] )) (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 "1\nGOOD MORNING!\nLine 2\nLine 3\nLine 4"))) (debug-tooltip))) (miogui-run) |
| > > > > > > | | > |
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 |
(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 600) (height 480) (top 0) (left 0) (position absolute) (background-color (rgb 125 125 125)) (display flex) (justify-content space-around) (align-items center) (flex-direction column)] [(id label1) ==> (align-self stretch)] [ button ==> (text-align center)] [ label ==> (text-align center)] [textline ==> (background-color white) (padding 5) (min-width 200) (text-align right) (color black)] )) (init-sdl "buttons") (define my-text (make-parameter "some editable text!")) (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 "1\nGOOD MORNING!\nLine 2\nLine 3\nLine 4") (textline 'text1 my-text))) (debug-tooltip))) (miogui-run) |
Changes to demos/demo3.ss.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
(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) ==> |
> |
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
(padding 10)
(border-style solid)
(background-color red)
(border-width 1)
(border-color black)]
[label ==>
(align-self flex-start)
(text-align center)
(color red)
(padding 5)
(border-width 1)
(border-color blue)
(background-color white)]
[(class first) ==>
|
Changes to draw.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 |
(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) (define font-size (mi-font-size)) (define font-family (mi-font-family)) (define font-style (mi-font-style)) (define font-weight (mi-font-weight)) (define color (mi-color)) (check-arg string? text draw-text/centered) (check-arg number? x draw-text/centered) (check-arg number? y draw-text/centered) (let ([extents (cairo-text-extents-create)]) (cairo-set-font-size (mi-cr) font-size) (cairo-select-font-face (mi-cr) (string-append font-family (string #\nul)) (cairo-font-slant font-style) ;; normal|italic|oblique (cairo-font-weight font-weight)) ;; normal|bold (cairo-text-extents (mi-cr) text extents) (let-struct extents cairo-text-extents-t (width height x-bearing y-bearing) (draw! (lambda () (cairo-set-font-size (mi-cr) font-size) (cairo-select-font-face (mi-cr) (string-append font-family (string #\nul)) (cairo-font-slant font-style) ;; normal|italic|oblique (cairo-font-weight font-weight)) ;; normal|bold ; (printf "x ~d y ~d~n" x y) (cairo-set-source-color (mi-cr) color) (cairo-move-to (mi-cr) (- x (/ width 2) x-bearing ) (- y (/ height 2) y-bearing)) (cairo-show-text (mi-cr) text))) (list width height)))) (define (draw-box id class style) #t ) |
> > > > > > > > > > > > > > > > > > > > > | > | | | | > > > | > > > > | < > > > > > > > > > > > > |
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 |
(when (not (memq border-style '(none hidden))) (draw-path) (with-cairo (mi-cr) (set-line-width bw) (set-source-color border-color) (stroke)))))) (define (text-extents text) (define font-size (mi-font-size)) (define font-family (mi-font-family)) (define font-style (mi-font-style)) (define font-weight (mi-font-weight)) (define text-align (mi-text-align)) (define color (mi-color)) (check-arg string? text draw-text) (let ([extents (cairo-text-extents-create)]) (cairo-set-font-size (mi-cr) font-size) (cairo-select-font-face (mi-cr) (string-append font-family (string #\nul)) (cairo-font-slant font-style) ;; normal|italic|oblique (cairo-font-weight font-weight)) ;; normal|bold (cairo-text-extents (mi-cr) text extents) (let-struct extents cairo-text-extents-t (width height x-bearing y-bearing) (list width height x-bearing y-bearing)))) (define (draw-text text x y w h) (define font-size (mi-font-size)) (define font-family (mi-font-family)) (define font-style (mi-font-style)) (define font-weight (mi-font-weight)) (define text-align (mi-text-align)) (define color (mi-color)) (check-arg string? text draw-text) (check-arg number? x draw-text) (check-arg number? y draw-text) (let ([extents (cairo-text-extents-create)]) (cairo-set-font-size (mi-cr) font-size) (cairo-select-font-face (mi-cr) (string-append font-family (string #\nul)) (cairo-font-slant font-style) ;; normal|italic|oblique (cairo-font-weight font-weight)) ;; normal|bold (cairo-text-extents (mi-cr) text extents) (let-struct extents cairo-text-extents-t (width height x-bearing y-bearing) (draw! (lambda () (cairo-set-font-size (mi-cr) font-size) (cairo-select-font-face (mi-cr) (string-append font-family (string #\nul)) (cairo-font-slant font-style) ;; normal|italic|oblique (cairo-font-weight font-weight)) ;; normal|bold ; (printf "x ~d y ~d~n" x y) (cairo-set-source-color (mi-cr) color) (case text-align [left (cairo-move-to (mi-cr) (- x x-bearing ) (- (+ y (/ h 2) (/ font-size 2)) 0 ))] [center (cairo-move-to (mi-cr) (- (+ x (/ w 2)) (/ width 2) x-bearing ) (- (+ y (/ h 2) (/ font-size 2)) 0 ))] [right (cairo-move-to (mi-cr) (- (+ x w) width x-bearing) (- (+ y (/ h 2) (/ font-size 2)) 0 ))]) (cairo-show-text (mi-cr) text))) (list width height)))) (define (draw-text/padding text x y w h) (draw-text text (+ (mi-padding) x) (+ (mi-padding) y) (- w (* 2 (mi-padding))) (- h (* 2 (mi-padding))))) (define (draw-box id class style) #t ) |
Changes to element.ss.
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 ... 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 ... 202 203 204 205 206 207 208 209 210 211 212 213 214 215 |
(mi-active-item id) (mi-kbd-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)]) ................................................................................ (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-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)) ................................................................................ [() (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 |
< > > | | > > > > > > > |
103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 ... 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 ... 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 |
(mi-active-item id) (mi-kbd-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))) (guard (e [else (printf "ops in stylesheet resolve: ") (display-condition e) (newline) (raise e)]) (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)]) ................................................................................ (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-text-align) (mi-element-text-align (mi-el))) (define (mi-parent) (mi-element-parent (mi-el))) (define (mi-padding) (mi-element-padding (mi-el))) (define mi-class (make-parameter #f)) (define mi-style (make-parameter '())) (define (mi-display) (mi-element-display (mi-el))) (define (mi-el-by-id id) (hashtable-ref element-table id #f)) ................................................................................ [() (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 (mi-wset id name value) (putprop id name value)) (define (mi-wget id name default) (getprop id name default)) (define-syntax define-css-element (lambda (x) (syntax-case x() [(_ name default inherited transformer validator ...) (with-syntax ([function-name |
Changes to event-loop.ss.
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 |
(if (eq? sym-name 'q) (quit)))]
[keyup (let* ([sym (sdl-event-keyboard-keysym-sym e)]
[sym-name (sdl-keycode-ref sym)])
(printf "keyup ~x ~d\n" sym (sdl-keycode-ref sym)))]
[textinput (let* ([ti (ftype-&ref sdl-event-t (text) e)]
[text (char*-array->string
(ftype-&ref sdl-text-input-event-t (text) ti) 32)])
(printf "text input \"~d\"\n" text ))]
[mousemotion (let* ([mousemotion (ftype-&ref sdl-event-t (motion) e)])
(let-struct mousemotion sdl-mouse-motion-event-t
(x y xrel yrel state)
(mi-mouse-x x) (mi-mouse-y y)
(if (region-hit? 0 0 (mi-window-width) (mi-window-height))
(sdl-capture-mouse #t)
(sdl-capture-mouse #f))
|
| > |
64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 |
(if (eq? sym-name 'q) (quit)))]
[keyup (let* ([sym (sdl-event-keyboard-keysym-sym e)]
[sym-name (sdl-keycode-ref sym)])
(printf "keyup ~x ~d\n" sym (sdl-keycode-ref sym)))]
[textinput (let* ([ti (ftype-&ref sdl-event-t (text) e)]
[text (char*-array->string
(ftype-&ref sdl-text-input-event-t (text) ti) 32)])
(printf "text input \"~d\"\n" text )
(mi-txt text))]
[mousemotion (let* ([mousemotion (ftype-&ref sdl-event-t (motion) e)])
(let-struct mousemotion sdl-mouse-motion-event-t
(x y xrel yrel state)
(mi-mouse-x x) (mi-mouse-y y)
(if (region-hit? 0 0 (mi-window-width) (mi-window-height))
(sdl-capture-mouse #t)
(sdl-capture-mouse #f))
|
Changes to miogui.ss.
75 76 77 78 79 80 81 82 83 84 85 86 87 88 |
;; (let ([k (car (mi-keys))]) ;; (mi-keys (cdr (mi-keys))) ;; k) ;; #f)) (define mi-key (make-parameter #f)) (define mi-keymod (make-parameter '())) (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)) |
> |
75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 |
;; (let ([k (car (mi-keys))])
;; (mi-keys (cdr (mi-keys)))
;; k)
;; #f))
(define mi-key (make-parameter #f))
(define mi-keymod (make-parameter '()))
(define mi-txt (make-parameter #f))
(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))
|
Changes to transition.ss.
93 94 95 96 97 98 99 100 101 102 103 |
(if (equal? val val2) a (case name [(width height left top border-radius border-width font-size padding margin) (if (and (number? val) (number? val2)) (list name (number-transition val val2 ratio)) (list name val2))] [(color background-color border-color) (list name (color-transition (->color val) (->color val2) ratio))] [else a]))) (hashtable->alist style-a)))) |
| > | |
93 94 95 96 97 98 99 100 101 102 103 104 |
(if (equal? val val2) a (case name [(width height left top border-radius border-width font-size padding margin) (if (and (number? val) (number? val2)) (list name (number-transition val val2 ratio)) (list name val2))] [(color background-color border-color) (list name (guard (e [else (->color val2)]) (color-transition (->color val) (->color val2) ratio)))] [else a]))) (hashtable->alist style-a)))) |
Changes to widgets.ss.
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 ... 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 ... 146 147 148 149 150 151 152 153 |
(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)) (create-element 'label id #f (lambda () (define-values (x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h))) (draw-rect x y w h) (let ([lines (string-split text (char-set #\newline))] [x* x] [y* y] [w* 0] [h* 0]) (if (= 1 (length lines)) (let ([extents (draw-text/centered (car lines) (+ x (/ w 2)) (+ y (/ h 2)))]) (set! w* (car extents)) (set! h* (mi-font-size))) (let loop ([l lines]) (unless (null? l) (let ([extents (draw-text/centered (car l) (+ x* (/ w 2)) (+ y* (mi-font-size)))]) (set! y* (+ y* (* (mi-line-height) (mi-font-size)))) (set! h* (+ h* (* (mi-line-height) (mi-font-size)))) (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 ................................................................................ (p10e ([mi-style `((width 20) (height expand) (position relative) (left ,l))]) (create-element 'slider-box (symbol-append id "::box") #t (lambda () (let-values ([(x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h))]) (draw-rect x y w h)))))) (end-layout (mi-el)) (let ([extents (draw-text/centered (format "~,3F" (state)) (+ 0 x (/ w 2)) (+ 0 y (/ h 2)))]) (mi-element-content-size-set! (mi-el) extents)) (when (and (> w 0) (eq? (mi-active-item) id)) (let ([val (/ (- (mi-mouse-x) x) w)]) (if (< val 0) (set! val 0)) (if (> val 1) (set! val 1)) (cond [(not (= (state) val)) ................................................................................ (let ([val (/ (- (mi-mouse-y) y) h)]) (if (< val 0) (set! val 0)) (if (> val 1) (set! val 1)) (cond [(not (= (state) val)) (state val) #t] [else #f]))))))) |
| < < | > > > | < | < | < | > < > | | > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > |
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 ... 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 ... 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 |
(define (button id text) (create-element 'button id #t (lambda () (define-values (x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h))) (draw-rect x y w h) (let ([extents (draw-text/padding text x y w h)]) (mi-element-content-size-set! (mi-el) extents)) (and (not (mi-mouse-down?)) (eq? (mi-hot-item) id) (eq? (mi-active-item) id))))) (define (label id text) ................................................................................ (import (only (srfi s14 char-sets) char-set) (only (thunder-utils) string-split)) (create-element 'label id #f (lambda () (define-values (x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h))) (draw-rect x y w h) (let ([lines (string-split text (char-set #\newline))] [x* (+ (mi-padding) x)] [y* (+ (mi-padding) y)] [w* 0] [h* (* (mi-line-height) (mi-font-size))]) (if (= 1 (length lines)) (let ([extents (draw-text/padding (car lines) x y w h)]) (set! w* (car extents))) (let loop ([l lines]) (unless (null? l) (let ([extents (draw-text (car l) x* y* (- w (* 2 (mi-padding) )) h*)]) (set! y* (+ y* (* (mi-line-height) (mi-font-size)))) (set! w* (max w* (car extents))) (loop (cdr l)))))) (set! h* (* (length lines) (* (mi-line-height) (mi-font-size)))) (mi-element-content-size-set! (mi-el) (list w* h*))) #f))) (define (debug-tooltip) (define id (mi-hot-item)) (when id ................................................................................ (p10e ([mi-style `((width 20) (height expand) (position relative) (left ,l))]) (create-element 'slider-box (symbol-append id "::box") #t (lambda () (let-values ([(x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h))]) (draw-rect x y w h)))))) (end-layout (mi-el)) (let ([extents (draw-text/padding (format "~,3F" (state)) x y w h)]) (mi-element-content-size-set! (mi-el) extents)) (when (and (> w 0) (eq? (mi-active-item) id)) (let ([val (/ (- (mi-mouse-x) x) w)]) (if (< val 0) (set! val 0)) (if (> val 1) (set! val 1)) (cond [(not (= (state) val)) ................................................................................ (let ([val (/ (- (mi-mouse-y) y) h)]) (if (< val 0) (set! val 0)) (if (> val 1) (set! val 1)) (cond [(not (= (state) val)) (state val) #t] [else #f]))))))) (define (textline id text) (import (only (srfi s14 char-sets) char-set) (only (thunder-utils) string-split string-replace)) (create-element 'textline id #t (lambda () (define-values (x y w h) (values (mi-x) (mi-y) (mi-w) (mi-h))) (define (cursor-pos) (mi-wget id 'cursor-pos 0)) (define (cursor-pos-move dir) (let ([cp (cursor-pos)]) (cond [(and (< dir 0) (> cp 0)) (mi-wset id 'cursor-pos (- cp 1))] [(and (> dir 0) (< cp (string-length (text)))) (mi-wset id 'cursor-pos (+ cp 1))]))) (draw-rect x y w h) (if (> (cursor-pos) (string-length (my-text))) (mi-wset id 'cursor-pos (string-length (my-text)))) (when (eq? (mi-kbd-item) id) (let ([txt (text)] [txt-len (string-length (text))]) (case (mi-key) [backspace (when (and (> txt-len 0) (> (cursor-pos) 0)) (text (string-append (substring txt 0 (- (cursor-pos) 1) ) (substring txt (cursor-pos) txt-len))) (cursor-pos-move -1)) (mi-key #f)] [delete (when (and (> txt-len 0) (>= (cursor-pos) 0) (< (cursor-pos) txt-len)) (text (string-append (substring txt 0 (cursor-pos)) (substring txt (+ (cursor-pos) 1) txt-len)))) (mi-key #f)] [left (cursor-pos-move -1) (mi-key #f)] [right (cursor-pos-move 1) (mi-key #f)] [home (mi-wset id 'cursor-pos 0) (mi-key #f)] [end (mi-wset id 'cursor-pos txt-len) (mi-key #f)] [else (when (mi-txt) (text (string-append (substring txt 0 (cursor-pos)) (mi-txt) (substring txt (cursor-pos) txt-len))) (mi-wset id 'cursor-pos (+ (string-length (mi-txt)) (mi-wget id 'cursor-pos 0))) (mi-txt #f))]))) (let* ([extents (draw-text/padding (text) x y w h)] [w* (car extents)] [h* (mi-font-size)]) (mi-element-content-size-set! (mi-el) (list w* h*)) (when (and (eq? (mi-kbd-item) id) (not (= 0 (logand (bitwise-arithmetic-shift-right (sdl-get-ticks) 9) 1)))) (let* ([cursor-pos (mi-wget id 'cursor-pos 0)] [size (text-extents (string-replace (substring (text) 0 cursor-pos) #\space #\-))] [padding (mi-padding)] [text-align (mi-text-align)]) (draw! (lambda () (define x1 (case text-align [left (+ x (car size) padding) ] [center (- (+ x (/ w 2)) (- (/ w* 2) (car size)) )] [right (- (+ x w) (- w* (car size)) padding)])) (with-cairo (mi-cr) (set-source-color (mi-color)) (move-to x1 (+ y padding)) (line-to x1 (- (+ y h ) padding)) (set-line-width 1) (stroke))))))) #f))) |