Glider4/Glider_405/Sources/G-FileInNOut.p

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.