Category : Printer + Display Graphics
Archive   : SPIN.ZIP
Filename : DESKSIGN.PAS
(* This program allows you to create your own 3-dimensional desk sign. It *)
(* currently supports up to 10 lines of text on the sign. To change that, *)
(* just change the MaxLinesPlusOne constant below. David B. Parker *)
(* Constants. *)
Const MaxLinesPlusOne = 11; (* Maximum lines on sign, plus one. *)
LineSpace = 0.5; (* Space between lines. *)
TopSpace = 0.5; (* Space on top and bottom of lines. *)
SideSpace = 0.5; (* Space on left and right of lines. *)
SignAngle = 50.0; (* Angle of sign. *)
SignMargin = 0.25; (* Margin around border. *)
TopBevelFraction = 0.1; (* Fraction of sign size for top bevel. *)
SideBevelFraction = 0.1; (* Fraction of sign size for side bevel. *)
ScaleFactor = 1000.0; (* Scale factor for AcroSpin. *)
(* Variables. *)
Var Output : Text; (* Output file. *)
FileName : String[255]; (* Name of output file. *)
MaxLineLength: Real; (* Maximum length of all lines on sign. *)
SignHeight : Real; (* Slant height of the sign. *)
SignWidth : Real; (* Width of the sign. *)
BorderHeight : Real; (* Slant height of the border. *)
BorderWidth : Real; (* Width of the border. *)
CosAngle : Real; (* Cosine of the sign angle. *)
SinAngle : Real; (* Sine of the sign angle. *)
Y, Z : Real; (* Y and Z coordinates. *)
I : Integer; (* Looping variable. *)
LineCount : Integer; (* Number of lines on sign. *)
SignColor : Integer; (* Color of the text for the sign. *)
BaseColor : Integer; (* Color of the base for the sign. *)
BorderColor : Integer; (* Color of the border for the sign. *)
Done : Boolean; (* Flag to indicate end of while loop. *)
LineLength : Array[1..MaxLinesPlusOne] Of Real; (* Lengths of lines. *)
Line : Array[1..MaxLinesPlusOne] Of String[255]; (* Lines. *)
(* Include the subroutine that writes out text. *)
{$I WRITETEX.PAS}
(* Calculate the sine and cosine of the sign angle. *)
Begin
CosAngle := Cos(SignAngle*Pi/180.0);
SinAngle := Sin(SignAngle*Pi/180.0);
(* Read the name of the output file and open it. *)
Write('Enter a name for the output file: ' );
Readln(FileName);
For I := 1 To Length(FileName) Do FileName[I] := UpCase(FileName[I]);
Assign(Output,FileName);
Rewrite(Output);
(* Read the colors for the desk sign. *)
Writeln;
Writeln(
'(You can view colors 1-15 by entering the command ACROSPIN COLORS.FIL when'
);
Writeln('you return to the DOS prompt)');
Write('Enter the color number for the base of the desk sign (1-255): ');
Readln(BaseColor);
Write('Enter the color number for the text on the desk sign (1-255): ');
Readln(SignColor);
Write('Enter the color number for the border around the text (1-255): ');
Readln(BorderColor);
(* Read the lines for the desk sign. *)
Writeln;
Writeln(
'Enter up to 10 lines of text for the desk sign, followed by an empty line.'
);
Writeln(
'The supported characters are the uppercase letters, digits, spaces, periods,'
);
Writeln(
'double quotes, single quotes, dashes, and commas. Lowercase letters will be'
);
Writeln(
'converted to uppercase. You should not enter any spaces to the left or right'
);
Writeln(
'of the text because the program will automatically center each line on the'
);
Writeln('sign.');
Done := False;
LineCount := 0;
MaxLineLength := 0.0;
While Not Done Do
Begin
Readln(Line[LineCount+1]);
If Length(Line[LineCount+1]) = 0 Then Done := True
Else Begin
LineCount := LineCount + 1;
If LineCount = MaxLinesPlusOne Then
Begin
Writeln('Too many lines for the sign' );
Halt;
End;
LineLength[LineCount] := TextLength(Line[LineCount]) - 1.0/6.0;
If LineLength[LineCount] > MaxLineLength Then
MaxLineLength := LineLength[LineCount];
End;
End;
If LineCount = 0 Then
Begin
Writeln('No lines were entered' );
Halt;
End;
(* Calculate the size of the sign. *)
BorderHeight := LineCount + (LineCount-1)*LineSpace + 2.0*TopSpace;
BorderWidth := MaxLineLength + 2.0*SideSpace;
SignHeight := BorderHeight+2.0*SignMargin;
SignWidth := BorderWidth+2.0*SignMargin;
(* Write out the endpoints for the base. *)
For I := 1 To 2 Do
Begin
Writeln(Output,'EndPoint',
' X ',Round((2*I-3)*ScaleFactor*
(0.5*SignWidth+SideBevelFraction*SignHeight)),
' Y 0',
' Z 0',
' Name P1',I);
Writeln(Output,'EndPoint',
' X ',Round((2*I-3)*ScaleFactor*
(0.5*SignWidth+SideBevelFraction*SignHeight)),
' Y ',Round(ScaleFactor*
SignHeight*(SinAngle*
(1.0+TopBevelFraction*(1.0/SinAngle+1.0/CosAngle))
-SideBevelFraction/CosAngle)),
' Z 0',
' Name P2',I);
Writeln(Output,'EndPoint',
' X ',Round((2*I-3)*ScaleFactor*
(0.5*SignWidth+SideBevelFraction*SignHeight)),
' Y 0',
' Z ',Round(ScaleFactor*SignHeight*
(CosAngle*(1.0+TopBevelFraction*(1.0/SinAngle+1.0/CosAngle))
-SideBevelFraction/SinAngle)),
' Name P3',I);
Writeln(Output,'EndPoint',
' X ',Round((2*I-3)*ScaleFactor*0.5*SignWidth),
' Y ',Round(ScaleFactor*SignHeight*(SinAngle+TopBevelFraction)),
' Z 0',
' Name P4',I);
Writeln(Output,'EndPoint',
' X ',Round((2*I-3)*ScaleFactor*0.5*SignWidth),
' Y ',Round(ScaleFactor*SignHeight*(SinAngle+TopBevelFraction)),
' Z ',Round(ScaleFactor*SignHeight*TopBevelFraction),
' Name P5',I);
Writeln(Output,'EndPoint',
' X ',Round((2*I-3)*ScaleFactor*0.5*SignWidth),
' Y ',Round(ScaleFactor*SignHeight*TopBevelFraction),
' Z ',Round(ScaleFactor*SignHeight*(CosAngle+TopBevelFraction)),
' Name P6',I);
Writeln(Output,'EndPoint',
' X ',Round((2*I-3)*ScaleFactor*0.5*SignWidth),
' Y 0',
' Z ',Round(ScaleFactor*SignHeight*(CosAngle+TopBevelFraction)),
' Name P7',I);
Writeln(Output,'EndPoint',
' X ',Round((2*I-3)*ScaleFactor*(0.5*SignWidth-SignMargin)),
' Y ',Round(ScaleFactor*
(SignMargin*SinAngle+SignHeight*TopBevelFraction)),
' Z ',Round(ScaleFactor*
(SignHeight*(CosAngle+TopBevelFraction)-SignMargin*CosAngle)),
' Name P8',I);
Writeln(Output,'EndPoint',
' X ',Round((2*I-3)*ScaleFactor*(0.5*SignWidth-SignMargin)),
' Y ',Round(ScaleFactor*
((SignHeight-SignMargin)*SinAngle+SignHeight*TopBevelFraction)),
' Z ',Round(ScaleFactor*
(SignHeight*TopBevelFraction+SignMargin*CosAngle)),
' Name P9',I);
End;
(* Write out the lines for the base. *)
For I := 1 To 2 Do
Begin
Writeln(Output,'Line From P1',I,' To P2',I,' Color ',BaseColor);
Writeln(Output,'Line From P2',I,' To P3',I,' Color ',BaseColor);
Writeln(Output,'Line From P3',I,' To P1',I,' Color ',BaseColor);
Writeln(Output,'Line From P2',I,' To P4',I,' Color ',BaseColor);
Writeln(Output,'Line From P2',I,' To P5',I,' Color ',BaseColor);
Writeln(Output,'Line From P3',I,' To P6',I,' Color ',BaseColor);
Writeln(Output,'Line From P3',I,' To P7',I,' Color ',BaseColor);
Writeln(Output,'Line From P4',I,' To P5',I,' Color ',BaseColor);
Writeln(Output,'Line From P5',I,' To P6',I,' Color ',BaseColor);
Writeln(Output,'Line From P6',I,' To P7',I,' Color ',BaseColor);
End;
Writeln(Output,'Line From P11 To P12 Color ',BaseColor);
For I := 4 To 7 Do
Writeln(Output,'Line From P',I,'1 To P',I,'2 Color ',BaseColor);
(* Write out the lines for the border. *)
Writeln(Output,'Line From P81 To P82 Color ',BorderColor);
Writeln(Output,'Line From P81 To P91 Color ',BorderColor);
Writeln(Output,'Line From P82 To P92 Color ',BorderColor);
Writeln(Output,'Line From P91 To P92 Color ',BorderColor);
(* Write out the text for the sign. *)
Y := (SignHeight*TopBevelFraction/SinAngle+TopSpace+SignMargin+
(LineCount-1)*(1.0+LineSpace))*SinAngle;
Z := SignHeight*CosAngle*(1.0+TopBevelFraction*(1.0/SinAngle+1.0/CosAngle))
-(SignHeight*TopBevelFraction/SinAngle+TopSpace+SignMargin+
(LineCount-1)*(1.0+LineSpace))*CosAngle;
For I := 1 To LineCount Do
Begin
WriteText(SignColor,ScaleFactor,ScaleFactor,
SignAngle-90.0,0.0,0.0,
-ScaleFactor*0.5*LineLength[I],ScaleFactor*Y,ScaleFactor*Z,
Line[I]);
Y := Y-SinAngle*(1.0+LineSpace);
Z := Z+CosAngle*(1.0+LineSpace);
End;
(* Close the output file and return. *)
Close(Output);
Writeln('To view your desk sign, enter the command ACROSPIN ',FileName,
' at the DOS');
Writeln('prompt.' );
End.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
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/