PROGRAM GEOMETRIA_ANALITICA(input,output);
(* produced by Marcello Mengoni - www.mengoni.org *)
uses
crt,Graph;
var
grDriver : Integer;
grMode : Integer;
scala,colore,spc:integer;
axa,axz,axc,axb,axx,axy,bya,byb:integer;
x,y:real;
valore:integer;
equazione,spessore:real;
area:integer;
(*************************************************************************)
function POT(fpa,fpb:real):real;
var
fpc,fpe:integer;
fpd:real;
begin
fpe:=trunc(fpb);
fpd:=1;
for fpc:=1 to fpe do
fpd:=fpd*fpa;
pot:=fpd
end;
function sgn(fs:real):integer;
begin
if fs<>0 then
sgn:=trunc(fs/(abs(fs)))
else
sgn:=1
end;
function fraz(ff:real):real;
begin
fraz:=ff-trunc(ff)
end;
function adattatore(getmaxx,scala:integer):integer;
var
faa,fac,fad,fae,fak:real;
fab,faf,fag:integer;
begin
fag:=getmaxx;
fak:=fag/2;
faf:=0;
repeat
faa:=fak/scala;
fab:=trunc(faa);
fac:=faa-fab;
if fac < 0.5 then
fae:=0
else
begin
fab:=trunc(faa+1);
fae:=1
end;
fad:=abs(faa-fab);
if fad < 0.5 then
faf:=1
else
begin
if fae =1 then
fak:=fak+1
else
fak:=fak-1
end;
until faf=1;
adattatore:=fab
end;
procedure assi(getmaxx,getmaxy:integer);
var
paa,pab,pac,pad:integer;
begin
paa:=trunc(getmaxx/2);
pab:=trunc(getmaxy/2);
for pac:=1 to getmaxx do
putpixel(pac,pab,15);
for pad:=1 to getmaxy do
putpixel(paa,pad,15)
end;
procedure unita(axc,getmaxx,getmaxy,scala:integer);
var
pua,pub,puc,pud,pue,puf,pug,puh,pui:integer;
begin
puc:=adattatore(getmaxx,scala);
pue:=trunc(getmaxy/2)-3;
puf:=trunc(getmaxx/2)-3;
for pua:=1 to 5 do
begin
for pub:=-scala to (scala-1) do
begin
pud:=pub*puc+trunc(getmaxx/2);
pui:=-(pub*puc)+trunc(getmaxy/2);
pug:=pue+pua;
puh:=puf+pua;
putpixel(pud,pug,15);
putpixel(puh,pui,15)
end;
end;
end;
procedure quesito(spazio,altezza:integer);
var
ascii:char;
ch,decine,conta,potenza:integer;
numero:array[1..6] of integer;
begin
decine:=0;
repeat
ch:=ord(readkey);
if (ch>47) and (ch<58) then
begin
decine:=decine+1;
numero[decine]:=ch-48;
spazio:=spazio+10;
ascii:=char(ch);
outtextxy(spazio,altezza,ascii);
end;
until ch=13;
valore:=0;
for conta:=1 to decine do
begin
potenza:=decine-conta;
valore:=valore+numero[conta]*trunc(pot(10,potenza));
end;
end;
procedure superficie;
var
ch:integer;
begin
outtextxy(10,100,'Premi " L " se vuoi tracciare una linea');
outtextxy(10,150,'Premi " A " se vuoi trcciare l''area');
ch:=ord(readkey);
repeat
if ch=108 then
begin
area:=1;
outtextxy(10,250,'Definisci li spessore della linea da 1 (fine) a 9 (spesso)');
ch:=ord(readkey);
repeat
if (ch>48)and(ch<58) then
begin
spessore:=(ch-48)/10;
ch:=108;
end;
until ch=108;
end;
if ch=97 then
begin
area:=2;
end;
until (ch=108)or(ch=97);
end;
(*************************************************************************)
begin
grDriver := Detect;
InitGraph(grDriver,grMode,'');
outtextxy(10,100,'dimmi la scala (standard = 11) ');
quesito(270,100);
scala:=valore;
outtextxy(10,200,'dimmi di che colore vuoi la funzione (standard = 4) ');
quesito(440,200);
colore:=valore;
InitGraph(grDriver,grMode,'');
superficie;
InitGraph(grDriver,grMode,'');
(*************************************************************************)
assi(getmaxx,getmaxy);
axz:=0;
axc:=adattatore(getmaxx,scala);
unita(axc,getmaxx,getmaxy,scala);
for bya:=-scala to (scala-1) do
begin
for byb:=1 to axc do
begin
for axa:=-scala to (scala-1) do
begin
for axb:=1 to axc do
begin
y:=bya+(byb/axc);
x:=axa+(axb/axc);
if area=1 then
equazione:=abs(sqr(y)+sqr(x)-25);
if area=2 then
equazione:=trunc(sqr(y)+sqr(x)-25);
if equazione