#lang scheme/gui
(require "mreddesigner-misc.ss"
"preview-widgets.ss"
"properties.ss"
"property-widgets.ss"
)
(define/provide property-frame #f)
(define/provide (show-property-frame)
(send property-frame show #t))
(define current-prop-panel #f)
(define update-callback #f)
(define/provide (make-property-frame
[parent #f]
#:update-callback update-cb
)
(set! update-callback update-cb)
(let-values ([(screen-w screen-h) (get-display-size)])
(set! property-frame
(new frame%
[label "Properties"]
[parent parent]
[x (- screen-w 320)]
[y 5]
[min-width 300]
[stretchable-width #f]
[stretchable-height #f])))
(set! current-prop-panel (make-properties-panel #f))
)
(define prop-panel-hash (make-weak-hasheq))
(define (make-properties-panel mid)
(debug-printf "make-properties-panel: creating a new prop-panel for ~a\n" (and mid (send mid get-id)))
(let ([vp (new vertical-panel% [parent property-frame])])
(if mid
(let ([prop-widgets (parameterize ([current-property-mred-id mid])
(field-id-properties->widgets vp (send mid get-properties)))])
(new button%
[parent vp]
[label "Apply && Update Preview"]
[style '(border)]
[callback (λ _
(debug-printf "make-properties-panel: update enter\n")
(for-each (λ(p)(when p (send p commit))) prop-widgets)
(update-callback)
(debug-printf "make-properties-panel: update exit\n")
)])
)
(let ([vp2 (new vertical-panel%
[parent vp]
[min-height 300]
[alignment '(center center)])])
(new message% [parent vp2]
[label "No widget selected."]))
)
vp
))
(define/provide (update-property-frame mid)
(send property-frame begin-container-sequence)
(send property-frame change-children (λ(l)'())) (set! current-prop-panel
(hash-ref! prop-panel-hash mid
(λ()(make-properties-panel mid))))
(send property-frame change-children
(λ(l)(list current-prop-panel)))
(send property-frame end-container-sequence)
)