Category : Pascal Source Code
Archive   : TPGRAFIX.ZIP
Filename : HAT.PAS

PROGRAM hat;

{ This program displays on the IBM graphics screen a plot of the 'hat'
{ function. The hat is displayed in the hi-resolution mode.
{
{ NOTE -- This program will take about an hour to run if you do not have
{ an 8087 chip running with Turbo Pascal-8087 v2.0. If you do have that
{ hardware/software configuration, the program will run in under three minutes.
{ You cannot halt the program with a BREAK command. You have to warm boot
{ (CONTROL-ALT-DEL) the IBM.}


CONST
p = 310;
q = 95;
xp = 180;
yp = 50;
zp = 64;

VAR
yf,xy,zf,xf,zt,xt,xr,yr,yy,xpzp : REAL;
xp2,zi,zzp,zzq,xl,xi,yi : INTEGER;
qq, a, zz, xx, x1, y1 : INTEGER;
aa : STRING[100];

TYPE
varX = RECORD
varL,varH: BYTE;
END;
TimeRec = RECORD
AX,BX: varX;
Min,Hour,Msec,Sec: BYTE;
BP,SI,DI,DS,ES,FLAGS: INTEGER;
END;
RecPack = RECORD
AX: varX;
BX,CX,DX,BP,SI,DI,DS,ES,FLAGS: INTEGER;
END;

VAR
intparm : RecPack;
i,j : INTEGER;
rx,ry : INTEGER;


PROCEDURE ShowTime;
VAR
timeparm : TimeRec;

BEGIN
WITH TimeParm DO
BEGIN
AX.varH := $2C;
MsDos(timeparm);
WRITELN('Time is : ',Hour,':',Min,':',Sec,'.',Msec);
END;
END;



BEGIN
qq := 2 * q;
xr := 1.5*PI;
xf := xr/xp;
xpzp := xp/zp;
xp2 := xp*xp;
yr := 1;
yf := yp/yr;
zf := xr/zp;

ShowTime;
HIRES; HiresColor(7);
ShowTime;
FOR zi:= -q TO q-1 DO
BEGIN
IF (zi >= -zp) AND (zi <= zp) THEN
BEGIN
zt := zi * xpzp;
zz := zi;
xl := TRUNC (0.5 + SQRT(xp2 - zt*zt));
FOR xi := - xl TO xl DO
BEGIN
xt := SQRT(xi*xi + zt*zt) * xf;
yy := (SIN(xt) + 0.4 * SIN(3 * xt)) * yf;
x1 := ROUND(xi + zz + p);
y1 := ROUND(qq - (yy - zz + q));
PLOT(x1,y1,1);
END;
END; {if}
END; {next zi}

GOTOXY(1,2);
ShowTime;
READLN(aa);
CRTINIT;
ShowTime;

END.