home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BGICHR.ZIP / BGI-TEST.PAS next >
Encoding:
Pascal/Delphi Source File  |  1988-03-29  |  9.3 KB  |  263 lines
  1. {$R+,S+,I+,D+,T-,F-,V+,B-,N-,L+ }
  2. {$M 16384,0,16384 }
  3. {$define trace} { decide if using internal tracing or DOS DEBUG }
  4.  
  5. { >>> CHECK STATMENTS FLAGGED WITH !PATH! BEFORE RUNNING! <<< }
  6.  
  7. uses
  8.   Dos, Graph;
  9.  
  10. const copyright : array[1..66] of char =
  11. 'Copyright 1988 by Sam Denton, St. Louis, MO, CompuServ 76314,1512.';
  12.  
  13. {$ifdef trace}
  14.  
  15. function Nybble(x:byte):char;
  16. inline($58/            {  POP     AX     }
  17.        $24/$0F/        {  AND     AL,0F  }
  18.        $04/$90/        {  ADD     AL,90  }
  19.        $27/            {  DAA            }
  20.        $14/$40/        {  ADC     AL,40  }
  21.        $27/            {  DAA            }
  22.        $24/$7F);       {  AND     AL,7F  }
  23. function HexByte(h:byte):string;
  24.   begin
  25.     HexByte[0]:=#2;
  26.     HexByte[1]:=Nybble(h shr 4);
  27.     HexByte[2]:=Nybble(h);
  28.   end;
  29. function HexWord(h:word):string;
  30.   begin
  31.     HexWord:=HexByte(hi(h))+HexByte(lo(h));
  32.   end;
  33.  
  34. {$endif}
  35.  
  36. { This is a quick steal from the GRLINK demo program.  To disect a different }
  37. { driver, just change this and the reference at RegisterBGIDriver.  Or, do   }
  38. { your own BINOBJ to the BGI stuff and give them the same entry point name.  }
  39. procedure CGADriverProc; external;
  40. {$L CGA.OBJ }                                                         {!PATH!}
  41.  
  42. type
  43.   DriverPtr = ^ Driver;
  44.   Driver    = record
  45.               case integer of
  46.               0: (chars : array[0..499] of char);
  47.               1: (bytes : array[0..499] of byte);
  48.               2: (words : array[0..249] of word);
  49.               end;
  50.  
  51. procedure PatchDriver(d:DriverPtr);
  52. var
  53.   i,j : integer;
  54. begin
  55.   with d^ do
  56.     begin
  57.       if (bytes[0] <> ord('p')) or (bytes[1] <> ord('k')) then
  58.         halt(99);
  59.       i := 4;
  60.       repeat
  61.         write(chars[i]);
  62.         inc(i);
  63.       until (i>256) or (bytes[i] = ord(^Z));
  64.     end;
  65.   writeln;
  66.   j := DriverPtr(ptr(seg(d^),ofs(d^)+i+1))^.words[0];
  67. { change CALL [SI+$0016] into INT 3; CALL [SI+$16] }
  68.   d^.bytes[j+5] := $CC;  { was $FF }
  69.   d^.bytes[j+6] := $FF;  { was $94 }
  70.   d^.bytes[j+7] := $54;  { was $16 }
  71.   d^.bytes[j+8] := $16;  { was $00 }
  72. end;
  73.  
  74. {$ifdef trace}
  75.  
  76. var
  77.   tracetable : array[0..511] of record
  78.     flags,ax,bx,cx,dx,si,di,es : word;
  79.     mem : array[0..47] of byte;
  80.   end;
  81. const
  82.   trace : word = 0;
  83.  
  84. procedure Int3(flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp : word);
  85.   interrupt;
  86.   var
  87.     i : word;
  88.   begin
  89.     tracetable[trace].flags := flags;
  90.     tracetable[trace].ax := ax;
  91.     tracetable[trace].bx := bx;
  92.     tracetable[trace].cx := cx;
  93.     tracetable[trace].dx := dx;
  94.     tracetable[trace].si := si;
  95.     tracetable[trace].di := di;
  96.     tracetable[trace].es := es;
  97.   if bx < $f000 then
  98.     for i := 0 to 47 do
  99.       tracetable[trace].mem[i] := {$R-}mem[es:bx+i]{$R+};
  100.     trace := succ(trace) and 511;
  101.   end;
  102.  
  103. {$endif}
  104.  
  105. procedure dumptrace(msg:string);
  106.   var
  107.     i,l : integer;
  108.     traceout : text;
  109.   begin
  110.     assign(traceout,'trace.out');
  111. {$I-}
  112.     append(traceout);
  113. {$I+}
  114.     if IOResult <> 0 then
  115.       rewrite(traceout);
  116.     writeln(traceout,'<<< ',msg,' >>>');
  117. {$ifdef trace}
  118.     if trace = 0 then
  119.       begin
  120.         close(traceout);
  121.         exit;
  122.       end;
  123.     for trace := 0 to pred(trace) do
  124.       with tracetable[trace] do
  125.         begin
  126.           write(traceout,'AX=',HexWord(ax),'  BX=',HexWord(bx),
  127.                        '  CX=',HexWord(cx),'  DX=',HexWord(dx),
  128.                        '  SI=',HexWord(si),'  DI=',HexWord(di));
  129.           if (flags and FOverflow) = FOverflow then
  130.             write(traceout,' OV')
  131.           else
  132.             write(traceout,' NV');
  133.           if (flags and FSign) = FSign then
  134.             write(traceout,' MI')
  135.           else
  136.             write(traceout,' PL');
  137.           if (flags and FZero) = FZero then
  138.             write(traceout,' ZE')
  139.           else
  140.             write(traceout,' NZ');
  141.           if (flags and FParity) = FParity then
  142.             write(traceout,' PO')
  143.           else
  144.             write(traceout,' PE');
  145.           if (flags and FCarry) = FCarry then
  146.             write(traceout,' CA')
  147.           else
  148.             write(traceout,' NC');
  149.           writeln(traceout);
  150.         if bx < $F000 then
  151.           for l := 0 to 2 do
  152.             begin
  153.               write(traceout,HexWord(es),':',HexWord(bx+16*l),'  ');
  154.               for i := 0 to 15 do
  155.                 begin
  156.                   write(traceout,HexByte(mem[16*l+i]));
  157.                   if (i and 15) = 7 then
  158.                     write(traceout,'-')
  159.                   else
  160.                     write(traceout,' ');
  161.                 end;
  162.               write(traceout,'  ');
  163.               for i := 0 to 15 do
  164.                 begin
  165.                   if mem[16*l+i] in [32..126] then
  166.                     write(traceout,chr(mem[16*l+i]))
  167.                   else
  168.                     write(traceout,'.');
  169.                 end;
  170.               writeln(traceout);
  171.             end;
  172.           writeln(traceout);
  173.         end;
  174.     trace := 0;
  175. {$endif}
  176.     i := GraphResult;
  177.     if i <> 0 then
  178.       WriteLn(traceout,'*** Error ***',GraphErrorMsg(i));
  179.     close(traceout);
  180.   end;
  181.  
  182. const
  183.   UserPattern : FillPatternType = ($00,$70,$20,$27,$25,$27,$04,$04);
  184.   pentagon : array[0..5] of PointType = ((x:500;y:50),(x:480;y:70),
  185.                (x:490;y:90),(x:510;y:90),(x:520;y:70),(x:500;y:50));
  186.  
  187. var
  188.   GraphDriver, GraphMode : integer;
  189.   i : longint;
  190.   Old3,ImageBuffer : pointer;
  191.  
  192. begin
  193. { erase old copy of file (I also hunt rabbits with elephant guns!) }
  194.   Exec('C:\Dos\Command.Com','/c erase Trace.Out');                     {!PATH!}
  195. { (I am violating my own standards by NOT looking up COMSPEC, }
  196. { because the stupid DOS unit has no environment functions!) }
  197.  
  198. {$ifdef trace}
  199. { install spy program at same vector used by DEBUG and the like }
  200.   GetIntVec(3,Old3);
  201.   SetIntVec(3,@Int3);
  202. {$endif}
  203.   PatchDriver(@CGADriverProc);
  204. { start doing things and see what happens }
  205.   if RegisterBGIdriver(@CGADriverProc) < 0 then
  206.       halt(99);
  207.   GraphDriver := 1;
  208.   GraphMode := 4;
  209.   InitGraph(GraphDriver, GraphMode, '');  { activate graphics }
  210.   if GraphResult <> grOk then
  211.     begin
  212.       writeln('error: ',GraphErrorMsg(GraphDriver));
  213.       halt;
  214.     end;
  215.   DumpTrace('InitGraph');
  216.   Line(53,54,55,56);                           DumpTrace('Line');
  217.   MoveTo(57,58);                               DumpTrace('MoveTo');
  218.   LineTo(59,60);                               DumpTrace('LineTo');
  219.   MoveRel(61,62);                              DumpTrace('MoveRel');
  220.   LineRel(63,64);                              DumpTrace('LineRel');
  221.   GetMem(ImageBuffer,ImageSize(53,54,63,62));  DumpTrace('ImageSize');
  222.   GetImage(53,54,63,62,ImageBuffer^);          DumpTrace('GetImage');
  223.   i := GetGraphMode;                           DumpTrace('GetGraphMode');
  224.   RestoreCrtMode;                              DumpTrace('RestoreCrtMode');
  225.   SetGraphMode(i);                             DumpTrace('SetGraphMode');
  226.   PutPixel(1,1,1);                             DumpTrace('PutPixel');
  227.   if GetPixel(1,1) = 0 then ;                  DumpTrace('GetPixel');
  228.   PutImage(53,54,ImageBuffer^,0);              DumpTrace('PutImage, MOV');
  229.   PutImage(63,64,ImageBuffer^,4);              DumpTrace('PutImage, NOT');
  230.   SetColor(1);                                 DumpTrace('SetColor');
  231.   SetFillPattern(UserPattern,1);               DumpTrace('SetFillPattern');
  232.   Bar(16,48,32,64);                            DumpTrace('Bar');
  233.   SetFillStyle(CloseDotFill,1);                DumpTrace('SetFillStyle');
  234.   Bar3D(24,56,32,64,2,TopOn);                  DumpTrace('Bar3D');
  235.   PieSlice(99,99,90,180,30);                   DumpTrace('PieSlice');
  236.   Ellipse(99,99,180,360,30,45);                DumpTrace('Ellipse');
  237.   Arc(99,99,0,90,30);                          DumpTrace('Arc');
  238.   Circle(200,100,30);                          DumpTrace('Circle');
  239.   FloodFill(200,100,1);                        DumpTrace('FloodFill');
  240.   SetLineStyle(DottedLn,7,NormWidth);          DumpTrace('SetLineStyle');
  241.   Rectangle(0,100,50,150);                     DumpTrace('Rectangle');
  242.   DrawPoly(6,pentagon);                        DumpTrace('DrawPoly');
  243.   FillPoly(5,pentagon);                        DumpTrace('FillPoly');
  244.   OutText('Hello');                            DumpTrace('OutText');
  245.   SetTextJustify(CenterText,CenterText);       DumpTrace('SetTextJustfy');
  246.   SetTextStyle(DefaultFont,HorizDir,3);        DumpTrace('SetTextStyle');
  247.   OutTextXY(320,100,'Hello, again');           DumpTrace('OutTextXY');
  248.   SetBkColor(Blue);                            DumpTrace('SetBkColor');
  249.   SetColor(5);                                 DumpTrace('SetColor');
  250.   SetPalette(1,5);                             DumpTrace('SetPalette');
  251.   SetViewport(0,0,100,100,true);               DumpTrace('SetViewport');
  252.   ClearViewport;                               DumpTrace('ClearViewport');
  253.   SetActivePage(1);                            DumpTrace('SetActivePage');
  254.   SetVisualPage(1);                            DumpTrace('SetVisualPage');
  255.   ClearDevice;                                 DumpTrace('ClearDevice');
  256.   CloseGraph;                                  DumpTrace('CloseGraph');
  257. {$ifdef trace}
  258. { kill the spy, he knows too much! }
  259.   SetIntVec(3,Old3);
  260. {$endif}
  261. { invoke Vernon D. Buerg's LIST utility to look at the results }
  262.   Exec('C:\User\V.Com','Trace.Out');                                   {!PATH!}
  263. end.