07. august 2002 - 16:15Der er
5 kommentarer og 1 løsning
3D-Engine
Sidder for sjov og skriver min egen 3D-engine i pascal, og jeg er kørt helt fast ved rotering af punkter. Jeg har prøvet alle mulige slags formler, men har ikke kunnet få noget til at virke. hvis nogen ved hvordan man gør, vil det være en stor hjælp! Kan godt poste koden hvis det skal være.
Poster koden her :) Vil lige prøve den løsning. Den virker da ret fornuftig :)
Her kommer HELE koden. Under proceduren "mantd" skal jeg som sagt også lave en procedure til at rotere:
unit TD3D; interface procedure td; procedure td_init; procedure fileload; procedure setVGAmode; procedure setTXTmode; procedure putpixel(x, y : integer; color : byte); procedure line(a,b,c,d,col:integer); procedure mantd(optype:char; opvar: integer); function sgn(a:real):integer; var drawflag: boolean; endflag: boolean; infile: text; inputvar: string; ninputvar: integer; errcode: integer; u: char; n: integer; l: integer; i:integer; x:real; y:real; x2:real; y2:real; td_model : array[1..7,1..50] of integer; td_nls:integer; td_xo :integer; td_yo :integer; td_zo :integer; td_xb :integer; td_yb :integer; td_zb :integer; td_x1 :integer; td_y1 :integer; td_z1 :real; td_x2 :integer; td_y2 :integer; td_z2 :real; td_x1o:integer; td_y1o:integer; td_z1o:integer; td_x2o:integer; td_y2o:integer; td_z2o:integer; td_zOff:integer; td_xOff:integer; td_yOff:integer; td_lc:integer; td_bgcolor:integer; td_fps:integer; td_framedelay:integer; td_modelfile:string; implementation function sgn(a:real):integer; begin if a>0 then sgn:=+1; if a<0 then sgn:=-1; if a=0 then sgn:=0; end; procedure waitretrace;assembler; label l1,l2; asm mov dx,3DAh l1: in al,dx and al,08h jnz l1 l2: in al,dx and al,08h jz l2 end; procedure setVGAmode; BEGIN asm mov ax,0013h int 10h end; END;
procedure setTXTmode; BEGIN asm mov ax,0003h int 10h end; END;
procedure putpixel(x, y : integer; color : byte); BEGIN
Mem [$a000:x+(y*320)]:=color; END; procedure line(a,b,c,d,col:integer); var u,s,v,d1x,d1y,d2x,d2y,m,n:real; i:integer; begin u:= c - a; v:= d - b; d1x:= SGN(u); d1y:= SGN(v); d2x:= SGN(u); d2y:= 0; m:=ABS(u); n:=ABS(v); IF NOT (M>N) then BEGIN d2x:=0; d2y:=SGN(v); m:=ABS(v); n:=ABS(u); END; s:=INT(m/2); FOR i := 0 TO round(m) DO BEGIN putpixel(a,b,col); s:=s+n; IF not (s<m) THEN BEGIN s:=s-m; a:=a+round(d1x); b:=b+round(d1y); END ELSE BEGIN a:=a+round(d2x); b:=b+round(d2y); END; end; END;
procedure td; BEGIN i:=1; drawflag := TRUE; FillChar (Mem [$a000:0],64000,td_bgcolor); repeat td_x1 := td_model[1,i]; td_y1 := td_model[2,i]; td_z1 := td_model[3,i]/10; td_x2 := td_model[4,i]; td_y2 := td_model[5,i]; td_z2 := td_model[6,i]/10; td_lc := td_model[7,i]; if (td_z1 <= 0) or (td_z2 <= 0) then drawflag := FALSE; if (drawflag = TRUE) then BEGIN if not (td_x1 = 0) then td_x1o:= round((2*td_x1) / (td_z1))+160 else td_x1o:=160; if not (td_y1 = 0) then td_y1o:= round((2*td_y1) / (td_z1))+100 else td_y1o:=100; if not (td_x2 = 0) then td_x2o:= round((2*td_x2) / (td_z2))+160 else td_x2o:=160; if not (td_y2 = 0) then td_y2o:= round((2*td_y2) / (td_z2))+100 else td_y2o:=100; if (td_x1o < 0) then td_x1o := 0; if (td_y1o < 0) then td_y1o := 0; if (td_x2o < 0) then td_x2o := 0; if (td_y2o < 0) then td_y2o := 0; if (td_x1o > 319) then td_x1o := 319; if (td_y1o > 199) then td_y1o := 199; if (td_x2o > 319) then td_x2o := 319; if (td_y2o > 199) then td_y2o := 199; line(td_x1o,td_y1o,td_x2o,td_y2o,td_lc); END; i:=i+1; until i=td_nls; END; procedure mantd(optype:char; opvar: integer); BEGIN i:=1; if (optype='l') then fileload; if (optype='q') then endflag:=TRUE; if (optype='a') then BEGIN repeat td_model[1,i]:=td_model[1,i]-opvar; td_model[4,i]:=td_model[4,i]-opvar; i:=i+1; until (i=td_nls); END; if (optype='d') then BEGIN repeat td_model[1,i]:=td_model[1,i]+opvar; td_model[4,i]:=td_model[4,i]+opvar; i:=i+1; until (i=td_nls); END; if (optype='w') then BEGIN repeat td_model[2,i]:=td_model[2,i]-opvar; td_model[5,i]:=td_model[5,i]-opvar; i:=i+1; until (i=td_nls); END; if (optype='s') then BEGIN repeat td_model[2,i]:=td_model[2,i]+opvar; td_model[5,i]:=td_model[5,i]+opvar; i:=i+1; until (i=td_nls); END; if (optype='r') then BEGIN repeat td_model[3,i]:=td_model[3,i]+opvar; td_model[6,i]:=td_model[6,i]+opvar; i:=i+1; until (i=td_nls); END; if (optype='f') then BEGIN repeat td_model[3,i]:=td_model[3,i]-opvar; td_model[6,i]:=td_model[6,i]-opvar; i:=i+1; until (i=td_nls); END; if (optype='g') then BEGIN repeat
i:=i+1; until (i=td_nls); END;
td; END;
procedure fileload; begin setTXTmode; n:=1 ; l:=1; assign(infile, td_modelfile); reset(infile); while not eof(infile) do begin while not eoln(infile) do begin readln(infile, inputvar); write(inputvar); val(inputvar,ninputvar,errcode); td_model[n,l]:=ninputvar; n:=n+1; IF (n>7) THEN begin n:=1; l:=l+1; end; end; end; td_nls:=l; close(infile); setVGAmode; end; procedure td_init; BEGIN if (td_bgcolor=0) then td_bgcolor:=0; if (td_fps=0) then td_fps:=30; i:=1; if not (td_fps=0) then td_framedelay:=(1000 div td_fps)-5 else td_framedelay:=1000; setVGAmode; fileload; END; end.
hehe.. ved jeg heller ikk helt om jeg kan :) tror jeg prøver at omskrive hele lortet. Hvis der er nogle der har ideer til hvordan man laver shading osv er de meget velkomne!
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.