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

fixed buttons and realy resized error is hacked to be caught

Browse Source 
original commit: 07182c63afd0a5642972c0912dac4ecca1a6a12a
This commit is contained in:
Mike MacHenry 2004-08-12 19:01:10 +00:00
parent 5e29ac6338
commit 3fa1b48029
2 changed files with 38 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
collects/embedded-gui/private/button-snip.ss
View File

@ -1,3 +1,5 @@
#| Rewrite these to use snip-wrapper% automatically |#
(module button-snip mzscheme
(require
@ -88,20 +90,34 @@
(define toggle-button-snip%
(class button-snip%
(inherit set-images)
(init-field images-off images-on callback-off callback-on (state 'on))
(init-field images-off images-on turn-off turn-on (state 'on))
;; Emulates clicking the button to a certain state
(define/public (turn astate)
(case astate
[(off) (set-state 'off)
(turn-on this #f)]
[(on) (set-state 'on)
(turn-off this #f)]))
(define/public (set-state value)
(case value
[(off) (set-images images-off)
(set! state 'off)]
[(on) (set-images images-on)
(set! state 'on)]))
(super-new
(images (if (symbol=? state 'on) images-on images-off))
(images (case state
[(on) images-on]
[(off) images-off]))
(callback
(lambda (b e)
(if (symbol=? state 'on)
(begin
(set-images images-off)
(set! state 'off)
(callback-on b e))
(begin
(set-images images-on)
(set! state 'on)
(callback-off b e))))))))
;; NOTE: I lose the event right here, but turn can't require it.
;; Since it's public.
(case state
[(on) (turn 'off)]
[(off) (turn 'on)]))))))
;;;;;;;;;;
;; tests
@ -132,17 +148,18 @@
(define t (new text%))
(define es (new editor-snip% (editor t)))
(define b (new toggle-button-snip%
(images1 (cons (build-path (collection-path "icons") "turn-up.gif")
(images-on (cons (build-path (collection-path "icons") "turn-up.gif")
(build-path (collection-path "icons") "turn-up-click.gif")))
(images2 (cons (build-path (collection-path "icons") "turn-down.gif")
(images-off (cons (build-path (collection-path "icons") "turn-down.gif")
(build-path (collection-path "icons") "turn-down-click.gif")))
(callback1
(turn-on
(lambda (b e)
(send* t (erase) (insert "Up"))))
(callback2
(turn-off
(lambda (b e)
(send* t (erase) (insert "Down"))))))
(send e insert es 50 0)
(send e insert b)
(send f show #t))
)

9
collects/embedded-gui/private/really-resized-pasteboard.ss
View File

@ -40,7 +40,11 @@ get text deteleted from them, etc.
(super-resized snip redraw-now?)
(unless ignore-resizing?
(let ([size (snip-size snip)])
(unless (equal? size (hash-table-get snip-cache snip))
;; The snip is getting remove from hash table in a way I
;; am not antisipating. I need to find it and then I can
;; remove this error catcher.
(unless (equal? size (with-handlers ([exn? (lambda x 0)])
(hash-table-get snip-cache snip)))
(hash-table-put! snip-cache snip size)
(really-resized snip)))))
@ -76,8 +80,7 @@ get text deteleted from them, etc.
(cons (- (unbox right) (unbox left))
(- (unbox bottom) (unbox top)))))
(super-new)
))
(super-new)))
(define really-resized-pasteboard%
(really-resized-pasteboard-mixin