2014-11-20 02:42:58 +00:00
|
|
|
#lang racket/base
|
|
|
|
|
(require racket/match
|
|
|
|
|
racket/fixnum
|
|
|
|
|
racket/gui/base
|
|
|
|
|
racket/class
|
|
|
|
|
(prefix-in pict: pict)
|
|
|
|
|
(prefix-in image: 2htdp/image)
|
|
|
|
|
lux
|
|
|
|
|
lux/chaos/gui
|
2014-11-20 21:31:02 +00:00
|
|
|
lux/chaos/gui/val
|
|
|
|
|
lux/chaos/gui/key)
|
2014-11-20 02:42:58 +00:00
|
|
|
|
|
|
|
|
(define MODES
|
2014-11-21 04:15:50 +00:00
|
|
|
(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"))))
|
2014-11-20 02:42:58 +00:00
|
|
|
|
|
|
|
|
(struct demo
|
2014-11-20 21:31:02 +00:00
|
|
|
(g/v mode)
|
2014-11-20 02:42:58 +00:00
|
|
|
#:methods gen:word
|
2014-11-21 18:26:01 +00:00
|
|
|
[(define (word-fps w)
|
|
|
|
|
60.0)
|
|
|
|
|
(define (word-label s ft)
|
2014-11-20 02:42:58 +00:00
|
|
|
(lux-standard-label "Values" ft))
|
2014-11-20 15:53:15 +00:00
|
|
|
(define (word-output w)
|
2014-11-20 21:31:02 +00:00
|
|
|
(match-define (demo g/v mode-n) w)
|
2014-11-21 04:15:50 +00:00
|
|
|
(g/v (list-ref MODES mode-n)))
|
2014-11-20 15:53:15 +00:00
|
|
|
(define (word-event w e)
|
2014-11-20 21:31:02 +00:00
|
|
|
(match-define (demo g/v mode-n) w)
|
2014-11-20 02:42:58 +00:00
|
|
|
(define closed? #f)
|
2014-11-20 21:31:02 +00:00
|
|
|
(cond
|
|
|
|
|
[(eq? e 'close)
|
|
|
|
|
#f]
|
|
|
|
|
[(and (key-event? e)
|
|
|
|
|
(not (eq? 'release (send e get-key-code))))
|
|
|
|
|
(demo g/v (fxmodulo (fx+ 1 mode-n) (length MODES)))]
|
|
|
|
|
[else
|
|
|
|
|
(demo g/v mode-n)]))
|
2014-11-20 15:53:15 +00:00
|
|
|
(define (word-tick w)
|
|
|
|
|
w)])
|
2014-11-20 02:42:58 +00:00
|
|
|
|
|
|
|
|
(module+ main
|
|
|
|
|
(call-with-chaos
|
2014-11-21 18:26:01 +00:00
|
|
|
(make-gui)
|
2014-11-20 21:31:02 +00:00
|
|
|
(λ () (fiat-lux (demo (make-gui/val) 0)))))
|
