The Equalizer BBS/equalizer-bbs-collection_2004.zip/equalizer-bbs-collection/DEMOSCENE-STUFF/BM9.ZIP/FIFO.PAS

Pascal/Delphi Source File | 1994-11-26 | 5KB | 192 lines

{

  Diese UNIT stellt einen Lister zur Verfügung, der mehr als 64k Daten
  listen kann. Der zur Verfügung stehende Speicher beeinflußt die Größe
  der anzeigbaren Datei, und kann im Hauptprogramm mit den entsprechenden
  Compiler-Schaltern beeinflußt werden.
  Die Pufferstruktur ist untypisiert, d.h. sie kann auch anderweitig
  verbastelt werden.
  Für Insider : die Struktur wird als verkettete Liste bezeichnet.

       HAVE FUN - BUT GIMME DA CREDITS      (c)1994   JAMES DEAN

}

unit speed;

interface

  procedure list(filename : String);

implementation

uses dos,crt;

type  PufferInhalt  = String[77];
      Puffer        = ^PufferEintrag;
      PufferEintrag = record
                        Eintrag   : PufferInhalt;
                        Naechster : Puffer
                      end;

var   PufferAnfang,
      PufferEnde    : Puffer;
      PufferLeer    : boolean;   { Wird wahr, wenn kein Element in Puffer }
      dummy : Pufferinhalt;

function PufferVoll : boolean;         { Wird wahr, wenn Puffer überläuft }
  const MemEinheit = 16.0;
  var   PufferAvail : real;
  begin
    if MemAvail<0
       then PufferAvail:=MemEinheit*(65536.0+MemAvail)
       else PufferAvail:=MemEinheit*MemAvail;
    PufferVoll:=PufferAvail<SizeOf(PufferEintrag)
  end;

procedure InitPuffer;                             { Initialisiert Puffer }
  begin
    PufferAnfang:=NIL; PufferEnde:=NIL; PufferLeer:=true;
  end;

procedure SchreibInPuffer(E : PufferInhalt);  { Prüft nicht auf Überlauf! }
  var p : Puffer;
  begin
    if not PufferVoll then
      begin
        new(p); PufferLeer:=false;
        with p^ do begin Eintrag:=E; Naechster:=NIL end;
        if PufferEnde<>NIL
          then PufferEnde^.Naechster:=p
          else if PufferAnfang<>NIL then PufferAnfang^.Naechster:=p
                                     else PufferAnfang:=p;
        PufferEnde:=p
      end
  end;

procedure HolVonPuffer(var E : PufferInhalt);
                                         { Undefiniert, wenn Puffer leer! }
  var p : Puffer;
  begin
    if PufferAnfang=NIL
      then PufferLeer:=true
      else begin
             p:=PufferAnfang; E:=p^.Eintrag; PufferAnfang:=p^.Naechster;
             dispose(p); PufferLeer:=PufferAnfang=NIL;
             if PufferLeer then PufferEnde:=NIL
           end
  end;

procedure cursor_aus;assembler;
asm
  mov ah,01h     { RUFE INTERRUPT 10hex                                    }
  mov cx,2020h   { MIT FUNKTION 01hex UND CX-WERT 2020hex AUF.             }
  int 10h
end;

procedure cursor_an;assembler;
asm
  mov ah,01h     { RUFE INTERRUPT 10hex                                    }
  mov cx,0607h   { MIT FUNKTION 01hex UND CX-WERT 0607hex AUF.             }
  int 10h
end;

procedure display(filename : String);

var zeilen,ii,i,count : Word;
    f                : Text;
    ch               : char;

begin
  zeilen := 25;
  ii:=0;i:=0;
  InitPuffer;
  ClrScr;
  Assign(f, filename);
  Reset(f);
  count := 0;
  while not eof(f) do begin
    Inc(count, 1);
    ReadLn(f, dummy);
    SchreibInPuffer(dummy);
  end;

  if count < zeilen then zeilen := count+2;

  TextColor(14);TextBackground(0);ClrScr;

  GotoXY( 1,zeilen);
  Write('└─────────────────────────────────────────────────────────────────────────────┘');
  GotoXY( 1,1);
  Write('┌─────────────────────────────────────────────────────────────────────────────┐');

  GotoXY(39 - Length(filename) DIV 2,1);Write(filename);
  for i := 2 to (zeilen-1) do
  begin
    GotoXY( 1,i);Write('│');
    GotoXY(79,i);Write('│');
  end;

  Window(2,2,78,zeilen-1);TextColor(14);TextBackground(1);ClrScr;

  cursor_aus;

  for i := 1 to (zeilen - 3) do begin
    if not puffervoll then
    begin
      HolVonPuffer(dummy);SchreibInPuffer(dummy);
      WriteLn(dummy);
    end;
  end;
  i := zeilen;
  repeat
    ch := ReadKey;
    if ch = #0 then
    begin
      ch:=ReadKey;
      if ch =  #80  then
      begin
        HolVonPuffer(dummy);SchreibInPuffer(dummy);
        WriteLn(dummy);
      end;
      if ch = #72 then
      begin
        ClrScr;
        for i := 1 to (count - zeilen + 2) do
        begin
          HolVonPuffer(dummy);SchreibInPuffer(dummy);
        end;
        for ii := 1 to (zeilen - 3) do
        begin
          HolVonPuffer(dummy);SchreibInPuffer(dummy);
          WriteLn(dummy);
        end;
      end;
    end;
  until ch = #27;

  while not pufferleer do holvonpuffer(dummy);

  window(1,1,80,25);TextColor(7);TextBackground(0);ClrScr;
  Close(f);

  cursor_an;

end;

procedure list(filename : string);
var
  DirInfo: SearchRec;
begin
  FindFirst(filename, AnyFile, DirInfo);
  while DosError = 0 do
  begin
    display(DirInfo.Name);
    FindNext(DirInfo);
  end;
end;

end.

{       HAVE FUN - BUT GIMME DA CREDITS      (c)1994   JAMES DEAN         }