mirror of
https://github.com/softdorothy/Glider4.git
synced 2024-05-28 16:41:28 +00:00
e178486ce8
There was an effort to organize the files a little bit for presenting in this repository. I hope I have included everything needed for both Glider 4.05 and the Room Editor 1.0.3. The code is in Pascal — THINK Pascal was used to build the original. I’m not sure how someone would open the project files (or for that matter the resource files) these days. Never mind there is also a .o file (SMS.a) representing a statically linked library (from hand-coded 68K assembly) for doing performant 4-channel sound on 68K Macs in the day (this was licensed from Patrick Buckland — I’m sure he won’t mind my preserving it here for posterity, right?). Art files, sound files of unknown format…. What a joy it will be sleuthing through these files…. Enjoy.
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} |