DECLARE SUB MouseClick (row%, col%, lButton%, rButton%)
DECLARE SUB MouseHide ()
DECLARE SUB MouseInit ()
DECLARE SUB MousePut (row%, col%)
DECLARE SUB MouseShow ()
DECLARE SUB MouseXYB (row%, col%, lButton%, rButton%)
'                      OrbWeave.BAS
'
' (composed of module ORBWEAVE.BAS plus modules ORB2.BAS and ORB3.BAS,
'  plus mouse utility module MYMOUSE.BAS, plus INCLUDE files
'              MYMOUSE.BI and GENERAL.BI)
' These files contains source code to be compiled with
' Microsoft's BASIC Professional Development System, version 7.1, to
' create an interactive editor of 2-D finite element grids composed of
' 3-node spherical triangles and 4-node great-circle
' fault elements.  The grids lie on a sphere.
' (Such grids are used by the finite element program Shells by
' Xianghong Kong and Peter Bird, and in programs Restore
' and NeoKinema, by Peter Bird.)
'
' The compiled program requires:
'    * a Microsoft-compatible serial mouse,
'    * mouse driver software loaded in memory, and
'    * a graphics card and monitor.
' For speed, it is VERY desirable that the PC:
'     * be equipped with a math coprocessor or '486 or Pentium chip,
'     * run at 20 MHz or higher,
'     * has a hard disk, and
'     * that the graphics card should have enough memory to hold two pages of
'       graphics in some mode (EGA, VGA, or CGA).  Otherwise, the menu screen
'       and window will have to be recreated every time you switch between them.
' Color EGA or VGA is nice, as you can see highlighted nodes/elements/faults.
' If a basemap is desired (for location reference, surface geology,
' fault traces, latitude/longitude grids, etc.) then it may be
' digitized using program DIGITISE, by the same author.
'
' To interpret and/or compile this program successfully with
' Microsoft BASIC 7.1, you need to start the work environment with
' the following command line:
' C:\BC7\BIN\QBX.EXE /AH /Ea /L CHRTBEFR.QLB
' and you need to have file CHRTBEFR.QLB available in C:\BC7\LIB.
'
' Written by Peter Bird, Department of Earth and Space Sciences,
' University of California, Los Angeles, CA 90024.
' Version 1.G, November, 2001.
' (c) Copyright 1993, 1994, 1995, 1996, 1998, 1999, 2001 by
'     Peter Bird and the
'     Regents of the University of California.
'----------------------------------------------------------------------
'All mouse subprograms are modified from MicroSoft BASIC Prof. Dev. System:
REM $INCLUDE: 'GENERAL.BI'
REM $INCLUDE: 'MYMOUSE.BI'
'----------------------------------------------------------------------
'The following occur at the end of this module:
DECLARE SUB FirstScreen (Ins, BestMode%, Blue%, Foreground%, Green%, HotColor%, lines%, PixelRatio!, Red%, White%, Yellow%, Outs, PageNow%)
'The following subprograms are included in 2nd module DRAW2.BAS:
DECLARE FUNCTION ATAN2D# (Y#, X#)
DECLARE FUNCTION ATAN2F! (Y!, X!)
DECLARE FUNCTION GETBIT% (Number%, Place%)
DECLARE FUNCTION Inside% (TempVec!(), NPlanes%, Normals!())
DECLARE FUNCTION Principal! (angle!)
DECLARE SUB ABG2LonLat (Ins, TempVec!(), Outs, Lon!, Lat!)
DECLARE SUB ABG2XY (Ins, TempVec!(), Outs, Visible%, X!, Y!)
DECLARE SUB AddNode (Ins, MXNODE%, NFL%, NUMEL%, TempVec!(), Mods, EQCM!(), NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, N1000%, NodeABG!(), Outs, n%)
DECLARE SUB Blanker (R1%, R2%, C1%, C2%)
DECLARE SUB CIRCUIT (Ins, MXBN%, NFL%, NUMEL%, Mods, EQCM!(), NFAKEN%, NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, NodeABG!(), Outs, FAILED%, NCOND%, NODCON%(), Work, FMemo%(), EMemo%())
DECLARE SUB CloseOut (Ins, GridLoaded%, Remind%)
DECLARE SUB Cross (Ins, V1!(), V2!(), Outs, VCross!())
DECLARE SUB Delay18th (n%)
DECLARE SUB DrawBase (UseColor%, ColOldBase%, RowOldBase%, LastEnd%)
DECLARE SUB DrawElement (BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), i%, IData%, Logs%, Mus!(), NODES%(), Redo%, UseColor%, NodeABG!())
DECLARE SUB DrawFault (FDIP!(), i%, NODEF%(), UseColor%, NodeABG!())
DECLARE SUB DrawNode (n%, UseColor%, NodeABG!())
DECLARE SUB DropNode (Ins, AKA%, n%, NFL%, NUMEL%, Mods, EQCM!(), NFAKEN%, NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, NodeABG!())
DECLARE SUB Exists (Ins, n1%, NUMNOD%, X!, Y!, NodeABG!(), Tolerance!, Outs, n%)
DECLARE SUB FindFault (Ins, X!, Y!, NFL%, NODEF%(), NodeABG!(), Tolerance!, Outs, ie%)
DECLARE SUB Finish (FileNum%) 'read past any junk at the end of a record
DECLARE SUB Flipped (Ins, i%, NODES%(), NodeABG!(), Outs, EMemo%())
DECLARE SUB GetBase (Ins, CD$, Outs, BinaryN$, NeedMenu%, NeedToDraw%, UsingBase%)
DECLARE SUB GetCD (Outs, CD$)
DECLARE SUB GetNewCD (Mods, CD$, NSlice%)
DECLARE SUB GetElement (Ins, NodeABG!(), NODES%(), NUMEL%, X!, Y!, Outs, j%, R2MIN!)
DECLARE SUB GetFileName (Text$, LineN%, NewName$)
DECLARE SUB GetNet (Ins, GridFileN$, MXNODE%, MXEL%, MXFEL%, Outs, TITLE$, NUMNOD%, NREALN%, NFAKEN%, N1000%, NodeABG!(), EQCM!(), NMemo%(), NUMEL%, NODES%(), Mus!(), EMemo%(), NFL%, NODEF%(), FMemo%(), FDIP!(), OFFSET!(), FAILED%, TempVec!())
DECLARE SUB Icosahedron (Ins, NSlice%)
DECLARE SUB KolorMenu (Ins, Blue%, Brown%, Green%, Red%, White%, Yellow%, Mods, BaseC%, CircleC%, DoIcon%, ElementC%, FaultC1%, FaultC2%, NodeC1%, NodeC2%)
DECLARE SUB ModeParms (Ins, BestMode%, Outs, Background%, Blue%, Brown%, Foreground%, Green%, HotColor%, lines%, Red%, White%, Yellow%)
DECLARE SUB Nearest (Ins, NodeABG!(), NUMNOD%, X!, Y!, Outs, NumNear%, NearOnes%())
DECLARE SUB NEXTto (Ins, i%, j%, NFL%, NODEF%(), NODES%(), NUMEL%, Outs, KFAULT%, jf%, KELE%, je%)
DECLARE SUB OnAnyE (Ins!, n%, n1%, NLast%, NODES%(), Outs!, ie%, je%)
DECLARE SUB OnAnyF (Ins!, n%, n1%, NLast%, NODEF%(), Outs!, ie%, je%)
DECLARE SUB Pixels (Ins, X!, Y!, Outs, col%, row%)
DECLARE SUB PutNet (GridFileN$, TITLE$, NUMNOD%, NREALN%, NFAKEN%, N1000%, NodeABG!(), EQCM!(), NUMEL%, NODES%(), Mus!(), NFL%, NODEF%(), FDIP!(), OFFSET!())
DECLARE SUB RunMenu (Ins, Background%, BestMode%, CD$, CommandKey$, CW1%, CW2%, Foreground%, HCol%(), HotCol%, HotColor%, HotLine%, HRow%, lines%, Mask%(), MXEL%, MXFEL%, MXNODE%, NFL%, NUMEL%, NUMNOD%, Places%(), RAM&, RW1%, RW2%, Trial$, Outs,  _
Current$)
DECLARE SUB Scaler ()
DECLARE SUB SecondScreen (Ins, BestMode%, Foreground%, HotColor%, Outs, PageNow%)
DECLARE SUB SetBins (Ins, Ask%, Contour%, EQCM!(), IData%, NUMEL%, NUMNOD%, Mus!(), Mods, OldBotF!, OldIData%, OldTopF!, Outs, BotF!, DFC!, Logs%, NeedToDraw%, TopF!)
DECLARE SUB SetMenu (Ins, Background%, BestMode%, Current$, Foreground%, HCol%(), HotCol%, HotLine%, HighPage%, lines%, Mask%(), Mods, NeedMenu%, Outs, HRow%, PageNow%, Places%(), Trial$)
DECLARE SUB Sterradians (Ins, V1!(), V2!(), V3!(), Outs, SolidAngle!)
DECLARE SUB TwoToOne (Ins, From2nd11!, From2nd12!, From2ndX!, From2ndY!, Mods, X!, Y!)
DECLARE SUB UnitVec (Mods, TempVec!())
DECLARE SUB WaitForKey (a$)
DECLARE SUB WinFrame (Ins, WinLat!, WinLon!, Outs, WinRight!(), WinOut!(), WinUp!())
DECLARE SUB XandY (Ins, col%, row%, Outs, X!, Y!)
DECLARE SUB XORLine (X1%, Y1%, X2%, Y2%)
DECLARE SUB XY2ABG (Ins, X!, Y!, Outs, Outside%, TempVec!())
DECLARE SUB XY2LonLat (Ins, Which%, X!, Y!, Outs, Outside%, Lon!, Lat!)
'----------------------------------------------------------------------
'arrays of constant size:
OPTION BASE 1
DIM WinOut!(3), WinRight!(3), WinUp!(3)
DIM Cart2!(3, 3)  '2nd Cartesian coordinate system expressed in 1st.
DIM TempVec!(3), TempV2!(3), TempV3!(3), TempV4!(3), TempV5!(3)
DIM Normals!(3, 20) 'normals to great circle arcs in Tile
DIM VertCol%(0 TO 20), VertRow%(0 TO 20)'remember polygons, to un-draw them
DIM EOn%(36), FOn%(36), JOn%(36), NOn%(36)
DIM DIPS!(2)
DIM FIPoint!(4)
DIM Modes%(1 TO 12)
DIM LastPage%(1 TO 12)
DIM Icon1%(30), Icon2%(30) 'triangle or X symbol for element centers
DIM Places%(26, 2) 'Col and line numbers for each letter
DIM HCol%(2)
DIM Scales!(2, 2) 'matrix which converts (x,y) to (col,row)
DIM UnScale!(2, 2)'matrix which converts (col,row) to (x,y)
DIM Mask%(1200)  'storage for the highlight mask, 29 characters x 1 line
DIM NearOnes%(4)    'nearest nodes to mouse
DIM TITLE AS STRING * 80
'---------------------------------------------------------------------
'Following COMMON gets parameters and constant-length arrays
'(but not dynamic, variable-length arrays) to the subprograms
'DrawNode, DrawElement, DrawFault in the fastest way, without
'having to put them on the stack and take them off in every call:
COMMON SHARED Cart2!(), Colored%, CursorOn%, DoIcon%, FEP%, FIPoint!(), HiColor%, HiCol%, HiRow%, Icon1%(), Icon2%(), LastPutC%, LastPutR%, R2C!, Scales!(), UnScale!(), WindowHeight!, WinOut!(), WinRight!(), WinUp!()
'---------------------------------------------------------------------
'FALSE% = 0             'Note: These are commented out because they
'TRUE% = NOT FALSE%     'already appear in an $INCLUDEd file above.
'----------------------------------------------------------------------
'Code to find highest-resolution video mode available
'   by trial-and (trapped) error; a mode with two graphics
'   pages is preferred to one with better color or resolution, for speed.
ON ERROR GOTO ErrorHandler
GOTO Beginning:
ErrorHandler:
RESUME TryAgain
Beginning:
Modes%(1) = 12      'VGA + 16 colors           1st choice
Modes%(2) = 9       'EGA + 16 colors                |
Modes%(3) = 11      'VGA + monochrome          3rd choice
Modes%(4) = 10      'EGA + monochrome               |
Modes%(5) = 3       'Hercules                       V
Modes%(6) = 2       'CGA (used as monochrome)  Last choice
FOR i% = 7 TO 12
	Modes%(i%) = Modes%(i% - 6)
NEXT i%
FOR i% = 1 TO 6
	LastPage%(i%) = 1   'HAVING TWO PAGES TAKES PRECEDENCE OVER RESOLUTION!
NEXT i%
FOR i% = 7 TO 12
	LastPage%(i%) = 0
NEXT i%
ModeNum% = 0
TryAgain:
ModeNum% = ModeNum% + 1
BestMode% = Modes%(ModeNum%)
HighPage% = LastPage%(ModeNum%)
SCREEN BestMode%, , HighPage%, HighPage%
'statement above causes error until correct mode is found
'--------------------------------------------------------
ON ERROR GOTO AnyError      'turn off special handler; use generic one.
PageNow% = HighPage%
CALL ModeParms(Ins, BestMode%, Outs, Background%, Blue%, Brown%, Foreground%, Green%, HotColor%, lines%, Red%, White%, Yellow%)
PixelRatio! = (4! / 3!) * (HiRow% + 1!) / (HiCol% + 1!)
LastPutC% = HiCol% - 6
LastPutR% = HiRow% - 6
GOTO LogicalStart
'=========================================================================
AnyError:  'generic error handler; most versatile one.
BEEP
CALL Delay18th(24)
SCREEN BestMode%, , HighPage%, HighPage%
CLS
NeedMenu% = TRUE%
LOCATE 2, 30
PRINT "ERROR INTERRUPT";
'
LOCATE 6, 10
PRINT "Logical error with code number of "; ERR
LOCATE 7, 14
IF ERR = 9 THEN
	PRINT "( Subscript out of range: Due to bug in code! )"
	LOCATE 8, 10
	PRINT "I suggest that you save grid immediately, under a new filename."
ELSEIF ERR = 5 THEN
	PRINT "( Illegal function call )"
ELSEIF ERR = 6 THEN
	PRINT "( Overflow: integer over 32767 or real over 3.4E+38)"
ELSEIF ERR = 7 THEN
	PRINT "( Out of memory: Increase Reserve& and recompile. )"
ELSEIF ERR = 11 THEN
	PRINT "( Division by zero )"
ELSEIF ERR = 52 OR ERR = 64 THEN
	PRINT "( Bad file name )"
ELSEIF ERR = 53 THEN
	PRINT "( File not found )"
ELSEIF ERR = 55 THEN
	PRINT "( File already open )"
ELSEIF ERR = 61 THEN
	PRINT "( Disk full )"
ELSEIF ERR = 62 THEN
	PRINT "( Attempt to Input past end of file )";
	LOCATE 8, 16
	PRINT "Possible cause: reading SHELLS-format .FEG file in RESTORE3 mode.";
ELSEIF ERR = 70 THEN
	PRINT "( Permission to access file denied )"
ELSEIF ERR = 71 OR ERR = 72 THEN
	PRINT "( Disk not ready or physically defective )"
ELSEIF ERR = 76 THEN
	PRINT "( Path not found )"
ELSE
	PRINT "( consult the appendix of any QuickBASIC manual )";
END IF
'
ErrorCode% = ERDEV AND &HF
a$ = ERDEV$
IF a$ = "" THEN a$ = "[null]"
LOCATE 10, 10
PRINT "OR, device "; a$; " reports device Error Number of "; ErrorCode%;
'
LOCATE 20, 5
PRINT "YOUR OPTIONS ARE:"
LOCATE 22, 5
PRINT "1) Press the spacebar to return to the program, at statement after error.";
LOCATE 23, 5
PRINT "2) Press Enter to abort the current command and return to the menu.";
LOCATE 24, 5
PRINT "3) Press ESCape to abort and return to DOS.";
CALL WaitForKey(a$)
IF ASC(a$) = 27 THEN
	SYSTEM
ELSEIF ASC(a$) = 13 THEN
	SCREEN BestMode%, , PageNow%, PageNow%
	RESUME AfterError
ELSEIF ASC(a$) = 32 THEN
	SCREEN BestMode%, , PageNow%, PageNow%
	RESUME NEXT
ELSE
	GOTO AnyError
END IF
'=========================================================================
LogicalStart:
'
'initialize mouse
MouseInit
'initialize logical flags
NeedMenu% = TRUE%
NeedToDraw% = TRUE%
ColorIn% = FALSE%
Contour% = FALSE%
Remind% = FALSE%
NewTopology% = FALSE%
ChangesInRAM% = FALSE%
CursorOn% = FALSE%
'initialize grid
NUMNOD% = 0: NREALN% = 0: NFAKEN% = 0: N1000% = 30000
NUMEL% = 0: NFL% = 0
TITLE = "TITLE?"
' initialize window
WindowHeight! = 2.02
CALL Scaler
Tolerance! = WindowHeight! * 6! / CSNG(HiRow%)
WinLat! = 0!
WinLon! = 0!
CALL WinFrame(Ins, WinLat!, WinLon!, Outs, WinRight!(), WinOut!(), WinUp!())
'initialize second coordinate system (none)
Using2nd% = FALSE%
'initialize subdivision of icosahedron (none)
NSlice% = -99
'initialize default colors
CircleC% = Blue%
BaseC% = White%
NodeC1% = Blue%
NodeC2% = Red%
ElementC% = Green%
FaultC1% = Red%
FaultC2% = Yellow%
DoIcon% = TRUE%
'create highlight mask
CLS
col% = (HiCol% + 1) * 29! / 80! - 1
row% = (HiRow% + 1) / lines% - 1
IF Colored% THEN
	LINE (0, 0)-(col%, row%), White%, BF
ELSE
	LINE (0, 0)-(col%, row%), , BF
END IF
GET (0, 0)-(col%, row%), Mask%
'create triangle icon
CLS
IF Colored% THEN COLOR Green%
LINE (0, 0)-(0, 6)
LINE (0, 6)-(6, 6)
LINE (6, 6)-(0, 0)
GET (0, 0)-(6, 6), Icon1%
'create X icon
CLS
IF Colored% THEN COLOR HotColor%
LINE (0, 0)-(6, 6)
LINE (0, 6)-(6, 0)
GET (0, 0)-(6, 6), Icon2%
'points for plotting fault dips
FIPoint!(1) = .125
FIPoint!(2) = .375
FIPoint!(3) = .625
FIPoint!(4) = .875
'initialize data editing
IData% = 1
IMus% = 1
'-------------------------------------------
'introductory screens
CALL FirstScreen(Ins, BestMode%, Blue%, Foreground%, Green%, HotColor%, lines%, PixelRatio!, Red%, White%, Yellow%, Outs, PageNow%)
CALL SecondScreen(Ins, BestMode%, Foreground%, HotColor%, Outs, PageNow%)
'-------------------------------------------
' initialize menu
Current$ = "D"
HotCol% = 1
HotLine% = 3
CW1% = (HiCol% + 1) / 80!           'corners of dialog box, for blanking
CW2% = (HiCol% + 1) * 79! / 80! - 1 'purposes
RW1% = (HiRow% + 1) * 15! / lines%
RW2% = (HiRow% + 1) * 24! / lines% - 1
'fault dips
Shallow! = 25!
Steep! = 65!
'----------------------------------------------------------------
'Determine default disk and current directory.
'
SCREEN BestMode%, , HighPage%, HighPage%
PageNow% = HighPage%
IF Colored% THEN COLOR Foreground%
CALL GetCD(Outs, CD$)
'---------------------------------------------------------------
'determine limits on array sizes:
'Note 1: This must be done AFTER the SHELL command, not before.
'Note 2: This calculation assumes an OPTION BASE 1 statement is above.
Reserve& = 38 * 1024&        ' Reserve some memory for use by PAINT and
RAM& = FRE(-1) - Reserve&    ' for rounding-up of array lengths to segments.
IF (FEP% = 3) THEN
	MXEL% = RAM& / 40            ' First estimate, w/o considering boundary.
ELSE
	MXEL% = RAM& / 32
END IF
MXNODE% = CINT(.66667 * CSNG(MXEL%))   '   "     "
MXBN% = 8 * SQR(CSNG(MXNODE%))  '(4 for a square; 8 for extra tortuosity)
GRAM& = RAM& - 2 * MXBN%     ' Correct RAM for boundary array(s)
IF (FEP% = 3) THEN
	MXEL% = GRAM& / 40           ' Corrected limits: maximum elements
	MXFEL% = 0                                     ' maximum faults
ELSEIF (FEP% = 2) THEN
	MXEL% = GRAM& / 32
	MXFEL% = 0
ELSE '1
	MXEL% = GRAM& / 32
	MXFEL% = MXEL% / 6
END IF
MXNODE% = CINT(.66667 * CSNG(MXEL%))           ' maximum nodes
'------------------------------------------------------------------------
'large arrays, all placed in far heap:
REM $DYNAMIC
DIM EQCM!(4, MXNODE%), NMemo%(MXNODE%), NodeABG!(3, MXNODE%)
DIM NODCON%(MXBN%)
DIM NODES%(3, MXEL%), EMemo%(MXEL%)
IF (FEP% = 3) THEN
	DIM Mus!(3, MXEL%)
ELSEIF (FEP% = 1) THEN
	DIM FDIP!(2, MXFEL%), FMemo%(MXFEL%), NODEF%(4, MXFEL%), OFFSET!(MXFEL%)
END IF
'=======================================================================
AfterError:
CommandLoop:
IF NeedMenu% THEN CALL SetMenu(Ins, Background%, BestMode%, Current$, Foreground%, HCol%(), HotCol%, HotLine%, HighPage%, lines%, Mask%(), Mods, NeedMenu%, Outs, HRow%, PageNow%, Places%(), Trial$)
CALL RunMenu(Ins, Background%, BestMode%, CD$, CommandKey$, CW1%, CW2%, Foreground%, HCol%(), HotCol%, HotColor%, HotLine%, HRow%, lines%, Mask%(), MXEL%, MXFEL%, MXNODE%, NFL%, NUMEL%, NUMNOD%, Places%(), RAM&, RW1%, RW2%, Trial$, Outs, Current$)
'-----------------------------------------------------------------------
'Carry Out The Commands!
IF Current$ = "D" THEN    'Directory (path)
	CALL GetNewCD(Mods, CD$, NSlice%)
ELSEIF Current$ = "B" THEN       'Basemap file
	CALL GetBase(Ins, CD$, Outs, BinaryN$, NeedMenu%, NeedToDraw%, UsingBase%)
	IF NeedToDraw% THEN
		GOSUB ToPage0
		GOSUB RunPage0
	END IF
ELSEIF Current$ = "C" THEN       'Clear grid file
	IF GridLoaded% THEN
		IF ChangesInRAM% THEN
			IF Colored% THEN COLOR HotColor%
			LOCATE 24, 5
			PRINT "*** EDITING WORK WILL BE LOST IN __ SECONDS, UNLESS A KEY IS PRESSED! ***";
			FOR i% = 10 TO 1 STEP -1
				PLAY "MBL64O5C"
				LOCATE 24, 38: PRINT ; USING "##"; i%;
				FOR j% = 1 TO 7
					CALL Delay18th(2)
					IF j% MOD 2 = 0 THEN
						LOCATE 24, 5: PRINT "   "; : LOCATE 24, 75: PRINT "   ";
					ELSE
						LOCATE 24, 5: PRINT "***"; : LOCATE 24, 75: PRINT "***";
					END IF
					a$ = INKEY$: IF LEN(a$) > 0 THEN GOTO Collector
				NEXT j%
			NEXT i%
		END IF
		PLAY "MBL32O2AGFEDCO1BL4A"
		IF Colored% THEN COLOR Foreground%
		NeedToDraw% = TRUE%
		GridLoaded% = FALSE%
		ChangesInRAM% = FALSE%
		ColorIn% = FALSE%
		Contour% = FALSE%
		NUMNOD% = 0: NREALN% = 0: NFAKEN% = 0: N1000% = 30000
		NUMEL% = 0: NFL% = 0: TITLE = "TITLE?"
		NewTopology% = FALSE%
	ELSE
		BEEP
		LOCATE 24, 32: PRINT "No grid is loaded.";
		CALL Delay18th(32)
	END IF
ELSEIF Current$ = "L" THEN       'Load grid file
	IF GridLoaded% THEN
		BEEP
	ELSE
GetGridfile:
		FileN$ = CD$ + "\*.FEG"
		IF LEN(DIR$(FileN$)) = 0 THEN
			CALL Blanker(16, 24, 2, 79)
			LOCATE 19, 10
			PRINT "There are no .FEG files in the current directory."
			LOCATE 20, 10
			PRINT "Try changing directories with the Directory command."
			LOCATE 21, 10
			PRINT "Press Enter to continue."
			CALL WaitForKey(a$)
		ELSE
			CALL Blanker(16, 24, 2, 79)
			LOCATE 16, 10: PRINT "The following .FEG files are available in the current directory,";
			LOCATE 17, 3: FILES FileN$
			NeedMenu% = TRUE%    'file listing may scroll the window!
			CALL Blanker(23, 24, 2, 79)
			LOCATE 23, 10
			PRINT "If you do not want any of these grid files, press ESCape now.";
			LOCATE 24, 10
			PRINT "If you do, press Enter to continue ...";
			CALL WaitForKey(a$)
			IF a$ = CHR$(27) THEN
				GridFileN$ = ""
				GridLoaded% = FALSE%
				FOR i% = 16 TO 24  'repair damage to window frame
					LOCATE i%, 1: PRINT CHR$(186);
				NEXT i%
			ELSE
				CALL Blanker(23, 24, 3, 78)
				a$ = "Enter an existing filename (1-8 characters, no extension): "
				CALL GetFileName(a$, 23, NewName$)
				GridFileN$ = CD$ + "\" + NewName$ + ".FEG"
				IF LEN(DIR$(GridFileN$)) = 0 THEN
					BEEP
					GOTO GetGridfile
				ELSE
					CALL GetNet(Ins, GridFileN$, MXNODE%, MXEL%, MXFEL%, Outs, TITLE$, NUMNOD%, NREALN%, NFAKEN%, N1000%, NodeABG!(), EQCM!(), NMemo%(), NUMEL%, NODES%(), Mus!(), EMemo%(), NFL%, NODEF%(), FMemo%(), FDIP!(), OFFSET!(), FAILED%,  _
TempVec!())
					IF FAILED% THEN
						BEEP
						CALL WaitForKey(a$)
						GOTO Collector
					END IF
					GridLoaded% = TRUE%
					NeedToDraw% = TRUE%
					WindowHeight! = 2.02
					CALL ABG2LonLat(Ins, TempVec!(), Outs, WinLon!, WinLat!)
					CALL WinFrame(Ins, WinLat!, WinLon!, Outs, WinRight!(), WinOut!(), WinUp!())
					CALL Scaler
					Tolerance! = WindowHeight! * 6! / CSNG(HiRow%)
					GOSUB ToPage0
					GOSUB RunPage0
				END IF
			END IF
		END IF
	END IF
ELSEIF Current$ = "S" THEN       'Save grid file
	IF GridLoaded% THEN
SaveGridfile:
		FileN$ = CD$ + "\*.FEG"
		IF LEN(DIR$(FileN$)) = 0 THEN
			CALL Blanker(16, 24, 2, 79)
			LOCATE 19, 10
			PRINT "(There are no .FEG files in the current directory.)"
		ELSE
			CALL Blanker(16, 24, 2, 79)
			LOCATE 16, 10: PRINT "The following .FEG files are already in the current directory,";
			LOCATE 17, 3: FILES FileN$
			NeedMenu% = TRUE%  'file listing may scroll the menu!
		END IF
		CALL Blanker(23, 24, 2, 79)
		a$ = "Enter a filename to save under (1-8 characters, no extension): "
		CALL GetFileName(a$, 23, NewName$)
		GridFileN$ = CD$ + "\" + NewName$ + ".FEG"
		CALL PutNet(GridFileN$, TITLE, NUMNOD%, NREALN%, NFAKEN%, N1000%, NodeABG!(), EQCM!(), NUMEL%, NODES%(), Mus!(), NFL%, NODEF%(), FDIP!(), OFFSET!())
		ChangesInRAM% = FALSE%
		IF NewTopology% THEN Remind% = TRUE%
	ELSE
		BEEP
	END IF
ELSEIF Current$ = "X" THEN        'eXit to DOS
	CALL CloseOut(Ins, GridLoaded%, Remind%)
ELSEIF Current$ = "W" THEN        'Window position
GetWinOut:
	WinLatD! = WinLat! * 57.2958
	WinLonD! = WinLon! * 57.2958
	CALL Blanker(18, 24, 2, 79)
	LOCATE 21, 10: PRINT USING "Current latitude of window center = +##.### degrees."; WinLatD!;
	LOCATE 22, 10: PRINT "Press Enter to accept, or enter latitude (N=+,S=-): ";
	CALL WaitForKey(a$)
	IF ASC(a$) = 13 THEN
		'no change in Lat
		ay! = WinLatD!
	ELSE
		LOCATE 22, 62: PRINT a$;
		INPUT ; "", B$
		a$ = a$ + B$
		ay! = VAL(a$)
		IF (ay! > 90!) OR (ay! < -90!) THEN
			BEEP
			CALL Blanker(21, 22, 10, 79)
			GOTO GetWinOut:
		END IF
		IF ay! <> WinLatD! THEN NeedToDraw% = TRUE%
	END IF
	LOCATE 23, 10: PRINT USING "Current longitude of window center = +###.### degrees."; WinLonD!;
	LOCATE 24, 10: PRINT "Press Enter to accept, or enter longitude (E=+,W=-): ";
	CALL WaitForKey(a$)
	IF ASC(a$) = 13 THEN
		'no change in Lon
		ax! = WinLonD!
	ELSE
		LOCATE 24, 64: PRINT a$;
		INPUT ; "", B$
		a$ = a$ + B$
		ax! = VAL(a$)
		IF ax! <> WinLonD! THEN NeedToDraw% = TRUE%
	END IF
	WinLon! = ax! * .017453293#
	WinLat! = ay! * .017453293#
	CALL WinFrame(Ins, WinLat!, WinLon!, Outs, WinRight!(), WinOut!(), WinUp!())
	GOSUB ToPage0
	GOSUB RunPage0
ELSEIF Current$ = "O" THEN        '2nd Origin (re)set
	LineDown% = FALSE%
	GOSUB ToPage0
OLoop:
	GOSUB RunPage0
	IF Left% THEN
		MouseXYB Row0%, Col0%, MouseLeft%, MouseRight%
		CALL XandY(Ins, Col0%, Row0%, Outs, XO!, YO!)
		CALL XY2ABG(Ins, XO!, YO!, Outs, Outside%, TempVec!())
		IF Outside% THEN
			BEEP
		ELSE
			OChosen% = TRUE%
		END IF
		GOTO OLoop
	ELSEIF Right% THEN
		IF OChosen% THEN
			MouseXYB row%, col%, MouseLeft%, MouseRight%
			CALL XandY(Ins, col%, row%, Outs, XR!, YR!)
			IF (XR! = XO!) AND (YR! = YO!) THEN
				BEEP
			ELSE
				CALL XY2ABG(Ins, XR!, YR!, Outs, Outside%, TempV2!())
				IF Outside% THEN
					BEEP
				ELSE
					'If point accepted, execute both (1) local part:
					GOSUB MouseOff
					IF LineDown% THEN CALL XORLine(col1%, row1%, col2%, row2%)
					CALL XORLine(Col0%, Row0%, col%, row%)
					LineDown% = TRUE%
					GOSUB MouseOn
					col1% = Col0%: row1% = Row0%
					col2% = col%: row2% = row%
					'and (2) global part:
					Using2nd% = TRUE%
					Cart2!(1, 3) = TempVec!(1): Cart2!(2, 3) = TempVec!(2): Cart2!(3, 3) = TempVec!(3)
					CALL Cross(Ins, TempVec!(), TempV2!(), Outs, TempV3!())
					CALL UnitVec(Mods, TempV3!())
					Cart2!(1, 2) = TempV3!(1): Cart2!(2, 2) = TempV3!(2): Cart2!(3, 2) = TempV3!(3)
					CALL Cross(Ins, TempV3!(), TempVec!(), Outs, TempV2!())
					Cart2!(1, 1) = TempV2!(1): Cart2!(2, 1) = TempV2!(2): Cart2!(3, 1) = TempV2!(3)
				END IF
			END IF
		ELSE
			BEEP
		END IF
		GOTO OLoop
	END IF
ELSEIF Current$ = "Z" THEN      'Zoom
GetHigh:
	CALL Blanker(22, 24, 2, 79)
	LOCATE 22, 10: PRINT USING "Current height of window = #.### radii."; WindowHeight!;
	LOCATE 23, 10: PRINT "Press Enter to accept, or enter new height (0.01 to 3.): ";
	CALL WaitForKey(a$)
	IF ASC(a$) = 13 THEN
		'no change in window width
		a! = WindowHeight!
	ELSE
		LOCATE 23, 68: PRINT a$;
		INPUT ; "", B$
		a$ = a$ + B$
		a! = VAL(a$)
		IF (a! <= .009) OR (a! > 3!) THEN
			BEEP
			GOTO GetHigh
		END IF
	END IF
	LOCATE 24, 10: PRINT "Now click on desired center of window...";
	CALL Delay18th(18)
	GOSUB ToPage0
NewCenter:
	GOSUB RunPage0
	IF Left% OR Right% THEN
		MouseXYB row%, col%, MouseLeft%, MouseRight%
		CALL XandY(Ins, col%, row%, Outs, XC!, YC!)
		CALL XY2ABG(Ins, XC!, YC!, Outs, Outside%, TempVec!())
		IF Outside% THEN
			BEEP
		ELSE
			'do (1) local stuff:
			DO WHILE Left% OR Right% 'wait for button to lift
				MouseXYB MouseRow%, MouseCol%, Left%, Right%
			LOOP
			MousePut 0, 0
			'and, (2) global stuff:
			WindowHeight! = a!
			NeedToDraw% = TRUE%
			CALL ABG2LonLat(Ins, TempVec!(), Outs, WinLon!, WinLat!)
			CALL WinFrame(Ins, WinLat!, WinLon!, Outs, WinRight!(), WinOut!(), WinUp!())
			CALL Scaler
			Tolerance! = WindowHeight! * 6! / CSNG(HiRow%)
		END IF
		GOTO NewCenter
	END IF
ELSEIF Current$ = "K" THEN  'select Kolors
	CALL KolorMenu(Ins, Blue%, Brown%, Green%, Red%, White%, Yellow%, Mods, BaseC%, CircleC%, DoIcon%, ElementC%, FaultC1%, FaultC2%, NodeC1%, NodeC2%)
	NeedToDraw% = TRUE%
	GOSUB ToPage0
	GOSUB RunPage0
ELSEIF Current$ = "R" THEN      'Redraw
	NeedToDraw% = TRUE%
	NeedMenu% = TRUE%
	ColorIn% = FALSE%
	Contour% = FALSE%
	Using2nd% = FALSE%
	GOSUB ToPage0
	GOSUB RunPage0
ELSEIF (Current$ = "G") OR (Current$ = "T") THEN   'add grid regions
	IF (Current$ = "G") AND GridLoaded% THEN
		BEEP
		CALL Blanker(16, 24, 2, 79)
		LOCATE 21, 10: PRINT "Command G not allowed with grid in memory!";
		CALL Delay18th(36)
		GOTO Collector
	END IF
	IF (ColorIn% OR Contour%) THEN
		NeedToDraw% = TRUE%
		ColorIn% = FALSE%
		Contour% = FALSE%
	END IF
G1:
	CALL Blanker(16, 24, 2, 79)
	LOCATE 16, 4: PRINT "Available subdivision levels:";
	LOCATE 17, 6: PRINT "N = 0 ->     20 63.4-degree elements to cover sphere";
	LOCATE 18, 6: PRINT "N = 1 ->     80 34.5-degree elements to cover sphere";
	LOCATE 19, 6: PRINT "N = 2 ->    320 17.3-degree elements to cover sphere";
	LOCATE 20, 6: PRINT "N = 3 ->   1280 8.62-degree elements to cover sphere";
	IF (Current$ = "G") AND (1280 > MXEL%) THEN PRINT " (NOT ENOUGH MEMORY)";
	LOCATE 21, 6: PRINT "N = 4 ->   5120 4.31-degree elements to cover sphere";
	IF (Current$ = "G") AND (5120 > MXEL%) THEN PRINT " (NOT ENOUGH MEMORY)";
	LOCATE 22, 6: PRINT "N = 5 ->  20480 2.16-degree elements to cover sphere";
	IF (Current$ = "G") AND (20480 > MXEL%) THEN PRINT " (NOT ENOUGH MEMORY)";
	LOCATE 23, 6: PRINT "N = 6 ->  81920 1.08-degree elements to cover sphere";
	IF (Current$ = "G") AND (81920 > MXEL%) THEN PRINT " (NOT ENOUGH MEMORY)";
	OldSlice% = NSlice%
	IF OldSlice% >= 0 THEN
		IF (Current$ = "T") THEN
			LOCATE 24, 22: PRINT USING "#"; OldSlice%;
		END IF
		LOCATE 24, 41: PRINT USING "(last selection was #)"; OldSlice%;
	END IF
	LOCATE 24, 4: INPUT ; "Enter N (0 to 6): ", a$
	IF a$ = "" THEN
		IF Current$ = "T" THEN
			IF OldSlice% >= 0 THEN
				NSlice% = OldSlice%
			ELSE
				BEEP
				GOTO G1
			END IF
		ELSE
			BEEP
			GOTO G1
		END IF
	ELSE
		NSlice% = VAL(a$) 'this method avoids Redo-from-start scrolling!
	END IF
	IF NSlice% < 0 THEN
		BEEP
		GOTO G1
	END IF
	IF (Current$ = "G") AND (20 * 4 ^ NSlice% > MXEL%) THEN
		NSlice% = OldSlice%
		BEEP
		GOTO G1
	END IF
	Fudge! = .1 * (6.28318) / (5! * 2! ^ NSlice%)
	CALL Blanker(16, 16, 2, 79)
	IF NSlice% <> 0 THEN CALL Blanker(17, 17, 2, 79)
	IF NSlice% <> 1 THEN CALL Blanker(18, 18, 2, 79)
	IF NSlice% <> 2 THEN CALL Blanker(19, 19, 2, 79)
	IF NSlice% <> 3 THEN CALL Blanker(20, 20, 2, 79)
	IF NSlice% <> 4 THEN CALL Blanker(21, 21, 2, 79)
	IF NSlice% <> 5 THEN CALL Blanker(22, 22, 2, 79)
	IF NSlice% <> 6 THEN CALL Blanker(23, 23, 2, 79)
	IF NSlice% <> OldSlice% THEN
		CALL Blanker(24, 24, 2, 79)
		LOCATE 24, 15: PRINT "Creating working file ELEMENTS.BIN on disk...";
		CALL Icosahedron(Ins, NSlice%)
	END IF
	IF Current$ = "T" THEN
		CALL Blanker(16, 24, 2, 79)
		LOCATE 18, 10: PRINT "Now, outline a convex polygon in the counterclockwise";
		LOCATE 19, 10: PRINT "direction with left mouse clicks; finish with right button.";
		LOCATE 22, 40: PRINT "Press any key when ready to begin...";
		CALL WaitForKey(a$)
	END IF
	GOSUB ToPage0
	IF Current$ = "G" THEN
		NPoly% = 0
		WindowHeight! = 2.02
		CALL Scaler
		Tolerance! = WindowHeight! * 6! / CSNG(HiRow%)
		WinLat! = 0!
		WinLon! = 0!
		CALL WinFrame(Ins, WinLat!, WinLon!, Outs, WinRight!(), WinOut!(), WinUp!())
		Using2nd% = FALSE%
		CLS
		CALL Pixels(Ins, 0!, 0!, Outs, tcol0%, trow0%)
		CALL Pixels(Ins, 1!, 0!, Outs, tcol1%, trow1%)
		radpix% = tcol1% - tcol0%
		IF Colored% THEN COLOR CircleC%
		CIRCLE (tcol0%, trow0%), radpix%
	ELSE   '(command T)
NewPoly:
		NPoly% = -1 'begin input of convex polygon defined by NPoly% planes
MorePoly:
		GOSUB RunPage0
		IF Left% THEN
			IF NPoly% > 19 THEN
				BEEP
				NeedToDraw% = TRUE%
				GOTO Collector
			END IF
			MouseXYB row%, col%, MouseLeft%, MouseRight%
			CALL XandY(Ins, col%, row%, Outs, X!, Y!)
			TempV2!(1) = TempVec!(1): TempV2!(2) = TempVec!(2): TempV2!(3) = TempVec!(3)
			CALL XY2ABG(Ins, X!, Y!, Outs, Outside%, TempVec!())
			IF Outside% THEN
				BEEP
			ELSE
				NPoly% = NPoly% + 1
				VertCol%(NPoly%) = col%
				VertRow%(NPoly%) = row%
				IF NPoly% > 0 THEN
					CALL Cross(Ins, TempV2!(), TempVec!(), Outs, TempV3!())
					Normals!(1, NPoly%) = TempV3!(1)
					Normals!(2, NPoly%) = TempV3!(2)
					Normals!(3, NPoly%) = TempV3!(3)
				END IF
				GOSUB MouseOff
				IF NPoly% < 1 THEN  'plot point, and save initial position
					PSET (col%, row%), HotColor%
					PSET (col% + 1, row%), HotColor%
					PSET (col% - 1, row%), HotColor%
					PSET (col%, row% + 1), HotColor%
					PSET (col%, row% - 1), HotColor%
					X0! = X!: Y0! = Y!
					TempV4!(1) = TempVec!(1): TempV4!(2) = TempVec!(2): TempV4!(3) = TempVec!(3)
				ELSE  'draw line
					CALL XORLine(ColOld%, RowOld%, col%, row%)
				END IF
				GOSUB MouseOn
				DO WHILE Left%: MouseXYB MouseRow%, MouseCol%, Left%, Right%: LOOP
				ColOld% = col%
				RowOld% = row%
				GOTO MorePoly
			END IF
		ELSEIF Right% THEN
			NPoly% = NPoly% + 1
			VertCol%(NPoly%) = VertCol%(0)
			VertRow%(NPoly%) = VertRow%(0)
			IF NPoly% < 3 THEN
				BEEP
				GOTO MorePoly
			END IF
			CALL Cross(Ins, TempVec!(), TempV4!(), Outs, TempV3!())
			Normals!(1, NPoly%) = TempV3!(1)
			Normals!(2, NPoly%) = TempV3!(2)
			Normals!(3, NPoly%) = TempV3!(3)
			CALL Pixels(Ins, X0!, Y0!, Outs, col%, row%)
			GOSUB MouseOff
			CALL XORLine(ColOld%, RowOld%, col%, row%)
		ELSE
			GOTO Collector
		END IF
	END IF
	'--------------------------------------------------
	'create new grid
	IF Colored% THEN COLOR White%
	LOCATE 25, 56: PRINT "Working...";
	OPEN "ELEMENTS.BIN" FOR BINARY AS #5 LEN = 3600
	DO
		a$ = INKEY$
		IF a$ <> "" THEN GOTO G99
		GET #5, , TempVec!(1)
		IF EOF(5) THEN GOTO G99  'for binary files, EOF just uses OLD status, doesn't check!
		GET #5, , TempVec!(2)
		GET #5, , TempVec!(3)
		GET #5, , TempV2!(1)
		GET #5, , TempV2!(2)
		GET #5, , TempV2!(3)
		GET #5, , TempV3!(1)
		GET #5, , TempV3!(2)
		GET #5, , TempV3!(3)
		'qualify this element with respect to polygon boundary
		OK% = TRUE%
		FOR i% = 1 TO NPoly%
			Dot! = Normals!(1, i%) * TempVec!(1) + Normals!(2, i%) * TempVec!(2) + Normals!(3, i%) * TempVec!(3)
			IF Dot! < 0! THEN OK% = FALSE%
		NEXT i%
		IF OK% THEN
			FOR i% = 1 TO NPoly%
				Dot! = Normals!(1, i%) * TempV2!(1) + Normals!(2, i%) * TempV2!(2) + Normals!(3, i%) * TempV2!(3)
				IF Dot! < 0! THEN OK% = FALSE%
			NEXT i%
			IF OK% THEN
				FOR i% = 1 TO NPoly%
					Dot! = Normals!(1, i%) * TempV3!(1) + Normals!(2, i%) * TempV3!(2) + Normals!(3, i%) * TempV3!(3)
					IF Dot! < 0! THEN OK% = FALSE%
				NEXT i%
				IF OK% THEN
					'locate (or create) nodes:
					R2MIN! = 3E+38
					FOR i% = 1 TO NUMNOD%
						DA! = NodeABG!(1, i%) - TempVec!(1)
						DB! = NodeABG!(2, i%) - TempVec!(2)
						DG! = NodeABG!(3, i%) - TempVec!(3)
						R2! = DA! * DA! + DB! * DB! + DG! * DG!
						IF R2! < R2MIN! THEN
							R2MIN! = R2!
							n% = i%
						END IF
					NEXT i%
					IF SQR(R2MIN!) < Fudge! THEN
						n1% = n%
					ELSE
						CALL AddNode(Ins, MXNODE%, NFL%, NUMEL%, TempVec!(), Mods, EQCM!(), NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, N1000%, NodeABG!(), Outs, new%)
						n1% = new%
						CALL DrawNode(n1%, NodeC1%, NodeABG!())
					END IF
					R2MIN! = 3E+38
					FOR i% = 1 TO NUMNOD%
						DA! = NodeABG!(1, i%) - TempV2!(1)
						DB! = NodeABG!(2, i%) - TempV2!(2)
						DG! = NodeABG!(3, i%) - TempV2!(3)
						R2! = DA! * DA! + DB! * DB! + DG! * DG!
						IF R2! < R2MIN! THEN
							R2MIN! = R2!
							n% = i%
						END IF
					NEXT i%
					IF SQR(R2MIN!) < Fudge! THEN
						n2% = n%
					ELSE
						CALL AddNode(Ins, MXNODE%, NFL%, NUMEL%, TempV2!(), Mods, EQCM!(), NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, N1000%, NodeABG!(), Outs, new%)
						n2% = new%
						CALL DrawNode(n2%, NodeC1%, NodeABG!())
					END IF
					R2MIN! = 3E+38
					FOR i% = 1 TO NUMNOD%
						DA! = NodeABG!(1, i%) - TempV3!(1)
						DB! = NodeABG!(2, i%) - TempV3!(2)
						DG! = NodeABG!(3, i%) - TempV3!(3)
						R2! = DA! * DA! + DB! * DB! + DG! * DG!
						IF R2! < R2MIN! THEN
							R2MIN! = R2!
							n% = i%
						END IF
					NEXT i%
					IF SQR(R2MIN!) < Fudge! THEN
						n3% = n%
					ELSE
						CALL AddNode(Ins, MXNODE%, NFL%, NUMEL%, TempV3!(), Mods, EQCM!(), NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, N1000%, NodeABG!(), Outs, new%)
						n3% = new%
						CALL DrawNode(n3%, NodeC1%, NodeABG!())
					END IF
					'check that this element does not already exist,
					'and that it won't use non-unique fault nodes.
					BeenDone% = FALSE%
					IF Current$ = "T" THEN
						s1% = 1
G4:
						CALL OnAnyE(Ins, n1%, s1%, NUMEL%, NODES%(), Outs, ie%, je%)
						IF ie% > 0 THEN
							M1% = NODES%(je%, ie%)
							M2% = NODES%((je% MOD 3) + 1, ie%)
							M3% = NODES%(((je% + 1) MOD 3) + 1, ie%)
							IF ((M2% = n2%) AND (M3% = n3%)) OR ((M3% = n2%) AND (M2% = n3%)) THEN BeenDone% = TRUE%
							IF ie% < NUMEL% THEN
								s1% = ie% + 1
								GOTO G4
							END IF
						END IF
						IF NFL% > 0 THEN
							s1% = 1
G5:
							CALL OnAnyF(Ins, n1%, s1%, NFL%, NODEF%(), Outs, ie%, je%)
							IF ie% > 0 THEN
								IF NODEF%(je%, ie%) <> NODEF%(5 - je%, ie%) THEN BeenDone% = TRUE%
								IF ie% < NFL% THEN
									s1% = ie% + 1
									GOTO G5
								END IF
							END IF
							s1% = 1
G6:
							CALL OnAnyF(Ins, n2%, s1%, NFL%, NODEF%(), Outs, ie%, je%)
							IF ie% > 0 THEN
								IF NODEF%(je%, ie%) <> NODEF%(5 - je%, ie%) THEN BeenDone% = TRUE%
								IF ie% < NFL% THEN
									s1% = ie% + 1
									GOTO G6
								END IF
							END IF
							s1% = 1
G7:
							CALL OnAnyF(Ins, n3%, s1%, NFL%, NODEF%(), Outs, ie%, je%)
							IF ie% > 0 THEN
								IF NODEF%(je%, ie%) <> NODEF%(5 - je%, ie%) THEN BeenDone% = TRUE%
								IF ie% < NFL% THEN
									s1% = ie% + 1
									GOTO G7
								END IF
							END IF
						END IF
					END IF
					IF BeenDone% THEN  '(keep quiet, continue)
					ELSE
						'create an element, if space permits
						IF NUMEL% = MXEL% THEN
							LOCATE 2, 1
							PRINT "LIMIT OF "; MXEL%; " ELEMENTS HAS BEEN REACHED.";
							LOCATE 4, 1: PRINT "Press any key...";
							CALL WaitForKey(a$)
							NeedToDraw% = TRUE%
							GOTO Collector
						END IF
						NUMEL% = NUMEL% + 1
						NODES%(1, NUMEL%) = n1%
						NODES%(2, NUMEL%) = n2%
						NODES%(3, NUMEL%) = n3%
						CALL Flipped(Ins, NUMEL%, NODES%(), NodeABG!(), Outs, EMemo%())
						IF EMemo%(NUMEL%) THEN  'must reverse definition
							NODES%(1, NUMEL%) = n1%
							NODES%(2, NUMEL%) = n3%
							NODES%(3, NUMEL%) = n2%
							EMemo%(NUMEL%) = FALSE%
						END IF
						IF (FEP% = 3) THEN
							Mus!(1, NUMEL%) = 0!
							Mus!(2, NUMEL%) = 0!
							Mus!(3, NUMEL%) = 0!
						END IF
						CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), NUMEL%, IData%, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
						GridLoaded% = TRUE%
						NewTopology% = TRUE%
						ChangesInRAM% = TRUE%
					END IF
				END IF
			END IF
		END IF
	LOOP
	'-------------------------------------------------
G99:
	CLOSE #5
	IF Colored% THEN COLOR White%
	LOCATE 25, 56: PRINT "ALL DONE !";
	BEEP
	IF Current$ = "T" THEN
		'un-draw the polygon
		FOR i% = 1 TO NPoly%
			CALL XORLine(VertCol%(i% - 1), VertRow%(i% - 1), VertCol%(i%), VertRow%(i%))
		NEXT i%
		PSET (VertCol%(0), VertRow%(0)), 0
		PSET (VertCol%(0) + 1, VertRow%(0)), 0
		PSET (VertCol%(0) - 1, VertRow%(0)), 0
		PSET (VertCol%(0), VertRow%(0) + 1), 0
		PSET (VertCol%(0), VertRow%(0) - 1), 0
		GOSUB MouseOn
		GOTO NewPoly
	ELSE  '(G)
		NeedToDraw% = FALSE%
		GOSUB MouseOn
		GOSUB RunPage0
	END IF
ELSEIF Current$ = "A" THEN  'Adjust nodes
	IF (ColorIn% OR Contour%) THEN
		NeedToDraw% = TRUE%
		ColorIn% = FALSE%
		Contour% = FALSE%
	END IF
	GOSUB ToPage0
A1:
	GOSUB RunPage0
	MouseClick MouseRow%, MouseCol%, LC%, RC%
	IF LC% OR RC% THEN  'new node attached
		MouseXYB RowHOld%, ColHOld%, MouseLeft%, MouseRight%
		CALL XandY(Ins, ColHOld%, RowHOld%, Outs, X!, Y!)
		NItsOn% = 0
		s1% = 1
A2:
		CALL Exists(Ins, s1%, NUMNOD%, X!, Y!, NodeABG!(), Tolerance!, Outs, nH%)
		IF nH% > 0 THEN
			NItsOn% = NItsOn% + 1
			NOn%(NItsOn%) = nH%
			IF nH% <= NUMNOD% THEN
				s1% = nH% + 1
				GOTO A2
			END IF
		END IF
		IF NItsOn% > 0 THEN
			GOSUB MouseOff
			CALL DrawNode(NOn%(1), FaultC1%, NodeABG!())
			GOSUB MouseOn
			EItsOn% = 0
			FItsOn% = 0
			FOR n% = 1 TO NItsOn%
				nH% = NOn%(n%)
				s1% = 1
A3:
				CALL OnAnyE(Ins, nH%, s1%, NUMEL%, NODES%(), Outs, ie%, je%)
				IF ie% > 0 THEN
					EItsOn% = EItsOn% + 1
					EOn%(EItsOn%) = ie%
					IF ie% < NUMEL% THEN
						s1% = ie% + 1
						GOTO A3
					END IF
				END IF
				FOR i% = 1 TO NFL%
					IF nH% = NODEF%(1, i%) OR nH% = NODEF%(2, i%) THEN
						FItsOn% = FItsOn% + 1
						FOn%(FItsOn%) = i%
					END IF
				NEXT i%
			NEXT n%
			ChangesInRAM% = TRUE%
		ELSE  'cursor is not on any node
			BEEP
		END IF
		GOTO A1
	ELSEIF Left% OR Right% THEN 'still attached
		MouseXYB RowH%, ColH%, MouseLeft%, MouseRight%
		IF ColH% <> ColHOld% OR RowH% <> RowHOld% THEN
			'erase old graphics
			GOSUB MouseOff
			FOR j% = 1 TO FItsOn%
				CALL DrawFault(FDIP!(), FOn%(j%), NODEF%(), 0, NodeABG!())
			NEXT j%
			FOR j% = 1 TO EItsOn%
				CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), EOn%(j%), IData%, Logs%, Mus!(), NODES%(), Redo%, 0, NodeABG!())
			NEXT j%
			CALL DrawNode(NOn%(1), 0, NodeABG!())
			'correct positions
			CALL XandY(Ins, ColH%, RowH%, Outs, X!, Y!)
			CALL XY2ABG(Ins, X!, Y!, Outs, Outside%, TempVec!())
			IF Outside% THEN
				BEEP
			ELSE
				FOR n% = 1 TO NItsOn%
					nH% = NOn%(n%)
					NodeABG!(1, nH%) = TempVec!(1)
					NodeABG!(2, nH%) = TempVec!(2)
					NodeABG!(3, nH%) = TempVec!(3)
				NEXT n%
			END IF
			CALL DrawNode(NOn%(1), NodeC2%, NodeABG!())
			FOR j% = 1 TO EItsOn%
				CALL Flipped(Ins, EOn%(j%), NODES%(), NodeABG!(), Outs, EMemo%())
				CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), EOn%(j%), IData%, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
			NEXT j%
			FOR j% = 1 TO FItsOn%
				CALL DrawFault(FDIP!(), FOn%(j%), NODEF%(), FaultC1%, NodeABG!())
			NEXT j%
			GOSUB MouseOn
			ColHOld% = ColH%: RowHOld% = RowH%
		END IF
		NeedGrid% = TRUE%: NeedFaults% = TRUE%: NextFault% = NFL%
		GOTO A1
	END IF
ELSEIF Current$ = "N" THEN    'Nodes: add or delete
	IF (ColorIn% OR Contour%) THEN
		NeedToDraw% = TRUE%
		ColorIn% = FALSE%
		Contour = FALSE%
	END IF
	GOSUB ToPage0
MoreNodes:
	GOSUB RunPage0
	MouseClick MouseRow%, MouseCol%, Left%, Right%
	IF Left% THEN 'add node
		row% = MouseRow%
		col% = MouseCol%
		CALL XandY(Ins, col%, row%, Outs, X!, Y!)
		CALL XY2ABG(Ins, X!, Y!, Outs, Outside%, TempVec!())
		IF Outside% THEN
			BEEP
		ELSE
			CALL AddNode(Ins, MXNODE%, NFL%, NUMEL%, TempVec!(), Mods, EQCM!(), NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, N1000%, NodeABG!(), Outs, n%)
			GridLoaded% = TRUE%
			NewTopology% = TRUE%
			ChangesInRAM% = TRUE%
			GOSUB MouseOff
			CALL DrawNode(n%, NodeC1%, NodeABG!())
			GOSUB MouseOn
			DO WHILE Left% OR Right%: MouseXYB MouseRow%, MouseCol%, Left%, Right%: LOOP
		END IF
		GOTO MoreNodes
	ELSEIF Right% THEN  'remove node(s)
		row% = MouseRow%
		col% = MouseCol%
		CALL XandY(Ins, col%, row%, Outs, X!, Y!)
		NItsOn% = 0
		CALL Exists(Ins, 1, NUMNOD%, X!, Y!, NodeABG!(), Tolerance!, Outs, nH%)
		IF nH% > 0 THEN  'at least one node in this spot
			FOR k% = 1 TO NUMNOD%  'make list of all at this spot NOT in an element or fault
				IF NodeABG!(1, k%) = NodeABG!(1, nH%) AND NodeABG!(2, k%) = NodeABG!(2, nH%) AND NodeABG!(3, k%) = NodeABG!(3, nH%) THEN
					CALL OnAnyE(Ins, k%, 1, NUMEL%, NODES%(), Outs, ie%, je%)
					IF ie% = 0 THEN
						CALL OnAnyF(Ins, k%, 1, NFL%, NODEF%(), Outs, ie%, je%)
						IF ie% = 0 THEN
							NItsOn% = NItsOn% + 1
							NOn%(NItsOn%) = k%
						END IF
					END IF
				END IF
			NEXT k%
		END IF
		IF NItsOn% > 0 THEN  'if cursor is on 1 or more unused nodes...
			GOSUB MouseOff
			n% = NOn%(1)
			CALL DrawNode(n%, 0, NodeABG!())
			GOSUB MouseOn
			FOR i% = 1 TO NItsOn%
				n% = NOn%(i%)
				CALL DropNode(Ins, AKA%, n%, NFL%, NUMEL%, Mods, EQCM!(), NFAKEN%, NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, NodeABG!())
				FOR k% = i% + 1 TO NItsOn%
					IF NOn%(k%) > n% THEN NOn%(k%) = NOn%(k%) - 1
				NEXT k%
				NewTopology% = TRUE%
				ChangesInRAM% = TRUE%
				IF NUMNOD% = 0 THEN GridLoaded% = FALSE%
			NEXT i%
		ELSE
			BEEP
		END IF
		DO WHILE Left% OR Right%: MouseXYB MouseRow%, MouseCol%, Left%, Right%: LOOP
		GOTO MoreNodes
	END IF
ELSEIF Current$ = "E" THEN   'Elements: add or delete
	IF (ColorIn% OR Contour%) THEN
		NeedToDraw% = TRUE%
		ColorIn% = FALSE%
		Contour% = FALSE%
	END IF
	JIP% = 0
	GOSUB ToPage0
MoreEs:
	DO WHILE Left% OR Right%: MouseXYB MouseRow%, MouseCol%, Left%, Right%: LOOP
	IF Colored% THEN COLOR White%
	LOCATE 25, 25: PRINT JIP%; " nodes have been selected";
	GOSUB RunPage0
	MouseClick MouseRow%, MouseCol%, Left%, Right%
	IF Left% THEN 'add node to short list; add element when you have 3 nodes.
		MouseXYB row%, col%, MouseLeft%, MouseRight%
		CALL XandY(Ins, col%, row%, Outs, X!, Y!)
		CALL Exists(Ins, 1, NUMNOD%, X!, Y!, NodeABG!(), Tolerance!, Outs, n%)
		IF n% > 0 THEN
			CALL OnAnyF(Ins, n%, 1, NFL%, NODEF%(), Outs, ie%, je%)
			IF ie% = 0 THEN 'not on a fault (good)
				OK% = TRUE%
				'reject this node if it was already selected
				FOR k% = 1 TO JIP%
					IF n% = EOn%(k%) THEN OK% = FALSE%
				NEXT k%
				IF OK% THEN
					JIP% = (JIP% MOD 3) + 1
					EOn%(JIP%) = n%
					GOSUB MouseOff
					CALL DrawNode(n%, NodeC2%, NodeABG!())
					GOSUB MouseOn
					IF JIP% = 3 THEN  'element completely defined; make it
						JIP% = 0
						IF NUMEL% = MXEL% THEN
							LOCATE 2, 1
							PRINT "LIMIT OF "; MXEL%; " ELEMENTS HAS BEEN REACHED.";
							CALL WaitForKey(a$)
							GOTO Collector
						END IF
						'check that this element does not already exist
						BeenDone% = FALSE%
						n1% = 1
MNE:                          CALL OnAnyE(Ins, EOn%(1), n1%, NUMEL%, NODES%(), Outs, ie%, je%)
						IF ie% > 0 THEN
							M1% = NODES%(je%, ie%)
							M2% = NODES%((je% MOD 3) + 1, ie%)
							M3% = NODES%(((je% + 1) MOD 3) + 1, ie%)
							IF ((M2% = EOn%(2)) AND (M3% = EOn%(3))) OR ((M3% = EOn%(2)) AND (M2% = EOn%(3))) THEN BeenDone% = TRUE%
							IF ie% < NUMEL% THEN
								n1% = ie% + 1
								GOTO MNE
							END IF
						END IF
						IF BeenDone% THEN
							BEEP
							GOSUB MouseOff
							FOR j% = 1 TO 3
								n% = EOn%(j%)
								CALL DrawNode(n%, NodeC1%, NodeABG!())
							NEXT j%
							GOSUB MouseOn
						ELSE
							'element is OK...
							NUMEL% = NUMEL% + 1
							NewTopology% = TRUE%
							ChangesInRAM% = TRUE%
							NODES%(1, NUMEL%) = EOn%(1)
							NODES%(2, NUMEL%) = EOn%(2)
							NODES%(3, NUMEL%) = EOn%(3)
							IF (FEP% = 3) THEN
								Mus!(1, NUMEL%) = 0!
								Mus!(2, NUMEL%) = 0!
								Mus!(3, NUMEL%) = 0!
							END IF
							CALL Flipped(Ins, NUMEL%, NODES%(), NodeABG!(), Outs, EMemo%())
							GOSUB MouseOff
							CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), NUMEL%, IData%, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
							FOR j% = 1 TO 3
								n% = NODES%(j%, NUMEL%)
								CALL DrawNode(n%, NodeC1%, NodeABG!())
							NEXT j%
							GOSUB MouseOn
						END IF
					END IF
				ELSE
					BEEP 'this node is already in short list
				END IF
			ELSE
				BEEP  'node was on some fault
			END IF
		ELSE
			BEEP 'cursor is not on any node
		END IF
		GOTO MoreEs
	ELSEIF Right% THEN 'subtract an element
		IF JIP% MOD 3 = 0 THEN
			MouseXYB row%, col%, MouseLeft%, MouseRight%
			CALL XandY(Ins, col%, row%, Outs, X!, Y!)
			CALL GetElement(Ins, NodeABG!(), NODES%(), NUMEL%, X!, Y!, Outs, j%, R2MIN!)
			IF R2MIN! < Tolerance! * Tolerance! THEN
				'check for any node involved in a fault
				OK% = TRUE%
				FOR m% = 1 TO 3
					na% = NODES%(m%, j%)
					CALL OnAnyF(Ins, na%, 1, NFL%, NODEF%(), Outs, ie%, je%)
					IF ie% > 0 THEN OK% = FALSE%
				NEXT m%
				IF OK% THEN
					GOSUB MouseOff
					CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), j%, IData%, Logs%, Mus!(), NODES%(), Redo%, 0, NodeABG!())
					FOR m% = 1 TO 3
						na% = NODES%(m%, j%)
						nb% = NODES%((m% MOD 3) + 1, j%)
						'redraw any neighboring elements that were partly blanked
						n1% = 1
TA:
						CALL OnAnyE(Ins, na%, n1%, NUMEL%, NODES%(), Outs, ie%, je%)
						IF ie% = j% THEN 'just found itself; continue
							n1% = j% + 1
							GOTO TA
						ELSEIF ie% > 0 THEN
							IF (nb% = NODES%(((je% + 1) MOD 3) + 1, ie%)) OR (nb% = NODES%((je% MOD 3) + 1, ie%)) THEN
								CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), ie%, IData%, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
							ELSE
								IF ie% < NUMEL% THEN
									n1% = ie% + 1
									GOTO TA
								END IF
							END IF
						END IF
					NEXT m%
					GOSUB MouseOn
					NUMEL% = NUMEL% - 1
					JIP% = 0
					NewTopology% = TRUE%
					ChangesInRAM% = TRUE%
					FOR i% = j% TO NUMEL%
						EMemo%(i%) = EMemo%(i% + 1)
						FOR k% = 1 TO 3
							NODES%(k%, i%) = NODES%(k%, i% + 1)
							IF (FEP% = 3) THEN Mus!(k%, i%) = Mus!(k%, i% + 1)
						NEXT k%
					NEXT i%
				ELSE
					BEEP  'one or more nodes involved in a fault
				END IF
			ELSE
				BEEP 'not on any element symbol
			END IF
		ELSEIF JIP% > 0 THEN
			'delete the element which is in progress
			GOSUB MouseOff
			FOR i% = 1 TO JIP%
				CALL DrawNode(EOn%(i%), NodeC1%, NodeABG!())
			NEXT i%
			JIP% = 0
			GOSUB MouseOn
		ELSE
			BEEP
		END IF
		GOTO MoreEs
	ELSE
		CALL Blanker(25, 25, 25, 60)
	END IF
ELSEIF Current$ = "F" THEN     'Faults: cut or heal
	IF (ColorIn% OR Contour%) THEN
		NeedToDraw% = TRUE%
		ColorIn% = FALSE%
		Contour% = FALSE%
	END IF
	GOSUB ToPage0
MF:
	DO WHILE Left% OR Right%: MouseXYB MouseRow%, MouseCol%, Left%, Right%: LOOP
	GOSUB RunPage0
	IF Left% OR Right% THEN 'locate nearest midpoint
		MouseXYB row%, col%, MouseLeft%, MouseRight%
		CALL XandY(Ins, col%, row%, Outs, X!, Y!)
		CALL XY2ABG(Ins, X!, Y!, Outs, Outside%, TempVec!())
		IF Outside% THEN
			BEEP
		ELSE
			IF Left% THEN 'cut a new fault
				GOSUB MouseOff
				R2MIN! = 3.3E+38    'find the nearest midpoint of an element side
				FOR i% = 1 TO NUMEL%
					FOR j% = 1 TO 3
						j1% = (j% MOD 3) + 1
						K1% = NODES%(j1%, i%)
						TempV2!(1) = NodeABG!(1, K1%): TempV2!(2) = NodeABG!(2, K1%): TempV2!(3) = NodeABG!(3, K1%)
						CALL ABG2XY(Ins, TempV2!(), Outs, Visible%, X1!, Y1!)
						IF Visible% THEN
							j2% = (j1% MOD 3) + 1
							K2% = NODES%(j2%, i%)
							TempV3!(1) = NodeABG!(1, K2%): TempV3!(2) = NodeABG!(2, K2%): TempV3!(3) = NodeABG!(3, K2%)
							CALL ABG2XY(Ins, TempV3!(), Outs, Visible%, X2!, Y2!)
							IF Visible% THEN
								XC! = .5 * (X1! + X2!)
								YC! = .5 * (Y1! + Y2!)
								DX! = X! - XC!
								DY! = Y! - YC!
								R2! = DX! * DX! + DY! * DY!
								IF R2! < R2MIN! THEN
									R2MIN! = R2!: ieBase% = i%
									n1% = K2%  'note reversal; n1% and
									n2% = K1%  'n2% are now FAULT nodes 1 and 2
								END IF
							END IF
						END IF
					NEXT j%
				NEXT i%
				IF R2MIN! > Tolerance! * Tolerance! THEN
					BEEP
				ELSE 'cursor has identified an element side
					'is this side already a fault?
					Faulted% = FALSE%
					s1% = 1
F3:
					CALL OnAnyF(Ins, n1%, s1%, NFL%, NODEF%(), Outs, ie%, je%)
					IF ie% > 0 THEN
						IF (n2% = NODEF%(1, ie%)) OR (n2% = NODEF%(2, ie%)) OR (n2% = NODEF%(3, ie%)) OR (n2% = NODEF%(4, ie%)) THEN Faulted% = TRUE%
						IF ie% < NFL% THEN
							s1% = ie% + 1
							GOTO F3
						END IF
					END IF
					IF Faulted% THEN
						BEEP
					ELSEIF NFL% = MXFEL% THEN  'storage could be full...
						BEEP
						LOCATE 3, 1
						PRINT "MAXIMUM OF "; MXFEL%; " FAULTS HAS BEEN REACHED."
						CALL WaitForKey(a$)
						GOTO Collector
					ELSE  'side is green and storage OK; make new fault
						NFL% = NFL% + 1
						NewTopology% = TRUE%
						ChangesInRAM% = TRUE%
						FDIP!(1, NFL%) = 90!: FDIP!(2, NFL%) = 90!
						OFFSET!(NFL%) = 0!
						NODEF%(1, NFL%) = n1%
						NODEF%(2, NFL%) = n2%
						'create two new nodes:
						TempVec!(1) = NodeABG!(1, n1%): TempVec!(2) = NodeABG!(2, n1%): TempVec!(3) = NodeABG!(3, n1%)
						CALL AddNode(Ins, MXNODE%, NFL% - 1, NUMEL%, TempVec!(), Mods, EQCM!(), NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, N1000%, NodeABG!(), Outs, new%)
						NODEF%(4, NFL%) = new%
						n4% = new%
						EQCM!(1, n4%) = EQCM!(1, n1%)
						EQCM!(2, n4%) = EQCM!(2, n1%)
						EQCM!(3, n4%) = EQCM!(3, n1%)
						EQCM!(4, n4%) = EQCM!(4, n1%)
						TempVec!(1) = NodeABG!(1, n2%): TempVec!(2) = NodeABG!(2, n2%): TempVec!(3) = NodeABG!(3, n2%)
						CALL AddNode(Ins, MXNODE%, NFL% - 1, NUMEL%, TempVec!(), Mods, EQCM!(), NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, N1000%, NodeABG!(), Outs, new%)
						NODEF%(3, NFL%) = new%
						n3% = new%
						EQCM!(1, n3%) = EQCM!(1, n2%)
						EQCM!(2, n3%) = EQCM!(2, n2%)
						EQCM!(3, n3%) = EQCM!(3, n2%)
						EQCM!(4, n3%) = EQCM!(4, n2%)
						'If there's an element on the far side, locate it.
						s1% = 1
F19:
						CALL OnAnyE(Ins, n1%, s1%, NUMEL%, NODES%(), Outs, ie%, je%)
						IF ie% > 0 THEN
							IF ie% <> ieBase% THEN
								je2% = (je% MOD 3) + 1
								IF NODES%(je2%, ie%) = n2% THEN
									ieFar% = ie%
									jeFar% = (je2% MOD 3) + 1
									'Now, pivot from far side back to original side,
									'redefining elements with n3% and n4% until
									'you are stopped by any fault (perhaps this fault!)
									'Swing clockwise around n3-n2 end:
									'- - - - - - - - - - - - - - - - - -
									ieTemp% = ieFar%
									jeJoin% = (jeFar% MOD 3) + 1
Clockwise:
									CALL NEXTto(Ins, ieTemp%, jeJoin%, NFL%, NODEF%(), NODES%(), NUMEL%, Outs, KFAULT%, jf%, KELE%, je%)
									NODES%((jeJoin% MOD 3) + 1, ieTemp%) = n3%   'do this AFTER NextTo, so it works!
									IF KFAULT% > 0 THEN 'end by redefining this fault, and possibly canning the pivot node.
										IF jf% = 1 THEN
											NODEF%(2, KFAULT%) = n3%
										ELSE ' jf% = 2
											NODEF%(4, KFAULT%) = n3%
										END IF
										IF KFAULT% = NFL% THEN 'you just came back to side 1; eliminate old node.
											CALL DropNode(Ins, n3%, n2%, NFL%, NUMEL%, Mods, EQCM!(), NFAKEN%, NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, NodeABG!())
											IF n1% > n2% THEN n1% = n1% - 1
											IF n4% > n2% THEN n4% = n4% - 1
										END IF
									ELSE ' no fault here, continue pivoting (if possible)
										IF KELE% > 0 THEN
											ieTemp% = KELE%
											jeJoin% = (je% MOD 3) + 1
											GOTO Clockwise
										END IF
									END IF
									'- - - - - - - - - - - - - - - - - -
									'Swing counterclockwise around n4-n1 end:
									'- - - - - - - - - - - - - - - - - -
									ieTemp% = ieFar%
									jeJoin% = (((jeFar% MOD 3) + 1) MOD 3) + 1
Counterclockwise:
									CALL NEXTto(Ins, ieTemp%, jeJoin%, NFL%, NODEF%(), NODES%(), NUMEL%, Outs, KFAULT%, jf%, KELE%, je%)
									NODES%((((jeJoin% MOD 3) + 1) MOD 3) + 1, ieTemp%) = n4%  'do this AFTER NextTo, so it works!
									IF KFAULT% > 0 THEN 'end by redefining this fault, and possibly canning the pivot node.
										IF jf% = 1 THEN
											NODEF%(1, KFAULT%) = n4%
										ELSE ' jf% = 2
											NODEF%(3, KFAULT%) = n4%
										END IF
										IF KFAULT% = NFL% THEN 'you just came back to side 1; eliminate old node.
											CALL DropNode(Ins, n4%, n1%, NFL%, NUMEL%, Mods, EQCM!(), NFAKEN%, NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, NodeABG!())
											IF n2% > n1% THEN n2% = n2% - 1
											IF n3% > n1% THEN n3% = n3% - 1
										END IF
									ELSE ' no fault here, continue pivoting (if possible)
										IF KELE% > 0 THEN
											ieTemp% = KELE%
											jeJoin% = (((je% MOD 3) + 1) MOD 3) + 1
											GOTO Counterclockwise
										END IF
									END IF
									'- - - - - - - - - - - - - - - - - -
								END IF   '(ieFar% has been found)
							END IF  '(potential ieFar% <> ieBase%)
							IF ie% < NUMEL% THEN 'search for far side needs to continue
								s1% = ie% + 1
								GOTO F19
							END IF
						END IF '(a potential ieFar% hangs by one node)
						'Finally, draw the fault!
						GOSUB MouseOff
						CALL DrawFault(FDIP!(), NFL%, NODEF%(), FaultC1%, NodeABG!())
					END IF '(side is green and there's enough storage)
				END IF '(cursor has found an element side midpoint)
				GOSUB MouseOn
			ELSE 'right button: heal a fault
				CALL FindFault(Ins, X!, Y!, NFL%, NODEF%(), NodeABG!(), Tolerance!, Outs, ie%)
				IF ie% > 0 THEN
					GOSUB DropFault
				ELSE
					BEEP
				END IF
			END IF
		END IF
		GOTO MF
	ELSE 'interruption was by key-press; eliminate bogus faults
		ie% = NFL%
F21:           IF (NODEF%(1, ie%) = NODEF%(4, ie%)) AND (NODEF%(2, ie%) = NODEF%(3, ie%)) THEN
				GOSUB DropFault
			END IF
		ie% = ie% - 1: IF (ie% > 0) THEN GOTO F21
	END IF
ELSEIF Current$ = "I" THEN       'Inclination of faults
	IF (ColorIn% OR Contour%) THEN
		NeedToDraw% = TRUE%
		ColorIn% = FALSE%
		Contour% = FALSE%
	END IF
GSh:
	CALL Blanker(21, 24, 2, 79)
	LOCATE 21, 18
	PRINT USING "Left mouse button = shallow dip = ##.# degrees."; Shallow!;
	LOCATE 22, 18: PRINT "(Press Enter to accept, or type new number)";
	CALL WaitForKey(a$)
	IF ASC(a$) <> 13 THEN
		LOCATE 21, 52: PRINT a$; "   "
		LOCATE 21, 53: INPUT ; "", B$
		a$ = a$ + B$
		T! = VAL(a$)
		IF T! < 1! OR T! > 90! THEN
			BEEP
			GOTO GSh
		ELSE
			Shallow! = T!
			LOCATE 21, 52: PRINT USING "##.#"; T!
		END IF
	END IF
GSt:
	LOCATE 23, 18
	PRINT USING "Right mouse button = steep  dip = ##.# degrees."; Steep!;
	LOCATE 24, 18: PRINT "(Press Enter to accept, or type new number)";
	LOCATE 23, 52
	CALL WaitForKey(a$)
	IF ASC(a$) <> 13 THEN
		LOCATE 23, 52: PRINT a$; "   "
		LOCATE 23, 53: INPUT ; "", B$
		a$ = a$ + B$
		T! = VAL(a$)
		IF T! < 1! OR T! > 90! THEN
			BEEP
			GOTO GSt
		ELSE
			Steep! = T!
			LOCATE 23, 52: PRINT USING "##.#"; T!
		END IF
	END IF
	Fudge! = .05 * WindowHeight!
	JIP% = 1
	GOSUB ToPage0
MI:
	DO WHILE Left% OR Right%: MouseXYB MouseRow%, MouseCol%, Left%, Right%: LOOP
	LOCATE 25, 30
	SELECT CASE JIP%
		CASE 1
			IF Colored% THEN COLOR White%
			PRINT "Click near a midpoint   ";
		CASE 2
			IF Colored% THEN COLOR Green%
			PRINT "Click near either end   ";
		CASE 3
			IF Colored% THEN COLOR HotColor%
			PRINT "Click near the other end";
	END SELECT
	GOSUB RunPage0
	IF Left% OR Right% THEN
		MouseXYB row%, col%, MouseLeft%, MouseRight%
		'pause 0.3 seconds to see if second button will also be pushed
		CALL Delay18th(6)
		OldLeft% = Left%
		OldRight% = Right%
		MouseXYB MouseRow%, MouseCol%, Left%, Right%
		Left% = Left% OR OldLeft%
		Right% = Right% OR OldRight%
		CALL XandY(Ins, col%, row%, Outs, X!, Y!)
		CALL XY2ABG(Ins, X!, Y!, Outs, Outside%, TempVec!())
		IF Outside% THEN
			BEEP: GOTO MI
		END IF
		IF JIP% = 1 THEN
			CALL FindFault(Ins, X!, Y!, NFL%, NODEF%(), NodeABG!(), Tolerance!, Outs, ie%)
			IF ie% > 0 THEN
				JIP% = 2
				n1% = NODEF%(1, ie%)
				n2% = NODEF%(2, ie%)
				A1! = NodeABG!(1, n1%): B1! = NodeABG!(2, n1%): G1! = NodeABG!(3, n1%)
				A2! = NodeABG!(1, n2%): B2! = NodeABG!(2, n2%): G2! = NodeABG!(3, n2%)
				AC! = .5 * (A1! + A2!): BC! = .5 * (B1! + B2!): GC! = .5 * (G1! + G2!)
				FA! = A2! - AC!: FB! = B2! - BC!: FG! = G2! - GC!
				TempVec!(1) = AC!: TempVec!(2) = BC!: TempVec!(3) = GC! 'r to fault center*
				TempV2!(1) = FA!: TempV2!(2) = FB!: TempV2!(3) = FG!  'along fault*
				CALL Cross(Ins, TempV2!(), TempVec!(), Outs, TempV3!())  '*NOT unit vectors
				GOSUB MouseOff
				CALL DrawFault(FDIP!(), ie%, NODEF%(), FaultC2%, NodeABG!())
				GOSUB MouseOn
			ELSE
				BEEP
			END IF
			GOTO MI
		ELSEIF JIP% = 2 THEN
			JIP% = 3
			VA! = TempVec!(1) - AC!: VB! = TempVec!(2) - BC!: VG! = TempVec!(3) - GC!
			Dot! = FA! * VA! + FB! * VB! + FG! * VG!
			IF Dot! > 0! THEN
				je% = 2
			ELSE
				je% = 1
			END IF
		ELSE '(JIP% = 3)
			JIP% = 1
			je% = 3 - je%
			VA! = TempVec!(1) - AC!: VB! = TempVec!(2) - BC!: VG! = TempVec!(3) - GC!
		END IF
		Sense! = VA! * TempV3!(1) + VB! * TempV3!(2) + VG! * TempV3!(3)
		IF Left% AND Right% THEN
			NewDip! = 90!
		ELSEIF Left% THEN
			IF Sense! > 0! THEN
				NewDip! = Shallow!
			ELSE
				NewDip! = 180! - Shallow!
			END IF
		ELSEIF Right% THEN
			IF Sense! > 0! THEN
				NewDip! = Steep!
			ELSE
				NewDip! = 180! - Steep!
			END IF
		END IF
		GOSUB MouseOff
		CALL DrawFault(FDIP!(), ie%, NODEF%(), 0, NodeABG!())
		FDIP!(je%, ie%) = NewDip!
		CALL DrawFault(FDIP!(), ie%, NODEF%(), FaultC1%, NodeABG!())
		GOSUB MouseOn
		ChangesInRAM% = TRUE%
		GOTO MI
	ELSE
		CALL Blanker(25, 25, 30, 60)
	END IF
ELSEIF Current$ = "H" THEN  'Heading, or azimuth
	IF (ColorIn% OR Contour%) THEN
		NeedToDraw% = TRUE%
		ColorIn% = FALSE%
		Contour% = FALSE%
	END IF
	GOSUB ToPage0
H1:
	DO WHILE Left% OR Right%: MouseXYB MouseRow%, MouseCol%, Left%, Right%: LOOP
	GOSUB RunPage0
	IF Left% OR Right% THEN
		MouseXYB row%, col%, MouseLeft%, MouseRight%
		CALL XandY(Ins, col%, row%, Outs, X!, Y!)
		CALL XY2ABG(Ins, X!, Y!, Outs, Outside%, TempVec!())
		IF Outside% THEN
			BEEP
		ELSE
			CALL FindFault(Ins, X!, Y!, NFL%, NODEF%(), NodeABG!(), Tolerance!, Outs, ie%)
			IF ie% > 0 THEN  'we found a fault center
				GOSUB MouseOff  'and STAY OFF until whole job is done!
				CALL DrawFault(FDIP!(), ie%, NODEF%(), FaultC2%, NodeABG!())
				'locate midpoint precisely
				n1% = NODEF%(1, ie%): n2% = NODEF%(2, ie%)
				n3% = NODEF%(3, ie%): n4% = NODEF%(4, ie%)
				TempVec!(1) = .5 * (NodeABG!(1, n1%) + NodeABG!(1, n2%))
				TempVec!(2) = .5 * (NodeABG!(2, n1%) + NodeABG!(2, n2%))
				TempVec!(3) = .5 * (NodeABG!(3, n1%) + NodeABG!(3, n2%))
				CALL UnitVec(Mods, TempVec!())
				CALL ABG2XY(Ins, TempVec!(), Outs, Visible%, XC!, YC!)
				CALL Pixels(Ins, XC!, YC!, Outs, ColOld%, RowOld%)
				CALL MousePut(RowOld%, ColOld%)
				CALL XandY(Ins, ColOld%, RowOld%, Outs, XOld!, YOld!)
				'find initial heading
				TempV2!(1) = NodeABG!(1, n2%) - NodeABG!(1, n1%)
				TempV2!(2) = NodeABG!(2, n2%) - NodeABG!(2, n1%)
				TempV2!(3) = NodeABG!(3, n2%) - NodeABG!(3, n1%)
				'east-pointing unit vector
				TempV3!(1) = -TempVec!(2): TempV3!(2) = TempVec!(1): TempV3!(3) = 0!
				CALL UnitVec(Mods, TempV3!())
				'north-pointing unit vector
				CALL Cross(Ins, TempVec!(), TempV3!(), Outs, TempV4!())
				EDot! = TempV2!(1) * TempV3!(1) + TempV2!(2) * TempV3!(2) + TempV2!(3) * TempV3!(3)
				NDot! = TempV2!(1) * TempV4!(1) + TempV2!(2) * TempV4!(2) + TempV2!(3) * TempV4!(3)
				OldHead! = ATAN2F!(EDot!, NDot!)
				'find Fixup necessary when correcting projected heading to true heading
				'(this is only important when fault is off-center)
				TempV5!(1) = NodeABG!(1, n1%): TempV5!(2) = NodeABG!(2, n1%): TempV5!(3) = NodeABG!(3, n1%)
				CALL ABG2XY(Ins, TempV5!(), Outs, Visible%, X1!, Y1!)
				TempV5!(1) = NodeABG!(1, n2%): TempV5!(2) = NodeABG!(2, n2%): TempV5!(3) = NodeABG!(3, n2%)
				CALL ABG2XY(Ins, TempV5!(), Outs, Visible%, X2!, Y2!)
				ScreenHead! = 1.570796 - ATAN2F!(Y2! - Y1!, X2! - X1!)
				FixUp! = OldHead! - ScreenHead!
				IF FixUp! > 6.28318 THEN FixUp! = FixUp! - 6.28318
				IF FixUp! < -6.28318 THEN FixUp! = FixUp! + 6.28318
				'prepare to begin indefinate loop
				CALL Blanker(25, 25, 15, 65)
H2:
				MouseXYB row%, col%, MouseLeft%, MouseRight%
				IF ABS(col% - ColOld%) > 6 OR ABS(row% - RowOld%) > 6 THEN
					CALL XORLine(2 * ColOld% - col%, 2 * RowOld% - row%, col%, row%)
					CALL XandY(Ins, col%, row%, Outs, Xp!, Yp!)
					Heading! = 1.570796 - ATAN2F!(Yp! - YOld!, Xp! - XOld!) + FixUp!
				ELSE
					Heading! = OldHead!
				END IF
				HeadOut! = 57.2958 * Heading!: IF HeadOut! < 0! THEN HeadOut! = HeadOut! + 360!
				IF HeadOut! < 180! THEN
					HeadOut1! = HeadOut!
					HeadOut2! = HeadOut! + 180!
				ELSE
					HeadOut1! = HeadOut! - 180!
					HeadOut2! = HeadOut!
				END IF
				LOCATE 25, 30: PRINT USING "###.# / ###.# degrees"; HeadOut1!; HeadOut2!;
				CALL Delay18th(2) 'to SEE the line!
				CALL XORLine(2 * ColOld% - col%, 2 * RowOld% - row%, col%, row%)
				MouseXYB MouseRow%, MouseCol%, Left%, Right%
				IF Left% OR Right% THEN GOTO H2
				IF ABS(row% - RowOld%) > 6 OR ABS(col% - ColOld%) > 6 THEN
					CALL XandY(Ins, col%, row%, Outs, X!, Y!)
					Heading! = 1.570796 - ATAN2F!(Y! - YC!, X! - XC!) + FixUp!
				ELSE
					Heading! = OldHead!
				END IF
				IF Heading! = OldHead! THEN  'simply make fault red again
					CALL DrawFault(FDIP!(), ie%, NODEF%(), FaultC1%, NodeABG!())
				ELSE   'update whole grid by moving nodes
					'make sure heading change is minimal!
					Change! = Heading! - OldHead!
					IF Change! > 1.570796 THEN Change! = Change! - 3.141593
					IF Change! > 1.570796 THEN Change! = Change! - 3.141593
					IF Change! > 1.570796 THEN Change! = Change! - 3.141593
					IF Change! > 1.570796 THEN Change! = Change! - 3.141593
					IF Change! < -1.570796 THEN Change! = Change! + 3.141593
					IF Change! < -1.570796 THEN Change! = Change! + 3.141593
					IF Change! < -1.570796 THEN Change! = Change! + 3.141593
					IF Change! < -1.570796 THEN Change! = Change! + 3.141593
					Heading! = OldHead! + Change!
					'make list of nodes, elements, faults to be redrafted
					NItsOn% = 4
					NOn%(1) = n1%: NOn%(2) = n2%: NOn%(3) = n3%: NOn%(4) = n4%
					NMemo%(n1%) = 1: NMemo%(n2%) = 2: NMemo%(n3%) = 2: NMemo%(n4%) = 1
					FOR k% = 1 TO NUMNOD%  'find other nodes sharing same spot
						IF (NodeABG!(1, k%) = NodeABG!(1, n1%)) AND (NodeABG!(2, k%) = NodeABG!(2, n1%)) AND (NodeABG!(3, k%) = NodeABG!(3, n1%)) THEN
							IF (k% <> n1%) AND (k% <> n4%) THEN
								NItsOn% = NItsOn% + 1
								NOn%(NItsOn%) = k%
								NMemo%(k%) = 1
							END IF
						END IF
						IF (NodeABG!(1, k%) = NodeABG!(1, n2%)) AND (NodeABG!(2, k%) = NodeABG!(2, n2%)) AND (NodeABG!(3, k%) = NodeABG!(3, n2%)) THEN
							IF (k% <> n2%) AND (k% <> n3%) THEN
								NItsOn% = NItsOn% + 1
								NOn%(NItsOn%) = k%
								NMemo%(k%) = 2
							END IF
						END IF
					NEXT k%
					EItsOn% = 0
					FOR k% = 1 TO NItsOn%
						s1% = 1
H3:
						CALL OnAnyE(Ins, NOn%(k%), s1%, NUMEL%, NODES%(), Outs, ie%, je%)
						IF ie% > 0 THEN
							GotIt% = FALSE%
							FOR m% = 1 TO EItsOn%
								IF EOn%(m%) = ie% THEN GotIt% = TRUE%
							NEXT m%
							IF GotIt% THEN
							ELSE
								EItsOn% = EItsOn% + 1
								EOn%(EItsOn%) = ie%
							END IF
							IF ie% < NUMEL% THEN
								s1% = ie% + 1
								GOTO H3
							END IF
						END IF
					NEXT k%
					FItsOn% = 0
					FOR k% = 1 TO NItsOn%
						s1% = 1
H4:
						CALL OnAnyF(Ins, NOn%(k%), s1%, NFL%, NODEF%(), Outs, ie%, je%)
						IF ie% > 0 THEN
							GotIt% = FALSE%
							FOR m% = 1 TO FItsOn%
								IF FOn%(m%) = ie% THEN GotIt% = TRUE%
							NEXT m%
							IF GotIt% THEN
							ELSE
								FItsOn% = FItsOn% + 1
								FOn%(FItsOn%) = ie%
							END IF
							IF ie% < NFL% THEN
								s1% = ie% + 1
								GOTO H4
							END IF
						END IF
					NEXT k%
					'undraft these things in black
					FOR k% = 1 TO FItsOn%
						CALL DrawFault(FDIP!(), FOn%(k%), NODEF%(), 0, NodeABG!())
					NEXT k%
					FOR k% = 1 TO EItsOn%
						CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), EOn%(k%), IData%, Logs%, Mus!(), NODES%(), Redo%, 0, NodeABG!())
					NEXT k%
					FOR k% = 1 TO NItsOn%
						CALL DrawNode(NOn%(k%), 0, NodeABG!())
					NEXT k%
					'correct node positions
					r! = .5 * SQR(TempV2!(1) ^ 2 + TempV2!(2) ^ 2 + TempV2!(3) ^ 2)
					r! = r! / SQR(1! - r! ^ 2)
					TempV2!(1) = TempVec!(1) + r! * (COS(Heading!) * TempV4!(1) + SIN(Heading!) * TempV3!(1))
					TempV2!(2) = TempVec!(2) + r! * (COS(Heading!) * TempV4!(2) + SIN(Heading!) * TempV3!(2))
					TempV2!(3) = TempVec!(3) + r! * (COS(Heading!) * TempV4!(3) + SIN(Heading!) * TempV3!(3))
					CALL UnitVec(Mods, TempV2!())
					FOR m% = 1 TO NItsOn%
						k% = NOn%(m%)
						IF NMemo%(k%) = 2 THEN
							NMemo%(k%) = 0
							NodeABG!(1, k%) = TempV2!(1)
							NodeABG!(2, k%) = TempV2!(2)
							NodeABG!(3, k%) = TempV2!(3)
						END IF
					NEXT m%
					TempV2!(1) = TempVec!(1) - r! * (COS(Heading!) * TempV4!(1) + SIN(Heading!) * TempV3!(1))
					TempV2!(2) = TempVec!(2) - r! * (COS(Heading!) * TempV4!(2) + SIN(Heading!) * TempV3!(2))
					TempV2!(3) = TempVec!(3) - r! * (COS(Heading!) * TempV4!(3) + SIN(Heading!) * TempV3!(3))
					CALL UnitVec(Mods, TempV2!())
					FOR m% = 1 TO NItsOn%
						k% = NOn%(m%)
						IF NMemo%(k%) = 1 THEN
							NMemo%(k%) = 0
							NodeABG!(1, k%) = TempV2!(1)
							NodeABG!(2, k%) = TempV2!(2)
							NodeABG!(3, k%) = TempV2!(3)
						END IF
					NEXT m%
					'redraft in correct positions and colors
					FOR k% = 1 TO NItsOn%
						CALL DrawNode(NOn%(k%), NodeC1%, NodeABG!())
					NEXT k%
					FOR k% = 1 TO EItsOn%
						CALL Flipped(Ins, EOn%(k%), NODES%(), NodeABG!(), Outs, EMemo%())
						CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), EOn%(k%), IData%, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
					NEXT k%
					FOR k% = 1 TO FItsOn%
						CALL DrawFault(FDIP!(), FOn%(k%), NODEF%(), FaultC1%, NodeABG!())
					NEXT k%
					ChangesInRAM% = TRUE%
				END IF
				GOSUB MouseOn
			ELSE  'cursor didnt hit any fault center
				BEEP
			END IF
		END IF
		GOTO H1
	ELSE   'a key was pressed; prepare the exit the command
		CALL Blanker(25, 25, 15, 65)
	END IF
ELSEIF Current$ = "P" THEN        'Perimeter test
	IF NUMEL% > 0 THEN
		CALL CIRCUIT(Ins, MXBN%, NFL%, NUMEL%, Mods, EQCM!(), NFAKEN%, NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, NodeABG!(), Outs, FAILED%, NCOND%, NODCON%(), Work, FMemo%(), EMemo%())
		IF FAILED% THEN
			CALL WaitForKey(CommandKey$)
			IF ASC(CommandKey$) = 13 THEN CommandKey$ = ""
		ELSE
			CALL Blanker(16, 24, 2, 79)
			'(use mean vector as an approximate center)
			TempVec!(1) = 0!: TempVec!(2) = 0!: TempVec!(3) = 0!
			FOR i% = 1 TO NUMNOD%
				TempVec!(1) = TempVec!(1) + NodeABG!(1, i%)
				TempVec!(2) = TempVec!(2) + NodeABG!(2, i%)
				TempVec!(3) = TempVec!(3) + NodeABG!(3, i%)
			NEXT i%
			CALL UnitVec(Mods, TempVec!())
			'form triangles using one side sement and center point
			Within# = 0#
			IF NCOND% > 0 THEN
				LOCATE 17, 13
				PRINT "Area within perimeter = "
				TempV2!(1) = NodeABG!(1, NODCON%(NCOND%))
				TempV2!(2) = NodeABG!(2, NODCON%(NCOND%))
				TempV2!(3) = NodeABG!(3, NODCON%(NCOND%))
				FOR i% = 1 TO NCOND%
					TempV3!(1) = NodeABG!(1, NODCON%(i%))
					TempV3!(2) = NodeABG!(2, NODCON%(i%))
					TempV3!(3) = NodeABG!(3, NODCON%(i%))
					CALL Sterradians(Ins, TempVec!(), TempV2!(), TempV3!(), Outs, SolidAngle!)
					Within# = Within# + CDBL(SolidAngle!)
					LOCATE 17, 37
					PRINT USING "+#.######^^^^^ steradians"; Within#
					TempV2!(1) = TempV3!(1)
					TempV2!(2) = TempV3!(2)
					TempV2!(3) = TempV3!(3)
				NEXT i%
			ELSE
				Within# = 12.56637061#  '4 Pi steradians, a whole sphere
				LOCATE 17, 13
				PRINT "Area of sphere        = "
				LOCATE 17, 37
				PRINT USING "+#.######^^^^^ steradians"; Within#
			END IF
			LOCATE 19, 13
			PRINT "Sum of element areas  = "
			SumArea# = 0#
			FOR i% = 1 TO NUMEL%
				n1% = NODES%(1, i%)
				TempVec!(1) = NodeABG!(1, n1%)
				TempVec!(2) = NodeABG!(2, n1%)
				TempVec!(3) = NodeABG!(3, n1%)
				n2% = NODES%(2, i%)
				TempV2!(1) = NodeABG!(1, n2%)
				TempV2!(2) = NodeABG!(2, n2%)
				TempV2!(3) = NodeABG!(3, n2%)
				n3% = NODES%(3, i%)
				TempV3!(1) = NodeABG!(1, n3%)
				TempV3!(2) = NodeABG!(2, n3%)
				TempV3!(3) = NodeABG!(3, n3%)
				CALL Sterradians(Ins, TempVec!(), TempV2!(), TempV3!(), Outs, SolidAngle!)
				SumArea# = SumArea# + CDBL(ABS(SolidAngle!))
				LOCATE 19, 37
				PRINT USING "+#.######^^^^^ steradians"; SumArea#
			NEXT i%
			IF Within# < 0# OR SumArea# < 0# THEN
				LOCATE 20, 9
				PRINT "A negative area suggests that many elements were defined backwards."
				LOCATE 21, 9
				PRINT "Delete any elements with an X and redefine them counterclockwise."
			ELSE
				X! = CSNG(Within#): Y! = CSNG(SumArea#)
				IF X! = Y! THEN
					LOCATE 21, 23: PRINT "Areas agree, within expected precision."
				ELSE
					Z! = ABS(X! - Y!)
					Zpc! = 100! * Z! / Y!
					LOCATE 21, 13
					PRINT USING "Discrepancy is +#.##^^^^ steradians, or ####.###%"; Z!; Zpc!
					LOCATE 21, 28: PRINT " "
					IF Zpc! > .01 THEN
						LOCATE 23, 5
						PRINT "Check for overlapped or missing elements with command View.";
					END IF
				END IF
			END IF
			CALL WaitForKey(CommandKey$)
			IF ASC(CommandKey$) = 13 THEN CommandKey$ = ""
		END IF
	ELSE  'without elements there can be no perimeter or area check
		BEEP
	END IF
ELSEIF Current$ = "V" THEN       'View gaps/overlaps
	IF Colored% THEN
		NeedToDraw% = TRUE%
		ColorIn% = TRUE%
		Contour% = FALSE%
		GOSUB ToPage0
V1:       GOSUB RunPage0
		MouseClick MouseRow%, MouseCol%, Left%, Right%
		IF (Left% OR Right%) THEN 'increment color of all connected elements
			CALL XandY(Ins, MouseCol%, MouseRow%, Outs, X!, Y!)
GPBnow:
			CALL GetElement(Ins, NodeABG!(), NODES%(), NUMEL%, X!, Y!, Outs, j%, R2MIN!)
			IF R2MIN! < Tolerance! * Tolerance! THEN 'clicked on some triangle
				nH% = NODES%(1, j%)
				GOSUB MouseOff
				FOR k% = 1 TO NUMNOD%
					NMemo%(k%) = 0
				NEXT k%
				NMemo%(nH%) = 2
				FOR i% = 1 TO NUMEL%
					EMemo%(i%) = EMemo%(i%) AND 1
				NEXT i%
V2:
				GotOne% = FALSE%
				FOR i% = 1 TO NUMEL%
					IF (NMemo%(NODES%(1, i%)) = 2) OR (NMemo%(NODES%(2, i%)) = 2) OR (NMemo%(NODES%(3, i%)) = 2) THEN
						IF (EMemo%(i%) AND 2) THEN
						ELSE
							EMemo%(i%) = EMemo%(i%) OR 2
							'increment element color
							CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), i%, IData%, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
							GotOne% = TRUE%
							FOR k% = 1 TO 3
								j% = NODES%(k%, i%)
								IF NMemo%(j%) = 0 THEN
									NMemo%(j%) = 1
								END IF
							NEXT k%
						END IF
					END IF
				NEXT i%
				IF GotOne% THEN
					FOR k% = 1 TO NUMNOD%
						IF NMemo%(k%) > 0 THEN NMemo%(k%) = NMemo%(k%) + 1
					NEXT k%
					GOTO V2
				ELSE
					FOR k% = 1 TO NUMNOD%
						NMemo%(k%) = 0
					NEXT k%
					FOR i% = 1 TO NUMEL%
						EMemo%(i%) = EMemo%(i%) AND 1
					NEXT i%
					GOSUB MouseOn
				END IF
			ELSE 'click was not on an element center
				BEEP
			END IF
			GOTO V1
		END IF
	ELSE   'no color on this monitor
		BEEP
	END IF
ELSEIF Current$ = "Q" THEN    'show/edit elevation.or.mu_/Q/crust/mantle-lithosphere
	IF (NUMNOD% = 0) THEN
		BEEP
	ELSE
		LastF! = 0!
		CALL Blanker(16, 24, 2, 79)
		LOCATE 16, 8: PRINT "Any of the following can be displayed using 14 color steps:";
		LOCATE 17, 15: PRINT "1 = elevation (for SHELLS) or mu_ (for RESTORE v.2)";
		LOCATE 18, 15: PRINT "2 = heat-flow (Q)";
		LOCATE 19, 15: PRINT "3 = crustal thickness";
		LOCATE 20, 15: PRINT "4 = mantle-lithosphere thickness";
Q1:       CALL Blanker(22, 22, 15, 79)
		LOCATE 22, 15: PRINT USING "Enter your choice (1-4): #"; IData%
		LOCATE 22, 40: INPUT ; "", a$
		IF a$ <> "" THEN
			n% = VAL(a$)
			IF (n% < 1) OR (n% > 4) THEN
				BEEP
				CALL Blanker(22, 22, 2, 79)
				GOTO Q1
			END IF
			IData% = n%
		END IF
		IF Colored% THEN
			Ask% = TRUE% 'just once
			CALL SetBins(Ins, Ask%, Contour%, EQCM!(), IData%, NUMEL%, NUMNOD%, Mus!(), Mods, OldBotF!, OldIData%, OldTopF!, Outs, BotF!, DFC!, Logs%, NeedToDraw%, TopF!)
			Ask% = FALSE%
			Contour% = TRUE%
			DoIcon% = FALSE%
		END IF
		ColorIn% = FALSE%
		GOSUB ToPage0
Q3:       GOSUB RunPage0
		MouseClick MouseRow%, MouseCol%, Left%, Right%
		IF Left% OR Right% THEN
			row% = MouseRow%
			col% = MouseCol%
			CALL XandY(Ins, col%, row%, Outs, X!, Y!)
			NItsOn% = 0
			EItsOn% = 0
			FItsOn% = 0
			n1% = 1
Q4:            CALL Exists(Ins, n1%, NUMNOD%, X!, Y!, NodeABG!(), Tolerance!, Outs, nH%)
			IF nH% > 0 THEN
				NItsOn% = NItsOn% + 1
				NOn%(NItsOn%) = nH%
				e1% = 1
Q5:                 CALL OnAnyE(Ins, nH%, e1%, NUMEL%, NODES%(), Outs, ie%, je%)
				IF ie% > 0 THEN
					EItsOn% = EItsOn% + 1
					EOn%(EItsOn%) = ie%
					IF ie% < NUMEL% THEN
						e1% = ie% + 1
						GOTO Q5
					END IF
				END IF
				f1% = 1
Q6:                 CALL OnAnyF(Ins, nH%, f1%, NFL%, NODEF%(), Outs, ie%, je%)
				IF ie% > 0 THEN
					FItsOn% = FItsOn% + 1
					FOn%(FItsOn%) = ie%
					IF ie% < NFL% THEN
						f1% = ie% + 1
						GOTO Q6
					END IF
				END IF
				IF n1% < NUMNOD% THEN
					n1% = nH% + 1
					GOTO Q4
				END IF
			END IF
			IF NItsOn% = 0 THEN
				BEEP
			ELSE
				IF Colored% THEN COLOR Foreground%
				CALL Blanker(lines%, lines%, 19, 60)
				LOCATE lines%, 20: PRINT "Value: "; EQCM!(IData%, NOn%(1)); "; Change?: ";
				INPUT ; "", a$
				IF a$ <> "" THEN
					IF a$ = "'" THEN
						F! = LastF!
					ELSE
						F! = VAL(a$)
						LastF! = F!
					END IF
					IF (IData% > 1) AND (F! < 0!) THEN
						BEEP
					ELSE
						FOR k% = 1 TO NItsOn%
							EQCM!(IData%, NOn%(k%)) = F!
						NEXT k%
						ChangesInRAM% = TRUE%
						Redo% = TRUE%
						GOSUB MouseOff
						FOR i% = 1 TO EItsOn%
							CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), EOn%(i%), IData%, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
						NEXT i%
						FOR i% = 1 TO FItsOn%
							CALL DrawFault(FDIP!(), FOn%(i%), NODEF%(), FaultC1%, NodeABG!())
						NEXT i%
						GOSUB MouseOn
					END IF
				END IF
			END IF
			GOTO Q3
		END IF
	END IF
ELSEIF Current$ = "U" THEN    'show/edit Mus!(1-3, i%)
	IF (NUMEL% = 0) THEN
		BEEP
	ELSE
		LastF! = 0!
		CALL Blanker(16, 24, 2, 79)
		LOCATE 16, 8: PRINT "Any of the following can be displayed using 14 color steps:";
		LOCATE 17, 15: PRINT "1 = recent  strain-rate tolerance (/s)";
		LOCATE 18, 15: PRINT "2 = recent/ancient transition age (Ma)";
		LOCATE 19, 15: PRINT "3 = ancient strain-rate tolerance (/s)";
U1:       CALL Blanker(22, 22, 15, 79)
		LOCATE 22, 15: PRINT USING "Enter your choice (1-3): #"; IMus%
		LOCATE 22, 40: INPUT ; "", a$
		IF a$ <> "" THEN
			n% = VAL(a$)
			IF (n% < 1) OR (n% > 3) THEN
				BEEP
				CALL Blanker(22, 22, 2, 79)
				GOTO U1
			END IF
			IMus% = n%
		END IF
		IF Colored% THEN
			Ask% = TRUE% 'just once
			CALL SetBins(Ins, Ask%, Contour%, EQCM!(), IMus% + 4, NUMEL%, NUMNOD%, Mus!(), Mods, OldBotF!, OldIData%, OldTopF!, Outs, BotF!, DFC!, Logs%, NeedToDraw%, TopF!)
			Ask% = FALSE%
			Contour% = TRUE%
			IData% = IMus% + 4
			DoIcon% = FALSE%
		END IF
		ColorIn% = FALSE%
		GOSUB ToPage0
U3:       GOSUB RunPage0
		MouseClick MouseRow%, MouseCol%, Left%, Right%
		IF Left% OR Right% THEN
			MouseXYB row%, col%, MouseLeft%, MouseRight%
			CALL XandY(Ins, col%, row%, Outs, X!, Y!)
			CALL GetElement(Ins, NodeABG!(), NODES%(), NUMEL%, X!, Y!, Outs, j%, R2MIN!)
			IF R2MIN! < Tolerance! * Tolerance! THEN
				IF Colored% THEN COLOR Foreground%
				CALL Blanker(lines%, lines%, 19, 60)
				LOCATE lines%, 20: PRINT "Value: "; Mus!(IMus%, j%); "; Change?: ";
				INPUT ; "", a$
				IF a$ <> "" THEN
					IF a$ = "'" THEN
						F! = LastF!
					ELSE
						F! = VAL(a$)
						LastF! = F!
					END IF
					IF (IMus% <> 2) AND (F! < 0!) THEN
						BEEP
					ELSE
						Mus!(IMus%, j%) = F!
						ChangesInRAM% = TRUE%
						Redo% = TRUE%
						GOSUB MouseOff
						CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), j%, IMus% + 4, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
						GOSUB MouseOn
					END IF ' legal value typed
				END IF ' new value typed
			ELSE ' not near a centroid
				BEEP
			END IF 'near or not near a centroid
			GOTO U3
		END IF 'Left% OR Right%
	END IF ' NUMEL% > 0
END IF
'
'common collector after any command is completed:
Collector:
GOSUB MouseOff
SCREEN BestMode%, , HighPage%, HighPage%
PageNow% = HighPage%
IF Colored% THEN
	IF BestMode% <= 10 THEN
		COLOR Foreground%, Background%
	ELSE
		COLOR Foreground%
	END IF
END IF
IF HighPage% = 0 THEN NeedMenu% = TRUE%
GOTO CommandLoop
'
'===============================================================
'
'Entry to this section is by GOSUB ToPage0
'switches to the graphics screen, if necessary
ToPage0:
SCREEN BestMode%, , 0, 0
PageNow% = 0
IF Colored% THEN
	IF BestMode% <= 10 THEN
		COLOR White%, 0  'black background
	ELSE
		COLOR White%
	END IF
END IF
IF HighPage% = 0 THEN
	NeedToDraw% = TRUE%
ELSE
	LOCATE 1, 80: PRINT LEFT$(Current$, 1);
END IF
GOSUB MouseOn
MouseClick MouseRow%, MouseCol%, Left%, Right% 'clear any old mouse clicks
RETURN
'
'================================================================
RunPage0:
'
DO     ' "endless" loop
'
'    (1) Update(?) Lat and Lon coordinates printed in corner(s).
'
	MouseXYB row%, col%, MouseLeft%, MouseRight%
	IF (col% <> OldCol%) OR (row% <> OldRow%) THEN
		IF Colored% THEN COLOR White%
		CALL XandY(Ins, col%, row%, Outs, X!, Y!)
		Which% = 1
		CALL XY2LonLat(Ins, Which%, X!, Y!, Outs, Outside%, Lon!, Lat!)
		IF Outside% THEN
			LOCATE lines% - 1, 1: PRINT "             ";
			LOCATE lines%, 1: PRINT "             ";
		ELSE
			IF Lat! >= 0! THEN
				LatD! = Lat! * 57.2958
				NorS$ = " N"
			ELSE
				LatD! = -Lat! * 57.2958
				NorS$ = " S"
			END IF
			IF Lon! >= 0! THEN
				LonD! = Lon! * 57.2958
				EorW$ = " E"
			ELSE
				LonD! = -Lon! * 57.2958
				EorW$ = " W"
			END IF
			LOCATE lines% - 1, 1: PRINT USING "Lat= ##.###"; LatD!; : PRINT NorS$;
			LOCATE lines%, 1: PRINT USING "Lon=###.###"; LonD!; : PRINT EorW$;
		END IF
		IF Using2nd% THEN
			Which% = 2
			CALL XY2LonLat(Ins, Which%, X!, Y!, Outs, Outside%, Lon!, Lat!)
			IF Outside% THEN
				LOCATE lines% - 1, 67: PRINT "              ";
				LOCATE lines%, 67: PRINT "              ";
			ELSE
				IF Lat! >= 0! THEN
					LatD! = Lat! * 57.2958
					NorS$ = " N"
				ELSE
					LatD! = -Lat! * 57.2958
					NorS$ = " S"
				END IF
				IF Lon! >= 0! THEN
					LonD! = Lon! * 57.2958
					EorW$ = " E"
				ELSE
					LonD! = -Lon! * 57.2958
					EorW$ = " W"
				END IF
				LOCATE lines% - 1, 67: PRINT USING "Lat'= ##.###"; LatD!; : PRINT NorS$;
				LOCATE lines%, 67: PRINT USING "Lon'=###.###"; LonD!; : PRINT EorW$;
			END IF
		END IF
		OldCol% = col%: OldRow% = row%
		IF ((Current$ = "N") OR (Current$ = "A")) THEN ' identify node(s) nearest to mouse
			IF NUMNOD% > 0 THEN
				CALL Nearest(Ins, NodeABG!(), NUMNOD%, X!, Y!, Outs, NumNear%, NearOnes%())
				IF Outside% THEN
					CALL Blanker(lines% - 1, lines% - 1, 27, 67)
				ELSE
					LOCATE lines% - 1, 27: PRINT "Nearest ";
					LOCATE lines% - 1, 35: PRINT USING "node(s): ##### ##### #####"; NearOnes%(1); NearOnes%(2); NearOnes%(3);
				END IF
			END IF
		END IF
	END IF
'
'    (2) Check for mouse button or key action, and return if any
'
	MouseXYB MouseRow%, MouseCol%, Left%, Right%
	IF Left% OR Right% THEN
		RETURN
	END IF
	CommandKey$ = INKEY$
	IF LEN(CommandKey$) > 0 THEN
		RETURN
	END IF
'
'    (3) Clear screen (and initialize flags) if NeedToDraw%
'
	IF NeedToDraw% THEN
		NeedToDraw% = FALSE%
		Redo% = FALSE%
		CALL MousePut(0, 0)
		CLS
		NeedGrid% = GridLoaded%
		IF NeedGrid% THEN
			IF NodeC1% > 0 THEN
				NeedNodes% = TRUE%
			ELSE
				NeedNodes% = FALSE%
			END IF
			NextNode% = NUMNOD%
			NeedElements% = TRUE%
			NextElement% = NUMEL%
			NeedFaults% = TRUE%
			NextFault% = NFL%
		END IF
		NeedBase% = UsingBase%
		NeedBar% = Contour%
		IF NeedBase% THEN 'initialize file and drawing
			CLOSE #3
			OPEN BinaryN$ FOR BINARY AS #3
			GET #3, , TempVec!(1)
			GET #3, , TempVec!(2)
			GET #3, , TempVec!(3)
			IF TempVec!(1) > 1.1 THEN
				' file begins with end mark; do nothing
				LastEnd% = TRUE%
			ELSE  'start new segment with single point
				LastEnd% = FALSE%
				CALL ABG2XY(Ins, TempVec!(), Outs, Visible%, XOldBase!, YOldBase!)
				IF Visible% THEN
					CALL Pixels(Ins, XOldBase!, YOldBase!, Outs, ColOldBase%, RowOldBase%)
					IF Colored% THEN
						PSET (ColOldBase%, RowOldBase%), BaseC%
					ELSE
						PSET (ColOldBase%, RowOldBase%)
					END IF
				END IF
			END IF
		END IF
		'print current command in upper right
		LOCATE 1, 79: PRINT CHR$(221); LEFT$(Current$, 1);
		LOCATE 2, 79: PRINT CHR$(223) + CHR$(223);
		'draw outer circle of sphere, if visible
		IF WindowHeight! > 1.2 THEN
			CALL Pixels(Ins, 0!, 0!, Outs, tcol0%, trow0%)
			CALL Pixels(Ins, 1!, 0!, Outs, tcol1%, trow1%)
			radpix% = tcol1% - tcol0%
			IF Colored% THEN COLOR CircleC%
			CIRCLE (tcol0%, trow0%), radpix%
		END IF
		'
		GOSUB MouseOn
		OldCol% = 0
		OldRow% = 0
		CALL MousePut(0, 0)
	END IF
'
'   4) Add to graphics, taking only one of the following:
'      a) Draw one more node, until done.
'      b) Draw one more triangular continuum element, until done.
'      c) Draw one more fault element, until done.
'      d) Draw one more line from basemap file, until done.
'      e) Add color bar to side of figure.
'
	IF NeedGrid% THEN
		IF NeedNodes% THEN
			IF NextNode% > 0 THEN
				n% = NextNode%
				CALL DrawNode(n%, NodeC1%, NodeABG!())
				NextNode% = NextNode% - 1
			ELSE
				NeedNodes% = FALSE%
			END IF
		ELSEIF NeedElements% THEN
			IF NextElement% > 0 THEN
				CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), NextElement%, IData%, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
				NextElement% = NextElement% - 1
			ELSE
				NeedElements% = FALSE%
			END IF
		ELSEIF NeedFaults% THEN
			IF NextFault% > 0 THEN
				CALL DrawFault(FDIP!(), NextFault%, NODEF%(), FaultC1%, NodeABG!())
				NextFault% = NextFault% - 1
			ELSE
				NeedFaults% = FALSE%
			END IF
		ELSE
			NeedGrid% = FALSE%
		END IF
	ELSEIF NeedBase% THEN
		IF EOF(3) THEN
			NeedBase% = FALSE%
			CLOSE #3
		ELSE
			CALL DrawBase(BaseC%, ColOldBase%, RowOldBase%, LastEnd%)
		END IF
	ELSEIF NeedBar% THEN
		NeedBar% = FALSE%
		CALL Blanker(lines% - 6 - HiColor%, lines% - 7, 1, 12)
		COLOR Foreground%
		LOCATE lines% - 7, 3
		IF Logs% THEN
			PRINT 10! ^ BotF!
		ELSE
			PRINT BotF!;
		END IF
		xt% = CINT(.0225 * HiCol%) - 1
		FOR kc% = 2 TO HiColor%
			yb% = CSNG(HiRow%) * (CSNG(lines% - 6 - kc%) - .5) / CSNG(lines%)
			yt% = CSNG(HiRow%) * (CSNG(lines% - 5 - kc%) - .5) / CSNG(lines%)
			LINE (0, yb%)-(xt%, yt%), kc%, BF
			LOCATE lines% - 6 - kc%, 3
			F! = BotF! + (TopF! - BotF!) * CSNG(kc% - 1) / CSNG(HiColor% - 1)
			IF Logs% THEN
				F! = 10! ^ F!
			END IF
			PRINT F!;
		NEXT kc%
	END IF
'
LOOP   '  "endless" loop
'===============================================================
MouseOn:
IF NOT CursorOn% THEN
	MouseShow
	CursorOn% = TRUE%
END IF
RETURN
'
MouseOff:
IF CursorOn% THEN
	MouseHide
	CursorOn% = FALSE%
END IF
RETURN
'-------------------------
DropFault:
GOSUB MouseOff  'eliminates fault ie% from memory and image
CALL DrawFault(FDIP!(), ie%, NODEF%(), 0, NodeABG!())
IF Colored% THEN
	FDIP!(1, ie%) = 90!: FDIP!(2, ie%) = 90!
	CALL DrawFault(FDIP!(), ie%, NODEF%(), ElementC%, NodeABG!())
ELSE
	FOR m% = 1 TO 4
		n% = NODEF(m%, ie%)
		n1% = 1
F17:
		CALL OnAnyE(Ins, n%, n1%, NUMEL%, NODES%(), Outs, ke%, le%)
		IF ke% > 0 THEN
			CALL DrawElement(BotF!, ColorIn%, Contour%, DFC!, EMemo%(), EQCM!(), ke%, IData%, Logs%, Mus!(), NODES%(), Redo%, ElementC%, NodeABG!())
			IF ke% < NUMEL% THEN
				n1% = ke% + 1
				GOTO F17
			END IF
		END IF
	NEXT m%
END IF
GOSUB MouseOn
FOR m% = 1 TO 2
	n1% = NODEF%(m%, ie%)
	n2% = NODEF%(5 - m%, ie%)
	IF n1% > n2% THEN 'switch places
		i% = n1%: n1% = n2%: n2% = i%
	END IF
	IF n1% <> n2% THEN
		n% = n2%
		AKA% = n1%
		CALL DropNode(Ins, AKA%, n%, NFL%, NUMEL%, Mods, EQCM!(), NFAKEN%, NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, NodeABG!())
	END IF
NEXT m%
NFL% = NFL% - 1
NewTopology% = TRUE%
ChangesInRAM% = TRUE%
FOR i% = ie% TO NFL%
	FOR j% = 1 TO 4
		NODEF%(j%, i%) = NODEF%(j%, i% + 1)
	NEXT j%
	FOR j% = 1 TO 2
		FDIP!(j%, i%) = FDIP!(j%, i% + 1)
	NEXT j%
	FMemo%(i%) = FMemo%(i% + 1)
	OFFSET!(i%) = OFFSET!(i% + 1)
NEXT i%
RETURN
'----------------------------------