E'offerto agli allievi un "ambiente" di programmazione ( IDE particolarmente comodo, nel quale e' possibile passare immediatamente dall'editor al compilatore - linker - loader col minimo di preoccupazioni dell'utilizzatore. Dopo stabilito il collegamento con la rete, mediante ID-utente e chiave (username e password), si accede all'ambiente IDE mediante l'opzione TURBO. Lo sfondo dello schermo diviene color celeste e un facile editor consente di scrivere il programma nel linguaggio PASCAL. La chiave F 1 offre spiegazioni riguardanti I' editor (es. come definire i blocchi per compiere spostamenti e copie di parti di, testo); la chiave ctrl-F I offre spiegazioni riguardanti il linguaggio (si suggerisce in particolare di studiare V uso delle opzioni grafiche). Un programma PASCAL deve avere: una Intestazione, un nome, la parola chiave BEGIN, la parola chiave END, il punto (. ) finale, il punto e virgola ( ; ) tra Intestazione e parola Begin. Il seguente programma puo' essere compilato ed eseguito: PROGRAM mino; BEGIN END. E programma, una volta introdotto tramite l'editor di IDE, va "salvato" o registrato su disco con il tasto F2. In tale occasione si assegna il nome-DOS. E' opportuno, se non ci sono forti motivi contrari, che il nome DOS permetta di riconoscere il nome programma cosi' da agevolare il successivo reperimento. I programmi piu' recenti sono reperibili con la chiave Alt-F3. Il programma viene compilato linkato ed eseguito con il tasto CtrI-F9. Eventuali errori di sintassi Pascal vengono immediatamente segnalati da IDE. Si sottolinea fortemente l'opportunita' di preparare il programma per piccoli frammenti, ciascuno verificabile immediatamente, cosi' da localizzare con sicurezza i possibili motivi di errore. Eseguito il programma, il sistema ripropone I' ambiente IDE. L'eventuale risultato prodotto dal programma e' ispezionabile premendo il tasto Alt-F5, che alterna lo schermo IDE (azzurro) e lo schermo DOS (nero), che conserva i risultati prodotti PROGRAM mino; BEGIN writeln (' ciao, sono mino: benvenuto!') END. F2 ; Ctrl-F9; Alt-F5; Alt-F5Alt-F5 Alt-F5 Per mantenere lo schermo nero contenente l'uscita del programma e' utile inserire l'istruzione READLN: PROGRAM mino; BEGIN writeln (' benvenuto'); READLN END. Tale istruzione dispone l'attesa dei carattere EOL da tastiera, cioe' la pressione del tasto enter, prima dei ritorno ad IDE. PROGRAM mino; BEGIN writeln (' benvenuto'); writeln ('premi "ENTER" per tornare in IDE'); READLN END. Per costruire con sicurezza programmi articolati e complessi e' opportuno incapsulare blocchi di istruzioni in PROCEDURE. Il programma suggerito puo' evolvere cosi': PROGRAM saluti; PROCEDURE messaggi; BEGIN writeln(' benvenuto'); writeln('premi "ENTER" per tornare in IDE"); READLN END; BEGIN messaggi END. e quindi Cosi': PROGRAM saluti; VAR memoria:text; tuonome:string; ok:string[1]; PROCEDURE messaggi; BEGIN writein ('benvenuto , come ti chiami?') Readin ( tuonome ); writeln ( memoria, tuonome writeln ('ciao ', tuonome,' buon lavoro') ; Readln(ok);writeln(mernoria,ok) ; END; PROCEDURE riferisci; BEGIN writeln ('Elenco dei visitatori') REPEAT readln (memoria, tuonome );writeln(tuonome); readln(memoria,ok) UNTIL (ok='x')or eof(memoria) END; BEGIN writeln(' rispondi x per tornare in IDE'); assign(memoria,'nomi.dat'); rewrite(memoria); REPEAT MESSAGGI UNTIL ok=W; reset (memoria); riferisci; close (memoria); readln END. I nomi registrati nel file-text pascal di nome memoria, cui corrisponde, per la istruzione assign, il file DOS " nomi.dat % sono ispezionabili mediante l'editor di IDE con la chiave F3 seguita dal nome-DOS del file cioe' nomi.dat. Un programma per offire funzioni tabellate potrebbe essere progettato cosi: PROGRAM tab; PROCEDURE tabelle; BEGIN writeln(' tabelle') END; BEGIN TABELLE; readin END. Vale la pena verificare subito il programma (ctrl-F9) e poi completare (per blocchi piccoli) la procedura tabelle: PROCEDURE tabelle; VAR x,y,t,dt,er,dif,den :real; :integer; BEGIN writeln('tabelle coseno seno errore'); t:=O; dt:=3.14159/40; fori:= 1 to 20 do BEGIN t:=t+dt; x:=cos(t) y:=sin(t); dif.=I-sqr(x)-sqr(y); er:=sqrt(abs(dif); writeln(t:10A,x:10A,y:10A,' ',er:10) END; END; Per ispezionare i risultati dei calcolo e' opportuno utilizzare la possibilit… di rappresentare direttamente grafici. Tra le funzioni grafiche segnaliamo la procedura PUTPIXEL(xx,yy,col), nella quale i tre parametri sono interi positivi rispettivamente limitati da 640, 480,15. Per ottenere grafici e' necessario reperire nel disco P o D il file EGAVGA.BG1 e trascriverlo nel disco C o X; quindi si deve dichiarare l'uso della unit GRAPH (insieme di programmi nella libreria turbo pascal), e chiamare la procedura initgraph. ... copy P:\tp\BGI\EGAVGA.BGI c:\tp\ PROGRAM DISEGNI; uses GRAPH; PROCEDURE grafico; VAR x,y:tipodati; BEGIN REPEAT ... x:= ... ;y:= ... ; punto(x,y) UNTIL finegrafico END; PROCEDURE iniziadisegni; VAR gd,gm:integer; path:string; BEGIN gd:=detect; path:='c:Vp'; initgraph(gd,gm,path) END; BEGIN INIZIADISEGNI; GRAFICO END. La funzione detect e' definita entro GRAPH; la stringa path contiene l'itinerario per raggiungere la directory che contiene il file EGAVGA.BG1. La procedura punto(x,y) deve trasformare i valori di x e y negli interi positivi xx e yy che soddisfino le limitazioni indicate; quindi chiama la procedura putpixel(xx,yy,col) di GRAPH. Ad esempio, se x ed y sono valori di seni e coseni cioe' sono compresi tra - 1 e + 1, una possibile versione e' la seguente: PROCEDURE punto(x:real,y:real); VAR xx,yy,col:integer; BEGIN xx:trunc(320+140*x);yy:=trunc(240+100*y); col:=14; putpixel(xx,yy,col) END; Piu' in generale per ciascuna coordinata serve un fattore di scala (es. 140 per x) ed un offset(es. 320 per x), rapportati ai valori massimi e minimo che si vogliono rappresentare. Puo' cioe' servire una procedura che, per dati valori estremi di x e di y, assegni valori di scala e di offset per le due variabili. PROGRAM DISEGNI; uses GRAPH; VAR col :integer; max,mix,may,miy,scax,shx,scay,shy:real; PROCEDURE scalemax; BEGIN max:=3.5;mix:=-3.5;may:=2.5;miy:=-2.5 END; PROCEDURE scalegra; const mxx=640;myy--480; BEGIN scalemax; scax:=mxx/(max-mix); shx:=-mix*scax scay:=myy/(inay-iiiiy); shy:=-miy*scay END; PROCEDURE punto(x,y:real); VAR xx,yy: integer; BEGIN xx:=trunc(shx+scax*x),yy:=trunc(shy+scay*y); putpixel(xx,yy,col) END; PROCEDURE grafico; VAR x,y,t,dt,erdifden:extended; i:integer; BEGIN t::=O;dt:=3.14159/50 col:=13; fori:= 1 to 100 do BEGIN t:= t+dt ; x:=cos(t) ; y:=sin(t); difi=1-x*x-y*y; den:=sqrt(abs(dif); er:=0 ;if den><0 then er:=dif/den; ( writeln(x:10:4,10:4,' ',er:10); ) punto(x,y) END; readln END; PROCEDURE iniziadisegni; VAR gd,gm:¡nteger;path:string; BEGIN path:='\tp';gd=detect; initgraph(gd,gm,path) writeln('ok=',graphresult); scalegra END; BEGIN INIZIADISEGNI; GRAFICO END. Il programma si presta a rappresentare efficientemente il risultato di una integrazione numerica: PROCEDURE sincos; cost tf=3.14159; VAR x,y,ttfdter:extended; col, ij,ni,nj:integer, BEGIN writeln(numero di passini');readln(ni); nj:=30 dt=tV(ni*nj); x:=1;y:=O; col:=13; for j:= 1 to nj do BEGIN; for i:= 1 to ni do begin t:= t+dt; x:=x-y*dt; y:=y+x*dt; er:=I-x*x-y*y end; writeln(x:10:4,y:10:4,' ',er:10); { punto(x,y) ) END; readln END INTEGRAZIONE DI EQUAZIONI DIFFERENZIALI ORDINARIE. Utilizzeremo questi programmi principalmente per tracciare le orbite sul piano delle fasi di sistemi a due gradi di liberta' oppure opportune sezioni di Poincare' per sistemi a piu' gradi di liberta' In generale risolveremo dei "problemi di Cauchy" o ai valori iniziali. Assegnate le condizioni iniziali e la legge differenziale di evoluzione calcoleremo "passo passo" ossia per valori discreti dei tempo le successive configurazioni del sistema e ne tracceremo le corrispondenti immagini nel piano delle fasi. Nel caso dei pendolo le equazioni differenziali sono: dx/dt=v dv/dt=sin(x) Il piano delle fasi rappresenta v in ordinate e x in ascisse e sono richiesti i valori iniziali x e v al tempo iniziale. Potremo, per comodita' di successive applicazioni considerare anche la variabile t con derivata dt/dt=1 e con valore iniziale to=0. Proponiamo come primo metodo di integrazione il "metodo di Eulero". Dopo aver assegnato le condizioni iniziali x=0,v=v0, i successivi punti si trovano ripetendo le formule: rx=V rv=-sin(x) x=x+dt*rx v=v+dt*rv Il risultato dipende seriamente da dt. E' noto dal corso di Analisi che il metodo di Eulero converge alla soluzione giusta per dt molto piccolo. Per i valori utilizzabili di dt le traiettorie nel piano x,v sono spirali che si aprono e mostrano che ad ogni successivo istante la traiettoria e' rappresentata da un segmento di retta, che soddisfa l'eq.diff. ali' inizio ma non all'estremo. (si osservi che scambiando l'ordine della seconda e terza espressione si ottengono traiettorie che si chiudono con precisione eccezionale, ma il sistema ottenuto non e'piu' identico a quello originale; in particolare e' come se v ed x fossero calcolati a tempi non simultanei, ma alternati e sfasati di dt.) La correzione che suggeriamo e'ricalcolare il valore della derivata all'estremo e supporre una variazione continua lineare nel tempo della derivata tra i due istanti; il che comporta approssimare la vera traiettoria con archi di parabola, capaci di soddisfare simultaneamente l'eq.diff. ad entrambe le estremita' rx=V rv=-sin(x) xa=x+0.5*dt*rx va=v+0.5*dt*rv ripeti x=xa+0.5*dt*rx v=va+0.5*dt*rv rx=V rv=-sin(x) per tre volte Il metodo consente precisioni sufficenti per la maggior parte delle applicazioni e l'errore e' proporzionale a dt^3. Risultati piu' precisi possono essere ottenuti con un metodo dei quarto ordine. Detti x ed r i valori della funzione incognita e della sua derivata e detta DERIV(x,r) la procedura che calcola r in funzione delle x, si utilizzino le variabili ausiliarie r1,r2,r3,r4. Uno schema di procedura che realizza il passo di integrazione Runge-Kutta del 4 ordine e' il seguente: xa=x deriv(x,rl) x=xa+0.5*dt*rI deriv(x,r2) x=xa+0.5*dt*r2 deriv (x,r3) x=xa+dt*r3 deriv(x,r4) x=xa+dt*(rl+r2+r2+r3+r3+M)/6 Proponiamo anche un Runge Kutta Gill ancora del quarto ordine che sembra avere migliori doti di stabilita! Le variabili x ed xa sono valutate dalla procedura: for iru=1 to 4 do BEGIN deriv(x,r) rr=r*step aum=aa(iru)*(rr-bb(iru)*xa) x=x+aum xa=xa+3*aum-cc(iru)*rr: END dove detti s=03;q=1-sqrt(s);p=(2-q), le aa,bb,cc al variare di iru assumono i valori al,cl=s ; a2,c2=q ; a3,c3=p ; c4=s; a4=1/6; 12 bl=2;b2=I;b3=I;b4=2 PROGRAM integr_ode; USES GRAPII; const nhe=4; var id, it,nd,nt,col: integer; step,tempofinale,tempo,hstep, x y v w r t z . xa,ya,va,wa,ra,ta,za, rx,ry,rv,rw,rr,rt,rz, scax,scay,shx,shy,max,may,mix,miy: extended; A,B,C: ARRAY [ L4] OF EXTENDED; PROCEDURE titolo; BEGIN writeln(' pendolo ') END; PROCEDURE SCALEMAX;BEGIN (PENDOLO max:=3.5;mix:=-3.5;may:=2.5;miy:=-2.5 END; PROCEDURE deriv ;BEGIN rx:=v;rv:=-sin(x); rt:= l; END; PROCEDURE scegli(var xg,yg:real); BEGIN xg:=x;yg:=v END; FUNCTION invar:extended; BEGIN invar:=v*v*03-cos(x) END; PROCEDURE leggin; BEGIN writeln('x0,vT); readin(x,v) END; Il piano delle fasi rappresenta v in ordinate e x in ascisse e sono richiesti i valori iniziali x e v al tempo iniziale. Potremo, per comodita' di successive applicazioni considerare anche la variabile t con derivata dt/dt= I e con valore iniziale to=0. Proponiamo come primo metodo di integrazione il "metodo di Eulero". Dopo aver assegnato le condizioni iniziali x=xO,v=vO, i successivi punti si trovano ripetendo le formule: rx=V rv=-sin(x) x=x+dt*rx v=v+dt*rv Il risultato dipende seriamente da dt. E' noto dal corso di Analisi che il metodo di Eulero converge alla soluzione giusta per dt molto piccolo. Per i valori utilizzabili di dt le traiettorie nel piano x,v sono spirali che si aprono e mostrano che ad ogni successivo istante la traiettoria e' rappresentata da un segmento di retta, che soddisfa l'eq.diff. all' inizio ma non all'estremo. (si osservi che scambiando l'ordine della seconda e terza espressione si ottengono traiettorie che si chiudono con precisione eccezionale, ma il sistema ottenuto non e'piu' identico a quello originale; in particolare e' come se v ed x fossero calcolati a tempi non simultanei, ma alternati e sfasati di dt.) La correzione che suggeriamo e ricalcolare il valore della derivata all'estremo e supporre una variazione continua lineare nel tempo della derivata tra i due istanti; il che comporta approssimare la vera traiettoria con archi di parabola, capaci di soddisfare simultaneamente l'eq.diff. ad entrambe le estremita' rx=V rv=-sin(x) xa=x+0.5*dt*rx va=v+0.5*dt*rv ripeti x=xa+0.5*dt*rx v-- va+0.5*dt*rv rx=v rv=-sin(x) per tre volte Il metodo consente precisioni sufficenti per la maggior parte delle applicazioni e l'errore e' proporzionale a dt^3. Risultati piu' precisi possono essere ottenuti con un metodo del quarto ordine. Detti x ed r i valori della funzione incognita e della sua derivata e detta DERIV(x,r) la procedura che calcola r in funzione delle x, si utilizzino le variabili ausiliarie rl,r2,r3,r4. Uno schema di procedura che realizza il passo di integrazione Runge-Kutta del 4 ordine e' il seguente: xa=x deriv(x,r1) x=xa+0.5*dt*rl deriv(x,r2) x=xa+0.5*dt*r2 deriv (x,r3) x=xa+dt*r3 deriv(x,r4) x=xa+dt*ffl+r2+r2+r3+r3+r4)/6 Proponiamo anche un Runge Kutta Gill ancora dei quarto ordine che sembra avere migliori doti di stabilita! Le variabili x ed xa sono valutate dalla procedura: for iru= 1 to 4 do BEGIN deriv(x,r) rr=r*step, aum=aa(iru)*(rr-bb(iru)*xa) x=x+aum xa=xa+3 *aum-cc(iru)*rr: END dove detti s=0.5;q= 1 -sqrt(s);p=(2-q), le aa,bb,cc al variare di iru assumono i valori al,cl=s ; a2,c2=q ; a3,c3=p ; c4=s; a4=116; b1=2;b2=1;b3=1;b4=2 PROGRAM integr_ode; USES GRAPH; const nhe=4; var id, it,nd,ntcol: integer; step,tempofinale,tempo,hstep, x y v w r t z . xa,ya,va,wa,ra,ta,za, rx,ry,rv,rw,rr,rt,rz, scax,scay,shx,shy,max,may,mix,miy: extended; A,B,C: ARRAY [LA] OF EXTENDED; PROCEDURE titolo; BEGIN writeln(' pendolo ') END; PROCEDURE SCALEMAX;BEGIN {PENDOLO) max:=3.5;mix:=-3.5;may:=2.5;miy:=-2.5 END A PROCEDURE scegli(var xg,yg:real); BEGIN xg:=x;yg:=v END; FUNCTION invar:extended; BEGIN invar:=v*v*03-cos(x) END; PROCEDURE leggin; BEGIN writeln('x0,v0'); readln(x,v) END; PROCEDURE passo; var iru: LA PROCEDURE passino(aa,bb,cc:extended) PROCEDURE incre(rx:extended;var x,xa:extended) ; var rr,aum:extended; BEGIN rr-rx*step; aum:=aa*(i-r-bb*xa);x:=x+aum; xa:=xa+3*aurn-cc*ri- END BEGIN deriv;incre(rx,x,xa);incre(rv,v,va);incre(rt,tta) END; BEGIN for iru:= I to 4 do passino(a[iru],b[ii-u],c[ii-u]) END; PROCEDURE passohe; var ihe: l..nhe PROCEDURE incre(rx:extended;var x,xa:extended) ; BEGIN xa:=x+hstep* rx END BEGIN incre(rx,x,xa);incre(rv,v,va);incre(rt,t,ta) for ihe:= I to nhe do BEGIN incre (rx,xa,x);incre(rv,vav);incre(rt,tat); deriv END; END; PROCEDURE param; BEGIN write(1fin,ripunti,ndiV); readin(tempofinale,nt,nd); if nt=0 then nt:=20;if nd =O then nd:=I;step:=tempofinale/(rit*nd); write('step=',step:8,' ');step:=step/2 END; PROCEDURE punto; var xx,yy: integer;xg,yg:real; BEGIN scegli(xg,yg); xx:=trun*g*scax+shx); yy:=trunc(yg*scay+shy); putpixel(xx,yy,col) END; PROCEDURE traccia; BEGIN deriv; for it:= I to nt do BEGIN for id:= I io nd do passo; punto END END; PROCEDURE azzera;BEGIN xa:=O;ya:=O;va:=O;wa:=O;ra:=O;ta:=0 END; PROCEDURE valin; BEGIN azzera;t:=O; leggin END; FUNCTION finetraccia:boolean; BEGIN finetraccia:=(x=O)and(v=O) END; FUNCTION finedis:boolean;BEGIN finedis:=ternpofinale=0 END; PROCEDURE scalegra; const mxx=640;inxy=480;BEGIN scalemax; scax:=mxxl(max-mix);shx:=-mix*scax; scay:=-mxyl(may-miy);shy:=- may*scay END; PROCEDURE iniziagrafici;var gd,gm:integer; BEGIN gd:=detect;initgraph(gd,gm,'\tp');scalegra END; PROCEDURE INIZIAMETODO;CONST R=0.5;var s,t:extended; BEGIN S:=I-SQRT(R);T:=M; a[1]:=r; a[2]:=s; a[3]:=t; a[4]:=1.016.0; c[1):=r; c[2]:=s; c[3]:=t; c[4]:=r; b[ I ]:=2; b[2]:= l; b[3]:= l; b[4]:=2 END; PROCEDURE fine; var ok:string[1] ; procedure hcopy;begin end; BEGIN writeln('fine . vuoi hcopy grafici? (s/n)') readln (ok);if ok='s'then hcopy END; PROCEDURE esegui; BEGIN param; col:= 15; repeat valin; repeat traccia; col:=col- I; valin until finetraccia; param until finedis END; BEGIN iniziagrafici; iniziametodo; titolo; esegui; fine END. (per ottenere la copia su printer dell'immagine video e' utile questa procedura: program ma99; uses graph,mouse,bottone,crt; const maxnvar--S; type tydat=extended; tyvec= array[0..maxnvar] of tydat; var gd,gm,grok,ximx,yimx xtemp,ytemp,xmu,ymu, it,nt,iv,nv,ig,ng :integer; y,ya,r :tyvec; tempofinale,dt,hdt, xmx,ymx,xmn,ymn,xO,yO tydat; uscita:boolean; a:char; procedurederiv; varc,sl,s2,d,d1,d2:tydat; begin c:=cos(y[2]-y[ 1 ]);s L=sin(y[ 1 ]);s2:=sin(y[2]); d:=2-c*c;di:=-2*sl+ c*s2;d2:=-2*s2+c*s; r[0]:=I ; r[1]:=y[3] ; r[2]:=y[4]; r[3]:=dl/d;r[4]:=d2/d end; procedure deriv0; begin r[0]:=I ; r[1]:=y[2] ; r[2]:=-sin(y[1]) end; procedure scamax; begin xmx:=7 ; ymx:=5 ; xmn:=-7 ; ymn:=-5 end; procedure mouseinput(var xr,yr:tydat); var strx,stiy:string; begin modo:=grafica; mostramouse ; setcolor(black); repeat if (xtemp<>xmu )and(ytemp<>ymu) then begin xtemp:=mu;ytemp:=ymu; xr:=xmn+(xmx-xmn)*xmu/ximx; yr=ymx-(ymx-ymn)*ymu/yimx; str(xr:8:4,strx);str(yr:8:4,stry); bar(0,450,150,479); outtextxy(1,465,strx+' '+stry) end until premuto(xmu,ymu)=sinistro; nascondimouse; putpixel(xmu,ymu,13); xr:=xmn+(xmx-mn)*mu/kim; yn=ymx-(ymx-ymn)*ymuffim; end; procedure numin; var strx,stry:string;begin setcolor(red); bar (160,450,225,480);outtextxy(170,465,'xo,yo') readln(xO,yO); str(x0:8:4,strx);str(y0:8:4,stiy); bar(0,450,150,479); outtextxy(1,465,strx+'4- stry) end; procedure assvalin;begin y[1]:=x0;y[2]:=y0;y[3]:=0;y[41:=0end; procedure valin; begin for iv:=0 to nv do ya[iv]:=0 ; x0:=0;y0:=0; y:=ya; mouseinput(x0,y0); if (ymu>450) and (xmu<230) then numin assvalin end; procedure param; begin m=4;tempofinale:=20;ne= 100;ng:= I; write('tempofinale, n.punti,n.passi writeln(tempofinale:8:2,",nt,"Ag); procedure paramt; var np: integer; xt,yt:byte; begin xt:=wherex;yt=wherey; writeln(xmu,ymu',xt,yt);setcolor(13); outtextxy(25,40,'tempofinale, n.punti,n.passi readin(tempofinale,rtp,ng) ; if np=0 then np:=1 ; if ng=0 eden ng:=I nt:=np*ng; dt=tempofinale/nt;hdt=dt/2 end; procedure punto(xr,yr:tydat); var xi,yi:integer; begin xi:=trunc(ximx*(xr-xmn)/(xmx-xmn¯; yi:=trunc(yimx*(ymx-yr)/(ymx-ymn¯; putpixel(xi,yi,14);{ write(xr,yr) end; procedure passo; procedure incre(y tyvec; var ya : tyvec) begin for iv:= 0 to nv do ya[iv]:=y[iv]+hdt*r[iv] end; begin incre (y,ya) ; for ig:=O to 2 do begin incre(yay) ; deriv end end; procedure passoru; const radue=O.707106781186548; a:array[03] of tydat--(0.5,1-radue, l+radue,1.0/6.0); b :array[03] of tydat--(2,1,1,2); c :array[03] of tydat--(0.5,1-radue, l+mdue,0.5); var ir:O3; iv:0..maxnvar; procedure incre(a,b,c,r:tydat ;var y,ya:tydat) var aum,ff:tydat; begin ff:=r*dt; aum:=a*(rr-b*ya); y:=y+aum; ya:=ya+3*aurn-c*rr end; begin for ir:=0 to 3 do begin for iv:=O to nv do incre(a[ir],b[ir],c[ir],r[iv],y[iv],ya[iv]); deriv end end; procedure graf¡ni;begin gd:=O;gm:=O; initgraph(gd,grn,''); grok:=graphresult; write('grok= ', grok); ximx:=getmaxx;yimx:=getmaxy;writeln('',ximx,",yimx) end; procedure clear;begin seffilIstyle(emptyfilI,white); bar(0,0,639,420); seffilistyle(solidflII,white) end; procedure assi; var xi,yi:integer; begin xi:=trunc(x£nx*(-xmn)/(xmx-xmn¯; yi:=tiunc(yimx*(ymx)/(ymx-ymn¯; setcolor(blue); line(xi,0,xi,yimx)jine(O,yi,ximx,yi) end; procedure bandiera; begin setcolor(black); bar (160,450,225,480);outtextxy(170,465,'xo,yo') bar (230,450,295,480);outtextxy(235,465,'hcopy) bar (360,450,425,480);outtextxy(365,465,'cleae); bar (430,450,495,480);outtextxy(435,465,'param'); bar (500,450,565,480);outtextxy(505,465,'assi'); bar (570,450,640,480);outtextxy(575 465 'exiV procedure faicurve; begin valin; repeat deriv; for it:=0 to nt do begin punto(y[ 1 ],y[2]) ; for ig:= 1 to ng do passoru end; punto(y[1],y[2]); valin; until (ymu>450) and (xmu>230) ;end; procedure controlli; begin if xmu<360 then hcopy('prm') else if xmu <430 then clear else if xmu <500 then paramt else if xmu <570 then assi else uscita := true ;end; ( MAIN PROGRAM) begin grafini; param; scamax; assi; repeat bandiera; faicurve ;controlli until uscita=true; closegraph; end. PROCEDURE HCOPY(NomePlotFile:string); CONST ESC = 27; DOPPIA = 76; INTERLINEA = 5 l; VAR Lista: Text; c,s : word; m: ARRAY [0..7] OF word; ij,k,nix,my : integer; BEGIN Assign(Lista,NomePloffile); Rewrite(Lista); m[0]:=128; m[4]:=8; m[1]:=64; m[5]:=4; m[2]:=32; m[6]:=2; m[3]:= 16; m[71:= l; mx := GetMaxX; my := GetMaxY DIV 8; Write(Lista,CHR(ESC),CHR(INTERLINEA),CHR(24¯; FOR i:= 0 TO my DO BEGIN Write(Lista,CHR(ESC),CHR(DOPPIA¯; Write(Lista,CHR((mx+ I) MOD 256¯; Write(Lista,CHR((mx+ I) DIV 256¯; FOR j := 0 TO mx DO BEGIN s:= 0; FOR k:= 0 TO 7 DO BEGIN c:= GetPixelo,i*8+k); IF (c<>O) THEN s:= s+m[k]; END; Write(Lista,CHR(s)); END; Write(1,ista,CHR(10),CHR(13)); END; Close(Lista); END; 1 MAIN PROGRAM) begin grafini; param; scamax; assi; repeat bandiera; faicurve ;controlli until uscita=true; closegraph; end. Unit mouse; interface uses dos; const testo=O; grafica= I; type TipoTasto = (notasto, sinistro, destro); var modo : integer; function premuto(var x,y: integer) : TipoTasto; procedure mostraMouse; procedure nascondiMouse; implementation var regs : Registers; procedure chiamaInt ( a,b,c,d integer); begin with regs do begin ax:=a; bx:=b; cx:=c; dx:=d; end, Intr(5 1, regs); end; function premuto(var x,y: integer) TipoTasto; begin with regs do begin chiamaInt(3,0,0,0); x:=cx; y:=dx; premuto:=notasto; if modo=testo then begin x:=-trunc(x/8)+ I; y:=trunc(y/8)+ I; end; if (bx and 1)= 1 then premuto:=sinistro else if (bx and 2)=2 then premuto:=destro; end; end, procedure mostraMouse; begin chiamaInt(1,0,0,0); ella; procedure nascondiMouse; begin chiamalnt(2,0,0,0); end; end- ( fine unita 1 program ma99; uses graph,mouse; const maxnvar--5; type tydat-- extended; tyvec= array[0..maxnvar] of tydat; var gd,gm,grok,ximx,yimx xtemp,ytemp,xmu,ymu, it,nt,iv,nv,ig,ng :integer; y,ya,r :tyvec; tempofinale,dt,hdt, xmx,ymx,xmn,ymn,xO,yO :tydat; uscita:boolean; a:char; procedurederiv; varc,sl,s2,d,ffi,d2aydat; begin c:=cos(y[2]-y[I]);sl:=sin(y[I]);s2:=sin(y[2]); d:=2-c*c;dI:=-2*sl+ c*s2;d2:=-2*s2+c*sl; r[0]:=I ; r[1]:=y[3] ; r[2]:=y[4]; r[3]:=ffi/d;r[4]:=d2/d end; procedure deriv(); beginr[0]:=I;r[1]:=y[2];r[2]:=-sin(y[I]) end; procedure scamax; begin xmx:=7; ymx:=5; xmn:=-7; ymn:=-5 end; procedure mouseinput(var xr,yr:tydat); var strx,stry:string; begin modo:=grafica; mostramouse ; setcolor(black); repeat if (xtemp<>xmu )and(ytemp<>ymu) then begin xtemp:=mu;ytemp:=ymu; xn=xmn+(xmx-xmn)*mu/xim; yn=ymx-(ymx-ymn)*ymuffim; str(xr: 8:4,strx);str(yr: 8:4,stry); bar(0,450,150,479); outtextxy(1,465,strx+' f+stry) end until premuto(mu,ymu)=sinistro; nascondimouse; putpixel(xmu,ymu,13); xn=xmn+(xmx-mn)*mu/xim; yn=ymx-(ymx-ymn)*ymu/yim; end; procedure numin; var strx,stry:string;begin setcolor(red); bar (1 60,450,225,480);outtextxy(1 70,465,'xo,yo') Al t A Ai- str(x0:8:4,strx);str(y0:8:4,stry); bar(0,450,150,479); outtextxy(1,465,strx+"+stry) end; procedure assvalin ;begin y[ I ]:=A;y[2]:=yO ;y[3):=O;y[4]:=O end; procedure valin; begin for iv:=O to nv do ya[iv]:=0 ; x0:=0;y0:=0; y:=ya; mouseinput(x0,y0); f (ymu>450) and (xmu<230) then numin assvalin end; procedure param; begin nv:=4;tempofinale-=20;nt:=100;ng:=1; write('tempofinale, n.punti,n.passi wnten(tempofinale:8:2,",nt,",ng); dt:=tempofinale/nt ; hdt:=dt/2 end; procedure paramt; var np:integer, xt~yt:byte; beg¡n xt:=wherex;yt=wherey; wr¡teln('xrnu,ymu',xt,yt);setcolor(13); outtextxy(25,40,' tempofinale, n.punti,n.pass readln(tempofinale,np,ng) ; if np=0 then np:=I ; if ng--O then ng :=1 nt:=np*ng; dt=tempofinale/nt;hdc=dt/2 end; procedure punto(xryr:tydat); var xi,yi:integer; begin xi:=trunc(ximx*(xr-xmn)/(xmx-xmn¯; yi:--trunc(yimx*(ymx-yr)/(ymx-ymn¯; putpixel(xi,yi, 14); write(xr,yr) end; procedure passo; procedure incre(y tyvec; var ya : tyvec) begin for iv:= 0 to nv do ya[iv]:=y[ivI+Mt*r[iv] end; begin incre (y,ya) ; for ig:=0 to 2 do begin incre(ya,y) ; deriv end end; procedure passoru; const radue=0.707106781186548; a :array[03] of tydat=(0.5, 1 -radue, l+radue, 1.016.0); b :array[03] of tydat=(2,1,1,2); c :array [03] of tydat=(0.5, 1 -radue, l+radue,0.5); I- procedure incre(a,b,c,r:tydat ;var y,yatydat) ;var aum,rr:tydat; begin rr:=r*dt; aum:=a*(rr-b*ya); y:=y+aum; ya:=ya+3*aum-c*rr end; begin forir:--Oto3do begin foriv:=Otonvdo incre(a[ir],b[¡r],c[ir],r[iv],y[iv],ya[¡v]); deriv end end; procedure grafini;begin gd:=0;grn:=0; ntgraph(gd,gin,"); grok:=graphresult; write('grok= ', grok); xim:=getmaxx;yim:=getmaxy; writeln('',ximx,'',yimx) end; procedure clear;begin seffilIstyle(emptyfilI,white); bar(0,0,639,420); seffilIstyle(solidflII,white) end; procedure assi; var x¡,yi:integer; begin xi:=trunc(ximx*(-xmn)/(xmx-xmn)); yi:=trunc(yimx*(ymx)/(ymx-ymn)); setcolor(blue); line(xi,0,x¡,yimx);Iine(0,yi,ximx,yi) end; procedure bandiera; begin seteolor(black); bar (1 60,450,225,480);outtextxy(1 70,465,'xo,yo') bar (230,450,295,480);outtextxy(235,465,'hcopy') bar (360,450,425,480);outtextxy(365,465,'cleae); bar (430,450,495,480);outtextxy(435,465,'param'); bar (500,450,565,480);outtextxy(505,465,assi'); bar (570,450,640,480);outtextxy(575,465,'exit') end; procedure faicurve; beg¡n valin; repeat deriv; for it:=0 to nt do begin punto(y[ I ],y[2])for ig:= 1 to ng do passoru end; punto(y[ 1 ],y[2]) valin ; until (ymu>450) and (xmu>230) ;end; procedure controlli; begin ¡f xmu<360 then hcopy('pm') else if xmu <430 then clear else f xmu <500 then pararnt else if xmu <570 then assi else uscita := true ;end;