no display name and no $DISPLAY environment variable
    while executing
"load /enadisk/commun/linux/local/ActiveTcl-8.6.11/lib/libtk8.6.so Tk"
    ("package ifneeded Tk 8.6.11" script)
    invoked from within
"package require Tk"
    (in namespace eval "::request" script line 15)
    invoked from within
"namespace eval ::request $script"
    ("::try" body line 12)
OUTPUT BUFFER:
# Copyright:      2006-2010 Paul Obermeier (obermeier@tcl3d.org)
#
#                 See the file "Tcl3D_License.txt" for information on 
#                 usage and redistribution of this file, and for a
#                 DISCLAIMER OF ALL WARRANTIES.
#
# Module:         Tcl3D -> tcl3dSDL
# Filename:       cdplayer.tcl
#
# Author:         Paul Obermeier
#
# Description:    Tcl script implementing a simple CD player to test the
#                 CD related functions (SDL_CD*) of the Tcl3D SDL wrapping.

package require Tk
package require tcl3d 0.3

if { [info procs tcl3dHaveSDL] ne "" } {
    if { ![tcl3dHaveSDL] } {
        tk_messageBox -icon error -type ok -title "Error" \
                      -message "You do not have SDL installed."
        exit
    }
}

proc bgerror { msg } {
    tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
    exit
}

proc poBmp:play {} {
    return {
    #define play_width 16
    #define play_height 16
    static unsigned char play_bits[] = {
       0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0x21, 0x80, 0x61, 0x80, 0xe1, 0x80,
       0xe1, 0x81, 0xe1, 0x83, 0xe1, 0x87, 0xe1, 0x83, 0xe1, 0x81, 0xe1, 0x80,
       0x61, 0x80, 0x21, 0x80, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpPlay [image create bitmap -data [poBmp:play]]

proc poBmp:stop {} {
    return {
    #define stop_width 16
    #define stop_height 16
    static unsigned char stop_bits[] = {
       0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87,
       0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87, 0xe1, 0x87,
       0xe1, 0x87, 0xe1, 0x87, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpStop [image create bitmap -data [poBmp:stop]]

proc poBmp:reverse {} {
    return {
    #define reverse_width 16
    #define reverse_height 16
    static unsigned char reverse_bits[] = {
       0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0x39, 0x90, 0x39, 0x98, 0x39, 0x9c,
       0x39, 0x9e, 0x39, 0x9f, 0xb9, 0x9f, 0x39, 0x9f, 0x39, 0x9e, 0x39, 0x9c,
       0x39, 0x98, 0x39, 0x90, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpReverse [image create bitmap -data [poBmp:reverse]]

proc poBmp:forward {} {
    return {
    #define forward_width 16
    #define forward_height 16
    static unsigned char forward_bits[] = {
       0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0x09, 0x9c, 0x19, 0x9c, 0x39, 0x9c,
       0x79, 0x9c, 0xf9, 0x9c, 0xf9, 0x9d, 0xf9, 0x9c, 0x79, 0x9c, 0x39, 0x9c,
       0x19, 0x9c, 0x09, 0x9c, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpForward [image create bitmap -data [poBmp:forward]]

proc poBmp:pause {} {
    return {
    #define pause_width 16
    #define pause_height 16
    static char pause_bits[] = {
      0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0x61, 0x86, 0x61, 0x86, 0x61, 0x86,
      0x61, 0x86, 0x61, 0x86, 0x61, 0x86, 0x61, 0x86, 0x61, 0x86, 0x61, 0x86,
      0x61, 0x86, 0x61, 0x86, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpPause [image create bitmap -data [poBmp:pause]]

proc poBmp:eject {} {
    return {
    #define eject_width 16
    #define eject_height 16
    static char eject_bits[] = {
      0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0x81, 0x81, 0xc1, 0x83, 0xe1, 0x87,
      0xf1, 0x8f, 0xf9, 0x9f, 0xfd, 0xbf, 0x01, 0x80, 0x01, 0x80, 0xfd, 0xbf,
      0xfd, 0xbf, 0xfd, 0xbf, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpEject [image create bitmap -data [poBmp:eject]]
 
proc poBmp:update {} {
    return {
    #define endless_width 16
    #define endless_height 16
    static char endless_bits[] = {
      0xff, 0xff, 0x01, 0x80, 0x01, 0x80, 0xf1, 0x81, 0x09, 0x82, 0x05, 0x84,
      0x05, 0x84, 0x05, 0x84, 0x05, 0x9f, 0x05, 0x8e, 0x09, 0x84, 0x71, 0x80,
      0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0xff, 0xff};
    }
}
set bmpUpdate [image create bitmap -data [poBmp:update]]

proc max { a b } {
    if { $a >$b } {
        return $a
    } else {
        return $b
    }
}

proc CloseAll {} {
    global gDrives

    set numDrives [SDL_CDNumDrives]
    for { set ind 0 } { $ind < $numDrives } { incr ind } {
        if { [info exists gDrives($ind)] } {
            SDL_CDClose $gDrives($ind)
            unset gDrives($ind)
        }
    }
}

proc StopTimer {} {
    if { [info exists ::afterId] } {
        after cancel $::afterId
    }
}

proc UpdateDriveList {} {
    global gDrives gLists

    StopTimer
    $gLists(drives) delete 0 end
    set numDrives [SDL_CDNumDrives]
    if { $numDrives == 0 } {
        $gLists(drives) insert end "No CD drives found"
        $gLists(drives) configure -state disabled
    } else {
        CloseAll
        for { set ind 0 } { $ind < $numDrives } { incr ind } {
            set gDrives($ind) [SDL_CDOpen $ind]
            set status [SDL_CDStatus $gDrives($ind)]
            if { $status == $::CD_TRAYEMPTY || $status == $::CD_ERROR } {
                set msg [tcl3dSDLGetCdStatusName $status]
                SDL_CDClose $gDrives($ind)
                unset gDrives($ind)
            } else {
                set numTracks [$gDrives($ind) cget -numtracks]
                set msg [format "%d tracks" $numTracks]
            }
            $gLists(drives) insert end [format "%s %s" [SDL_CDName $ind] $msg]
        }
    }
}

proc GetCurInd {} {
    global gDrives

    if { ! [info exists gDrives(cur)] } {
        .fr.controls.status configure -text "No drive selected"
        return -1
    }
    return $gDrives(cur)
}

proc GetCurStatus {} {
    global gDrives

    set ind [GetCurInd]
    return [SDL_CDStatus $gDrives($ind)]
}

proc UpdateTrackList { w } {
    global gDrives gTracks gLists

    StopCurrent

    set indList [$w curselection]
    if { [llength $indList] == 0 } {
        return
    }
    set ind [lindex $indList 0]

    $gLists(tracks) delete 0 end

    if { ! [info exists gDrives($ind)] } {
        return
    }
    set gDrives(cur) $ind

    set numTracks [$gDrives($ind) cget -numtracks]
    if { $numTracks > 0 } {
        set trackArray [$gDrives($ind) cget -track]
        for { set i 0 } { $i < $numTracks } { incr i } {
            set curTrack [Track_ind $trackArray $i]
            set id   [$curTrack cget -id]
            set type [$curTrack cget -type]
            set len  [$curTrack cget -length]
            set off  [$curTrack cget -offset]
            set msf  [tcl3dSDLFrames2MSF $len]
            $gLists(tracks) insert end [format "%02d: %s %02d:%02d" \
                [expr $i +1] [tcl3dSDLGetTrackTypeName $type] \
                [lindex $msf 0] [lindex $msf 1]]
            set gTracks($i,len) $len
        }
        SetCurTrack $gLists(tracks) 0
        StopTimer
        UpdateStatus
    }
}

proc SetCurTrack { w ind } {
    $w selection set $ind
    GetCurTrack $w
}

proc GetCurTrack { w } {
    global gTracks

    set indList [$w curselection]
    if { [llength $indList] == 0 } {
        return
    }
    set ind [lindex $indList 0]
    set gTracks(cur) $ind
}

proc UpdateStatus {} {
    global gDrives gTracks gLists

    set ind [GetCurInd]
    set status [GetCurStatus]
    if { ! [info exists ::lastStatus] } {
        set ::lastStatus $status
    }
    set gTracks(curFrame) [$gDrives($ind) cget -cur_frame]
    set msf [tcl3dSDLFrames2MSF $gTracks(curFrame)]
    .fr.controls.status configure -text \
        [format "%02d:%02d %s" [lindex $msf 0] [lindex $msf 1] \
                               [tcl3dSDLGetCdStatusName $status]]
    if { $status == $::CD_STOPPED && $::lastStatus == $::CD_PLAYING && \
         !$gTracks(userStopped) } {
        set numTracks [$gDrives($ind) cget -numtracks]
        if { $gTracks(cur) < [expr $numTracks -1] } {
            $gLists(tracks) selection clear $gTracks(cur)
            SetCurTrack $gLists(tracks) [expr $gTracks(cur) +1]
            PlayCurrent
        }
    }
    set ::lastStatus $status
    set ::afterId [after 1000 UpdateStatus]
}

proc TogglePlayPause {} {
    set status [GetCurStatus]
    if { $status == $::CD_STOPPED } {
        PlayCurrent
    } elseif { $status == $::CD_PLAYING } {
        PauseCurrent
    } elseif { $status == $::CD_PAUSED } {
        ResumeCurrent
    }
}

proc PlayNewTrack { w } {
    global gDrives

    StopCurrent
    GetCurTrack $w
    PlayCurrent
}

proc PlayCurrent {} {
    set ind [GetCurInd]
    Play $ind
}

proc Play { ind } {
    global gTracks gDrives

    if { [info exists gDrives($ind)] } {
        .fr.scale.slider configure -from 0 -to $gTracks($gTracks(cur),len)
        set retVal [SDL_CDPlayTracks $gDrives($ind) $gTracks(cur) $gTracks(curFrame) 1 0]
        if { $retVal == 0 } {
            .fr.controls.play configure -image $::bmpPause
            tcl3dToolhelpAddBinding .fr.controls.play "Pause"
        } else {
            .fr.controls.play configure -image $::bmpPlay
            tcl3dToolhelpAddBinding .fr.controls.play "Play"
        }
        set gTracks(userStopped) 0
    }
}

proc ResumeCurrent {} {
    set ind [GetCurInd]
    Resume $ind
}

proc Resume { ind } {
    global gDrives gTracks

    if { [info exists gDrives($ind)] } {
        set retVal [SDL_CDResume $gDrives($ind)]
        if { $retVal == 0 } {
            .fr.controls.play configure -image $::bmpPlay
            tcl3dToolhelpAddBinding .fr.controls.play "Play"
        } else {
            .fr.controls.play configure -image $::bmpPause
            tcl3dToolhelpAddBinding .fr.controls.play "Pause"
            set errMsg [SDL_GetError]
            error "Error from SDL: $errMsg"
        }
    }
}

proc PauseCurrent {} {
    set ind [GetCurInd]
    Pause $ind
}

proc Pause { ind } {
    global gDrives gTracks

    if { [info exists gDrives($ind)] } {
        set retVal [SDL_CDPause $gDrives($ind)]
        if { $retVal == 0 } {
            .fr.controls.play configure -image $::bmpPlay
            tcl3dToolhelpAddBinding .fr.controls.play "Play"
        } else {
            .fr.controls.play configure -image $::bmpPause
            tcl3dToolhelpAddBinding .fr.controls.play "Pause"
            set errMsg [SDL_GetError]
            error "Error from SDL: $errMsg"
        }
    }
}

proc StopAll {} {
    set numDrives [SDL_CDNumDrives]
    for { set ind 0 } { $ind < $numDrives } { incr ind } {
        Stop $ind
    }
}

proc StopCurrent {} {
    set ind [GetCurInd]
    Stop $ind
}

proc Stop { ind } {
    global gDrives gTracks

    if { [info exists gDrives($ind)] } {
        set retVal [SDL_CDStop $gDrives($ind)]
        .fr.controls.play configure -image $::bmpPlay
        if { $retVal != 0 } {
            set errMsg [SDL_GetError]
            error "Error from SDL: $errMsg"
        }
        set gTracks(userStopped) 1
        set gTracks(curFrame) 0
    }
}

proc EjectCurrent {} {
    set ind [GetCurInd]
    Eject $ind
}

proc Eject { ind } {
    global gDrives gLists gTracks

    if { [info exists gDrives($ind)] } {
        StopTimer
        StopCurrent
        SDL_CDEject $gDrives($ind)
        SDL_CDClose $gDrives($ind)
        unset gDrives($ind)
        UpdateDriveList
        $gLists(tracks) delete 0 end
        .fr.controls.play configure -image $::bmpPlay
    }
}

proc Shuffle { val } {
    global gTracks

    set gTracks(curFrame) $val
    PlayCurrent
}

proc Cleanup {} {
    StopAll
    CloseAll
    SDL_Quit
}

proc ExitProg {} {
    Cleanup
    exit
}

# Master frame. Needed to integrate demo into Tcl3D Starpack presentation.
frame .fr
pack .fr -expand 1 -fill both
frame .fr.drives
frame .fr.tracks
frame .fr.scale
frame .fr.controls
grid  .fr.drives   -row 0 -column 0 -sticky news
grid  .fr.tracks   -row 1 -column 0 -sticky news
grid  .fr.scale    -row 2 -column 0 -sticky news
grid  .fr.controls -row 3 -column 0 -sticky news
grid rowconfigure    .fr 1 -weight 1
grid columnconfigure .fr 0 -weight 1

set listFont [font create -family fixed -size 10]
set gLists(drives) [tcl3dCreateScrolledListbox .fr.drives "Drive list" \
                    -font $listFont -exportselection false -height 3 -width 50]
bind $gLists(drives) <> "UpdateTrackList %W"

set gLists(tracks) [tcl3dCreateScrolledListbox .fr.tracks "Track list" \
                    -font $listFont -exportselection false]
bind $gLists(tracks) <> "GetCurTrack %W"
bind $gLists(tracks)  "PlayNewTrack %W"

scale .fr.scale.slider -orient horizontal -showvalue false \
      -variable gTracks(curFrame) -command Shuffle
pack  .fr.scale.slider -expand 1 -fill x

button .fr.controls.play   -relief flat -image $bmpPlay   -command TogglePlayPause
button .fr.controls.stop   -relief flat -image $bmpStop   -command StopCurrent
button .fr.controls.update -relief flat -image $bmpUpdate -command UpdateDriveList
button .fr.controls.eject  -relief flat -image $bmpEject  -command EjectCurrent
label  .fr.controls.status -relief flat -text "No drive selected"
pack .fr.controls.play .fr.controls.stop .fr.controls.update .fr.controls.eject \
     -side left
pack .fr.controls.status -padx 10 -side left

tcl3dToolhelpAddBinding .fr.controls.play   "Play"
tcl3dToolhelpAddBinding .fr.controls.stop   "Stop"
tcl3dToolhelpAddBinding .fr.controls.update "Update drive list"
tcl3dToolhelpAddBinding .fr.controls.eject  "Eject"

bind .   ExitProg
wm protocol . WM_DELETE_WINDOW "ExitProg"
wm title . "Tcl3D demo: A simple CD player"

if { [SDL_Init [expr $::SDL_INIT_VIDEO | $::SDL_INIT_CDROM]] < 0 } {
    error [format "Couldn't initialize SDL: %s\n" [SDL_GetError]]
    exit 1
}

set numDrives [SDL_CDNumDrives]
$gLists(drives) configure -height [max 1 $numDrives]
set gTracks(curFrame) 0

UpdateDriveList
$gLists(drives) selection set 0
UpdateTrackList $gLists(drives)