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

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

Overview
Comment:little fixes
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: e53e9815acd32891b65b5fbf2fef6c7ed5e16753
User & Date: aldo 2016-09-04 14:45:25
Context
2016-09-06
09:06
use display-condition instead of our print-condition, improved repl check-in: 1cb1fedb47 user: aldo tags: trunk
2016-09-04
14:45
little fixes check-in: e53e9815ac user: aldo tags: trunk
2016-09-01
09:16
removed box check-in: f43f2eabf1 user: noreply@github.com tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to css.ss. 

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


(define stylesheet '([* ==> 
			(position static)
			(box-sizing border-box)
			(font-family "Sans")
			(font-size 12)]
		     [button ==>
		       (width 100) 
		      (height 50) 
		      (color red)
		      (background-color (rgbf 0 1 0 0.5))

		      (border-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 expand !important)
		      (background-color black)
		      (transition-duration 0.2)]
		     [(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 %)]

		     [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-color red) ]

		     [(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))
  (for-each
   (lambda (x)  
     (hashtable-set! hash (car x) (if (and (list? x) (< (length x) 2)) 
				      (cadr x) 
				      (cadr x)))
     (hashtable-ref hash (car x) #f))

   alist)
  hash)

(define (compare-specifity x y)
  ;(printf "~d ~d~n" x y)
    (cond
     [(< (list-ref x 0) (list-ref y 0)) #t]








|
|
|
|
>
|
|
|









|

|





|
>







 







|
>












|

|
|
>








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


(define stylesheet '([* ==> 
			(position static)
			(box-sizing border-box)
			(font-family "Sans")
			(font-size 12)]
		     [button ==>
			     (width 100) 
			     (height 50) 
			     (color red)
			     (background-color (rgbf 0 1 0 0.5))
			     (border-style solid)
			     (border-color red)
			     (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 50 !important)
		      (background-color black)
		      (transition-duration 1)]
		     [(id panel-1) ==> 
		      (width 100 %) (height 89 %) (top 0) (left 0) (position absolute) 
		      (background-color (rgb 125 125 125))]
		     [(> (id panel-1) button) ==> (width 27 %) (height 10 %)]
		     [panel ==> 
			    (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))
  (for-each
   (lambda (x)  
     (let ([v (if (and (list? x) (< (length x) 2)) 
				      (cadr x) 
				      (cadr x))])
       (hashtable-set! hash (car x) v)
       v))
   alist)
  hash)

(define (compare-specifity x y)
  ;(printf "~d ~d~n" x y)
    (cond
     [(< (list-ref x 0) (list-ref y 0)) #t]

Changes to draw.ss. 

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

    (cairo-arc cr (+ x radius) (- (+ y height) radius) radius (* 90 degrees) (* 180 degrees))
    (cairo-arc cr (+ x radius) (+ y radius) radius (* 180 degrees) (* 270 degrees))
    (cairo-close-path cr)))

(define (draw-rect x y w h)
  (define bw (mi-border-width))
  (define border-color (mi-border-color))





  (when (mi-bg-color)

	(with-cairo (mi-cr)
	      ;(cairo-scale 640 480)
	      (set-source-color (mi-bg-color))
	      (if (> (mi-border-radius) 0)
		  (round-rect (+ x bw) (+ y bw) (- w bw) (- h bw) (mi-border-radius))
		  (cairo-rectangle (mi-cr) (+ x bw) (+ y bw) (- w bw) (- h bw)))
	      (fill-preserve)))


  (with-cairo (mi-cr)
	      ;(cairo-scale 640 480)
	      (set-line-width bw)
	      (set-source-color border-color)
	      (stroke)))

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

  (cairo-set-font-size (mi-cr) (mi-font-size))








>
>
>
>


>



<
<
<
|
>
>
|
<
|
|
|








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

    (cairo-arc cr (+ x radius) (- (+ y height) radius) radius (* 90 degrees) (* 180 degrees))
    (cairo-arc cr (+ x radius) (+ y radius) radius (* 180 degrees) (* 270 degrees))
    (cairo-close-path cr)))

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

  (when (mi-bg-color)
	(draw-path)
	(with-cairo (mi-cr)
	      ;(cairo-scale 640 480)
	      (set-source-color (mi-bg-color))



	      (fill)))
  (when (not-none? (mi-border-style))
	(draw-path)
	(with-cairo (mi-cr)

		    (set-line-width bw)
		    (set-source-color border-color)
		    (stroke))))

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

  (cairo-set-font-size (mi-cr) (mi-font-size))

Changes to element.ss. 

150
151
152
153
154
155
156



(define (mi-border-width) (mi-element-border-width (mi-el)))
(define (mi-border-style) (mi-element-border-style (mi-el)))

(define (mi-parent) (mi-element-parent (mi-el)))
(define (mi-padding) (mi-element-padding (mi-el)))
(define mi-class (make-parameter #f))
(define mi-style (make-parameter '()))










>
>

150
151
152
153
154
155
156
157
158

(define (mi-border-width) (mi-element-border-width (mi-el)))
(define (mi-border-style) (mi-element-border-style (mi-el)))

(define (mi-parent) (mi-element-parent (mi-el)))
(define (mi-padding) (mi-element-padding (mi-el)))
(define mi-class (make-parameter #f))
(define mi-style (make-parameter '()))

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

Changes to layout.ss. 

15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

;; limitations under the License.

(define layout-state (make-eq-hashtable))

(define (get-last-coords id)
  (check-arg symbol? id get-last-coords)

  (let ([e (hashtable-ref element-table id #f)])
    (if e 
	(parameterize ([mi-el e])
		      (values (mi-x) (mi-y) (mi-w) (mi-h)))
	(values 0 0 0 0))))

(define (layout-element element)  









|








15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

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

Changes to widgets.ss. 

55
56
57
58
59
60
61


62
63
64
65







66


67
68

69
70
71
72
73
74
75

     
     ;;return
     (and (not (mi-mouse-down?))
	  (eq? (mi-hot-item) id)
	  (eq? (mi-active-item) id)))))

(define (label id text)


  (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 ([extents (draw-text/centered text (+ 0 x (/ w 2)) (+ 0 y (/ h 2)))])


		      (mi-element-content-size-set! (mi-el) extents))
		    #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 `((position absolute) 








>
>




>
>
>
>
>
>
>
|
>
>
|

>








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

     
     ;;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))
  (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])
		      (if (= 1 (length lines ))
			  (let ([extents (draw-text/centered (car lines) (+ 0 x (/ w 2)) (+ 0 y (/ h 2)))])
			    (set! x* (car extents)) 
			    (set! y* (cadr extents)))
			  (let loop ([l lines])
			    (let ([extents (draw-text/centered text (+ 0 x* (/ w 2)) (+ y* ))])
			      (set! x* (+ x* (car extents)))
			      (set! y* (+ y* (cadr extents))))))
		      (mi-element-content-size-set! (mi-el) (list x* y*)))
		    #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 `((position absolute)

Fossil 2.9 [0fd79a3e09] 2019-07-13 13:05:19