A 3D Model Generator GUI
uniquename - 2012nov15
I indicated in April 2012, on my 'biography page' at uniquename, that I was inspired by Mark Stucky and Gerard Sookahet to create some 3D model viewing utilities --- complete with fairly robust 3D model data importers (for a variety of 3D data formats --- such as Wavefront OBJ files, Cyberware PLY files, STL stereolithography files, CAD-like data files, etc.).
Well, I am getting started on some 3D viewing projects, but to aid in that endeavor, I have found that it would be nice to have a variety of test files at hand --- boxes, tetrahedrons, octahedrons, icosahedrons, spheres, cones, cylinders, tori --- even buckyballs --- of various dimensions and in various formats.
And what better way to generate such files (with parameters such as widths, heights, depths, radii, etc.) than with Tcl.
And what better way to make an easy-and-quick-and-consolidated-and-self-documenting way of running the code that generates those files than Tk.
Here are a couple of screenshots that sum up in a few inches what the resulting GUI looks like. The 2 images indicate the current extent of the capabilities --- and some capabilities that may be implemented in the future (some model-types that may be implemented in the future --- indicated by a hash-sign at the beginning of the line in the listbox).
and
The first image shows the parameter prompts for the model-type 'BOX-6-QUADS' --- parameters: width,height,depth.
The image also indicates the (ASCII) 3D model output-file types that I plan to support in the future: OBJ format, PLY format, OFF format, and STL format.
The images also indicate that you can supply an x,y,z 'offset' to translate all the vertices in the model by that vector-amount.
The 2nd image indicates that I have clicked on the 'WriteFile' button, because the label at the upper right of the GUI indicates that an OBJ file was written for a 'CONE-N-TRIAS' model-type. The label shows the number of vertex and face records written. (A text editor popped up showing the output file. I dismissed that editor window and took this screenshot.)
The listbox on the left of these images indicates that, so far, I have implemented at least one 'writer' for about ten model-types.
The code
I provide the code for this 3D model generator GUI below.
I follow my usual 'canonical' structure for Tk code. So for this Tk script:
0) Set general window & widget parms (win-name, win-position,
win-color-scheme, fonts, widget-geometry-parms, win-size-control,
text-array-for-labels-etc).
1a) Define ALL frames (and sub-frames, if any).
1b) Pack ALL frames and sub-frames.
2) Define & pack all widgets in the frames, frame by frame.
3) Define keyboard and mouse/touchpad/touch-sensitive-screen action
BINDINGS, if needed.
4) Define PROCS, if needed.
5) Additional GUI initialization (typically with one or more of
the procs), if needed.This structure is discussed in more detail on the page A Canonical Structure for Tk Code --- and variations.
This structure makes it easy for me to find code sections --- while generating and testing a Tk script, and when looking for code snippets to include in a Tk script (code re-use).
One new thing that I have started doing recently is using a text-array for text in labels, buttons, and other widgets in the GUI. This can make it easier for people to internationalize my scripts. I will be using a text-array like this in most of my scripts in the future.
Experimenting with the GUI
As in all my scripts that use the 'pack' geometry manager (which is all of my 100-plus scripts, so far), I provide the four main pack parameters --- '-side', '-anchor', '-fill', '-expand' --- on all of the 'pack' commands for the frames and widgets.
That helps me when I am initially testing the behavior of a GUI (the various widgets within it) as I resize the main window.
You can experiment with the '-side', '-anchor', '-fill', and '-expand' parameters on the 'pack' commands for the various frames and widgets --- to get the widget behavior that you want.
___
In addition, you might want to change the fonts used for the various GUI widgets. For example, you could change '-weight' from 'bold' to 'normal' --- or '-slant' from 'roman' to 'italic'. Or change font families.
In fact, you may NEED to change the font families, because the families I used may not be available on your computer --- and the default font that the 'wish' interpreter chooses may not be very pleasing.
I use variables to set geometry parameters of widgets --- parameters such as border-widths and padding. And I have included the '-relief' parameter on the definitions of frames and widgets. Feel free to experiment with those 'appearance' parameters as well.
Some features of the code
That said, here's the code --- with plenty of comments to describe what most of the code-sections are doing.
One of the rather unusual features of this script is the fact that the 'parameters' frame is changed according to the 'model-type' selected.
- When 'BOX-6-QUADS' is selected, the 'parameters' frame prompts for the 3 parameters width, height, and depth.
- When 'ICOSA-20-TRIAS' is selected, the 'parameters' frame prompts for two parameters --- 'x' and 'z'.
You can look at the procs 'load_parameters_frame_BOX6QUADS' and 'load_parameters_frame_ICOSA20TRIAS' --- to see how the pack forget command is used to change the widgets in the 'parameters' frame.
Those 'load_parameters_frame_XXX' procs also enable or disable the 'output-type' radiobuttons on the GUI to correspond to the currently available 'write' procs for any selected 'model-type'.
You can use the 'Help' button on the GUI to see information on how to add a 'model-type' to this utility. It involves adding a 'load_parameters_frame_XXX' proc and at least one 'write_model_XXX_YYY' proc to the script.
The bottom of the 'Help' also describes the formats of OBJ, PLY, OFF, and STL files --- and the help describes which parts of the format specifications are being supported by these 'writers'.
___
It is my hope that the copious comments in the code will help Tcl-Tk coding 'newbies' get started in making GUI's like this --- and perhaps have some fun with the 'pack forget' command.
Without the comments, potential young Tcler's might be tempted to return to their iPhones and iPads and iPods --- to watch Earth's/Jupiter's/Uranus's Funniest Home Videos.
Code for the Tk script '3DmodelGenerator.tk' :
#!/usr/bin/wish -f
##
## SCRIPT: 3DmodelGenerator.tk
##
## PURPOSE: This Tk GUI script offers a GUI on which the user can
## - choose model type (box, tetrahedron, octahedron, icosahedron,
## ..., sphere, cone, cylinder, torus, etc.)
## and
## - enter associated parameters such as distances (length, radius,
## number of longitudinal segments, number of latitudinal
## segments, etc.)
##
## and then click a button to generate a 3D model data file
## according to a chosen format type (OBJ, PLY, OFF, STL, ...).
##
## Since the OBJ file format is the most common ASCII 3D model
## file format used at 3D model archive sites, we put a priority
## on creating models in OBJ format.
##
## We may use a slight extension of the OBJ format, dubbed 'cOBJ',
## in which we put 'c' (color) records in the file --- to
## indicate a color for the following 'v' (vertex) or 'f' (face)
## records.
##
## These 'c' records are like the 'Kd' (diffuse light) records of
## OBJ 'mtl' (material) files in that they contain 3 decimal numbers
## between 0 and 1 that specify a Red-Green-Blue color. Example:
## c 0.72 0.45 0.0 , which would be an orange color.
##
##+######
## METHOD: After the user specifies 3 types of items:
## - a model type (box, sphere, etc.)
## - some parameters associated with that model type,
## and
## - an output file type,
##
## the file is written using Tcl 'puts' commands.
##
## The file may be automatically presented in a GUI text-editor.
##
## (To change the GUI editor setting, the user can edit this
## script to change the setting of an 'EDITOR_text' variable
## at the bottom of this script.)
##
## The output file may be put in a temporary-file directory,
## such as /tmp on Linux/Unix. That default directory is
## set in a variable like 'outDIR' at the bottom of this script.
##
## The user can use the 'SaveAs...' option of their text editor
## to save the file in a directory of the user's choice ---
## after 'touching up' the file however the user desires.
## For example, comment lines starting with '#' may be added.
##
##+##############
## THE GUI LAYOUT:
## The GUI contains the following frames and widgets:
##
## - 1 'model type' frame for a LISTBOX --- used to select a
## 3D model-file type to generate --- box, sphere/ellipsoid,
## tetrahedron, pyramid, cone, octahedron, torus, whatever.
##
## - 1 'buttons' frame for an 'Exit' BUTTON, a 'Help' BUTTON, a
## 'Write' BUTTON, and a LABEL widget to hold 'info',
## such as info about the 3D-model --- for example,
## number of points/lines/facets=polygons written.
##
## - 1 'outtypes' frame for some RADIOBUTTONS --- used to specify
## output-file type --- 'CAD-like', OBJ, whatever.
##
## - 1 'parameters' frame for LABEL and ENTRY widgets and whatever
## other kinds of widgets are appropriate for the
## user-selected output type.
##
## Note: There will actually be a parameter frame (and widgets)
## defined for each output type. The current 'parameters' frame
## will be replaced by the frame(s) appropriate to the
## user-selected output type. A button1-release
## binding on each of the model-types in the listbox will
## be used to call on a proc-for-each-output-type.
## That proc will use a 'pack-forget-and-re-pack' technique
## to replace the current frame with the appropriate frame.
##
##+######################################################################
## 'CANONICAL' STRUCTURE OF THIS CODE:
##
## 0) Set general window parms (win-name,win-position,color-scheme,fonts,
## widget-geometry-parms,win-size-control,text-array-for-labels-etc).
## 1a) Define ALL frames (and sub-frames, if any).
## 1b) Pack ALL the frames and sub-frames.
## 2) Define all widgets in the frames, frame by frame.
## When all widgets are defined for a frame, pack them.
##
## 3) Define keyboard and mouse/touchpad/touch-sensitive-screen 'event'
## BINDINGS, if needed.
## 4) Define PROCS, if needed.
## 5) Additional GUI INITIALIZATION (typically, with one or two procs),
## if needed.
##
## The code-structure detail for this particular script:
##
## 1a) Define ALL frames:
##
## Top-level : '.fRleft' '.fRright'
##
## Sub-frames:
## in '.fRleft': '.fRlistbox' (for listbox and scrollbar widgets)
## in '.fRright': '.fRbuttons' '.fRouttypes' '.fRtranslate' '.fRparameters'
##
## 1b) Pack ALL frames.
##
## 2) Define all widgets in the frames (and pack them):
##
## - In '.fRright.fRbuttons':
## 3 button widgets ('Exit','Help','Write') and1 label widget
##
## - In '.fRright.fRouttypes' frame:
## several radiobutton widgets, for output type --- OBJ, PLY, ...
##
## - In '.fRright.fRtranslate' frame:
## 3 entry widgets, with label widgets --- for x,y,z translation
## of all the point coordinates of the model
##
## - In '.fRright.fRparameters_XXX':
## label and entry ( and other?) widgets, where XXX is a name indicating
## the model-type --- BOX6QUADS, OCTA20TRIAS, whatever
##
## (The current 'parameters' frame is overlaid by a frame
## chosen via one of the model-types radiobuttons.)
##
## 3) Define BINDINGS:
##
## a button1-release binding on the model-type listbox,
## to call on a 'load_parameters_frame_XXX' to change
## the '.fRparameters_XXX' frame.
##
## 4) Define PROCS:
##
## 'load_parameters_frame_XXX' - called via the binding above,
## according to which model-type listbox line
## is clicked. Example proc name:
## 'load_parameters_frame_BOX6QUADS'
##
## 'write_model_XXX_YYY' - called when the 'WriteFile' button is clicked.
## Writes the output file according to the
## XXX model-type setting (box,sphere, ...) and the
## YYY output-type radiobutton setting (OBJ, ...).
## Example proc name:
## 'write_model_BOX6QUADS_OBJ'
##
## These 'load' and 'write' procs may be grouped together according
## to the model-type ('XXX') so that whenever a programmer
## adds/changes/deletes a model-type, the 'load' and 'write' procs
## for the model-type are nicely accessible, by being together.
##
## 'popup_msgVarWithScroll' - for a Help button
##
## See the top of the PROCS section of the code for a more detailed list
## of the procs.
##
## 5) Additional GUI initialization:
## Some constants (like pi) are set here, for use by some of the
## 'write_model' procs.
##
## The 'EDITOR_text' variable is set here. Change this 'set'
## statement to change the text editor to be used.
##
## The 'outDIR' variable is set here. Change this 'set'
## statement to change where the model files will be created.
##
## The 'curPARMframe' is set here with the name of the current
## (dummy) parameter frame.
##
## OPTIONALLY: (to have a non-dummy parameter frame showing
## when the GUI first comes up)
## We set an initial listbox line setting via variable
## 'VARmodeltype' and an initial radiobutton setting for
## output-type. Example: BOX-6-QUADS and OBJ.
##
## The 'load_parameters_frame_BOX6QUADS' for BOX-6-QUADS (or whatever)
## is also called here, to display the '.fRright.fRparameters_BOX6QUADS'
## frame, which will typically contain some default parameter values.
##
## It the model-type and output-type and parameters are what the
## user wants, the user can simply click the 'WriteFile' button to
## immediately generate a model file and see its contents be
## displayed in the specified text-editor.
##
## Otherwise, the user can change model-type and/or output-type,
## set some parameters, and THEN click 'WriteFile'.
##
##+########################################################################
## DEVELOPED WITH:
## Tcl-Tk 8.5 on Ubuntu 9.10 (2009-october, 'Karmic Koala).
##
## $ wish
## % puts "$tcl_version $tk_version"
## showed 8.5 8.5 on Ubuntu 9.10.
##+#######################################################################
## MAINTENANCE HISTORY:
## Created by: Blaise Montandon 2012nov15
## Changed by: Blaise Montandon 2013jan27 Changed model-type selection
## from radiobuttons to a listbox.
## Added parameter and write procs
## for some model-types.
## Changed by: Blaise Montandon 2013feb02 Added frame '.fRtranslate' to
## set VARtranx,VARtrany,VARtranz
## to translate all points of any
## given model. Also re-orged the
## 'load' & 'write' procs in the
## PROCS section.
## Changed by: Blaise Montandon 2013feb03 Added load-parameters-frame and
## write-OBJ procs for models
## 'TETRA-4-TRIAS', 'CYL-N-QUADS',
## 'PYR-4-TRIAS-1-QUAD', 'OCTA-8-TRIAS',
## 'PRISM-2-TRIAS-3-QUADS', 'CONE-N-TRIAS',
## and 'SPHERE-QUADS-TRIAS'.
##+#######################################################################
##+#######################################################################
## Set window parms --- WIN-TITLE and WIN-POSITION.
##+#######################################################################
wm title . "3D Model Generator, for some model types & output formats"
wm iconname . "modGen3D"
wm geometry . +15+30
##+#########################################################
## Set the COLOR SCHEME (palette) for the window ---
## and some colors for its widgets --- such as scale widgets.
##+#########################################################
set R255pal 210
set G255pal 210
set B255pal 210
## sandy brown
set R255pal 244
set G255pal 164
set B255pal 96
set hexCOLORpal [format "#%02X%02X%02X" $R255pal $G255pal $B255pal]
tk_setPalette "$hexCOLORpal"
set BKGD_listbox "#f0f0f0"
set BKGD_entry "#f0f0f0"
set BKGD_radbutt "#f0f0f0"
##+########################################################
## SET 'FONT-NAMES'.
##
## We use a VARIABLE-WIDTH FONT for labels and buttons
## and the numeric values shown by scale widgets.
##
## We use a FIXED-WIDTH FONT for the help text in a text
## widget (so that any columns in the text stay lined up).
##+########################################################
font create fontTEMP_varwidth \
-family {comic sans ms} \
-size -14 \
-weight bold \
-slant roman
font create fontTEMP_SMALL_varwidth \
-family {comic sans ms} \
-size -10 \
-weight bold \
-slant roman
## Some other possible (similar) variable width fonts:
## Arial
## Bitstream Vera Sans
## DejaVu Sans
## Droid Sans
## FreeSans
## Liberation Sans
## Nimbus Sans L
## Trebuchet MS
## Verdana
font create fontTEMP_fixedwidth \
-family {liberation mono} \
-size -14 \
-weight bold \
-slant roman
## Some other possible fixed width fonts (esp. on Linux):
## Andale Mono
## Bitstream Vera Sans Mono
## Courier 10 Pitch
## DejaVu Sans Mono
## Droid Sans Mono
## FreeMono
## Nimbus Mono L
## TlwgMono
##+###########################################################
## SET GEOM VARS FOR THE VARIOUS WIDGET DEFINITIONS.
## (e.g. padding and borderwidths for Buttons and Labels)
##+###########################################################
## For LABEL widgets:
set PADYpx_label 0
set PADXpx_label 0
# set BDwidthPx_label 0
set BDwidthPx_label 2
## For BUTTON widgets:
set PADXpx_button 0
set PADYpx_button 0
set BDwidthPx_button 2
## For the LISTBOX widget:
set initListboxWidthChars 25
set initListboxHeightChars 15
set BDwidthPx_listbox 2
## For ENTRY widgets:
set BDwidthPx_entry 2
## For TEXT widgets:
set BDwidthPx_text 2
##+########################################################
## Set a MINSIZE of the window (roughly) -- according to the
## approx max WIDTH of the buttons in the 'fRbuttons' frame
## --- and according to the approx HEIGHT of the 4 frames.
##+########################################################
set minWinWidthPx [font measure fontTEMP_varwidth \
"Exit Help Write"]
## Add some pixels to account for right-left-side window decoration
## (about 8 pixels), about 3 widgets x 3 pixels/widget for borders/padding
## for 3 widgets --- 3 buttons.
set minWinWidthPx [expr {17 + $minWinWidthPx}]
## MIN HEIGHT --- allow at least
## 1 char high for the 'fRbuttons' frame
## 1 char high for the 'fRouttypes' frame
## 1 char high for the 'fRparameters_XXX' frame
##
## OR at least 6 chars high for model-types in the listbox.
set charHeightPx [font metrics fontTEMP_varwidth -linespace]
set minWinHeightPx [expr {6 * $charHeightPx}]
## Add some pixels to account for top-bottom window decoration
## (about 28 pixels) and frame/widget padding vertically
## (about 4 pixels/frame x 3 frames).
set minWinHeightPx [expr {40 + $minWinHeightPx}]
## FOR TESTING:
# puts "minWinWidthPx = $minWinWidthPx"
# puts "minWinHeightPx = $minWinHeightPx"
wm minsize . $minWinWidthPx $minWinHeightPx
## We allow the window to be resizable and we pack the canvas with
## '-fill both' so that the canvas can be enlarged by enlarging the
## window.
## If you want to make the window un-resizable,
## you can use the following statement.
# wm resizable . 0 0
##+####################################################################
## Set a TEXT-ARRAY to hold text for buttons & labels on the GUI.
## NOTE: This can aid INTERNATIONALIZATION. This array can
## be set according to a nation/region parameter.
##+####################################################################
## if { "$VARlocale" == "en"}
## For 'fRbuttons' frame:
set aRtext(buttonEXIT) "Exit"
set aRtext(buttonHELP) "Help"
set aRtext(buttonWRITE) "WriteFile"
set aRtext(labelINFO) "Change default parameter values if desired,
select an output file type, and click on
'WriteFile' to write the file."
## For 'fRouttypes' frame:
set aRtext(labelOUTTYPES) "Output File Format:"
set aRtext(radbuttOBJ) "OBJ"
set aRtext(radbuttPLY) "PLY"
set aRtext(radbuttOFF) "OFF"
set aRtext(radbuttSTL) "STL"
# set aRtext(radbuttCADlike) "CAD-like"
## For 'fRtranslate' frame:
set aRtext(labelTRANX) "TranslateAllVertices - X:"
set aRtext(labelTRANY) " Y:"
set aRtext(labelTRANZ) " Z:"
## For various 'fRparameters_XXX' frames:
## (Some label-text may be hardcoded in the various
## label-widget definitions for the parameter frames,
## in the 'load_parameter_frame_XXX' procs.)
set aRtext(labelWIDTH) "Width:"
set aRtext(labelHEIGHT) "Height:"
set aRtext(labelDEPTH) "Depth:"
set aRtext(labelRADIUS) "Radius:"
set aRtext(labelLENGTH) "Length:"
## END OF if { "$VARlocale" == "en"}
##+################################################################
## DEFINE *ALL* THE FRAMES:
##
## Top-level : '.fRleft' '.fRright'
##
## Sub-frames: '.fRleft.fRlistbox' (for listbox and scrollbars)
## '.fRright.fRbuttons'
## '.fRright.fRouttypes'
## '.fRright.fRtranslate'
## '.fRright.fRparameters_XXX', for many XXX
##
## Note: The 'fRparameters_XXX' frames are defined here but they will
## not be packed in this GUI define-and-pack section.
## The 'fRparameters_XXX' frames will be packed as needed, by
## 'load_parameter_frame_XXX' procs.
##+################################################################
## FOR TESTING of expansion of frames (esp. during window expansion):
# set RELIEF_frame raised
# set BDwidth_frame 2
set RELIEF_frame flat
set BDwidth_frame 0
frame .fRleft -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRright -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRleft.fRlistbox -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRright.fRbuttons -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRright.fRouttypes -relief raised -borderwidth 2
frame .fRright.fRtranslate -relief $RELIEF_frame -borderwidth $BDwidth_frame
frame .fRright.fRparameters -relief $RELIEF_frame -borderwidth $BDwidth_frame
## The specific '.fRparameters_XXX' frames are not defined here.
## They are defined below, as entries are inserted into the
## model-types listbox.
##+##############################
## PACK the top-level FRAMES.
##+##############################
pack .fRleft \
-side left \
-anchor nw \
-fill both \
-expand 1
pack .fRright \
-side left \
-anchor nw \
-fill none \
-expand 0
##+##############################
## PACK the '.fRleft' SUB-FRAME.
##+##############################
pack .fRleft.fRlistbox \
-side top \
-anchor nw \
-fill both \
-expand 1
##+##############################
## PACK the '.fRright' SUB-FRAMES.
##+##############################
pack .fRright.fRbuttons \
-side top \
-anchor nw \
-fill none \
-expand 0
pack .fRright.fRouttypes \
-side top \
-anchor nw \
-fill x \
-expand 0
pack .fRright.fRtranslate \
-side top \
-anchor nw \
-fill none \
-expand 0
pack .fRright.fRparameters \
-side top \
-anchor nw \
-fill none \
-expand 0
## OK. ALL frames are defined and packed --- except those 'fRparameters_XXX'
## frames that will be defined below as listbox entries are inserted.
## The 'fRparameters_XXX' frames will be packed as-needed, by procs.
##
## Ready to define widgets.
##+################################################################
##+################################################################
## START DEFINING & PACKING WIDGETS WITHIN THEIR FRAMES,
## frame-by-frame. When all widgets for a frame are defined,
## pack them in the frame.
##+################################################################
##+################################################################
##+######################################################
## In FRAME '.fRleft.fRlistbox' -
## DEFINE-and-PACK a LISTBOX WIDGET,
## with scrollbars --- for a list of functions of 2 vars.
##+######################################################
listbox .fRleft.fRlistbox.listbox \
-width $initListboxWidthChars \
-height $initListboxHeightChars \
-font fontTEMP_fixedwidth \
-relief raised \
-borderwidth $BDwidthPx_listbox \
-state normal \
-yscrollcommand ".fRleft.fRlistbox.scrbary set" \
-xscrollcommand ".fRleft.fRlistbox.scrbarx set"
scrollbar .fRleft.fRlistbox.scrbary \
-orient vertical \
-command ".fRleft.fRlistbox.listbox yview"
scrollbar .fRleft.fRlistbox.scrbarx \
-orient horizontal \
-command ".fRleft.fRlistbox.listbox xview"
##+##########################################################
## INSERT MODEL-TYPE LISTBOX ENTRIES that hold brief, unique
## model-type identifiers --- followed by a separator
## character (#) --- followed by an arbitrary amount of
## descriptive info.
##
## By adding a '#' at the beginning of each line, we signal
## that that model-type is not implemented yet --- but it
## is being considered for addition at some future date.
##+##########################################################################
## FOR EACH MODEL-TYPE ADDED, ADD 2 PROCS TO THE PROCS SECTION
## --- with frame and widget definitions-and-packing.
##
## Note that for each listbox-line added here, there should be
## at least a couple of procs added to the PROCS section below:
## 'load_parameters_frame_XXX'
## Example name: 'load_parameters_frame_BOX6QUADS'
## 'write_model_XXX_YYY'
## Example names: 'write_model_BOX6QUADS_OBJ'
## 'write_model_BOX6QUADS_PLY'
##
## In the proc 'load_parameters_frame_XXX', there should be
## frame and widget definitions and pack statements for
## the new frame and new widgets.
##
## See the 'load_parameters_frame_XXX' procs for examples of how
## the previous parameters-frame is REMOVED by a 'pack forget' command,
## and THEN the XXX frame is packed.
##+##########################################################################
## Make sure the listbox is empty.
.fRleft.fRlistbox.listbox delete 0 end
## New MODEL-TYPES are to be added/activated here:
## (Also add corresponding 'load' & 'write' procs in the PROCS section below.)
.fRleft.fRlistbox.listbox insert end "BOX-6-QUADS # one quad for each face of the 6 faces this rectangular parallapiped"
.fRleft.fRlistbox.listbox insert end "BOX-12-TRIAS # two triangles for each face of the 6 faces this rectangular parallapiped"
.fRleft.fRlistbox.listbox insert end "CONE-N-TRIAS # N triangles around axis of cone; no bottom"
.fRleft.fRlistbox.listbox insert end "CYL-N-QUADS # N quads around axis of cylinder; no top or bottom"
.fRleft.fRlistbox.listbox insert end "ICOSA-20-TRIAS # one triangle for each of the 20 faces of this icosahedron"
.fRleft.fRlistbox.listbox insert end "OCTA-8-TRIAS # one triangle for each of the 8 faces of this octahedron; looks like 2 pyramids with a common base"
.fRleft.fRlistbox.listbox insert end "PRISM-2-TRIAS-3-QUADS # 2 triangular end-caps; the 2 triangles connected by 3 quadrangles"
.fRleft.fRlistbox.listbox insert end "PYR-4-TRIAS-1-QUAD # one triangle for each of the 4 sides of this pyramid; square bottom"
.fRleft.fRlistbox.listbox insert end "SPHERE-QUADS-TRIAS # triangles at north and south poles, quadrangles elsewhere"
.fRleft.fRlistbox.listbox insert end "TETRA-4-TRIAS # one triangle for each of the 4 faces of this tetrahedron"
.fRleft.fRlistbox.listbox insert end "## NOT IMPLEMENTED YET:"
.fRleft.fRlistbox.listbox insert end "# BUCKYBALL # M pentagons and ??? ???gons"
.fRleft.fRlistbox.listbox insert end "# CUBE-M-N-QUADS # one quad for each face of the 6 faces this rectangular parallapiped"
.fRleft.fRlistbox.listbox insert end "# ELLIPSOID-QUADS-TRIAS # triangles at north and south poles, quadrangles elsewhere"
.fRleft.fRlistbox.listbox insert end "# SPHERE-ALL-TRIAS # sphere with all triangles; no quadrangles"
.fRleft.fRlistbox.listbox insert end "# TRIAD-3CONES-3CYLS # three perpendicular xyz axes"
.fRleft.fRlistbox.listbox insert end "# TRIAD-12TRIAS-12QUADS # three perpendicular xyz axes"
.fRleft.fRlistbox.listbox insert end "# TORUS-M-N-QUADS # M segments of small circle; N segments of large circle; M*N quadrilaterals"
##+##############################################################
## Get the number of model-types loaded into the listbox --- to
## show users how many are in the listbox, out of sight.
##+##############################################################
set numModelTypes [.fRleft.fRlistbox.listbox index end]
##+####################################
## Pack the listbox and its scrollbars.
##+####################################
pack .fRleft.fRlistbox.scrbary \
-side right \
-anchor e \
-fill y \
-expand 0
pack .fRleft.fRlistbox.scrbarx \
-side bottom \
-anchor s \
-fill x \
-expand 0
## We need to pack the listbox AFTER
## the scrollbars, to get the scrollbars
## positioned properly --- BEFORE
## the listbox FILLS the pack area.
pack .fRleft.fRlistbox.listbox \
-side top \
-anchor nw \
-fill both \
-expand 1
##+################################################################
## IN THE '.fRright.fRbuttons' frame -
## DEFINE several BUTTONS (Exit,Help,Write) and a LABEL widget.
##+################################################################
button .fRright.fRbuttons.buttEXIT \
-text "$aRtext(buttonEXIT)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {exit}
button .fRright.fRbuttons.buttHELP \
-text "$aRtext(buttonHELP)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {popup_msgVarWithScroll "$HELPtext"}
button .fRright.fRbuttons.buttWRITE \
-text "$aRtext(buttonWRITE)" \
-font fontTEMP_varwidth \
-padx $PADXpx_button \
-pady $PADYpx_button \
-relief raised \
-bd $BDwidthPx_button \
-command {write_model_file}
## The text for this label will be loaded
## by a proc, such as 'load_3Dmodel_XXX'.
label .fRright.fRbuttons.labelINFO \
-text "Select a model-type from the listbox, change its default
parameter values if desired, select an output file type, and
click on 'WriteFile' to write the file." \
-font fontTEMP_SMALL_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
## Pack ALL the widgets in frame 'fRbuttons'.
pack .fRright.fRbuttons.buttEXIT \
.fRright.fRbuttons.buttHELP \
.fRright.fRbuttons.buttWRITE \
.fRright.fRbuttons.labelINFO \
-side left \
-anchor w \
-fill none \
-expand 0
##+######################################################
## In frame '.fRright.fRouttypes' -
## DEFINE a LABEL widget and several RADIOBUTTON widgets.
## Then PACK them.
##+#####################################################
label .fRright.fRouttypes.labelOUTTYPES \
-text "$aRtext(labelOUTTYPES)" \
-font fontTEMP_varwidth \
-justify left \
-anchor w \
-relief raised \
-bd 2
## The radiobuttons' variable, VARouttype, is
## initialized in the additional-GUI-initialization
## section at the bottom of this script.
radiobutton .fRright.fRouttypes.radbuttOBJ \
-text "$aRtext(radbuttOBJ)" \
-font fontTEMP_varwidth \
-anchor w \
-variable VARouttype \
-value "OBJ" \
-selectcolor "$BKGD_radbutt" \
-relief flat \
-bd $BDwidthPx_button
radiobutton .fRright.fRouttypes.radbuttPLY \
-text "$aRtext(radbuttPLY)" \
-font fontTEMP_varwidth \
-anchor w \
-variable VARouttype \
-value "PLY" \
-selectcolor "$BKGD_radbutt" \
-relief flat \
-bd $BDwidthPx_button
radiobutton .fRright.fRouttypes.radbuttOFF \
-text "$aRtext(radbuttOFF)" \
-font fontTEMP_varwidth \
-anchor w \
-variable VARouttype \
-value "OFF" \
-selectcolor "$BKGD_radbutt" \
-relief flat \
-bd $BDwidthPx_button
radiobutton .fRright.fRouttypes.radbuttSTL \
-text "$aRtext(radbuttSTL)" \
-font fontTEMP_varwidth \
-anchor w \
-variable VARouttype \
-value "STL" \
-selectcolor "$BKGD_radbutt" \
-relief flat \
-bd $BDwidthPx_button
if {0} {
## This button is NOT USED YET.
radiobutton .fRright.fRouttypes.radbuttCADlike \
-text "$aRtext(radbuttCADlike)" \
-font fontTEMP_varwidth \
-anchor w \
-variable VARouttype \
-value "CAD-like" \
-selectcolor "$BKGD_radbutt" \
-relief flat \
-bd $BDwidthPx_button
}
## Pack ALL the widgets in frame 'fRouttypes'.
pack .fRright.fRouttypes.labelOUTTYPES \
.fRright.fRouttypes.radbuttOBJ \
.fRright.fRouttypes.radbuttPLY \
.fRright.fRouttypes.radbuttOFF \
.fRright.fRouttypes.radbuttSTL \
-side left \
-anchor w \
-fill none \
-expand 0
## Not used yet:
# .fRright.fRouttypes.radbuttCADlike \
##+########################################################
## In the '.fRright.fRtranslate' frame -
## DEFINE 3 ENTRY widgets, for x,y,z translation of all the
## points in a model --- along with 3 LABEL widgets.
##
## PACK the 6 label and entry widgets.
##+########################################################
label .fRright.fRtranslate.labelTRANX \
-text "$aRtext(labelTRANX)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARtranx "0.0"
entry .fRright.fRtranslate.entTRANX \
-textvariable VARtranx \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRtranslate.labelTRANY \
-text "$aRtext(labelTRANY)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARtrany "0.0"
entry .fRright.fRtranslate.entTRANY \
-textvariable VARtrany \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRtranslate.labelTRANZ \
-text "$aRtext(labelTRANZ)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARtranz "0.0"
entry .fRright.fRtranslate.entTRANZ \
-textvariable VARtranz \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the 3 entry widgets.
pack .fRright.fRtranslate.labelTRANX \
.fRright.fRtranslate.entTRANX \
.fRright.fRtranslate.labelTRANY \
.fRright.fRtranslate.entTRANY \
.fRright.fRtranslate.labelTRANZ \
.fRright.fRtranslate.entTRANZ \
-side left \
-anchor w \
-fill none \
-expand 0
##+########################################################
## In the '.fRright.fRparameters' frame -
## DEFINE a 'dummy' LABEL widget
##
## in this is an initial, 'dummy' frame that is to be
## replaced by other frames for particular model types
## --- box, tetrahedron, sphere, torus, whatever.
##
## Then PACK the widget.
##+########################################################
## NOTE:
## The widgets for the '.fRparameters_XXX' frames ---
## such as LABEL and ENTRY widgets for the
## '.fRparameters_BOX6QUADS' frame ---
## are defined and packed, as needed, in the
## 'load_parameters_frame_XXX' procs --- for example,
## 'load_parameters_frame_BOX6QUADS'.
##+#######################################################
label .fRright.fRparameters.labelDUMMY \
-text "Select a model-type from the listbox. Its parameter prompts will appear here." \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
## Pack ALL the widgets in the 'fRparameters' frame.
pack .fRright.fRparameters.labelDUMMY \
-side left \
-anchor w \
-fill none \
-expand 0
##+#####################################################################
## END OF SECTIONS TO SETUP THE GUI.
## ALL FRAMES and WIDGETS are DEFINED-and-PACKED --- except for
## the 'parameter' frames and widgets for specific model-types.
## Those will be defined-and-packed in the 'load_parameters_frame_XXX'
## procs below.
##
## We are now ready to define BINDINGS and PROCS, and do some
## additional initialization of the GUI.
##+#####################################################################
##+#######################################################################
## DEFINE BINDINGS SECTION, including:
## - button1-release on the listbox ---
## to call on a corresponding 'load_parameters_frame_XXX' proc.
##+#######################################################################
bind .fRleft.fRlistbox.listbox <ButtonRelease-1> {listboxSelectionTOparmframeload}
##+######################################################################
## DEFINE PROCS SECTION. Procs here include:
##
## 'listboxSelectionTOparmframeload' - called by a click on the
## model-types listbox.
##
## This proc calls on a 'load_parameters_frame_XXX' proc
## depending on the listbox line (model-type, XXX) selected.
##
## Example proc that this proc calls: 'load_parameters_frame_BOX6QUADS'
##
##-----------------------------------------------------------------------
##
## 'write_model_file' - called by a click on the 'WriteFile' button.
##
## This proc calls on a 'write_model_XXX_YYY' proc
## depending on the current model-type selected and
## the current setting of the output-types radiobuttons.
##
## Example proc that this proc calls: 'write_model_BOX6QUADS_OBJ'
##
##-----------------------------------------------------------------------
##
## 'edit_outfile' - called by the 'write_model_XXX_YYY' procs, below, to
## display the new output file in a GUI text-editor.
##-----------------------------------------------------------------------
## NOTES on load-and-write PROC GROUPING-ORDERING:
##
## The following 'load' and 'write' procs may be grouped together
## according to the model-type ('XXX') --- so that whenever a programmer
## adds/changes/deletes a model-type, the 'load' and 'write' procs
## for the model-type are nicely accessible, by being together.
##
## Note that there may be multiple 'write' procs (OBJ,PLY,OFF,STL,...)
## for any given model-type ('XXX').
##
## We may put these load-and-write GROUPS in alpha-numeric order by
## model-type ('XXX'). Example:
## BOX6QUADS
## BOX12TRIAS
## ...
## CONE...
## ...
## CYL...
## ...
## SPHER...
## ...
## TETRA...
## ...
##
## Note that if you ADD 'load' or 'write' procs, you will probably
## need to UPDATE the two procs 'listboxSelectionTOparmframeload'
## and/or 'write_model_file', described above.
##
##-----------------------------------------------------------------------
## NOTES ON 'load_parameters_frame_XXX' PROCS:
##
## 'load_parameters_frame_XXX' procs for various model-types XXX,
## where XXX = BOX6QUADS, TETRA4TRIAS, etc.
##
## Example (actions performed by a typical 'load' proc):
##
## 'load_parameters_frame_BOX6QUADS' -
## Unpacks (with 'pack forget') the current 'parameters' frame
## --- held in var 'curPARMframe' --- and packs the
## 'BOX6QUADS' parm-frame (with its widgets) in its place.
##
## If the 'BOX6QUADS' parm-frame does not exist yet,
## the proc defines the frame and its widgets
## and packs the widgets within the frame.
## THEN it proceeds to pack the 'BOX6QUADS' parm-frame.
##
## Note: The proc should define the 'BOX6QUADS' frame and
## its widgets just once in any session, but the
## 'BOX6QUADS' frame could be packed and 'pack forget'-ed
## multiple times in a session.
##
## The 'load_parameters_frame_BOX6QUADS' proc is called
## via the 'listboxSelectionTOparmframeload' proc, whenever
## the 'BOX6QUADS' line of the listbox was clicked.
##
##-----------------------------------------------------------------------
## NOTES ON 'write_model_XXX_YYY' PROCS:
##
## 'write_model_XXX_YYY' procs for various model-types XXX and for various
## out-types YYY, where YYY = OBJ, PLY, ...
##
## A 'write_model_XXX_YYY' proc is called by the 'write_model_file' proc,
## when the 'WriteFile' button is clicked.
##
## A 'write_model_XXX_YYY' proc writes the output file according to the
## XXX model-type setting and the
## YYY output-type radiobutton setting.
##
## Example name: 'write_model_BOX6QUADS_OBJ'
##-----------------------------------------------------------------------
##
## 'popup_msgVarWithScroll' - for a Help button (and warning/error msgs)
##
## 'popup_msgVarWithScroll_wait' - for showing error messages.
##
##-----------------------------------------------------------------------
## PERHAPS SOMEDAY - procs/coding like this may be created and used:
##
## 'randomColor' - called-by/used-in the 'write_model_XXX_YYY' procs, to
## generate random hexcolor codes --- for use in writing
## 3D model files --- i.e. for applying colors to points
## and/or polygons, randomly.
##
## 'rainbowColor' - called-by/used-in the 'write_model_XXX_YYY' procs, to
## generate hexcolor codes from the rainbow spectrum
## --- for use in writing 3D model files --- i.e. for
## applying colors to points and faces/polygons,
## randomly or via some algorithm such as color assignment
## according to height of polygons/points in the model.
##
##+########################################################################
##+#########################################################################
## proc 'listboxSelectionTOparmframeload'
##+#########################################################################
## PURPOSE: Calls on a 'load_parameters_frame_XXX' proc
## depending on the model-types listbox line selected.
##
## CALLED BY: button1-release on the model-types listbox
##
## See the listbox insert statements above (where the listbox widget was
## defined) for the model-type ID strings that were loaded in the listbox.
##+#########################################################################
proc listboxSelectionTOparmframeload {} {
global VARmodeltype
set sel_index [ .fRleft.fRlistbox.listbox curselection ]
if { $sel_index != "" } {
set MODELdesc [ .fRleft.fRlistbox.listbox get $sel_index ]
set TEMPlist [split $MODELdesc #]
set VARmodeltype [lindex $TEMPlist 0]
set VARmodeltype [string trim $VARmodeltype]
} else {return}
## FOR TESTING:
# puts "proc 'listboxSelectionTOparmframeload' > VARmodeltype: $VARmodeltype"
if {"$VARmodeltype" == ""} {return}
#####################################################################################
## THE FOLLOWING MODEL-TYPES HAVE AT LEAST ONE 'write' PROC. (in alpha-numeric order).
#####################################################################################
if {"$VARmodeltype" == "BOX-6-QUADS"} {load_parameters_frame_BOX6QUADS}
if {"$VARmodeltype" == "BOX-12-TRIAS"} {load_parameters_frame_BOX12TRIAS}
if {"$VARmodeltype" == "CONE-N-TRIAS"} {load_parameters_frame_CONEnTRIAS}
if {"$VARmodeltype" == "CYL-N-QUADS"} {load_parameters_frame_CYLnQUADS}
if {"$VARmodeltype" == "ICOSA-20-TRIAS"} {load_parameters_frame_ICOSA20TRIAS}
if {"$VARmodeltype" == "OCTA-8-TRIAS"} {load_parameters_frame_OCTA8TRIAS}
if {"$VARmodeltype" == "PRISM-2-TRIAS-3-QUADS"} {load_parameters_frame_PRISM2TRIAS3QUADS}
if {"$VARmodeltype" == "PYR-4-TRIAS-1-QUAD"} {load_parameters_frame_PYR4TRIAS1QUAD}
if {"$VARmodeltype" == "SPHERE-QUADS-TRIAS"} {load_parameters_frame_SPHEREquadsTrias}
if {"$VARmodeltype" == "TETRA-4-TRIAS"} {load_parameters_frame_TETRA4TRIAS}
####################################################################################
## THE FOLLOWING MODEL-TYPES ARE ON MY 'TO-IMPLEMENT' LIST. (in alpha-numeric order)
####################################################################################
# if {"$VARmodeltype" == "BUCKYBALL"} {load_parameters_frame_BUCKYBALL}
# if {"$VARmodeltype" == "CUBE-M-N-QUADS"} {load_parameters_frame_CUBE_m_n_QUADS}
# if {"$VARmodeltype" == "ELLIPSOID-QUADS-TRIAS"} {load_parameters_frame_ELLIPSOIDquadsTrias}
# if {"$VARmodeltype" == "TORUS-M-N-QUADS"} {load_parameters_frame_TORUS_m_n_QUADS}
# if {"$VARmodeltype" == "TRIAD-12TRIAS-12QUADS"} {load_parameters_frame_TRIAD12TRIAS12QUADS}
# if {"$VARmodeltype" == "TRIAD-3CONES-3CYLS"} {load_parameters_frame_TRIAD3CONES3CYS}
}
## END OF PROC 'listboxSelectionTOparmframeload'
##+#########################################################################
## proc 'write_model_file'
##+#########################################################################
## PURPOSE: Calls on a 'write_model_XXX_YYY' proc according to the
## current settings of VARmodeltype and the out-type radiobuttons.
##
## CALLED BY: called by the 'WriteFile' button
##+#########################################################################
proc write_model_file {} {
global VARmodeltype VARouttype
## We could put a message into the 'labelINFO' widget, rather than
## silently returning when VARmodeltype is not set yet.
if {![info exists VARmodeltype]} {return}
#####################################################################################
## THE FOLLOWING MODEL-TYPES HAVE AT LEAST ONE 'write' PROC. (in alpha-numeric order).
#####################################################################################
if {"$VARmodeltype" == "BOX-6-QUADS" && "$VARouttype" == "OBJ"} {
write_model_BOX6QUADS_OBJ
return
}
if {"$VARmodeltype" == "BOX-6-QUADS" && "$VARouttype" == "PLY"} {
write_model_BOX6QUADS_PLY
return
}
if {"$VARmodeltype" == "BOX-12-TRIAS" && "$VARouttype" == "PLY"} {
write_model_BOX12TRIAS_PLY
return
}
if {"$VARmodeltype" == "BOX-12-TRIAS" && "$VARouttype" == "STL"} {
write_model_BOX12TRIAS_STL
return
}
if {"$VARmodeltype" == "CONE-N-TRIAS" && "$VARouttype" == "OBJ"} {
write_model_CONEnTRIAS_OBJ
}
if {"$VARmodeltype" == "CYL-N-QUADS" && "$VARouttype" == "OBJ"} {
write_model_CYLnQUADS_OBJ
return
}
if {"$VARmodeltype" == "ICOSA-20-TRIAS" && "$VARouttype" == "OBJ"} {
write_model_ICOSA20TRIAS_OBJ
return
}
if {"$VARmodeltype" == "OCTA-8-TRIAS" && "$VARouttype" == "OBJ"} {
write_model_OCTA8TRIAS_OBJ
return
}
if {"$VARmodeltype" == "PRISM-2-TRIAS-3-QUADS" && "$VARouttype" == "OBJ"} {
write_model_PRISM2TRIAS3QUADS_OBJ
}
if {"$VARmodeltype" == "PYR-4-TRIAS-1-QUAD" && "$VARouttype" == "OBJ"} {
write_model_PYR4TRIAS1QUAD_OBJ
return
}
if {"$VARmodeltype" == "SPHERE-QUADS-TRIAS" && "$VARouttype" == "OBJ"} {
write_model_SPHEREquadsTrias_OBJ
return
}
if {"$VARmodeltype" == "TETRA-4-TRIAS" && "$VARouttype" == "OBJ"} {
write_model_TETRA4TRIAS_OBJ
return
}
}
## END OF proc 'write_model_file'
##+#########################################################################
## proc 'edit_outfile'
##+#########################################################################
## PURPOSE: Calls on a GUI text-editor of the user's choice,
## with which to disply the output 3D model file.
##
## If any 'fancy' error handling needs to be done,
## it can be done in one place, in this script.
##
## NOTE: The user can edit this script to change the setting
## of the variable EDITOR_text to the editor of their choice.
## See the example settings at the bottom of this script,
## in the Additional-GUI-Initialization section.
##
## CALLED BY: the 'write_model_XXX_YYY' procs.
##+#########################################################################
proc edit_outfile {FULFILname} {
global env EDITOR_text
# exec /usr/bin/sh -c "$EDITOR_text "$FULFILname" > /dev/null 2>&1"
exec $EDITOR_text "$FULFILname"
}
## END OF proc 'edit_outfile'
##+##########################################################################
##+##########################################################################
## HERE IS THE START OF THE GROUPS OF 'load' and 'write' procs, for
## model-type XXX and output-file-type YYY.
##+##########################################################################
##+##########################################################################
##+#############################
## START OF **BOX6QUADS GROUP**:
##+#############################
##+#########################################################################
## proc 'load_parameters_frame_BOX6QUADS'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for a BOX.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an BOX-write proc for the outtype.
##
## CALLED BY: button1-release on the BOX6QUADS model-type listbox line
##+#########################################################################
proc load_parameters_frame_BOX6QUADS {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARwidth VARheight VARdepth VARouttype
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_BOX6QUADS]} {
frame .fRright.fRparameters_BOX6QUADS -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_BOX6QUADS' frame -
## DEFINE 3 ENTRY widgets, for width,height,depth of the box
## --- along with 3 LABEL widgets.
## PACK the 6 label and entry widgets.
##+########################################################
label .fRright.fRparameters_BOX6QUADS.labelWIDTH \
-text "BOX-6-QUADS - $aRtext(labelWIDTH)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARwidth "1.0"
entry .fRright.fRparameters_BOX6QUADS.entWIDTH \
-textvariable VARwidth \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_BOX6QUADS.labelHEIGHT \
-text "$aRtext(labelHEIGHT)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARheight "1.0"
entry .fRright.fRparameters_BOX6QUADS.entHEIGHT \
-textvariable VARheight \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_BOX6QUADS.labelDEPTH \
-text "$aRtext(labelDEPTH)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARdepth "1.0"
entry .fRright.fRparameters_BOX6QUADS.entDEPTH \
-textvariable VARdepth \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the 3 entry widgets.
pack .fRright.fRparameters_BOX6QUADS.labelWIDTH \
.fRright.fRparameters_BOX6QUADS.entWIDTH \
.fRright.fRparameters_BOX6QUADS.labelHEIGHT \
.fRright.fRparameters_BOX6QUADS.entHEIGHT \
.fRright.fRparameters_BOX6QUADS.labelDEPTH \
.fRright.fRparameters_BOX6QUADS.entDEPTH \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_BOX6QUADS]}
## FOR TESTING:
# puts "proc 'load_parameters_frame_BOX6QUADS' > Replacing curPARMframe: $curPARMframe"
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_BOX6QUADS' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_BOX6QUADS \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_BOX6QUADS"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state normal
.fRright.fRouttypes.radbuttPLY configure -state normal
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state disabled
# .fRright.fRouttypes.radbuttCADlike configure -state normal
set VARouttype "OBJ"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
## FOR TESTING:
# puts "proc 'load_parameters_frame_BOX6QUADS' > 'pack forget' and re-pack was done."
# puts "proc 'load_parameters_frame_BOX6QUADS' > curPARMframe IS: $curPARMframe"
}
## END OF proc 'load_parameters_frame_BOX6QUADS'
##+#########################################################################
## proc 'write_model_BOX6QUADS_OBJ'
##+#########################################################################
## PURPOSE: Write out a model file for 'BOX6QUADS' model type, into
## a file with 'OBJ' data format.
##
## CALLED BY: 'write_model_file' proc
##+########################################################################
## METHOD: Uses the 'puts' command to write records.
##
## Writes 'v' (vertex) and 'f' (face) records.
## For a description of the OBJ file format, see the HELPtext
## variable that is set near the bottom of this script.
##+##########################################################################
proc write_model_BOX6QUADS_OBJ {} {
global env outDIR VARwidth VARheight VARdepth VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_box6quads.obj"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open $OUTfilename w]
set CNTpoints 0
set CNTpolygons 0
## Write a heading comment record to the file.
puts $f "## BOX-6-QUADS MODEL. WIDTH: $VARwidth HEIGHT: $VARheight DEPTH: $VARdepth"
## Write 8 'v' records for the corners of the box.
puts $f "## OBJ file."
puts $f "## 8 vertex records follow."
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
## Write 6 faces (rectangles) of the box.
puts $f "##"
puts $f "## 6 face records follow (all quadrilaterals)."
incr CNTpolygons
puts $f "f 1 4 3 2" ;# back
incr CNTpolygons
puts $f "f 5 6 7 8" ;# front
incr CNTpolygons
puts $f "f 6 2 3 7" ;# right
incr CNTpolygons
puts $f "f 1 5 8 4" ;# left
incr CNTpolygons
puts $f "f 4 8 7 3" ;# top
incr CNTpolygons
puts $f "f 1 2 6 5" ;# bottom
## Write a summary of the vertex and face counts.
puts $f "## Counts for OBJ file for model BOX-6-QUADS."
puts $f "## Vertices/Points: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_BOX6QUADS_OBJ' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for OBJ file for model
BOX-6-QUADS - Points: $CNTpoints Polygons: $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_BOX6QUADS_OBJ'
##+########################################################################
## PROC 'write_model_BOX6QUADS_PLY'
##+########################################################################
## PURPOSE: Write out a model file for model-type 'BOX-6-QUADS', into
## a file with 'PLY' data format.
##
## CALLED BY: 'write_model_file' proc
##+########################################################################
## METHOD: Uses the 'puts' command to write records.
##
## For a description of the PLY file format, see the 'HELPtext'
## variable that is set near the bottom of this script.
##+###################################################################
proc write_model_BOX6QUADS_PLY {} {
global env outDIR VARwidth VARdepth VARheight VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_box6quads.ply"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open $OUTfilename w]
set CNTpoints 0
set CNTpolygons 0
## Write the PLY header records.
puts $f "ply"
puts $f "format ascii 1.0"
puts $f "comment BOX-6-QUADS MODEL. WIDTH: $VARwidth HEIGHT: $VARheight DEPTH: $VARdepth"
puts $f "element vertex 8"
puts $f "property float x"
puts $f "property float y"
puts $f "property float z"
puts $f "element face 6"
puts $f "property list uchar int vertex_indices"
puts $f "end_header"
## Write 8 points for the corners of the box.
##
## We use points: (w=VARwidth,h=VARheight,d=VARdepth)
## 1 - 0 0 0
## 2 - w 0 0
## 3 - w h 0
## 4 - 0 h 0
## 5 - 0 0 d
## 6 - w 0 d
## 7 - w h d
## 8 - 0 h d
puts $f "##"
puts $f "## PLY Vertex records follow."
incr CNTpoints
puts $f "[expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "[expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "[expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "[expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "[expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
incr CNTpoints
puts $f "[expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
incr CNTpoints
puts $f "[expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
incr CNTpoints
puts $f "[expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
## Write the PLY face records (6 rectangles).
puts $f "##"
puts $f "## PLY Face records follow."
incr CNTpolygons
puts $f "4 0 3 2 1" ;# back
incr CNTpolygons
puts $f "4 4 5 6 7" ;# front
incr CNTpolygons
puts $f "4 5 1 2 6" ;# right
incr CNTpolygons
puts $f "4 0 4 7 3" ;# left
incr CNTpolygons
puts $f "4 3 7 6 2" ;# top
incr CNTpolygons
puts $f "4 0 1 5 4" ;# bottom
## Write the vertex and face counts to the bottom of the file.
puts $f "## Counts for the PLY file for model BOX-6-QUADS."
puts $f "## Points/Vertices: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_BOX6QUADS_PLY' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for PLY file and model
BOX-6-QUADS - Points (vertices) : $CNTpoints Polygons (faces) : $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_BOX6QUADS_PLY'
##+#############################
## START OF **BOX12TRIAS GROUP**:
##+#############################
##+#########################################################################
## proc 'load_parameters_frame_BOX12TRIAS'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for a BOX.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an BOX12TRIAS-write proc for the outtype.
##
## CALLED BY: button1-release on the BOX12TRIAS model-type listbox line
##+#########################################################################
proc load_parameters_frame_BOX12TRIAS {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARwidth VARheight VARdepth VARouttype
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_BOX12TRIAS]} {
frame .fRright.fRparameters_BOX12TRIAS -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_BOX12TRIAS' frame -
## DEFINE 3 ENTRY widgets, for width,height,depth of the box
## --- along with 3 LABEL widgets.
## PACK the 6 label and entry widgets.
##+########################################################
label .fRright.fRparameters_BOX12TRIAS.labelWIDTH \
-text "BOX-12-TRIAS - $aRtext(labelWIDTH)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARwidth "1.0"
entry .fRright.fRparameters_BOX12TRIAS.entWIDTH \
-textvariable VARwidth \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_BOX12TRIAS.labelHEIGHT \
-text "$aRtext(labelHEIGHT)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARheight "1.0"
entry .fRright.fRparameters_BOX12TRIAS.entHEIGHT \
-textvariable VARheight \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_BOX12TRIAS.labelDEPTH \
-text "$aRtext(labelDEPTH)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARdepth "1.0"
entry .fRright.fRparameters_BOX12TRIAS.entDEPTH \
-textvariable VARdepth \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the 3 entry widgets.
pack .fRright.fRparameters_BOX12TRIAS.labelWIDTH \
.fRright.fRparameters_BOX12TRIAS.entWIDTH \
.fRright.fRparameters_BOX12TRIAS.labelHEIGHT \
.fRright.fRparameters_BOX12TRIAS.entHEIGHT \
.fRright.fRparameters_BOX12TRIAS.labelDEPTH \
.fRright.fRparameters_BOX12TRIAS.entDEPTH \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_BOX12TRIAS]}
## FOR TESTING:
# puts "proc 'load_parameters_frame_BOX12TRIAS' > Replacing curPARMframe: $curPARMframe"
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_BOX12TRIAS' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_BOX12TRIAS \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_BOX12TRIAS"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state disabled
.fRright.fRouttypes.radbuttPLY configure -state normal
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state normal
# .fRright.fRouttypes.radbuttCADlike configure -state normal
set VARouttype "PLY"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
## FOR TESTING:
# puts "proc 'load_parameters_frame_BOX12TRIAS' > 'pack forget' and re-pack was done."
# puts "proc 'load_parameters_frame_BOX12TRIAS' > curPARMframe IS: $curPARMframe"
}
## END OF proc 'load_parameters_frame_BOX12TRIAS'
##+########################################################################
## PROC 'write_model_BOX12TRIAS_PLY'
##+########################################################################
## PURPOSE: Write out a model file for model-type 'BOX12TRIAS'--- a surface
## made of 12 triangles --- in a file with Cyberware '.ply' data format.
##
## CALLED BY: 'write_model_file' proc
##+########################################################################
## METHOD: Uses the 'puts' command to write records.
##
## Writes vertex and face records to make a Cyberware '.ply' file.
## For a description of the PLY file format, see the 'HELPtext'
## variable that is set near the bottom of this script.
##+###################################################################
proc write_model_BOX12TRIAS_PLY {} {
global env outDIR VARwidth VARdepth VARheight VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_box12trias.ply"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open $OUTfilename w]
set CNTpoints 0
set CNTpolygons 0
## Write the PLY header records.
puts $f "ply"
puts $f "format ascii 1.0"
puts $f "comment BOX-12-TRIAS MODEL. WIDTH: $VARwidth HEIGHT: $VARheight DEPTH: $VARdepth"
puts $f "element vertex 8"
puts $f "property float x"
puts $f "property float y"
puts $f "property float z"
puts $f "element face 12"
puts $f "property list uchar int vertex_indices"
puts $f "end_header"
## Write 8 points for the corners of the box.
##
## We use points: (w=VARwidth,h=VARheight,d=VARdepth)
## 1 - 0 0 0
## 2 - w 0 0
## 3 - w h 0
## 4 - 0 h 0
## 5 - 0 0 d
## 6 - w 0 d
## 7 - w h d
## 8 - 0 h d
puts $f "##"
puts $f "## PLY Vertex records follow."
incr CNTpoints
puts $f "[expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "[expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "[expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "[expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "[expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
incr CNTpoints
puts $f "[expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
incr CNTpoints
puts $f "[expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
incr CNTpoints
puts $f "[expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
## Write PLY face records.
puts $f "##"
puts $f "## PLY Face records follow (all triangles)."
## For faces, we use triangles made from the points as follows:
## (We convert base 1 to base 0.)
## 1 - 1 3 2 -> 0 2 1
## 2 - 1 4 3 -> 0 3 2
## 3 - 5 6 7 -> 4 5 6
## 4 - 5 7 8 -> 4 6 7
## 5 - 6 2 3 -> 5 1 2
## 6 - 6 3 7 -> 5 2 6
## 7 - 5 8 4 -> 4 7 3
## 8 - 5 4 1 -> 4 3 0
## 9 - 4 8 7 -> 3 7 6
## 10 - 4 7 3 -> 3 6 2
## 11 - 1 2 6 -> 0 1 5
## 12 - 1 6 5 -> 0 5 4
incr CNTpolygons
puts $f "3 0 2 1"
incr CNTpolygons
puts $f "3 0 3 2"
incr CNTpolygons
puts $f "3 4 5 6"
incr CNTpolygons
puts $f "3 4 6 7"
incr CNTpolygons
puts $f "3 5 1 2"
incr CNTpolygons
puts $f "3 5 2 6"
incr CNTpolygons
puts $f "3 4 7 3"
incr CNTpolygons
puts $f "3 4 3 0"
incr CNTpolygons
puts $f "3 3 7 6"
incr CNTpolygons
puts $f "3 3 6 2"
incr CNTpolygons
puts $f "3 0 1 5"
incr CNTpolygons
puts $f "3 0 5 4"
## Write the vertex and face counts to the bottom of the file.
puts $f "## Counts for PLY file of model BOX-12-TRIAS."
puts $f "## Points/Vertices: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_BOX12TRIAS_PLY' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for PLY file and model
BOX-12-TRIAS - Points (vertices) : $CNTpoints Polygons (faces) : $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_BOX12TRIAS_PLY'
##+########################################################################
## PROC 'write_model_BOX12TRIAS_STL'
##+########################################################################
## PURPOSE: Write out a model file for model-type 'BOX-12-TRIAS' --- a file
## with 'ASCII STL' (stereolithography) data format.
##
## CALLED BY: 'write_model_file' proc
##+########################################################################
## METHOD: Uses the Tcl 'puts' command to write records.
## The format of STL files is very simple.
## See a decription of the format in the 'HELPtext' variable
## that is set near the bottom of this script.
##+########################################################################
proc write_model_BOX12TRIAS_STL {} {
global env outDIR VARwidth VARdepth VARheight VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_box12trias.stl"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open $OUTfilename w]
set CNTpoints 0
set CNTpolygons 0
## Write the top record of the STL file
puts $f "solid BOX-12-TRIAS WIDTH: $VARwidth HEIGHT: $VARheight DEPTH: $VARdepth ; ASCII STL FILE ; 'facet normals' are simply set to 1,0,0"
## Write the facet-groups of records for each of 12 triangles
## making up the faces of the box. Each group looks like:
##
## facet normal 1.0 0.0 0.0
## outer loop
## vertex 0.0 0.0 0.0
## vertex 1.0 1.0 0.0
## vertex 1.0 0.0 0.0
## endloop
## endfacet
##
## We do not determine the normal. We simply put '1.0 0.0 0.0'
## as the values for each normal. There are programs like 'admesh'
## that can go through an STL file and correct the normals ---
## giving them an orientation corresponding to the specification
## of the 3 vertices.
##
## We use points: (w=VARwidth,h=VARheight,d=VARdepth)
## 1 - 0 0 0
## 2 - w 0 0
## 3 - w h 0
## 4 - 0 h 0
## 5 - 0 0 d
## 6 - w 0 d
## 7 - w h d
## 8 - 0 h d
## We use triangles made from the points as follows:
## 1 - 1 3 2
## 2 - 1 4 3
## 3 - 5 6 7
## 4 - 5 7 8
## 5 - 6 2 3
## 6 - 6 3 7
## 7 - 5 8 4
## 8 - 5 4 1
## 9 - 4 8 7
## 10 - 4 7 3
## 11 - 1 2 6
## 12 - 1 6 5
## Facet1:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet2:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet3:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet4:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet5:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet6:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet7:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet8:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet9:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet10:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {$VARheight + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpoints 3
incr CNTpolygons
## Facet11:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Facet12:
puts $f "facet normal 1.0 0.0 0.0"
puts $f " outer loop"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
puts $f " vertex [expr {$VARwidth + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " vertex [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARdepth + $VARtranz}]"
puts $f " end loop"
puts $f "endfacet"
incr CNTpolygons
## Write the last record of the STL file
puts $f "endsolid BOX-12-TRIAS Facets (triangles) : $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_BOX_STL' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for STL file and model
BOX-12-TRIAS - Polygons (facets, triangles) : $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_BOX12TRIAS_STL'
##+#############################
## START OF **CONEnTRIAS GROUP**:
##+#############################
##+#########################################################################
## proc 'load_parameters_frame_CONEnTRIAS'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for a
## CONEnTRIAS model.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an CONEnTRIAS-write proc for the outtype.
##
## CALLED BY: button1-release on the CONE-N-TRIAS model-type listbox line
##+#########################################################################
proc load_parameters_frame_CONEnTRIAS {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARradius VARheight VARnumTriaSides
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_CONEnTRIAS]} {
frame .fRright.fRparameters_CONEnTRIAS -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_CONEnTRIAS' frame -
## DEFINE 3 ENTRY widgets, for radius,height,numTriaSides of
## the cone --- along with 3 LABEL widgets.
## PACK the 6 widgets --- labels and entry widgets.
##+########################################################
label .fRright.fRparameters_CONEnTRIAS.labelRADIUS \
-text "CONE-N-TRIAS - $aRtext(labelRADIUS)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARradius "1.0"
entry .fRright.fRparameters_CONEnTRIAS.entRADIUS \
-textvariable VARradius \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_CONEnTRIAS.labelHEIGHT \
-text "$aRtext(labelHEIGHT)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARheight "1.4"
entry .fRright.fRparameters_CONEnTRIAS.entHEIGHT \
-textvariable VARheight \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_CONEnTRIAS.labelNUMtriaSides \
-text " Number of Triangular Sides:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARnumTriaSides "20"
entry .fRright.fRparameters_CONEnTRIAS.entNUMtriaSides \
-textvariable VARnumTriaSides \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the 3 entry widgets.
pack .fRright.fRparameters_CONEnTRIAS.labelRADIUS \
.fRright.fRparameters_CONEnTRIAS.entRADIUS \
.fRright.fRparameters_CONEnTRIAS.labelHEIGHT \
.fRright.fRparameters_CONEnTRIAS.entHEIGHT \
.fRright.fRparameters_CONEnTRIAS.labelNUMtriaSides \
.fRright.fRparameters_CONEnTRIAS.entNUMtriaSides \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_CONEnTRIAS]}
## FOR TESTING:
# puts "proc 'load_parameters_frame_CONEnTRIAS' > Replacing curPARMframe: $curPARMframe"
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_CONEnTRIAS' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_CONEnTRIAS \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_CONEnTRIAS"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state normal
.fRright.fRouttypes.radbuttPLY configure -state disabled
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state disabled
# .fRright.fRouttypes.radbuttCADlike configure -state normal
set VARouttype "OBJ"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
## FOR TESTING:
# puts "proc 'load_parameters_frame_CONEnTRIAS' > 'pack forget' and re-pack was done."
# puts "proc 'load_parameters_frame_CONEnTRIAS' > curPARMframe IS: $curPARMframe"
}
## END OF proc 'load_parameters_frame_CONEnTRIAS'
##+#########################################################################
## proc 'write_model_CONEnTRIAS_OBJ'
##+#########################################################################
## PURPOSE: Write out a model file for 'CONEnTRIAS' model type, into
## a file with 'OBJ' data format.
##
## CALLED BY: 'write_model_file' proc
##+########################################################################
proc write_model_CONEnTRIAS_OBJ {} {
global env outDIR twopi TOLfactor VARradius VARheight VARnumTriaSides \
VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_CONEnTRIAS.obj"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open $OUTfilename w]
set CNTpoints 0
set CNTpolygons 0
## Write a heading comment records to the file.
puts $f "## CONE: $VARnumTriaSides-TRIANGULAR SIDES MODEL. NO BOTTOM POLYGONS."
puts $f "## RADIUS: $VARradius HEIGHT: $VARheight NUMtriaSides: $VARnumTriaSides"
## Write ($VARnumTriaSides + 1) 'v' vertex records for the cone.
puts $f "## OBJ file."
puts $f "## [expr {$VARnumTriaSides + 1}] vertex records follow."
## We could set the number of significant digits of precision
## (for the xyz values written to the file) here.
# set tcl_precision 5
## Assure that VARradius is not an integer or string,
## for speed in the following calculations.
set VARradius [expr {double($VARradius)}]
## Set a 'zero tolerance' for setting very small xyz coords to zero.
set TOLzero [expr {double($TOLfactor) * $VARradius}]
## Set angle increment, in radians.
set deltaANG [expr {double($twopi / $VARnumTriaSides)}]
## Write the top vertex record for the peak of the cone (vertex 1).
puts $f "##"
puts $f "## Vertex at peak of the cone."
puts $f "##"
puts $f "v 0.0 0.0 $VARheight"
incr CNTpoints
## Write $VARnumTriaSides vertex records for the bottom of the cone.
puts $f "##"
puts $f "## Start of $VARnumTriaSides vertices on 'bottom' of cone."
puts $f "##"
for {set n 0} {$n < $VARnumTriaSides} {incr n} {
set ang [expr {double($deltaANG * $n)}]
set x [expr {$VARradius * cos($ang)}]
set y [expr {$VARradius * sin($ang)}]
set newx [expr {$x + $VARtranx}]
set newy [expr {$y + $VARtrany}]
set xabs [expr {abs($newx)}]
set yabs [expr {abs($newy)}]
if {$xabs < $TOLzero} {set newx 0.0}
if {$yabs < $TOLzero} {set newy 0.0}
## FOR TESTING:
# puts "proc 'write_model_CONEnTRIAS_OBJ' > TOLzero: $TOLzero newx: $newx xabs: $xabs newy: $newy yabs: $yabs"
puts $f "v $newx $newy 0.0"
incr CNTpoints
}
## END OF vertex loop (for points on 'bottom' of the cone)
## Write face records (triangles) for the cone.
puts $f "##"
puts $f "## $VARnumTriaSides face records follow (all triangles)."
## This loop writes '1 2 3' '1 3 4' ... '1 N N+1'
for {set n 1} {$n < $VARnumTriaSides} {incr n} {
## In each face record, we user vertex 1 (the peak of the cone) and
## 2 points from the bottom of the cone, to make each triangle.
## We place them in a 'counter-clockwise' order. So the 1st rtriangle is
## 2 1 N+1 N+2 :
## 1
## |\
## | \
## | \
## 2 ____ 3 ... N
##
puts $f "f 1 [expr {$n + 1}] [expr {$n + 2}]"
incr CNTpolygons
}
## END OF vertices loop over n
## Write the last face record: '1 N+1 2'
puts $f "f 1 [expr {$VARnumTriaSides + 1}] 2"
incr CNTpolygons
## Write a summary of the vertex and face counts.
puts $f "## Counts for OBJ file for model CONE-N-TRIAS."
puts $f "## Vertices/Points: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_CONEnTRIAS_OBJ' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for OBJ file for model
CONE-N-TRIAS - Points: $CNTpoints Polygons: $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_CONEnTRIAS_OBJ'
##+#############################
## START OF **CYLnQUADS GROUP**:
##+#############################
##+#########################################################################
## proc 'load_parameters_frame_CYLnQUADS'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for a
## CYLnQUADS.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an CYLnQUADS-write proc for the outtype.
##
## CALLED BY: button1-release on the CYL-N-QUADS model-type listbox line
##+#########################################################################
proc load_parameters_frame_CYLnQUADS {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARradius VARheight VARnumQuadSides
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_CYLnQUADS]} {
frame .fRright.fRparameters_CYLnQUADS -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_CYLnQUADS' frame -
## DEFINE 3 ENTRY widgets, for radius,height,numQuadSides of
## the cylinder --- along with 3 LABEL widgets.
## PACK the 6 widgets --- labels and entry widgets.
##+########################################################
label .fRright.fRparameters_CYLnQUADS.labelRADIUS \
-text "CYL-N-QUADS - $aRtext(labelRADIUS)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARradius "1.0"
entry .fRright.fRparameters_CYLnQUADS.entRADIUS \
-textvariable VARradius \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_CYLnQUADS.labelHEIGHT \
-text "$aRtext(labelHEIGHT)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARheight "1.0"
entry .fRright.fRparameters_CYLnQUADS.entHEIGHT \
-textvariable VARheight \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_CYLnQUADS.labelNUMquadSides \
-text " Number of Quadrilateral Sides:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARnumQuadSides "20"
entry .fRright.fRparameters_CYLnQUADS.entNUMquadSides \
-textvariable VARnumQuadSides \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the 3 entry widgets.
pack .fRright.fRparameters_CYLnQUADS.labelRADIUS \
.fRright.fRparameters_CYLnQUADS.entRADIUS \
.fRright.fRparameters_CYLnQUADS.labelHEIGHT \
.fRright.fRparameters_CYLnQUADS.entHEIGHT \
.fRright.fRparameters_CYLnQUADS.labelNUMquadSides \
.fRright.fRparameters_CYLnQUADS.entNUMquadSides \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_CYLnQUADS]}
## FOR TESTING:
# puts "proc 'load_parameters_frame_CYLnQUADS' > Replacing curPARMframe: $curPARMframe"
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_CYLnQUADS' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_CYLnQUADS \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_CYLnQUADS"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state normal
.fRright.fRouttypes.radbuttPLY configure -state disabled
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state disabled
# .fRright.fRouttypes.radbuttCADlike configure -state normal
set VARouttype "OBJ"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
## FOR TESTING:
# puts "proc 'load_parameters_frame_CYLnQUADS' > 'pack forget' and re-pack was done."
# puts "proc 'load_parameters_frame_CYLnQUADS' > curPARMframe IS: $curPARMframe"
}
## END OF proc 'load_parameters_frame_CYLnQUADS'
##+#########################################################################
## proc 'write_model_CYLnQUADS_OBJ'
##+#########################################################################
## PURPOSE: Write out a model file for 'CYLnQUADS' model type, into
## a file with 'OBJ' data format.
##
## CALLED BY: 'write_model_file' proc
##+########################################################################
proc write_model_CYLnQUADS_OBJ {} {
global env outDIR twopi TOLfactor VARradius VARheight VARnumQuadSides \
VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_CYLnQUADS.obj"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open $OUTfilename w]
set CNTpoints 0
set CNTpolygons 0
## Write a heading comment records to the file.
puts $f "## CYLINDER: $VARnumQuadSides-QUADRILATERAL SIDES MODEL. NO TOP OR BOTTOM POLYGONS."
puts $f "## RADIUS: $VARradius HEIGHT: $VARheight NUMquadSides: $VARnumQuadSides"
## Write (2 * $VARnumQuadSides) 'v' vertex records for the cylinder.
puts $f "## OBJ file."
puts $f "## [expr {2 * $VARnumQuadSides}] vertex records follow."
## We could set the number of significant digits of precision
## (for the xyz values written to the file) here.
# set tcl_precision 5
## Assure that VARradius is not an integer or string,
## for speed in the following calculations.
set VARradius [expr {double($VARradius)}]
## Set a 'zero tolerance' for setting very small xyz coords to zero.
set TOLzero [expr {double($TOLfactor) * $VARradius}]
## Set angle increment, in radians.
set deltaANG [expr {double($twopi / $VARnumQuadSides)}]
## Set half-height value.
set h [expr {double($VARheight) / 2.0}]
## Write vertex records for one end of the cylinder.
puts $f "##"
puts $f "## Start of points on 'top' of cylinder."
puts $f "##"
for {set n 0} {$n < $VARnumQuadSides} {incr n} {
set ang [expr {double($deltaANG * $n)}]
set x [expr {$VARradius * cos($ang)}]
set y [expr {$VARradius * sin($ang)}]
set newx [expr {$x + $VARtranx}]
set newy [expr {$y + $VARtrany}]
set xabs [expr {abs($newx)}]
set yabs [expr {abs($newy)}]
if {$xabs < $TOLzero} {set newx 0.0}
if {$yabs < $TOLzero} {set newy 0.0}
## FOR TESTING:
# puts "proc 'write_model_CYLnQUADS_OBJ' > TOLzero: $TOLzero newx: $newx xabs: $xabs newy: $newy yabs: $yabs"
puts $f "v $newx $newy [expr {$h + $VARtranz}]"
incr CNTpoints
}
## END OF first vertex loop (for points on 'top' of the cylinder)
## Write vertex records for the other end of the cylinder.
puts $f "##"
puts $f "## Start of points on 'bottom' of cylinder."
puts $f "##"
set h [expr {-$h}]
for {set n 0} {$n < $VARnumQuadSides} {incr n} {
set ang [expr {double($deltaANG * $n)}]
set x [expr {$VARradius * cos($ang)}]
set y [expr {$VARradius * sin($ang)}]
set newx [expr {$x + $VARtranx}]
set newy [expr {$y + $VARtrany}]
set xabs [expr {abs($newx)}]
set yabs [expr {abs($newy)}]
if {$xabs < $TOLzero} {set newx 0.0}
if {$yabs < $TOLzero} {set newy 0.0}
puts $f "v $newx $newy [expr {$h + $VARtranz}]"
incr CNTpoints
}
## END OF second vertex loop (for points on 'bottom' of the cylinder)
## Write face records (rectangles) for the cylinder.
puts $f "##"
puts $f "## $VARnumQuadSides face records follow (all rectangles)."
for {set n 1} {$n < $VARnumQuadSides} {incr n} {
## In each face record, we put 2 points from the top and 2 corresponding
## points from the bottom of the cylinder, to make each rectangle.
## We place them in a 'counter-clockwise' order. So the 1st rectangle is
## 2 1 N+1 N+2 :
## 1 ________ 2 3 ... N
## | |
## | |
## N+1 ________ N+2 N+3 ... 2*N
##
puts $f "f [expr {$n + 1}] $n [expr {$VARnumQuadSides + $n}] [expr {$VARnumQuadSides + $n + 1}]"
incr CNTpolygons
}
## END OF vertices loop over n
## Write the last face record: N 1 2*N N+1
puts $f "f 1 $VARnumQuadSides [expr {int(2 * $VARnumQuadSides)}] [expr {$VARnumQuadSides + 1}]"
incr CNTpolygons
## Write a summary of the vertex and face counts.
puts $f "## Counts for OBJ file for model CYL-N-QUADS (cylinder)."
puts $f "## Vertices/Points: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_CYLnQUADS_OBJ' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for OBJ file for model
CYL-N-QUADS - Points: $CNTpoints Polygons: $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_CYLnQUADS_OBJ'
##+###############################
## START OF **ICOSA20TRIAS GROUP**:
##+###############################
##+#########################################################################
## proc 'load_parameters_frame_ICOSA20TRIAS'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for a
## ICOSAHEDRON.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an ICOSAHEDRON-write proc for the outtype.
##
## CALLED BY: button1-release on the ICOSAHEDRON model-type listbox line
##
## Reference: OpenGL Programming Guide, Chapter 2, Drawing
## Geometric Objects
##+#########################################################################
proc load_parameters_frame_ICOSA20TRIAS {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARx VARz VARouttype
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_ICOSA20TRIAS]} {
frame .fRright.fRparameters_ICOSA20TRIAS -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_ICOSA20TRIAS' frame -
## DEFINE 2 ENTRY widgets, for 'X' and 'Z'
## --- along with 2 LABEL widgets.
## PACK the 4 label and entry widgets.
##+########################################################
label .fRright.fRparameters_ICOSA20TRIAS.labelX \
-text "ICOSA-20-TRIAS - X:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARx "0.525731"
entry .fRright.fRparameters_ICOSA20TRIAS.entX \
-textvariable VARx \
-font fontTEMP_fixedwidth \
-width 10 \
-bg $BKGD_entry \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_ICOSA20TRIAS.labelZ \
-text "Z:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARz "0.850651"
entry .fRright.fRparameters_ICOSA20TRIAS.entZ \
-textvariable VARz \
-font fontTEMP_fixedwidth \
-width 10 \
-bg $BKGD_entry \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the 2 entry widgets, with labels.
pack .fRright.fRparameters_ICOSA20TRIAS.labelX \
.fRright.fRparameters_ICOSA20TRIAS.entX \
.fRright.fRparameters_ICOSA20TRIAS.labelZ \
.fRright.fRparameters_ICOSA20TRIAS.entZ \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_ICOSA20TRIAS]}
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_ICOSA20TRIAS' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_ICOSA20TRIAS \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_ICOSA20TRIAS"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state normal
.fRright.fRouttypes.radbuttPLY configure -state disabled
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state disabled
# .fRright.fRouttypes.radbuttCADlike configure -state normal
set VARouttype "OBJ"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
}
## END OF proc 'load_parameters_frame_ICOSA20TRIAS'
##+#########################################################################
## proc 'write_model_ICOSA20TRIAS_OBJ'
##+#########################################################################
## PURPOSE: Write out a model file for model-type 'ICOSA-20-TRIAS' (12 vertices,
## 20 triangular faces) --- to a file with 'OBJ' data format.
##
## CALLED BY: 'write_model_file' proc when 'WriteFile' button is clicked.
##+########################################################################
## METHOD: Uses the 'puts' command to write records.
##
## For a description of some of the output file formats,
## see the 'HELPtext' variable near the bottom of this script
##+##########################################################################
proc write_model_ICOSA20TRIAS_OBJ {} {
global env outDIR VARx VARz VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_icosa20trias.obj"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open $OUTfilename w]
set CNTpoints 0
set CNTpolygons 0
## Write a heading comment record to the file.
puts $f "## 'ICOSA-20-TRIAS' ICOSAHEDRON MODEL. X: $VARx Z: $VARz"
puts $f "## Reference: OpenGL Programming Guide, Chapter 2, Drawing Geometric Objects"
puts $f "## OBJ file."
puts $f "## 'v' (vertex) records follow."
set VARminusx [expr {-$VARx}]
set VARminusz [expr {-$VARz}]
incr CNTpoints
puts $f "v [expr {$VARminusx + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARz + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARx + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARz + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARminusx + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARminusz + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARx + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARminusz + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {$VARz + $VARtrany}] [expr {$VARx + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {$VARz + $VARtrany}] [expr {$VARminusx + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {$VARminusz + $VARtrany}] [expr {$VARx + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {$VARminusz + $VARtrany}] [expr {$VARminusx + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARz + $VARtranx}] [expr {$VARx + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARminusz + $VARtranx}] [expr {$VARx + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARz + $VARtranx}] [expr {$VARminusx + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARminusz + $VARtranx}] [expr {$VARminusx + $VARtrany}] [expr {0.0 + $VARtranz}]"
## Write 20 faces (triangles) of the icosahedron.
## OBJ FACE RECORD FORMAT:
## f pointNUM1 pointNUM2 pointNUM3 ...
## NOTE: These indexes of the points are based at zero, not one.
puts $f "##"
puts $f "## 'f' (face) OBJ records follow."
incr CNTpolygons
puts $f "f 1 5 2"
incr CNTpolygons
puts $f "f 1 10 5"
incr CNTpolygons
puts $f "f 10 6 5"
incr CNTpolygons
puts $f "f 5 6 9"
incr CNTpolygons
puts $f "f 5 9 2"
incr CNTpolygons
puts $f "f 9 11 2"
incr CNTpolygons
puts $f "f 9 4 11"
incr CNTpolygons
puts $f "f 6 4 9"
incr CNTpolygons
puts $f "f 6 3 4"
incr CNTpolygons
puts $f "f 3 8 4"
incr CNTpolygons
puts $f "f 8 11 4"
incr CNTpolygons
puts $f "f 8 7 11"
incr CNTpolygons
puts $f "f 8 12 7"
incr CNTpolygons
puts $f "f 12 1 7"
incr CNTpolygons
puts $f "f 1 2 7"
incr CNTpolygons
puts $f "f 7 2 11"
incr CNTpolygons
puts $f "f 10 1 12"
incr CNTpolygons
puts $f "f 10 12 3"
incr CNTpolygons
puts $f "f 10 3 6"
incr CNTpolygons
puts $f "f 8 3 12"
## Write a summary of the vertex and face counts.
puts $f "## Counts for OBJ file for model ICOSA-20-TRIAS (icosahedron)."
puts $f "## Vertices/Points: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_ICOSA20TRIAS_OBJ' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for OBJ file and model
ICOSA-20-TRIAS - Points: $CNTpoints Polygons: $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_ICOSA20TRIAS_OBJ'
##+####################################
## START OF **OCTA8TRIAS GROUP**:
##+####################################
##+#########################################################################
## proc 'load_parameters_frame_OCTA8TRIAS'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for an
## OCTA8TRIAS model.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an OCTA8TRIAS-write proc for the outtype.
##
## CALLED BY: button1-release on the OCTA-8-TRIAS model-type listbox line
##+#########################################################################
proc load_parameters_frame_OCTA8TRIAS {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARlength VARheight VARouttype
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_OCTA8TRIAS]} {
frame .fRright.fRparameters_OCTA8TRIAS -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_OCTA8TRIAS' frame -
## DEFINE 2 ENTRY widgets, for length of sides of the
## square in the middle and for height of the 2 pyramids above
## and below that square --- along with 2 LABEL widgets.
## PACK the label and entry widgets.
##+########################################################
label .fRright.fRparameters_OCTA8TRIAS.labelLENGTH \
-text "OCTA-8-TRIAS - LengthOfSidesOfSquareInMiddle:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARlength "1.0"
entry .fRright.fRparameters_OCTA8TRIAS.entLENGTH \
-textvariable VARlength \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_OCTA8TRIAS.labelHEIGHT \
-text "HeightOfTwoPyramids,EachSideOfSquare:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARheight "1.4"
entry .fRright.fRparameters_OCTA8TRIAS.entHEIGHT \
-textvariable VARheight \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the entry widget and its label.
pack .fRright.fRparameters_OCTA8TRIAS.labelLENGTH \
.fRright.fRparameters_OCTA8TRIAS.entLENGTH \
.fRright.fRparameters_OCTA8TRIAS.labelHEIGHT \
.fRright.fRparameters_OCTA8TRIAS.entHEIGHT \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_OCTA8TRIAS]}
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_OCTA8TRIAS' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_OCTA8TRIAS \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_OCTA8TRIAS"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state normal
.fRright.fRouttypes.radbuttPLY configure -state disabled
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state disabled
# .fRright.fRouttypes.radbuttCADlike configure -state disabled
set VARouttype "OBJ"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
## FOR TESTING:
# puts "proc 'load_parameters_frame_OCTA8TRIAS' > 'pack forget' and re-pack was done."
# puts "proc 'load_parameters_frame_OCTA8TRIAS' > curPARMframe IS: $curPARMframe"
}
## END OF proc 'load_parameters_frame_OCTA8TRIAS'
##+#########################################################################
## proc 'write_model_OCTA8TRIAS_OBJ'
############################################################################
## PURPOSE: Write out a model file for 'OCTA8TRIAS' model type, into
## a file with 'OBJ' data format.
##
## CALLED BY: 'write_model_file' proc
###########################################################################
proc write_model_OCTA8TRIAS_OBJ {} {
global env outDIR VARlength VARheight VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_OCTA8TRIAS.obj"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open "$OUTfilename" w]
set CNTpoints 0
set CNTpolygons 0
## Write a heading comment record to the file.
puts $f "## OCTAHEDRON MODEL: 8 TRIANGLES, 4 above and 4 below a square base."
puts $f "## Length of sides of the square: $VARlength Height of the 2 pyramids above and below the square: $VARheight"
## Write 6 'v' records for the 6 points of the octahedron.
puts $f "## OBJ file."
puts $f "## 6 vertex records follow (1 top and 1 bottom vertex and 4 vertices of the mid-square)."
## Top vertex (vertex 1):
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARheight + $VARtranz}]"
## Bottom vertex (vertex 2):
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {-$VARheight + $VARtranz}]"
set half [expr {$VARlength / 2.0}]
## Four vertices of square (vertices 3,4,5,6):
incr CNTpoints
puts $f "v [expr {$half + $VARtranx}] [expr {$half + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {-$half + $VARtranx}] [expr {$half + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {-$half + $VARtranx}] [expr {-$half + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$half + $VARtranx}] [expr {-$half + $VARtrany}] [expr {0.0 + $VARtranz}]"
## Write 8 faces of the pyramid.
puts $f "##"
puts $f "## 8 face records follow (4 triangles for the top, then 4 triangles for the bottom)."
## The top 4 triangles:
incr CNTpolygons
puts $f "f 1 3 4"
incr CNTpolygons
puts $f "f 1 4 5"
incr CNTpolygons
puts $f "f 1 5 6"
incr CNTpolygons
puts $f "f 1 6 3"
## The bottom 4 triangles:
incr CNTpolygons
puts $f "f 2 6 5"
incr CNTpolygons
puts $f "f 2 5 4"
incr CNTpolygons
puts $f "f 2 4 3"
incr CNTpolygons
puts $f "f 2 3 6"
## Write a summary of the vertex and face counts.
puts $f "## Counts for OBJ file for model OCTA-8-TRIAS (octahedron)."
puts $f "## Vertices/Points: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_OCTA8TRIAS_OBJ' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for OBJ file for model
OCTA-8-TRIAS - Points: $CNTpoints Polygons: $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_OCTA8TRIAS_OBJ'
##+####################################
## START OF **PRISM2TRIAS3QUADS GROUP**:
##+####################################
##+#########################################################################
## proc 'load_parameters_frame_PRISM2TRIAS3QUADS'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for a
## PRISM2TRIAS3QUADS model.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an PRISM2TRIAS3QUADS-write proc for the outtype.
##
## CALLED BY: button1-release on the PRISM-2TRIAS-3QUADS model-type listbox line
##+#########################################################################
proc load_parameters_frame_PRISM2TRIAS3QUADS {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARlength VARradius VARouttype
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_PRISM2TRIAS3QUADS]} {
frame .fRright.fRparameters_PRISM2TRIAS3QUADS -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_PRISM2TRIAS3QUADS' frame -
## DEFINE 2 ENTRY widgets, for length of the quads of the
## prism and a 'radius' for the size of the triangular end-caps
## --- along with 2 LABEL widgets.
## PACK the label and entry widgets.
##+########################################################
label .fRright.fRparameters_PRISM2TRIAS3QUADS.labelLENGTH \
-text "PRISM-2-TRIAS-3-QUADS - Length of quads:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARlength "4.0"
entry .fRright.fRparameters_PRISM2TRIAS3QUADS.entLENGTH \
-textvariable VARlength \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_PRISM2TRIAS3QUADS.labelRADIUS \
-text "Radius of equilateral triangular end-caps:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARradius "1.0"
entry .fRright.fRparameters_PRISM2TRIAS3QUADS.entRADIUS \
-textvariable VARradius \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the entry widget and its label.
pack .fRright.fRparameters_PRISM2TRIAS3QUADS.labelLENGTH \
.fRright.fRparameters_PRISM2TRIAS3QUADS.entLENGTH \
.fRright.fRparameters_PRISM2TRIAS3QUADS.labelRADIUS \
.fRright.fRparameters_PRISM2TRIAS3QUADS.entRADIUS \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_PRISM2TRIAS3QUADS]}
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_PRISM2TRIAS3QUADS' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_PRISM2TRIAS3QUADS \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_PRISM2TRIAS3QUADS"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state normal
.fRright.fRouttypes.radbuttPLY configure -state disabled
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state disabled
# .fRright.fRouttypes.radbuttCADlike configure -state disabled
set VARouttype "OBJ"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
## FOR TESTING:
# puts "proc 'load_parameters_frame_PRISM2TRIAS3QUADS' > 'pack forget' and re-pack was done."
# puts "proc 'load_parameters_frame_PRISM2TRIAS3QUADS' > curPARMframe IS: $curPARMframe"
}
## END OF proc 'load_parameters_frame_PRISM2TRIAS3QUADS'
##+#########################################################################
## proc 'write_model_PRISM2TRIAS3QUADS_OBJ'
############################################################################
## PURPOSE: Write out a model file for 'PRISM2TRIAS3QUADS' model type, into
## a file with 'OBJ' data format.
##
## CALLED BY: 'write_model_file' proc
###########################################################################
proc write_model_PRISM2TRIAS3QUADS_OBJ {} {
global env outDIR VARlength VARradius pi VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_PRISM2TRIAS3QUADS.obj"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open "$OUTfilename" w]
set CNTpoints 0
set CNTpolygons 0
## Write a heading comment record to the file.
puts $f "## PRISM MODEL: 2 TRIANGULAR END-CAPS and 3 RECTANGLES connecting the triangles."
puts $f "## There are 6 vertices. They are located on the 2 triangles."
puts $f "## Length of the 3 rectangles: $VARlength 'Radius' of the 2 triangles, r: $VARradius"
puts $f "##"
puts $f "## We let the axis of the prism coincide with the x-axis, with midpoint of prism at the origin."
puts $f "## We let the peak of the prism be directly above the x-axis."
puts $f "## We let positive z be up."
puts $f "## Then the 2 points on the peak of the prism are the radius, r, above the x-axis in the z direction."
puts $f "## The other 4 points, on the base of the prism, are r * sin(30 degrees) below the x-axis, in the minus z direction."
## Write 6 'v' records for the 6 points of the prism.
puts $f "## OBJ file."
puts $f "## 6 vertex records follow (2 peak vertices: vertices 1 and 2, then the 4 vertices of the rectangular base)."
set hbelow [expr {-$VARradius * sin($pi / 6.0)}]
set halflen [expr {$VARlength / 2.0}]
set halfrad [expr {$VARradius / 2.0}]
## Peak points (vertex 1 and vertex 2):
incr CNTpoints
puts $f "v [expr {$halflen + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARradius + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {-$halflen + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARradius + $VARtranz}]"
## Four base points (vertices 3,4,5,6):
incr CNTpoints
puts $f "v [expr {$halflen + $VARtranx}] [expr {$halfrad + $VARtrany}] [expr {$hbelow + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$halflen + $VARtranx}] [expr {-$halfrad + $VARtrany}] [expr {$hbelow + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {-$halflen + $VARtranx}] [expr {-$halfrad + $VARtrany}] [expr {$hbelow + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {-$halflen + $VARtranx}] [expr {$halfrad + $VARtrany}] [expr {$hbelow + $VARtranz}]"
## Write 5 faces of the pyramid.
puts $f "##"
puts $f "## 5 face records follow (2 triangles, then 3 rectangles)."
## The 2 triangles:
incr CNTpolygons
puts $f "f 1 4 3"
incr CNTpolygons
puts $f "f 2 6 5"
## The 3 rectangles:
incr CNTpolygons
puts $f "f 3 6 5 4"
incr CNTpolygons
puts $f "f 2 5 4 1"
incr CNTpolygons
puts $f "f 6 2 1 3"
## Write a summary of the vertex and face counts.
puts $f "## Counts for OBJ file for model PRISM-2-TRIAS-3-QUADS."
puts $f "## Vertices/Points: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_PRISM2TRIAS3QUADS_OBJ' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for OBJ file for model
PRISM-2-TRIAS-3-QUADS - Points: $CNTpoints Polygons: $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_PRISM2TRIAS3QUADS_OBJ'
##+##################################
## START OF ** PYR4TRIAS1QUAD GROUP**:
##+##################################
##+#########################################################################
## proc 'load_parameters_frame_PYR4TRIAS1QUAD'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for a
## PYRAMID.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an PYRAMID-write proc for the outtype.
##
## CALLED BY: button1-release on the 'PYR-4TRIAS-1QUAD' model-type listbox line
##+#########################################################################
proc load_parameters_frame_PYR4TRIAS1QUAD {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARlength VARheight VARouttype
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_PYR4TRIAS1QUAD]} {
frame .fRright.fRparameters_PYR4TRIAS1QUAD -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_PYR4TRIAS1QUAD' frame -
## DEFINE 2 ENTRY widgets, for length of sides of the
## square bottom and for height of pyramid --- along with
## 2 LABEL widgets.
## PACK the label and entry widgets.
##+########################################################
label .fRright.fRparameters_PYR4TRIAS1QUAD.labelLENGTH \
-text "PYR-4-TRIAS-1-QUAD - Length of sides of square base:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARlength "1.0"
entry .fRright.fRparameters_PYR4TRIAS1QUAD.entLENGTH \
-textvariable VARlength \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_PYR4TRIAS1QUAD.labelHEIGHT \
-text "$aRtext(labelHEIGHT)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARheight "1.0"
entry .fRright.fRparameters_PYR4TRIAS1QUAD.entHEIGHT \
-textvariable VARheight \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the entry widget and its label.
pack .fRright.fRparameters_PYR4TRIAS1QUAD.labelLENGTH \
.fRright.fRparameters_PYR4TRIAS1QUAD.entLENGTH \
.fRright.fRparameters_PYR4TRIAS1QUAD.labelHEIGHT \
.fRright.fRparameters_PYR4TRIAS1QUAD.entHEIGHT \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_PYR4TRIAS1QUAD]}
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_PYR4TRIAS1QUAD' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_PYR4TRIAS1QUAD \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_PYR4TRIAS1QUAD"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state normal
.fRright.fRouttypes.radbuttPLY configure -state disabled
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state disabled
# .fRright.fRouttypes.radbuttCADlike configure -state disabled
set VARouttype "OBJ"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
## FOR TESTING:
# puts "proc 'load_parameters_frame_PYR4TRIAS1QUAD' > 'pack forget' and re-pack was done."
# puts "proc 'load_parameters_frame_PYR4TRIAS1QUAD' > curPARMframe IS: $curPARMframe"
}
## END OF proc 'load_parameters_frame_PYR4TRIAS1QUAD'
##+#########################################################################
## proc 'write_model_PYR4TRIAS1QUAD_OBJ'
############################################################################
## PURPOSE: Write out a model file for 'PYR4TRIAS1QUAD' model type, into
## a file with 'OBJ' data format.
##
## CALLED BY: 'write_model_file' proc
###########################################################################
proc write_model_PYR4TRIAS1QUAD_OBJ {} {
global env outDIR VARlength VARheight VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_PYR4TRIAS1QUAD.obj"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open "$OUTfilename" w]
set CNTpoints 0
set CNTpolygons 0
## Write a heading comment record to the file.
puts $f "## PYRAMID MODEL: 4 TRIANGLES, 1 SQUARE. Length of sides of square base: $VARlength Height: $VARheight"
## Write 4 'v' records for the 5 points of the pyramid.
puts $f "## OBJ file."
puts $f "## 5 vertex records follow (1 peak vertex and 4 vertices of the square base)."
set half [expr {$VARlength / 2.0}]
## Peak point (vertex 1):
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$VARheight + $VARtranz}]"
## Four base points (vertices 2,3,4,5):
incr CNTpoints
puts $f "v [expr {$half + $VARtranx}] [expr {$half + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {-$half + $VARtranx}] [expr {$half + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {-$half + $VARtranx}] [expr {-$half + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$half + $VARtranx}] [expr {-$half + $VARtrany}] [expr {0.0 + $VARtranz}]"
## Write 5 faces of the pyramid.
puts $f "##"
puts $f "## 5 face records follow (4 triangles, then 1 square for the base)."
## The 4 triangles:
incr CNTpolygons
puts $f "f 1 2 3"
incr CNTpolygons
puts $f "f 1 3 4"
incr CNTpolygons
puts $f "f 1 4 5"
incr CNTpolygons
puts $f "f 1 5 2"
## The square:
incr CNTpolygons
puts $f "f 2 3 4 5"
## Write a summary of the vertex and face counts.
puts $f "## Counts for OBJ file for model PYR-4-TRIAS-1-QUAD."
puts $f "## Vertices/Points: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_PYR4TRIAS1QUAD_OBJ' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for OBJ file for model
PYR-4-TRIAS-1-QUAD - Points: $CNTpoints Polygons: $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_PYR4TRIAS1QUAD_OBJ'
##+###################################
## START OF **SPHEREquadsTrias GROUP**:
##+###################################
##+#########################################################################
## proc 'load_parameters_frame_SPHEREquadsTrias'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for a
## SPHEREquadsTrias.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an SPHEREquadsTrias-write proc for the outtype.
##
## CALLED BY: button1-release on the SPHERE-QUADS-TRIAS model-type listbox line
##+#########################################################################
proc load_parameters_frame_SPHEREquadsTrias {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARradius VARlonSegs VARlatSegs
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_SPHEREquadsTrias]} {
frame .fRright.fRparameters_SPHEREquadsTrias -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_SPHEREquadsTrias' frame -
## DEFINE 3 ENTRY widgets, for radius,numLongitudeSegs,
## numLatitudeSegs of the sphere --- along with 3 LABEL widgets.
## PACK the 6 widgets --- labels and entry widgets.
##+########################################################
label .fRright.fRparameters_SPHEREquadsTrias.labelRADIUS \
-text "SPHERE-QUADS-TRIAS - $aRtext(labelRADIUS)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARradius "1.0"
entry .fRright.fRparameters_SPHEREquadsTrias.entRADIUS \
-textvariable VARradius \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_SPHEREquadsTrias.labelLONsegs \
-text " Longitude segments:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARlonSegs "20"
entry .fRright.fRparameters_SPHEREquadsTrias.entLONsegs \
-textvariable VARlonSegs \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
label .fRright.fRparameters_SPHEREquadsTrias.labelLATsegs \
-text " Latitude segments:" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARlatSegs "10"
entry .fRright.fRparameters_SPHEREquadsTrias.entLATsegs \
-textvariable VARlatSegs \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the 3 entry widgets.
pack .fRright.fRparameters_SPHEREquadsTrias.labelRADIUS \
.fRright.fRparameters_SPHEREquadsTrias.entRADIUS \
.fRright.fRparameters_SPHEREquadsTrias.labelLONsegs \
.fRright.fRparameters_SPHEREquadsTrias.entLONsegs \
.fRright.fRparameters_SPHEREquadsTrias.labelLATsegs \
.fRright.fRparameters_SPHEREquadsTrias.entLATsegs \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_SPHEREquadsTrias]}
## FOR TESTING:
# puts "proc 'load_parameters_frame_SPHEREquadsTrias' > Replacing curPARMframe: $curPARMframe"
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_SPHEREquadsTrias' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_SPHEREquadsTrias \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_SPHEREquadsTrias"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state normal
.fRright.fRouttypes.radbuttPLY configure -state disabled
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state disabled
# .fRright.fRouttypes.radbuttCADlike configure -state normal
set VARouttype "OBJ"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
## FOR TESTING:
# puts "proc 'load_parameters_frame_SPHEREquadsTrias' > 'pack forget' and re-pack was done."
# puts "proc 'load_parameters_frame_SPHEREquadsTrias' > curPARMframe IS: $curPARMframe"
}
## END OF proc 'load_parameters_frame_SPHEREquadsTrias'
##+#########################################################################
## proc 'write_model_SPHEREquadsTrias_OBJ'
##+#########################################################################
## PURPOSE: Write out a model file for 'SPHEREquadsTrias' model type, into
## a file with 'OBJ' data format.
##
## CALLED BY: 'write_model_file' proc
##+########################################################################
proc write_model_SPHEREquadsTrias_OBJ {} {
global env outDIR twopi pi TOLfactor VARradius VARlonSegs VARlatSegs \
VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_SPHEREquadsTrias.obj"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open $OUTfilename w]
set CNTpoints 0
set CNTpolygons 0
#################################################
## WRITE HEADING (comment)records to the file.
#################################################
puts $f "## SPHERE: TRIANGLES at TOP and BOTTOM. QUADRILATERALS around the MIDDLE."
puts $f "## RADIUS: $VARradius LongitudinalSegments: $VARlonSegs LatitudinalSegments: $VARlatSegs"
puts $f "## OBJ file."
#################################################
## Before entering the loops below,
## SET SOME CONSTANTS.
#################################################
## We could set the number of significant digits of precision
## (for the xyz values written to the file) here.
# set tcl_precision 5
## Assure that VARradius is not an integer or string,
## for speed in the following calculations.
set VARradius [expr {double($VARradius)}]
## Set a 'zero tolerance' for setting very small xyz coords to zero.
set TOLzero [expr {double($TOLfactor) * $VARradius}]
## Set longitudinal and latitudinal angle increments, in radians.
set deltaLONang [expr {double($twopi / $VARlonSegs)}]
set deltaLATang [expr {double($pi / $VARlatSegs)}]
## For some msgs below, set number of latitudinal lines.
set LATlines [expr {$VARlatSegs - 1}]
###########################################################################
## WRITE 'v' VERTEX RECORDS for the cylinder.
## We write the vertex at the north pole, then the vertices for
## the quadrangles around the middle, then the vertex at the south pole.
###########################################################################
## NOTE: For OBJ files, vertex numbers (in face records) should start at one.
##
## We number the vertices of the sphere as follows, where for $VARlonSegs (M),
## there are M lines of longitude (for example, for M=3, the north hemisphere is
## a tetrahedron and there are 3 longitudinal lines) --- and
## for $VARlatSegs (N), there are N-1 lines of latitude.
## (For example, for N=2 segments, there is one latitude line --- the equator.)
## Let n denote a latitude line number, 1<=n<=N-1.
##
## north pole vertex = 1
##
## On the 1st latitude (n=1) / / / | \ \ \
##
## vertex numbers are 2 3 ... M+1
## or (n-1)M+2 (n-1)M+3 ... (n-1)M+M+1=n*M+1
##
## On the 2nd latitude (n=2)
## / / / | \ \ \
##
## vertex numbers are M+2 M+3 ... M+M+1=2M+1
## or (n-1)M+2 (n-1)M+3 ... (n-1)M+M+1=n*M+1
##
## On the (N-1)-st latitude
## \ \ \ | / / /
## vertex numbers are (n-1)M+2 (n-1)M+3 ... (n-1)M+M+1=n*M+1
## or (N-2)M+2 (N-2)M+3 ... (N-2)M+M+1=(N-1)M+1
##
## south pole = (N-1)M + 2
##
## In other words, the numbering starts at 1 for the vertex at the north pole.
## Then, at the 1st latitude down, we add M points, starting at 2.
## For each latitude line, we add M more points.
## We end up with (N-1)M points on the latitude lines and 2 points at the poles.
puts $f "## North pole vertex follows."
puts $f "v 0.0 0.0 $VARradius"
incr CNTpoints
## Loop over longitude lines fastest, latitude lines slowest,
## writing the vertices along the latitude lines.
## We let the z-axis be the north-south axis. The x and y axes are
## in the plane of the equator.
puts $f "##"
puts $f "## Vertices on the latitude lines follow."
puts $f "##"
for {set n 1} {$n < $VARlatSegs} {incr n} {
puts $f "##"
puts $f "## Vertices for LATITUDE LINE $n OF $LATlines follow. Current vertex count: $CNTpoints"
puts $f "##"
## Set the current latitude angle (measured from the postive z-axis),
## so that we do not have to keep recalculating it in the m-loop below.
set curLAT [expr {$n * $deltaLATang}]
## For the vertices at this latitude, set their radius in the xy plane.
set rxy [expr {$VARradius * sin($curLAT)}]
for {set m 1} {$m <= $VARlonSegs} {incr m} {
## Use rxy and the current longitudinal angle to get
## the x,y coordinates of this vertex.
set curLON [expr {($m - 1) * $deltaLONang}]
set x [expr {$rxy * cos($curLON)}]
set y [expr {$rxy * sin($curLON)}]
## Use VARradius and the current latitudinal angle
## to get the z coordinate of this vertex.
set z [expr {$VARradius * cos($curLAT)}]
puts $f "v [expr {$x + $VARtranx}] [expr {$y + $VARtrany}] [expr {$z + $VARtranz}]"
incr CNTpoints
}
## END OF m (longitudinal) loop
}
## END OF n (latitudinal) loop
## Write the vertex record for the south pole vertex.
puts $f "## South pole vertex follows."
puts $f "v 0.0 0.0 -$VARradius"
incr CNTpoints
## Write the count of the vertex records written.
puts $f "##"
puts $f "## *** $CNTpoints VERTEX RECORDS WRITTEN. ***"
######################################
## START WRITING FACE 'f' RECORDS NOW.
######################################
puts $f "##"
puts $f "## Start of TRIANGULAR FACE RECORDS for 'top' of sphere."
puts $f "##"
for {set m 1} {$m < $VARlonSegs} {incr m} {
## In each face record, we put the north pole vertex (vertex 1) and
## 2 points from the 1st latitude line, to make each triangle.
## We place them in a 'counter-clockwise' order.
## 1
## | \
## | \
## | \
## 2 _____3 ... M+1
##
puts $f "f 1 [expr {$m + 1}] [expr {$m + 2}]"
incr CNTpolygons
}
## END OF loop for all but last of top triangles.
## Write the last of the top triangles, which 'wraps' from M+1 to 2.
puts $f "f 1 [expr {$VARlonSegs + 1}] 2"
incr CNTpolygons
puts $f "##"
puts $f "## Start of QUADRILATERAL FACE RECORDS for 'middle' of sphere."
puts $f "##"
for {set n 1} {$n < $LATlines} {incr n} {
puts $f "## Start of quadrilaterals BETWEEN LATITUDE LINES $n AND [expr {$n + 1}]."
for {set m 1} {$m < $VARlonSegs} {incr m} {
## In each face record, we put 2 points from the current latitude level
## and 2 corresponding points from the next latitude level, to make each
## quadrilateral.
##
## We place the vertex IDs for each quad in a 'counter-clockwise' order.
## (n-1)M+2 (n-1)M+3 ... (n-1)M+M+1=n*M+1
## _________
## | |
## | |
## ________
## n*M+2 n*M+3 ... n*M+M+1=(n+1)*M+1
##
puts $f "f [expr {($n - 1)*$VARlonSegs + $m +1}] [expr {$n*$VARlonSegs + $m + 1}] [expr {$n*$VARlonSegs + $m + 2}] [expr {($n - 1)*$VARlonSegs + $m + 2}]"
incr CNTpolygons
}
## END OF m (longitudinal) loop for quadrangles.
## Write the last of the quads at latitude $n. This quad 'wraps back'.
puts $f "f [expr {$n*$VARlonSegs + 1}] [expr {($n + 1)*$VARlonSegs + 1}] [expr {$n*$VARlonSegs + 2}] [expr {($n - 1)*$VARlonSegs + 2}]"
}
## END OF n (latitudinal) loop for quadrangles.
puts $f "##"
puts $f "## Start of TRIANGULAR FACE RECORDS for 'bottom' of sphere."
puts $f "##"
set southIDX [expr {(($VARlatSegs - 1) * $VARlonSegs) + 2}]
set latIDX [expr {$VARlatSegs - 2}]
for {set m 1} {$m < $VARlonSegs} {incr m} {
## In each face record, we put the south pole vertex (vertex (N-1)M + 2) and
## 2 points from the last latitude line, to make each triangle.
## We place them in a 'counter-clockwise' order.
## (N-2)M+2 (N-2)M+3 ... (N-2)M+M+1=(N-1)M+1
## _____
## | /
## | /
## | /
## |/
## south pole = (N-1)M + 2
##
puts $f "f $southIDX [expr {($latIDX * $VARlonSegs) + $m +2}] [expr {($latIDX * $VARlonSegs) + $m +1}]"
incr CNTpolygons
}
## END OF loop for all but last of bottom triangles.
## Write the last of the bottom triangles, which 'wraps'.
puts $f "f $southIDX [expr {($latIDX * $VARlonSegs) + 2}] [expr {(($VARlatSegs - 1) * $VARlonSegs) + 1}]"
incr CNTpolygons
## Write a summary of the vertex and face counts.
puts $f "## Counts for OBJ file for model SPHERE-QUADS-TRIAS."
puts $f "## Vertices/Points: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_SPHEREquadsTrias_OBJ' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for OBJ file for model
SPHERE-QUADS-TRIAS - Points: $CNTpoints Polygons: $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_SPHEREquadsTrias_OBJ'
##+###############################
## START OF **TETRA4TRIAS GROUP**:
##+###############################
##+#########################################################################
## proc 'load_parameters_frame_TETRA4TRIAS'
##+#########################################################################
## PURPOSE: Replace the current parameters-frame by the frame with
## data entry widgets for generation of a 3D model file for a
## TETRAHEDRON.
##
## Also enable/disable the outtype radiobuttons according to
## whether we have an TETRAHEDRON-write proc for the outtype.
##
## CALLED BY: button1-release on the TETRA4TRIAS model-type listbox line
##+#########################################################################
proc load_parameters_frame_TETRA4TRIAS {} {
global curPARMframe RELIEF_frame BDwidth_frame aRtext \
PADXpx_label PADYpx_label BDwidthPx_label BKGD_entry BDwidthPx_entry \
VARradius VARouttype
## If the frame is not defined yet, define it.
## Also define and pack its widgets.
if {![winfo exists .fRright.fRparameters_TETRA4TRIAS]} {
frame .fRright.fRparameters_TETRA4TRIAS -relief $RELIEF_frame -borderwidth $BDwidth_frame
##+########################################################
## In the '.fRright.fRparameters_TETRA4TRIAS' frame -
## DEFINE 1 ENTRY widget, for length of sides of the
## equilateral triangles --- along with 1 LABEL widget.
## PACK the label and entry widgets.
##+########################################################
label .fRright.fRparameters_TETRA4TRIAS.labelRADIUS \
-text "TETRA-4-TRIAS - Base triangle's $aRtext(labelRADIUS)" \
-font fontTEMP_varwidth \
-padx $PADXpx_label \
-pady $PADYpx_label \
-justify left \
-anchor w \
-relief raised \
-bd $BDwidthPx_label
set VARradius "1.0"
entry .fRright.fRparameters_TETRA4TRIAS.entRADIUS \
-textvariable VARradius \
-font fontTEMP_fixedwidth \
-width 7 \
-bg "$BKGD_entry" \
-relief sunken \
-bd $BDwidthPx_entry
## Pack the entry widget and its label.
pack .fRright.fRparameters_TETRA4TRIAS.labelRADIUS \
.fRright.fRparameters_TETRA4TRIAS.entRADIUS \
-side left \
-anchor w \
-fill none \
-expand 0
}
## END OF if {![winfo exists .fRright.fRparameters_TETRA4TRIAS]}
## Remove the current 'parameters' frame (and the frames below it, if any)
## and re-pack using the 'fRparameters_TETRA4TRIAS' frame.
pack forget $curPARMframe
pack .fRright.fRparameters_TETRA4TRIAS \
-side top \
-anchor nw \
-fill none \
-expand 0
set curPARMframe ".fRright.fRparameters_TETRA4TRIAS"
## Set the state of the outtypes radiobuttons to 'normal'
## if a write proc exists for this model-type.
## Set the state to 'disabled' if no write proc.
.fRright.fRouttypes.radbuttOBJ configure -state normal
.fRright.fRouttypes.radbuttPLY configure -state disabled
.fRright.fRouttypes.radbuttOFF configure -state disabled
.fRright.fRouttypes.radbuttSTL configure -state disabled
# .fRright.fRouttypes.radbuttCADlike configure -state disabled
set VARouttype "OBJ"
.fRright.fRbuttons.labelINFO configure -text "$aRtext(labelINFO)"
## FOR TESTING:
# puts "proc 'load_parameters_frame_TETRA4TRIAS' > 'pack forget' and re-pack was done."
# puts "proc 'load_parameters_frame_TETRA4TRIAS' > curPARMframe IS: $curPARMframe"
}
## END OF proc 'load_parameters_frame_TETRA4TRIAS'
##+#########################################################################
## proc 'write_model_TETRA4TRIAS_OBJ'
############################################################################
## PURPOSE: Write out a model file for 'TETRA4TRIAS' model type, into
## a file with 'OBJ' data format.
##
## CALLED BY: 'write_model_file' proc
###########################################################################
proc write_model_TETRA4TRIAS_OBJ {} {
global env outDIR VARradius twopi VARtranx VARtrany VARtranz
set userID "$env(USER)"
set OUTfilename "$outDIR/${userID}_TETRA4TRIAS.obj"
# catch {exec rm "$OUTfilename"}
catch {file delete "$OUTfilename"}
set f [open $OUTfilename w]
set CNTpoints 0
set CNTpolygons 0
## Write a heading comment record to the file.
puts $f "## TETRAHEDRON-4-TRIANGLES MODEL. Base triangle's RADIUS: $VARradius"
## Write 4 'v' records for the corners of the box.
puts $f "## OBJ file."
puts $f "## 4 vertex records follow."
set angle [expr {$twopi / 3.0}]
# set h [expr {sqrt(2.0) * $VARradius}]
set h $VARradius
incr CNTpoints
puts $f "v [expr {0.0 + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {$h + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {$VARradius + $VARtranx}] [expr {0.0 + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {($VARradius * cos(2.0 * $angle)) + $VARtranx}] [expr {($VARradius * sin(2.0 * $angle)) + $VARtrany}] [expr {0.0 + $VARtranz}]"
incr CNTpoints
puts $f "v [expr {($VARradius * cos($angle)) + $VARtranx}] [expr {($VARradius * sin($angle)) + $VARtrany}] [expr {0.0 + $VARtranz}]"
## Write 6 faces (rectangles) of the box.
puts $f "##"
puts $f "## 4 face records follow (all triangles)."
incr CNTpolygons
puts $f "f 1 3 2"
incr CNTpolygons
puts $f "f 1 4 3"
incr CNTpolygons
puts $f "f 1 2 4"
incr CNTpolygons
puts $f "f 2 3 4"
## Write a summary of the vertex and face counts.
puts $f "## Counts for OBJ file for model TETRA-4-TRIAS."
puts $f "## Vertices/Points: $CNTpoints Faces/Polygons: $CNTpolygons"
## Close the file.
close $f
## FOR TESTING:
# puts "proc 'write_model_TETRA4TRIAS_OBJ' > CNTpoints: $CNTpoints CNTpolygons: $CNTpolygons"
.fRright.fRbuttons.labelINFO configure -text "Counts for OBJ file for model
TETRA-4-TRIAS - Points: $CNTpoints Polygons: $CNTpolygons"
## Display the file in a GUI text-editor.
edit_outfile "$OUTfilename"
}
## END OF PROC 'write_model_TETRA4TRIAS_OBJ'
##+######################################################
## END OF GROUPS OF 'load_parameters_frame_XXX' and
## 'write_model_XXX_YYY' procs.
##
## WE ARE NEARING THE BOTTOM OF THIS SCRIPT.
##+######################################################
##+########################################################################
## PROC 'popup_msgVarWithScroll'
##+########################################################################
## PURPOSE: Report help or error conditions to the user.
##
## We do not use focus,grab,tkwait in this proc,
## because we use it to show help when the GUI is idle,
## and we may want the user to be able to keep the Help
## window open while doing some other things with the GUI
## such as putting a filename in the filename entry field
## or clicking on a radiobutton.
##
## For a similar proc with focus-grab-tkwait added,
## see the proc 'popup_msgVarWithScroll_wait'.
##
## REFERENCE: page 602 of 'Practical Programming in Tcl and Tk',
## 4th edition, by Welch, Jones, Hobbs.
##
## ARGUMENTS: A toplevel frame name (such as .fRhelp or .fRerrmsg)
## and a variable holding text (many lines, if needed).
##
## CALLED BY: 'help' button
##+########################################################################
## To have more control over the formatting of the message (esp.
## words per line), we use this 'toplevel-text' method,
## rather than the 'tk_dialog' method -- like on page 574 of the book
## by Hattie Schroeder & Mike Doyel,'Interactive Web Applications
## with Tcl/Tk', Appendix A "ED, the Tcl Code Editor".
##+########################################################################
proc popup_msgVarWithScroll { toplevName VARtext } {
## global fontTEMP_varwidth #; Not needed. 'wish' makes this global.
## global env
# bell
# bell
#################################################
## Set VARwidth & VARheight from $VARtext.
#################################################
## To get VARheight,
## split at '\n' (newlines) and count 'lines'.
#################################################
set VARlist [ split $VARtext "\n" ]
## For testing:
# puts "VARlist: $VARlist"
set VARheight [ llength $VARlist ]
## For testing:
# puts "VARheight: $VARheight"
#################################################
## To get VARwidth,
## loop through the 'lines' getting length
## of each; save max.
#################################################
set VARwidth 0
#############################################
## LOOK AT EACH LINE IN THE LIST.
#############################################
foreach line $VARlist {
#############################################
## Get the length of the line.
#############################################
set LINEwidth [ string length $line ]
if { $LINEwidth > $VARwidth } {
set VARwidth $LINEwidth
}
}
## END OF foreach line $VARlist
## For testing:
# puts "VARwidth: $VARwidth"
###############################################################
## NOTE: VARwidth works for a fixed-width font used for the
## text widget ... BUT the programmer may need to be
## careful that the contents of VARtext are all
## countable characters by the 'string length' command.
###############################################################
#####################################
## SETUP 'TOP LEVEL' HELP WINDOW.
#####################################
catch {destroy $toplevName}
toplevel $toplevName
# wm geometry $toplevName 600x400+100+50
wm geometry $toplevName +100+50
wm title $toplevName "Note"
# wm title $toplevName "Note to $env(USER)"
wm iconname $toplevName "Note"
#####################################
## In the frame '$toplevName' -
## DEFINE THE TEXT WIDGET and
## its two scrollbars --- and
## DEFINE an OK BUTTON widget.
#####################################
text $toplevName.text \
-wrap none \
-font fontTEMP_varwidth \
-width $VARwidth \
-height $VARheight \
-bg "#f0f0f0" \
-relief raised \
-bd 2 \
-yscrollcommand "$toplevName.scrolly set" \
-xscrollcommand "$toplevName.scrollx set"
scrollbar $toplevName.scrolly \
-orient vertical \
-command "$toplevName.text yview"
scrollbar $toplevName.scrollx \
-orient horizontal \
-command "$toplevName.text xview"
button $toplevName.butt \
-text "OK" \
-font fontTEMP_varwidth \
-command "destroy $toplevName"
###############################################
## PACK *ALL* the widgets in frame '$toplevName'.
###############################################
## Pack the bottom button BEFORE the
## bottom x-scrollbar widget,
pack $toplevName.butt \
-side bottom \
-anchor center \
-fill none \
-expand 0
## Pack the scrollbars BEFORE the text widget,
## so that the text does not monopolize the space.
pack $toplevName.scrolly \
-side right \
-anchor center \
-fill y \
-expand 0
## DO NOT USE '-expand 1' HERE on the Y-scrollbar.
## THAT ALLOWS Y-SCROLLBAR TO EXPAND AND PUTS
## BLANK SPACE BETWEEN Y-SCROLLBAR & THE TEXT AREA.
pack $toplevName.scrollx \
-side bottom \
-anchor center \
-fill x \
-expand 0
## DO NOT USE '-expand 1' HERE on the X-scrollbar.
## THAT KEEPS THE TEXT AREA FROM EXPANDING.
pack $toplevName.text \
-side top \
-anchor center \
-fill both \
-expand 1
#####################################
## LOAD MSG INTO TEXT WIDGET.
#####################################
## $toplevName.text delete 1.0 end
$toplevName.text insert end $VARtext
$toplevName.text configure -state disabled
}
## END OF PROC 'popup_msgVarWithScroll'
##+########################################################################
## PROC 'popup_msgVarWithScroll_wait'
##+########################################################################
## PURPOSE: Report error conditions to the user.
## Sets 'focus' on this toplevel window, does a 'grab',
## and does 'tkwait' so that execution stops until the
## user responds to this window.
##
## ARGUMENTS: A toplevel frame name (such as .fRhelp or .fRerrmsg)
## and a variable holding text (many lines, if needed).
##
## CALLED BY: various procs that need to popup an error message.
##+########################################################################
proc popup_msgVarWithScroll_wait { toplevName VARtext } {
popup_msgVarWithScroll $toplevName $VARtext
focus $toplevName
grab $toplevName
tkwait window $toplevName
}
## END OF PROC 'popup_msgVarWithScroll_wait'
set HELPtext "\
\ \ \ \ \ ** HELP for this 3D-Model-File-Generator Utility **
When the 3D-Model-Generator GUI comes up, the user can specify
3 types of items:
1) FROM A LISTBOX:
Specify a MODEL TYPE to be generated. Examples: box, tetrahedron, pyramid,
prism, octahedron, icosahedron, ... , sphere, cone, cylinder, torus, ... ,
spiral staircase, capital-A, ....
The model-type ID usually includes some indication of the polygon types
(triangles, quads, ...) that are to be generated --- and in some cases,
the ID indicates the numbers of those polygon types.
Example model-type ID's: BOX-6-QUADS, SPHERE-QUADS-TRIAS, CONE-N-TRIAS, BUCKYBALL
3) VIA ENTRY WIDGETS (and perhaps other widgets), with labels:
Specify some PARAMETERS associated with that model type --- such as width,
height, depth, radius, number of longitudinal segments, ....
The ENTRY widgets presented depend on the 'model-type' chosen.
2) VIA RADIOBUTTONS:
Specify an OUTPUT FILE TYPE (OBJ, PLY, OFF, STL, ...).
When the parameters are set and the desired output file type is
specified, then click on the 'WriteFile' button to create
the file of the specified type.
The file will be automatically displayed in a GUI text-editor.
(The user can edit a variable named 'EDITOR_text' near the
bottom of this script to specify the GUI editor to use.)
The output file may be put in a temporary-file directory,
such as '/tmp' on Linux/Unix. (That directory is specified by
a variable 'outDIR' at the bottom of the script.)
After 'touching up' the file with the editor (for example,
adding comment lines starting with '#'),
the user can use the 'SaveAs...' option of their text editor
to save the 3D model-data file in a directory of the user's choice.
---
ADDING MODEL-TYPES TO THIS UTILITY:
Over time, some additonal 'model-types' (and perhaps 'output-types')
may be added to this utility.
Within the script, this means that, along with each new model-type
entry inserted in the model-types listbox, an additional
'load_parameters_frame_XXX' proc and one or more additional
'write_model_XXX_YYY' procs will need to be added.
Adding a model type XXX also means that a new '.fRright.fRparameters_XXX'
frame needs to be defined in the 'load_parameters_frame_XXX' proc.
And appropriate widgets need to be defined and packed in
the frame. Usually, the widgets are labels and entry-field widgets ---
in which the user can enter parameters for creation of the XXX model type.
The user-programmer can use existing 'load_parameters_frame_XXX' and
'write_model_XXX_YYY' procs as a model for building new procs.
----------------------------------------------------------------------
DESCRIPTION OF SOME OF THE OUTPUT FILE FORMATS (OBJ, PLY, OFF, STL, CAD-like):
***************
OBJ FILE FORMAT:
***************
The Wavefront '.obj' file format is a standard 3D object
file format created for use with Wavefront's Advanced Visualizer.
'Object' Files are text based files supporting both polygonal and
free-form geometry (curves and surfaces).
The 'OBJ-model-writer' procs in this utility support a subset of
the file format (not the curves and surfaces, currently).
The supported geometry items (vertices, faces, lines) are enough
to create a wide variety of useful '.obj' Files.
The following text is a very brief description of the 'v' and 'f'
records in '.obj' files.
The model-writer procs in this utility write 'v ' records, but no
'vn' and 'vt' records. The 'basic' '.obj' records are:
# some text
This line is for a comment, until the end of the line.
v float float float
A single vertex's geometric position in space. The first
vertex listed in the file has index 1, and subsequent
vertices are numbered sequentially.
vn float float float
A normal. The first normal in the file is index 1,
and subsequent normals are numbered sequentially.
vt float float
A texture coordinate. The first texture coordinate in
the file is index 1, and subsequent textures are numbered
sequentially.
f int int int ...
or
f int/int int/int int/int . . .
or
f int/int/int int/int/int int/int/int ...
A polygonal face. The numbers are indexes into the arrays
of vertex positions, texture coordinates, and normals
respectively. A number may be omitted if, for example,
texture coordinates are not being defined in the model.
There is no maximum number of vertices that a single
polygon may contain. The .obj file specification says
that each face must be flat and convex.
NOTE that vertex integers in the OBJ file 'face' records
start counting from ONE, NOT zero. IMPORTANT!
A very elementary example file is given below (it is a box):
v 1 1 1
v 1 1 -1
v 1 -1 1
v 1 -1 -1
v -1 1 1
v -1 1 -1
v -1 -1 1
v -1 -1 -1
f 1 3 4 2
f 5 7 8 6
f 1 5 6 2
f 3 7 8 4
f 1 5 7 3
f 2 6 8 4
It is also quite common to see 'f' records in one of the
following formats:
f 1//1 2//2 3//3 4//4
f 1/1 2/2 3/3 4/4
f 6/4/1 3/5/3 7/6/5
The 'OBJ-model-writer' procs of this utility simply write
'f' records in the
f int int int ...
format.
----------------------------------------------------------------------
***************
PLY FILE FORMAT:
***************
The Cyberware '.ply' file format for most files that one
encounters is fairly simple. It is tyically composed of
three sections:
- A set of about 11 ASCII text records declaring that
the file is a 'ply' file and indicating the number
of 'vertex' and 'face' records in the file.
- Vertex records containing xyz coordinates.
- Face records containing polygon data --- typically
the number 3 (indicating that it is a triangular face)
followed by 3 integers referring to the vertex records
with vertex count starting at 0, not 1.
Here is an example PLY file:
ply
format ascii 1.0
element vertex 162
property float x
property float y
property float z
element face 320
property list uchar int vertex_indices
end_header
0 -0.525731 0.850651
0.850651 0 0.525731
...
... (more vertex records in here)
...
-0.688191 -0.425325 0.587785
-0.425325 -0.587785 0.688191
3 0 42 43
3 0 43 44
...
... (more face rectords in here)
...
3 156 157 158
3 159 160 161
You can get more info on the format of '.ply' files from
the Cyberware website: www.cyberware.com
----------------------------------------------------------------------
***************
OFF FILE FORMAT:
***************
The OFF file format is similar to the PLY file format.
Example OFF header records:
OFF
#created by dirichlet domain computation.
36 20 54
There are 'OFF'-type files that start with
'NOFF' and '4OFF' instead of 'OFF'.
The 'OFF-writer' procs in this utility simply put
'OFF' in the first record of an OFF file.
NOTE: The 3 integers in the 3rd header records above
are for vertices,faces,edges.
The header records are followed by vertex records,
then face records.
Example OFF 'vertex' records:
0.272269 0.118712 0.520703
-0.000222 0.002388 0.617335
0.000222 -0.002388 0.617335
Example OFF 'face' record format:
3 14 51 54 (for a triangle)
4 8 7 10 9 (for a quadrangle)
5 27 6 5 1 0 (for a pentagon)
6 29 20 21 9 10 28 (for a hexagon)
7 32 15 18 25 24 2 35 (for a 7-gon)
..
..
10 128 48 49 45 46 47 125 126 129 127 (for a 10-gon)
Note that OFF vertex numbering in the face records starts
with zero, not one --- like PLY files and unlike OBJ files.
I have seen an extra integer(s) at the end of face records
in an OFF file. This may handle adding colors and other
options.
Unless other information recommends otherwise,
the 'OFF-writer' procs in this utility will normally
not put more integers in a face record than are
indicated by the first integer.
----------------------------------------------------------------------
***************
STL FILE FORMAT:
***************
The format of STL files is very simple.
Here is an example of a 'facet group' of data:
facet normal 0.0 0.0 -1.0
outer loop
vertex 0.0 0.0 0.0
vertex 1.0 1.0 0.0
vertex 1.0 0.0 0.0
endloop
endfacet
These are usually the only types of data records in the file,
except for a record like 'solid MYSOLID' at the top of the file
and a record like 'endsolid MYSOLID' at the bottom of the file.
All facets are triangles. To write out an object like a box,
each rectangular side needs to be split into at least 2 triangles.
This model-file-writers of this utility may put dummy values,
like 1.0 0.0 0.0, in the 'facet normal' records.
There are programs (example: 'admesh') that can
read through an STL file and write out a new STL file with
corrected normals --- giving each normal an orientation
corresponding to the order of the 3 vertices.
NOTE: These STL-write procs do not write out 'true' STL files.
'True' STL files ordinarily consist of triangles making up
the four surfaces of tetrahedrons. Most of the faces of the
tetrahedrons match up with the faces of other tetrahedrons
--- thus yielding many triangles which are 'coinciding
duplicates' (but with opposite normals, i.e. different
ordering of the vertices of the 2 triangles).
In contrast, these 'STL-writers' just write one of the two
triangles --- which is sufficient for the purpose of
using the STL file in a 3D model viewer utility, to
simply see the triangles making up the surface(s)
of a 3D model.
----------------------------------------------------------------------
**********************
A CAD-like FILE FORMAT:
**********************
The file formats above (OBJ,PLY,OFF,STL) do not put vertex numbers or
face numbers in the vertex and face records. HOWEVER, that is a common
type of format in various CAD, CAE, FEA 'exchange' files.
So this utility may eventually support a 'CAD-like' file format ---
something like the following description.
We define a 'CAD-like' 'pseudo' file format as follows.
The file may contain 'PT' (point), 'LN' (line), and 'PG' (polygon)
record types.
FORMAT OF THE DATA RECORDS: (fields are separated by 'white-space')
In FIELD 1 (2 characters):
'PT' denotes a 'point' record,
'LN' denotes a 'line' record,
'PG' denotes a 'polygon' record.
(We may use 'PL' for 'polyline', if needed.)
In FIELD 2 (a string with no embedded spaces):
The hex RGB values for a color. Example: #ff00ff for magenta.
We could support decimal RGB values between 0 and 1 by allowing hyphens, say,
to separate the 3 RGB decimals. Example: 0.25-0.39-0.0
Similarly, we could support integer RGB values, between 0 and 255.
Example: 15-25-0
Alternatively, this field could contain a group ID or material ID,
typically an integer.
In FIELD 3 (an integer):
An integer ID, unique for that record-type.
Example: 83 in a PT record denotes point number 83.
These integers may have meaning to the user or person who prepared the data,
but they do not necessarily have to be used to identify the data or record
by programs processing the records. Those programs may keep their own
counts/indexes to the records and their data.
For FIELD 4 and greater (numbers - real or integer):
For 'PT' (point) recs, cols 4,5,6 contain the x,y,z coords of the point.
For 'LN' (line) recs, cols 4,5 contain point ID numbers.
For 'PG' (polygon) recs, col 4 contains the number of points in the
polygon (3 for triangle, 4 for quadrilateral, etc.),
and cols 5,6,7,... contain point ID numbers.
NOTE: We will ordinarily restrict ourselves
to using triangles or quads for 3D models.
EXAMPLES of 'PT', 'L ', and 'PG' record formats:
POINT RECORD FORMAT:
PT hexcolor point# x y z
Example:
PT #ffffff 23 0.0 0.0 0.0
LINE RECORD FORMAT:
L hexcolor line# pointNUM1 pointNUM2
Example:
L #ff0000 10 1 2
POLYGON RECORD FORMAT:
PG hexcolor polygon# numPoints pointNUM1 pointNUM2 pointNUM3 ...
Example (a triangle):
PG #ff0000 19 3 2 5 17
"
## END of setting var 'HELPtext'.
##+#####################################################
## The Additional-GUI-Initialization SECTION:
##+#####################################################
##+#########################################################
## We set some 'universal' constants that may be used in the
## 'write' procs for some of the models.
##+#########################################################
set pi [expr {4.0 * atan(1.0)}]
set twopi [expr { 2.0 * $pi }]
set pihalf [expr { $pi / 2.0 }]
# set minuspihalf [expr {-$pihalf}]
set TOLfactor 0.00001
##+######################################################
## Set a default directory for the model output files ---
## OBJ, PLY, OFF, STL, whatever.
##+######################################################
set outDIR "/tmp"
##+######################################################
## Set a GUI text editor to be used to show the user
## the model output files.
##+######################################################
# set EDITOR_text "gedit"
# set EDITOR_text "/usr/bin/gedit"
set EDITOR_text "$env(HOME)/apps/gscite_2.27/SciTE"
##+###############################################
## Set the name of the current 'parameters' frame.
##+###############################################
set curPARMframe ".fRright.fRparameters"
##+#################################
## Set a default output-file-type.
##+#################################
set VARouttype "OBJ"
##+###############################################################
## OPTIONAL:
## Set a default model-type and use its 'load_parameters_frame'
## proc to replace the current '.fRright.fRparmeters' frame
## by the appropriate parameters frame '.fRright.fRparameters_XXX'
## --- by calling the proc 'load_parameters_frame_XXX'.
##
## We also set an appropriate default output-file-type for this
## model-type.
##
## For the specified model-type XXX, the 'load_parameters_frame_XXX'
## proc should define the '.fRright.fRparameters_XXX' frame and
## define-and-pack the widgets of that frame.
## Then, the 'load_parameters_frame_XXX' proc simply has to
## 'pack forget' the current frame (in $curPARMframe) and pack the
## frame '.fRright.fRparameters_XXX' and the parameter-prompting
## widgets will suddenly, magically appear.
##+##############################################################
set VARmodeltype "BOX-6-QUADS"
set VARouttype "OBJ"
load_parameters_frame_BOX6QUADS
Setting the Text Editor
Another not-so-common feature of this Tk script --- besides the 'pack forget' technique that is used to 'dynamically' change the parameters frame in the GUI --- is that, after the model file is written, it is displayed to the user in a GUI text editor of the user's choice.
You can see in the text of the 'HELPtext' variable, set at the bottom of the script above, that the user can edit the 'set' statement for variable 'EDITOR_text', near the bottom of the script, to set the text-editor to be the user's preferred editor.
The editor is called up from within the Tk script by using the Tcl 'exec' command.
---
The 'writers' are so fast that IMMEDIATELY after clicking on the 'WriteFile' button, the text-editor pops up displaying the model file.
Some Possible Enhancements
More Model-Types:
As I work on some 3D model and 3D surface viewing utilities in coming months, I may add several 'model types' to this GUI. So, if you find this utility of use, you may want to check back here every few months in 2012 and 2013 to see if an updated version of the script is available.
Colors:
I may put some color-assignment-algorithm procs in the code, in the future. I may eventually add a checkbutton (or two) to the GUI so that the user can choose to add colors chosen from a wide range (or from a restricted range, such as the spectrum of the rainbow). For example, the colors could be put into the polygon and/or point records in the model file formats that support colors of polygons and/or points --- or the colors could be put in separate color-records.
Conclusion
It took several days to get this code in shape. But now I am in a position to generate model files (of various dimensions and shapes and numbers of polygons/points) at about 30 microseconds per model file, instead of over 30 minutes per model file. :-) :-) :-) :-) :-)
Thank you, Tcl-Tk developers, for making it possible for me to make nice quality images of geometry in 3-space.
uniquename 2013jan27 UPDATE
I changed the GUI rather significantly by changing the model-type selection from using a couple of rows of radiobuttons to a using a listbox on the left of the GUI. This facilitates adding more 'model-types'.
I can also add more description of each model-type, by taking advantage of the x-scroll-bar of the listbox.
The y-scroll-bar allows for an unlimited number of added 'model-types'.
I have replaced the two GUI images above with the new images, and I have replaced the code above with the new code.
You can see the 'set' statement for the 'HELPtext' variable, near the bottom of the script, for a description of how to add new 'model-types' to the listbox.
Some 'model-types' that I have not implemented yet can be seen in the listbox of the images above. They are indicated by a hash-sign at the beginning of those listbox lines.
Over the coming months, I plan to implement more of those 'model-types'.
uniquename 2013feb03 UPDATE
OK. Now I have this script in much better shape. I have provided the following additions and enhancements.
1) Added a frame for specifying x,y,z translation amounts for all the points in a generated model. This can be helpful, for example, if a person is making a 3D scene (with some 3D modeler) and the scene is to be populated with a variety of 3D 'objects'. Having the models built at various distances from the origin allows the person to add objects without their being 'clumped' near the origin.
2) Added about 14 procs --- 'load_parameters_frame_XXX' and 'write_model_XXX_OBJ' procs where XXX indicates a model-type. The model types added were 'TETRA-4-TRIAS', 'CYL-N-QUADS', 'PYR-4-TRIAS-1-QUAD', 'OCTA-8-TRIAS', 'PRISM-2-TRIAS-3-QUADS', 'CONE-N-TRIAS', and 'SPHERE-QUADS-TRIAS'.
3) Re-organized the 'load_parameters_frame' & 'write_model' procs in the PROCS section. Grouped the procs together by model-type. This makes for easier maintenance and easier additions of new procs for more models.
___
I have tested the 7 new, added model-types by reading the generated OBJ files into my viewer that was presented at A 3D Model File Loader-and-Examiner - for OBJ, PLY, OFF, STL, FEA files.
Here is an image from that viewer that shows that the 'write-OBJ' proc for the 'SPHERE-QUADS-TRIAS' model is working properly.
The logic for writing the OBJ file for the sphere was quite challenging, as you can see by looking at the proc 'write_model_SPHEREquadsTrias_OBJ' in the code above.
___
Now that I have experience in generating vertex and face records for spheres and cylinders, I am ready to tackle my next 3D project --- a molecule viewer --- in which atoms may be represented as spheres (or simpler shapes such as icosahedrons, octahedrons, or cubes) and chemical bonds may be indicated by cylinders (or simpler shapes such as box-beams).
For the molecule viewer, I just need to change the logic in the 'write-OBJ' procs to load vertex and face ARRAYS IN MEMORY, instead of writing vertex and face RECORDS to an OBJ file.
___
It is at times like these I have to wonder what Pythagoras, Archimedes, Euclid, al-Khwarizmi, Euler, Newton, Leibniz, Gauss, Legendre, Laplace, Poincare, et. al. would have done if they had had a Tcl-Tk 'wish' interpreter at their finger-tips. The Tk canvas sure beats tracing figures in the sand --- and a quill-pen and ink.
I still wonder how Archimedes dealt with 92-or-whatever-sided polygons to perform calculations to approximate pi. Whether he was using a pen/pencil-type device or scratching in the sand, either way, it must have been tedious and extremely frustrating (with no back-space/delete keys and no super-fast Undo; no cut/copy-and-paste). He would have been in heaven, if he had a nice text-editor and 'wish'. Hopefully he is in heaven now, using Tcl-Tk for eternity. Imagine the amazing geometry relationships and formulas and configurations he would have accumluated by now. In heaven, they must be way ahead of our poor mathematics and physics by now --- with all those minds and all that time --- and access to tools like Tcl-Tk, since before Ousterhout invented it (shades of 'Back to the Future').
By the way, I have replaced the code above with the new, re-organized code with 7 more model-type generators. I updated the 2 screenshots at the top of this page. The x,y,z prompts for the new 'translation-vector' are shown.