suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

...

Browse Source 
original commit: bfd85b7e724afe90d4363b863bda7cf228197273
This commit is contained in:
Mike MacHenry 2004-06-29 22:40:19 +00:00
parent 97ecbf1c62
commit 49f3f2baab
2 changed files with 59 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
collects/mrlib/private/aligned-pasteboard/alignment.ss
View File

@ -1,22 +1,24 @@
;;note: This code computes the sizees for the rectangles in the space using the on dimention #|
;; off dimention method of referencing sizes. This means for example instead of saying This code computes the sizees for the rectangles in the space using the on dimention
;; width we say off dimention for vertical alignment. Inorder to consume and return off dimention method of referencing sizes. This means for example instead of saying
;; the values in terms of width and height manipulation had to be done. I chose to create width we say off dimention for vertical alignment. Inorder to consume and return
;; a struct abs-rect (abstract rectangle) and have code map horizontal and vertical rect the values in terms of width and height manipulation had to be done. I chose to create
;; stucts on to them. This code is a bit long but more readable than the other two options a struct abs-rect (abstract rectangle) and have code map horizontal and vertical rect
;; I came up with. stucts on to them. This code is a bit long but more readable than the other two options
;; 1) define all functions to be letrec bound functions inside align. align then take I came up with.
;; accessors for the rect struct. The caller of align swaps the order of ondimention 1) define all functions to be letrec bound functions inside align. align then take
;; and off dimention accessors for vertical or horizontal code. This method does not accessors for the rect struct. The caller of align swaps the order of ondimention
;; allow the use of the readable, sort, consis pattern matching code. As some of the and off dimention accessors for vertical or horizontal code. This method does not
;; matching code is easily removed this may be a good option but a large letrec allow the use of the readable, short, consis pattern matching code. As some of the
;; is harder to write tests for. matching code is easily removed this may be a good option but a large letrec
;; 2) define a pattern matcher syntax that will match the struct rect but swap the fields is harder to write tests for.
;; based on wich on is the on or off dimention. This would have been shorter but much 2) define a pattern matcher syntax that will match the struct rect but swap the fields
;; more confusing. based on wich on is the on or off dimention. This would have been shorter but much
;; The current implementation requires align to map over the rects and allocate new stucts more confusing.
;; for each one on both passing into and returning from stretch-to-fit; This is not a bottle The current implementation requires align to map over the rects and allocate new stucts
;; neck and it is the most readable solution. for each one on both passing into and returning from stretch-to-fit; This is not a bottle
neck and it is the most readable solution.
|#
(module alignment mzscheme (module alignment mzscheme
@ -29,15 +31,16 @@
(define-struct rect (x y)) (define-struct rect (x y))
(define-struct abs-rect (ondim offdim)) (define-struct abs-rect (ondim offdim))
(define-struct dim (pos size stretchable?)) (define-struct dim (pos size stretchable?))
;; make-rect (dim? dim? . -> . rect?)
;; make-abs-rect (dim? dim? . -> . rect?)
;; make-dim (nonnegative? nonnegative? boolean? . -> . dim?)
(provide (define (nonnegative? n)
(struct rect (x y)) (and (number? n)
(struct dim (pos size stretchable?))) (or (positive? n)
(zero? n))))
(provide/contract (provide/contract
(struct rect ((x dim?) (y dim?)))
(struct abs-rect ((ondim dim?) (offdim dim?)))
(struct dim ((pos nonnegative?) (size nonnegative?) (stretchable? boolean?)))
(align ((symbols 'horizontal 'vertical) (align ((symbols 'horizontal 'vertical)
positive? positive? (listof rect?) positive? positive? (listof rect?)
. -> . (listof rect?))) . -> . (listof rect?)))
@ -137,7 +140,7 @@
(make-dim 0 offsize offstretch?)) (make-dim 0 offsize offstretch?))
(loop rest-rects (+ onpos onsize))))])))) (loop rest-rects (+ onpos onsize))))]))))
;; waner (nonnegative? . -> . (-> (union 1 0))) ;; waner (natural-number? . -> . (-> (union 1 0)))
;; makes a thunk that returns 1 for it's first n applications, zero otherwise ;; makes a thunk that returns 1 for it's first n applications, zero otherwise
(define (waner n) (define (waner n)
(lambda () (lambda ()

30
collects/test-suite/private/button-snip.ss
View File

@ -6,6 +6,7 @@
(lib "etc.ss")) (lib "etc.ss"))
(provide (provide
text-button-snip%
button-snip% button-snip%
toggle-button-snip%) toggle-button-snip%)
@ -55,6 +56,35 @@
(super-new) (super-new)
(load-file image))) (load-file image)))
;; a textual button of the same type
(define text-button-snip%
(class string-snip%
(init label)
(init-field callback)
(field
[got-click? false]
[inside? false])
(rename [super-on-event on-event])
(define/override (on-event dc x y editorx editory event)
(case (send event get-event-type)
[(left-down)
(set! got-click? true)
(set! inside? true)]
[(left-up)
(when (and got-click? inside?)
(callback this event))
(set! got-click? false)
(set! inside? false)]
[(enter)
(set! inside? true)]
[(leave)
(set! inside? false)]
[else (void)]))
(super-make-object label)))
;; a toggle button that displays different images
(define toggle-button-snip% (define toggle-button-snip%
(class button-snip% (class button-snip%
(inherit set-images) (inherit set-images)