Psychedelia‎ > ‎

Source code

Program Psychedelic_Trigonometry;             { Last modified: Jan. 30, 1989
I started this program at 1360 Tropical on Saturday afternoon, Nov. 11, 1988

case Graphdriver of
EGA: begin s:=18; c:=11; end;
VGA: begin s:=20; c:=16; end;
end;


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Trig.Pas !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! !
! (C) Copyright Matthew Reiser 1989. All Rights Reserved !
! !
! This program belongs to Matthew R. Reiser. It is to be considered a trade !
! secret and is not to be divulged or used by parties who have not received !
! written authorization from the owner. If you have any questions, please !
! call (818) 351-0428. !
! !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!



Ideas for enhancements:
-----------------------
Short range
* Use OOP concepts as much as possible as practice
* Incorporate the fastatkb 00 code into trig.exe (DOS Power Tools)
* Show the Print Menu (e.g. HP, Dot Matrix, Cancel, etc.)
* Finish Help Topics.
* Change pallette to be able to switch to colors that are closer to each
other during the auto-color change.
(e.g. blue to green instead of blue to magenta.)
* Add system date and time to the PATH.DAT dat file.

Longer range goals
- Scrunch the EGA pig to VGA size in order to
A. Make him look better.
B. Allow EGA pig quotes.
C. Make a more readable EGA menu (more roomy).
D. Prepare for 8514A or Hercules implementation.
- Pig quotes (use <smallfont> to fit bigger words between the ears. *)
a. Reiterate the option user just pressed.
b. Utter subliminal messages.
c. Generate Random quotes from the Pig!
- Allow for the quick input of Paths larger than 9999. Use something
similar to Increment (?)
- Allow user to redefine the 0-9 "quickpaths" (use variable array)
(but keep defaults just in case by storing them in a constant array)
- To keep track of options and path redefinitions once the program has
ended, store values in a TrigPref file!


This Pascal program:
1. Creates mesmerizing images on the monitor.
2. Runs in either EGA or VGA mode.
3. Requires the use of the units Include.Pas and Graphinc.Pas
4. Runs a Hell of a lot better with a math chip on the host.


Layout of Source Code
---------------------
1. Initialization routines
2. Window-drawing routines
3. Option handling routines
4. Window-managing routines
5. Main program }
(*--------------------------------------------------------------------------*)
USES Graph, CRT,
Graphinc, Include,
PrnGraph,
TrigAux;

Const global_want_oval = not true;
global_want_box = not true;

Var main_response : char;
Pig_Motion_Criterion : longint;
want_auto_change_color : boo;
want_changing_pupil_color: boo;
(*--------------------------------------------------------------------------*)
(*----------------------- Initialization Routines ------------------------*)
(*--------------------------------------------------------------------------*)
Procedure Generate_Random_Starting_Theta;
CONST max_int = 32767;
BEGIN
theta:= random(max_int); (* anything within the range of integer type *)
if random > 0.5 then theta:= -theta;
END; (* Generate_Random_Starting_Theta *)
(*---------------------------------------------------------------------------*)
PROCEDURE Refresh_Screen;
BEGIN
(* Determine the origin for the function *)
if want_random_origins then Generate_Random_Starting_Theta (* start the new function at a random spot *)
else theta:= 0; (* start the new function at the origin *)
FullTrigPort;
clearviewport;
END; (* Refresh_Screen *)
(*--------------------------------------------------------------------------*)
Procedure Create_Storage_File;
BEGIN
rewrite(PathFile);
writeln(PathFile, 'Stored information from recent executions of Psychedelic Trigonometry:');
writeln(PathFile, 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
writeln(PathFile);
writeln(PathFile, 'Generator Path');
writeln(PathFile, 'ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');
END; (* Create_Storage_File *)
(*--------------------------------------------------------------------------*)
Procedure Initialize_Pixel_Erasure_Array; (* Called many times *)
VAR count:int;
BEGIN
curcount := 0;
shift := Num_Stored_Pixels - 1; (* this is the max. pixel shift *)
prevcount:= Num_Stored_Pixels - shift; (* start off HIGH in array and come back "underneath" curcount when we need it *)
END; (* Initialize_Pixel_Erasure_Array *)
(*--------------------------------------------------------------------------*)
Procedure Initialize_Matt_Options; (* Assorted initialization: to be performed each time program starts *)
VAR count:int;
BEGIN
(* Screen prefs. *)
trigy := 535; {gen.}
trigy_inc := 1; {inc.}
theta_inc :=5909; {path}
Num_Stored_Pixels:= 300; {Len.}
theta := 0;
for count:= 1 to Max_Stored_Pixels do (* Assign all locations within the <Stored_Pixel> array to (1,1) *)
with Stored_Pixels[count] do begin x:=1; y:=1; end;
Initialize_Pixel_Erasure_Array;
assign(PathFile, 'Path.dat');
newstore:= true;

(* Misc stuff *)
newscreen:= true;
beginning:= true;
want_changing_pupil_color:= false;
END; (* Initialize_Matt_Options *)
(*--------------------------------------------------------------------------*)
Procedure Initialize_User_Options; (* Assorted initialization: to be performed each time program starts *)
BEGIN
color0 := lightgray; (* constant *)
color1 := lightred; (* variable *)
if want_changing_pupil_color then pupilcolor:= color1
else pupilcolor:= pigcolor;

want_auto_change_color:= false;
want_random_origins:= not true;
want_erase:= true;
current_Menu:= Menu_1;
END; (* Initialize_User_Options *)
(*--------------------------------------------------------------------------*)
Procedure Look_for_command_line_parameters;
BEGIN
clrscr;
case paramcount of
0: begin want_box:= false; want_oval:= false; end;
1: want_box:= (paramstr(1) = 'b');
2: begin want_box:= (paramstr(1) = 'b');
want_oval:= (paramstr(2) = 'o'); end;
end; (* case *)
if global_want_oval then want_oval:= true;
if global_want_box then want_box:= true;
END; (* Look_for_command_line_parameters *)
(*--------------------------------------------------------------------------*)
procedure Incorporate_Font_and_Driver_into_EXE;
BEGIN
if RegisterBGIdriver(@EGAVGADriverProc) < 0 then begin Writeln('EGA/VGA: ', GraphErrorMsg(GraphResult)); Halt(1); end;
if RegisterBGIfont (@GothicFontProc) < 0 then begin Writeln('Gothic: ', GraphErrorMsg(GraphResult)); Halt(1); end;
if RegisterBGIfont (@TriplexFontProc) < 0 then begin Writeln('Triplex: ', GraphErrorMsg(GraphResult)); Halt(1); end;
END; (* Incorporate_Font_and_Driver_into_EXE *)
(*--------------------------------------------------------------------------*)
(*----------------------- Window-Drawing Routines ------------------------*)
(*--------------------------------------------------------------------------*)
Procedure Draw_Main_Window;
CONST dist_from_bottom = 9;
BEGIN
(* Clear main window *)
FullTrigPort;
clearviewport;
(* Draw outline of the main window *)
setcolor(mainwindowcolor);
fullport;
rectangle(0,0, maxx,maxy);

(* Draw the title and author of the program at the bottom of the screen *)
setcolor(black); outtextxy( 9, getmaxy-dist_from_bottom, 'Psychedelic Trigonometry 0.9');
setcolor(sigcolor); outtextxy( 9-offset, getmaxy-dist_from_bottom-offset,'Psychedelic Trigonometry 0.9');

settextjustify(righttext,toptext);
setcolor(black); outtextxy(maxx-3, getmaxy-dist_from_bottom, '(C) Matthew Reiser 1989');
setcolor(sigcolor); outtextxy(maxx-3-offset, getmaxy-dist_from_bottom-offset,'(C) Matthew Reiser 1989');
settextjustify(lefttext,toptext);
END; (* Draw_Main_Window *)
(*---------------------------------------------------------------------------*)
(*----------------------- Menu-related Stuff -------------------------*)
(*---------------------------------------------------------------------------*)
Procedure Define_Menu_Contents; (* Define the contents of the Menus *)
BEGIN
with Menus[Menu_1] do begin
Menu_Title:= 'Menu 1';
with Entries[1] do begin Hot_key:= 'R '; Command:= 'Refresh '; end;
with Entries[2] do begin Hot_key:= 'G '; Command:= 'Generator '; end;
with Entries[3] do begin Hot_key:= 'I '; Command:= 'Increment '; end;
with Entries[4] do begin Hot_key:= 'P '; Command:= 'Path '; end;
with Entries[5] do begin Hot_key:= '0-9'; Command:= ' QPaths'; end;
with Entries[6] do begin Hot_key:= 'F1 '; Command:= ' Help! '; end;
with Entries[7] do begin Hot_key:= 'F9 '; Command:= ' Print '; end;
with Entries[8] do begin Hot_key:= 'Tab'; Command:= ' Menu ¯'; end;
end; (* with Menu 1 *)

with Menus[Menu_2] do begin
Menu_Title:= 'Menu 2';
with Entries[1] do begin Hot_key:= 'F '; Command:= 'Forward '; end;
with Entries[2] do begin Hot_key:= 'B '; Command:= 'Backward '; end;
with Entries[3] do begin Hot_key:= 'Up '; Command:= ' Path + '; end;
with Entries[4] do begin Hot_key:= 'Dn '; Command:= ' Path - '; end;
with Entries[5] do begin Hot_key:= '¯¯ '; Command:= ' Color +'; end;
with Entries[6] do begin Hot_key:= '®® '; Command:= ' Color -'; end;
with Entries[7] do begin Hot_key:= 'Spc'; Command:= ' Pause '; end;
with Entries[8] do begin Hot_key:= 'Tab'; Command:= ' Menu ¯'; end;
end; (* with Menu 2 *)

with Menus[Menu_3] do begin
Menu_Title:= 'Menu 3';
with Entries[1] do begin Hot_key:= ' N'; Command:= 'Boss Near'; end;
with Entries[2] do begin Hot_key:= 'Hom'; Command:= ' Len - '; end;
with Entries[3] do begin Hot_key:= 'End'; Command:= ' Len + '; end;
with Entries[4] do begin Hot_key:= 'E '; Command:= 'Erase on '; end;
with Entries[5] do begin Hot_key:= 'O '; Command:= 'Origin (0)'; end;
with Entries[6] do begin Hot_key:= 'S '; Command:= 'Store Path'; end;
with Entries[7] do begin Hot_key:= 'Esc'; Command:= ' Quit '; end;
with Entries[8] do begin Hot_key:= 'Tab'; Command:= ' Menu ¯'; end;
end; (* with Menu 3 *)

with Menus[Menu_4] do begin
Menu_Title:= 'Extras';
with Entries[1] do begin Hot_key:= 'C '; Command:= 'Color:user'; end;
with Entries[2] do begin Hot_key:= 'W '; Command:= 'Worbulate '; end;
with Entries[3] do begin Hot_key:= 'F5 '; Command:= ' Shrink '; end;
with Entries[4] do begin Hot_key:= 'A '; Command:= 'About P.T.'; end;
with Entries[5] do begin Hot_key:= ' '; Command:= ' '; end;
with Entries[6] do begin Hot_key:= ' '; Command:= ' '; end;
with Entries[7] do begin Hot_key:= ' '; Command:= ' '; end;
with Entries[8] do begin Hot_key:= 'Tab'; Command:= ' Menu ¯'; end;
end; (* with Menu 4 *)

END; (* Define_Menu_Contents *)
(*--------------------------------------------------------------------------*)
PROCEDURE Display_Contents_of_1_Menu(Menu_Number, s,c:int); (* Draws one a menu in upper right corner. *)
VAR count:int;
BEGIN
WITH Menus[Menu_Number] do
begin (*****************)
(* Print the Title of the Menu *)
centered_underlined_Text(Menu_Title,0,omaxx-ominx,5,underline_on,just_off);

(* Print the Commands *)
setcolor(commandcolor);
for count:= 1 to max_commands do
with Entries[count] do outtextxy(Menu_textx, ((count-1)*c)+s, Command);

(* Print the HotKeys *)
setcolor(MenuHotKeyColor);
for count:= 1 to max_commands do
with Entries[count] do outtextxy(Menu_textx, ((count-1)*c)+s, Hot_Key);

end; (* WITH Menu[Menu_Number] ***************)
END; (* Display_Contents_of_1_Menu *)
(*--------------------------------------------------------------------------*)
Procedure Draw_1_Menu(Menu_Number: int);
VAR s,c:int;
BEGIN
current_Menu:= Menu_Number; (* The menu called for is now the current menu *)
case Graphdriver of
EGA: begin s:=18; c:=11; end;
VGA: begin s:=20; c:=16; end;
end;
setviewport(ominx+1,ominy+1, omaxx-1,omaxy-1, clipon); clearviewport;
setviewport(ominx,ominy, omaxx,omaxy, clipon);
setcolor(windowcolor);
if newscreen then begin rectangle(0,0, MenuWindowWidth, omaxy); newscreen:=false; end;
case Menu_Number of
Menu_1: Display_Contents_of_1_Menu(1,S,C);
Menu_2: Display_Contents_of_1_Menu(2,S,C);
Menu_3: Display_Contents_of_1_Menu(3,S,C);
Menu_4: Display_Contents_of_1_Menu(4,S,C);
end;
FullTrigPort;
END; (* Draw_1_Menu *)
(*--------------------------------------------------------------------------*)
(*------------------- Changing 1 line of a Menu --------------------*)
(*--------------------------------------------------------------------------*)
PROCEDURE Display_1_Line_of_a_Menu(Menu_Number,Row_number, s,c:int); (* Prints the changed menu item. *)
BEGIN
WITH Menus[Menu_Number] do
begin
(* Print the changed Command *)
setcolor(commandcolor);
with Entries[Row_number] do outtextxy(Menu_textx, ((Row_number-1)*c)+s, Command);

(* Print the (not necessarily changed) HotKey *)
setcolor(MenuHotKeyColor);
with Entries[Row_number] do outtextxy(Menu_textx, ((Row_number-1)*c)+s, Hot_Key);
end; (* WITH Menu[Menu_Number] *)
END; (* Display_1_Line_of_a_Menu *)
(*--------------------------------------------------------------------------*)
Procedure Setup_to_Display_1_Line_of_a_Menu(Menu_number,Row_number:int);
VAR s,c:int;
BEGIN
current_Menu:= Menu_Number; (* The menu called for is now the current menu *)
case Graphdriver of
EGA: begin s:=18; c:=11; end;
VGA: begin s:=20; c:=16; end;
end;
(* clear the old menu entry *)
setviewport(ominx+1, ominy+(Row_number-1)*c+s, omaxx-1, ominy+Row_number*c+s-1, clipon);
clearviewport;
setviewport(ominx,ominy, omaxx,omaxy, clipon);
case Menu_Number of
Menu_1: Display_1_Line_of_a_Menu(1,Row_number,S,C);
Menu_2: Display_1_Line_of_a_Menu(2,Row_number,S,C);
Menu_3: Display_1_Line_of_a_Menu(3,Row_number,S,C);
Menu_4: Display_1_Line_of_a_Menu(4,Row_number,S,C);
end;
FullTrigPort;
END; (* Setup_to_Display_1_Line_of_a_Menu *)
(*---------------------------------------------------------------------------*)
PROCEDURE Change_Menu_Contents(Menu_Number, Row_Number:int);
BEGIN
if Menu_Number = Menu_3 then
with menus[Menu_Number] do
case Row_Number of
4: if want_erase then Entries[row_number].Command:='Erase on'
else Entries[row_number].Command:='Erase off';
5: if want_random_origins then Entries[row_number].Command:='Origin (R)'
else Entries[row_number].Command:='Origin (0)';
end (* case *)

else if Menu_Number = Menu_4 then
with menus[Menu_Number] do
case Row_Number of
1: if want_auto_change_color then Entries[row_number].Command:='Color:auto'
else Entries[row_number].Command:='Color:user';
end; (* case *)

(* Display the results of a changed menu *)
if current_menu = Menu_Number then Setup_to_Display_1_Line_of_a_Menu(Menu_number,Row_number);
END; (* Change_Menu_Contents *)
(*--------------------------------------------------------------------------*)
(*---------------------- Screen-Setup Stuff --------------------*)
(*--------------------------------------------------------------------------*)
Procedure Draw_A_Small_Window(window_type:char); (* Used for drawing the Gen., Inc., Path, and Length windows *)
VAR xminx,xminy, xmaxx,xmaxy:int;
title : string[4];
num_string: string[6];
BEGIN
case window_type of (* Determine window coords and window title *)
'g': begin xminx:=gminx; xmaxx:=gmaxx; xminy:=gminy; xmaxy:=gmaxy; Title:='Gen.'; end;
'i': begin xminx:=iminx; xmaxx:=imaxx; xminy:=iminy; xmaxy:=imaxy; Title:='Inc.'; end;
'p': begin xminx:=pminx; xmaxx:=pmaxx; xminy:=pminy; xmaxy:=pmaxy; Title:='Path'; end;
'l': begin xminx:=lminx; xmaxx:=lmaxx; xminy:=lminy; xmaxy:=lmaxy; Title:='Len.'; end;
end; (* case *)

(* Clear window contents *)
setviewport(xminx+1,xminy+1, xmaxx-1,xminy+smallboxheight-1, clipon);
clearviewport;

(* Draw window border *)
setviewport(xminx,xminy, xmaxx,xminy+smallboxheight, clipoff);
setcolor(windowcolor);
rectangle(0,0, sbw, smallboxheight);

(* Determine which numerical value will be printed *)
case window_type of
'g': str(trigy, num_string);
'i': str(trigy_inc, num_string);
'p': str(theta_inc, num_string);
'l': str(Num_Stored_Pixels, num_string);
end; (* case *)
(* Print the value inside *)
outtextxy(textx,texty, num_string);

(* Print window title *)
fullport;
setcolor(black); outtextxy(ominx+1+offset, xminy+offset+texty,Title);
setcolor(lightgray); outtextxy(ominx+1, xminy +texty,Title);
END; (* Draw_A_Small_Window *)
(*--------------------------------------------------------------------------*)
Procedure Draw_oval; (* Draws the expanding oval in the lower right corner *)
CONST thickness = 12; (* thickness of oval as it's growing *)
final_thickness = 4; (* thickness of oval after its growth *)
ovalcolor = lightgray;
VAR x,y,z, total_oval_height: int;
BEGIN
(* Clear the Help Window *)
setviewport(hminx,hminy, hmaxx,hmaxy, clipon);
clearviewport;

(* Draw the border of the Pig window *)
setcolor(windowcolor);
rectangle(0,0,MenuWindowWidth, hmaxy-hminy);

if want_oval then begin
total_oval_height:= ((hmaxy-hminy) div 2) - 1;
x:= MenuWindowWidth div 2;
y:= total_oval_height+1;
z:= x-1;
(* Draw the opening oval *)
for jk:= thickness to total_oval_height do
begin
setcolor(ovalcolor); ellipse(x, y,0,360, z,jk);
setcolor(black); ellipse(x, y,0,360, z,(jk-thickness));
end;
(* Erase extra thickness at the end *)
for jk:= (total_oval_height - thickness) to (total_oval_height - final_thickness) do
begin ellipse(x,y, 0,360, z,jk);
delay(30); (* keep the same speed as the growing oval *)
end;
end (* want_oval *)
END; (* Draw_oval *)
(*--------------------------------------------------------------------------*)
Procedure Draw_help_window; (* Pop up help menu in the lower right corner *)
VAR s,c:int;
BEGIN
case Graphdriver of
EGA: begin s:=18; c:=11; end;
VGA: begin s:=20; c:=16; end;
end;
(* Clear the whole window *)
setviewport(hminx+1,hminy+1, hmaxx-1,hmaxy-1, clipon);
clearviewport;

(* Draw border of Help Window *)
setcolor(windowcolor);
rectangle(-1,-1, MenuWindowWidth-1, hmaxy-hminy-1);

setcolor(lightgray);
outtextxy(menu_textx, s, ' enerator');
outtextxy(menu_textx, s+c, ' ncrement');
outtextxy(menu_textx, s+c*2, ' ath');
outtextxy(menu_textx, s+c*3, ' tore Path');
outtextxy(menu_textx, s+c*4, ' ath Chip');
outtextxy(menu_textx, s+c*5, ' ');

setcolor(HelpHotKeyColor);
outtextxy(menu_textx, s, 'G');
outtextxy(menu_textx, s+c, 'I');
outtextxy(menu_textx, s+c*2, 'P');
outtextxy(menu_textx, s+c*3, 'S');
outtextxy(menu_textx, s+c*4, 'M');
outtextxy(menu_textx, s+c*5, ' ');

(* Draw title of Help Window *)
setcolor(lightgray);
centered_underlined_text('Help',hminx,hmaxx,5,underline_on,just_off);
END; (* Draw_help_window *)
(*--------------------------------------------------------------------------*)
Procedure Draw_Title;
CONST zoffset = 10; (* offset for title shadow *)
speed = 100;
thickness = 60;
rectcolor = lightgray;
VAR startxt, startyt,
x1t,y1t, x2t,y2t, (* coords of Title Window *)
title_depth,
copy_depth, (* copyright *)
s,c:int;
BEGIN
(* Adjust opening windows for EGA/VGA *)
x1t:= 30; y1t:= 20;
x2t:= maxx-30; y2t:= 130;
s := 14;
c := 15;
title_depth:= 10;
copy_depth := title_depth + 112;
if graphdriver = EGA then (* Adjust opening windows for EGA/VGA conversion *)
begin
y1t:= round(ymult * y1t);
y2t:= round(ymult * y2t);
s := round(ymult * s);
c := round(ymult * c);
title_depth:= round(ymult * title_depth);
copy_depth := round(ymult * copy_depth) + 3; (* fudge of 3 *)
end;
startxt:= maxx div 2;
startyt:= y1t + (y2t-y1t) div 2;

(* Do upper crazy 3D rectangle *)
Expand_Rect(startxt,startyt, x1t,y1t,x2t,y2t, rectcolor, speed, thickness);
(* Erase the confining rectangle *)
FullTrigPort;
setcolor(black);
rectangle(x1t-1,y1t-1,x2t-1,y2t-1);

(* Title *)
settextstyle(gothicfont, 0,1);
case Graphdriver of
EGA: SetUserCharSize(4,3,7,3); (* stretch the Title *)
VGA: SetUserCharSize(4,3,3,1); (* stretch the Title a little less *)
end;
(* Draw Title *)
setcolor(darkgray); outtextxy(37+zoffset, title_depth+zoffset, 'Psychedelic Trigonometry');
setcolor(lightgray); outtextxy(37, title_depth, 'Psychedelic Trigonometry');

(* Copyright+Year *)
settextstyle(0,0,1);
outtextxy(328, copy_depth, '(C) Copyright 1989');
END; (* Draw_Title *)
(*--------------------------------------------------------------------------*)
Procedure Show_User_Message;
CONST speed = 100;
thickness = 60;
rectcolor = lightgray;
VAR startxm, startym,
x1m,y1m, x2m,y2m, (* coords of Message Window *)
s,c:int;
BEGIN
(* Adjust opening windows for EGA/VGA *)
x1m:= 65; y1m:= 200;
x2m:= maxx-65; y2m:= 325;
s:= 14;
c:= 15;
if graphdriver = EGA then (* Adjust opening windows for EGA/VGA conversion *)
begin
y1m:= round(ymult * y1m);
y2m:= round(ymult * y2m);
s := round(ymult * s);
c := round(ymult * c);
end;
startxm:= maxx div 2;
startym:= y1m + (y2m-y1m) div 2;

(* Do lower crazy 3-D rectangle *)
Expand_Rect(startxm,startym, x1m,y1m,x2m,y2m, rectcolor, speed, thickness);

(* Draw Message *)
setcolor(lightgray);
setviewport(x1m,y1m, x2m,y2m, clipon);
centered_underlined_text('This is a Beta Test Version. It is not to be', x1m,x2m, s+c*0, underline_off, just_off);
centered_underlined_text('copied or distributed into the public domain.', x1m,x2m, s+c*1, underline_off, just_off);
centered_underlined_text('For comments or suggestions, please contact:', x1m,x2m, s+c*2, underline_off, just_off);
centered_underlined_text('Matthew Reiser', x1m,x2m, s+c*4, underline_off, just_off);
centered_underlined_text('1360 Tropical Ave.', x1m,x2m, s+c*5, underline_off, just_off);
centered_underlined_text('Pasadena, Calif. 91107', x1m,x2m, s+c*6, underline_off, just_off);
END; (* Show_User_Message *)
(*--------------------------------------------------------------------------*)
Procedure Flash_Title; (* Flashes Title *)
CONST box1_depth = 71;
box2_height = vmaxy div 8;
VAR title_depth: int;
BEGIN
FullTrigPort;
(* Flash the Title *)
settextstyle(gothicfont, 0,5);
case Graphdriver of
EGA: begin title_depth:= 7; SetUserCharSize(4,3,7,3); end;
VGA: begin title_depth:=10; SetUserCharSize(4,3,3,1); end;
end;
jk:= 1;
while not keypressed do begin (* do the rainbow thing *)
setcolor(jk);
if not (jk in [black, darkgray]) then outtextxy(37, title_depth,'Psychedelic Trigonometry');
jk:= (jk + 1) mod 16;
end;
settextstyle(0,0,1); (* reset to the small text *)
END; (* Flash_Title *)
(*--------------------------------------------------------------------------*)
Procedure Shrink_Box;
CONST thickness = 20; (* ...of shrinking box *)
delayfunc = 130; (* used to smooth the shrinking at the end *)
start_shrink = 264;
VAR shrinkcolor:int;
BEGIN
(* Determine color of the shrinking box *)
if beginning then shrinkcolor:= darkgray
else case color1 of
brown : shrinkcolor:= brown;
lightgray: shrinkcolor:= darkgray;
else shrinkcolor:= color1 - 8;
end; (* case *)

(* Draw shrinking "box" *)
if want_box then begin
for jk:= start_shrink downto 0 do begin
setcolor(shrinkcolor); rectangle(xc-jk, yc-jk, xc+jk, yc+jk);
setcolor(0); rectangle(xc-jk-thickness, yc-jk-thickness, xc+jk+thickness, yc+jk+thickness);
end;

(* Erase remaining part of box *)
for jk:= thickness downto 0 do begin
setcolor(0);
rectangle(xc-jk, yc-jk, xc+jk, yc+jk);
if not (jk in [0,1]) then delay( round(delayfunc / (jk+1)) ); (* delay slows down at the very end! (smoothness) *)
end;
end (* want_box *)

else clearviewport;
END; (* Shink_Box *)
(*--------------------------------------------------------------------------*)
Procedure Draw_Screen; (* Draw everything (and all the windows). *)
BEGIN
Draw_Gray_Screen;
Draw_Main_Window;
Draw_1_Menu(current_Menu);
Draw_A_Small_Window('g');
Draw_A_Small_Window('i');
Draw_A_Small_Window('p');
Draw_A_Small_Window('l');
if beginning then begin Draw_Title;
Show_User_Message;
Draw_Oval;
end;
Draw_Pig;
FlushKeyBuffer;
if beginning then begin Flash_Title; pause;
Shrink_Box;
end;
FullTrigPort;
beginning:= false; (* only do the beginning stuff once *)
END; (* Draw_Screen *)
(*--------------------------------------------------------------------------*)
Procedure Handle_Draw_Intro_Screen; (* Draw everything (and all the windows). *)
BEGIN
Refresh_Screen;
Draw_Title;
Show_User_Message;
pause;
Refresh_Screen;
END; (* Handle_Draw_Intro_Screen *)
(*--------------------------------------------------------------------------*)
(*----------------------------- Help Stuff ------------------------------*)
(*--------------------------------------------------------------------------*)
Procedure Read_and_Show_Help_Text(Choice: char);
CONST maxlines = 42; (* 2 screenfuls *)
VAR i,
Cur_screen_number, Proper_screen_number: int;
trighelp: text;
(* Size of this structure is 1.7 Kbytes *)
helptext: array[1..maxlines] of string[80]; (* each element stores a line of text (may be null character *)
s,c:int;
Title: string[25];
Begin
(*------- Read the Help text ----------*)
assign(trighelp, 'trighelp.dat');
reset (trighelp);

for i:= 1 to maxlines do readln(trighelp); (* read past the warning that is placed in the file. *)
cur_screen_number:= 3;

case choice of (* find the proper location in the help text file to start reading lines *)
'g','G': begin Proper_screen_number:= 3; Title:= 'Using the Generator'; end;
'i','I': begin Proper_screen_number:= 5; Title:= 'Using the Increment'; end;
'p','P': begin Proper_screen_number:= 7; Title:= 'Using Store Path'; end;
'm','M': begin Proper_screen_number:= 9; Title:= 'The Precious Math Chip'; end;
end;

while cur_screen_number < Proper_screen_number do
begin
for i:= 1 to maxlines do readln(trighelp); (* read a screenful of help text *)
cur_screen_number:= cur_screen_number + 2;
end; (* we're now at the start of the appropriate section of help text... *)
(* ...So start reading it: *)
for I:= 1 to maxlines do
readln(trighelp, helptext[i]);

(*------- Draw the Help text ----------*)
case Graphdriver of
EGA: begin s:=18; c:=12; end;
VGA: begin s:=20; c:=17; end;
end;
Refresh_Screen;
setcolor(text_color);
settextstyle(1,0,4);
centered_underlined_text(Title, minx,maxx, s, underline_on,just_off);

(* Show the lines of text on the screen so the user can see them (!) *)
settextstyle(0,0,1);
for I:= 1 to maxlines do
if i <> 2 then centered_underlined_text(helptext[i], minx,maxx, s+(c*(i-1)), underline_off,just_off); (* echo it back *)

close(trighelp);
End; (* Read_and_Show_Help_Text *)
(*--------------------------------------------------------------------------*)
Procedure Help_the_user; (* displays the help menu and asks for a help topic *)
VAR help_choice: char;
BEGIN
Draw_help_window; (* superimposed on top of the pig *)
setviewport(hminx,hminy, hmaxx,hmaxy, clipon);
Flash_box(0,0, hmaxx-hminx,hmaxy-hminy, help_choices, help_choice);

if help_choice = EscapeKey then (* user wants to quit the Help *)
begin
setviewport(hminx,hminy, hmaxx,hmaxy, clipon);
setcolor(lightgray);
rectangle(0,0, hmaxx-hminx,hmaxy-hminy);
Draw_pig;
FullTrigPort; (* Reset to main window to continue plotting *)
end (* user wants to quit the Help *)

else (* user selected a help topic *)
begin
Read_and_Show_Help_Text(help_choice);
Draw_Pig; (* Pig looks at help text with the reader *)
pause; (* Wait for user to read text *)
Refresh_Screen;
end;
END; (* Help_the_user *)
(*--------------------------------------------------------------------------*)
Procedure Cant_Help_You_User; (* Tell user that he blew it by erasing the help file! *)
VAR x2,c,s: int;
BEGIN
beep;
FullTrigPort;
clearviewport;
case Graphdriver of
EGA: begin s:= 70; c:=16; end;
VGA: begin s:=100; c:=22; end;
end;
x2:= maxx-minx;
setcolor(cyan);
Centered_Underlined_Text('The file: ''Trighelp.dat'' could not' , 0, x2, s , underline_off,just_off);
Centered_Underlined_Text('be found in the current directory.' , 0, x2, s+c*1, underline_off,just_off);
Centered_Underlined_Text('It apparently has either been erased,' , 0, x2, s+c*2, underline_off,just_off);
Centered_Underlined_Text('renamed or moved to a different directory.' , 0, x2, s+c*3, underline_off,just_off);
Centered_Underlined_Text('Thus, I cannot provide you with the Help Topics.' , 0, x2, s+c*5, underline_off,just_off);
Centered_Underlined_Text('Sorry about that. Press any key to journey further.', 0, x2, s+c*6, underline_off,just_off);
Centered_Underlined_Text(' -- M.R.' , 0, x2, s+c*7, underline_off,just_off);
pause;
clearviewport;
END; (* Cant_Help_You_User *)
(*--------------------------------------------------------------------------*)
Procedure Handle_Help_Request; (* Handles user's request for help *)
BEGIN
(* Does the Help file exist? *)
if not Does_File_Exist('TrigHelp.dat') then Cant_Help_You_User
else Help_the_user;
END; (* Handle_Help_Request *)
(*--------------------------------------------------------------------------*)
Procedure User_Change_Small_Window_Value(window_type:char; VAR Value:int); (* Changes the values *)
VAR s: string;
xminx,xminy, xmaxx,xmaxy: int;
BEGIN
case window_type of (* Determine window coords *)
'g': begin xminx:=gminx; xmaxx:=gmaxx; xminy:=gminy; xmaxy:=gmaxy; end;
'i': begin xminx:=iminx; xmaxx:=imaxx; xminy:=iminy; xmaxy:=imaxy; end;
'p': begin xminx:=pminx; xmaxx:=pmaxx; xminy:=pminy; xmaxy:=pmaxy; end;
end;
(* Clear the current string *)
setviewport(xminx+textx, xminy+texty, xmaxx-1, xmaxy-1, clipoff);
clearviewport;

(* Change value of variable *)
setviewport(xminx,xminy, xmaxx,xmaxy, clipoff);
Update_small_Window_value(value);

(* Draw string version of "new" value (may be the same as the original value *)
setviewport(xminx+textx, xminy+texty, xmaxx-1, xmaxy-1, clipoff);
clearviewport;
str(value, s);
outtextxy(0,0, s);

(* Reset to main window so the main routine doesn't have to *)
FullTrigPort;
END; (* User_Change_Value *)
(*--------------------------------------------------------------------------*)
(*---------------------------- Misc Stuff ------------------------------*)
(*--------------------------------------------------------------------------*)
Procedure Update_Generator_Window; (* Writes new value of Generator to the Generator Window *)
BEGIN
(* Set and Clear Generator Window *)
setviewport(gminx+textx, gminy+texty, gmaxx-1, gmaxy-1, clipoff);
clearviewport;
setviewport(gminx,gminy, gmaxx,gmaxy, clipoff);

(* Print the (not nescessarily new) value of trigy *)
str(trigy, trigy_string);
setcolor(lightgray);
outtextxy(textx, texty, trigy_string);

FullTrigPort;
END; (* Update_Generator_Window *)
(*--------------------------------------------------------------------------*)
Procedure Update_Increment_Window; (* Writes new value of Increment to the Increment Window *)
BEGIN
(* Set and Clear Increment Window *)
setviewport(iminx+textx, iminy+texty, imaxx-1, imaxy-1, clipoff);
clearviewport;
setviewport(iminx,iminy, imaxx,imaxy, clipoff);

(* Print the (not nescessarily new) value of trigy_inc *)
str(trigy_inc, trigy_inc_string);
setcolor(lightgray);
outtextxy(textx, texty, trigy_inc_string);

FullTrigPort;
END; (* Update_Increment_Window *)
(*--------------------------------------------------------------------------*)
Procedure Update_Path_Window; (* Writes new value of Path to the Path Window *)
BEGIN
(* Set and Clear Path Window *)
setviewport(pminx+textx, pminy+texty, pmaxx-1, pmaxy-1, clipoff);
clearviewport;
setviewport(pminx,pminy, pmaxx,pmaxy, clipoff);

(* Print the (not nescessarily new) value of theta_inc *)
str(theta_inc, theta_inc_string);
setcolor(lightgray);
outtextxy(textx, texty, theta_inc_string);

FullTrigPort;
END; (* Update_Path_Window *)
(*--------------------------------------------------------------------------*)
Procedure Handle_Quick_Path(ch:char); (* Discrete changes to the "path" *)
BEGIN
case ch of
'1': theta_inc:= 11;
'2': theta_inc:= 4333;
'3': theta_inc:= 4321;
'4': theta_inc:= 993;
'5': theta_inc:= 5909;
'6': theta_inc:= 5687;
'7': theta_inc:= 6259;
'8': theta_inc:= 4251;
'9': theta_inc:= 4707;
'0': theta_inc:= 481;
end;
Update_Path_Window;
END; (* Quick_Path *)
(*--------------------------------------------------------------------------*)
PROCEDURE Handle_Store_Function_Option; (* store the current Generator and Path *)
BEGIN
if newstore then begin
if Does_File_exist('Path.dat') then
begin
Append(PathFile);
writeln;
writeln(PathFile,'New Session.');
end (* if file exists *)

else Create_Storage_File;
end; (* if it's the first storage made during an execution *)

writeln(PathFile, trigy:6, theta_inc:10);
beep;
newstore:= false;
END; (* Handle_Store_Function_Option *)
(*--------------------------------------------------------------------------*)
Procedure Handle_Color_Option(up_or_down:char); (* Allows user to change the colors of the pixels during program operation *)
BEGIN
repeat (* look for an OK color *)
case up_or_down of
RtKey: color1:= (color1+1) mod 16; (* increase color *)
LtKey: begin (* decrease color *)
if color1 = 0 then color1:= 16; (* avoid going below 0 *)
color1:= (color1-1) mod 16;
end;
else color1:= random(maxcolors); (* used when auto_color_change is on *)
end; (* case *)
until color1 in okcolors;
(* change color of Pig's eyes as the color of the pixels change *)
if want_changing_pupil_color then
if color1 in [brown, lightblue] then pupilcolor:= lightgray
else pupilcolor:= color1;
END; (* Handle_Color_Option *)
(*--------------------------------------------------------------------------*)
(*------------------------ Error-handling routines --------------------*)
(*--------------------------------------------------------------------------*)
Procedure Show_Bailout_Options(key:char; keycolor:int); (* Show the user which options are available after a user error *)
VAR s,c:int;
BEGIN
case Graphdriver of
EGA: begin s:=18; c:=11; end;
VGA: begin s:=20; c:=16; end;
end;

(* Highlight the color of the Generator Hotkey *)
if current_Menu <> Menu_1 then Draw_1_Menu(Menu_1);
setviewport(ominx,ominy, omaxx,omaxy, clipon);
setcolor(keycolor);
case key of
'g': outtextxy(menu_textx, s+c , 'G');
'i': outtextxy(menu_textx, s+c*2, 'I');
'p': outtextxy(menu_textx, s+c*3, 'P');
end; (* case *)
END; (* Show_Bailout_Options *)
(*--------------------------------------------------------------------------*)
Procedure Report_user_error(error_type:char); (* Prints an error message when user tries to set trigy = 0. *)
CONST bailoutcolor = lightred; (* Color of the first letter of commands that will bail out the user *)
VAR bailoutaction: string[11];
BEGIN
(* Erase current contents of main window (either graphics if (errornum = 0) or the error box) *)
if errornum = 0 then clearviewport;
Draw_Moody_Pig(Mad_Pig);
FullTrigPort;
(* Draw error message in main window *)
setcolor(lightgray); centered_underlined_text('The Pig says:', minx,maxx, round(170*ymult),underline_off,just_off);
setcolor(red); centered_underlined_text('"No Zeroes!"', minx,maxx, round(195*ymult),underline_on, just_off);
setcolor(lightgray);
case error_type of
'g': bailoutaction:= '(G)enerator';
'i': bailoutaction:= '(I)ncrement';
'p': bailoutaction:= '(P)ath';
end; (* case *)
centered_underlined_text('Please select a different '+bailoutaction, minx,maxx, round(250*ymult),underline_off,just_off);
Show_Bailout_Options(error_type, bailoutcolor);
END; (* Report_user_error *)
(*--------------------------------------------------------------------------*)
Procedure Resolve_User_Error(error_type:char);
BEGIN
Show_Bailout_Options(error_type,MenuHotKeyColor); (* Reset hotkeys to normal hotkey color *)
Draw_Moody_Pig(Happy_Pig);

(* Clear error message on the main window *)
setviewport(1,round(248*ymult),maxx-3,round(260*ymult), clipon);

{ fulltrigport; setcolor(7); rectangle(5,round(248*ymult),maxx-5,round(260*ymult)); pause; }
clearviewport;
END; (* Resolve_User_Error *)
(*--------------------------------------------------------------------------*)
Procedure Move_pig_ears; (* Continues to move the Pig's ears until a key is pressed.*)
CONST eardelay = 30;
VAR leftside, natural: boolean;
newdelay: int; (* The speed of the pig's ears gets faster if user makes mistakes in trying to correct mistake *)
BEGIN
leftside:=true; natural:=false;
REPEAT
if leftside then begin setviewport(pigminx,pigminy, pigminx+19,pigminy+25, clipon);
natural:= not natural;
end
else setviewport(pigmaxx-19,pigminy, pigmaxx,pigminy+25, clipon);
clearviewport;
if natural then putimage(0,earoffsety, rear1^, normalput)
else putimage(0,earoffsety, lear1^, normalput);
leftside:= not leftside;
newdelay:= round(eardelay - (5*errornum));
if newdelay >= 0 then delay(newdelay)
else delay(2);
UNTIL keypressed;
END; (* Move_pig_ears *)
(*--------------------------------------------------------------------------*)
PROCEDURE Handle_Path_Change(amount:int); forward;
(*--------------------------------------------------------------------------*)
Procedure Zero_Error(error_type:char; VAR response: char); (* Handles the only user error possible: Generator = 0 *)
VAR ok_keys: set of char;
BEGIN
case error_type of
'g': ok_keys:=['f','F', 'b','B', 'g','G', EscapeKey];
'i': ok_keys:=['i','I', EscapeKey];
'p': ok_keys:=['p','P', UpKey, DnKey, EscapeKey];
end; (* case *)
beep;
errornum:= 0;

Report_User_Error(error_type);
repeat
Move_Pig_Ears;
response:= readakey; (* What is user's response to the moving pig ears? *)
errornum:= errornum + 1; (* Speed of ears is directly proportional to number of misentries from user (errornum) *)
until response in ok_keys;
Resolve_User_Error(error_type);

case response of
{PgUp} 'H': Handle_Path_Change(Inc); (* This char kludge is due to compiler's inability... *)
{PgDn} 'P': Handle_Path_Change(Dec); (*...to distinguish regular and special characters *)
Escapekey: begin
case error_type of
'g': trigy:= prevtrigy; (* Restore previous generator *)
'i': trigy_inc:= prevtrigy_inc; (* Restore previous increment *)
'p': theta_inc:= prevtheta_inc; (* Restore previous path *)
end; (* case *)
response:= 'r'; (* Simulate a refresh *)
end; (* Escape *)
end; (* case *)
END; (* Zero_Error *)
(*--------------------------------------------------------------------------*)
(*------------------- Option-Handling Routines ----------------------*)
(*--------------------------------------------------------------------------*)
Procedure Handle_response(response:char); forward;
(*---------------------------------------------------------------------------*)
PROCEDURE Take_Care_of_Zero_Gen_or_Path(error_type:char);
VAR response:char;
BEGIN
Zero_Error(error_type,response);
Handle_response(response);
if response <> 'r' then Refresh_Screen;
END; (* Take_Care_of_Zero_Gen_or_Path *)
(*---------------------------------------------------------------------------*)
PROCEDURE Handle_Generator_Change(amount:int);
BEGIN
prevtrigy:= trigy; (* Store previous value of the path *)
case amount of
Dec: begin trigy:=trigy - trigy_inc; Update_Generator_Window; end;
Inc: begin trigy:=trigy + trigy_inc; Update_Generator_Window; end;
Generic: User_Change_Small_Window_Value('g', trigy);
end; (* case *)
while trigy = 0 do begin
Take_Care_of_Zero_Gen_or_Path('g');
Update_Generator_Window;
end;
END; (* Handle_Generator_Option *)
(*---------------------------------------------------------------------------*)
PROCEDURE Handle_Increment_Change;
BEGIN
prevtrigy_inc:= trigy_inc; (* Store previous value of the increment *)
User_Change_Small_Window_Value('i',trigy_inc);
while trigy_inc = 0 do begin
Take_Care_of_Zero_Gen_or_Path('i');
Update_Increment_Window;
end;
END; (* Handle_Increment_Change *)
(*---------------------------------------------------------------------------*)
PROCEDURE Handle_Path_Change(amount:int);
BEGIN
prevtheta_inc:= theta_inc; (* Store previous value of the path *)
case amount of
Dec: begin theta_inc:=theta_inc - 2; Update_Path_Window; end;
Inc: begin theta_inc:=theta_inc + 2; Update_Path_Window; end;
Generic: User_Change_Small_Window_Value('p', theta_inc);
end; (* case *)
while theta_inc = 0 do begin
Take_Care_of_Zero_Gen_or_Path('p');
Update_Path_Window;
end;
END; (* Handle_Path_Change *)
(*---------------------------------------------------------------------------*)
(*---------------------------------------------------------------------------*)
(*---------------------------------------------------------------------------*)
PROCEDURE Handle_Erase_Option;
BEGIN
want_erase:= not want_erase;
Change_Menu_Contents(Menu_3, 4); (* Change the toggle shown on the menu *)
if want_erase then Refresh_Screen;
END; (* Handle_Erase_Option *)
(*---------------------------------------------------------------------------*)
PROCEDURE Handle_Origin_Option;
BEGIN
want_random_origins:= not want_random_origins;
Change_Menu_Contents(Menu_3, 5); (* Change the toggle shown on the menu *)
END; (* Handle_Origin_Option *)
(*---------------------------------------------------------------------------*)
PROCEDURE Handle_Auto_Color;
BEGIN
want_auto_change_color:= not want_auto_change_color;
Change_Menu_Contents(Menu_4, 1); (* Change the toggle shown on the menu *)
END; (* Handle_Auto_Color *)
(*---------------------------------------------------------------------------*)
PROCEDURE Change_Amount_of_Erased_Pixels(direction: int);
CONST inc = 100; (* Amount by which we inc/dec <length> each time *)
BEGIN
if direction = longer then (* Increase length *)
begin
if Num_Stored_Pixels > (Max_Stored_pixels-inc)
then Num_Stored_Pixels:= inc
else Num_Stored_Pixels:= (Num_Stored_Pixels + inc) mod Max_Stored_pixels;
end
else (* Decrease length *)
begin
if Num_Stored_Pixels <= inc
then Num_Stored_Pixels:= Max_Stored_pixels
else Num_Stored_Pixels:= (Num_Stored_Pixels - inc) mod Max_Stored_pixels;
end;
if Num_Stored_Pixels = 0 then Num_Stored_Pixels:= Max_Stored_pixels; (* Kludge protection device *)
Initialize_Pixel_Erasure_Array;
Draw_A_Small_Window('l'); (* put new value in the Length window *)
Refresh_Screen;
END; (* Change_Amount_of_Erased_Pixels *)
(*---------------------------------------------------------------------------*)
PROCEDURE Boss_is_Around; (* Shows innocent text report until boss is safely away, then redraws graphics. *)
BEGIN
Restore_crt;
textcolor(lightgray);
writeln;
writeln;
writeln(' We do not feel the investment in the swine has come to fruition so');
writeln(' we are terminating our relationship with Hogsworth International. ');
writeln(' Please prepare a report to the purchasing division so that we may ');
writeln(' evaluate the feasiblity of their alternate proposal.');
writeln;
writeln(' Next Wednesday, the division is planning on sending a final draft of');
write (' the monthly report to the Advertising Department so that we can');
Wait_For_Escape_Key;

Initialize_Graphics_Mode;
newscreen:=true;
Draw_Screen;
END; (* Boss_is_Around *)
(*---------------------------------------------------------------------------*)
PROCEDURE Print_Trig;
BEGIN
if want_full_Print then fullport
else Set_port_to_Print;
Print_Screen(Trig_Caller);
END; (* Print_Trig *)
(*---------------------------------------------------------------------------*)
PROCEDURE Theres_no_PDT_to_Print; (* Explain to user that he needs to move the *.pdt file to current directory to print *)
VAR s,c:int;
BEGIN
case Graphdriver of
EGA: begin s:=100; c:=14; end;
VGA: begin s:=140; c:=18; end;
end;
refresh_screen;
beep;
setcolor(lightgray);
centered_underlined_Text('Error: I am unable to print the screen because the', minx,maxx,s , underline_off,just_off);
centered_underlined_Text('necessary file: "BVRD.PDT" could not be found.', minx,maxx,s+c , underline_off,just_off);
centered_underlined_Text('It has either been erased, renamed,', minx,maxx,s+c*3, underline_off,just_off);
centered_underlined_Text('or moved to a different directory.', minx,maxx,s+c*4, underline_off,just_off);
centered_underlined_Text('Sorry about that.', minx,maxx,s+c*5, underline_off,just_off);
centered_underlined_Text('Press any key to continue.', minx,maxx,s+c*7, underline_off,just_off);

pause;
refresh_screen;
END; (* Theres_no_PDT_to_Print *)
(*---------------------------------------------------------------------------*)
PROCEDURE Handle_Print_Option;
BEGIN
if not Does_File_Exist('BDRV.PDT') then Theres_no_PDT_to_Print
else Print_Trig;
END; (* Handle_Print_Option *)
(*--------------------------------------------------------------------------*)
(*------------------- Main Routines ----------------------*)
(*--------------------------------------------------------------------------*)
Procedure Plot_pixels; (* plot one point from the value of the trig. function *)
CONST pig_eye_speed = 0.90; (* percentage of time that pig moves eyes *)
cpix = 1;
VAR x,y:int; (* (x,y) = point at which current pixel will be plotted *)
pix: real;
BEGIN
Pig_Motion_Criterion:= 0;
REPEAT
(* Polar form of the equation : [ f(é) = (r * é / generator) * scale ] *)
(* Cartesian transformation : [ x = r * cos(é / generator) * scale ] *)

(* These next 2 lines take up 1.4 times as much as the rest of this REPEAT loop (291087) *)
(* I need to optimize the next 2 lines (big time) *)
x:= xc + trunc(theta * cos(theta * pi_over_180) * scale_x);
y:= yc + trunc(theta * sin(theta * (pi / trigy)) * scale_y);

(* The following is the two color stratey *)
{ if odd(theta) then pix:= cpix div 2
else}pix:= cpix;
if pix = 4 then
if odd(theta) then begin putpixel(x, y, color0); putpixel(x+1, y, color0); (* pixels alternate in color *)
putpixel(x,y+1, color0); putpixel(x+1,y+1, color0) end
else begin putpixel(x, y, color1); putpixel(x+1, y, color1); (* pixels alternate in color *)
putpixel(x,y+1, color1); putpixel(x+1,y+1, color1) end

else if pix = 2 then
if odd(theta) then begin putpixel(x, y, color0); putpixel(x+1, y, color0); end
else begin putpixel(x, y, color1); putpixel(x+1, y, color1); end

else if pix = 1 then
if odd(theta) then putpixel(x, y, color0)
else putpixel(x, y, color1);

(* Erasure of pixels *)
if want_erase then (* this "erasing" section takes up 1.42 times as much as the other (simple) non-math statements *)
begin
curcount:= curcount mod Num_Stored_Pixels + 1;
Stored_Pixels[curcount].x:= x; (* store the location of the pixel that is being plotted *)
Stored_Pixels[curcount].y:= y;
prevcount:= prevcount mod Num_Stored_Pixels + 1;
with Stored_Pixels[prevcount] do putpixel(x,y, black); (* Overwrite pixels by accessing stored locations *)
end;

(* Calc the new value of <theta> (add Path (theta_inc) to theta) *)
theta:= theta + theta_inc;

(* Move the Pig eyes every now and then *)
Pig_Motion_Criterion:= (Pig_Motion_Criterion + 1) mod maxlongint;
if (Pig_Motion_Criterion mod 200) = 0 then
begin
if (Pig_Motion_Criterion mod 2000) = 0 then
if want_auto_change_color then Handle_Color_Option('d'); (* dummy char *)
if random < pig_eye_speed then (* Take action only SOME of the time (to make it more interesting) *)
Normal_Pig_Motion;
end;

(* Change color automatically if user wants to *)
UNTIL keypressed;
END; (* Plot_pixels *)
(*--------------------------------------------------------------------------*)
PROCEDURE Handle_Extended_Key; (* PassOut_key is passed back to
(* Handle_Response which is then passed out to the main program which determines what further action to take. *)
VAR Extended_key:char;
BEGIN
Extended_key:= readkey; (* read the second half of an extended key *)

case Extended_key of
{Help } F1Key : Handle_Help_Request;
{Shrink} F5Key : begin want_box:= true; Shrink_Box; end;
{Len } EndKey : Change_Amount_of_Erased_Pixels(shorter);
HomeKey: Change_Amount_of_Erased_Pixels(longer);
{Print } F9Key : Handle_Print_Option;
{Paths } UpKey : Handle_Path_Change(Inc);
DnKey : Handle_Path_Change(Dec);
{Color } LtKey,
RtKey : Handle_Color_Option(Extended_key);

else; { Ignore other keys }
end; (* case *)
END; (* Handle_Extended_Key *)
(*--------------------------------------------------------------------------*)
Procedure Handle_response(response:char);
BEGIN
case response of
{ About } 'a','A': Handle_Draw_Intro_Screen;
{ Backwrd} 'b','B': Handle_Generator_Change(Dec);
{ Auotcol} 'c','C': Handle_Auto_Color;
{ Forward} 'f','F': Handle_Generator_Change(Inc);
{ Gen. } 'g','G': Handle_Generator_Change(Generic);
{ Erase } 'e','E': Handle_Erase_Option;
{ Inc. } 'i','I': Handle_Increment_Change;
{ Origins} 'o','O': Handle_Origin_Option;
{ Boss } 'n','N': Boss_is_Around;
{ Path } 'p','P': Handle_Path_Change(generic);
{ Refresh} 'r','R': Refresh_Screen;
{ Store P} 's','S': Handle_Store_Function_Option;
{ Worb } 'w','W': Trig_Worbulation_Option;
{ Qk Path} '0'..'9': Handle_Quick_Path(response);
{ Print } 'P': Handle_Print_Option;
{ Pause } SpaceKey: Pause;
'q','Q',
{ Quit } EscapeKey: Trig_Sure_Quit;
{ Menus } chr(9): begin current_menu:= (Current_Menu mod Num_Menus) + 1; (* scroll to next higher menu *)
Draw_1_Menu(Current_Menu); (* show that menu *)
end;
#0 : Handle_Extended_Key; (* This <response> is passed OUT of this proc. (not in) *)
else (* Ignore everything else *)
end; (* case *)
END; (* Handle_Response *)
(*--------------------------------------------------------------------------*)
Procedure Initialize_Trig_Program;
BEGIN

Incorporate_Font_and_Driver_into_EXE;
Look_for_command_line_parameters;

Initialize_Matt_Options;
Initialize_User_Options;
Initialize_Graphics_Mode;

Adjust_EGA_VGA_Window_Coords;
Center_Main_Window_Coords;

Initialize_Pig_features; (* Create pig bitmaps *)
Define_Menu_Contents;

Randomize; (* used to generate random origins if desired *)
Draw_Screen;

END; (* Initialize_Trig_Program *)
(*--------------------------------------------------------------------------*)
BEGIN (* Main Program ----------------------------------------------------*)
Initialize_Trig_Program;

Repeat
Plot_pixels;
main_response:= readkey; (* Grab the key that was pressed in Plot_Pixels *)
Handle_Response(main_response);
FlushKeyBuffer; (* erase any extra command(s) *)
Until true = false; (* Quit only through Handle_Response! *)
END. (* Trig.Pas *).
Comments