can't find package tcl3dogl
while executing
"package require tcl3dogl"
(in namespace eval "::request" script line 39)
invoked from within
"namespace eval ::request $script"
("::try" body line 12)
OUTPUT BUFFER:
# Copyright: 2005-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
# Filename: tcl3dInfo.tcl
#
# Author: Paul Obermeier
#
# Description: Tcl script to display OpenGL related information.
# When called without arguments, a window is opened with
# buttons to display OpenGL information for the following
# categories:
# - General information (-info)
# - Available OpenGL commands in Tcl (-cmd)
# - Available OpenGL enumerations in Tcl (-enum)
#
# The information texts can also be printed to stdout
# whithout opening a GUI, if calling this Tcl script
# with any of the above listed command line options.
# To display all four categories, the option "-all"
# can be used.
#
# Note: To retrieve all necessary information, an OpenGL
# context has to be established. So the batch mode
# needs a DISPLAY, too.
proc InitPackages { args } {
global gPo
foreach pkg $args {
set retVal [catch {package require $pkg} gPo(ext,$pkg,version)]
set gPo(ext,$pkg,avail) [expr !$retVal]
}
}
package require tcl3dogl
set gVectorTypes(base) [info commands new_*]
InitPackages tcl3d
set gVectorTypes(all) [info commands new_*]
proc bgerror { msg } {
tk_messageBox -icon error -type ok -message "Error: $msg\n\n$::errorInfo"
exit
}
proc GetPackageInfo {} {
global gPo
set msgList {}
foreach name [lsort [array names gPo "ext,*,avail"]] {
set pkg [lindex [split $name ","] 1]
lappend msgList [list $pkg $gPo(ext,$pkg,avail) $gPo(ext,$pkg,version)]
}
return $msgList
}
proc AddMenuCmd { menu label acc cmd args } {
eval {$menu add command -label $label -accelerator $acc -command $cmd} $args
}
proc AddMenuRadio { menu label acc var val cmd args } {
eval {$menu add radiobutton -label $label -accelerator $acc \
-variable $var -value $val -command $cmd} $args
}
proc AddMenuCheck { menu label acc var cmd args } {
eval {$menu add checkbutton -label $label -accelerator $acc \
-variable $var -command $cmd} $args
}
proc ShowMainWin {title} {
global textId
# Create the windows title.
wm title . $title
if { [tcl3dHaveAqua] } {
set btnRelief flat
} else {
set btnRelief solid
}
frame .fr -relief sunken -borderwidth 1
pack .fr -side top -fill both -expand 1
frame .fr.catfr -relief raised -borderwidth 1
frame .fr.resfr -relief raised -borderwidth 1
frame .fr.infofr -relief sunken -borderwidth 1
grid .fr.catfr -row 0 -column 0 -sticky nwe -ipadx 2
grid .fr.resfr -row 0 -column 1 -sticky nwse -ipadx 2
grid .fr.infofr -row 1 -column 0 -sticky nwse -columnspan 2
grid rowconfigure .fr 0 -weight 1
grid columnconfigure .fr 1 -weight 1
# Create menus File and Help
set hMenu .fr.menufr
menu $hMenu -borderwidth 2 -relief sunken
$hMenu add cascade -menu $hMenu.file -label "File" -underline 0
$hMenu add cascade -menu $hMenu.help -label "Help" -underline 0
set fileMenu $hMenu.file
menu $fileMenu -tearoff 0
AddMenuCmd $fileMenu "Save As ..." "Ctrl+S" SaveAs
if { $::tcl_platform(os) ne "Darwin" } {
AddMenuCmd $fileMenu "Quit" "Ctrl+Q" ExitProg
}
bind . SaveAs
bind . ExitProg
wm protocol . WM_DELETE_WINDOW "ExitProg"
set helpMenu $hMenu.help
menu $helpMenu -tearoff 0
AddMenuCmd $helpMenu "About $::appName ..." "" HelpAbout
. configure -menu $hMenu
set textId \
[tcl3dCreateScrolledText .fr.resfr "Result window" \
-bg white -wrap word]
label .fr.infofr.label -textvariable ::gCmdArgs -anchor nw
pack .fr.infofr.label -fill x -in .fr.infofr
set catFr .fr.catfr
set row 0
set curFr $catFr.fr$row
frame $curFr
grid $curFr -row $row -column 0 -sticky news
togl $curFr.togl -width 1 -height 1
pack $curFr.togl
incr row
set curFr $catFr.fr$row
frame $curFr -relief groove
grid $curFr -row $row -column 0 -sticky news
checkbutton $curFr.save -variable ::optInfo \
-text "General Tcl3D information" -anchor w -bg gray
set ::gInitButton $curFr.bPkg
radiobutton $curFr.bPkg -text "Tcl packages" -command PkgInfo \
-anchor w -relief $btnRelief -value $row.0 \
-indicatoron [tcl3dShowIndicator]
radiobutton $curFr.bVers -text "GL versions" -command GLInfo \
-anchor w -relief $btnRelief -value $row.1 \
-indicatoron [tcl3dShowIndicator]
radiobutton $curFr.bExt -text "GL extensions" -command GLExtInfo \
-anchor w -relief $btnRelief -value $row.2 \
-indicatoron [tcl3dShowIndicator]
radiobutton $curFr.bProf -text "Cg profiles" -command CGProfileInfo \
-anchor w -relief $btnRelief -value $row.3 \
-indicatoron [tcl3dShowIndicator]
radiobutton $curFr.bVec -text "Vector types" -command VectorInfo \
-anchor w -relief $btnRelief -value $row.4 \
-indicatoron [tcl3dShowIndicator]
pack $curFr.save -side top -expand 1 -fill both
pack $curFr.bPkg -side top -expand 1 -fill x
pack $curFr.bVers -side top -expand 1 -fill x
pack $curFr.bExt -side top -expand 1 -fill x
pack $curFr.bProf -side top -expand 1 -fill x
pack $curFr.bVec -side top -expand 1 -fill x
incr row
set curFr $catFr.fr$row
frame $curFr -relief groove
grid $curFr -row $row -column 0 -sticky news
checkbutton $curFr.save -variable ::optCmd \
-text "Tcl3D commands" -bg gray -anchor w
pack $curFr.save -side top -expand 1 -fill both
set num 0
radiobutton $curFr.bglCmds -text "GL commands" -command _GLCmdInfo \
-anchor w -relief $btnRelief -value $row.$num \
-indicatoron [tcl3dShowIndicator]
pack $curFr.bglCmds -side top -expand 1 -fill x
incr num
radiobutton $curFr.bgluCmds -text "GLU commands" -command _GLUCmdInfo \
-anchor w -relief $btnRelief -value $row.$num \
-indicatoron [tcl3dShowIndicator]
pack $curFr.bgluCmds -side top -expand 1 -fill x
incr num
radiobutton $curFr.bcgCmds -text "Cg commands" -command _CGCmdInfo \
-anchor w -relief $btnRelief -value $row.$num \
-indicatoron [tcl3dShowIndicator]
pack $curFr.bcgCmds -side top -expand 1 -fill x
incr num
radiobutton $curFr.bsdlCmds -text "SDL commands" -command _SDLCmdInfo \
-anchor w -relief $btnRelief -value $row.$num \
-indicatoron [tcl3dShowIndicator]
pack $curFr.bsdlCmds -side top -expand 1 -fill x
incr num
radiobutton $curFr.bftglCmds -text "FTGL commands" -command _FTGLCmdInfo \
-anchor w -relief $btnRelief -value $row.$num \
-indicatoron [tcl3dShowIndicator]
pack $curFr.bftglCmds -side top -expand 1 -fill x
incr row
set curFr $catFr.fr$row
frame $curFr -relief groove
grid $curFr -row $row -column 0 -sticky news
checkbutton $curFr.save -variable ::optEnum \
-text "Tcl3D enumerations" -anchor w -bg gray
pack $curFr.save -side top -expand 1 -fill both
set num 0
radiobutton $curFr.bglEnums -text "GL enums" -command _GLEnumInfo \
-anchor w -relief $btnRelief -value $row.$num \
-indicatoron [tcl3dShowIndicator]
pack $curFr.bglEnums -side top -expand 1 -fill x
incr num
radiobutton $curFr.bgluEnums -text "GLU enums" -command _GLUEnumInfo \
-anchor w -relief $btnRelief -value $row.$num \
-indicatoron [tcl3dShowIndicator]
pack $curFr.bgluEnums -side top -expand 1 -fill x
incr num
radiobutton $curFr.bcgEnums -text "Cg enums" -command _CGEnumInfo \
-anchor w -relief $btnRelief -value $row.$num \
-indicatoron [tcl3dShowIndicator]
pack $curFr.bcgEnums -side top -expand 1 -fill x
incr num
radiobutton $curFr.bsdlEnums -text "SDL enums" -command _SDLEnumInfo \
-anchor w -relief $btnRelief -value $row.$num \
-indicatoron [tcl3dShowIndicator]
pack $curFr.bsdlEnums -side top -expand 1 -fill x
bind . RemapLabelSize
set ::initDir [pwd]
wm title . $title
}
proc RemapLabelSize {} {
set xsize [winfo width .fr.infofr.label]
.fr.infofr.label configure -wraplength $xsize
}
proc SaveAs {} {
set fileTypes {
{{Text} {.txt}}
{{All files} *}
}
set initFile [format "OS_%s_GL_%s.txt" \
$::tcl_platform(platform) \
[glGetString GL_VERSION]]
set fileName [tk_getSaveFile -filetypes $fileTypes \
-initialfile $initFile -initialdir $::initDir]
if { $fileName != "" } {
set ::initDir [file dirname $fileName]
PrintInfoToFile $fileName $::optInfo $::optCmd $::optEnum $::optState
}
}
proc Cleanup {} {
uplevel #0 unset gPo
uplevel #0 unset gVectorTypes
}
proc ExitProg {} {
exit
}
proc HelpAbout {} {
tk_messageBox \
-title "Tcl3D information viewer." \
-message "tcl3dInfo Version 0.5.0.\nCopyright 2005-2010 Paul Obermeier." \
-type ok -icon info
}
proc drawTitle { tw titleStr } {
global gLastKeys textId
if { ! [info exists gLastKeys($tw)] } {
set gLastKeys($tw) ""
}
tcl3dSetScrolledTitle $textId "$titleStr : <$gLastKeys($tw)>"
}
proc SearchIndexList { tw titleStr textWidget key sym } {
global gLastKeys
if { ! [info exists gLastKeys($tw)] } {
set gLastKeys($tw) ""
}
set lkey [string tolower $key]
if { $sym eq "BackSpace" } {
set gLastKeys($tw) [string range $gLastKeys($tw) 0 end-1]
} else {
if { $sym ne "Return" } {
append gLastKeys($tw) $lkey
}
}
scan [$textWidget index end] %d noLines
set keyLen [string length $gLastKeys($tw)]
drawTitle $tw $titleStr
for { set i 1 } { $i < $noLines } { incr i } {
if { [string compare $gLastKeys($tw) \
[string tolower [$textWidget get $i.0 $i.$keyLen]]] == 0 } {
$textWidget see $i.0
$textWidget mark set insert $i.0
break
}
}
}
proc GetCmdArgs { textWidget x y } {
global gCmdArgs
set ind [$textWidget index @$x,$y]
set line [lindex [split $ind "."] 0]
set cmd [string trim [$textWidget get $line.0 $line.end]]
set ind [lsearch -exact [tcl3dOglGetFuncList] $cmd]
if { $ind >= 0 } {
set vers [lindex [tcl3dOglGetFuncVersionList] $ind]
set sig [lindex [tcl3dOglGetFuncSignatureList] $ind]
set gCmdArgs "$vers: $sig"
} else {
set retVal [catch {eval $cmd} errMsg]
set existStr ""
set helpStr ""
if { $retVal == 0 } {
set existStr "No parameters"
} else {
set startInd [string first $cmd $errMsg]
set endInd [expr [string last "argument" $errMsg] -1]
if { $endInd < 0 } {
set endInd end
}
set helpStr [string trim [string range $errMsg $startInd $endInd] " \""]
}
set gCmdArgs "$existStr $helpStr"
}
}
proc PkgInfo {} {
global textId
$textId configure -state normal
$textId delete 1.0 end
foreach pkgInfo [GetPackageInfo] {
set msgStr "Package [lindex $pkgInfo 0]: [lindex $pkgInfo 2]\n"
if { [lindex $pkgInfo 1] == 1} {
set tag avail
} else {
set tag unavail
}
$textId insert end $msgStr $tag
if { [string compare [lindex $pkgInfo 0] "tcl3d"] == 0 } {
if { [info procs tcl3dGetPackageInfo] ne "" } {
foreach tcl3dInfo [tcl3dGetPackageInfo] {
set libVer [lindex $tcl3dInfo 3]
set msgStr "\tPackage [lindex $tcl3dInfo 0]: [lindex $tcl3dInfo 2]"
if { $libVer ne "" } {
append msgStr " ($libVer)\n"
} else {
append msgStr "\n"
}
if { [lindex $tcl3dInfo 1] == 1} {
set tag avail
} else {
set tag unavail
}
$textId insert end $msgStr $tag
}
}
}
}
$textId tag configure avail -background green
$textId tag configure unavail -background red
$textId configure -state disabled
tcl3dSetScrolledTitle $textId "Tcl packages"
bind $textId <1> {}
}
proc GLInfo {} {
global textId
$textId configure -state normal
$textId delete 1.0 end
foreach glInfo [tcl3dOglGetVersions] {
set msgStr "[lindex $glInfo 0]: [lindex $glInfo 1]\n"
$textId insert end $msgStr avail
}
$textId tag configure avail -background green
$textId configure -state disabled
tcl3dSetScrolledTitle $textId "OpenGL versions"
bind $textId <1> {}
}
proc GLExtInfo {} {
global textId
set tw GLExtInfoWin
$textId configure -state normal
$textId delete 1.0 end
set numExt 0
foreach glInfo [tcl3dOglGetExtensions] {
set msgStr "[lindex $glInfo 0]\n"
$textId insert end $msgStr type
foreach ext [lsort [lindex $glInfo 1]] {
set msgStr "$ext\n"
$textId insert end $msgStr name
}
set numExt [expr $numExt + [llength [lindex $glInfo 1]]]
}
$textId tag configure type -background gray
$textId tag configure name -background green
$textId configure -state disabled
set titleStr "OpenGL Extensions ($numExt extensions)"
drawTitle $tw $titleStr
bind $textId "SearchIndexList $tw [list $titleStr] $textId %A %K"
bind $textId <1> {}
focus $textId
}
proc CGProfileInfo {} {
global textId
$textId configure -state normal
$textId delete 1.0 end
if { [tcl3dHaveCg] } {
foreach { profile avail } [tcl3dCgGetProfileList] {
if { $avail } {
set tag yes
} else {
set tag no
}
set msgStr "$profile\n"
$textId insert end $msgStr $tag
}
}
$textId tag configure yes -background green
$textId tag configure no -background red
$textId configure -state disabled
tcl3dSetScrolledTitle $textId "Cg profiles"
bind $textId <1> {}
}
proc VectorInfo {} {
global textId
global gVectorTypes
set tw VectorInfoWin
$textId configure -state normal
$textId delete 1.0 end
set numBaseTypes [llength $gVectorTypes(base)]
set numAllTypes [llength $gVectorTypes(all)]
set msgStr "Base types with tcl3dVector support: ($numBaseTypes types)\n"
$textId insert end $msgStr header
foreach objCmd [lsort $gVectorTypes(base)] {
scan $objCmd "new_%s" type
$textId insert end "$type \n" name
}
set msgStr "All types with tcl3dVector support: ($numAllTypes types)\n"
$textId insert end $msgStr header
foreach objCmd [lsort $gVectorTypes(all)] {
scan $objCmd "new_%s" type
$textId insert end "$type \n" name
}
$textId tag configure header -background gray
$textId tag configure name -background green
$textId configure -state disabled
set titleStr "Types with tcl3dVector support"
drawTitle $tw $titleStr
bind $textId "SearchIndexList $tw [list $titleStr] $textId %A %K"
bind $textId <1> {}
focus $textId
}
proc _CmdInfo { cmdList title cmdWin } {
global textId
set tw InfoWin_$cmdWin
$textId configure -state normal
$textId delete 1.0 end
set numCmds 0
foreach cmd [lsort $cmdList] {
set tag avail
if { ! [tcl3dOglHaveFunc $cmd] } {
set tag unavail
}
set msgStr "$cmd\n"
$textId insert end $msgStr $tag
incr numCmds
}
$textId tag configure avail -background green
$textId tag configure unavail -background red
$textId configure -state disabled
set titleStr "$title ($numCmds commands)"
drawTitle $tw $titleStr
bind $textId "SearchIndexList $tw [list $titleStr] $textId %A %K"
bind $textId <1> "GetCmdArgs $textId %x %y"
focus $textId
}
proc _EnumInfo { enumList title enumWin } {
global textId
set tw InfoWin_$enumWin
$textId configure -state normal
$textId delete 1.0 end
set numEnums 0
foreach cmd [lsort $enumList] {
set cmdStr [format "::%s" $cmd]
set msgStr "$cmd [set $cmdStr]\n"
$textId insert end $msgStr
incr numEnums
}
$textId configure -state disabled
set titleStr "$title ($numEnums enumerations)"
drawTitle $tw $titleStr
bind $textId "SearchIndexList $tw [list $titleStr] $textId %A %K"
bind $textId <1> {}
focus $textId
}
proc _GLCmdInfo {} {
_CmdInfo $::glCmds "OpenGL core commands" "glCmds"
}
proc _GLUCmdInfo {} {
_CmdInfo $::gluCmds "OpenGL utility commands" "gluCmds"
}
proc _CGCmdInfo {} {
_CmdInfo [info commands cg*] "Cg library commands" "cgCmds"
}
proc _SDLCmdInfo {} {
_CmdInfo [info commands SDL_*] "SDL library commands" "sdlCmds"
}
proc _FTGLCmdInfo {} {
_CmdInfo [info commands FT*] "FTGL library commands" "ftglCmds"
}
proc _GLEnumInfo {} {
_EnumInfo [info globals GL_*] "OpenGL core enums" "glEnum"
}
proc _GLUEnumInfo {} {
_EnumInfo [info globals GLU_*] "OpenGL utility enums" "gluEnum"
}
proc _CGEnumInfo {} {
_EnumInfo [info globals CG_*] "Cg shader enums" "cgEnum"
}
proc _SDLEnumInfo {} {
_EnumInfo [info globals SDL_*] "SDL enums" "sdlEnum"
}
proc CmdPrint { cmdList title fp } {
puts $fp [format "----%s:\n" $title]
set numCmds 0
foreach cmd [lsort $cmdList] {
set msgStr "$cmd"
puts $fp $msgStr
incr numCmds
}
puts $fp [format "Number of %s: %d\n\n" $title $numCmds]
flush $fp
}
proc EnumPrint { enumList title fp } {
puts $fp [format "----%s:\n" $title]
set numEnums 0
foreach cmd [lsort $enumList] {
set cmdStr [format "::%s" $cmd]
set msgStr "$cmd [set $cmdStr]"
puts $fp $msgStr
incr numEnums
}
puts $fp [format "Number of %s: %d\n\n" $title $numEnums]
flush $fp
}
proc PrintInfoToFile { {fileName "glInfo.txt"} {inf 1} {cmd 1} {enum 1} {state 1} } {
set fp [open $fileName "w"]
PrintInfo $fp $inf $cmd $enum $state
close $fp
}
proc PrintInfo { {fp stdout} {inf 1} {cmd 1} {enum 1} {state 1} } {
global gVectorTypes
if { $inf } {
puts $fp "----Package information:\n"
foreach pkgInfo [GetPackageInfo] {
if { [lindex $pkgInfo 1] == 1} {
set msgStr "[lindex $pkgInfo 0]: [lindex $pkgInfo 2]"
puts $fp $msgStr
}
if { [string compare [lindex $pkgInfo 0] "tcl3d"] == 0 } {
if { [info procs tcl3dGetPackageInfo] ne "" } {
foreach tcl3dInfo [tcl3dGetPackageInfo] {
if { [lindex $tcl3dInfo 1] == 1} {
set libVer [lindex $tcl3dInfo 3]
set msgStr "\t[lindex $tcl3dInfo 0]: [lindex $tcl3dInfo 2]"
if { $libVer ne "" } {
append msgStr " ($libVer)"
}
puts $fp $msgStr
}
}
}
}
}
puts $fp "\n"
flush $fp
puts $fp "----OpenGL version information:\n"
foreach glInfo [tcl3dOglGetVersions] {
set msgStr "[lindex $glInfo 0]: [lindex $glInfo 1]"
puts $fp $msgStr
}
puts $fp "\n"
flush $fp
puts $fp "----OpenGL extensions:\n"
set count 0
foreach glInfo [tcl3dOglGetExtensions] {
foreach ext [lsort [lindex $glInfo 1]] {
set msgStr "$ext"
puts $fp $msgStr
}
set count [expr $count + [llength [lindex $glInfo 1]]]
}
puts $fp "Number of OpenGL extensions: $count\n\n"
flush $fp
puts $fp "----Cg profiles:\n"
set count 0
foreach { profile avail } [tcl3dCgGetProfileList] {
if { $avail } {
set msgStr "$profile"
puts $fp $msgStr
incr count
}
}
puts $fp "Number of Cg profiles: $count\n\n"
flush $fp
puts $fp "----Vector types:\n"
foreach objCmd [lsort $gVectorTypes(all)] {
scan $objCmd "new_%s" type
puts $fp "$type : $objCmd"
}
puts $fp "Number of vector types: [llength $gVectorTypes(all)]\n\n"
flush $fp
}
if { $cmd } {
CmdPrint $::glCmds "OpenGL core commands" $fp
CmdPrint $::gluCmds "OpenGL utility commands" $fp
if { $::tcl_platform(platform) == "windows" } {
CmdPrint [info commands wgl*] "OpenGL windows specific commands" $fp
}
CmdPrint [info commands cg*] "Cg library commands" $fp
CmdPrint [info commands SDL_*] "SDL commands" $fp
CmdPrint [info commands FTGL*] "FTGL commands" $fp
}
if { $enum } {
EnumPrint [info globals GL_*] "OpenGL core enums" $fp
EnumPrint [info globals GLU_*] "OpenGL utility enums" $fp
EnumPrint [info globals CG_*] "Cg shader enums" $fp
EnumPrint [info globals SDL_*] "SDL enums" $fp
}
if { $state } {
puts $fp "----OpenGL state variables:\n"
set count 0
foreach glState [tcl3dOglGetStates "asdf"] {
if { [lindex $glState 0] != 0 } {
set msgStr "[lindex $glState 2]: [lrange $glState 3 end]"
puts $fp $msgStr
incr count
}
}
puts $fp "Number of OpenGL state variables: $count\n\n"
flush $fp
}
}
set appName "tcl3dInfo"
set optInfo 0
set optCmd 0
set optEnum 0
set optState 0
set glCmds [tcl3dOglGetFuncList]
set gluCmds [list]
foreach cmd [info commands glu*] {
lappend gluCmds $cmd
}
foreach cmd [info commands glm*] {
lappend gluCmds $cmd
}
if { $argc == 0 } {
# Interactive usage via GUI
ShowMainWin "$appName: Tcl3D Information"
$::gInitButton invoke
}
if { $argc > 0 } {
set i 0
while { $i < $argc } {
set arg [lindex $argv $i]
if { [string compare $arg "-info"] == 0 } {
set optInfo 1
} elseif { [string compare $arg "-cmd"] == 0 } {
set optCmd 1
} elseif { [string compare $arg "-enum"] == 0 } {
set optEnum 1
} elseif { [string compare $arg "-state"] == 0 } {
set optState 1
} elseif { [string compare $arg "-all"] == 0 } {
set optInfo 1
set optCmd 1
set optEnum 1
set optState 1
} else {
puts "Ignoring unknown option: $arg"
}
incr i
}
PrintInfo stdout $optInfo $optCmd $optEnum $optState
exit 0
}