Glider4/Glider_405/Sources/G-IdleInput.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
12 KiB
OpenEdge ABL
Executable File
Raw Blame History

unit IdleInput;
interface
uses
SMS, Balloons, Palettes, Globals, GlobalUtils, FileInNOut, IdleUtils, PlayUtils, PlaySetUp;
procedure StartNewGame;
function GetGame: Boolean;
procedure HandleMenu (theMenu, theItem: integer);
procedure DoMouseDown;
procedure DoKeyDown;
procedure DoDiskEvent;
procedure DoOSEvent;
{=================================}
implementation
{=================================}
procedure StartNewGame;
var
i: Integer;
tempRect: Rect;
firstIs: string[32];
begin
if (not smsIsActive) then
SMSInit;
smsIsActive := TRUE;
if (is4Channel) then
SMSSetMode(4)
else
SMSSetMode(2);
if (not GetHouse) then
Exit(StartNewGame);
firstIs := thisHouse.firstFile;
if (firstIs <> housesName) and (firstIs <> '') and (firstIs <> 'nil') then
begin
GenericAlert(kErrNotFirstHouse);
housesName := firstIs;
if (not OpenHouse) then
begin
GenericAlert(kErrExitSansHouse);
Exit(StartNewGame);
end;
DoClose(houseVolNum);
{$IFC DemoVersion}
if (thisHouse.timeStamp <> 16) then
begin
GenericAlert(kErrNotDemoHouse);
Exit(StartNewGame);
end;
{$ENDC}
thisHouse.firstFile := '';
if (not WriteHouse) then
;
end;
firstFileName := housesName;
HideMenuBar;
if (screenBits.bounds.bottom > 382) then
begin
SetPort(GrafPtr(mainWndo));
PenNormal;
ClipRect(fullArea);
SetRect(tempRect, -rightOffset, -downOffset, 512 + 2 * rightOffset, -downOffset + 20);
FillRect(tempRect, black);
ClipRect(wholeArea);
end;
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
with scoreList do
begin
changed := FALSE;
rank := 20;
end;
roomAt := 1;
roomsPassed := 1;
roomScore := 0;
suppScore := 0;
rollScore := 0;
GetDateTime(workingGameNumber);
sideYouCantExit := whoCares;
loopsThruRoom := 0;
bassLoop := 0;
playBassTime := kBonusTimeToBeat div kBassFract + kMinBassLoop;
for i := 1 to 40 do
roomVisits[i] := FALSE;
if (ozmaFlags[3]) then
begin
mortals := 50;
refuseHigh := TRUE;
end
else
begin
mortals := 5;
refuseHigh := FALSE;
end;
for i := 0 to 3 do
ozmaFlags[i] := FALSE;
enteredLeft := TRUE;
with theGlider do
begin
isRight := TRUE;
bands := 0;
forVel := 4;
energy := 0;
end;
ResetGlider;
playing := TRUE;
pausing := FALSE;
hasMirror := FALSE;
hasWindow := FALSE;
hasToast := FALSE;
scoreIsRolling := FALSE;
floatPoints.out := FALSE;
ReadyRoom;
gameName := '';
DisableItem(GetMenu(mGame), iLoadHouse);
EnableItem(GetMenu(mGame), iEndGame);
DisableItem(GetMenu(mGame), iLoadGame);
{$IFC not DemoVersion}
EnableItem(GetMenu(mGame), iSaveGame);
EnableItem(GetMenu(mGame), iSaveGameAs);
{$ENDC}
DisableItem(GetMenu(mOption), iHiScores);
SetPort(GrafPtr(mainWndo));
PenNormal;
TextFont(0);
TextSize(12);
TextMode(patOr);
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
SetCursor(noCursor^^);
DissBlocks;
FlushEvents(everyEvent, 0);
end;
{=================================}
procedure DoLoadHouse;
var
killed: Boolean;
begin
{$IFC not DemoVersion}
if DoOpen(kHouseType) then
begin
demoMode := Randomize(lastDemo) + 1;
HideMenuBar;
StartNewGame;
end;
{$ENDC}
end;
{=================================}
procedure DoEndGame;
begin
SetItem(GetMenu(mGame), iBegin, 'Begin Game<6D>');
WrapItUp;
DrawMenuBar;
end;
{=================================}
function GetGame;
var
tempRect: Rect;
begin
GetGame := FALSE;
if (not ReadGame) then
Exit(GetGame);
if (not smsIsActive) then
SMSInit;
smsIsActive := TRUE;
if (is4Channel) then
SMSSetMode(4)
else
SMSSetMode(2);
demoMode := Randomize(lastDemo) + 1;
HideMenuBar;
if (screenBits.bounds.bottom > 382) then
begin
SetPort(GrafPtr(mainWndo));
PenNormal;
ClipRect(fullArea);
SetRect(tempRect, -rightOffset, -downOffset, 512 + 2 * rightOffset, -downOffset + 20);
FillRect(tempRect, black);
ClipRect(wholeArea);
end;
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
ResetGlider;
playing := TRUE;
pausing := FALSE;
hasMirror := FALSE;
hasWindow := FALSE;
hasToast := FALSE;
scoreIsRolling := FALSE;
refuseHigh := TRUE;
floatPoints.out := FALSE;
sideYouCantExit := whoCares;
loopsThruRoom := 0;
bassLoop := 0;
playBassTime := kBonusTimeToBeat div kBassFract + kMinBassLoop;
ReadyRoom;
DisableItem(GetMenu(mGame), iLoadHouse);
EnableItem(GetMenu(mGame), iEndGame);
DisableItem(GetMenu(mGame), iLoadGame);
EnableItem(GetMenu(mGame), iSaveGame);
EnableItem(GetMenu(mGame), iSaveGameAs);
DisableItem(GetMenu(mOption), iHiScores);
SetPort(GrafPtr(mainWndo));
PenNormal;
TextFont(0);
TextSize(12);
TextMode(patOr);
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
SetCursor(noCursor^^);
DissBlocks;
FlushEvents(everyEvent, 0);
GetGame := TRUE;
end;
{=================================}
procedure ResumeGame;
var
tempRect: Rect;
begin
if (not smsIsActive) then
SMSInit;
smsIsActive := TRUE;
if (is4Channel) then
SMSSetMode(4)
else
SMSSetMode(2);
HideMenuBar;
SetItem(GetMenu(mGame), iBegin, 'Begin Game<6D>');
SetCursor(noCursor^^);
pausing := FALSE;
if (screenBits.bounds.bottom < 382) then
begin
SetPort(GrafPtr(mainWndo));
SetRect(tempRect, 0, 0, 512, 20);
if (inColor) then
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, GrafPtr(mainWndo)^.portBits, tempRect, tempRect, srcCopy, nil)
else
CopyBits(offVirginMap, mainWndo^.portBits, tempRect, tempRect, srcCopy, nil);
end
else
begin
SetPort(GrafPtr(mainWndo));
PenNormal;
ClipRect(fullArea);
SetRect(tempRect, -rightOffset, -downOffset, 512 + 2 * rightOffset, -downOffset + 20);
FillRect(tempRect, black);
ClipRect(wholeArea);
end;
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
end;
{=================================}
procedure HandleMenu; {Handle menu selections realtime}
var
DNA, i, volNum: integer;
BoolHolder, cancelIt: boolean;
DAName: Str255;
SavePort: GrafPtr;
tempRect: Rect;
begin
case theMenu of
mApple:
case theItem of
iNothing:
;
iAbout:
DoAbout;
otherwise
begin
GetPort(SavePort);
GetItem(GetMenu(mApple), theItem, DAName);
DNA := OpenDeskAcc(DAName);
SetPort(SavePort);
end;
end;
mGame:
case theItem of
iBegin:
begin
demoMode := Randomize(lastDemo) + 1;
if (pausing and playing) then
ResumeGame
else
StartNewGame;
end;
iLoadHouse:
DoLoadHouse;
iEndGame:
DoEndGame;
iLoadGame:
begin
{$IFC not DemoVersion}
if (DoOpen(kGameType)) then
begin
if (not GetGame) then
;
end;
{$ENDC}
end;
iSaveGame:
begin
{$IFC not DemoVersion}
if (not SaveGame) then
;
{$ENDC}
end;
iSaveGameAs:
begin
{$IFC not DemoVersion}
if (not SaveGameAs) then
;
{$ENDC}
end;
iQuit:
begin
{$IFC DemoVersion}
playing := FALSE;
pausing := FALSE;
doneFlag := TRUE;
{$ELSEC}
if DoQuit then
begin
playing := FALSE;
pausing := FALSE;
doneFlag := TRUE;
end
else if (SaveGame) then
begin
playing := FALSE;
pausing := FALSE;
doneFlag := TRUE;
end;
{$ENDC}
end;
otherwise
end;
mOption:
case theItem of
iControls:
;
iSound:
DoSoundSettings;
iShowAir:
begin
airVisible := not airVisible;
if (airVisible) then
SetItem(GetMenu(mOption), iShowAir, 'Air is Visible')
else
SetItem(GetMenu(mOption), iShowAir, 'Air is Invisible');
if (playing) then
GenericAlert(kErrAirChange);
end;
iRestoreDeep:
begin
restoreColor := not restoreColor;
if (restoreColor) then
SetItem(GetMenu(mOption), iRestoreDeep, 'Depth Restore is On')
else
SetItem(GetMenu(mOption), iRestoreDeep, 'Depth Restore is Off');
end;
iHiScores:
DrawHiScores;
iHelp:
OpenHelpScreens;
otherwise
end;
mControls:
case theItem of
iHoldKeyboard..iRelMouse:
begin
for i := iHoldKeyboard to iRelMouse do
CheckItem(GetMenu(mControls), i, FALSE);
CheckItem(GetMenu(mControls), theItem, TRUE);
controlMethod := theItem;
end;
iConfigure:
DoCustomizeKeys;
otherwise
end;
kHMHelpMenuID:
if (theItem = iGlidersHelp) then
OpenHelpScreens;
otherwise
end;
HiliteMenu(0);
end;
{=================================}
procedure DoMouseDown;
var
whichWindow: WindowPtr;
theMenu, theItem, code: Integer;
mResult: LongInt;
begin
code := FindWindow(theEvent.where, whichWindow);
if (demoMode = highScoreMode) then
CloseHiScores
else if (demoMode = helpScreensMode) then
NextPageHelpScreens
else
case (code) of
inMenuBar:
begin
mResult := MenuSelect(theEvent.Where);
theMenu := HiWord(mResult);
theItem := LoWord(mResult);
HandleMenu(theMenu, theItem);
end;
inSysWindow:
SystemClick(theEvent, whichWindow);
otherwise
end;
end;
{=================================}
procedure DoKeyDown;
var
chCode, theMenu, theItem: Integer;
mResult: LongInt;
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
begin
{knock through the demo messages}
if ((chCode = kSpaceBar) and (demoMode <> highScoreMode)) then
begin
if (demoMode = helpScreensMode) then
NextPageHelpScreens
else
begin
demoMode := demoMode + 1;
if (demoMode > lastDemo) then
demoMode := 1;
demoCount := 0;
NewMode(FALSE);
end;
end;
if (chCode = kReturnKey) then
begin
if (demoMode = helpScreensMode) then
CloseHelpScreens
else if (demoMode = highScoreMode) then
CloseHiScores;
end;
{return from a paused game}
if ((chCode = kTabKey) and (playing) and (pausing)) then
begin
demoMode := Randomize(lastDemo) + 1;
HideMenuBar;
ResumeGame;
repeat
GetKeys(theKeys);
until (not theKeys[kTabKeyMap]);
end;
{check for secret code entered!}
if (chCode = $4F) then
ozmaFlags[0] := TRUE;
if ((chCode = $7A) and (ozmaFlags[0])) then
ozmaFlags[1] := TRUE;
if ((chCode = $6D) and (ozmaFlags[1])) then
ozmaFlags[2] := TRUE;
if ((chCode = $61) and (ozmaFlags[2])) then
begin
ozmaFlags[3] := TRUE;
refuseHigh := TRUE;
end;
end; {if (Odd(mod...}
end; {with theEvent}
end; {procedure}
{=================================}
procedure DoDiskEvent;
var
cornerPt: Point;
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: {suspendResumeMessage}
if (BitAnd(theEvent.message, kSuspendResumeBit) = kResuming) then
begin
inBackground := FALSE; {it was a resume event}
if (not smsIsActive) then
SMSInit;
smsIsActive := TRUE;
if (is4Channel) then
SMSSetMode(4)
else
SMSSetMode(2);
{re-grow window's right edge}
end
else
begin
if (smsIsActive) then
SMSExit;
smsIsActive := FALSE;
inBackground := TRUE; {it was a suspend event}
{shrink window's right edge}
ShowMenuBar;
end;
otherwise
end; {CASE}
end; {osEvt}
{=================================}
end.