All pastes #966458 Raw Edit

Unnamed

public text v1 · immutable
·published 2008-04-01 19:20 UTC
rendered paste body
program multimea_S; {multimea S in baza i-1} 
{$N+} 
uses graph, crt; 
const NrCfMax=32; 
type complex=record re, im: Real end; 
var gd, gm: Integer; 
remax, immax,remin,immin: Real; 
cul, nfig,n: Word; 
i, j: Longint; 
sum, z: complex; 
function xprim(x:real): Integer; 
begin 
xprim:=round((getmaxx-10)*(x-remin)/(remax-remin)) 
end; 
function yprim(y:Real): Integer; 
begin 
yprim:=round((getmaxy-10)*(y-immax)/(immin- immax)) 
end; 
function citeste_bit(k:Longint;poz:Byte): Byte; 
const l: longint=1; 
begin 
if k and(l Shl (poz-1))=0 then citeste_bit:=0 
else citeste_bit:=1 
end; 
function pow(k:longint): Real; 
begin 
if odd(k) then pow:=-exp(k*ln(0.25)) 
else pow:=exp(k*ln(0.25)) 
end; 
procedure putere(k:Integer; var rez:complex); 
var cit, rest :Integer; 
p: Real; 
begin 
cit:=-k div 4; rest:=-k mod 4; p:=pow(cit); 
case rest of 
0: begin rez.re:= p; rez.im:=0 end; 
1: begin rez.re:=p*(-0.5); rez.im:=p*(-0.5) end; 
2: begin rez.re:=0; rez.im:=p*0.5 end; 
3: begin rez.re:=p*0.25; rez.im:=p*-0.25 end 
end 
end; 
begin {main} 
Write('nr. cifre zecimale(maxim ',NrCfMax,'): '); 
Readln(n); 
if n>NrCfMax then begin Writeln('prea multe cifre'); Readln; Exit end; 
Write('nr. de figuri congruente(putere a lui 2): '); Readln(nfig); 
gd:=0; Initgraph(gd, gm, 'c:\bp\bgi'); 
if Graphresult<>0 then begin Write('eroare initializare'); Readln; Exit end; 
remin:=-1; remax:=1; immin:=-1; immax:=1; 
{fereastra afisare} 
Setcolor(8); 
Moveto(xprim(remin), yprim(0)); {linii, axe} 
Lineto(xprim(remax), yprim(0)); 
Moveto(xprim(0), yprim(immin)); Lineto(xprim(0), yprim(immax)); 
Moveto(xprim(remin), yprim(immin)); Lineto(xprim(remax), yprim(immin)); 
Moveto(xprim(remax), yprim(immax)); Lineto(xprim(remax), yprim(immin)); 
Moveto(xprim(remin), yprim(immin)); Lineto(xprim(remin), yprim(immax)); 
Moveto(xprim(remax), yprim(immax)); Lineto(xprim(remin), yprim(immax)); 
i:=0; 
while (i<exp(n*ln(2))) and not Keypressed do 
begin 
sum.re:=0; sum.im:=0; 
for j:=1 to n do 
if citeste_bit(i,j)=1 then begin 
putere(-j, z); 
sum.re:=sum.re+z.re; 
sum.im:=sum.im+z.im; 
end; 
if nfig<=16 then cul:=i mod nfig 
{calcul pt. culoare pixel} 
else cul:=(i mod nfig) div (nfig div 16); 
if cul=0 then cul:=8; 
Putpixel(xprim(sum.re), yprim(sum.im), cul); 
{desenarea unui punct al fig.} 
Inc(i); 
end; 
Outtextxy(0, 0, 'gata'); 
Readln 
end.