Updated 2016-02-16 10:37:34 by HJG

## Summary edit

if 0 { Richard Suchenwirth 2004-09-12 - In this fun project I tried to emulate the classic kaleidoscope - a tube to look through, where colorful pieces of glass are multiply mirrored, resulting in snowflake-like symmetric patterns. Click on the canvas for a new random pattern.

}

## Code edit

``` package require Tk

proc kaleidoscope w {
\$w delete all
foreach color {red green blue yellow magenta cyan} {
random'triangle \$w \$color
}
foreach item [\$w find withtag ori] {
\$w raise \$item
set item2 [poly'copy \$w \$item 1 -1]
foreach angle {60 120 180 240 300} {
poly'rotate \$w [poly'copy \$w \$item] \$angle
poly'rotate \$w [poly'copy \$w \$item2] \$angle
}
}
}
proc random'triangle {w color} {
set x0 [expr     {rand()*150-75}]
set y0 [expr     {rand()*150-75}]
set x1 [expr {\$x0+rand()*150-75}]
set y1 [expr {\$y0+rand()*150-75}]
set x2 [expr {\$x1+rand()*150-75}]
set y2 [expr {\$y1+rand()*150-75}]
\$w create poly \$x0 \$y0 \$x1 \$y1 \$x2 \$y2 -fill \$color \
-tag ori
}
proc poly'rotate {w item angle} {
set delta [expr {\$angle/180.*acos(-1)}]
foreach {x y} [\$w coords \$item] {
set r [expr {hypot(\$y,\$x)}]
set a [expr {atan2(\$y,\$x)+\$delta}]
lappend coords [expr {cos(\$a)*\$r}] [expr {sin(\$a)*\$r}]
}
\$w coords \$item \$coords
}
proc poly'copy {w item {fx 1} {fy 1}} {
foreach {x y} [\$w coords \$item] {
lappend coords [expr {\$x*\$fx}] [expr {\$y*\$fy}]
}
\$w create poly \$coords -fill [\$w itemcget \$item -fill] \
-stipple [\$w itemcget \$item -stipple]
}

#-- The ''main'' part:
pack [canvas .c -width 200 -height 200 -background white]
.c config -scrollregion {-100 -100 100 100}
kaleidoscope .c
bind .c <1> {kaleidoscope %W}

#-- Development helpers, including how to make screenshots:
bind . <Escape> {exec wish \$argv0 &; exit}
bind . <F1>     {console show}
set n 0
bind . <F2>     {
package req Img; [image create photo -data .c] write kal[incr n].gif
}```

## Program 2 edit

AM (4 may 2008) Just another twist to a kaleidoscope: this is based on angles of 72 degrees ... It was just to amuse myself.
```# kaleidoscope.tcl --
#     Kaleidoscope with a twist: the mirrors are set with an angle of
#     72 degrees and the triangles are copied with an imperfection
#
set angle [expr {2.0*acos(-1.0)/5.0}]

proc generateTriangle {} {
global angle

set coords {}
foreach p {1 2 3} {

while {1} {
set x [expr {200.0*rand()}]
set y [expr {200.0*rand()}]

if { atan2(\$y,\$x) <= \$angle } {
lappend coords \$x \$y
break
}
}
}
return \$coords
}

proc pickColour {} {
return [lindex {red orange yellow cyan magenta blue lightblue green lightgreen} \
[expr {int(rand()*9.0)}]]
}

proc mirrorTriangle {angle coords} {

set cosa [expr {cos(2.0*\$angle)}]
set sina [expr {sin(2.0*\$angle)}]

set coordsn {}
foreach {x y} \$coords {
set xn [expr { \$cosa * \$x + \$sina * \$y}]
set yn [expr { \$sina * \$x - \$cosa * \$y}]
lappend coordsn \$xn \$yn
}
return \$coordsn
}

proc fillCanvas {} {
global angle

.c delete all

set number [expr {int(20*rand())}]

for {set i 0} {\$i <\$number} {incr i} {
set colour [pickColour]
set coords [generateTriangle]

.c create polygon \$coords -fill \$colour -outline black

foreach c {1 2 3 4} stipple {gray75 gray50 gray25 gray12} {
set coords [mirrorTriangle [expr {\$c*\$angle}] \$coords]

.c create polygon \$coords -fill \$colour -outline black \
-stipple \$stipple
}
}

.c scale all 0 0 1 -1
.c move all 200 200

after 250 fillCanvas
}

pack [canvas .c -width 400 -height 400] -fill both

fillCanvas
```