home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
PHRO.ZIP
/
FACE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-07-21
|
4KB
|
193 lines
{ 3D Phong Shaded Vector Face Source FIle }
{ PHRO! }
{ Phred/OTM }
{ achalfin@uceng.uc.edu }
{ DO NOT DISTRIBUTE THIS SOURCE FILE }
Unit Face;
Interface
Procedure VectorFace;
Implementation
Uses Vector;
Type
tArray = Array[0..256*256-2] of Byte;
pArray = ^tArray;
Var
FaceVOPtr : Pointer;
StarVoPtr : Pointer;
EnvMap : pArray;
VPage : pArray;
EnvSine : Array[0..255] of Integer;
{$F+}
{$L Facevo.Obj}
Procedure FaceVO; External;
Procedure CalcSine;
Var
Count : Integer;
Begin
For Count := 0 to 255 do
EnvSine[Count] := Round(Sin(Count*Pi/256)*256);
End;
Function FixedMul(M1, M2 : Integer) : Integer; Assembler;
Asm
Mov ax,M1
IMul M2
db 0fh,0ach,0d0h,08h { Shrd ax,dx,8 }
Mov bx,63
IMul bx
db 0fh,0ach,0d0h,08h { Shrd ax,dx,8 }
End;
Procedure MakePhongEnv;
Var
PhiCount : Integer;
ThetaCount : Integer;
Begin
For PhiCount := 0 to 255 do
For ThetaCount := 0 to 255 do
EnvMap^[PhiCount Shl 8 + ThetaCount] := (FixedMul(EnvSine[PhiCount], EnvSine[ThetaCount]));
End;
Procedure MotionClear(Var D; Step : Byte); Assembler;
Asm
Les di,D
Mov bl,Step
Mov cx,64000
@Looper:
Mov al,es:[di]
Sub al,bl
Jns @SkipZero
Mov al,0
@SkipZero:
Mov es:[di],al
Inc di
Dec cx
Jnz @Looper
End;
Procedure CopyPage(P : Pointer); Assembler;
Asm
Push ds
Lds si,P
Mov ax,$A000
Mov es,ax
Xor di,di
db 66h; Mov cx,16000; dw 0;
db 66h; Rep Movsw
Pop ds
End;
Procedure ClearPage(P : Pointer); Assembler;
Asm
Les di,P
db 66h; Xor ax,ax
db 66h; Mov cx,16000; dw 0;
db 66h; Rep Stosw
End;
Procedure SetFadePalette(r1, g1, b1, r2, g2, b2, CStart, CEnd : Byte);
Var
RStep, GStep, BStep : Longint;
RVal, GVal, BVal : Longint;
Count : Integer;
Begin
RVal := Longint(R1) Shl 8;
GVal := Longint(G1) Shl 8;
BVal := Longint(B1) Shl 8;
RStep := Longint(R2-R1+1) Shl 8 Div (CEnd-CStart+1);
GStep := Longint(G2-G1+1) Shl 8 Div (CEnd-CStart+1);
BStep := Longint(B2-B1+1) Shl 8 Div (CEnd-CStart+1);
For Count := CStart to CEnd do
Begin
Port[$3c8] := Count;
Port[$3c9] := RVal Div 256;
Port[$3c9] := GVal Div 256;
Port[$3c9] := BVal Div 256;
RVal := RVal + RStep;
GVal := GVal + gStep;
BVal := BVal + bStep;
End;
End;
Procedure VectorFace;
Var
Count : Integer;
Angle : Integer;
Begin
New(EnvMap);
New(VPage);
FillChar(VPage^[0], 64000, 0);
MakePhongEnv;
InitVectorRoutines(750);
LoadVectorObject(FaceVOPtr, 0, cPhongPoly);
SelectEnable(0, 1, EnvMap); { Enable face vector object, with phong tmap }
SetFadePalette(12, 0, 0, 48, 32, 0, 1, 49);
SetFadePalette(48, 32, 0, 63, 53, 43, 50, 63);
Angle := 0;
For Count := 50 downto 0 do
Begin
MotionClear(VPage^, 5);
Location(0, Count*4, 0, 200, 0, Angle, Angle);
DisplayVectorObjects(Seg(VPage^));
CopyPage(VPage);
Angle := (Angle + 3) and 511;
End;
For Count := -1 downto -50 do
Begin
MotionClear(VPage^, 5);
Location(0, Count*4, 0, 200, 0, Angle, Angle);
DisplayVectorObjects(Seg(VPage^));
CopyPage(VPage);
Angle := (Angle + 3) and 511;
End;
Angle := 256;
For Count := 50 downto 0 do
Begin
MotionClear(VPage^, 5);
Location(0, 0, Count*4, 200, 0, Angle, Angle);
DisplayVectorObjects(Seg(VPage^));
CopyPage(VPage);
Angle := (Angle + 3) and 511;
End;
For Count := -1 downto -50 do
Begin
MotionClear(VPage^, 5);
Location(0, 0, Count*4, 200, 0, Angle, Angle);
DisplayVectorObjects(Seg(VPage^));
CopyPage(VPage);
Angle := (Angle + 3) and 511;
End;
FreeVectorObject(0);
CloseVectorRoutines;
Dispose(VPage);
Dispose(EnvMap);
End;
Begin
CalcSine;
FaceVOPtr := @FaceVO;
End.