|
|
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: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Affichage, seg_048a80
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Window_Io, Fonts;
with Complements;
with Rooms, Personnages, Items;
with Le_Heros;
with Quate;
use Quate;
package body Affichage is
Ma_Fenetre : Window_Io.File_Type;
Posx, Posy : Window_Io.Line_Number := 1;
procedure Infos_Du_Personnage (Un_Personnage : String) is
begin
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 12);
Window_Io.Overwrite (Ma_Fenetre,
Personnages.Get_Comment (Un_Personnage));
Personnages.Set_Current_Personnage (Un_Personnage);
Personnages.Go_First_State;
while not Personnages.At_End_State loop
if Personnages.Get_Current_State /= "heros" then
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 25);
Window_Io.Overwrite (Ma_Fenetre, Personnages.Get_Current_State);
end if;
Personnages.Go_Next_State;
end loop;
end Infos_Du_Personnage;
procedure Infos_Heros is
begin
Window_Io.Position_Cursor (Ma_Fenetre, Posx, Posy);
Window_Io.Overwrite (Ma_Fenetre, "Heros " & Le_Heros);
Infos_Du_Personnage (Le_Heros);
Posx := Posx + 1;
end Infos_Heros;
procedure Infos_Items_Heros is
Nom_Heros : My_String.Variable_String;
Affiche_Un : Boolean := False;
begin
My_String.Append (Nom_Heros, Le_Heros);
Complements.Go_First;
while not Complements.At_End loop
if Complements."=" (Complements.Get_Current_Kind,
Complements.Item) and then
Items.Get_Position (Complements.Get_Current) =
My_String.Image (Nom_Heros) then
Posx := Posx + 1;
Affiche_Un := True;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, Posy);
Window_Io.Overwrite (Ma_Fenetre,
"avec Objet " & Complements.Get_Current);
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 12);
Window_Io.Overwrite
(Ma_Fenetre, Items.Get_Comment (Complements.Get_Current));
Items.Set_Current_Item (Complements.Get_Current);
Items.Go_First_State;
while not Items.At_End_State loop
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 25);
Window_Io.Overwrite (Ma_Fenetre, Items.Get_Current_State);
Items.Go_Next_State;
end loop;
end if;
Complements.Go_Next;
end loop;
if Affiche_Un then
Posx := Posx + 2;
else
Posx := Posx + 1;
end if;
end Infos_Items_Heros;
procedure Infos_Personnage is
Affiche_Un : Boolean := False;
begin
Complements.Go_First;
while not Complements.At_End loop
if Complements."=" (Complements.Get_Current_Kind,
Complements.Personnage) and then
not Personnages.In_State
(Complements.Get_Current, "heros") and then
Personnages.Get_Position (Complements.Get_Current) =
Rooms.Get_Current_Room then
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, Posy);
Window_Io.Overwrite (Ma_Fenetre,
"Personnage " & Complements.Get_Current);
Infos_Du_Personnage (Complements.Get_Current);
end if;
Complements.Go_Next;
end loop;
if Affiche_Un then
Posx := Posx + 2;
else
Posx := Posx + 1;
end if;
end Infos_Personnage;
procedure Infos_Item is
Affiche_Un : Boolean := False;
begin
Complements.Go_First;
while not Complements.At_End loop
if Complements."=" (Complements.Get_Current_Kind,
Complements.Item) and then
Items.Get_Position (Complements.Get_Current) =
Rooms.Get_Current_Room then
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, Posy);
Window_Io.Overwrite (Ma_Fenetre,
"Objet " & Complements.Get_Current);
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 12);
Window_Io.Overwrite
(Ma_Fenetre, Items.Get_Comment (Complements.Get_Current));
Items.Set_Current_Item (Complements.Get_Current);
Items.Go_First_State;
while not Items.At_End_State loop
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 25);
Window_Io.Overwrite (Ma_Fenetre, Items.Get_Current_State);
Items.Go_Next_State;
end loop;
end if;
Complements.Go_Next;
end loop;
if Affiche_Un then
Posx := Posx + 2;
else
Posx := Posx + 1;
end if;
end Infos_Item;
procedure Infos_Piece is
Affiche_Un : Boolean := False;
begin
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, Posy);
Window_Io.Overwrite (Ma_Fenetre,
"Piece courante : " & Rooms.Get_Current_Room);
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 18);
Window_Io.Overwrite (Ma_Fenetre,
Rooms.Get_Comment (Rooms.Get_Current_Room));
Posx := Posx + 1;
Rooms.Go_First_State;
while not Rooms.At_End_State loop
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 25);
Window_Io.Overwrite (Ma_Fenetre, Rooms.Get_Current_State);
Rooms.Go_Next_State;
end loop;
Window_Io.Position_Cursor (Ma_Fenetre, Posx + 1, Posy);
Window_Io.Overwrite (Ma_Fenetre, " Les voies : ");
Rooms.First_Communication;
while not Rooms.At_End_Communication loop
if Rooms."=" (Rooms.Get_Communication_Visibility,
Rooms.Visible) then
Posx := Posx + 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 18);
case Rooms.Get_Communication_Mode is
when Rooms.Lock =>
Window_Io.Overwrite
(Ma_Fenetre, Rooms.Get_Communication_Way &
" - fermee");
when Rooms.Unlock =>
Window_Io.Overwrite
(Ma_Fenetre, Rooms.Get_Communication_Way &
" - ouverte");
end case;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, 40);
Window_Io.Overwrite (Ma_Fenetre,
Rooms.Get_Communication_Comment);
end if;
Rooms.Next_Communication;
end loop;
if Affiche_Un then
Posx := Posx + 2;
else
Posx := Posx + 1;
end if;
end Infos_Piece;
procedure Creation is
begin
Window_Io.Create (Ma_Fenetre, Name => "Fenetre d infos");
end Creation;
procedure Les_Infos is
begin
Window_Io.Position_Cursor (Ma_Fenetre, 1, 1);
Window_Io.Delete_Lines (Ma_Fenetre, Posx);
Posx := 1;
Posy := 1;
Window_Io.Position_Cursor (Ma_Fenetre, Posx, Posy);
Infos_Heros;
Infos_Items_Heros;
Infos_Personnage;
Infos_Item;
Infos_Piece;
end Les_Infos;
procedure Destruction is
begin
Window_Io.Delete (Ma_Fenetre);
end Destruction;
end Affichage;
nblk1=c
nid=2
hdr6=14
[0x00] rec0=1d rec1=00 rec2=01 rec3=018
[0x01] rec0=19 rec1=00 rec2=09 rec3=030
[0x02] rec0=18 rec1=00 rec2=08 rec3=034
[0x03] rec0=04 rec1=00 rec2=0b rec3=00e
[0x04] rec0=18 rec1=00 rec2=03 rec3=012
[0x05] rec0=13 rec1=00 rec2=06 rec3=058
[0x06] rec0=1b rec1=00 rec2=0c rec3=016
[0x07] rec0=13 rec1=00 rec2=05 rec3=04e
[0x08] rec0=1e rec1=00 rec2=07 rec3=00e
[0x09] rec0=0c rec1=00 rec2=0a rec3=001
[0x0a] rec0=f1 rec1=e9 rec2=40 rec3=000
[0x0b] rec0=9e rec1=80 rec2=00 rec3=000
tail 0x21545f998865a5d36ab72 0x42a00088462060003
Free Block Chain:
0x2: 0000 00 04 00 be 80 0a 6e 66 6f 73 5f 49 74 65 6d 3b ┆ nfos_Item;┆
0x4: 0000 00 00 03 fc 80 27 76 65 63 20 4f 62 6a 65 74 20 ┆ 'vec Objet ┆