Glider4/Glider_405/Sources/G-Initialize.p

1 line
40 KiB
OpenEdge ABL
Executable File

unit Initialize;
interface
uses
Balloons, Palettes, Globals, GlobalUtils, FileInNOut, IdleInput;
procedure InitializeAll;
procedure DoStartUp;
{=================================}
implementation
{=================================}
procedure InitializeAll;
var
i: Integer;
ignoreStr: Str255;
{------------------------}
procedure InitToolBox;
var
ignore: Boolean;
begin
gliderResNum := CurResFile;
SetApplLimit(Ptr(LongInt(GetApplLimit) - kStackSize));
MaxApplZone;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
MoreMasters;
InitGraf(@thePort);
InitFonts;
FlushEvents(everyEvent, 0);
InitWindows;
InitMenus;
TEInit;
InitDialogs(nil);
ignore := EventAvail(EveryEvent, theEvent);
inBackground := FALSE;
end;
{------------------------}
procedure CheckOurEnvirons;
const
WNETrapNum = $60;
unimplTrapNum = $9F;
SoundBase = $0266;
ASCBase = $0CC0;
Color = 1;
Monochrome = 0;
GDTypeFlag = 1;
kPointerBase = $3F2700 - $20;
var
thisWorld: SysEnvRec;
tempRes: Handle;
theDevice: GDHandle;
initsPointer: Ptr;
theResponse, initData: LongInt;
sheSaid: Integer;
hasINIT: Boolean;
{-----------}
function DepthAlert: Integer;
var
dummyInt: Integer;
alertHandle: AlertTHndl;
alertRect: Rect;
begin
UseResFile(gliderResNum);
InitCursor;
alertHandle := AlertTHndl(Get1Resource('ALRT', rDepthAlertID));
if (alertHandle <> nil) then
begin
HNoPurge(Handle(alertHandle));
alertRect := alertHandle^^.boundsRect;
OffsetRect(alertRect, -alertRect.left, -alertRect.top);
dummyInt := (screenBits.bounds.right - alertRect.right) div 2;
OffsetRect(alertRect, dummyInt, 0);
dummyInt := (screenBits.bounds.bottom - alertRect.bottom) div 3;
OffsetRect(alertRect, 0, dummyInt);
alertHandle^^.boundsRect := alertRect;
HPurge(Handle(alertHandle));
end;
dummyInt := Alert(rDepthAlertID, nil);
DepthAlert := dummyInt;
end;
{-----------}
function SetDepth (gd: GDHandle; newDepth, whichFlags, newFlags: Integer): Integer;
inline
$203C, $000A, $0013, $AAA2;
{-----------}
procedure ForceBlackAndWhite;
begin
with theDevice^^.gdPMap^^ do
if (pixelSize <> 1) then
if (cantSwitch) then {if we can't switch via software}
begin
GenericAlert(kErr2Or16Colors); {say, "Hey, set the Control Panel"}
ExitToShell;
end
else
begin {we can switch via software}
theErr := SetDepth(theDevice, 1, GDTypeFlag, Color);
inColor := FALSE;
end; {end - we can switch via software}
end;
{-----------}
procedure CheckAndSwitch;
begin
with theDevice^^.gdPMap^^ do
if ((pixelSize <> 4) and (pixelSize <> 1)) then
if (cantSwitch) then {if we can't switch via software}
begin
GenericAlert(kErr2Or16Colors); {say, "Hey, set the Control Panel"}
ExitToShell;
end
else
begin {we can switch via software}
sheSaid := DepthAlert; {bring up monitor switch alert}
case sheSaid of {what button did they click?}
1: {switch to 16 color}
theErr := SetDepth(theDevice, 4, GDTypeFlag, Color);
2: {switch to B&W}
begin
theErr := SetDepth(theDevice, 1, GDTypeFlag, Color);
inColor := FALSE;
end;
otherwise
begin
InitCursor;
ExitToShell;
end;
end;
end; {end - we can switch via software}
end;
{-----------}
begin
tempRes := Get1Resource('CURS', 128);
if (tempRes <> nil) then
begin
HLock(tempRes);
SetResInfo(tempRes, 128, 'oz');
if (ResError = WPrErr) or (ResError = FLckdErr) or (ResError = VLckdErr) then
begin
GenericAlert(kErrVolLocked);
ExitToShell;
end;
ChangedResource(tempRes);
if (ResError = WPrErr) or (ResError = FLckdErr) or (ResError = VLckdErr) then
begin
GenericAlert(kErrVolLocked);
ExitToShell;
end;
WriteResource(tempRes);
if (ResError = WPrErr) or (ResError = FLckdErr) or (ResError = VLckdErr) then
begin
GenericAlert(kErrVolLocked);
ExitToShell;
end;
HUnlock(tempRes);
ReleaseResource(tempRes);
end
else
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
rightOffset := (ScreenBits.bounds.right - 512) div 2;
downOffset := (ScreenBits.bounds.bottom - 342) div 2;
theErr := SysEnvirons(1, thisWorld); {Check on the set up of the Mac game is on }
with thisWorld do
begin
if (machineType < envMacPlus) then {If less than a Mac 512KE (=1) then quit now!}
begin
GenericAlert(kErrMacPlusNeeded);
ExitToShell;
end;
inhibitSound := FALSE;
cantSwitch := (systemVersion < $0605);
hasSys7 := (systemVersion >= $0700);
areFlipping := (machineType = envMacPlus) or (machineType = envSE) or (machineType = 15);
if (areFlipping) then
begin
hasINIT := TRUE;
initsPointer := Pointer(kPointerBase + 1);
initData := initsPointer^;
if (initData <> $61) and (initData <> $48) then
hasINIT := FALSE;
initsPointer := Pointer(kPointerBase + 2);
initData := initsPointer^;
if (initData <> $6C) and (initData <> $6F) then
hasINIT := FALSE;
initsPointer := Pointer(kPointerBase + 3);
initData := initsPointer^;
if (initData <> $74) and (initData <> $6C) then
hasINIT := FALSE;
if ((not hasINIT) and (areFlipping)) then
begin
GenericAlert(kErrMissionINIT);
areFlipping := FALSE;
end;
scoreIncrement := kFastScoreIncrement;
end
else
scoreIncrement := kSlowScoreIncrement;
herKeyboard := keyBoardType;
cantColor := not hasColorQD;
inColor := hasColorQD;
if (inColor) then
begin
theDevice := GetMainDevice;
if (theDevice = nil) then
begin
GenericAlert(kErrUnaccounted);
ExitToShell;
end;
HLock(Handle(theDevice));
with theDevice^^.gdPMap^^ do
begin
wasDepth := pixelSize;
GetKeys(theKeys);
if (theKeys[kCommandKeyMap]) then
ForceBlackAndWhite
else
CheckAndSwitch;
if (pixelSize = 1) then
inColor := FALSE;
end;
HUnlock(Handle(theDevice));
end;
end; {end - with thisWorld}
hasWNE := (NGetTrapAddress(WNETrapNum, ToolTrap) <> NGetTrapAddress(unimplTrapNum, toolTrap));
end;
{------------------------}
procedure LoadCursors;
var
count: Integer;
tempByte: SignedByte;
begin
useColorCursor := inColor;
UseResFile(gliderResNum);
noCursor := GetCursor(128);
ballList := acurHand(GetResource('acur', rAcurID));
if (ballList = nil) then
begin
GenericAlert(kErrLoadingRes);
Exit(LoadCursors);
end;
tempByte := HGetState(Handle(ballList));
HLock(Handle(ballList));
with ballList^^ do
begin
for count := 1 to kCursCount do
begin
if (useColorCursor) then
begin
ballC[count] := GetCCursor(HiWord(LongInt(ball[count])));
if (ballC[count] = nil) then
useColorCursor := FALSE;
end;
ball[count] := GetCursor(HiWord(LongInt(ball[count])));
if (ball[count] = nil) then
begin
GenericAlert(kErrLoadingRes);
whichBall := -1;
Exit(LoadCursors);
end;
end;
whichBall := 0;
end;
HSetState(Handle(ballList), tempByte);
end;
{------------------------}
procedure InitGlobalRects;
begin
SetRect(wholeArea, 0, 0, 512, 342);
SetRect(fullArea, -rightOffset, -downOffset, 512 + rightOffset, 342 + downOffset);
SetRect(nullRect, -500, -500, -500, -500);
SetRect(smScoreRect, 224, 8, 296, 17);
SetRect(lgScoreRect, 222, 4, 296, 21);
wholeRgn := NewRgn;
RectRgn(wholeRgn, wholeArea);
MoveHHi(Handle(wholeRgn));
HLock(Handle(wholeRgn));
end;
{------------------------}
procedure SetUpColors;
begin
rgbBlack.red := 0;
rgbBlack.green := 0;
rgbBlack.blue := 0;
rgbWhite.red := -1;
rgbWhite.green := -1;
rgbWhite.blue := -1;
rgbYellow.red := -1;
rgbYellow.green := -1;
rgbYellow.blue := 0;
rgbViolet.red := -1;
rgbViolet.green := 0;
rgbViolet.blue := -1;
rgbRed.red := -1;
rgbRed.green := 0;
rgbRed.blue := 0;
rgbLtBlue.red := 0;
rgbLtBlue.green := -1;
rgbLtBlue.blue := -1;
rgbBrown.red := 22016;
rgbBrown.green := 11421;
rgbBrown.blue := 1316;
rgbLtBrown.red := -28457;
rgbLtBrown.green := 29024;
rgbLtBrown.blue := 14900;
rgbDkGray.red := 16384;
rgbDkGray.green := 16384;
rgbDkGray.blue := 16384;
rgbBlue.red := 0;
rgbBlue.green := 0;
rgbBlue.blue := -1;
rgbLtGreen.red := 7967;
rgbLtGreen.green := -18503;
rgbLtGreen.blue := 5140;
end;
{------------------------}
procedure SetUpMainWndo;
var
thePict: PicHandle;
tempRect: Rect;
tempByte: SignedByte;
begin
{Init main window}
mainWndo := nil;
if (inColor) then {load the window template from resource}
mainWndo := GetNewCWindow(rMainWndoID, nil, Pointer(-1))
else
mainWndo := GetNewWindow(rMainWndoID, nil, WindowPtr(-1));
if (mainWndo = nil) then
begin
mainWndo := nil;
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
{properly size and then show window}
SizeWindow(GrafPtr(mainWndo), 512 + (2 * rightOffset), 342 + (2 * downOffset), FALSE);
ShowWindow(mainWndo);
SelectWindow(GrafPtr(mainWndo));
SetPort(GrafPtr(mainWndo));
{set up windows coordinate system}
SetOrigin(-rightOffset, -downOffset);
{fill black all around the border}
SetRect(tempRect, -rightOffset, -downOffset, 512 + (2 * rightOffset), 0);
FillRect(tempRect, black);
SetRect(tempRect, -rightOffset, 342, 512 + (2 * rightOffset), 342 + downOffset);
FillRect(tempRect, black);
SetRect(tempRect, -rightOffset, 0, 0, 342);
FillRect(tempRect, black);
SetRect(tempRect, 512, 0, 512 + rightOffset, 342);
FillRect(tempRect, black);
if (inColor) then
begin
RGBForeColor(rgbBlack);
RGBBackColor(rgbWhite);
{assign palette}
mainPalette := GetNewPalette(rMainWndoID);
SetPalette(mainWndo, mainPalette, TRUE);
{load side-bar PICTs}
SetRect(tempRect, -64, 0, 0, 342);
thePict := GetPicture(rSidePict1);
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
MoveHHi(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, tempRect);
HSetState(Handle(thePict), tempByte);
end
else
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
ReleaseResource(Handle(thePict));
end
else
begin
TextFont(201); {This is to preload the fonts}
DrawString('o'); {needed so that there is no }
TextFont(200); {disk-access delay when they }
DrawString('z'); {are needed in the game. }
end;
{load in other side-bar PICT}
if (inColor) then
begin
SetRect(tempRect, 512, 0, 512 + 64, 342);
thePict := GetPicture(rSidePict2);
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
MoveHHi(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, tempRect);
HSetState(Handle(thePict), tempByte);
end
else
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
ReleaseResource(Handle(thePict));
end;
ClipRect(wholeArea);
{load in splash PICT}
if (inColor) then
thePict := GetPicture(rColorIdleID)
else
thePict := GetPicture(rIdleID);
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
MoveHHi(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, wholeArea);
HSetState(Handle(thePict), tempByte);
end
else
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
ReleaseResource(Handle(thePict));
{$IFC DemoVersion}
MoveTo(13, 113);
TextFont(SystemFont);
if (inColor) then
begin
ForeColor(redColor);
TextMode(patOr);
DrawString('DEMO VERSION');
ForeColor(blackColor);
end
else
begin
TextMode(patXOr);
DrawString('DEMO VERSION');
end;
{$ENDC}
end;
{------------------------}
function NewBitMap (var theBitMap: BitMap; theRect: Rect): Ptr;
begin
SpinBall;
with theBitMap, theRect do
begin
rowBytes := ((right - left + 15) div 16) * 2;
baseAddr := NewPtr(rowBytes * (bottom - top));
bounds := theRect;
if (MemError <> noErr) then
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end
else
NewBitMap := baseAddr;
end;
end;
{------------------------}
procedure SetUpBitMaps;
var
thePict: PicHandle;
rawPointer: Ptr;
tempRect: Rect;
tempByte: SignedByte;
begin
{Init b&w Bitmaps}
{Init offscreen virgin map}
offVirginPort := GrafPtr(NewPtr(SizeOf(GrafPort)));
OpenPort(offVirginPort);
offVirginBits := NewBitMap(offVirginMap, wholeArea);
SetPortBits(offVirginMap);
ClipRect(wholeArea);
EraseRect(offVirginMap.bounds);
thePict := GetPicture(rIdleID);
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
MoveHHi(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, wholeArea);
HSetState(Handle(thePict), tempByte);
end
else
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
ReleaseResource(Handle(thePict));
{$IFC DemoVersion}
MoveTo(13, 113);
TextFont(SystemFont);
TextMode(patXOr);
DrawString('DEMO VERSION');
{$ENDC}
SpinBall;
{Init offscreen load map}
if (areFlipping) then
begin
offLoadPort := GrafPtr(NewPtr(SizeOf(GrafPort)));
OpenPort(offLoadPort);
with offLoadMap, ScreenBits.bounds do
begin
rowBytes := ((right - left + 15) div 16) * 2;
baseAddr := Pointer(kSecondaryAddr);
bounds := ScreenBits.bounds;
if (MemError <> noErr) then
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end
else
offLoadBits := baseAddr;
end;
SetPortBits(offLoadMap);
ClipRect(ScreenBits.bounds);
EraseRect(offLoadMap.bounds);
end
else
begin
offLoadPort := GrafPtr(NewPtr(SizeOf(GrafPort)));
OpenPort(offLoadPort);
offLoadBits := NewBitMap(offLoadMap, wholeArea);
SetPortBits(offLoadMap);
ClipRect(wholeArea);
EraseRect(offLoadMap.bounds);
end;
{Init offscreen object map}
offPlayerPort := GrafPtr(NewPtr(SizeOf(GrafPort)));
OpenPort(offPlayerPort);
offPlayerBits := NewBitMap(offPlayerMap, wholeArea);
SetPortBits(offPlayerMap);
ClipRect(wholeArea);
EraseRect(offPlayerMap.bounds);
{Init offscreen reserve map}
SetRect(tempRect, 0, 0, 192, 116);
offReservePort := GrafPtr(NewPtr(SizeOf(GrafPort)));
OpenPort(offReservePort);
offReserveBits := NewBitMap(offReserveMap, tempRect);
SetPortBits(offReserveMap);
ClipRect(offReserveMap.bounds);
EraseRect(offReserveMap.bounds);
end; {black and white set-up}
{------------------------}
procedure SetUpPixMaps;
var
thePict: PicHandle;
sizeOfOff, offRowBytes: LongInt;
tempRect: Rect;
theDepth: Integer;
tempByte: SignedByte;
begin
virginCPtr := @virginCPort;
OpenCPort(virginCPtr);
theDepth := 4;
offRowBytes := ((((theDepth * (wholeArea.right - wholeArea.left)) + 15)) div 16) * 2;
sizeOfOff := LONGINT(wholeArea.bottom - wholeArea.top) * offRowBytes;
virginCBits := NewPtr(sizeOfOff);
if (virginCPtr = nil) then
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
with virginCPtr^.portPixMap^^ do
begin
baseAddr := virginCBits;
rowBytes := offRowBytes + $8000;
bounds := wholeArea;
end;
RGBForeColor(rgbBlack);
RGBBackColor(rgbWhite);
EraseRect(thePort^.portRect);
ClipRect(wholeArea);
{load virgin ports PICT}
SpinBall;
thePict := GetPicture(rColorIdleID);
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
MoveHHi(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, wholeArea);
HSetState(Handle(thePict), tempByte);
end
else
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
ReleaseResource(Handle(thePict));
{$IFC DemoVersion}
MoveTo(13, 113);
TextFont(SystemFont);
ForeColor(redColor);
TextMode(patOr);
DrawString('DEMO VERSION');
ForeColor(blackColor);
{$ENDC}
SpinBall;
loadCPtr := @loadCPort;
OpenCPort(loadCPtr);
loadCBits := NewPtr(sizeOfOff);
if (loadCBits = nil) then
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
with loadCPtr^.portPixMap^^ do
begin
baseAddr := loadCBits;
rowBytes := offRowBytes + $8000;
bounds := wholeArea;
end;
RGBForeColor(rgbBlack);
RGBBackColor(rgbWhite);
EraseRect(thePort^.portRect);
ClipRect(wholeArea);
objectCPtr := @objectCPort;
OpenCPort(objectCPtr);
objectCBits := NewPtr(sizeOfOff);
if (objectCBits = nil) then
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
with objectCPtr^.portPixMap^^ do
begin
baseAddr := objectCBits;
rowBytes := offRowBytes + $8000;
bounds := wholeArea;
end;
RGBForeColor(rgbBlack);
RGBBackColor(rgbWhite);
EraseRect(thePort^.portRect);
ClipRect(wholeArea);
{Init offscreen reserve map}
reserveCPtr := @reserveCPort;
OpenCPort(reserveCPtr);
SetRect(tempRect, 0, 0, 192, 116);
offRowBytes := ((((theDepth * (tempRect.right - tempRect.left)) + 15)) div 16) * 2;
sizeOfOff := LONGINT(tempRect.bottom - tempRect.top) * offRowBytes;
reserveCBits := NewPtr(sizeOfOff);
if (reserveCBits = nil) then
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
with reserveCPtr^.portPixMap^^ do
begin
baseAddr := reserveCBits;
rowBytes := offRowBytes + $8000;
bounds := tempRect;
end;
RGBForeColor(rgbBlack);
RGBBackColor(rgbWhite);
EraseRect(thePort^.portRect);
ClipRect(thePort^.portRect);
end;
{------------------------}
procedure SetUpOffMask;
begin
{Init offscreen mask map}
offMaskPort := GrafPtr(NewPtr(SizeOf(GrafPort)));
OpenPort(offMaskPort);
offMaskBits := NewBitMap(offMaskMap, wholeArea);
SetPortBits(offMaskMap);
ClipRect(wholeArea);
EraseRect(offMaskMap.bounds);
end;
{------------------------}
procedure GetPrefs;
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;
pictDeepPt = ^Integer;
pictDeepHn = ^pictDeepPt;
var
theirPrefs: prefHand;
pictDeep: pictDeepHn;
refNumber, tempVol: Integer;
satisfactory: Boolean;
{-----------------}
procedure DefaultControls;
begin
leftKey := kDefaultLeftKey;
rightKey := kDefaultRightKey;
energyKey := kDefaultEnergyKey;
bandKey := kDefaultBandKey;
buttonFires := FALSE;
leftName := kDefaultLeftName;
rightName := kDefaultRightName;
energyName := kDefaultEnergyName;
bandName := kDefaultBandName;
end;
{-----------------}
procedure Default;
begin
{$IFC DemoVersion}
housesName := 'Demo House';
{$ELSEC}
housesName := 'The House';
{$ENDC}
playerName := 'Your name here...';
if (inColor) then
resourceName := 'Color Art'
else
resourceName := 'B&W Art';
controlMethod := 3;
CheckItem(GetMenu(mControls), controlMethod, TRUE);
musicOn := TRUE;
airVisible := FALSE;
buttonFires := FALSE;
restoreColor := TRUE;
is4Channel := TRUE;
DefaultControls;
end;
{-----------------}
begin
UseResFile(gliderResNum);
theirPrefs := prefHand(NewHandle(SIZEOF(prefType)));
if (theirPrefs = nil) then
begin
GenericAlert(kErrLoadingPrefs);
Default;
end
else
begin
Handle(theirPrefs) := GetResource('Gprf', 128);
if ((ResError = noErr) and (theirPrefs <> nil)) then
begin
HLock(Handle(theirPrefs));
with theirPrefs^^ do
begin
housesName := houseName;
playerName := theName;
resourceName := resName;
SetSoundVol(sndVolume);
controlMethod := controlIs;
leftKey := leftIs;
rightKey := rightIs;
energyKey := energyIs;
bandKey := bandIs;
musicOn := musicIs;
channel4Is := is4Channel;
airVisible := airVisIs;
buttonFires := buttonIs;
restoreColor := restoreIs;
leftName := leftNameIs;
rightName := rightNameIs;
energyName := energyNameIs;
bandName := bandNameIs;
if (keyBoardIs <> herKeyBoard) then
begin
GenericAlert(kErrNewKeyboard);
DefaultControls;
end;
end;
HUnlock(Handle(theirPrefs));
ReleaseResource(Handle(theirPrefs));
end
else
begin
GenericAlert(kErrLoadingPrefs);
Default;
end;
end;
refNumber := OpenResFile(resourceName); {test to see if res legit}
if (refNumber = -1) then
begin
if (ResError = resFNotFound) then {Hmmm. Maybe color depth has changed}
begin
if (inColor) then
resourceName := 'Color Art' {Try the default color name}
else
resourceName := 'B&W Art'; {Or default B&W file name}
refNumber := OpenResFile(resourceName); {test to see if res legit yet}
if (refNumber = -1) then
begin
UseResFile(gliderResNum); {back to Gilder res file}
GenericAlert(kErrGraphicsNotFound); {bitch about all this}
if (not DoOpen(kArtType)) then
begin
GenericAlert(kErrExitSansGraphics);
ExitToShell;
end;
refNumber := OpenResFile(resourceName);
end;
end
else
begin
UseResFile(gliderResNum); {back to Gilder res file}
GenericAlert(kErrGraphicsNotFound); {bitch about all this}
if (not DoOpen(kArtType)) then
begin
GenericAlert(kErrExitSansGraphics);
ExitToShell;
end;
refNumber := OpenResFile(resourceName);
end;
end;
satisfactory := FALSE; {default to failure}
repeat
UseResFile(refNumber); {make sure we're current}
pictDeep := pictDeepHn(NewHandle(SIZEOF(Integer)));
if (pictDeep = nil) then {prepare for 'deep' resource}
begin
GenericAlert(kErrGraphicLoad);
ExitToShell;
end;
Handle(pictDeep) := GetResource('deep', 128);
if ((ResError = noErr) and (pictDeep <> nil)) then
begin
HLock(Handle(pictDeep));
if (inColor) then
begin
if (pictDeep^^ <> $0004) then {is it a 4-bit color file?}
begin
if (pictDeep <> nil) then
begin
HUnlock(Handle(pictDeep));
ReleaseResource(Handle(pictDeep));
pictDeep := nil;
end;
CloseResFile(refNumber);
if (resourceName <> 'Color Art') then
begin
resourceName := 'Color Art';
refNumber := OpenResFile(resourceName);{lets try this one}
end
else
begin
GenericAlert(kErrGraphicsAre2Bit); {sorry, not 4-bit!}
if (not DoOpen(kArtType)) then {last chance}
begin
GenericAlert(kErrExitSansGraphics); {you blew it - bye!}
ExitToShell;
end;
refNumber := OpenResFile(resourceName);{okay, we'll try this one}
end;
end
else
satisfactory := TRUE;
end {end - inColor}
else {not inColor so...}
begin {were in b&w mode}
if (pictDeep^^ <> $0001) then
begin
if (pictDeep <> nil) then
begin
HUnlock(Handle(pictDeep));
ReleaseResource(Handle(pictDeep));
pictDeep := nil;
end;
CloseResFile(refNumber);
if (resourceName <> 'B&W Art') then
begin
resourceName := 'B&W Art';
refNumber := OpenResFile(resourceName);{lets try this one}
end
else
begin
GenericAlert(kErrGraphicsAre16Bit);
if (not DoOpen(kArtType)) then
begin
GenericAlert(kErrExitSansGraphics);
ExitToShell;
end;
refNumber := OpenResFile(resourceName);
end;
end
else
satisfactory := TRUE;
end;
end {end - if ((ResError = noErr)...}
else {there was an error}
begin
GenericAlert(kErrGraphicLoad);
ExitToShell;
end;
if (pictDeep <> nil) then
begin
HUnlock(Handle(pictDeep));
ReleaseResource(Handle(pictDeep));
pictDeep := nil;
end;
until satisfactory;
CloseResFile(refNumber);
UseResFile(gliderResNum);
GetSoundVol(tempVol);
case tempVol of
0:
SetSoundVol(0);
1, 2:
SetSoundVol(1);
3, 4:
SetSoundVol(3);
5, 6:
SetSoundVol(5);
otherwise
SetSoundVol(7);
end;
if (tempVol = 0) then
soundOn := FALSE
else
soundOn := not inhibitSound;
end;
{------------------------}
procedure LoadPICTs;
var
wasPort: GrafPtr;
thePict: PicHandle;
refNumber: Integer;
tempByte: SignedByte;
begin
refNumber := OpenResFile(resourceName);
if (refNumber = -1) then
begin
UseResFile(gliderResNum);
GenericAlert(kErrGraphicsNotFound);
if (not DoOpen(kArtType)) then
begin
GenericAlert(kErrExitSansGraphics);
ExitToShell;
end;
refNumber := OpenResFile(resourceName);
if (refNumber = -1) then
begin
GenericAlert(kErrGraphicsNotFound);
ExitToShell;
end;
end;
SpinBall;
GetPort(wasPort);
if (inColor) then {load the objects up}
SetPort(GrafPtr(objectCPtr))
else
SetPort(offPlayerPort);
UseResFile(refNumber);
thePict := GetPicture(rObjectPictID);
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
MoveHHi(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, wholeArea);
HSetState(Handle(thePict), tempByte);
end
else
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
ReleaseResource(Handle(thePict));
SpinBall;
SetPort(offMaskPort);
UseResFile(refNumber);
thePict := GetPicture(rMaskPictID); {load the masks up}
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
MoveHHi(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, wholeArea);
HSetState(Handle(thePict), tempByte);
end
else
begin
GenericAlert(kErrNotEnoughMem);
ExitToShell;
end;
ReleaseResource(Handle(thePict));
SetPort(wasPort);
CloseResFile(refNumber);
UseResFile(gliderResNum);
end;
{------------------------}
procedure SetUpMenus;
var
tempMenu: MenuHandle;
i: Integer;
{-------------------}
begin {Init MENU bar}
ClearMenuBar;
tempMenu := GetMenu(mApple);
if (tempMenu <> nil) then
begin
AddResMenu(tempMenu, 'DRVR');
InsertMenu(tempMenu, 0);
end
else
begin
GenericAlert(kErrUnknownAtInit);
ExitToShell;
end;
tempMenu := GetMenu(mGame);
if (tempMenu <> nil) then
begin
InsertMenu(tempMenu, 0);
DisableItem(tempMenu, iEndGame);
DisableItem(tempMenu, iSaveGame);
DisableItem(tempMenu, iSaveGameAs);
{$IFC DemoVersion}
DisableItem(tempMenu, iLoadHouse);
DisableItem(tempMenu, iLoadGame);
{$ENDC}
end
else
begin
GenericAlert(kErrUnknownAtInit);
ExitToShell;
end;
tempMenu := GetMenu(mOption);
if (tempMenu <> nil) then
InsertMenu(tempMenu, 0)
else
begin
GenericAlert(kErrUnknownAtInit);
ExitToShell;
end;
if (hasSys7) then {add a Help menu item}
begin
theErr := HMGetHelpMenuHandle(tempMenu);
if (theErr = noErr) then
if (tempMenu <> nil) then
begin
AppendMenu(tempMenu, 'Glider Help');
iGlidersHelp := CountMItems(tempMenu);
end
else
begin
tempMenu := GetMenu(mOption);
AppendMenu(tempMenu, '(-');
AppendMenu(tempMenu, 'Help');
end
else
begin
tempMenu := GetMenu(mOption);
AppendMenu(tempMenu, '(-');
AppendMenu(tempMenu, 'Help');
end;
end
else
begin
AppendMenu(tempMenu, '(-');
AppendMenu(tempMenu, 'Help');
end;
tempMenu := GetMenu(mControls);
if (tempMenu <> nil) then
InsertMenu(tempMenu, -1)
else
begin
GenericAlert(kErrUnknownAtInit);
ExitToShell;
end;
if (airVisible) then
SetItem(GetMenu(mOption), iShowAir, 'Air is Visible')
else
SetItem(GetMenu(mOption), iShowAir, 'Air is Invisible');
if (restoreColor) then
SetItem(GetMenu(mOption), iRestoreDeep, 'Depth Restore is On')
else
SetItem(GetMenu(mOption), iRestoreDeep, 'Depth Restore is Off');
if ((cantColor) or (cantSwitch)) then
DisableItem(GetMenu(mOption), iRestoreDeep);
CheckItem(GetMenu(mControls), controlMethod, TRUE);
SetPort(GrafPtr(mainWndo));
HideMenuBar;
ShowMenuBar;
end;
{------------------------}
function PrepareSounds: Boolean;
const
lastSound = 28;
var
theSnd: Handle;
i: Integer;
itFailed: Boolean;
begin
itFailed := FALSE;
cantMusic := FALSE;
smsIsActive := FALSE;
ErrorSound(@DoErrorSound);
UseResFile(gliderResNum);
for i := 1 to lastSound do
begin
theSnd := GetResource('SMSD', i);
if ((theSnd <> nil) and (MemError = NoErr)) then
begin
MoveHHi(theSnd);
HLock(theSnd);
end
else
begin
itFailed := TRUE;
inhibitSound := TRUE;
soundOn := FALSE;
Leave;
end;
end;
if (musicOn) then
begin
theSnd := GetResource('SMSD', kDuhDumSound);
if ((theSnd <> nil) and (MemError = NoErr)) then
begin
MoveHHi(theSnd);
HLock(theSnd);
end
else
begin
cantMusic := TRUE;
musicOn := FALSE;
GenericAlert(kErrBackgroundMusic);
end;
theSnd := GetResource('SMSD', kMusicSound);
if ((theSnd <> nil) and (MemError = NoErr)) then
begin
MoveHHi(theSnd);
HLock(theSnd);
end
else
begin
cantMusic := TRUE;
musicOn := FALSE;
GenericAlert(kErrBackgroundMusic);
end;
end;
PrepareSounds := not itFailed;
end;
{------------------------}
procedure InitAllOtherGlobalVars;
var
i, i2: Integer;
begin
doneFlag := FALSE;
playing := FALSE;
pausing := FALSE;
refuseHigh := FALSE;
mainScreenHidden := FALSE;
binaryFlip := 0;
GetDateTime(RandSeed);
scoreList.rank := 20;
for i := 0 to 7 do
begin
SpinBall;
SetRect(tileRects[i], i * 64, 0, (i + 1) * 64, 342);
end;
SetRect(shadoRct[0], 256, 0, 304, 11);
SetRect(shadoRct[1], 256, 12, 304, 23);
SetRect(glideRct[0], 0, 0, 48, 20); {right forward}
SetRect(glideRct[1], 0, 21, 48, 41); {right tipped}
SetRect(glideRct[2], 0, 42, 48, 62); {left forward}
SetRect(glideRct[3], 0, 63, 48, 83); {left tipped}
SetRect(glideRct[4], 208, 0, 256, 20); {turn endpoint}
SetRect(glideRct[5], 208, 21, 256, 41); { " }
SetRect(glideRct[6], 208, 42, 256, 62); { " }
SetRect(glideRct[7], 208, 63, 256, 83); { " }
SetRect(glideRct[8], 208, 84, 256, 104); { " }
SetRect(glideRct[9], 208, 105, 256, 125); {turn endpoint}
SetRect(glideRct[10], 414, 53, 462, 73); {glider fading masks right}
SetRect(glideRct[11], 414, 74, 462, 94);
SetRect(glideRct[12], 414, 95, 462, 115);
SetRect(glideRct[13], 414, 116, 462, 136);
SetRect(glideRct[14], 414, 137, 462, 157);
SetRect(glideRct[15], 414, 158, 462, 178);
SetRect(glideRct[16], 414, 179, 462, 199);
SetRect(glideRct[17], 463, 53, 511, 73); {glider fading masks left}
SetRect(glideRct[18], 463, 74, 511, 94);
SetRect(glideRct[19], 463, 95, 511, 115);
SetRect(glideRct[20], 463, 116, 511, 136);
SetRect(glideRct[21], 463, 137, 511, 157);
SetRect(glideRct[22], 463, 158, 511, 178);
SetRect(glideRct[23], 463, 179, 511, 199);
SetRect(glideRct[24], 256, 24, 304, 60); {burning}
SetRect(glideRct[25], 256, 61, 304, 97);
SetRect(glideRct[26], 256, 98, 304, 134);
SetRect(glideRct[27], 256, 135, 304, 171);
for i2 := 0 to 3 do {column}
for i := 0 to 3 do {row}
SetRect(reserveRects[i2 * 4 + i + 1], i * 48, i2 * 29, 1 * 48 + 48, i2 * 29 + 29);
SpinBall;
nextPhase[1, 0] := 10;
nextPhase[1, 1] := 11;
nextPhase[1, 2] := 10;
nextPhase[1, 3] := 11;
nextPhase[1, 4] := 12;
nextPhase[1, 5] := 11;
nextPhase[1, 6] := 12;
nextPhase[1, 7] := 13;
nextPhase[1, 8] := 12;
nextPhase[1, 9] := 13;
nextPhase[1, 10] := 14;
nextPhase[1, 11] := 13;
nextPhase[1, 12] := 14;
nextPhase[1, 13] := 15;
nextPhase[1, 14] := 14;
nextPhase[1, 15] := 15;
nextPhase[1, 16] := 16;
nextPhase[2, 0] := 16;
nextPhase[2, 1] := 15;
nextPhase[2, 2] := 16;
nextPhase[2, 3] := 15;
nextPhase[2, 4] := 14;
nextPhase[2, 5] := 15;
nextPhase[2, 6] := 14;
nextPhase[2, 7] := 13;
nextPhase[2, 8] := 14;
nextPhase[2, 9] := 13;
nextPhase[2, 10] := 12;
nextPhase[2, 11] := 13;
nextPhase[2, 12] := 12;
nextPhase[2, 13] := 11;
nextPhase[2, 14] := 12;
nextPhase[2, 15] := 11;
nextPhase[2, 16] := 10;
nextPhase[3, 0] := 4;
nextPhase[3, 1] := 4;
nextPhase[3, 2] := 5;
nextPhase[3, 3] := 5;
nextPhase[3, 4] := 6;
nextPhase[3, 5] := 6;
nextPhase[3, 6] := 7;
nextPhase[3, 7] := 7;
nextPhase[3, 8] := 8;
nextPhase[3, 9] := 8;
nextPhase[3, 10] := 9;
nextPhase[3, 11] := 9;
nextPhase[4, 0] := 9;
nextPhase[4, 1] := 9;
nextPhase[4, 2] := 8;
nextPhase[4, 3] := 8;
nextPhase[4, 4] := 7;
nextPhase[4, 5] := 7;
nextPhase[4, 6] := 6;
nextPhase[4, 7] := 6;
nextPhase[4, 8] := 5;
nextPhase[4, 9] := 5;
nextPhase[4, 10] := 4;
nextPhase[4, 11] := 4;
SpinBall;
SetRect(srcRect[celVnt], 0, 84, 48, 96);
SetRect(srcRect[celDct], 0, 97, 48, 110);
SetRect(srcRect[flrVnt], 0, 111, 48, 124);
SetRect(srcRect[paper], 0, 125, 48, 146);
SetRect(srcRect[toastr], 0, 147, 38, 174);
SetRect(srcRect[60], 304, 84, 336, 115); {toast 1}
SetRect(srcRect[61], 304, 116, 336, 147); {toast 2}
SetRect(srcRect[62], 304, 148, 336, 179); {toast 3}
SetRect(srcRect[63], 304, 180, 336, 211); {toast 4}
SetRect(srcRect[64], 304, 212, 336, 243); {toast 5}
SetRect(srcRect[65], 304, 244, 336, 275); {toast 6}
SetRect(srcRect[teaKtl], 0, 175, 41, 205);
SetRect(srcRect[lftFan], 0, 206, 35, 261);
SetRect(srcRect[ritFan], 0, 262, 35, 316);
SetRect(srcRect[table], 48, 23, 112, 45);
SetRect(srcRect[shredr], 48, 46, 112, 70);
SetRect(srcRect[books], 48, 71, 112, 126);
SetRect(srcRect[clock], 112, 0, 144, 29);
SetRect(srcRect[candle], 112, 30, 144, 51);
SetRect(srcRect[rbrBnd], 112, 52, 144, 75);
SetRect(srcRect[ball], 112, 76, 144, 108);
SetRect(srcRect[fshBwl], 112, 109, 144, 138);
SetRect(srcRect[66], 144, 109, 160, 125); {fish 1}
SetRect(srcRect[67], 144, 126, 160, 142); {fish 2}
SetRect(srcRect[68], 144, 143, 160, 159); {fish 3}
SetRect(srcRect[69], 144, 160, 160, 176); {fish 4}
SetRect(srcRect[grease], 112, 139, 144, 168);
SetRect(srcRect[58], 112, 169, 144, 198); {grease falling 1}
SetRect(srcRect[59], 112, 199, 144, 228); {grease fallen}
SetRect(srcRect[litSwt], 142, 0, 160, 26);
SetRect(srcRect[thermo], 144, 27, 162, 54);
SetRect(srcRect[outlet], 160, 264, 192, 289);
SetRect(srcRect[51], 160, 290, 192, 315); {outlet sparking 1}
SetRect(srcRect[52], 160, 316, 192, 341); {outlet sparking 2}
SetRect(srcRect[pwrSwt], 144, 82, 162, 108);
SetRect(srcRect[guitar], 48, 127, 112, 297);
SetRect(srcRect[drip], 192, 42, 208, 55);
SetRect(srcRect[shelf], 192, 71, 208, 100);
SetRect(srcRect[basket], 448, 270, 511, 341);
SetRect(srcRect[paintg], 408, 53, 510, 146);
SetRect(srcRect[battry], 144, 55, 160, 81);
SetRect(srcRect[macTsh], 256, 209, 301, 267);
SetRect(srcRect[upStar], 0, 0, 161, 254);
SetRect(srcRect[dnStar], 0, 0, 161, 254);
SetRect(srcRect[48], 144, 189, 160, 201); {candle flame}
SetRect(srcRect[49], 144, 202, 160, 214); {candle flame}
SetRect(srcRect[50], 144, 215, 160, 227); {candle flame}
SetRect(srcRect[53], 192, 0, 208, 13); {drip}
SetRect(srcRect[54], 192, 14, 208, 27); {drip}
SetRect(srcRect[55], 192, 28, 208, 41); {drip}
SetRect(srcRect[56], 192, 42, 208, 55); {drip}
SetRect(srcRect[57], 192, 56, 208, 70); {drip}
SpinBall;
SetRect(animateRct[0, -1], 304, 0, 368, 22); {crushed dart}
SetRect(animateRct[0, 0], 48, 0, 112, 22); {dart...}
SetRect(animateRct[0, 1], 48, 0, 112, 22);
SetRect(animateRct[0, 2], 48, 0, 112, 22);
SetRect(animateRct[0, 3], 48, 0, 112, 22);
SetRect(animateRct[0, 4], 48, 0, 112, 22);
SetRect(animateRct[0, 5], 48, 0, 112, 22);
SetRect(animateRct[0, 6], 48, 0, 112, 22);
SetRect(animateRct[0, 7], 48, 0, 112, 22);
SetRect(animateRct[1, -1], 304, 276, 336, 308); {crushed 'copter}
SetRect(animateRct[1, 0], 160, 0, 192, 32); {'copter...}
SetRect(animateRct[1, 1], 160, 33, 192, 65);
SetRect(animateRct[1, 2], 160, 66, 192, 98);
SetRect(animateRct[1, 3], 160, 99, 192, 131);
SetRect(animateRct[1, 4], 160, 132, 192, 164);
SetRect(animateRct[1, 5], 160, 165, 192, 197);
SetRect(animateRct[1, 6], 160, 198, 192, 230);
SetRect(animateRct[1, 7], 160, 231, 192, 263);
SetRect(animateRct[2, -1], 304, 309, 336, 341); {popped balloon}
SetRect(animateRct[2, 0], 112, 229, 144, 261); {balloon...}
SetRect(animateRct[2, 1], 112, 229, 144, 261);
SetRect(animateRct[2, 2], 112, 262, 144, 294);
SetRect(animateRct[2, 3], 112, 262, 144, 294);
SetRect(animateRct[2, 4], 112, 295, 144, 327);
SetRect(animateRct[2, 5], 112, 295, 144, 327);
SetRect(animateRct[2, 6], 112, 262, 144, 294);
SetRect(animateRct[2, 7], 112, 262, 144, 294);
SetRect(bandRct[0], 192, 155, 208, 162);
SetRect(bandRct[1], 192, 163, 208, 170);
SetRect(bandRct[2], 192, 171, 208, 178);
end;
{------------------------}
begin
InitToolbox;
CheckOurEnvirons;
LoadCursors;
for i := 0 to 32 do
SpinBall;
InitGlobalRects;
for i := 0 to 32 do
SpinBall;
if (inColor) then
SetUpColors;
for i := 0 to 32 do
SpinBall;
SetUpMainWndo;
for i := 0 to 32 do
SpinBall;
if (inColor) then
SetUpPixMaps
else
SetUpBitMaps;
for i := 0 to 32 do
SpinBall;
SetUpOffMask;
for i := 0 to 32 do
SpinBall;
GetSoundVol(wasSndVolume);
for i := 0 to 32 do
SpinBall;
theErr := GetVol(@ignoreStr, houseVolNum);
for i := 0 to 32 do
SpinBall;
GetPrefs;
for i := 0 to 32 do
SpinBall;
if (not GetHouse) then
begin
GenericAlert(kErrLoadingDfltHouse);
ExitToShell;
end;
defaultHouse := housesName;
for i := 0 to 32 do
SpinBall;
LoadPICTs;
for i := 0 to 32 do
SpinBall;
SetUpMenus;
for i := 0 to 32 do
SpinBall;
if (not PrepareSounds) then
GenericAlert(kErrNoSounds);
if (inhibitSound) then
DisableItem(GetMenu(mOption), iSound);
for i := 0 to 32 do
SpinBall;
InitAllOtherGlobalVars;
InitCursor;
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
GetAppFiles(1, docInfo);
with docInfo do
begin
if (fType = 'GLgm') then
begin
{$IFC DemoVersion}
GenericAlert(kErrDemoRefuseHouse);
{$ELSEC}
gameName := fName;
gameVolNum := vRefNum;
if (not GetGame) then
begin
Exit(DoStartUp);
end;
EnableItem(GetMenu(mGame), iSaveGame);
{$ENDC}
end {if fType = 'GLgm'}
else {if fType <> 'GLgm'}
if (fType = 'GLhs') then
begin
{$IFC DemoVersion}
GenericAlert(kErrDemoRefuseHouse);
{$ELSEC}
houseVolNum := vRefNum;
housesName := fName;
demoMode := Randomize(lastDemo) + 1;
HideMenuBar;
StartNewGame;
{$ENDC}
end
else
GenericAlert(kErrStartUpWrongType);
ClrAppFiles(1);
end; {with docInfo do}
end; {if (numDocs <> 0) then}
end;
{=================================}
end.