-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathCharacters.p
3374 lines (3144 loc) · 103 KB
/
Characters.p
1
Unit Characters;InterfaceUSES Types, QuickDraw, Controls, Events, IntlResources, Memory, OSUtils, QuickDrawText, SegLoad, { List 3 - needs List 1/2 types } Files, { needs OSUtils, SegLoad } Windows, { List 4 } Lists, Script, ObjIntf, BinIO, Lista3, TaskMaster3, Engine3D, DreamTypes, LowLevel, HiLevel;CONST kMezzanotte = 24*60;TYPE { Nelle versioni 1.0 sino a 1.2 si salvava anche il vettore equipaggiamento, senza alcuno scopo perchŽ un vettore di handle. Dalla versione 1.3 ho aumentato lo spazio a disposizione per gli inc. in memoria. C' ancora un po' da spazio libero. } DatiPersonaggioDaSalvare = RECORD classe: TClasse; livello: Integer; razza: TRazza; eta: Integer; forza, saggezza, costituzione, carisma: Integer; superforza: Integer; height, weight, WA: integer; baseHP: HPArray; XPtoNextLevel, XPForThisLevel, maxXP, XP: longint; formazione: Point; GP: longint; spellsPerLevel: NumSpellsArray; spellsInMemory: MemorizedSpellsArray; knownSpells: KnownSpellsArray; numKnownSpells: Integer; windowIsWide: Boolean; { New for v 2.0 } spareSpace: ARRAY[1..4] OF Integer; { Fill byte, free for use } END; { The following data is defined only in v1.1 } AdditionalCharFields = RECORD hasOpenWindow: Boolean; windowPos: Point; fullIcon: Integer END; TPersonaggio = OBJECT (TCreatura) classe: TClasse; livello: Integer; razza: TRazza; eta: Integer; forza, saggezza, { Intelligenza, destrezza: in TCreatura } costituzione, carisma: Integer; superforza: Integer; height, weight, WA: integer; { weightLoad in TCreatura } baseHP: HPArray; { 0 se non ha ancora attained the level } { MaxHP=HP al pieno, e HP=HP attuali, sono ereditati da TCreatura } XPtoNextLevel, { Quando passer˜ di livello } XPForThisLevel, { XP che avevo quando sono passato di livello l'ultima volta} { (questi servono per la barra che mostro nella finestra } { del personaggio e che gli fa vedere quanta strada ha da fare } maxXP, { XP quando mi hanno fatto level drain } XP: longint; { XP attuali } formazione: Point; { Posizione nella formazione. } GP: longint; { monete con sŽ. Si chiamano "GE", ovvero Golden Eagles } spellsPerLevel: NumSpellsArray; spellsInMemory: MemorizedSpellsArray; knownSpells: KnownSpellsArray; numKnownSpells: Integer; windowIsWide: Boolean; { New for v 2.0 } spareSpace: ARRAY[1..4] OF Integer; { Fill byte, free for use } v11: AdditionalCharFields; equipaggiamento: ARRAY [Storage] OF TItem; nextChar: TPersonaggio; { Usato solo quando sono in locanda per costruire una lista } charWindow: WindowPtr; { Valid only if hasOpenWindow is TRUE - New for v1.1 } listData: ListInfoRec; { OK, fa abbastanza schifo come pulizia di programmazione. Comunque questo sta qui perchŽ uno spellcaster deve avere nella sua finestra la lista degli incantesimi in memoria, e non ho altro posto dove memorizzare i dati di List manager relativi. } PROCEDURE Init (ref: integer); OVERRIDE; PROCEDURE Draw (where: rect; how: INTEGER); OVERRIDE; { Per gestire le icone speciali per il combattimento. Il chiamante mi passa uno how or-ed con $8000 per segnalare che debbo usare una icona a figura piena } FUNCTION Kill: boolean; OVERRIDE; FUNCTION Move: Char; OVERRIDE; FUNCTION Time (amountInMin: integer): boolean; OVERRIDE; PROCEDURE InitFromRes (ref: Integer); { Carica i dati da una risorsa } PROCEDURE Save (dest: MyFile); OVERRIDE; PROCEDURE Load (source: MyFile; version: Integer); OVERRIDE; PROCEDURE Free; OVERRIDE; { Distrugge gli oggetti posseduti } FUNCTION Clone: TObject; OVERRIDE; { Crea una copia } END; VAR { Object data management. Un mega-vettore, Mondo, contiene riferimenti a tutti i personaggi. Una volta assegnato a uno specifico posto, il personaggio non sarˆ pi spostato. Il riempimento del vettore viene effettuato dall'inizio verso la fine. } Mondo: ARRAY[EntityRef] OF TPersonaggio; { Everybody is here! } numPC: INTEGER; { Stack-pointer like. First free place } { Lista dei personaggi che sono in qualche locanda. All'interno di ogni personaggio, whereAmI.h ha lo ID della locanda. } listaPersInLocanda: TPersonaggio; gCharSelected: INTEGER; { Identificatore nel mondo del personaggio selezionato } geInBank, { Quantitˆ di monete d'oro in banca } lastMove: longint; { last time user moved } dayOfLastRest: INTEGER; { last time group rested } gRoamingCount: Integer; { Per i check ai roaming monsters }Procedure CharactersInit;{ Inizializzazione della unit }PROCEDURE CharactersShutdown;{ Chiamato quando l'utente sceglie Esci. }FUNCTION NoEvils (alsoNoNeutrals: Boolean): Boolean;{ é una delle procedure che concorrono alla IA dei mostri. Scopre se nel gruppodi PC ce ne sono di malvagi (in tal caso restituisce FALSE). Se alsoNoNeutralsvale TRUE, la funzione controlla che nel gruppo ci siano solo personaggi conallineamento Good.é messa qui - anzichŽ in DreamMonsters Ð per l'uso dei paladini in Join. }PROCEDURE SomeoneDiedCheckForActiveChars;{ Da chiamare quando qualcuno muore. Bada alla HI, niente di pi }FUNCTION BeforeJoin (newGuysClass: TClasse): Boolean;{ Da chiamare prima che un nuovo personaggio (o comunque alleato) si uniscaal gruppo SENZA USARE JOIN. Restituisce TRUE se l'unione pu˜ procedere, FALSE altrimenti }PROCEDURE AfterJoin (a: TAllineamento);{ Da chiamare dopo che un nuovo personaggio (o comunque alleato) si unitoal gruppo SENZA USARE JOIN. Passare l'allineamento del nuovo venuto }PROCEDURE Join (whom: TClasse);{ The group asks a new character to join }FUNCTION CastSpell (who: TPersonaggio; what: Integer): Char;{ Il giocatore ha cliccato il pulsante Cast, ed era selezionata la cella numerowhat. Questa procedura si occupa del casting dell'incantesimo.La funzione pu˜ venire chiamata anche se la finestra non aperta e laselezione avvenuta in altro modo (p. es. premendo il pulsante"identify")}FUNCTION Storage2Place (s: Storage): INTEGER;{ Dentro ogni Item c' il campo wearingPlace, che specifica se l'oggetto pu˜ veniretenuto in un dato posto. é necessaria una funzione che converta un valore di tipoStorage, come usato in ClickOnCharWindow, e gli indici del vettore wearingPlace }FUNCTION CharacterGetsNoSpellPage (p: TPersonaggio): Boolean;{ TRUE se il personaggio in questione non ha accesso a una pagina incantesimi }FUNCTION ShellForLearningSpells (learner: TPersonaggio; spellID: Integer): Boolean;{ Problema. L'uso di uno scroll va gestito da TItem.Use. Che per˜ non sa nulladell'esistenza dei personaggi, e quindi non pu˜ certo chiamare LearnNewSpell inDreamMagic. Questa funzione, dichiarata come External dentro HiLevel, chiamata daITtem.Use, e chiama LearnNewSpell per suo conto. Poi ritorna TRUE se l'incantesimo stato appreso e lo scroll usato, FALSE altrimenti }PROCEDURE ShellForCastingSpells (itemName: String; owner: TCreatura; spellID: Integer);{ Analogo al precedente, gestisce il caso in cui un oggetto lancia un incantesimo }PROCEDURE ShellForKillingChars (who: TPersonaggio);{ Idem, a uso di Simulacrum che un incantesimo e deve distruggere unpersonaggio (il clone, quando espira) }PROCEDURE DoKillChar (whom: Entityref; freeMem: Boolean);{ A character leaves. Do the user interface things.Se freeMem TRUE, dealloca lui e le sue carabattole. Se FALSE, lascialo allocato(serve quando va in locanda) }PROCEDURE SwapChars (c1, c2: EntityRef);{ Swap two chars in the roster }PROCEDURE HandleRest (mustEat: Boolean);{ They try to rest }FUNCTION TimingSystem (amountOfTime: integer; mustEat: Boolean): Integer;{ Some time has passed. Let items, objects, PCs and monsters know that.mustEat is normally TRUE. In that case, TimingSystem checks that eachcharacter eats his/her fill at midnight.New for v2.1: returns number of PCs dead (due to poison or hunger) }Procedure MoreXP (howMany: Longint);{ Da chiamare quando, dopo un combattimento, gli eroi vanno insigniti diun certo numero di punti esperienza }FUNCTION ItemCanBeThere (theItem: TItem; theChar:TPersonaggio; realPosition: Storage): Boolean; { Restituisce TRUE se questo oggetto (theItem) pu˜ essere indossato da questo personaggio (theChar) nel posto indicato (realPosition) }FUNCTION CheckItemNeeded (itemRef: Integer; VAR who: TPersonaggio; VAR where: Storage): Boolean;{ Controlla se il personaggio "who" possiede almeno una istanza dell'oggettospecificato. Se si, mette in where la posizione del'oggetto e restituisce TRUE,se no restituisce FALSE.Se "who" vale NIL, controlla tutto il gruppo, e restituisce in "who" ilpersonaggio che possiede l'oggetto }FUNCTION CheckAmmunition (ID: Integer; who: TPersonaggio; decrement: Boolean; VAR ammoNumDice, ammoDiceSize, ammoBase: Integer): Boolean;{ Variante specializzata della funzione precedente. Cerca all'internodell'equipaggiamento di un personaggio le munizioni per una determinata arma dalancio, il cui codice passato in ID. Se le trova restituisce TRUE, altrimentiresttuisce FALSE. Inoltre, se il parametro decrement TRUE toglie una"carica" dalle munizioni (cio sono state usate), e restituisce il danno effettuabile;se FALSE le lascia come sono. }FUNCTION GiveItemToChar (theChar: TPersonaggio; where: Storage; itemID: Integer; itemKnown, itemIsFree: Boolean): Boolean;{ Se where vale Sacco6, lo mette in qualsiasi posto libero del personaggio.Se where vale Sacco1, lo mette ovunque nel sacco del personaggio.Per qualsiasi altro valore di where, lo mette esattamente l“.Se il posto indicato non libero, abortisce e restituisce FALSE. Altrimentirestituisce TRUE.}PROCEDURE ItemIsThrown (item: TItem; proprietario: TPersonaggio; forceDrop, silent: Boolean);{ Da chiamare quando un oggetto viene consumato (tipicamente, cliccando "use"nella sua finestra, cio usandolo indirettamente, ma anche possibileun uso indiretto, per esempio il cibo a mezzanotte o un componentemateriale durante il cast di un incantesimo.Se forceDrop TRUE, l'oggetto viene sempre buttato. Se FALSE, vienebuttato solo se esso stesso lo permette (cioŽ tipicamente sempre, se non maledetto.Se silent FALSE, non si sente il rumove dell'oggetto gettato nemmeno se il suono abilitato.La procedura avrˆ un crash se l'oggetto non appartiene al proprietarioindicato! }Procedure ACapo (VAR r: RECT);{ Procedura schiava di DrawKernelData e DrawCharData.posizionati sul bordo sx dello spazio, e su una nuova riga.Messa qui perchŽ usata anche in game.p}FUNCTION OutputRace (r: TRazza): STR255;{ Gives back a string with the race name }FUNCTION IsOverloaded (load: Longint; WA: integer): Boolean;FUNCTION CalcTHACO (c: TClasse; l: Livello; forza: Integer): SignedByte;{ Calculates the correct THACO - also works for monsters }FUNCTION FindNextXP (c: TClasse; l: Livello): longint;{ Chiamata per scoprire quando un personaggio di un certo livello e di unacerta classe passerˆ nuovamente di livello }FUNCTION HPBonus (c: Caratteristica; k: TClasse): Byte;{ Data la classe di un personaggio e il valore della sua costituzione, calcolail bouns }(********************** low level code for window manip **********************)PROCEDURE MyDisposeWindow (w: WindowPtr);{ Da chiamare per chiudere una qualsiasi delle finestre del gioco }FUNCTION Window2Personaggio (w: WindowPtr; VAR p: TPersonaggio): BOOLEAN;{ Se la finestra passata in W la finestra di un personaggio, restituisceTRUE e, in p, la handle al personaggio. Altrimenti restituisce FALSE }PROCEDURE FlipPage (w: WindowPtr; p: TPersonaggio; page: INTEGER);{ Data la finestra di un personaggio, il personaggio corrispondente (restituitoda Window2Personaggio) e la pagina che si vuole mostrare, provvede }FUNCTION Personaggio2Window (pers: TPersonaggio): WindowPtr;{ Dato un personaggio, trova se ad essocorrisponda una finestra aperta. In quel caso dammi il suo WindowPtr,altrimeenti restituisce NIL }FUNCTION Window2Item (w: WindowPtr; VAR it: TItem): BOOLEAN;{ Perfetto analogo a Window2Personaggio per le finestre di oggetti }PROCEDURE CharacterHasChanged (who: TPersonaggio);PROCEDURE ItemHasChanged (what: TItem);PROCEDURE WeaponHasChanged (who: TPersonaggio);{ Da chiamare quando sono cambiate le caratteristiche di un oggetto, di unpersonaggio o dell'arma che il personaggio usa. Questo codice controlla se c'una finestra aperta che mostri tali caratteristiche e, se si, ne provocal'aggiornamento. }(************************** def procs per finestre *********************************)PROCEDURE DrawKernelData (p: TPersonaggio; space: Rect; alsoOutOf: boolean);{ Disegna nel rettangolo fornito (che deve essere di almeno 180 pixel verticalmente)i dati fondamentali del personaggio.Se outOf true, scrive anche gli HP totali (massimi, da sano) del personaggio }{ Procedure utilizzate per le finestre dei personaggi }PROCEDURE DrawCharInfoBar (myWin: WindowPtr);PROCEDURE DrawCharWindow (myWin: WindowPtr);{ Procedure che disegnano la finestra principale }PROCEDURE DrawStatusLine (myWin: WindowPtr);PROCEDURE DrawMainWindow (myWin: WindowPtr);FUNCTION CreateCharWindow (char: EntityRef): WindowPtr;FUNCTION CreateItemWindow (oggetto: TItem): WindowPtr;ImplementationUSES Appearance, Drag, Errors, GestaltEqu, Icons, IntlResources, Menus, Resources, TextEdit, TextUtils, { List 4 - needs List 1/2/3 types } Dialogs, { needs TextEdit, Windows } MusicEngine, Cilindro, DialogLord4, GraphEngine, DreamMagic, DreamIO;VAR gDateFormat: Byte; { Formato della data nell'orologio }(********************** low level code for window manip **********************){$S LowLevel}FUNCTION Window2Personaggio (w: WindowPtr; VAR p: TPersonaggio): BOOLEAN;BEGIN IF TMGetWRefCon (w, 1) = kCharacterRefCon THEN BEGIN { Si, la finestra di un personaggio } p := TPersonaggio (TMGetWRefCon (w, kRefConForHandle)); Window2Personaggio := TRUE END ELSE BEGIN { No, non lo } p := NIL; Window2Personaggio := FALSE ENDEND;{$S LowLevel}FUNCTION CharWindow2SerialID (w: WindowPtr): EntityRef;BEGIN IF TMGetWRefCon (w, 1) = kCharacterRefCon THEN { Si, la finestra di un personaggio } CharWindow2SerialID := TMGetWRefCon (w, kRefConForID) ELSE CharWindow2SerialID := kNoPCSelectedEND;{$S LowLevel}FUNCTION Personaggio2SerialID (p: TPersonaggio): EntityRef;VAR result: EntityRef;BEGIN result := 0; WHILE (StripAddress (Mondo[result]) <> StripAddress (p)) AND (result < kNPCReference) DO result := result + 1; IF StripAddress (Mondo[result]) = StripAddress (p) THEN Personaggio2SerialID := result ELSE { Accade durante il caricamento: Mondo non ancora inizializzato } Personaggio2SerialID := 0 { Bug hide }END;{$S Characters}FUNCTION CharacterGetsNoSpellPage (p: TPersonaggio): Boolean;{ TRUE se il personaggio in questione non ha accesso a una pagina incantesimi }BEGIN CharacterGetsNoSpellPage := NOT (IsSpellcaster (p.classe, p.livello) OR (p.classe = paladino))END;{$S LowLevel}PROCEDURE MyDisposeWindow (w: WindowPtr);VAR p: TPersonaggio; isCharacterWindow: Boolean; it: TItem; sourceRect, destRect: rect; realPosition: Storage; err: OSErr; cw: WindowPtr;BEGIN { New for v2 - in v1 transcript has no close box } IF w = transcriptWindow THEN BEGIN gTranscriptIsOn := FALSE; ShowHide (transcriptWindow, gTranscriptIsOn); DoCheckItem (kGameMenu, kTranscript, gTranscriptIsOn); Exit (MyDisposeWindow) END; { Facciamo in modo che ci sia sempre un port valido } SetPort (mainWindow); { Debbo controllare il caso in cui una finestra di personaggio abbia una lista associata (succede con gli spellcaster } isCharacterWindow := Window2Personaggio (w, p); IF isCharacterWindow THEN BEGIN { Salva la posizione della finestra per la prossima volta } p.v11.hasOpenWindow := FALSE; p.v11.windowPos := GiveBackWindowPositionOnScreen (p.charWindow); { Animazione } WITH sourceRect DO BEGIN topLeft := p.v11.windowPos; IF p.windowIsWide THEN bottom := top + kCWHeight ELSE bottom := top + kCWInfoBarHeight; right := left + kCWWidth; END; WITH destRect DO BEGIN SetPort (mainWindow); SetPt (topLeft, 0, kMWTop + CharWindow2SerialID(w)*kIconHeight); TMLogicalToPhysical (topLeft); LocalToGlobal (topLeft); bottom := top + kIconHeight; right := left + kIconWidth END; { Do zoom } IF GetGestaltResult (gestaltDragMgrAttr) <> 0 THEN err := ZoomRects (sourceRect, destRect, 15, zoomDecelerate); IF (p.listData.theList <> NIL) THEN BEGIN HLock (Handle (p)); {$PUSH} {$H-} ListaShutdown (p.listData); {$POP} HUnlock (Handle (p)) END END; IF Window2Item (w, it) THEN BEGIN { Mark item as "not shown in any window" } it.data[9] := FALSE; { Save the position for next time } it.windowPos := GiveBackWindowPositionOnScreen (w); { Take note: we don't have a window any more (this is required for the shop code) } it.itemWindow := NIL; { zoom source is easy } WITH sourceRect DO BEGIN topLeft := it.windowPos; bottom := top + kIWHeight; right := left + kIWWidth; END; { zoom dest: three cases. 1. Owned by a shop } IF it.owner = NIL THEN WITH destRect DO BEGIN SetPort (mainWindow); SetPt (topLeft, kMWLeft, kMWTop); LocalToGlobal (topLeft); bottom := top + kMWHeight; right := left + kMWWidth END ELSE BEGIN p := TPersonaggio (it.owner); cw := Personaggio2Window (p); { 2. Owned by a char whose window is closed or is not showing items } IF (cw = NIL) | (TMGetWRefCon (cw, kRefConForPage) <> 2) THEN WITH destRect DO BEGIN SetPort (mainWindow); SetPt (topLeft, 0, kMWTop + Personaggio2SerialID(p)*kIconHeight); LocalToGlobal (topLeft); bottom := top + kIconHeight; right := left + kIconWidth END { 3. Owned by a char whose window is open on page 2 } ELSE WITH destRect DO BEGIN { Trova dove ce l'ha } realPosition := Testa; WHILE StripAddress(p.equipaggiamento[realPosition]) <> StripAddress (it) DO realPosition := succ (realPosition); { Trova le coordinate del rect } destRect := GetIndNrect (rFirstSilhouette+ord(p.classe), ord(realPosition)); SetPort (cw); LocalToGlobal (topLeft); LocalToGlobal (botRight) END; { item owner has window open on page 2 } END; { item has an owner } IF GetGestaltResult (gestaltDragMgrAttr) <> 0 THEN err := ZoomRects (sourceRect, destRect, 15, zoomDecelerate); END; IF isCharacterWindow THEN BEGIN { Devo far ridisegnare la mia icona di modo che non appaia pi come "aperta" } WITH destRect DO BEGIN GlobalToLocal (topLeft); GlobalToLocal (botRight); END; TMInvalRect (destRect); END; { Mi limito a chiedere a TaskMaster di fare il lavoro. } TMDisposeWindow (w)END;{$S LowLevel}PROCEDURE FlipPage (w: WindowPtr; p: TPersonaggio; page: INTEGER);VAR newRefCon: longint; nomeIncantesimo: String; pulsante, tabs: ControlHandle; r: Rect; currPage, i: integer; c: Cell; pPat: PixPatHandle; err: OSErr; BEGIN SetPort (w); Hlock (Handle (p)); { Tabs } IF gHasThemes THEN BEGIN { trova il tab } tabs := MyFindControl (rTabs); { Se questo personaggio non uno spellcaster, il terzo tab lo help } IF CharacterGetsNoSpellPage (p) AND (page = 4) THEN SetControlValue (tabs, 3) ELSE { Assegnagli il valore corretto } SetControlValue (tabs, page) END; currPage := TMGetWRefCon (w, kRefConForPage); IF currPage = 3 THEN BEGIN { Togli di mezzo la lista. Non si pu˜ nascondere, quindi la devo togliere } {$PUSH} {$H-} ListaShutdown (p.listData); {$POP} { Evita un secondo dispose in futuro, marcando come non in uso la lista } p.listData.theList := NIL; { Togli di mezzo il pulsante "Cast" } pulsante := MyFindControl (rButtonCast); { Bug fix 2.2 } DisposeControl (pulsante); { System 7: rimetti lo sfondo grigio } IF NOT gHasThemes THEN BEGIN ppat := GetPixPat (rLightGrayPpat); IF ppat = NIL THEN DeathAlert (errMissingApplRes, resNotFound); BackPixPat (ppat); InvalRect (w^.portRect) END END; IF (page = 3) THEN BEGIN IF NOT gHasThemes THEN BEGIN { System 7: la lista non appare bene se il colore di sfondo non bianco. Un problema del List manager, immagino. Per ora, ripristino il bianco } BackPat (qd.white); TMInvalRect (w^.portRect); END; { Crea la lista che conserva l'elenco degli incantesimi in memoria } SetRect (r, 10, kCWTopOfFreeSpace, kCWWidth-10, kCWHeight-50); {$PUSH} {$H-} p.listData := NuovaLista (w, r, 1, wantVScroll+wantAutoScroll+wantTaskMaster, lOnlyOne + lNoNilHilite); {$POP} { se gli incantesimi sono parecchi, il ciclo sfarfalla. Quindi disabilito temporaneamente il ridisegno sulla lista } LSetDrawingMode (FALSE, p.listData.theList); { Ciclo su tutti gli incantesimi conosciuti. } i := 1; c.h := 0; c.v := 0; WHILE (p.spellsInMemory [i] > 0) & (i <= kMaxSpellInMemory) DO BEGIN { Trova il nome di quest'incantesimo } nomeIncantesimo := SpellID2SpellName (p.spellsInMemory [i]); {$PUSH} {$H-} NuovaCella (p.listData, c, @nomeIncantesimo); {$POP} c.v := succ (c.v); i := succ (i) END; (* LSetDrawingMode (TRUE, p.listData.theList); { Non va bene: ridisegna la scrollbar nel sistema di coordinate sbagliato } Ridisegna (p.listData);} { Non va bene: va chiamata solo in seguito a evento update } *) TMInvalRect (r); { Ora mettiamoci il bottone "Cast" } pulsante := GetNewControl (rButtonCast, w); IF gHasThemes THEN err := EmbedControl (pulsante, tabs); { garantisci che non sparisca sotto al TAB } if pulsante = nil then DeathAlert (errMissingApplRes, resNotFound); END; { ELSE DI is spellcaster - creazione lista } TMSetWRefCon (w, kRefConForPage, page); { Obbliga al ridisegno della finestra } SetRect(r,0,0,kCWWidth,kCWHeight); TMInvalRect (r); HUnlock (Handle (p));END;{$S LowLevel}FUNCTION Personaggio2Window (pers: TPersonaggio): WindowPtr;BEGIN IF ord(pers.v11.hasOpenWindow) = 1 THEN Personaggio2Window := pers.charWindow ELSE Personaggio2Window := NILEND;{$S LowLevel}FUNCTION Window2Item (w: WindowPtr; VAR it: TItem): BOOLEAN;{ Perfetto analogo a Window2Personaggio per le finestre di oggetti }BEGIN IF TMGetWRefCon (w, 1) = kItemRefCon THEN BEGIN { Si, la finestra di un oggetto } it := TItem (TMGetWRefCon (w, kRefConForHandle)); Window2Item := TRUE END ELSE BEGIN it := NIL; Window2Item := FALSE ENDEND;{$S LowLevel}PROCEDURE ItemHasChanged (what: TItem);VAR itsWindow: WindowPtr;BEGIN { Questo oggetto ha una finestra aperta? } itsWindow := what.itemWindow; IF itsWindow <> NIL THEN BEGIN SetPort (itsWindow); InvalRect (itsWindow^.portRect) ENDEND;{$S Characters}PROCEDURE CharacterHasChanged (who: TPersonaggio);VAR r: Rect;BEGIN { Remember to save, ok? } dirty := TRUE; { Questo personaggio ha una finestra aperta? } IF who.v11.hasOpenWindow THEN BEGIN SetPort (who.charWindow); { Invalida la info bar, nel caso abbia cambiato gli hp } SetRect (r, 128, 0, kCWWidth, kCWInfoBarHeight); InvalRect (r); { sta mostrando le caratteristiche? } IF TMGetWRefCon (who.charWindow, kRefConForPage) = 1 THEN InvalRect (who.charWindow^.portRect) END; { Pel caso in cui sia cambiato lo status, invalida il groupRect } SetPort (mainWindow); TMInvalrect (groupRect)END;{$S Main}PROCEDURE WeaponHasChanged (who: TPersonaggio);VAR hisWindow: WindowPtr;BEGIN { Questo personaggio ha una finestra aperta? } hisWindow := Personaggio2Window (who); { Se si, sta mostrando l'equipaggiamento? } IF (hisWindow <> NIL) & (TMGetWRefCon (hisWindow, kRefConForPage) = 2) THEN BEGIN SetPort (hisWindow); TMInvalRect (GetIndNrect (rFirstSilhouette+ord (who.classe), kChosenWeaponSpace)) ENDEND;{$S Characters}PROCEDURE CharacterHasNoWeapons (p: TPersonaggio);BEGIN p.wieldedWeapon := Sacco1; p.baseDamage := 0; p.dannoInDadi := 1; p.dimDadi := 2;END;{$S Characters}PROCEDURE ItemIsThrown (item: TItem; proprietario: TPersonaggio; forceDrop, silent: Boolean);VAR place: Storage; { posto dove il proprietario tiene l'oggetto } ownerWindow: WindowPtr; { Finestra del proprietario } dummy: Boolean;BEGIN place := Testa; WHILE StripAddress(proprietario.equipaggiamento[place]) <> StripAddress (item) DO place := succ (place); IF place = proprietario.wieldedWeapon THEN BEGIN CharacterHasNoWeapons(proprietario); WeaponHasChanged (proprietario) END; IF item.Drop (forceDrop, place) THEN BEGIN IF NOT silent THEN DoSoundAsync (sndItemUsedUp); dummy := item.Kill; ownerWindow := Personaggio2Window (proprietario); IF ownerWindow <> NIL THEN BEGIN { Se la finestra del proprietario aperta, fa sparire l'oggetto } SetPort (ownerWindow); TMInvalRect (GetIndNrect (rFirstSilhouette+ord (proprietario.classe), ord(place))) END ELSE { Non lasciare comunque che il GrafPort corrente sia indefinito } SetPort (mainWindow); proprietario.equipaggiamento [place] := NIL; item.Free; { Chiude anche la finestra } { Ricorda che c' un cambiamento che va cambiato } dirty := TRUE END { If item can be dropped } ELSE SpellAlert (kItemCursed, 0)END;(************************* Window code ***************************){ Q&A Stack suggests that we leave all definition procedures(that is, code whose pointer is taken) in a special segmentwhich never gets deallocated. The threads package (develop 6, pg . 16)asks that swapping procedures stay in a segment different from all thecalling segments, so that A5 addressing is used. In this program, we make use of a special segment for defprocs. }{$S DefProcs}PROCEDURE DrawCharControls (myWin: WindowPtr);{ Some character, controls }VAR page: Integer; myControl: ControlHandle;BEGIN { Questa finestra contiene controlli sia nella info bar (il triangolo) che nella main part (il tab, eccetera). Non posso lasciar ridisegnare i controlli a taskmaster, perchŽ ridisegnerebbe anche la scrollbar della lista degli incantesimi, e nella posizione sbagliata. Non posso demandare comunque a TaskMaster, perchŽ non ha modo di sapere quali controlli appartengano al main pane a quali alla info bar. Si fa tutto a manona. } page := TMGetWRefCon (myWin, kRefConForPage); IF gHasThemes THEN BEGIN myControl := MyFindControl (rTabs); Draw1Control (myControl); { Disegna anche il bottone cast, che embedded, se del caso } { Triangolino } SetOrigin (0, 0); { é nella info bar } myControl := MyFindControl (rTriangle); Draw1Control (myControl); WITH tmAuxRecordHandle(WindowPeek(mainWindow)^.refCon)^^ DO SetOrigin (wXOrigin, wYOrigin-wInfoHeight-3); END ELSE BEGIN IF page = 3 THEN BEGIN myControl := MyFindControl (rButtonCast); Draw1Control (myControl); END; END;END;{$S DefProcs}PROCEDURE DrawCharInfoBar (myWin: WindowPtr);{ Some character, information bar }CONST rMyOpenCicn = 609; rMyClosedCicn = 608;VAR r: Rect; i: Integer; err: OSErr; theChar: TPersonaggio; color1, color2: PixPatHandle; triangolo: CIconHandle; triangoloControllo: ControlHandle;BEGIN TextFont (stdFontID); TextSize (stdFontSize); { Lo sfondo deve essere grigio, e NON basta che BackPat sia grigia. Di per sŽ, questo si limita a far s“ che gli effetti di EraseRect siano grigi e non bianchi, e fa anche s“ che le aree che appaiono per effetto di ScrollRect siano grigie } IF NOT gHasThemes THEN BEGIN SetRect (r, 0, 0, kCWWidth+1, kCWInfoBarHeight); EraseRect (r); END; i := Integer(Window2Personaggio (myWin, theChar)); { Trova il personaggio } IF theChar = NIL THEN DeathAlert (kStandardErr, 11111); SetRect (r, 10, kCWOffsetToIcons, 42, kCWOffsetToIcons+32); { Spazio ove mettere la icona } theChar.Draw (r, ttNone); (*** RAZZA CLASSE LIVELLO ***) MoveTo (45, 18); DrawString (OutputRace (theChar.razza)); MoveTo (45, 35); DrawMiscString (rStrLevel); DrawString (IToS (theChar.livello)); DrawChar (' '); DrawString (OutputClass (theChar.classe)); (*** TRIANGOLINO ***) IF NOT gHasThemes THEN BEGIN SetRect (r, kCWWidth-16, kCWInfoBarHeight-16, kCWWidth, kCWInfoBarHeight); { Spazio ove mettere la icona } IF theChar.windowIsWide THEN triangolo := GetCIcon (rMyOpenCicn) ELSE triangolo := GetCIcon (rMyClosedCicn); IF triangolo <> NIL THEN BEGIN err := PlotCiconHandle (r, kAlignNone, kTransformNone, triangolo); DisposeCicon (triangolo) END; END; MoveTo (132, 18); DrawMiscString (rStrHP); { Disegna una barra, verde per gli HP che restano, rossa per gli HP persi combattendo } SetRect (r, 160, 8, kCWWidth-16, 19); BarInit (r, theChar.maxHP); { trova i colori da usare } color1 := GetPixPat (rGreenPpat); color2 := GetPixPat (rRedPpat); IF (color1 = NIL) OR (color2 = NIL) THEN DeathAlert (errMissingApplRes, resNotFound); DrawProgressBar (theChar.HP, color1, color2); { Metti il totale } TextFont (smallFontID); TextSize (smallFontSize); MoveTo (kCWWidth - 12, 26); DrawString (IToS (theChar.maxHP)); { Se serve, metti quanti ne restano } IF (theChar.HP < theChar.maxHP) & (theChar.HP > 0) THEN BEGIN MoveTo (148, 26); DrawString (IToS (theChar.HP)) END; TextFont (stdFontID); TextSize (stdFontSize);END;{$S DefProcs}PROCEDURE DrawCharWindow (myWin: WindowPtr);{ Some character, display window }CONST rCharOutlinePictBase = 150; rCharHelpPict = 132; kButton = 900; { Per pag. 1, 901, eccetera } kOffsetToPressed = 10; kOffsetToDisabled = 20;VAR i, numIcon, page: INTEGER; temp: longint; dummy: Point; me: TPersonaggio; r: Rect; pict: Handle; loop: Storage; handleState: SignedByte; alignmentMessage: Str255; color1, color2: PixPatHandle; err: OSErr; myControl: ControlHandle; iAmActive: Boolean;BEGIN { Scopri a chi facciamo riferimento } me := NIL; IF Window2Personaggio (myWin, me) & (me <> NIL) THEN { Restituisce sempre true, qui! } page := TMGetWRefCon (myWin, kRefConForPage) ELSE DeathAlert (kStandardErr, 11112); IF NOT me.windowIsWide THEN Exit (DrawCharWindow); { Optimization new for v2.2 } { Lo sfondo deve essere grigio, e NON basta che BackPat sia grigia. Di per sŽ, questo si limita a far s“ che gli effetti di EraseRect siano grigi e non bianchi, e fa anche s“ che le aree che appaiono per effetto di ScrollRect siano grigie } IF gHasThemes THEN BEGIN iAmActive := WindowPeek (myWin)^.hilited; IF iAmActive THEN err := SetThemeWindowBackground (myWin, kThemeActiveUtilityWindowBackgroundBrush, FALSE) { 2.2 bug fix } ELSE err := SetThemeWindowBackground (myWin, kThemeInactiveUtilityWindowBackgroundBrush, FALSE); { 2.2 bug fix } END; (* ELSE BEGIN *) SetRect (r, 0, 0, kCWWidth+1, kCWHeight); EraseRect (r); (* END; *) handleState := HGetState (Handle (me)); HLock (Handle (me)); WITH me DO BEGIN IF NOT gHasThemes THEN BEGIN { Disegno che presente per qualsiasi dataDisplayed (barra icone) } SetRect (r, kCWOffsetToIcons, 3, kCWOffsetToIcons+32, 35); { Trova dove apparirˆ la prima icona } FOR i := 1 to 4 DO BEGIN { Ciclo per 4 icone } numIcon := kButton+i; { Trova num icona da disegnare } IF i = page THEN { Se quella della pagine correnteÉÊ} numIcon := numIcon + kOffsetToPressed; { Éallora premuto } IF (i = 3) AND { Se non pu˜ fare incantesimiÉ } CharacterGetsNoSpellPage (me) THEN { Ée stiamo per disegnare la terza icona, alloraÉÊ} numIcon := numIcon + kOffsetToDisabled; { É essa va disabilitata } { New for v 1.3 and NPC handling } IF (i = 2) AND (classe = Mostro) THEN numIcon := numIcon + kOffsetToDisabled; { É essa va disabilitata } err := PlotIconID (r, atNone, ttNone, numIcon); OffsetRect(r,32,0) END; END; CASE page OF 1: BEGIN { We are displaying the characteristics } { Write the kernel data } SetRect(r,8,kCWTopOfFreeSpace,kCWWidth DIV 2-8,209); DrawKernelData (me, r, TRUE); HLock (Handle (me)); { DrawKernelData fa unlock, alla fine } { Add more data } OffsetRect (r, kCWWidth DIV 2, 0); r.bottom := r.top + 76; DrawGrayRect (r); ACapo (r); DrawMiscString (rStrAC); DrawString (ITos (AC)); ACapo (r); ACapo (r); DrawMiscString (rStrXP); DrawString (IntegerToLocalString (XP)); ACapo (r); { Allineamento } GetPen (dummy); { Tiene traccia di dove eravamo } WITH r DO BEGIN r.top := r.bottom + 5; r.bottom := kCWTopOfFreeSpace + 120 END; DrawGrayRect (r); { Adesso restringilo perchŽ non venga sovrascritto } InsetRect (r, 2, 2); GetIndString (alignmentMessage, rMiscStrings, rStrAlignment); alignmentMessage := Concat (alignmentMessage, OutputAlignment (allineamento)); TETextBox(@alignmentMessage[1],length(alignmentMessage),r,teJustLeft); MoveTo (dummy.h, dummy.v); { Ripristina la posizione passata } DrawMiscString (rStrNextXP); { Disegna una barra, che mostra quanti XP per passare di livello } GetPen (dummy); { Scopre dove disegnare } SetRect (r, dummy.h, dummy.v - 10, r.right-5, dummy.v + 3); temp := XPToNextLevel-XPForThisLevel; { Punti che servono per passare, cioŽ la differenza tra il minimo per questo livello e il minimo per il livello successivo } BarInit (r, temp); { trova i colori da usare } color1 := GetPixPat (rDarkGrayPpat); color2 := GetPixPat (rLightGrayPpat); IF (color1 = NIL) OR (color2 = NIL) THEN DeathAlert (errMissingApplRes, resNotFound); { Calcola e disegna i punti che ho giˆ, cioŽ la differenza tra quanto ho in tutto e il minimo } DrawProgressBar (XP-XPForThisLevel, color1, color2); SetRect (r, 8, 258, kCWWidth - 8, kCWHeight-10); DrawGrayRect (r); r.top := r.top+2; ACapo (r); DrawMiscString (rStrHeight); DrawString (IToS (height)); ACapo (r); DrawMiscString (rStrWeight); DrawString (IToS (weight)); ACapo (r); DrawMiscString (rStrWA); DrawString (IntegerToLocalString (WA)); ACapo (r); drawMiscString (rStrLoad); DrawString (IntegerToLocalString (weightLoad)); IF IsOverloaded (weightLoad, WA) THEN BEGIN { Encumbered } ForeColor (redColor); DrawMiscString (rStrEncumbered); ForeColor (blackColor) END; END; 2: BEGIN { We are displaying the equipment } { Get the silhouette from the resources } pict := MyGetResource ('PICT', rCharOutlinePictBase+ord(classe), TRUE, FALSE); r := PicHandle (pict)^^.picFrame; { Offset it, so that topleft will be just below the icon & name, no matter the coordinates when the pict was saved } OffsetRect (r, -r.left, kCWTopOfFreeSpace - r.top); DrawPicture(PicHandle(pict),r); { Draw the items he/she possess } FOR loop := testa TO sacco6 DO IF equipaggiamento[loop] <> NIL THEN equipaggiamento[loop].Draw (GetIndNrect (rFirstSilhouette+ord(classe), ord(loop)), ttNone); { Show what kind of weapon he's using } r := GetIndNrect (rFirstSilhouette+ord(classe), kChosenWeaponSpace); DrawGrayRect (r); TextFont (smallFontID); TextSize (smallFontSize); ClipRect(r); { 1.3.3: impedisci di sforare il rect } MoveTo (r.left+5, r.top+15); DrawMiscString (rStrWield); MoveTo (r.left+5, r.top+17+smallFontSize); { Sporco trucco come bug fix } IF equipaggiamento[wieldedWeapon] = NIL THEN CharacterHasNoWeapons (me); IF (wieldedWeapon <> ManoSx) AND (wieldedWeapon <> ManoDx) THEN DrawMiscString (rStrFist) ELSE BEGIN { Per evitare unsafe use of >4 byte parm } IF equipaggiamento[wieldedWeapon].data[8] { obj is known } THEN alignmentMessage := equipaggiamento[wieldedWeapon].secretName ELSE alignmentMessage := equipaggiamento[wieldedWeapon].nome; DrawString (alignmentMessage); { Se gli mancano le munizioni, mostralo } IF equipaggiamento[wieldedWeapon].data[5] { thr. weap. } & NOT CheckAmmunition (equipaggiamento[wieldedWeapon].ID, me, FALSE, dummy.v, dummy.h, dummy.v) THEN BEGIN ForeColor (redColor); DrawMiscString (rStrEncumbered); ForeColor (blackColor) END; END; ClipRect (myWin^.portRect) END; { case 2, displaying equipment } 3: BEGIN { spells, usando la unit Lista } {$PUSH} {$H-} LSetDrawingMode (TRUE, me.listData.theList); Ridisegna (me.listData); {$POP} END; { case 3, spells available } 4: BEGIN { Page 4 is the help page } pict := MyGetResource ('PICT', rCharHelpPict, TRUE, FALSE); r := PicHandle (pict)^^.picFrame; { Offset it, so that topleft will be just below the icon & name, no matter the coordinates when the pict was saved } OffsetRect (r, -r.left, kCWTopOfFreeSpace - r.top); DrawPicture(PicHandle(pict),r); END; { Help } END; { case } END; { with } HSetState (Handle (me), handleState);END;{$S UtilInit}PROCEDURE InitializeDefaultDateFormat; VAR theItl0Handle: Handle;BEGIN theItl0Handle := GetResource('itl0', GetScriptVariable(smSystemScript, smScriptNumber)); IF theItl0Handle = NIL THEN gDateFormat := mdy ELSE WITH Intl0Hndl(theItl0Handle)^^ DO gDateFormat := dateOrder; { Technote 1 says not to release sys resources ReleaseResource (theItl0Handle) }END;{$S DefProcs}PROCEDURE DrawStatusLine (myWin: WindowPtr);{ Main window, information bar }CONST rMonths = 135;VAR monthName, timeSpace, afterTheFall: Str255; gg, mm, aa: integer;BEGIN {$UNUSED myWin} IF NOT gHasThemes THEN BEGIN { Cancella tutto in bianco, a scanso sovrapposizioni } timePlace.right := myWin^.portRect.right; { Cosmetic fix 2.1 FC } FillRect (timePlace, qd.white); END; IF length (message) = 0 THEN BEGIN { Standard time and date status line } MoveTo (10, 12); timeSpace := Itos (ora DIV 60); IF length (timeSpace) = 1 THEN timeSpace := concat ('0', timeSpace); DrawString (timeSpace); DrawChar (':'); timeSpace := Itos (ora MOD 60); IF length (timeSpace) = 1 THEN timeSpace := concat ('0', timeSpace); DrawString (Concat (timeSpace, ' ')); { 364 giorni in un anno su Lar. Il calendario parte dal 1200 } aa := giorno DIV 364 + 1200; gg := giorno MOD 28 + 1; { 28 giorni al mese su Lar } mm := (giorno DIV 28) MOD 13 + 1; { Prima trova quanti mesi dall'inizio del calendario, poi esegui un mod 13 per portarlo nel range 0,,12 } GetIndString (monthName, rMonths, mm); GetIndString (afterTheFall, rMiscStrings, rStrAfterTheFall); afterTheFall := Concat (ItoS(aa), ' ', afterTheFall); { Output } CASE gDateFormat OF mdy: timeSpace := Concat (monthName, ' ', ItoS(gg), ', ', afterTheFall); dmy: timeSpace := Concat (ItoS(gg), ' ',monthName, ' ', afterTheFall); ymd: timeSpace := Concat (afterTheFall, ' ', monthName, ' ', ItoS(gg)); ydm: timeSpace := Concat (afterTheFall, ' ', ItoS(gg), ' ', monthName); dym: timeSpace := Concat (ItoS(gg), ' ',afterTheFall, ' ', monthName); OTHERWISE timeSpace := Concat (monthName, ' ', ItoS(gg), ' ', afterTheFall) END; { Case } DrawString (timeSpace); END ELSE BEGIN { Special status line } gg := StringWidth (message); { Center message } MoveTo ((kMWWidth - gg) DIV 2, 12); drawString (message) END;END;(******************************** end defprocs **********************************){$S UtilInit}Procedure CharactersInit;VAR i: Integer;BEGIN listaPersInLocanda := NIL; numPC := 0; FOR i := kNoPCSelected to kNPCReference DO BEGIN Mondo[i] := NIL END; CursorAnimate; { init globals } lastMove := TickCount; { Hai un minuto di tempo per muovere, capo } dayOfLastRest := 0; { Quando nasci sei riposatoÉÊ} tickleTime := $7FFFFFFF; { All'inizio appare data ed ora nella status line } gCharSelected := kNoPCSelected; geInBank := 0; { Niente risparmi in banca } gRoamingCount := 0; { Check per mostri vaganti - vedere w } dirty := FALSE; { Indicatore di gioco modficato } placeID := 1000; { Questo serve solo in un caso: apro uno scenario, creo pertanto un nuovo savegame, esco subito, rientro aprendo quel savegame. In qs. caso qs. assegnazione fa s“ che all'interno del savefile sia indicato correttamente lo ID del posto dove mi trovo } groupX := 0; { Valore invalido, indica che bisogna caricare un nuovo scenario } InitializeDefaultDateFormat { New for v1.3 }END;{$S DefProcs}PROCEDURE DrawMainWindow (myWin: WindowPtr);{ Main window, main pane }VAR drawingMode: INTEGER; r: Rect; i,j: INTEGER;BEGIN { Disegna le icone dei personaggi dall'alto in basso } for i := 0 TO kNPCReference DO IF Mondo[i] <> NIL THEN BEGIN j := kMWTop + kIconHeight*i; { Coordinata top dell'icona } SetRect(r, 0, j, kIconWidth, j+kIconHeight); { Trova il modo in cui la icona va disegnata } IF i = gCharSelected THEN drawingMode := ttSelected ELSE drawingMode := ttNone; IF Mondo[i].v11.hasOpenWindow = TRUE THEN drawingMode := drawingMode + ttOpen; { E disegnala } Mondo[i].Draw (r, drawingMode); END; { Poi separa quella parte della finestra dal resto con due righe } MoveTo (kIconWidth, kMWTop); LineTo (kIconWidth, kMWHeight); MoveTo (kIconWidth+2, kMWTop); LineTo (kIconWidth+2, kMWHeight); { Infine, il contenuto del paneRect } IF placeData [3] THEN DoDrawShop ELSE IF placeKind <> threeD THEN DoDrawMap ELSE BEGIN EraseRect (paneRect); i := Engine3D_Scan (doNothing); Engine3D_ScanMap; ENDEND;{$S Characters}FUNCTION FindNextXP (c: TClasse; l: Livello): longint;{ Chiamata per scoprire quando un personaggio di un certo livello e di unacerta classe passerˆ nuovamente di livello }CONST rFirstXPTable = 128;TYPE LongintPtr = ^Longint;VAR XPtableHdl: handle; scanner: LongintPtr;BEGIN { Sanity check } IF l < 1 THEN BEGIN FindNextXP := 0; Exit (FindNextXP) END; { Load the appropriate table } XPTableHdl := MyGetResource (resXP, rFirstXPTable + ord (c), TRUE, FALSE); { Scan it and find the required value. The table data is longint, and sizeof (longint) is 4... } scanner := LongintPtr (ord4(StripAddress(XPTableHdl^)) + SizeOf (longint) * (l-1)); { Give the result back } FindNextXP := scanner^; HUnlock (XPTableHdl);END;{$S LowLevel}FUNCTION CheckAmmunition (ID: Integer; who: TPersonaggio; decrement: Boolean; VAR ammoNumDice, ammoDiceSize, ammoBase: Integer): Boolean;VAR result: Boolean; loop: Storage; item: TItem;BEGIN result := FALSE; FOR loop := Testa TO ManoSx DO BEGIN { Non permetto munizioni nel sacco } item := who.equipaggiamento[loop]; IF item.data[3] { is ammo } & (item.specialEffect = ID) THEN BEGIN result := TRUE; IF decrement THEN BEGIN ammoNumDice := item.dannoInDadi; ammoDiceSize := item.dimDadi; ammoBase := item.baseDamage; IF item.Use THEN BEGIN ItemIsThrown (item, who, FALSE, FALSE); GenericDreamAlert (kAmmoUsedUp) END ELSE ItemHasChanged (item); END END; { if found } END; { for } CheckAmmunition := resultEND;{$S Characters}FUNCTION CheckItemNeeded (itemRef: Integer; VAR who: TPersonaggio; VAR where: Storage): Boolean;VAR i: EntityRef; outerResult: Boolean; outerLoop: TPersonaggio; FUNCTION KernelCheck (charChecked: TPersonaggio): Boolean; { Effettua il controllo su un solo personaggio } VAR result: Boolean; loop: Storage; BEGIN { Bug fix 1.6 } result := FALSE; IF charChecked <> NIL THEN FOR loop := Testa TO Sacco6 DO IF (charChecked.equipaggiamento[loop] <> NIL) & (charChecked.equipaggiamento[loop].ID = itemRef) THEN BEGIN result := TRUE; where := loop END; KernelCheck := result END; BEGIN IF who = NIL THEN BEGIN outerResult := FALSE; FOR i := numPC-1 DOWNTO 0 DO BEGIN outerLoop := mondo[i]; IF KernelCheck (outerLoop) THEN BEGIN outerResult := TRUE; who := outerLoop END; { if found } END; { outer loop } CheckItemNeeded := outerResult; END { if must check whole group } ELSE CheckItemNeeded := KernelCheck (who);END;{$S LowLevel}PROCEDURE SwapChars (c1, c2: EntityRef);VAR swap: Tpersonaggio; c1Window, c2Window: WindowPtr;BEGIN { Se ci sono finestre ai personaggi da swappare, tieni presenti quali sono prima che lo swap modifichi le carte in tavola } c1Window := Personaggio2Window (Mondo[c1]); c2Window := Personaggio2Window (Mondo[c2]); { Ora scambia } swap := Mondo[c1]; Mondo[c1] := Mondo[c2]; Mondo[c2] := swap; { Aggiorna il display nella finestra principale } SetPort (mainWindow); FillRect (groupRect, qd.white); { Questo necessarioÊ} TMInvalRect (groupRect); { Aggiorna il numero del personaggio selezionato, se c' } IF gCharSelected = c1 THEN gCharSelected := c2 ELSE IF gCharSelected = c2 THEN gCharSelected := c1; { Se ci sono finestre vanno adattate (perchŽ nel refCon della finestra c' un riferimento all'entityref del personaggio } TMSetWRefCon (c1Window, kRefConForID, c2); TMSetWRefCon (c2Window, kRefConForID, c1);END;{$S Characters}PROCEDURE DoKillChar (whom: EntityRef; freeMem: Boolean);VAR him: TPersonaggio; suoNome: String; places: Storage; aWindow: WindowPtr; i: Integer;BEGIN { Remember to save the change! } dirty := TRUE; him := Mondo[whom]; suoNome := him.nome; AddToTranscript (suoNome, ktIsDismissed, '', 0);(* { Per qualche motivo questo codice provoca un crash quando il personaggio da mandare via non l'ultimo del gruppo. Quindi, con serendipityÉ } IF whom < numPC-1 THEN SwapChars (whom, numPC-1);*) { Uccidi il personaggio } IF freeMem THEN him.Free ELSE BEGIN aWindow := Personaggio2Window (him); IF aWindow <> NIL THEN MyDisposeWindow (aWindow); FOR places := Testa TO Sacco6 DO IF him.equipaggiamento[places] <> NIL THEN BEGIN aWindow := him.equipaggiamento[places].itemWindow; IF aWindow <> NIL THEN MyDisposeWindow (aWindow) END END; { se se n' andato un PC } IF whom <> kNPCReference THEN BEGIN { Riempi il buco } FOR i := whom TO numPC-2 DO Mondo[i] := Mondo[i+1]; Mondo[numPC-1] := NIL; { Aggiorna il num di PC } numPC := pred (numPC); { Se era l'unico personaggio, o comunque l'unico attivo, disabilita le opzioni del menu Gruppo } SomeoneDiedCheckForActiveChars; END ELSE Mondo[kNPCReference] := NIL; { Aggiorna il display } gCharSelected := kNoPCSelected; SetPort (mainWindow); FillRect (groupRect, qd.white); { Questo necessario perchŽ senn˜ l'ultima icona non sarebbe coperta correttamente: verrebbe disegnata su di essa l'icona zero, che trasparenteÉÊ} TMInvalRect (groupRect);END;{$S LowLevel}PROCEDURE SomeoneDiedCheckForActiveChars;VAR i: Integer;BEGIN gActiveChars := FALSE; FOR i := numPC-1 DOWNTO 0 DO gActiveChars := gActiveChars OR NOT Mondo[i].status[IsDead]; IF NOT gActiveChars THEN NoChars; { Disabilita i menu }END;{$S LowLevel}FUNCTION NoEvils (alsoNoNeutrals: Boolean): Boolean;VAR result: Boolean; loop: Entityref;BEGIN result := TRUE; { Supponiamo che inizialmente non ci siano maligni } loop := 0; WHILE (loop <= numPC) & result DO BEGIN IF alsoNoNeutrals THEN BEGIN IF Mondo[loop].allineamento < CG THEN result := FALSE END ELSE IF Mondo[loop].allineamento < CN THEN result := FALSE; loop := succ (loop) END; { while } NoEvils := resultEND;{$S Characters}FUNCTION Storage2Place (s: Storage): INTEGER;BEGIN CASE s OF Testa: Storage2Place := 6; Corpo: Storage2Place := 5; Cintura: Storage2Place := 4; ManoDx, ManoSx: Storage2Place := 3; Fodero: Storage2Place := 2; Sacco1, Sacco2, Sacco3, Sacco4, Sacco5, Sacco6: Storage2Place := 1; END { case }END;{$S Characters}FUNCTION ItemCanBeThere (theItem: TItem; theChar:TPersonaggio; realPosition: Storage): Boolean;BEGIN ItemCanBeThere := {if has space } (theChar.equipaggiamento [realPosition] = NIL) { & item can be there } & (theItem.wearingPlace[Storage2Place(realPosition)]) { & item allows this class } & ((realPosition >= Sacco1) | (theItem.permittedUse [ord(theChar.classe)]));END;{$S Characters}FUNCTION GiveItemToChar (theChar: TPersonaggio; where: Storage; itemID: Integer; itemKnown, itemIsFree: Boolean): Boolean;{ Se where vale Sacco6, lo mette in qualsiasi posto libero del personaggio.Se where vale Sacco1, lo mette ovunque nel sacco del personaggio.Per qualsiasi altro valore di where, lo mette esattamente l“.Se il posto indicato non libero, abortisce e restituisce FALSE. Altrimentirestituisce TRUE.}VAR theItem: TItem; nomeOggetto, nomeAcquirente: String; realPosition, firstAllowed, lastAllowed: Storage; placeFound: Boolean; buyerWindow: WindowPtr; allButtons: Family; BEGIN { Istanzia l'oggetto. Questo indispensabile per controllare che possa venire messo in qualche posto } theItem := NIL; { So that FailNIL can work } New (theItem); FailNIL (theItem); theItem.Init (itemID); theItem.data[8] { known } := itemKnown; IF itemKnown THEN nomeOggetto := theItem.secretName ELSE nomeOggetto := theItem.nome; nomeAcquirente := theChar.nome; IF itemIsFree THEN AddToTranscript (nomeAcquirente, ktGrabs, nomeOggetto, 0) ELSE AddToTranscript (nomeAcquirente, ktBuys, nomeOggetto, 0); { Se un oggetto rechargeable, e possiede giˆ una istanza dell'oggetto, aggiungi questo a quello. Il check < 16000 serve a evitare gli overflow. Chiedi conferma solo se l'oggetto non splittable. L'idea che se si tratta di oggetto splittable non c' bisogno di chiedere conferma, perchŽ il giocatore potrˆ sempre dividerlo in seguito se ne avrˆ bisogno } ParamText (nomeOggetto, '', '', ''); ClearFamily (allButtons); allButtons [kStdOkItemIndex] := TRUE; allButtons [kStdCancelItemIndex] := TRUE; IF theItem.data[1] {rechargeable} & (theItem.numCariche < 16000) & CheckItemNeeded (itemID, theChar, realPosition) & (theItem.data[12] { splittable } | (AlertLord (rJoinItemsAlert, 2, allButtons) = Ok)) THEN BEGIN WITH theChar.equipaggiamento[realPosition] DO BEGIN numCariche := numCariche + theItem.numCariche; weight := weight + theItem.weight; prezzo := prezzo + theItem.prezzo END; { Aggiungi il peso CORRETTO a quello del personaggio } theItem.Grab (theChar, TRUE); { Liberati dell'oggetto duplicato } theItem.Free; ItemHasChanged (theChar.equipaggiamento[realPosition]); CharacterHasChanged (theChar); GiveItemToChar := TRUE; Exit (GiveItemToChar); END; { Dove lo vuole mettere? } CASE where OF Sacco1: BEGIN { In un punto del sacco } firstAllowed := Sacco1; lastAllowed := Sacco6; END; Sacco6: BEGIN { Ovunque } firstAllowed := Testa; lastAllowed := Sacco6; END; OTHERWISE BEGIN { In un punto preciso } firstAllowed := where; lastAllowed := where; END END; { Controllo di fattibilitˆ } placeFound := FALSE; realPosition := lastAllowed; WHILE NOT placeFound & (realPosition >= firstAllowed) DO BEGIN placeFound := ItemCanBeThere (theItem, theChar, realPosition); IF NOT placeFound THEN realPosition := pred (realPosition) END; { Aftermath } IF placeFound THEN BEGIN theChar.equipaggiamento[realPosition] := theItem; CharacterHasChanged (theChar); { Dai all'oggetto la possibilitˆ di inizializzarsi e di aggiungere il suo peso a quello portato } theItem.Grab (theChar, realPosition >= Sacco1); { Check overload } IF IsOverloaded (theChar.weightLoad, theChar.WA) THEN GenericDreamAlert (kOverloaded); { Aggiorna il display, se del caso } buyerWindow := Personaggio2Window (theChar); IF buyerWindow <> NIL THEN BEGIN { Se la finestra del proprietario aperta, fa apparire l'oggetto } SetPort (buyerWindow); TMInvalRect (GetIndNrect (rFirstSilhouette+ord(theChar.classe), ord(realPosition))) END { if there is window } END ELSE BEGIN { Avvisa del fallimento } SellAlert (kSackFull); { Uh oh! destroy item! } theItem.Free; END; GiveItemToChar := placeFoundEND;{$S Characters}FUNCTION CastSpell (who: TPersonaggio; what: Integer): Char;{ Per una descrizione delle convenzioni vedere la dichiarazione di attackAdditionalInfodentro DreamMagic }VAR mySpell: TIncantesimo; spellID, i: Integer; myName: String; equip: Storage; { Posizione dove tiene il comp. mat. } c: Cell; itemIsUsedUp: Boolean; handleState: SignedByte; result: Char; aWindow: WindowPtr;BEGIN { Pu˜ fare incantesimi solo se non stato colpito in qs. round } IF who.hitDuringTheRound OR who.status[IsDead] THEN BEGIN IF who.hitDuringTheRound THEN SpellAlert (kCantCastWhenHit, 0) ELSE DoSoundAsync (sndImpossible); CastSpell := ' '; Exit (CastSpell) END; { trova l'ID dell'incantesimo selezionato. } spellID := who.spellsInMemory[what+1]; { La lista zero-based, il vettore one-based } myName := who.nome; { Toglilo dalla memoria - é necessario che la lista degli incantesimi memorizzati sia ordinata e senza buchi!!! } FOR i := what+1 TO kMaxSpellInMemory-1 DO who.spellsInMemory[i] := who.spellsInMemory[i+1]; { Aggiorna la lista di inc. disponibili a video SE ESISTE } aWindow := Personaggio2Window (who); IF (aWindow <> NIL) & (TMGetWRefCon (aWindow, kRefConForPage) = 3) THEN BEGIN c.h := 0; c.v := what; SetPort (aWindow); { CancellaCella richiede setport - bugfix 1.6 } {$PUSH} {$H-} handleState := HGetState (Handle (who)); HLock (Handle (who)); CancellaCella (who.listData, c); HSetState (Handle (who), handleState); {$POP} END; { Istanzia l'incantesimo } mySpell := DoCastSpell (spellID, who.livello, myName, who.whereAmI); attackAdditionalInfo.target := who; attackAdditionalInfo.identifyWhat := ManoDx; { Default per Identify - inutile altrimenti } { Ho i componenti materiali necessari??? } result := 'K'; { Supponiamo di si } IF mySpell.matComp <> 0 THEN IF CheckItemNeeded (mySpell.matComp, who, equip) THEN BEGIN itemIsUsedUp := TRUE; { Supponiamo che questo lo consumi } IF who.equipaggiamento[equip].numCariche > 1 THEN { Ma se ha caricheÉÊ} itemIsUsedUp := who.equipaggiamento[equip].Use; { Éallora togline una } IF itemIsUsedUp THEN ItemIsThrown (who.equipaggiamento[equip], who, TRUE, FALSE); END ELSE BEGIN SpellAlert (kMatSpellCompMiss, mySpell.matComp); mySpell.Free; attackAdditionalInfo.attackingSpell := NIL; result := '*'; END; who.hitDuringTheRound := TRUE; { Impediscigli di fare altri incantesimi in questo round } CastSpell := resultEND;{$S Characters}FUNCTION BeforeJoin (newGuysClass: TClasse): Boolean;VAR result: Boolean; allButtons: Family; i: Integer; s: Str255;BEGIN result := TRUE; { How many PCs already? } IF numPC = kMaxCharInUI+1 THEN BEGIN GenericDreamAlert (kRosterFull); result := FALSE END; IF result AND (numPC >= maxCharNumber) THEN BEGIN DoSoundAsync (sndAttention); ParamText (ItoS (numPC), IToS (maxCharNumber), '', ''); ClearFamily (allButtons); allButtons [kStdOkItemIndex] := TRUE; allButtons [kStdCancelItemIndex] := TRUE; IF AlertLord (rTooManyPCsAlert, 2, allButtons) = Cancel THEN result := FALSE END; { I paladini sono pi schizzinosi della mediaÉÊ} IF result & (newGuysClass = Paladino) & NOT NoEvils (TRUE) THEN BEGIN DoSoundAsync (sndAttention); GetIndString (s, rMiscStrings, rPaladinWontJoin); ParamText (s, '', '', ''); i := Alert (rPaladinAlert, NIL); result := FALSE END; BeforeJoin := RESULTEND;{$S Characters}PROCEDURE AfterJoin (a: TAllineamento);VAR s: Str255; i: Integer; incazz: Boolean;BEGIN { Se abbiamo fatto unire a noi un non-good, e abbiamo un paladinoÉ } IF a < CG THEN BEGIN i := -1; { Ciclo che passa tutti i personaggi e ritorna sempre ok=true a meno che il personaggio non sia un paladino } REPEAT i := succ (i); incazz := (Mondo[i].classe = Paladino); UNTIL (i = numPC-1) | incazz; { Se c' un paladinoÉÊ} IF incazz THEN BEGIN { Il paladino si incazza } DoSoundAsync (sndAttention); DoKillChar (i, TRUE); GetIndString (s, rMiscStrings, rPaladinWillLeave); ParamText (s, '', '', ''); i := Alert (rPaladinAlert, NIL) END { Incazzamento paladino } END; { Se abbiamo preso un non-good } SetPort (mainWindow); TMInvalrect (groupRect)END;{$S Characters}PROCEDURE Join (whom: TClasse);VAR guy: TPersonaggio; suoNome: String; okResult: Boolean;BEGIN IF NOT BeforeJoin(whom) THEN Exit (Join); { Proceed with join } okResult := false; { Sarˆ TRUE se l'utente cliccherˆ Join } guy := NIL; { Per riconoscere gli out of mem } New (guy); FailNIL (guy); IF whom < Mostro THEN guy.INIT (ord(whom)) ELSE guy.InitFromRes (placeID); okResult := length (guy.nome) > 0; IF okResult THEN BEGIN IF whom < Mostro THEN BEGIN { Mondo parte da zero } Mondo[numPc] := guy; numPC := succ(numPC) END ELSE Mondo[kNPCReference] := guy; suoNome := guy.nome; AddToTranscript (suoNome, ktJoins, '', 0); { Se il primo membro di un nuovo gruppo, attiva i menu } IF (numPC = 1) OR NOT gActiveChars THEN CharsHere END ELSE guy.ShallowFree; { Shallow perchŽ i campi non sono inizializzati } IF okResult THEN AfterJoin (guy.allineamento);END;{$S Characters}FUNCTION TimingSystem (amountOfTime: integer; mustEat: Boolean): Integer;VAR i: EntityRef; j: Storage; charges, numDead: Integer; anItem: TItem; aChar: TPersonaggio; aSpell: TIncantesimo; suoNome: String; foodFound, newDay, dummy, thisOneMustEat: BOOLEAN; BEGIN numDead := 0; IF ora > 24 * 60 THEN ora := 24 * 60; { Bug fix 2.2 } IF amountOfTime > 24 * 60 THEN amountOfTime := 24 * 60; { Safety trick, new for v2.1 } ora := ora + amountOfTime; { Show off the current time } SetPort (mainWindow); InvalRect (timePlace); { é un nuovo giorno? } newDay := ora > kMezzanotte; IF newDay THEN BEGIN ora := ora - kMezzanotte; giorno := succ (giorno); DoSoundAsync (sndBell); AddToTranscript ('', ktOneDayHasPassed, '', 0) END; { Da il time tick a tutti i personaggi, oggetti ed incantesimi } FOR i := 0 to numPC - 1 DO BEGIN aChar := Mondo[i]; suoNome := aChar.nome; aChar.hitDuringTheRound := FALSE; IF aChar.Time (amountOfTime) THEN numDead := succ (numDead); { Dai il time tick agli oggetti. Mentre lo fai cerca il cibo. } foodFound := FALSE; thisOneMustEat := mustEat; { Bug fix 1.6.2 } FOR j := Testa TO Sacco6 DO BEGIN anItem := aChar.equipaggiamento[j]; IF anItem <> NIL THEN BEGIN { Time tick } charges := aChar.equipaggiamento[j].numCariche; IF aChar.equipaggiamento[j].Time (amountOfTime) THEN ItemIsThrown (aChar.equipaggiamento[j], aChar, TRUE, FALSE) ELSE IF NOT (aChar.status[IsDead]) & thisOneMustEat & newDay & anItem.data[14] {is food} THEN BEGIN { Trovato! Ha del cibo! } foodFound := TRUE; { mangialo! } thisOneMustEat := FALSE; { Bug fix 1.6.2 } IF anItem.Use THEN { Ha finito il cibo } ItemIsThrown (anItem, aChar, TRUE, FALSE); END; { Cibo trovato } { Aggiorna la finestra a video se necessario } IF charges > aChar.equipaggiamento[j].numCariche THEN ItemHasChanged (aChar.equipaggiamento[j]) END { time tick } END; { Ciclo FOR sugli oggetti } { Se non mangia, ne soffre } IF newDay THEN BEGIN IF thisOneMustEat & NOT foodFound & NOT aChar.status[IsDead] THEN BEGIN AddToTranscript (suoNome, ktStarves, '', 0); IF HPChange (aChar, aChar.costituzione-19) THEN BEGIN dummy := aChar.Kill; { Il metodo Kill di un personaggio non dˆ mai TRUE } numDead := succ (numDead) END; CharacterHasChanged (aChar); END; { Se ha perso HP } { Se passato un anno, invecchia i personaggi } IF giorno MOD 364 = 0 THEN BEGIN { Bug fix 1.6: 364 } Mondo[i].eta := succ (Mondo[i].eta); CharacterHasChanged (Mondo[i]); END END; { Dai il time tick agli incantesimi del personaggio } aSpell := aChar.activeSpells; SpellTimingSystem (aSpell, amountOfTime); aChar.activeSpells := aSpell; END; { for su tutti i personaggi } IF numDead > 0 THEN SomeoneDiedCheckForActiveChars; { Bug fix 2.1 } TimingSystem := numDeadEND; {$S Characters}PROCEDURE HandleRest (mustEat: Boolean);{ Ha chiesto di riposare. Vediamo un po'É }VAR i: EntityRef; dummy: Boolean; hisWindow: WindowPtr; unNome: String; loop: Integer;BEGIN { Non lasciarli riposare nel treasure dispatch place! } { Bug fix 1.6.1 } IF placeID = rEncounterTreasure THEN EXIT (HandleRest); { Pu˜ riposare una volta al giorno, quindiÉ } IF (dayOfLastRest = giorno) THEN BEGIN AddToTranscript ('', ktTheGroup, '', ktDoesntRest); DoSoundAsync (sndImpossible); Exit (HandleRest); END; IF placeData[5] { wander monsters } THEN BEGIN AddToTranscript ('', ktTheGroup, '', ktHearsMonsters); DoSoundAsync (sndImpossible); Exit (HandleRest); END; { Se non si trovano in locanda, falli russare } IF mustEat THEN DoSoundAsync (sndSleeps); { OK, fa passare il tempo } AddToTranscript ('', ktTheGroup, '', ktRests); loop := TimingSystem (8*60, mustEat); { Otto ore } dayOfLastRest := giorno; FOR i := 0 TO numPC-1 DO BEGIN thisCharacter := Mondo[i]; unNome := thisCharacter.nome; IF NOT thisCharacter.Status [IsDead] & thisCharacter.Status [IsIll] & (Dado (1, 100) <= Mondo[i].costituzione * 2) THEN BEGIN AddToTranscript (unNome, ktIsCured, '', 0); thisCharacter.Status[isIll] := FALSE; { Malattia passata - new for 1.6 } END; { Lasciagli recuperare gli incantesimi } IF IsSpellCaster (Mondo[i].classe, Mondo[i].livello) THEN BEGIN HLock (Handle (Mondo[i])); {$PUSH} {$H-} WITH Mondo[i] DO RefillSpells (knownSpells, numKnownSpells, spellsInMemory, spellsPerLevel); {$POP} HUnlock (Handle (Mondo[i])); { Se ha la finestra aperta su pag. 3, bisognerebbe aggiornare la lista a video. Il che un po' complicato. Per ora mi limito a chiudergli la finestraÉÊ} hisWindow := Personaggio2Window (Mondo[i]); IF (hisWindow <> NIL) & (TMGetWRefCon (hisWindow, kRefConForPage) = 3) THEN MyDisposeWindow (hisWindow) END; { Assegna lo speciale incantesimo ai paladino - new for v1.6 } IF (Mondo[i].classe = Paladino) & (Mondo[i].spellsInMemory[1] <> kSpelSpecialPaladin) THEN BEGIN { Sposta gli altri } FOR loop := kMaxSpellInMemory DOWNTO 2 DO Mondo[i].spellsInMemory[loop] := Mondo[i].spellsInMemory[loop-1]; { Assegna questo } Mondo[i].spellsInMemory[1] := kSpelSpecialPaladin END; { Dagli un punto vita per il riposo } dummy := HPChange (Mondo[i], 1); CharacterHasChanged (Mondo[i]); END; { Ricorda che qualcosa cambiato (HP, etc) quindi bisogna salvare } dirty := TRUEEND;{$S Characters}FUNCTION IsOverloaded (load: Longint; WA: integer): Boolean;BEGIN load := load * 10 DIV WA; IsOverloaded := load > 8;END;{$S Characters}FUNCTION CalcNumAttacks (c: TClasse; l: Livello): SignedByte;BEGIN CASE c OF Combattente: CalcNumAttacks := 2 + l DIV 5; Ranger, Paladino: CalcNumAttacks := 2 + l DIV 6; OTHERWISE CalcNumAttacks := 2 ENDEND;{$S Characters}FUNCTION CalcTHACO (c: TClasse; l: Livello; forza: Integer): SignedByte;VAR result: SignedByte;BEGIN CASE c OF Combattente, Paladino, Ranger: result := 21 - l; Chierico, Ladro: result := 20 - l DIV 2; Mago: result := 21 - l DIV 4; Mostro: IF l = 1 THEN result := 21 ELSE result := 20 - l DIV 3 * 2; END; IF c < Mostro THEN BEGIN IF forza < 6 THEN result := result - forza + 6; IF c < Ladro THEN { Fighter type? } CASE forza OF 16: result := result + 1; 17: result := result + 2; 18..18+50: result := result + 3; 18+51..18+75: result := result + 4; 18+76..18+89: result := result + 5; 18+90..18+99: result := result + 6; 18+100: result := result + 7 END; { case } END; { if not monster } CalcTHACO := resultEND;{$S Characters}FUNCTION HPBonus (c: Caratteristica; k: TClasse): Byte;VAR result: INTEGER;BEGIN IF c > 14 THEN BEGIN result := c - 14; IF (k > Ranger) & (result > 2) THEN result := 2 END ELSE IF c < 7 THEN result := (8 - c) DIV 2 ELSE result := 0; HPBonus := resultEND;{$S Characters}FUNCTION RollHP (c: TClasse): Byte;{ Tira un dado per un personaggio di classe data che passato di livello }BEGIN CASE c OF chierico, ranger: RollHP := Dado (1, 8); combattente, paladino: RollHP := Dado (1, 10); ladro: RollHP := Dado (1, 6); mago: RollHP := Dado (1, 4) END { case }END;{$S Characters}FUNCTION ShellForLearningSpells (learner: TPersonaggio; spellID: Integer): Boolean;{ Problema. L'uso di uno scroll va gestito da TItem.Use. Che per˜ non sa nulladell'esistenza dei personaggi, e quindi non pu˜ certo chiamare LearnNewSpell inDreamMagic. Questa funzione, dichiarata come External dentro HiLevel, chiamata daITtem.Use, e chiama LearnNewSpell per suo conto. Poi ritorna TRUE se l'incantesimo stato appreso e lo scroll usato, FALSE altrimenti }BEGIN HLock (Handle (learner)); {$PUSH} {$H-} IF LearnNewSpells (learner.nome, learner.knownSpells, learner.numKnownSpells, 1, spellID, 7, (learner.classe = Chierico) OR (learner.classe = paladino)) THEN BEGIN {$POP} ShellForLearningSpells := TRUE; learner.numKnownSpells := Succ (learner.numKnownSpells) END ELSE ShellForLearningSpells := FALSE; HUnlock (Handle (learner))END;{$S Characters}PROCEDURE ShellForKillingChars (who: TPersonaggio);VAR i: EntityRef;BEGIN i := numPC-1; REPEAT IF StripAddress (Mondo[i]) = StripAddress (who) THEN { Vedi i commenti a Simulacrum in HiLevel.p } moveBuffer := concat (moveBuffer, chr (i+7)); { Bug fix 2.2: ogni tanto un chr(0) si fa strada in moveBufferÉÊ} i := i-1 UNTIL i < 0END;{$S Characters}PROCEDURE ShellForCastingSpells (itemName: String; owner: TCreatura; spellID: Integer);VAR mySpell: TIncantesimo;BEGIN mySpell := DoCastSpell (spellID, kCasterLevelForItems, '', owner.whereAmI); IF mySpell <> NIL THEN BEGIN attackAdditionalInfo.target := owner; attackAdditionalInfo.areaWidth := mySpell.area { PerchŽ serve? PerchŽ il TargetSystem non ci pensa lui? } ENDEND;{$S Characters}Procedure MoreXP (howMany: Longint);CONST rNoNewLevelAlert = 152;VAR i: EntityRef; j, bonus, maxLevel: integer; suoNome: String; allButtons: Family;BEGIN FOR i := 0 TO numPC-1 DO BEGIN Hlock (Handle (Mondo[i])); WITH Mondo[i] DO IF NOT status[isDead] & (whereAmI.h > 0) { Non fuggito } THEN BEGIN XP := XP + howMany; suoNome := Mondo[i].nome; AddToTranscript (suoNome, ktEarns, ItoS (howMany), ktXP); IF XP >= XPToNextLevel THEN BEGIN IF Verifica THEN BEGIN DoSoundAsync (sndNewLevel); AddToTranscript (suoNome, ktEarns, '', ktNewLevel); livello := succ (livello); THACO := CalcTHACO (classe, livello, forza+superforza); attacchiPerDueRound := CalcNumAttacks (classe, livello); baseHP[livello] := RollHP (classe); bonus := HPBonus (costituzione, classe); maxHP := maxHP + BaseHP [livello] + bonus; HP := HP + BaseHP [livello] + bonus; XPForThisLevel := XPToNextLevel; { Tengo nota degli XP min per qs. livello } XPToNextLevel := FindNextXP (Classe, Livello); IF IsSpellcaster (classe, livello) THEN BEGIN { Scopri quanti incantesimi per livello pu˜ memorizzare. Strada facendo, prendi nota e scopri quale sia il massimo livello di difficoltˆ di incantesimo: dobbiamo comunicarlo a LearnNewSpells } {$PUSH} {$H-} FindSpellsPerLevel (livello, classe, spellsPerLevel); {$POP} FOR j := 1 TO kMaxSpellLevel DO IF spellsPerLevel[j] > 0 THEN maxLevel := j; { Permettigli di imparare un incantesimo in pi } {$PUSH} {$H-} thisCharacter := Mondo[i]; IF LearnNewSpells (suoNome, knownSpells, numKnownSpells, 1, 0, maxLevel, classe in [Chierico, Paladino]) THEN numKnownSpells := succ (numKnownSpells); {$POP} END; { if spellcaster } END { if regular payer } ELSE BEGIN ClearFamily (allButtons); allButtons [kStdOkItemIndex] := TRUE; ParamText (suoNome, '', '', ''); j := AlertLord (rNoNewLevelAlert, 1, allButtons); END { unregistered } END; { if promoted } CharacterHasChanged (Mondo[i]); HUnlock (Handle (Mondo[i])); END; { for } END { IF personaggio merita XP }END;{$S Characters}PROCEDURE CharactersShutdown;VAR i: EntityRef; unPers: TPersonaggio;BEGIN { Dealloca tutti i personaggi, e i loro oggetti e spell } FOR i := 0 TO numPC-1 DO Mondo[i].Free; { Questo di per sŽ chiude tutte le finestre tranne quella principale e i windoid. } { Lo NPC } IF Mondo [kNPCReference] <> NIL THEN BEGIN Mondo [kNPCReference].Free; Mondo [kNPCReference] := NIL END; { Dealloca i personaggi in locanda } WHILE listaPersInLocanda <> NIL DO BEGIN unPers := listaPersInLocanda.nextChar; listaPersInLocanda.Free; listaPersInLocanda := unPers END;END;{$S Characters}FUNCTION OutputRace (r: TRazza): STR255;{ Gives back a string with the race name }BEGIN GetIndString (OutputRace, rMiscStrings, ORD(r) + rStrHuman)END;(***************** TPersonaggio.Init and support routines *********************){$S LowLevel}Procedure ACapo (VAR r: RECT);{ Procedura schiava di DrawKernelData e DrawCharData.posizionati sul bordo sx dello spazio, e su una nuova riga }CONST kInterlinea = 16;BEGIN r.top := r.top + kInterlinea; MoveTo(r.left+10,r.top)END;{$S Characters}PROCEDURE DrawKernelData (p: TPersonaggio; space: Rect; alsoOutOf: boolean);{ Disegna le caratteristiche pi importanti. é chiamata da DrawCharData,qui sotto, e da DrawCharWindow in game.p }VAR pt: Point; handleState: SignedByte;BEGIN TextFont (stdFontID); TextSize (stdFontSize); { Disegna un rettangolo che ingloba le caratteristiche } space.bottom := space.top + 120; DrawGrayRect (space); { Scrivi i dati } space.top := space.top + 8; { Posizione ideale per estetica } ACapo (space); handleState := HGetState (Handle(p)); HLock (Handle(p)); WITH p DO BEGIN DrawMiscString (rStrS); DrawString (IToS(forza)); IF superforza > 0 THEN BEGIN DrawChar ('/'); IF superforza < 10 THEN DrawChar ('0'); DrawString (IToS(superforza)) END; ACapo (space); DrawMiscString (rStrI); DrawString (IToS(intelligenza)); ACapo (space); DrawMiscString (rStrW); DrawString (IToS(saggezza)); ACapo (space); DrawMiscString (rStrD); DrawString (IToS(destrezza)); ACapo (space); DrawMiscString (rStrCo); DrawString (IToS(costituzione)); ACapo (space); DrawMiscString (rStrCh); DrawString (IToS(carisma)); ACapo (space); ACapo (space); DrawMiscString (rStrHP); GetPen (pt); { Scopre dove disegnare } DrawString (IToS (HP)); ACapo (space); DrawMiscString (rStrAge); DrawString (IToS (eta)); ACapo (space); DrawMiscString (rStrGP); DrawString (IntegerToLocalString (GP)); { OK, ora vediamo le condizioni aberranti } { Innanzitutto posizioniamoci a destra dei dati appena scritti (HP etc) } space.top := pt.v; space.left := pt.h + kCWWidth DIV 2; (*** 128 == kCWWidth DIV 2 ***) MoveTo (space.left, space.top); { Ora il colore rosso per avvisareÉ } ForeColor (redColor); { Siamo pronti } IF status [isDead] THEN DrawMiscString (rStrDead) ELSE IF status[IsStoned] THEN DrawMiscString (rStrStoned) ELSE IF status[isIll] THEN DrawMiscString (rStrIll); ACapo (space); IF isPoisoned > 0 THEN DrawMiscString (rStrPoisoned); { Rimetti a posto il color nero, ci siamo } ForeColor (blackColor); END; HSetState (Handle(p), handleState)END;{$S DefProcs}PROCEDURE DrawCharData (where: DialogPtr; item: INTEGER);{ Defproc richiamata dal dialog manager per scrivere i dati di un personaggiodella finestra di dialogo manipolata dentro TPersonaggio.Init. (é uno useritem)Risolve tutto chiamando DrawKernelData }VAR r: Rect;BEGIN GetItemRect (where, item, r); DrawKernelData (TPersonaggio(thisCharacter), r, FALSE)END;{$S Characters}PROCEDURE TPersonaggio.InitFromRes (ref: Integer);CONST kSizeOfCreatureData = 26; kSizeOfPhysicalData = 12; kSizeOfCharData = 24; kSizeOfXPGPData = 12;VAR definition: Handle; scanner: Ptr; i, copyOfHP, HPslice, numSpellsInMemory: Integer; s: Storage; { Per azzerare l'equipaggiamento } powerSetLoop: KindOfAttack;begin HLock (Handle(self)); { We are going to shuffle things a lot, and we need to access our fields a lot, so this makes things safer } definition := MyGetResource (resCharacter, ref, TRUE, TRUE); scanner := definition^; { Se il personaggio giˆ stato caricato, ho azzerato la risorsa. Vediamo. } IF scanner^ = 0 THEN BEGIN GenericDreamAlert (kAlreadyGotHim); Exit (InitFromRes) END; { OK, si pu˜ proseguire } nome := GetStringFromRes (scanner); icon := GetIntegerFromRes (scanner); status[IsPC] := TRUE; { New for v2.1 - significa che un TPersonaggio, dunque giusto cos“ } {$PUSH} {$H-} WITH v11 DO BEGIN fullIcon := GetIntegerFromRes (scanner); hasOpenWindow := FALSE END; {$POP} BlockMove (scanner, @dannoInDadi, kSizeOfCreatureData); scanner := Ptr(Longint(scanner)+kSizeOfCreatureData); FOR powerSetLoop := kFirstAttack TO kLastAttack DO specialModifiers[powerSetLoop] := TRUE; { sovraprudenza } wieldedWeapon := Sacco1; BlockMove (scanner, @THACO, kSizeOfPhysicalData); scanner := Ptr(Longint(scanner)+kSizeOfPhysicalData); activeSpells := NIL; BlockMove (scanner, @classe, kSizeOfCharData); scanner := Ptr(Longint(scanner)+kSizeOfCharData); copyOfHP := HP; HPslice := HP DIV livello; FOR i := 1 TO livello - 1 DO BEGIN baseHP[i] := HPslice; copyOfHP := copyOfHP - HPslice END; baseHP[livello] := copyOfHP; BlockMove (scanner, @XP, kSizeOfXPGPData); scanner := Ptr(Longint(scanner)+kSizeOfXPGPData); XPForThisLevel := XP; XPtoNextLevel := FindNextXP (classe, livello); {$PUSH} {$H-} FindSpellsPerLevel (livello, classe, spellsPerLevel); {$POP} FOR s := Testa TO Sacco6 DO equipaggiamento[s] := NIL; numKnownSpells := GetIntegerFromRes (scanner) + 1; FOR i := 1 TO numKnownSpells DO knownSpells[i] := GetIntegerFromRes (scanner); FOR i := numKnownSpells+1 TO kMaxKnownSpells DO knownSpells[i] := 0; numSpellsInMemory := GetIntegerFromRes (scanner) + 1; FOR i := 1 TO numSpellsInMemory DO spellsInMemory[i] := GetIntegerFromRes (scanner); FOR i := numSpellsInMemory+1 TO kMaxSpellInMemory DO spellsInMemory[i] := 0; { Carica in una globale i dati aggiuntivi dell'NPC } WITH npcData DO BEGIN placeForExit := GetIntegerFromRes (scanner); talkOnExit := GetIntegerFromRes (scanner); nctrForExit := GetIntegerFromRes (scanner) END; { Indichiamo che qs. personaggio giˆ stato caricato e non pu˜ pi venire usato nello scenario, creando una risorsa di zeri e salvandola nel savegame file } ReleaseResource (definition); definition := NewHandleClear (4); WriteRes (currentSaveGameFile, ref, resCharacter, '', definition); ReleaseResource (definition); { Grazie e arrivederci } HUnLock (Handle(self))END;{$S Characters}{$R-}Procedure TPersonaggio.Init (ref: integer);{ 1.1, 8feb94: usa startingCharLevel dallo scenario info, e implementa le razze }{ 7 lug 94: Aggiunti i pi attacchi per livello ai fighter avanzati, e la sceltadelle icone }CONST rFighterIcon = 158; { Icona per un combattente, visto in primo piano. Le icone delle altre classi seguono (159, 160É) Le icone alternative sono disposte a numeri decrescenti di sei in sei (le altre per il combattente sono a 152, 146É) } rFullFighterIcon = 170; { Icona per un combattente, visto in figura completa. Le icone delle altre classi seguono (171, 172É) Le icone alternative sono disposte a numeri crescenti di sei in sei (le altre per il combattente sono a 176, 182É) } { Items inside the dialog } rJoin = 1; rCancel = 2; rReroll = 3; rIcon = 4; rName = 6; rData = 8; rAlignSpace = 9; rNG = 17; rLG = 18; { E' importante che sia l'ultima, (ciclo in init paladin) } rCN = 13; rCG = 16; rTN = 14; rLN = 15; rCE = 12; rNE = 11; rLE = 10; rRadioBtnHuman = 19; rRadioBtnElf = 20; rRadioBtnDwarf = 21; rRadioBtnGnome = 22; rFullIcon = 23; kLastItem = rFullIcon;VAR item: integer; { item cliccato } mustRoll: Boolean; { Messo a true quando l'utente chiede di tirare di nuovo i dati } none, raceButtons, nameItem, { Lo item del nome: passato a DialogLord con la preghiera di accettare 20 char } mostItems: family; { Tutti gli item cliccabili sui quali devo reagire } myDlog: DialogPtr; oldPort: GrafPtr; e: EventRecord; { From DialogLord } iBox : Rect; { To selectively redraw items } dummyHandle: Handle; { Per verificare l'esistenza di un'icona } Procedure MyDefault3DButton (d: DialogPtr; item: Integer); { da DialogLord 2.3.1 } const kCntlActivate = 0; { enabled controlÕs hilite state } kCntlDeactivate = $FF; { disabled controlÕs hilite state } var itembox : rect; itemtype : integer; itemhdl : handle; r: rect; curPen: PenState; buttonOval: INTEGER; begin GetDialogItem (d,item,itemtype,itemhdl,itembox); GetItemRect (d, item, r); GetPenState(curPen); { Salva lo status della penna } PenNormal; PenSize (3, 3); InsetRect (r, -4, -4); buttonOval := ((r.bottom - r.top) DIV 2) + 2; { IM dice di usare 16, ma con grandi bottoniÉ} { se il bottone disattivo, l'outline va fatto in grigio } IF (ControlHandle(itemhdl)^^.contrlHilite <> kCntlActivate) THEN PenPat(qd.gray); { Disegna il contorno } FrameRoundRect (r, buttonOval, buttonOval); SetPenState(curPen) end; PROCEDURE PIInitObjectData; VAR cursore: Storage; i: Integer; Begin { Consenti al codice di basso livello di inizializzarsi } INHERITED Init (ref); { Init fields } classe := TClasse (ref); livello := startingCharLevel; razza := Umano; { default } status[IsPC] := TRUE; { New for v2.1 } allineamento := NNN; { poi ci pensiamo } XP := FindNextXP (classe, startingCharLevel-1); { Funza anche se passo zero } maxXP := XP; XPToNextLevel := FindNextXP (classe, startingCharLevel); XPForThisLevel := XP; numKnownSpells := 0; icon := rFighterIcon + ref; { Le icone sono sequenziali } attacchiPerDueRound := CalcNumAttacks (classe, startingCharLevel); WITH v11 DO BEGIN hasOpenWindow := FALSE; windowPos.h := 0; windowPos.v := 0; fullIcon := rFullFighterIcon + ref END; windowIsWide := TRUE; { New for v2.0 } { Mettilo in un punto di default della formazione } formazione.v := 2; formazione.h := numPC+1; { All'inizio disarmato } CharacterHasNoWeapons (self); { La lista degli incantesimi non stata ancora creata. Ci metto NIL per evitare che venga fatto un dispose inconsulto } listData.theList := NIL; FOR cursore := Testa TO Sacco6 DO equipaggiamento [cursore] := NIL; {$PUSH} {$H-} FindSpellsPerLevel (livello, classe, spellsPerLevel); {$POP} FOR i := 1 TO kMaxSpellInMemory DO spellsInMemory[i] := 0; FOR i := 1 TO kMaxKnownSpells DO knownSpells [i] := 0; FOR i := 1 TO kMaxCharLevel DO baseHP [i] := 0; END; PROCEDURE PIPrepareDialog; VAR i: Integer; BEGIN GetPort (oldPort); SetPort (myDlog); TextFont (stdFontID); TextSize (stdFontSize); { Get ready with DialogLord } DefaultButton (myDlog, TRUE); ClearFamily (none); ClearFamily (raceButtons); FOR i := rRadioBtnHuman TO rRadioBtnGnome DO raceButtons[i] := TRUE; ClearFamily (mostItems); FOR i := rJoin TO rIcon DO mostItems[i] := TRUE; FOR i := rRadioBtnHuman TO rFullIcon DO mostItems[i] := TRUE; mostItems [rName] := TRUE; FOR i := rLE TO rLG DO mostItems[i] := TRUE; ClearFamily (nameItem); nameItem [rName] := TRUE; SetRadio (myDlog, rRadioBtnHuman, kLastItem, raceButtons); { Set the draw procedures for my user items. The first gives me a chance to display the char's icon, while the second shows the char's characteristics. } thisCharacter := SELF; { External reference for DrawClassIcon } { First user item: icon } SetItemProcedure (myDlog, rIcon, @DrawClassIcon); {install draw proc} { second user item: text data } SetItemProcedure (myDlog, rData, @DrawCharData); {install draw proc} { Third user item: body } SetItemProcedure (myDlog, rFullIcon, @DrawClassIcon); {install draw proc} ShowWindow(myDlog); {make it visible} { Init dipendente dalla classe } CASE classe OF paladino: BEGIN FOR i := rLE TO rLG-1 DO DisableDialogItem (myDlog, i); { Un paladino pu˜ essere solo umano } DisableDialogItem (myDlog, rRadioBtnElf); DisableDialogItem (myDlog, rRadioBtnDwarf); DisableDialogItem (myDlog, rRadioBtnGnome); END; ranger: BEGIN { A ranger can't be of an extreme alignment } DisableDialogItem (myDlog, rCE); DisableDialogItem (myDlog, rLG); DisableDialogItem (myDlog, rLE); DisableDialogItem (myDlog, rCG); { Un ranger non pu˜ essere nano } DisableDialogItem (myDlog, rRadioBtnDwarf); END; ladro: BEGIN DisableDialogItem (myDlog, rNG); DisableDialogItem (myDlog, rLG); DisableDialogItem (myDlog, rCG); { Un ladro non pu˜ essere nano } DisableDialogItem (myDlog, rRadioBtnDwarf); END; mago: { Un mago non pu˜ essere nano } DisableDialogItem (myDlog, rRadioBtnDwarf); chierico: { Un chierico non pu˜ essere elfo (per nessun motivo particolareÉ) } DisableDialogItem (myDlog, rRadioBtnElf); END; { case } InitCursor { Bug fix 2.0 } END; PROCEDURE PIReadBaseData; { Richiede: nulla } VAR temp: Str255; { buffer } BEGIN { razza } razza := TRazza (GetRadio(myDlog, kLastItem, raceButtons) - rRadioBtnHuman); { Lettura del nome battuto nel dialogo } GetItemText (myDlog, rName, temp); { Pascal won't like employing a field } BlockMove (@temp, @nome, SizeOf (nome)); IF length (nome) = 0 THEN DisableDialogItem (myDlog, rJoin) ELSE BEGIN EnableDialogItem (myDlog, rJoin); { Forza il nome all'iniziale maiuscola } UpperText (@nome[1], 1); END; MyDefault3DButton (myDlog, rJoin); { Serve solo sinchŽ uso il CDEF 3D } END; PROCEDURE PISelectStartingSpells; { Richiede: classe, livello } VAR i, maxLevel: Integer; BEGIN { Consenti la scelta di incantesimi iniziali } thisCharacter := SELF; IF IsSpellCaster (classe, startingCharLevel) THEN BEGIN { Calcola il max level degli spell memorizzabili } FOR i := 1 TO kMaxSpellLevel DO IF spellsPerLevel[i] > 0 THEN maxLevel := i; {$PUSH} {$H-} { C' uno hlock in corso su self } IF LearnNewSpells (nome, knownSpells, 0, startingCharLevel+2, 0, maxLevel, classe in [Chierico, Paladino]) THEN numKnownSpells := startingCharLevel+2; {$POP} { Cortesia: se c' un nuovo spellcaster consentiamo il riposo, di modo che possa imparare il suo incantesimo } dayOfLastRest := giorno-1; END; END; PROCEDURE PIRollGold; { Richiede: classe e livello } BEGIN case classe OF chierico: GP := Dado (1, 10) * 10 * startingCharLevel; ranger: GP := Dado (4, 6) * 10 * startingCharLevel; combattente: GP := Dado (3, 6) * 10 * startingCharLevel; paladino: GP := Dado (3, 6) * 10; ladro: GP := Dado (3, 4) * 10 * startingCharLevel; mago: GP := Dado (2, 4) * 10 * startingCharLevel; END; { case } { Setta un weightLoad iniziale corretto } weightLoad := GP; END; PROCEDURE PIRollHP; { Richiede: classe, caratteristiche e livello } VAR i: Integer; BEGIN { hp } HP := 0; FOR i := 1 TO startingCharLevel DO BEGIN BaseHP[i] := RollHP (classe); HP := HP + BaseHP[i] + HPBonus (costituzione, classe) END; IF HP < 1 THEN HP := 1; { Per il raro caso in cui tiro basso e costituzione bassa } maxHP := HP; END; PROCEDURE PIRollCharacteristics; { Richiede: classe e livello e razza } BEGIN case classe OF chierico: BEGIN CASE razza OF { New for v1.7 } Umano: eta := 18 + Dado (2, 4) + startingCharLevel; Elfo: eta := 500 + Dado (10, 10); Nano: eta := 250 + Dado (2, 20); Gnomo: eta := 300 + Dado (3, 12) END; forza := Best3OutOf (4); superforza := 0; intelligenza := Best3OutOf (5); destrezza := Best3OutOf (3); costituzione := Best3OutOf (6); saggezza := Best3OutOf (8); carisma := Best3OutOf (7); END; ranger: BEGIN CASE razza OF { New for v1.7 } Umano: eta := 20 + Dado (1, 6) + startingCharLevel; Elfo: eta := 130 + Dado (5, 6); Nano: eta := 40 + Dado (5, 4); Gnomo: eta := 60 + Dado (5, 4) END; forza := Best3OutOf (7); IF forza = 18 then superforza := Dado (1, 100) ELSE superforza := 0; intelligenza := Best3OutOf (6); destrezza := Best3OutOf (5); costituzione := Best3OutOf (8); saggezza := Best3OutOf (4); carisma := Best3OutOf (3); END; combattente: BEGIN CASE razza OF { New for v1.7 } Umano: eta := 15 + Dado (1, 4) + startingCharLevel; Elfo: eta := 130 + Dado (5, 6); Nano: eta := 40 + Dado (5, 4); Gnomo: eta := 60 + Dado (5, 4) END; forza := Best3OutOf (8); IF forza = 18 then superforza := Dado (1, 100) ELSE superforza := 0; intelligenza := Best3OutOf (3); destrezza := Best3OutOf (6); costituzione := Best3OutOf (7); saggezza := Best3OutOf (4); carisma := Best3OutOf (5); END; paladino: BEGIN eta := 18 + Dado (1, 6) + startingCharLevel; forza := Best3OutOf (7); IF forza = 18 then superforza := Dado (1, 100) ELSE superforza := 0; intelligenza := Best3OutOf (3); destrezza := Best3OutOf (4); costituzione := Best3OutOf (5); saggezza := Best3OutOf (6); carisma := Best3OutOf (8); END; ladro: BEGIN CASE razza OF { New for v1.7 } Umano: eta := 14 + Dado (1, 6) + startingCharLevel; Elfo: eta := 100 + Dado (5, 6); Nano: eta := 75 + Dado (3, 6); Gnomo: eta := 80 + Dado (5, 4) END; forza := Best3OutOf (4); superforza := 0; intelligenza := Best3OutOf (5); destrezza := Best3OutOf (8); costituzione := Best3OutOf (7); saggezza := Best3OutOf (3); carisma := Best3OutOf (6); END; mago: BEGIN CASE razza OF { New for v1.7 } Umano: eta := 24 + Dado (2, 8) + startingCharLevel; Elfo: eta := 150 + Dado (5, 6); Nano: eta := 250 + Dado (2, 20); Gnomo: eta := 100 + Dado (2, 12) END; forza := Best3OutOf (3); superforza := 0; intelligenza := Best3OutOf (8); destrezza := Best3OutOf (7); costituzione := Best3OutOf (5); saggezza := Best3OutOf (6); carisma := Best3OutOf (4); END; END; { case } { Calcolo della AC } IF destrezza > 14 THEN AC := 24 - destrezza ELSE AC := 10; THACO := CalcTHACO (classe, startingCharLevel, forza+superforza) END; PROCEDURE PIRollHeightAndWeight; { Richiede: razza e caratteristiche } VAR i, modifier: Integer; longBuffer: Longint; BEGIN { Altezza } CASE razza OF Umano: height := 72; Elfo: height := 60; Nano: height := 48; Gnomo: height := 42 END; i := Dado (1, 100); CASE i OF 1..15: modifier := - Dado (1, 12); 16..86: modifier := 0; OTHERWISE modifier := Dado (1, 12) END; { case } IF razza <> Umano THEN height := height + modifier DIV 2 ELSE height := height + modifier; { Peso } CASE razza OF Umano: weight := 175; Elfo: weight := 100; Nano: weight := 150; Gnomo: weight := 80 END; i := Dado (1, 100); CASE i OF 1..15: CASE razza OF Umano: weight := weight - Dado (3, 12); Elfo: weight := weight - Dado (1, 10); Nano: weight := weight - Dado (2, 8); Gnomo: weight := weight - Dado (2, 4) END; 16..86: ; OTHERWISE CASE razza OF Umano: weight := weight + Dado (5, 12); Elfo: weight := weight + Dado (1, 20); Nano: weight := weight + Dado (2, 12); Gnomo: weight := weight + Dado (2, 6) END; { case razza of } END; { case i of } { weight allowance } longBuffer := (weight * 10); { base: peso per dieci } longBuffer := longBuffer * forza DIV 18 + { effettiva: proporzione su forza 18 } longBuffer DIV 10 * { Pi bonus per superforza } superforza DIV 10; { (Calcolato cos“ per evitare overflow) } WA := LoWrd (longBuffer); END;begin HLock (Handle(self)); { We are going to shuffle things a lot, and we need to access our fields a lot, so this makes things safer } PIInitObjectData; { load dialog } myDlog := GetNewDialog(rNewCharDlog,NIL,WindowPtr(-1)); IF myDlog = NIL THEN DeathAlert (errMissingApplRes, resNotFound); PIPrepareDialog; { Init dipendente dalla classe } CASE classe OF paladino: BEGIN { A paladin must be lawful good } allineamento := LG; { Un paladino soggetto a curse ma non alle malattie } specialDefenses[Illness] := TRUE; specialDefenses[Curse] := FALSE; END; ladro: { A thief can only be evil } allineamento := NE; END; { case } { have the class and alignment ready for show } ParamText (OutputClass (classe), OutputAlignment (allineamento), Itos(startingCharLevel), ''); { Ciclo eventi del dialog } mustRoll := true; DisableDialogItem (myDlog, rJoin); { Disabilitato sinchŽ non scrive un nome } MyDefault3DButton (myDlog, rJoin); { Serve solo sinchŽ uso il CDEF 3D } REPEAT if mustRoll THEN BEGIN PIRollGold; PIRollCharacteristics; PIRollHP; PIRollHeightAndWeight; { Don't roll next time we come through here } mustRoll := false END; { if characteristics must be rolled } {ÊCiclo eventi } item := DialogLord (myDlog, kLastItem, raceButtons, none, mostItems, none, none, nameItem, nameItem, 16, e); QTMusicIdle; { Senn˜ la musica dopo un po' si blocca } PIReadBaseData; CASE item OF rRadioBtnHuman, rRadioBtnElf, rRadioBtnDwarf, rRadioBtnGnome, rReroll: BEGIN mustRoll := TRUE; { have it redrawn correctly } GetItemRect (myDlog, rData, iBox); InvalRect (iBox); EraseRect (iBox); END; rLE..rLG: BEGIN { New alignment } allineamento := TAllineamento (item - rLE); { have it redrawn correctly } GetItemrect (myDlog, rAlignSpace, iBox); Invalrect (iBox); ParamText (OutputClass (classe), OutputAlignment (allineamento), '', '') END; rIcon: BEGIN icon := icon - 6; GetItemrect (myDlog, rIcon, iBox); EraseRect (iBox); Invalrect (iBox); { Esiste? } dummyHandle := MyGetResource ('cicn', icon, FALSE, FALSE); IF dummyHandle = NIL THEN { Non esiste. Ricominciamo il ciclo dalla prima } icon := rFighterIcon + ref ELSE { Si, esiste, ma potrebbe non servire per molto } HUnlock (dummyHandle); END; rFullIcon: BEGIN v11.fullIcon := v11.fullIcon + 6; GetItemrect (myDlog, rFullIcon, iBox); EraseRect (iBox); Invalrect (iBox); { Esiste? } dummyHandle := MyGetResource (large1BitMask, v11.fullIcon, FALSE, FALSE); IF dummyHandle = NIL THEN { Non esiste. Ricominciamo il ciclo dalla prima } v11.fullIcon := rFullFighterIcon + ref ELSE { Si, esiste, ma potrebbe non servire per molto } HUnlock (dummyHandle); END; END; { case } UNTIL (item = rCancel) | ((item = rJoin) & (length (nome) > 0)); { Liberati della finestra di dialogo } SetPort (oldPort); ResetItemProcedure (myDlog, rIcon); ResetItemProcedure (myDlog, rFullIcon); ResetItemProcedure (myDlog, rData); DisposeDialog (myDlog); { Se OK, restituisci un risultato adeguato } IF item = rJoin THEN PISelectStartingSpells ELSE { Segnala che la creazione abortita mettendo "nome" a stringa nulla } nome := ''; { Grazie e arrivederci } HUnlock (Handle (self));end;{$R-}{$S Characters}FUNCTION TPersonaggio.Kill: boolean;VAR hisWindow: WindowPtr;begin DoSoundAsync (sndPlayerDead); status[IsDead] := TRUE; { Va aggiornata la sua finestra, se ne ha una aperta, e non basta chiamare CharacterHasChanged perchŽ quello aggiorna solo se sta visualizzando la prima pagina } hisWindow := Personaggio2Window (self); IF hisWindow <> NIL THEN BEGIN SetPort (hisWindow); InvalRect (hisWindow^.portRect); END; { Va anche aggiornata la finestra principale, per mostrare una icona diversa } SetPort (mainWindow); TMInvalRect (groupRect); { OK, finito } Kill := FALSEend;{ Per riuscire a richiamare il MainEventLoop, che si trova in Game.p e deve restare l“perchŽ parte integrante dei dettagli implementativi Macintosh }Function MainEventLoop (whereAmI: point): char; EXTERNAL;{$S Characters}FUNCTION TPersonaggio.Time (amountInMin: integer): boolean;VAR result: Boolean; HPbefore: Integer;BEGIN HPBefore := HP; result := INHERITED Time (amountInMin); IF HP <> HPBefore THEN CharacterHasChanged (SELF); Time := resultEND;{$S Characters}PROCEDURE TPersonaggio.Draw (where: rect; how: INTEGER);CONST rInvisibleGuy = 999; { icon for invisible char }VAR realIcon: Integer;BEGIN { Ricorda quale sia la mia vera icona } realIcon := icon; IF BAnd (how, $8000) <> 0 THEN { Se vuole icona speciale } { Se sono invisible, mostra la mia silhouette } IF status[IsInvisible] THEN icon := rInvisibleGuy ELSE { Altrimenti usa la figura completa } icon := v11.fullIcon; { Disegna } how := BAnd (how, $7FFF); INHERITED Draw (where, how); { New for v1.6: semaforo } IF realIcon = icon THEN BEGIN IF status[IsDead] THEN ForeColor (blackColor) { Sono morto } ELSE IF status[IsIll] OR (isPoisoned > 0) THEN ForeColor (magentaColor) ELSE IF HP < maxHP THEN { Sono feritoÉ } IF HP < 7 THEN { Égravemente } ForeColor (redColor) ELSE { Éleggermente } ForeColor (yellowColor) ELSE ForeColor (greenColor); { Tutto OK } PenSize (2, 3); WITH where DO BEGIN MoveTo (left+1, top+10); LineTo (left+2, top+10) { Traccia un pixel } END; ForeColor (blackColor); { Torna alla normalitˆ } PenSize (1, 1) END; { Rimetti le cose come stavano } icon := realIconEND;{$S Characters}Function TPersonaggio.Move: char;VAR result: Char;begin IF status[IsDead] THEN result := '*' { Se morto, non muove } ELSE BEGIN FlushEvents (autoKey, 0); { v2.1: Avoid auto-repeat } result := MainEventLoop (whereAmI); END; Move := result;end;{$S Characters}PROCEDURE TPersonaggio.Save (dest: MyFile);VAR size: longint; s: Storage;BEGIN { Se la finestra aperta, salvane la posizione } IF v11.hasOpenWindow THEN v11.windowPos := GiveBackWindowPositionOnScreen (charWindow); HLock (Handle (self)); {$PUSH} {$H-} INHERITED Save (dest); size := SizeOf (DatiPersonaggioDaSalvare) + SizeOf (AdditionalCharFields); PtrWrite (dest, size, @classe); CursorAnimate; {$POP} { Now for the equipment } FOR s := Testa to Sacco6 DO IF equipaggiamento[s] = NIL THEN WriteInt (dest, 0) ELSE BEGIN Writeint (dest, 1); { Segnala che qui c' qualcosa } equipaggiamento[s].Save (dest) END; HUnlock (Handle (self));end;{$S Characters}FUNCTION TPersonaggio.Clone: TObject;VAR theClone: TPersonaggio; unNome: Str255; loop: Storage;BEGIN theClone := TPersonaggio(INHERITED Clone); FailNIL (theClone); { Dev'essere nudo, oppure dovremmo duplicare gli oggettiÉ } GetIndString (unNome, rMiscStrings, rStrClone); theClone.nome := Concat (unNome, nome); FOR loop := Testa TO Sacco6 DO theClone.equipaggiamento[loop] := NIL; theClone.listData.theList := NIL; IF theClone.destrezza > 14 THEN theClone.AC := 24 - theClone.destrezza ELSE theClone.AC := 10; theClone.formazione.v := succ(formazione.v); theClone.GP := 0; theClone.v11.hasOpenWindow := FALSE; theClone.charWindow := NIL; CharacterHasNoWeapons (theClone); theClone.weightLoad := 0; theClone.activeSpells := NIL; Clone := theCloneEND;{$S Characters}PROCEDURE TPersonaggio.Free;VAR s: Storage; aWindow: WindowPtr;BEGIN { Uccidi gli incantesimi su di me } KillAllSpells (self); { Togli tutti gli oggetti che ho, e chiudi le finestre relative } FOR s := Testa TO Sacco6 DO IF equipaggiamento[s] <> NIL THEN BEGIN aWindow := equipaggiamento[s].itemWindow; IF aWindow <> NIL THEN MyDisposeWindow (aWindow); equipaggiamento[s].Free END; { 3. Via la mia finestra } aWindow := Personaggio2Window (self); IF aWindow <> NIL THEN MyDisposeWindow (aWindow); { OK, posso sparire } ShallowFreeEND;{$S Main}FUNCTION CreateCharWindow (character: EntityRef): WindowPtr;VAR w: WindowPtr; { Finestra del personaggio cliccato } title: Str255; { Nome del personaggio cliccato } ppat: PixPatHandle; { Sfondo per la finestra del personaggio cliccato } triangle, tabs, root: ControlHandle; sourceRect, destRect: Rect; { Per l'animazione } err: OSErr; tabsID: Integer;BEGIN title := Mondo[character].nome; w := GetNewCWindow(rCharWindow+ord(gHasThemes)*1000, NIL, WindowPtr(-1)); { New v2.2 } IF w = NIL THEN DeathAlert (errMissingApplRes, resNotFound); IF gHasThemes THEN err := CreateRootControl (w, root); { Creo un root. Cos“ potr˜ mettere CAST dentro il TAB } TMNewWindow (w, fInfoBar, kCharacterRefCon, kCWHeight, kCWWidth, kCWHeight, kCWWidth, 0, kCWWidth, 0, 0, 0, 0, kCWInfoBarHeight, DrawCharInfoBar, DrawCharWindow, DrawCharControls); TMSetWRefCon (w, kRefConForID, character); TMSetWRefCon (w, kRefConForHandle, Longint (Mondo[character])); TMSetWRefCon (w, kRefConForPage, 1); IF NOT gHasThemes THEN BEGIN { Sistema lo sfondo grigio chiaro che va tanto di moda } ppat := GetPixPat (rLightGrayPpat); IF ppat = NIL THEN DeathAlert (errMissingApplRes, resNotFound); SetPort (w); BackPixPat (ppat); END; { Prendi nota che, per ora almeno, non stata creata una lista di incantesimi che questo personaggio ha in memoria } Mondo[character].listData.theList := NIL; { Cambia la icona di questo personaggio: che mostri che c' la finestra aperta } SetPort (mainWindow); TMInvalRect (groupRect); { Sposta la finestra all'ultima posizione salvata } Mondo[character].v11.hasOpenWindow := TRUE; Mondo[character].charWindow := w; MyMoveWindow (w, Mondo[character].v11.windowPos, FALSE); { New for v2.0 - se era larga quando salvata, rimettila larga } IF Mondo[character].windowIsWide THEN TMSizeWindow (w, kCWWidth, kCWHeight, TRUE) ELSE TMSizeWindow (w, kCWWidth, 0, TRUE); { Se siamo sotto Mac OS 8, usa un vero control per il disclosure triangle - new for v2.2 } IF gHasThemes THEN BEGIN triangle := GetNewControl (rTriangle, w); IF triangle = NIL THEN DeathAlert (errMissingApplRes, 0); IF Mondo[character].windowIsWide THEN SetControlValue (triangle, 1); { é aperta! } { Tab } IF (Mondo[character].classe = Mostro) THEN tabsID := rTabs+2 { Niente "help" tab } ELSE IF NOT (IsSpellcaster (Mondo[character].classe, Mondo[character].livello) OR (Mondo[character].classe = paladino)) THEN tabsID := rTabs+1 { Niente "spell" tab } ELSE tabsID := rTabs; tabs := GetNewControl (tabsID, w); IF tabs = NIL THEN DeathAlert (errMissingApplRes, 0); { Autoembed, altrimenti i controlli ivi contenuti, come CAST, spariscono } END; { OK, mostra la finestra e va } SetWTitle(w, title); ShowWindow (w); CreateCharWindow := w; { Animazione } WITH sourceRect DO BEGIN SetPort (mainWindow); SetPt (topLeft, 0, kMWTop + character*kIconHeight); LocalToGlobal (topLeft); bottom := top + kIconHeight; right := left + kIconWidth END; WITH destRect DO BEGIN topLeft := Mondo[character].v11.windowPos; IF Mondo[character].windowIsWide THEN bottom := top + kCWHeight ELSE bottom := top + kCWInfoBarHeight; right := left + kCWWidth; END; IF GetGestaltResult (gestaltDragMgrAttr) <> 0 THEN err := ZoomRects (sourceRect, destRect, 15, zoomAccelerate);END;{$S LowLevel}FUNCTION CreateItemWindow (oggetto: TItem): WindowPtr;VAR w: WindowPtr; pulsante: ControlHandle; i: Integer; ppat: PixPatHandle; { Sfondo grigio chiaro per le finestre } itemName: String; sourceRect, destRect: Rect; realPosition: Storage; p: TPersonaggio; cw: WindowPtr; err: OSErr;BEGIN w := GetNewCWindow(rItemWindow+ord(gHasThemes)*1000, NIL, WindowPtr(-1)); IF w = NIL THEN DeathAlert (errMissingApplRes, resNotFound); itemName := oggetto.nome; SetWTitle(w, itemName); SetPort (w); IF NOT gHasThemes THEN BEGIN { Sistema lo sfondo grigio chiaro che va tanto di moda } ppat := GetPixPat (rLightGrayPpat); IF ppat = NIL THEN DeathAlert (errMissingApplRes, resNotFound); BackPixPat (ppat); END; { Inserisci i pulsanti. Metti il pulsante Identify solo se l'oggetto sconosciuto. Metti pulsanti solo se l'oggetto di proprietˆ di un qualche PC } IF oggetto.owner <> NIL THEN BEGIN FOR i := rButtonUse TO rButtonIdentify - ord (oggetto.data[8]) DO BEGIN pulsante := GetNewControl (i, w); if pulsante = nil then DeathAlert (errMissingApplRes, resNotFound); END; { for } IF oggetto.data[8] { Known } AND oggetto.data[12] { splittable } THEN BEGIN pulsante := GetNewControl (rButtonSplit, w); if pulsante = nil then DeathAlert (errMissingApplRes, resNotFound); END; { se splittable } END; TMNewWindow (w, 0, kItemRefCon, kIWHeight, kIWWidth, { indica "item window" } kIWHeight, kIWWidth, kIWHeight, kIWWidth, 0, 0, 0, 0, 0, { Info bar height } NIL, DrawItemWindow, NIL); TMSetWRefCon (w, kRefConForHandle, Longint (oggetto)); { Prendi nota che la finestra esiste ed aperta } oggetto.data[9] := TRUE; oggetto.itemWindow := w; MyMoveWindow (w, oggetto.windowPos, FALSE); ShowWindow (w); { restituisci il risultato } CreateItemWindow := w; { ANIMAZIONE - new for v2 } { zoom dest is easy } WITH destRect DO BEGIN topLeft := oggetto.windowPos; bottom := top + kIWHeight; right := left + kIWWidth; END; { zoom source: three cases. 1. Owned by a shop } IF oggetto.owner = NIL THEN WITH sourceRect DO BEGIN SetPort (mainWindow); SetPt (topLeft, kMWLeft, kMWTop); LocalToGlobal (topLeft); bottom := top + kMWHeight; right := left + kMWWidth END ELSE BEGIN p := TPersonaggio (oggetto.owner); cw := Personaggio2Window (p); { 2. Owned by a char whose window is closed or is not showing items } IF (cw = NIL) | (TMGetWRefCon (cw, kRefConForPage) <> 2) THEN WITH sourceRect DO BEGIN SetPort (mainWindow); SetPt (topLeft, 0, kMWTop + Personaggio2SerialID(p)*kIconHeight); LocalToGlobal (topLeft); bottom := top + kIconHeight; right := left + kIconWidth END { 3. Owned by a char whose window is open on page 2 } ELSE WITH sourceRect DO BEGIN { Trova dove ce l'ha } realPosition := Testa; WHILE StripAddress(p.equipaggiamento[realPosition]) <> StripAddress (oggetto) DO realPosition := succ (realPosition); { Trova le coordinate del rect } sourceRect := GetIndNrect (rFirstSilhouette+ord(p.classe), ord(realPosition)); SetPort (cw); LocalToGlobal (topLeft); LocalToGlobal (botRight) END; { item owner has window open on page 2 } END; { item has an owner } IF GetGestaltResult (gestaltDragMgrAttr) <> 0 THEN err := ZoomRects (sourceRect, destRect, 15, zoomAccelerate);END;{$S Characters}PROCEDURE TPersonaggio.Load (source: MyFile; version: Integer);VAR size: longint; s: Storage; thereIsAnItem: Integer; anItem: TItem;BEGIN HLock (Handle (self)); {$PUSH} {$H-} INHERITED Load (source, version); size := SizeOf (DatiPersonaggioDaSalvare); PtrRead (source, size, @classe); status[IsPC] := TRUE; { New for v2.1 } { dalla versione 1.3 in poi le posizioni di alcuni campi sono shiftate. Aggiusta se del caso } IF version < 131 THEN BEGIN BlockMoveData (@spellsInMemory[22], @knownSpells, SizeOf (KnownSpellsArray)+2); spellsInMemory[22] := 0 END; IF version >= 110 THEN BEGIN size := SizeOf (AdditionalCharFields); PtrRead (source, size, @v11); END ELSE WITH v11 DO BEGIN hasOpenWindow := FALSE; windowPos.h := 0; windowPos.v := 0; fullIcon := icon + 12; { Ne becco una appropriata qualsiasi } END; CursorAnimate; {$POP} { Tolgo qui il loose checking, ma faccio unlock dopo aver caricato gli item, per maggior sicurezza } { E ora gli oggetti. Mentri li carica, ricalcola i peso complessiva- mente trasportato dal personaggio, sia per rimediare a possibili bug del codice che ne tiene traccia a ciascuna transazione sia per limitare manipolazioni del file } size := GP; FOR s := Testa to Sacco6 DO BEGIN ReadInt (source, thereIsAnItem); IF thereIsAnItem = 1 THEN BEGIN { Istanzialo e leggilo } anItem := NIL; New (anItem); FailNIL (anItem); anItem.owner := self; { L'owner va conosciuto per creare la finestra } anItem.Load (source, version); equipaggiamento[s] := anItem; size := size + anItem.weight; END { If there is an item to load } ELSE equipaggiamento[s] := NIL; END; { Ciclo FOR sugli oggetti } weightLoad := size; { Assegna il peso correttamente trasportato } listData.theList := NIL; { Ricorda che non c' ancora lista inc. } HUnlock (Handle (self));END;end.