-
Notifications
You must be signed in to change notification settings - Fork 1
/
DreamIO.p
1238 lines (1138 loc) · 36.8 KB
/
DreamIO.p
1
Unit DreamIO;(***GESTISCE Tutte le funzioni del menu file (open, save, save as, page setup, print, quit) Gli eventi Apple Caricamento e proiezione QuickTime ***) InterfaceUses Types, QuickDraw, Files;PROCEDURE IOInit;{ Inizializza la unit }FUNCTION IOShutdown: BOOLEAN;{ Se il gioco non stato salvato prima di uscire, invita autonomamente l'utente asalvare. Se l'utente sceglie di proseguire con l'uscita restituisce TRUE, se scegliedi abortire il processo di terminazione restituisce FALSE. Comunque sia il proces-so di salvataggio trasparente al chiamante }PROCEDURE DoSaveGame (saveAs: BOOLEAN);{ Chiamata quando l'utente sceglie SAVE dal menu FILE. Passare TRUE se l'utente sceglieSAVE AS, oppure FALSE se sceglie un semplice SAVE. Gestisce trasparentemente il casoin cui questo il primo salvataggio e bisogna scegliere un nome. }PROCEDURE DoLoadGame;{ Nel codice principale mi posso trovare di fronte a una serie di condizioni pi o meno aberranti. 1. L'applicazione viene lanciata con doppio click: non ho n scenario n savegame 2. L'applicazione viene lanciata avviando uno scenario: non ho savegame 3. Uno scenario termina: ho un savegame valido, ma non uno scenario. 4. L'utente sceglie "open" dal menu File. SI NOTI CHE tutti gli eventi Apple sono gestiti qui in modo trasparente all'applica- zione. Nel primo e quarto caso l'applicazione chiama DoLoadGame. Io mi limito a proporre uno standard open al giocatore: se mi trova un savegame file, bene, altrimenti mi apre uno scenario e io creo un nuovo savegame vuoto (via DoNewGame). Nel secondo caso compito dell'applicazione chiamare direttamente DoNewGame. Nel terzo caso, l'applicazione pu˜ chiamare DoSwitchScenario }PROCEDURE DoSwitchScenario;PROCEDURE LoadAndShowQuickTime (path: String);{ Carica, proietta, e scarica, il fimato QuickTime di cui viene passato ilpath RELATIVO a quello dello scenario. }Function ScenarioIsThreeD (myScenario: FSSpec): Boolean;VAR { Il motore 3D stato inizializzato? } gThreeDInited: Boolean;ImplementationUses Appearance, AppleEvents, Controls, Errors, Events, Memory, OSUtils, Resources, SegLoad, TextEdit, TextUtils, { List 3 - needs List 1/2 types } Aliases, { (3.2) needs Memory } AppleTalk, { needs OSUtils } Notification, { needs OSUtils } Processes, { (3.2) needs Events } Windows, { needs Events, Controls } { List 4 } Dialogs, { needs TextEdit, Windows } Finder, Folders, { (3.2) needs Files } Lists, PPCToolBox, { (3.2) needs AppleTalk } StandardFile, { (3.2) needs Aliases } EPPC, { (3.2) needs Events, PPCToolBox, Processes } Printing, { needs Dialogs } Components, Movies, ObjIntf, MoreFilesExtras, DialogLord4, Cilindro, Lista3, TaskMaster3, BinIO, DreamTypes, LowLevel, Engine3D, GraphEngine, HiLevel, DreamMonsters, Characters;CONST { AppleEvents - Messages to InternalODOCPDOC via Refcon } kOpenTheseRefcon = 0; kPrintTheseRefcon = 1; { AppleEvents - Dream Suite } kDreamEventClass = 'Drim'; kAEMovePlayerN = 'N '; kAEMovePlayerNE = 'NE '; kAEMovePlayerNW = 'NW '; kAEMovePlayerE = 'E '; kAEMovePlayerSE = 'SE '; kAEMovePlayerS = 'S '; kAEMovePlayerSW = 'SW '; kAEMovePlayerW = 'W '; kAEStand = 'Stil'; kAESearch = 'Look'; kAEBattleOrder = 'Ordr'; kAERest = 'Rest'; kAECast = 'Cast'; kAEWait = 'Wait';VAR { File specificato dal giocatore (con Save As) sul quale salvare } playerSaveGameFile: FSSpec;{$S LowLevel}PROCEDURE LoadAndShowQuickTime (path: String);CONST rMovieNotFound = 154; rMovieError = 155;VAR movieFSS: FSSpec; err: OSErr; justTheOKButton: Family; wasChanged: boolean; { Restituito da QuickTime } moovResName: stringPtr; { Restituito da QuickTime } resRef, { Zero (for "no resource in particular") - VAR parm } movieRef, { L'equivalente QuickTime di un FSSpec } dummy: Integer; movieAborted: Boolean; myMovie: Movie; tipoFigura: ResType; wRect: rect; finestra: WindowPtr; PROCEDURE AbortMovie (killMovie: Boolean; err: OSErr); BEGIN IF err <> noErr THEN BEGIN ParamText (path, IToS (err), '', ''); dummy := AlertLord (rMovieError, 1, justTheOKButton); END; IF killMovie THEN BEGIN StopMovie(myMovie); DisposeMovie (myMovie); myMovie := NIL; END; SetPort (mainWindow); DisposeWindow (finestra); finestra := NIL; Exit (LoadAndShowQuickTime) END;BEGIN IF gQuickTimeIsOn THEN BEGIN { Prepara l'alert, just in case } ClearFamily (justTheOKButton); justTheOKButton[kStdOkItemIndex] := TRUE; { 1. Risolvi il path in un FSS } err := FSMakeFSSpec(currentScenarioFile.FSS.vRefNum, currentScenarioFile.FSS.parID, path, { Il path relativo a quello dello scenario } movieFSS); ParamText (path, IToS (err), '', ''); CASE err OF fnfErr: BEGIN dummy := AlertLord (rMovieNotFound, 1, justTheOKButton); Exit (LoadAndShowQuickTime) END; noErr: ; OTHERWISE BEGIN dummy := AlertLord (rMovieError, 1, justTheOKButton); Exit (LoadAndShowQuickTime) END END; { case } { 2. Carica il filmato } tipoFigura := 'MooV'; myMovie := NIL; SetRect (wRect, 0, 30, 320, 270); { Verrˆ fatto un resize ove necessario } finestra := NewCWindow(NIL, wRect, '', FALSE, altDBoxProc, WindowPtr(-1), TRUE, 0); IF finestra = NIL THEN Exit (LoadAndShowQuickTime); SetPort (finestra); { Comunica a QuickTime qual il movie da eseguire } err := OpenMovieFile (movieFSS, movieRef, fsRdPerm); IF err <> noErr THEN AbortMovie (FALSE, err); { Innesca il meccanismo QuickTime } resRef := 0; { devo passare zero ma VAR } moovResName := NIL; err := NewMovieFromFile (myMovie, movieRef, resRef, moovResName, newMovieActive, wasChanged); IF err <> noErr THEN AbortMovie (FALSE, err); err := CloseMovieFile(movieRef); { Don't know how to handle err } { Scopri che dimensioni sono richieste per il movie } GetMovieBox (myMovie, wRect); err := GetMoviesError; IF err <> noErr then AbortMovie (TRUE, err); OffsetRect(wRect, -wRect.left, -wRect.top); SetMovieBox(myMovie, wRect); err := GetMoviesError; IF err <> noErr then AbortMovie (TRUE, err); if (wRect.right <= wRect.left) or (wRect.bottom <= wRect.top) then SetRect (wRect, 0, 0, 159, 119); SizeWindow (finestra, wRect.right, wRect.bottom, FALSE); { Sposta il rettangolo stabilito in centro allo schermo } OffsetRect (wRect, (qd.screenBits.bounds.right - wRect.right) div 2, (qd.screenBits.bounds.bottom - wRect.bottom) div 2); { Metti l“ la finestra } MoveWindow (finestra, wRect.left, wRect.top, FALSE); ShowWindow (finestra); SelectWindow (finestra); SetPort(finestra); { Make our window the current port } { Pronuncia qualche parola magica per il GWorld di turno } SetMovieGWorld (myMovie, CGrafPtr (finestra), nil); err := GetMoviesError; IF err <> noErr then AbortMovie (TRUE, err); { Riavvolgi il film... } GotoBeginningOfMovie (myMovie); err := GetMoviesError; IF err <> noErr then AbortMovie (TRUE, err); { Informa QuickTime che stiamo per partire } err := PrerollMovie (myMovie, 0, 1); if err <> noErr then AbortMovie (TRUE, err); { 3. Proietta il filmato } StartMovie (myMovie); REPEAT MoviesTask (myMovie, 0); err := GetMoviesError; movieAborted := CommandPeriod OR { mela-punto per terminare? } (err <> noErr); UNTIL movieAborted OR IsMovieDone (myMovie); { 4. Shutdown } AbortMovie (TRUE, 0) END;END;{$S LowLevel}FUNCTION MyGotRequiredParams (theAE: AppleEvent): OSErr;{ IM VI pag. 6-47 }VAR returnType: DescType; sz: Size; err: OSErr;BEGIN err := AEGetAttributePtr (theAE, keyMissedKeywordAttr, typeWildCard, returnType, nil, 0, sz); if err = errAEDescNotFound THEN MyGotRequiredParams := noErr ELSE IF err = noErr THEN MyGotRequiredParams := errAEEventNotHandled ELSE MyGotRequiredParams := errEND;{$S LowLevel}FUNCTION FSSDifferent (fss1, fss2: FSSpec): Boolean; BEGIN WITH fss1 DO FSSDifferent := (vrefnum <> fss2.vrefnum) | (parid <> fss2.parid) | (name <> fss2.name) END;{$S LowLevel}FUNCTION CanDoLoad: IoResult;CONST rWantSaveAlert = 134; kYes = 1; kCancel = 2; kNo = 3;VAR result: IoResult; action: Str255; allButtons: Family;BEGIN { C' un gioco in corso non salvato? } result := allRight; { Salvo contrordine posso caricare } IF dirty & (numPC > 0) THEN BEGIN DoSoundAsync (sndAttention); IF gQuit THEN GetIndString(action, rUserIntfStrings, kQuitting) ELSE GetIndString(action, rUserIntfStrings, kLoadingNewGame); ParamText (action, '', '', ''); ClearFamily (allButtons); allButtons[kYes] := TRUE; allButtons[kNo] := TRUE; allButtons[kCancel] := TRUE; CASE AlertLord (rWantSaveAlert, 3, allButtons) OF kYes: DoSaveGame (FALSE); { Salva, poiÉ } kNo: ; { carica senza far nulla } kCancel: result := userCancel; { Non caricare } END; { case } END; { if } { Se apro un altro gioco, chiudo prima il precedente } IF result = allRight THEN dirty := FALSE; { Se passo di nuovo di qui, so che posso procedere } CanDoLoad := resultEND;{$S LowLevel}PROCEDURE CreateNewEmptyTempSaveFile;{ Crea nella cartella Temporary Items un file col quale giocare.In questo modo il gioco pu˜ iniziare senza problemi. Questo fileviene copiato sul file specificato dal giocatore quando avvieneun save. }VAR foundVRefNum: Integer; foundDirID: Longint; newFile: FSSpec; tempFileName: StringHandle; err: OSErr;BEGIN tempFileName := GetString (rNameOfTempFile); err := FindFolder(kOnSystemDisk,kTemporaryFolderType, TRUE, foundVRefNum,foundDirID); IF (tempFileName <> NIL) & (err = noErr) THEN BEGIN err := FSMakeFSSpec(foundVRefNum,foundDirID,tempFileName^^,newFile); CASE err OF noErr, fnfErr: BEGIN RewriteRByFSS (currentSavegameFile, newFile, fileTypeSavegame, fileTypeAppl); { Open file to save into } IF currentSavegameFile.errore <> noErr THEN DeathAlert (errCantSaveGame, currentSavegameFile.errore); END; OTHERWISE DeathAlert (errCantSaveGame, err) END; { case } END { if no err } ELSE DeathAlert (errCantSaveGame, err)END;{$S LowLevel}FUNCTION IOShutdown: BOOLEAN;BEGIN IF CanDoLoad = allRight THEN BEGIN { In teoria dovrei testare anche failedAbort, ma non possibile che CanDoLoad lo restituisca } IOShutdown := TRUE; Close (currentSavegameFile); { Non lo cancello per pigrizia } Close (currentScenarioFile); END ELSE BEGIN gQuit := FALSE; IOShutdown := FALSE ENDEND;{$S LowLevel}FUNCTION CheckError (theError: OSErr; recoverable: Boolean): IoResult;{ Se avvenuto un errore notifica l'utente, e poi esce al chiamantesolo se l'errore non fatale. Restituisce true se c' errore }BEGIN CASE theError OF memFullErr: DeathAlert (errOutOfMemory, memFullErr); ioErr: IF recoverable THEN BEGIN NewErrorAlert (kAlertStopAlert, errCantSaveGame, ioErr); CheckError := failedRetry END ELSE DeathAlert (errCantLoadGame, ioErr); dskFulErr: BEGIN NewErrorAlert (kAlertStopAlert, errDiskIsFull, dskFulErr); CheckError := failedContinue END; permErr: BEGIN NewErrorAlert (kAlertStopAlert, errFileLocked, permErr); CheckError := failedRetry END; eofErr: BEGIN NewErrorAlert (kAlertStopAlert, errSavegameDamaged, eofErr); CheckError := failedRetry END; noErr : CheckError := allRight; OTHERWISE IF recoverable THEN BEGIN NewErrorAlert (kAlertCautionAlert, kStandardErr, theError); CheckError := failedContinue END ELSE DeathAlert (kStandardErr, theError); END; { case }END;{$S LowLevel}FUNCTION KernelSave: IoResult;{ Salva il gioco nel file currentSavegameFile.FSS }VAR i: Integer; l: Longint; result: IoResult; aSavedChar: TPersonaggio; PROCEDURE InnerCheck; BEGIN result := CheckError (currentSavegameFile.errore, TRUE); IF result < allRight THEN BEGIN KernelSave := result; Exit (KernelSave) END END; BEGIN { Devo salvare la risorsa del place corrente, o perder˜ le ultime scoperte. } IF placeDirty THEN BEGIN DetachResource(currentPlaceHandle); { Serve nel caso in cui fosse ancora parte dello scenario } WriteRes (currentSavegameFile, placeID, resPlace, '', currentPlaceHandle); placeDirty := FALSE END; { Rewind to start of file } MoveMark (currentSavegameFile, fsFromStart, 0); InnerCheck; { Salva il numero di versione di questo Dream e del formato di file } WriteInt (currentSavegameFile, kCurrentDreamVersion); InnerCheck; WriteInt (currentSavegameFile, kCurrentFileFormatVersion); { Salva il nome dello scenario che sto giocando } WriteLn (currentSavegameFile, currentScenarioFile.FSS.name); { Salva lo stack delle locazioni } WriteInt (currentSavegameFile, locationStackPointer); l := sizeof (TLocationStack); PtrWrite (currentSavegameFile, l, @locationStack); { Salva lo ID del place dove mi trovo } WriteInt (currentSavegameFile, placeID); { Salva le coordinate del punto dove mi trovo } IF groupX > 0 THEN BEGIN WriteInt (currentSavegameFile, groupX); WriteInt (currentSavegameFile, groupY) END ELSE BEGIN { Per il caso di salvataggio prima che l'inizializzazione sia completa } WriteInt (currentSavegameFile, 2); WriteInt (currentSavegameFile, 2) END; { Salva data, ora e status del gioco } WriteInt (currentSavegameFile, ora); WriteInt (currentSavegameFile, giorno); WriteInt (currentSavegameFile, artificialLight); WriteInt (currentSavegameFile, lightRange); WriteInt (currentSavegameFile, dayOfLastRest); { Salva il numero di personaggi } WriteInt (currentSavegameFile, numPC); InnerCheck; { Salva i personaggi con relativo equipaggiamento } FOR i := 0 TO numPC-1 DO BEGIN Mondo[i].Save (currentSavegameFile); IF Mondo[i].v11.hasOpenWindow THEN WriteInt (currentSavegameFile, TMGetWRefCon (Mondo[i].charWindow, kRefConForPage)) END; { New for v 1.3. NPC Data } WITH npcData DO BEGIN WriteInt (currentSavegameFile, placeForExit); WriteInt (currentSavegameFile, talkOnExit); WriteInt (currentSavegameFile, nctrForExit); END; IF Mondo[kNPCReference] = NIL THEN WriteInt (currentSavegameFile, 0) ELSE BEGIN WriteInt (currentSavegameFile, 1); Mondo[kNPCReference].Save (currentSavegameFile); IF Mondo[kNPCReference].v11.hasOpenWindow THEN WriteInt (currentSavegameFile, TMGetWRefCon (Mondo[kNPCReference].charWindow, kRefConForPage)) END; { Ammontare in banca } WriteLongint (currentSaveGameFile, geInBank); { Lista dei personaggi in locanda } aSavedChar := listaPersInLocanda; WHILE aSavedChar <> NIL DO BEGIN WriteInt (currentSaveGameFile, 1); { Indica che segue un pers. } aSavedChar.Save (currentSaveGameFile); aSavedChar := aSavedChar.nextChar END; WriteInt (currentSaveGameFile, 0); { Indica che sono finiti } { New for v2: save 3D location, if any } IF placeKind = threeD THEN Engine3D_SaveData (placeID); { Prendi nota del fatto che ora la situazione sicura } InnerCheck; dirty := FALSE;END;{$S LowLevel}FUNCTION KernelLoad: IoResult;var myFileList: SFTypeList; myReply: StandardFileReply; saveFileVersion: INTEGER; scenarioFSS: FSSpec; p: point; l: Longint; i, j: Integer; allChars: EntityRef; inInn: TPersonaggio; scenarioName: string; result: IoResult; sanityRect: rect; sanityPoint: Point; DEBUG: Ptr; PROCEDURE CheckFailure (forceFailure: Boolean); BEGIN IF NOT forceFailure THEN result := CheckError (currentSavegameFile.errore, TRUE); IF result < allRight THEN BEGIN Close (currentSavegameFile); Close (currentScenarioFile); KernelLoad := result; Exit (KernelLoad) END END; FUNCTION CharLoad (whichOne: EntityRef): TPersonaggio; VAR aLoadedChar: TPersonaggio; BEGIN aLoadedChar := NIL; New (aLoadedChar); FailNIL (aLoadedChar); aLoadedChar.Load (currentSavegameFile, saveFileVersion); CheckFailure (FALSE); IF whichOne <> kNoPCSelected THEN BEGIN { Se va infilato nel mondo, metticelo } Mondo[whichOne] := aLoadedChar; IF aLoadedChar.v11.hasOpenWindow = TRUE THEN BEGIN aLoadedChar.charWindow := CreateCharWindow (whichOne); { A che pagina era aperta la finestra? } ReadInt (currentSavegameFile, j); FlipPage (aLoadedChar.charWindow, aLoadedChar, j) END END; gActiveChars := gActiveChars OR NOT aLoadedChar.status[IsDead]; CursorAnimate; CharLoad := aLoadedChar END;BEGIN MoveMark (currentSavegameFile, fsFromStart, 0); CheckFailure (FALSE); { Numero di versione di questo Dream e del formato di file } ReadInt (currentSavegameFile, saveFileVersion); CheckFailure (FALSE); ReadInt (currentSavegameFile, saveFileVersion); { Riesco a comprendere questo formato di file? } { QUESTO POTRË ESSERE TOLTO PRESTO. IL FORMATO 1.1 é STATO USATO SOLO IN BETA } IF (saveFileVersion = 110) | (saveFileVersion < kMinimumFileFormatUnderstood) THEN BEGIN NewErrorAlert (kAlertStopAlert, errNoBetaPlease, 0); result := failedRetry; CheckFailure (TRUE); END; { Controllo "serio" } IF (saveFileVersion > kGreatestFileFormatUnderstood) THEN BEGIN NewErrorAlert (kAlertStopAlert, errSavegameTooRecent, 0); result := failedRetry; CheckFailure (TRUE); END; { Leggi il nome dello scenario che sto giocando, poi cerca di caricarlo } ReadLn (currentSavegameFile, scenarioName); CheckFailure (FALSE); { Se ha caricato un savefile vuoto, senza personaggi, ottiene scenarioName vuoto. In tal casoÉ (new for v1.1 } IF scenarioName = '' THEN BEGIN NewErrorAlert (kAlertStopAlert, errSavegameEmpty, eofErr); KernelLoad := failedRetry; Exit (KernelLoad) END; IF FsMakeFSSpec (0, 0, scenarioName, scenarioFSS) <> noErr THEN BEGIN ParamText (scenarioName, '', '', ''); myFileList[0] := fileTypeScenario; myFileList[1] := fileTypeScenario3D; p.v := -1; p.h := -1; InitCursor; CustomGetFile (nil, 2, @myFileList, myReply, customGetFileDITL, p, NIL, NIL, NIL, NIL, NIL); IF NOT myReply.sfGood THEN BEGIN gQuit := TRUE; result := failedContinue; { Esce subito dopo perchŽ gQuit = TRUE } CheckFailure (TRUE); END; { Copia lo FSS cos“ trovato nella variabile dove DoLoadScenario se l'aspetta } scenarioFSS := myReply.sfFile; CursorInit END; { carica lo scenario } REPEAT result := DoLoadScenario (@scenarioFSS) UNTIL result <> failedRetry; IF result <> allRight THEN BEGIN gQuit := TRUE; result := failedContinue; { Esce subito dopo perchŽ gQuit = TRUE } CheckFailure (TRUE); END; (* QUESTO CODICE PER QUALCHE STRANISSIMO MOTIVO FALLISCE. DURANTE UNA DELLE NUMEROSE PROVE HO SCOPERTO CHE IL SEGUENTE CODICE, INSERITO PER FARE DEBUGGING, PROVOCA RISPOSTE CORRETTE, E L'HO LASCIATO SUL POSTO { Carica lo stack delle locazioni } ReadInt (currentSavegameFile, locationStackPointer); *) l := 2; PtrRead (currentSavegameFile, l, @locationStackPointer); l := sizeof (TLocationStack); DEBUG := @locationStack[1]; DEBUG := @locationStack[2]; DEBUG := @locationStack[10]; l := (longint(StripAddress (@locationStack[2])) - longint(StripAddress (@locationStack[1]))) * 10; PtrRead (currentSavegameFile, l, @locationStack); { ID del place dove mi trovo } ReadInt (currentSavegameFile, placeID); { Coordinate del punto dove mi trovo } ReadInt (currentSavegameFile, groupX); ReadInt (currentSavegameFile, groupY); { Data, ora e status del gioco } ReadInt (currentSavegameFile, ora); ReadInt (currentSavegameFile, giorno); ReadInt (currentSavegameFile, artificialLight); ReadInt (currentSavegameFile, lightRange); ReadInt (currentSavegameFile, dayOfLastRest); { Numero di personaggi } ReadInt (currentSavegameFile, numPC); CheckFailure (FALSE); { Crea i personaggi con relativo equipaggiamento } gActiveChars := FALSE; FOR allChars := 0 TO numPC-1 DO Mondo [allChars] := CharLoad (allChars); { Se ce n' almeno uno vivo, abilita il menu Gruppo } IF gActiveChars THEN CharsHere; { New for v1.3. NPCs } IF saveFileVersion >= 130 THEN WITH npcData DO BEGIN ReadInt (currentSavegameFile, placeForExit); ReadInt (currentSavegameFile, talkOnExit); ReadInt (currentSavegameFile, nctrForExit); { Is there an NPC in the group? } ReadInt (currentSavegameFile, i); IF i > 0 THEN Mondo [kNPCReference] := CharLoad (kNPCReference) END; { Soldi in banca } ReadLongint (currentSaveGameFile, geInBank); CursorAnimate; { v 1.2 e successive: carica la lista dei personaggi in locanda } listaPersInLocanda := NIL; { Bug fix 2.1 } IF saveFileVersion >= 120 THEN { Personaggi in locanda } REPEAT ReadInt (currentSaveGameFile, i); IF i > 0 THEN BEGIN inInn := CharLoad (kNoPCSelected); inInn.nextChar := listaPersInLocanda; listaPersInLocanda := inInn END; CursorAnimate; UNTIL i = 0; { Ecco un twist interessante. Inevitabilmente lo scenario viene aperto dopo il savegame file, perchŽ il suo nome sta dentro il savegame file. Per˜ a me serve che il savegame venga dopo lo scenario nella catena di ricerca del resource manager, di modo che venga eseguito un override delle risorse. Quindi devo fare un po' di giochi di prestigio. } WITH currentSavegameFile DO BEGIN CloseResFile (resFork); { ChiudiloÉ } resFork := FSpOpenResFile (FSS, fsCurPerm); { e riaprilo! } END; CursorAnimate; { Adesso posso permettermi di fare DoLoadPlace. Se per˜ facessi un semplice DoLoadPlace (placeID, '5'); il posto dove mi trovo finirebbe sullo stack come predecessore di se stesso. Pertanto, prima salvo la posizione del gruppoÉ } i := groupX; j := groupY; { Poi chiamo DoPlaceLoad con groupX = 0 - In qs. modo DoLoadPlace non fa push } groupX := 0; DoLoadPlace (placeID, '5'); { Infine ripristino i valori corretti } groupX := i; groupY := j; { New for v2: reload 3D location, if any } IF placeKind = threeD THEN Engine3D_LoadData (placeID); { Controllo di sanitˆ, new for v2.1 } WITH sanityRect DO BEGIN top := 1; left := 1; right := placeW+1; { QD non considera (2,2) dentro al rettangolo (1, 1, 2, 2) } bottom := placeH+1 END; WITH sanityPoint DO BEGIN h := groupX; v := groupY END; IF NOT PtInRect (sanityPoint, sanityRect) THEN BEGIN NewErrorAlert (kAlertStopAlert, errCantLoadGame, 8664); KernelLoad := failedRetry; Exit (KernelLoad) END; dirty := FALSE; { Normalizza il display } SetPort (mainWindow); InvalRect (mainWindow^.portRect); KernelLoad := allRightEND;{$S LowLevel}PROCEDURE CopyAllRes (from, dest: MyFile);{ Copia tutte le risorse che si trovano nel primo file dentro il secondo, e anchetutti i dati del ramo dati. Entrambi i file devono esistere ed essere giˆstati aperti. }VAR size: Longint; { of copied data } oneRes: Handle; { Handle to the copied data } resForkID: Integer; { For copying resources }BEGIN { Risorse } { La copia avviene a basso livello. Se copiassi ad alto livello (cio risorsa per risorsa) ci metterei di pi e rischierei di deallocare qualche risorsa in uso. Per esempio quando il file sorgente il gioco in corso deallocherei la handle al current place } size := 1024; { Buffer di lettura/scrittura } oneRes := NewHandle (1024); HLock (oneRes); { 1. posso aprire in sola lettura un ramo risorse giˆ in uso! } from.errore := FSpOpenRF (from.FSS, fsRdPerm, resForkID); { 2. Non posso aprirlo in scirttura, invece, ma poco importa perchŽ sto per sovrascrivere, quindi prima chiuso l'esistente e poi lo sovrascrivo } IF dest.resFork <> 0 THEN CloseResFile (dest.resFork); { ChiudiloÉ } dest.errore := FSpOpenRF (dest.FSS, fsWrPerm, dest.resFork); { Inizia il ciclo di copia } IF (from.errore = noErr) AND (dest.errore = noErr) THEN BEGIN REPEAT from.errore := FSRead (resForkID, size, oneRes^); dest.errore := FSWrite (dest.resFork, size, oneRes^) UNTIL (size < 1024) OR (from.errore <> noErr) OR (dest.errore <> noErr); { Chiudi i due "file" usati } dest.errore := FSClose (dest.resFork); from.errore := FSClose (resForkID); { Apri in lettura il ramo risorse (appena creato) della dest. } dest.resFork := FSpOpenResFile (dest.FSS, fsRdWrPerm); END; { Dati } size := 1024; { Reinizializza il contatore dei byte letti } MoveMark (from, fsFromStart, 0); MoveMark (dest, fsFromStart, 0); REPEAT HandleRead (from, size, oneRes); HandleWrite (dest, size, oneres) UNTIL size < 1024; { Libera il buffer } DisposeHandle (oneRes)END;{$S LowLevel}Function ScenarioIsThreeD (myScenario: FSSpec): Boolean;VAR err: OSErr; myFinfo: FInfo; { Per scoprire se savegame o scenario } result: Boolean;BEGIN { é uno scenario o un savegame file ?} err := FSpGetFInfo (myScenario, myFInfo); IF err = noErr THEN result := (myFInfo.fdType = fileTypeScenario3D) ELSE DeathAlert (1, 0); ScenarioIsThreeD := resultEND;{$S LowLevel}PROCEDURE DoSaveGame (saveAs: BOOLEAN);VAR prompt: Str255; myReply: StandardFileReply; theSaveFile: MyFile;BEGIN { Twist: il place che sto visitando una risorsa, e probabilmente appartiene al vecchio savegame file. Rischio di chiudere il vecchio savegame file, e con esso deallocare la risorsa! Per evitarlo, forzo placeDirty a TRUE. Questo fa s“ che KernelSave esegua un DetachResource della risorsa place dal vecchio savegame file ed esegua un WriteRes sul nuovo savegame file } placeDirty := TRUE; IF saveAs OR (playerSaveGameFile.name = '') THEN BEGIN { Get the prompt for the dialog box } GetIndString(prompt, rUserIntfStrings, kPromptString); StandardPutFile (prompt, playerSaveGameFile.name, myReply); IF myReply.sfGood THEN playerSaveGameFile := myReply.sfFile ELSE Exit (DoSaveGame) END; { Salva sul file temporaneo } REPEAT UNTIL KernelSave <> failedRetry; { Copy temp file to new file } RewriteRByFSS (theSaveFile, playerSaveGameFile, fileTypeSavegame, fileTypeAppl); { Open file to save into } IF theSaveFile.errore = noErr THEN BEGIN CopyAllRes (currentSavegameFile, theSaveFile); Close (theSaveFile) END ELSE NewErrorAlert (kAlertStopAlert, errCantSaveGame, theSaveFile.errore)END;{$S LowLevel}PROCEDURE WarmReboot;BEGIN CursorInit; { Shutdown current scenario } IF currentScenarioFile.resFork <> 0 THEN Close (currentScenarioFile); CursorAnimate; CharactersShutdown; CursorAnimate; HiLevelShutDown; CursorAnimate; { Non eseguo LowLevelShutdown perchŽ serve a privarmi delle risorse hardware allocate, come i canali sonori } { Recreate a new empty world } LowLevelRestart; HiLevelInit; CursorAnimate; CharactersInit; SetPort (mainWindow); { Cancella fisicamente } TMInvalRect (groupRect); { le icone dei vecchi personaggi } EraseRect (groupRect); { le icone dei vecchi personaggi }END;{$S LowLevel}FUNCTION HandleGameLoading (savegame: FSSpec): IoResult;VAR newGamefile: MyFile; result: IoResult; dummy: Integer; justOK: Family;BEGIN { Accettalo solo se scrivibile - bug fix 2.1 } IF (FSpCheckObjectLock (savegame) <> noErr) OR (CheckVolLock (NIL, savegame.vrefNum) <> noErr) THEN BEGIN ClearFamily (justOK); justOK[kStdOkItemIndex] := TRUE; ParamText (savegame.name, '', '', ''); dummy := AlertLord (rAlertWriteProtected, 1, justOK); result := failedRetry; END ELSE result := CanDoLoad; IF result = allRight THEN BEGIN WarmReboot; ResetRByFss (newGameFile, savegame); CopyAllRes (newGameFile, currentSaveGameFile); Close (newGameFile); { Bug fix 1.6 - remember where the player keeps the save file } playerSaveGameFile := savegame; { Ora esegui il caricamento } HandleGameLoading := KernelLoad END ELSE HandleGameLoading := result; { Da CanDoLoad }END;{$S LowLevel}FUNCTION HandleScenarioLoading (scenario: FSSpec): IoResult;{ A uso interno: esegue il caricamento di uno scenario.}VAR result: IoResult;BEGIN result := CanDoLoad; IF result = allRight THEN BEGIN WarmReboot; result := DoLoadScenario (@scenario); IF result = allRight THEN BEGIN DoLoadPlace (1000, '5'); { Ecco un twist interessante. Inevitabilmente lo scenario viene aperto dopo il savegame file, perchŽ il suo nome sta dentro il savegame file. Per˜ a me serve che il savegame venga dopo lo scenario nella catena di ricerca del resource manager, di modo che venga eseguito un override delle risorse. Quindi devo fare un po' di giochi di prestigio. COPIA DI QUESTO CODICE STA IN KERNELLOAD } WITH currentSavegameFile DO BEGIN CloseResFile (resFork); { ChiudiloÉ } resFork := FSpOpenResFile (FSS, fsCurPerm); { e riaprilo! } END; { with } END { if load is ok } END; { if can load } IF result = failedAbort THEN NewErrorAlert (kAlertStopAlert, errScenarioDamaged, 0); HandleScenarioLoading := resultEND; {$S LowLevel}PROCEDURE ClearAllRes (VAR where: MyFile);{ Distrugge tutte le risorse dentro il file GOTCHA - ALLA FINE IL FILE DIVIENE CURRESFILE }VAR perTipi, perID: Integer; { Loop counters } thisType: ResType; { Type of the deleted resource } oneRes: Handle; { Handle to the deleted resource }BEGIN { Garantisci che non resti nessuna risorsa cached in RAM - bug fix 2.0 } Close (where); ReadNWriteRByFSS (where, where.FSS); SetResLoad (FALSE); { Quanti tipi di risorse ci sono qui? } FOR perTipi := Count1Types DOWNTO 1 DO BEGIN Get1IndType (thisType, perTipi); { Get resource type } FOR perID := Count1Resources (thisType) DOWNTO 1 DO BEGIN oneRes := Get1IndResource (thisType, perID); RemoveResource (oneRes); DisposeHandle (oneRes); END; { ciclo sulle risorse } END; { ciclo sui tipi } SetResLoad (TRUE);END;{$S LowLevel}PROCEDURE DoSwitchScenario;CONST rNotAllowedAlert = 153;VAR switchDone: Boolean; dummy: Integer; allButtons: Family; loadResult: IoResult; BEGIN ClearFamily (allButtons); allButtons [kStdOkItemIndex] := TRUE; IF NOT Verifica THEN BEGIN dummy := AlertLord (rNotAllowedAlert, 1, allButtons); gQuit := TRUE; Exit (DoSwitchScenario) END; switchDone := TRUE; ParamText (scenarioName, nomeDesigner, '', ''); allButtons [kStdCancelItemIndex] := TRUE; REPEAT IF AlertLord (rSwitchScenAlert, 2, allButtons) = Ok THEN BEGIN { Dice che vuole giocare ancora. Trova un nuovo scenario } REPEAT loadResult := DoLoadScenario (NIL) UNTIL loadResult <> failedRetry; IF loadResult = allRight THEN BEGIN { DoLoadPlace already closed old scenario } { Too few characters? - bug fix 2.0.1 } IF (minCharNumber > numPC) THEN BEGIN ParamText (ItoS (minCharNumber), IToS (numPC), '', ''); IF AlertLord (rTooFewPCsAlert, 2, allButtons) = kStdCancelItemIndex THEN BEGIN Close (currentScenarioFile); switchDone := FALSE END; { alert } END; { too few } { Too many characters? } IF (maxCharNumber < numPC) THEN BEGIN ParamText (ItoS (numPC), IToS (maxCharNumber), '', ''); IF AlertLord (rTooManyPCsAtSwitch, 2, allButtons) = kStdCancelItemIndex THEN BEGIN Close (currentScenarioFile); switchDone := FALSE END; { alert } END; { too many } IF switchDone THEN BEGIN { Se devo ancora andare avanti e lui non ha abortito... } { Prepara il savegame file all'uso per questo scenario. Ci˜ significa che tutte le risorse ivi contenute, che erano tipiche del vecchio scenario, vanno cancellate } ClearAllRes (currentSavegameFile); groupX := 0; DoLoadPlace (1000, '5'); { Start new scenario } END END ELSE { Prima dice che vuole giocare, poi non trova uno scenario? } switchDone := FALSE END ELSE BEGIN { Non vuole cominciare un nuovo scenario? Beh, allora usciamo! } IF loadResult <> failedAbort THEN DoSaveGame (FALSE); switchDone := TRUE; gQuit := TRUE END; UNTIL switchDoneEND;{$S LowLevel}PROCEDURE DoLoadGame;VAR myFileList: SFTypeList; myReply: StandardFileReply; result: IoResult; scenIsThreeD: Boolean;BEGIN REPEAT result := CanDoLoad; IF result = allRight THEN BEGIN { Specify filetypes which I can read } myFileList[0] := fileTypeScenario; myFileList[1] := fileTypeSavegame; myFileList[2] := fileTypeScenario3D; { PenNormal; Bug fix try 1.6 - get rid of light blue! } BackColor (whiteColor); StandardGetFile (nil, 3, @myFileList, myReply); { Se non possiede nemmeno uno scenario non si pu˜ giocare! } IF myReply.sfGood THEN BEGIN ClearAllRes (currentSavegameFile); { If there was a special menu loaded, unload it } ThisPlaceIsBeingShutdown; { Bug fix 2.0 } scenIsThreeD := (myReply.sfType = fileTypeScenario3D); IF (myReply.sfType = fileTypeScenario) OR scenIsThreeD THEN { Pu˜ fallire se clicca cancel su "non salvato, salvo e cambio?" } result := HandleScenarioLoading (myReply.sfFile) ELSE BEGIN playerSaveGameFile := myReply.sfFile; result := HandleGameLoading (myReply.sfFile); { Puo fallire se trova una vecchia versione. In quel caso gQuit = FALSE. Oppure se clicca cancel su stdOpen. In quel caso gQuit = TRUE } END END ELSE result := userCancel END UNTIL result <> failedRetry END;{$S LowLevel}FUNCTION InternalMove (VAR theAE, reply: AppleEvent; refCon: longint): OSErr;BEGIN {$UNUSED theAE, reply} { Il codice interno della mossa sta in refCon, care of InitAEStuff. Io qui mi mlimito a metterlo nel buffer interno di moveBuffer, donde sarˆ prelevato da MainEventLoop } moveBuffer := concat (moveBuffer, chr (LoWrd (refCon))); InternalMove := noErrEND;{$S LowLevel}FUNCTION InternalOAPP (VAR theAE, reply: AppleEvent; refCon: longint): OSErr;BEGIN {$UNUSED theAE, reply, refCon} InternalOAPP := noErr;END;{$S LowLevel}FUNCTION InternalQUIT (VAR theAE, reply: AppleEvent; refCon: longint): OSErr;BEGIN {$UNUSED theAE, reply, refCon} InternalQUIT := noErr; gQuit := trueEND;{$S LowLevel}Function DoAEOpen( directParam:AEDesc):OSErr; { Bug fix 1.7.1, rubato da Dream II }VAR result, err: OSErr; kw: AEKeyword; { Returned from AEGetNthPtr } typ: DescType; { Returned from AEGetNthPtr } sz: Size; { Returned from AEGetNthPtr } oneFSS: FSSpec; { FSS del file da aprire/stampare } myFinfo: FInfo; { Per scoprire se savegame o scenario } result2: Ioresult; scenIsThreeD: Boolean;BEGIN { Open a file } result := AEGetNthPtr (directParam, 1, typeFSS, kw, typ, @oneFSS, sizeof (oneFSS), sz); { Dispatch } { é uno scenario o un savegame file ?} err := FSpGetFInfo (oneFSS, myFInfo); IF err = noErr THEN BEGIN scenIsThreeD := (myFInfo.fdType = fileTypeScenario3D); IF (myFInfo.fdType = fileTypeScenario) OR scenIsThreeD THEN result2 := HandleScenarioLoading (oneFSS) ELSE { fileTypeSavegame } result2 := HandleGameLoading (oneFSS); IF result2 = failedAbort THEN gQuit := TRUE END; DoAEOpen := result;END;{$S LowLevel}Function HandleAEOpen(VAR theAppleEvent:AppleEvent; VAR theReply:AppleEvent; theRefCon:LONGINT):OSErr; VAR directParam : AEDesc; typeCode : DescType; actualSize : LONGINT; PROCEDURE CleanUp; VAR ignoreOSErr: OSErr; BEGIN IgnoreOSErr := AEDisposeDesc(directParam); END; PROCEDURE FailErr(err:OSErr); BEGIN IF err <> NOErr THEN BEGIN HandleAEOpen := err; CleanUp; Exit(HandleAEOpen); END; END; BEGIN {$UNUSED theReply, theRefCon} directParam.dataHandle := NIL; FailErr(AEGetKeyDesc(theAppleEvent,keyDirectObject,typeWildCard,directParam)); { We check to see if we missed any parameter from the client } IF AESizeOfAttribute(theAppleEvent, keyMissedKeywordAttr, typeCode, actualSize) <> errAEDescNotFound THEN FailErr(errAEParamMissed); FailErr(DoAEOpen(directParam)); CleanUp; HandleAEOpen := NoErr; END;{$S UtilInit}PROCEDURE InstallOneHandler (eventClass, eventID: DescType; routine: AEEventHandlerProcPtr; refConToUse: Integer);VAR myHandler: AEEventHandlerUPP; err: OSErr;BEGIN myHandler := NIL; { Just in case. Ho visto cose buffe nel debugger } myHandler := NewAEEventHandlerProc (routine); err := AEInstallEventHandler (eventClass, eventID, myHandler, refConToUse, FALSE);END;{$S UtilInit}PROCEDURE InitAEStuff;BEGIN InstallOneHandler(kCoreEventClass, kAEOpenApplication,@InternalOAPP, 0); InstallOneHandler(kCoreEventClass, kAEOpenDocuments, @HandleAEOpen, 0); InstallOneHandler(kCoreEventClass, kAEPrintDocuments, @HandleAEOpen, 0); InstallOneHandler(kCoreEventClass, kAEQuitApplication, @InternalQUIT, 0); { Eventi per spostare il giocatore } InstallOneHandler(kDreamEventClass, kAEMovePlayerN, @InternalMove, ord('8')); InstallOneHandler(kDreamEventClass, kAEMovePlayerNE, @InternalMove, ord('9')); InstallOneHandler(kDreamEventClass, kAEMovePlayerNW, @InternalMove, ord('7')); InstallOneHandler(kDreamEventClass, kAEMovePlayerE, @InternalMove, ord('6')); InstallOneHandler(kDreamEventClass, kAEMovePlayerSE, @InternalMove, ord('3')); InstallOneHandler(kDreamEventClass, kAEMovePlayerS, @InternalMove, ord('2')); InstallOneHandler(kDreamEventClass, kAEMovePlayerSW, @InternalMove, ord('1')); InstallOneHandler(kDreamEventClass, kAEMovePlayerW, @InternalMove, ord('4')); InstallOneHandler(kDreamEventClass, kAEStand, @InternalMove, ord('0')); InstallOneHandler(kDreamEventClass, kAESearch, @InternalMove, ord('L')); InstallOneHandler(kDreamEventClass, kAEBattleOrder, @InternalMove, ord('F')); InstallOneHandler(kDreamEventClass, kAERest, @InternalMove, ord('R')); InstallOneHandler(kDreamEventClass, kAECast, @InternalMove, ord('K')); InstallOneHandler(kDreamEventClass, kAEWait, @InternalMove, ord('W'));END;{$S UtilInit}PROCEDURE IOInit;BEGIN CursorAnimate; gThreeDInited := FALSE; { Init eventi apple } CursorAnimate; InitAEStuff; { Init file di lavoro } CursorAnimate; playerSaveGameFile.name := ''; CreateNewEmptyTempSaveFileEND;END. { Unit }