program grafico; uses crt,graph; var r,rAssi: char; k,xu,yu:real; xs,ys,col:integer; MaxX,MaxY,xsa,ysa:integer; nInterpunti:integer; idx:integer; dx: real; function f1(x:real):real; begin f1:=x*x-1; end; function f2(x:real):real; begin f2:=20*sin(x); end; procedure input; begin Clrscr; Write ('A quanti pixel vuoi che corrisponda una tua unita'' '); readln(k); write('Vuoi gli assi (N/default=S)? '); readln(rAssi); if (rAssi<>'N')then rAssi:='S' ; write('Vuoi gli interpunti (S/default=N)? '); readln(r); if (r<>'S')then r:='N' ; nInterpunti:=1; if (r='S')then begin write('Quanti interpunti '); readln(nInterpunti); end; end; procedure Assi; begin MaxX:=GETMAXX; MaxY:=GETMAXY; xsa:=MaxX div 2; ysa:= MaxY div 2; SetColor(3); Line(0,ysa,MaxX,ysa); Line(xsa,0,xsa,MaxY); end; procedure GraduaASSI; var i,xsg,ysg: integer; begin i:=0; repeat i:=i+1; xsg:=Round(i*k+xsa); Line(xsg,ysa-2,xsg,ysa+2); until xsg>MaxX; i:=0; repeat i:=i+1; xsg:=Round(-i*k+xsa); Line(xsg,ysa-2,xsg,ysa+2); until xsg<0; i:=0; repeat i:=i+1; ysg:=Round(ysa+i*k); Line(xsa-2,ysg,xsa+2,ysg); until ysg>MaxY; i:=0; repeat i:=i+1; ysg:=Round(-i*k+ysa); Line(xsa-2,ysg,xsa+2,ysg); until ysg<0; end; procedure InizializzaGrafica; var SchedaGrafica,ModoGrafico:smallint; begin SchedaGrafica:=0; InitGraph(SchedaGrafica,ModoGrafico,' '); end; (* -------------- MAIN PROGRAM -------------------*) begin repeat clrscr; input; InizializzaGrafica; Assi; if (rAssi='S') then GraduaAssi; col:=4; for xs:=0 to MaxX do begin for idx:=0 to nInterpunti-1 do begin dx:=idx/nInterpunti; xu:=((xs+dx)-xsa)/k ; yu:=f1(xu); ys:=Round(ysa-k*yu); if (ys>=0) AND (ys<= MaxY) then PutPixel(xs,ys,col); yu:=f2(xu); ys:=Round(ysa-k*yu); if (ys>=0) AND (ys<= MaxY) then PutPixel(xs,ys,col+1); end; end; write('Vuoi continuare (default=S/N) '); readln(r); closeGraph(); until (r='N'); end.