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: 24715 (0x608b) Types: TextFile Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11 └─ ⟦129cab021⟧ »DATA« └─⟦this⟧
with List_Generic; with Text_Io; package body Bloc is Maxi : constant := 255; type Vue_Scene is record Nom : Symbole; Vue : Pbloc := null; end record; type Vue_Bloc_Trie is record Offset_Global : Integer := -1; Vue : Pbloc := null; end record; package Liste_Offset_Globaux is new List_Generic (Vue_Bloc_Trie); package Liste_Offset_Trie is new List_Generic (Vue_Bloc_Trie); La_Liste_Offset_Globaux : Liste_Offset_Globaux.List; La_Liste_Offset_Trie : Liste_Offset_Trie.List; Un_Iter_Prive : Liste_Offset_Globaux.Iterator; Pere_Existe : Boolean := False; Liste_Nombre : Boolean; La_Liste_De_Nombre : Liste (False); La_Liste_De_Symbole : Liste (True); Compteur_Element : Integer; Vue_Liste_Action : Pgrande_Liste := null; Vue_Bloc_Pere : Pbloc := null; Vue_Courante : Pbloc := null; Memo_Bloc_Courant : array (1 .. Maxi) of Pbloc; Table_Vue_Scene : array (1 .. Maxi) of Vue_Scene; Index_Scene : Integer range 1 .. Maxi := 1; Filtre : Symbole; procedure Ajouter is begin La_Liste_Offset_Globaux := Liste_Offset_Globaux.Make (Vue_Bloc_Trie'(Vue => Vue_Courante, Offset_Global => 0), La_Liste_Offset_Globaux); Text_Io.Put_Line ("Longueur : " & Integer'Image (Liste_Offset_Globaux.Length (La_Liste_Offset_Globaux))); end Ajouter; function Va_Bloc_Pere return Boolean is begin if Vue_Courante.Le_Pere /= null then Vue_Courante := Vue_Courante.Le_Pere; return True; else return False; end if; end Va_Bloc_Pere; function Va_Bloc_Frere_Cadet return Boolean is begin if Vue_Courante.Le_Frere_Cadet /= null then Vue_Courante := Vue_Courante.Le_Frere_Cadet; return True; else return False; end if; end Va_Bloc_Frere_Cadet; function Va_Bloc_Frere_Aine return Boolean is begin if Vue_Courante.Le_Frere_Aine /= null then Vue_Courante := Vue_Courante.Le_Frere_Aine; return True; else return False; end if; end Va_Bloc_Frere_Aine; function Nouveau_Pere return Boolean is begin if Vue_Bloc_Pere = null then Vue_Bloc_Pere := new Le_Bloc; Vue_Bloc_Pere.Dernier_Bloc := False; Vue_Courante := Vue_Bloc_Pere; Liste_Offset_Globaux.Free (La_Liste_Offset_Globaux); La_Liste_Offset_Globaux := Liste_Offset_Globaux.Make (Vue_Bloc_Trie'(Vue => Vue_Courante, Offset_Global => 0), La_Liste_Offset_Globaux); return True; else return False; end if; end Nouveau_Pere; function Nouveau_Bloc_Frere_Aine return Boolean is ----ajout d'un aine Ok : Boolean := False; begin if Vue_Courante.Le_Frere_Aine = null then Vue_Courante.Dernier_Bloc := False; Vue_Courante.Le_Frere_Aine := new Le_Bloc; Vue_Courante.Le_Frere_Aine.Le_Pere := Vue_Courante.Le_Pere; Vue_Courante.Le_Frere_Aine.Profondeur := Vue_Courante.Profondeur; Vue_Courante.Le_Frere_Aine.Le_Frere_Cadet := Vue_Courante; Ok := Va_Bloc_Frere_Aine; Ajouter; Ok := Va_Bloc_Frere_Cadet; return True; else return False; end if; end Nouveau_Bloc_Frere_Aine; function Nouveau_Bloc_Frere_Cadet return Boolean is ----ajout d'un cadet Ok : Boolean := False; begin if Vue_Courante.Le_Frere_Cadet = null then Vue_Courante.Dernier_Bloc := False; Vue_Courante.Le_Frere_Cadet := new Le_Bloc; Vue_Courante.Le_Frere_Cadet.Le_Pere := Vue_Courante.Le_Pere; Vue_Courante.Le_Frere_Cadet.Profondeur := Vue_Courante.Profondeur; Vue_Courante.Le_Frere_Cadet.Le_Frere_Aine := Vue_Courante; Ok := Va_Bloc_Frere_Cadet; Ajouter; Ok := Va_Bloc_Frere_Aine; return True; else return False; end if; end Nouveau_Bloc_Frere_Cadet; function Nouveau_Bloc_Fils return Boolean is ---attention un seul fils par bloc Ok : Boolean := False; begin if Vue_Courante.Profondeur = 0 and then Vue_Courante.Le_Fils = null then Vue_Courante.Le_Fils := new Le_Bloc; Vue_Courante.Le_Fils.Le_Pere := Vue_Bloc_Pere; Vue_Courante.Le_Fils.Profondeur := 1; return True; elsif Vue_Courante.Le_Fils = null then Vue_Courante.Dernier_Bloc := False; Vue_Courante.Le_Fils := new Le_Bloc; Vue_Courante.Le_Fils.Profondeur := Vue_Courante.Profondeur + 1; Vue_Courante.Le_Fils.Le_Pere := Vue_Courante; Ok := Va_Bloc_Fils; Ajouter; Ok := Va_Bloc_Pere; return True; else return False; end if; end Nouveau_Bloc_Fils; function Dernier_Bloc return Boolean is begin return Vue_Courante.Dernier_Bloc; end Dernier_Bloc; function Va_Bloc_Fils return Boolean is begin if Vue_Courante.Le_Fils /= null then Vue_Courante := Vue_Courante.Le_Fils; return True; else return False; end if; end Va_Bloc_Fils; procedure Cherche_Case_Vide (P : in out Pgrande_Liste) is begin while P.Suivant /= null loop P := P.Suivant; end loop; end Cherche_Case_Vide; procedure Insere_Offset (Un_Temps : Integer) is begin Vue_Courante.Offset := Un_Temps; end Insere_Offset; function Donne_Offset return Integer is begin return Vue_Courante.Offset; end Donne_Offset; function Donne_Profondeur return Integer is begin return Vue_Courante.Profondeur; end Donne_Profondeur; function Scene_Existe (Un_Nom : Symbole) return Boolean is begin for I in Table_Vue_Scene'First .. Index_Scene loop if Equal (Un_Nom, Table_Vue_Scene (I).Nom) then return True; else return False; end if; end loop; end Scene_Existe; function Insere_Scene (Un_Nom : Symbole) return Boolean is begin if Index_Scene <= Table_Vue_Scene'Last then Table_Vue_Scene (Index_Scene).Nom := Un_Nom; Table_Vue_Scene (Index_Scene).Vue := Vue_Courante; Index_Scene := Index_Scene + 1; return True; else return False; end if; end Insere_Scene; function Va_Scene (Un_Nom : Symbole) return Boolean is Index : Integer; Ok : Boolean := False; begin Index := 1; while Index <= Maxi loop if Equal (Table_Vue_Scene (Index).Nom, Un_Nom) then Ok := True; Vue_Courante := Table_Vue_Scene (Index).Vue; exit; end if; Index := Index + 1; end loop; return Ok; end Va_Scene; procedure Insere_Type_Bloc (Un_Nom : Symbole) is begin Vue_Courante.Type_Bloc := Un_Nom; end Insere_Type_Bloc; function Donne_Type_Bloc return Symbole is begin return Vue_Courante.Type_Bloc; end Donne_Type_Bloc; function Donne_Nouvelle_Liste (Type_Liste : Boolean) return Pliste is begin return new Liste (Type_Liste); end Donne_Nouvelle_Liste; function Liste_Vide return Pliste is begin return null; end Liste_Vide; procedure Memorise_Bloc_Courant (I : Integer) is begin if I <= Maxi and I > 0 then Memo_Bloc_Courant (I) := Vue_Courante; end if; end Memorise_Bloc_Courant; procedure Retourne_Bloc_Memorise (I : Integer) is begin if I <= Maxi and I > 0 then if Memo_Bloc_Courant (I) /= null then Vue_Courante := Memo_Bloc_Courant (I); end if; end if; end Retourne_Bloc_Memorise; procedure Insere_Liste_Symbole (Un_Element : Symbole; Une_Valeur : Integer) is P : Pgrande_Liste := null; begin P := Vue_Courante.Liste_Symbole; if P /= null then Cherche_Case_Vide (P); P.Suivant := new Grande_Liste (False); if P.Precedent = null then P.Suivant.Precedent := P; P := P.Suivant; else P.Suivant.Precedent := P.Precedent.Suivant; P := P.Suivant; end if; else P := new Grande_Liste (False); Vue_Courante.Liste_Symbole := P; end if; P.Index := new Liste'(False, null, null, Une_Valeur); P.Contenu := Un_Element; end Insere_Liste_Symbole; procedure Insere_Liste (P : in out Pgrande_Liste; Un_Element : Symbole; Une_Liste : Liste) is begin P := Vue_Courante.Liste_Symbole; if P /= null then Cherche_Case_Vide (P); P.Suivant := new Grande_Liste (False); P.Suivant.Precedent := P; P := P.Suivant; else P := new Grande_Liste (False); Vue_Courante.Liste_Symbole := P; end if; P.Index := new Liste'(Une_Liste); P.Contenu := Un_Element; end Insere_Liste; procedure Insere_Liste_Symbole (Un_Element : Symbole; Une_Liste : Liste) is P : Pgrande_Liste := null; begin P := Vue_Courante.Liste_Symbole; Insere_Liste (P, Un_Element, Une_Liste); end Insere_Liste_Symbole; procedure Insere_Liste_Action (Un_Element : Symbole; Une_Liste : Liste) is P : Pgrande_Liste := null; begin P := Vue_Courante.Liste_Action; Insere_Liste (P, Un_Element, Une_Liste); end Insere_Liste_Action; procedure Insere_Liste_Action (Une_Action : Symbole; Un_Acteur : Symbole; De : Integer; Vers : Integer; En : Integer) is P : Pgrande_Liste := null; begin P := Vue_Courante.Liste_Action; if P /= null then Cherche_Case_Vide (P); P.Suivant := new Grande_Liste (True); P.Suivant.Precedent := P; P := P.Suivant; else Vue_Courante.Liste_Action := new Grande_Liste (True); P := Vue_Courante.Liste_Action; end if; P.Une_Action := Une_Action; P.Un_Acteur := Un_Acteur; P.De := De; P.En := En; P.Vers := Vers; end Insere_Liste_Action; function Qui_Es_Tu (Un_Element : Symbole) return Liste is P : Pgrande_Liste := null; P_Memo : Pbloc; Ok : Boolean := False; begin P_Memo := Vue_Courante; P := Vue_Courante.Liste_Symbole; loop if P /= null then while P.Suivant /= null loop P := P.Suivant; end loop; if Equal (Un_Element, P.Contenu) then Ok := True; end if; while (not Ok) and then (P.Precedent /= null) loop if Equal (Un_Element, P.Contenu) then Ok := True; exit; else P := P.Precedent; end if; end loop; if Ok then exit; elsif Va_Bloc_Pere then P := Vue_Courante.Liste_Symbole; else exit; end if; else if Va_Bloc_Pere then P := Vue_Courante.Liste_Symbole; else exit; end if; end if; end loop; Vue_Courante := P_Memo; if Ok then return P.Index.all; else return Liste'(Suivant => null, Precedent => null, Type_Cont => False, Valeur => 0); end if; end Qui_Es_Tu; procedure Liste_Action_Donne (Une_Action : out Symbole; Un_Acteur : out Symbole; De : out Integer; Vers : out Integer; En : out Integer) is begin Une_Action := Vue_Liste_Action.Une_Action; Un_Acteur := Vue_Liste_Action.Un_Acteur; De := Vue_Liste_Action.De; Vers := Vue_Liste_Action.Vers; En := Vue_Liste_Action.En; end Liste_Action_Donne; function Liste_Action_Suivante return Boolean is begin if Vue_Liste_Action.Suivant /= null then Vue_Liste_Action := Vue_Liste_Action.Suivant; return True; else return False; end if; end Liste_Action_Suivante; function Liste_Action_Init return Boolean is begin Text_Io.Put_Line ("Liste_Action_Init entree"); if Vue_Courante.Liste_Action /= null then Text_Io.Put_Line ("Vue_courante_Liste_Action non vide"); Vue_Liste_Action := Vue_Courante.Liste_Action; Text_Io.Put_Line ("Affectation"); return True; else Text_Io.Put_Line ("Vue_courante_Liste_Action vide"); return False; end if; end Liste_Action_Init; procedure Prend_Liste (Une_Liste : in Liste) is begin --mise au debut de la liste Compteur_Element := 0; if Une_Liste.Type_Cont then La_Liste_De_Symbole := Une_Liste; while La_Liste_De_Symbole.Suivant /= null loop La_Liste_De_Symbole := La_Liste_De_Symbole.Suivant.all; end loop; while La_Liste_De_Symbole.Precedent /= null loop Compteur_Element := Compteur_Element + 1; La_Liste_De_Symbole := La_Liste_De_Symbole.Precedent.all; end loop; Liste_Nombre := False; else La_Liste_De_Nombre := Une_Liste; while La_Liste_De_Nombre.Suivant /= null loop La_Liste_De_Nombre := La_Liste_De_Nombre.Suivant.all; end loop; while La_Liste_De_Nombre.Precedent /= null loop Compteur_Element := Compteur_Element + 1; La_Liste_De_Nombre := La_Liste_De_Nombre.Precedent.all; end loop; Liste_Nombre := True; end if; end Prend_Liste; function Donne_Type_Liste return Boolean is begin return not Liste_Nombre; end Donne_Type_Liste; function Suivant return Boolean is begin if Liste_Nombre then return (La_Liste_De_Nombre.Suivant /= null); else return (La_Liste_De_Symbole.Suivant /= null); end if; end Suivant; function Donne_Taille_Liste return Integer is begin return Compteur_Element; end Donne_Taille_Liste; function Donne_Element return Symbole is begin La_Liste_De_Symbole := La_Liste_De_Symbole.Suivant.all; return La_Liste_De_Symbole.Contenu; end Donne_Element; function Donne_Element return Integer is begin return La_Liste_De_Nombre.Valeur; end Donne_Element; procedure Concate (Un_Element : Symbole; Une_Liste : in out Pliste) is Memo : Pliste; begin Memo := Une_Liste; if Memo /= null then while Memo.Suivant /= null loop Memo := Memo.Suivant; end loop; Memo.Suivant := new Liste'(True, null, null, Un_Element); Memo.Suivant.Precedent := Memo; else Memo := new Liste'(True, null, null, Un_Element); end if; Une_Liste := Memo; end Concate; procedure Concate (Une_Valeur : Integer; Une_Liste : in out Pliste) is Memo : Pliste; begin Memo := Une_Liste; if Memo /= null then while Memo.Suivant /= null loop Memo := Une_Liste.Suivant; end loop; Memo.Suivant := new Liste'(False, null, null, Une_Valeur); Memo.Suivant.Precedent := Memo; else Memo := new Liste'(False, null, null, Une_Valeur); end if; Une_Liste := Memo; end Concate; function Somme_Offset_Bloc (P : Vue_Bloc_Trie) return Integer is Tmp : Integer; begin Vue_Courante := P.Vue; Tmp := Vue_Courante.Offset; while Va_Bloc_Pere loop Text_Io.Put_Line ("Somme_Offset_Bloc - boucle"); Tmp := Tmp + Vue_Courante.Offset; end loop; Text_Io.Put_Line ("Offset absolu : " & Integer'Image (Tmp)); return Tmp; end Somme_Offset_Bloc; procedure Max (Ancien, Nouveau : Vue_Bloc_Trie; Le_Max : out Vue_Bloc_Trie; Ok : out Boolean) is begin if Ancien.Offset_Global <= Nouveau.Offset_Global then Le_Max := Nouveau; Ok := True; else Le_Max := Ancien; Ok := False; end if; end Max; -- procedure Cherche_Max (Une_Liste : in Liste_Offset_Globaux.List; -- Un_Iter : out Liste_Offset_Globaux.Iterator; -- Un_Index : out Integer) is -- Iter, Iter_Memo : Liste_Offset_Globaux.Iterator; -- Index1, Index2 : Integer := 1; -- Elem_1, Elem_2 : Vue_Bloc_Trie; -- Ok : Boolean := False; -- begin -- Liste_Offset_Globaux.Init (Iter, Une_Liste); -- Elem_1 := Liste_Offset_Globaux.Value (Iter); -- while not Liste_Offset_Globaux.Done (Iter) loop -- Elem_2 := Liste_Offset_Globaux.Value (Iter); -- -- -- Max (Elem_1, Elem_2, Elem_1, Ok); -- if Ok then -- Iter_Memo := Iter; -- Index2 := Index1; -- end if; -- Liste_Offset_Globaux.Next (Iter); -- Index1 := Index1 + 1; -- end loop; -- Un_Index := Index2; -- Un_Iter := Iter_Memo; -- end Cherche_Max; procedure Trie_Liste_Offset is type Maille; type P_Maille is access Maille; type Maille is record Element : Vue_Bloc_Trie; Suivant : P_Maille; end record; Tete : P_Maille; Est_Vide : Boolean := False; Le_Max : Vue_Bloc_Trie; procedure Extrait_Max (Une_Chaine : in out P_Maille; Le_Max : out Vue_Bloc_Trie; Est_Vide : in out Boolean) is P_Local, P_Max : P_Maille := Une_Chaine; Off_Max : Integer := 0; Premier : Boolean := True; begin Est_Vide := True; if P_Local /= null then Off_Max := P_Local.Element.Offset_Global; while P_Local.Suivant /= null loop if P_Local.Suivant.Element.Offset_Global >= Off_Max then Off_Max := P_Local.Suivant.Element.Offset_Global; P_Max := P_Local; Premier := False; end if; P_Local := P_Local.Suivant; end loop; if P_Max.Suivant /= null then Est_Vide := False; if Premier then Le_Max := P_Max.Element; Une_Chaine := Une_Chaine.Suivant; else Le_Max := P_Max.Suivant.Element; P_Max.Suivant := P_Max.Suivant.Suivant; end if; else Le_Max := P_Max.Element; Une_Chaine := null; end if; end if; end Extrait_Max; procedure Copie_Total (Une_Liste : Liste_Offset_Trie.List; Autre_Liste : in out Liste_Offset_Globaux.List) is Iter : Liste_Offset_Trie.Iterator; Elem_Tempo : Vue_Bloc_Trie; begin Liste_Offset_Globaux.Free (Autre_Liste); Liste_Offset_Trie.Init (Iter, Une_Liste); while not Liste_Offset_Trie.Done (Iter) loop Elem_Tempo := Liste_Offset_Trie.Value (Iter); Autre_Liste := Liste_Offset_Globaux.Make (Elem_Tempo, Autre_Liste); Liste_Offset_Trie.Next (Iter); Text_Io.Put_Line ("Copie en cours liste_off tri=>liste_off_glob "); end loop; end Copie_Total; procedure Copie (Une_Liste : Liste_Offset_Trie.List; Une_Chaine : out P_Maille) is Iter : Liste_Offset_Trie.Iterator; Elem_Tempo : Vue_Bloc_Trie; Tete : P_Maille := null; begin Liste_Offset_Trie.Init (Iter, Une_Liste); while not Liste_Offset_Trie.Done (Iter) loop Elem_Tempo := Liste_Offset_Trie.Value (Iter); Tete := new Maille'(Element => Elem_Tempo, Suivant => Tete); Liste_Offset_Trie.Next (Iter); end loop; Une_Chaine := Tete; end Copie; begin Copie (La_Liste_Offset_Trie, Tete); if Tete /= null then while not Est_Vide loop Extrait_Max (Tete, Le_Max, Est_Vide); La_Liste_Offset_Globaux := Liste_Offset_Globaux.Make (Le_Max, La_Liste_Offset_Globaux); end loop; else Text_Io.Put_Line ("le scenario est vide"); end if; end Trie_Liste_Offset; procedure Construit_Liste_Offset is Iter : Liste_Offset_Globaux.Iterator; P : Vue_Bloc_Trie; Offset_Global : Integer; begin Liste_Offset_Globaux.Init (Iter, La_Liste_Offset_Globaux); while not Liste_Offset_Globaux.Done (Iter) loop P := Liste_Offset_Globaux.Value (Iter); Offset_Global := Somme_Offset_Bloc (P); La_Liste_Offset_Trie := Liste_Offset_Trie.Make (Vue_Bloc_Trie'(Vue => P.Vue, Offset_Global => Offset_Global), La_Liste_Offset_Trie); Liste_Offset_Globaux.Next (Iter); end loop; Liste_Offset_Globaux.Free (La_Liste_Offset_Globaux); Trie_Liste_Offset; end Construit_Liste_Offset; function Init_Liste_Offset (Un_Nom : Symbole) return Boolean is begin if Scene_Existe (Un_Nom) then Filtre := Un_Nom; Liste_Offset_Globaux.Init (Un_Iter_Prive, La_Liste_Offset_Globaux); return True; else return False; end if; end Init_Liste_Offset; function Suivant_Liste_Offset_Est_Bloc_Courant return Boolean is P : Vue_Bloc_Trie; P_Memo : Pbloc; Ok : Boolean := False; begin if not Liste_Offset_Globaux.Done (Un_Iter_Prive) then while not Ok loop P := Liste_Offset_Globaux.Value (Un_Iter_Prive); Vue_Courante := P.Vue; while Vue_Courante.Profondeur < 1 and then Va_Bloc_Pere loop null; end loop; P_Memo := Vue_Courante; if Va_Scene (Filtre) then if P_Memo = Vue_Courante then Vue_Courante := P.Vue; Vue_Courante.Offset := P.Offset_Global; Ok := True; end if; end if; Liste_Offset_Globaux.Next (Un_Iter_Prive); if Liste_Offset_Globaux.Done (Un_Iter_Prive) then return False; end if; end loop; return True; else return False; end if; end Suivant_Liste_Offset_Est_Bloc_Courant; end Bloc;