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

.

Browse Source 
original commit: 116461de53ef3c1db9d82d43fec9a455bde299d2
This commit is contained in:
Matthew Flatt 1998-08-14 01:50:58 +00:00
parent 06e9d67191
commit c523299b4b
3 changed files with 22 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/tests/mred/draw.ss
View File

@ -406,7 +406,7 @@
(send dc set-background
(if cyan?
(make-object wx:brush% "CYAN" wx:const-solid)
(make-object wx:brush% "WHILE" wx:const-solid)))
(make-object wx:brush% "WHITE" wx:const-solid)))
(send dc destroy-clipping-region)
(send dc clear)
@ -444,7 +444,8 @@
[ps? #t]
[use-bitmap? (and (= w (* scale 350)) (= h (* scale 300)))]
[else (= w (send this get-width)) (= h (send this get-height))])
(error "wrong size reported by get-size: ~a ~a" w h))))
(error 'x "wrong size reported by get-size: ~a ~a; w & h is ~a ~a"
w h (send this get-width) (send this get-height)))))
(send dc end-page)
(send dc end-doc)))

16
collects/tests/mred/item.ss
View File

@ -45,7 +45,7 @@
(make-object
(class-asi timer%
(inherit start)
(public
(override
[notify
(lambda ()
(when (send frame is-shown?)
@ -117,7 +117,8 @@
(inherit popup-menu get-dc)
(public
[last-m null]
[last-choice #f]
[last-choice #f])
(override
[on-paint
(lambda ()
(let ([dc (get-dc)])
@ -172,9 +173,9 @@
(define active-frame%
(class-asi frame%
(private (pre-on void))
(public [pre-on-event (lambda args (apply pre-on args))]
[pre-on-char pre-on-event]
[set-info
(override [pre-on-event (lambda args (apply pre-on args))]
[pre-on-char pre-on-event])
(public [set-info
(lambda (ep)
(set! pre-on (add-pre-note this ep)))])))
@ -1283,6 +1284,8 @@
(public
[vw 10]
[vh 10]
[set-vsize (lambda (w h) (set! vw w) (set! vh h))])
(override
[on-paint
(lambda ()
(let ([s (format "V: p: ~s r: ~s g: ~s H: ~s ~s ~s"
@ -1307,7 +1310,6 @@
3 27)
(draw-line 0 vh vw vh)
(draw-line vw 0 vw vh)))]
[set-vsize (lambda (w h) (set! vw w) (set! vh h))]
[on-scroll
(lambda (e) (on-paint))])
(sequence
@ -1363,7 +1365,7 @@
(make-object
(class timer% ()
(inherit start)
(public
(override
[notify
(lambda ()
(let* ([now (seconds->date (current-seconds))]

19
src/mred/wrap/mred.ss
View File

@ -379,7 +379,8 @@
[super-on-kill-focus on-kill-focus])
(inherit get-width get-height get-x get-y
get-parent get-client-size)
(rename [super-enable enable])
(rename [super-enable enable]
[super-set-size set-size])
(private [enabled? #t])
(override
[enable
@ -411,9 +412,6 @@
[is-enabled?
(lambda () enabled?)])
(rename
[super-set-size set-size])
(public
; Store minimum size of item.
; This will never change after the item is created.
@ -515,6 +513,8 @@
(send parent child-redraw-request this))))]
[on-container-resize void] ; This object doesn't contain anything
[init-min (lambda (x) x)]
; get-min-size: computes the minimum size the item can
; reasonably assume.
@ -528,8 +528,8 @@
(sequence
(apply super-init (send (car args) get-window) (cdr args))
(set-min-width (get-width))
(set-min-height (get-height))
(set-min-width (init-min (get-width)))
(set-min-height (init-min (get-height)))
(send (area-parent) add-child this)))))
@ -1213,7 +1213,9 @@
(set! curr-width client-width)
(set! curr-height client-height)
(set! move-children? #f)
(redraw client-width client-height))))])
(redraw client-width client-height))))]
[init-min (lambda (x) 0)])
(public
; place-children: determines where each child of panel should be
@ -1285,8 +1287,7 @@
child-infos
placements))])
(sequence
(super-init parent -1 -1 0 0 style)
(set-min-width 0) (set-min-height 0))))
(super-init parent -1 -1 0 0 style))))
(define (wx-make-pane% wx:panel%)
(class (make-container-glue% (make-glue% (wx-make-basic-panel% wx:panel%))) args