program Grapher(input, output);

const
  Pi = 3.14159265;
  ClrScr = 69;       {Clear screen and home the cursor}
  Cursor_on = 101;   {Turn blinking cursor on}
  Cursor_off = 102;  {Turn blinking cursor off}

{$I GEMCONST.PAS}

type
  Str7 = string[7];
  Draw_Type = (Redraw, No_Grid, Old_Grid);
  Grid_Type = (Rectangular, Polar, Trigonometric);
  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;
  Screen_Type = packed array [0..31999] of byte;
  Screen_Ptr = ^Screen_Type;

{$I GEMTYPE.PAS}

var
  InFix: Str255;          {Infix expression}
  TempPtr,                {Temporary pointer}
  PostFix: NodePtr;       {Postfix expression}
  X_Scale,                {Scale on X-axis}
  Y_Scale: real;          {Scale used on graph grid}
  Color: integer;         {Color of graph}
  Draw: Draw_Type;        {Grid drawing option}
  Grid: Grid_Type;        {Type of grid}
  Event: integer;         {Holds Get_Event value}
  DummyMsg: Message_Buffer;  {Dummy variable used in Get_Event call}
  D: integer;             {Dummy variable used in Get_Event call}

  {The following variables are accessed as global variables}

  Res: Res_Type;          {Screen resolution}
  X_Pix,                  {Number of pixels in horizontal direction}
  Y_Pix,                  {Number of pixels in vertical direction}
  X_Center,               {Center of screen horizontally}
  Y_Center,               {Center of screen vertically}
  Num_Color: integer;     {Number of colors available for graph}
  SF: real;               {Scaling factor need to compensate for screen
                           aspect ratio}
  Display_Area,           {Pointer to display area in memory}
  Temp_Screen: Screen_Ptr;{Used to save a graph display}
  GEM_Interface: boolean; {TRUE if user selects GEM-based interface}

  GridStr,                {This and next four are used to store user}
  DrawStr,                {input for grid type, grid drawing option,}
  ColorStr,               {graph color,                             }
  XStr,                   {X-scale, and                             }
  YStr: Str255;           {Y-scale.                                 }

{$I GEMSUBS.PAS}


{****************  Out_Escape  ******************
*                                               *
*  Send escape codes that control the cursor.   *
*                                               *
*  Called by: Initialization,                   *
*             Get_Expression,                   *
*             Get_Graph_Parameters_OK           *
*                                               *
*  In parameter: Ascii code of the character    *
*                following escape code          *
************************************************}

procedure Out_Escape(c : integer);
  procedure bconout(device, c:integer);
    BIOS(3);
begin
  bconout(2, 27); {The escape character}
  bconout(2, c)
end; {Out_Escape}


{*************  Initialization  *****************
*                                               *
*  Sets the value of various global screen      *
*  parameters based on the screen resolution.   *
*  Also sets initial default values of graph    *
*  parameters: grid scales, color, and          *
*  expression to be graphed.                    *
*                                               *
*  Called by: MAIN DRIVER                       *
*                                               *
*  All variables used in this procedure are     *
*  accessed as globals                          *
************************************************}

procedure Initialization;

var
  AlertStr: Str255;          {Alert box string}
  Blanks: string[25];        {A string of blanks}
  Num: integer;              {Dummy value used in Alert Box call}
  Scr_Res: integer;          {Holds screen resolution value}
  Dummy: char;

  {-------------  Physical Screen  -------------
  |                                             |
  |  Returns pointer to physical screen area.   |
  |                                             |
  |  Called by: MAIN DRIVER                     |
   ---------------------------------------------}

  function Physical_Screen: Screen_Ptr;
    XBIOS(2);

  {-------------  Get Resolution  --------------
  |                                             |
  |  Returns 0, 1, or 2 indicating current      |
  |  screen resolution low, med, or high.       |
  |                                             |
  |  Called by: MAIN DRIVER                     |
   ---------------------------------------------}

  function Get_Res : Integer;
    XBIOS(4);

begin

  { Set up screen parameters based on display resolution. }

  Scr_Res := Get_Res;
  case Scr_Res of

    0 : begin
          Res := Low;
          X_Pix := 320;
          Y_Pix := 200;
          SF := 0.869;
          Num_Color := 15
        end; {0}

    1 : begin
          Res := Med;
          X_Pix := 640;
          Y_Pix := 200;
          SF := 0.434;
          Num_Color := 3
        end; {1}

    2 : begin
          Res := Hi;
          X_Pix := 640;
          Y_Pix := 400;
          SF := 0.869;
          Num_Color := 1
        end; {3}

  end; {case}

  { Print Copyright Message }

  Out_Escape(ClrScr);
  if Res = Low then
    Blanks := '     '
  else
    Blanks := '                         ';
  writeln(Blanks,'           Grapher');
  writeln(Blanks,'      by Delmar Searls');
  writeln;
  writeln(Blanks,' (Parts of this product are');
  writeln(Blanks,'Copyright (c) 1986, OSS & CCD');
  writeln(Blanks,'  Used by permission of OSS)');

  { Let user select type of interface }

  AlertStr := '[2]';
  AlertStr := concat(AlertStr, '[     Choose a     |');
  AlertStr := concat(AlertStr,  '   text-oriented  |');
  AlertStr := concat(AlertStr,  '    or GEM-based  |');
  AlertStr := concat(AlertStr,  '     interface.   ]');
  AlertStr := concat(AlertStr, '[ Text | GEM  ]');
  Num := Do_Alert(AlertStr, 0);
  if Num = 1 then
    GEM_Interface := FALSE
  else
    GEM_Interface := TRUE;
  Out_Escape(ClrScr);

  { Set clipping boundaries and find coordinates of center of display. }

  Set_Clip(0,0,X_Pix,Y_Pix);
  X_Center := X_Pix DIV 2;
  Y_Center := Y_Pix DIV 2;

  {  Set up initial default values  }

  GridStr := 'R';
  DrawStr := '1';
  ColorStr := '1'; Color := 1;
  XStr := '1'; X_Scale := 1;
  YStr := '1'; Y_Scale := 1;
  InFix := 'SIN(X)';
  Display_Area := Physical_Screen;
  new(Temp_Screen)
end; {Initialization)


{****************  Str_to_Num  ******************
*                                               *
*  Converts a string representation of a number *
*  to the numeric representation.               *
*                                               *
*  Called by: Next_Token, Get_Scale,            *
*             Get_Graph_Parameters_OK           *
*                                               *
*  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}


{**************  Convert  ***********************
*                                               *
*  This function converts the input expression  *
*  from infix to postfix notation.  A pointer   *
*  to the postfix expression is returned as the *
*  value of Convert.                            *
*                                               *
*  Called by: Get_Expression                    *
*                                               *
*  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}

  begin

    { 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','(',')': 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 := 'R';
                       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 = 'X') OR (TChar = '('))
                 AND (Previous_Token = 'N') then
          Syntax_Error := TRUE
        else if ((T = 5) OR (TChar = 'X'))
                 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',')'] 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 variable X are immediately appended to postfix. }

      if Token^.NodeType = Numeric then
        Append(Tail, Token)
      else if Token^.Code = 'X' 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. }
    if GEM_Interface then begin
      Out_Escape(ClrScr);
      writeln('Y = ',TempStr)
    end; {if}
    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;
        if GEM_Interface then
          Out_Escape(ClrScr);
        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}


{****************  Evaluate  ********************
*                                               *
*  Evaluates the Postfix expression for the     *
*  value of X passed to it.                     *
*                                               *
*  Called by: Get_Expression, Rect_Graph,       *
*             and Polar_Graph                   *
*                                               *
*  In parameters: The postfix expression and    *
*                 The value of X                *
*  Out parameters: Postfix error flag and       *
*                  Undefined result flag        *
************************************************}

function Evaluate(Head {in}: NodePtr;
                  X {in}: real;
                  var PostFix_Error {out},
                      Undefined {out}: boolean): real;

var
  TOS: 0..100;
  Stack: array [1..100] of real;
  Cosine_Val: real;
  Temp: integer;

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 the variable onto the stack, }

    else if Head^.Code = 'X' then begin
      TOS := TOS + 1;
      Stack[TOS] := X
    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;
          'R': 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
      Evaluate := Stack[TOS]
    else
      PostFix_Error := TRUE;

    { Print error message if necessary. }

    if PostFix_Error then begin
      if GEM_Interface then
        Out_Escape(ClrScr);
      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}
end; {Evaluate}


{**************  Get Expression  ****************
*                                               *
*  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_Expression(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}
  TempStr: Str255; {Temporary storage of infix expression}
  Dummy,
  Syntax_Error,    {TRUE if error found during conversion to postfix}
  PostFix_Error: boolean;  {TRUE if error found during evaluation}
  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
  if NOT Gem_Interface then begin

    { Print the instructions and the default infix expression. }

    Out_Escape(ClrScr);
    Out_Escape(Cursor_On);
    writeln;
    writeln('Enter the expression you want graphed.');
    writeln('(Enter "Q" to QUIT)');
    writeln;
    writeln('Y = ',InFix);
  end; {if}

    { Get a valid infix expression from the user. }

  repeat
    if GEM_Interface then begin
      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,'Y=',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,6,1,0,0);
      Set_DText(Dialog,Quit_Btn,'QUIT',3,TE_Center);
      Ok_Btn := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
                              9,3,6,1,0,0);
      Set_DText(Dialog,Ok_Btn,' OK ',3,TE_Center);
      Center_Dialog(Dialog);
      Show_Mouse;
      Pushed := Do_Dialog(Dialog,User_Input);
      End_Dialog(Dialog);
      Hide_Mouse;
      Out_Escape(ClrScr);
      Delete_Dialog(Dialog);
      if Pushed = Quit_Btn then
        TempStr := 'Q'
      else
        Get_DEdit(Dialog,User_Input,TempStr)
    end {if}
    else begin
      writeln;
      write('Y = ');
      readln(TempStr)
    end; {else}
    Syntax_Error := FALSE;
    PostFix_Error := FALSE;
    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}
    If InFix <> 'Q' then begin { Convert infix to postfix. }
      PostFix := Convert(InFix, Syntax_Error);
      if NOT Syntax_Error then { Check for postfix error. }
        Temp := Evaluate(PostFix, 1.1, PostFix_Error, Dummy)
    end {if}
  until NOT(Syntax_Error or PostFix_Error);
  if NOT GEM_Interface then
    Out_Escape(Cursor_Off)
end; {Get}


{**********  Get Graph Parameters OK  ***********
*                                               *
*  Get the grid scale, the color of the graph,  *
*  and the desired grid drawing option.         *
*                                               *
*  Called by: MAIN DRIVER                       *
*                                               *
*  Out parameters: Grid type, X & Y scales,     *
*           color, and grid drawing option.     *
*                                               *
*  Global variables accessed: Res, Num_Color    *
************************************************}

function Get_Graph_Parameters_OK(var Grid {out}: Grid_Type;
                                  var X_Scale {out}: real;
                                  var Y_Scale {out}: real;
                                  var Color {out}: integer;
                                  var Draw {out}: Draw_Type): boolean;

var
  I: integer;             {Loop counter}
  TempStr: Str255;        {Temporary string representation}
  Temp: real;             {Temporary numeric representation}
  Syntax_Error: boolean;  {True if entry is invalid}
  Dialog: Dialog_Ptr;     {Pointer to dialog box}
  Button: array [1..15] of integer;  {Dialog box buttons}
  Pushed: integer;        {Indicates which button was selected}
  Prompt: integer;        {Pointer to prompt in dialog box}

  {--------------  Select Color  ---------------
  |                                             |
  |  Select color for graph line.               |
  |                                             |
  |  Called by: Get_Graph_Parameters_OK         |
  |                                             |
   ---------------------------------------------}

  procedure Select_Color;
    var
      I : integer;        {Loop counter}

    begin
      if GEM_Interface then begin
        Dialog := New_Dialog(16,0,0,8,18);
        Prompt := Add_DItem(Dialog,G_Text,None,1,1,6,1,0,256*Black);
        Set_DText(Dialog,Prompt,'Color?',3,TE_Center);
        for I := 1 to Num_Color do
          Button[I] := Add_DItem(Dialog,G_Box,Selectable|Exit_Btn,
                                   2,I+1,4,1,0,112+I);
        Center_Dialog(Dialog);
        Show_Mouse;
        Pushed := Do_Dialog(Dialog,0);
        End_Dialog(Dialog);
        Hide_Mouse;
        Out_Escape(ClrScr);
        Delete_Dialog(Dialog);
        for I := 1 to Num_Color do
          if Pushed = Button[I] then
            Color := I
      end {if}
      else begin
        Out_Escape(ClrScr);
        for I := 1 to Num_Color do begin
          Line_Color(I);
          writeln(I:2,' ');
          line(24, 8*I-4, 300, 8*I-4)
        end; {for}
        writeln;
        repeat
          Syntax_Error := FALSE;
          write('Graph color <',ColorStr,'>: '); readln(TempStr);
          if TempStr <> '' then begin
            for I := 1 to length(TempStr) do
              if not (TempStr[I] in ['0'..'9']) then
                Syntax_Error := TRUE;
            if not Syntax_Error then begin
              Temp := Str_to_Num(TempStr, Syntax_Error);
              if (Temp < 1) or (Temp > Num_Color) then
                Syntax_Error := TRUE
              else begin
                ColorStr := TempStr;
                Color := round(Temp)
              end {else}
            end {if}
          end {if}
        until not Syntax_Error
      end {else}
    end; {Select_Color}

  {----------------  Get Scale  ----------------
  |                                             |
  |  Get the scale for the X or Y axis.         |
  |                                             |
  |  Called by: Get_Graph_Parameters_OK         |
  |                                             |
  |  In parameter: Which axis ('X' or 'Y')      |
  |  Out parameters: The scale in both numeric  |
  |                  and string representations |
  |                                             |
  |  TempStr, Temp, and Syntax_Error are used   |
  |  as globals from calling procedure.         |
   ---------------------------------------------}

  procedure Get_Scale(Axis {in}: char;
                      var XYStr {out}: Str255;
                      var XY_Scale {out}: real);

  var
    I: integer;            {Loop counter}

  begin
    if GEM_Interface then begin
      Dialog := New_Dialog(9,0,0,11,20);
      Prompt := Add_DItem(Dialog,G_Text,None,1,1,9,1,0,256*Black);
      if Axis = 'X' then
       Set_DText(Dialog,Prompt,'X-Scale',3,TE_Center)
      else if Axis = 'Y' then
       Set_DText(Dialog,Prompt,'Y-Scale',3,TE_Center)
      else
       Set_DText(Dialog,Prompt,'R-Scale',3,TE_Center);
      for I := 1 to 8 do
        Button[I] := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
                                  3,2*I+2,5,1,0,0);
      Set_DText(Dialog, Button[1], '0.5',3,TE_Center);
      Set_DText(Dialog, Button[2], '1',3,TE_Center);
      Set_DText(Dialog, Button[3], '2',3,TE_Center);
      Set_DText(Dialog, Button[4], '5',3,TE_Center);
      Set_DText(Dialog, Button[5], '10',3,TE_Center);
      Set_DText(Dialog, Button[6], '20',3,TE_Center);
      Set_DText(Dialog, Button[7], '50',3,TE_Center);
      Set_DText(Dialog, Button[8], '100',3,TE_Center);
      Center_Dialog(Dialog);
      Show_Mouse;
      Pushed := Do_Dialog(Dialog,0);
      End_Dialog(Dialog);
      Hide_Mouse;
      Out_Escape(ClrScr);
      Delete_Dialog(Dialog);
      if Pushed = Button[1] then XY_Scale := 0.5
      else if Pushed = Button[2] then XY_Scale := 1.0
      else if Pushed = Button[3] then XY_Scale := 2.0
      else if Pushed = Button[4] then XY_Scale := 5.0
      else if Pushed = Button[5] then XY_Scale := 10.0
      else if Pushed = Button[6] then XY_Scale := 20.0
      else if Pushed = Button[7] then XY_Scale := 50.0
      else XY_Scale := 100.0
    end {if}
    else begin
      repeat
        Syntax_Error := FALSE;
        writeln;
        write(Axis,'-Scale <',XYStr,'>: ');readln(TempStr);
        if TempStr <> '' then begin
          for I:= 1 to length(TempStr) do
            if not (TempStr[I] in ['.','0'..'9']) then
              Syntax_Error := TRUE;
          if not Syntax_Error then
            Temp := Str_to_Num(TempStr, Syntax_Error);
          if not Syntax_Error then
            if Temp > 100 then begin
              writeln('Enter a value <= 100');
              Syntax_Error := TRUE
            end {if}
            else begin
              XYStr := TempStr;
              XY_Scale := Temp
            end {else}
        end {if}
      until not Syntax_Error
    end {else}
  end; {Get_Scale}

{----  Get Graph parameters starts here  ----}

begin

  {  Get Grid-type or QUIT  }

  if GEM_Interface then begin
    Dialog := New_Dialog(5,0,0,14,13);
    Prompt := Add_DItem(Dialog,G_Text,None,1,1,12,1,0,256*Black);
    Set_DText(Dialog,Prompt,'Grid?',3,TE_Center);
    for I := 1 to 4 do
      Button[I] := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
                               4,2*I+1,6,1,0,0);
    Set_DText(Dialog,Button[1],'RECT',3,TE_Center);
    Set_DText(Dialog,Button[2],'TRIG',3,TE_Center);
    Set_DText(Dialog,Button[3],'POLAR',3,TE_Center);
    Set_DText(Dialog,Button[4],'QUIT',3,TE_Center);
    Center_Dialog(Dialog);
    Show_Mouse;
    Pushed := Do_Dialog(Dialog,0);
    End_Dialog(Dialog);
    Hide_Mouse;
    Out_Escape(ClrScr);
    Delete_Dialog(Dialog);
    if Pushed = Button[1] then TempStr := 'R'
    else if Pushed = Button[2] then TempStr := 'T'
    else if Pushed = Button[3] then TempStr := 'P'
    else TempStr := 'Q'
  end {if}
  else begin
    Out_Escape(Cursor_on);
    Out_Escape(ClrScr);
    writeln('Enter');
    writeln;
    writeln('  "R" for rectangular grid');
    writeln;
    writeln('  "P" for polar grid');
    writeln;
    writeln('  "T" for trigonometric grid');
    writeln;
    writeln('  "Q" for QUIT (or get new function)');
    writeln;
    writeln;
    repeat
      write('Grid type <',GridStr,'>: '); readln(TempStr);
      if TempStr[1] in ['p','q','r','t'] then
        TempStr[1] := chr(ord(TempStr[1])-32)
    until (TempStr[1] in ['P', 'Q', 'R', 'T']) or (TempStr = '')
  end; {else}
  if TempStr = 'Q' then
    Get_Graph_Parameters_OK := FALSE
  else begin
    if TempStr <> '' then
      GridStr := TempStr;
    Get_Graph_Parameters_OK := TRUE;
    if GridStr = 'R' then
      Grid := Rectangular
    else if GridStr = 'P' then
      Grid := Polar
    else
      Grid := Trigonometric;

    {  Get grid scales  }

    if GEM_Interface then begin
      if Grid = Rectangular then begin
        Get_Scale('X', XStr, X_Scale);
        Get_Scale('Y', YStr, Y_Scale)
      end {if}
      else if Grid = Polar then
        Get_Scale('R', XStr, X_Scale)
      else begin
        X_Scale := Pi/2;
        Get_Scale('Y', YStr, Y_Scale)
      end {else}
    end {if}
    else begin
      Out_Escape(ClrScr);
      writeln('The origin is centered in the display');
      write('area.  You can adjust the ');
      if Grid = Rectangular then begin
        writeln('horizontal');
        writeln('and vertical scales by entering the');
        writeln('value corresponding to the first grid');
        writeln('line.  Integer values are recommended.');
        writeln;
        Get_Scale('X', XStr, X_Scale);
        Get_Scale('Y', YStr, Y_Scale)
      end {if}
      else if Grid = Polar then begin
        writeln('scale by');
        writeln('entering the value of the radius of');
        writeln('the first circle in the polar grid.');
        writeln('Integer values are recommended.');
        writeln;
        Get_Scale('R', XStr, X_Scale)
      end {else if}
      else begin
        writeln('vertical');
        writeln('scale by entering the value of the');
        writeln('first horizontal grid line.  Integer');
        writeln('values are recommended.');
        writeln;
        X_Scale := Pi/2;
        XStr := '1.57079633';
        Get_Scale('Y', YStr, Y_Scale)
      end {else}
    end; {else}

    {  Get Graph Color  }

    if Res = Hi then
      Color := Black
    else
      Select_Color;

    {  Get Grid drawing option  }

    if GEM_Interface then begin
      Dialog := New_Dialog(3,0,0,20,7);
      for I := 1 to 3 do
        Button[I] := Add_DItem(Dialog,G_Button,Selectable|Exit_Btn,
                                1,2*I-1,18,1,0,0);
      Set_DText(Dialog,Button[1],'Clear / New Grid',3,TE_Center);
      Set_DText(Dialog,Button[2],'Clear / No Grid',3,TE_Center);
      Set_DText(Dialog,Button[3],'Draw on old Grid',3,TE_Center);
      Center_Dialog(Dialog);
      Show_Mouse;
      Pushed := Do_Dialog(Dialog,0);
      End_Dialog(Dialog);
      Hide_Mouse;
      Out_Escape(ClrScr);
      Delete_Dialog(Dialog);
      if Pushed = Button[1] then
        Draw := Redraw
      else if Pushed = Button[2] then
        Draw := No_Grid
      else
        Draw := Old_Grid
    end {if}
    else begin
      Out_Escape(ClrScr);
      writeln('Choose one of the following:');
      writeln('  1. Clear screen / Draw new grid');
      writeln('  2. Clear screen / NO GRID');
      writeln('  3. Draw graph on previous screen');
      writeln;
      repeat
        Syntax_Error := FALSE;
        write('Which option <',DrawStr,'>: '); readln(TempStr);
      until (TempStr[1] in ['1','2','3']) or (TempStr = '');
      if TempStr <> '' then begin
        DrawStr := TempStr;
        if DrawStr = '1' then
          Draw := Redraw
        else if DrawStr = '2' then
          Draw := No_Grid
        else
          Draw := Old_Grid
      end; {if}
      Out_Escape(Cursor_Off)
    end {else}
  end {else}
end; {Get_Graph_Parameters_OK}


{*************  Number to String  ***************
*                                               *
*  Converts the number parameter to string      *
*  representation.                              *
*                                               *
*  Called by: Rect_Grid, Polar_Grid             *
*                                               *
*  In parameter: The number                     *
*  Out parameter: The corresponding string      *
************************************************}

procedure Num_to_Str(N {in}: real;
                     var NumStr {out}: Str7);

var
  Integer_Part,            {Integer part of number}
  Fraction_Part: integer;  {Fractional part of number}
  TempI,                   {Temporary integer string}
  TempF: Str7;             {Temporary fraction part string}

begin

  { Find integer and fraction parts. }

  if Abs(round(N) - N) < 0.01 then begin
    Integer_Part := round(N);
    Fraction_Part := 0
  end {if}
  else begin
    Integer_Part := trunc(N);
    Fraction_Part := round((N-Integer_Part)*100)
  end; {else}

  {  Convert integer part to string representation. }

  if Integer_Part = 0 then
    TempI := '0'
  else
    TempI := '';
  while Integer_Part <> 0 do begin
    TempI := concat(chr(ord('0') + Integer_Part MOD 10), TempI);
    Integer_Part := Integer_Part DIV 10
  end; {while}

  {  Convert fraction part to string representation. }

  TempF := '';
  if Fraction_Part <> 0 then begin
    while Fraction_Part <> 0 do begin
      TempF := concat(chr(ord('0') + Fraction_Part MOD 10), TempF);
      Fraction_Part := Fraction_Part DIV 10
    end; {while}
    TempF := concat('.', TempF)
  end; {if}

  NumStr := concat(TempI, TempF)  { Concatenate integer and fraction parts. }
end; {Num_to_Str}


{*************  Restore Screen  *****************
*                                               *
*  Restore saved screen to display area.        *
*                                               *
*  Called by: Rect_Graph, Polar_Graph           *
*                                               *
*  In parameters: Pointer to physical screen,   *
*                 Screen storage area           *
************************************************}

procedure Restore_Screen(Display {in},
                         Old_Screen {in}: Screen_Ptr);

var
  I: integer;      {Loop control}

begin
  {$P-}
  for I := 0 to 31999 do
    Display^[I] := Old_Screen^[I]
  {$P+}
end; {Restore_Screen}


{***********  Draw Rectangular Graph  ***********
*                                               *
*  Draws a graph in a rectangular coordinate    *
*  system.                                      *
*                                               *
*  Called by: MAIN DRIVER                       *
*                                               *
*  In Parameters: Function being graphed,       *
*                 Grid scales, Color of graph,  *
*                 Grid drawing option           *
*                                               *
*  Globals accessed: X_Center, Y_Center, X_Pix, *
*                    SF, Display_Area and       *
*                    Temp_Screen                *
************************************************}

procedure Rect_Graph(The_Function {in}: NodePtr;
                     X_Scale, Y_Scale {in}: real;
                     Graph_Color {in}: integer;
                     Draw {in}: Draw_Type);

var
  SX: integer;         {Loop counter and screen X-coordinate}
  SY,                  {Screen Y-coordinate}
  X, Y,                {Logical X, Y coordinates}
  XPix_per_Unit,       {Pixels per horizontal grid unit}
  YPix_per_Unit: real; {Pixels per vertical grid unit}
  Dummy,
  Undefined,           {TRUE if function is undefined for given X}
  Line_to_Flag: boolean;  {True if last logical point was plotted on screen}


  {-----------  Draw Rectangular Grid  -----------
  |                                               |
  |  Draws and labels a rectangular grid.         |
  |                                               |
  |  Called by: Rect_Graph                        |
  |                                               |
  |  In parameter: Grid scales, grid type         |
  |                                               |
  |  Global parameters accessed: Res, X_Pix,      |
  |       Y_Pix, X_Center, Y_Center, SF           |
   -----------------------------------------------}

  procedure Rect_Grid(X_Scale, Y_Scale {in}: real;
                         Grid_Option: Grid_Type);

  const
    Pi_code = 227;       {Code for Pi character}

  var
    X, Y: integer;       {Loop control}
    SX1, SX2, SY1, SY2,  {Screen coordinates}
    Tick_Unit,           {X-coordinate of first grid line to right of origin}
    Pix_per_Unit: real;  {Number of pixels in one grid unit}
    NumStr: Str7;        {String form of grid labels}

  begin
    Clear_Screen;
    if Res = Hi then
      Line_Color(Black)
    else
      Line_Color(Red);
    Pix_per_Unit := X_Center/5;

    { Vertical grid lines }

    SY1 := 0;
    SY2 := Y_Pix - 1;
    for X := -5 to 4 do begin
      SX1 := X_Center + X*Pix_per_Unit;
      Line(round(SX1),round(SY1),round(SX1),round(SY2))
    end; {for}
    SX1 := X_Pix - 1;
    Line(round(SX1),round(SY1),round(SX1),round(SY2));

    { Horizontal grid lines }

    SX1 := 0;
    SX2 := X_Pix - 1;
    for Y := -3 to 3 do begin
      SY1 := Y_Center - Y*SF*Pix_per_Unit;
      Line(round(SX1),round(SY1),round(SX2),round(SY1))
    end; {for}
    Line_Color(Black);
    Line(X_Center,0,X_Center,Y_Pix-1);
    Line(0,Y_Center,X_Pix-1,Y_Center);

    { X-axis labels }

    Draw_Mode(2);
    Tick_Unit := X_Scale;
    SY1 := Y_Center + 0.3*SF*Pix_per_Unit;
    if Grid = Rectangular then
      for X := 1 to 4 do begin
        Num_to_Str(X*Tick_Unit, NumStr);
        SX1 := X_Center + X*Pix_per_Unit - 8*Length(NumStr)/2;
        Draw_String(round(SX1),round(SY1),NumStr);
        SX1 := X_Center - X*Pix_per_Unit - 8*(Length(NumStr)+1)/2;
        NumStr := concat('-',NumStr);
        Draw_String(round(SX1),round(SY1),NumStr)
      end {for}
    else begin  {  Trigonometric X-axis labels  }
      NumStr:= chr(Pi_code);
      SX1 := X_Center + 2*Pix_per_Unit - 4;
      Draw_String(round(SX1),round(SY1),NumStr);
      SX1 := X_Center - 2*Pix_per_Unit - 8;
      NumStr := concat('-', NumStr);
      Draw_String(round(SX1),round(SY1), NumStr);
      delete(NumStr,1,1);
      NumStr := concat('2',NumStr);
      SX1 := X_Center + 4*Pix_per_Unit - 8;
      Draw_String(round(SX1),round(SY1),NumStr);
      SX1 := X_Center - 4*Pix_per_Unit - 16;
      NumStr := concat('-', NumStr);
      Draw_String(round(SX1),round(SY1), NumStr);
      delete(NumStr,1,2);
      NumStr := concat(NumStr, '/2');
      SX1 := X_Center + Pix_per_Unit - 12;
      Draw_String(round(SX1),round(SY1),NumStr);
      SX1 := X_Center - Pix_per_Unit - 16;
      NumStr := concat('-', NumStr);
      Draw_String(round(SX1),round(SY1), NumStr);
      delete(NumStr,1,1);
      NumStr := concat('3',NumStr);
      SX1 := X_Center + 3*Pix_per_Unit - 16;
      Draw_String(round(SX1),round(SY1),NumStr);
      SX1 := X_Center - 3*Pix_per_Unit - 20;
      NumStr := concat('-', NumStr);
      Draw_String(round(SX1),round(SY1), NumStr)
    end; {else}

    { Y-Axis labels }

    Tick_Unit := Y_Scale;
    SX1 := X_Center + 8;
    for Y := 1 to 3 do begin
      Num_to_Str(Y*Tick_Unit, NumStr);
      SY1 := Y_Center - Y*SF*Pix_per_Unit + 4*(Y_Pix DIV 200);
      Draw_String(round(SX1),round(SY1),NumStr);
      SY1 := Y_Center + Y*SF*Pix_per_Unit + 4*(Y_Pix DIV 200);
      NumStr := concat('-',NumStr);
      Draw_String(round(SX1),round(SY1),NumStr)
    end; {for}
    Draw_Mode(1)
  end; {Draw_RGrid}

{-----  Rect_Graph begins here  -----}

begin
  if Draw = ReDraw then
    Rect_Grid(X_Scale, Y_Scale, Grid)
  else if Draw = Old_Grid then
    Restore_Screen(Display_Area, Temp_Screen)
  else
    Clear_Screen;
  Line_Color(Graph_Color);
  XPix_per_Unit := (X_Center/5)/X_Scale;
  YPix_per_Unit := SF*(X_Center/5)/Y_Scale;
  Line_to_Flag := FALSE;
  for SX := 0 to X_Pix - 1 do begin
    X := (SX - X_Center)/XPix_per_Unit;
    Y := Evaluate(The_Function, X, Dummy, Undefined);
    if NOT Undefined then begin
      SY := Y_Center - Y*YPix_per_Unit;
      if Abs(SY) < 32000 then  { it's safe to use round function }
        if Line_to_Flag then
          Line_to(SX, round(SY))
        else begin
          Plot(SX, round(SY));
          Line_to_Flag := TRUE
        end {else}
      else
        Line_to_Flag := FALSE
    end {if}
    else
      Line_to_Flag := FALSE
  end {for}
end; {Draw_RGraph}


{*************  Draw Polar Graph  ***************
*                                               *
*  Draws a graph using a polar coordinate       *
*  system.                                      *
*                                               *
*  Called by: MAIN DRIVER                       *
*                                               *
*  In parameters: Function being graphed,       *
*                 Grid scale, Color of graph,   *
*                 Grid drawing option           *
*                                               *
*  Globals accessed: X_Center, Y_Center, X_Pix, *
*                    SF, Display_Area and       *
*                    Temp_Screen                *
************************************************}

procedure Polar_Graph(The_Function {in}: NodePtr;
                      X_Scale {in}: real;
                      Graph_Color {in}: integer;
                      Draw {in}: Draw_Type);

var
  SX, SY,                {Screen coordinates}
  Angle,                 {Angle in radians}
  Radius,                {Radius for given angle}
  XPix_per_Unit,         {Pixels per horizontal grid unit}
  YPix_per_Unit: real;   {Pixels per vertical grid unit}
  A: integer;            {Loop counter}
  Dummy_flag,
  Undefined,             {TRUE if function is undefined for given angle}
  Line_to_Flag: boolean; {TRUE if last logical point was plotted}
  Dummy:char;


  {--------------  Draw Polar Grid  --------------
  |                                               |
  |  Draws and labels a Polar coordinate grid.    |
  |                                               |
  |  Called by: Polar_Graph                       |
  |                                               |
  |  In_Parameter: Grid scale                     |
  |                                               |
  |  Global variables accessed: Res, X_Pix,       |
  |       Y_Pix, X_Center, Y_Center, SF           |
   -----------------------------------------------}

  procedure Polar_Grid(X_Scale {in}: real);

  var
    Pix_per_Unit: real;
    R: integer;
    A: integer;
    Rad: real;
    SX1, SY1, SX2, SY2: real;
    Temp: real;
    X,Y: real;
    NumStr: Str7;

  begin
    Clear_Screen;
    if Res = Hi then
      Line_Color(Black)
    else
      Line_Color(Red);

    { Draw the concentric circles. }

    Pix_per_Unit := X_Center/5;
    for R := 1 to 4 do begin
      Plot(X_Center+round(Pix_per_Unit*R), Y_Center);
      for A := 1 to 72 do begin
        Rad := A*Pi/36;
        Temp := R*Cos(Rad)*Pix_per_Unit;
        SX1 := X_Center + Temp;
        Temp := R*Sin(Rad)*SF*Pix_per_Unit;
        SY1 := Y_Center - Temp;
        Line_to(round(SX1), round(SY1))
      end {for}
    end; {for}

    { Draw radiating lines.  Lines at 0, 30, 60,... degrees go through the
      origin.  The rest start at the second circle.  Otherwise the middle
      of the grid gets too cluttered. }

    for A := 0 to 35 do begin
      Rad := A*Pi/36;
      X := 4*Cos(Rad)*Pix_per_Unit;
      Y := 4*Sin(Rad)*SF*Pix_per_Unit;
      if A MOD 3 = 0 then begin
        SX1 := X_Center + X;
        SY1 := Y_Center - Y;
        SX2 := X_Center - X;
        SY2 := Y_Center + Y;
        Line(round(SX1), round(SY1), round(SX2), round(SY2))
      end {if}
      else begin
        SX1 := X_Center + X;
        SY1 := Y_Center - Y;
        SX2 := X_Center + X/2;
        SY2 := Y_Center - Y/2;
        Line(round(SX1), round(SY1), round(SX2), round(SY2));
        SX1 := X_Center - X;
        SY1 := Y_Center + Y;
        SX2 := X_Center - X/2;
        SY2 := Y_Center + Y/2;
        Line(round(SX1), round(SY1), round(SX2), round(SY2))
      end {else}
    end; {for}

    { Draw X-axis labels. }

    Draw_Mode(2);
    SY1 := Y_Center + 0.3*SF*Pix_per_Unit;
    for R := 1 to 4 do begin
      Num_to_Str(R*X_Scale, NumStr);
      SX1 := X_Center + R*Pix_per_Unit-8*Length(NumStr)/2;
      Draw_String(round(SX1), round(SY1), NumStr)
    end; {for}

    { Draw the angle labels. }

    for A := 1 to 23 do begin
      Rad := A*Pi/12;
      if (A<6) or (A>18) then
        SX1 := X_Center + 4.1*Cos(Rad)*Pix_per_Unit
      else
        SX1 := X_Center + 4.1*Cos(Rad)*Pix_per_Unit - 24;
      Temp := Y_Pix DIV 200;
      SY1 := Y_Center - 4*Sin(Rad)*(SF*Pix_per_Unit + Temp) + 4*Temp;
      Num_to_Str(15*A, NumStr);
      Draw_String(round(SX1), round(SY1), NumStr)
    end; {for}
    Draw_Mode(1)
  end; {Draw_PGrid}

{-----  Polar_Graph begins here  -----}

begin
  if Draw = ReDraw then
    Polar_Grid(X_Scale)
  else if Draw = Old_Grid then
    Restore_Screen(Display_Area, Temp_Screen)
  else
    Clear_Screen;
  Line_Color(Graph_Color);
  XPix_per_Unit := (X_Center/5)/X_Scale;
  YPix_per_Unit := SF*XPix_per_Unit;
  Line_to_Flag := FALSE;
  A := 0;

  { Since polar graphs don't have a fixed 'stopping' place, the program
    will continue plotting until the user presses a key.  The screen
    display will remain until the user presses another key. }

  repeat
    Angle := A*Pi/180;
    Radius := Evaluate(The_Function, Angle, Dummy_flag, Undefined);
    if NOT Undefined then begin
      SX := X_Center + Radius*Cos(Angle)*XPix_per_Unit;
      SY := Y_Center - Radius*Sin(Angle)*YPix_Per_Unit;
      if Abs(SY) < 32000 then
        if Line_to_Flag then
          Line_to(round(SX), round(SY))
        else begin
          Plot(round(SX), round(SY));
          Line_to_Flag := TRUE
        end {else}
      else
        Line_to_Flag := FALSE
    end {if}
    else
      Line_to_Flag := FALSE;
    A := A + 1;
    if A > 32000 then begin
      A := 0;
      Line_to_Flag := FALSE
    end {if}
  until keypress;
  read(Dummy)
end; {Draw_PGraph}


{***************  Save Screen  ******************
*                                               *
*  Save screen display.                         *
*                                               *
*  Called by: MAIN DRIVER                       *
*                                               *
*  In parameter: Pointer to physical screen     *
*  Out parameter: Screen storage area           *
************************************************}

procedure Save_Screen(Display {in}: Screen_Ptr;
                      var Temp_Screen {out}: Screen_Ptr);

var
  I: integer;   {Loop control}

begin
  {$P-}
  for I := 0 to 31999 do
    Temp_Screen^[I] := Display^[I]
  {$P+}
end; {Save_Screen}


{-----------------------------------------
          M A I N   D R I V E R
-----------------------------------------}

begin
  if Init_Gem >= 0 then begin
    Hide_Mouse;
    Initialization;
    Get_Expression(Infix, PostFix);
    while InFix <> 'Q' do begin

      { Get the parameter values desired by the user. }

      while Get_Graph_Parameters_OK(Grid,X_Scale,Y_Scale,Color,Draw) do begin
        if (Grid = Rectangular) or (Grid = Trigonometric) then
          Rect_Graph(PostFix,X_Scale,Y_Scale,Color,Draw)
        else
          Polar_Graph(PostFix,X_Scale,Color,Draw);

        { Freeze display until user presses a key. }

        repeat
          Event := Get_Event(E_Button|E_Keyboard,1,1,1,0,FALSE,0,0,0,0,
                             FALSE,0,0,0,0,DummyMsg,D,D,D,D,D,D);
        until (Event = E_Button) or (Event = E_Keyboard);

        { Save the screen display. }

        Save_Screen(Display_Area, Temp_Screen)
      end; {while}

      { Return postfix storage to the available memory heap. }

      while PostFix <> NIL do begin
        TempPtr := PostFix;
        PostFix := PostFix^.Link;
        dispose(TempPtr)
      end; {while}

      { Get ready to do it again. }

      Get_Expression(Infix, PostFix)
    end; {while}
    Show_Mouse;
    Exit_Gem
  end {if}
end.