Динамический список координат, Графика Опции

[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.

А вопрос то - помогите алгоритмом работы такой программы, только с использованием динамического списка этих самых точек.
Объясните,пожалуйста, каким способом обращатся к данным из (как я понимаю) динамического списка записей.
Заранее спасибо.

Сообщение отредактировано: xlr8 - 2.06.2007 11:47

[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? А то знаешь,компилятор то не волшебник..

[volvo]

xlr8, динамический список где? Массив вижу, списка здесь нет...

Сообщение отредактировано: volvo - 2.06.2007 20:35

[xlr8]

Вот модуль My..но он совсем не суть..
volvo, задание прийдется уточнить ...Ну а если с динам. масивом - это правильно (ну тоесть дин. масив так строится)?

Код

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.

Вобщем получается так, что шарик летает несовсем по точкам...То выше точки, то попадает, но ниже..Вобщем укажите плз если не сложно где здесь что подправить..

Сообщение отредактировано: xlr8 - 3.06.2007 9:55

[Чужак]

Вопрос: обязательно использовать массивы,
файлы, динамическме списки?
Можешь уточнить задание?
Если точки все равно задаются рандомно,
или шире-произвольно, то обязателен ли их список?
Есть один экспериментальный код, где шарик
отражается от стенок, но и сам может менять свое направление.
Выкладывается под ТВОЮ полную ответственность /Шутка /.

[xlr8]

Задачу нужно решить применив двунаправленый список (этих самых координат)..
Если кто знает - подскажите как?
Заранее спасибо

Сообщение отредактировано: xlr8 - 5.06.2007 18:25

[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]

Спасибо огромное!

[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);