Deprecated: Function set_magic_quotes_runtime() is deprecated in /DISK2/WWW/lokiware.info/mff/wakka.php on line 35
program RingBuffer (input, output); { Kruhove fronte se anglicky rika ring buffer, nebo circular buffer. } const RBufSize = 8; { Staci } type RBItem = integer; { Pro ukazkove ucely jsou polozkami kruhove fronty cislicka. } RBItemPtr = ^RBItem; RBuffer = record buf : array[0..RBufSize] of RBItem; head : integer; { place for newly added items } tail : integer; { the "oldest" item } isEmpty : boolean; end; RBufferPtr = ^RBuffer; procedure RBMakeEmpty(buf : RBufferPtr); begin buf^.head := 0; buf^.tail := 0; buf^.isEmpty := TRUE; end; function RBIsFull(buf : RBufferPtr) : boolean; begin RBIsFull := (buf^.head = buf^.tail) and not buf^.isEmpty; end; function RBAddItem(buf : RBufferPtr; item : RBItem) : boolean; begin if not RBIsFull(buf) then begin buf^.buf[buf^.head] := item; buf^.head := (buf^.head+1) mod RBufSize; if buf^.isEmpty then buf^.isEmpty := FALSE; RBAddItem := TRUE; end else RBAddItem := FALSE; end; function RBGetItem(buf : RBufferPtr; item : RBItemPtr) : boolean; begin if not buf^.isEmpty then begin item^ := buf^.buf[buf^.tail]; buf^.tail := (buf^.tail+1) mod RBufSize; if buf^.tail = buf^.head then buf^.isEmpty := TRUE; RBGetItem := TRUE; end else RBGetItem := FALSE; end; var i : integer; t : RBItem; fifo : RBuffer; trash : boolean; { we assign boolean return values here, as Turbo Pascal can't ignore them } begin RBMakeEmpty(@fifo); { store and retrieve numbers 1..max } write('* test 1:'); i := 1; while RBAddItem(@fifo, i) do inc(i); while RBGetItem(@fifo, @t) do write(' ', t); writeln; writeln; { store and retrieve numbers 1..42 } write('* test 2:'); for i := 1 to 7 do trash := RBAddItem(@fifo, i); for i := 8 to 42 do begin trash := RBGetItem(@fifo, @t); write(' ', t); trash := RBAddItem(@fifo, i); end; while RBGetItem(@fifo, @t) do write(' ', t); writeln; writeln; end.