Category : Printer + Display Graphics
Archive   : SPIN.ZIP
Filename : SURFACE.PAS

 
Output of file : SURFACE.PAS contained in archive : SPIN.ZIP
Program Surface;

(* This program generates an AcroSpin file called SURFACE.FIL that displays a *)
(* 3-dimensional surface plot. I wrote this program using Turbo Pascal *)
(* version 3.0. You can plot your own function by changing the Z subroutine *)
(* below. By changing the following constants, you can control a number of *)
(* other parameters. *)
(* *)
(* David B. Parker *)

(* Constants. *)

Const
AutoScaling = True; (* Automatically scale Z to look nice. *)
MinX = -1.0; (* Minimum x value. *)
MaxX = 1.0; (* Maximum x value. *)
MinY = -1.0; (* Minimum y value. *)
MaxY = 1.0; (* Maximum y value. *)
XDivisions = 10; (* Number of x divisions. *)
YDivisions = 10; (* Number of y divisions. *)
SurfaceColor = 13; (* Color to use for the surface. *)
AxisColor = 15; (* Color to use for the axes. *)
TextColor = 15; (* Color to use for the text. *)

(* Variables. *)

Var ZArray : Array[0..XDivisions,0..YDivisions] Of Real;
I, J : Integer; (* Looping variables. *)
MinZ, MaxZ : Real; (* Minimum and maximum z values. *)
XRange, YRange, ZRange: Real; (* Range of x, y, and z values. *)
MaxRange : Real; (* Maximum of the three ranges. *)
MinMaxFlag : Boolean; (* Flag variable. *)
Output : Text; (* Output file. *)

(* Function to be plotted. Another good function is Z := X*Y. *)

Function Z( X, Y: Real ): Real;
Begin
Z := Exp(-X*X-Y*Y)*Cos(2.0*(X*X+Y*Y));
End;

(* Include the subroutine that writes out text. *)

{$I WRITETEX.PAS}

(* Open the output file. *)

Begin
Assign(Output,'SURFACE.FIL');
Rewrite(Output);

(* Calculate the points on the surface, remembering the minimum and maximum *)
(* values. *)

XRange := MaxX-MinX;
YRange := MaxY-MinY;
MinMaxFlag := False;
For I := 0 to XDivisions Do
For J := 0 To YDivisions Do
Begin
ZArray[I,J] := Z(MinX+I*XRange/XDivisions,MinY+J*YRange/YDivisions);
If Not MinMaxFlag Then
Begin
MinMaxFlag := True;
MinZ := ZArray[I,J];
MaxZ := MinZ;
End
Else If ZArray[I,J] < MinZ Then MinZ := ZArray[I,J]
Else If ZArray[I,J] > MaxZ Then MaxZ := ZArray[I,J];
End;
ZRange := MaxZ-MinZ;

(* Calculate the maximum range of the x, y, and z coordinates. If *)
(* autoscaling was requested, scale the z coordinates so that their range is *)
(* the same as the maximum of the x and y ranges. *)

MaxRange := XRange;
If MaxRange < YRange Then MaxRange := YRange;
If AutoScaling Then
Begin
For I := 0 To XDivisions Do
For J := 0 To YDivisions Do
ZArray[I,J] := ZArray[I,J]*MaxRange/ZRange;
MaxZ := MaxZ*MaxRange/ZRange;
MinZ := MinZ*MaxRange/ZRange;
End
Else If MaxRange < ZRange Then MaxRange := ZRange;

(* Write out the points for the surface. The name of each end point is the *)
(* letter X, followed by the number of the x coordinate, followed by the *)
(* letter Y, followed by the number of the y coordinate. *)

For I := 0 to XDivisions Do
For J := 0 To YDivisions Do
Writeln( Output,'EndPoint',
' X ',Round(13000.0*(2.0*I/XDivisions-1.0)*XRange/MaxRange),
' Y ',Round(13000.0*(2.0*ZArray[I,J]-MaxZ-MinZ)/MaxRange),
' Z ',Round(13000.0*(1.0-2.0*J/YDivisions)*YRange/MaxRange),
' Name X',I,'Y',J );

(* Write out the lines for the surface. *)

For I := 0 To XDivisions Do
For J := 0 To YDivisions Do
Begin
If I < XDivisions Then
Writeln( Output,'Line From X',I,'Y',J,
' To X',I+1,'Y',J,' Color ',SurfaceColor );
If J < YDivisions Then
Writeln( Output,'Line From X',I,'Y',J,
' To X',I,'Y',J+1,' Color ',SurfaceColor );
End;

(* Write out the x, y, and z axes. *)

Writeln(Output,'EndPoint X -15000 Y -15000 Z 15000 Name X0Y0Z1');
Writeln(Output,'EndPoint X 15000 Y -15000 Z 15000 Name X1Y0Z1');
Writeln(Output,'EndPoint X -15000 Y 15000 Z 15000 Name X0Y1Z1');
Writeln(Output,'EndPoint X -15000 Y -15000 Z -15000 Name X0Y0Z0');
Writeln(Output,'Line From X0Y0Z1 To X1Y0Z1 Color ',AxisColor);
Writeln(Output,'Line From X0Y0Z1 To X0Y1Z1 Color ',AxisColor);
Writeln(Output,'Line From X0Y0Z1 To X0Y0Z0 Color ',AxisColor);

(* Put little arrows on the axes. *)

Writeln(Output,'EndPoint X 14500 Y -14550 Z 15000 Name XArrow1');
Writeln(Output,'EndPoint X 14500 Y -15450 Z 15000 Name XArrow2');
Writeln(Output,'EndPoint X -14550 Y 14500 Z 15000 Name ZArrow1');
Writeln(Output,'EndPoint X -15450 Y 14500 Z 15000 Name ZArrow2');
Writeln(Output,'EndPoint X -15000 Y -14550 Z -14500 Name YArrow1');
Writeln(Output,'EndPoint X -15000 Y -15450 Z -14500 Name YArrow2');
Writeln(Output,'Line From XArrow1 To X1Y0Z1 Color ',AxisColor);
Writeln(Output,'Line From XArrow2 To X1Y0Z1 Color ',AxisColor);
Writeln(Output,'Line From ZArrow1 To X0Y1Z1 Color ',AxisColor);
Writeln(Output,'Line From YArrow2 To X0Y0Z0 Color ',AxisColor);
Writeln(Output,'Line From YArrow1 To X0Y0Z0 Color ',AxisColor);
Writeln(Output,'Line From ZArrow2 To X0Y1Z1 Color ',AxisColor);

(* Write out the legends for the axes. *)

WriteText(TextColor,1500.0,1500.0,0.0,0.0,0.0,13000.0,-18000.0,15000.0,'X');
WriteText(TextColor,1500.0,1500.0,0.0,-90.0,0.0,-15000.0,-18000.0,-13000.0,'Y');
WriteText(TextColor,1500.0,1500.0,0.0,0.0,0.0,-18000.0,13000.0,15000.0,'Z');

(* Close the output file. *)

Close(Output);
End.


  3 Responses to “Category : Printer + Display Graphics
Archive   : SPIN.ZIP
Filename : SURFACE.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/