uses dos,crt; const info:array[1..9] of string= ( ' {---------------------------------------------------------------}', ' {si param1= `?`, alors param2 doit être le premier rayon, }', ' { param3 le second rayon ' { param4 la distance de la seconde sphere }', ' {si param1= `d`, alors param2 doit être le rayon de la lentille }', ' { param3 le premier rayon   ' { param4 le second rayon ' { les donnés sont sauvegardées dans un fichier texte `.inc` }', ' {---------------------------------------------------------------}');
var r1,r2, a,b,c, mf1,mf2, x,y, o1,o2, o3,o4, o31,o41   errc,int,int0 &n ch st,st0,st1,st2,st3,st4,sto3,sto4,sto31,sto41,sty : string; f : text; dinf : searchrec;
begin st:=paramstr(1); ch:=st[1]; if paramstr(1)='' then begin for errc:=1 to 9 do writeln(info[errc]); halt(0); end; case ch of '?': begin val(paramstr(2),r1,errc); val(paramstr(3),r2,errc); val(paramstr(4),o2,errc);
o1:=0;
mf1:=r1; mf2:=r2;
c:=(o1+o2)/2; a:=(mf1+mf2)/2; b:=sqrt((a*a)-(c*c));
x:=((mf1-a)*a)/c; y:=sqrt((b*b)*(1-(x*x)/(a*a)));
writeln(y:4:4);
o3:=sqrt((r1*r1)-(y)*(y)); o4:=sqrt((r2*r2)-(y)*(y)); o2:=o3+o4; o31:=r2-o4; o41:=r1-o3; end;
'd': begin val(paramstr(2),y,errc); if paramstr(3)<>'' then begin if paramstr(4)<>'' then begin val(paramstr(3),r1,errc); val(paramstr(4),r2,errc); end else begin val(paramstr(3),r1,errc); r2:=r1; end; mf1:=r1; mf2:=r2; o3:=sqrt((r1*r1)-(y)*(y)); o4:=sqrt((r2*r2)-(y)*(y)); o2:=o3+o4; o31:=r2-o4; o41:=r1-o3; end else begin r1:=y*2; mf1:=r1; mf2:=r2; o3:=sqrt((r1*r1)-(y)*(y)); o4:=sqrt((r2*r2)-(y)*(y)); o2:=o3+o4; o31:=r2-o4; o41:=r1-o3; end; writeln(o2:4:4); end; end;
o2:=o2/2; str(r1:4:4,st1); str(r2:4:4,st2);
str(o2:4:4,st3); str(o3:4:4,sto3); str(o4:4:4,sto4);
str(o31:4:4,sto31); str(o41:4:4,sto41);
str(y:4:4,sty);
findfirst('lentil*.inc',$10,dinf); if doserror<>0 then begin assign(f,'lentil00.inc'); rewrite(f); st0:='lentil00'; end else begin while doserror=0 do findnext(dinf); st0:= copy(dinf.name,1,pos('.', dinf.name)-2); st0[0]:=chr(6); st4:= copy(dinf.name,pos('.', dinf.name)-2,2); if st4[1]='0' then st4[1]:=' '; val(st4,int,errc); while st4[1]='0' do delete(st4,1,1); inc(int); str(int:2,st4); if st4[1]=' ' then st4[1]:='0'; st0:=st0+st4; for int0:=1 to 8 do if st0[int]=' ' then st0[int]:='0'; st:=st0+'.inc'; writeln('crétaion de ',st,' o/n ?'); ch:=readkey; if (ch='n') or (ch='N') then halt(0) else begin assign(f,st); rewrite(f); end end;
writeln(f,'declare '+st0+' ='); writeln(f,'object{'); writeln(f,'intersection{'); writeln(f,' sphere{<0,0,-'+sto3+'>,'+st1+' } '); writeln(f,' sphere{<0,0,'+sto4+'>,'+st2+' } '); writeln(f,' } ' ); writeln(f,'// diamètre de la lentille:'+sty); writeln(f,' bounded_by{'); writeln(f,' object{'); writeln(f,'box{<-'+sty+',-'+sty+',-'+sto31+'>,<'+sty+',' +sty+','+sto41+'>}}}'); writeln(f,'texture{ Glass9}'); writeln(f,' } ' );
close(f); end.
|
|