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

 
Output of file : LAMP.PAS contained in archive : SPIN.ZIP
Program Lamp;

(* This program generates an AcroSpin file called LAMP.FIL that displays a *)
(* lamp. I wrote this program using Turbo Pascal Version 3.0. You can *)
(* modify the color and number of sides of each of the parts of the lamp by *)
(* changing the constants in the next section. *)
(* David B. Parker *)

(* Constants. *)

Const
Scale = 1000; (* Multiplier for coordinates. *)
SwitchAngles = 4; (* Number of sides on switch. *)
SwitchColor = 15; (* Color of switch. *)
BaseAngles = 8; (* Number of sides on base. *)
BaseColor = 10; (* Color of base. *)
StemAngles = 6; (* Number of sides on stem. *)
StemColor = 14; (* Color of stem. *)
BulbLines = 6; (* Number of horizontal lines on bulb. *)
BulbAngles = 6; (* Number of vertical lines on bulb. *)
BulbColor = 15; (* Color of bulb. *)
ShadeAngles = 8; (* Number of sides on shade. *)
ShadeColor = 13; (* Color of shade. *)

(* Variables. *)

Var I, J, K, L: Integer; (* Looping variables. *)
Output : Text; (* Output file. *)

(* Subroutine to write out text. *)

{$I WRITETEX.PAS}

(* Subroutine to calculate the X coordinate of a point on the surface of the *)
(* bulb, given the Y coordinate of the point and the angle around the bulb. *)

Function X( Y, Angle: Real ): Integer;
Begin
If Y >= 8793.0/19838.0 Then
X:=Round(Scale*Sqrt(Sqr(5.0/14.0)-Sqr(Y-9.0/14.0))*Cos(Angle))
Else X:=Round(Scale*(1175.0/1232.0-Sqrt(Sqr(977.0/1232.0)-Sqr(Y)))*Cos(Angle));
End;

(* Subroutine to calculate the Y coordinate of a point on the surface of the *)
(* bulb, given the fraction of arc length from the base of the bulb to the *)
(* top of the bulb. *)

Function Y( YFrac: Real ): Real;
Var Angle: Real;
Begin
Angle := ArcTan( 792.0/1175.0 );
If YFrac >= 977.0*Angle/(220.0*Pi+440.0*Angle) Then
Y := (5.0*Sin((1417.0*(YFrac-1.0)*Angle+220.0*Pi*YFrac)/440.0)+9.0)/14.0
Else Y := 977.0*sin((1417.0*Angle+220.0*Pi)*YFrac/977.0)/1232.0;
End;

(* Subroutine to calculate the Z coordinate of a point on the surface of the *)
(* bulb, given the Y coordinate of the point and the angle around the bulb. *)

Function Z( Y, Angle: Real ): Integer;
Begin
If Y >= 8793.0/19838.0 Then
Z:=Round(Scale*Sqrt(Sqr(5.0/14.0)-Sqr(Y-9.0/14.0))*Sin(Angle))
Else Z:=Round(Scale*(1175.0/1232.0-Sqrt(Sqr(977.0/1232.0)-Sqr(Y)))*Sin(Angle));
End;

(* Prepare the output file for writing. *)

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

(* Write out the end points for the lines in the switch. *)

For I := 1 To SwitchAngles Do
Begin
Writeln( Output,'EndPoint X ',
Round(Scale*(3.0/7.0+Cos(2.0*Pi*(I-1.0)/SwitchAngles)*3.0/112.0)),
' Y ',Round(-Scale*22.0/7.0),
' Z ',Round(Scale*Sin(2.0*Pi*(I-1.0)/SwitchAngles)*3.0/112.0),
' Name WL',I );
Writeln( Output,'EndPoint X ',
Round(Scale*(3.0/7.0+Cos(2.0*Pi*(I-1.0)/SwitchAngles)*3.0/112.0)),
' Y ',Round(-Scale*85.0/28.0),
' Z ',Round(Scale*Sin(2.0*Pi*(I-1.0)/SwitchAngles)*3.0/112.0),
' Name WH',I );
End;

(* Write out the lines in the switch. *)

For I := 1 To SwitchAngles Do
Begin
If I = SwitchAngles Then J := 1 Else J := I+1;
Writeln( Output,'Line From WL',I,' To WL',J,' Color ',SwitchColor );
Writeln( Output,'Line From WL',I,' To WH',I,' Color ',SwitchColor );
Writeln( Output,'Line From WH',I,' To WH',J,' Color ',SwitchColor );
End;

(* Write out the end points for the lines in the base. *)

For I := 1 To BaseAngles Do
Begin
Writeln( Output,'EndPoint',
' X ',Round(Scale*Cos(2.0*Pi*(I-1.0)/BaseAngles)*5.0/7.0),
' Y ',Round(-Scale*24.0/7.0),
' Z ',Round(Scale*Sin(2.0*Pi*(I-1.0)/BaseAngles)*5.0/7.0),
' Name BL',I );
Writeln( Output,'EndPoint',
' X ',Round(Scale*Cos(2.0*Pi*(I-1.0)/BaseAngles)*5.0/7.0),
' Y ',Round(-Scale*22.0/7.0),
' Z ',Round(Scale*Sin(2.0*Pi*(I-1.0)/BaseAngles)*5.0/7.0),
' Name BH',I );
End;

(* Write out the lines in the base. *)

For I := 1 To BaseAngles Do
Begin
If I = BaseAngles Then J := 1 Else J := I+1;
Writeln( Output,'Line From BL',I,' To BL',J,' Color ',BaseColor );
Writeln( Output,'Line From BL',I,' To BH',I,' Color ',BaseColor );
Writeln( Output,'Line From BH',I,' To BH',J,' Color ',BaseColor );
End;

(* Write out the end points for the lines in the stem. *)

For I := 1 To StemAngles Do
Begin
Writeln( Output,'EndPoint',
' X ',Round(Scale*Cos(2.0*Pi*(I-1.0)/StemAngles)*3.0/14.0),
' Y ',Round(-Scale*22.0/7.0),
' Z ',Round(Scale*Sin(2.0*Pi*(I-1.0)/StemAngles)*3.0/14.0),
' Name TL',I );
Writeln( Output,'EndPoint',
' X ',Round(Scale*Cos(2.0*Pi*(I-1.0)/StemAngles)*3.0/14.0),
' Y 0',
' Z ',Round(Scale*Sin(2.0*Pi*(I-1.0)/StemAngles)*3.0/14.0),
' Name TH',I );
End;

(* Write out the lines in the stem. *)

For I := 1 To StemAngles Do
Begin
If I = StemAngles Then J := 1 Else J := I+1;
Writeln( Output,'Line From TL',I,' To TL',J,' Color ',StemColor );
Writeln( Output,'Line From TL',I,' To TH',I,' Color ',StemColor );
Writeln( Output,'Line From TH',I,' To TH',J,' Color ',StemColor );
End;

(* Write out the end points for the lines in the bulb. *)

For I := 1 To BulbLines Do
For J := 1 To BulbAngles Do
Writeln( Output,'EndPoint',
' X ',X(Y((I-1.0)/BulbLines),2.0*Pi*(J-1.0)/BulbAngles),
' Y ',Round(Scale*Y((I-1.0)/BulbLines)),
' Z ',Z(Y((I-1.0)/BulbLines),2.0*Pi*(J-1.0)/BulbAngles),
' Name Y',I,'A',J );
Writeln( Output,'EndPoint',
' X 0 Y ',Scale,' Z 1 Name Y',BulbLines+1,'A0' );

(* Write out the lines in the bulb. *)

For I := 1 To BulbLines Do
For J := 1 To BulbAngles Do
Begin
If I = BulbLines Then K := 0 Else K := J;
If J = BulbAngles Then L := 1 Else L := J+1;
Writeln( Output,'Line',
' From Y',I,'A',J,' To Y',I+1,'A',K,' Color ',BulbColor );
Writeln( Output,'Line',
' From Y',I,'A',J,' To Y',I,'A',L,' Color ',BulbColor );
End;

(* Write out the end points for the lines in the shade. *)

For I := 1 To ShadeAngles Do
Begin
Writeln( Output,'EndPoint',
' X ',Round(Scale*Cos(2.0*Pi*(I-1.0)/ShadeAngles)*8.0/7.0),
' Y ',Round(-Scale*5.0/7.0),
' Z ',Round(Scale*Sin(2.0*Pi*(I-1.0)/ShadeAngles)*8.0/7.0),
' Name SL',I );
Writeln( Output,'EndPoint',
' X ',Round(Scale*Cos(2.0*Pi*(I-1.0)/ShadeAngles)),
' Y ',Round(Scale*15.0/7.0),
' Z ',Round(Scale*Sin(2.0*Pi*(I-1.0)/ShadeAngles)),
' Name SH',I );
End;

(* Write out the lines in the shade. *)

For I := 1 To ShadeAngles Do
Begin
If I = ShadeAngles Then J := 1 Else J := I+1;
Writeln( Output,'Line From SL',I,' To SL',J,' Color ',ShadeColor );
Writeln( Output,'Line From SL',I,' To SH',I,' Color ',ShadeColor );
Writeln( Output,'Line From SH',I,' To SH',J,' Color ',ShadeColor );
End;

(* Put the word 'LAMP' just underneath the lamp. *)

WriteText(12,Scale*3.0/7.0,Scale*3.0/7.0,
0.0,0.0,0.0,
-Scale*3.0/7.0*13.0/6.0,-Scale*29.0/7.0,0.0,
'LAMP' );

(* Close the output file. *)

Close( Output );
End.


  3 Responses to “Category : Printer + Display Graphics
Archive   : SPIN.ZIP
Filename : LAMP.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/