1-- Copyright 1994 Grady Booch 2-- Copyright 1998-2014 Simon Wright <simon@pushface.org> 3 4-- This package is free software; you can redistribute it and/or 5-- modify it under terms of the GNU General Public License as 6-- published by the Free Software Foundation; either version 2, or 7-- (at your option) any later version. This package is distributed in 8-- the hope that it will be useful, but WITHOUT ANY WARRANTY; without 9-- even the implied warranty of MERCHANTABILITY or FITNESS FOR A 10-- PARTICULAR PURPOSE. See the GNU General Public License for more 11-- details. You should have received a copy of the GNU General Public 12-- License distributed with this package; see file COPYING. If not, 13-- write to the Free Software Foundation, 59 Temple Place - Suite 14-- 330, Boston, MA 02111-1307, USA. 15 16-- As a special exception, if other files instantiate generics from 17-- this unit, or you link this unit with other files to produce an 18-- executable, this unit does not by itself cause the resulting 19-- executable to be covered by the GNU General Public License. This 20-- exception does not however invalidate any other reasons why the 21-- executable file might be covered by the GNU Public License. 22 23generic 24package BC.Containers.Rings is 25 26 pragma Preelaborate; 27 28 type Abstract_Ring is abstract new Container with private; 29 30 -- A ring denotes a sequence in which items may be added and 31 -- removed from the top of a circular structure. Since this 32 -- structure has no beginning or ending, a client can mark one 33 -- particular item to designate a point of reference in the 34 -- structure. 35 36 type Direction is (Forward, Backward); 37 38 function Are_Equal (Left, Right : Abstract_Ring'Class) return Boolean; 39 -- Return True if and only if both rings have the same extent and 40 -- the same items in the same order; return False otherwise. The 41 -- identity of the top and mark of both rings does not participate 42 -- in this test of equality. 43 -- Can't call this "=" because of the standard one for Ring. 44 45 procedure Copy (From : Abstract_Ring'Class; 46 To : in out Abstract_Ring'Class); 47 -- This operation MUST be called for dissimilar Rings in place of 48 -- assignment. 49 50 procedure Clear (R : in out Abstract_Ring) is abstract; 51 -- Empty the ring of all items. The mark is cleared. 52 53 procedure Insert (R : in out Abstract_Ring; Elem : Item) is abstract; 54 -- If the ring was empty, set the ring's mark and top to designate 55 -- this item. 56 -- Otherwise, 57 -- this item becomes the new top; 58 -- the previous top is located one place forward of the new top; 59 -- the mark remains on the previously marked item. 60 61 procedure Pop (R : in out Abstract_Ring) is abstract; 62 -- Remove the top item from the ring. 63 -- If the ring is still not empty, the new top is the item that was 64 -- previously one place forward from the top. 65 -- If the removed item was the marked item, the mark now designates 66 -- the new top. 67 68 procedure Rotate (R : in out Abstract_Ring; Dir : Direction := Forward); 69 -- Rotate the top of the ring in the given direction. The ring's 70 -- mark is unaffected. If there is exactly one item in the ring, 71 -- rotating either direction always returns to the same item. 72 73 procedure Mark (R : in out Abstract_Ring); 74 -- Designate the item at the top of the ring (if not empty) as 75 -- marked. 76 77 procedure Rotate_To_Mark (R : in out Abstract_Ring); 78 -- Rotate the ring so that the ring's mark is at the top. 79 80 function Available (R : in Abstract_Ring) return Natural; 81 -- Indicates number of empty "Item slots" left in Ring 82 83 function Extent (R : Abstract_Ring) return Natural is abstract; 84 -- Return the number of items in the ring. 85 86 function Is_Empty (R : Abstract_Ring) return Boolean is abstract; 87 -- Return True if and only if there are no items in the ring. 88 89 function Top (R : Abstract_Ring) return Item is abstract; 90 -- Return a copy of the item at the top of the ring. 91 92 function At_Mark (R : Abstract_Ring) return Boolean; 93 -- Return True if and only if the item at the top of the ring is 94 -- marked; otherwise, return False. This member function will 95 -- return True if the ring is empty, since the ring's top and mark 96 -- both do not designate any item. 97 98private 99 100 type Abstract_Ring is abstract new Container with record 101 Top : Natural := 0; -- 0 implies not set 102 Mark : Natural := 0; -- 0 implies not set 103 end record; 104 105 procedure Add (R : in out Abstract_Ring; Elem : Item); 106 107 type Ring_Iterator is new Iterator with record 108 Index : Natural; 109 end record; 110 111 -- Overriding primitive supbrograms of the concrete actual 112 -- Iterator. 113 114 procedure Reset (It : in out Ring_Iterator); 115 116 procedure Next (It : in out Ring_Iterator); 117 118 function Is_Done (It : Ring_Iterator) return Boolean; 119 120 function Current_Item (It : Ring_Iterator) return Item; 121 122 function Current_Item_Ptr (It : Ring_Iterator) return Item_Ptr; 123 124 procedure Delete_Item_At (It : in out Ring_Iterator); 125 126end BC.Containers.Rings; 127