Информационный сервер для программистов: Исходники со всего света. Паскальные исходники со всего света
  Powered by Поисковый сервер Яndex: Найдется ВСЁ!
На Главную Pascal Форум Информер Страны мира
   Demo Making    >>    rot10
   
 
 Bumping 3D Sphere [320x200x256]  Unknown 20.11.97

Сфера, состоящая из точек, вращается в трехмерном пространстве и скачет, как мячик, на экране.
Rotate a "ball" of dots.



2k 
 

  {> Cut here. FileName= ROT10.PAS } {$g+} program bumping_3d_sphere; const dots = 99; gseg : word = $a000; _x = 0; _y = 1; _z = 2; spd = 2; dist = 100; divd = 1024; ptab : array[0..255] of byte = ( 123,121,119,117,115,114,112,110,108,106,104,103,101,99,97,96,94, 92,91,89,87,86,84,82,81,79,78,76,75,73,72,70,69,67,66,64,63,62, 60,59,58,56,55,54,52,51,50,49,48,46,45,44,43,42,41,39,38,37,36, 35,34,33,32,31,30,29,28,27,26,26,25,24,23,22,21,21,20,19,18,17, 17,16,15,15,14,13,13,12,12,11,10,10,9,9,8,8,7,7,6,6,5,5,5,4,4,4, 3,3,3,2,2,2,2,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1, 1,1,1,2,2,2,2,3,3,3,3,4,4,4,5,5,6,6,7,7,7,8,8,9,9,10,11,11,12,12, 13,14,14,15,16,16,17,18,19,19,20,21,22,23,23,24,25,26,27,28,29,30, 31,32,33,34,35,36,37,38,39,40,41,42,43,44,46,47,48,49,51,52,53,54, 56,57,58,60,61,62,64,65,67,68,69,71,72,74,75,77,78,80,82,83,85,86, 88,90,91,93,95,96,98,100,102,103,105,107,109,111,113,114,116,118, 120,122,124,126); type prec = record x,y,z : integer; end; ppos = array[0..dots] of prec; styp = array[0..255] of integer; var stab : styp; dot : ppos; procedure setpal(col,r,g,b : byte); assembler; asm mov dx,03c8h mov al,col out dx,al inc dx mov al,r out dx,al mov al,g out dx,al mov al,b out dx,al end; procedure init; const ctab : array[0..99,_x.._z] of integer = ( (-18,24,2),(14,-19,19),(23,14,-13),(-1,22,-20),(-3,1,30), (-1,5,30),(-11,-27,-4),(-1,0,-30),(-12,-11,25),(-18,-13,20), (-3,12,27),(-27,6,-13),(-30,-1,1),(-6,-9,-28),(4,-28,11), (2,22,-20),(-5,1,-30),(2,1,30),(-7,21,21),(-7,18,-23), (17,-22,-11),(-10,5,28),(0,-1,30),(11,-25,-13),(-6,-28,-10), (13,12,-24),(0,0,-30),(-20,21,8),(-3,-30,-4),(16,7,-24), (13,-4,-27),(4,-9,-28),(-10,-1,-28),(-19,-22,-8),(7,-6,29), (-16,-22,-13),(23,6,-18),(22,-7,-19),(-5,3,-30),(-3,5,-29), (12,0,28),(-6,13,-26),(24,-16,-8),(-7,23,18),(-10,28,-5), (21,20,8),(19,-5,23),(0,10,-28),(23,13,-14),(4,-6,29),(19,12,20), (8,-17,-23),(17,21,13),(-16,3,25),(-2,4,30),(-24,17,3), (-2,-1,-30),(-9,-8,27),(-10,4,-28),(10,-19,21),(3,22,-20), (-6,1,29),(-22,-21,3),(0,-1,-30),(30,1,4),(-29,7,-1),(-6,23,-18), (-10,-28,3),(-3,10,-28),(16,-23,-10),(-8,23,-17),(-6,3,29), (2,-19,24),(-13,14,-23),(13,-26,9),(-17,21,-12),(8,2,29), (16,-13,22),(9,9,27),(7,-15,25),(-25,16,-2),(-1,-3,-30), (18,0,-24),(12,-3,27),(3,3,-30),(-22,-16,-13),(-5,-5,29), (21,-14,-16),(3,21,21),(21,-20,-8),(27,6,12),(-13,-13,-23), (1,11,-28),(25,-14,-9),(3,1,-30),(-2,-3,-30),(1,2,30),(8,20,21), (-20,22,6),(11,13,25)); var i : byte; begin for i := 0 to dots do begin dot[i].x := ctab[i,_x]; dot[i].y := ctab[i,_y]; dot[i].z := ctab[i,_z]; end; for i := 1 to 64 do setpal(i,10+i div 3,10+i div 2,i); end; procedure csin(var stab : styp); var i : byte; begin for i := 0 to 255 do stab[i] := round(sin(2*i*pi/255)*divd); end; function sinus(i : byte) : integer; begin sinus := stab[i]; end; {function sinus(i : word) : integer; assembler; asm mov di,i; mov ax,word ptr stab[di]; end;} function cosin(i : byte) : integer; begin cosin := stab[(i+192) mod 255]; end; {function cosin(i : word) : integer; assembler; asm mov di,i; add di,192; mov ax,word ptr stab[di]; and ax,255 end;} function esc : boolean; begin esc := port[$60] = 1; end; procedure bumprotate; const xst = spd; yst = spd; zst = -spd; xdiv : shortint = 1; var xp : array[0..dots] of word; { 0 -> 319 } yp : array[0..dots] of byte; { 0 -> 199 } objx,n : word; x,y,z,i,j,k : integer; pc,phix,phiy,phiz : byte; begin objx := 160; pc := 128; phix := 0; phiy := 0; phiz := 0; repeat asm mov dx,03dah @l1: in al,dx test al,8 jnz @l1 @l2: in al,dx test al,8 jz @l2 end; { retrace } setpal(0,15,0,0); for n := 0 to dots do begin asm mov es,gseg { put graphicssegment in es } mov si,n { get index } xor ah,ah { clear hi-byte } mov al,byte ptr yp[si] { get indexed-value from yp } cmp al,200 { check if value greater than 200 } jae @skip { if so, then jump out } shl si,1 { x2 for word-size } mov bx,word ptr xp[si] { get indexed-value from xp } cmp bx,320 { check if value greater than 320 } jae @skip { if so, then jump out } shl ax,6 { multiply with 64 } mov di,ax { keep in di } shl ax,2 { multiply with 4 } add di,ax { add with di (64+(4*64)=320) } add di,bx { add horizontal value } xor al,al { al zero (black color) } mov [es:di],al { move to screen } @skip: end; { check if dot in screen, if so: clear it } i := (cosin(phiy)*dot[n].x - sinus(phiy)*dot[n].z) div divd; j := (cosin(phiz)*dot[n].y - sinus(phiz)*i) div divd; k := (cosin(phiz)*dot[n].z + sinus(phiy)*dot[n].x) div divd; x := (cosin(phiz)*i + sinus(phiz)*dot[n].y) div divd; y := (cosin(phix)*j + sinus(phix)*k) div divd; z := (cosin(phix)*k - sinus(phix)*j) div divd; xp[n] := objx+(-x*dist) div (z-dist); yp[n] := 50+ptab[pc]+(-y*dist) div (z-dist); asm mov es,gseg; { put graphicssegment in es } mov si,n { get index } xor ah,ah { clear hi-byte } mov al,byte ptr yp[si] { get indexed-value from yp } cmp al,200 { check if value greater than 200 } jae @skip { if so, then jump out } shl si,1 { x2 for word-size } mov bx,word ptr xp[si] { get indexed-value from xp } cmp bx,320 { check if value greater than 320 } jae @skip { if so, then jump out } shl ax,6 { multiply with 64 } mov di,ax { keep in di } shl ax,2 { multiply with 4 } add di,ax { add with di (64+(4*64)=320) } add di,bx { add horizontal value } mov ax,z { get z (depth) value } shr ax,1 { divide by 2 (range/2=30) } add ax,32 { add 32, ax is now in range 0 -> 64 } mov [es:di],al { move to screen } @skip: end; { check if dot in screen, if so: set it } end; inc(objx,xdiv); if (objx < 35) or (objx > 285) then xdiv := -xdiv; inc(pc,spd); inc(phix,xst); inc(phiy,yst); inc(phiz,zst); setpal(0,0,0,0); until esc; end; begin asm mov ax,13h; int 10h; end; init; csin(stab); bumprotate; asm mov ax,3; int 10h; end; end.