|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 9946 (0x26da)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
└─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16
└─ ⟦6f12a12be⟧ »DATA«
└─⟦this⟧
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04
└─ ⟦d65440be7⟧ »DATA«
└─⟦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;