'DRAW3.BAS
'third module of DRAWGRID.BAS
'by Peter Bird, UCLA, 1992, 1999
'(c)Copyright 1992, 1999 by Peter Bird and the Regents of the University of California.
DECLARE FUNCTION ATAN2F! (Y!, X!)
DECLARE FUNCTION GETBIT% (NUMBER%, PLACE%)
DECLARE FUNCTION Inside% (X!, Y!, NPoly%, XPoly!(), YPoly!())
DECLARE FUNCTION Principal! (Angle!)
DECLARE SUB Blanker (R1%, R2%, C1%, C2%)
DECLARE SUB DERIV (Ins!, I%, NODES%(), POINTS!(), XNODE!(), YNODE!(), Outs!, EMemo%)
DECLARE SUB DropNode (Ins, AKA%, n%, NFL%, NUMEL%, Mods, EQCM!(), NFAKEN%, NMemo%(), NODEF%(), NODES%(), NREALN%, NUMNOD%, XNODE!(), YNODE!())
DECLARE SUB Finish (FileNum%)
DECLARE SUB IsJoined (Ins, FAZ!(), I%, NFL%, NODEF%(), Outs, FMemo%())
DECLARE SUB MidFault (Ins!, FAZ!(), I%, NODEF%(), Mods!, XNODE!(), YNODE!(), Outs!, NMemo%())
DECLARE SUB NEXTto (Ins, I%, j%, NFL%, NODEF%(), NODES%(), NUMEL%, Outs, KFAULT%, KELE%)
DECLARE SUB OnAny (Ins!, n%, n1%, NLast%, NODES%(), Outs!, ie%, je%)
DECLARE SUB Pixels (Ins!, X!, Y!, Outs!, col%, row%)
DECLARE SUB RaiseOne (Ins!, I%, NODES%(), XNODE!(), YNODE!())
DECLARE SUB SETBIT (NUMBER%, PLACE%, ONOFF%)
DECLARE SUB WaitForKey (a$)
DECLARE SUB XandY (Ins!, col%, row%, UnScale!(), Outs!, X!, Y!)
'--------------------------------------------------------------
OPTION BASE 1
'--------------------------------------------------------------------
DIM SHARED Letters(2, 14) AS STRING * 1 'Letter associated with (col,line) in menu
'---------------------------------------------------------------------
'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:
DIM FIPoint!(4)
DIM Icon1%(30), Icon2%(30)
DIM Scales!(2, 2)
COMMON SHARED Argument!, Colored%, CursorOn%, DoIcon%, FIPoint!(), HiCol%, HiColor%, HiRow%, Icon1%(), Icon2%(), LastPutC%, LastPutR%, Mantle%, R2C!, Scales!(), XatTL!, XCenter!, YatTL!, YCenter!
'---------------------------------------------------------------------

SUB FirstScreen (Ins, BestMode%, Foreground%, HotColor%, Red%, Green%, Yellow%, White%, Outs, PageNow%)
'prints introductory screen, using text characters,
'  and multiple colors if possible.
SCREEN BestMode%: CLS : LOCATE 1, 1
PageNow% = 0
IF Colored% THEN COLOR HotColor%
PRINT "                  DRAWGRID v1.G                   ";
IF Colored% THEN COLOR White%
LOCATE 1, 53: PRINT "y";
IF Colored% THEN COLOR Yellow%
PRINT "              node"
IF Colored% THEN COLOR HotColor%
PRINT "an interactive editor for finite element grids of   ";
IF Colored% THEN COLOR White%
LOCATE 2, 53: PRINT CHR$(179);
IF Colored% THEN COLOR Yellow%
PRINT "              " + CHR$(25)
IF Colored% THEN COLOR HotColor%
PRINT "6-node isoparametric triangular elements and 6-node ";
IF Colored% THEN COLOR White%
LOCATE 3, 53: PRINT CHR$(179);
IF Colored% THEN COLOR Yellow%
PRINT "     " + CHR$(4);
IF Colored% THEN COLOR Green%
PRINT CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196);
IF Colored% THEN COLOR Yellow%
PRINT CHR$(4);
IF Colored% THEN COLOR Green%
PRINT CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196);
IF Colored% THEN COLOR Yellow%
PRINT CHR$(4) + CHR$(4)
IF Colored% THEN COLOR HotColor%
PRINT "faults, all lying in the [x,y] plane, as used in";
IF Colored% THEN COLOR White%
LOCATE 4, 53: PRINT CHR$(179);
IF Colored% THEN COLOR Green%
PRINT "     "; CHR$(179);
IF Colored% THEN COLOR Red%
PRINT "                //";
IF Colored% THEN COLOR Green%
PRINT CHR$(179); ""
IF Colored% THEN COLOR HotColor%
PRINT "programs FAULTS and PLATES, by the same author.";
IF Colored% THEN COLOR White%
LOCATE 5, 53: PRINT CHR$(179);
IF Colored% THEN COLOR Green%
PRINT "     "; CHR$(179); "  element     ";
IF Colored% THEN COLOR Red%
PRINT "//  ";
IF Colored% THEN COLOR Green%
PRINT CHR$(179)
IF Colored% THEN COLOR HotColor%
PRINT "Capacity: up to 12OOO nodes, 4OOO elements,         ";
IF Colored% THEN COLOR White%
PRINT CHR$(179);
IF Colored% THEN COLOR Green%
PRINT "     "; CHR$(179);
IF Colored% THEN COLOR Red%
PRINT "            //    ";
IF Colored% THEN COLOR Green%
PRINT CHR$(179)
IF Colored% THEN COLOR HotColor%
PRINT "          and 2OOO faults (with 64O K of RAM).      ";
IF Colored% THEN COLOR White%
PRINT CHR$(179);
IF Colored% THEN COLOR Green%
PRINT "     "; CHR$(179);
IF Colored% THEN COLOR Red%
PRINT "          //      ";
IF Colored% THEN COLOR Green%
PRINT CHR$(179)
IF Colored% THEN COLOR White%
PRINT "                                                    " + CHR$(179);
IF Colored% THEN COLOR Yellow%
PRINT "     " + CHR$(4) + "        " + CHR$(4) + CHR$(4) + "        " + CHR$(4)
IF Colored% THEN COLOR HotColor%
PRINT "by Peter Bird                                       ";
IF Colored% THEN COLOR White%
PRINT CHR$(179);
IF Colored% THEN COLOR Green%
PRINT "     "; CHR$(179);
IF Colored% THEN COLOR Red%
PRINT "      //"; CHR$(27); "fault    ";
IF Colored% THEN COLOR Green%
PRINT CHR$(179)
IF Colored% THEN COLOR HotColor%
PRINT "   Department of Earth and Space Sciences           ";
IF Colored% THEN COLOR White%
PRINT CHR$(179);
IF Colored% THEN COLOR Green%
PRINT "     "; CHR$(179);
IF Colored% THEN COLOR Red%
PRINT "    //            ";
IF Colored% THEN COLOR Green%
PRINT CHR$(179)
IF Colored% THEN COLOR HotColor%
PRINT "   University of California                         ";
IF Colored% THEN COLOR White%
PRINT CHR$(179);
IF Colored% THEN COLOR Green%
PRINT "     "; CHR$(179);
IF Colored% THEN COLOR Red%
PRINT "  //              ";
IF Colored% THEN COLOR Green%
PRINT CHR$(179)
IF Colored% THEN COLOR HotColor%
PRINT "   Los Angeles, CA 9OO95                            ";
IF Colored% THEN COLOR White%
PRINT CHR$(179);
IF Colored% THEN COLOR Green%
PRINT "     "; CHR$(179);
IF Colored% THEN COLOR Red%
PRINT "//";
IF Colored% THEN COLOR Green%
PRINT "     element    " + CHR$(179)
IF Colored% THEN COLOR HotColor%
PRINT "(c)Copyright 2000 by Peter Bird and the             ";
IF Colored% THEN COLOR White%
PRINT CHR$(179);
IF Colored% THEN COLOR Yellow%
PRINT "     " + CHR$(4) + CHR$(4);
IF Colored% THEN COLOR Green%
PRINT CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196);
IF Colored% THEN COLOR Yellow%
PRINT CHR$(4);
IF Colored% THEN COLOR Green%
PRINT CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196);
IF Colored% THEN COLOR Yellow%
PRINT CHR$(4)
IF Colored% THEN COLOR HotColor%
PRINT "   Regents of the University of California          ";
IF Colored% THEN COLOR White%
PRINT CHR$(197); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196); CHR$(196);  _
CHR$(196); CHR$(196); CHR$(196); CHR$(196); " x";
IF Colored% THEN COLOR HotColor%
PRINT " "
PRINT "REQUIRES:  Microsoft-compatible serial mouse, mouse-driver program"
PRINT "           (memory-resident), a graphics card, and a graphics monitor."
PRINT "DESIRABLE: Math coprocessor, speed of 2O MHz or greater, color EGA or VGA,"
PRINT "           graphics card with enough memory to hold two graphics screens,"
PRINT "           and a hard disk."
PRINT "NOTES: (1) You never need to wait for a drawing to be completed;"
PRINT "           enter your commands as soon as you can see enough to work."
PRINT "       (2) It is very important to use utility program NUMBER to renumber"
PRINT "           the nodes when editing is done, but before using FAULTS or PLATES.";
IF Colored% THEN COLOR Foreground%
LOCATE 25, 60
PRINT "Press any key ...";
CALL WaitForKey(a$)
END SUB

SUB Interpolate (Ins, s1!, s2!, s3!, EValues!(), Outs, value!)
'interpolates within one 6-node element using 6 nodal functions;
'all input and output values are real.
f1! = -1! * s1! + 2! * s1! * s1!
f2! = -1! * s2! + 2! * s2! * s2!
f3! = -1! * s3! + 2! * s3! * s3!
f4! = 4! * s1! * s2!
f5! = 4! * s2! * s3!
f6! = 4! * s3! * s1!
value! = f1! * EValues!(1) + f2! * EValues!(2) + f3! * EValues!(3) + f4! * EValues!(4) + f5! * EValues!(5) + f6! * EValues!(6)
END SUB

SUB LineOfNumbers (Ins, Rec$, Outs, AreNumbers%)
'Evaluates one line of a .dig file to decide if it contains a number pair.
     FALSE% = 0
     TRUE% = NOT FALSE%
     a$ = LEFT$(Rec$, 2)
     IF (a$ = " +") OR (a$ = " -") THEN
          AreNumbers% = TRUE%
     ELSE
          IF (a$ = "  ") THEN
               b$ = LEFT$(Rec$, 3)
               b3$ = RIGHT$(b$, 1)
               IF (LEN(b3$) < 1) THEN b3$ = "x"
               b3% = ASC(b3$)'look for digits 0, 1, ... 9
               IF (b3% > 47) AND (b3% < 58) THEN
                    AreNumbers% = TRUE%
               ELSE
                    AreNumbers% = FALSE%
               END IF
          ELSE
               AreNumbers% = FALSE%
          END IF
     END IF
END SUB

SUB OnAnyE (Ins, n%, n1%, NLast%, NODES%(), Outs, ie%, je%)
'locate any element including the specified node n%
ie% = 0
je% = 0
FOR I% = n1% TO NLast%
     FOR j% = 1 TO 6
          IF NODES%(j%, I%) = n% THEN
               ie% = I%
               je% = j%
               EXIT SUB
          END IF
     NEXT j%
NEXT I%
END SUB

SUB OnAnyF (Ins, n%, n1%, NLast%, NODEF%(), Outs, ie%, je%)
'locate any fault including the specified node n%
ie% = 0
je% = 0
FOR I% = n1% TO NLast%
     FOR j% = 1 TO 6
          IF NODEF%(j%, I%) = n% THEN
               ie% = I%
               je% = j%
               EXIT SUB
          END IF
     NEXT j%
NEXT I%
END SUB

SUB SecondScreen (Ins, BestMode%, Foreground%, HotColor%, Outs, PageNow%)
'choice between FAULTS and PLATES formats
TheTop:
SCREEN BestMode%: CLS
PageNow% = 0
IF Colored% THEN COLOR HotColor%
LOCATE 4, 33
PRINT "DECISION POINT:";
LOCATE 5, 33
PRINT "===============";
LOCATE 7, 5
PRINT "Programs FAULTS and PLATES use slightly different file formats,";
LOCATE 8, 5
PRINT "because in FAULTS the model domain ends at the Moho, but in PLATES";
LOCATE 9, 5
PRINT "the domain ends at the asthenosphere.  Therefore, .FEG files intended";
LOCATE 10, 5
PRINT "for PLATES carry an extra nodal parameter, the lithosphere thickness.";
LOCATE 11, 5
PRINT "Even if this number is not changed by DRAWGRID, it must be carried";
LOCATE 12, 5
PRINT "in memory to remain attached to the node.";
LOCATE 15, 5
PRINT "Choose 1 for FAULTS format (crustal thickness only at each node),";
LOCATE 16, 5
PRINT "    or 2 for PLATES format (both crust and lithosphere thicknesses).";
LOCATE 18, 30
INPUT "SELECTION (1 or 2): ", Layer%
IF Layer% < 1 OR Layer% > 2 THEN
     BEEP
     GOTO TheTop
END IF
IF Layer% = 1 THEN
     Mantle% = 0 'FALSE
ELSE
     Mantle% = NOT 0 'TRUE
END IF
END SUB

SUB SetBins (Ins, Ask%, Contour%, EQCM!(), IData%, NUMNOD%, Mods, OldBotF!, OldIData%, OldTopF!, Outs, BotF!, DFC!, Logs%, NeedToDraw%, TopF!)
'Figure out best assignment of (HiColor% - 1) colors to nodal data values
'Logs% indicates that base-10 logarithmic scale should be used.
FALSE% = 0
TRUE% = NOT FALSE%
Q2:  CALL Blanker(23, 24, 2, 79)
     MaxF! = EQCM!(IData%, 1)
     MinF! = MaxF!
     FOR I% = 1 TO NUMNOD%
          IF (EQCM!(IData%, I%) > MaxF!) THEN MaxF! = EQCM!(IData%, I%)
          IF (EQCM!(IData%, I%) < MinF!) THEN MinF! = EQCM!(IData%, I%)
     NEXT I%
     IF MaxF! > MinF! THEN
          IF Ask% THEN
               LOCATE 23, 15: INPUT ; "Do you want colors to span the data range? (Yes/no): ", a$
               IF (LEFT$(a$, 1) = "N") OR (LEFT$(a$, 1) = "n") THEN
                    GetF1F2% = TRUE%
               ELSE
                    GetF1F2% = FALSE%
               END IF
          ELSE
               GetF1F2% = FALSE%
          END IF
     ELSE
          GetF1F2% = TRUE%
     END IF
     IF GetF1F2% THEN
          LOCATE 24, 15: INPUT ; "Enter lowest colored value: ", a$
          MinF! = VAL(a$)
          CALL Blanker(24, 24, 2, 79)
          LOCATE 24, 15: INPUT ; "Enter highest colored value: ", a$
          MaxF! = VAL(a$)
          IF MaxF! <= MinF! THEN
               BEEP
               GOTO Q2
          END IF
     END IF
     IF (MinF! > 0!) AND (MaxF! <= .001) THEN
          Logs% = TRUE%
          BotF! = LOG(MinF!) / LOG(10#)
          TopF! = LOG(MaxF!) / LOG(10#)
          DFC! = (TopF! - BotF!) / CSNG(HiColor% - 1)
     ELSE
          Logs% = FALSE%
          BotF! = MinF!
          TopF! = MaxF!
     END IF
     DFC! = (TopF! - BotF!) / CSNG(HiColor% - 1)
     IF (NOT Contour%) OR (IData% <> OldIData%) OR (TopF! <> OldTopF!) OR (BotF! <> OldBotF!) THEN
          NeedToDraw% = TRUE%
     END IF
     OldIData% = IData%
     OldBotF! = BotF!
     OldTopF! = TopF!
END SUB