* adapted to new graph unit

This commit is contained in:
pierre 1999-12-14 22:59:52 +00:00
parent 540c68e49f
commit 525f8777c8

View File

@ -25,13 +25,7 @@ uses
{$ifdef go32v2} {$ifdef go32v2}
dpmiexcp, dpmiexcp,
{$endif go32v2} {$endif go32v2}
Graph; dos,Graph;
{$ifdef go32v2}
{$ifndef ver0_99_8}
{$define has_colors_equal}
{$endif ver0_99_8}
{$endif go32v2}
const const
shift:byte=12; shift:byte=12;
@ -44,7 +38,7 @@ var
Max_Y_Width,Y_Width : integer; Max_Y_Width,Y_Width : integer;
Y1,Y2,X1,X2,Dy,Dx : Real; Y1,Y2,X1,X2,Dy,Dx : Real;
Zm : Integer; Zm : Integer;
Flag : boolean; SymetricCase : boolean;
LineY : array [0..600] OF BYTE; LineY : array [0..600] OF BYTE;
LineX : array [0..100,0..600] OF INTEGER; LineX : array [0..100,0..600] OF INTEGER;
const const
@ -54,7 +48,6 @@ type
arrayType = array[1..50] of integer; arrayType = array[1..50] of integer;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{$ifndef has_colors_equal}
function ColorsEqual(c1, c2 : longint) : boolean; function ColorsEqual(c1, c2 : longint) : boolean;
begin begin
ColorsEqual:=((GetMaxColor=$FF) and ((c1 and $FF)=(c2 and $FF))) or ColorsEqual:=((GetMaxColor=$FF) and ((c1 and $FF)=(c2 and $FF))) or
@ -63,8 +56,6 @@ type
((GetMaxColor>$10000) and ((c1 and $FFFFFF)=(c2 and $FFFFFF))); ((GetMaxColor>$10000) and ((c1 and $FFFFFF)=(c2 and $FFFFFF)));
end; end;
{$endif not has_colors_equal}
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
function CalcMandel(Point:PointType; z:integer) : Longint ; function CalcMandel(Point:PointType; z:integer) : Longint ;
var var
@ -84,12 +75,7 @@ begin
if Z=0 Then if Z=0 Then
CalcMandel:=(blue and $FFFFFF) CalcMandel:=(blue and $FFFFFF)
else else
{$ifdef go32v2} CalcMandel:=(z mod Max_Color) + 1 ;
if getMaxColor>255 then
CalcMandel:=(stdcolors[(z mod 254) + 1] and $FFFFFF)
else
{$endif}
CalcMandel:=(z mod Max_Color) + 1 ;
end; end;
{-----------------------------------------------------------------------------} {-----------------------------------------------------------------------------}
@ -166,7 +152,7 @@ begin
if P3 <> P4 then if P3 <> P4 then
begin begin
line ( P3 , P1 , P4 , P1) ; line ( P3 , P1 , P4 , P1) ;
if Flag then if SymetricCase then
begin begin
P:=Max_Y_Width-P1; P:=Max_Y_Width-P1;
line ( P3 , P , P4 , P ) ; line ( P3 , P , P4 , P ) ;
@ -200,7 +186,7 @@ begin
ActualPoint:=NextPoint; ActualPoint:=NextPoint;
LastColor:=CalcMandel(NextPoint,Zm) ; LastColor:=CalcMandel(NextPoint,Zm) ;
putpixel (ActualPoint.X,ActualPoint.Y,LastColor); putpixel (ActualPoint.X,ActualPoint.Y,LastColor);
if Flag then if SymetricCase then
putpixel (ActualPoint.X,Max_Y_Width-ActualPoint.Y,LastColor) ; putpixel (ActualPoint.X,Max_Y_Width-ActualPoint.Y,LastColor) ;
Ymax:=NextPoint.Y ; Ymax:=NextPoint.Y ;
MerkY:=NextPoint.Y ; MerkY:=NextPoint.Y ;
@ -232,7 +218,7 @@ begin
begin begin
FoundColor:= CalcMandel (SearchPoint,Zm) ; FoundColor:= CalcMandel (SearchPoint,Zm) ;
Putpixel (SearchPoint.X,SearchPoint.Y,FoundColor) ; Putpixel (SearchPoint.X,SearchPoint.Y,FoundColor) ;
if Flag then if SymetricCase then
PutPixel (SearchPoint.X,Max_Y_Width-SearchPoint.Y,FoundColor) ; PutPixel (SearchPoint.X,Max_Y_Width-SearchPoint.Y,FoundColor) ;
end ; end ;
if ColorsEqual(FoundColor,LastColor) then if ColorsEqual(FoundColor,LastColor) then
@ -268,40 +254,36 @@ end ;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
MAINROUTINE MAINROUTINE
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
{$ifndef Linux}
var var
error : word; error : word;
{$endif not Linux}
var neededtime,starttime : longint;
hour, minute, second, sec100 : word;
const
{$ifdef win32}
gmdefault : word = m640x480x16;
{$else not win32}
gmdefault : word = m640x480x256;
{$endif win32}
begin begin
{$ifdef go32v2}
{$ifdef debug}
{$warning If the compilation fails, you need to recompile}
{$warning the graph unit with -dDEBUG option }
Write('Use linear ? ');
readln(st);
if st='y' then UseLinear:=true;
{$endif debug}
{$endif go32v2}
{$ifdef Linux}
gm:=0;
gd:=0;
{$else}
if paramcount>0 then if paramcount>0 then
begin begin
val(paramstr(1),gm,error); val(paramstr(1),gm,error);
if error<>0 then if error<>0 then
gm:=$103; gm:=m640x400x256;
end end
else else
gm:=$103; gm:=m640x400x256;
gd:=$ff; gd:=detect;
{$ifDEF TURBO} GetTime(hour, minute, second, sec100);
gd:=detect; starttime:=((hour*60+minute)*60+second)*100+sec100;
{$endif}
{$endif}
InitGraph(gd,gm,''); InitGraph(gd,gm,'');
if GraphResult <> grOk then Halt(1); if GraphResult <> grOk then
begin
Writeln('Graph driver ',gd,' graph mode ',gm,' not supported');
Halt(1);
end;
Max_X_Width:=GetMaxX; Max_X_Width:=GetMaxX;
Max_y_Width:=GetMaxY; Max_y_Width:=GetMaxY;
Max_Color:=GetMaxColor-1; Max_Color:=GetMaxColor-1;
@ -316,28 +298,33 @@ begin
dy:=(y1 - y2) / Max_Y_Width ; dy:=(y1 - y2) / Max_Y_Width ;
if abs(y1) = abs(y2) then if abs(y1) = abs(y2) then
begin begin
{$ifndef NOFLAG} SymetricCase:=true;
flag:=true;
{$endif NOFLAG}
Y_Width:=Max_Y_Width shr 1 Y_Width:=Max_Y_Width shr 1
end end
else else
begin begin
flag:=false; SymetricCase:=false;
Y_Width:=Max_Y_Width; Y_Width:=Max_Y_Width;
end; end;
NextPoint.X:=0; NextPoint.X:=0;
NextPoint.Y:=0; NextPoint.Y:=0;
LastColor:=CalcMandel(SearchPoint,zm); LastColor:=CalcMandel(SearchPoint,zm);
CalcBounds ; CalcBounds ;
GetTime(hour, minute, second, sec100);
neededtime:=((hour*60+minute)*60+second)*100+sec100-starttime;
{$ifndef fpc_profile} {$ifndef fpc_profile}
readln; readln;
{$endif fpc_profile} {$endif fpc_profile}
CloseGraph; CloseGraph;
Writeln('Mandel took ',neededtime/100:0:3,' secs to generate mandel graph');
Writeln('With graph driver ',gd,' and graph mode ',gm);
end. end.
{ {
$Log$ $Log$
Revision 1.5 1999-05-27 21:36:33 peter Revision 1.6 1999-12-14 22:59:52 pierre
* adapted to new graph unit
Revision 1.5 1999/05/27 21:36:33 peter
* new demo's * new demo's
* fixed mandel for linux * fixed mandel for linux