ftp.ncsa.uiuc.edu/ftp.ncsa.uiuc.edu.zip/ftp.ncsa.uiuc.edu/Contour/general.p

Text File | 2017-03-03 | 17KB | 559 lines

{$U-}
{$R-}
unit General(60);

interface
uses
    MemTypes,Quickdraw,OSIntf,ToolIntf,MacPrint,PackIntf,FixMath,Graf3D,
    Globals,utilities,Routines,ThreeD,Interf,Init;

procedure InitThings;
procedure SetUpThings;
procedure MainEventLoop;
procedure CloseThings;

implementation

procedure DealwthUpdates(Event: EventRecord); forward;

procedure InitData; forward;

procedure ReSizeWindow (theWindow : WindowPtr;
                        MouseLoc : Point);
var
    NewSize : Point;
    oldWidth,oldHeight,
    oldBottom,oldRight,
    Width : Integer;
    Height : Integer;
    R : Rect;
begin
    SetPort(theWindow);
    NewSize.v := HiWord(GrowWindow(theWindow, MouseLoc, GrowArea));
    NewSize.h := LoWord(GrowWindow(theWindow, MouseLoc, GrowArea));

    if longint(NewSize) <> 0 then begin
        Height := NewSize.v;
        Width := NewSize.h;

          {invalidate size box}
        with theWindow^.portRect do
            SetRect(R,right-ScrollBarWidth,bottom-ScrollBarWidth,right,bottom);
        InvalRect(R);

        if Height < currentGridSize then
            Height := currentGridSize; {don't let the window close on itself}
        if Width < currentGridSize then
            Width := currentGridSize;

      {now set the new size}
        SizeWindow(theWindow, Width, Height, true);   {resize this Window}

        fixPlotRect;
        fixScrollBars;
        MoveScrollBars;
    end;
end;

procedure Zoom(theWindow: WindowPtr;
                           thePt : Point; partCode: integer);

begin
    if TrackBox(theWindow,thePt,partCode) then begin
        SetPort(theWindow);
        ZoomWindow(theWindow,partCode,false);
        fixPlotRect;
        fixScrollBars;
        MoveScrollBars;
    end;
end;

{-------------------------------------------------------------------}

procedure ProcessMenu_in (CodeWord : longint);
var
    Menu_No : integer;        {menu number that was selected}
    Item_No : integer;        {item in menu that was selected}
    NameHolder : Str255;         {name holder for desk accessory or font}
    i,
    DNA : integer;        {OpenDA will never return 0, so don't care}
begin
    if CodeWord <> 0 then begin {go ahead and process the command}
        Menu_No := HiWord(CodeWord);   {get the Hi word of...}
        Item_no := LoWord(CodeWord);   {get the Lo word of...}

        case Menu_No of
        AppleMenuID :
            if Item_NO = 1 then
                DoAbout
            else begin
               GetItem(GetMHandle(AppleMenuID), Item_No, NameHolder);
               DNA := OpenDeskAcc(NameHolder);
            end;
         FileMenuID :
             case Item_No of
                   1 :
                      InitData;
                   2 : DoSave(FrontWindow);
             3 : if PrStlDialog(prRecHdl) then;
             4 : DoPrint;
                   6 :
                       Finished := True;    {quit}
                   otherwise;
            end;
         EditMenuID : begin
             if not SystemEdit(Item_No - 1) then {if not for a desk accessory}
                 case Item_No of
                 4 :
                    if FrontWindow <> nil then
                        DoScrap(FrontWindow);
                 end;
         end;
         otherwise
            ProcessContourMenu(Menu_No, Item_No);
         end; { case }
        HiliteMenu(0);               {unhilite after processing menu}
   end;

end; {of W procedure}


{-------------------------------------------------------------------}
{----- These are procedures called from the main event loop  -------}

procedure DealwthMouseDowns (Event : EventRecord);
var
    Location : integer;
    WindowPointedTo : WindowPtr;
    MouseLoc : Point;
    WindoLoc : integer;


begin
    MouseLoc := Event.Where;
    WindoLoc := FindWindow(MouseLoc, WindowPointedTo);
    case WindoLoc of

    inMenuBar :
        ProcessMenu_in(MenuSelect(MouseLoc));

    inSysWindow :
        SystemClick(Event, WindowPointedTo);

    inContent :
        if WindowPointedTo <> FrontWindow then
            ChangeWindow(WindowPointedTo)
        else
            DoContent(Event, WindowPointedTo);

    inGrow :
        if WindowPointedTo <> FrontWindow then
            ChangeWindow(WindowPointedTo)
        else
            ReSizeWindow(WindowPointedTo, MouseLoc);

    inDrag :
        if (WindowPointedTo = FrontWindow) or
           (BitAnd(event.modifiers,CmdKey) <>  0) then
            DragWindow(WindowPointedTo, MouseLoc, DragArea)
        else
            changeWindow(windowPointedTo);

    inZoomIn,
    inZoomOut :
        if WindowPointedTo <> FrontWindow then
                     ChangeWindow(WindowPointedTo)
        else
            Zoom(WindowPointedTo,MouseLoc,WindoLoc);

    inGoAway :
        if TrackGoAway(WindowPointedTo, MouseLoc) then
            closeWindow(WindowPointedTo);
    otherwise;
    end;{ of case}
end;

{-----------------------------------------------------------------------------}

procedure DealwthKeyDowns (Event : EventRecord);
var
    CharCode : char;
begin
    CharCode := char(BitAnd(Event.message, $FF));

    if BitAnd(Event.modifiers, CmdKey) = CmdKey then
      {key board command - probably a menu command}
        ProcessMenu_in(MenuKey(CharCode));
end;

{-----------------------------------------------------------------------------}

procedure DealwthActivates (Event : EventRecord);
var
    theWindow : WindowPtr;
    savePort : WindowPtr;
    i : integer;
begin
    theWindow := WindowPtr(Event.message);

    if Odd(Event.modifiers) then begin
      {then the window is becoming active}
      {and activate whatever else you need}
        setPort(theWindow);
        if theWindow = ContourWindow[windowIndex] then begin
        {the scroll bars}
            fixScrollBars;
            MoveScrollBars;
            DisableItem(PlotMenu,5);
            EnableItem(PlotMenu,6);
            EnableItem(GoodiesMenu,3);
            DrawGrowIcon(theWindow);
        end
        else begin
             EnableItem(PlotMenu,5);
             DisableItem(GoodiesMenu,3);
             DisableItem(PlotMenu,6);
        end;
        DrawControls(theWindow);
    end
    else begin
        getPort(savePort);
        setPort(theWindow);
        {deactivate whatever you need}
        {deactivate the scroll bars}
        i := 1;
        while (theWindow <> ContourWindow[i]) and
            (theWindow <> threeDWindow[i]) do
            i := i + 1;
        if theWindow = ContourWindow[i] then begin
            HideControl(HorizontalScrollBar[i]);
            HideControl(VerticalScrollBar[i]);
            DrawGrowIcon(theWindow);
        end
        else if theWindow = threeDWindow[i] then begin
            Hidecontrol(TDHBar[i]);
            HideControl(TDVBar[i]);
        end;
        setPort(savePort);

    end;


end;

{-----------------------------------------------------------------------------}

procedure DealwthUpdates {(Event : EventRecord)};
var
    UpDateWindow, savePort : WindowPtr;
    updateRect : Rect;
    updateRgn : RgnHandle;
    clipRgn : RgnHandle;
    twoDWindow : boolean;
    i : integer;
    oldGridSize : longint;

begin
    SetCursor(ClockCursor^^);
    UpDateWindow := WindowPtr(Event.message);
    GetPort(savePort);                {Save the current port}
    SetPort(UpDateWindow);      {set the port to one in Evt.msg}
    twoDWindow := false;
    i := 1;
    while not twoDWindow and (i <= maxWindows) do begin
        if UpDateWindow = ContourWindow[i] then
            twoDWindow := true;
        i := i + 1;
    end;
    if not twoDWindow then begin
        i := 1; twoDWindow := true;
        while (i <= maxWindows) and twoDWindow do begin
            if UpDateWindow = threeDWindow[i] then
                twoDWindow := false;
            i := i + 1;
        end;
    end;
    oldWindowIndex := windowIndex;
    windowIndex := i-1;
    oldGridSize := currentGridSize;
    if oldWindowIndex <> windowIndex then
        currentGridSize := gridSize[windowIndex];
    BeginUpDate(UpDateWindow);
    begin
        if twoDWindow then begin
            updateRgn := NewRgn;
            RectRgn(updateRgn, PlotRect[windowIndex]);
            SectRgn(updateRgn, UpDateWindow^.VisRgn, updateRgn);
            updateRect := updateRgn^^.rgnBBox;
            {showRgn(UpdateWindow^.cliprgn);}
            DisposeRgn(updateRgn);

            EraseRect(updateRect);
            clipRgn := newRgn;
            GetClip(clipRgn);
            ClipRect(updateRect);
            ContourPlot(updateRect);
            SetClip(clipRgn);
            disposeRgn(clipRgn);
            DrawGrowIcon(UpdateWindow);
        end
        else begin
            eraseRect(myRect[windowIndex]);
            Refresh3D;
            Prepare3DPlot;
        end;
    end;
    EndUpDate(UpDateWindow);
    if FrontWindow = UpDateWindow then
        DrawControls(UpDateWindow);
    InitCursor;
    SetPort(savePort);
    windowIndex := oldWindowIndex;
    currentGridSize := oldGridSize;
end;

{-----------------------------------------------------------------------------}

procedure MainEventStep;
var
    ProcessIt : Boolean;
begin
    SystemTask;             {so we can support Desk Accessories}
    ProcessIt := GetNextEvent(EveryEvent-keyUpMask, theEvent);

    if ProcessIt then begin
           {we'll ProcessIt}
        case theEvent.what of
        mouseDown :
            DealwthMouseDowns(theEvent);
        KeyDown :
            DealwthKeyDowns(theEvent);
        ActivateEvt :
            DealwthActivates(theEvent);
        UpDateEvt :
            DealwthUpdates(theEvent);
        otherwise;
        end; {of Case}
           if (windowIndex <> 0) and zooming[windowIndex] then
                  if not zoomed[windowIndex] then
                         zoomed[windowIndex] := true
                  else
                UnZoom;
    end;
end;


 procedure MainEventLoop;
 begin
  repeat
   MainEventStep;
  until Finished;
 end;

{-----------------------------------------------------------------------------}

procedure InitThings;

    procedure InitLocalStuff;
    var
        y : integer;
    begin
        windowIndex := 0;
        NoOfWindows := 0;
        for y := 1 to maxWindows do begin
            zooming[y] := false;
            zoomed[y] := false;
            ThreeDWindow[y] := nil;
            ContourWindow[y] := nil;
            theFile[y] := -1;
        end;
        prRecHdl := THPrint(NewHandle(SizeOf(TPrint)));
        PrOpen;
        PrintDefault(PrRecHdl);
        upHill := boolPtr(NewPtr(SizeOf(boolean)*maxWidth));

        for y := 0 to maxRows do begin
            data[y] := ArrayPtr(NewPtr(maxWidth));
            if data[y] = nil then begin
                Sysbeep(1); sysbeep(1); sysbeep(1);
            end;
              end;
        Finished := False; {set program terminator to false}
    end;

begin
   {UnLoadSeg (&_DATAINIT);}
    MoreMasters;                 {extra pointer blocks at the bottom of the heap}
    MoreMasters;                 {this is 5 X 64 master pointers}
    MoreMasters;
    MoreMasters;
    MoreMasters;
    MoreMasters;

    InitGraf(@thePort);          {create a grafport for the screen}
    InitGrf3D(@thePort3D);

     {get the cursors we use and lock them down - no clutter}
    ClockCursor := GetCursor(watchCursor);
    HLock(Handle(clockCursor));
    {show the watch while we wait for inits & setups to finish}
    SetCursor(ClockCursor^^);

     {init everything in case the app is the Startup App}

    InitFonts;                     {startup the fonts manager}
    InitWindows;                 {startup the window manager}

    InitMenus;                     {startup the menu manager}
    TEInit;                        {startup the text edit manager}
    InitDialogs(nil);              {startup the dialog manager}
    InitLocalStuff;
    FlushEvents(everyEvent, 0);     {clear events from previous program}
end;

{-----------------------------------------------------------------------------}

procedure SetupWindows;
begin
   { Create the window from information stored on the Resource file }

    ContourWindow[windowIndex] := GetNewWindow(WindResID, nil, POINTER(-1));      {Resource ID where Window info is }
            {W Mgr allocates space for W. Record}
   {set the window to be in front    }
    if ContourWindow[windowIndex] = nil then SysBeep(1);
    SetPort(ContourWindow[windowIndex]);
    fixOrigin(xOrigin[windowIndex]*currentGridSize,yOrigin[windowIndex]*currentGridSize);
    HorizontalScrollBar[windowIndex] := GetNewControl(HSBarID,ContourWindow[windowIndex]);
    VerticalScrollBar[windowIndex] := GetNewControl(VSBarID,ContourWindow[windowIndex]);
    fixPlotRect;
    fixScrollBars;
    MoveScrollBars;

end;


 procedure InitData;
 var
    reply : SFReply;
    dlgOrigin : Point;
    theTypeList : SFTypeList;
 resFileNum : integer;

 begin
    SetPt(dlgOrigin,100,100);
    theTypeList[0] := 'TEXT';
    SFGetFile(dlgOrigin,'',nil,1,theTypeList,nil,reply);
        if reply.good then begin
       if windowIndex <> 0 then begin
           gridSize[windowIndex] := currentGridSize;
           oldWindowIndex := windowIndex;
       end;
       windowIndex := windowIndex + 1;
       if windowIndex > maxWindows then
            windowIndex := 1;
       NoOfWindows := NoOfWindows + 1;
             with reply do begin
                     resultCode := FSOpen(fname,vRefNum,theFile[windowIndex]);
                     if resultCode <> 0 then begin sysbeep(1); repeat until button end;
                     resultCode := SetFPos(theFile[windowIndex],FSFromStart,0);
            resName[windowIndex] := fname;
            resFileNum := OpenResFile(fname);
            dimen[windowIndex] := dimenhandle(GetResource('crac',resID));
            if (dimen[windowIndex] = nil) or (resError = resNotFound) or button then begin
                newFile[windowIndex] := true;
                if dimen[windowIndex] <> nil then begin
                    sysbeep(1);
                    RmveResource(handle(dimen[windowIndex]));
                end;
                maxData[windowIndex] := -1;
            end
            else begin
                NewFile[windowIndex] := false;
                maxX[windowIndex] := dimen[windowIndex]^^.maxX;
                maxY[windowIndex] := dimen[windowIndex]^^.maxY;
                currentGridSize := dimen[windowIndex]^^.gridSize;
                NoOfLevels[windowIndex] := dimen[windowIndex]^^.NoOfLevels;
                xOrigin[windowIndex] := dimen[windowIndex]^^.xOrigin;
                yOrigin[windowIndex] := dimen[windowIndex]^^.yOrigin;
                minData[windowIndex] := dimen[windowIndex]^^.minData;
                maxData[windowIndex] := dimen[windowIndex]^^.maxData;
            end;
              end;
        if getITDims(maxX[windowIndex], maxY[windowIndex],currentGridSize,
                     NoOfLevels[windowIndex],xOrigin[windowIndex],yOrigin[windowIndex],
                     minData[windowIndex],maxData[windowIndex]) then begin
             if NoOfWindows = 1 then begin
                SetUpContourMenus;
                SetUpContour;
             end;
                   SetUpWindows;
                   InitTables;
        end
        else begin
            resultCode := FSClose(theFile[windowIndex]);
            windowIndex := windowIndex - 1;
            currentGridSize := gridSize[windowIndex];
            NoOfWindows := NoOfWindows - 1;

        end;
        CloseResFile(resFileNum);
        if NoOfWindows = maxWindows then
            DisableItem(FileMenu,1);
    end;
end;


{-----------------------------------------------------------------------------}

 procedure SetupLimits;
 begin
  Screen := ScreenBits.Bounds;   {set the size of the screen}
  SetRect(DragArea, Screen.left + 4, Screen.top + 24, Screen.right - 4, Screen.bottom - 4);
  SetRect(GrowArea, Screen.left, Screen.top + 24, Screen.right, Screen.bottom);
 end;

{-----------------------------------------------------------------------------}

 procedure SetupMenus;
 begin
  FileMenu := GetMenu(AppleMenuID);  {get the apple desk accessories menu}
  AddResMenu(FileMenu, 'DRVR');     {adds all names into item list}
  InsertMenu(FileMenu, 0);          {put in list held by menu manager}

  FileMenu := GetMenu(FileMenuID);   {always need this for Quiting}
  InsertMenu(FileMenu, 0);

  EditMenu := GetMenu(EditMenuID);   {always need for editing Desk Accessories}
  InsertMenu(EditMenu, 0);

  DrawMenuBar;           {all done so show the menu bar}
 end;

{-----------------------------------------------------------------------------}

 procedure SetUpThings;
 begin
  SetupMenus;
  SetupLimits;
  SetUpCursors;
  doAbout;
 end;

{-------------------------------------------------------------------------}

 procedure CloseThings;
 var
    i : integer;
 begin
    for i := 1 to maxWindows do begin
        windowIndex := i;
        if contourWindow[windowIndex] <> nil then
            CloseWindow(contourWindow[windowIndex]);
    end;
    DisposPtr(ptr(uphill));
    for i := 0 to maxRows do
        DisposPtr(ptr(data[i]));
end;

end.