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

unit FileInNOut;
interface
uses
Palettes, Globals, GlobalUtils;
function ErrorCheckFile: Boolean;
function OpenHouse: Boolean;
function DoOpen (whichType: Integer): Boolean;
procedure DoClose (volNum: Integer);
function GetHouse: Boolean;
function ReadGame: Boolean;
function SaveGameAs: Boolean;
function SaveGame: Boolean;
function WriteHouse: Boolean;
implementation
const
dlgTop = 50;
dlgLeft = 85;
var
typeIs: Integer;
{=================================}
function ErrorCheckFile;
var
nRooms, index: Integer;
begin
ErrorCheckFile := FALSE;
with thisHouse do
begin
nRooms := numberORooms;
if ((nRooms < 1) or (nRooms > 40)) then {check for valid # of rooms}
begin
Exit(ErrorCheckFile);
end;
for index := 1 to nRooms do {check PICT ID numbers}
begin
if (theRooms[index].backPictID < 200) or (theRooms[index].backPictID > 215) then
begin
Exit(ErrorCheckFile);
end;
end;
end;
ErrorCheckFile := TRUE;
end;
{=================================}
function IOCheck (theErr: OSErr): OSErr;
var
dummyInt: Integer;
line1, line2: Str255;
alertHandle: AlertTHndl;
alertRect: Rect;
begin
InitCursor;
UseResFile(gliderResNum);
if (theErr <> NoErr) then
begin
case theErr of
DskFulErr:
GetIndString(line1, rFileStrIDs, 1);
FNFErr:
begin
fileWasLost := TRUE;
GetIndString(line1, rFileStrIDs, 2);
end;
WPrErr:
GetIndString(line1, rFileStrIDs, 3);
FLckdErr:
GetIndString(line1, rFileStrIDs, 4);
VLckdErr:
GetIndString(line1, rFileStrIDs, 5);
FBsyErr, OpWrErr:
GetIndString(line1, rFileStrIDs, 6);
EOFErr:
GetIndString(line1, rFileStrIDs, 7);
otherwise
GetIndString(line1, rFileStrIDs, 10);
end;
NumToString(theErr, line2);
line2 := CONCAT('Error code = ', line2);
ParamText(line1, line2, '', '');
alertHandle := AlertTHndl(Get1Resource('ALRT', rFileAlertID));
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(rFileAlertID, nil);
end;
IOCheck := theErr;
end;
{=================================}
function OpenHouse;
var
index: Integer;
textLength: LongInt;
ignored: Boolean;
begin
OpenHouse := FALSE;
theErr := SetVol(nil, houseVolNum);
if (IOCheck(theErr) <> 0) then
Exit(OpenHouse);
theErr := FSOpen(housesName, houseVolNum, houseNumber);
if (IOCheck(theErr) <> 0) then
begin
if (not DoOpen(kHouseType)) then
begin
playing := FALSE;
theErr := FSClose(houseNumber);
Exit(OpenHouse);
end;
theErr := FSOpen(housesName, houseVolNum, houseNumber);
if (IOCheck(theErr) <> 0) then
begin
playing := FALSE;
theErr := FSClose(houseNumber);
Exit(OpenHouse);
end;
end;
theErr := SetFPos(houseNumber, FSFromStart, 0);
if (IOCheck(theErr) <> 0) then
begin
playing := FALSE;
theErr := FSClose(houseNumber);
Exit(OpenHouse);
end;
textLength := SIZEOF(thisHouse);
theErr := FSRead(houseNumber, textLength, @thisHouse);
if (IOCheck(theErr) <> 0) then
begin
playing := FALSE;
theErr := FSClose(houseNumber);
Exit(OpenHouse);
end;
OpenHouse := TRUE;
end;
{=================================}
function OpenSFGetHook (theSFitem: integer; theDialog: DialogPtr): integer;
const
statText = 11; {DITL item number of textAppButton}
firstTime = -1;
var
itemToChange: Handle; {needed for GetDItem and SetCtlValue}
itemBox: Rect; {needed for GetDItem}
itemType: integer; {needed for GetDItem}
statTitle: Str255; {needed for GetIndString}
begin
OpenSFGetHook := theSFitem;
case theSFitem of
firstTime:
begin
GetIndString(statTitle, rMiscStrID, typeIs);
if (statTitle <> '') then
begin { if we really got the resource}
GetDItem(theDialog, statText, itemType, itemToChange, itemBox);
SetIText(itemToChange, statTitle);
end
else
GenericAlert(kErrLoadingRes);
end; {firstTime}
otherwise
end;
end;
{=================================}
function SimpleFileFilter (p: ParmBlkPtr): BOOLEAN;
const
houseType = 1;
artType = 2;
gameType = 3;
begin
SimpleFileFilter := TRUE; {Don't show it -- default}
with p^.ioFlFndrInfo do
case typeIs of
houseType:
if (fdType = 'GLhs') then
SimpleFileFilter := FALSE; {Show it}
artType:
if (fdType = 'GLbk') then
SimpleFileFilter := FALSE; {Show it}
gameType:
if (fdType = 'GLgm') then
SimpleFileFilter := FALSE; {Show it}
otherwise
;
end;
end;
{=================================}
function DoOpen;
var
dlgOrigin: Point;
theTypeList: SFTypeList;
theReply: SFReply;
begin
UseResFile(gliderResNum);
SetPt(dlgOrigin, dlgLeft + rightOffset, dlgTop + downOffset);
typeIs := whichType + 1;
SFPGetFile(dlgOrigin, '', @SimpleFileFilter, -1, theTypeList, @OpenSFGetHook, theReply, rCustGetID, nil);
with theReply do
begin
if (good) then
begin
case whichType of
kHouseType:
begin
housesName := fName;
houseVolNum := vRefNum;
end;
kArtType:
begin
resourceName := fName;
resVolNum := vRefNum;
end;
kGameType:
begin
gameName := fName;
gameVolNum := vRefNum;
end;
otherwise
Exit(DoOpen);
end;
end;
DoOpen := good;
end;
end;
{=================================}
procedure DoClose;
begin
theErr := FSClose(houseNumber);
if (theErr <> NoErr) then
begin
GenericAlert(theErr);
Exit(DoClose);
end;
theErr := FlushVol(nil, volNum);
if (theErr <> NoErr) then
begin
GenericAlert(theErr);
Exit(DoClose);
end;
end;
{=================================}
function GetHouse;
var
i: Integer;
begin
GetHouse := FALSE;
if (not OpenHouse) then
begin
GenericAlert(kErrExitSansHouse);
Exit(GetHouse);
end;
DoClose(houseVolNum);
{$IFC DemoVersion}
if (thisHouse.timeStamp <> 16) then
begin
GenericAlert(kErrNotDemoHouse);
Exit(GetHouse);
end;
{$ENDC}
if (not ErrorCheckFile) then
begin
GenericAlert(kErrWrongHouseVers);
Exit(GetHouse);
end;
GetHouse := TRUE;
end;
{=================================}
function ReadGame;
type
miniObject = record
theAmount: Integer;
theExtra: Integer;
theIsOn: Boolean;
end;
roomState = record
stateCode: Integer;
objectStates: array[1..16] of miniObject;
end;
gameRec = record
version: Integer;
houseStamp: LongInt;
roomIs, roomsHas: Integer;
nMortals, nBands, nEnergy: Integer;
isRightFace, hasEnteredLeft: Boolean;
theRoomScore, theSuppScore: LongInt;
workingGameNumberIs: LongInt;
whichHouse: string[32];
firstHouse: string[32];
prefs: Integer; {temporary}
roomWasFlags: array[1..40] of Boolean;
stateOfRooms: array[1..40] of roomState;
end;
var
theGame: gameRec;
i, i2: Integer;
bytesIn: LongInt;
begin
ReadGame := FALSE;
bytesIn := SIZEOF(gameRec);
theErr := SetVol(nil, gameVolNum);
if (IOCheck(theErr) <> 0) then
Exit(ReadGame);
theErr := FSOpen(gameName, gameVolNum, gameNumber); {open the game}
if (IOCheck(theErr) <> 0) then
begin
if ((theErr = FNFErr) and (DoOpen(kGameType))) then
begin
theErr := FSOpen(gameName, gameVolNum, gameNumber);
if (IOCheck(theErr) <> 0) then
Exit(ReadGame)
end
else
Exit(ReadGame);
end;
theErr := SetFPos(gameNumber, FSFromStart, 0);
if (IOCheck(theErr) <> 0) then
begin
playing := FALSE;
theErr := FSClose(gameNumber);
Exit(ReadGame);
end;
theErr := FSRead(gameNumber, bytesIn, @theGame); {read in the game}
if (IOCheck(theErr) <> 0) then
begin
playing := FALSE;
theErr := FSClose(gameNumber);
Exit(ReadGame);
end;
theErr := FSClose(gameNumber); {close game file}
if (IOCheck(theErr) <> 0) then
begin
playing := FALSE;
theErr := FSClose(gameNumber);
Exit(ReadGame);
end;
with theGame do {extract beginning game info}
begin
if (version >= $0200) then
begin
GenericAlert(kErrGameOldVers);
Exit(ReadGame);
end;
roomAt := roomIs;
roomsPassed := roomsHas;
mortals := nMortals;
theGlider.bands := nBands;
theGlider.energy := nEnergy;
theGlider.forVel := 4;
theGlider.isRight := isRightFace;
enteredLeft := hasEnteredLeft;
roomScore := theRoomScore;
suppScore := theSuppScore;
workingGameNumber := workingGameNumberIs;
housesName := whichHouse;
firstFileName := firstHouse;
end;
CalcRoomScore;
rollScore := roomScore + suppScore;
if (not GetHouse) then {open said house}
begin
GenericAlert(kErrExitSansHouse);
Exit(ReadGame);
end;
if (theGame.houseStamp <> thisHouse.timeStamp) then
GenericAlert(kErrHouseModified);
with theGame do {set remaining game info}
begin
for i := 1 to 40 do
begin
roomVisits[i] := roomWasFlags[i];
with stateOfRooms[i], thisHouse.theRooms[i] do
begin
conditionCode := stateCode;
for i2 := 1 to 16 do
begin
theObjects[i2].amount := objectStates[i2].theAmount;
theObjects[i2].extra := objectStates[i2].theExtra;
theObjects[i2].isOn := objectStates[i2].theIsOn;
end; {for i2}
end; {with thisHouse}
end; {for i}
end; {with theGame}
ReadGame := TRUE;
end;
{=================================}
function WriteGame (fileNum, volNum: Integer): Boolean;
type
miniObject = record
theAmount: Integer;
theExtra: Integer;
theIsOn: Boolean;
end;
roomState = record
stateCode: Integer;
objectStates: array[1..16] of miniObject;
end;
gameRec = record
version: Integer;
houseStamp: LongInt;
roomIs, roomsHas: Integer;
nMortals, nBands, nEnergy: Integer;
isRightFace, hasEnteredLeft: Boolean;
theRoomScore, theSuppScore: LongInt;
workingGameNumberIs: LongInt;
whichHouse: string[32];
firstHouse: string[32];
prefs: Integer; {temporary}
roomWasFlags: array[1..40] of Boolean;
stateOfRooms: array[1..40] of roomState;
end;
var
theGame: gameRec;
i, i2: Integer;
bytesOut: LongInt;
begin
WriteGame := FALSE;
for i := 1 to nObjects do {set current conditions of present room}
case (eventKind[i, 0]) of
awardIt, extraIt, energizeIt, bandIt:
begin
thisHouse.theRooms[roomAt].theObjects[i].amount := eventKind[i, 1];
end;
lightIt, airOnIt:
begin
if ((not lightsOut) and (not airOut)) then
thisHouse.theRooms[roomAt].conditionCode := 0;
end;
otherwise
end;
CalcRoomScore;
with theGame do
begin
version := kGlideVersion;
houseStamp := thisHouse.timeStamp;
roomIs := roomAt;
roomsHas := roomsPassed;
nMortals := mortals;
nBands := theGlider.bands;
nEnergy := theGlider.energy;
isRightFace := theGlider.isRight;
hasEnteredLeft := enteredLeft;
theRoomScore := roomScore;
theSuppScore := suppScore;
workingGameNumberIs := workingGameNumber;
whichHouse := housesName;
firstHouse := firstFileName;
prefs := 0;
for i := 1 to 40 do
begin
roomWasFlags[i] := roomVisits[i];
with stateOfRooms[i], thisHouse.theRooms[i] do
begin
stateCode := conditionCode;
for i2 := 1 to 16 do
begin
objectStates[i2].theAmount := theObjects[i2].amount;
objectStates[i2].theExtra := theObjects[i2].extra;
objectStates[i2].theIsOn := theObjects[i2].isOn;
end; {for i2}
end; {with thisHouse}
end; {for i}
end; {with theGame}
bytesOut := SIZEOF(gameRec);
theErr := SetFPos(fileNum, FSFromStart, 0);
if (IOCheck(theErr) <> 0) then
begin
theErr := FSClose(gameNumber); {close game file}
Exit(WriteGame);
end;
theErr := FSWrite(fileNum, bytesOut, @theGame);
if (IOCheck(theErr) <> 0) then
begin
theErr := FSClose(gameNumber); {close game file}
Exit(WriteGame);
end;
theErr := SetEOF(fileNum, bytesOut);
if (IOCheck(theErr) <> 0) then
begin
theErr := FSClose(gameNumber); {close game file}
Exit(WriteGame);
end;
theErr := FSClose(fileNum); {close game file}
if (IOCheck(theErr) <> 0) then
begin
theErr := FSClose(gameNumber); {close game file}
Exit(WriteGame);
end;
theErr := FlushVol(nil, volNum);
if (IOCheck(theErr) <> 0) then
Exit(WriteGame);
WriteGame := TRUE;
end;
{=================================}
function SaveGameAs;
var
dlgOrigin: Point;
theReply: SFReply;
theInfo: FInfo;
begin
SaveGameAs := FALSE;
SetPt(dlgOrigin, dlgLeft + rightOffset + 25, dlgTop + downOffset);
SFPutFile(dlgOrigin, 'Name for game:', '', nil, theReply);
with theReply do
begin
if (not good) then
Exit(SaveGameAs);
gameVolNum := vRefNum;
theErr := GetFInfo(fName, gameVolNum, theInfo);
case theErr of
NoErr:
begin
if (theInfo.fdType <> 'GLgm') then
begin
GenericAlert(kErrFileExists);
Exit(SaveGameAs);
end;
end;
FNFErr:
begin
theErr := Create(fname, gameVolNum, 'GLID', 'GLgm');
if (IOCheck(theErr) <> 0) then
begin
Exit(SaveGameAs);
end;
end;
otherwise
begin
GenericAlert(theErr);
Exit(SaveGameAs);
end;
end; {end - case}
{SetCursor- watch}
gameName := fName;
theErr := FSOpen(fName, gameVolNum, gameNumber);
if (IOCheck(theErr) <> 0) then
Exit(SaveGameAs);
if (not WriteGame(gameNumber, gameVolNum)) then
begin
theErr := FSClose(gameNumber); {close game file}
Exit(SaveGameAs);
end;
end; {end - with}
refuseHigh := TRUE;
SaveGameAs := TRUE;
end; {end - function}
{=================================}
function SaveGame;
var
gameVolName: Str255;
begin
SaveGame := FALSE;
if (gameName = '') then
begin
if (not SaveGameAs) then
Exit(SaveGame)
end
else
begin
theErr := FSOpen(gameName, gameVolNum, gameNumber);
if (IOCheck(theErr) <> 0) then
begin
Exit(SaveGame);
end;
if (not WriteGame(gameNumber, gameVolNum)) then
begin
Exit(SaveGame);
end;
end;
refuseHigh := TRUE;
SaveGame := TRUE;
end;
{=================================}
function WriteHouse;
var
fileLength: LongInt;
begin
SpinBall;
WriteHouse := FALSE;
fileLength := SIZEOF(houseRec);
SpinBall;
theErr := SetVol(nil, houseVolNum);
if (IOCheck(theErr) <> 0) then
Exit(WriteHouse);
theErr := FSOpen(housesName, houseVolNum, houseNumber);
if (IOCheck(theErr) <> 0) then
begin
if (not DoOpen(kHouseType)) then
begin
playing := FALSE;
theErr := FSClose(houseNumber);
Exit(WriteHouse);
end;
theErr := FSOpen(housesName, houseVolNum, houseNumber);
if (IOCheck(theErr) <> 0) then
begin
playing := FALSE;
theErr := FSClose(houseNumber);
Exit(WriteHouse);
end;
end;
SpinBall;
theErr := SetFPos(houseNumber, FSFromStart, 0);
if (IOCheck(theErr) <> 0) then
Exit(WriteHouse);
SpinBall;
theErr := FSWrite(houseNumber, fileLength, @thisHouse);
if (IOCheck(theErr) <> 0) then
Exit(WriteHouse);
SpinBall;
theErr := SetEOF(houseNumber, fileLength);
if (IOCheck(theErr) <> 0) then
Exit(WriteHouse);
SpinBall;
theErr := FSClose(houseNumber);
if (IOCheck(theErr) <> 0) then
begin
Exit(WriteHouse);
end;
SpinBall;
theErr := FlushVol(nil, houseVolNum);
if (IOCheck(theErr) <> 0) then
Exit(WriteHouse);
SpinBall;
WriteHouse := TRUE;
end;
{=================================}
end.