|
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: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body File, package body Info, procedure Engine, seg_0046bc, separate Spreadsheet_Generic
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Editor;
with Debug_Tools;
with What;
separate (Spreadsheet_Generic)
procedure Engine (Window_Name : String := Default_Name;
Initial_File_To_Load : String := No_File_Name) is
procedure Show_Selection is new Screen.Refresh_And_Highlight
(Is_Selected => Is_Selected);
procedure Protected_Compute is
begin
if Committing_Also_Computes then
Compute; --<< provided by application
else
Screen.Banner (Status, " ...computing");
Compute; --<< provided by application
Screen.Banner (Status);
end if;
exception
when others =>
Alert ("Exception during Computation: " &
Debug_Tools.Get_Raise_Location (False, False));
Screen.Banner (Status);
end Protected_Compute;
package File is
procedure Read (Name : String);
procedure Write (Nae : String);
end File;
package Info is
procedure Display;
end Info;
procedure Process_Key (K : Keyboard.Logical_Key);
procedure Set_Up is
W : Positive;
Offset : Natural := 0;
begin
for C in Column_Type loop
W := Column_Width (C);
Actual_Column_Width (Col (C)) := W;
for L in Line_Number loop
Display (L, Col (C)) := new String'(W * ' ');
end loop;
Column_Offset (Col (C)) := Offset;
Offset := Offset + W;
end loop;
Initialize; --< provided by application
Process_Key (Keyboard.Home);
Screen.Refresh;
Screen.Mark;
end Set_Up;
procedure Commit is
Valid : Boolean := False;
Buf : constant String := Buffer.Get;
begin
if Buffer.Is_Untouched then
return;
elsif Buf'Length > 0 then
begin --< provided by application
Feed (The_Current_Line, The_Current_Column, Buf, Valid);
exception
when others =>
Valid := False;
end;
if Valid then
if Committing_Also_Computes then
Protected_Compute;
end if;
else
declare
M : constant String := Diagnosis;
begin
if M = No_Message then
Alert ("Invalid entry:" & Buf);
else
Alert (M);
end if;
end;
end if;
end if;
Screen.Refresh_End_Of_Line;
Buffer.Clear;
end Commit;
procedure Process_Key (K : Keyboard.Logical_Key) is
subtype Moves is Keyboard.Movement_Key;
use Keyboard;
Char : Character;
begin
case K is
when Help =>
Info.Display;
when Definition =>
declare
Text : constant String :=
Definition (The_Current_Line, The_Current_Column);
begin
if Text'Length > 0 then
Echo_Line (Text);
end if;
end;
when Object =>
Echo_Line ("OBJECT. ? (G to abandon, U to reset)");
if Get_Key = Ascii_Char then
Char := Get_Char;
if Char = 'g' or Char = 'G' then
raise Keyboard.Quit;
elsif Char = 'u' or Char = 'U' then
Set_Up;
end if;
end if;
when Reset =>
Beep ("Press again to confirm reset");
if Get_Key = Reset then
Set_Up;
end if;
when Edit =>
if Is_Modifiable (The_Current_Line, The_Current_Column) then
Buffer.Put (Screen.Prompt_For
(Edit_Prompt (The_Current_Line,
The_Current_Column)));
Commit;
Screen.Mark;
else
Beep;
end if;
when Window =>
Editor.Window.Join;
when Save =>
Screen.Banner (Status, "...saving");
File.Write (Save_File_Name);
Screen.Banner (Status);
when Load =>
Screen.Banner (Status, "...loading");
File.Read (Load_File_Name);
Screen.Banner (Status);
when Command =>
Command; --< application dependent command
when Show =>
Show_Selection;
when Compute =>
Commit;
Protected_Compute;
if Computing_Also_Reformats then
Screen.Refresh;
end if;
when Enter =>
Commit;
Screen.Mark;
when Time =>
What.Time;
when Format =>
Buffer.Clear;
Screen.Refresh;
Screen.Mark;
when Moves =>
declare
Next_L : Line_Type := The_Current_Line;
Next_C : Column_Type := The_Current_Column;
begin
case Moves'(K) is
when Up =>
Next_L := Line_Type'Pred (The_Current_Line);
when Down =>
Next_L := Line_Type'Succ (The_Current_Line);
when Left =>
Next_C := Column_Type'Pred (The_Current_Column);
when Right =>
Next_C := Column_Type'Succ (The_Current_Column);
when Begin_Of =>
Next_C := Column_Type'First;
when End_Of =>
Next_C := Column_Type'Last;
when Home =>
Home_Position (Next_L, Next_C);
when Bottom =>
Next_L := Line_Type'Last;
end case;
if Moving_Cursor_Also_Commits then
Commit;
else
Buffer.Clear;
end if;
Screen.Unmark;
The_Current_Line := Next_L;
The_Current_Column := Next_C;
Screen.Cursor;
Screen.Mark;
Screen.Banner (Cursor_Location);
exception
when Constraint_Error => -- illegal move
Beep;
end;
when Numeric | Ascii_Char =>
Char := Keyboard.Get_Char;
if Char = Ascii.Cr then
Process_Key (Down);
elsif Is_Modifiable (The_Current_Line, The_Current_Column) then
Buffer.Append (Char);
else
Beep;
end if;
when Erase =>
Buffer.Erase;
when Del =>
Buffer.Del;
when others =>
Beep;
end case;
end Process_Key;
package body File is separate;
package body Info is separate;
begin
Screen.Open (Window_Name);
Set_Up;
if Initial_File_To_Load /= No_File_Name then
File.Read (Initial_File_To_Load);
end if;
loop
begin
Process_Key (Keyboard.Get_Key);
exception
when Keyboard.Quit =>
Echo_Line ("Exit from " & Capitalize (Default_Name));
Screen.Unmark;
exit;
when others =>
Echo_Line ("Fatal exception in Spreadsheet.Engine " &
Debug_Tools.Get_Exception_Name);
exit;
end;
end loop;
Screen.Close;
end Engine;
nblk1=d
nid=0
hdr6=1a
[0x00] rec0=1e rec1=00 rec2=01 rec3=036
[0x01] rec0=00 rec1=00 rec2=0d rec3=002
[0x02] rec0=26 rec1=00 rec2=02 rec3=03c
[0x03] rec0=01 rec1=00 rec2=0c rec3=012
[0x04] rec0=1f rec1=00 rec2=03 rec3=004
[0x05] rec0=19 rec1=00 rec2=04 rec3=028
[0x06] rec0=19 rec1=00 rec2=05 rec3=012
[0x07] rec0=1a rec1=00 rec2=06 rec3=048
[0x08] rec0=01 rec1=00 rec2=0b rec3=004
[0x09] rec0=15 rec1=00 rec2=07 rec3=030
[0x0a] rec0=00 rec1=00 rec2=0a rec3=004
[0x0b] rec0=1d rec1=00 rec2=08 rec3=04c
[0x0c] rec0=12 rec1=00 rec2=09 rec3=000
tail 0x217002a00815c66f5f36b 0x42a00088462061e03