diff --git a/chaos/gui/val.rkt b/chaos/gui/val.rkt index 5341b5a..4e167dc 100644 --- a/chaos/gui/val.rkt +++ b/chaos/gui/val.rkt @@ -1,32 +1,30 @@ #lang racket/base (require racket/class racket/draw + racket/fixnum racket/contract/base pict pict/convert) +;; xxx maybe draw to a bitmap and blit (define (make-gui/val #:scale? [scale? #t]) - (define last-val #f) - (define (output-val o) - (unless (eq? o last-val) - (set! last-val o) - (define p (pict-convert o)) - (λ (w h dc) - (parameterize ([dc-for-text-size dc]) - (send dc set-background "black") - (send dc clear) - (define sp - (if scale? - (scale-to-fit p w h) - p)) - (define spw (pict-width sp)) - (define left (/ (- w spw) 2)) - (define sph (pict-height sp)) - (define top (/ (- h sph) 2)) - (send dc set-brush "white" 'solid) - (send dc draw-rectangle left top spw sph) - (draw-pict sp dc left top))))) - output-val) + (λ (o) + (define p (pict-convert o)) + (λ (w h dc) + (parameterize ([dc-for-text-size dc]) + (send dc set-background "black") + (send dc clear) + (define sp + (if scale? + (scale-to-fit p w h) + p)) + (define spw (pict-width sp)) + (define left (/ (- w spw) 2)) + (define sph (pict-height sp)) + (define top (/ (- h sph) 2)) + (send dc set-brush "white" 'solid) + (send dc draw-rectangle left top spw sph) + (draw-pict sp dc left top))))) (provide (contract-out diff --git a/examples/val-demo.rkt b/examples/val-demo.rkt index d230559..0b5a3db 100644 --- a/examples/val-demo.rkt +++ b/examples/val-demo.rkt @@ -11,7 +11,11 @@ lux/chaos/gui/key) (define MODES - '(pict image)) + (list (pict:arrowhead 30 0) + (image:add-line + (image:rectangle 100 100 "solid" "darkolivegreen") + 25 25 75 75 + (image:make-pen "goldenrod" 30 "solid" "round" "round")))) (struct demo (g/v mode) @@ -20,15 +24,7 @@ (lux-standard-label "Values" ft)) (define (word-output w) (match-define (demo g/v mode-n) w) - (g/v - (match (list-ref MODES mode-n) - ['pict - (pict:arrowhead 30 0)] - ['image - (image:add-line - (image:rectangle 100 100 "solid" "darkolivegreen") - 25 25 75 75 - (image:make-pen "goldenrod" 30 "solid" "round" "round"))]))) + (g/v (list-ref MODES mode-n))) (define (word-event w e) (match-define (demo g/v mode-n) w) (define closed? #f) @@ -45,5 +41,5 @@ (module+ main (call-with-chaos - (make-gui 60.0) + (make-gui 60.0) (λ () (fiat-lux (demo (make-gui/val) 0)))))