Keith Vetter 2018-06-04 -- The
Impossible Triangle
is a shape which appears at first looks possible at each corner but you will begin to notice a paradox when you view the triangle as a whole.
It was popularised by Roger Penrose in the 1950's and became the centerpoint in two M. C. Escher prints:
Ascending and Descending and
Waterfall.
This page lets you draw and play with both the Impossible Triangle and Impossible Square. The code could easily draw even higher dimension impossible figures but the visual effect is not as striking, the object seems merely to be warped or twisted.
Larry Smith We used to call such a thing a "hyperspace mounting bracket". You have to stabilize the warp engines in their cowling, you know. ;)
##+##########################################################################
#
# impossible_triangle.tcl -- Draws the Impossible Triangle and Impossible Square
# see https://en.wikipedia.org/wiki/Penrose_triangle
# by Keith Vetter 2018-05-23
#
package require Tk
set Z(dimensions) 3
set Z(tsize) 30
set Z(esize) 70
set Z(title) "Impossible Triangle"
set Z(angle) 0
set Z(gradient) 1
set Z(color,0) yellow
set Z(color,1) green
set Z(color,2) cyan
set Z(color,3) orange
set S(gradient,darkPercent) 30
set S(bg) dodgerblue
set S(colors) {purple red orange magenta yellow green blue cyan white black random}
proc DoDisplay {} {
global Z S
frame .ctrl
label .title -bg $S(bg) -textvariable Z(title) -font {Times 42 bold}
canvas .c -bd 0 -highlightthickness 0 -width 500 -height 500 -bg $::S(bg)
pack .ctrl -side right -fill y
pack .title .c -side top -fill x
pack config .c -fill both -expand 1
labelframe .ctrl.shape -text "Shape"
radiobutton .ctrl.shape.t -text "Triangle" -variable ::Z(dimensions) -value 3 \
-command {Redim 3}
radiobutton .ctrl.shape.s -text "Square" -variable ::Z(dimensions) -value 4 \
-command {Redim 4}
pack .ctrl.shape -fill x -pady 10
pack .ctrl.shape.t .ctrl.shape.s -side top -fill both
labelframe .ctrl.sizes -text "Sizes"
scale .ctrl.tsize -from 1 -to 200 -variable ::Z(tsize) -orient h \
-showvalue 0 -label "Inner: $::Z(tsize)" \
-command {apply {{value} { .ctrl.tsize config -label "Inner: $value" ; Redraw}}}
scale .ctrl.esize -from 1 -to 200 -variable ::Z(esize) -orient h \
-showvalue 0 -label "Outer: $::Z(esize)" \
-command {apply {{value} { .ctrl.esize config -label "Outer: $value" ; Redraw}}}
pack .ctrl.tsize .ctrl.esize -side top -fill x -in .ctrl.sizes
pack .ctrl.sizes -side top -fill x
labelframe .ctrl.rotate -text "Rotation"
scale .ctrl.rotate.rotate -from -180 -to 180 -command {Redraw rotate} \
-variable ::Z(angle) -orient horizontal -showvalue 0 -relief ridge
pack .ctrl.rotate.rotate -side top
pack .ctrl.rotate -fill x -pady .1i
labelframe .ctrl.colors -text "Colors"
ColorButton .ctrl.color0 ::Z(color,0)
ColorButton .ctrl.color1 ::Z(color,1)
ColorButton .ctrl.color2 ::Z(color,2)
ColorButton .ctrl.color3 ::Z(color,3)
pack .ctrl.color0 .ctrl.color1 .ctrl.color2 .ctrl.color3 -fill x -in .ctrl.colors -padx 5 -pady 5
pack .ctrl.colors -fill x
labelframe .ctrl.grad -text "Shading"
checkbutton .ctrl.grad.cb -text "Shading on" -variable ::Z(gradient) -command Redraw
pack .ctrl.grad -fill x -pady 10
pack .ctrl.grad.cb -side left -fill both
bind .c <Configure> {apply {{W h w} {
set h [expr {$h / 2.0}]
set w [expr {$w / 2.0}]
$W config -scrollregion [list -$w -$h $w $h]
}} %W %h %w}
}
proc GetPoints {dims triangleSize edgeSize} {
global V P POLY
unset -nocomplain POLY
set toRadians [expr {acos(-1) / 180}]
set offset [expr {$dims == 3 ? 0 : -45}]
# Vertices of the polygon
for {set i 0} {$i < $dims} {incr i} {
set angle [expr {$toRadians * ($offset + 360 * $i / $dims)}]
set P($i) [VRescale [list [expr {cos($angle)}] [expr {sin($angle)}]] $triangleSize]
set P($i,p) [VRescale [list [expr {cos($angle)}] [expr {sin($angle)}]] $triangleSize]
}
# Vectors along polygon sides
for {set i 0} {$i < $dims} {incr i} {
set next [expr {($i + 1) % $dims}]
set V($i) [VRescale [VSub $P($i) $P($next)] $edgeSize]
set V([expr {$i+$dims}]) $V($i)
}
# Key points for drawing the shape
for {set i 0} {$i < $dims} {incr i} {
set idxNext [expr {($i + 1) % $dims}]
set idxPrev [expr {($i - 1) % $dims}]
set P($i,a) [VAdd $P($i) $V($i)]
set P($i,b) [VAdd $P($i,a) $V($i)]
set P($i,c) [VSub $P($i,b) $V($idxPrev)]
set P($i,d) [VAdd $P($i,c) $V($idxNext)]
if {$dims == 4} {
set P($i,d) [VAdd $P($i,d) $V($i) -2.5]
}
}
# Vertices for the region to shade
for {set i 0} {$i < $dims} {incr i} {
set idxNext [expr {($i + 1) % $dims}]
set idxPrev [expr {($i - 1) % $dims}]
set br $P($i)
set bl $P($idxPrev,a)
set tl [VAdd $P($idxPrev,c) $V($idxPrev) -1]
set tr $P($i,a)
set P($i,shading) [list $br $bl $tl $tr]
}
for {set i 0} {$i < $dims} {incr i} {
set POLY($i) [GetXY $dims $i,a $i+1,p $i+1,a $i,c $i-1,d $i-1,c $i,a]
}
}
proc GetXY {dims args} {
global P
set xy {}
foreach arg $args {
set n [regexp {^(\d+[+-]\d+)(,.)$} $arg . value letter]
if {$n} {
set arg [expr ($value) % $dims]$letter
}
lappend xy {*}$P($arg)
}
return $xy
}
proc ColorButton {w varName} {
set menu [tk_optionMenu $w $varName {*}$::S(colors)]
for {set i 0} {$i <= [[$w cget -menu] index end]} {incr i} {
[$w cget -menu] entryconfig $i -command Redraw
}
}
proc RotateItem {w tagOrId Ox Oy angle} {
set angle [expr {$angle * atan(1) * 4 / 180.0}] ;# Radians
set cos [expr {cos($angle)}]
set sin [expr {sin($angle)}]
foreach id [$w find withtag $tagOrId] { ;# Do each component separately
set xy {}
foreach {x y} [$w coords $id] {
# rotates vector (Ox,Oy)->(x,y) by angle clockwise
set x [expr {$x - $Ox}] ;# Shift to origin
set y [expr {$y - $Oy}]
set xx [expr {$x * $cos - $y * $sin}] ;# Rotate
set yy [expr {$x * $sin + $y * $cos}]
set xx [expr {$xx + $Ox}] ;# Shift back
set yy [expr {$yy + $Oy}]
lappend xy $xx $yy
}
$w coords $id $xy
}
}
proc GradientSides {} {
# Draws the gradient shading for all the sides
.c itemconfig side -outline {}
for {set who 0} {$who < $::Z(dimensions)} {incr who} {
set last [expr {($who - 1) % $::Z(dimensions)}]
_GradientQuad $::Z(color,$last) {*}$::P($who,shading)
}
}
proc _GradientQuad {clr P0 P1 P2 P3} {
# Draw gradient along quadrilateral with sides P0->P1 AND P3->P2
# with dark color at P0,P1 gradient to $clr at P3,P2
set V0 [VSub $P1 $P0]
set V1 [VSub $P2 $P3]
set len0 [VLength $V0]
set len1 [VLength $V1]
set steps [expr {min($len0, $len1)}]
set gradientRange [expr {100 - $::S(gradient,darkPercent)}]
set lastP $P0
set lastQ $P3
set stepSize 1
for {set idx $stepSize} {$idx <= $steps} {incr idx $stepSize} {
set percent [expr {$idx / double($steps)}]
set gperc [expr {int($::S(gradient,darkPercent) + $gradientRange * $percent)}]
set gcolor [::tk::Darken $clr $gperc]
set p [VAdd $P0 $V0 $percent]
set q [VAdd $P3 $V1 $percent]
set xy [concat $lastP $p $q $lastQ]
.c create poly $xy -fill $gcolor -outline $gcolor -tag grad
set lastP $p
set lastQ $q
}
}
proc NewColor {} {
global Z
.c delete grad
for {set i 0} {$i < $Z(dimensions)} {incr i} {
if {! [info exists ::Z(color,$i)]} {
set Z(color,$i) [lrandom $::S(colors)]
}
if {$Z(color,$i) eq "random"} {
set Z(color,$i) [format "#%06x" [expr {int(rand() * 0xFFFFFF)}]]
}
.c itemconfig p$i -fill $Z(color,$i)
}
if {$Z(gradient)} {
GradientSides
}
}
proc VAdd {v1 v2 {scaling 1}} {
foreach {x1 y1} $v1 {x2 y2} $v2 break
return [VClean [list [expr {$x1 + $scaling*$x2}] [expr {$y1 + $scaling*$y2}]]]
}
proc VSub {v1 v2} { return [VAdd $v1 $v2 -1] }
proc VScale {v scaling} {
lassign $v x y
return [VClean [list [expr {$x * $scaling}] [expr {$y * $scaling}]]]
}
proc VRescale {v scaling} {
lassign $v x y
set len [expr {hypot($x,$y)}]
return [VClean [list [expr {$x * $scaling / $len}] [expr {$y * $scaling / $len}]]]
}
proc VClean {v} {
lassign $v x y
if {abs($x - round($x)) < .001} { set x [expr {round($x)}] }
if {abs($y - round($y)) < .001} { set y [expr {round($y)}] }
return [list $x $y]
}
proc VLength {v} {
lassign $v x y
return [expr {hypot($x,$y)}]
}
proc lrandom {l} {
return [lindex $l [expr {int(rand() * [llength $l])}]]
}
proc Redim {dims} {
global Z
set Z(title) [expr {$dims == 3 ? "Impossible Triangle" : "Impossible Square"}]
wm title . $Z(title)
set Z(dimensions) $dims
set Z(tsize) 30
set Z(esize) 70
set Z(angle) 0
if {$Z(dimensions) == 4} {
set Z(tsize) 110
set Z(esize) 25
set Z(angle) -45
}
Redraw
}
proc Redraw {args} {
DrawIt $::Z(dimensions) $::Z(tsize) $::Z(esize)
if {$::Z(angle) != 0} {
RotateItem .c all 0 0 $::Z(angle)
}
}
proc DrawIt {dims triangleSize edgeSize} {
global POLY Z
GetPoints $Z(dimensions) $triangleSize $edgeSize
.c delete all
for {set i 0} {$i < $dims} {incr i} {
.c create poly $POLY($i) -tag [list side p$i] -outline black
}
NewColor
}
DoDisplay
Redim $Z(dimensions)
return
