misc-deps
/
lux
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Notes and cleanup for gui/val

This commit is contained in:
Jay McCarthy 2014-11-20 20:15:50 -08:00
parent bb1567f481
commit f1a4039c55
2 changed files with 26 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
chaos/gui/val.rkt
View File

@ -1,32 +1,30 @@
#lang racket/base #lang racket/base
(require racket/class (require racket/class
racket/draw racket/draw
racket/fixnum
racket/contract/base racket/contract/base
pict pict
pict/convert) pict/convert)
;; xxx maybe draw to a bitmap and blit
(define (make-gui/val #:scale? [scale? #t]) (define (make-gui/val #:scale? [scale? #t])
(define last-val #f) (λ (o)
(define (output-val o) (define p (pict-convert o))
(unless (eq? o last-val) (λ (w h dc)
(set! last-val o) (parameterize ([dc-for-text-size dc])
(define p (pict-convert o)) (send dc set-background "black")
(λ (w h dc) (send dc clear)
(parameterize ([dc-for-text-size dc]) (define sp
(send dc set-background "black") (if scale?
(send dc clear) (scale-to-fit p w h)
(define sp p))
(if scale? (define spw (pict-width sp))
(scale-to-fit p w h) (define left (/ (- w spw) 2))
p)) (define sph (pict-height sp))
(define spw (pict-width sp)) (define top (/ (- h sph) 2))
(define left (/ (- w spw) 2)) (send dc set-brush "white" 'solid)
(define sph (pict-height sp)) (send dc draw-rectangle left top spw sph)
(define top (/ (- h sph) 2)) (draw-pict sp dc left top)))))
(send dc set-brush "white" 'solid)
(send dc draw-rectangle left top spw sph)
(draw-pict sp dc left top)))))
output-val)
(provide (provide
(contract-out (contract-out

18
examples/val-demo.rkt
View File

@ -11,7 +11,11 @@
lux/chaos/gui/key) lux/chaos/gui/key)
(define MODES (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 (struct demo
(g/v mode) (g/v mode)
@ -20,15 +24,7 @@
(lux-standard-label "Values" ft)) (lux-standard-label "Values" ft))
(define (word-output w) (define (word-output w)
(match-define (demo g/v mode-n) w) (match-define (demo g/v mode-n) w)
(g/v (g/v (list-ref MODES mode-n)))
(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"))])))
(define (word-event w e) (define (word-event w e)
(match-define (demo g/v mode-n) w) (match-define (demo g/v mode-n) w)
(define closed? #f) (define closed? #f)
@ -45,5 +41,5 @@
(module+ main (module+ main
(call-with-chaos (call-with-chaos
(make-gui 60.0) (make-gui 60.0)
(λ () (fiat-lux (demo (make-gui/val) 0))))) (λ () (fiat-lux (demo (make-gui/val) 0)))))