freepascal.compiler/tests/tbs/tb0045.pp

{ %GRAPH }

{ Old file: tbs0051.pp }
{  Graph, shows a problem with putpixel                 OK 0.99.9 (PM) }

{$ifdef go32v2}
  {define has_colors_equal}
{$endif go32v2}

{$ifdef go32v2}
{$define OK}
{$endif}
{$ifdef linux}
{$define OK}
{$endif}

{$ifdef OK}
uses  crt,graph;

{$ifndef has_colors_equal}
  function ColorsEqual(c1, c2 : longint) : boolean;
    begin
       ColorsEqual:=((GetMaxColor=$FF) and ((c1 and $FF)=(c2 and $FF))) or
         ((GetMaxColor=$7FFF) and ((c1 and $F8F8F8)=(c2 and $F8F8F8))) or
         ((GetMaxColor=$FFFF) and ((c1 and $F8FCF8)=(c2 and $F8FCF8))) or
         ((GetMaxColor>$10000) and ((c1 and $FFFFFF)=(c2 and $FFFFFF)));
    end;

{$endif not has_colors_equal}

var   gd,gm,gError,yi,i : integer;
      col: longint;
      error : word;

{$endif OK}
BEGIN
{$ifdef OK}
  if paramcount=0 then
    gm:=$111   {640x480/64K  HiColor}
  else
    begin
       val(paramstr(1),gm,error);
       if error<>0 then
         gm:=$111;
    end;
  gd:=detect;

  InitGraph(gd,gm,'');
  gError := graphResult;
  IF gError <> grOk
  THEN begin
    writeln ('graphDriver=',gd,'  graphMode=',gm,
    #13#10'Graphics error: ',gError);
    halt(1);
  end;

  for i := 0 to 255
  do begin
    { new grpah unit used word type for colors }
    col := {i shl 16 + }(i) shl 8 + (i div 2);
    for yi := 0 to 20 do
      PutPixel (i,yi,col);
    SetColor (col);
    Line (i,22,i,42);
  end;

  for i:=0 to 255 do
   if not ColorsEqual(getpixel(i,15),getpixel(i,30)) then
     Halt(1);
  {readkey;}delay(1000);

  closegraph;
{$endif OK}
END.

{
  $Log$
  Revision 1.1  2000-11-30 22:38:17  peter
    * renamed test suite

  Revision 1.1  2000/11/29 23:14:15  peter
    * new testsuite setup

  Revision 1.1  2000/07/13 09:21:54  michael
  + Initial import

  Revision 1.2  2000/04/14 05:44:22  pierre
   * adapted to new graph unit

  Revision 1.1  1999/12/02 17:37:38  peter
    * moved *.pp into subdirs
    * fpcmaked

  Revision 1.5  1999/11/28 12:17:14  jonas
    * changed the requested graphdriver from $FF to VESA (= 10), so the
      test program works again with the new graph unit
    * undefined has_colors_equal for go32v2, because it is not anymore
      in the new graph unit


}