1 line
10 KiB
OpenEdge ABL
Executable File
1 line
10 KiB
OpenEdge ABL
Executable File
program RoomEditor;
|
|
|
|
|
|
{===========================================================}
|
|
{ }
|
|
{ R O O M E D I T O R 1.02 }
|
|
{ For Glider 4.0 }
|
|
{ }
|
|
{ All code 1991 john calhoun }
|
|
{ }
|
|
{ Published and © 1991 Casady & Greene, Inc. }
|
|
{ }
|
|
{===========================================================}
|
|
|
|
{$I-}
|
|
|
|
uses
|
|
Palettes, About, Globals, Utilities, Drawing, HouseStuff, RoomStuff, ObjectStuff, FileInNOut, Initialize, TheMenus, FlyGlider;
|
|
|
|
var
|
|
downIsDubl: Longint;
|
|
eventHappened: Boolean;
|
|
|
|
{=================================}
|
|
|
|
procedure UpDateMain;
|
|
var
|
|
tempRect: Rect;
|
|
|
|
begin
|
|
DrawRoomNum;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoMainWindow;
|
|
var
|
|
thePt: Point;
|
|
|
|
{--------------------}
|
|
|
|
procedure DoASimpleClik;
|
|
var
|
|
which: Integer;
|
|
hitARect: Boolean;
|
|
|
|
begin
|
|
if (StillDown) then
|
|
begin
|
|
if (PtInRect(thePt, handleRect)) then
|
|
begin
|
|
DragHandle;
|
|
Exit(DoASimpleClik);
|
|
end;
|
|
hitARect := FALSE;
|
|
for which := 1 to thisRoom.numberOObjects do
|
|
if (PtInRect(thePt, thisRoom.theObjects[which].boundRect)) then
|
|
begin
|
|
Deselect;
|
|
oneActive := which;
|
|
hitARect := TRUE;
|
|
Leave;
|
|
end;
|
|
if (hitARect) then
|
|
begin
|
|
DragObject(oneActive);
|
|
DrawAllObjects;
|
|
UpdateMenuItems(editToObject);
|
|
end
|
|
else
|
|
begin
|
|
Deselect;
|
|
UpdateMenuItems(editToRoom);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
hitARect := FALSE;
|
|
for which := 1 to thisRoom.numberOObjects do
|
|
if (PtInRect(thePt, thisRoom.theObjects[which].boundRect)) then
|
|
begin
|
|
Deselect;
|
|
oneActive := which;
|
|
hitARect := TRUE;
|
|
Leave;
|
|
end;
|
|
if (hitARect) then
|
|
begin
|
|
DrawAllObjects;
|
|
UpdateMenuItems(editToObject);
|
|
end
|
|
else
|
|
begin
|
|
Deselect;
|
|
UpdateMenuItems(editToRoom);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{--------------------}
|
|
|
|
procedure DoADublClik;
|
|
var
|
|
which: Integer;
|
|
cancelIt, hitARect: Boolean;
|
|
|
|
begin
|
|
if (PtInRect(thePt, thisRoom.theObjects[oneActive].boundRect)) then
|
|
begin
|
|
DoObjectInfo;
|
|
UpdateMenuItems(editToObject);
|
|
end
|
|
else
|
|
begin
|
|
hitARect := FALSE;
|
|
for which := 1 to thisRoom.numberOObjects do
|
|
if (PtInRect(thePt, thisRoom.theObjects[which].boundRect)) then
|
|
begin
|
|
Deselect;
|
|
oneActive := which;
|
|
hitARect := TRUE;
|
|
Leave;
|
|
end;
|
|
if (hitARect) then
|
|
begin
|
|
DrawAllObjects;
|
|
end
|
|
else
|
|
begin
|
|
if (editRoom) then
|
|
begin
|
|
UpdateMenuItems(editToRoom);
|
|
cancelIt := TRUE;
|
|
DoRoomCondInfo(cancelIt);
|
|
end
|
|
else
|
|
begin
|
|
Deselect;
|
|
UpdateMenuItems(editToRoom);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{--------------------}
|
|
|
|
begin
|
|
SetPort(GrafPtr(mainWndo));
|
|
thePt := theEvent.where;
|
|
GlobalToLocal(thePt);
|
|
|
|
if (theEvent.what = mouseDown) then
|
|
begin
|
|
if (theEvent.when <= downIsDubl) then
|
|
DoADublClik
|
|
else
|
|
DoASimpleClik;
|
|
end
|
|
else if (theEvent.what = mouseUp) then
|
|
downIsDubl := theEvent.when + GetDblTime;
|
|
|
|
if (toolWndo <> nil) then
|
|
SetPort(GrafPtr(toolWndo));
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoDrag (whichWindow: WindowPtr);
|
|
var
|
|
wasRect, tempRect: Rect;
|
|
|
|
begin
|
|
Deselect;
|
|
wasRect := whichWindow^.portRect;
|
|
tempRect := screenbits.bounds;
|
|
tempRect.top := tempRect.top + 20;
|
|
DragWindow(whichWindow, theEvent.where, tempRect);
|
|
if (whichWindow = toolWndo) then
|
|
ShowWindow(whichWindow);
|
|
if (toolWndo <> nil) then
|
|
SelectWindow(toolWndo);
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoGoAway (WhichWindow: WindowPtr);
|
|
var
|
|
wasRect, tempRect: Rect;
|
|
|
|
begin
|
|
if (theEvent.what <> MouseUp) then
|
|
Exit(DoGoAway);
|
|
if TrackGoAway(whichWindow, theEvent.where) then
|
|
begin
|
|
Deselect;
|
|
case (GetWRefCon(whichWindow)) of
|
|
1:
|
|
CloseTools;
|
|
otherwise
|
|
;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoInContent (whichWindow: WindowPtr);
|
|
begin
|
|
if ((whichWindow <> FrontWindow) and (whichWindow <> mainWndo)) then
|
|
SelectWindow(toolWndo)
|
|
else
|
|
case (GetWRefCon(whichWindow)) of
|
|
0:
|
|
DoMainWindow;
|
|
1:
|
|
DoTools;
|
|
otherwise
|
|
end;{case}
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoUpdate;
|
|
var
|
|
whichWindow: WindowPtr;
|
|
begin
|
|
whichWindow := WindowPtr(theEvent.message);
|
|
SetPort(whichWindow);
|
|
BeginUpdate(whichWindow);
|
|
case (GetWRefCon(whichWindow)) of
|
|
0:
|
|
UpDateMain;
|
|
1:
|
|
UpdateTools;
|
|
otherwise
|
|
begin
|
|
end;
|
|
end;
|
|
EndUpdate(whichWindow);
|
|
DrawAllObjects;
|
|
DrawRoomNum;
|
|
UpdateTools;
|
|
if (toolWndo <> nil) then
|
|
SetPort(toolWndo);
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoStartUp;
|
|
var
|
|
cancelIt: Boolean;
|
|
theMessage, numDocs, thisDoc, ignore: Integer;
|
|
docInfo: AppFile;
|
|
begin
|
|
CountAppFiles(theMessage, numDocs);
|
|
if (theMessage = AppPrint) then
|
|
begin
|
|
GenericAlert(kErrNothingToPrint);
|
|
ExitToShell;
|
|
end;
|
|
|
|
if (numDocs = 0) then
|
|
begin
|
|
DoOpenHouse;
|
|
Exit(DoStartUp);
|
|
end;
|
|
|
|
GetAppFiles(1, docInfo);
|
|
with docInfo do
|
|
begin
|
|
if fType = 'GLhs' then
|
|
begin
|
|
if (not OpenFile(fName, vRefNum)) then
|
|
begin
|
|
InitCursor;
|
|
DoNewHouse;
|
|
Exit(DoStartUp);
|
|
end;
|
|
InitCursor;
|
|
|
|
housesName := fName;
|
|
changed := FALSE;
|
|
roomScrapDirty := FALSE;
|
|
objectScrapDirty := FALSE;
|
|
|
|
roomAt := 1;
|
|
thisRoom := thisHouse.theRooms[roomAt];
|
|
EnableItem(GetMenu(mFile), iSave);
|
|
EnableItem(GetMenu(mFile), iSaveAs);
|
|
|
|
oneActive := 0;
|
|
handleRect := nullRect;
|
|
|
|
LoadABackground(thisRoom.backPictID);
|
|
UpdateMenuItems(fileExists);
|
|
UpdateMenuItems(editToRoom);
|
|
DrawAllObjects;
|
|
DrawRoomNum;
|
|
|
|
OpenTools;
|
|
end
|
|
else
|
|
begin
|
|
DoNewHouse;
|
|
end;
|
|
ClrAppFiles(1);
|
|
end;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoMouseDown;
|
|
var
|
|
whichWindow: WindowPtr;
|
|
mResult: longint;
|
|
theMenu, theItem, code: integer;
|
|
|
|
begin
|
|
code := FindWindow(theEvent.where, whichWindow);
|
|
case (code) of
|
|
inMenuBar:
|
|
begin
|
|
mResult := MenuSelect(theEvent.Where);
|
|
theMenu := HiWord(mResult);
|
|
theItem := LoWord(mResult);
|
|
HandleMenu(theMenu, theItem);
|
|
end;
|
|
inGoAway:
|
|
DoGoAway(whichWindow);
|
|
inContent:
|
|
DoInContent(whichWindow);
|
|
inDrag:
|
|
DoDrag(whichWindow);
|
|
inSysWindow:
|
|
SystemClick(theEvent, whichWindow);
|
|
otherwise
|
|
;
|
|
end;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoKeyDown;
|
|
var
|
|
mResult: longint;
|
|
chCode, theMenu, theItem, wasActive: integer;
|
|
|
|
begin
|
|
with theEvent do
|
|
begin
|
|
chCode := BitAnd(message, CharCodeMask);
|
|
if (Odd(modifiers div CmdKey)) then
|
|
begin
|
|
mResult := MenuKey(CHR(chCode));
|
|
theMenu := HiWord(mResult);
|
|
theItem := LoWord(mResult);
|
|
if (theMenu <> 0) then
|
|
HandleMenu(theMenu, theItem);
|
|
end
|
|
else
|
|
case chCode of
|
|
kTabKey:
|
|
if (thisRoom.numberOObjects > 0) then
|
|
begin
|
|
wasActive := oneActive;
|
|
Deselect;
|
|
oneActive := wasActive + 1;
|
|
if (oneActive > thisRoom.numberOObjects) then
|
|
oneActive := 1;
|
|
UpdateMenuItems(editToObject);
|
|
DrawAllObjects;
|
|
end;
|
|
kLeftArrow:
|
|
DoPrevRoom;
|
|
kRightArrow:
|
|
DoNextRoom;
|
|
kDeleteKey:
|
|
DoClear;
|
|
otherwise
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoDiskEvent;
|
|
var
|
|
cornerPt: Point;
|
|
theErr: OSErr;
|
|
begin
|
|
if (HiWrd(theEvent.message) <> noErr) then
|
|
begin
|
|
SetPt(cornerPt, 85 + rightOffset, 50 + downOffset);
|
|
theErr := DIBadMount(cornerPt, theEvent.message);
|
|
end;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
procedure DoOSEvent;
|
|
begin
|
|
case BSR(theEvent.message, 24) of {high byte of message}
|
|
1:
|
|
begin
|
|
if (BAnd(theEvent.message, 1) <> 0) then
|
|
begin
|
|
inBackground := FALSE; {it was a resume event}
|
|
if (not SameScreenDepth) then
|
|
GenericAlert(23);
|
|
end
|
|
else
|
|
begin
|
|
inBackground := TRUE; {it was a suspend event}
|
|
end;
|
|
end; {suspendResumeMessage}
|
|
otherwise
|
|
;
|
|
end; {CASE}
|
|
end; {osEvt}
|
|
|
|
{=================================}
|
|
|
|
procedure CloseUpShop;
|
|
const
|
|
Color = 1;
|
|
GDTypeFlag = 1;
|
|
var
|
|
theDevice: GDHandle;
|
|
theErr: OSErr;
|
|
|
|
{-----------}
|
|
|
|
function SetDepth (gd: GDHandle; newDepth, whichFlags, newFlags: Integer): Integer;
|
|
inline
|
|
$203C, $000A, $0013, $AAA2;
|
|
|
|
{-----------}
|
|
|
|
begin
|
|
CloseTools;
|
|
|
|
if (inColor) then
|
|
begin
|
|
DisposePalette(mainPalette);
|
|
if (mainWndo <> nil) then
|
|
DisposeWindow(GrafPtr(mainWndo));
|
|
CloseCPort(objectCPtr);
|
|
DisposPtr(objectCBits);
|
|
CloseCPort(virginCPtr);
|
|
DisposPtr(virginCBits);
|
|
CloseCPort(loadCPtr);
|
|
DisposPtr(loadCBits);
|
|
end
|
|
else
|
|
begin
|
|
if (mainWndo <> nil) then
|
|
DisposeWindow(mainWndo);
|
|
ClosePort(offVirginPort);
|
|
DisposPtr(Ptr(offVirginPort));
|
|
ClosePort(offPlayerPort);
|
|
DisposPtr(Ptr(offPlayerPort));
|
|
ClosePort(offLoadPort);
|
|
DisposPtr(Ptr(offLoadPort));
|
|
ClosePort(offMaskPort);
|
|
DisposPtr(Ptr(offMaskPort));
|
|
end;
|
|
|
|
SavePrefs;
|
|
|
|
if ((not cantColor) and (restoreColor) and (not cantSwitch)) then
|
|
begin
|
|
theDevice := GetMainDevice;
|
|
HLock(Handle(theDevice));
|
|
if (theDevice^^.gdPMap^^.pixelSize <> wasDepth) then
|
|
theErr := SetDepth(theDevice, wasDepth, GDTypeFlag, Color);
|
|
HUnlock(Handle(theDevice));
|
|
end;
|
|
end;
|
|
|
|
{=================================}
|
|
|
|
begin
|
|
InitVariables;
|
|
UnloadSeg(@InitVariables);
|
|
DoStartUp;
|
|
downIsDubl := TickCount;
|
|
|
|
repeat
|
|
if (hasWNE) then
|
|
eventHappened := WaitNextEvent(everyEvent, theEvent, sleep, nil)
|
|
else
|
|
begin
|
|
SystemTask;
|
|
eventHappened := GetNextEvent(everyEvent, theEvent);
|
|
end;
|
|
|
|
if (eventHappened) then
|
|
case (theEvent.what) of
|
|
NullEvent:
|
|
;
|
|
MouseDown, MouseUp:
|
|
DoMouseDown;
|
|
KeyDown, AutoKey:
|
|
DoKeyDown;
|
|
UpDateEvt:
|
|
DoUpdate;
|
|
DiskEvt: {call DIBadMount in response to a diskEvt}
|
|
DoDiskEvent;
|
|
App4Evt:
|
|
DoOSEvent;
|
|
otherwise
|
|
;
|
|
end; {case}
|
|
|
|
if ((marqueeTime) and (not inBackground)) then
|
|
DoMarquee;
|
|
|
|
until doneFlag; {End of the event loop}
|
|
|
|
CloseUpShop;
|
|
|
|
end. {End of the program} |