\#!/tksipp
#==============================================================================
#                                 tkdemo.tcl
#------------------------------------------------------------------------------
# Demo and test program for Tcl-SIPP Tk programming.
#------------------------------------------------------------------------------

#
# For debugging...allows re-sourcing of the file without restarting tksipp.
#
if {[info proc StatusFlasherKill] != ""} {
    StatusFlasherKill
}
foreach w [winfo children .] {
    destroy $w
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# General variables used by the entire program but not associated with any
# functional module.
#
# Globals;
#   o imageSize - Fixed size of the image to generate.
#   o currentScene - Name of the scene currently displayed.  Used to
#     determine if the photo should be cleared.
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

set imageSize 256
set currentScene {}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#  Scene control and creation.
#
# Module Globals:
#   o sceneSelect - Name of the selected demo scene file.
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

#==============================================================================
# Setup control panel for picking the scene.
#
# Parameters:
#   o w (I) - Path of widget to create.
#------------------------------------------------------------------------------

proc ScenePanelCreate w {
    global sceneSelect

    frame $w -border 5 -relief sunken
    label $w.title -text "Scene"
    pack $w.title

    ScenePanel:Button $w ellipsoid  "Ellipsoid (fast)"
    ScenePanel:Button $w chain      "Chain (fast)"
    ScenePanel:Button $w torus      "Torus (fast)"
    ScenePanel:Button $w structure  "Structure (medium)"
    ScenePanel:Button $w vw         "Volkswagen (mediom)"
    ScenePanel:Button $w isy90      "Teapot (slow)"

    pack $w.ellipsoid $w.chain $w.torus \
         $w.structure $w.vw    $w.isy90

    set sceneSelect ellipsoid
}

proc ScenePanel:Button {frame scene text} {
    radiobutton $frame.$scene -text $text -value $scene \
        -variable sceneSelect -anchor w -width 20
    pack $frame.$scene
}

#==============================================================================
# Define the selected scene.  This clears SIPP of all existing objects,
# lights, etc, then sources the approriate file. The standard demo programs
# are used to define the Tk demo scenes.  The command line parsing and
# rendering library functions are no-op with dummy procs, so only the scene
# setup occurs when they are sourced.
#
# Parameters:
#   o mode (I) - The mode the scene will be rendered in.
#   o imageSize (I) - The size of the image.
#   o sceneNameVar (O) - The name of the scene is returned here (used for
#     file names).
# Globals:
#   o G_size, G_mode (O) - Set because certain demos need them.
#   o currentScene (I/O) -  Name of the scene currently displayed.
# Returns:
#   o SAME if the scene is the same as the previous scene.
#   o DIFF if the scene is different from the previous scene.
#------------------------------------------------------------------------------
proc SceneDefine {mode imageSize sceneNameVar} {
    global sceneSelect currentScene G_mode G_size auto_path
    upvar $sceneNameVar sceneName

    SippReset
    SippBackground {0.1 0.1 0.1}
    SippLineColor  {0.0 0.2 1.0}

    set G_mode $mode
    set G_size $imageSize

    # Find scene definition script, its either in the current directory or the
    # installed master.  When installed, its doesn't have the .tcl extension.

    set scenePath ./$sceneSelect.tcl
    if ![file exists $scenePath] {
        set scenePath [searchpath $auto_path demos/$sceneSelect]
        if [lempty $scenePath] {
            error "Can't locate scene file \"$sceneSelect\""
        }
    }
    source $scenePath

    set sceneName $sceneSelect

    if {$sceneSelect == $currentScene} {
        return SAME
    } else {
        set currentScene $sceneSelect
        return DIFF
    }
}

proc ParseDemoArgs {args} {}    ;# Noop demo library routines.
proc DoRendering {args} {}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# Rendering mode and rendering.
#
# Module Globals:
#   o modeSelect - The selected rendering mode.
#   o modeCurrent - The mode of last rendering.
#   o whenRenderDisable - Windows to disble while rendering.
#   o whenRenderEnable - Windows to enable while rendering.
#   o whenRenderState - List containing state saved when rendering started,
#     used to restore previous state.
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
set modeCurrent {}
set whenRenderDisable {}
set whenRenderEnable {}

#==============================================================================
# Setup control panel for picking the mode.
#
# Parameters:
#   o w (I) - Path of widget to create.
#------------------------------------------------------------------------------
proc ModePanelCreate w {
    global modeSelect

    frame $w -borderwidth 5 -relief sunken
    label $w.title -text "Rendering Mode"
    pack $w.title
    
    ModePanel:Button $w LINE     "Line (fast)"
    ModePanel:Button $w FLAT     "Flat (medium)"
    ModePanel:Button $w GOURAUD  "Gouraud (slow)"
    ModePanel:Button $w PHONG    "Phong (slow)"

    set modeSelect LINE
}

proc ModePanel:Button {frame mode text} {
    radiobutton $frame.m$mode -text $text -value $mode \
        -variable modeSelect -anchor w -width 14
    pack $frame.m$mode -fill x
}

#==============================================================================
# Register a window to be enabled or disabled when rendering.
#
# Parameters:
#   o renderState (I) - "disabled" or "enabled", indicating the state to set
#     the window to.
#   o args - Window names to register.
#------------------------------------------------------------------------------
proc WhenRendering {renderState args} {
    case $renderState {
        disabled {upvar #0 whenRenderDisable stateList}
        enabled  {upvar #0 whenRenderEnable  stateList}
    }
    
    foreach win $args {
        lappend stateList $win
    }
}

#==============================================================================
# Enable or disable windows at the start of rendering and restore them to their
# previous states when done.
#
# Parameters:
#   o state (I) - "run" if rendering is beginning, "done" if its over.
#------------------------------------------------------------------------------
proc WhenRenderingControl {state} {
    global whenRenderDisable whenRenderEnable whenRenderState

    if {$state == "run"} {
        set whenRenderState {}
        foreach win $whenRenderDisable {
            lappend whenRenderState [list $win \
                                          [lindex [$win configure -state] 4]]
            $win configure -state disabled
        }
        foreach win $whenRenderEnable {
            lappend whenRenderState [list $win \
                                          [lindex [$win configure -state] 4]]
            $win configure -state normal
        }
    } else {
        foreach entry $whenRenderState {
            set win   [lindex $entry 0]
            set state [lindex $entry 1]
            $win configure -state $state
        }
    }
}

#==============================================================================
# Do the rendering.
#
# Parameters:
#   o photo (I) - Photo image name to render the image to.
# Globals:
#   o imageSize (I) - Size of image to render.
#------------------------------------------------------------------------------
proc RenderScene {photo} {
    global modeSelect modeCurrent imageSize

    set sceneChange [SceneDefine $modeSelect $imageSize sceneName]

    if {$sceneChange == "SAME"} {
        set clear -noclear
    } else {
        set clear -clear
    }
    set modeCurrent $modeSelect

    LFileClose    
    set fileInfo [StartFileRender $sceneName $modeCurrent]

    lappend handles $photo
    set dispMsg "Rendering"

    if {$fileInfo != {}} {
        lappend handles [lindex $fileInfo 0]
        append dispMsg  " and writing [lindex $fileInfo 1]"
    }
    append dispMsg "..."

    WhenRenderingControl run
    StatusFlash $dispMsg

    SippRender $clear -update 256 $handles $imageSize $imageSize $modeSelect 1

    StatusDisplay "$dispMsg  Done"
    WhenRenderingControl done
    EndFileRender
    LFileAddList [lindex $fileInfo 1]
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# Module for managing saving files.
# 
# Module Globals:
#   o sFileFormatSelect - Selected format "RLE" or "PBM".
#   o sFileStoreSelect - Selected file storage "CREATE", "APPEND", "NOSAVE".
#   o sFileStoreRLESelect - The last selected store mode when under RLE.
#   o sFilePanelWidget - The path for the file panel widget.
#   o sFileHandleCurrent - The currently opened file handle
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

#==============================================================================
# Create the file format panel.
#
# Parameters:
#   o w (I) - Path of widget to create.
#------------------------------------------------------------------------------
proc SFilePanelCreate w {
    global sFileFormatSelect sFileStoreSelect sFileStoreRLESelect
    global sFilePanelWidget

    frame $w -border 5 -relief sunken
    set sFilePanelWidget $w

    label $w.storeTitle -text "Image Save"
    pack $w.storeTitle

    SFilePanel:StoreButton $w CREATE "Create File"
    SFilePanel:StoreButton $w APPEND "Append File"
    SFilePanel:StoreButton $w NOSAVE "Don't Save"

    label $w.formatTitle -text "File Format"
    pack $w.formatTitle

    SFilePanel:FormatButton $w RLE RLE {
        if {$sFileStoreSelect != "NOSAVE"} {
            set sFileStoreSelect $sFileStoreRLESelect 
        }
        $sFilePanelWidget.sAPPEND configure -state normal
    }
    SFilePanel:FormatButton $w PBM PBMPlus {
        set sFileStoreRLESelect $sFileStoreSelect
        if {$sFileStoreSelect == "APPEND"} {
            set sFileStoreSelect CREATE
        }
        $sFilePanelWidget.sAPPEND configure -state disabled
    }

    if [SippInfo RLE] {
        set sFileFormatSelect RLE
        set sFileStoreSelect NOSAVE
        set sFileStoreRLESelect NOSAVE
    } else {
        $w.fRLE configure -state disabled
        set sFileFormatSelect PBM
        set sFileStoreSelect NOSAVE
    }
}

proc SFilePanel:FormatButton {frame format text code} {
    radiobutton $frame.f$format -text $text -value $format \
        -variable sFileFormatSelect -command $code -anchor w -width 10
    pack $frame.f$format -fill x
}

proc SFilePanel:StoreButton {frame store text} {
    radiobutton $frame.s$store -text $text -value $store \
        -variable sFileStoreSelect -anchor w -width 10
    pack $frame.s$store -fill x
}

#==============================================================================
# Called at the beginning of rendering to set up a file for output, if
# specified.
#
# Parameters:
#   o fileBase (I) - The base name of the file to create.
#   o mode (I) - The rendering mode (use for pbm vs. ppm).
# Returns:
#   A list containing handle and file name (less directory), or {} if a file
# is not to be written.
#------------------------------------------------------------------------------
proc StartFileRender {baseName mode} {
    global sFileFormatSelect sFileStoreSelect sFileHandleCurrent

    set sFileHandleCurrent {}
    if {$sFileStoreSelect == "NOSAVE"} {
        return {}
    }

    if {$sFileFormatSelect =="RLE"} {
        if {$sFileStoreSelect == "APPEND"} {set acc "a"} else {set acc "w"}
        set fileName $baseName.rle
        set sFileHandleCurrent [SippRLEOpen ./tkdemo.dir/$fileName $acc]
        SippCommentPut $sFileHandleCurrent image_gamma 0.4
        SippCommentPut $sFileHandleCurrent image_title $baseName
    } else {
        if {$mode == "LINE"} {set ext "pbm"} else {set ext "ppm"}
        set fileName $baseName.$ext
        set sFileHandleCurrent [SippPBMOpen ./tkdemo.dir/$fileName "w"]
    }
    return [list $sFileHandleCurrent $fileName]
}

#==============================================================================
# Called at the end of rendering to close the output file
# specified.
#
#------------------------------------------------------------------------------
proc EndFileRender {} {
    global sFileHandleCurrent

    case $sFileHandleCurrent {
        {rlefile*} {SippRLEClose $sFileHandleCurrent}
        {pbmfile*} {SippPBMClose $sFileHandleCurrent}
    }
    set sFileHandleCurrent {}
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# Module for managing saving files.
# 
# Module Globals:
#   o lFileListWidget - The list widget path.
#   o lFileNameSelect - Select file in the load list window.
#   o lFileLoadWidget - Path of widget to un-disable when files are
#     available for loading.
#   o lFileNextWidget - Path of widget to un-disable when there is another
#     image in the current file.
#   o lFileLoadedHandle - Handle of last loaded file (if open).
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
set lFileNameSelect {}
set lFileLoadedHandle {}

#==============================================================================
# Create the file load selection panel.  Also creates the file save directory
# if it doesn't exist.
#
# Parameters:
#   o w (I) - Path of widget to create.
#   o loadWidget (I) - Path of widget to un-disable when files are
#     available for loading.
#   o nextWidget (I) - Path of widget to un-disable when there is another
#     image in the current file.
#------------------------------------------------------------------------------
proc LFilePanelCreate {w loadWidget nextWidget} {
    global lFileListWidget lFileLoadWidget lFileNextWidget

    set lFileListWidget $w.list
    set lFileLoadWidget $loadWidget
    set lFileNextWidget $nextWidget

    frame $w -border 5 -relief sunken
    label $w.label -text "Loadable RLE Files"

    listbox $w.list -width 15 -height 4 -selectmode  normal
    bind $w.list <B1-ButtonRelease> {LFileSelect %W}

    pack $w.label $w.list

    if {![file isdirectory ./tkdemo.dir]} {
         mkdir ./tkdemo.dir
    }
    foreach fname [lsort [glob -nocomplain tkdemo.dir/*.rle]] {
        $w.list insert end [file tail $fname]
    }
}

#==============================================================================
# Called on button-up to select a file from the load list.
#
# Parameters:
#   o listWidget (I) - List widget path.
#------------------------------------------------------------------------------
proc LFileSelect {listWidget} {
    global lFileNameSelect lFileLoadWidget

    LFileClose
    $lFileLoadWidget configure -state normal
    set lFileNameSelect [selection get]
}

#==============================================================================
# Add a file to the file selection list.  (Currently just rebuilds the list
# from the directory).
#
# Parameters:
#   o fileName (I) - The file name to add.
#------------------------------------------------------------------------------
proc LFileAddList {fileName} {
    global lFileNameSelect lFileLoadWidget lFileListWidget

    if {![string match *.rle $fileName]} return

    $lFileListWidget delete 0 end

    foreach fname [lsort [glob -nocomplain tkdemo.dir/*.rle]] {
        $lFileListWidget insert end [file tail $fname]
    }
    
}

#==============================================================================
# Load the currently selected file to a photo image.
#
# Parameters:
#   o photo (I) - Photo image name.
#   o currentScene (I/O) -  Name of the scene currently displayed.
#------------------------------------------------------------------------------
proc LFileLoad {photo} {
    global lFileNameSelect lFileLoadedHandle lFileNextWidget currentScene

    if {$lFileLoadedHandle != {}} {
        if [string match "rlefile*" $lFileLoadedHandle] {
            SippRLEClose $lFileLoadedHandle
        } else {
            SippPBMClose $lFileLoadedHandle
        }
        set lFileLoadedHandle {}
    }
    set sceneName [file root $lFileNameSelect]
    if {$currentScene == $sceneName} {
        set clear -noclear
    } else {
        set clear -clear
    }
    set currentScene $sceneName  

    set lFileLoadedHandle [SippRLEOpen ./tkdemo.dir/$lFileNameSelect r]

    SippCopy $clear $lFileLoadedHandle $photo

    if [SippRLEInfo $lFileLoadedHandle EOF] {
        SippRLEClose $lFileLoadedHandle
        set lFileLoadedHandle {}
        $lFileNextWidget configure -state disabled
    } else {
        $lFileNextWidget configure -state normal
    }
}

#==============================================================================
# Display the next image from the last file that was loaded. (RLE only)
#
# Parameters:
#   o photo (I) - Photo image name.
#------------------------------------------------------------------------------
proc LFileNext {photo} {
    global lFileLoadedHandle lFileNextWidget

    SippCopy -noclear $lFileLoadedHandle $photo
 
    if [SippRLEInfo $lFileLoadedHandle EOF] {
        LFileClose
    }
}

#==============================================================================
# If a file is currently open for loading, close it.  This is called before
# doing a rendering.
#------------------------------------------------------------------------------
proc LFileClose {} {
    global lFileLoadedHandle lFileNextWidget
    
    if {$lFileLoadedHandle != {}} {
        SippRLEClose $lFileLoadedHandle
        set lFileLoadedHandle {}
        $lFileNextWidget configure -state disabled
    }
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# Status area management.
#
# Module Globals:
#   o statusText - The text to display in the status window.
#   o statusFlash - Controls flashing of the message.  FLASHON if its currently
#     on, FLASHOFF if its off and NOFLASH for constant display.
#   o statusPanelImage - Path to status panel image.
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

#==============================================================================
# Create status area.
#
# Parameters:
#   o w (I) - Path of image to create.
#------------------------------------------------------------------------------
proc StatusPanelCreate w {
    global statusText statusFlash statusPanelImage

    label $w -border 10 -relief sunken
    set statusPanelImage $w

    set statusText {}
    set statusFlash NOFLASH
}

#==============================================================================
# Display a non-flashing string in the status window.
#
# Parameters:
#   o msg (I) - The message to display.
#------------------------------------------------------------------------------
proc StatusDisplay msg {
    global statusText statusFlash statusPanelImage

    set statusText $msg
    set statusFlash NOFLASH
    $statusPanelImage configure -text $msg
}

#==============================================================================
# Display a flashing string in the status window.
#
# Parameters:
#   o msg (I) - The message to display.
#------------------------------------------------------------------------------
proc StatusFlash msg {
    global statusText statusFlash statusPanelImage

    set statusText $msg
    set statusFlash FLASHOFF
    $statusPanelImage configure -text $msg

    StatusFlasher
    update
}

#==============================================================================
# Status flasher killer.  Used when restarting the program to kill the
# status flasher if its running.  This is for debugging purposes.
#------------------------------------------------------------------------------
proc StatusFlasherKill {} {
    global statusText statusFlash statusPanelImage

    if {![info exists statusPanelImage]} return
    if {$statusFlash == "NOFLASH"} return

    set statusText "***KILLED***"
    set statusFlash NOFLASH

    # Wait for the flasher to catch the change and update the image.
    while {[lindex [$statusPanelImage configure -text] 4] != $statusText} {
        update
    }
}

#==============================================================================
# Status flasher.  Flash message in the states window every 1/2 second.  If
# the statusFlash variable is set to NOFLASH, the flasher terminates
#------------------------------------------------------------------------------
proc StatusFlasher {} {
    global statusText statusFlash statusPanelImage
    
    case $statusFlash {
        {NOFLASH} {
            $statusPanelImage configure -text $statusText
        }
        {FLASHON} {
            $statusPanelImage configure -text ""
            set statusFlash FLASHOFF
            after 500 StatusFlasher
        }
        {FLASHOFF} {
            $statusPanelImage configure -text $statusText
            set statusFlash FLASHON
            after 500 StatusFlasher
        }
    }
}

#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# Creating main panels and buttons.
#::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

#==============================================================================
# Create action buttons.
#
# Parameters:
#   o w (I) - Path of image to create.
#   o photo (I) - Photo image name to render the image to.
#------------------------------------------------------------------------------
proc ActionPanelCreate {w photo} {

    frame $w

    button $w.render -text "Render" -command "RenderScene $photo"
    button $w.load   -text "Load File" -command "LFileLoad $photo" \
        -state disabled
    button $w.next   -text "Next Image" -command "LFileNext $photo" \
        -state disabled
    button $w.abort  -text "Abort" -command SippAbortRender -state disabled
    button $w.exit   -text "Exit" -command {destroy .}

    pack $w.render $w.load $w.next $w.abort $w.exit \
        -side left -expand 1 -fill x

    WhenRendering disabled $w.render $w.load $w.next $w.exit
    WhenRendering enabled  $w.abort
}

#==============================================================================
# Construct the control panel.
#
# Parameters:
#   o w (I) - Path of image to create.
#   o photo (I) - Photo image name to render the image to.
#------------------------------------------------------------------------------
proc ControlPanelCreate {w photo} {
    frame $w

    StatusPanelCreate $w.status
    frame $w.top
    frame $w.bottom
    pack $w.status -fill x
    pack $w.top -anchor n
    pack $w.bottom -side bottom
    
    ScenePanelCreate  $w.top.scene
    ModePanelCreate   $w.top.mode
    SFilePanelCreate  $w.top.sFile
    ActionPanelCreate $w.bottom.action $photo
    LFilePanelCreate  $w.top.flist $w.bottom.action.load $w.bottom.action.next

    pack $w.top.scene $w.top.mode $w.top.sFile $w.top.flist \
        -side left -fill y
    pack $w.bottom.action -side bottom -fill x
}

#==============================================================================
# Create the main panel.
#
# Globals;
#   o imageSize (I) - Size of the image to generate.
#------------------------------------------------------------------------------
proc MainPanelCreate {} {
    global imageSize
    
    set photo [image create photo -height ${imageSize} -width ${imageSize}]
    label .photo -image $photo -background [SippColor tox {0 0 0}]

    ControlPanelCreate .control $photo

    pack .photo -side left
    pack .control -side left -fill both
}

if [file exists ../tclsrc/tsipp.tlib] {
    loadlibindex ../tclsrc/tsipp.tlib
}
MainPanelCreate
