Glider4/RoomEditor_103/Sources/E-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
12 KiB
OpenEdge ABL
Executable File

unit FileInNOut;
interface
uses
Palettes, Globals, Utilities;
function OpenFile (fileName: Str255; vNum: Integer): Boolean;
function DoOpen: Boolean;
function WriteFile (theFile, volNum: Integer): Boolean;
function DoSaveAs: Boolean;
function DoSave: Boolean;
function DoClose: Boolean;
function SaveNoClose: Integer;
function SaveFirst: Integer;
procedure SavePrefs;
implementation
{=================================}
function IOCheck (theErr: OSErr): Integer;
var
dummyInt: Integer;
line1, line2: Str255;
alertHandle: AlertTHndl;
alertRect: Rect;
begin
UseResFile(editorResNum);
if (theErr <> NoErr) then
begin
InitCursor;
case theErr of
DskFulErr:
GetIndString(line1, fileStrIDs, 1);
FNFErr:
GetIndString(line1, fileStrIDs, 2);
WPrErr:
GetIndString(line1, fileStrIDs, 3);
FLckdErr:
GetIndString(line1, fileStrIDs, 4);
VLckdErr:
GetIndString(line1, fileStrIDs, 5);
FBsyErr, OpWrErr:
GetIndString(line1, fileStrIDs, 6);
EOFErr:
GetIndString(line1, fileStrIDs, 7);
otherwise
GetIndString(line1, fileStrIDs, 10);
end;
NumToString(theErr, line2);
line2 := CONCAT('Error code = ', line2);
ParamText(line1, line2, '', '');
alertHandle := AlertTHndl(Get1Resource('ALRT', fileAlertID));
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(fileAlertID, nil);
end;
IOCheck := theErr;
end;
{=================================}
function OpenFile;
var
textLength: LongInt;
resultCode: OSErr;
dummy: Boolean;
begin
SpinBall;
OpenFile := FALSE;
resultCode := FSOpen(fileName, vNum, fileNumber);
if (IOCheck(resultCode) <> 0) then
Exit(OpenFile);
SpinBall;
resultCode := SetFPos(fileNumber, FSFromStart, 0);
if (IOCheck(resultCode) <> 0) then
begin
fileIsOpen := TRUE;
dummy := DoClose;
Exit(OpenFile);
end;
SpinBall;
textLength := SIZEOF(houseRec);
resultCode := FSRead(fileNumber, textLength, @thisHouse);
if (IOCheck(resultCode) <> 0) then
begin
fileIsOpen := TRUE;
dummy := DoClose;
Exit(OpenFile);
end;
SpinBall;
if (thisHouse.timeStamp <= 0) then
begin
GenericAlert(24);
fileIsOpen := TRUE;
volumeNumber := vNum;
dummy := DoClose;
Exit(OpenFile);
end;
SpinBall;
fileIsOpen := TRUE;
OpenFile := TRUE;
lockIt := FALSE;
volumeNumber := vNum;
end;
{=================================}
function SimpleFileFilter (p: ParmBlkPtr): BOOLEAN;
begin
SimpleFileFilter := TRUE; {Don't show it -- default}
with p^.ioFlFndrInfo do
if (fdType = 'GLhs') then
SimpleFileFilter := FALSE; {Show it}
end;
{=====================================}
function DoOpen;
var
dlgOrigin: Point;
theTypeList: SFTypeList;
theReply: SFReply;
begin
DoOpen := FALSE;
SetPt(dlgOrigin, dlgLeft + rightOffset, dlgTop + downOffset);
theTypeList[0] := 'GLhs';
SFPGetFile(dlgOrigin, '', @SimpleFileFilter, -1, theTypeList, nil, theReply, custGetID, nil);
with theReply do
begin
if (good) then
begin
housesName := fName;
DoOpen := (OpenFile(fName, vRefNum));
InitCursor;
end
else
begin
DoOpen := FALSE;
Exit(DoOpen);
end;
end;
end;
{=====================================}
function WriteFile;
var
index, temp: Integer;
fileLength: LongInt;
resultCode: OSErr;
begin
SpinBall;
WriteFile := FALSE;
fileLength := SIZEOF(houseRec);
SpinBall;
resultCode := SetFPos(theFile, FSFromStart, 0);
if (IOCheck(resultCode) <> 0) then
begin
Exit(WriteFile);
end;
SpinBall;
resultCode := FSWrite(theFile, fileLength, @thisHouse);
if (IOCheck(resultCode) <> 0) then
begin
Exit(WriteFile);
end;
SpinBall;
resultCode := SetEOF(theFile, fileLength);
if (IOCheck(resultCode) <> 0) then
begin
Exit(WriteFile);
end;
SpinBall;
resultCode := FlushVol(nil, volNum);
if (IOCheck(resultCode) <> 0) then
begin
Exit(WriteFile);
end;
SpinBall;
changed := FALSE;
WriteFile := TRUE;
end;
{=====================================}
function DoSaveAs;
var
dlgOrigin: Point;
theReply: SFReply;
resultCode: OSErr;
theInfo: FInfo;
begin
DoSaveAs := FALSE;
if (fileIsOpen) then
begin
if (not DoClose) then
Exit(DoSaveAs);
end;
SetPt(dlgOrigin, dlgLeft + rightOffset + 20, dlgTop + downOffset);
SFPutFile(dlgOrigin, 'Name for house:', '', nil, theReply);
with theReply do
begin
if (not good) then
Exit(DoSaveAs);
volumeNumber := vRefNum;
resultCode := GetFInfo(fName, vRefNum, theInfo);
case resultCode of
NoErr:
if (theInfo.fdType <> 'GLhs') then
begin
GenericAlert(kErrFileExists);
Exit(DoSaveAs);
end;
FNFErr:
begin
resultCode := Create(fname, vRefNum, 'GLed', 'GLhs');
if (IOCheck(resultCode) <> 0) then
Exit(DoSaveAs);
end;
otherwise
begin
GenericAlert(resultCode);
Exit(DoSaveAs);
end;
end; {end - case}
{SetCursor- watch}
housesName := fName;
if (thisHouse.firstFile = '') then
thisHouse.firstFile := housesName;
GetDateTime(thisHouse.timeStamp);
if (not lockIt) then
thisHouse.timeStamp := -thisHouse.timeStamp;
SpinBall;
resultCode := FSOpen(fName, vRefNum, fileNumber);
if (IOCheck(resultCode) <> 0) then
Exit(DoSaveAs);
if (not WriteFile(fileNumber, vRefNum)) then
begin
InitCursor;
Exit(DoSaveAs);
end;
InitCursor;
end; {end - with}
fileIsOpen := TRUE;
EnableItem(GetMenu(mFile), iSave);
DoSaveAs := TRUE;
end;
{=====================================}
function DoSave;
var
resultCode: OSErr;
begin
DoSave := FALSE;
if ((housesName = 'untitled') and (not fileIsOpen)) then
begin
if (not DoSaveAs) then
Exit(DoSave);
end
else
begin
GetDateTime(thisHouse.timeStamp);
if (not lockIt) then
thisHouse.timeStamp := -thisHouse.timeStamp;
if (not WriteFile(fileNumber, volumeNumber)) then
begin
InitCursor;
Exit(DoSave);
end;
InitCursor;
end;
DoSave := TRUE;
end;
{=================================}
function DoClose;
var
resultCode: OSErr;
begin
DoClose := FALSE;
if (fileIsOpen) then
begin
resultCode := FSClose(fileNumber);
if (IOCheck(resultCode) <> 0) then
Exit(DoClose);
resultCode := FlushVol(nil, volumeNumber);
if (IOCheck(resultCode) <> 0) then
Exit(DoClose);
EnableItem(GetMenu(mFile), 1);
EnableItem(GetMenu(mFile), 2);
DisableItem(GetMenu(mFile), 4);
DisableItem(GetMenu(mFile), 5);
DisableItem(GetMenu(mFile), 6);
DisableItem(GetMenu(mFile), 7);
end;
fileIsOpen := FALSE;
housesName := 'untitled';
DoClose := TRUE;
end;
{=====================================}
function SaveNoClose;
const
saveBut = 1;
closeBut = 2;
cancelBut = 6;
var
leaveDlg: Boolean;
theDlgPtr: DialogPtr;
wasPort: GrafPtr;
tempRect: Rect;
cntlType, index, itemHit, tempInt, rightOff, downOff: Integer;
dlgItem: Handle;
{-------------------------}
procedure Redraw;
var
index: Integer;
begin
SetPort(theDlgPtr); {Point to our dialog window}
GetDItem(theDlgPtr, saveBut, cntlType, dlgItem, tempRect);{Get the item handle}
PenSize(3, 3); {Change pen to draw thick default outline}
InsetRect(tempRect, -4, -4); {Draw outside the button by 1 pixel}
FrameRoundRect(tempRect, 16, 16); {Draw the outline}
PenNormal;
end;
{-------------------------}
begin
GetPort(wasPort);
theDlgPtr := GetNewDialog(saveNoCloseID, nil, Pointer(-1));
with theDlgPtr^.portBits do
begin
rightOff := rightOffset - bounds.left;
downOff := downOffset - bounds.top;
end;
MoveWindow(theDlgPtr, rightOff, downOff, FALSE);
ShowWindow(theDlgPtr);
SelectWindow(theDlgPtr);
SetPort(theDlgPtr);
Redraw;
leaveDlg := FALSE;
repeat
ModalDialog(nil, itemHit);
GetDItem(theDlgPtr, itemHit, cntlType, dlgItem, tempRect);
if (itemHit = saveBut) or (itemHit = closeBut) or (itemHit = cancelBut) then
begin
SaveNoClose := itemHit;
leaveDlg := TRUE;
end;
until leaveDlg;
DisposDialog(theDlgPtr);
if (toolWndo <> nil) then
SetPort(toolWndo)
else
SetPort(wasPort);
end;
{=====================================}
function SaveFirst;
const
saveBut = 1;
quitBut = 2;
cancelBut = 6;
var
leaveDlg: Boolean;
theDlgPtr: DialogPtr;
wasPort: GrafPtr;
tempRect: Rect;
cntlType, index, itemHit, tempInt, rightOff, downOff: Integer;
dlgItem: Handle;
{-------------------------}
procedure Redraw;
var
index: Integer;
begin
SetPort(theDlgPtr); {Point to our dialog window}
GetDItem(theDlgPtr, saveBut, cntlType, dlgItem, tempRect);{Get the item handle}
PenSize(3, 3); {Change pen to draw thick default outline}
InsetRect(tempRect, -4, -4); {Draw outside the button by 1 pixel}
FrameRoundRect(tempRect, 16, 16); {Draw the outline}
PenNormal;
end;
{-------------------------}
begin
GetPort(wasPort);
theDlgPtr := GetNewDialog(saveNoQuitID, nil, Pointer(-1));
with theDlgPtr^.portBits do
begin
rightOff := rightOffset - bounds.left;
downOff := downOffset - bounds.top;
end;
MoveWindow(theDlgPtr, rightOff, downOff, FALSE);
ShowWindow(theDlgPtr);
SelectWindow(theDlgPtr);
SetPort(theDlgPtr);
Redraw;
leaveDlg := FALSE;
repeat
ModalDialog(nil, itemHit);
GetDItem(theDlgPtr, itemHit, cntlType, dlgItem, tempRect);
if (itemHit = saveBut) or (itemHit = quitBut) or (itemHit = cancelBut) then
begin
SaveFirst := itemHit;
leaveDlg := TRUE;
end;
until leaveDlg;
DisposDialog(theDlgPtr);
if (toolWndo <> nil) then
SetPort(toolWndo)
else
SetPort(wasPort);
end;
{=================================}
procedure SavePrefs;
type
prefType = record
resName: string[32];
controlIs: Integer;
leftIs, rightIs, energyIs, bandIs: Integer;
buttonIs, restoreIs: Boolean;
leftNameIs, rightNameIs, energyNameIs, bandNameIs: string[12];
isKeyBoard: Integer;
end;
prefPtr = ^prefType;
prefHand = ^prefPtr;
var
theirPrefs: prefHand;
theErr: OSErr;
volName: Str255;
begin
UseResFile(editorResNum);
theirPrefs := prefHand(NewHandle(SIZEOF(prefType)));
if (theirPrefs <> nil) then
HLock(Handle(theirPrefs))
else
begin
GenericAlert(kErrSavingPrefs);
Exit(SavePrefs);
end;
Handle(theirPrefs) := GetResource('Gprf', 128);
if ((ResError = noErr) and (theirPrefs <> nil)) then
with theirPrefs^^ do
begin
resName := resourceName;
controlIs := controlMethod;
leftIs := leftKey;
rightIs := rightKey;
energyIs := energyKey;
bandIs := bandKey;
buttonIs := buttonFires;
restoreIs := restoreColor;
leftNameIs := leftName;
rightNameIs := rightName;
energyNameIs := energyName;
bandNameIs := bandName;
isKeyBoard := herKeyBoard;
end
else
begin
GenericAlert(kErrSavingPrefs);
Exit(SavePrefs);
end;
ChangedResource(Handle(theirPrefs));
WriteResource(Handle(theirPrefs));
if (ResError <> noErr) then
begin
if ((ResError = FLckdErr) or (ResError = VLckdErr) or (ResError = WPrErr)) then
GenericAlert(kErrSavingPrefs)
else
GenericAlert(ResError);
end;
HUnlock(Handle(theirPrefs));
ReleaseResource(Handle(theirPrefs));
end;
{=================================}
end.