Dream3Display_Tools.p

unit
	Dream3Display_Tools;


{	Dimensione delle variabili globali:	12	}


interface

	
uses
	types,
	memory,
	quickdraw,
	resources,
	qdoffscreen,
	palettes,
	AppleEvents,
	AERegistry,
	palettes,
	
	events,
	binio,
	segload,
	
	cilindro,
	
	dreamtypes,
	
	Dream3Display_Tipi;


const
	MaxSqElement =	400;
	MaxObject =		50;
	MaxNPC =		50;
	WindowYEdge =	200;
	WindowXEdge =	320;
	MaxPaletteCount = 255 + 3;
	

type
	SqElementListType =	array [1..MaxSqElement] of SqElement;
	SqElementListPtr =	^SqElementListType;

	ObjectListType =	array [1..MaxObject] of DisplayObject;
	ObjectListPtr =		^ObjectListType;
	
	LargeObjectListType =	array [1..10] of LargeObject;
	LargeObjectListPtr =	^LargeObjectListType;
	
	NPCListType =	array [1..MaxNPC] of NPCPtr;
	NPCListPtr	=	^NPCListType;
	
	PICTPtr =	record
					Id :		integer;
					Callings :	integer;
					ThePtr :	ptr;
				end;
	PICTPtrArray =		array [1..1024] of PICTPtr;
	PICTPtrArrayPtr =	^PICTPtrArray;

	TDoorArray =	array [1..10] of DoorWallPtr;
	TDoorArrayPtr =	^TDoorArray;
	
	ByteColorArray =	array [0..MaxPaletteCount] of byte;
	ByteColorPtr =		^ByteColorArray;

	
var
	SqElementList :		SqElementListPtr;
	SqElementN :		integer;
	ObjectList :		ObjectListPtr;
	ObjectN :			integer;
	LargeObjectList :	LargeObjectListPtr;
	LargeObjectN :		integer;
	NPCList :			NPCListPtr;
	NPCN :				integer;
	PICTPtrs :			PICTPtrArrayPtr;
	PICTN :				integer;
	DoorArray :			TDoorArrayPtr;
	DoorN :				integer;
	
	Array66 :			ByteColorPtr;
	Array33 :			ByteColorPtr;
	waterArray66 :		byteColorPtr;
	sortedArray :		byteColorPtr;
	

function GetDoor (	Id :	integer) :	DoorWallPtr;

function AddDoor (	Id :	integer) :	DoorWallPtr;

procedure GetFloorMap (Id :	integer);

procedure DisposePICTOnPtr (var ThePtr :	ptr);

function GetSqElement (	Id :	integer) :	SqElementHandle;

function GetObject (Id :	integer) :	DisplayObjectHandle;

procedure GetSqElementList;

function GetSqElementInList (	Id :	integer) :	SqElement;

procedure GetObjectList;

function GetObjectInList (	Id :	integer) :	DisplayObject;

function GetObjectInListPtr (	Id :	integer) :	DisplayObjectPtr;

procedure GetEnvironment3D (Id :			integer;
							filterMipMap :	boolean);	

procedure GetSquareMap (Id :	integer);

procedure GetObjectMap (Id :	integer);

procedure InitOffScreen (	var	TheScreen :	cgrafptr);

function GetLightSource (	Id :	integer) :	Lightsource;

function GetEnvironmentEvent (Id :	integer) :	EnvironmentEvent;	

procedure InitTools;

function MapPoint (	TheH, TheV :	longint) :	point;

function GetNPC (	Id :	integer) :	NPCPtr;

function GetCIconOnPtr (	TheCIconId :	integer;
							LightSource :	boolean;
						var isNew :			boolean) :	ptr;

function GetPICTOnPtr (	ThePICTId :	integer;
						TheRect :	rect) :	ptr;

procedure DisposeAllObjects;

procedure SetUpPICTS;

function GetATexture (	Id :	integer) :	ATexturePtr;

procedure DisposeDoors;

function GetPosSet (Id :		integer;
					Direction :	char) :	point;

procedure Fade1 (	BasePtr :	ptr);

procedure Fade2 (	BasePtr :	ptr);

procedure mipMap64 (thePtr :	ptr);

procedure mipMap64_2 (thePtr :	ptr);

procedure mipMap64_3 (thePtr :	ptr);

procedure mipMap320_200 (thePtr :	ptr);


implementation
	

uses
	icons,
	toolutils,
	
	lowlevel,
	
	engine3D_ciconarray;
	
	
const
	ObjectListResType =	'ObjL';
	
	
type
	ObjectListElement =	record
							PosX :	integer;
							PosY :	integer;
							ObjId :	integer;
							R1 :	integer;
						end;
	ObjectListArray =	record
							R1 :	integer;
							R :		integer;
							A :		array [1..50] of ObjectListElement;
						end;
	ObjectListArrayPtr =	^ObjectListArray;
	ObjectListArrayHandle =	^ObjectListArrayPtr;
	

{$S Engine3D_Tools}
function GetDoor (	Id :	integer) :	DoorWallPtr;

var
	Tmp :	handle;
	Tmp2 :	DoorWallPtr;
	
begin
	Tmp := mygetresource (DoorWallResType, Id, true, true);
	if Tmp = nil then
		deathalert (errmissingscenres, Id);
	Tmp2 := DoorWallPtr (newptr (sizeof (DoorWall)));
	if tmp2 = nil then
		deathalert (erroutofmemory, memerror);
	hlock (Tmp);
	Tmp2^ := DoorWallHandle (Tmp)^^;
	releaseresource (Tmp);
	GetDoor := Tmp2;
end;


{$S Engine3D_Tools}
function AddDoor (	Id :	integer) :	DoorWallPtr;

var
	Tmp :	DoorWallPtr;
	
begin
	Tmp := GetDoor (Id);
	DoorN := DoorN + 1;
	DoorArray^ [DoorN] := Tmp;
	AddDoor := Tmp;
end;


{$S Engine3D_Tools}
function GetATexture (	Id :	integer) :	ATexturePtr;

var
	Tmp :	ATextureHandle;
	Tmp2 :	ATexturePtr;

begin
	Tmp := ATextureHandle (mygetresource (AnimatedTextureResType, Id, true, true));
	if Tmp = nil then
		deathalert (errmissingscenres, Id);
	Tmp2 := ATexturePtr (newptr (sizeof (ATexture)));
	if Tmp2 = nil then
		deathalert (erroutofmemory, memerror);
	hlock (handle (Tmp));
	Tmp2^ := Tmp^^;
	releaseresource (handle (Tmp));
	GetATexture := Tmp2;
end;


{$S Engine3D_Tools}
function GetSqElement (	Id :	integer) :	SqElementHandle;

var
	Tmp :	SqElementHandle;
	
begin
	Tmp := SqElementHandle (mygetresource (SqElementResType, Id, true, false));
	if Tmp = nil then begin
		deathalert (errmissingscenres, Id)
	end else
		GetSqElement := Tmp;
end;


{$S Engine3D_Tools}
function GetLightSource (	Id :	integer) :	Lightsource;

var
	Tmp :	LightSourceHandle;
	
begin
	Tmp := LightSourceHandle (mygetresource (LightSourceResType, Id, true, true));
	if Tmp = nil then
		deathalert (errmissingscenres, Id)
	else begin
		hlock (handle (Tmp));
		GetLightSource := Tmp^^;
		releaseresource (handle (Tmp));
	end;
end;


{$S Engine3D_Tools}
procedure PutSqElement (Id :			integer;
						TheElement :	SqElementHandle);
var
	TheH :		SqElementHandle;
	TheFile :	integer;
	
begin
	TheFile := curresfile;
	TheH := SqElementHandle (mygetresource (SqElementResType, Id, true, true));
	if TheH <> nil then begin
		Removeresource (handle (TheH));
		updateresfile (TheFile);
		disposehandle (handle (TheH));
	end;
	hlock (handle (TheElement));
	addresource (handle (TheElement), SqElementResType, Id, '');
	updateresfile (TheFile);
end;


{$S Engine3D_Tools}
function GetObject (Id :	integer) :	DisplayObjectHandle;

var
	Tmp :	DisplayObjectHandle;
	Tmp2 :	DisplayObjectHandle;
	I, J :	integer;
	dummy :	boolean;
	
begin
	Tmp := DisplayObjectHandle (mygetresource (DisplayObjectResType, Id, true, true));
	if Tmp = nil then
		deathalert (errmissingscenres, Id)
	else begin
		hlock (handle (Tmp));
		Tmp2 := DisplayObjectHandle (newhandle (sizeof (DisplayObject)));
		if Tmp2 = nil then
			deathalert (erroutofmemory, memerror);
		hlock (handle (Tmp2));
		Tmp2^^ := Tmp^^;
		releaseresource (handle (Tmp));
		with Tmp2^^ do begin
			CurrentFrame := abs (random) mod AnimFrames;
			if CurrentFrame = 0 then
				CurrentFrame := 1;
			for I := 1 to AnimFrames do 
				for J := 1 to ObjectSides do
					FramePtrs [J, I] := GetCIconOnPtr (FrameCIcon [J, I], LightSource, dummy);
		end;
		hunlock (handle (Tmp2));
		GetObject := Tmp2;
	end;
end;


{$S Engine3D_Tools}
procedure GetSquareMap (Id :	integer);

var
	Tmp :		SqMapRHandle;
	I, J :		integer;
	TheRect :	rect;
	

function GetData (X, Y :	integer) :	integer;

var
	TheAddress :	integerptr;
	
begin
	TheAddress := integerptr (longint (Tmp^) + sizeof (rect));
	with TheRect do begin
		TheAddress := integerptr (longint (TheAddress) + 2 * (bottom - top + 1) * (X - 1));
		TheAddress := integerptr (longint (TheAddress) + 2 * (Y - 1));
		GetData := TheAddress^;
	end;
end;


begin
	Tmp := SqMapRHandle (mygetresource (SqMapResType, Id, true, true));
	if Tmp = nil then
		deathalert (errmissingscenres, Id);

	hlock (handle (Tmp));
	Environment.SquareMap := SqMapHandle (newhandle (sizeof (SqMap)));
	if Environment.SquareMap = nil then
		deathalert (erroutofmemory, Id);
	hlock (handle (Environment.SquareMap));

	TheRect := Tmp^^.TheRect;
	for I := 1 to TheRect.right do
		for J := 1 to TheRect.bottom do
			with TheRect do
				if (I >= left) and (I <= right) and (J >= top) and (J <= bottom) then
					Environment.SquareMap^^ [I, J] := GetData (I, J)
				else
					Environment.SquareMap^^ [I, J] := 0;
			
	hunlock (handle (Environment.SquareMap));
	releaseresource (handle (Tmp));
end;


{$S Engine3D_Tools}
procedure GetFloorMap (Id :	integer);

var
	Tmp :	SqMapRHandle;
	I, J :	integer;
	

function GetData (X, Y :	integer) :	integer;

var
	TheAddress :	integerptr;
	
begin
	TheAddress := integerptr (longint (Tmp^) + sizeof (rect));
	with Tmp^^.TheRect do begin
		TheAddress := integerptr (longint (TheAddress) + 2 * (bottom - top + 1) * (X - 1));
		TheAddress := integerptr (longint (TheAddress) + 2 * (Y - 1));
		GetData := TheAddress^;
	end;
end;


begin
	Tmp := SqMapRHandle (mygetresource (SqMapResType, Id, true, true));
	if Tmp = nil then
		deathalert (errmissingscenres, 10000 + Id);

	hlock (handle (Tmp));
	Environment.FloorMap := SqMapHandle (newhandle (sizeof (SqMap)));
	if Environment.FloorMap = nil then
		deathalert (errmissingscenres, 10000 + Id);
	hlock (handle (Environment.FloorMap));

	for I := 1 to SqMapHSize do
		for J := 1 to SqMapVSize do
			with Tmp^^.TheRect do
				if (I >= left) and (I <= right) and (J >= top) and (J <= bottom) then
					Environment.FloorMap^^ [I, J] := GetData (I, J)
				else
					Environment.FloorMap^^ [I, J] := 0;
			
	hunlock (handle (Environment.FloorMap));
	releaseresource (handle (Tmp));
end;


{$S Engine3D_Tools}
procedure GetObjectMap (Id :	integer);

var
	ObjT :		ObjectListArrayHandle;
	ObjN :		integer;
	I, J :		integer;
	LocalMap :	SqMapPtr;
	
begin
	if Id <> 0 then begin
		ObjT := ObjectListArrayHandle (mygetresource (ObjectListResType, Id, true, true));
		if ObjT = nil then
			deathalert (errmissingscenres, Id);
		hlock (handle (ObjT));
		ObjN := ObjT^^.R + 1;
	end;
		
	Environment.ObjectMap := SqMapHandle (newhandle (sizeof (SqMap)));
	if Environment.ObjectMap = nil then
		deathalert (errmissingscenres, Id);
	hlock (handle (Environment.ObjectMap));
	LocalMap := Environment.ObjectMap^;
	for I := 1 to 100 do
		for J := 1 to 100 do
			LocalMap^ [I, J] := 0;
	
	if Id <> 0 then begin
		for I := 1 to ObJN do
			if (ObjT^^.A [I].PosX in [1..100]) and (ObjT^^.A [I].PosY in [1..100]) then
				LocalMap^ [ObjT^^.A [I].PosX, ObjT^^.A [I].PosY] := ObjT^^.A [I].ObjId;
		releaseresource (handle (ObjT));
	end;
	hunlock (handle (Environment.ObjectMap));
end;


{$S Engine3D_Tools}
function XIL (	Id :	integer) :	boolean;

var
	I :	integer;
	
begin
	for I := 1 to SqElementN do
		if SqElementList^ [I].Id  = Id then begin
			XIL := true;
			exit (XIL);
		end;
	XIL := false;
end;


{$S Engine3D_Tools}
procedure GetSqElementList;

var
	I,
	J :				integer;
	TheSqElement :	SqElementHandle;
	LocalMap :		SqMapPtr;
	ThisSq :		integer;
	
begin
	hlock (handle (Environment.SquareMap));
	LocalMap := Environment.SquareMap^;
	SqElementN := 0;
	for J := 1 to Environment.MapHor do
		for I := 1 to Environment.MapVer do begin
			ThisSq := LocalMap^ [J, I];
			if ThisSq <> 0 then
				if not (XIL (ThisSq)) then begin
					TheSqElement := GetSqElement (ThisSq);
					hlock (handle (TheSqElement));
					SqElementN := SqElementN + 1;
					SqElementList^ [SqElementN] := TheSqElement^^;
					releaseresource (handle (TheSqElement));
					while SqElementList^ [SqElementN].Next <> 0 do begin
						TheSqElement := GetSqElement (SqElementList^ [SqElementN].Next);
						hlock (handle (TheSqElement));
						SqElementN := SqElementN + 1;
						SqElementList^ [SqElementN] := TheSqElement^^;
						releaseresource (handle (TheSqElement));
					end;
				end;
		end;
	hunlock (handle (Environment.SquareMap));
end;


{$S Engine3D_Tools}
function GetSqElementInList (	Id :	integer) :	SqElement;

var
	I :	integer;
	
begin
	I := 1;
	while (SqElementList^ [I].Id <> Id) and (I <= SqElementN) do
		I := I + 1;
	if (SqElementList^ [I].Id <> Id) or (I > SqElementN) then
		{GetSqElementInList.SqType := 0} 
		deathalert (errmissingscenres, Id)
	else
		GetSqElementInList := SqElementList^ [I];
end;


{$S Engine3D_Tools}
function GetObjectInList (	Id :	integer) :	DisplayObject;
	
var
	I :	longint;
	
begin
	for I := ObjectN downto 1 do
		if ObjectList^ [I]. Id = Id then
			GetObjectInList := ObjectList^ [Id];
end;


{$S Engine3D_Tools}
function GetObjectInListPtr (	Id :	integer) :	DisplayObjectPtr;

var
	I :	longint;
	
begin
	for I := ObjectN downto 1 do
		if ObjectList^ [I]. Id = Id then begin
			GetObjectInListPtr := DisplayObjectPtr (longint (ObjectList) +
												(I - 1) * sizeof (DisplayObject));
			exit (GetObjectInListPtr);
		end;
	GetObjectInListPtr := nil;
end;


{$S Engine3D_Tools}
procedure InitTools;

begin
	SqElementList := SqElementListPtr (newptr (sizeof (SqElementListType)));
	if SqElementList = nil then
		deathalert (erroutofmemory, -1);
	ObjectList := ObjectListPtr (newptr (sizeof (ObjectListType)));
	if ObjectList = nil then
		deathalert (erroutofmemory, -1);
	NPCList := NPCListPtr (newptr (sizeof (NPCListType)));
	if NPCList = nil then
		deathalert (erroutofmemory, -1);
	NPCN := 0;
	PICTPtrs := PICTPtrArrayPtr (newptr (sizeof (PICTPtrArray)));
	if PICTPtrs = nil then
		deathalert (erroutofmemory, -1);
	PICTN := 0;
	
	DoorArray := TDoorArrayPtr (newptr (sizeof (TDoorArray)));
	if DoorArray = nil then
		deathalert (erroutofmemory, -1);
	DoorN := 0;
end;


{$S Engine3D_Tools}
procedure GetObjectList;

var
	I,
	J :			integer;
	TheObject :	DisplayObjectHandle;
	LocalMap :	SqMapPtr;
	ThisObj :	integer;
	
begin
	if Environment.ObjectMapId <> 0 then begin
		ObjectN := 0;
		hlock (handle (Environment.ObjectMap));
		LocalMap := Environment.ObjectMap^;
		for I := 1 to Environment.MapHor do
			for J := 1 to Environment.MapVer do begin
				ThisObj := LocalMap^ [J, I];
				if ThisObj <> 0 then begin
					TheObject := GetObject (ThisObj);
					if TheObject <> nil then begin
						hlock (handle (TheObject));
						ObjectN := ObjectN + 1;
						TheObject^^.Id := ObjectN;
						LocalMap^ [J, I] := ObjectN;
						ObjectList^ [ObjectN] := TheObject^^;
						disposehandle (handle (TheObject));
					end else
						deathalert (errmissingscenres, ThisObj);
				end;
			end;
		hunlock (handle (Environment.ObjectMap));
	end;
end;


{$S Engine3D_Tools}
procedure GetEnvironment3D (Id :			integer;
							filterMipMap :	boolean);	

var
	Tmp :	Environment3DHandle;
	TmpRect :	rect;
	TmpPtr :	cgrafptr;
	TmpPtr2 :	cgrafptr;
	TmpRect2 :	rect;
	
begin
	TmpRect := Environment.MapRect;
	TmpPtr := Environment.ScreenMapGWorld;
	TmpPtr2 := Environment.ScreenGWorld;
	TmpRect2 := Environment.CommonRect;
	Tmp := Environment3DHandle (mygetresource (Environment3DResType, Id, true, true));
	if Tmp = nil then
		deathalert (errmissingscenres, 10000 + Id);
	hlock (handle (Tmp));
	blockmove (Tmp^, @Environment, sizeof (Environment3D));
	releaseresource (handle (Tmp));
	with Environment do begin
		AmplitudeOffSet := BackgroundRect.right div NAngles;
		if RayCastingDepth = 0 then
			RayCastingDepth := $7FFFFFFF;
		if RayThroughDepth = 0 then
			RayThroughDepth := 10;
		with ViewPoint do begin
			h := (h - 1) * PlaceDim * 2;
			v := (MapVer + 1 - v) * PlaceDim * 2;
		end;
		WindowXCenter := CommonRect.right div 2;
		WindowYCenter := CommonRect.bottom div 2;
		if DisplayPaletteId <> 0 then
			DisplayPalette := getctable (DisplayPaletteID)
		else
			DisplayPalette := nil;
	end;
	Environment.MapRect := TmpRect;
	Environment.ScreenMapGWorld := TmpPtr;
	Environment.ScreenGWorld := TmpPtr2;
	Environment.CommonRect := TmpRect2;
	environment.mipMap := filterMipMap;
	environment.ViewAngle := 180 - environment.ViewAngle;
	while Environment.ViewAngle > 179 do
		Environment.ViewAngle := Environment.ViewAngle - 180;
	while Environment.ViewAngle < 0 do
		Environment.ViewAngle := Environment.ViewAngle + 180;
end;


{$S Engine3D}
function MapPoint (	TheH, TheV :	longint) :	point;

var
	DoubleDim :	integer;
	
begin
	DoubleDim := bsl (Environment.PlaceDim, 1);
	MapPoint.h := (TheH + Environment.PlaceDim) div DoubleDim + 1;
	MapPoint.v := Environment.MapVer - (TheV - Environment.PlaceDim) div
															DoubleDim + 1;
end;


{$S Engine3D_Tools}
function GetEnvironmentEvent (Id :	integer) :	EnvironmentEvent;	

var
	Tmp :	EnvironmentEventHandle;
	Tmp2 :	EnvironmentEvent;
	
begin
	Tmp := EnvironmentEventHandle (mygetresource (EnvironmentEventResType, Id, true, true));
	if Tmp = nil then
		deathalert (errmissingscenres, 10000 + Id);
	hlock (handle (Tmp));
	blockmove (Tmp^, @Tmp2, sizeof (EnvironmentEvent));
	releaseresource (handle (Tmp));
	GetEnvironmentEvent := Tmp2;
end;


{$S Engine3D_Tools}
procedure DisposeEnvironmentEvent (	TheEvent :	EnvironmentEvent);

begin
	{disposectable (TheEvent.EvtClut);}
end;


{$S Engine3D_Tools}
procedure InitOffScreen (	var	TheScreen :	cgrafptr);

var
	err :	oserr;
	
begin
	err:=  (newgworld (TheScreen, 8, Environment.CommonRect, Environment.DisplayPalette, nil, 0));
	if (err <> noerr) or (TheScreen = nil) then begin
		deathalert (erroutofmemory, err);
	end;
end;


{$S Engine3D_Tools}
function GetLargeObject (	Id :	integer) :	LargeObject;

var
	Tmp :	LargeObjectHandle;
	
begin
	Tmp := LargeObjectHandle (mygetresource (LargeObjectResType, Id, true, true));
	if Tmp = nil then
		deathalert (errmissingscenres, 0);
	hlock (handle (Tmp));
	GetLargeObject := Tmp^^;
	releaseresource (handle (Tmp));
end;


{$S Engine3D_Tools}
function GetPICTOnPtr (	ThePICTId :	integer;
						TheRect :	rect) :	ptr;

var
	OldWorld,
	TheWorld :	cgrafptr;
	OldGD :		gdhandle;
	ThePICT :	pichandle;
	ThePtr1,
	ThePtr2 :	longintptr;
	Err :		oserr;
	Tmp :		ptr;
	TheRow :	integer;
	I, J :		integer;
	TheRows :	integer;
	TheRect2 :	rect;
	
begin

	for I := 1 to PICTN do
		if PICTPtrs^ [I].Id = ThePICTId then begin
			PICTPtrs^ [I].Callings := PICTPtrs^ [I].Callings + 1;
			GetPICTOnPtr := PICTPtrs^ [I].ThePtr;
			exit (GetPICTOnPtr);
		end;
		
	getgworld (OldWorld, OldGD);
	ThePICT := pichandle (mygetresource ('PICT', ThePICTId, true, true));
	if ThePICT = nil then
		deathalert (errmissingscenres, ThePICTId);

	TheRect2 := TheRect;
	with TheRect2 do begin
		right := TheRect.right + 1;
		bottom := TheRect.bottom + 1;
	end;
	
	Err := newgworld (TheWorld, 8, TheRect2, Environment.DisplayPalette, nil, 0);
	if (Err <> noerr) or (TheWorld = nil) then
		deathalert (erroutofmemory, Err);
		
	if not (lockpixels (TheWorld^.portpixmap)) then
		deathalert (erroutofmemory, Err);
	
	setgworld (TheWorld, nil);
	drawpicture (ThePICT, TheRect2);
	releaseresource (handle (ThePICT));
	Tmp := newptr ((TheRect.bottom + 1) * (TheRect.right + 1) + 4);
	if Tmp = nil then
		deathalert (erroutofmemory, MemError);

	ThePtr1 := longintptr (TheWorld^.portpixmap^^.baseaddr);
	ThePtr2 := longintptr (Tmp);
	TheRow := loword (bitand (TheWorld^.portpixmap^^.rowbytes, $7FFF)) -
																TheRect.right - 1;
	TheRows := (TheRect.right + 1) div 4 - 1;
	for I := TheRect.bottom downto 0 do begin
		for J := TheRows downto 0 do begin
			ThePtr2^ := ThePtr1^;
			ThePtr2 := longintptr (longint (ThePtr2) + 4);
			ThePtr1 := longintptr (longint (ThePtr1) + 4);
		end;
		ThePtr1 := longintptr (longint (ThePtr1) + TheRow);
	end;

	setgworld (OldWorld, OldGD);
	disposegworld (TheWorld);
	
	PICTN := PICTN + 1;
	if PICTN = 1025 then
		deathalert (erroutofmemory, -1);
	with PICTPtrs^ [PICTN] do begin
		Callings := 1;
		Id := ThePICTId;
		ThePtr := Tmp;
	end;

	GetPICTOnPtr := Tmp;
end;



{$S Engine3D_Tools}
function GetCIconOnPtr (	TheCIconId :	integer;
							LightSource :	boolean;
						var isNew :			boolean) :	ptr;

var
	OldWorld,
	TheWorld :	cgrafptr;
	OldGD :		gdhandle;
	TheCIcon :	ciconhandle;
	ThePtr1,
	ThePtr2 :	longintptr;
	Err :		oserr;
	Tmp :		ptr;
	TheRow :	integer;
	I, J :		integer;
	TheRect :	rect;

	LocalArray66 :	ByteColorPtr;
	Tmp0, Tmp1, Tmp2, Tmp3, Tmp4 :	longint;

	TmpB :		byte;
	
	
function DoPict : ptr;

var
	Tmp, Tmp2 :	ptr;
	I :			longint;
	S, D :		longintptr;
	
begin
	setrect (TheRect, 0, 0, 63, 63);
	Tmp := GetPICTOnPtr (TheCIconId, TheRect);
	if not LightSource then
		case Environment.DiffuseLight of
			3 :			DoPict := Tmp;
			2 :			begin
							Tmp2 := newptr (8192);
							if tmp2 = nil then
								deathalert (erroutofmemory, memerror);
							S := longintptr (Tmp);
							D := longintptr (Tmp2);
							for I := 1023 downto 0 do begin
								D^ := S^;
								D := longintptr (longint (D) + 4);
								S := longintptr (longint (S) + 4);
							end;
							S := longintptr (Tmp);
							for I := 1023 downto 0 do begin
								D^ := S^;
								D := longintptr (longint (D) + 4);
								S := longintptr (longint (S) + 4);
							end;
							Fade2 (ptr (longint (Tmp2)));
							DisposePictOnPtr (Tmp);
							DoPict := Tmp2;
						end;
			otherwise	begin
							Tmp2 := newptr (12288);
							if tmp2 = nil then
								deathalert (erroutofmemory, memerror);
							S := longintptr (Tmp);
							D := longintptr (Tmp2);
							for I := 1023 downto 0 do begin
								D^ := S^;
								D := longintptr (longint (D) + 4);
								S := longintptr (longint (S) + 4);
							end;
							S := longintptr (Tmp);
							for I := 1023 downto 0 do begin
								D^ := S^;
								D := longintptr (longint (D) + 4);
								S := longintptr (longint (S) + 4);
							end;
							Fade2 (ptr (longint (Tmp2)));
							S := longintptr (Tmp);
							for I := 1023 downto 0 do begin
								D^ := S^;
								D := longintptr (longint (D) + 4);
								S := longintptr (longint (S) + 4);
							end;
							Fade1 (ptr (longint (Tmp2)));
							DisposePictOnPtr (Tmp);
							DoPict := Tmp2;
						end;
		end
	else
		DoPict := Tmp;
end;

	
begin
	for I := 1 to PICTN do
		if PICTPtrs^ [I].Id = -TheCIconId then begin
			PICTPtrs^ [I].Callings := PICTPtrs^ [I].Callings + 1;
			GetCIconOnPtr := PICTPtrs^ [I].ThePtr;
			isNew := false;
			exit (GetCIconOnPtr);
		end;
		
	TheCIcon := getcicon (TheCIconId);
	if TheCIcon = nil then begin
		Tmp := DoPict;
		PICTN := PICTN + 1;
		if PICTN = 1025 then
			deathalert (erroutofmemory, -1);
		with PICTPtrs^ [PICTN] do begin
			Callings := 1;
			thePtr := tmp;
			Id := TheCIconId;
		end;
		GetCIconOnPtr := Tmp;
		isNew := false;
		exit (GetCIconOnPtr);
	end;

	getgworld (OldWorld, OldGD);

	setrect (TheRect, 0, 0, 64, 64);
	Err := newgworld (TheWorld, 8, TheRect, Environment.DisplayPalette, nil, 0);
	if (Err <> noerr) or (TheWorld = nil) then
		deathalert (erroutofmemory, Err);
		
	if not (lockpixels (TheWorld^.portpixmap)) then
		deathalert (erroutofmemory, Err);

	setgworld (TheWorld, nil);

	if not LightSource then
		case Environment.DiffuseLight of
			3 :			Tmp := newptr (4096);
			2 :			Tmp := newptr (8192);
			otherwise	Tmp := newptr (12288);
		end
	else
		Tmp := newptr (4096);
		
	if Tmp = nil then
		deathalert (erroutofmemory, MemError);

	ThePtr1 := longintptr (TheWorld^.portpixmap^^.baseaddr);
	TheRow := loword (bitand (TheWorld^.portpixmap^^.rowbytes, $7FFF)) - 64;
	for I := 63 downto 0 do begin
		for J := 15 downto 0 do begin
			ThePtr1^ := 0;
			ThePtr1 := longintptr (longint (ThePtr1) + 4);
		end;
		ThePtr1 := longintptr (longint (ThePtr1) + TheRow);
	end;

	plotcicon (TheRect, TheCIcon);
	disposecicon (TheCIcon);
	
	ThePtr1 := longintptr (TheWorld^.portpixmap^^.baseaddr);
	ThePtr2 := longintptr (Tmp);
	for I := 63 downto 0 do begin
		for J := 15 downto 0 do begin
			ThePtr2^ := ThePtr1^;
			ThePtr2 := longintptr (longint (ThePtr2) + 4);
			ThePtr1 := longintptr (longint (ThePtr1) + 4);
		end;
		ThePtr1 := longintptr (longint (ThePtr1) + TheRow);
	end;

	if (Environment.DiffuseLight < 3) and (not (LightSource)) then begin
		LocalArray66 := Array66;
		TmpB := LocalArray66^ [0];
		LocalArray66^ [0] := 0;
		ThePtr1 := longintptr (TheWorld^.portpixmap^^.baseaddr);
		for I := 63 downto 0 do begin
			for J := 15 downto 0 do begin
				Tmp4 := ThePtr1^;
				Tmp0 := LocalArray66^ [band (Tmp4, $000000FF)];
				Tmp1 := bsl (LocalArray66^ [bsr (band (Tmp4, $0000FF00), 8)], 8);
				Tmp2 := bsl (LocalArray66^ [bsr (band (Tmp4, $00FF0000), 16)], 16);
				Tmp3 := bsl (LocalArray66^ [bsr (band (Tmp4, $FF000000), 24)], 24);
				ThePtr2^ := bor (bor (Tmp0, Tmp1), bor (Tmp2, Tmp3));
				ThePtr1 := LongintPtr (longint (ThePtr1) + 4);
				ThePtr2 := LongintPtr (longint (ThePtr2) + 4);
			end;
			ThePtr1 := LongintPtr (longint (ThePtr1) + TheRow);
		end;
		LocalArray66^ [0] := TmpB;
		if Environment.DiffuseLight < 2 then begin
			LocalArray66 := Array33;
			TmpB := LocalArray66^ [0];
			LocalArray66^ [0] := 0;
			ThePtr1 := longintptr (TheWorld^.portpixmap^^.baseaddr);
			for I := 63 downto 0 do begin
				for J := 15 downto 0 do begin
					Tmp4 := ThePtr1^;
					Tmp0 := LocalArray66^ [band (Tmp4, $000000FF)];
					Tmp1 := bsl (LocalArray66^ [bsr (band (Tmp4, $0000FF00), 8)], 8);
					Tmp2 := bsl (LocalArray66^ [bsr (band (Tmp4, $00FF0000), 16)], 16);
					Tmp3 := bsl (LocalArray66^ [bsr (band (Tmp4, $FF000000), 24)], 24);
					ThePtr2^ := bor (bor (Tmp0, Tmp1), bor (Tmp2, Tmp3));
					ThePtr1 := LongintPtr (longint (ThePtr1) + 4);
					ThePtr2 := LongintPtr (longint (ThePtr2) + 4);
				end;
				ThePtr1 := LongintPtr (longint (ThePtr1) + TheRow);
			end;
			LocalArray66^ [0] := TmpB;
		end;
	end;

	setgworld (OldWorld, OldGD);
	disposegworld (TheWorld);
	
	PICTN := PICTN + 1;
	if PICTN = 1025 then
		deathalert (erroutofmemory, -1);
	with PICTPtrs^ [PICTN] do begin
		Callings := 1;
		Id := -TheCIconId;
		ThePtr := Tmp;
	end;

	isNew := true;
	GetCIconOnPtr := Tmp;
end;


{$S Engine3D_Tools}
procedure DisposePICTOnPtr (var ThePtr :	ptr);

label
	100;
	
var
	I, J :		integer;

begin
	I := 0;
	while  I <= PICTN do begin
		I := I + 1;
		if PICTPtrs^ [I].ThePtr = ThePtr then begin
			PICTPtrs^ [I].Callings := PICTPtrs^ [I].Callings - 1;
			if 	PICTPtrs^ [I].Callings = 0 then begin
				PICTN := PICTN - 1;
				for J := I to PICTN do
					PICTPtrs^ [J] := PICTPtrs^ [J + 1];
				goto 100;
			end else
				exit (DisposePICTOnPtr);
		end;
	end;
	exit (DisposePICTOnPtr);
100:
	disposeptr (ThePtr);
	thePtr := nil;
end;


{$S Engine3D_Tools}
procedure DisposeAllObjects;

var
	I, J, K :	integer;

begin
	for I := 1 to ObjectN do
		for J := 1 to ObjectSides do
			with ObjectList^ [I] do
				for K := 1 to AnimFrames do
					DisposePICTOnPtr (FramePtrs [J, K]);
end;


{$S Engine3D_Tools}
function GetNPC (	Id :	integer) :	NPCPtr;

var
	Tmp :				NPCPtr;
	TheHandle :			handle;
	TheShift :			integerptr;
	I, J :				integer;
	DoublePlaceDim :	integer;
	
begin
	TheHandle := mygetresource (NPCObjectResType, Id, true, true);
	if TheHandle = nil then
		deathalert (errmissingscenres, 0);
	
	hlock (TheHandle);
	Tmp := NPCPtr (newptr (sizeof (NPCObject)));
	if Tmp = nil then
		deathalert (erroutofmemory, MemError);

	DoublePlaceDim := Environment.PlaceDim * 2;

	blockmove (TheHandle^, Tmp, 14 * sizeof (Integer) + 3 * sizeof (longint));
	TheShift := integerptr (longint (TheHandle^) + 14 * sizeof (Integer) +
															3 * sizeof (longint));
	
	with Tmp^ do begin

		for I := 0 to MoveFrames do
			for J := 1 to ObjectSides do begin			
				MovePICT [J, I] := GetPICTOnPtr (TheShift^, Dimensions);
				TheShift := integerptr (longint (TheShift) + sizeof (integer));
				MoveMask [J, I] := GetPICTOnPtr (TheShift^, Dimensions);
				TheShift := integerptr (longint (TheShift) + sizeof (integer));
			end;

		hisHeight := TheShift^;
		TheShift := integerptr (longint (TheShift) + sizeof (integer));
		
		ActionFrames := TheShift^;
		TheShift := integerptr (longint (TheShift) + sizeof (integer));
		for I := 0 to ActionFrames do begin
			ActionPICT [I] := GetPICTOnPtr (TheShift^, Dimensions);
			TheShift := integerptr (longint (TheShift) + sizeof (integer));
			ActionMask [I] := GetPICTOnPtr (TheShift^, Dimensions);
			TheShift := integerptr (longint (TheShift) + sizeof (integer));
		end;
		
		if ptr (TheShift)^ <> 0 then
			LightSource := true
		else
			LightSource := false;
		LightSource := false;

		TheShift := integerptr (longint (TheShift) + 2);
		Tmp^.RelatedPath := TheShift^;
		TheShift := integerptr (longint (TheShift) + 2);
		Tmp^.hisBase := TheShift^;
		Position.h := Position.h  * DoublePlaceDim ;
		Position.v := (Environment.MapVer - Position.v + 1) * DoublePlaceDim;

	end;
	releaseresource (TheHandle);
	Tmp^.MoveFrames := Tmp^.MoveFrames + 1;
	Tmp^.MoveFrame := 0;
	Tmp^.ActionFrame := 0;
	Tmp^.TalkOccurred := false;
	GetNPC := Tmp;
end;


{$S Engine3D_Tools}
procedure SetUpPICTS;

var
	i :	integer;
	
begin
	for i := 1 to PICTN do
		if PICTPtrs^ [i].thePtr <> nil then begin
			disposeptr (PICTPtrs^ [i].thePtr);
			PICTPtrs^ [i].thePtr := nil;
		end;
	PICTN := 0;
end;


{$S Engine3D_Tools}
procedure DisposeDoors;

var
	I :	integer;

begin
	for I := 1 to DoorN do
		disposeptr (ptr (DoorArray^ [I]));
	DoorN := 0;
end;


{$S Engine3D_Tools}
function GetPosSet (Id :		integer;
					Direction :	char) :	point;

var
	ThePos :	PosSetHandle;
	
begin
	ThePos := PosSetHandle (mygetresource (PosSetResType, Id, false, true));
	if ThePos = nil then
		setpt (GetPosSet, 0, 0)
	else begin
		hlock (handle (ThePos));
		case Direction of
			'7' :	GetPosSet := ThePos^^ [7];
			'8' :	GetPosSet := ThePos^^ [6];
			'9' :	GetPosSet := ThePos^^ [5];
			'4' :	GetPosSet := ThePos^^ [4];
			'6' :	GetPosSet := ThePos^^ [3];
			'1' :	GetPosSet := ThePos^^ [2];
			'2' :	GetPosSet := ThePos^^ [1];
			'3' :	GetPosSet := ThePos^^ [0];
		end;
		releaseresource (handle (ThePos));
	end; 
end;


{$S Engine3D_IconAndFade}
procedure Fade2 (	BasePtr :	ptr);

var
	I :					integer;
	LocalArray66 :		ByteColorPtr;
	Tmp, Tmp0, Tmp1,
	Tmp2, Tmp3 :		longint;
	ThePtr, ThePtrS :	longintptr;
	TmpB :				byte;
	
begin
	LocalArray66 := Array66;
	TmpB := LocalArray66^ [0];
	LocalArray66^ [0] := 0;
	ThePtr := longintptr (longint (BasePtr) + 4096);
	ThePtrS := longintptr (BasePtr);
	for I := 1023 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;
	LocalArray66^ [0] := TmpB;
end;


{$S Engine3D_IconAndFade}
procedure Fade1 (	BasePtr :	ptr);

var
	I :				integer;
	LocalArray66 :	ByteColorPtr;
	Tmp, Tmp0, Tmp1, Tmp2, Tmp3 :			longint;
	ThePtr, ThePtrS :	longintptr;
	TmpB :			byte;
	
begin
	LocalArray66 := Array33;
	TmpB := LocalArray66^ [0];
	LocalArray66^ [0] := 0;
	ThePtr := longintptr (longint (BasePtr) + 8192);
	ThePtrS := longintptr (BasePtr);
	for I := 1023 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;
	LocalArray66^ [0] := TmpB;
end;


{$S Engine3D_IconAndFade}
procedure mipMap64 (thePtr :	ptr);

var
	i, j :			integer;
	tmp :			array [0..3] of byte;
	theLong :		array [0..1] of longint;
	theShift :		array [0..1] of longintptr;
	thePalette :	ptr;
	lastTmp :		array [0..1] of byte;
	
begin
	if mixedPalette = nil then
		exit (mipMap64);
	thePalette := ptr (mixedPalette);
	if thePalette = nil then
		exit (mipMap64);
	theShift [0] := longintptr (thePtr);
	for i := 63 downto 0 do begin
		for j := 15 downto 0 do begin
			theLong [0] := theShift [0]^;
			tmp [0] := bsr (theLong [0], 24);
			tmp [1] := band (bsr (theLong [0], 16), $FF);
			tmp [2] := band (bsr (theLong [0], 8), $FF);
			tmp [3] := band (theLong [0], $FF);
			lastTmp [0] := band (ptr (longint (thePalette) +
									bor (band (tmp [0], $FF),
										bsl (band (tmp [1], $FF), 8)))^, $FF);
			lastTmp [1] := band (ptr (longint (thePalette) +
									bor (band (tmp [2], $FF), 
										bsl (band (tmp [3], $FF), 8)))^, $FF);
			theShift [0]^ :=  bor (bor (bsl (lastTmp [0], 24), bsl (lastTmp [0], 16)), 
										bor (bsl (lastTmp [1], 8), lastTmp [1]));
			theShift [0] := longintptr (longint (theShift [0]) + 4);
		end;
	end;

	theShift [0] := longintptr (thePtr);
	theShift [1] := longintptr (longint (thePtr) + 64);
	for i := 31 downto 0 do begin
		for j := 15 downto 0 do begin
			theLong [0] := theShift [0]^;
			theLong [1] := theShift [1]^;
			tmp [0] := bsr (theLong [0], 24);
			tmp [1] := bsr (theLong [1], 24);
			tmp [2] := band (bsr (theLong [0], 8), $FF);
			tmp [3] := band (bsr (theLong [1], 8), $FF);
			lastTmp [0] := band (ptr (longint (thePalette) +
									bor (band (tmp [0], $FF),
										bsl (band (tmp [1], $FF), 8)))^, $FF);
			lastTmp [1] := band (ptr (longint (thePalette) +
									bor (band (tmp [2], $FF), 
										bsl (band (tmp [3], $FF), 8)))^, $FF);
			theLong [0] := bor (bor (bsl (lastTmp [0], 24), bsl (lastTmp [0], 16)), 
										bor (bsl (lastTmp [1], 8), lastTmp [1]));
			theShift [0]^ := theLong [0];
			theShift [1]^ := theLong [0];
			theShift [0] := longintptr (longint (theShift [0]) + 4);
			theShift [1] := longintptr (longint (theShift [1]) + 4);
		end;
		theShift [0] := longintptr (longint (theShift [0]) + 64);
		theShift [1] := longintptr (longint (theShift [1]) + 64);
	end;

end;


{$S Engine3D_IconAndFade}
procedure mipMap64_2 (thePtr :	ptr);

var
	i, j :			integer;
	tmp :			array [0..3] of byte;
	theLong :		array [0..1] of longint;
	theShift :		array [0..1] of longintptr;
	thePalette :	ptr;
	lastTmp :		array [0..1] of byte;
	
begin
	if mixedPalette = nil then
		exit (mipMap64_2);
	mipMap64 (thePtr);
	thePalette := ptr (mixedPalette);
	theShift [0] := longintptr (thePtr);
	for i := 31 downto 0 do begin
		for j := 15 downto 0 do begin
			theLong [0] := theShift [0]^;
			tmp [0] := bsr (theLong [0], 24);
			tmp [2] := band (bsr (theLong [0], 8), $FF);
			lastTmp [0] := band (ptr (longint (thePalette) +
									bor (band (tmp [0], $FF),
										bsl (band (tmp [2], $FF), 8)))^, $FF);
			theShift [0]^ :=  bor (bor (bsl (lastTmp [0], 24), bsl (lastTmp [0], 16)), 
										bor (bsl (lastTmp [0], 8), lastTmp [0]));
			theShift [0] := longintptr (longint (theShift [0]) + 4);
		end;
		theShift [0] := longintptr (longint (theShift [0]) + 64);
	end;

	theShift [0] := longintptr (thePtr);
	theShift [1] := longintptr (longint (thePtr) + 128);
	for i := 15 downto 0 do begin
		for j := 15 downto 0 do begin
			theLong [0] := theShift [0]^;
			theLong [1] := theShift [1]^;
			tmp [0] := bsr (theLong [0], 24);
			tmp [1] := bsr (theLong [1], 24);
			lastTmp [0] := band (ptr (longint (thePalette) +
									bor (band (tmp [0], $FF),
										bsl (band (tmp [1], $FF), 8)))^, $FF);
			theLong [0] := bor (bor (bsl (lastTmp [0], 24), bsl (lastTmp [0], 16)), 
										bor (bsl (lastTmp [0], 8), lastTmp [0]));
			theShift [0]^ := theLong [0];
			longintptr (longint (theShift [0]) + 64)^ := theLong [0];
			theShift [1]^ := theLong [0];
			longintptr (longint (theShift [1]) + 64)^ := theLong [0];
			theShift [0] := longintptr (longint (theShift [0]) + 4);
			theShift [1] := longintptr (longint (theShift [1]) + 4);
		end;
		theShift [0] := longintptr (longint (theShift [0]) + 192);
		theShift [1] := longintptr (longint (theShift [1]) + 192);
	end;

end;


{$S Engine3D_IconAndFade}
procedure mipMap64_3 (thePtr :	ptr);

var
	i, j, k :		integer;
	tmp :			array [0..3] of byte;
	theLong :		array [0..1] of longint;
	theShift :		array [0..3] of longintptr;
	thePalette :	ptr;
	lastTmp :		array [0..1] of byte;
	
begin
	if mixedPalette = nil then
		exit (mipMap64_3);
	mipMap64_2 (thePtr);
	thePalette := ptr (mixedPalette);
	theShift [0] := longintptr (thePtr);
	for i := 15 downto 0 do begin
		for j := 7 downto 0 do begin
			theLong [0] := theShift [0]^;
			theLong [1] := longintptr (longint (theShift [0]) + 4)^;
			tmp [0] := band (theLong [0], $FF);
			tmp [2] := band (theLong [1], $FF);
			lastTmp [0] := band (ptr (longint (thePalette) +
									bor (band (tmp [0], $FF),
										bsl (band (tmp [2], $FF), 8)))^, $FF);
			theLong [0] :=  bor (bor (bsl (lastTmp [0], 24), bsl (lastTmp [0], 16)), 
										bor (bsl (lastTmp [0], 8), lastTmp [0]));
			theShift [0]^ := theLong [0];
			theShift [0] := longintptr (longint (theShift [0]) + 4);
			theShift [0]^ := theLong [0];
			theShift [0] := longintptr (longint (theShift [0]) + 4);
		end;
		theShift [0] := longintptr (longint (theShift [0]) + 128);
	end;

	theShift [0] := longintptr (thePtr);
	theShift [1] := longintptr (longint (thePtr) + 256);
	for i := 7 downto 0 do begin
		for j := 7 downto 0 do begin
			theLong [0] := theShift [0]^;
			theLong [1] := theShift [1]^;
			tmp [0] := bsr (theLong [0], 24);
			tmp [1] := bsr (theLong [1], 24);
			lastTmp [0] := band (ptr (longint (thePalette) +
									bor (band (tmp [0], $FF),
										bsl (band (tmp [1], $FF), 8)))^, $FF);
			theLong [0] := bor (bor (bsl (lastTmp [0], 24), bsl (lastTmp [0], 16)), 
										bor (bsl (lastTmp [0], 8), lastTmp [0]));
			for k := 7 downto 0 do
				longintptr (longint (theShift [0]) + bsl (k, 6))^ := theLong [0];
			theShift [0] := longintptr (longint (theShift [0]) + 8);
			theShift [1] := longintptr (longint (theShift [1]) + 8);
		end;
		theShift [0] := longintptr (longint (theShift [0]) + 384);
		theShift [1] := longintptr (longint (theShift [1]) + 384);
	end;

end;


{$S Engine3D}
procedure mipMap320_200 (thePtr :	ptr);

var
	i, j :			integer;
	tmp :			array [0..3] of byte;
	theLong :		array [0..1] of longint;
	theShift :		array [0..1] of longintptr;
	thePalette :	ptr;
	lastTmp :		array [0..1] of byte;
	localRow :		integer;
	
begin
	if mixedPalette = nil then
		exit (mipMap320_200);
	thePalette := ptr (mixedPalette);
	if thePalette = nil then
		exit (mipMap320_200);
	localRow := dstRow;
	theShift [0] := longintptr (thePtr);
	for i := 199 downto 0 do begin
		for j := 79 downto 0 do begin
			theLong [0] := theShift [0]^;
			tmp [0] := bsr (theLong [0], 24);
			tmp [1] := band (bsr (theLong [0], 16), $FF);
			tmp [2] := band (bsr (theLong [0], 8), $FF);
			tmp [3] := band (theLong [0], $FF);
			lastTmp [0] := band (ptr (longint (thePalette) +
									bor (band (tmp [0], $FF),
										bsl (band (tmp [1], $FF), 8)))^, $FF);
			lastTmp [1] := band (ptr (longint (thePalette) +
									bor (band (tmp [2], $FF), 
										bsl (band (tmp [3], $FF), 8)))^, $FF);
			theShift [0]^ :=  bor (bor (bsl (lastTmp [0], 24), bsl (lastTmp [0], 16)), 
										bor (bsl (lastTmp [1], 8), lastTmp [1]));
			theShift [0] := longintptr (longint (theShift [0]) + 4);
		end;
		theShift [0] := longintptr (longint (theShift [0]) + localRow - 320);
	end;
{
	theShift [0] := longintptr (thePtr);
	theShift [1] := longintptr (longint (thePtr) + localRow);
	for i := 99 downto 0 do begin
		for j := 39 downto 0 do begin
			theLong [0] := theShift [0]^;
			theLong [1] := theShift [1]^;
			tmp [0] := bsr (theLong [0], 24);
			tmp [1] := bsr (theLong [1], 24);
			tmp [2] := band (bsr (theLong [0], 8), $FF);
			tmp [3] := band (bsr (theLong [1], 8), $FF);
			lastTmp [0] := band (ptr (longint (thePalette) +
									bor (band (tmp [0], $FF),
										bsl (band (tmp [1], $FF), 8)))^, $FF);
			lastTmp [1] := band (ptr (longint (thePalette) +
									bor (band (tmp [2], $FF), 
										bsl (band (tmp [3], $FF), 8)))^, $FF);
			theLong [0] := bor (bor (bsl (lastTmp [0], 24), bsl (lastTmp [0], 16)), 
										bor (bsl (lastTmp [1], 8), lastTmp [1]));
			theShift [0]^ := theLong [0];
			theShift [1]^ := theLong [0];
			theShift [0] := longintptr (longint (theShift [0]) + 4);
			theShift [1] := longintptr (longint (theShift [1]) + 4);
		end;
		theShift [0] := longintptr (longint (theShift [0]) + bsl (localRow, 1) - 320);
		theShift [1] := longintptr (longint (theShift [1]) + bsl (localRow, 1) - 320);
	end;
}
end;


end.