Пишу в этом разделе, т.к. графика (и моя трабла) очень близка именно к играм
Собственно что мне надо - есть какая-то картинка (спрайт или т.п.), скажем 200x210.
Ее треба перемещать на экране по заданной траектории (не важно какой именно).
Проблема в том, что нужно устранить мерцание при движении спрайта (/фигуры)...
Что пробовал:
1. Стандартные фишки типа Getimage/putimage XOR'ом для рисования и стирания
2. Смена видеостраниц (двойная буферизация, тратата..) - что-то не очень-то помогает.
К тому же мне хотелось бы использовать режим 640x480 - а это VGAHi и у него только 1 видеостраница.
3. Синхронизация с обратным ходом лучей - нечто мистическое (думается для CRT моников самое то), но у меня LCD и ускорения или устранения мерцания таким вот образом я не наблюдаю
4. Нашел в инете статейки со вставками на асме и т.п. - асм юзать не хочется, т.к. в нем ничерта не понимаю
Из более-менее схожего - есть обращение к видеопамяти напрямую - $A000:$0000 - начиная отсюда и далее.
Дык вот, внимание, сам вопрос (барабанная дробь):
Как в этом самом режиме VGAHi 640x480@16 устроена эта самая видеопамять?
Т.е. как она представлена в памяти? 16 цветов - это типа полбайта на пиксель чтоли?
В общем хелп ми
P.S.: Можно ли в каких-нибудь настройках форума сделать так, чтобы все сообщения в теме выводились полностью, а не по одному и с деревом снизу - как-то непривычно...
1. При использовании буфера в памяти, мерцания не видно даже без обратного хода луча. А с ним не должно быть заметно и при переключении видео страниц. Покажи код, иначе не разберёмся в чём твоя трабла.
2. Ага, 4 бита на пиксел. Используй побитовые сдвиги и логические операции.
3. Насчёт твоего PS, не знаю. Этот форум даже в текстовой версии выводит все сообщения сразу.
program RO_i_OI_lab02_ver05;
uses crt,graph;
var cl,bcl:integer;
xbase,ybase:integer;
P: Pointer;
Size: Word;
vis,act:boolean;
c:char;
oldx,oldy,x,y,alf1,alf2,delt1,delt2:real;
fl,t:integer;
{--------------------------------------------}
procedure InitGr;
var
grDriver: Integer;
grMode: Integer;
ErrCode: Integer;
begin
grDriver := Detect;
InitGraph(grDriver, grMode,'');
ErrCode := GraphResult;
if not (ErrCode = grOk) then begin
writeln('Graphics error:', GraphErrorMsg(ErrCode));
end;
end;
procedure CloseGr;
begin
CloseGraph;
end;
{--------------------------------------------}
procedure drawLine(xx1,yy1,xx2,yy2:integer);
var k,b:real;
x1,y1,x2,y2:real;
Xmax,Xmin,Ymax,Ymin:real;
xr,yr,delta:real;
dl:integer; {delay}
begin
dl:=0;
{integer -> real}
x1:=xx1;
x2:=xx2;
y1:=yy1;
y2:=yy2;
if x1>=x2 then begin Xmax:=x1; Xmin:=x2; end {switch X, x1<x2, x1=Xmin, x2=Xmax}
else begin Xmax:=x2; Xmin:=x1; end;
if y1>=y2 then begin Ymax:=y1; Ymin:=y2; end {switch Y, y1<y2, y1=Ymin, y2=Ymax}
else begin Ymax:=y2; Ymin:=y1; end;
if x1<>x2 then begin {y=k*x+b, Xmin<=x<=Xmax, Ymin<=y<=Ymax}
k:=(y2-y1)/(x2-x1);
b:=y1-k*x1;
xr:=Xmin;
delta:=0.1; {step}
repeat
yr:=k*xr+b; {1st step: yr:=y1}
putpixel(trunc(xr),trunc(yr),cl);
delay(dl);
xr:=xr+delta;
until (xr>Xmax);
end
else begin {x=x1=x2=const, Ymin<=y<=Ymax }
if y1=y2 then begin {line->point}
putpixel(xx1,yy1,cl); {x1=x2, y1=y2}
end
else begin {vertical line}
delta:=1;
xr:=x1; {x1=x2}
yr:=Ymin;
repeat
putpixel(trunc(xr),trunc(yr),cl);
yr:=yr+delta;
delay(dl);
until (yr>Ymax);
end;
end;
end;
{--------------------------------------------}
procedure drawCircle(xx,yy,rr:integer);
var x,y,r:real;
alpha,delta:real;
dvaPi:real;
dl:integer;
begin
dl:=0;
{integer->real}
r:=rr;
dvaPi:=2*pi;
delta:=0.01; {step of angle}
alpha:=0;
repeat
x:=r*cos(alpha);
y:=r*sin(alpha);
putpixel(trunc(x)+xx,trunc(y)+yy,cl);
alpha:=alpha+delta;
delay(dl);
until alpha>dvaPi;
end;
{--------------------------------------------}
procedure drawEllipse(xx,yy,xxr,yyr:integer);
var x,y,xr,yr:real;
alpha,delta:real;
dvaPi:real;
dl:integer;
begin
dl:=0;
{integer->real}
xr:=xxr;
yr:=yyr;
dvaPi:=2*pi;
delta:=0.01; {step of angle}
alpha:=0;
repeat
x:=xr*cos(alpha);
y:=yr*sin(alpha);
putpixel(trunc(x)+xx,trunc(y)+yy,cl);
alpha:=alpha+delta;
delay(dl);
until alpha>dvaPi;
end;
{--------------------------------------------}
procedure drawRectangle(x1,y1,x2,y2:integer);
begin
drawline(x1,y1,x2,y1);
drawline(x2,y1,x2,y2);
drawline(x2,y2,x1,y2);
drawline(x1,y2,x1,y1);
end;
{--------------------------------------------}
procedure drawman(xbase,ybase:integer);
begin
drawrectangle(xbase-20,ybase-25,xbase+20,ybase+25); {telo}
drawcircle(xbase,ybase-45,12); {golova}
{left arm}
drawline(xbase-5,ybase-25,xbase-35,ybase-65); {h\}
drawline(xbase-20,ybase-25,xbase-40,ybase-65); {\h}
{right arm}
drawline(xbase+5,ybase-25,xbase+35,ybase-65); {/h}
drawline(xbase+20,ybase-25,xbase+40,ybase-65); { h/}
{hands}
drawcircle(xbase-41,ybase-72,8); {left hand}
drawcircle(xbase+41,ybase-72,8); {right hand}
{weight - central part}
drawline(xbase-34,ybase-74,xbase+34,ybase-74); {--}
drawline(xbase-34,ybase-71,xbase+34,ybase-71); {--}
{weight - left part}
drawline(xbase-50,ybase-74,xbase-65,ybase-74); {--}
drawline(xbase-50,ybase-71,xbase-65,ybase-71); {--}
drawrectangle(xbase-70,ybase-94,xbase-65,ybase-49); {blin1}
drawrectangle(xbase-77,ybase-94,xbase-72,ybase-49); {blin2}
drawrectangle(xbase-84,ybase-84,xbase-79,ybase-59); {blin3 small}
drawrectangle(xbase-95,ybase-74,xbase-86,ybase-71); {end}
{weight - right part}
drawline(xbase+50,ybase-74,xbase+65,ybase-74); {--}
drawline(xbase+50,ybase-71,xbase+65,ybase-71); {--}
drawrectangle(xbase+70,ybase-94,xbase+65,ybase-49); {blin1}
drawrectangle(xbase+77,ybase-94,xbase+72,ybase-49); {blin2}
drawrectangle(xbase+84,ybase-84,xbase+79,ybase-59); {blin3 - small}
drawrectangle(xbase+95,ybase-74,xbase+86,ybase-71); {end}
{left leg}
drawline(xbase-20,ybase+25,xbase-35,ybase+88); {/l}
drawline(xbase,ybase+40,xbase-30,ybase+90); { l/}
drawcircle(xbase-35,ybase+95,8); {left foot} {o}
{right leg}
drawline(xbase+20,ybase+25,xbase+35,ybase+88); { l\}
drawline(xbase,ybase+40,xbase+30,ybase+90); {\l}
drawcircle(xbase+35,ybase+95,8); {right hand} {o}
end;
{--------------------------------------------}
procedure switchvisual(var f:boolean);
begin
if f then begin
setvisualpage(1);
f:=false;
end
else begin
setvisualpage(0);
f:=true;
end;
end;
procedure switchactive(var f:boolean);
begin
if f then begin
setactivepage(1);
f:=false;
end
else begin
setactivepage(0);
f:=true;
end;
end;
{--------------------------------------------}
procedure WaitVerticalRetrace;
begin
while (port[$3da] and 8)=0 do;
end;
{--------------------------------------------}
begin
cl:=10;
bcl:=0;
InitGr;
Setcolor(cl);
Setbkcolor(bcl);
Cleardevice;
xbase:=round(getMaxX/2);
ybase:=round(getMaxY/2);
{===============PREPARE=============================================}
{draw man}
drawman(xbase,ybase);
readln;
{copy image}
Size := ImageSize(xbase-95,ybase-95,xbase+95,ybase+103);
GetMem(P, Size); { Allocate memory on heap }
GetImage(xbase-95,ybase-95,xbase+95,ybase+103,p^);
{paste image: NormalPut, XORPut, NotPut}
PutImage(xbase-95,ybase-95,p^,XORPut);
{================================================================}
setgraphmode(VGAMed); {640x350, 2 videopages}
setvisualpage(0);
setactivepage(0);
cleardevice;
xbase:=round(getMaxX/2);
ybase:=round(getMaxY/2);
x:=xbase;
y:=ybase;
oldx:=x;
oldy:=y;
c:=' ';
xbase:=round(getmaxX/2-95);
ybase:=round(getmaxY/2-95);
x:=xbase;
y:=ybase;
alf1:=0;
alf2:=0;
delt1:=0.07;
delt2:=0.07;
x:=xbase+80*sin(alf1);
y:=ybase+80*sin(alf2);
act:=true;
vis:=true;
{draw}
PutImage(round(x),round(y),p^,XORPut);
switchvisual(vis); {vis=false}
fl:=0;
repeat
{waitverticalretrace;}
switchvisual(vis);
{c:=readkey;}
switchactive(act);
{clear}
if fl<>0 then begin
PutImage(round(oldx),round(oldy),p^,XORPut);
end else begin
fl:=fl+1;
end;
{change}
oldx:=x;
oldy:=y;
alf1:=alf1+delt1;
alf2:=alf2+delt2;
x:=xbase+80*sin(alf1);
y:=ybase+80*sin(alf2);
{draw}
PutImage(round(x),round(y),p^,NormalPut);
{delay, show}
if keypressed then c:=readkey;
until c=chr(27);
CloseGr;
end.
Да... забыл добавить - программлю в Borland Pascal'е....
Добавлено через 1 мин.
Как читать пиксел - не знаю, но вот про запись:
Port[$03C4] := 2;
после этого можно менять битовые плоскости для вывода
Port[$03C5] := A;
Число A от 0 до 15. Пусть оно в двоичной системе счисления имеет вид 1001. Это означает, что после этого момента запись будет идти в нулевую и третью плоскости - соостветственно ненулевым битам числа A. По умолчанию запись идёт во все 4 плоскости.
Могу предложить свой модуль. Буферный вывод без асма - это ничего хорошего, потому что массовые копирования областей памяти с помощью процедуры Move делаютcя похоже командой movsb, которая вдвое медленней команды movsw. Советую обратить внимание на типы TLayer и TScreenBuffer и на процедуры InitGraph, CloseGraph, ClearBuffer, OutBuffer (она самая важная - имеет один параметр - количество приёмов, в которое будет идти вывод. Слишком много - нельзя, так как будет тормозить, слишком мало - нельзя, так как плоскости будут выводиться по очереди и в те милисекунды между выводом плоскостей картинка имеет странные цвета, и при малых значениях параметра глаз это видит). Ну и на процедуру PutPixel - вывод пиксела в буфер. Остальное - по ходу дела наслоилось. Минусы - буфер жрёт немеренно памяти, поэтому либо вообще программу нельзя будет из Паскаля запускать (только екзешник), либо указать компилятору (Options -> Memory Sizes -> StackSize поменять допустим на 16000), чтобы он для стека поменьше памяти забрал (но учтите, что слишком маленький стек может заглючить программу). И ещё вывод буфера - операция долгая (хотя все равно втрое быстрее, чем ClearViewPort)
Прикрепленные файлы
VGAGRAPH.PAS ( 36.58 килобайт )
Кол-во скачиваний: 385
мерцание устранилось видеостраницами и синхронизацией в использовании TMT паскаля....
но есть одно НО.... http://forum.pascal.net.ru/index.php?showtopic=16631