! OrbWin: ! ! a finite-element grid-creator and -editor for 2-D meshes on the surface of a ! spherical planet. This editor is especially designed to work with 3 F-E programs: ! ! *Shells (neotectonic DYNAMICS from physics, rheologies, fault traces & dips, ! and [some] velocity boundary conditions); ! *NeoKinema (neotectonic KINEMATICS from fault traces, geologic offset rates, ! GPS interseismic velocities, azimuths of principal stresses, ! and [some] velocity boundary conditions); ! *Restore (paleotectonic KINEMATICS through time from fault histories, ! paleomagnetic inclination & declination anomalies, paleostress directions, ! restored lengths of cross-sections, and [some] velocity boundary conditions). ! ! For best results, follow any editing change in OrbWin with a (re-)run of OrbNumber, ! and then plot the F-E grid (and any nodal data?) with either ! FiniteMap (for Shells) or NeoKineMap (for NeoKinema) or RetroMap (for Restore). ! ! All of these programs are currently maintained by: ! Peter Bird (Professor Emeritus) ! Department of Earth, Planetary, and Space Sciences ! University of California, Los Angeles, CA 90095-1567 ! E-mail: pbird@epss.ucla.edu ! Web site: http://peterbird.name ! ! This version 1.3 of OrbWin is from February 2019, whose latest feature is support ! for OPTIONAL Lithospheric Rheology index integers (LR#s) for different elements, ! which can be passed through OrbNumber and OrbData (or OrbData5) to be finally ! read and used by Shells_v5.0+ and by FiniteMap. ! This version was compiled with Intel Visual Fortran ! (Parallel Studio XE 2013 with Microsoft Visual Studio 2010) for use on Windows 8+. ! Both 32-bit and 64-bit versions are provided. There is multithreading, but no parallel. ! !************************************************************************************** ! Source Files (which must be identified in Solution Explorer before compiling): ! OrbWin.f90: Create a message loop to wait for events. ! Menu.f90: Customized menu items and callback routines. ! CallBacks.f90: Contains major callback routines for menu items. ! OrbLib.f90: Subroutines rewritten from Orbweave.bas, ORB2.bas, ORB3.bas. ! Global.f90: Global variables floating across subroutines. ! Comdlger.f90: Subroutines to detect errors when common dialog is created. ! ErrorMsg.f90: Error-message subroutines. ! Icosahedron.f90: Icosahedron F-E module supplied by Peter Bird at UCLA. ! LoadBase.f90: Subroutine for creating dialog box to load basemap file. ! LoadGrid.f90: Subroutines for creating dialog box to load grid file. ! OutputGrid.f90: Subroutines for writing grid to specified filename. ! PlanetaryGrid.f90: Subroutine for creation of a uniform global F-E grid. ! ReadGrid.f90: Subroutines for reading an existing F-E grid from file. ! SaveGrid.f90: Subroutines for creating dialog box to save edited F-E grid. ! ThreadDlg1.f90: Subroutine for (multithreaded) perimeter/area tests. !************************************************************************************** ! Resource files (which must also be identified in Solution Explorer): ! resource.h ! resource.fd ! resource.rc ! icon1.ico !(all created by Digital Visual Fortran, and only slightly modified for OrbWin 1.2). !************************************************************************************** ! IMPORTANT NOTES on compiling this code: ! *The "project" or "solution" type chosen at the creation of the project *MUST* ! be "QuickWin" (not "Windowing Application/SDI", or ".../MDI"). QuickWin programs ! have a structure different from full-fledged "Win API" applications, and also ! use special simplified function calls from special libraries. ! *SUBROUTINE Divide in MODULE Icosahedron calls itself recursively; therefore, ! be sure that the compiler switch is set to permit recursive routines! !************************************************************************************** PROGRAM OrbWin USE DFWin ! MODULE of INTERFACEs for the Digital Fortran for Windows (still present in Intel Fortran, and necessary). USE DFLib ! MODULE of INTERFACEs for the Digital Fortran Library (still present in Intel Fortran, and necessary). USE Global ! my MODULE of COMMON-like variables (& utility procedures). IMPLICIT NONE !variables of native types: INTEGER(4) :: iRet, iSt, iUnit, & & jBottom, jHeight, jLeft, jRight, jTop, jWidth LOGICAL(4) :: bRet CHARACTER(1) :: key !variables of TYPEs defined in libraries: TYPE(windowconfig) :: wc TYPE(qwinfo) :: qw EXTERNAL ShowXY INTERFACE INTEGER(4) FUNCTION FrameWndProc(hWnd, Msg, wParam, lParam) !DEC$ ATTRIBUTES STDCALL :: FrameWndProc !Note [2016.01]: Based on a "conversion" document for CVF --> IF, I tried using "STDCALL,REFERENCE", but this caused a crash. INTEGER:: hWnd, Msg, wParam, lParam END FUNCTION END INTERFACE !NOTE that lots of QuickWin start-up code preceeds what we will be doing here: ! *Automatic start-up code calls my function INITIALSETTINGS() {located in my file Menu.f90} and this ! defines the command menu lists for the top-level "frame" window. (No other window will have a menu.) ! *The top-level frame window is created as an "overlapping window" with title, minimize/maximize/close buttons, ! a menu bar at the top, and a status bar at the bottom. (This status bar is a child window.) ! *The top-level frame window is painted (displayed). ! *A large black child window (under the MDI standard) is created, with minimize/maximize/close buttons, and made active. ! (However, one comment in documentation suggests that this window may not have "focus" (e.g., for text-mode I/O) yet. ! The following invocation of function SetWindowConfig adjusts properties of the "active window". ! (Apparently, QuickWin start-up code has already established a child window within the MDI portion of the frame window.) ! Set the child window properties to defaults and highest-resolution graphics mode, which is ! the same size as full-screen. (Thus, scroll bars will appear because the visible graphics window is a bit smaller.) wc%numxpixels = -1 wc%numypixels = -1 wc%numtextcols = -1 wc%numtextrows = -1 wc%numcolors = -1 wc%fontsize = -1 wc%title ='Working Window'C ! Note: Final "C" indicates a C-style text string, used for passing arguments to C-language functions in Windows libraries. bRet = SetWindowConfig(wc) ! .TRUE. indicates success iUnit = GETACTIVEQQ() ! get the Fortran I/O unit# for this active child window; result is 0 each time; OK. WRITE (iUnit, "('Testing ...')") ! Note that this puts the text into the large black child window, as expected. ! This indicates that the child window is both "active" and "has focus". hGraphics = GetHWndQQ(iUnit) ! Get handle to child graphics window; -1 for failure; large integer for success. ! Note that hGraphics is defined, and resides, in my MODULE Global. ! {I don't think it is currently ever used, but it could be handy in future.} !enter new title for the frame window hFrame = GetHwndQQ(QWIN$FRAMEWINDOW) ! get handle to frame window; -1 for failure; large integer for success ! Note that hFrame is defined in (and resides in) my MODULE Global. iRet = SetWindowText(hFrame, "OrbWin"C) ! 0 for failure; any non-zero result indicates success !maximize the size of this frame window (to full-screen; this is IMPORTANT, to allow enough width for the status-bar created later) qw%type = QWIN$MAX iRet = SETWSIZEQQ(QWIN$FRAMEWINDOW, qw) ! 0 if successful; anything else = failure !maximize child window (to fill all available space in the frame window): iRet = GETWSIZEQQ(iUnit, QWIN$SIZECURR, qw) ! get contents TYPE(qwinfo):: qw structure for current child window; returns 0 if successful. qw%type = QWIN$MAX ! request maximization iRet = SETWSIZEQQ(iUnit, qw) ! 0 if successful; anything else = failure !initialize all 6 drawing colors (variables reside in my MODULE Global): DO DrawType = 1, 6 redValue = RGB_int_of_IDC_LIST_line(1, DrawType) greenValue = RGB_int_of_IDC_LIST_line(2, DrawType) blueValue = RGB_int_of_IDC_LIST_line(3, DrawType) RedByte = CHAR(redValue) ! converting from 4 bytes to 1 byte GreenByte = CHAR(greenValue) ! to prepare for use of "rgb macro" BlueByte = CHAR(blueValue) !NOTE: In Global.f90, EQUIVALENCE (RebByte, RedInt1), ... ! This kludge was used because "RedInt1 = redValue" doesn't work; ! it leads to integer overflow because INTEGER*1 uses one bit for sign, ! and thus has a range from -128 to +128 instead of from 0 to 255. IF (DrawType == 1) ifrontcolor = rgb(RedInt1,GreenInt1,BlueInt1) IF (DrawType == 2) ibasecolor = rgb(RedInt1,GreenInt1,BlueInt1) IF (DrawType == 3) inodecolor = rgb(RedInt1,GreenInt1,BlueInt1) IF (DrawType == 4) ielecolor = rgb(RedInt1,GreenInt1,BlueInt1) IF (DrawType == 5) ifaultcolor = rgb(RedInt1,GreenInt1,BlueInt1) IF (DrawType == 6) ibackcolor = rgb(RedInt1,GreenInt1,BlueInt1) END DO; DrawType = 0 ! returning to "uninitialized" value, meaning no list item selected iRet = SETCOLORRGB(ifrontcolor) iRet = SETBKCOLORRGB(ibackcolor) !kill default QuickWin status bar hFrame = GETHWNDQQ(QWIN$FRAMEWINDOW) ! -1 for failure; large integer for success; result hFrame lives in Global. hMDI = FindWindowEx(hFrame, NULL, LOC('MDIClient'C), NULL) ! -1 for failure; large integer for success; result hMDI lives in Global. hStatus = GetWindow(hMDI, GW_HWNDNEXT) ! handle to the Status sub-window of the MDI window; hStatus lives in Global. iSt = SendMessage(hStatus, WM_CLOSE, 0, 0) ! for message WM_CLOSE {specifically!} a return of 0 indicates success. !In order to have a chance to redefine the code that creates the status bar, ! subclass the Frame window's FrameWndProc. lpfnOldFrameProc is the LOC (or handle) ! of the default ("old") Frame Window Procedure, and it lives in Global. lpfnOldFrameProc = SetWindowLongPtr(hFrame, GWL_WNDPROC, LOC(FrameWndProc)) !NOTE: For better compatibility with x64, replaced SetWindowLong with SetWindowPtr ! !create new statusbar in the frame window. {See replacement FUNCTION FrameWndProc below for details.} ist = SendMessage(hFrame, WM_CREATESTATUS, 0, 0) CALL CLEARSCREEN($GCLEARSCREEN) CALL DecisionPtDlg !after this, AppType is set CALL Initialization ! Initialization achieves 3 purposes: ! 1. Specify the array sizes to hold: nodes, elements, and faults (either to be read-in, or to be created); wild overestimation is OK! ! (If no # is specified -> Disable all Editing submenus.) ! 2. Set windowheight and projection/scaler matrix to default values. ! 3. Initialize values of global switches. ! Initialize mu range (to apply if a new grid is created, instead of reading one in): lowest_mu = 0.0D-16 highest_mu = 1.0D-14 !draw a circle to represent the blank surface of the planet CALL DrawGrid !get current focus window and work on it iUnit = GetActiveQQ() iRet = REGISTERMOUSEEVENT (iUnit, MOUSE$MOVE, ShowXY) DO WHILE (.TRUE.) ! i.e., "forever" ... !wait forever to allow event-driven action. key = GETCHARQQ() SELECT CASE(ichar(key)) CASE(1) ! ctrl-A: adjust node CALL AdjustNode CASE(2) ! ctrl-B: loadbase CALL LoadBase CASE(4) ! ctrl-D: drawgrid CALL DrawGrid CASE(5) ! ctrl-E: add/delete element CALL AddDeleteElement CASE(6) ! ctrl-F: cuthealfault CALL CutHealFault CASE(7) ! ctrl-G: loadGrid CALL LoadGrid CASE(8) ! ctrl-H: Fault Heading CALL Fheading CASE(9) ! ctrl-I: Fault inclination CALL FInclination CASE(11) ! ctrl-K: setColor CALL SetKolor CASE(13) ! ctrl-M: Draw Ele/Q/Crust/Mantle CALL eqcmDraw CASE(14) ! ctrl-N: add/delete node CALL AddDropNode CASE(15) ! ctrl-O: 2nd origin CALL Set2ndOrigin CASE(18) ! ctrl-R: Redraw CALL Redraw CASE(22) ! ctrl-V: savegrid, Note: ctrl-S does not work out!!! CALL SaveGrid CASE(24) ! ctrl-X: userexit CALL UserExit CASE(26) !ctrl-Z: zoominout CALL ZoomInOut END SELECT END DO END PROGRAM OrbWin !================================================================== !Subclassed procedure of Frame client window INTEGER FUNCTION FrameWndProc(hWnd, Msg_int, wParam, lParam) !DEC$ ATTRIBUTES STDCALL :: FrameWndProc !Note [2016.01]: Based on a "conversion" document for CVF --> IF, I tried using "STDCALL,REFERENCE", but this caused a crash. USE DFWin USE COMCTL32 USE Global IMPLICIT NONE INTEGER(handle), INTENT(IN) :: hWnd, wParam, lParam ! Note that "handle" = 4 on IA-32 platform, but = 8 on x64 platform. INTEGER(4), INTENT(IN) :: Msg_int INTEGER(4) :: ID, isbHeight, iSt, iState, jWidth INTEGER(4), DIMENSION(0:3) :: iSBFieldPos ! distances of right edges of status bar parts from window edge, in pixels TYPE(T_rect) :: mdirect, sbrect SELECT CASE(Msg_int) CASE (WM_CREATETOOLBAR) !request for toolbar creation, which means toolbar can be added if you want !CALL CreateMyToolbar FrameWndProc = 0 ! report success (whether true or not!) !Note that Debug test will require FrameWndProc to be defined in all CASEs, even if no action occurs. CASE (WM_CREATESTATUS) !process message for creating statusbar hStatus = CreateStatusWindow(WS_CHILD, ''C, hFrame, 0) iSt = GetWindowRect(hstatus, sbrect) ! get statusbar rectangle infor. iSt = GetClientRect(hMDI, mdirect) ! get client area info. (top, left, right. bottom) jWidth = mdirect%Right iSBFieldPos(3) = jWidth - 20 ! for graceful graphics, leave a little space after last part iSBFieldPos(2) = jWidth - 320 ! boundary between Lat/Lon on the left, and NearestNode on the right. iSBFieldPos(1) = jWidth - 620 ! boundary between long hints on the left, and LatLon on the right. iSBFieldPos(0) = 100 iSt = SendMessage(hStatus, SB_SETPARTS, 4, LOC(iSBFieldPos)) iSt = ShowWindow(hStatus, SW_SHOW) CALL SetStatusBar(0, 'Ready'C) !move statusbar to seal the gap between default statusbar size and diff_size of frame and client area isbHeight = mdirect%bottom ! y-location of the top of statusbar relative to MDI iSt = MoveWindow(hStatus, 0, isbHeight, sbRect%Right, sbRect%Bottom - sbRect%top, .TRUE.) FrameWndProc = 0 ! report success (whether true or not!) CASE DEFAULT !send all other messages to normal processing FrameWndProc = CallWindowProc(lpfnOldFrameProc, hWnd, Msg_int, wParam, lParam) END SELECT END FUNCTION FrameWndProc