boxEditor.p

program
	boxEditor;


uses
	types,
	quickdraw,
	resources,
	memory,
	textutils,
	events,
	windows,
	dialogs,
	standardfile,
	lists,
	icons,
	
	binio,
	cilindro,
	dialoglord4,
	lista3;


type
	Box3D =	record
					MapRect :		rect;
					Height :		integer;
					LeftCIconId :	integer;
					TopCIconId :	integer;
					RightCIconId :	integer;
					BottomCIconId :	integer;
					UpperCIconId :	integer;	{ -1: glass, -2, mirror}
					SideFullMask :	boolean;
					Passable :		boolean;
					UpperHeight :	integer;
					LeftHeight :	integer;
					TopHeight :		integer;
					RightHeight :	integer;
					BottomHeight :	integer;
					LeftCIcon :		ptr;
					TopCicon :		ptr;
					RightCicon :	ptr;
					BottomCIcon :	ptr;
					UpperCIcon :	ptr;
				end;
	Box3DPtr =	^Box3D;
	Box3DHandle =	^Box3DPtr;

	tboxList =	record
					reserved :	integer;
					nBoxes :	integer;
					theBoxes :	array [0..255] of integer;
				end;
	tboxListPtr =	^tboxList;
	tboxListHandle =	^tboxListPtr;
				
	tboxInFile =	record
						nBoxes :	integer;
						theBoxes :	array [0..2047] of integer;
						theNames :	array [0..2047] of str255;
					end;
	
	

var
	theId :			integer;
	theName :		str255;
	theBox :		box3D;
	theDialog :		dialogptr;
	theEvent :		eventrecord;
	theChoice :		integer;
	theResFile :	integer;
	boxInFile :		tboxInFile;
	boxList :		tboxList;
	theboxListId :	integer;
	
	
procedure doSorry;

var
	dummy :	integer;
	
begin
	dummy := alert (151, nil);
end;


procedure plotTexture (	theDialog :	grafptr;
						textureId :	integer;
						item :		integer);

var
	aPtr :		grafptr;
	aRect :		rect;
	theCIcon :	ciconhandle;
	thePict :	pichandle;
	
begin
	getitemrect (theDialog, item, aRect);
	getport (aPtr);
	setport (theDialog);
	theCIcon := getcicon (textureId);
	if theCIcon <> nil then begin
		plotcicon (aRect, theCicon);
		disposecicon (theCIcon);
	end else begin
		thePict := getpicture (textureId);
		if thePict <> nil then begin
			drawpicture (thePict, aRect);
			releaseresource (handle (thePict));
		end else
			fillrect (aRect, qd.black);
	end;
	setport (aPtr);
end;


function getItemValue2 (theItem :	integer) :integer;
						
var
	theString :	str255;
	
begin
	getitemtext (theDialog, theItem, theString);
	getItemValue2 := stoi (theString);
end;


procedure texturePreview (	item :	integer);

var
	theId :			integer;
	aDialog :		dialogPtr;
	cFamily,
	buttonFamily :	family;
	i :				integer;
	
begin
	theId := getItemValue2 (item);
	aDialog := getnewdialog (141, nil, pointer (-1));
	for i := 2 to 4 do
		plotTexture (aDialog, theId, i);
	repeat
		clearfamily (buttonFamily);
		clearfamily (cFamily);
		buttonFamily [1] := true;
		buttonFamily [5] := true;
		theChoice := dialoglord (theDialog, 5, cFamily, cFamily, buttonFamily,
										cFamily, cFamily, cFamily, cFamily, 0, theEvent);
		case theChoice of
			1 :	begin
				end;
			otherwise	doSorry;
		end;
	until theChoice = 1;
	closedialog (aDialog);
end;


procedure drawAlltexture;

var
	i :	integer;

begin
	for i := 0 to 4 do
		plotTexture (theDialog, getItemValue2 (i + 9), i + 27);
end;


procedure getboxInFile;

var
	i :				integer;
	theIndex :		integer;
	aHandle :		handle;
	dummy :			integer;
	dummyType :	restype;
	
begin
	with boxInFile do begin
		nBoxes := countresources ('Box ');
		theIndex := 0;
		i := 0;
		while i < nBoxes do begin
			theIndex := theIndex + 1;
			aHandle := getresource ('Box ', theIndex);
			if aHandle <> nil then begin
				theBoxes [i] := theIndex;
				getresinfo (aHandle, dummy, dummyType, theNames [i]);
				i := i + 1;
				releaseresource (aHandle);
			end;
		end;
		nBoxes := nBoxes - 1;
	end;
end;


function loadboxList (id :	integer) :	boolean;

var
	theList :	tboxListHandle;
	dummy :		integer;
	i :			integer;
	
begin
	theList := tboxListHandle (getresource ('BoxL', id));
	if theList = nil then begin
		dummy := alert (134, nil);
		if dummy = 1 then begin
			boxList.nBoxes := -1;
			boxList.reserved := 0;
			loadboxList := true;
		end else
			loadboxList := false;
	end else begin
		hlock (handle (theList));
		with boxList do begin
			reserved := 0;
			nBoxes := theList^^.nBoxes;
			for i := 0 to nBoxes do
				theBoxes [i]:= theList^^.theBoxes [i];
		end;
		releaseresource (handle (theList));
		loadboxList := true;
	end;
end;


procedure saveboxList (id :	integer);

label
	100;
	
var
	theList :	tboxListHandle;
	i :			integer;
	dummy :		integer;
	
begin
	theList := tboxListHandle (getresource ('BoxL', id));
	if theList <> nil then begin
		dummy := alert (131, nil);
		if dummy = 2 then
			goto 100;
		removeresource (handle (theList));
		updateresfile (theResFile);
	end;
	with boxList do begin
		theList := tboxListHandle (newhandle (6 + 2 * nBoxes));
		hlock (handle (theList));
		theList^^.nBoxes := nBoxes;
		theList^^.reserved := 0;
		for i := 0 to nBoxes do
			theList^^.theBoxes [I] := theBoxes [I];
		addresource (handle (theList), 'BoxL', Id, '');
		updateresfile (theResFile);
	end;
100 :
	releaseresource (handle (theList));		
end;


procedure initEditor;

begin
	theDialog := getnewdialog (128, nil, pointer (-1));
end;


procedure closeEditor;

begin
	disposedialog (theDialog);
end;


procedure loadBox (	id :	integer);

var
	theHandle :	box3DHandle;
	dummy :		integer;
	dummyType :	restype;
	
begin
	theHandle := box3DHandle (getresource ('Box ', id));
	if theHandle = nil then begin
		dummy := alert (130, nil);
	end else begin
		hlock (handle (theHandle));
		theBox := theHandle^^;
		getresinfo (handle (theHandle), dummy, dummyType, theName);
		releaseresource (handle (theHandle));
		theId := id;
	end;
end;


procedure saveBox;

label
	100;
	
var
	theHandle :	box3DHandle;
	theShort :	handle;
	
begin
	theHandle := box3DHandle (getresource ('Box ', theId));
	if theHandle <> nil then begin
		theChoice := alert (131, nil);
		if theChoice = 2 then
			goto 100;
		removeresource (handle (theHandle));
		updateresfile (theResFile);
	end;
	theHandle := box3DHandle (newhandle (sizeof (box3D)));
	hlock (handle (theHandle));
	theHandle^^ := theBox;
	theShort := newhandle (sizeof (box3D) - 5 * sizeof (longint));
	hlock (theShort);
	blockmove (theHandle^, theShort^, sizeof (box3D) - 5 * sizeof (longint));
	disposehandle (handle (theHandle));
	addresource (theShort, 'Box ', theId, theName);
100:
	releaseresource (theShort);
	updateresfile (theResFile);
end;


procedure fillDialog;

begin
	setitemtext (theDialog, 2, itos (theId));
	setitemtext (theDialog, 3, theName);
	with theBox do begin
		setitemtext (theDialog, 5, itos (mapRect.left));
		setitemtext (theDialog, 4, itos (mapRect.top));
		setitemtext (theDialog, 7, itos (mapRect.right - mapRect.left));
		setitemtext (theDialog, 6, itos (mapRect.top - mapRect.bottom));
		setitemtext (theDialog, 8, itos (height));
		setitemtext (theDialog, 9, itos (leftCIconId));
		setitemtext (theDialog, 10, itos (topCIconId));
		setitemtext (theDialog, 11, itos (rightCIconId));
		setitemtext (theDialog, 12, itos (bottomCIconId));
		setitemtext (theDialog, 13, itos (upperCIconId));
		setitemtext (theDialog, 14, itos (leftHeight));
		setitemtext (theDialog, 15, itos (topHeight));
		setitemtext (theDialog, 16, itos (rightHeight));
		setitemtext (theDialog, 17, itos (bottomHeight));
		setitemtext (theDialog, 18, itos (upperHeight));
		if passable then
			setitemvalue (theDialog, 19, 1)
		else
			setitemvalue (theDialog, 19, 0);
	end;
	drawAlltexture;
end;			
					
					
procedure getFromDialog;

begin
	theId := getitemvalue2 (2);
	getitemtext (theDialog, 3, theName);
	with theBox do begin
		mapRect.left := getitemvalue2 (5);
		mapRect.top := getitemvalue2 (4);
		mapRect.right := getitemvalue2 (7) + mapRect.left;
		mapRect.bottom := mapRect.top - getitemvalue2 (6);
		height := getitemvalue2 (8);
		leftCIconId := getitemvalue2 (9);
		topCIconId := getitemvalue2 (10);
		rightCIconId := getitemvalue2 (11);
		bottomCIconId := getitemvalue2 (12);
		upperCIconId := getitemvalue2 (13);
		leftHeight := getitemvalue2 (14);
		topHeight := getitemvalue2 (15);
		rightHeight := getitemvalue2 (16);
		bottomHeight := getitemvalue2 (17);
		upperHeight := getitemvalue2 (18);
		if getitemvalue (theDialog, 19) <> 0 then
			passable := true
		else
			passable := false;
	end;
end;

					
procedure chooseFile;

var
	TheReply :	standardfilereply;
	TheList :	ConstSFTypeListPtr;
	ThePt :		point;
	
begin
	setpt (ThePt, -1, -1);
	customgetfile (nil, -1, TheList, TheReply, 129, ThePt, nil, nil, nil, nil, nil);
	if not TheReply.sfgood then;
	theResFile := fspopenresfile (TheReply.sffile, 3);
end;


procedure eraseBox;

var
	i :			longint;
	thePtr :	longintptr;
	
begin
	thePtr := longintptr (@theBox);
	for i := 1 to sizeof (box3d) div 4 do begin
		thePtr^ := 0;
		thePtr := longintptr (longint (thePtr) + 4);
	end;
	theId := 0;
	theName := '';
end;


procedure doAllBoxL;

var
	theResult :		boolean;
	aDialog :		dialogptr;
	radioFamily,
	buttonFamily,
	numFamily,
	cFamily : 		family;
	theString :		str255;
	i :				integer;
	leftList,
	rightList :		listinforec;
	listResult :	result;
	aPtr :			grafptr;
	aPoint :		point;
	currentLeft,
	currentRight :	integer;
	

procedure fillLeftList;

var
	i :		integer;
	aRect :	rect;
	
begin
	getitemrect (aDialog, 5, aRect);
	leftList := nuovalista (aDialog, aRect, 1, 6, lonlyone + lnonilhilite);
	with boxInFile do begin
		for i := 0 to nBoxes do begin
			setpt (aPoint, 0, i);
			theString := concat (itos (theBoxes [i]), ' ', theNames [i]);
			nuovacella (leftList, aPoint, @theString);
		end;
	end;
end;


procedure fillRightList;

var
	i :		integer;
	aRect :	rect;
	
begin
	getitemrect (aDialog, 6, aRect);
	rightList := nuovalista (aDialog, aRect, 1, 6, lonlyone + lnonilhilite);
	with boxList do begin
		for i := 0 to nBoxes do begin
			setpt (aPoint, 0, i);
			theString := itos (theBoxes [i]);
			nuovacella (rightList, aPoint, @theString);
		end;
	end;
end;


function alreadyHere (	theId :	integer) :	boolean;

var
	i :		integer;
	tmp :	boolean;
	
begin
	tmp := false;
	with boxList do
		for i := 0 to nBoxes do
			if theBoxes [i] = theId then
				tmp := true;
	alreadyHere := tmp;
end;


procedure sortRightList;

var
	i, j, id :	integer;
	theString :	str255;
	aPoint :	point;
	
begin
	with boxList do
		for i := 0 to nBoxes - 1 do
			for j := i + 1 to nBoxes do
				if theBoxes [i] > theBoxes [j] then begin
					id := theBoxes [i];
					theBoxes [i] := theBoxes [j];
					theBoxes [j] := id;
					setpt (aPoint, 0, i);
					theString := itos (theBoxes [i]);
					aggiornacella (rightList, aPoint, @theString);
					setpt (aPoint, 0, j);
					theString := itos (theBoxes [j]);
					aggiornacella (rightList, aPoint, @theString);
				end;
end;


procedure doAddInRight (theCell :	point);

var
	dummy :	integer;
	
begin
	if alreadyHere (boxInFile.theBoxes [theCell.v]) then
		dummy := alert (135, nil)
	else begin
		theString := itos (boxInFile.theBoxes [theCell.v]);
		with boxList do begin
			nBoxes := nBoxes + 1;
			theBoxes [nBoxes] := boxInFile.theBoxes [theCell.v];
			setpt (theCell, 0, nBoxes);
		end;
		nuovacella (rightList, theCell, @theString);
		sortRightList;
	end;
end;


procedure doCutInRight (theCell :	point);

var
	i :	integer;
	
begin
	with boxList do begin
		if nBoxes > -1 then begin
			nBoxes := nBoxes - 1;
			for i := theCell.v to nBoxes do
				theBoxes [i] := theBoxes [i + 1];
			cancellacella (rightList, theCell);
		end;
	end;
end;


procedure doLeftList;

begin
	listResult := findlist (@leftList, theEvent, aPoint, @rightList);
	case listResult of
		click, doubleclick :	if dammicella (leftList, aPoint) then
									currentLeft := aPoint.v
								else
									currentLeft := -1;
		draggedtoother :		doAddInRight (aPoint);
		otherwise;
	end;
end;


procedure doRightList;

begin
	listResult := findlist (@rightList, theEvent, aPoint, @leftList);
	case listResult of
		click, doubleclick :			if dammicella (rightList, aPoint) then
											currentRight := aPoint.v
										else
											currentRight := -1;
		draggedtoother, draggedout :	doCutInRight (aPoint);
		otherwise;
	end;
end;


procedure shiftToRight;

begin
	if currentLeft > -1 then begin
		setpt (aPoint, 0, currentLeft);
		doAddInRight (aPoint);
		currentLeft := -1;
	end;
end;


procedure shiftAway;

begin
	if currentRight > -1 then begin
		setpt (aPoint, 0, currentRight);
		doCutInRight (aPoint);
		currentRight := -1;
	end;
end;


begin
	theResult := loadboxList (theboxListId);
	getboxInFile;
	if theResult then begin
		aDialog := getnewdialog (132, nil, pointer (-1));
		getport (aPtr);
		setport (aDialog);
		fillLeftList;
		fillRightList;
		sortRightList;
		ridisegna (leftList);
		ridisegna (rightList);
		repeat
			clearfamily (radioFamily);
			clearfamily (buttonFamily);
			clearfamily (numFamily);
			clearfamily (cFamily);
			for i := 1 to 6 do
				buttonFamily [i] := true;
			theChoice := dialoglord (theDialog, 21, radioFamily, cFamily, buttonFamily, cFamily,
										numFamily, cFamily, cFamily, 0, theEvent);
			case theChoice of
				3 :	shiftToRight;
				4 :	shiftAway;
				5 :	doLeftList;
				6 :	doRightList;
				otherwise;
			end;
			ridisegna (leftList);
			ridisegna (rightList);
		until (theChoice = 1) or (theChoice = 2);
		if theChoice = 1 then
			saveboxList (theboxListId);
		cancellalista (leftList);
		cancellalista (rightList);
		setport (aPtr);
		closedialog (aDialog);
	end;
end;


procedure doboxList;

var
	aDialog :		dialogptr;
	radioFamily,
	buttonFamily,
	numFamily,
	cFamily : 		family;
	theString :		str255;

begin
	aDialog := getnewdialog (133, nil, pointer (-1));
	repeat
		clearfamily (radioFamily);
		clearfamily (buttonFamily);
		clearfamily (numFamily);
		clearfamily (cFamily);
		buttonFamily [1] := true;
		buttonFamily [2] := true;
		numFamily [3] := true;
		theChoice := dialoglord (theDialog, 21, radioFamily, cFamily, buttonFamily, cFamily,
									numFamily, cFamily, cFamily, 0, theEvent);
	until (theChoice = 1) or (theChoice = 2);
	if theChoice = 1 then begin
		getitemtext (aDialog, 3, theString);
		theboxListId := stoi (theString);
		closedialog (aDialog);	
		doAllBoxL;
	end else
		closedialog (aDialog);	
end;


procedure mainEditor;

var
	radioFamily,
	buttonFamily,
	numFamily,
	cFamily : 	family;
	i :			integer;
	
begin
	initEditor;
	useresfile (theResFile);
	repeat
		clearfamily (radioFamily);
		clearfamily (buttonFamily);
		clearfamily (numFamily);
		clearfamily (cFamily);
		buttonFamily [1] := true;
		buttonFamily [20] := true;
		buttonFamily [21] := true;
		for i := 22 to 31 do
			buttonFamily [i] := true;
		radioFamily [19] := true;
		numFamily [2] := true;
		for i := 4 to 18 do
			numFamily [i] := true;
		theChoice := dialoglord (theDialog, 33, cFamily, cFamily, buttonFamily,
										radioFamily, numFamily, cFamily, cFamily, 0, theEvent);
		case theChoice of
			1 :	begin
					getFromDialog;
					saveBox;
				end;
			20 :	begin
						loadBox (getitemvalue2 (2));
						fillDialog;
					end;
			21 :	begin
					end;
			23 :	begin
						eraseBox;
						fillDialog;
					end;
			24 :	begin
						doBoxList;
						fillDialog;
					end;
			25 :	begin
						loadBox (getitemvalue2 (2) - 1);
						fillDialog;						
					end;
			26 :	begin
						loadBox (getitemvalue2 (2) + 1);
						fillDialog;						
					end;
			27..31 :	begin
							texturePreview (theChoice - 18);
							fillDialog;
						end;
			otherwise	doSorry;
		end;
	until theChoice = 21;
	closeEditor;
end;

	
begin
	standardinitialization (1);
	chooseFile;
	mainEditor;
end.