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

...

Browse Source 
original commit: ac9be2acffc0959305e9729a1807820f99f68876
This commit is contained in:
Mike MacHenry 2004-08-05 00:21:38 +00:00
parent 4558dab073
commit 1039313a04
3 changed files with 45 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
collects/embedded-gui/private/aligned-pasteboard.ss
View File

@ -18,6 +18,9 @@
"verthoriz-alignment.ss"
"suppress-modify-editor.ss")
(require
(lib "print-debug.ss" "mike-lib"))
(define aligned-pasteboard%
(class (click-forwarding-editor-mixin
(on-show-pasteboard-mixin
@ -31,11 +34,11 @@
(field
[alignment (new (case align
[(horizontal) horizontal-alignment%]
[else vertical-alignment%]))]
[(vertical) vertical-alignment%]))]
[lock-alignment? false]
[needs-alignment? false])
(define/public (add i) (send alignment add i))
(define/public (get-alignment) alignment)
#|
snip : snip% object
@ -64,8 +67,8 @@
(super-really-resized snip)
(realign))
#;(rename [super-on-show on-show])
#;(define/override (on-show)
(rename [super-on-show on-show])
(define/override (on-show)
(realign)
(super-on-show))

8
collects/embedded-gui/private/suppress-modify-editor.ss
View File

@ -16,16 +16,16 @@
[super-after-insert after-insert]
[super-after-move-to after-move-to]
[super-after-resize after-resize])
(define/override (after-delete snip)
#;(define/override (after-delete snip)
(super-after-delete snip)
(set-modified false))
(define/override (after-insert snip before x y)
#;(define/override (after-insert snip before x y)
(super-after-insert snip before x y)
(set-modified false))
(define/override (after-move-to snip x y dragging?)
#;(define/override (after-move-to snip x y dragging?)
(super-after-move-to snip x y dragging?)
(set-modified false))
(define/override (after-resize snip w h resized?)
#;(define/override (after-resize snip w h resized?)
(super-after-resize snip w h resized?)
(set-modified false))
(super-new)))

52
collects/embedded-gui/private/verthoriz-alignment.ss
View File

@ -29,14 +29,6 @@
[min-width 0]
[min-height 0])
;; need base class for this method
(define (show/hide-child child show?)
(if (is-a? child alignment<%>)
(send child show show?)
(if show?
(send pasteboard insert child)
(send pasteboard release-snip child))))
;; STATUS: This function (through lock-alignment false) invokes a call
;; to realign of the pasteboard even when this alignement has show? = false
;; so the call is not needed.
@ -45,28 +37,50 @@
(send pasteboard lock-alignment true)
(cond
[(is-a? child snip%)
(when show?
(when (get-show?)
(send pasteboard insert child false))]
[(is-a? child alignment<%>)
(send child set-pasteboard pasteboard)])
(send pasteboard lock-alignment false))
(define/public (get-min-width)
(if show? min-width 0))
(if (get-show?) min-width 0))
(define/public (get-min-height)
(if show? min-height 0))
(if (get-show?) min-height 0))
(define/public (set-pasteboard pb) (set! pasteboard pb))
(define/public (stretchable-width?) true)
(define/public (stretchable-height?) true)
#;(boolean? . -> . void?)
;; Shows or hides the alignment
(define/public (show bool)
(unless (boolean=? bool show?)
(set! show? bool)
(set! show? bool)
(when (parent-show?)
(send pasteboard lock-alignment true)
(for-each (lambda (c)
(show/hide-child c bool))
children)
(show/hide-snips show?)
(send pasteboard lock-alignment false)))
#;(boolean? . -> . void?)
;; Inserts or deletes all the snips in the tree.
(define/public (show/hide-snips bool)
(when (boolean=? show? bool)
(for-each (show/hide-child bool) children)))
(define ((show/hide-child show?) child)
(if (is-a? child alignment<%>)
(send child show/hide-snips show?)
(if show?
(send pasteboard insert child)
(send pasteboard release-snip child))))
(define/public (get-show?)
(and show? (parent-show?)))
(define (parent-show?)
(if (and parent (is-a? parent alignment<%>))
(send parent get-show?)
true))
(define/public (align x-offset y-offset width height)
(define move/resize
@ -84,7 +98,7 @@
[(is-a? child alignment<%>)
(send child align global-x global-y w h)]))]))
(when (and show? (not (empty? children)))
(when (and (get-show?) (not (empty? children)))
(for-each move/resize
children
(a:align type width height
@ -111,7 +125,9 @@
children))))))
(super-new)
(when parent (send parent add this))))
;; NOTE: Try to figure out how it's getting a nonalignment<%> parent
(when (and parent (is-a? parent alignment<%>))
(send parent add this))))
(define vertical-alignment% (vert/horiz-alignment 'vertical))
(define horizontal-alignment% (vert/horiz-alignment 'horizontal))