-
Notifications
You must be signed in to change notification settings - Fork 1
/
boundaries-not-projections.rkt
48 lines (42 loc) · 1.71 KB
/
boundaries-not-projections.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
#lang racket
(require slideshow/fullscreen
slideshow/play
"util.rkt" "faces.rkt")
(provide boundaries-not-projections
not-projections)
(define proj-word (scale/improve-new-text (bt "Projections") 4))
(define boun-word (scale/improve-new-text (bt "Boundaries") 4))
(define s (* (pict-width proj-word) 2/3))
(define r (/ s 2))
(define lw 80)
(define (rb p) (linewidth lw (colorize p "red")))
(define (proj-vs-boun proj boun)
(cc-superimpose
(proj (rb (circle s)))
(proj
(rb
(dc (λ (dc dx dy)
(send dc draw-line
(+ dx r (* (- r (/ lw 2)) (cos (* pi 1/4))))
(+ dy r (* (- r (/ lw 2)) (sin (* pi 1/4))))
(+ dx r (* (- r (/ lw 2)) (cos (* pi 5/4))))
(+ dy r (* (- r (/ lw 2)) (sin (* pi 5/4))))))
s s)))
(refocus (cc-superimpose
(boun (colorize (scale/improve-new-text (bt "✓") 20) "forestgreen"))
(vc-append (blank 0 100) (rc-superimpose
(proj proj-word)
(boun boun-word))))
boun-word)))
(define christos (get-bitmap 'christos))
(define (mk-proc n1)
(lt-superimpose (cellophane (ht-append 20
(scale christos 2/3)
(vl-append (t "Christos")
(t "Dimoulas")))
n1)
(proj-vs-boun ghost values)))
(define (boundaries-not-projections)
(slide (proj-vs-boun values ghost))
(play-n #:aspect 'fullscreen mk-proc))
(define (not-projections) (proj-vs-boun values ghost))