96 lines
3.2 KiB
Racket
96 lines
3.2 KiB
Racket
(module snip-wrapper mzscheme
|
|
|
|
(require
|
|
mzlib/etc
|
|
mzlib/class
|
|
mred
|
|
"interface.rkt"
|
|
(prefix sl: "snip-lib.rkt")
|
|
"dllist.rkt")
|
|
|
|
(provide control-style
|
|
snip-wrapper%)
|
|
|
|
(define control-style
|
|
(let ([delta (make-object style-delta%)])
|
|
(send delta set-family 'system)
|
|
(send delta set-delta 'change-size (send normal-control-font get-point-size))
|
|
(send the-style-list find-or-create-style
|
|
(send the-style-list basic-style)
|
|
delta)))
|
|
|
|
(define snip-wrapper%
|
|
(class* dllist% (alignment<%>)
|
|
(init-field parent snip)
|
|
(field [pasteboard (send parent get-pasteboard)]
|
|
[show? true]
|
|
[snip-is-inserted? false]
|
|
[min-width 0]
|
|
[min-height 0])
|
|
|
|
;;;;;;;;;;
|
|
;; alignment<%>
|
|
|
|
#;(-> alignment-parent<%>)
|
|
;; The parent of this alignment
|
|
(define/public (get-parent) parent)
|
|
|
|
#;(-> void?)
|
|
;; Tells the alignment that its sizes should be calculated
|
|
(define/public (set-min-sizes)
|
|
(if snip-is-inserted?
|
|
(begin (set! min-width (sl:snip-min-width snip))
|
|
(set! min-height (sl:snip-min-height snip)))
|
|
(begin (set! min-width 0)
|
|
(set! min-height 0))))
|
|
|
|
#;(nonnegative? nonnegative? nonnegative? nonnegative? . -> . void?)
|
|
;; Tells the alignment to align its children on the pasteboard in the given rectangle
|
|
(define/public (align x y w h)
|
|
(send pasteboard move-to snip x y)
|
|
(when (is-a? snip stretchable-snip<%>)
|
|
(send snip stretch w h)))
|
|
|
|
#;(-> nonnegative?)
|
|
;; The minimum width this alignment must be.
|
|
(define/public (get-min-width) min-width)
|
|
|
|
#;(-> nonnegative?)
|
|
;; The minimum height this alignment must be.
|
|
(define/public (get-min-height) min-height)
|
|
|
|
#;(case-> (-> boolean?) (boolean? . -> . void?))
|
|
;; True if the alignment can be stretched in the x dimension
|
|
(define/public (stretchable-width)
|
|
(sl:stretchable-width? snip))
|
|
|
|
#;(case-> (-> boolean?) (boolean? . -> . void?))
|
|
;; True if the alignment can be stretched in the y dimension
|
|
(define/public (stretchable-height)
|
|
(sl:stretchable-height? snip))
|
|
|
|
#;(boolean? . -> . void?)
|
|
;; Tells the alignment that its show state is the given value
|
|
;; and it should show or hide its children accordingly.
|
|
(define/public (show bool)
|
|
(set! show? bool)
|
|
(show/hide show?))
|
|
|
|
#;(boolean? . -> . void)
|
|
;; Tells the alignment to show or hide its children
|
|
(define/public (show/hide bool)
|
|
(send pasteboard lock-alignment true)
|
|
(unless (boolean=? bool snip-is-inserted?)
|
|
(if bool
|
|
(begin (send pasteboard insert-aligned-snip snip)
|
|
(set! snip-is-inserted? true))
|
|
(begin (send pasteboard release-aligned-snip snip)
|
|
(set! snip-is-inserted? false))))
|
|
(send pasteboard realign)
|
|
(send pasteboard lock-alignment false))
|
|
|
|
(super-new)
|
|
(send parent add-child this)
|
|
(show/hide (and show? (send parent is-shown?)))))
|
|
)
|