|
|
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 - metrics - download
Length: 25600 (0x6400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Single_Selection_Line_Menus, seg_0046ff
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Io;
with Fonts;
with String_Utilities;
with Job;
with Editor;
with Window_Io;
with New_Keys;
with Window_Utilities;
package body Single_Selection_Line_Menus is
type Direction is (Forward, Backward);
Definition_Not_Found : exception;
package Raw renames Window_Io.Raw;
function "=" (A, B : Raw.Key) return Boolean renames Raw."=";
Inverse_Bold : constant Window_Io.Font :=
Window_Io.Font'(Window_Io.Plain, (Inverse => True, others => False));
function Make return Menu_Definition is
begin
return null;
end Make;
procedure Add (E : Element; To : in out Menu_Definition) is
Temp : Menu_Definition;
Image : constant String := Line_Image (E);
begin
if To = null then
To := new Node'(E, 1, Image (Image'First), 1, 1, null, null, null);
To.Next := To;
To.Previous := To;
else
Temp := To.Previous;
Temp.Next := new Node'(E, Temp.Elem_Number + 1, Image (Image'First),
1, 1, null, Temp, null);
Temp.Next.Next := To;
To.Previous := Temp.Next;
end if;
end Add;
function Max (X, Y : Integer) return Integer is
begin
if X > Y then
return X;
else
return Y;
end if;
end Max;
procedure Initialize_Placement (Def : in Menu_Definition;
Column_Offset : Natural;
Line_Offset : Natural;
Presentation : Layout;
Window_Size : Positive) is
Temp : Menu_Definition := Def;
Next_Line : Positive := Line_Offset + 1;
Next_Column : Positive := Column_Offset + 1;
Number_Of_Elements : Positive := Def.Previous.Elem_Number;
Num_First_Column : Positive;
Second_Column_Offset : Natural := 0;
begin
if Number_Of_Elements + Line_Offset > Window_Size then
Num_First_Column := Number_Of_Elements / 2;
Second_Column_Offset := (78 - Column_Offset) / 2;
else
Num_First_Column := Number_Of_Elements;
end if;
Temp.Line := Next_Line;
Temp.Column := Next_Column;
case Presentation is
when Vertical =>
Next_Line := Next_Line + 1;
when Horizontal =>
Next_Column := Next_Column + Line_Image (Temp.Elem)'Length + 4;
if Next_Column + Line_Image (Temp.Next.Elem)'Length > 78 then
Next_Line := Next_Line + 1;
Next_Column := Column_Offset + 1;
end if;
end case;
Temp := Temp.Next;
while Temp /= Def loop
if Temp.Elem_Number > Num_First_Column then
Num_First_Column := 99999;
Next_Line := Line_Offset + 1;
Next_Column := Second_Column_Offset + 1;
end if;
Temp.Line := Next_Line;
Temp.Column := Next_Column;
case Presentation is
when Vertical =>
if Temp.Elem_Number > Num_First_Column then
Num_First_Column := 99999;
Next_Line := Line_Offset + 1;
Next_Column := Second_Column_Offset + 1;
else
Next_Line := Next_Line + 1;
end if;
when Horizontal =>
Next_Column := Next_Column +
Line_Image (Temp.Elem)'Length + 4;
if Next_Column + Line_Image (Temp.Next.Elem)'Length >
78 then
Next_Column := Column_Offset + 1;
Next_Line := Next_Line + 1;
end if;
end case;
Temp := Temp.Next;
end loop;
end Initialize_Placement;
procedure Display (Menu_Output : Window_Type;
Def : Menu_Definition;
Title : String := "";
Column_Offset : Natural := 0;
Line_Offset : Natural := 0;
Presentation : Layout := Vertical) is
Temp_Def : Menu_Definition := Def;
Num_Lines, Num_Cols : Positive;
begin
if Def.Current_Node = null then
Def.Current_Node := Def;
end if;
Window_Io.Report_Size (Menu_Output, Num_Lines, Num_Cols);
Initialize_Placement (Def, Column_Offset, Line_Offset,
Presentation, Num_Lines);
if Title = "" then
null;
else
Window_Io.Position_Cursor
(Menu_Output, Temp_Def.Line, Temp_Def.Column);
Window_Io.Overwrite (Menu_Output, Title & ": ", Fonts.Normal);
Initialize_Placement (Def, Column_Offset + 2, Line_Offset + 2,
Presentation, Num_Lines);
end if;
Window_Io.Position_Cursor (Menu_Output, Temp_Def.Line, Temp_Def.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Temp_Def.Elem), Window_Io.Normal);
Temp_Def := Temp_Def.Next;
while Temp_Def /= Def loop
Window_Io.Position_Cursor
(Menu_Output, Temp_Def.Line, Temp_Def.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Temp_Def.Elem), Window_Io.Normal);
Temp_Def := Temp_Def.Next;
end loop;
Window_Io.Position_Cursor (Menu_Output, Temp_Def.Line, Temp_Def.Column);
end Display;
function Rotate (Def : Menu_Definition; Arg : Natural; Dir : Direction)
return Menu_Definition is
Temp : Menu_Definition := Def;
begin
case Dir is
when Forward =>
for I in 1 .. Arg loop
Temp := Temp.Next;
end loop;
when Backward =>
for I in 1 .. Arg loop
Temp := Temp.Previous;
end loop;
end case;
return Temp;
end Rotate;
function Find_Def (C : Character; Def : Menu_Definition)
return Menu_Definition is
Temp : Menu_Definition := Def;
begin
if Temp = null then
raise Definition_Not_Found;
elsif Temp.First_Char = C then
return Temp;
else
Temp := Temp.Next;
while Temp /= Def loop
if Temp.First_Char = C then
return Temp;
else
Temp := Temp.Next;
end if;
end loop;
end if;
raise Definition_Not_Found;
end Find_Def;
procedure Hang (Output_Window : Window_Io.File_Type;
Input_Window : Window_Io.File_Type;
Key : Raw.Key) is
Out_Char : Character;
begin
Window_Io.Position_Cursor (Output_Window);
Window_Io.New_Line (Output_Window, 1);
if Key = New_Keys.Up then
Editor.Window.Previous (Repeat => 1);
elsif Key = New_Keys.Down then
Editor.Window.Next (Repeat => 1);
end if;
Job.Disconnect;
Window_Utilities.Continue
(Input_Window => Input_Window,
Output_Window => Output_Window,
Prompt => "Hit Enter on this window to Reconnect",
Line => 1,
Column => 1);
end Hang;
function Get_Response (Menu_Input : Window_Type;
Menu_Output : Window_Type;
Def : Menu_Definition) return Element is
Temp_Def : Menu_Definition := Def;
Character_Stream : Raw.Stream_Type;
One_Key : Raw.Key;
Second_Key : Raw.Key;
Numeric_Arg : Natural := 0;
begin
loop
begin
Raw.Open (Character_Stream);
exit;
exception
when Io.Status_Error =>
Window_Io.Position_Cursor (Menu_Output);
Window_Io.New_Line (Menu_Output, 1);
Window_Utilities.Continue
(Input_Window => Menu_Input,
Output_Window => Menu_Output,
Prompt => "Hit Enter on this window to Reconnect",
Line => 1,
Column => 1);
end;
end loop;
loop
Window_Io.Position_Cursor
(Menu_Output, Def.Current_Node.Line, Def.Current_Node.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Def.Current_Node.Elem), Inverse_Bold);
Raw.Get (Character_Stream, One_Key);
if One_Key = New_Keys.Up or One_Key = New_Keys.Left then
Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
Def.Current_Node.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Def.Current_Node.Elem),
Window_Io.Normal);
if Numeric_Arg = 0 then
Def.Current_Node := Def.Current_Node.Previous;
else
Def.Current_Node := Rotate (Def.Current_Node,
Numeric_Arg, Backward);
Numeric_Arg := 0;
end if;
Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
Def.Current_Node.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Def.Current_Node.Elem),
Inverse_Bold);
elsif One_Key = New_Keys.Down or One_Key = New_Keys.Right then
Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
Def.Current_Node.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Def.Current_Node.Elem),
Window_Io.Normal);
if Numeric_Arg = 0 then
Def.Current_Node := Def.Current_Node.Next;
else
Def.Current_Node := Rotate (Def.Current_Node,
Numeric_Arg, Forward);
Numeric_Arg := 0;
end if;
Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
Def.Current_Node.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Def.Current_Node.Elem),
Inverse_Bold);
elsif One_Key = New_Keys.Begin_Of then
Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
Def.Current_Node.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Def.Current_Node.Elem),
Window_Io.Normal);
Def.Current_Node := Def;
Numeric_Arg := 0;
Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
Def.Current_Node.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Def.Current_Node.Elem),
Inverse_Bold);
elsif One_Key = New_Keys.C_M_Up then
Hang (Menu_Output, Menu_Input, New_Keys.Up);
elsif One_Key = New_Keys.C_M_Down then
Hang (Menu_Output, Menu_Input, New_Keys.Down);
elsif One_Key = New_Keys.Window then
Raw.Get (Character_Stream, Second_Key);
if Second_Key = New_Keys.Up then
Hang (Menu_Output, Menu_Input, New_Keys.Up);
elsif Second_Key = New_Keys.Down then
Hang (Menu_Output, Menu_Input, New_Keys.Down);
else
Window_Io.Bell (Menu_Output);
end if;
elsif New_Keys.Is_Alphabet_Key (One_Key) then
begin
Window_Io.Position_Cursor
(Menu_Output, Def.Current_Node.Line,
Def.Current_Node.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Def.Current_Node.Elem),
Window_Io.Normal);
Def.Current_Node :=
Find_Def (String_Utilities.Upper_Case
(Window_Io.Raw.Convert (One_Key)),
Def.Current_Node.Next);
exception
when Definition_Not_Found =>
Window_Io.Bell (Menu_Output);
end;
Window_Io.Position_Cursor (Menu_Output, Def.Current_Node.Line,
Def.Current_Node.Column);
Window_Io.Overwrite
(Menu_Output, Line_Image (Def.Current_Node.Elem),
Inverse_Bold);
elsif One_Key = New_Keys.User_Interrupt then
null;
Numeric_Arg := 0;
elsif One_Key = New_Keys.Definition then
Raw.Close (Character_Stream, True);
return Def.Current_Node.Elem;
elsif New_Keys.Is_Numeric_Arg_Key (One_Key) then
Numeric_Arg := (Numeric_Arg * 10) +
New_Keys.Numeric_Value (One_Key);
else
Raw.Close (Character_Stream);
Unknown_Key (One_Key, Def.Current_Node.Elem);
Raw.Open (Character_Stream);
Numeric_Arg := 0;
end if;
end loop;
end Get_Response;
procedure Highlight_Element (Menu_Output : Window_Type;
E : Element;
Def : Menu_Definition;
Font : Window_Io.Font) is
Temp : Menu_Definition := Def;
begin
if Temp = null then
null;
elsif Temp.Elem = E then
Window_Io.Position_Cursor (Menu_Output, Temp.Line, Temp.Column);
Window_Io.Overwrite (Menu_Output, Line_Image (Temp.Elem), Font);
else
Temp := Temp.Next;
while Temp /= Def loop
if Temp.Elem = E then
Window_Io.Position_Cursor
(Menu_Output, Temp.Line, Temp.Column);
Window_Io.Overwrite (Menu_Output,
Line_Image (Temp.Elem), Font);
exit;
else
Temp := Temp.Next;
end if;
end loop;
end if;
end Highlight_Element;
end Single_Selection_Line_Menus;
nblk1=18
nid=0
hdr6=30
[0x00] rec0=26 rec1=00 rec2=01 rec3=008
[0x01] rec0=00 rec1=00 rec2=18 rec3=002
[0x02] rec0=1b rec1=00 rec2=02 rec3=070
[0x03] rec0=01 rec1=00 rec2=16 rec3=010
[0x04] rec0=1d rec1=00 rec2=17 rec3=042
[0x05] rec0=00 rec1=00 rec2=03 rec3=01e
[0x06] rec0=18 rec1=00 rec2=04 rec3=02e
[0x07] rec0=00 rec1=00 rec2=14 rec3=030
[0x08] rec0=1e rec1=00 rec2=15 rec3=020
[0x09] rec0=01 rec1=00 rec2=05 rec3=016
[0x0a] rec0=1f rec1=00 rec2=06 rec3=004
[0x0b] rec0=1f rec1=00 rec2=07 rec3=034
[0x0c] rec0=1f rec1=00 rec2=08 rec3=006
[0x0d] rec0=1d rec1=00 rec2=09 rec3=048
[0x0e] rec0=01 rec1=00 rec2=13 rec3=01a
[0x0f] rec0=1a rec1=00 rec2=0a rec3=06a
[0x10] rec0=16 rec1=00 rec2=0b rec3=04c
[0x11] rec0=00 rec1=00 rec2=12 rec3=00a
[0x12] rec0=17 rec1=00 rec2=0c rec3=018
[0x13] rec0=00 rec1=00 rec2=11 rec3=014
[0x14] rec0=19 rec1=00 rec2=0d rec3=074
[0x15] rec0=18 rec1=00 rec2=0e rec3=016
[0x16] rec0=1a rec1=00 rec2=0f rec3=022
[0x17] rec0=17 rec1=00 rec2=10 rec3=000
tail 0x215004eee815c677cab89 0x42a00088462061e03