DataMuseum.dk

top - download

    Length: 15190 (0x3b56)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
    └─ ⟦d65440be7⟧ »DATA« 
        └─⟦this⟧ 

TextFile

with System;
with Text_Io;
with Unchecked_Conversion;
with Mac_Types;
use Mac_Types;
with Quickdraw;
use Quickdraw;
with Desk, Dialogs, Dtia_Server, Events, Fonts, Memory, Menus,
     Osutils, Resources, Segload, Toolutils, Textedit, Traps, Windows;
procedure Dtia is

    Ksysenvironsversion : constant := 1;
    Kosevent : constant := Events.App4evt;
    Ksuspendresumemessage : constant := 1;
    Kresumemask : constant := 1;
    Kminheap : constant := 256 * 1024;
    Kminspace : constant := 16 * 1024;
    Kextremeneg : constant := -32768;
    Kextremepos : constant := 32767 - 1;
    Rmenubar : constant := 128;
    Raboutalert : constant := 128;
    Ruseralert : constant := 129;
    Rwindow : constant := 128;
    Mapple : constant := 128;
    Iabout : constant := 1;
    Mfile : constant := 129;
    Inew : constant := 1;
    Iclose : constant := 4;
    Iquit : constant := 12;
    Medit : constant := 130;
    Iundo : constant := 1;
    Icut : constant := 3;
    Icopy : constant := 4;
    Ipaste : constant := 5;
    Iclear : constant := 6;

    type Rectptr is access Rect;
    type Recthnd is access Rectptr;

    Gmac : Osutils.Sysenvrec;
    Ghaswaitnextevent : Boolean;
    Ginbackground : Boolean;

    function Windowptr_To_Peek is
       new Unchecked_Conversion (Source => Windowptr,
                                 Target => Windows.Windowpeek);

    function Windowptr_To_Ptr is new Unchecked_Conversion
                                        (Source => Windowptr, Target => Ptr);

    function Windowptr_To_Grafptr is
       new Unchecked_Conversion (Source => Windowptr, Target => Grafptr);

    function Longint_To_Windowptr is
       new Unchecked_Conversion (Source => Longint, Target => Windowptr);

    function Handle_To_Recthnd is new Unchecked_Conversion
                                         (Source => Handle, Target => Recthnd);

    function Address_To_Ptr is new Unchecked_Conversion
                                      (Source => System.Address, Target => Ptr);

    function Address_To_Varwindowptr is
       new Unchecked_Conversion
              (Source => System.Address, Target => Varwindowptr);

    function Ptr_To_Longint is new Unchecked_Conversion
                                      (Source => Ptr, Target => Longint);

    function Ptr_To_Windowptr is new Unchecked_Conversion
                                        (Source => Ptr, Target => Windowptr);

    function Thz_To_Longint is new Unchecked_Conversion
                                      (Source => Memory.Thz, Target => Longint);

    function Array_To_Restype is
       new Unchecked_Conversion (Source => Restypearray, Target => Restype);

    function Array_To_Ostype is
       new Unchecked_Conversion (Source => Ostypearray, Target => Ostype);


    function Trapavailable
                (Tnumber : Mac_Types.Integer; Ttype : Osutils.Traptype)
                return Boolean is
    begin
        return Osutils.Ngettrapaddress (Tnumber, Ttype) /=
                  Osutils.Gettrapaddress (Mac_Types.Integer
                                             (Traps.Unimplemented));
    end Trapavailable;

    procedure Alertuser is
        Itemhit : Mac_Types.Integer;
    begin
        Setcursor (Qd.Arrow);
        Itemhit := Dialogs.Alert (Ruseralert, null);
        Segload.Exittoshell;
    end Alertuser;

    procedure Initialize is
        Menubar : Handle;
        Window : Windowptr;
        Ignoreerror : Oserr;
        Total, Contig : Longint;
        Ignoreresult : Boolean;
        Event : Events.Eventrecord;
        Count : Mac_Types.Integer;
    begin

        Ghaswaitnextevent :=
           Trapavailable (Mac_Types.Integer (Traps.Waitnextevent),
                          Osutils.Tooltrap);
        Ginbackground := False;

        Quickdraw.Initgraf (Address_To_Ptr (Qd.Theport'Address));
        Fonts.Initfonts;
        Windows.Initwindows;
        Menus.Initmenus;
        Textedit.Teinit;
        Dialogs.Initdialogs (null);
        Quickdraw.Initcursor;

        for Count in 1 .. 3 loop
            Ignoreresult := Events.Getnextevent (Events.Everyevent, Event);
        end loop;

        Ignoreerror := Osutils.Sysenvirons (Ksysenvironsversion, Gmac);

        if Gmac.Machinetype < 0 then
            Alertuser;
        end if;

        if Ptr_To_Longint (Memory.Getappllimit) -
           Thz_To_Longint (Memory.Appliczone) < Kminheap then
            Alertuser;
        end if;

        Memory.Purgespace (Total, Contig);
        if Total < Kminspace then
            Alertuser;
        end if;

        Window := Ptr_To_Windowptr (Memory.Newptr
                                       (Windows.Windowrecord'Size / 8));
        if Window = null then
            Alertuser;
        end if;
        Window := Windows.Getnewwindow (Rwindow, Windowptr_To_Ptr (Window),
                                        Longint_To_Windowptr (-1));

        Menubar := Menus.Getnewmbar (Rmenubar);
        if Menubar = null then
            Alertuser;
        end if;
        Menus.Setmenubar (Menubar);
        Memory.Disposhandle (Menubar);
        Menus.Addresmenu (Menus.Getmhandle (Mapple),
                          Array_To_Restype (('D', 'R', 'V', 'R')));
        Menus.Drawmenubar;
    end Initialize;

    function Isdawindow (Window : Windowptr) return Boolean is
    begin
        if Window = null then
            return False;
        else
            return Windowptr_To_Peek (Window).Windowkind < 0;
        end if;
    end Isdawindow;

    function Isappwindow (Window : Windowptr) return Boolean is
    begin
        if Window = null then
            return False;
        else
            return (Windowptr_To_Peek (Window).Windowkind >=
                    Windows.Userkind) or
                   (Windowptr_To_Peek (Window).Windowkind = Windows.Dialogkind);
        end if;
    end Isappwindow;

    function Doclosewindow (Window : Windowptr) return Boolean is
    begin
        if Isdawindow (Window) then
            Desk.Closedeskacc (Windowptr_To_Peek (Window).Windowkind);
        end if;
        if Isappwindow (Window) then
            Windows.Closewindow (Window);
        end if;
        return True;
    end Doclosewindow;

    procedure Macterminate is
        Awindow : Windowptr;
        Closed : Boolean;
    begin
        Closed := True;
        loop
            Awindow := Windows.Frontwindow;
            if Awindow /= null then
                Closed := Doclosewindow (Awindow);
            end if;
            exit when (not Closed) or (Awindow = null);
        end loop;
        if Closed then
            Segload.Exittoshell;
        end if;
    end Macterminate;

    procedure Adjustmenus is
        Window : Windowptr;
        Menu : Menus.Menuhandle;
    begin
        Window := Windows.Frontwindow;

        Menu := Menus.Getmhandle (Mfile);
        if Isdawindow (Window) then
            Menus.Enableitem (Menu, Iclose);
        else
            Menus.Disableitem (Menu, Iclose);
        end if;

        Menu := Menus.Getmhandle (Medit);
        if Isdawindow (Window) then
            Menus.Enableitem (Menu, Iundo);
            Menus.Enableitem (Menu, Icut);
            Menus.Enableitem (Menu, Icopy);
            Menus.Enableitem (Menu, Ipaste);
            Menus.Enableitem (Menu, Iclear);
        else
            Menus.Disableitem (Menu, Iundo);
            Menus.Disableitem (Menu, Icut);
            Menus.Disableitem (Menu, Icopy);
            Menus.Disableitem (Menu, Iclear);
            Menus.Disableitem (Menu, Ipaste);
        end if;
    end Adjustmenus;

    procedure Domenucommand (Menuresult : Longint) is
        Menuid : Mac_Types.Integer;
        Menuitem : Mac_Types.Integer;
        Itemhit : Mac_Types.Integer;
        Daname : Str255;
        Darefnum : Mac_Types.Integer;
        Handledbyda : Boolean;
        Ignore : Boolean;
    begin
        Menuid := Toolutils.Hiword (Menuresult);
        Menuitem := Toolutils.Loword (Menuresult);
        case Menuid is
            when Mapple =>
                case Menuitem is
                    when Iabout =>
                        Itemhit := Dialogs.Alert (Raboutalert, null);
                    when others =>
                        Menus.Getitem (Menus.Getmhandle (Mapple),
                                       Menuitem, Daname);
                        Darefnum := Desk.Opendeskacc (Daname);
                end case;
            when Mfile =>
                case Menuitem is
                    when Iclose =>
                        Ignore := Doclosewindow (Windows.Frontwindow);
                    when Iquit =>
                        Macterminate;
                    when others =>
                        null;
                end case;
            when Medit =>
                Handledbyda := Desk.Systemedit (Menuitem - 1);
            when others =>
                null;
        end case;
        Menus.Hilitemenu (0);
    end Domenucommand;

    procedure Drawwindow (Window : Windowptr) is
    begin
        Setport (Windowptr_To_Grafptr (Window));

        Eraserect (Window.Portrect);
        Forecolor (Blackcolor);
        Forecolor (Blackcolor);
    end Drawwindow;

    procedure Docontentclick (Window : Windowptr; Event : Events.Eventrecord) is
    begin
        null;
    end Docontentclick;

    procedure Doupdate (Window : Windowptr) is
    begin
        if Isappwindow (Window) then
            Windows.Beginupdate (Window);
            if not Emptyrgn (Window.Visrgn) then
                Drawwindow (Window);
            end if;
            Windows.Endupdate (Window);
        end if;
    end Doupdate;

    procedure Doactivate (Window : Windowptr; Becomingactive : Boolean) is
    begin
        if Isappwindow (Window) then
            if Becomingactive then
                null;  --do whatever you need to at activation
            else
                null;  --do whatever you need to at deactivation
            end if;
        end if;
    end Doactivate;

    procedure Adjustcursor (Mouse : Point; Region : Rgnhandle) is
        Window : Windowptr;
        Arrowrgn : Rgnhandle;
        Plusrgn : Rgnhandle;
        Globalportrect : Rect;
    begin
        Window := Windows.Frontwindow;
        if (not Ginbackground) and (not Isdawindow (Window)) then
            Arrowrgn := Newrgn;
            Plusrgn := Newrgn;

            Setrectrgn (Arrowrgn, Kextremeneg, Kextremeneg,
                        Kextremepos, Kextremepos);

            if Isappwindow (Window) then
                Setport (Windowptr_To_Grafptr (Window));
                Setorigin (-Window.Portbits.Bounds.Left,
                           -Window.Portbits.Bounds.Top);
                Globalportrect := Window.Portrect;
                Rectrgn (Plusrgn, Globalportrect);
                Sectrgn (Plusrgn, Window.Visrgn, Plusrgn);
                Setorigin (0, 0);
            end if;

            Diffrgn (Arrowrgn, Plusrgn, Arrowrgn);

            if Ptinrgn (Mouse, Plusrgn) then
                Setcursor (Toolutils.Getcursor (Toolutils.Pluscursor).all.all);
                Copyrgn (Plusrgn, Region);
            else
                Setcursor (Qd.Arrow);
                Copyrgn (Arrowrgn, Region);
            end if;

            Disposergn (Arrowrgn);
            Disposergn (Plusrgn);
        end if;
    end Adjustcursor;

    procedure Doevent (Event : Events.Eventrecord) is
        Part : Mac_Types.Integer;
        Window : Windowptr;
        Hit : Boolean;
        Key : Char;
    begin
        case Event.What is
            when Events.Mousedown =>
                Part := Windows.Findwindow (Event.Where, Address_To_Varwindowptr
                                                            (Window'Address));
                case Part is
                    when Windows.Inmenubar =>
                        Adjustmenus;
                        Domenucommand (Menus.Menuselect (Event.Where));
                    when Windows.Insyswindow =>
                        Desk.Systemclick (Event, Window);
                    when Windows.Incontent =>
                        if Window /= Windows.Frontwindow then
                            Windows.Selectwindow (Window);
                            --DoEvent(event);
                        else
                            Docontentclick (Window, Event);
                        end if;
                    when Windows.Indrag =>
                        Windows.Dragwindow (Window, Event.Where,
                                            Qd.Screenbits.Bounds);
                    when Windows.Ingrow =>
                        null;
                    when Windows.Inzoomin | Windows.Inzoomout =>
                        null;
                    when others =>
                        null;
                end case;
            when Events.Keydown | Events.Autokey =>
                Key := Char'Val (Toolutils.Bitand
                                    (Event.Message, Events.Charcodemask));
                if Toolutils.Bitand
                      (Longint (Event.Modifiers), Events.Cmdkey) /= 0 then
                    if Event.What = Events.Keydown then
                        Adjustmenus;
                        Domenucommand (Menus.Menukey
                                          (Charword (Char'Pos (Key))));
                    end if;
                end if;
            when Events.Activateevt =>  
                Doactivate (Longint_To_Windowptr (Event.Message),
                            Toolutils.Bitand
                               (Mac_Types.Longint (Event.Modifiers),
                                Events.Activeflag) /= 0);
            when Events.Updateevt =>  
                Doupdate (Longint_To_Windowptr (Event.Message));
            when Kosevent =>
                case Toolutils.Bitand
                        (Toolutils.Bitshift (Event.Message, 8), 255) is
                    when Ksuspendresumemessage =>
                        Ginbackground := Toolutils.Bitand
                                            (Event.Message, Kresumemask) = 0;
                        Doactivate (Windows.Frontwindow, not Ginbackground);
                    when others =>
                        null;
                end case;
            when others =>
                null;
        end case;
    end Doevent;

    procedure Eventloop is
        Cursorrgn : Rgnhandle;
        Gotevent : Boolean;
        Event : Events.Eventrecord;
    begin  
        Dtia_Server.Launch_Server;
        Cursorrgn := Newrgn;
        loop  -- forever, or at least until SegLoad.ExitToShell
            delay 0.1;
            if Ghaswaitnextevent then
                Adjustcursor (Event.Where, Cursorrgn);
                Gotevent := Events.Waitnextevent
                               (Events.Everyevent, Event, 30, Cursorrgn);
            else
                Desk.Systemtask;
                Gotevent := Events.Getnextevent (Events.Everyevent, Event);
            end if;
            if Gotevent then
                Adjustcursor (Event.Where, Cursorrgn);
                Doevent (Event);
            end if;
        end loop;
    end Eventloop;

begin  -- dtia
    Memory.Maxapplzone;

    Initialize;

    Eventloop;
end Dtia;