{$mode objfpc} {$H+}
unit Grafica;
interface
uses graph, crt;
function inizio_graf:boolean;
procedure assi;
procedure fine_graf(pausa:boolean);
type tpuntoxy=record
px,py:double;
end;
type finestra=record
inizio,fine:tpuntoxy;
end;
function distanza (tratto:finestra):double;
type punto=class
private
px,py,maxx,maxy,colore:integer;
scale:tpuntoxy;
f:finestra;
procedure SetX(a:double);
procedure SetY(a:double);
procedure setColore(c:integer);
function getColore:integer;
public
constructor inizio(g:finestra); overload;
constructor inizio(a,b,c,d:double); overload;
constructor IsoInizio(cx0,cy0,cxf:double);
destructor DistruggiPunto;
procedure assi(c:word);
procedure punto(x,y:double);
procedure rettangolo(x,y,x1,y1:double);
function RuotaPunto(po:tpuntoxy; al:double):tpuntoxy;
procedure TraslaRuotaPunto(x0,y0,x,y,al:double);
procedure cerchio(xc,yc,r:double);
procedure ellisse(xc,yc,rx,ry:double);
procedure linea(c:finestra);
procedure linea(a,b,c,d:double);
procedure lineaTo(x,y:double);
procedure parabola(a,b,c:double);
procedure SetXY(pu:tpuntoxy);
procedure limitiFoglio(var x,y:smallint);
procedure scriviXY(messaggio:string; cx,cy:real);
property tinta:integer read getColore write setColore;
end; { fine classe punto }
const nero=black;
blu=blue;
verde=green;
ciano=cyan;
rosso=red;
magenta=magenta;
marrone=brown;
GrigioChiaro=LightGray;
GrigioScuro=DarkGray;
BluChiaro=LightBlue;
VerdeChiaro=LightGreen;
CianoChiaro=LightCyan;
RossoChiaro=LightRed;
MagentaChiaro=LightMagenta;
giallo=yellow;
bianco=white;
lampeggio=blink; { solo per il testo }
implementation
function inizio_graf:boolean;
var sg,ng,ec:smallint(*integer*);
ch:boolean;
begin
sg:=detect;
ng:=0;
initgraph(sg, ng, '');
ec:=graphresult;
if ec=grok then
begin
ch:=true;
settextstyle(DefaultFont, HorizDir, 1);
end
else
begin
ch:=false;
writeln;
write('Errore grafico: ',grapherrormsg(ec));
repeat until keypressed;
writeln(' ',readkey);
end;
inizio_graf:=ch;
end;
procedure assi;
var finx,finy,sx,sy:word;
begin
finx:=getmaxx;
finy:=getmaxy;
sx:=finx div 2;
sy:=finy div 2;
setcolor(7);
line(sx,0,sx-3,10);
line(sx,0,sx+3,10);
line(finx,sy,finx-10,sy-3);
line(finx,sy,finx-10,sy+3);
setcolor(15);
line(sx,0,sx,finy);
line(0,sy,finx,sy);
outtextxy(finx-10,sy-15,'x');
outtextxy(sx+10,0,'y');
end;
procedure fine_graf(pausa:boolean);
var tasto:char;
begin
if pausa then
begin
tasto:=readkey;
writeln(tasto);
end;
closegraph;
end;
function distanza(tratto:finestra):double;
var dx,dy:double;
begin
dx:=tratto.fine.px - tratto.inizio.px;
dy:=tratto.fine.py - tratto.inizio.py;
distanza:=sqrt(dx*dx + dy*dy);
end;
constructor punto.inizio(a,b,c,d:double); overload;
var temp:finestra;
begin
with temp do
begin
inizio.px:=a;
inizio.py:=b;
fine.px:=c;
fine.py:=d;
end;
inizio(temp);
end;
constructor punto.inizio(g:finestra); overload;
var dx,dy:double;
begin
maxx:=GetMaxX;
maxy:=GetMaxY;
tinta:=7;
f:=g;
with f do
begin
dx:=fine.px-inizio.px;
dy:=fine.py-inizio.py;
end;
if abs(dx)<1e-23 then dx:=1e-23;
if abs(dy)<1e-23 then dy:=1e-23;
scale.px:=maxx/dx;
scale.py:=maxy/dy;
SetX(f.inizio.px);
SetY(f.inizio.py);
end;
constructor punto.IsoInizio(cx0,cy0,cxf:double);
var dx:double;
begin
maxx:=GetMaxX;
maxy:=GetMaxY;
tinta:=7;
with f do
begin
inizio.px:=cx0;
fine.px:=cxf;
inizio.py:=cy0;
dx:=cxf-cx0;
if abs(dx)<1e-23 then
begin
dx:=1e-23;
fine.px:=inizio.px+dx;
end;
scale.px:=maxx/dx;
scale.py:=scale.px;
fine.py:=(maxy/scale.py)+inizio.py;
SetX(inizio.px);
SetY(inizio.py);
end;
end;
destructor punto.DistruggiPunto;
begin
{ Distruttore }
end;
procedure punto.assi(c:word);
var cx0,cy0:longint;
begin
with f do
begin
cx0:=round(scale.px*(0.0-f.inizio.px));
cy0:=maxy-round(scale.py*(0.0-f.inizio.py));
end;
SetColor(abs(c) mod 16);
if (cy0>=0) and (cy0<=maxy) then
begin
line(0, cy0, maxx, cy0); { asse x }
end;
if (cx0>=0) and (cx0<=maxx) then
begin
line(cx0, 0, cx0, maxy); { asse y }
end;
setColor(colore);
end;
procedure punto.SetX(a:double);
begin
a:=scale.px*(a-f.inizio.px);
if a<0.0 then
a:=0.0;
if a>maxx then a:=maxx;
px:=round(a);
end;
procedure punto.SetY(a:double);
begin
a:=maxy-(scale.py*(a-f.inizio.py));
if a<0 then
a:=0.0;
if a>maxy then
a:=maxy;
py:=round(a);
end;
procedure punto.SetXY(pu:tpuntoxy);
begin
SetX(pu.px);
SetY(pu.py);
end;
procedure punto.punto(x,y:double);
begin
SetX(x);
SetY(y);
putpixel(px, py, colore);
end;
procedure punto.rettangolo(x,y,x1,y1:double);
var lato:finestra;
begin
with lato do
begin
inizio.px:=x;
inizio.py:=y;
fine.px:=x1;
fine.py:=y;
linea(lato);
inizio.px:=x1;
fine.py:=y1;
linea(lato);
inizio.px:=x;
inizio.py:=y1;
linea(lato);
fine.px:=x;
fine.py:=y;
linea(lato);
end;
end;
function punto.RuotaPunto(po:tpuntoxy; al:double):tpuntoxy;
var ris:tpuntoxy;
begin
ris.px:=po.px*cos(al)-po.py*sin(al);
ris.py:=po.px*sin(al)+po.py*cos(al);
RuotaPunto:=ris;
end;
procedure punto.TraslaRuotaPunto(x0,y0,x,y,al:double);
var rx,ry:double;
begin
rx:=x*cos(al)-y*sin(al);
ry:=y*sin(al)+x*cos(al);
punto(rx+x0, ry+y0);
end;
procedure punto.cerchio(xc,yc,r:double);
var al,dal,omega:double;
begin
al:=0.0;
omega:=2.0*pi;
if abs(r)<1e-15 then r:=1e-15;
dal:=1.0/(r*omega*scale.px);
setX(xc+r); sety(yc);
while al<=omega do
begin
lineaTo(xc+r*cos(al), yc+r*sin(al));
al:=al+dal;
end;
end;
procedure punto.linea(c:finestra);
var x1,y1:integer;
begin
with c do
begin
SetXY(inizio);
x1:=px;
y1:=py;
SetXY(fine);
setColor(colore);
line(x1, y1, px, py);
end;
end;
procedure punto.linea(a,b,c,d:double);
var t:finestra;
begin
with t do
begin
inizio.px:=a;
inizio.py:=b;
fine.px:=c;
fine.py:=d;
end;
linea(t);
end;
procedure punto.lineaTo(x,y:double);
var ox,oy:word;
begin
ox:=px;
oy:=py;
SetX(x);
SetY(y);
setColor(colore);
line(px,py, ox,oy);
end;
procedure punto.ellisse(xc,yc,rx,ry:double);
var al,dal,be,rm:double;
begin
al:=0.0;
be:=2.0*pi;
rm:=0.5*(rx+ry);
dal:=0.5/(scale.py*be*rm);
while al<=be do
begin
punto(xc+rx*cos(al), yc+ry*sin(al));
al:=al+dal;
end;
end;
procedure punto.parabola(a,b,c:double);
var tratto:finestra;
passo:double;
function fun(x:double):double;
begin
fun:=a*x*x + b*x + c;
end;
begin
passo:=(f.fine.px-f.inizio.px)/2000;
tratto.inizio.px:=f.inizio.px;
tratto.inizio.py:=fun(tratto.inizio.px);
while tratto.inizio.px<=f.fine.px do
begin
tratto.fine.px:=tratto.inizio.px + passo;
tratto.fine.py:=fun(tratto.fine.px);
linea(tratto);
tratto.inizio:=tratto.fine;
end;
end;
procedure punto.setColore(c:integer);
begin
colore:=abs(c) mod 16;
setColor(colore);
end;
function punto.getColore:integer;
begin
getColore:=colore;
end;
procedure punto.limitiFoglio(var x,y:smallint);
begin
x:=maxx;
y:=maxy;
end;
procedure punto.scriviXY(messaggio:string; cx,cy:real);
begin
setX(cx);
setY(cy);
outTextXY(px, py, messaggio);
end;
begin
{Inizializzazione}
end.
