home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / TUT16.ZIP / GFX2.PAS next >
Pascal/Delphi Source File  |  1994-04-25  |  11KB  |  393 lines
  1. Unit GFX2;
  2.  
  3.  
  4. INTERFACE
  5.  
  6. USES crt;
  7. CONST VGA = $A000;
  8.  
  9. TYPE Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
  10.      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }
  11.  
  12. VAR Virscr : VirtPtr;                     { Our first Virtual screen }
  13.     Vaddr  : word;                        { The segment of our virtual screen}
  14.  
  15. Procedure SetMCGA;
  16.    { This procedure gets you into 320x200x256 mode. }
  17. Procedure SetText;
  18.    { This procedure returns you to text mode.  }
  19. Procedure Cls (Where:word;Col : Byte);
  20.    { This clears the screen to the specified color }
  21. Procedure SetUpVirtual;
  22.    { This sets up the memory needed for the virtual screen }
  23. Procedure ShutDown;
  24.    { This frees the memory used by the virtual screen }
  25. procedure flip(source,dest:Word);
  26.    { This copies the entire screen at "source" to destination }
  27. Procedure Pal(Col,R,G,B : Byte);
  28.    { This sets the Red, Green and Blue values of a certain color }
  29. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  30.   { This gets the Red, Green and Blue values of a certain color }
  31. procedure WaitRetrace;
  32.    {  This waits for a vertical retrace to reduce snow on the screen }
  33. Procedure Hline (x1,x2,y:word;col:byte;where:word);
  34.    { This draws a horizontal line from x1 to x2 on line y in color col }
  35. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  36.   { This draws a solid line from a,b to c,d in colour col }
  37. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  38.    { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  39.      in color col }
  40. Function rad (theta : real) : real;
  41.    {  This calculates the degrees of an angle }
  42. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
  43.    { This puts a pixel on the screen by writing directly to memory. }
  44. Function Getpixel (X,Y : Integer; where:word) :Byte;
  45.    { This gets the pixel on the screen by reading directly to memory. }
  46. Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  47.   { This loads the cel 'filename' into the pointer scrptr }
  48.  
  49.  
  50. IMPLEMENTATION
  51.  
  52. {──────────────────────────────────────────────────────────────────────────}
  53. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  54. BEGIN
  55.   asm
  56.      mov        ax,0013h
  57.      int        10h
  58.   end;
  59. END;
  60.  
  61. {──────────────────────────────────────────────────────────────────────────}
  62. Procedure SetText;  { This procedure returns you to text mode.  }
  63. BEGIN
  64.   asm
  65.      mov        ax,0003h
  66.      int        10h
  67.   end;
  68. END;
  69.  
  70. {──────────────────────────────────────────────────────────────────────────}
  71. Procedure Cls (Where:word;Col : Byte); assembler;
  72.    { This clears the screen to the specified color }
  73. asm
  74.    push    es
  75.    mov     cx, 32000;
  76.    mov     es,[where]
  77.    xor     di,di
  78.    mov     al,[col]
  79.    mov     ah,al
  80.    rep     stosw
  81.    pop     es
  82. End;
  83.  
  84. {──────────────────────────────────────────────────────────────────────────}
  85. Procedure SetUpVirtual;
  86.    { This sets up the memory needed for the virtual screen }
  87. BEGIN
  88.   GetMem (VirScr,64000);
  89.   vaddr := seg (virscr^);
  90. END;
  91.  
  92. {──────────────────────────────────────────────────────────────────────────}
  93. Procedure ShutDown;
  94.    { This frees the memory used by the virtual screen }
  95. BEGIN
  96.   FreeMem (VirScr,64000);
  97. END;
  98.  
  99. {──────────────────────────────────────────────────────────────────────────}
  100. procedure flip(source,dest:Word); assembler;
  101.   { This copies the entire screen at "source" to destination }
  102. asm
  103.   push    ds
  104.   mov     ax, [Dest]
  105.   mov     es, ax
  106.   mov     ax, [Source]
  107.   mov     ds, ax
  108.   xor     si, si
  109.   xor     di, di
  110.   mov     cx, 32000
  111.   rep     movsw
  112.   pop     ds
  113. end;
  114.  
  115. {──────────────────────────────────────────────────────────────────────────}
  116. Procedure Pal(Col,R,G,B : Byte); assembler;
  117.   { This sets the Red, Green and Blue values of a certain color }
  118. asm
  119.    mov    dx,3c8h
  120.    mov    al,[col]
  121.    out    dx,al
  122.    inc    dx
  123.    mov    al,[r]
  124.    out    dx,al
  125.    mov    al,[g]
  126.    out    dx,al
  127.    mov    al,[b]
  128.    out    dx,al
  129. end;
  130.  
  131. {──────────────────────────────────────────────────────────────────────────}
  132. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  133.   { This gets the Red, Green and Blue values of a certain color }
  134. Var
  135.    rr,gg,bb : Byte;
  136. Begin
  137.    asm
  138.       mov    dx,3c7h
  139.       mov    al,col
  140.       out    dx,al
  141.  
  142.       add    dx,2
  143.  
  144.       in     al,dx
  145.       mov    [rr],al
  146.       in     al,dx
  147.       mov    [gg],al
  148.       in     al,dx
  149.       mov    [bb],al
  150.    end;
  151.    r := rr;
  152.    g := gg;
  153.    b := bb;
  154. end;
  155.  
  156. {──────────────────────────────────────────────────────────────────────────}
  157. procedure WaitRetrace; assembler;
  158.   {  This waits for a vertical retrace to reduce snow on the screen }
  159. label
  160.   l1, l2;
  161. asm
  162.     mov dx,3DAh
  163. l1:
  164.     in al,dx
  165.     and al,08h
  166.     jnz l1
  167. l2:
  168.     in al,dx
  169.     and al,08h
  170.     jz  l2
  171. end;
  172.  
  173. {──────────────────────────────────────────────────────────────────────────}
  174. Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
  175.   { This draws a horizontal line from x1 to x2 on line y in color col }
  176. asm
  177.   mov   ax,where
  178.   mov   es,ax
  179.   mov   ax,y
  180.   mov   di,ax
  181.   shl   ax,8
  182.   shl   di,6
  183.   add   di,ax
  184.   add   di,x1
  185.  
  186.   mov   al,col
  187.   mov   ah,al
  188.   mov   cx,x2
  189.   sub   cx,x1
  190.   shr   cx,1
  191.   jnc   @start
  192.   stosb
  193. @Start :
  194.   rep   stosw
  195. end;
  196.  
  197. {──────────────────────────────────────────────────────────────────────────}
  198. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  199.   { This draws a solid line from a,b to c,d in colour col }
  200.   function sgn(a:real):integer;
  201.   begin
  202.        if a>0 then sgn:=+1;
  203.        if a<0 then sgn:=-1;
  204.        if a=0 then sgn:=0;
  205.   end;
  206. var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
  207. begin
  208.      u:= c - a;
  209.      v:= d - b;
  210.      d1x:= SGN(u);
  211.      d1y:= SGN(v);
  212.      d2x:= SGN(u);
  213.      d2y:= 0;
  214.      m:= ABS(u);
  215.      n := ABS(v);
  216.      IF NOT (M>N) then
  217.      BEGIN
  218.           d2x := 0 ;
  219.           d2y := SGN(v);
  220.           m := ABS(v);
  221.           n := ABS(u);
  222.      END;
  223.      s := m shr 1;
  224.      FOR i := 0 TO m DO
  225.      BEGIN
  226.           putpixel(a,b,col,where);
  227.           s := s + n;
  228.           IF not (s<m) THEN
  229.           BEGIN
  230.                s := s - m;
  231.                a:= a + d1x;
  232.                b := b + d1y;
  233.           END
  234.           ELSE
  235.           BEGIN
  236.                a := a + d2x;
  237.                b := b + d2y;
  238.           END;
  239.      end;
  240. END;
  241.  
  242.  
  243. {──────────────────────────────────────────────────────────────────────────}
  244. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  245.   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  246.     in color col }
  247. var
  248.   x:integer;
  249.   mny,mxy:integer;
  250.   mnx,mxx,yc:integer;
  251.   mul1,div1,
  252.   mul2,div2,
  253.   mul3,div3,
  254.   mul4,div4:integer;
  255.  
  256. begin
  257.   mny:=y1; mxy:=y1;
  258.   if y2<mny then mny:=y2;
  259.   if y2>mxy then mxy:=y2;
  260.   if y3<mny then mny:=y3;
  261.   if y3>mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
  262.   if y4<mny then mny:=y4;
  263.   if y4>mxy then mxy:=y4;
  264.  
  265.   if mny<0 then mny:=0;
  266.   if mxy>199 then mxy:=199;
  267.   if mny>199 then exit;
  268.   if mxy<0 then exit;        { Verticle range checking }
  269.  
  270.   mul1:=x1-x4; div1:=y1-y4;
  271.   mul2:=x2-x1; div2:=y2-y1;
  272.   mul3:=x3-x2; div3:=y3-y2;
  273.   mul4:=x4-x3; div4:=y4-y3;  { Constansts needed for intersection calc }
  274.  
  275.   for yc:=mny to mxy do
  276.     begin
  277.       mnx:=320;
  278.       mxx:=-1;
  279.       if (y4>=yc) or (y1>=yc) then
  280.         if (y4<=yc) or (y1<=yc) then   { Check that yc is between y1 and y4 }
  281.           if not(y4=y1) then
  282.             begin
  283.               x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
  284.               if x<mnx then
  285.                 mnx:=x;
  286.               if x>mxx then
  287.                 mxx:=x;       { Set point as start or end of horiz line }
  288.             end;
  289.       if (y1>=yc) or (y2>=yc) then
  290.         if (y1<=yc) or (y2<=yc) then   { Check that yc is between y1 and y2 }
  291.           if not(y1=y2) then
  292.             begin
  293.               x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
  294.               if x<mnx then
  295.                 mnx:=x;
  296.               if x>mxx then
  297.                 mxx:=x;       { Set point as start or end of horiz line }
  298.             end;
  299.       if (y2>=yc) or (y3>=yc) then
  300.         if (y2<=yc) or (y3<=yc) then   { Check that yc is between y2 and y3 }
  301.           if not(y2=y3) then
  302.             begin
  303.               x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
  304.               if x<mnx then
  305.                 mnx:=x;
  306.               if x>mxx then
  307.                 mxx:=x;       { Set point as start or end of horiz line }
  308.             end;
  309.       if (y3>=yc) or (y4>=yc) then
  310.         if (y3<=yc) or (y4<=yc) then   { Check that yc is between y3 and y4 }
  311.           if not(y3=y4) then
  312.             begin
  313.               x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
  314.               if x<mnx then
  315.                 mnx:=x;
  316.               if x>mxx then
  317.                 mxx:=x;       { Set point as start or end of horiz line }
  318.             end;
  319.       if mnx<0 then
  320.         mnx:=0;
  321.       if mxx>319 then
  322.         mxx:=319;          { Range checking on horizontal line }
  323.       if mnx<=mxx then
  324.         hline (mnx,mxx,yc,color,where);   { Draw the horizontal line }
  325.     end;
  326.   end;
  327.  
  328. {──────────────────────────────────────────────────────────────────────────}
  329. Function rad (theta : real) : real;
  330.   {  This calculates the degrees of an angle }
  331. BEGIN
  332.   rad := theta * pi / 180
  333. END;
  334.  
  335. {──────────────────────────────────────────────────────────────────────────}
  336. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
  337.   { This puts a pixel on the screen by writing directly to memory. }
  338. Asm
  339.   mov     ax,[where]
  340.   mov     es,ax
  341.   mov     bx,[X]
  342.   mov     dx,[Y]
  343.   mov     di,bx
  344.   mov     bx, dx                  {; bx = dx}
  345.   shl     dx, 8
  346.   shl     bx, 6
  347.   add     dx, bx                  {; dx = dx + bx (ie y*320)}
  348.   add     di, dx                  {; finalise location}
  349.   mov     al, [Col]
  350.   stosb
  351. End;
  352.  
  353. {──────────────────────────────────────────────────────────────────────────}
  354. Function Getpixel (X,Y : Integer; where:word):byte; assembler;
  355.   { This puts a pixel on the screen by writing directly to memory. }
  356. Asm
  357.   mov     ax,[where]
  358.   mov     es,ax
  359.   mov     bx,[X]
  360.   mov     dx,[Y]
  361.   mov     di,bx
  362.   mov     bx, dx                  {; bx = dx}
  363.   shl     dx, 8
  364.   shl     bx, 6
  365.   add     dx, bx                  {; dx = dx + bx (ie y*320)}
  366.   add     di, dx                  {; finalise location}
  367.   mov     al, es:[di]
  368. End;
  369.  
  370. {──────────────────────────────────────────────────────────────────────────}
  371. Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  372.   { This loads the cel 'filename' into the pointer scrptr }
  373. var
  374.   Fil : file;
  375.   Buf : array [1..1024] of byte;
  376.   BlocksRead, Count : word;
  377. begin
  378.   assign (Fil, FileName);
  379.   reset (Fil, 1);
  380.   BlockRead (Fil, Buf, 800);    { Read and ignore the 800 byte header }
  381.   Count := 0; BlocksRead := $FFFF;
  382.   while (not eof (Fil)) and (BlocksRead <> 0) do begin
  383.     BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
  384.     Count := Count + 1024;
  385.   end;
  386.   close (Fil);
  387. end;
  388.  
  389.  
  390.  
  391.  
  392. BEGIN
  393. END.