|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 18432 (0x4800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, procedure Dtia, seg_02597b
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
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;
nblk1=11
nid=0
hdr6=22
[0x00] rec0=21 rec1=00 rec2=01 rec3=012
[0x01] rec0=00 rec1=00 rec2=11 rec3=01a
[0x02] rec0=1c rec1=00 rec2=02 rec3=06e
[0x03] rec0=19 rec1=00 rec2=03 rec3=02e
[0x04] rec0=1f rec1=00 rec2=04 rec3=024
[0x05] rec0=20 rec1=00 rec2=05 rec3=07a
[0x06] rec0=1e rec1=00 rec2=06 rec3=032
[0x07] rec0=22 rec1=00 rec2=07 rec3=00e
[0x08] rec0=1d rec1=00 rec2=08 rec3=024
[0x09] rec0=19 rec1=00 rec2=09 rec3=00e
[0x0a] rec0=21 rec1=00 rec2=0a rec3=01c
[0x0b] rec0=1e rec1=00 rec2=0b rec3=008
[0x0c] rec0=1d rec1=00 rec2=0c rec3=020
[0x0d] rec0=13 rec1=00 rec2=0d rec3=04e
[0x0e] rec0=15 rec1=00 rec2=0e rec3=02e
[0x0f] rec0=19 rec1=00 rec2=0f rec3=004
[0x10] rec0=1a rec1=00 rec2=10 rec3=001
tail 0x2172078d883a35cb6547b 0x42a00088462060003