program threeD(input,output); const minint = -32767; pi = 3.14159; {$I GEMCONST.PAS} type Menu_Option_Type = (Colors,Grid,G_Function,View,Draw,Help,Quit); Res_Type = (Low, Med, Hi); TokenType = (Numeric, Character); NodePtr = ^Node; Node = Record Link: NodePtr; case NodeType: TokenType of Numeric: (Value: real); Character: (Code: char; Priority: 0..5) end; Intensity_Type = array [0..2,1..3] of 0..8; {$I GEMTYPE.PAS} var sx,sy: array [-32..32,-32..32] of integer; { Screen coordinates } lx,ly,lz: array [-32..32,-32..32] of real; { Logical coordinates } Res: Res_Type; { Resolution } X_Center, Y_Center: integer; { Center of screen } SF, { Compensates for aspect ratio } Max_Z, { Maximum Z value allowed } Min_Z, { Minimum Z value allowed } x,y, { x and y coordinates } d, { distance from point to origin } r: real; { square of distance from point to origin } max, min: array [-640..1280] of integer; { Holds max and min y values } { for each possible x value. } Option: Menu_Option_Type; { Choice from main menu } Intensity: Intensity_Type; { Values for color registers } XLim, YLim: integer; { Number of grid lines on x, y axes } Grid_Scale: real; { Scale per grid line } InFix: Str255; { The function being graphed } PostFix: NodePtr; { Pointer to postfix version of function } Syntax_Error: boolean; Azimuth, { Position around z-axis } Altitude, { Elevation above or below x-y plane } Screen_Scale: integer; { Size of displayed graph } Plot_Fast, { TRUE if fast plotting desired } Perspective, { TRUE if perspective desired } Draw_Both_Ways, { TRUE if boths sets of grids desired } Hidden_Lines, { TRUE if hidden lines are desired } Draw_Top, { TRUE if top of graph should be drawn } Draw_Bottom: boolean; { TRUE if bottom should be drawn } Must_Load1, { TRUE if no coordinates have been calculated } Must_Load2, { TRUE if coordinates must be recalculated } Must_Transform: boolean; { TRUE if points must be transformed } { The following variables are used to get events in menu screens } Done: boolean; { TRUE if user clicks on OK button } Event: integer; Dummy_Buffer: Message_Buffer; Dummy: integer; { Dummy parameters to Get_Event} mx, my: integer; { Coordinates of mouse } {$I GEMSUBS.PAS} {************************** GotoXY ********************************* * * * Used to provide cursor control when printing to the screen. * * * * Called by: Various user input modules * * * * In parameters: x, y screen positions * * * *********************************************************************} procedure GotoXY(x,y: integer); procedure bconout(device, c: integer); BIOS(3); begin bconout(2,27); bconout(2,ord('Y')); bconout(2,31+x); bconout(2,31+y) end; {GotoXY} {************************** Initialization ************************** * * * Initializes global variables. * * * * Called by: MAIN DRIVER * * * **********************************************************************} procedure Initialization; var I, { Loop counter } Scr_Res: integer; { 0, 1, or 2 for screen resolution } r: 1..2; { 1 if color monitor is used, 2 otherwise } function Get_Res : Integer; XBIOS(4); begin { Determine screen environment } Scr_Res := Get_Res; case Scr_Res of 0 : begin Res := Low; X_Center := 160; Y_Center := 100; Set_Clip(0,0,320,200); SF := 0.869 end; {0} 1 : begin Res := Med; X_Center := 320; Y_Center := 100; Set_Clip(0,0,640,200); SF := 0.434 end; {1} 2 : begin Res := Hi; X_Center := 320; Y_Center := 200; Set_Clip(0,0,640,400); SF := 0.869 end; {2} end; {case} if Res = Hi then r := 2 else r := 1; { Print Copyright message } Clear_Screen; GotoXY(1,1); writeln(' 3-D Grapher'); writeln(' by Delmar Searls'); writeln; writeln(' (Parts of this product are'); writeln('Copyright (c) 1986, OSS & CCD'); writeln(' Used by persmission of OSS)'); Text_Style(Thickened); Draw_String(112,104*r,'OK'); Text_Style(Normal); Frame_Rect(88,81*r,64,40*r); { Wait for user to click on OK button } Done := FALSE; Set_Mouse(M_Arrow); repeat Show_Mouse; Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0, Dummy_Buffer,Dummy,Dummy,Dummy,mx,my,Dummy); Hide_Mouse; if Res = Hi then my := my DIV 2; if Event = E_Button then if (mx>88) AND (mx<154) AND (my>81) AND (my<121) then Done := TRUE until Done; { Set up general environment } Text_Color(1); Line_Color(1); Draw_Mode(1); { Set up initial intensities for colors 0, 1, & 2 } for I := 1 to 3 do begin Intensity[0,I] := 7; Intensity[1,I] := 0; Intensity[2,I] := 0 end; {for} Intensity[2,1] := 7; { Set up initial view parameters } Azimuth := 30; Altitude := 10; Screen_Scale := 100; Plot_Fast := TRUE; Perspective := TRUE; Draw_Both_Ways := TRUE; Hidden_Lines := TRUE; Draw_Top := TRUE; Draw_Bottom := TRUE; { Set up initial Grid parameters } Grid_Scale := 0.25; XLim := 16; YLim := 16; { Set up some odds and ends } InFix := '-3*EXP(-R/8)*(SIN(R/2)-COS(R/3))-1'; Syntax_Error := FALSE; Must_Load1 := TRUE; Must_Transform := TRUE end; {Initialization} {************************** Menu_Option **************************** * * * Display the main menu and allow the user to select an option. * * * * Called by: MAIN DRIVER * * * *********************************************************************} function Menu_Option: Menu_Option_Type; var Dialog: Dialog_Ptr; Button: array [1..7] of integer; Button_Text: string[8]; I, { Loop counter } Choice, { Indicates which button user selected } Row: integer; { Text row in dialog box } begin Clear_Screen; { Set up the menu dialog box } Dialog := New_Dialog(7,0,0,16,15); for I := 1 to 7 do begin Row := 2*I-1; if (I = 1) AND (Res = Hi) then Button[I] := Add_DItem(Dialog,G_Button,None,4,Row,8,1,0,0) else Button[I]:= Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,4,Row,8,1,0,0); case I of 1: Button_Text := 'Color'; 2: Button_Text := 'Grid'; 3: Button_Text := 'Function'; 4: Button_Text := 'View'; 5: Button_Text := 'Draw'; 6: Button_Text := 'Help'; 7: Button_Text := 'Quit' end; {case} if (I = 1) AND (Res = Hi) then Set_DText(Dialog, Button[I], Button_Text,5,TE_Center) else Set_DText(Dialog, Button[I], Button_Text,3,TE_Center) end; {for} { Display menu and get user's choice } Center_Dialog(Dialog); Set_Mouse(M_Point_Hand); Show_Mouse; Choice := Do_Dialog(Dialog,0); End_Dialog(Dialog); Hide_Mouse; Delete_Dialog(Dialog); { Analyze user's choice } if Choice = Button[1] then Menu_Option := Colors else if Choice = Button[2] then Menu_Option := Grid else if Choice = Button[3] then Menu_Option := G_Function else if Choice = Button[4] then Menu_Option := View else if Choice = Button[5] then Menu_Option := Draw else if Choice = Button[6] then Menu_Option := Help else Menu_Option := Quit; end; {Menu_Option} {************************** Get_Colors ***************************** * * * Allow the user to determine the color of the background, the * * top of the graph, and the bottom of the graph. * * * * Called by: MAIN DRIVER * * * * In/Out parameters: Intensity levels * * * *********************************************************************} procedure Get_Colors(var Intensity: Intensity_Type); var IString, { Holds string representation of intensity level } Up_Arrows, Down_Arrows: str255; Key, { Stores value of key pressed by user } K, { 0 => raise intensity, 1 => lower intensity } I, J: integer; { Row and Column counters } T, { Holds parameters to Set_Color procedure } XPos: array [1..3] of integer; { Store print positions } YPos: array [0..3] of integer; { Store print positions } begin { Load graph colors into color registers } for I := 0 to 1 do begin for J := 1 to 3 do T[J] := 60 + 125*Intensity[I,J]; Set_Color(I,T[1],T[2],T[3]) end; {for} Clear_Screen; Set_Mouse(M_Arrow); { Set positions of arrows } XPos[1] := 161; XPos[2] := 177; XPos[3] := 193; YPos[0] := 48; YPos[1] := 104; YPos[2] := 160; { Create a string of 3 up arrows } Up_Arrows := ' '; Up_Arrows[1] := chr(1); Up_Arrows[3] := chr(1); Up_Arrows[5] := chr(1); { Create a string of 3 down arrows } Down_Arrows := ' '; Down_Arrows[1] := chr(2); Down_Arrows[3] := chr(2); Down_Arrows[5] := chr(2); { Create screen display } Draw_String(64,8, 'Adjust Color Registers'); Draw_String(161,32, Up_Arrows); Draw_String(0,48, 'Background'); Draw_String(161,64, Down_Arrows); Draw_String(161,88, Up_Arrows); Draw_String(57,104,'Top'); Draw_String(161,120, Down_Arrows); Draw_String(161,144, Up_Arrows); Draw_String(33,160,'Bottom'); Draw_String(161,176, Down_Arrows); Paint_Color(1); Paint_Rect(97,89,48,24); Paint_Color(2); Paint_Rect(97,145,48,24); Frame_Rect(241,81,64,40); Text_Style(Thickened); Draw_String(265,104, 'OK'); Text_Style(Normal); { Display current graph color register values } IString := ' '; for I := 0 to 2 do for J := 1 to 3 do begin IString[1] := chr(ord('0')+Intensity[I,J]); Draw_String(XPos[J], YPos[I], IString) end; {for} { Check for and process user changes } Done := FALSE; repeat Show_Mouse; Event := Get_Event(E_Keyboard|E_Button,1,1,1,0, FALSE,0,0,0,0,FALSE,0,0,0,0, Dummy_Buffer,Key,Dummy,Dummy,mx,my,Dummy); Hide_Mouse; if (Event = E_keyboard) AND (Key = 283) then begin {Escape key pressed} Set_Color(0,1000,1000,1000); Set_Color(1,0,0,0); for J := 1 to 3 do begin Intensity[0,J] := 7; Intensity[1,J] := 0 end; {for} Done := TRUE end; {if} if Event = E_Button then if (mx>241) AND (mx<305) AND (my>81) AND (my<121) then Done := TRUE else begin I := -1; J := 0; if (mx>158) AND (mx<171) then J := 1 {Red} else if (mx>174) AND (mx<187) then J := 2 {Green} else if (mx>190) AND (mx<203) then J := 3; {Blue} if (my>24) AND (my<33) then I := 0 { Increase background register value } else if (my>56) AND (my<65) then I := 1 { Decrease background register value } else if (my>80) AND (my<89) then I := 2 { Increase top color register value } else if (my>112) AND (my<121) then I := 3 { Decrease top color register value } else if (my>136) AND (my<145) then I := 4 { Increase bottom color register value } else if (my>168) AND (my<177) then I := 5; { Decrease bottom color register value } { Adjust color register if necessary } if (I>-1) AND (J>0) then begin K := I MOD 2; I := I DIV 2; if K = 0 then Intensity[I,J] := (Intensity[I,J] + 1) MOD 8 else Intensity[I,J] := (Intensity[I,J] + 7) MOD 8; IString[1] := chr(ord('0') + Intensity[I,J]); Draw_String(XPos[J], YPos[I], IString); for J := 1 to 3 do T[J] := 60 + 125*Intensity[I,J]; Set_Color(I, T[1], T[2], T[3]); if I > 0 then begin Paint_Color(I); Paint_Rect(97,33+I*56,48,24) end {if} end {if} end {else} Until Done; Set_Color(0,1000,1000,1000); Set_Color(1,0,0,0) end; {Get_Colors} {********************** Get_Grid_Parameters ************************ * * * Get the number of grid lines and scale per grid line. * * * * Called by: MAIN DRIVER * * * * Out parameters: Grid_Scale, XLim, YLim * * * *********************************************************************} procedure Get_Grid_Parameters(var Grid_Scale: real; var XLim, YLim: integer; var Must_Load2: boolean); var TStr: Str255; { Temporary storage used in Draw_String } TempXLim, TempYLim: integer; { Temporary storage in case of an Abort } TempScale: real; r: 1..2; {1 if color monitor used, 2 otherwise} begin TempXLim := XLim; TempYLim := YLim; TempScale := Grid_Scale; if Res = Hi then r := 2 else r := 1; Clear_Screen; Set_Mouse(M_Arrow); { Draw Arrows } TStr := ' '; Tstr[1] := chr(4); Draw_String(55,46*r,TStr); Draw_String(55,118*r,TStr); Draw_String(55,158*r,TStr); Tstr[1] := chr(3); Draw_String(129,46*r,TStr); Draw_String(129,118*r,TStr); Draw_String(129,158*r,TStr); { Display Text } GotoXY(3,8); write('Grid Scale'); GotoXY(4,5); write('(per grid line)'); GotoXY(6,11); write(Grid_Scale:4:2); GotoXY(10,3); write('Number of Grid Lines'); GotoXY(11,5); write('(positive axis)'); GotoXY(13,10); write('X-Axis'); GotoXY(15,12); write(XLim:2); GotoXY(18,10); write('Y-Axis'); GotoXY(20,12); write(YLim:2); Draw_String(253,66*r,'ABORT'); Text_Style(Thickened); Draw_String(265,104*r, 'OK'); Text_Style(Normal); { Draw Boxes } Frame_Rect(68,36*r,56,16*r); Frame_Rect(68,108*r,56,16*r); Frame_Rect(68,148*r,56,16*r); Frame_Rect(241,55*r,64,16*r); Frame_Rect(241,81*r,64,40*r); Must_Load2 := FALSE; Done := FALSE; repeat Show_Mouse; Event := Get_Event(E_Button,1,1,1,0, FALSE,0,0,0,0,FALSE,0,0,0,0, Dummy_Buffer,Dummy,Dummy,Dummy,mx,my,Dummy); Hide_Mouse; if Res = Hi then my := my DIV 2; if Event = E_Button then if (mx>241) AND (mx<305) then begin if (my>81) AND (my<121) then Done := TRUE else if (my>55) AND (my<71) then begin { Restore orginal values and abort } Must_Load2 := FALSE; XLim := TempXLim; YLim := TempYLim; Grid_Scale := TempScale; Done := TRUE end {else if} end {else if} else if (my>38) AND (my<49) then begin if (mx>54) AND (mx<65) AND (Grid_Scale > 0.06) then begin Grid_Scale := Grid_Scale-0.05; Must_Load2 := TRUE end {if} else if (mx>128) AND (mx<139) AND (Grid_Scale < 3.96) then begin Grid_Scale := Grid_Scale+0.05; Must_Load2 := TRUE end; {else if} GotoXY(6,11); write(Grid_Scale:4:2) end {else if} else if (my>110) AND (my<121) then begin if (mx>54) AND (mx<65) AND (XLim>4) then begin XLim := XLim - 4; Must_Load2 := TRUE end {if} else if (mx>128) AND (mx<139) AND (XLim<32) then begin XLim := XLim + 4; Must_Load2 := TRUE end; {if else} GotoXY(15,12); write(XLim:2) end {else if} else if (my>150) AND (my<161) then begin if (mx>54) AND (mx<65) AND (YLim>4) then begin YLim := YLim - 4; Must_Load2 := TRUE end {if} else if (mx>128) AND (mx<139) AND (YLim<32) then begin YLim := YLim + 4; Must_Load2 := TRUE end; {else if} GotoXY(20,12); write(YLim:2) end {else if} until Done end; {Get_Grid_Parameters} {************** Convert ******************************************** * * * This function converts the input expression from infix to * * postfix notation. A pointer to the postfix expression is * * is returned as the as the value of Convert. * * * * Called by: Get_Function * * * * In parameter: The infix expression * * Out parameter: Syntax error flag * *********************************************************************} function Convert(InString {in}: Str255; var Syntax_Error {out}: boolean): NodePtr; var TempStr: Str255; {Temporary storage of Infix expression} PostFix, {Pointer to the postfix expression} Tail, {Pointer to last token in postfix expression} Token, {A token to be added to postfix expression} TOS: NodePtr; {Pointer to top of stack used in conversion} I, {Loop counter} L: integer; {Length of InFix expression} Previous_Token: char; {Denotes the type of the previous token. This has a value of '(' for right parenthesis, and a 'N' if previous token was numeric. Numeric tokens are numbers, 'X', and ')'. A code of 'F' indicates a function token. Otherwise this identifier is assigned the null character. } {------------ Next_Token ------------------- | | | This function removes the next item from | | the infix expression and returns the | | corresponding token. | | | | Called by: Convert | | | | In/Out parameter: The infix expression | | Previous token | | Out parameter: Syntax error flag | ---------------------------------------------} function Next_Token(var InFix {in/out}: Str255; var Previous_Token: char; var Syntax_Error {out}: boolean): NodePtr; var Token: NodePtr; {The new token} TStr: Str255; {Stores numeric operand in string form} TChar: char; {Token code for non-numeric tokens} T: integer; {Temporary storage for token priority} {- - - - - - - - - Str_to_Num - - - - - - - - - - - - - Converts a string representation of a number - - to the numeric representation. - - - - Called by: Next_Token - - - - In parameter: The string representation - - Out parameter: Syntax error flag - - - - - - - - - - - - - - - - - - - - - - - - -} function Str_to_Num(NumStr {in}: Str255; var Syntax_Error {out}: boolean): Real; var Integer_Part, {Integer part of number} Fraction_Part, {Fraction part of number} Power_of_Ten: real; {Used in finding fraction part} DP, {Position of decimal point} Num_Int_Digits, {Number of digits in integer part} Num_Frac_Digits, {Number of digits in fractional part} I: integer; {Loop counter} begin { Initialize variables. } Integer_Part := 0; Fraction_Part := 0; Power_of_Ten := 1; { Determine number of digits in integer part and fraction part. } DP := pos('.', NumStr); if DP = 0 then begin { string represents an integer } Num_Int_Digits := length(NumStr); Num_Frac_Digits := 0 end {if} else begin { string represents a real } Num_Int_Digits := DP-1; Num_Frac_Digits := length(NumStr)-DP end; {else} { Convert integer part to numeric form. } for I := 1 to Num_Int_Digits do begin Integer_Part := 10*Integer_Part + ord(NumStr[1]) - ord('0'); delete(NumStr,1,1) end; {for} if NumStr <> '' then { delete decimal point from string } delete(NumStr,1,1); { Convert fraction part (if any) to numeric form. } if Num_Frac_Digits > 0 then { first check for extra decimal point } if pos('.', NumStr) = 0 then begin { conversion process } for I := 1 to Num_Frac_Digits do begin Fraction_Part := 10*Fraction_Part + ord(NumStr[1]) - ord('0'); Power_of_Ten := 10*Power_of_Ten; delete(NumStr,1,1) end; {for} Fraction_Part := Fraction_Part/Power_of_Ten end {if} else Syntax_Error := TRUE; Str_to_Num := Integer_Part + Fraction_Part end; {Str_to_Num} {- - - - - - - - - - - - - - - - - - - - - - - -} begin { Next_Token } { Get and initialize token node. } new(Token); Token^.Link := NIL; while InFix[1] = ' ' do { remove leading blanks } delete(InFix,1,1); TStr := InFix[1]; { Transfer first character of infix to TStr. } delete(InFix,1,1); if TStr[1] in ['0'..'9','.'] then begin { Token is a number. } Token^.NodeType := Numeric; { Read the number as a string of valid numeric characters. } while (InFix <> '') and (InFix[1] in ['.','0'..'9']) do begin TStr := concat(TStr, InFix[1]); delete(InFix,1,1) end; {while} { Convert string representation to numeric. } Token^.Value := Str_to_Num(TStr, Syntax_Error); { Do a little error checking. A number cannot directly follow another numeric token or a function token. } if NOT Syntax_Error then if (Previous_Token = 'N') OR (Previous_Token = 'F') then Syntax_Error := TRUE else {reset previous token code} Previous_Token := 'N' end {if} else begin { Token is character type token. } Token^.NodeType := Character; TChar := TStr[1]; Token^.Code := TChar; { Determine priority of token } case TChar of 'X','Y','R','D','(',')': Token^.Priority := 0; '+': Token^.Priority := 1; '-': if Previous_Token = '(' then begin Token^.Priority := 3; TChar := '~'; Token^.Code := '~' end {if} else Token^.Priority := 1; '*','/': Token^.Priority := 2; '^': Token^.Priority := 4; { Also check for syntax errors in function tokens. } 'A': if (Length(InFix) > 1) and (InFix[1] = 'B') and (InFix[2] = 'S') then begin Token^.Priority := 5; delete(InFix,1,2) end {if} else Syntax_Error := TRUE; 'C': if (Length(InFix) > 1) and (InFix[1] = 'O') and (InFix[2] = 'S') then begin Token^.Priority := 5; delete(InFix,1,2) end {if} else Syntax_Error := TRUE; 'E': if (Length(InFix) > 1) and (InFix[1] = 'X') and (InFix[2] = 'P') then begin Token^.Priority := 5; delete(InFix,1,2) end {if} else Syntax_Error := TRUE; 'L': if (Length(InFix) > 0) and (InFix[1] = 'N') then begin Token^.Priority := 5; delete(InFix,1,1) end {if} else Syntax_Error := TRUE; 'S': if (Length(InFix) > 1) and (InFix[1] = 'I') and (InFix[2] = 'N') then begin Token^.Priority := 5; delete(InFix,1,2) end {if} else if (Length(Infix)>1) and (Infix[1] = 'Q') and (Infix[2] = 'R') then begin Token^.Priority := 5; Token^.Code := 'Q'; delete(InFix,1,2) end {else if} else Syntax_Error := TRUE; 'T': if (Length(Infix) > 1) and (InFix[1] = 'A') and (InFix[2] = 'N') then begin Token^.Priority := 5; delete(InFix,1,2) end {if} else Syntax_Error := TRUE; OTHERWISE: Syntax_Error := TRUE { Since token was not in list } end; {case} if NOT Syntax_Error then begin { Do a little error checking. } T := Token^.Priority; if ((T = 5) OR (TChar in ['X','Y','R','D','('])) AND (Previous_Token = 'N') then Syntax_Error := TRUE else if ((T = 5) OR (TChar in ['X','Y','R','D'])) AND (Previous_Token = 'F') then Syntax_Error := TRUE else if ((T = 1) OR (T = 2) OR (T = 4) OR (TChar = ')')) AND (Previous_Token <> 'N') then Syntax_Error := TRUE; { Reset previous token code. } if NOT Syntax_Error then if Token^.Nodetype = Numeric then Previous_Token := 'N' else if TChar in ['X','Y','R','D',')'] then Previous_Token := 'N' else if TChar = '(' then Previous_Token := '(' else if T = 5 then Previous_Token := 'F' else Previous_Token := chr(0) end {if} end; {else} Next_Token := Token end; {Next_Token} {------------------ Append ----------------- | | | This procedure appends the input token to | | the postfix expression. | | | | Called by: Convert | | | | In parameter: The token | | In/Out parameter: Pointer to last token | | in postfix expression | ---------------------------------------------} procedure Append(var Tail {in/out}: NodePtr; Item {in}: NodePtr); var Temp: NodePtr; begin if Item^.Link <> NIL then {Item is on stack, append copy to postfix. } new(Temp) else { The item itself is appended to postfix. } Temp := Item; Temp^ := Item^; Tail^.Link := Temp; Tail := Temp; Temp^.Link := NIL end; {Append} {----------------- Push -------------------- | | | Push a token onto the stack | | | | Called by: Convert | | | | In parameter: The token | | In/Out parameter: The top of stack ptr | ---------------------------------------------} procedure Push(var TOS {in/out}: NodePtr; Item {in}: NodePtr); begin Item^.Link := TOS; TOS := Item end; {------------------- Pop -------------------- | | | Delete the top element from the stack. | | | | Called by: Convert | | | | In/Out parameter: The top of stack ptr | ---------------------------------------------} procedure Pop(var TOS {in/out}: NodePtr); var Temp: NodePtr; begin Temp := TOS; TOS := TOS^.Link; dispose(Temp) end; {Pop} {******** Convert code starts here *******} begin TempStr := InString; Syntax_Error := FALSE; Previous_Token := '('; { Create 'NULL' node on stack. } new(TOS); TOS^.NodeType := Character; TOS^.Priority := 0; TOS^.Code := '@'; TOS^.Link := NIL; {Create a dummy head node. } new(PostFix); Tail := PostFix; { Process the user's infix expression. } while (Length(InString) > 0) and not Syntax_Error do begin Token := Next_Token(InString, Previous_Token, Syntax_Error); if not Syntax_Error then begin { Numbers and variables are immediately appended to postfix. } if Token^.NodeType = Numeric then Append(Tail, Token) else if Token^.Code in ['X','Y','R','D'] then Append(Tail, Token) { Left parenthesis is pushed onto the stack. } else if Token^.Code = '(' then Push(TOS, Token) { When a right parenthesis is encountered, operators are pulled from the stack and appended to postfix until the corresponding left parenthesis is encountered. The left parenthesis is pulled from the stack, and both parentheses are discarded. } else if Token^.Code = ')' then begin while (TOS^.Code <> '(') and (TOS^.Code <> '@') do begin Append(Tail, TOS); Pop(TOS) end; {while} if TOS^.Code = '@' then Syntax_Error := TRUE else Pop(TOS) end {else if} { The only thing left is operators. Operators of higher priority, if any, are pulled from the stack and appended to postfix. The current operator is then pushed onto the stack. } else begin while Token^.Priority <= TOS^.Priority do begin Append(Tail, TOS); Pop(TOS) end; {while} Push(TOS, Token) end {else} end {if} end; {while} if Syntax_Error then begin { Print syntax error message if needed. } GotoXY(18,1); L := length(TempStr) - length(InString) + 4; for I := 1 to L do write(' '); writeln('^'); writeln('Syntax error!') end {if} { Remove the remaining operators from the stack and append to postfix. } else begin while TOS^.Code <> '@' do begin if TOS^.Code = '(' then begin Syntax_Error := TRUE; writeln('Unmatched Left Parenthesis!') end; Append(Tail, TOS); Pop(TOS) end; {while} Pop(TOS) { Pull NULL node from stack } end; {else} Convert := PostFix^.Link; dispose(PostFix) end; {Convert} {*********************** Get_Function ****************************** * * * This procedure asks the user to enter the expression to be * * graphed. It is entered in normal infix notation and converted * * to postfix. * * * * Called by: MAIN DRIVER * * * * Out Parameter: The postfix expression * * In/Out parameter: The infix expression * * * *********************************************************************} procedure Get_Function(var InFix {in/out}: Str255; var PostFix {out}: NodePtr); var J, {Loop counter} Last: integer; {Index of last character in infix expression} Temp: real; {Used in checking for postfix errors} TempPtr, {Used when returning old nodes to heap} OldPtr: NodePtr; {Previous postfix pointer} OldStr, {Previous infix expression} TempStr: Str255; {Temporary storage of infix expression} Dummy, Dialog: Dialog_Ptr; {Pointer to dialog box} Pushed, {Stores way in which user exited dialog box} Prompt, {Points to prompt in dialog box} User_Input, {Points to user input item in dialog box} Quit_Btn, {Quit button in dialog box} Ok_Btn: integer; {Ok button in dialog box} begin OldStr := Infix; OldPtr := PostFix; { Get a valid infix expression from the user. } Clear_Screen; repeat if Res = Low then Dialog := New_Dialog(4,0,0,38,5) else Dialog := New_Dialog(4,0,0,78,5); Prompt := Add_DItem(Dialog,G_Text,None,1,1,2,1,0,256*Black); Set_DText(Dialog,Prompt,'Z=',3,TE_Center); if Res = Low then begin User_Input := Add_DItem(Dialog,G_FText,Editable, 3,1,34,1,0,256*Black|128); Set_DEdit(Dialog,User_Input,'__________________________________', 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', Infix,3,TE_Left) end {if} else begin User_Input := Add_DItem(Dialog,G_FText,Editable, 3,1,74,1,0,256*Black|128); Set_DEdit(Dialog,User_Input, '__________________________________________________________________________', 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX', Infix,3,TE_Left) end; {else} Quit_Btn := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn, 1,3,8,1,0,0); Set_DText(Dialog,Quit_Btn,'ABORT',3,TE_Center); Ok_Btn := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn, 12,3,8,1,0,0); Set_DText(Dialog,Ok_Btn,' OK ',3,TE_Center); Center_Dialog(Dialog); Set_Mouse(M_Arrow); Show_Mouse; Pushed := Do_Dialog(Dialog,User_Input); End_Dialog(Dialog); Hide_Mouse; Clear_Screen; Delete_Dialog(Dialog); Syntax_Error := FALSE; if Pushed = Ok_Btn then begin Get_DEdit(Dialog,User_Input,TempStr); if TempStr <> '' then begin {remove trailing blanks} InFix := TempStr; Last := Length(InFix); while (Last > 0) AND (Infix[Last] = ' ') do begin delete(InFix, Last, 1); Last := Last - 1 end; {while} {Convert to all uppercase} for J := 1 to Last do if InFix[J] in ['a'..'z'] then InFix[J] := chr(ord(InFix[J])-32) end; {if} PostFix := Convert(InFix, Syntax_Error) end {if} until NOT Syntax_Error; if Pushed = Ok_Btn then begin Must_Load1 := TRUE; Must_Transform := TRUE; while OldPtr<>NIL do begin {return previous postfix memory to heap} TempPtr := OldPtr; OldPtr := OldPtr^.Link; dispose(TempPtr) end {for} end {if} else begin Infix := OldStr; PostFix := OldPtr end end; {Get_Function} {**************************** Get_View ***************************** * * * Get the viewpoint and other parameters related to screen view. * * * * Called by: MAIN DRIVER * * * * Out parameters: Azimuth, Altitude, Screen_Scale, Plot_Speed, * * Draw_Top, Draw_Bottom * * * *********************************************************************} procedure Get_View(var Azimuth, Altitude, Screen_Scale: integer; var Fast_Plot, Perspective, Draw_Both_Ways, Hidden_Lines, Draw_Top, Draw_Bottom, Must_Transform: boolean); var TStr: Str255; { Temporary storage used in Draw_String } TempAz, TempAL, TempSc: integer; { Temporary storage in } TempPF, TempPE, TempBW, { case of an abort } TempHL, TempDT, TempDB: boolean; r: 1..2; { 1 if color monitor used, 2 otherwise } begin TempAz := Azimuth; TempAl := Altitude; TempSc := Screen_Scale; TempPF := Plot_Fast; TempPE := Perspective; TempBW := Draw_Both_Ways; TempHL := Hidden_Lines; TempDT := Draw_Top; TempDB := Draw_Bottom; if Res = Hi then r := 2 else r := 1; Clear_Screen; Set_Mouse(M_Arrow); TStr := ' '; { Draw Arrows } TStr[1] := chr(4); Draw_String(96,22*r, TStr); Draw_String(96,102*r, TStr); TStr[1] := chr(3); Draw_String(161,22*r, TStr); Draw_String(161,102*r, TStr); TStr[1] := chr(1); Draw_String(129,46*r, TStr); TStr[1] := chr(2); Draw_String(129,78*r, TStr); { Draw check marks where necessary } TStr[1] := chr(8); if Fast_Plot then Draw_String(89,126*r, TStr); if Perspective then Draw_String(89,142*r, TStr); if Draw_Both_Ways then Draw_String(89,158*r, TStr); if Hidden_Lines then Draw_String(89,174*r, TStr); if Draw_Top then Draw_String(89,190*r, TStr); if Draw_Bottom then Draw_String(89,198*r, TStr); { Display screen text } GotoXY(3,3); write('Azimuth'); GotoXY(3,15); write(Azimuth:4); GotoXY(8,2); write('Altitude'); GotoXY(8,16); write(Altitude:3); GotoXY(13,6); write('Size'); GotoXY(13,16); write(Screen_Scale:3,'%'); GotoXY(16,14); write('Fast plot'); GotoXY(18,14); write('Perspective'); GotoXY(20,14); write('Lines both ways'); GotoXY(22,14); write('Hidden lines'); GotoXY(24,5); write('Graph:'); GotoXY(24,14); write('Top'); GotoXY(25,14); write('Bottom'); Draw_String(253,66*r, 'ABORT'); Text_Style(Thickened); Draw_String(265,104*r, 'OK'); Text_Style(Normal); { Draw boxes } Frame_Rect(108,12*r,48,16*r); Frame_Rect(108,52*r,48,16*r); Frame_Rect(108,92*r,48,16*r); Frame_Rect(241,55*r,64,16*r); Frame_Rect(241,81*r,64,40*r); { Get and process any user changes } TStr[1] := chr(8); Done := FALSE; repeat Show_Mouse; Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0, Dummy_Buffer,Dummy,Dummy,Dummy,mx,my,Dummy); Hide_Mouse; if Res = Hi then my := my DIV 2; if Event = E_Button then if (mx>241) AND (mx<305) then begin if (my>81) AND (my<121) then Done := TRUE else if (my>55) AND (my<71) then begin { Restore values and abort } Azimuth := TempAz; Altitude := TempAl; Screen_Scale := TempSc; Plot_Fast := TempPF; Perspective := TempPE; Draw_Both_Ways := TempBW; Hidden_Lines := TempHL; Draw_Top := TempDT; Draw_Bottom := TempDB; Done := TRUE end {else if} end {if} else if(my>14) AND (my<25) then begin if (mx>95) AND (mx<106) AND (Azimuth>-180) then begin Azimuth := Azimuth - 5; Must_Transform := TRUE end {if} else if (mx>160) AND (mx<171) AND (Azimuth<180) then begin Azimuth := Azimuth + 5; Must_Transform := TRUE end; {else if} GotoXY(3,15); write(Azimuth:4) end {else if} else if (mx>128) AND (mx<139) AND (my<81) then begin if (my>38) AND (my<49) AND (Altitude<90) then begin Altitude := Altitude + 5; Must_Transform := TRUE end {if} else if (my>70) AND (my<81) AND (Altitude>-90) then begin Altitude := Altitude - 5; Must_Transform := TRUE end; {else if} GotoXY(8,16); write(Altitude:3) end {else if} else if(my>94) AND (my<105) then begin if (mx>95) AND (mx<106) AND (Screen_Scale > 50) then begin Screen_Scale := Screen_Scale - 10; Must_Transform := TRUE end {if} else if (mx>160) AND (mx<171) AND (Screen_Scale < 200) then begin Screen_Scale := Screen_Scale + 10; Must_Transform := TRUE end; {else if} GotoXY(13,16); write(Screen_Scale:3) end {else if} else if(mx>104) AND (mx<177) AND (my>120) AND (my<129) then if Fast_Plot then begin Fast_Plot := FALSE; GotoXY(16,13); write(' '); GotoXY(16,12); write(' ') end {if} else begin Fast_Plot := TRUE; Draw_String(89,126*r, TStr) end {else} else if (mx>104) AND (mx<193) AND (my>136) AND (my<145) then if Perspective then begin Perspective := FALSE; GotoXY(18,13); write(' '); GotoXY(18,12); write(' '); Must_Transform := TRUE end {if} else begin Perspective := TRUE; Draw_String(89,142*r, TStr); Must_Transform := TRUE end {else} else if (mx>104) AND (mx<225) AND (my>152) AND (my<161) then if Draw_Both_Ways then begin Draw_Both_Ways := FALSE; GotoXY(20,13); write(' '); GotoXY(20,12); write(' ') end {if} else begin Draw_Both_Ways := TRUE; Draw_String(89,158*r, TStr) end {else} else if (mx>104) AND (mx<241) AND (my>168) AND (my<177) then if Hidden_Lines then begin Hidden_Lines := FALSE; GotoXY(22,13); write(' '); GotoXY(22,12); write(' ') end {if} else begin Hidden_Lines := TRUE; Draw_String(89,174*r, TStr) end {else} else if (mx>104) AND (mx<129) AND (my>184) AND (my<193) then if Draw_Top then begin Draw_Top := FALSE; GotoXY(24,13); write(' '); GotoXY(24,12); write(' ') end {if} else begin Draw_Top := TRUE; Draw_String(89,190*r, TStr) end {else} else if (mx>104) AND (mx<153) AND (my>192) AND (my<200) then if Draw_Bottom then begin Draw_Bottom := FALSE; GotoXY(25,13); write(' '); GotoXY(25,12); write(' ') end {if} else begin Draw_Bottom := TRUE; Draw_String(89,198*r, TStr) end {else} until Done end; {Get_View} {************************ Evaluate_Function ************************ * * * Evaluates the Postfix expression * * * * Called by: Load_Point_Array * * * * Variables are accessed globally to reduce execution time * * * *********************************************************************} function Evaluate_Function(Head {in}: NodePtr): real; var TOS: 0..100; Stack: array [1..100] of real; Cosine_Val: real; Temp: integer; Undefined, PostFix_Error: boolean; begin { Initialize flags and data stack. } PostFix_Error := FALSE; Undefined := FALSE; TOS := 0; { Process postfix expression } while (Head<> NIL) and not PostFix_Error and not Undefined do begin { Push numbers onto the stack, } if Head^.NodeType = Numeric then begin TOS := TOS + 1; Stack[TOS] := Head^.Value end {if} { or push the value of a variable onto the stack, } else if Head^.Code = 'X' then begin TOS := TOS + 1; Stack[TOS] := x end {else if} else if Head^.Code = 'Y' then begin TOS := TOS + 1; Stack[TOS] := y end {else if} else if Head^.Code = 'R' then begin TOS := TOS + 1; Stack[TOS] := r end {else if} else if Head^.Code = 'D' then begin TOS := TOS + 1; Stack[TOS] := d end {else if} { or apply negation operator, } else if Head^.Priority = 3 then if TOS>0 then Stack[TOS] := -Stack[TOS] else PostFix_Error := TRUE { or apply function to TOS element, } else if Head^.Priority = 5 then if TOS>0 then case Head^.Code of 'A': Stack[TOS] := ABS(Stack[TOS]); 'C': Stack[TOS] := COS(Stack[TOS]); 'E': if Stack[TOS] < -50 then Stack[TOS] := 0 else if Stack[TOS] < 50 then Stack[TOS] := EXP(Stack[TOS]) else Undefined := TRUE; 'L': if Stack[TOS] > 0 then Stack[TOS] := LN(Stack[TOS]) else Undefined := TRUE; 'Q': if Stack[TOS] >= 0 then Stack[TOS] := SQRT(Stack[TOS]) else Undefined := TRUE; 'S': Stack[TOS] := SIN(Stack[TOS]); 'T': begin Cosine_Val := COS(Stack[TOS]); if ABS(Cosine_Val) > 0.000001 then Stack[TOS] := SIN(Stack[TOS])/COS(Stack[TOS]) else Undefined := TRUE end {case option} end {case} else PostFix_Error := TRUE { or else the token is a binary operator which is applied to top two stack elements and the result replaces both of them. } else if TOS>1 then begin TOS := TOS - 1; case Head^.Code of '+': Stack[TOS] := Stack[TOS] + Stack[TOS+1]; '-': Stack[TOS] := Stack[TOS] - Stack[TOS+1]; '*': Stack[TOS] := Stack[TOS] * Stack[TOS+1]; '/': if ABS(Stack[TOS+1]) > 0.000001 then Stack[TOS] := Stack[TOS] / Stack[TOS+1] else Undefined := TRUE; { The program can handle two types of exponentiation. If the base (TOS) is positive, the normal process of using EXP and LN functions is used. If the base is negative and the exponent is an integer, then we have to apply some algebraic trickery first. If the base has a value of zero, the result is set to zero as well. } '^': if Stack[TOS] > 0 then Stack[TOS] := EXP(Stack[TOS+1]*LN(Stack[TOS])) else if Stack[TOS] < 0 then begin Temp := round(Stack[TOS+1]); if abs(Temp - Stack[TOS+1]) < 0.000001 then begin Stack[TOS] := EXP(Stack[TOS+1]*LN(-Stack[TOS])); if Odd(Temp) then Stack[TOS] := -Stack[TOS] end {if} else Undefined := TRUE end {else if} else Stack[TOS] := 0 end {case} end {if} { If we get this far, then postfix token is invalid. Not likely to happen. } else PostFix_Error := TRUE; Head:= Head^.Link { Move to next token in postfix. } end; {while} { At the end, there should be only one element remaining on the stack, namely the final result. Otherwise, the postfix expression is invalid. We skip this if the function is undefined for the current value of X. } if not Undefined then begin if TOS = 1 then if Stack[TOS] > Max_Z then Evaluate_Function := Max_Z else if Stack[TOS] < Min_Z then Evaluate_Function := Min_Z else Evaluate_Function := Stack[TOS] else PostFix_Error := TRUE; { Print error message if necessary. } if PostFix_Error then begin writeln('Postfix error detected!'); writeln; writeln('This is usually caused by too few'); writeln('operators. Check for missing arithmetic'); writeln('symbols; especially multiplication "*".') end {if} end {if} else Evaluate_Function := Max_Z end; {Evaluate_Function} {********************** Load_Point_Array *************************** * * * Load the logical coordinate point arrays. * * * * Called by: MAIN DRIVER * * * * Accessed as global variables: lx, ly, lz, XLim, YLim, Grid_Scale, * * Must_Load1, Must_Load2, * * Must_Transform * * * *********************************************************************} procedure Load_Point_Array; var i,j: integer; { Loop counters } begin Clear_Screen; Draw_String(0,100,'CALCULATING POINT COORDINATES...'); Set_Mouse(M_Bee); Show_Mouse; Max_Z := 2*Grid_Scale*XLim; Min_Z := -Max_Z; { Calculate values for logical coordinates } for I := -XLim to XLim do for j := -YLim to YLim do begin x := I*Grid_Scale; y := J*Grid_Scale; r := x*x+y*y; d := sqrt(r); lz[i,j] := Evaluate_Function(PostFix); lx[i,j] := x; ly[i,j] := y end; {for} Hide_Mouse; Must_Load1 := FALSE; Must_Load2 := FALSE; Must_Transform := TRUE end; {Load_Point_Array} {******************** Transform_Point_Array ************************ * * * Transform the coordinate arrays into screen coordinates. Scale * * and viewpoint are taken into account. * * * * Called by: MAIN DRIVER * * * * Accessed as global variables: Azimuth, Altitude, Screen_Scale, * * Grid_Scale, XLim, YLim, lx, ly, lx, sx, sy, Perspective, * * X_Center, Y_Center, SF * * * *********************************************************************} procedure Transform_Point_Array; var i,j : integer; { Loop counters } Temp, { Temporary storage } AzRad, { Azimuth in radians } AltRad, { Altitude in radians } NewZ, { Transformed z-coordinate } Display_Scale, { Scaling factor used in drawing graph } pf, { Perspective factor } c1,s1,c2,s2, { cos(AzRad), sin(AzRad), cos(AltRad), sin(AltRad) } mf1,mf2: real; { Multiplicative factors to create graph that will nearly } { fill the screen. } begin Clear_Screen; Draw_String(0,100, 'TRANSFORMING THE POINTS...'); Set_Mouse(M_Bee); Show_Mouse; AzRad := Azimuth*Pi/180; c1 := cos(AzRad); s1 := sin(AzRad); AltRad := Altitude*Pi/180; c2 := cos(AltRad); s2 := sin(AltRad); Display_Scale := Screen_Scale/100; mf1 := 0.90*X_Center*Display_Scale/(XLim*Grid_Scale); mf2 := mf1*SF; { Transform logical to screen coordinates } for I := -XLim to XLim do for j := -YLim to YLim do begin Temp := lx[i,j]*s1-ly[i,j]*c1; NewZ := c2*Temp+lz[i,j]*s2; if Perspective then pf := 1/(1-NewZ/(140*Grid_Scale)) else pf := 1; sx[i,j] := X_Center+round(mf1*pf*(lx[i,j]*c1+ly[i,j]*s1)); sy[i,j] :=Y_Center-round(mf2*pf*(s2*(-Temp)+lz[i,j]*c2)) end; {for} Hide_Mouse; Must_Transform := FALSE end; { Transform_Point_Array } {************************ Draw Line ******************************** * * * This procedure draws the visible portion(s) of the line between * * the two points passed in as parameters. The maximum and minimum * * arrays are updated as necessary. * * * * Called by: Draw_Graph * * * * In parameters: The coordinates of two points * * * * Global variables accessed: Max, Min, Draw_Top, Draw_Bottom, * * Plot_Fast * * * *********************************************************************} procedure Draw_Line(x1,y1,x2,y2: integer); var f1 ,f2: 0..2; { Flag = 2 ===> Point visible above } { Flag = 1 ===> Point visible below } { Flag = 0 ===> Point is hidden } dx, dy, { delta x = x2 - x1, delta y = y2 - y1 } tx, ty: integer; { Temporary storage } inc, { Temporary storaged } incx, incy, { Increments used to plot line pixel by pixel } { when only part of line is visible. } t1, t2, { Horizontal and vertical distance from first } { point. Used when plotting pixel by pixel. } slope: real; { Slope of line segment between points } {-------------- Adjust_Min ------------------ | | | Adjust the array indicating the upper limit | | of the graph. | | | | Called by: Draw_Line | | | | Global variables accessed: x1,x2,y1,y2 | | | ----------------------------------------------} procedure Adjust_Min; var x: integer; {Loop counter} begin if x1>x2 then {Line goes left to right} for x := x1 downto x2 do begin min[x] := y1 + round((x-x1)*slope); if max[x] = minint then max[x] := min[x] end {for} else {Line goes right to left} for x := x1 to x2 do begin min[x] := y1 + round((x-x1)*slope); if max[x] = minint then max[x] := min[x] end {for} end; {Adust_Min} {-------------- Adjust_Max ------------------ | | | Adjust the array indicating the lower limit | | of the graph. | | | | Called by: Draw_Line | | | | Global variables accessed: x1,x2,y1,y2 | | | ----------------------------------------------} procedure Adjust_Max; var x: integer; {Loop counter} begin if x1>x2 then {Line goes left to right} for x := x1 downto x2 do begin max[x] := y1 + round((x-x1)*slope); if min[x] = maxint then min[x] := max[x] end {for} else {Line goes right to left} for x := x1 to x2 do begin max[x] := y1 + round((x-x1)*slope); if min[x] = maxint then min[x] := max[x] end {for} end; {Adust_Max} {-------------- Swap_Points ----------------- | | | Swap the two input points and associated | | variables. All are accessed as global | | values within Draw_Line. | | | | Called by: Draw_Line | | | | Global variables accessed: x1,x2,y1,y2,f1, | | f2, incx, incy | | | ----------------------------------------------} procedure Swap_Points; var TempInt: integer; begin TempInt := x1; x1 := x2; x2 := TempInt; TempInt := y1; y1 := y2; y2 := TempInt; TempInt := f1; f1 := f2; f2 := TempInt; incx := -incx; incy := -incy end; {Swap_Points} {----------------------------------------------} begin { Check visibility of first point } if y1 <= min[x1] then { point is visible above graph } f1 := 2 else if y1 >= max[x1] then { point is visible below graph } f1 := 1 else { point is hidden } f1 := 0; { Check visibility of second point } if f1 <> 1 then { check for visible above graph first } if y2 <= min[x2] then { visible above } f2 := 2 else if y2 >= max[x2] then { visible below } f2 := 1 else { hidden } f2 := 0 else { Since first point was below, check second point for below first } if y2 >= max[x2] then { below } f2 := 1 else if y2 <= min[x2] then { above } f2 := 2 else { hidden } f2:=0; dx := x2 - x1; dy := y2 - y1; if (f1 | f2) > 0 then {at least one point is visible} if abs(dx)+abs(dy) = 0 then { Line consists of single point } Plot(x1,y1) else begin if (f1 = f2) AND (dx <> 0) AND Plot_Fast then begin { Draw line segment } slope := dy/dx; if (f1 = 2) then begin {both points above the graph} if Draw_Top then begin Line_Color(1); line(x1,y1,x2,y2) end; {if} Adjust_Min end {if} else begin {both points below the graph} if Draw_Bottom then begin if Res <> Hi then Line_Color(2); line(x1,y1,x2,y2) end; {if} Adjust_Max end {else if} end {if} else begin if abs(dy)>abs(dx) then inc := 1/abs(dy) else inc := 1/abs(dx); incx := inc*dx; incy := inc*dy; if ((f1=2) OR (f2 = 2)) AND Draw_Top then begin { One of the points is visible above the graph } if y1y2 then Swap_Points; { so line goes from (x1,y1) DOWN to (x2,y2) } if Res <> Hi then line_color(2); t1 := 0; t2 := 0; repeat { Check line pixel by pixel } tx := x1 + round(t1); ty := y1 + round(t2); if ty>max[tx] then begin { pixel is visible so plot it } plot(tx,ty); max[tx] := ty; { and adust Max array } if min[tx] = maxint then min[tx] := ty end; {if} t1 := t1+incx; t2 := t2 +incy until (tx=x2); { you're in same vertical column as (x2,y2) } { so plot remaining vertical segment, if any } if x1 max[x2]) OR (ty > max[tx]) then plot(x2,ty); ty := ty+1 until ty>y2; if f2 = 1 then begin max[x2] := y2; if min[x2] = maxint then min[x2] := y2 end {if} end {if} end {else} end; {else} Line_Color(1) end; {*************************** Draw_Graph **************************** * * * Draw the graph * * * * Called by: MAIN DRIVER * * * * Variables accessed globally: sx, sy, Azimuth, Intensity, Res * * Draw_Both_Ways, XLim, YLim * * * *********************************************************************} procedure Draw_Graph; var XStart, Xstep, Xstop, { Values for x-coordinate loops } YStart, YStep, YStop, { Values for y-coordinate loops } NextI, NextJ, { Next row, next column } Zone, { Octant from which graph is viewed } I, J: integer; { Loop counters } T: array [1..3] of integer; begin if Res <> Hi then {Load graph colors} for I := 0 to 1 do begin for J := 1 to 3 do T[J] := 60 + 125*Intensity[I,J]; Set_Color(I,T[1],T[2],T[3]) end; {for} { Find Zone } if Azimuth > 135 then Zone := 1 else if Azimuth > 90 then Zone := 2 else if Azimuth > 45 then Zone := 3 else if Azimuth > 0 then Zone := 4 else if Azimuth >-45 then Zone := 5 else if Azimuth >-90 then Zone := 6 else if Azimuth>-135 then Zone := 7 else Zone := 8; { Initialize Min and Max arrays } for I := -640 to 1280 do begin max[I] := minint; min[I] := maxint end; {for} { Set up loop parameters } if Zone in [1,2,7,8] then begin YStart := YLim; YStep := -1 end {if} else begin YStart := -YLim; YStep := 1 end; {else} if Zone in [1,2,3,4] then begin XStart := XLim; XStep := -1 end {if} else begin XStart := -XLim; XStep := 1 end; {else} { Draw the graph } Clear_Screen; if Zone in [1,4,5,8] then begin J := YStart; YStop := -YStart + YStep; repeat I := XStart; XStop := -XStart; repeat NextI := I + XStep; Draw_Line(sx[I,J],sy[I,J],sx[NextI,J],sy[NextI,J]); I := NextI until I = XStop; if (J <> -YStart) AND Draw_Both_Ways then begin I := XStart; XStop := XStop + XStep; NextJ := J + YStep; repeat Draw_Line(sx[I,J],sy[I,J],sx[I,NextJ],sy[I,NextJ]); I := I + XStep until I = XStop end; {if} J := J + YStep; until J = YStop end {if} else begin I := XStart; XStop := -XStart + XStep; repeat J := YStart; YStop := -YStart; repeat NextJ := J + YStep; Draw_Line(sx[I,J],sy[I,J],sx[I,NextJ],sy[I,NextJ]); J := NextJ until J = YStop; if (I <> -XStart) AND Draw_Both_Ways then begin J := YStart; YStop := YStop + YStep; NextI := I + XStep; repeat Draw_Line(sx[I,J],sy[I,J],sx[NextI,J],sy[NextI,J]); J := J + YStep until J = YStop end; {if} I := I + XStep; until I = XStop end; {else} repeat Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0, Dummy_Buffer,Dummy,Dummy,Dummy,Dummy,Dummy,Dummy); until Event = E_Button; if Res <> Hi then begin Set_Color(0,1000,1000,1000); Set_Color(1,0,0,0) end {if} end; {Draw_Graph} {*********************** Quick_Draw_Graph ************************** * * * Draw the graph without worrying about hidden lines. * * * * Called by: MAIN DRIVER * * * * Variables accessed globally: sx, sy, Azimuth, Intensity, Res, * * XLim, YLim * * * *********************************************************************} procedure Quick_Draw_Graph; var I, J: integer; { Loop counters } T: array [1..3] of integer; begin Clear_Screen; if Res <> Hi then { Load graph colors } for I := 0 to 1 do begin for J := 1 to 3 do T[J] := 60 + 125*Intensity[I,J]; Set_Color(I,T[1],T[2],T[3]) end; {for} for I := -XLim to XLim do begin Plot(sx[I,-Ylim], sy[I,-YLim]); for J := -YLim+1 to YLim do Line_to(sx[I,J], sy[I,J]) end; {for} for J := -YLim to Ylim do begin Plot(sx[-XLim,J],sy[-XLim,J]); for I := -XLim to XLim do Line_to(sx[I,J], sy[I,J]) end; {for} repeat Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0, Dummy_Buffer,Dummy,Dummy,Dummy,Dummy,Dummy,Dummy); until Event = E_Button; if Res <> Hi then begin Set_Color(0,1000,1000,1000); Set_Color(1,0,0,0) end {if} end; {Quick_Draw_Graph} {**************************** Show_Help **************************** * * * Display help screen for main menu. * * * * Called by: MAIN DRIVER * * * *********************************************************************} procedure Show_Help; var Quit: boolean; Help_Screen: integer; r: 1..2; { 1 if color monitor used, 2 otherwise } begin Help_Screen := 1; Quit := FALSE; if Res = Hi then r := 2 else r := 1; repeat Clear_Screen; GotoXY(1,1); case Help_Screen of { Print current help screen } 1: begin writeln('This program draws graphs of three'); writeln('dimensional functions of the type'); writeln('z = f(x,y). You can enter your own'); writeln('functions by simply typing them in.'); writeln; writeln('You control every aspect of the display'); writeln('including colors, size, and viewpoint.'); writeln; writeln('Clicking on an ABORT button will cancel'); writeln('any changes you''ve made in that option'); writeln('and return you to the main menu. It'); writeln('will also prevent the program from'); writeln('thinking it needs to recalculate or'); writeln('transform the point coordinates.') end; 2: begin writeln(' COLOR'); writeln; writeln('You can choose the background color,'); writeln('as well as the color of the top and'); writeln('bottom surfaces of the graph. Each'); writeln('register (red, green, blue) has a value'); writeln('from 0 (absence of that color) to 7'); writeln('(full intensity). Clicking on an arrow'); writeln('above an intensity value will raise it'); writeln('by one. (Raising a 7 will make it 0.)'); writeln('Clicking on an arrow below an intensity'); writeln('value will decrease the value by one.'); writeln('(Lowering a 0 will make it 7.)'); writeln; writeln('In the event you should accidently make'); writeln('the background and text colors the same,'); writeln('just press the escape (Esc) key.') end; 3: begin writeln(' GRID'); writeln; writeln('The grid scale is the scale per grid'); writeln('line. Acceptable values range from'); writeln('0.10 to 4.00 in steps of 0.05.'); writeln; writeln('You can also choose the number of grid'); writeln('lines used to draw the graph. The'); writeln('X and Y limits are the number of grid'); writeln('lines on the corresponding POSITIVE'); writeln('axis. The actual number of grid lines'); writeln('is given by 2*Limit+1.'); writeln; writeln('The maximum coordinate value is found'); writeln('by multiplying the Limit times the grid'); writeln('scale.'); writeln; writeln('With the default values, there are 33'); writeln('grid lines in each direction with values'); writeln('ranging from -4 to 4 in steps of 0.25.') end; 4: begin writeln(' FUNCTION'); writeln; writeln('The program recognizes the following'); writeln('mathematical functions: ABS, COS, SIN,'); writeln('TAN, LN, EXP, and SQR. When entering'); writeln('your function use the same syntax you'); writeln('would use in BASIC.'); writeln; writeln('The program will allow you to use four'); writeln('variables:'); writeln(' X = x-coordinate'); writeln(' Y = y-coordinate'); writeln(' D = distance from (x,y) to origin'); writeln(' R = D*D (D squared)'); writeln; writeln('Functions can be entered using either'); writeln('upper or lowercase letters.'); end; 5: begin writeln(' VIEW'); writeln; writeln('Azimuth refers to the viewer''s position'); writeln('in the x-y plane as follows:'); writeln; writeln(' Angle (degrees) View from'); writeln(' --------------- ---------'); writeln(' 0 South'); writeln(' 90 East'); writeln(' -90 West'); writeln(' -180 or 180 North'); writeln; writeln('Elevation refers to the angle above or'); writeln('below the x-y plane (directly above the'); writeln('origin is 90 degrees and directly below'); writeln('is -90).'); writeln; writeln('Screen scale refers to the image size'); writeln('and ranges from 50 to 200 percent of the'); writeln('default size.') end; 6: begin writeln(' VIEW (continued)'); writeln; writeln('FAST plotting is approximately twice as'); writeln('fast as SLOW. However, it assumes that'); writeln('if both endpoints of a line segment are'); writeln('visible then the entire segment will be'); writeln('too. This is not always true. SLOW'); writeln('plotting doesn''t make this assumption'); writeln('and will be more accurate in certain'); writeln('(rather rare) circumstances.'); writeln; writeln('The remaining options are turned on or'); writeln('off by clicking on the corresponding'); writeln('text.') end; 7: begin writeln(' DRAW'); writeln; writeln('Draws the graph on the screen.'); writeln; writeln('The program automatically keeps track'); writeln('of whether it needs to calculate a new'); writeln('set of coordinates. This is necessary'); writeln('anytime you change a value in the GRID'); writeln('option or enter a new function.'); writeln; writeln('The program also keeps track of the'); writeln('need to transform the coordinates'); writeln('because of a change in azimuth,'); writeln('elevation, or screen scale.'); writeln; writeln('These operations will be performed as'); writeln('necessary before the graph is drawn.') end end; { Set up buttons at bottom of help screen } if Help_Screen <> 1 then begin GotoXY(24,3); write('BACK'); Frame_Rect(0,180*r,64,16*r) end; GotoXY(24,19); write('MENU'); Frame_Rect(128,180*r,64,16*r); if Help_Screen <> 7 then begin GotoXY(24,35); write('NEXT'); Frame_Rect(256,180*r,64,16*r) end; { Wait until user clicks on a button and take appropriate action. } Done := FALSE; repeat Set_Mouse(M_Arrow); Show_Mouse; Event := Get_Event(E_Button,1,1,1,0,FALSE,0,0,0,0,FALSE,0,0,0,0, Dummy_Buffer,Dummy,Dummy,Dummy,mx,my,Dummy); Hide_Mouse; if Res = Hi then my := my DIV 2; if Event = E_Button then if (my>180) AND (my<200) then begin if (mx>0) AND (mx<63) AND (Help_Screen<>1) then begin Help_Screen := Help_Screen - 1; Done := TRUE end else if (mx>128) AND (mx<191) then begin Quit := TRUE; Done := TRUE end else if (mx>256) AND (mx<319) AND (Help_Screen<>7) then begin Help_Screen := Help_Screen + 1; Done := TRUE end end until Done until Quit end; {Show_Help} {************************************************ M A I N D R I V E R ************************************************} begin if INIT_GEM >= 0 then begin Hide_Mouse; Initialization; PostFix := Convert(InFix, Syntax_Error); Option := Menu_Option; while Option <> Quit do begin case Option of Colors: Get_Colors(Intensity); Grid: Get_Grid_Parameters(Grid_Scale, XLim, YLim, Must_Load2); G_Function: Get_Function(InFix, PostFix); View: Get_View(Azimuth,Altitude,Screen_Scale,Plot_Fast, Perspective, Draw_Both_Ways, Hidden_Lines, Draw_Top,Draw_Bottom,Must_Transform); Draw: begin if Must_Load1 or Must_Load2 then Load_Point_Array; if Must_Transform then Transform_Point_Array; if Hidden_Lines then Draw_Graph else Quick_Draw_Graph end; Help: Show_Help end; {case} Option := Menu_Option end; {while} Set_Mouse(M_Arrow); Show_Mouse; Set_Color(0,1000,1000,1000); Set_Color(1,0,0,0); Set_Color(2,1000,0,0); Exit_Gem end {if} end.