Glider4/Glider_405/Sources/G-GameBody.p
John Calhoun e178486ce8 Initial check-in
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.
2016-01-26 20:30:26 -08:00

1 line
6.0 KiB
OpenEdge ABL
Executable File

{------------------------------------------------------}
{ }
{ G L I D E R }
{ }
{ }
{ Glider 4.05, copyright 1991, Casady & Greene, Inc. }
{ All code contained herein is by john calhoun }
{ }
{ This is version 4.05 compiled with THINK Pascal 3.02 }
{ }
{------------------------------------------------------}
program Glider;
{$I-}
uses
SMS, Palettes, Globals, GlobalUtils, IdleUtils, PlayActive, FileInNOut, IdleInput, Initialize;
var
eventHappened: Boolean;
{=================================}
procedure SavePrefs;
type
prefType = record
theName: string[24];
houseName: string[32];
resName: string[32];
sndVolume: Integer;
controlIs: Integer;
leftIs, rightIs, energyIs, bandIs: Integer;
musicIs, channel4Is, airVisIs, buttonIs, restoreIs: Boolean;
leftNameIs, rightNameIs, energyNameIs, bandNameIs: string[12];
keyBoardIs: Integer;
end;
prefPtr = ^prefType;
prefHand = ^prefPtr;
var
theirPrefs: prefHand;
begin
UseResFile(gliderResNum);
theirPrefs := prefHand(NewHandle(SIZEOF(prefType)));
if (theirPrefs = nil) then
begin
GenericAlert(kErrMemLow);
Exit(SavePrefs);
end;
Handle(theirPrefs) := Get1Resource('Gprf', 128);
if ((ResError = noErr) and (theirPrefs <> nil)) then
begin
HLock(Handle(theirPrefs));
with theirPrefs^^ do
begin
houseName := defaultHouse;
theName := playerName;
resName := resourceName;
GetSoundVol(sndVolume);
controlIs := controlMethod;
leftIs := leftKey;
rightIs := rightKey;
energyIs := energyKey;
bandIs := bandKey;
musicIs := musicOn;
channel4Is := is4Channel; {presently un-used}
airVisIs := airVisible;
buttonIs := buttonFires;
restoreIs := restoreColor;
leftNameIs := leftName;
rightNameIs := rightName;
energyNameIs := energyName;
bandNameIs := bandName;
keyBoardIs := herKeyBoard;
end;
end
else
begin
GenericAlert(kErrLoadingRes);
Exit(SavePrefs);
end;
ChangedResource(Handle(theirPrefs));
WriteResource(Handle(theirPrefs));
if (ResError <> noErr) then
begin
if ((ResError = FLckdErr) or (ResError = VLckdErr) or (ResError = WPrErr)) then
GenericAlert(kErrSavingPrefs)
else
GenericAlert(ResError);
end;
HUnlock(Handle(theirPrefs));
ReleaseResource(Handle(theirPrefs));
end;
{=================================}
procedure DoUpdate;
var
whichWindow: WindowPtr;
begin
whichWindow := WindowPtr(theEvent.message);
if (whichWindow = mainWndo) then
begin
BeginUpdate(mainWndo);
RedrawWindowFrame;
if ((demoMode = highScoreMode) and (not playing)) then
DrawHiScores
else if (demoMode = helpScreensMode) then
DisplayAHelpScreen
else
begin
if (inColor) then
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, GrafPtr(mainWndo)^.portBits, wholeArea, wholeArea, srcCopy, mainWndo^.visRgn)
else
CopyBits(offVirginMap, mainWndo^.portBits, wholeArea, wholeArea, srcCopy, mainWndo^.visRgn);
end;
EndUpdate(mainWndo);
ClipRect(wholeArea);
end;
end;
{=================================}
procedure CloseUpShop;
const
Color = 1;
GDTypeFlag = 1;
var
theDevice: GDHandle;
{-----------}
function SetDepth (gd: GDHandle; newDepth, whichFlags, newFlags: Integer): Integer;
inline
$203C, $000A, $0013, $AAA2;
{-----------}
begin
DropIdle;
ShowMenuBar;
SpinBall;
if (hasMirror) then
begin
hasMirror := FALSE;
HUnlock(Handle(mirrorRgn));
DisposeRgn(mirrorRgn);
end;
if (hasWindow) then
begin
hasWindow := FALSE;
HUnlock(Handle(windowRgn));
DisposeRgn(windowRgn);
end;
if (hasToast) then
begin
hasToast := FALSE;
HUnlock(Handle(toastRgn));
DisposeRgn(toastRgn);
end;
SpinBall;
if (smsIsActive) then
SMSExit;
smsIsActive := FALSE;
SpinBall;
if (wholeRgn <> nil) then
begin
HUnlock(Handle(wholeRgn));
DisposeRgn(wholeRgn);
end;
SpinBall;
if (inColor) then
begin
if (mainPalette <> nil) then
DisposePalette(mainPalette);
if (mainWndo <> nil) then
DisposeWindow(GrafPtr(mainWndo));
CloseCPort(objectCPtr);
DisposPtr(objectCBits);
CloseCPort(virginCPtr);
DisposPtr(virginCBits);
CloseCPort(loadCPtr);
DisposPtr(loadCBits);
CloseCPort(reserveCPtr);
DisposPtr(reserveCBits);
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));
ClosePort(offReservePort);
DisposPtr(Ptr(offReservePort));
end;
SpinBall;
SavePrefs;
SpinBall;
SetSoundVol(wasSndVolume);
if ((not cantColor) and (restoreColor) and (not cantSwitch)) then
begin
theDevice := GetMainDevice;
if (theDevice <> nil) then
begin
HLock(Handle(theDevice));
if (theDevice^^.gdPMap^^.pixelSize <> wasDepth) then
theErr := SetDepth(theDevice, wasDepth, GDTypeFlag, Color);
HUnlock(Handle(theDevice));
end;
end;
end;
{=================================}
begin
InitializeAll;
InitCursor;
InitIdle;
{$IFC not DemoVersion}
DoStartUp;
{$ENDC}
UnloadSeg(@InitializeAll);
UnloadSeg(@DoStartUp);
repeat
if (hasWNE) then
eventHappened := WaitNextEvent(everyEvent, theEvent, kSleep, nil)
else
begin
SystemTask;
eventHappened := GetNextEvent(everyEvent, theEvent);
end;
if (eventHappened) then
case (theEvent.what) of
MouseDown:
DoMouseDown;
KeyDown, AutoKey:
DoKeyDown;
UpDateEvt:
DoUpdate;
DiskEvt: {call DIBadMount in response to a diskEvt}
DoDiskEvent;
App4Evt:
DoOSEvent;
otherwise
end; {case}
if (not pausing) then
begin
if (playing) then
Coordinate
else if ((not inBackground) and (mainWndo = FrontWindow)) then
DoIdle;
end;
until doneFlag; {End of the event loop}
CloseUpShop; {Dispose of all data structures, etc....}
end. {Finis}