home *** CD-ROM | disk | FTP | other *** search
- program surface;
- {taken from page 184 PC tech Journal Vol. 3 No. 11}
- var
- xctr, yctr : real;
-
- { *** NOTE: The following definitions are part of my math library. They may or
- may not be needed, depending on which function you put into function f(x,y).
- You may want to omit these lines if you have your own functions library to
- put in here. For the sake of convenience, it would be wise to put these
- definitions in a file and include it at compile time with the i directive. *}
-
- { This program has been modified for the EGA by Kent Cedola, if you like a
- copy of all of the EGA graphic routines for Turbo Pascal, send Disk and SASE
- to Kent Cedola, 2015 Meadow Lake Court, Norfolk, VA 23518 * FREE * }
-
- const
- Tiny: real = 1E-38;
-
- {$I GPPARMS.P }
- {$I GPINIT.P }
- {$I GPTERM.P }
- {$I GPCOLOR.P }
- {$I GPMOVE.P }
- {$I GPPLOT.P }
- {$I GPLINE.P }
-
- function ArcSin(trig : real) : real;
- begin
- ArcSin := ArcTan(trig / sqrt(1 - sqr(trig)));
- end; { function ArcSin(trig : real) }
-
- function ArcCos(trig : real) : real;
- begin
- ArcCos := ArcTan(Sqrt(1 - Sqr(trig)) / trig);
- end; { function ArcCos(trig : real) }
-
- function Tan(trig : real) : real;
- begin
- Tan := Sin(trig) / Cos(trig);
- end;
-
- function E(x,y : real) : real; {raises x to the y pwr -- x^y in basic}
- begin
- E := Exp(y * Ln(x));
- end; { function E(x,y }
-
- { *** END OF MATH LIBRARY ***}
-
- {Define function to be graphed - z=f(x,y)}
- function f(x,y:real): real;
- var
- x1, y1 : real;
- begin
- x1:=abs(x-xctr); y1:=abs(y-yctr);
- { Function: Enter your own below. Notice that all others must be commented out
- 1. Pond Ripples
- 2. Stretched Planar Curve
- 3. Rippled Plane
- 4. Inverse Cone
- 5. Egg Carton
- 6. Pond Ripples 2
- f := sin(sqrt(x1*x1+y1*y1));
- f := sqrt(100-sqrt(x1*x1+y1*y1));
- f := exp(-(x*y+y*y)/90)*cos((x*x+y*y)/40);
- f := sqrt(x1*x1+y1*y1); }
- f := sin(x)+cos(y); {
- f := Sin(sqrt(x1*x1+y1*y1))/(sqrt(x1*x1+y1*y1)+tiny);
- f := sin(1/x+1/(x*y));}
- end; { function f(x,y:real) }
-
-
- Const
- xdiv = 40; {number of subdivisions of each axis}
- ydiv = 60;
- xeye = 100; {eye position}
- yeye = 3; {xeye and yeye should be positive}
- zeye = 8;
-
- var
- i,j : integer;
- xmin, xmax,
- ymin, ymax,
- zmin, zmax,
- xdif, ydif, zdif : real;
- p, q : array[0..xdiv,0..ydiv] of integer;
- y, z : array[0..xdiv,0..ydiv] of real;
-
- {input extreme values for x and y}
-
- procedure Input_Domain;
- begin
- write('Enter smallest value of x '); readln(xmin);
- write('Enter largest value of x '); readln(xmax); xdif:= xmax - xmin;
- Write('Enter smallest value of y '); readln(ymin);
- write('Enter largest value of y '); readln(ymax); ydif:= ymax - ymin;
- xctr:= xmin + xdif/2; yctr:= ymin + ydif/2;
- end; { procedure Input_Domain }
-
- {evaluate function at grid points and project to view plane}
-
- procedure Evaluate_and_Project;
- var
- xtemp, xtemp1, xtemp2,
- ytemp, ytemp1,
- ztemp,
- xavg, yavg : real;
-
- begin
- xavg:= (xmax+xmin)/2; yavg:=(ymax+ymin)/2;
- for i:=0 to xdiv do
- for j:=0 to ydiv do begin
- xtemp:=xmin+i*xdif/xdiv;
- ytemp:=ymin+j*ydif/ydiv;
- ztemp:=f(xtemp,ytemp);
- xtemp1:=xeye - xtemp;
- ytemp1:=yeye - ytemp;
- y[i,j]:= (xeye - xavg)*(xeye*ytemp - yeye*xtemp) /
- ((xeye - xavg)*xtemp1+(yeye-yavg)*ytemp1);
- if y[i,j] <> yeye then
- z[i,j] := zeye + (zeye - ztemp)*(Y[i,j] - yeye)/ytemp1
- else begin
- xtemp2 := yeye*(yavg - yeye) / (xeye - xavg);
- z[i,j] := zeye + (zeye - ztemp)*(xtemp2 - xeye) / xtemp1;
- end;
- end;
- end; { procedure Evaluate_and_Project }
-
- {determine projected extrema}
-
- procedure Find_Extrema;
- var
- ytemp, ztemp : real;
- begin
- ymax:= y[0,0]; ymin:=ymax;
- zmax:= z[0,0]; zmin:=zmax;
- for i:=0 to xdiv do
- for j:=0 to ydiv do begin
- ytemp:=y[i,j];
- ztemp:=z[i,j];
- if ytemp>ymax then ymax:=ytemp;
- if ytemp<ymin then ymin:=ytemp;
- if ztemp>zmax then zmax:=ztemp;
- if ztemp<zmin then zmin:=ztemp;
- end;
- end; { procedure Find_Extrema }
-
- procedure Scale_to_Screen;
- var
- dy, dz : real;
- begin
- dy:=(Ymax-ymin)/639; dz:=(Zmax - zmin)/349;
- for i:=0 to xdiv do
- for j:=0 to ydiv do begin
- p[i,j]:=round((y[i,j] - ymin) / dy);
- q[i,j]:=349 - round((z[i,j] - zmin) / dz);
- end;
- end; { procedure Scale_to_Screen }
-
- {exchange coordinates of two points}
-
- procedure Swap(var x1,y1,x2,y2:integer);
- var
- temp:integer;
- begin
- temp:=x1; x1:=x2; x2:=temp;
- temp:=y1; y1:=y2; y2:=temp;
- end; { procedure Swap(var x1,y1,x2,y2:integer) }
-
- {draws blank horizontal line}
-
- procedure Line(x0,x1,y:integer);
- begin
- GPCOLOR(Black);
- GPMOVE(x0,y);
- GPLINE(x1,y);
- end; { procedure Line(x0,x1,y:integer) }
-
- {blanks triangle}
-
- procedure Triblank(x0,y0,x1,y1,x2,y2:integer);
- var
- x3, x4,
- dx1, dx2, dy1, dy2,
- inc1, inc2,
- nx1, nx2 : integer;
-
- procedure Blank(y:integer);
- begin
- while y0<y do begin
- nx1:=nx1+dx1;
- if nx1>dy1 then
- repeat
- x3:=x3+inc1;
- nx1:=nx1-dy1;
- until nx1<=dy1;
- nx2:=nx2+dx2;
- if nx2>dy2 then
- repeat
- x4:=x4+inc2;
- nx2:=nx2 - dy2;
- until nx2<=dy2;
- y0:=y0+1;
- line(x3,x4,y0);
- end;
- end; { procedure Blank(y:integer) }
-
- begin
- if y1<y0 then swap(x0,y0,x1,y1);
- if y2<y0 then swap(x0,y0,x2,y2);
- if y2<y1 then swap(x1,y1,x2,y2);
- dy1:=y1-y0; dy2:=y2-y0;
- if x1<x0 then inc1:=-1 else inc1:=1;
- if x2<x0 then inc2:=-1 else inc2:=1;
- dx1:=abs(x1-x0); dx2:=abs(x2-x0);
- x3:=x0; x4:=x0;
- nx1:=dy1 div 2; nx2:=dy2 div 2;
- blank(y1);
- if x2<x1 then inc1:=-1 else inc1:=1;
- x3:=x1; dy1:=y2-y1;
- dx1:=abs(x1-x2); nx1:=dy1 div 2;
- blank(y2);
- end; { procedure Triblank(x0,y0,x1,y1,x2,y2:integer) }
-
- {Draws box with blank interior}
-
- procedure DrawBox(x1,y1,x2,y2,x3,y3,x4,y4 : integer);
- begin
- triblank(x1,y1,x2,y2,x3,y3);
- triblank(x2,y2,x3,y3,x4,y4);
- GPCOLOR(Green);
- GPMOVE(x1,y1); GPLINE(x2,y2);
- GPMOVE(x1,y1); GPLINE(x3,y3);
- GPMOVE(x2,y2); GPLINE(x4,y4);
- GPMOVE(x3,y3); GPLINE(x4,y4);
- end; { procedure DrawBox(x1,y1,x2,y2,x3,y3,x4,y4 : integer) }
-
- {Draws surface}
-
- procedure Graph;
- var
- x1,x2,x3,x4,y1,y2,y3,y4 : integer;
- begin
- GPINIT;
- for i:=0 to xdiv-1 do
- for j:=0 to ydiv-1 do begin
- x1:=p[i,j]; x2:=p[i+1,j];
- x3:=p[i,j+1]; x4:=p[i+1,j+1];
- y1:=q[i,j]; y2:=q[i+1,j];
- y3:=q[i,j+1]; y4:=q[i+1,j+1];
- drawBox(x1,y1,x2,y2,x3,y3,x4,y4);
- end;
- end; { procedure Graph }
-
-
- begin
- GPPARMS;
- GPINIT;
- GPCOLOR(Green);
- input_Domain;
- Evaluate_and_Project;
- Find_Extrema;
- Scale_to_Screen;
- Graph;
- repeat until keypressed;
- GPTERM;
- end.