-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathEngine3D_Boxes.p
1587 lines (1370 loc) · 37 KB
/
Engine3D_Boxes.p
1
unit Engine3D_Boxes;interfaceuses types, quickdraw, lowlevel, Dream3Display_Tipi, Engine3D_Globals;const MaxBoxes = 256;type Box3D = record MapRect : rect; Height : integer; LeftCIconId : integer; TopCIconId : integer; RightCIconId : integer; BottomCIconId : integer; UpperCIconId : integer; SideFullMask : boolean; Passable : boolean; UpperHeight : integer; LeftHeight : integer; TopHeight : integer; RightHeight : integer; BottomHeight : integer; LeftCIcon : ptr; TopCicon : ptr; RightCicon : ptr; BottomCIcon : ptr; UpperCIcon : ptr; upperSurface : integer; { 0 : normale, 1 : specchio, 2 : acqua, 3 : vetro (necessita di mxpl), 4 : texture opaca } reserved : integer; end; Box3DPtr = ^Box3D; Box3DHandle = ^Box3DPtr; TBoxList = array [1..MaxBoxes] of Box3DPtr; TBoxListPtr = ^TBoxList; var BoxN : integer; BoxList : TBoxListPtr;procedure InitBox;procedure GetBoxes (Id : integer);procedure RotateBoxes;procedure DrawTheUpper ( TheXScreen, TheXStart, TheBoxN : integer); procedure DisposeBoxes;implementation{$R-}uses memory, resources, qdoffscreen, icons, fixmath, toolutils, events, segload, cilindro, dreamtypes, Dream3Display_Tools, Engine3D_CIconArray, Engine3D_Rotate, Engine3D_DrawFloor; const Box3DResType = 'Box '; BoxListResType = 'BoxL'; BoxTrPoly = 6; type BoxListRes = record R1 : integer; Items : integer; BoxId : array [1..MaxBoxes] of integer; end; BoxListResPtr = ^BoxListRes; BoxListResHandle = ^BoxListResPtr; boxList1Item = record id : integer; theRect : rect; end; BoxListRes1 = record R1 : integer; Items : integer; BoxId : array [1..MaxBoxes] of boxList1Item; end; BoxListRes1Ptr = ^BoxListRes1; BoxListRes1Handle = ^BoxListRes1Ptr; BoxBaseArray = array [1..MaxBoxes * 4] of Poly3DBase; BoxBaseArrayPtr = ^BoxBaseArray; BoxPolyArray = array [1..MaxBoxes * 4] of Poly3D; BoxPolyArrayPtr = ^BoxPolyArray; var BoxBaseN : integer; BoxBase : BoxBaseArrayPtr; BoxPolys : BoxPolyArrayPtr;{$Engine3D_Boxes}procedure InitBox;begin BoxN := 0; BoxList := TBoxListPtr (newptr (sizeof (TBoxList))); if BoxList = nil then deathalert (erroutofmemory, MemError); BoxBase := BoxBaseArrayPtr (newptr (sizeof (BoxBaseArray))); if BoxBase = nil then deathalert (erroutofmemory, MemError);end;{$Engine3D_Boxes}function Get3DBox ( Id : integer) : Box3DPtr;var Tmp : Box3DHandle; Tmp2 : Box3DPtr; isNew : boolean; begin Tmp := Box3DHandle (mygetresource ('Box ', Id, true, true)); if Tmp = nil then deathalert (errmissingscenres, 0); hlock (handle (Tmp)); Tmp2 := Box3DPtr (newptr (sizeof (Box3D))); if Tmp2 = nil then deathalert (erroutofmemory, memerror); Tmp2^ := Tmp^^; if gethandlesize (handle (Tmp)) < sizeof (box3D) then { vecchia versione della scatola} Tmp2^.upperSurface := 0; releaseresource (handle (Tmp)); with Tmp2^ do begin LeftCicon := GetCiconOnPtr (LeftCIconId, false, isNew); TopCIcon := GetCiconOnPtr (TopCIconId, false, isNew); RightCIcon := GetCiconOnPtr (RightCIconId, false, isNew); BottomCIcon := GetCiconOnPtr (BottomCIconId, false, isNew); if upperCIconId <> 0 then begin UpperCIcon := GetCiconOnPtr (UpperCIconId, false, isNew); if isNew and environment.mipMap then begin mipMap64 (ptr (longint (upperCIcon) + 4096)); mipMap64 (ptr (longint (upperCIcon) + 8192)); end; end else upperCIcon := nil; end; Get3DBox := Tmp2;end;{$Engine3D_Boxes}function Get3DBox1 ( boxId : boxList1Item) : Box3DPtr;var Tmp : Box3DHandle; Tmp2 : Box3DPtr; isNew : boolean; begin Tmp := Box3DHandle (mygetresource ('Box ', boxId.id, true, true)); if Tmp = nil then deathalert (errmissingscenres, 0); hlock (handle (Tmp)); Tmp2 := Box3DPtr (newptr (sizeof (Box3D))); if Tmp2 = nil then deathalert (erroutofmemory, memerror); Tmp2^ := Tmp^^; if gethandlesize (handle (Tmp)) < sizeof (box3D) then { vecchia versione della scatola} Tmp2^.upperSurface := 0; releaseresource (handle (Tmp)); with Tmp2^ do begin LeftCicon := GetCiconOnPtr (LeftCIconId, false, isNew); TopCIcon := GetCiconOnPtr (TopCIconId, false, isNew); RightCIcon := GetCiconOnPtr (RightCIconId, false, isNew); BottomCIcon := GetCiconOnPtr (BottomCIconId, false, isNew); if upperCIconId <> 0 then begin UpperCIcon := GetCiconOnPtr (UpperCIconId, false, isNew); if isNew and environment.mipMap then begin mipMap64 (ptr (longint (upperCIcon) + 4096)); mipMap64 (ptr (longint (upperCIcon) + 8192)); end; end else upperCIcon := nil; end; tmp2^.mapRect := boxId.theRect; Get3DBox1 := Tmp2;end;{$Engine3D_Boxes}procedure DisposeBoxes;var I : integer; procedure DisposeABox ( var theBox : Box3DPtr);begin with theBox^ do begin DisposePICTOnPtr (LeftCIcon); DisposePICTOnPtr (TopCIcon); DisposePICTOnPtr (RightCIcon); DisposePICTOnPtr (BottomCIcon); if upperCIcon <> nil then DisposePICTOnPtr (UpperCIcon); end;end;begin for I := 1 to BoxN do begin DisposeABox (BoxList^ [I]); disposeptr (ptr (BoxList^ [I])); end; BoxN := 0;end;{$Engine3D_Boxes}procedure PutBoxInBase ( NBase : integer; var TheBox : Box3D);var N, I : integer; begin N := NBase * 4 - 3; for I := N to N + 3 do with BoxBase^ [I] do begin Height0 := TheBox.Height; HeightU := TheBox.UpperHeight; Next := I - N; Light := NBase; PoType := 6; FullMask := TheBox.SideFullMask; Seen := false; MustIBeShown := true; parameter := theBox.upperSurface; end; with BoxBase^ [N] do begin Height := TheBox.LeftHeight; CIcon := longint (TheBox.LeftCIcon); with RealCorner [0] do begin H := TheBox.MapRect.left; V := TheBox.MapRect.top ; end; with RealCorner [1] do begin H := TheBox.MapRect.left; V := TheBox.MapRect.bottom; end; end; with BoxBase^ [N + 1] do begin Height := TheBox.TopHeight; CIcon := longint (TheBox.TopCIcon); with RealCorner [0] do begin H := TheBox.MapRect.left; V := TheBox.MapRect.top; end; with RealCorner [1] do begin H := TheBox.MapRect.right; V := TheBox.MapRect.top; end; end; with BoxBase^ [N + 2] do begin Height := TheBox.RightHeight; CIcon := longint (TheBox.RightCIcon); with RealCorner [0] do begin H := TheBox.MapRect.right; V := TheBox.MapRect.top; end; with RealCorner [1] do begin H := TheBox.MapRect.right; V := TheBox.MapRect.bottom; end; end; with BoxBase^ [N + 3] do begin Height := TheBox.BottomHeight; CIcon := longint (TheBox.BottomCIcon); with RealCorner [0] do begin H := TheBox.MapRect.left; V := TheBox.MapRect.bottom; end; with RealCorner [1] do begin H := TheBox.MapRect.right; V := TheBox.MapRect.bottom; end; end;end;{$Engine3D_Boxes}procedure FillBoxBase;var I : integer; begin for I := 1 to BoxN do PutBoxInBase (I, BoxList^ [I]^); BoxBaseN := BoxN * 4;end;{$Engine3D_Boxes}procedure GetBoxes (Id : integer);label 100; var I : integer; Tmp : BoxListResHandle; tmp1 : boxListRes1Handle; superTmp : handle; theType : integer; begin superTmp := mygetresource (BoxListResType, Id, false, true); if superTmp <> nil then begin hlock (superTmp); theType := integerptr (superTmp^)^; releaseresource (superTmp); end else goto 100; BoxN := 0; if theType = 0 then begin Tmp := BoxListResHandle (mygetresource (BoxListResType, Id, false, true)); if Tmp <> nil then begin hlock (handle (Tmp)); BoxN := Tmp^^.Items + 1; for I := 1 to BoxN do BoxList^ [I] := Get3DBox (Tmp^^.BoxId [I]); releaseresource (handle (Tmp)); end; end else begin Tmp1 := BoxListRes1Handle (mygetresource (BoxListResType, Id, false, true)); if Tmp1 <> nil then begin hlock (handle (Tmp1)); BoxN := Tmp1^^.Items + 1; for I := 1 to BoxN do BoxList^ [I] := Get3DBox1 (Tmp1^^.BoxId [I]); releaseresource (handle (Tmp1)); end; end;100: FillBoxBase; waterShift := 1;end;{$S Engine3D_FastRotate}procedure RotateBoxs;label 100; const LimiteX = 1000; var I : integer; Help : FixedPoint; Tmp0h, Tmp0v, Tmp1h, Tmp1v : longint; PN_1 : integer; Tmp2 : longint; LocalPolys : PolyArrayPtr; LocalBoxPolys : BoxPolyarrayPtr; LocalBase : BoxBaseArrayPtr; TheSin, TheCos : integer; LocalPolyN : integer; WallHeight16 : longint; VPointH, VPointV : longint;begin WallHeight16 := bsl (Environment.StdWallHeight, 16); VPointH := Environment.ViewPoint.h; VPointV := Environment.ViewPoint.v; LocalPolys := PolysTr; LocalBoxPolys := BoxPolys; LocalBase := BoxBase; LocalPolyN := PolyNTr + 1; TheSin := DiscreteSin [Environment.ViewAngle]; TheCos := DiscreteCos [Environment.ViewAngle]; for I := BoxBaseN downto 1 do begin with LocalBase^ [I] do with LocalPolys^ [LocalPolyN] do begin Tmp0h := RealCorner [0].h - VPointH; Tmp0v := RealCorner [0].v - VPointV; Tmp1h := RealCorner [1].h - VPointH; Tmp1v := RealCorner [1].v - VPointV; ProjCorner0.Z := - Tmp0h * TheSin + Tmp0v * TheCos; if (ProjCorner0.Z < DistanceN40) or (ProjCorner0.Z > Environment.RayCastingDepth) then goto 100; ProjCorner1.Z := - Tmp1h * TheSin + Tmp1v * TheCos; if (ProjCorner1.Z < DistanceN40) or (ProjCorner1.Z > Environment.RayCastingDepth) then goto 100; ProjCorner0.X := Tmp0h * TheCos + Tmp0v * TheSin; ProjCorner1.X := Tmp1h * TheCos + Tmp1v * TheSin; ProjCorner0.X := (bsl (ProjCorner0.X, 9)) div (ProjCorner0.Z + Distance40); if (abs (ProjCorner0.X) > LimiteX) then goto 100; ProjCorner1.X := (bsl (ProjCorner1.X, 9)) div (ProjCorner1.Z + Distance40); if (abs (ProjCorner1.X) > LimiteX) then goto 100; MiddleZ := ProjCorner0.Z + ProjCorner1.Z; PN_1 := LocalPolyN; LocalPolyN := LocalPolyN + 1; if ProjCorner1.X < ProjCorner0.X then begin if (ProjCorner0.X < - WindowXCenter) or (ProjCorner1.X > WindowXCenter) then begin LocalPolyN := LocalPolyN - 1; goto 100; end; Help := ProjCorner1; ProjCorner1 := ProjCorner0; ProjCorner0 := Help; Dir := -1; end else begin if (ProjCorner0.X = ProjCorner1.X) or (ProjCorner1.X < - WindowXCenter) or (ProjCorner0.X > WindowXCenter) then begin LocalPolyN := LocalPolyN - 1; goto 100; end; Dir := 0; end; XDist := ProjCorner1.X - ProjCorner0.X + 1; with LocalPolys^ [PN_1] do begin Tmp2 := MiddleZ; if Tmp2 < 0 then Tmp2 := 0 else Tmp2 := bsr (Tmp2, 4); if Tmp2 < Environment.LightIndex3 then CIcon := LocalBase^ [I].CIcon else if Tmp2 < Environment.LightIndex2 then CIcon := longint (LocalBase^ [I].CIcon) + 4096 else CIcon := longint (LocalBase^ [I].CIcon) + 8192; end; LocalPolys^ [PN_1].FullMask := false; YEnd0 := (WallHeight16 - bsl (Height0, 16)) div (ProjCorner0.Z + Distance40); YEnd1 := (WallHeight16 - bsl (Height0, 16)) div (ProjCorner1.Z + Distance40); YStart0 := (WallHeight16 - bsl (Height, 16)) div (ProjCorner0.Z + Distance40); YStart1 := (WallHeight16 - bsl (Height, 16)) div (ProjCorner1.Z + Distance40); DYStart := fixdiv ((YStart1 - YStart0), XDist); DYEnd := fixdiv ((YEnd1 - YEnd0), XDist); with LocalPolys^ [PN_1] do begin PoType := 6; Next := LocalBase^ [I].Next; Levels := LocalBase^ [I].Light; BaseRef := I; parameter := LocalBase^ [I].parameter; end; PN_1 := PN_1 + 1; LocalPolys^ [PN_1] := LocalPolys^ [PN_1 - 1]; with LocalPolys^ [PN_1] do begin YStart0 := (WallHeight16 - bsl (HeightU, 16)) div (ProjCorner0.Z + Distance40); YStart1 := (WallHeight16 - bsl (HeightU, 16)) div (ProjCorner1.Z + Distance40); DYStart := fixdiv ((YStart1 - YStart0), XDist); PoType := 8; parameter := boxList^ [light]^.upperSurface; CIcon := longint (BoxList^ [Light]^.UpperCIcon); Animated := LocalBase^ [I].MustiBeShown; end; LocalPolyN := LocalPolyN + 1; end;100 : end; PolyNTr := LocalPolyN - 1;end;procedure RotateBoxes;var I1, F1, I, XMin, XMax, N : integer; Middle : longint; LPolysTr : PolyArrayPtr; begin if OddOrEven then begin WaterShift := WaterShift + 1; OddOrEven := false; end else OddOrEven := true; LPolysTr := PolysTr; I1 := PolyNTr + 1; RotateBoxs; F1 := PolyNTr; while I1 <= F1 do begin if LPolysTr^ [I1].PoType = 6 then begin I := LPolysTr^ [I1].Levels; XMin := LPolysTr^ [I1].ProjCorner0.X; XMax := LPolysTr^ [I1].ProjCorner1.X; Middle := LPolysTr^ [I1].MiddleZ; I1 := I1 + 1; N := 1; while (LPolysTr^ [I1].Levels = I) and (I1 <= F1) do begin if LPolysTr^ [I1].PoType = 6 then begin if LPolysTr^ [I1].ProjCorner0.X < XMIn then XMin := LPolysTr^ [I1].ProjCorner0.X; if LPolysTr^ [I1].ProjCorner1.X > XMax then XMax := LPolysTr^ [I1].ProjCorner1.X; Middle := Middle + LPolysTr^ [I1].MiddleZ; N := N + 1; end; I1 := I1 + 1; end; Middle := Middle div N - 1; PolyNTr := PolyNTr + 1; with LPolysTr^ [PolyNTr] do begin ProjCorner0.X := XMin; ProjCorner1.X := XMax; MiddleZ := Middle; PoType := 7; Levels := I; BaseRef := I; end; end else I1 := I1 + 1; end;end;{$S Engine3D}procedure DrawTheUpper (TheBoxN : integer; XStart, XEnd : integer);var TheX : integer; TheZ : longint; ThePolys : array [1..4] of Poly3DPtr; NPolys : integer; FarPoly, NearPoly : integer; TheMin : integer; TheCIconPtr : ptr; {$S Engine3D}procedure DrawTheUp ( TheCIcon : ptr; TheYStart, TheYEnd, TheStartSide, TheEndSide, TheXStart, TheXEnd : integer);var DeltaX, DeltaY, IconX, IconY : fixed; TheXstension : integer; TheSrcPtr : ptr; TheDstPtr : ptr; i : integer; TheDstIPtr : integerptr; LocalDstRow : integer; Tmp : integer; TheXBetter : integer; begin LocalDstRow := DstRow; TheXBetter := TheX + WindowXCenter; TheXstension := TheYEnd - TheYStart; if TheXStension = 0 then exit (DrawTheUp); if TheCIcon <> nil then begin case TheEndSide of 0 : begin IconX := 0; IconY := bsl (TheXEnd, 16); case TheStartSide of 1 : begin DeltaX := bsl (TheXStart, 16) div TheXstension; DeltaY := - bsl (TheXEnd, 16) div TheXstension; end; 2 : begin DeltaX := (63 * $10000) div TheXstension; DeltaY := bsl (TheXStart - TheXEnd, 16) div TheXstension; end; 3 : begin DeltaX := bsl (TheXStart, 16) div TheXstension; DeltaY := bsl (63 - TheXEnd, 16) div TheXstension; end; 0 : begin DeltaX := 0; DeltaY := bsl (TheXStart - TheXEnd, 16) div TheXstension; end; end; end; 1 : begin IconX := bsl (TheXEnd, 16); IconY := 0; case TheStartSide of 1 : begin DeltaX := fixdiv (TheXStart - TheXEnd, TheXstension); DeltaY := 0; end; 2 : begin DeltaX := fixdiv (63 - TheXEnd, TheXstension); DeltaY := fixdiv (TheXStart, TheXstension); end; 3 : begin DeltaX := fixdiv (TheXStart - TheXEnd, TheXstension); DeltaY := fixdiv (63, TheXstension); end; 0 : begin DeltaX := fixdiv (-TheXEnd, TheXstension); DeltaY := fixdiv (TheXStart, TheXstension); end; end; end; 2 : begin IconX := 63 * $10000; IconY := bsl (TheXEnd, 16); case TheStartSide of 1 : begin DeltaX := fixdiv (TheXStart - 63, TheXstension); DeltaY := fixdiv (-TheXEnd, TheXstension); end; 2 : begin DeltaX := 0; DeltaY := fixdiv (TheXStart - TheXEnd, TheXstension); end; 3 : begin DeltaX := fixdiv (TheXStart - 63, TheXstension); DeltaY := fixdiv (63 - TheXEnd, TheXstension); end; 0 : begin DeltaX := fixdiv (-63, TheXstension); DeltaY := fixdiv (TheXStart - TheXEnd, TheXstension); end; end; end; 3 : begin IconX := bsl (TheXEnd, 16); IconY := 63 * $10000; case TheStartSide of 1 : begin DeltaX := fixdiv (TheXStart - TheXEnd, TheXstension); DeltaY := fixdiv (-63, TheXstension); end; 2 : begin DeltaX := fixdiv (63 - TheXEnd, TheXstension); DeltaY := fixdiv (TheXStart - 63, TheXstension); end; 3 : begin DeltaX := fixdiv (TheXStart - TheXEnd, TheXstension); DeltaY := 0; end; 0 : begin DeltaX := fixdiv (-TheXEnd, TheXstension); DeltaY := fixdiv (TheXStart - 63, TheXstension); end; end; end; end; if TheXstension > 0 then begin TheXstension := TheXstension; if TheYEnd > 199 then begin TheXstension := TheXstension + 199 - TheYEnd; TheDstIPtr := integerptr (longint (OffScreenAddr) + TheXBetter + DstRowTop^ [199]); I := TheYEnd - 199; while I > 0 do begin I := I - 1; IconX := IconX + DeltaX; IconY := IconY + DeltaY; end; end else TheDstIPtr := integerptr (longint (OffScreenAddr) + TheXBetter + DstRowTop^ [TheYEnd]); I := TheXstension; if I <= 0 then exit (DrawTheUp); TheSrcPtr := TheCIcon; case Dettaglio of 1 : begin TheDstPtr := ptr (TheDstIPtr); while I <> 0 do begin I := I - 1; TheDstPtr^ := ptr (longint (TheSrcPtr) + band (bsr (IconY, 10), $FFFFFFC0) + bsr (IconX, 16))^; TheDstPtr := ptr (longint (TheDstPtr) - LocalDstRow); IconX := IconX + DeltaX; IconY := IconY + DeltaY; end; end; 2 : begin while I <> 0 do begin I := I - 1; Tmp := integerptr (longint (TheSrcPtr) + band (bsr (IconY, 10), $FFFFFFC0) + bsr (IconX, 16))^; TheDstIPtr^ := bor (bsr (Tmp, 8), band (Tmp, $FF00)); TheDstIPtr := integerptr (longint (TheDstIPtr) - LocalDstRow); IconX := IconX + DeltaX; IconY := IconY + DeltaY; end; end; end; end else begin TheXstension := -TheXstension; if TheYEnd < 0 then begin TheXstension := TheXstension + TheYEnd; TheDstIPtr := integerptr (longint (OffScreenAddr) + TheXBetter); I := -TheYEnd; while I > 0 do begin I := I - 1; IconX := IconX - DeltaX; IconY := IconY - DeltaY; end; end else TheDstIPtr := integerptr (longint (OffScreenAddr) + TheXBetter + DstRowTop^ [TheYEnd]); I := TheXstension; if I <= 0 then exit (DrawTheUp); TheSrcPtr := TheCIcon; case Dettaglio of 1 : begin TheDstPtr := ptr (TheDstIPtr); while I <> 0 do begin I := I - 1; TheDstPtr^:= ptr (longint (TheSrcPtr) + band (bsr (IconY, 10), $FFFFFFC0) + bsr (IconX, 16))^; TheDstPtr := ptr (longint (TheDstPtr) + LocalDstRow); IconX := IconX - DeltaX; IconY := IconY - DeltaY; end; end; 2 : begin while I <> 0 do begin I := I - 1; Tmp := integerptr (longint (TheSrcPtr) + band (bsr (IconY, 10), $FFFFFFC0) + bsr (IconX, 16))^; TheDstIPtr^ := bor (bsr (Tmp, 8), band (Tmp, $FF00)); TheDstIPtr := integerptr (longint (TheDstIPtr) + LocalDstRow); IconX := IconX - DeltaX; IconY := IconY - DeltaY; end; end; end; end; end;end;{$S Engine3D}procedure SortPolys;var I, J : integer; Tmp : Poly3DPtr; begin for I := 1 to NPolys - 1 do for J := I + 1 to NPolys do if ThePolys [I]^.MiddleZ > ThePolys [J]^.MiddleZ then begin Tmp := ThePolys [I]; ThePolys [I] := ThePolys [J]; ThePolys [J] := Tmp; end;end;{$S Engine3D}procedure GetFarAndNear;var I : integer; begin FarPoly := 0; NearPoly := 0; for I := 1 to NPolys do if (ThePolys [I]^.ProjCorner0.X <= TheX) and (ThePolys [I]^.ProjCorner1.X >= TheX) then FarPoly := I; for I := NPolys downto 1 do if (ThePolys [I]^.ProjCorner0.X <= TheX) and (ThePolys [I]^.ProjCorner1.X >= TheX) then NearPoly := I;end;{$S Engine3D}procedure FindPolys;var I : integer; LocalPolys : PolyArrayPtr; begin LocalPolys := PolysTr; NPolys := 0; for I := PolyNTr downto 1 do if (LocalPolys^ [I].PoType = 8) and (LocalPolys^ [I].Levels = TheBoxN) then begin NPolys := NPolys + 1; ThePolys [NPolys] := @LocalPolys^ [I]; end;end;{$S Engine3D}function GetY ( ThePolyN : integer) : integer;begin with ThePolys [ThePolyN]^ do GetY := YStart0 + bsr ((TheX - ProjCorner0.X) * DYStart, 16) + WindowYCenter;end;{$S Engine3D}function GetX ( ThePolyN : integer) : integer;var Tmp : integer; begin with ThePolys [ThePolyN]^ do begin Tmp := bsr (fixdiv (TheX - ProjCorner0.X, XDist + 1), 10); if Dir <> 0 then GetX := CIconMaxH - Tmp else GetX := Tmp; end;end;{$S Engine3D}procedure upperStandard; begin TheZ := ThePolys [1]^.MiddleZ; if TheZ < 0 then TheZ := 0; TheZ := bsr (TheZ, 4); if TheZ > Environment.LightIndex2 then TheCIconPtr := ptr (ThePolys [1]^.Cicon + 8192) else if TheZ > Environment.LightIndex3 then TheCIconPtr := ptr (ThePolys [1]^.Cicon + 4096) else TheCIconPtr := ptr (ThePolys [1]^.Cicon); if Dettaglio = 1 then begin TheX := Max (XStart, 0) - WindowXCenter; while theX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then DrawTheUp ( TheCIconPtr, GetY (FarPoly), GetY (NearPoly), ThePolys [FarPoly]^.Next, ThePolys [NearPoly]^.Next, GetX (FarPoly), GetX (NearPoly)); theX := theX + 1; end end else begin TheX := Max (XStart, 0) - WindowXCenter; while TheX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then DrawTheUp ( TheCIconPtr, GetY (FarPoly), GetY (NearPoly), ThePolys [FarPoly]^.Next, ThePolys [NearPoly]^.Next, GetX (FarPoly), GetX (NearPoly)); TheX := TheX + 2; end; endend;{$S Engine3D}procedure highDetailMirror (startY, endY : integer);var i : integer; srcPtr, dstPtr : ptr; theDist : integer; localRow : integer; localArray : byteColorPtr; begin if startY > 199 then exit (highDetailMirror); localRow := dstRow; theDist := endY - startY; if endY > 199 then theDist := 199 - startY; if theDist <= 0 then exit (highDetailMirror); localArray := waterArray66; dstPtr := ptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [startY]); srcPtr := ptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [200 - startY + environment.horizonLine]); i := theDist; while i <> 0 do begin i := i - 1; dstPtr^ := localArray^ [band (srcPtr^, $FF)]; srcPtr := ptr (longint (srcPtr) - localRow); dstPtr := ptr (longint (dstPtr) + localRow); end;end;{$S Engine3D}procedure lowDetailMirror ( startY, endY : integer);var i : integer; tmp : integer; srcPtr : integerptr; dstPtr : integerptr; theDist : integer; localRow : integer; localArray : byteColorPtr; begin if startY > 199 then exit (lowDetailMirror); localRow := dstRow; theDist := endY - startY; if endY > 199 then theDist := 199 - startY; if theDist <= 0 then exit (lowDetailMirror); localArray := waterArray66; dstPtr := integerptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [startY]); srcPtr := integerptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [200 - startY + environment.horizonLine]); i := theDist; while i <> 0 do begin i := i - 1; tmp := srcPtr^; dstPtr^ := bor (bsl (localArray^ [bsr (Tmp, 8)], 8), localArray^ [band (Tmp, $FF)]); srcPtr := integerptr (longint (srcPtr) - localRow); dstPtr := integerptr (longint (dstPtr) + localRow); end;end;{$S Engine3D}procedure upperMirror; begin TheZ := ThePolys [1]^.MiddleZ; if TheZ < 0 then TheZ := 0; TheZ := bsr (TheZ, 4); if Dettaglio = 1 then begin TheX := Max (XStart, 0) - WindowXCenter; while theX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then highDetailMirror (GetY (FarPoly), GetY (NearPoly)); theX := theX + 1; end end else begin TheX := Max (XStart, 0) - WindowXCenter; while TheX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then lowDetailMirror (GetY (FarPoly), GetY (NearPoly)); TheX := TheX + 2; end; endend;{$S Engine3D}procedure highDetailWater ( startY, endY : integer);var i : integer; srcPtr, dstPtr : ptr; theDist : integer; localRow : integer; localArray : byteColorPtr; begin if startY > 199 then exit (highDetailWater); localRow := dstRow; theDist := endY - startY; if endY > 199 then theDist := 199 - startY; if theDist <= 0 then exit (highDetailWater); localArray := waterArray66; dstPtr := ptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [startY]); srcPtr := ptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [200 - startY + environment.horizonLine]); WaterShift := WaterShift - 1; if WaterShift = 0 then begin WaterShift := Environment.WaterChaos; srcPtr := ptr (longint (srcPtr) + localRow); end; i := theDist; while i <> 0 do begin i := i - 1; dstPtr^ := localArray^ [band (srcPtr^, $FF)]; srcPtr := ptr (longint (srcPtr) - localRow); dstPtr := ptr (longint (dstPtr) + localRow); end;end;{$S Engine3D}procedure lowDetailWater ( startY, endY : integer);var i : integer; tmp : integer; srcPtr : integerptr; dstPtr : integerptr; theDist : integer; localRow : integer; localArray : byteColorPtr; begin if startY > 199 then exit (lowDetailWater); localRow := dstRow; theDist := endY - startY; if endY > 199 then theDist := 199 - startY; if theDist <= 0 then exit (lowDetailWater); localArray := waterArray66; dstPtr := integerptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [startY]); srcPtr := integerptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [200 - startY + environment.horizonLine]); WaterShift := WaterShift - 1; if WaterShift = 0 then begin WaterShift := Environment.WaterChaos; srcPtr := integerptr (longint (srcPtr) + localRow); end; i := theDist; while i <> 0 do begin i := i - 1; tmp := srcPtr^; dstPtr^ := bor (bsl (localArray^ [bsr (Tmp, 8)], 8), localArray^ [band (Tmp, $FF)]); srcPtr := integerptr (longint (srcPtr) - localRow); dstPtr := integerptr (longint (dstPtr) + localRow); end;end;{$S Engine3D}procedure upperWater; begin TheZ := ThePolys [1]^.MiddleZ; if TheZ < 0 then TheZ := 0; TheZ := bsr (TheZ, 4); if Dettaglio = 1 then begin TheX := Max (XStart, 0) - WindowXCenter; while theX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then highDetailWater (GetY (FarPoly), GetY (NearPoly)); theX := theX + 1; end end else begin TheX := Max (XStart, 0) - WindowXCenter; while TheX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then lowDetailWater (GetY (FarPoly), GetY (NearPoly)); TheX := TheX + 2; end; endend;{$S Engine3D}procedure highDetailGlass ( startY, endY : integer);var i : integer; srcPtr, dstPtr : ptr; theDist : integer; localRow : integer; localPalette : ptr; begin if startY > 199 then exit (highDetailGlass); localRow := dstRow; theDist := endY - startY; if endY > 199 then theDist := 199 - startY; if theDist <= 0 then exit (highDetailGlass); localPalette := ptr (mixedPalette); if localPalette = nil then exit (highDetailGlass); dstPtr := ptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [startY]); srcPtr := ptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [200 - startY + environment.horizonLine]); i := theDist; while i <> 0 do begin i := i - 1; dstPtr^ := ptr (longint (LocalPalette) + bor (band (srcPtr^, $FF), bsl (band (dstPtr^, $FF), 8)))^; srcPtr := ptr (longint (srcPtr) - localRow); dstPtr := ptr (longint (dstPtr) + localRow); end;end;{$S Engine3D}procedure lowDetailGlass ( startY, endY : integer);var i : integer; tmp : byte; srcPtr, dstPtr : ptr; theDist : integer; localRow : integer; localRow_1 : integer; localPalette : ptr; begin if startY > 199 then exit (lowDetailGlass); localRow := dstRow; theDist := endY - startY; if endY > 199 then theDist := 199 - startY; if theDist <= 0 then exit (lowDetailGlass); localPalette := ptr (mixedPalette); if localPalette = nil then exit (lowDetailGlass); dstPtr := ptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [startY]); srcPtr := ptr (longint (OffScreenAddr) + TheX + WindowXCenter + DstRowTop^ [200 - startY + environment.horizonLine]); localRow_1 := localRow - 1; i := theDist; while i <> 0 do begin i := i - 1; tmp := ptr (longint (LocalPalette) + bor (band (srcPtr^, $FF), bsl (band (dstPtr^, $FF), 8)))^; dstPtr^ := Tmp; dstPtr := ptr (longint (dstPtr) + 1); dstPtr^ := Tmp; srcPtr := ptr (longint (srcPtr) - localRow); dstPtr := ptr (longint (dstPtr) + localRow_1); end;end;{$S Engine3D}procedure upperGlass; begin TheZ := ThePolys [1]^.MiddleZ; if TheZ < 0 then TheZ := 0; TheZ := bsr (TheZ, 4); if Dettaglio = 1 then begin TheX := Max (XStart, 0) - WindowXCenter; while theX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then highDetailGlass (GetY (FarPoly), GetY (NearPoly)); theX := theX + 1; end end else begin TheX := Max (XStart, 0) - WindowXCenter; while TheX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then lowDetailGlass (GetY (FarPoly), GetY (NearPoly)); TheX := TheX + 2; end; endend;{$S Engine3D}procedure drawOpaque ( TheCIcon : ptr; TheYStart, TheYEnd, TheStartSide, TheEndSide, TheXStart, TheXEnd : integer);var DeltaX, DeltaY, IconX, IconY : fixed; TheXstension : integer; TheSrcPtr : ptr; TheDstPtr : ptr; i : integer; LocalDstRow : integer; Tmp : byte; tmpB : byte; TheXBetter : integer; localPalette : ptr; begin LocalDstRow := DstRow; TheXBetter := TheX + WindowXCenter; TheXstension := TheYEnd - TheYStart; if TheXStension = 0 then exit (drawOpaque); if TheCIcon <> nil then begin case TheEndSide of 0 : begin IconX := 0; IconY := bsl (TheXEnd, 16); case TheStartSide of 1 : begin DeltaX := bsl (TheXStart, 16) div TheXstension; DeltaY := - bsl (TheXEnd, 16) div TheXstension; end; 2 : begin DeltaX := (63 * $10000) div TheXstension; DeltaY := bsl (TheXStart - TheXEnd, 16) div TheXstension; end; 3 : begin DeltaX := bsl (TheXStart, 16) div TheXstension; DeltaY := bsl (63 - TheXEnd, 16) div TheXstension; end; 0 : begin DeltaX := 0; DeltaY := bsl (TheXStart - TheXEnd, 16) div TheXstension; end; end; end; 1 : begin IconX := bsl (TheXEnd, 16); IconY := 0; case TheStartSide of 1 : begin DeltaX := fixdiv (TheXStart - TheXEnd, TheXstension); DeltaY := 0; end; 2 : begin DeltaX := fixdiv (63 - TheXEnd, TheXstension); DeltaY := fixdiv (TheXStart, TheXstension); end; 3 : begin DeltaX := fixdiv (TheXStart - TheXEnd, TheXstension); DeltaY := fixdiv (63, TheXstension); end; 0 : begin DeltaX := fixdiv (-TheXEnd, TheXstension); DeltaY := fixdiv (TheXStart, TheXstension); end; end; end; 2 : begin IconX := 63 * $10000; IconY := bsl (TheXEnd, 16); case TheStartSide of 1 : begin DeltaX := fixdiv (TheXStart - 63, TheXstension); DeltaY := fixdiv (-TheXEnd, TheXstension); end; 2 : begin DeltaX := 0; DeltaY := fixdiv (TheXStart - TheXEnd, TheXstension); end; 3 : begin DeltaX := fixdiv (TheXStart - 63, TheXstension); DeltaY := fixdiv (63 - TheXEnd, TheXstension); end; 0 : begin DeltaX := fixdiv (-63, TheXstension); DeltaY := fixdiv (TheXStart - TheXEnd, TheXstension); end; end; end; 3 : begin IconX := bsl (TheXEnd, 16); IconY := 63 * $10000; case TheStartSide of 1 : begin DeltaX := fixdiv (TheXStart - TheXEnd, TheXstension); DeltaY := fixdiv (-63, TheXstension); end; 2 : begin DeltaX := fixdiv (63 - TheXEnd, TheXstension); DeltaY := fixdiv (TheXStart - 63, TheXstension); end; 3 : begin DeltaX := fixdiv (TheXStart - TheXEnd, TheXstension); DeltaY := 0; end; 0 : begin DeltaX := fixdiv (-TheXEnd, TheXstension); DeltaY := fixdiv (TheXStart - 63, TheXstension); end; end; end; end; localPalette := ptr (mixedPalette); if localPalette = nil then exit (drawOpaque); if TheXstension > 0 then begin TheXstension := TheXstension; if TheYEnd > 199 then begin TheXstension := TheXstension + 199 - TheYEnd; TheDstPtr := ptr (longint (OffScreenAddr) + TheXBetter + DstRowTop^ [199]); I := TheYEnd - 199; while I > 0 do begin I := I - 1; IconX := IconX + DeltaX; IconY := IconY + DeltaY; end; end else TheDstPtr := ptr (longint (OffScreenAddr) + TheXBetter + DstRowTop^ [TheYEnd]); I := TheXstension; if I <= 0 then exit (drawOpaque); TheSrcPtr := TheCIcon; case Dettaglio of 1 : begin while I <> 0 do begin I := I - 1; tmpB := ptr (longint (TheSrcPtr) + band (bsr (IconY, 10), $FFFFFFC0) + bsr (IconX, 16))^; TheDstPtr^ := ptr (longint (LocalPalette) + bor (band (tmpB, $FF), bsl (band (TheDstPtr^, $FF), 8)))^; TheDstPtr := ptr (longint (TheDstPtr) - LocalDstRow); IconX := IconX + DeltaX; IconY := IconY + DeltaY; end; end; 2 : begin localDstRow := localDstRow + 1; while I <> 0 do begin I := I - 1; tmpB := ptr (longint (TheSrcPtr) + band (bsr (IconY, 10), $FFFFFFC0) + bsr (IconX, 16))^; tmp := ptr (longint (LocalPalette) + bor (band (tmpB, $FF), bsl (band (TheDstPtr^, $FF), 8)))^; theDstPtr^:= tmp; TheDstPtr := ptr (longint (TheDstPtr) + 1); theDstPtr^:= tmp; TheDstPtr := ptr (longint (TheDstPtr) - LocalDstRow); IconX := IconX + DeltaX; IconY := IconY + DeltaY; end; end; end; end else begin TheXstension := -TheXstension; if TheYEnd < 0 then begin TheXstension := TheXstension + TheYEnd; TheDstPtr := ptr (longint (OffScreenAddr) + TheXBetter); I := -TheYEnd; while I > 0 do begin I := I - 1; IconX := IconX - DeltaX; IconY := IconY - DeltaY; end; end else TheDstPtr := ptr (longint (OffScreenAddr) + TheXBetter + DstRowTop^ [TheYEnd]); I := TheXstension; if I <= 0 then exit (drawOpaque); TheSrcPtr := TheCIcon; case Dettaglio of 1 : begin while I <> 0 do begin I := I - 1; tmpB := ptr (longint (TheSrcPtr) + band (bsr (IconY, 10), $FFFFFFC0) + bsr (IconX, 16))^; TheDstPtr^ := ptr (longint (LocalPalette) + bor (band (tmpB, $FF), bsl (band (TheDstPtr^, $FF), 8)))^; TheDstPtr := ptr (longint (TheDstPtr) + LocalDstRow); IconX := IconX - DeltaX; IconY := IconY - DeltaY; end; end; 2 : begin localDstRow := localDstRow - 1; while I <> 0 do begin I := I - 1; tmpB := ptr (longint (TheSrcPtr) + band (bsr (IconY, 10), $FFFFFFC0) + bsr (IconX, 16))^; tmp := ptr (longint (LocalPalette) + bor (band (tmpB, $FF), bsl (band (TheDstPtr^, $FF), 8)))^; theDstPtr^:= tmp; TheDstPtr := ptr (longint (TheDstPtr) + 1); theDstPtr^:= tmp; TheDstPtr := ptr (longint (TheDstPtr) + LocalDstRow); IconX := IconX - DeltaX; IconY := IconY - DeltaY; end; end; end; end; end;end;{$S Engine3D}procedure upperOpaque; begin TheZ := ThePolys [1]^.MiddleZ; if TheZ < 0 then TheZ := 0; TheZ := bsr (TheZ, 4); if TheZ > Environment.LightIndex2 then TheCIconPtr := ptr (ThePolys [1]^.Cicon + 8192) else if TheZ > Environment.LightIndex3 then TheCIconPtr := ptr (ThePolys [1]^.Cicon + 4096) else TheCIconPtr := ptr (ThePolys [1]^.Cicon); if Dettaglio = 1 then begin TheX := Max (XStart, 0) - WindowXCenter; while theX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then drawOpaque (TheCIconPtr, GetY (FarPoly), GetY (NearPoly), ThePolys [FarPoly]^.Next, ThePolys [NearPoly]^.Next, GetX (FarPoly), GetX (NearPoly)); theX := theX + 1; end end else begin TheX := Max (XStart, 0) - WindowXCenter; while TheX < TheMin do begin GetFarAndNear; if (FarPoly <> 0) and (NearPoly <> 0) then drawOpaque (TheCIconPtr, GetY (FarPoly), GetY (NearPoly), ThePolys [FarPoly]^.Next, ThePolys [NearPoly]^.Next, GetX (FarPoly), GetX (NearPoly)); TheX := TheX + 2; end; endend;begin FindPolys; SortPolys; TheMin := Min (XEnd, 2 * WindowXCenter) - WindowXCenter; case ThePolys [1]^.parameter of 0 : upperStandard; 1 : upperMirror; 2 : upperWater; 3 : upperGlass; 4 : upperOpaque; otherwise; end; end;end.