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 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 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 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 (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 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 *)