-
Notifications
You must be signed in to change notification settings - Fork 1
/
quick.rkt
68 lines (55 loc) · 1.63 KB
/
quick.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
#lang slideshow
(require pict/flash)
(require (planet schematics/random:1:0/random))
(require slideshow/code)
(require racket/class
racket/gui/base)
(define f (new frame% [label "my art"]
[width 300]
[height 300]
[alignment '(center center)]))
(define c (circle 10))
(define r (rectangle 10 20))
(define (square n)
(filled-rectangle n n))
(define (four p)
(define two-p (hc-append p p))
(vc-append two-p two-p))
(define (checker p1 p2)
(let ([p12 (hc-append p1 p2)]
[p21 (hc-append p2 p1)])
(vc-append p12 p21)))
(define (checkerboard p)
(let* ([rp (colorize p "red")]
[bp (colorize p "black")]
[c (checker rp bp)]
[c4 (four c)])
(four c4)))
(define (series mk)
(hc-append 4 (mk 5) (mk 10) (mk 20)))
(define (rgb-series mk)
(vc-append
(series (lambda (sz) (colorize (mk sz) "red")))
(series (lambda (sz) (colorize (mk sz) "green")))
(series (lambda (sz) (colorize (mk sz) "blue")))))
(define (rgb-maker mk)
(lambda (sz)
(vc-append (colorize (mk sz) "red")
(colorize (mk sz) "green")
(colorize (mk sz) "blue"))))
(define (rainbow p)
(map (lambda (color)
(colorize p color))
(list "red" "orange" "yellow" "green" "blue" "purple")))
(define-syntax pict+code
(syntax-rules ()
[(pict+code expr)
(hc-append 10
expr
(code expr))]))
(define (add-drawing p)
(let ([drawer (make-pict-drawer p)])
(new canvas% [parent f]
[style '(border)]
[paint-callback (lambda (self dc)
(drawer dc 0 0))])))