RBBS in a Box Volume 1 #2/RBBS_vol1_no2.iso/add2/tavram.zip/TAVGRTST.PAS

Pascal/Delphi Source File | 1989-05-30 | 8KB | 331 lines

Program VRamGraphTest;
{$M 16384,50000,50000}

uses
  Crt,
  TaVram,
  Graph;
const
  BGIspec = 'C:\LANG\TP5\BGI';
  MaxUpdateSize = 200;
  BarWidth = 70;
  BarSpacing = 30;
  BarDepth = 5;
  BarXOffset = 20;
  MemAvailBar        = 1;
  MaxAvailBar        = 2;
  BytesAllocatedBar  = 3;
  MaxHeapToUseBar    = 4;
  HeapUsedBar        = 5;
  Labels : Array[MemAvailBar..HeapUsedBar] of String[20] = ( 'MemAvail',
                                                             'MaxAvail',
                                                             'BytesAlloc',
                                                             'MaxHeap2Use',
                                                             'HeapUsed');
var
  GraphDriver : Integer;
  GraphMode : Integer;
  ErrorCode : Integer;
  MaxX,
  MaxY,
  GraphLeft,
  GraphRight,
  GraphTop,
  GraphBot  : Integer;
  VertFact : Real;
  CurAlloc : LongInt;
  LastAlloc,
  LastMemAvail,
  LastMaxAvail,
  LastMaxHeapToUse,
  LastHeapUsed : Array[0..1] of LongInt;
  LargestBarSize : LongInt;
  CurPage,
  Pages : Word;

function LongStr(L : LongInt;P:Byte) : String;
var
  St : String[20];
begin
  Str(L:P,St);
  LongStr:=St;
end;

function RealStr(R : Real; P,D :Byte) : String;
var
  St : String[20];
begin
  Str(R:P:D,St);
  RealStr:=St;
end;

procedure SetFullViewPort;
begin
  SetViewPort(0,0,MaxX,MaxY,ClipOn);
end;

procedure FlipPage;
begin
  SetActivePage(CurPage);
  CurPage:=CurPage XOR $0001;
  SetVisualPage(CurPage);
end;

function DivideVert(X,Y1,Y2 : Integer; Lv,Hv : LongInt) : Real;
var
  R,
  CR : Real;
  CY : Integer;
begin
  R:=(Hv-Lv) / (Y2-Y1);
  CY:=Y2;
  CR:=0;
  while CY>=Y1 do begin
    SetColor(Cyan);
    OutTextXY(X-(7*8),CY-4,RealStr(CR,6,0));
    Line(X-2,CY,X+2,CY);
    CR:=CR+(R*10);
    Dec(CY,10);
  end;
  DivideVert:=R;
end;

procedure ClearArea(X1,Y1,X2,Y2 : Word);
begin
  SetViewPort(X1,Y1,X2,Y2,True);
  ClearViewPort;
  SetFullViewPort;
end;

procedure ClearStatusBar(N : Word);
var
  BarX : Integer;
begin
  BarX:=((N-1)*(BarWidth+BarSpacing))+(GraphLeft+BarXOffset);
  ClearArea(BarX,0,BarX+BarWidth+BarDepth,GraphBot-1);
end;

procedure DrawStatusBar(N : Word; Size : LongInt);
var
  BarX,
  BarY : Integer;
  UseSize : LongInt;
begin
  ClearStatusBar(N);
  if Size<=0 then
    Exit;
  if Size>LargestBarSize then
    UseSize:=LargestBarSize
  else
    UseSize:=Size;
  BarY:=GraphBot-Round(UseSize/VertFact);
  BarX:=((N-1)*(BarWidth+BarSpacing))+(GraphLeft+BarXOffset);
  SetColor(LightGray);
  SetFillStyle(LineFill+N,DarkGray+N);
  Bar3D(BarX,BarY,BarX+BarWidth,GraphBot-1,BarDepth,True);
  if UseSize<Size then begin
    SetColor(DarkGray+N);
    OutTextXY(BarX+8,0,#24+LongStr(Size,6)+#24);
  end;
end;

procedure DrawStatusBarLabel(N : Word; St : String);
var
  BarX : Integer;
begin
  BarX:=((N-1)*(BarWidth+BarSpacing))+(GraphLeft+BarXOffset);
  SetColor(DarkGray+N);
  OutTextXY(BarX,GraphBot+4,St);
end;

procedure DrawLabels;
var
  W : Word;
begin
  For W:=MemAvailBar to HeapUsedBar do
    DrawStatusBarLabel(W,Labels[W]);
end;

procedure ClearStatusLine;
begin
  ClearArea(0,MaxY-10,MaxX,MaxY);
end;

procedure DisplayStatusLine(St : String);
begin
  ClearStatusLine;
  SetColor(LightGreen);
  OutTextXY(0,MaxY-10,St);
end;

procedure UpdateGraphs;
var
  MaxAv,
  MemAv : LongInt;
begin
  MemAv:=MemAvail;
  MaxAv:=MaxAvail;
  if Abs(LastMemAvail[CurPage]-MemAv)>MaxUpdateSize then begin
    DrawStatusBar(MemAvailBar,MemAv);
    LastMemAvail[CurPage]:=MemAv;
  end;
  if Abs(LastMaxAvail[CurPage]-MaxAv)>MaxUpdateSize then begin
    DrawStatusBar(MaxAvailBar,MaxAv);
    LastMaxAvail[CurPage]:=MaxAv;
  end;
  if Abs(LastAlloc[CurPage]-CurAlloc)>=MaxUpdateSize then begin
    DrawStatusBar(BytesAllocatedBar,CurAlloc);
    LastAlloc[CurPage]:=CurAlloc;
  end;
  if Abs(LastMaxHeapToUse[CurPage]-VRamMaxHeapToUse)>MaxUpdateSize then begin
    DrawStatusBar(MaxHeapToUseBar,VRamMaxHeapToUse);
    LastMaxHeapToUse[CurPage]:=VRamMaxHeapToUse;
  end;
  if Abs(LastHeapUsed[CurPage]-VRamHeapUsed)>MaxUpdateSize then begin
    DrawStatusBar(HeapUsedBar,VRamHeapUsed);
    LastHeapUsed[CurPage]:=VRamHeapUsed;
  end;
end;

procedure DisplayStatusUpdate(St : String);
begin
  DisplayStatusLine(St);
  UpdateGraphs;
  if Pages>0 then
    FlipPage;
end;

procedure SetupLastSizes;
var
  i : Integer;
begin
  for i:=0 to 1 do begin
    LastAlloc[i]:=-MaxUpdateSize;
    LastMemAvail[i]:=-MaxUpdateSize;
    LastMaxAvail[i]:=-MaxUpdateSize;
    LastMaxHeapToUse[i]:=-MaxUpdateSize;
    LastHeapUsed[i]:=-MaxUpdateSize;
  end;
end;

procedure Init;
var
  W : Word;
begin
  DetectGraph(GraphDriver,GraphMode);
  if GraphDriver in[EGA,HercMono,VGA] then begin
    Pages:=1;
    Case GraphDriver of
      EGA : GraphMode:=EGAHi;
      HercMono : GraphMode:=HercMonoHi;
      VGA : GraphMode:=VGAMed;
      else Pages:=0;
    end;
  end;
  InitGraph(GraphDriver,GraphMode,BGIspec);
  if GraphResult<>grOk then begin
    writeln;
    writeln('Turbo Pascal Graph error #',GraphResult);
    writeln('Program aborted.');
    Halt(1);
  end;
  MaxX:=GetMaxX;
  MaxY:=GetMaxY;
  GraphLeft:=60;
  GraphRight:=MaxX-10;
  GraphTop:=12;
  GraphBot:=MaxY-30;
  CurAlloc:=0;
  CurPage:=0;

  W:=0;
  While W<=Pages do begin
    SetActivePage(W);
    SetBkColor(Black);
    ClearViewPort;
    SetColor(Yellow);
    SetLineStyle(SolidLn,0,NormWidth);
    Line(GraphLeft,GraphTop,GraphLeft,GraphBot);
    Line(GraphLeft,GraphBot,GraphRight,GraphBot);
    LargestBarSize:=MemAvail;
    VertFact:=DivideVert(GraphLeft,GraphTop,GraphBot,0,LargestBarSize);
    DrawLabels;
    Inc(W);
  end;
  SetupLastSizes;
end;

procedure Test;
const
  MaxBigArray = 255;
  MaxArraySize = 400;
type
  BigRecPtr = ^BigRec;
  BigRec = Record
    A: Array[1..MaxArraySize] of byte;
  end;
var
  BRArray : Array[1..MaxBigArray] of BigRecPtr;
  I,J : integer;
  Temp : LongInt;
  ch : Char;

procedure AbortTest;
begin
  CloseGraph;
  writeln('Test failed.');
  Halt(1);
end;

begin
  DisplayStatusUpdate('Press a key to start.');
  ch:=ReadKey;
{$P+}
  VRamOn;
  VRamMaxHeapToUse:=20000;
  { FreeMin:=(MaxBigArray * 4) * 2;   absolute safest if not using
                                      VRamMaxHeapToUse.            }
  VRamPageOff;
  for i:=1 to MaxBigArray do begin
    New(BRArray[i]);
    Inc(CurAlloc,SizeOf(BigRec));
    FillChar(BRArray[i]^,MaxArraySize,i);
    if i>60 then  {Watch VRamHeapUsed go way above VRamMaxHeapToUse.}
      VRamPageOn;  {then watch it pop back down.}
    DisplayStatusUpdate('Allocating #'+LongStr(i,3));
  end;
  while not KeyPressed do begin
    i:=Random(MaxBigArray)+1;
    for j:=1 to MaxArraySize do
      if BRArray[i]^.A[j]<>i then
        AbortTest;
    DisplayStatusUpdate('Testing #'+LongStr(i,3)+'... OK!');
  end;
  while KeyPressed do ch:=ReadKey;
  for i:=50 to 100 do begin
    Dispose(BRArray[i]);
    Dec(CurAlloc,SizeOf(BigRec));
    DisplayStatusUpdate('Deallocated # '+LongStr(i,3));
  end;
  for i:=1 to 49 do begin
    Dispose(BRArray[i]);
    Dec(CurAlloc,SizeOf(BigRec));
    DisplayStatusUpdate('Deallocated #'+LongStr(i,3));
  end;
  for i:=101 to MaxBigArray do begin
    Dispose(BRArray[i]);
    Dec(CurAlloc,SizeOf(BigRec));
    DisplayStatusUpdate('Deallocated #'+LongStr(i,3));
  end;
{$P-}
  DisplayStatusUpdate('FINISHED!  Press a key to continue.');
  ch:=ReadKey;
end;

begin
  Init;
  Test;
  CloseGraph;
end.