[TP] Obracający się sześcian w 3D (już nie trzeba;p )

0

Hej
siedze już troche czasu i szlag mnie trafia. Bo musze zrobić obracający się sześcian w głupim Turbo Pascalu i najlepiej jak najprostszm sposobem. I znalazałem świetny kodzik obracającej się bryły tutaj:
http://4programmers.net/Forum/viewtopic.php?id=84184

Napisałem z zapytaniem do jego autora co oznacza który parametr w tych "wspólrzędnych" i czy mógłby mi coś pomóc, Ale mail od 3 dni pozostał bez odzewu. Pewnie się chłopak wakacjuje:D

No i tu prośba do WAS. Może jest tu jakiś zapaleniec TP który ma lepszą wyobraźnię przestrzenną niż ja:D

program pas3dp;

uses crt,graph;
type tablica=array[0..16] of integer;
     punkty=array[1..4] of pointtype;
     keys=(ShiftUp,
           ShiftDn,
           shiftleft,
           shiftright,
           HOME,
           TAB,
           CR,
           F1,
           F2,
           F3,
           F4,
           F5,
           F6,
           F7,
           F8,
           F9,
           F10,
           INS,
           ESC);

const dl1=80;
      dl2=30;
      dl3=50;
      pz2=-80;
      pz3=20;
      pz4=50;
      pz5=100;
      xp:tablica=(50,-50,-50,50,50,-50,dl2,dl2,-dl2,-dl3,dl3,dl3,-dl3,-dl3,dl3,0,0);
      yp:tablica=(50,50,-50,-50,-50,-50,-dl2,dl2,dl2,-dl3,-dl3,dl3,dl3,-dl3,dl3,-dl3,dl3);
      zp:tablica=(0,0,0,0,0,-50,pz3,pz3,pz3,pz4,pz4,pz4,pz4,pz5,pz5,pz4,pz4);
      stala=1;

var k:real;
    koniec:boolean;
    katpoz,katpion:integer;
    x,y,z:tablica;

function key:keys;
var ch:char;

begin
  ch:=readkey;
  if ch=#0 then
    begin
      ch:=readkey;
      case ch of
        #59:key:=F1;
        #60:key:=F2;
        #61:key:=F3;
        #62:key:=F4;
        #63:key:=F5;
        #64:key:=F6;
        #65:key:=F7;
        #66:key:=F8;
        #71:key:=home;
        #72:key:=ShiftUp;
        #75:key:=shiftleft;
        #77:key:=shiftright;
        #80:key:=ShiftDn;
        #82:key:=ins;
      end
    end
  else
    case ch of
      #9 :key:=TAB;
      #13:key:=CR;
      #27:key:=ESC;
    end;
end;

procedure inicjuj;
var gd,gm:integer;
    x,y:word;

begin
  gd:=9;
  gm:=2;
  initgraph(gd,gm,'c:\tp\bgi');
  setviewport(getmaxx div 2,getmaxy div 2,getmaxx,getmaxy,clipoff);
  getaspectratio(x,y);
 k:=y/x;
  {k:=1;}
end;

procedure translacja(p1,p2,p3,p4:byte);
var pun:punkty;


begin


      pun[1].x:=round(x[p1]+z[p1]*stala);
      pun[1].y:=round(k*(y[p1]-z[p1]*stala));
      pun[2].x:=round(x[p2]+z[p2]*stala);
      pun[2].y:=round(k*(y[p2]-z[p2]*stala));
      pun[3].x:=round(x[p3]+z[p3]*stala);
      pun[3].y:=round(k*(y[p3]-z[p3]*stala));
      pun[4].x:=round(x[p4]+z[p4]*stala);
      pun[4].y:=round(k*(y[p4]-z[p4]*stala));


    SetColor(LightBlue);
    Line(pun[1].x,pun[1].y,pun[2].x,pun[2].y);

    SetColor(Lightred);
    Line(pun[3].x,pun[3].y,pun[4].x,pun[4].y);


end;

procedure oblicz_punkty;
var z1,x1,y1,i:integer;
    kat1,kat2:real;

begin
  kat1:=2*pi*katpoz/360;
  kat2:=2*pi*katpion/360;
  for i:=0 to 16 do
    begin
      x1:=round(xp[i]*cos(kat1)+zp[i]*sin(kat1));
      z1:=round(-xp[i]*sin(kat1)+zp[i]*cos(kat1));
      x[i]:=x1;
      y1:=round(yp[i]*cos(kat2)+z1*sin(kat2));
      z[i]:=round(-yp[i]*sin(kat2)+z1*cos(kat2));
      y[i]:=y1;
    end;

end;

procedure narysuj_figure;
begin
  {1}
  oblicz_punkty;
  cleardevice;
  translacja(0,1,1,2);
  translacja(2,3,3,4);
  translacja(4,0,5,6);
  translacja(6,7,7,8);
  translacja(8,5,0,7);
  translacja(6,4,5,2);
  translacja(8,1,1,1);

end;

begin
  inicjuj;
  koniec:=false;
  katpoz:=0;
  katpion:=0;
  repeat
    narysuj_figure;
    case key of
      ESC:koniec:=true;
      shiftup:inc(katpion,10);
      shiftdn:dec(katpion,10);
      shiftleft:inc(katpoz,10);
      shiftright:dec(katpoz,10);
    end;
  until koniec;
  closegraph;
end.

Trochę tu pozmieniałem i jeszcze trochę do usunięcia zostało. Głównie chodzi o te 50-tki w tablicach xp yp zp.

Może WAM sie uda z tego zrobić sześcian?? Bo ja w swoje umiejętności zwątpiłem :p

Obiecuje odwdzięczyć sie browarem jesli ktoś zawita na Kresy Wschodnie :D

0
program pas3dp;

uses crt,graph;
type tablica=array[0..7] of integer;
     punkty=array[1..4] of pointtype;
     keys=(ShiftUp,
           ShiftDn,
           shiftleft,
           shiftright,
           CR,
           ESC);

const
      xp:tablica=(50,-50,-50,50,50,-50,-50,50);
      yp:tablica=(-50,-50,50,50,-50,-50,50,50);
      zp:tablica=(50,50,50,50,-50,-50,-50,-50);
      stala=0.3;

var k:real;
    koniec:boolean;
    katpoz,katpion:integer;
    x,y,z:tablica;

function key:keys;
var ch:char;

begin
  ch:=readkey;
  if ch=#0 then
    begin
      ch:=readkey;
      case ch of
        #72:key:=ShiftUp;
        #75:key:=shiftleft;
        #77:key:=shiftright;
        #80:key:=ShiftDn;

      end
    end
  else
    case ch of

      #13:key:=CR;
      #27:key:=ESC;
    end;
end;

procedure inicjuj;
var gdriver,gmode:integer;
    x,y:word;

begin
  gdriver:=Detect;
  gmode:=2;
  initgraph(gdriver,gmode,'c:\tp\bgi');
  setviewport(getmaxx div 2,getmaxy div 2,getmaxx,getmaxy,clipoff);
  getaspectratio(x,y);
 k:=x/y; { k:=1;}
end;

procedure translacja(p1,p2,p3,p4:byte);
var pun:punkty;


begin


      pun[1].x:=round(x[p1]+z[p1]*stala);
      pun[1].y:=round(k*(y[p1]-z[p1]*stala));
      pun[2].x:=round(x[p2]+z[p2]*stala);
      pun[2].y:=round(k*(y[p2]-z[p2]*stala));
      pun[3].x:=round(x[p3]+z[p3]*stala);
      pun[3].y:=round(k*(y[p3]-z[p3]*stala));
      pun[4].x:=round(x[p4]+z[p4]*stala);
      pun[4].y:=round(k*(y[p4]-z[p4]*stala));


    SetColor(LightBlue);
    Line(pun[1].x,pun[1].y,pun[2].x,pun[2].y);


    SetColor(Lightred);
    Line(pun[3].x,pun[3].y,pun[4].x,pun[4].y);


end;

procedure oblicz_punkty;
var z1,x1,y1,i:integer;
    kat1,kat2:real;

begin
  kat1:=2*pi*katpoz/360;
  kat2:=2*pi*katpion/360;
  for i:=0 to 7 do
    begin
      x1:=round(xp[i]*cos(kat1)+zp[i]*sin(kat1));
      z1:=round(-xp[i]*sin(kat1)+zp[i]*cos(kat1));
      x[i]:=x1;
      y1:=round(yp[i]*cos(kat2)+z1*sin(kat2));
      z[i]:=round(-yp[i]*sin(kat2)+z1*cos(kat2));
      y[i]:=y1;
    end;

end;

procedure narysuj_figure;
begin
  {1}
  oblicz_punkty;
  cleardevice;
  translacja(0,1,1,2);
  translacja(2,3,3,0);
  translacja(4,5,5,6);
  translacja(6,7,7,4);
  translacja(0,4,1,5);
  translacja(2,6,3,7);

end;

begin
  inicjuj;
  koniec:=false;
  katpoz:=0;
  katpion:=0;
  repeat
    narysuj_figure;
    case key of
      ESC:koniec:=true;
      shiftup:inc(katpion,10);
      shiftdn:dec(katpion,10);
      shiftleft:inc(katpoz,10);
      shiftright:dec(katpoz,10);
    end;
  until koniec;
  closegraph;
end.

Jakoś ruszyły moje stare szare, i zadziałało.

Oczywiście zaznaczam że ten sześcian powstał na bazie kodu, który nie jest mojego autorstwa !!!

Ale dla mnie ważne że działa:)

A browara sam będę musiał wypić :p

0

To jeszcze dodaj to do gotowców.

1 użytkowników online, w tym zalogowanych: 0, gości: 1