Добрый день! Нужна помощь в решении такой задачи: Построить движущегося вправо,влево.. человечка с анимированными конечностями с помощью псевдографики, с использованием собственных процедур, никаких модулей кроме CRT использовать нельзя. Собственно не могу сделать руки, получается либо сделать их подвижными по оси Y, но по оси X они не двигаются, либо наоборот
Код для построения человечка написал:
uses CRT; var g,i:integer;
procedure circle(Radius,Horizontal,Vertical:integer); var l,x,y:integer; begin for l:=0 to 360 do begin x:=round(Radius*sin(l)+Horizontal); y:=round(Radius*cos(l)+Vertical); GoToXY(x,y); write('*'); end end;
procedure HorizontalLine(y,b1,b2:integer); begin for g:=b1 to b2 do begin GoToXY(g,y); writeln('*'); end end;
procedure VerticalLine(x,b1,b2:integer); begin for g:=b1 to b2 do begin GoToXY(x,g); writeln('*'); end end;
begin clrscr; for i:=1 to 60 do begin textcolor(red);
-------------------------------------------------------------------------- Помогите пожалуйста приклеить к нему руки+еще чтобы двигались вправо и вверх вниз, вообщем что руками махал)) сам похоже уже не справлюсь
Тегами для подсветки кода пользуйся...
bakalava92
19.10.2009 21:13
знакомые вроде как сказали что агоритм брезенхема можно использовать, но как это осуществить без модуля graph не нашел, знакомые тоже с алгоритмом этим не сталкивались, только слышали, помогите кто может пожалуйста!
Lapp
20.10.2009 15:33
Цитата(bakalava92 @ 19.10.2009 18:13)
агоритм брезенхема можно использовать, но как это осуществить без модуля graph не нашел,
При чем тут модуль Graph? Он же его все равно реализует только для внутренних своих нужд.
Непонятно, как ты не нашел его. Есть в Википедии, например. Попробуй сделать с ним линию (x1,y1,x2,y2). Начни хотя бы. Поможем.
bakalava92
20.10.2009 20:32
uses CRT; var g,i:integer;
procedure circle(Radius,Horizontal,Vertical:integer); var l,x,y:integer; begin for l:=0 to 360 do begin x:=round(Radius*sin(l)+Horizontal); y:=round(Radius*cos(l)+Vertical); GoToXY(x,y); write('*'); end; end;
procedure HorizontalLine(y,b1,b2:integer); begin for g:=b1 to b2 do begin GoToXY(g,y); writeln('*'); end; end;
procedure VerticalLine(x,b1,b2:integer); begin for g:=b1 to b2 do begin GoToXY(x,g); writeln('*'); end; end;
procedure line(x1,y1,x2,y2:integer;sim:string); {liniya - algoritm Bresenhema} var g,x,y,dx,dy,s1,s2,e,i:integer; begin x:=x1; y:=y1; dx:=abs(x2-x1); dy:=abs(y2-y1); if x2-x1>0 then s1:=1 else if x2-x1<0 then s1:=-1 else s1:=0; if y2-y1>0 then s2:=1 else if y2-y1<0 then s2:=-1 else s2:=0; if dy<=dx then begin e:=2*dy-dx; for i:=0 to dx do begin gotoxy(x,y); write(sim); if e>=0 then begin y:=y+s2; e:=e-2*dx; end; e:=e+2*dy; x:=x+s1; end; end else begin e:=2*dx-dy; for i:=0 to dy do begin gotoxy(x,y); write(sim); if e>=0 then begin x:=x+s1; e:=e-2*dy; end; e:=e+2*dx; y:=Y+s2; end; end; end;
begin g:=1; clrscr; for i:=1 to 50 do begin textcolor(red);
сделал! правда руки все равно не знаю как сделать чтобы двигались вверх-вниз..(вообще то знаю,но тогда они по оси X двигаться не будут, не знаю как объеденить) и еще такая штука не знаю почему, но программа не заканчивается после нажатия кнопки, приходиться ctrl+break использовать, кто знает как поправить, поправте пожалуйста, извините, что туплю так, но в программировании я почти 0, но есть жедание научиться!
bakalava92
21.10.2009 2:56
Помогите пожалуйста!!! хотя бы с until keypressed`ом который у меня почему то не работает, в четверг сдавать нужно, а программа даже нормально не закрывается
ammaximus
21.10.2009 18:14
1. достаточно просто написать
until keypressed
2. Где repeat?
3. Вот рисую линии с помощью алгоритма Брезенхема:
uses crt; var i:integer;
procedure line(x0,y0,x1,y1:integer); var x,y:integer; begin if (x0=x1) then begin {func goriz - ТВОЯ ФУНКЦИЯ ГОРИЗОНАЛЬНОЙ ЛИНИИ} exit; end; if (y0=y1) then begin {func vert - ВЕРТИКАЛЬНОЙ} exit; end;
{РИСУЕМ} for x:=x0 downto x1 do begin GotoXY(x,round ( ((y1-y0) / (x1-x0)) * (x-x0)+y0)); write('*'); end;
for y:=y0 downto y1 do begin GotoXY(round ( ((y-y0) / (y1-y0)) * (x1-x0)+x0), y); write('*'); end;
for x:=x0 to x1 do begin GotoXY(x,round ( ((y1-y0) / (x1-x0)) * (x-x0)+y0)); write('*'); end;
for y:=y0 to y1 do begin GotoXY(round ( ((y-y0) / (y1-y0)) * (x1-x0)+x0), y); write('*'); end;
end;
begin clrscr; line(10,10,11,20); line(10,10,25,14); line(10,10,2,2); line(10,10,15,3); line(10,10,3,15); readkey;
end.
Я не стал писать конструкции if в построении, неверные ситуации итак игнорируются. Рисует во все стороны.
andriano
21.10.2009 22:34
Цитата(ammaximus @ 21.10.2009 15:14)
3. Вот рисую линии с помощью алгоритма Брезенхема:
В алгоритме Брезенхема не используются ни числа с плавающей точкой, ни операция округления, ни операции деления внутри цикла. Это вас кто-то обманул.
Procedure Line(x1,y1,x2,y2,c:Integer); var dx,dy,sx,sy,d,d1,d2,x,y,i:Integer; begin dx:=abs(x2-x1); dy:=abs(y2-y1); if (x2>x1) then sx:=1 else sx:=-1; if (y2>y1) then sy:=1 else sy:=-1; if dy<=dx then begin d:=dy shl 1 - dx; d1:=dy shl 1; d2:=(dy-dx) shl 1; PutPixel(x1,y1,c); x:=x1+sx;y:=y1; for i:=1 to dx do begin if (d>0) then begin inc(d,d2);inc(y,sy); end else inc(d,d1); PutPixel(x,y,c); inc(x,sx); end; end else begin d:=dx shl 1 - dy; d1:=dx shl 1; d2:=(dx-dy) shl 1; PutPixel(x1,y1,c); y:=y1+sy;x:=x1; for i:=1 to dy do begin if (d>0) then begin inc(d,d2);inc(x,sx); end else inc(d,d1); PutPixel(x,y,c); inc(y,sy); end; end; end;
bakalava92
22.10.2009 3:59
Всем спасибо, уже сделал все!
program Human; uses CRT; var g,j,i:integer; k:boolean;
procedure circle(Radius,Horizontal,Vertical:integer); {postroenie kruga} var l,x,y:integer; begin for l:=0 to 360 do {cikl s parametrom} begin x:=round(Radius*sin(l)+Horizontal); {nahodim i okruglyaem koordinatu X} y:=round(Radius*cos(l)+Vertical); {nahodim i okruglyaem koordinatu Y} GoToXY(x,y); {peremeshaem kursor v tochku c koordinatami (X,Y)} write('*'); {stavim v tochke s koordinatami (X,Y) simvol * } end; end;
procedure HorizontalLine(y,b1,b2:integer); {postroenie gorizontalnoy linii} begin for g:=b1 to b2 do {cikl s parametrom} begin GoToXY(g,y); {perevodim kursor v tochku s koordinatami (G,Y)} writeln('*'); {stavim v tochke s koordinatami (G,Y) simvol * } end; end;
procedure VerticalLine(x,b1,b2:integer); {postroenie vertikalnoy linii} begin for g:=b1 to b2 do {cikl s parametrom} begin GoToXY(x,g); {perevodim kursor v tochku s koordinatami (X,G)} writeln('*'); {stavim v tochke s koordinatami (X,G) simvol * } end; end;
procedure line(x1,y1,x2,y2:integer); {liniya - algoritm Brasenhaima} var g,x,y,dx,dy,s1,s2,e,i:integer; begin x:=x1; y:=y1; dx:=abs(x2-x1); dy:=abs(y2-y1); if x2-x1>0 then s1:=1 else {operator uslovnogo perehoda} if x2-x1<0 then s1:=-1 else s1:=0; if y2-y1>0 then s2:=1 else if y2-y1<0 then s2:=-1 else s2:=0; if dy<=dx then begin e:=2*dy-dx; for i:=0 to dx do {cikl s parametrom} begin gotoxy(x,y); {peremeshaem kursor v tochku s koordinatami (X,Y)} write('*'); {stavim v tochke s koordinatami (X,Y) simvol * } if e>=0 then {cikl uslovnogo perehoda} begin y:=y+s2; e:=e-2*dx; end; e:=e+2*dy; x:=x+s1; end; end else begin e:=2*dx-dy; for i:=0 to dy do {cikl s parametrom} begin gotoxy(x,y); {peremeshaem kursor v tochku s koordinatami (X,Y)} write('*'); {stavim v tochke s koordinatami (X,Y) simvol * } if e>=0 then {uslovie, operator uslovnogo perehoda} begin x:=x+s1; e:=e-2*dy; end; e:=e+2*dx; y:=Y+s2; end; end; end;
begin clrscr; {ochistka ekrana} j:=0; k:=true; repeat {povtor, cikl s post usloviem} repeat inc(i); {shag, analogichno i:=i+1}
Line(8+i,9,4+i,13-j); {ruki} Line(22+i,9,26+i,13-j); delay(30000); {zaderzhka} if (j<2) and (k=true) then {uslovie, operator uslovnogo perehoda} inc(j) {tozhe samoe chto i j:=j+1} else begin k:=false; dec(j); {tozhe samoe chto i j:=j-1} end; if j=0 then {uslovie, operator uslovnogo perehoda} begin k:=true; end; clrscr; {ochistka ekrana} until (i=50)or(keypressed=true); {cikl s post usloviem} repeat {cikl s post usloviem} dec(i); {tozhe samoe chto i i:=i-1}
Line(8+i,9,4+i,13-j); {ruki} Line(22+i,9,26+i,13-j); delay(30000); {zaderzhka} if (j<2) and (k=true) then {uslovie, operator uslovnogo perehoda} inc(j) {tozhe samoe chto j:=j+1} else begin k:=false; dec(j); {tozhe samoe chto i j:=j-1} end; if j=0 then {uslovie, operator uslovnogo perehoda} begin k:=true; end; clrscr; {ochistka ekrana} until (i=0)or(keypressed=true); {cikl s post usloviem} until keypressed=true; end.
Lapp
22.10.2009 4:52
Цитата(bakalava92 @ 20.10.2009 17:32)
until keypressed=true;
Почему не
until ((keypressed=true)=true)=true;
- ?.. Тебе же написали:
Цитата(ammaximus @ 21.10.2009 15:14)
1. достаточно просто написать
until keypressed
Ждешь, когда преподаватель скажет? ))
bakalava92
22.10.2009 20:31
преподователь ничего не сказал)) она и не смотрела толком))
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.
