Version 1 of Bulging Line Illusion

Updated 2004-10-27 16:16:30

Keith Vetter 2003-02-07 - a whizzlet demonstrating the bulging line illusion invented by Akiyoshi Kitaoka.

See also Atlantis Cafe Illusion.


 #!/bin/sh -*- tab-width: 8; -*-
 # The next line is executed by /bin/sh, but not tcl \
 exec wish $0 ${1+"$@"}

 ##+#############################################################
 #
 # bulging.tcl -- whizzlet demonstrating the bulging line illusion
 # by Keith Vetter
 #

 package require Tk

 set G \#848484
 set L \#C4C4C4
 set B \#040404
 set W \#FEFEFE

 set S(m) 30                                     ;# Margin
 set S(r) 10                                     ;# Circle radius
 set S(colors) "GLWB"                            ;# Coloring scheme

 proc DoDisplay {} {
    wm title . "Bulging Line Illusion"
    pack [frame .bottom] -side bottom -fill x
    canvas .c -width 400 -height 400 -bd 2 -relief raised -bg \#C0DEC4
    pack .c -side top -fill both -expand 1

    scale .size -from 5 -to 15 -orient horizontal -showvalue 0 \
        -variable S(r) -label "Circle Size" -command DrawCircles
    radiobutton .c1 -text "GLWB" -variable S(colors) -value "GLWB" \
        -command Colorize
    radiobutton .c2 -text "GLBW" -variable S(colors) -value "GLBW" \
        -command Colorize
    pack .size -side left -in .bottom
    pack .c2 .c1 -side right -in .bottom

    image create photo ::img::blank -width 1 -height 1
    button .about -image ::img::blank -highlightthickness 0 -command About
    place .about -in .bottom -relx 1 -rely 0 -anchor ne

    bind all <Alt-c> [list console show]
    bind .c <Configure> DrawBoard
    update
 }
 proc DrawBoard {} {
    global S
    .c delete c0 c1 c2 c3

    set S(w) [expr {([winfo width .c] - 2*$S(m)) / 9.0}]
    set S(h) [expr {([winfo height .c] - 2*$S(m)) / 9.0}]
    .size config -to [expr {int(($S(w) < $S(h) ? $S(w) : $S(h))/2)}]

    for {set row 0} {$row < 9} {incr row} {
        for {set col 0} {$col < 9} {incr col} {
            set xy [GetXY $row $col]
            .c create rect $xy -tag "c[expr {($row + $col) % 2}]" -outline {}
        }
    }
    DrawCircles
    for {set row 1} {$row < 9} {incr row} {
        foreach {x1 y1} [GetXY $row 1] break
        foreach {x2 y2} [GetXY $row 8] break
        .c create line $x1 $y1 $x2 $y2 -tag {c1 line}
    }
    for {set col 1} {$col < 9} {incr col} {
        foreach {x1 y1} [GetXY 1 $col] break
        foreach {x2 y2} [GetXY 8 $col] break
        .c create line $x1 $y1 $x2 $y2 -tag {c1 line}
    }
    Colorize
 }
 # Colorize -- sets the correct color for every item on the canvas
 proc Colorize {} {
    foreach id {0 1 2 3} {
        set color [set ::[string index $::S(colors) $id]]
        .c itemconfig c$id -fill $color
        catch {.c itemconfig c$id -outline $color}
    }
 }
 proc DrawCircles {args} {
    global S

    if {! [info exists S(w)]} return
    set id1 {3 2 3 2 2 3 2 3 2 3 2 3 3 2 3 2}   ;# Color each gets
    set id2 {2 3 2 3 3 2 3 2 3 2 3 2 2 3 2 3}
    set ids [concat $id1 $id1 $id2 $id2]

    .c delete circle
    for {set row 1} {$row < 9} {incr row} {
        for {set col 1} {$col < 9} {incr col} {
            foreach {x y} [GetXY $row $col] break
            set xy [Box $x $y $S(r)]
            set id [lindex $ids 0] ; set ids [lrange $ids 1 end]
            .c create oval $xy -tag [list c$id circle]
        }
    }
    Colorize
    .c raise line
 }
 proc Box {x y r} {
    return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
 }
 proc GetXY {row col} {
    global S

    set x1 [expr {$S(m) + $col * $S(w)}]
    set y1 [expr {$S(m) + $row * $S(h)}]
    set x2 [expr {$x1 + $S(w)}]
    set y2 [expr {$y1 + $S(h)}]
    return [list $x1 $y1 $x2 $y2]
 }
 proc About {} {
    set msg "Bulging Line Illusion\nby Keith Vetter, February 2003\n\n"
    append msg "A whizzlet for visualizing the Bulging Line Illusion.\n\n"
    append msg "The Bulging Line Illusion was invented by Japanese artist\n"
    append msg "Akiyoshi Kitaoka. So named because for some distributions of\n"
    append msg "colors, e.g. GLWB, the lines appear to bulge. For other\n"
    append msg "distributions they appear to bend inwards.\n\n"
    append msg "(G is gray, L is light gray, B is black and W is white.)\n"
    tk_messageBox -title "About Bulging Line Illusion" -message $msg
 }

 DoDisplay

Category Graphics | Category Application | Category Whizzlet