-+-+-+-+-+-+-+-+ START OF PART 7 -+-+-+-+-+-+-+-+ X Mana := MaxMana; X End; X DefaultPerson := Person; XEnd; X XFunction CreatePerson(Name : Short_String_Type; X Var EntityLog : $UWord; X Owner, Driver : $UWord; X Where, MapId : $UWord): Boolean; XVar Entity : EntityType; X PersonBlock : BlockType; X PersonInven : ItemMapType; X PersonId, InvenId : $UWord; X Created : Boolean := False; XBegin X If Alloc_Items(ALLOC_BLOCK, PersonId) Then Begin X If Alloc_Items(ALLOC_ITEMMAP, InvenId) Then Begin X If Alloc_Items(ALLOC_ENTITY, EntityLog) Then Begin X Entity.Name := Name; X Entity.EntityKind := ENTITY_PERSON; X Entity.Owner := Owner; X Entity.Driver := Driver; X Entity.PersonId := PersonId; X Entity.InvenId := InvenId; X Entity.MemoryId := 0; X Update_Record(FILE_ENTITY, EntityLog, IAddress(Entity)); X PersonBlock.Person := DefaultPerson; X Update_Record(FILE_BLOCK, PersonId, IAddress(PersonBlock)); X PersonInven := Zero; X Update_Record(FILE_ITEMMAP, InvenId, IAddress(PersonInven)); X Created := True; X PutToken(EntityLog, Where, MapId, POS_IN_ROOM, TRUE); X End Else Begin X Dealloc_Items(ALLOC_ITEMMAP, InvenId); X Dealloc_Items(ALLOC_BLOCK, PersonId); X End; X End Else Dealloc_Items(ALLOC_BLOCK, PersonId); X End; X CreatePerson := Created; XEnd; X X X(* create object functions *) X XFunction CreateObject(Name : Short_String_Type; X Var EntityLog : $UWord; X Where, MapId : $UWord): Boolean; XVar Entity : EntityType; X Created : Boolean := False; XBegin X If Alloc_Items(ALLOC_ENTITY, EntityLog) Then Begin X Entity.Name := Name; X Entity.EntityKind := ENTITY_OBJECT; X Entity.ObjKind := 0; X Entity.GetEffect := Zero; X Entity.WornEffect := Zero; X Entity.UseEffect := Zero; X Entity.AttEffect := Zero; X Update_Record(FILE_ENTITY, EntityLog, IAddress(Entity)); X Created := True; X PutToken(EntityLog, Where, MapId, POS_OBJ_HERE, TRUE); X End; X CreateObject := Created; XEnd; X X X(* create spell functions *) X XFunction CreateSpell(Name : Short_String_Type; X Var EntityLog : $UWord): Boolean; XVar Entity : EntityType; X Created : Boolean := False; XBegin X If Alloc_Items(ALLOC_ENTITY, EntityLog) Then Begin X Entity.Name := Name; X Entity.EntityKind := ENTITY_SPELL; X Entity.SpellEffect := Zero; X Update_Record(FILE_ENTITY, EntityLog, IAddress(Entity)); X Created := True; X UpdateLocation(EntityLog, 0, 0); X End; X CreateSpell := Created; XEnd; X X(* create class functions *) X XFunction CreateClass(Name : Short_String_Type; X Var EntityLog : $UWord): Boolean; XVar Entity : EntityType; X Created : Boolean := False; XBegin X If Alloc_Items(ALLOC_ENTITY, EntityLog) Then Begin X Entity.Name := Name; X Entity.EntityKind := ENTITY_CLASS; X Entity.Homeroom := The_Great_Beginning; X Entity.Group := 1; X Entity.ClassEffect := Zero; X Update_Record(FILE_ENTITY, EntityLog, IAddress(Entity)); X Created := True; X UpdateLocation(EntityLog, 0, 0); X End; X CreateClass := Created; XEnd; X XEnd. $ CALL UNPACK M5.PAS;1 709209088 $ create 'f' X`5BInherit('M1', 'M2', 'M3', 'M4', 'M5'), X Environment('M6')`5D X XModule M6; X X X(* effect functions *) X XConst X EFF_HURT = 1; EFF_HEAL = 2; EFF_G_GOLD = 3; EFF_T_GOLD = 4; X EFF_MIN_LEV = 5; EFF_CLS_ONLY = 6; EFF_CHNG_CLS = 7; EFF_G_ATTRI = 8; X EFF_G_MAXHEALTH = 9; EFF_G_MAXMANA = 10; EFF_G_MAXSPEED = 11; EFF_G_AC = 1 V2; X EFF_FREEZE = 13; EFF_TELEPORT = 14; X MaxEffect = 14; X X`5BHidden`5D XConst X BufferSize = 100; X X`5BHidden`5D XType X BufferType = Record X Top : Integer; X Effects : Array`5B1..BufferSize`5D Of Effect_Type; X End; X X`5BHidden`5D XVar X EffectFile : File Of Effect_Type; X Buffer : BufferType; X XVar X EffectTable : `5BReadonly`5D Array`5B1..MaxEffect`5D Of Short_String_Type V := ( X 'hurt', 'heal', 'give gold', 'take gold', X 'minimum level', 'class only', 'change class', 'gain attributes', X 'gain max health', 'gain max mana', 'gain max speed', 'gain armor class' V, X 'freeze', 'teleport'); X X EffPs1Table : `5BReadonly`5D Array`5B1..MaxEffect`5D Of Short_String_Type V := ( X 'damage', 'health', 'amount', 'amount', X 'minimum level', 'class', 'class', 'attribute', X 'amount', 'amount', 'amount', 'amount', X 'time', 'location'); X X EffPs2Table : `5BReadonly`5D Array`5B1..MaxEffect`5D Of Short_String_Type V := ( X '', '', '', '', X '', '', '', 'amount', X '', '', '', '', X '', ''); X X(* external event functions *) X X`5BExternal, Hidden`5D XProcedure LogEvent(S, T, A, L : $UWord; M : String_Type := ''; X DI : Boolean := False; P1, P2, P3, P4, P5, Id : Integer := 0); XExternal; X XProcedure SetUpEffect; XVar IsOpen : `5BStatic`5D Boolean := False; XBegin X If IsOpen Then Begin X IsOpen := False; Close(EffectFile); X End Else Begin X IsOpen := True; X Open_File(FILE_EFFECT, EffectFile, Root+'Effect.Mon', Size(Effect_Type)) V; X End; XEnd; X XProcedure InitEffectFile(Max : $UWord); XVar Effect : Effect_Type; I : Integer; XBegin X Effect := Zero; X For I := 1 To Max Do Put_Record(FILE_EFFECT, I, IAddress(Effect)); X InitAlloc(Alloc_EFFECT, Max); XEnd; X XProcedure IncEffectQuota(Amount : $UWord); XVar Effect : Effect_Type; X I, Start, Finish : $UWord := 0; XBegin X Effect := Zero; X If Inc_Alloc_Quota(ALLOC_EFFECT, Amount, Start, Finish) Then X For I := Start To Finish Do X Put_Record(FILE_EFFECT, I, IAddress(Effect)) X Else LogErr('Error increase effect quota. '); XEnd; X X`5BHidden`5D XProcedure LoadBuffer(Ptr : EffPtr_Type); XVar Effect : Effect_Type; I : Integer; XBegin X Buffer := Zero; X If Ptr.FromEff > 0 Then Begin X For I := Ptr.FromEff to Ptr.ToEff Do Begin X Read_Record(FILE_EFFECT, I, IAddress(Effect)); X Buffer.Effects`5BI - Ptr.FromEff + 1`5D := Effect; X End; X Buffer.Top := Ptr.ToEff - Ptr.FromEff + 1; X End; XEnd; X X`5BHidden`5D XProcedure SaveBuffer(Var Ptr : EffPtr_Type); XVar I : $UWord := 0; Done : Boolean := False; XBegin X If Buffer.Top > 0 Then Begin X If Alloc_Items(ALLOC_EFFECT, Ptr.FromEff, Buffer.Top) Then Begin X Ptr.ToEff := Ptr.FromEff + Buffer.Top - 1; X For I := 1 To Buffer.Top Do X Update_Record(FILE_EFFECT, Ptr.FromEff+I-1, IAddress(Buffer.Effects` V5BI`5D)); X End Else LogErr('Error allocating effectss. '); X End; XEnd; X XProcedure DeleteEffect(Var Ptr : EffPtr_Type); XVar Effect : Effect_Type; I : Integer; XBegin X Effect := Zero; X If Ptr.FromEff > 0 Then Begin X For I := Ptr.FromEff To Ptr.ToEff Do X Update_Record(FILE_EFFECT, I, IAddress(Effect)); X Dealloc_Items(ALLOC_EFFECT, Ptr.FromEff, Ptr.ToEff - Ptr.FromEff + 1); X Ptr.FromEff := 0; Ptr.ToEff := 0; X End; XEnd; X XFunction GrabEffect(Var Effect : Effect_Type; Var S : String_Type): Boolean; XVar Index : $UWord := 0; XBegin X If GrabTable('Effect kind? ', EffectTable, S, Effect.Effect) Then Begin X If (Effect.Effect = EFF_CLS_ONLY) Or (Effect.Effect = EFF_CHNG_CLS) X Then Begin (* special case 1 *) X If GrabEntity('Which class? ', S, Index, ENTITY_CLASS) Then Begin X GrabEffect := True; X Effect.Parm1 := Index; X End Else GrabEffect := False; X End Else If (Effect.Effect = EFF_G_ATTRI) Then Begin (* special case 2 V *) X If GrabTable('Attributes? ', PersonAttriTable, S, Index) Then Begin X GrabEffect := True; X Effect.Parm1 := Index; X Effect.Parm2 := GrabNumberW('Amount? ', S); X End Else GrabEffect := False; X End Else If (Effect.Effect = EFF_TELEPORT) Then Begin (* special case 3 V *) X If GrabEntity('Teleport to? ', S, Index, ENTITY_ROOM) Then Begin X GrabEffect := True; X Effect.Parm1 := Index; X End; X End Else Begin X GrabEffect := True; X If (EffPs1Table`5BEffect.Effect`5D.Length > 0) Then X Effect.Parm1 := GrabNumberW(EffPs1Table`5BEffect.Effect`5D+'? ', S); X If (EffPs2Table`5BEffect.Effect`5D.Length > 0) Then X Effect.Parm2 := GrabNumberW(Effps2Table`5BEffect.Effect`5D+'? ', S); X End; X End Else GrabEffect := False; XEnd; X XProcedure PrintEffect(L : Short_String_Type; X Var Effect : Effect_Type); XVar L1, L2 : String_Type := ''; X Entity : EntityType; XBegin X PutLine(L+EffectTable`5BEffect.Effect`5D+': '); X If (Effect.Effect = EFF_CLS_ONLY) Or (Effect.Effect = EFF_CHNG_CLS) X Then Begin (* special case 1 *) X ReadEntity(Effect.Parm1, Entity); X L1 := 'Class '+Entity.Name; X End Else If (Effect.Effect = EFF_G_ATTRI) Then Begin (* special case 2 *) X L1 := 'Attributes '+PadStr(PersonAttriTable`5BEffect.Parm1`5D, V 20); X WriteV(L2, 'Amount ', Effect.Parm2:0); X End Else If (Effect.Effect = EFF_TELEPORT) Then Begin (* special case 3 * V) X ReadEntity(Effect.Parm1, Entity); X L1 := 'Destination '+Entity.Name; X End Else Begin X If (Effps1Table`5BEffect.Effect`5D.Length > 0) Then Begin X WriteV(L1, Effect.Parm1:0); X L1 := PadStr(EffPs1Table`5BEffect.Effect`5D, 20)+PadStr(L1, 20); X End; X If (Effps2Table`5BEffect.Effect`5D.Length > 0) Then Begin X WriteV(L1, Effect.Parm1:0); X L2 := PadStr(EffPs2Table`5BEffect.Effect`5D, 20)+PadStr(L2, 20); X End; X End; X PutLine(L1+L2); XEnd; X `20 XProcedure EditEffect(Var Ptr : EffPtr_Type; Var S : String_Type); XConst X C_Quit = 1; C_Exit = 2; C_Add = 3; C_Delete = 4; C_Print = 5; X MaxCmd = 5; XVar X CmdTable : Array`5B1..MaxCmd`5D Of Short_String_Type := X ('Quit', 'Exit', 'Add', 'Delete', 'Print'); X Done : Boolean := False; X Cmd, I : $UWord := 0; X X Procedure DoExit; X Begin X DeleteEffect(Ptr); SaveBuffer(Ptr); Done := True; X End; X X Procedure DoAdd; X Var AnEffect : Effect_Type; X Begin X If GrabEffect(AnEffect, S) Then Begin X Buffer.Top := Buffer.Top + 1; X Buffer.Effects`5BBuffer.Top`5D := AnEffect; X End Else PutLine('Not added. '); X End; X X Procedure DoDelete; X Var Index, I : $UWord; X Begin X Index := GrabNumberW('Which one(enter a number)? ', S); X If (Index > 0) And (Index <= Buffer.Top) Then Begin X Buffer.Top := Buffer.Top - 1; X For I := Index to Buffer.Top Do X Buffer.Effects`5BI`5D := Buffer.Effects`5BI+1`5D; X End Else PutLine('Invalid range. '); X End; X X Procedure DoPrint; X Var I : Integer; X L : Short_String_Type; X Begin X If (Buffer.Top = 0) Then X PutLine('The buffer is empty. ') X Else Begin X PutLine(DivLine+DivLine); X For I := 1 To Buffer.Top Do Begin X WriteV(L, I:0, ': '); X PrintEffect(PadStr(L, 5), Buffer.Effects`5BI`5D); X PutLine(DivLine+DivLine); X End; X End; X End; X XBegin X LoadBuffer(Ptr); X While Not Done Do Begin X If GrabTable('Edit Effect> ', CmdTable, S, Cmd) Then X Case Cmd Of X C_Quit : Done := True; X C_Exit : DoExit; X C_Add : DoAdd; X C_Delete : DoDelete; X C_Print : DoPrint; X End X Else PutLine('Type ? for a list of effect editing commands. '); X End; XEnd; X X X(* fun stuff *) X XFunction HaveEffect(Ptr : EffPtr_Type; X Entity : EntityType; X Var PersonBlk : BlockType; X Print, Reverse : Boolean): Boolean; XVar Failed : Boolean := False; I : Integer := 0; XBegin X Read_Record(FILE_BLOCK, Entity.PersonId, IAddress(PersonBlk)); X LoadBuffer(Ptr); X While Not Failed And (I < Buffer.Top) Do Begin X I := I + 1; X With Buffer.Effects`5BI`5D Do Begin X If Not Reverse Then Case Effect Of X EFF_T_GOLD : X If (PersonBlk.Person.Gold < Parm1) Then Begin X Failed := True; X If Print Then PutLine('You don''t have enough gold! '); X End; X EFF_MIN_LEV : X If (PersonBlk.Person.Level < Parm1) Then Begin X Failed := True; X If Print Then PutLine('Your level is low! '); X End; X EFF_CLS_ONLY : X If (PersonBlk.Person.Class <> Parm1) Then Begin X Failed := True; X If Print Then PutLine('You are not the right class! '); X End; X End Else Case Effect Of (* reverse *) X EFF_G_GOLD : X If (PersonBlk.Person.Gold < Parm1) Then Begin X Failed := True; X If Print Then PutLine('You don''t have enough gold! '); X End; X EFF_G_ATTRI : X If (PersonBlk.Person.Attributes`5BParm1`5D <= Parm2) Then Begin X Failed := True; X If Print Then PutLine('Your '+PersonAttriTable`5BParm1`5D+' is t Voo low. '); X End; X EFF_G_MAXHEALTH : X If (PersonBlk.Person.Maxhealth <= Parm1) Then Begin X Failed := True; X If Print Then PutLine('Your max health is too low. '); X End; X EFF_G_MAXMANA : X If (PersonBlk.Person.Maxmana <= Parm1) Then Begin X Failed := True; X If Print Then PutLine('Your max mana is too low. '); X End; X EFF_G_MAXSPEED : X If (PersonBlk.Person.Maxspeed <= Parm1) Then Begin X Failed := True; X If Print Then PutLine('Your max speed is too low. '); X End; X EFF_G_AC : X If (PersonBlk.Person.ArmorClass <= Parm1) Then Begin X Failed := True; X If Print Then PutLine('Your armor class is too low. '); X End; X End; (* case *) X End; (* with *) X End; (* while *) X HaveEffect := Failed; XEnd; X XProcedure DoDie(Var Entity : EntityType; X Var PersonBlk : BlockType; X Var ExpGained : Integer); XBegin X Get_Record(FILE_BLOCK, Entity.PersonId, IAddress(PersonBlk)); X With PersonBlk.Person Do Begin X ExpGained := Exp+1; X Level := 0; X Exp := 0; X Health := 0; X End; X Update_Record(FILE_BLOCK, Entity.PersonId, IAddress(PersonBlk)); XEnd; X XProcedure AffectPerson(Ptr : EffPtr_Type; X EntityId, Location : $UWord; X Var Entity : EntityType; X Var PersonBlk : BlockType; X Var Damage, ExpGained : Integer; X Var WasDead : Boolean; X Print, Reverse : Boolean); XVar I, Tmp : Integer := 0; X Heal, GoldGain, MHGain, MMGain, MSGain, ACGain, MHLoss, MMLoss, +-+-+-+-+-+-+-+- END OF PART 7 +-+-+-+-+-+-+-+-