mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 05:49:23 +02:00
* adapted to new graph unit
This commit is contained in:
parent
540c68e49f
commit
525f8777c8
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user