|
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: ┃ A ┃
Length: 51354 (0xc89a)
Names: »ADB«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
0x0000…0020 77 69 74 68 20 61 63 74 6f 72 5f 74 72 65 65 3b 0d 0a 0d 0a 70 61 63 6b 61 67 65 20 62 6f 64 79 ┆with actor_tree; package body┆
0x0020…0040 20 74 61 64 5f 6d 61 74 65 72 69 61 6c 20 69 73 0d 0a 0d 0a 70 72 6f 63 65 64 75 72 65 20 43 72 ┆ tad_material is procedure Cr┆
0x0040…0060 65 61 74 65 5f 4e 65 77 5f 4d 61 74 65 72 69 61 6c 20 28 74 68 65 5f 6f 62 6a 65 63 74 20 3a 20 ┆eate_New_Material (the_object : ┆
0x0060…0080 6f 75 74 20 6f 62 6a 65 63 74 3b 20 74 68 65 5f 4e 61 6d 65 20 3a 20 73 74 72 69 6e 67 29 20 69 ┆out object; the_Name : string) i┆
0x0080…00a0 73 0d 0a 6e 65 77 5f 6e 61 6d 65 20 3a 20 73 74 72 69 6e 67 28 31 2e 2e 32 30 29 20 3a 3d 20 28 ┆s new_name : string(1..20) := (┆
0x00a0…00c0 31 2e 2e 32 30 20 3d 3e 20 27 20 27 29 3b 0d 0a 62 65 67 69 6e 0d 0a 20 20 6e 65 77 5f 6e 61 6d ┆1..20 => ' '); begin new_nam┆
0x00c0…00e0 65 28 31 2e 2e 74 68 65 5f 6e 61 6d 65 27 6c 61 73 74 29 20 3a 3d 20 74 68 65 5f 6e 61 6d 65 3b ┆e(1..the_name'last) := the_name;┆
0x00e0…0100 0d 0a 20 20 74 68 65 5f 6f 62 6a 65 63 74 20 3a 3d 20 6f 62 6a 65 63 74 27 28 6e 65 77 5f 6e 61 ┆ the_object := object'(new_na┆
0x0100…0120 6d 65 2c 20 61 63 74 6f 72 5f 74 72 65 65 2e 63 72 65 61 74 65 5f 6e 65 77 5f 74 72 65 65 29 3b ┆me, actor_tree.create_new_tree);┆
0x0120…0140 0d 0a 65 6e 64 20 43 72 65 61 74 65 5f 4e 65 77 5f 4d 61 74 65 72 69 61 6c 3b 0d 0a 0d 0a 70 72 ┆ end Create_New_Material; pr┆
0x0140…0160 6f 63 65 64 75 72 65 20 73 65 74 5f 61 63 74 6f 72 73 20 28 74 68 65 5f 6f 62 6a 65 63 74 20 3a ┆ocedure set_actors (the_object :┆
0x0160…0180 20 69 6e 20 6f 75 74 20 6f 62 6a 65 63 74 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 ┆ in out object; t┆
0x0180…01a0 68 65 5f 61 63 74 6f 72 73 20 3a 20 61 63 74 6f 72 5f 74 72 65 65 2e 6f 62 6a 65 63 74 29 20 69 ┆he_actors : actor_tree.object) i┆
0x01a0…01c0 73 0d 0a 62 65 67 69 6e 0d 0a 20 20 74 68 65 5f 6f 62 6a 65 63 74 2e 61 63 74 6f 72 73 20 3a 3d ┆s begin the_object.actors :=┆
0x01c0…01e0 20 74 68 65 5f 61 63 74 6f 72 73 3b 0d 0a 65 6e 64 20 73 65 74 5f 61 63 74 6f 72 73 3b 0d 0a 0d ┆ the_actors; end set_actors; ┆
0x01e0…0200 0a 70 72 6f 63 65 64 75 72 65 20 67 65 74 5f 61 63 74 6f 72 73 20 28 74 68 65 5f 6f 62 6a 65 63 ┆ procedure get_actors (the_objec┆
0x0200…0220 74 20 3a 20 6f 62 6a 65 63 74 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 68 65 5f 61 ┆t : object; the_a┆
0x0220…0240 63 74 6f 72 73 20 3a 20 6f 75 74 20 61 63 74 6f 72 5f 74 72 65 65 2e 6f 62 6a 65 63 74 29 20 69 ┆ctors : out actor_tree.object) i┆
0x0240…0260 73 0d 0a 62 65 67 69 6e 0d 0a 20 20 74 68 65 5f 61 63 74 6f 72 73 20 3a 3d 20 74 68 65 5f 6f 62 ┆s begin the_actors := the_ob┆
0x0260…0280 6a 65 63 74 2e 61 63 74 6f 72 73 3b 0d 0a 65 6e 64 20 67 65 74 5f 61 63 74 6f 72 73 3b 0d 0a 0d ┆ject.actors; end get_actors; ┆
0x0280…02a0 0a 66 75 6e 63 74 69 6f 6e 20 63 6f 6d 70 61 72 65 5f 6e 61 6d 65 20 28 6f 62 6a 65 63 74 31 2c ┆ function compare_name (object1,┆
0x02a0…02c0 20 6f 62 6a 65 63 74 32 20 3a 20 6f 62 6a 65 63 74 29 20 72 65 74 75 72 6e 20 69 6e 74 65 67 65 ┆ object2 : object) return intege┆
0x02c0…02e0 72 20 69 73 0d 0a 62 65 67 69 6e 0d 0a 20 20 69 66 20 6f 62 6a 65 63 74 31 2e 6e 61 6d 65 20 3d ┆r is begin if object1.name =┆
0x02e0…0300 20 6f 62 6a 65 63 74 32 2e 6e 61 6d 65 20 74 68 65 6e 0d 0a 20 20 20 20 72 65 74 75 72 6e 20 30 ┆ object2.name then return 0┆
0x0300…0320 3b 0d 0a 20 20 65 6e 64 20 69 66 3b 0d 0a 20 20 69 66 20 6f 62 6a 65 63 74 31 2e 6e 61 6d 65 20 ┆; end if; if object1.name ┆
0x0320…0340 3e 20 6f 62 6a 65 63 74 32 2e 6e 61 6d 65 20 74 68 65 6e 0d 0a 20 20 20 20 72 65 74 75 72 6e 20 ┆> object2.name then return ┆
0x0340…0360 31 3b 0d 0a 20 20 65 6c 73 65 0d 0a 20 20 20 20 72 65 74 75 72 6e 20 2d 31 3b 0d 0a 20 20 65 6e ┆1; else return -1; en┆
0x0360…0380 64 20 69 66 3b 0d 0a 65 6e 64 20 63 6f 6d 70 61 72 65 5f 6e 61 6d 65 3b 0d 0a 0d 0a 66 75 6e 63 ┆d if; end compare_name; func┆
0x0380…03a0 74 69 6f 6e 20 77 68 61 74 5f 6e 61 6d 65 20 28 74 68 65 5f 6f 62 6a 65 63 74 20 3a 20 6f 62 6a ┆tion what_name (the_object : obj┆
0x03a0…03c0 65 63 74 29 20 72 65 74 75 72 6e 20 73 74 72 69 6e 67 20 69 73 0d 0a 62 65 67 69 6e 0d 0a 20 20 ┆ect) return string is begin ┆
0x03c0…03e0 72 65 74 75 72 6e 20 74 68 65 5f 6f 62 6a 65 63 74 2e 6e 61 6d 65 3b 0d 0a 65 6e 64 20 77 68 61 ┆return the_object.name; end wha┆
0x03e0…0400 74 5f 6e 61 6d 65 3b 0d 0a 0d 0a 0d 0a 65 6e 64 20 74 61 64 5f 6d 61 74 65 72 69 61 6c 3b 0d 0a ┆t_name; end tad_material; ┆
0x0400…0420 70 61 63 6b 61 67 65 20 62 6f 64 79 20 67 65 6e 65 72 69 63 5f 74 72 65 65 20 69 73 0d 0a 0d 0a ┆package body generic_tree is ┆
0x0420…0440 74 79 70 65 20 73 6f 6e 20 69 73 20 28 6c 65 66 74 2c 20 72 69 67 68 74 29 3b 0d 0a 63 75 72 72 ┆type son is (left, right); curr┆
0x0440…0460 65 6e 74 5f 6e 6f 64 65 20 3a 20 6f 62 6a 65 63 74 20 3a 3d 20 76 6f 69 64 5f 74 72 65 65 3b 0d ┆ent_node : object := void_tree; ┆
0x0460…0480 0a 0d 0a 0d 0a 66 75 6e 63 74 69 6f 6e 20 67 6f 5f 74 6f 5f 6c 65 66 74 5f 73 6f 6e 20 72 65 74 ┆ function go_to_left_son ret┆
0x0480…04a0 75 72 6e 20 62 6f 6f 6c 65 61 6e 20 69 73 0d 0a 6f 6b 20 3a 20 62 6f 6f 6c 65 61 6e 20 3a 3d 20 ┆urn boolean is ok : boolean := ┆
0x04a0…04c0 66 61 6c 73 65 3b 0d 0a 62 65 67 69 6e 0d 0a 20 20 69 66 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 ┆false; begin if current_node┆
0x04c0…04e0 20 2f 3d 20 76 6f 69 64 5f 74 72 65 65 20 74 68 65 6e 0d 0a 20 20 20 20 69 66 20 63 75 72 72 65 ┆ /= void_tree then if curre┆
0x04e0…0500 6e 74 5f 6e 6f 64 65 2e 6c 65 66 74 20 2f 3d 20 76 6f 69 64 5f 74 72 65 65 20 74 68 65 6e 0d 0a ┆nt_node.left /= void_tree then ┆
0x0500…0520 20 20 20 20 20 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 20 3a 3d 20 63 75 72 72 65 6e 74 5f 6e 6f ┆ current_node := current_no┆
0x0520…0540 64 65 2e 6c 65 66 74 3b 0d 0a 20 20 20 20 20 20 6f 6b 20 3a 3d 20 74 72 75 65 3b 0d 0a 20 20 20 ┆de.left; ok := true; ┆
0x0540…0560 20 65 6e 64 20 69 66 3b 0d 0a 20 20 65 6e 64 20 69 66 3b 0d 0a 20 20 72 65 74 75 72 6e 20 6f 6b ┆ end if; end if; return ok┆
0x0560…0580 3b 0d 0a 65 6e 64 20 67 6f 5f 74 6f 5f 6c 65 66 74 5f 73 6f 6e 3b 0d 0a 0d 0a 66 75 6e 63 74 69 ┆; end go_to_left_son; functi┆
0x0580…05a0 6f 6e 20 67 6f 5f 74 6f 5f 72 69 67 68 74 5f 73 6f 6e 20 72 65 74 75 72 6e 20 62 6f 6f 6c 65 61 ┆on go_to_right_son return boolea┆
0x05a0…05c0 6e 20 69 73 0d 0a 6f 6b 20 3a 20 62 6f 6f 6c 65 61 6e 20 3a 3d 20 66 61 6c 73 65 3b 0d 0a 62 65 ┆n is ok : boolean := false; be┆
0x05c0…05e0 67 69 6e 0d 0a 20 20 69 66 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 20 2f 3d 20 76 6f 69 64 5f 74 ┆gin if current_node /= void_t┆
0x05e0…0600 72 65 65 20 74 68 65 6e 0d 0a 20 20 20 20 69 66 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 2e 72 69 ┆ree then if current_node.ri┆
0x0600…0620 67 68 74 20 2f 3d 20 76 6f 69 64 5f 74 72 65 65 20 74 68 65 6e 0d 0a 20 20 20 20 20 20 63 75 72 ┆ght /= void_tree then cur┆
0x0620…0640 72 65 6e 74 5f 6e 6f 64 65 20 3a 3d 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 2e 72 69 67 68 74 3b ┆rent_node := current_node.right;┆
0x0640…0660 0d 0a 20 20 20 20 20 20 6f 6b 20 3a 3d 20 74 72 75 65 3b 0d 0a 20 20 20 20 65 6e 64 20 69 66 3b ┆ ok := true; end if;┆
0x0660…0680 0d 0a 20 20 65 6e 64 20 69 66 3b 0d 0a 20 20 72 65 74 75 72 6e 20 6f 6b 3b 0d 0a 65 6e 64 20 67 ┆ end if; return ok; end g┆
0x0680…06a0 6f 5f 74 6f 5f 72 69 67 68 74 5f 73 6f 6e 3b 0d 0a 0d 0a 66 75 6e 63 74 69 6f 6e 20 63 6f 6e 73 ┆o_to_right_son; function cons┆
0x06a0…06c0 74 72 75 63 74 20 28 74 68 65 5f 65 6c 65 6d 65 6e 74 20 3a 20 65 6c 65 6d 65 6e 74 3b 20 6f 6e ┆truct (the_element : element; on┆
0x06c0…06e0 5f 73 6f 6e 20 3a 20 73 6f 6e 20 3a 3d 20 72 69 67 68 74 29 0d 0a 20 20 20 20 20 72 65 74 75 72 ┆_son : son := right) retur┆
0x06e0…0700 6e 20 62 6f 6f 6c 65 61 6e 20 69 73 0d 0a 74 6d 70 5f 6e 6f 64 65 20 3a 20 6f 62 6a 65 63 74 20 ┆n boolean is tmp_node : object ┆
0x0700…0720 3a 3d 20 6e 65 77 20 6e 6f 64 65 27 28 63 6f 6e 74 61 69 6e 20 3d 3e 20 74 68 65 5f 65 6c 65 6d ┆:= new node'(contain => the_elem┆
0x0720…0740 65 6e 74 2c 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 65 66 74 20 20 3d ┆ent, left =┆
0x0740…0760 3e 20 76 6f 69 64 5f 74 72 65 65 2c 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ┆> void_tree, ┆
0x0760…0780 20 72 69 67 68 74 20 3d 3e 20 76 6f 69 64 5f 74 72 65 65 29 3b 0d 0a 6f 6b 20 3a 20 62 6f 6f 6c ┆ right => void_tree); ok : bool┆
0x0780…07a0 65 61 6e 20 3a 3d 20 66 61 6c 73 65 3b 0d 0a 62 65 67 69 6e 0d 0a 20 20 69 66 20 63 75 72 72 65 ┆ean := false; begin if curre┆
0x07a0…07c0 6e 74 5f 6e 6f 64 65 20 3d 20 76 6f 69 64 5f 74 72 65 65 20 74 68 65 6e 0d 0a 20 20 20 20 62 65 ┆nt_node = void_tree then be┆
0x07c0…07e0 67 69 6e 0d 0a 20 20 20 20 20 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 20 3a 3d 20 74 6d 70 5f 6e ┆gin current_node := tmp_n┆
0x07e0…0800 6f 64 65 3b 0d 0a 20 20 20 20 20 20 6f 6b 20 3a 3d 20 74 72 75 65 3b 0d 0a 20 20 20 20 65 6e 64 ┆ode; ok := true; end┆
0x0800…0820 3b 0d 0a 20 20 65 6c 73 69 66 20 6f 6e 5f 73 6f 6e 20 3d 20 73 6f 6e 27 28 6c 65 66 74 29 20 74 ┆; elsif on_son = son'(left) t┆
0x0820…0840 68 65 6e 0d 0a 20 20 20 20 20 20 20 62 65 67 69 6e 0d 0a 20 20 20 20 20 63 75 72 72 65 6e 74 5f ┆hen begin current_┆
0x0840…0860 6e 6f 64 65 2e 6c 65 66 74 20 3a 3d 20 74 6d 70 5f 6e 6f 64 65 3b 0d 0a 20 20 20 20 20 6f 6b 20 ┆node.left := tmp_node; ok ┆
0x0860…0880 3a 3d 20 74 72 75 65 3b 0d 0a 20 20 20 20 20 20 20 65 6e 64 3b 0d 0a 20 20 20 20 20 65 6c 73 65 ┆:= true; end; else┆
0x0880…08a0 0d 0a 20 20 20 20 20 20 20 62 65 67 69 6e 0d 0a 20 20 20 20 20 63 75 72 72 65 6e 74 5f 6e 6f 64 ┆ begin current_nod┆
0x08a0…08c0 65 2e 72 69 67 68 74 20 3a 3d 20 74 6d 70 5f 6e 6f 64 65 3b 0d 0a 20 20 20 20 20 6f 6b 20 3a 3d ┆e.right := tmp_node; ok :=┆
0x08c0…08e0 20 74 72 75 65 3b 0d 0a 20 20 20 20 20 20 20 65 6e 64 3b 0d 0a 20 20 65 6e 64 20 69 66 3b 0d 0a ┆ true; end; end if; ┆
0x08e0…0900 20 20 72 65 74 75 72 6e 20 6f 6b 3b 0d 0a 65 6e 64 20 63 6f 6e 73 74 72 75 63 74 3b 0d 0a 0d 0a ┆ return ok; end construct; ┆
0x0900…0920 66 75 6e 63 74 69 6f 6e 20 70 6c 61 63 65 5f 6f 6e 5f 6e 6f 64 65 28 6f 6e 65 5f 65 6c 65 6d 65 ┆function place_on_node(one_eleme┆
0x0920…0940 6e 74 20 3a 20 65 6c 65 6d 65 6e 74 29 20 72 65 74 75 72 6e 20 62 6f 6f 6c 65 61 6e 20 69 73 0d ┆nt : element) return boolean is ┆
0x0940…0960 0a 6f 6b 20 3a 20 62 6f 6f 6c 65 61 6e 20 3a 3d 20 66 61 6c 73 65 3b 0d 0a 62 65 67 69 6e 0d 0a ┆ ok : boolean := false; begin ┆
0x0960…0980 20 20 69 66 20 28 63 75 72 72 65 6e 74 5f 6e 6f 64 65 20 2f 3d 20 76 6f 69 64 5f 74 72 65 65 29 ┆ if (current_node /= void_tree)┆
0x0980…09a0 20 74 68 65 6e 0d 0a 20 20 20 20 62 65 67 69 6e 0d 0a 20 20 20 20 20 20 69 66 20 63 6f 6d 70 61 ┆ then begin if compa┆
0x09a0…09c0 72 65 5f 6b 65 79 28 63 75 72 72 65 6e 74 5f 6e 6f 64 65 2e 63 6f 6e 74 61 69 6e 2c 20 6f 6e 65 ┆re_key(current_node.contain, one┆
0x09c0…09e0 5f 65 6c 65 6d 65 6e 74 29 20 3d 20 30 20 74 68 65 6e 0d 0a 20 20 20 20 72 65 74 75 72 6e 20 74 ┆_element) = 0 then return t┆
0x09e0…0a00 72 75 65 3b 0d 0a 20 20 20 20 20 20 65 6e 64 20 69 66 3b 0d 0a 20 20 20 20 20 20 69 66 20 63 6f ┆rue; end if; if co┆
0x0a00…0a20 6d 70 61 72 65 5f 6b 65 79 28 63 75 72 72 65 6e 74 5f 6e 6f 64 65 2e 63 6f 6e 74 61 69 6e 2c 20 ┆mpare_key(current_node.contain, ┆
0x0a20…0a40 6f 6e 65 5f 65 6c 65 6d 65 6e 74 29 3e 30 20 74 68 65 6e 0d 0a 20 20 20 20 69 66 20 67 6f 5f 74 ┆one_element)>0 then if go_t┆
0x0a40…0a60 6f 5f 6c 65 66 74 5f 73 6f 6e 20 74 68 65 6e 0d 0a 20 20 20 20 20 20 6f 6b 20 3a 3d 20 70 6c 61 ┆o_left_son then ok := pla┆
0x0a60…0a80 63 65 5f 6f 6e 5f 6e 6f 64 65 28 6f 6e 65 5f 65 6c 65 6d 65 6e 74 29 3b 0d 0a 20 20 20 20 65 6e ┆ce_on_node(one_element); en┆
0x0a80…0aa0 64 20 69 66 3b 0d 0a 20 20 20 20 20 20 65 6c 73 65 0d 0a 20 20 20 20 69 66 20 67 6f 5f 74 6f 5f ┆d if; else if go_to_┆
0x0aa0…0ac0 72 69 67 68 74 5f 73 6f 6e 20 74 68 65 6e 0d 0a 20 20 20 20 20 20 6f 6b 20 3a 3d 20 70 6c 61 63 ┆right_son then ok := plac┆
0x0ac0…0ae0 65 5f 6f 6e 5f 6e 6f 64 65 28 6f 6e 65 5f 65 6c 65 6d 65 6e 74 29 3b 0d 0a 20 20 20 20 65 6e 64 ┆e_on_node(one_element); end┆
0x0ae0…0b00 20 69 66 3b 0d 0a 20 20 20 20 20 20 65 6e 64 20 69 66 3b 0d 0a 20 20 20 20 65 6e 64 3b 0d 0a 20 ┆ if; end if; end; ┆
0x0b00…0b20 20 65 6c 73 65 0d 0a 20 20 20 20 6f 6b 20 3a 3d 20 66 61 6c 73 65 3b 0d 0a 20 20 65 6e 64 20 69 ┆ else ok := false; end i┆
0x0b20…0b40 66 3b 0d 0a 20 20 72 65 74 75 72 6e 20 6f 6b 3b 0d 0a 65 6e 64 20 70 6c 61 63 65 5f 6f 6e 5f 6e ┆f; return ok; end place_on_n┆
0x0b40…0b60 6f 64 65 3b 0d 0a 0d 0a 70 72 6f 63 65 64 75 72 65 20 69 6e 73 65 72 74 5f 65 6c 65 6d 65 6e 74 ┆ode; procedure insert_element┆
0x0b60…0b80 20 28 74 68 65 5f 6f 62 6a 65 63 74 20 3a 20 69 6e 20 6f 75 74 20 6f 62 6a 65 63 74 3b 20 74 68 ┆ (the_object : in out object; th┆
0x0b80…0ba0 65 5f 65 6c 65 6d 65 6e 74 20 3a 20 65 6c 65 6d 65 6e 74 29 20 69 73 0d 0a 6f 6b 20 3a 20 62 6f ┆e_element : element) is ok : bo┆
0x0ba0…0bc0 6f 6c 65 61 6e 3b 0d 0a 62 65 67 69 6e 0d 0a 20 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 20 3a 3d ┆olean; begin current_node :=┆
0x0bc0…0be0 20 74 68 65 5f 6f 62 6a 65 63 74 3b 0d 0a 20 20 69 66 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 20 ┆ the_object; if current_node ┆
0x0be0…0c00 2f 3d 20 76 6f 69 64 5f 74 72 65 65 20 74 68 65 6e 0d 0a 20 20 20 20 6f 6b 20 3a 3d 20 70 6c 61 ┆/= void_tree then ok := pla┆
0x0c00…0c20 63 65 5f 6f 6e 5f 6e 6f 64 65 28 74 68 65 5f 65 6c 65 6d 65 6e 74 29 3b 0d 0a 20 20 20 20 69 66 ┆ce_on_node(the_element); if┆
0x0c20…0c40 20 63 6f 6d 70 61 72 65 5f 6b 65 79 28 63 75 72 72 65 6e 74 5f 6e 6f 64 65 2e 63 6f 6e 74 61 69 ┆ compare_key(current_node.contai┆
0x0c40…0c60 6e 2c 20 74 68 65 5f 65 6c 65 6d 65 6e 74 29 3e 30 20 74 68 65 6e 0d 0a 20 20 20 20 20 20 6f 6b ┆n, the_element)>0 then ok┆
0x0c60…0c80 20 3a 3d 20 63 6f 6e 73 74 72 75 63 74 28 74 68 65 5f 65 6c 65 6d 65 6e 74 2c 20 6c 65 66 74 29 ┆ := construct(the_element, left)┆
0x0c80…0ca0 3b 0d 0a 20 20 20 20 65 6c 73 65 0d 0a 20 20 20 20 20 20 6f 6b 20 3a 3d 20 63 6f 6e 73 74 72 75 ┆; else ok := constru┆
0x0ca0…0cc0 63 74 28 74 68 65 5f 65 6c 65 6d 65 6e 74 2c 20 72 69 67 68 74 29 3b 0d 0a 20 20 20 20 65 6e 64 ┆ct(the_element, right); end┆
0x0cc0…0ce0 20 69 66 3b 0d 0a 20 20 65 6c 73 65 0d 0a 20 20 20 20 6f 6b 20 3a 3d 20 63 6f 6e 73 74 72 75 63 ┆ if; else ok := construc┆
0x0ce0…0d00 74 28 74 68 65 5f 65 6c 65 6d 65 6e 74 29 3b 0d 0a 20 20 20 20 74 68 65 5f 6f 62 6a 65 63 74 20 ┆t(the_element); the_object ┆
0x0d00…0d20 3a 3d 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 3b 0d 0a 20 20 65 6e 64 20 69 66 3b 0d 0a 65 6e 64 ┆:= current_node; end if; end┆
0x0d20…0d40 20 69 6e 73 65 72 74 5f 65 6c 65 6d 65 6e 74 3b 0d 0a 0d 0a 70 72 6f 63 65 64 75 72 65 20 73 65 ┆ insert_element; procedure se┆
0x0d40…0d60 61 72 63 68 5f 65 6c 65 6d 65 6e 74 28 74 68 65 5f 6f 62 6a 65 63 74 20 3a 20 6f 62 6a 65 63 74 ┆arch_element(the_object : object┆
0x0d60…0d80 3b 20 74 68 65 5f 65 6c 65 6d 65 6e 74 20 3a 20 69 6e 20 6f 75 74 20 65 6c 65 6d 65 6e 74 29 20 ┆; the_element : in out element) ┆
0x0d80…0da0 69 73 0d 0a 6f 6b 20 3a 20 62 6f 6f 6c 65 61 6e 3b 0d 0a 62 65 67 69 6e 0d 0a 20 20 63 75 72 72 ┆is ok : boolean; begin curr┆
0x0da0…0dc0 65 6e 74 5f 6e 6f 64 65 20 3a 3d 20 74 68 65 5f 6f 62 6a 65 63 74 3b 0d 0a 20 20 6f 6b 20 3a 3d ┆ent_node := the_object; ok :=┆
0x0dc0…0de0 20 70 6c 61 63 65 5f 6f 6e 5f 6e 6f 64 65 28 74 68 65 5f 65 6c 65 6d 65 6e 74 29 3b 0d 0a 20 20 ┆ place_on_node(the_element); ┆
0x0de0…0e00 74 68 65 5f 65 6c 65 6d 65 6e 74 20 3a 3d 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 2e 63 6f 6e 74 ┆the_element := current_node.cont┆
0x0e00…0e20 61 69 6e 3b 0d 0a 65 6e 64 20 73 65 61 72 63 68 5f 65 6c 65 6d 65 6e 74 3b 0d 0a 0d 0a 66 75 6e ┆ain; end search_element; fun┆
0x0e20…0e40 63 74 69 6f 6e 20 63 72 65 61 74 65 5f 6e 65 77 5f 74 72 65 65 20 72 65 74 75 72 6e 20 6f 62 6a ┆ction create_new_tree return obj┆
0x0e40…0e60 65 63 74 20 69 73 0d 0a 62 65 67 69 6e 0d 0a 20 20 72 65 74 75 72 6e 20 76 6f 69 64 5f 74 72 65 ┆ect is begin return void_tre┆
0x0e60…0e80 65 3b 0d 0a 65 6e 64 20 63 72 65 61 74 65 5f 6e 65 77 5f 74 72 65 65 3b 0d 0a 0d 0a 70 72 6f 63 ┆e; end create_new_tree; proc┆
0x0e80…0ea0 65 64 75 72 65 20 63 68 61 6e 67 65 5f 65 6c 65 6d 65 6e 74 28 74 68 65 5f 6f 62 6a 65 63 74 20 ┆edure change_element(the_object ┆
0x0ea0…0ec0 3a 20 69 6e 20 6f 75 74 20 6f 62 6a 65 63 74 3b 20 74 68 65 5f 65 6c 65 6d 65 6e 74 20 3a 20 65 ┆: in out object; the_element : e┆
0x0ec0…0ee0 6c 65 6d 65 6e 74 29 20 69 73 0d 0a 6f 6b 20 3a 20 62 6f 6f 6c 65 61 6e 3b 0d 0a 62 65 67 69 6e ┆lement) is ok : boolean; begin┆
0x0ee0…0f00 0d 0a 20 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 20 3a 3d 20 74 68 65 5f 6f 62 6a 65 63 74 3b 0d ┆ current_node := the_object; ┆
0x0f00…0f20 0a 20 20 69 66 20 70 6c 61 63 65 5f 6f 6e 5f 6e 6f 64 65 28 74 68 65 5f 65 6c 65 6d 65 6e 74 29 ┆ if place_on_node(the_element)┆
0x0f20…0f40 20 74 68 65 6e 0d 0a 20 20 20 20 63 75 72 72 65 6e 74 5f 6e 6f 64 65 2e 63 6f 6e 74 61 69 6e 20 ┆ then current_node.contain ┆
0x0f40…0f60 3a 3d 20 74 68 65 5f 65 6c 65 6d 65 6e 74 3b 0d 0a 20 20 65 6e 64 20 69 66 3b 0d 0a 65 6e 64 20 ┆:= the_element; end if; end ┆
0x0f60…0f80 63 68 61 6e 67 65 5f 65 6c 65 6d 65 6e 74 3b 0d 0a 0d 0a 66 75 6e 63 74 69 6f 6e 20 65 6c 65 6d ┆change_element; function elem┆
0x0f80…0fa0 65 6e 74 5f 65 78 69 73 74 28 74 68 65 5f 6f 62 6a 65 63 74 20 3a 20 6f 62 6a 65 63 74 3b 20 74 ┆ent_exist(the_object : object; t┆
0x0fa0…0fc0 68 65 5f 65 6c 65 6d 65 6e 74 20 3a 20 65 6c 65 6d 65 6e 74 29 0d 0a 20 20 20 20 20 72 65 74 75 ┆he_element : element) retu┆
0x0fc0…0fe0 72 6e 20 62 6f 6f 6c 65 61 6e 20 69 73 0d 0a 62 65 67 69 6e 0d 0a 20 20 63 75 72 72 65 6e 74 5f ┆rn boolean is begin current_┆
0x0fe0…1000 6e 6f 64 65 20 3a 3d 20 74 68 65 5f 6f 62 6a 65 63 74 3b 0d 0a 20 20 72 65 74 75 72 6e 20 70 6c ┆node := the_object; return pl┆
0x1000…1020 61 63 65 5f 6f 6e 5f 6e 6f 64 65 28 74 68 65 5f 65 6c 65 6d 65 6e 74 29 3b 0d 0a 65 6e 64 20 65 ┆ace_on_node(the_element); end e┆
0x1020…1040 6c 65 6d 65 6e 74 5f 65 78 69 73 74 3b 0d 0a 0d 0a 0d 0a 65 6e 64 20 67 65 6e 65 72 69 63 5f 74 ┆lement_exist; end generic_t┆
0x1040…1060 72 65 65 3b 0d 0a 70 61 63 6b 61 67 65 20 62 6f 64 79 20 54 6f 6b 65 6e 20 69 73 0a 20 20 20 20 ┆ree; package body Token is ┆
0x1060…1080 74 79 70 65 20 50 73 74 72 69 6e 67 20 69 73 20 61 63 63 65 73 73 20 53 74 72 69 6e 67 3b 0a 20 ┆type Pstring is access String; ┆
0x1080…10a0 20 20 20 73 75 62 74 79 70 65 20 4b 65 79 77 6f 72 64 5f 54 6f 6b 65 6e 20 69 73 20 54 6f 6b 65 ┆ subtype Keyword_Token is Toke┆
0x10a0…10c0 6e 2e 4f 62 6a 65 63 74 20 72 61 6e 67 65 20 4c 5f 41 75 20 2e 2e 20 4c 5f 54 65 6d 70 73 3b 0a ┆n.Object range L_Au .. L_Temps; ┆
0x10c0…10e0 20 20 20 20 74 79 70 65 20 4b 65 79 77 6f 72 64 20 69 73 20 61 72 72 61 79 20 28 4b 65 79 77 6f ┆ type Keyword is array (Keywo┆
0x10e0…1100 72 64 5f 54 6f 6b 65 6e 29 20 6f 66 20 50 73 74 72 69 6e 67 3b 0a 20 20 20 20 54 68 65 5f 4b 65 ┆rd_Token) of Pstring; The_Ke┆
0x1100…1120 79 77 6f 72 64 73 20 3a 20 63 6f 6e 73 74 61 6e 74 20 4b 65 79 77 6f 72 64 20 3a 3d 0a 20 20 20 ┆ywords : constant Keyword := ┆
0x1120…1140 20 20 20 20 28 4c 5f 41 75 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 61 75 22 29 2c 0a ┆ (L_Au => new String'("au"), ┆
0x1140…1160 20 20 20 20 20 20 20 20 4c 5f 41 63 74 69 76 65 72 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 ┆ L_Activer => new String'┆
0x1160…1180 28 22 61 63 74 69 76 65 72 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 41 6c 6f 72 73 20 3d 3e 20 ┆("activer"), L_Alors => ┆
0x1180…11a0 6e 65 77 20 53 74 72 69 6e 67 27 28 22 61 6c 6f 72 73 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f ┆new String'("alors"), L_┆
0x11a0…11c0 41 74 74 65 6e 64 72 65 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 61 74 74 65 6e 64 72 ┆Attendre => new String'("attendr┆
0x11c0…11e0 65 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 41 76 65 63 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e ┆e"), L_Avec => new Strin┆
0x11e0…1200 67 27 28 22 61 76 65 63 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 42 69 6e 61 69 72 65 20 3d 3e ┆g'("avec"), L_Binaire =>┆
0x1200…1220 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 62 69 6e 61 69 72 65 22 29 2c 0a 20 20 20 20 20 20 20 ┆ new String'("binaire"), ┆
0x1220…1240 20 4c 5f 44 65 73 61 63 74 69 76 65 72 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 64 65 ┆ L_Desactiver => new String'("de┆
0x1240…1260 73 61 63 74 69 76 65 72 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 44 69 73 63 72 65 74 20 3d 3e ┆sactiver"), L_Discret =>┆
0x1260…1280 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 64 69 73 63 72 65 74 22 29 2c 0a 20 20 20 20 20 20 20 ┆ new String'("discret"), ┆
0x1280…12a0 20 4c 5f 45 6e 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 65 6e 22 29 2c 0a 20 20 20 20 ┆ L_En => new String'("en"), ┆
0x12a0…12c0 20 20 20 20 4c 5f 45 73 74 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 65 73 74 22 29 2c ┆ L_Est => new String'("est"),┆
0x12c0…12e0 0a 20 20 20 20 20 20 20 20 4c 5f 45 78 70 65 72 69 65 6e 63 65 20 3d 3e 20 6e 65 77 20 53 74 72 ┆ L_Experience => new Str┆
0x12e0…1300 69 6e 67 27 28 22 65 78 70 65 72 69 65 6e 63 65 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 46 61 ┆ing'("experience"), L_Fa┆
0x1300…1320 69 72 65 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 66 61 69 72 65 22 29 2c 0a 20 20 20 ┆ire => new String'("faire"), ┆
0x1320…1340 20 20 20 20 20 4c 5f 46 69 6e 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 66 69 6e 22 29 ┆ L_Fin => new String'("fin")┆
0x1340…1360 2c 0a 20 20 20 20 20 20 20 20 4c 5f 46 6f 69 73 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 ┆, L_Fois => new String'(┆
0x1360…1380 22 66 6f 69 73 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 46 75 67 69 74 69 66 20 3d 3e 20 6e 65 ┆"fois"), L_Fugitif => ne┆
0x1380…13a0 77 20 53 74 72 69 6e 67 27 28 22 66 75 67 69 74 69 66 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f ┆w String'("fugitif"), L_┆
0x13a0…13c0 48 65 75 72 65 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 68 22 29 2c 0a 20 20 20 20 20 ┆Heure => new String'("h"), ┆
0x13c0…13e0 20 20 20 4c 5f 4d 61 74 65 72 69 65 6c 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 6d 61 ┆ L_Materiel => new String'("ma┆
0x13e0…1400 74 65 72 69 65 6c 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 4d 69 6e 75 74 65 20 3d 3e 20 6e 65 ┆teriel"), L_Minute => ne┆
0x1400…1420 77 20 53 74 72 69 6e 67 27 28 22 6d 69 6e 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 50 75 69 73 ┆w String'("min"), L_Puis┆
0x1420…1440 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 70 75 69 73 22 29 2c 0a 20 20 20 20 20 20 20 ┆ => new String'("puis"), ┆
0x1440…1460 20 4c 5f 52 65 70 65 74 65 72 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 72 65 70 65 74 ┆ L_Repeter => new String'("repet┆
0x1460…1480 65 72 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 53 63 65 6e 65 20 3d 3e 20 6e 65 77 20 53 74 72 ┆er"), L_Scene => new Str┆
0x1480…14a0 69 6e 67 27 28 22 73 63 65 6e 65 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 53 65 63 6f 6e 64 65 ┆ing'("scene"), L_Seconde┆
0x14a0…14c0 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 73 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f ┆ => new String'("s"), L_┆
0x14c0…14e0 53 69 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 73 69 22 29 2c 0a 20 20 20 20 20 20 20 ┆Si => new String'("si"), ┆
0x14e0…1500 20 4c 5f 53 70 65 63 74 61 63 6c 65 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 73 70 65 ┆ L_Spectacle => new String'("spe┆
0x1500…1520 63 74 61 63 6c 65 22 29 2c 0a 20 20 20 20 20 20 20 20 4c 5f 53 74 61 74 69 6f 6e 20 3d 3e 20 6e ┆ctacle"), L_Station => n┆
0x1520…1540 65 77 20 53 74 72 69 6e 67 27 28 22 73 74 61 74 69 6f 6e 22 29 2c 0a 20 20 20 20 20 20 20 20 4c ┆ew String'("station"), L┆
0x1540…1560 5f 54 65 6d 70 73 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 27 28 22 74 65 6d 70 73 22 29 2c 0a ┆_Temps => new String'("temps"), ┆
0x1560…1580 20 20 20 20 20 20 20 20 4c 5f 54 65 6d 70 6f 72 65 6c 20 3d 3e 20 6e 65 77 20 53 74 72 69 6e 67 ┆ L_Temporel => new String┆
0x1580…15a0 27 28 22 74 65 6d 70 6f 72 65 6c 22 29 29 3b 0a 0a 20 20 20 20 66 75 6e 63 74 69 6f 6e 20 53 65 ┆'("temporel")); function Se┆
0x15a0…15c0 61 72 63 68 5f 54 6f 6b 65 6e 20 28 53 20 3a 20 53 74 72 69 6e 67 29 20 72 65 74 75 72 6e 20 54 ┆arch_Token (S : String) return T┆
0x15c0…15e0 6f 6b 65 6e 2e 4f 62 6a 65 63 74 20 69 73 0a 20 20 20 20 62 65 67 69 6e 0a 20 20 20 20 20 20 20 ┆oken.Object is begin ┆
0x15e0…1600 20 66 6f 72 20 49 20 69 6e 20 4b 65 79 77 6f 72 64 5f 54 6f 6b 65 6e 20 6c 6f 6f 70 0a 20 20 20 ┆ for I in Keyword_Token loop ┆
0x1600…1620 20 20 20 20 20 69 66 20 53 20 3d 20 54 68 65 5f 4b 65 79 77 6f 72 64 73 20 28 49 29 2e 61 6c 6c ┆ if S = The_Keywords (I).all┆
0x1620…1640 20 74 68 65 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 74 75 72 6e 20 49 3b 0a ┆ then return I; ┆
0x1640…1660 20 20 20 20 20 20 20 20 20 20 20 20 65 6e 64 20 69 66 3b 20 20 0a 20 20 20 20 20 20 20 20 65 6e ┆ end if; en┆
0x1660…1680 64 20 6c 6f 6f 70 3b 20 20 0a 20 20 20 20 20 20 20 20 72 65 74 75 72 6e 20 4c 5f 49 64 3b 0a 20 ┆d loop; return L_Id; ┆
0x1680…16a0 20 20 20 65 6e 64 20 53 65 61 72 63 68 5f 54 6f 6b 65 6e 3b 0a 65 6e 64 20 54 6f 6b 65 6e 3b 0a ┆ end Search_Token; end Token; ┆
0x16a0…16c0 77 69 74 68 20 74 61 64 5f 6d 61 74 65 72 69 61 6c 3b 0d 0a 0d 0a 0d 0a 70 61 63 6b 61 67 65 20 ┆with tad_material; package ┆
0x16c0…16e0 62 6f 64 79 20 74 61 64 5f 67 6c 6f 62 61 6c 20 69 73 0d 0a 0d 0a 70 72 6f 63 65 64 75 72 65 20 ┆body tad_global is procedure ┆
0x16e0…1700 63 72 65 61 74 65 5f 6e 65 77 5f 73 74 61 74 69 6f 6e 20 28 74 68 65 5f 6f 62 6a 65 63 74 20 3a ┆create_new_station (the_object :┆
0x1700…1720 20 6f 75 74 20 6f 62 6a 65 63 74 3b 20 74 68 65 5f 6e 61 6d 65 20 3a 20 73 74 72 69 6e 67 29 20 ┆ out object; the_name : string) ┆
0x1720…1740 69 73 0d 0a 6e 65 77 5f 6e 61 6d 65 20 3a 20 73 74 72 69 6e 67 28 31 2e 2e 32 30 29 20 3a 3d 20 ┆is new_name : string(1..20) := ┆
0x1740…1760 28 31 2e 2e 32 30 20 3d 3e 20 27 20 27 29 3b 0d 0a 62 65 67 69 6e 0d 0a 20 20 6e 65 77 5f 6e 61 ┆(1..20 => ' '); begin new_na┆
0x1760…1780 6d 65 28 31 2e 2e 74 68 65 5f 6e 61 6d 65 27 6c 61 73 74 29 20 3a 3d 20 74 68 65 5f 6e 61 6d 65 ┆me(1..the_name'last) := the_name┆
0x1780…17a0 3b 0d 0a 20 20 74 68 65 5f 6f 62 6a 65 63 74 20 3a 3d 20 6f 62 6a 65 63 74 27 28 6e 65 77 5f 6e ┆; the_object := object'(new_n┆
0x17a0…17c0 61 6d 65 2c 20 30 2c 20 6e 75 6c 6c 29 3b 0d 0a 65 6e 64 20 63 72 65 61 74 65 5f 6e 65 77 5f 73 ┆ame, 0, null); end create_new_s┆
0x17c0…17e0 74 61 74 69 6f 6e 3b 0d 0a 0d 0a 70 72 6f 63 65 64 75 72 65 20 73 65 74 5f 6d 61 74 65 72 69 61 ┆tation; procedure set_materia┆
0x17e0…1800 6c 5f 74 79 70 65 20 28 74 68 65 5f 6f 62 6a 65 63 74 20 3a 20 69 6e 20 6f 75 74 20 6f 62 6a 65 ┆l_type (the_object : in out obje┆
0x1800…1820 63 74 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 61 74 65 72 69 61 6c 5f 74 ┆ct; material_t┆
0x1820…1840 79 70 65 20 3a 20 74 61 64 5f 6d 61 74 65 72 69 61 6c 2e 6f 62 6a 65 63 74 29 20 69 73 0d 0a 62 ┆ype : tad_material.object) is b┆
0x1840…1860 65 67 69 6e 0d 0a 20 20 74 68 65 5f 6f 62 6a 65 63 74 2e 6d 61 74 65 72 69 61 6c 5f 74 79 70 65 ┆egin the_object.material_type┆
0x1860…1880 20 3a 3d 20 6e 65 77 20 74 61 64 5f 6d 61 74 65 72 69 61 6c 2e 6f 62 6a 65 63 74 27 28 6d 61 74 ┆ := new tad_material.object'(mat┆
0x1880…18a0 65 72 69 61 6c 5f 74 79 70 65 29 3b 0d 0a 65 6e 64 20 73 65 74 5f 6d 61 74 65 72 69 61 6c 5f 74 ┆erial_type); end set_material_t┆
0x18a0…18c0 79 70 65 3b 0d 0a 0d 0a 70 72 6f 63 65 64 75 72 65 20 73 65 74 5f 73 74 61 74 69 6f 6e 5f 6e 75 ┆ype; procedure set_station_nu┆
0x18c0…18e0 6d 62 65 72 20 28 74 68 65 5f 6f 62 6a 65 63 74 20 3a 20 69 6e 20 6f 75 74 20 6f 62 6a 65 63 74 ┆mber (the_object : in out object┆
0x18e0…1900 3b 0d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 68 65 5f 61 64 64 72 65 73 73 ┆; the_address┆
0x1900…1920 20 3a 20 6e 61 74 75 72 61 6c 29 20 69 73 0d 0a 62 65 67 69 6e 0d 0a 20 20 74 68 65 5f 6f 62 6a ┆ : natural) is begin the_obj┆
[…truncated at 200 lines…]