roofEditor.p

program
	roofEditor;


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


type
	RoofRes =	record
					Id :			integer;
					MapRect :		rect;
					Height0Side :	integer;
					Height0 :		integer;
					Height1 :		integer;
					RoofCIconId :	integer;
					SideCIconId :	integer;
					Level :			integer;
				end;
	RoofResPtr =	^RoofRes;
	RoofResHandle =	^RoofResPtr;
	
	troofList =	record
					nRooves :	integer;
					theRooves :	array [0..255] of integer;
				end;
	troofListPtr =	^troofList;
	troofListHandle =	^troofListPtr;
				
	tRoofInFile =	record
						nRooves :	integer;
						theRooves :	array [0..2047] of integer;
					end;
	
	
var
	theName :		str255;
	theRoof :		roofRes;
	theDialog :		dialogptr;
	theEvent :		eventrecord;
	theChoice :		integer;
	theResFile :	integer;
	roofInFile :	tRoofInFile;
	roofList :		tRoofList;
	theRoofListId :	integer;
	

procedure getRoofInFile;

var
	i :			integer;
	theIndex :	integer;
	aHandle :	handle;
	
begin
	with roofInFile do begin
		nRooves := countresources ('Roof');
		theIndex := 0;
		i := 0;
		while i < nRooves do begin
			theIndex := theIndex + 1;
			aHandle := getresource ('Roof', theIndex);
			if aHandle <> nil then begin
				theRooves [I] := theIndex;
				i := i + 1;
				releaseresource (aHandle);
			end;
		end;
		nRooves := nRooves - 1;
	end;
end;


function loadRoofList (id :	integer) :	boolean;

var
	theList :	tRoofListHandle;
	dummy :		integer;
	i :			integer;
	
begin
	theList := tRoofListHandle (getresource ('RofL', id));
	if theList = nil then begin
		dummy := alert (134, nil);
		if dummy = 1 then begin
			roofList.nRooves := -1;
			loadRoofList := true;
		end else
			loadRoofList := false;
	end else begin
		hlock (handle (theList));
		roofList.nRooves := theList^^.nRooves;
		for i := 0 to roofList.nRooves do
			roofList.theRooves [i]:= theList^^.theRooves [i];
		releaseresource (handle (theList));
		loadRoofList := true;
	end;
end;


procedure saveRoofList (id :	integer);

label
	100;
	
var
	theList :	tRoofListHandle;
	i :			integer;
	dummy :		integer;
	
begin
	theList := tRoofListHandle (getresource ('RofL', id));
	if theList <> nil then begin
		dummy := alert (131, nil);
		if dummy = 2 then
			goto 100;
		removeresource (handle (theList));
		updateresfile (theResFile);
	end;
	with roofList do begin
		theList := tRoofListHandle (newhandle (4 + 2 * nRooves));
		hlock (handle (theList));
		theList^^.nRooves := nRooves;
		for i := 0 to nRooves do
			theList^^.theRooves [I] := theRooves [I];
		addresource (handle (theList), 'RofL', 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 loadRoof (	id :	integer);

var
	theHandle :	roofResHandle;
	dummy :		integer;
	dummyType :	restype;
	
begin
	theHandle := roofResHandle (getresource ('Roof', id));
	if theHandle = nil then begin
		dummy := alert (130, nil);
	end else begin
		hlock (handle (theHandle));
		theRoof := theHandle^^;
		getresinfo (handle (theHandle), dummy, dummyType, theName);
		releaseresource (handle (theHandle));
		theRoof.id := id;
	end;
end;


procedure saveRoof;

label
	100;
	
var
	theHandle :	roofResHandle;
	
begin
	theHandle := roofResHandle (getresource ('Roof', theRoof.Id));
	if theHandle <> nil then begin
		theChoice := alert (131, nil);
		if theChoice = 2 then
			goto 100;
		removeresource (handle (theHandle));
		updateresfile (theResFile);
	end;
	theHandle := roofResHandle (newhandle (sizeof (roofRes)));
	hlock (handle (theHandle));
	theHandle^^ := theRoof;
	addresource (handle (theHandle), 'Roof', theRoof.Id, theName);
100:
	releaseresource (handle (theHandle));
	updateresfile (theResFile);
end;


procedure setItemValue2 (	theItem :	integer;
							theValue :	integer);

begin
	setitemtext (theDialog, theItem, itos (theValue));
end;


procedure fillDialog;

var
	i :	integer;
	
begin
	setitemtext (theDialog, 7, theName);
	with theRoof do begin
		setitemvalue2 (6, id);
		with mapRect do begin
			setitemvalue2 (8, top);
			setitemvalue2 (9, left);
			setitemvalue2 (10, bottom);
			setitemvalue2 (11, right);
		end;
		setitemvalue2 (12, height0);
		setitemvalue2 (13, height1);
		setitemvalue2 (14, level);
		setitemvalue2 (15, roofCIconId);
		setitemvalue2 (16, sideCIconId);
		for i := 17 to 20 do
			setitemvalue (theDialog, i, 0);
		setitemvalue (theDialog, height0Side + 17, 1);
	end;
end;			
					
					
function getItemValue2 (theItem :	integer) :integer;
						
var
	theString :	str255;
	
begin
	getitemtext (theDialog, theItem, theString);
	getItemValue2 := stoi (theString);
end;


procedure getFromDialog;

var
	i :	integer;
	
begin
	getitemtext (theDialog, 7, theName);
	with theRoof do begin
		Id := getitemvalue2 (6);
		with mapRect do begin
			top := getitemvalue2 (8);
			left := getitemvalue2 (9);
			bottom := getitemvalue2 (10);
			right := getitemvalue2 (11);
		end;
		height0 := getitemvalue2 (12);
		height1 := getitemvalue2 (13);
		level := getitemvalue2 (14);
		roofCIconId := getitemvalue2 (15);
		sideCIconId := getitemvalue2 (16);
		for i := 17 to 20 do
			if getitemvalue (theDialog, i) <> 0 then
				height0Side := i - 17;
	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 eraseRoof;

var
	i :			longint;
	thePtr :	longintptr;
	
begin
	with theRoof do begin
		Id := 0;
		setrect (MapRect, 0, 0, 0, 0);
		Height0Side := 0;
		Height0 := 0;
		Height1 := 0;
		RoofCIconId := 0;
		SideCIconId := 0;
		level := 0;
	end;
	theName := '';
end;


procedure doAllRofl;

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 roofInFile do begin
		for i := 0 to nRooves do begin
			setpt (aPoint, 0, i);
			theString := itos (theRooves [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 roofList do begin
		for i := 0 to nRooves do begin
			setpt (aPoint, 0, i);
			theString := itos (theRooves [i]);
			nuovacella (rightList, aPoint, @theString);
		end;
	end;
end;


function alreadyHere (	theId :	integer) :	boolean;

var
	i :		integer;
	tmp :	boolean;
	
begin
	tmp := false;
	with roofList do
		for i := 0 to nRooves do
			if theRooves [i] = theId then
				tmp := true;
	alreadyHere := tmp;
end;


procedure sortRightList;

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


procedure doAddInRight (theCell :	point);

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


procedure doCutInRight (theCell :	point);

var
	i :	integer;
	
begin
	with roofList do begin
		if nRooves > -1 then begin
			nRooves := nRooves - 1;
			for i := theCell.v to nRooves do
				theRooves [i] := theRooves [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 := loadRoofList (theRoofListId);
	getRoofInFile;
	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
			saveRoofList (theRoofListId);
		cancellalista (leftList);
		cancellalista (rightList);
		setport (aPtr);
		closedialog (aDialog);
	end;
end;


procedure doRoofList;

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);
		theRoofListId := stoi (theString);
		closedialog (aDialog);	
		doAllRofL;
	end else
		closedialog (aDialog);	
end;


procedure mainEditor;

var
	radioFamily,
	buttonFamily,
	numFamily,
	cFamily : 	family;
	i :			integer;
	
begin
	initEditor;
	useresfile (theResFile);
	eraseRoof;
	fillDialog;
	repeat
		clearfamily (radioFamily);
		clearfamily (buttonFamily);
		clearfamily (numFamily);
		clearfamily (cFamily);
		for i := 17 to 20 do
			radioFamily [i] := true;
		for i := 1 to 5 do
			buttonFamily [i] := true;
		buttonFamily [21] := true;
		buttonFamily [22] := true;
		numFamily [6] := true;
		for i := 8 to 16 do
			numFamily [i] := true;
		theChoice := dialoglord (theDialog, 22, radioFamily, cFamily, buttonFamily, cFamily,
									numFamily, cFamily, cFamily, 0, theEvent);
		case theChoice of
			2 :	begin
					getFromDialog;
					saveRoof;
				end;
			3 :	begin
					loadRoof (getitemvalue2 (6));
					fillDialog;
				end;
			4 :	begin
					loadRoof (getitemvalue2 (6) - 1);
					fillDialog;
				end;
			5 :	begin
					loadRoof (getitemvalue2 (6) + 1);
					fillDialog;
				end;
			21 :	begin
						eraseRoof;
						fillDialog;
					end;
			22 :	begin
						doRoofList;
						fillDialog;
						theChoice := 22;
					end;
			otherwise;
		end;
	until theChoice = 1;
	closeEditor;
end;

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