Integration of OCCT 6.5.0 from SVN

src/DrawResources/BuildWorkbench.tcl

@@ -0,0 +1,327 @@
+#
+#
+#  procedures pour automatiser la fabrication de gti
+#
+#
+puts " *****  loading  build_list   ***** "
+###############################################################################
+#
+#
+proc build_list { factory ilot workbench  exelist toolkitlist   packagelist } {
+#
+#
+###############################################################################
+# fabrique la liste des executables, toolkits et packages
+# pour un workbench donne
+#
+
+    upvar $exelist      EXECUTABLE_LIST
+    upvar $toolkitlist  TOOLKIT_LIST
+    upvar $packagelist  PACKAGE_LIST
+    wokcd [concat $factory:$ilot:$workbench]
+    wokprofile -d
+    set UD_LIST [ w_info -l ]
+    set PACKAGE_LIST ""
+    set EXECUTABLE_LIST ""
+    set TOOLKIT_LIST ""
+    for { set i 0 } { $i <= [expr [ llength $UD_LIST ] - 1 ]} { incr i } {
+	set p [lindex $UD_LIST $i]
+	set typ [ uinfo -t $p ]
+	if { $typ == "executable" } {
+	    lappend EXECUTABLE_LIST $p
+	} elseif { $typ == "toolkit" } {
+	    lappend TOOLKIT_LIST $p
+	} elseif { $typ == "package" || $typ == "nocdlpack" } {
+	    lappend PACKAGE_LIST $p
+	}
+    }
+}
+puts " *****  loading   extract_from_cdl ***** "
+###############################################################################
+#
+#
+proc extract_from_cdl { factory ilot workbench } {
+#
+#
+###############################################################################
+    build_list $factory $ilot $workbench  TYPE_OF_PACKAGE_LIST(1) TYPE_OF_PACKAGE_LIST(2) TYPE_OF_PACKAGE_LIST(3) 
+    puts " *********** Extraction commencing at "
+    puts "[exec date]"
+    for { set i 0 } { $i <= [expr [ llength $TYPE_OF_PACKAGE_LIST(3) ] - 1 ]} { incr i } {
+	    set PACKAGE [lindex $TYPE_OF_PACKAGE_LIST(3) $i]
+	    wokcd $PACKAGE
+	    set LOCAL_UD [ wokcd ] 
+
+            
+	    set ERROR_FILE [ wokinfo -p admfile:cdlcompile.log $LOCAL_UD ] 
+            set ERROR_DIRECTORY [ file dirname $ERROR_FILE ] 
+	    puts " $ERROR_FILE "
+#
+#  attention : verifier que la directory existe 
+#
+	    if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		set FILE_DESCRIPTOR [ open $ERROR_FILE w ] 
+#
+#   on initialise avec un chaine null le fichier
+#
+		puts $FILE_DESCRIPTOR ""
+#
+#   on redirige les erreurs avec un dispatcheur
+#
+		msgsetcmd dispatch_compile_message $FILE_DESCRIPTOR
+	    }
+	    catch { umake -fe obj.inc } 
+#           puts "umake -fe obj.inc"
+	    if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		close $FILE_DESCRIPTOR
+		msgunsetcmd
+            }
+	
+    }
+    puts " ********** Extraction ending at " 
+    puts " [exec date]"
+    msclear
+}
+puts " *****  loading  force_build_only_obj *****  "
+###############################################################################
+#
+#
+proc force_build_only_obj { factory ilot workbench } {
+#
+#
+###############################################################################
+    build_list $factory $ilot $workbench  TYPE_OF_PACKAGE_LIST(1) TYPE_OF_PACKAGE_LIST(2) TYPE_OF_PACKAGE_LIST(3) 
+    puts " *********   Obj commencing at "
+    puts " [ exec date ] "
+    for { set i 0 } { $i <= [expr [ llength $TYPE_OF_PACKAGE_LIST(3) ] - 1 ]} { incr i } {
+	set p [lindex $TYPE_OF_PACKAGE_LIST(3) $i]
+	wokcd $p
+	set LOCAL_UD [ wokcd ] 
+	set ERROR_FILE [ wokinfo -p stadmfile:objcompile.log $LOCAL_UD ]
+        set ERROR_DIRECTORY [ file dirname $ERROR_FILE ] 
+	puts " $ERROR_FILE "
+#
+#  attention : verifier que la directory existe 
+#
+	if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		set FILE_DESCRIPTOR [ open $ERROR_FILE w ] 
+#
+#   on initialise avec un chaine null le fichier
+#
+		puts $FILE_DESCRIPTOR ""
+#
+#   on redirige les erreurs avec un dispatcheur
+#
+		msgsetcmd dispatch_compile_message $FILE_DESCRIPTOR
+	    } 
+	catch { umake -of obj } 
+#       puts " umake -o obj  $p "
+	if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		close $FILE_DESCRIPTOR
+		msgunsetcmd 
+	}
+
+	
+    }
+    for { set j 1 } { $j <= 2 } { incr j } {
+	for { set i 0 } { $i <= [expr [ llength $TYPE_OF_PACKAGE_LIST($j) ] - 1 ]} { incr i } {
+	    set p [lindex $TYPE_OF_PACKAGE_LIST($j) $i]
+	    wokcd $p
+	    set LOCAL_UD [ wokcd ] 
+	    set ERROR_FILE [ wokinfo -p stadmfile:objcompile.log $LOCAL_UD ]
+            set ERROR_DIRECTORY [ file dirname $ERROR_FILE ] 
+	    puts " $ERROR_FILE "
+#
+#  attention : verifier que la directory existe 
+#
+	    if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		set FILE_DESCRIPTOR [ open $ERROR_FILE w ] 
+#
+#   on initialise avec un chaine null le fichier
+#
+		puts $FILE_DESCRIPTOR ""
+#
+#   on redirige les erreurs avec un dispatcheur
+#
+		msgsetcmd dispatch_compile_message $FILE_DESCRIPTOR
+	    } 
+	    
+	    catch { umake -f  } 
+#           puts " umake $p "
+	    if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		close $FILE_DESCRIPTOR
+		msgunsetcmd 
+	    }
+	}
+    }
+
+    puts " *********   Obj ending at "
+    puts " [ exec date ] " 
+    msclear
+}
+puts " *****  loading  build_only_obj ****** "
+###############################################################################
+#
+#
+proc build_only_obj { factory ilot workbench } {
+#
+#
+###############################################################################
+
+    build_list $factory $ilot $workbench  TYPE_OF_PACKAGE_LIST(1) TYPE_OF_PACKAGE_LIST(2) TYPE_OF_PACKAGE_LIST(3) 
+    puts " *********   Obj commencing at "
+    puts " [ exec date ] "
+    for { set i 0 } { $i <= [expr [ llength $TYPE_OF_PACKAGE_LIST(3) ] - 1 ]} { incr i } {
+	set p [lindex $TYPE_OF_PACKAGE_LIST(3) $i]
+	wokcd $p
+	set LOCAL_UD [ wokcd ] 
+	set ERROR_FILE [ wokinfo -p stadmfile:objcompile.log $LOCAL_UD ]
+        set ERROR_DIRECTORY [ file dirname $ERROR_FILE ] 
+	puts " $ERROR_FILE "
+#
+#  attention : verifier que la directory existe 
+#
+	if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		set FILE_DESCRIPTOR [ open $ERROR_FILE w ] 
+#
+#   on initialise avec un chaine null le fichier
+#
+		puts $FILE_DESCRIPTOR ""
+#
+#   on redirige les erreurs avec un dispatcheur
+#
+		msgsetcmd dispatch_compile_message $FILE_DESCRIPTOR
+	    } 
+	catch { umake -o obj } 
+#       puts " umake -o obj  $p "
+	if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		close $FILE_DESCRIPTOR
+		msgunsetcmd 
+	}
+
+	
+    }
+    for { set j 1 } { $j <= 2 } { incr j } {
+	for { set i 0 } { $i <= [expr [ llength $TYPE_OF_PACKAGE_LIST($j) ] - 1 ]} { incr i } {
+	    set p [lindex $TYPE_OF_PACKAGE_LIST($j) $i]
+	    wokcd $p
+	    set LOCAL_UD [ wokcd ] 
+	    set ERROR_FILE [ wokinfo -p stadmfile:objcompile.log $LOCAL_UD ]
+            set ERROR_DIRECTORY [ file dirname $ERROR_FILE ] 
+	    puts " $ERROR_FILE "
+#
+#  attention : verifier que la directory existe 
+#
+	    if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		set FILE_DESCRIPTOR [ open $ERROR_FILE w ] 
+#
+#   on initialise avec un chaine null le fichier
+#
+		puts $FILE_DESCRIPTOR ""
+#
+#   on redirige les erreurs avec un dispatcheur
+#
+		msgsetcmd dispatch_compile_message $FILE_DESCRIPTOR
+	    } 
+	    
+	    catch { umake  } 
+#           puts " umake $p "
+	    if { [ file isdirectory  $ERROR_DIRECTORY ] } {
+		close $FILE_DESCRIPTOR
+		msgunsetcmd 
+	    }
+	}
+    }
+
+    puts " *********   Obj ending at "
+    puts " [ exec date ] " 
+    msclear
+}
+###############################################################################
+#
+#
+proc dispatch_compile_message { code message file } {
+#
+#
+###############################################################################
+    puts " $message "
+    if { $code == "E" } {
+	    puts $file " $message "
+     } 
+#
+#  E les erreurs
+#       
+#
+#  V verbose 
+#
+#
+#  I les infos
+#
+#
+#  W les warnings
+#
+    
+     
+}
+puts " *****  loading  build_obj_log *****  "
+###############################################################################
+#
+#
+proc build_obj_log { factory ilot workbench } {
+#
+#
+###############################################################################
+    puts " Erreurs dans les compiles obj :"
+    build_list $factory $ilot $workbench  TYPE_OF_PACKAGE_LIST(1) TYPE_OF_PACKAGE_LIST(2) TYPE_OF_PACKAGE_LIST(3) 
+    for { set j 2 } { $j <= 3 } { incr j } {
+	for { set i 0 } { $i <= [expr [ llength $TYPE_OF_PACKAGE_LIST($j) ] - 1 ]} { incr i } {
+	    set p [lindex $TYPE_OF_PACKAGE_LIST($j) $i]
+	    wokcd $p
+	    set LOCAL_UD [ wokcd ] 
+	    set ERROR_FILE [ wokinfo -p stadmfile:objcompile.log $LOCAL_UD ] 
+	    if { [ file exists $ERROR_FILE ] } {
+		set FILE_DESCRIPTOR [ open $ERROR_FILE r ]
+		set ERROR_HAPPENED 0 
+		while { [ gets $FILE_DESCRIPTOR LINE ] >= 0 && $ERROR_HAPPENED == 0  } {
+		    if { [ regexp Error $LINE ] } {
+   		        puts "$LOCAL_UD"
+			set ERROR_HAPPENED 1
+		    }
+		}
+		close $FILE_DESCRIPTOR
+	    }
+        }
+    }
+}
+puts " *****  loading   build_cdl_log ******  "
+###############################################################################
+#
+#
+proc build_cdl_log { factory ilot workbench } {
+#
+#
+###############################################################################
+    puts "Erreurs dans les compiles cdl :"
+    build_list $factory $ilot $workbench  TYPE_OF_PACKAGE_LIST(1) TYPE_OF_PACKAGE_LIST(2) TYPE_OF_PACKAGE_LIST(3) 
+    for { set i 0 } { $i <= [expr [ llength $TYPE_OF_PACKAGE_LIST(3) ] - 1 ]} { incr i } {
+	    set p [lindex $TYPE_OF_PACKAGE_LIST(3) $i]
+	    wokcd $p
+	    set LOCAL_UD [ wokcd ] 
+	    set ERROR_FILE [ wokinfo -p admfile:cdlcompile.log $LOCAL_UD ] 
+	    if { [ file exists $ERROR_FILE ] } {
+		set FILE_DESCRIPTOR [ open $ERROR_FILE r ] 
+		set ERROR_HAPPENED  0
+		while { [ gets $FILE_DESCRIPTOR LINE ] >= 0 && $ERROR_HAPPENED == 0} {
+		    if { [ regexp Error $LINE ] } {
+			puts "$LOCAL_UD "
+			set ERROR_HAPPENED 1 
+		    }
+		}
+		close $FILE_DESCRIPTOR
+	    }
+   }
+}
+
+
+
+

src/DrawResources/CURVES.tcl

@@ -0,0 +1,16 @@
+addmenu Curves "Line"    {
+    dialbox line name l origin {0 0 0} direction {1 0 0}
+}
+addmenu Curves "Circle"  {
+    dialbox circle name c center {0 0 0} normal {0 0 1} xdir {1 0 0} radius 1
+}
+addmenu Curves "Ellipse"  {
+    dialbox ellipse name e center {0 0 0} normal {0 0 1} xdir {1 0 0} radii {1 0.5}
+}
+addmenu Curves "Hyperbola"  {
+    dialbox hyperbola name h center {0 0 0} normal {0 0 1} xdir {1 0 0} radii {1 0.5}
+}
+
+addmenu Curves "Parabola"  {
+    dialbox parabola name b center {0 0 0} normal {0 0 1} xdir {1 0 0} focus 1
+}

src/DrawResources/Consultation.tcl

@@ -0,0 +1,439 @@
+#
+# wish tools to browse tests and results
+#
+package require Tk
+
+####################################################
+# source batch tcl 
+####################################################
+#
+#  sets the following environment variables
+#  
+#  WBCONTAINER
+#  WBROOT
+#  STATION
+#
+source $env(DRAWHOME)/InitEnvironment.tcl
+
+source $env(DRAWHOME)/Tests.tcl
+
+####################################################
+# executable to display images
+####################################################
+
+set imageExec $env(WBROOT)/$env(STATION)/bin/TestImage
+#set imageExec [ wokinfo -p testexec:TestImage ] 
+
+####################################################
+# Colors and title
+####################################################
+
+option add *Background grey
+option add *Foreground black
+wm  title . "Modeling Team Test Browser"
+wm geometry . +460+10
+
+####################################################
+# Les Boutons
+####################################################
+
+frame .top
+
+frame .b
+
+set nextCommand "nextTest"
+proc InteractiveNext {} {
+
+    # process the next button
+    # remove display of image for rapidity
+
+    global nextCommand withImage
+    set oldwith $withImage
+    set withImage 0
+    $nextCommand
+    set withImage $oldwith
+    displayImage
+    focus .
+}
+
+button .b.init  -text "init"          -command init
+button .b.clear -text "clear"         -command clearResult
+button .b.copy  -text "Copy"          -command copyMaster
+button .b.exit  -text "exit"          -command {if $withImage switchImage; exit}
+button .b.view  -text "View"          -command viewTest
+button .b.run   -text "Run"           -command runTest
+button .b.send   -text "Send"         -command sendTest
+button .b.next  -text "Next"          -command InteractiveNext
+button .b.nul   -text "next UL"       -command nextUL
+button .b.nfunc -text "next Function" -command nextFunction
+
+radiobutton .b.withtest -anchor w -relief flat \
+	-text "Test " -variable nextCommand -value "nextTest"
+radiobutton .b.withres  -anchor w -relief flat \
+	-text "With result" -variable nextCommand -value "nextWithResult"
+radiobutton .b.witherr  -anchor w -relief flat \
+	-text "With error" -variable nextCommand -value "nextWithError"
+
+pack    .b.init .b.clear .b.copy  .b.run .b.send .b.view \
+	.b.next .b.withtest .b.withres .b.witherr \
+	.b.nul .b.nfunc .b.exit \
+	-side top -fill x
+
+pack .b -side right -anchor n -in .top
+
+####################################################
+# Les directory test resultat et master
+# les entry
+####################################################
+
+frame  .root
+label  .root.name  -text "Root of tests : " -width 20 -anchor w
+entry  .root.val  -relief sunken -textvariable testRoot -width 40
+pack .root.name .root.val -side left
+
+frame  .res
+label  .res.name    -text "Result directory : " -width 20 -anchor w
+entry  .res.val -relief sunken -textvariable resultRoot -width 40
+pack .res.name .res.val -side left
+
+frame .master
+label .master.name -text "Master directory : " -width 20 -anchor w
+entry .master.val  -relief sunken -textvariable masterRoot -width 40
+pack .master.name .master.val -side left
+
+frame .exec
+label .exec.name -text "Executable : " -width 20 -anchor w
+entry .exec.val  -relief sunken -textvariable theExec -width 40
+pack .exec.name .exec.val -side left
+
+frame .sendto
+label .sendto.name -text "Send to : " -width 20 -anchor w
+entry .sendto.val  -relief sunken -textvariable theDraw -width 40
+pack .sendto.name .sendto.val -side left
+
+# enforce update when return
+bind .root.val <Return> "set theTest $theTest"
+bind .res.val <Return> "set theTest $theTest"
+bind .master.val <Return> "set theTest $theTest"
+bind .exec.val <Return> "set theTest $theTest"
+
+pack .root .res .master .exec .sendto -side top -in .top
+
+####################################################
+# Les list box UL Function Test
+####################################################
+
+listbox .uls -relief sunken -borderwidth 2 \
+	-yscrollcommand ".suls set"
+scrollbar .suls -relief sunken  -command ".uls yview"
+
+listbox .funcs -relief sunken -borderwidth 2 \
+-yscrollcommand ".sfuncs set"
+scrollbar .sfuncs -relief sunken  -command ".funcs yview"
+
+listbox .tests -relief sunken -borderwidth 2 \
+-yscrollcommand ".stests set"
+scrollbar .stests -relief sunken  -command ".tests yview"
+
+bind .uls <Double-Button-1> {
+    set theUL [selection get]
+}
+
+bind .funcs <Double-Button-1> {
+    set theFunction [selection get]
+}
+
+bind .tests <Double-Button-1> {
+    set theTest [selection get]
+}
+
+# procedures de trace des variables listes
+# mettent a jour la list box correspondante
+
+trace variable listUL w  listULProcW
+proc listULProcW {name element op} {
+    global listUL
+    .uls delete 0 [.uls size]
+    foreach f $listUL {.uls insert end $f}
+}
+
+trace variable listFunction w  listFunctionProcW
+proc listFunctionProcW {name element op} {
+    global listFunction
+    .funcs delete 0 [.funcs size]
+    foreach f $listFunction {.funcs insert end $f}
+}
+
+trace variable listTest w  listTestProcW
+proc listTestProcW {name element op} {
+    global listTest
+    .tests delete 0 [.tests size]
+    foreach f $listTest {.tests insert end $f}
+}
+
+#presentation 
+
+pack .uls .suls .funcs .sfuncs .tests .stests -side left -fill both -in .top
+
+####################################################
+# the current UL Function Test, associated buttons
+####################################################
+
+frame .current
+
+label .current.ul   -textvariable theUL
+label .current.func -textvariable theFunction
+label .current.test -textvariable theTest
+
+pack .current.ul .current.func .current.test -side left
+
+####################################################
+# le statut
+####################################################
+
+frame .status
+label .status.h -text "${theStatusHeader} : "
+label .status.s -textvariable theStatusLine -anchor w
+
+# menu des fichiers xwd
+
+set withImage 0
+set hasImage "No Image"
+set nbXWD "0 images  "
+
+label  .status.xwd  -textvariable nbXWD
+button .status.vxwd -text "no Display" -command switchImage
+bind . <d> switchImage
+
+proc switchImage {} {
+    global withImage imageProcess
+    if $withImage {
+	set withImage 0
+	.status.vxwd configure -text "no Display"
+	catch {exec kill $imageProcess}
+	set imageProcess 0
+    } else {
+	set withImage 1
+	.status.vxwd configure -text "Display"
+	displayImage
+    }
+}
+
+trace variable theXWDFiles w theXWDFilesProcW
+
+proc theXWDFilesProcW {name element op} {
+    global nbXWD theXWDFiles
+    set nbXWD "[llength $theXWDFiles] images  "
+    displayImage
+}
+
+set imageProcess 0
+
+proc displayImage {} {
+    global withImage
+    if {! $withImage} return
+    global imageExec imageProcess
+    global theXWDFiles resultRoot masterRoot theUL theFunction 
+    if $imageProcess {catch {exec kill $imageProcess}}
+
+    foreach f [glob -nocomplain /tmp/*.xwd] {catch {exec rm -f $f}}
+    set r {}
+    foreach h $theXWDFiles {
+	set g [file rootname [file tail $h]]
+	set f $resultRoot/$theUL/$theFunction/$g.Z
+	if [file readable $f] {
+	    catch {exec cp $f /tmp/r$g.Z}
+	    catch {exec uncompress /tmp/r$g.Z}
+	    lappend r /tmp/r$g
+	} else {lappend r "XXXX"}
+	set f $masterRoot/$theUL/$theFunction/$g.Z
+	if [file readable $f] {
+	    catch {exec cp $f /tmp/m$g.Z}
+	    catch {exec uncompress /tmp/m$g.Z}
+	    lappend r /tmp/m$g
+	} else {lappend r "XXXX"}
+    }
+    set imageProcess [eval exec $imageExec $r & ]
+}
+
+pack .status.h .status.s -side left
+pack .status.vxwd .status.xwd -side right
+
+####################################################
+# Les resultats et les master
+####################################################
+
+frame .log
+text .log.result -relief raised -bd 2 -width 38 -yscrollcommand ".log.sresult set"
+scrollbar .log.sresult -relief sunken -command ".log.result yview"
+text .log.master -relief raised -bd 2 -width 38 -yscrollcommand ".log.smaster set"
+scrollbar .log.smaster -relief sunken -command ".log.master yview"
+
+# trace the files names
+proc loadFile {file text} {
+    $text delete 1.0 end
+    if {$file == ""} return
+    if [file isdirectory $file] return
+    if [file readable $file] {
+	set f [open $file]
+	while {![eof $f]} {
+	    $text insert end [read $f 1000]
+	}
+	close $f
+    }
+}
+
+trace variable theLog w theLogProc
+proc theLogProc {name element op} {
+    global theLog 
+    loadFile $theLog .log.result
+}
+
+trace variable theErrorLines w theErrorLinesProc
+proc theErrorLinesProc {name element op} {
+    global theErrorLines
+    # tag the errors if there are
+    .log.result tag delete error
+    foreach l $theErrorLines {
+	.log.result tag add error $l.0 $l.end
+	.log.result tag configure error -background orange
+    }
+}
+
+trace variable theDiffs w theDiffsProc
+proc theDiffsProc {name element op} {
+    global theDiffs
+    # tag the differences if there are
+    .log.result tag delete diffs
+    .log.master tag delete diffs
+    if [llength $theDiffs] {
+	foreach l $theDiffs {
+	    .log.result tag add diffs ${l}.0 ${l}.end
+	    .log.master tag add diffs ${l}.0 ${l}.end
+	}
+	.log.result tag configure diffs -background lightblue
+	.log.master tag configure diffs -background lightblue
+    }
+}
+
+trace variable theMasterLog w theMasterLogProc
+proc theMasterLogProc {name element op} {
+    global theMasterLog
+    loadFile $theMasterLog .log.master
+}
+
+pack .log.result .log.sresult .log.master .log.smaster -side left -fill y
+
+####################################################
+# panel to display the test
+####################################################
+
+set hasTestPanel 0
+set withBeginEnd 0
+set beginFunction ""
+set endFunction   ""
+set beginUL       ""
+set endUL         ""
+
+proc viewTest {} {
+    global hasTestPanel 
+    if {! $hasTestPanel} {
+	set hasTestPanel 1
+	toplevel .panel
+	wm geometry .panel +10+610
+
+	frame .panel.b
+	button .panel.b.quit -text Quit \
+		-command {destroy .panel; set hasTestPanel 0}
+	bind .panel <q> {destroy .panel; set hasTestPanel 0}
+
+	button .panel.b.bfunc -textvariable beginFunction \
+		-command {loadFile $testRoot/$theUL/$theFunction/begin .panel.t.text}
+	button .panel.b.efunc -textvariable endFunction \
+		-command {loadFile $testRoot/$theUL/$theFunction/end .panel.t.text}
+	button .panel.b.bul -textvariable beginUL \
+		-command {loadFile $testRoot/$theUL/begin .panel.t.text}
+	button .panel.b.eul -textvariable endUL \
+		-command {loadFile $testRoot/$theUL/end .panel.t.text}
+	button .panel.b.test -textvariable theTest \
+		-command {loadFile $testRoot/$theUL/$theFunction/$theTest .panel.t.text}
+	button .panel.b.next -text Next -command {$nextCommand; focus .panel}
+	bind .panel <n> {$nextCommand}
+
+	button .panel.b.concat -text "Concat " -command {
+	    if { $withBeginEnd} { 
+		set withBeginEnd 0
+	    } else { 
+		set withBeginEnd 1
+	    } 
+	    displayTest
+	}
+	button .panel.b.send   -text "Send"         -command sendTest
+
+	pack .panel.b.quit .panel.b.next .panel.b.concat .panel.b.send \
+		-side top -fill x 
+	pack .panel.b.eul .panel.b.efunc .panel.b.test .panel.b.bfunc \
+		.panel.b.bul \
+		-side bottom -fill x 
+
+	frame .panel.t
+	text .panel.t.text -relief raised -width 65 -bd 2 \
+		-yscrollcommand ".panel.t.scroll set"
+	scrollbar .panel.t.scroll -relief sunken -command ".panel.t.text yview"
+	pack .panel.t.text .panel.t.scroll -side left -fill both
+
+	pack .panel.t .panel.b -side left -fill both
+
+    } else {
+	destroy .panel
+	set hasTestPanel 0	
+    }
+    displayTest
+}
+
+proc displayTest {} {
+    global hasTestPanel
+    global withBeginEnd
+    if {! $hasTestPanel} return
+    global testRoot theUL theFunction theTest
+    global beginFunction endFunction beginUL endUL
+    if { ! $withBeginEnd} {
+	loadFile $testRoot/$theUL/$theFunction/$theTest .panel.t.text
+    } else {
+	global testRoot resultRoot theExec theLog theDraw
+	global theUL theFunction theTest
+	set f /tmp/theTest[pid]
+	set ff [open $f w]
+	puts $ff "set testroot $testRoot"
+	puts $ff "set testinfos(resultRoot)  $resultRoot"
+	puts $ff "set testinfos(theUL)       $theUL"
+	puts $ff "set testinfos(theFunction) $theFunction"
+	puts $ff "set testinfos(theTest)     $theTest"
+	close $ff
+	catch {exec cat -s \
+		$testRoot/$theUL/begin \
+		$testRoot/$theUL/$theFunction/begin \
+		$testRoot/$theUL/$theFunction/$theTest \
+		$testRoot/$theUL/$theFunction/end \
+		$testRoot/$theUL/end  >> $f}
+	loadFile $f .panel.t.text
+    }
+    set beginFunction "$theFunction begin"
+    set endFunction   "$theFunction end"
+    set beginUL "$theUL begin"
+    set endUL   "$theUL end"
+    wm title .panel "$theUL $theFunction $theTest"
+}
+
+trace variable theTest w theTestProcW
+proc theTestProcW {name element op} {
+    displayTest
+}
+
+####################################################
+# presentation generale
+####################################################
+
+pack .top .current .status .log -side top -fill x
+
+init

src/DrawResources/DIFF.c

@@ -0,0 +1,44 @@
+
+
+
+
+#include <stdio.h>
+
+int main(int argc, char **argv) { 
+  if(argc!=3) { 
+    fprintf(stderr,"\n DIFF File1 File2 \n");
+    return(-1);
+  }
+  FILE *fp1 = fopen(argv[1],"r");
+  if(fp1 == NULL) { 
+    fprintf(stderr,"\n Unable to open file1:%s \n",argv[1]);
+    return(-2);
+  }
+  FILE *fp2 = fopen(argv[2],"r");
+  if(fp2 == NULL) { 
+    fprintf(stderr,"\n Unable to open file2:%s \n",argv[2]);
+    return(-3);
+  }
+
+  int ok1 = fseek(fp1,0L,SEEK_END);
+  long size1 = ftell(fp1);
+
+
+  int ok2 = fseek(fp2,0L,SEEK_END);
+  long size2 = ftell(fp2);
+
+  //-- printf("\n size:   %s:%ld    %s:%ld\n",argv[1],size1,argv[2],size2);
+
+  if(size2>size1) { 
+    fseek(fp2,size1,SEEK_SET);
+    while(!feof(fp2)) { 
+      int c=fgetc(fp2);
+      if(c!=-1) { 
+	fputc(c,stdout);
+      }    
+    }
+  }
+  
+  return(0);
+}
+  

src/DrawResources/DataExchangeDemo.tcl

@@ -0,0 +1,73 @@
+
+set stationname $tcl_platform(platform)
+if { ${stationname} == "windows" } {
+   proc winfo { aTest aWindow } { return False }
+}
+
+
+proc sage { a} {
+    global stationname 
+    if { ${stationname} != "windows" } {
+	
+	if { ![winfo exists .h ] } {
+	    toplevel .h -bg azure3
+	    wm title .h "INFO DATAEXCHANGE TEST HARNESS"
+	    wm geometry .h +320+20
+	    
+	} 
+	if { [winfo exists .h.m ] } {
+	    set astring [.h.m cget  -text]
+	    set newstring "${astring} \n $a"
+	    .h.m configure -text $newstring 
+	    puts $a
+	} else {
+	    message .h.m -justify left -bg azure2 -width 13c -relief ridge -bd 4\
+		    -text $a
+	    puts $a
+	} 
+	pack .h.m
+	update
+   }
+}
+
+
+smallview
+if { [winfo exists .h ] } {
+    destroy .h
+}
+
+if { [info exists env(CASROOT)] } {
+    set thedir [file join $env(CASROOT) src DEResource]
+    cd ${thedir}
+}
+
+datadir .
+sage " First, we retrieve a BREP File "
+sage "    datadir ."
+sage "    restore wing.brep wing"
+sage " "
+datadir .
+restore wing.brep wing
+disp wing
+fit
+sage "Generate the IGES File of this BREP"
+sage "   brepiges wing /tmp/wing.igs"
+sage " "
+brepiges wing /tmp/wing.igs
+wait 3
+sage "we delete all data"
+sage ""
+dall
+sage "Restore this IGES File we have created " 
+sage "   igesbrep wing.igs new *"
+sage ""
+cd /tmp
+igesbrep wing.igs new *
+disp new
+fit
+if { [winfo exists .h ] } {
+    destroy .h
+}
+puts "End IGES Elementary Test " 
+sage " "
+unlink /tmp/wing.igs

src/DrawResources/Documentation.tcl

@@ -0,0 +1,100 @@
+#
+# Documentation.tcl
+#
+# TCL procedures to process documentation files
+#
+
+
+
+#
+# Read a file
+
+# The array subTitles binds the subTitles for each title (or empty list)
+# The array texts     binds the text for each title
+#
+# Titles are of the form {Title subTitle subTitle}
+#
+
+proc readFile {filename} {
+    global subTitles texts
+    if {! [file readable $filename]} return
+
+    foreach ar {subTitles texts} {if [info exists $ar] {unset $ar}}
+    set title  "Top"
+    set stitle "Top"
+    set subTitles($stitle) {}
+    set level 1
+    set f [open $filename r]
+    while {[gets $f line] >= 0} {
+
+	if [regexp {^[ ]*(\*+)[ ]*(.*$)} $line dummy s t] {
+	    
+	    # it is a new title
+	    set l [string length $s]
+
+	    # at a deepest level go down enough levels
+	    while {$level < $l} {
+		set up($title) $stitle
+		set stitle $title
+		lappend title $t
+		incr level
+	    }
+
+	    # at an upper level go up enough level
+	    while {$level > $l} {
+		set title stitle
+		set stitle $up($stitle)
+		incr level -1
+	    }
+	    
+	    # at the current level
+	    lappend subTitles($stitle) $t
+	    set title [concat $stitle $t]
+	    set texts($title) ""
+
+	} else {
+
+	    # it is a line for the current title
+	    lappend texts($title) $line
+	}
+    }
+    close $f
+}
+
+#
+# call on each title : titleProc title level
+# call on each text  : textProc text
+
+proc dump {titleProc textProc {title Top} {level 1}} {
+    global subTitles texts
+    if [info exists texts($title)] {$textProc $texts($title)}
+    if [info exists subTitles($title)] {
+	set l $level
+	incr l
+	foreach t $subTitles($title) {
+	    $titleProc $t $level
+	    dump $titleProc $textProc [concat $title $t] $l
+	}
+    }
+}
+
+# cut a text into sections
+# and call on  each section  : sectionProc section text
+
+proc sectionText {aText aSectionProc} {
+    set section ""
+    set text    {}
+    foreach line $aText {
+	
+	if {[string index $line 0] == "."} {
+	    
+	    $aSectionProc $section $text
+	    set section $line
+	    set text {}
+	} else {
+	    lappend text $line
+	}
+    }
+    $aSectionProc $section $text
+}
+

src/DrawResources/DrawDefault

@@ -0,0 +1,37 @@
+set tcl_interactive 1
+set tcl_precision 17
+
+if [info exists library] {
+  source [file join $library init.tcl]
+}
+set dir ""
+if { [info exists env(DRAWHOME) ] } { 
+  set dir $env(DRAWHOME)  
+} else {
+    if { [info exists env(CASROOT) ] } {
+  set dir [file join $env(CASROOT) src DrawResources]
+    } else {
+  puts " CASROOT is Mandatory to Run OpenCascade"
+    }
+}
+
+# san - 02/08/2002 - In Tcl8.3 it is no longer necessary to load Tix explicitly on WNT
+#if { [info exists env(STATION)] } {
+#  if { $env(STATION) == "wnt" } {
+#    load tix8183.dll Tix
+#  }
+#}
+
+if { [file exist  $dir] } { 
+   source [file join $dir StandardCommands.tcl]
+   source [file join $dir StandardViews.tcl]
+   source [file join $dir Geometry.tcl]
+   if [info exists tk_version] {source [file join $dir DrawTK.tcl]}
+   if [file readable DrawAppliInit] {
+  source DrawAppliInit
+   }
+   set stationname $tcl_platform(platform)
+   if { ${stationname} == "windows" } {
+      wm iconbitmap . -default [file join $dir lamp.ico]
+   }
+} 

src/DrawResources/DrawPlugin

@@ -0,0 +1,49 @@
+! Description of available plugins for DRAW Test Harness
+! *****************************************************************************
+!
+! Format of the file is compliant with the standard Open CASCADE resource files
+! (see the Resource_Manager.cdl file for details).
+!
+! Each key defines a sequence of either further keys or a name of the dynamic
+! library. Keys can be nested down to an arbitrary level. However, make sure
+! there are no cyclic dependencies (internal checks are not performed).
+! 
+! For details how to implement a DRAW plugin refer to the Test Harness User's
+! Guide.
+!
+! To load a plugin use the following command in DRAW:
+!
+! Draw> pload [-PluginFileName] [[Key1] [Key2]...], where:
+!     <-PluginFileName> - Defines the name of a resource file.
+!                         If this parameter is omitted then the default name DrawPlugin
+!                         is used.
+!                         According to the Open CASCADE resource file management rules
+!                         the environment variable CSF_<PluginFileName>Defaults must
+!                         be set and point to the directory storing the file. If it is
+!                         omitted then it defaults to $CASROOT/src/DrawResources.
+!     [Key]             - Defines the key(s) enumerating plugins to be loaded.
+!                         If no keys are specified then the key named DEFAULT is used
+!                         (if there is no such in the file then no plugins are loaded).
+!
+!
+! NOTE: Make sure the DATAEXCHANGE or XDE key succeeds the OCAF key in a sequence
+!
+
+DEFAULT            : MODELING
+MODELING           : TOPTEST
+VISUALIZATION      : AISV
+OCAFKERNEL         : DCAF
+DATAEXCHANGEKERNEL : XSDRAW
+OCAF               : VISUALIZATION, OCAFKERNEL
+DATAEXCHANGE       : XDE, VISUALIZATION
+XDE                : DATAEXCHANGEKERNEL, XDEDRAW
+FULL               : MODELING, OCAFKERNEL, VISUALIZATION 
+ALL                : MODELING, OCAFKERNEL, DATAEXCHANGE
+
+TOPTEST            : TKTopTest
+DCAF               : TKDCAF
+AISV               : TKViewerTest
+XSDRAW             : TKXSDRAW
+XDEDRAW            : TKXDEDRAW
+TOBJ               : TKTObjDRAW
+DFBROWSER          : TKDFBrowser

src/DrawResources/DrawTK.tcl

@@ -0,0 +1,278 @@
+#
+# 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
+}

src/DrawResources/FILES

@@ -0,0 +1,39 @@
+srcinc:::demo.tcl
+srcinc:::BuildWorkbench.tcl
+srcinc:::Tests.tcl
+srcinc:::Consultation.tcl
+srcinc:::CURVES.tcl
+srcinc:::Documentation.tcl
+srcinc:::DrawTK.tcl
+srcinc:::Geometry.tcl
+srcinc:::WOKcomplement.tcl
+srcinc:::InitEnvironment.tcl
+srcinc:::PROFIL.tcl
+srcinc:::StandardCommands.tcl
+srcinc:::StandardViews.tcl
+srcinc:::SCAN.tcl
+srcinc:::SURFACES.tcl
+srcinc:::Grille.tcl
+srcinc:::Move.tcl
+srcinc:::idoc
+srcinc:::mkdoc
+srcinc:::tdoc
+srcinc:::test2xl
+srcinc:::mdltest
+srcinc:::vmdltest
+srcinc:::DRAW.doc
+srcinc:::DRAW.info
+srcinc:::DrawDefault
+srcinc:::TestDraw.cxx
+srcinc:::Filtre.c
+srcinc:::DIFF.c
+srcinc:::demo
+srcinc:::demo.bat
+srcinc:::lamp.ico
+srcinc:::DrawPlugin
+srcinc:::ModelingDemo.tcl
+srcinc:::DataExchangeDemo.tcl
+srcinc:::wing.brep
+srcinc:::VisualizationDemo.tcl
+srcinc:::OCAFDemo.tcl
+srcinc:::TKTopTest.tcl

src/DrawResources/Filtre.c

@@ -0,0 +1,21 @@
+
+#include <stdio.h>
+#include <stdlib.h>
+
+
+
+int main(int argc,char **argv) { 
+  char t[10000];
+  do { 
+    if(fgets(t,10000,stdin)) { 
+      if (t[0] == 'D' && t[1] == 'r' && t[2] == 'a' && t[3] == 'w' &&
+	  t[4] == '[' && t[5] == '1' && t[6] == ']')
+	fputs(t+9,stdout);
+      else
+	fputs(t,stdout);
+    }
+  }
+  while(!feof(stdin));
+
+  return(1);
+}

src/DrawResources/Geometry.tcl

@@ -0,0 +1,75 @@
+proc cmp {} {
+    dtyp .
+    set name [lastrep id x y b]
+    global $name
+    lastrep id x1 y1 z1 b
+    cfindp $name id x y pole
+    if {[dval pole] == 0} return
+    dset x0 x1 y0 y1 z0 z1 b 0
+    draw id 6 $name
+    while {[dval b] == 0} {
+	pick id x2 y2 z2 b nowait
+	dset dx x2-x1 dy y2-y1 dz z2-z1  x1 x2  y1 y2  z1 z2
+	draw id 6 $name
+	cmovep $name pole dx dy dz
+	draw id 6 $name
+    }
+    draw id 6 $name
+    if {[dval b] == 1} return;
+    dset dx x0-x2 dy y0-y2 dz z0-z2
+    cmovep $name pole dx dy dz
+}
+
+proc smp {} {
+    dtyp .
+    set name [lastrep id x y b]
+    global $name
+    lastrep id x1 y1 z1 b
+    sfindp $name id x y upole vpole
+    if {[dval upole] == 0} return
+    dset x0 x1 y0 y1 z0 z1 b 0
+    draw id 6 $name
+    while { [dval b] == 0} {
+	pick id x2 y2 z2 b nowait
+	dset dx x2-x1  dy y2-y1  dz z2-z1 x1 x2 y1 y2 z1 z2
+	draw id 6 $name
+	movep $name upole vpole dx dy dz
+	draw id 6 $name
+    }
+    draw id 6 $name
+    if {[dval b] == 1} return
+    dset dx x0-x2  dy y0-y2  dz z0-z2
+    movep $name upole vpole dx dy dz
+}
+
+#################################################
+# smooth
+#################################################
+proc smooth {name tol {file ""}} {
+    if {$file == ""} {
+	uplevel #0 "bsmooth $name $tol"
+    } else {
+	global Draw_DataDir
+	uplevel #0 "bsmooth $name $tol $Draw_DataDir/$file"
+    }
+    return $name
+}
+
+help smooth {smooth  cname tol [filename] } "DRAW Variables management"
+
+#################################################
+# beziersmooth
+#################################################
+proc beziersmooth {name tol deg option {file ""}} {
+    if {$file == ""} {
+	uplevel #0 "bzsmooth $name $tol $deg $option"
+    } else {
+	global Draw_DataDir
+	uplevel #0 "bzsmooth $name $tol  $deg $option $Draw_DataDir/$file"
+    }
+    return $name
+}
+
+help beziersmooth { beziersmooth  cname tol deg [-GR -VA -PR] [filename] } "DRAW Variables management"
+
+

src/DrawResources/Grille.tcl

@@ -0,0 +1,42 @@
+#
+# this prints the image of the BOOLEAN GRIDS
+#
+proc print_test { test_letter grille_number } {
+    append test_file $test_letter 2 ;  
+    append image_directory "/home/wb/mdl/gti/work/GRILLE/" $grille_number
+    set grille_directory "/adv_20/BAG/test/GRILLES-BOOLEAN/"
+    append grille_directory $grille_number
+    append grille_name $grille_number
+    cd $grille_directory
+    uplevel #0 source $test_file  ;  
+    clear ; 
+    smallview AXON
+    uplevel #0 display b1 b2
+    uplevel #0 fit;
+    uplevel #0 clear
+    uplevel #0 vprops b1 x y z
+    uplevel #0 vprops b2 u v w
+    dtext -0.1 -0.1  -0.2 $test_letter ;
+    dtext -0.1 -0.1  -0.5 $grille_name
+    dtext u v w  solid2
+    dtext x y z  solid1
+    uplevel #0 compound b1 b2 c
+    uplevel #0 display c
+    uplevel #0 hlr rgn c
+    uplevel #0 hlr hid c
+    
+    if { [ file isdirectory $image_directory ] == 0 } {
+	uplevel #0 mkdir $image_directory 
+    }
+    cd $image_directory
+    hcolor 5 16 0
+    hcolor 12 11 0
+    hardcopy $test_letter.ps 
+}
+
+proc print_grille  { number } {
+    foreach letter { A B C D E F G H I J K L M N O P Q R S T U V W X } {
+	puts " *** test : $letter *** "
+	print_test $letter $number 
+    }
+}

src/DrawResources/InitEnvironment.tcl

@@ -0,0 +1,37 @@
+################################################
+#
+#  find the name of the station
+#
+################################################
+proc wokstation {} {
+    set LINE_FROM_UNAME [ exec uname -a ] ;
+    if { [ regexp SunOS $LINE_FROM_UNAME ] } {
+	return "sun"
+    }  elseif { [ regexp IRIX $LINE_FROM_UNAME ] } {
+	return "sil"
+    } elseif { [ regexp OSF $LINE_FROM_UNAME ] } {
+	return "ao1" 
+    } elseif { [ regexp HP-UX $LINE_FROM_UNAME ] } {
+	return "hp"
+    } elseif { [ regexp Linux $LINE_FROM_UNAME ] } {
+	return "lin"
+    } elseif { [ regexp FreeBSD $LINE_FROM_UNAME ] } {
+	return "bsd"
+    } elseif { [ regexp Darwin $LINE_FROM_UNAME ] } {
+	return "mac"
+    } elseif { [ regexp AIX $LINE_FROM_UNAME ] } {
+	return "aix"
+    } else {
+	return "wnt"
+    }
+    
+}
+
+set env(STATION)     [ wokstation ] 
+
+# PMN LE 6/06/1997
+# Ce type d'environnement n'a rien n'a faire dans les sources
+# On doit le faire dans des ilots.tcl ou des ud.tcl ou bien
+# dans les procedures de test externes a WOK
+#set env(WBCONTAINER) /adv_20/BAG
+#set env(WBROOT)     "/adv_21/MDL/k1deb/ref"

src/DrawResources/ModelingDemo.tcl

@@ -0,0 +1,116 @@
+
+set stationname $tcl_platform(platform)
+if { ${stationname} == "windows" } {
+   proc winfo { aTest aWindow } { return False }
+}
+
+
+proc sage { a} {
+    global stationname 
+    if { ${stationname} != "windows" } {
+	
+	if { ![winfo exists .h ] } {
+	    toplevel .h -bg azure3
+	    wm title .h "INFO TEST HARNESS"
+	    wm geometry .h +320+20
+	    
+	} 
+	if { [winfo exists .h.m ] } {
+	    set astring [.h.m cget  -text]
+	    set newstring "${astring} \n $a"
+	    .h.m configure -text $newstring 
+	    puts $a
+	} else {
+	    message .h.m -justify left -bg azure2 -width 13c -relief ridge -bd 4\
+		    -text $a
+	    puts $a
+	} 
+	pack .h.m
+	update
+   }
+}
+
+
+smallview
+if { [winfo exists .h ] } {
+    destroy .h
+}
+sage " Creating a box"
+sage "    box  b -10 -10 -10 20 20 20"
+sage " "
+box b -10 -10 -10 20 20 20
+fit
+nexplode b f
+erase b
+sage " Draft of two lateral faces "
+sage "    depouille r b  0 0  -1 b_6 -15 10 -10 10  0 0 -1 "
+sage "    nexplode r f"
+sage "    depouille rr r  0 0 -1   r_1 -15 -10 -10 10  0 0 -1 "
+sage " "
+depouille r b  0 0  -1 b_6 -15 10 -10 10  0 0 -1 
+clear
+nexplode r f
+depouille rr r  0 0 -1   r_1 -15 -10 -10 10  0 0 -1 
+clear
+nexplode rr e
+sage " Fillet on four lateral edges, then on the top and bottom edges  "
+sage "    nexplode rr e"
+sage "    blend result rr 3 rr_2 3 rr_3 3 rr_10 3 rr_11"
+sage "    nexplode result e"
+sage "    blend result result 2 result_11 3 result_12"
+sage " "
+blend result rr 3 rr_2 3 rr_3 3 rr_10 3 rr_11
+erase rr
+erase result
+nexplode result e
+blend result result 2 result_11 3 result_12 
+clear
+nexplode result f
+sage " Creating a profile on the top face "
+sage "    nexplode result f"
+sage "    profile p  S result_16 F 10 4 D 1 0 C 2 90. Y 8 C 2 90. X -2 C 2 90. Y -8 C 2 90. X 2
+"
+sage " "
+profile p  S result_16 F 10 4 D 1 0 C 2 90. Y 8 C 2 90. X -2 C 2 90. Y -8 C 2 90. X 2
+sage " Creating a prism"
+sage "    prism rr p 0 0 20"
+sage " "
+prism rr p 0 0 20
+fit
+sage " Fusion of this prism with the original part "
+sage "    fuse result rr result"
+sage " "
+fuse result rr result
+donl result
+nexplode result f
+erase result
+fit
+
+sage " Opening the top face"
+sage "    offsetshape r result -1 0.0001 result_17"
+sage " "
+
+nexplode result f
+offsetshape r result -1 0.0001 result_17
+sage " Creating a cylinder and positionning it"
+sage "    pcylinder cyl 2 300"
+sage "    trotate cyl cyl 0 0 0  1 0 0 45"
+sage "    ttranslate cyl cyl 0 7.5 0"
+sage " "
+pcylinder cyl 2 30
+trotate cyl cyl 0 0 0  1 0 0 45
+ttranslate cyl cyl 0 7.5 0
+sage " Display the Shape on Hidden Line Mode "
+sage "   hlr hid r"
+sage ""
+donl r
+hlr hid r
+sage " Display the Shape on HLR Mode "
+sage "   hlr nohid r"
+sage "   hlr hlr r"
+sage ""
+donl r
+hlr nohid r
+hlr hlr r
+sage "Demo completed"
+

src/DrawResources/Move.tcl

@@ -0,0 +1,50 @@
+#
+#  02/02/1996 : pbo : creation
+#  25/10/1996 : pbo : add 2d view
+#
+#  rotation/panning/zoom with buttons
+#
+
+frame .move -relief groove -borderwidth 1 
+pack .move -pady 1 -padx 1 -anchor w -side left
+#toplevel .move
+
+frame .move.rotate -borderwidth 1 
+label .move.rotate.title -text " Rotation "
+button .move.rotate.l   -text " < " -command {l ; repaint}
+button .move.rotate.r   -text " > " -command {r ; repaint}
+button .move.rotate.u   -text " ^ " -command {u ; repaint}
+button .move.rotate.d   -text " v " -command {d ; repaint}
+pack .move.rotate.title -side top
+pack .move.rotate.l -side left
+pack .move.rotate.r -side right
+pack .move.rotate.u -side top
+pack .move.rotate.d -side bottom
+pack .move.rotate
+
+frame .move.panning -borderwidth 1 
+label .move.panning.title -text " Panning "
+button .move.panning.l   -text " < " -command {pl ; 2dpl ; repaint}
+button .move.panning.r   -text " > " -command {pr ; 2dpr ; repaint}
+button .move.panning.u   -text " ^ " -command {pu ; 2dpu ; repaint}
+button .move.panning.d   -text " v " -command {pd ; 2dpd ; repaint}
+pack .move.panning.title -side top
+pack .move.panning.l -side left
+pack .move.panning.r -side right
+pack .move.panning.u -side top
+pack .move.panning.d -side bottom
+pack .move.panning
+
+frame .move.zoom -borderwidth 1 
+label .move.zoom.title -text " Zoom "
+button .move.zoom.mu   -text " + " -command {mu    ; 2dmu ; repaint}
+button .move.zoom.md   -text " - " -command {md    ; 2dmd ; repaint}
+button .move.zoom.fit  -text "max" -command {fit   ; 2dfit; repaint}
+button .move.zoom.w    -text "win" -command {wzoom ;        repaint}
+pack .move.zoom.title -side top
+pack .move.zoom.w -side left
+pack .move.zoom.fit -side right
+pack .move.zoom.mu -side top
+pack .move.zoom.md -side bottom
+pack .move.zoom
+

src/DrawResources/OCAFDemo.tcl

@@ -0,0 +1,76 @@
+# first , Opening Document write on Unix 
+puts "First , Opening Document write on Unix "
+set Data [file join $env(CASROOT) src TCAF]
+
+set DocName [file join ${Data} FileUnix.std]
+if [ file exists ${DocName}  ] {
+    
+    Open ${DocName} Unix
+    DumpDocument Unix
+} else {
+    puts "  ${DocName} does not exist "
+}
+
+# first , Opening Document write on WindowsNT
+puts ""
+puts "now , Opening Document write on WindowsNT "
+puts ""
+
+set DocName [file join ${Data} FileWNT.std]
+puts "trying to Open : ${DocName}  "
+if  [ file exists  ${DocName} ] {
+    catch {  Open ${DocName} WNT } filesta
+    if { ${filesta} == "" } { 
+	DumpDocument WNT
+    } else {
+	puts " Problem when trying to read ${DocName}  ==> $filesta "
+    }
+} else {
+    puts "  ${DocName} does not exist "
+}
+puts "List the Document in the Session :"
+ListDocuments
+
+puts ""
+puts "now , We create  new Document "
+puts ""
+NewDocument New MDTV-Standard
+UndoLimit New 5
+NewCommand New
+
+Label   New  0:20
+SetReal New  0:20 .12345
+
+
+set newName /tmp/New.std
+if { [info exists env(TEMP)] } {
+    set newName $env(TEMP)/New.std
+}
+SaveAs New  ${newName}
+puts " "
+puts "List the Document in the Session :"
+ListDocuments
+puts " "
+puts "We close it"
+Close  New
+puts "List the Document in the Session :"
+ListDocuments
+
+puts "Verify if the new Document is saved : ${newName} "
+if   [file exists ${newName}] { 
+   puts " ... exists : Yes "
+   puts " ... size   : [file size ${newName}]"
+
+   puts " "
+   puts " We try to read it :"
+   Open ${newName} ReadDoc
+   DumpDocument ReadDoc
+    puts "List the Document in the Session :"
+    ListDocuments
+ 
+}  else {
+   puts " ... exists : No "
+}
+puts " "
+puts " "
+puts "end "

src/DrawResources/PROFIL.tcl

@@ -0,0 +1,713 @@
+# File:	BRepOffset.cxx
+# Created:	Wed Oct 25 10:39:23 1995
+# Author:	Bruno DUMORTIER
+#		<dub@fuegox>
+
+
+addmenu Sketch "Sketch" { vprofil2d }
+
+proc mkprofil2d {last} {
+    global [.top.p.eobj.name get]
+    global [.top.p.eobj.face get]
+    global DX 
+    global DY
+    global DX0
+    global DY0
+
+    append cmd " F "
+    append cmd [dval DX] " " [dval DY]
+    
+    for {set i 0} {$i < [.top.l.lb.cm size]} {incr i} {
+	append cmd " [.top.l.lb.cm get $i]"
+    }
+    if [info exist cmd] {
+	uplevel #0 eval 2dprofile [.top.p.eobj.name get] $cmd $last
+    }
+    .top.p.eobj.com delete 0 end
+    set DX0 [dval DX]
+    set DY0 [dval DY]
+    update
+    repaint
+}
+
+proc mkprofil3d {last} {
+    global [.top.p.eobj.name get]
+    global [.top.p.eobj.face get]
+    global DX 
+    global DY
+
+    append cmd " F "
+    append cmd [dval DX] " " [dval DY]
+    
+    if [info exist [.top.p.eobj.face get]] {
+	append cmd " S"
+	append cmd " [.top.p.eobj.face get]";
+    }
+    for {set i 0} {$i < [.top.l.lb.cm size]} {incr i} {
+	append cmd " [.top.l.lb.cm get $i]"
+    }
+    if [info exist cmd] {
+	puts $cmd
+	eval profile [.top.p.eobj.name get] $cmd $last
+    }
+    .top.p.eobj.com delete 0 end
+    repaint
+}
+
+proc bougex {} {
+    global DX
+    global DY
+
+    dset x0 DX
+    dset y0 DY
+
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset DX x0+x2-x1 DY y0
+	mkprofil2d WW
+    }
+    if {[dval MOUSEbutton] == 1} { mkprofil2d WW; return; }
+    dset DX x0 DY y0
+    mkprofil2d WW
+}
+
+proc bougey {} {
+    global DX
+    global DY
+
+    dset x0 DX
+    dset y0 DY
+
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset DX x0 DY y0+y2-y1
+	mkprofil2d WW
+    }
+    if {[dval MOUSEbutton] == 1} { mkprofil2d WW; return; }
+    dset DX x0 DY y0
+    mkprofil2d WW
+}
+
+proc bouge {} {
+    global DX
+    global DY
+
+    dset x0 DX
+    dset y0 DY
+
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset DX x0+x2-x1 DY y0+y2-y1
+	mkprofil2d WW
+    }
+    if {[dval MOUSEbutton] == 1} { mkprofil2d WW; return; }
+    dset DX x0 DY y0
+    mkprofil2d WW
+}
+
+proc bougefp {} {
+    global DX
+    global DY
+
+    dset x0 DX
+    dset y0 DY
+
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	pick 29 x2 y2 z2 MOUSEbutton nowait
+	dset DX x2 DY y2
+	mkprofil2d WW
+    }
+    if {[dval MOUSEbutton] == 1} { mkprofil2d WW; return; }
+    dset DX x0 DY y0
+    mkprofil2d WW
+}
+
+proc movex {} {
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	set MO ""
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dx x2-x1 
+	if { [dval dx] != 0 } {
+	    append MO "x "
+	    append MO [dval dx]
+	}
+	append MO " WW"
+	mkprofil2d $MO
+    }
+    if {[dval MOUSEbutton] == 1} { 
+	set MO ""
+	if { [dval dx] != 0 } {
+	    append MO "x "
+	    append MO [dval dx]
+	}
+	.top.l.lb.cm insert end $MO
+	mkprofil2d WW
+	return
+    }
+    2dclear
+    if [info exist [.top.p.eobj.face get]] {
+	eval pcurve [.top.p.eobj.face get];
+    }
+    mkprofil2d WW
+}
+
+proc movey {} {
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	set MO ""
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dy y2-y1 
+	if { [dval dy] != 0 } {
+	    append MO "y "
+	    append MO [dval dy]
+	}
+	append MO " WW"
+	mkprofil2d $MO
+    }
+    if {[dval MOUSEbutton] == 1} { 
+	set MO ""
+	if { [dval dy] != 0 } {
+	    append MO "y "
+	    append MO [dval dy]
+	}
+	.top.l.lb.cm insert end $MO
+	mkprofil2d WW
+	return
+    }
+    2dclear
+    if [info exist [.top.p.eobj.face get]] {
+	eval pcurve [.top.p.eobj.face get];
+    }
+    mkprofil2d WW
+}
+
+proc movec {} {
+    autodisplay
+    upvar #0 pi    PI
+    upvar #0 CurX  CX
+    upvar #0 CurY  CY
+    upvar #0 CurDX CDX
+    upvar #0 CurDY CDY
+
+    line dummyline CX CY CDX CDY
+
+    point p1 CX CY
+    repaint
+    pick id x1 y1 z1 MOUSEbutton
+    dset sign 1
+    if {[dval MOUSEbutton] == 2} { dset sign -1}
+    dset MOUSEbutton 0
+    autodisplay
+
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	autodisplay
+	point p2 x2 y2
+	cirtang dummy dummyline p1 p2
+	dset PS sign*(CDX*(y2-CY)-CDY*(x2-CX))
+	if { [dval PS] < 0 } { reverse dummy_1}
+	parameters dummy_1 CX CY U1
+	parameters dummy_1 x2 y2 U2
+	autodisplay
+	eval trim dummy_1 dummy_1 U1 U2
+	repaint
+    }
+
+    if {[dval MOUSEbutton] == 1} { 
+	erase dummy_1
+	set MO ""
+	if { [dval U2] < [dval U1]} { dset U2 U2+2*PI}
+	dset da sign*180*(U2-U1)/PI
+	2dcvalue dummy_1 0 X Y DX DY
+	dset dr sqrt(DX*DX+DY*DY)
+	dset PS CDX*(y2-CY)-CDY*(x2-CX)
+	if { [dval PS] < 0 } {dset dr -dr}
+	if { [dval dr] != 0 } {
+	    if { [dval da] != 0 } {
+		append MO "c "
+		append MO [format "%.3f" [dval dr]] " " 
+		append MO [format "%.3f" [dval da]]
+		.top.l.lb.cm insert end $MO
+	    }
+	}
+	mkprofil2d WW
+	return
+    }
+    2dclear
+    if [info exist [.top.p.eobj.face get]] {
+	eval pcurve [.top.p.eobj.face get];
+    }
+    mkprofil2d WW
+}
+
+proc movel {} {
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	set MO ""
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dr sqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1))
+	if { [dval dr] != 0 } {
+	    append MO "l "
+	    append MO [dval dr]
+	}
+	append MO " WW"
+	mkprofil2d $MO
+    }
+    if {[dval MOUSEbutton] == 1} { 
+	set MO ""
+	if { [dval dr] != 0 } {
+	    append MO "l "
+	    append MO [dval dr]
+	}
+	.top.l.lb.cm insert end $MO
+	mkprofil2d WW
+	return
+    }
+    2dclear
+    if [info exist [.top.p.eobj.face get]] {
+	eval pcurve [.top.p.eobj.face get];
+    }
+    mkprofil2d WW
+}
+
+proc movet {} {
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	set MO ""
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dx x2-x1 dy y2-y1
+	if { [dval dx] != 0 || [dval dy] != 0 } {
+	    append MO "t "
+	    append MO [dval dx] " " [dval dy]
+	}
+	append MO " WW"
+	mkprofil2d $MO
+    }
+    if {[dval MOUSEbutton] == 1} { 
+	set MO ""
+	if { [dval dx] != 0 || [dval dy] != 0 } {
+	    append MO "t "
+	    append MO [dval dx] " " [dval dy]
+	}
+	.top.l.lb.cm insert end $MO
+	mkprofil2d WW
+	return
+    }
+    2dclear
+    if [info exist [.top.p.eobj.face get]] {
+	eval pcurve [.top.p.eobj.face get];
+    }
+    mkprofil2d WW
+}
+
+proc movexx {} {
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	set MO ""
+	pick id x2 y2 z2 MOUSEbutton nowait
+	append MO "xx "
+	append MO [dval x2]
+	append MO " WW"
+	mkprofil2d $MO
+    }
+    if {[dval MOUSEbutton] == 1} { 
+	set MO ""
+	append MO "xx "
+	append MO [dval x2]
+	.top.l.lb.cm insert end $MO
+	mkprofil2d WW
+	return
+    }
+    2dclear
+    if [info exist [.top.p.eobj.face get]] {
+	eval pcurve [.top.p.eobj.face get];
+    }
+    mkprofil2d WW
+}
+
+proc moveyy {} {
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	set MO ""
+	pick id x2 y2 z2 MOUSEbutton nowait
+	append MO "yy "
+	append MO [dval y2]
+	append MO " WW"
+	mkprofil2d $MO
+    }
+    if {[dval MOUSEbutton] == 1} { 
+	set MO ""
+	append MO "yy "
+	append MO [dval y2]
+	.top.l.lb.cm insert end $MO
+	mkprofil2d WW
+	return
+    }
+    2dclear
+    if [info exist [.top.p.eobj.face get]] {
+	eval pcurve [.top.p.eobj.face get];
+    }
+    mkprofil2d WW
+}
+
+proc moveix {} {
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	set MO ""
+	pick id x2 y2 z2 MOUSEbutton nowait
+	append MO "ix "
+	append MO [dval x2]
+	append MO " WW"
+	mkprofil2d $MO
+    }
+    if {[dval MOUSEbutton] == 1} { 
+	set MO ""
+	append MO "ix "
+	append MO [dval x2]
+	.top.l.lb.cm insert end $MO
+	mkprofil2d WW
+	return
+    }
+    2dclear
+    if [info exist [.top.p.eobj.face get]] {
+	eval pcurve [.top.p.eobj.face get];
+    }
+    mkprofil2d WW
+}
+
+proc moveiy {} {
+    pick id x1 y1 z1 MOUSEbutton
+    dset MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	set MO ""
+	pick id x2 y2 z2 MOUSEbutton nowait
+	append MO "iy "
+	append MO [dval y2]
+	append MO " WW"
+	mkprofil2d $MO
+    }
+    if {[dval MOUSEbutton] == 1} { 
+	set MO ""
+	append MO "iy "
+	append MO [dval y2]
+	.top.l.lb.cm insert end $MO
+	mkprofil2d WW
+	return
+    }
+    2dclear
+    if [info exist [.top.p.eobj.face get]] {
+	eval pcurve [.top.p.eobj.face get];
+    }
+    mkprofil2d WW
+}
+
+proc vprofil2d {} {
+
+    toplevel .top -bg cornsilk
+    wm geometry .top +10+10
+    wm title .top "SKETCHER"
+    
+    frame .top.l -bg cornsilk
+    
+    frame .top.l.lb -bg azure1 -relief ridge -bd 4
+    listbox .top.l.lb.cm -bg azure1 -yscrollcommand ".top.l.lb.sc set"
+#    scrollbar .top.l.lb.sc -bg azure2 -fg grey80 -activeforeground grey90\
+#	    -relief sunken -command ".top.l.lb.cm yview"
+    scrollbar .top.l.lb.sc -bg azure2 \
+	    -relief sunken -command ".top.l.lb.cm yview"
+    bind .top.l.lb.cm <Double-Button-1> {
+	.top.p.eobj.com delete 0 end
+	.top.p.eobj.com insert end\
+		[.top.l.lb.cm get [.top.l.lb.cm curselection]]
+    }
+    pack .top.l.lb.cm .top.l.lb.sc -side left -fill both -padx 2m
+    
+    frame .top.l.t -bg azure2 -relief ridge -bd 4
+    radiobutton .top.l.t.a -bg azure3 -activebackground azure2\
+	    -text "face" -variable proftype -value F
+    radiobutton .top.l.t.b -bg azure3 -activebackground azure2\
+	    -text "closed" -variable proftype -value W
+    radiobutton .top.l.t.c -bg azure3 -activebackground azure2\
+	    -text "wire" -variable proftype -value " "
+    
+    frame .top.l.f -bg azure2 -relief ridge -bd 4
+    button .top.l.f.f -bg deepskyblue -activebackground lightskyblue1\
+	    -text "  FIT  " -command {
+	if [info exist [.top.p.eobj.face get]] {
+	    eval pcurve [.top.p.eobj.face get];
+	}
+	mkprofil2d WW
+	2dfit; repaint
+    }
+    button .top.l.f.u -bg deepskyblue -activebackground lightskyblue1\
+	    -text " ZOOM + " -command {
+	2dmu; repaint
+    }
+    button .top.l.f.d -bg deepskyblue -activebackground lightskyblue1\
+	    -text " ZOOM - " -command {2dmd; repaint}
+
+    pack .top.l.f.f .top.l.f.u .top.l.f.d -side right -padx 1m -pady 1m
+    
+    frame .top.l.d -bg azure2 -relief ridge -bd 4
+    button .top.l.d.u -bg deepskyblue -activebackground lightskyblue1\
+	    -text " UP" -command 2dpu
+    button .top.l.d.d -bg deepskyblue -activebackground lightskyblue1\
+	    -text "DOWN" -command 2dpd
+    button .top.l.d.l -bg deepskyblue -activebackground lightskyblue1\
+	    -text "LEFT" -command 2dpl
+    button .top.l.d.r -bg deepskyblue -activebackground lightskyblue1\
+	    -text "RIGHT" -command 2dpr
+    pack .top.l.d.u .top.l.d.d .top.l.d.l .top.l.d.r -side left\
+	    -padx 1m -pady 1m
+
+    frame .top.l.q -bg azure2 -relief ridge -bd 4
+    button .top.l.q.ok -bg deepskyblue -activebackground lightskyblue1\
+	    -text " VALI " -command {
+	delete 29
+	if { $proftype == "F"} {
+	    set proftype " "
+	} elseif { $proftype != "W" } {
+	    set proftype "WW"
+	}
+	mkprofil3d $proftype
+	destroy .top
+	if [info exist PickedFace] { erase PickedFace}
+	repaint;
+    }
+    button .top.l.q.ko -bg deepskyblue -activebackground lightskyblue1\
+	    -text " CANCEL " -command {
+	delete 29
+	if [info exist [.top.p.eobj.name get]] {
+	    eval unset [.top.p.eobj.name get];
+	}
+	destroy .top
+	if [info exist PickedFace] { unset PickedFace}
+	repaint;
+    }
+    button .top.l.q.h  -bg deepskyblue -activebackground lightskyblue1\
+	    -text " HELP " -command helpme
+    pack .top.l.q.ok .top.l.q.ko .top.l.q.h -side left -fill both\
+	    -padx 2m -pady 1m
+    
+    pack .top.l.t.a .top.l.t.b .top.l.t.c -side left -padx 1m -pady 1m
+    
+    pack .top.l.lb .top.l.t -side top -pady 1m -fill both
+    pack .top.l.f .top.l.d -side top -pady 1m -fill both
+    pack .top.l.q -side bottom -fill both -pady 1m
+    
+    pack .top.l -side left -fill both -padx 1m
+    
+    frame .top.p -bg azure2 -relief ridge -bd 4
+    
+    frame .top.p.obj -bg azure2 
+    frame .top.p.eobj -bg azure2 
+    label .top.p.obj.name -bg azure2 -text "Name:"
+    entry .top.p.eobj.name  -bg azure1 -relief sunken
+    .top.p.eobj.name insert end "prof"
+    
+    label .top.p.obj.com -bg azure2 -text "Command:"
+    entry .top.p.eobj.com  -bg azure1 -relief sunken
+    bind .top.p.eobj.com <Return> {
+	.top.l.lb.cm insert end [.top.p.eobj.com get]
+	mkprofil2d WW
+    } 
+    
+    label .top.p.obj.face  -bg azure2 -text "Face:"
+    entry .top.p.eobj.face -bg azure1 -relief sunken -textvariable CURFACE
+    bind .top.p.eobj.face <Return> {
+	2dclear
+	if [info exist [.top.p.eobj.face get]] {
+	    eval pcurve [.top.p.eobj.face get];
+	} elseif { [.top.p.eobj.face get] == "."} {
+	    uplevel #0 pickface
+	    set CURFACE PickedFace
+	    uplevel #0 eval pcurve [.top.p.eobj.face get];
+	}
+	mkprofil2d WW
+	2dfit
+	repaint
+    } 
+    
+    label .top.p.obj.x0 -bg azure2 -text "X0:"
+    entry .top.p.eobj.x0  -bg azure1 -relief sunken -textvariable DX0
+    bind .top.p.eobj.x0 <Return> {
+	dset DX [expr $DX0]
+	mkprofil2d WW
+    } 
+    
+    label .top.p.obj.y0 -bg azure2 -text "Y0:"
+    entry .top.p.eobj.y0  -bg azure1 -relief sunken -textvariable DY0
+    bind .top.p.eobj.y0 <Return> {
+	dset DY [expr $DY0]
+	mkprofil2d WW
+    } 
+    
+    frame .top.c -bg azure2 -relief ridge -bd 4
+    button .top.c.add -bg deepskyblue -activebackground lightskyblue1\
+	    -text " Add " -command {
+	.top.l.lb.cm insert end [.top.p.eobj.com get]
+	mkprofil2d WW
+    }
+    button .top.c.rem -bg deepskyblue -activebackground lightskyblue1\
+	    -text "Remove" -command {
+	if {[.top.l.lb.cm curselection] != ""} {
+	    .top.l.lb.cm delete [.top.l.lb.cm curselection]
+	} else {
+	    .top.l.lb.cm delete end
+	}
+	2dclear
+	if [info exist [.top.p.eobj.face get]] {
+	    eval pcurve [.top.p.eobj.face get];
+	}
+	mkprofil2d WW
+    }
+    button .top.c.set -bg deepskyblue -activebackground lightskyblue1\
+	    -text " Set " -command {
+	if {[.top.l.lb.cm curselection] != ""} {
+	    .top.l.lb.cm insert [.top.l.lb.cm curselection]\
+		    [.top.p.eobj.com get]
+	    .top.l.lb.cm delete [.top.l.lb.cm curselection]
+	} else {
+	    .top.l.lb.cm insert end [.top.l.lb.cm get]
+	}
+	mkprofil2d WW
+    }
+    pack .top.c.add .top.c.rem .top.c.set -side left -fill both\
+	    -padx 4m -pady 1m
+    
+    frame .top.m -bg azure2 -relief ridge -bd 4
+    
+    frame .top.m.m1 -bg azure2 
+    button .top.m.m1.x -bg deepskyblue -activebackground lightskyblue1\
+	    -text " X " -command movex
+    button .top.m.m1.xx -bg deepskyblue -activebackground lightskyblue1\
+	    -text " XX " -command movexx
+    
+    frame .top.m.m2 -bg azure2 
+    button .top.m.m2.y -bg deepskyblue -activebackground lightskyblue1\
+	    -text " Y " -command movey
+    button .top.m.m2.yy -bg deepskyblue -activebackground lightskyblue1\
+	    -text " YY " -command moveyy
+    
+    frame .top.m.m3 -bg azure2 
+    button .top.m.m3.c -bg deepskyblue -activebackground lightskyblue1\
+	    -text " C " -command movec
+    button .top.m.m3.ix -bg deepskyblue -activebackground lightskyblue1\
+	    -text " IX " -command moveix
+    
+    frame .top.m.m4 -bg azure2 
+    button .top.m.m4.l -bg deepskyblue -activebackground lightskyblue1\
+	    -text " L " -command movel
+    button .top.m.m4.iy -bg deepskyblue -activebackground lightskyblue1\
+	    -text " IY " -command moveiy
+    
+    frame .top.m.m5 -bg azure2 
+    button .top.m.m5.t -bg deepskyblue -activebackground lightskyblue1\
+	    -text " T " -command movet
+    button .top.m.m5.tt -bg deepskyblue -activebackground lightskyblue1\
+	    -text " TT " -command movett
+    
+    frame .top.sc -bg azure2 -relief ridge -bd 4
+    frame .top.sc.sc1 -bg azure2
+    button .top.sc.sc1.d -bg deepskyblue -activebackground lightskyblue1\
+	    -text "SCAN" -command bouge
+    button .top.sc.sc1.f -bg deepskyblue -activebackground lightskyblue1\
+	    -text " First Point " -command bougefp
+    
+    frame .top.sc.sc2 -bg azure2
+    button .top.sc.sc2.x -bg deepskyblue -activebackground lightskyblue1\
+	    -text " SCAN X " -command bougex
+    button .top.sc.sc2.y -bg deepskyblue -activebackground lightskyblue1\
+	    -text " SCAN Y " -command  bougey 
+    
+    pack .top.p.obj.name .top.p.obj.com .top.p.obj.face .top.p.obj.x0\
+	    .top.p.obj.y0 -side top -fill x -pady 1m
+    pack .top.p.eobj.name .top.p.eobj.com .top.p.eobj.face .top.p.eobj.x0\
+	    .top.p.eobj.y0 -side top -fill x -pady 1m
+    pack .top.p.obj .top.p.eobj -side left 
+    
+    pack .top.m.m1.x .top.m.m1.xx -side top -fill x -pady 1m
+    pack .top.m.m2.y .top.m.m2.yy -side top -fill x -pady 1m
+    pack .top.m.m3.c .top.m.m3.ix -side top -fill x -pady 1m
+    pack .top.m.m4.l .top.m.m4.iy -side top -fill x -pady 1m
+    pack .top.m.m5.t .top.m.m5.tt -side top -fill x -pady 1m
+    pack .top.m.m1 .top.m.m2 .top.m.m3 .top.m.m4 .top.m.m5 -side left -padx 2m
+    
+    pack .top.sc.sc1.d .top.sc.sc1.f -side top -fill x -pady 1m
+    pack .top.sc.sc2.x .top.sc.sc2.y -side top -fill x -pady 1m
+    pack .top.sc.sc1 .top.sc.sc2 -side left -padx 6m 
+    
+    pack .top.p  -side top -fill both -padx 1m -pady 1m
+    pack .top.c  -side top -fill both -padx 1m -pady 1m
+    pack .top.m  -side top -fill both -padx 1m -pady 1m
+    pack .top.sc -side top -fill both -padx 1m -pady 1m
+
+    #global variables and init them
+    global proftype
+    global CURFACE
+    global DX
+    global DY
+    global DX0
+    global DY0
+
+    set  proftype " "
+    set  CURFACE ""
+    set  DX0 ""
+    set  DY0 ""
+    dset DX 0 
+    dset DY 0
+    
+    view 29 -2D- 465 10 664 410
+    2dclear
+    # call 2dprofile to initialize CurX CurY CurDX CurDY
+    mkprofil2d WW
+}
+
+proc helpme {} {
+    toplevel .h -bg azure3
+    wm title .h "HELP"
+    wm geometry .h +40+90
+    message .h.m -justify left -bg azure2 -width 13c -relief ridge -bd 4 -text\
+     "Build a profile in the UV plane from a moving point and direction.\n \
+      The original point and direction are 0 0 and 1 0.\n \
+      Codes and values describe the point or direction change.\n \
+      When the point change the direction becomes the tangent.\n \
+      All angles are in degree (may be negative).\n \
+      By default the profile is closed.\n \
+      \n \
+      Instruction\tParameters\tAction\n \
+      F\t\tX Y\t\tSet the first point\n \
+      X\t\tDX\t\tTranslate point along X\n \
+      Y\t\tDY\t\tTranslate point along Y\n \
+      L\t\tDL\t\tTranslate point along direction\n \
+      XX\t\tX\t\tSet point X coordinate\n \
+      YY\t\tY\t\tSet point Y coordinate\n \
+      T\t\tDX DY\t\tTranslate point\n \
+      TT\t\tX Y\t\tSet point\n \
+      R\t\tAngle\t\tRotate direction\n \
+      RR\t\tAngle\t\tSet direction\n \
+      D\t\tDX DY\t\tSet direction\n \
+      IX\t\tX\t\tIntersect with vertical\n \
+      IY\t\tY\t\tIntersect with horizontal\n \
+      C\t\tRadius Angle\tArc of circle tangent to direction"
+
+    frame .h.q -relief ridge -bd 4 -bg azure3
+    button .h.q.q -bg deepskyblue -activebackground lightskyblue1 -text "QUIT" -command {destroy .h}
+    pack .h.q.q -padx 1m -pady 1m
+    pack .h.m .h.q -side top -pady 2m
+}

src/DrawResources/SCAN.tcl

@@ -0,0 +1,179 @@
+proc 2dscan {} {
+    dtyp .
+    set name [lastrep id x y MOUSEbutton]
+    global $name
+    lastrep id x1 y1 z1 MOUSEbutton
+    dset x0 x1 y0 y1 z0 z1 MOUSEbutton 0
+    erase $name
+    draw id 6 $name
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dx x2-x1 dy y2-y1 dz z2-z1  x1 x2  y1 y2  z1 z2
+	draw id 6 $name
+	2dtranslate $name dx dy
+	draw id 6 $name
+    }
+    draw id 6 $name
+    if {[dval MOUSEbutton] == 1} { display $name; return; }
+    dset dx x0-x2 dy y0-y2 dz z0-z2
+    2dtranslate $name dx dy
+    display $name
+}
+
+proc scan {} {
+    dtyp .
+    set name [lastrep id x y MOUSEbutton]
+    global $name
+    lastrep id x1 y1 z1 MOUSEbutton
+    dset x0 x1 y0 y1 z0 z1 MOUSEbutton 0
+    erase $name
+    draw id 6 $name
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dx x2-x1 dy y2-y1 dz z2-z1  x1 x2  y1 y2  z1 z2
+	draw id 6 $name
+	translate $name dx dy dz
+	draw id 6 $name
+    }
+    draw id 6 $name
+    if {[dval MOUSEbutton] == 1} { display $name; return; }
+    dset dx x0-x2 dy y0-y2 dz z0-z2
+    translate $name dx dy dz
+    display $name
+}
+
+proc scanx {} {
+    dtyp .
+    set name [lastrep id x y MOUSEbutton]
+    global $name
+    lastrep id x1 y1 z1 MOUSEbutton
+    dset x0 x1 y0 y1 z0 z1 MOUSEbutton 0
+    erase $name
+    draw id 6 $name
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dx x2-x1 x1 x2
+	draw id 6 $name
+	translate $name dx 0 0
+	draw id 6 $name
+    }
+    draw id 6 $name
+    if {[dval MOUSEbutton] == 1} {display $name; return;}
+    dset dx x0-x2 
+    translate $name dx 0 0
+    display $name
+}
+
+proc scany {} {
+    dtyp .
+    set name [lastrep id x y MOUSEbutton]
+    global $name
+    lastrep id x1 y1 z1 MOUSEbutton
+    dset x0 x1 y0 y1 z0 z1 MOUSEbutton 0
+    erase $name
+    draw id 6 $name
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dy y2-y1 y1 y2
+	draw id 6 $name
+	translate $name 0 dy 0
+	draw id 6 $name
+    }
+    draw id 6 $name
+    if {[dval MOUSEbutton] == 1} { display $name; return;}
+    dset dy y0-y2
+    translate $name 0 dy 0
+    display $name
+}
+
+proc scanz {} {
+    dtyp .
+    set name [lastrep id x y MOUSEbutton]
+    global $name
+    lastrep id x1 y1 z1 MOUSEbutton
+    dset x0 x1 y0 y1 z0 z1 MOUSEbutton 0
+    erase $name
+    draw id 6 $name
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dz z2-z1 z1 z2
+	draw id 6 $name
+	translate $name 0 0 dz
+	draw id 6 $name
+    }
+    draw id 6 $name
+    if {[dval MOUSEbutton] == 1} { display $name; return;}
+    dset dz z0-z2
+    translate $name 0 0 dz
+    display $name
+}
+
+proc tscan {} {
+    dtyp .
+    set name [lastrep id x y MOUSEbutton]
+    global $name
+    lastrep id x1 y1 z1 MOUSEbutton
+    dset x0 x1 y0 y1 z0 z1 MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dx x2-x0 dy y2-y0 dz z2-z0
+	eval ttranslate [explode $name e] dx dy dz
+	repaint
+    }
+    if {[dval MOUSEbutton] == 3} return;
+    dset dx x2-x0 dy y2-y0 dz z2-z0
+    ttranslate $name dx dy dz
+}
+
+proc tscanx {} {
+    dtyp .
+    set name [lastrep id x y MOUSEbutton]
+    global $name
+    lastrep id x1 y1 z1 MOUSEbutton
+    dset x0 x1 y0 y1 z0 z1 MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dx x2-x0
+	eval ttranslate [explode $name e] dx 0 0
+	repaint
+    }
+    if {[dval MOUSEbutton] == 3} return;
+    dset dx x2-x0 
+    ttranslate $name dx 0 0
+}
+
+proc tscany {} {
+    dtyp .
+    set name [lastrep id x y MOUSEbutton]
+    global $name
+    lastrep id x1 y1 z1 MOUSEbutton
+    dset x0 x1 y0 y1 z0 z1 MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dy y2-y0
+	eval ttranslate [explode $name e] 0 dy 0
+	repaint
+    }
+    if {[dval MOUSEbutton] == 3} return;
+    dset dy y2-y0
+    ttranslate $name 0 dy 0
+}
+
+proc tscanz {} {
+    dtyp .
+    set name [lastrep id x y MOUSEbutton]
+    global $name
+    lastrep id x1 y1 z1 MOUSEbutton
+    dset x0 x1 y0 y1 z0 z1 MOUSEbutton 0
+    while {[dval MOUSEbutton] == 0} {
+	pick id x2 y2 z2 MOUSEbutton nowait
+	dset dz z2-z0
+	eval ttranslate [explode $name e] 0 0 dz
+	repaint
+    }
+    if {[dval MOUSEbutton] == 3} return;
+    dset dz z2-z0
+    ttranslate $name 0 0 dz
+}
+
+

src/DrawResources/SURFACES.tcl

@@ -0,0 +1,13 @@
+proc dialanasurf {command sname args} {
+    set com "dialbox $command name $sname origin {0 0 0} normal {0 0 1} xdir {1 0 0} "
+    foreach l $args {append com " $l"}
+    eval $com
+}
+
+addmenu Surfaces "Plane"      {dialanasurf plane p {}}
+addmenu Surfaces "Cylinder"   {dialanasurf cylinder c {radius 1}}
+addmenu Surfaces "Cone"       {dialanasurf cone c {angle 30 radius 0}}
+addmenu Surfaces "Sphere"     {dialanasurf sphere s {radius 1}}
+addmenu Surfaces "Torus"      {dialanasurf torus t {radii {1 0.8}}}
+addmenu Surfaces "Revolution" {dialbox revsur name r basis . origin {0 0 0} axis {0 0 1}}
+addmenu Surfaces "Extrusion"  {dialbox extsurf name e basis . direction {0 0 1}}

src/DrawResources/StandardCommands.tcl

@@ -0,0 +1,363 @@
+#
+# Draw standard initialisation
+#
+
+#################################################
+# prompts
+#################################################
+
+set Draw_CmdIndex 0
+set tcl_prompt1 {
+    incr Draw_CmdIndex
+    puts -nonewline "Draw\[$Draw_CmdIndex\]> "
+}
+
+set tcl_prompt2 {puts -nonewline "> "}
+
+
+#################################################
+# the help command in TCL
+#################################################
+
+
+proc help {{command ""} {helpstring ""} {group "Procedures"}} {
+
+    global Draw_Helps Draw_Groups
+
+    if {$command == ""} {
+
+	# help general
+	foreach h [lsort [array names Draw_Groups]] {
+	    puts ""
+	    puts ""
+	    puts $h
+	    set i 0
+	    foreach f [lsort $Draw_Groups($h)] {
+		if {$i == 0} {
+		    puts ""
+		    puts -nonewline "  "
+		}
+		puts -nonewline $f
+		for {set j [string length $f]} {$j < 15} {incr j} {
+		    puts -nonewline " "
+		}
+		incr i
+		if {$i == 4} {set i 0}
+	    }
+	    puts ""
+	}
+    } elseif {$helpstring == ""} {
+
+	# help fonction
+	append command "*"
+	foreach f [lsort [array names Draw_Helps]] {
+	    if {[string match $command $f]} {
+		puts -nonewline $f
+		for {set j [string length $f]} {$j < 15} {incr j} {
+		    puts -nonewline " "
+		}
+		puts " : $Draw_Helps($f)"
+	    }
+	}
+    } else {
+
+	# set help
+	lappend Draw_Groups($group) $command
+	set Draw_Helps($command) $helpstring
+    }
+    
+    flush stdout
+}
+
+help help {help pattern, or help command string group, to set help} {DRAW General Commands}
+#################################################
+# the getsourcefile command in TCL
+#################################################
+
+
+proc getsourcefile {{command ""}} {
+
+    global Draw_Helps Draw_Groups Draw_Files
+
+    if {$command == ""} {
+
+	# help general
+	foreach h [lsort [array names Draw_Groups]] {
+	    puts ""
+	    puts ""
+	    puts $h
+	    set i 0
+	    foreach f [lsort $Draw_Groups($h)] {
+		if {$i == 0} {
+		    puts "  "
+		}
+		incr i
+#
+# check that the command has its source file set
+#
+		foreach command_that_has_file [array names Draw_Files] {
+		    if {($command_that_has_file == $f)} {
+#
+#  compute the length of the string to have the right spacing
+#  with tabs
+#
+			set ll [string length $f] 
+			if {($ll >= 1) && ($ll < 8)} {
+			    puts "$f\t\t:  $Draw_Files($f) "
+			}
+			if {($ll >= 8)} {
+			    puts "$f\t:  $Draw_Files($f) "
+			}
+			 
+		    }
+		}
+	    }
+	}
+    } else {
+
+	# getsourcefile fonction
+	append command "*"
+	foreach f [lsort [array names Draw_Files]] {
+	    if {[string match $command $f]} {
+		puts -nonewline $f
+		for {set j [string length $f]} {$j < 15} {incr j} {
+		    puts -nonewline " "
+		}
+
+		puts "     $Draw_Files($f)"
+	    }
+	}
+	
+    } 
+    flush stdout
+}
+
+help getsourcefile {getsourcefile, or getsourcefile command } {DRAW General Commands}
+
+#################################################
+# whatis
+#################################################
+
+#proc gwhatis {aVarName} {
+#    global $aVarName
+#    puts -nonewline $aVarName; puts -nonewline " is a "; puts [dtyp ${aVarName}]
+#}
+
+proc whatis args {
+    set __out_string ""
+    foreach i $args {
+	if {$i == "."} {set i [dname $i]}
+	#gwhatis $i
+	global $i
+	set __tmp_string "$i is a [dtyp $i]\n"
+	set __out_string "${__out_string}${__tmp_string}"
+    }
+    return ${__out_string}
+}
+
+help whatis "whatis object1 object2 ..." 
+
+#################################################
+# library, lsource
+#################################################
+
+proc library lib {
+    global auto_path
+    set auto_path [linsert $auto_path 0 $lib]
+    if [file readable $lib/LibraryInit] {
+	puts "Loading $lib/LibraryInit"
+	uplevel "source $lib/LibraryInit"
+    }
+}
+
+proc lsource file {
+    if [file readable $file] {source $file} else {
+	global auto_path
+	foreach dir $auto_path {
+	    if [file readable $dir/$file] {
+		uplevel #0 "source $dir/$file"
+		break
+	    }
+	}
+    }
+}
+
+#################################################
+# directory
+#################################################
+
+proc isgdraw {var} {
+    global $var
+    return [isdraw $var]
+}
+
+proc directory {{joker *}} {
+    set res ""
+    foreach var [info globals $joker] { 
+	if [isgdraw $var] {lappend res $var}
+    }
+    return $res
+}
+
+help directory {directory [pattern], list draw variables} {DRAW Variables management}
+
+proc lsd {} { exec ls [datadir] }
+
+proc dall {} {
+    set schmurtz ""
+    foreach var [info globals] { 
+	global $var
+	if [isdraw $var] {
+	    if ![isprot $var] {
+		lappend schmurtz $var; unset $var
+	    }
+	}
+    }
+    return $schmurtz
+}
+
+#################################################
+# repeat, do
+#################################################
+
+proc repeat {val script} {
+    for {set i 1} {$i <= $val} {incr i} {uplevel $script}
+}
+
+proc do {var start end args} {
+    global errorInfo errorCode
+    if {[llength args] == 1} {
+	set incr 1
+	set body args
+    } else {
+	set incr [lindex 1 args]
+	set body [lindex 2 args]
+    }
+    upvar $var v
+    if {[dval $incr] < 0} {set rel >=} else {set rel <=}
+    for {dset v $start} {[dval v] $rel [dval end]} {dset v [dval v+($incr)]} {
+	set code [catch {uplevel $body} string]
+	if {$code == 1} {
+	    return -code error -errorInfo $errorInfo -errorcode $errorCode $string
+	} elseif {$code == 2} {
+	    return -code return $string
+	}elseif {$code == 3} {
+	    return
+	} elseif {$code > 4} {
+	    return -code $code $string
+	}
+    }
+}
+
+#################################################
+# datadir, save, restore
+#################################################
+
+set Draw_DataDir "."
+
+proc datadir {{dir ""}} {
+    global Draw_DataDir
+    if {$dir != ""} {
+	if {![file isdirectory $dir]} {
+	    error "datadir : $dir is not a directory"
+	} else {
+	    set Draw_DataDir $dir
+	}
+    }
+    return $Draw_DataDir
+}
+
+help datadir {datadir [directory]} "DRAW Variables management"
+
+proc save {name {file ""}} {
+    if {$file == ""} {set file $name}
+    upvar $name n
+    if {![isdraw n]} {error "save : $name is not a Draw variable"}
+    global Draw_DataDir
+    bsave n [file join $Draw_DataDir $file]
+    return [file join $Draw_DataDir $file]
+}
+
+help save {save variable [filename]} "DRAW Variables management"
+
+proc restore {file {name ""}} {
+    if {$name == ""} {set name $file}
+    global Draw_DataDir
+    uplevel #0 "brestore [file join $Draw_DataDir $file ] $name"
+    return $name
+}
+
+help restore {restore filename [variablename]} "DRAW Variables management"
+
+#################################################
+# misc...
+#################################################
+
+proc ppcurve {a} {
+	2dclear;
+	uplevel pcurve $a;
+	2dfit;
+}
+
+#################################################
+# display and donly with jokers
+#################################################
+
+
+proc disp { args } {
+    set res ""
+    foreach joker $args {
+	if { $joker == "." } {
+             dtyp .
+             set joker [lastrep id x y b]
+	}
+        foreach var [info globals $joker] { 
+	   if { $var == "." } {
+               dtyp .
+               set var [lastrep id x y b]
+	   }
+	   if [isgdraw $var] {lappend res $var}
+        }
+    }
+    uplevel #0 eval display $res
+    return $res
+}
+
+
+proc donl { args } {
+    set res ""
+    foreach joker $args {
+	if { $joker == "." } {
+             dtyp .
+             set joker [lastrep id x y b]
+	}
+        foreach var [info globals $joker] { 
+	   if { $var == "." } {
+               dtyp .
+               set var [lastrep id x y b]
+	   }
+	   if [isgdraw $var] {lappend res $var}
+        }
+    }
+    uplevel #0 eval donly $res
+    return $res
+}
+
+proc don { args } {
+    set res ""
+    foreach joker $args {
+	if { $joker == "." } {
+             dtyp .
+             set joker [lastrep id x y b]
+	}
+        foreach var [info globals $joker] { 
+	   if { $var == "." } {
+               dtyp .
+               set var [lastrep id x y b]
+	   }
+	   if [isgdraw $var] {lappend res $var}
+        }
+    }
+    uplevel #0 eval donly $res
+    return $res
+}

src/DrawResources/StandardViews.tcl

@@ -0,0 +1,271 @@
+#
+# view management scripts
+#
+#
+
+proc mu4 {} {
+    global tcl_platform
+    set stationname $tcl_platform(platform)
+    delete
+#    if { ${stationname} == "windows" } {
+#	view 1 +X+Z 20 20 300 300
+#	view 2 +X+Y 20 350 300 300
+#	view 3 -Y+Z 328 20 300 300
+#	view 4 AXON 328 350 300 300
+#    } else {
+	view 1 +X+Z 320 20 400 400
+	view 2 +X+Y 320 450 400 400
+	view 3 -Y+Z 728 20 400 400
+	view 4 AXON 728 450 400 400
+#    }
+}
+
+help mu4 ", Four views layout" "DRAW Graphic Commands"
+
+proc mu7 {} {
+    delete
+    view  1 +Y+Z 0   300 275 270
+    view  2 +X-Y 285 0   275 270
+    view  3 +X+Z 285 300 275 270
+    view  4 +X+Y 285 600 275 270
+    view  5 -Y+Z 570 300 275 270
+    view  6 -X+Z 855 300 275 270
+    view  7 AXON 855 600 275 270
+}
+help mu7 ", Seven views layout" "DRAW Graphic Commands"
+
+proc mu8 {} {
+    delete
+    view  1 +Y+Z 0   300 275 270
+    view  2 +X-Y 285 0   275 270
+    view  3 +X+Z 285 300 275 270
+    view  4 +X+Y 285 600 275 270
+    view  5 -Y+Z 570 300 275 270
+    view  6 PERS 855 0   275 270
+    view  7 -X+Z 855 300 275 270
+    view  8 AXON 855 600 275 270
+}
+help mu8 ", Seven views layout" "DRAW Graphic Commands"
+
+proc mu24 {} {
+    delete
+    view  1 +X+Y 0   0   180 190
+    view  2 -Y+X 0   220 180 190
+    view  3 -X-Y 0   440 180 190
+    view  4 +Y-X 0   660 180 190
+    
+    view  5 +Y+X 190 0   180 190
+    view  6 -X+Y 190 220 180 190
+    view  7 -Y-X 190 440 180 190
+    view  8 +X-Y 190 660 180 190
+    
+    view  9 +X+Z 380 0   180 190
+    view 10 -Z+X 380 220 180 190
+    view 11 -X-Z 380 440 180 190
+    view 12 +Z-X 380 660 180 190
+    
+    view 13 +Z+X 570 0   180 190
+    view 14 -X+Z 570 220 180 190
+    view 15 -Z-X 570 440 180 190
+    view 16 +X-Z 570 660 180 190
+    
+    view 17 +Y+Z 760 0   180 190
+    view 18 -Z+Y 760 220 180 190
+    view 19 -Y-Z 760 440 180 190
+    view 20 +Z-Y 760 660 180 190
+    
+    view 21 +Z+Y 950 0   180 190
+    view 22 -Y+Z 950 220 180 190
+    view 23 -Z-Y 950 440 180 190
+    view 24 +Y-Z 950 660 180 190
+    
+}
+help mu24 ", 24 views layout" "DRAW Graphic Commands"
+
+proc axo {} {
+    global tcl_platform
+    set stationname $tcl_platform(platform)
+    delete
+#    if { ${stationname} == "windows" } {
+#	view 1 AXON 10 120 600 600
+#    } else {
+	view 1 AXON 465 20 800 800
+#    }
+}
+help axo ", One axonometric view" "DRAW Graphic Commands"
+
+proc haxo {} {
+    delete
+    view 1 AXON 465 20 800 800*20.4/29.1
+}
+help haxo ", One axonometric horizontal view" "DRAW Graphic Commands"
+
+proc vaxo {} {
+    delete
+    view 1 AXON 705 20 800*20.4/29.1 800
+}
+help vaxo ", One axonometric vertical view" "DRAW Graphic Commands"
+
+proc pers {} {
+    delete
+    view 1 PERS 465 20 800 800
+}
+help pers ", One perspective view" "DRAW Graphic Commands"
+
+proc hpers {} {
+    delete
+    view 1 PERS 465 20 800 800*20.4/29.1
+}
+help hpers ", One perspective horizontal view" "DRAW Graphic Commands"
+
+proc vpers {} {
+    delete
+    view 1 PERS 705 20 800*20.4/29.1 800
+}
+help vpers ", One perspective vertical view" "DRAW Graphic Commands"
+
+proc front {} {
+    delete
+    view 1 +X+Z 465 20 800 800
+}
+help front ", One front view" "DRAW Graphic Commands"
+
+proc hfront {} {
+    delete
+    view 1 +X+Z 465 20 800 800*20.4/29.1
+}
+help hfront ", One front horizontal view" "DRAW Graphic Commands"
+
+proc vfront {} {
+    delete
+    view 1 +X+Z 705 20 800*20.4/29.1 800
+}
+help vfront ", One front vertical view" "DRAW Graphic Commands"
+
+proc top {} {
+    delete
+    view 1 +X+Y 465 20 800 800
+}
+help top ", One top view" "DRAW Graphic Commands"
+
+proc htop {} {
+    delete
+    view 1 +X+Y 465 20 800 800*20.4/29.1
+}
+help htop ", One top horizontal view" "DRAW Graphic Commands"
+
+proc vtop {} {
+    delete
+    view 1 +X+Y 705 20 800*20.4/29.1 800
+}
+help vtop ", One top vertical view" "DRAW Graphic Commands"
+
+proc left {} {
+    delete
+    view 1 -Y+Z 465 20 800 800
+}
+help left ", One left view" "DRAW Graphic Commands"
+
+proc hleft {} {
+    delete
+    view 1 -Y+Z 465 20 800 800*20.4/29.1
+}
+help hleft ", One left horizontal view" "DRAW Graphic Commands"
+
+proc vleft {} {
+    delete
+    view 1 -Y+Z 705 20 800*20.4/29.1 800
+}
+help vleft ", One left vertical view" "DRAW Graphic Commands"
+
+proc back {} {
+    delete
+    view 1 -X+Z 465 20 800 800
+}
+help back ", One back view" "DRAW Graphic Commands"
+
+proc hback {} {
+    delete
+    view 1 -X+Z 465 20 800 800*20.4/29.1
+}
+help hback ", One back horizontal view" "DRAW Graphic Commands"
+
+proc vback {} {
+    delete
+    view 1 -X+Z 705 20 800*20.4/29.1 800
+}
+help vback ", One back vertical view" "DRAW Graphic Commands"
+
+proc right {} {
+    delete
+    view 1 +Y+Z 465 20 800 800
+}
+help right ", One right view" "DRAW Graphic Commands"
+
+proc hright {} {
+    delete
+    view 1 +Y+Z 465 20 800 800*20.4/29.1
+}
+help hright ", One right horizontal view" "DRAW Graphic Commands"
+
+proc vright {} {
+    delete
+    view 1 +Y+Z 705 20 800*20.4/29.1 800
+}
+help vright ", One right vertical view" "DRAW Graphic Commands"
+
+proc bottom {} {
+    delete
+    view 1 +X-Z 465 20 800 800
+}
+help bottom ", One bottom view" "DRAW Graphic Commands"
+
+proc hbottom {} {
+    delete
+    view 1 +X-Z 465 20 800 800*20.4/29.1
+}
+help hbottom ", One bottom horizontal view" "DRAW Graphic Commands"
+
+proc vbottom {} {
+    delete
+    view 1 +X-Z 705 20 800*20.4/29.1 800
+}
+help vbottom ", One bottom vertical view" "DRAW Graphic Commands"
+
+proc v2d {} {
+    delete
+    view 1 -2D- 465 20 800 800
+}
+help v2d ", One 2d view" "DRAW Graphic Commands"
+
+proc av2d {} {
+    delete
+    global tcl_platform
+    set stationname $tcl_platform(platform)
+#    if { ${stationname} == "windows" } {
+#	view 2 -2D- 328  20 300 300
+#	view 1 AXON 328 350 300 300
+#    } else {
+	view 2 -2D-  728 20 400 400
+	view 1 AXON 728 450 400 400
+#    }
+}
+help av2d ", axono and 2d view" "DRAW Graphic Commands"
+
+proc v2d2 {} {
+    view 2 -2D-  728 20 400 400
+}
+help v2d2 "2d view on number 2" "DRAW Graphic Commands"
+
+proc smallview {{v AXON}} {
+    global tcl_platform
+    set stationname $tcl_platform(platform)
+    delete
+#    if { ${stationname} == "windows" } {
+#	view 1 $v 328 350 300 300
+#    } else {
+	view 1 $v 728 450 400 400
+#    }
+}
+
+help smallview " AXON PERS -2D- +X+Y ..." "DRAW Graphic Commands"

src/DrawResources/TKTopTest.tcl

@@ -0,0 +1,3 @@
+set Draw_GEOMETRY 1
+source $env(CASROOT)/src/DrawResources/CURVES.tcl
+source $env(CASROOT)/src/DrawResources/SURFACES.tcl

src/DrawResources/TestDraw.cxx

@@ -0,0 +1,70 @@
+
+
+// modele de programme principal Draw
+
+#include <Draw.hxx>
+#include <Draw_Appli.hxx>
+
+// main passe la main a Draw
+
+main(int argc, char** argv)
+{
+  Draw_Appli(argc,argv);
+}
+
+//*******************************
+//
+// Retirez les includes inutiles
+// pour ne pas surcharger le link
+//
+//********************************
+
+#include <GeometryTest.hxx>
+
+// seulement si on fait de la topologie
+#include <BRepTest.hxx>
+
+// pour les commandes utilisateurs topologie
+#include <DBRep.hxx>
+
+
+// exemple de commande utilisateur
+
+static Standard_Integer macommande (Draw_Interpretor& di,
+				    Standard_Integer n, char** a)
+{
+  if (n < 2) return 1;   // erreur si pas assez d'arguments
+
+  TopoDS_Shape S = DBRep::Get(a[1]);
+  if (S.IsNull()) {
+    cout << a[1] << " n'est pas un shape" << endl;
+    return 1;
+  }
+
+  // .... faite ce que vous voulez a S .....
+
+  //... pour retourner un chaine a TCL, mettez la dans di
+
+  di << a[1];
+
+  return 0;
+}
+
+
+// definition des commandes
+
+void Draw_InitAppli(Draw_Interpretor& theCommands)
+{
+  Draw::Commands(theCommands);
+
+  // geometry
+  GeometryTest::AllCommands(theCommands);   // voir GeometryTest.cdl pour etre plus fin
+
+  // pour la topologie
+  BRepTest::AllCommands(theCommands);       // voir BRepTest.cdl pour etre plus fin
+
+
+  // commandes utilisateur
+
+  theCommands.Add("macommande","macommande et son help",macommande);
+}

src/DrawResources/Tests.tcl

@@ -0,0 +1,818 @@
+#
+# tclsh tools to browse tests
+#
+# xab : 22-Mar-96  rajout de floatDifference pour eviter des diffs
+#                  en fonction de la tolerance DiffTestTolerance
+# pmn : 25-Sept-96 masterRoot sans reference explicite a gti 
+#                 (pour une utilisation Aixoise)
+# xab : 12-Nov-996 nouveau trap dans les comptes rendus
+#                  INV par checkshape ou checktopshape
+# xab : 22/11/96  : on a encore besoin des 3 variables d'environement
+#                   WBCONTAINER
+#                   WBROOT
+#                   STATION
+# xab : 10-Mar-97 : string compare au lieu de != dans les diffs
+#
+####################################################
+# Error list
+####################################################
+
+set nomatch "ZXWYWXZ"
+set theErrors {
+    { nomatch                   "NOLOGFILE" "no result for the test"}
+    { nomatch                   "OK       " "no error and no difference"}
+    { nomatch                   "NO       " "no error and no master file to compare"}
+    { nomatch                   "NOEND    " "abnormal termination"}
+    { "An exception was caught" "CATCH    " "an exception was caught"}
+    { "segv"                    "SEGV     " "segmentation violation"}
+    { "ERROR"                   "ERROR    " "user generated error"}
+    { "NYI"                     "NYI      " "This test is not yet implemented"}
+    { "Cpu Limit Exceeded"      "CPULIM   " "CPU limit exceeded"}
+    { "BRepCheck_"              "INV      " "invalid result"}    
+}
+
+####################################################
+# Variables
+####################################################
+set DiffTestTolerance 1.0e-6
+
+set theStation $env(STATION)
+
+if {$theStation=="wnt"} {
+    set ExeMachinePath  drv\\DFLT\\$env(STATION)
+    set exePath         $env(WBROOT)\\prod
+#    set testRoot        $env(WBCONTAINER)\\test
+    set testRoot        $env(WBCONTAINER)
+    set resultRoot      $env(WBROOT)\\work\\result$env(STATION)
+    set masterRoot      $env(WBROOT)\\work\\master
+} else {
+    set ExeMachinePath  drv/DFLT/$env(STATION)
+    set ExePath         $env(WBROOT)/$env(STATION)/bin
+    set testRoot        $env(WBCONTAINER)
+    set resultRoot      $env(WBROOT)/work/result$env(STATION)
+    set masterRoot      $env(WBROOT)/work/master
+}
+puts "$testRoot  et        $env(WBCONTAINER) "
+#
+## customize default values, if "setenv" has been set by AQ Team  -plb/13feb97-
+
+foreach el1 [array names env] {
+    if       { [ string compare $el1 "DRAW_TEST_ROOT" ] == 0 }   {
+	set testRoot   $env($el1)
+    } elseif { [ string compare $el1 "DRAW_TEST_RESULT" ] == 0 } {
+	set resultRoot $env($el1)
+    } elseif { [ string compare $el1 "DRAW_TEST_MASTER" ] == 0 } {
+	set masterRoot $env($el1)
+    }
+}
+
+
+set theUL       ""
+set theFunction ""
+set theTest     ""
+set theExec     ""
+set themode     ""
+
+# name of Draw process to send
+set theDraw     "Draw"
+set FILTRE      ""
+set DIFF        ""
+set RESULT      ""
+set PREVIOUS    ""
+set TEMP        ""
+
+set listUL       {}
+set listFunction {}
+set listTest     {}
+
+set theLog            ""
+set theMasterLog      ""
+set theXWDFiles       {}
+set theMasterXWDFiles {}
+
+set theStatusHeader "Result    LOG  XWD"
+set theStatus       ""
+set theStatusLine   ""
+set theErrorLines   {}
+set theDiffs        {}
+
+
+####################################################
+# List from a directory
+####################################################
+
+# match what is not a test
+set testRegExp \
+	"^(Applet_GridTest|modeles|scripts|data|bin|help|begin.*|begin_wnt|end.*|grid|executables|readme|image|save|read.me|photo.*|.*~|#.*#)$"
+
+proc mkListTests root {
+    global testRegExp  Wok theStation env
+    set l {}
+
+    if {$theStation=="wnt"} {
+	foreach f [exec $env(WOKHOME)\\lib\\wnt\\ls.exe  $root] {
+	    set f [file tail $f]
+	    if [regexp $testRegExp $f] continue
+		lappend l $f
+	}
+    } else {
+        foreach f [glob -nocomplain $root/*] {
+	    set f [file tail $f]
+	    if [regexp $testRegExp $f] continue
+	    lappend l $f
+	}
+    }
+    return [lsort $l]
+}
+
+####################################################
+# Junky Heuristic to compare numbers in tests 
+####################################################
+
+proc floatDifference { line1 line2 } {
+    global DiffTestTolerance 
+    set has_number 0
+    for { set ii 1 } { $ii <= 3 } { incr ii } {
+	for { set jj 1 } { $jj <= 3 } { incr jj } {
+	    set number($ii,$jj) 0.0e0 
+	}
+    }
+    if { [regexp { ([0-9]+\.[0-9]+e-([0-9]+))|([0-9]+\.[0-9]*)} $line1  number(1,1) number(1,2) number(1,3) ] } {
+	if { [regexp { ([0-9]+\.[0-9]+e-([0-9]+))|([0-9]+\.[0-9]*)} $line2 number(2,1) number(2,2)  number(2,3) ] } {
+	    for { set ii 1 } { $ii <= 3 } { incr ii } {
+		if { $number(1,$ii) != "" && $number(2,$ii) != "" } {
+		    if { [ regexp {\.} $number(1,$ii) ] && [ regexp {\.} $number(2,$ii) ] } {
+			set has_number 1 
+			set diff [ expr $number(1,$ii) - $number(2,$ii) ]
+			set diff [ expr abs($diff) ] 
+			if { $diff > $DiffTestTolerance } {
+			    return 1
+			
+			}
+		    }
+		}
+	    }
+			
+	}
+    }
+
+#
+# scabreux mais donne de bon resultat
+#
+    if { $has_number } {
+	return 0
+    } else {
+	return 1 
+    }
+	    
+}
+
+####################################################
+# compute the current test status
+####################################################
+
+proc computeStatus {} {
+    global testRoot resultRoot masterRoot
+    global theUL theFunction theTest
+    global theLog theMasterLog theXWDFiles theMasterXWDFiles
+    global theErrors theStatus theStatusLine theErrorLines theDiffs
+    
+    set hasresult [file readable $theLog]
+    if {! $hasresult} {
+	set theStatus     "-"
+	set theStatusLine "NOLOGFILE"
+	set theErrorLines {}
+	set theDiffs      {}
+	return
+    }
+    set hasmaster [file readable $theMasterLog]
+
+    # analyse the log file and compare to the master
+    set curline    0
+    set error      ""
+    set errorlines {} 
+    set diffs      {}
+    set completed  0
+
+    set f [open $theLog]
+    if $hasmaster {set g [open $theMasterLog]}
+    set moremaster $hasmaster
+
+
+    while {[gets $f line] >= 0} {
+	incr curline
+	# difference with master
+	if {$moremaster} {
+	    if {[gets $g mline] >= 0} {
+		# compare the two lines
+		if { [ string compare $line $mline ] } {
+		    if { [ floatDifference  $mline $line  ] } {
+			lappend diffs $curline
+                    }
+		}
+	    } else {
+		# the master file is finished
+		set moremaster 0
+		lappend ldiff $curline
+	    }
+	}
+
+	# search for errors
+	foreach err $theErrors {
+	    if [regexp [lindex $err 0] $line] {
+		if {[llength $errorlines] == 0} {set error [lindex $err 1]}
+		lappend errorlines $curline
+	    }
+	}
+
+	# check for end of test
+	if [regexp "TEST COMPLETED" $line] {
+	    set completed 1
+	}
+    }
+
+    close $f
+    if $hasmaster {close $g}
+
+    set status "*"
+    set statusline $error
+    if {$error == ""} {
+	if {! $completed} {
+	    set statusline "NOEND    "
+	} else {
+	    set statusline "OK       "
+	    set status " "
+	}
+    }
+
+    if {$hasmaster} {
+	if [llength $diffs] {
+	    append statusline " DIFF"
+	    set status "*"
+	} else {
+	    append statusline " OK  "
+	}
+    } else {
+	    append statusline " NO  "
+    }
+    
+    # xwd files
+
+    if [llength $theXWDFiles] {
+	# here we should compare the XWD files
+	if [llength $theMasterXWDFiles] {
+	    append statusline " OK    "
+	} else {
+	    append statusline " NO    "
+	}
+    } else {
+	    append statusline " NOXWD "
+    }
+    
+    # set results
+    
+    set theStatus     $status
+    set theStatusLine $statusline
+    set theErrorLines $errorlines
+    set theDiffs      $diffs
+}
+
+####################################################
+# trace on variables to update the lists
+####################################################
+
+trace variable theUL w theULProc 
+proc theULProc {name element op} {
+    global theUL testRoot listFunction
+    global theStation
+
+    # Met a jour la liste des fonctions
+    if {$theUL == ""} {
+	set listFunction {}
+    } else {
+	set listFunction [mkListTests $testRoot/$theUL]
+    }
+}
+
+trace variable theFunction w theFunctionProc
+proc theFunctionProc {name element op} {
+    global testRoot theUL theFunction listTest
+    global theStation
+
+    # Met a jour la liste des tests
+    if {$theFunction == ""} {
+	set listTest {}
+    } else {
+	set listTest [mkListTests $testRoot/$theUL/$theFunction]
+    }
+}
+
+trace variable theTest w theTestProc
+proc theTestProc {name element op} {
+    global resultRoot masterRoot theUL theFunction theTest
+    global theLog theMasterLog theXWDFiles theMasterXWDFiles
+    global theStation
+
+    if {$theStation=="wnt"} {
+	
+	# update the result variables
+	set theLog       $resultRoot\\$theUL\\$theFunction\\$theTest.log
+	set theMasterLog $masterRoot\\$theUL\\$theFunction\\$theTest.log
+ 
+	set theXWDFiles \
+		[glob -nocomplain \
+		$resultRoot\\$theUL\\$theFunction\\${theTest}.*.xwd.Z]
+	
+	set theMasterXWDFiles \
+		[glob -nocomplain \
+		$masterRoot\\$theUL\\$theFunction\\${theTest}.*.xwd.Z]
+    } else {
+	# update the result variables
+	set theLog       $resultRoot/$theUL/$theFunction/$theTest.log
+	set theMasterLog $masterRoot/$theUL/$theFunction/$theTest.log
+ 
+	set theXWDFiles \
+		[glob -nocomplain \
+		$resultRoot/$theUL/$theFunction/${theTest}.*.xwd.Z]
+	
+	set theMasterXWDFiles \
+		[glob -nocomplain \
+		$masterRoot/$theUL/$theFunction/${theTest}.*.xwd.Z]
+    }	
+
+    # update the status
+    computeStatus
+}
+
+trace variable listUL w  listULProc
+proc listULProc {name element op} {
+    global listUL theUL
+    if [llength $listUL] {
+	set theUL [lindex $listUL 0]
+    } else {
+	set theUL ""
+    }
+}
+
+trace variable listFunction w  listFunctionProc
+proc listFunctionProc {name element op} {
+    global listFunction theFunction
+    if [llength $listFunction] {
+	set theFunction [lindex $listFunction 0]
+    } else {
+	set theFunction ""
+    }
+}
+
+trace variable listTest w  listTestProc
+proc listTestProc {name element op} {
+    global listTest theTest
+    if [llength $listTest] {
+	set theTest [lindex $listTest 0]
+    } else {
+	set theTest ""
+    }
+}
+
+####################################################
+# procedure to change test
+####################################################
+
+proc nextUL {} {
+    global listUL theUL
+    set l [llength $listUL]
+    if ($l) {
+	set i [lsearch $listUL $theUL]
+	incr i
+	if {$i < $l} {
+	    set theUL [lindex $listUL $i]
+	    return
+	}
+    }
+    set theUL ""
+}
+
+proc nextFunction {} {
+    global listFunction theFunction
+    set l [llength $listFunction]
+    if ($l) {
+	set i [lsearch $listFunction $theFunction]
+	incr i
+	if {$i < $l} {
+	    set theFunction [lindex $listFunction $i]
+	    return
+	}
+    }
+    nextUL
+}
+
+proc nextTest {} {
+    global listTest theTest
+    set l [llength $listTest]
+    if ($l) {
+	set i [lsearch $listTest $theTest]
+	incr i
+	if {$i < $l} {
+	    set theTest [lindex $listTest $i]
+	    return
+	}
+    }
+    nextFunction
+}
+
+proc nextWithResult {} {
+    global theUL theTest theStatus
+    while 1 { 
+	nextTest
+	if {$theUL == ""} break
+	if {$theTest == ""} continue
+	if {$theStatus == "-"} continue
+	break
+    }
+}
+
+proc nextWithError {} {
+    global theStatus theUL
+    while 1 {
+	nextWithResult
+	if {$theUL == ""} break
+	if {$theStatus == "*"} break
+    }
+}
+
+####################################################
+# run the current Test
+####################################################
+
+proc runTest {} {
+    global themode theDraw Drawid 
+    global RESULT PREVIOUS TEMP DIFF FILTRE
+    global testRoot resultRoot theExec theLog
+    global theUL theFunction theTest
+    global ExePath  ExeMachinePath
+    global theStation theTmp theDrawHome theTmp1
+    global cmdexec protect
+    global testRootNT env
+    
+    
+    puts "  theUL $theUL theFunction $theFunction test  $theTest "
+    puts "thest == $theStation"
+    
+    if {$theTest == ""} return
+    
+    set exe $theExec
+    
+    if {$exe == "" } {
+
+	if {$theStation=="wnt"} { 
+	    set exe "${ExePath}\\T${theUL}\\${ExeMachinePath}\\T${theUL}"
+	} else {
+	    set exe "${ExePath}/T${theUL}"
+	}
+    }
+    
+    if {![file exists $resultRoot]} {
+	if {$theStation=="wnt"} {
+	    set stat1 [catch {file mkdir $resultRoot} iscreated ]
+	    #	    [exec $cmdexec $resultRoot] 
+	} else {
+	    catch {exec mkdir $resultRoot}
+	    catch {exec chmod 777 $resultRoot}
+	}
+    }
+    
+    cd $resultRoot
+    
+    if {![file isdirectory $resultRoot/$theUL]} {
+	if { $theStation == "wnt" }  {
+	    set statpop [catch {file mkdir $resultRoot/$theUL} erreurfile ]
+	    if { $statpop != 0 } { puts "erreurfile == $erreurfile " }
+	    #	    [exec $cmdexec $protect $theUL]
+	} else {
+	    catch {exec mkdir $resultRoot/$theUL}
+	    catch {exec chmod 777 $resultRoot/$theUL}
+	}
+    }
+    
+    cd $resultRoot/$theUL
+    
+    if {![file isdirectory $resultRoot/$theUL/$theFunction]} {
+	if {$theStation=="wnt"} {
+            set stat1 [catch {file mkdir $resultRoot/$theUL/$theFunction} iscreated ]
+	    if {$stat1 != 0 } { puts "iscreated == $iscreated " }
+	    #		[exec $cmdexec $protect $theUL]
+	} else {
+	    catch {exec mkdir $resultRoot/$theUL/$theFunction}
+	    catch {exec chmod 777 $resultRoot/$theUL/$theFunction}
+	}
+    }
+    cd $resultRoot/$theUL/$theFunction
+    
+    # run the test
+    if {$theStation=="wnt"} {
+	catch {file delete $theLog}
+    } else {
+	catch {exec rm -f $theLog}
+    }
+    
+    foreach f [glob -nocomplain ${theTest}.*.xwd.Z] {catch {exec $cmdexec $del $f}}
+   
+
+    if {$theStation=="wnt"} {
+	set f  $resultRoot/$theUL/$theFunction/${theTest}[pid]
+	set f1 $resultRoot/$theUL/$theFunction/${theTest}[pid]
+    	set ff [open $f1 w]
+    } else {
+	set f /tmp/theTest[pid]
+	set ff [open $f w]
+    }
+    ## send current infos in "begin" script for customize by AQ Team  -plb/14feb97-
+    puts $ff "set testinfos(resultRoot)  $resultRoot"
+    puts $ff "set testinfos(theUL)       $theUL"
+    puts $ff "set testinfos(theFunction) $theFunction"
+    puts $ff "set testinfos(theTest)     $theTest"
+    if {$themode == "samedraw"} {
+	puts $ff "cd $resultRoot/$theUL/$theFunction"
+    }
+    
+    close $ff
+
+    puts "testRoot $testRoot"
+
+    cd $resultRoot/$theUL/$theFunction
+
+    if {$theStation=="wnt"} {
+	set fff  $resultRoot/$theUL/$theFunction/${theTest}[pid]-pop
+	set fpop [open $fff w]
+	for_file line $f1                                    { puts $fpop $line }
+	for_file line $testRoot/begin                        { puts $fpop $line }
+	if {[file exist  $testRoot/$theUL/begin_wnt  ] } { 
+	    for_file line $testRoot/$theUL/begin_wnt             { puts $fpop $line }
+	}
+	if {[file exist  $testRoot/$theUL/$theFunction/begin_wnt]} {
+	    for_file line $testRoot/$theUL/$theFunction/begin_wnt { puts $fpop $line }
+	} else {
+	    if {[file exist  $testRoot/$theUL/$theFunction/begin]} {
+		for_file line $testRoot/$theUL/$theFunction/begin { puts $fpop $line }
+	    }
+	}	
+	for_file line $testRoot/$theUL/$theFunction/$theTest { puts $fpop $line }
+	if { [ file exists $testRoot/$theUL/end ] } {
+	    for_file line $testRoot/$theUL/end                   { puts $fpop $line }
+	}
+	if { [ file exists $testRoot/end ] } {
+	    for_file line $testRoot/end                          { puts $fpop $line }
+	}
+	puts $fpop "exit"
+	if {[file exist $resultRoot/$theUL/$theFunction/${theTest}[pid] ] } {
+	    file delete $resultRoot/$theUL/$theFunction/${theTest}[pid]
+	}
+	close $fpop
+	file copy $fff $f1
+	file delet $fff
+    } else {
+	catch {exec cat -s \
+		   $testRoot/begin \
+		   $testRoot/$theUL/begin \
+		   $testRoot/$theUL/$theFunction/begin \
+		   $testRoot/$theUL/$theFunction/$theTest \
+		   $testRoot/$theUL/$theFunction/end \
+		   $testRoot/$theUL/end \
+		   $testRoot/end >> $f}
+	
+	set testroot $testRoot
+    }
+    if {$theStation=="wnt"} {
+	set f3 $resultRoot/$theUL/$theFunction/${theTest}.log
+	if { [file exists $f3] } { file delete $f3 } 
+	puts "l'executable == $exe"
+	puts "testRoot == $testRoot"
+	#puts "input  == $f1"
+	#puts "output == $f3"
+	catch { exec $exe -f $f1 -o $f3 } popstatus
+	puts $popstatus
+	
+    } else {
+	if {$themode != "samedraw" } {
+	    catch { exec $exe -f $f >& ${theTest}.log }
+	} else {
+	    # the draw est il toujours valide ?
+	    set myList [winfo interps]
+	    set DrawExists "0"
+	    for {set i 0} { $i < [expr [llength $myList]] } { incr i } {
+		set p [lindex $myList $i]
+		if {$p == $theDraw} {set DrawExists "1"}
+	    }
+	    if { $DrawExists == "0"} {
+		puts "Pas de Draw, on en lance un !!"
+	    }
+	    while { $DrawExists == "0"} {
+		set myList [winfo interps]
+		set mylen [llength $myList]
+		while { [catch { exec $theExec -l >& $RESULT & } message] } {
+		    puts $message
+		}
+		set Drawid $message
+		# On espere avoir lance un draw, on recupere son nom
+		# comme on peut. La methode utilisee est extremement
+		# plantatoire, il faudrait pouvoir trouver le numero
+		# du process !?!
+		set i 0
+		while { $myList == [winfo interps] && [expr $i] < 20 } {
+		    sleep 1
+		    puts "1s d attente"
+		    incr i
+		}
+		if {  [expr $i] < 20 } {
+		    sleep 2
+		    puts "2s d attente"
+		    set newList [winfo interps]
+		    set newlen [llength $newList]
+		    set theDraw ""
+		    puts $myList
+		    puts $newList
+		    for {set i 0} { $i < [expr $newlen] && !$DrawExists } { incr i } {
+			set DrawExists 1
+			set theDraw [lindex $newList $i]
+			for {set j 0} { $j < [expr $mylen]} {incr j} {
+			    set p [lindex $myList $j]
+			    if { $p == $theDraw} {
+				set DrawExists 0
+			    }
+			}
+		    }
+		}
+		if { $DrawExists } {
+		    puts "nouvelle appli : $theDraw"
+		} else {
+		    puts "echec creation nouveau Draw, on recommence"
+		    set theDraw ""
+		    if { [catch { exec kill -9 $Drawid } mes] } { 
+			puts $mes 
+		    } else {
+			puts "le process etait bien la, mais le Draw n est pas venu!?!"
+		    }
+		}
+	    }
+	    
+	    exec cp $RESULT $PREVIOUS
+	    
+	    if { [catch {send $theDraw "source $f"} mes]} {
+		puts $mes
+		puts "on tue le Draw"
+		set theDraw ""
+		if { [catch { exec kill -9 $Drawid } mes] } { puts $mes }
+	    }
+
+	    catch {exec $DIFF $PREVIOUS $RESULT > $TEMP}
+	    catch {exec cat $TEMP | $FILTRE >> ${theTest}.log}
+	}
+	
+    }
+    
+
+    if {$theStation=="wnt"} {
+	catch {file delete $f1} 
+    } else {
+        catch {exec rm -f $f}
+    }
+    
+    if { $theStation == "wnt" } {
+    	catch {exec $cmdexec attrib ${theTest}.log}
+    } else {
+	catch { exec chmod 666 ${theTest}.log }
+    }
+    
+    
+    # process photos    
+    foreach f [glob -nocomplain photo*] {
+	set g $theTest.[string range $f 5 end].xwd
+	puts "Processing $g"
+	if {$theStation=="wnt"} { 
+	    catch {exec $cmdexec $move $f $g}
+	} else {
+	    catch { exec mv -f $f $g }
+	}
+	catch {exec compress $g}
+	if {$theStation=="wnt"} { 
+	    catch { exec $cmdexec attrib $g.Z }
+	} else {
+	    catch { exec chmod 666 $g.Z }
+	}
+    }
+    
+    #enforce update
+    set theTest $theTest
+}
+
+####################################################
+# send the current test 
+# to the process $theDraw
+####################################################
+
+proc sendTest {} {
+    global testRoot resultRoot theExec theLog theDraw
+    global theUL theFunction theTest
+    global theStation
+    
+    if {$theTest == ""} return
+    
+    puts "Sending $theUL $theFunction $theTest to $theDraw"
+    if {$theStation=="wnt"} {
+	set f  $resultRoot\\\\$theUL\\\\$theFunction\\\\${theTest}[pid]
+	set f1 $resultRoot\\\\$theUL\\\\$theFunction\\\\${theTest}[pid]
+	set f2 $resultRoot\\\\$theUL\\\\$theFunction\\\\${theTest}.log
+    	set ff [open $f1 w]
+    	set gg [open $f2 w]
+	#set ff2 [open $f2 w]
+	puts $ff "set testroot $testRootNT"
+    } else {
+	set f /tmp/theTest[pid]
+	set ff [open $f w]
+	puts $ff "set testroot $testRoot"
+    }
+    
+## send current infos in "begin" script for customize by AQ Team  -plb/14feb97-
+    puts $ff "set testinfos(resultRoot)  $resultRoot"
+    puts $ff "set testinfos(theUL)       $theUL"
+    puts $ff "set testinfos(theFunction) $theFunction"
+    puts $ff "set testinfos(theTest)     $theTest"
+    close $ff
+
+    if {$theStation=="wnt"} {
+	set stat1 [catch {exec cmd /C copy /A \ $f1 + $testRoot\\begin + $testRoot\\$theUL\\begin_wnt + $testRoot\\$theUL\\$theFunction\\begin + $testRoot\\$theUL\\$theFunction\\$theTest + $testRoot\\$theUL\\$theFunction\\end + $testRoot\\$theUL\\end + $testRoot\\end + $f1} myerro]
+	send $theDraw "source $f1"
+    } else {
+	catch {exec cat -s \
+		   $testRoot/$theUL/begin \
+		   $testRoot/$theUL/$theFunction/begin \
+		   $testRoot/$theUL/$theFunction/$theTest \
+		   $testRoot/$theUL/$theFunction/end \
+		   $testRoot/$theUL/end  >> $f}
+	send $theDraw "source $f"
+    }
+}
+
+####################################################
+# clear result, copy master
+####################################################
+
+proc clearResult {} {
+    global theTest theLog theXWDFiles
+    catch {exec rm -f $theLog}
+    foreach f  $theXWDFiles {catch {exec rm -f $f}}
+
+    #enforce update
+    set theTest $theTest
+}
+
+proc copyMaster {} {
+
+    global theLog theXWDFiles
+    global theMasterLog theMasterXWDFiles
+    global masterRoot theUL theFunction theTest
+
+    catch {exec rm -f $theMasterLog}
+    foreach f $theMasterXWDFiles {catch {exec rm -f  $f}}
+
+    if {![file isdirectory $masterRoot/$theUL]} {
+	if {$theStation=="wnt"} {
+		cd $masterRoot
+		file mkdir $theUL
+		#catch {exec $cmdexec mkdir $masterRoot\\$theUL}
+		#catch {exec $cmdexec $protect $masterRoot\\$theUL}
+	} else {
+	    catch {exec mkdir $masterRoot/$theUL}
+	    catch {exec chmod 777 $masterRoot/$theUL}
+	}
+    }
+
+    if {![file isdirectory $masterRoot/$theUL/$theFunction]} {
+	if {$theStation=="wnt"} {
+		cd $theUL
+		file mkdir $theFunction
+		#catch {exec $cmdexec mkdir $masterRoot\\$theUL\\$theFunction}
+		#catch {exec $cmdexec $protect $masterRoot\\$theUL\\$theFunction}
+	} else {
+	    catch {exec mkdir $masterRoot/$theUL/$theFunction}
+	    catch {exec chmod 777 $masterRoot/$theUL/$theFunction}
+	}
+    }
+
+    if {$theStation=="wnt"} {set d $masterRoot\\$theUL\\$theFunction
+} else {set d $masterRoot/$theUL/$theFunction}
+    if [file readable $theLog] {catch {exec cp $theLog $d}}
+    foreach f $theXWDFiles {catch {exec cp $f $d}}
+
+    # enforce update
+    set theTest $theTest
+}
+
+####################################################
+# Make the initial list of UL
+####################################################
+
+proc init {} {
+    global listUL testRoot
+    set listUL [mkListTests $testRoot]
+}

src/DrawResources/VisualizationDemo.tcl

@@ -0,0 +1,156 @@
+
+set stationname $tcl_platform(platform)
+if { ${stationname} == "windows" } {
+   proc winfo { aTest aWindow } { return False }
+}
+
+
+proc sage { a} {
+    global stationname 
+    if { ${stationname} != "windows" } {
+	
+	if { ![winfo exists .h ] } {
+	    toplevel .h -bg azure3
+	    wm title .h "INFO AISViewer"
+	    wm geometry .h +320+20
+	    
+	} 
+	if { [winfo exists .h.m ] } {
+	    set astring [.h.m cget  -text]
+	    set newstring "${astring} \n $a"
+	    .h.m configure -text $newstring 
+	    puts $a
+	} else {
+	    message .h.m -justify left -bg azure2 -width 13c -relief ridge -bd 4\
+		    -text $a
+	    puts $a
+	} 
+	pack .h.m
+	update
+   }
+}
+
+if { [winfo exists .h ] } {
+    destroy .h
+}
+
+sage " Creating the V3D Viewer"
+sage "    vinit"
+sage " " 
+vinit
+vclear
+clear
+
+sage " Creating the Topological Viewer"
+sage "    smallview"
+sage " " 
+smallview
+sage " Creating a box"
+sage "    box  b -10 -10 -10 20 20 20"
+sage " "
+box b -10 -10 -10 20 20 20
+fit
+sage " Display the box in the V3D Viewer"
+sage "    vdisplay b"
+sage " "
+vdisplay b
+vfit
+nexplode b f
+erase b
+sage " Draft of two lateral faces "
+sage "    nexplode b f"
+sage "    depouille r b  0 0  -1 b_6 -15 10 -10 10  0 0 -1 "
+sage "    nexplode r f"
+sage "    depouille rr r  0 0 -1   r_1 -15 -10 -10 10  0 0 -1 "
+sage " "
+depouille r b  0 0  -1 b_6 -15 10 -10 10  0 0 -1 
+clear
+nexplode r f
+depouille rr r  0 0 -1   r_1 -15 -10 -10 10  0 0 -1 
+clear
+nexplode rr e
+verase b
+vdisplay rr
+vfit
+sage " Fillet on four lateral edges, then on the top and bottom edges  "
+sage "    nexplode rr e"
+sage "    blend result rr 3 rr_2 3 rr_3 3 rr_10 3 rr_11"
+sage "    nexplode result e"
+sage "    blend result result 2 result_11 3 result_12"
+sage " "
+blend result rr 3 rr_2 3 rr_3 3 rr_10 3 rr_11
+erase rr
+erase result
+nexplode result e
+blend result result 2 result_11 3 result_12 
+clear
+nexplode result f
+verase rr
+vdisplay result
+vfit
+sage " Creating a profile on the top face "
+sage "    nexplode result f"
+sage "    profile p  S result_16 F 10 4 D 1 0 C 2 90. Y 8 C 2 90. X -2 C 2 90. Y -8 C 2 90. X 2
+"
+sage " "
+profile p  S result_16 F 10 4 D 1 0 C 2 90. Y 8 C 2 90. X -2 C 2 90. Y -8 C 2 90. X 2
+sage " Creating a prism"
+sage "    prism rr p 0 0 20"
+sage " "
+prism rr p 0 0 20
+sage " Change some attributs : MATERIAL , TRANSPARENCY"
+sage "    vsetmaterial rr PLASTIC"
+sage "    vsetcolor rr RED"
+sage "    vsettransparency result 0.5"
+sage "    vsetdispmode 1"
+sage " "
+vdisplay rr
+vsetmaterial rr PLASTIC
+vsettransparency rr 0.5
+vsetcolor rr RED
+vsettransparency result 0.5
+vsetdispmode 1
+vfit
+fit
+sage " Fusion of this prism with the original part "
+sage "    fuse result rr result"
+sage " "
+fuse result rr result
+donl result
+vdisplay result
+vdonly result
+vfit
+nexplode result f
+erase result
+fit
+
+sage " Opening the top face"
+sage "    offsetshape r result -1 0.0001 result_17"
+sage " "
+nexplode result f
+
+offsetshape r result -1 0.0001 result_17
+vdisplay r
+vdonly r
+vfit
+vsetcolor r MATRABLUE
+vsettransparency r 0
+
+sage " Creating a cylinder and positionning it"
+sage "    pcylinder cyl 2 300"
+sage "    trotate cyl cyl 0 0 0  1 0 0 45"
+sage "    ttranslate cyl cyl 0 7.5 0"
+sage " "
+pcylinder cyl 2 30
+vdisplay cyl 
+vsetcolor cyl RED
+vfit
+trotate cyl cyl 0 0 0  1 0 0 45
+ttranslate cyl cyl 0 7.5 0
+vdisplay cyl 
+vsetcolor cyl RED
+vfit
+vdisplay cyl 
+vsetcolor cyl RED
+vfit
+sage "Demo completed"

src/DrawResources/WOKcomplement.tcl

@@ -0,0 +1,29 @@
+##########################################################
+#
+#  find the name of the station
+#
+proc wokstation {} {
+    set LINE_FROM_UNAME [ exec uname -a ] ;
+    if { [ regexp SunOS $LINE_FROM_UNAME ] } {
+	return "sun"
+    } 
+    elseif { [ regexp IRIX $LINE_FROM_UNAME ] } {
+	return "sil"
+    }
+    elseif { [ regexp OSF $LINE_FROM_UNAME ] } {
+	return "ao1" 
+    }
+    elseif { [ regexp HP-UX $LINE_FROM_UNAME ] } {
+	return "hp"
+    }
+    elseif { [ regexp FreeBSD $LINE_FROM_UNAME ] } {
+	return "bsd"
+    }
+    elseif { [ regexp Darwin $LINE_FROM_UNAME ] } {
+	return "mac"
+    }
+    else {
+	return "unknown"
+    }
+    
+}

src/DrawResources/demo

@@ -0,0 +1,46 @@
+#!/bin/csh -f
+#
+# This is a simple script demo for Draw Module on Unix platform.
+#
+# The V.E. CASROOT must be setted to the directory where CasCade 3.0 has been
+# downloaded.
+#
+setenv station `uname`
+if ( ${station} == "IRIX64" ) setenv station IRIX
+
+if (! ($?LD_LIBRARY_PATH) ) setenv LD_LIBRARY_PATH ""
+setenv LD_LIBRARY_PATH "${CASROOT}/${station}/lib:${LD_LIBRARY_PATH}"
+
+if ( ${station} == "AIX" ) then
+   setenv LIBPATH ${LD_LIBRARY_PATH}
+endif
+if ( ${station} == "HP-UX" ) then
+   setenv SHLIB_PATH ${LD_LIBRARY_PATH}
+endif
+if ( ${station} == "Linux" ) then
+   setenv LIBPATH "/usr/X11R6/lib:${LD_LIBRARY_PATH}"
+endif
+
+#
+# This is for setting VE used by Draw
+#
+# POP : Since C31 Version ; this Varaible are not Mandatory
+#setenv DRAWHOME    $CASROOT/src/DrawResources
+#setenv DRAWDEFAULT $DRAWHOME/DrawDefault
+echo ""
+echo " Running demo using :"
+echo ""
+echo "LD_LIBRARY_PATH : $LD_LIBRARY_PATH"
+echo "CASROOT         : $CASROOT"
+if ($?DRAWHOME)    then 
+    echo "DRAWHOME        : $DRAWHOME"
+endif
+if ($?DRAWDEFAULT) then
+    echo "DRAWDEFAULT     : $DRAWDEFAULT"
+endif
+#
+# Run the executable.
+#
+$CASROOT/${station}/bin/TTOPOLOGY
+#
+exit

src/DrawResources/demo.bat

@@ -0,0 +1,40 @@
+echo ON
+
+echo " Open CASCADE "
+
+if not DEFINED CASROOT     echo CASROOT is mandatory
+
+if %PROCESSOR_ARCHITECTURE% EQU x86 Set STATION=Windows_NT
+
+
+
+rem =========================================
+rem
+rem    LD_LIBRARY_PATH definition 
+rem
+rem =========================================
+
+if NOT DEFINED OLDPATH set OLDPATH=%PATH%
+
+
+
+set PATH=%PATH%;%CASROOT%\%STATION%\dll;
+
+rem the Path where Tcl is installed
+
+set PATH=D:/DevTools/Tcltk/bin/;%PATH%;
+
+rem ======================================
+
+
+Set DrawExe=%CASROOT%\%STATION%\bin\TTOPOLOGY.exe
+
+# POP : Since C31 Version ; this Varaible are not Mandatory
+rem if not DEFINED DRAWHOME    Set DRAWHOME=%CASROOT%/src/DrawResources
+rem if not DEFINED DRAWDEFAULT set DRAWDEFAULT=%DRAWHOME%\\DrawDefault
+
+Set MMGT_CLEAR=1
+%DRAWEXE% 
+
+
+

src/DrawResources/demo.tcl

@@ -0,0 +1,116 @@
+
+set stationname $tcl_platform(platform)
+if { ${stationname} == "windows" } {
+   proc winfo { aTest aWindow } { return False }
+}
+
+
+proc sage { a} {
+    global stationname 
+    if { ${stationname} != "windows" } {
+	
+	if { ![winfo exists .h ] } {
+	    toplevel .h -bg azure3
+	    wm title .h "INFO TEST HARNESS"
+	    wm geometry .h +320+20
+	    
+	} 
+	if { [winfo exists .h.m ] } {
+	    set astring [.h.m cget  -text]
+	    set newstring "${astring} \n $a"
+	    .h.m configure -text $newstring 
+	    puts $a
+	} else {
+	    message .h.m -justify left -bg azure2 -width 13c -relief ridge -bd 4\
+		    -text $a
+	    puts $a
+	} 
+	pack .h.m
+	update
+   }
+}
+
+
+smallview
+if { [winfo exists .h ] } {
+    destroy .h
+}
+sage " Creating a box"
+sage "    box  b -10 -10 -10 20 20 20"
+sage " "
+box b -10 -10 -10 20 20 20
+fit
+nexplode b f
+erase b
+sage " Draft of two lateral faces "
+sage "    depouille r b  0 0  -1 b_6 -15 10 -10 10  0 0 -1 "
+sage "    nexplode r f"
+sage "    depouille rr r  0 0 -1   r_1 -15 -10 -10 10  0 0 -1 "
+sage " "
+depouille r b  0 0  -1 b_6 -15 10 -10 10  0 0 -1 
+clear
+nexplode r f
+depouille rr r  0 0 -1   r_1 -15 -10 -10 10  0 0 -1 
+clear
+nexplode rr e
+sage " Fillet on four lateral edges, then on the top and bottom edges  "
+sage "    nexplode rr e"
+sage "    blend result rr 3 rr_2 3 rr_3 3 rr_10 3 rr_11"
+sage "    nexplode result e"
+sage "    blend result result 2 result_11 3 result_12"
+sage " "
+blend result rr 3 rr_2 3 rr_3 3 rr_10 3 rr_11
+erase rr
+erase result
+nexplode result e
+blend result result 2 result_11 3 result_12 
+clear
+nexplode result f
+sage " Creating a profile on the top face "
+sage "    nexplode result f"
+sage "    profile p  S result_16 F 10 4 D 1 0 C 2 90. Y 8 C 2 90. X -2 C 2 90. Y -8 C 2 90. X 2
+"
+sage " "
+profile p  S result_16 F 10 4 D 1 0 C 2 90. Y 8 C 2 90. X -2 C 2 90. Y -8 C 2 90. X 2
+sage " Creating a prism"
+sage "    prism rr p 0 0 20"
+sage " "
+prism rr p 0 0 20
+fit
+sage " Fusion of this prism with the original part "
+sage "    fuse result rr result"
+sage " "
+fuse result rr result
+donl result
+nexplode result f
+erase result
+fit
+
+sage " Opening the top face"
+sage "    offsetshape r result -1 0.0001 result_17"
+sage " "
+
+nexplode result f
+offsetshape r result -1 0.0001 result_17
+sage " Creating a cylinder and positionning it"
+sage "    pcylinder cyl 2 300"
+sage "    trotate cyl cyl 0 0 0  1 0 0 45"
+sage "    ttranslate cyl cyl 0 7.5 0"
+sage " "
+pcylinder cyl 2 30
+trotate cyl cyl 0 0 0  1 0 0 45
+ttranslate cyl cyl 0 7.5 0
+sage " Display the Shape on Hidden Line Mode "
+sage "   hlr hid r"
+sage ""
+donl r
+hlr hid r
+sage " Display the Shape on HLR Mode "
+sage "   hlr nohid r"
+sage "   hlr hlr r"
+sage ""
+donl r
+hlr nohid r
+hlr hlr r
+sage "Demo completed"
+

src/DrawResources/idoc

@@ -0,0 +1,170 @@
+#!/bin/sh
+# The next line is executed by /bin/sh, but not Tcl \
+  exec tclsh $0 ${1+"$@"}
+
+source $env(DRAWHOME)/Documentation.tcl
+
+#
+# format a documentation for info
+#
+
+proc putText {aText} {
+    global theFile
+    foreach line $aText {puts $theFile $line}
+}
+
+proc infoSection {aSection aText} {
+    global theFile index theTitle
+
+    # check if text is empty
+    set empty 1
+    foreach line $aText {
+	if {![regexp {^[ \t]*$} $line]} {
+	    set empty 0
+	    break
+	}
+    }
+    if $empty return
+
+    if {$aSection == ""} {
+	putText $aText
+	return
+    }
+
+    switch $aSection {
+		
+	.Synopsis  {
+	    puts $theFile "\nSYNOPSIS\n"
+	    putText $aText
+	}
+	
+	.Purpose    {
+	    puts $theFile "\nPURPOSE\n"
+	    putText $aText
+	}
+	
+	.Example    {
+	    puts $theFile "\nEXAMPLE\n"
+	    putText $aText
+	}
+	
+	".See also" {
+	    puts $theFile "\nSEE ALSO\n"
+	    putText $aText
+	}
+	
+	.Warning    {
+	    puts $theFile "\nWARNINGS\n"
+	    putText $aText
+	}
+	
+	.Warning    {
+	    puts "\n"
+	    putText $aText
+	}
+	
+	.Text    {
+	    putText $aText
+	}
+	
+	.Index      {
+	    foreach word $aText {
+		if {$word != ""} {
+		    set index($word) $theTitle
+		}
+	    }
+	}
+    }
+}
+
+proc dumpInfo {title ftitle up prev next} {
+    global theFile subTitles texts
+    global theTitle
+    if {![info exists texts($ftitle)] &&
+    ![info exists subTitles($ftitle)]} return
+
+    set theTitle $title
+    puts $theFile ""
+    puts $theFile "Node: $title,  Prev: $prev,  Next: $next,  Up: $up,"
+    puts $theFile ""
+
+    if [info exists texts($ftitle)] {
+	sectionText $texts($ftitle) infoSection
+    }
+    if [info exists subTitles($ftitle)] {
+	puts $theFile "\n\n* Menu:\n"
+	foreach t $subTitles($ftitle) {
+	    puts $theFile  "* $t::"
+	}
+	puts $theFile ""
+	set p ""
+	set l [lrange $subTitles($ftitle) 1 end]
+	foreach t $subTitles($ftitle) {
+	    dumpInfo $t [concat $ftitle $t] $title $p [lindex $l 0]
+	    set p $t
+	    set l [lrange $l 1 end]
+	}
+    }
+}
+
+# compare without case, used for sorting the index
+proc cmp {s1 s2} {
+    return [string compare [string tolower $s1] [string tolower $s2]]
+}
+
+proc dumpIndex {} {
+    global index theFile
+    
+    puts $theFile ""
+    puts $theFile "Node: Index,  Up: Top,"
+    puts $theFile ""
+    if [info exists index] {
+	set l 0
+	foreach word [array names index] {
+	    set ll [string length $word]
+	    if {$ll > $l} {set l $ll}
+	}
+	incr l 2
+	set letter ""
+	foreach word [lsort -command cmp [array names index]] {
+	    puts -nonewline $theFile $word
+	    for {set ll [string length $word]} {$ll < $l} {incr ll} {
+		puts -nonewline $theFile " "
+	    }
+	    puts $theFile "*Note $index($word)::"
+	}
+    }
+}
+
+#
+# process arguments
+#
+
+if {$argc < 1} {
+    puts "idoc docfile upnode"
+    puts "create an info file form a doc file, upnode is the up node of Top"
+    exit
+}
+
+set file [lindex $argv 0]
+set up ""
+if {$argc > 1} {set up [lindex $argv 1]}
+
+if [file readable $file] {
+    readFile $file
+    set file [file rootname $file]
+    # add a menu for the index
+    lappend subTitles(Top) Index
+    
+    global theFile
+    set theFile [open $file.info "w"] 
+    puts $theFile ""
+    dumpInfo Top Top $up "" ""
+    dumpIndex
+    close $theFile
+    puts "$file.info created"
+} else {
+    puts "Cannot open $file for reading"
+}
+
+

src/DrawResources/mdltest

@@ -0,0 +1,236 @@
+#!/bin/sh
+# The next line is executed by /bin/sh, but not Tcl \
+  exec tclsh $0 ${1+"$@"}
+
+
+
+#
+#  suite au passage a tk4.1 on a plus besoin des references
+#  a TCL-1-1
+#
+# batch test command
+##########################################################
+#
+#  initialisation de  env(STATION)  
+#                     env(WBCONTAINER)
+#                     env(WBROOT)      
+#
+
+#package require Tk
+
+puts $env(DRAWHOME)
+source $env(DRAWHOME)/InitEnvironment.tcl
+
+source $env(DRAWHOME)/Tests.tcl
+
+# xab : 22/11/96  : on a encore besoin des 3 variables d'environement
+#                   WBCONTAINER
+#                   WBROOT
+#                   STATION
+#   usage
+#
+proc help {} {
+    global resultRoot masterRoot testRoot
+    puts {mdltest -h -hc -c -l -x executable -t testdir -r resultdir -m masterdir UL function test}
+    puts ""
+    puts "Run & compare modeling team tests."
+    puts ""
+    puts "-hc help on comparisons"
+    puts "-l  only list the tests"
+    puts "-c  performs only the comparisons"
+    puts "-o  executable is run once for all tests"
+    puts ""
+    puts "-x executable : to run the test"
+    puts "   none        use the executable TUL for each UL"
+    puts "   -x compare  performs only the comparisons"
+    puts "   -x list     only list the tests"
+    puts ""
+    puts "-t testdir   : root of the test hierarchy"
+    puts "   default   : $testRoot"
+    puts ""
+    puts "-r resultdir : to store the results, or source for comparisons"
+    puts "   default   : $resultRoot"
+    puts "   must be a writable directory"
+    puts ""
+    puts "-m masterdir : reference results for comparisons"
+    puts "   default   : $masterRoot"
+    puts ""
+    puts "UL function test : performs this test"
+    puts "UL function      : performs all tests for this function"
+    puts "UL               : performs all tests for all functions of this UL"
+    puts "                 : performs all test"
+    puts ""
+    puts "UL function Test can be patterns (quote to protect from csh)"
+    puts "example : mdltest -l '*' '*curve*'"
+    puts ""
+    exit
+}
+proc helpcomp {} {
+    global theErrors
+    puts ""
+    puts "Result of comparisons"
+    puts "====================="
+    puts ""
+    puts "For each test a status line is displayed of the following format"
+    puts ""
+    puts "xUL Function Test     Result Log XWD"
+    puts ""
+    puts "x is a single caracter : "
+    puts "  ' ' : means no problem"
+    puts "  '-' : means no result fro the test"
+    puts "  '*' : means error detected or difference with the master"
+    puts ""
+    puts "Result is the status of the log file analysis : "
+    foreach err $theErrors {
+	puts "  [lindex $err 1] : means [lindex $err 2]"
+    }
+    puts ""
+    puts "Log is the result of the logfile comparisons"
+    puts "  OK    : means no differences"
+    puts "  NO    : means no master logfile to compare with"
+    puts "  DIFF  : means differences"
+    puts ""
+    puts "XWD is the result of the image comparisons"
+    puts "  OK    : means no differences"
+    puts "  NO    : means no master images to compare with"
+    puts "  DIFF  : means differences"
+
+
+    exit
+}
+
+# analyze arguments
+
+set more 1
+while {$more} {
+    set more 1
+    set shift 2
+    switch -exact a[lindex $argv 0] {
+	"a-x"     {set theExec    [lindex $argv 1]}
+	"a-t"     {set testRoot   [lindex $argv 1]}
+	"a-r"     {set resultRoot [lindex $argv 1]}
+	"a-m"     {set masterRoot [lindex $argv 1]}
+	"a-l"     {set theExec "list"; set shift 1;}
+	"a-c"     {set theExec "compare"; set shift 1;}
+	"a-o"     {set themode "samedraw"; set shift 1;}
+	"a-hc"    {helpcomp}
+	"a-h"     {help}
+	default   {set more 0}
+    }
+    if $more {set argv [lrange $argv $shift end]}
+}
+
+puts ""
+puts "Executable       : $theExec"
+puts "Test   Directory : $testRoot"
+puts "Result Directory : $resultRoot"
+puts "Master Directory : $masterRoot"
+
+if {![file isdirectory $resultRoot]} {
+    puts "$resultRoot is not a directory"
+    exit
+}
+
+set UL       "*"  
+set Function "*"
+set Test     "*"
+
+if {[llength $argv] >= 1} {set UL       [lindex $argv 0]}
+if {[llength $argv] >= 2} {set Function [lindex $argv 1]}
+if {[llength $argv] >= 3} {set Test     [lindex $argv 2]}
+
+puts ""
+puts "UL       : $UL"
+puts "Function : $Function"
+puts "Test     : $Test"
+
+init
+
+# used to compute length for formatting the result
+set l 0
+
+if { $themode == "samedraw" } {
+    set theDraw     ""
+    set FILTRE      "/tmp/FILTRE[pid]"
+    set DIFF        "/tmp/DIFF[pid]"
+    set RESULT      "/tmp/RESULT[pid]"
+    set PREVIOUS    "/tmp/PREVIOUS[pid]"
+    set TEMP        "/tmp/TEMP[pid]"
+    #on compile le Diff et le Filtre a Diff
+    if { [catch { eval "exec $env(MDLTEST_COMPIL) $env(DRAWHOME)/Filtre.c -c -o ${FILTRE}.o" } mes] } { puts $mes }
+    if { [catch { eval "exec $env(MDLTEST_COMPIL) ${FILTRE}.o -o $FILTRE" } mes] } { puts $mes }
+    if { [catch { eval "exec $env(MDLTEST_COMPIL) $env(DRAWHOME)/DIFF.c -c -o ${DIFF}.o" } mes] } { puts $mes }
+    if { [catch { eval "exec $env(MDLTEST_COMPIL) ${DIFF}.o -o $DIFF" } mes] } { puts $mes }
+}
+
+while {$theUL != ""} {
+    if {! [string match $UL $theUL] }            {nextUL; continue;}
+    if {! [string match $Function $theFunction]} {nextFunction; continue;}
+    if {[string match $Test $theTest]} {
+	if [file readable $testRoot/$theUL/$theFunction/$theTest] {
+	    if {$theExec == "list"} {
+		puts "$theUL $theFunction $theTest"
+	    } else {
+		if {$theExec != "compare"} runTest
+		set l2 [string length "$theUL $theFunction $theTest"]
+		if {$l2 > $l} {set l $l2}
+	    }
+	} else {
+	    puts "Test does not exist : $theUL $theFunction $theTest"
+	}
+    }
+    nextTest
+}
+
+# Pour les tests effectues dans 1 seul exe, on sort!!
+if { $themode == "samedraw" } { 
+    catch { send $theDraw "exit" } 
+}
+
+
+# do the comparisons
+
+
+if {$theExec    == "list"} exit
+if {$masterRoot == ""}     exit
+
+set count 1
+incr l 4
+
+init
+
+puts ""
+while {$theUL != ""} {
+    if {! [string match $UL $theUL] }            {nextUL; continue;}
+    if {! [string match $Function $theFunction]} {nextFunction; continue;}
+    if {[string match $Test $theTest]} {
+	if [file readable $testRoot/$theUL/$theFunction/$theTest] {
+	    if {$count == 1} {
+		set s "  UL Function Test"
+		puts -nonewline $s
+		for {set i [string length $s]} {$i <= $l} {incr i} {puts -nonewline " "}
+		puts $theStatusHeader
+	    }
+	    incr count
+	    set s "$theStatus $theUL $theFunction $theTest :"
+	    puts -nonewline $s
+	    for {set i [string length $s]} {$i <= $l} {incr i} {puts -nonewline " "}
+	    puts $theStatusLine
+	}
+    }
+    nextTest
+}
+
+# destruction de la petite fenetre merdique.
+catch { destroy . }
+
+#on vire le Diff et le Filtre a Diff
+if { $themode == "samedraw" } {
+    catch { unlink $FILTRE } 
+    catch { unlink ${FILTRE}.o } 
+    catch { unlink $DIFF } 
+    catch { unlink ${DIFF}.o } 
+    catch { unlink $RESULT } 
+    catch { unlink $PREVIOUS } 
+    catch { unlink $TEMP } 
+}

src/DrawResources/mkdoc

@@ -0,0 +1,23 @@
+#!/bin/csh
+
+# make the big doc
+
+echo making DRAW.doc
+wget DRAW.doc
+set draw = `locate Draw::source:::Draw.doc`
+set geo  = `locate GeometryTest::source:::GeometryTest.doc`
+set topo = `locate BRepTest::source:::BRepTest.doc`
+
+cat $draw $geo $topo > DRAW.doc
+wput DRAW.doc
+
+# make the postscript
+
+echo making postscript
+tdoc DRAW.doc "Draw Reference Manual"
+
+# make the info
+
+echo making info
+idoc DRAW.doc '(MODEL)'
+cp DRAW.info $WBCONTAINER/info

src/DrawResources/tdoc

@@ -0,0 +1,232 @@
+#!/bin/sh
+# The next line is executed by /bin/sh, but not Tcl \
+  exec tclsh $0 ${1+"$@"}
+
+source $env(DRAWHOME)/Documentation.tcl
+
+#
+# format a documentation for troff
+#
+
+# proc ot manage keeping of lines together
+proc keep {} {
+    global theFile keeping
+    if {! $keeping} {
+	puts $theFile ".KS"
+    }
+    set keeping 1
+}
+
+proc endkeep {} {
+    global theFile keeping
+    if {$keeping} {
+	puts $theFile ".KE"
+    }
+    set keeping 0
+}
+
+proc troffTitle {title level} {
+    global theFile
+
+    endkeep
+
+    # set the header
+    puts $theFile ".ds LH $title"
+
+    # try to keep command titles with their synopsis
+    if {$level == 3} keep
+
+    puts $theFile ".NH $level"
+    puts $theFile $title
+    puts $theFile ".XS"
+    for {set i 1} {$i <= $level} {incr i} {puts -nonewline $theFile "  "}
+    puts $theFile $title
+    puts $theFile ".XE"
+}
+
+proc putText {aText} {
+    global theFile
+    foreach line $aText {
+	regsub -all {\\} $line "\\e" l
+	puts $theFile $l
+    }
+}
+
+proc troffSection {aSection aText} {
+    global theFile ExNumber fill
+
+    # check if text is empty
+    set empty 1
+    foreach line $aText {
+	if {![regexp {^[ \t]*$} $line]} {
+	    set empty 0
+	    break
+	}
+    }
+    if $empty return
+
+    if {$aSection == ""} {
+	if {$fill} {puts $theFile ".PP"} else {puts $theFile ".LD\n.R"}
+	putText $aText
+	if {! $fill} {puts $theFile ".DE"}
+	return
+    }
+
+    switch $aSection {
+		
+	.Synopsis  {
+	    puts $theFile ".LD\n.R"
+	    putText $aText
+	    puts $theFile ".DE"
+	}
+	
+	.Purpose   {
+	    puts $theFile ".B Purpose\n.PP"
+	    putText $aText
+	    # Synopsis and purpose are kept with command title
+	    endkeep
+	}
+	
+	.Example    {
+	    endkeep
+	    incr ExNumber
+	    puts $theFile ".sp\n.B1\n.DS"         
+	    for {set i 1} {$i <= 80} {incr i} {puts -nonewline $theFile " "}
+	    puts $theFile " "
+	    puts $theFile ".B \"Example $ExNumber\""
+	    putText $aText
+	    puts $theFile ".DE"
+	    puts $theFile ".B2"
+	}
+	
+	".See also" {
+	    puts $theFile ".sp\n.B \"See also\"\n.PP"
+	    putText $aText
+	}
+	
+	.Warning    {
+	    puts $theFile ".sp\n.B Warnings\n.PP"
+	    putText $aText
+	}
+	
+	.Text   {
+	    if {$fill} {puts $theFile ".PP"} else {puts $theFile ".LD\n.R"}
+	    putText $aText
+	    if {! $fill} {puts $theFile ".DE"}
+	}
+	
+	.Index      {
+	    foreach word $aText {
+		if {$word != ""} {puts $theFile ".IX $word"}
+	    }
+	}
+    }
+}
+
+proc troffText {aText} {
+	sectionText $aText troffSection
+}
+
+proc troff {} {
+    global theFile texts ExNumber title
+    set ExNumber 0
+
+    puts $theFile ".RP"
+    puts $theFile ".TL\n$title"
+    puts $theFile ".AU\nThe CAS.CADE Software Factory"
+    puts $theFile ".AI\nMatra-Datavision"
+
+    if [info exists texts(Top)] {
+	# Abstract
+	puts $theFile ".AB"
+	putText $texts(Top)
+	puts $theFile ".AE"
+	set text(Top) {}
+    }
+
+    # header and footer
+    puts $theFile ".ds CH "
+    puts $theFile ".ds RH $title"
+    puts $theFile ".ds CF -%-"
+    puts $theFile ".ds LF Copyright Matra-Datavision"
+
+    dump troffTitle troffText
+
+    puts $theFile ".ds RH Contents"
+    puts $theFile ".bp\n.TL\nTable of contents\n.PX no"
+}
+
+# compare without case, used for sorting the index
+proc cmp {s1 s2} {
+    return [string compare [string tolower $s1] [string tolower $s2]]
+}
+
+proc processIndex {fileindex filetr} {
+    # read the index file and create the index
+    # Try to keep together the letter an the first line
+
+    set f [open $fileindex r]
+    set sindex {}
+    while {[gets $f line] >= 0} {
+	if [regexp {^(.*[^ 	])[ 	]*\.\.\. ([0-9]*)$} $line dummy word page] {
+	    lappend sindex "$word $page"
+	}
+    }
+    close $f
+    set f [open $filetr w]
+    puts $f ".TL\nIndex"
+    puts $f ".2C\n.LD"
+    set letter ""
+    set count 0
+    foreach line [lsort -command cmp $sindex] {
+	set l [string toupper [string index $line 0]]
+	if {$l != $letter} {
+	    set letter $l
+	    puts $f "\n.KS\n.LG 2\n.B $letter\n.NL\n"
+	    set count 0
+	}
+	puts $f $line
+	incr count
+	if {$count == 1} {puts $f ".KE"}
+    }
+    close $f
+}
+
+#
+# process arguments
+#
+
+if {$argc < 1} {
+    puts "tdoc docfile title [nofill]"
+    puts "format a doc file for printing in postscript"
+    puts "if nofill text are not justified"
+    exit
+}
+
+set file   [lindex $argv 0]
+set title  "CAS.CADE Documentation"
+if {$argc > 1} {set title [lindex $argv 1]}
+set fill 1
+if {$argc > 2} {set fill 0}
+
+
+if [file readable $file] {
+    readFile $file
+    set file [file rootname $file]
+    set filetr    F[pid]
+    set fileout   O[pid]
+    set fileindex I[pid]
+    set theFile [open $filetr w]
+    set keeping 0
+    troff
+    close $theFile
+    exec troff -ms $filetr > $fileout 2> $fileindex
+    set fileindextr IT[pid]
+    processIndex $fileindex $fileindextr
+    exec troff -ms $fileindextr >> $fileout
+    exec /usr/lib/lp/postscript/dpost $fileout > $file.ps
+    exec rm -f $filetr $fileout $fileindex $fileindextr
+    puts "$file.ps created"
+} else {
+	puts "Cannot open $file for reading"
+}

src/DrawResources/test2xl

@@ -0,0 +1,55 @@
+#!/bin/sh
+# 
+# this script converts the result from mdltest to a MS EXCEL readable formated spreed sheet 
+#
+# The next line is executed by /bin/sh, but not Tcl \
+  exec tclsh $0 ${1+"$@"}
+
+if {$argc != 1} {
+    error "Usage: test2xl filename"
+}
+set sourfile [open [lindex $argv 0] r]
+set dir  $env(PWD)
+
+# set result [open toot r]
+set p "   "
+while {[ gets $sourfile line ] >= 0 } {
+  if [regexp {GRILLES-BOOLEAN ([a-zA-Z0-9]*) ([a-zA-Z][0-9]) : ([\ ]*) ([a-zA-Z]*)} $line dummy EDCnb AZnb dummy1 oko] {
+    if {$AZnb == "A1"} {
+#      close $result
+      set file $EDCnb 
+      append file ".txt"
+      set result [open $file w]
+      puts ":: $EDCnb"
+      puts $result ":: $EDCnb"
+      puts ": 1 commun : 2 fusion : 3 coupe 1 par 2 : 4 coupe 2 par 1 "
+      puts $result ": 1 commun : 2 fusion : 3 coupe 1 par 2 : 4 coupe 2 par 1 "
+    }
+    append p $oko
+    append p ":"
+    if {$oko != "OK"} {
+      set oko "KO"
+    } 
+    if {[string index $AZnb 1 ] == "1"} {
+      set OK $AZnb
+      append OK ":"
+      append OK $oko
+      append OK ":"
+    } elseif {[string index $AZnb 1 ] == "2"} {
+	append OK $oko
+	append OK ":"
+      } elseif {[string index $AZnb 1 ] == "3"} {
+	  append OK $oko
+	  append OK ":"
+	} elseif {[string index $AZnb 1 ] == "4"} {
+	    puts ""
+	    puts $p
+	    set p "   "
+	    append OK $oko
+	    puts $OK
+	    puts $result $OK
+	  } else {
+	     puts "error letter"
+	    }
+  }
+}

src/DrawResources/vmdltest

@@ -0,0 +1,3 @@
+#!/bin/sh
+
+exec wishx -file $DRAWHOME/Consultation.tcl

src/DrawResources/wing.brep

@@ -0,0 +1,404 @@
+DBRep_DrawableShape
+
+CASCADE Topology V1, (c) Matra-Datavision
+Locations 0
+Curve2ds 16
+1 0 0 0 1 
+1 0 0 1 0 
+1 1 0 0 1 
+1 0 1 1 0 
+1 0 0 0 1 
+1 0 0 1 0 
+1 1 0 0 1 
+1 0 1 1 0 
+1 0 0 0 1 
+1 0 0 1 0 
+1 1 0 0 1 
+1 0 1 1 0 
+1 0 0 0 1 
+1 0 0 1 0 
+1 1 0 0 1 
+1 0 1 1 0 
+Curves 16
+7 0 0  1 2 2  3.3500000000000001 0 0.84999599999999997  3.0956649999999999 3.3199999999999998 0.849997 
+ 0 2 1 2
+7 0 0  7 8 2  3.3500000000000001 0 0.84999599999999997  2.5594269999999999 0 1.0545310000000001  2.9291839999999998 0 0.94117300000000004  2.224526 0 1.0736730000000001  2.2209889999999999 0 0.96156200000000003  1.9382239999999999 0 0.984595  1.850238 0 0.91910099999999995  1.8500000000000001 0 0.84999999999999998 
+ 0 8 1 8
+7 0 0  1 2 2  1.8500000000000001 0 0.84999999999999998  1.7956650000000001 3.3199999999999998 0.84999999999999998 
+ 0 2 1 2
+7 0 0  7 8 2  3.0956649999999999 3.3199999999999998 0.849997  2.4105020000000001 3.3199999999999998 1.0272600000000001  2.7309580000000002 3.3199999999999998 0.92901699999999998  2.1202549999999998 3.3199999999999998 1.0438499999999999  2.1171880000000001 3.3199999999999998 0.94668699999999995  1.872126 3.3199999999999998 0.96664899999999998  1.795871 3.3199999999999998 0.909887  1.7956650000000001 3.3199999999999998 0.84999999999999998 
+ 0 8 1 8
+7 0 0  1 2 2  1.8500000000000001 0 0.84999999999999998  1.7956650000000001 3.3199999999999998 0.84999999999999998 
+ 0 2 1 2
+7 0 0  8 9 2  1.8500000000000001 0 0.84999999999999998  1.8497189999999999 0 0.76831300000000002  2.1391040000000001 0 0.76218600000000003  2.558659 0 0.68765799999999999  2.970672 0 0.84048500000000004  2.512594 0 0.70602500000000001  3.174499 0 0.87292999999999998  3.190143 0 0.84999999999999998  3.3500000000000001 0 0.84999599999999997 
+ 0 9 1 9
+7 0 0  1 2 2  3.3500000000000001 0 0.84999599999999997  3.0956649999999999 3.3199999999999998 0.849997 
+ 0 2 1 2
+7 0 0  8 9 2  1.7956650000000001 3.3199999999999998 0.84999999999999998  1.7954209999999999 3.3199999999999998 0.77920500000000004  2.0462220000000002 3.3199999999999998 0.773895  2.4098359999999999 3.3199999999999998 0.70930300000000002  2.7669139999999999 3.3199999999999998 0.841754  2.3699129999999999 3.3199999999999998 0.72522200000000003  2.9435639999999998 3.3199999999999998 0.86987300000000001  2.9571230000000002 3.3199999999999998 0.84999999999999998  3.0956649999999999 3.3199999999999998 0.849997 
+ 0 9 1 9
+7 0 0  1 2 2  3.0956649999999999 3.3199999999999998 0.849997  2.4870429999999999 4.75 1.180139 
+ 0 2 1 2
+7 0 0  7 8 2  3.0956649999999999 3.3199999999999998 0.849997  2.4105020000000001 3.3199999999999998 1.0272600000000001  2.7309580000000002 3.3199999999999998 0.92901699999999998  2.1202549999999998 3.3199999999999998 1.0438499999999999  2.1171880000000001 3.3199999999999998 0.94668699999999995  1.872126 3.3199999999999998 0.96664899999999998  1.795871 3.3199999999999998 0.909887  1.7956650000000001 3.3199999999999998 0.84999999999999998 
+ 0 8 1 8
+7 0 0  1 2 2  1.7956650000000001 3.3199999999999998 0.84999999999999998  1.9370430000000001 4.75 1.1801410000000001 
+ 0 2 1 2
+7 0 0  7 8 2  2.4870429999999999 4.75 1.180139  2.1971660000000002 4.75 1.2551349999999999  2.3327439999999999 4.75 1.213571  2.0743689999999999 4.75 1.262154  2.0730719999999998 4.75 1.221047  1.969392 4.75 1.229492  1.93713 4.75 1.2054769999999999  1.9370430000000001 4.75 1.1801410000000001 
+ 0 8 1 8
+7 0 0  1 2 2  1.7956650000000001 3.3199999999999998 0.84999999999999998  1.9370430000000001 4.75 1.1801410000000001 
+ 0 2 1 2
+7 0 0  8 9 2  1.7956650000000001 3.3199999999999998 0.84999999999999998  1.7954209999999999 3.3199999999999998 0.77920500000000004  2.0462220000000002 3.3199999999999998 0.773895  2.4098359999999999 3.3199999999999998 0.70930300000000002  2.7669139999999999 3.3199999999999998 0.841754  2.3699129999999999 3.3199999999999998 0.72522200000000003  2.9435639999999998 3.3199999999999998 0.86987300000000001  2.9571230000000002 3.3199999999999998 0.84999999999999998  3.0956649999999999 3.3199999999999998 0.849997 
+ 0 9 1 9
+7 0 0  1 2 2  3.0956649999999999 3.3199999999999998 0.849997  2.4870429999999999 4.75 1.180139 
+ 0 2 1 2
+7 0 0  8 9 2  1.9370430000000001 4.75 1.1801410000000001  1.9369400000000001 4.75 1.1501889999999999  2.0430480000000002 4.75 1.147942  2.196885 4.75 1.1206149999999999  2.3479559999999999 4.75 1.176652  2.1799940000000002 4.75 1.1273500000000001  2.4226930000000002 4.75 1.1885479999999999  2.4284289999999999 4.75 1.1801410000000001  2.4870429999999999 4.75 1.180139 
+ 0 9 1 9
+Polygon3D 0
+PolygonOnTriangulations 0
+Surfaces 4
+9 0 0 0 0 7 1 8 2 2 2 3.3500000000000001 0 0.84999599999999997  3.0956649999999999 3.3199999999999998 0.849997  
+2.5594269999999999 0 1.0545310000000001  2.4105020000000001 3.3199999999999998 1.0272600000000001  
+2.9291839999999998 0 0.94117300000000004  2.7309580000000002 3.3199999999999998 0.92901699999999998  
+2.224526 0 1.0736730000000001  2.1202549999999998 3.3199999999999998 1.0438499999999999  
+2.2209889999999999 0 0.96156200000000003  2.1171880000000001 3.3199999999999998 0.94668699999999995  
+1.9382239999999999 0 0.984595  1.872126 3.3199999999999998 0.96664899999999998  
+1.850238 0 0.91910099999999995  1.795871 3.3199999999999998 0.909887  
+1.8500000000000001 0 0.84999999999999998  1.7956650000000001 3.3199999999999998 0.84999999999999998  
+
+0 8
+1 8
+
+0 2
+1 2
+
+9 0 0 0 0 8 1 9 2 2 2 1.8500000000000001 0 0.84999999999999998  1.7956650000000001 3.3199999999999998 0.84999999999999998  
+1.8497189999999999 0 0.76831300000000002  1.7954209999999999 3.3199999999999998 0.77920500000000004  
+2.1391040000000001 0 0.76218600000000003  2.0462220000000002 3.3199999999999998 0.773895  
+2.558659 0 0.68765799999999999  2.4098359999999999 3.3199999999999998 0.70930300000000002  
+2.970672 0 0.84048500000000004  2.7669139999999999 3.3199999999999998 0.841754  
+2.512594 0 0.70602500000000001  2.3699129999999999 3.3199999999999998 0.72522200000000003  
+3.174499 0 0.87292999999999998  2.9435639999999998 3.3199999999999998 0.86987300000000001  
+3.190143 0 0.84999999999999998  2.9571230000000002 3.3199999999999998 0.84999999999999998  
+3.3500000000000001 0 0.84999599999999997  3.0956649999999999 3.3199999999999998 0.849997  
+
+0 9
+1 9
+
+0 2
+1 2
+
+9 0 0 0 0 7 1 8 2 2 2 3.0956649999999999 3.3199999999999998 0.849997  2.4870429999999999 4.75 1.180139  
+2.4105020000000001 3.3199999999999998 1.0272600000000001  2.1971660000000002 4.75 1.2551349999999999  
+2.7309580000000002 3.3199999999999998 0.92901699999999998  2.3327439999999999 4.75 1.213571  
+2.1202549999999998 3.3199999999999998 1.0438499999999999  2.0743689999999999 4.75 1.262154  
+2.1171880000000001 3.3199999999999998 0.94668699999999995  2.0730719999999998 4.75 1.221047  
+1.872126 3.3199999999999998 0.96664899999999998  1.969392 4.75 1.229492  
+1.795871 3.3199999999999998 0.909887  1.93713 4.75 1.2054769999999999  
+1.7956650000000001 3.3199999999999998 0.84999999999999998  1.9370430000000001 4.75 1.1801410000000001  
+
+0 8
+1 8
+
+0 2
+1 2
+
+9 0 0 0 0 8 1 9 2 2 2 1.7956650000000001 3.3199999999999998 0.84999999999999998  1.9370430000000001 4.75 1.1801410000000001  
+1.7954209999999999 3.3199999999999998 0.77920500000000004  1.9369400000000001 4.75 1.1501889999999999  
+2.0462220000000002 3.3199999999999998 0.773895  2.0430480000000002 4.75 1.147942  
+2.4098359999999999 3.3199999999999998 0.70930300000000002  2.196885 4.75 1.1206149999999999  
+2.7669139999999999 3.3199999999999998 0.841754  2.3479559999999999 4.75 1.176652  
+2.3699129999999999 3.3199999999999998 0.72522200000000003  2.1799940000000002 4.75 1.1273500000000001  
+2.9435639999999998 3.3199999999999998 0.86987300000000001  2.4226930000000002 4.75 1.1885479999999999  
+2.9571230000000002 3.3199999999999998 0.84999999999999998  2.4284289999999999 4.75 1.1801410000000001  
+3.0956649999999999 3.3199999999999998 0.849997  2.4870429999999999 4.75 1.180139  
+
+0 9
+1 9
+
+0 2
+1 2
+
+Triangulations 0
+
+TShapes 41
+Ve
+1e-07
+3.35 0 0.849996
+0 0
+
+0101100
+*
+Ve
+1e-07
+3.095665 3.32 0.849997
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  1 0 0 1
+2  1 1 0 0 1
+0
+
+0101000
++41 0 -40 0 *
+Ve
+1e-07
+1.85 0 0.849999999999998
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  2 0 0 1
+2  2 1 0 0 1
+0
+
+0101000
++41 0 -38 0 *
+Ve
+1e-07
+1.795665 3.32 0.849999999999998
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  3 0 0 1
+2  3 1 0 0 1
+0
+
+0101000
++38 0 -36 0 *
+Ed
+ 1e-07 1 1 0
+1  4 0 0 1
+2  4 1 0 0 1
+0
+
+0101000
++40 0 -36 0 *
+Wi
+
+0101100
+-39 0 +37 0 +35 0 -34 0 *
+Fa
+1  1e-07 1 0
+
+0111000
++33 0 *
+Ve
+1e-07
+1.85 0 0.85
+0 0
+
+0101100
+*
+Ve
+1e-07
+1.795665 3.32 0.85
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  5 0 0 1
+2  5 2 0 0 1
+0
+
+0101000
++31 0 -30 0 *
+Ve
+1e-07
+3.35000000000001 0 0.849996000000003
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  6 0 0 1
+2  6 2 0 0 1
+0
+
+0101000
++31 0 -28 0 *
+Ve
+1e-07
+3.09566500000001 3.32 0.849997000000003
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  7 0 0 1
+2  7 2 0 0 1
+0
+
+0101000
++28 0 -26 0 *
+Ed
+ 1e-07 1 1 0
+1  8 0 0 1
+2  8 2 0 0 1
+0
+
+0101000
++30 0 -26 0 *
+Wi
+
+0101100
+-29 0 +27 0 +25 0 -24 0 *
+Fa
+1  1e-07 2 0
+
+0111000
++23 0 *
+Ve
+1e-07
+3.095665 3.32 0.849997
+0 0
+
+0101100
+*
+Ve
+1e-07
+2.487043 4.75 1.180139
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  9 0 0 1
+2  9 3 0 0 1
+0
+
+0101000
++21 0 -20 0 *
+Ve
+1e-07
+1.79566500000001 3.32 0.850000000000001
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  10 0 0 1
+2  10 3 0 0 1
+0
+
+0101000
++21 0 -18 0 *
+Ve
+1e-07
+1.93704300000001 4.75 1.180141
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  11 0 0 1
+2  11 3 0 0 1
+0
+
+0101000
++18 0 -16 0 *
+Ed
+ 1e-07 1 1 0
+1  12 0 0 1
+2  12 3 0 0 1
+0
+
+0101000
++20 0 -16 0 *
+Wi
+
+0101100
+-19 0 +17 0 +15 0 -14 0 *
+Fa
+1  1e-07 3 0
+
+0111000
++13 0 *
+Ve
+1e-07
+1.795665 3.32 0.85
+0 0
+
+0101100
+*
+Ve
+1e-07
+1.937043 4.75 1.180141
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  13 0 0 1
+2  13 4 0 0 1
+0
+
+0101000
++11 0 -10 0 *
+Ve
+1e-07
+3.09566499999999 3.32 0.849997000000002
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  14 0 0 1
+2  14 4 0 0 1
+0
+
+0101000
++11 0 -8 0 *
+Ve
+1e-07
+2.487043 4.75 1.180139
+0 0
+
+0101100
+*
+Ed
+ 1e-07 1 1 0
+1  15 0 0 1
+2  15 4 0 0 1
+0
+
+0101000
++8 0 -6 0 *
+Ed
+ 1e-07 1 1 0
+1  16 0 0 1
+2  16 4 0 0 1
+0
+
+0101000
++10 0 -6 0 *
+Wi
+
+0101100
+-9 0 +7 0 +5 0 -4 0 *
+Fa
+1  1e-07 4 0
+
+0111000
++3 0 *
+Co
+
+1100000
++32 0 +22 0 +12 0 +2 0 *
+
++1 0