home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / GRAPHICS / PHONGSRC.ZIP / GRUNIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-07  |  5.5 KB  |  183 lines

  1. {   _______________________________________________________________________
  2.   /                                                                         \
  3.  |  Little graphics unit. Code again by Inopia. Have phun! PS: The little    |
  4.  |  KickPcx2Screen thingie totally ignores the header, so don't be surprised |
  5.  |  when it won't load your 1280x1024x16m PCX files......                    |
  6.   \ _______________________________________________________________________ /
  7. }
  8. Unit GRUnit;
  9.  
  10. Interface
  11.  
  12. Uses VarUnit;
  13.  
  14. Procedure Set320X200;
  15. Procedure SetText;
  16. Procedure SetRGBColor(NR,R,G,B:BYTE);
  17. Procedure MyMove(Var Src,Dst;Bigness:Word);
  18. Procedure MyFill(Var Dst;Bigness:Word;color:byte);
  19. Procedure Polygon(X1,Y1,X2,Y2,X3,Y3:integer;txt:vert4;c:integer);
  20. Procedure Sline(x1,x2,y,tx1,tx2,ty1,ty2,c:integer);
  21. Procedure KickPcx2Screen(Image:Pointer;var page);
  22. Procedure Place_Polys;
  23.  
  24. Implementation
  25.  
  26. Procedure Set320X200; assembler;
  27. Asm MOV AX,013H; INT 10h; End;
  28.  
  29. Procedure SetText; assembler;
  30. Asm MOV AX,03h; INT 10h; End;
  31.  
  32. Procedure SetRGBColor(NR,R,G,B:BYTE); assembler;
  33. asm
  34.   MOV DX,03C8h
  35.   MOV AL,NR
  36.   OUT DX,al
  37.   INC DX
  38.   MOV AL,R
  39.   OUT DX,AL
  40.   MOV AL,G
  41.   OUT DX,AL
  42.   MOV AL,B
  43.   OUT DX,AL
  44. end;
  45.  
  46. Procedure MyMove(Var Src,Dst;Bigness:Word); AssEmbler;
  47. Asm
  48.   PUSH DS
  49.   LDS SI,SRC
  50.   LES DI,DST
  51.   MOV CX,BIGNESS
  52.   SHR CX,2
  53.   DB  066h
  54.   REP MOVSW
  55.   POP DS
  56. End;
  57.  
  58. Procedure MyFill(Var Dst;Bigness:Word;color:byte); AssEmbler;
  59. Asm
  60.   LES DI,DST
  61.   MOV AL,COLOR
  62.   MOV AH,AL
  63.   PUSH AX
  64.   PUSH AX
  65.   DB  66h
  66.   POP AX
  67.   MOV CX,BIGNESS
  68.   SHR CX,2
  69.   DB  066h
  70.   REP STOSW
  71. End;
  72.  
  73. Procedure Sline(X1,X2,Y,TX1,TX2,TY1,TY2,C:Integer);
  74. Var SX,SY,I : Integer;
  75. Begin
  76.   If X2=X1 Then Exit;
  77.   If X1>X2 Then Begin
  78.     I := X1;
  79.     X1 := X2;
  80.     X2 := I;
  81.     I := TX1;
  82.     TX1 := TX2;
  83.     TX2 := I;
  84.     I := TY1;
  85.     TY1 := TY2;
  86.     TY2 := I;
  87.   End;
  88.   SX := ((TX2-TX1) SHL 7) div (X2-X1);
  89.   SY := ((TY2-TY1) SHL 7) div (X2-X1);
  90.   If x1<1 then x1 := 1; If x1>318 then x1 := 318;
  91.   If x2<1 then x2 := 1; If x2>318 then x2 := 318;
  92.   For I := 0 to (X2-X1)+1 do buffer^[Y*320+I+X1] := emap^[(TY1+((I*SY) SHR 7))*256+TX1+((I*SX) SHR 7)]+c;
  93. End;
  94.  
  95. Procedure KickPcx2Screen(Image:Pointer;var page);
  96. Var PS,PO,s,o    : Word;
  97.     ScreenCount  : longint;
  98.     Data,Count,I : Byte;
  99.     ImageCnt     : Word;
  100.     palette      : array[0..255,0..2] of byte;
  101. begin
  102.   PS := Seg(Image^); PO := Ofs(Image^)+128;
  103.   S := Seg(page); O := Ofs(page);
  104.   Screencount := 0; ImageCnt := 0;
  105.   repeat
  106.     I := Mem[PS:PO]; Inc(PO);
  107.     if I and 192 = 192 then Begin
  108.       Count := I and 63;
  109.       I := Mem[PS:PO]; Inc(PO);
  110.       Data := I;
  111.     End Else Begin Data := I; Count := 1; End;
  112.     for I := 1 to Count do Begin
  113.       Mem[S:O+ScreenCount] := data;
  114.       Inc(ScreenCount);
  115.     End;
  116.   Until ScreenCount > 65534;
  117.   Move(Mem[PS:PO+1],Palette,Sizeof(Palette));
  118.   For I := 0 to 255 do Begin
  119.     Palette[I,0] := Palette[I,0] div 4;
  120.     Palette[I,1] := Palette[I,1] div 4;
  121.     Palette[I,2] := Palette[I,2] div 4;
  122.   End;
  123.   for i := 0 to 255 do setrgbcolor(i,palette[i,0],palette[i,1],palette[i,2]);
  124. end;
  125.  
  126.  
  127. Procedure Polygon(X1,Y1,X2,Y2,X3,Y3:integer;txt:vert4;c:integer);
  128. Var XValues                 : Array[0..199,0..1] of Integer;
  129.     TXValues                : Array[0..199,0..1] of Integer;
  130.     TYValues                : Array[0..199,0..1] of Integer;
  131.     I, Y, Min, Max          : Integer;
  132.     Step                    : ShortInt;
  133.     Side, Number            : Byte;
  134.     TX, TY, SX, SY,K,X      : Integer;
  135.     TZ, SZ                  : Integer;
  136.     TTX,TTY,STX,STY         : Integer;
  137.     SX1,SX2,SX3,SY1,SY2,SY3 : Longint;
  138. begin
  139.   SX1 := TXT.VN[0].XT; SY1 := TXT.VN[0].YT;
  140.   SX2 := TXT.VN[1].XT; SY2 := TXT.VN[1].YT;
  141.   SX3 := TXT.VN[2].XT; SY3 := TXT.VN[2].YT;
  142.   If (X1<0) and (X2<0) and (X3<0) then exit;
  143.   If (X1>319) and (X2>319) and (X3>319) then exit;
  144.   If (Y1<0) and (Y2<0) and (Y3<0) then exit;
  145.   If (Y1>199) and (Y2>199) and (Y3>199) then exit;
  146.   Min := Y1; if Y2 < Min then Min := Y2; if Y3 < Min then Min := Y3;
  147.   Max := Y1; if Y2 > Max then Max := Y2; if Y3 > Max then Max := Y3;
  148.   for Number := 0 to 3 do Begin
  149.     if Number = 0 then Begin TX := X1; TY := Y1; TTX := SX1; TTY := SY1; SX := X2; SY := Y2; STX := SX2; STY := SY2; end;
  150.     if Number = 1 then Begin TX := X2; TY := Y2; TTX := SX2; TTY := SY2; SX := X3; SY := Y3; STX := SX3; STY := SY3; end;
  151.     if Number = 2 then Begin TX := X3; TY := Y3; TTX := SX3; TTY := SY3; SX := X1; SY := Y1; STX := SX1; STY := SY1; end;
  152.     Step := Byte(TY<SY)*2-1;
  153.     Y := TY; Side := Byte(TY<SY);
  154.     if TY <> SY then Begin
  155.       Repeat
  156.         If (Y>0) and (Y<199) then begin
  157.           XValues[Y,Side] := Integer(SX-TX)*(Y-TY) div (SY-TY)+TX;;
  158.           TXValues[Y,Side] := Integer(STX-TTX)*(Y-TY) div (SY-TY)+TTX;
  159.           TYValues[Y,Side] := Integer(STY-TTY)*(Y-TY) div (SY-TY)+TTY;
  160.         end;
  161.         Inc(Y,Step);
  162.       Until Y = SY+Step;
  163.     End Else If (Y>0) and (Y<199) then Begin
  164.       XValues[Y,Side] := tx;
  165.       TXValues[Y,Side] := TTX;
  166.       TYValues[Y,Side] := TTY;
  167.     End;
  168.   End;
  169.   for I := Min to Max-1 do if (i>0) and (i<199) then
  170.     Sline(XValues[I,0],XValues[I,1],I,TXValues[I,0],TXValues[I,1],TYValues[I,0],TYValues[I,1],c);
  171. End;
  172.  
  173. Procedure Place_Polys;
  174. Begin
  175.   for i := faces downto 0 do {if Fshow[sortedz[i]] then}
  176.     Polygon(x[face[sortedz[i],0]],y[face[sortedz[i],0]],
  177.             x[face[sortedz[i],1]],y[face[sortedz[i],1]],
  178.             x[face[sortedz[i],2]],y[face[sortedz[i],2]],
  179.             vns[sortedz[i]],0);
  180. End;
  181.  
  182. Begin
  183. End.