PROGRAM CURVE_PARAMETRICHE(input,output); (* produced by Marcello Mengoni - www.mengoni.org *) uses crt,Graph; const pigreco=3.1415927; var grDriver : Integer; grMode : Integer; scala,colore,spc:integer; axc,xx,yy,zz,za:integer; xassex,yassex,xassey,yassey:integer; angxoz,angxoy,angyoz:real; xestrassex,yestrassex,xestrassey,yestrassey:integer; convx,convy:real; x,y,z:real; valore:integer; precedente:array[1..700] of integer; indice:integer; t,a,b:real; k: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; 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 assonometria; var ch:integer; begin angxoz:=5/4*pigreco; angxoy:=7/4*pigreco; angyoz:=1/2*pigreco; yestrassex:=trunc(350-sin(angxoz)*100); xestrassex:=trunc(320+cos(angxoz)*100); yestrassey:=trunc(350-sin(angxoy)*100); xestrassey:=trunc(320+cos(angxoy)*100); initgraph(grdriver,grmode,''); outtextxy(180,10,'DEFINIZIONE DELL'' ASSONOMETRIA'); outtextxy(145,70,'Premere " X " per selezionare l''asse x'); outtextxy(145,90,'Premere " Y " per selezionare l''asse y'); outtextxy(50,110,'Usare le frecce destra e sinistra per lo spostamento dell''asse'); outtextxy(145,130,'Pemere RETURN per chiudere la selezione'); line(320,250,320,350); line(320,350,xestrassex,yestrassex); line(320,350,xestrassey,yestrassey); circle(320,350,15); repeat ch:=ord(readkey); case ch of 120:begin repeat ch:=ord(readkey); case ch of 75:begin setcolor(0); line(320,350,xestrassex,yestrassex); angxoz:=angxoz-pigreco/120; yestrassex:=trunc(350-sin(angxoz)*100); xestrassex:=trunc(320+cos(angxoz)*100); setcolor(15); circle(320,350,15); line(320,350,xestrassex,yestrassex); end; 77:begin setcolor(0); line(320,350,xestrassex,yestrassex); angxoz:=angxoz+pigreco/120; yestrassex:=trunc(350-sin(angxoz)*100); xestrassex:=trunc(320+cos(angxoz)*100); setcolor(15); circle(320,350,15); line(320,350,xestrassex,yestrassex); end; end; (* case *) until (ch=13) or (ch=121) end; 121:begin repeat ch:=ord(readkey); case ch of 75:begin setcolor(0); line(320,350,xestrassey,yestrassey); angxoy:=angxoy-pigreco/120; yestrassey:=trunc(350-sin(angxoy)*100); xestrassey:=trunc(320+cos(angxoy)*100); setcolor(15); circle(320,350,15); line(320,350,xestrassey,yestrassey); end; 77:begin setcolor(0); line(320,350,xestrassey,yestrassey); angxoy:=angxoy+pigreco/120; yestrassey:=trunc(350-sin(angxoy)*100); xestrassey:=trunc(320+cos(angxoy)*100); setcolor(15); circle(320,350,15); line(320,350,xestrassey,yestrassey); end; end; (* case *) until (ch=13) or (ch=120) end; end; (* case *) until ch=13; 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; begin setcolor(8); yestrassex:=trunc(239-sin(angxoz)*320); xestrassex:=trunc(319+cos(angxoz)*320); yestrassey:=trunc(239-sin(angxoy)*320); xestrassey:=trunc(319+cos(angxoy)*320); line(319,0,319,480); line(319,239,xestrassex,yestrassex); line(319,239,xestrassey,yestrassey); yestrassex:=trunc(239+sin(angxoz)*320); xestrassex:=trunc(319-cos(angxoz)*320); yestrassey:=trunc(239+sin(angxoy)*320); xestrassey:=trunc(319-cos(angxoy)*320); line(319,0,319,480); line(319,239,xestrassex,yestrassex); line(319,239,xestrassey,yestrassey); setcolor(15); end; procedure unita(axc,getmaxx,getmaxy,scala:integer); var pub,puc,pud,puf,pug,puh,pui,pul,pum:integer; begin setcolor(8); puc:=adattatore(getmaxx,scala); for pub:=-scala to (scala-1) do begin pud:=trunc(319+cos(angxoz)*pub*puc); puf:=trunc(239-sin(angxoz)*pub*puc); pul:=trunc(319-cos(angxoy)*pub*puc); pum:=trunc(239+sin(angxoy)*pub*puc); pui:=-(pub*puc)+trunc(getmaxy/2); line(pud,puf-3,pud,puf+3); (* asse x *) line(316,pui,322,pui); (* asse z *) line(pul,pum-3,pul,pum+3); (* asse y *) end; setcolor(15); 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 curva (standard = 4) '); quesito(440,200); colore:=valore; assonometria; InitGraph(grDriver,grMode,''); (*************************************************************************) assi; axc:=adattatore(getmaxx,scala); unita(axc,getmaxx,getmaxy,scala); a:=-10*2*pigreco; b:=10*2*pigreco; t:=a; for k:=trunc(a*axc) to trunc(b*axc) do begin (****** EQUAZIONE PARAMETRICA **********) (***********) x:=cos(t); (**************) (***********) y:=sin(t); (**************) (***********) z:=1/4*t; (**************) (***************************************) xassey:=trunc((y*axc)*cos(angxoy)+319); yassey:=trunc((y*axc)*sin(angxoy)+239); xassex:=trunc((x*axc)*cos(angxoz)+319); yassex:=trunc((x*axc)*sin(angxoz)+239); xx:=xassex+xassey-319; yy:=yassex+yassey-239; zz:=yy-(trunc(z)*axc+round(fraz(z)*axc)); putpixel(xx,zz,colore); t:=t+1/axc end; (* for t *) outtextxy(450,470,'RETURN per continuare'); (*************************************************************************) ReadLn; CloseGraph end.