{SPOOL.TLD Prozeduren und Funktionen :
procedure store_char(ch : byte);
procedure print_char(n : integer);
procedure clear_spooler;
procedure remove_spooler;
function spooler_status : integer;
procedure empty_spooler;
procedure init_spooler(size : integer);
}

const ONE_CHUNK_TL = 80;    { Anzahl Zeichen , die auf einmal zum Drucker }
  { geschickt werden }

type buffer_type = array[1..1] of byte;

var printer_buffer  : ^buffer_type;
  pb_head,pb_tail : integer;    { Buffer ist als Queue angelegt, }
    { bp_tail und pb_head sind Anfang/Ende }
  pb_size         : integer;    { Groesse des Buffers in Byte }
  OldLstOutPtr    : integer;    { alter Wert des LstOutPtr }

{$R-  <-----  Range-Check off ! }

procedure store_char(ch : byte);  { wird angesprungen bei Ausgabe eines }
forward;                          { Zeichens zum Drucker }

procedure print_char(n : integer);
{ druckt n Zeichen }
begin
  while n>0 do
  begin
    if pb_head=pb_tail then n:=0 { kein Zeichen in Queue }
    else
    begin
      n:=pred(n);
      pb_tail:=succ(pb_tail);
      if pb_tail>pb_size then pb_tail:=1;
      Bdos(5,printer_buffer^[pb_tail]); { ... drucken ... }
    end
  end
end;

procedure store_char;
var temp:integer;
begin
  temp:=succ(pb_head);
  if temp>pb_size then temp:=1;
  if temp=pb_tail then print_char(ONE_CHUNK_TL); { Queue ist voll, wir muessen drucken }
  printer_buffer^[temp]:=ch;
  pb_head:=temp
end;

procedure clear_spooler;{ loescht den Spooler }
begin
  pb_head:=1;
  pb_tail:=1;
end;

procedure remove_spooler;
{ gibt den Platz frei und setzt alles auf normal zurueck }
begin
  clear_spooler;
  LstOutPtr:=OldLstOutPtr;
  freemem(printer_buffer,pb_size)
end;

function spooler_status : integer;{ Spooler leer ? }
begin
  spooler_status:=abs(pb_head-pb_tail);
end;

procedure empty_spooler;{ leert Spooler }
begin
  while spooler_status<>0 do print_char(ONE_CHUNK_TL)
end;

procedure init_spooler(size : integer);
{ initialisiert Spooler }
begin
  if (size<128) or (size>32767) then writeln('<init_spooler>: size nicht korrekt')
  else
  begin
    getmem(printer_buffer,size);  { Speicher reservieren }
    OldLstOutPtr:=LstOutPtr;      { alten Pointer retten }
    LstOutPtr:=addr(store_char);  { Pointer auf store_char setzen }
    pb_size:=size;
    clear_spooler                 { Spooler ist ready }
  end
end;