Random Dot Stereogram

tomk - While cleaning out some old files I found a paper on Random Dot Stereograms (which is the basis for "Magic Eye" pictures). I was always fascinated by these single image stereograms so I decided to write a little Tcl program that generates a single image stereogram. The image below is an example of the image created by the code it should be a 3D image of a stepped pyramid.

TR Wow, such a fascinating output with so little code! Can you, perhaps in a few words, explain the principle? How is this kind of 3D image created? What is the random part in here? Thanks!

tomk - Take a look at this wikipedia page [L1 ] for more information on random dot stereograms and other types of autostereograms. Read the Viewing Techniques section on that page for some tips on how to see the 3D image in the image below.

The human eye (and vision system) can humble even the most optimistic computer designer, and if that isn't bad enough the human eye isn't a very good sensor when compared to a birds eye. Here are some of the bird adaptations that are missing from the human eye.

  1. Birds have 5 cones (color sensors) instead of 3 and thus have much better spectral sensitivity and range.
  2. In many raptors the fovea centralis has far more rods and cones than in humans and it is this which allows these birds their spectacular long distance vision. Humans have about 200,000 receptors per mm2, sparrows however have about 400,000 while a Buzzard has an incredible 1,000,000 receptors per mm2
  3. Many raptors also have more than one fovea which provides them with high resolution areas to each side as well as in front (like humans).
  4. Birds have special oil droplets on the cones which help filter the light, making the cones more sensitive to smaller ranges of colour. As they have five different sorts of oil filters the eyes of birds can often see a far more subtle world than we can.
  5. Sea birds such as the Procellariformes use red oil filters to cut out the blue light scattered up from the sea. This makes it easier for them to discern small objects floating on or near the surface.

Stereogram

# Random Dot Stereogram
package require Tk

canvas .c
pack .c
update

set width [winfo width .]
set height [winfo height .]

# The strip width effects the interocular distance.
set vstrip 40
# initialize picture to size of root window and depth of 0
proc new_pic { } {
    global width height pic xpos ypos
    set pic {}
    set xpos 0
    set ypos 0
    for {set y 0} {$y<$height} {incr y} {
        set row {}
        for {set x 0} {$x<$width} {incr x} {
            lappend row 0
        }
        lappend pic ${row}
    }
}
# set a rectangle in pic to depth
proc rectangle { x0 y0 x1 y1 depth } {
    global pic
    for {set y $y0} {$y<$y1} {incr y} {
        for {set x $x0} {$x<$x1} {incr x} {
            lset pic $y $x $depth
        }
    }
}
# draw a stepped pyramid in pic
proc draw_pyramid { steps depth } {
    global width height
    set offset 50
    set base [expr {$height-2*$offset}]
    set step [expr {$base/($steps*2)}]
    for {set i 1} {$i<=$steps} {incr i} {
        set offset [expr {$offset+$step}]
        set x0 $offset
        set x1 [expr {$width-$offset}]
        set y0 $offset
        set y1 [expr {$height-$offset}]
        #puts "rectangle $x0 $y0 $x1 $y1 [expr {$i*$depth}]"
        rectangle $x0 $y0 $x1 $y1 [expr {$i*$depth}]
    }   
}
# Initialize buffer with a vertical strip of random bits.
# Width of the strip is vstrip.
proc init_buffer { } {
    global width height buffer vstrip
    for {set y 0} {$y<$height} {incr y} {
        set row {}
        for {set x 0} {$x<$vstrip} {incr x} {
            lappend row [expr {round(rand())}]
        }
        lappend buffer ${row}
    }   
}
# Create a random dot stereogram
proc stereogram {  } {
    global width height pic buffer vstrip
    for {set col 0} {$col<$width} {incr col $vstrip} {
        do_one_strip $col
    }
}
# process one vertical strip of the stereogram
proc do_one_strip { offset } {
    global width height pic buffer vstrip
    set buf_y 0
    for {set pic_y 0;set buf_y 0} {$pic_y<$height} {incr pic_y;incr buf_y} {
        for {set pic_x ${offset}; set buf_x [expr {$vstrip+$offset}]} \
            {$pic_x<[expr {$offset+$vstrip}]} \
            {incr pic_x;incr buf_x} \
        {
            set depth [lindex $pic $pic_y $pic_x]
            if { $depth > 0 } {
                lset buffer $buf_y $buf_x [lindex $buffer $buf_y [expr {${buf_x}-${vstrip}+${depth}}]]
            } else {
                lset buffer $buf_y $buf_x [lindex $buffer $buf_y [expr {${buf_x}-${vstrip}}]]
            }
        }
    }
}
# Output the stereogram to the canvas
proc render { buffer } {
    set y 0
    foreach row ${buffer} {
        set x 0
        foreach bit ${row} {
            if { $bit > 0 } {
                .c create rectangle $x $y $x $y -outline white
            } else {
                .c create rectangle $x $y $x $y -outline black
            }
            incr x
        }
        incr y
    }
}
# run the program
new_pic
draw_pyramid 4 3
init_buffer
stereogram
render ${buffer}