{ ************************GRCALC************************ }

{
  Copyright (C) 2002 Marcello Barnaba <vjt@openssl.it>,
  licenziato secondo i termini della GNU GPL versione 2
  (www.gnu.org/gpl.html) o, ad opzione dell`utente,
  qualsiasi versione successiva.

  programma per visualizzare una semplice funzione matematica
  a schermo, ispirato dalla `Calcolatrice Grafica' del MacOS
  e da GNUplot (http://www.gnu.org/software/gnuplot).
}

program graphic_calc;

{ direttive per il coprocessore matematico. }
{IFDEF CPU87}
{$N+;$E-}
{ELSE}
{$N-;$E+}
{ENDIF}

{ disabilita l`inserimento nell`eseguibile dei simboli di debug. }
{$D-}

{ crt per clrscr, graph per la totalita` delle funzioni grafiche }
uses crt, graph;

{ linka i driver video nell`eseguibile, in modo da non essere
  costretti a distribuire il .BGI assieme al .EXE. }
procedure EGAVGADriver; external;
procedure CGADriver; external;
procedure HERCDriver; external;
{$L egavga.obj}
{$L cga.obj}
{$L herc.obj}

{ dichiarazioni forward per le funzioni da inserire nelle tabelle
  const. }
{$F+}
function calc_add(x, y : real) : real; forward;
function calc_sub(x, y : real) : real; forward;
function calc_mul(x, y : real) : real; forward;
function calc_div(x, y : real) : real; forward;
function calc_sin(x : real) : real; forward;
function calc_cos(x : real) : real; forward;
function calc_tan(x : real) : real; forward;
function calc_cotan(x : real) : real; forward;
function calc_asin(x : real) : real; forward;
function calc_acos(x : real) : real; forward;
function calc_atan(x : real) : real; forward;
function calc_ln(x : real) : real; forward;
function calc_exp(x : real) : real; forward;
function calc_sqrt(x : real) : real; forward;
{$F-}

type

	calc_func_t = string; { tipo della stringa che contiene la funzione inserita dall`utente }
	calc_error_t = shortint; { tipo del codice di errore gestito dalla calc_perror() }
	calc_term_type_t = shortint; { tipo del codice che identifica un tipo di termine all`interno della struttura 'calc_term_t' }
	calc_term_value_t = real; { tipo del valore di un termine }

	{ tipo puntatore a funzione per le funzioni matematiche }
	calc_func_handler_t = function(x : real) : real;
	{ tipo puntatore a funzione per gli operatori }
	calc_oper_handler_t = function(x, y : real) : real;

	calc_term_t_p = ^calc_term_t; { puntatore ad una struttura calc_term,
									per la creazione della lista collegata }
	calc_term_t = record { struttura termine, pesante in termini di memoria,
						   poiche` contiene tutti i possibili elementi che
						   possono identificare un termine: sia il valore,
						   che un operatore non possiede, sia due puntatori
						   a funzione, per le funzioni e gli operatori, ed
						   un puntatore alla struttura successiva.
						   alternativamente sarebbe stato possibile
						   utilizzare un oggetto base e poi utilizzare
						   l`incapsulamento e l`ereditarieta` per creare
						   strutture polimorfiche, ma a mio parere il
						   programma sarebbe diventato troppo complesso
						   e pesante. }
		term_type : calc_term_type_t; { codice tipo del termine }
		term_value : calc_term_value_t; { valore del termine, nel
										  caso in cui questo termine sia un numero }
		term_func_handler : calc_func_handler_t; { puntatore a funzione per
												   funzione matematica }
		term_oper_handler : calc_oper_handler_t; { puntatore a funzione per
												   operatore }
		term_next : calc_term_t_p;               { elemento successivo, nil
												   in caso di ultimo elem. }
	end;

	calc_parse_state_t = shortint; { tipo dello stato interno del parser }

const

	{ versione. }
	CALC_VERSION = '1.0';

	{ costanti per la gestione degli errori. }
	CALC_NO_ERROR = 1;
	CALC_ERROR_INITGRAPH = 2;
	CALC_ERROR_BADFUNC = 3;
	CALC_ERROR_BADINTEGER = 4;
	CALC_ERROR_FUNCTIONNOTDEFINED = 5;

	CALC_ERRORS = 5; { numero errori. }

	calc_errlist : array[1..CALC_ERRORS] of string = (
		'Nessun errore.',
		'Non sono riuscito ad inizializzare la modalita` grafica.',
		'Errore di sintassi nella funzione.',
		'Intero non valido.',
		'Funzione non definita in questo punto.'
	);

	{ tipi di termini. }
	CALC_TERM_TYPE_NUMBER = 1;
	CALC_TERM_TYPE_FUNCTION = 2;
	CALC_TERM_TYPE_OPERATOR = 3;
	CALC_TERM_TYPE_VARIABLE = 4;
	CALC_TERM_TYPE_BRACKETOPEN = 5;
	CALC_TERM_TYPE_BRACKETCLOSE = 6;

	{ costanti per gli operatori. }
	CALC_TERM_TYPE_OPERATOR_ADD = 1;
	CALC_TERM_TYPE_OPERATOR_SUB = 2;
	CALC_TERM_TYPE_OPERATOR_MUL = 3;
	CALC_TERM_TYPE_OPERATOR_DIV = 4;

	{ costanti che descrivono il numero di funzioni e operatori supportati. }
	CALC_FUNX = 10;
	CALC_OPS = 4;

	{ stati del parser. }
	CALC_PARSE_IDLE = 1;			{ inizio della stringa. }
	CALC_PARSE_READNUMBER = 2;		{ il parser sta leggendo un numero. }
	CALC_PARSE_READFUNCTION = 3;	{ il parser sta leggendo una funzione (sin, cos, ..) }
	CALC_PARSE_READOPERATOR = 4;	{ il parser sta leggendo un operatore (*, /, ..) }
	CALC_PARSE_READVARIABLE = 5;	{ il parser sta leggendo 'x' }
	CALC_PARSE_BRACKETOPEN = 6;		{ il parser sta leggendo '(' }
	CALC_PARSE_BRACKETCLOSE = 7;    { il parser sta leggendo ')' }

	{ settaggi grafici. }
	CALC_GRAPH_BAR_SHIFT = 4;		{ dimensione della barra relativa al font corrente. }
	CALC_GRAPH_DEFAULT_ZOOM = 50;	{ fattore di zoom di default. }
	CALC_GRAPH_LINE_COLOR = yellow;	{ colore della curva. }
	CALC_GRAPH_DELAY = 100;          { tempo di inattivita` tra il disegno di un pixel ed un altro. }
	CALC_GRAPH_CARTHESIO_TICK_HALF_LENGTH = 3; { meta` della dimensione di una stanghetta del piano cartesiano. }
	CALC_GRAPH_PROGRESSBAR_COLOR_DEFINED = blue; { colore della barra inferiore quando la funz. e` definita. }
	CALC_GRAPH_PROGRESSBAR_COLOR_NOTDEFINED = lightgray; { colore della barra inferiore quando la funz. non e` definita. }
	CALC_GRAPH_PROGRESSBAR_COLOR_OOB = red; { colore della barra inferiore
											  quando la funz. e` definita ma va oltre i limiti dello schermo. }
	CALC_GRAPH_PROGRESSBAR_WIDTH = 8; { spessore della barra inferiore. }

	{ costanti per calc_setgraph() }
	CALC_INIT = 0; { inizializza la mod. grafica. }
	CALC_CRT = 1;  { ripristina la mod. terminale. }
	CALC_GRAPH = 2;{ ripristina la mod. grafica. }
	CALC_CLOSE = 3;{ chiudi la mod. grafica. }

	{ tabella degli operatori }
	calc_oper_table : array [1..CALC_OPS] of calc_oper_handler_t =
		(calc_add, calc_sub, calc_mul, calc_div);

	{ tabella delle funzioni }
	calc_func_table : array [1..CALC_FUNX] of record { tipo della tabella delle funzioni supportate }
		func_name : string[5]; { nome della funzione }
		func_handler : calc_func_handler_t; { puntatore alla funzione gestore }
	end = (
		(func_name : 'sin'; func_handler : calc_sin),
		(func_name : 'cos'; func_handler : calc_cos),
		(func_name : 'tan'; func_handler : calc_tan),
		(func_name : 'asin'; func_handler : calc_asin),
		(func_name : 'acos'; func_handler : calc_acos),
		(func_name : 'atan'; func_handler : calc_atan),
		(func_name : 'ln'; func_handler : calc_ln),
		(func_name : 'e'; func_handler : calc_exp),
		(func_name : 'cotan'; func_handler : calc_cotan),
		(func_name : 'sqrt'; func_handler : calc_sqrt)
	);

var
	calc_func : calc_func_t; { stringa che contiene la funzione come scritta dall`utente. }
	calc_term : calc_term_t_p; { testa della lista collegata di termini. }
	calc_errno : calc_error_t; { codice errore attuale. }
	calc_zoom : integer; { valore di zoom nella visualizzazione corrente. }
	maxx, maxy : word; { x ed y massimi nella visualizzazione corrente. }

{ permetti le chiamate FAR per queste funzioni, in modo
  che possano essere chiamate tramite puntatori a funzione }
{$F+}

{ funzioni per il calcolo del valore delle operazioni base. }
function calc_add(x, y : real) : real;
begin calc_add := x + y; end;
function calc_sub(x, y : real) : real;
begin calc_sub := x - y; end;
function calc_mul(x, y : real) : real;
begin calc_mul := x * y; end;
function calc_div(x, y : real) : real;
begin
	calc_errno := CALC_ERROR_FUNCTIONNOTDEFINED;
	calc_div := 0;
	if y <> 0 then begin
		calc_div := x / y;
		calc_errno := CALC_NO_ERROR;
	end;
end;

{ funzioni per il calcolo del valore delle funz. matematiche. }
function calc_tan(x : real) : real;
begin calc_tan := sin(x) / cos(x); end;

function calc_cotan(x : real) : real;
var y : real;
begin
	calc_cotan := 0;
	y := sin(x);
	if y <> 0 then
		calc_cotan := cos(x) / y
	else
		calc_errno := CALC_ERROR_FUNCTIONNOTDEFINED;
end;

{ operazione di asin trovata sulla FAQ del newsgroup comp.lang.pascal }
function calc_asin(x : real) : real;
var _sqr, _sqrt : real;
begin
	_sqr := (1 - sqr(x));
	calc_errno := CALC_ERROR_FUNCTIONNOTDEFINED;
	calc_asin := 0;

	if _sqr > 0 then begin
		_sqrt := sqrt(_sqr);
		if _sqrt <> 0 then begin
			calc_asin := arctan( x / _sqrt );
			calc_errno := CALC_NO_ERROR;
		end;
	end;
end;

{ operazione di asin trovata sulla FAQ del newsgroup comp.lang.pascal }
function calc_acos(x : real) : real;
var _sqr : real;
begin
	calc_errno := CALC_ERROR_FUNCTIONNOTDEFINED;
	calc_acos := 0;

	if x <> 0 then begin
		_sqr := (1 - sqr(x));
		if _sqr > 0 then begin
			calc_acos := arctan(sqrt(_sqr) / x);
			calc_errno := CALC_NO_ERROR;
		end;
	end;
end;

function calc_sin(x : real) : real;
begin calc_sin := sin(x); end;

function calc_cos(x : real) : real;
begin calc_cos := cos(x); end;

function calc_atan(x : real) : real;
begin calc_atan := arctan(x); end;

function calc_exp(x : real) : real;
begin calc_exp := exp(x); end;

function calc_ln(x : real) : real;
begin
	calc_ln := 0;
	if x > 0 then
		calc_ln := ln(x)
	else
		calc_errno := CALC_ERROR_FUNCTIONNOTDEFINED;
end;

function calc_sqrt(x : real) : real;
begin
	calc_sqrt := 0;
	if x > 0 then
		calc_sqrt := sqrt(x)
	else
		calc_errno := CALC_ERROR_FUNCTIONNOTDEFINED;
end;
{$F-}

{ procedura che stampa a schermo la descrizione
  di un errore identificato da un codice, ispirata
  alla perror(3) C ISO. ho scelto di passare l`errno
  come parametro poiche` non ci sono moltissimi errori
  da gestire in questo programma. }
procedure calc_perror(err : calc_error_t);
begin
	writeln('Errore: ', calc_errlist[err]);
end;

{ procedura per il rilascio della memoria occupata
  dalla lista dei termini della funzione. }
procedure cleanup;
var p, q : calc_term_t_p;
begin
	p := calc_term;
	while p^.term_next <> nil do begin
		q := p^.term_next;
		dispose(p);
		p := q;
	end;
	writeln;
end;

function calc_parse_func(f : calc_func_t) : boolean;
var i : shortint; { contatore principale }
var done : boolean; { abbiamo terminato il parsing ? }
var p : calc_term_t_p; { puntatore temporaneo per allocare gli elementi della lista }
var state : calc_parse_state_t; { stato interno del parser }
var token_buf : string; { buffer temporaneo per conservare
						  pezzi di stringa (come 'sin', 'cos')
						  per poi processarli in seguito con la func2id() }
var wasspace : boolean; { bool di utilita` che indica se il precedente char
						  era uno spazio (utile nel parsing di, ad es.
						  sin cos tan x }
var ret : boolean;

	{ setta il fallimento del parsing e conseguente ritorno false
	  della procedura genitore }
	procedure fail;
	begin
		done := true;
		ret := false;
	end;

	{ prende in input un nome di funzione matematica (sin, cos, tan . .)
	  e ritorna un ID da inserire in una struttura calc_term_t }
	function func2id(s : string) : shortint;
	var i : shortint;
	begin
		func2id := 0;
		for i := 1 to CALC_FUNX do begin
			if s = calc_func_table[i].func_name then begin
				func2id := i;
				exit;
			end;
		end;

	end;

	{ cambia lo stato interno del parser, effettuando gli
	  opportuni controlli di sintassi e salvando i dati
	  dello stato precedente nella struttura correntemente
	  puntata da p, e alloca il successore di p facendolo
	  puntare nella p corrente a term_next }
	procedure changestate(newstate : calc_parse_state_t);

		{ alloca un nuovo elemento della lista, e aggiorna
		  il valore corrente di p a questo nuovo elemento }
		procedure new_p;
		begin
			new(p^.term_next);
			p := p^.term_next;
			p^.term_next := nil;
		end;

	var good_syntax : boolean;
	var id : shortint;
	var val_code : integer; { valore di ritorno della val() }
	begin
		{ controllo sintassi. }
		good_syntax := false;
		case newstate of
			CALC_PARSE_READNUMBER : good_syntax :=
							(state = CALC_PARSE_READFUNCTION) or
							(state = CALC_PARSE_READOPERATOR) or
							(state = CALC_PARSE_BRACKETOPEN) or
							(state = CALC_PARSE_IDLE);
			CALC_PARSE_READOPERATOR : good_syntax :=
							(state = CALC_PARSE_READNUMBER) or
							(state = CALC_PARSE_BRACKETCLOSE) or
							(state = CALC_PARSE_READVARIABLE);
			CALC_PARSE_READFUNCTION : good_syntax :=
							(state = CALC_PARSE_IDLE) or
							(state = CALC_PARSE_READOPERATOR) or
							(state = CALC_PARSE_READFUNCTION) or
							(state = CALC_PARSE_BRACKETOPEN);
			CALC_PARSE_READVARIABLE : good_syntax :=
							(state = CALC_PARSE_IDLE) or
							(state = CALC_PARSE_READOPERATOR) or
							(state = CALC_PARSE_READFUNCTION) or
							(state = CALC_PARSE_BRACKETOPEN);
			CALC_PARSE_BRACKETOPEN : good_syntax :=
							(state = CALC_PARSE_IDLE) or
							(state = CALC_PARSE_READFUNCTION) or
							(state = CALC_PARSE_READOPERATOR) or
							(state = CALC_PARSE_BRACKETOPEN);
			CALC_PARSE_BRACKETCLOSE : good_syntax :=
							(state = CALC_PARSE_READNUMBER) or
							(state = CALC_PARSE_READVARIABLE) or
							(state = CALC_PARSE_BRACKETCLOSE);
			CALC_PARSE_IDLE : begin
								good_syntax :=
									 (state = CALC_PARSE_READVARIABLE) or
									 (state = CALC_PARSE_BRACKETCLOSE) or
									 (state = CALC_PARSE_READNUMBER);
								done := true;
							end;
		end;

		{ salvataggio termine corrente }
		if good_syntax then begin
			case state of
				CALC_PARSE_READNUMBER : begin
					new_p;
					p^.term_type := CALC_TERM_TYPE_NUMBER;
					val(token_buf, p^.term_value, val_code);
					if val_code = 0 then begin
						p^.term_func_handler := nil;
						p^.term_oper_handler := nil;
						token_buf := '';
						state := newstate;
					end
					else
						fail;
				end;
				CALC_PARSE_READFUNCTION : begin
					id := func2id(token_buf);
					if id <> 0 then begin

						new_p;

						p^.term_type := CALC_TERM_TYPE_FUNCTION;
						p^.term_value := 0;
						p^.term_oper_handler := nil;
						p^.term_func_handler :=
							calc_func_table[id].func_handler;

						token_buf := '';
						state := newstate;
					end
					else
						fail;
				end;
				CALC_PARSE_READOPERATOR : begin
					new_p;
					p^.term_type := CALC_TERM_TYPE_OPERATOR;
					p^.term_value := 0;
					p^.term_func_handler := nil;
					case token_buf[1] of
						'*' : p^.term_oper_handler :=
							 calc_oper_table[CALC_TERM_TYPE_OPERATOR_MUL];
						'+' : p^.term_oper_handler :=
							 calc_oper_table[CALC_TERM_TYPE_OPERATOR_ADD];
						'/' : p^.term_oper_handler :=
							 calc_oper_table[CALC_TERM_TYPE_OPERATOR_DIV];
						'-' : p^.term_oper_handler :=
							 calc_oper_table[CALC_TERM_TYPE_OPERATOR_SUB];
					end;
					token_buf := '';
					state := newstate;
				end;

				CALC_PARSE_READVARIABLE : begin
					new_p;
					p^.term_type := CALC_TERM_TYPE_VARIABLE;
					p^.term_value := 0;
					p^.term_oper_handler := nil;
					p^.term_func_handler := nil;
					state := newstate;
				end;
				CALC_PARSE_BRACKETOPEN : begin
					new_p;
					p^.term_type := CALC_TERM_TYPE_BRACKETOPEN;
					p^.term_value := 0;
					p^.term_oper_handler := nil;
					p^.term_func_handler := nil;
					state := newstate;
				end;
				CALC_PARSE_BRACKETCLOSE : begin
					new_p;
					p^.term_type := CALC_TERM_TYPE_BRACKETCLOSE;
					p^.term_value := 0;
					p^.term_oper_handler := nil;
					p^.term_func_handler := nil;
					state := newstate;
				end;
				CALC_PARSE_IDLE : state := newstate;
			end; { fine salvataggio termine corrente }

		end { fine controllo sintassi }
		else
			fail;
	end;

	{ verifica che le parentesi siano bilanciate }
	function check_brackets : boolean;
	var len : shortint;
	var i : shortint;
	var j : shortint;
	begin
		len := length(f);
		j := 0;
		check_brackets := false;

		for i := 1 to len do begin
			if f[i] = '(' then
				inc(j)
			else if f[i] = ')' then
				dec(j);
		end;

		if j = 0 then
			check_brackets := true;
	end;
	{ fine sottoprocedure }
begin

	{ metti a \0 il char successivo alla lunghezza della stringa. }
	f[length(f) + 1] := #0;

	{ inizializza lo stato interno del parser. }
	state := CALC_PARSE_IDLE;

	{ inizializza il contatore principale e
	  il buffer che conterra` pezzi della stringa
	  in input per processarli in seguito. }
	i := 0;
	token_buf := '';

	{ inizializza i puntatori e la lista collegata,
	  creando la testa che poi andra` tagliata.
	  questo per alleggerire l`algoritmo di aggiungimento
	  di elementi alla lista. se non venisse allocata una testa
	  subito, poiche` c`e` l`esigenza di conservare l`indirizzo
	  del primo elemento della lista per poi processarla in seguito
	  e scorrerla, quando verra` visualizzata la funzione, bisognerebbe
	  inserire una struttura di selezione binaria (if) nel ciclo
	  della procedura changestate, in modo che se la testa della lista
	  non e` ancora definita (e` nil), l`elemento che viene allocato
	  diventa la testa. allocando prima una testa fittizia, abbiamo la
	  certezza che durante il parsing il primo elemento e` gia` allocato,
	  risparmiando il controllo, e dovremo solo aggiungere nuovi elementi
	  alla lista. alla fine del parsing, se la sintassi e` corretta viene
	  tagliata la testa e calc_term viene fatto puntare al secondo elemento
	  della lista, che diventa il primo e la lista e` allocata
	  correttamente. }
	new(p);
	calc_term := p; { testa. }
	p^.term_next := nil;

	{ presumi che la funzione abbia sintassi corretta. }
	ret := true;

	{ inizia ad iterare. }
	wasspace := false;
	done := false;
	while not done do begin
		inc(i);
		case upcase(f[i]) of

			'X' : changestate(CALC_PARSE_READVARIABLE);

			'0'..'9' :
				begin
					if state <> CALC_PARSE_READNUMBER then
						changestate(CALC_PARSE_READNUMBER);
					token_buf := token_buf + f[i];
				end;

			'*', '+',
			'/', '-':
				begin
					changestate(CALC_PARSE_READOPERATOR);
					token_buf := token_buf + f[i];
				end;

			'A'..'Z' :
				begin
					if (state <> CALC_PARSE_READFUNCTION) or
						((state = CALC_PARSE_READFUNCTION) and wasspace) then begin
						changestate(CALC_PARSE_READFUNCTION);
						wasspace := false;
					end;
					token_buf := token_buf + f[i];
				end;
			'(' : changestate(CALC_PARSE_BRACKETOPEN);
			')' : changestate(CALC_PARSE_BRACKETCLOSE);

			' ' : wasspace := true;

			#0 : changestate(CALC_PARSE_IDLE);

			else
				fail;
		end;
	end;

	{ taglia via la testa della lista. }
	p := calc_term^.term_next;
	dispose(calc_term);
	calc_term := p;

	{ verifica che le parentesi siano bilanciate. }
	if ret then
		ret := check_brackets;

	if not ret then begin
		calc_errno := CALC_ERROR_BADFUNC;
                cleanup;
        end;

	calc_parse_func := ret;
end;

{ converti un intero in una stringa. }
function int2str(i : integer) : string;
var buf : string;
begin
	str(i, buf);
	int2str := buf;
end;

{ cuore del disegno del grafico: procedura che
  a seconda del valore x che gli viene passato,
  ritorna il valore corrispondente della y,
  scorrendo la lista dei termini ed effettuando
  le operazioni necessarie }

function get_y_value(x : real; var p : calc_term_t_p) : real;
var current_value : calc_term_value_t;
var current_oper : calc_oper_handler_t;
var currently_operating : boolean;

{ funzione ricorsiva per evalutare il valore di
  una singola o di una serie di funzioni (es. sin cos tan x)
  matematiche, partendo dall`elemento che gli viene passato
  tramite puntatore al termine corrente. }

function evaluate_func : calc_term_value_t;
var current_func : calc_func_handler_t;
var ret : calc_term_value_t;
begin

	current_func := p^.term_func_handler;
	p := p^.term_next;
	case p^.term_type of
		CALC_TERM_TYPE_FUNCTION :
			ret := current_func(evaluate_func);

		CALC_TERM_TYPE_VARIABLE :
			ret := current_func(x);

		CALC_TERM_TYPE_NUMBER :
			ret := current_func(p^.term_next^.term_value);

		CALC_TERM_TYPE_BRACKETOPEN :
			begin
				p := p^.term_next;
				ret := current_func(get_y_value(x, p));
			end;
	end;
	evaluate_func := ret;
end;

begin
	current_value := 0;
	current_oper := nil;
	currently_operating := false;
	while p <> nil do begin
		case p^.term_type of
			CALC_TERM_TYPE_NUMBER:
				begin
					if currently_operating then begin
						current_value := current_oper(current_value,
							p^.term_value);
						currently_operating := false;
					end
					else
						current_value := p^.term_value;
				end;
			CALC_TERM_TYPE_OPERATOR:
				begin
					current_oper := p^.term_oper_handler;
					currently_operating := true;
				end;
			CALC_TERM_TYPE_FUNCTION:
				begin
					if currently_operating then begin
						current_value := current_oper(current_value,
							evaluate_func);
						currently_operating := false;
					end
					else
						current_value := evaluate_func;
				end;
			CALC_TERM_TYPE_VARIABLE:
				begin
					if currently_operating then begin
						current_value := current_oper(current_value, x);
						currently_operating := false;
					end
					else
						current_value := x;
				end;
			CALC_TERM_TYPE_BRACKETOPEN:
				begin
					p := p^.term_next;
					if currently_operating then begin
						current_value := current_oper(current_value,
							get_y_value(x, p));
						currently_operating := false;
					end
					else
						current_value := get_y_value(x, p);
				end;
			CALC_TERM_TYPE_BRACKETCLOSE:
				begin
					get_y_value := current_value;
					exit;
				end;

		end;
		if p <> nil then
			p := p^.term_next;
	end;
	get_y_value := current_value;
end;

{ procedura per il disegno del grafico e
  zoom di esso }

procedure draw_graph;
var x, y : integer;
var vp : viewporttype;
var relmaxx, relmaxy : word;
var barcolor : shortint;
var p : calc_term_t_p;
begin
	getviewsettings(vp);
	with vp do begin
		relmaxx := (x2 - x1) div 2;
		relmaxy := (y2 - y1) div 2;
		x := ((x2 - x1) div -2);

		repeat
			p := calc_term;
			y := round(get_y_value(x / calc_zoom, p) * calc_zoom);
			if calc_errno = CALC_ERROR_FUNCTIONNOTDEFINED then begin
				barcolor := CALC_GRAPH_PROGRESSBAR_COLOR_NOTDEFINED;
				calc_errno := CALC_NO_ERROR;
			end
			else if (y > relmaxy) or (y < -relmaxy) then
				barcolor := CALC_GRAPH_PROGRESSBAR_COLOR_OOB
			else begin
				putpixel(x + relmaxx, relmaxy - y,
						 CALC_GRAPH_LINE_COLOR);
				barcolor := CALC_GRAPH_PROGRESSBAR_COLOR_DEFINED;
			end;

			setcolor(barcolor);
			line(x + relmaxx, (y2 - y1) - CALC_GRAPH_PROGRESSBAR_WIDTH, x + relmaxx, (y2 - y1));
			inc(x);
			delay(CALC_GRAPH_DELAY);
		until x > relmaxx;
	end;
end;

{ disegna il piano cartesiano. }
procedure draw_carthesio;
var vp : viewporttype;
var ts : textsettingstype;
var x, y, i : integer;
var relmaxx, relmaxy : word;
var th, tw : integer;
var str : string;
var increment : integer;
begin
	getviewsettings(vp);
	gettextsettings(ts);

	with vp do begin
		relmaxx := x2 - x1;
		relmaxy := y2 - y1;

		moveto(relmaxx div 2, relmaxy);
		lineto(relmaxx div 2, 0);
		moveto(0, relmaxy div 2);
		lineto(relmaxx, relmaxy div 2);

		increment := 40 div calc_zoom;
		if increment = 0 then increment := 1;

		settextstyle(ts.font, horizdir, ts.charsize);

		y := relmaxy div 2;
		x := relmaxx div 2;
		i := increment;
		while x < relmaxx do begin
			x := x + (increment * calc_zoom);
			{ stampa il tick. }
			line(x, y + CALC_GRAPH_CARTHESIO_TICK_HALF_LENGTH,
				 x, y - CALC_GRAPH_CARTHESIO_TICK_HALF_LENGTH);
			line(relmaxx - x, y + CALC_GRAPH_CARTHESIO_TICK_HALF_LENGTH,
				 relmaxx - x, y - CALC_GRAPH_CARTHESIO_TICK_HALF_LENGTH);
			{ stampa il numero. }
			str := int2str(i);
			th := textheight(str);
			tw := textwidth(str) div 2;
			outtextxy(x - tw, y + th, str);
			outtextxy(relmaxx - x - tw, y + th, '-' + str);

			i := i + increment;
		end;

		settextstyle(ts.font, vertdir, ts.charsize);

		i := increment;
		x := relmaxx div 2;
		while y < relmaxy do begin
			y := y + (increment * calc_zoom);
			{ stampa il tick. }
			line(x - 2, y, x + 2, y);
			line(x - 2, relmaxy - y, x + 2, relmaxy - y);
			{ stampa il numero. }
			str := int2str(i);
			th := textheight(str) * 2;
			tw := textwidth(str) div 2;
			outtextxy(x + th, y - tw, '-' + str);
			outtextxy(x + th, relmaxy - y - tw, str);

			i := i + increment;
		end;
		settextstyle(ts.font, ts.direction, ts.charsize);
	end;
end;

{ disegna una barra con del testo all`interno. }
procedure draw_bar(x1, y1, x2, y2 : word; str : string);
begin
	rectangle(x1, y1, x2, y2);
	outtextxy((x2 - textwidth(str)) div 2,
			  (y1 + (textheight(str) div 2)), str);
end;

{ procedura principale che disegna il piano,
  disegna la barra di stato, disegna il grafico,
  attende un input dall`utente e rilascia la memoria. }
procedure calc_graph_main;
var bar_width : word;
begin

	setwritemode(copyput); { usa MOV per disegnare i pixel a video }
	bar_width := textheight(calc_func) + CALC_GRAPH_BAR_SHIFT * 2;

	draw_bar(0, 0, maxx, bar_width, { barra superiore }
			 'y = ' + calc_func + ' [fattore di zoom: ' +
			 int2str(calc_zoom) + 'x]');

	draw_bar(0, (maxy - bar_width), maxx, maxy, { barra inferiore }
			 'risoluzione: ' + int2str(maxx + 1) +
			 ' x ' + int2str(maxy + 1));

	{ setta il viewport al piano cartesiano }
	setviewport(0, bar_width + 1, maxx, maxy - bar_width - 1, clipOn);
	{ disegna gli assi }
	draw_carthesio;
	{ disegna il grafico }
	setwritemode(xorput);
	draw_graph;
	{ attendi un input dall`utente }
	readkey;
	{ libera la memoria }
	cleanup;
end;

{ funzione per verificare la presenza di una modalita`
  grafica utilizzabile, per tornare in modalita` terminale
  e per settare nuovamente la modalita` grafica, utilizzando
  la risoluzione + elevata possibile.
  ritorna false in caso di fallimento }
function calc_setgraph(todo : shortint) : boolean;
var gd, gml, gmh : integer;
begin
	calc_setgraph := false;
	case todo of
		CALC_INIT :
			begin
				registerbgidriver(@EGAVGAdriver);
				registerbgidriver(@CGADriver);
				registerbgidriver(@HERCDriver);

				gd := detect;

				if gd = grOk then begin
					calc_setgraph := true;
					initgraph(gd, gml, '');
					maxx := getmaxx;
					maxy := getmaxy;
				end
				else
					calc_errno := CALC_ERROR_INITGRAPH;
			end;
		CALC_CRT : restorecrtmode;
		CALC_GRAPH :
			begin
				detectgraph(gd, gml);
				getmoderange(gd, gml, gmh);
				setgraphmode(gmh);
				maxx := getmaxx;
				maxy := getmaxy;
			end;
		CALC_CLOSE : closegraph;
	end;
end;

{ procedura per leggere i dati in input dall`utente }

function calc_read_data : boolean;
var buf : string;
var val_code : integer;
begin
	calc_errno := CALC_NO_ERROR;
	write('Inserire la funzione da disegnare [invio per uscire]: ');
	readln(calc_func);
	if calc_func <> '' then begin
		val_code := 0;
		repeat
			write('Inserire il fattore di zoom [default: ',
				CALC_GRAPH_DEFAULT_ZOOM, ' X]: ');
			readln(buf);
			calc_zoom := CALC_GRAPH_DEFAULT_ZOOM;
			if(buf <> '') then begin
				val(buf, calc_zoom, val_code);
				if val_code <> 0 then
					calc_errno := CALC_ERROR_BADINTEGER
				else begin
					calc_zoom := abs(calc_zoom);
					if calc_zoom > 1000 then
						val_code := 1;
				end;
			end;
		until val_code = 0;
		calc_read_data := true;
	end
	else
		calc_read_data := false;
end;

{ un simpatico banner :) }
procedure calc_banner;
begin
	writeln('** GRCALC versione ', CALC_VERSION, '.');
	writeln('** Copyright (C) 2002 Marcello Barnaba.');
end;

{$F+}
procedure calc_exitproc;
begin
	writeln;
	writeln('Grazie per aver utilizzato questo programma !');
	write('Premi un tasto qualsiasi per continuare . . .');
	readkey;
end;
{$F-}

{ main. verifica la presenza della modalita` grafica, e se presente,
  inizia un ciclo in cui viene chiesto all`utente la funzione che
  vuol disegnare, viene fatto il controllo della sintassi e viene
  quindi disegnata. per uscire e` sufficiente non immettere alcuna
  funzione. se la modalita` grafica non e` disponibile, il programma
  esce immediatamente. }
begin

	calc_errno := CALC_NO_ERROR;
	exitproc := @calc_exitproc;

	if calc_setgraph(CALC_INIT) then begin
		calc_setgraph(CALC_CRT);
		calc_banner;
		writeln('* Hardware grafico disponibile');
		writeln;

		while calc_read_data do begin
			if not calc_parse_func(calc_func) then begin
				calc_perror(calc_errno);
				writeln;
			end
			else begin
				calc_setgraph(CALC_GRAPH);
				calc_graph_main;
			end;
			calc_setgraph(CALC_CRT);
		end;
		calc_setgraph(CALC_CLOSE);
	end
	else
		calc_perror(calc_errno);
end.