|
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: 12288 (0x3000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Services, seg_05c2fb
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Calendar;
with Maitre;
with Gen;
package body Services is
M1 : constant := 1000;
M : constant := M1 * M1;
A : constant := 31415821;
C : constant := 1;
First_Call : Boolean := True;
type Torigine is (Non_Origine, Droite, Dessus, Gauche);
Base_Origine : Natural := Torigine'Pos (Torigine'Last);
Base_X : Natural := Gen.Max_Col;
Base_Y : Natural := Gen.Max_Col - 1;
Base_Sens : Natural := 3;
Randseed : Natural := Natural (Float (Calendar.Seconds (Calendar.Clock)) *
Float (Calendar.Day (Calendar.Clock)) *
Float (Calendar.Month (Calendar.Clock)));
function Mult (P, Q : in Natural) return Natural is
P1, P0, Q1, Q0 : Natural;
begin
P1 := P / M1;
P0 := P mod M1;
Q1 := Q / M1;
Q0 := Q mod M1;
return (((P0 * Q1 + P1 * Q0) mod M1) * M1 + P0 * Q0) mod M;
end Mult;
function Randomint (R : in Natural) return Natural is
begin
Randseed := (Mult (Randseed, A) + C) mod M;
return ((Randseed / M1) * R) / M1 + 1;
end Randomint;
function Pos_Random return Gen.Tposition is
X, Y : Natural;
Index_Sens : Natural;
Sens : Gen.Tsens;
begin
if First_Call then
Base_X := Maitre.Last_X;
Base_Y := Maitre.Last_Y - 1;
Randseed := Natural (Float (Calendar.Seconds (Calendar.Clock)) *
Float (Calendar.Day (Calendar.Clock)) *
Float (Calendar.Month (Calendar.Clock)));
First_Call := False;
end if;
Index_Sens := Randomint (Base_Sens) - 1;
case Torigine'Val (Randomint (Base_Origine)) is
when Gauche =>
X := 1;
Y := Randomint (Base_Y);
case Index_Sens is
when 1 =>
Sens := Gen.Nord_Est;
when 2 =>
Sens := Gen.Est;
when 0 =>
Sens := Gen.Sud_Est;
when others =>
Sens := Gen.Non_Sens;
end case;
when Dessus =>
X := Randomint (Base_X);
Y := 1;
case Index_Sens is
when 1 =>
Sens := Gen.Sud_Est;
when 2 =>
Sens := Gen.Sud;
when 0 =>
Sens := Gen.Sud_Ouest;
when others =>
Sens := Gen.Non_Sens;
end case;
when Droite =>
X := Gen.Max_Col;
Y := Randomint (Base_Y);
case Index_Sens is
when 1 =>
Sens := Gen.Sud_Ouest;
when 2 =>
Sens := Gen.Ouest;
when 0 =>
Sens := Gen.Nord_Ouest;
when others =>
Sens := Gen.Non_Sens;
end case;
when Non_Origine =>
Sens := Gen.Non_Sens;
end case;
return Gen.Tposition'(X => X, Y => Y, Sens => Sens);
end Pos_Random;
function Traduire (Ordre : in Character) return Gen.Tordre is
begin
case Ordre is
when ' ' =>
return Gen.Feu;
when 'e' | 'r' | 't' | 'd' | 'g' | 'c' | 'v' | 'b' =>
return Gen.Deplacement;
when others =>
return Gen.Non_Ordre;
end case;
end Traduire;
function Sens (Ordre : in Character) return Gen.Tsens is
begin
case Ordre is
when 'e' =>
return Gen.Nord_Ouest;
when 'r' =>
return Gen.Nord;
when 't' =>
return Gen.Nord_Est;
when 'd' =>
return Gen.Ouest;
when 'g' =>
return Gen.Est;
when 'c' =>
return Gen.Sud_Ouest;
when 'v' =>
return Gen.Sud;
when 'b' =>
return Gen.Sud_Est;
when others =>
return Gen.Non_Sens;
end case;
end Sens;
function To_Char (N : in Integer) return Character is
begin
case N is
when 1 =>
return '1';
when 2 =>
return '2';
when 3 =>
return '3';
when 4 =>
return '4';
when 5 =>
return '5';
when 6 =>
return '6';
when 7 =>
return '7';
when 8 =>
return '8';
when others =>
return '0';
end case;
end To_Char;
procedure Bouger_Nord (X, Y : in out Gen.Tcoordonnees;
Signal : in out Boolean) is
begin
if Y = 1 then
Y := Maitre.Last_Y - 1;
Signal := True;
else
Y := Y - 1;
end if;
end Bouger_Nord;
procedure Bouger_Sud (X, Y : in out Gen.Tcoordonnees;
Signal : in out Boolean) is
begin
if Y = Maitre.Last_Y - 1 then
Y := 1;
Signal := True;
else
Y := Y + 1;
end if;
end Bouger_Sud;
procedure Bouger_Est (X, Y : in out Gen.Tcoordonnees;
Signal : in out Boolean) is
begin
if X = Maitre.Last_X then
X := 1;
Signal := True;
else
X := X + 1;
end if;
end Bouger_Est;
procedure Bouger_Ouest (X, Y : in out Gen.Tcoordonnees;
Signal : in out Boolean) is
begin
if X = 1 then
X := Maitre.Last_X;
Signal := True;
else
X := X - 1;
end if;
end Bouger_Ouest;
procedure Calculer (Position : in out Gen.Tposition;
Sens : in Gen.Tsens;
Hors_Ecran : out Boolean) is
Signal : Boolean := False;
X : Gen.Tcoordonnees renames Position.X;
Y : Gen.Tcoordonnees renames Position.Y;
begin
case Sens is
when Gen.Sud =>
Bouger_Sud (X, Y, Signal);
when Gen.Nord =>
Bouger_Nord (X, Y, Signal);
when Gen.Est =>
Bouger_Est (X, Y, Signal);
when Gen.Ouest =>
Bouger_Ouest (X, Y, Signal);
when Gen.Sud_Est =>
Bouger_Sud (X, Y, Signal);
Bouger_Est (X, Y, Signal);
when Gen.Sud_Ouest =>
Bouger_Sud (X, Y, Signal);
Bouger_Ouest (X, Y, Signal);
when Gen.Nord_Est =>
Bouger_Nord (X, Y, Signal);
Bouger_Est (X, Y, Signal);
when Gen.Nord_Ouest =>
Bouger_Nord (X, Y, Signal);
Bouger_Ouest (X, Y, Signal);
when Gen.Non_Sens =>
null;
end case;
Hors_Ecran := Signal;
end Calculer;
end Services;
nblk1=b
nid=8
hdr6=12
[0x00] rec0=22 rec1=00 rec2=01 rec3=00a
[0x01] rec0=00 rec1=00 rec2=0a rec3=046
[0x02] rec0=1b rec1=00 rec2=03 rec3=048
[0x03] rec0=1b rec1=00 rec2=05 rec3=036
[0x04] rec0=1f rec1=00 rec2=02 rec3=014
[0x05] rec0=24 rec1=00 rec2=04 rec3=016
[0x06] rec0=23 rec1=00 rec2=0b rec3=01a
[0x07] rec0=1d rec1=00 rec2=06 rec3=02e
[0x08] rec0=12 rec1=00 rec2=07 rec3=000
[0x09] rec0=08 rec1=00 rec2=0a rec3=000
[0x0a] rec0=4b rec1=ad rec2=70 rec3=001
tail 0x2176b9bc4895c81ebe086 0x42a00088462060003
Free Block Chain:
0x8: 0000 00 09 03 fc 80 11 72 65 74 75 72 6e 20 4e 61 74 ┆ return Nat┆
0x9: 0000 00 00 00 04 80 01 3b 01 5f 4f 75 65 73 74 20 28 ┆ ; _Ouest (┆