Skip to content

Commit 431a0e5

Browse files
osnrosnr
authored
Merge pull request #201 from FolkComputer/ac/shapes-tune-up
Shapes refactor
2 parents 077517c + add6b0e commit 431a0e5

File tree

1 file changed

+260
-70
lines changed

1 file changed

+260
-70
lines changed

‎virtual-programs/shapes.folk‎

Lines changed: 260 additions & 70 deletions
Original file line numberDiff line numberDiff line change
@@ -1,111 +1,301 @@
1-
# sides 2 => line
2-
# sides 3 => triangle
3-
# sides 4 => square
1+
set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 septagon 7 octagon 8 nonagon 9]
2+
3+
proc process_offset {offset region} {
4+
if {![info exists region]} {
5+
return $offset
6+
}
7+
8+
set w [region width $region]
9+
set h [region height $region]
10+
11+
if {[llength $offset] == 2 &&
12+
![string match *%* $offset] &&
13+
![string is alpha -strict [lindex $offset 0]]} {
14+
return $offset
15+
}
16+
17+
# Handle simple percentage string: "50%"
18+
if {[string match *%* $offset] && [llength $offset] == 1} {
19+
set pct [expr {[string map {% ""} $offset] / 100.0}]
20+
return [list [expr {$w * $pct}] 0] # Default to horizontal offset
21+
}
22+
23+
# Handle directional strings: "right", "left", "up", "down"
24+
if {$offset eq "right"} {
25+
return [list [expr {$w * 0.5}] 0]
26+
} elseif {$offset eq "left"} {
27+
return [list [expr {-$w * 0.5}] 0]
28+
} elseif {$offset eq "up"} {
29+
return [list 0 [expr {-$h * 0.5}]]
30+
} elseif {$offset eq "down"} {
31+
return [list 0 [expr {$h * 0.5}]]
32+
}
33+
34+
# Handle directional percentage: "right 50%", "left 25%", etc.
35+
if {[llength $offset] == 2 && [string is alpha -strict [lindex $offset 0]]} {
36+
set direction [lindex $offset 0]
37+
set amount [lindex $offset 1]
38+
39+
if {[string match *%* $amount]} {
40+
set pct [expr {[string map {% ""} $amount] / 100.0}]
41+
42+
switch $direction {
43+
"right" { return [list [expr {$w * $pct}] 0] }
44+
"left" { return [list [expr {-$w * $pct}] 0] }
45+
"up" { return [list 0 [expr {-$h * $pct}]] }
46+
"down" { return [list 0 [expr {$h * $pct}]] }
47+
default { return [list 0 0] }
48+
}
49+
}
50+
}
51+
52+
# Handle x y vector where one or both components have percentage notation
53+
if {[llength $offset] == 2} {
54+
lassign $offset ox oy
55+
56+
if {[string match *%* $ox]} {
57+
set pct [expr {[string map {% ""} $ox] / 100.0}]
58+
set ox [expr {$w * $pct}]
59+
}
60+
61+
if {[string match *%* $oy]} {
62+
set pct [expr {[string map {% ""} $oy] / 100.0}]
63+
set oy [expr {$h * $pct}]
64+
}
65+
66+
return [list $ox $oy]
67+
}
68+
69+
# Default fallback
70+
return $offset
71+
}
72+
473
When /someone/ wishes to draw a shape with /...options/ {
5-
set numPoints [dict get $options sides]
6-
set c [dict get $options center]
7-
set r [dict get $options radius]
8-
set radians [dict_getdef $options radians 0]
74+
set isRect 0
75+
if {[dict exists $options type] && [dict get $options type] eq "rect"} {
76+
set isRect 1
77+
}
78+
79+
set c [dict_getdef $options center {0 0}]
80+
981
set color [dict_getdef $options color white]
1082
set filled [dict_getdef $options filled false]
83+
set thickness [dict_getdef $options thickness 1]
1184
set layer [dict_getdef $options layer 0]
12-
13-
set p [list 0 0]
14-
set center $p
15-
set points [list $p]
16-
17-
set incr [expr {2 * 3.14159 / $numPoints}]
18-
set a [expr {$incr + 3.14159}]
19-
for {set i 0} {$i < $numPoints} {incr i} {
20-
set p [vec2 add $p [vec2 scale [list [expr {cos($a)}] [expr {sin($a)}]] $r]]
21-
lappend points $p
22-
# Accumulate center
23-
set center [vec2 add $center $p]
24-
set a [expr {$a + $incr}]
25-
}
26-
set center [vec2 scale $center [expr {1.0/$numPoints}]]
27-
28-
set points [lmap v $points {
29-
set v [vec2 sub $v $center]
30-
set v [vec2 rotate $v $radians]
31-
set v [vec2 add $v $c]
32-
set v
33-
}]
34-
85+
set angle [dict_getdef $options angle 0]
86+
87+
if {$isRect} {
88+
set w [dict_getdef $options width 100]
89+
set h [dict_getdef $options height 100]
90+
91+
set hw [expr {$w / 2.0}]
92+
set hh [expr {$h / 2.0}]
93+
94+
set points [lmap v [list \
95+
[list [expr {-$hw}] [expr {-$hh}]] \
96+
[list [expr {$hw}] [expr {-$hh}]] \
97+
[list [expr {$hw}] [expr {$hh}]] \
98+
[list [expr {-$hw}] [expr {$hh}]] \
99+
[list [expr {-$hw}] [expr {-$hh}]] \
100+
] {
101+
vec2 add [vec2 rotate $v $angle] $c
102+
}]
103+
} else {
104+
set numPoints [dict_getdef $options sides 4]
105+
if {[dict exists $options shape] && [dict exists $shapes [dict get $options shape]]} {
106+
set numPoints [dict get $shapes [dict get $options shape]]
107+
}
108+
set r [dict_getdef $options radius 50]
109+
110+
set points {{0 0}}
111+
set centerPoint {0 0}
112+
set polyAngle [expr {2 * 3.14159 / $numPoints + 3.14159}]
113+
set angleIncr [expr {2 * 3.14159 / $numPoints}]
114+
115+
for {set i 0} {$i < $numPoints} {incr i} {
116+
set p [vec2 add [lindex $points end] [vec2 scale [list [expr {cos($polyAngle)}] [expr {sin($polyAngle)}]] $r]]
117+
lappend points $p
118+
set centerPoint [vec2 add $centerPoint $p]
119+
set polyAngle [expr {$polyAngle + $angleIncr}]
120+
}
121+
122+
set points [lmap v $points {
123+
vec2 add [vec2 rotate [vec2 sub $v [vec2 scale $centerPoint [expr {1.0/$numPoints}]]] $angle] $c
124+
}]
125+
}
126+
35127
if {$filled} {
36128
Wish to draw a polygon with points $points color $color layer $layer
37129
} else {
38-
Wish to draw a stroke with points $points width 1 color $color layer $layer
130+
Wish to draw a stroke with points $points width $thickness color $color layer $layer
39131
}
40132
}
41133

42-
set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 \
43-
septagon 7 octagon 8 nonagon 9]
44134
When /someone/ wishes /p/ draws a /shape/ {
45-
# TODO: This is a hack because rest pattern doesn't match empty
46-
# sequence at end.
47135
Wish $p draws a $shape with color white
48136
}
49-
When /someone/ wishes /p/ draws an /shape/ { Wish $p draws a $shape }
137+
138+
# Handle "a" vs "an" grammar variations
139+
When /someone/ wishes /p/ draws an /shape/ {
140+
Wish $p draws a $shape
141+
}
142+
50143
When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ {
51-
lassign [region centroid $r] x y
52-
set width [region width $r]
53-
set height [region height $r]
54-
lassign [dict_getdef $options offset {0 0}] offsetX offsetY
55-
set radius [dict_getdef $options radius 50]
144+
lassign [region centroid $r] cx cy
145+
set angle [region angle $r]
146+
56147
set color [dict_getdef $options color white]
57148
set filled [dict_getdef $options filled false]
58149
set thickness [dict_getdef $options thickness 5]
59150
set layer [dict_getdef $options layer 0]
60-
61-
if {$offsetX != 0} {
62-
set x [expr {$x + $offsetX}]
63-
}
64-
if {$offsetY != 0} {
65-
set y [expr {$y + $offsetY}]
66-
}
67-
68-
set angle [region angle $r]
69-
set p [list $x $y]
70-
151+
152+
set offset [dict_getdef $options offset {0 0}]
153+
set offset [process_offset $offset $r]
154+
155+
set center [vec2 add [list $cx $cy] [vec2 rotate $offset $angle]]
156+
71157
if {$shape eq "circle"} {
72-
Wish to draw a circle with \
73-
center $p radius $radius thickness $thickness \
74-
color $color filled $filled layer $layer
158+
set radius [dict_getdef $options radius 50]
159+
160+
Wish to draw a circle with center $center radius $radius thickness $thickness \
161+
color $color filled $filled layer $layer
162+
163+
} elseif {$shape eq "rect"} {
164+
set w [dict_getdef $options width [region width $r]]
165+
set h [dict_getdef $options height [region height $r]]
166+
167+
Wish to draw a shape with type rect center $center width $w height $h angle $angle \
168+
color $color filled $filled thickness $thickness layer $layer
169+
75170
} elseif {[dict exists $shapes $shape]} {
76-
Wish to draw a shape with sides [dict get $shapes $shape] \
77-
center $p radius $radius radians $angle \
78-
color $color filled $filled layer $layer
171+
set radius [dict_getdef $options radius 50]
172+
173+
Wish to draw a shape with sides [dict get $shapes $shape] center $center radius $radius \
174+
angle $angle color $color filled $filled thickness $thickness layer $layer
175+
79176
} else {
80-
Wish to draw a shape with sides 2 \
81-
center $p radius $radius radians $angle \
82-
color $color filled $filled layer $layer
177+
set radius [dict_getdef $options radius 50]
178+
179+
Wish to draw a shape with sides 4 center $center radius $radius \
180+
angle $angle color $color filled $filled thickness $thickness layer $layer
83181
}
84182
}
183+
184+
# Pass through options for "an" version
85185
When /someone/ wishes /p/ draws an /shape/ with /...options/ {
86186
Wish $p draws a $shape with {*}$options
87187
}
88188

189+
When /someone/ wishes /p/ draws a rect with width /w/ height /h/ {
190+
Wish $p draws a rect with width $w height $h
191+
}
192+
193+
When /someone/ wishes /p/ draws a /shape/ with radius /rad/ {
194+
Wish $p draws a $shape with radius $rad
195+
}
196+
197+
When /someone/ wishes /page/ draws a set of points /points/ with /...options/ & /page/ has region /r/ {
198+
set radius [dict_getdef $options radius 5]
199+
set color [dict_getdef $options color white]
200+
set filled [dict_getdef $options filled true]
201+
set thickness [dict_getdef $options thickness 2]
202+
set layer [dict_getdef $options layer 0]
203+
204+
lassign [region centroid $r] cx cy
205+
set angle [region angle $r]
206+
set center [list $cx $cy]
207+
208+
if {[dict exists $options offset]} {
209+
set offset [dict get $options offset]
210+
set offset [process_offset $offset $r]
211+
set center [vec2 add $center [vec2 rotate $offset $angle]]
212+
}
213+
214+
foreach point $points {
215+
set pointPos [vec2 add $center [vec2 rotate $point $angle]]
216+
217+
Wish to draw a circle with center $pointPos radius $radius thickness $thickness \
218+
color $color filled $filled layer $layer
219+
}
220+
}
221+
222+
When /someone/ wishes /page/ draws a polyline /points/ with /...options/ & /page/ has region /r/ {
223+
set color [dict_getdef $options color white]
224+
set thickness [dict_getdef $options thickness 2]
225+
set layer [dict_getdef $options layer 0]
226+
set dashed [dict_getdef $options dashed false]
227+
set dashlength [dict_getdef $options dashlength 20]
228+
set dashoffset [dict_getdef $options dashoffset 0]
229+
230+
lassign [region centroid $r] cx cy
231+
set angle [region angle $r]
232+
set center [list $cx $cy]
233+
234+
if {[dict exists $options offset]} {
235+
set offset [dict get $options offset]
236+
set offset [process_offset $offset $r]
237+
set center [vec2 add $center [vec2 rotate $offset $angle]]
238+
}
239+
240+
set transformedPoints {}
241+
foreach point $points {
242+
lappend transformedPoints [vec2 add $center [vec2 rotate $point $angle]]
243+
}
244+
245+
if {$dashed} {
246+
Wish to draw a dashed stroke with points $transformedPoints color $color width $thickness \
247+
dashlength $dashlength dashoffset $dashoffset layer $layer
248+
} else {
249+
Wish to draw a stroke with points $transformedPoints color $color width $thickness layer $layer
250+
}
251+
}
252+
89253
Claim $this has demo {
254+
# Center circle
90255
Wish $this draws a circle
91-
Wish $this draws a triangle with color skyblue
92-
Wish $this draws a triangle with color green offset {280 0}
93-
Wish $this draws a pentagon with color gold offset {200 0}
94-
Wish $this draws an octagon with color red offset {250 80}
95-
256+
257+
# Grid of shapes with varying thickness
258+
set baseX -850
259+
set baseY -200
260+
set gridSpacing 130
261+
262+
# Row 1: Regular polygons with different colors and thickness
263+
Wish $this draws a triangle with color skyblue thickness 2 offset [list $baseX [expr {$baseY}]]
264+
Wish $this draws a square with color green thickness 4 offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY}]]
265+
Wish $this draws a pentagon with color gold thickness 6 offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY}]]
266+
Wish $this draws a hexagon with color orange thickness 8 offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY}]]
267+
268+
# Row 2: Filled shapes
269+
Wish $this draws a triangle with color skyblue filled true offset [list $baseX [expr {$baseY + $gridSpacing}]]
270+
Wish $this draws a square with color green filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing}]]
271+
Wish $this draws a pentagon with color gold filled true offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY + $gridSpacing}]]
272+
Wish $this draws a hexagon with color orange filled true offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY + $gridSpacing}]]
273+
274+
# Row 3: Directional offset examples (replacing shift)
275+
Wish $this draws a triangle with radius 40 offset "right 50%"
276+
Wish $this draws a square with radius 40 offset "left 50%"
277+
Wish $this draws a pentagon with radius 40 offset "up 50%"
278+
Wish $this draws a hexagon with radius 40 offset "down 50%"
279+
280+
# Row 4: Rectangles with different properties
281+
Wish $this draws a rect with width 80 height 50 color cyan thickness 3 offset [list $baseX [expr {$baseY + $gridSpacing*3}]]
282+
Wish $this draws a rect with width 80 height 50 color magenta filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing*3}]]
283+
Wish $this draws a rect with width 80 height 50 offset "right 50%"
284+
Wish $this draws a rect with width 80 height 50 offset "left 50%"
285+
286+
# Animated elements
96287
When the clock time is /t/ {
97288
set offsetVector [list [sin $t] [cos $t]]
98289
set offsetVector [::vec2::scale $offsetVector 105]
99290
Wish $this draws a circle with color palegoldenrod offset $offsetVector
100291
}
101-
102-
# This toggles a square between filled and unfilled
292+
103293
When $this has region /r/ & the clock time is /t/ {
104294
lassign [region centroid $r] x y
105295
set fill [expr {round(sin($t) * 2) % 2 == 0}]
106296
set y [- $y 150]
107297
Wish to draw a shape with sides 4 center [list [- $x 100] $y] radius 60 color white filled $fill
108298
}
109-
299+
110300
Wish $this is outlined white
111-
}
301+
}

0 commit comments

Comments
 (0)