Glider4/Glider_405/Sources/G-PlayUtils.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
62 KiB
OpenEdge ABL
Executable File

unit PlayUtils;
interface
uses
Palettes, Globals, SMS, GlobalUtils, FileInNOut;
procedure ForceMainToVisible;
procedure LoadABackground (whichID: Integer);
procedure ArrangeTiles;
procedure DrawAllObjects;
procedure BumpTheScore;
procedure StartScoreRolling;
procedure UpdateBandNumbers;
procedure PopTokenBand;
procedure UpdateBatteryEnergy;
procedure PopTokenBattery;
procedure DrawHeadline;
procedure ResetGlider;
procedure ResetAnimate (typeIs, index: Integer);
procedure ExtractEventRects;
procedure ReadyRoom;
procedure SortHiScores;
function DoQuit: Boolean;
implementation
{=================================}
procedure ForceMainToVisible;
begin
if ((areFlipping) and (mainScreenHidden)) then
begin
CopyBits(offLoadMap, mainWndo^.portBits, wholeArea, wholeArea, srcCopy, nil);
mainScreenHidden := FALSE;
SetPage(mainScreenHidden);
CopyBits(offVirginMap, offLoadMap, wholeArea, wholeArea, srcCopy, nil);
end;
end;
{=================================}
procedure ArrangeTiles;
var
wasPort: GrafPtr;
i, panel: Integer;
begin
for i := 0 to 7 do
begin
panel := thisHouse.theRooms[roomAt].tileOrder[i];
if (inColor) then
CopyBits(BitMapPtr(loadCPtr^.portPixMap^)^, BitMapPtr(virginCPtr^.portPixMap^)^, tileRects[panel], tileRects[i], srcCopy, nil)
else
CopyBits(offLoadMap, offVirginMap, tileRects[panel], tileRects[i], srcCopy, nil);
end;
if (inColor) then
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, BitMapPtr(loadCPtr^.portPixMap^)^, wholeArea, wholeArea, srcCopy, nil)
else
CopyBits(offVirginMap, offLoadMap, wholeArea, wholeArea, srcCopy, nil);
end;
{=================================}
procedure LoadABackground;
var
refNumber: Integer;
tempByte: SignedByte;
thePict: PicHandle;
wasPort: GrafPtr;
begin
refNumber := OpenResFile(resourceName);
if (refNumber = -1) then
begin
UseResFile(gliderResNum);
GenericAlert(kErrGraphicsNotFound);
if (not DoOpen(kArtType)) then
begin
ShowMenuBar;
Exit(LoadABackground);
end;
refNumber := OpenResFile(resourceName);
if (refNumber = -1) then
begin
GenericAlert(kErrGraphicsNotFound);
ShowMenuBar;
playing := FALSE;
Exit(LoadABackground);
end;
end;
if (areFlipping) then
ForceMainToVisible;
GetPort(wasPort);
if (inColor) then
SetPort(GrafPtr(loadCPtr))
else
SetPort(offLoadPort);
thePict := GetPicture(whichID);
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, wholeArea);
HSetState(Handle(thePict), tempByte);
end
else
begin
case whichID of {try to substitute}
205:
thePict := GetPicture(201);
206:
thePict := GetPicture(204);
207:
thePict := GetPicture(200);
208:
thePict := GetPicture(203);
209:
thePict := GetPicture(200);
otherwise
begin
GenericAlert(kErrGraphicLoad);
ShowMenuBar;
playing := FALSE;
Exit(LoadABackground);
end;
end;
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, wholeArea);
HSetState(Handle(thePict), tempByte);
end
else
begin
GenericAlert(kErrGraphicLoad);
ShowMenuBar;
playing := FALSE;
Exit(LoadABackground);
end;
end;
ReleaseResource(Handle(thePict));
SetPort(wasPort);
CloseResFile(refNumber);
UseResFile(gliderResNum);
end;
{=================================}
procedure FillNFrame (theColor: RGBColor; theRect: Rect);
begin
RGBForeColor(theColor);
PaintRect(theRect);
RGBForeColor(rgbBlack);
FrameRect(theRect);
end;
{=================================}
procedure GrayNFrame (theRect: Rect);
begin
FillRect(theRect, gray);
FrameRect(theRect);
end;
{=================================}
procedure HiLiteARect (theColor: RGBColor; theRect: Rect);
begin
RGBForeColor(theColor);
MoveTo(theRect.left + 1, theRect.top + 1);
LineTo(theRect.right - 2, theRect.top + 1);
LineTo(theRect.right - 2, theRect.bottom - 2);
RGBForeColor(rgbBlack);
end;
{=================================}
procedure GrayLiteARect (theRect: Rect);
begin
PenPat(white);
MoveTo(theRect.left + 1, theRect.top + 1);
LineTo(theRect.right - 2, theRect.top + 1);
LineTo(theRect.right - 2, theRect.bottom - 2);
PenNormal;
MoveTo(theRect.left + 1, theRect.top + 1);
LineTo(theRect.left + 1, theRect.bottom - 2);
LineTo(theRect.right - 2, theRect.bottom - 2);
end;
{=================================}
procedure LoLiteARect (theRect: Rect);
begin
RGBForeColor(rgbLtBrown);
MoveTo(theRect.left - 1, theRect.top);
LineTo(theRect.left - 1, theRect.bottom);
LineTo(theRect.right - 1, theRect.bottom);
RGBForeColor(rgbDkGray);
MoveTo(theRect.left, theRect.top - 1);
LineTo(theRect.right, theRect.top - 1);
LineTo(theRect.right, theRect.bottom);
RGBForeColor(rgbBlack);
end;
{=================================}
procedure GrayLoARect (theRect: Rect);
begin
PenPat(white);
MoveTo(theRect.left - 1, theRect.top);
LineTo(theRect.left - 1, theRect.bottom);
LineTo(theRect.right - 1, theRect.bottom);
PenNormal;
MoveTo(theRect.left, theRect.top - 1);
LineTo(theRect.right, theRect.top - 1);
LineTo(theRect.right, theRect.bottom);
end;
{=================================}
procedure DrawTable (whichItem: Integer);
var
kind: Integer;
theRect, tempRect: Rect;
wasPort: GrafPtr;
begin
GetPort(wasPort);
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
PenNormal;
with thisHouse.theRooms[roomAt].theObjects[whichItem] do
begin
kind := objectIs;
theRect := boundRect;
end;
if (inColor) then {***** Draw table top}
begin
RGBForeColor(rgbBrown);
PaintRect(theRect);
RGBForeColor(rgbBlack);
FrameRect(theRect);
MoveTo(theRect.left + 1, theRect.bottom - 2);
LineTo(theRect.right - 1, theRect.bottom - 2);
RGBForeColor(rgbLtBrown);
MoveTo(theRect.left + 1, theRect.top + 1);
LineTo(theRect.right - 2, theRect.top + 1);
RGBForeColor(rgbBlack);
end
else
begin
FillRect(theRect, gray);
FrameRect(theRect);
MoveTo(theRect.left + 1, theRect.bottom - 2);
LineTo(theRect.right - 1, theRect.bottom - 2);
PenPat(white);
MoveTo(theRect.left + 1, theRect.top + 1);
LineTo(theRect.right - 2, theRect.top + 1);
end;
PenNormal; {***** Draw table shadow}
SetRect(tempRect, theRect.left, kFloorVert - 0, theRect.right, kFloorVert + 20);
OffsetRect(tempRect, (theRect.top - kFloorVert) div 5, 0);
if (inColor) then
begin
PenMode(patCopy + transparent);
PenPat(gray);
PaintOval(tempRect);
end
else
begin
PenMode(patOr);
PenPat(gray);
PaintOval(tempRect);
end;
PenNormal;
if (inColor) then {***** Draw table support}
begin
RGBForeColor(rgbBlack);
PenSize(5, 1);
MoveTo(((theRect.left + theRect.right) div 2) - 2, theRect.bottom);
LineTo(((theRect.left + theRect.right) div 2) - 2, kFloorVert - 7);
RGBForeColor(rgbWhite);
PenSize(1, 1);
MoveTo(((theRect.left + theRect.right) div 2) + 1, theRect.bottom + (theRect.right - theRect.left) div 8);
LineTo(((theRect.left + theRect.right) div 2) + 1, kFloorVert - 7);
RGBForeColor(rgbLtBrown);
MoveTo(((theRect.left + theRect.right) div 2) + 0, theRect.bottom + (theRect.right - theRect.left) div 8);
LineTo(((theRect.left + theRect.right) div 2) + 0, kFloorVert - 7);
RGBForeColor(rgbBlack);
end
else
begin
PenSize(5, 1);
MoveTo(((theRect.left + theRect.right) div 2) - 2, theRect.bottom);
LineTo(((theRect.left + theRect.right) div 2) - 2, kFloorVert - 7);
PenPat(white);
PenSize(1, 1);
MoveTo(((theRect.left + theRect.right) div 2) + 1, theRect.bottom + (theRect.right - theRect.left) div 8);
LineTo(((theRect.left + theRect.right) div 2) + 1, kFloorVert - 7);
PenPat(gray);
MoveTo(((theRect.left + theRect.right) div 2) + 0, theRect.bottom + (theRect.right - theRect.left) div 8);
LineTo(((theRect.left + theRect.right) div 2) + 0, kFloorVert - 7);
end;
PenNormal;
tempRect := srcRect[kind];{***** Draw table base}
OffsetRect(tempRect, -tempRect.left, -tempRect.top);
OffsetRect(tempRect, ((theRect.left + theRect.right) div 2) - 31, kFloorVert - 7);
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, srcRect[kind], srcRect[kind], tempRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, srcRect[kind], srcRect[kind], tempRect);
SetPort(wasPort);
end;
{=================================}
procedure DrawShelf (whichItem: Integer);
var
kind: Integer;
theRect, tempRect: Rect;
tempRgn: RgnHandle;
wasPort: GrafPtr;
begin
GetPort(wasPort);
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
PenNormal;
with thisHouse.theRooms[roomAt].theObjects[whichItem] do
begin
kind := objectIs;
theRect := boundRect;
end;
if (inColor) then {***** Draw shelf top}
begin
RGBForeColor(rgbLtBrown);
PaintRect(theRect);
FrameRect(theRect);
MoveTo(theRect.left + 1, theRect.bottom - 2);
LineTo(theRect.right - 1, theRect.bottom - 2);
RGBForeColor(rgbWhite);
MoveTo(theRect.left + 1, theRect.top + 1);
LineTo(theRect.right - 2, theRect.top + 1);
end
else
begin
FillRect(theRect, gray);
FrameRect(theRect);
MoveTo(theRect.left + 1, theRect.bottom - 2);
LineTo(theRect.right - 1, theRect.bottom - 2);
PenPat(white);
MoveTo(theRect.left + 1, theRect.top + 1);
LineTo(theRect.right - 2, theRect.top + 1);
end;
PenNormal;
tempRgn := NewRgn; {***** Draw shelf shadow}
MoveTo(theRect.right, theRect.bottom - 1);
OpenRgn;
Line(-15, 15);
LineTo(theRect.left - 15, theRect.bottom + 14);
Line(0, -5);
Line(15, -15);
Line(0, 5);
LineTo(theRect.right, theRect.bottom - 1);
CloseRgn(tempRgn);
PenPat(gray);
if (inColor) then
begin
RGBForeColor(rgbBlack);
PenMode(patCopy + transparent);
PenPat(gray);
PaintRgn(tempRgn);
end
else
begin
PenMode(patOr);
PaintRgn(tempRgn);
end;
DisposeRgn(tempRgn);
PenNormal;
tempRect := srcRect[kind]; {***** Draw shelf bracket 1}
OffsetRect(tempRect, -tempRect.left, -tempRect.top); {0 it out}
OffsetRect(tempRect, theRect.left + 15, theRect.bottom - 2);
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, srcRect[kind], srcRect[kind], tempRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, srcRect[kind], srcRect[kind], tempRect);
tempRect := srcRect[kind]; {***** Draw shelf bracket 2}
OffsetRect(tempRect, -tempRect.left, -tempRect.top); {0 it out}
OffsetRect(tempRect, theRect.right - 25, theRect.bottom - 2);
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, srcRect[kind], srcRect[kind], tempRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, srcRect[kind], srcRect[kind], tempRect);
SetPort(wasPort);
end;
{=================================}
procedure DrawMirror (whichItem: Integer);
var
theRect: Rect;
wasPort: GrafPtr;
begin
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
PenNormal;
with thisHouse.theRooms[roomAt].theObjects[whichItem] do
theRect := boundRect;
if (inColor) then
begin
RGBForeColor(rgbBrown);
PaintRect(theRect);
RGBForeColor(rgbBlack);
end
else
begin
FillRect(theRect, gray);
end;
FrameRect(theRect);
InsetRect(theRect, 3, 3);
FillRect(theRect, white);
FrameRect(theRect);
PenNormal;
end;
{=================================}
procedure DrawCabinet (whichItem: Integer);
var
panels, width, index, offIt: Integer;
theRect, tempR: Rect;
shadoRgn: RgnHandle;
begin
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
PenNormal;
with thisHouse.theRooms[roomAt].theObjects[whichItem] do
theRect := boundRect;
tempR := theRect;
if (theRect.bottom > 280) then
begin
tempR.bottom := tempR.bottom - 5;
if (inColor) then
begin
RGBForeColor(rgbBrown);
PenMode(srcCopy + transparent);
PaintRect(tempR);
RGBForeColor(rgbBlack);
end
else
begin
FillRect(tempR, gray);
end;
FrameRect(tempR);
tempR := theRect;
InsetRect(tempR, 2, 0);
tempR.top := tempR.bottom - 5;
if (inColor) then
PaintRect(tempR)
else
FillRect(tempR, dkGray);
FrameRect(tempR);
SetRect(tempR, theRect.left - 2, theRect.top, theRect.right + 2, theRect.top + 7);
if (inColor) then
begin
RGBForeColor(rgbLtBrown);
PenMode(srcCopy + transparent);
PaintRect(tempR);
RGBForeColor(rgbBlack);
end
else
begin
FillRect(tempR, ltGray);
end;
FrameRect(tempR);
MoveTo(tempR.left + 2, tempR.bottom);
LineTo(tempR.right - 3, tempR.bottom);
shadoRgn := NewRgn;
MoveTo(theRect.left, theRect.top + 5);
OpenRgn;
Line(-15, 15);
LineTo(theRect.left - 15, theRect.bottom - 10);
LineTo(theRect.left, theRect.bottom);
LineTo(theRect.left, theRect.top + 5);
CloseRgn(shadoRgn);
HLock(Handle(shadoRgn));
if (inColor) then
begin
RGBForeColor(rgbBlack);
PenMode(patCopy + transparent);
PenPat(gray);
PaintRgn(shadoRgn);
end
else
begin
PenMode(patOr);
PenPat(gray);
PaintRgn(shadoRgn);
end;
HUnlock(Handle(shadoRgn));
DisposeRgn(shadoRgn);
PenNormal;
offIt := 5;
end
else
begin
if (inColor) then
begin
RGBForeColor(rgbBrown);
PenMode(srcCopy + transparent);
PaintRect(theRect);
RGBForeColor(rgbBlack);
end
else
begin
FillRect(theRect, gray);
end;
FrameRect(theRect);
shadoRgn := NewRgn;
MoveTo(theRect.left, theRect.top);
OpenRgn;
Line(-15, 15);
LineTo(theRect.left - 15, theRect.bottom + 15);
LineTo(theRect.right - 15, theRect.bottom + 15);
Line(15, -15);
LineTo(theRect.left, theRect.bottom);
LineTo(theRect.left, theRect.top);
CloseRgn(shadoRgn);
HLock(Handle(shadoRgn));
if (inColor) then
begin
PenMode(srcCopy + transparent);
PenPat(gray);
PaintRgn(shadoRgn);
end
else
begin
PenMode(patOr);
PenPat(gray);
PaintRgn(shadoRgn);
end;
HUnlock(Handle(shadoRgn));
DisposeRgn(shadoRgn);
PenNormal;
offIt := 0;
end;
panels := (theRect.right - theRect.left) div 48;
if (panels = 0) then
begin
tempR := theRect;
InsetRect(tempR, 5, 5 + offIt);
FrameRect(tempR);
if (inColor) then
begin
RGBForeColor(rgbLtBrown);
MoveTo(tempR.left + 3, tempR.top + 3);
LineTo(tempR.left + 3, tempR.bottom - 4);
LineTo(tempR.right - 4, tempR.bottom - 4);
RGBForeColor(rgbBlack);
LineTo(tempR.right - 4, tempR.top + 3);
LineTo(tempR.left + 3, tempR.top + 3);
end
else
begin
PenPat(white);
MoveTo(tempR.left + 3, tempR.top + 3);
LineTo(tempR.left + 3, tempR.bottom - 4);
LineTo(tempR.right - 4, tempR.bottom - 4);
PenPat(black);
LineTo(tempR.right - 4, tempR.top + 3);
LineTo(tempR.left + 3, tempR.top + 3);
end;
end
else
begin
width := ((theRect.right - theRect.left) - (panels + 1) * 5) div panels;
SetRect(tempR, theRect.left + 5, theRect.top + 5 + offIt, theRect.left + 5 + width, theRect.bottom - 5 - offIt);
for index := 1 to panels do
begin
if (inColor) then
begin
RGBForeColor(rgbLtBrown);
MoveTo(tempR.left + 3, tempR.top + 3);
LineTo(tempR.left + 3, tempR.bottom - 4);
LineTo(tempR.right - 4, tempR.bottom - 4);
RGBForeColor(rgbBlack);
LineTo(tempR.right - 4, tempR.top + 3);
LineTo(tempR.left + 3, tempR.top + 3);
end
else
begin
FrameRect(tempR);
PenPat(white);
MoveTo(tempR.left + 3, tempR.top + 3);
LineTo(tempR.left + 3, tempR.bottom - 4);
LineTo(tempR.right - 4, tempR.bottom - 4);
PenPat(black);
LineTo(tempR.right - 4, tempR.top + 3);
LineTo(tempR.left + 3, tempR.top + 3);
end;
OffsetRect(tempR, width + 5, 0);
end;
end;
PenNormal;
end;
{=================================}
procedure DrawWindow (whichItem: Integer);
var
theRect, tempRect: Rect;
kind: Integer;
tempRgn: RgnHandle;
windowOpen: Boolean;
begin
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
PenNormal;
with thisHouse.theRooms[roomAt].theObjects[whichItem] do
begin
kind := objectIs;
theRect := boundRect;
windowOpen := isOn;
end;
tempRgn := NewRgn; {***** Draw window shadow}
MoveTo(theRect.left, theRect.top);
OpenRgn;
Line(-10, 10);
Line(0, 5);
Line(5, 5);
LineTo(theRect.left - 5, theRect.bottom - 10);
Line(-5, 5);
Line(0, 5);
Line(5, 5);
LineTo(theRect.right - 5, theRect.bottom + 5);
LineTo(theRect.right, theRect.bottom);
LineTo(theRect.left, theRect.bottom);
LineTo(theRect.left, theRect.top);
CloseRgn(tempRgn);
PenPat(gray);
if (inColor) then
begin
RGBForeColor(rgbBlack);
PenMode(patCopy + transparent);
PenPat(gray);
PaintRgn(tempRgn);
end
else
begin
PenMode(patOr);
PaintRgn(tempRgn);
end;
DisposeRgn(tempRgn);
PenNormal;
if (inColor) then
begin
FillNFrame(rgbBrown, theRect); {***** Draw window frame and sill}
HiLiteARect(rgbLtBrown, theRect);
SetRect(tempRect, theRect.left - 4, theRect.top, theRect.right + 4, theRect.top + 6);
FillNFrame(rgbBrown, tempRect);
HiLiteARect(rgbLtBrown, tempRect);
SetRect(tempRect, theRect.left - 2, theRect.top + 6, theRect.right + 2, theRect.top + 10);
FillNFrame(rgbBrown, tempRect);
SetRect(tempRect, theRect.left - 4, theRect.bottom - 6, theRect.right + 4, theRect.bottom);
FillNFrame(rgbBrown, tempRect);
HiLiteARect(rgbLtBrown, tempRect);
SetRect(tempRect, theRect.left - 2, theRect.bottom - 10, theRect.right + 2, theRect.bottom - 5);
FillNFrame(rgbBrown, tempRect);
HiLiteARect(rgbLtBrown, tempRect);
tempRect := theRect;
InsetRect(tempRect, 8, 16);
FillNFrame(rgbBrown, tempRect);
LoLiteARect(tempRect);
tempRect := theRect; {***** Draw the top window pane}
InsetRect(tempRect, 8, 16);
tempRect.bottom := ((theRect.bottom + theRect.top) div 2) + 2;
FillNFrame(rgbBrown, tempRect);
InsetRect(tempRect, 6, 6);
LoLiteARect(tempRect);
InsetRect(tempRect, 2, 2);
LoLiteARect(tempRect);
InsetRect(tempRect, 2, 2);
FillNFrame(rgbBlack, tempRect);
LoLiteARect(tempRect);
tempRect := theRect; {Fill bottom black}
InsetRect(tempRect, 8, 16);
tempRect.top := ((theRect.bottom + theRect.top) div 2) + 2;
FillRect(tempRect, black);
tempRect := theRect; {***** Draw the bottom window pane}
InsetRect(tempRect, 8, 16);
tempRect.top := ((theRect.bottom + theRect.top) div 2) - 2;
if (windowOpen) then
OffsetRect(tempRect, 0, 26 - ((theRect.bottom - theRect.top) div 2));
FillNFrame(rgbBrown, tempRect);
InsetRect(tempRect, 6, 6);
LoLiteARect(tempRect);
InsetRect(tempRect, 2, 2);
LoLiteARect(tempRect);
InsetRect(tempRect, 2, 2);
FillNFrame(rgbBlack, tempRect);
LoLiteARect(tempRect);
RGBForeColor(rgbBlack);
end
else
begin
GrayNFrame(theRect); {***** Draw window frame and sill}
GrayLiteARect(theRect);
SetRect(tempRect, theRect.left - 4, theRect.top, theRect.right + 4, theRect.top + 6);
GrayNFrame(tempRect);
GrayLiteARect(tempRect);
SetRect(tempRect, theRect.left - 2, theRect.top + 6, theRect.right + 2, theRect.top + 10);
GrayNFrame(tempRect);
SetRect(tempRect, theRect.left - 4, theRect.bottom - 6, theRect.right + 4, theRect.bottom);
GrayNFrame(tempRect);
GrayLiteARect(tempRect);
SetRect(tempRect, theRect.left - 2, theRect.bottom - 10, theRect.right + 2, theRect.bottom - 5);
GrayNFrame(tempRect);
GrayLiteARect(tempRect);
tempRect := theRect;
InsetRect(tempRect, 8, 16);
GrayNFrame(tempRect);
GrayLoARect(tempRect);
tempRect := theRect; {***** Draw the top window pane}
InsetRect(tempRect, 8, 16);
tempRect.bottom := ((theRect.bottom + theRect.top) div 2) + 2;
GrayNFrame(tempRect);
InsetRect(tempRect, 6, 6);
GrayLoARect(tempRect);
InsetRect(tempRect, 2, 2);
GrayLoARect(tempRect);
InsetRect(tempRect, 2, 2);
FillRect(tempRect, black);
GrayLoARect(tempRect);
tempRect := theRect; {Fill bottom black}
InsetRect(tempRect, 8, 16);
tempRect.top := ((theRect.bottom + theRect.top) div 2) + 2;
FillRect(tempRect, black);
tempRect := theRect; {***** Draw the bottom window pane}
InsetRect(tempRect, 8, 16);
tempRect.top := ((theRect.bottom + theRect.top) div 2) - 2;
if (windowOpen) then
OffsetRect(tempRect, 0, 26 - ((theRect.bottom - theRect.top) div 2));
GrayNFrame(tempRect);
InsetRect(tempRect, 6, 6);
GrayLoARect(tempRect);
InsetRect(tempRect, 2, 2);
GrayLoARect(tempRect);
InsetRect(tempRect, 2, 2);
FillRect(tempRect, black);
GrayLoARect(tempRect);
end;
end;
{=================================}
procedure DrawStair (whichItem: Integer);
var
refNumber, kind: Integer;
tempByte: SignedByte;
theRect: Rect;
thePict: PicHandle;
begin
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
with thisHouse.theRooms[roomAt].theObjects[whichItem] do
begin
kind := objectIs;
theRect := boundRect;
end;
refNumber := OpenResFile(resourceName);
if (refNumber = -1) then
begin
CloseResFile(refNumber);
UseResFile(gliderResNum);
GenericAlert(kErrGraphicsNotFound);
Exit(DrawStair);
end;
if (kind = upStar) then
thePict := GetPicture(198)
else
thePict := GetPicture(199);
if (thePict <> nil) then
begin
tempByte := HGetState(Handle(thePict));
HLock(Handle(thePict));
DrawPicture(thePict, theRect);
HSetState(Handle(thePict), tempByte);
end
else
begin
GenericAlert(kErrGraphicLoad);
end;
ReleaseResource(Handle(thePict));
CloseResFile(refNumber);
UseResFile(gliderResNum);
end;
{=================================}
procedure DrawAllObjects;
var
index: Integer;
theSrc, destRect, destReserve: Rect;
airPat: Pattern;
airCPat: PixPatHandle;
begin
if ((nObjects < 0) or (nObjects > 16)) then
begin
GenericAlert(kErrWrongHouseVers);
ShowMenuBar;
Exit(DrawAllObjects);
end;
if (nObjects = 0) then
begin
if (inColor) then
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, GrafPtr(mainWndo)^.portBits, wholeArea, wholeArea, srcCopy, wholeRgn)
else
CopyBits(offVirginMap, mainWndo^.portBits, wholeArea, wholeArea, srcCopy, wholeRgn);
Exit(DrawAllObjects);
end;
if (lightsOut) then
begin
if (inColor) then
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
PenNormal;
PaintRect(wholeArea);
for index := 1 to thisHouse.theRooms[roomAt].numberOObjects do
with thisHouse.theRooms[roomAt].theObjects[index] do
if (objectIs = litSwt) then
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
end;
Exit(DrawAllObjects);
end;
for index := 1 to thisHouse.theRooms[roomAt].numberOObjects do
with thisHouse.theRooms[roomAt].theObjects[index] do
case objectIs of
table:
DrawTable(index);
shelf:
DrawShelf(index);
cabNet:
DrawCabinet(index);
books:
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
end;
flrVnt..candle:
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
if (airVisible) then
begin
if (inColor) then
begin
SetPort(GrafPtr(virginCPtr));
PenNormal;
RGBForeColor(rgbBlack);
airCPat := GetPixPat(128);
if (airCPat <> nil) then
PenPixPat(airCPat);
PenMode(srcCopy + transparent);
PaintRect(eventRect[index]);
if (airCPat <> nil) then
DisposPixPat(airCPat);
PenNormal;
end
else
begin
SetPort(offVirginPort);
PenNormal;
GetIndPattern(airPat, 128, 1);
PenPat(airPat);
PaintRect(eventRect[index]);
PenNormal;
end;
end;
end;
lftFan, ritFan:
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
if (airVisible) then
begin
if (inColor) then
begin
SetPort(GrafPtr(virginCPtr));
PenNormal;
RGBForeColor(rgbBlack);
airCPat := GetPixPat(129);
if (airCPat <> nil) then
PenPixPat(airCPat);
PenMode(srcCopy + transparent);
PaintRect(eventRect[index]);
if (airCPat <> nil) then
DisposPixPat(airCPat);
PenNormal;
end
else
begin
SetPort(offVirginPort);
PenNormal;
GetIndPattern(airPat, 128, 2);
PenPat(airPat);
PaintRect(eventRect[index]);
end;
end;
end;
grease:
begin
destRect := boundRect;
if (not isOn) then
begin
theSrc := srcRect[59]; {spilled grease}
if (inColor) then
begin
SetPort(GrafPtr(virginCPtr));
PenNormal;
RGBForeColor(rgbBlack);
PenSize(2, 2);
MoveTo(destRect.right, destRect.bottom - 2);
LineTo(amount, destRect.bottom - 2);
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect);
end
else
begin
SetPort(offVirginPort);
PenNormal;
PenSize(2, 2);
MoveTo(destRect.right, destRect.bottom - 2);
LineTo(amount, destRect.bottom - 2);
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
end;
end;
end;
clock, paper, battry, rbrBnd:
if (amount > 0) then
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
destReserve := destRect;
OffsetRect(destReserve, -destReserve.left, -destReserve.top);
OffsetRect(destReserve, reserveRects[index].left, reserveRects[index].top);
if (inColor) then
begin
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, BitMapPtr(reserveCPtr^.portPixMap^)^, destRect, destReserve, srcCopy, nil);
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect)
end
else
begin
CopyBits(offVirginMap, offReserveMap, destRect, destReserve, srcCopy, nil);
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
end;
end;
litSwt..guitar:
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
end;
drip:
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
end;
toastr, fshBwl, teaKtl:
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
end;
window:
DrawWindow(index);
mirror:
DrawMirror(index);
paintg:
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
if (inColor) then
CopyBits(BitMapPtr(objectCPtr^.portPixMap^)^, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, destRect, srcCopy, nil)
else
CopyBits(offPlayerMap, offVirginMap, theSrc, destRect, srcCopy, nil);
end;
basket, macTsh:
begin
theSrc := srcRect[objectIs];
destRect := boundRect;
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, theSrc, theSrc, destRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, theSrc, theSrc, destRect);
end;
upStar, dnStar:
DrawStair(index);
otherwise
Cycle;
end;
end;
{=================================}
procedure PopTheScore (whatScore: LongInt);
var
tempStr: Str255;
begin
PenNormal;
PaintRect(lgScoreRect);
NumToString(whatScore, tempStr);
MoveTo(224, 17);
TextFont(SystemFont);
TextSize(12);
if (inColor) then
begin
RGBForeColor(rgbLtBlue);
PenMode(srcOr);
DrawString(tempStr);
PenNormal;
RGBForeColor(rgbBlack);
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, GrafPtr(mainWndo)^.portBits, smScoreRect, smScoreRect, srcCopy, wholeRgn);
end
else
begin
TextMode(patXOr);
DrawString(tempStr);
if (mainScreenHidden) then
CopyBits(offVirginMap, offLoadMap, smScoreRect, smScoreRect, srcCopy, nil)
else
CopyBits(offVirginMap, mainWndo^.portBits, smScoreRect, smScoreRect, srcCopy, nil);
end;
end;
{=================================}
procedure BumpTheScore;
begin
rollScore := rollScore + scoreIncrement;
if (rollScore < (roomScore + suppScore)) then
begin
PopTheScore(rollScore);
DoTheSound(21);
end
else
begin
scoreIsRolling := FALSE;
rollScore := roomScore + suppScore;
PopTheScore(rollScore);
if (inColor) then
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, BitMapPtr(loadCPtr^.portPixMap^)^, smScoreRect, smScoreRect, srcCopy, nil)
else
begin
CopyBits(offVirginMap, mainWndo^.portBits, smScoreRect, smScoreRect, srcCopy, nil);
CopyBits(offVirginMap, offLoadMap, smScoreRect, smScoreRect, srcCopy, nil);
end;
end;
end;
{=================================}
procedure StartScoreRolling;
begin
if (rollScore < (roomScore + suppScore)) then
begin
rollScore := roomScore + suppScore;
PopTheScore(rollScore);
end;
scoreIsRolling := TRUE;
end;
{=================================}
procedure UpdateBandNumbers;
var
tempStr: Str255;
dest: Rect;
begin
SetRect(dest, 346, 5, 359, 20);
FillRect(dest, black);
MoveTo(dest.left, dest.bottom - 2);
TextFont(16);
TextSize(12);
if (theGlider.bands < 100) then
NumToString(theGlider.bands, tempStr)
else
tempStr := '++';
if (inColor) then
begin
RGBForeColor(rgbLtGreen);
PenMode(srcOr);
DrawString(tempStr);
PenNormal;
RGBForeColor(rgbBlack);
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, BitMapPtr(loadCPtr^.portPixMap^)^, dest, dest, srcCopy, nil);
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, GrafPtr(mainWndo)^.portBits, dest, dest, srcCopy, wholeRgn);
end
else
begin
TextMode(patXOr);
DrawString(tempStr);
PenNormal;
CopyBits(offVirginMap, offLoadMap, dest, dest, srcCopy, nil);
CopyBits(offVirginMap, mainWndo^.portBits, dest, dest, srcCopy, wholeRgn);
end;
end;
{=================================}
procedure PopTokenBand;
var
src, dest: Rect;
begin
SetRect(src, 36, 301, 45, 316);
SetRect(dest, 359, 5, 368, 20);
if (inColor) then
begin
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, src, src, dest);
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, GrafPtr(mainWndo)^.portBits, dest, dest, srcCopy, wholeRgn)
end
else
begin
CopyMask(offPlayerMap, offMaskMap, offVirginMap, src, src, dest);
CopyBits(offVirginMap, mainWndo^.portBits, dest, dest, srcCopy, nil);
CopyBits(offVirginMap, offLoadMap, dest, dest, srcCopy, nil);
end;
end;
{=================================}
procedure UpdateBatteryEnergy;
var
tempStr: Str255;
dest: Rect;
begin
SetRect(dest, 308, 5, 326, 20);
FillRect(dest, black);
MoveTo(dest.left, dest.bottom - 2);
TextFont(16);
TextSize(12);
if (theGlider.energy < 1000) then
NumToString(theGlider.energy, tempStr)
else
tempStr := '+++';
if (inColor) then
begin
RGBForeColor(rgbYellow);
PenMode(srcOr);
DrawString(tempStr);
PenNormal;
RGBForeColor(rgbBlack);
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, BitMapPtr(loadCPtr^.portPixMap^)^, dest, dest, srcCopy, nil);
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, GrafPtr(mainWndo)^.portBits, dest, dest, srcCopy, wholeRgn);
end
else
begin
TextMode(patXOr);
DrawString(tempStr);
PenNormal;
CopyBits(offVirginMap, offLoadMap, dest, dest, srcCopy, nil);
CopyBits(offVirginMap, mainWndo^.portBits, dest, dest, srcCopy, wholeRgn);
end;
end;
{=================================}
procedure PopTokenBattery;
var
src, dest: Rect;
begin
SetRect(src, 46, 301, 55, 316);
SetRect(dest, 326, 5, 335, 20);
if (inColor) then
begin
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, src, src, dest);
CopyBits(BitMapPtr(virginCPtr^.portPixMap^)^, GrafPtr(mainWndo)^.portBits, dest, dest, srcCopy, wholeRgn);
end
else
begin
CopyMask(offPlayerMap, offMaskMap, offVirginMap, src, src, dest);
CopyBits(offVirginMap, mainWndo^.portBits, dest, dest, srcCopy, nil);
CopyBits(offVirginMap, offLoadMap, dest, dest, srcCopy, nil);
end;
end;
{=================================}
procedure DrawHeadline;
var
index, shown: Integer;
srcR, tempRect: Rect;
tempStr: Str255;
begin
if (inColor) then {Draw the title of room}
SetPort(GrafPtr(virginCPtr))
else
SetPort(offVirginPort);
SetRect(tempRect, 3, 2, 162, 23);
EraseRect(tempRect);
PenNormal;
TextFont(SystemFont);
TextSize(12);
FrameRect(tempRect);
MoveTo(tempRect.left - 1, tempRect.top + 2);
LineTo(tempRect.left - 1, tempRect.bottom);
LineTo(tempRect.right - 2, tempRect.bottom);
tempStr := thisHouse.theRooms[roomAt].roomName;
MoveTo(tempRect.left + 4, tempRect.top + 15);
if (inColor) then
begin
InsetRect(tempRect, 2, 2);
InvertRect(tempRect);
RGBForeColor(rgbRed);
PenMode(srcOr);
DrawString(tempStr);
PenNormal;
RGBForeColor(rgbBlack);
end
else
begin
DrawString(tempStr);
InsetRect(tempRect, 2, 2);
InvertRect(tempRect);
end;
SetRect(srcR, 36, 318, 54, 341); {Pop up number of room}
SetRect(tempRect, 165, 1, 183, 24);
if (inColor) then
CopyBits(BitMapPtr(objectCPtr^.portPixMap^)^, BitMapPtr(virginCPtr^.portPixMap^)^, srcR, tempRect, srcCopy, wholeRgn)
else
CopyBits(offPlayerMap, offVirginMap, srcR, tempRect, srcCopy, wholeRgn);
if (roomsPassed > 99) then
shown := roomsPassed div 100
else
begin
if (roomsPassed > 9) then
shown := roomsPassed div 10
else
shown := roomsPassed;
end;
MoveTo(tempRect.left + 5, tempRect.bottom - 6);
NumToString(shown, tempStr);
DrawString(tempStr);
if (roomsPassed > 9) then
begin
OffsetRect(srcR, 18, 0);
OffsetRect(tempRect, 20, 0);
if (inColor) then
CopyBits(BitMapPtr(objectCPtr^.portPixMap^)^, BitMapPtr(virginCPtr^.portPixMap^)^, srcR, tempRect, srcCopy, wholeRgn)
else
CopyBits(offPlayerMap, offVirginMap, srcR, tempRect, srcCopy, wholeRgn);
if (roomsPassed > 99) then
shown := (roomsPassed div 10) - (roomsPassed mod 10)
else
shown := roomsPassed mod 10;
MoveTo(tempRect.left + 6, tempRect.bottom - 6);
NumToString(shown, tempStr);
DrawString(tempStr);
if (roomsPassed > 99) then
begin
OffsetRect(srcR, -18, 0);
OffsetRect(tempRect, 20, 0);
if (inColor) then
CopyBits(BitMapPtr(objectCPtr^.portPixMap^)^, BitMapPtr(virginCPtr^.portPixMap^)^, srcR, tempRect, srcCopy, wholeRgn)
else
CopyBits(offPlayerMap, offVirginMap, srcR, tempRect, srcCopy, wholeRgn);
shown := roomsPassed mod 100;
MoveTo(tempRect.left + 5, tempRect.bottom - 6);
NumToString(shown, tempStr);
DrawString(tempStr);
end;
end;
PenNormal; {Draw all 'token' gliders}
SetRect(tempRect, 302, 2, 510, 23);
EraseRect(tempRect);
FrameRect(tempRect);
MoveTo(tempRect.left - 1, tempRect.top + 2);
LineTo(tempRect.left - 1, tempRect.bottom);
LineTo(tempRect.right - 2, tempRect.bottom);
InsetRect(tempRect, 2, 2);
InvertRect(tempRect);
if (Mortals > 1) then
begin
if (Mortals > 3) then
begin
SetRect(tempRect, 384, 5, 396, 20);
MoveTo(tempRect.left, tempRect.bottom - 2);
TextFont(16);
TextSize(12);
NumToString(mortals - 1, tempStr);
if (inColor) then
begin
RGBForeColor(rgbRed);
PenMode(srcOr);
DrawString(tempStr);
PenNormal;
RGBForeColor(rgbBlack);
end
else
begin
TextMode(patXOr);
DrawString(tempStr);
PenNormal;
end;
shown := 3;
end
else
shown := Mortals - 1;
SetRect(tempRect, 470, 5, 505, 20);
SetRect(srcR, 0, 318, 35, 333);
for index := 1 to shown do
begin
if (inColor) then
CopyMask(BitMapPtr(objectCPtr^.portPixMap^)^, offMaskMap, BitMapPtr(virginCPtr^.portPixMap^)^, srcR, srcR, tempRect)
else
CopyMask(offPlayerMap, offMaskMap, offVirginMap, srcR, srcR, tempRect);
OffsetRect(tempRect, -37, 0);
end;
end;
PenNormal; {Draw score box}
SetRect(tempRect, 220, 2, 298, 23);
EraseRect(tempRect);
FrameRect(tempRect);
MoveTo(tempRect.left - 1, tempRect.top + 2);
LineTo(tempRect.left - 1, tempRect.bottom);
LineTo(tempRect.right - 2, tempRect.bottom);
InsetRect(tempRect, 2, 2);
InvertRect(tempRect);
PopTheScore(rollScore);
if (theGlider.bands > 0) then
begin
PopTokenBand;
UpdateBandNumbers;
end;
if (theGlider.energy > 0) then
begin
PopTokenBattery;
UpdateBatteryEnergy;
end;
end;
{=================================}
procedure ResetGlider;
begin
with theGlider do
begin
if (mode <> burning) then
begin
timeStamp := 0;
mode := fadingIn;
phase := 0;
isForward := TRUE;
if (isRight) then
srcNum := 0
else
srcNum := 2;
end;
if (enteredLeft) then
SetRect(destRect, 0, 40, 48, 60)
else
SetRect(destRect, 464, 40, 512, 60);
oldRect := destRect;
wholeRect := destRect;
shadoDest := destRect;
shadoDest.top := kFloorVert;
shadoDest.bottom := kFloorVert + 11;
oldShado := shadoDest;
wholeShado := shadoDest;
touchRect := destRect;
InsetRect(touchRect, 10, 5);
end;
lifeNormal := FALSE;
end;
{=================================}
procedure ResetAnimate;
begin
with theAnimates[index] do
begin
if (typeIs <> -1) then
begin
delay := thisHouse.theRooms[roomAt].animateDelay;
kind := typeIs;
unSeen := TRUE;
end;
case kind of
0: {dart}
begin
with destRect do
begin
left := 512;
right := left + 64;
top := Randomize(150);
bottom := top + 22;
end;
phase := 0;
horiOff := -8;
vertOff := 1;
end;
1: {copter}
begin
with destRect do
begin
left := Randomize(256) + 256;
right := left + 32;
top := -32;
bottom := 0;
end;
phase := Randomize(8);
horiOff := -4;
vertOff := 2;
end;
2: {balloon}
begin
with destRect do
begin
left := Randomize(400) + 50;
right := left + 32;
top := 342;
bottom := 374;
end;
phase := Randomize(8);
horiOff := 0;
vertOff := -3;
end;
otherwise
;
end;
wholeRect := destRect;
oldRect := destRect;
tickStamp := Randomize(LoWord(delay) + 120) + TickCount + 60;
end; {with theAnimates[index]}
end;
{=================================}
procedure ExtractEventRects;
var
index, tempInt, tempNum: Integer;
tempRect: Rect;
{-------------------------}
procedure SetUpGrease;
begin
nCycleObs := nCycleObs + 1;
with thisHouse.theRooms[roomAt].theObjects[index] do
begin
if (isOn) then {hasn't been spilled}
begin
eventRect[index] := boundRect;
with cycleObjects[nCycleObs] do
begin
kindIs := grease;
tiedTo := index;
wholeRect := eventRect[index];
oldRect := wholeRect;
reset := 0; {phase=not spilled}
accel := grease; {graphic # to display}
velocity := wholeRect.right;{current length of spill}
position := amount; {full length of spill}
end;
end
else {has been spilled}
begin
with cycleObjects[nCycleObs] do
begin
kindIs := grease;
tiedTo := index;
wholeRect := boundRect;
oldRect := wholeRect;
eventRect[index].left := boundRect.right;
eventRect[index].bottom := boundRect.bottom;
eventRect[index].right := amount;
eventRect[index].top := boundRect.bottom - 5;
reset := 999; {phase=spilled}
accel := 59; {graphic # to display}
velocity := amount; {current length of spill}
position := amount; {length of spill}
end;
end;
end;
end;
{-------------------------}
procedure FrameOutlet;
begin
nCycleObs := nCycleObs + 1;
eventRect[index] := thisHouse.theRooms[roomAt].theObjects[index].boundRect;
with cycleObjects[nCycleObs] do
begin
kindIs := outlet;
tiedTo := index;
eventKind[tiedTo, 1] := 0;
accel := 25;
wholeRect := thisHouse.theRooms[roomAt].theObjects[index].boundRect;
oldRect := wholeRect;
reset := thisHouse.theRooms[roomAt].theObjects[index].amount;
position := TickCount;
end;
end;
{-------------------------}
procedure FrameCandle;
begin
nCycleObs := nCycleObs + 1;
with thisHouse.theRooms[roomAt].theObjects[index] do
begin
tempInt := (boundRect.right + boundRect.left) div 2;
SetRect(eventRect[index], tempInt - 12, amount, tempInt + 4, boundRect.top);
end;
with cycleObjects[nCycleObs] do
begin
wholeRect := thisHouse.theRooms[roomAt].theObjects[index].boundRect;
wholeRect.bottom := wholeRect.top;
wholeRect.top := wholeRect.bottom - 12;
wholeRect.left := wholeRect.left + 5;
wholeRect.right := wholeRect.left + 16;
oldRect := wholeRect;
kindIs := candle;
position := Randomize(3) + 48;
end;
end;
{-------------------------}
procedure FrameDrip;
begin
nCycleObs := nCycleObs + 1;
eventRect[index] := thisHouse.theRooms[roomAt].theObjects[index].boundRect;
with cycleObjects[nCycleObs] do
begin
kindIs := drip;
tiedTo := index;
holdRect := thisHouse.theRooms[roomAt].theObjects[index].boundRect;
wholeRect := holdRect;
oldRect := wholeRect;
reset := thisHouse.theRooms[roomAt].theObjects[index].amount * 32;
accel := 12;
position := holdRect.bottom * 32;
velocity := 0;
phase := 53;
end;
end;
{-------------------------}
procedure ReadyToast;
begin
nCycleObs := nCycleObs + 1;
with thisHouse.theRooms[roomAt].theObjects[index] do
begin
tempInt := boundRect.left + 3;
tempNum := boundRect.bottom - 3;
SetRect(eventRect[index], 0, 0, 32, 31);
OffsetRect(eventRect[index], tempInt, tempNum);
SetRect(tempRect, tempInt, amount, tempInt + 32, boundRect.top);
end;
toastRgn := NewRgn;
RectRgn(toastRgn, tempRect);
HLock(Handle(toastRgn));
hasToast := TRUE;
with cycleObjects[nCycleObs] do
begin
phase := 60;
kindIs := toastr;
tiedTo := index;
wholeRect := eventRect[index];
oldRect := wholeRect;
reset := tempNum * 32;
accel := 8;
position := reset;
tempInt := (thisHouse.theRooms[roomAt].theObjects[index].amount + 32) * 32;
velocity := 0;
repeat
velocity := velocity + accel;
tempInt := tempInt + velocity;
until (tempInt > reset);
velocity := -velocity;
end;
end;
{-------------------------}
procedure FrameBall;
begin
nCycleObs := nCycleObs + 1;
eventRect[index] := thisHouse.theRooms[roomAt].theObjects[index].boundRect;
with cycleObjects[nCycleObs] do
begin
kindIs := ball;
tiedTo := index;
wholeRect := thisHouse.theRooms[roomAt].theObjects[index].boundRect;
oldRect := wholeRect;
reset := thisHouse.theRooms[roomAt].theObjects[index].boundRect.bottom * 32;
accel := 8;
position := reset;
tempInt := (thisHouse.theRooms[roomAt].theObjects[index].amount + 32) * 32;
velocity := 0;
repeat
velocity := velocity + accel;
tempInt := tempInt + velocity;
until (tempInt > reset);
velocity := -velocity;
end;
end;
{-------------------------}
procedure ReadyFish;
begin
nCycleObs := nCycleObs + 1;
with thisHouse.theRooms[roomAt].theObjects[index] do
begin
tempInt := boundRect.left + 8;
tempNum := boundRect.top + 24;
SetRect(eventRect[index], 0, 0, 16, 16); {fish rectangle}
OffsetRect(eventRect[index], tempInt, tempNum);
end;
with cycleObjects[nCycleObs] do
begin
phase := 69; {# of fish rect}
kindIs := fshBwl;
tiedTo := index;
wholeRect := eventRect[index];
oldRect := wholeRect;
reset := tempNum * 32;
accel := 8;
position := reset;
tempInt := (thisHouse.theRooms[roomAt].theObjects[index].amount + 32) * 32;
velocity := 0;
repeat
velocity := velocity + accel;
tempInt := tempInt + velocity;
until (tempInt > reset);
velocity := -velocity;
end;
end;
{-------------------------}
procedure ReadyTea;
begin
nCycleObs := nCycleObs + 1;
with thisHouse.theRooms[roomAt].theObjects[index] do
begin
tempInt := boundRect.left;
tempNum := boundRect.top;
SetRect(eventRect[index], tempInt - 128, tempNum - 128, tempInt, tempNum);
if (eventRect[index].top < kCeilingVert) then
eventRect[index].top := kCeilingVert;
if (eventRect[index].left < 0) then
eventRect[index].left := 0;
end;
with cycleObjects[nCycleObs] do
begin
phase := 0;
kindIs := teaKtl;
tiedTo := index;
SetRect(wholeRect, 0, 0, 0, 0);
oldRect := wholeRect;
position := thisHouse.theRooms[roomAt].theObjects[index].amount;
reset := position + Randomize(120);
end;
end;
{-------------------------}
procedure FrameWindow;
var
i, joint: Integer;
topRect, bottomRect: Rect;
tempRgn: RgnHandle;
begin
nObjects := nObjects - 1;
with thisHouse.theRooms[roomAt].theObjects[index] do
begin
if (isOn) then
begin
topRect := boundRect; {create top opening}
InsetRect(topRect, 8, 16);
topRect.top := ((boundRect.bottom + boundRect.top) div 2) - 2;
OffsetRect(topRect, 0, 26 - ((boundRect.bottom - boundRect.top) div 2));
InsetRect(topRect, 10, 10);
bottomRect := boundRect; {create bottom opening}
InsetRect(bottomRect, 8, 16);
bottomRect.top := ((boundRect.bottom + boundRect.top) div 2) + 10;
windowOpen := TRUE;
end
else
begin
topRect := boundRect; {create top opening}
InsetRect(topRect, 8, 16);
topRect.bottom := ((boundRect.bottom + boundRect.top) div 2) + 2;
InsetRect(topRect, 10, 10);
bottomRect := boundRect; {create bottom opening}
InsetRect(bottomRect, 8, 16);
bottomRect.top := ((boundRect.bottom + boundRect.top) div 2) - 2;
InsetRect(bottomRect, 10, 10);
end;
end;
windowRgn := NewRgn;
RectRgn(windowRgn, topRect);
tempRgn := NewRgn;
RectRgn(tempRgn, bottomRect);
UnionRgn(windowRgn, tempRgn, windowRgn);
HLock(Handle(windowRgn));
DisposeRgn(tempRgn);
UnionRect(topRect, bottomRect, tempRect);
tempInt := (tempRect.bottom - tempRect.top) div 7;
with theLightning do
begin
for i := 1 to 3 do
begin
theBolts[i, 0, 0] := tempRect.left + Randomize(tempRect.right - tempRect.left);
theBolts[i, 0, 1] := tempRect.top;
for joint := 1 to 7 do
repeat
theBolts[i, joint, 0] := theBolts[i, joint - 1, 0] + Randomize(tempInt * 4) - tempInt * 2;
theBolts[i, joint, 1] := tempInt * joint + tempRect.top;
until ((theBolts[i, joint, 0] > tempRect.left) and (theBolts[i, joint, 0] < tempRect.right));
end;
whichBolt := Randomize(3) + 1;
whatTime := TickCount + 120 + Randomize(120);
whatPhase := 0;
end;
hasWindow := TRUE;
end;
{-------------------------}
procedure FrameMirror;
begin
nObjects := nObjects - 1;
with thisHouse.theRooms[roomAt].theObjects[index] do
tempRect := boundRect;
InsetRect(tempRect, 5, 5);
mirrorRgn := NewRgn;
RectRgn(mirrorRgn, tempRect);
HLock(Handle(mirrorRgn));
hasMirror := TRUE;
end;
{-------------------------}
begin
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;
windowOpen := FALSE;
if (thisHouse.theRooms[roomAt].conditionCode = 2) then
lightsOut := TRUE
else
lightsOut := FALSE;
if (thisHouse.theRooms[roomAt].conditionCode = 1) then
airOut := TRUE
else
airOut := FALSE;
nCycleObs := 0;
nObjects := thisHouse.theRooms[roomAt].numberOObjects;
tempNum := nObjects;
for index := 1 to tempNum do
with thisHouse.theRooms[roomAt].theObjects[index] do
begin
case objectIs of
table..obsRct:
eventRect[index] := boundRect;
flrVnt:
begin
tempInt := (boundRect.right + boundRect.left) div 2;
SetRect(eventRect[index], tempInt - 8, amount, tempInt + 8, kFloorVert);
end;
celVnt:
begin
tempInt := (boundRect.right + boundRect.left) div 2;
SetRect(eventRect[index], tempInt - 8, kCeilingVert, tempInt + 8, amount);
end;
celDct:
if (isOn) then
begin
tempInt := (boundRect.right + boundRect.left) div 2;
SetRect(eventRect[index], tempInt - 8, kCeilingVert, tempInt + 8, amount);
end
else
begin
eventRect[index] := boundRect;
eventRect[index].bottom := eventRect[index].top + 8;
end;
candle:
FrameCandle;
lftFan:
SetRect(eventRect[index], amount, boundRect.top + 10, boundRect.left, boundRect.top + 30);
ritFan:
SetRect(eventRect[index], boundRect.right, boundRect.top + 10, amount, boundRect.top + 30);
clock, paper:
eventRect[index] := boundRect;
grease:
SetUpGrease;
bnsRct..rbrBnd:
eventRect[index] := boundRect;
litSwt, thermo, pwrSwt:
eventRect[index] := boundRect;
shredr:
begin
eventRect[index] := boundRect;
eventRect[index].top := eventRect[index].top - 4;
eventRect[index].bottom := eventRect[index].bottom - 12;
end;
outlet:
FrameOutlet;
guitar:
with boundRect do
SetRect(eventRect[index], left + 36, top + 24, left + 38, bottom - 56);
ball:
FrameBall;
drip:
FrameDrip;
toastr:
ReadyToast;
fshBwl:
ReadyFish;
teaKtl:
ReadyTea;
window:
FrameWindow;
paintg:
nObjects := nObjects - 1;
mirror:
FrameMirror;
basket, macTsh:
eventRect[index] := boundRect;
upStar:
with boundRect do
SetRect(eventRect[index], left + 32, top, right - 32, top + 8);
dnStar:
with boundRect do
SetRect(eventRect[index], left + 32, bottom - 8, right - 32, bottom);
otherwise
eventRect[index] := nullRect;
end; {case}
eventKind[index, 1] := 0;
case objectIs of
table, shelf, books, cabnet, obsRct, drip, toastr, ball, fshBwl, basket, macTsh:
eventKind[index, 0] := crashIt;
extRct:
begin
eventKind[index, 0] := moveIt;
eventKind[index, 1] := amount;
end;
flrVnt:
eventKind[index, 0] := liftIt;
celVnt:
eventKind[index, 0] := dropIt;
celDct:
if (isOn) then
eventKind[index, 0] := dropIt
else
begin
eventKind[index, 0] := moveIt;
eventKind[index, 1] := extra;
end;
candle:
begin
eventKind[index, 0] := burnIt;
eventKind[index, 1] := boundRect.bottom - 48;
end;
lftFan:
if (isOn) then
eventKind[index, 0] := turnItLeft
else
eventKind[index, 0] := ignoreIt;
ritFan:
if (isOn) then
eventKind[index, 0] := turnItRight
else
eventKind[index, 0] := ignoreIt;
clock:
begin
eventKind[index, 0] := awardIt;
eventKind[index, 1] := amount;
if (amount < 1) then
eventRect[index] := nullRect;
end;
paper:
begin
eventKind[index, 0] := extraIt;
eventKind[index, 1] := amount;
if (amount < 1) then
eventRect[index] := nullRect;
end;
grease:
if (isOn) then
eventKind[index, 0] := spillIt
else
eventKind[index, 0] := slideIt;
bnsRct:
begin
eventKind[index, 0] := trickIt;
eventKind[index, 1] := amount;
if (amount < 1) then
eventRect[index] := nullRect;
end;
battry:
begin
eventKind[index, 0] := energizeIt;
eventKind[index, 1] := amount;
if (amount < 1) then
eventRect[index] := nullRect;
end;
rbrBnd:
begin
eventKind[index, 0] := bandIt;
eventKind[index, 1] := amount;
if (amount < 1) then
eventRect[index] := nullRect;
end;
litSwt:
eventKind[index, 0] := lightIt;
outlet:
eventKind[index, 0] := zapIt;
thermo:
eventKind[index, 0] := airOnIt;
shredr:
if (isOn) then
eventKind[index, 0] := shredIt
else
eventKind[index, 0] := ignoreIt;
pwrSwt:
begin
eventKind[index, 0] := toggleIt;
eventKind[index, 1] := amount; {object# linked to}
eventKind[index, 2] := TickCount;{delay from when hit}
end;
guitar:
begin
eventKind[index, 0] := playIt;
eventKind[index, 1] := 0;
end;
upStar:
begin
eventKind[index, 0] := ascendIt;
eventKind[index, 1] := amount; {room # linked to}
end;
dnStar:
begin
eventKind[index, 0] := descendIt;
eventKind[index, 1] := amount; {room # linked to}
end;
otherwise
eventKind[index, 0] := ignoreIt;
end; {case}
end;
end;
{=================================}
procedure ReadyRoom;
var
index: Integer;
begin
with thisHouse.theRooms[roomAt] do
begin
rightIsOpen := rightOpen;
leftIsOpen := leftOpen;
if (animateNumber > 0) then
begin
nAnimates := animateNumber;
for index := 1 to nAnimates do
ResetAnimate(animateKind, index);
end
else
nAnimates := 0;
end;
bandBorne := FALSE;
floatPoints.out := FALSE;
ExtractEventRects;
LoadABackground(thisHouse.theRooms[roomAt].backPictID);
DoTheMusic(kMusicSound);
ArrangeTiles;
DrawAllObjects;
DrawHeadline;
end;
{=================================}
procedure WriteScores;
type
scoreHold = record
score: array[0..19] of LongInt;
level: array[0..19] of Integer;
name: array[0..19] of string[24];
room: array[0..19] of string[24];
end;
var
i, temp: Integer;
textLength: LongInt;
tempScore: scoreHold;
houseVolName: Str255;
begin
with tempScore, thisHouse do {**** Hold copy of scores****}
for i := 0 to 19 do
begin
score[i] := hiScores[i];
level[i] := hiLevel[i];
name[i] := hiName[i];
room[i] := hiRoom[i];
end;
theErr := SetVol(nil, houseVolNum);
if (theErr <> NoErr) then
begin
GenericAlert(theErr);
Exit(WriteScores);
end;
theErr := FSOpen(housesName, houseVolNum, houseNumber);
if (theErr <> NoErr) then
begin
GenericAlert(theErr);
Exit(WriteScores);
end;
theErr := SetFPos(houseNumber, FSFromStart, 0);
if (theErr <> NoErr) then {**** Read in virgin house ****}
begin
GenericAlert(theErr);
Exit(WriteScores);
end;
textLength := SIZEOF(thisHouse);
theErr := FSRead(houseNumber, textLength, @thisHouse);
if (theErr <> NoErr) then
begin
GenericAlert(theErr);
Exit(WriteScores);
end;
with tempScore, thisHouse do {**** modify hi scores ****}
for i := 0 to 19 do
begin
hiScores[i] := score[i];
hiLevel[i] := level[i];
hiName[i] := name[i];
hiRoom[i] := room[i];
end; {with}
theErr := SetFPos(houseNumber, FSFromStart, 0);
if (theErr <> NoErr) then {**** write out new file ****}
begin
GenericAlert(theErr);
Exit(WriteScores);
end;
theErr := FSWrite(houseNumber, textLength, @thisHouse);
if (theErr <> NoErr) then
begin
GenericAlert(theErr);
Exit(WriteScores);
end;
theErr := SetEOF(houseNumber, textLength);
if (theErr <> NoErr) then
begin
GenericAlert(theErr);
Exit(WriteScores);
end;
theErr := FSClose(houseNumber); {**** close file ****}
if (theErr <> NoErr) then
begin
GenericAlert(theErr);
Exit(WriteScores);
end;
end;
{=================================}
function TypewriterFilter (theDialog: DialogPtr; var theEvent: EventRecord; var itemHit: integer): boolean;
var
tempRect: Rect;
begin
TypewriterFilter := FALSE;
if (theEvent.what = KeyDown) then
begin
if (BitAnd(theEvent.message, CharCodeMask) = kReturnKey) then
begin
itemHit := 1;
TypewriterFilter := TRUE;
end
else
begin
{play typewriter keystroke}
DoTheSound(kTapSound);
end;
end;
end;
{=================================}
procedure GetName (theRank: Integer; theScore: LongInt);
const
okayItem = 1;
nameItem = 2;
rankItem = 3;
scoreItem = 4;
var
wasPort: GrafPtr;
leaveDlg: boolean;
itemT, itemHit: Integer;
tempStr: Str255;
itemH: Handle;
theDlgPtr: DialogPtr;
tempRect: Rect;
{----------------------------------}
procedure RefreshIt;
begin
SetPort(theDlgPtr);
GetDItem(theDlgPtr, okayItem, itemT, itemH, tempRect);
PenSize(3, 3);
InsetRect(tempRect, -4, -4);
FrameRoundRect(tempRect, 16, 16);
PenSize(1, 1);
end;
{----------------------------------}
begin
DoTheSound(kWhistleSound);
FlushEvents(EveryEvent, 0);
GetPort(wasPort);
theDlgPtr := GetNewDialog(128, nil, Pointer(-1));{Bring in the dialog resource}
tempRect := theDlgPtr^.portRect; {Get window size, we will now center it}
tempRect.Top := ((screenBits.Bounds.Bottom - screenBits.Bounds.Top) - (tempRect.Bottom - tempRect.Top)) div 2;
tempRect.Left := ((screenBits.Bounds.Right - screenBits.Bounds.Left) - (tempRect.Right - tempRect.Left)) div 2;
MoveWindow(theDlgPtr, tempRect.Left, tempRect.Top, TRUE);{Now move the window to the proper position}
ShowWindow(theDlgPtr); {Open a dialog box}
SelectWindow(theDlgPtr);
SetPort(theDlgPtr);
GetDItem(theDlgPtr, rankItem, itemT, itemH, tempRect);
NumToString(theRank + 1, tempStr);
SetIText(itemH, tempStr);
GetDItem(theDlgPtr, scoreItem, itemT, itemH, tempRect);
NumToString(theScore, tempStr);
SetIText(itemH, tempStr);
GetDItem(theDlgPtr, nameItem, itemT, itemH, tempRect);
SetIText(itemH, playerName);
SelIText(theDlgPtr, nameItem, 0, 24);
RefreshIt;
leaveDlg := FALSE;
repeat
ModalDialog(@TypewriterFilter, itemHit);
GetDItem(theDlgPtr, itemHit, itemT, itemH, tempRect);
if (ItemHit = okayItem) then
begin
{play typewriter carriage return}
DoTheSound(kCRSound);
leaveDlg := TRUE;
end;
until leaveDlg;
GetDItem(theDlgPtr, nameItem, itemT, itemH, tempRect);
GetIText(itemH, tempStr);
playerName := COPY(tempStr, 1, 24);
DisposDialog(theDlgPtr);
SetPort(GrafPtr(wasPort));
end;
{=================================}
procedure SortHiScores;
var
i: Integer;
tempLong: LongInt;
lastName: Str255;
begin
if (roomAt < 1) then
begin
roomsPassed := 0;
lastName := 'Completed the House';
end
else
lastName := thisHouse.theRooms[roomAt].roomName;
tempLong := suppScore + roomScore;
if (housesName <> firstFileName) then
begin
housesName := firstFileName;
if (not GetHouse) then
Exit(SortHiScores);
end;
if (refuseHigh) then
Exit(SortHiScores);
with scoreList, thisHouse do
begin
if (tempLong <= hiScores[19]) then
rank := 20
else
begin
changed := TRUE;
hiScores[19] := tempLong;
hiLevel[19] := roomsPassed;
hiName[19] := '';
hiRoom[19] := lastName;
rank := 19;
for i := 18 downto 0 do
if (tempLong > hiScores[i]) then
begin
hiName[i + 1] := hiName[i];
hiScores[i + 1] := hiScores[i];
hiLevel[i + 1] := hiLevel[i];
hiRoom[i + 1] := hiRoom[i];
hiName[i] := '';
hiScores[i] := tempLong;
hiLevel[i] := roomsPassed;
hiRoom[i] := lastName;
rank := i;
end;
GetName(rank, tempLong);
hiName[rank] := COPY(playerName, 1, 24);
WriteScores;
end; {else}
end; {with}
end; {proc}
{=================================}
function DoQuit;
var
dummyInt: Integer;
alertHandle: AlertTHndl;
alertRect: Rect;
begin
DoQuit := TRUE;
if (playing) then
begin
UseResFile(gliderResNum);
InitCursor;
alertHandle := AlertTHndl(Get1Resource('ALRT', rQuitNoSaveAlertID));
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(rQuitNoSaveAlertID, nil);
if (dummyInt = 1) then
DoQuit := FALSE;
end;
end;
{=================================}
end.