Updated 2018-06-05 17:56:14 by LarrySmith

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