[Keith Vetter] 2018-06-04 -- The https://en.wikipedia.org/wiki/Penrose_triangle%|%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: https://en.wikipedia.org/wiki/Ascending_and_Descending%|%Ascending and Descending%|% and https://en.wikipedia.org/wiki/Waterfall_(M._C._Escher)%|%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_image2] ---- [Jeff Smith] 2019-04-21 : Below is an online demo using [CloudTk] <> <> ====== ##+########################################################################## # # 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 {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 ====== <>Graphics