Помощь - Поиск - Пользователи - Календарь
Полная версия: Динамический список координат
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
xlr8
Собственно написал вот такую программу. Шарик движется линейно между точками (x[i],y[i])..

Uses Graph,Crt,My;

Const N=10;

Type
TPoint=record
x:real;
y:real;
end;

p=array[1..N] of TPoint;

Var
Dot:p;
output:text;
i:integer;
x,y:real;

procedure draw;
Var a,b,c:real;
begin

Init_graph;

for i:=1 to N do
PutPixel(round(Dot[i].x),round(Dot[i].y),red);{отмечает маршрут}

{дальше собственно "анимация"..}
for i:=1 to N-1 do
begin
x:=Dot[i].x;
if Dot[i].x<Dot[i+1].x then
begin
repeat
x:=x+1;
a:=x*Dot[i+1].y-x*Dot[i].y-Dot[i].x*Dot[i+1].y+Dot[i].x*Dot[i].y;
b:=Dot[i+1].x*Dot[i].y-Dot[i].x*Dot[i].y;
c:=Dot[i+1].x-Dot[i].x;
y:=(a+b)/c;
Drawcircle(round(x),round(y),green);
delay(2600);
Drawcircle(round(x),round(y),white);
until x>=Dot[i+1].x;
end
else
begin
repeat
x:=x-1;
a:=x*Dot[i+1].y-x*Dot[i].y-Dot[i].x*Dot[i+1].y+Dot[i].x*Dot[i].y;
b:=Dot[i+1].x*Dot[i].y-Dot[i].x*Dot[i].y;
c:=Dot[i+1].x-Dot[i].x;
y:=(a+b)/c;
Drawcircle(round(x),round(y),green);
delay(2600);
Drawcircle(round(x),round(y),white);
until x<=Dot[i+1].x;
end;
end;
readkey;
end;

{main program}
BEGIN
clrscr;
randomize;

{вводим координаты точек}
for i:=1 to N do
begin
Dot[i].x:=round(random(640));
Dot[i].y:=round(random(480));
end;
draw;
END.


А вопрос то - помогите алгоритмом работы такой программы, только с использованием динамического списка этих самых точек.
Объясните,пожалуйста, каким способом обращатся к данным из (как я понимаю) динамического списка записей.
Заранее спасибо.
Ozzя
Тут прочитал как решать товю задачу?
xlr8
Будем разбиратся..Спасибо
xlr8
Просмотрите...правильно ли я всё сделал? (программа работает конечно)
Код

Uses Graph,Crt,My;

Const N=10000;

Type

     point=^tpoint;

     tpoint=record
     x:real;
     y:real;
     next:point;
     end;



Var
      Dot:array[1..N] of point;
      output:text;
      i:integer;
      x,y:real;

procedure draw;
Var a,b,c:real;
begin

Init_graph;
for i:=1 to N do
begin
with Dot[i]^ do
begin
PutPixel(round(x),round(y),red);
next:=Dot[i+1];
end;
end;
readkey;
for i:=1 to N-1 do
    begin
    x:=Dot[i]^.x;
    if Dot[i]^.x<Dot[i+1]^.x then
       begin
            repeat
            x:=x+1;
            a:=x*Dot[i+1]^.y-x*Dot[i]^.y-Dot[i]^.x*Dot[i+1]^.y+Dot[i]^.x*Dot[i]^.y;
            b:=Dot[i+1]^.x*Dot[i]^.y-Dot[i]^.x*Dot[i]^.y;
            c:=Dot[i+1]^.x-Dot[i]^.x;
            y:=(a+b)/c;
            Drawcircle(round(x),round(y),green);
            delay(300);
            Drawcircle(round(x),round(y),black);
            until x>=Dot[i+1]^.x;
       end
          else
              begin
                   repeat
                   x:=x-1;
                   a:=x*Dot[i+1]^.y-x*Dot[i]^.y-Dot[i]^.x*Dot[i+1]^.y+Dot[i]^.x*Dot[i]^.y;
                   b:=Dot[i+1]^.x*Dot[i]^.y-Dot[i]^.x*Dot[i]^.y;
                   c:=Dot[i+1]^.x-Dot[i]^.x;
                   y:=(a+b)/c;
                   Drawcircle(round(x),round(y),green);
                   delay(300);
                   Drawcircle(round(x),round(y),black);
                   until x<=Dot[i+1]^.x;
              end;
end;
Dispose(Dot[i]);
end;

{main program}
BEGIN
clrscr;
randomize;
for i:=1 to N do
begin
     New(Dot[i]);
     with Dot[i]^ do
     begin
     x:=round(random(640));
                           {writeln(Dot[i]^.x:4:0);}
     y:=round(random(480));
                           {writeln(Dot[i]^.y:4:0);}
                           next:=nil;
     end;
end;
readkey;
draw;
readkey;
END.
Артемий
Извини, а можно присоеденить модуль My? А то знаешь,компилятор то не волшебник.. smile.gif
volvo
xlr8, динамический список где? Массив вижу, списка здесь нет...
xlr8
Вот модуль My..но он совсем не суть..
volvo, задание прийдется уточнить dry.gif ...Ну а если с динам. масивом - это правильно (ну тоесть дин. масив так строится)?
Код

Unit MY;

Interface

Uses Crt, Graph;

Var Err,s,x,y:integer;

procedure Init_Graph;
procedure Drawcircle(x,y:integer;color:word);

Implementation

procedure Init_Graph;
var GD, GM, EC: Integer;
begin
GD:= Detect;
  InitGraph(GD,GM,'C:\TP\BGI\');
EC:= GraphResult;
  if EC<>GrOK then
   begin
    WriteLn('Error Graphic Initialize: ', GraphErrorMsg(EC));
    Halt(1);
   end;
end;

procedure Drawcircle(x,y:integer;color:word);
var p:FillPatternType;
begin
  Setcolor(color);
  Circle(x,y,2);
  GetFillPattern(p);
  SetFillPattern(p,color);
  FloodFill(x,y,color);
end;
End.
volvo
И динамического массива здесь тоже нет... Понимаешь, динамический массив - это когда ты при запуске программы не знаешь его размера, и только в RunTime становится известен размер, который тебе необходим, и инициализируется массив нужного размера. А у тебя все известно - массив статический (место-то под сам массив выделяется еще на этапе компиляции). То, что сами элементы хранятся в "куче" - ничего не значит... Массив от этого не становится динамическим в полном смысле этого слова...

А задание все-таки уточни, и подкорректируй название темы соответственно, а то в названии написано одно, а ты говоришь что это - несущественно...
xlr8
Код

Uses Graph,Crt,My;

Type

     point=^tpoint;

     tpoint=record
     x:real;
     y:real;
     next:point;
     end;



Var
      first:point;
      place:point;
      output:text;
      k,i:integer;
      x,y:real;

procedure draw(first:point);
Var a,b,c:real;
    r:point;
begin

Init_graph;

place:=first;
while place<>nil do
begin
Drawcircle(round(place^.x),round(place^.y),red);
place:=place^.next;
end;}

place:=first;

while (place^.next<>nil) do
begin
    y:=0;
    x:=place^.x;
    r:=place^.next;
    if place^.x<r^.x then
       begin
            repeat
            x:=x+1;
            y:=((x*r^.y-x*place^.y-place^.x*r^.y+place^.x*r^.y)+(r^.x*place^.y-place^.x*place^.y))/(r^.x-place^.x);
            writeln(y);
            {Drawcircle(round(x),round(y),green);
            delay(2600);
            Drawcircle(round(x),round(y),black);}
            until x>=r^.x;
       end
          else
              begin
                   repeat
                   x:=x-1;
                   y:=((x*r^.y-x*place^.y-place^.x*r^.y+place^.x*r^.y)+(r^.x*place^.y-place^.x*place^.y))/(r^.x-place^.x);
                   Drawcircle(round(x),round(y),green);
                   delay(2600);
                   Drawcircle(round(x),round(y),black);
                   until x<=r^.x;
end;
place:=place^.next;
end;
end;

{main program}
BEGIN
clrscr;
randomize;
first:=nil;
while k<>2 do
begin
     New(place);
     readln(place^.x);
     readln(place^.y);
     place^.next:=first;
     first:=place;
     k:=k+1;
end;
readkey;
draw(first);
readkey;
END.



Вобщем получается так, что шарик летает несовсем по точкам...То выше точки, то попадает, но ниже..Вобщем укажите плз если не сложно где здесь что подправить..
Чужак
Вопрос: обязательно использовать массивы,
файлы, динамическме списки?
Можешь уточнить задание?
Если точки все равно задаются рандомно,
или шире-произвольно, то обязателен ли их список?
Есть один экспериментальный код, где шарик
отражается от стенок, но и сам может менять свое направление.
Выкладывается под ТВОЮ полную ответственность cool.gif /Шутка blum.gif /.
xlr8
Задачу нужно решить применив двунаправленый список (этих самых координат)..
Если кто знает - подскажите как?
Заранее спасибо
volvo
Вот набросок:
uses crt, graph;
type
plist = ^tlist;
tlist = record
X, Y: integer;
prev, next: plist;
end;

const
R = 5;
step = 20; { <--- Можешь поиграться с этим }
var
head, tail: plist;


{
append new item to the end of list
}
procedure append_list(x, y: integer);
var p: plist;
begin
p := new(plist);
p^.x := x; p^.y := y;
p^.next := nil;
p^.prev := tail;

if head = nil then head := p
else tail^.next := p;

tail := p;

setfillstyle(solidfill, red);
fillellipse(p^.x, p^.y, R, R);
end;

var
gd, gm: integer;
i: integer;
p: plist;

cx, cy, DX, DY: real;
begin
initgraph(gd, gm, '');
setcolor(white);

head := nil; tail := nil;
for i := 1 to 10 do begin
append_list(random(getmaxx), random(getmaxy));
end;

setcolor(lightgreen);
cx := 0; cy := 0;

p := head;
while p <> nil do begin

DX := (p^.x - cx) / step;
DY := (p^.y - cy) / step;
for i := 1 to step do begin
setcolor(black);
circle(trunc(cx), trunc(cy), R);
cx := cx + DX; cy := cy + DY;
setcolor(lightgreen);
circle(trunc(cx), trunc(cy), R);
delay(25); { <--- Измени на бОльшее значение }
end;

p := p^.next;
end;


readln;
closegraph;
end.

Единственное, что надо еще сделать - это принять меры против того, что изображение точки "размывается" при проходе над ней шарика... Это просто, попробуй догадаться сам...
xlr8
Спасибо огромное! smile.gif
xlr8
 
procedure delete_elem(i:byte);
var
nav,p1,p2:plist;
search:boolean;
c:byte;
begin
search:=false;

c:=0;
p:=head;
while p^.next<>NIL do
begin
if c=i then
begin
search:=true;
break;
end;
p:=p^.next;
inc©;
end;

if search then
begin
writeln('Remove elem #',c,' (',p^.x,',',p^.y,')');
nav:=p;
p^.prev:=nav^.prev;
p^.next:=nav^.next;
dispose(nav);
nav:=nil;

end
else writeln('No result of search')

end;



Помогите удалить елемент из списка. По правильному вроде бы так..У меня работает всё отлично только если вот так:

nav:=p^.next;
p^.prev:=nav^.prev;
p^.next:=nav^.next;
dispose(nav);
nav:=nil;



В чем проблема тут?
volvo
Цитата
В чем проблема тут?
Может, в том, что элементы считаются у тебя с НУЛЯ?

Добавлено через 6 мин.
Хм... вторая попытка... Ты сам понял, что написал?
   nav:=p;
p^.prev:=nav^.prev;
p^.next:=nav^.next;
dispose(nav);

Это значит (если Nav заменить на P, они же равны, так?):
   p^.prev:=p^.prev;
p^.next:=p^.next;
dispose(p);

Что получишь? Бред...

Делаем так?
   nav:=p;
if p^.prev <> nil then p^.prev^.next := nav^.next;
if p^.next <> nil then p^.next^.prev := nav^.prev;
dispose(nav);

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.