# bytearray.tcl
#
# Tcl3D demo showing the use of the tcl3dByteArray2Vector function,
# introduced in Version 0.3.
# The program texture maps an image generated with Tcl onto a quad.
#
# Author: Paul Obermeier
# Date: 2006-02-01

package require tcl3d

# Font to be used in the Tk listbox.
set g_ListFont {-family {Courier} -size 10}

# Create checkerboard texture
set ::g_TexWidth  256
set ::g_TexHeight 256

# Show errors occuring in the Togl callbacks.
proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

# Print info message into widget at the bottom of the window.
proc PrintInfo { msg } {
    if { [winfo exists .fr.info] } {
        .fr.info configure -text $msg
    }
}

# Print info message into window title.
proc PrintTitle { msg } {
    set titleStr "Tcl3D demo: Creating textures from byte arrays"
    wm title . [format "%s (%s)" $titleStr $msg]
}

# Print info message into widget at the bottom of the window.
proc PrintTimeInfo { num msg } {
    if { [winfo exists .fr.timeinfo] } {
         if { $num > 0 } {
             set msg "Key-$num: $msg" 
         }
        .fr.timeinfo configure -text $msg
    }
}

# Execute one of the texture creation procedures makeTexture$num
# with time measurement.
proc Method { num } {
    if { [package vcompare [package versions tcl3d] "0.2"] <= 0  && \
         $num > 1 } {
        tk_messageBox -icon info -type ok -title "Info" \
                      -message "Method $num needs Tcl3D 0.3 or higher"
        return
    }
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]
    glFlush

    Cleanup true
    set measure [time makeTexture$num]
    PrintTimeInfo $num $measure
    PrintTitle "Test $num"

    glPixelStorei GL_UNPACK_ALIGNMENT 1

    set ::g_TexName [tcl3dVector GLuint 1]
    glGenTextures 1 $::g_TexName
    glBindTexture GL_TEXTURE_2D [$::g_TexName get 0]

    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_S $::GL_REPEAT
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_WRAP_T $::GL_REPEAT
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER $::GL_NEAREST
    glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER $::GL_NEAREST

    glTexImage2D GL_TEXTURE_2D 0 $::GL_RGBA \
                 $::g_TexWidth $::g_TexHeight \
                 0 $::g_TexType GL_UNSIGNED_BYTE $::g_TexImg
    .fr.toglwin postredisplay
}

# Create a gray-scale gradient: Set each pixel value by calling the set method
# of a tcl3dVector.
# Slow, needs Tcl3D >= 0.2.
proc makeTexture1 {} {
    set texSize [expr $::g_TexHeight*$::g_TexWidth * 1]
    set ::g_TexImg [tcl3dVector GLubyte $texSize]
    set ::g_TexType $::GL_LUMINANCE

    set count 0
    for { set i 0 } { $i < $::g_TexHeight } { incr i } {
        for { set j 0 } { $j < $::g_TexWidth } { incr j } { 
            $::g_TexImg set $count $j
            incr count
        }
    }
}

# Create a gray-scale gradient: Generate a binary Tcl string by appending each 
# individual pixel value. 
# Transfer the image data with 1 call to tcl3dVectorFromByteArray.
# Fast, needs Tcl3D >= 0.3.
proc makeTexture2 {} {
    set ::g_TexType $::GL_LUMINANCE

    for { set i 0 } { $i < $::g_TexHeight } { incr i } {
        for { set j 0 } { $j < $::g_TexWidth } { incr j } { 
            append img [binary format c $j]
        }
    }
    set ::g_TexImg [tcl3dVectorFromByteArray GLubyte $img]
}

# Create a gray-scale gradient: Generate a binary Tcl string for only one row.
# Append that string for each row of the image to the image binary string.
# Transfer the image data with 1 call to tcl3dVectorFromByteArray.
# Faster, needs Tcl3D >= 0.3.
proc makeTexture3 {} {
    set ::g_TexType $::GL_LUMINANCE

    for { set j 0 } { $j < $::g_TexWidth } { incr j } { 
        append imgRow [binary format c $j]
    }
    for { set i 0 } { $i < $::g_TexHeight } { incr i } {
        append img $imgRow
    }
    set ::g_TexImg [tcl3dVectorFromByteArray GLubyte $img]
}

# Create a gray-scale gradient: Generate a gradient vector for 1 row
# with the Linspace function.
# Transfer this row data with several calls to function tcl3dVectorCopy
# while incrementing the destination offset.
# Faster, needs Tcl3D >= 0.4.1.
proc makeTexture4 {} {
    set texSize [expr $::g_TexHeight*$::g_TexWidth * 1]
    set ::g_TexImg [tcl3dVector GLubyte $texSize]
    set ::g_TexType $::GL_LUMINANCE

    set imgRow [tcl3dVectorFromLinspace GLubyte 0 255 $::g_TexWidth]

    for { set i 0 } { $i < $::g_TexHeight } { incr i } {
        set off [expr {$i * $::g_TexWidth}]
        tcl3dVectorCopy $imgRow [tcl3dVectorInd $::g_TexImg GLubyte $off] \
                        $::g_TexWidth 1 1
    }
    $imgRow delete
}

# Create a gray-scale gradient: Generate a binary Tcl string for only one row.
# Transfer this row data with several calls to low-level function
# tcl3dByteArray2Vector while incrementing the destination offset.
# Fastest, needs Tcl3D >= 0.3.
proc makeTexture5 {} {
    set texSize [expr $::g_TexHeight*$::g_TexWidth * 1]
    set ::g_TexImg [tcl3dVector GLubyte $texSize]
    set ::g_TexType $::GL_LUMINANCE

    for { set j 0 } { $j < $::g_TexWidth } { incr j } { 
        append imgRow [binary format c $j]
    }
    for { set i 0 } { $i < $::g_TexHeight } { incr i } {
        set off [expr {$i * $::g_TexWidth}]
        tcl3dByteArray2Vector $imgRow $::g_TexImg [string length $imgRow] 0 $off
    }
}

# Create a color gradient with tcl3dVectorFromByteArray.
# Needs Tcl3D >= 0.3.
proc makeTexture6 {} {
    set texSize [expr $::g_TexHeight*$::g_TexWidth * 3]
    set ::g_TexType $::GL_RGB

    set template [binary format ccc 1 0 0]
    for { set j 1 } { $j < $::g_TexWidth } { incr j } { 
        append template [binary format ccc $j 0 0]
    }
    set row $template
    for { set i 0 } { $i < $::g_TexHeight } { incr i } {
        append img $row
        set row [string map [list [binary format c 0] [binary format c $i]] \
                            $template]
    }
    set ::g_TexImg [tcl3dVectorFromByteArray GLubyte $img]
}

# Create a gray-scale gradient: Generate a binary Tcl string for only one row.
# Append that string for each row of the image to the binary string.
# Transfer the image data with 1 call to utility procedure tcl3dVectorFromByteArray,
# then read back the tcl3dVector into a second binary string and compare the two
# binary strings. Print an error message, if they are not equal.
# Needs Tcl3D >= 0.3.
proc makeTexture7 {} {
    set texSize [expr $::g_TexHeight*$::g_TexWidth * 1]
    set ::g_TexType $::GL_LUMINANCE

    for { set j 0 } { $j < $::g_TexWidth } { incr j } { 
        append imgRow [binary format c $j]
    }
    for { set i 0 } { $i < $::g_TexHeight } { incr i } {
        append img $imgRow
    }
    set ::g_TexImg [tcl3dVectorFromByteArray GLubyte $img]

    set readback [tcl3dVectorToByteArray $::g_TexImg $texSize 0 0]
    if { [string compare $img $readback] != 0 } {
        tk_messageBox -icon error -type ok -title "Error" \
                      -message "ByteArray read back differs from original"
    }
}

proc CreateCallback { toglwin } {    
    glClearColor 0.5 0.5 0.5 0.0
    glShadeModel GL_FLAT
    glEnable GL_DEPTH_TEST
}

proc DisplayCallback { toglwin } {
    glClear [expr $::GL_COLOR_BUFFER_BIT | $::GL_DEPTH_BUFFER_BIT]

    # Viewport command is not really needed, but has been inserted for
    # Mac OSX. Presentation framework (Tk) does not send a reshape event,
    # when switching from one demo to another.
    glViewport 0 0 [$toglwin width] [$toglwin height]

    if { [info exists ::g_TexName] } {
        glEnable GL_TEXTURE_2D
        glTexEnvf GL_TEXTURE_ENV GL_TEXTURE_ENV_MODE $::GL_DECAL
        glBindTexture GL_TEXTURE_2D [$::g_TexName get 0]
    }

    glBegin GL_QUADS
        glTexCoord2f 0.0 0.0 ; glVertex3f -1.0 -1.0 0.0
        glTexCoord2f 0.0 1.0 ; glVertex3f -1.0 1.0 0.0
        glTexCoord2f 1.0 1.0 ; glVertex3f 1.0 1.0 0.0
        glTexCoord2f 1.0 0.0 ; glVertex3f 1.0 -1.0 0.0
    glEnd
    glFlush
    glDisable GL_TEXTURE_2D
    $toglwin swapbuffers
}

proc ReshapeCallback { toglwin { w -1 } { h -1 } } {
    set w [$toglwin width]
    set h [$toglwin height]

    glViewport 0 0 $w $h
    glMatrixMode GL_PROJECTION
    glLoadIdentity
    gluPerspective 60.0 [expr double($w)/double($h)] 1.0 30.0
    glMatrixMode GL_MODELVIEW
    glLoadIdentity
    glTranslatef 0.0 0.0 -2.6
}

proc Cleanup { { texOnly false } } {
    if { [info exists ::g_TexName] } {
        glDeleteTextures 1 [$::g_TexName get 0]
        $::g_TexName delete
    }
    if { [info exists ::g_TexImg] } {
        $::g_TexImg delete
    }
    if { ! $texOnly } {
        foreach var [info globals g_*] {
            uplevel #0 unset $var
        }
    }
}

proc ExitProg {} {
    exit
}

frame .fr
pack .fr -expand 1 -fill both
togl .fr.toglwin -width 500 -height 500 \
                 -double true -depth true \
                 -createcommand CreateCallback \
                 -reshapecommand ReshapeCallback \
                 -displaycommand DisplayCallback 
listbox .fr.usage -height 7 -font $g_ListFont
label   .fr.timeinfo -bg white
label   .fr.info
grid .fr.toglwin  -row 0 -column 0 -sticky news
grid .fr.usage    -row 1 -column 0 -sticky news
grid .fr.timeinfo -row 2 -column 0 -sticky news
grid .fr.info     -row 3 -column 0 -sticky news
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 0 -weight 1
PrintTitle "Init"

wm protocol . WM_DELETE_WINDOW "ExitProg"
bind . <Key-Escape> "ExitProg"
bind . <Key-1> "Method 1"
bind . <Key-2> "Method 2"
bind . <Key-3> "Method 3"
bind . <Key-4> "Method 4"
bind . <Key-5> "Method 5"
bind . <Key-6> "Method 6"
bind . <Key-7> "Method 7"

.fr.usage insert end "Key-1:      Gradient with tcl3dVector              (slow)"
.fr.usage insert end "Key-2:      Gradient with tcl3dVectorFromByteArray (slow)"
.fr.usage insert end "Key-3:      Gradient with tcl3dVectorFromByteArray (fast)"
.fr.usage insert end "Key-4:      Gradient with tcl3VectorLinspace       (fast)"
.fr.usage insert end "Key-5:      Gradient with tcl3dVectorFromByteArray (fast)"
.fr.usage insert end "Key-6:      Color gradient with tcl3dVectorFromByteArray"
.fr.usage insert end "Key-7:      Gradient readback with tcl3dVectorToByteArray"
.fr.usage insert end "Key-Escape: Exit"
.fr.usage configure -state disabled

PrintTimeInfo -1 "Press a key to create a texure"
PrintInfo [tcl3dOglGetInfoString]
Method 3
