Engine3D_SetupPrePalette.p

unit
	engine3D_setupPrePalette;


interface


uses
	types,
	quickdraw;


procedure Engine3D_CreatePalettes (	theResFileId :	integer);

function Engine3D_GetClut2ProcessN (theResFileId : integer) :	integer;


implementation


uses
	memory,
	palettes,
	resources,
	windows,
	dialogs,

	binio,
	cilindro,
	dreamtypes,
	lowlevel,
	
	Dream3Display_Tipi;
	

type
	RealColor =	record
					R, G, B :	real;
				end;

	ByteRGB2 =	record
					BRed, BGreen, BBlue, total :	longint;
				end;

	BytePalette2 =		array [0..255] of ByteRGB2;
	ByteColorArray2 =	array [0..255] of byte;
	ByteColorPtr2 =		^ByteColorArray2;

	tPaletteGlobals =	record
							ThePalette :		ctabhandle;
							NewPalette :		ctabhandle;
							TheArray :			array [0..255] of rgbcolor;
							RealArray :			array [0..255] of RealColor;
							DeltaArray :		array [0..255] of RealColor;

							TheBytePalette2 :	BytePalette2;
							sortedArray :		byteColorPtr2;
							MixedPalette2 :		ptr;
						end;
	paletteGlobalsPtr =	^tPaletteGlobals;
	
	
var
	paletteGlobals :	paletteGlobalsPtr;
	

{$S Engine3D_SetupPalettes}
function myNewPtr (	theSize :	longint) :	ptr;

var
	tmp :	ptr;

begin
	tmp := newptr (theSize);
	if tmp = nil then
		deathalert (erroutofmemory, memerror);
	myNewPtr := tmp;
end;


{$S Engine3D_SetupPalettes}
function myNewHandle (	theSize :	longint) :	handle;

var
	tmp :	handle;

begin
	tmp := newhandle (theSize);
	if tmp = nil then
		deathalert (erroutofmemory, memerror);
	myNewHandle := tmp;
end;


{$S Engine3D_SetupPalettes}
procedure setupInit;

begin
	paletteGlobals := paletteGlobalsPtr (myNewPtr (sizeof (tPaletteGlobals)));
	paletteGlobals^.mixedPalette2 := myNewPtr ($10004);
end;


{$S Engine3D_SetupPalettes}
procedure setupShutDown;

begin
	disposeptr (ptr (paletteGlobals));
end;


{$S Engine3D_SetupPalettes}
procedure getBytePalette2 (	theId :	integer);

var
	I :	integer;

begin
	paletteGlobals^.ThePalette := getctable (theId);
	if paletteGlobals^.thePalette = nil then
		deathalert (errmissingscenres, theId);
	hlock (handle (paletteGlobals^.ThePalette));
	for I := 0 to 255 do begin
		with paletteGlobals^.TheBytePalette2 [I] do
			with paletteGlobals^.ThePalette^^.cttable [I].rgb do begin
				BRed := band (red, $000000FF);
				BGreen := band (green, $000000FF);
				BBlue := band (blue, $000000FF);
				total := bRed + bGreen + bBlue;
			end;
	end;
	hunlock (handle (paletteGlobals^.ThePalette));
end;


{$S Engine3D_IconAndFade}
function GetApproxInClut2 (	TheColor :	ByteRGB2) : byte;

var
	I :				integer;
	Min :			integer;
	MinSize :		longint;
	CurMin :		longint;
	Boh, Boh2 :		ByteRGB2;

begin
	Boh := TheColor;
	Boh2 := paletteGlobals^.TheBytePalette2 [255];

	MinSize := sqr (Boh.BRed - Boh2.BRed) +
				sqr (Boh.BGreen - Boh2.BGreen) +
				sqr (Boh.BBlue - Boh2.BBlue);

	if MinSize = 0 then begin
		GetApproxInClut2 := 255;
		exit (GetApproxInClut2);
	end;

	Min := 255;

	for I := 254 downto 0 do begin

		Boh2 := paletteGlobals^.TheBytePalette2 [I];

		CurMin := sqr (Boh.BRed - Boh2.BRed) +
					sqr (Boh.BGreen - Boh2.BGreen) +
					sqr (Boh.BBlue - Boh2.BBlue);

		if CurMin = 0 then begin
			GetApproxInClut2 := I;
			exit (GetApproxInClut2);
		end;

		if CurMin < MinSize then begin
			MinSize := CurMin;
			Min := I;
		end;
	end;
	GetApproxInClut2 := Min;
end;


{$S Engine3D_SetupPalettes}
procedure createMixedPalette (	theId :	integer);

var
	I, J :			longint;
	TheColor1,
	TheColor2,
	TheColor3 :		ByteRGB2;
	LocalPalette :	longintptr;
	Tmp :			handle;
	
	theCounter :	integer;
	tmp0, tmp1, tmp2, tmp3 :	longint;
	
begin
	Tmp := myNewHandle ($10004);
	hlock (Tmp);
	LocalPalette := longintptr (Tmp^);
	
	theCounter := 0;
	
	for I := 255 downto 0 do begin
	
		theCounter := theCounter + 1;
		if theCounter = 5 then begin
			theCounter := 0;
			cursoranimate;
		end;
		TheColor1 := paletteGlobals^.TheBytePalette2 [255 - I];
		for J := 63 downto 0 do begin
			TheColor2 := paletteGlobals^.TheBytePalette2 [255 - J * 4 - 3];
			with TheColor3 do begin
				Bred := bsr (TheColor1.BRed + TheColor2.Bred, 1);
				BBlue := bsr (TheColor1.BBlue + TheColor2.BBlue, 1);
				BGreen := bsr (TheColor1.BGreen + TheColor2.BGreen, 1);
			end;
			tmp0 := GetApproxInClut2 (TheColor3);

			TheColor2 := paletteGlobals^.TheBytePalette2 [255 - J * 4 - 2];
			with TheColor3 do begin
				Bred := bsr (TheColor1.BRed + TheColor2.Bred, 1);
				BBlue := bsr (TheColor1.BBlue + TheColor2.BBlue, 1);
				BGreen := bsr (TheColor1.BGreen + TheColor2.BGreen, 1);
			end;
			tmp1 := GetApproxInClut2 (TheColor3);

			TheColor2 := paletteGlobals^.TheBytePalette2 [255 - J * 4 - 1];
			with TheColor3 do begin
				Bred := bsr (TheColor1.BRed + TheColor2.Bred, 1);
				BBlue := bsr (TheColor1.BBlue + TheColor2.BBlue, 1);
				BGreen := bsr (TheColor1.BGreen + TheColor2.BGreen, 1);
			end;
			tmp2 := GetApproxInClut2 (TheColor3);
			
			TheColor2 := paletteGlobals^.TheBytePalette2 [255 - J * 4];
			with TheColor3 do begin
				Bred := bsr (TheColor1.BRed + TheColor2.Bred, 1);
				BBlue := bsr (TheColor1.BBlue + TheColor2.BBlue, 1);
				BGreen := bsr (TheColor1.BGreen + TheColor2.BGreen, 1);
			end;
			tmp3 := GetApproxInClut2 (TheColor3);
			
			LocalPalette^ := bor (bor (bsl (tmp0, 24), bsl (tmp1, 16)),
								bor (bsl (tmp2, 8), tmp3));
			
			LocalPalette := longintptr (longint (LocalPalette) + 4);
		end;
	end;
	
	writeres (currentscenariofile, theId, 'mxpl', '', Tmp);
	blockmovedata (Tmp^, paletteGlobals^.mixedPalette2, $10000);
	releaseresource (Tmp);
end;


{$S Engine3D_SetupPalettes}
function getMaxColor2 (	a, b :	longint) :	longint;
	
begin
	if paletteGlobals^.TheBytePalette2 [a].total >
					paletteGlobals^.TheBytePalette2 [b].total then
		getMaxColor2 := a
	else
		getMaxColor2 := b;
end;


{$S Engine3D_SetupPalettes}
procedure createMaxedPalette (	theId :	integer);

var
	I, J, k :		longint;
	LocalPalette :	longintptr;
	
	Tmp :			handle;
	tmpB :			longint;
	
	tmpa : 			array [0..3] of longint;
	theCounter :	longint;
	
begin

	Tmp := myNewHandle ($10004);
	hlock (Tmp);
	LocalPalette := longintptr (Tmp^);
	theCounter := 0;
	for I := 255 downto 0 do begin

		theCounter := theCounter + 1;
		if theCounter = 25 then begin
			theCounter := 0;
			cursoranimate;
		end;
		
		for J := 63 downto 0 do begin

			for k := 0 to 3 do begin
				tmpB := band (getMaxColor2 (255 - i, 255 - j * 4 - 3 + k), $FF);
				if paletteGlobals^.TheBytePalette2 [tmpB].total < 650 then
					tmpB := ptr (longint (paletteGlobals^.mixedPalette2) +
							bor (band (tmpB, $FF), bsl (band (255 - i, $FF), 8)))^;
				tmpa [k] := band (tmpB, $FF);
			end;			

			localPalette^ := bor (bor (bsl (tmpa [0], 24), bsl (tmpa [1], 16)),
								bor (bsl (tmpa [2], 8), tmpa [3]));
			LocalPalette := longintptr (longint (LocalPalette) + 4);
		end;
	end;
	
	writeres (currentscenariofile, theId, 'Mxpl', '', Tmp);
	
	releaseresource (Tmp);
end;


{$S Engine3D_SetupPalettes}
procedure disposeThings;

begin
	with paletteGlobals^ do begin
		releaseresource (handle (thePalette));
	end;
end;


{$S Engine3D_SetupPalettes}
procedure doForAllCluts;

var
	i, n, id :	integer;
	aHandle :	handle;
	tmpEnv :	environment3DHandle;
	theClutId :	integer;
	
begin
	n := count1resources ('3DEn');
	i := 1;
	id := 1000;
	while i <= n do begin
		tmpEnv := environment3DHandle (get1indresource ('3DEn', i));
		if tmpEnv <> nil then begin
		
			cursoranimate;
			
			hlock (handle (tmpEnv));
			theClutId := tmpEnv^^.displayPaletteId;
			releaseresource (handle (tmpEnv));
			getBytePalette2 (theClutId);
			
			aHandle := mygetresource ('mxpl', theClutId, false, false);
			if aHandle = nil then
				createMixedPalette (theClutId)
			else begin
				hlock (aHandle);
				blockmovedata (aHandle^, paletteGlobals^.mixedPalette2, $10000);
				releaseresource (aHandle);
			end;
			
			aHandle := mygetresource ('Mxpl', theClutId, false, false);
			if aHandle = nil then
				createMaxedPalette (theClutId)
			else
				releaseresource (aHandle);
			
			disposeThings;
			i := i + 1;
		end;
		id := id + 1;
	end;
end;


{$S Engine3D_SetupPalettes}
procedure Engine3D_CreatePalettes (	theResFileId :	integer);

var
	tmp :		integer;
	
begin
	tmp := curresfile;
	useresfile (theResFileId);
	setupInit;
	doForAllCluts;
	setupShutDown;
	useresfile (tmp);
end;


{$S Engine3D_SetupPalettes}
function Engine3D_GetClut2ProcessN (theResFileId : integer) :	integer;

label
	100;
	
var
	clutList :		array [0..127] of integer;
	clutN :			integer;
	i, j, n, id :	integer;
	tmpEnv :		environment3DHandle;
	aHandle :		handle;
	theClutId :		integer;
	tmp :			integer;
	erase :			boolean;
	
begin
	tmp := curresfile;
	useresfile (theResFileId);
	n := count1resources ('3DEn');
	i := 1;
	id := 1000;
	clutN := 0;
	while i <= n do begin
		tmpEnv := environment3DHandle (get1indresource ('3DEn', i));
		if tmpEnv <> nil then begin
			hlock (handle (tmpEnv));
			theClutId := tmpEnv^^.displayPaletteId;
			releaseresource (handle (tmpEnv));
			i := i + 1;
			for j := 0 to clutN - 1 do
				if clutList [j] = theClutId then
					goto 100;
			clutN := clutN + 1;
			clutList [clutN] := theClutId;
100:
		end;
		id := id + 1;
	end;
	
	for j := 0 to clutN do begin
		erase := true;
		aHandle := get1resource ('mxpl', clutList [j]);
		if aHandle <> nil then
			releaseresource (aHandle)
		else
			erase := false;
		aHandle := get1resource ('Mxpl', clutList [j]);
		if aHandle <> nil then
			releaseresource (aHandle)
		else
			erase := false;	
		if erase then begin
			for i := j to clutN - 1 do
				clutList [i] := clutList [i] + 1;
			clutN := clutN - 1;
		end;
	end;
	
	useresfile (tmp);
	Engine3D_GetClut2ProcessN := clutN + 1;
end;


end.