DEMO.DESIGN
Frequently Asked Questions
 
оглавление | demo party в ex-СССР | infused bytes e-mag | новости от ib/news | другие проекты | письмо | win koi lat

следующий фpагмент (2)
{ ===================================== } { Copyright (c) Skael, 1999 - 2000 } { See copying.txt for details } { ===================================== } { arrows, Ctrl + arrows ==> rotate voxel object } { Space ==> wild rotation } { Esc ==> exit } uses p_graph; const sample = 1; var zbuffer : pchar; type fp = single; PVector = ^TVector; TVector = object x,y,z : fp; procedure load(fx,fy,fz:fp); procedure add(var a:TVector); procedure sub(var a:TVector); procedure mul(v:fp); procedure rotate(c,v,h : fp); end; TVectorArray = array [0..65520 div sizeof(TVector)-1] of TVector; PVectorArray = ^TVectorArray; PVoxel = ^TVoxel; TVoxel = record x,y,z : byte; color : byte; end; TVoxelArray = array [0..65520 div sizeof(TVoxel)-1] of TVoxel; PVoxelArray = ^TVoxelArray; TVoxelUnit = object vCount : integer; vList : PVoxel; vSide : integer; vHalf : integer; vecX, vecY, vecZ : PVectorArray; vec1X, vec1Y, vec1Z : TVector; vec2X, vec2Y, vec2Z : TVector; constructor init; procedure rotate(ax,ay,az:fp); procedure render(x,y,z:integer); destructor done; end; var outPalette : TPalette; procedure makePalette; var r,g,b,i,ofs:integer; begin for i:=0 to 255 do with outPalette[i] do begin r:=0; g:=0; b:=0; end; i:=0; ofs := 0; { blue-red crossfade pal } for i:=0 to 255 do with outPalette[i+ofs] do begin r := maxcolor*(i div 16) div 15; b := maxcolor*(i mod 16) div 15; end; Inc(ofs,i+1); {} end; procedure TVector.load(fx,fy,fz:fp); begin x := fx; y := fy; z := fz; end; procedure TVector.Add(var a:TVector); begin x := x+a.x; y := y+a.y; z := z+a.z; end; procedure TVector.Sub(var a:TVector); begin x := x-a.x; y := y-a.y; z := z-a.z; end; procedure TVector.Mul(v:fp); begin x := x*v; y := y*v; z := z*v; end; procedure TVector.rotate(c,v,h : fp); var rp : TVector; begin rp.x := x*cos(c) - y*sin(c); rp.y := x*sin(c) + y*cos(c); rp.z := z;{} z := rp.z*cos(h) - rp.y*sin(h); y := rp.z*sin(h) + rp.y*cos(h); x := rp.x;{} rp.x := x*cos(v) - y*sin(v); rp.y := x*sin(v) + y*cos(v); rp.z := z;{} x := rp.x; y := rp.y; z := rp.z; end; procedure malloc(var p:pointer; size:word); begin if (maxAvail>size) then begin GetMem(p, size); FillChar(p^, size, 0); end else begin p := nil; WriteLn('Not enough memory!'); Halt(1); end; end; procedure mfree(var p:pointer; size:word); begin if (p<>nil) then begin FreeMem(p, size); p := nil; end; end; function colorJoin(r,b:byte) : byte; begin colorJoin := (r shl 4)+(b and $f); end; procedure colorSplit(c:byte; var r,b:byte); begin Inc(r, c shr 4); Inc(b, c and $f); end; constructor TVoxelUnit.init; var pList : PVoxel; norm, fy, fx : real; c, x, y, z : integer; r, b : byte; begin vSide := 64; vHalf := vSide shr 1; { voxel cube vCount := sqr(vSide-2)*3; malloc(pointer(vList), vCount*sizeof(TVoxel)); pList := vList; z := 1; for x := 1 to vSide-2 do for y := 1 to vSide-2 do begin pList^.x := Sqr(x-y) div vSide; pList^.y := Sqr(y) div vSide; pList^.z := (Sqr(x)) div vSide; pList^.color := colorJoin(y,x); Inc(pList); end; z := vSide-2; for x := 1 to vSide-2 do for y := 1 to vSide-2 do begin pList^.x := x; pList^.y := y; pList^.z := z; pList^.color := colorJoin(0,15); Inc(pList); end; y := vSide-2; for x := 1 to vSide-2 do for z := 1 to vSide-2 do begin pList^.x := x; pList^.y := y; pList^.z := z; pList^.color := colorJoin(15,0); Inc(pList); end; { eov cube } { voxel sphere } vCount := 10000; malloc(pointer(vList), vCount*sizeof(TVoxel)); pList := vList; for c := 1 to vCount do begin x := vHalf - Random(vSide); y := vHalf - Random(vSide); z := Abs(vHalf - Random(vSide)); norm := Sqrt(Sqr(x)+Sqr(y)+Sqr(z)) / vHalf; pList^.x := trunc(x/norm) + vHalf; pList^.y := trunc(y/norm) + vHalf; pList^.z := trunc(z/norm) + vHalf; if (y<>0) then fy := ArcTan(x/y) else fy := Pi/6; pList^.color := colorJoin(trunc(Abs(fy)*16),(Abs(z div 3))); Inc(pList); end; { eov sphere } malloc(pointer(vecX), sizeof(TVector)*vSide); malloc(pointer(vecY), sizeof(TVector)*vSide); malloc(pointer(vecZ), sizeof(TVector)*vSide); end; destructor TVoxelUnit.done; begin if (vCount>0) and (vSide>0) then begin mfree(pointer(vList), vCount*sizeof(TVoxel)); mfree(pointer(vecX), sizeof(TVector)*vSide); mfree(pointer(vecY), sizeof(TVector)*vSide); mfree(pointer(vecZ), sizeof(TVector)*vSide); end; vCount := 0; vSide := 0; end; procedure TVoxelUnit.rotate(ax,ay,az:fp); var i : integer; vec0:TVector; pVec : PVector; begin vec1X.load(1,0,0); vec1X.rotate(ax,ay,az); vec1Y.load(0,1,0); vec1Y.rotate(ax,ay,az); vec1Z.load(0,0,1); vec1Z.rotate(ax,ay,az); vec2X := vec1X; vec2X.mul(1/Sample); vec2Y := vec1Y; vec2Y.mul(1/Sample); vec2Z := vec1Z; vec2Z.mul(1/Sample); vec0.load(0,0,0); for i:=0 to vSide-1 do begin vecX^[i] := vec0; vec0.add(vec1X); end; vec0.load(0,0,0); for i:=0 to vSide-1 do begin vecY^[i] := vec0; vec0.add(vec1Y); end; vec0.load(0,0,0); for i:=0 to vSide-1 do begin vecZ^[i] := vec0; vec0.add(vec1Z); end; end; procedure putPixelZ(x,y,z : integer; color:byte); var offset : word; saveZ : byte; begin offset := x+y*maxx; saveZ := byte((zbuffer+offset)^); if (saveZ > z) then begin byte((zbuffer+offset)^) := z; byte((video+offset)^) := color; end; end; procedure TVoxelUnit.render(x,y,z:integer); var fx, fy, fz : fp; ix, iy, iz : integer; vColor, vx, vy, vz : byte; i : integer; pList : PVoxel; begin pList := vList; for i := 0 to vCount do begin vx := pList^.x; vy := pList^.y; vz := pList^.z; vColor := pList^.color; fx := vecX^[vx].x+vecY^[vy].x+vecZ^[vz].x; fy := vecX^[vx].y+vecY^[vy].y+vecZ^[vz].y; fz := vecX^[vx].z+vecY^[vy].z+vecZ^[vz].z; fx := fx*sample; fy := fy*sample; fz := fz*sample; ix := trunc(fx); iy := trunc(fy); iz := trunc(fz); putPixelZ(ix+x,iy+y,iz+z,vColor);{} putPixelZ(ix+x+1,iy+y,iz+z+1,vColor); putPixelZ(ix+x,iy+y+1,iz+z+1,vColor); putPixelZ(ix+x+1,iy+y+1,iz+z+1,vColor);{} Inc(pList); end; end; const centerz = 128; bMove : boolean = false; var rc : integer; zseg : word; rseg : word; ax, ay, az : fp; axInc, ayInc, azInc : fp; vUnit : TVoxelUnit; key : word; begin rc := 0; { сделать указатели кратными 16 } rc := rc or DosAlloc(4096,rseg); rc := rc or DosAlloc(4096,zseg); if rc<>0 then begin WriteLn('Bad luck! Not enough memory.'); Halt(1); end; InitGraph; video := DosSeg2Ptr(rseg); zbuffer := DosSeg2Ptr(zseg); MakePalette; PalCopy(outpalette); PalUse; vUnit.init; ax := 0; ay := 0; az := 0; axInc := 0.1; ayInc := 0.06; azInc := 0.13; repeat vUnit.rotate(ax,ay,az); DosFill(rseg,$0000); DosFill(zseg,$FFFF); vUnit.render(centerx,centery,centerz); DosMove($A000,rseg); if keypressed then begin key := readkey; if key = kbd_esc then break; case key of kbd_left : ax := ax-0.1; kbd_right : ax := ax+0.1; kbd_up : ay := ay-0.1; kbd_down : ay := ay+0.1; kbd_ctrl_left : az := az-0.1; kbd_ctrl_right : az := az+0.1; kbd_space : bMove := not bMove; end; end; if bMove then begin ax := ax+axInc; ay := ay+ayInc; az := az+azInc; end; until 1=2; vUnit.done; DosFree(rseg); DosFree(zseg); DoneGraph; end.

Всего 1 фpагмент(а/ов) |пpедыдущий фpагмент (1)

Если вы хотите дополнить FAQ - пожалуйста пишите.

design/collection/some content by Frog,
DEMO DESIGN FAQ (C) Realm Of Illusion 1994-2000,
При перепечатке материалов этой страницы пожалуйста ссылайтесь на источник: "DEMO.DESIGN FAQ, http://www.enlight.ru/demo/faq".