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

improved Java example boxes

Browse Source 
svn: r1325
This commit is contained in:
Matthew Flatt 2005-11-16 01:16:58 +00:00
parent d08b2afc58
commit db6ac7f0a6
4 changed files with 59 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/embedded-gui/doc.txt
View File

@ -84,7 +84,7 @@ _alignment-parent<%>_s implement the following methods.
The pasteboard that this alignment is being displayed to
> (send an-alignment-parent add-child) -> void
> (send an-alignment-parent add-child child) -> void
child : (is-a?/c alignment<%>)
after : (union (is-a?/c alignment<%>) false?) = false

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

@ -90,6 +90,12 @@
(super-new)
(load-file image)))
(define BUTTON-H-SPACE 5)
(define BUTTON-V-SPACE 2)
(define UNCLICKED-COLOR (make-object color% 220 220 175))
(define CLICKED-COLOR (make-object color% 100 100 50))
;; a textual button of the same type
(define text-button-snip%
(class string-snip%
@ -99,21 +105,64 @@
[got-click? false]
[inside? false])
(define/private (inc b v)
(when b
(set-box! b (+ v (unbox b)))))
(define/override get-extent
(opt-lambda (dc x y [w #f] [h #f] [db #f] [dt #f] [dl #f] [dr #f])
(super get-extent dc (+ x BUTTON-H-SPACE) (+ y BUTTON-V-SPACE) w h db dt dl dr)
(inc w (* 2 BUTTON-H-SPACE))
(inc h (* 2 BUTTON-V-SPACE))
(inc db BUTTON-V-SPACE)
(inc dt BUTTON-V-SPACE)
(inc dl BUTTON-H-SPACE)
(inc dr BUTTON-H-SPACE)))
(define/override (draw dc x y t l r b dx dy caret)
(let ([p (send dc get-pen)]
[b (send dc get-brush)]
[smoothing (send dc get-smoothing)])
(send dc set-pen "black" 1 'solid)
(send dc set-brush
(if got-click? CLICKED-COLOR UNCLICKED-COLOR)
'solid)
(send dc set-smoothing 'aligned)
(let ([w (box 0)]
[h (box 0)])
(get-extent dc x y w h)
(send dc draw-rounded-rectangle x y (unbox w) (unbox h) BUTTON-H-SPACE))
(send dc set-pen p)
(send dc set-brush b)
(send dc set-smoothing smoothing))
(super draw dc (+ x BUTTON-H-SPACE) (+ y BUTTON-V-SPACE)
t l r b
(+ dx BUTTON-H-SPACE) (+ dy BUTTON-V-SPACE)
caret))
(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)]
(set! inside? true)
(refresh)]
[(left-up)
(when (and got-click? inside?)
(callback this event))
(set! got-click? false)
(set! inside? false)]
(set! inside? false)
(refresh)]
[(enter)
(set! inside? true)]
[(leave)
(set! inside? false)]
[else (void)]))
(inherit get-admin)
(define/private (refresh)
(let ([a (get-admin)])
(when a
(send a needs-update this 0 0 1000 100))))
(super-make-object label)
(inherit set-style)

5
collects/embedded-gui/private/cue-text.ss
View File

@ -19,7 +19,7 @@
(define cue-text-mixin
(mixin ((class->interface text%)) ()
(inherit insert change-style erase)
(inherit insert change-style erase clear-undos)
(init [cue-text ""]
[color "gray"])
(init-field
@ -31,7 +31,8 @@
(define (clear-cue-text)
(when first-focus?
(set! first-focus? false)
(erase)))
(erase)
(clear-undos)))
#;(boolean? . -> . void)
;; Called when this text% gains or loses focus

6
collects/profjBoxes/private/example-box.ss
View File

@ -30,7 +30,7 @@
;; A readable-snip<%> of an examples box to allow GUI contruction of data examples.
(define example-box%
(class* editor-snip% (readable-snip<%>)
(class* (decorated-editor-snip-mixin editor-snip%) (readable-snip<%>)
(inherit set-snipclass)
(init [examples-to-copy #f])
@ -117,6 +117,8 @@
;;;;;;;;;;
;; Layout
(define/override (get-color) "purple")
(field [pb (new aligned-pasteboard%)])
(send pb lock-alignment true)
(field [main (new vertical-alignment% (parent pb))]
@ -233,7 +235,7 @@
(new horizontal-alignment% (parent this)) ; spacer
(new embedded-text-button%
(parent this)
(label "Del")
(label "Delete")
(callback (lambda (b e) (send (get-parent) delete-child this))))
(send (get-pasteboard) lock-alignment false)
))