|
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: 17408 (0x4400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Arithmetic, package body Easy_X, seg_00be8c, seg_00bffc
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Xlbt_Basic, Xlbt_Event, Xlbt_Window, Xlbt_Font, Xlbt_Text,
Xlbt_String, Xlbt_Arithmetic, Xlbt_Gc, Xlbt_Hint;
use Xlbt_Basic, Xlbt_Event, Xlbt_Window, Xlbt_Font, Xlbt_Text,
Xlbt_String, Xlbt_Arithmetic, Xlbt_Gc, Xlbt_Hint;
with Xlbp_Event, Xlbp_Display, Xlbp_Window, Xlbp_Font, Xlbp_Text,
Xlbp_Sync, Xlbp_Gc, Xlbp_Graphics, Xlbp_Hint, Text_Io;
use Xlbp_Event, Xlbp_Display, Xlbp_Window, Xlbp_Font, Xlbp_Text,
Xlbp_Sync, Xlbp_Gc, Xlbp_Graphics, Xlbp_Hint, Text_Io;
package body Easy_X is
type Pen is
record
X, Y : S_Short := 0;
Size : U_Short_Positive := 1;
end record;
Max_No_Flushed_Requests : constant Natural := 10;
X_Request_Count : Natural := 0;
The_Display : X_Display;
The_Screen : X_Screen_Number;
The_Root_Window, The_Main_Window : X_Window;
The_Pen : Pen;
The_Graphic_Context : X_Gc;
Black, White : X_Pixel;
The_Small_Font, The_Medium_Font, The_Large_Font, The_Current_Font :
X_Font_Struct;
procedure Set_Window_Manager_Hints (Title : String;
X, Y : S_Short;
Width, Height : U_Short_Positive) is
Success : X_Status;
Size_Hints : X_Size_Hints;
begin
Size_Hints.Flags (U_S_Position) := True;
Size_Hints.Flags (U_S_Size) := True;
Size_Hints.Width := S_Long (Width);
Size_Hints.Height := S_Long (Height);
Size_Hints.X := S_Long (X);
Size_Hints.Y := S_Long (Y);
X_Set_Wm_Properties (Display => The_Display,
Window => The_Main_Window,
Window_Name => To_X_String (Title),
Icon_Name => To_X_String (Title),
Arg_V => (1 .. 0 => null),
Normal => Size_Hints,
Wm => None_X_Wm_Hints,
Class => None_X_Class_Hint,
Status => Success);
end Set_Window_Manager_Hints;
procedure Create_Window (Title : String;
X, Y : S_Short;
Width, Height : U_Short_Positive) is
Xswa : X_Set_Window_Attributes;
begin
Xswa.Event_Mask :=
X_Event_Mask'(Button_Press_Mask |
Button_Release_Mask | Exposure_Mask => True,
others => False);
Xswa.Background_Pixel := White;
Xswa.Border_Pixel := Black;
The_Main_Window :=
X_Create_Window
(Display => The_Display,
Parent => The_Root_Window,
X => X,
Y => Y,
Width => Width,
Height => Height,
Border_Width => 0,
Depth => X_Default_Depth (The_Display, The_Screen),
Class => Input_Output,
Visual => X_Default_Visual (The_Display, The_Screen),
Values_Mask =>
(Cw_Event_Mask | Cw_Back_Pixel | Cw_Border_Pixel => True,
others => False),
Values => Xswa);
Set_Window_Manager_Hints (Title, X, Y, Width, Height);
X_Map_Window (The_Display, The_Main_Window);
end Create_Window;
procedure Create_Graphic_Context is
Xgcv : X_Gc_Values;
begin
The_Graphic_Context := X_Create_Gc
(The_Display, The_Main_Window.Drawable,
None_X_Gc_Components, None_X_Gc_Values);
X_Set_Foreground (The_Display, The_Graphic_Context, Black);
X_Set_Background (The_Display, The_Graphic_Context, White);
Xgcv.Line_Width := 1;
Xgcv.Cap_Style := Cap_Round;
X_Change_Gc
(The_Display, The_Graphic_Context,
(Gc_Line_Width | Gc_Cap_Style => True, others => False), Xgcv);
end Create_Graphic_Context;
procedure Load_The_Fonts is
begin
The_Small_Font := X_Load_Query_Font (Display => The_Display,
Name => To_X_String ("rom10"));
The_Medium_Font := X_Load_Query_Font (Display => The_Display,
Name => To_X_String ("rom14"));
The_Large_Font := X_Load_Query_Font (Display => The_Display,
Name => To_X_String ("rom28"));
end Load_The_Fonts;
procedure Open (Display : String;
Title : String := "Easy_X";
Left, Right : Coordinate := 100;
Width, Height : Dimension := 800) is
The_Name : constant X_String := X_Display_Name (To_X_String (Display));
Error : X_Error_String;
begin
X_Open_Display (The_Name, The_Display, Error);
if The_Display = None_X_Display then
Text_Io.Put_Line ("Fatal error, " & To_String (Err (Error)));
raise Fatal_Error;
end if;
The_Screen := X_Default_Screen (The_Display);
The_Root_Window := X_Root_Window (The_Display, The_Screen);
Black := X_Black_Pixel (The_Display, The_Screen);
White := X_White_Pixel (The_Display, The_Screen);
Create_Window (Title, Left, Right, Width, Height);
Load_The_Fonts;
Create_Graphic_Context;
The_Current_Font := The_Small_Font;
X_Set_Font (The_Display, The_Graphic_Context, The_Current_Font.Font_Id);
end Open;
procedure Flush_If_Needed is
begin
X_Request_Count := X_Request_Count + 1;
if X_Request_Count >= Max_No_Flushed_Requests then
X_Sync (The_Display, False);
X_Request_Count := 0;
end if;
end Flush_If_Needed;
procedure Move_To (X, Y : Coordinate) is
begin
The_Pen.X := X;
The_Pen.Y := Y;
end Move_To;
procedure Line_To (X, Y : Coordinate) is
begin
X_Draw_Line (Display => The_Display,
Drawable => The_Main_Window.Drawable,
Gc => The_Graphic_Context,
X1 => The_Pen.X,
Y1 => The_Pen.Y,
X2 => X,
Y2 => Y);
Flush_If_Needed;
The_Pen.X := X;
The_Pen.Y := Y;
end Line_To;
procedure Set_Pen (Size : Dimension) is
Xgcv : X_Gc_Values;
begin
The_Pen.Size := Size;
Xgcv.Line_Width := Size;
X_Change_Gc (The_Display, The_Graphic_Context,
(Gc_Line_Width => True, others => False), Xgcv);
end Set_Pen;
function Next_Event return Events is
Event : X_Event;
begin
loop
X_Next_Event (The_Display, Event);
if Event.Window = The_Main_Window then
case Event.Kind is
when Button_Press =>
return Button_Down;
when Button_Release =>
return Button_Up;
when Expose =>
if Event.Expose.Count = 0 then
return Update;
end if;
when others =>
null;
end case;
end if;
end loop;
end Next_Event;
procedure Set_Font (To : Fonts) is
begin
case To is
when Small_Font =>
The_Current_Font := The_Small_Font;
when Medium_Font =>
The_Current_Font := The_Medium_Font;
when Large_Font =>
The_Current_Font := The_Large_Font;
end case;
X_Set_Font (The_Display, The_Graphic_Context, The_Current_Font.Font_Id);
end Set_Font;
procedure Draw_String (The_String : String) is
Width : S_Long;
begin
X_Draw_Image_String (Display => The_Display,
Drawable => The_Main_Window.Drawable,
Gc => The_Graphic_Context,
X => The_Pen.X,
Y => The_Pen.Y,
Text => To_X_String (The_String));
Width := X_Text_Width (The_Current_Font, To_X_String (The_String));
The_Pen.X := The_Pen.X + S_Short (Width);
Flush_If_Needed;
end Draw_String;
procedure Close is
begin
X_Close_Display (The_Display);
end Close;
package body Arithmetic is
function "+" (C : Coordinate; D : Dimension) return Coordinate is
begin
return S_Short (C) + S_Short (D);
exception
when Constraint_Error =>
raise Value_Error;
end "+";
function "-" (C : Coordinate; D : Dimension) return Coordinate is
begin
return S_Short (C) - S_Short (D);
exception
when Constraint_Error =>
raise Value_Error;
end "-";
function "/" (D : Dimension; Scale : Positive) return Dimension is
begin
return U_Short_Positive (D) / U_Short_Positive (Scale);
exception
when Constraint_Error | Numeric_Error =>
raise Value_Error;
end "/";
function "*" (D : Dimension; Scale : Positive) return Dimension is
begin
return U_Short_Positive (D) * U_Short_Positive (Scale);
exception
when Constraint_Error =>
raise Value_Error;
end "*";
end Arithmetic;
end Easy_X;
nblk1=10
nid=3
hdr6=1a
[0x00] rec0=1b rec1=00 rec2=01 rec3=048
[0x01] rec0=03 rec1=00 rec2=0c rec3=04c
[0x02] rec0=12 rec1=00 rec2=09 rec3=058
[0x03] rec0=01 rec1=00 rec2=06 rec3=06e
[0x04] rec0=19 rec1=00 rec2=05 rec3=01e
[0x05] rec0=15 rec1=00 rec2=10 rec3=044
[0x06] rec0=16 rec1=00 rec2=0e rec3=06e
[0x07] rec0=18 rec1=00 rec2=04 rec3=00a
[0x08] rec0=21 rec1=00 rec2=02 rec3=05e
[0x09] rec0=21 rec1=00 rec2=0f rec3=01c
[0x0a] rec0=19 rec1=00 rec2=07 rec3=042
[0x0b] rec0=22 rec1=00 rec2=0b rec3=04c
[0x0c] rec0=07 rec1=00 rec2=0d rec3=000
[0x0d] rec0=19 rec1=00 rec2=0d rec3=000
[0x0e] rec0=18 rec1=00 rec2=0d rec3=000
[0x0f] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x21708ebbc82014433f355 0x42a00088462063c03
Free Block Chain:
0x3: 0000 00 0a 00 eb 80 09 2c 20 45 76 65 6e 74 29 3b 09 ┆ , Event); ┆
0xa: 0000 00 08 00 41 80 04 79 29 29 3b 04 00 22 20 20 20 ┆ A y)); " ┆
0x8: 0000 00 00 03 fc 80 34 20 20 20 20 20 20 20 20 20 20 ┆ 4 ┆