Скачать Bumping 3D Sphere [320x200x256]

20.11.1997
Скачать файл (2,43 Кб)




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.