-
Notifications
You must be signed in to change notification settings - Fork 0
/
icons.rkt
173 lines (157 loc) · 4.32 KB
/
icons.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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
#lang racket
(provide
(contract-out
[target (-> pict?)]
[range (-> pict?)]
[push (-> pict?)]
[pull (-> pict?)]
[move (-> pict?)]
[jump (-> pict?)]
[teleport (-> pict?)]))
(require pict
pict/color
pict/shadow
racket/draw
frosthaven-manager/curlique
frosthaven-manager/aoe-images)
(define-flow highlight
(shadow 10 0 0 #:shadow-color "white"))
(define (target)
(~> (20 40)
(>< (circle #:border-width 5))
cc-superimpose
highlight))
(define (range)
(parameterize ([hex-size 10])
(define left (S))
(define right (ghost (S)))
(~> (left right)
hc-append
(pin-arrow-line
5
_
left cc-find
right cc-find)
(inset 0 0 -10 0)
highlight)))
(define (push)
(define (outlined-arrowhead size)
(cc-superimpose (arrowhead size 0)
(white (scale (arrowhead size 0) 6/10))))
(define arrows
(map {~> outlined-arrowhead (rotate (* 1/2 pi))}
(list 20 10 5)))
(~> (arrows) sep
(vc-append -2 __)
(scale 1 3/4)
highlight))
(define (pull)
(rotate (push) pi))
(define boot-scale 3)
(define (scale-point scale)
{~> (-< car cdr) (>< (* scale)) cons})
(define boot-path
(let ([p (new dc-path%)])
(begin0 p
(send* p
[move-to 0 0]
[lines (map (scale-point boot-scale)
'((0 . 10)
(2 . 10)
(3 . 9)
(4 . 10)
(6 . 10)
(8 . 9)
(4 . 6)
(4 . 0)
(0 . 0)
(0 . 10)))]
[close]))))
(define (boot)
(dc (λ (dc dx dy)
(define old-brush (send dc get-brush))
(send* dc
[set-brush "white" 'solid]
[draw-path boot-path dx dy]
[draw-line (+ dx (* boot-scale 6))
(+ dy (* boot-scale (- 10 2.5)))
(+ dx (* boot-scale 5.7))
(+ dy (* boot-scale (- 10 2.1)))]
[draw-line (+ dx (* boot-scale 16/3))
(+ dy (* boot-scale (- 10 3)))
(+ dx (* boot-scale 77/15))
(+ dy (* boot-scale (- 10 41/15)))]
[draw-line (+ dx (* boot-scale 4))
(+ dy (* boot-scale (- 10 8)))
(+ dx (* boot-scale 3))
(+ dy (* boot-scale (- 10 8)))]
[draw-line (+ dx (* boot-scale 4))
(+ dy (* boot-scale (- 10 7)))
(+ dx (* boot-scale 3))
(+ dy (* boot-scale (- 10 7)))]
[set-brush old-brush]))
(* boot-scale 8)
(* boot-scale 10)))
(define (trails)
(vr-append
(hline (* boot-scale 8/3) 5)
(hline (* boot-scale 8/4) 5)
(hline (* boot-scale 8/3) 5)))
(define (move)
(~> ((boot))
(rotate (/ pi -6))
(ht-append -3 (trails) _)
highlight))
(define (jump)
(define squish {(scale 1 1/3)})
(define-values (left chain right)
(parameterize ([hex-size 10])
(define left (squish (S)))
(define middle (squish (S)))
(define right (squish (S)))
(values left
(hc-append left middle right)
right)))
(~> (chain)
(pin-arrow-line
5
_
left cc-find
right cc-find
#:start-angle (* pi 1/6)
#:end-angle (* pi -1/6)
#:start-pull 1/2)
(inset 0 5)
highlight))
(define (teleport)
(define squish {(scale 1 1/3)})
(define bottom
(parameterize ([hex-size 10])
(squish (S))))
(define middle
(parameterize ([hex-size 7])
(squish (S))))
(define top
(parameterize ([hex-size 4])
(squish (S))))
(define phantom
(ghost top))
(~> (phantom top middle bottom)
(vc-append 5 __)
(pin-arrow-line
5
_
phantom cc-find
bottom cc-find)
(inset 5 5)
highlight))
(module+ main
(require (only-in racket/gui))
(for ([p (list target
range
push
pull
move
jump
teleport)])
(show-pict (p))))