[Keith Vetter] 2003-02-07 - a whizzlet demonstrating the bulging line illusion invented by Akiyoshi Kitaoka. ---- #!/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 [list console show] bind .c 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]