Check-in [a2511885ee]
Not logged in
Home Timeline Files Branches Tags Tickets Wiki Login

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:a2511885eee6021eb3a6c29d6ccb03b35c47f5ce
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
Hide Diffs Unified Diffs Ignore Whitespace Patch

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

Fossil 2.7 [9aa9ba8bd2] 2018-09-22 17:40:11