mirror of
https://git.dev.opencascade.org/repos/occt.git
synced 2025-04-10 18:51:21 +03:00
ed4415982c
License statement text corrected; compiler warnings caused by Bison 2.41 disabled for MSVC; a few other compiler warnings on 54-bit Windows eliminated by appropriate type cast Wrong license statements corrected in several files. Copyright and license statements added in XSD and GLSL files. Copyright year updated in some files. Obsolete documentation files removed from DrawResources.
292 lines
6.6 KiB
Tcl
292 lines
6.6 KiB
Tcl
# Copyright (c) 1999-2014 OPEN CASCADE SAS
|
|
#
|
|
# This file is part of Open CASCADE Technology software library.
|
|
#
|
|
# This library is free software; you can redistribute it and/or modify it under
|
|
# the terms of the GNU Lesser General Public License version 2.1 as published
|
|
# by the Free Software Foundation, with special exception defined in the file
|
|
# OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
|
|
# distribution for complete text of the license and disclaimer of any warranty.
|
|
#
|
|
# Alternatively, this file may be used under the terms of Open CASCADE
|
|
# commercial license or contractual agreement.
|
|
|
|
#
|
|
# TK features for Draw
|
|
#
|
|
|
|
# reload bindings
|
|
if { [info exists tk_library] } {
|
|
set version [split [info tclversion] "."]
|
|
set major [lindex ${version} 0]
|
|
set minor [lindex ${version} 1]
|
|
if { (${major} > 8) || (${major} >= 8 && ${minor} >= 4) } {
|
|
#source $tk_library/tk.tcl
|
|
} else {
|
|
source $tk_library/tk.tcl
|
|
}
|
|
}
|
|
|
|
wm geometry . +10+10
|
|
|
|
frame .mbar -relief raised -bd 2
|
|
pack .mbar -side top -fill x
|
|
focus .mbar
|
|
|
|
set theMenus("") ""
|
|
set Draw_MenuIndex 0
|
|
|
|
proc addmenuitem {menu options} {
|
|
|
|
global theMenus Draw_MenuIndex
|
|
if {![info exists theMenus($menu)]} {
|
|
incr Draw_MenuIndex
|
|
set m .mbar.m$Draw_MenuIndex.menu
|
|
menubutton .mbar.m$Draw_MenuIndex -text $menu -menu $m
|
|
pack .mbar.m$Draw_MenuIndex -side left
|
|
menu $m
|
|
set theMenus($menu) $m
|
|
} else {set m $theMenus($menu)}
|
|
|
|
eval $m add $options
|
|
}
|
|
|
|
proc addmenu {menu submenu {command ""}} {
|
|
if {$command == ""} {set command $submenu}
|
|
addmenuitem $menu "command -label $submenu -command {$command}"
|
|
}
|
|
|
|
#################################
|
|
# Menus definition
|
|
#################################
|
|
|
|
# the file menu
|
|
|
|
addmenu File datadir vdatadir
|
|
addmenu File restore vrestore
|
|
addmenu File source vsource
|
|
addmenu File exit
|
|
|
|
# the view menu
|
|
|
|
addmenu Views axo {smallview AXON}
|
|
addmenu Views top {smallview +X+Y}
|
|
addmenu Views front {smallview +X+Z}
|
|
addmenu Views left {smallview +Y+Z}
|
|
addmenu Views 2d {smallview -2D-}
|
|
addmenuitem Views "separator"
|
|
addmenu Views mu4
|
|
addmenu Views av2d
|
|
addmenu Views axo
|
|
addmenu Views pers
|
|
|
|
# the display menu
|
|
|
|
addmenu Display fit "fit; repaint"
|
|
addmenu Display 2dfit "2dfit; repaint"
|
|
addmenu Display clear
|
|
addmenu Display 2dclear
|
|
|
|
|
|
#################################
|
|
# Modal dialog box
|
|
# add OK, help, cancel buttons
|
|
#################################
|
|
|
|
proc modaldialog {box okproc {helpproc ""} {cancelproc ""}} {
|
|
wm geometry $box +10+60
|
|
|
|
button $box.ok -text ok -command "$okproc ; destroy $box"
|
|
pack $box.ok -side left
|
|
button $box.ko -text Cancel -command "$cancelproc ; destroy $box"
|
|
pack $box.ko -side right
|
|
if {$helpproc != ""} {
|
|
button $box.help -text Help -command $helpproc
|
|
pack $box.help -side right
|
|
}
|
|
grab set $box
|
|
}
|
|
|
|
##############################
|
|
#
|
|
# dialbox command arg1 val1 arg2 val2 ...
|
|
#
|
|
##############################
|
|
|
|
proc dialbox args {
|
|
|
|
set com [lindex $args 0]
|
|
|
|
toplevel .d
|
|
wm title .d $com
|
|
|
|
# com will be the command
|
|
set com "eval $com"
|
|
|
|
# create entries for the arguments
|
|
set n [llength $args]
|
|
|
|
for {set i 1} {$i < $n} {incr i 2} {
|
|
|
|
frame .d.a$i
|
|
label .d.a$i.l -text [lindex $args $i]
|
|
entry .d.a$i.e -relief sunken
|
|
.d.a$i.e insert end [lindex $args [expr $i+1]]
|
|
pack .d.a$i.l -side left
|
|
pack .d.a$i.e -side right
|
|
pack .d.a$i -side top -fill x
|
|
|
|
append com { [} ".d.a$i.e get" {]}
|
|
}
|
|
append com ";repaint"
|
|
|
|
modaldialog .d $com "help [lindex $args 0]"
|
|
}
|
|
|
|
|
|
####################################
|
|
# Modal get file
|
|
# select a file and launch a command
|
|
# - file is the original value
|
|
# - okproc is the OK procedure,
|
|
# it will be called with the filename
|
|
# - title is the box title
|
|
# - filter is called on each subfile
|
|
# - Buttons are added in the dialbox, if none it is created
|
|
####################################
|
|
|
|
proc retyes {file} {return 1}
|
|
|
|
proc getfile {file okproc title {filter "retyes"} {box ""}} {
|
|
|
|
if {$box == ""} {
|
|
set box ".s"
|
|
toplevel .s
|
|
}
|
|
wm title $box $title
|
|
|
|
# The text entry at the top
|
|
frame $box.d
|
|
entry $box.d.e -relief sunken -width 40
|
|
$box.d.e insert end $file
|
|
button $box.d.s -text scan -command "filescan $filter $box"
|
|
pack $box.d.e -side left
|
|
pack $box.d.s -side right
|
|
pack $box.d -side top
|
|
|
|
# The list box with the files
|
|
frame $box.f
|
|
listbox $box.f.l -relief sunken -yscrollcommand "$box.f.s set"
|
|
scrollbar $box.f.s -relief sunken -command "$box.f.l yview"
|
|
pack $box.f.l $box.f.s -side left -fill y
|
|
pack $box.f -side top
|
|
|
|
filescan $filter $box
|
|
|
|
bind $box.f.l <Double-Button-1> "fileclick $box $filter $okproc"
|
|
|
|
modaldialog $box [concat $okproc " \[" $box.d.e "get\]"]
|
|
}
|
|
|
|
# when double click
|
|
proc fileclick {box filter okproc} {
|
|
filescan $filter $box [selection get]
|
|
set f [$box.d.e get]
|
|
if {! [file isdirectory $f]} {
|
|
destroy $box
|
|
$okproc $f
|
|
}
|
|
}
|
|
|
|
proc filescan {filter box {subfile ""}} {
|
|
|
|
set s [$box.d.e get]
|
|
if {$s == "."} {set s [pwd]/}
|
|
|
|
$box.d.e delete 0 end
|
|
if {$subfile != ""} {
|
|
if {$subfile == ".."} {
|
|
set s [file dirname [file dirname $s]]/
|
|
} else {
|
|
set s [file dirname $s]/$subfile
|
|
}
|
|
}
|
|
$box.d.e insert end $s
|
|
|
|
# list directories
|
|
$box.f.l delete 0 end
|
|
$box.f.l insert end ".."
|
|
if [file isdirectory $s] {
|
|
set d $s
|
|
if {![string match */ $s]} {append s "/"}
|
|
} else {
|
|
set d [file dirname $s]
|
|
}
|
|
foreach f [glob -nocomplain $d/*] {
|
|
if [$filter $f] {
|
|
set x [file tail $f]
|
|
if [file isdirectory $f] {append x "/"}
|
|
$box.f.l insert end $x
|
|
}
|
|
}
|
|
}
|
|
|
|
|
|
#################################
|
|
# File menu procedures
|
|
#################################
|
|
|
|
#
|
|
# dialog box for datadir
|
|
#
|
|
|
|
proc isdir {f} {return [file isdirectory $f]}
|
|
|
|
proc sdatadir {d} {
|
|
global Draw_DataDir
|
|
set Draw_DataDir $d
|
|
}
|
|
|
|
proc vdatadir {} {
|
|
global Draw_DataDir
|
|
toplevel .s
|
|
frame .s.t
|
|
button .s.t.d -text data -command {
|
|
.s.d.e delete 0 end
|
|
.s.d.e insert end $env(WBCONTAINER)/data/
|
|
filescan isdir .s
|
|
}
|
|
pack .s.t.d -side left
|
|
pack .s.t -side top
|
|
getfile $Draw_DataDir sdatadir "Data Directory" isdir .s
|
|
}
|
|
|
|
proc notild {f} {return [expr ! [string match *~ $f]]}
|
|
|
|
proc rresto {f} {
|
|
if {! [file isdirectory $f]} {
|
|
uplevel \#0 "brestore $f [file tail $f]"
|
|
repaint
|
|
}
|
|
}
|
|
|
|
proc vrestore {} {
|
|
global Draw_DataDir
|
|
getfile $Draw_DataDir rresto "Restore" notild
|
|
}
|
|
|
|
|
|
proc ssour {f} {
|
|
global Draw_Source
|
|
set Draw_Source $f
|
|
if {! [file isdirectory $f]} {
|
|
uplevel \#0 "source $f"
|
|
}
|
|
}
|
|
|
|
set Draw_Source [pwd]
|
|
proc vsource {} {
|
|
global Draw_Source
|
|
getfile $Draw_Source ssour "Source" notild
|
|
}
|