атом, проверьте Опции

[sheka]

визуализация атома.
подскажите пожалуйста:
1. как ускорить прогу;
2. при старте остаются следы електронов - как их убрать.

uses crt,graph;

const
  re=5;
  rp=15;
  a=40;
  b=100;
  cx=320;
  cy=240;
  kel=10;
  kor=15;
  kpr=13;
  z1=0;
  z2=110;
  z3=50;
  z4=230;

var
  ugol:integer;
  p:pointer;
  xn,yn:integer;

procedure initialization; var gd,gm:integer; begin gd:=detect; initgraph(gd,gm,''); end;

procedure vihod;
var c:char;
begin
if keypressed then begin
  c:=readkey;
  if c=#13 then begin
	dispose(p);
	closegraph;
	halt;
	end;
  end;
end;

procedure ell(angl:real);
var x0,y0,xn,yn:real; i:integer;
begin
setcolor(kor);
for i:=0 to 359 do
begin
x0:=a*cos(i/180*pi);
y0:=b*sin(i/180*pi);
xn:=cx+x0*cos(angl)-y0*sin(angl);
yn:=cy+x0*sin(angl)+y0*cos(angl);
putpixel(round(xn),round(yn),15);
end;
end;

procedure atom1;
begin
putimage(cx+round(a*cos((ugol+z1-1)*pi/180)),
		 cy+round(b*sin((ugol+z1-1)*pi/180)),p^,1);
putimage(cx+round(a*cos((ugol+z1)*pi/180)),
		 cy+round(b*sin((ugol+z1)*pi/180)),p^,0);
end;

procedure atom2;
begin
putimage(cx+round(b*sin((ugol+z2-1)*pi/180)),
		 cy+round(a*cos((ugol+z2-1)*pi/180)),p^,1);
putimage(cx+round(b*sin((ugol+z2)*pi/180)),
		 cy+round(a*cos((ugol+z2)*pi/180)),p^,0);
end;

procedure atom3;
var x0,y0,xn,yn:real; i:integer;
begin
x0:=a*cos((ugol+z3-1)/180*pi);
y0:=b*sin((ugol+z3-1)/180*pi);
xn:=cx+x0*cos(pi/4)-y0*sin(pi/4);
yn:=cy+x0*sin(pi/4)+y0*cos(pi/4);
putimage(round(xn),round(yn),p^,1);
x0:=a*cos((ugol+z3)/180*pi);
y0:=b*sin((ugol+z3)/180*pi);
xn:=cx+x0*cos(pi/4)-y0*sin(pi/4);
yn:=cy+x0*sin(pi/4)+y0*cos(pi/4);
putimage(round(xn),round(yn),p^,0);
end;

procedure atom4;
var x0,y0,xn,yn:real; i:integer;
begin
x0:=a*cos((ugol+z4-1)/180*pi);
y0:=b*sin((ugol+z4-1)/180*pi);
xn:=cx+x0*cos(-pi/4)-y0*sin(-pi/4);
yn:=cy+x0*sin(-pi/4)+y0*cos(-pi/4);
putimage(round(xn),round(yn),p^,1);
x0:=a*cos((ugol+z4)/180*pi);
y0:=b*sin((ugol+z4)/180*pi);
xn:=cx+x0*cos(-pi/4)-y0*sin(-pi/4);
yn:=cy+x0*sin(-pi/4)+y0*cos(-pi/4);
putimage(round(xn),round(yn),p^,0);
end;



begin
initialization;
setbkcolor(0);
clearviewport;
setcolor(kel);setfillstyle(1,kel);pieslice(re,re,0,360,re);
new(p);
getmem(p,imagesize(1,1,2*re+1,2*re+1));
getimage(0,0,2*re,2*re,p^);

clearviewport;
setcolor(kpr); setfillstyle(1,kpr);pieslice(cx,cy,0,360,rp);
ugol:=0;
while true do begin
ellipse(cx,cy,0,360,a,b);
ellipse(cx,cy,0,360,b,a);
ell(pi/4);
ell(-pi/4);
  atom1;
  atom2;
  atom3;
  atom4;
  vihod;
  inc(ugol);if ugol=360 then ugol:=0;
  end;
end.

Сообщение отредактировано: sheka - 4.06.2009 21:40

[volvo]

А чего она у тебя на каждом шаге перерисовывает повернутый эллипс? Ресурсы только жрет этим. И замедляется...

1. Для того, чтоб отобразить движение предметов, не обязательно вызывать PutImage с NotmalPut, а потом - с XORput. Достаточно отобразить XORput-ом, потом чуть-чуть подождать, и опять отобразить тем же самым XORput-ом... Лишние вызовы PutImage убрал, сделал еще одну процедуру draw_atoms, если понадобится еще ускорить - запоминай положения атомов в массиве (у тебя если на то пошло всего 360 значений угла, и массив из 360*4(атома)*2(координаты X, Y)*4(размер одного вещественного числа) даже Турбо Паскаль вполне потянет, всего 11Кб)

uses crt,graph;
const
  re=5;
  rp=15;
  a=40;
  b=100;
  cx=320;
  cy=240;
  kel=10;
  kor=15;
  kpr=13;
  z1=0;
  z2=110;
  z3=50;
  z4=230;
var
  ugol:integer;
  p:pointer;
  xn,yn:integer;
  cycle: boolean;
procedure init;
var gd,gm:integer;
begin gd:=detect; initgraph(gd,gm,''); end;

procedure vihod;
var c:char;
begin
if keypressed then begin
  c:=readkey;
  if c=#13 then begin
	closegraph;
	halt;
	end;
  end;
end;
procedure ell(angl:real);
var x0,y0,xn,yn:real; i:integer;
begin
setcolor(kor);
for i:=0 to 359 do
begin
x0:=a*cos(i/180*pi);
y0:=b*sin(i/180*pi);
xn:=cx+x0*cos(angl)-y0*sin(angl);
yn:=cy+x0*sin(angl)+y0*cos(angl);
putpixel(round(xn),round(yn),15);
end;
end;
procedure atom1;
begin
putimage(cx+round(a*cos((ugol+z1-1)*pi/180)),
		 cy+round(b*sin((ugol+z1-1)*pi/180)),p^,1);
end;
procedure atom2;
begin
putimage(cx+round(b*sin((ugol+z2-1)*pi/180)),
		 cy+round(a*cos((ugol+z2-1)*pi/180)),p^,1);
end;
procedure atom3;
var x0,y0,xn,yn:real; i:integer;
begin
x0:=a*cos((ugol+z3-1)/180*pi);
y0:=b*sin((ugol+z3-1)/180*pi);
xn:=cx+x0*cos(pi/4)-y0*sin(pi/4);
yn:=cy+x0*sin(pi/4)+y0*cos(pi/4);
putimage(round(xn),round(yn),p^,1);
end;
procedure atom4;
var x0,y0,xn,yn:real; i:integer;
begin
x0:=a*cos((ugol+z4-1)/180*pi);
y0:=b*sin((ugol+z4-1)/180*pi);
xn:=cx+x0*cos(-pi/4)-y0*sin(-pi/4);
yn:=cy+x0*sin(-pi/4)+y0*cos(-pi/4);
putimage(round(xn),round(yn),p^,1);
end;
procedure draw_atoms;
begin
  atom1;
  atom2;
  atom3;
  atom4;
end;

begin
  writeln(normalput);
  init;
  setbkcolor(0);
  clearviewport;
  setcolor(kel);setfillstyle(1,kel);pieslice(re,re,0,360,re);
  getmem(p,imagesize(1,1,2*re+1,2*re+1));
  getimage(0,0,2*re,2*re,p^);
  clearviewport;
  setcolor(kpr); setfillstyle(1,kpr);pieslice(cx,cy,0,360,rp);
  ugol:=0;

  ellipse(cx,cy,0,360,a,b);
  ellipse(cx,cy,0,360,b,a);
  ell(pi/4);
  ell(-pi/4);
  draw_atoms;

  while true do begin
    draw_atoms;

    vihod;
    inc(ugol);if ugol=360 then ugol:=0;

    draw_atoms;
    delay(15); { <--- С этой задержкой можно поиграться }
  end;
end.

2. У тебя некорректно выделялась память: New не работает с бестиповыми указателями, я убрал этот лишний вызов. Освободить память при выходе из программы не забудь, там тоже был неправильный вызов Dispose(p), но ты выделял память через GetMem, значит, надо освобождать через парную процедуру: FreeMem.

[sheka]

[quote name='volvo' date='4.06.2009 18:18' post='134499']

[quote]writeln(normalput);[/quote] что это такое?

[quote]1. Для того, чтоб отобразить движение предметов, не обязательно вызывать PutImage с NotmalPut, а потом - с XORput. Достаточно отобразить XORput-ом, потом чуть-чуть подождать, и опять отобразить тем же самым XORput-ом...

Код

  while true do begin
    draw_atoms;

    vihod;
    inc(ugol);if ugol=360 then ugol:=0;

    draw_atoms;
  end;
end.

[/quote]
почему это так? в какой момент происходит зарисовка прошлого рисунка?


[/quote]FreeMem.
[/quote]
память запоминать ту,которую брал при выделении в отдельную переменную?

[volvo]

writeln(normalput); что это такое?

Это можешь убрать. Я просто терпеть не могу, когда вместо именованных констант, специально введенных в разных библиотеках, используют ничего не значащие числа. Просто проверял, NormalPut - это 0 или 1...

почему это так? в какой момент происходит зарисовка прошлого рисунка?

При первом вызове draw_atoms (перед циклом) эти самые атомы устанавливаются в начальную позицию. Потом, входим в цикл и начинаем: первый вызов draw_atoms внутри цикла затирает изображение атомов, поскольку если одно и то же изображение дважды наложить с маской XorPut, то останется только фон, самое изображение уничтожится (для примера, возьми число, скажем, 234, и сделай дважды ему побитовый XOR с любым другим числом. После второго XOR-а опять останется число 234. С изображениями - тот же принцип). Потом меняем угол, и второй вызов draw_atoms в цикле отображает атомы уже на новых позициях...

память запоминать ту,которую брал при выделении в отдельную переменную?

Для того, чтоб правильно освободить память, надо знать, сколько ее было выделено. Вот так:

var buf_size: word; { <-- глобально }

  buf_size := imagesize(1,1,2*re+1,2*re+1);
  getmem(p, buf_size);
  getimage(0,0,2*re,2*re,p^);

, а освобождать - так:

  freemem(p, buf_size);