#                      A R C H E R C O R E . T C L
# BRL-CAD
#
# Copyright (c) 2002-2021 United States Government as represented by
# the U.S. Army Research Laboratory.
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public License
# version 2.1 as published by the Free Software Foundation.
#
# This library is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
#
# You should have received a copy of the GNU Lesser General Public
# License along with this file; see the file named COPYING for more
# information.
#
###
#
# Description:
#    This is a BRL-CAD Application Core mega-widget.
#

LoadArcherCoreLibs
package provide ArcherCore 1.0

namespace eval ArcherCore {
    set cursorWaitCount 0

    if {![info exists parentClass]} {
	set parentClass itk::Toplevel
	set inheritFromToplevel 1
    }
}

::itcl::class ArcherCore {
    inherit $ArcherCore::parentClass

    itk_option define -quitcmd quitCmd Command {}
    itk_option define -master master Master "."
    itk_option define -geometry geometry Geometry ""

    constructor {{_viewOnly 0} {_noCopy 0} {_noTree 0} {_noToolbar 0} args} {}
    destructor {}

    public {
	common application ""
	common splash ""
	common showWindow 0

	common TREE_AFFECTED_TAG "affected"
	common TREE_FULLY_DISPLAYED_TAG "displayed"
	common TREE_PARTIALLY_DISPLAYED_TAG "pdisplayed"
	common TREE_POPUP_TAG "popup"
	common TREE_OPENED_TAG "opened"
	common TREE_PLACEHOLDER_TAG "placeholder"
	common TREE_POPUP_TYPE_NODE "node"
	common TREE_POPUP_TYPE_NULL "null"

	common TREE_MODE_TREE 0
	common TREE_MODE_COLOR_OBJECTS 1
	common TREE_MODE_GHOST_OBJECTS 2
	common TREE_MODE_EDGE_OBJECTS 3
	common TREE_MODE_NAMES {Tree "Color Objects" "Ghost Objects" "Edge Objects"}

	common VIEW_ROTATE_MODE 0
	common VIEW_TRANSLATE_MODE 1
	common VIEW_SCALE_MODE 2
	common VIEW_CENTER_MODE 3
	common COMP_PICK_MODE 4
	common COMP_SELECT_MODE 5
	common MEASURE_MODE 6
	common OBJECT_ROTATE_MODE 7
	common OBJECT_TRANSLATE_MODE 8
	common OBJECT_SCALE_MODE 9
	common OBJECT_CENTER_MODE 10
	common FIRST_FREE_BINDING_MODE 11

	common DISPLAY_MODE_OFF -1
	common DISPLAY_MODE_WIREFRAME 0
	common DISPLAY_MODE_SHADED 1
	common DISPLAY_MODE_SHADED_ALL 2
	common DISPLAY_MODE_EVALUATED 3
	common DISPLAY_MODE_HIDDEN 4
	common DISPLAY_MODE_SHADED_EVAL 5

	common MATRIX_ABOVE_MODE 0
	common MATRIX_BELOW_MODE 1

	common OBJ_EDIT_VIEW_MODE 0
	common OBJ_ATTR_VIEW_MODE 1
	common OBJ_TOOL_VIEW_MODE 2
	common OBJ_RT_IMAGE_VIEW_MODE 3

	common COMP_PICK_TREE_SELECT_MODE 0
	common COMP_PICK_NAME_MODE 1
	common COMP_PICK_ERASE_MODE 2
	common COMP_PICK_BOT_SPLIT_MODE 3
	common COMP_PICK_BOT_SYNC_MODE 4
	common COMP_PICK_BOT_FLIP_MODE 5

	common COMP_SELECT_LIST_MODE 0
	common COMP_SELECT_LIST_PARTIAL_MODE 1
	common COMP_SELECT_GROUP_ADD_MODE 2
	common COMP_SELECT_GROUP_ADD_PARTIAL_MODE 3
	common COMP_SELECT_GROUP_REMOVE_MODE 4
	common COMP_SELECT_GROUP_REMOVE_PARTIAL_MODE 5
	common COMP_SELECT_BOT_POINTS_MODE 6
	common COMP_SELECT_MODE_NAMES {"List" "List (Partial)" "Add to Group" "Add to Group (Partial)" "Remove from Group" "Remove from Group (Partial)" "Select BOT Points"}

	common LIGHT_MODE_FRONT 1
	common LIGHT_MODE_FRONT_AND_BACK 2
	common LIGHT_MODE_FRONT_AND_BACK_DARK 3
	common LIGHT_MODE_FRONT_AND_BACK_LIGHT 4

	common SystemWindowFont
	common SystemWindowText
	common SystemWindow
	common SystemHighlight
	common SystemHighlightText
	common SystemButtonFace

	common ZCLIP_SMALL_CUBE 0
	common ZCLIP_MEDIUM_CUBE 1
	common ZCLIP_LARGE_CUBE 2
	common ZCLIP_NONE 3

	common MEASURING_STICK "cad_measuring_stick"

	common LABEL_BACKGROUND_COLOR [::ttk::style lookup label -background]

	proc packTree              {_data}
	proc unpackTree            {_tree}

	# public window commands
	method getCanvasArea {}
	method restoreCanvas {}
	method setCanvas {_canvas}
	method dockArea            {{_position "south"}}
	method primaryToolbarAddBtn     {_name {args ""}}
	method primaryToolbarAddSep     {_name {args ""}}
	method primaryToolbarRemoveItem  {_index}
	method closeHierarchy {}
	method openHierarchy {{_fraction 30}}
	method rebuildTree {}
	method rsyncTree {_pnode}
	method syncTree {}
	method updateTreeDrawLists        {{_cflag 0}}
	method shootRay {_start _op _target _prep _no_bool _onehit _bot_dflag}
	method addMouseRayCallback {_callback}
	method deleteMouseRayCallback {_callback}
	method setDefaultBindingMode {_mode}

	# public database commands
	method cmd                 {args}
	method gedCmd              {args}

	# general
	method Load                {_filename}
	method GetUserCmds         {}
	method WhatsOpen           {}
	method Close               {}
	method askToSave           {}
	method freezeGUI           {{_freeze ""}}
	method getTkColor          {_r _g _b}
	method getRgbColor         {_color}
	method setSave {}
	method getLastSelectedDir  {}
	method refreshDisplay      {}
	method putString           {_str}
	method rtcntrl             {args}
	method setStatusString     {_str}
	method getSelectedTreePaths {}

	# Commands exposed to the user via the command line.
	# More to be added later...
	method 3ptarb              {args}
	method adjust              {args}
	method edit                {args}
	method arced               {args}
	method attr                {args}
	method bb                  {args}
	method bev                 {args}
	method B                   {args}
	method blast               {args}
	method bo                  {args}
	method bot                 {args}
	method bot_condense        {args}
	method bot_decimate        {args}
	method bot_face_fuse       {args}
	method bot_face_sort       {args}
	method bot_flip            {args}
	method bot_fuse            {args}
	method bot_merge           {args}
	method bot_smooth          {args}
	method bot_split           {args}
	method bot_sync            {args}
	method bot_vertex_fuse     {args}
	method brep                {args}
	method brlman              {args}
	method c                   {args}
	method cd                  {args}
	method clear               {args}
	method clone               {args}
	method closedb             {args}
	method color               {args}
	method comb                {args}
	method comb_color          {args}
	method combmem             {args}
	method copy                {args}
	method copyeval            {args}
	method copymat             {args}
	method cp                  {args}
	method cpi                 {args}
	method dbconcat            {args}
	method dbExpand	           {args}
	method decompose           {args}
	method delete              {args}
	method draw                {args}
	method e                   {args}
	method E                   {args}
	method edarb               {args}
	method edcodes             {args}
	method edcolor             {args}
	method edcomb              {args}
	method edmater             {args}
	method env                 {args}
	method d                   {args}
	method dsp                 {args}
	method erase               {args}
	method ev                  {args}
	method exists              {args}
	method exit                {args}
	method facetize            {args}
	method fracture            {args}
	method graph               {args}
	method hide                {args}
	method human               {args}
	method g                   {args}
	method get                 {args}
	method group               {args}
	method i                   {args}
	method igraph              {args}
	method importFg4Section    {args}
	method in                  {args}
	method inside              {args}
	method item                {args}
	method kill                {args}
	method killall             {args}
	method killrefs            {args}
	method killtree            {args}
	method l                   {args}
	method ls                  {args}
	method lc                  {args}
	method make		   {args}
	method make_name           {args}
	method make_pnts           {args}
	method man                 {args}
	method mater               {args}
	method mirror              {args}
	method move                {args}
	method move_arb_edge       {args}
	method move_arb_face       {args}
	method mv                  {args}
	method mvall               {args}
	method nmg_collapse        {args}
	method nmg_simplify        {args}
	method ocenter		   {args}
	method opendb		   {args}
	method orotate		   {args}
	method oscale		   {args}
	method otranslate	   {args}
	method p                   {args}
	method prefix              {args}
	method protate             {args}
	method pscale              {args}
	method ptranslate          {args}
	method pull                {args}
	method push                {args}
	method put                 {args}
	method put_comb            {args}
	method putmat              {args}
	method pwd                 {}
	method q                   {args}
	method quit                {args}
	method r                   {args}
	method rcodes              {args}
	method red                 {args}
	method rfarb               {args}
	method rm                  {args}
	method rmater              {args}
	method rotate              {args}
	method rotate_arb_face     {args}
	method saveview		   {args}
	method scale		   {args}
	method search		   {args}
	method sed		   {_prim}
	method shader              {args}
	method shells              {args}
	method tire                {args}
	method title               {args}
	method track               {args}
	method translate           {args}
	method unhide              {args}
	method units               {args}
	method vmake               {args}
	method wmater              {args}
	method xpush               {args}
	method Z                   {args}
	method zap                 {args}

	if {$::tcl_platform(platform) != "windows"} {
	    set SystemWindowFont Helvetica
	    set SystemWindowText black
	    set SystemWindow $LABEL_BACKGROUND_COLOR
	    set SystemHighlight black
	    set SystemHighlightText \#ececec
	    set SystemButtonFace $LABEL_BACKGROUND_COLOR
	} else {
	    set SystemWindowFont SystemWindowText
	    set SystemWindowText SystemWindowText
	    set SystemWindow SystemWindow
	    set SystemHighlight SystemHighlight
	    set SystemHighlightText SystemHighlightText
	    set SystemButtonFace SystemButtonFace
	}
    }

    protected {
	proc unpackTreeGuts      {_tree}

	variable mLastSelectedDir ""

	variable mFontArrowsName "arrowFont"
	variable mFontArrows {Wingdings 3}
	variable mLeftArrow "t"
	variable mRightArrow "u"
	variable mFontText
	variable mFontTextBold

	variable mDelayCommandViewBuild 0
	variable mRestoringTree 0
	variable mViewOnly 0
	variable mFreezeGUI 0
	variable mNeedsTreeRebuild 0
	variable mNeedsTreeSync 0
	variable mNoTree 0
	variable mNoToolbar 0
	variable mTarget ""
	variable mTargetCopy ""
	variable mTargetOldCopy ""
	variable mDisplayType
	variable mLighting 1
	variable mRenderMode -1
	variable mActivePane
	variable mActivePaneName
	variable mCurrentPaneName ""
	variable mStatusStr ""
	variable mDbType ""
	variable mDbReadOnly 0
	variable mDbNoCopy 0
	variable mDbShared 0
	variable mProgress 0
	variable mProgressBarWidth 200
	variable mProgressBarHeight ""
	#variable mProgressString ""
	variable mNeedSave 0
	variable mPrevSelectedObjPath ""
	variable mPrevSelectedObj ""
	variable mSelectedObjPath ""
	variable mSelectedObj ""
	variable mSelectedObjType ""
	variable mMultiPane 0
	variable mTransparency 0

	variable mHPaneFraction1 80
	variable mHPaneFraction2 20
	variable mVPaneFraction1 10
	variable mVPaneFraction2 90
	variable mVPaneFraction3 20
	variable mVPaneFraction4 60
	variable mVPaneFraction5 20

	variable mVPaneToggle1 20
	variable mVPaneToggle3 20
	variable mVPaneToggle5 20

	variable mShowViewAxes 1
	variable mShowModelAxes 0
	variable mShowModelAxesTicks 1
	variable mShowGroundPlane 0
	variable mShowPrimitiveLabels 0
	variable mShowViewingParams 0
	variable mShowScale 0
	variable mShowGrid 0
	variable mSnapGrid 0
	variable mSnapLines 0
	variable mShowADC 0

	# variables for preference state
	variable mWindowGeometry ""
	variable mCmdWindowGeometry ""
	variable mEnableAffectedNodeHighlight 0
	variable mEnableAffectedNodeHighlightPref ""
	variable mEnableListView 0
	variable mEnableListViewPref ""
	variable mEnableListViewAllAffected 0
	variable mEnableListViewAllAffectedPref ""
	variable mTreeAttrColumns ""
	variable mTreeAttrColumnsPref ""

	variable mEnableColorListView 0
	variable mEnableGhostListView 0
	variable mEnableEdgeListView 0
	variable mColorObjects {}
	variable mGhostObjects {}
	variable mEdgeObjects {}
	variable mColorObjectsHow 0
	variable mGhostObjectsHow 0
	variable mEdgeObjectsHow 0

	variable mAccordianCallbackActive 0
	variable mTreeMode $TREE_MODE_TREE
	variable mPrevTreeMode $TREE_MODE_TREE
	variable mPrevTreeMode2 $TREE_MODE_COLOR_OBJECTS
	variable mToolViewChange 0
	variable mTreePopupBusy 0
	variable mDoubleClickActive 0

	variable mSavedCenter ""
	variable mSavedViewEyePt ""
	variable mSavedSize ""

	variable mSeparateCommandWindow 0
	variable mSeparateCommandWindowPref ""
	variable mSepCmdPrefix "sepcmd_"

	variable mCompPickMode $COMP_PICK_TREE_SELECT_MODE
	variable mCompSelectMode $COMP_SELECT_LIST_MODE
	variable mCompSelectModePref ""
	variable mCompSelectGroup "tmp_group"
	variable mCompSelectGroupPref ""
	variable mCompSelectGroupList ""

	variable mBindingMode Default
	variable mBindingModePref ""
	variable mBackground "0 0 0"
	variable mBackgroundColor Navy
	variable mBackgroundColorPref ""
	variable mPrimitiveLabelColor Yellow
	variable mPrimitiveLabelColorPref
	variable mViewingParamsColor Yellow
	variable mViewingParamsColorPref
	variable mScaleColor Yellow
	variable mScaleColorPref ""
	variable mMeasuringStickMode 0
	variable mMeasuringStickModePref ""
	variable mMeasuringStickColor Yellow
	variable mMeasuringStickColorPref ""
	variable mMeasuringStickColorVDraw ffff00
	variable mRayColorOdd Cyan
	variable mRayColorOddPref ""
	variable mRayColorEven Yellow
	variable mRayColorEvenPref ""
	variable mRayColorVoid Magenta
	variable mRayColorVoidPref ""
	variable mEnableBigE 0
	variable mEnableBigEPref ""

	variable mFBBackgroundColor Black
	variable mFBBackgroundColorPref ""
	variable mRtWizardEdgeColor White
	variable mRtWizardNonEdgeColor Grey
	variable mRtWizardOccMode 1
	variable mRtWizardGhostIntensity 12

	variable mDisplayFontSize 0
	variable mDisplayFontSizePref ""
	variable mDisplayFontSizes {}

	variable mPerspective 0
	variable mPerspectivePref 0

	variable mMaxCombMembersShown 200
	variable mMaxCombMembersShownPref ""
	variable mCombWarningList ""

	variable mZClipBack 100.0
	variable mZClipBackPref 100.0
	variable mZClipFront 100.0
	variable mZClipFrontPref 100.0
	variable mZClipBackMax 1000
	variable mZClipBackMaxPref 1000
	variable mZClipFrontMax 1000
	variable mZClipFrontMaxPref 1000

	variable mLightingMode 1
	variable mLightingModePref ""
	variable mDisplayListMode 1
	variable mDisplayListModePref ""
	variable mWireframeMode 0
	variable mWireframeModePref ""
	variable mHideSubtractions 0
	variable mHideSubtractionsPref ""

	variable mDefaultDisplayMode $DISPLAY_MODE_WIREFRAME
	variable mDefaultDisplayModePref ""

	variable mGridAnchor "0 0 0"
	variable mGridAnchorXPref ""
	variable mGridAnchorYPref ""
	variable mGridAnchorZPref ""
	variable mGridColor White
	variable mGridColorPref ""
	variable mGridMrh 10
	variable mGridMrhPref ""
	variable mGridMrv 10
	variable mGridMrvPref ""
	variable mGridRh 1
	variable mGridRhPref ""
	variable mGridRv 1
	variable mGridRvPref ""

	variable mGroundPlaneSize 20000
	variable mGroundPlaneSizePref ""
	variable mGroundPlaneInterval 1000
	variable mGroundPlaneIntervalPref ""
	variable mGroundPlaneMajorColor Yellow
	variable mGroundPlaneMajorColorPref ""
	variable mGroundPlaneMinorColor Grey
	variable mGroundPlaneMinorColorPref ""

	variable mViewAxesSizeOffsets
	variable mViewAxesSizeValues
	variable mViewAxesSize Small
	variable mViewAxesSizePref ""
	variable mViewAxesPosition "Lower Right"
	variable mViewAxesPositionPref ""
	variable mViewAxesLineWidth 1
	variable mViewAxesLineWidthPref ""
	variable mViewAxesColor Triple
	variable mViewAxesColorPref ""
	variable mViewAxesLabelColor Yellow
	variable mViewAxesLabelColorPref ""

	variable mModelAxesSizeValues
	variable mModelAxesSize "View (1x)"
	variable mModelAxesSizePref ""
	variable mModelAxesPosition "0 0 0"
	variable mModelAxesPositionXPref ""
	variable mModelAxesPositionYPref ""
	variable mModelAxesPositionZPref ""
	variable mModelAxesLineWidth 1
	variable mModelAxesLineWidthPref ""
	variable mModelAxesColor White
	variable mModelAxesColorPref ""
	variable mModelAxesLabelColor Yellow
	variable mModelAxesLabelColorPref ""

	variable mModelAxesTickInterval 100
	variable mModelAxesTickIntervalPref ""
	variable mModelAxesTicksPerMajor 10
	variable mModelAxesTicksPerMajorPref ""
	variable mModelAxesTickThreshold 8
	variable mModelAxesTickThresholdPref ""
	variable mModelAxesTickLength 4
	variable mModelAxesTickLengthPref ""
	variable mModelAxesTickMajorLength 8
	variable mModelAxesTickMajorLengthPref ""
	variable mModelAxesTickColor Yellow
	variable mModelAxesTickColorPref ""
	variable mModelAxesTickMajorColor Red
	variable mModelAxesTickMajorColorPref ""

	variable mDefaultBindingMode 0
	variable mPrevObjViewMode 0
	variable mObjViewMode 0
	variable mObjMatrixMode $MATRIX_BELOW_MODE

	# This is mostly a list of wrapped Ged commands. However, it also contains
	# a few commands that are implemented here in ArcherCore.
	variable mArcherCoreCommands { \
	    3ptarb adjust arced attr bb bev B blast bo bot bot_condense \
	    bot_decimate bot_face_fuse bot_face_sort bot_flip bot_fuse \
	    bot_merge bot_smooth bot_split bot_sync bot_vertex_fuse \
	    brep brlman c cd clear clone closedb color comb comb_color combmem \
	    copy copyeval copymat cp cpi dbconcat dbExpand decompose \
	    delete draw dsp e E edarb edcodes edcolor edcomb edit edmater env d erase ev exists \
	    exit facetize fracture freezeGUI g get graph group hide human i igraph \
	    importFg4Section in inside item kill killall killrefs \
	    killtree l lc ls make make_name make_pnts man mater mirror move \
	    move_arb_edge move_arb_face mv mvall nmg_collapse \
	    nmg_simplify ocenter opendb orotate oscale otranslate p q \
	    quit packTree prefix protate pscale ptranslate pull push put \
	    put_comb putmat pwd r rcodes red rfarb rm rmater rotate \
	    rotate_arb_face saveview scale search sed shader shells tire title \
	    track translate unhide units unpackTree vmake wmater xpush \
	    Z zap
	}

	# Commands in this list get passed directly to the Ged object
	variable mUnwrappedDbCommands {}

	variable mBannedDbCommands {
	    dbip open shaded_mode
	}

	variable mMouseOverrideInfo "\
	    \nTranslate     Shift-Right\
	    \nRotate        Shift-Left\
	    \nScale         Shift-Middle\
	    \nCenter        Shift-Ctrl-Right\
	    \nPopup Menu    Right or Ctrl-Left\
	    \n"
	variable mColorList {Grey Black Navy Blue Cyan Green Magenta Red White Yellow Triple}
	variable mColorListNoTriple {Grey Black Navy Blue Cyan Green Magenta Red White Yellow}
	variable mDefaultNodeColor {150 150 150}

	variable mDoStatus 1
	variable mDbName ""
	variable mDbUnits ""
	variable mDbTitle ""

	variable mMouseRayCallbacks ""
	variable mLastTags ""

	variable mStandardViewsMenuCommands

	method OpenTarget {target}
	method handleMoreArgs {args}

	method checkIfSelectedObjExists {}
	method gedWrapper {_cmd _eflag _hflag _sflag _tflag args}

	method buildCommandView {}
	method buildCanvasMenubar {}

	method redrawObj {_obj {_wflag 1}}
	method redrawWho {}

	method colorMenuStatusCB {_w}
	method menuStatusCB {_w}
	method transparencyMenuStatusCB {_w}
	method setViewTypeFromTreeMode {}

	method updateSaveMode {}
	method createTargetCopy {}
	method deleteTargetOldCopy {}

	method getVDrawColor {_color}
	method buildGroundPlane {}
	method showGroundPlane {}
	method showPrimitiveLabels {}
	method showViewParams {}
	method showScale {}
	method compareViewAxesSizes {a b}
	method compareModelAxesSizes {a b}

	method launchCheckOverlaps {_size}
	method launchNirt {}
	method launchRtApp {_app _size}

	method updateDisplaySettings {}
	method updateLightingMode {}
	method updatePerspective {_unused}
	method updateZClipPlanes {_front _front_max _back _back_max}
	method updateZClipPlanesFromSettings {}
	method updateZClipPlanesFromPreferences {{_unused 0.0}}
	method calculateZClipMax {}
	method calculateZClipBackMax {}
	method calculateZClipFrontMax {}
	method pushPerspectiveSettings {}
	method validateZClipMax {_d}

	method shootRay_doit {_start _op _target _prep _no_bool _onehit _bot_dflag _objects}

	variable mImgDir ""
	variable mCenterX ""
	variable mCenterY ""
	variable mCenterZ ""

	# variables for images
	variable mImage_air ""
	variable mImage_airLabeled ""
	variable mImage_airInter ""
	variable mImage_airSub ""
	variable mImage_airUnion ""
	variable mImage_airregion ""
	variable mImage_airregionInter ""
	variable mImage_airregionSub ""
	variable mImage_airregionUnion ""
	variable mImage_comb ""
	variable mImage_combLabeled ""
	variable mImage_combInter ""
	variable mImage_combSub ""
	variable mImage_combUnion ""
	variable mImage_region ""
	variable mImage_regionLabeled ""
	variable mImage_regionInter ""
	variable mImage_regionSub ""
	variable mImage_regionUnion ""
	variable mImage_arb8 ""
	variable mImage_arb8Labeled ""
	variable mImage_arb8Inter ""
	variable mImage_arb8Sub ""
	variable mImage_arb8Union ""
 	variable mImage_arb7 ""
        variable mImage_arb7Labeled ""
 	variable mImage_arb7Inter ""
 	variable mImage_arb7Sub ""
 	variable mImage_arb7Union ""
 	variable mImage_arb6 ""
        variable mImage_arb6Labeled ""
 	variable mImage_arb6Inter ""
 	variable mImage_arb6Sub ""
 	variable mImage_arb6Union ""
 	variable mImage_arb5 ""
        variable mImage_arb5Labeled ""
 	variable mImage_arb5Inter ""
 	variable mImage_arb5Sub ""
 	variable mImage_arb5Union ""
 	variable mImage_arb4 ""
        variable mImage_arb4Labeled ""
 	variable mImage_arb4Inter ""
 	variable mImage_arb4Sub ""
 	variable mImage_arb4Union ""
	variable mImage_arbn ""
	variable mImage_arbnLabeled ""
	variable mImage_arbnInter ""
	variable mImage_arbnSub ""
	variable mImage_arbnUnion ""
	variable mImage_ars ""
	variable mImage_arsLabeled ""
	variable mImage_arsInter ""
	variable mImage_arsSub ""
	variable mImage_arsUnion ""
	variable mImage_bot ""
	variable mImage_botLabeled ""
	variable mImage_botInter ""
	variable mImage_botSub ""
	variable mImage_botUnion ""
	variable mImage_brep ""
	variable mImage_brepLabeled ""
	variable mImage_brepInter ""
	variable mImage_brepSub ""
	variable mImage_brepUnion ""
	variable mImage_dsp ""
	variable mImage_dspLabeled ""
	variable mImage_dspInter ""
	variable mImage_dspSub ""
	variable mImage_dspUnion ""
	variable mImage_ehy ""
	variable mImage_ehyLabeled ""
	variable mImage_ehyInter ""
	variable mImage_ehySub ""
	variable mImage_ehyUnion ""
	variable mImage_ell ""
	variable mImage_ellLabeled ""
	variable mImage_ellInter ""
	variable mImage_ellSub ""
	variable mImage_ellUnion ""
	variable mImage_epa ""
	variable mImage_epaLabeled ""
	variable mImage_epaInter ""
	variable mImage_epaSub ""
	variable mImage_epaUnion ""
	variable mImage_eto ""
	variable mImage_etoLabeled ""
	variable mImage_etoInter ""
	variable mImage_etoSub ""
	variable mImage_etoUnion ""
	variable mImage_extrude ""
	variable mImage_extrudeLabeled ""
	variable mImage_extrudeInter ""
	variable mImage_extrudeSub ""
	variable mImage_extrudeUnion ""
	variable mImage_half ""
	variable mImage_halfLabeled ""
	variable mImage_halfInter ""
	variable mImage_halfSub ""
	variable mImage_halfUnion ""
	variable mImage_hyp ""
	variable mImage_hypLabeled ""
	variable mImage_hypInter ""
	variable mImage_hypSub ""
	variable mImage_hypUnion ""
	variable mImage_invalid ""
	variable mImage_invalidInter ""
	variable mImage_invalidSub ""
	variable mImage_invalidUnion ""
	variable mImage_metaball ""
	variable mImage_metaballLabeled ""
	variable mImage_metaballInter ""
	variable mImage_metaballSub ""
	variable mImage_metaballUnion ""
	variable mImage_nmg ""
	variable mImage_nmgLabeled ""
	variable mImage_nmgInter ""
	variable mImage_nmgSub ""
	variable mImage_nmgUnion ""
	variable mImage_other ""
	variable mImage_otherInter ""
	variable mImage_otherSub ""
	variable mImage_otherUnion ""
	variable mImage_partLabeled ""
	variable mImage_pipe ""
	variable mImage_pipeLabeled ""
	variable mImage_pipeInter ""
	variable mImage_pipeSub ""
	variable mImage_pipeUnion ""
	variable mImage_rhc ""
	variable mImage_rhcLabeled ""
	variable mImage_rhcInter ""
	variable mImage_rhcSub ""
	variable mImage_rhcUnion ""
	variable mImage_rpc ""
	variable mImage_rpcLabeled ""
	variable mImage_rpcInter ""
	variable mImage_rpcSub ""
	variable mImage_rpcUnion ""
	variable mImage_sketch ""
	variable mImage_sketchLabeled ""
	variable mImage_sketchInter ""
	variable mImage_sketchSub ""
	variable mImage_sketchUnion ""
	variable mImage_sph ""
	variable mImage_sphLabeled ""
	variable mImage_sphInter ""
	variable mImage_sphSub ""
	variable mImage_sphUnion ""
	variable mImage_tgc ""
	variable mImage_tgcLabeled ""
	variable mImage_tgcInter ""
	variable mImage_tgcSub ""
	variable mImage_tgcUnion ""
	variable mImage_tor ""
	variable mImage_torLabeled ""
	variable mImage_torInter ""
	variable mImage_torSub ""
	variable mImage_torUnion ""

	variable mImage_fbOff ""
	variable mImage_fbOn ""
	variable mImage_fbInterlay ""
	variable mImage_fbOverlay ""
	variable mImage_fbUnderlay ""
	variable mImage_rt ""
	variable mImage_rtAbort ""

	variable mImage_matrixModeAbove ""
	variable mImage_matrixModeBelow ""

	# variables for the new tree
	variable mCNode2PList
	variable mPNode2CList
	variable mNode2Text
	variable mText2Node
	variable mNodePDrawList
	variable mNodeDrawList
	variable mAffectedNodeList ""
	variable mCopyObj ""

	variable mCoreCmdLevel 0

	# init functions
	method initImages {}
	method initTree          {}
	method initTreeImages    {}
	method initGed           {}
	method closeMged         {}
	method updateRtControl   {}

	# interface operations
	method closeDb           {}
	method newDb             {}
	method openDb            {}
	method saveDb            {}
	method exportDb          {}
	method primaryToolbarAdd        {_type _name {args ""}}
	method primaryToolbarRemove     {_index}

	method bot_split2 {_bot}

	# tree commands
	method dblClick {_x _y}
	method fillTree          {_pnode _ctext _flat {_allow_multiple 0}}
	method fillTreeColumns   {_cnode _ctext}
	method isRegion          {_cgdata}
	method loadMenu          {_menu _node _nodeType _node_id}
	method loadTopMenu          {_menu}
	method findTreeChildNodes {_pnode}
	method findTreeParentNodes {_cnode}
	method getCNodesFromCText {_pnode _text}
	method getTreeImage {_obj _type {_op ""} {_isregion 0}}
	method getTreeNode {_path {_cflag 0}}
	method getTreeNodes {_path {_cflag 0}}
	method getTreePath {_node {_path ""}}
	method handleTreeClose {}
	method handleTreeOpen {}
	method handleTreePopup {_type _x _y _X _Y}
	method handleTreeSelect {}
	method addTreeNodeTag {_node _tag}
	method removeTreeNodeTag {_node _tag}
	method addTreePlaceholder {_pnode}
	method selectTreePath {_path}
	method setTreeView {{_rflag 0}}
	method toggleTreeView {}
	method treeNodeHasBeenOpened {_node}
	method treeNodeIsOpen {_node}
	method purgeNodeData {_node}
	method updateTreeTopWithName {_name}
	method handleCmdPopup {_X _Y}

	# db/display commands
	method getNodeChildren  {_node}
	method getTreeFromGData  {_gdata}
	method getTreeMembers  {_comb {_wflag 0}}
	method getTreeOp {_parent _child}
	method renderComp        {_node}
	method render             {_node _state _trans _updateTree {_wflag 1} {_node_id ""}}
	method selectDisplayColor  {_node}
	method setDisplayColor	   {_node _rgb}
	method selectTransparency  {_node}
	method selectTransparencyCmd  {_node _alpha}
	method setTransparency	   {_node _alpha}
	method raytracePanel    {}
	method doPng             {}
	method setActivePane    {_pane}
	method updateActivePane {_args}
	method doMultiPane      {}
	method doLighting        {}

	# view commands
	method doViewReset {}
	method doAutoview {}
	method doViewCenter {}
	method doAe {_az _el}
	method doFlipView {}

	method doSelectGroup {}

	method showViewAxes     {}
	method showModelAxes    {}
	method showModelAxesTicks {}
	method showGrid     {}
	method snapGrid     {}
	method snapLines    {}
	method showADC     {}

	# private mged commands
	method deleteObj     {_obj}
	method doCopy        {_obj}
	method doPaste       {_pobj _obj}
	method doRename      {_top _obj}
	method doTopPaste    {_obj}
	method renameObj     {_obj}

	method buildPrimaryToolbar {}

	method beginViewRotate {}
	method endViewRotate {_pane}

	method beginViewScale {}
	method endViewScale {_pane}

	method beginViewTranslate {}
	method endViewTranslate {_pane}

	method initViewCenterMode {}
	method initCompPick {}
	method initCompSelect {}
	method compSelectCallback {_mstring}
	method compSelectGroupAdd {_plist}
	method compSelectGroupCommon {_plist}
	method compSelectGroupRemove {_plist}

	method mrayCallback_cvo {_pane _start _target _partitions}
	method mrayCallback_nirt {_pane _start _target _partitions}
	method mrayCallback_pick {_pane _start _target _partitions}

	method initViewMeasure {}
	method endViewMeasure {_mstring}

	method initDefaultBindings {{_comp ""}}
	method initBrlcadBindings {}
	method validateDigit {_d}
	method validateDouble {_d}
	method validateTickInterval {_ti}
	method validateColorComp {_c}

	method backgroundColor {_color}

	method updateHPaneFractions {}
	method updateVPaneFractions {}

	method setColorOption {_cmd _colorOption _color {_tripleColorOption ""}}

	method addHistory {_cmd}

	# Dialogs Section
	method buildSelectGroupDialog {}
	method buildInfoDialog {_name _title _info _size _wrapOption _modality}
	method buildSaveDialog {}
	method buildSelectTransparencyDialog {}
	method buildViewCenterDialog {}
	method centerDialogOverPane {_dialog}

	# Helper Section
	method buildComboBox {_parent _name1 _name2 _varName _text _listOfChoices}

	method watchVar {_name1 _name2 _op}
	method accordianCallback {_item _state}
	method updatePrimitiveLabels {args}
    }
}

# ------------------------------------------------------------
#                      CONSTRUCTOR
# ------------------------------------------------------------
::itcl::body ArcherCore::constructor {{_viewOnly 0} {_noCopy 0} {_noTree 0} {_noToolbar 0} args} {
    global env
    global tcl_platform

    if {$::tcl_platform(platform) == "windows"} {
	set mDisplayFontSizes {0 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29}
    } else {
	set mDisplayFontSizes {0 5 6 7 8 9 10 12}
    }

    array set mViewAxesSizeOffsets {
	"Small"   0.85
	"Medium"  0.75
	"Large"   0.55
	"X-Large" 0.0
    }
    array set mViewAxesSizeValues {
	"Small"   0.2
	"Medium"  0.4
	"Large"   0.8
	"X-Large" 1.6
    }
    array set mModelAxesSizeValues {
	"Small"      0.2
	"Medium"     0.4
	"Large"      0.8
	"X-Large"    1.6
	"View (1x)"  2.0
	"View (2x)"  4.0
	"View (4x)"  8.0
	"View (8x)" 16.0
    }

    set mStandardViewsMenuCommands {
	command front -label "Front" \
	    -helpstr "Set view to front"
	command rear -label "Rear" \
	    -helpstr "Set view to rear"
	command port -label "Port" \
	    -helpstr "Set view to port/left"
	command starboard -label "Starboard" \
	    -helpstr "Set view to starboard/right"
	command top -label "Top" \
	    -helpstr "Set view to top"
	command bottom -label "Bottom" \
	    -helpstr "Set view to bottom"
	separator sep0
	command 35, 25 -label "35, 25" \
	    -helpstr "Set view to az=35, el=25"
	command 45, 45 -label "45, 45" \
	    -helpstr "Set view to az=45, el=45"
    }

    set mLastSelectedDir [pwd]

    set mFontText [list $SystemWindowFont 8]
    set mFontTextBold [list $SystemWindowFont 8 bold]

    set mProgressBarHeight [expr {[font metrics $mFontText -linespace] + 1}]
    set mViewOnly $_viewOnly
    set mDbNoCopy $_noCopy
    set mNoTree $_noTree
    set mNoToolbar $_noToolbar

    if {$ArcherCore::inheritFromToplevel} {
	wm withdraw [namespace tail $this]
    }

    if {![info exists env(DISPLAY)]} {
	set env(DISPLAY) ":0"
    }

    set mImgDir [file join [bu_dir data] tclscripts archer images]

    if {[llength $args] == 1} {
	set args [lindex $args 0]
    }

    set dm_list [split [dm_list] ',']
    set mDisplayType [lindex $dm_list 0]

    # horizontal panes
    itk_component add hpane {
	::iwidgets::panedwindow $itk_interior.hpane \
	    -orient horizontal \
	    -thickness 5 \
	    -sashborderwidth 1 \
	    -sashcursor sb_v_double_arrow \
	    -showhandle 0 \
	    -background $LABEL_BACKGROUND_COLOR
    } {}

    $itk_component(hpane) add topView
    $itk_component(hpane) paneconfigure topView \
	-margin 0

    if {!$mViewOnly} {
	buildCommandView
    }

    # vertical panes
    set parent [$itk_component(hpane) childsite topView]
    itk_component add vpane {
	::iwidgets::panedwindow $parent.vpane \
	    -orient vertical \
	    -thickness 5 \
	    -sashborderwidth 1 \
	    -sashcursor sb_h_double_arrow \
	    -showhandle 0 \
	    -background $LABEL_BACKGROUND_COLOR
    } {}

    if {!$mNoTree} {
	$itk_component(vpane) add hierarchyView
    }

    if {!$mViewOnly} {
	$itk_component(vpane) add geomView
	$itk_component(vpane) add attrView

	if {!$mNoTree} {
	    $itk_component(vpane) paneconfigure hierarchyView \
		-margin 0 \
		-minimum 0
	}

	$itk_component(vpane) paneconfigure geomView \
	    -margin 0
	$itk_component(vpane) paneconfigure attrView \
	    -margin 0 \
	    -minimum 0
    } else {
	$itk_component(vpane) add geomView
	$itk_component(vpane) paneconfigure geomView \
	    -margin 0 \
	    -minimum 0
    }

    # frame for all geometry canvas's
    set parent [$itk_component(vpane) childsite geomView]
    itk_component add canvasF {
	::ttk::frame $parent.canvasF \
	    -borderwidth 1 \
	    -relief sunken
    } {}

    if {$mViewOnly && !$mNoToolbar} {
	itk_component add canvas_menu {
	    ::iwidgets::menubar $itk_component(canvasF).canvas_menu \
		-helpvariable [::itcl::scope mStatusStr] \
		-font $mFontText \
		-activeborderwidth 2 \
		-borderwidth 0 \
		-activebackground $SystemHighlight \
		-activeforeground $SystemHighlightText
	} {
	    keep -background
	}

	buildCanvasMenubar
    }

    if {!$mViewOnly} {
	# dummy canvas
	itk_component add canvas {
	    ::frame $itk_component(canvasF).canvas \
		-borderwidth 0 \
		-relief flat
	} {}

	grid $itk_component(canvas) -row 0 -column 0 -columnspan 3 -sticky news
	grid rowconfigure $itk_component(canvasF) 0 -weight 1
	grid columnconfigure $itk_component(canvasF) 1 -weight 1

	# status bar
	itk_component add statusF {
	    ::ttk::frame $itk_interior.statfrm
	} {}

	itk_component add status {
	    ::ttk::label  $itk_component(statusF).status -anchor w -relief sunken \
		-font $mFontText \
		-textvariable [::itcl::scope mStatusStr]
	} {}

	itk_component add progress {
	    ::canvas $itk_component(statusF).progress \
		-relief sunken \
		-bd 1 \
		-background $LABEL_BACKGROUND_COLOR \
		-width $mProgressBarWidth \
		-height $mProgressBarHeight
	} {}

	itk_component add editLabel {
	    ::ttk::label  $itk_component(statusF).edit -relief sunken \
		-font $mFontText \
		-width 5
	} {}

	itk_component add dbtype {
	    ::ttk::label  $itk_component(statusF).dbtype -anchor w -relief sunken \
		-font $mFontText \
		-width 8 -textvariable [::itcl::scope mDbType]
	} {}

	pack $itk_component(dbtype) -side right -padx 1 -pady 1
	pack $itk_component(editLabel) -side right -padx 1 -pady 1
	pack $itk_component(progress) -fill y -side right -padx 1 -pady 1
	pack $itk_component(status) -expand yes -fill x -padx 1 -pady 1

	# tree control
	initTree
    } else {
	# dummy canvas
	itk_component add canvas {
	    ::frame $itk_component(canvasF).canvas \
		-borderwidth 0 \
		-relief flat
	}

	if {!$mNoToolbar} {
	    grid $itk_component(canvas_menu) -row 0 -column 0 -sticky w
	    grid $itk_component(canvas) -row 1 -column 0 -sticky news
	    grid rowconfigure $itk_component(canvasF) 1 -weight 1
	} else {
	    grid $itk_component(canvas) -row 0 -column 0 -sticky news
	    grid rowconfigure $itk_component(canvasF) 0 -weight 1
	}
	grid columnconfigure $itk_component(canvasF) 0 -weight 1

	# tree control
	initTree
    }

    # docking areas
    itk_component add north {
	::ttk::frame $itk_interior.north -height 0
    } {}
    itk_component add south {
	::ttk::frame $itk_interior.south -height 0
    } {}
    set parent [$itk_component(hpane) childsite topView]
    itk_component add east {
	::ttk::frame $parent.east -width 0
    } {}
    itk_component add west {
	::ttk::frame $itk_interior.west -width 0
    } {}

    pack $itk_component(south) -side bottom -fill x
    pack $itk_component(north) -side top -fill x
    pack $itk_component(west)  -side left -fill y
    pack $itk_component(east)  -side right -fill y
    if {!$mViewOnly} {
	if {!$mDelayCommandViewBuild} {
	    pack $itk_component(advancedTabs) -fill both -expand yes
	}
	pack $itk_component(statusF) -before $itk_component(south) -side bottom -fill x
    }
    if {!$mNoTree} {
	pack $itk_component(treeAccordian) -fill both -expand yes
    }
    pack $itk_component(hpane) -fill both -expand yes
    pack $itk_component(vpane) -fill both -expand yes
    pack $itk_component(canvasF) -fill both -expand yes

    if {!$mViewOnly} {
	set _fontNames [font names]
	set _fontIndex [lsearch $_fontNames $mFontArrowsName]
	if {$_fontIndex == -1} {
	    font create $mFontArrowsName -family $mFontArrows
	}
    }

    if {!$mNoToolbar} {
	buildPrimaryToolbar
    }

    trace add variable [::itcl::scope mMeasuringStickColor] write watchVar
    trace add variable [::itcl::scope mMeasuringStickMode] write watchVar
    trace add variable [::itcl::scope mPrimitiveLabelColor] write watchVar
    trace add variable [::itcl::scope mScaleColor] write watchVar

    trace add variable [::itcl::scope mModelAxesColor] write watchVar
    trace add variable [::itcl::scope mModelAxesLabelColor] write watchVar
    trace add variable [::itcl::scope mModelAxesTickColor] write watchVar
    trace add variable [::itcl::scope mModelAxesTickMajorColor] write watchVar

    trace add variable [::itcl::scope mViewingParamsColor] write watchVar
    trace add variable [::itcl::scope mViewAxesColor] write watchVar
    trace add variable [::itcl::scope mViewAxesLabelColor] write watchVar

    trace add variable [::itcl::scope mRayColorOdd] write watchVar
    trace add variable [::itcl::scope mRayColorEven] write watchVar
    trace add variable [::itcl::scope mRayColorVoid] write watchVar

    trace add variable [::itcl::scope mDisplayFontSize] write watchVar

    eval itk_initialize $args

    $this configure -background $LABEL_BACKGROUND_COLOR

    if {!$mViewOnly} {
	# set initial toggle variables
	set mVPaneToggle3 $mVPaneFraction3
	set mVPaneToggle5 $mVPaneFraction5

	updateSaveMode
    }

    initImages
    initTreeImages

    if {!$mViewOnly && !$mDelayCommandViewBuild} {
	after idle "$itk_component(cmd) configure -cmd_prefix \"[namespace tail $this] cmd\""
    }

#    Load ""

    if {!$mNoToolbar} {
	$itk_component(primaryToolbar) itemconfigure open -state normal
    }

    #    eval itk_initialize $args
}

# ------------------------------------------------------------
#                       DESTRUCTOR
# ------------------------------------------------------------
::itcl::body ArcherCore::destructor {} {
    # We do this to remove librt's reference
    # to $mTargetCopy now. Once this reference is
    # gone, we can successfully delete the temporary
    # file here in the destructor.
    catch {::itcl::delete object $itk_component(ged)}

    set mTargetOldCopy $mTargetCopy
    deleteTargetOldCopy
}

# ------------------------------------------------------------
#                        OPTIONS
# ------------------------------------------------------------


::itcl::body ArcherCore::handleMoreArgs {args} {
    eval $itk_component(cmd) print_more_args_prompt $args
    return [$itk_component(cmd) get_more_args]
}


::itcl::body ArcherCore::checkIfSelectedObjExists {} {
    # This is a placeholder that gets overridden.
}


# e_flag_expands_globbing h_flag_unused s_flag_save_needed t_flag_tree_redraw_needed
::itcl::body ArcherCore::gedWrapper {cmd eflag hflag sflag tflag args} {
    if {!$mFreezeGUI} {
	SetWaitCursor $this
    }

    if {$eflag} {
	set optionsAndArgs [eval dbExpand $args]
	set options [lindex $optionsAndArgs 0]
	set expandedArgs [lindex $optionsAndArgs 1]
    } else {
	set options {}
	set expandedArgs $args
    }

    if {[catch {eval gedCmd $cmd $options $expandedArgs} ret]} {
	if {!$mFreezeGUI} {
	    SetNormalCursor $this
	}
	error $ret
    }

    if {$sflag} {
	set mNeedSave 1
	if {!$mFreezeGUI} {
	    updateSaveMode
	}
    }

    if {!$mFreezeGUI} {
	switch -- $tflag {
	    0 {
		# Do nothing
	    }
	    1 {
		catch {updateTreeDrawLists}
	    }
	    default {
		catch {syncTree}
	    }
	}
	checkIfSelectedObjExists

	SetNormalCursor $this
    }

    return $ret
}

::itcl::body ArcherCore::buildCommandView {} {
    $itk_component(hpane) add bottomView
    $itk_component(hpane) paneconfigure bottomView \
	-margin 0 \
	-minimum 0

    if {$mSeparateCommandWindow} {
	itk_component add sepcmdT {
	    ::toplevel $itk_interior.sepcmdT
	} {}

	::wm title $itk_component(sepcmdT) "Archer Command"
	set parent $itk_component(sepcmdT)
	wm protocol $itk_component(sepcmdT) WM_DELETE_WINDOW {exitArcher $::ArcherCore::application}
    } else {
	set parent [$itk_component(hpane) childsite bottomView]
    }

    itk_component add advancedTabs {
	::ttk::notebook $parent.tabs
    } {}

    itk_component add cmd {
	Command $itk_component(advancedTabs).cmd \
	    -relief sunken -borderwidth 2 \
	    -hscrollmode none -vscrollmode dynamic \
	    -scrollmargin 2 -visibleitems 80x15 \
	    -textbackground $SystemWindow -prompt "ArcherCore> " \
	    -prompt2 "% " -result_color black -cmd_color red \
	    -background $LABEL_BACKGROUND_COLOR \
	    -cmd_history_callback [::itcl::code $this addHistory]
    } {}

    $itk_component(cmd) component text configure -background white

    itk_component add history {
	::iwidgets::scrolledtext $itk_component(advancedTabs).history \
	    -relief sunken -borderwidth 2 \
	    -hscrollmode none -vscrollmode dynamic \
	    -scrollmargin 2 -visibleitems 80x15 \
	    -textbackground $SystemWindow
    } {}
    [$itk_component(history) component text] configure -state disabled

    $itk_component(advancedTabs) add $itk_component(cmd) -text "Command"
    $itk_component(advancedTabs) add $itk_component(history) -text "History"

    itk_component add cmdpopup {
	::menu $itk_component(advancedTabs).cmdmenu \
	    -tearoff 0
    } {}

    $itk_component(cmdpopup) add command \
	-label "Paste Selected Path" \
	-command "[$itk_component(cmd) component text] insert insert \
		  \[[::itcl::code $this getSelectedTreePaths]\]"

    bind [$itk_component(cmd) component text] <Button-3> [::itcl::code $this handleCmdPopup %X %Y]
}

::itcl::body ArcherCore::buildCanvasMenubar {}  {
    if {$mViewOnly && !$mNoToolbar} {
	# View Menu
	$itk_component(canvas_menu) add menubutton view \
	    -text "View" -menu "options -tearoff 0 $mStandardViewsMenuCommands"

	$itk_component(canvas_menu) menuconfigure .view.front \
	    -command [::itcl::code $this doAe 0 0] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .view.rear \
	    -command [::itcl::code $this doAe 180 0] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .view.port \
	    -command [::itcl::code $this doAe 90 0] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .view.starboard \
	    -command [::itcl::code $this doAe -90 0] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .view.top \
	    -command [::itcl::code $this doAe 270 90] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .view.bottom \
	    -command [::itcl::code $this doAe 270 -90] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .view.35,25 \
	    -command [::itcl::code $this doAe 35 25] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .view.45,45 \
	    -command [::itcl::code $this doAe 45 45] \
	    -state disabled

	# Background Menu
	$itk_component(canvas_menu) add menubutton background \
	    -text "Background" -menu {
		options -tearoff 0

		command black -label "Black" \
		    -helpstr "Set background color to black"
		command grey -label "Grey" \
		    -helpstr "Set background color to grey"
		command white -label "White" \
		    -helpstr "Set background color to white"
		command cyan -label "Cyan" \
		    -helpstr "Set background color to cyan"
		command blue -label "Light Blue" \
		    -helpstr "Set background color to blue"
		command navy -label "Navy" \
		    -helpstr "Set background color to navy"
	    }

	$itk_component(canvas_menu) menuconfigure .background.black \
	    -command [::itcl::code $this backgroundColor Black]
	$itk_component(canvas_menu) menuconfigure .background.grey \
	    -command [::itcl::code $this backgroundColor Grey]
	$itk_component(canvas_menu) menuconfigure .background.white \
	    -command [::itcl::code $this backgroundColor White]
	$itk_component(canvas_menu) menuconfigure .background.cyan \
	    -command [::itcl::code $this backgroundColor Cyan]
	$itk_component(canvas_menu) menuconfigure .background.blue \
	    -command [::itcl::code $this backgroundColor Blue]
	$itk_component(canvas_menu) menuconfigure .background.navy \
	    -command [::itcl::code $this backgroundColor Navy]

    # Raytrace Menu
	$itk_component(canvas_menu) add menubutton raytrace \
	    -text "Raytrace" -menu {
		options -tearoff 0

		cascade rt \
		    -label "rt" \
		    -menu {
			command fivetwelve \
			    -label "512x512" \
			    -helpstr "Raytrace at a resolution of 512x512"
			command tentwenty \
			    -label "1024x1024" \
			    -helpstr "Raytrace at a resolution of 1024x1024"
			command window \
			    -label "Window Size" \
			    -helpstr "Raytrace at a resolution matching the window width"
		    }
		cascade rtcheck \
		    -label "rtcheck" \
		    -menu {
			command fifty \
			    -label "50x50" \
			    -helpstr "Check for overlaps using a 50x50 grid"
			command hundred \
			    -label "100x100" \
			    -helpstr "Check for overlaps using a 100x100 grid"
			command twofiftysix \
			    -label "256x256" \
			    -helpstr "Check for overlaps using a 256x256 grid"
			command fivetwelve \
			    -label "512x512" \
			    -helpstr "Check for overlaps using a 512x512 grid"
		    }
		cascade rtedge \
		    -label "rtedge" \
		    -menu {
			command fivetwelve \
			    -label "512x512" \
			    -helpstr "Raytrace at a resolution of 512x512"
			command tentwenty \
			    -label "1024x1024" \
			    -helpstr "Raytrace at a resolution of 1024x1024"
			command window \
			    -label "Window Size" \
			    -helpstr "Raytrace at a resolution matching the window width"
		    }
		separator sep0
		command nirt \
		    -label "nirt" \
		    -helpstr "Launch nirt from view center"
	    }

	$itk_component(canvas_menu) menuconfigure .raytrace.rt \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rt.fivetwelve \
	    -command [::itcl::code $this launchRtApp rt 512] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rt.tentwenty \
	    -command [::itcl::code $this launchRtApp rt 1024] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rt.window \
	    -command [::itcl::code $this launchRtApp rt window] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck.fifty \
	    -command [::itcl::code $this launchRtApp rtcheck 50] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck.hundred \
	    -command [::itcl::code $this launchRtApp rtcheck 100] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck.twofiftysix \
	    -command [::itcl::code $this launchRtApp rtcheck 256] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck.fivetwelve \
	    -command [::itcl::code $this launchRtApp rtcheck 512] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rtedge \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rtedge.fivetwelve \
	    -command [::itcl::code $this launchRtApp rtedge 512] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rtedge.tentwenty \
	    -command [::itcl::code $this launchRtApp rtedge 1024] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.rtedge.window \
	    -command [::itcl::code $this launchRtApp rtedge window] \
	    -state disabled
	$itk_component(canvas_menu) menuconfigure .raytrace.nirt \
	    -command [::itcl::code $this launchNirt] \
	    -state disabled
    }
}

::itcl::body ArcherCore::redrawObj {obj {wflag 1}} {
    if {$obj == ""} {
	return
    }

    set rdata [gedCmd how -b $obj]
    if {$rdata == -1} {
	return
    }

    set rmode [lindex $rdata 0]
    set rtrans [lindex $rdata 1]
    set obj [file tail $obj]

    foreach item [gedCmd solid_report 0] {
	if {[lsearch [split $item /] $obj] != -1} {
	    if { $rmode == $DISPLAY_MODE_HIDDEN } {
		gedCmd draw -h $item
	    } else {
		gedCmd draw -m$rmode -x$rtrans $item
	    }
	}
    }
}

::itcl::body ArcherCore::redrawWho {} {
    $itk_component(ged) refresh_off

    foreach obj [gedCmd who] {
	set rdata [gedCmd how -b $obj]
	set rmode [lindex $rdata 0]
	set rtrans [lindex $rdata 1]

	if {$rmode == $DISPLAY_MODE_HIDDEN} {
	    gedCmd draw -h $obj
	} else {
	    gedCmd draw -m$rmode -x$rtrans $obj
	}
    }

    $itk_component(ged) refresh_on
    $itk_component(ged) refresh_all
}


::itcl::body ArcherCore::initImages {} {
    set dir $mImgDir

    if {!$mViewOnly} {
	if {!$mNoToolbar} {
	    # Primary Toolbar
	    $itk_component(primaryToolbar) itemconfigure open \
		-image [image create photo \
			    -file [file join $dir open.png]]
	    $itk_component(primaryToolbar) itemconfigure save \
		-image [image create photo \
			    -file [file join $dir save.png]]
	}

	# Tree Control
#	$itk_component(tree) configure \
	    -openimage [image create photo -file [file join $dir folder_open_small.png]] \
	    -closeimage [image create photo -file [file join $dir folder_closed_small.png]] \
	    -nodeimage [image create photo -file [file join $dir file_text_small.png]]
#	$itk_component(tree) redraw

    }

    if {!$mNoToolbar} {
	# View Toolbar
	$itk_component(primaryToolbar) itemconfigure rotate \
	    -image [image create photo \
			-file [file join $dir view_rotate.png]]
	$itk_component(primaryToolbar) itemconfigure translate \
	    -image [image create photo \
			-file [file join $dir view_translate.png]]
	$itk_component(primaryToolbar) itemconfigure scale \
	    -image [image create photo \
			-file [file join $dir view_scale.png]]
	$itk_component(primaryToolbar) itemconfigure center \
	    -image [image create photo \
			-file [file join $dir view_center.png]]
	$itk_component(primaryToolbar) itemconfigure cpick \
	    -image [image create photo \
			-file [file join $dir component_pick.png]]
	$itk_component(primaryToolbar) itemconfigure cselect \
	    -image [image create photo \
			-file [file join $dir component_select.png]]
	$itk_component(primaryToolbar) itemconfigure measure \
	    -image [image create photo \
			-file [file join $dir measure.png]]
    }
}

::itcl::body ArcherCore::initTree {} {
    if {$mNoTree} {
	return
    }

    set parent [$itk_component(vpane) childsite hierarchyView]

    set mNode2Text() ""
    set mText2Node() ""
    set mCNode2PList() ""
    set mPNode2CList() ""

    itk_component add treeAccordian {
	::cadwidgets::Accordian $parent.treeAccordian
    } {}

    $itk_component(treeAccordian) addTogglePanelCallback [::itcl::code $this accordianCallback]

    if {$mTreeMode < $TREE_MODE_COLOR_OBJECTS} {
	$itk_component(treeAccordian) insert 0 [lindex $TREE_MODE_NAMES $TREE_MODE_TREE]
    } else {
	$itk_component(treeAccordian) insert 0 "[lindex $TREE_MODE_NAMES $TREE_MODE_EDGE_OBJECTS] (Tree)"
	$itk_component(treeAccordian) insert 0 "[lindex $TREE_MODE_NAMES $TREE_MODE_GHOST_OBJECTS] (Tree)"
	$itk_component(treeAccordian) insert 0 "[lindex $TREE_MODE_NAMES $TREE_MODE_COLOR_OBJECTS] (Tree)"
    }

    itk_component add newtree {
	::ttk::treeview $itk_component(treeAccordian).tree \
	    -selectmode browse \
	    -show tree
    } {}

    bind $itk_component(newtree) <Button-3> [::itcl::code $this handleTreePopup $TREE_POPUP_TYPE_NULL %x %y %X %Y]
    bind $itk_component(newtree) <<TreeviewSelect>> [::itcl::code $this handleTreeSelect]
    bind $itk_component(newtree) <<TreeviewOpen>> [::itcl::code $this handleTreeOpen]
    bind $itk_component(newtree) <<TreeviewClose>> [::itcl::code $this handleTreeClose]
    $itk_component(newtree) tag bind $TREE_POPUP_TAG <Button-3> [::itcl::code $this handleTreePopup TREE_POPUP_TYPE_NODE %x %y %X %Y]
    $itk_component(newtree) tag bind $TREE_POPUP_TAG <Double-1> [::itcl::code $this dblClick %x %y]
    $itk_component(newtree) tag configure $TREE_FULLY_DISPLAYED_TAG \
	-foreground red \
	-font TkHeadingFont
    $itk_component(newtree) tag configure $TREE_PARTIALLY_DISPLAYED_TAG \
	-foreground \#9999ff \
	-font TkHeadingFont
    $itk_component(newtree) tag configure $TREE_AFFECTED_TAG \
	-background yellow2

    itk_component add newtreepopup {
	::menu $itk_interior.newtreemenu \
	    -tearoff 0
    } {}

    itk_component add newtreehscroll {
	::ttk::scrollbar $itk_component(treeAccordian).newtreehscroll \
	    -orient horizontal
    } {}

    itk_component add newtreevscroll {
	::ttk::scrollbar $itk_component(treeAccordian).newtreevscroll \
	    -orient vertical
    } {}

    # Hook up scrollbars
    $itk_component(newtree) configure -xscrollcommand "$itk_component(newtreehscroll) set"
    $itk_component(newtree) configure -yscrollcommand "$itk_component(newtreevscroll) set"
    $itk_component(newtreehscroll) configure -command "$itk_component(newtree) xview"
    $itk_component(newtreevscroll) configure -command "$itk_component(newtree) yview"

    # newtree and its scrollbars get added via a callback to accordianCallback
    if {$mTreeMode < $TREE_MODE_COLOR_OBJECTS} {
	$itk_component(treeAccordian) togglePanel [lindex $TREE_MODE_NAMES $mTreeMode]
    } else {
	$itk_component(treeAccordian) togglePanel "[lindex $TREE_MODE_NAMES $mTreeMode] (Tree)"
    }
}

::itcl::body ArcherCore::initTreeImages {} {
    if {$mNoTree} {
	return
    }

    set mImage_air [image create photo -file [file join $mImgDir air.png]]
    set mImage_airLabeled [image create photo -file [file join $mImgDir air_labeled.png]]
    set mImage_airInter [image create photo -file [file join $mImgDir air_intersect.png]]
    set mImage_airSub [image create photo -file [file join $mImgDir air_subtract.png]]
    set mImage_airUnion [image create photo -file [file join $mImgDir air_union.png]]

    set mImage_airregion [image create photo -file [file join $mImgDir airregion.png]]
    set mImage_airregionInter [image create photo -file [file join $mImgDir airregion_intersect.png]]
    set mImage_airregionSub [image create photo -file [file join $mImgDir airregion_subtract.png]]
    set mImage_airregionUnion [image create photo -file [file join $mImgDir airregion_union.png]]

    set mImage_comb [image create photo -file [file join $mImgDir comb.png]]
    set mImage_combLabeled [image create photo -file [file join $mImgDir comb_labeled.png]]
    set mImage_combInter [image create photo -file [file join $mImgDir comb_intersect.png]]
    set mImage_combSub [image create photo -file [file join $mImgDir comb_subtract.png]]
    set mImage_combUnion [image create photo -file [file join $mImgDir comb_union.png]]

    set mImage_region [image create photo -file [file join $mImgDir region.png]]
    set mImage_regionLabeled [image create photo -file [file join $mImgDir region_labeled.png]]
    set mImage_regionInter [image create photo -file [file join $mImgDir region_intersect.png]]
    set mImage_regionSub [image create photo -file [file join $mImgDir region_subtract.png]]
    set mImage_regionUnion [image create photo -file [file join $mImgDir region_union.png]]

    set mImage_arb8 [image create photo -file [file join $mImgDir arb8.png]]
    set mImage_arb8Labeled [image create photo -file [file join $mImgDir arb8_labeled.png]]
    set mImage_arb8Inter [image create photo -file [file join $mImgDir arb8_intersect.png]]
    set mImage_arb8Sub [image create photo -file [file join $mImgDir arb8_subtract.png]]
    set mImage_arb8Union [image create photo -file [file join $mImgDir arb8_union.png]]

    set mImage_arb7 [image create photo -file [file join $mImgDir arb7.png]]
    set mImage_arb7Labeled [image create photo -file [file join $mImgDir arb7_labeled.png]]
    set mImage_arb7Inter [image create photo -file [file join $mImgDir arb7_intersect.png]]
    set mImage_arb7Sub [image create photo -file [file join $mImgDir arb7_subtract.png]]
    set mImage_arb7Union [image create photo -file [file join $mImgDir arb7_union.png]]

    set mImage_arb6 [image create photo -file [file join $mImgDir arb6.png]]
    set mImage_arb6Labeled [image create photo -file [file join $mImgDir arb6_labeled.png]]
    set mImage_arb6Inter [image create photo -file [file join $mImgDir arb6_intersect.png]]
    set mImage_arb6Sub [image create photo -file [file join $mImgDir arb6_subtract.png]]
    set mImage_arb6Union [image create photo -file [file join $mImgDir arb6_union.png]]

    set mImage_arb5 [image create photo -file [file join $mImgDir arb5.png]]
    set mImage_arb5Labeled [image create photo -file [file join $mImgDir arb5_labeled.png]]
    set mImage_arb5Inter [image create photo -file [file join $mImgDir arb5_intersect.png]]
    set mImage_arb5Sub [image create photo -file [file join $mImgDir arb5_subtract.png]]
    set mImage_arb5Union [image create photo -file [file join $mImgDir arb5_union.png]]

    set mImage_arb4 [image create photo -file [file join $mImgDir arb4.png]]
    set mImage_arb4Labeled [image create photo -file [file join $mImgDir arb4_labeled.png]]
    set mImage_arb4Inter [image create photo -file [file join $mImgDir arb4_intersect.png]]
    set mImage_arb4Sub [image create photo -file [file join $mImgDir arb4_subtract.png]]
    set mImage_arb4Union [image create photo -file [file join $mImgDir arb4_union.png]]

    set mImage_arbn [image create photo -file [file join $mImgDir arbn.png]]
    set mImage_arbnLabeled [image create photo -file [file join $mImgDir arbn_labeled.png]]
    set mImage_arbnInter [image create photo -file [file join $mImgDir arbn_intersect.png]]
    set mImage_arbnSub [image create photo -file [file join $mImgDir arbn_subtract.png]]
    set mImage_arbnUnion [image create photo -file [file join $mImgDir arbn_union.png]]

    set mImage_ars [image create photo -file [file join $mImgDir ars.png]]
    set mImage_arsLabeled [image create photo -file [file join $mImgDir ars_labeled.png]]
    set mImage_arsInter [image create photo -file [file join $mImgDir ars_intersect.png]]
    set mImage_arsSub [image create photo -file [file join $mImgDir ars_subtract.png]]
    set mImage_arsUnion [image create photo -file [file join $mImgDir ars_union.png]]

    set mImage_bot [image create photo -file [file join $mImgDir bot.png]]
    set mImage_botLabeled [image create photo -file [file join $mImgDir bot_labeled.png]]
    set mImage_botInter [image create photo -file [file join $mImgDir bot_intersect.png]]
    set mImage_botSub [image create photo -file [file join $mImgDir bot_subtract.png]]
    set mImage_botUnion [image create photo -file [file join $mImgDir bot_union.png]]

    set mImage_brep [image create photo -file [file join $mImgDir brep.png]]
    set mImage_brepLabeled [image create photo -file [file join $mImgDir brep_labeled.png]]
    set mImage_brepInter [image create photo -file [file join $mImgDir brep_intersect.png]]
    set mImage_brepSub [image create photo -file [file join $mImgDir brep_subtract.png]]
    set mImage_brepUnion [image create photo -file [file join $mImgDir brep_union.png]]

    set mImage_dsp [image create photo -file [file join $mImgDir dsp.png]]
    set mImage_dspLabeled [image create photo -file [file join $mImgDir dsp_labeled.png]]
    set mImage_dspInter [image create photo -file [file join $mImgDir dsp_intersect.png]]
    set mImage_dspSub [image create photo -file [file join $mImgDir dsp_subtract.png]]
    set mImage_dspUnion [image create photo -file [file join $mImgDir dsp_union.png]]

    set mImage_ehy [image create photo -file [file join $mImgDir ehy.png]]
    set mImage_ehyLabeled [image create photo -file [file join $mImgDir ehy_labeled.png]]
    set mImage_ehyInter [image create photo -file [file join $mImgDir ehy_intersect.png]]
    set mImage_ehySub [image create photo -file [file join $mImgDir ehy_subtract.png]]
    set mImage_ehyUnion [image create photo -file [file join $mImgDir ehy_union.png]]

    set mImage_ell [image create photo -file [file join $mImgDir ell.png]]
    set mImage_ellLabeled [image create photo -file [file join $mImgDir ell_labeled.png]]
    set mImage_ellInter [image create photo -file [file join $mImgDir ell_intersect.png]]
    set mImage_ellSub [image create photo -file [file join $mImgDir ell_subtract.png]]
    set mImage_ellUnion [image create photo -file [file join $mImgDir ell_union.png]]

    set mImage_epa [image create photo -file [file join $mImgDir epa.png]]
    set mImage_epaLabeled [image create photo -file [file join $mImgDir epa_labeled.png]]
    set mImage_epaInter [image create photo -file [file join $mImgDir epa_intersect.png]]
    set mImage_epaSub [image create photo -file [file join $mImgDir epa_subtract.png]]
    set mImage_epaUnion [image create photo -file [file join $mImgDir epa_union.png]]

    set mImage_eto [image create photo -file [file join $mImgDir eto.png]]
    set mImage_etoLabeled [image create photo -file [file join $mImgDir eto_labeled.png]]
    set mImage_etoInter [image create photo -file [file join $mImgDir eto_intersect.png]]
    set mImage_etoSub [image create photo -file [file join $mImgDir eto_subtract.png]]
    set mImage_etoUnion [image create photo -file [file join $mImgDir eto_union.png]]

    set mImage_extrude [image create photo -file [file join $mImgDir extrude.png]]
    set mImage_extrudeLabeled [image create photo -file [file join $mImgDir extrude_labeled.png]]
    set mImage_extrudeInter [image create photo -file [file join $mImgDir extrude_intersect.png]]
    set mImage_extrudeSub [image create photo -file [file join $mImgDir extrude_subtract.png]]
    set mImage_extrudeUnion [image create photo -file [file join $mImgDir extrude_union.png]]

    set mImage_half [image create photo -file [file join $mImgDir half.png]]
    set mImage_halfLabeled [image create photo -file [file join $mImgDir half_labeled.png]]
    set mImage_halfInter [image create photo -file [file join $mImgDir half_intersect.png]]
    set mImage_halfSub [image create photo -file [file join $mImgDir half_subtract.png]]
    set mImage_halfUnion [image create photo -file [file join $mImgDir half_union.png]]

    set mImage_hyp [image create photo -file [file join $mImgDir hyp.png]]
    set mImage_hypLabeled [image create photo -file [file join $mImgDir hyp_labeled.png]]
    set mImage_hypInter [image create photo -file [file join $mImgDir hyp_intersect.png]]
    set mImage_hypSub [image create photo -file [file join $mImgDir hyp_subtract.png]]
    set mImage_hypUnion [image create photo -file [file join $mImgDir hyp_union.png]]

    set mImage_invalid [image create photo -file [file join $mImgDir invalid.png]]
    set mImage_invalidInter [image create photo -file [file join $mImgDir invalid_intersect.png]]
    set mImage_invalidSub [image create photo -file [file join $mImgDir invalid_subtract.png]]
    set mImage_invalidUnion [image create photo -file [file join $mImgDir invalid_union.png]]

    set mImage_metaball [image create photo -file [file join $mImgDir metaball.png]]
    set mImage_metaballLabeled [image create photo -file [file join $mImgDir metaball_labeled.png]]
    set mImage_metaballInter [image create photo -file [file join $mImgDir metaball_intersect.png]]
    set mImage_metaballSub [image create photo -file [file join $mImgDir metaball_subtract.png]]
    set mImage_metaballUnion [image create photo -file [file join $mImgDir metaball_union.png]]

    set mImage_nmg [image create photo -file [file join $mImgDir nmg.png]]
    set mImage_nmgLabeled [image create photo -file [file join $mImgDir nmg_labeled.png]]
    set mImage_nmgInter [image create photo -file [file join $mImgDir nmg_intersect.png]]
    set mImage_nmgSub [image create photo -file [file join $mImgDir nmg_subtract.png]]
    set mImage_nmgUnion [image create photo -file [file join $mImgDir nmg_union.png]]

    set mImage_other [image create photo -file [file join $mImgDir other.png]]
    set mImage_otherInter [image create photo -file [file join $mImgDir other_intersect.png]]
    set mImage_otherSub [image create photo -file [file join $mImgDir other_subtract.png]]
    set mImage_otherUnion [image create photo -file [file join $mImgDir other_union.png]]

    set mImage_partLabeled [image create photo -file [file join $mImgDir part_labeled.png]]

    set mImage_pipe [image create photo -file [file join $mImgDir pipe.png]]
    set mImage_pipeLabeled [image create photo -file [file join $mImgDir pipe_labeled.png]]
    set mImage_pipeInter [image create photo -file [file join $mImgDir pipe_intersect.png]]
    set mImage_pipeSub [image create photo -file [file join $mImgDir pipe_subtract.png]]
    set mImage_pipeUnion [image create photo -file [file join $mImgDir pipe_union.png]]

    set mImage_rhc [image create photo -file [file join $mImgDir rhc.png]]
    set mImage_rhcLabeled [image create photo -file [file join $mImgDir rhc_labeled.png]]
    set mImage_rhcInter [image create photo -file [file join $mImgDir rhc_intersect.png]]
    set mImage_rhcSub [image create photo -file [file join $mImgDir rhc_subtract.png]]
    set mImage_rhcUnion [image create photo -file [file join $mImgDir rhc_union.png]]

    set mImage_rpc [image create photo -file [file join $mImgDir rpc.png]]
    set mImage_rpcLabeled [image create photo -file [file join $mImgDir rpc_labeled.png]]
    set mImage_rpcInter [image create photo -file [file join $mImgDir rpc_intersect.png]]
    set mImage_rpcSub [image create photo -file [file join $mImgDir rpc_subtract.png]]
    set mImage_rpcUnion [image create photo -file [file join $mImgDir rpc_union.png]]

    set mImage_sketch [image create photo -file [file join $mImgDir sketch.png]]
    set mImage_sketchLabeled [image create photo -file [file join $mImgDir sketch_labeled.png]]
    set mImage_sketchInter [image create photo -file [file join $mImgDir sketch_intersect.png]]
    set mImage_sketchSub [image create photo -file [file join $mImgDir sketch_subtract.png]]
    set mImage_sketchUnion [image create photo -file [file join $mImgDir sketch_union.png]]

    set mImage_sph [image create photo -file [file join $mImgDir sph.png]]
    set mImage_sphLabeled [image create photo -file [file join $mImgDir sph_labeled.png]]
    set mImage_sphInter [image create photo -file [file join $mImgDir sph_intersect.png]]
    set mImage_sphSub [image create photo -file [file join $mImgDir sph_subtract.png]]
    set mImage_sphUnion [image create photo -file [file join $mImgDir sph_union.png]]

    set mImage_tgc [image create photo -file [file join $mImgDir tgc.png]]
    set mImage_tgcLabeled [image create photo -file [file join $mImgDir tgc_labeled.png]]
    set mImage_tgcInter [image create photo -file [file join $mImgDir tgc_intersect.png]]
    set mImage_tgcSub [image create photo -file [file join $mImgDir tgc_subtract.png]]
    set mImage_tgcUnion [image create photo -file [file join $mImgDir tgc_union.png]]

    set mImage_tor [image create photo -file [file join $mImgDir tor.png]]
    set mImage_torLabeled [image create photo -file [file join $mImgDir tor_labeled.png]]
    set mImage_torInter [image create photo -file [file join $mImgDir tor_intersect.png]]
    set mImage_torSub [image create photo -file [file join $mImgDir tor_subtract.png]]
    set mImage_torUnion [image create photo -file [file join $mImgDir tor_union.png]]
}

::itcl::body ArcherCore::initGed {} {
    itk_component add ged {
	if {$mDbNoCopy || $mDbReadOnly} {
	    set _target $mTarget
	} else {
	    set _target $mTargetCopy
	}

	cadwidgets::Ged $itk_component(canvasF).mged $_target \
	    -type $mDisplayType \
	    -showhandle 0 \
	    -sashcursor sb_v_double_arrow \
	    -hsashcursor sb_h_double_arrow \
	    -showViewingParams $mShowViewingParams \
	    -centerDotEnable $mShowViewingParams \
	    -multi_pane $mMultiPane
    } {
	keep -sashwidth -sashheight -sashborderwidth
	keep -sashindent -thickness
    }
    set tmp_dbCommands [$itk_component(ged) getUserCmds]
    set mUnwrappedDbCommands {}
    foreach cmd $tmp_dbCommands {
	if {[lsearch $mArcherCoreCommands $cmd] == -1 &&
	    [lsearch $mBannedDbCommands $cmd] == -1} {
	    lappend mUnwrappedDbCommands $cmd
	}
    }

    if {!$mViewOnly} {
	$itk_component(ged) set_outputHandler "$itk_component(cmd) putstring"
    }
    $itk_component(ged) transparency_all 1
    $itk_component(ged) bounds_all "-4096 4095 -4096 4095 -4096 4095"
    $itk_component(ged) more_args_callback [::itcl::code $this handleMoreArgs]
    $itk_component(ged) history_callback [::itcl::code $this addHistory]


    # RT Control Panel
    itk_component add rtcntrl {
	RtControl $itk_interior.rtcp -mged $itk_component(ged)
    } {
	usual
    }
    $itk_component(ged) fb_active 0
    $itk_component(rtcntrl) updateControlPanel
    bind $itk_component(rtcntrl) <Visibility> "raise $itk_component(rtcntrl)"
    bind $itk_component(rtcntrl) <FocusOut> "raise $itk_component(rtcntrl)"
    wm protocol $itk_component(rtcntrl) WM_DELETE_WINDOW "$itk_component(rtcntrl) deactivate"

    # Other bindings for mged
    #bind $itk_component(ged) <Enter> {focus %W}

    if {$mViewOnly && !$mNoToolbar} {
	$itk_component(canvas_menu) menuconfigure .raytrace.rt \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rt.fivetwelve \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rt.tentwenty \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rt.window \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck.fifty \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck.hundred \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck.twofiftysix \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rtcheck.fivetwelve \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rtedge \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rtedge.fivetwelve \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rtedge.tentwenty \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.rtedge.window \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .raytrace.nirt \
	    -state normal

	$itk_component(canvas_menu) menuconfigure .view.front \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .view.rear \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .view.port \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .view.starboard \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .view.top \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .view.bottom \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .view.35,25 \
	    -state normal
	$itk_component(canvas_menu) menuconfigure .view.45,45 \
	    -state normal
    }

    bind $itk_component(canvasF) <Configure> [::itcl::code $this updateRtControl]

    set mActivePane 1
    set mActivePaneName ur

    if {$mShowViewAxes} {
	showViewAxes
    }
    if {$mShowModelAxes} {
	showModelAxes
    }
    if {$mShowGroundPlane} {
	showGroundPlane
    }
    if {$mShowPrimitiveLabels} {
	showPrimitiveLabels
    }
    if {$mShowViewingParams} {
	showViewParams
    }
    if {$mShowScale} {
	showScale
    }
    if {$mLighting} {
	doLighting
    }
    if {$mShowGrid} {
	showGrid
    }
    if {$mSnapGrid} {
	snapGrid
    }
    if {$mSnapLines} {
	snapLines
    }
    if {$mShowADC} {
	showADC
    }

    $itk_component(ged) configure -paneCallback [::itcl::code $this updateActivePane]
}

::itcl::body ArcherCore::closeMged {} {
    catch {delete object $itk_component(rtcntrl)}
    #    catch {delete object $itk_component(vac)}
    #    catch {delete object $itk_component(mac)}
    catch {delete object $itk_component(ged)}
}

::itcl::body ArcherCore::updateRtControl {} {
    ::update
    if {[info exists itk_component(rtcntrl)]} {
	$itk_component(rtcntrl) updateControlPanel
    }
}

# ------------------------------------------------------------
#                 INTERFACE OPERATIONS
# ------------------------------------------------------------
::itcl::body ArcherCore::closeDb {} {
    grid forget $itk_component(ged)
    closeMged

    grid $itk_component(canvas) -row 1 -column 0 -columnspan 3 -sticky news
    set mDbType ""

    rebuildTree
}

::itcl::body ArcherCore::newDb {} {
    set typelist {
	{"BRL-CAD Database" {".g"}}
	{"All Files" {*}}
    }

    #XXX This is not quite right, but it gets us
    #    enough of the behavior we want (for the moment).
    set target [tk_getSaveFile -parent $itk_interior \
		    -initialdir $mLastSelectedDir \
		    -title "Create a New Database" \
		    -filetypes $typelist]

    if {$target == ""} {
	return
    }

    if {[file exists $target]} {
	file delete -force $target
    }

    switch -- [file extension $target] {
	".g"   {
	    $itk_component(ged) open $target
	}
	"" {
	    set target $target.g
	    $itk_component(ged) open $target
	}
	default {
	    return
	}
    }

    Load $target
}

::itcl::body ArcherCore::openDb {} {

    package require cadwidgets::GeometryIO

    set typelist {
	{"BRL-CAD Database" {".g" ".asc"}}
	{"3dm (Rhino)" {".3dm"}}
	{"FASTGEN 4" {".bdf" ".fas" ".fg" ".fg4"}}
	{"OBJ" {".obj"}}
	{"STEP" {".stp" ".step"}}
	{"STL" {".stl"}}
	{"All Files" {*}}
    }

    set input_target [tk_getOpenFile -parent $itk_interior \
		    -initialdir $mLastSelectedDir \
		    -title "Open Database" \
		    -filetypes $typelist]

    if {$input_target == ""} {
	return
    }

    set target [cadwidgets::geom_load $input_target 1]

    ::update
    Load $target
}

::itcl::body ArcherCore::saveDb {} {
    set mNeedSave 0
    updateSaveMode

    if {$mTarget == ""} {
	set typelist {
	    {"BRL-CAD Database" {".g"}}
	    {"All Files" {*}}
	}

	set target [tk_getSaveFile -parent $itk_interior \
			-initialdir $mLastSelectedDir \
			-title "Save the New Database" \
			-filetypes $typelist]
    } else {
	set target $mTarget
    }

    # Sanity
    if {$target == "" ||
	$mTargetCopy == "" ||
	$mDbReadOnly ||
	$mDbNoCopy} {
	return
    }

    set mTarget $target
    set t [::clock seconds]
    ::file mtime $mTargetCopy $t
    ::file copy -force $mTargetCopy $mTarget
}

::itcl::body ArcherCore::exportDb {} {

    package require cadwidgets::GeometryIO

    set typelist {
	{"All Files" {*}}
	{"STL" {".stl"}}
	{"Wavefront OBJ" {".obj"}}
    }

    set target [tk_getSaveFile -parent $itk_interior \
        -initialdir $mLastSelectedDir \
        -title "Save the Database As..." \
        -filetypes $typelist]

    # Sanity
    if {$target == "" ||
	$mTargetCopy == "" ||
	$mDbNoCopy} {
	return
    }

    set mTarget $target
    cadwidgets::geom_save $mTargetCopy $mTarget $itk_component(ged)
}

::itcl::body ArcherCore::primaryToolbarAdd {type name {args ""}} {
    if {[llength $args] > 1} {
	eval $itk_component(primaryToolbar) add $type $name $args
    } else {
	eval $itk_component(primaryToolbar) add $type $name [lindex $args 0]
    }
    return [$itk_component(primaryToolbar) index $name]
}

::itcl::body ArcherCore::primaryToolbarRemove {index} {
    eval $itk_component(primaryToolbar) delete $index
}

##
# This method operates on one bot. It splits the bot if
# necessary and puts the pieces in a new group.
#
::itcl::body ArcherCore::bot_split2 {_bot} {
    set new_bots [gedCmd bot_split $_bot]

    set blist [lindex $new_bots 0]
    set bname [lindex $blist 0]
    set bots [lindex $blist 1]
    if {[llength $bots] == 0} {
	return ""
    }

    set backup "$bname.bak"
    if {[gedCmd exists $backup]} {
	gedCmd make_name -s 0
	set backup [gedCmd make_name $backup]
    }

    gedCmd mv $bname $backup
    eval gedCmd g $bname $bots
    gedCmd erase $bname

    return [list $bname $backup]
}


# ------------------------------------------------------------
#                    WINDOW COMMANDS
# ------------------------------------------------------------

::itcl::body ArcherCore::getCanvasArea {} {
    return $itk_component(canvasF)
}

::itcl::body ArcherCore::restoreCanvas {} {
    if {![info exists itk_component(ged)]} {
	return
    }

    set slave [grid slaves $itk_component(canvasF)]
    if {[llength $slave] == 1 && $slave != $itk_component(ged)} {
	grid forget $slave

	if {!$mViewOnly} {
	    grid $itk_component(ged) -row 0 -column 0 -columnspan 3 -sticky news
	} else {
	    grid $itk_component(ged) -row 1 -column 0 -sticky news
	}
    }
}


::itcl::body ArcherCore::setCanvas {_canvas} {
    if {![info exists itk_component(ged)]} {
	return
    }

    grid forget $itk_component(ged)
    if {!$mViewOnly} {
	grid $_canvas -row 0 -column 0 -columnspan 3 -sticky news
    } else {
	grid $_canvas -row 1 -column 0 -sticky news
    }
}

::itcl::body ArcherCore::dockArea {{position "south"}} {
    switch -- $position {
	"north" -
	"south" -
	"east"  -
	"west"  {return $itk_component($position)}
	default {
	    error "ArcherCore::dockArea: unrecognized area `$position'"
	}
    }
}

::itcl::body ArcherCore::primaryToolbarAddBtn {name {args ""}} {
    if [catch {primaryToolbarAdd button $name $args} err] {error $err}
    return $err
}

::itcl::body ArcherCore::primaryToolbarAddSep {name {args ""}} {
    if [catch {primaryToolbarAdd frame $name $args} err] {error $err}
    return $err
}

::itcl::body ArcherCore::primaryToolbarRemoveItem  {index} {
    if [catch {primaryToolbarRemove $index} err] {error $err}
}

::itcl::body ArcherCore::closeHierarchy {} {
    if {!$mNoTree} {
	$itk_component(vpane) hide hierarchyView
    }
}

::itcl::body ArcherCore::openHierarchy {{fraction 30}} {
    #XXX We should check to see if fraction is between
    #    0 and 100 inclusive.
    if {!$mNoTree} {
	$itk_component(vpane) show hierarchyView
	$itk_component(vpane) fraction $fraction [expr {100 - $fraction}]
    }
}

# ------------------------------------------------------------
#                     PUBLIC TREE COMMANDS
# ------------------------------------------------------------
::itcl::body ArcherCore::setViewTypeFromTreeMode {} {
    switch -- $mTreeMode \
	$TREE_MODE_TREE - \
	$TREE_MODE_COLOR_OBJECTS {
	    if {$mEnableColorListView} {
		set mEnableListView 1
	    } else {
		set mEnableListView 0
	    }
	} \
	$TREE_MODE_GHOST_OBJECTS {
	    if {$mEnableGhostListView} {
		set mEnableListView 1
	    } else {
		set mEnableListView 0
	    }
	} \
	$TREE_MODE_EDGE_OBJECTS {
	    if {$mEnableEdgeListView} {
		set mEnableListView 1
	    } else {
		set mEnableListView 0
	    }
	}
}

::itcl::body ArcherCore::rebuildTree {} {
    if {$mNoTree || $mFreezeGUI} {
	set mNeedsTreeRebuild 1
	return
    }

    foreach node [array names mNode2Text] {
	catch {$itk_component(newtree) delete $node}
    }

    $itk_component(newtree) configure -columns $mTreeAttrColumns
    set i 0
    foreach column $mTreeAttrColumns {
	$itk_component(newtree) heading $i -text $column
	incr i
    }

    # clobber the associative arrays
    unset mNode2Text
    unset mText2Node
    unset mCNode2PList
    unset mPNode2CList
    set mNode2Text() ""
    set mText2Node() ""
    set mCNode2PList() ""
    set mPNode2CList() ""
    set mNodePDrawList ""
    set mNodeDrawList ""
    set mAffectedNodeList ""

    setViewTypeFromTreeMode

    if {$mEnableListView} {
	set items [lsort -dictionary [$itk_component(ged) ls]]
    } else {
	set items [lsort -dictionary [$itk_component(ged) tops]]
    }

    foreach item $items {
	set item [regsub {/.*} $item {}]
	if {$mEnableListView} {
	    fillTree {} $item 1
	} else {
	    fillTree {} $item 0
	}
    }

    updateTreeDrawLists
}

##
# This routine expects mEnableListView to be 0.
#
::itcl::body ArcherCore::rsyncTree {_pnode} {
    if {$mNoTree} {
	return
    }

    set ptext $mNode2Text($_pnode)

    # Is _pnode currently set up for children?
    if {![catch {set clists $mPNode2CList($_pnode)}]} {

	set ptype [$itk_component(ged) get_type $ptext]

	if {$ptype == "dsp" ||
	    $ptype == "ebm" ||
	    $ptype == "extrude" ||
	    $ptype == "revolve" ||
	    $ptype == "vol"} {

	    set clist [lindex $clists 0]
	    set old_ctext [lindex $clist 0]
	    set cnode [lindex $clist 1]

	    if {$old_ctext == $TREE_PLACEHOLDER_TAG} {
		return
	    }

	    switch -- $ptype {
		"dsp" -
		"ebm" -
		"vol" {
		    set ctext [$itk_component(ged) get $ptext file]
		}
		"extrude" -
		"revolve" {
		    set ctext [$itk_component(ged) get $ptext sk_name]
		}
	    }

	    if {$old_ctext != $ctext} {
		set clist [list $ctext $cnode]
		set clists [list $clist]
		set mPNode2CList($_pnode) $clists
		set mNode2Text($cnode) $ctext
		$itk_component(newtree) item $cnode -text $ctext

		set nlist [list $cnode $_pnode]
		lappend mText2Node($ctext) $nlist

		set i [lsearch -index 0 $mText2Node($old_ctext) $cnode]
		if {$i == -1} {
		    return
		}

		set mText2Node($old_ctext) [lreplace $mText2Node($old_ctext) $i $i]
	    }

	    return
	}

	set mlist [getTreeMembers $ptext]

	# Reconcile clists (i.e. the tree's view)
	# with mlist (i.e. the database's view).

	set clen [llength $clists]
	switch -- $clen {
	    0 {
		# This shouldn't happen.
		puts "ArcherCore::rsyncTree - $ptext has empty child list"
	    }
	    default {
		foreach clist $clists {
		    set ctext [lindex $clist 0]
		    if {$ctext == $TREE_PLACEHOLDER_TAG} {
			if {$mlist == {}} {
			    # Since there are NO children, remove the placeholder
			    $itk_component(newtree) delete [lindex $clist 1]
			    unset mPNode2CList($_pnode)

			} else {
			    # There are children so keep the placeholder since
			    # the parent node has not been opened.

			    set mlist {}
			}

			continue
		    }

		    set cnode [lindex $clist 1]

		    set i [lsearch $mlist $ctext]
		    if {$i == -1} {
			purgeNodeData $cnode
			$itk_component(newtree) delete $cnode
			continue
		    }

		    set mlist [lreplace $mlist $i $i]

		    if {[catch {$itk_component(ged) get_type $ctext} cgdata]} {
			# In here, the child node refers to non-existent geometry
			# so update the image and remove any grandchildren etc.

			set op [getTreeOp $ptext $ctext]
			set img [getTreeImage $ctext "invalid" $op]
			$itk_component(newtree) item $cnode -image $img

			# Remove all grandchildren
			if {![catch {set gclists $mPNode2CList($cnode)}]} {
			    foreach gclist $gclists {
				set gctext [lindex $gclist 0]
				set gcnode [lindex $gclist 1]

				if {$gctext == $TREE_PLACEHOLDER_TAG} {
				    unset mPNode2CList($cnode)
				} else {
				    purgeNodeData $gcnode
				}

				$itk_component(newtree) delete $gcnode
			    }
			}
		    } else {
			# The child node refers to geometry that exists. The image
			# needs to be updated in case we're going from non-existent
			# to existent geometry.

			set ctype [lindex $cgdata 0]
			set isregion [isRegion $cgdata]
			set op [getTreeOp $ptext $ctext]
			set img [getTreeImage $ctext $ctype $op $isregion]

			# Also, for combinations the placeholders and
			# TREE_OPENED_TAGs might need updating.
			if {$ctype == "comb"} {
			    # Possibly add a place holder
			    if {![catch {set gclists $mPNode2CList($cnode)}]} {
				set gclen [llength $gclists]

				if {$gclen != 0} {
				    rsyncTree [lindex $clist 1]
				} else {
				    # This shouldn't happen.
				    puts "ArcherCore::rsyncTree - $ctext has empty child list"
				}

			    } else {
				set cmlist [getTreeMembers $ctext]
				if {$cmlist != ""} {
				    removeTreeNodeTag $cnode $TREE_OPENED_TAG
				    $itk_component(newtree) item $cnode -open false
				    addTreePlaceholder $cnode
				}
			    }
			}

			$itk_component(newtree) item $cnode -image $img
		    }
		}
	    }
	}

	# Anything leftover in mlist needs to be added
	if {$mEnableListView} {
	    foreach member $mlist {
		fillTree $_pnode $member 1 1
	    }
	} else {
	    foreach member $mlist {
		fillTree $_pnode $member 0 1
	    }
	}
    } else {
	set ptype [$itk_component(ged) get_type $ptext]

	if {$ptype == "comb"} {
	    set mlist [getTreeMembers $ptext]
	    if {$mlist != ""} {
		removeTreeNodeTag $_pnode $TREE_OPENED_TAG
		$itk_component(newtree) item $_pnode -open false
		addTreePlaceholder $_pnode
	    }
	} elseif {$ptype == "dsp" ||
		  $ptype == "ebm" ||
		  $ptype == "extrude" ||
		  $ptype == "revolve" ||
		  $ptype == "vol"} {
	    removeTreeNodeTag $_pnode $TREE_OPENED_TAG
	    $itk_component(newtree) item $_pnode -open false
	    addTreePlaceholder $_pnode
	}
    }
}

##
# Synchronize the tree view with the database.
#
::itcl::body ArcherCore::syncTree {} {
    if {$mNoTree || $mFreezeGUI} {
	set mNeedsTreeSync 1
	return
    }

    # Get list of toplevel tree items
    if {$mEnableListView} {
	set items [lsort -dictionary [$itk_component(ged) ls]]
    } else {
	set items [lsort -dictionary [$itk_component(ged) tops]]
    }

    set scrubbed_items {}
    foreach item $items {
	set item [regsub {/.*} $item {}]
	lappend scrubbed_items  $item
    }

    # Get rid of toplevel tree nodes that are no
    # longer valid (i.e. either they don't exist or they
    # belong to at least one combination).
    if {![catch {set clists $mPNode2CList()}]} {
	foreach clist $clists {
	    set ctext [lindex $clist 0]

	    # Checking for the existence of ctext
	    if {![$itk_component(ged) exists $ctext]} {
		# ctext doesn't exist
		set cnode [lindex $clist 1]
		purgeNodeData $cnode
		$itk_component(newtree) delete $cnode

	    } elseif {!$mEnableListView} {
		# Make sure ctext is a valid toplevel
		set i [lsearch $scrubbed_items $ctext]
		if {$i == -1} {
		    # ctext does exist, but is not a toplevel tree node
		    set cnode [lindex $clist 1]
		    purgeNodeData $cnode
		    $itk_component(newtree) delete $cnode
		}
	    }
	}
    }

    # Make sure each item has a tree node
    foreach item $scrubbed_items {
	set cnodes [getCNodesFromCText {} $item]

	if {$cnodes == {}} {
	    if {$mEnableListView} {
		fillTree {} $item 1
	    } else {
		fillTree {} $item 0
	    }
	} elseif {!$mEnableListView} {
	    foreach item $cnodes {
		rsyncTree $item
	    }
	}
    }

    updateTreeDrawLists
}

::itcl::body ArcherCore::updateTreeDrawLists {{_cflag 0}} {
    if {$mNoTree} {
	return
    }

    foreach node $mNodePDrawList {
	removeTreeNodeTag $node $TREE_PARTIALLY_DISPLAYED_TAG
    }
    foreach node $mNodeDrawList {
	removeTreeNodeTag $node $TREE_FULLY_DISPLAYED_TAG
    }

    set mNodePDrawList ""
    set mNodeDrawList ""

    set whoList [gedCmd who]

    set who [lindex $whoList 0]
    if {$who != ""} {
	set how [gedCmd how $who]
    } else {
	set how 0
    }

    switch -- $mTreeMode \
	$TREE_MODE_TREE - \
	$TREE_MODE_COLOR_OBJECTS {
	    set mColorObjects $whoList
	    set mColorObjectsHow $how
	} \
	$TREE_MODE_GHOST_OBJECTS {
	    set mGhostObjects $whoList
	    set mGhostObjectsHow $how
	} \
	$TREE_MODE_EDGE_OBJECTS {
	    set mEdgeObjects $whoList
	    set mEdgeObjectsHow $how
	}

    foreach ditem $whoList {
	if {$mEnableListView} {
	    set ditem [regsub {^/} $ditem {}]
	    set dlist [split $ditem /]
	    set dlen [llength $dlist]
	    if {$dlen == 1} {
		eval lappend mNodeDrawList [lindex [lindex $mText2Node($ditem) 0] 0]
	    } else {
		eval lappend mNodePDrawList [lindex [lindex $mText2Node([lindex $dlist 0]) 0] 0]
	    }
	} else {
	    set nodesList [getTreeNodes $ditem $_cflag]
	    eval lappend mNodePDrawList [lindex $nodesList 0]
	    eval lappend mNodeDrawList [lindex $nodesList 1]
	}
    }

    set mNodePDrawList [lsort -unique $mNodePDrawList]
    set mNodeDrawList [lsort -unique $mNodeDrawList]

    foreach node $mNodePDrawList {
	addTreeNodeTag $node $TREE_PARTIALLY_DISPLAYED_TAG
    }
    foreach node $mNodeDrawList {
	addTreeNodeTag $node $TREE_FULLY_DISPLAYED_TAG
    }
}

::itcl::body ArcherCore::shootRay {_start _op _target _prep _no_bool _onehit _bot_dflag} {
    set objects [gedCmd who]
    shootRay_doit $_start $_op $_target $_prep $_no_bool $_onehit $_bot_dflag $objects
}


::itcl::body ArcherCore::addMouseRayCallback {_callback} {
    lappend mMouseRayCallbacks $_callback
}

::itcl::body ArcherCore::deleteMouseRayCallback {_callback} {
    set i [lsearch $mMouseRayCallbacks $_callback]
    if {$i != -1} {
	set mMouseRayCallbacks [lreplace $mMouseRayCallbacks $i $i]
    }
}

::itcl::body ArcherCore::setDefaultBindingMode {_mode} {
    set mDefaultBindingMode $_mode

    set ret 1
    switch -- $mDefaultBindingMode \
	$VIEW_ROTATE_MODE {
	    $itk_component(primaryToolbar) component rotate invoke
	} \
	$VIEW_TRANSLATE_MODE {
	    $itk_component(primaryToolbar) component translate invoke
	} \
	$VIEW_SCALE_MODE {
	    $itk_component(primaryToolbar) component scale invoke
	} \
	$VIEW_CENTER_MODE {
	    $itk_component(primaryToolbar) component center invoke
	} \
	$COMP_PICK_MODE {
	    $itk_component(primaryToolbar) component cpick invoke
	} \
	$COMP_SELECT_MODE {
	    $itk_component(primaryToolbar) component cselect invoke
	} \
	$MEASURE_MODE {
	    $itk_component(primaryToolbar) component measure invoke
	} \
	default {
	    set ret 0
	}

    return $ret
}

# ------------------------------------------------------------
#                     MGED COMMANDS
# ------------------------------------------------------------

::itcl::body ArcherCore::deleteObj {comp} {
    if {[do_question "Are you sure you wish to delete `$comp'."] == "no"} {
	return
    }

    set mNeedSave 1
    updateSaveMode
    SetWaitCursor $this
    gedCmd kill $comp

#    set select [$itk_component(tree) selection get]
    #set element [lindex [split $select ":"] 1]
    set element [split $select ":"]
    if {[llength $element] > 1} {
	set element [lindex $element 1]
    }

#    set node [$itk_component(tree) query -path $element]

    set node ""
    foreach t $tags {
	if {[string compare [string trim $t] "leaf"] != 0 &&
	    [string compare [string trim $t] "branch"] != 0} {
	    set node $t
	}
    }
    set flist [file split $node]
    if {[llength $flist] > 1} {
	set grp [lindex $flist [expr [llength $flist] -2]]
	gedCmd rm $grp $comp
    }

    # remove from tree
#    set parent [$itk_component(tree) query -parent $element]
#    $itk_component(tree) remove $element $parent
#    rebuildTree
    SetNormalCursor $this
}


::itcl::body ArcherCore::doCopy {_obj} {
    set mCopyObj $_obj
}


::itcl::body ArcherCore::doPaste {_pobj _obj} {
    if {$_pobj == ""} {
	doTopPaste $_obj
    } else {
	if {[$itk_component(ged) get_type $_pobj] != "comb"} {
	    doTopPaste $_obj
	    return
	}

	set isregion [$itk_component(ged) get $_pobj region]

	set plist [$itk_component(ged) dbfind $_obj]
	if {[lsearch $plist $_pobj] != -1} {
	    set newobj [doTopPaste $_obj]

	    if {$isregion} {
		r $_pobj u $newobj
	    } else {
		g $_pobj $newobj
	    }
	} else {
	    if {$isregion} {
		r $_pobj u $_obj
	    } else {
		g $_pobj $_obj
	    }
	}
    }
}


::itcl::body ArcherCore::doRename {_top _obj} {
    set newobj [string trim [$_top.entry get]]
    wm withdraw $_top
    if {[catch {gedCmd mvall $_obj $newobj} msg]} {
	putString $msg
	destroy $_top
	return
    }

    SetWaitCursor $this

    set mNeedSave 1
    updateSaveMode
    rebuildTree

    if {$mSelectedObj == $_obj} {
	set obj $newobj
	set dir [file dirname $mSelectedObjPath]
	set path "$dir/$newobj"
    } else {
	set obj $mSelectedObj
	set path $mSelectedObjPath
    }

    if {$mEnableListView} {
	selectTreePath $obj
    } else {
	selectTreePath $path
    }

    destroy $_top
    SetNormalCursor $this
}


::itcl::body ArcherCore::doTopPaste {_obj} {
    set i 1
    set newobj "$_obj\.$i"
    while {[$itk_component(ged) exists $newobj]} {
	incr i
	set newobj "$_obj\.$i"
    }

    cp $_obj $newobj
    return $newobj
}


::itcl::body ArcherCore::renameObj {_obj} {
    if {[winfo exists .alter]} {
	destroy .alter
    }

    if {$_obj == $mCopyObj} {
	set mCopyObj ""
    }

    set top [::toplevel .alter]
    wm withdraw $top
    wm transient $top $itk_interior
    set x [winfo pointerx $itk_interior]
    set y [winfo pointery $itk_interior]
    wm geometry $top +$x+$y

    set entry [::iwidgets::entryfield $top.entry -textbackground $SystemWindow -width 20]
    $entry insert 0 $_obj
    pack $entry -fill x -padx 3 -pady 2

    wm title $top "Rename $_obj"
    $entry configure -labeltext "New Name:"

    set oframe [::frame $top.oframe -bg black]
    set ok [::button $oframe.ok -text "OK" -width 7 -command [::itcl::code $this doRename $top $_obj]]
    pack $ok -padx 1 -pady 1

    set cancel [::button $top.cancel -text "Cancel" -width 7 -command "destroy $top"]
    pack $cancel -side right -anchor e -padx 3 -pady 2
    pack $oframe -side right -anchor e -padx 3 -pady 2

    set entryc [$entry component entry]
    $entryc selection range 0 end
    focus $entryc
    bind $entryc <Return> "$ok invoke"

    wm deiconify $top
    tkwait window $top
}


::itcl::body ArcherCore::buildPrimaryToolbar {} {
    # tool bar
    itk_component add primaryToolbar {
	::iwidgets::toolbar $itk_interior.primarytoolbar \
	    -helpvariable [::itcl::scope mStatusStr] \
	    -balloonfont "{CG Times} 8" \
	    -balloonbackground \#ffffdd \
	    -borderwidth 1 \
	    -orient horizontal \
	    -background $LABEL_BACKGROUND_COLOR
    } {}

    $itk_component(primaryToolbar) add button open \
	-balloonstr "Open an existing geometry file" \
	-helpstr "Open an existing geometry file" \
	-relief flat \
	-overrelief raised \
	-command [::itcl::code $this openDb]

    if {!$mViewOnly} {
	$itk_component(primaryToolbar) add button save \
	    -balloonstr "Save the current geometry file" \
	    -helpstr "Save the current geometry file" \
	    -relief flat \
	    -overrelief raised \
	    -command [::itcl::code $this askToSave]
    }

    $itk_component(primaryToolbar) add radiobutton rotate \
	-balloonstr "Rotate view" \
	-helpstr "Rotate view" \
	-variable [::itcl::scope mDefaultBindingMode] \
	-value $VIEW_ROTATE_MODE \
	-command [::itcl::code $this beginViewRotate]
    $itk_component(primaryToolbar) add radiobutton translate \
	-balloonstr "Translate view" \
	-helpstr "Translate view" \
	-variable [::itcl::scope mDefaultBindingMode] \
	-value $VIEW_TRANSLATE_MODE \
	-command [::itcl::code $this beginViewTranslate] \
	-state disabled
    $itk_component(primaryToolbar) add radiobutton scale \
	-balloonstr "Scale view" \
	-helpstr "Scale view" \
	-variable [::itcl::scope mDefaultBindingMode] \
	-value $VIEW_SCALE_MODE \
	-command [::itcl::code $this beginViewScale] \
	-state disabled
    $itk_component(primaryToolbar) add radiobutton center \
	-balloonstr "Center view" \
	-helpstr "Center view" \
	-variable [::itcl::scope mDefaultBindingMode] \
	-value $VIEW_CENTER_MODE \
	-command [::itcl::code $this initViewCenterMode] \
	-state disabled
    $itk_component(primaryToolbar) add radiobutton cpick \
	-balloonstr "Component Pick" \
	-helpstr "Component Pick" \
	-variable [::itcl::scope mDefaultBindingMode] \
	-value $COMP_PICK_MODE \
	-command [::itcl::code $this initCompPick] \
	-state disabled
    $itk_component(primaryToolbar) add radiobutton cselect \
	-balloonstr "Component Select Mode" \
	-helpstr "Component Select Mode" \
	-variable [::itcl::scope mDefaultBindingMode] \
	-value $COMP_SELECT_MODE \
	-command [::itcl::code $this initCompSelect] \
	-state disabled
    $itk_component(primaryToolbar) add radiobutton measure \
	-balloonstr "Measuring Tool" \
	-helpstr "Measuring Tool" \
	-variable [::itcl::scope mDefaultBindingMode] \
	-value $MEASURE_MODE \
	-command [::itcl::code $this initViewMeasure] \
	-state disabled

    $itk_component(primaryToolbar) itemconfigure rotate -state disabled
    $itk_component(primaryToolbar) itemconfigure translate -state disabled
    $itk_component(primaryToolbar) itemconfigure scale -state disabled
    $itk_component(primaryToolbar) itemconfigure center -state disabled
    $itk_component(primaryToolbar) itemconfigure cpick -state disabled
    $itk_component(primaryToolbar) itemconfigure cselect -state disabled
    $itk_component(primaryToolbar) itemconfigure measure -state disabled

    eval pack configure [pack slaves $itk_component(primaryToolbar)] -padx 2

    if {$mViewOnly} {
	grid $itk_component(primaryToolbar) \
	    -row 0 \
	    -column 0 \
	    -in $itk_component(canvasF) \
	    -sticky e
    } else {
	pack $itk_component(primaryToolbar) \
	    -before $itk_component(north) \
	    -side top \
	    -fill x \
	    -pady 2
    }
}

::itcl::body ArcherCore::beginViewRotate {} {
    $itk_component(ged) init_view_rotate 1
    $itk_component(ged) init_button_no_op 2

    $itk_component(ged) rect lwidth 0
}

::itcl::body ArcherCore::endViewRotate {_pane} {
    $itk_component(ged) end_view_rotate $_pane

    set ae [$itk_component(ged) pane_aet $_pane]
    addHistory "ae $ae"
}

::itcl::body ArcherCore::beginViewScale {} {
    $itk_component(ged) init_view_scale 1
    $itk_component(ged) init_button_no_op 2

    $itk_component(ged) rect lwidth 0
}

::itcl::body ArcherCore::endViewScale {_pane} {
    $itk_component(ged) end_view_scale $_pane

    set size [$itk_component(ged) pane_size $_pane]
    addHistory "size $size"
}

::itcl::body ArcherCore::beginViewTranslate {} {
    $itk_component(ged) init_view_translate 1
    $itk_component(ged) init_button_no_op 2

    $itk_component(ged) rect lwidth 0
}

::itcl::body ArcherCore::endViewTranslate {_pane} {
    $itk_component(ged) end_view_translate $_pane

    set center [$itk_component(ged) pane_center $_pane]
    addHistory "center $center"
}

::itcl::body ArcherCore::initViewCenterMode {} {
    $itk_component(ged) init_view_center 1
    $itk_component(ged) init_button_no_op 2

    $itk_component(ged) clear_mouse_ray_callback_list
    $itk_component(ged) add_mouse_ray_callback [::itcl::code $this mrayCallback_cvo]
    $itk_component(ged) init_comp_pick 2

    $itk_component(ged) rect lwidth 0
}

::itcl::body ArcherCore::initCompPick {} {
    set mDefaultBindingMode $COMP_PICK_MODE

    $itk_component(ged) clear_mouse_ray_callback_list
    $itk_component(ged) add_mouse_ray_callback [::itcl::code $this mrayCallback_pick]
    $itk_component(ged) init_comp_pick 1
    $itk_component(ged) init_button_no_op 2

    $itk_component(ged) rect lwidth 0
}

::itcl::body ArcherCore::initCompSelect {} {
    if {$mCompSelectMode != $COMP_SELECT_LIST_MODE &&
	$mCompSelectMode != $COMP_SELECT_LIST_PARTIAL_MODE} {
	doSelectGroup
    }

    $itk_component(ged) clear_view_rect_callback_list
    $itk_component(ged) add_view_rect_callback [::itcl::code $this compSelectCallback]
    if {$mCompSelectMode == $COMP_SELECT_LIST_PARTIAL_MODE ||
	$mCompSelectMode == $COMP_SELECT_GROUP_ADD_PARTIAL_MODE ||
	$mCompSelectMode == $COMP_SELECT_GROUP_REMOVE_PARTIAL_MODE} {
	$itk_component(ged) init_view_rect 1 1
    } else {
	$itk_component(ged) init_view_rect 1 0
    }
    $itk_component(ged) init_button_no_op 2

    # The rect lwidth should be a preference
    $itk_component(ged) rect lwidth 1

    # Update the toolbar buttons
    set mDefaultBindingMode $COMP_SELECT_MODE
}

::itcl::body ArcherCore::compSelectCallback {_mstring} {
    switch -- $mCompSelectMode \
	$COMP_SELECT_LIST_MODE - \
	$COMP_SELECT_LIST_PARTIAL_MODE {
	    putString $_mstring
	} \
	$COMP_SELECT_GROUP_ADD_MODE - \
	$COMP_SELECT_GROUP_ADD_PARTIAL_MODE {
	    compSelectGroupAdd $_mstring
	} \
	$COMP_SELECT_GROUP_REMOVE_MODE - \
	$COMP_SELECT_GROUP_REMOVE_PARTIAL_MODE {
	    compSelectGroupRemove $_mstring
	}
}

::itcl::body ArcherCore::compSelectGroupAdd {_plist} {
    set new_plist [compSelectGroupCommon $_plist]
    if {$new_plist == ""} {
	# Nothing to do
	return
    }

    set add_list {}
    foreach item $new_plist {
	set i [lsearch $mCompSelectGroupList $item]
	if {$i == -1} {
	    lappend add_list $item
	}
    }

    if {[llength $add_list] > 0} {
	eval group $mCompSelectGroup $add_list

	set tlist [getTreeMembers $mCompSelectGroup]
	if {[llength $tlist] > 0} {
	    putString "$mCompSelectGroup now contains:"
	    putString "\t$tlist"
	}
    }
}

##
# Returns empty string if mCompSelectGroup exists and is not a group (i.e. it's a region).
# Also sets mCompSelectGroupList to the list of components currently in mCompSelectGroup.
#
::itcl::body ArcherCore::compSelectGroupCommon {_plist} {
    set mCompSelectGroupList ""

    if {[$itk_component(ged) exists $mCompSelectGroup]} {
	if {([$itk_component(ged) get_type $mCompSelectGroup] != "comb" ||
	     [$itk_component(ged) get $mCompSelectGroup] == "yes")} {
	    putString "$mCompSelectGroup is not a group"
	    return ""
	}

	#set tree [$itk_component(ged) get $mCompSelectGroup tree]
	set tlist [getTreeMembers $mCompSelectGroup]
	if {[llength $tlist] > 0} {
	    set mCompSelectGroupList $tlist
	}
    }

    set new_plist {}
    foreach item $_plist {
	lappend new_plist [file tail $item]
    }

    return [lsort -unique -dictionary $new_plist]
}

::itcl::body ArcherCore::compSelectGroupRemove {_plist} {
    set new_plist [compSelectGroupCommon $_plist]
    if {$new_plist == "" || $mCompSelectGroupList == ""} {
	# Nothing to do
	return
    }

    set rem_list {}
    foreach item $new_plist {
	set i [lsearch $mCompSelectGroupList $item]
	if {$i != -1} {
	    lappend rem_list $item
	}
    }

    if {[llength $rem_list] > 0} {
	eval rm $mCompSelectGroup $rem_list

	set tlist [getTreeMembers $mCompSelectGroup]
	if {[llength $tlist] > 0} {
	    putString "$mCompSelectGroup now contains:"
	    putString "\t$tlist"
	} else {
	    putString "$mCompSelectGroup is empty"
	}
    }
}

::itcl::body ArcherCore::mrayCallback_cvo {_pane _start _target _partitions} {
    if {$_partitions == ""} {
	set rpos [$itk_component(ged) lastMouseRayPos]
	eval $itk_component(ged) vslew $rpos
	return
    }

    set partition [lindex $_partitions 0]

    if {[catch {bu_get_value_by_keyword in $partition} in]} {
	putString "Partition does not contain an \"in\""
	putString "$in"
	return
    }

    if {[catch {bu_get_value_by_keyword point $in} point]} {
	putString "Partition does not contain an \"in\" point"
	putString "$point"
	return
    }

    set point [vscale $point [$itk_component(ged) base2local]]
    $itk_component(ged) pane_center $_pane $point
}


::itcl::body ArcherCore::mrayCallback_nirt {_pane _start _target _partitions} {
    #set size [$itk_component(ged) size]
    #set cdim [$itk_component(ged) pane_rect $_pane cdim]
    #set width [lindex $cdim 0]
    #set height [lindex $cdim 1]

    set b2l [$itk_component(ged) base2local]
    set rad2deg [expr {180.0 / acos(-1.0)}]
    set raydir [vunitize [vsub2 $_target $_start]]
    set scaled_start [vscale $_start $b2l]

    set rds "([format {%.4f %.4f %.4f} [lindex $raydir 0] [lindex $raydir 1] [lindex $raydir 2]])"
    set ae [eval $itk_component(ged) dir2ae $raydir]
    set aes "([format {%.2f %.2f} [lindex $ae 0] [lindex $ae 1]])"
    set ors "([format {%.3f %.3f %.3f} [lindex $scaled_start 0] [lindex $scaled_start 1] [lindex $scaled_start 2]])"

    putString "\nOrigin (x y z) = $ors"
    putString "Direction (x y z) = $rds\t(az el) - $aes"
    putString "Region Name\t\t\tEntry (x y z)\t\t\t\tLOS\tObliq_in"

    # use the reverse ray direction for the cos calculation below
    set raydir [vunitize [vsub2 $_start $_target]]

    foreach partition $_partitions {
	if {[catch {bu_get_value_by_keyword "region" $partition} region] ||
	    [catch {bu_get_value_by_keyword "in" $partition} in] ||
	    [catch {bu_get_value_by_keyword "normal" $in} hit_normal] ||
	    [catch {bu_get_value_by_keyword "point" $in} i_pt] ||
	    [catch {bu_get_value_by_keyword "out" $partition} out] ||
	    [catch {bu_get_value_by_keyword "point" $out} o_pt]} {
	    return ""
	}

	set hit_normal [vunitize $hit_normal]
	set cosa [vdot $raydir $hit_normal]

	set angle [format "%.3f" [expr {acos($cosa) * $rad2deg}]]
	set los [format "%.2f" [expr {[vmagnitude [vsub2 $o_pt $i_pt]] * $b2l}]]
	set i_pt [vscale $i_pt $b2l]
	set i_pt [format "(%.3f %.3f %.3f)" [lindex $i_pt 0] [lindex $i_pt 1] [lindex $i_pt 2]]

	putString "$region\t\t\t$i_pt\t\t\t\t$los\t$angle"
    }

    $itk_component(ged) draw_ray $_start $_partitions
}


::itcl::body ArcherCore::mrayCallback_pick {_pane _start _target _partitions} {
    set partition [lindex $_partitions 0]
    if {$partition == {}} {
	putString "Missed!"
	set mStatusStr "Missed!"
    } else {
	set in [bu_get_value_by_keyword "in" $partition]
	set path [bu_get_value_by_keyword "path" $in]
	set path [regsub {^/} $path {}]
	set pathlist [split $path /]
	set last [lindex $pathlist end]
	switch -- $mCompPickMode \
	    $COMP_PICK_TREE_SELECT_MODE { \
		selectTreePath $path
	    } \
	    $COMP_PICK_NAME_MODE { \
		putString "Hit $path, last - $last"
	    } \
	    $COMP_PICK_ERASE_MODE { \
		gedCmd erase $path
		updateTreeDrawLists
		putString "erase $path"
		set mStatusStr "erase $path"
	    } \
	    $COMP_PICK_BOT_FLIP_MODE { \
		catch {bot_flip $path}
		redrawObj $path
	    } \
	    $COMP_PICK_BOT_SPLIT_MODE { \
		SetWaitCursor $this
		set how [gedCmd how $path]
		if {![catch {bot_split2 $last} bnames] && $bnames != ""} {
		    set dirname [file dirname $path]
		    if {$dirname != "."} {
			set drawitem $dirname
		    } else {
			set drawitem [lindex $bnames 0]
		    }

		    $itk_component(ged) refresh_off
		    gedCmd draw -m$how $drawitem
		    gedCmd erase [lindex $bnames 1]
		    $itk_component(ged) refresh_on
		    $itk_component(ged) refresh_all

		    syncTree
		    setSave
		}
		SetNormalCursor $this
	    } \
	    $COMP_PICK_BOT_SYNC_MODE { \
		catch {bot_sync $path}
		redrawObj $path
	    }
    }
}

::itcl::body ArcherCore::initViewMeasure {} {
    $itk_component(ged) clear_view_measure_callback_list
    $itk_component(ged) clear_mouse_ray_callback_list
    $itk_component(ged) add_view_measure_callback [::itcl::code $this endViewMeasure]
    $itk_component(ged) add_mouse_ray_callback [::itcl::code $this mrayCallback_nirt]
    $itk_component(ged) init_view_measure
    $itk_component(ged) init_button_no_op 2

    $itk_component(ged) rect lwidth 0
}

::itcl::body ArcherCore::endViewMeasure {_mstring} {
    putString $_mstring
    set mStatusStr $_mstring
}

::itcl::body ArcherCore::initDefaultBindings {{_comp ""}} {
    if {!$mNoToolbar} {
	$itk_component(primaryToolbar) itemconfigure rotate -state normal
	$itk_component(primaryToolbar) itemconfigure translate -state normal
	$itk_component(primaryToolbar) itemconfigure scale -state normal
	$itk_component(primaryToolbar) itemconfigure center -state normal
	$itk_component(primaryToolbar) itemconfigure cpick -state normal
	$itk_component(primaryToolbar) itemconfigure cselect -state normal
	$itk_component(primaryToolbar) itemconfigure measure -state normal
    }

    $itk_component(ged) init_view_bindings

    # Initialize rotate mode
    set mDefaultBindingMode $VIEW_ROTATE_MODE
    beginViewRotate
}

::itcl::body ArcherCore::initBrlcadBindings {} {
    if {!$mNoToolbar} {
	$itk_component(primaryToolbar) itemconfigure rotate -state disabled
	$itk_component(primaryToolbar) itemconfigure translate -state disabled
	$itk_component(primaryToolbar) itemconfigure scale -state disabled
	$itk_component(primaryToolbar) itemconfigure center -state disabled
	$itk_component(primaryToolbar) itemconfigure cpick -state disabled
	$itk_component(primaryToolbar) itemconfigure cselect -state disabled
	$itk_component(primaryToolbar) itemconfigure measure -state disabled
    }

    $itk_component(ged) init_view_bindings brlcad
}


::itcl::body ArcherCore::validateDigit {d} {
    ::cadwidgets::Ged::validateDigit $d
}

::itcl::body ArcherCore::validateDouble {d} {
    ::cadwidgets::Ged::validateDouble $d
}

::itcl::body ArcherCore::validateTickInterval {ti} {
    if {$ti == ""} {
	return 1
    }

    if {[::cadwidgets::Ged::validateDouble $ti]} {
	if {$ti == "." || 0 <= $ti} {
	    return 1
	}

	return 0
    } else {
	return 0
    }
}

::itcl::body ArcherCore::validateColorComp {c} {
    if {$c == ""} {
	return 1
    }

    if {[string is digit $c]} {
	if {$c <= 255} {
	    return 1
	}

	return 0
    } else {
	return 0
    }
}


::itcl::body ArcherCore::backgroundColor {_color} {
    set mCurrentPaneName ""
    set mBackgroundColor $_color
    set mBackground [::cadwidgets::Ged::get_rgb_color $mBackgroundColor]

    if {[info exists itk_component(ged)]} {
	eval $itk_component(ged) bg_all $mBackground
    }
}


::itcl::body ArcherCore::updateHPaneFractions {} {
    if {$mViewOnly} {
	return
    }

    if {[catch {$itk_component(hpane) fraction} fractions]} {
	return
    }

    if {[llength $fractions] == 2} {
	set mHPaneFraction1 [lindex $fractions 0]
	set mHPaneFraction2 [lindex $fractions 1]
    }
}

::itcl::body ArcherCore::updateVPaneFractions {} {
    if {$mViewOnly} {
	return
    }

    if {[catch {$itk_component(vpane) fraction} fractions]} {
	return
    }

    switch -- [llength $fractions] {
	2 {
	    set mVPaneFraction1 [lindex $fractions 0]
	    set mVPaneFraction2 [lindex $fractions 1]
	}
	3 {
	    set mVPaneFraction3 [lindex $fractions 0]
	    set mVPaneFraction4 [lindex $fractions 1]
	    set mVPaneFraction5 [lindex $fractions 2]
	}
    }
}

::itcl::body ArcherCore::setColorOption {cmd colorOption color {tripleColorOption ""}} {
    if {$tripleColorOption != ""} {
	$cmd configure $tripleColorOption 0
    }

    switch -- $color {
	"Grey" {
	    $cmd configure $colorOption {100 100 100}
	}
	"Black" {
	    $cmd configure $colorOption {0 0 0}
	}
	"Navy" {
	    $cmd configure $colorOption {0 0 50}
	}
	"Blue" {
	    $cmd configure $colorOption {100 100 255}
	}
	"Cyan" {
	    $cmd configure $colorOption {0 255 255}
	}
	"Green" {
	    $cmd configure $colorOption {100 255 100}
	}
	"Magenta" {
	    $cmd configure $colorOption {255 0 255}
	}
	"Red" {
	    $cmd configure $colorOption {255 100 100}
	}
	default -
	"White" {
	    $cmd configure $colorOption {255 255 255}
	}
	"Yellow" {
	    $cmd configure $colorOption {255 255 0}
	}
	"Triple" {
	    $cmd configure $tripleColorOption 1
	}
    }
}

::itcl::body ArcherCore::addHistory {cmd} {
    if {$mViewOnly} {
	return
    }

    set cmd [string trim $cmd]

    set maxlines 1000
    set tw [$itk_component(history) component text]

    # construct line
    set str "> "
    append str $cmd "\n"

    # insert line
    $tw configure -state normal
    $itk_component(history) insert end $str

    # check to see it does not exceed maxline count
    set nlines [expr int([$tw index end])]
    if {$nlines > $maxlines} {
	$tw delete 1.0 [expr $nlines - $maxlines].end
    }

    # disable text widget
    $tw configure -state disabled
    $itk_component(history) see end

    update idletasks
}

::itcl::body ArcherCore::cmd {args} {
    set cmd [lindex $args 0]
    if {$cmd == ""} {
	return
    }

    if {$cmd == "info"} {
	set arg1 [lindex $args 1]
	switch $arg1 {
	    function {
		if {[llength $args] == 3} {
		    set subcmd [lindex $args 2]
		    if {[lsearch $mArcherCoreCommands $subcmd] == -1 &&
			[lsearch $mUnwrappedDbCommands $subcmd] == -1} {
			error "ArcherCore::cmd: unrecognized command - $subcmd"
		    } else {
			return $subcmd
		    }
		} else {
		    return [eval list $mArcherCoreCommands $mUnwrappedDbCommands]
		}
	    }
	    class {
		return [info class]
	    }
	    default {
		return
	    }
	}
    }

    set i [lsearch -exact $mArcherCoreCommands $cmd]
    if {$i != -1} {
	return [uplevel $mCoreCmdLevel $args]
    }

    set i [lsearch -exact $mUnwrappedDbCommands $cmd]
    if {$i != -1} {
	return [eval gedCmd $args]
    }

    error "ArcherCore::cmd: unrecognized command - $args, check source code"
}

::itcl::body ArcherCore::gedCmd {args} {
    return [eval $itk_component(ged) $args]
}


# ------------------------------------------------------------
#                  DB/DISPLAY COMMANDS
# ------------------------------------------------------------
::itcl::body ArcherCore::getNodeChildren {node} {
    if {$node == ""} {
	return {}
    }


    if {[catch {getTreeMembers $node} tlist]} {
	return {}
    }

    return $tlist
}

::itcl::body ArcherCore::getTreeFromGData {_gdata} {
    set ti [lsearch $_gdata tree]
    if {$ti != -1} {
	incr ti
	return [lindex $_gdata $ti]
    }

    return {}
}


::itcl::body ArcherCore::getTreeMembers {_comb {_wflag 0}} {
    if {![$itk_component(ged) exists $_comb]} {
	return ""
    }

    set tlist [$itk_component(ged) lt -c " " $_comb]
    set tlen [llength $tlist]

    if {$tlen >= $mMaxCombMembersShown} {
	if {$_wflag} {
	    set j [lsearch $mCombWarningList $_comb]

	    if {$j == -1} {
		tk_messageBox -message "Warning: not all members of $_comb will be visible in the tree. See the \"Max Comb Members Shown\" preference."
		lappend mCombWarningList $_comb
	    }
	}

	set tlist [lrange $tlist 0 $mMaxCombMembersShown-1]
    }

    return $tlist
}


::itcl::body ArcherCore::getTreeOp {_parent _child} {
    if {$_parent == ""} {
	return ""
    }

    #XXX The quick and dirty solution calls "l". There should be an option to
    #    get a clean list of the members and their respective operators.
    set ldata [split [$itk_component(ged) l $_parent] "\n"]
    foreach line [lrange $ldata 1 end] {
	if {[catch {lindex $line 1} member]} {
	    continue
	}

	if {$member == $_child} {
	    switch -- [lindex $line 0] {
		"-" {
		    return "Sub"
		}
		"+" {
		    return "Inter"
		}
		default {
		    return "Union"
		}

	    }
	    return
	}
    }

    return ""
}

::itcl::body ArcherCore::renderComp {_node} {
    set renderMode [gedCmd how $_node]
    if {$renderMode < 0} {
	render $_node 0 1 1
    } else {
	render $_node -1 1 1
    }
}


::itcl::body ArcherCore::render {_node _state _trans _updateTree {_wflag 1} {_node_id ""}} {
    if {$_wflag} {
	SetWaitCursor $this
    }

    set tnode [file tail $_node]
    set saveGroundPlane 0

    if {$mShowPrimitiveLabels} {
	set plnode $_node
    } else {
	set plnode {}
    }

    $itk_component(ged) refresh_off

    catch {
	if {[catch {gedCmd attr get \
			$tnode displayColor} displayColor]} {
	    switch -exact -- $_state \
		$DISPLAY_MODE_WIREFRAME {
		    gedCmd draw -m0 -x$_trans $_node
		} \
		$DISPLAY_MODE_SHADED {
		    gedCmd draw -m1 -x$_trans $_node
		} \
		$DISPLAY_MODE_SHADED_ALL {
		    gedCmd draw -m2 -x$_trans $_node
		} \
		$DISPLAY_MODE_SHADED_EVAL {
		    gedCmd draw -m3 -x$_trans $_node
		} \
		$DISPLAY_MODE_EVALUATED {
		    gedCmd E $_node
		} \
		$DISPLAY_MODE_HIDDEN {
		    gedCmd draw -h $_node
		} \
		$DISPLAY_MODE_OFF {
		    gedCmd erase $_node
		}
	} else {
	    switch -exact -- $_state \
		$DISPLAY_MODE_WIREFRAME {
		    gedCmd draw -m0 -x$_trans \
			-C$displayColor $_node
		} \
		$DISPLAY_MODE_SHADED {
		    gedCmd draw -m1 -x$_trans \
			-C$displayColor $_node
		} \
		$DISPLAY_MODE_SHADED_ALL {
		    gedCmd draw -m2 -x$_trans \
			-C$displayColor $_node
		} \
		$DISPLAY_MODE_SHADED_EVAL {
		    gedCmd draw -m3 -x$_trans \
			-C$displayColor $_node
		} \
		$DISPLAY_MODE_EVALUATED {
		    gedCmd E -C$displayColor $_node
		} \
		$DISPLAY_MODE_HIDDEN {
		    gedCmd draw -h -C$displayColor $_node
		} \
		$DISPLAY_MODE_OFF {
		    gedCmd erase $_node
		}
	}
    }

    if {$_node == $mSelectedObjPath} {
	if {$_state != -1} {
	    gedCmd configure -primitiveLabels $plnode
	} else {
	    gedCmd configure -primitiveLabels {}

	    gedCmd data_axes points {}
	    gedCmd data_lines points {}
	}
    } else {
	set soi -1
	set tmpObjPath [file dirname $mSelectedObjPath]
	while {$soi == -1 && $tmpObjPath != "."} {
	    set soi [lsearch $_node $tmpObjPath]
	    set tmpObjPath [file dirname $tmpObjPath]
	}

	if {$soi != -1} {
	    gedCmd configure -primitiveLabels {}

	    gedCmd data_axes points {}
	    gedCmd data_lines points {}
	}
    }

    if {$mSavedCenter != "" && $mTreeMode > $TREE_MODE_TREE &&
	($mColorObjects != "" || $mGhostObjects != "" || $mEdgeObjects != "")} {
	$itk_component(ged) center $mSavedCenter
	$itk_component(ged) size $mSavedSize
    }

    set mSavedCenter ""
    set mSavedSize ""

    # Get the eye pt in model coordinates
    set eyemodel [split [regsub {;} [$itk_component(ged) get_eyemodel] {}] "\n"]
    set eye_pt [lrange [lindex $eyemodel 2] 1 end]

    # Convert the eye pt to view coordinates
    set viewEyePt [eval $itk_component(ged) m2v_point $eye_pt]

    # Use the eye pt that is furthest from the view center
    if {$mSavedViewEyePt == ""} {
	set mSavedViewEyePt $viewEyePt
    } else {
	set vz [lindex $viewEyePt 2]
	set saved_vz [lindex $mSavedViewEyePt 2]

	if {$vz > $saved_vz} {
	    set mSavedViewEyePt $viewEyePt
	}
    }

    $itk_component(ged) refresh_on
    $itk_component(ged) refresh_all

    # Turn ground plane back on if it was on before the draw
    if {$saveGroundPlane} {
	set mShowGroundPlane 1
	showGroundPlane
    }

    if {$_updateTree} {
	updateTreeDrawLists
    }

    if {$_wflag} {
	SetNormalCursor $this
    }

    if {$_node_id != ""} {
	set snode [$itk_component(newtree) selection]

	if {$snode != $_node_id} {
	    $itk_component(newtree) selection set $_node_id
	}
    }
}

::itcl::body ArcherCore::selectDisplayColor {node} {
    set tnode [file tail $node]

    if {[catch {gedCmd attr get \
		    $tnode displayColor} displayColor] &&
	[catch {gedCmd attr get \
		    $tnode rgb} displayColor]} {
	set displayColor [eval format "%d/%d/%d" $mDefaultNodeColor]
    }

    set rgb [split $displayColor /]
    set color [tk_chooseColor \
		   -parent $itk_interior \
		   -initialcolor [getTkColor [lindex $rgb 0] [lindex $rgb 1] [lindex $rgb 2]]]
    if {$color == ""} {
	return
    }

    setDisplayColor $node [getRgbColor $color]
}

::itcl::body ArcherCore::setDisplayColor {node rgb} {
    set tnode [file tail $node]
    set savePwd ""

    if {$rgb == {}} {
	gedCmd attr rm $tnode displayColor
    } else {
	gedCmd attr set $tnode \
	    displayColor "[lindex $rgb 0]/[lindex $rgb 1]/[lindex $rgb 2]"
    }

    set drawState [gedCmd how -b $node]

    if {$savePwd != ""} {
	cd $savePwd
    }

    # redraw with a potentially different color
    if {[llength $drawState] != 0} {
	render $node [lindex $drawState 0] \
	    [lindex $drawState 1] 0 1
    }

    set mNeedSave 1
    updateSaveMode
}


::itcl::body ArcherCore::selectTransparency {_node} {
    set rdata [gedCmd how -b $_node]
    if {$rdata == -1} {
	return
    }

    set mTransparency [expr {1.0 - [lindex $rdata 1]}]

    set pane [centerDialogOverPane $itk_component(selTranspDialog)]
    $itk_component(selTranspDialogSc) configure \
	-command [::itcl::code $this selectTransparencyCmd $_node]
    $itk_component(selTranspDialog) activate
}


::itcl::body ArcherCore::selectTransparencyCmd {_node _alpha} {
    setTransparency $_node [expr {1.0 - $_alpha}]
}


::itcl::body ArcherCore::setTransparency {node alpha} {
    gedCmd set_transparency $node $alpha
}

::itcl::body ArcherCore::raytracePanel {} {
    $itk_component(rtcntrl) configure -size "Size of Pane"
    $itk_component(rtcntrl) activate
}

::itcl::body ArcherCore::doPng {} {
    set typelist {
	{"PNG Files" {".png"}}
	{"All Files" {*}}
    }
    set filename [tk_getSaveFile -parent $itk_interior \
		      -title "Export Geometry to PNG" \
		      -initialdir $mLastSelectedDir -filetypes $typelist]

    if {$filename == ""} {
	return
    }

    set mLastSelectedDir [file dirname $filename]

    #XXX Hack! Hack! Hack!
    #XXX The png command below needs to be modified to draw
    #XXX into an off screen buffer to avoid occlusion
    ::update idletasks
    after 1000
    refreshDisplay

    $itk_component(ged) png $filename
}

::itcl::body ArcherCore::setActivePane {_pane} {
    $itk_component(ged) pane $_pane
}

::itcl::body ArcherCore::updateActivePane {args} {
    # update active pane radiobuttons
    switch -- $args {
	ul {
	    set mActivePane 0
	    set mActivePaneName ul
	}
	ur {
	    set mActivePane 1
	    set mActivePaneName ur
	}
	ll {
	    set mActivePane 2
	    set mActivePaneName ll
	}
	lr {
	    set mActivePane 3
	    set mActivePaneName lr
	}
    }

    set mShowModelAxes [gedCmd cget -modelAxesEnable]
    set mShowModelAxesTicks [gedCmd cget -modelAxesTickEnable]
    set mShowViewAxes [gedCmd cget -viewAxesEnable]
    set mShowGrid [gedCmd cget -gridEnable]
    set mSnapGrid [gedCmd cget -gridSnap]
    set mSnapLines [gedCmd cget -linesSnap]
    set mShowADC [gedCmd cget -adcEnable]
}

::itcl::body ArcherCore::doMultiPane {} {
    gedCmd configure -multi_pane $mMultiPane

    if {$mMultiPane && $mDisplayListMode} {
	::update
	redrawWho
    }
}

::itcl::body ArcherCore::doLighting {} {
    SetWaitCursor $this

    # Leave this off for now.
    gedCmd zclip_all 0

    gedCmd zbuffer_all $mLighting

    if {$mLighting} {
	gedCmd light_all $mLightingMode
    } else {
	gedCmd light_all $mLighting
    }

    gedCmd refresh_all

    SetNormalCursor $this
}

::itcl::body ArcherCore::doViewReset {} {
    set mCurrentPaneName ""
    gedCmd autoview_all
    gedCmd default_views
}

::itcl::body ArcherCore::doAutoview {} {
    if {$mCurrentPaneName == ""} {
	set pane $mActivePaneName
    } else {
	set pane $mCurrentPaneName
    }
    set mCurrentPaneName ""

    $itk_component(ged) pane_autoview $pane
}

::itcl::body ArcherCore::doViewCenter {} {
    set pane [centerDialogOverPane $itk_component(centerDialog)]

    set center [$itk_component(ged) pane_center $pane]
    set mCenterX [lindex $center 0]
    set mCenterY [lindex $center 1]
    set mCenterZ [lindex $center 2]

    set mDbUnits [gedCmd units -s]
    ::update
    if {[$itk_component(centerDialog) activate]} {
	$itk_component(ged) pane_center $pane $mCenterX $mCenterY $mCenterZ
    }
}


::itcl::body ArcherCore::doAe {_az _el} {
    if {$mCurrentPaneName == ""} {
	set pane $mActivePaneName
    } else {
	set pane $mCurrentPaneName
    }
    set mCurrentPaneName ""

    $itk_component(ged) pane_ae $pane $_az $_el

    addHistory "aet $_az $_el"
}


::itcl::body ArcherCore::doFlipView {} {
    if {$mCurrentPaneName == ""} {
	set pane $mActivePaneName
    } else {
	set pane $mCurrentPaneName
    }
    set mCurrentPaneName ""

    $itk_component(ged) pane_rot $pane -v 0 180 0

    addHistory "rot -v 0 180 0"
}

::itcl::body ArcherCore::doSelectGroup {} {
    $itk_component(selGroupDialog) center [namespace tail $this]
    ::update idletasks
    set save_name $mCompSelectGroup
    if {![$itk_component(selGroupDialog) activate]} {
	set mCompSelectGroup $save_name
    }
}

::itcl::body ArcherCore::showViewAxes {} {
    catch {gedCmd configure -viewAxesEnable $mShowViewAxes}
}

::itcl::body ArcherCore::showModelAxes {} {
    catch {gedCmd configure -modelAxesEnable $mShowModelAxes}
}

::itcl::body ArcherCore::showModelAxesTicks {} {
    catch {gedCmd configure -modelAxesTickEnable $mShowModelAxesTicks}
}

::itcl::body ArcherCore::showGrid {} {
    catch {gedCmd configure -gridEnable $mShowGrid}
}

::itcl::body ArcherCore::snapGrid {} {
    catch {gedCmd configure -gridSnap $mSnapGrid}
}

::itcl::body ArcherCore::snapLines {} {
    catch {gedCmd configure -linesSnap $mSnapLines}
}

::itcl::body ArcherCore::showADC {} {
    catch {gedCmd configure -adcEnable $mShowADC}
}


# ------------------------------------------------------------
#                     PROTECTED TREE COMMANDS
# ------------------------------------------------------------


::itcl::body ArcherCore::dblClick {_x _y} {
    set mDoubleClickActive 1

    set item [$itk_component(newtree) identify row $_x $_y]
    set obj [$itk_component(newtree) item $item -text]
    set path [getTreePath $item $obj]

    set rdata [gedCmd how -b $path]
    if {$rdata == -1} {
	render $path $mDefaultDisplayMode 1 1 1 $item
    } else {
	erase $path
    }
}


::itcl::body ArcherCore::fillTree {_pnode _ctext _flat {_allow_multiple 0}} {
    global no_tree_decorate

    set cnodes [getCNodesFromCText $_pnode $_ctext]

    # At least one node for _pnode/_ctext already exists
    if {!$_allow_multiple && $cnodes != {}} {
	return
    }

    set ctype invalid
    set isregion 0

    if {![catch {$itk_component(ged) get_type $_ctext} ctype]} {
	if {![catch {$itk_component(ged) form $ctype} cform]} {
	    if {[lsearch $cform region] > -1} {
		if {![catch {$itk_component(ged) get $_ctext} cgdata]} {
		    set ctype [lindex $cgdata 0]
		    set isregion [isRegion $cgdata]
		}
	    }
	}
    }

    set ptext $mNode2Text($_pnode)
    if {[info exists no_tree_decorate] && $no_tree_decorate} {
	set cnode [$itk_component(newtree) insert $_pnode end \
		       -tags $TREE_POPUP_TAG \
		       -text $_ctext]
    } else {
	set op [getTreeOp $ptext $_ctext]
	set img [getTreeImage $_ctext $ctype $op $isregion]
	set cnode [$itk_component(newtree) insert $_pnode end \
		       -tags $TREE_POPUP_TAG \
		       -text $_ctext \
		       -image $img]
    }
    fillTreeColumns $cnode $_ctext

    if {!$_flat} {
	set mlist ""
	switch -- $ctype {
	    "comb" {
		set mlist [getTreeMembers $_ctext]
	    }
	    "dsp" -
	    "ebm" -
	    "vol" {
		set mlist [$itk_component(ged) get $_ctext file]
	    }
	    "extrude" -
	    "revolve" {
		set mlist [$itk_component(ged) get $_ctext sk_name]
	    }
	}

	if {$mlist != ""} {
	    removeTreeNodeTag $cnode $TREE_OPENED_TAG
	    $itk_component(newtree) item $cnode -open false
	    addTreePlaceholder $cnode
	}
    }

    lappend mText2Node($_ctext) [list $cnode $_pnode]
    set mNode2Text($cnode) $_ctext
    lappend mPNode2CList($_pnode) [list $_ctext $cnode]
    set mCNode2PList($cnode) [list $ptext $_pnode]
}

::itcl::body ArcherCore::fillTreeColumns {_cnode _ctext} {
    if {$mTreeAttrColumns != {}} {
	set vals {}

	if {[catch {gedCmd attr get $_ctext} alist]} {
	    set alist {}
	}

	foreach attr $mTreeAttrColumns {
	    set ai [lsearch -index 0 $alist $attr]
	    if {$ai != -1} {
		incr ai
		lappend vals [lindex $alist $ai]
	    } else {
		lappend vals {}
	    }
	}

	$itk_component(newtree) item $_cnode -values $vals
    }
}

::itcl::body ArcherCore::isRegion {_cgdata} {
    set ri [lsearch $_cgdata region]
    if {$ri == -1} {
	return 0
    }

    incr ri
    set isregion [lindex $_cgdata $ri]

    if {$isregion} {
	# Check for rid
	set ii [lsearch $_cgdata id]
	if {$ii != -1} {
	    incr ii
	    set hasId [lindex $_cgdata $ii]
	} else {
	    set hasId 0
	}

	# Check for air
	set ai [lsearch $_cgdata air]

	if {$ai != -1} {
	    set hasAir 1
	} else {
	    set hasAir 0
	}

	if {($hasId && $hasAir) || (!$hasId && !$hasAir)} {
	    set isregion 3
	} else {
	    if {$hasId} {
		set isregion 1
	    } else {
		set isregion 2
	    }
	}

	return $isregion
    }

    return 0
}

::itcl::body ArcherCore::loadMenu {_menu _node _nodeType _node_id} {
    set mCurrTreeMenuNode $_node_id

    # destroy old menu
    if [winfo exists $_menu.color] {
	$_menu.color delete 0 end
	destroy $_menu.color
    }
    if {[winfo exists $_menu.trans]} {
	$_menu.trans delete 0 end
	destroy $_menu.trans
    }
    $_menu delete 0 end

    set mRenderMode [gedCmd how $_node]
    # do this in case "ev" was used from the command line
    if {!$mEnableBigE && $mRenderMode == 3} {
	set mRenderMode 0
    }

    if {$_nodeType == "leaf"} {
	$_menu add radiobutton -label "Wireframe" \
	    -indicatoron 1 -value 0 -variable [::itcl::scope mRenderMode] \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_WIREFRAME 1 1 1 $_node_id]

	$_menu add radiobutton -label "Shaded" \
	    -indicatoron 1 -value 2 -variable [::itcl::scope mRenderMode] \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_SHADED_ALL 1 1 1 $_node_id]

	$_menu add radiobutton -label "Shaded (Evaluated)" \
	    -indicatoron 1 -value 5 -variable [::itcl::scope mRenderMode] \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_SHADED_EVAL 1 1 1 $_node_id]

	$_menu add radiobutton -label "Hidden Line" \
	    -indicatoron 1 -value 4 -variable [::itcl::scope mRenderMode] \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_HIDDEN 1 1 1 $_node_id]

	if {$mEnableBigE} {
	    $_menu add radiobutton \
		-label "Evaluated" \
		-indicatoron 1 \
		-value 3 \
		-variable [::itcl::scope mRenderMode] \
		-command [::itcl::code $this render $_node $DISPLAY_MODE_EVALUATED 1 1 1 $_node_id]
	}

	$_menu add radiobutton -label "Off" \
	    -indicatoron 1 -value -1 -variable [::itcl::scope mRenderMode] \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_OFF 1 1]
    } else {
	$_menu add command -label "Wireframe" \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_WIREFRAME 1 1 1 $_node_id]

	$_menu add command -label "Shaded" \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_SHADED_ALL 1 1 1 $_node_id]

	$_menu add command -label "Shaded (Evaluated)" \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_SHADED_EVAL 1 1 1 $_node_id]

	$_menu add command -label "Hidden Line" \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_HIDDEN 1 1 1 $_node_id]

	if {$mEnableBigE} {
	    $_menu add command \
		-label "Evaluated" \
		-command [::itcl::code $this render $_node $DISPLAY_MODE_EVALUATED 1 1 1 $_node_id]
	}

	$_menu add command -label "Off" \
	    -command [::itcl::code $this render $_node $DISPLAY_MODE_OFF 1 1]
    }

    set nodeList [split $_node /]
    set nodeLen [llength $nodeList]

    #XXX need to copy over
    $_menu add separator
    $_menu add command -label "Copy" \
	-command [::itcl::code $this doCopy [file tail $_node]]
    if {$mCopyObj != ""} {
	$_menu add command -label "Paste" \
	    -command [::itcl::code $this doPaste [file tail $_node] $mCopyObj]
    }
    $_menu add command -label "Kill" \
	-command [::itcl::code $this kill [file tail $_node]]
    $_menu add command -label "Killall" \
	-command [::itcl::code $this killall [file tail $_node]]
    $_menu add command -label "Rename" \
	-command [::itcl::code $this renameObj [file tail $_node]]

    if {$nodeLen > 1} {
	$_menu add command -label "Remove" \
	    -command [::itcl::code $this rm [lindex $nodeList end-1] [lindex $nodeList end]]
    }

    $_menu add separator

    # Build color menu
    $_menu add cascade -label "Color" \
	-menu $_menu.color
    set color [menu $_menu.color -tearoff 0]

    $color configure \
	-background $SystemButtonFace

    $color add command -label "Red" \
	-command [::itcl::code $this setDisplayColor $_node {255 0 0}]
    $color add command -label "Orange" \
	-command [::itcl::code $this setDisplayColor $_node {204 128 51}]
    $color add command -label "Yellow" \
	-command [::itcl::code $this setDisplayColor $_node {219 219 112}]
    $color add command -label "Green" \
	-command [::itcl::code $this setDisplayColor $_node {0 255 0}]
    $color add command -label "Blue" \
	-command [::itcl::code $this setDisplayColor $_node {0 0 255}]
    $color add command -label "Cyan" \
	-command [::itcl::code $this setDisplayColor $_node {0 255 255}]
    $color add command -label "Indigo" \
	-command [::itcl::code $this setDisplayColor $_node {0 0 128}]
    $color add command -label "Violet" \
	-command [::itcl::code $this setDisplayColor $_node {128 0 128}]
    $color add separator
    $color add command -label "Default" \
	-command [::itcl::code $this setDisplayColor $_node {}]
    $color add command -label "Select..." \
	-command [::itcl::code $this selectDisplayColor $_node]

    if {($mDisplayType == "wgl" || $mDisplayType == "ogl" || $mDisplayType == "osgl") && ($_nodeType != "leaf" || 0 < $mRenderMode)} {
	# Build transparency menu
	$_menu add cascade -label "Transparency" \
	    -menu $_menu.trans
	set trans [menu $_menu.trans -tearoff 0]

	$trans configure \
	    -background $SystemButtonFace

	$trans add command -label "None" \
	    -command [::itcl::code $this setTransparency $_node 1.0]
#	#$trans add command -label "25%" \
#	    #	-command [::itcl::code $this setTransparency $_node 0.75]
#	#$trans add command -label "50%" \
#	    #	-command [::itcl::code $this setTransparency $_node 0.5]
#	#$trans add command -label "75%" \
#	    #	-command [::itcl::code $this setTransparency $_node 0.25]
#	$trans add command -label "10%" \
#	    -command [::itcl::code $this setTransparency $_node 0.9]
#	$trans add command -label "20%" \
#	    -command [::itcl::code $this setTransparency $_node 0.8]
#	$trans add command -label "30%" \
#	    -command [::itcl::code $this setTransparency $_node 0.7]
#	$trans add command -label "40%" \
#	    -command [::itcl::code $this setTransparency $_node 0.6]
#	$trans add command -label "50%" \
#	    -command [::itcl::code $this setTransparency $_node 0.5]
#	$trans add command -label "60%" \
#	    -command [::itcl::code $this setTransparency $_node 0.4]
	$trans add command -label "70%" \
	    -command [::itcl::code $this setTransparency $_node 0.3]
	$trans add command -label "80%" \
	    -command [::itcl::code $this setTransparency $_node 0.2]
#	$trans add command -label "85%" \
	    -command [::itcl::code $this setTransparency $_node 0.15]
	$trans add command -label "90%" \
	    -command [::itcl::code $this setTransparency $_node 0.1]
#	$trans add command -label "95%" \
	    -command [::itcl::code $this setTransparency $_node 0.05]
#	$trans add command -label "97%" \
	    -command [::itcl::code $this setTransparency $_node 0.03]
#	$trans add command -label "99%" \
	    -command [::itcl::code $this setTransparency $_node 0.01]
	$trans add separator
	$trans add command -label "Select..." \
	    -command [::itcl::code $this selectTransparency $_node]

	# set up bindings for transparency status
	bind $trans <<MenuSelect>> \
	    [::itcl::code $this transparencyMenuStatusCB %W]
    }

    # set up bindings for status
    bind $_menu <<MenuSelect>> \
	[::itcl::code $this menuStatusCB %W]
    bind $color <<MenuSelect>> \
	[::itcl::code $this colorMenuStatusCB %W]
}


::itcl::body ArcherCore::loadTopMenu {_menu} {
    # destroy old menu
    if {[winfo exists $_menu.color]} {
	$_menu.color delete 0 end
	destroy $_menu.color
    }
    if {[winfo exists $_menu.trans]} {
	$_menu.trans delete 0 end
	destroy $_menu.trans
    }
    $_menu delete 0 end

    if {$mCopyObj != ""} {
	$_menu add command -label "Paste" \
	    -command [::itcl::code $this doPaste "" $mCopyObj]
    }
}


::itcl::body ArcherCore::findTreeChildNodes {_pnode} {
    if {![info exists mPNode2CList($_pnode)]} {
	 return
    }

    set cnodes {}
    foreach clist $mPNode2CList($_pnode) {
	set ctext [lindex $clist 0]
	if {$ctext == $TREE_PLACEHOLDER_TAG} {
	    continue
	}

	set cnode [lindex $clist 1]
	lappend cnodes $cnode
	eval lappend cnodes [findTreeChildNodes $cnode]
    }

    return $cnodes
}

::itcl::body ArcherCore::findTreeParentNodes {_cnode} {
    set plist $mCNode2PList($_cnode)
    set pnode [lindex $plist 1]

    if {$pnode != {}} {
	lappend pnodes $pnode
	eval lappend pnodes [findTreeParentNodes $pnode]
	return $pnodes
    }

    return $pnode
}

::itcl::body ArcherCore::getCNodesFromCText {_pnode _text} {
    if {[catch {set clists $mPNode2CList($_pnode)}]} {
	return ""
    }

    set cnodes {}

    set ilist [lsearch -all -index 0 $clists $_text]
    if {$ilist != {}} {
	foreach i $ilist {
	    lappend cnodes [lindex [lindex $clists $i] 1]
	}
    }

    return $cnodes
}

::itcl::body ArcherCore::getTreeImage {_obj _type {_op ""} {_isregion 0}} {
    switch -- $_type {
	comb {
	    switch -- $_isregion {
		1 {
		    return [subst $[subst mImage_region$_op]]
		}
		2 {
		    return [subst $[subst mImage_air$_op]]
		}
		3 {
		    return [subst $[subst mImage_airregion$_op]]
		}
		0 -
		default {
		    return [subst $[subst mImage_comb$_op]]
		}
	    }
	}
	arb4 -
	arb5 -
	arb6 -
	arb7 -
	arb8 -
	arbn -
	ars -
	bot -
	brep -
	dsp -
	ehy -
	ell -
	epa -
	eto -
	extrude -
	half -
	hyp -
	invalid -
	metaball -
	nmg -
	pipe -
	rhc -
	rpc -
	sketch -
	sph -
	tgc -
	tor {
	    return [subst $[subst mImage_$_type$_op]]
	}
	default {
	    return [subst $[subst mImage_other$_op]]
	}
    }
}

::itcl::body ArcherCore::getTreeNode {_path {_cflag 0}} {
    set items [split $_path /]
    set len [llength $items]

    if {$len < 1} {
	return {}
    }

    set pnode {}
    set ptext [lindex $items 0]

    if {![info exists mText2Node($ptext)]} {
	return $pnode
    }

    foreach sublist $mText2Node($ptext) {
	set gpnode [lindex $sublist 1]

	if {$gpnode == {}} {
	    set pnode [lindex $sublist 0]

	    if {$_cflag} {
		if {![$itk_component(newtree) item $pnode -open]} {
		    $itk_component(newtree) item $pnode -open true
		    $itk_component(newtree) focus $pnode
		    handleTreeOpen
		} else {
		    $itk_component(newtree) focus $pnode
		}
	    }

	    break
	}
    }

    foreach item [lrange $items 1 end] {
	set found 0

	if {![info exists mText2Node($item)]} {
	    if {$_cflag} {
		if {![$itk_component(newtree) item $pnode -open]} {
		    $itk_component(newtree) item $pnode -open true
		    $itk_component(newtree) focus $pnode
		    handleTreeOpen
		} else {
		    $itk_component(newtree) focus $pnode
		}
	    } else {
		return $pnode
	    }
	}

	foreach sublist $mText2Node($item) {
	    set cnode [lindex $sublist 0]

	    if {$pnode == [lindex $sublist 1]} {
		set pnode $cnode
		set found 1

		if {$_cflag} {
		    if {![$itk_component(newtree) item $cnode -open]} {
			$itk_component(newtree) item $cnode -open true
			$itk_component(newtree) focus $cnode
			handleTreeOpen
		    } else {
			$itk_component(newtree) focus $cnode
		    }
		}

		continue
	    }
	}

	if {!$found} {
	    return $pnode
	}
    }

    return $pnode
}

::itcl::body ArcherCore::getTreeNodes {_path {_cflag 0}} {
    set nlist_partial {}
    set nlist_full {}
    set cnode [getTreeNode $_path $_cflag]

    if {$cnode == {}} {
	return [list $nlist_partial $nlist_full]
    }

    lappend nlist_full $cnode

    set nlist_partial [findTreeParentNodes $cnode]
    eval lappend nlist_full [findTreeChildNodes $cnode]

    return [list $nlist_partial $nlist_full]
}

::itcl::body ArcherCore::getTreePath {_node {_path ""}} {
    if {$_node == ""} {
	return ""
    }

    if {$_path == ""} {
	set _path $mNode2Text($_node)
    }

    set parent [lindex $mCNode2PList($_node) end]
    if {$parent == {}} {
	return $_path
    }

    set text $mNode2Text($parent)
    set _path "$text/$_path"

    return [getTreePath $parent $_path]
}

::itcl::body ArcherCore::getSelectedTreePaths {} {
    return [getTreePath [$itk_component(newtree) selection]]
}

::itcl::body ArcherCore::handleTreeClose {} {
}

::itcl::body ArcherCore::handleTreeOpen {} {
    if {$mEnableListView} {
	return
    }

    SetWaitCursor $this

    set cnode [$itk_component(newtree) focus]
    set ctext [$itk_component(newtree) item $cnode -text]
    set cgdata [$itk_component(ged) get_type $ctext]
    set ctype [lindex $cgdata 0]

    if {($ctype == "comb" ||
	 $ctype == "region" ||
	 $ctype == "dsp" ||
	 $ctype == "ebm" ||
	 $ctype == "extrude" ||
	 $ctype == "revolve" ||
	 $ctype == "vol") &&
	[info exists mPNode2CList($cnode)]} {
	# If this node has never been opened ...
	if {[addTreeNodeTag $cnode $TREE_OPENED_TAG]} {
	    # Remove placeholder
	    set placeholder [lindex [lindex $mPNode2CList($cnode) 0] 1]
	    $itk_component(newtree) delete $placeholder
	    unset mPNode2CList($cnode)

	    switch -- $ctype {
		"region" -
		"comb" {
		    #set tree [getTreeFromGData $cgdata]
		    foreach gctext [getTreeMembers $ctext 1] {
			if {[catch {$itk_component(ged) get_type $gctext} gcgdata]} {
			    set op [getTreeOp $ctext $gctext]
			    set img [getTreeImage $gctext "invalid" $op]

			    set gcnode [$itk_component(newtree) insert $cnode end \
					    -tags $TREE_POPUP_TAG \
					    -text $gctext \
					    -image $img]

			    fillTreeColumns $gcnode $gctext

			    lappend mText2Node($gctext) [list $gcnode $cnode]
			    set mNode2Text($gcnode) $gctext
			    lappend mPNode2CList($cnode) [list $gctext $gcnode]
			    set mCNode2PList($gcnode) [list $ctext $cnode]

			    continue
			}

			# Add gchild members
			if {$mEnableListView} {
			    fillTree $cnode $gctext 1 1
			} else {
			    fillTree $cnode $gctext 0 0
			}
		    }
		}
		"dsp" -
		"ebm" -
		"vol" {
		    set gctext [$itk_component(ged) get $ctext file]
		    set gcnode [$itk_component(newtree) insert $cnode end \
				    -tags $TREE_POPUP_TAG \
				    -text $gctext \
				    -image $mImage_other]
		    fillTreeColumns $gcnode $gctext

		    lappend mText2Node($gctext) [list $gcnode $cnode]
		    set mNode2Text($gcnode) $gctext
		    lappend mPNode2CList($cnode) [list $gctext $gcnode]
		    set mCNode2PList($gcnode) [list $ctext $cnode]
		}
		"extrude" -
		"revolve" {
		    set gctext [$itk_component(ged) get $ctext sk_name]

		    # Add gchild members
		    if {$mEnableListView} {
			fillTree $cnode $gctext 1 1
		    } else {
			fillTree $cnode $gctext 0 0
		    }
		}
	    }
	}
    }

    updateTreeDrawLists
    SetNormalCursor $this
}

::itcl::body ArcherCore::handleTreePopup {_type _x _y _X _Y} {
    if {$mTreePopupBusy} {
	set mTreePopupBusy 0
	return
    }

    if {$_type == $TREE_POPUP_TYPE_NULL} {
	loadTopMenu $itk_component(newtreepopup)
	tk_popup $itk_component(newtreepopup) $_X $_Y

	return
    }

    # Relies on this routine being called twice when a popup is invoked over a node
    set mTreePopupBusy 1

    set item [$itk_component(newtree) identify row $_x $_y]
    set text [$itk_component(newtree) item $item -text]
    set img [$itk_component(newtree) item $item -image]

    if {$img == $mImage_comb} {
	set nodeType "branch"
    } else {
	set nodeType "leaf"
    }

    set path [getTreePath $item $text]
    set dirname [file dirname $path]
    if {$dirname != "."} {
	set type [$itk_component(ged) get_type $dirname]
	if {$type == "dsp" || $type == "ebm" || $type == "extrude" || $type == "revolve" || $type == "vol"} {
	    return
	}
    }

    loadMenu $itk_component(newtreepopup) $path $nodeType $item
    tk_popup $itk_component(newtreepopup) $_X $_Y
}

::itcl::body ArcherCore::handleCmdPopup {_X _Y} {
    tk_popup $itk_component(cmdpopup) $_X $_Y
}

::itcl::body ArcherCore::handleTreeSelect {} {
    if {$mDoubleClickActive} {
	set mDoubleClickActive 0
	return 1
    }

    foreach anode $mAffectedNodeList {
	removeTreeNodeTag $anode $TREE_AFFECTED_TAG
    }

    set mAffectedNodeList ""
    set snode [$itk_component(newtree) selection]

    if {$snode == ""} {
	return 1
    }

    set mPrevSelectedObjPath $mSelectedObjPath
    set mPrevSelectedObj $mSelectedObj
    set mSelectedObjPath [getTreePath $snode]
    set mSelectedObj $mNode2Text($snode)

    # label the object if it's being drawn
    set mRenderMode [gedCmd how $mSelectedObjPath]

    if {$mShowPrimitiveLabels} {
	if {0 <= $mRenderMode} {
	    gedCmd configure -primitiveLabels $mSelectedObjPath
	} else {
	    gedCmd configure -primitiveLabels {}
	}
    }

    if {$mPrevSelectedObjPath == $mSelectedObjPath} {
	return 1
    }

    if {!$mEnableAffectedNodeHighlight} {
	return 0
    }

    if {$mEnableListView} {
	if {$mEnableListViewAllAffected} {
	    foreach path [string trim [gedCmd search / -name $mSelectedObj]] {
		set path [regsub {^/} $path {}]
		foreach obj [split $path /] {
		    if {$obj == $mSelectedObj} {
			continue
		    }

		    set cnode [lindex [lindex $mText2Node($obj) 0] 0]
		    lappend mAffectedNodeList $cnode
		    addTreeNodeTag $cnode $TREE_AFFECTED_TAG
		}
	    }
	} else {
	    foreach obj [gedCmd dbfind $mSelectedObj] {
		set cnode [lindex [lindex $mText2Node($obj) 0] 0]
		lappend mAffectedNodeList $cnode
		addTreeNodeTag $cnode $TREE_AFFECTED_TAG
	    }
	}
    } else {
	foreach path [string trim [gedCmd search / -name $mSelectedObj]] {
	    set path [regsub {^/} $path {}]
	    set pathNodes [getTreeNodes $path]
	    set pnodes [lreverse [lindex $pathNodes 0]]
	    set cnodes [lindex $pathNodes 1]

	    set found_pnode ""
	    set pnode_not_open 0
	    set snodeEQpnode 0
	    foreach pnode $pnodes {
		if {$mNode2Text($snode) == $mNode2Text($pnode)} {
		    set snodeEQpnode 1
		    break
		}

		set found_pnode $pnode

		if {![$itk_component(newtree) item $pnode -open]} {
		    if {$mNode2Text($pnode) != $TREE_PLACEHOLDER_TAG} {
			set pnode_not_open 1
		    }

		    break
		}
	    }

	    set cnode [lindex $cnodes 0]
	    if {$found_pnode != "" && ($pnode_not_open || $snodeEQpnode || $mNode2Text($snode) == $mNode2Text($cnode))} {
		lappend mAffectedNodeList $found_pnode
		addTreeNodeTag $pnode $TREE_AFFECTED_TAG
	    } elseif {$cnode != $snode} {
		if {$mNode2Text($snode) == $mNode2Text($cnode) && $found_pnode != ""} {
		    lappend mAffectedNodeList $found_pnode
		    addTreeNodeTag $pnode $TREE_AFFECTED_TAG
		} else {
		    lappend mAffectedNodeList $cnode
		    addTreeNodeTag $cnode $TREE_AFFECTED_TAG
		}
	    }
	}
    }

    return 0
}

::itcl::body ArcherCore::addTreeNodeTag {_node _tag} {
    set tags [$itk_component(newtree) item $_node -tags]
    set ai [lsearch $tags $_tag]
    if {$ai == -1} {
	lappend tags $_tag
	$itk_component(newtree) item $_node -tags $tags

	return 1
    }

    return 0
}

::itcl::body ArcherCore::removeTreeNodeTag {_node _tag} {
    set tags [$itk_component(newtree) item $_node -tags]
    set ai [lsearch $tags $_tag]
    if {$ai != -1} {
	set tags [lreplace $tags $ai $ai]
	$itk_component(newtree) item $_node -tags $tags
    }
}

::itcl::body ArcherCore::addTreePlaceholder {_pnode} {
    set cnode [$itk_component(newtree) insert $_pnode end \
		   -text $TREE_PLACEHOLDER_TAG \
		   -tags $TREE_PLACEHOLDER_TAG]

    set mPNode2CList($_pnode) [list [list $TREE_PLACEHOLDER_TAG $cnode]]
}

::itcl::body ArcherCore::selectTreePath {_path} {
    if {$_path == {}} {
	return
    }

    set obj [lindex [split $_path /] end]

    if {$mEnableListView} {
	$itk_component(newtree) selection set [lindex [lindex $mText2Node($obj) 0] 0]
	$itk_component(newtree) see [lindex [lindex $mText2Node($obj) 0] 0]
    } else {
	getTreeNode $_path 1
	set snode [$itk_component(newtree) focus]
	set mSelectedObjPath ""

	if {$snode == {}} {
	    set mSelectedObj ""
	    putString $_path
	} else {
	    $itk_component(newtree) selection set $snode
	    $itk_component(newtree) see $snode
	}
    }
}

::itcl::body ArcherCore::setTreeView {{_rflag 0}} {
    if {![info exists itk_component(ged)]} {
	return
    }

    SetWaitCursor $this

    if {$_rflag} {
	rebuildTree

	if {$mSelectedObj != ""} {
	    if {$mEnableListView} {
		selectTreePath $mSelectedObj 
	    } else {
		if {![catch {set paths [gedCmd search -Q / -name $mSelectedObj]}]} {
		    if {[llength $paths]} {
		       selectTreePath [lindex $paths 0]
		    }
		}
	    }
	}
    }

    SetNormalCursor $this
}

##
# Expects mTreeMode to be set before calling.
#
::itcl::body ArcherCore::toggleTreeView {} {

    set mToolViewChange 1
    $itk_component(treeAccordian) clear

    if {$mTreeMode < $TREE_MODE_COLOR_OBJECTS} {
	if {$mEnableColorListView} {
	    $itk_component(treeAccordian) insert 0 List
	} else {
	    $itk_component(treeAccordian) insert 0 [lindex $TREE_MODE_NAMES $mTreeMode]
	}
    } else {
	if {$mEnableEdgeListView} {
	    $itk_component(treeAccordian) insert 0 "[lindex $TREE_MODE_NAMES $TREE_MODE_EDGE_OBJECTS] (List)"
	} else {
	    $itk_component(treeAccordian) insert 0 "[lindex $TREE_MODE_NAMES $TREE_MODE_EDGE_OBJECTS] (Tree)"
	}

	if {$mEnableGhostListView} {
	    $itk_component(treeAccordian) insert 0 "[lindex $TREE_MODE_NAMES $TREE_MODE_GHOST_OBJECTS] (List)"
	} else {
	    $itk_component(treeAccordian) insert 0 "[lindex $TREE_MODE_NAMES $TREE_MODE_GHOST_OBJECTS] (Tree)"
	}

	if {$mEnableColorListView} {
	    $itk_component(treeAccordian) insert 0 "[lindex $TREE_MODE_NAMES $TREE_MODE_COLOR_OBJECTS] (List)"
	} else {
	    $itk_component(treeAccordian) insert 0 "[lindex $TREE_MODE_NAMES $TREE_MODE_COLOR_OBJECTS] (Tree)"
	}
    }

    setViewTypeFromTreeMode

    if {$mTreeMode < $TREE_MODE_COLOR_OBJECTS} {
	if {$mEnableListView} {
	    $itk_component(treeAccordian) togglePanel List
	} else {
	    $itk_component(treeAccordian) togglePanel [lindex $TREE_MODE_NAMES $mTreeMode]
	}
    } else {
	if {$mEnableListView} {
	    $itk_component(treeAccordian) togglePanel "[lindex $TREE_MODE_NAMES $mTreeMode] (List)"
	} else {
	    $itk_component(treeAccordian) togglePanel "[lindex $TREE_MODE_NAMES $mTreeMode] (Tree)"
	}
    }

    set mToolViewChange 0
}

::itcl::body ArcherCore::treeNodeHasBeenOpened {_node} {
    set tags [$itk_component(newtree) item $_node -tags]
    set ai [lsearch $tags $TREE_OPENED_TAG]
    if {$ai == -1} {
	return 0
    }

    return 1
}

::itcl::body ArcherCore::treeNodeIsOpen {_node} {
    return [$itk_component(newtree) item $_node -open]
}

#
# Delete any use of _node and its descendants in the data
# variables that are used to interact with the tree viewer.
#
::itcl::body ArcherCore::purgeNodeData {_node} {
    if {$mNoTree} {
	return
    }

    if {[info exists mPNode2CList($_node)]} {
	foreach sublist $mPNode2CList($_node) {
	    if {[lindex $sublist 0] != $TREE_PLACEHOLDER_TAG} {
		purgeNodeData [lindex $sublist 1]
	    }
	}
    }

    set name $mNode2Text($_node)
    if {[info exists mText2Node($name)]} {
	set leftovers {}
	foreach sublist $mText2Node($name) {
	    if {$_node != [lindex $sublist 0]} {
		lappend leftovers $sublist
	    }
	}

	if {$leftovers != {}} {
	    set mText2Node($name) $leftovers
	} else {
	    unset mText2Node($name)
	}
    }

    set pnode [lindex $mCNode2PList($_node) 1]
    if {[info exists mPNode2CList($pnode)]} {
	set leftovers {}
	foreach sublist $mPNode2CList($pnode) {
	    if {$_node != [lindex $sublist 1]} {
		lappend leftovers $sublist
	    }
	}

	if {$leftovers != {}} {
	    set mPNode2CList($pnode) $leftovers
	} else {
	    unset mPNode2CList($pnode)
	}
    }

    unset mNode2Text($_node)
    unset mCNode2PList($_node)

    set i [lsearch $mNodePDrawList $_node]
    if {$i != -1} {
	set mNodePDrawList [lreplace $mNodePDrawList $i $i]
    }

    set i [lsearch $mNodeDrawList $_node]
    if {$i != -1} {
	set mNodeDrawList [lreplace $mNodeDrawList $i $i]
    }
}

#
# Note -_name is expected to exist in the database.
#
::itcl::body ArcherCore::updateTreeTopWithName {_name} {
    # Check to see if it's okay to add a toplevel node
    set toplist {}
    foreach item [$itk_component(ged) tops] {
	lappend toplist [regsub {/.*} $item {}]
    }

    set i [lsearch $toplist $_name]

    # Possibly add a toplevel node to the tree
    if {$i != -1} {
	# Add _name if not already there.
	if {[catch {lsearch -index 0 $mPNode2CList() $_name} j] || $j == -1} {
	    if {$mEnableListView} {
		fillTree {} $_name 1
	    } else {
		fillTree {} $_name 0
	    }
	}
    } else {
	# Not found in call to tops, so possibly need to update _name as a member
	# of some other combination(s).
	if {![catch {set tlists $mText2Node($_name)}]} {
	    foreach tlist $tlists {
		set cnode [lindex $tlist 0]
		set pnode [lindex $tlist 1]
		set ptext $mNode2Text($pnode)

		if {[catch {$itk_component(ged) get $_name} cgdata]} {
		    # Shouldn't happen at this point.
		} else {
		    set ctype [lindex $cgdata 0]

		    if {!$mEnableListView} {
			set isregion [isRegion $cgdata]
			set op [getTreeOp $ptext $_name]
			set img [getTreeImage $_name $ctype $op $isregion]

			if {$ctype == "comb"} {
			    # Possibly add a place holder
			    if {![catch {set gclists $mPNode2CList($cnode)}]} {
				set gclen [llength $gclists]

				# This will probably never happen
				if {$gclen == 0} {
				    addTreePlaceholder $cnode
				}
			    } else {
				addTreePlaceholder $cnode
			    }
			}

			$itk_component(newtree) item $cnode -image $img
		    }
		}
	    }
	}
    }
}

# ------------------------------------------------------------
#                         GENERAL
# ------------------------------------------------------------
::itcl::body ArcherCore::OpenTarget {target} {
    global tcl_platform

    set mTarget $target
    set mDbType "BRL-CAD"
    set mCopyObj ""
    set mCombWarningList ""

    if {![catch {$mTarget ls}]} {
	set mDbShared 1
	set mDbReadOnly 1
    } elseif {[file exists $mTarget]} {
	if {[file writable $mTarget] ||
	    ($::tcl_platform(platform) == "windows" && ![file attributes $mTarget -readonly])} {
	    set mDbReadOnly 0
	} else {
	    set mDbReadOnly 1
	}
    } else {
	set mDbReadOnly 0
    }

    if {$mDbNoCopy || $mDbReadOnly} {
	set mTargetOldCopy $mTargetCopy
	set mTargetCopy ""
    } else {
	createTargetCopy
    }

    # Load MGED database
    if {![info exists itk_component(ged)]} {
	return false
    }

    if {$mDbShared} {
	$itk_component(ged) sharedGed $mTarget
    } elseif {$mDbNoCopy || $mDbReadOnly} {
	$itk_component(ged) open $mTarget
    } else {
	$itk_component(ged) open $mTargetCopy
    }
    gedCmd data_axes points {}
    gedCmd data_lines points {}
    gedCmd configure -primitiveLabels {}

    set mLastSelectedDir [file dirname $target]

    return true
}

::itcl::body ArcherCore::Load {target} {
    global tcl_platform

    SetWaitCursor $this
    if {$mNeedSave} {
	askToSave
    }

    set mNeedSave 0
    updateSaveMode

    if {![OpenTarget $target]} {
	initGed

	grid forget $itk_component(canvas)
	if {!$mViewOnly} {
	    grid $itk_component(ged) -row 1 -column 0 -columnspan 3 -sticky news
	    after idle "$itk_component(cmd) configure -cmd_prefix \"[namespace tail $this] cmd\""
	} else {
	    if {!$mNoToolbar} {
		grid $itk_component(ged) -row 1 -column 0 -sticky news
	    } else {
		grid $itk_component(ged) -row 0 -column 0 -sticky news
	    }
	}
    }

    set mDbTitle [$itk_component(ged) title]
    set mDbUnits [$itk_component(ged) units -s]
    set mPrevObjViewMode $OBJ_ATTR_VIEW_MODE
    set mPrevSelectedObjPath ""
    set mPrevSelectedObj ""
    set mSelectedObjPath ""
    set mSelectedObj ""
    set mSelectedObjType ""
    set mColorObjects ""
    set mGhostObjects ""
    set mEdgeObjects ""

    if {!$mViewOnly} {
	gedCmd size [expr {$mGroundPlaneSize * 1.5 * [gedCmd base2local]}]
	buildGroundPlane
	showGroundPlane
    }

    if {!$mViewOnly} {
	doLighting
	deleteTargetOldCopy

	# rebuild tree contents
	rebuildTree
    } else {
	doLighting
    }

    if {$mBindingMode == 0} {
	initDefaultBindings $itk_component(ged)
    }

    set mSavedCenter ""
    set mSavedViewEyePt ""
    set mSavedSize ""

    SetNormalCursor $this
}

::itcl::body ArcherCore::GetUserCmds {} {
    return $mUnwrappedDbCommands
}

::itcl::body ArcherCore::WhatsOpen {} {
    return $mTarget
}

::itcl::body ArcherCore::Close {} {
    if {$itk_option(-quitcmd) != {}} {
	catch {eval $itk_option(-quitcmd)}
    } else {
	::exit
    }
}

::itcl::body ArcherCore::askToSave {} {
    if {!$mNeedSave} {
	return 0
    }

    $itk_component(saveDialog) center [namespace tail $this]
    ::update
    if {[$itk_component(saveDialog) activate]} {
	saveDb
	return 1
    }

    return 0
}

::itcl::body ArcherCore::freezeGUI {{_freeze ""}} {
    if {$_freeze == ""} {
	return $mFreezeGUI
    }

    if {![string is boolean $_freeze]} {
	error "ArcherCore::freezeGUI: \"$_freeze\" is not a boolean"
    }

    if {($_freeze && $mFreezeGUI) ||
	(!$_freeze && !$mFreezeGUI)} {
	# Nothing to do
	return
    }

    set mFreezeGUI $_freeze
    if {$mFreezeGUI} {
	$itk_component(ged) refresh_off
	SetWaitCursor $this
    } else {
	if {$mNeedsTreeRebuild} {
	    set mNeedsTreeRebuild 0
	    set mNeedsTreeSync 0
	    rebuildTree
	} elseif {$mNeedsTreeSync} {
	    set mNeedsTreeSync 0
	    syncTree
	}

	updateSaveMode

	$itk_component(ged) refresh_on
	$itk_component(ged) refresh_all
	SetNormalCursor $this
    }
}

::itcl::body ArcherCore::getTkColor {r g b} {
    return [format \#%.2x%.2x%.2x $r $g $b]
}

::itcl::body ArcherCore::getRgbColor {_color} {
    set len [llength $_color]
    if {$len == 1} {
	set rgb [winfo rgb $itk_interior $_color]
	return [list \
		    [expr {[lindex $rgb 0] / 256}] \
		    [expr {[lindex $rgb 1] / 256}] \
		    [expr {[lindex $rgb 2] / 256}]]
    }

    # This widget uses values from 0 to 255
    set r [lindex $_color 0]
    set g [lindex $_color 1]
    set b [lindex $_color 2]

    if {[string is digit -strict $r] && $r >= 0 && $r <= 255 &&
	[string is digit -strict $g] && $g >= 0 && $g <= 255 &&
	[string is digit -strict $b] && $b >= 0 && $b <= 255} {
	return $_color
    }

    return "255 255 255"
}

::itcl::body ArcherCore::setSave {} {
    if {$mDbNoCopy || $mDbReadOnly} {
	return
    }

    set mNeedSave 1
    updateSaveMode
}

::itcl::body ArcherCore::getLastSelectedDir {} {
    return $mLastSelectedDir
}

::itcl::body ArcherCore::refreshDisplay {} {
    if {$mCurrentPaneName == ""} {
	set pane $mActivePaneName
    } else {
	set pane $mCurrentPaneName
    }
    set mCurrentPaneName ""

#    $itk_component(ged) pane_refresh $pane
    $itk_component(ged) refresh_all
}

::itcl::body ArcherCore::putString {_str} {
    $itk_component(cmd) putstring $_str
}


::itcl::body ArcherCore::rtcntrl {args} {
    eval $itk_component(rtcntrl) $args
}


::itcl::body ArcherCore::setStatusString {_str} {
    set mStatusStr $_str
}

::itcl::body ArcherCore::colorMenuStatusCB {_w} {
    if {$mDoStatus} {
	# entry might not support -label (i.e. tearoffs)
	if {[catch {$_w entrycget active -label} op]} {
	    set op ""
	}

	switch -- $op {
	    "Red" {
		set mStatusStr "Set this object's color to red"
	    }
	    "Orange" {
		set mStatusStr "Set this object's color to orange"
	    }
	    "Yellow" {
		set mStatusStr "Set this object's color to yellow"
	    }
	    "Green" {
		set mStatusStr "Set this object's color to green"
	    }
	    "Blue" {
		set mStatusStr "Set this object's color to blue"
	    }
	    "Indigo" {
		set mStatusStr "Set this object's color to indigo"
	    }
	    "Violet" {
		set mStatusStr "Set this object's color to violet"
	    }
	    "Default" {
		set mStatusStr "Set this object's color to the default color"
	    }
	    "Select..." {
		set mStatusStr "Set this object's color to the selected color"
	    }
	    default {
		set mStatusStr ""
	    }
	}
    }
}

::itcl::body ArcherCore::menuStatusCB {_w} {
    if {$mDoStatus} {
	# entry might not support -label (i.e. tearoffs)
	if {[catch {$_w entrycget active -label} op]} {
	    set op ""
	}

	switch -- $op {
	    "Wireframe" {
		set mStatusStr "Draw object as wireframe"
	    }
	    "Shaded" {
		set mStatusStr "Draw object as shaded if a bot or polysolid (unevaluated)"
	    }
	    "Hidden Line" {
		set mStatusStr "Draw object as hidden line"
	    }
	    "Off" {
		set mStatusStr "Erase object"
	    }
	    default {
		set mStatusStr ""
	    }
	}
    }
}

::itcl::body ArcherCore::transparencyMenuStatusCB {_w} {
    if {$mDoStatus} {
	# entry might not support -label (i.e. tearoffs)
	if {[catch {$_w entrycget active -label} op]} {
	    set op ""
	}

	switch -- $op {
	    "None" {
		set mStatusStr "Set this object's transparency to 0%"
	    }
	    "80%" {
		set mStatusStr "Set this object's transparency to 80%"
	    }
	    "85%" {
		set mStatusStr "Set this object's transparency to 85%"
	    }
	    "90%" {
		set mStatusStr "Set this object's transparency to 90%"
	    }
	    "95%" {
		set mStatusStr "Set this object's transparency to 95%"
	    }
	    "97%" {
		set mStatusStr "Set this object's transparency to 97%"
	    }
	    "99%" {
		set mStatusStr "Set this object's transparency to 99%"
	    }
	    default {
		set mStatusStr ""
	    }
	}
    }
}

::itcl::body ArcherCore::updateSaveMode {} {
    if {$mViewOnly} {
	return
    }

    if {!$mNoToolbar} {
	if {!$mDbNoCopy && !$mDbReadOnly && $mNeedSave} {
	    $itk_component(primaryToolbar) itemconfigure save \
		-state normal
	} else {
	    $itk_component(primaryToolbar) itemconfigure save \
		-state disabled
	}
    }
}

::itcl::body ArcherCore::createTargetCopy {} {

    package require fileutil

    set tmpdir [::fileutil::tempdir]

    if {$mTarget == ""} {
	set target "$tmpdir/BBBBogusArcherTargetCopy"
    } else {
	set target_fname [file tail $mTarget]
	set target "$tmpdir/$target_fname"
    }

    set mTargetOldCopy $mTargetCopy
    set mTargetCopy "$target~"

    set id 1
    while {[file exists $mTargetCopy]} {
	set mTargetCopy "$target~$id"
	incr id
    }

    if {[file exists $mTarget]} {
	file copy $mTarget $mTargetCopy
    }
}

::itcl::body ArcherCore::deleteTargetOldCopy {} {
    if {$mTargetOldCopy != ""} {
	catch {file delete -force $mTargetOldCopy}

	# sanity
	set mTargetOldCopy ""
    }
}


::itcl::body ArcherCore::getVDrawColor {color} {
    switch -- $color {
	"Grey" {
	    return "646464"
	}
	"Black" {
	    return "000000"
	}
	"Navy" {
	    return "000032"
	}
	"Blue" {
	    return "0000ff"
	}
	"Cyan" {
	    return "00ffff"
	}
	"Green" {
	    return "00ff00"
	}
	"Magenta" {
	    return "ff00ff"
	}
	"Red" {
	    return "ff0000"
	}
	"Yellow" {
	    return "ffff00"
	}
	"White" -
	default {
	    return "ffffff"
	}
    }
}

#XXXX Needs more flexibility (i.e. position and orientation)
::itcl::body ArcherCore::buildGroundPlane {} {
    catch {gedCmd vdraw vlist delete groundPlaneMajor}
    catch {gedCmd vdraw vlist delete groundPlaneMinor}

    set majorColor [getVDrawColor $mGroundPlaneMajorColor]
    set minorColor [getVDrawColor $mGroundPlaneMinorColor]
    set move 0
    set draw 1
    set Xmax [expr {$mGroundPlaneSize * 0.5}]
    set Xmin [expr {0.0 - $Xmax}]
    set Ymax [expr {$mGroundPlaneSize * 0.5}]
    set Ymin [expr {0.0 - $Ymax}]


    # build minor lines
    gedCmd vdraw open groundPlaneMinor
    gedCmd vdraw params color $minorColor

    # build minor X lines
    for {set y -$mGroundPlaneInterval} {$Ymin <= $y} {set y [expr {$y - $mGroundPlaneInterval}]} {
	gedCmd vdraw write next $move $Xmin $y 0
	gedCmd vdraw write next $draw $Xmax $y 0
    }

    for {set y $mGroundPlaneInterval} {$y <= $Ymax} {set y [expr {$y + $mGroundPlaneInterval}]} {
	gedCmd vdraw write next $move $Xmin $y 0
	gedCmd vdraw write next $draw $Xmax $y 0
    }

    # build minor Y lines
    for {set x -$mGroundPlaneInterval} {$Xmin <= $x} {set x [expr {$x - $mGroundPlaneInterval}]} {
	gedCmd vdraw write next $move $x $Ymin 0
	gedCmd vdraw write next $draw $x $Ymax 0
    }

    for {set x $mGroundPlaneInterval} {$x <= $Xmax} {set x [expr {$x + $mGroundPlaneInterval}]} {
	gedCmd vdraw write next $move $x $Ymin 0
	gedCmd vdraw write next $draw $x $Ymax 0
    }


    # build major lines
    gedCmd vdraw open groundPlaneMajor
    gedCmd vdraw params color $majorColor
    gedCmd vdraw write 0 $move $Xmin 0 0
    gedCmd vdraw write next $draw $Xmax 0 0
    gedCmd vdraw write next $move 0 $Ymin 0
    gedCmd vdraw write next $draw 0 $Ymax 0
}

::itcl::body ArcherCore::showGroundPlane {} {
    set savePwd ""

    if {$mShowGroundPlane} {
	gedCmd vdraw open groundPlaneMajor
	gedCmd vdraw send
	gedCmd vdraw open groundPlaneMinor
	gedCmd vdraw send
    } else {
	set phonyList [gedCmd who p]
	if {[lsearch $phonyList _VDRWgroundPlaneMajor] != -1} {
	    gedCmd erase _VDRWgroundPlaneMajor _VDRWgroundPlaneMinor
	}
    }

    if {$savePwd != ""} {
	cd $savePwd
    }
}

::itcl::body ArcherCore::showPrimitiveLabels {} {
    if {!$mShowPrimitiveLabels} {
	gedCmd configure -primitiveLabels {}
    }

    handleTreeSelect
}

::itcl::body ArcherCore::showViewParams {} {
    $itk_component(ged) configure -showViewingParams $mShowViewingParams
    $itk_component(ged) configure -centerDotEnable $mShowViewingParams
    refreshDisplay
}

::itcl::body ArcherCore::showScale {} {
    $itk_component(ged) configure -scaleEnable $mShowScale
    refreshDisplay
}

::itcl::body ArcherCore::compareViewAxesSizes {a b} {
    if {$mViewAxesSizeValues($a) < $mViewAxesSizeValues($b)} {
	return -1
    }
    if {$mViewAxesSizeValues($a) > $mViewAxesSizeValues($b)} {
	return 1
    }
    return 0
}

::itcl::body ArcherCore::compareModelAxesSizes {a b} {
    if {$mModelAxesSizeValues($a) < $mModelAxesSizeValues($b)} {
	return -1
    }
    if {$mModelAxesSizeValues($a) > $mModelAxesSizeValues($b)} {
	return 1
    }
    return 0
}

::itcl::body ArcherCore::launchCheckOverlaps {size} {
    putString "running check overlaps -G $size -i -o -q"
    if {[catch {$itk_component(ged) check overlaps -G $size -i -o -q} output]} {
	tk_messageBox -message "$output"
	return
    }
    putString "$output"
}

::itcl::body ArcherCore::launchNirt {} {
    putString "nirt -b"
    putString [$itk_component(ged) nirt -b]
}

::itcl::body ArcherCore::launchRtApp {app size} {
    global tcl_platform

    if {![string is digit $size]} {
	set size [winfo width $itk_component(ged)]
    }

    set dm_list [split [dm_list] ',']
    set devtype "/dev/"
    append devtype [lindex $dm_list 0]
    $itk_component(ged) $app -s $size -F $devtype
}

::itcl::body ArcherCore::updateDisplaySettings {} {
    $itk_component(ged) refresh_off

    updateZClipPlanesFromSettings
    updatePerspective 0
    doLighting
    gedCmd dlist_on $mDisplayListMode
    gedCmd configure -hideSubtractions $mHideSubtractions

    if {$mWireframeMode} {
	gedCmd lod on
    } else {
	gedCmd lod off
    }

    $itk_component(ged) refresh_on
    $itk_component(ged) refresh_all
}

::itcl::body ArcherCore::updateLightingMode {} {
    set mLightingModeCurr $mLightingModePref

    if {$mLighting} {
	gedCmd light_all $mLightingModeCurr
    }
}

::itcl::body ArcherCore::updatePerspective {_unused} {
    $itk_component(ged) perspective_all $mPerspectivePref
}

::itcl::body ArcherCore::updateZClipPlanes {_front _front_max _back _back_max} {
    set near [expr {0.01 * $_front * $_front_max}]
    set far [expr {0.01 * $_back * $_back_max}]
    $itk_component(ged) bounds_all "-1.0 1.0 -1.0 1.0 -$near $far"
    $itk_component(ged) refresh_all
}

::itcl::body ArcherCore::updateZClipPlanesFromSettings {} {
    updateZClipPlanes $mZClipFront $mZClipFrontMax $mZClipBack $mZClipBackMax
}

# Note: This method is used by scale widgets in the Archer Preferences
# dialog, which is why it has an unused parameter.
::itcl::body ArcherCore::updateZClipPlanesFromPreferences {{_unused 0.0}} {
    updateZClipPlanes $mZClipFrontPref $mZClipFrontMaxPref $mZClipBackPref \
	$mZClipBackMaxPref
}

::itcl::body ArcherCore::calculateZClipMax {} {
    set size [$itk_component(ged) size]
    set autoview_l [$itk_component(ged) get_autoview]
    set asize [lindex $autoview_l end]

    set max [expr {($asize / $size) * 0.5}]
    set maxSq [expr {$max * $max}]

    # return the length of the diagonal
    return [expr {sqrt($maxSq + $maxSq)}]
}

::itcl::body ArcherCore::calculateZClipBackMax {} {
    set mZClipBackMaxPref [calculateZClipMax]
    updateZClipPlanesFromPreferences
}

::itcl::body ArcherCore::calculateZClipFrontMax {} {
    set mZClipFrontMaxPref [calculateZClipMax]
    updateZClipPlanesFromPreferences
}

::itcl::body ArcherCore::validateZClipMax {_d} {
    if {[::cadwidgets::Ged::validateDouble $_d]} {

	if {$_d == "" || $_d == "."} {
	    return 1
	}

	if {$_d < 0} {
	    return 0
	}

	after idle [::itcl::code $this updateZClipPlanesFromPreferences]
	return 1
    }

    return 0
}

::itcl::body ArcherCore::pushPerspectiveSettings {} {
    set mPerspectivePref $mPerspective
    updatePerspective 0
}

::itcl::body ArcherCore::shootRay_doit {_start _op _target _prep _no_bool _onehit _bot_dflag _objects} {
    $itk_component(ged) init_shoot_ray ray $_prep $_no_bool $_onehit $_bot_dflag $_objects
    return [ray shootray $_start $_op $_target]
}


##################################### ArcherCore Commands #####################################
::itcl::body ArcherCore::3ptarb {args} {
    eval gedWrapper 3ptarb 0 1 1 1 $args
}

::itcl::body ArcherCore::adjust {args} {
    set arg0 [lindex $args 0]

    if {[catch {$itk_component(ged) get_type $arg0} type]} {
	return
    }

    if {$type == "extrude" || $type == "revolve"} {
	set arg1 [lindex $args 1]

	if {$arg1 == "S" || $arg1 == "sk_name"} {
	    set tflag 2
	} else {
	    set tflag 1
	}
    } elseif {$type == "dsp" || $type == "ebm" || $type == "vol"} {
	set arg1 [lindex $args 1]

	if {$arg1 == "F" || $arg1 == "file"} {
	    set tflag 2
	} else {
	    set tflag 1
	}
    } else {
	    set tflag 1
    }

    eval gedWrapper adjust 0 1 1 $tflag $args
}

::itcl::body ArcherCore::arced {args} {
    eval gedWrapper arced 0 0 1 0 $args
}

::itcl::body ArcherCore::attr {args} {
    set arg0 [lindex $args 0]
    set ac [llength $args]
    if {$arg0 == "get" || $arg0 == "show"} {
	return [eval gedCmd attr $args]
    }

    eval gedWrapper attr 0 0 1 2 $args
}

::itcl::body ArcherCore::bb {args} {
    eval gedWrapper bb 0 0 1 2 $args
}

::itcl::body ArcherCore::bev {args} {
    eval gedWrapper bev 0 0 1 1 $args
}

::itcl::body ArcherCore::B {args} {
    eval blast $args
}

::itcl::body ArcherCore::blast {args} {
    eval gedWrapper blast 0 0 0 1 $args
}

::itcl::body ArcherCore::bo {args} {
    eval gedWrapper bo 0 0 1 1 $args
}

::itcl::body ArcherCore::bot {args} {
    eval gedWrapper bot 0 0 1 1 $args
}

::itcl::body ArcherCore::bot_condense {args} {
    eval gedWrapper bot_condense 0 0 1 1 $args
}

::itcl::body ArcherCore::bot_decimate {args} {
    eval gedWrapper bot_decimate 0 0 1 1 $args
}

::itcl::body ArcherCore::bot_face_fuse {args} {
    eval gedWrapper bot_face_fuse 0 0 1 1 $args
}

::itcl::body ArcherCore::bot_face_sort {args} {
    eval gedWrapper bot_face_sort 1 0 1 1 $args
}

::itcl::body ArcherCore::bot_flip {args} {
    eval gedWrapper bot_flip 1 0 1 0 $args
}

::itcl::body ArcherCore::bot_fuse {args} {
    eval gedWrapper bot_fuse 0 0 1 2 $args
}

::itcl::body ArcherCore::bot_merge {args} {
    eval gedWrapper bot_merge 1 0 1 1 $args
}

::itcl::body ArcherCore::bot_smooth {args} {
    eval gedWrapper bot_smooth 0 0 1 1 $args
}

::itcl::body ArcherCore::bot_split {args} {
    eval gedWrapper bot_split 0 0 1 2 $args
}

::itcl::body ArcherCore::bot_sync {args} {
    eval gedWrapper bot_sync 1 0 1 0 $args
}

::itcl::body ArcherCore::bot_vertex_fuse {args} {
    eval gedWrapper bot_vertex_fuse 0 0 1 1 $args
}

::itcl::body ArcherCore::brep {args} {
    eval gedWrapper brep 0 1 1 2 $args
}

::itcl::body ArcherCore::brlman {args} {
    # simple (intentionally undocumented) pass-through alias
    man $args
}

::itcl::body ArcherCore::c {args} {
    eval gedWrapper c 0 1 1 2 $args

    set ilist [lsearch -all -regexp $args {^-[cr]$}]
    if {$ilist == ""} {
	return
    }
    set i [lindex $list end]
    incr i

    set oname [lindex $args $i]
    selectTreePath $oname
}

::itcl::body ArcherCore::cd {args} {
    eval ::cd $args
}

::itcl::body ArcherCore::clear {args} {
    $itk_component(cmd) clear
}

::itcl::body ArcherCore::clone {args} {
    eval gedWrapper clone 0 0 1 2 $args
}

::itcl::body ArcherCore::closedb {args} {
    Load ""

    if {[llength $args] != 0} {
	return "Usage: closedb\nWarning - ignored unsupported argument(s) \"$args\""
    }
}

::itcl::body ArcherCore::color {args} {
    eval gedWrapper color 0 0 1 0 $args
}

::itcl::body ArcherCore::comb {args} {
    eval gedWrapper comb 0 1 1 2 $args

    set oname [lindex $args 0]
    selectTreePath $oname
}

::itcl::body ArcherCore::comb_color {args} {
    eval gedWrapper comb_color 0 1 1 1 $args
}

::itcl::body ArcherCore::combmem {args} {
    eval gedWrapper combmem 0 1 1 1 $args
}

::itcl::body ArcherCore::copy {args} {
    eval gedWrapper cp 0 0 1 2 $args
}

::itcl::body ArcherCore::copyeval {args} {
    eval gedWrapper copyeval 0 0 1 2 $args
}

::itcl::body ArcherCore::copymat {args} {
    eval gedWrapper copymat 0 0 1 0 $args
}

::itcl::body ArcherCore::cp {args} {
    eval gedWrapper cp 0 0 1 2 $args

    set oname [lindex $args 1]
    if {$oname == ""} {
	return ""
    }

    draw $oname
    selectTreePath $oname
}

::itcl::body ArcherCore::cpi {args} {
    eval gedWrapper cpi 0 0 1 2 $args
}

::itcl::body ArcherCore::dbconcat {args} {
    eval gedWrapper dbconcat 0 0 1 2 $args
}

::itcl::body ArcherCore::dbExpand {args} {
    # parse out preceding options
    set searchType "-glob"
    set options {}
    set objects {}
    set possibleOption 1
    foreach arg $args {
	if {$possibleOption && [regexp -- {^-[a-zA-Z]} $arg]} {
	    if {$arg == "-regexp"} {
		set searchType "-regexp"
	    } else {
		lappend options $arg
	    }
	} else {
	    set possibleOption 0
	    lappend objects $arg
	}
    }

    set tobjects {}
    set lsItems [$itk_component(ged) ls -a]
    foreach obj $objects {
	set pdata [split $obj /]
	set len [llength $pdata]

	if {$len == 1} {
	    set child $obj

	    if {$searchType == "-regexp"} {
		set child "^$child\$"
	    }

	    # find indices of matching children
	    set mi [lsearch -all $searchType $lsItems $child]

	    if {[llength $mi] == 0} {
		lappend tobjects $obj
	    } else {
		foreach i $mi {
		    lappend tobjects [lindex $lsItems $i]
		}
	    }
	} else {
	    set path [file dirname $obj]
	    incr len -1
	    set child [lindex $pdata $len]
	    incr len -1
	    set parent [lindex $pdata $len]
	    set children [getNodeChildren $parent]

	    if {$searchType == "-regexp"} {
		set child "^$child\$"
	    }

	    # find indices of matching children
	    set mi [lsearch -all $searchType $children $child]

	    if {[llength $mi] == 0} {
		lappend tobjects $obj
	    } else {
		foreach i $mi {
		    lappend tobjects "/$path/[lindex $children $i]"
		}
	    }
	}
    }

    if {$tobjects != {}} {
	return [list $options $tobjects]
    }

    return [list $options $objects]
}

::itcl::body ArcherCore::decompose {args} {
    eval gedWrapper decompose 0 1 1 0 $args
}

::itcl::body ArcherCore::delete {args} {
    eval kill $args
}

::itcl::body ArcherCore::e {args} {
    eval draw $args
}

::itcl::body ArcherCore::draw {args} {
    if {[llength $args] == 0} {
	return
    }

    set i [lsearch $args "-noWaitCursor"]
    if {$i == -1} {
	set wflag 1
    } else {
	set wflag 0
	set args [lreplace $args $i $i]
    }

    if {$wflag && !$mFreezeGUI} {
	SetWaitCursor $this
    }

    set optionsAndArgs [eval dbExpand $args]
    set options [lindex $optionsAndArgs 0]
    set objects [lindex $optionsAndArgs 1]
    set tobjects ""

    # remove leading /'s to make the hierarchy widget happy
    foreach obj $objects {
	lappend tobjects [regsub {^/} $obj ""]
    }

    set soi [lsearch $tobjects $mSelectedObjPath]

    if {[catch {eval gedCmd draw $options $tobjects} ret]} {
	if {$soi != -1} {
	    gedCmd configure -primitiveLabels $mSelectedObjPath
	}

	if {!$mFreezeGUI} {
	    updateTreeDrawLists

	    if {$wflag} {
		SetNormalCursor $this
	    }
	}

	return $ret
    }

    if {$soi != -1} {
	gedCmd configure -primitiveLabels $mSelectedObjPath
    }

    if {!$mFreezeGUI} {
	updateTreeDrawLists

	if {$wflag} {
	    SetNormalCursor $this
	}
    }

    return $ret
}

::itcl::body ArcherCore::dsp {args} {
    eval gedWrapper dsp 0 0 1 1 $args
}

::itcl::body ArcherCore::E {args} {
    eval gedWrapper E 1 0 0 1 $args
}

::itcl::body ArcherCore::edarb {args} {
    if {[catch {eval gedWrapper edarb 0 1 1 0 $args} ret]} {
	return $ret
    }
    set len [llength $args]

    if {$len > 2} {
	redrawObj [lindex $args 1] 0
    }

    return $ret
}

::itcl::body ArcherCore::edcodes {args} {
    eval gedWrapper edcodes 0 0 1 0 $args
}

::itcl::body ArcherCore::edcolor {args} {
    eval gedWrapper edcolor 0 0 1 0 $args
}

::itcl::body ArcherCore::edcomb {args} {
    eval gedWrapper edcomb 0 0 1 2 $args
}

::itcl::body ArcherCore::edit {args} {
    eval gedWrapper edit 0 0 1 0 $args

    #FIXME: not right at all; we need to redraw all edited objects
    #set len [llength $args]
    #if {$len > 2} {
	#redrawObj [lindex $args end] 0
    #}
}

::itcl::body ArcherCore::edmater {args} {
    eval gedWrapper edmater 0 0 1 0 $args
}

::itcl::body ArcherCore::env {args} {
    eval gedWrapper env 1 0 0 0 $args
}

::itcl::body ArcherCore::d {args} {
    eval erase $args
}

::itcl::body ArcherCore::erase {args} {
    if {[llength $args] == 0} {
	return
    }

    SetWaitCursor $this

    set optionsAndArgs [eval dbExpand $args]
    set options [lindex $optionsAndArgs 0]
    set objects [lindex $optionsAndArgs 1]

    # remove leading /'s to make the hierarchy widget happy
    set tobjects {}
    foreach obj $objects {
	lappend tobjects [regsub {^/} $obj ""]
    }

    set soi [lsearch $tobjects $mSelectedObjPath]
    set tmpObjPath [file dirname $mSelectedObjPath]
    while {$soi == -1 && $tmpObjPath != "."} {
	set soi [lsearch $tobjects $tmpObjPath]
	set tmpObjPath [file dirname $tmpObjPath]
    }

    if {[catch {eval gedCmd erase $options $tobjects} ret]} {
	if {$soi != -1} {
	    gedCmd configure -primitiveLabels {}
	}

	updateTreeDrawLists
	SetNormalCursor $this

	return $ret
    }

    if {$soi != -1} {
	gedCmd configure -primitiveLabels {}

	gedCmd data_axes points {}
	gedCmd data_lines points {}
    }

    updateTreeDrawLists
    SetNormalCursor $this
}

::itcl::body ArcherCore::ev {args} {
    eval gedWrapper ev 1 0 0 1 $args
}

::itcl::body ArcherCore::exists {args} {
    eval gedWrapper exists 0 1 0 0 $args
}

::itcl::body ArcherCore::exit {args} {
    Close
}

::itcl::body ArcherCore::facetize {args} {
    eval gedWrapper facetize 0 0 1 2 $args
}

::itcl::body ArcherCore::fracture {args} {
    eval gedWrapper fracture 0 1 1 2 $args
}

::itcl::body ArcherCore::g {args} {
    eval group $args
}

::itcl::body ArcherCore::get {args} {
    eval gedWrapper get 0 1 0 0 $args
}

::itcl::body ArcherCore::graph {args} {
    eval gedWrapper graph 0 1 1 1 $args
}

::itcl::body ArcherCore::group {args} {
    eval gedWrapper g 1 1 1 2 $args

    set oname [lindex $args 0]
    selectTreePath $oname
}

::itcl::body ArcherCore::hide {args} {
    eval gedWrapper hide 0 0 1 2 $args
}

::itcl::body ArcherCore::human {args} {
    eval gedWrapper human 0 0 1 2 $args
}


::itcl::body ArcherCore::i {args} {
    eval gedWrapper i 0 1 1 1 $args
}

::itcl::body ArcherCore::igraph {args} {
    eval ::igraph $args
}

::itcl::body ArcherCore::importFg4Section {args} {
    eval gedWrapper importFg4Section 0 0 1 1 $args
}

::itcl::body ArcherCore::in {args} {
    eval gedWrapper in 0 0 1 2 $args
}

::itcl::body ArcherCore::inside {args} {
    eval gedWrapper inside 0 0 1 2 $args
}

::itcl::body ArcherCore::item {args} {
    eval gedWrapper item 0 0 1 0 $args
}

::itcl::body ArcherCore::updatePrimitiveLabels {args} {
    if {![info exists itk_component(ged)]} {
	return
    }

    set plist [$itk_component(ged) cget -primitiveLabels]
    if {[llength $plist] > 0} {
	set tail_plist {}
	foreach item $plist {
	    lappend tail_plist [file tail $item]
	}

	foreach item [eval gedCmd kill -n $args] {
	    set item [string trim $item]
	    set i [lsearch $tail_plist $item]
	    if {$i != -1} {
		set plist [lreplace $plist $i $i]
		set tail_plist [lreplace $tail_plist $i $i]
	    }
	}

	$itk_component(ged) configure -primitiveLabels $plist
    }
}

::itcl::body ArcherCore::kill {args} {
    eval updatePrimitiveLabels $args
    eval gedWrapper kill 1 0 1 2 $args
}

::itcl::body ArcherCore::killall {args} {
    eval updatePrimitiveLabels $args
    eval gedWrapper killall 1 0 1 2 $args
}

::itcl::body ArcherCore::killrefs {args} {
    eval gedWrapper killrefs 1 0 1 2 $args
}

::itcl::body ArcherCore::killtree {args} {
    eval gedWrapper killtree 1 0 1 2 $args
}

::itcl::body ArcherCore::l {args} {
    eval gedWrapper l 1 0 0 0 $args
}
::itcl::body ArcherCore::lc {args} {
    eval gedWrapper lc 1 0 0 0 $args
}
::itcl::body ArcherCore::ls {args} {
    eval gedWrapper ls 1 0 0 0 $args
}

::itcl::body ArcherCore::make {args} {
    if {$args == "" || $args == "-t"} {
	return [eval $itk_component(ged) make $args]
    }

    eval gedWrapper make 0 0 1 2 $args

    set oname [lindex $args 0]
    selectTreePath $oname
}

::itcl::body ArcherCore::make_name {args} {
    eval gedWrapper make_name 0 1 0 0 $args
}

::itcl::body ArcherCore::make_pnts {args} {
    eval gedWrapper make_pnts 0 1 1 1 $args
}

::itcl::body ArcherCore::man {args} {
    set archerMan $itk_interior.archerMan

    set len [llength $args]
    if {$len != 0 && $len != 1} {
	return "Usage: man cmdName"
    }

    if {$args != {}} {
	set page $args
	if {![$archerMan select $page]} {
	    error "couldn't find manual page \"$page\""
	}
    }
    $archerMan center [namespace tail $this]
    ::update idletasks
    $archerMan activate
}

::itcl::body ArcherCore::mater {args} {
    eval gedWrapper mater 0 1 1 1 $args
}

::itcl::body ArcherCore::mirror {args} {
    eval gedWrapper mirror 0 0 1 2 $args
}

::itcl::body ArcherCore::move {args} {
    eval gedWrapper mv 0 0 1 1 $args
}

::itcl::body ArcherCore::move_arb_edge {args} {
    eval gedWrapper move_arb_edge 0 0 1 0 $args
}

::itcl::body ArcherCore::move_arb_face {args} {
    eval gedWrapper move_arb_face 0 0 1 0 $args
}

::itcl::body ArcherCore::mv {args} {
    eval gedWrapper mv 0 0 1 2 $args
}

::itcl::body ArcherCore::mvall {args} {
    eval gedWrapper mvall 0 0 1 2 $args
}

::itcl::body ArcherCore::nmg_collapse {args} {
    eval gedWrapper nmg_collapse 0 0 1 2 $args
}

::itcl::body ArcherCore::nmg_simplify {args} {
    eval gedWrapper nmg_simplify 0 0 1 2 $args
}

::itcl::body ArcherCore::ocenter {args} {
    if {[llength $args] == 4} {
	set obj [lindex $args 0]

	eval gedWrapper ocenter 0 0 1 0 $args
	redrawObj $obj 0
    } else {
	eval gedCmd ocenter $args
    }
}

::itcl::body ArcherCore::opendb {args} {
    set ret ""

    switch [llength $args] {
	0 {set ret $mTarget}
	1 {Load [lindex $args 0]}
	default {set ret "Usage: opendb \[database.g\]"}
    }

    return $ret
}

::itcl::body ArcherCore::orotate {args} {
    set result [eval gedWrapper orotate 0 0 1 0 $args]

    set len [llength $args]
    if {$len == 4 || $len == 7} {
	redrawObj [lindex $args 0] 0
    }

    return $result
}

::itcl::body ArcherCore::oscale {args} {
    set result [eval gedWrapper oscale 0 0 1 0 $args]

    if {[llength $args] == 2} {
	redrawObj [lindex $args 0] 0
    }

    return $result
}

::itcl::body ArcherCore::otranslate {args} {
    set result [eval gedWrapper otranslate 0 0 1 0 $args]

    if {[llength $args] == 4} {
	redrawObj [lindex $args 0] 0
    }

    return $result
}

::itcl::body ArcherCore::p {args} {
    # Nothing for now
}

::itcl::body ArcherCore::packTree {data} {
    if {$data == ""} {
	return ""
    }

    set lines [split $data "\n"]
    set nlines [llength $lines]

    if {$nlines == 1} {
	set line [lindex $lines 0]

	set len [llength $line]

	if {$len == 2} {
	    return "l [lindex $line 1]"
	} elseif {$len == 3} {
	    return "l [lindex $line 1] [list [lindex $line 2]]"
	}

	error "packTree: malformed data - $data"
    }

    set tree ""

    set line [lindex $lines 0]
    set len [llength $line]
    if {$len == 2} {
	set tree "l [lindex $line 1]"
    } elseif {$len == 18} {
	set tree "l [lindex $line 1] [list [lrange $line 2 end]]"
    } else {
	#	error "packTree: malformed line - $line"
    }

    for {set n 1} {$n < $nlines} {incr n} {
	set line [string trim [lindex $lines $n]]

	# Ignore blank lines
	if {$line == ""} {
	    continue
	}

	set len [llength $line]
	if {$len == 2} {
	    set tree "[lindex $line 0] [list $tree] [list [list l [lindex $line 1]]]"
	} elseif {$len == 18} {
	    set tree "[lindex $line 0] [list $tree] [list [list l [lindex $line 1] [lrange $line 2 end]]]"
	} else {
	    #	    error "packTree: malformed line - $line"
	    continue
	}
    }

    return $tree
}

::itcl::body ArcherCore::prefix {args} {
    eval gedWrapper prefix 0 0 1 1 $args
}

::itcl::body ArcherCore::protate {args} {
    eval gedWrapper protate 0 0 1 0 $args
}

::itcl::body ArcherCore::pscale {args} {
    eval gedWrapper pscale 0 0 1 0 $args
}

::itcl::body ArcherCore::ptranslate {args} {
    eval gedWrapper ptranslate 0 0 1 0 $args
}

::itcl::body ArcherCore::pull {args} {
    eval gedWrapper pull 0 1 1 0 $args
}

::itcl::body ArcherCore::push {args} {
    eval gedWrapper push 0 1 1 0 $args
}

::itcl::body ArcherCore::put {args} {
    eval gedWrapper put 0 0 1 2 $args
}

::itcl::body ArcherCore::put_comb {args} {
    eval gedWrapper put_comb 0 0 1 1 $args
}

::itcl::body ArcherCore::putmat {args} {
    eval gedWrapper putmat 0 0 1 0 $args
}

::itcl::body ArcherCore::pwd {} {
    ::pwd
}

::itcl::body ArcherCore::q {args} {
    Close
}

::itcl::body ArcherCore::quit {args} {
    Close
}

::itcl::body ArcherCore::r {args} {
    eval gedWrapper r 0 1 1 2 $args

    set oname [lindex $args 0]
    selectTreePath $oname
}

::itcl::body ArcherCore::rcodes {args} {
    eval gedWrapper rcodes 0 0 1 0 $args
}

::itcl::body ArcherCore::red {args} {
    eval gedWrapper red 0 0 1 2 $args
}

::itcl::body ArcherCore::rfarb {args} {
    eval gedWrapper rfarb 0 0 1 1 $args
}

::itcl::body ArcherCore::rm {args} {
    eval gedWrapper rm 0 0 1 2 $args
}

::itcl::body ArcherCore::rmater {args} {
    eval gedWrapper rmater 0 0 1 1 $args
}

::itcl::body ArcherCore::rotate {args} {
    set args [linsert $args 0 "rotate"]
    eval gedWrapper edit 0 0 1 0 $args
}

::itcl::body ArcherCore::rotate_arb_face {args} {
    eval gedWrapper rotate_arb_face 0 0 1 0 $args
}

::itcl::body ArcherCore::saveview {args} {
    # If no input database is specified and the open database is a
    # working copy, specify the name of the original database so that
    # the saveview script remains valid after the working copy is
    # deleted on program exit.
    set i [lsearch $args "-i"]
    if {$i == -1 && $mTargetCopy != "" && !$mDbNoCopy} {
	set args [linsert $args 0 "$mTarget"]
	set args [linsert $args 0 "-i"]
    }
    eval gedWrapper saveview 0 0 0 0 $args
}

::itcl::body ArcherCore::scale {args} {
    set args [linsert $args 0 "scale"]
    eval gedWrapper edit 0 0 1 0 $args
}

::itcl::body ArcherCore::search {args} {
    if {$args == {}} {
	return [gedCmd search]
    } else {
	return [eval gedCmd search $args]
    }
}

::itcl::body ArcherCore::sed {_prim} {
    if {$_prim == ""} {
	return "Usage: sed prim"
    }

    set paths [gedCmd search / -name $_prim]
#    $itk_component(tree) selectpaths $paths

#    $itk_component(tree) selectitem $_prim
}

::itcl::body ArcherCore::shader {args} {
    eval gedWrapper shader 0 0 1 0 $args
}

::itcl::body ArcherCore::shells {args} {
    eval gedWrapper shells 0 0 1 1 $args
}

::itcl::body ArcherCore::tire {args} {
    eval gedWrapper tire 0 0 1 2 $args
}

::itcl::body ArcherCore::title {args} {
    if {$args == {}} {
	return [gedCmd title]
    }

    eval gedWrapper title 0 0 1 0 $args
}

::itcl::body ArcherCore::track {args} {
    eval gedWrapper track 0 0 1 1 $args
}

::itcl::body ArcherCore::translate {args} {
    set args [linsert $args 0 "translate"]
    eval gedWrapper edit 0 0 1 0 $args
}

::itcl::body ArcherCore::unhide {args} {
    eval gedWrapper unhide 0 0 1 2 $args
}

::itcl::body ArcherCore::units {args} {
    if {$args == {}} {
	return [gedCmd units]
    }

    set arg0 [lindex $args 0]
    if {[llength $args] == 1 && ($arg0 == "-s" || $arg0 == "-t")} {
	return [gedCmd units $arg0]
    }

    eval gedWrapper units 0 0 1 0 $args
}

::itcl::body ArcherCore::unpackTree {tree} {
    return " u [unpackTreeGuts $tree]"
}

::itcl::body ArcherCore::unpackTreeGuts {tree} {
    if {$tree == ""} {
	return ""
    }

    if {[llength $tree] == 2} {
	return [lindex $tree 1]
    }

    if {[llength $tree] != 3} {
	error "unpackTree: tree is malformed - $tree!"
    }

    set op [lindex $tree 0]

    if {$op == "l"} {
	return "[lindex $tree 1]\t[lindex $tree 2]"
    } else {
	if {$op == "n"} {
	    set op "+"
	}

	set partA [unpackTreeGuts [lindex $tree 1]]
	set partB [unpackTreeGuts [lindex $tree 2]]

	return "$partA
 $op $partB"
    }
}

::itcl::body ArcherCore::vmake {args} {
    eval gedWrapper vmake 0 0 1 2 $args
}

::itcl::body ArcherCore::wmater {args} {
    eval gedWrapper wmater 0 0 0 0 $args
}

::itcl::body ArcherCore::xpush {args} {
    eval gedWrapper xpush 0 0 1 2 $args
}

::itcl::body ArcherCore::Z {args} {
    eval zap $args
}

::itcl::body ArcherCore::zap {args} {
    eval gedWrapper clear 0 0 0 1 $args
    gedCmd configure -primitiveLabels {}
}


################################### Dialogs Section ###################################

::itcl::body ArcherCore::buildSelectGroupDialog {} {
    itk_component add selGroupDialog {
	::iwidgets::dialog $itk_interior.selGroupDialog \
	    -modality application \
	    -title "Selection Group"
    } {}
    $itk_component(selGroupDialog) hide 1
    $itk_component(selGroupDialog) hide 2
    $itk_component(selGroupDialog) hide 3
    $itk_component(selGroupDialog) configure \
	-thickness 2 \
	-buttonboxpady 0
    $itk_component(selGroupDialog) buttonconfigure 0 \
	-defaultring yes \
	-defaultringpad 3 \
	-borderwidth 1 \
	-pady 0

    # ITCL can be nasty
    set win [$itk_component(selGroupDialog) component bbox component OK component hull]
    after idle "$win configure -relief flat"

    set parent [$itk_component(selGroupDialog) childsite]
    itk_component add selGroupDialogL {
	::ttk::label $parent.groupL \
	    -text "Group Name:"
    } {}

    itk_component add selGroupDialogE {
	::ttk::entry $parent.groupE \
	    -width 12 \
	    -textvariable [::itcl::scope mCompSelectGroup]
    } {}

    set col 0
    set row 0
    grid $itk_component(selGroupDialogL) -row $row -column $col
    incr col
    grid $itk_component(selGroupDialogE) -row $row -column $col -sticky ew
    grid columnconfigure $parent $col -weight 1

    wm geometry $itk_component(selGroupDialog) "275x70"
    $itk_component(selGroupDialog) center
}

::itcl::body ArcherCore::buildInfoDialog {name title info size wrapOption modality} {
    itk_component add $name {
	::iwidgets::dialog $itk_interior.$name \
	    -modality $modality \
	    -title $title \
	    -background $SystemButtonFace
    } {}
    $itk_component($name) hide 1
    $itk_component($name) hide 2
    $itk_component($name) hide 3
    $itk_component($name) configure \
	-thickness 2 \
	-buttonboxpady 0
    $itk_component($name) buttonconfigure 0 \
	-defaultring yes \
	-defaultringpad 3 \
	-borderwidth 1 \
	-pady 0

    # ITCL can be nasty
    set win [$itk_component($name) component bbox component OK component hull]
    after idle "$win configure -relief flat"

    set parent [$itk_component($name) childsite]

    itk_component add $name\Info {
	::iwidgets::scrolledtext $parent.info \
	    -wrap $wrapOption \
	    -hscrollmode dynamic \
	    -vscrollmode dynamic \
	    -textfont $mFontText \
	    -background $SystemButtonFace \
	    -textbackground $SystemButtonFace
    } {}
    $itk_component($name\Info) insert 0.0 $info
    wm geometry $itk_component($name) $size
    #    wm overrideredirect $itk_component($name) 1

    after idle "$itk_component($name\Info) configure -state disabled"
    after idle "$itk_component($name) center"

    pack $itk_component($name\Info) -expand yes -fill both
}

::itcl::body ArcherCore::buildSaveDialog {} {
    buildInfoDialog saveDialog \
	"Save Database?" \
	"Do you wish to save the current database?" \
	450x85 none application

    $itk_component(saveDialog) show 2
    $itk_component(saveDialog) buttonconfigure 0 \
	-defaultring yes \
	-defaultringpad 3 \
	-borderwidth 1 \
	-pady 0 \
	-text Yes
    $itk_component(saveDialog) buttonconfigure 2 \
	-borderwidth 1 \
	-pady 0 \
	-text No
    $itk_component(saveDialogInfo) configure \
	-vscrollmode none \
	-hscrollmode none
}


::itcl::body ArcherCore::buildSelectTransparencyDialog {} {
    itk_component add selTranspDialog {
	::iwidgets::dialog $itk_interior.selTranspDialog \
	    -modality application \
	    -title "Select Transparency"
    } {}
    $itk_component(selTranspDialog) hide 1
    $itk_component(selTranspDialog) hide 2
    $itk_component(selTranspDialog) hide 3
    $itk_component(selTranspDialog) configure \
	-thickness 2 \
	-buttonboxpady 0
    $itk_component(selTranspDialog) buttonconfigure 0 \
	-defaultring yes \
	-defaultringpad 3 \
	-borderwidth 1 \
	-pady 0

    # ITCL can be nasty
    set win [$itk_component(selTranspDialog) component bbox component OK component hull]
    after idle "$win configure -relief flat"

    set parent [$itk_component(selTranspDialog) childsite]
    itk_component add selTranspDialogSc {
	::scale $parent.scale \
	    -length 200 \
	    -orient horizontal \
	    -from 0.0 \
	    -to 0.99 \
	    -resolution 0.01 \
	    -showvalue 1 \
	    -variable [::itcl::scope mTransparency]
    } {}

    pack $itk_component(selTranspDialogSc) -expand yes -fill both
}


::itcl::body ArcherCore::buildViewCenterDialog {} {
    itk_component add centerDialog {
	::iwidgets::dialog $itk_interior.centerDialog \
	    -modality application \
	    -title "View Center"
    } {}
    $itk_component(centerDialog) hide 1
    $itk_component(centerDialog) hide 3
    $itk_component(centerDialog) configure \
	-thickness 2 \
	-buttonboxpady 0
    $itk_component(centerDialog) buttonconfigure 0 \
	-defaultring yes \
	-defaultringpad 3 \
	-borderwidth 1 \
	-pady 0
    $itk_component(centerDialog) buttonconfigure 2 \
	-borderwidth 1 \
	-pady 0

    # ITCL can be nasty
    set win [$itk_component(centerDialog) component bbox component OK component hull]
    after idle "$win configure -relief flat"

    set parent [$itk_component(centerDialog) childsite]
    itk_component add centerDialogXL {
	::ttk::label $parent.xl \
	    -text "X:"
    } {}

    itk_component add centerDialogXE {
	::ttk::entry $parent.xe \
	    -width 12 \
	    -textvariable [::itcl::scope mCenterX] \
	    -validate key \
	    -validatecommand {::cadwidgets::Ged::validateDouble %P}
    } {}
    itk_component add centerDialogXUL {
	::ttk::label $parent.xul \
	    -textvariable [::itcl::scope mDbUnits]
    } {}
    itk_component add centerDialogYL {
	::ttk::label $parent.yl \
	    -text "Y:"
    } {}
    itk_component add centerDialogYE {
	::ttk::entry $parent.ye \
	    -width 12 \
	    -textvariable [::itcl::scope mCenterY] \
	    -validate key \
	    -validatecommand {::cadwidgets::Ged::validateDouble %P}
    } {}
    itk_component add centerDialogYUL {
	::ttk::label $parent.yul \
	    -textvariable [::itcl::scope mDbUnits]
    } {}
    itk_component add centerDialogZL {
	::ttk::label $parent.zl \
	    -text "Z:"
    } {}
    itk_component add centerDialogZE {
	::ttk::entry $parent.ze \
	    -width 12 \
	    -textvariable [::itcl::scope mCenterZ] \
	    -validate key \
	    -validatecommand {::cadwidgets::Ged::validateDouble %P}
    } {}
    itk_component add centerDialogZUL {
	::ttk::label $parent.zul \
	    -textvariable [::itcl::scope mDbUnits]
    } {}

    $itk_component(centerDialog) configure -background $LABEL_BACKGROUND_COLOR

    set col 0
    set row 0
    grid $itk_component(centerDialogXL) -row $row -column $col
    incr col
    grid $itk_component(centerDialogXE) -row $row -column $col -sticky ew
    grid columnconfigure $parent $col -weight 1
    incr col
    grid $itk_component(centerDialogXUL) -row $row -column $col

    set col 0
    incr row
    grid $itk_component(centerDialogYL) -row $row -column $col
    incr col
    grid $itk_component(centerDialogYE) -row $row -column $col -sticky ew
    grid columnconfigure $parent $col -weight 1
    incr col
    grid $itk_component(centerDialogYUL) -row $row -column $col

    set col 0
    incr row
    grid $itk_component(centerDialogZL) -row $row -column $col
    incr col
    grid $itk_component(centerDialogZE) -row $row -column $col -sticky ew
    grid columnconfigure $parent $col -weight 1
    incr col
    grid $itk_component(centerDialogZUL) -row $row -column $col

    wm geometry $itk_component(centerDialog) "275x125"
}

::itcl::body ArcherCore::centerDialogOverPane {_dialog} {
    if {$mCurrentPaneName == ""} {
	set pane $mActivePaneName
    } else {
	set pane $mCurrentPaneName
    }

    set mCurrentPaneName ""
    $_dialog center [$itk_component(ged) pane_win_name $pane]

    return $pane
}


################################### Helper Section ###################################

::itcl::body ArcherCore::buildComboBox {parent name1 name2 varName text listOfChoices} {
    itk_component add $name1\L {
	::ttk::label $parent.$name2\L \
	    -text $text
    } {}

    itk_component add $name1\F {
	::ttk::frame $parent.$name2\F \
	    -relief sunken
    } {}

    itk_component add $name1\CB {
	::ttk::combobox $itk_component($name1\F).$name2\CB \
	    -state readonly \
	    -textvariable [::itcl::scope $varName] \
	    -values $listOfChoices
    } {}

    pack $itk_component($name1\CB) -expand yes -fill both
}

::itcl::body ArcherCore::watchVar {_name1 _name2 _op} {
    global env

    if {![info exists itk_component(ged)]} {
	return
    }

    switch -- $_name1 {
	mDisplayFontSize {
	    $itk_component(ged) fontsize $mDisplayFontSize
	}
	mMeasuringStickColor {
	    $itk_component(ged) configure -measuringStickColor $mMeasuringStickColor
	}
	mMeasuringStickMode {
	    $itk_component(ged) configure -measuringStickMode $mMeasuringStickMode
	}
	mModelAxesColor {
	    if {$mModelAxesColor == "Triple"} {
		$itk_component(ged) configure -modelAxesTripleColor 1
	    } else {
		$itk_component(ged) configure -modelAxesTripleColor 0
		$itk_component(ged) configure -modelAxesColor $mModelAxesColor
	    }
	}
	mModelAxesLabelColor {
	    $itk_component(ged) configure -modelAxesLabelColor $mModelAxesLabelColor
	}
	mModelAxesTickColor {
	    $itk_component(ged) configure -modelAxesTickColor $mModelAxesTickColor
	}
	mModelAxesTickMajorColor {
	    $itk_component(ged) configure -modelAxesTickMajorColor $mModelAxesTickMajorColor
	}
	mPrimitiveLabelColor {
	    $itk_component(ged) configure -primitiveLabelColor $mPrimitiveLabelColor
	}
	mScaleColor {
	    $itk_component(ged) configure -scaleColor $mScaleColor
	}
	mViewAxesColor {
	    if {$mViewAxesColor == "Triple"} {
		$itk_component(ged) configure -viewAxesTripleColor 1
	    } else {
		$itk_component(ged) configure -viewAxesTripleColor 0
		$itk_component(ged) configure -viewAxesColor $mViewAxesColor
	    }
	}
	mViewAxesLabelColor {
	    $itk_component(ged) configure -viewAxesLabelColor $mViewAxesLabelColor
	}
	mViewingParamsColor {
	    $itk_component(ged) configure -viewingParamsColor $mViewingParamsColor
	}
	mRayColorOdd {
	    $itk_component(ged) configure -rayColorOdd $mRayColorOdd
	}
	mRayColorEven {
	    $itk_component(ged) configure -rayColorEven $mRayColorEven
	}
	mRayColorVoid {
	    $itk_component(ged) configure -rayColorVoid $mRayColorVoid
	}
    }
}


::itcl::body ArcherCore::accordianCallback {_item _state} {
    if {$mAccordianCallbackActive} {
	return
    }

    set mAccordianCallbackActive 1

    grid forget $itk_component(newtree) $itk_component(newtreevscroll) $itk_component(newtreehscroll)

    set saveTreeMode $mTreeMode
    if {$_item == "Tree" || $_item == "List"} {
	set mTreeMode $TREE_MODE_TREE
    } else {
	set base [regsub { (\(Tree\))| (\(List\))} $_item ""]
	set mTreeMode [lsearch $TREE_MODE_NAMES $base]
    }

    set drawem 0
    set draw_objects ""
    set how 0

    if {!$_state && !$mToolViewChange} {    # The same accordian button was pressed and there's NO tool view change
	if {[regexp Tree $_item all]} {
	    set mEnableListView 1
	    set item [regsub Tree $_item List]
	} else {
	    set mEnableListView 0
	    set item [regsub List $_item Tree]
	}

	if {$mEnableListView} {
	    switch -- $mTreeMode \
		$TREE_MODE_TREE - \
		$TREE_MODE_COLOR_OBJECTS {
		    set mEnableColorListView 1
		} \
		$TREE_MODE_GHOST_OBJECTS {
		    set mEnableGhostListView 1
		} \
		$TREE_MODE_EDGE_OBJECTS {
		    set mEnableEdgeListView 1
		}
	} else {
	    switch -- $mTreeMode \
		$TREE_MODE_TREE - \
		$TREE_MODE_COLOR_OBJECTS {
		    set mEnableColorListView 0
		} \
		$TREE_MODE_GHOST_OBJECTS {
		    set mEnableGhostListView 0
		} \
		$TREE_MODE_EDGE_OBJECTS {
		    set mEnableEdgeListView 0
		}
	}

	$itk_component(treeAccordian) rename $_item $item

    } else {    # A different accordian button was pressed OR there's a tool view change
	if {[catch {gedCmd who} whoList]} {
	    set whoList ""
	}

	if {[regexp Tree $_item all]} {
	    set mEnableListView 0
	} else {
	    set mEnableListView 1
	}

	switch -- $saveTreeMode \
	    $TREE_MODE_TREE - \
	    $TREE_MODE_COLOR_OBJECTS {
		if {$mTreeMode != $TREE_MODE_TREE && $mTreeMode != $TREE_MODE_COLOR_OBJECTS} {
		    set drawem 1
		}
	    } \
	    $TREE_MODE_GHOST_OBJECTS {
		if {$mTreeMode != $TREE_MODE_GHOST_OBJECTS} {
		    set drawem 1
		}
	    } \
	    $TREE_MODE_EDGE_OBJECTS {
		if {$mTreeMode != $TREE_MODE_EDGE_OBJECTS} {
		    set drawem 1
		}
	    }

	if {$drawem || $mToolViewChange} {
	    switch -- $mTreeMode \
		$TREE_MODE_TREE - \
		$TREE_MODE_COLOR_OBJECTS {
		    set draw_objects $mColorObjects
		    set how $mColorObjectsHow
		} \
		$TREE_MODE_GHOST_OBJECTS {
		    set draw_objects $mGhostObjects
		    set how $mGhostObjectsHow
		} \
		$TREE_MODE_EDGE_OBJECTS {
		    set draw_objects $mEdgeObjects
		    set how $mEdgeObjectsHow
		}
	}

	set item $_item
    }

    set childsite [$itk_component(treeAccordian) itemChildsite $item]
    grid $itk_component(newtree) $itk_component(newtreevscroll) -sticky nsew -in $childsite
    grid $itk_component(newtreehscroll) - -sticky nsew -in $childsite
    grid columnconfigure $childsite 0 -weight 1
    grid rowconfigure $childsite 0 -weight 1

    raise $itk_component(newtree)
    raise $itk_component(newtreevscroll)
    raise $itk_component(newtreehscroll)

    setTreeView 1
    if {($drawem || $mToolViewChange) && [info exists itk_component(ged)]} {
	$itk_component(ged) refresh_off
	set mSavedCenter [$itk_component(ged) center]
	set mSavedSize [$itk_component(ged) size]
	zap

	if {$draw_objects != ""} {
	    eval draw -m$how $draw_objects
	}

	$itk_component(ged) center $mSavedCenter
	$itk_component(ged) size $mSavedSize
	$itk_component(ged) refresh_on
	$itk_component(ged) refresh_all
    }

    if {$mTreeMode < $TREE_MODE_COLOR_OBJECTS} {
	set mPrevTreeMode $mTreeMode
    } else {
	set mPrevTreeMode2 $mTreeMode
    }

    set mAccordianCallbackActive 0
}


# Local Variables:
# mode: Tcl
# tab-width: 8
# c-basic-offset: 4
# tcl-indent-level: 4
# indent-tabs-mode: t
# End:
# ex: shiftwidth=4 tabstop=8
