aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

25
Task/Sierpinski-triangle-Graphical/Tcl/sierpinski-triangle-graphical.tcl Normal file
View file

@ -0,0 +1,25 @@
package require Tcl 8.5
package require Tk
proc mean args {expr {[::tcl::mathop::+ {*}$args] / [llength $args]}}
proc sierpinski {canv coords order} {
$canv create poly $coords -fill black -outline {}
set queue [list [list {*}$coords $order]]
while {[llength $queue]} {
lassign [lindex $queue 0] x1 y1 x2 y2 x3 y3 order
set queue [lrange $queue 1 end]
if {[incr order -1] < 0} continue
set x12 [mean $x1 $x2]; set y12 [mean $y1 $y2]
set x23 [mean $x2 $x3]; set y23 [mean $y2 $y3]
set x31 [mean $x3 $x1]; set y31 [mean $y3 $y1]
$canv create poly $x12 $y12 $x23 $y23 $x31 $y31 -fill white -outline {}
update idletasks; # So we can see progress
lappend queue [list $x1 $y1 $x12 $y12 $x31 $y31 $order] \
[list $x12 $y12 $x2 $y2 $x23 $y23 $order] \
[list $x31 $y31 $x23 $y23 $x3 $y3 $order]
}
}
pack [canvas .c -width 400 -height 400 -background white]
update; # So we can see progress
sierpinski .c {200 10 390 390 10 390} 7