[uniquename] - 2013jan31 On my 'bio' page at [uniquename], in early 2012, I pointed out that I found the 3D model viewing programs of MBS = Mark Stucky ([3dviewer : A canvas only viewer of 3D data]) and GS = Gerard Soohaket ([3D polyhedra with simple tk canvas]) quite inspiring. I resolved to make a similar 3D viewer --- but with MUCH enhanced 3D model import options and some other enhancements. I resolved to support reading and examining models from ASCII file formats such as Wavefront OBJ, Stereolithography STL, Cyberware PLY, Geomview OFF, and at least one CAE(FEA) file format. I recently published the code for such a model-file-reader-and-viewer at [A 3D Model File Loader-and-Examiner - for OBJ, PLY, OFF, STL, FEA files]. With that 3D reader-viewer utility, an unlimited number of 3D models can be viewed. At the bottom of the page presenting that reader-viewer, I mentioned that my next project would be to make a 3D terrain generator-and-viewer. That is the subject of this page. I pointed out that one difference in the terrain utility would be that it reads an image file instead of an ASCII 3D model file. There were a few capabilities that were shown 'grayed out' (not yet implemented) in the 3D reader-viewer utility --- such as a polygon-coloring-from-a-color-table option and a shading-by-lighting option. I resolved to get those options working in the terrain utility --- so that I could then 'back-port' those capabilities into the 3D OBJ/PLY/OFF/STL reader-viewer utility. In a sense, the terrain utility would be a step back in capability. The 3D OBJ/PLY/OFF/STL reader-viewer utility handles model files with polygons with 1,3,4,5,6,7,8,9,10,... sides, where 1 = line-segments. For the terrain viewer, I would need to handle only 4 sides (or 3). Before making the 3D OBJ/PLY/OFF/STL reader-viewer utility, I took some 'baby steps' toward building that viewer by developing two somewhat less ambitious 3D surface viewers at the pages * [Enhanced 3D Plot Examiner for functions of 2 variables] * [A 3D Generator-and-Examiner for Parametric Surfaces of 2 Variables] Those two viewers dealt only with 4-sided polygons. So in a sense, the terrain generator utility would be a 'step back' to less-generalized handling of polygons, like in these two utilities. In the first of these '2 variables' viewers, I presented code for a Tk GUI that allows for examining surfaces generated over a rectangular grid in the x-y plane --- by generating the z-values of points on the surface, over a rectangular grid, from a function of x and y --- z=f(x,y). In that script, I established a lot of procs that I could use for other 3D viewers. In particular, I provided a proc to rotate '3D point clouds'. In the second of these 2 pages/scripts, I devised a proc for polygon-sorting according to a 'z-depth'. So those two 3D viewer projects provided a lot of the code that I needed to make the 3D model-file viewer. In those two 3D viewer projects, I got fairly good display of surfaces using 4-sided polygons (possibly non-planar) without having to use 3-sided (planar) polygons. So I decided to stick with 4-sided polygons (rather than triangles) for this first attempt at a terrain generator and viewer. In making the terrain generator-viewer, I could draw on all 3 of the previously written 3D viewers to make the viewing part of the utility. I could also use the same kind of 'arrays-of-lists' points and polygons storage architecture that I used in the 3 previous 3D viewers. One of the new challenges would be to work out the logic of loading the RGB values of the pixels of an image into those storage arrays. Another challenge would be to provide a 'write-OBJ' option so that the generated terrain could be saved in a popular 3D model file format. --- '''MY GOALS:''' I decided to make a 3D terrain generating-and-viewing utility that included the following features. 1) ROTATION METHOD: Like in my other three 3D viewers, I would allow the user to specify longitude (yaw) and latitude (pitch) angles to specify the view direction (or to rotate the surface). I would use Tk 'scale' widgets so that setting the 2 view angles can be done quickly and redraw is initiated immediately. I would use '''button1-release bindings''' on the scales to cause the redraw as soon as a scale change is complete. (I may eventually add bindings to mouse events on the canvas, like , so that the view rotation can be done even more quickly & conveniently. This would be similar to rotate/zoom/pan controls that Mark Stucky provided in a 3D model viewer that he published at wiki.tcl.tk/15032 - [3dviewer : A canvas only viewer of 3D data]) 2) DATA ENTRY: Instead of having one entry field for the function f(x,y) --- or 3 entry fields for functions f(u,v), g(u,v), h(u,v) --- or one entry field for the name of an OBJ/PLY/OFF/STL file, I would have an entry field for a image filename --- along with a 'Browse...' button by which to navigate to and select a file in the computer's directory structure. I used GIF files for my testing and screen captures, since I am running Tcl-Tk 8.5 --- not 8.6. Those who are running 8.6 could verify whether this utility also works well for PNG files. In any case, since one can find an unlimited variety of GIF files that would be suitable for generating terrains, even if restricted to GIF files, we will have the ability to generate an unlimited variety of terrains. 3) COLOR CHOICES: I would (again, like in the other three 3D viewers I have posted here) allow color choices for * polygon fill * polygon outline * canvas background from among 16 million colors, each. 4) DISPLAY OPTIONS: I would provide radiobuttons by which the type of model display could be chosen: * 'fill-only' of polygons * 'fill-and-outline' of polygons and two 'outline-only' options: * 'wireframe-hidden' * 'wireframe-show-all'. 5) ZOOM OPTION: I would (again) provide a 'zoom' Tk scale widget, by which the plot can easily be resized, down or up --- to make sure the entire plot can be seen on the canvas. Like with the 2 scales for the longitude-latitude view angles, I would use a button1-release binding on the zoom scale to cause the redraw to be initiated as soon as a scale change is complete. 6) MATH (COORDINATE AXES) APPROACH: In the 3D OBJ/PLY/OFF/STL reader-viewer script I used a z-axis out of the screen and a y-axis in the 'up' direction --- for the 'fixed, viewing' coordinate axes. For this terrain utility, I returned to using a z-axis in the 'up' direction, just as I used in the two '2 variable' surface plotting Tk scripts. Specifically, for 'fixed, viewing' axes in this terrain viewer: * positive z-axis is 'up' (parallel to the monitor screen) * positive y-axis is 'to the right' (parallel to the monitor screen) * positive x-axis is 'out of the screen' (perpendicular to the monitor screen). Based on that, I would let the 'longitudinal' ('yaw') view angle specify a rotation around the z-viewing-axis and the 'latitudinal' ('pitch') view angle specify a rotation around the y-viewing-axis. Then rotations of the generated terrain surface could be given by an Ry * Rz rotation matrix product. We are avoiding 'roll' --- rotation around the x axis (out of the screen). It is too disorienting. 'Roll' is for fighter jet simulations and for emulating an acrobatic sky diver doing flips and all manner of rotations in mid-air. After all ... When we examine an object, like a dining table, we walk around it and we may put our eyes somewhat above or below the table top --- but we generally do not stand on our head to examine it. 7) 'PAINTING' THE POLYGONS (SORTING): For the viewer of parametric surfaces given by 3 functions of u and v, I needed to implement a procedure for sorting the polygons (quadrilaterals) before drawing them. I also needed to use a polygon sorting procedure in the 3D OBJ/PLY/OFF/STL reader-viewer utility. For that 3D utility, I took the sorting utility for the parametric surface viewer and enhanced it to handle N-gons, where N = 1,3,4,... --- not just 4-gons (quadrilaterals). Now, however, for this terrain viewer utility, it is much more like the 3D viewer for a function of 2 variables z=f(x,y). That is, with the terrain viewer, I would again be dealing with 'single-valued' functions over a rectangular grid. (We are not generating terrains with caves or overhangs.) So I could use the 'painting' technique that I used in the f(x,y) surface generator-and-viewer utility --- a technique of starting the 'painting' from the 'far corner' of the rectangular grid. To have the ability to choose other sorting methods, I decided to provide radiobuttons on the GUI so that a variety of sorting methods could be tried out. (I plan to 'back-port' those buttons to the 3D OBJ/PLY/OFF/STL viewer utility.) --- In aiming to accomplish these goals, I ended up with the GUI seen in the following image. [3DterrainGeneratorExaminerGUI_grayscaleHeightMap_imageOnly_960x623.jpg] When started up, the GUI first appears with a blank entry field for the image filename. The image above demonstrates that when you select an image file with the 'Browse...' button, after closing the Tk OpenFile GUI utility, you are returned to this GUI and the image is shown in the upper left corner of the Tk canvas. The following image shows that when you trigger one of the events that causes the image file to be 'plotted' --- for example, clicking with MouseButton3 on the filename entry field --- a terrain is generated from the image file. [3DterrainGeneratorExaminerGUI_heightMap_fillOutline_magentaWhite_noShade_1024x713.jpg] And the following image shows that you can pick up the colors from the pixels of the image file (grays in this case) to color the polygons of the terrain. [3DterrainGeneratorExaminerGUI_heightMap_fillOnly_pixelColors_noShading_1024x715.jpg] In these images, you can see the three buttons for color-setting, across the top of the GUI --- 'Fill', 'Outline', and 'Background'. In the frame below the color-buttons frame, you can see the entry field for an image filename --- along with a 'Browse...' button. Below that frame, you can see the frame for entry fields by which the user can specify 'grid-distances' to convert the x,y pixel locations into 'world coordinates' for the rectangular grid which is the 'domain' of the terrain surface. Also in that frame is a 'z-height-factor' to apply to a sum of the RGB values of each pixel to get a z-height, in 'world coordinates', for each pixel (i.e. for each x,y location of the rectangular grid). And the next frame contains the 2 scales for the longitude (yaw) and latitude (pitch) rotation angles --- around the fixed, 'viewing' axes --- the y-axis and the x-axis, respectively. Also in that frame is the scale for zooming the model, in or out. ___ In the frame on the left (which can be switched to the right with the 'ToggleSide' button at the top of the GUI), you can see several groups of radiobuttons, each in their own frame. The frames, from the top, are for * fill/outline radiobuttons * fill-color-source radiobuttons * fill-color-shading-type radiobuttons ___ In addition to showing these GUI features, the images above indicate that the default polygon-sort routine (painting starting from the 'far corner') does its job quite capably --- at least for these terrain surfaces that contain lots of polygons of approximately the same size (and no long 'slivers'). ___ '''IMAGE SIZE CONSIDERATIONS''' A 640x480 image file would generate a rather large grid in the sense that each polygon of the terrain surface would be less than 3 pixels across, if one shows the entire grid on a large monitor, say 1900x1200. On a smaller monitor, say 1024x768, the polygons would be less than 2 pixels across --- especially since the canvas area is quite a bit smaller than the monitor size (about 60 to 70% of the monitor area). The number of 'segments' of the rectangular grid in the x direction and in the y direction are determined by the dimensions of the image file. For example, a 640x480 image file yields 640x480 = 307,200 height-points and a rectangular grid of 639 segments by 479 segments for 639x479 = 306,081 rectangles in the grid --- or 612,162 triangles if we ever convert each (not necessarily planar) quadrilateral over a grid rectangle into 2 (planar) triangles. With the 3D OBJ/PLY/OFF/STL reader-viewer, the 'bunny' model that contained 69,451 faces --- what seemed like a superfluous number of triangular faces --- was drawn in about 14 seconds. So we can expect a terrain generated from a 200x200 pixel image file, which would contain about 40,000 polygons, to take around 10 seconds to be drawn --- especially if we use a sort routine that does an 'lsort'. Hence, this utility shows the user a warning popup message if the image file is going to create a terrain that will be difficult to show in its entirety --- say images larger than about 200x200 pixels. ___ Certainly these draw speeds are not as fast as a terrain viewer using OpenGL (and firmware in a graphics card to handle the 'graphics pipeline'). But the draw speed is not too shabby for free software --- and considering the large number of polygons --- and if you simply want to examine the terrain, not make it spin like a top. I was pleasantly surprised that I could view pretty elaborate terrains --- surfaces with tens of thousands of polygons --- in a reasonable amount of time. --- ''' HELP TEXT''' The 'Help' button on the GUI shows the following text. It describes the various ways in which a 'draw' is triggered. ------ '''HELP for this 3D Terrain-Surface Generation-and-Examination Utility''' SELECTING/ENTERING AN IMAGE FILENAME: When the GUI comes up, you can use the 'Browse...' button next to the image-filename entry field to select an image file from which to generate a terrain-surface to examine. INITIAL DISPLAY OF THE TERRAIN SURFACE: An Enter-key-press --- or MouseButton-3 (MB3) click-release --- on the filename entry field will cause a terrain surface (vertices and polygons) to be generated and plotted in the canvas area --- according to the current settings of the various generate and examine options in the GUI. SAVING THE SURFACE: If the surface looks useful, use the 'WriteOBJ' button to save the vertex and connectivity (polygon) data in a 3D data file in Wavefront OBJ format. --- CHANGING THE GENERATED SURFACE : If the image does not give the surface that you were seeking, you can take the image file into an image processing utility to create a different image file to try. Then simply read in the new image file to see how it looks. Or find and try a different image file. Or write out an OBJ file and read it into a 3D model editor, like Blender or Wings3D, to change the terrain. --- ALTERING THE GRID DISTANCES and HEIGHT FACTOR: You can change the grid parameters --- xmin,xstep,ymin,ystep --- and z-height factor --- by entering new values. To re-plot based on the new 'distance parameters', you can press the Enter key in any distance entry field --- or to re-plot at ANY time, you can MB3-click-release on any of the 'distance-entry-fields'. Changing the distance parameters may not change the form of the surface, but they definitely change the data that would be written to a Save file, like a Wavefront OBJ file. --- CHANGING THE VIEW ANGLE: You can use the two 'angle-scale' widgets to quickly change either of a couple of rotation angles --- longitude (yaw) or latitude (pitch). An MB1-release of the slider on a angle-scale widget causes a replot. You can simply keep clicking in the 'trough' of either scale widget (to the left or right of the scale-button) to step through a series of re-plots, varying an angle one degee per click-release. Or you can hold MB1 down, when the mouse cursor is to the right or left of the scale-button in the trough, to rapidly but rather precisely change to a new angle of rotation. Releasing MB1 will cause a re-plot at the new angle. --- ZOOMING: You can use the 'zoom-scale' widget to magnify or shrink the plot. An MB1-release of the slider on the zoom-scale widget causes a replot. Click-release in the 'trough' --- on either side of the scale's button --- to zoom in/out a little at a time. --- FILL-ONLY/FILL-and-OUTLINE/WIRE-hidden/WIRE-show-all: The fill/outline/wire radiobuttons allow for showing the plot with the polygons color-filled or not --- and with outlines ('wireframe' mode) or not. --- COLOR: Three COLOR BUTTONS on the GUI allow for specifying a color for - the interior of the polygons - the outline of the polygons - the (canvas) background from among 16 million colors, each. --- Summary of 'EVENTS' that cause a 'REDRAW' of the plot: Pressing Enter/Return key when focus is in the image-filename entry field. Alternatively, a button3-release on the image-filename entry field. Pressing Enter/Return key when focus is in the - 'xmin' entry field - 'xstep' entry field - 'ymin' entry field - 'ystep' entry field - 'z-height-factor' entry field Alternatively, a button3-release in any of these 'distance-entry-fields'. Button1-release on the LONGITUDE or LATITUDE scale widget. Button1-release on the ZOOM scale widget. Button1-release on the either of the 2 WIRE radio-buttons. Button1-release on any of the SHADING option radio-buttons. Changing color via the FILL-COLOR or OUTLINE-COLOR buttons. ALSO: Resizing the window changes the size of the canvas, which triggers a redraw of the plot according to the new canvas size. ------ '''The code''' I provide the code for this 3D terrain generator-and-examiner Tk script below. I follow my usual 'canonical' structure for Tk code 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. Within each frame, define ALL the widgets. Then pack the widgets. 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 other scripts (code re-use). I call your attention to step-zero. 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. I think that I have used a nice choice of the 'pack' parameters. The labels and buttons and scales stay fixed in size and relative-location as the window is re-sized --- while the 'canvas' expands/contracts as the window is re-sized. 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. ___ Note that the color buttons call on a color-selector-GUI script to set the colors. You can make that color-selector script by cutting-and-pasting the code from the page [A non-obfuscated color selector GUI] on this site. ------ '''Some features in the code''' That said, here's the code --- with plenty of comments to describe what most of the code-sections are doing. You can look at the top of the PROCS section of the code to see a list of the procs used in this script, along with brief descriptions of how they are called and what they do. ___ As in my other three 3D viewer scripts, one interesting feature of this GUI is the way the procs involved in a redraw are broken up into a sequence. In this script: 1) load_points_array 2) translate_points_array 3) rotate_points 4) sort_polyIDs_list 5) draw_2D_pixel_polys Some 'events' --- such as MB3-click-release on the image filename entry field --- trigger the execution of all 5 procs (in that order). Other events (like longitude or latitude change) trigger the execution of only the last 3 procs. Clicking on one of the 'sort' radiobuttons triggers the execution of only the last 2 procs. And some 'simple' changes (like a color change or a switch to wireframe mode) trigger the execution of only the last proc. Note that I do most of the calculations in 'world coordinates', NOT pixel coordinates. All the coordinate calculations in the first 3 procs are done in world coordinates. It is in the 5th proc that I obtain a set of 2D points from a family of 3D points, and I map a 'bounding area' of the 2D points into the current canvas area, in units of pixels --- to finally get the plot, via 'create polygon' commands. --- To implement the 'sort_polyIDs_list' proc, I provide several 'compare' procs for the '-command' option of the 'lsort' command. For details on the different comparison techniques used in those procs, see the procs named * compare_2polyIDs_by_MAXzdepth * compare_2polyIDs_by_AVEzdepth * compare_2polyIDs_by_biggerMINzdepth ___ The 'write_obj' proc may be of use to others who need such a 3D model file writer in their Tcl-Tk applications. ----- 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. Without the comments, potential young Tcler's might be tempted to return to their iPhones and iPads and iPods --- to watch videos of snow-mobilers cushioning the fall of their snow-mobiles with their bodies. ====== #!/usr/bin/wish -f ##+########################################################################### ## ## SCRIPT: 3DterrainGeneratorExaminer_fromImgFiles_RyRz_quads.tk ## ## PURPOSE: This Tk script serves to GENERATE AND EXAMINE terrain-type surfaces. ## A surface is generated as height-data over a rectangular grid, ## with the heights based on RGB pixel values in a user-specified ## image file (GIF or PNG). ## ## A user-specified IMAGE FILE is used to generate heights (z-values) ## for x,y values of a rectangular grid, with the x,y points of the grid ## corresponding to the pixel locations in the 2D image. ## ## A GUI is presented by which the user can specify an image file ## and various options for generating and viewing a terrain surface --- ## such as distances between grid points in the x and y directions, ## in 'world-coordinate units'. ## ## The SURFACE GENERATOR portion of this script generates '3D grid points' ## given by reading, scan-line by scan-line, ## the RGB values of pixels from a user-specified image file. ## ## Each x,y value is computed from user-specified x and y 'min' and 'step-sizes' ## for each succeeding pixel in the x and y directions, to get the ## x,y coordinates in units of 'world coordinates' --- such as meters, ## feet, kilometers, or degrees. The x,y min values and step-sizes ## come from 2 entry fields on the GUI. ## ## The z-value at each x,y value is computed based on an expression ## involving the RGB values (0 to 255) of the corresponding pixel. ## ## For example, the expression may be a weighted sum (or average) of ## the 3 RGB values (a 'brightness' of the pixel). Eventually, ## radiobuttons could be placed on the GUI to allow for various ways ## of generating the z-values from the RGB values --- such as ## R-only, G-only, B-only, and various weighted averages of RGB. ## ## The computed z-value is multiplied by a user-specified scale factor ## from an entry field on the GUI, to get the z-height in ## 'world coordinates' --- such as a 'realistic' range of meters or feet. ## ## There could be options on the GUI to apply some adjustments to the ## z-values --- say, via adding randomized height values over the grid. ## I.e. we could provide options to modify the z-values that are ## computed from the RGB values of the image file --- to allow ## for modifying the terrain in specific ways. ## ## However, to keep the GUI from getting any 'busier' than it already is, ## rather than offering terrain modification options on the GUI, we ## leave it to the user to edit/image-process an image file and re-load ## it into this utility, to get a somewhat different terrain. ## Another alternative would be to write out a 3D data file (such as OBJ) ## and take that 3D model/surface file into a 3D model editor such as ## Blender or Wings3D. Or provide a separate Tk script that reads OBJ ## files and provides surface editing options and a write-OBJ option. ## ## The number of 'segments' of the rectangular grid in the x direction ## and in the y direction are determined by the dimensions of the ## image file. For example, a 640x480 image file yields 640x480 = ## 307,200 height-points and a rectangular grid of 639 segments by ## 479 segments for 639x479 = 306,081 rectangles in the grid --- ## or 612,162 triangles if we ever convert each (not necessarily planar) ## quadrilateral over a grid rectangle into 2 (planar) triangles. ## ## A 640x480 image file would generate a rather large grid in the sense ## that each polygon of the terrain surface would be less than 3 pixels across, if ## if one shows the entire grid on a large monitor, say 1900x1200. On a ## smaller monitor, say 1024x768, the polygons would be less than 2 pixels ## across --- especially since the canvas area is quite a bit smaller than ## the monitor size (about 60 to 70% of the monitor area). ## ## The user may receive a warning popup message if the image file ## is going to create a terrain that will be difficult to show in its ## entirety --- say images larger than about 200x180 pixels. ## ## The set of 3D points x(i,j),y(i,j),z(i,j) that are generated are ## stored in a Tcl array variable, 'aRpoints' --- where i varies from ## 0 thru Nxsegs and j varies from 0 thru Nysegs --- and where ## Nxsegs and Nysegs are one less than the x and y dimensions of the ## image file. ## ## Rather than using 'i,j' as the index of the 'aRpoints' array, ## we will use a single integer based on i,j. This will reduce the ## need for double loops in various procs --- such as the write-OBJ ## proc and the translate, rotate, sort, and draw procs of the ## 'graphics pipeline'. ## ## The EXAMINER portion of this script allows the user to rotate ## (and zoom) the quadrilateral (or triangular) polygons into which ## each terrain surface may be segmented. ## ## The examiner allows for various display options for the polygons: ## - fill-only, fill-and-outline, outline-only(hidden), outline-only(show-all) ## - fill-color source (ColorButton, ImagePixels, ColorTable, Random) ## - fill-color shading (none, byZheight, byViewDepth, byLighting) ## as well as some depth-sort ('painting'-order) options. ## ## A 'write' button is provided on the GUI so that the ## terrain data can be written to a 3D file format, such as ## a Wavefront OBJ file. ## ##+################### ## MESH CONSIDERATIONS: ## ## Note that if we use 3D quadrilaterals to project onto the 2D canvas, ## the 3D quadrilaterals are not necessarily planar. ## ## If we are painting each 3D quadrilateral as a solid color (with no shading ## being applied, due to lighting effects or geometry heights/depths), the ## quadrilaterals can simply be projected onto a viewing plane and ## colored without having to take into account the possible non-planarity ## of the quadrilaterals. ## ## However, if we want to be able to apply more subtle coloring/shading ## to a mesh representing the terrain surface, then we may want ## to use a mesh of triangles rather than quadrangles. How to ## do that trianglulation becomes an issue, because there are ## multiple ways each quadrangle could be broken into triangles ## --- 2 triangles per quadrangle (2 different diagonal directions ## to choose from --- randomized or consistent) or 4 triangles per ## quadrangle (by adding a mid-point to each quadrangle), and so on. ## ## We may someday provide radiobuttons on the GUI by which the user can ## specify which type of mesh should be generated --- and viewed. ## ##+################## ## METHOD OF ROTATION by the EXAMINER: ## ## In this script, the points in the 'data cloud' of the segmented ## terrain surface are automatically translated so that rotations ## are performed around a point in the middle of the 'data cloud'. ## ## We imagine our 'viewing' coordinate system to be as follows: ## ## - positive z-axis is 'up' (and parallel to the monitor surface) ## - positive y-axis is 'to the right' (and parallel to the monitor surface) ## - positive x-axis is 'out of the screen' (perpendicular to the monitor surface) ## ## The 2D projection points of rotated 3D points x(i,j),y(i,j),z(i,j) are ## determined according to a user-specified view direction --- specified ## via a longitude angle ('yaw', around the z viewing-axis) and a latitude ## angle ('pitch', around the y viewing-axis). ## ## In other words, the rotation of the terrain surface is determined by ## those 2 viewing angles. ## ## In terms of rotation matrices, we will rotate the 'cloud of points' ## of a given 'polygonized' terrain surface according to a ## rotation matrix product Ry * Rz. ## ## A bounding rectangle of the translated-rotated-projected 3D points is ## determined and the 2D projection points are then 'mapped' onto the ## 'current' rectangular Tk canvas. ## ## The '3D plot' onto the canvas is achieved by plotting 4-sided polygons ## (or 3-sided polygons) made from the 2D projection points of the corners ## of the not-necessarily-planar quadrilateral polygons (or corners of ## the planar triangular polygons) in 3-space. ## ## The projected polygons are plotted on the Tk canvas with Tk ## canvas 'create polygon' commands. ## ##+######################## ## BASED ON and INSPIRED BY: ## ## This script is based on my own 3D-utility scripts: ## - for examining 3D surfaces made from functions of 2 variables, ## z=f(x,y), ## - for examining 3D 'parametric' surfaces, defined by functions ## f(u,v), g(u,v), h(u,v), ## - for examining 3D model files --- OBJ, PLY, OFF, or STL files. ## ## These scripts of mine, in turn, were inspired by 3D scripts of ## Mark Stucky, Gerard Soohaket, Arjen Markus, and Marco Maggi ## at the Tcl-Tk Wiki --- http://wiki.tcl.tk. ## ##+################################### ## SOME DISPLAY OPTIONS OF THIS SCRIPT --- many adapted from my other 3D scripts: ## ## - I allow the user to specify LATITUDE AND LONGITUDE ANGLES to specify ## the view direction. I use 2 Tk scales so that setting the 2 view angles ## can be done quickly and a redraw is almost immediate. I use button1-release ## bindings on the scales to cause the redraw as soon as a scale change is complete. ## ## The user can keep tapping button1 'in the trough' of either scale to step ## through rotating the surface, one degree per click. ## ## (I may eventually add bindings to mouse events on the canvas, like , ## so that the view rotation can be done even more quickly & conveniently. ## This would be similar to rotate/zoom/pan controls that Mark Stucky provided ## in a 3D model viewer that he published at wiki.tcl.tk/15032.) ## ## - I allow COLOR CHOICES for the ## - canvas background ## - the polygon fill ## - the polygon outline ## from among 16 million colors, each. ## ## - I provide several radiobuttons by which POLYGON FILL AND/OR OUTLINE options ## can be specified. ## ## - I provide some radiobuttons by which the user can specify COLOR SOURCE of ## the 'fill' color for the polygons: ## - by the polygon-fill button, ## - by the color of pixels in the image file, ## - by a fixed table of N-colors (rainbow-like) ## - by a randomly-generated table of N-colors, ## where N may be the same as the number of entries in the 'fixed' color ## table, and where the N-random-colors-table is regenerated each ## time this radiobutton is clicked. ## ## - I provide some radiobuttons by which the user can specify SHADING of the ## the 'fill' color for the polygons: ## - none ## - by z-height of the terrain ## - by view-depth (distance of polygons from the viewer) ## - by lighting (based on light from the viewer and perpendicular ## to the 2D projection plane). ## ## - I provide a 'ZOOM' Tk scale widget, by which the plot/projection can easily be ## resized, down or up --- to make sure the entire plot can be seen on the canvas. ## ## Like with the 2 scales for the longitude-latitude view angles, I use a ## button1-release binding on the zoom scale to cause the redraw as soon as a ## scale change is complete. ## ## In summary, this GUI provides a wealth of options, such as a variety of color ## controls, multiple ways of triggering a quick redraw (Enter key in the image ## filename entry widget, button1-release on scale widgets or shading widgets, ...), ## and easy-quick control on putting the entire plot within the canvas (auto-mapping ## of the diameter of the model into the current canvas area, and a zoom control). ## ##+######################### ## MATH UNITS CONSIDERATIONS ('world coordinates' and pixels): ## ## I do the translation and rotation calculations in 'world coordinates'. ## When I have a rotated set of 2D points from a family of 3D points (the x,y ## coordinates of the translated-rotated 3D points), I map a 'bounding area' ## of the 2D points into the current canvas area, in units of pixels --- ## to finally get the 'plot' for a given longitude and latitude. ## ##+############################### ## SORTING/PAINTING CONSIDERATIONS (hidden polygons): ## ## In my z=f(x,y) 3D surface plotting script, ## I used a "painter's algorithm" (or my interpretation of it) ## to handle hiding portions of polygons that are hidden by ## polygons in the foreground. I started drawing polygons from ## the corner of the grid that is farthest away from the view point (eye). ## ## On the other hand, in the parametric (u,v) 3D surface plotting script ## and in the 3D model file plotting script (OBJ,PLY,OFF,STL), I used ## a 'z-depth sort' proc inserted between the 'rotate' and the 'draw' procs ## of the 'load-translate-rotate-draw' sequence. ## ## For this script, I use a 'sort' proc based on comparing the a z-depth ## of the polygons. (Actually an x-depth is used, because of the choice ##of x-axis 'out of the monitor'.) ## ## Note that there are multiple ways the x-depth of a polygon ## could be computed from its several vertices. ## ## Also note that we can still revert to drawing polygons from the ## corner of the grid that is farthest away from the view point (eye). ## ## One would simply need to put the following type of logic in the ## 'sort' proc, to return a list of sorted polygon ID's, based on ## view-quadrant-and-far-corner considerations. ## ## One could build the sorted list via the following considerations. ## ## Let the xy quadrant --- over which the 'eye' lies --- (i.e. the quadrant ## of the longitudinal angle) determine the 'start corner' of the 'painting'. ## ## For example, if the 'eye' is over the first quadrant of the xy plane, ## the 'start corner' of 'painting' would be the xmin,ymin (far) corner of the ## 'rectangular grid' below the x,y,z terrain points. So we would build the ## sorted list of polygon IDs, in a double loop, starting from that corner. ## ## 2nd example: If the 'eye' lies over the 3rd quadrant of the xy plane, ## the 'start corner' of 'painting' (sorted-list-building) would be the ## xmax,ymax corner of the 'rectangular grid'. ## ## Similarly, if over the 2nd quadrant, we start at xmax,ymin. ## ## And, if over the 4th quadrant, we start at xmin,ymax. ## ## If this 'corner-based-sort' technique results in too many 'artifacts', ## I can adapt some of the polygon-sort procs that I used in my script for ## examining 3D model files (OBJ, PLY, OFF, or STL files) for use in this script. ## ## Also, we have the option of using triangles rather than quadrangles ## for the polygonal surface of the terrain, to reduce artifacts. ## ##+####################### ## A SHADING CONSIDERATION (light-shading of polygons): ## ## We will assume a light source coming from the viewer (i.e. parallel ## to the fixed, viewing x-axis - out of the screen), and do a dot-product ## of the normal of each polygon to the x-axis to determine a lighting ## factor (cosine of an angle) to apply to the color of each polygon. ## ##+######################################################################### ## GUI FEATURES: ## ## This script provides a Tk GUI that includes the following widgets ## and features. ## ## 1) There is an IMAGE FILENAME ENTRY FIELD (along with a 'Browse...' ## button) into which the user can enter the name of an image file ## (GIF or PNG). ## ## 2) The user presses the Enter/Return key on the filename-entry field ## --- or uses a button3-release on the field --- to initially ## generate a terrain surface that is plotted on the canvas. ## ## 3) There are 2 SCALES for setting LONGITUDE-LATITUDE ANGLES that ## determine the view direction --- and therby specify the direction ## of the projection (of 3D points onto a 2D 'viewing plane'). ## ## There is also 1 SCALE for the ZOOM function. ## ## 4) There are ENTRY FIELDS for the X AND Y 'STEP-SIZES' for the ## the rectangular grid to be used for the terrain generation. ## ## There is also an ENTRY FIELD for a Z-HEIGHT-FACTOR to apply ## to the z-heights calculated from the RGB pixel values. ## ## Also, there COULD BE entry fields so that the user can enter ## integers --- like Nxseg and Nyseg --- to specify some subset ## of the image (rectangular domain) to be used to make the terrain. ## But, to avoid adding even more to an already 'busy' GUI, we ## do not do that. The user can copy-and-crop the image file instead. ## ## 5) There are also some COLOR BUTTONS on the GUI that allow ## the user to specify ## - a 'FILL'-COLOR for the polygons that make up the ## 3D surface being plotted ## - an 'OUTLINE'-COLOR for the polygons ## - a color for the BACKGROUND of the plot (the canvas). ## ## 6) Many RADIOBUTTONS to specify (1) fill/outline options, (2) ## fill-color source options, and (3) fill-color shading options. ## ##+####################################################################### ## 'CANONICAL' STRUCTURE OF THIS CODE: ## ## 0) Set general window parms (win-name, win-position, color-scheme, ## fonts,widget-geometry-parameters, win-size-control,text-for-labels-etc). ## 1a) Define ALL frames (and sub-frames, if any). ## 1b) Pack the frames and sub-frames. ## 2) Define & pack all widgets in the frames, frame-by-frame. ## Define ALL the widgets for a frame. Then pack them in the frame. ## ## 3) Define key and mouse/touchpad/touch-sensitive-screen 'event' ## BINDINGS, if needed. ## 4) Define PROCS, if needed. ## 5) Additional GUI initialization (typically with one or more of ## the procs), if needed. ## ##+################################# ## Some detail of the code structure of this particular script: ## ## 1a) Define ALL frames: ## ## Top-level : ## 'fRtop' - to contain sub-frames for ## - buttons (Exit,Help,3-colors,Write-OBJ) and a label widget ## - label-entry-button widgets for entering image filename ## 'fRopts' - to contain some groups of radiobuttons & checkbuttons ## 'fRcanvas' - to contain a canvas widget ## ## Sub-frames of 'fRtop' (top to bottom): ## 'fRbuttons' - to contain an 'Exit' button, a 'Help' button, ## 3 color-setting buttons, and ## a label widget to show current color parm values ## 'fRfilename ' - to contain label & entry widgets and Browse-button ## 'fRfactors' - entry widgets for x,y step-sizes and z-height-factor ## 'fRscales' - to contain longitude,latitude,zoom scale widgets ## 'fRsorts' - to contain radiobuttons for 'x-depth' sort types ## ## Sub-frames of 'fRopts' (top to bottom): ## 'fRfillout' - about 4 radiobuttons for fill/outline opts ## 'fRfillsrc' - about 3 radiobuttons for fill-source (button,pixels,table,random) ## 'fRshade' - about 3 radiobuttons for shading opts (none,Zheight,viewDepth,Lighting) ## ## 1b) Pack ALL frames. ## ## 2) Define & pack widgets in the frames, frame by frame -- basically ## going through frames & their interiors in top-to-bottom and/or ## left-to-right order. ## Define ALL the widgets for a frame, then pack them in the frame. ## ## 3) Define BINDINGS: ## - Return/Enter key-press on the image filename entry widgets ## - Button3-release on the image filename entry fields ## ## Also ## - Return and Button3-release on the x-stepsize,y-stepsize, ## and z-height-factor ## - Button1-release on the longitude,latitude,zoom scale widgets ## ## See the BINDINGS section of the code for other bindings. ## ## 4) Define PROCS: ## - procs to do load-points-array, translate-points, ## rotate-points, and then pixel-draw-the-polygons. ## - 3 procs for setting colors (fill, outline, background/canvas) ## ## See the PROCS section in the code below for other procs. ## ## The 4 load-translate-rotate-draw procs are all executed whenever ## the user triggers the bindings on the image filename entry widget. ## ## The 2 rotate-draw procs are executed whenever there is a change ## in either the longitude or latitude angle. ## ## The draw proc is executed whenever there is a 'simple' change, such as ## a color change (polygon or outline) or a change in the zoom scale. ## ## 5) Additional GUI initialization: ## - initialize color button settings ## - set initial grid-creation-parameters (x-stepsize,y-stepsize, ## z-height-factor) ## - set an initial view direction (longitude,latitude) ## - set an initial zoom factor ## - initialize various radiobutton settings ## ## See the added-GUI-INITIALIZATION section at the bottom of the code ## for complete intialization info. ## ##+####################################################################### ## 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 ## but this script should work in most previous 8.x versions, and probably ## even in some 7.x versions (if font handling is made 'old-style'). ##+####################################################################### ## MAINTENANCE HISTORY: ## Started by: Blaise Montandon 2013jan21 Started based on other 3D scripts ## and image processing scripts. ## Changed by: Blaise Montandon 2013jan22 ##+######################################################################## ##+####################################################################### ## Set general window parms (title,position). ##+####################################################################### wm title . "Generator-Examiner for 3D Terrain Surfaces, based on Image Files" wm iconname . "3Dterrain" wm geometry . +15+30 ##+###################################################### ## Set the color scheme for the window and its widgets --- ## such as entry field and listbox background color. ##+###################################################### tk_setPalette "#e0e0e0" set listboxBKGD "#f0f0f0" set entryBKGD "#f0f0f0" set scaleBKGD "#f0f0f0" set radbuttBKGD "#f0f0f0" set labelFGND "#ff0000" set labelBKGD "#cccccc" ## Initialize the polygons fill-color (COLOR1) and ## the outline-color (COLOR2) --- and background (canvas) color. ## ## Alternatively, these initial color settings could be moved ## to the additional-GUI-initialization' section at the bottom ## of this script. # set COLOR1r 255 # set COLOR1g 255 # set COLOR1b 255 set COLOR1r 255 set COLOR1g 0 set COLOR1b 255 set COLOR1hex [format "#%02X%02X%02X" $COLOR1r $COLOR1g $COLOR1b] # set COLOR2r 255 # set COLOR2g 255 # set COLOR2b 255 set COLOR2r 255 set COLOR2g 255 set COLOR2b 255 set COLOR2hex [format "#%02X%02X%02X" $COLOR2r $COLOR2g $COLOR2b] # set COLORbkGNDr 60 # set COLORbkGNDg 60 # set COLORbkGNDb 60 set COLORbkGNDr 0 set COLORbkGNDg 0 set COLORbkGNDb 0 set COLORbkGNDhex \ [format "#%02X%02X%02X" $COLORbkGNDr $COLORbkGNDg $COLORbkGNDb] ## Make a 'color table' of Ncolors, for use with the ## 'byColorTable' option of the Shade options. ## ## PRELIMINARY. This table may have entries added to be a table ## of at least 18 colors. And color values may be refined by ## some testing with terrain-like models. ## Lake/Ocean Blue # set aRcolor(1) "#0099ff" set aRcolor(1) [list 0 153 255] ## Blue-Green # set aRcolor(2) "#00ccaa" set aRcolor(2) [list 0 204 170] ## Delta/Riverside Green # set aRcolor(3) "#00ff00" set aRcolor(3) [list 0 255 0] ## Green-to-Brown # set aRcolor(4) "#66cc00" set aRcolor(4) [list 102 204 0] ## Dark Earth Brown # set aRcolor(5) "#cc6622" set aRcolor(5) [list 204 102 16] ## Light Earth Brown # set aRcolor(6) "#eeaa66" set aRcolor(6) [list 238 170 102] ## Dark Green Trees # set aRcolor(7) "#009900" set aRcolor(7) [list 0 153 0] ## Green-to-Gray # set aRcolor(8) "#66aa66" set aRcolor(8) [list 102 170 102] ## Gray Alps/Mountains Rock-Gravel # set aRcolor(9) "#cccccc" set aRcolor(9) [list 204 204 204] ## Gray-to-White # set aRcolor(10) "#dcdcdc" set aRcolor(10) [list 220 220 220] ## Snow White # set aRcolor(11) "#ffffff" set aRcolor(11) [list 255 255 255] set Ncolors 11 ##+######################################################## ## Use a VARIABLE-WIDTH font for text on label and ## button widgets. ## ## Use a FIXED-WIDTH font for the listbox list and for ## the text in the entry field. ##+######################################################## 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 font create fontTEMP_SMALL_fixedwidth \ -family {liberation mono} \ -size -10 \ -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. width and height of canvas, and padding for Buttons) ##+########################################################### ## CANVAS widget geom settings: set initCanWidthPx 300 set initCanHeightPx 300 set minCanWidthPx 100 set minCanHeightPx 24 # set BDwidthPx_canvas 2 set BDwidthPx_canvas 0 ## BUTTON widget geom settings: set PADXpx_button 0 set PADYpx_button 0 set BDwidthPx_button 2 ## LABEL widget geom settings: set PADXpx_label 0 set PADYpx_label 0 set BDwidthPx_label 2 set RELIEF_label "raised" ## ENTRY widget geom settings: set BDwidthPx_entry 2 set initFuncEntryWidthChars 20 set uvEntriesWidthChars 5 ## LISTBOX geom settings: set BDwidthPx_listbox 2 set initListboxWidthChars 30 set initListboxHeightChars 8 ## SCALE geom parameters: set BDwidthPx_scale 2 set initScaleLengthPx 200 ## RADIOBUTTON geom parameters: set PADXpx_radbutt 0 set PADYpx_radbutt 0 set BDwidthPx_radbutt 2 ## CHECKBUTTON geom parameters: set PADXpx_chkbutt 0 set PADYpx_chkbutt 0 set BDwidthPx_chkbutt 2 ##+###################################################### ## Set a MINSIZE of the window (roughly): ## ## MIN-WIDTH according to the approx min width of the ## listbox and function-entry widgets (about 20 chars each) ## ## MIN-HEIGHT according to the approx min height of the ## listbox widget, about 8 lines. ##+###################################################### set charWidthPx [font measure fontTEMP_fixedwidth "0"] ## FOR MIN-WIDTH: ## Use the init width of the listbox and entry widgets, in chars, ## to calculate their total width in pixels. Then add some ## pixels to account for right-left-size of window-manager decoration, ## frame/widget borders, and the vertical listbox scrollbar. set minWinWidthPx [expr {20 + ( $initListboxWidthChars * $charWidthPx ) + \ ( $initFuncEntryWidthChars * $charWidthPx )}] set charHeightPx [font metrics fontTEMP_fixedwidth -linespace] ## FOR MIN-HEIGHT: ## Get the height of the init number of lines in the listbox ## and add about 20 pixels for top-bottom window decoration -- ## and about 8 pixels for frame/widget borders. set minWinHeightPx [expr {28 + ( $initListboxHeightChars * $charHeightPx )}] ## 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. ## ## Just press the Enter key on an entry field (or use button3-release ## on an entry field) --- or use button1-release on a scale wdiget --- ## or any perform any 'event' to cause the pixel-draw proc to execute --- ## to re-fill the canvas according to the the user-specified functions ## and grid --- and the current canvas dimensions. ## 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 the 'fRbuttons' frame: set aRtext(buttonEXIT) "Exit" set aRtext(buttonHELP) "Help" set aRtext(buttonTOGSIDE) "Toggle Side" set aRtext(buttonWRITEobj) "Write OBJ file" set aRtext(buttonCOLOR1) "Polygon Fill Color" set aRtext(buttonCOLOR2) "Polygon Outline Color" set aRtext(buttonBkgdCOLOR) "Background Color" set aRtext(labelDRAWTIME) "Select or enter an image filename (GIF or PNG). To generate surface, press Enter with text-cursor in the file entry field (or MouseButn3-click the file entry field). Before or after the 'gen', change values for distances, view-angles, zoom, etc." ## For the 'fRfilename' frame: set aRtext(labelFILENAME) "Image Filename (GIF or PNG):" set aRtext(buttonBROWSE) "Browse..." ## For the 'fRfactors' frame: set aRtext(labelGRID) "Grid distances:" set aRtext(labelXMIN) " xmin" set aRtext(labelXSTEP) " x-step" set aRtext(labelYMIN) " ymin" set aRtext(labelYSTEP) " y-step" set aRtext(labelZFACTOR) " Z-height-factor:" ## For the 'fRscales' frame: set aRtext(labelVIEW) "View via 2 angles longitude,latitude:" set aRtext(labelZOOM) "Zoom:" ## For the 'fRsorts' frame: set aRtext(labelSORT) "SortOpts:" set aRtext(radbuttSORTmaxDepth) "MAXpolyDepth" set aRtext(radbuttSORTaveDepth) "AVEpolyDepth" set aRtext(radbuttSORTminDepth) "MINpolyDepth" set aRtext(radbuttSORTfarCorner) "fromFARcorner" ## For the 'fRfillout' frame: set aRtext(labelFILLOUT) "FILL or OUTLINE polys (wire = outline-only):" set aRtext(radbuttFILLOUTfillonly) "fill-only" set aRtext(radbuttFILLOUTboth) "fill-and-outline" set aRtext(radbuttFILLOUTwirehide) "wire-hidden" set aRtext(radbuttFILLOUTwirenohide) "wire-showall" set aRtext(labelWIRE) " Color for the 'wire' display options above is set from the Polygon-Outline color button." ## For the 'fRfillsrc' frame: set aRtext(labelFILLSRC) "FILL-COLOR source:" set aRtext(radbuttFILLSRCfromFile) "ImageFilePixels" set aRtext(radbuttFILLSRCfromButton) "FillColorButton" set aRtext(radbuttFILLSRCfromTable) "$Ncolors-FixedColorsTable" set aRtext(radbuttFILLSRCrandom) "$Ncolors-RandomColorsTable" ## For the 'fRshadeopts' frame: set aRtext(labelSHADE) "Do FILL-SHADING according to:" set aRtext(radbuttSHADEnone) "noShading" set aRtext(radbuttSHADEorigZheight) "polyZheight" set aRtext(radbuttSHADEviewDepth) "polyViewDepth" set aRtext(radbuttSHADEbyLighting) "polyLighting (from viewer)" # set aRtext(radbuttSHADEorigYheight) "polyYheight" # set aRtext(radbuttSHADEorigXheight) "polyXheight" set aRtext(labelSHADEinfo) "\ Clicking on any of the Fill-Opts radiobuttons above (non-wire) does NOT cause a re-draw, but clicking on any of the Shade option radiobuttons below DOES cause a re-draw." # set aRtext(labelSHADEinfo) "\ # Shading by 'Lighting' is not implemented yet. # If fill-color-source is ColorTable, pick a # height/depth method, which will be used to # distribute (unshaded) table colors on the model." ## Some error messages: set modelNOTloadedMSG "\ It appears that an image file has not been loaded yet. Try selecting or entering a filename for the filename entry field. Then press Enter/Return or click MouseButton3 on the entry field." ## END OF if { "$VARlocale" == "en"} ##+################################################################ ## DEFINE *ALL* THE FRAMES: ## ## Top-level (arranged as indicated in this layout): ## 'fRtop' ## 'fRopts' 'fRcanvas' ## ## Sub-frames of 'fRtop' (top to bottom): ## 'fRbuttons' - to contain an 'Exit' button, a 'Help' button, ## 3 color-setting buttons, and ## a label widget to show current color parm values ## and a label widget for instructions & draw-time ## 'fRfilename ' - to contain label & entry widgets and Browse-button ## 'fRfactors' - entry widgets for x,y step-sizes and z-height-factor ## 'fRscales' - to contain longitude,latitude,zoom scale widgets ## 'fRsorts' - to contain radiobuttons for sort (paint-order) options ## ## Sub-frames of 'fRopts' (top to bottom): ## 'fRfillout' - about 4 radiobuttons for fill/outline opts ## 'fRfillsrc' - about 4 radiobuttons for fill-source (button,pixels,table,random) ## 'fRshade' - about 4 radiobuttons for shading opts (none,Zheight,viewDepth,Lighting) ## ##+################################################################ ## FOR TESTING: (esp. to check behavior during window expansion) # set BDwidth_frame 2 # set RELIEF_frame raised set BDwidth_frame 0 set RELIEF_frame flat frame .fRtop -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRopts -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRcanvas -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRtop.fRbuttons -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRtop.fRfilename -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRtop.fRfactors -relief $RELIEF_frame -borderwidth $BDwidth_frame # frame .fRtop.fRscales -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRtop.fRscales -relief groove -borderwidth 2 frame .fRtop.fRsorts -relief $RELIEF_frame -borderwidth $BDwidth_frame frame .fRopts.fRfillout -relief $RELIEF_frame -bd $BDwidth_frame frame .fRopts.fRfillsrc -relief $RELIEF_frame -bd $BDwidth_frame frame .fRopts.fRshadeopts -relief $RELIEF_frame -bd $BDwidth_frame ##+############################## ## PACK the FRAMES. ##+############################## pack .fRtop \ -side top \ -anchor nw \ -fill x \ -expand 0 pack .fRopts \ -side left \ -anchor nw \ -fill none \ -expand 0 ## Set a variable for use in the 'toggle_side' proc. set LR_side "left" pack .fRcanvas \ -side left \ -anchor nw \ -fill both \ -expand 1 ## Pack the sub-frames of '.fRtop'. pack .fRtop.fRbuttons \ .fRtop.fRfilename \ .fRtop.fRfactors \ .fRtop.fRscales \ .fRtop.fRsorts \ -side top \ -anchor nw \ -fill x \ -expand 0 ## Pack the sub-frames of '.fRopts'. pack .fRopts.fRfillout \ .fRopts.fRfillsrc \ .fRopts.fRshadeopts \ -side top \ -anchor nw \ -fill x \ -expand 0 ## OK, the frames are defined. Ready to define and pack ## widgets within the frames. ##+#################################### ## In FRAME '.fRtop.fRbuttons' - ## DEFINE-and-PACK 'BUTTON' WIDGETS ## --- exit and color buttons, and ## a label to show current color vals. ## Also checkbuttons for fill, outline. ##+#################################### button .fRtop.fRbuttons.buttEXIT \ -text "$aRtext(buttonEXIT)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {exit} button .fRtop.fRbuttons.buttHELP \ -text "$aRtext(buttonHELP)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {popup_msgVarWithScroll .fRhelp "$HELPtext"} button .fRtop.fRbuttons.buttTOGSIDE \ -text "$aRtext(buttonTOGSIDE)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {toggle_side} button .fRtop.fRbuttons.buttWRITEobj \ -text "$aRtext(buttonWRITEobj)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {write_obj} button .fRtop.fRbuttons.buttCOLOR1 \ -text "$aRtext(buttonCOLOR1)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command "set_polygon_color1" button .fRtop.fRbuttons.buttCOLOR2 \ -text "$aRtext(buttonCOLOR2)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command "set_polygon_color2" button .fRtop.fRbuttons.buttCOLORbkGND \ -text "$aRtext(buttonBkgdCOLOR)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command "set_background_color" label .fRtop.fRbuttons.labelCOLORS \ -text "" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd $BDwidthPx_button label .fRtop.fRbuttons.labelDRAWTIME \ -text "$aRtext(labelDRAWTIME)" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief raised \ -bd $BDwidthPx_button \ -fg $labelFGND \ -bg $labelBKGD ## Pack the '.fRtop.fRbuttons' widgets. pack .fRtop.fRbuttons.buttEXIT \ .fRtop.fRbuttons.buttHELP \ .fRtop.fRbuttons.buttTOGSIDE \ .fRtop.fRbuttons.buttWRITEobj \ .fRtop.fRbuttons.buttCOLOR1 \ .fRtop.fRbuttons.buttCOLOR2 \ .fRtop.fRbuttons.buttCOLORbkGND \ .fRtop.fRbuttons.labelCOLORS \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRbuttons.labelDRAWTIME \ -side left \ -anchor w \ -fill none \ -expand 0 ##+############################### ## In FRAME '.fRtop.fRfilename' - ## DEFINE-and-PACK LABEL & ENTRY. ##+############################### label .fRtop.fRfilename.labelFILENAME \ -text "$aRtext(labelFILENAME)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd 0 ## We set an initial function1 in the GUI initialization ## section at the bottom of this script. entry .fRtop.fRfilename.entFILENAME \ -textvariable ENTRYfilename \ -bg $entryBKGD \ -font fontTEMP_fixedwidth \ -width $initFuncEntryWidthChars \ -relief sunken \ -bd $BDwidthPx_entry button .fRtop.fRfilename.buttBROWSE \ -text "$aRtext(buttonBROWSE)" \ -font fontTEMP_varwidth \ -padx $PADXpx_button \ -pady $PADYpx_button \ -relief raised \ -bd $BDwidthPx_button \ -command {get_image_filename} ## Pack the 'fRfilename' widgets. pack .fRtop.fRfilename.labelFILENAME \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRfilename.entFILENAME \ -side left \ -anchor w \ -fill x \ -expand 1 pack .fRtop.fRfilename.buttBROWSE \ -side left \ -anchor w \ -fill none \ -expand 0 ##+############################################ ## In FRAME '.fRtop.fRfactors' - ## DEFINE-and-PACK LABEL & ENTRY WIDGETS ## --- for x,y min and step-size (to establish ## the rectangular grid in 'world coordinates'). ##+############################################ label .fRtop.fRfactors.labelGRID \ -text "$aRtext(labelGRID)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd 0 label .fRtop.fRfactors.labelXMIN \ -text "$aRtext(labelXMIN)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd 0 ## We set the initial value for this entry widget in the ## GUI initialization section at the bottom of this script. # set ENTRYxmin "0.0" entry .fRtop.fRfactors.entXMIN \ -textvariable ENTRYxmin \ -bg $entryBKGD \ -font fontTEMP_fixedwidth \ -width $uvEntriesWidthChars \ -relief sunken \ -bd $BDwidthPx_entry label .fRtop.fRfactors.labelXSTEP \ -text "$aRtext(labelXSTEP)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd 0 ## We set the initial value for this entry widget in the ## GUI initialization section at the bottom of this script. # set ENTRYxstep "10.0" entry .fRtop.fRfactors.entXSTEP \ -textvariable ENTRYxstep \ -bg $entryBKGD \ -font fontTEMP_fixedwidth \ -width $uvEntriesWidthChars \ -relief sunken \ -bd $BDwidthPx_entry ## AND THE WIDGETS FOR YMIN,YSTEP. label .fRtop.fRfactors.labelYMIN \ -text "$aRtext(labelYMIN)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd 0 ## We set the initial value for this entry widget in the ## GUI initialization section at the bottom of this script. # set ENTRYymin "0.0" entry .fRtop.fRfactors.entYMIN \ -textvariable ENTRYymin \ -bg $entryBKGD \ -font fontTEMP_fixedwidth \ -width $uvEntriesWidthChars \ -relief sunken \ -bd $BDwidthPx_entry label .fRtop.fRfactors.labelYSTEP \ -text "$aRtext(labelYSTEP)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd 0 ## We set the initial value for this entry widget in the ## GUI initialization section at the bottom of this script. # set ENTRYystep "10.0" entry .fRtop.fRfactors.entYSTEP \ -textvariable ENTRYystep \ -bg $entryBKGD \ -font fontTEMP_fixedwidth \ -width $uvEntriesWidthChars \ -relief sunken \ -bd $BDwidthPx_entry ## AND THE WIDGETS FOR Z-HEIGHT-FACTOR. label .fRtop.fRfactors.labelZFACTOR \ -text "$aRtext(labelZFACTOR)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd 0 ## We set the initial value for this entry widget in the ## GUI initialization section at the bottom of this script. # set ENTRYzfactor "10.0" entry .fRtop.fRfactors.entZFACTOR \ -textvariable ENTRYzfactor \ -bg $entryBKGD \ -font fontTEMP_fixedwidth \ -width $uvEntriesWidthChars \ -relief sunken \ -bd $BDwidthPx_entry ##+################################################## ## Pack the '.fRtop.fRfactors' frame's widgets ## --- for entering xmin,xstep,ymin,ystep --- ## grid location/distance/dimension parms. ##+################################################## pack .fRtop.fRfactors.labelGRID \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRfactors.labelXMIN \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRfactors.entXMIN \ -side left \ -anchor w \ -fill x \ -expand 1 pack .fRtop.fRfactors.labelXSTEP \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRfactors.entXSTEP \ -side left \ -anchor w \ -fill x \ -expand 1 ## FOR Y: pack .fRtop.fRfactors.labelYMIN \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRfactors.entYMIN \ -side left \ -anchor w \ -fill x \ -expand 1 pack .fRtop.fRfactors.labelYSTEP \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRfactors.entYSTEP \ -side left \ -anchor w \ -fill x \ -expand 1 ## FOR Z: pack .fRtop.fRfactors.labelZFACTOR \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRfactors.entZFACTOR \ -side left \ -anchor w \ -fill x \ -expand 1 ##+################################################ ## In FRAME '.fRtop.fRscales' - ## DEFINE-and-PACK a pair of LABEL & SCALE WIDGETS ## --- for 2 rotation angles, longitude & latitude. ## ## Also provide a label widget in which to ## show help and/or 'status' info. ##+################################################ label .fRtop.fRscales.labelVIEW \ -text "$aRtext(labelVIEW)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd 0 ## We will set initial values for the ## following 2 scales in the ## additional-GUI-initialization section ## at the bottom of this script. ## This 'scaleLON' is for the longitudinal angle, ## which we allow to range from 0 to 360 degrees. scale .fRtop.fRscales.scaleLON \ -orient horizontal \ -resolution 1 \ -from 0 -to 360 \ -digits 4 \ -length 360 \ -repeatdelay 500 \ -repeatinterval 50 \ -font fontTEMP_SMALL_varwidth \ -troughcolor "$scaleBKGD" \ -tickinterval 360 # -label "$aRtext(scaleLON)" \ # -command {rotate-draw} ## We do NOT use the '-variable' option. ## It may cause 'auto-repeat' problems. # -variable angLON \ ## This 'scaleLAT' is for the latitudinal angle, ## which we allow to range from -90 to +90 degrees. scale .fRtop.fRscales.scaleLAT \ -orient horizontal \ -resolution 1 \ -from -90 -to 90 \ -digits 3 \ -length 260 \ -repeatdelay 500 \ -repeatinterval 50 \ -font fontTEMP_SMALL_varwidth \ -troughcolor "$scaleBKGD" \ -tickinterval 180 # -from 0 -to 180 \ # -label "$aRtext(scaleLAT)" \ # -command {rotate_proJECT} ## We do NOT use the '-variable' option. ## It may cause 'auto-repeat' problems. # -variable viewZ \ ## Define a label widget to precede the ZOOM-scale. label .fRtop.fRscales.labelZOOM \ -text "$aRtext(labelZOOM)" \ -font fontTEMP_varwidth \ -justify left \ -anchor w \ -relief flat \ -bd $BDwidthPx_button ## We set the initial value for this 'scaleZOOM' widget in the ## GUI initialization section at the bottom of this script. # set curZOOM 1.0 # set curZOOM 0.8 scale .fRtop.fRscales.scaleZOOM \ -orient horizontal \ -resolution 0.1 \ -from 0.1 -to 10.0 \ -digits 3 \ -length 150 \ -repeatdelay 500 \ -repeatinterval 50 \ -font fontTEMP_SMALL_varwidth \ -troughcolor "$scaleBKGD" \ -variable curZOOM \ -tickinterval 9.8 # -command "wrap_draw_2D_pixel_polys 0" ## Pack the widgets in frame '.fRtop.fRscales'. pack .fRtop.fRscales.labelVIEW \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRscales.scaleLON \ .fRtop.fRscales.scaleLAT \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRscales.labelZOOM \ -side left \ -anchor w \ -fill none \ -expand 0 pack .fRtop.fRscales.scaleZOOM \ -side left \ -anchor w \ -fill none \ -expand 0 ## NOTE on SCALES BEHAVIOR: ## Using '-fill x -expand 1' on a scale widget may cause ## the scale to 'go crazy' if you click in the trough ## of the scale. ## The sliderbar may keep advancing on its own as many ## redraws of the changing canvas are done. ## This may happen in conjunction with the binding ## on the canvas widget. ## For now, we use '-fill none -expand 0'. ##+###################################################### ## In FRAME '.fRtop.fRsorts' - ## DEFINE-and-PACK a LABEL & several RADIOBUTTON WIDGETS. ##+###################################################### label .fRtop.fRsorts.labelSORT \ -text "$aRtext(labelSORT)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_label \ -pady $PADYpx_label \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label ## We set the initial value for these radiobutton widgets in the ## GUI initialization section at the bottom of this script. # set poly_sort "maxPolyDepth" # set poly_sort "avePolyDepth" # set poly_sort "minPolyDepth" # set poly_sort "fromFarCorner" radiobutton .fRtop.fRsorts.radbuttSORTfarCorner \ -text "$aRtext(radbuttSORTfarCorner)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_sort \ -value "fromFarCorner" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRtop.fRsorts.radbuttSORTmaxDepth \ -text "$aRtext(radbuttSORTmaxDepth)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_sort \ -value "maxPolyDepth" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRtop.fRsorts.radbuttSORTaveDepth \ -text "$aRtext(radbuttSORTaveDepth)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_sort \ -value "avePolyDepth" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRtop.fRsorts.radbuttSORTminDepth \ -text "$aRtext(radbuttSORTminDepth)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_sort \ -value "minPolyDepth" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt ## Pack the widgets in frame 'fRsorts'. pack .fRtop.fRsorts.labelSORT \ .fRtop.fRsorts.radbuttSORTfarCorner \ .fRtop.fRsorts.radbuttSORTmaxDepth \ .fRtop.fRsorts.radbuttSORTaveDepth \ .fRtop.fRsorts.radbuttSORTminDepth \ -side left \ -anchor nw \ -fill none \ -expand 0 ## OK, we are done defining-and-packing widgets within the ## '.fRtop' frame. Now we start on the '.fRopts' frame. ##+###################################################### ## In FRAME '.fRopts.fRfillout' - ## DEFINE-and-PACK a LABEL & several RADIOBUTTON WIDGETS. ##+###################################################### label .fRopts.fRfillout.labelFILLOUT \ -text "$aRtext(labelFILLOUT)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_label \ -pady $PADYpx_label \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label ## We set the initial value for these radiobutton widgets in the ## GUI initialization section at the bottom of this script. # set poly_fillout "FILLonly" # set poly_fillout "FILLoutline" # set poly_fillout "WIREhide" # set poly_fillout "WIREnohide" radiobutton .fRopts.fRfillout.radbuttFILLOUTfillonly \ -text "$aRtext(radbuttFILLOUTfillonly)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_fillout \ -value "FILLonly" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRfillout.radbuttFILLOUTboth \ -text "$aRtext(radbuttFILLOUTboth)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_fillout \ -value "FILLoutline" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRfillout.radbuttFILLOUTwirehide \ -text "$aRtext(radbuttFILLOUTwirehide)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_fillout \ -value "WIREhide" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRfillout.radbuttFILLOUTwirenohide \ -text "$aRtext(radbuttFILLOUTwirenohide)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_fillout \ -value "WIREnohide" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt ## This label is for info on how color for the ## 'wire' display options is set. label .fRopts.fRfillout.labelWIRE \ -text "$aRtext(labelWIRE)" \ -font fontTEMP_SMALL_varwidth \ -padx $PADXpx_label \ -pady $PADYpx_label \ -justify center \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label \ -fg $labelFGND \ -bg $labelBKGD ## Pack the widgets in frame 'fRfillout'. pack .fRopts.fRfillout.labelFILLOUT \ .fRopts.fRfillout.radbuttFILLOUTfillonly \ .fRopts.fRfillout.radbuttFILLOUTboth \ .fRopts.fRfillout.radbuttFILLOUTwirehide \ .fRopts.fRfillout.radbuttFILLOUTwirenohide \ -side top \ -anchor nw \ -fill none \ -expand 0 pack .fRopts.fRfillout.labelWIRE \ -side top \ -anchor nw \ -fill x \ -expand 1 ##+###################################################### ## In FRAME '.fRopts.fRfillsrc' - ## DEFINE-and-PACK a LABEL & several RADIOBUTTON WIDGETS. ##+###################################################### label .fRopts.fRfillsrc.labelFILLSRC \ -text "$aRtext(labelFILLSRC)" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label ## We set the initial value for these radiobutton widgets in the ## GUI initialization section at the bottom of this script. # set poly_fillsrc "fromButton" # set poly_fillsrc "fromPixels" # set poly_fillsrc "fromFixedTable" # set poly_fillsrc "fromRandomTable" ## We can disable these 'filesrc' radiobuttons in the ## additional-GUI-initialization section at the bottom of ## this script, with the 'disable_filesrc_radbutts' proc, ## according to the radiobutton settings chosen in that ## GUI initialization section. If the 'wire' display ## options are chosen, these buttons are not needed. radiobutton .fRopts.fRfillsrc.radbuttFILLSRCfromButton \ -text "$aRtext(radbuttFILLSRCfromButton)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_fillsrc \ -value "fromButton" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRfillsrc.radbuttFILLSRCfromPixels \ -text "$aRtext(radbuttFILLSRCfromFile)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_fillsrc \ -value "fromPixels" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRfillsrc.radbuttFILLSRCfromFixedTable \ -text "$aRtext(radbuttFILLSRCfromTable)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_fillsrc \ -value "fromFixedTable" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRfillsrc.radbuttFILLSRCfromRandomTable \ -text "$aRtext(radbuttFILLSRCrandom)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_fillsrc \ -value "fromRandomTable" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt label .fRopts.fRfillsrc.labelSHADEinfo \ -text "$aRtext(labelSHADEinfo)" \ -font fontTEMP_SMALL_varwidth \ -justify center \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label \ -fg $labelFGND \ -bg $labelBKGD ## Pack the widgets in frame 'fRfillsrc'. pack .fRopts.fRfillsrc.labelFILLSRC \ -side top \ -anchor nw \ -fill none \ -expand 0 pack .fRopts.fRfillsrc.radbuttFILLSRCfromButton \ .fRopts.fRfillsrc.radbuttFILLSRCfromPixels \ .fRopts.fRfillsrc.radbuttFILLSRCfromFixedTable \ .fRopts.fRfillsrc.radbuttFILLSRCfromRandomTable \ -side top \ -anchor nw \ -fill none \ -expand 0 pack .fRopts.fRfillsrc.labelSHADEinfo \ -side top \ -anchor nw \ -fill x \ -expand 1 ##+##################################################################### ## IN THE '.fRopts.fRshadeopts' frame - ## DEFINE one group of RADIOBUTTON widgets, preceded by a LABEL widget. ##+##################################################################### ## The possible values of the 'poly_shade' var of the SHADE radiobutton: ## 'none' OR 'origZheight' OR 'viewDepth' OR 'byLighting' ## (and someday? OR 'origYheight' OR 'origXheight') ## ## (These shade-opts are to be used when the 'poly_fillout' var is ## 'FILLonly' or 'FILLoutline'. ## For 'FILLoutline', 'SHADEnone' is recommended, for faster execution. ## For 'FILLonly', the user will probably want to use one of the other ## shade options, to avoid getting one big blob of solid color, when only ## one fill color is being used --- for all of the model or large parts of ## the model.) ##+######################################################################## ## SHADE options: label .fRopts.fRshadeopts.labelSHADE \ -text "$aRtext(labelSHADE)" \ -font fontTEMP_SMALL_varwidth \ -justify left \ -anchor w \ -relief $RELIEF_label \ -bd $BDwidthPx_label ## We set the initial value for these radiobutton widgets in the ## GUI initialization section at the bottom of this script. # set poly_shade "none" # set poly_shade "origZheight" # set poly_shade "viewDepth" # set poly_shade "byLighting" ## set poly_shade "origYheight" ## set poly_shade "origXheight" ## We can disable these 'shade' radiobuttons in the ## additional-GUI-initialization section at the bottom of ## this script, with the 'disable_shade_radbutts' proc, ## according to the 'fillout' and 'fillsrc' radiobutton settings ## chosen in that GUI initialization section. If the 'wire' display ## options are chosen, these buttons are not needed. radiobutton .fRopts.fRshadeopts.radbuttSHADEnone \ -text "$aRtext(radbuttSHADEnone)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_shade \ -value "none" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRshadeopts.radbuttSHADEorigZheight \ -text "$aRtext(radbuttSHADEorigZheight)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_shade \ -value "origZheight" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRshadeopts.radbuttSHADEviewDepth \ -text "$aRtext(radbuttSHADEviewDepth)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_shade \ -value "viewDepth" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRshadeopts.radbuttSHADEbyLighting \ -text "$aRtext(radbuttSHADEbyLighting)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_shade \ -value "byLighting" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt # -state disabled ## The 'byLighting' shade option will be enabled if it is ## implemented someday, via a 'cross_product' proc. ## We do not implement these 2 radiobuttons, for now. if {0} { radiobutton .fRopts.fRshadeopts.radbuttSHADEorigYheight \ -text "$aRtext(radbuttSHADEorigYheight)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_shade \ -value "origYheight" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt radiobutton .fRopts.fRshadeopts.radbuttSHADEorigXheight \ -text "$aRtext(radbuttSHADEorigXheight)" \ -font fontTEMP_SMALL_varwidth \ -anchor w \ -variable poly_shade \ -value "origXheight" \ -selectcolor "$radbuttBKGD" \ -relief flat \ -padx $PADXpx_radbutt \ -pady $PADYpx_radbutt \ -bd $BDwidthPx_radbutt } ## END OF if {0} (to not define these radiobuttons for now) ## Pack ALL the widgets in the '.fRshadeopts' frame. pack .fRopts.fRshadeopts.labelSHADE \ .fRopts.fRshadeopts.radbuttSHADEnone \ .fRopts.fRshadeopts.radbuttSHADEorigZheight \ .fRopts.fRshadeopts.radbuttSHADEviewDepth \ .fRopts.fRshadeopts.radbuttSHADEbyLighting \ -side top \ -anchor nw \ -fill none \ -expand 0 # .fRopts.fRshadeopts.radbuttSHADEorigYheight \ # .fRopts.fRshadeopts.radbuttSHADEorigXheight \ ##+############################### ## In FRAME '.fRcanvas' - ## DEFINE-and-PACK a CANVAS WIDGET: ##+############################### ## We set '-highlightthickness' and '-borderwidth' to ## zero, to avoid covering some of the viewable area ## of the canvas, as suggested on page 558 of the 4th ## edition of 'Practical Programming with Tcl and Tk'. ##+################################################### canvas .fRcanvas.canvas \ -width $initCanWidthPx \ -height $initCanHeightPx \ -relief raised \ -highlightthickness 0 \ -borderwidth 0 pack .fRcanvas.canvas \ -side top \ -anchor nw \ -fill both \ -expand 1 ##+################################################## ## END OF DEFINITION of the GUI widgets. ##+################################################## ## Start of BINDINGS, PROCS, Added-GUI-INIT sections. ##+################################################## ##+####################################################################### ##+####################################################################### ## BINDINGS SECTION: ## ## Note that a sequence of up to 4 procs may be used to perform a draw: ## - load_points_array ## - translate_points_array ## - rotate_points ## - wrap_draw_2D_pixel_polys ## ## Bindings on the filename entry widget may do all 4: load-translate-rotate-draw. ## Bindings on the xmin,xstep,ymin,ystep entry fields may do all 4. ## ## Bindings on the longitude-latitude scales would do the last 2: rotate-draw. ## ## Bindings on the fill/outline/wire radiobutons would do the last 1: draw. ## Binding on the zoom scale would do the last 1. ## The fill-color and outline-color button procs would do the last 1. ##+####################################################################### bind .fRtop.fRfilename.entFILENAME "load-translate-rotate-sort-draw" bind .fRtop.fRfilename.entFILENAME "load-translate-rotate-sort-draw" ## Bindings on widgets in the 'fRfactors' frame. bind .fRtop.fRfactors.entXMIN "load-translate-rotate-sort-draw" bind .fRtop.fRfactors.entXMIN "load-translate-rotate-sort-draw" bind .fRtop.fRfactors.entXSTEP "load-translate-rotate-sort-draw" bind .fRtop.fRfactors.entXSTEP "load-translate-rotate-sort-draw" bind .fRtop.fRfactors.entYMIN "load-translate-rotate-sort-draw" bind .fRtop.fRfactors.entYMIN "load-translate-rotate-sort-draw" bind .fRtop.fRfactors.entYSTEP "load-translate-rotate-sort-draw" bind .fRtop.fRfactors.entYSTEP "load-translate-rotate-sort-draw" bind .fRtop.fRfactors.entZFACTOR "load-translate-rotate-sort-draw" bind .fRtop.fRfactors.entZFACTOR "load-translate-rotate-sort-draw" ## Bindings on widgets in the 'fRscales' frame: bind .fRtop.fRscales.scaleLON "rotate-sort-draw" bind .fRtop.fRscales.scaleLAT "rotate-sort-draw" bind .fRtop.fRscales.scaleZOOM "wrap_draw_2D_pixel_polys" ## Bindings on widgets in the 'fRsorts' frame: bind .fRtop.fRsorts.radbuttSORTfarCorner "sort-draw" bind .fRtop.fRsorts.radbuttSORTmaxDepth "sort-draw" bind .fRtop.fRsorts.radbuttSORTaveDepth "sort-draw" bind .fRtop.fRsorts.radbuttSORTminDepth "sort-draw" ## FOLLOWING ARE BINDINGS ON WIDGETS IN THE '.fRopts' FRAMES. bind .fRopts.fRfillout.radbuttFILLOUTfillonly \ "enable_fillsrc_radbutts ; enable_shade_radbutts" bind .fRopts.fRfillout.radbuttFILLOUTboth \ "enable_fillsrc_radbutts ; enable_shade_radbutts" bind .fRopts.fRfillout.radbuttFILLOUTwirehide \ "disable_fillsrc_radbutts ; disable_shade_radbutts ; wrap_draw_2D_pixel_polys" bind .fRopts.fRfillout.radbuttFILLOUTwirenohide \ "disable_fillsrc_radbutts ; disable_shade_radbutts ; wrap_draw_2D_pixel_polys" bind .fRopts.fRfillsrc.radbuttFILLSRCfromButton "enable_shade_radbutts" bind .fRopts.fRfillsrc.radbuttFILLSRCfromPixels "enable_shade_radbutts" bind .fRopts.fRfillsrc.radbuttFILLSRCfromFixedTable "enable_shade_radbutts" bind .fRopts.fRfillsrc.radbuttFILLSRCfromRandomTable "enable_shade_radbutts" bind .fRopts.fRshadeopts.radbuttSHADEnone "wrap_draw_2D_pixel_polys" bind .fRopts.fRshadeopts.radbuttSHADEorigZheight "wrap_draw_2D_pixel_polys" bind .fRopts.fRshadeopts.radbuttSHADEviewDepth "wrap_draw_2D_pixel_polys" bind .fRopts.fRshadeopts.radbuttSHADEbyLighting "wrap_draw_2D_pixel_polys" # bind .fRopts.fRshadeopts.radbuttSHADEorigYheight "wrap_draw_2D_pixel_polys" # bind .fRopts.fRshadeopts.radbuttSHADEorigXheight "wrap_draw_2D_pixel_polys" ##+################################################################## ##+################################################################## ## DEFINE PROCS SECTION: ## ## - 'get_image_filename' - to get the filename of an image (GIF/PNG) file ## and put the name in the filename entry field. ## Called by the 'Browse...' button of the GUI. ## ## - 'load-translate-rotate-sort-draw' - ## a proc that calls on the 5 procs that constitute the ## 'graphics pipeline' of this script: ## - load_points_array ## - translate_points_array ## - rotate_points ## - sort_polyIDs_list ## - draw_2D_pixel_polys ## and also shows the draw-time (millisecs). ## These 5 procs are described below. ## ## - 'rotate-sort-draw' - ## a proc that calls the last 3 procs of the ## 'graphics pipeline': ## - rotate_points ## - sort_polyIDs_list ## - draw_2D_pixel_polys ## and also shows the draw-time (millisecs). ## ## - 'wrap_draw_2D_pixel_polys' - ## a proc that calls the last proc of the ## 'graphics pipeline': ## - draw_2D_pixel_polys ## and also shows the draw-time (millisecs). ## ## - 'update_draw-time_label' - shows the draw-time (millsecs) in a label ## ## - 'load_points_array' - (STEP1 of the 'graphics pipeline') ## ## For a given image file, this proc loads two main arrays: ## aRpoints($k) and aRconnect($k). ## ## The elements of each array are of the following form: ## ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] ## aRconnect($k) = [list $numVertices $vertID1 $vertID2 ...] ## ## The item "$i,$j" is a string representing 2 integers separated by a ## comma. The 2 integers represent the pixel position in the image ## file from which values are computed for $x $y and $z. ## ## We include the "$i,$j" string in the points storage array in case having ## the integers there come in handy for use in various procs used in the ## 'graphics pipeline'. ## ## The string '$RGBcolor-list' in the 'aRpoints' array format represents ## a Tcl list item that contains a triple of RGB integers (from 0 thru 255) ## that comes from retrieving the pixel color corresponding to the point. ## ## For more details, see the comments in the 'load_points_array' proc below. ## ## - 'translate_points_array' - (STEP2 of the 'graphics pipeline') ## For the array aRpoints($i) = [list $CNTpoint $RGBcolor-list $x $y $z], ## we calculate a new array in Cartesian coordinates: ## aRtranspoints($k) = [list $transx $transy $transz] ## based at the midpoint of the min-max ranges of x,y,z. ## ## (Note that the xyz values could be far from the origin in 3-space ## -- 0,0,0. So we need to translate the 'center point' of the surface data ## to the middle of the data cloud. Otherwise we may be rotating the data ## around a point far from the origin 0,0,0.) ## ## We could use the array 'aRpoints' to hold the translated coordinates, ## but we will use some memory just in case we find it useful to have the ## original point values available --- for example for coloring the polygons ## according to the original x,y,z point coordinate values. ## ## - 'rotate_points' - (STEP3 of the 'graphics pipeline') ## For a given longitude and latitude (view direction), this proc loops thru ## all the POINTS, in array ## aRtranspoints($k) = [list $transx $transy $transz], ## rotating each point according to the current 2 longitude ## and latitude angles --- angLON,angLAT --- and calculating ## the new Cartesian (xyz) coordinates. The xyz data for ## the 'new points' are put into a new array: ## aRnew_points($k) = [list $newx $newy $newz] ## ## Note that if we make a 'simple' change --- like change color of polygon ## fill or outline --- or a change to wireframe mode from fill mode (changes ## that do not change the image, grid geometry, z-height, or view direction), ## we do not have to go through a lot of mathematical calculations again. ## We can work off of the 'aRnew_points' array. ## ## We are using memory for 3 'points' arrays --- aRpoints, aRtranspoints, ## and aRnew_points --- to give us some processing efficiency ## when we make changes that should not require sweeping through ## the grid and performing math calculations that we have already ## done once --- nor require re-creating data that we had loaded before. ## ## If we are usually dealing with image files no larger than ## 200x200 pixels, we generally have no more than about ## 3x200x200 = 120,000 xyz coords per array. At about 8bytes per ## coord, this means about 8 x 120,000 = 0.96 Megabytes per array. ## For 3 arrays, this is about 3 Megabytes for the 3 arrays. ## ## Since most computers nowadays will have at least 1 Gigabyte ## = 1,000 Megabytes of memory available if no more than the ## basic operating system tasks are running, this means that ## less than 1% of the free memory will be used by the 3 arrays. ## ## - 'sort_polyIDs_list' - (STEP 4 of the 'graphics pipeline') ## For poly ID's "$i" (an integer) in a Tcl list 'LISTpolyIDs', ## we generate a new list called 'sortedLISTpolyIDs' --- by sorting ## the polyIDs according to the 'x-depth' of each poly. Uses one of ## severa sort procs, such as ## compare_2polyIDs_by_MAXxdepth ## compare_2polyIDs_by_AVExdepth ## compare_2polyIDs_by_biggerMINxdepth ## ## Alternatively, the list 'sortedLISTpolyIDs' could be built ## according to a view-quadrant-and-far-corner technique outlined ## in comments at the top of this script. ## ## See comments in the 'sort_polyIDs_list' proc for current details ## on implementation of a sort method. ## ## - 'compare_2polyIDs_by_XXXxdepth' (several such procs) ## These procs are used by a Tcl 'lsort' command in proc 'sort_polyIDs_list' ## in order to sort a list of polygon IDs according to the ## x-depth of the corners/vertices of the polygons. ## Input is a pair of polygon IDs (two integers) as arguments. ## Output is 1 or -1. ## ## - 'draw_2D_pixel_polys' - (STEP5 'graphics pipeline') ## For the current array ## aRnew_points($k) = [list $newx $newy $newz] ## this proc maps the y,z values of the 4 corners of the quadrilaterals ## into pixels and the polygons are placed on the current ## Tk canvas area with 'create polygon' commands --- with ## the requested '-fill' and '-outline' options and the requested ## color values and shading technique. ## ## The initial mapping of world-units to pixels is based on ## mapping the canvas dimensions into world-units of at least ## the diameter of the data cloud of x,y,z points. ## ## We use the Tcl list 'sortedLISTpolyIDs' to determine ## the order in which to issue the 'create polygon' commands. ## ## Zooming logic is located solely in this proc. ## ## Note that the procs that built the arrays aRpoints, ## aRtranspoints, and aRnew_points are all dealing with 'world ## coordinates'. 'draw_2D_pixel_polys' is the only proc ## dealing with pixel coordinates. ## ## - 'set_polygon_color1' - sets fill color for the polygons ## - 'set_polygon_color2' - sets outline color for the polygons ## - 'set_background_color' - sets background (canvas) color ## - 'update_colors_label' - to color buttons and reset a colors label ## ## 'enable_fillsrc_radbutts' - to enable the indicated radiobuttons ## 'disable_fillsrc_radbutts' - to disable the indicated radiobuttons ## ## 'enable_shade_radbutts' - to enable the indicated radiobuttons ## 'disable_shade_radbutts' - to disable the indicated radiobuttons ## ## 'cross_product_normx' - to perform 'shading' of the fill color of ## the polygons, according to the angle ## that the polygon normals make to a ## 'lighting' vector --- such as the 'view vector', ## if we assume the lighting is attached to the ## viewer's forehead, say. ## ## - 'popup_msgVarWithScroll' - to show Help text (and other msgs) ## ## - 'popup_msgVarWithScroll_wait' - to show error msgs. ## ##+################################################################# ##+######################################################################### ## Proc 'get_image_filename' - ## ## To get the name of an image file (GIF/PNG) and put the ## filename into global var 'ENTRYfilename'. ## ## Used by: the '-command' option of the 'Browse ...' button. ##+######################################################################### # set curDIR "$env(HOME)" set curDIR [pwd] proc get_image_filename {} { global t0 ENTRYfilename env curDIR img1 Nxpixels Nypixels Nxsegs Nysegs ## Load data from an OBJ file set fName [tk_getOpenFile -parent . -title "Select GIF/PNG file to load" \ -initialdir "$curDIR" ] if {"$fName" == ""} {return} ## FOR TESTING: # puts "fName : $fName" ## Set the current time, for determining elapsed time for loading ## the image. Used by the 'update_draw-time_label' proc below. set t0 [clock milliseconds] if {[file exists $fName]} { set ENTRYfilename "$fName" set curDIR [ get_chars_before_last / in "$ENTRYfilename" ] # image create photo img1 -file "$ENTRYfilename" set img1 [image create photo -file "$ENTRYfilename"] ## FOR TESTING: # puts "get_image_filename - img1: $img1" ## Get the dimensions (in pixels) of the image. set Nxpixels [image width $img1] set Nypixels [image height $img1] set Nxsegs [expr {$Nxpixels - 1}] set Nysegs [expr {$Nypixels - 1}] ## Pop a warning message if the image is 'large'. if {$Nxpixels > 200 && $Nypixels > 200} { set IMGlargeWARNmsg "The image file $ENTRYfilename is larger than 200x200 pixels. This would generate a terrain surface of more than 40,000 points. Showing the entire surface in the canvas would make the polygons look like dots. Consider scaling down the size of the image." popup_msgVarWithScroll_wait .fRwarnmsg "$IMGlargeWARNmsg" } ## Clear the canvas. .fRcanvas.canvas delete all ## Put the image on the canvas, in the upper-left corner. .fRcanvas.canvas create image 0 0 -anchor nw -image $img1 ## Show the dimensions of the image and the draw time. update_draw-time_label "Image Load" } else { set FILEopenERRmsg "Cannot open file $ENTRYfilename It is likely that the file is not found. Check spelling." popup_msgVarWithScroll_wait .fRerrmsg "$FILEopenERRmsg" return } ## END OF if {[file exists $fName]} } ## END OF proc 'get_image_filename' ##+###################################################################### ## Proc 'get_chars_before_last' - ##+###################################################################### ## INPUT: A character and a string. ## ## OUTPUT: Returns all of the characters in the string "strng" that ## are BEFORE the last occurence of the characater "char". ## ## EXAMPLE CALL: To extract the directory from a fully qualified file name: ## ## set directory [ get_chars_before_last "/" in "/home/abc01/junkfile" ] ## ## $directory will now be the string "/home/abc01" ## ## Note: The "in" parameter is a 'dummy' parameter. ## It is there only for readability of the inputs. ## ##+###################################################################### proc get_chars_before_last { char in strng } { set IDXend [ expr [string last $char $strng ] - 1 ] set output [ string range $strng 0 $IDXend ] ## FOR TESTING: # puts "From 'get_chars_before_last' proc:" # puts "STRING: $strng" # puts "CHAR: $char" # puts "RANGE up to LAST CHAR - IDXstart: 0 IDXend: $IDXend" return $output } ## END OF 'get_chars_before_last' PROCEDURE ##+################################################################ ## proc load-translate-rotate-sort-draw ## ## PURPOSE: a proc that calls 5 procs: ## - load_points_array ## - translate_points_array ## - rotate_points ## - sort_polyIDs_list ## - draw_2D_pixel_polys ## ## CALLED BY: see BINDINGS section above. ##+################################################################ proc load-translate-rotate-sort-draw {} { global t0 img1 ## Bail out if an indicator (that data has been read ## and ready for drawing) is not set. if {![info exists img1]} {return} ## Set the current time, for determining elapsed ## time for redrawing the 3D plot. set t0 [clock milliseconds] load_points_array translate_points_array rotate_points sort_polyIDs_list draw_2D_pixel_polys update_draw-time_label } ## END OF proc 'load-translate-rotate-sort-draw' ##+################################################################ ## proc rotate-sort-draw ## ## PURPOSE: a proc that calls 3 procs: ## - rotate_points ## - sort_polyIDs_list ## - draw_2D_pixel_polys ## ## CALLED BY: see BINDINGS section above. ##+################################################################ proc rotate-sort-draw {} { global t0 NUMgridpts ## Bail out if an indicator (that data has been read ## and ready for drawing) is not set. if {![info exists NUMgridpts]} {return} ## Set the current time, for determining elapsed ## time for redrawing the 3D plot. set t0 [clock milliseconds] rotate_points sort_polyIDs_list draw_2D_pixel_polys update_draw-time_label } ## END OF proc 'rotate-sort-draw' ##+################################################################ ## proc sort-draw ## ## PURPOSE: a proc that calls 2 procs: ## - sort_polyIDs_list ## - draw_2D_pixel_polys ## ## CALLED BY: see BINDINGS section above. ##+################################################################ proc sort-draw {} { global t0 NUMgridpts ## Bail out if an indicator (that data has been read ## and ready for drawing) is not set. if {![info exists NUMgridpts]} {return} ## Set the current time, for determining elapsed ## time for redrawing the 3D plot. set t0 [clock milliseconds] sort_polyIDs_list draw_2D_pixel_polys update_draw-time_label } ## END OF proc 'sort-draw' ##+################################################################ ## proc wrap_draw_2D_pixel_polys ## ## PURPOSE: a proc that calls the proc 'draw_2D_pixel_polys' ## and shows the millisecs that the redraw took. ## ## CALLED BY: see BINDINGS section above. ##+################################################################ proc wrap_draw_2D_pixel_polys {} { global t0 NUMgridpts ## Bail out if an indicator (that data has been read ## and ready for drawing) is not set. if {![info exists NUMgridpts]} {return} ## Set the current time, for determining elapsed ## time for redrawing the 3D plot. set t0 [clock milliseconds] draw_2D_pixel_polys update_draw-time_label } ## END OF proc 'wrap_draw_2D_pixel_polys' ##+##################################################################### ## proc 'update_draw-time_label' ##+##################################################################### ## PURPOSE: Updates the draw-time (millisecs) in the label widget ## '.fRtop.fRbuttons.labelDRAWTIME'. ## ## ARGUMENTS: none ## ## CALLED BY: the 3 'wrapper' redraw-procs: ## - load-translate-rotate-sort-draw ## - rotate-sort-draw ## - wrap_draw_2D_pixel_polys ##+##################################################################### proc update_draw-time_label { {TIMEtype "re-DRAW"} } { global Nxpixels Nypixels t0 # if {"$TIMEtype" == ""} {set TIMEtype "re-DRAW"} .fRtop.fRbuttons.labelDRAWTIME configure -text "\ The image size is $Nxpixels by $Nypixels. The terrain surface generated will contain $Nxpixels times $Nypixels = [expr {$Nxpixels * $Nypixels}] points. ** $TIMEtype TIME: [expr {[clock milliseconds] - $t0}] millisecs elapsed" \ } ## END OF PROC 'update_draw-time_label' ##+##################################################################### ## proc load_points_array ## ## PURPOSE: For a given image file, this proc loads two main arrays: ## aRpoints($k) and aRconnect($k). ## ## The elements of each array are of the following form: ## ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] ## aRconnect($k) = [list $vertID1 $vertID2 $vertID3 $vertID4] ## ## The item "$i,$j" is a string representing 2 integers separated by a ## comma. The 2 integers represent the pixel position in the image ## file from which values are computed for $x $y and $z. ## ## We include the "$i,$j" string in the points storage array in case having ## the integers there come in handy for use in various procs used in the ## 'graphics pipeline' --- or for writing out a particular type of ## 3D file format. ## ## Note that if we ever change this script to use triangles instead ## of quadrilaterals, then there will be no $vertID4 in the aRconnect ## array's list-lines. ## ## ADDITIONAL FUNCTIONS of this proc: ## ## While loading the array aRpoints, we find the min,max values of ## the xyz coords and use these to calculate Xmid,Ymid,Zmid values. ## ## We also use the min,max values to compute an approximate diameter, ## 'diam', for the 'point cloud'. ## ## We also create a list, 'LISTpolyIDs', consisting of integers ## from 0 up to NUMpolys = (Nxpixels -1) * (Nypixels - 1) = ## Nxsegs * Nysegs. ## ## Note that we set Nxpixels, Nypixels, Nxsegs, and Nysegs in ## the get-file proc. ## ## To load the aRpoints array, ## we let i and j vary in a double loop in this proc, such that ## 0 <= i < Nxpixels and 0 <= j < Nypixels. ## ## To load the aRconnect array, ## we let i and j vary in a double loop in this proc, such that ## 0 <= i < Nxsegs and 0 <= j < Nysegs. ## ## CALLED BY: proc 'load-translate-rotate-sort-draw' --- for example, ## in or button3-release bindings on the image file ## entry field. ## ## Bindings that call on the proc 'load-translate-rotate-sort-draw' ## can be seen in the BINDINGS section above. ##+##################################################################### proc load_points_array {} { global img1 Nxpixels Nypixels Nxsegs Nysegs NUMgridpts NUMpolys \ ENTRYxmin ENTRYxstep ENTRYymin ENTRYystep ENTRYzfactor \ aRpoints aRconnect minX maxX minY maxY minZ maxZ \ Xmid Ymid Zmid diam LISTpolyIDs ######################################################################### ## Make sure that ENTRYxmin ENTRYxstep ENTRYymin ENTRYystep ENTRYzfactor ## are in floating-point/decimal form, not integer --- to avoid possible ## truncation problems in expr-operations. ######################################################################### set ENTRYxmin [expr {double($ENTRYxmin)}] set ENTRYxstep [expr {double($ENTRYxstep)}] set ENTRYymin [expr {double($ENTRYymin)}] set ENTRYystep [expr {double($ENTRYystep)}] set ENTRYzfactor [expr {double($ENTRYzfactor)}] ################################################################## ## Start looping thru the image pixels over integers xPx,yPx. ## For each xPx,yPx: ## ## - Get RGB values (integers between 0 and 255) at that ## xPx,yPx pixel location in the image. ## ## - Use an 'intensity' measure based on the RGB values to ## set a z-height --- using $ENTRYzfactor to put the ## z-heights in a user-selected 'world-coords' range. ## ## - Also calculate x,y world-coords --- from xPx,yPx and ## ENTRYxmin ENTRYxstep ENTRYymin ENTRYystep. ## ## - Store the 3 x,y,z coords in array 'aRpoints' --- with the ## array index given by a single integer of the form: ## k = ($yPx * $Nxpixels) + $xPx ## and ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] ## ## - Within this loop, we also collect minX,maxX,minY,maxY,minZ,maxZ. ################################################################### ## Start incrementing over the height of the image. ## In other words, set a row of the image to process. #################################################################### ## 0,0 is top-left of the image. ## We start loading from the bottom-left. ################################################################### ## FOR TESTING: # puts "proc 'load_points_array': Starting to get RGB values from the image: # puts "Nxpixels: $Nxpixels Nypixels: $Nypixels" # puts "Nxsegs: $Nxsegs Nysegs: $Nysegs" ## This would start loading from the top-left of the image. ## for {set yPx 0} {$yPx < $Nypixels} {incr yPx} for {set yPx $Nysegs} {$yPx < $Nypixels && $yPx >= 0} {incr yPx -1} { ## Start incrementing over the width of the image, ## to get colors at pixels in the current row. for {set xPx 0} {$xPx < $Nxpixels} {incr xPx} { ## Get the current rgb color at xPx,yPx. ## These will be decimal integer values (0-255) --- NOT hex. foreach {r g b} [$img1 get $xPx $yPx] break ## FOR TESTING: # if {$xPx == 0} { # puts "proc 'load_points_array': Getting RGB values from the image: # puts "At row yPx: $yPx" # puts "xPx: $xPx r: $r g: $g b: $b" # } ###################################################### ## Compute the 'Luminance' (Y) of the xPx,yPx pixel, ## given by a weighted average of RGB values, ## according to the formula: ## ## Y = .299*R + .587*G + .114*B ##################################################### # set LUMval [ expr {(.299*$r) + (.587*$g) + (.114*$b)} ] ##################################################### ## OR, simply get the sum of rgb (less processing). ##################################################### set LUMval [ expr {double($r + $g + $b)} ] ##################################################### ## Multiply LUMval by the z-height-factor to ## get a 'world coordinates' value of z. ##################################################### set z [ expr {$LUMval * $ENTRYzfactor} ] ##################################################### ## Get the 'world coordinates' values of x and y, ## using xPx,ENTRYxmin,ENTRYxstep and ## using yPx,ENTRYymin,ENTRYystep. ## The ENTRY vars were made type 'double' above. ## ## We want to map world-coordinate xmin,ymin to pixel ## (0,Nysegs), the lower-left corner of the image. And ## we want to have xmax,ymax be at (Nxsegs,0), the ## upper-right corner of the image. ##################################################### set x [expr {($xPx * $ENTRYxstep) + $ENTRYxmin }] set y [expr {(($Nysegs - $yPx) * $ENTRYystep) + $ENTRYymin }] ################################################### ## LOAD THE 'aRpoints' ARRAY. ## Note: k goes from 0 up to (Nxpixels * Nypixels). ################################################### set k [expr {($yPx * $Nxpixels) + $xPx}] set aRpoints($k) [list "$xPx,yPx" [list $r $g $b] $x $y $z] ## FOR TESTING: # if {$yPx == 10 && $xPx == 10} { # puts "proc 'load_points_array' > At pixel $xPx,$yPx:" # puts " k = ($yPx * $Nxpixels) + $xPx = $k" # puts " r: $r g: $g b: $b" # puts " x: $x y: $y z: $z" # } ############################################################## ## Set the minX,maxX,minY,maxY,minZ,maxZ values of the points. ## Initialize at the first x,y point of the loop. ############################################################## if {$xPx == 0 && $yPx == $Nysegs} { set minX $x set maxX $x set minY $y set maxY $y set minZ $z set maxZ $z } else { if {$x < $minX} {set minX $x} if {$x > $maxX} {set maxX $x} if {$y < $minY} {set minY $y} if {$y > $maxY} {set maxY $y} if {$z < $minZ} {set minZ $z} if {$z > $maxZ} {set maxZ $z} } ## END OF if {$xPx == 0 && $yPx == $Nysegs} } ## END OF loop over $xPx } ## END OF loop over $yPx ## Get the mid-points of the x,y,z ranges. set Xmid [expr {($maxX + $minX) / 2.0}] set Ymid [expr {($maxY + $minY) / 2.0}] set Zmid [expr {($maxZ + $minZ) / 2.0}] ## Calculate a diameter 'diam' for our 'cloud' of data points. set diam [expr {$maxX - $minX}] set maxDeltaY [expr {$maxY - $minY}] if {$maxDeltaY > $diam} {set diam $maxDeltaY} set maxDeltaZ [expr {$maxZ - $minZ}] if {$maxDeltaZ > $diam} {set diam $maxDeltaZ} ################################################################################ ## Build the polygons' connectivity array: ## aRconnect($k) = [list $vertID1 $vertID2 $vertID3 $vertID4] ################################################################################ for {set yPx 0} {$yPx < $Nysegs} {incr yPx} { for {set xPx 0} {$xPx < $Nxsegs} {incr xPx} { set ID1 [expr {($yPx * $Nxpixels) + $xPx}] set ID2 [expr {($yPx * $Nxpixels) + $xPx + 1}] set ID3 [expr {(($yPx + 1) * $Nxpixels) + $xPx + 1}] set ID4 [expr {(($yPx + 1) * $Nxpixels) + $xPx}] set k [expr {($yPx * $Nxsegs) + $xPx}] set aRconnect($k) [list $ID1 $ID2 $ID3 $ID4] } ## END OF for {set xPx 0} {$xPx < $Nxpixels} {incr xPx} } ## END OF for {set yPx 0} {$yPx < $Nypixels} {incr yPx} ########################################################## ## Load the list of poly IDs (for sorting by a sort proc). ########################################################## set LISTpolyIDs {} set NUMpolys [expr {$Nxsegs * $Nysegs}] for {set k 0} {$k < $NUMpolys} {incr k} { lappend LISTpolyIDs "$k" } ## END OF k loop ######################################################################### ## Set the number of points, so we do not have to keep re-calculating it. ######################################################################### set NUMgridpts [expr {$Nxpixels * $Nypixels}] ## FOR TESTING: # puts "proc 'load_points_array' > $NUMgridpts grid points in array. Some loaded points:" # puts " aRpoints(0): $aRpoints(0)" # puts " aRpoints($NUMgridpts): $aRpoints($NUMgridpts)" # puts "Extreme x,y,z-values of the loaded points:" # puts " minX: $minX maxX: $maxX minY: $minY maxY: $maxY minZ: $minZ maxZ: $maxZ" # puts "Middle values of the loaded points:" # puts " Xmid: $Xmid Ymid: $Ymid Zmid: $Zmid" # puts "Max Diameter of the loaded points - diam: $diam" } ## END OF PROC load_points_array ##+##################################################################### ## proc translate_points_array ## ## PURPOSE: For the array 'aRpoints', each of whose entries look like ## aRpoints($k) = [list $CNTpoint "$i,4j" $x $y $z], ## we calculate a new array in Cartesian coordinates: ## aRtranspoints($k) = [list $transx $transy $transz] ## based at the midpoint of the min-max ranges of xyz. ## ## (Note that the xyz values could be far from the origin ## in 3-space --- 0,0,0. Furthermore, we will be performing ## rotations around 0,0,0. So we need to translate the 'center ## point' of the point data to the middle of the 'point cloud'. ## I.e. we want to avoid rotating the 'point cloud' around ## a point far from the origin 0,0,0.) ## ## We could use the array 'aRpoints' to hold the translated ## coordinates, but we will use some memory just in case we ## find it useful to have the original point values available ## --- for example for coloring the polygons according to ## the original data values. ## ## In fact, we may apply the rotation matrix Ry*Rz to the ## original points in 'aRpoints' rather than applying the ## rotation to the current xyz values of the translated-rotated ## points, held in some array. ## ## CALLED BY: proc 'load-translate-rotate-sort-draw' --- for example, ## for or button3-release bindings on the image filename ## entry field. ## ## Bindings that call on the proc 'load-translate-rotate-sort-draw' ## can be seen in the BINDINGS section above. ##+##################################################################### proc translate_points_array {} { global aRpoints aRtranspoints Nxsegs Nysegs NUMgridpts Xmid Ymid Zmid ################################################################## ## Start looping thru the points, from 0 up to NUMGRIDpts. ## For each point index $k: ## get coords x,y,z from array ## aRpoints($k) = [list $CNTpoint "$i,4j" $x $y $z], ## and translate them to coordinates relative to Xmid,Ymid,Zmid. ## ## Put the translated values into array aRtranspoints such that ## aRtranspoints($k) = [list $transx $transy $transz] ################################################################### for {set k 0} {$k < $NUMgridpts} {incr k} { ## Get the xyz coords from aRpoints($k). foreach {dummy dummy x y z} $aRpoints($k) {break} ## Translate the xyz coords to the mid-point of the data. set transx [expr {$x - $Xmid}] set transy [expr {$y - $Ymid}] set transz [expr {$z - $Zmid}] ## Load array aRtranspoints. set aRtranspoints($k) [list $transx $transy $transz] } ## END OF k loop ## FOR TESTING: # puts "proc 'translate_points_array' > After loop - some translated points :" # puts "aRtranspoints(0): $aRtranspoints(0)" # puts "aRtranspoints($NUMgridpts): $aRtranspoints($NUMgridpts)" } ## END OF PROC translate_points_array ##+################################################################################### ## proc 'rotate_points' ## ## PURPOSE: For a given longitude and latitude (view direction), ## this proc loops thru all the POINTS, in array ## aRtranspoints($k) = [list $transx $transy $transz], ## rotating each point according to the current 2 longitude ## and latitude angles --- angLON,angLAT --- and calculating ## the new Cartesian (xyz) coordinates. The xyz data for ## the 'new points' are put into a new array: ## aRnew_points($k) = [list $newx $newy $newz] ## ## Thus if we make a 'simple' change like fill or outline color, ## or change to wireframe mode from fill mode (changes that do ## not change the image, grid distances, z-height-factor, or ## view direction), we do not have to go through a lot of mathematical ## calculations again. We can work off of this 'aRnew_points' array. ## ## We are using memory for 3 'points' arrays --- aRpoints, aRtranspoints, ## and aRnew_points --- to give us some processing efficiency ## when we make changes that should not require sweeping through ## the grid and performing math calculations that we have already ## done once. ## ## CALLED BY: proc 'load-translate-rotate-sort-draw' ## or proc 'rotate-sort-draw' --- for example, for the ## or button3-release binding on the image filename ## entry field. ## ## Bindings that call on the proc 'load-translate-rotate-sort-draw' ## and on the proc 'rotate-sort-draw' can be seen in ## the BINDINGS section above. ##+##################################################################### proc rotate_points {} { global radsPERdeg NUMgridpts aRtranspoints aRnew_points maxnewX minnewX ## Get the 2 rotation angles (in degrees). set angLON [.fRtop.fRscales.scaleLON get] set angLAT [.fRtop.fRscales.scaleLAT get] ## Convert the 2 rotation angles from degrees to radians. set angLON [expr {$radsPERdeg * $angLON}] set angLAT [expr {$radsPERdeg * $angLAT}] ## THIS IS THE STEP WE HAVE BEEN LEADING UP TO --- ## THE ACTUAL ROTATION OF EACH 3D POINT --- done via a ## Ry * Rz rotation matrix --- a product of a longitudinal rotation about ## the z-axis, followed by a latitudinal rotation about the y-axis. ## ## z| . (x,y,f(x,y)) ## | . ## | . angLAT ## |___________________y ## / . ## / . ## / angLON . ## x / ## ## Referring to computer graphics notes such as 'Draft Lecture Notes: ## Computer Graphics for Engineers', by Victor Saouma, U. of Colorado, ## 2000, page 24: ## If we rotate a model/point around the z and then y axes, ## by angles 'thetaz' and 'thetay' resp., and if we let ## cz=cos(thetaz),sz=sin(thetaz),cy=cos(thetay),sy=sin(thetay), ## the product of the 2 rotation matrices is ## ## | cy 0 sy | | cz -sz 0 | ## Ry*Rz = | 0 1 0 | | sz cz 0 | ## | -sy 0 cy | | 0 0 1 | ## ## | cy*cz -cy*sz sy | ## = | sz cz 0 | ## | -sy*cz sy*sz cy | ## ## To reduce the number of math operations in rotating each point, ## we pre-compute the 4 products and denote them as ## cycz, cysz, sycz, sysz. ## ## Then ## newx = cycz * x - cysz * y + sy * z ## newy = sz * x + cz * y ## newz = -sycz * x + sysz * y + cy * z ## Note that 'thetaz' and 'thetay' (the amounts to rotate the points), ## are related to the view angles in our case. ## ## angLON (an angle in the xy plane) is the longitudinal view angle, and ## angLAT (ordinarily an angle from the xy plane toward the z axis) is ## what we are calling the latitudinal view angle. ## ## We let angLON be 'thetaz' and angLAT be 'thetay', up to the sign. ## ## For 'thetaz' and 'thetay', we adjust the view angles, as needed, by ## a negative sign to get an 'appropriate' rotation of the point cloud. set cy [expr {cos($angLAT)}] set sy [expr {sin($angLAT)}] # set cz [expr {cos(-$angLON)}] # set sz [expr {sin(-$angLON)}] set cz [expr {cos($angLON)}] set sz [expr {sin($angLON)}] set cycz [expr {$cy * $cz}] set cysz [expr {$cy * $sz}] set sycz [expr {$sy * $cz}] set sysz [expr {$sy * $sz}] ################################################################## ## Start looping thru the rectangular grid over integer k going ## from 0 up to NUMgridpts. ## For each k: ## - get coords transx,transy,transz from array 'aRtranspoints' ## - apply the rotation matrix Ry*Rz to the point ## to calculate the new Cartesian coords newX,newY,newZ ## - store the values in the new-points array ## aRnew_points($k) = [list $newX $newY $newZ] ################################################################### for {set k 0} {$k < $NUMgridpts} {incr k} { ## Get the cartesian coords from aRtranspoints($k). foreach {transx transy transz} $aRtranspoints($k) {break} ## Calc the new Cartesian coords using ## newx = cycz * x - cysz * y + sy * z ## newy = sz * x + cz * y ## newz = -sycz * x + sysz * y + cy * z set newX [expr { ($cycz * $transx) - ($cysz * $transy) + ($sy * $transz) }] set newY [expr { ($sz * $transx) + ($cz * $transy) }] set newZ [expr { (-$sycz * $transx) + ($sysz * $transy) + ($cy * $transz) }] ## FOR TESTING: # puts "proc 'rotate_points' > For POINT $i,$j, the new rotated-translated point is:" # puts " newX: $newX newY: $newY newZ: $newZ" ## HERE IS where we load array aRnew_points. set aRnew_points($k) [list $newX $newY $newZ] ## While we are rotating the points, we set maxnewX and minnewX ## for use in x-depth-shading in the draw proc. if {$k == 0} { set minnewX $newX set maxnewX $newX } else { if {$newX < $minnewX} {set minnewX $newX} if {$newX > $maxnewX} {set maxnewX $newX} } ## END OF if {$k == 0} } ## END OF k loop ## FOR TESTING: # puts "proc 'rotate_points' > After loop - some rotated points :" # puts " aRnew_points(0): $aRnew_spoints(0)" # puts " aRnew_points($NUMgridpts): $aRnew_points($NUMgridpts)" } ## END OF PROC 'rotate_points' ##+##################################################################### ## proc sort_polyIDs_list ## ## PURPOSE: For poly ID's $m and $n (2 integers) in the Tcl list ## 'LISTpolyIDs', we generate a new list called ## 'sortedLISTpolyIDs' --- by sorting the polyIDs according ## to the current 'z-depth' of each poly. ## ## (Actually, we use x-depth in our case, since we will be ## plotting y,z --- not x --- in the draw routine --- as we ## imagine looking along the x-axis to a 2D projection plane ## which is parallel to or identical to the yz plane.) ## ## This proc uses one of several 'compare_2polyIDs' procs ## ## depending on the current value of the 'poly_sort' ## radiobutton variable. ## ## See comments in the 'compare' procs (below) for ## current details on the several sort methods. ## ## CALLED BY: proc 'load-translate-rotate-sort-draw' ## or proc 'rotate-sort-draw' --- for example, for the ## or button3-release binding on the image filename ## entry field . See the BINDINGS section above. ##+##################################################################### proc sort_polyIDs_list {} { global LISTpolyIDs sortedLISTpolyIDs poly_sort if {"$poly_sort" == "maxPolyDepth"} { set sortedLISTpolyIDs \ [lsort -command compare_2polyIDs_by_MAXxdepth $LISTpolyIDs] } if {"$poly_sort" == "avePolyDepth"} { set sortedLISTpolyIDs \ [lsort -command compare_2polyIDs_by_AVExdepth $LISTpolyIDs] } if {"$poly_sort" == "minPolyDepth"} { set sortedLISTpolyIDs \ [lsort -command compare_2polyIDs_by_MINxdepth $LISTpolyIDs] } if {"$poly_sort" == "fromFarCorner"} { build_sortedLISTpolyIDs_fromFarCorner } ## FOR TESTING: # puts "proc 'sort_polyIDs_list' > Built the following list :" # puts "sortedLISTpolyIDs: $sortedLISTpolyIDs" } ## END OF PROC 'sort_polyIDs_list' ##+################################################################ ## proc compare_2polyIDs_by_MAXxdepth ## ## PURPOSE: To be used by a Tcl 'lsort' command in order to sort ## a list of polygon IDs according to the 'max' x-depth ## of the corners/vertices of the specified polygons. ## ## INPUT: Input is a pair of polygon IDs (each an integer) ## as arguments to this proc. ## ## OUTPUT: Output is passed by the 'return' statement. ## ## Output is 1 (one) if the first polygon ID is ## considered greater than the 2nd polygon ID, and ## -1 (minus one) otherwise. ## ## (If the x-depth of the 2 polygons is the same, ## we return 1.) ## ## OTHER CONSIDERATIONS: ## ## In this application, we are working with quadrilateral ## polygons over a rectangular array of points, Nxpixels by Nypixels. ## ## For a given integer polyID, $k, we need to 'decompose' the integer ## into a pair of integers, i and j, representing a point in the grid. ## ## We use ## j = int(k / Nxpixels) and ## i = k % Nxpixels (the remainder of the division k / Nxpixels) ## ## Our list integer pairs i,j are such that ## 0 <= i < Nxsegs = (Nxpixels - 1) ## and ## 0 <= j < Nysegs = (Nypixels -1) ## ## and the length of the polyIDs list is Nxsegs times Nysegs. ## ## To use the pair of polygon IDs (to determine the x-depth-values ## of the polygon vertices), we will need the 'points' array ## that is translated and rotated: ## aRnew_points($k) = [list $newX $newY $newZ] ## ## In this application, each polygon has the same number of ## vertices, N=4. (Or N=3 if we end up breaking up each ## quadrilateral polygon into 2 triangles --- someday.) ## ## In this 'MAXxdepth' proc, we compare the max x-value of ## one set of 4 points to the max x-value of the other ## set of 4 points. ## ## REFERENCE: pages 70-71 on the 'lsort' command in the book ## 'Practical Programming in Tcl and Tk', 4th edition, ## by Welch, Jones, and Hobbs. ## ## CALLED BY: a Tcl command of the form ## ## set sortedLISTpolyIDs \ ## [lsort -command compare_2polyIDs_by_MAXxdepth $LISTpolyIDs] ## ## in proc 'sort_polyIDs_list'. ##+################################################################ proc compare_2polyIDs_by_MAXxdepth {id1 id2} { global aRnew_points Nxpixels Nxsegs ## Split id1 into its i and j parts. set jID1 [expr {int($id1 / $Nxsegs)}] set iID1 [expr {$id1 % $Nxsegs}] ## Get the z-depths (x-depths) of the 4 vertices of the polygon at id1. set k [expr {int(($Nxpixels * $jID1) + $iID1)}] foreach {x1 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * $jID1) + $iID1 + 1)}] foreach {x2 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID1 + 1)) + $iID1 + 1)}] foreach {x3 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID1 + 1)) + $iID1)}] foreach {x4 dummy dummy} $aRnew_points($k) {break} ## Assure that the x's are considered floating point, not chars. set x1 [expr {double($x1)}] set x2 [expr {double($x2)}] set x3 [expr {double($x3)}] set x4 [expr {double($x4)}] ## Get the MAX 'z-depth' (x-depth) of the polygon at id1. set xdepthID1 [expr {max($x1,$x2,$x3,$x4)}] ## Split id2 into its i and j parts. set jID2 [expr {int($id2 / $Nxsegs)}] set iID2 [expr {$id2 % $Nxsegs}] ## Get the z-depths (x-depths) of the 4 vertices of the polygon at id2. set k [expr {int(($Nxpixels * $jID2) + $iID2)}] foreach {x1 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * $jID2) + $iID2 + 1)}] foreach {x2 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID2 + 1)) + $iID2 + 1)}] foreach {x3 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID2 + 1)) + $iID2)}] foreach {x4 dummy dummy} $aRnew_points($k) {break} ## Assure that the x's are considered floating point, not chars. set x1 [expr {double($x1)}] set x2 [expr {double($x2)}] set x3 [expr {double($x3)}] set x4 [expr {double($x4)}] ## Get the MAX 'z-depth' (x-depth) of the polygon at id2. set xdepthID2 [expr {max($x1,$x2,$x3,$x4)}] ## Compare the 2 z-depths (x-depths) and return 1 or -1. if {$xdepthID1 >= $xdepthID2} { return 1 } else { return -1 } } ## END OF PROC 'compare_2polyIDs_by_MAXxdepth' ##+################################################################ ## proc compare_2polyIDs_by_AVExdepth ## ## PURPOSE: To be used by a Tcl 'lsort' command in order to sort ## a list of polygon IDs according to the 'average' x-depth ## of the corners/vertices of the 2 specified polygons. ## ## INPUT: Input is a pair of polygon IDs (each an integer) ## as arguments to this proc. ## ## OUTPUT: Output is passed by the 'return' statement. ## ## Output is 1 (one) if the first polygon ID is ## considered greater than the 2nd polygon ID, and ## -1 (minus one) otherwise. ## ## (If the x-depth of the 2 polygons is the same, ## we return 1.) ## ## OTHER CONSIDERATIONS: ## ## See the 'OTHER CONSIDERATIONS' in the proc ## 'compare_2polyIDs_by_MAXxdepth'. ## ## CALLED BY: a Tcl command of the form ## ## set sortedLISTpolyIDs \ ## [lsort -command compare_2polyIDs_by_AVExdepth $LISTpolyIDs] ## ## in proc 'sort_polyIDs_list'. ##+################################################################ proc compare_2polyIDs_by_AVExdepth {id1 id2} { global aRnew_points Nxpixels Nxsegs ## Split id1 into its i and j parts. set jID1 [expr {int($id1 / $Nxsegs)}] set iID1 [expr {$id1 % $Nxsegs}] ## Get the x-depths of the 4 vertices of the polygon at id1. set k [expr {int(($Nxpixels * $jID1) + $iID1)}] foreach {x1 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * $jID1) + $iID1 + 1)}] foreach {x2 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID1 + 1)) + $iID1 + 1)}] foreach {x3 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID1 + 1)) + $iID1)}] foreach {x4 dummy dummy} $aRnew_points($k) {break} ## Assure that the x's are considered floating point, not chars. set x1 [expr {double($x1)}] set x2 [expr {double($x2)}] set x3 [expr {double($x3)}] set x4 [expr {double($x4)}] ## Compute the AVERAGE x-depth of the polygon at id1. set xdepthID1 [expr {($x1 + $x2 + $x3 + $x4)/4.0}] ## Split id2 into its i and j parts. set jID2 [expr {int($id2 / $Nxsegs)}] set iID2 [expr {$id2 % $Nxsegs}] ## Get the z-depths (x-depths) of the 4 vertices of the polygon at id2. set k [expr {int(($Nxpixels * $jID2) + $iID2)}] foreach {x1 dummy dummy} $aRnew_points($iID2) {break} set k [expr {int(($Nxpixels * $jID2) + $iID2 + 1)}] foreach {x2 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID2 + 1)) + $iID2 + 1)}] foreach {x3 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID2 + 1)) + $iID2)}] foreach {x4 dummy dummy} $aRnew_points($k) {break} ## Assure that the x's are considered floating point, not chars. set x1 [expr {double($x1)}] set x2 [expr {double($x2)}] set x3 [expr {double($x3)}] set x4 [expr {double($x4)}] ## Get the AVERAGE x-depth of the polygon at id2. set xdepthID2 [expr {($x1 + $x2 + $x3 + $x4)/4.0}] ## Compare the 2 x-depths and return 1 or -1. if {$xdepthID1 >= $xdepthID2} { return 1 } else { return -1 } } ## END OF PROC 'compare_2polyIDs_by_AVExdepth' ##+################################################################ ## proc compare_2polyIDs_by_MINxdepth ## ## PURPOSE: To be used by a Tcl 'lsort' command in order to sort ## a list of polygon IDs according to the 'BIGGER MINIMUM' ## x-depth of the corners/vertices of the 2 specified polygons. ## ## INPUT: Input is a pair of polygon IDs (each an integer) ## as arguments to this proc. ## ## OUTPUT: Output is passed by the 'return' statement. ## ## Output is 1 (one) if the first polygon ID is ## considered greater than the 2nd polygon ID, and ## -1 (minus one) otherwise. ## ## (If the x-depth of the 2 polygons is the same, ## we return 1.) ## ## OTHER CONSIDERATIONS: ## ## See the 'OTHER CONSIDERATIONS' in the proc ## 'compare_2polyIDs_by_MAXxdepth'. ## ## CALLED BY: a Tcl command of the form ## ## set sortedLISTpolyIDs \ ## [lsort -command compare_2polyIDs_by_MINxdepth $LISTpolyIDs] ## ## in proc 'sort_polyIDs_list'. ##+################################################################ proc compare_2polyIDs_by_MINxdepth {id1 id2} { global aRnew_points Nxpixels Nxsegs ## Split id1 into its i and j parts. set jID1 [expr {int($id1 / $Nxsegs)}] set iID1 [expr {$id1 % $Nxsegs}] ## Get the x-depths of the 4 vertices of the polygon at id1. set k [expr {int(($Nxpixels * $jID1) + $iID1)}] foreach {x1 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * $jID1) + $iID1 + 1)}] foreach {x2 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID1 + 1)) + $iID1 + 1)}] foreach {x3 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID1 + 1)) + $iID1)}] foreach {x4 dummy dummy} $aRnew_points($k) {break} ## Assure that the x's are considered floating point, not chars. set x1 [expr {double($x1)}] set x2 [expr {double($x2)}] set x3 [expr {double($x3)}] set x4 [expr {double($x4)}] ## Get the MINIMUM x-depth of the polygon at id1. set xdepthID1 [expr {min($x1,$x2,$x3,$x4)}] ## Split id2 into its i and j parts. set jID2 [expr {int($id2 / $Nxsegs)}] set iID2 [expr {$id2 % $Nxsegs}] ## Get the z-depths (x-depths) of the 4 vertices of the polygon at id2. set k [expr {int(($Nxpixels * $jID2) + $iID2)}] foreach {x1 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * $jID2) + $iID2 + 1)}] foreach {x2 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID2 + 1)) + $iID2 + 1)}] foreach {x3 dummy dummy} $aRnew_points($k) {break} set k [expr {int(($Nxpixels * ($jID2 + 1)) + $iID2)}] foreach {x4 dummy dummy} $aRnew_points($k) {break} ## Assure that the x's are considered floating point, not chars. set x1 [expr {double($x1)}] set x2 [expr {double($x2)}] set x3 [expr {double($x3)}] set x4 [expr {double($x4)}] ## Get the MINIMUM x-depth of the polygon at id2. set xdepthID2 [expr {min($x1,$x2,$x3,$x4)}] ## Compare the 2 x-depths and return 1 or -1. if {$xdepthID1 >= $xdepthID2} { return 1 } else { return -1 } } ## END OF PROC 'compare_2polyIDs_by_MINxdepth' ##+########################################################### ## proc build_sortedLISTpolyIDs_fromFarCorner ## ## PURPOSE: To build a list of sorted polygon ID's, 'sortedLISTpolyIDs', ## based on view-quadrant-and-far-corner considerations. ## ## Let the xy quadrant --- over which the 'eye' lies --- (i.e. the quadrant ## of the longitudinal angle) determine the 'start corner' of the 'painting'. ## ## For example, if the 'eye' is over the first quadrant of the xy plane, ## the 'start corner' of 'painting' would be the xmin,ymin (far) corner of the ## 'rectangular grid' below the x,y,z terrain points. So we would build the ## sorted list of polygon IDs, in a double loop, starting from that corner. ## ## 2nd example: If the 'eye' lies over the 3rd quadrant of the xy plane, ## the 'start corner' of 'painting' (sorted-list-building) would be the ## xmax,ymax corner of the 'rectangular grid'. ## ## Similarly, if over the 2nd quadrant, we start at xmax,ymin. ## ## And, if over the 4th quadrant, we start at xmin,ymax. ## ## ## CALLED BY: proc 'sort_polyIDs_list'. ##+########################################################### proc build_sortedLISTpolyIDs_fromFarCorner {} { global sortedLISTpolyIDs Nxsegs Nysegs Nxpixels Nypixels NUMpolys set angLON [.fRtop.fRscales.scaleLON get] ## If the 'eye' is over the 1st quadrant of the xy plane, ## start from the corner in the 3rd quadrant: xmin,ymin which ## is i,j = 0,0. if {$angLON >= 0 && $angLON <= 90} { set iStart 0 set jStart 0 set iDelta 1 set jDelta 1 } ## If the 'eye' is over the 2nd quadrant of the xy plane, ## start from the corner in the 4th quadrant: xmax,ymin which ## is i,j = $Nxsegs,0. if {$angLON >= 90 && $angLON <= 180} { set iStart [expr {$Nxsegs - 1}] set jStart 0 set iDelta -1 set jDelta 1 } ## If the 'eye' is over the 3rd quadrant of the xy plane, ## start from the corner in the 1st quadrant: xmax,ymax which ## is i,j = $Nxsegs,$Nysegs. if {$angLON >= 180 && $angLON <= 270} { set iStart [expr {$Nxsegs - 1}] set jStart [expr {$Nysegs - 1}] set iDelta -1 set jDelta -1 } ## If the 'eye' is over the 4th quadrant of the xy plane, ## start from the corner in the 2nd quadrant: xmin,ymax which ## is i,j = 0,$Nysegs. if {$angLON >= 270 && $angLON <= 360} { set iStart 0 set jStart [expr {$Nysegs - 1}] set iDelta 1 set jDelta -1 } ################################################################## ## Start looping thru the rectangular grid over integers i,j --- ## using the iStart jStart iDelta jDelta values set above, ## to add an integer to the list 'sortedLISTpolyIDs' where ## the integer k is determined from i,j by ## k = (j * Nxpixels) + $i ################################################################## set sortedLISTpolyIDs {} for {set j $jStart} {$j < $Nysegs && $j >= 0} {incr j $jDelta} { for {set i $iStart} {$i < $Nxsegs && $i >= 0} {incr i $iDelta} { set k [expr {int(($j * $Nxsegs) + $i)}] lappend sortedLISTpolyIDs "$k" } ## END OF i loop } ## END OF j loop ## FOR TESTING: # puts "proc 'build_sortedLISTpolyIDs_fromFarCorner' > Built the following list :" # puts "sortedLISTpolyIDs: $sortedLISTpolyIDs" # puts "length of list: [llength $sortedLISTpolyIDs]" # puts "NUMpolys: $NUMpolys" # .fRcanvas.canvas delete all # after 500 } ## END OF proc 'build_sortedLISTpolyIDs_fromFarCorner' ##+########################################################### ## proc draw_2D_pixel_polys ## ## PURPOSE: ## For the translated-rotated points array ## aRnew_points($k) = [list $newx $newy $newz] ## we 'sweep' through the rectangular grid (using our list ## of depth-sorted polygon IDs, 'sortedLISTpolyIDs') plotting ## the polygons on the canvas with 'create polygon' commands. ## ## For our projection on a viewing plane: ## Rather than using the x,y coords of our rotated points (and ## ignoring the z coord), we use the y,z coords of our rotated ## points (and 'ignore' the x coord). I.e. we imagine looking ## at a 2D projection plane perpendicular to the 'viewing' x-axis, ## which is perpendicular to the monitor screen. ## ## Recall that our 'fixed, viewing' positive z-axis is 'up', ## positive y is to the right, and positive x is out of the ## monitor surface. ## ## Then for longitude,latitude (0,0) --- where the viewing x-axis ## is out of the screen (viewport), and longitude goes from 0 to ## 360 degrees from the x axis toward the y axis 'in a right-handed ## way', and latitude goes from -90 to +90 degrees measured from ## the xy plane toward the z axis --- we get a 'front view' ## (i.e. a view along the viewing x-axis which points out of ## the monitor screen). ## ## (0,90) gives us a 'top view' (a view perpendicular to the xy ## 'viewing plane') and (90,0) gives us a 'side view' (a view ## perpendicular to the xz 'viewing plane'). ## ## We use our 'x-sorted' list of polyIDs to plot the ## 'farther-away' polygons first. ## ## We convert the y,z 2D points from 'world coordinate' units to ## pixel units within the current canvas dimensions --- based ## on the 'diameter of the point cloud' as determined in the ## proc 'load_points_array'. Then ... ## ## draw polygons using groups of 4 2D points at a time, and ## based on the fill/outline/wire radiobuttons of the GUI and ## (if not in 'wireframe' mode) use polygon colors according to ## the 'fill-source' radiobuttons and with shading according to the ## 'fill-shading' radiobuttons. ## ## In addition, we use the curZOOM variable from the 'scaleZOOM' ## widget of the GUI to allow for zooming (by adjusting the ## 'diameter of the point cloud'). ## ## INPUTS: ## All the global vars declared below. ## ## CALLED BY: proc 'load-translate-rotate-sort-draw' ## or proc 'rotate-sort-draw' ## or proc 'wrap_draw_2D_pixel_polys'. ## ## Bindings that call on these procs ## can be seen in the BINDINGS section above. ##+######################################################### proc draw_2D_pixel_polys {} { global aRnew_points aRconnect sortedLISTpolyIDs \ Nxsegs Nysegs NUMpolys diam curZOOM \ COLOR1hex COLOR2hex COLORbkGNDhex \ poly_fillout poly_fillsrc poly_shade \ COLOR1r COLOR1g COLOR1b aRcolor Ncolors \ minX maxX minY maxY minZ maxZ TOLfactor aRpoints \ maxnewX minnewX ## BEFORE the loop to plot POLYGONS, ## we get the PIXELS-PER-WORLD-UNITS CONVERSION FACTOR, ## by dividing the minimum canvas dimension by ## $curZOOM times the model/surface diameter, where curZOOM ## is allowed to go from about 0.1 to 10. ## Get the current canvas size. set curCanWidthPx [winfo width .fRcanvas.canvas] set curCanHeightPx [winfo height .fRcanvas.canvas] set minCanDimPx $curCanWidthPx if {$curCanHeightPx < $minCanDimPx} {set minCanDimPx $curCanHeightPx} ## To preserve distances nicely, we want to use the same ## pixels-per-world-units factor in both x and y directions ## (assuming the pixels are square). ## ## We may intialize curZOOM so that the rotated surface comfortably ## fits into the canvas (at the start of a session, i.e. for the first ## terrain generated). That is, curZOOM can be initialized so that the ## initial 'plot' is 'set in' from the boundary of the canvas. # set PxPerUnit [expr { double( $minCanDimPx / ($curZOOM * $diam) ) }] set PxPerUnit [expr { double( ($curZOOM * $minCanDimPx) / $diam ) }] ## FOR TESTING: # puts "proc 'draw_2D_pixel_polys' > Calculated 'PxPerUnit':" # puts " minCanDimPx: $minCanDimPx curZOOM: $curZOOM diam: $diam " # puts " PxPerUnit(= curZOOM * minCanDimPx/diam): $PxPerUnit" ## Get the half width and height of the canvas rectangle --- ## which serve as the pixel-coordinates of the (near?) center of the plot. set imgWidthPx $curCanWidthPx set imgHeightPx $curCanHeightPx if {$imgWidthPx % 2 == 1} { incr imgWidthPx -1 } if {$imgHeightPx % 2 == 1} { incr imgHeightPx -1 } set xmidPx [expr {$imgWidthPx / 2}] set ymidPx [expr {$imgHeightPx / 2}] ############################################################################# ## BEFORE WE DROP INTO THE DRAWING LOOP over polyIDs, ## ## SET-SOME-COLOR-and-SHADING-PARAMETERS. ## ## Set some parms we will need if a shading type is requested. ## We set the parms here rather than repeatedly within the loop. ############################################################################ ## RECALL THAT: ## The possible values of the 'poly_fillout' var of the FILLOUT radiobuttons: ## 'FILLonly' or 'FILLoutline' OR 'WIREhide' OR 'WIREnohide' ## ## The possible values of the 'poly_fillsrc' var of the FILLSRC radiobuttons: ## 'fromButton' OR 'fromPixels' OR 'fromFixedTable' OR 'fromRandomTable' ## ## (One of these 'fillsrc' options is used when the 'poly_fillout' var is ## 'FILLonly' or 'FILLoutline'.) ## ## The possible values of the 'poly_shade' var of the SHADE radiobuttons: ## 'none' OR 'origZheight' OR 'viewDepth' OR 'byLighting' ## ## (One of these 'shade' options is used when the 'poly_fillout' var is ## 'FILLonly' or 'FILLoutline'.) ## ## For 'FILLoutline', shading 'none' is allowed and is 'suggested' ## to attain a faster drawing speed. ## ## For 'FILLonly', shading 'none' gives a blob of solid color, so one of ## the other, more-processing-intensive shading options is suggested.) ########################################################################### ## Make sure that shading is not requested when one of the ## 'wire' display modes is requested. if {"$poly_fillout" == "WIREhide" || "$poly_fillout" == "WIREnohide"} { set poly_shade "none" } ############################################################################## ## SET A HEIGHT-UNITS-PER-COLOR PARM: ## If 'fillsrc' is from a color table, set a factor 'deltaHGTperCOLOR' ## to be used, in the loop over polyIDs below, to convert a z-height ## of a poly to a color in a table. ############################################################################## if {"$poly_fillsrc" == "fromFixedTable" || "$poly_fillsrc" == "fromRandomTable"} { ## Get the spread of height-units over the Ncolors ## of the color table. set deltaHGTperCOLOR [expr {double(($maxZ - $minZ)/$Ncolors)}] } ################################################################################# ## SET RANDOM COLOR TABLE: ## If 'fillsrc' is 'fromRandomTable', build a table of $Ncolors random colors, ## for this particular pass through this draw proc. ## Note: Ncolors is the size of the 'fixed' color table. For simplicity and ## consistency, we make this random colors table the same size. ## Like with the 'fixed' color table, we start the indexing at 1. ################################################################################# for {set n 1} {$n <= $Ncolors} {incr n} { set r [expr {int(rand() * 255)}] set g [expr {int(rand() * 255)}] set b [expr {int(rand() * 255)}] set aRrandColor($n) [list $r $g $b] } ########################################################################## ## SECTION for SETTING a few SHADING FACTORS: ## If a height/depth shading option is requested (i.e. NOT noshade and NOT ## byLighting), set vars Low0to1, deltaHeight, shadeRatio. ########################################################################## if {"$poly_shade" != "none" && "$poly_shade" != "byLighting"} { ## Set a near-zero-tolerance value for use in computing color-shading ratios. set zeroTOL [expr {$TOLfactor * $diam}] ## We are mapping a color-shading-measure (origZheight or viewDepth --- ## and perhaps origYheight and origXheight someday) into the interval ## 0.0 to 1.0 --- to be applied to RGB-base-255 color values. ## But we do not want to go all the way down to 0.0 (black). ## So we set a 'floor' in Low0to1. # set Low0to1 0.5 # set Low0to1 0.35 # set Low0to1 0.25 set Low0to1 0.15 # set Low0to1 0.0 ## For the depth-type shading options (origZheight, origYheight, ## origXheight or viewDepth), we set a value 'deltaHeight', that ## will be used to compute a 'shadeRatio', just below, ## to be used in shading RGB-base-255 colors, from the 'floor' ## proportion set above to the specified R, G, and B values. if {"$poly_shade" == "origZheight"} { set deltaHeight [expr {$maxZ - $minZ}] } if {"$poly_shade" == "viewDepth"} { set deltaHeight [expr {$maxnewX - $minnewX}] } ## NOT USED, yet. # if {"$poly_shade" == "origYheight"} { # set deltaHeight [expr {$maxY - $minY}] # } ## NOT USED, yet. # if {"$poly_shade" == "origXheight"} { # set deltaHeight [expr {$maxX - $minX}] # } ## Now that we have 'deltaHeight', we use it to set the ## 'shadeRatio' factor that we will use in 'scaling' RGB values ## --- provided 'deltaHeight' is not near-zero. if {$deltaHeight < $zeroTOL} { set deltaHeight 0.0 } else { set shadeRatio [expr {(1.0 - $Low0to1)/$deltaHeight}] } } ## END OF {"$poly_shade" != "none" && "$poly_shade" != "byLighting"} ## i.e. if poly_shade is origZheight or viewDepth, ## this is, END OF setting shadeRatio, Low0to1, deltaHeight. ## Clear the canvas before starting to lay down the (new) polygons. .fRcanvas.canvas delete all ################################################################## ## DRAW-SECTION: LOOP-OVER-THE-POLYS. ## ## Start looping thru the 'polys' of the array ## aRconnect($k) = [list $vertID1 $vertID2 $vertID3 $vertID4] ## using the list of depth-sorted 'poly' IDs, 'sortedLISTpolyIDs'. ## ## For each 'polyID' (which is an integer, from 1 to Nxsegs*Nysegs): ## ## - convert the yz coords of array 'aRnew_points' to pixel coords, ## for each of the N vertices of the N-gon of poly 'polyID'. ## ## NOTE: ## Rather than store another array, say 'aRpixel_yzpoints', ## of the yz coords of ALL the points converted to pixel-coords, ## we convert most points to pixel coords several times, because ## most points are used in several different polygons. ## We may go back someday and build array 'aRpixel_yzpoints', ## say, in a 'convert_all_yz_coords_to_pixels' proc,say, called, ## say, at the top of this 'draw' proc. That proc needs to execute ## after the translate and rotate procs have done their job. ## ## As we process each polygon, we set RGB color vars for the ## current polyID --- polyCOLORr,polyCOLORg,polyCOLORb --- according ## to the source specified by the user via the 'fillsrc' radiobuttons: ## 'fromButton' OR 'fromPixels' OR 'fromFixedTable' OR 'fromRandomTable'. ## ## For ColorTable coloring (fixed or random), we set ## polyCOLORr,polyCOLORg,polyCOLORb according to the origZheight, minZ, maxZ, ## the number of colors in the table, and the deltaHGTperCOLOR factor ## computed above. ## ## If shading is requested via the 'shade' radiobuttons 'origZheight' ## OR 'viewDepth', we use the height/depth of each 'polyID' poly to ## shade the 3 values previously set --- polyCOLORr,polyCOLORg,polyCOLORb. ## ## If shading is requested 'byLighting', we use the proc ## 'cross_product_normx' to get a number between 0 and 1 to ## apply to the 3 color values previously set --- polyCOLORr, ## polyCOLORg,polyCOLORb. ## ## - plot each N-gon polygon according to the requested fill-outline ## type --- and, if fill is requested, using the current RGB values ## in polyCOLORr,polyCOLORg,polyCOLORb, modified according to the ## current setting of the 'shading' radiobuttons. ## ################################################################### for {set k 0} {$k < $NUMpolys} {incr k} { ## Get the polyID from the depth-sorted list of polyIDs. set polyID [lindex $sortedLISTpolyIDs $k] ############################################################## ## SECTION: SET-PIXEL-COORDS of 4 vertices for poly $polyID. ## ## For poly $polyID, in a loop over its number of vertices (4), ## get the point ID of a vertex. ## ## Recall our format for aRconnect: ## aRconnect($k) = [list $vertID1 $vertID2 $vertID3 $vertID4 ] ## ## Then ## CONVERT THE Y and Z coordinates of the vertex to PIXEL-COORDS ## and put the pair of x,y pixel coords in Tcl list 'XYlistPx' ## --- for use in a 'create polygon' command below. ## ## Recall our format for aRnew_points: ## aRnew_points($i) = [list $x $y $z] ################################################################## set Nverts 4 set XYlistPx {} for {set n 0} {$n < $Nverts} {incr n} { set vertID [lindex $aRconnect($polyID) $n] foreach {thisX thisY thisZ} $aRnew_points($vertID) {break} ######################################################################### ## NOTES on WORLD-to-PIXELS CONVERSION: ## ## Append the yz world-coords (converted to xy pixel coords) to XYlistPx. ## ## Convert the yz coordinates to pixel values, using the 'PxPerUnit' ## factor determined above. Then add $xmidPx or $ymidPx to account for the ## fact that aRnew_points world-coordinates are relative to (x,y,z)=(0,0,0), ## and (0,0,0) should be positioned in the middle of the canvas. ## ## Note: We are plotting the yz world coords about the center of the canvas ## at ($xmidPx,$ymidPx). We are plotting the y world coords in the x-direction ## of the canvas and the z world coords in the y direction of the canvas. ## ## Note that the y-pixels coords are based at the top of the canvas, yet the ## world-coordinates are based at the bottom. We convert the z-world-coords ## to pixels and then subtract from the canvas height. ########################################################################### set xPx [expr { round( ($PxPerUnit * $thisY) + $xmidPx ) }] set yPx [expr { round( $curCanHeightPx - (($PxPerUnit * $thisZ) + $ymidPx) ) }] lappend XYlistPx $xPx $yPx ########################################################################## ## Set 'bigX', the biggest X, for this 'poly', if we need to x-depth-shade ## the 'poly' because the user requested poly_shade="viewDepth". ########################################################################## if {"$poly_shade" == "viewDepth"} { set thisX [expr {double($thisX)}] if {$n == 0} { set bigX $thisX } else { if {$thisX > $bigX} {set bigX $thisX} } } ## END OF if {"$poly_shade" == "viewDepth"} } ## END OF n loop for poly $polyID ## FOR TESTING: # puts "proc 'draw_2D_pixel_polys' > In a loop over the 'polys', for polyID: $polyID" # puts " converted the y,z vertex point-coords to pixel units for $Nverts vertices :" # puts " XYlistPx: $XYlistPx" # puts " Also found the biggest X for POLYGON $polyID - bigX: $bigX" ########################################################################## ## SECTION: SET-FILL-COLOR for poly $polyID. ## ## If fill is requested (var 'poly_fillout' is 'FILLonly' or 'FILLoutline' ## --- not 'WIREhide' or 'WIREnohide'): ## ## Set polyCOLORr,polyCOLORg,polyCOLORb according to the value of var ## poly_fillsrc: fromButton, fromPixels, fromFixedTable, fromRandomTable. ## ## (In a following section, ## we will shade polyCOLORr,polyCOLORg,polyCOLORb according to the ## shading request in var poly_shade.) ########################################################################## ## As a default (to make sure these color vars are set), ## we COULD set the RGB colors for this $polyID from the current setting ## of the fill-color button of this GUI. ## OR, we could leave these unset and test for errors in logic by ## seeing if we get 'polyCOLOR not set' errors. # set polyCOLORr $COLOR1r # set polyCOLORg $COLOR1g # set polyCOLORb $COLOR1b if {"$poly_fillout" == "FILLonly" || "$poly_fillout" == "FILLoutline"} { if {"$poly_fillsrc" == "fromButton"} { set polyCOLORr $COLOR1r set polyCOLORg $COLOR1g set polyCOLORb $COLOR1b } if {"$poly_fillsrc" == "fromPixels"} { ## For poly $polyID, get its color from a pixel corresponding ## to one of its vertices --- from the points array: ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] ## which holds the RGB colors of the pixels. ## ## Recall our format for aRconnect: ## aRconnect($k) = [list $vertID1 $vertID2 v$ertID3 $vertID4] set vertID1 [lindex $aRconnect($polyID) 0] set RGBlist [lindex $aRpoints($vertID1) 1] set polyCOLORr [lindex $RGBlist 0] set polyCOLORg [lindex $RGBlist 1] set polyCOLORb [lindex $RGBlist 2] } ## END OF if {"$poly_fillsrc" == "fromPixels"} if {"$poly_fillsrc" == "fromFixedTable"} { ## For poly $polyID, get its color from the z-height of one ## of its vertices --- from the points array: ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] ## and use the fixed color table in array 'aRcolor' ## to assign a color according to the z-height within the ## range minZ to maxZ. ## ## Recall our format for aRconnect: ## aRconnect($k) = [list $vertID1 $vertID2 $vertID3 $vertID4] ## Recall the color table was set as follows, ## starting with index 1: ## set aRcolor(1) [list 0 153 255] set vertID1 [lindex $aRconnect($polyID) 0] set z [lindex $aRpoints($vertID1) 4] set IDXcolor [expr {int( (($z - $minZ)/$deltaHGTperCOLOR) + 1)}] if {$IDXcolor > $Ncolors} {set IDXcolor $Ncolors} set RGBlist $aRcolor($IDXcolor) set polyCOLORr [lindex $RGBlist 0] set polyCOLORg [lindex $RGBlist 1] set polyCOLORb [lindex $RGBlist 2] } ## END OF if {"$poly_fillsrc" == "fromFixedTable"} if {"$poly_fillsrc" == "fromRandomTable"} { ## For poly $polyID, get its color from the z-height of one ## of its vertices --- from the points array: ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] ## and use the 'RANDOM' color table in array 'aRrandColor' ## to assign a color according to the z-height within the ## range minZ to maxZ. ## ## Recall our format for aRconnect: ## aRconnect($k) = [list $vertID1 $vertID2 $vertID3 $vertID4] ## Recall the 'rand' color table was set as follows, ## starting with index 1: ## set aRrandColor(1) [list 0 153 255] set vertID1 [lindex $aRconnect($polyID) 0] set z [lindex $aRpoints($vertID1) 4] set IDXcolor [expr {int( (($z - $minZ)/$deltaHGTperCOLOR) + 1)}] if {$IDXcolor > $Ncolors} {set IDXcolor $Ncolors} set RGBlist $aRrandColor($IDXcolor) set polyCOLORr [lindex $RGBlist 0] set polyCOLORg [lindex $RGBlist 1] set polyCOLORb [lindex $RGBlist 2] } ## END OF if {"$poly_fillsrc" == "fromRandomTable"} } ## END OF if {"$poly_fillout" == "FILLonly" || "$poly_fillout" == "FILLoutline"} ## That is, end of section that sets polyCOLORr,polyCOLORg,polyCOLORb --- ## the fill color for polygon $polyID. ########################################################################## ## SECTION: SHADE THE SELECTED FILL-COLOR for poly $polyID. ## ## The color for this polygon --- polyCOLORr,polyCOLORg,polyCOLORb --- ## is to be modified according to the current shading request: ## 'none' OR 'origZheight' OR 'viewDepth' OR 'byLighting' ## ## In a following section, we will use polyCOLORr,polyCOLORg,polyCOLORb ## to set var 'hexFILLcolor' for use, finally, in 'create polygon' commands ## used for the type of fill-draw that may be requested (FILLonly or FILLoutline). ## ## This section is to be executed if ## fill is requested (var 'poly_fillout' is 'FILLonly' or 'FILLoutline' --- ## i.e. if neither 'WIREhide' nor 'WIREnohide' is requested) ## AND ## shading type is not 'none'. ########################################################################## if {"$poly_shade" != "none"} { if {"$poly_shade" == "origZheight" && $deltaHeight != 0.0} { ## For poly $polyID, shade its color --- polyCOLORr,polyCOLORg, ## polyCOLORb -- according to the z-height of one ## of its vertices --- from the points array: ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] ## ## Use the parms 'shadeRatio' and 'Low0to1' set above this loop ## over the sorted polyIDs. ## ## The steps are: ## ## 1) Get the ORIGINAL Z-height of polygon $polyID at a vertex ## of the polygon. (This is faster than finding an average.) ## 2) Compute its "ratio" in the Z (min, max) range, a float between ## 0 and 1. ## 3) Use this ratio to map the current poly-color RGB components ## (polyCOLORr,polyCOLORg,polyCOLORb) into a new,shaded ## fill color for the polygon, using 'shadeRatio' and 'Low0to1' ## linear-interp. vars set above this poly-processing-loop. ## ## Recall our format for aRconnect: ## aRconnect($k) = [list $vertID1 $vertID2 $vertID3 $vertID4] set vertID1 [lindex $aRconnect($polyID) 0] set z [lindex $aRpoints($vertID1) 4] set tempFactor [expr {($shadeRatio * ($z - $minZ)) + $Low0to1}] ## FOR TESTING: # puts "proc 'draw_2D_pixel_polys' > Shading the poly-colors by 'origZheight'." # puts " For poly $polyID, STARTed with:" # puts " polyCOLORr: $polyCOLORr polyCOLORg: $polyCOLORg polyCOLORb: $polyCOLORb" set polyCOLORr [expr {int($tempFactor * $polyCOLORr)}] if {$polyCOLORr > 255} {set polyCOLORr 255} set polyCOLORg [expr {int($tempFactor * $polyCOLORg)}] if {$polyCOLORg > 255} {set polyCOLORg 255} set polyCOLORb [expr {int($tempFactor * $polyCOLORb)}] if {$polyCOLORb > 255} {set polyCOLORb 255} ## FOR TESTING: # puts "proc 'draw_2D_pixel_polys' > Shading the poly-colors by 'origZheight'." # puts " For poly $polyID, ENDed with:" # puts " polyCOLORr: $polyCOLORr polyCOLORg: $polyCOLORg polyCOLORb: $polyCOLORb" } ## END OF if {"$poly_shade" == "origZheight"} if {"$poly_shade" == "viewDepth"} { ## For poly $polyID, shade its color --- polyCOLORr,polyCOLORg, ## polyCOLORb -- according to the 'view-depth' (x-coord) of one ## of its vertices --- from the translated-rotated points array: ## aRnew_points($k) = [list $newx $newy $newz] ## ## We got the biggest X ('bigX') according to our view (i.e. ## after translation and rotation) when we accumulated ## the xyz coords of this poly, $polyID, above. ## We use that for our viewDepth. ## ## The steps are: ## ## 1) Use 'bigX' as a measure of the 'depth' of this polygon. ## 2) Compute its "ratio" in the 'newX' (min, max) range, a float between ## 0 and 1. (We set newminX and newmaxX in the 'rotate' proc.) ## 3) Use this ratio to map the current poly-color RGB components ## (polyCOLORr,polyCOLORg,polyCOLORb) into a new,shaded ## fill color for the poly, using 'shadeRatio' and 'Low0to1' ## linear-interp. vars set above this poly-processing-loop. ## ## NOTE: ## If deltaHeight is zero, we leave the polyCOLOR vars 'as-is'. set tempHeight [expr {$bigX - $minnewX}] set tempFactor [expr {($shadeRatio * $tempHeight) + $Low0to1}] ## FOR TESTING: # puts "proc 'draw_2D_pixel_polys' > Shading the poly-colors by 'viewDepth'." # puts " For poly $polyID, STARTed with:" # puts " polyCOLORr: $polyCOLORr polyCOLORg: $polyCOLORg polyCOLORb: $polyCOLORb" set polyCOLORr [expr {int($tempFactor * $polyCOLORr)}] if {$polyCOLORr > 255} {set polyCOLORr 255} set polyCOLORg [expr {int($tempFactor * $polyCOLORg)}] if {$polyCOLORg > 255} {set polyCOLORg 255} set polyCOLORb [expr {int($tempFactor * $polyCOLORb)}] if {$polyCOLORb > 255} {set polyCOLORb 255} ## FOR TESTING: # puts "proc 'draw_2D_pixel_polys' > Shading the poly-colors by 'viewDepth'." # puts " For poly $polyID, ENDed with:" # puts " polyCOLORr: $polyCOLORr polyCOLORg: $polyCOLORg polyCOLORb: $polyCOLORb" } ## END OF if {"$poly_shade" == "viewDepth"} if {"$poly_shade" == "byLighting"} { ## For poly $polyID, shade its color --- polyCOLORr,polyCOLORg, ## polyCOLORb -- according to the angle that the polygon ## makes with a light source from the viewer (i.e. along ## the x-viewing axis). ## To get the angle we use a cross-product of a couple ## of vectors made from 3 of the vertices of the polygon. ## ## We get the vertices --- from the translated-rotated points array: ## aRnew_points($k) = [list $newx $newy $newz] ## ## The steps are: ## ## 1) Get 3 vertices. Subtract 1 from 2 and 1 from 3 to get ## xyz coords of 2 vectors along the side of the polygon. ## 2) Pass the 6 xyz coords to proc 'cross_product_normx' ## which will return a float between 0 and 1. ## 3) Multiply that number times the current poly-color RGB components ## (polyCOLORr,polyCOLORg,polyCOLORb) to get a new,shaded ## fill color for the poly. set vertID1 [lindex $aRconnect($polyID) 0] set vertID2 [lindex $aRconnect($polyID) 1] set vertID3 [lindex $aRconnect($polyID) 2] foreach {x1 y1 z1} $aRnew_points($vertID1) {break} foreach {x2 y2 z2} $aRnew_points($vertID2) {break} foreach {x3 y3 z3} $aRnew_points($vertID3) {break} set x12 [expr {$x2 - $x1}] set y12 [expr {$y2 - $y1}] set z12 [expr {$z2 - $z1}] set x13 [expr {$x3 - $x1}] set y13 [expr {$y3 - $y1}] set z13 [expr {$z3 - $z1}] set tempFactor [cross_product_normx $x12 $y12 $z12 $x13 $y13 $z13] set tempFactor [expr {abs($tempFactor)}] ## Note: When tempFactor is negative, this is an indication that the ## polygon is tilted away from the viewer. This could be used as an ## indicator to skip plotting this polygon (i.e. backface culling). ## FOR TESTING: # puts "proc 'draw_2D_pixel_polys' > Shading the poly-colors 'byLighting'." # puts " For poly $polyID, STARTed with:" # puts " polyCOLORr: $polyCOLORr polyCOLORg: $polyCOLORg polyCOLORb: $polyCOLORb" # puts " From proc 'cross_product_normx', tempFactor: $tempFactor" set polyCOLORr [expr {int($tempFactor * $polyCOLORr)}] if {$polyCOLORr > 255} {set polyCOLORr 255} set polyCOLORg [expr {int($tempFactor * $polyCOLORg)}] if {$polyCOLORg > 255} {set polyCOLORg 255} set polyCOLORb [expr {int($tempFactor * $polyCOLORb)}] if {$polyCOLORb > 255} {set polyCOLORb 255} ## FOR TESTING: # puts "proc 'draw_2D_pixel_polys' > Shading the poly-colors 'byLighting'." # puts " For poly $polyID, ENDed with:" # puts " polyCOLORr: $polyCOLORr polyCOLORg: $polyCOLORg polyCOLORb: $polyCOLORb" } ## END OF if {"$poly_shade" == "byLighting"} } ## END OF if {"$poly_shade" != "none"} ## That is, end of section that shades polyCOLORr,polyCOLORg,polyCOLORb --- ## the fill color for polygon $polyID. ############################################################################ ## DRAW-SECTION: SET VAR 'hexFILLcolor' from polyCOLORr,polyCOLORg,polyCOLORb ## (or from other considerations) for poly $polyID. ## ## If this is a wire display, we set 'hexFILLcolor' with the color from the ## outline-color button of the GUI. Otherwise (for non-wire = some-type-of-fill), ## we set 'hexFILLcolor' from polyCOLORr,polyCOLORg,polyCOLORb. ## ############################################################################# if {"$poly_fillout" == "WIREhide" || "$poly_fillout" == "WIREnohide"} { set hexFILLcolor "$COLOR2hex" } else { ## If the 'polyCOLOR' vars are not set at this point and the logic is too much, ## we could set a default color for 'hexFILLcolor' (the color from the fill-color ## button of the GUI). set hexFILLcolor [format "#%02X%02X%02X" $polyCOLORr $polyCOLORg $polyCOLORb] } ############################################################################ ## DRAW-SECTION: DRAW THE 'poly', $polyID, with 'create polygon'. ## ## We take the 4 cases, 'poly_fillout' = ## WIREhide OR WIREnohide OR FILLout OR FILLoutline ############################################################################ if { "$poly_fillout" == "WIREhide" } { eval .fRcanvas.canvas create polygon $XYlistPx \ -outline $hexFILLcolor -fill $COLORbkGNDhex -tags TAGpolygon } ## END OF if { "$poly_fillout" == "WIREhide" } if { "$poly_fillout" == "WIREnohide" } { eval .fRcanvas.canvas create polygon $XYlistPx \ -outline $hexFILLcolor -fill \"\" -tags TAGpolygon ## (NOTE: By setting '-fill' to null instead of the background color, ## we get a wireframe image with NO hiding of back polygons.) } ## END OF if { "$poly_fillout" == "WIREnohide" } if { "$poly_fillout" == "FILLoutline"} { eval .fRcanvas.canvas create polygon $XYlistPx \ -outline $COLOR2hex -fill $hexFILLcolor -tags TAGpolygon } ## END OF if { "$poly_fillout" == "FILLoutline"} if { "$poly_fillout" == "FILLonly"} { eval .fRcanvas.canvas create polygon $XYlistPx \ -fill $hexFILLcolor -tags TAGpolygon } ## END OF if { "$poly_fillout" == "FILLonly"} ## We may find use for 'TAGpolygon', for example to delete ## all polygons but leave other canvas objects such as text ## (someday?) on the canvas. ## FOR TESTING: (slow down the drawing of the polygons) # update # after 50 } ## END OF k loop over the x-depth-sorted polygons } ## END OF proc 'draw_2D_pixel_polys' ##+##################################################################### ## proc 'set_polygon_color1' ##+##################################################################### ## PURPOSE: ## ## This procedure is invoked to get an RGB triplet ## via 3 RGB slider bars on the FE Color Selector GUI. ## ## Uses that RGB value to set a 'fill' color. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCOLOR1 button ##+##################################################################### proc set_polygon_color1 {} { global COLOR1r COLOR1g COLOR1b COLOR1hex COLOR1r COLOR1g COLOR1b # global feDIR_tkguis ## FOR TESTING: # puts "COLOR1r: $COLOR1r" # puts "COLOR1g: $COLOR1g" # puts "COLOR1b: $COLOR1b" set TEMPrgb [ exec \ ./sho_colorvals_via_sliders3rgb.tk \ $COLOR1r $COLOR1g $COLOR1b] # $feDIR_tkguis/sho_colorvals_via_sliders3rgb.tk \ ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLOR1hex "#$hexRGB" set COLOR1r $r255 set COLOR1g $g255 set COLOR1b $b255 ## Set color of color1 button and update the colors label. update_colors_label ## Redraw the geometry in the new fill color. wrap_draw_2D_pixel_polys } ## END OF proc 'set_polygon_color1' ##+##################################################################### ## proc 'set_polygon_color2' ## ##+##################################################################### ## PURPOSE: ## ## This procedure is invoked to get an RGB triplet ## via 3 RGB slider bars on the FE Color Selector GUI. ## ## Uses that RGB value to set an 'outline' color. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCOLOR2 button ##+##################################################################### proc set_polygon_color2 {} { global COLOR2r COLOR2g COLOR2b COLOR2hex COLOR2r COLOR2g COLOR2b # global feDIR_tkguis ## FOR TESTING: # puts "COLOR2r: $COLOR2r" # puts "COLOR2g: $COLOR2g" # puts "COLOR2b: $COLOR2b" set TEMPrgb [ exec \ ./sho_colorvals_via_sliders3rgb.tk \ $COLOR2r $COLOR2g $COLOR2b] # $feDIR_tkguis/sho_colorvals_via_sliders3rgb.tk \ ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLOR2hex "#$hexRGB" set COLOR2r $r255 set COLOR2g $g255 set COLOR2b $b255 ## Set color of color2 button and update the colors label. update_colors_label ## Redraw the geometry in the new outline color. wrap_draw_2D_pixel_polys } ## END OF proc 'set_polygon_color2' ##+##################################################################### ## proc 'set_background_color' ##+##################################################################### ## PURPOSE: ## ## This procedure is invoked to get an RGB triplet ## via 3 RGB slider bars on the FE Color Selector GUI. ## ## Uses that RGB value to set the color of the canvas --- ## on which all the tagged items (polygons) lie. ## ## Arguments: none ## ## CALLED BY: .fRbuttons.buttCOLORbkGND button ##+##################################################################### proc set_background_color {} { global COLORbkGNDr COLORbkGNDg COLORbkGNDb COLORbkGNDhex # global feDIR_tkguis ## FOR TESTING: # puts "COLORbkGNDr: $COLORbkGNDr" # puts "COLORbkGNDg: $COLORbkGNDb" # puts "COLORbkGNDb: $COLORbkGNDb" set TEMPrgb [ exec \ ./sho_colorvals_via_sliders3rgb.tk \ $COLORbkGNDr $COLORbkGNDg $COLORbkGNDb] # $feDIR_tkguis/sho_colorvals_via_sliders3rgb.tk \ ## FOR TESTING: # puts "TEMPrgb: $TEMPrgb" if { "$TEMPrgb" == "" } { return } scan $TEMPrgb "%s %s %s %s" r255 g255 b255 hexRGB set COLORbkGNDhex "#$hexRGB" set COLORbkGNDr $r255 set COLORbkGNDg $g255 set COLORbkGNDb $b255 ## Set color of background-color button and update the colors label. update_colors_label ## Set the color of the canvas. .fRcanvas.canvas config -bg $COLORbkGNDhex } ## END OF proc 'set_background_color' ##+##################################################################### ## proc 'update_colors_label' ##+##################################################################### ## PURPOSE: ## This procedure is invoked to update the text in a COLORS ## label widget, to show hex values of current color1, color2, ## and background-color settings. ## ## This proc also sets the background color of each of those 3 buttons ## to its current color --- and sets foreground color to a ## suitable black or white color, so that the label text is readable. ## ## Arguments: global color vars ## ## CALLED BY: 3 colors procs: ## 'set_polygon_color1' ## 'set_polygon_color2' ## 'set_background_color' ## and the additional-GUI-initialization section at ## the bottom of this script. ##+##################################################################### proc update_colors_label {} { global COLOR1hex COLOR2hex COLORbkGNDhex \ COLOR1r COLOR1g COLOR1b \ COLOR2r COLOR2g COLOR2b \ COLORbkGNDr COLORbkGNDg COLORbkGNDb .fRtop.fRbuttons.labelCOLORS configure -text "\ Poly-Fill-Color - $COLOR1hex Poly-Outline-Color - $COLOR2hex Background Color: $COLORbkGNDhex" # set colorBREAK 300 set colorBREAK 250 .fRtop.fRbuttons.buttCOLOR1 configure -bg $COLOR1hex set sumCOLOR1 [expr {$COLOR1r + $COLOR1g + $COLOR1b}] if {$sumCOLOR1 > $colorBREAK} { .fRtop.fRbuttons.buttCOLOR1 configure -fg "#000000" } else { .fRtop.fRbuttons.buttCOLOR1 configure -fg "#f0f0f0" } .fRtop.fRbuttons.buttCOLOR2 configure -bg $COLOR2hex set sumCOLOR2 [expr {$COLOR2r + $COLOR2g + $COLOR2b}] if {$sumCOLOR2 > $colorBREAK} { .fRtop.fRbuttons.buttCOLOR2 configure -fg "#000000" } else { .fRtop.fRbuttons.buttCOLOR2 configure -fg "#f0f0f0" } .fRtop.fRbuttons.buttCOLORbkGND configure -bg $COLORbkGNDhex set sumCOLORbkgd [expr {$COLORbkGNDr + $COLORbkGNDg + $COLORbkGNDb}] if {$sumCOLORbkgd > $colorBREAK} { .fRtop.fRbuttons.buttCOLORbkGND configure -fg "#000000" } else { .fRtop.fRbuttons.buttCOLORbkGND configure -fg "#f0f0f0" } } ## END OF proc 'update_colors_label' ##+######################################################################### ## proc 'enable_fillsrc_radbutts' ##+######################################################################### ## PURPOSE: To enable the 'FILLSRC' radiobuttons. ## ## CALLED BY: See BINDINGS section above, some bindings on FILLOUT ## radiobuttons --- 'FILLonly' and 'FILLoutline'. ##+######################################################################### proc enable_fillsrc_radbutts {} { .fRopts.fRfillsrc.radbuttFILLSRCfromPixels configure -state normal .fRopts.fRfillsrc.radbuttFILLSRCfromButton configure -state normal .fRopts.fRfillsrc.radbuttFILLSRCfromFixedTable configure -state normal .fRopts.fRfillsrc.radbuttFILLSRCfromRandomTable configure -state normal } ## END OF PROC 'enable_fillsrc_radbutts' ##+######################################################################### ## proc 'disable_fillsrc_radbutts' ##+######################################################################### ## PURPOSE: To disable the 'FILLSRC' radiobuttons. ## ## CALLED BY: See BINDINGS section above, some bindings some FILLOUT ## radiobuttons --- 'wirehidn' and 'wirehide'. ##+######################################################################### proc disable_fillsrc_radbutts {} { .fRopts.fRfillsrc.radbuttFILLSRCfromPixels configure -state disable .fRopts.fRfillsrc.radbuttFILLSRCfromButton configure -state disable .fRopts.fRfillsrc.radbuttFILLSRCfromRandomTable configure -state disable .fRopts.fRfillsrc.radbuttFILLSRCfromFixedTable configure -state disable } ## END OF PROC 'disable_fillsrc_radbutts' ##+######################################################################### ## proc 'enable_shade_radbutts' ##+######################################################################### ## PURPOSE: To enable the 'SHADE' radiobuttons. ## ## CALLED BY: See BINDINGS section above, the bindings on the FILLSRC ## radiobuttons. ##+######################################################################### proc enable_shade_radbutts {} { global poly_fillsrc poly_fillout poly_shade .fRopts.fRshadeopts.radbuttSHADEnone configure -state normal .fRopts.fRshadeopts.radbuttSHADEorigZheight configure -state normal .fRopts.fRshadeopts.radbuttSHADEviewDepth configure -state normal .fRopts.fRshadeopts.radbuttSHADEbyLighting configure -state normal # .fRopts.fRshadeopts.radbuttSHADEorigYheight configure -state normal # .fRopts.fRshadeopts.radbuttSHADEorigXheight configure -state normal ## If fill-and-outline is requested, to avoid extra processing, ## we can discourage use of shading options by setting ## 'poly_shade' to 'none'. if {"$poly_fillout" == "FILLoutline"} { set poly_shade "none" } ## If fill-only is requested, to avoid a large blob of solid color, ## we could discourage use of no-shading ## by setting 'poly_shade' to an option like 'origZheight' instead ## of 'none'. if {"$poly_fillout" == "FILLonly" && "$poly_shade" == "none"} { set poly_shade "origZheight" } } ## END OF PROC 'enable_shade_radbutts' ##+######################################################################### ## proc 'disable_shade_radbutts' ##+######################################################################### ## PURPOSE: To disable the 'SHADE' radiobuttons. ## ## CALLED BY: See BINDINGS section above, the bindings on some FILLOUT ## radiobuttons. ##+######################################################################### proc disable_shade_radbutts {} { .fRopts.fRshadeopts.radbuttSHADEnone configure -state disable .fRopts.fRshadeopts.radbuttSHADEorigZheight configure -state disable .fRopts.fRshadeopts.radbuttSHADEviewDepth configure -state disable .fRopts.fRshadeopts.radbuttSHADEbyLighting configure -state disable # .fRopts.fRshadeopts.radbuttSHADEorigYheight configure -state disable # .fRopts.fRshadeopts.radbuttSHADEorigXheight configure -state disable } ## END OF PROC 'disable_shade_radbutts' ##+######################################################################## ## PROC 'cross_product_normx' ##+######################################################################## ## PURPOSE: Performs the vector cross-product of 2 given 3D-vectors --- ## p=(px,py,pz) and q=(qx,qy,qz) --- such as 2 vectors along ## 2 sides of a quadrilateral/triangular polygon of the terrain ## surface. ## ## The output is the normalized x-component of the cross-product ## vector. ## ## Since we will be assuming a light source along the viewing ## x-axis, this component gives us the cosine of the angle ## between this cross-product vector (normal to the polygon) ## and a unit vector in the x-direction. ## ## CALLED BY: the 'draw' proc, to perform 'shading' of the specified ## source of fill colors in polygons. ## ## USE: The absolute value of the 'normx' output is ## multiplied times the RGB values of a polygon color to give ## the 'shaded-color' of the polygon. ##+######################################################################## proc cross_product_normx {px py pz qx qy qz} { set crossx [expr { ($py * $qz) - ($qy * $pz) }] set crossy [expr { ($qx * $pz) - ($px * $qz) }] set crossz [expr { ($px * $qy) - ($qx * $py) }] set MAGcross [expr {sqrt(($crossx * $crossx) + ($crossy * $crossy) + ($crossz * $crossz))}] set normx [expr { $crossx / $MAGcross }] # set MAGp [expr {sqrt(($px * $px) + ($py * $py) + ($pz * $pz))}] # set MAGq [expr {sqrt(($qx * $qx) + ($qy * $qy) + ($qz * $qz))}] # set sinAngTWEENpANDq [expr { $MAGcross / ($MAGp * $MAGq) }] return $normx } ## END OF PROC 'cross_product_normx' ##+##################################################################### ## proc 'toggle_side' ##+##################################################################### ## PURPOSE: To switch the sides of the 'fRopts' & 'fRcanvas' frames. ## ## CALLED BY: .fRtop.fRbuttons.butTOGSIDE button ##+##################################################################### proc toggle_side { } { global LR_side if { "$LR_side" == "left" } { set LR_side "right" } else { set LR_side "left" } ## Re-pack the side-by-side frames 'fRopts' and 'fRcanvas' ## to the opposite sides from where they were. pack forget .fRopts .fRcanvas pack .fRopts \ -side $LR_side \ -anchor w \ -fill y \ -expand 0 pack .fRcanvas \ -side $LR_side \ -anchor w \ -fill both \ -expand 1 } ## END of proc 'toggle_side' ##+############################################################# ## proc ReDraw_if_canvas_resized ## ## PURPOSE: Redraws the surface on the canvas, but only ## if the canvas size has changed. If the canvas ## size has increased, the surface is drawn bigger. ## ## CALLED BY: bind .fRcanvas.canvas ## at bottom of this script. ##+############################################################# proc ReDraw_if_canvas_resized {} { global PREVcanWidthPx PREVcanHeightPx diam ## Bail out if an indicator (that data has been read ## and ready for drawing) is not set. if {![info exists diam]} {return} set CURcanWidthPx [winfo width .fRcanvas.canvas] set CURcanHeightPx [winfo height .fRcanvas.canvas] if { $CURcanWidthPx != $PREVcanWidthPx || $CURcanHeightPx != $PREVcanHeightPx} { wrap_draw_2D_pixel_polys set PREVcanWidthPx $CURcanWidthPx set PREVcanHeightPx $CURcanHeightPx } } ## END OF proc 'ReDraw_if_canvas_resized' ##+############################################################# ## proc write_obj ## ## PURPOSE: To write an OBJ file ('v' vertex records and 'f' ## face records) from the data in the points array ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] ## and the polygon (connectivity) array ## aRconnect($k) = [list $vertID1 $vertID2 $vertID3 $vertID4] ## ## METHOD: This proc uses the 'puts' command to write records. See the info ## below on the format of a Wavefront OBJ file. ## ## CALLED BY: the '-command' option of the button ## .fRtop.fRbuttons.buttWRITEobj ##+############################################################# ## OBJ FILE FORMAT INFO: ## ## 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). ## ## This 'OBJ-writer' supports a subset of the file format ## (not the curves and surfaces). ## ## The following text is a very brief description of the 'v' and 'f' ## records (and comment records) in '.obj' files. ## ## Records other than 'v ' and 'f ' records (and comment records) ## are not written by this 'OBJ-writer'. ## ## This proc writes 'v ' records, but not 'vn' (vertex normal) and ## 'vt' (vertex texture) records. ## ## Main OBJ record types: ## ## # some text ## Line is 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. I.e. in the 'f' (face) ## records, the integers representing vertices start with 1. ## ## 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: There vertex IDs in the face records should ## start at 1, not 0. If you see a zero index in a face ## record that is going to cause a problem with any application ## that reads OBJ files according to the standard. ## ## A very elementary example file is given below (it is a cube): ## ## 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 ## ## The top of a '.obj' file typically contains a few '#' comment records ## indicating the source of the data and, often, the number of vertices ## and faces in the file. ## But you cannot count on the number of vertices being given in the file. ## A program must read the 'v' records and assign vertex ID numbers ## as the 'v' records are being read. ## ## Here is a variety of 'v' records: ## v 16 17 5 ## v 19 61 18.3073 ## v 3.5 88 8.50596 ## v 19.9352 12.0843 -2.24927 ## Note that integers are allowed along with decimal numbers. ## ## When there are 'vt' and/or 'vn' records in the file, ## it is quite common to see 'f' records in one of the ## following formats: ## ## f 1//1 2//2 3//3 4//4 (for 'vn' recs in the file) ## f 1/1 2/2 3/3 4/4 (for 'vt' recs in the file) ## f 6/4/1 3/5/3 7/6/5 (for both in the file) ## ## The integers between two slashes in a group are IDs of ## texture-vertices. ## The integers after the 2nd slash in a group are IDs of ## normals at vertices. ## ## This 'OBJ-writer' only write the simple face records: ## f int int int ... ## ## This 'OBJ-writer' does not write records such as records starting with ## 'mtllib' 'usemtl' 'vt' 'vn' 'o' (object) 's' (shininess) 'g' (group). ## ## We may add the following 'color extension' --- a 'c' record --- ## to the OBJ file specification --- for this proc to support. ## ## Example format: ## c 0.64 0.64 0.85 ## ## The 3 decimal numbers (between 0 and 1) in these 'c' records are ## meant to emulate the data found in 'Kd' (diffuse color) records ## in material groups in an external OBJ '.mtl' file). ## ## This 'OBJ-writer' may convert the 3 RGB values (0 to 255) ## in the points array ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] ## to decimal values in the range 0 to 1 and put the 'current' 3 values ## in a 'c' record every time there is a change in the RGB values ## as we read through the aRpoints array. ## ## Alternatively, logic could be incorporated in this OBJ-writer ## to assign colors to the polygons, from the colors in the vertices ## of those polygons. ## ## The intent here is that an application (like another Tcl-Tk script) ## could be written so that when a 'c' record is encountered while ## reading the 'cOBJ' file, its RGB-color values would be used to ## color for any following 'v' or 'f' records. ##+################################################################### proc write_obj {} { global aRpoints aRconnect NUMgridpts NUMpolys ENTRYfilename \ minX maxX minY maxY minZ maxZ Xmid Ymid Zmid diam \ env outDIR EDITOR_text if {![info exists diam]} {return} set userID "$env(USER)" set OUTfilename "$outDIR/${userID}_terrain_V${NUMgridpts}_F${NUMpolys}.obj" set f [open $OUTfilename w] ## Write a heading comment record to the file. puts $f "## OBJ file. Terrain file generated from image file:" puts $f "## $ENTRYfilename" puts $f "## by a Tcl-Tk script." puts $f "##" puts $f "## $NUMgridpts vertex ('v') records follow." ## Write the 'v' (vertex) records from the points array ## aRpoints($k) = [list "$i,$j" $RGBcolor-list $x $y $z] set CNTvertices 0 for {set k 0} {$k < $NUMgridpts} {incr k} { foreach {dummy dummy x y z} $aRpoints($k) {break} puts $f "v $x $y $z" incr CNTvertices } ## END OF k loop ## Write the 'f' (face) records from the polygons (connectivity) array ## aRconnect($k) = [list $vertID1 $vertID2 $vertID3 $vertID4] ## ## NOTE: The puts $f "##" puts $f "## $NUMpolys face ('f') records follow." set CNTfaces 0 for {set k 0} {$k < $NUMpolys} {incr k} { foreach {vertID1 vertID2 vertID3 vertID4} $aRconnect($k) {break} incr vertID1 incr vertID2 incr vertID3 incr vertID4 puts $f "f $vertID1 $vertID2 $vertID3 $vertID4" incr CNTfaces } ## END OF k loop ## Write a summary at the bottom of the OBJ file. puts $f "## TOTAL RECS WRITTEN - Vertices: $CNTvertices Faces: $CNTfaces" puts $f "## FROM ARRAYS WITH - Points: $NUMgridpts Polygons: $NUMpolys" puts $f "## MINIMUMS - x: $minX y: $minY z: $minZ" puts $f "## MAXIMUMS - x: $maxX y: $maxY z: $maxZ" puts $f "## MID-POINT - x: $Xmid y: $Ymid z: $Zmid" puts $f "## APPROX. DIAMETER - $diam" ## Close the file. close $f ## FOR TESTING: # puts "proc 'write_obj' > Vertices: $NUMgridpts Polygons: $NUMpolys" ## Show record counts on the GUI. .fRtop.fRbuttons.labelDRAWTIME configure -text "Counts for '.obj' file written to directory $outDIR Points (vertices) : $NUMgridpts Polygons (faces) : $NUMpolys" ## Display the file in a GUI text-editor. # exec /usr/bin/sh -c "$EDITOR_text "$OUTfilename" > /dev/null 2>&1" exec $EDITOR_text "$OUTfilename" } ## END OF proc 'write_obj' ##+######################################################################## ## 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 Terrain-Surface Generation-and-Examination Utility ** SELECTING/ENTERING AN IMAGE FILENAME: When the GUI comes up, you can use the 'Browse...' button next to the image-filename entry field to select an image file from which to generate a terrain-surface to examine. INITIAL DISPLAY OF THE TERRAIN SURFACE: An Enter-key-press --- or MouseButton-3 (MB3) click-release --- on the filename entry field will cause a terrain surface (vertices and polygons) to be generated and plotted in the canvas area --- according to the current settings of the various generate and examine options in the GUI. SAVING THE SURFACE: If the surface looks useful, use the 'WriteOBJ' button to save the vertex and connectivity (polygon) data in a 3D data file in Wavefront OBJ format. --- CHANGING THE GENERATED SURFACE : If the image does not give the surface that you were seeking, you can take the image file into an image processing utility to create a different image file to try. Then simply read in the new image file to see how it looks. Or find and try a different image file. Or write out an OBJ file and read it into a 3D model editor, like Blender or Wings3D, to change the terrain. --- ALTERING THE GRID DISTANCES and HEIGHT FACTOR: You can change the grid parameters --- xmin,xstep,ymin,ystep --- and z-height factor --- by entering new values. To re-plot based on the new 'distance parameters', you can press the Enter key in any distance entry field --- or to re-plot at ANY time, you can MB3-click-release on any of the 'distance-entry-fields'. Changing the distance parameters may not change the form of the surface, but they definitely change the data that would be written to a Save file, like a Wavefront OBJ file. --- CHANGING THE VIEW ANGLE: You can use the two 'angle-scale' widgets to quickly change either of a couple of rotation angles --- longitude (yaw) or latitude (pitch). An MB1-release of the slider on a angle-scale widget causes a replot. You can simply keep clicking in the 'trough' of either scale widget (to the left or right of the scale-button) to step through a series of re-plots, varying an angle one degee per click-release. Or you can hold MB1 down, when the mouse cursor is to the right or left of the scale-button in the trough, to rapidly but rather precisely change to a new angle of rotation. Releasing MB1 will cause a re-plot at the new angle. --- ZOOMING: You can use the 'zoom-scale' widget to magnify or shrink the plot. An MB1-release of the slider on the zoom-scale widget causes a replot. Click-release in the 'trough' --- on either side of the scale's button --- to zoom in/out a little at a time. --- FILL-ONLY/FILL-and-OUTLINE/WIRE-hidden/WIRE-show-all: The fill/outline/wire radiobuttons allow for showing the plot with the polygons color-filled or not --- and with outlines ('wireframe' mode) or not. --- COLOR: Three COLOR BUTTONS on the GUI allow for specifying a color for - the interior of the polygons - the outline of the polygons - the (canvas) background from among 16 million colors, each. --- Summary of 'EVENTS' that cause a 'REDRAW' of the plot: Pressing Enter/Return key when focus is in the image-filename entry field. Alternatively, a button3-release on the image-filename entry field. Pressing Enter/Return key when focus is in the - 'xmin' entry field - 'xstep' entry field - 'ymin' entry field - 'ystep' entry field - 'z-height-factor' entry field Alternatively, a button3-release in any of these 'distance-entry-fields'. Button1-release on the LONGITUDE or LATITUDE scale widget. Button1-release on the ZOOM scale widget. Button1-release on the either of the 2 WIRE radio-buttons. Button1-release on any of the SHADING option radio-buttons. Changing color via the FILL-COLOR or OUTLINE-COLOR buttons. ALSO: Resizing the window changes the size of the canvas, which triggers a redraw of the plot according to the new canvas size. --- SOME POTENTIAL ENHANCEMENTS: Eventually some other features may be added to this utility: - the ability to pan the plot, as well as rotate and zoom it. - the ability to use mouse motions on the canvas to rotate, zoom, and pan the plot --- say, MB1 to rotate, MB2 to zoom, and MB3 to pan the surface plot. - depth clipping may be added --- so that the user can essentially get section views of the surface. - a 'triad' may be added, to show the orientation of the 'local', 'surface-build' xyz axes in any (re)plot. - a check-button may be added to allow for switching to a 'perspective' view, from the current 'parallel projection'. - a check-button may be added to allow for 'backface culling', to speed up the plots when lots of polygons are not facing the viewer and perhaps would be hidden. - more polygon-sort options may be added, to offer some alternatives for the 'painting-order' of the polygons --- to allow for (perhaps?) better showing/hiding of near and far polygons. - we could add the ability to specify a different, arbitrary direction of the light source, instead of just the fixed light-source from the viewer (along the viewing axis). - more elaborate shading techniques may eventually be implemented --- a Gouraud-like shading (interpolation of the colors assigned to the vertices of the polygons) --- to get smoother shading effects across polygon edges, and perhaps to get glossy effects. This interpolation would really slow each plot down, but having the option might be worth it, to get a higher quality image --- if it can be done within 30 seconds for a 100x100 grid (10,000 vertices), say. (Unfortunately, there is no color interpolation option built into the Tk 'create polygon' command for the canvas. I would like to suggest this for Tk 9.0 --- at least for triangular polygons --- allow for specifying colors at the three vertices.) - the list may go on." ##+###################################################### ## End of PROC definitions. ##+###################################################### ## Additional GUI INITIALIZATION, if needed (or wanted): ##+###################################################### ## We set some 'universal' constants that will be used in the ## 'rotate_points' proc. 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 radsPERdeg [expr { $twopi / 360 }] ## Some mathematical constants/parameters are here. ## ## TOLfactor (times the diameter 'diam' of a model) ## is used as a 'zero-tolerance' check. Numbers less than ## the 'zero-tolerance' may be set to 0.0. set TOLfactor 0.0001 ## We need following command because the 'draw_2D_pixel_polys' proc ## (called below) does not (re)set the background/canvas color. ## Only the background-color button-proc sets the canvas color. .fRcanvas.canvas config -bg $COLORbkGNDhex ## We need following command because the 'draw_2D_pixel_polys' proc ## does not call the 'update_colors_label' proc to ## set the color of the color buttons and put ## the hex color values in the colors label. ## Only the color button procs call the 'update_colors_label' proc. update_colors_label ## Set xmin,xstep,ymin,ystep,zfactor initial values. set ENTRYxmin "0.0" set ENTRYxstep "10.0" set ENTRYymin "0.0" set ENTRYystep "10.0" # set ENTRYzfactor "0.2" set ENTRYzfactor "0.3" ## Set the initial values for the 2 scale widgets ## that set the initial rotation angles ## (longitude and latitude). ## ## NOTE: Using the '-variable' option of the ## 'scale' widget can cause unwanted 'auto-repeat' ## behavior of the widget, so we do NOT specify ## variables. We use 'set' and 'get' instead. if {0} { ## Start out looking at a FRONT VIEW of the model/surface. .fRtop.fRscales.scaleLON set 0 .fRtop.fRscales.scaleLAT set 0 } if {0} { ## Start out looking at a BACK VIEW of the model/surface. .fRtop.fRscales.scaleLON set 180 .fRtop.fRscales.scaleLAT set 0 } if {0} { ## Start out looking at an 'ISOMETRIC' VIEW of the model/surface. .fRtop.fRscales.scaleLON set 45 .fRtop.fRscales.scaleLAT set 45 } if {1} { ## Start out looking at the model/surface with NO rotation (yaw) ## about the Z (up) viewing axis and about 30 degrees of rotation ## (pitch) about the Y (to-the-right) viewing axis. .fRtop.fRscales.scaleLON set 0 .fRtop.fRscales.scaleLAT set 30 } if {0} { ## Start out looking at a RIGHT-SIDE VIEW of the model/surface. .fRtop.fRscales.scaleLON set 90 .fRtop.fRscales.scaleLAT set 0 } if {0} { ## Start out looking at a LEFT-SIDE VIEW of the model/surface. .fRtop.fRscales.scaleLON set 270 .fRtop.fRscales.scaleLAT set 0 } if {0} { ## Start out looking at a TOP VIEW of the model/surface. .fRtop.fRscales.scaleLON set 0 .fRtop.fRscales.scaleLAT set 90 } if {0} { ## Start out looking at a BOTTOM VIEW of the model/surface. .fRtop.fRscales.scaleLON set 0 .fRtop.fRscales.scaleLAT set -90 } ## We set the initial value for this 'scaleZOOM' widget ## so that there will probably be a nice margin around the ## initial plot. # set curZOOM 0.6 # set curZOOM 0.8 set curZOOM 0.9 # set curZOOM 1.0 ## Set initial SORT radiobutton value. set poly_sort "fromFarCorner" # set poly_sort "maxPolyDepth" # set poly_sort "avePolyDepth" # set poly_sort "minPolyDepth" ## Set initial FILLOUT radiobutton value. # set poly_fillout "FILLonly" set poly_fillout "FILLoutline" # disable_fillsrc_radbutts ; disable_shade_radbutts # set poly_fillout "WIREhide" # set poly_fillout "WIREnohide" ## Set initial FILLSRC radiobutton value. set poly_fillsrc "fromButton" # set poly_fillsrc "fromPixels" # set poly_fillsrc "fromFixedTable" # set poly_fillsrc "fromRandomTable" ## Set initial SHADE radiobutton value. set poly_shade "none" # set poly_shade "origZheight" # set poly_shade "viewDepth" # set poly_shade "byLighting" ## set poly_shade "origYheight" ## set poly_shade "origXheight" ## NOTE: We do not provide an initial display of a terrain ## in the GUI, say, by providing an initial image file. ## ## After the user enters/selects an image filename and the user ## triggers a binding to do a surface-generation-and-plot ## based on the image (see the BINDINGS section above), ## the following 'graphics pipeline' of procs is executed: ## ## 1) load_points_array ## (loads xyz values into an array 'aRpoints') ## 2) translate_points_array ## (converts the array 'aRpoints' to Cartesian coords ## in array 'aRtranspoints'. Translates the points so ## they are centered at the middle of the point cloud.) ## 3) rotate_points ## (rotates the 'aRtranspoints' points and store the ## resulting Cartesian coords in array 'aRnew_points'. ## Uses the 2 view angles --- longitude,latitude.) ## 4) wrap_draw_2D_pixel_polys ## (draws projections of the 3D polygons as 2D polygons ## on the Tk canvas. This proc 'sweeps' thru the ## array 'aRnew_points' converting the yz coords --- ## the 2D projection --- to pixel coords, and plots the ## polygons with the 'create polygon' command. ## The radiobutton settings for fill/outline, fill-src, ## and fill-shading are used in this proc.) ## Set an output directory in case the 'write_obj' proc is used. set outDIR "/tmp" ## Set a GUI text editor to use in the 'write_obj' proc. # set EDITOR_text "gedit" # set EDITOR_text "/usr/bin/gedit" set EDITOR_text "$env(HOME)/apps/gscite_2.27/SciTE" ## We force display of the GUI before setting the following ## 'bind .fRcanvas.canvas ' command, so that the ## binding does not trigger a redraw when the GUI is first ## configured --- during which the canvas size changes. update ## The 'bind ' command below handles ## automatic redraws whenever the user changes the ## window size, and thus the canvas size. ## ## From now on, if the canvas is resized, we do an automatic redraw ## via the 'wrap_draw_2D_pixel_polys' proc. set PREVcanWidthPx [winfo width .fRcanvas.canvas] set PREVcanHeightPx [winfo height .fRcanvas.canvas] bind .fRcanvas.canvas "ReDraw_if_canvas_resized" ====== '''ALPHABETIC TERRAINS''' When I was thinking about image files to use for making interesting terrains, it occurred to me that I could use a terrain generator to make interesting variations on letters of the alphabet. In fact, I can use my 'Title Block' utility at [A GUI for making 'Title Blocks' ... with text, fonts, colors, images] to put white letters on a black background (with a literally unlimited choice of fonts). Then I can capture the screen and take it into an image editor, like 'mtpaint', to crop the image and blur the letters to make a suitable image for terrain generation --- like the following image: [lettersFE_whiteONblack_blurred_194x128.gif] And here is an example of one kind of image that you can generate from alphabetic letters using this terrain generator. [3DterrainGeneratorExaminerGUI_FEletters_fillOnly_magenta_zHeightShading_959x623.jpg] And you could make terrains from pictures of favorite pets, pictures of children or grand-children, images of favorite cartoon characters, and so on. The list of possibilities is endless. ------ '''The WRITE-OBJ OPTION''' In testing the 'Write-OBJ' option of this terrain generator utility, I generated an OBJ file and decided to use my 3D OBJ/PLY/OFF/STL reader-viewer utility to see if the OBJ file was readable. Here is evidence that this terrain utility is capable of generating good OBJ files. [3DterrainGeneratorExaminer_FEobjFile_shownByModelReaderScript_randomColors_1024x689.jpg] I must admit that I had to fix a couple of bugs in my initial code for the 'write_obj' proc of the terrain utility before I could successfully read the file. In any case, I feel confident now that the Write-OBJ feature is working --- and that if I ever want to add some color capabilities to the writer, I can do so. ------ '''THE SHADING-BY-LIGHTING OPTION''' For the initial release of the 3D OBJ/PLY/OFF/STL reader-viewer script, the SHADING option called 'byLighting' was grayed-out (not implemented yet). I put a 'cross_product' proc in the terrain generator-viewer script to take into account the angle that polygon normals make with a light direction --- for simplicity, assuming the light is down the viewing axis, i. e. coming from the user/viewer. That option seems to be working OK. I had feared that the computations involved in computing the cross-product for thousands of polygons would increase the draw time considerably, However the draw times for the 'byLighting' shading option seem to be comparable to the draw-times for the 'byZheight' and 'byViewDepth' options. In any case, I will now 'back port' the 'byLighting' shading option into the 3D OBJ/PLY/OFF/STL reader-viewer script. Then I should be able to get nice shading of the gear model --- as well as nice shading on other models such as car, airplane, boat, and StarWars/StarTrek cruiser models, for which I was unable to get pleasing shading via the height/depth shading options. Here is an example of output from the shading 'byLighting' option. [3DterrainGeneratorExaminerGUI_graySpots_fillOnly_pixelGrays_shadeByLighting_961x621.jpg] It was generated from this image file. [spots_white-gray-black_192x108.gif] ------ '''GUI LAYOUT OPTIONS''' In the 3D OBJ/PLY/OFF/STL reader-viewer script, I put all the non-canvas frames at the top of the GUI, strung out across the GUI. I pointed out that that GUI layout works out well for long horizontal objects --- like cars, airplanes, boats, cows, and horses. But for tall objects, it might be better to put many of the frames (like several of the radiobutton frames) into Tk frames on the left or right of the GUI. For this terrain viewer, I decided to try that type of layout. And in the screen captures above, you can see a 'ToggleSide' button. Clicking on that button a couple of times quickly moves the frames on the left of the GUI to the right side of the GUI, and back again. I implemented that side-to-side switch capability by using the Tk 'pack forget' command --- as I have done in several other scripts that I have contributed to this wiki. For example, the technique is used for switching the color-swatch from right to left, and back, in the color-selector script that I mentioned above. ------ '''THE FIXED-COLOR-TABLE and RANDOM-COLOR-TABLE OPTIONS''' The following image illustrates the effect achieved by using the 'fixed-color-table' radiobutton from among the 'fill-color-source' radiobuttons. [3DterrainGeneratorExaminerGUI_heightMap_fillOnly_fixedColorsTable_noShading_1024x715.jpg] The colors in this image came from an 11-element array that is hard-coded in the script. If you want to change the colors, simply change the script. And you can add more colors if you like. The 'random-color-table' option allows you to quickly experiment with applying random colors to the polygons (according to the z-height of the polygons). It works by building a color table of random colors (the same number of colors as are in the fixed-color-table) and applying those colors to the polygons each time you click a GUI item that causes another re-draw of the terrain. The script re-builds the random-colors table each time a re-draw is done. So, for example, you can keep clicking on one of the 'fill shading type' radiobuttons to keep causing redraws. Each redraw will show the image with colors from a different set of random colors. I would put an image here to show the 'random-color-table/z-height' effect, but I am afraid I am using up too much disk space on this wiki with my GUI images. In any case, if you do not like how the fixed or random color tables were implemented, you can simply change the code to do it as you perfer. ------ '''SOME POTENTIAL ENHANCEMENTS:''' Eventually some other features may be added to this utility: '''**''' A checkbutton may be added to allow for turning on/off a 'triad' display, that indicates the current direction of the 'local' xyz coordinate axes of the terrain. '''**''' Add the ability to pan the model, as well as rotate and zoom it. '''**''' Add the ability to use mouse-motions on the canvas area to move the model. Say: MB1 to rotate, MB2 to zoom, and MB3 to pan the terrain. '''**''' Depth clipping may be added --- so that the user can essentially get section views of the terrain. '''**''' A check-button may be added to allow for switching to a 'perspective' view, from the current 'parallel projection'. '''**''' A check-button may be added to allow for 'backface culling', to speed up the plots when lots of polygons are not facing the viewer and perhaps would be hidden --- for example, polygons on the back-side of 'mountains' in the terrain. '''**''' More elaborate shading techniques may eventually be implemented --- such as Gouraud-like shading (color interpolation) --- to get smoother shading effects across polygon edges, and perhaps to get glossy effects. (These effects may be easiest to implement by using colors assigned to polygon vertex points rather than colors assigned to polygons. In fact, in this script, I store an RGB color triplet, taken from each pixel's color, for each point in the terrain surface.) This color interpolation would really slow each plot down (much slower than the shading 'byZheight', 'byViewDepth' and 'byLighting' options), but having the color-interpolation option might be worth it, to get a higher quality image --- if it can be done within 10 to 30 seconds for a 2,000 face model, say. (Unfortunately, there is no color-interpolation option built into the Tk 'create polygon' command for the canvas. I would like to suggest this for Tk 9.0 --- at least in the case when the polygons are triangles --- allow for specifying a different color at each of the 3 vertices --- and interpolate the 3 colors across the polygon, perhaps by using barycentric coordinates. In C code, this might proceed at a reasonably fast pace.) '''**''' No doubt, there are some ways to change the calculations and/or procedures to get a significant speed up of the redraws and thus allow for smooth rotation of fairly large terrains. If this script is enhanced to allow for 'immediate' rotation according to mouse motion on the canvas, then the rotation will definitely be a bit 'jumpy' --- even for 'small' terrains on the order of a few thousand polygons. So it behooves one to find ways to speed up the procs in the 'graphics pipeline'. '''**''' This enhancement list may be extended. I may add a few more ideas for enhancements to this script in coming months, as I tackle other 3D utilities. ------ '''SCALES RESPONSE''' '-repeatdelay 500' and '-repeatinterval 50' parameters are present on all three scales. If the responsiveness of the sliderbar movements is not to your liking (when you press-and-hold mouse-button-1 over a scale's trough --- to rapidly make changes of about 5 to 10 degrees in a view angle), you can change these milliseconds values. ------ '''NEXT 3D PROJECTS''' The four 3D-viewer scripts that I have developed so far have given me a wealth of procs and techniques that will be very useful to me. The procs of these 4 scripts will be useful for other 3D Tk-script projects --- such as a molecule-viewing utility --- the next 3D project on my to-do list. In that project, I will be reading in a '.mol' file instead of an image file (GIF or PNG) and instead of a 3D model file (OBJ, PLY, OFF, STL, etc.). I can take my read-OBJ file proc, say, and convert it into a read-MOL file proc. But first I need to 'back-port' some items from this terrain utility --- namely, the color-table 'fill-source' option and the 'by-lighting' 'fill-shade' option --- into the 3D OBJ/PLY/OFF/STL reader-viewer script. ------ '''IN CONCLUSION''' The script on this page is certainly not as capable or fast as some commercial 3D terrain file viewers --- but once again I say: There's a lot to like about a utility that is 'free freedom' --- that is, no-cost and open-source so that you can modify/enhance/fix it without having to wait for someone else to do it for you (which may be never). So once again ... A BIG THANK YOU to Ousterhout for starting Tcl-Tk, and a BIG THANK YOU to the Tcl-Tk developers and maintainers who have kept the simply MAH-velous 'wish' interpreter going. <> 3D Graphics