Engine3D_CIconArray.p

unit
	Engine3D_CIconArray;


{	Dimensione delle variabili globali:	8	}


interface


uses
	types,
	quickdraw,
	
	Dream3Display_Tipi,
	Dream3Display_Tools;


const
	Black4Fade =		255;


type
	PackedBoolean =	packed array [0..7] of boolean;
	

var
	DstRow,
	SrcRow :				longint;
	
	OffScreenAddr :			ptr;
	
	ATextureList :			array [1..10] of ATexturePtr;
	ATextureListN :			integer;

	MixedPalette :			ptr;
	
	WaterShift :			integer;
	OddOrEven :				boolean;
	thisLensFlareActive :	boolean;
		
	
procedure FillCIconArray;

procedure DisposeCIcons;
	
procedure InitCIconArray;

function SetUpfade :	integer;

procedure doLensFlare (	where :	point);


implementation
{$R-}


uses
	icons,
	qdoffscreen,
	segload,
	toolutils,
	memory,
	AppleEvents,
	AERegistry,
	resources,
	
	cilindro,
	dreamtypes,
	lowlevel,
	dialoglord4,
	
	Dream3Display_Tipi,
	Engine3D_Globals,
	Engine3D_DrawProc,
	Dream3Display_Tools;
	
	
const
	lensFlarePictId =	300;
	lensFlareTot =		128;
	lensFlareHalf =		lensFlareTot div 2;
	lensFlareTot2 =		64;
	lensFlareHalf2 =	lensFlareTot2 div 2;
	lensFlareTot3 =		16;
	lensFlareHalf3 =	lensFlareTot3 div 2;
	

type
	BytePtr =	^byte;
	CharPtr =	^char;
	LongRGB =	record
					Red,
					Green,
					Blue :	longint;
				end;
	
	ByteRGB =	record
					BRed, BGreen, BBlue :	longint;
				end;
				
	BytePalette =	array [0..MaxPaletteCount] of ByteRGB;
	

var
	DisplayPaletteId :	integer;
	FadeType :			integer;
	lensFlarePtr :		array [0..2, 0..3] of ptr;
	maxedPalette :		ptr;
	flareShift :		integer;
	
	
{$S Engine3D_IconAndFade}
procedure getLensFlarePict;

var
	R :	rect;
	i :	integer;
	
begin
	if placedata [4] then
		for i := 0 to 3 do begin
			setrect (R, 0, 0, lensFlareTot - 1, lensFlareTot - 1);
			lensFlarePtr [0, i] := getPictOnPtr (lensFlarePictId + i, R);
			setrect (R, 0, 0, lensFlareTot2 - 1, lensFlareTot2 - 1);
			lensFlarePtr [1, i] := getPictOnPtr (lensFlarePictId + i + 4, R);
			setrect (R, 0, 0, lensFlareTot3 - 1, lensFlareTot3 - 1);
			lensFlarePtr [2, i] := getPictOnPtr (lensFlarePictId + i + 8, R);
		end;
end;


{$S Engine3D_IconAndFade}
procedure disposeLensFlarePict;

var
	i, j :	integer;
	
begin
	if placedata [4] then
		for i := 0 to 3 do
			for j := 0 to 2 do
				disposePictOnPtr (lensFlarePtr [i, j]);
end;


{$Engine3D}
procedure doLensFlare (	where :	point);

var
	dstPtr :	ptr;
	srcPtr :	ptr;
	theRow :	integer;
	theDstRow :	integer;
	currentRow,
	endV :		integer;
	localPal,
	localPal2 :	ptr;
	theMax :	integer;
	where2 :	point;
	
begin
	localPal := ptr (maxedPalette);
	if localPal = nil then
		exit (doLensFlare);
	
	if (where.h <= - lensFlareHalf) or (where.h >= 319 + lensFlareHalf) or
		(where.v <= -lensFlareHalf) or (where.v >= 199 + lensFlareHalf) then
		exit (doLensFlare);
		
	theRow := 0;
	srcPtr := lensFlarePtr [0, flareShift];		 
	dstPtr := offScreenAddr;

	if where.h < lensFlareHalf then begin
		theRow := lensFlareHalf - where.h;
		srcPtr := ptr (longint (srcPtr) + theRow);
	end else begin
		if where.h > 319 - lensFlareHalf then begin
			theRow := where.h - (319 - lensFlareHalf);
		end;
		dstPtr := ptr (longint (dstPtr) + where.h - lensFlareHalf);
	end;

	theDstRow := dstRow - lensFlareTot + theRow;

	if where.v < lensFlareHalf then begin
		srcPtr := ptr (longint (srcPtr) + bsl (lensFlareHalf - where.v, 7));
		endV := where.v + lensFlareHalf;
	end else begin
		endV := lensFlareTot;
		if where.v > 199 - lensFlareHalf then
			endV := endV - (where.v - (199 - lensFlareHalf));
		dstPtr := ptr (longint (dstPtr) + dstRow * (where.v - lensFlareHalf));
	end;

	localPal := ptr (maxedPalette);
	while endV <> 0 do begin
		currentRow := lensFlareTot - theRow;
		while currentRow <> 0 do begin
			dstPtr^ := ptr (longint (localPal) + bor (band (srcPtr^, $FF),
												bsl (band (dstPtr^, $FF), 8)))^;
			srcPtr := ptr (longint (srcPtr) + 1);
			dstPtr := ptr (longint (dstPtr) + 1);
			currentRow := currentRow - 1;
		end;
		srcPtr := ptr (longint (srcPtr) + theRow);
		dstPtr := ptr (longint (dstPtr) + theDstRow);
		endV := endV - 1;
	end;

	localPal2 := ptr (mixedPalette);
	if localPal2 = nil then
		exit (doLensFlare);
	
	where2 := where;
	with where do begin
		h := 319 - h;
		v := 199 - v;
	end;
	
	if (where.h <= - lensFlareHalf2) or (where.h >= 319 + lensFlareHalf2) or
		(where.v <= -lensFlareHalf2) or (where.v >= 199 + lensFlareHalf2) then
		exit (doLensFlare);
		
	theRow := 0;
	srcPtr := lensFlarePtr [1, flareShift];		 
	dstPtr := offScreenAddr;

	if where.h < lensFlareHalf2 then begin
		theRow := lensFlareHalf2 - where.h;
		srcPtr := ptr (longint (srcPtr) + theRow);
	end else begin
		if where.h > 319 - lensFlareHalf2 then begin
			theRow := where.h - (319 - lensFlareHalf2);
		end;
		dstPtr := ptr (longint (dstPtr) + where.h - lensFlareHalf2);
	end;

	theDstRow := dstRow - lensFlareTot2 + theRow;

	if where.v < lensFlareHalf2 then begin
		srcPtr := ptr (longint (srcPtr) + bsl (lensFlareHalf2 - where.v, 5));
		endV := where.v + lensFlareHalf2;
	end else begin
		endV := lensFlareTot2 ;
		if where.v > 199 - lensFlareHalf2 then
			endV := endV - (where.v - (199 - lensFlareHalf2));
		dstPtr := ptr (longint (dstPtr) + dstRow * (where.v - lensFlareHalf2));
	end;

	while endV <> 0 do begin
		currentRow := lensFlareTot2 - theRow;
		while currentRow <> 0 do begin
{
			dstPtr^ := ptr (longint (localPal) + bor (band (srcPtr^, $FF),
												bsl (band (dstPtr^, $FF), 8)))^;
}
			dstPtr^ := ptr (longint (localPal2) + bor (band (ptr (longint (localPal) + bor (band (srcPtr^, $FF),
												bsl (band (dstPtr^, $FF), 8)))^, $FF),
												bsl (band (dstPtr^, $FF), 8)))^;
			srcPtr := ptr (longint (srcPtr) + 1);
			dstPtr := ptr (longint (dstPtr) + 1);
			currentRow := currentRow - 1;
		end;
		srcPtr := ptr (longint (srcPtr) + theRow);
		dstPtr := ptr (longint (dstPtr) + theDstRow);
		endV := endV - 1;
	end;
	
	with where do begin
		h := bsr (3 * h + where2.h, 2);
		v := bsr (3 * v + where2.v, 2);
	end;
	
	if (where.h <= - lensFlareHalf3) or (where.h >= 319 + lensFlareHalf3) or
		(where.v <= -lensFlareHalf3) or (where.v >= 199 + lensFlareHalf3) then
		exit (doLensFlare);
		
	theRow := 0;
	srcPtr := lensFlarePtr [2, flareShift];		 
	dstPtr := offScreenAddr;

	if where.h < lensFlareHalf3 then begin
		theRow := lensFlareHalf3 - where.h;
		srcPtr := ptr (longint (srcPtr) + theRow);
	end else begin
		if where.h > 319 - lensFlareHalf3 then begin
			theRow := where.h - (319 - lensFlareHalf3);
		end;
		dstPtr := ptr (longint (dstPtr) + where.h - lensFlareHalf3);
	end;

	theDstRow := dstRow - lensFlareTot3 + theRow;

	if where.v < lensFlareHalf3 then begin
		srcPtr := ptr (longint (srcPtr) + bsl (lensFlareHalf3 - where.v, 5));
		endV := where.v + lensFlareHalf3;
	end else begin
		endV := lensFlareTot3 ;
		if where.v > 199 - lensFlareHalf3 then
			endV := endV - (where.v - (199 - lensFlareHalf3));
		dstPtr := ptr (longint (dstPtr) + dstRow * (where.v - lensFlareHalf3));
	end;

	while endV <> 0 do begin
		currentRow := lensFlareTot3 - theRow;
		while currentRow <> 0 do begin
{
			dstPtr^ := ptr (longint (localPal) + bor (band (srcPtr^, $FF),
												bsl (band (dstPtr^, $FF), 8)))^;
}
			dstPtr^ := ptr (longint (localPal2) + bor (band (ptr (longint (localPal) + bor (band (srcPtr^, $FF),
												bsl (band (dstPtr^, $FF), 8)))^, $FF),
												bsl (band (dstPtr^, $FF), 8)))^;

			srcPtr := ptr (longint (srcPtr) + 1);
			dstPtr := ptr (longint (dstPtr) + 1);
			currentRow := currentRow - 1;
		end;
		srcPtr := ptr (longint (srcPtr) + theRow);
		dstPtr := ptr (longint (dstPtr) + theDstRow);
		endV := endV - 1;
	end;

	if oddOrEven then
		theMax := 4
	else
		theMax := 3;
	flareShift := flareShift + 1;
	if flareShift >= theMax then
		flareShift := 0;
end;


{$S Engine3D_IconAndFade}
procedure InitCIconArray;

var
	bf :	family;
	 
begin
	Array66 := ByteColorPtr (newptr (sizeof (ByteColorArray)));
	if Array66 = nil then begin
		deathalert (erroutofmemory, 1);
	end;
	Array33 := ByteColorPtr (newptr (sizeof (ByteColorArray)));
	if Array33 = nil then begin
		deathalert (erroutofmemory, 1);
	end;
	waterArray66 := ByteColorPtr (newptr (sizeof (ByteColorArray)));
	if waterArray66 = nil then begin
		deathalert (erroutofmemory, 1);
	end;
	
	clearfamily (bf);
	bf [1] := true;
	bf [2] := true;
	
	MixedPalette := newptr ($10004);
	if MixedPalette = nil then begin
		if alertlord (155, 4, bf) = 2 then
			deathalert (erroutofmemory, 1);
	end;

	MaxedPalette := newptr ($10004);
	if MaxedPalette = nil then begin
		if alertlord (155, 4, bf) = 2 then
			deathalert (erroutofmemory, 1);
	end;

	DisplayPaletteId := -1;
	FadeType := -1;
	ATextureListN := 0;
end;

	
{$S Engine3D_IconAndFade}
procedure GetMixedPalette;

var
	
	Tmp :			handle;
	
begin
	if mixedPalette <> nil then begin
		Tmp := mygetresource ('mxpl', Environment.DisplayPaletteId, false, true);
		if Tmp <> nil then begin
			hlock (Tmp);
			blockmove (Tmp^, MixedPalette, $10000);
			releaseresource (Tmp);
		end;
	end;
end;


{$S Engine3D_IconAndFade}
procedure GetMaxedPalette;

var
	
	Tmp :			handle;
	
begin
	if maxedPalette <> nil then begin
		Tmp := mygetresource ('Mxpl', Environment.DisplayPaletteId, false, true);
		if Tmp <> nil then begin
			hlock (Tmp);
			blockmove (Tmp^, MaxedPalette, $10000);
			releaseresource (Tmp);
		end;
	end;
	flareShift := 0;
end;


{$S Engine3D_IconAndFade}
function SetUpfade :	integer;

var
	TheBytePalette :	BytePalette;


{$S Engine3D_IconAndFade}
procedure GetBytePalette;

var
	I :	integer;
	
begin
	with Environment do begin
		hlock (handle (DisplayPalette));
		for I := 0 to 255 do begin
			with TheBytePalette [I] do
				with DisplayPalette^^.cttable [I].rgb do begin
					BRed := band (red, $000000FF);
					BGreen := band (green, $000000FF);
					BBlue := band (blue, $000000FF);
				end;
		end;
		hunlock (handle (DisplayPalette));
	end;
end;


{$S Engine3D_IconAndFade}
function GetApproxInClut (	TheColor :	ByteRGB) : byte;

var
	I :				integer;
	Min :			integer;
	MinSize :		longint;
	CurMin :		longint;
	Boh, Boh2 :		ByteRGB;
	
begin
	Boh := TheColor;
	Boh2 := TheBytePalette [255];
		
	MinSize := sqr (Boh.BRed - Boh2.BRed) +
				sqr (Boh.BGreen - Boh2.BGreen) +
				sqr (Boh.BBlue - Boh2.BBlue);

	if MinSize = 0 then begin
		GetApproxInClut := 255;
		exit (GetApproxInClut);
	end;
	
	Min := 255;
	
	for I := 254 downto 0 do begin

		Boh2 := TheBytePalette [I];
		
		CurMin := sqr (Boh.BRed - Boh2.BRed) +
					sqr (Boh.BGreen - Boh2.BGreen) +
					sqr (Boh.BBlue - Boh2.BBlue);
									
		if CurMin = 0 then begin
			GetApproxInClut := I;
			exit (GetApproxInClut);
		end;
	
		if CurMin < MinSize then begin
			MinSize := CurMin;
			Min := I;
		end;
	end;
	GetApproxInClut := Min;
end;


{$S Engine3D_IconAndFade}
procedure GetArrays;

var
	TheColor :	ByteRGB;
	

{$S Engine3D_IconAndFade}
procedure FadeToBlack;

var
	I :				integer;

begin
	for I := 255 downto 0 do begin
	
		TheColor := TheBytePalette [I];

		with TheColor do begin
			BRed := bsr (BRed, 1);
			BGreen := bsr (BGreen, 1);
			BBlue := bsr (BBlue, 1);
		end;

		Array66^ [I] := GetApproxInClut (TheColor);

		TheColor := TheBytePalette [I];

		with TheColor do begin
			BRed := bsr (BRed, 2);
			BGreen := bsr (BGreen, 2);
			BBlue := bsr (BBlue, 2);
		end;

		Array33^ [I] := GetApproxInClut (TheColor);
	end;
end;


{$S Engine3D_IconAndFade}
procedure BlackFog;

var
	I :			integer;
	
begin
	for I := 0 to 255 do begin

		TheColor := TheBytePalette [I];
	
		with TheColor do begin
			BRed := bsr (BRed, 1);
			BGreen := bsr (BGreen, 1);
			BBlue := bsr (BBlue, 1);
			
			BRed := BRed - Environment.FadeParameter;
			if BRed < 0 then
				BRed := 0;
			BGreen := BGreen - Environment.FadeParameter;
			if BGreen < 0 then
				BGreen := 0;
			BBlue := BBlue - Environment.FadeParameter;
			if BBlue < 0 then
				BBlue := 0;

			BRed := bsl (BRed, 1);
			BGreen := bsl (BGreen, 1);
			BBlue := bsl (BBlue, 1);
		end;

		Array66^ [I] := GetApproxInClut (TheColor);

		with TheColor do begin
			BRed := bsr (BRed, 1);
			BGreen := bsr (BGreen, 1);
			BBlue := bsr (BBlue, 1);
			
			BRed := BRed - 2 * Environment.FadeParameter;
			if BRed < 0 then
				BRed := 0;
			BGreen := BGreen - 2 * Environment.FadeParameter;
			if BGreen < 0 then
				BGreen := 0;
			BBlue := BBlue - 2 * Environment.FadeParameter;
			if BBlue < 0 then
				BBlue := 0;

			BRed := bsl (BRed, 1);
			BGreen := bsl (BGreen, 1);
			BBlue := bsl (BBlue, 1);
		end;

		Array33^ [I] := GetApproxInClut (TheColor);

	end;
end;


{$S Engine3D_IconAndFade}
procedure AllRed;

var
	I :			integer;

begin
	for I := 0 to 255 do begin

		TheColor := TheBytePalette [I];
			
		with TheColor do begin
			BRed := bsr (BRed, 1);
			BGreen := bsr (BGreen, 2);
			BBlue := bsr (BGreen, 2);
		end;

		Array66^ [I] := GetApproxInClut (TheColor);

		with TheColor do begin
			BRed := bsr (BRed, 1);
			BGreen := 0;
			BBlue := 0;
		end;

		Array33^ [I] := GetApproxInClut (TheColor);
	end;
end;


{$S Engine3D_IconAndFade}
procedure AllBlue;

var
	I :			integer;

begin
	for I := 0 to 255 do begin

		TheColor := TheBytePalette [I];
			
		with TheColor do begin
			BRed := bsr (BRed, 2);
			BGreen := bsr (BGreen, 1);
			BBlue := bsr (BBlue, 2);
		end;

		Array66^ [I] := GetApproxInClut (TheColor);

		with TheColor do begin
			BRed := 0;
			BGreen := 0;
			BBlue := bsr (BBlue, 1);
		end;

		Array33^ [I] := GetApproxInClut (TheColor);
	end;
end;


{$S Engine3D_IconAndFade}
procedure FadeToGray;

const
	FadeToGrayConst =	63;
	
var
	I :			integer;

begin
	for I := 0 to 255 do begin

		TheColor := TheBytePalette [I];
			
		with TheColor do begin
			BRed := bsr (BRed, 1);
			BRed := (BRed - FadeToGrayConst) div 2 + FadeToGrayConst;
			BGreen := bsr (BGreen, 1);
			BGreen := (BGreen - FadeToGrayConst) div 2 + FadeToGrayConst;
			BBlue := bsr (BBlue, 1);
			BBlue := (BBlue - FadeToGrayConst) div 2 + FadeToGrayConst;
		end;

		Array66^ [I] := GetApproxInClut (TheColor);

		with TheColor do begin
			BRed := bsr (BRed, 1);
			BRed := (BRed - FadeToGrayConst) div 2 + FadeToGrayConst;
			BGreen := bsr (BGreen, 1);
			BGreen := (BGreen - FadeToGrayConst) div 2 + FadeToGrayConst;
			BBlue := bsr (BBlue, 1);
			BBlue := (BBlue - FadeToGrayConst) div 2 + FadeToGrayConst;
		end;

		Array33^ [I] := GetApproxInClut (TheColor);
	end;
end;


{$S Engine3D_IconAndFade}
procedure FadeToGrayWSnow;

const
	FadeToGrayConst =	23;
	SnowC =				0.75;
	
var
	I :			integer;

begin
	for I := 0 to 255 do begin

		TheColor := TheBytePalette [I];
			
		with TheColor do begin
			BRed := bsr (BRed, 1);
			BRed := round ((BRed - FadeToGrayConst) * SnowC + FadeToGrayConst);
			BGreen := bsr (BGreen, 1);
			BGreen := round ((BGreen - FadeToGrayConst) * SnowC + FadeToGrayConst);
			BBlue := bsr (BBlue, 1);
			BBlue := round ((BBlue - FadeToGrayConst) * SnowC + FadeToGrayConst);
		end;

		Array66^ [I] := GetApproxInClut (TheColor);

		with TheColor do begin
			BRed := bsr (BRed, 1);
			BRed := round ((BRed - FadeToGrayConst) * SnowC + FadeToGrayConst);
			BGreen := bsr (BGreen, 1);
			BGreen := round ((BGreen - FadeToGrayConst) * SnowC + FadeToGrayConst);
			BBlue := bsr (BBlue, 1);
			BBlue := round ((BBlue - FadeToGrayConst) * SnowC + FadeToGrayConst);
		end;

		Array33^ [I] := GetApproxInClut (TheColor);
	end;
end;


{$S Engine3D_IconAndFade}
procedure FadeToWhite;

var
	I :			integer;

begin
	for I := 0 to 255 do begin

		TheColor := TheBytePalette [I];
			
		with TheColor do begin
			BRed := bsl (BRed + 4, 1);
			BGreen := bsl (BGreen + 4, 1);
			BBlue := bsl (BBlue + 4, 1);
		end;

		Array66^ [I] := GetApproxInClut (TheColor);

		with TheColor do begin
			BRed := bsl (BRed + 2, 2);
			BGreen := bsl (BGreen + 2, 2);
			BBlue := bsl (BBlue + 2, 2);
		end;

		Array33^ [I] := GetApproxInClut (TheColor);
	end;
end;


procedure adjorna;

var
	i :	integer;
	
begin
	waterArray66^ := array66^;
	if environment.mipMap then begin
		if environment.diffuseLight = 2 then begin
			array33^ := array66^;
			environment.diffuseLight := 1
		end else
			if environment.diffuseLight = 3 then begin
				for i := 255 downto 0 do
					array66^ [i] := i;
				array33^ := array66^;
				environment.diffuseLight := 1
			end;
	end;
end;


begin
	case Environment.FadeKind of
		0 :	FadeToBlack;
		1 :	BlackFog;
		2 :	AllRed;
		3 :	AllBlue;
		4 :	FadeToGray;
		5 :	FadeToWhite;
		6 :	FadeToGrayWSnow;
		otherwise;
	end;
	adjorna;
end;


begin
	if (Environment.DisplayPaletteId <> DisplayPaletteId) or
									(FadeType <> Environment.FadeKind) then begin
		GetBytePalette;
		GetArrays;
		DisplayPaletteId := Environment.DisplayPaletteId;
		SetUpFade := Environment.FadeKind;
	end;
end;	


{$S Engine3D_IconAndFade}
procedure FillCIconArray;

var
	I :					integer;
	TheRect :			rect;
	TheWorld :			cgrafptr;
	TheOldWorld :		cgrafptr;
	TheGDHandle :		gdhandle;
	Quale :				integer;
	TheCIcon :			ciconhandle;
	ThePict :			pichandle;
	err:				OSErr;
	LocalBase :			PolyBaseArrayPtr;
	TheColor :			ByteRGB;
	IsCIcon :			boolean;
	

{$S Engine3D_IconAndFade}
function MyGetCIcon (	Id :	integer) :	ciconhandle;

var
	Tmp :	ciconhandle;
	
begin
	IsCIcon := true;
	Tmp := getcicon (Id);
	if Tmp = nil then begin
		ThePict := pichandle (mygetresource ('PICT', id, true, true));
		if ThePict <> nil then begin
			Tmp := ciconhandle (ThePict);
			IsCIcon := false;
		end;
	end;
	MyGetCIcon := Tmp;
end;


{$S Engine3D_IconAndFade}
procedure MyDisposeCIcon;

begin
	if IsCIcon then
		disposecicon (TheCIcon)
	else
		releaseresource (handle (ThePict));
end;


{$S Engine3D_IconAndFade}
function TrLoaded (		Id :	integer;
					var Quale :	integer) :	boolean;

var
	I :	integer;

begin
	for I := 1 to LoadedTrCiconsN do
		if TrCIconIdsArray^ [I] = Id then begin
			TrLoaded := true;
			Quale := I;
			exit (TrLoaded);
		end;
	TrLoaded := false;
end;


{$S Engine3D_IconAndFade}
procedure LoadCIcon (	IsBorder :	boolean);

var
	I, J :		integer;
	ThePtr :	longintptr;
	ThePtrS :	longintptr;
	TheRow :	integer;
	
	Tmp :			longint;
	Tmp0, Tmp1,
	Tmp2, Tmp3 :	longint;
	LocalArray66,
	LocalArray33 :	ByteColorPtr;
	TmpB :			byte;
	
begin
	setgworld (TheWorld, nil);
	forecolor (whitecolor);
	fillrect (TheWorld^.portrect, qd.black);
	forecolor (whitecolor);
	if IsCIcon then
		plotcicon (TheRect, TheCIcon)
	else
		drawpicture (ThePict, TheRect);
		
	TheRow := band (TheWorld^.portpixmap^^.rowbytes, $7FFF) - 64;

	CIconArray [3, LoadedCIconsN] := newptr (4096);
	if CIconArray [3, LoadedCIconsN] = nil then begin
		deathalert (erroutofmemory, 1);
	end;
	ThePtr := longintptr (CIconArray [3, LoadedCIconsN]);
	ThePtrS := longintptr (TheWorld^.portpixmap^^.baseaddr);
	for I := 63 downto 0 do begin
		for J := 15 downto 0 do begin
			ThePtr^ := ThePtrS^;
			ThePtr := longintptr (longint (ThePtr) + 4);
			ThePtrS := longintptr (longint (ThePtrS) + 4);
		end;
		ThePtrS := longintptr (longint (ThePtrS) + TheRow);
	end;
	
	if (Environment.DiffuseLight < 3) or (environment.mipMap) then begin
		LocalArray66 := Array66;
		CIconArray [2, LoadedCIconsN] := newptr (4096);
		if CIconArray [2, LoadedCIconsN] = nil then begin
			deathalert (erroutofmemory, 1);
		end;
		ThePtr := LongintPtr (CIconArray [2, LoadedCIconsN]);
		ThePtrS := LongintPtr (TheWorld^.portpixmap^^.baseaddr);
		
		if IsBorder then begin
			TmpB := LocalArray66^ [0];
			LocalArray66^ [0] := 0;
		end;
		
		for I := 63 downto 0 do begin
			for J := 15 downto 0 do begin
				Tmp := ThePtrS^;
				Tmp0 := LocalArray66^ [band (Tmp, $000000FF)];
				Tmp1 := bsl (LocalArray66^ [bsr (band (Tmp, $0000FF00), 8)], 8);
				Tmp2 := bsl (LocalArray66^ [bsr (band (Tmp, $00FF0000), 16)], 16);
				Tmp3 := bsl (LocalArray66^ [bsr (band (Tmp, $FF000000), 24)], 24);
				ThePtr^ := bor (bor (Tmp0, Tmp1), bor (Tmp2, Tmp3));
				ThePtr := LongintPtr (longint (ThePtr) + 4);
				ThePtrS := LongintPtr (longint (ThePtrS) + 4);
			end;
			ThePtrS := LongintPtr (longint (ThePtrS) + TheRow);
		end;

		if IsBorder then
			LocalArray66^ [0] := TmpB;
		if environment.mipMap then
			mipMap64 (CIconArray [2, LoadedCIconsN]);
		
	end;

	if (Environment.DiffuseLight < 2) or (Environment.MipMap) then begin
		LocalArray33 := Array33;
		CIconArray [1, LoadedCIconsN] := newptr (4096);
		if CIconArray [1, LoadedCIconsN] = nil then begin
			deathalert (erroutofmemory, 1);
		end;

		if IsBorder then begin
			TmpB := LocalArray33^ [0];
			LocalArray33^ [0] := 0;
		end;
		
		ThePtr := longintptr (CIconArray [1, LoadedCIconsN]);
		ThePtrS := longintptr (TheWorld^.portpixmap^^.baseaddr);
		for I := 63 downto 0 do begin
			for J := 15 downto 0 do begin
				Tmp := ThePtrS^;
				Tmp0 := LocalArray33^ [band (Tmp, $000000FF)];
				Tmp1 := bsl (LocalArray33^ [bsr (band (Tmp, $0000FF00), 8)], 8);
				Tmp2 := bsl (LocalArray33^ [bsr (band (Tmp, $00FF0000), 16)], 16);
				Tmp3 := bsl (LocalArray33^ [bsr (band (Tmp, $FF000000), 24)], 24);
				ThePtr^ := bor (bor (Tmp0, Tmp1), bor (Tmp2, Tmp3));
				ThePtr := longintptr (longint (ThePtr) + 4);
				ThePtrS := longintptr (longint (ThePtrS) + 4);
			end;
			ThePtrS := longintptr (longint (ThePtrS) + TheRow);
		end;
		
		if IsBorder then
			LocalArray33^ [0] := TmpB;
		if environment.mipMap then
			mipMap64 (CIconArray [1, LoadedCIconsN]);
	end;
end;


{$S Engine3D_IconAndFade}
function Loaded (		Id :		integer;
						ThePoType :	integer;
					var Quale :		integer) :	boolean;

var
	I, J, Quale2, TheId :	integer;
	
begin
	if Id < 0 then begin
		ATextureListN := ATextureListN + 1;
		ATextureList [ATextureListN] := GetATexture (-Id);
		for J := 0 to ATextureList [ATextureListN]^.NFrames do begin
			TheId := ATextureList [ATextureListN]^.CIconId [J];
			if not Loaded (TheId, ThePoType, Quale2) then begin
				LoadedCiconsN := LoadedCiconsN + 1;
				CIconIdsArray^ [LoadedCiconsN] := TheId;
				TheCIcon := MyGetCIcon (TheId);
				if TheCIcon <> nil then begin
					if ThePoType = 9 then
						LoadCIcon (true)
					else
						LoadCIcon (false);
					ATextureList [ATextureListN]^.CIconId [J] := LoadedCIconsN;
					MyDisposeCIcon;
				end else begin
					deathalert (errmissingscenres, TheId);
				end;
			end else
				ATextureList [ATextureListN]^.CIconId [J] := Quale2;
		end;
		Quale := -ATextureListN;
		Loaded := true;
	end else begin
		for I := 1 to LoadedCiconsN do
			if CIconIdsArray^ [I] = Id then begin
				Loaded := true;
				Quale := I;
				exit (Loaded);
			end;
		Loaded := false;
	end;
end;


begin
	GetMixedPalette;

	getLensFlarePict;
	GetMaxedPalette;

	setrect (TheRect, 0, 0, 64, 64);

	getgworld (TheOldWorld, TheGDHandle);

	err := newgworld (TheWorld, 8, TheRect, Environment.DisplayPalette, nil, 0);
	if (err <> noerr) or (TheWorld = nil) then begin
		deathalert (erroutofmemory, err);
	end;
	if not (lockpixels (TheWorld^.portpixmap)) then begin
		deathalert (erroutofmemory, -1);
	end;

	LocalBase := Base;

	LoadedCiconsN := 0;
	LoadedTrCIconsN := 0;
	for I := 1 to BaseN do begin
		if (LocalBase^ [I].PoType in [BaseSqElement, 9]) then
			if (LocalBase^ [I].FullMask) then
				if not Loaded (LocalBase^ [I].CIcon, LocalBase^ [I].PoType, Quale) then begin
					LoadedCiconsN := LoadedCiconsN + 1;
					CIconIdsArray^ [LoadedCiconsN] := LocalBase^ [I].CIcon;
					TheCIcon := MyGetCIcon (LocalBase^ [I].CIcon);
					if TheCIcon <> nil then begin
						if LocalBase^ [I].PoType = 9 then
							LoadCIcon (true)
						else
							LoadCIcon (false);
						LocalBase^ [I].CIcon := LoadedCIconsN;
						MyDisposeCIcon;
					end else begin
						deathalert (errmissingscenres, LocalBase^ [I].CIcon);
					end;
				end else
					LocalBase^ [I].CIcon := Quale
			else
				if not Loaded (LocalBase^ [I].CIcon, LocalBase^ [I].PoType, Quale) then begin
					LoadedCiconsN := LoadedCiconsN + 1;
					CIconIdsArray^ [LoadedCiconsN] := LocalBase^ [I].CIcon;
					TheCIcon := MyGetCicon (LocalBase^ [I].CIcon);
					if TheCIcon <> nil then begin
						LoadCIcon (true);
						LocalBase^ [I].CIcon := LoadedCIconsN;
						MyDisposeCIcon;
					end else begin
						deathalert (errmissingscenres, LocalBase^ [I].CIcon);
					end;
				end else
					LocalBase^ [I].CIcon := Quale;
	end;
	for I := 1 to BaseLevelsN do begin
		if BaseLevels^ [I].PoType in [BaseSqElement, 9] then
			if not Loaded (BaseLevels^ [I].CIcon, BaseLevels^ [I].PoType, Quale) then begin
				LoadedCiconsN := LoadedCiconsN + 1;
				CIconIdsArray^ [LoadedCiconsN] := BaseLevels^ [I].CIcon;
				TheCIcon := MyGetCIcon (BaseLevels^ [I].CIcon);
				if TheCIcon <> nil then begin
					if BaseLevels^ [I].PoType = 9 then
						LoadCIcon (true)
					else
						LoadCIcon (false);
					BaseLevels^ [I].CIcon := LoadedCIconsN;
					MyDisposeCIcon;
				end else begin
					deathalert (errmissingscenres, BaseLevels^ [I].CIcon);
				end;
			end else
				BaseLevels^ [I].CIcon := Quale
	end;

	setgworld (TheOldWorld, TheGDHandle);
	disposegworld (TheWorld);
	with TheColor do begin
		bred := Environment.FadeParameter;
		bblue := Environment.FadeParameter;
		bgreen := Environment.FadeParameter;
	end;
end;


{$S Engine3D_IconAndFade}
procedure DisposeCIcons;

var
	N, I, J :	integer;
	
begin
	if (Environment.DiffuseLight > 1) and not (environment.mipMap) then
		J := Environment.DiffuseLight
	else
		J := 1;
	for N := J to NLightValues do
		for I := 1 to LoadedCiconsN do
			disposeptr (CIconArray [N, I]);
	for I := 1 to ATextureListN do
		disposeptr (ptr (ATextureList [I]));
	ATextureListN := 0;
	
	for I := 1 to ObjectN do begin
		for J := 1 to 6 do begin
			for N := 1 to ObjectList^ [I].AnimFrames do begin
				DisposePICTOnPtr (ObjectList^ [I].FramePtrs [J, N]);
			end;
		end;
	end;
	
	for i := 1 to baseN do
		if base^ [i].poType = baseSqFrontal then
			disposePictOnPtr (ptr (base^ [i].cicon));
	disposeLensFlarePict
end;


end.