home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / threedee.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-28  |  5KB  |  192 lines
  1.  
  2. {$r-}
  3. unit threedee;
  4.  
  5. interface
  6.  
  7. const
  8.   vidseg:word=$a000;
  9.   divd:word=128;
  10.  
  11. var
  12.   ctab:array[0..255] of integer;
  13.   stab:array[0..255] of integer;
  14.   virscr:pointer;
  15.   virseg:word;
  16.   minx,miny,maxx,maxy:integer;
  17.   border:boolean;
  18.  
  19. procedure setborder(col:byte);
  20. procedure retrace;
  21. procedure setpal(c,r,g,b:byte);
  22. procedure cls(lvseg:word);
  23. procedure flip(src,dst:word);
  24. procedure polygon(x1,y1,x2,y2,x3,y3,x4,y4:integer; c:byte);
  25. function sinus(i:byte):integer;
  26. function cosinus(i:byte):integer;
  27.  
  28. implementation
  29.  
  30. { -------------------------------------------------------------------------- }
  31.  
  32. procedure setborder(col:byte); assembler; asm
  33.   xor ch,ch; mov cl,border; jcxz @out; mov dx,3dah; in al,dx
  34.   mov dx,3c0h; mov al,11h+32; out dx,al; mov al,col; out dx,al; @out: end;
  35.  
  36. { -------------------------------------------------------------------------- }
  37.  
  38. procedure retrace; assembler; asm
  39.   mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  40.   @vert2: in al,dx; test al,8; jnz @vert2; end;
  41.  
  42. { -------------------------------------------------------------------------- }
  43.  
  44. procedure setpal(c,r,g,b:byte); assembler; asm
  45.   mov dx,3c8h; mov al,[c]; out dx,al; inc dx; mov al,[r]
  46.   out dx,al; mov al,[g]; out dx,al; mov al,[b]; out dx,al; end;
  47.  
  48. { -------------------------------------------------------------------------- }
  49.  
  50. procedure cls(lvseg:word); assembler; asm
  51.   mov es,[lvseg]; xor di,di; xor ax,ax; mov cx,320*200/2; rep stosw; end;
  52.  
  53. procedure flip(src,dst:word); assembler; asm
  54.   push ds; mov ax,[dst]; mov es,ax; mov ax,[src]; mov ds,ax
  55.   xor si,si; xor di,di; mov cx,320*200/2; rep movsw; pop ds; end;
  56.  
  57. { -------------------------------------------------------------------------- }
  58.  
  59. procedure horline(xb,xe,y:integer; c:byte); assembler;
  60. asm
  61.   mov bx,xb
  62.   mov cx,xe
  63.   cmp bx,cx
  64.   jb @skip
  65.   xchg bx,cx
  66.  @skip:
  67.   inc cx
  68.   sub cx,bx
  69.   mov es,virseg
  70.   mov ax,y
  71.   shl ax,6
  72.   mov di,ax
  73.   shl ax,2
  74.   add di,ax
  75.   add di,bx
  76.   mov al,c
  77.   shr cx,1
  78.   jnc @skip2
  79.   stosb
  80.  @skip2:
  81.   mov ah,al
  82.   rep stosw
  83.  @out:
  84. end;
  85.  
  86. function MaxI(A,B:Integer):Integer; inline(
  87.   $58/             { pop   ax     }
  88.   $5B/             { pop   bx     }
  89.   $3B/$C3/         { cmp   ax,bx  }
  90.   $7F/$01/         { jg    +1     }
  91.   $93);            { xchg  ax,bx  }
  92.  
  93. function MinI(A,B:Integer):Integer; inline(
  94.   $58/             { pop   ax     }
  95.   $5B/             { pop   bx     }
  96.   $3B/$C3/         { cmp   ax,bx  }
  97.   $7C/$01/         { jl    +1     }
  98.   $93);            { xchg  ax,bx  }
  99.  
  100. function InRangeI(value,min,max:integer):integer; inline(
  101.   $59/             { pop   cx max }
  102.   $5B/             { pop   bx min }
  103.   $58/             { pop   ax val }
  104.   $3B/$C3/         { cmp   ax,bx  }
  105.   $7F/$03/         { jg    +3     }
  106.   $93/             { xchg  ax,bx  }
  107.   $Eb/$05/         { jmp   +5     }
  108.   $3B/$C1/         { cmp   ax,cx  }
  109.   $7C/$01/         { jl    +1     }
  110.   $91);            { xchg  ax,cx  }
  111.  
  112. procedure polygon( x1,y1, x2,y2, x3,y3, x4,y4 :integer; c:byte);
  113. var pos:array[0..199,0..1] of integer;
  114.   xdiv1,xdiv2,xdiv3,xdiv4:integer;
  115.   ydiv1,ydiv2,ydiv3,ydiv4:integer;
  116.   dir1,dir2,dir3,dir4:byte;
  117.   ly,gy,y,tmp,step:integer;
  118. begin
  119.   { determine highest and lowest point + vertical window checking }
  120.   ly:=MaxI(MinI(MinI(MinI(y1,y2),y3),y4),miny);
  121.   gy:=MinI(MaxI(MaxI(MaxI(y1,y2),y3),y4),maxy);
  122.   if ly>maxy then exit;
  123.   if gy<miny then exit;
  124.  
  125.   { check directions (-1=down, 1=up) and calculate constants }
  126.   dir1:=byte(y1<y2); xdiv1:=x2-x1; ydiv1:=y2-y1;
  127.   dir2:=byte(y2<y3); xdiv2:=x3-x2; ydiv2:=y3-y2;
  128.   dir3:=byte(y3<y4); xdiv3:=x4-x3; ydiv3:=y4-y3;
  129.   dir4:=byte(y4<y1); xdiv4:=x1-x4; ydiv4:=y1-y4;
  130.  
  131.   y:=y1;
  132.   step:=dir1*2-1;
  133.   if y1<>y2 then repeat
  134.     if InRangeI(y,ly,gy)=y then begin
  135.       tmp:=xdiv1*(y-y1) div ydiv1+x1;
  136.       pos[y,dir1]:=InRangeI(tmp,minx,maxx);
  137.     end;
  138.     inc(y,step);
  139.   until y=y2+step
  140.   else if (y>=ly) and (y<=gy) then pos[y,dir1]:=InRangeI(x1,minx,maxx);
  141.  
  142.   y:=y2;
  143.   step:=dir2*2-1;
  144.   if y2<>y3 then repeat
  145.     if InRangeI(y,ly,gy)=y then begin
  146.       tmp:=xdiv2*(y-y2) div ydiv2+x2;
  147.       pos[y,dir2]:=InRangeI(tmp,minx,maxx);
  148.     end;
  149.     inc(y,step);
  150.   until y=y3+step
  151.   else if (y>=ly) and (y<=gy) then pos[y,dir2]:=InRangeI(x2,minx,maxx);
  152.  
  153.   y:=y3;
  154.   step:=dir3*2-1;
  155.   if y3<>y4 then repeat
  156.     if InRangeI(y,ly,gy)=y then begin
  157.       tmp:=xdiv3*(y-y3) div ydiv3+x3;
  158.       pos[y,dir3]:=InRangeI(tmp,minx,maxx);
  159.     end;
  160.     inc(y,step);
  161.   until y=y4+step
  162.   else if (y>=ly) and (y<=gy) then pos[y,dir3]:=InRangeI(x3,minx,maxx);
  163.  
  164.   y:=y4;
  165.   step:=dir4*2-1;
  166.   if y4<>y1 then repeat
  167.     if InRangeI(y,ly,gy)=y then begin
  168.       tmp:=xdiv4*(y-y4) div ydiv4+x4;
  169.       pos[y,dir4]:=InRangeI(tmp,minx,maxx);
  170.     end;
  171.     inc(y,step);
  172.   until y=y1+step
  173.   else if (y>=ly) and (y<=gy) then pos[y,dir4]:=InRangeI(x4,minx,maxx);
  174.  
  175.   for y:=ly to gy do horline(pos[y,0],pos[y,1],y,c);
  176. end;
  177.  
  178. { -------------------------------------------------------------------------- }
  179.  
  180. function cosinus(i:byte):integer; begin cosinus:=ctab[i]; end;
  181. function sinus(i:byte):integer; begin sinus:=stab[i]; end;
  182.  
  183. { -------------------------------------------------------------------------- }
  184.  
  185. var i:byte;
  186. begin
  187.   border:=false;
  188.   minx:=0; miny:=0; maxx:=319; maxy:=199;
  189.   for i:=0 to 255 do ctab[i]:=round(-cos(i*pi/128)*divd);
  190.   for i:=0 to 255 do stab[i]:=round(sin(i*pi/128)*divd);
  191. end.
  192.