diff -x .svn -uprN GearHead1100repository.original/I18N_COMPILING.txt branches/I18N_COMPILING.txt --- GearHead1100repository.original/I18N_COMPILING.txt 1970-01-01 09:00:00.000000000 +0900 +++ branches/I18N_COMPILING.txt 2009-08-14 04:01:58.340713000 +0900 @@ -0,0 +1,30 @@ +# +# i18n_compiling.txt +# + +1. How to build the GearHead. + +1.1. Required softwares to compile it. + + fpc - Free Pascal Compiler + fpc-pthreads (Unix-like OS only) + fpc-x11 (SDL-mode on Unix-like OS only) + JEDI-SDL (SDL-mode only) + + +1.2. Required libraries to compile and run it. + + libiconv + SDL (SDL-mode only) + SDL_image (SDL-mode only) + SDL_ttf (SDL-mode only) + png (SDL-mode only) + xorg or xf86 (SDL-mode on Unix-like OS only) + + +1.3. How to compile. + + Use build.sh +That's all. + +[ End of File ] diff -x .svn -uprN GearHead1100repository.original/Series/temp_relay.txt branches/Series/temp_relay.txt --- GearHead1100repository.original/Series/temp_relay.txt 2012-01-09 14:01:36.526131000 +0900 +++ branches/Series/temp_relay.txt 2009-08-10 02:11:25.401387000 +0900 @@ -149,7 +149,7 @@ sub Msg9 <> Msg10 <> - % 11 - 15 : PC has accepted job, now recieves instructions. + % 11 - 15 : PC has accepted job, now receives instructions. % use "\Element 3" for NPC E3's name, and "\SCENE EScene 3" for % NPC E3's location. You should provide both. % Also, you may want to mention that there's a 24-hour time limit, diff -x .svn -uprN GearHead1100repository.original/ability.pp branches/ability.pp --- GearHead1100repository.original/ability.pp 2013-02-07 13:00:00.000000000 +0900 +++ branches/ability.pp 2013-08-20 09:00:00.000000000 +0900 @@ -25,7 +25,14 @@ unit ability; interface -uses gears,ghsensor; +uses +{$IFDEF PATCH_GH} + gears_base, + gears, +{$ELSE PATCH_GH} + gears, +{$ENDIF PATCH_GH} + ghsensor; const XPA_AttackHit = 2; @@ -60,7 +67,11 @@ const PCC_Comm = GV_Comm; { Can receive communications from NPCs } PCC_News = GV_News; { Can view internet global news } +{$IFDEF PATCH_GH} + { Moved into ui4gh.pp } +{$ELSE PATCH_GH} Direct_Skill_Learning: Boolean = False; +{$ENDIF PATCH_GH} var ABILITY_MESSAGES: SAttPtr; @@ -103,7 +114,17 @@ Function HasSkill( PC: GearPtr; Skill: I implementation -uses damage,gearutil,ghchars,ghholder,ghmecha,ghmodule,ghsupport,movement, +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + ui4gh, +{$ENDIF PATCH_CHEAT} + damage,gearutil,ghchars,ghholder,ghmecha,ghmodule,ghsupport,movement, rpgdice,texutil; Function LocatePilot( Mecha: GearPtr ): GearPtr; @@ -119,6 +140,11 @@ begin if Mecha = Nil then begin Pilot := Nil; +{$IFDEF PATCH_GH} + end else if (Mecha^.G <= GG_DisposeGear) then begin + Pilot := NIL; +{$ENDIF PATCH_GH} + end else if Mecha^.G = GG_Character then begin { Just return this character, since we can't find a mecha. } Pilot := Mecha; @@ -149,6 +175,10 @@ begin { Error Check } if ( Mek = Nil ) then begin MO := False +{$IFDEF PATCH_GH} + end else if (Mek^.G <= GG_DisposeGear) then begin + MO := False; +{$ENDIF PATCH_GH} end else if Mek^.G = GG_Mecha then begin MO := NotDestroyed( Mek ) and NotDestroyed( LocatePilot( Mek ) ); end else MO := NotDestroyed( Mek ); @@ -161,6 +191,9 @@ Function GearActive( Mek: GearPtr ): Boo { Generally only master gears may be active. } begin if Mek = Nil then GearActive := False +{$IFDEF PATCH_GH} + else if (Mek^.G <= GG_DisposeGear) then GearActive := False +{$ENDIF PATCH_GH} else if Mek^.G = GG_Prop then GearActive := False else if IsMasterGear( Mek ) then GearActive := GearOperational( Mek ) else GearActive := False; @@ -179,6 +212,9 @@ begin { Error check- make sure that we're actually dealing } { with a master gear and not a ham sandwich or anything. } if ( Master = Nil ) then Exit( 0 ); +{$IFDEF PATCH_GH} + if (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if ( Master^.G <> GG_Unit ) and Not IsMasterGear( Master ) then Exit( 0 ); { Error check- make sure we have a valid skill number. } @@ -234,6 +270,9 @@ begin { point in time, but for now just locate the cockpit. } C := LocatePilot( Master ); if C = Nil then Exit( 0 ); +{$IFDEF PATCH_GH} + if (C^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} SkRk := SkillValue( C , Skill) + ModifiersSkillBonus( Master , Skill ); StRk := 0; @@ -265,6 +304,9 @@ function ReactionTime( Master: GearPtr ) var I,RT: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} { Determine the Initiative skill value for this character. } I := SkillValue( Master , 12 ) + 1; if I < Minimum_Initiative then I := Minimum_Initiative; @@ -284,13 +326,29 @@ begin M := Part; if not IsMasterGear( Part ) then M := FindMaster( Part ); +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if M = Nil then begin +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + {$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then name := I18N_MsgString('PilotName','Nothing') + {$ELSE PATCH_GH} + if NIL = Part then name := I18N_MsgString('PilotName','Nothing') + {$ENDIF PATCH_GH} +{$ELSE PATCH_I18N} if Part = Nil then name := 'Nothing' +{$ENDIF PATCH_I18N} else name := GearName( Part ); end else if M^.G = GG_Mecha then begin Part := LocatePilot( M ); +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then name := GearName( M ) +{$ELSE PATCH_GH} if Part = Nil then name := GearName( M ) +{$ENDIF PATCH_GH} else name := GearName( Part ); end else begin @@ -306,8 +364,16 @@ Procedure DoleExperience( Mek: GearPtr; var P: GearPtr; { The pilot, in theory. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + P := LocatePilot( Mek ); +{$IFDEF PATCH_GH} + if (NIL <> P) and (GG_DisposeGear < P^.G) then begin +{$ELSE PATCH_GH} if P <> Nil then begin +{$ENDIF PATCH_GH} AddNAtt( P^.NA , NAG_Experience , NAS_TotalXP , XPV ); if XPV > Random(25) then AddMoraleDmg( P , -1 ); end; @@ -317,23 +383,55 @@ Procedure DoleExperience( Mek,Target: Ge { Give XPV experience points to whoever is behind the wheel of } { master unit Mek. Scale the experience points by the relative } { values of Mek and Target. } +{$IFDEF PATCH_GH} +const + XPV_MAX = 2147483647; + XPV_MIN = -2147483648; +{$ENDIF PATCH_GH} var MPV,TPV,MonPV: LongInt; { Mek PV, Target PV } +{$IFDEF PATCH_GH} + XPV_TPV: Int64; + XPV_TPV_TS: double; + XP2: double; +{$ELSE PATCH_GH} XP2: Int64; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + MPV := GearValue( Mek ); if MPV < 1 then MPV := 1; +{$IFDEF PATCH_GH} + if (NIL <> Target) and (GG_DisposeGear < Target^.G) then begin +{$ELSE PATCH_GH} if Target <> Nil then begin +{$ENDIF PATCH_GH} TPV := GearValue( Target ); - { Monsters might benefit from an upward-adjusted TPV based on } { their difficulcy rating. } if ( Target^.G = GG_Character ) and ( Target^.V > 0 ) then begin MonPV := Target^.V * Target^.V * 150 - Target^.V * 100; if MonPV > TPV then TPV := MonPV; end; - XP2 := ( XPV * TPV * ( Target^.Scale + 1 ) ) div MPV; +{$IFDEF PATCH_GH} + { To avoid a range overflow of the LongInt. } + XPV_TPV := Int64(XPV) * Int64(TPV); + XPV_TPV_TS := double(XPV_TPV) * double( Target^.Scale + 1 ); + XP2 := XPV_TPV_TS / double(MPV); + if XP2 < XPV_MIN then begin + XPV := XPV_MIN; + end else if XPV_MAX < XP2 then begin + XPV := XPV_MAX; + end else begin + XPV := LongInt(Trunc(XP2)); + end; +{$ELSE PATCH_GH} + XP2 := ( Int64(XPV) * Int64(TPV) * Int64( Target^.Scale + 1 ) ) div MPV; XPV := XP2; +{$ENDIF PATCH_GH} end; if XPV < 1 then XPV := 1; DoleExperience( Mek , XPV ); @@ -373,9 +471,17 @@ var SkLvl: Integer; it: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + P := LocatePilot( Mek ); it := False; { Assume FALSE unless shown otherwise. } +{$IFDEF PATCH_GH} + if (NIL <> P) and (GG_DisposeGear < P^.G) then begin +{$ELSE PATCH_GH} if P <> Nil then begin +{$ENDIF PATCH_GH} AddNAtt( P^.NA , NAG_Experience , NAS_Skill_XP_Base + Skill , XPV ); { Check to see if enough skill-specific XPs have been earned to advance the skill. } @@ -406,8 +512,15 @@ var Master: GearPtr; Material,Skill: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(32766); +{$ENDIF PATCH_GH} + { Start by finding the master and material for this part. } Master := FindMaster( Part ); +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(32766); +{$ENDIF PATCH_GH} Material := NAttValue( Part^.NA , NAG_GearOps , NAS_Material ); if Material = NAV_BioTech then begin @@ -459,6 +572,11 @@ var Cash,Cost: LongInt; Skill,SkRoll,MOS,AMOS: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(32766); + if (NIL = Fixer) or (Fixer^.G <= GG_DisposeGear) then Exit(32766); +{$ENDIF PATCH_GH} + AD := NAttValue( Part^.NA , NAG_Damage , NAS_ArmorDamage ); SD := NAttValue( Part^.NA , NAG_Damage , NAS_StrucDamage ); Cash := NAttValue( Fixer^.NA , NAG_Experience , NAS_Credits ); @@ -516,7 +634,11 @@ begin if AMOS > 0 then begin SetNAtt( Part^.NA , NAG_Damage , NAS_ArmorDamage , 0 ); +{$IFDEF PATCH_GH} + if AMOS > 1 then Cost := ( Cost * ( 6 - AMOS ) ) div 5; +{$ELSE PATCH_GH} if AMOS > 1 then Cost := ( Cost * ( 6 - MOS ) ) div 5; +{$ENDIF PATCH_GH} Cash := Cash - Cost; end; end; @@ -541,9 +663,19 @@ var InitGear( M ); end; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if PC^.SubCom = Nil then begin InsertLimb( GS_Head ); +{$IFDEF PATCH} + SetSAtt( M^.SA , 'NAME <' + SATtValue( ABILITY_MESSAGES , 'EXPAND_Head' ) + '>' ); +{$ENDIF} InsertLimb( GS_Body ); +{$IFDEF PATCH} + SetSAtt( M^.SA , 'NAME <' + SATtValue( ABILITY_MESSAGES , 'EXPAND_Body' ) + '>' ); +{$ENDIF} H := AddGear( M^.InvCom , M ); H^.G := GG_ExArmor; H^.S := GS_Body; @@ -582,14 +714,25 @@ var it,t: Integer; begin it := 0; +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} Sensor := SeekActiveIntrinsic( Mek , GG_Sensor , GS_MainSensor ); +{$IFDEF PATCH_GH} + if (NIL <> Sensor) and (GG_DisposeGear < Sensor^.G) then begin +{$ELSE PATCH_GH} if Sensor <> Nil then begin +{$ENDIF PATCH_GH} it := it + Sensor^.V; end; Pilot := LocatePilot( Mek ); +{$IFDEF PATCH_GH} + if (NIL <> Pilot) and (GG_DisposeGear < Pilot^.G) then begin +{$ELSE PATCH_GH} if Pilot <> Nil then begin +{$ENDIF PATCH_GH} it := it + ( Pilot^.Stat[ STAT_Perception ] div 3 ); end; @@ -610,7 +753,14 @@ Procedure AddMoraleDMG( PC: GearPtr; M: var CL: Integer; { Current Level } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if PC^.G <> GG_Character then PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if ( PC <> Nil ) and ( PC^.G = GG_Character ) then begin CL := NAttValue( PC^.NA , NAG_Condition , NAS_MoraleDamage ); @@ -637,7 +787,14 @@ Procedure AddReputation( PC: GearPtr; R, var CL: Integer; { Current Level } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if PC^.G <> GG_Character then PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if ( PC <> Nil ) and ( PC^.G = GG_Character ) then begin CL := NAttValue( PC^.NA , NAG_CHarDescription , -R ); @@ -685,9 +842,16 @@ end; Procedure AddStaminaDown( PC: GearPtr; Strain: Integer ); { Apply stamina drain to the PC. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Begin with a battery of error checks. } if ( PC <> Nil ) and ( Strain > 0 ) then begin if PC^.G <> GG_Character then PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if ( PC <> Nil ) then begin if ( CharCurrentStamina( PC ) > 0 ) then begin AddNAtt( PC^.NA , NAG_Condition , NAS_StaminaDown , Strain ); @@ -704,9 +868,16 @@ end; Procedure AddMentalDown( PC: GearPtr; Strain: Integer ); { Apply mental drain to the PC. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Begin with a battery of error checks. } if ( PC <> Nil ) and ( Strain > 0 ) then begin if PC^.G <> GG_Character then PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if ( PC <> Nil ) then begin if ( CharCurrentMental( PC ) > 0 ) then begin AddNAtt( PC^.NA , NAG_Condition , NAS_MentalDown , Strain ); @@ -723,7 +894,13 @@ end; Function CurrentMental( PC: GearPtr ): Integer; { Return how many mental points this character currently has. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if PC <> Nil then begin CurrentMental := CharCurrentMental( PC ); end else begin @@ -734,7 +911,13 @@ end; Function CurrentStamina( PC: GearPtr ): Integer; { Return how many stamina points this character currently has. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if PC <> Nil then begin CurrentStamina := CharCurrentStamina( PC ); end else begin @@ -749,7 +932,50 @@ var MM,MMS: Integer; CanMove: Boolean; Engine: GearPtr; +{$IFDEF PATCH_CHEAT} + Function Msg_MassMeter( PC : GearPtr): String; + { On top of the backpack seperator, display the current inventory mass, and the carrying capacity } + { Origin : Michael } + { http://gearheadrpg.com/forum/index.php?action=vthread&forum=1&topic=789 } + { ftp://ftp.ocis.net/pub/users/ldeutsch/ghpatches/gh-1100-massmeter1.diff } + var + MassString: String; + CurrentInv,CurrentEqp,Limit,Limit2: LongInt; + begin + CurrentInv := IntrinsicMass(PC); + CurrentEqp := EquipmentMass(PC); + Limit2 := GearEncumberance(PC); + + Limit := Limit2 * 2 - 1; {Maximum weight before penalty starts} + + if PC^.G = GG_Character then begin + Limit := Limit + NAttValue(PC^.NA,NAG_Skill,NAS_WeightLifting); + end; + + Limit2 := Limit2 + Limit; {Where penalty gets worse} + + MassString := ReplaceHash( I18N_MsgString('CreateEqpMenu','MassMeter'), + MakeMassString(CurrentInv,PC^.Scale), + MakeMassString(CurrentEqp,PC^.Scale) ); + + MassString := MassString + ReplaceHash( + I18N_MsgString('CreateEqpMenu','MassMeter_Limit'), + MakeMassString(Limit,PC^.Scale) ); + if Limit2 < CurrentEqp then begin + MassString := MassString + I18N_MsgString('CreateEqpMenu','MassMeter_LimitOver2'); + end else if Limit < CurrentEqp then begin + MassString := MassString + I18N_MsgString('CreateEqpMenu','MassMeter_LimitOver'); + end else begin + end; + + Msg_MassMeter := MassString; + end; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit('ERROR: Broken data.'); +{$ENDIF PATCH_GH} + if Mek^.G <> GG_Mecha then Exit( 'NOT A MECHA!' ); it := MassString( Mek ) + ' ' + FormName[Mek^.S]; @@ -778,18 +1004,30 @@ begin { Check to see whether the mecha can } { fly or just jump. } if JumpTime( Mek ) = 0 then begin +{$IFDEF PATCH_I18N} + it := it + ' ' + I18N_Name('MoveModeName',MoveModeName[ MM ]) + ':' + BStr( MMS ); +{$ELSE PATCH_I18N} it := it + ' ' + MoveModeName[ MM ] + ':' + BStr( MMS ); +{$ENDIF PATCH_I18N} end else begin it := it + ' ' + SAttValue( ABILITY_MESSAGES , 'MEKDESC_Jump' ) + ':' + BStr( JumpTime( Mek ) ) + 's'; end; end else begin +{$IFDEF PATCH_I18N} + it := it + ' ' + I18N_Name('MoveModeName',MoveModeName[ MM ]) + ':' + BStr( MMS ); +{$ELSE PATCH_I18N} it := it + ' ' + MoveModeName[ MM ] + ':' + BStr( MMS ); +{$ENDIF PATCH_I18N} end; end; end; Engine := SeekGear( Mek , GG_Support , GS_Engine ); +{$IFDEF PATCH_GH} + if (NIL <> Engine) and (GG_DisposeGear < Engine^.G) then begin +{$ELSE PATCH_GH} if Engine <> Nil then begin +{$ENDIF PATCH_GH} i2 := SAttValue( ABILITY_MESSAGES , 'MEKDESC_ENGINE' + Bstr( Engine^.Stat[ STAT_EngineSubtype ] ) ); if i2 <> '' then it := it + ' ' + i2; end; @@ -805,6 +1043,11 @@ begin it := it + ' ' + SAttValue( ABILITY_MESSAGES , 'MEKDESC_NoCockpit' ); end; +{$IFDEF PATCH_CHEAT} + If Cheat_MechaDescription_ShowMassMeter then begin + it := it + ' ' + Msg_MassMeter( Mek ); + end; +{$ENDIF PATCH_CHEAT} MechaDescription := it; end; @@ -812,14 +1055,25 @@ Function HasPCommCapability( PC: GearPtr { Return TRUE if the listed PC has the requested Personal } { Communications Capability. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} HasPCommCapability := PCommRating( PC ) >= C; end; Function HasTalent( PC: GearPtr; T: Integer ): Boolean; { Return TRUE if PC has the listed talent, FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); + HasTalent := ( NAttValue( PC^.NA , NAG_Talent , T ) <> 0 ); +{$ELSE PATCH_GH} HasTalent := ( PC <> Nil ) and ( NAttValue( PC^.NA , NAG_Talent , T ) <> 0 ); +{$ENDIF PATCH_GH} end; Function LancematePoints( PC: GearPtr ): Integer; @@ -827,8 +1081,15 @@ Function LancematePoints( PC: GearPtr ): { A human lancemate who can pilot a mecha costs 2 points; a pet costs 1 point. } { How to tell which from which? Human lancemates have CIDs; pets don't. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ELSE PATCH_GH} if PC = Nil then Exit( 0 ); +{$ENDIF PATCH_GH} LancematePoints := ( PC^.Stat[ STAT_Charm ] + NAttValue( PC^.NA , NAG_Skill , NAS_Leadership ) + ( NAttValue( PC^.NA , NAG_CharDescription , NAS_Renowned ) div 10 ) ) div 4; end; @@ -837,16 +1098,29 @@ Function SkillRank( PC: GearPtr; Skill: var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Make sure we're dealing with the real PC here. } PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} SkillRank := CharaSkillRank( PC , Skill ); end; Function HasSkill( PC: GearPtr; Skill: Integer ): Boolean; { Return TRUE if the PC has the listed skill, or FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} { Make sure we're dealing with the real PC here. } PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if PC <> Nil then begin HasSkill := ( NAttValue( PC^.NA , NAG_Skill , Skill ) > 0 ) or HasTalent( PC , NAS_JackOfAll ); @@ -855,10 +1129,22 @@ begin end; end; + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ability.pp'); +{$ENDIF DEBUG} ABILITY_MESSAGES := LoadStringList( Ability_Message_File ); +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ability.pp(finalization)'); +{$ENDIF DEBUG} DisposeSAtt( ABILITY_MESSAGES ); +end; end. diff -x .svn -uprN GearHead1100repository.original/action.pp branches/action.pp --- GearHead1100repository.original/action.pp 2013-02-07 09:00:01.000000000 +0900 +++ branches/action.pp 2015-08-30 09:02:00.000000000 +0900 @@ -28,7 +28,11 @@ unit action; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; const TRIGGER_NumberOfUnits = 'NU'; @@ -42,6 +46,9 @@ const var Destroyed_Parts_List: SAttPtr; +{$IFDEF PATCH_CHEAT} + Exploding_Parts_List: SAttPtr; +{$ENDIF PATCH_CHEAT} Function DamageGear( gb: GameBoardPtr; Part,Weapon: GearPtr; DMG,MOS,N: Integer; const AtAt: String ): LongInt; @@ -55,11 +62,25 @@ Function TeamPV( MList: GearPtr; Team: I Function TeamTV( MList: GearPtr; Team: Integer ): LongInt; Procedure WaitAMinute( GB: GameBoardPtr; Mek: GearPtr; D: Integer ); +{$IFDEF PATCH_GH} +Procedure WaitAMinute_Part( GB: GameBoardPtr; Mek: GearPtr; D: Integer ); +Function Check_WaitAMinute_Part( GB: GameBoardPtr; Mek: GearPtr ): Boolean; +{$ENDIF PATCH_GH} implementation -uses ability,damage,gearutil,ghchars,ghmodule,ghweapon,interact,movement,rpgdice,texutil; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + ui4gh, +{$ENDIF PATCH_CHEAT} + ability,damage,gearutil,ghchars,ghmodule,ghweapon,interact,movement,rpgdice,texutil; const EjectDamage = 10; { The damage step to roll during an ejection attempt. } @@ -83,6 +104,11 @@ var GoUp: GearPtr; { A counter that will be used to check all of PART's parents. } Team: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit(False); + if DMG < 0 then exit(False); +{$ENDIF PATCH_GH} + Ok_At_Start := GearOperational( Part ); AddNAtt(Part^.NA,NAG_Damage,NAS_StrucDamage,DMG); @@ -95,6 +121,9 @@ begin { checked for triggers. } GoUp := Part; while GoUp <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < GoUp^.G) then begin +{$ENDIF PATCH_GH} { If GoUp is destroyed, and it has a UID, generate } { a TD* trigger. } if ( NAttValue( GoUp^.NA , NAG_EpisodeData , NAS_UID ) <> 0 ) and ( Not GearOperational( GoUp ) ) then begin @@ -112,6 +141,9 @@ begin Team := NAttValue( GoUp^.NA , NAG_Location , NAS_Team ); SetTrigger( GB , TRIGGER_NumberOfUnits + BStr( Team ) ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} { Move up one more level. } GoUp := GoUp^.Parent; @@ -151,6 +183,9 @@ begin while ( Part <> Nil ) do begin P2 := Part^.Next; +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if NotDestroyed( Part ) then begin if Part^.G = GG_Character then begin { This character must either eject or die. } @@ -213,6 +248,9 @@ begin EjectionCheck( GB , Part^.SubCom ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := P2; end; @@ -225,6 +263,10 @@ var NumShots: Integer; M: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { Only installed ammo can explode. This may seem silly, and it } { probably is, but otherwise carrying replacement clips is } { asking for certain death. } @@ -235,6 +277,9 @@ begin NumShots := Part^.Stat[ STAT_AmmoPresent ] - NAttValue( Part^.NA , NAG_WeaponModifier , NAS_AmmoSpent ); if NumShots > 0 then begin DAMAGE_AmmoExplosion := True; +{$IFDEF PATCH_CHEAT} + StoreSAtt( Exploding_Parts_List , GearName( Part ) ); +{$ENDIF PATCH_CHEAT} M := FindModule( Part ); if ( M = Nil ) or ( M^.S <> GS_Storage ) then begin DAMAGE_OverKill := DAMAGE_OverKill + RollDamage( Part^.V + NumShots , Part^.Scale ); @@ -250,6 +295,10 @@ var OK_at_Start: Boolean; { Was the part OK before damage was applied? } M: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + {ERROR CHECK - If we are attempting to damage a storage} {module or other -1HP type, don't do anything.} @@ -269,7 +318,10 @@ begin end; TakeDamage( GB , Part , DMG ); +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} DAMAGE_LastPartHit := Part; +{$ENDIF PATCH_GH} if OK_At_Start and Destroyed( Part ) then begin { The part started out OK, but it's been } @@ -292,6 +344,10 @@ var AAP: Integer; {The actual number that will be lost.} Armor: LongInt; { Initial armor value of the part. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { First, check InvComponents for external armor. } if ( Part <> Nil ) and ( not IsMasterGear( Part ) ) then begin XA := Part^.InvCom; @@ -304,6 +360,9 @@ begin { Locate the master of this part, which we'll need in order } { to check status conditions. } PMaster := FindMaster( Part ); +{$IFDEF PATCH_GH} + if (NIL = PMaster) or (PMaster^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} { Only do armor damage to parts which have armor. } if GearMaxArmor( Part ) > 0 then begin @@ -399,6 +458,10 @@ var XA: GearPtr; N: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} + { Increment the ITERATIONS value. } Inc( DAMAGE_Iterations ); { Do all damage thingies, unless we want to ignore damage. } @@ -433,7 +496,11 @@ begin {whatever's on the inside.} { Increase damage by excess margin of success. } +{$IFDEF PATCH_GH} + if ( MOS > 0 ) and (0 < GearMaxDamage(Part)) then begin +{$ELSE PATCH_GH} if ( MOS > 0 ) and ( GearMaxDamage(Part) <> -1 ) then begin +{$ENDIF PATCH_GH} { Each extra point of MOS will increase damage } { by 20%. } DMG := ( DMG * ( 5 + MOS ) ) div 5; @@ -447,7 +514,11 @@ begin if N > 0 then begin {There are subcomponents. Either damage this} {part directly, or pass damage on to a subcom.} +{$IFDEF PATCH_GH} + if (GearMaxDamage(Part) < 0) or ( Random(100) = 23 ) then begin +{$ELSE PATCH_GH} if (GearMaxDamage(Part) = -1) or ( Random(100) = 23 ) then begin +{$ENDIF PATCH_GH} {Damage a subcomponent. Time for recursion.} DMG := REALDamageGear( gb , FindActiveGear(Part^.SubCom,Random(N)+1), DMG , MOS , Scale , AtAt ); @@ -490,9 +561,14 @@ Function ConcussionDamageAmount( Part , var it,MS: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit(0); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Weapon := NIL; +{$ENDIF PATCH_GH} + { Base concussion chance is equal to the damage class of } { the weapon. } - it := Dmg; + it := Dmg; { Missiles and Melee Weapons do more concussion than normal. } if ( Weapon <> Nil ) then begin @@ -539,6 +615,10 @@ var P2: GearPtr; Total: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} + { Initialize TOTAL to 0. } Total := 0; @@ -576,7 +656,10 @@ var Total,T,Scale: LongInt; begin { Initialize History Variables. } +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} DAMAGE_LastPartHit := Nil; +{$ENDIF PATCH_GH} DAMAGE_EjectRoll := False; DAMAGE_EjectOK := False; DAMAGE_PilotDied := False; @@ -585,6 +668,14 @@ begin DAMAGE_Iterations := 0; DAMAGE_AmmoExplosion := False; DisposeSAtt( Destroyed_Parts_List ); +{$IFDEF PATCH_CHEAT} + DisposeSAtt( Exploding_Parts_List ); +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit(0); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Weapon := NIL; +{$ENDIF PATCH_GH} { Make sure at least one hit will be caused. } if N < 1 then N := 1; @@ -664,8 +755,15 @@ var MM,MA,DMG,N: Integer; { Move Mode and Move Action } MT: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { Make sure we have the root gear. } Mek := FindRoot( Mek ); +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} { Determine both the move mode and the move action for this mek. } MM := NAttValue( Mek^.NA , NAG_Action , NAS_MoveMode ); @@ -707,6 +805,10 @@ Procedure DoActionSetup( GB: GameBoardPt { Perpare all of the mek's data structures for the action } { being undertaken. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + if ( Action = NAV_Stop ) or ( Action = NAV_Hover ) or ( CPHMoveRate( Mek , GB^.Scale ) = 0 ) then begin if NAttValue( Mek^.NA , NAG_Action , NAS_MoveAction ) = NAV_Stop then begin { The mek is already stopped. Wait one round before calling again. } @@ -779,11 +881,20 @@ begin SetNAtt( Mek^.NA , NAG_Action , NAS_TimeLimit , 0 ); end; +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SpeedoMeter then begin + SetNAtt( Mek^.NA , NAG_Action , NAS_SpeedoMeter , CalcRelativeSpeed( Mek , GB ) ); + end; +{$ENDIF PATCH_CHEAT} end; Procedure PrepAction( GB: GameBoardPtr; Mek: GearPtr; Action: Integer ); { Given an action, prepare all of the mek's values for it. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + if MoveLegal( Mek , Action , GB^.ComTime ) or ( BaseMoveRate( Mek ) = 0 ) then begin DoActionSetup( GB , Mek , Action ); end else begin @@ -811,6 +922,10 @@ Procedure DoMoveTile( Mek: GearPtr; GB: var P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { Find out the gear's destination. } P := GearDestination( Mek ); @@ -835,6 +950,10 @@ var cmd: Integer; {The exact command issued.} D: Integer; {The direction of the mek.} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { Determine whether the mek is turning left or right. } cmd := NAttValue( Mek^.NA , NAG_Action , NAS_MoveAction ); @@ -888,6 +1007,10 @@ var ETA,Spd,StartTime,Order,Alt0,ALt1,SkRoll: LongInt; NeedRedraw: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} + { Note that this call to MoveThatMek might result in } { no movement at all. It could be a wait call- an ETA } { is set even if the mek's movemode is Inactive, or its } @@ -990,15 +1113,34 @@ end; Function TeamPV( MList: GearPtr; Team: Integer ): LongInt; { Calculate the total point value of active models belonging } { to TEAM which are present on the map. } +{$IFDEF PATCH_GH} +const + it_MAX = 2147483647; +{$ENDIF PATCH_GH} var +{$IFDEF PATCH_GH} + it: Int64; +{$ELSE PATCH_GH} it: LongInt; +{$ENDIF PATCH_GH} begin it := 0; while MList <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < MList^.G) then begin + if GearActive( MList ) and ( NAttValue( MList^.NA , NAG_Location , NAS_TEam ) = Team ) then begin + it := it + GearValue( MList ); + if it_MAX < it then begin + it := it_MAX; + end; + end; + end; +{$ELSE PATCH_GH} if GearActive( MList ) and ( NAttValue( MList^.NA , NAG_Location , NAS_TEam ) = Team ) then begin it := it + GearValue( MList ); end; +{$ENDIF PATCH_GH} MList := MList^.Next; end; @@ -1015,9 +1157,15 @@ begin it := 0; while MList <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < MList^.G) then begin +{$ENDIF PATCH_GH} if GearActive( MList ) and ( MList^.G = GG_Character ) and ( NAttValue( MList^.NA , NAG_Location , NAS_TEam ) = Team ) then begin it := it + MList^.V; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} MList := MList^.Next; end; @@ -1029,6 +1177,10 @@ Procedure WaitAMinute( GB: GameBoardPtr; var NextCall: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + Mek := FindRoot( Mek ); NextCall := NAttValue( Mek^.NA , NAG_Action , NAS_CallTime ); if ( GB <> Nil ) and ( NextCall < GB^.ComTime ) then NextCall := GB^.ComTime; @@ -1039,10 +1191,69 @@ begin SetNAtt( Mek^.NA , NAG_Action , NAS_CallTime , NextCall ); end; +{$IFDEF PATCH_GH} +Procedure WaitAMinute_Part( GB: GameBoardPtr; Mek: GearPtr; D: Integer ); + { Force MEK to wait a short time. } +var + NextCall: LongInt; +begin + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; + + NextCall := NAttValue( Mek^.NA , NAG_Action , NAS_CallTime ); + if ( NIL <> GB ) then begin + if ( NextCall < GB^.ComTime ) then begin + NextCall := GB^.ComTime; + end; + end; + NextCall := NextCall + D; + SetNAtt( Mek^.NA , NAG_Action , NAS_CallTime , NextCall ); +end; + +Function Check_WaitAMinute_Part( GB: GameBoardPtr; Mek: GearPtr ): Boolean; +var + RT: LongInt; +begin + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit( True ); + + Check_WaitAMinute_Part := False; + if ( NIL <> GB ) then begin + RT := NAttValue( Mek^.NA , NAG_Action , NAS_CallTime ); + if ( RT < GB^.ComTime ) then begin + SetNAtt( Mek^.NA , NAG_Action , NAS_CallTime , 0 ); + Check_WaitAMinute_Part := True; + end; + end; +end; +{$ENDIF PATCH_GH} + + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: action.pp'); +{$ENDIF DEBUG} Destroyed_Parts_List := Nil; +{$IFDEF PATCH_CHEAT} + Exploding_Parts_List := Nil; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + Attach_SmartPointer( 'Destroyed_Parts_List: SAttPtr', @Destroyed_Parts_List ); + {$IFDEF PATCH_CHEAT} + Attach_SmartPointer( 'Exploding_Parts_List: SAttPtr', @Exploding_Parts_List ); + {$ENDIF PATCH_CHEAT} +{$ENDIF PATCH_GH} +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: action.pp(finalization)'); +{$ENDIF DEBUG} DisposeSAtt( Destroyed_Parts_List ); +{$IFDEF PATCH_CHEAT} + DisposeSAtt( Exploding_Parts_List ); +{$ENDIF PATCH_CHEAT} +end; end. diff -x .svn -uprN GearHead1100repository.original/aibrain.pp branches/aibrain.pp --- GearHead1100repository.original/aibrain.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/aibrain.pp 2015-12-27 09:01:00.000000000 +0900 @@ -25,7 +25,11 @@ unit aibrain; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; Procedure ClearHotMaps; @@ -40,15 +44,32 @@ Function MOVE_MODEL_TOWARDS_SPOT( Mek: G implementation +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + ui4gh, + ability,action,arenacfe,backpack,damage,effects,movement,gearutil, + ghchars,ghmodule,ghweapon,ghparser,ghprop,interact,rpgdice,skilluse, + texutil, +{$ELSE PATCH_GH} + ability,action,arenacfe,damage,effects,movement,gearutil, + ghchars,ghmodule,ghweapon,ghparser,ghprop,interact,rpgdice,skilluse, + texutil,ui4gh, +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} -uses ability,action,arenacfe,damage,effects,movement,gearutil, - ghchars,ghmodule,ghweapon,ghparser,ghprop,interact,rpgdice,skilluse, - texutil,ui4gh,sdlmap,sdlgfx; -{$ELSE} -uses ability,action,arenacfe,damage,effects,movement,gearutil, - ghchars,ghmodule,ghweapon,ghparser,ghprop,interact,rpgdice,skilluse, - texutil,ui4gh,conmap,context; -{$ENDIF} + sdlmap,sdlgfx +{$ELSE SDLMODE} + conmap,context +{$ENDIF SDLMODE} +{$IFDEF PATCH_CHEAT} + ,pcaction,ghmecha +{$ENDIF PATCH_CHEAT} + ; const Hot_Terr: Array [0..NumMoveMode,1..NumTerr] of SmallInt = ( @@ -129,6 +150,10 @@ var var T,V: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Make sure combat taunts are enabled. } if No_Combat_Taunts then begin SetNAtt( FindRoot( NPC )^.NA , NAG_EpisodeData , NAS_ChatterRecharge , GB^.ComTime + 100000 ); @@ -137,7 +162,11 @@ begin { Make sure we have a proper NPC, and not a mecha. } NPC := LocatePilot( NPC ); +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if NPC = Nil then Exit; +{$ENDIF PATCH_GH} { Initialize our message list to NIL. } MList := Nil; @@ -162,7 +191,11 @@ begin { If at least one phrase was found, and the NPC is visible, it can say something. } if ( MList <> Nil ) and ( ( Msg_Label = 'CHAT_EJECT' ) or MekVisible( GB , FindRoot( NPC ) ) ) then begin +{$IFDEF PATCH_I18N} + DialogMsg( FormatChatStringByGender( '[' + GearName( NPC ) + ']: ' + SelectRandomSAtt( MList )^.Info, NPC ) ); +{$ELSE PATCH_I18N} DialogMsg( '[' + GearName( NPC ) + ']: ' + SelectRandomSAtt( MList )^.Info ); +{$ENDIF PATCH_I18N} end; { Add the chatter recharge time. } @@ -242,6 +275,9 @@ var begin M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} P := GearCurrentLocation( M ); if IsMasterGear( M ) and OnTheMap( P.X , P.Y ) and GearOperational( M ) then begin Inc( ColdMap[ N , P.X , P.Y ] ); @@ -255,6 +291,9 @@ begin HotMapFloodFill( GB , N , MM ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end; @@ -268,12 +307,18 @@ begin { Set the position for all blocking gears on the coldmap. } M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} P := GearCurrentLocation( M ); if IsMasterGear( M ) and OnTheMap( P.X , P.Y ) and GearOperational( M ) then begin Inc( ColdMap[ N , P.X , P.Y ] ); end else if ( M^.G = GG_MetaTerrain ) and ( M^.Stat[ STAT_Pass ] <= -100 ) and NotDestroyed( M ) then begin Inc( ColdMap[ N , P.X , P.Y ] ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -300,12 +345,18 @@ begin { Set the position for all blocking gears on the coldmap. } M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} P := GearCurrentLocation( M ); if IsMasterGear( M ) and OnTheMap( P.X , P.Y ) and GearOperational( M ) then begin Inc( ColdMap[ N , P.X , P.Y ] ); end else if ( M^.G = GG_MetaTerrain ) and ( M^.Stat[ STAT_Pass ] <= -100 ) and NotDestroyed( M ) then begin Inc( ColdMap[ N , P.X , P.Y ] ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -340,6 +391,9 @@ begin M := GB^.Meks; flag := True; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} P := GearCurrentLocation( M ); if IsMasterGear( M ) and OnTheMap( P.X , P.Y ) and GearOperational( M ) then begin Inc( ColdMap[ N , P.X , P.Y ] ); @@ -350,6 +404,9 @@ begin end else if ( M^.G = GG_MetaTerrain ) and ( M^.Stat[ STAT_Pass ] <= -100 ) and NotDestroyed( M ) then begin Inc( ColdMap[ N , P.X , P.Y ] ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -373,6 +430,9 @@ begin M := GB^.Meks; flag := True; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} P := GearCurrentLocation( M ); if IsMasterGear( M ) and OnTheMap( P.X , P.Y ) and GearOperational( M ) then begin Inc( ColdMap[ N , P.X , P.Y ] ); @@ -383,6 +443,9 @@ begin end else if ( M^.G = GG_MetaTerrain ) and ( M^.Stat[ STAT_Pass ] <= -100 ) and NotDestroyed( M ) then begin Inc( ColdMap[ N , P.X , P.Y ] ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -438,6 +501,10 @@ Function GetHotMap( GB: GameBoardPtr; Te var RepMap,GoodMap,T: Integer; begin +{$IFDEF PATCH_GH} + if (MM < 0) then Exit(0); +{$ENDIF PATCH_GH} + RepMap := 1; GoodMap := 0; for T := 1 to NumFFMap do begin @@ -463,6 +530,12 @@ var AtOp: Integer; T2,T3: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit; + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Calculate AttSkillVal, DefSkillVal, and set AtOp to 0. } if Target^.G = GG_Mecha then DefSkillVal := SkillValue( Target, 5 ) else DefSkillVal := SkillValue( Target, 10 ); @@ -478,18 +551,38 @@ begin { If using a powerful weapon, do aimed shot at the torso. } while ( T2 <> Nil ) and (( T2^.G <> GG_Module ) or ( T2^.S <> GS_Body )) do T2 := T2^.Next; +{$IFDEF PATCH_GH} + end else if (NIL <> T2) and (GG_DisposeGear < T2^.G) then begin +{$ELSE PATCH_GH} end else if T2 <> Nil then begin +{$ENDIF PATCH_GH} { If using a less powerful weapon, do aimed shot at the part with the lowest armor. } T3 := Nil; while T2 <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < T2^.G) then begin + if (NIL = T3) then begin + T3 := T2 + end else if GearCurrentArmor( T2 ) < GearCurrentArmor( T3 ) then begin + T3 := T2; + end; + end; +{$ELSE PATCH_GH} if T3 = Nil then T3 := T2 else if GearCurrentArmor( T2 ) < GearCurrentArmor( T3 ) then T3 := T2; +{$ENDIF PATCH_GH} T2 := T2^.Next; end; T2 := T3; end; +{$IFDEF PATCH_GH} + if (NIL <> T2) and (GG_DisposeGear < T2^.G) then begin + Target := T2; + end; +{$ELSE PATCH_GH} if T2 <> Nil then Target := T2; +{$ENDIF PATCH_GH} end else if ( Weapon^.G = GG_Weapon ) then begin { If not making a called shot, the attacker will take } @@ -509,12 +602,273 @@ begin SetNAtt( Mek^.NA , NAG_EpisodeData , NAS_InitRecharge , GB^.ComTime + ReactionTime( Mek ) ); end; +{$IFDEF PATCH_CHEAT} +Procedure SelectPurgePartsMode( Mek: GearPtr; GB: GameBoardPtr ); +var + FindParts: Boolean; + + Function CheckParts( P: GearPtr ): Boolean; + var + it: Boolean; + CurrentDamage: Integer; + MaxDamage: Integer; + CurrentArmor: Integer; + MaxArmor: Integer; + begin + CurrentDamage := GearCurrentDamage( P ); + MaxDamage := GearMaxDamage( P ); + CurrentArmor := GearCurrentArmor(P); + MaxArmor := GearMaxArmor(P); + case P^.G of + GG_Module: it := ( CurrentDamage <= ( ( MaxDamage * 90 ) div 100 ) ); + GG_Mecha: it := False; + GG_Character: it := False; + GG_Cockpit: it := False; + GG_Weapon: it := True; + GG_Ammo: it := ( P^.Stat[STAT_AmmoPresent] <= NAttValue( P^.NA , NAG_WeaponModifier , NAS_AmmoSpent ) ); + GG_MoveSys: it := False; + GG_Holder: it := True; + GG_Sensor: it := False; + GG_Support: it := False; + GG_Shield: it := ( CurrentArmor <= ( ( MaxArmor * 90 ) div 100 ) ); + GG_ExArmor: it := ( CurrentArmor <= ( ( MaxArmor * 90 ) div 100 ) ); + GG_Scene: it := False; + GG_Swag: it := False; + GG_Prop: it := False; + GG_MetaTerrain: it := False; + GG_Electronics: it := False; + GG_Usable: it := False; + GG_RepairFuel: it := False; + GG_Consumable: it := False; + GG_Modifier: it := False; + GG_WeaponAddOn: it := True; + else it := True; + end; + CheckParts := it; + end; + + Function CheckPartsAlongTrack( P: GearPtr ): Boolean; + var + P_Next: GearPtr; + begin + while ( NIL <> P ) do begin + P_Next := P^.Next; + if (GG_DisposeGear < P^.G) then begin + if not CheckParts( P ) then begin + exit( False ); + end; + + if ( GG_Cockpit = P^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + if ( not CheckPartsAlongTrack( P^.InvCom ) ) then begin + exit( False ); + end; + end else begin + if ( not CheckPartsAlongTrack( P^.SubCom ) ) then begin + exit( False ); + end; + if ( not CheckPartsAlongTrack( P^.InvCom ) ) then begin + exit( False ); + end; + end; + end; + P := P_Next; + end; + CheckPartsAlongTrack := True; + end; + +var + GS_Tag: String; + + Function CheckPartAlongTrack( P: GearPtr ): Boolean; + var + P_Next: GearPtr; + begin + while ( NIL <> P ) do begin + P_Next := P^.Next; + if (GG_DisposeGear < P^.G) then begin + if ( '' <> SAttValue( P^.SA, GS_Tag ) ) then begin + FindParts := True; + if ( not CheckParts( P ) ) then begin + exit( False ); + end; + if ( not CheckPartsAlongTrack( P^.SubCom ) ) then begin + exit( False ); + end; + if ( not CheckPartsAlongTrack( P^.InvCom ) ) then begin + exit( False ); + end; + end else begin + if ( GG_Cockpit = P^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + if ( not CheckPartAlongTrack( P^.InvCom ) ) then begin + exit( False ); + end; + end else begin + if ( not CheckPartAlongTrack( P^.SubCom ) ) then begin + exit( False ); + end; + if ( not CheckPartAlongTrack( P^.InvCom ) ) then begin + exit( False ); + end; + end; + end; + end; + P := P_Next; + end; + CheckPartAlongTrack := True; + end; + +var + MaxMode: Integer; + T: Integer; + SelectMode: Integer; +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + + MaxMode := SAttValueToInt( Mek^.SA, SATT_SEPARABLE ); + if ( MaxMode < 1 ) then exit; + + SelectMode := 0; + for T := 1 to MaxMode do begin + if ( 0 <= SAttValueToInt(Mek^.SA,SATT_SEPARATE_WAIT + BStr(T)) ) then begin + FindParts := False; + GS_Tag := SATT_SEPARATE + BStr(T); + if CheckPartAlongTrack( Mek^.SubCom ) then begin + if FindParts then begin + SelectMode := T; + end; + end; + end; + end; + + if ( SelectMode < 1 ) or ( MaxMode < SelectMode ) then begin + exit; + end; + + DoPurgeParts( GB , Mek , SelectMode ); +end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} +Procedure SelectFastestFormMode( Mek: GearPtr; GB: GameBoardPtr ); +var + MaxForm: Integer; + OldForm: Integer; + MaxSpeed: Integer; + FM: Integer; + FS: Integer; + WaitTime: Integer; + I: Integer; + J: Integer; + NewForm: Integer; +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + + MaxForm := SAttValueToInt( Mek^.SA , SATT_TRANSFORMABLE ); + if MaxForm < 1 then exit; + OldForm := SAttValueToInt( Mek^.SA , SATT_TRANSFORM_CURRENT ); + if OldForm < 1 then exit; + if not CheckConversionSystem( Mek , False ) then begin + exit; + end; + + MaxSpeed := 0; + NewForm := 0; + + for I := 1 to MaxForm do begin + WaitTime := SAttValueToInt( Mek^.SA , SATT_TRANSFORM_WAIT + BStr(OldForm) + '_' + BStr(I) ); + if ( ( 0 < WaitTime ) or ( OldForm = I ) ) then begin + FM := SAttValueToInt( Mek^.SA , SATT_TRANSFORM_GS + BStr(I) ); + for J := 1 to NumMoveMode do begin + FS := FormSpeedLimit[ FM , J ]; + if ( MaxSpeed < FS ) then begin + MaxSpeed := FS; + NewForm := I; + end else if ( MaxSpeed = FS ) then begin + if ( 1 = random(2) ) then begin + MaxSpeed := FS; + NewForm := I; + end; + end; + end; + end; + end; + + if ( ( 0 < NewForm ) and ( OldForm <> NewForm ) ) then begin + DoTransformation( GB , Mek , NewForm ); + end; +end; + +Procedure SelectHeavyFormMode( Mek: GearPtr; GB: GameBoardPtr ); +const + FormVolume: Array [0..NumForm-1] of Integer = ( + 50, {Battroid} + 20, {Zoanoid} + 20, {GroundHugger} + 20, {Arachnoid} + 20, {AeroFighter} + 20, {Ornithoid} + 50, {GerWalk} + 20, {HoverFighter} + 20 {GroundCar} + ); +var + MaxForm: Integer; + OldForm: Integer; + MaxVolume: Integer; + FM: Integer; + FV: Integer; + WaitTime: Integer; + I: Integer; + NewForm: Integer; +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + + MaxForm := SAttValueToInt( Mek^.SA , SATT_TRANSFORMABLE ); + if MaxForm < 1 then exit; + OldForm := SAttValueToInt( Mek^.SA , SATT_TRANSFORM_CURRENT ); + if OldForm < 1 then exit; + if not CheckConversionSystem( Mek , False ) then begin + exit; + end; + + MaxVolume := 0; + NewForm := 0; + + for I := 1 to MaxForm do begin + WaitTime := SAttValueToInt( Mek^.SA , SATT_TRANSFORM_WAIT + BStr(OldForm) + '_' + BStr(I) ); + if ( ( 0 < WaitTime ) or ( OldForm = I ) ) then begin + FM := SAttValueToInt( Mek^.SA , SATT_TRANSFORM_GS + BStr(I) ); + FV := FormVolume[ FM ]; + if ( random(100) < FV ) then begin + NewForm := I; + break; + end; + end; + end; + + if ( ( 0 < NewForm ) and ( OldForm <> NewForm ) ) then begin + DoTransformation( GB , Mek , NewForm ); + end; +end; +{$ENDIF PATCH_CHEAT} + procedure SelectMoveMode( Mek: GearPtr; GB: GameBoardPtr ); { Set the mek's MoveMode attribute to the highest } { active movemode that this mek has. } var T,MM,MaxSpeed: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + MM := 0; MaxSpeed := 0; for T := 1 to NumMoveMode do begin @@ -555,7 +909,13 @@ var R := BlastRadius( GB , Part , WeaponAttackAttributes( Part ) ); Found := False; while M2 <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M2^.G) then begin +{$ENDIF PATCH_GH} if AreAllies( GB , Mek , M2 ) and ( Range( M2 , P.X , P.Y ) < R ) then Found := True; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M2 := M2^.Next; end; SafeToFire := Not Found; @@ -568,7 +928,7 @@ var function WGoodness( Part, Target: GearPtr ): Integer; { This is the heuristic SeekBigWeapon uses } var - WG,AS,AM : Integer; + WG,ASV,AM : Integer; AttSkillVal, DefSkillVal : Integer; begin { Can your lancemates size up the abilities of a defender in a } @@ -581,12 +941,12 @@ var { modifiers, so this is an approximation } { Missiles will have BustValue = 0. Don't fire } { until you can see the whites of their eyes. } - AS := SkillValue( FindRoot(Part) , AttackSkillNeeded( Part ) ); + ASV := SkillValue( FindRoot(Part) , AttackSkillNeeded( Part ) ); AM := CalcTotalModifiers( gb , Part , Target , Part^.Stat[ STAT_BurstValue ] , WeaponAttackAttributes( Part ) ); - AttSkillVal := AS + AM; + AttSkillVal := ASV + AM; WG := Part^.V * (1+Part^.Stat[ STAT_BurstValue ]) + 2*(AttSkillVal-DefSkillVal); - for AS := 1 to Part^.Scale do WG := WG * 3; + for ASV := 1 to Part^.Scale do WG := WG * 3; WGoodness := WG; end; @@ -607,6 +967,11 @@ var begin while ( Part <> Nil ) do begin if ( Part^.G = GG_Module ) or ( Part^.G = GG_Weapon ) then begin +{$IFDEF PATCH_GH} + if NeedAmmo( Part ) then begin + ReloadAmmo( GB , Mek , Part ); + end; +{$ENDIF PATCH_GH} if ReadyToFire( GB , Mek , Part ) and RangeArcCheck( GB , Mek , Part , Target ) and SafeToFire( Part ) then begin if Weapon = Nil then begin @@ -628,6 +993,10 @@ var end; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(NIL); + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} Weapon := Nil; BestWeight := -10000; SeekBigWeapon( Mek^.SubCom ); @@ -647,6 +1016,11 @@ var begin while ( Part <> Nil ) do begin if ( Part^.G = GG_Module ) or ( Part^.G = GG_Weapon ) then begin +{$IFDEF PATCH_GH} + if NeedAmmo( Part ) then begin + ReloadAmmo( GB , Mek , Part ); + end; +{$ENDIF PATCH_GH} if ReadyToFire( GB , Mek , Part ) then begin if Weapon = Nil then Weapon := Part else if WeaponRange( GB , Part ) > WeaponRange( GB , Weapon ) then Weapon := Part; @@ -682,7 +1056,13 @@ var R := BlastRadius( GB , Part , WeaponAttackAttributes( Part ) ); while M2 <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M2^.G) then begin +{$ENDIF PATCH_GH} if AreAllies( GB , Mek , M2 ) and ( Range( M2 , P.X , P.Y ) < R ) then Found := True; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M2 := M2^.Next; end; @@ -723,6 +1103,10 @@ var begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { First, check to make sure that the mecha hasn't attacked } { too recently. } if NAttValue( Mek^.NA , NAG_EpisodeData , NAS_InitRecharge ) > GB^.ComTime then Exit; @@ -740,10 +1124,28 @@ begin TL := gb^.meks; while TL <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < TL^.G) then begin + if (AreEnemies( GB , Mek , TL ) and OnTheMap( TL )) then begin + if (RangeArcCheck( GB , Mek , Weapon , TL ) and GearActive( TL )) then begin + if MekCanSeeTarget( GB , Mek , TL ) then begin + if Target = Nil then begin + Target := TL + end else begin + if (Range( gb , Target , Mek ) > Range( gb , TL , Mek )) then begin + Target := TL; + end; + end; + end; + end; + end; + end; +{$ELSE PATCH_GH} if AreEnemies( GB , Mek , TL ) and OnTheMap( TL ) and RangeArcCheck( GB , Mek , Weapon , TL ) and GearActive( TL ) and MekCanSeeTarget( GB , Mek , TL ) then begin if Target = Nil then Target := TL else if Range( gb , Target , Mek ) > Range( gb , TL , Mek ) then Target := TL; end; +{$ENDIF PATCH_GH} TL := TL^.Next; end; @@ -764,6 +1166,10 @@ var P: Point; CD: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Determine current facing and position. } P := GearCurrentLocation( Mek ); CD := NAttValue( Mek^.NA , NAG_Location , NAS_D ); @@ -801,6 +1207,10 @@ var P,P2: Point; T,D,Best,CD: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + P := GearCurrentLocation( Mek ); { If our current direction of travel is bringing us closer to the } @@ -897,7 +1307,11 @@ begin end else if OnTheMap( P.X + AngDir[ CD , 1 ] , P.Y + AngDir[ CD , 2 ] ) and ( HotMap[ HM , P.X + AngDir[ CD , 1 ] , P.Y + AngDir[ CD , 2 ] ] < HotMap[ HM , P.X , P.Y ] ) and ( HotMap[ HM , P.X , P.Y ] < Random( 4 ) ) and not MoveBlocked( Mek , GB ) then begin +{$IFDEF PATCH_CHEAT} + if (( Mek^.G = GG_Mecha ) or ( not Cheat_DoNotRunWhenMouseClicked and ( CurrentStamina( Mek ) > 10 ) ) ) and MoveLegal( Mek , NAV_FullSpeed , GB^.ComTime ) then begin +{$ELSE PATCH_CHEAT} if (( Mek^.G = GG_Mecha ) or ( CurrentStamina( Mek ) > 10 ) ) and MoveLegal( Mek , NAV_FullSpeed , GB^.ComTime ) then begin +{$ENDIF PATCH_CHEAT} PrepAction( GB , Mek , NAV_FullSpeed ); end else if MoveLegal( Mek , NAV_NormSpeed , GB^.ComTime ) then begin PrepAction( GB , Mek , NAV_NormSpeed ); @@ -931,7 +1345,11 @@ begin end else begin if MoveBlocked( Mek , GB ) then begin Exit( False ); +{$IFDEF PATCH_CHEAT} + end else if ( HotMap[ HM , P.X ,P.Y ] > ( OptMax * 3 div 2 ) ) and (( Mek^.G = GG_Mecha ) or ( not Cheat_DoNotRunWhenMouseClicked and ( CurrentStamina( Mek ) > 10 ) ) ) and MoveLegal( Mek , NAV_FullSpeed, GB^.ComTime ) then begin +{$ELSE PATCH_CHEAT} end else if ( HotMap[ HM , P.X ,P.Y ] > ( OptMax * 3 div 2 ) ) and (( Mek^.G = GG_Mecha ) or ( CurrentStamina( Mek ) > 10 ) ) and MoveLegal( Mek , NAV_FullSpeed, GB^.ComTime ) then begin +{$ENDIF PATCH_CHEAT} PrepAction( GB , Mek , NAV_FullSpeed ); end else if MoveLegal( Mek , NAV_NormSpeed, GB^.ComTime ) then begin PrepAction( GB , Mek , NAV_NormSpeed ); @@ -955,6 +1373,10 @@ end; Procedure MoveTowardsGoal( GB: GameBoardPtr; Mek: GearPtr; HM: Integer ); { Front-end for the Extended Move Towards Goal. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if not XMoveTowardsGoal( GB , Mek , HM , 0 , 0 ) then Wander( Mek , GB ); end; @@ -975,6 +1397,10 @@ var P: Point; D: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { No reason to panic. Just stand around; } { maybe move if it's okay. } if Random( 3 ) = 1 then begin @@ -1010,6 +1436,10 @@ var P: Point; T,D,Best,CD: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + P := GearCurrentLocation( Mek ); { If our current direction of travel is bringing us closer to the } @@ -1058,6 +1488,10 @@ Function HotMoveMode( Mek: GearPtr ): In var T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} + T := NAttValue( Mek^.NA , NAG_Action , NAS_MoveMode ); if ( T = MM_Walk ) and ( Mek^.G = GG_Character ) then T := 0; HotMoveMode := T; @@ -1070,10 +1504,20 @@ var N: LongInt; msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit; + if (NIL = RepairFuel) or (RepairFuel^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + N := UseRepairSkill( GB , NPC , Target , Skill ); +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('NPCREPAIR','UseSkill'), GearName(NPC), GearName(Target) ); +{$ELSE PATCH_I18N} msg := MsgString( 'NPCREPAIR_UseSkill' ); msg := ReplaceHash( msg , GearName( NPC ) ); msg := ReplaceHash( msg , GearName( Target ) ); +{$ENDIF PATCH_I18N} { Inform the user of the success. } if N > 0 then begin @@ -1099,13 +1543,24 @@ Function SelectRepairTarget( GB: GameBoa { Locate a target that needs repairs. } var T,BTar: GearPtr; +{$IFDEF PATCH_GH} + Best,Dmg: LongInt; +{$ELSE PATCH_GH} Best,Dmg: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + T := GB^.Meks; BTar := Nil; Best := 0; while T <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < T^.G) then begin +{$ENDIF PATCH_GH} if AreAllies( GB , Mek , T ) then begin Dmg := TotalRepairableDamage( T , Skill ); if Dmg > Best then begin @@ -1113,6 +1568,9 @@ begin Best := Dmg; end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} T := T^.Next; end; @@ -1127,6 +1585,9 @@ var Function IsGoodSocTarget: Boolean; { Return TRUE if M is a good target, or FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if ( NAttValue( NPC^.NA , NAG_Personal , NAS_CID ) = 0 ) or ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = Team ) or ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) then begin IsGoodSocTarget := False; end else if MustBeSexy then begin @@ -1136,6 +1597,10 @@ var end; end; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + { Make two passes. On the first pass, just count the number of candidates. } { On the second pass actually select one. } N := 0; @@ -1143,7 +1608,13 @@ begin M := GB^.Meks; Team := NAttValue( NPC^.NA , NAG_Location , NAS_Team ); while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if IsGoodSocTarget then Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -1152,10 +1623,16 @@ begin M := GB^.Meks; N := Random( N ); while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if IsGoodSocTarget then begin Dec( N ); if N = -1 then Target := M; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end; @@ -1172,36 +1649,59 @@ var msg: String; M,PC: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + SkRoll := RollStep( SkillValue( NPC , 27 ) ); if SkRoll > 15 then begin { Report the success. } +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('NPCFLIRT','Good'), PilotName(NPC), PilotName(TARGET) ); +{$ELSE PATCH_I18N} msg := MsgString( 'NPCFLIRT_Good' ); msg := ReplaceHash( msg , PilotName( NPC ) ); msg := ReplaceHash( msg , PilotName( TARGET ) ); +{$ENDIF PATCH_I18N} DialogMsg( msg ); { Success! Improve the reaction score. } CID := NAttValue( Target^.NA , NAG_Personal , NAS_CID ); M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and GearActive( M ) then begin PC := LocatePilot( M ); if PC <> Nil then AddNAtt( PC^.NA , NAG_ReactionScore , CID , 1 + Random( 3 ) ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end else if SkRoll > 5 then begin { Okay... neither good nor bad. } +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('NPCFLIRT','Okay'), PilotName(NPC), PilotName(TARGET) ); +{$ELSE PATCH_I18N} msg := MsgString( 'NPCFLIRT_Okay' ); msg := ReplaceHash( msg , PilotName( NPC ) ); msg := ReplaceHash( msg , PilotName( TARGET ) ); +{$ENDIF PATCH_I18N} DialogMsg( msg ); end else begin { Bad. This is just bad. } AddMoraleDmg( NPC , 15 ); +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('NPCFLIRT','Bad'), PilotName(NPC), PilotName(TARGET) ); +{$ELSE PATCH_I18N} msg := MsgString( 'NPCFLIRT_Bad' ); msg := ReplaceHash( msg , PilotName( TARGET ) ); msg := ReplaceHash( msg , PilotName( NPC ) ); +{$ENDIF PATCH_I18N} DialogMsg( msg ); end; end; @@ -1213,6 +1713,11 @@ var msg: String; Rumors: SAttPtr; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + SkRoll := RollStep( SkillValue( NPC , 19 ) ); if SkRoll > 10 then begin { A rumor has been gained. } @@ -1224,17 +1729,25 @@ begin msg := msg + ' ' + SelectRandomSAtt( Rumors )^.info; DisposeSAtt( Rumors ); end else begin +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('NPCCHAT','Okay'), PilotName(NPC), PilotName(TARGET) ); +{$ELSE PATCH_I18N} msg := MsgString( 'NPCCHAT_Okay' ); msg := ReplaceHash( msg , PilotName( NPC ) ); msg := ReplaceHash( msg , PilotName( TARGET ) ); +{$ENDIF PATCH_I18N} end; DialogMsg( msg ); end else begin { Okay... neither good nor bad. } +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('NPCCHAT','Okay'), PilotName(NPC), PilotName(TARGET) ); +{$ELSE PATCH_I18N} msg := MsgString( 'NPCCHAT_Okay' ); msg := ReplaceHash( msg , PilotName( NPC ) ); msg := ReplaceHash( msg , PilotName( TARGET ) ); +{$ENDIF PATCH_I18N} DialogMsg( msg ); end; end; @@ -1252,6 +1765,10 @@ var NPC,TGear,Tool: GearPtr; CORD: Integer; { Continuous Orders } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { See if there are any pending actions. } CORD := NAttValue( Mek^.NA , NAG_EpisodeData , NAS_ContinuousOrders ); @@ -1385,6 +1902,68 @@ end; Procedure Seek_And_Destroy( Mek: GearPtr; GB: GameBoardPtr ); { Seek an enemy, destroy it if possible. } + +{$IFDEF PATCH_CHEAT} + Function CheckToFire( Mek: GearPtr; GB: GameBoardPtr ): Boolean; + var + Weapon: GearPtr; + TL,Target: GearPtr; + + procedure SeekFarWeapon( Part: GearPtr ); + begin + while ( NIL <> Part ) do begin + if ( ( GG_Module = Part^.G ) or ( GG_Weapon = Part^.G ) ) then begin +{$IFDEF PATCH_GH} + if NeedAmmo( Part ) then begin + ReloadAmmo( GB , Mek , Part ); + end; +{$ENDIF PATCH_GH} + if ReadyToFire( GB , Mek , Part , False , True, False ) then begin + if ( NIL = Weapon ) then begin + Weapon := Part + end else if ( WeaponRange( GB , Weapon ) < WeaponRange( GB , Part ) ) then begin + Weapon := Part; + end; + end; + end; + SeekFarWeapon( Part^.SubCom ); + SeekFarWeapon( Part^.InvCom ); + Part := Part^.Next; + end; + end; + begin + Weapon := NIL; + SeekFarWeapon( Mek^.SubCom ); + SeekFarWeapon( Mek^.InvCom ); + if ( NIL = Weapon ) then begin + exit( False ); + end; + + Target := NIL; + TL := GB^.Meks; + + while ( NIL <> TL ) do begin + if (GG_DisposeGear < TL^.G) then begin + if ( AreEnemies( GB , Mek , TL ) and OnTheMap( TL ) ) then begin + if ( RangeCheck( GB , Mek , Weapon , TL ) and GearActive( TL ) ) then begin + if MekCanSeeTarget( GB , Mek , TL ) then begin + Target := TL; + break; + end; + end; + end; + end; + TL := TL^.Next; + end; + + if ( NIL = Target ) then begin + exit( False ); + end; + + CheckToFire := True; + end; +{$ENDIF PATCH_CHEAT} + var HM: Integer; N1,D1,N2,D2: LongInt; { Numerator 1 , Numerator 2 , Denominator 1 , Denominator 2 } @@ -1398,7 +1977,15 @@ var Dmg,Rng: Integer; begin while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} { If PART is a weapon, it will affect our calculations. } +{$IFDEF PATCH_GH} + if NeedAmmo( Part ) then begin + ReloadAmmo( GB , Mek , Part ); + end; +{$ENDIF PATCH_GH} if ReadyToFire( GB , Mek , Part ) then begin if Part^.G = GG_Module then begin Dmg := WeaponDC( Part , 0 ); @@ -1425,6 +2012,9 @@ var end; CheckOptimumRange( Part^.SubCom ); CheckOptimumRange( Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; @@ -1443,6 +2033,10 @@ var end; end; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { First, move towards the enemy, if necessary. } if Random( 3 ) = 1 then begin SelectMoveMode( Mek , GB ); @@ -1469,6 +2063,19 @@ begin { Secondly, attack anyone within reach. } AttackTargetOfOppurtunity( GB , Mek ); + +{$IFDEF PATCH_CHEAT} + if Random( 10 ) = 0 then begin + if CheckToFire( Mek, GB ) then begin + SelectHeavyFormMode( Mek , GB ); + end else begin +{$IFDEF PATCH_CHEAT} + SelectPurgePartsMode( Mek , GB ); +{$ENDIF PATCH_CHEAT} + SelectFastestFormMode( Mek , GB ); + end; + end; +{$ENDIF PATCH_CHEAT} end; @@ -1479,6 +2086,10 @@ var TN: Integer; TG: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + TN := NAttValue( Mek^.NA , NAG_Location , NAS_Team ); TG := LocateTeam( GB , TN ); @@ -1501,6 +2112,10 @@ Procedure GOTO_SPOT( Mek: GearPtr; GB: G var HM,X,Y,GX,GY: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Locate all the values we're gonna need. } X := NAttValue( Mek^.NA , NAG_Location , NAS_X ); Y := NAttValue( Mek^.NA , NAG_Location , NAS_Y ); @@ -1508,6 +2123,12 @@ begin GY := NAttValue( Mek^.NA , NAG_Location , NAS_GY ); if Random( 3 ) = 1 then begin +{$IFDEF PATCH_CHEAT} + SelectPurgePartsMode( Mek , GB ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + SelectFastestFormMode( Mek , GB ); +{$ENDIF PATCH_CHEAT} SelectMoveMode( Mek , GB ); end; @@ -1532,10 +2153,20 @@ Procedure GOTO_EDGE( Mek: GearPtr; GB: G var HM,Edge: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Locate all the values we're gonna need. } Edge := NAttValue( Mek^.NA , NAG_EpisodeData , NAS_ATarget ); if Random( 2 ) = 1 then begin +{$IFDEF PATCH_CHEAT} + SelectPurgePartsMode( Mek , GB ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + SelectFastestFormMode( Mek , GB ); +{$ENDIF PATCH_CHEAT} SelectMoveMode( Mek , GB ); end; @@ -1554,6 +2185,10 @@ Procedure PASSIVE( Mek: GearPtr; GB: Gam var HM: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { First, move towards the enemy, if necessary. } HM := GetHotMap( GB , NAttValue( Mek^.NA , NAG_LOcation , NAS_Team ) , HotMoveMode( Mek ) , ORD_SeekEnemy ); FleeFromGoal( GB , Mek , HM ); @@ -1562,8 +2197,18 @@ end; Procedure RUNAWAY( Mek: GearPtr; GB: GameBoardPtr ); { This AI type is for models wishing to exit the board. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { This mode will likely run the NPC off the map. } if MoveBlocked( Mek , GB ) then begin +{$IFDEF PATCH_CHEAT} + SelectPurgePartsMode( Mek , GB ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + SelectFastestFormMode( Mek , GB ); +{$ENDIF PATCH_CHEAT} SelectMoveMode( Mek , GB ); if Random( 2 ) = 1 then begin PrepAction( GB , Mek , NAV_TurnRight ); @@ -1582,6 +2227,10 @@ Procedure FOLLOW( Mek: GearPtr; GB: Game var UID,HM: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { First, attempt to move closer to target. } UID := NAttValue( Mek^.NA , NAG_EpisodeData , NAS_ATarget ); HM := GetHotMap( GB , UID , HotMoveMode( Mek ) , ORD_SeekSingleModel ); @@ -1596,6 +2245,10 @@ Procedure AI_Eject( Mek: GearPtr; GB: Ga var Pilot: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Better set the following triggers. } SetTrigger( GB , TRIGGER_NumberOfUnits + BStr( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) ) ); SetTrigger( GB , TRIGGER_UnitEliminated2 + BStr( NAttValue( Mek^.NA , NAG_EpisodeData , NAS_UID ) ) ); @@ -1616,6 +2269,10 @@ Function ShouldEject( Mek: GearPtr; GB: var Dmg,PrevDmg,Intimidation: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + Dmg := PercentDamaged( Mek ); PrevDmg := 100 - NAttValue( Mek^.NA , NAG_EpisodeData , NAS_PrevDamage ); SetNAtt( Mek^.NA , NAG_EpisodeData , NAS_PrevDamage , 100 - DMG ); @@ -1637,6 +2294,10 @@ Procedure GetAIInput( Mek: GearPtr; GB: var O: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Before processing orders, check jump time, since the AI is } { stupid and will crash as often as possible. } O := NAttValue( Mek^.NA , NAG_Action , NAS_TimeLimit ); @@ -1680,6 +2341,10 @@ var P: Point; CD: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Determine current facing and position. } P := GearCurrentLocation( Mek ); CD := NAttValue( Mek^.NA , NAG_Location , NAS_D ); @@ -1722,7 +2387,13 @@ Procedure BrownianMotion( GB: GameBoardP N := NumGearsXY( GB , X , Y ); for t := 1 to N do begin target := FindGearXY( GB , X , Y , T ); +{$IFDEF PATCH_GH} + if ( Target <> MT ) and NotDestroyed( Target ) then begin + EffectFrontEnd( GB , MT , Target , fx , desc ); + end; +{$ELSE PATCH_GH} if ( Target <> MT ) and NotDestroyed( Target ) then EffectFrontEnd( GB , Target , fx , desc ); +{$ENDIF PATCH_GH} end; end; var @@ -1747,6 +2418,9 @@ begin while M <> Nil do begin M2 := M^.Next; +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} P := GearCurrentLocation( M ); if OnTheMap( P.X , P.Y ) then begin if ( M^.G = GG_Metaterrain ) and ( M^.S = GS_MetaCloud ) then begin @@ -1778,6 +2452,9 @@ begin ElseMap[ P.X , P.Y ] := True; end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M2; end; @@ -1877,6 +2554,10 @@ var HM,X,Y: Integer; it: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Locate all the values we're gonna need. } X := NAttValue( Mek^.NA , NAG_Location , NAS_X ); Y := NAttValue( Mek^.NA , NAG_Location , NAS_Y ); @@ -1906,12 +2587,21 @@ begin end; -initialization +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: aibrain.pp'); +{$ENDIF DEBUG} NPC_Chatter_Standard := LoadStringList( NPC_Chatter_File ); +end; finalization - +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: aibrain.pp(finalization)'); +{$ENDIF DEBUG} DisposeSAtt( NPC_Chatter_Standard ); +end; end. diff -x .svn -uprN GearHead1100repository.original/arena.pas branches/arena.pas --- GearHead1100repository.original/arena.pas 2012-01-09 14:01:36.526131000 +0900 +++ branches/arena.pas 2016-02-28 09:01:00.000000000 +0900 @@ -27,42 +27,151 @@ program Arena; {$IFDEF SDLMODE} -{$IFNDEF DEBUG} -{$APPTYPE GUI} -{$ENDIF} -uses gears,sdlgfx,arenahq,sdlmenus,randchar,navigate,sdlmap; -{$ELSE} -uses gears,congfx,arenahq,conmenus,randchar,navigate,context,mapedit; -{$ENDIF} + {$IFDEF DEBUG} + {$ELSE DEBUG} + {$APPTYPE GUI} + {$ENDIF} +{$ENDIF} +{$IFDEF GUIMSWINMODE} + {$IFDEF DEBUG} + {$ELSE DEBUG} + {$APPTYPE GUI} + {$ENDIF DEBUG} +{$ENDIF GUIMSWINMODE} + +{$IFDEF PATCH_GH} +uses + {$IFDEF PATCH_I18N} + dos, + version, + {$ENDIF PATCH_I18N} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} + gears_base, + gears, + {$IFDEF PATCH_I18N} + i18nmsg, + {$ENDIF PATCH_I18N} + ui4gh, + {$IFDEF PATCH_CHEAT} + menugear, + {$ENDIF PATCH_CHEAT} + {$IFDEF SDLMODE} + sdlgfx,arenahq,sdlmenus,randchar,navigate,sdlmap, + {$ELSE} + congfx,arenahq,conmenus,randchar,navigate,context, + {$ENDIF} + mapedit; +{$ELSE PATCH_GH} +uses + {$IFDEF PATCH_I18N} + dos, + version, + {$ENDIF PATCH_I18N} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} + gears, + {$IFDEF PATCH_I18N} + i18nmsg, + {$ENDIF PATCH_I18N} + {$IFDEF PATCH_CHEAT} + ui4gh, + menugear, + {$ENDIF PATCH_CHEAT} + {$IFDEF SDLMODE} + sdlgfx,arenahq,sdlmenus,randchar,navigate,sdlmap + {$ELSE} + congfx,arenahq,conmenus,randchar,navigate,context,mapedit + {$ENDIF} + ; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} const - Version = '1.100'; + Version = '1.100-github'; +{$ENDIF PATCH_I18N} var RPM: RPGMenuPtr; N: Integer; begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arena.pas(begin)'); +{$ENDIF DEBUG} + RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'Start RPG Campaign' ) , 4 ); + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'Load RPG Campaign' ) , 5 ); + {$IFDEF PATCH_GH} + if Enable_ArenaMode then begin + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'New Arena Unit' ) , 1 ); + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'Load Arena Unit' ) , 2 ); + end; + {$ELSE PATCH_GH} + {$IFNDEF SDLMODE} + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'New Arena Unit' ) , 1 ); + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'Load Arena Unit' ) , 2 ); + {$ENDIF SDLMODE} + {$ENDIF PATCH_GH} + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'Create Character' ) , 3 ); + {$IFDEF PATCH_GH} + if Enable_EditMap then begin + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'Edit Map' ) , 6 ); + end; + {$ELSE PATCH_GH} + {$IFNDEF SDLMODE} + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'Edit Map' ) , 6 ); + {$ENDIF SDLMODE} + {$ENDIF PATCH_GH} + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'View Design Files' ) , 7 ); + AddRPGMenuItem( RPM , '(v' + Version_org + ')' , 8 ); + AddRPGMenuItem( RPM , '(BIN:' + Version_I18N + ')' , 8 ); + AddRPGMenuItem( RPM , '(MSG: ' + Version_txt + ')' , 8 ); + AddRPGMenuItem( RPM , I18N_MsgString( 'arena.pas', 'Quit Game' ) , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Start RPG Campaign' , 4 ); AddRPGMenuItem( RPM , 'Load RPG Campaign' , 5 ); -{$IFNDEF SDLMODE} + {$IFNDEF SDLMODE} AddRPGMenuItem( RPM , 'New Arena Unit' , 1 ); AddRPGMenuItem( RPM , 'Load Arena Unit' , 2 ); -{$ENDIF} + {$ENDIF SDLMODE} AddRPGMenuItem( RPM , 'Create Character' , 3 ); -{$IFNDEF SDLMODE} + {$IFNDEF SDLMODE} AddRPGMenuItem( RPM , 'Edit Map' , 6 ); -{$ENDIF} + {$ENDIF SDLMODE} AddRPGMenuItem( RPM , 'View Design Files' , 7 ); AddRPGMenuItem( RPM , 'Quit Game' , -1 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_MainMenu_AddMenuKey then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} repeat +{$IFDEF DEBUG} + ErrorMessage_fork( 'DEBUG_MESSAGE: Main Loop' ); + {$IFDEF PATCH_I18N} + ErrorMessage_fork( rcsid ); + ErrorMessage_fork( '(MSG: ' + Version_txt + ')' ); + {$ELSE PATCH_I18N} + ErrorMessage_fork( 'GearHead Arena v' + Version ); + {$ENDIF PATCH_I18N} +{$ENDIF DEBUG} ClrScreen; { Get rid of the console history from previous games. } DisposeSAtt( Console_History ); +{$IFDEF PATCH_I18N} + CMessage( 'GearHead Arena v' + Version_org + ' BIN:' + Version_I18N + ', MSG: ' + Version_txt, ZONE_Map, InfoHilight ); +{$ELSE PATCH_I18N} CMessage( 'GearHead Arena v' + Version, ZONE_Map, InfoHilight ); +{$ENDIF PATCH_I18N} if not STARTUP_OK then DialogMsg( 'ERROR: Main game directories not found. Please check installation of the game.' ); {$IFDEF SDLMODE} PrepOpening; @@ -77,13 +186,24 @@ begin 3: GenerateNewPC; 4: StartRPGCampaign; 5: RestoreCampaign; -{$IFNDEF SDLMODE} +{$IFDEF PATCH_GH} 6: EditMap; -{$ENDIF} +{$ELSE PATCH_GH} + {$IFNDEF SDLMODE} + 6: EditMap; + {$ENDIF} +{$ENDIF PATCH_GH} 7: DesignDirBrowser; end; until N = -1; +{$IFDEF DEBUG} + ErrorMessage_fork( 'DEBUG_MESSAGE: Main Loop fin' ); +{$ENDIF DEBUG} {deallocate all dynamic resources.} DisposeRPGMenu( RPM ); + +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arena.pas(end)'); +{$ENDIF DEBUG} end. diff -x .svn -uprN GearHead1100repository.original/arenacfe.pp branches/arenacfe.pp --- GearHead1100repository.original/arenacfe.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/arenacfe.pp 2015-07-31 09:01:00.000000000 +0900 @@ -24,11 +24,19 @@ unit ArenaCFE; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; Procedure AttackerFrontEnd( GB: GameBoardPtr; Attacker,Weapon: GearPtr; X,Y,Z,AtOp: Integer ); Procedure AttackerFrontEnd( GB: GameBoardPtr; Attacker,Weapon,Target: GearPtr; AtOp: Integer ); +{$IFDEF PATCH_GH} +Procedure EffectFrontEnd( GB: GameBoardPtr; Attacker,Target: GearPtr; FX_String,FX_Desc: String ); +{$ELSE PATCH_GH} Procedure EffectFrontEnd( GB: GameBoardPtr; Target: GearPtr; FX_String,FX_Desc: String ); +{$ENDIF PATCH_GH} Procedure StatusEffectCheck( GB: GameBoardPtr ); @@ -40,13 +48,17 @@ Procedure QuickTime( GB: GameBoardPtr; T implementation +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + ability,damage,effects,gearutil,ghchars,ghweapon,rpgdice,texutil, {$IFDEF SDLMODE} -uses ability,damage,effects,gearutil,ghchars,ghweapon,rpgdice,texutil, - sdlinfo,sdlmap,sdlgfx; + sdlinfo,sdlmap,sdlgfx {$ELSE} -uses ability,damage,effects,gearutil,ghchars,ghweapon,rpgdice,texutil, - coninfo,conmap,context; + coninfo,conmap,context {$ENDIF} + ; Function DisplayAnnouncements( N: Integer ): Boolean; { Display all the announcements stored for sequence slice N. } @@ -98,6 +110,11 @@ Procedure AttackerFrontEnd( GB: GameBoar var EMek: GearPtr; { Enemy Meks } begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit; + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { In SDL mode, do an update of the map before doing the attack, so that } { every model will appear in its correct position. } {$IFDEF SDLMODE} @@ -110,9 +127,15 @@ begin { how long this comment remains in the code... :) } EMek := GB^.Meks; while EMek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < EMek^.G) then begin +{$ENDIF PATCH_GH} if AreEnemies( GB , EMek , Attacker ) and not MekCanSeeTarget( GB , EMek , Attacker ) then begin RevealMek( GB , Attacker , EMek ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} EMek := Emek^.Next; end; @@ -133,6 +156,12 @@ Procedure AttackerFrontEnd( GB: GameBoar var EMek: GearPtr; { Enemy Meks } begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit; + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit; + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + DisplayGearInfo( Target , gb ); { In SDL mode, do an update of the map before doing the attack, so that } @@ -147,9 +176,15 @@ begin { how long this comment remains in the code... :) } EMek := GB^.Meks; while EMek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < EMek^.G) then begin +{$ENDIF PATCH_GH} if AreEnemies( GB , EMek , Attacker ) and not MekCanSeeTarget( GB , EMek , Attacker ) then begin RevealMek( GB , Attacker , EMek ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} EMek := Emek^.Next; end; @@ -164,11 +199,23 @@ begin DisplayMap( GB ); end; +{$IFDEF PATCH_GH} +Procedure EffectFrontEnd( GB: GameBoardPtr; Attacker,Target: GearPtr; FX_String,FX_Desc: String ); +{$ELSE PATCH_GH} Procedure EffectFrontEnd( GB: GameBoardPtr; Target: GearPtr; FX_String,FX_Desc: String ); +{$ENDIF PATCH_GH} { An effect string has just been triggered. Call the effect handler, } { then display the outcome for the user. } begin +{$IFDEF PATCH_GH} + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + HandleEffectString( GB , Attacker , Target , FX_String , FX_Desc ); +{$ELSE PATCH_GH} HandleEffectString( GB , Target , FX_String , FX_Desc ); +{$ENDIF PATCH_GH} Display_Effect_History( GB ); end; @@ -210,7 +257,11 @@ begin FX2 := FX^.Next; if ( FX^.G = NAG_StatusEffect ) then begin if SX_Effect_String[ FX^.S ] <> '' then begin +{$IFDEF PATCH_GH} + EffectFrontEnd( GB , M , M , SX_Effect_String[ FX^.S ] , MSgString( 'Status_FXDesc' + BStr( FX^.S ) ) ); +{$ELSE PATCH_GH} EffectFrontEnd( GB , M , SX_Effect_String[ FX^.S ] , MSgString( 'Status_FXDesc' + BStr( FX^.S ) ) ); +{$ENDIF PATCH_GH} end; if ( FX^.V > 0 ) and ( SX_ResistTarget[ FX^.S ] = -1 ) then begin @@ -248,6 +299,10 @@ var N: Integer; { Number of implants. } D: Integer; { Disfunction # } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { To start with, add up all the trauma points the PC has. } TT := 0; N := 0; @@ -316,7 +371,10 @@ var PCTeam,CanRegen: Boolean; begin while MList <> Nil do begin - PCTeam := ( NAttValue( MList^.NA , NAG_Location , NAS_Team ) = 1 ) and ( MList^.G = GG_Character ); +{$IFDEF PATCH_GH} + if (GG_DisposeGear < MList^.G) then begin +{$ENDIF PATCH_GH} + PCTeam := ( NAttValue( MList^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and ( MList^.G = GG_Character ); if PCTeam then Morale := NAttValue( MList^.NA , NAG_Condition , NAS_MoraleDamage ); CanRegen := NAttValue( MList^.NA , NAG_StatusEffect , NAS_Anemia ) = 0; @@ -412,6 +470,9 @@ begin RegenerationCheck( MList^.InvCom ); RegenerationCheck( MList^.SubCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} { Move to the next sibling. } MList := MList^.Next; end; @@ -424,10 +485,16 @@ var begin M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} { Decrease OVERLOAD by 1 every 10 seconds } if ( M^.G = GG_Mecha ) and ( NAttValue( M^.NA , NAG_Condition , NAS_Overload ) > 0 ) then begin AddNAtt( M^.NA , NAG_Condition , NAS_Overload , -1 ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end; @@ -469,4 +536,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arenacfe.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arenacfe.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/arenahq.pp branches/arenahq.pp --- GearHead1100repository.original/arenahq.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/arenahq.pp 2015-06-13 09:02:00.000000000 +0900 @@ -35,15 +35,93 @@ Procedure DesignDirBrowser; implementation +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, + version, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + gears_base, + gears, + ui4gh, + ability,arenaplay,damage,gearutil,ghchars,ghparser, + locale,navigate,pcaction,randchar,randmaps,texutil,wmonster, + {$IFDEF PATCH_CHEAT} + menugear, + {$ENDIF PATCH_CHEAT} + {$IFDEF SDLMODE} + sdlinfo,sdlgfx,sdlmap,sdlmenus + {$ELSE SDLMODE} + coninfo,congfx,conmap,conmenus,context + {$ENDIF SDLMODE} +{$ELSE PATCH_GH} + ability,arenaplay,damage,gears,gearutil,ghchars,ghparser, + locale,navigate,pcaction,randchar,randmaps,texutil,wmonster, + {$IFDEF PATCH_CHEAT} + menugear, + {$ENDIF PATCH_CHEAT} + {$IFDEF SDLMODE} + sdlinfo,sdlgfx,sdlmap,sdlmenus, + {$ELSE} + coninfo,congfx,conmap,conmenus,context, + {$ENDIF} + ui4gh +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + ,backpack,ghweapon +{$ENDIF PATCH_CHEAT} + ; + + {$IFDEF SDLMODE} -uses ability,arenaplay,damage,gears,gearutil,ghchars,ghparser, - locale,navigate,pcaction,randchar,randmaps,texutil,wmonster, - sdlinfo,sdlgfx,sdlmap,sdlmenus,ui4gh; -{$ELSE} -uses ability,arenaplay,damage,gears,gearutil,ghchars,ghparser, - locale,navigate,pcaction,randchar,randmaps,texutil,wmonster, - coninfo,congfx,conmap,conmenus,context,ui4gh; -{$ENDIF} + {$IFDEF PATCH_GH} +var + InfoGear: GearPtr; { Gear to appear in the INFO menu. } + InfoMekMenu: RPGMenuPtr; + + +Procedure FHQRedraw; +var + Mek: GearPtr; + MekNum: LongInt; +begin + Mek := NIL; + if (NIL <> InfoMekMenu) then begin + MekNum := RPMLocateByPosition(InfoMekMenu,InfoMekMenu^.selectitem)^.value; + if (0 <= MekNum) then begin + Mek := RetrieveGearSib( InfoGear, MekNum ); + end; + end else if (NIL <> InfoGear) then begin + Mek := InfoGear; + end; + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + DisplayGearInfo( Mek ); + end; +end; + {$ENDIF PATCH_GH} +{$ENDIF SDLMODE} + + +{$IFDEF PATCH_CHEAT} +Procedure DetachMekChar( U: GearPtr; var MList: GearPtr ); +var + Mek: GearPtr; +begin + while NIL <> MList do begin + Mek := MList; + DelinkGear( MList, Mek ); + if Mek^.G = GG_Character then begin + InsertSubCom( U, Mek ); + end else begin + InsertInvCom( U, Mek ); + end; + end; +end; +{$ENDIF PATCH_CHEAT} + Procedure SaveUnit( U: GearPtr ); { Save this unit to disk, in the "SaveGame" directory. } @@ -51,7 +129,19 @@ var FName: String; { Filename for the character. } F: Text; { The file to write to. } begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + { Output DEBUG info. } + SetSAtt( U^.SA , Version_Running_TAG + ' <' + Version_all + '>' ); +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_I18N} + FName := Save_Unit_Base + TextEncode(GearName(U) + Default_File_Ending); +{$ELSE PATCH_I18N} FName := Save_Unit_Base + GearName(U) + Default_File_Ending; +{$ENDIF PATCH_I18N} Assign( F , FName ); Rewrite( F ); WriteCGears( F , U ); @@ -66,6 +156,11 @@ var pc,mpc: GearPtr; name: String; begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit(NIL); + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + { Begin by finding the pilot's name. } name := SAttValue( Mek^.SA , 'pilot' ); @@ -100,16 +195,34 @@ var begin RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_HQPilots ); +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit(RPM); +{$ENDIF PATCH_GH} + { Add an entry for each pilot. } P := U^.SubCom; N := 1; while P <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < P^.G) then begin +{$ENDIF PATCH_GH} msg := GearName( P ); if FindPilotsMecha( U^.InvCom , P ) <> Nil then msg := msg + ' +'; AddRPGMenuItem( RPM , msg , N ); Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} P := P^.Next; end; +{$IFDEF PATCH_CHEAT} + if Cheat_MenuOrder_Edit then begin + AddRPGMenuKey( RPM, KeyMap[ KMC_EditMenuOrder ].KCode, -128 ); + end; + if Cheat_ArenaMode_PilotsMenu_AddMenuKey then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} { Return the finished menu. } CreateHQPilotMenu := RPM; @@ -126,21 +239,45 @@ var begin RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_HQMecha ); +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit(RPM); +{$ENDIF PATCH_GH} + { Add an entry for each mek. } P := U^.InvCom; N := 1; while P <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < P^.G) then begin +{$ENDIF PATCH_GH} { Only add mechas to the menu - not items or salvage. } if P^.G = GG_Mecha then begin msg := GearName( P ); Pilot := FindMechasPilot( U , P ); if Pilot <> Nil then msg := msg + ' (' + GearName( Pilot ) + ')'; AddRPGMenuItem( RPM , msg , N ); +{$IFDEF DEBUG} + end else begin + msg := 'JUNK: ' + GearName( P ); + AddRPGMenuItem( RPM, msg, -1 ); +{$ENDIF DEBUG} end; Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} P := P^.Next; end; +{$IFDEF PATCH_CHEAT} + if Cheat_MenuOrder_Edit then begin + AddRPGMenuKey( RPM, KeyMap[ KMC_EditMenuOrder ].KCode, -128 ); + end; + if Cheat_ArenaMode_MechaMenu_AddMenuKey then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} + { Return the finished menu. } CreateHQMechaMenu := RPM; end; @@ -171,8 +308,20 @@ begin { Display how many credits the unit has. } ClrZone( ZONE_Clock ); CMessage( '$' + BStr( NAttValue( U^.NA , NAG_Experience , NAS_Credits ) ) , ZONE_Clock , PlayerBlue ); + +{$IFDEF PATCH_GH} + ClrZone( ZONE_Menu ); +{$ENDIF PATCH_GH} end; +{$IFDEF PATCH_GH} +Procedure RedrawHQDisplay( U: GearPtr ); +begin + SetupHQDisplay; + UpdateHQDisplay( U ); +end; +{$ENDIF PATCH_GH} + procedure PurchaseGear( U,Part: GearPtr ); { The unit may or may not want to buy PART. } { Show the price of this gear, and ask whether or not the } @@ -181,6 +330,11 @@ var YNMenu: RPGMenuPtr; Cost, ShopRk: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit; + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + Cost := GearValue( Part ); ShopRk := SkillValue( U , 21 ); @@ -190,13 +344,22 @@ begin ShopRk := ( ShopRk - 10 ) * 2; if ShopRk > 40 then ShopRk := 40; +{$IFDEF PATCH_GH} + Cost := ( Int64(Cost) * Int64(100 - ShopRk) ) div 100; +{$ELSE PATCH_GH} Cost := ( Cost * (100 - ShopRk ) ) div 100; +{$ENDIF PATCH_GH} end; if Cost < 1 then Cost := 1; YNMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( YNMenu , ReplaceHash(I18N_MsgString('PURCHASEGEAR_BUY'), GearName(Part), BStr(Cost) ) , 1 ); + AddRPGMenuItem( YNMenu , I18N_MsgString('PurchaseGear','Search Again') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( YNMenu , 'Buy ' + GearName( Part ) + ' ($' + BStr( Cost ) + ')' , 1 ); AddRPGMenuItem( YNMenu , 'Search Again' , -1 ); +{$ENDIF PATCH_I18N} CMessage( 'COST: ' + BStr( Cost ) , ZONE_Menu1 , InfoHilight ); {$IFDEF SDLMODE} @@ -215,10 +378,18 @@ begin { Update the display. } UpdateHQDisplay( U ); +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash(I18N_MsgString('PurchaseGear','Purchased'),GearName(Part)) ); +{$ELSE PATCH_I18N} DialogMSG( 'You have purchased ' + GearName( Part ) + '.' ); +{$ENDIF PATCH_I18N} end else begin { Not enough cash to buy... } +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash(I18N_MsgString('PurchaseGear','Donot Purchased'),GearName(Part)) ); +{$ELSE PATCH_I18N} DialogMSG( 'You don''t have enough money to buy ' + GearName( Part ) + '.' ); +{$ENDIF PATCH_I18N} end; end; @@ -234,7 +405,16 @@ var YNMenu: RPGMenuPtr; Cost, ShopRk: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit; + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + Cost := ( Int64(GearValue(Part)) * Int64(PercentDamaged(Part)) ) div 100; +{$ELSE PATCH_GH} Cost := ( GearValue( Part ) * PercentDamaged( Part ) ) div 100; +{$ENDIF PATCH_GH} if Destroyed( Part ) then Cost := Cost div 3; ShopRk := SkillValue( U , 21 ); @@ -243,13 +423,22 @@ begin { gives a 1% bonus to the money gained. } if ShopRk > 40 then ShopRk := 40; +{$IFDEF PATCH_GH} + Cost := ( Int64(Cost) * Int64(20 + ShopRk) ) div 100; +{$ELSE PATCH_GH} Cost := ( Cost * (20 + ShopRk ) ) div 100; +{$ENDIF PATCH_GH} end; if Cost < 1 then Cost := 1; YNMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( YNMenu , ReplaceHash(I18N_MsgString('SellGear','Sell'),GearName(Part),BStr(Cost)) , 1 ); + AddRPGMenuItem( YNMenu , I18N_MsgString('PurchaseGear','Search Again') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( YNMenu , 'Sell ' + GearName( Part ) + ' ($' + BStr( Cost ) + ')' , 1 ); AddRPGMenuItem( YNMenu , 'Search Again' , -1 ); +{$ENDIF PATCH_I18N} CMessage( 'VALUE: ' + BStr( Cost ) , ZONE_Menu1 , InfoHilight ); {$IFDEF SDLMODE} @@ -263,7 +452,11 @@ begin { Update the display. } UpdateHQDisplay( U ); +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash(I18N_MsgString('SellGear','Sold'),GearName(Part),BStr(Cost)) ); +{$ELSE PATCH_I18N} DialogMSG( 'You have sold ' + GearName( Part ) + ' for $' + BStr( Cost ) + '.' ); +{$ENDIF PATCH_I18N} RemoveGear( Part^.Parent^.InvCom , Part ); end; @@ -278,6 +471,11 @@ var SPart: GearPtr; Roll,LowRoll: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit(32766); + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(32766); +{$ENDIF PATCH_GH} + LowRoll := PitFix( Part , U ); SPart := Part^.SubCom; @@ -304,33 +502,57 @@ var C0,C1: LongInt; { Cash at start. } R,LowRoll: Integer; { The worst repair result generated. } begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + C0 := NAttValue( U^.NA , NAG_Experience , NAS_Credits ); LowRoll := 10; { Administer medical treatment to all characters. } Part := U^.SubCom; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} R := RecurseFix( U , Part ); if R < LowRoll then LowRoll := R; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; { Administer repair to all assigned mecha. } Part := U^.InvCom; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G = GG_Mecha ) and ( FindMechasPilot( U , Part ) <> Nil ) then begin R := RecurseFix( U , Part ); if R < LowRoll then LowRoll := R; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; C1 := NAttValue( U^.NA , NAG_Experience , NAS_Credits ); if C1 < C0 then begin +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash(I18N_MsgString('FixEntireUnit','Recovery'),BStr( C0 - C1 )) ); +{$ELSE PATCH_I18N} DialogMSG( 'Recovery from the combat cost $' + BStr( C0 - C1 ) + '.' ); +{$ENDIF PATCH_I18N} end; if LowRoll < 1 then begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('FixEntireUnit','Some Problems') ); +{$ELSE PATCH_I18N} DialogMSG( 'There have been some problems...' ); +{$ENDIF PATCH_I18N} end; end; @@ -340,6 +562,11 @@ var C0,C1: LongInt; { Cash at start. } Roll: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit; + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + C0 := NAttValue( U^.NA , NAG_Experience , NAS_Credits ); Roll := RecurseFix( U , Mek ); @@ -348,10 +575,18 @@ begin C1 := NAttValue( U^.NA , NAG_Experience , NAS_Credits ); if C1 < C0 then begin +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash(I18N_MsgString('FixSingleGear','Restoring'),GearName(Mek),BStr( C0 - C1 )) ); +{$ELSE PATCH_I18N} DialogMSG( 'Restoring ' + GearName( Mek ) + ' cost $' + BStr( C0 - C1 ) + '.' ); +{$ENDIF PATCH_I18N} end; if Roll < 1 then begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('FixSingleGear','Some Problems') ); +{$ELSE PATCH_I18N} DialogMSG( 'There have been some problems...' ); +{$ENDIF PATCH_I18N} end; end; @@ -366,13 +601,24 @@ var F: Text; FName: String; begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Create the YNMenu here. It'll be the same throughout the } { hiring process. } YNMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( YNMenu , I18N_MsgString('AddPilotToUnit','Hire Character') , 1 ); + AddRPGMenuItem( YNMenu , I18N_MsgString('AddPilotToUnit','Search Again') , -1 ); + + DialogMSG( I18N_MsgString('AddPilotToUnit','Select Character')); +{$ELSE PATCH_I18N} AddRPGMenuItem( YNMenu , 'Hire Character' , 1 ); AddRPGMenuItem( YNMenu , 'Search Again' , -1 ); DialogMSG('Select character file.'); +{$ENDIF PATCH_I18N} { Keep querying for characters until cancel is selected. } repeat @@ -380,7 +626,11 @@ begin PCMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); BuildFileMenu( PCMenu , Save_Character_Base + Default_Search_Pattern ); RPMSortAlpha( PCMenu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( PCMenu , I18N_MsgString('AddPilotToUnit','Exit') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( PCMenu , ' Exit' , -1 ); +{$ENDIF PATCH_I18N} { Select a file, then dispose of the menu. } { Don't need to worry about the menu being empty because } @@ -396,14 +646,23 @@ begin { wants to keep it. } if FName <> '' then begin { Load the character file. } +{$IFDEF PATCH_I18N} + Assign( F , Save_Game_Directory + TextEncode(FName) ); +{$ELSE PATCH_I18N} Assign( F , Save_Game_Directory + FName ); +{$ENDIF PATCH_I18N} reset(F); PC := ReadCGears(F); Close(F); { ERROR CHECK - make sure the file that was loaded } { is in fact a valid, singular character. } +{$IFDEF PATCH_GH} + if (NIL <> PC) and (GG_DisposeGear < PC^.G) then begin +{$ELSE PATCH_GH} if ( PC <> Nil ) then begin +{$ENDIF PATCH_GH} + { Display the character's stats. } DisplayGearInfo( PC ); @@ -430,7 +689,11 @@ begin { problem in saving, at least the original } { character file will be intact. } SaveUnit( U ); +{$IFDEF PATCH_I18N} + Assign( F , Save_Game_Directory + TextEncode(FName) ); +{$ELSE PATCH_I18N} Assign( F , Save_Game_Directory + FName ); +{$ENDIF PATCH_I18N} Erase(F); UpdateHQDisplay( U ); @@ -442,7 +705,11 @@ begin end else begin { PC isn't a valid character. Get rid of it. } +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('AddPilotToUnit','Corrupt File') ); +{$ELSE PATCH_I18N} DialogMSG( 'ERROR - Corrupt save file.' ); +{$ENDIF PATCH_I18N} DisposeGear( PC ); end; end; @@ -457,9 +724,17 @@ Function SelectOneGear( List: GearPtr ): var BrowseMenu: RPGMenuPtr; Part: GearPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} msg: String; begin +{$IFDEF PATCH_GH} + ClrZone( ZONE_Menu ); +{$ENDIF PATCH_GH} + { Create the menu. } BrowseMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); @@ -467,15 +742,25 @@ begin Part := List; N := 1; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} msg := SAttValue( Part^.SA , 'desig' ); if msg <> '' then msg := msg + ' ' + GearName( Part ) else msg := GearName( Part ); AddRPGMenuItem( BrowseMenu , msg , N ); Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; RPMSortAlpha( BrowseMenu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( BrowseMenu , I18N_MsgString('SelectOneGear','Cancel') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( BrowseMenu , ' Cancel' , -1 ); +{$ENDIF PATCH_I18N} { Select a gear. } {$IFDEF SDLMODE} @@ -498,15 +783,30 @@ var { and the mek being considered for purchase. } F: Text; begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Create the mecha menu. } MekMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); BuildFileMenu( MekMenu , Design_Directory + Default_Search_Pattern ); RPMSortAlpha( MekMenu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( MekMenu , I18N_MsgString('BuyMechsForUnit','Exit') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( MekMenu , ' Exit' , -1 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('BuyMechsForUnit','Select Design') ); +{$ELSE PATCH_I18N} DialogMSG( 'Select design file.' ); +{$ENDIF PATCH_I18N} repeat +{$IFDEF PATCH_GH} + ClrZone( ZONE_Menu ); +{$ENDIF PATCH_GH} { Prompt the user for a file selection. } {$IFDEF SDLMODE} fname := SelectFile( MekMenu , Nil ); @@ -519,11 +819,20 @@ begin { to select any of the gears it contains. } Assign(F, Design_Directory + fname ); reset(F); +{$IFDEF PATCH_GH} + m1 := ReadGear(F, Design_Directory + fname); +{$ELSE PATCH_GH} m1 := ReadGear(F); +{$ENDIF PATCH_GH} Close(F); { Error check- make sure something was actually loaded. } +{$IFDEF PATCH_GH} + if (NIL <> m1) and (GG_DisposeGear < m1^.G) then begin +{$ELSE PATCH_GH} if ( m1 <> Nil ) then begin +{$ENDIF PATCH_GH} + { If there were multiple designs in this file, } { allow the player to browse through them. } { If there was only one design, leap straight to it. } @@ -531,7 +840,15 @@ begin else Mek := SelectOneGear( M1 ); { Check to make sure that Mek isn't Nil. } +{$IFDEF PATCH_GH} + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin +{$ELSE PATCH_GH} if Mek <> Nil then begin +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + ClrZone( ZONE_Menu ); +{$ENDIF PATCH_GH} DisplayGearInfo( Mek ); PurchaseGear( U , Mek ); @@ -542,7 +859,11 @@ begin DisposeGear( m1 ); end else begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('BuyMechsForUnit','Corrupt File') ); +{$ELSE PATCH_I18N} DialogMsg( 'ERROR - Corrupt design file.' ); +{$ENDIF PATCH_I18N} end; end; until fname = ''; @@ -560,14 +881,37 @@ procedure ExamineUnitMecha( U: GearPtr ) { Select a pilot for this mecha, then associate the two. } var PMenu: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + CMessage( I18N_MsgString('ExamineUnitMecha','SELECT CHARACTER'), ZONE_Menu1, InfoHilight ); + DialogMSG( ReplaceHash(I18N_MsgString('ExamineUnitMecha','Select a Pilot'),GearName(M)) ); +{$ELSE PATCH_I18N} CMessage( 'SELECT CHARACTER' , ZONE_Menu1 , InfoHilight ); DialogMSG( 'Select a pilot for ' + GearName( M ) + '.' ); +{$ENDIF PATCH_I18N} PMenu := CreateHQPilotMenu( U ); if PMenu^.NumItem > 0 then begin {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + InfoMekMenu := PMenu; + InfoGear := U^.SubCom; + end; + N := SelectMenu( PMenu, @FHQRedraw ); + InfoGear := NIL; + InfoMekMenu := NIL; + {$ELSE PATCH_GH} N := SelectMenu( PMenu , Nil ); + {$ENDIF PATCH_GH} {$ELSE} N := SelectMenu( PMenu ); {$ENDIF} @@ -580,24 +924,93 @@ procedure ExamineUnitMecha( U: GearPtr ) { Update the display. } UpdateHQDisplay( U ); end; + +{$IFDEF PATCH_CHEAT} + Procedure CallRealBackpack( U, PC, Mek: GearPtr ); + var + MList: GearPtr; + begin + MList := U^.InvCom; + LastGear(MList)^.Next := U^.SubCom; + U^.SubCom := NIL; + U^.InvCom := NIL; + RealBackpack( NIL, MList, PC, Mek, False ); + DetachMekChar( U, MList ); + end; + + Procedure CallMechaPartEditor( U, PC, Mek: GearPtr ); + var + MList: GearPtr; + begin + MList := U^.InvCom; + LastGear(MList)^.Next := U^.SubCom; + U^.SubCom := NIL; + U^.InvCom := NIL; + MechaPartEditor( NIL, MList, PC, Mek ); + DetachMekChar( U, MList ); + end; +{$ENDIF PATCH_CHEAT} + var MekMenu,OpMenu: RPGMenuPtr; Mek: GearPtr; +{$IFDEF PATCH_GH} + MN: LongInt; + N: Integer; +{$ELSE PATCH_GH} MN,N: Integer; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + PC: GearPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Create the needed menus. } MekMenu := CreateHQMechaMenu( U ); OpMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); +{$IFDEF PATCH_CHEAT} + if Cheat_ArenaMode_FieldHQInHQ then begin + AddRPGMenuItem( OpMenu, MsgString('FHQ_GoBackpack'), 4 ); + AddRPGMenuItem( OpMenu, MsgString('FHQ_Rename'), 5 ); + AddRPGMenuItem( OpMenu, MsgString('FHQ_PartEditor'), 6 ); + {$IFDEF SDLMODE} + AddRPGMenuItem( OpMenu, MsgString('FHQ_EditColor'), 7 ); + {$ENDIF SDLMODE} + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( OpMenu , I18N_MsgString('ExamineUnitMecha','Assign Pilot') , 1 ); + AddRPGMenuItem( OpMenu , I18N_MsgString('ExamineUnitMecha','Sell') , -2 ); + AddRPGMenuItem( OpMenu , I18N_MsgString('ExamineUnitMecha','Repair') , 3 ); + AddRPGMenuItem( OpMenu , I18N_MsgString('ExamineUnitMecha','Exit') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( OpMenu , 'Assign Pilot' , 1 ); AddRPGMenuItem( OpMenu , 'Sell this Mecha' , -2 ); AddRPGMenuItem( OpMenu , 'Repair Mecha' , 3 ); AddRPGMenuItem( OpMenu , 'Exit' , -1 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_ArenaMode_MechaHQ_AddMenuKey then begin + AlphaKeyMenu( OpMenu ); + end; +{$ENDIF PATCH_CHEAT} { Error check- this unit better have some meks purchased already. } if MekMenu^.NumItem > 0 then begin MN := 1; repeat +{$IFDEF PATCH_GH} + RedrawHQDisplay( U ); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + CMessage( I18N_MsgString('ExamineUnitMecha','SELECT MECHA TO EXAMINE'), ZONE_Menu1, InfoHilight ); +{$ELSE PATCH_I18N} CMessage( 'SELECT MECHA TO EXAMINE' , ZONE_Menu1 , MenuSelect ); +{$ENDIF PATCH_I18N} {$IFNDEF SDLMODE} DrawZoneBorder( ZONE_Menu2 , PlayerBlue ); {$ENDIF} @@ -605,24 +1018,55 @@ begin { MN stands for Mek Number. } SetItemByValue( MekMenu , MN ); {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + InfoMekMenu := MekMenu; + InfoGear := U^.InvCom; + end; + MN := SelectMenu( MekMenu, @FHQRedraw ); + InfoGear := NIL; + InfoMekMenu := NIL; + {$ELSE PATCH_GH} MN := SelectMenu( MekMenu , Nil ); + {$ENDIF PATCH_GH} {$ELSE} MN := SelectMenu( MekMenu ); {$ENDIF} { If a mek was selected, go to the options menu. } +{$IFDEF PATCH_CHEAT} + if -1 < MN then begin +{$ELSE PATCH_CHEAT} if MN <> -1 then begin +{$ENDIF PATCH_CHEAT} { Find out what mek the player selected, } { and display its info. } Mek := RetrieveGearSib( U^.InvCom , MN ); +{$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + InfoGear := Mek; + {$ENDIF PATCH_GH} +{$ENDIF SDLMODE} +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} DisplayGearInfo( Mek ); { Restore the display. } UpdateHQDisplay( U ); +{$ENDIF PATCH_GH} { Bring up the options menu. } +{$IFDEF PATCH_CHEAT} + SetItemByValue( OpMenu, 4 ); +{$ELSE PATCH_CHEAT} SetItemByValue( OpMenu , 1 ); +{$ENDIF PATCH_CHEAT} repeat +{$IFDEF PATCH_GH} + PC := FindMechasPilot( U , Mek ); + RedrawHQDisplay( U ); + DisplayGearInfo( Mek ); +{$ENDIF PATCH_GH} ClrZone( ZONE_Menu1 ); CMessage( GearName( Mek ) , ZONE_Menu1 , InfoHilight ); {$IFDEF SDLMODE} @@ -630,23 +1074,54 @@ begin {$ELSE} N := SelectMenu( OpMenu ); {$ENDIF} +{$IFDEF PATCH_CHEAT} + Case N of + 1: GetPilotForMek( Mek ); + -2: SellGear( U , Mek ); + 3: FixSingleGear( U , Mek ); + 4: CallRealBackpack( U, PC, Mek ); + 5: Rename_Mecha( NIL, Mek ); + 6: CallMechaPartEditor( U, PC, Mek ); + {$IFDEF SDLMODE} + 7: SelectColors( Mek, @FHQRedraw ); + {$ENDIF SDLMODE} + end; +{$ELSE PATCH_CHEAT} if N = 1 then GetPilotForMek( Mek ) else if N = -2 then SellGear( U , Mek ) else if N = 3 then FixSingleGear( U , Mek ); +{$ENDIF PATCH_CHEAT} until N < 0; { Refresh the mecha menu. } DisposeRPGMenu( MekMenu ); MekMenu := CreateHQMechaMenu( U ); +{$IFDEF PATCH_CHEAT} + end else if -128 = MN then begin + Mek := RetrieveGearSib( U^.InvCom, RPMLocateByPosition( MekMenu, MekMenu^.SelectItem )^.value ); + SwapMenu( ZONE_HQMecha, Mek ); + DisposeRPGMenu( MekMenu ); + MekMenu := CreateHQMechaMenu( U ); +{$ENDIF PATCH_CHEAT} end; +{$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + InfoGear := NIL; + {$ENDIF PATCH_GH} +{$ENDIF SDLMODE} + until ( MN = -1 ) or ( MekMenu^.NumItem = 0 ); { Restore the display. } UpdateHQDisplay( U ); end else begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('ExamineUnitMecha','No Meks') ); +{$ELSE PATCH_I18N} DialogMSG( 'Your unit does not currently have any meks.' ); +{$ENDIF PATCH_I18N} end; { Free dynamic resources. } @@ -664,14 +1139,38 @@ procedure ExamineUnitPilots( U: GearPtr { Select a pilot for this mecha, then associate the two. } var MekMenu: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = P) or (P^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + RedrawHQDisplay( U ); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + CMessage( I18N_MsgString('ExamineUnitPilots','SELECT MECHA'), ZONE_Menu1, InfoHilight ); + DialogMSG( ReplaceHash(I18N_MsgString('ExamineUnitPilots','Select a Mecha'),GearName(P)) ); +{$ELSE PATCH_I18N} CMessage( 'SELECT MECHA' , ZONE_Menu1 , InfoHilight ); DialogMSG( 'Select a mecha for ' + GearName( P ) + '.' ); +{$ENDIF PATCH_I18N} MekMenu := CreateHQMechaMenu( U ); if MekMenu^.NumItem > 0 then begin {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + InfoMekMenu := MekMenu; + InfoGear := U^.InvCom; + N := SelectMenu( MekMenu, @FHQRedraw ); + InfoGear := NIL; + InfoMekMenu := NIL; + {$ELSE PATCH_GH} N := SelectMenu( MekMenu , Nil ); + {$ENDIF PATCH_GH} {$ELSE} N := SelectMenu( MekMenu ); {$ENDIF} @@ -688,6 +1187,9 @@ procedure ExamineUnitPilots( U: GearPtr Procedure QuitUnit( PC: GearPtr ); { This character wants to quit. Make it so. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} DelinkGear( U^.SubCom , PC ); SaveChar( PC ); SaveUnit( U ); @@ -700,32 +1202,93 @@ procedure ExamineUnitPilots( U: GearPtr var msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} msg := SAttValue( PC^.SA , 'Bio1' ); +{$IFDEF PATCH_I18N} + CMessage( I18N_MsgString('ExamineUnitPilots','BIOGRAPHY'), ZONE_Menu1, InfoHilight ); +{$ELSE PATCH_I18N} CMessage( 'BIOGRAPHY' , ZONE_Menu1 , InfoHilight ); +{$ENDIF PATCH_I18N} GameMsg( msg , ZONE_Menu2 , InfoGreen ); { Wait for a keypress before exiting. } +{$IFDEF PATCH_GH} + EndOfGameMoreKey; +{$ELSE PATCH_GH} RPGKey; +{$ENDIF PATCH_GH} end; + +{$IFDEF PATCH_CHEAT} + Procedure CallRealBackpack( U, PC: GearPtr ); + var + MList: GearPtr; + begin + MList := U^.SubCom; + LastGear(MList)^.Next := U^.InvCom; + U^.SubCom := NIL; + U^.InvCom := NIL; + RealBackpack( NIL, MList, PC, PC, True ); + DetachMekChar( U, MList ); + end; +{$ENDIF PATCH_CHEAT} + var PCMenu,OpMenu: RPGMenuPtr; PC: GearPtr; +{$IFDEF PATCH_GH} + PN: LongInt; + N: Integer; +{$ELSE PATCH_GH} PN,N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = U) or (U^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Create the needed menus. } PCMenu := CreateHQPilotMenu( U ); OpMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); +{$IFDEF PATCH_I18N} + {$IFDEF PATCH_CHEAT} + if Cheat_ArenaMode_InventoryInHQ then begin + AddRPGMenuItem( OpMenu , I18N_MsgString('GameOptionMenu','Inventory') , 4 ); + end; + {$ENDIF PATCH_CHEAT} + AddRPGMenuItem( OpMenu , I18N_MsgString('ExamineUnitPilots','View Biography') , 3 ); + AddRPGMenuItem( OpMenu , I18N_MsgString('ExamineUnitPilots','Assign') , 1 ); + AddRPGMenuItem( OpMenu , I18N_MsgString('ExamineUnitPilots','Training') , 2 ); + AddRPGMenuItem( OpMenu , I18N_MsgString('ExamineUnitPilots','Quit') , -2 ); + AddRPGMenuItem( OpMenu , I18N_MsgString('ExamineUnitPilots','Exit') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( OpMenu , 'View Biography' , 3 ); AddRPGMenuItem( OpMenu , 'Assign Mecha for Pilot' , 1 ); AddRPGMenuItem( OpMenu , 'Do Training' , 2 ); AddRPGMenuItem( OpMenu , 'Quit This Team' , -2 ); AddRPGMenuItem( OpMenu , 'Exit' , -1 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_ArenaMode_PilotsHQ_AddMenuKey then begin + AlphaKeyMenu( OpMenu ); + end; +{$ENDIF PATCH_CHEAT} { Error check- this unit better have some chars hired already. } if PCMenu^.NumItem > 0 then begin PN := 1; repeat +{$IFDEF PATCH_GH} + RedrawHQDisplay( U ); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + CMessage( I18N_MsgString('ExamineUnitPilots','SELECT CHARACTER TO EXAMINE'), ZONE_Menu1, InfoHilight ); +{$ELSE PATCH_I18N} CMessage( 'SELECT CHARACTER TO EXAMINE' , ZONE_Menu1 , MenuSelect ); +{$ENDIF PATCH_I18N} {$IFNDEF SDLMODE} DrawZoneBorder( ZONE_Menu2 , PlayerBlue ); {$ENDIF} @@ -733,13 +1296,27 @@ begin { PN stands for PC Number. } SetItemByValue( PCMenu , PN ); {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + InfoMekMenu := PCMenu; + InfoGear := U^.SubCom; + end; + PN := SelectMenu( PCMenu, @FHQRedraw ); + InfoGear := NIL; + InfoMekMenu := NIL; + {$ELSE PATCH_GH} PN := SelectMenu( PCMenu , Nil ); + {$ENDIF PATCH_GH} {$ELSE} PN := SelectMenu( PCMenu ); {$ENDIF} { If a char was selected, go to the options menu. } +{$IFDEF PATCH_CHEAT} + if -1 < PN then begin +{$ELSE PATCH_CHEAT} if PN <> -1 then begin +{$ENDIF PATCH_CHEAT} { Find out what PC the player selected, } { and display its info. } PC := RetrieveGearSib( U^.SubCom , PN ); @@ -750,9 +1327,17 @@ begin ClrZone( ZONE_Menu1 ); { Bring up the options menu. } +{$IFDEF PATCH_CHEAT} + SetItemByValue( OpMenu , 4 ); +{$ELSE PATCH_CHEAT} SetItemByValue( OpMenu , 3 ); +{$ENDIF PATCH_CHEAT} repeat CMessage( GearName( PC ) , ZONE_Menu1 , InfoHilight ); +{$IFDEF PATCH_GH} + DisplayGearInfo( PC , NIL ); + CharacterDisplay( PC , NIL ); +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} N := SelectMenu( OpMenu , Nil ); {$ELSE} @@ -763,6 +1348,9 @@ begin 1: GetMekForPilot( PC ); 2: DoTraining( Nil , PC ); 3: ViewBiography( PC ); +{$IFDEF PATCH_CHEAT} + 4: CallRealBackpack( U, PC ); +{$ENDIF PATCH_CHEAT} end; until N < 0; @@ -770,6 +1358,13 @@ begin DisposeRPGMenu( PCMenu ); PCMenu := CreateHQPilotMenu( U ); +{$IFDEF PATCH_CHEAT} + end else if -128 = PN then begin + PC := RetrieveGearSib( U^.SubCom, RPMLocateByPosition( PCMenu, PCMenu^.SelectItem )^.value ); + SwapMenu( ZONE_HQPilots, PC ); + DisposeRPGMenu( PCMenu ); + PCMenu := CreateHQPilotMenu( U ); +{$ENDIF PATCH_CHEAT} end; until ( PN = -1 ) or ( PCMenu^.NumItem = 0 ); @@ -777,7 +1372,11 @@ begin { Restore the display. } UpdateHQDisplay( U ); end else begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('ExamineUnitPilots','No Characters') ); +{$ELSE PATCH_I18N} DialogMSG( 'Your unit does not currently have any characters.' ); +{$ENDIF PATCH_I18N} end; { Free dynamic resources. } @@ -798,6 +1397,11 @@ procedure EnterCombat( HQCamp: CampaignP { Insert surviving PCs and salvage into the unit. } { Deallocate NPCs and wasted meks. } { Save the game. } +{$IFDEF PATCH_GH} +const + TPV_MAX = 2147483647; + TPV_MIN = -2147483648; +{$ENDIF PATCH_GH} var ECM: RPGMenuPtr; { Enter Combat Menu } Diff: Integer; { Difficulcy Level } @@ -805,19 +1409,35 @@ var Mek: GearPtr; { Mecha Pointer of Many Uses } Pilot: GearPtr; MList: GearPtr; { The list of meks which will take part } +{$IFDEF PATCH_GH} + N: LongInt; { A menu input code } +{$ELSE PATCH_GH} N: Integer; { A menu input code } +{$ENDIF PATCH_GH} msg: String; +{$IFDEF PATCH_GH} + TPV: Int64; +{$ELSE PATCH_GH} TPV: LongInt; +{$ENDIF PATCH_GH} SA: SAttPtr; XPV: Integer; begin { Create the difficulcy selector menu. } ECM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); +{$IFDEF PATCH_I18N} + CMessage( I18N_MsgString('EnterCombat','SELECT DIFFICULCY LEVEL'), ZONE_Menu1, InfoHilight ); + AddRPGMenuItem( ECM , I18N_MsgString('EnterCombat','Easy') , 1 ); + AddRPGMenuItem( ECM , I18N_MsgString('EnterCombat','Regular') , 3 ); + AddRPGMenuItem( ECM , I18N_MsgString('EnterCombat','Hard') , 6 ); + AddRPGMenuItem( ECM , I18N_MsgString('EnterCombat','Suicidal') , 10 ); +{$ELSE PATCH_I18N} CMessage( 'SELECT DIFFICULCY LEVEL' , ZONE_Menu1 , InfoGreen ); AddRPGMenuItem( ECM , 'Easy' , 1 ); AddRPGMenuItem( ECM , 'Regular' , 3 ); AddRPGMenuItem( ECM , 'Hard' , 6 ); AddRPGMenuItem( ECM , 'Suicidal' , 10 ); +{$ENDIF PATCH_I18N} { Input the difficulcy level, and dispose of the menu right away. } {$IFDEF SDLMODE} @@ -832,7 +1452,11 @@ begin if Diff = -1 then exit; { Select the list of mechas to use on this mission. } +{$IFDEF PATCH_I18N} + CMessage( I18N_MsgString('EnterCombat','SELECT MECHA'), ZONE_Menu1, InfoHilight ); +{$ELSE PATCH_I18N} CMessage( 'SELECT MECHA' , ZONE_Menu1 , InfoGreen ); +{$ENDIF PATCH_I18N} MList := Nil; repeat { Create the mecha menu. This has to be re-created with } @@ -842,12 +1466,23 @@ begin Mek := HQCamp^.Source^.InvCom; N := 1; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin + if ( Mek^.G = GG_Mecha ) and ( FindMechasPilot( HQCamp^.Source , Mek ) <> Nil ) then begin + msg := GearName( Mek ) + ' (' + GearName( FindMechasPilot( HQCamp^.Source , Mek ) ) + ')'; + AddRPGMenuItem( ECM , msg , N ); + end; + Inc( N ); + end; + Mek := Mek^.Next; +{$ELSE PATCH_GH} if ( Mek^.G = GG_Mecha ) and ( FindMechasPilot( HQCamp^.Source , Mek ) <> Nil ) then begin msg := GearName( Mek ) + ' (' + GearName( FindMechasPilot( HQCamp^.Source , Mek ) ) + ')'; AddRPGMenuItem( ECM , msg , N ); end; Mek := Mek^.Next; Inc( N ); +{$ENDIF PATCH_GH} end; { Get input from the menu, if there are any mechas left. } @@ -887,6 +1522,13 @@ begin DelinkGear( HQCamp^.Source^.SubCom , Pilot ); DeployMek( HQCamp^.GB , Mek , Pilot , NAV_DefPlayerTeam ); end; +{$IFDEF PATCH_GH} + if TPV < TPV_MIN then begin + TPV := TPV_MIN; + end else if TPV_MAX < TPV then begin + TPV := TPV_MAX; + end; +{$ENDIF PATCH_GH} { Add a number of random enemies to the scenario. } { Generate a shopping list of mecha found in the Design/ drawer. } @@ -899,6 +1541,13 @@ begin { selected (Diff). Yes, I'm reassigning TPV to now represent the enemy } { point value... bad programming style. } TPV := ( TPV * Diff ) div 2; +{$IFDEF PATCH_GH} + if TPV < TPV_MIN then begin + TPV := TPV_MIN; + end else if TPV_MAX < TPV then begin + TPV := TPV_MAX; + end; +{$ENDIF PATCH_GH} { Call the SelectEnemyForces procedure from ArenaPlay. This will } { choose mecha designs from the list generated & give pilots to them. } @@ -940,6 +1589,12 @@ begin StripNAtt( Pilot , -3 ); StripNAtt( Pilot , -5 ); StripNAtt( Pilot , NAG_EpisodeData ); +{$IFDEF PATCH_CHEAT} + if Cheat_ArenaMode_AllRecoveryInHQ then begin + StripNAtt( Pilot, NAG_StatusEffect ); + StripNAtt( Pilot, NAG_Condition ); + end; +{$ENDIF PATCH_CHEAT} InsertSubCom( HQCamp^.Source , Pilot ); { Give XP for successful mission. } @@ -968,6 +1623,12 @@ begin StripNAtt( Mek , -3 ); StripNAtt( Mek , -5 ); StripNAtt( Mek , NAG_EpisodeData ); +{$IFDEF PATCH_CHEAT} + if Cheat_ArenaMode_AllRecoveryInHQ then begin + StripNAtt( Mek, NAG_StatusEffect ); + StripNAtt( Mek, NAG_Condition ); + end; +{$ENDIF PATCH_CHEAT} InsertInvCom( HQCamp^.Source , Mek ); end else begin @@ -992,6 +1653,12 @@ begin StripNAtt( Mek , -3 ); StripNAtt( Mek , -5 ); StripNAtt( Mek , NAG_EpisodeData ); +{$IFDEF PATCH_CHEAT} + if Cheat_ArenaMode_AllRecoveryInHQ then begin + StripNAtt( Mek, NAG_StatusEffect ); + StripNAtt( Mek, NAG_Condition ); + end; +{$ENDIF PATCH_CHEAT} InsertInvCom( HQCamp^.Source , Mek ); end else DisposeGear( Mek ); @@ -1005,6 +1672,12 @@ begin StripNAtt( Mek , -3 ); StripNAtt( Mek , -5 ); StripNAtt( Mek , NAG_EpisodeData ); +{$IFDEF PATCH_CHEAT} + if Cheat_ArenaMode_AllRecoveryInHQ then begin + StripNAtt( Mek, NAG_StatusEffect ); + StripNAtt( Mek, NAG_Condition ); + end; +{$ENDIF PATCH_CHEAT} InsertSubCom( HQCamp^.Source , Mek ); { Give experience, which is reduced if the pilot had to eject. } @@ -1031,7 +1704,11 @@ begin { Repair all meks and treat all wounded pilots. } SetupHQDisplay; +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash(I18N_MsgString('ExamineUnitPilots','Earned'),BStr(TPV)) ); +{$ELSE PATCH_I18N} DialogMSG( 'You earned $' + BStr(TPV) + ' for this mission.' ); +{$ENDIF PATCH_I18N} FixEntireUnit( HQCamp^.Source ); end; @@ -1044,13 +1721,38 @@ var begin { Create the HQ Menu } RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('HQMain','Examine Characters') , 5 ); + AddRPGMenuItem( RPM , I18N_MsgString('HQMain','Examine Mecha') , 1 ); + AddRPGMenuItem( RPM , I18N_MsgString('HQMain','Purchase Hardware') , 2 ); + AddRPGMenuItem( RPM , I18N_MsgString('HQMain','Hire Character') , 3 ); + AddRPGMenuItem( RPM , I18N_MsgString('HQMain','Create New Character') , 4 ); + AddRPGMenuItem( RPM , I18N_MsgString('HQMain','Enter Combat') , 6 ); + {$IFDEF PATCH_GH} + AddRPGMenuItem( RPM , I18N_MsgString('HQMain','Display Log') , 7 ); + {$ENDIF PATCH_GH} + AddRPGMenuItem( RPM , I18N_MsgString('HQMain','Exit') , 0 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Examine Characters' , 5 ); AddRPGMenuItem( RPM , 'Examine Mecha' , 1 ); AddRPGMenuItem( RPM , 'Purchase Hardware' , 2 ); AddRPGMenuItem( RPM , 'Hire Character' , 3 ); AddRPGMenuItem( RPM , 'Create New Character' , 4 ); AddRPGMenuItem( RPM , 'Enter Combat' , 6 ); + {$IFDEF PATCH_GH} + AddRPGMenuItem( RPM , 'Display Log' , 7 ); + {$ENDIF PATCH_GH} AddRPGMenuItem( RPM , 'Exit to Main' , 0 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + AddRPGMenuKey( RPM, KeyMap[ KMC_History ].KCode, 7 ); + AddRPGMenuKey( RPM, KeyMap[ KMC_QuitGame ].KCode, 0 ); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + if Cheat_ArenaMode_MainMenu_AddMenuKey then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} RPM^.mode := RPMNoCancel; { Set up the display. } @@ -1064,6 +1766,9 @@ begin {$ELSE} N := SelectMenu( RPM ); {$ENDIF} +{$IFDEF PATCH_GH} + UpdateHQDisplay( HQCamp^.Source ); +{$ENDIF PATCH_GH} case N of 5: ExamineUnitPilots( HQCamp^.Source ); @@ -1072,8 +1777,14 @@ begin 3: AddPilotToUnit( HQCamp^.Source ); 4: GenerateNewPC; 6: EnterCombat( HQCamp ); +{$IFDEF PATCH_GH} + 7: MoreText( Console_History , MoreHighFirstLine( Console_History ) ); +{$ENDIF PATCH_GH} 0: SaveUnit( HQCamp^.Source ); end; +{$IFDEF PATCH_GH} + RedrawHQDisplay( HQCamp^.Source ); +{$ENDIF PATCH_GH} until N <= 0; { Free all dynamic resources. } @@ -1093,13 +1804,28 @@ begin HQCamp^.Source^.G := GG_Unit; Name := 'New Unit'; SetNAtt( HQCamp^.Source^.NA , NAG_Experience , NAS_Credits , NAV_StartingCash ); +{$IFDEF PATCH_I18N} + { Output DEBUG info. } + SetSAtt( HQCamp^.Source^.SA , Version_Generate_TAG + ' <' + Version_all + '>' ); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} + {$IFDEF PATCH_I18N} + Name := GetStringFromUser( I18N_MsgString('CreateNewUnit','Enter a Name') , Nil ); + {$ELSE PATCH_I18N} Name := GetStringFromUser( 'enter a name for your new unit' , Nil ); -{$ELSE} + {$ENDIF PATCH_I18N} +{$ELSE SDLMODE} + {$IFDEF PATCH_I18N} + Name := GetStringFromUser( I18N_MsgString('CreateNewUnit','Enter a Name') ); + {$ELSE PATCH_I18N} Name := GetStringFromUser( 'enter a name for your new unit' ); -{$ENDIF} + {$ENDIF PATCH_I18N} +{$ENDIF SDLMODE} if Name <> '' then begin +{$IFDEF DEBUG} + ErrorMessage_fork('CreateNewUnit: "' + name + '".' ); +{$ENDIF DEBUG} SetSAtt( HQCamp^.Source^.SA , 'name <'+name+'>'); SaveUnit( HQCamp^.Source ); HQMain( HQCamp ); @@ -1124,15 +1850,26 @@ begin { Otherwise, go straight to the NEW UNIT procedure. } if RPM^.NumItem > 0 then begin RPMSortAlpha( RPM ); +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('LoadUnit','Select') ); +{$ELSE PATCH_I18N} DialogMSG('Select unit file to load.'); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} uname := SelectFile( RPM , Nil ); {$ELSE} uname := SelectFile( RPM ); {$ENDIF} if uname <> '' then begin +{$IFDEF DEBUG} + ErrorMessage_fork('LoadUnit: "' + uname + '".' ); +{$ENDIF DEBUG} HQCamp := NewCampaign; +{$IFDEF PATCH_I18N} + Assign(F, Save_Game_Directory + TextEncode(uname) ); +{$ELSE PATCH_I18N} Assign(F, Save_Game_Directory + uname ); +{$ENDIF PATCH_I18N} reset(F); HQCamp^.Source := ReadCGears(F); Close(F); @@ -1167,21 +1904,37 @@ begin {$ELSE} uname := SelectFile( RPM ); {$ENDIF} +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} DisposeRPGMenu( RPM ); +{$ENDIF PATCH_GH} end else if RPM^.NumItem = 1 then begin uname := RPM^.FirstItem^.msg; end else begin uname := ''; end; +{$IFDEF PATCH_GH} + DisposeRPGMenu( RPM ); +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} if uname <> '' then begin Assign( F , Series_Directory + uname ); Reset( F ); +{$IFDEF PATCH_GH} + TCamp^.Source := ReadGear( F, Series_Directory + uname ); +{$ELSE PATCH_GH} TCamp^.Source := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); end; +{$IFDEF PATCH_GH} + if (NIL <> PC) + and (NIL <> TCamp^.Source) and (GG_DisposeGear < TCamp^.Source^.G) then begin +{$ELSE PATCH_GH} if ( PC <> Nil ) and ( TCamp^.Source <> Nil ) then begin +{$ENDIF PATCH_GH} Part := PC; while Part <> Nil do begin if ( Part^.G = GG_Character ) and ( Part^.SubCom = Nil ) then begin @@ -1214,22 +1967,42 @@ begin if RPM^.NumItem > 0 then begin RPMSortAlpha( RPM ); AddRPGMenuItem( RPM , MsgString( 'STARTRPG_NewChar' ) , -2 ); +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('StartRPGCampaign','Select') ); +{$ELSE PATCH_I18N} DialogMSG('Select character file.'); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} uname := SelectFile( RPM , Nil ); {$ELSE} uname := SelectFile( RPM ); {$ENDIF} +{$IFDEF DEBUG} + ErrorMessage_fork('StartRPGCampaign: "' + uname + '".' ); +{$ENDIF DEBUG} if uname = MsgString( 'STARTRPG_NewChar' ) then begin EnterCampaign( CharacterCreator ); end else if uname <> '' then begin +{$IFDEF PATCH_I18N} + Assign(F, Save_Game_Directory + TextEncode(uname) ); +{$ELSE PATCH_I18N} Assign(F, Save_Game_Directory + uname ); +{$ENDIF PATCH_I18N} reset(F); PC := ReadCGears(F); Close(F); +{$IFDEF PATCH_I18N} + { Output DEBUG info. } + SetSAtt( PC^.SA , Version_Start_TAG + ' <' + Version_all + '>' ); +{$ENDIF PATCH_I18N} + { Erase character upon entry. } +{$IFDEF PATCH_I18N} + Assign( F , Save_Game_Directory + TextEncode(uName) ); +{$ELSE PATCH_I18N} Assign( F , Save_Game_Directory + uName ); +{$ENDIF PATCH_I18N} Erase(F); EnterCampaign( PC ); @@ -1250,30 +2023,57 @@ var A: Char; msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + {$IFDEF SDLMODE} + {$IFDEF PATCH_I18N} + msg := FormatDescString( Part ); + {$ELSE PATCH_I18N} msg := SAttValue( Part^.SA , 'DESC' ); + {$ENDIF PATCH_I18N} if ( msg <> '' ) or ( Part^.G <> GG_Mecha ) then begin repeat RedrawOpening; DisplayGearInfo( Part ); + {$IFDEF PATCH_I18N} + NFVCMessage( msg , ZONE_Menu , InfoGreen ); + {$ELSE PATCH_I18N} NFCMessage( msg , ZONE_Menu , InfoGreen ); + {$ENDIF PATCH_I18N} GHFlip; A := RPGKey; until ( A = ' ' ) or ( A = #27 ) or ( A = RPK_MouseButton ); end; + {$IFDEF PATCH_GH} + {$ELSE PATCH_GH} msg := MechaDescription( Part ); + {$ENDIF PATCH_GH} if Part^.G = GG_Mecha then begin + {$IFDEF PATCH_GH} + msg := MechaDescription( Part ); + {$ELSE PATCH_GH} + {$ENDIF PATCH_GH} repeat RedrawOpening; DisplayGearInfo( Part ); + {$IFDEF PATCH_I18N} + NFVCMessage( msg , ZONE_Menu , InfoGreen ); + {$ELSE PATCH_I18N} NFCMessage( msg , ZONE_Menu , InfoGreen ); + {$ENDIF PATCH_I18N} GHFlip; A := RPGKey; until ( A = ' ' ) or ( A = #27 ) or ( A = RPK_MouseButton ); end; -{$ELSE} +{$ELSE SDLMODE} DisplayGearInfo( Part ); + {$IFDEF PATCH_I18N} + msg := FormatDescString( Part ); + {$ELSE PATCH_I18N} msg := SAttValue( Part^.SA , 'DESC' ); + {$ENDIF PATCH_I18N} if ( msg <> '' ) or ( Part^.G <> GG_Mecha ) then begin GameMsg( msg , ZONE_Menu , InfoGreen ); EndOfGameMoreKey; @@ -1284,7 +2084,7 @@ begin end; ClrZone( ZONE_Menu ); ClrZone( ZONE_Info ); -{$ENDIF} +{$ENDIF SDLMODE} end; Procedure BrowseDesignFile( List: GearPtr ); @@ -1304,8 +2104,14 @@ begin Part := List; N := 1; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} AddRPGMenuItem( BrowseMenu , FullGearName( Part ) , N ); Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; RPMSortAlpha( BrowseMenu ); @@ -1368,4 +2174,25 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arenahq.pp'); +{$ENDIF DEBUG} +{$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + InfoGear := NIL; + InfoMekMenu := NIL; + {$ENDIF PATCH_GH} +{$ENDIF SDLMODE} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arenahq.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/arenaplay.pp branches/arenaplay.pp --- GearHead1100repository.original/arenaplay.pp 2013-02-06 10:00:02.000000000 +0900 +++ branches/arenaplay.pp 2016-01-03 09:01:00.000000000 +0900 @@ -24,33 +24,68 @@ unit arenaplay; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; Const +{$IFDEF PATCH_GH} +{ Moved into locale.pp } +{$ELSE PATCH_GH} { Sets trigger NUMBEROFUNITS } TRIGGER_StartGame = 'Start'; TRIGGER_EndGame = 'END'; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + SATT_AutoSave_Label = 'AutoSave'; +{$ENDIF PATCH_GH} SATT_Artifact = 'ARTIFACT'; Function CombatMain( Camp: CampaignPtr ): Integer; +{$IFDEF PATCH_GH} +Function ScenePlayer( Camp: CampaignPtr ; Scene: GearPtr; var PCForces: GearPtr; RestoreMode: Boolean ): Integer; +{$ELSE PATCH_GH} Function ScenePlayer( Camp: CampaignPtr ; Scene: GearPtr; var PCForces: GearPtr ): Integer; +{$ENDIF PATCH_GH} implementation +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + ui4gh, + ability,aibrain,arenacfe,arenascript,backpack,damage,gearutil, + ghchars,ghprop,ghweapon,grabgear,menugear,movement,pcaction, + playwright,randmaps,rpgdice,skilluse,texutil,wmonster, +{$ELSE PATCH_GH} + ability,aibrain,arenacfe,arenascript,backpack,damage,gearutil, + ghchars,ghprop,ghweapon,grabgear,menugear,movement,pcaction, + playwright,randmaps,rpgdice,skilluse,texutil,ui4gh,wmonster, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + ghmodule, +{$ENDIF PATCH_CHEAT} {$IFDEF SDLMODE} -uses ability,aibrain,arenacfe,arenascript,backpack,damage,gearutil, - ghchars,ghprop,ghweapon,grabgear,menugear,movement,pcaction, - playwright,randmaps,rpgdice,skilluse,texutil,ui4gh,wmonster, - sdlmap,sdlgfx; -{$ELSE} -uses ability,aibrain,arenacfe,arenascript,backpack,damage,gearutil, - ghchars,ghprop,ghweapon,grabgear,menugear,movement,pcaction, - playwright,randmaps,rpgdice,skilluse,texutil,ui4gh,wmonster, - conmap,context; -{$ENDIF} + sdlmap,sdlgfx +{$ELSE SDLMODE} + conmap,context +{$ENDIF SDLMODE} + ; + const +{$IFDEF DEBUG} + DEBUG_ON: Boolean = True; +{$ELSE DEBUG} DEBUG_ON: Boolean = False; +{$ENDIF DEBUG} Function Confused( Mek: GearPtr ): Boolean; { Return true if either the pilot or the mecha is either } @@ -58,8 +93,15 @@ Function Confused( Mek: GearPtr ): Boole var Pilot: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if Mek^.G = GG_Mecha then begin Pilot := LocatePilot( Mek ); +{$IFDEF PATCH_GH} + if (NIL = Pilot) or (Pilot^.G <= GG_DisposeGear) then Pilot := NIL; +{$ENDIF PATCH_GH} end else begin Pilot := Nil; end; @@ -70,6 +112,10 @@ end; Procedure GetMekInput( Mek: GearPtr; Camp: CampaignPtr; ControlByPlayer: Boolean ); { Decide what the mek in question is gonna do next. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { This procedure has to branch depending upon whether we have a } { player controlled mek or a computer controlled mek. } @@ -78,12 +124,15 @@ begin if Confused( Mek ) and ( Random( 2 ) = 1 ) then begin ConfusedInput( Mek , Camp^.GB ); - end else if ( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = 1 ) or ControlByPlayer then begin + end else if ( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) or ControlByPlayer then begin { It's a player mek. } { In SDL mode, update the display with each player action. } +{$IFDEF PATCH_JPSSDL} +{$ELSE PATCH_JPSSDL} {$IFDEF SDLMODE} IndicateTile( Camp^.GB , Mek , True ); {$ENDIF} +{$ENDIF PATCH_JPSSDL} GetPlayerInput( Mek , Camp ); end else begin @@ -126,6 +175,9 @@ begin M := Camp^.GB^.meks; while ( M <> Nil ) and KeepPlayingSC( Camp^.GB ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if IsMasterGear( M ) then begin { Check for actions in progress. } if NotDestroyed( M ) and OnTheMap( M ) then begin @@ -145,6 +197,9 @@ begin end; end; { if IsMasterGear then... } +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -166,13 +221,25 @@ begin { Display message regarding the outcome of the battle. } if ( PTeam > 0 ) and ( ETeam = 0 ) then begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('DecideCombatOutcome','Player won') ); +{$ELSE PATCH_I18N} DialogMsg( 'Player has won this combat.' ); +{$ENDIF PATCH_I18N} T := 1; end else if ( ETeam > 0 ) and ( PTeam = 0 ) then begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('DecideCombatOutcome','Computer won') ); +{$ELSE PATCH_I18N} DialogMsg( 'Computer has won this combat.' ); +{$ENDIF PATCH_I18N} T := -1; end else begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('DecideCombatOutcome','Draw') ); +{$ELSE PATCH_I18N} DialogMsg( 'The game has ended in a draw.' ); +{$ENDIF PATCH_I18N} T := 0; end; end; @@ -191,12 +258,22 @@ begin { Next, go through each gear on the gameboard, doing vision checks as needed. } M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if IsMasterGear( M ) and OnTheMap( M ) then VisionCheck( GB , M ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end; +{$IFDEF PATCH_GH} +Function CombatMain( Camp: CampaignPtr; RestoreMode: Boolean ): Integer; +{$ELSE PATCH_GH} Function CombatMain( Camp: CampaignPtr ): Integer; +{$ENDIF PATCH_GH} { This is the main meat-and-potatoes combat procedure. } { Actually, it's pretty simple. All the difficult work is } { done by the procedures it calls. } @@ -204,7 +281,70 @@ Function CombatMain( Camp: CampaignPtr ) { won, and 0 if the game ended in a draw. } var T: String; +{$IFDEF DEBUG} + ApplyUpdate: Boolean = False; +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + GarbageCollectTimer: LongInt = 0; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + { To start with, do a vision check for everyone, } + { then set up the display. } + UniversalVisionCheck( Camp^.GB ); + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; + + { Get rid of the old AI pathfinding maps. } + ClearHotMaps; + + if RestoreMode then begin + {$IFDEF DEBUG} + ApplyUpdate := False; + if DEBUG_FORCE_EXEC_MacroSTART_when_Restore then begin + SetTrigger( Camp^.GB , TRIGGER_StartGame ); + ApplyUpdate := True; + end; + {$ENDIF DEBUG} + {$IFDEF DEBUG} + if DEBUG_STOP_MacroRESTORESTART_when_Restore then begin + end else begin + {$ENDIF DEBUG} + SetTrigger( Camp^.GB , TRIGGER_RestoreStartGame ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + {$IFDEF DEBUG} + if DEBUG_FORCE_EXEC_MacroUPDATE_when_Restore then begin + T := 'UPDATE'; + CheckTriggerAlongPath( T , Camp^.GB , Camp^.GB^.Meks , True ); + ApplyUpdate := True; + end; + if DEBUG_FORCE_RestockRandomMonsters_when_Restore then begin + RestockRandomMonsters( Camp^.GB ); + ApplyUpdate := True; + end; + if ApplyUpdate then begin + UniversalVisionCheck( Camp^.GB ); + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; + end; + {$ENDIF DEBUG} + end else begin + { Set the STARTGAME trigger, and update all props. } + SetTrigger( Camp^.GB , TRIGGER_StartGame ); + T := 'UPDATE'; + CheckTriggerAlongPath( T , Camp^.GB , Camp^.GB^.Meks , True ); + + { Add some random monsters, if appropriate. } + RestockRandomMonsters( Camp^.GB ); + + { Apply the UPDATE } + UniversalVisionCheck( Camp^.GB ); + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; + end; +{$ELSE PATCH_GH} { To start with, do a vision check for everyone, } { then set up the display. } UniversalVisionCheck( Camp^.GB ); @@ -220,10 +360,20 @@ begin { Add some random monsters, if appropriate. } RestockRandomMonsters( Camp^.GB ); +{$ENDIF PATCH_GH} {Start main combat loop here.} {Keep going until there's only one side left.} while KeepPlayingSC( Camp^.GB ) do begin +{$IFDEF PATCH_GH} + { Garbage Collect, Every 10 minutes. } + if (GarbageCollectTimer < Camp^.GB^.ComTime) then begin + Purge_Att( Camp^.GB^.Meks ); + Purge_Att( Camp^.Source ); + GarbageCollectTimer := Camp^.GB^.ComTime + AP_10minutes; + end; +{$ENDIF PATCH_GH} + AdvanceGameClock( Camp^.GB ); { Once every 10 minutes, roll for random monsters. } @@ -239,10 +389,26 @@ begin CheckMeks( Camp ); +{$IFDEF PATCH_GH} + if Require_GFCombatDisplay then begin + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; + end else begin + UpdateCombatDisplay( Camp^.GB ); + end; +{$ELSE PATCH_GH} UpdateCombatDisplay( Camp^.GB ); +{$ENDIF PATCH_GH} {end main combat loop.} end; +{$IFDEF PATCH_GH} + { Garbage Collect } + Purge_Att( Camp^.GB^.Meks ); + Purge_GG_DisposeGear( Camp^.Source ); + Purge_GG_AbsolutelyNothing( Camp^.Source ); +{$ENDIF PATCH_GH} + { Handle the last pending triggers. } SetTrigger( Camp^.GB , TRIGGER_EndGame ); HandleTriggers( Camp^.GB ); @@ -250,10 +416,19 @@ begin { Return the outcome code. } CombatMain := DecideCombatOutcome( Camp^.GB ); end; +{$IFDEF PATCH_GH} +Function CombatMain( Camp: CampaignPtr ): Integer; +begin + CombatMain := CombatMain( Camp, False ); +end; +{$ENDIF PATCH_GH} Function CanTakeTurn( M: GearPtr ): Boolean; { Return TRUE if M can act in this turn. } begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} CanTakeTurn := GearOperational( M ) and OnTheMap( M ); end; @@ -265,6 +440,10 @@ var BeginTime,EndTime: LongInt; DidBeginTurn: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Get rid of the old AI pathfinding maps. } ClearHotMaps; @@ -278,7 +457,14 @@ begin if ETA <= Camp^.GB^.ComTime then begin ProcessMovement( Camp^.GB , M ); {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if OnTheScreen( M ) and ( NAttValue( M^.NA , NAG_Location , NAS_Team ) <> NAV_DefPlayerTeam ) and MekVisible( Camp^.GB , M ) then begin + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; + end; + {$ELSE PATCH_GH} if OnTheScreen( M ) and ( NAttValue( M^.NA , NAG_Location , NAS_Team ) <> NAV_DefPlayerTeam ) and MekVisible( Camp^.GB , M ) then GFCombatDisplay( Camp^.GB ); + {$ENDIF PATCH_GH} {$ENDIF} end; @@ -289,6 +475,11 @@ begin if IsPlayerMek and not DidBeginTurn then begin BeginTurn( Camp^.GB , M ); DidBeginTurn := True; +{$IFDEF PATCH_GH} + FocusOnMek( Camp^.GB , M ); + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; +{$ENDIF PATCH_GH} end; GetMekInput( M , Camp , IsPlayerMek ); @@ -309,7 +500,11 @@ begin end; +{$IFDEF PATCH_GH} +Function TacticsMain( Camp: CampaignPtr; RestoreMode: Boolean ): Integer; +{$ELSE PATCH_GH} Function TacticsMain( Camp: CampaignPtr ): Integer; +{$ENDIF PATCH_GH} { This is the main meat-and-potatoes combat procedure. } { It functions as the above procedure, but a bit more strangely. } { You see, in order to have a tactics mode without changing any other part } @@ -321,7 +516,70 @@ var M: GearPtr; Team: Integer; FoundPCToAct: Boolean; +{$IFDEF DEBUG} + ApplyUpdate: Boolean = False; +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + GarbageCollectTimer: LongInt = 0; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + { To start with, do a vision check for everyone, } + { then set up the display. } + UniversalVisionCheck( Camp^.GB ); + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; + + { Get rid of the old AI pathfinding maps. } + ClearHotMaps; + + if RestoreMode then begin + {$IFDEF DEBUG} + ApplyUpdate := False; + if DEBUG_FORCE_EXEC_MacroSTART_when_Restore then begin + SetTrigger( Camp^.GB , TRIGGER_StartGame ); + ApplyUpdate := True; + end; + {$ENDIF DEBUG} + {$IFDEF DEBUG} + if DEBUG_STOP_MacroRESTORESTART_when_Restore then begin + end else begin + {$ENDIF DEBUG} + SetTrigger( Camp^.GB , TRIGGER_RestoreStartGame ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + {$IFDEF DEBUG} + if DEBUG_FORCE_EXEC_MacroUPDATE_when_Restore then begin + T := 'UPDATE'; + CheckTriggerAlongPath( T , Camp^.GB , Camp^.GB^.Meks , True ); + ApplyUpdate := True; + end; + if DEBUG_FORCE_RestockRandomMonsters_when_Restore then begin + RestockRandomMonsters( Camp^.GB ); + ApplyUpdate := True; + end; + if ApplyUpdate then begin + UniversalVisionCheck( Camp^.GB ); + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; + end; + {$ENDIF DEBUG} + end else begin + { Set the STARTGAME trigger, and update all props. } + SetTrigger( Camp^.GB , TRIGGER_StartGame ); + T := 'UPDATE'; + CheckTriggerAlongPath( T , Camp^.GB , Camp^.GB^.Meks , True ); + + { Add some random monsters, if appropriate. } + RestockRandomMonsters( Camp^.GB ); + + { Apply the UPDATE } + UniversalVisionCheck( Camp^.GB ); + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; + end; +{$ELSE PATCH_GH} { To start with, do a vision check for everyone, } { then set up the display. } UniversalVisionCheck( Camp^.GB ); @@ -337,10 +595,20 @@ begin { Add some random monsters, if appropriate. } RestockRandomMonsters( Camp^.GB ); +{$ENDIF PATCH_GH} {Start main combat loop here.} {Keep going until there's only one side left.} while KeepPlayingSC( Camp^.GB ) do begin +{$IFDEF PATCH_GH} + { Garbage Collect, Every 10 minutes. } + if (GarbageCollectTimer < Camp^.GB^.ComTime) then begin + Purge_Att( Camp^.GB^.Meks ); + Purge_Att( Camp^.Source ); + GarbageCollectTimer := Camp^.GB^.ComTime + AP_10minutes; + end; +{$ENDIF PATCH_GH} + { Start by handling triggers; also end by handling triggers. It may } { seem like overkill but it's the only way to catch them all. } HandleTriggers( Camp^.GB ); @@ -351,6 +619,9 @@ begin FoundPCToAct := False; M := Camp^.GB^.Meks; while ( M <> Nil ) and KeepPlayingSC( Camp^.GB ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} team := NAttValue( M^.NA , NAG_Location , NAS_Team ); if ( Team = NAV_DefPlayerTeam ) or ( Team = NAV_LancemateTeam ) then begin if NotDestroyed( M ) and OnTheMap( M ) then begin @@ -358,6 +629,9 @@ begin TacticsTurn( Camp , M , True ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; until ( not FoundPCToAct ); @@ -365,12 +639,18 @@ begin { Handle the enemy mecha next. } M := Camp^.GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} team := NAttValue( M^.NA , NAG_Location , NAS_Team ); if ( Team <> NAV_DefPlayerTeam ) and ( Team <> NAV_LancemateTeam ) then begin if NotDestroyed( M ) and OnTheMap( M ) then begin TacticsTurn( Camp , M , False ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -380,7 +660,16 @@ begin HandleTriggers( Camp^.GB ); { Update the display. } +{$IFDEF PATCH_GH} + if Require_GFCombatDisplay then begin + GFCombatDisplay( Camp^.GB ); + Require_GFCombatDisplay := False; + end else begin + UpdateCombatDisplay( Camp^.GB ); + end; +{$ELSE PATCH_GH} UpdateCombatDisplay( Camp^.GB ); +{$ENDIF PATCH_GH} { Update clouds every round. } for team := 1 to ( TacticsRoundLength div 30 ) do BrownianMotion( Camp^.GB ); @@ -389,6 +678,13 @@ begin if ( ( Camp^.GB^.ComTime div TacticsRoundLength ) mod 10 ) = 0 then RestockRandomMonsters( Camp^.GB ); end; +{$IFDEF PATCH_GH} + { Garbage Collect } + Purge_Att( Camp^.GB^.Meks ); + Purge_GG_DisposeGear( Camp^.Source ); + Purge_GG_AbsolutelyNothing( Camp^.Source ); +{$ENDIF PATCH_GH} + { Handle the last pending triggers. } SetTrigger( Camp^.GB , TRIGGER_EndGame ); HandleTriggers( Camp^.GB ); @@ -453,7 +749,13 @@ end; Function NonRecoveryScene( GB: GameBoardPtr ): Boolean; { Return TRUE if this scene isn't a good location for recovery. } begin +{$IFDEF PATCH_GH} + if (NIL = GB^.Scene) then Exit(True); + if (GB^.Scene^.G <= GG_DisposeGear) then Exit(True); + NonRecoveryScene := not AStringHasBString( SAttValue( GB^.Scene^.SA , 'TYPE' ) , 'TOWN' ); +{$ELSE PATCH_GH} NonRecoveryScene := ( GB^.Scene = Nil ) or ( not AStringHasBString( SAttValue( GB^.Scene^.SA , 'TYPE' ) , 'TOWN' ) ); +{$ENDIF PATCH_GH} end; Function ShouldDeployLancemate( GB: GameBoardPtr; LM , Scene: GearPtr ): Boolean; @@ -478,7 +780,13 @@ Procedure DeployJJang( Camp: CampaignPtr var it,it2: GearPtr; begin +{$IFDEF DEBUG} + if DEBUG_ON then begin + ErrorMessage_fork( 'DeployJJang' ); + end; +{$ELSE DEBUG} if DEBUG_ON then DialogMsg( 'DeployJJang' ); +{$ENDIF DEBUG} { ERROR CHECK - If this campaign already has a GameBoard, no need to } { deploy anything. It was presumably just restored from disk and should } @@ -574,6 +882,9 @@ begin InsertInvCom( Scene , Item ); { If inserting a character, better choose a team. } +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('PutAwayGlobal()'); +{$ENDIF DEBUG} if IsMasterGear( Grabbed_Gear ) then begin ChooseTeam( Item , Scene ); end; @@ -613,13 +924,44 @@ Procedure PutAwayGear( GB: GameBoardPtr; ShouldBeMoved := False; end; end; +{$IFDEF PATCH_CHEAT} +var + DestroyedFlag: SAttPtr; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_CHEAT} + DestroyedFlag := FindSAtt( Mek^.SA, SATT_DESTROYED ); +{$ENDIF PATCH_CHEAT} if Mek = Nil then begin Exit; end else if ( Mek^.G = GG_MetaTerrain ) and ( Mek^.S = GS_MetaFire ) then begin DisposeGear( Mek ); end else if Destroyed( Mek ) and ShouldDeleteDestroyed( GB , Mek ) then begin +{$IFDEF PATCH_CHEAT} + if (Cheat_MechaCustomize_FreeSupport or ('' <> SAttValue(Mek^.SA,SATT_CUSTOM_ENGINE))) and (NIL = DestroyedFlag) then begin + { Strip the stuff we don't want to save. } + StripNAtt( Mek , NAG_Visibility ); + StripNAtt( Mek , NAG_Action ); + StripNAtt( Mek , NAG_EpisodeData ); + StripNAtt( Mek , NAG_Condition ); + + if GB^.Scene <> Nil then begin + if IsGlobalGear( Mek ) then begin + StripNAtt( Mek , NAG_Location ); + StripNAtt( Mek , NAG_Damage ); + PutAwayGlobal( GB , Mek ); + end else begin + InsertInvCom( GB^.Scene , Mek ); + end; + end else begin + DisposeGear( Mek ); + end; + end else begin + DisposeGear( Mek ); + end; +{$ELSE PATCH_CHEAT} DisposeGear( Mek ); +{$ENDIF PATCH_CHEAT} end else if ( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and ShouldBeMoved then begin { Strip the location & visibility info. } StripNAtt( Mek , NAG_Location ); @@ -664,6 +1006,11 @@ begin end; end; +{$IFDEF PATCH_CHEAT} + if (NIL <> Mek) and (NIL <> DestroyedFlag) then begin + RemoveSAtt( Mek^.SA, DestroyedFlag ); + end; +{$ENDIF PATCH_CHEAT} end; Procedure PreparePCForDelink( GB: GameBoardPtr ); @@ -730,7 +1077,16 @@ begin if PC^.G = GG_Mecha then begin DialogMsg( ReplaceHash( MsgString( 'DJ_MECHARECOVERED' ) , GearName( PC ) ) ); end else if Team = NAV_DefPlayerTeam then begin +{$IFDEF PATCH_CHEAT} + if Cheat_Roguelike_Death then begin + DialogMsg( ReplaceHash( I18N_MsgString( 'PreparePCForDelink','Died' ) , PilotName( PC ) ) ); + Mark_GG_DisposeGear( PC ); + end else begin + DialogMsg( ReplaceHash( MsgString( 'DJ_PCRESCUED' ) , PilotName( PC ) ) ); + end; +{$ELSE PATCH_CHEAT} DialogMsg( ReplaceHash( MsgString( 'DJ_PCRESCUED' ) , PilotName( PC ) ) ); +{$ENDIF PATCH_CHEAT} end else begin DialogMsg( ReplaceHash( MsgString( 'DJ_OUTOFACTION' ) , PilotName( PC ) ) ); end; @@ -759,25 +1115,62 @@ end; Procedure DoPillaging( GB: GameBoardPtr ); { Pillage everything that isn't nailed down. } +{$IFDEF PATCH_GH} +const + V_MAX = 2147483647; + V_MIN = -2147483648; +{$ENDIF PATCH_GH} var PC,M,M2: GearPtr; +{$IFDEF PATCH_GH} + Cash: Int64; + NID: LongInt; +{$ELSE PATCH_GH} Cash,NID: LongInt; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + Pillaging_Cash: Int64; +{$ENDIF PATCH_CHEAT} begin Cash := 0; PC := GG_LocatePC( GB ); { If this is a NOPILLAGE scene, exit. } +{$IFDEF PATCH_CHEAT} + if ( GB^.Scene <> Nil ) and AStringHasBString( SAttValue( GB^.Scene^.SA, 'TYPE' ) , 'NOPILLAGE' ) then begin + if Cheat_Print_DoPillage then begin + DialogMsg( I18N_MsgString('DoPillaging','PillagingIsProhibited') ); + end; + Exit; + end; +{$ELSE PATCH_CHEAT} if ( GB^.Scene <> Nil ) and AStringHasBString( SAttValue( GB^.Scene^.SA, 'TYPE' ) , 'NOPILLAGE' ) then Exit; +{$ENDIF PATCH_CHEAT} if ( PC <> Nil ) and OnTheMap( PC ) then begin { First pass: Shakedown anything that's destroyed. } M := GB^.Meks; while M <> Nil do begin if OnTheMap( M ) and IsMasterGear( M ) and not GearOperational( M ) then begin +{$IFDEF PATCH_CHEAT} + Pillaging_Cash := ShakeDown( GB , M , 1 , 1 ); + if Cheat_Print_DoPillage then begin + DialogMsg( ReplaceHash( I18N_MsgString('DoPillaging','YouGotMoney'), BStr(Pillaging_Cash) ) ); + end; + cash := cash + Pillaging_Cash; +{$ELSE PATCH_CHEAT} cash := cash + SHakeDown( GB , M , 1 , 1 ); +{$ENDIF PATCH_CHEAT} end; M := M^.Next; end; +{$IFDEF PATCH_GH} + if (V_MAX < Cash) then begin + Cash := V_MAX; + end else if (Cash < V_MIN) then begin + Cash := V_MIN; + end; +{$ENDIF PATCH_GH} { Second pass: Pick up anything we can! } M := GB^.Meks; @@ -785,6 +1178,11 @@ begin M2 := M^.Next; if OnTheMap( M ) and NotDestroyed( M ) and IsLegalSlot( PC , M ) and ( M^.G > 0 ) and not IsMasterGear( M ) then begin +{$IFDEF PATCH_CHEAT} + if Cheat_Print_DoPillage then begin + DialogMsg( ReplaceHash( I18N_MsgString('DoPillaging','YouGotItem'), GearName(M) ) ); + end; +{$ENDIF PATCH_CHEAT} DelinkGear( GB^.Meks , M ); { Clear the item's location values. } @@ -801,6 +1199,12 @@ begin { Finally, hand the PC any money that was found. } PC := LocatePilot( PC ); if ( PC <> Nil ) and ( Cash > 0 ) then AddNAtt( PC^.NA , NAG_Experience , NAS_Credits , Cash ); +{$IFDEF PATCH_CHEAT} + end else begin + if Cheat_Print_DoPillage then begin + DialogMsg( I18N_MsgString('DoPillaging','NotTragetedForPillage') ); + end; +{$ENDIF PATCH_CHEAT} end; end; @@ -810,20 +1214,44 @@ Function DelinkJJang( GB: GameBoardPtr ) var PCForces,Mek,Pilot: GearPtr; begin +{$IFDEF DEBUG} + if DEBUG_ON then begin + ErrorMessage_fork( 'DelinkJJang' ); + end; +{$ELSE DEBUG} if DEBUG_ON then DialogMsg( 'DelinkJJang' ); +{$ENDIF DEBUG} { Step one - Delete obsoleted teams. } { A team will be deleted if it has no members, if it isn't the } { player team or the neutral team, and if it has no wandering } { monsters allocated. } DeleteObsoleteTeams( GB ); +{$IFDEF DEBUG} + if DEBUG_ON then begin + ErrorMessage_fork( 'Team update complete.' ); + end; +{$ELSE DEBUG} if DEBUG_ON then DialogMsg( 'Team update complete.' ); +{$ENDIF DEBUG} { Step one-and-a-half: If this is a dynamic scene, and is safe, and pillaging } { is enabled, then pillage away! } +{$IFDEF PATCH_CHEAT} + if Pillage_On then begin + if IsInvCom( GB^.Scene ) and IsSafeArea( GB ) then begin + DoPillaging( GB ); + end else begin + if Cheat_Print_DoPillage then begin + DialogMsg( I18N_MsgString('DelinkJJang','DontPillaging') ); + end; + end; + end; +{$ELSE PATCH_CHEAT} if IsInvCom( GB^.Scene ) and IsSafeArea( GB ) and Pillage_On then begin DoPillaging( GB ); end; +{$ENDIF PATCH_CHEAT} { Step two - Remove all models from game board. } { Initialize the PC Forces to Nil. } @@ -859,25 +1287,72 @@ begin end; +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} + if DEBUG_Grabbed_Gear then begin + Show_DebugMessage_Grabbed_Gear('DelinkJJang()'); + ErrorMessage_fork( 'DEBUG_MESSAGE: DelinkJJang() Grabbed_Gear, set NIL' ); + end; + {$ENDIF DEBUG} + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_Change_Scene then begin + end else begin + {$ENDIF DEBUG} + Grabbed_Gear := NIL; + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} DelinkJJang := PCForces; end; +{$IFDEF PATCH_GH} +Function ScenePlayer( Camp: CampaignPtr ; Scene: GearPtr; var PCForces: GearPtr; RestoreMode: Boolean ): Integer; +{$ELSE PATCH_GH} Function ScenePlayer( Camp: CampaignPtr ; Scene: GearPtr; var PCForces: GearPtr ): Integer; +{$ENDIF PATCH_GH} { Construct then play a scenario. } { Note that this procedure ABSOLUTELY DEFINITELY requires that } { the SCENE gear be defined. } var N: Integer; +{$IFDEF PATCH_GH} + AutoSave_Flag: String; +{$ENDIF PATCH_GH} begin DeployJJang( Camp , Scene , PCForces ); { Once everything is deployed, save the campaign. } +{$IFDEF PATCH_GH} + if RestoreMode then begin + AutoSave_Flag := SAttValue( GG_LocatePC( Camp^.GB )^.SA, SATT_AutoSave_Label ); + if ExtractTF(AutoSave_Flag) then begin + RestoreMode := False; + end; + end else begin + if DoAutoSave then begin + SetSAtt( GG_LocatePC( Camp^.GB )^.SA, SATT_AutoSave_Label + ' ' ); + PCSaveCampaign( Camp , GG_LocatePC( Camp^.GB ) , False ); + end; + end; + SetSAtt( GG_LocatePC( Camp^.GB )^.SA, SATT_AutoSave_Label + ' ' ); +{$ELSE PATCH_GH} if DoAutoSave then PCSaveCampaign( Camp , GG_LocatePC( Camp^.GB ) , False ); +{$ENDIF PATCH_GH} if UseTacticsMode and ( Camp^.gb^.Scale = 2 ) then begin +{$IFDEF PATCH_GH} + N := TacticsMain( Camp, RestoreMode ); +{$ELSE PATCH_GH} N := TacticsMain( Camp ); +{$ENDIF PATCH_GH} end else begin +{$IFDEF PATCH_GH} + N := CombatMain( Camp, RestoreMode ); +{$ELSE PATCH_GH} N := CombatMain( Camp ); +{$ENDIF PATCH_GH} end; PCForces := DelinkJJang( Camp^.gb ); @@ -899,4 +1374,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arenaplay.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arenaplay.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/arenascript.pp branches/arenascript.pp --- GearHead1100repository.original/arenascript.pp 2013-02-05 09:01:00.000000000 +0900 +++ branches/arenascript.pp 2015-11-16 09:01:00.000000000 +0900 @@ -36,16 +36,29 @@ unit arenascript; interface +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears, + locale, {$IFDEF SDLMODE} -uses gears,locale,sdlmenus,sdl; + sdlmenus,sdl {$ELSE} -uses gears,locale,conmenus; + conmenus {$ENDIF} + ; const NAG_ScriptVar = 0; Max_Plots_Per_Story = 5; +{$IFDEF PATCH_GH} + lancemate_tactics_persona: GearPtr = NIL; { Persona for setting lancemate tactics. } +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} + + var { This gear pointer will be created if a dynamic scene is requested. } SCRIPT_DynamicEncounter: GearPtr; @@ -61,15 +74,43 @@ var { middle of a conversation and all other interaction variables } { should have good values. } IntMenu: RPGMenuPtr; { Interaction Menu } +{$IFDEF PATCH_GH} + I_PC: GearPtr; { Pointers to the PC Chara gears } + I_NPC: GearPtr; { Pointers to the NPC Chara gears } + I_NPC_org: GearPtr; { Pointers to the backup NPC Chara gears } + { When ASLs "SetNPC E4 EMail d3" is executed, } + { original I_NPC is preserved in I_NPC_org } + { and E4 is set to I_NPC. } + { At the end of an ASL EMail, } + { the content of I_NPC_org returns to I_NPC. } +{$ELSE PATCH_GH} I_PC,I_NPC: GearPtr; { Pointers to the PC & NPC Chara gears } +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} I_Endurance: Integer; { How much of the PC's crap the NPC is } { willing to take. When it reaches 0, the NPC says goodbye. } I_Rumors: SAttPtr; { List of rumors. } +{$ENDIF PATCH_GH} Grabbed_Gear: GearPtr; { This gear can be acted upon by } { generic commands. } +{$IFDEF PATCH_GH} + { These variable are counter measures to the bug that exists in the design of GG_AbsolutelyNothing. } + NestLevel_of_InvokeEvent: Integer; + Current_PlotMaster: GearPtr; + Current_StoryMaster: GearPtr; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} lancemate_tactics_persona: GearPtr; { Persona for setting lancemate tactics. } +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + Require_GFCombatDisplay: Boolean; +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} @@ -96,45 +137,241 @@ Function TriggerGearScript( GB: GameBoar Function CheckTriggerAlongPath( var T: String; GB: GameBoardPtr; Plot: GearPtr; CheckAll: Boolean ): Boolean; Procedure HandleTriggers( GB: GameBoardPtr ); +{$IFDEF PATCH_GH} +Function Make_ErrorMessage_ASL_CONTEXT1( const Event: String ): String; +Function Make_ErrorMessage_ASL_CONTEXT2( const Event: String ): String; +Function Make_ErrorMessage_ASL_CONTEXT3( const Event: String ): String; +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} +Procedure Show_DebugMessage_Grabbed_Gear( Msg: String ); +Procedure Show_DebugMessage_SCRIPT_DynamicEncounter( Msg: String ); +{$ENDIF DEBUG} + implementation +uses +{$IFDEF PATCH_GH} + sysutils, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + sysutils, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + errmsg, +{$ELSE DEBUG} +{$IFDEF PATCH_GH} + errmsg, +{$ENDIF PATCH_GH} +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} + action,arenacfe,ability,damage,gearutil,ghchars,ghparser,ghmodule, + ghprop,ghweapon,grabgear,interact,menugear,playwright,rpgdice,backpack, + services,texutil,ui4gh,wmonster, {$IFDEF SDLMODE} -uses action,arenacfe,ability,damage,gearutil,ghchars,ghparser,ghmodule, - ghprop,ghweapon,grabgear,interact,menugear,playwright,rpgdice, - services,texutil,ui4gh,wmonster,sdlgfx,sdlinfo,sdlmap,backpack; -{$ELSE} -uses action,arenacfe,ability,damage,gearutil,ghchars,ghparser,ghmodule, - ghprop,ghweapon,grabgear,interact,menugear,playwright,rpgdice,backpack, - services,texutil,ui4gh,wmonster,congfx,coninfo,conmap,context; -{$ENDIF} + sdlgfx,sdlinfo,sdlmap +{$ELSE SDLMODE} + congfx,coninfo,conmap,context +{$ENDIF SDLMODE} + ; const CMD_Chat = -2; CMD_Join = -3; CMD_Quit = -4; - Debug_On: Boolean = False; - -var +{$IFDEF DEBUG} + DEBUG_ON: Boolean = True; +{$ELSE DEBUG} + DEBUG_ON: Boolean = False; +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + MAX_Old_Grabbed_Gear_StackLevel = 512; +{$ENDIF PATCH_GH} + +var +{$IFDEF PATCH_GH} + DEBUG_cmd_org: String; { for DEBUG } + DEBUG_cmd_org2: String; { for DEBUG } + DEBUG_cmd_org3: String; { for DEBUG } +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + I_Endurance: Integer; { How much of the PC's crap the NPC is } + { willing to take. When it reaches 0, the NPC says goodbye. } + I_Rumors: SAttPtr; { List of rumors. } +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} script_macros,value_macros: SAttPtr; {$IFDEF SDLMODE} ASRD_InfoGear: GearPtr; ASRD_GameBoard: GameBoardPtr; ASRD_MemoMessage: String; +{$ENDIF SDLMODE} +{$IFDEF PATCH_GH} + Old_Grabbed_Gear_StackLevel: Integer; + Old_Grabbed_Gear: Array [0..MAX_Old_Grabbed_Gear_StackLevel] of GearPtr; +{$ENDIF PATCH_GH} + + +{$IFDEF PATCH_GH} +Function Make_ErrorMessage_ASL( const Source: GearPtr; const cmd: String ): String; +var + MsgOut: String; +begin + MsgOut := 'In "' + GearName( Source ) + '", '; + if '' <> cmd then begin + MsgOut := MsgOut + 'ASL:"' + cmd + '", '; + end; + Make_ErrorMessage_ASL := MsgOut; +end; + +Function Make_ErrorMessage_ASL_CONTEXT1( const Event: String ): String; +var + MsgOut: String; +begin + MsgOut := ''; + if ('' <> DEBUG_cmd_org2) then begin + MsgOut := MsgOut + 'SUB-CONTEXT: '; + end else begin + MsgOut := MsgOut + 'CONTEXT: '; + end; + if '' <> Event then begin + MsgOut := MsgOut + '"' + Event + '" '; + end; + Make_ErrorMessage_ASL_CONTEXT1 := MsgOut; +end; +Function Make_ErrorMessage_ASL_CONTEXT2( const Event: String ): String; +var + MsgOut: String; +begin + MsgOut := ''; + if ('' <> DEBUG_cmd_org2) then begin + MsgOut := MsgOut + 'in <' + DEBUG_cmd_org2 + '>'; + end else begin + MsgOut := MsgOut + 'in <' + DEBUG_cmd_org + '>'; + end; + Make_ErrorMessage_ASL_CONTEXT2 := MsgOut; +end; +Function Make_ErrorMessage_ASL_CONTEXT3( const Event: String ): String; +var + MsgOut: String; +begin + MsgOut := ''; + if ('' <> DEBUG_cmd_org3) then begin + MsgOut := MsgOut + ' as <' + DEBUG_cmd_org3 + '>.'; + end else begin + MsgOut := MsgOut + '.'; + end; + Make_ErrorMessage_ASL_CONTEXT3 := MsgOut; +end; + + +Procedure Dispose_SCRIPT_DynamicEncounter(); +var + Old_SCRIPT_DynamicEncounter: GearPtr; +begin + Old_SCRIPT_DynamicEncounter := SCRIPT_DynamicEncounter; + {$IFDEF DEBUG} + if not DEBUG_DONOT_NIL_SCRIPT_DynamicEncounter then begin + {$ENDIF DEBUG} + SCRIPT_DynamicEncounter := NIL; + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + if (NIL <> Old_SCRIPT_DynamicEncounter) then DisposeGear( Old_SCRIPT_DynamicEncounter ); +end; +{$ENDIF PATCH_GH} + +{$IFDEF DEBUG} +Procedure Show_DebugMessage_Grabbed_Gear( Msg: String ); +var + display_msg: String; +begin + if DEBUG_Grabbed_Gear then begin + display_msg := Msg + '[' + IntToStr(Old_Grabbed_Gear_StackLevel) + '] Grabbed_Gear:' + IntToHex(Int64(Grabbed_Gear), 16); + if (NIL <> Grabbed_Gear) then begin + if (NIL <> Grabbed_Gear^.SA) then begin + display_msg := display_msg + ', SA:' + Grabbed_Gear^.SA^.info; + end; + if (GG_AbsolutelyNothing = Grabbed_Gear^.G) then begin + display_msg := display_msg + ', GG_AbsolutelyNothing.'; + end else if (Grabbed_Gear^.G <= GG_DisposeGear) then begin + display_msg := display_msg + ', GG_DisposeGear.'; + end; + end; + ErrorMessage_fork( display_msg ); + end; +end; + +Procedure Show_DebugMessage_SCRIPT_DynamicEncounter( Msg: String ); +var + display_msg: String; + error: Boolean; + warning: Boolean; +begin + if DEBUG_SCRIPT_DynamicEncounter then begin + error := False; + warning := False; + if (NIL <> SCRIPT_DynamicEncounter) then begin + if (GG_AbsolutelyNothing = SCRIPT_DynamicEncounter^.G) then begin + ErrorMessage_fork( 'WARNING: SCRIPT_DynamicEncounter is GG_AbsolutelyNothing.' ); + DialogMsg( 'WARNING: SCRIPT_DynamicEncounter is GG_AbsolutelyNothing.' ); + warning := True; + end else if (SCRIPT_DynamicEncounter^.G <= GG_DisposeGear) then begin + ErrorMessage_fork( 'ERROR: SCRIPT_DynamicEncounter is GG_DisposeGear.' ); + DialogMsg( 'ERROR: SCRIPT_DynamicEncounter is GG_DisposeGear.' ); + error := True; + end; + end; + display_msg := Msg + ' SCRIPT_DynamicEncounter:' + IntToHex(Int64(SCRIPT_DynamicEncounter), 16); + if (NIL <> SCRIPT_DynamicEncounter) and (NIL <> SCRIPT_DynamicEncounter^.SA) then begin + display_msg := display_msg + ', SA:' + SCRIPT_DynamicEncounter^.SA^.info; + end; + if error then begin + ErrorMessage_fork( 'ERROR: ' + display_msg ); + DialogMsg( 'ERROR: ' + display_msg ); + end else if warning then begin + ErrorMessage_fork( 'WARNING: ' + display_msg ); + DialogMsg( 'WARNING: ' + display_msg ); + end else begin + ErrorMessage_fork( 'DEBUG_MESSAGE: ' + display_msg ); + end; + end; +end; +{$ENDIF DEBUG} + +{$IFDEF SDLMODE} Procedure ArenaScriptReDraw; { Redraw the combat screen for some menu usage. } begin if ASRD_GameBoard <> Nil then QuickCombatDisplay( ASRD_GameBoard ); +{$IFDEF PATCH_GH} + if (NIL <> ASRD_InfoGear) and (GG_DisposeGear < ASRD_InfoGear^.G) then begin + DisplayGearInfo( ASRD_InfoGear , ASRD_GameBoard ); + end; +{$ELSE PATCH_GH} DisplayGearInfo( ASRD_InfoGear , ASRD_GameBoard ); +{$ENDIF PATCH_GH} end; Procedure MemoPageReDraw; { Redraw the combat screen for some menu usage. } begin if ASRD_GameBoard <> Nil then QuickCombatDisplay( ASRD_GameBoard ); +{$IFDEF PATCH_GH} + if (NIL <> ASRD_InfoGear) and (GG_DisposeGear < ASRD_InfoGear^.G) then begin + DisplayGearInfo( ASRD_InfoGear , ASRD_GameBoard ); + end; +{$ELSE PATCH_GH} DisplayGearInfo( ASRD_InfoGear , ASRD_GameBoard ); +{$ENDIF PATCH_GH} SetupMemoDisplay; NFGameMsg( ASRD_MemoMessage , ZONE_MemoText , InfoGreen ); end; @@ -150,20 +387,34 @@ var RPM: RPGMenuPtr; msg: String; M: GearPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then PC := NIL; +{$ENDIF PATCH_GH} + { Step one - Create the menu. } RPM := CreateRPGMenu( MenuItem , MenuSelect , Z ); RPM^.Mode := RPMNoCancel; M := LList; N := 1; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if ( M^.G = GG_Mecha ) and ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) then begin msg := FullGearName( M ); AddRPGMenuItem( RPM , msg , N ); end; Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -205,10 +456,21 @@ var msg: String; begin while Part <> Nil do begin + {$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin + msg := SAttValue( Part^.SA , Tag ); + if msg <> '' then begin + StoreSAtt( MemoList , msg ); + end; + CreateMemoList( Part^.SubCom , Tag ); + CreateMemoList( Part^.InvCom , Tag ); + end; + {$ELSE PATCH_GH} msg := SAttValue( Part^.SA , Tag ); if msg <> '' then StoreSAtt( MemoList , msg ); CreateMemoList( Part^.SubCom , Tag ); CreateMemoList( Part^.InvCom , Tag ); + {$ENDIF PATCH_GH} Part := Part^.Next; end; end; @@ -224,8 +486,17 @@ var RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_MemoMenu ); AddRPGMenuItem( RPM , MsgString( 'MEMO_Next' ) , 1 ); AddRPGMenuItem( RPM , MsgString( 'MEMO_Prev' ) , 2 ); +{$IFDEF PATCH_GH} + AddRPGMenuKey( RPM , KeyMap[ KMC_Right ].KCode , 1 ); + AddRPGMenuKey( RPM , KeyMap[ KMC_Left ].KCode , 2 ); + AddRPGMenuKey( RPM , RPK_Right , 1 ); + AddRPGMenuKey( RPM , RPK_Left , 2 ); + AddRPGMenuKey( RPM , '+' , 1 ); + AddRPGMenuKey( RPM , '-' , 2 ); +{$ELSE PATCH_GH} AddRPGMenuKey( RPM , KeyMap[ KMC_East ].KCode , 1 ); AddRPGMenuKey( RPM , KeyMap[ KMC_West ].KCode , 2 ); +{$ENDIF PATCH_GH} AlphaKeyMenu( RPM ); RPM^.Mode := RPMNoCleanup; N := 1; @@ -336,10 +607,16 @@ begin Mek := GB^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = Team ) and GearOperational( Mek ) then begin Inc( T ); if T = N then MID := NAttValue( Mek^.NA , NAG_EpisodeData , NAS_UID ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; end; @@ -367,6 +644,9 @@ begin Mek := GB^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = Team ) and GearOperational( Mek ) then begin Inc( T ); if T = N then begin @@ -374,6 +654,9 @@ begin if P <> Nil then MID := NAttValue( P^.NA , NAG_EpisodeData , NAS_UID ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; end; @@ -410,11 +693,17 @@ Function FindFacMem( ID: Integer; GB: Ga begin it := 0; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G = GG_Character ) and ( NAttValue( Part^.NA , NAG_Personal , NAS_FactionID ) = ID ) then begin Inc( It ); end; if Part^.SubCom <> Nil then it := it + WorkHorse( Part^.SubCom ); if Part^.InvCom <> Nil then it := it + WorkHorse( Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; WorkHorse := it; @@ -434,11 +723,17 @@ Function FindFacScene( ID: Integer; Scen begin it := 0; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G = GG_Scene ) and ( NAttValue( Part^.NA , NAG_Personal , NAS_FactionID ) = ID ) then begin Inc( It ); end; if Part^.SubCom <> Nil then it := it + WorkHorse( Part^.SubCom ); if Part^.InvCom <> Nil then it := it + WorkHorse( Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; WorkHorse := it; @@ -460,9 +755,15 @@ begin if GB <> Nil then begin M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} { If this is a mecha, and it belongs to team 1, } { increment the counter. } if ( M^.G = GG_Mecha ) and ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) then Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end; @@ -540,10 +841,16 @@ Function FindHostileFactions( GB: GameBo it := 0; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G = GG_Faction ) and MeetsTheRequirements( Part ) then inc( it ); it := it + CheckAlongPath( Part^.SubCom ); it := it + CheckAlongPath( Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; @@ -718,6 +1025,9 @@ begin M := GB^.Meks; HiSkill := 0; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} T := NAttValue( M^.NA , NAG_Location , NAS_Team ); if GearActive( M ) and ( ( T = NAV_DefPlayerTeam ) or ( T = NAV_LancemateTeam ) ) then begin PC := LocatePilot( M ); @@ -726,6 +1036,9 @@ begin if T > HiSkill then HiSkill := T; end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -739,13 +1052,28 @@ Function ScriptValue( var Event: String; { scenario variables as the parameters for commands. That's } { what this function is for. } var +{$IFDEF PATCH_GH} { for DEBUG, It was moved to gears.pp } + PC: GearPtr; +{$ELSE PATCH_GH} Old_Grabbed_Gear,PC: GearPtr; +{$ENDIF PATCH_GH} VCode,VC2: LongInt; SV: LongInt; SMsg,S2: String; begin +{$IFDEF PATCH_GH} { for DEBUG, It was moved to gears.pp } + { Save the grabbed gear, to restore it later. } + if Old_Grabbed_Gear_StackLevel <= MAX_Old_Grabbed_Gear_StackLevel then begin + Old_Grabbed_Gear[Old_Grabbed_Gear_StackLevel] := Grabbed_Gear; + end; + Inc(Old_Grabbed_Gear_StackLevel); +{$ELSE PATCH_GH} { Save the grabbed gear, to restore it later. } Old_Grabbed_Gear := Grabbed_Gear; +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ScriptValue() push'); +{$ENDIF DEBUG} SMsg := UpCase(ExtractWord( Event )); SV := 0; @@ -759,6 +1087,9 @@ begin SV := ScriptValue( Event , gb , scene ); end else if ( SMsg = 'GNATT' ) then begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ScriptValue() GNATT'); +{$ENDIF DEBUG} { Get a Numeric Attribute from the currently grabbed gear. } VCode := ScriptValue( Event , GB , Scene ); VC2 := ScriptValue( Event , GB , Scene ); @@ -767,6 +1098,9 @@ begin end; end else if ( SMsg = 'GSTAT' ) then begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ScriptValue() GSTAT'); +{$ENDIF DEBUG} { Get a Numeric Attribute from the currently grabbed gear. } VCode := ScriptValue( Event , GB , Scene ); if ( Grabbed_Gear <> Nil ) then begin @@ -820,6 +1154,15 @@ begin if ( GB <> Nil ) and ( GB^.Scene <> Nil ) and IsSubCom( GB^.Scene ) then begin SV := GB^.Scene^.S; end; +{$IFDEF PATCH_GH} + if (GB^.Scene^.G <= GG_DisposeGear) then begin + {$IFDEF DEBUG} + ErrorMessage_fork( 'ERROR: SceneID, GG_DisposeGear.' ); + DialogMsg( 'ERROR: SceneID, GG_DisposeGear.' ); + {$ENDIF DEBUG} + SV := 0; + end; +{$ENDIF PATCH_GH} end else if ( SMsg = 'FACMEM' ) then begin { Return the number of members of the requested faction. } @@ -962,12 +1305,30 @@ begin if ( SV = 0 ) and ( S2 <> '' ) and ( S2 <> '0' ) then begin DialogMsg( 'WARNING: Script value ' + S2 + ' in ' + GearName( Scene ) ); +{$IFDEF PATCH_GH} + DialogMsg( Make_ErrorMessage_ASL_CONTEXT1(Event) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT2(Event) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT3(Event) ); +{$ELSE PATCH_GH} DialogMsg( 'CONTEXT: ' + event ); +{$ENDIF PATCH_GH} end; end; +{$IFDEF PATCH_GH} { for DEBUG, It was moved to gears.pp } + { Restore the grabbed gear before exiting. } + Dec(Old_Grabbed_Gear_StackLevel); + if Old_Grabbed_Gear_StackLevel <= MAX_Old_Grabbed_Gear_StackLevel then begin + Grabbed_Gear := Old_Grabbed_Gear[Old_Grabbed_Gear_StackLevel]; + Old_Grabbed_Gear[Old_Grabbed_Gear_StackLevel] := NIL; + end; +{$ELSE PATCH_GH} { Restore the grabbed gear before exiting. } Grabbed_Gear := Old_Grabbed_Gear; +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ScriptValue() pop'); +{$ENDIF DEBUG} ScriptValue := SV; end; @@ -981,6 +1342,9 @@ Function AS_GetString( Source: GearPtr; var msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = Source) or (Source^.G <= GG_DisposeGear) then Source := NIL; +{$ENDIF PATCH_GH} if Source <> Nil then begin msg := SAttValue( Source^.SA , Key ); if ( msg = '' ) and ( Source^.G = GG_MetaTerrain ) and ( Source^.S >= 1 ) and ( Source^.S <= NumBasicMetaTerrain ) then begin @@ -1009,6 +1373,9 @@ end; Procedure ProcessExit( var Event: String; GB: GameBoardPtr; Source: GearPtr ); { An exit command has been received. } begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear at here. } +{$ENDIF PATCH_GH} AS_SetExit( GB , ScriptValue( Event , GB , Source ) ); end; @@ -1091,12 +1458,21 @@ var S0,S1,w: String; ID,ID2: LongInt; Part: GearPtr; +{$IFDEF PATCH_I18N} + S1_tail: String; + DItS: Boolean; {Do insert the space, or not.} + CW_I18N: Boolean; {Is the current word I18N ?} +{$ENDIF PATCH_I18N} begin S0 := msg; S1 := ''; while S0 <> '' do begin +{$IFDEF PATCH_I18N} + w := ExtractWord( S0, DItS, CW_I18N ); +{$ELSE PATCH_I18N} w := ExtractWord( S0 ); +{$ENDIF PATCH_I18N} if UpCase( W ) = '\MEK' then begin { Insert the name of a specified gear. } @@ -1200,12 +1576,36 @@ begin ID := ScriptValue( S0 , GB , Scene ); W := TimeString( ID ); - end; +{$IFDEF PATCH_I18N} + end else if UpCase( W ) = '\NAME2' then begin + W := ExtractWord( S0 ); + W := I18N_Name( W, ExtractWord( S0 ) ); + end else if UpCase( W ) = '\NAME' then begin + W := I18N_Name( ExtractWord( S0 ) ); +{$ENDIF PATCH_I18N} + end; + +{$IFDEF PATCH_I18N} + S1_tail := ''; + if ( 1 <= Length(S1) ) then begin + S1_tail := Copy( S1, Length( S1 ), 1 ); + end; + if ( ( 1 <= Length(W) ) and IsPunctuation( W[1] ) ) or ( '$' = S1_tail ) or ( '@' = S1_tail ) then begin +{$ELSE PATCH_I18N} if IsPunctuation( W[1] ) or ( S1[Length(S1)] = '$' ) or ( S1[Length(S1)] = '@' ) then begin +{$ENDIF PATCH_I18N} S1 := S1 + W; end else begin +{$IFDEF PATCH_I18N} + if DItS then begin + S1 := S1 + ' ' + W; + end else begin + S1 := S1 + W; + end; +{$ELSE PATCH_I18N} S1 := S1 + ' ' + W; +{$ENDIF PATCH_I18N} end; end; @@ -1239,6 +1639,9 @@ var C,msg: String; MList,M: SAttPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Source) or (Source^.G <= GG_DisposeGear) then Source := NIL; +{$ENDIF PATCH_GH} { Create the list of possible strings. } MList := Nil; C := AS_GetString( Source , 'C' + msg_label ); @@ -1277,6 +1680,32 @@ begin GetTheMessage := ScriptMessage( head + BStr( idnum ) , GB , Scene ); end; +{$IFDEF PATCH_GH} +Procedure ProcessSetNPC( var Event: String; GB: GameBoardPtr; Scene: GearPtr ); +var + CID: Integer; +begin + CID := ScriptValue( Event, GB, Scene ); + if 0 < CID then begin + if NIL = I_NPC_org then begin + I_NPC_org := I_NPC; + end; + I_NPC := SeekGearByCID( FindRoot(GB^.Scene), CID ); + end else begin + {$IFDEF DEBUG} + ErrorMessage_fork( 'ERROR: NPC not found. ' + Make_ErrorMessage_ASL(Scene,Event) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT1(Event) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT2(Event) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT3(Event) ); + {$ENDIF DEBUG} + DialogMsg( 'ERROR: NPC not found. ' + Make_ErrorMessage_ASL(Scene,Event) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT1(Event) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT2(Event) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT3(Event) ); + end; +end; +{$ENDIF PATCH_GH} + Procedure ProcessPrint( var Event: String; GB: GameBoardPtr; Scene: GearPtr ); { Locate and then print the specified message. } var @@ -1285,6 +1714,9 @@ var begin id := ScriptValue( Event , GB , Scene ); msg := getTheMessage( 'msg', id , GB , Scene ); +{$IFDEF PATCH_I18N} + msg := FormatChatStringByGender( msg, I_NPC ); +{$ENDIF PATCH_I18N} if msg <> '' then DialogMsg( msg ); end; @@ -1296,6 +1728,9 @@ var begin id := ScriptValue( Event , GB , Scene ); msg := getTheMessage( 'msg', id , GB , Scene ); +{$IFDEF PATCH_I18N} + msg := FormatChatStringByGender( msg, I_NPC ); +{$ENDIF PATCH_I18N} if msg <> '' then begin YesNoMenu( GB , msg , '' , '' ); GFCombatDisplay( GB ); @@ -1310,6 +1745,9 @@ var begin id := ScriptValue( Event , GB , Scene ); msg := getTheMessage( 'msg', id , GB , Scene ); +{$IFDEF PATCH_I18N} + msg := FormatChatStringByGender( msg, I_NPC ); +{$ENDIF PATCH_I18N} if ( Scene <> Nil ) then SetSAtt( Scene^.SA , 'MEMO <' + msg + '>' ); end; @@ -1322,6 +1760,9 @@ var begin id := ScriptValue( Event , GB , Scene ); msg := getTheMessage( 'msg' , id , GB , Scene ); +{$IFDEF PATCH_I18N} + msg := FormatChatStringByGender( msg, I_NPC ); +{$ENDIF PATCH_I18N} Adv := GG_LocateAdventure( GB , Scene ); if ( msg <> '' ) and ( Adv <> Nil ) then AddSAtt( Adv^.SA , 'HISTORY' , msg ); end; @@ -1344,6 +1785,9 @@ var msg: String; begin while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G <> GG_AbsolutelyNothing ) then begin StoreSAtt( VList , tabpos + prefix + GearName( Part ) ); msg := ExtendedDescription( Part ); @@ -1353,6 +1797,9 @@ var CheckAlongPath( Part^.InvCom , TabPos + ' ' , InvStr ); CheckAlongPath( Part^.SubCom , TabPos + ' ' , SubStr ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end;{CheckAlongPath} @@ -1376,8 +1823,13 @@ begin { Store the stats. } for t := 1 to 8 do begin +{$IFDEF PATCH_I18N} + msg := I18N_Name( 'StatName', StatName[ t ] ); + while WidthMBcharStr( msg ) < 20 do msg := msg + ' '; +{$ELSE PATCH_I18N} msg := StatName[ t ]; while Length( msg ) < 20 do msg := msg + ' '; +{$ENDIF PATCH_I18N} msg := msg + BStr( PC^.Stat[ T ] ); V := ( PC^.Stat[ T ] + 2 ) div 3; if V > 7 then V := 7; @@ -1405,8 +1857,12 @@ begin { Store the faction and rank. } Fac := GG_LocateFaction( NAttValue( PC^.NA , NAG_Personal , NAS_FactionID ) , GB , Nil ); if Fac <> Nil then begin +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('ProcessVictory','History_Faction'), GearName(Fac), PCRankName(GB , Nil) ); +{$ELSE PATCH_I18N} msg := ReplaceHash( MsgString( 'HISTORY_FACTION' ) , PCRankName( GB , Nil ) ); msg := ReplaceHash( msg , GearName( Fac ) ); +{$ENDIF PATCH_I18N} StoreSAtt( VList , msg ); StoreSAtt( VList , ' ' ); end; @@ -1415,8 +1871,12 @@ begin for t := 1 to Num_Personality_Traits do begin V := NATtValue( PC^.NA , NAG_CharDescription , -T ); if V <> 0 then begin +{$IFDEF PATCH_I18N} + Msg := ReplaceHash( I18N_MsgString('ProcessVictory','History_Traits'), PersonalityTraitDesc(T , V , True), BStr(Abs(V)) ); +{$ELSE PATCH_I18N} Msg := ReplaceHash( MsgString( 'HISTORY_Traits' ) , PersonalityTraitDesc( T , V ) ); Msg := ReplaceHash( msg , BStr( Abs( V ) ) ); +{$ENDIF PATCH_I18N} StoreSAtt( VList , msg ); end; end; @@ -1439,9 +1899,13 @@ begin for t := 1 to NumSkill do begin V := NATtValue( PC^.NA , NAG_Skill , T ); if V > 0 then begin +{$IFDEF PATCH_I18N} + Msg := ReplaceHash( I18N_MsgString('ProcessVictory','History_Skills'), I18N_Name('SkillMan',SkillMan[ T ].Name), BStr(V), BStr(SkillValue(PC , T)) ); +{$ELSE PATCH_I18N} Msg := ReplaceHash( MsgString( 'HISTORY_Skills' ) , SkillMan[ T ].Name ); Msg := ReplaceHash( msg , BStr( V ) ); Msg := ReplaceHash( msg , BStr( SkillValue( PC , T ) ) ); +{$ENDIF PATCH_I18N} StoreSAtt( VList , msg ); end; end; @@ -1474,6 +1938,9 @@ begin { Add info on the PC's mechas. } PC := GB^.Meks; while PC <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < PC^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( PC^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and ( PC^.G = GG_Mecha ) then begin StoreSAtt( VList , FullGearName( PC ) ); @@ -1482,6 +1949,9 @@ begin StoreSAtt( VList , ' ' ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} PC := PC^.Next; end; @@ -1499,6 +1969,9 @@ var begin id := ScriptValue( Event , GB , Scene ); msg := getTheMessage( 'msg' , id , GB , Scene ); +{$IFDEF PATCH_I18N} + msg := FormatChatStringByGender( msg, I_NPC ); +{$ENDIF PATCH_I18N} if ( msg <> '' ) and ( Scene <> Nil ) then SetSAtt( Scene^.SA , 'NEWS <' + msg + '>' ); end; @@ -1511,9 +1984,18 @@ var begin id := ScriptValue( Event , GB , Scene ); msg := getTheMessage( 'msg' , id , GB , Scene ); +{$IFDEF PATCH_I18N} + msg := FormatChatStringByGender( msg, I_NPC ); +{$ENDIF PATCH_I18N} if ( msg <> '' ) and ( Scene <> Nil ) then SetSAtt( Scene^.SA , 'EMAIL <' + msg + '>' ); PC := GG_LocatePC( GB ); if ( PC <> Nil ) and HasPCommCapability( PC , PCC_EMail ) then DialogMsg( MsgString( 'AS_EMail' ) ); +{$IFDEF PATCH_GH} + if NIL <> I_NPC_org then begin + I_NPC := I_NPC_org; + I_NPC_org := NIL; + end; +{$ENDIF PATCH_GH} end; Procedure ProcessValueMessage( var Event: String; GB: GameBoardPtr; Scene: GearPtr ); @@ -1550,6 +2032,9 @@ begin id := ScriptValue( Event , GB , Source ); msg := getTheMessage( 'msg' , id , GB , Source ); +{$IFDEF PATCH_I18N} + msg := FormatChatStringByGender( msg, I_NPC ); +{$ENDIF PATCH_I18N} if msg <> '' then begin {$IFDEF SDLMODE} NFGameMsg( msg , ZONE_InteractMsg , InfoHiLight ); @@ -1566,6 +2051,9 @@ var N: Integer; Msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = Source) or (Source^.G <= GG_DisposeGear) then Source := NIL; +{$ENDIF PATCH_GH} { Error check - this command can only work if the IntMenu is } { already allocated. } if ( IntMenu <> Nil ) and ( Source <> Nil ) then begin @@ -1574,21 +2062,47 @@ begin msg := getthemessage( 'PROMPT' , N , GB , Source ); DeleteWhiteSpace( msg ); +{$IFDEF PATCH_I18N} + msg := FormatChatStringByGender( msg, I_PC ); +{$ENDIF PATCH_I18N} if Msg <> '' then begin +{$IFDEF PATCH_CHEAT} + if Cheat_Chat_ReverseSort then begin + PushRPGMenuItemFront( IntMenu , Msg , N ); + end else begin + AddRPGMenuItem( IntMenu , Msg , N ); + end; +{$ELSE PATCH_CHEAT} AddRPGMenuItem( IntMenu , Msg , N ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} RPMSortAlpha( IntMenu ); +{$ENDIF PATCH_I18N} end; end; end; +{$IFDEF PATCH_I18N} +Procedure ProcessSayAnything( NPC: GearPtr ); +{$ELSE} Procedure ProcessSayAnything; +{$ENDIF} { Print a random message in the interact message area. } begin {$IFDEF SDLMODE} +{$IFDEF PATCH_I18N} + CHAT_Message := IdleChatter( NPC ); +{$ELSE} CHAT_Message := IdleChatter; +{$ENDIF} +{$ELSE} +{$IFDEF PATCH_I18N} + GameMsg( IdleChatter( NPC ) , ZONE_InteractMsg , InfoHiLight ); {$ELSE} GameMsg( IdleChatter , ZONE_InteractMsg , InfoHiLight ); {$ENDIF} +{$ENDIF} end; Procedure ProcessGSetNAtt( var Event: String; GB: GameBoardPtr; Scene: GearPtr ); @@ -1598,11 +2112,21 @@ var G,S: Integer; V: LongInt; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGSetNAtt()'); +{$ENDIF DEBUG} + { Find the variable ID number and the value to assign. } G := ScriptValue( event , GB , scene ); S := ScriptValue( event , GB , scene ); V := ScriptValue( event , GB , scene ); +{$IFDEF DEBUG} + if Debug_On then begin + ErrorMessage_fork( 'GAddNAtt: ' + GearName( Grabbed_Gear ) + ' ' + BStr( G ) + '/' + BStr( S ) + '/' + BStr( V ) ); + end; +{$ELSE DEBUG} if Debug_On then dialogmsg( 'GAddNAtt: ' + GearName( Grabbed_Gear ) + ' ' + BStr( G ) + '/' + BStr( S ) + '/' + BStr( V ) ); +{$ENDIF DEBUG} if Grabbed_Gear <> Nil then SetNAtt( Grabbed_Gear^.NA , G , S , V ); end; @@ -1614,11 +2138,21 @@ var G,S: Integer; V: LongInt; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGAddNAtt()'); +{$ENDIF DEBUG} + { Find the variable ID number and the value to assign. } G := ScriptValue( event , GB , scene ); S := ScriptValue( event , GB , scene ); V := ScriptValue( event , GB , scene ); +{$IFDEF DEBUG} + if Debug_On then begin + ErrorMessage_fork( 'GAddNAtt: ' + GearName( Grabbed_Gear ) + ' ' + BStr( G ) + '/' + BStr( S ) + '/' + BStr( V ) ); + end; +{$ELSE DEBUG} if Debug_On then dialogmsg( 'GAddNAtt: ' + GearName( Grabbed_Gear ) + ' ' + BStr( G ) + '/' + BStr( S ) + '/' + BStr( V ) ); +{$ENDIF DEBUG} if Grabbed_Gear <> Nil then AddNAtt( Grabbed_Gear^.NA , G , S , V ); end; @@ -1629,6 +2163,10 @@ Procedure ProcessGSetStat( var Event: St var Slot,Value: Integer; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGSetStat()'); +{$ENDIF DEBUG} + { Find the variable ID number and the value to assign. } Slot := ScriptValue( event , GB , scene ); Value := ScriptValue( event , GB , scene ); @@ -1642,6 +2180,10 @@ Procedure ProcessGAddStat( var Event: St var Slot,Value: Integer; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGAddStat()'); +{$ENDIF DEBUG} + { Find the variable ID number and the value to assign. } Slot := ScriptValue( event , GB , scene ); Value := ScriptValue( event , GB , scene ); @@ -1654,6 +2196,10 @@ Procedure ProcessGSetSAtt( var Event: St var Key,Info: String; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGSetSAtt()'); +{$ENDIF DEBUG} + Key := ExtractWord( Event ); Info := ExtractWord( Event ); if Source <> Nil then Info := AS_GetString( Source , Info ); @@ -1666,6 +2212,12 @@ Procedure IfSuccess( var Event: String ) var cmd: String; begin +{$IFDEF DEBUG} + if DEBUG_TraceMacro then begin + ErrorMessage_fork( 'TRACE: IfSuccess() "' + Event + '"' ); + end; +{$ENDIF DEBUG} + { Extract the next word from the script. } cmd := ExtractWord( Event ); @@ -1681,6 +2233,12 @@ Procedure IfFailure( var Event: String; var cmd: String; begin +{$IFDEF DEBUG} + if DEBUG_TraceMacro then begin + ErrorMessage_fork( 'TRACE: IfFailure() "' + Event + '"' ); + end; +{$ENDIF DEBUG} + { Extract the next word from the script. } cmd := ExtractWord( Event ); @@ -1689,6 +2247,9 @@ begin { specified script line. } cmd := ExtractWord( Event ); Event := AS_GetString( Scene , CMD ); +{$IFDEF PATCH_GH} + DEBUG_cmd_org2 := Event; { for DEBUG } +{$ENDIF PATCH_GH} end else begin { There's no ELSE clause. Just cease execution of this } @@ -1701,6 +2262,10 @@ Procedure ProcessIfGInPlay( var Event: S { Return true if the Grabbed_Gear is on the map and operational. } { Return false otherwise. } begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessIfGInPlay()'); +{$ENDIF DEBUG} + if ( Grabbed_Gear <> Nil ) and OnTheMap( Grabbed_Gear ) and GearOperational( Grabbed_Gear ) then begin IfSuccess( Event ); end else begin @@ -1712,6 +2277,10 @@ Procedure ProcessIfGOK( var Event: Strin { If the grabbed gear is OK, count as true. If it is destroyed, } { or if it can't be found, count as false. } begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessIfGOK()'); +{$ENDIF DEBUG} + if ( Grabbed_Gear <> Nil ) and NotDestroyed( Grabbed_Gear ) then begin IfSuccess( Event ); end else IfFailure( Event , Source ); @@ -1723,6 +2292,10 @@ Procedure ProcessIfGSexy( var Event: Str var PC: GearPtr; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessIfGSexy()'); +{$ENDIF DEBUG} + PC := GG_LOcatePC( GB ); if ( Grabbed_Gear <> Nil ) and ( PC <> Nil ) and IsSexy( PC , Grabbed_Gear ) then begin IfSuccess( Event ); @@ -1735,6 +2308,10 @@ Procedure ProcessIfGArchEnemy( var Event var Adv: GearPtr; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessIfGArchEnemy()'); +{$ENDIF DEBUG} + Adv := GG_LOcateAdventure( GB , Source ); if ( Grabbed_Gear <> Nil ) and ( Adv <> Nil ) and IsArchEnemy( Adv , Grabbed_Gear ) then begin IfSuccess( Event ); @@ -1747,6 +2324,10 @@ Procedure ProcessIfGArchAlly( var Event: var Adv: GearPtr; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessIfGArchAlly()'); +{$ENDIF DEBUG} + Adv := GG_LOcateAdventure( GB , Source ); if ( Grabbed_Gear <> Nil ) and ( Adv <> Nil ) and IsArchAlly( Adv , Grabbed_Gear ) then begin IfSuccess( Event ); @@ -1779,6 +2360,9 @@ Procedure ProcessIfStoryless( var Event: var story: GearPtr; begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear at here. } +{$ENDIF PATCH_GH} if Source <> Nil then begin story := Source^.InvCom; while ( story <> Nil ) and ( story^.G <> GG_Story ) do story := story^.Next; @@ -1855,6 +2439,9 @@ begin PC := GB^.Meks; while PC <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < PC^.G) then begin +{$ENDIF PATCH_GH} { If this gear belongs to the player team, check it } { for the wanted item. } if NAttValue( PC^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam then begin @@ -1865,6 +2452,9 @@ begin else if SeekGearByIDTag( PC^.SubCom , NAG_Narrative , NAS_NID , NID ) <> Nil then FoundTheItem := True else if SeekGearByIDTag( PC^.InvCom , NAG_Narrative , NAS_NID , NID ) <> Nil then FoundTheItem := True; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} { Move to the next gear to check. } PC := PC^.Next; @@ -1893,6 +2483,12 @@ begin id := ScriptValue( Event , GB , Source ); NoPrompt := GetTheMessage( 'msg' , id , GB , Source ); +{$IFDEF PATCH_I18N} + Desc := FormatChatStringByGender( Desc , I_NPC ); + YesPrompt := FormatChatStringByGender( YesPrompt, I_PC ); + NoPrompt := FormatChatStringByGender( NoPrompt , I_PC ); +{$ENDIF PATCH_I18N} + it := YesNoMenu( GB , Desc , YesPrompt , NoPrompt ); if it then IfSuccess( Event ) @@ -1953,6 +2549,9 @@ var Mek: GearPtr; P: Array [1..2] of Integer; begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear at here. } +{$ENDIF PATCH_GH} { Record the team number. } Team := ScriptValue( Event , gb , Source ); @@ -1971,6 +2570,9 @@ begin { of the specified team, assign the specified order. } Mek := gb^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = Team then begin SetNAtt( Mek^.NA , NAG_EpisodeData , NAS_Orders , OrderCode ); @@ -1983,6 +2585,9 @@ begin SetNAtt( Mek^.NA , NAG_Location , NAS_GY , P[2] ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; end; @@ -1994,6 +2599,9 @@ var Trigger,Ev2: String; P: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Source) or (Source^.G <= GG_DisposeGear) then Source := NIL; +{$ENDIF PATCH_GH} if Source = Nil then exit; { Extract the values we need. } @@ -2006,10 +2614,18 @@ end; Procedure ProcessNewChat; { Reset the dialog menu with the standard options. } +{$IFDEF PATCH_I18N} +var + msg_chat, msg_bye, msg_join, msg_quit: String; +{$ENDIF PATCH_I18N} begin { Error check - make sure the interaction menu is active. } if IntMenu = Nil then begin Exit; +{$IFDEF PATCH_GH} + if (NIL = I_PC) or (I_PC^.G <= GG_DisposeGear) then I_PC := NIL; + if (NIL = I_NPC) or (I_NPC^.G <= GG_DisposeGear) then I_NPC := NIL; +{$ENDIF PATCH_GH} { If there are any menu items currently in the list, get rid } { of them. } @@ -2017,11 +2633,25 @@ begin ClearMenu( IntMenu ); end; +{$IFDEF PATCH_I18N} + msg_chat := I18N_MsgString('ProcessNewChat','Chat'); + msg_bye := I18N_MsgString('ProcessNewChat','Goodbye'); + msg_join := I18N_MsgString('ProcessNewChat','Join'); + msg_quit := I18N_MsgString('ProcessNewChat','Quit Lance'); + + AddRPGMenuItem( IntMenu , msg_chat , CMD_Chat ); + if ( I_NPC <> Nil ) and ( NAttValue( I_NPC^.NA , NAG_Relationship , 0 ) > 0 ) and ( NAttValue( I_NPC^.NA , NAG_Location , NAS_Team ) <> NAV_LancemateTeam ) then AddRPGMenuItem( IntMenu , msg_join , CMD_Join ); + if ( I_NPC <> Nil ) and ( NAttValue( I_NPC^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) then AddRPGMenuItem( IntMenu , msg_quit , CMD_Quit ); + AddRPGMenuItem( IntMenu , msg_bye , -1 ); + { If PATCH_I18N defined, sorting makes the menu confusing. } + { RPMSortAlpha( IntMenu ); } +{$ELSE PATCH_I18N} AddRPGMenuItem( IntMenu , '[Chat]' , CMD_Chat ); AddRPGMenuItem( IntMenu , '[Goodbye]' , -1 ); if ( I_NPC <> Nil ) and ( NAttValue( I_NPC^.NA , NAG_Relationship , 0 ) > 0 ) and ( NAttValue( I_NPC^.NA , NAG_Location , NAS_Team ) <> NAV_LancemateTeam ) then AddRPGMenuItem( IntMenu , '[Join]' , CMD_Join ); if ( I_NPC <> Nil ) and ( NAttValue( I_NPC^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) then AddRPGMenuItem( IntMenu , '[Quit Lance]' , CMD_Quit ); RPMSortAlpha( IntMenu ); +{$ENDIF PATCH_I18N} end; Procedure ProcessEndChat; @@ -2042,6 +2672,9 @@ Procedure ProcessGoto( var Event: String var destination: String; begin +{$IFDEF PATCH_GH} + if (NIL = Source) or (Source^.G <= GG_DisposeGear) then Source := NIL; +{$ENDIF PATCH_GH} { Error check- if there's no defined source, we can't very } { well jump to another line, can we? } if Source = Nil then begin @@ -2053,6 +2686,9 @@ begin if destination <> '' then begin { Change the event script to the requested line. } Event := AS_GetString( Source , destination ); +{$IFDEF PATCH_GH} + DEBUG_cmd_org2 := Event; { for DEBUG } +{$ENDIF PATCH_GH} end else begin { No label was provided. Just return a blank line. } Event := ''; @@ -2109,6 +2745,118 @@ begin ExpressDelivery( GB , I_PC , I_NPC ); end; +{$IFDEF PATCH_GH} +Procedure ProcessAdvancePlot( var Event: String; GB: GameBoardPtr; Source: GearPtr ); + { This particular plot is over- mark it for deletion. } + { First, though, check to see if there are any subcomponents that } + { need to be moved around. } +var + N: Integer; +begin + { Don't kick out the GG_DisposeGear at here. } + { Determine which sub-plot to advance to. } + N := ScriptValue( event , GB , Source ); + + { If we have a valid SOURCE, attempt to advance the plot. } + if ( Source <> Nil ) then begin + if (GG_AbsolutelyNothing <> Source^.G) then begin + Current_PlotMaster := PlotMaster( Source ); + Current_StoryMaster := StoryMaster( Source ); + end; + { It's possible that our SOURCE is a PERSONA rather than } + { a PLOT, so if SOURCE isn't a PLOT move to its parent. } + Source := PlotMaster( Source ); + if ( Source <> Nil ) and ( Source^.G = GG_Plot ) then AdvancePlot( GB , Source^.Parent , Source , N ); + end; +end; + +Procedure CleanupStoryPlots( GB: GameBoardPtr; Story: GearPtr ); + { Give a CLEANUP trigger to all the story plots, then move the } + { plots which survive to the adventure invcoms. } +var + T: String; + Part, P2, Adv: GearPtr; +begin + { Send a CLEANUP trigger to the invcoms. } + { This should erase all the plots that want to be erased, } + { and leave all the plots which want to be moved. } + T := 'CLEANUP'; + CheckTriggerAlongPath( T , GB , Story^.InvCom , False ); + + { Check whatever is left over. } + Part := Story^.InvCom; + Adv := GG_LocateAdventure( GB , Story ); + while (NIL <> Part) do begin + P2 := Part^.Next; + + if (GG_Plot = Part^.G) then begin + if (NIL <> Adv) then begin + DelinkGear( Story^.InvCom , Part ); + InsertInvCom( Adv , Part ); + end else begin + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_CleanupStoryPlots then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('CleanupStoryPlots()', Part, False ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + Mark_GG_DisposeGear_withNext( Part ); + end; + end; + + Part := P2; + end; +end; + +Procedure ProcessEndStory( GB: GameBoardPtr; Source: GearPtr ); + { This particular story is over- mark it for deletion. } + { First, though, pass a CLEANUP trigger to any subcomponents that } + { may need to be cleaned up. } +begin + { Don't kick out the GG_DisposeGear at here. } + Source := StoryMaster( Source ); + if (NIL <> Source) and (GG_Story = Source^.G) then begin + if (GG_AbsolutelyNothing <> Source^.G) then begin + Current_StoryMaster := StoryMaster( Source ); + end; + + CleanupStoryPlots( GB , Source ); + + { Mark the story for deletion. } + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_EndStory then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('ProcessEndStory()', Source, False ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + Source^.G := GG_AbsolutelyNothing; + + Require_GFCombatDisplay := True; + end; +end; + +Procedure ProcessPurgeStory( GB: GameBoardPtr; Source: GearPtr ); + { Eliminate all plots from this story. } +begin + { Don't kick out the GG_DisposeGear at here. } + { If we have a valid SOURCE, check the invcoms. } + if (NIL <> Source) and (GG_Story = Source^.G) then begin + if (GG_AbsolutelyNothing <> Source^.G) then begin + Current_StoryMaster := StoryMaster( Source ); + end; + + { Send a CLEANUP trigger to the invcoms, } + { then move the survivors to the Adventure. } + CleanupStoryPlots( GB , Source ); + + Require_GFCombatDisplay := True; + end; +end; +{$ELSE PATCH_GH} Procedure ProcessAdvancePlot( var Event: String; GB: GameBoardPtr; Source: GearPtr ); { This particular plot is over- mark it for deletion. } { First, though, check to see if there are any subcomponents that } @@ -2184,6 +2932,7 @@ begin CleanupStoryPlots( GB , Source ); end; end; +{$ENDIF PATCH_GH} Procedure ProcessTReputation( var Event: String; GB: GameBoardPtr; Source: GearPtr ); { Something has happened to affect the PC's reputation. } @@ -2239,8 +2988,42 @@ end; Procedure ProcessDeleteGG( GB: GameBoardPtr; var Source: GearPtr ); { Delete the grabbed gear. } { Only physical gears can be deleted in this way. } +{$IFDEF PATCH_GH} +var + Target: GearPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessDeleteGG()'); +{$ENDIF DEBUG} + if ( Grabbed_Gear <> Nil ) and ( Grabbed_Gear^.G >= 0 ) then begin +{$IFDEF PATCH_GH} + Target := Grabbed_Gear; + Grabbed_Gear := NIL; + + { Make sure we aren't currently using the grabbed gear. } + if ( IntMenu <> Nil ) and ( I_NPC = Target ) then begin + ProcessEndChat; + I_NPC := Nil; + end; + if Source = Target then begin + Source := Nil; + end; + + { Delete the gear, if it can be found. } + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_DelegeGG then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('ProcessDeleteGG()', Target, False ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + Mark_GG_DisposeGear( Target ); + + Require_GFCombatDisplay := True; +{$ELSE PATCH_GH} { Make sure we aren't currently using the grabbed gear. } if ( IntMenu <> Nil ) and ( I_NPC = Grabbed_Gear ) then begin ProcessEndChat; @@ -2261,6 +3044,7 @@ begin RemoveGear( GB^.Meks , Grabbed_Gear ); end; +{$ENDIF PATCH_GH} end; end; @@ -2273,6 +3057,10 @@ var Scene: GearPtr; P: Point; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessMoveGG()'); +{$ENDIF DEBUG} + { Check to make sure we have a valid gear to move. } if ( Grabbed_Gear <> Nil ) and ( Grabbed_Gear^.G >= 0 ) then begin { Attach useful scene-specific information to this gear. } @@ -2324,6 +3112,10 @@ var Scene: GearPtr; P: Point; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessDeployGG()'); +{$ENDIF DEBUG} + { Check to make sure we have a valid gear to move. } if ( Grabbed_Gear <> Nil ) and ( GB <> Nil ) and ( Grabbed_Gear^.G >= 0 ) then begin { Attach useful scene-specific information to this gear. } @@ -2363,6 +3155,27 @@ begin end; end; +{$IFDEF PATCH_GH} +Procedure ProcessDeployGGOnMap( var Event: String; GB: GameBoardPtr; Source: GearPtr ); + { Deploy the grabbed gear to the current map. } +var + P: Point; +begin + {$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessDeployGGOnMap()'); + {$ENDIF DEBUG} + + if Grabbed_Gear <> Nil then begin + P := FindDeploymentSpot( GB , Grabbed_Gear ); + SetNAtt( Grabbed_Gear^.NA , NAG_Location , NAS_X , P.X ); + SetNAtt( Grabbed_Gear^.NA , NAG_Location , NAS_Y , P.Y ); + SetNAtt( Grabbed_Gear^.NA , NAG_Location , NAS_D , Random( 8 ) ); + + Require_GFCombatDisplay := True; + end; +end; +{$ENDIF PATCH_GH} + Procedure ProcessDynaGG( var Event: String; GB: GameBoardPtr; Source: GearPtr ); { Move the grabbed gear to the dynamic scene. } { Only physical gears can be moved in this way. } @@ -2371,7 +3184,17 @@ var TID: Integer; { Scene ID, Team ID. } Scene: GearPtr; P: Point; -begin +{$IFDEF PATCH_GH} + ErrMsg: String; +{$ENDIF PATCH_GH} +begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessDynaGG()'); +{$ENDIF DEBUG} +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('ProcessDynaGG()'); +{$ENDIF DEBUG} + { Check to make sure we have a valid gear to move. } if ( Grabbed_Gear <> Nil ) and ( Grabbed_Gear^.G >= 0 ) and ( SCRIPT_DynamicEncounter <> Nil ) then begin { Attach useful scene-specific information to this gear. } @@ -2416,6 +3239,36 @@ begin { Perform the insertion. } InsertNPCIntoDynamicScene( Grabbed_Gear , SCRIPT_DynamicEncounter , TID ); +{$IFDEF PATCH_GH} + end else begin + ErrMsg := 'ERROR: '; + if (NIL <> Grabbed_Gear) then begin + if (Grabbed_Gear^.G < 0) then begin + ErrMsg := ErrMsg + 'Grabbed_Gear is disposed (' + IntToStr(Grabbed_Gear^.G) + '), '; + end; + end else begin + ErrMsg := ErrMsg + 'Grabbed_Gear is NIL, '; + end; + if (NIL = SCRIPT_DynamicEncounter) then begin + ErrMsg := ErrMsg + 'SCRIPT_DynamicEncounter is NIL, '; + end; + {$IFDEF DEBUG} + ErrorMessage( ErrMsg + 'at DynaGG. ' + Make_ErrorMessage_ASL(Source,Event) ); + ErrorMessage( Make_ErrorMessage_ASL_CONTEXT1('') ); + ErrorMessage( Make_ErrorMessage_ASL_CONTEXT2('') ); + ErrorMessage( Make_ErrorMessage_ASL_CONTEXT3('') ); + {$ENDIF DEBUG} + DialogMsg( ErrMsg + 'at DynaGG. ' + Make_ErrorMessage_ASL(Source,Event) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT1('') ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT2('') ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT3('') ); + + TID := ScriptValue( Event , GB , Source ); + {$IFDEF DEBUG} + ErrorMessage( 'TID is ' + IntToStr(TID) + '.' ); + {$ENDIF DEBUG} + DialogMsg( 'TID is ' + IntToStr(TID) + '.' ); +{$ENDIF PATCH_GH} end; end; @@ -2425,7 +3278,14 @@ Procedure ProcessGiveGG( GB: GameBoardPt var DelinkOK: Boolean; PC: GearPtr; -begin +{$IFDEF PATCH_GH} + NID: LongInt; +{$ENDIF PATCH_GH} +begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGiveGG()'); +{$ENDIF DEBUG} + PC := GG_LocatePC( GB ); if ( Grabbed_Gear <> Nil ) and ( Grabbed_Gear^.G >= 0 ) and (( PC = Nil ) or ( FindGearIndex( Grabbed_Gear , PC ) < 0 )) then begin @@ -2445,6 +3305,21 @@ begin end; if DelinkOK then begin +{$IFDEF PATCH_GH} + if IsLegalSlot( PC, Grabbed_Gear ) then begin + { Clear the item's location values. } + StripNAtt( Grabbed_Gear, NAG_Location ); + if NAttValue( Grabbed_Gear^.NA, NAG_ParaLocation, NAS_OriginalHome ) < 0 then begin + StripNAtt( Grabbed_Gear, NAG_ParaLocation ); + end; + if 0 < Length(SAttValue( Grabbed_Gear^.SA, 'HOME' )) then begin + SetSAtt( Grabbed_Gear^.SA, 'HOME <>' ); + end; + { Execute the Trigger. } + NID := NAttValue( Grabbed_Gear^.NA, NAG_Narrative, NAS_NID ); + if (0 <> NID) then SetTrigger( GB, TRIGGER_GetItem + BStr(NID) ); + end; +{$ENDIF PATCH_GH} GivePartToPC( GB , Grabbed_Gear , PC ); end; end; @@ -2457,7 +3332,14 @@ Procedure ProcessGNewPart( var Event: St { file, then the NPC file. } var IName: String; +{$IFDEF PATCH_GH} + Msg: String; +{$ENDIF PATCH_GH} begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGNewPart() old'); +{$ENDIF DEBUG} + { First determine the item's designation. } IName := ExtractWord( Event ); if Source <> Nil then begin @@ -2466,9 +3348,23 @@ begin { As long as we have a GB, try to stick the item there. } if GB <> Nil then begin +{$IFDEF PATCH_GH} + Grabbed_Gear := LoadNewSTC_withoutErrorCheck( IName ); + if Grabbed_Gear = Nil then Grabbed_Gear := LoadNewMonster_withoutErrorCheck( IName ); + if Grabbed_Gear = Nil then Grabbed_Gear := LoadNewNPC_withoutErrorCheck( IName ); + if ( NIL = Grabbed_Gear ) then begin + Msg := 'ERROR: ProcessGNewPart failed : ' + IName; + ErrorMessage_fork( Msg ); + DialogMsg( Msg ); + end; +{$ELSE PATCH_GH} Grabbed_Gear := LoadNewSTC( IName ); if Grabbed_Gear = Nil then Grabbed_Gear := LoadNewMonster( IName ); if Grabbed_Gear = Nil then Grabbed_Gear := LoadNewNPC( IName ); +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGNewPart() new'); +{$ENDIF DEBUG} { If we found something, stick it on the map. } if Grabbed_Gear <> Nil then begin @@ -2680,9 +3576,17 @@ Procedure BuildGenericEncounter( GB: Gam var Team: GearPtr; begin +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('BuildGenericEncounter() old'); +{$ENDIF DEBUG} + { First, if for some reason there's already a dynamic encounter in } { place, get rid of it. } +{$IFDEF PATCH_GH} + Dispose_SCRIPT_DynamicEncounter(); +{$ELSE PATCH_GH} if SCRIPT_DynamicEncounter <> Nil then DisposeGear( SCRIPT_DynamicEncounter ); +{$ENDIF PATCH_GH} { Allocate a new dynamic encounter, then fill in the blanks. } SCRIPT_DynamicEncounter := NewGear( Nil ); @@ -2726,6 +3630,10 @@ begin { Advance the game clock by one hour. } QuickTime( GB , AP_HalfHour + RollStep( 35 ) * 5 ); end; + +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('BuildGenericEncounter() new'); +{$ENDIF DEBUG} end; Procedure ProcessNewD( var Event: String; GB: GameBoardPtr; Source: GearPtr ); @@ -2743,9 +3651,17 @@ Procedure ProcessLoadD( var Event: Strin var FName: String; begin +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('ProcessLoadD() old'); +{$ENDIF DEBUG} + { First, if for some reason there's already a dynamic encounter in } { place, get rid of it. } +{$IFDEF PATCH_GH} + Dispose_SCRIPT_DynamicEncounter(); +{$ELSE PATCH_GH} if SCRIPT_DynamicEncounter <> Nil then DisposeGear( SCRIPT_DynamicEncounter ); +{$ENDIF PATCH_GH} { First, find the file name of the scene file to look for. } FName := ExtractWord( Event ); @@ -2781,11 +3697,21 @@ begin end; end else begin +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('ProcessLoadD() tmp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + Dispose_SCRIPT_DynamicEncounter(); +{$ELSE PATCH_GH} DisposeGear( SCRIPT_DynamicEncounter ); +{$ENDIF PATCH_GH} end; end; +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('ProcessLoadD() new'); +{$ENDIF DEBUG} end; { ProcessLoadD } Procedure ProcessTStockD( var Event: String; GB: GameBoardPtr; Source: GearPtr ); @@ -2793,6 +3719,10 @@ Procedure ProcessTStockD( var Event: Str var TID,UPV: LongInt; begin +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('ProcessTStockD()'); +{$ENDIF DEBUG} + { Find out the team, and how many enemies to add. } TID := ScriptValue( Event , GB , Source ); UPV := ScriptValue( Event , GB , Source ); @@ -2846,6 +3776,10 @@ var TID,UPV: LongInt; MDesc: String; begin +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('ProcessTMStockD()'); +{$ENDIF DEBUG} + { Find out the team, and how many enemies to add. } TID := ScriptValue( Event , GB , Source ); UPV := ScriptValue( Event , GB , Source ); @@ -2878,6 +3812,10 @@ var EChance,AChance: Integer; MainDesc: String; begin +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('ProcessEncounter()'); +{$ENDIF DEBUG} + { Error check - make sure everything is defined first. } if ( SCRIPT_DynamicEncounter = Nil ) or ( GB = Nil ) or ( GB^.Scene = Nil ) or ( Source = Nil ) then exit; @@ -2998,8 +3936,13 @@ begin N := ScriptValue( Event , GB , Source ); { Final error check- based on the config options, maybe exit. } +{$IFDEF PATCH_GH} + if Load_Plots_At_Start and ( UpCase( Trigger ) <> UpCase(TRIGGER_StartGame) ) then exit + else if ( not Load_Plots_At_Start ) and ( UpCase( Trigger ) = UpCase(TRIGGER_StartGame) ) then exit; +{$ELSE PATCH_GH} if Load_Plots_At_Start and ( UpCase( Trigger ) <> 'START' ) then exit else if ( not Load_Plots_At_Start ) and ( UpCase( Trigger ) = 'START' ) then exit; +{$ENDIF PATCH_GH} for t := 1 to N do begin { Secondly, confirm the file name. } @@ -3195,8 +4138,15 @@ begin end else begin RemoveSAtt( TempSceneList , TS ); end; +{$IFDEF PATCH_GH} + PurgeSAtt( SceneList ); + PurgeSAtt( TempSceneList ); +{$ENDIF PATCH_GH} end; RemoveSAtt( FList , F ); +{$IFDEF PATCH_GH} + PurgeSAtt( FList ); +{$ENDIF PATCH_GH} end; if FList <> Nil then DisposeSAtt( FList ); @@ -3249,6 +4199,9 @@ begin { Loop through every mek on the board. } Mek := GB^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if NotDestroyed( Mek ) and ( not GearOperational( Mek ) ) then begin { Remove any pilots that may be in the mek... } repeat @@ -3271,6 +4224,9 @@ begin AppendGear( GB^.Meks , M2 ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; end; @@ -3293,12 +4249,18 @@ begin { Loop through every mek on the board. } Mek := GB^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if GearOperational( Mek ) and ( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = Team ) then begin P := GearCurrentLocation( Mek ); SetNAtt( Mek^.NA , NAG_Location , NAS_X , 0 ); SetNAtt( Mek^.NA , NAG_Location , NAS_Y , 0 ); RedrawTile( GB , P.X , P.Y ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; @@ -3318,9 +4280,15 @@ begin { Loop through every mek on the board. } Mek := GB^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if GearOperational( Mek ) and ( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) <> NAV_DefPlayerTeam ) then begin SetNAtt( Mek^.NA , NAG_EpisodeData , NAS_Orders , NAV_RunAway ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; end; @@ -3332,12 +4300,19 @@ var Mek,NPC: GearPtr; P: Point; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGRunAway()'); +{$ENDIF DEBUG} + { ERROR CHECK - GB must be defined!!! } if ( GB = Nil ) or ( Grabbed_Gear = Nil ) then Exit; { Loop through every mek on the board. } Mek := GB^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if Mek = Grabbed_Gear then begin P := GearCurrentLocation( Mek ); SetNAtt( Mek^.NA , NAG_Location , NAS_X , 0 ); @@ -3358,6 +4333,9 @@ begin SetTrigger( GB , TRIGGER_NumberOfUnits + BStr( NAttValue( MEK^.NA , NAG_Location , NAS_Team ) ) ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; end; @@ -3414,11 +4392,26 @@ var if S <> '' then SetSAtt( Source^.SA , tag + ' <' + S + '>' ); end; begin +{$IFDEF PATCH_GH} + if (NIL = Source) then Exit; +{$ENDIF PATCH_GH} + { Find out which aspect to change to. } N := ScriptValue( Event , GB , Source ); {Switch all known dispay descriptors. } SwapSAtts( 'ROGUECHAR' ); +{$IFDEF PATCH_I18N} + SwapSAtts( 'NAME_ORG' ); + {$IFDEF PATCH_BACKPORT} + SwapSAtts( 'CALIBER_ORG' ); + SwapSAtts( 'CALIBER' ); + {$ENDIF PATCH_BACKPORT} +{$ELSE PATCH_I18N} + {$IFDEF PATCH_BACKPORT} + SwapSAtts( 'CALIBER' ); + {$ENDIF PATCH_BACKPORT} +{$ENDIF PATCH_I18N} SwapSAtts( 'NAME' ); SwapSAtts( 'SDL_SPRITE' ); SwapSAtts( 'SDL_COLORS' ); @@ -3551,6 +4544,9 @@ begin Ld := 0; M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} T := NAttValue( M^.NA , NAG_Location , NAS_Team ); if ( T = NAV_DefPlayerTeam ) then begin { At this time, also record the LEADERSHIP rating. } @@ -3560,6 +4556,9 @@ begin end else if ( T = NAV_LancemateTeam ) and OnTheMap( M ) and GearActive( M ) then begin Inc( N ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -3572,12 +4571,18 @@ begin { On the second pass actually give the XP. } M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} T := NAttValue( M^.NA , NAG_Location , NAS_Team ); if ( T = NAV_DefPlayerTeam ) then begin DoleExperience( M , XP ); end else if ( T = NAV_LancemateTeam ) and OnTheMap( M ) then begin DoleExperience( M , XP ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end; @@ -3591,6 +4596,10 @@ Procedure ProcessGSkillXP( var Event: St var Sk,XP: LongInt; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGSkillXP()'); +{$ENDIF DEBUG} + { Find out what skill to give XP for, and how much XP to give. } Sk := ScriptValue( Event , GB , Source ); XP := ScriptValue( Event , GB , Source ); @@ -3605,6 +4614,10 @@ Procedure ProcessGMental( GB: GameBoardP { The grabbed gear is doing something. Make it wait, and spend } { one mental point. } begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGMental()'); +{$ENDIF DEBUG} + { As long as we have a grabbed gear, go for it! } if Grabbed_Gear <> Nil then begin WaitAMinute( GB , Grabbed_Gear , ReactionTime( Grabbed_Gear ) * 3 ); @@ -3615,6 +4628,10 @@ end; Procedure ProcessGQuitLance( GB: GameBoardPtr ); { The grabbed gear will quit the lance. } begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGQuitLance()'); +{$ENDIF DEBUG} + if Grabbed_Gear <> Nil then begin RemoveLancemate( GB , Grabbed_Gear ); end; @@ -3627,6 +4644,10 @@ var SkLvl: Integer; Pilot: GearPtr; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGSkillLevel()'); +{$ENDIF DEBUG} + { Find out what level the NPC should be at. } SkLvl := ( ScriptValue( Event , GB , Source ) div 7 ) + 3; if SkLvl < 1 then SkLvl := 1; @@ -3652,6 +4673,10 @@ var Skill: NAttPtr; SkLvl: Integer; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGAbsoluteLevel()'); +{$ENDIF DEBUG} + { Find out what level the NPC should be at. } SkLvl := ScriptValue( Event , GB , Source ) + 35; if SkLvl < 1 then SkLvl := 1; @@ -3674,6 +4699,10 @@ Procedure ProcessGMoraleDmg( var Event: var M: LongInt; begin +{$IFDEF DEBUG} + Show_DebugMessage_Grabbed_Gear('ProcessGMoraleDmg()'); +{$ENDIF DEBUG} + { Find out how much morale change. } M := ScriptValue( Event , GB , Source ); @@ -3748,12 +4777,29 @@ Procedure InvokeEvent( Event: String; GB var cmd: String; begin +{$IFDEF PATCH_GH} + Inc( NestLevel_of_InvokeEvent ); + DEBUG_cmd_org := Event; + DEBUG_cmd_org2 := ''; + DEBUG_cmd_org3 := ''; +{$ENDIF PATCH_GH} while ( Event <> '' ) do begin cmd := UpCase( ExtractWord( Event ) ); +{$IFDEF DEBUG} + if DEBUG_TraceMacro and ('' <> cmd) then begin + ErrorMessage_fork( 'TRACE: ' + Make_ErrorMessage_ASL(Source,cmd) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT1(Event) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT2(Event) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT3(Event) ); + end; +{$ENDIF DEBUG} if SAttValue( Script_Macros , cmd ) <> '' then begin { Install the macro. } InitiateMacro( Event , SAttValue( Script_Macros , cmd ) ); +{$IFDEF PATCH_GH} + DEBUG_cmd_org3 := Event; +{$ENDIF PATCH_GH} end else if not Attempt_Gear_Grab( Cmd , Event , GB , Source ) then begin { If this is a gear-grabbing command, our work here is done. } @@ -3767,10 +4813,16 @@ begin else if cmd = 'DELETEGG' then ProcessDeleteGG( GB , Source ) else if cmd = 'MOVEGG' then ProcessMoveGG( Event , GB , Source ) else if cmd = 'DEPLOYGG' then ProcessDeployGG( Event , GB , Source ) +{$IFDEF PATCH_GH} + else if cmd = 'DEPLOYGGONMAP' then ProcessDeployGGOnMap( Event , GB , Source ) +{$ENDIF PATCH_GH} else if cmd = 'DYNAGG' then ProcessDynaGG( Event , GB , Source ) else if cmd = 'GIVEGG' then ProcessGiveGG( GB ) else if cmd = 'GNEWPART' then ProcessGNewPart( Event , GB , Source ) else if cmd = 'RETURN' then ProcessReturn( GB ) +{$IFDEF PATCH_GH} + else if cmd = 'SETNPC' then ProcessSetNPC( Event , GB , Source ) +{$ENDIF PATCH_GH} else if cmd = 'PRINT' then ProcessPrint( Event , GB , Source ) else if cmd = 'ALERT' then ProcessAlert( Event , GB , Source ) else if cmd = 'MEMO' then ProcessMemo( Event , GB , Source ) @@ -3780,7 +4832,11 @@ begin else if cmd = 'VICTORY' then ProcessVictory( GB ) else if cmd = 'VMSG' then ProcessValueMessage( Event , GB , Source ) else if cmd = 'SAY' then ProcessSay( Event , GB , Source ) +{$IFDEF PATCH_I18N} + else if cmd = 'SAYANYTHING' then ProcessSayAnything( Source ) +{$ELSE} else if cmd = 'SAYANYTHING' then ProcessSayAnything() +{$ENDIF} else if cmd = 'IFGINPLAY' then ProcessIfGInPlay( Event , Source ) else if cmd = 'IFGOK' then ProcessIfGOK( Event , Source ) else if cmd = 'IFGSEXY' then ProcessIfGSexy( Event , GB , Source ) @@ -3850,15 +4906,45 @@ begin else if cmd = 'GQUITLANCE' then ProcessGQuitLance( GB ) else if cmd <> '' then begin +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} + ErrorMessage_fork( 'ERROR: Unknown ASL command. ' + Make_ErrorMessage_ASL(Source,cmd) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT1(Event) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT2(Event) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT3(Event) ); + {$ENDIF DEBUG} + DialogMsg( 'ERROR: Unknown ASL command. ' + Make_ErrorMessage_ASL(Source,cmd) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT1(Event) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT2(Event) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT3(Event) ); +{$ELSE PATCH_GH} DialogMsg( 'ERROR: Unknown ASL command ' + cmd + ' in ' + GearName( Source ) ); DialogMsg( 'CONTEXT: ' + event ); +{$ENDIF PATCH_GH} end; end; { If not GrabGear } end; +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('InvokeEvent()'); +{$ENDIF DEBUG} { Process rounding-up events here. } if ( SCRIPT_DynamicEncounter <> Nil ) and ( SCRIPT_DynamicEncounter^.V > 0 ) then CheckMechaEquipped( GB ); + +{$IFDEF PATCH_GH} + Dec( NestLevel_of_InvokeEvent ); + if (0 = NestLevel_of_InvokeEvent) then begin +{$IFDEF DEBUG} + if (NIL <> Current_PlotMaster) then begin + Current_PlotMaster := NIL; + Current_StoryMaster := NIL; + end; +{$ENDIF DEBUG} + Current_PlotMaster := NIL; + Current_StoryMaster := NIL; + end; +{$ENDIF PATCH_GH} end; Procedure HandleChat( GB: GameBoardPtr; var FreeRumors: Integer ); @@ -3878,6 +4964,10 @@ end; Procedure AddLancemate( GB: GameBoardPtr; NPC: GearPtr ); { Add the listed NPC to the PC's lance. } begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { This NPC will have to quit their current team to do this... } { so, better set a trigger. } SetTrigger( GB , TRIGGER_NumberOfUnits + BStr( NAttValue( NPC^.NA , NAG_Location , NAS_Team ) ) ); @@ -3891,7 +4981,12 @@ var LMP: Integer; { Lancemate Points needed } begin { Make sure we've got an NPC to deal with. } +{$IFDEF PATCH_GH} + if (NIL = I_NPC) or (I_NPC^.G <= GG_DisposeGear) then Exit; + if (NIL = I_PC) or (I_PC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if I_NPC = Nil then Exit; +{$ENDIF PATCH_GH} { Need two more available lancemate points than are currently in use. } LMP := LancematesPresent( GB ) + 2; @@ -3928,6 +5023,10 @@ Procedure RemoveLancemate( GB: GameBoard { Remove NPC from the party. } { ERROR CHECK: Lancemates cannot be removed in dynamic scenes! } begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if not IsInvCom( GB^.Scene ) then begin SetSAtt( NPC^.SA , 'TEAMDATA ' ); ChooseTeam( NPC , GB^.Scene ); @@ -3937,7 +5036,11 @@ end; Procedure HandleQuit( GB: GameBoardPtr ); { I_NPC will quit the party. } begin +{$IFDEF PATCH_GH} + if (NIL = I_NPC) or (I_NPC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if I_NPC = Nil then Exit; +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} CHAT_Message := MsgString( 'QUIT_LANCE' ); {$ELSE} @@ -3952,7 +5055,11 @@ Procedure InteractRedraw; begin QuickCombatDisplay( ASRD_GameBoard ); SetupInteractDisplay( TeamColor( ASRD_GameBoard , I_NPC ) ); + {$IFDEF PATCH_GH} + if (NIL <> I_NPC) and (GG_DisposeGear < I_NPC^.G) then begin + {$ELSE PATCH_GH} if I_NPC <> Nil then begin + {$ENDIF PATCH_GH} DisplayInteractStatus( ASRD_GameBoard , I_NPC , CHAT_React , I_Endurance ); DisplayGearInfo( I_NPC , ASRD_GameBoard ); end; @@ -3971,7 +5078,12 @@ begin L2 := L^.Next; if L^.G = GG_AbsolutelyNothing then begin +{$IFDEF PATCH_GH} + { Don't purge at here. If you purge the Plot at here, that cause memory crash. } + Mark_GG_DisposeGear( L ); +{$ELSE PATCH_GH} RemoveGear( LList , L ); +{$ENDIF PATCH_GH} end else begin PruneNothings( L^.SubCom ); PruneNothings( L^.InvCom ); @@ -3992,7 +5104,16 @@ var N,FreeRumors: Integer; RTT: LongInt; { ReTalk Time } T: String; -begin +{$IFDEF PATCH_CHEAT} + A: Char; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then PC := NIL; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then NPC := NIL; + if (NIL = Interact) or (Interact^.G <= GG_DisposeGear) then Interact := NIL; +{$ENDIF PATCH_GH} + { Start by allocating the menu. } IntMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); @@ -4029,13 +5150,21 @@ begin if ( NAttValue( NPC^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) and ( Interact <> Nil ) and ( Interact^.Parent <> Nil ) and ( Interact^.Parent^.G = GG_Scene ) then begin { Lancemates won't use their local personas while part of the lance. } { Hence the mother of all conditionals above... } +{$IFDEF DEBUG} + IntScr := 'SAYANYTHInG NEWCHaT'; +{$ELSE DEBUG} IntScr := 'SAYANYTHING NEWCHAT'; +{$ENDIF DEBUG} end else if Interact <> Nil then begin IntScr := AS_GetString( Interact , 'GREETING' ); end else begin { If there is no standard greeting, set the event to } { build the default interaction menu. } +{$IFDEF DEBUG} + IntScr := 'SAYANYTHiNG NEWChAT'; +{$ELSE DEBUG} IntScr := 'SAYANYTHING NEWCHAT'; +{$ENDIF DEBUG} end; T := 'Greeting'; InvokeEvent( IntScr , GB , Interact , T ); @@ -4053,10 +5182,44 @@ begin {$IFDEF SDLMODE} ASRD_GameBoard := GB; CHAT_React := ReactionScore( GB^.Scene , PC , NPC ); +{$ENDIF SDLMODE} +{$IFDEF PATCH_CHEAT} + if Cheat_NPC_Edit then begin + AddRPGMenuKey( IntMenu , '.' , -5 ); + AddRPGMenuKey( IntMenu , KeyMap[ KMC_SelectPortrait ].KCode , -6 ); + AddRPGMenuKey( IntMenu , KeyMap[ KMC_RenameMecha ].KCode , -7 ); + repeat + {$IFDEF SDLMODE} + N := SelectMenu( IntMenu , @InteractRedraw ); + {$ELSE SDLMODE} + N := SelectMenu( IntMenu ); + {$ENDIF SDLMODE} + if (N = -5) then begin + {$IFDEF SDLMODE} + DialogMSG( CHAT_Message ); + {$ELSE SDLMODE} + {$ENDIF SDLMODE} + end else if (N = -6) and (I_NPC <> Nil) then begin + SelectPortrait( I_NPC ); + //ClrZone(ZONE_Menu); + end else if (N = -7) and (I_NPC <> Nil) then begin + Rename_Mecha( GB , I_NPC ) + end; + until N > -5 + end else begin + {$IFDEF SDLMODE} + N := SelectMenu( IntMenu , @InteractRedraw ); + {$ELSE SDLMODE} + N := SelectMenu( IntMenu ); + {$ENDIF SDLMODE} + end; +{$ELSE PATCH_CHEAT} + {$IFDEF SDLMODE} N := SelectMenu( IntMenu , @InteractRedraw ); -{$ELSE} + {$ELSE SDLMODE} N := SelectMenu( IntMenu ); -{$ENDIF} + {$ENDIF SDLMODE} +{$ENDIF PATCH_CHEAT} end else begin { If the menu is empty, we must leave this procedure. } { More importantly, we better not do anything in } @@ -4092,7 +5255,20 @@ begin InteractRedraw; GHFlip; {$ENDIF} +{$IFDEF PATCH_CHEAT} + if Cheat_NPC_Edit then begin + repeat + A := RPGKey; + {$IFDEF SDLMODE} + if A = '.' then DialogMSG( CHAT_Message ); + {$ENDIF SDLMODE} + until ( A = ' ' ) or ( A = #27 ) or ( A = #8 ); + end else begin + EndOfGameMoreKey; + end; +{$ELSE PATCH_CHEAT} EndOfGameMoreKey; +{$ENDIF PATCH_CHEAT} end; { If the conversation ended because the NPC ran out of patience, } @@ -4104,13 +5280,25 @@ begin AddReputation( PC , 3 , 1 ); end; +{$IFDEF PATCH_GH} { Check - If this persona gear is the child of a gear whose type } { is GG_ABSOLUTELYNOTHING, chances are that it used to be a plot } { but it's been advanced by the conversation. Delete it. } if Interact <> Nil then begin + { Don't purge at here. If you purge the Plot at here, that cause memory crash. } Interact := FindRoot( Interact ); PruneNothings( Interact ); + Require_GFCombatDisplay := True; end; +{$ELSE PATCH_GH} + { Check - If this persona gear is the child of a gear whose type } + { is GG_ABSOLUTELYNOTHING, chances are that it used to be a plot } + { but it's been advanced by the conversation. Delete it. } + if Interact <> Nil then begin + Interact := FindRoot( Interact ); + PruneNothings( Interact ); + end; +{$ENDIF PATCH_GH} { Set the ReTalk value. } { Base retalk time is 1500 ticks; may be raised or lowered depending } @@ -4159,6 +5347,9 @@ var E: String; it: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = Source) or (Source^.G <= GG_DisposeGear) then Source := NIL; +{$ENDIF PATCH_GH} it := False; if Source <> Nil then begin E := AS_GetString( Source , Trigger ); @@ -4178,9 +5369,24 @@ var P2: GearPtr; it,I2: Boolean; begin +{$IFDEF DEBUG} + if DEBUG_TraceMacro then begin + if CheckAll then begin + ErrorMessage_fork( 'TRACE: CheckTriggerAlongPath() "' + T + '" in "' + GearName(Plot) + '", CheckAll:Y.' ); + end else begin + ErrorMessage_fork( 'TRACE: CheckTriggerAlongPath() "' + T + '" in "' + GearName(Plot) + '", CheckAll:N.' ); + end; + end; +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear at here. } +{$ENDIF PATCH_GH} it := False; while ( Plot <> Nil ) and ( T <> '' ) do begin P2 := Plot^.Next; +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Plot^.G) then begin +{$ENDIF PATCH_GH} if CheckAll or ( Plot^.G = GG_Plot ) or ( Plot^.G = GG_Faction ) or ( Plot^.G = GG_Story ) or ( Plot^.G = GG_Adventure ) then begin { FACTIONs and STORYs can hold active plots in their InvCom. } if ( Plot^.G = GG_Faction ) or ( Plot^.G = GG_Story ) or ( Plot^.G = GG_Adventure ) then CheckTriggerAlongPath( T , GB , Plot^.InvCom , CheckAll); @@ -4192,9 +5398,21 @@ begin { structure, so reset P2. } P2 := Plot^.Next; +{$IFDEF PATCH_GH} + { Mark to remove the plot, if it's been advanced. } + if Plot^.G = GG_AbsolutelyNothing then begin + { Don't purge at here. If you purge the Plot at here, that cause memory crash. } + Mark_GG_AbsolutelyNothing( Plot ); + Require_GFCombatDisplay := True; + end; +{$ELSE PATCH_GH} { Remove the plot, if it's been advanced. } if Plot^.G = GG_AbsolutelyNothing then RemoveGear( Plot^.Parent^.InvCom , Plot ); +{$ENDIF PATCH_GH} + end; +{$IFDEF PATCH_GH} end; +{$ENDIF PATCH_GH} Plot := P2; end; CheckTriggerAlongPath := it; @@ -4268,20 +5486,87 @@ begin end; end; + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arenascript.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + DEBUG_cmd_org := ''; + DEBUG_cmd_org2 := ''; + DEBUG_cmd_org3 := ''; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + for Old_Grabbed_Gear_StackLevel := 0 to MAX_Old_Grabbed_Gear_StackLevel do begin + Old_Grabbed_Gear[Old_Grabbed_Gear_StackLevel] := NIL; + Attach_SmartPointer( 'Old_Grabbed_Gear[' + IntToStr(Old_Grabbed_Gear_StackLevel) + ']: GearPtr', @(Old_Grabbed_Gear[Old_Grabbed_Gear_StackLevel]) ); + end; + Old_Grabbed_Gear_StackLevel := 0; +{$ENDIF PATCH_GH} SCRIPT_DynamicEncounter := Nil; +{$IFDEF PATCH_GH} + IntMenu := NIL; + I_PC := NIL; + I_NPC := NIL; + I_NPC_org := NIL; + I_Rumors := NIL; +{$ENDIF PATCH_GH} Grabbed_Gear := Nil; +{$IFDEF PATCH_GH} + NestLevel_of_InvokeEvent := 0; + Current_PlotMaster := NIL; + Current_StoryMaster := NIL; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + Require_GFCombatDisplay := True; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} + if not DEBUG_DONOT_NIL_SCRIPT_DynamicEncounter then begin + {$ENDIF DEBUG} + Attach_SmartPointer( 'SCRIPT_DynamicEncounter: GearPtr', @SCRIPT_DynamicEncounter ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + Attach_SmartPointer( 'IntMenu: RPGMenuPtr', @IntMenu ); + Attach_SmartPointer( 'I_PC: GearPtr', @I_PC ); + Attach_SmartPointer( 'I_NPC: GearPtr', @I_NPC ); + Attach_SmartPointer( 'I_NPC_org: GearPtr', @I_NPC_org ); + Attach_SmartPointer( 'I_Rumors: SAttPtr', @I_Rumors ); + Attach_SmartPointer( 'Grabbed_Gear: GearPtr', @Grabbed_Gear ); + {$IFDEF SDLMODE} + ASRD_InfoGear := NIL; + ASRD_GameBoard := NIL; + Attach_SmartPointer( 'ASRD_InfoGear: GearPtr', @ASRD_InfoGear ); + Attach_SmartPointer( 'ASRD_GameBoard: GameBoardPtr', @ASRD_GameBoard ); + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} Script_Macros := LoadStringList( Script_Macro_File ); Value_Macros := LoadStringList( Value_Macro_File ); lancemate_tactics_persona := LoadFile( 'lmtactics.txt' , Data_Directory ); +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: arenascript.pp(finalization)'); +{$ENDIF DEBUG} +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('arenascript finalization()'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + Dispose_SCRIPT_DynamicEncounter(); +{$ELSE PATCH_GH} if SCRIPT_DynamicEncounter <> Nil then begin DisposeGear( SCRIPT_DynamicEncounter ); end; +{$ENDIF PATCH_GH} DisposeSAtt( Script_Macros ); DisposeSAtt( Value_Macros ); DisposeGear( lancemate_tactics_persona ); +end; end. diff -x .svn -uprN GearHead1100repository.original/backpack.pp branches/backpack.pp --- GearHead1100repository.original/backpack.pp 2016-02-28 09:01:00.000000000 +0900 +++ branches/backpack.pp 2016-03-18 09:01:00.000000000 +0900 @@ -24,11 +24,18 @@ unit backpack; interface +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale {$IFDEF SDLMODE} -uses gears,locale,sdlgfx; -{$ELSE} -uses gears,locale; -{$ENDIF} + {$IFDEF PATCH_CHEAT} + ,SDL + {$ENDIF PATCH_CHEAT} + ,sdlgfx +{$ENDIF SDLMODE} + ; const TRIGGER_GetItem = 'GET'; @@ -46,57 +53,161 @@ Procedure DoFieldRepair( GB: GameBoardPt Function Handless( Mek: GearPtr ): Boolean; Function ShakeDown( GB: GameBoardPtr; Part: GearPtr; X,Y: Integer ): LongInt; +{$IFDEF PATCH_GH} +Procedure InstallAmmo( GB: GameBoardPtr; PC , Gun , Ammo: GearPtr ); +Function NeedAmmo( Weapon: GearPtr ): Boolean; +Function ReloadAmmo( GB: GameBoardPtr; User,Weapon: GearPtr ): Boolean; +{$ENDIF PATCH_GH} Procedure PCGetItem( GB: GameBoardPtr; PC: GearPtr ); Procedure StartContinuousUseItem( GB: GameBoardPtr; TruePC , Item: GearPtr ); Procedure FHQ_SelectMechaForPilot( GB: GameBoardPtr; NPC: GearPtr ); Procedure LancemateBackpack( GB: GameBoardPtr; PC,NPC: GearPtr ); Procedure BackpackMenu( GB: GameBoardPtr; PC: GearPtr; StartWithInv: Boolean ); +{$IFDEF PATCH_CHEAT} +Procedure RealBackpack( GB: GameBoardPtr; var LList: GearPtr; PC,M: GearPtr; StartWithInv: Boolean ); +Procedure MechaPartEditor( GB: GameBoardPtr; var LList: GearPtr; PC,Mek: GearPtr ); +{$ENDIF PATCH_CHEAT} -{$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} +Procedure MechaPartBrowser( Mek: GearPtr; DebugMode: Boolean; RDP: RedrawProcedureType ); Procedure MechaPartBrowser( Mek: GearPtr; RDP: RedrawProcedureType ); -{$ELSE} + {$ELSE} +Procedure MechaPartBrowser( Mek: GearPtr; DebugMode: Boolean ); Procedure MechaPartBrowser( Mek: GearPtr ); -{$ENDIF} + {$ENDIF} +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} +Procedure MechaPartBrowser( Mek: GearPtr; RDP: RedrawProcedureType ); + {$ELSE} +Procedure MechaPartBrowser( Mek: GearPtr ); + {$ENDIF} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} +Procedure SelectPortrait( M: GearPtr ); +Procedure Rename_Mecha( GB: GameBoardPtr; NPC: GearPtr ); +{$IFDEF SDLMODE} +Function SwapMenu_NoParent( var FirstPart: GearPtr; Z: TSDL_Rect; Part: GearPtr ):Boolean; +{$ELSE SDLMODE} +Function SwapMenu_NoParent( var FirstPart: GearPtr; Z: Integer; Part: GearPtr ):Boolean; +{$ENDIF SDLMODE} +{$IFDEF SDLMODE} +Function SwapMenu( Z: TSDL_Rect; Part: GearPtr ):Boolean; +{$ELSE SDLMODE} +Function SwapMenu( Z: Integer; Part: GearPtr ):Boolean; +{$ENDIF SDLMODE} +{$ENDIF PATCH_CHEAT} Procedure FHQ_ThisWargearWasSelected( GB: GameBoardPtr; var LList: GearPtr; PC,M: GearPtr ); implementation +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + ui4gh, + pcaction, +{$ENDIF PATCH_CHEAT} + ability,action,arenacfe,arenascript,damage,gearutil,ghchars,ghholder, + ghmodule,ghprop,ghswag,interact,menugear,rpgdice,skilluse,texutil, {$IFDEF SDLMODE} -uses ability,action,arenacfe,arenascript,damage,gearutil,ghchars,ghholder, - ghmodule,ghprop,ghswag,interact,menugear,rpgdice,skilluse,texutil, - sdlinfo,sdlmap,sdlmenus,ghweapon; + sdlinfo,sdlmap,sdlmenus, {$ELSE} -uses ability,action,arenacfe,arenascript,damage,gearutil,ghchars,ghholder, - ghmodule,ghprop,ghswag,interact,menugear,rpgdice,skilluse,texutil, - congfx,coninfo,conmap,conmenus,context,ghweapon; + congfx,coninfo,conmap,conmenus,context, {$ENDIF} + ghweapon; var ForceQuit: Boolean; EqpRPM,InvRPM: RPGMenuPtr; +{$IFDEF DEBUG} + EqpRPM_MaxNum, InvRPM_MaxNum: LongInt; +{$ENDIF DEBUG} {$IFDEF SDLMODE} InfoGear: GearPtr; { Gear to appear in the INFO menu. } InfoGB: GameBoardPtr; MPB_Redraw: RedrawProcedureType; MPB_Gear: GearPtr; + {$IFDEF PATCH_GH} + MPR_InvMenu: RPGMenuPtr; + MPR_InvMenuLGBN: GearPtr; + MPR_InvMenuRGS: GearPtr; + {$ENDIF PATCH_GH} Procedure PlainRedraw; { Miscellaneous menu redraw procedure. } +{$IFDEF PATCH_GH} +var + Mek: GearPtr; + MekNum: LongInt; +{$ENDIF PATCH_GH} begin if InfoGB <> Nil then QuickCombatDisplay( InfoGB ); +{$IFDEF PATCH_GH} + Mek := NIL; + if (NIL <> MPR_InvMenu) then begin + MekNum := RPMLocateByPosition(MPR_InvMenu,MPR_InvMenu^.selectitem)^.value; + if (0 <= MekNum) then begin + if (NIL <> MPR_InvMenuRGS) then begin + Mek := RetrieveGearSib( MPR_InvMenuRGS, MekNum ); + end; + end; + end else if (NIL <> InfoGear) then begin + Mek := InfoGear; + end; + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + DisplayGearInfo( Mek, InfoGB ); + end; +{$ELSE PATCH_GH} if InfoGear <> Nil then DisplayGearInfo( InfoGear , InfoGB ); +{$ENDIF PATCH_GH} end; Procedure MiscProcRedraw; { Miscellaneous menu redraw procedure. The Eqp display will be shown; } { the INV display won't be. } +{$IFDEF PATCH_GH} +var + Mek: GearPtr; + MekNum: LongInt; +{$ENDIF PATCH_GH} begin if InfoGB <> Nil then QuickCombatDisplay( InfoGB ); DrawBPBorder; +{$IFDEF PATCH_GH} + Mek := NIL; + if (NIL <> MPR_InvMenu) then begin + MekNum := RPMLocateByPosition(MPR_InvMenu,MPR_InvMenu^.selectitem)^.value; + if (0 <= MekNum) then begin + if (NIL <> MPR_InvMenuLGBN) then begin + {$IFDEF DEBUG} + Mek := LocateGearByNumber( MPR_InvMenuLGBN, MekNum, False, 0, '' ); + {$ELSE DEBUG} + Mek := LocateGearByNumber( MPR_InvMenuLGBN, MekNum ); + {$ENDIF DEBUG} + end else if (NIL <> MPR_InvMenuRGS) then begin + Mek := RetrieveGearSib( MPR_InvMenuRGS , MekNum ); + end; + end; + end else if (NIL <> InfoGear) then begin + Mek := InfoGear; + end; + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + DisplayGearInfo( Mek, InfoGB ); + end; +{$ELSE PATCH_GH} if InfoGear <> Nil then DisplayGearInfo( InfoGear , InfoGB ); +{$ENDIF PATCH_GH} if EqpRPM <> Nil then begin DisplayMenu( EqpRPM , Nil ); NFGameMsg( MsgString( 'BACKPACK_Directions' ) , ZONE_Menu , MenuItem ); @@ -108,7 +219,13 @@ Procedure RobotPartRedraw; begin if InfoGB <> Nil then QuickCombatDisplay( InfoGB ); DrawBPBorder; +{$IFDEF PATCH_GH} + if (NIL <> InfoGear) and (GG_DisposeGear < InfoGear^.G) then begin + DisplayGearInfo( InfoGear , InfoGB ); + end; +{$ELSE PATCH_GH} if InfoGear <> Nil then DisplayGearInfo( InfoGear , InfoGB ); +{$ENDIF PATCH_GH} NFGameMsg( MsgString( 'SELECT_ROBOT_PARTS' ) , ZONE_EqpMenu , MenuItem ); end; @@ -120,9 +237,13 @@ Procedure SelectColors( M: GearPtr; Redr var RPM,CMenu: RPGMenuPtr; N,T,T2: Integer; - ColorList,C: SAttPtr; + C: SAttPtr; oldcolor,msg,newcolor: String; begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); if M^.G = GG_Character then begin AddRPGMenuItem( RPM , MsgString( 'EDITCOLOR_1' ) , 1 ); @@ -190,6 +311,10 @@ var RPM: RPGMenuPtr; fname: String; begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); if NAttValue( M^.NA , NAG_CharDescription , NAS_Gender ) = NAV_Female then begin BuildFileMenu( RPM , Graphics_Directory + 'cha_f_*.*' ); @@ -198,6 +323,17 @@ begin end; AddRPGMenuItem( RPM , MsgString( 'EXIT' ) , -1 ); +{$IFDEF PATCH_GH} + fname := SAttValue( M^.SA , 'SDL_SPRITE' ); + while (RPM^.SelectItem < RPM^.NumItem) do begin + if RPMLocateByPosition(RPM,RPM^.SelectItem)^.msg = fname then begin + break; + end; + Inc( RPM^.SelectItem ); + end; + RPM^.TopItem := -1; +{$ENDIF PATCH_GH} + fname := SelectFile( RPM , Redrawer ); if fname <> '' then begin @@ -215,8 +351,16 @@ Function SelectRobotParts( GB: GameBoard var Ingredients,Part,P2: GearPtr; RPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + {$IFNDEF SDLMODE} DrawBPBorder; GameMsg( MsgString( 'SELECT_ROBOT_PARTS' ) , ZONE_EqpMenu , MenuItem ); @@ -232,6 +376,17 @@ begin Part := PC^.InvCom; N := 1; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin + if ( Part^.G = GG_Weapon ) or ( Part^.G = GG_Shield ) or ( Part^.G = GG_ExArmor ) or ( Part^.G = GG_Sensor ) or ( Part^.G = GG_Electronics ) then begin + AddRPGMenuItem( RPM , GearName( Part ) , N ); + end else if ( Part^.G = GG_RepairFuel ) and ( ( Part^.S = 15 ) or ( Part^.S = 23 ) ) then begin + AddRPGMenuItem( RPM , GearName( Part ) , N ); + end; + Inc( N ); + end; + Part := Part^.Next; +{$ELSE PATCH_GH} if ( Part^.G = GG_Weapon ) or ( Part^.G = GG_Shield ) or ( Part^.G = GG_ExArmor ) or ( Part^.G = GG_Sensor ) or ( Part^.G = GG_Electronics ) then begin AddRPGMenuItem( RPM , GearName( Part ) , N ); end else if ( Part^.G = GG_RepairFuel ) and ( ( Part^.S = 15 ) or ( Part^.S = 23 ) ) then begin @@ -239,6 +394,7 @@ begin end; Part := Part^.Next; Inc( N ); +{$ENDIF PATCH_GH} end; RPMSortAlpha( RPM ); AlphaKeyMenu( RPM ); @@ -275,14 +431,28 @@ Procedure AddRepairOptions( RPM: RPGMenu var N: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if PC <> Nil then begin for N := 1 to NumRepairSkills do begin { The repair option will only be added to the menu if: } { - The PC has the required skill. } { - The item is in need of repair (using this skill). } if ( NAttValue( PC^.NA , NAG_Skill , RepairSkillIndex[N] ) > 0 ) and ( TotalRepairableDamage( Item , RepairSkillIndex[N] ) > 0 ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , + ReplaceHash( I18N_MsgString('BACKPACK_Repair'), I18N_Name('SkillMan',SkillMan[ RepairSkillIndex[N] ].Name) ), + 100 + N ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , MsgString( 'BACKPACK_Repair' ) + SkillMan[ RepairSkillIndex[N] ].Name , 100 + N ); +{$ENDIF PATCH_I18N} end; end; end; @@ -296,6 +466,17 @@ var N: LongInt; RepairFuel,RMaster: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then begin + DialogMsg( MsgString( 'PCREPAIR_NoRepairFuel' ) ); + Exit; + end; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then begin + DialogMsg( MsgString( 'PCREPAIR_NoDamageDone' ) ); + Exit; + end; +{$ENDIF PATCH_GH} + { Error check - if no repair is needed, display an appropraite } { response. } if TotalRepairableDamage( Item , Skill ) < 1 then begin @@ -344,6 +525,59 @@ end; Function ShakeDown( GB: GameBoardPtr; Part: GearPtr; X,Y: Integer ): LongInt; { This is the workhorse for this function. It does the } { dirty work of separating inventory from (former) owner. } +{$IFDEF PATCH_GH} +const + V_MAX = 2147483647; + V_MIN = -2147483648; + + Function ShakeDown_internal( GB: GameBoardPtr; Part: GearPtr; X,Y: Integer ): Int64; + var + Cash: Int64; + SPart: GearPtr; { Sub-Part } + begin + { Start by removing the cash from this part. } + Cash := NAttValue( Part^.NA , NAG_Experience , NAS_Credits ); + SetNAtt( Part^.NA , NAG_Experience , NAS_Credits , 0 ); + SetNAtt( Part^.NA , NAG_EpisodeData , NAS_Ransacked , 1 ); + + { Remove all InvComs, and place them on the map. } + While (NIL <> Part^.InvCom) do begin + SPart := Part^.InvCom; + DelinkGear( Part^.InvCom , SPart ); + { If this invcom isn't destroyed, put it on the } + { ground for the PC to pick up. Otherwise delete it. } + if NotDestroyed( SPart ) then begin + SetNAtt( SPart^.NA , NAG_Location , NAS_X , X ); + SetNAtt( SPart^.NA , NAG_Location , NAS_Y , Y ); + SPart^.Next := GB^.Meks; + GB^.Meks := SPart; + end else begin + DisposeGear( SPart ); + end; + end; + + { Shake down this gear's subcoms. } + SPart := Part^.SubCOm; + while (NIL <> SPart) do begin + if (GG_DisposeGear < SPart^.G) then begin + if SPart^.G <> GG_Cockpit then begin + Cash := Cash + ShakeDown_internal( GB , SPart , X , Y ); + end; + end; + SPart := SPart^.Next; + end; + + if (V_MAX < Cash) then begin + Cash := V_MAX; + end else if (Cash < V_MIN) then begin + Cash := V_MIN; + end; + ShakeDown_internal := Cash; + end; +begin + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); + ShakeDown := ShakeDown_internal( GB, Part, X, Y ); +{$ELSE PATCH_GH} var cash: LongInt; SPart: GearPtr; { Sub-Part } @@ -377,6 +611,7 @@ begin end; ShakeDown := Cash; +{$ENDIF PATCH_GH} end; @@ -395,6 +630,9 @@ begin Mek := GB^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} { If this is a broken-down master, check to see if it's } { one we want to pillage. } if IsMasterGear( Mek ) and not GearOperational( Mek ) then begin @@ -409,6 +647,9 @@ begin it := it + ShakeDown( GB , Mek , X , Y ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; @@ -422,20 +663,44 @@ Function Handless( Mek: GearPtr ): Boole var Hand: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(True); + {$IFDEF PATCH_CHEAT} + Hand := SeekActiveIntrinsic( Mek , GG_Holder , GS_Hand , Cheat_EnableCockpitBarrier_Hand ); + {$ELSE PATCH_CHEAT} + Hand := SeekActiveIntrinsic( Mek , GG_Holder , GS_Hand ); + {$ENDIF PATCH_CHEAT} + if (NIL = Hand) or (Hand^.G <= GG_DisposeGear) then Exit(True); + Handless := not InGoodModule( Hand ); +{$ELSE PATCH_GH} Hand := SeekActiveIntrinsic( Mek , GG_Holder , GS_Hand ); if Hand = Nil then Handless := True else Handless := not InGoodModule( Hand ); +{$ENDIF PATCH_GH} end; {$IFDEF SDLMODE} Procedure GetItemRedraw; begin +{$IFDEF PATCH_GH} + if (NIL <> InfoGB) then begin + QuickCombatDisplay( InfoGB ); + end; + if (NIL <> InfoGear) and (GG_DisposeGear < InfoGear^.G) then begin + DisplayGearInfo( InfoGear , InfoGB ); + end; +{$ELSE PATCH_GH} QuickCombatDisplay( InfoGB ); DisplayGearInfo( InfoGear , InfoGB ); +{$ENDIF PATCH_GH} end; {$ENDIF} +{$IFDEF PATCH_GH} +Function SelectVisibleItem( GB: GameBoardPtr; PC: GearPtr; X,Y: Integer; var FlagAll: Boolean ): GearPtr; +{$ELSE PATCH_GH} Function SelectVisibleItem( GB: GameBoardPtr; PC: GearPtr; X,Y: Integer ): GearPtr; +{$ENDIF PATCH_GH} { Attempt to select a visible item from gameboard tile X,Y. } { If more than one item is present, prompt the user for which one } { to pick up. } @@ -443,6 +708,10 @@ var N,T: Integer; RPM: RPGMenuPtr; begin +{$IFDEF PATCH_GH} + FlagAll := False; +{$ENDIF PATCH_GH} + { First count the number of items in this spot. } N := NumVisibleItemsAtSpot( GB , X , Y ); @@ -460,8 +729,17 @@ begin for t := 1 to N do begin AddRPGMenuItem( RPM , GearName( GetVisibleItemAtSpot( GB , X , Y , T ) ) , T ); end; +{$IFDEF PATCH_GH} + if ( 1 < RPM^.NumItem ) then begin + AddRPGMenuItem_Top( RPM , I18N_MsgString( 'SelectVisibleItem', 'PickUpAll' ) , -5 ); + end; +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then InfoGear := NIL else InfoGear := PC; + {$ELSE PATCH_GH} InfoGear := PC; + {$ENDIF PATCH_GH} InfoGB := GB; N := SelectMenu( RPM , @GetItemRedraw ); {$ELSE} @@ -470,6 +748,11 @@ begin DisposeRPGMenu( RPM ); if N > -1 then begin SelectVisibleItem := GetVisibleItemAtSpot( GB , X , Y , N ); +{$IFDEF PATCH_GH} + end else if ( -5 = N ) then begin + FlagAll := True; + SelectVisibleItem := NIL; +{$ENDIF PATCH_GH} end else begin SelectVisibleItem := Nil; end; @@ -478,15 +761,95 @@ end; Procedure PCGetItem( GB: GameBoardPtr; PC: GearPtr ); { The PC will attempt to pick up something lying on the ground. } + +{$IFDEF PATCH_GH} +var + Cash: LongInt; + + Procedure GetItem( Item: GearPtr ); + var + NID: LongInt; + begin + if ( NIL <> Item ) then begin + if IsLegalSlot( PC , Item ) then begin + DelinkGear( GB^.Meks , Item ); + + { Clear the item's location values. } + StripNAtt( Item , NAG_Location ); + if NAttValue( Item^.NA, NAG_ParaLocation, NAS_OriginalHome ) < 0 then begin + StripNAtt( Item, NAG_ParaLocation ); + end; + + InsertInvCom( PC , Item ); + { Clear the home, to prevent wandering items. } + SetSAtt( Item^.SA , 'HOME <>' ); + DialogMsg( ReplaceHash( MsgString( 'YOU_GET_?' ) , GearName( Item ) ) ); + + NID := NAttValue( Item^.NA , NAG_Narrative , NAS_NID ); + if NID <> 0 then SetTrigger( GB , TRIGGER_GetItem + BStr( NID ) ); + end else if Cash = 0 then begin + DialogMsg( ReplaceHash( MsgString( 'CANT_GET_?' ) , GearName( Item ) ) ); + end; + end else if Cash = 0 then begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('PCGetItem','No item found') ); +{$ELSE PATCH_I18N} + DialogMSG( 'No item found.' ); +{$ENDIF PATCH_I18N} + end; + + if Cash > 0 then begin + DialogMsg( ReplaceHash( MsgString( 'YouFind$' ) , BStr( Cash ) ) ); + AddNAtt( LocatePilot( PC )^.NA , NAG_Experience , NAS_Credits , Cash ); + Cash := 0; + end; + + { Picking up an item takes time. } + WaitAMinute( GB , PC , ReactionTime( PC ) ); + end; + Procedure GetAllItem( P: Point ); + var + Match: LPattern; + M, M_Next: GearPtr; + begin + Match.X := P.X; + Match.Y := P.Y; + Match.Z := -10; + Match.Only_Visibles := True; + Match.Only_Masters := LP_MustNotBeMaster; + + M := GB^.Meks; + while ( NIL <> M ) do begin + M_Next := M^.Next; + if GearMatchesLPattern( GB , M , Match ) then begin + GetItem( M ); + end; + M := M_Next; + end; + end; +var + P: Point; + item: GearPtr; + FlagAll: Boolean; +{$ELSE PATCH_GH} var Cash,NID: LongInt; P: Point; item: GearPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) or Handless(PC) then begin +{$ELSE PATCH_GH} if Handless( PC ) then begin +{$ENDIF PATCH_GH} { Start by checking something that other RPGs would } { just assume- does the PC have any hands? } +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('PCGetItem','you need hands') ); +{$ELSE PATCH_I18N} DialogMsg( 'You need hands in order to use this command.' ); +{$ENDIF PATCH_I18N} end else begin P := GearCurrentLocation( PC ); @@ -499,6 +862,15 @@ begin { freed by the Ransack procedure above will remain unseen. } VisionCheck( GB , PC ); +{$IFDEF PATCH_GH} + Item := SelectVisibleItem( GB , PC , P.X , P.Y , FlagAll ); + + if FlagAll then begin + GetAllItem( P ); + end else begin + GetItem( Item ); + end; +{$ELSE PATCH_GH} Item := SelectVisibleItem( GB , PC , P.X , P.Y ); if Item <> Nil then begin @@ -507,6 +879,11 @@ begin { Clear the item's location values. } StripNAtt( Item , NAG_Location ); +{$IFDEF PATCH_GH} + if NAttValue( Item^.NA, NAG_ParaLocation, NAS_OriginalHome ) < 0 then begin + StripNAtt( Item, NAG_ParaLocation ); + end; +{$ENDIF PATCH_GH} InsertInvCom( PC , Item ); { Clear the home, to prevent wandering items. } @@ -519,7 +896,11 @@ begin DialogMsg( ReplaceHash( MsgString( 'CANT_GET_?' ) , GearName( Item ) ) ); end; end else if Cash = 0 then begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('PCGetItem','No item found') ); +{$ELSE PATCH_I18N} DialogMSG( 'No item found.' ); +{$ENDIF PATCH_I18N} end; if Cash > 0 then begin @@ -529,6 +910,7 @@ begin { Picking up an item takes time. } WaitAMinute( GB , PC , ReactionTime( PC ) ); +{$ENDIF PATCH_GH} end; end; @@ -538,32 +920,134 @@ begin if InvRPM <> Nil then DisposeRPGMenu( InvRPM ); InvRPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); InvRPM^.Mode := RPMNoCleanup; +{$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} + InvRPM_MaxNum := BuildInventoryMenu( InvRPM , PC , Cheat_InvMenu_ShowSubItem ); + {$ELSE DEBUG} + BuildInventoryMenu( InvRPM , PC , Cheat_InvMenu_ShowSubItem ); + {$ENDIF DEBUG} +{$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} + InvRPM_MaxNum := BuildInventoryMenu( InvRPM , PC ); + {$ELSE DEBUG} BuildInventoryMenu( InvRPM , PC ); + {$ENDIF DEBUG} +{$ENDIF PATCH_CHEAT} AttachMenuDesc( InvRPM , ZONE_Menu2 ); +{$IFDEF PATCH_CHEAT} + if not(Cheat_InvMenu_NoSort) then begin + if Cheat_InvMenu_ShowSubItem then begin + RPMSortAlpha_withSubItem( InvRPM ); + end else begin + RPMSortAlpha( InvRPM ); + end; + end; +{$ELSE PATCH_CHEAT} RPMSortAlpha( InvRPM ); +{$ENDIF PATCH_CHEAT} { If the menu is empty, add a message saying so. } +{$IFDEF PATCH_I18N} + If InvRPM^.NumItem < 1 then AddRPGMenuItem( InvRPM , I18N_MsgString('CreateInvMenu','no inventory items') , -1 ) +{$ELSE PATCH_I18N} If InvRPM^.NumItem < 1 then AddRPGMenuItem( InvRPM , '[no inventory items]' , -1 ) +{$ENDIF PATCH_I18N} else AlphaKeyMenu( InvRPM ); { Add the menu keys. } AddRPGMenuKey(InvRPM,'/',-2); +{$IFDEF PATCH_CHEAT} + if Cheat_MenuOrder_Edit then begin + AddRPGMenuKey( InvRPM , KeyMap[ KMC_EditMenuOrder ].KCode , -128 ); + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + if ( 1 < InvRPM^.NumItem ) then begin + AddRPGMenuItem_Top( InvRPM , I18N_MsgString( 'ThisItemWasSelected', 'DropAll' ), -3 ); + AddRPGMenuItem_Top( InvRPM , I18N_MsgString( 'ThisItemWasSelected', 'TransferAll' ), -4 ); + end; +{$ENDIF PATCH_GH} end; Procedure CreateEqpMenu( PC: GearPtr ); { Allocate the equipment menu and fill it up with the PC's gear. } +{$IFDEF PATCH_CHEAT} + Function AddRPGMenu_MassMeter( RPM: RPGMenuPtr; PC: GearPtr): String; + { On top of the backpack seperator, display the current inventory mass, and the carrying capacity } + { Origin : Michael } + { http://gearheadrpg.com/forum/index.php?action=vthread&forum=1&topic=789 } + { ftp://ftp.ocis.net/pub/users/ldeutsch/ghpatches/gh-1100-massmeter1.diff } + var + MassString: String; + CurrentInv,CurrentEqp,Limit,Limit2: LongInt; + begin + CurrentInv := IntrinsicMass(PC); + CurrentEqp := EquipmentMass(PC); + Limit2 := GearEncumberance(PC); + + Limit := Limit2 * 2 - 1; {Maximum weight before penalty starts} + + if PC^.G = GG_Character then begin + Limit := Limit + NAttValue(PC^.NA,NAG_Skill,NAS_WeightLifting); + end; + + Limit2 := Limit2 + Limit; {Where penalty gets worse} + + MassString := ReplaceHash( I18N_MsgString('CreateEqpMenu','MassMeter'), + MakeMassString(CurrentInv,PC^.Scale), + MakeMassString(CurrentEqp,PC^.Scale) ); + AddRPGMenuItem_Top( RPM, #$0 + MassString, 0 ); + + MassString := ReplaceHash( I18N_MsgString('CreateEqpMenu','MassMeter_Limit'), + MakeMassString(Limit,PC^.Scale) ); + if Limit2 < CurrentEqp then begin + MassString := MassString + I18N_MsgString('CreateEqpMenu','MassMeter_LimitOver2'); + end else if Limit < CurrentEqp then begin + MassString := MassString + I18N_MsgString('CreateEqpMenu','MassMeter_LimitOver'); + end else begin + end; + AddRPGMenuItem_Top( RPM, #$0 + MassString, 0 ); + end; +{$ENDIF PATCH_CHEAT} begin if EqpRPM <> Nil then DisposeRPGMenu( EqpRPM ); EqpRPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_EqpMenu ); EqpRPM^.Mode := RPMNoCleanup; AttachMenuDesc( EqpRPM , ZONE_Menu2 ); +{$IFDEF DEBUG} + EqpRPM_MaxNum := BuildEquipmentMenu( EqpRPM , PC ); +{$ELSE DEBUG} BuildEquipmentMenu( EqpRPM , PC ); +{$ENDIF DEBUG} { If the menu is empty, add a message saying so. } +{$IFDEF PATCH_I18N} + If EqpRPM^.NumItem < 1 then AddRPGMenuItem( EqpRPM , #$0 + I18N_MsgString('CreateEqpMenu','no equipped items') , -1 ); +{$ELSE PATCH_I18N} If EqpRPM^.NumItem < 1 then AddRPGMenuItem( EqpRPM , '[no equipped items]' , -1 ); +{$ENDIF PATCH_I18N} { Add the menu keys. } AddRPGMenuKey(EqpRPM,'/',-2); + +{$IFDEF PATCH_CHEAT} + if Cheat_EqpMenu_AddMenuKey then begin + AlphaKeyMenu( EqpRPM ); + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + if ( 1 < EqpRPM^.NumItem ) then begin + AddRPGMenuItem_Top( EqpRPM , I18N_MsgString( 'ThisItemWasSelected', 'DropAll' ), -3 ); + AddRPGMenuItem_Top( EqpRPM , I18N_MsgString( 'ThisItemWasSelected', 'TransferAll' ), -4 ); + end; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + If Cheat_EqpMenu_ShowMassMeter then begin + if (NIL <> PC) and (GG_DisposeGear < PC^.G) then begin + AddRPGMenu_MassMeter( EqpRPM, PC ); + end; + end; +{$ENDIF PATCH_CHEAT} end; Procedure UpdateBackpack( PC: GearPtr ); @@ -584,6 +1068,13 @@ Procedure GivePartToPC( GB: GameBoardPtr var team: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = GB) then begin + InsertInvCom( PC, Part ); + end else +{$ENDIF PATCH_GH} if ( PC <> Nil ) and IsLegalSlot( PC , Part ) then begin InsertInvCom( PC , Part ); end else begin @@ -600,6 +1091,10 @@ Procedure UnequipItem( GB: GameBoardPtr; { Delink ITEM from its parent, and stick it in the general inventory... } { If possible. Otherwise drop it. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} { First, delink Item from its parent. } DelinkGear( Item^.Parent^.InvCom , Item ); { HOW'D YA LIKE THEM CARROT DOTS, EH!?!? } @@ -615,7 +1110,15 @@ Procedure UnequipFrontend( GB: GameBoard { Simply unequip the provided item. } { PRECOND: PC and ITEM had better be correct, dagnabbit... } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('UnequipFrontend','You unequip'), GearName(Item) ) ); +{$ELSE PATCH_I18N} DialogMsg( 'You unequip ' + GearName( Item ) + '.' ); +{$ENDIF PATCH_I18N} UnequipItem( GB , PC , Item ); end; @@ -624,6 +1127,52 @@ Function CanBeExtracted( Item: GearPtr ) { Return TRUE if the listed part can be extracted from a mecha, } { or FALSE if it cannot normally be extracted. } begin +{$IFDEF PATCH_GH} + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + if ( Item^.G = GG_Support ) then begin + CanBeExtracted := False; + if Cheat_MechaCustomize_FreeSupport then begin + CanBeExtracted := True; + end; + end else if ( Item^.G = GG_Cockpit ) then begin + CanBeExtracted := False; + if Cheat_MechaCustomize_FreeCockpit then begin + CanBeExtracted := True; + end; + end else if IsMasterGear( Item ) then begin + CanBeExtracted := False; + if Cheat_MechaCustomize_FreeMasterGear then begin + CanBeExtracted := True; + end; + end else if ( Item^.Parent = Nil ) then begin + CanBeExtracted := False; + if Cheat_MechaCustomize_FreeParent then begin + CanBeExtracted := True; + end; + end else if ( Item^.Parent^.Scale = 0 ) then begin + CanBeExtracted := False; + if Cheat_MechaCustomize_FreeScale then begin + CanBeExtracted := True; + end; + end else if ( Item^.G = GG_Modifier ) then begin + CanBeExtracted := False; + if Cheat_MechaCustomize_FreeModifier then begin + CanBeExtracted := True; + end; + end else if ( Item^.G = GG_Module ) and ( Item^.S = GS_Body ) then begin + CanBeExtracted := False; + if Cheat_MechaCustomize_FreeBodyModule then begin + CanBeExtracted := True; + end; + end else begin + CanBeExtracted := True; + end; + if Cheat_MechaCustomize_Limitless then begin + CanBeExtracted := True; + end; +{$ELSE PATCH_CHEAT} if ( Item^.G = GG_Support ) or ( Item^.G = GG_Cockpit ) or IsMasterGear( Item ) or ( Item^.Parent = Nil ) or ( Item^.Parent^.Scale = 0 ) or ( Item^.G = GG_Modifier ) then begin CanBeExtracted := False; end else if ( Item^.G = GG_Module ) and ( Item^.S = GS_Body ) then begin @@ -631,9 +1180,14 @@ begin end else begin CanBeExtracted := True; end; +{$ENDIF PATCH_CHEAT} end; +{$IFDEF PATCH_CHEAT} +Function ExtractItem( GB: GameBoardPtr; LList, TruePC, PC: GearPtr; var Item: GearPtr ): Boolean; +{$ELSE PATCH_CHEAT} Function ExtractItem( GB: GameBoardPtr; TruePC , PC: GearPtr; var Item: GearPtr ): Boolean; +{$ENDIF PATCH_CHEAT} { Delink ITEM from its parent, and stick it in the general inventory. } { Note that pulling a gear out of its mecha may well wreck it } { beyond any repair! Therefore, after this call, ITEM might no } @@ -642,6 +1196,14 @@ var it: Boolean; SkTarget,SkRoll,WreckTarget: Integer; begin +{$IFDEF PATCH_GH} + { Don't kick out the NIL of GB at here. } + { Don't kick out the GG_DisposeGear of LList at here. } + if (NIL = TruePC) or (TruePC^.G <= GG_DisposeGear) then Exit(False); + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { First, calculate the skill target. } SkTarget := 2 + ComponentComplexity( Item ); if Item^.G = GG_Module then begin @@ -653,11 +1215,27 @@ begin end; if WreckTarget < SkTarget then WreckTarget := SkTarget + 1; +{$IFDEF PATCH_GH} + if (NIL <> GB) then begin + SkRoll := RollStep( TeamSkill( GB , NAV_DefPlayerTeam , 31 ) ); + end else if (NIL <> LList) then begin + SkRoll := RollStep( TeamSkill( LList, 31 ) ); + end else begin + SkRoll := RollStep( SkillValue( TruePC, 31 ) ); + end; +{$ELSE PATCH_GH} SkRoll := RollStep( TeamSkill( GB , NAV_DefPlayerTeam , 31 ) ); +{$ENDIF PATCH_GH} DoleSkillExperience( TruePC , 31 , 1 ); AddMentalDown( TruePC , 1 ); +{$IFDEF PATCH_GH} + if (NIL <> GB) then begin + WaitAMinute( GB , TruePC , ReactionTime( TruePC ) * 5 ); + end; +{$ELSE PATCH_GH} WaitAMinute( GB , TruePC , ReactionTime( TruePC ) * 5 ); +{$ENDIF PATCH_GH} if SkRoll > WreckTarget then begin { First, delink Item from its parent. } @@ -682,16 +1260,31 @@ begin ExtractItem := it; end; +{$IFDEF PATCH_CHEAT} +Procedure ExtractFrontend( GB: GameBoardPtr; LList, TruePC, PC, Item: GearPtr ); +{$ELSE PATCH_CHEAT} Procedure ExtractFrontend( GB: GameBoardPtr; TruePC , PC , Item: GearPtr ); +{$ENDIF PATCH_CHEAT} { Simply remove the provided item. } { PRECOND: PC and ITEM had better be correct, dagnabbit... } var name: String; begin +{$IFDEF PATCH_GH} + { Don't kick out the NIL of GB at here. } + { Don't kick out the GG_DisposeGear of LList at here. } + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + name := GearName( Item ); if GearActive( PC ) then begin DialogMsg( MsgString( 'EXTRACT_NOTACTIVE' ) ); +{$IFDEF PATCH_CHEAT} + end else if ExtractItem( GB, LList, TruePC, PC, Item ) then begin +{$ELSE PATCH_CHEAT} end else if ExtractItem( GB , TruePC , PC , Item ) then begin +{$ENDIF PATCH_CHEAT} if Item = Nil then begin DialogMsg( ReplaceHash( MsgString( 'EXTRACT_WRECK' ) , name ) ); end else begin @@ -712,6 +1305,12 @@ Procedure EquipItem( GB: GameBoardPtr; P var I2,I3: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Slot) or (Slot^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { First, check for already equipped items. } I2 := Slot^.InvCom; while I2 <> Nil do begin @@ -737,35 +1336,110 @@ Procedure EquipItemFrontend( GB: GameBoa { general inventory into its new home. } var EI_Menu: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; -begin +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + ReBrowse: Boolean; +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + MaxNum: LongInt; +{$ENDIF DEBUG} +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Build the slot selection menu. } EI_Menu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); +{$IFDEF DEBUG} + MaxNum := BuildSlotMenu( EI_Menu , PC , Item ); +{$ELSE DEBUG} BuildSlotMenu( EI_Menu , PC , Item ); +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + if EI_Menu^.NumItem < 1 then AddRPGMenuItem( EI_Menu , ReplaceHash( I18N_MsgString('EquipItemFrontend','cannot equip'), GearName(Item) ) , -1 ); +{$ELSE PATCH_I18N} if EI_Menu^.NumItem < 1 then AddRPGMenuItem( EI_Menu , '[cannot equip ' + GearName( Item ) + ']' , -1 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + repeat + ReBrowse := False; + {$IFDEF SDLMODE} + N := SelectMenu( EI_Menu , @MiscProcRedraw); + {$ELSE SDLMODE} + N := SelectMenu( EI_Menu ); + {$ENDIF SDLMODE} + + if N < -1 then begin + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('EquipItemFrontend','You can not install to it') ); + {$ELSE PATCH_I18N} + DialogMSG( 'You can not install to it.' ); + {$ENDIF PATCH_I18N} + ReBrowse := True; + end else if 0 <= N then begin + {$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('EquipItemFrontend','You equip'), GearName(Item) ) ); + {$ELSE PATCH_I18N} + DialogMsg( 'You equip ' + GearName( Item ) + '.' ); + {$ENDIF PATCH_I18N} + {$IFDEF DEBUG} + EquipItem( GB , PC , LocateGearByNumber( PC , N, False, MaxNum, 'EquipItemFrontend' ) , Item ); + {$ELSE DEBUG} + EquipItem( GB , PC , LocateGearByNumber( PC , N ) , Item ); + {$ENDIF DEBUG} + end; + until False = ReBrowse; + DisposeRPGMenu( EI_Menu ); +{$ELSE PATCH_CHEAT} { Select a slot for the item to go into. } -{$IFDEF SDLMODE} + {$IFDEF SDLMODE} N := SelectMenu( EI_Menu , @MiscProcRedraw); -{$ELSE} + {$ELSE} N := SelectMenu( EI_Menu ); -{$ENDIF} + {$ENDIF} DisposeRPGMenu( EI_Menu ); { If a slot was selected, pass that info on to the workhorse. } if N <> -1 then begin + {$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('EquipItemFrontend','You equip'), GearName(Item) ) ); + {$ELSE PATCH_I18N} DialogMsg( 'You equip ' + GearName( Item ) + '.' ); + {$ENDIF PATCH_I18N} + {$IFDEF DEBUG} + EquipItem( GB , PC , LocateGearByNumber( PC , N, False, MaxNum, 'EquipItemFrontend' ) , Item ); + {$ELSE DEBUG} EquipItem( GB , PC , LocateGearByNumber( PC , N ) , Item ); + {$ENDIF DEBUG} end; +{$ENDIF PATCH_CHEAT} end; +{$IFDEF PATCH_CHEAT} +Function InstallItem( GB: GameBoardPtr; LList, TruePC, Slot: GearPtr; var Item: GearPtr ): Boolean; +{$ELSE PATCH_CHEAT} Function InstallItem( GB: GameBoardPtr; TruePC , Slot: GearPtr; var Item: GearPtr ): Boolean; +{$ENDIF PATCH_CHEAT} { Attempt the skill rolls needed to install ITEM into the } { requested slot. } var SlotCom,ItemCom,UsedCom: Integer; SkTarget,WreckTarget,SkRoll: Integer; begin +{$IFDEF PATCH_GH} + { Don't kick out the NIL of GB at here. } + { Don't kick out the GG_DisposeGear of LList at here. } + if (NIL = TruePC) or (TruePC^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Slot) or (Slot^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Error Check - no circular references! } if ( FindGearIndex( Item , Slot ) <> -1 ) then Exit( False ); @@ -773,7 +1447,11 @@ begin if CurrentMental( TruePC ) < 1 then Exit( False ); { Can't install into a personal-scale slot. } +{$IFDEF PATCH_CHEAT} + if (Slot^.Scale = 0) and not(Cheat_MechaCustomize_FreeScale) then Exit( False ); +{$ELSE PATCH_CHEAT} if Slot^.Scale = 0 then Exit( False ); +{$ENDIF PATCH_CHEAT} SlotCom := ComponentComplexity( Slot ); ItemCom := ComponentComplexity( Item ); @@ -805,9 +1483,25 @@ begin SkTarget := SkTarget + ItemCom + UsedCom - SlotCom + 5; end; +{$IFDEF PATCH_GH} + if (NIL <> GB) then begin + WaitAMinute( GB , TruePC , ReactionTime( TruePC ) * 5 ); + end; +{$ELSE PATCH_GH} WaitAMinute( GB , TruePC , ReactionTime( TruePC ) * 5 ); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + if (NIL <> GB) then begin + SkRoll := RollStep( TeamSkill( GB , NAV_DefPlayerTeam , 31 ) ); + end else if (NIL <> LList) then begin + SkRoll := RollStep( TeamSkill( LList, 31 ) ); + end else begin + SkRoll := RollStep( SkillValue( TruePC, 31 ) ); + end; +{$ELSE PATCH_GH} SkRoll := RollStep( TeamSkill( GB , NAV_DefPlayerTeam , 31 ) ); +{$ENDIF PATCH_GH} if SkRoll > SkTarget then begin { Install the item. } DoleSkillExperience( TruePC , 31 , 5 ); @@ -825,14 +1519,44 @@ begin InstallItem := SkRoll > SkTarget; end; +{$IFDEF PATCH_CHEAT} +Procedure InstallFrontend( GB: GameBoardPtr; LList, TruePC, PC, Item: GearPtr ); +{$ELSE PATCH_CHEAT} Procedure InstallFrontend( GB: GameBoardPtr; TruePC , PC , Item: GearPtr ); +{$ENDIF PATCH_CHEAT} { Assign ITEM to a legal equipment slot. Move it from the } { general inventory into its new home. } var EI_Menu: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} name: String; -begin +{$IFDEF PATCH_CHEAT} + ReBrowse: Boolean; +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + MaxNum: LongInt; +{$ENDIF DEBUG} +begin +{$IFDEF PATCH_GH} + { Don't kick out the NIL of GB at here. } + { Don't kick out the GG_DisposeGear of LList at here. } + if (NIL = TruePC) or (TruePC^.G <= GG_DisposeGear) + or (NIL = PC) or (PC^.G <= GG_DisposeGear) + or (NIL = Item) or (Item^.G <= GG_DisposeGear) + then begin + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('InstallFrontend','You can not install to it') ); + {$ELSE PATCH_I18N} + DialogMSG( 'You can not install to it.' ); + {$ENDIF PATCH_I18N} + Exit; + end; +{$ENDIF PATCH_GH} + { Error check- can't install into an active master. } if GearActive( PC ) then begin DialogMsg( MsgString( 'INSTALL_NOTACTIVE' ) ); @@ -841,16 +1565,79 @@ begin { Build the slot selection menu. } EI_Menu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); +{$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} + MaxNum := BuildSubMenu( EI_Menu , PC , Item , True, Cheat_Install_ShowSubItem ); + {$ELSE DEBUG} + BuildSubMenu( EI_Menu , PC , Item , True, Cheat_Install_ShowSubItem ); + {$ENDIF DEBUG} + {$IFDEF PATCH_I18N} + if EI_Menu^.NumItem < 1 then AddRPGMenuItem( EI_Menu , ReplaceHash( I18N_MsgString('InstallFrontend','cannot install'), GearName(Item) ) , -1 ); + {$ELSE PATCH_I18N} + if EI_Menu^.NumItem < 1 then AddRPGMenuItem( EI_Menu , '[cannot install ' + GearName( Item ) + ']' , -1 ); + {$ENDIF PATCH_I18N} + + repeat + ReBrowse := False; + DialogMsg( GearName( Item ) + ' cmx:' + BStr( ComponentComplexity( Item ) ) + '. ' + MsgSTring( 'BACKPACK_InstallInfo' ) ); + {$IFDEF SDLMODE} + N := SelectMenu( EI_Menu , @MiscProcRedraw); + {$ELSE} + N := SelectMenu( EI_Menu ); + {$ENDIF} + + if N < -1 then begin + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('InstallFrontend','You can not install to it') ); + {$ELSE PATCH_I18N} + DialogMSG( 'You can not install to it.' ); + {$ENDIF PATCH_I18N} + ReBrowse := True; + end else if 0 <= N then begin + name := GearName( Item ); + {$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} + if InstallItem( GB, LList, TruePC, LocateGearByNumber( PC, N, False, MaxNum, 'InstallFrontend' ), Item ) then begin + {$ELSE DEBUG} + if InstallItem( GB, LList, TruePC, LocateGearByNumber( PC, N ), Item ) then begin + {$ENDIF DEBUG} + {$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} + if InstallItem( GB , TruePC , LocateGearByNumber( PC , N, False, MaxNum, 'InstallFrontend' ) , Item ) then begin + {$ELSE DEBUG} + if InstallItem( GB , TruePC , LocateGearByNumber( PC , N ) , Item ) then begin + {$ENDIF DEBUG} + {$ENDIF PATCH_CHEAT} + DialogMsg( ReplaceHash( MsgString( 'INSTALL_OK' ) , name ) ); + end else begin + if Item = Nil then begin + DialogMsg( ReplaceHash( MsgString( 'INSTALL_WRECK' ) , name ) ); + end else begin + DialogMsg( ReplaceHash( MsgString( 'INSTALL_FAIL' ) , name ) ); + end; + end; + end; + until False = ReBrowse; + DisposeRPGMenu( EI_Menu ); +{$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} + MaxNum := BuildSubMenu( EI_Menu , PC , Item , True ); + {$ELSE DEBUG} BuildSubMenu( EI_Menu , PC , Item , True ); + {$ENDIF DEBUG} + {$IFDEF PATCH_I18N} + if EI_Menu^.NumItem < 1 then AddRPGMenuItem( EI_Menu , ReplaceHash( I18N_MsgString('InstallFrontend','cannot install'), GearName(Item) ) , -1 ); + {$ELSE PATCH_I18N} if EI_Menu^.NumItem < 1 then AddRPGMenuItem( EI_Menu , '[cannot install ' + GearName( Item ) + ']' , -1 ); + {$ENDIF PATCH_I18N} { Select a slot for the item to go into. } DialogMsg( GearName( Item ) + ' cmx:' + BStr( ComponentComplexity( Item ) ) + '. ' + MsgSTring( 'BACKPACK_InstallInfo' ) ); -{$IFDEF SDLMODE} + {$IFDEF SDLMODE} N := SelectMenu( EI_Menu , @MiscProcRedraw); -{$ELSE} + {$ELSE} N := SelectMenu( EI_Menu ); -{$ENDIF} + {$ENDIF} DisposeRPGMenu( EI_Menu ); { If a slot was selected, pass that info on to the workhorse. } @@ -858,7 +1645,19 @@ begin { Store the name here, since the item might get destroyed } { during the installation process. } name := GearName( Item ); + {$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} + if InstallItem( GB, LList, TruePC, LocateGearByNumber( PC, N, False, MaxNum, 'InstallFrontend' ), Item ) then begin + {$ELSE DEBUG} + if InstallItem( GB, LList, TruePC, LocateGearByNumber( PC, N ), Item ) then begin + {$ENDIF DEBUG} + {$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} + if InstallItem( GB , TruePC , LocateGearByNumber( PC , N, False, MaxNum, 'InstallFrontend' ) , Item ) then begin + {$ELSE DEBUG} if InstallItem( GB , TruePC , LocateGearByNumber( PC , N ) , Item ) then begin + {$ENDIF DEBUG} + {$ENDIF PATCH_CHEAT} DialogMsg( ReplaceHash( MsgString( 'INSTALL_OK' ) , name ) ); end else begin if Item = Nil then begin @@ -868,22 +1667,115 @@ begin end; end; end; +{$ENDIF PATCH_CHEAT} +end; + +{$IFDEF PATCH_GH} +Procedure InstallAmmo( GB: GameBoardPtr; PC , Gun , Ammo: GearPtr ); + { Place the ammunition gear into the gun. } +var + A,A2: GearPtr; +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Gun) or (Gun^.G <= GG_DisposeGear) then Exit; + if (NIL = Ammo) or (Ammo^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + + { To start with, unload any ammo currently in the gun. } + A := Gun^.SubCom; + while A <> Nil do begin + A2 := A^.Next; + +{$IFDEF PATCH_GH} + if (GG_DisposeGear < A^.G) then begin +{$ENDIF PATCH_GH} + if A^.G = GG_Ammo then begin + DelinkGear( Gun^.SubCom , A ); + InsertInvCom( PC , A ); + end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} + + A := A2; + end; + + { Delink the magazine from wherever it currently resides. } + if IsInvCom( Ammo ) then begin + DelinkGear( Ammo^.Parent^.InvCom , Ammo ); + end else if IsSubCom( Ammo ) then begin + DelinkGear( Ammo^.Parent^.SubCom , Ammo ); + end; + + { Stick the new magazine into the gun. } + InsertSubCom( Gun , Ammo ); + + { Loading a gun takes time. } + if GB <> Nil then begin + WaitAMinute_Part( GB , PC , ReactionTime( PC ) ); + end; +end; + +Function NeedAmmo( Weapon: GearPtr ): Boolean; +begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if ( GG_Weapon <> Weapon^.G ) then exit( False ); + if ( GS_Ballistic <> Weapon^.S ) and ( GS_Missile <> Weapon^.S ) then exit( False ); + NeedAmmo := True; end; +Function ReloadAmmo( GB: GameBoardPtr; User,Weapon: GearPtr ): Boolean; +var + Ammo: GearPtr; + msg: String; +begin +{$IFDEF PATCH_GH} + if (NIL = User) or (User^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if ( GG_Weapon <> Weapon^.G ) then exit( False ); + if ( GS_Ballistic <> Weapon^.S ) and ( GS_Missile <> Weapon^.S ) then exit( False ); + if ( NIL <> LocateGoodAmmo( Weapon ) ) then exit( True ); + + Ammo := SearchGoodAmmo( User , Weapon ); + if ( NIL <> Ammo ) then begin + DialogMsg( ReplaceHash( I18N_MsgString('ReloadAmmo','Ammo loaded'), GearName( LocatePilot( User ) ) , GearName(Weapon) , GearName(Ammo) ) ); + + { Loading a gun takes time. } + InstallAmmo( GB , User , Weapon , Ammo ); + end; + ReloadAmmo := ( NIL <> LocateGoodAmmo( Weapon ) ); +end; +{$ELSE PATCH_GH} Procedure InstallAmmo( GB: GameBoardPtr; PC , Gun , Ammo: GearPtr ); { Place the ammunition gear into the gun. } var A,A2: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Gun) or (Gun^.G <= GG_DisposeGear) then Exit; + if (NIL = Ammo) or (Ammo^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { To start with, unload any ammo currently in the gun. } A := Gun^.SubCom; while A <> Nil do begin A2 := A^.Next; +{$IFDEF PATCH_GH} + if (GG_DisposeGear < A^.G) then begin +{$ENDIF PATCH_GH} if A^.G = GG_Ammo then begin DelinkGear( Gun^.SubCom , A ); InsertInvCom( PC , A ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} A := A2; end; @@ -901,6 +1793,7 @@ begin { Loading a gun takes time. } if GB <> Nil then WaitAMinute( GB , PC , ReactionTime( PC ) ); end; +{$ENDIF PATCH_GH} Procedure InstallAmmoFrontend( GB: GameBoardPtr; PC , Item: GearPtr ); { Assign ITEM to a legal projectile weapon. Move it from the } @@ -908,27 +1801,102 @@ Procedure InstallAmmoFrontend( GB: GameB var IA_Menu: RPGMenuPtr; Gun: GearPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; -begin +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + ReBrowse: Boolean; +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + MaxNum: LongInt; +{$ENDIF DEBUG} +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Build the slot selection menu. } IA_Menu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); +{$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} + MaxNum := BuildSubMenu( IA_Menu , PC , Item , False, Cheat_InstallAmmo_ShowSubItem ); + {$ELSE DEBUG} + BuildSubMenu( IA_Menu , PC , Item , False, Cheat_InstallAmmo_ShowSubItem ); + {$ENDIF DEBUG} + {$IFDEF PATCH_I18N} + if IA_Menu^.NumItem < 1 then AddRPGMenuItem( IA_Menu , ReplaceHash( I18N_MsgString('InstallAmmoFrontend','no weapon'), GearName(Item) ) , -1 ); + {$ELSE PATCH_I18N} + if IA_Menu^.NumItem < 1 then AddRPGMenuItem( IA_Menu , '[no weapon for ' + GearName( Item ) + ']' , -1 ); + {$ENDIF PATCH_I18N} + + repeat + ReBrowse := False; + {$IFDEF SDLMODE} + N := SelectMenu( IA_Menu , @MiscProcRedraw); + {$ELSE} + N := SelectMenu( IA_Menu ); + {$ENDIF} + + if N < -1 then begin + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('InstallAmmoFrontend','You can not install to it') ); + {$ELSE PATCH_I18N} + DialogMSG( 'You can not install to it.' ); + {$ENDIF PATCH_I18N} + ReBrowse := True; + end else if 0 <= N then begin + {$IFDEF DEBUG} + Gun := LocateGearByNumber( PC , N, False, MaxNum, 'InstallAmmoFrontend' ); + {$ELSE DEBUG} + Gun := LocateGearByNumber( PC , N ); + {$ENDIF DEBUG} + {$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('InstallAmmoFrontend','You load'), GearName(Gun), GearName(Item) ) ); + {$ELSE PATCH_I18N} + DialogMsg( 'You load ' + GearName( Item ) + ' into ' + GearName( Gun ) + '.' ); + {$ENDIF PATCH_I18N} + InstallAmmo( GB , PC , Gun , Item ); + end; + until False = ReBrowse; + DisposeRPGMenu( IA_Menu ); +{$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} + MaxNum := BuildSubMenu( IA_Menu , PC , Item , False ); + {$ELSE DEBUG} BuildSubMenu( IA_Menu , PC , Item , False ); + {$ENDIF DEBUG} + {$IFDEF PATCH_I18N} + if IA_Menu^.NumItem < 1 then AddRPGMenuItem( IA_Menu , ReplaceHash( I18N_MsgString('InstallAmmoFrontend','no weapon'), GearName(Item) ) , -1 ); + {$ELSE PATCH_I18N} if IA_Menu^.NumItem < 1 then AddRPGMenuItem( IA_Menu , '[no weapon for ' + GearName( Item ) + ']' , -1 ); + {$ENDIF PATCH_I18N} { Select a slot for the item to go into. } -{$IFDEF SDLMODE} + {$IFDEF SDLMODE} N := SelectMenu( IA_Menu , @MiscProcRedraw); -{$ELSE} + {$ELSE} N := SelectMenu( IA_Menu ); -{$ENDIF} + {$ENDIF} DisposeRPGMenu( IA_Menu ); { If a slot was selected, pass that info on to the workhorse. } if N <> -1 then begin + {$IFDEF DEBUG} + Gun := LocateGearByNumber( PC , N, False, MaxNum, 'InstallAmmoFrontend' ); + {$ELSE DEBUG} Gun := LocateGearByNumber( PC , N ); + {$ENDIF DEBUG} + {$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('InstallAmmoFrontend','You load'), GearName(Gun), GearName(Item) ) ); + {$ELSE PATCH_I18N} DialogMsg( 'You load ' + GearName( Item ) + ' into ' + GearName( Gun ) + '.' ); + {$ENDIF PATCH_I18N} InstallAmmo( GB , PC , Gun , Item ); end; +{$ENDIF PATCH_CHEAT} end; @@ -938,8 +1906,16 @@ Procedure DropFrontEnd( PC , Item: GearP { Copy PC's location variables to ITEM. } { Install ITEM as the next sibling of PC. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Make sure PC is at root level... } PC := FindRoot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} { Delink ITEM from its parent... } DelinkGear( Item^.Parent^.InvCom , Item ); @@ -954,21 +1930,171 @@ begin PC^.Next := Item; { Do display stuff. } +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('DropFrontEnd','You drop'), GearName(Item) ) ); +{$ELSE PATCH_I18N} DialogMsg( 'You drop ' + GearName( Item ) + '.' ); +{$ENDIF PATCH_I18N} end; -Procedure TradeFrontend( GB: GameBoardPtr; PC , Item, LList: GearPtr ); - { Assign ITEM to a different master. Move it from the } - { general inventory of PC into its new home. } +Procedure DropAllFrontEnd( GB: GameBoardPtr; var LList: GearPtr; PC , Part: GearPtr ); +var + Part_Next: GearPtr; +begin + while ( NIL <> Part ) do begin + Part_Next := Part^.Next; + if CheckAlongPath_DisallowDropping( Part ) then begin + end else begin + DropFrontEnd( PC , Part ); + end; + Part := Part_Next; + end; +end; + +Procedure DropEqpAllFrontEnd( GB: GameBoardPtr; var LList: GearPtr; PC , Master: GearPtr ); + Procedure CheckAlongPath( Part: GearPtr; IsInv: Boolean ); + var + Part_Next: GearPtr; + begin + while ( NIL <> Part ) do begin + Part_Next := Part^.Next; + if IsInv and ( not CheckAlongPath_DisallowDropping( Part ) ) then begin + DropFrontEnd( PC , Part ); + end; + CheckAlongPath( Part^.InvCom , True ); + CheckAlongPath( Part^.SubCom , False ); + Part := Part_Next; + end; + end; +begin + CheckAlongPath( Master^.InvCom , False ); + CheckAlongPath( Master^.SubCom , False ); +end; + +{$IFDEF PATCH_GH} +Function TradeFrontEnd_GetDest( GB: GameBoardPtr; PC , LList: GearPtr ): GearPtr; var TI_Menu: RPGMenuPtr; M: GearPtr; - Team,N: Integer; + Team: Integer; + N: LongInt; begin +{$IFDEF PATCH_CHEAT} + if (NIL <> GB) then begin + if not (Cheat_Trade_NotSafeArea or IsSafeArea( GB )) then begin + DialogMsg( MsgSTring('TRANSFER_NOTHERE') ); + Exit( NIL ); + end; + + if not (IsSafeArea( GB )) then begin + WaitAMinute( GB , PC , ReactionTime( PC ) ); + end; + end; +{$ELSE PATCH_CHEAT} + if not IsSafeArea( GB ) then begin + DialogMsg( MsgSTring( 'TRANSFER_NOTHERE' ) ); + Exit( NIL ); + end; +{$ENDIF PATCH_CHEAT} + + { Build the slot selection menu. } + TI_Menu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); + N := 1; + M := LList; + Team := NAttValue( PC^.NA , NAG_Location , NAS_Team ); + + { This menu should contain all the masters from LList which } + { belong to Team 1. } + while ( NIL <> M ) do begin + if (GG_DisposeGear < M^.G) then begin + if ( Team = NAV_DefPlayerTeam ) or ( Team = NAV_LancemateTeam ) then begin + if IsMasterGear( M ) and ( ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) or ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) ) and ( M <> PC ) then begin + AddRPGMenuItem( TI_Menu , GearName( M ) , N ); + end; + end else begin + if IsMasterGear( M ) and ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = Team ) and ( M <> PC ) then begin + AddRPGMenuItem( TI_Menu , GearName( M ) , N ); + end; + end; + Inc( N ); + end; + M := M^.Next; + end; + AlphaKeyMenu( TI_Menu ); + +{$IFDEF PATCH_I18N} + if TI_Menu^.NumItem < 1 then AddRPGMenuItem( TI_Menu , I18N_MsgString( 'TradeFrontEnd' , 'CannotTrade' ) , -1 ); +{$ELSE PATCH_I18N} + if TI_Menu^.NumItem < 1 then AddRPGMenuItem( TI_Menu , '[cannot trade ' + GearName( Item ) + ']' , -1 ); +{$ENDIF PATCH_I18N} + + { Select a slot for the item to go into. } +{$IFDEF SDLMODE} + if Cheat_DisplayGearInfo then begin + MPR_InvMenu := TI_Menu; + MPR_InvMenuRGS := LList; + end; + N := SelectMenu( TI_Menu , @MiscProcRedraw); + MPR_InvMenuRGS := NIL; + MPR_InvMenu := NIL; +{$ELSE} + N := SelectMenu( TI_Menu ); +{$ENDIF} + DisposeRPGMenu( TI_Menu ); + + TradeFrontEnd_GetDest := RetrieveGearSib( LList , N ); +end; +{$ENDIF PATCH_GH} + +Procedure TradeFrontend( GB: GameBoardPtr; PC , Item, LList: GearPtr ); + { Assign ITEM to a different master. Move it from the } + { general inventory of PC into its new home. } +var +{$IFDEF PATCH_GH} + M: GearPtr; +{$ELSE PATCH_GH} + TI_Menu: RPGMenuPtr; + M: GearPtr; + Team,N: Integer; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; + { Don't kick out the GG_DisposeGear of LList at here. } +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + M := TradeFrontEnd_GetDest( GB , PC , LList ); + + { If a slot was selected, pass that info on to the workhorse. } + if ( NIL <> M ) then begin + if IsLegalSlot( M , Item ) then begin + DelinkGear( Item^.Parent^.InvCom , Item ); + InsertInvCom( M , Item ); + DialogMsg( MsgString( 'BACKPACK_ItemTraded' ) ); + end else begin + DialogMsg( MsgString( 'BACKPACK_NotTraded' ) ); + end; + end; +{$ELSE PATCH_GH} +{$IFDEF PATCH_CHEAT} + if (NIL <> GB) then begin + if not (Cheat_Trade_NotSafeArea or IsSafeArea( GB )) then begin + DialogMsg( MsgSTring('TRANSFER_NOTHERE') ); + Exit; + end; + + if not (IsSafeArea( GB )) then begin + WaitAMinute( GB , PC , ReactionTime( PC ) ); + end; + end; +{$ELSE PATCH_CHEAT} if not IsSafeArea( GB ) then begin DialogMsg( MsgSTring( 'TRANSFER_NOTHERE' ) ); Exit; end; +{$ENDIF PATCH_CHEAT} { Build the slot selection menu. } TI_Menu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); @@ -993,7 +2119,11 @@ begin end; AlphaKeyMenu( TI_Menu ); +{$IFDEF PATCH_I18N} + if TI_Menu^.NumItem < 1 then AddRPGMenuItem( TI_Menu , ReplaceHash( I18N_MsgString('TradeFrontend','cannot trade'), GearName(Item) ) , -1 ); +{$ELSE PATCH_I18N} if TI_Menu^.NumItem < 1 then AddRPGMenuItem( TI_Menu , '[cannot trade ' + GearName( Item ) + ']' , -1 ); +{$ENDIF PATCH_I18N} { Select a slot for the item to go into. } {$IFDEF SDLMODE} @@ -1014,8 +2144,89 @@ begin DialogMsg( MsgString( 'BACKPACK_NotTraded' ) ); end; end; +{$ENDIF PATCH_GH} end; +{$IFDEF PATCH_GH} +Procedure TradeAllFrontend( GB: GameBoardPtr; PC , Item, LList: GearPtr ); + { Assign ITEM to a different master. Move it from the } + { general inventory of PC into its new home. } +var + M: GearPtr; + Item_Next: GearPtr; +begin + M := TradeFrontEnd_GetDest( GB , PC , LList ); + + if ( NIL <> M ) then begin + while ( NIL <> Item ) do begin + Item_Next := Item^.Next; + if CheckAlongPath_DisallowTransfering( Item ) then begin + end else begin + if IsLegalSlot( M , Item ) then begin + DelinkGear( Item^.Parent^.InvCom , Item ); + InsertInvCom( M , Item ); +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString( 'TradeAllFrontend' , 'ItemTraded' ) , GearName( Item ) ) ); +{$ELSE PATCH_I18N} + DialogMsg( 'Item traded.' ); +{$ENDIF PATCH_I18N} + end else begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString( 'TradeAllFrontend' , 'NotTraded' ) , GearName( Item ) ) ); +{$ELSE PATCH_I18N} + DialogMsg( 'Not traded.' ); +{$ENDIF PATCH_I18N} + end; + end; + Item := Item_Next; + end; + end; +end; + +Procedure TradeEqpAllFrontEnd( GB: GameBoardPtr; PC , Item, LList: GearPtr ); + { Assign ITEM to a different master. Move it from the } + { general inventory of PC into its new home. } +var + M: GearPtr; + + Procedure CheckAlongPath( Part: GearPtr; IsInv: Boolean ); + var + Part_Next: GearPtr; + begin + while ( NIL <> Part ) do begin + Part_Next := Part^.Next; + if IsInv and ( not CheckAlongPath_DisallowTransfering( Part ) ) then begin + if IsLegalSlot( M , Part ) then begin + DelinkGear( Part^.Parent^.InvCom , Part ); + InsertInvCom( M , Part ); +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString( 'TradeAllFrontend' , 'ItemTraded' ) , GearName( Part ) ) ); +{$ELSE PATCH_I18N} + DialogMsg( 'Item traded.' ); +{$ENDIF PATCH_I18N} + end else begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString( 'TradeAllFrontend' , 'NotTraded' ) , GearName( Part ) ) ); +{$ELSE PATCH_I18N} + DialogMsg( 'Not traded.' ); +{$ENDIF PATCH_I18N} + end; + end; + CheckAlongPath( Part^.InvCom , True ); + CheckAlongPath( Part^.SubCom , False ); + Part := Part_Next; + end; + end; +begin + M := TradeFrontEnd_GetDest( GB , PC , LList ); + + if ( NIL <> M ) then begin + CheckAlongPath( Item^.InvCom , False ); + CheckAlongPath( Item^.SubCom , False ); + end; +end; +{$ENDIF PATCH_GH} + Procedure FHQ_AssociatePilotMek( PC , M , LList: GearPtr ); { Associate the mecha with the pilot. } begin @@ -1031,14 +2242,35 @@ Procedure FHQ_SelectPilotForMecha( GB: G { training them to be pilots. } var RPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} M: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Create the menu. } RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); M := GB^.Meks; N := 1; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin + if M^.G = GG_Character then begin + if ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) and ( NAttValue( M^.NA , NAG_Personal , NAS_CID ) <> 0 ) then begin + AddRPGMenuItem( RPM , GearName( M ) , N ); + end else if NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam then begin + AddRPGMenuItem( RPM , GearName( M ) , N ); + end; + end; + Inc( N ); + end; + M := M^.Next; +{$ELSE PATCH_GH} if M^.G = GG_Character then begin if ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) and ( NAttValue( M^.NA , NAG_Personal , NAS_CID ) <> 0 ) then begin AddRPGMenuItem( RPM , GearName( M ) , N ); @@ -1048,13 +2280,24 @@ begin end; M := M^.Next; Inc( N ); +{$ENDIF PATCH_GH} end; RPMSortAlpha( RPM ); AddRPGMenuItem( RPM , MSgString( 'EXIT' ) , -1 ); { Get a selection from the menu. } {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + MPR_InvMenu := RPM; + MPR_InvMenuRGS := GB^.Meks; + end; + {$ENDIF PATCH_GH} n := SelectMenu( RPM , @PlainRedraw ); + {$IFDEF PATCH_GH} + MPR_InvMenuRGS := NIL; + MPR_InvMenu := NIL; + {$ENDIF PATCH_GH} {$ELSE} n := SelectMenu( RPM ); {$ENDIF} @@ -1074,9 +2317,21 @@ Procedure FHQ_SelectMechaForPilot( GB: G { training them to be pilots. } var RPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} M: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then begin + {$IFDEF SDLMODE} + INFOGear := NIL; + {$ENDIF} + Exit; + end; +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} INFOGear := NPC; INFOGB := GB; @@ -1093,18 +2348,38 @@ begin M := GB^.Meks; N := 1; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin + if ( M^.G = GG_Mecha ) and ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) then begin + AddRPGMenuItem( RPM , GearName( M ) , N ); + end; + Inc( N ); + end; + M := M^.Next; +{$ELSE PATCH_GH} if ( M^.G = GG_Mecha ) and ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) then begin AddRPGMenuItem( RPM , GearName( M ) , N ); end; M := M^.Next; Inc( N ); +{$ENDIF PATCH_GH} end; RPMSortAlpha( RPM ); AddRPGMenuItem( RPM , MSgString( 'EXIT' ) , -1 ); { Get a selection from the menu. } {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + MPR_InvMenu := RPM; + MPR_InvMenuRGS := GB^.Meks; + end; + {$ENDIF PATCH_GH} n := SelectMenu( RPM , @PlainRedraw ); + {$IFDEF PATCH_GH} + MPR_InvMenuRGS := NIL; + MPR_InvMenu := NIL; + {$ENDIF PATCH_GH} {$ELSE} n := SelectMenu( RPM ); {$ENDIF} @@ -1119,8 +2394,17 @@ end; Procedure StartContinuousUseItem( GB: GameBoardPtr; TruePC , Item: GearPtr ); { The PC wants to use this item. Give it a try. } var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = TruePC) or (TruePC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Find the item's index number. If the item cannot be found } { on the TRUEPC, then this item cannot be used. } N := FindGearIndex( TruePC , Item ); @@ -1140,16 +2424,34 @@ end; Procedure UseScriptItem( GB: GameBoardPtr; TruePC, Item: GearPtr; T: String ); { This item has a script effect. Exit the backpack and use it. } begin +{$IFDEF PATCH_GH} + { Don't kick out the NIL of GB at here. } + { Don't kick out the GG_DisposeGear of TruePC at here. } + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if SAttValue( Item^.SA , T ) <> '' then begin { Announce the intention. } DialogMsg( ReplaceHash( MsgString( 'BACKPACK_Script_' + T ) , GearName( Item ) ) ); { Using items takes time... } +{$IFDEF PATCH_GH} + if (NIL <> TruePC) and (GG_DisposeGear < TruePC^.G) then begin + WaitAMinute( GB , TruePC , ReactionTime( TruePC ) ); + end; +{$ELSE PATCH_GH} WaitAMinute( GB , TruePC , ReactionTime( TruePC ) ); +{$ENDIF PATCH_GH} { ...and also exits the backpack. } ForceQuit := True; +{$IFDEF PATCH_GH} + if (NIL <> GB) then begin + GFCombatDisplay( GB ); + end; +{$ELSE PATCH_GH} GFCombatDisplay( GB ); +{$ENDIF PATCH_GH} { Finally, trigger the script. } TriggerGearScript( GB , Item , T ); @@ -1159,7 +2461,11 @@ begin end; end; +{$IFDEF PATCH_CHEAT} +Procedure UseSkillOnItem( GB: GameBoardPtr; LList, TruePC, Item: GearPtr ); +{$ELSE PATCH_CHEAT} Procedure UseSkillOnItem( GB: GameBoardPtr; TruePC, Item: GearPtr ); +{$ENDIF PATCH_CHEAT} { The PC will have the option to use a CLUE-type skill on this } { item, maybe to gain some new information, activate an effect, } { or whatever else. } @@ -1168,19 +2474,43 @@ var T: Integer; msg: String; begin +{$IFDEF PATCH_GH} + { Don't kick out the NIL of GB at here. } + { Don't kick out the GG_DisposeGear of LList at here. } + { Don't kick out the GG_DisposeGear of TruePC at here. } + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + SkMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); { Add the usable skills. } for t := 1 to NumSkill do begin { In order to be usable, it must be a CLUE type skill, } { and the PC must have ranks in it. } +{$IFDEF PATCH_CHEAT} + if ((USAGE_Clue = SkillMan[T].Usage) + and ( + ((NIL <> GB) and TeamHasSkill( GB, NAV_DefPlayerTeam, T )) + or ((NIL <> LList) and TeamHasSkill( LList, T )) + or HasTalent( TruePC, NAS_JackOfAll ) + ) + ) then begin +{$ELSE PATCH_CHEAT} if ( SkillMan[ T ].Usage = USAGE_Clue ) and ( TeamHasSkill( GB , NAV_DefPlayerTeam , T ) or HasTalent( TruePC , NAS_JackOfAll ) ) then begin +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('BACKPACK','ClueSkillPrompt'), I18N_Name('SkillMan',SkillMan[ T ].Name), GearName(Item) ); +{$ELSE PATCH_I18N} msg := ReplaceHash( MsgString( 'BACKPACK_ClueSkillPrompt' ) , SkillMan[ T ].Name ); msg := ReplaceHash( msg , GearName( Item ) ); +{$ENDIF PATCH_I18N} AddRPGMenuItem( SkMenu , msg , T ); end; end; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} RPMSortAlpha( SkMenu ); +{$ENDIF PATCH_I18N} AddRPGMenuItem( SkMenu , MsgSTring( 'BACKPACK_CancelSkillUse' ) , -1 ); {$IFDEF SDLMODE} @@ -1201,18 +2531,43 @@ Procedure EatItem( GB: GameBoardPtr; Tru { The PC wants to eat this item. Give it a try. } var effect: String; -begin +{$IFDEF PATCH_GH} + WaitTime: Int64; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = TruePC) or (TruePC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + TruePC := LocatePilot( TruePC ); +{$IFDEF PATCH_GH} + if (NIL = TruePC) or (TruePC^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if TruePC = Nil then begin +{$ENDIF PATCH_GH} DialogMsg( ReplaceHash( MsgString( 'BACKPACK_CantBeEaten' ) , GearName( Item ) ) ); end else if ( NAttValue( TruePC^.NA , NAG_Condition , NAS_Hunger ) > ( Item^.V div 2 ) ) or ( Item^.V = 0 ) then begin { Show a message. } +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('BACKPACK','YouAreEating'), GearName(TruePC), GearName(Item) ) ); +{$ELSE PATCH_I18N} DialogMsg( ReplaceHash( ReplaceHash( MsgString( 'BACKPACK_YouAreEating' ) , GearName( TruePC ) ) , GearName( Item ) ) ); +{$ENDIF PATCH_I18N} { Eating takes time... } +{$IFDEF PATCH_GH} + WaitTime := ReactionTime( TruePC ) * GearMass( Item ) + 1; + while (32767 < WaitTime) do begin + WaitAMinute( GB, TruePC, 32767 ); + WaitTime := WaitTime - 32767; + end; + WaitAMinute( GB, TruePC, WaitTime ); +{$ELSE PATCH_GH} WaitAMinute( GB , TruePC , ReactionTime( TruePC ) * GearMass( Item ) + 1 ); +{$ENDIF PATCH_GH} { ...and also exits the backpack. } ForceQuit := True; @@ -1225,7 +2580,11 @@ begin effect := SAttValue( Item^.SA , 'EFFECT' ); if effect <> '' then begin GFCombatDisplay( GB ); +{$IFDEF PATCH_GH} + EffectFrontEnd( GB , Item , TruePC , effect , '' ); +{$ELSE PATCH_GH} EffectFrontEnd( GB , TruePC , effect , '' ); +{$ENDIF PATCH_GH} end; { Destroy the item, if appropriate. } @@ -1243,7 +2602,11 @@ begin end; +{$IFDEF PATCH_CHEAT} +Procedure ThisItemWasSelected( GB: GameBoardPtr; var LList: GearPtr; TruePC , PC , Item: GearPtr; ShowOnly: Boolean ); +{$ELSE PATCH_CHEAT} Procedure ThisItemWasSelected( GB: GameBoardPtr; var LList: GearPtr; TruePC , PC , Item: GearPtr ); +{$ENDIF PATCH_CHEAT} { TruePC is the primary character, who may be doing repairs } { and stuff. } { PC is the current master being examined, which may well be } @@ -1253,10 +2616,27 @@ Procedure ThisItemWasSelected( GB: GameB { Item is the piece of wargear currently being examined. } var TIWS_Menu: RPGMenuPtr; +{$IFDEF PATCH_GH} + SI,TI: Integer; +{$ENDIF PATCH_GH} N: Integer; begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear of LList at here. } + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; + {if (NIL = TruePC) or (TruePC^.G <= GG_DisposeGear) then Exit;} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + TIWS_Menu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); +{$IFDEF PATCH_GH} + SI := 1; + TI := 1; +{$ELSE PATCH_GH} +{$IFDEF PATCH_CHEAT} + if not(ShowOnly) then begin +{$ENDIF PATCH_CHEAT} if Item^.G = GG_Usable then AddRPGMenuItem( TIWS_Menu , ReplaceHash( MsgString( 'BACKPACK_UseItem' ) , GearName( Item ) ) , -9 ); if Item^.G = GG_Consumable then AddRPGMenuItem( TIWS_Menu , ReplaceHash( MsgString( 'BACKPACK_EatItem' ) , GearName( Item ) ) , -10 ); @@ -1265,18 +2645,84 @@ begin if Item^.G = GG_Ammo then AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_LoadAmmo' ) , -5 ); if IsInvCom( Item ) then begin if Item^.Parent = PC then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('ThisItemWasSelected','Equip'), GearName(Item) ), -2 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( TIWS_Menu , 'Equip ' + GearName( Item ) , -2 ); +{$ENDIF PATCH_I18N} if ( FindMaster( Item ) <> Nil ) and ( FindMaster( Item )^.G = GG_Mecha ) then begin +{$IFDEF PATCH_CHEAT} + if (NIL <> TruePC) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Install'), GearName(Item) ) , -8 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_Install' ) + GearName( Item ) , -8 ); +{$ENDIF PATCH_I18N} + if 0 < SAttValueToInt(Item^.SA,SATT_TRANSFORMABLE) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Transformation'), GearName(Item) ) , -13 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'Transformation' ) + GearName( Item ) , -13 ); +{$ENDIF PATCH_I18N} + end; + end; +{$ELSE PATCH_CHEAT} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Install'), GearName(Item) ) , -8 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_Install' ) + GearName( Item ) , -8 ); +{$ENDIF PATCH_I18N} +{$ENDIF PATCH_CHEAT} end; end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('ThisItemWasSelected','Unequip'), GearName(Item) ), -3 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( TIWS_Menu , 'Unequip ' + GearName( Item ) , -3 ); +{$ENDIF PATCH_I18N} + end; +{$IFDEF PATCH_CHEAT} + if (NIL <> LList) then begin + if (NIL = GB) or ((NIL <> GB) and (Cheat_Trade_NotSafeArea or IsSafeArea(GB))) then begin + AddRPGMenuItem( TIWS_Menu, MsgString('BACKPACK_TradeItem'), -6 ); + end; end; +{$ELSE PATCH_CHEAT} if ( LList <> Nil ) and ( GB <> Nil ) and IsSafeArea( GB ) then AddRPGMenuItem ( TIWS_Menu , MsgString( 'BACKPACK_TradeItem' ) , -6 ); +{$ENDIF PATCH_CHEAT} AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_DropItem' ) , -4 ); end else if ( FindMaster( Item ) <> Nil ) and ( FindMaster( Item )^.G = GG_Mecha ) and CanBeExtracted( Item ) then begin +{$IFDEF PATCH_CHEAT} + if (NIL <> TruePC) then +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Remove'), GearName(Item) ) , -7 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_Remove' ) + GearName( Item ) , -7 ); +{$ENDIF PATCH_I18N} end; +{$IFDEF PATCH_CHEAT} + if not(IsInvCom(Item)) and (NIL = Item^.Parent) and (NIL <> TruePC) then begin + if 0 < SAttValueToInt(Item^.SA,SATT_TRANSFORMABLE) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Transformation'), GearName(Item) ) , -13 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'Transformation' ) + GearName( Item ) , -13 ); +{$ENDIF PATCH_I18N} + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + if 0 < SAttValueToInt(Item^.SA,SATT_SEPARABLE) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','PurgeParts'), GearName(Item) ) , -14 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'PurgeParts' ) + GearName( Item ) , -14 ); +{$ENDIF PATCH_I18N} + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} AddRepairOptions( TIWS_Menu , TruePC , Item ); if ( Item^.G = GG_Weapon ) or ( ( Item^.G = GG_Ammo ) and ( Item^.S = GS_Grenade ) ) then begin @@ -1288,10 +2734,195 @@ begin end; AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_UseSkillOnItem' ) , 1 ); +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_ExitTIWS' ) , -1 ); +{$IFDEF PATCH_CHEAT} + if Cheat_ThisItemWasSelected_AddMenuKey then begin + AlphaKeyMenu( TIWS_Menu ); + end; +{$ENDIF PATCH_CHEAT} +{$ENDIF PATCH_GH} repeat DisplayGearInfo( Item ); +{$IFDEF PATCH_GH} + TIWS_Menu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); + +{$IFDEF PATCH_CHEAT} + if not(ShowOnly) then begin +{$ENDIF PATCH_CHEAT} + if Item^.G = GG_Usable then AddRPGMenuItem( TIWS_Menu , ReplaceHash( MsgString( 'BACKPACK_UseItem' ) , GearName( Item ) ) , -9 ); + if Item^.G = GG_Consumable then AddRPGMenuItem( TIWS_Menu , ReplaceHash( MsgString( 'BACKPACK_EatItem' ) , GearName( Item ) ) , -10 ); + + if SATtValue( Item^.SA , 'USE' ) <> '' then AddRPGMenuItem( TIWS_Menu , ReplaceHash( MsgString( 'BACKPACK_UseItemScript' ) , GearName( Item ) ) , -11 ); + + if Item^.G = GG_Ammo then AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_LoadAmmo' ) , -5 ); + if IsInvCom( Item ) then begin + if Item^.Parent = PC then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('ThisItemWasSelected','Equip'), GearName(Item) ), -2 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'Equip ' + GearName( Item ) , -2 ); +{$ENDIF PATCH_I18N} + if ( FindMaster( Item ) <> Nil ) and ( FindMaster( Item )^.G = GG_Mecha ) then begin +{$IFDEF PATCH_CHEAT} + if (NIL <> TruePC) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Install'), GearName(Item) ) , -8 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_Install' ) + GearName( Item ) , -8 ); +{$ENDIF PATCH_I18N} + if 0 < SAttValueToInt(Item^.SA,SATT_TRANSFORMABLE) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Transformation'), GearName(Item) ) , -13 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'Transformation' ) + GearName( Item ) , -13 ); +{$ENDIF PATCH_I18N} + end; + end; +{$ELSE PATCH_CHEAT} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Install'), GearName(Item) ) , -8 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_Install' ) + GearName( Item ) , -8 ); +{$ENDIF PATCH_I18N} +{$ENDIF PATCH_CHEAT} + end; + end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('ThisItemWasSelected','Unequip'), GearName(Item) ), -3 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'Unequip ' + GearName( Item ) , -3 ); +{$ENDIF PATCH_I18N} + end; +{$IFDEF PATCH_CHEAT} + if (NIL <> LList) then begin + if (NIL = GB) or ((NIL <> GB) and (Cheat_Trade_NotSafeArea or IsSafeArea(GB))) then begin + if CheckAlongPath_DisallowTransfering( Item ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , I18N_MsgString( 'ThisItemWasSelected' , 'YouCannotTransferIt' ) , 0 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'You cannot transfer it.' , 0 ); +{$ENDIF PATCH_I18N} + end else begin + AddRPGMenuItem( TIWS_Menu, MsgString('BACKPACK_TradeItem'), -6 ); + end; + end; + end; +{$ELSE PATCH_CHEAT} + if ( LList <> Nil ) and ( GB <> Nil ) and IsSafeArea( GB ) then begin + if CheckAlongPath_DisallowTransfering( Item ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , I18N_MsgString( 'ThisItemWasSelected' , 'YouCannotTransferIt' ) , 0 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'You cannot transfer it.' , 0 ); +{$ENDIF PATCH_I18N} + end else begin + AddRPGMenuItem ( TIWS_Menu , MsgString( 'BACKPACK_TradeItem' ) , -6 ); + end; + end; +{$ENDIF PATCH_CHEAT} + if CheckAlongPath_DisallowDropping( Item ) then begin + AddRPGMenuItem( TIWS_Menu , I18N_MsgString( 'ThisItemWasSelected' , 'YouCannotDropIt' ) , 0 ); + end else begin + AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_DropItem' ) , -4 ); + end; + end else if ( FindMaster( Item ) <> Nil ) and ( FindMaster( Item )^.G = GG_Mecha ) and CanBeExtracted( Item ) then begin +{$IFDEF PATCH_CHEAT} + if (NIL <> TruePC) then +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Remove'), GearName(Item) ) , -7 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_Remove' ) + GearName( Item ) , -7 ); +{$ENDIF PATCH_I18N} + end; +{$IFDEF PATCH_CHEAT} + if not(IsInvCom(Item)) and (NIL = Item^.Parent) and (NIL <> TruePC) then begin + if 0 < SAttValueToInt(Item^.SA,SATT_TRANSFORMABLE) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','Transformation'), GearName(Item) ) , -13 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'Transformation' ) + GearName( Item ) , -13 ); +{$ENDIF PATCH_I18N} + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + if 0 < SAttValueToInt(Item^.SA,SATT_SEPARABLE) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , ReplaceHash( I18N_MsgString('BACKPACK','PurgeParts'), GearName(Item) ) , -14 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , MsgString( 'PurgeParts' ) + GearName( Item ) , -14 ); +{$ENDIF PATCH_I18N} + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} + AddRepairOptions( TIWS_Menu , TruePC , Item ); + + if ( Item^.G = GG_Weapon ) or ( ( Item^.G = GG_Ammo ) and ( Item^.S = GS_Grenade ) ) then begin + if NAttValue( Item^.NA , NAG_WeaponModifier , NAS_SafetySwitch ) = 0 then begin + AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_EngageSafety' ) , -12 ); + end else begin + AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_DisengageSafety' ) , -12 ); + end; + end; + + AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_UseSkillOnItem' ) , 1 ); + if DisallowSelling( Item ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , I18N_MsgString( 'ThisItemWasSelected' , 'AllowSelling' ) , 7 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'AllowSelling' , 7 ); +{$ENDIF PATCH_I18N} + end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , I18N_MsgString( 'ThisItemWasSelected' , 'DisallowSelling' ) , 6 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'DisallowSelling' , 6 ); +{$ENDIF PATCH_I18N} + end; +{$IFDEF PATCH_CHEAT} + if DisallowDropping( Item ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , I18N_MsgString( 'ThisItemWasSelected' , 'AllowDropping' ) , 9 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'AllowDropping' , 9 ); +{$ENDIF PATCH_I18N} + end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , I18N_MsgString( 'ThisItemWasSelected' , 'DisallowDropping' ) , 8 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'DisallowDropping' , 8 ); +{$ENDIF PATCH_I18N} + end; + if DisallowTransfering( Item ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , I18N_MsgString( 'ThisItemWasSelected' , 'AllowTransfering' ) , 11 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'AllowTransfering' , 11 ); +{$ENDIF PATCH_I18N} + end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , I18N_MsgString( 'ThisItemWasSelected' , 'DisallowTransfering' ) , 10 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( TIWS_Menu , 'DisallowTransfering' , 10 ); +{$ENDIF PATCH_I18N} + end; + end; +{$ENDIF PATCH_CHEAT} + AddRPGMenuItem( TIWS_Menu , MsgString( 'BACKPACK_ExitTIWS' ) , -1 ); +{$IFDEF PATCH_CHEAT} + if Cheat_ThisItemWasSelected_AddMenuKey then begin + AlphaKeyMenu( TIWS_Menu ); + end; +{$ENDIF PATCH_CHEAT} + TIWS_Menu^.SelectItem := SI; + TIWS_Menu^.TopItem := TI; +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} InfoGear := Item; InfoGB := GB; @@ -1299,51 +2930,171 @@ begin {$ELSE} N := SelectMenu( TIWS_Menu ); {$ENDIF} +{$IFDEF PATCH_GH} + SI := TIWS_Menu^.SelectItem; + TI := TIWS_Menu^.TopItem; + DisposeRPGMenu( TIWS_Menu ); +{$ENDIF PATCH_GH} if N > 100 then begin DoFieldRepair( GB , TruePC , Item , RepairSkillIndex[N-100] ); end else begin case N of +{$IFDEF PATCH_CHEAT} + 1: UseSkillOnItem( GB, LList, TruePC, Item ); +{$ELSE PATCH_CHEAT} 1: UseSkillOnItem( GB , TruePC , Item ); +{$ENDIF PATCH_CHEAT} -2: EquipItemFrontend( GB , PC , Item ); -3: UnequipFrontEnd( GB , PC , Item ); -4: DropFrontEnd( PC , Item ); -5: InstallAmmoFrontEnd( GB , PC , Item ); -6: TradeFrontEnd( GB , PC, Item , LList ); +{$IFDEF PATCH_CHEAT} + -7: ExtractFrontEnd( GB, LList, TruePC, PC, Item ); + -8: InstallFrontEnd( GB, LList, TruePC, PC, Item ); +{$ELSE PATCH_CHEAT} -7: ExtractFrontEnd( GB , TruePC , PC , Item ); -8: InstallFrontEnd( GB , TruePC , PC , Item ); +{$ENDIF PATCH_CHEAT} -9: StartContinuousUseItem( GB , TruePC , Item ); -10: EatItem( GB , PC , Item ); -11: UseScriptItem( GB , TruePC , Item , 'USE' ); -12: SetNAtt( Item^.NA , NAG_WeaponModifier , NAS_SafetySwitch , 1 - NAttValue( Item^.NA , NAG_WeaponModifier , NAS_SafetySwitch ) ); +{$IFDEF PATCH_CHEAT} + -13: UserTransformation( GB , Item , True ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + -14: UserPurgeParts( GB , Item ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + 6: SetSAtt( Item^.SA , TAG_DisallowSelling + ' ' ); + 7: SetSAtt( Item^.SA , TAG_DisallowSelling + ' <>' ); + 8: SetSAtt( Item^.SA , TAG_DisallowDropping + ' ' ); + 9: SetSAtt( Item^.SA , TAG_DisallowDropping + ' <>' ); + 10: SetSAtt( Item^.SA , TAG_DisallowTransfering + ' ' ); + 11: SetSAtt( Item^.SA , TAG_DisallowTransfering + ' <>' ); +{$ENDIF PATCH_GH} end; end; until ( N < 0 ) or ForceQuit; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} DisposeRPGMenu( TIWS_Menu ); +{$ENDIF PATCH_GH} +end; + +{$IFDEF PATCH_CHEAT} +Procedure ThisItemWasSelected( GB: GameBoardPtr; var LList: GearPtr; TruePC , PC , Item: GearPtr ); +begin + ThisItemWasSelected( GB, LList, TruePC, PC, Item, False ); end; +{$ENDIF PATCH_CHEAT} Function DoInvMenu( GB: GameBoardPtr; var LList: GearPtr; PC,M: GearPtr ): Boolean; { Return TRUE if the user selected Quit. } var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; -begin +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + top, sel: Integer; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear of LList at here. } + {if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(True);} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit(True); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} + top := 0; + sel := 0; +{$ENDIF PATCH_CHEAT} Repeat {$IFDEF SDLMODE} InfoGear := M; InfoGB := GB; +{$ENDIF} +{$IFDEF PATCH_CHEAT} + if Cheat_InvMenu_KeepPosition and (0 < sel) then begin + InvRPM^.TopItem := top; + SetItemByPosition( InvRPM, sel ); + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + MPR_InvMenu := InvRPM; + MPR_InvMenuLGBN := M; + end; + {$ENDIF PATCH_GH} N := SelectMenu( INVRPM , @MiscProcRedraw); + {$IFDEF PATCH_GH} + MPR_InvMenuLGBN := NIL; + MPR_InvMenu := NIL; + {$ENDIF PATCH_GH} {$ELSE} N := SelectMenu( InvRPM ); {$ENDIF} +{$IFDEF PATCH_CHEAT} + top := InvRPM^.TopItem; + sel := InvRPM^.SelectItem; +{$ENDIF PATCH_CHEAT} { If an item was selected, pass it along to the appropriate } { procedure. } if N > 0 then begin +{$IFDEF PATCH_CHEAT} + if ' ' = RPMLocateByPosition( InvRPM, sel )^.msg[1] then begin + {$IFDEF DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N, False, InvRPM_MaxNum, 'DoInvMenu' ), True ); + {$ELSE DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N ), True ); + {$ENDIF DEBUG} + end else begin + {$IFDEF DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N, False, InvRPM_MaxNum, 'DoInvMenu' ) ); + {$ELSE DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N ) ); + {$ENDIF DEBUG} + end; +{$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N, False, InvRPM_MaxNum, 'DoInvMenu' ) ); + {$ELSE DEBUG} ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N ) ); + {$ENDIF DEBUG} +{$ENDIF PATCH_CHEAT} { Restore the display. } UpdateBackpack( M ); DisplayGearInfo( M ); +{$IFDEF PATCH_GH} + end else if ( -3 = N ) then begin + DropAllFrontEnd( GB , LList , M , M^.InvCom ); + UpdateBackpack( M ); + DisplayGearInfo( M ); + N := 0; + end else if ( -4 = N ) then begin + TradeAllFrontEnd( GB , M , M^.InvCom , LList ); + UpdateBackpack( M ); + N := 0; +{$ENDIF PATCH_GH} + end; +{$IFDEF PATCH_CHEAT} + if N = -128 then begin + {$IFDEF DEBUG} + SwapMenu( ZONE_InvMenu , LocateGearByNumber( M , RPMLocateByPosition( InvRPM , InvRPM^.SelectItem )^.value, False, InvRPM_MaxNum, 'DoInvMenu' ) ); + {$ELSE DEBUG} + SwapMenu( ZONE_InvMenu , LocateGearByNumber( M , RPMLocateByPosition( InvRPM , InvRPM^.SelectItem )^.value ) ); + {$ENDIF DEBUG} + UpdateBackpack( M ); + DisplayGearInfo( M ); + N := 0; end; +{$ENDIF PATCH_CHEAT} until ( N < 0 ) or ForceQuit; {$IFNDEF SDLMODE} @@ -1356,10 +3107,36 @@ end; {$IFDEF SDLMODE} Procedure EqpRedraw; { Show Inventory, select Equipment. } +{$IFDEF PATCH_GH} +var + Mek: GearPtr; + MekNum: LongInt; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL <> InfoGB) then begin + QuickCombatDisplay( InfoGB ); + end; + DrawBPBorder; + Mek := InfoGear; + if (NIL <> MPR_InvMenu) then begin + MekNum := RPMLocateByPosition(MPR_InvMenu,MPR_InvMenu^.selectitem)^.value; + if (0 <= MekNum) then begin + {$IFDEF DEBUG} + Mek := LocateGearByNumber( MPR_InvMenuLGBN, MekNum, False, 0, '' ); + {$ELSE DEBUG} + Mek := LocateGearByNumber( MPR_InvMenuLGBN, MekNum ); + {$ENDIF DEBUG} + end; + end; + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + DisplayGearInfo( Mek, InfoGB ); + end; +{$ELSE PATCH_GH} QuickCombatDisplay( InfoGB ); DrawBPBorder; DisplayGearInfo( InfoGear , InfoGB ); +{$ENDIF PATCH_GH} DisplayMenu( InvRPM , Nil ); NFGameMsg( MsgString( 'BACKPACK_Directions' ) , ZONE_Menu , MenuItem ); end; @@ -1368,24 +3145,97 @@ end; Function DoEqpMenu( GB: GameBoardPtr; var LList: GearPtr; PC,M: GearPtr ): Boolean; { Return TRUE if the user selected Quit. } var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; -begin +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + top, sel: Integer; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear of LList at here. } + {if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(True);} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit(True); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} + top := 0; + sel := 0; +{$ENDIF PATCH_CHEAT} Repeat {$IFDEF SDLMODE} InfoGear := M; InfoGB := GB; +{$ENDIF} +{$IFDEF PATCH_CHEAT} + if Cheat_EqpMenu_KeepPosition and (0 < sel) then begin + EqpRPM^.TopItem := top; + SetItemByPosition( EqpRPM, sel ); + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + MPR_InvMenu := EqpRPM; + MPR_InvMenuLGBN := M; + end; + {$ENDIF PATCH_GH} N := SelectMenu( EqpRPM , @EqpRedraw); + {$IFDEF PATCH_GH} + MPR_InvMenuLGBN := NIL; + MPR_InvMenu := NIL; + {$ENDIF PATCH_GH} {$ELSE} N := SelectMenu( EqpRPM ); {$ENDIF} +{$IFDEF PATCH_CHEAT} + top := EqpRPM^.TopItem; + if 0 < N then begin + SetItemByValue( EqpRPM, N ); + end; + sel := EqpRPM^.SelectItem; +{$ENDIF PATCH_CHEAT} { If an item was selected, pass it along to the appropriate } { procedure. } if N > 0 then begin +{$IFDEF PATCH_CHEAT} + if ' ' = RPMLocateByPosition( EqpRPM, sel )^.msg[1] then begin + {$IFDEF DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N, False, EqpRPM_MaxNum, 'DoEqpMenu' ), True ); + {$ELSE DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N ), True ); + {$ENDIF DEBUG} + end else begin + {$IFDEF DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N, False, EqpRPM_MaxNum, 'DoEqpMenu' ) ); + {$ELSE DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N ) ); + {$ENDIF DEBUG} + end; +{$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} + ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N, False, EqpRPM_MaxNum, 'DoEqpMenu' ) ); + {$ELSE DEBUG} ThisItemWasSelected( GB , LList , PC , M , LocateGearByNumber( M , N ) ); + {$ENDIF DEBUG} +{$ENDIF PATCH_CHEAT} { Restore the display. } UpdateBackpack( M ); DisplayGearInfo( M ); +{$IFDEF PATCH_GH} + end else if ( -3 = N ) then begin + DropEqpAllFrontEnd( GB , LList , M , M ); + UpdateBackpack( M ); + DisplayGearInfo( M ); + N := 0; + end else if ( -4 = N ) then begin + TradeEqpAllFrontEnd( GB , M , M , LList ); + UpdateBackpack( M ); + N := 0; +{$ENDIF PATCH_GH} end; until ( N < 0 ) or ForceQuit; @@ -1405,6 +3255,12 @@ Procedure RealBackpack( GB: GameBoardPtr var QuitBP: Boolean; begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear of LList at here. } + {if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit;} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Set up the display. } DrawBPBorder; ForceQuit := False; @@ -1442,18 +3298,52 @@ end; Procedure BackpackMenu( GB: GameBoardPtr; PC: GearPtr; StartWithInv: Boolean ); { This is a header for the REALBACKPACK function. } begin +{$IFDEF PATCH_GH} + if (NIL = GB) then Exit; +{$ENDIF PATCH_GH} RealBackPack( GB , GB^.Meks , PC , PC , StartWithInv ); end; {$IFDEF SDLMODE} Procedure MPERedraw; { Show Inventory, select Equipment. } + {$IFDEF PATCH_GH} + var + Mek: GearPtr; + MekNum: LongInt; + begin + if (NIL <> InfoGB) then begin + QuickCombatDisplay( InfoGB ); + end; + DrawBPBorder; + Mek := NIL; + if (NIL <> MPR_InvMenu) then begin + MekNum := RPMLocateByPosition(MPR_InvMenu,MPR_InvMenu^.selectitem)^.value; + if (0 <= MekNum) then begin + {$IFDEF DEBUG} + Mek := LocateGearByNumber( MPR_InvMenuLGBN, MekNum, False, 0, '' ); + {$ELSE DEBUG} + Mek := LocateGearByNumber( MPR_InvMenuLGBN, MekNum ); + {$ENDIF DEBUG} + end; + end else if (NIL <> InfoGear) then begin + Mek := InfoGear; + end; + if (NIL <> InfoGear) and (GG_DisposeGear < InfoGear^.G) then begin + NFGameMsg( FullGearName(InfoGear) + ' ' + MechaDescription(InfoGear), ZONE_EqpMenu, InfoGreen ); + end; + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + DisplayGearInfo( Mek ); + end; + end; + {$ELSE PATCH_GH} begin QuickCombatDisplay( InfoGB ); DrawBPBorder; NFGameMsg( FullGearName( INFOGear ) + ' ' + MechaDescription( InfoGear) , ZONE_EqpMenu , InfoGreen ); DisplayGearInfo( InfoGear ); end; + {$ENDIF PATCH_GH} {$ENDIF} Procedure MechaPartEditor( GB: GameBoardPtr; var LList: GearPtr; PC,Mek: GearPtr ); @@ -1461,17 +3351,64 @@ Procedure MechaPartEditor( GB: GameBoard { bits of a mecha and examine each one individually. } var RPM: RPGMenuPtr; +{$IFDEF PATCH_CHEAT} + N: LongInt; + top,sel: Integer; +{$ELSE PATCH_CHEAT} +{$IFDEF PATCH_GH} + N: LongInt; + I: Integer; +{$ELSE PATCH_GH} N,I: Integer; -begin +{$ENDIF PATCH_GH} +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + MaxNum: LongInt; +{$ENDIF DEBUG} +begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear of LList at here. } + {if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit;} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Set up the display. } DrawBPBorder; +{$IFDEF PATCH_CHEAT} + top := 0; + sel := 0; +{$ELSE PATCH_CHEAT} I := 0; +{$ENDIF PATCH_CHEAT} Repeat RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InvMenu ); +{$IFDEF DEBUG} + MaxNum := BuildGearMenu( RPM , Mek ); +{$ELSE DEBUG} BuildGearMenu( RPM , Mek ); +{$ENDIF DEBUG} +{$IFDEF PATCH_CHEAT} + if Cheat_MechaPartEditor_KeepPosition and (0 < sel) then begin + RPM^.TopItem := top; + SetItemByPosition( RPM, sel ); + end; +{$ELSE PATCH_CHEAT} if I > 0 then SetItemByPosition( RPM , I ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('MechaPartEditor','Exit Editor') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Exit Editor' , -1 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_MenuOrder_Edit then begin + AddRPGMenuKey( RPM , KeyMap[ KMC_EditMenuOrder ].KCode , -128 ); + end; + if Cheat_MechaPartEditor_AddMenuKey then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} {$IFNDEF SDLMODE} GameMsg( FullGearName( Mek ) + ' ' + MechaDescription( Mek ) , ZONE_EqpMenu , InfoGreen ); @@ -1480,15 +3417,51 @@ begin {$IFDEF SDLMODE} InfoGear := Mek; InfoGB := GB; + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + MPR_InvMenu := RPM; + MPR_InvMenuLGBN := Mek; + end; + {$ENDIF PATCH_GH} N := SelectMenu( RPM , @MPERedraw); + {$IFDEF PATCH_GH} + MPR_InvMenuLGBN := NIL; + MPR_InvMenu := NIL; + {$ENDIF PATCH_GH} {$ELSE} N := SelectMenu( RPM ); {$ENDIF} +{$IFDEF PATCH_CHEAT} + top := RPM^.TopItem; + if 0 < N then begin + SetItemByValue( RPM, N ); + end; + sel := RPM^.SelectItem; + if N = -128 then begin + {$IFDEF SDLMODE} + {$IFDEF DEBUG} + InfoGear := LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.SelectItem )^.value, False, MaxNum, 'MechaPartEditor' ); + {$ELSE DEBUG} + InfoGear := LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.SelectItem )^.value ); + {$ENDIF DEBUG} + {$ENDIF SDLMODE} + {$IFDEF DEBUG} + SwapMenu( ZONE_InvMenu , LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.SelectItem )^.value, False, MaxNum, 'MechaPartEditor' ) ); + {$ELSE DEBUG} + SwapMenu( ZONE_InvMenu , LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.SelectItem )^.value ) ); + {$ENDIF DEBUG} + end; +{$ELSE PATCH_CHEAT} I := RPM^.SelectItem; +{$ENDIF PATCH_CHEAT} DisposeRPGMenu( RPM ); if N > -1 then begin +{$IFDEF DEBUG} + ThisItemWasSelected( GB , LList , PC , Mek , LocateGearByNumber( Mek , N, False, MaxNum, 'MechaPartEditor' ) ); +{$ELSE DEBUG} ThisItemWasSelected( GB , LList , PC , Mek , LocateGearByNumber( Mek , N ) ); +{$ENDIF DEBUG} end; until N = -1; @@ -1497,56 +3470,330 @@ end; {$IFDEF SDLMODE} Procedure PartBrowserRedraw; { Redraw the screen for the part browser. } +{$IFDEF PATCH_GH} +var + Mek: GearPtr; + MekNum: LongInt; +{$ENDIF PATCH_GH} begin if MPB_Redraw <> Nil then MPB_Redraw; + { Don't kick out the GG_DisposeGear at here. } + {$IFDEF PATCH_GH} + Mek := NIL; + if (NIL <> MPR_InvMenu) then begin + MekNum := RPMLocateByPosition(MPR_InvMenu,MPR_InvMenu^.selectitem)^.value; + if (0 <= MekNum) then begin + {$IFDEF DEBUG} + Mek := LocateGearByNumber( MPR_InvMenuLGBN, MekNum, False, 0, '' ); + {$ELSE DEBUG} + Mek := LocateGearByNumber( MPR_InvMenuLGBN, MekNum ); + {$ENDIF DEBUG} + end; + end else if (NIL <> MPB_Gear) then begin + Mek := MPB_Gear; + end; + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + DisplayGearInfo( Mek, True ); + end; + {$ELSE PATCH_GH} if MPB_Gear <> Nil then DisplayGearInfo( MPB_Gear ); + {$ENDIF PATCH_GH} end; +{$ENDIF} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} Procedure MechaPartBrowser( Mek: GearPtr; RDP: RedrawProcedureType ); -{$ELSE} +begin + MechaPartBrowser( Mek, False, RDP ); +end; + {$ELSE SDLMODE} Procedure MechaPartBrowser( Mek: GearPtr ); -{$ENDIF} +begin + MechaPartBrowser( Mek, False ); +end; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} +Procedure MechaPartBrowser( Mek: GearPtr; DebugMode: Boolean; RDP: RedrawProcedureType ); + {$ELSE SDLMODE} +Procedure MechaPartBrowser( Mek: GearPtr; DebugMode: Boolean ); + {$ENDIF SDLMODE} +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} +Procedure MechaPartBrowser( Mek: GearPtr; RDP: RedrawProcedureType ); + {$ELSE} +Procedure MechaPartBrowser( Mek: GearPtr ); + {$ENDIF} +{$ENDIF PATCH_GH} { This procedure may be used to browse through all the various } { bits of a mecha and examine each one individually. } var RPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + ReBrowse: Boolean; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + top, sel: Integer; + {$IFDEF SDLMODE} + {$ELSE SDLMODE} + MPB_Gear: GearPtr; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + MaxNum: LongInt; +{$ENDIF DEBUG} + +{$IFDEF PATCH_CHEAT} + Key: String; + + Procedure MechaPartBrowser_SearchForward; + var + RPM_Item: RPGMenuItemPtr; + begin + {$IFDEF SDLMODE} + Key := GetStringFromUser( 'Search String Forward', NIL, Key ); + {$ELSE SDLMODE} + Key := GetStringFromUser( 'Search String Forward', Key ); + {$ENDIF SDLMODE} + sel := RPM^.SelectItem; + RPM_Item := RPMLocateByPosition( RPM, sel ); + repeat + Inc( sel ); + RPM_Item := RPM_Item^.Next; + if (RPM^.NumItem < sel) then begin + sel := 1; + RPM_Item := RPM^.FirstItem; + end; + if 0 < Pos( Key, RPM_Item^.msg ) then begin + RPM^.SelectItem := sel; + break; + end; + until sel = RPM^.SelectItem; + end; + + Procedure MechaPartBrowser_SearchBackward; + var + RPM_Item: RPGMenuItemPtr; + begin + {$IFDEF SDLMODE} + Key := GetStringFromUser( 'Search String Backward', NIL, Key ); + {$ELSE SDLMODE} + Key := GetStringFromUser( 'Search String Backward', Key ); + {$ENDIF SDLMODE} + sel := RPM^.SelectItem; + repeat + Dec( sel ); + if (sel < 1) then begin + sel := RPM^.NumItem; + end; + RPM_Item := RPMLocateByPosition( RPM, sel ); + if 0 < Pos( Key, RPM_Item^.msg ) then begin + RPM^.SelectItem := sel; + break; + end; + until sel = RPM^.SelectItem; + end; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if not(DebugMode) then begin + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; + end; + top := 0; + sel := 0; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} + Key := ''; + + repeat + ReBrowse := False; +{$ENDIF PATCH_CHEAT} {$IFDEF SDLMODE} MPB_Redraw := RDP; MPB_Gear := Mek; {$ENDIF} +{$IFDEF PATCH_GH} + MPB_Gear := Mek; + if not(DebugMode) then begin + if (NIL = MPB_Gear) or (MPB_Gear^.G <= GG_DisposeGear) then MPB_Gear := NIL; + end; +{$ENDIF PATCH_GH} RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} + MaxNum := BuildGearMenu( RPM, Mek, DebugMode ); + {$ELSE DEBUG} + BuildGearMenu( RPM, Mek, DebugMode ); + {$ENDIF DEBUG} +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + MaxNum := BuildGearMenu( RPM , Mek ); + {$ELSE DEBUG} BuildGearMenu( RPM , Mek ); + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('MechaPartBrowser','Exit Browser') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Exit Browser' , -1 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_MenuOrder_Edit then begin + AddRPGMenuKey( RPM , KeyMap[ KMC_EditMenuOrder ].KCode , -128 ); + end; + if DebugMode and Cheat_MechaPartBrowser_Delete then begin + AddRPGMenuKey( RPM , KeyMap[ KMC_Stop ].KCode , -3 ); + end; + if DebugMode then begin + AddRPGMenuKey( RPM , KeyMap[ KMC_ExamineMap ].KCode , -4 ); + AddRPGMenuKey( RPM , KeyMap[ KMC_Search ].KCode , -5 ); + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + if 0 < sel then begin + RPM^.TopItem := top; + SetItemByPosition( RPM, sel ); + end; +{$ENDIF PATCH_GH} Repeat -{$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + DisplayGearInfo( MPB_Gear, DebugMode ); + {$IFDEF SDLMODE} + if Cheat_DisplayGearInfo then begin + MPR_InvMenu := RPM; + MPR_InvMenuLGBN := Mek; + end; N := SelectMenu( RPM , @PartBrowserRedraw ); -{$ELSE} + MPR_InvMenuLGBN := NIL; + MPR_InvMenu := NIL; + {$ELSE SDLMODE} + N := SelectMenu( RPM ); + {$ENDIF SDLMODE} +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} + N := SelectMenu( RPM , @PartBrowserRedraw ); + {$ELSE} DisplayGearInfo( Mek ); N := SelectMenu( RPM ); -{$ENDIF} + {$ENDIF} +{$ENDIF PATCH_GH} if N > -1 then begin -{$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} + MPB_Gear := LocateGearByNumber( Mek, N, DebugMode, MaxNum, 'MechaPartBrowser' ); + {$ELSE DEBUG} + MPB_Gear := LocateGearByNumber( Mek, N, DebugMode ); + {$ENDIF DEBUG} +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} + {$IFDEF DEBUG} + MPB_Gear := LocateGearByNumber( Mek , N, False, MaxNum, 'MechaPartBrowser' ); + {$ELSE DEBUG} MPB_Gear := LocateGearByNumber( Mek , N ); -{$ELSE} + {$ENDIF DEBUG} + {$ELSE} + {$IFDEF DEBUG} + DisplayGearInfo( LocateGearByNumber( Mek , N, False, MaxNum, 'MechaPartBrowser' ) ); + {$ELSE DEBUG} DisplayGearInfo( LocateGearByNumber( Mek , N ) ); + {$ENDIF DEBUG} EndOFGameMoreKey; -{$ENDIF} + {$ENDIF} +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} + end else if N = -128 then begin + {$IFDEF PATCH_GH} + {$IFDEF DEBUG} + MPB_Gear := LocateGearByNumber( Mek, RPMLocateByPosition( RPM , RPM^.selectitem )^.value, DebugMode, MaxNum, 'MechaPartBrowser' ); + {$ELSE DEBUG} + MPB_Gear := LocateGearByNumber( Mek, RPMLocateByPosition( RPM , RPM^.selectitem )^.value, DebugMode ); + {$ENDIF DEBUG} + {$ELSE PATCH_GH} + {$IFDEF SDLMODE} + {$IFDEF DEBUG} + MPB_Gear := LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.selectitem )^.value, False, MaxNum, 'MechaPartBrowser' ); + {$ELSE DEBUG} + MPB_Gear := LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.selectitem )^.value ); + {$ENDIF DEBUG} + {$ENDIF SDLMODE} + {$ENDIF PATCH_GH} + {$IFDEF PATCH_GH} + if SwapMenu( ZONE_Menu, MPB_Gear ) then begin + {$ELSE PATCH_GH} + {$IFDEF DEBUG} + if SwapMenu( ZONE_Menu , LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.selectitem )^.value, False, MaxNum, 'MechaPartBrowser' ) ) then begin + {$ELSE DEBUG} + if SwapMenu( ZONE_Menu , LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.selectitem )^.value ) ) then begin + {$ENDIF DEBUG} + {$ENDIF PATCH_GH} + N := -1; + ReBrowse := True; + end; + + end else if N = -3 then begin + {$IFDEF PATCH_GH} + {$IFDEF DEBUG} + MPB_Gear := LocateGearByNumber( Mek, RPMLocateByPosition( RPM , RPM^.selectitem )^.value, DebugMode, MaxNum, 'MechaPartBrowser' ); + {$ELSE DEBUG} + MPB_Gear := LocateGearByNumber( Mek, RPMLocateByPosition( RPM , RPM^.selectitem )^.value, DebugMode ); + {$ENDIF DEBUG} + Mark_GG_DisposeGear( MPB_Gear ); + {$ELSE PATCH_GH} + {$IFDEF DEBUG} + Mark_GG_DisposeGear( LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.selectitem )^.value, False, MaxNum, 'MechaPartBrowser' ) ); + {$ELSE DEBUG} + Mark_GG_DisposeGear( LocateGearByNumber( Mek , RPMLocateByPosition( RPM , RPM^.selectitem )^.value ) ); + {$ENDIF DEBUG} + {$ENDIF PATCH_GH} + N := -1; + ReBrowse := True; + + end else if N = -4 then begin + MechaPartBrowser_SearchForward(); + N := -1; + ReBrowse := True; + end else if N = -5 then begin + MechaPartBrowser_SearchBackward(); + N := -1; + ReBrowse := True; +{$ENDIF PATCH_CHEAT} end; until N = -1; +{$IFDEF PATCH_GH} + top := RPM^.TopItem; + sel := RPM^.SelectItem; +{$ENDIF PATCH_GH} DisposeRPGMenu( RPM ); +{$IFDEF PATCH_CHEAT} + until False = ReBrowse; +{$ENDIF PATCH_CHEAT} end; {$IFDEF SDLMODE} Procedure FHQRedraw; begin if InfoGB <> Nil then QuickCombatDisplay( InfoGB ); +{$IFDEF PATCH_GH} + if (NIL <> InfoGear) and (GG_DisposeGear < InfoGear^.G) then begin + DisplayGearInfo( InfoGear ); + end; +{$ELSE PATCH_GH} DisplayGearInfo( InfoGear ); +{$ENDIF PATCH_GH} end; {$ENDIF} @@ -1556,8 +3803,19 @@ Procedure FHQ_Transfer( var LList: GearP var RPM: RPGMenuPtr; M: GearPtr; +{$IFDEF PATCH_GH} + N: LongInt; + Team: Integer; +{$ELSE PATCH_GH} N,Team: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear of LList at here. } + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Show the item's stats. } DisplayGearInfo( Item ); @@ -1567,12 +3825,22 @@ begin N := 1; Team := NAttValue( PC^.NA , NAG_LOcation , NAS_Team ); while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin + if ( ( NAttValue( M^.NA , NAG_LOcation , NAS_Team ) = Team ) or ( NAttValue( M^.NA , NAG_LOcation , NAS_Team ) = NAV_LancemateTeam ) ) and IsMasterGear( M ) and IsLegalSlot( M , Item ) then begin + AddRPGMenuItem( RPM , GearName( M ) , N ); + end; + Inc( N ); + end; + M := M^.Next; +{$ELSE PATCH_GH} if ( ( NAttValue( M^.NA , NAG_LOcation , NAS_Team ) = Team ) or ( NAttValue( M^.NA , NAG_LOcation , NAS_Team ) = NAV_LancemateTeam ) ) and IsMasterGear( M ) and IsLegalSlot( M , Item ) then begin AddRPGMenuItem( RPM , GearName( M ) , N ); end; M := M^.Next; Inc( N ); +{$ENDIF PATCH_GH} end; { Sort the menu, then add an exit option. } @@ -1603,14 +3871,63 @@ Procedure Rename_Mecha( GB: GameBoardPtr { Enter a new name for NPC. } var name: String; -begin +{$IFDEF PATCH_CHEAT} + it: SAttPtr; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + name := GetStringFromUser( ReplaceHash( MsgString( 'FHQ_Rename_Prompt' ) , GearName( NPC ) ) , @FHQRedraw , GearName( NPC ) ); + {$ELSE PATCH_GH} name := GetStringFromUser( ReplaceHash( MsgString( 'FHQ_Rename_Prompt' ) , GearName( NPC ) ) , @FHQRedraw ); -{$ELSE} + {$ENDIF PATCH_GH} +{$ELSE SDLMODE} + {$IFDEF PATCH_GH} + name := GetStringFromUser( ReplaceHash( MsgString( 'FHQ_Rename_Prompt' ) , GearName( NPC ) ) , GearName( NPC ) ); + if (NIL <> GB) then begin + GFCombatDisplay( GB ); + end; + {$ELSE PATCH_GH} name := GetStringFromUser( ReplaceHash( MsgString( 'FHQ_Rename_Prompt' ) , GearName( NPC ) ) ); GFCombatDisplay( GB ); -{$ENDIF} + {$ENDIF PATCH_GH} +{$ENDIF SDLMODE} +{$IFDEF PATCH_CHEAT} + if Cheat_RenameBackup then begin + if name ='.' then begin + name := SAttValue( NPC^.SA , 'NameDef' ); + if name = '.' then begin + it := FindSAtt(NPC^.SA ,'Name'); + RemoveSAtt( NPC^.SA , it ); + it := FindSAtt(NPC^.SA ,'NameDef'); + RemoveSAtt( NPC^.SA , it ); + end else if name <> '' then begin + SetSAtt( NPC^.SA , 'Name <' + SAttValue( NPC^.SA , 'NameDef' ) + '>' ); + it := FindSAtt(NPC^.SA ,'NameDef'); + RemoveSAtt( NPC^.SA , it ); + end; + end else if (name <> '') then begin + if (SAttValue( NPC^.SA , 'NameDef' ) <> '') then begin + SetSAtt( NPC^.SA , 'Name <' + name + '>' ); + end else begin + if (SAttValue( NPC^.SA , 'Name' ) <> '') then begin + SetSAtt( NPC^.SA , 'NameDef <' + SAttValue(NPC^.SA , 'Name') + '>' ); + end else begin + SetSAtt( NPC^.SA , 'NameDef <.>' ); + end; + SetSAtt( NPC^.SA , 'Name <' + name + '>' ); + end; + end; + end else begin + if name <> '' then SetSAtt( NPC^.SA , 'name <' + name + '>' ); + end; +{$ELSE PATCH_CHEAT} if name <> '' then SetSAtt( NPC^.SA , 'name <' + name + '>' ); +{$ENDIF PATCH_CHEAT} end; Procedure FHQ_ThisWargearWasSelected( GB: GameBoardPtr; var LList: GearPtr; PC,M: GearPtr ); @@ -1621,6 +3938,12 @@ var RPM: RPGMenuPtr; N: Integer; begin +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear of LList at here. } + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + repeat { Show the mecha's stats. } DisplayGearInfo( M ); @@ -1648,6 +3971,11 @@ begin {$ENDIF} AddRPGMenuItem( RPM , MsgString( 'FHQ_ReturnToMain' ) , -1 ); +{$IFDEF PATCH_CHEAT} + if Cheat_FieldHQ_AddMenuKey then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} { Get a selection from the menu, then dispose of it. } {$IFDEF SDLMODE} @@ -1684,5 +4012,245 @@ begin GFCombatDisplay( GB ); end; +{$IFDEF PATCH_CHEAT} +Procedure SelectPortrait( M: GearPtr ); + { The player wants to change the colors for sprite for this character. } + { The menu will be placed in the Menu area; assume the redrawer will } + { show whatever changes are made here. } +var + RPM: RPGMenuPtr; + fname: String; +begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + + RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); + if NAttValue( M^.NA , NAG_CharDescription , NAS_Gender ) = NAV_Female then begin + BuildFileMenu( RPM , Graphics_Directory + 'por_f_*.*' ); + end else begin + BuildFileMenu( RPM , Graphics_Directory + 'por_m_*.*' ); + end; + AddRPGMenuItem( RPM , MsgString( 'EXIT' ) , -1 ); + +{$IFDEF PATCH_GH} + fname := SAttValue( M^.SA , 'SDL_PORTRAIT' ); + while (RPM^.SelectItem < RPM^.NumItem) do begin + if RPMLocateByPosition(RPM,RPM^.SelectItem)^.msg = fname then begin + break; + end; + Inc( RPM^.SelectItem ); + end; + RPM^.TopItem := -1; +{$ENDIF PATCH_GH} + +{$IFDEF SDLMODE} + fname := SelectFile( RPM , Nil ); +{$ELSE SDLMODE} + fname := SelectFile( RPM ); +{$ENDIF SDLMODE} + + if fname <> '' then begin + SetSAtt( M^.SA , 'SDL_PORTRAIT <' + fname + '>' ); + end; + + DisposeRPGMenu( RPM ); +end; +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_CHEAT} +Procedure BuildSiblingMenu( RPM: RPGMenuPtr; First , Item: GearPtr ); +var + N: Integer; + Part: GearPtr; +begin + { Don't kick out the GG_DisposeGear of Item at here. } + N := 0; + Part := First; + while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin + Inc(N); + if (Part <> Item) then begin + AddRPGMenuItem( RPM , ' ' + GearName( Part ) , N ) + end else begin + AddRPGMenuItem( RPM , '< ' + GearName( Part ) , N ); + end; + end; + Part := Part^.Next; +{$ELSE PATCH_GH} + Inc(N); + if (Part <> Item) then AddRPGMenuItem( RPM , ' ' + GearName( Part ) , N ) + else AddRPGMenuItem( RPM , '< ' + GearName( Part ) , N ); + Part := Part^.Next; +{$ENDIF PATCH_GH} + end; +end; + +Procedure SwapParts( var F: GearPtr; A,B: GearPtr ); +var + t,pa,pb: GearPtr; +begin +{$IFDEF PATCH_GH} + if (NIL = F) then Exit; + if (NIL = A) or (A^.G <= GG_DisposeGear) then Exit; + if (NIL = B) or (B^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + + t := F; + while (t <> NIL) and (t <> A) and (t <> B) do begin + t := t^.Next; + end; + if t = B then begin + B := A; + A := t; + end; + + if F = A then begin + pa := NIL; + end else begin + pa := F; + while (pa^.Next <> A) do begin + pa := pa^.next; + end; + end; + + pb := A; + while (pb^.Next <> B) do begin + pb := pb^.next; + end; + + { F ... pa A ... pb B ... => F ... pa B ... pb A ... } + { F ... pa A B ... => F ... pa B A ... } + { A ... pb B ... => B ... pb A ... } + { A B ... => B A ... } + if A^.Next <> B then begin + t := A^.Next; + end else begin + t := A; + end; + A^.Next := B^.Next; + B^.Next := t; + + if pb <> A then begin + pb^.Next := A; + end; + if (NIL = pa) then begin + F := B; + end else begin + pa^.Next := B; + end; +end; + +{$IFDEF SDLMODE} +Function SwapMenu_NoParent( var FirstPart: GearPtr; Z: TSDL_Rect; Part: GearPtr ):Boolean; +{$ELSE SDLMODE} +Function SwapMenu_NoParent( var FirstPart: GearPtr; Z: Integer; Part: GearPtr ):Boolean; +{$ENDIF SDLMODE} +var + done: Boolean; + RPM: RPGMenuPtr; + A,B: GearPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} + N: Integer; +{$ENDIF PATCH_GH} + top: Integer = 1; + sel: Integer = 1; +begin + done := False; + { Don't kick out the GG_DisposeGear at here. } + if (NIL <> FirstPart) and (NIL <> Part) then begin + if 1 < NumSiblingGears(FirstPart) then begin + RPM := CreateRPGMenu( MenuItem , MenuSelect , Z ); + A := Part; + + repeat + BuildSiblingMenu( RPM, FirstPart, A ); + if done then AddRPGMenuItem( RPM , I18N_MsgString('BACKPACK_SwapMenu','Exit') , -1 ) + else AddRPGMenuItem( RPM , I18N_MsgString('BACKPACK_SwapMenu','Cancel') , -1 ); + RPM^.SelectItem := sel; + RPM^.TopItem := top; +{$IFDEF SDLMODE} + N := SelectMenu( RPM , Nil ); +{$ELSE SDLMODE} + N := SelectMenu( RPM ); +{$ENDIF SDLMODE} + + if 0 < N then begin + B := RetrieveGearSib( FirstPart, N ); + if A = Nil then begin + A := B; + end else if A = B then begin + A := Nil; + end else begin + SwapParts( FirstPart, A, B ); + done := True; + A := Nil; + end; + + sel := RPM^.SelectItem; + top := RPM^.TopItem; + ClearMenu( RPM ); + end; + until N = -1; + + DisposeRPGMenu( RPM ); + end; + end; + SwapMenu_NoParent := done; +end; + +{$IFDEF SDLMODE} +Function SwapMenu( Z: TSDL_Rect; Part: GearPtr ):Boolean; +{$ELSE SDLMODE} +Function SwapMenu( Z: Integer; Part: GearPtr ):Boolean; +{$ENDIF SDLMODE} +var + done: Boolean; +begin + done := False; + { Don't kick out the GG_DisposeGear at here. } + if (NIL <> Part) and (NIL <> Part^.Parent) then begin + if IsInvCom(Part) then begin + done := SwapMenu_NoParent( Part^.Parent^.InvCom, Z, Part ); + end else begin + done := SwapMenu_NoParent( Part^.Parent^.SubCom, Z, Part ); + end; + end; + SwapMenu := done; +end; +{$ENDIF PATCH_CHEAT} + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: backpack.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + InfoGear := NIL; + InfoGB := NIL; + MPB_Redraw := NIL; + MPB_Gear := NIL; + MPR_InvMenu := NIL; + MPR_InvMenuLGBN := NIL; + MPR_InvMenuRGS := NIL; + Attach_SmartPointer( 'InfoGear: GearPtr', @InfoGear ); + Attach_SmartPointer( 'InfoGB: GameBoardPtr', @InfoGB ); + Attach_SmartPointer( 'MPB_Gear: GearPtr', @MPB_Gear ); + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: backpack.pp(finalization)'); +{$ENDIF DEBUG} +end; end. diff -x .svn -uprN GearHead1100repository.original/boxdraw.inc branches/boxdraw.inc --- GearHead1100repository.original/boxdraw.inc 2012-01-09 14:01:36.526131000 +0900 +++ branches/boxdraw.inc 2009-08-14 03:51:12.135805000 +0900 @@ -15,15 +15,31 @@ Const +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} {$IFDEF go32v2} {$DEFINE use_cp437} -{$ELSE} -{$IFDEF win32} +{$ELSE go32v2} +{$IFDEF Windows} {$DEFINE use_cp437} -{$ENDIF} -{$ENDIF} +{$ENDIF Windows} +{$ENDIF go32v2} +{$ENDIF PATCH_I18N} {$IFDEF use_cp437} + {$IFDEF GUIMSWINMODE} + BoxUpperLeft = #$d5; + BoxUpperRight = #$b8; + BoxLowerLeft = #$d4; + BoxLowerRight = #$be; + BoxHorizontal = #$cd; + BoxVertical = #$b3; + BoxSeperator = '~'; + GLYPH_FRAME_LM = #$11; + GLYPH_FRAME_RM = #$10; + GLYPH_FRAME_TM = #$1e; + GLYPH_FRAME_BM = #$1f; + {$ELSE GUIMSWINMODE} BoxUpperLeft = #218; BoxUpperRight = #191; BoxLowerLeft = #192; @@ -31,12 +47,17 @@ Const BoxHorizontal = #196; BoxVertical = #179; BoxSeperator = #196; + {$ENDIF GUIMSWINMODE} {$ELSE} - BoxUpperLeft = '+'; + BoxUpperLeft = '+'; BoxUpperRight = '+'; - BoxLowerLeft = '+'; + BoxLowerLeft = '+'; BoxLowerRight = '+'; BoxHorizontal = '-'; - BoxVertical = '|'; + BoxVertical = '|'; BoxSeperator = '~'; + GLYPH_FRAME_LM = '+'; + GLYPH_FRAME_RM = '+'; + GLYPH_FRAME_TM = '+'; + GLYPH_FRAME_BM = '+'; {$ENDIF} diff -x .svn -uprN GearHead1100repository.original/build.sh branches/build.sh --- GearHead1100repository.original/build.sh 1970-01-01 09:00:00.000000000 +0900 +++ branches/build.sh 2014-06-13 09:00:00.000000000 +0900 @@ -0,0 +1,790 @@ +#!/bin/sh -- +# +# Bourne shell script, to build arena. +# +# +# How to Use This Script? +# % sh ./build.sh help +# +# +# How to Compile for Unix-like OS: +# +# I18N ASCII mode +# % export PC='path-to-FreePascal/fpc' +# % sh ./build.sh ascii build clean +# +# I18N SDL mode +# % export PC='path-to-FreePascal/fpc' +# % sh ./build.sh sdl build clean +# +# I18N SDL mode, for Developper +# % export PC='path-to-FreePascal/fpc' +# % sh ./build.sh sdl build clean definedebug +# +# +# +# How to Compile with LIBICONV instead of GCONV(alternative library) on GNU/Linux: +# +# I18N ASCII mode +# % export PC='path-to-FreePascal/fpc' +# % sh ./build.sh ascii build nolibc_iconv nolibiconv_plug +# +# If you want a static linked binary, +# % ld -b elf32-i386 -m elf_i386 -dynamic-linker=/lib/ld-linux.so.2 -L. -o ../GearHead-1100.I18N/arena.ascii arena.res +# You must write a arena.res by manually. '-st' option for fpc is usable for write it. +# +# I18N SDL mode +# % export PC='path-to-FreePascal/fpc' +# % sh ./build.sh sdl build nolibc_iconv nolibiconv_plug +# +# If you want a static linked binary, +# % ld -b elf32-i386 -m elf_i386 -dynamic-linker=/lib/ld-linux.so.2 -L. -o ../GearHead-1100.I18N/arena.sdl arena.res +# You must write a arena.res by manually. '-st' option for fpc is usable for write it. +# +# +# +# How to Compile for MS-Windows: +# +# I18N ASCII mode +# % C:\FPC\2.2.2\bin\i386-win32\fpc.exe -g -Ci -Co -CR -Cr -Ct -O3 -Op2 -dENABLE_ADDRESSBOOK -dPATCH_GH -dPATCH_GH_PARANOID_SAFER -dPATCH_JPSSDL -dPATCH_l0ugh -dPATCH -dPATCH_I18N -dPATCH_CHEAT -dPATCH_BACKPORT -dWITH_TENC -dICONV arena.pas +# % C:\FPC\2.2.2\bin\i386-win32\strip.exe arena.exe +# +# I18N ASCII mode with WideChar Function +# % C:\FPC\2.2.2\bin\i386-win32\fpc.exe -g -Ci -Co -CR -Cr -Ct -O3 -Op2 -dENABLE_ADDRESSBOOK -dPATCH_GH -dPATCH_GH_PARANOID_SAFER -dPATCH_JPSSDL -dPATCH_l0ugh -dPATCH -dPATCH_I18N -dPATCH_CHEAT -dPATCH_BACKPORT -dWITH_TENC -dICONV -dWITH_WIDECHAR -dCONV_UNICODE arena.pas +# % C:\FPC\2.2.2\bin\i386-win32\strip.exe arena.exe +# +# I18N GDI mode +# % C:\FPC\2.2.2\bin\i386-win32\fpc.exe -g -Ci -Co -CR -Cr -Ct -O3 -Op2 -dENABLE_ADDRESSBOOK -dPATCH_GH -dPATCH_GH_PARANOID_SAFER -dPATCH_JPSSDL -dPATCH_l0ugh -dPATCH -dPATCH_I18N -dPATCH_CHEAT -dPATCH_BACKPORT -dGUIMSWINMODE -dWITH_TENC -dICONV -dHAVE_NO_TERMINAL arena.pas +# % C:\FPC\2.2.2\bin\i386-win32\strip.exe arena.exe +# +# I18N SDL mode +# % C:\FPC\2.2.2\bin\i386-win32\fpc.exe -g -Ci -Co -CR -Cr -Ct -O1 -Op2 -dENABLE_ADDRESSBOOK -dPATCH_GH -dPATCH_GH_PARANOID_SAFER -dPATCH_JPSSDL -dPATCH_l0ugh -dPATCH -dPATCH_I18N -dPATCH_CHEAT -dPATCH_BACKPORT -dSDLMODE -dWITH_TENC -dCONV_UNICODE -dICONV -dHAVE_NO_TERMINAL -dWITHOUT_SDLIM -FiJEDI-SDLv1.0_extract -FuJEDI-SDLv1.0_extract arena.pas +# % C:\FPC\2.2.2\bin\i386-win32\strip.exe arena.exe +# +# +# +# Compiler Options: +# +# -dSDLMODE +# Select SDL mode. If not, ASCII mode. If you use SDLMODE with PATH_I18N, need with -dCONV_UNICODE. +# -dMINI +# Select Minimize SDL mode. Need with -dSDLMODE. +# -dGUIMSWINMODE +# Select ASCII simulation mode using GDI for MS-Windows, made by l0ugh and updated by G-HAL. +# Need with -dPATCH_I18N and -dHAVE_NO_TERMINAL and -dWITH_TENC. +# NOTE: Only for MS-Windows. +# -dPATCH_I18N +# Enable I18N support. +# -dENABLE_ADDRESSBOOK +# Enable additional function, addressbook, made by l0ugh. +# -dPATCH_GH +# Enable additional function, made by G-HAL. +# -dPATCH_GH_PARANOID_SAFER +# Enable additional function to detect illigal memory access, made by G-HAL. +# -dPATCH_JPSSDL +# Enable additional function, made by jp-SDL version on the JaPanese Spoiler site. +# -dPATCH_l0ugh +# Enable additional function, made by l0ugh. +# -dPATCH +# Enable additional function, made by unknown, perhaps l0ugh or jp-SDL. +# -dPATCH_CHEAT +# Enable cheat function, made by JP-SDL version on the Japanese Spoiler Site and G-HAL. +# -dPATCH_BACKPORT +# Enable backported function. +# -dWITH_TENC +# Enable dynamically chaging of terminal-encoding. (ASCII and SDL) +# NOTE: If you use this option, you can set any source-code and data encoding that differs from the locale. +# -dWITH_WIDECHAR +# Select WideChar/WideString for Write() in ASCII mode. Need with -dCONV_UNICODE. Exclusive with -dSDLMODE. +# -dPASCAL_WRITE_BUG_HACK +# Enable a hack to avoid a bug of Free-Pascal's write while printing I18N string. +# At fpc-2.2.2, this bug was treated (?). +# +# -dCONV_UNICODE +# Enable additional function, handling Unicode. +# NOTE: In UNIX like OS, Need with -dICONV. +# -dICONV +# Select iconv to handle Unicode.(MS-Windows only) +# NOTE: Other OSs require it defining. +# -dLIBC_ICONV +# Select using iconv in libc, offered by GNU/Linux and Solaris. +# -dLIBICONV_PLUG +# Select using iconv offered by GNU/Linux and Solaris. +# +# -dHAVE_NO_TERMINAL +# Compiling for "Window-mode Application" on MS-Windows. MS-Windows only. +# NOTE: Applications using SDL on MS-Windows can not use terminal without creating a console window. +# NOTE: If you set this option, the program create a console window. +# -dWITHOUT_SDLIM +# Select IMM insted of SDL to handle IME. MS-Windows only. +# ATTENTION: If you use it, you must do nooptimize. If you use it and optimize(-O2 or -O3), it cause crash when open a input-dialog. +# NOTE: Only in SDLMODE. +# NOTE: If you setlect setting any source-code and data encoding that differs from the locale, need with -dWITH_TENC. +# +# -dENCODING_SINGLEBYTE +# -dENCODING_EUCJP +# -dENCODING_EUCKR +# -dENCODING_EUCCN +# -dENCODING_EUCTW +# -dENCODING_UTF8 +# -dENCODING_SJIS +# -dENCODING_CP932 +# Fixating source-code and data encoding as it. +# If you do not set it, a value 'SYSTEM_ENCODING' in GameData/I18N_messages.txt is used. +# NOTE: ISO2022-* is not supported. +# +# -dUNIX +# Enable compiling for UNIX like OS. Need with -dICONV, Exclusive with -dWindows. +# -dLINUX +# Enable compiling for UNIX like OS (JEDI-SDL). Need with -dUNIX. +# ATTENTION: Not only GNU/Linux but also *BSD require it defining. +# -dWindows +# Enable compiling for MS-Windows. Exclusive with -dUNIX. +# + +check_exec() +{ + _check_file="$1" + if [ -x ${_check_file} -a ! -d ${_check_file} ]; then + return 0 + fi + return 1 +} + +search_exec() +{ + _env_name="$1" + _search_file="$2" + _default_file="$3" + if [ "x${_default_file}" = "x" ]; then + if check_exec /bin/${_search_file}; then + _ret=/bin/${_search_file} + return 0 + elif check_exec /usr/bin/${_search_file}; then + _ret=/usr/bin/${_search_file} + return 0 + elif check_exec /usr/local/bin/${_search_file}; then + _ret=/usr/local/bin/${_search_file} + return 0 + else + echo "${_search_file} not found." + echo "Please set environment ${_env_name} where ${_search_file} is." + return 1 + fi + elif check_exec ${_default_file}; then + _ret=${_default_file} + return 0 + else + echo "${_default_file} not found." + echo "Please set environment ${_env_name} where ${_search_file} is." + return 1 + fi +} + +# Parse argments +# +# Default Settings +MODE_SHOW= +MODE_CLEAN= +MODE_BUILD= +MODE_CROSS= +MODE_OPTIMIZE= +MODE_DEBUG=yes +MODE_PARANOID_SAFER=yes +MODE_DEFINE_DEBUG= +MODE_STATIC= +MODE_ASCII= +MODE_SDL=yes +MODE_SDLMINI= +MODE_MSWINGDI= +MODE_I18N=yes +MODE_ABOOK=yes +MODE_PATCH=yes +MODE_PATCHl0ugh=yes +MODE_PATCHJPSSDL=yes +MODE_PATCHGH=yes +MODE_PATCH_CHEAT=yes +MODE_PATCH_BACKPORT=yes +MODE_TENC=yes +MODE_WIDECHAR= +MODE_PASCAL_WRITE_BUG_HACK= +MODE_UNIX= +MODE_ENCODING_SINGLEBYTE= +MODE_ENCODING_EUCJP= +MODE_ENCODING_EUCKR= +MODE_ENCODING_EUCCN= +MODE_ENCODING_EUCTW= +MODE_ENCODING_UTF8= +MODE_ENCODING_SJIS= +MODE_ENCODING_CP932= +MODE_CONV_UNICODE= +MODE_ICONV=yes +MODE_LIBC_ICONV=auto +MODE_LIBICONV_PLUG=auto +MODE_32EMU= +OPTIONS="${OPTIONS}" +PCMODE="-Mfpc" +#PCMODE="-Mobjfpc" +LDFLAGS= +LD_RES= +# +for FOO in $* +do + MODE_=yes + MODEnot_= + case $FOO in + no*) + MODE_= + MODEnot_=yes + ;; + esac + case $FOO in + show|noshow) + MODE_SHOW=${MODE_} + ;; + clean|noclean) + MODE_CLEAN=${MODE_} + ;; + build|nobuild) + MODE_BUILD=${MODE_} + ;; + + cross*|nocross) + case $FOO in + cross|nocross) + MODE_CROSS= + ;; + crossemx) + MODE_CROSS=EMX + ;; + crossdarwin) + MODE_CROSS=Darwin + ;; + crossfreebsd) + MODE_CROSS=FreeBSD + ;; + crossgo32v2) + MODE_CROSS=GO32v2 + ;; + crosslinux) + MODE_CROSS=Linux + ;; + crossnetbsd) + MODE_CROSS=NetBSD + ;; + crossnetware) + MODE_CROSS=NetWare + ;; + crossopenbsd) + MODE_CROSS=OpenBSD + ;; + crossos2) + MODE_CROSS=OS2 + ;; + crosssolaris) + MODE_CROSS=Solaris + ;; + crosswatcom) + MODE_CROSS=Watcom + ;; + crosswdosx) + MODE_CROSS=WDosX + ;; + crosswin32) + MODE_CROSS=Win32 + ;; + *) + echo "Cross-platform option '"$FOO"' is unknown." + exit 0 + ;; + esac + ;; + + optimize|nooptimize) + MODE_OPTIMIZE=${MODE_} + ;; + debug|nodebug) + MODE_DEBUG=${MODE_} + ;; + paranoid_safer|noparanoid_safer) + MODE_PARANOID_SAFER=${MODE_} + ;; + definedebug|nodefinedebug) + MODE_DEFINE_DEBUG=${MODE_} + ;; + static|nostatic) + MODE_STATIC=${MODE_} + ;; + + ascii) + MODE_SDL=${MODEnot_} + MODE_SDLMINI=${MODEnot_} + MODE_ASCII=${MODE_} + MODE_MSWINGDI=${MODEnot_} + ;; + sdl) + MODE_SDL=${MODE_} + MODE_SDLMINI= + MODE_ASCII=${MODEnot_} + MODE_MSWINGDI=${MODEnot_} + ;; + sdlmini) + MODE_SDL=${MODE_} + MODE_SDLMINI=${MODE_} + MODE_ASCII=${MODEnot_} + MODE_MSWINGDI=${MODEnot_} + ;; + mswingdi) + MODE_SDL=${MODEnot_} + MODE_SDLMINI= + MODE_ASCII=${MODEnot_} + MODE_MSWINGDI=${MODE_} + ;; + + i18n|noi18n) + MODE_I18N=${MODE_} + ;; + + addressbook|noaddressbook) + MODE_ABOOK=${MODE_} + ;; + patchl0ugh|nopatchl0ugh) + MODE_PATCHl0ugh=${MODE_} + ;; + patchjpssdl|nopatchjpssdl) + MODE_PATCHJPSSDL=${MODE_} + ;; + patchgh|nopatchgh) + MODE_PATCHGH=${MODE_} + ;; + patch|nopatch) + MODE_PATCH=${MODE_} + ;; + jpcheat|nojpcheat|cheat|nocheat) + MODE_PATCH_CHEAT=${MODE_} + ;; + backport|nobackport) + MODE_PATCH_BACKPORT=${MODE_} + ;; + + tenc|notenc) + MODE_TENC=${MODE_} + ;; + widechar|nowidechar) + MODE_WIDECHAR=${MODE_} + ;; + pascal_write_bug_hack|nopascal_write_bug_hack) + MODE_PASCAL_WRITE_BUG_HACK=${MODE_} + ;; + + unix|nounix) + MODE_UNIX=${MODE_} + ;; + + noencoding) + MODE_ENCODING_SINGLEBYTE= + MODE_ENCODING_EUCJP= + MODE_ENCODING_EUCKR= + MODE_ENCODING_EUCCN= + MODE_ENCODING_EUCTW= + MODE_ENCODING_UTF8= + MODE_ENCODING_SJIS= + MODE_ENCODING_CP932= + ;; + encoding_singlebyte) + MODE_ENCODING_SINGLEBYTE=yes + MODE_ENCODING_EUCJP= + MODE_ENCODING_EUCKR= + MODE_ENCODING_EUCCN= + MODE_ENCODING_EUCTW= + MODE_ENCODING_UTF8= + MODE_ENCODING_SJIS= + MODE_ENCODING_CP932= + ;; + encoding_eucjp) + MODE_ENCODING_SINGLEBYTE= + MODE_ENCODING_EUCJP=yes + MODE_ENCODING_EUCKR= + MODE_ENCODING_EUCCN= + MODE_ENCODING_EUCTW= + MODE_ENCODING_UTF8= + MODE_ENCODING_SJIS= + MODE_ENCODING_CP932= + ;; + encoding_euckr) + MODE_ENCODING_SINGLEBYTE= + MODE_ENCODING_EUCJP= + MODE_ENCODING_EUCKR=yes + MODE_ENCODING_EUCCN= + MODE_ENCODING_EUCTW= + MODE_ENCODING_UTF8= + MODE_ENCODING_SJIS= + MODE_ENCODING_CP932= + ;; + encoding_euccn) + MODE_ENCODING_SINGLEBYTE= + MODE_ENCODING_EUCJP= + MODE_ENCODING_EUCKR= + MODE_ENCODING_EUCCN=yes + MODE_ENCODING_EUCTW= + MODE_ENCODING_UTF8= + MODE_ENCODING_SJIS= + MODE_ENCODING_CP932= + ;; + encoding_euctw) + MODE_ENCODING_SINGLEBYTE= + MODE_ENCODING_EUCJP= + MODE_ENCODING_EUCKR= + MODE_ENCODING_EUCCN= + MODE_ENCODING_EUCTW=yes + MODE_ENCODING_UTF8= + MODE_ENCODING_SJIS= + MODE_ENCODING_CP932= + ;; + encoding_utf8) + MODE_ENCODING_SINGLEBYTE= + MODE_ENCODING_EUCJP= + MODE_ENCODING_EUCKR= + MODE_ENCODING_EUCCN= + MODE_ENCODING_EUCTW= + MODE_ENCODING_UTF8=yes + MODE_ENCODING_SJIS= + MODE_ENCODING_CP932= + ;; + encoding_sjis) + MODE_ENCODING_SINGLEBYTE= + MODE_ENCODING_EUCJP= + MODE_ENCODING_EUCKR= + MODE_ENCODING_EUCCN= + MODE_ENCODING_EUCTW= + MODE_ENCODING_UTF8= + MODE_ENCODING_SJIS=yes + MODE_ENCODING_CP932= + ;; + encoding_cp932) + MODE_ENCODING_SINGLEBYTE= + MODE_ENCODING_EUCJP= + MODE_ENCODING_EUCKR= + MODE_ENCODING_EUCCN= + MODE_ENCODING_EUCTW= + MODE_ENCODING_UTF8= + MODE_ENCODING_SJIS= + MODE_ENCODING_CP932=yes + ;; + + iconv|noiconv) + MODE_ICONV=${MODE_} + ;; + libc_iconv|nolibc_iconv) + MODE_LIBC_ICONV=${MODE_} + ;; + autolibc_iconv) + MODE_LIBC_ICONV=auto + ;; + libiconv_plug|nolibiconv_plug) + MODE_LIBICONV_PLUG=${MODE_} + ;; + autolibiconv_plug) + MODE_LIBICONV_PLUG=auto + ;; + + *|help|h) + echo "build.sh , It is a script, to build GearHead." + echo "" + echo "Argments:" + echo " help Show these messages." + echo " " + echo " (no)show Show only. Not execute.(default no)" + echo " (no)clean Erase all object files, such as *.o and *.ppu .(default no)" + echo " (no)build Build arena.(default no)" + echo " (no)cross(darwin|freebsd|linux|netbsd|openbsd|os2|solaris|win32) Cross Compile.(default no)" + echo " " + echo " (no)optimize Build with optimization.(default no)" + echo " (no)debug Build with debugger informations.(default yes)" + echo " (no)paranoid_safer Build with define PATCH_GH_PARANOID_SAFER.(default yes)" + echo " (no)definedebug Build with define DEBUG.(default no)" + echo " " + echo " ascii Build for ASCII-mode.(default no)" + echo " sdl Build for Fullsize SDL-mode.(default yes)" + echo " sdlmini Build for Minimize SDL-mode.(default no)" + echo " mswingdi Build for GDI-mode.(MS-Windows only)(default no)" + echo " " + echo " (no)i18n Enable I18N support.(default yes)" + echo " " + echo " (no)addressbook Enable address-book.(default yes)" + echo " (no)cheat Enable cheat function.(default yes)" + echo " (no)backport Enable backported function.(default yes)" + echo " (no)tenc Enable dynamically chaging of terminal-encoding.(default yes)" + echo " (no)widechar Enable WideChar/WideString for Write().(default no)" + echo " " + echo " (no)unix Build for unixlike os.(default autodetect)" + echo " " + echo " Select Data Charactorset Encoding.(default noencoding)" + echo " noencoding Encoding is dynamic changable, and determine at a run time." + echo " encoding_singlebyte Fixating SingleByteCharacter as source-code and data encoding." + echo " encoding_eucjp Fixating EUC-JP as source-code and data encoding." + echo " encoding_euckr Fixating EUC-KR as source-code and data encoding." + echo " encoding_euccn Fixating EUC-CN as source-code and data encoding." + echo " encoding_euctw Fixating EUC-TW as source-code and data encoding." + echo " encoding_utf8 Fixating UTF8 as source-code and data encoding." + echo " encoding_sjis Fixating ShiftJIS as source-code and data encoding." + echo " encoding_cp932 Fixating CP932 as source-code and data encoding." + echo " " + echo " (no)iconv Build with iconv.(MS-Windows only)(default yes)" + echo " (no|auto)libc_iconv Select using iconv in libc (default auto)" + echo " (no|auto)libiconv_plug Select to define LIBICONV_PLUG (default auto)" + echo " " + echo "Enviroments:" + echo " UNAME Command for 'uname' with fullpath." + echo " RM Command for 'rm' with fullpath." + echo " MKDIR Command for 'mkdir' with fullpath." + echo " PC Command for 'fpc' with fullpath." + echo " LD Command for 'ld' with fullpath." + echo " INCLUDE Additional directory for include." + echo " UNIT Additional directory for unit." + echo " OPTIONS Additional options for compiler." + echo " DEFINE Additional define the symbols for compiler." + echo " SRC Source file.(default arena.pas)" + echo "" + exit 0 + ;; + esac +done +# +# Check Conflict +if [ x$MODE_ASCII = xyes -a x$MODE_SDL = xyes ]; then + echo "Don't use 'ascii' and 'sdl' at the same time." + exit 1 +fi +if [ x$MODE_SDL = xyes -a x$MODE_WIDECHAR = xyes ]; then + echo "Don't use 'sdl' and 'widechar' at the same time." + exit 1 +fi +# + +# +search_exec UNAME uname ${UNAME} || exit 1 +UNAME=${_ret} +search_exec RM rm ${RM} || exit 1 +RM=${_ret} +search_exec MKDIR mkdir ${MKDIR} || exit 1 +MKDIR=${_ret} +search_exec PC fpc ${PC} || exit 1 +PC=${_ret} +search_exec LD ld ${LD} || exit 1 +LD=${_ret} +# +if [ x$MODE_ABOOK = xyes ]; then + DEFINE="${DEFINE} -dENABLE_ADDRESSBOOK" +fi +if [ x$MODE_PATCHGH = xyes ]; then + DEFINE="${DEFINE} -dPATCH_GH" +fi +if [ x$MODE_PATCHJPSSDL = xyes ]; then + DEFINE="${DEFINE} -dPATCH_JPSSDL" +fi +if [ x$MODE_PATCHl0ugh = xyes ]; then + DEFINE="${DEFINE} -dPATCH_l0ugh" +fi +if [ x$MODE_PATCH = xyes ]; then + DEFINE="${DEFINE} -dPATCH" +fi +if [ x$MODE_I18N = xyes ]; then + DEFINE="${DEFINE} -dPATCH_I18N" +fi +if [ x$MODE_PATCH_CHEAT = xyes ]; then + DEFINE="${DEFINE} -dPATCH_CHEAT" +fi +if [ x$MODE_PATCH_BACKPORT = xyes ]; then + DEFINE="${DEFINE} -dPATCH_BACKPORT" +fi +# +if [ x$MODE_ENCODING_SINGLEBYTE = xyes ]; then + DEFINE="${DEFINE} -dENCODING_SINGLEBYTE" +elif [ x$MODE_ENCODING_EUCJP = xyes ]; then + DEFINE="${DEFINE} -dENCODING_EUCJP" +elif [ x$MODE_ENCODING_EUCKR = xyes ]; then + DEFINE="${DEFINE} -dENCODING_EUCKR" +elif [ x$MODE_ENCODING_EUCCN = xyes ]; then + DEFINE="${DEFINE} -dENCODING_EUCCN" +elif [ x$MODE_ENCODING_EUCTW = xyes ]; then + DEFINE="${DEFINE} -dENCODING_EUCTW" +elif [ x$MODE_ENCODING_UTF8 = xyes ]; then + DEFINE="${DEFINE} -dENCODING_UTF8" +elif [ x$MODE_ENCODING_SJIS = xyes ]; then + DEFINE="${DEFINE} -dENCODING_SJIS" +elif [ x$MODE_ENCODING_CP932 = xyes ]; then + DEFINE="${DEFINE} -dENCODING_CP932" +fi +# +if [ x$MODE_CROSS = x ]; then + OS_IDENT=`${UNAME} -s` +else + OPTIONS="${OPTIONS} -T${MODE_CROSS}" + OS_IDENT="${MODE_CROSS}" +fi +case ${OS_IDENT} in +FreeBSD|NetBSD|OpenBSD|*BSD|Darwin) + MODE_UNIX=yes +# if [ x`${UNAME} -m` = xamd64 ]; then +# if [ ! -f fpc.cfg ]; then +# echo "'fpc.cfg' not found." +# exit 1; +# fi +# LDFLAGS="-m elf_i386_fbsd" +# MODE_32EMU=yes +# fi + ;; +Linux|linux) + MODE_UNIX=yes + if [ x$MODE_LIBC_ICONV = xauto ]; then + MODE_LIBC_ICONV=yes + fi + if [ x$MODE_LIBICONV_PLUG = xauto ]; then + MODE_LIBICONV_PLUG=yes + fi + LDFLAGS="-b elf32-i386 -m elf_i386 -dynamic-linker=/lib/ld-linux.so.2" + ;; +*Solaris*|*solaris*) + MODE_UNIX=yes + if [ x$MODE_LIBC_ICONV = xauto ]; then + MODE_LIBC_ICONV=yes + fi + if [ x$MODE_LIBICONV_PLUG = xauto ]; then + MODE_LIBICONV_PLUG=yes + fi + ;; +*Win32*|*win32*|*Windows*|*CYGWIN*|*MINGW*) + MODE_UNIX= + if [ x$MODE_MSWINGDI = xyes ]; then + DEFINE="${DEFINE} -dHAVE_NO_TERMINAL" + elif [ x$MODE_SDL = xyes ]; then + MODE_OPTIMIZE= + DEFINE="${DEFINE} -dHAVE_NO_TERMINAL -dWITHOUT_SDLIM" + fi + if [ x$MODE_ENCODING_SJIS = x -a x$MODE_ENCODING_CP932 = x ]; then + MODE_TENC=yes + fi + ;; +*) + ;; +esac +if [ -f /usr/local/lib/X11/fonts/TrueType/sazanami-gothic.ttf ]; then + DEFINE="${DEFINE} -dFONTFILE_USR_LOCAL" +elif [ -f /usr/X11R6/lib/X11/fonts/TrueType/sazanami-gothic.ttf ]; then + DEFINE="${DEFINE} -dFONTFILE_USR_X11R6" +elif [ -f /usr/share/fonts/truetype/sazanami/sazanami-gothic.ttf ]; then + DEFINE="${DEFINE} -dFONTFILE_USR_SHARE" +fi +# +if [ x$MODE_SDL = xyes ]; then + if [ x$MODE_UNIX = xyes -a x$MODE_I18N = xyes ]; then + MODE_ICONV=yes + fi + if [ x$MODE_ICONV = xyes -a x$MODE_I18N = xyes ]; then + MODE_CONV_UNICODE=yes + fi + DEFINE="${DEFINE} -dSDLMODE" + MODE_STRING="sdl" + if [ x$MODE_SDLMINI = xyes ]; then + DEFINE="${DEFINE} -dMINI" + fi + if [ x$MODE_32EMU = xyes ]; then + LD_RES="build.link.sdlmode.32.static.res" + else + LD_RES="build.link.sdlmode.static.res" + fi +fi +if [ x$MODE_MSWINGDI = xyes ]; then + DEFINE="${DEFINE} -dGUIMSWINMODE" + MODE_STRING="ascii_mswingdi" +fi +if [ x$MODE_ASCII = xyes ]; then + MODE_STRING="ascii" +fi +# +if [ x$MODE_TENC = xyes ]; then + DEFINE="${DEFINE} -dWITH_TENC" + MODE_ICONV=yes +fi +if [ x$MODE_WIDECHAR = xyes ]; then + DEFINE="${DEFINE} -dWITH_WIDECHAR" + MODE_CONV_UNICODE=yes +fi +if [ x$MODE_PASCAL_WRITE_BUG_HACK = xyes ]; then + DEFINE="${DEFINE} -dPASCAL_WRITE_BUG_HACK" +fi +if [ x$MODE_CONV_UNICODE = xyes ]; then + DEFINE="${DEFINE} -dCONV_UNICODE" +fi +if [ x$MODE_ICONV = xyes ]; then + DEFINE="${DEFINE} -dICONV" +fi +if [ x$MODE_LIBC_ICONV = xyes ]; then + DEFINE="${DEFINE} -dLIBC_ICONV" +fi +if [ x$MODE_LIBICONV_PLUG = xyes ]; then + DEFINE="${DEFINE} -dLIBICONV_PLUG" +fi +# +if [ x$MODE_DEBUG = xyes ]; then + OPTIONS="${OPTIONS} -g -Ci -Co -CR -Cr -Ct" +fi +if [ x$MODE_PARANOID_SAFER = xyes ]; then + DEFINE="${DEFINE} -dPATCH_GH_PARANOID_SAFER" +fi +if [ x$MODE_DEFINE_DEBUG = xyes ]; then + DEFINE="${DEFINE} -dDEBUG" +fi +if [ x$MODE_OPTIMIZE = xyes ]; then + OPTIONS="${OPTIONS} -O3 -Op2" +else + OPTIONS="${OPTIONS}" +fi +if [ x$MODE_STATIC = xyes -a x$MODE_ASCII = xyes ]; then + OPTIONS="${OPTIONS} -Xt" +fi +if [ x$MODE_UNIX = xyes ]; then + DEFINE="${DEFINE} -dUNIX -dLINUX" +fi +# +if [ x$PATH_TO_OBJECTS_ADD = x ]; then + PATH_TO_OBJECTS="build.${MODE_STRING}.${OS_IDENT}" +else + PATH_TO_OBJECTS="build.${MODE_STRING}.${OS_IDENT}.${PATH_TO_OBJECTS_ADD}" +fi +if [ ! -d ${PATH_TO_OBJECTS} ]; then + ${MKDIR} ${PATH_TO_OBJECTS} +fi +OPTIONS="${OPTIONS} -FU${PATH_TO_OBJECTS} -FE${PATH_TO_OBJECTS}" +# +PCFLAGS="${OPTIONS} ${DEFINE} ${INCLUDE} ${UNIT}" +SRC=${SRC:-"arena.pas"} +# + +# +if [ x$MODE_CLEAN = xyes ]; then + if [ x$MODE_SHOW = x ]; then + ${RM} *.o *.ppu + else + echo "${RM} *.o *.ppu" + fi +fi +# +if [ x$MODE_BUILD = xyes ]; then + if [ x$MODE_SHOW = x ]; then + ${PC} ${PCMODE} ${PCFLAGS} ${SRC} + else + echo "${PC} ${PCMODE} ${PCFLAGS} ${SRC}" + fi +fi +if [ x$MODE_STATIC = xyes -a x$MODE_SDL = xyes ]; then + if [ x$MODE_SHOW = x ]; then + ${LD} ${LDFLAGS} -L. -o arena.static ${LD_RES} + else + echo "${LD} ${LDFLAGS} -L. -o arena.static ${LD_RES}" + fi +fi +# + +# [ End of File ] diff -x .svn -uprN GearHead1100repository.original/congfx.pp branches/congfx.pp --- GearHead1100repository.original/congfx.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/congfx.pp 2014-06-17 09:00:00.000000000 +0900 @@ -22,13 +22,21 @@ unit ConGfx; interface +{$IFDEF GUIMSWINMODE} +uses w32crt; +{$ELSE GUIMSWINMODE} uses crt; +{$ENDIF GUIMSWINMODE} const { For the purpose of making things easy on me, the } { screen is divided into several zones. } +{$IFDEF PATCH_GH} + NumZones = 31; +{$ELSE PATCH_GH} NumZones = 30; +{$ENDIF PATCH_GH} ZONE_Map = 1; ZONE_Clock = 2; ZONE_Info = 3; @@ -63,6 +71,11 @@ const ZONE_UsagePrompt = 29; ZONE_UsageMenu = 30; +{$IFDEF PATCH_GH} + ZONE_MoreText = 31; +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} + ZONE_MemoText = 27; ZONE_MemoMenu = 28; @@ -71,9 +84,15 @@ const ( -30 , -5 , -1 , -5 ), ( -30 , 1 , -1 , 10 ), ( -30 , 11 , -1 , -6 ), +{$IFDEF PATCH_I18N} + ( -30 , 11 , -1 , 14 ), + + ( -30 , 15 , -1 , -6 ), +{$ELSE PATCH_I18N} ( -30 , 11 , -1 , 13 ), ( -30 , 14 , -1 , -6 ), +{$ENDIF PATCH_I18N} ( 1 , -4 , -1 , 0 ), ( 3 , 3 , -62 , -6 ), ( -60 , 3 , -32 , -6 ), @@ -101,10 +120,25 @@ const ( -68 , -20 , -38 , -13 ), ( -68 , -11 , -38 , -10 ), ( -68 , -20 , -38 , -17 ), +{$IFDEF PATCH_GH} + ( -68 , -15 , -38 , -10 ), + ( 1 , 1 , -1 , -1 ) +{$ELSE PATCH_GH} ( -68 , -15 , -38 , -10 ) +{$ENDIF PATCH_GH} ); +{$IFDEF PATCH_GH} + GOTOXY_MIN = 1; + GOTOXY_MAX = 255; +{$ELSE PATCH_GH} + {$IFDEF PATCH_I18N} + GOTOXY_MIN = 1; + GOTOXY_MAX = 255; + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} + { *** STANDARD COLORS *** } StdBlack: Byte = Black; StdWhite: Byte = White; @@ -135,7 +169,11 @@ Procedure DrawMapBorder( N,E,S,W: Boolea Procedure DrawBPBorder; Procedure DrawCharGenBorder; Procedure SetupCombatDisplay; +{$IFDEF PATCH_GH} + { SetupHQDisplay was moved into context.pp. } +{$ELSE PATCH_GH} Procedure SetupHQDisplay; +{$ENDIF PATCH_GH} Procedure SetupFactoryDisplay; Procedure SetupYesNoDisplay; Procedure SetupMemoDisplay; @@ -143,37 +181,65 @@ Procedure SetupInteractDisplay( TeamColo implementation -uses ui4gh; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF GUIMSWINMODE} + w32,conoutput, +{$ENDIF GUIMSWINMODE} + ui4gh; {$I boxdraw.inc} Procedure ClipZone( ZoneNumber: Integer ); { Set the clipping bounds to this defined zone. } begin +{$IFDEF GUIMSWINMODE} + w32crt.Window( ScreenZone[ZoneNumber,1] , ScreenZone[ZoneNumber,2] , ScreenZone[ZoneNumber,3] , ScreenZone[ZoneNumber,4] ); +{$ELSE GUIMSWINMODE} Window( ScreenZone[ZoneNumber,1] , ScreenZone[ZoneNumber,2] , ScreenZone[ZoneNumber,3] , ScreenZone[ZoneNumber,4] ); +{$ENDIF GUIMSWINMODE} end; Procedure MaxClipZone; { Restore the clip area to the maximum possible area. } begin +{$IFDEF GUIMSWINMODE} + w32crt.Window( 1 , 1 , ScreenColumns , ScreenRows ); +{$ELSE GUIMSWINMODE} Window( 1 , 1 , ScreenColumns , ScreenRows ); +{$ENDIF GUIMSWINMODE} end; Procedure ClrZone( ZoneNumber: Integer ); { Clear the specified screen zone. } begin ClipZone( ZoneNumber ); +{$IFDEF GUIMSWINMODE} + w32crt.TextBackground( Black ); + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} TextBackground( Black ); ClrScr; +{$ENDIF GUIMSWINMODE} MaxClipZone; end; Procedure ClrScreen; { Clear the entire screen. } begin +{$IFDEF GUIMSWINMODE} + w32crt.TextBackground( Black ); +{$ELSE GUIMSWINMODE} TextBackground( Black ); +{$ENDIF GUIMSWINMODE} MaxClipZone; +{$IFDEF GUIMSWINMODE} + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} ClrScr; +{$ENDIF GUIMSWINMODE} end; Procedure DrawZoneBorder( X1, Y1, X2, Y2, Color: Byte ); @@ -182,14 +248,29 @@ var t: integer; {a counter, of the house of CBM.} begin {Set the color for the box.} +{$IFDEF GUIMSWINMODE} + w32crt.TextColor(Color); + w32crt.TextBackground( Black ); +{$ELSE GUIMSWINMODE} TextColor(Color); TextBackground( Black ); +{$ENDIF GUIMSWINMODE} {$IFDEF NeedShifts} ShiftAltCharset; {$ENDIF} {Print the four corners.} +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY(X1,Y1); + conoutput.ConWrite(BoxUpperLeft); + w32crt.GotoXY(X2,Y1); + conoutput.ConWrite(BoxUpperRight); + w32crt.GotoXY(X1,Y2); + conoutput.ConWrite(BoxLowerLeft); + w32crt.GotoXY(X2,Y2); + conoutput.ConWrite(BoxLowerRight); +{$ELSE GUIMSWINMODE} GotoXY(X1,Y1); write(BoxUpperLeft); GotoXY(X2,Y1); @@ -198,21 +279,36 @@ begin write(BoxLowerLeft); GotoXY(X2,Y2); write(BoxLowerRight); +{$ENDIF GUIMSWINMODE} {Print the two horizontal edges.} for t := X1+1 to X2-1 do begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY(t,Y1); + conoutput.ConWrite(BoxHorizontal); + w32crt.GotoXY(t,Y2); + conoutput.ConWrite(BoxHorizontal); +{$ELSE GUIMSWINMODE} GotoXY(t,Y1); write(BoxHorizontal); GotoXY(t,Y2); write(BoxHorizontal); +{$ENDIF GUIMSWINMODE} end; {Print the two vertical edges.} for t := Y1+1 to Y2-1 do begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY(X1,t); + conoutput.Conwrite(BoxVertical); + w32crt.GotoXY(X2,t); + conoutput.ConWrite(BoxVertical); +{$ELSE GUIMSWINMODE} GotoXY(X1,t); write(BoxVertical); GotoXY(X2,t); write(BoxVertical); +{$ENDIF GUIMSWINMODE} end; {$IFDEF NeedShifts} @@ -245,23 +341,43 @@ begin { Draw "MORE"s as appropriate. } If N then begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ( ScreenZone[ ZONE_Map , 1 ] + ScreenZone[ ZONE_Map , 3 ] ) div 2 - 2 , ScreenZone[ ZONE_Map , 2 ] - 1 ); + conoutput.ConWrite( StringOfChar(GLYPH_FRAME_TM, 5) ); +{$ELSE GUIMSWINMODE} GotoXY( ( ScreenZone[ ZONE_Map , 1 ] + ScreenZone[ ZONE_Map , 3 ] ) div 2 - 2 , ScreenZone[ ZONE_Map , 2 ] - 1 ); Write( '+++++' ); +{$ENDIF GUIMSWINMODE} end; If S then begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ( ScreenZone[ ZONE_Map , 1 ] + ScreenZone[ ZONE_Map , 3 ] ) div 2 - 2 , ScreenZone[ ZONE_Map , 4 ] + 1 ); + conoutput.ConWrite( StringOfChar(GLYPH_FRAME_BM, 5) ); +{$ELSE GUIMSWINMODE} GotoXY( ( ScreenZone[ ZONE_Map , 1 ] + ScreenZone[ ZONE_Map , 3 ] ) div 2 - 2 , ScreenZone[ ZONE_Map , 4 ] + 1 ); Write( '+++++' ); +{$ENDIF GUIMSWINMODE} end; If W then begin for t := 1 to 4 do begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenZone[ ZONE_Map , 1 ] - 1 , ( ScreenZone[ ZONE_Map , 2 ] + ScreenZone[ ZONE_Map , 4 ] ) div 2 - 2 + T ); + conoutput.ConWrite( GLYPH_FRAME_LM ); +{$ELSE GUIMSWINMODE} GotoXY( ScreenZone[ ZONE_Map , 1 ] - 1 , ( ScreenZone[ ZONE_Map , 2 ] + ScreenZone[ ZONE_Map , 4 ] ) div 2 - 2 + T ); Write( '+' ); +{$ENDIF GUIMSWINMODE} end; end; If E then begin for t := 1 to 4 do begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenZone[ ZONE_Map , 3 ] + 1 , ( ScreenZone[ ZONE_Map , 2 ] + ScreenZone[ ZONE_Map , 4 ] ) div 2 - 2 + T ); + conoutput.ConWrite( GLYPH_FRAME_RM ); +{$ELSE GUIMSWINMODE} GotoXY( ScreenZone[ ZONE_Map , 3 ] + 1 , ( ScreenZone[ ZONE_Map , 2 ] + ScreenZone[ ZONE_Map , 4 ] ) div 2 - 2 + T ); Write( '+' ); +{$ENDIF GUIMSWINMODE} end; end; end; @@ -271,16 +387,29 @@ Procedure DrawBPBorder; var T: Integer; begin +{$IFDEF PATCH_GH} + DrawZoneBorder( ScreenZone[ ZONE_EqpMenu , 1 ] - 1 , ScreenZone[ ZONE_EqpMenu , 2 ] - 1 , ScreenZone[ ZONE_EqpMenu , 3 ] + 1 , ScreenZone[ ZONE_EqpMenu , 4 ] + 1 , White ); + DrawZoneBorder( ScreenZone[ ZONE_InvMenu , 1 ] - 1 , ScreenZone[ ZONE_InvMenu , 2 ] - 1 , ScreenZone[ ZONE_InvMenu , 3 ] + 1 , ScreenZone[ ZONE_InvMenu , 4 ] + 1 , White ); +{$ELSE PATCH_GH} DrawZoneBorder( ScreenZone[ ZONE_EqpMenu , 1 ] - 1 , ScreenZone[ ZONE_EqpMenu , 2 ] - 1 , ScreenZone[ ZONE_InvMenu , 3 ] + 1 , ScreenZone[ ZONE_InvMenu , 4 ] + 1 , White ); +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenZone[ ZONE_EqpMenu , 1 ] , ScreenZone[ ZONE_EqpMenu , 4 ] + 1 ); +{$ELSE GUIMSWINMODE} GotoXY( ScreenZone[ ZONE_EqpMenu , 1 ] , ScreenZone[ ZONE_EqpMenu , 4 ] + 1 ); +{$ENDIF GUIMSWINMODE} {$IFDEF NeedShifts} ShiftAltCharset; {$ENDIF} for t := 1 to (ScreenZone[ ZONE_EqpMenu , 3 ] - ScreenZone[ ZONE_EqpMenu , 1 ] + 1 ) do +{$IFDEF GUIMSWINMODE} + conoutput.ConWrite(BoxSeperator); +{$ELSE GUIMSWINMODE} write(BoxSeperator); +{$ENDIF GUIMSWINMODE} {$IFDEF NeedShifts} ShiftNormalCharset; {$ENDIF} +{$ENDIF PATCH_GH} end; @@ -295,20 +424,35 @@ end; Procedure SetupCombatDisplay; { Clear the screen & draw boxes. } begin +{$IFDEF GUIMSWINMODE} + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} ClrScr; +{$ENDIF GUIMSWINMODE} end; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Procedure SetupHQDisplay; { CLear the screen & draw boxes. } begin + {$IFDEF GUIMSWINMODE} + w32crt.ClrScr; + {$ELSE GUIMSWINMODE} ClrScr; + {$ENDIF GUIMSWINMODE} end; +{$ENDIF PATCH_GH} Procedure SetupFactoryDisplay; { CLear the screen & draw boxes. } begin +{$IFDEF GUIMSWINMODE} + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} ClrScr; +{$ENDIF GUIMSWINMODE} DrawExtBorder( ZONE_Factory_Parts , LightGray ); DrawExtBorder( ZONE_Factory_Caption , White ); end; @@ -320,12 +464,20 @@ var begin ClrZone( ZONE_YesNoTotal ); DrawZoneBorder( ZONE_YesNoTotal , LightBlue ); +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenZone[ ZONE_YesNoMenu , 1 ] , ScreenZone[ ZONE_YesNoMenu , 2 ] - 1 ); +{$ELSE GUIMSWINMODE} GotoXY( ScreenZone[ ZONE_YesNoMenu , 1 ] , ScreenZone[ ZONE_YesNoMenu , 2 ] - 1 ); +{$ENDIF GUIMSWINMODE} {$IFDEF NeedShifts} ShiftAltCharset; {$ENDIF} for t := 1 to (ScreenZone[ ZONE_YesNoMenu , 3 ] - ScreenZone[ ZONE_YesNoMenu , 1 ] + 1 ) do +{$IFDEF GUIMSWINMODE} + conoutput.ConWrite(BoxSeperator); +{$ELSE GUIMSWINMODE} write(BoxSeperator); +{$ENDIF GUIMSWINMODE} {$IFDEF NeedShifts} ShiftNormalCharset; {$ENDIF} @@ -338,12 +490,20 @@ var begin ClrZone( ZONE_YesNoTotal ); DrawZoneBorder( ZONE_YesNoTotal , LightMagenta ); +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenZone[ ZONE_YesNoMenu , 1 ] , ScreenZone[ ZONE_YesNoMenu , 2 ] - 1 ); +{$ELSE GUIMSWINMODE} GotoXY( ScreenZone[ ZONE_YesNoMenu , 1 ] , ScreenZone[ ZONE_YesNoMenu , 2 ] - 1 ); +{$ENDIF GUIMSWINMODE} {$IFDEF NeedShifts} ShiftAltCharset; {$ENDIF} for t := 1 to (ScreenZone[ ZONE_YesNoMenu , 3 ] - ScreenZone[ ZONE_YesNoMenu , 1 ] + 1 ) do +{$IFDEF GUIMSWINMODE} + conoutput.ConWrite(BoxSeperator); +{$ELSE GUIMSWINMODE} write(BoxSeperator); +{$ENDIF GUIMSWINMODE} {$IFDEF NeedShifts} ShiftNormalCharset; {$ENDIF} @@ -369,6 +529,14 @@ var t, uRows, uCols, iRowOff, iColOff: Integer; begin +{$IFDEF PATCH_GH} + if (0 < ScreenSize_Width) and (ScreenSize_Width < ScreenColumns) then begin + ScreenColumns := ScreenSize_Width; + end; + if (0 < ScreenSize_Height) and (ScreenSize_Height < ScreenRows) then begin + ScreenRows := ScreenSize_Height; + end; +{$ENDIF PATCH_GH} if ScreenRows > 57 then uRows := 57 else uRows := ScreenRows; if ScreenColumns > 83 then uCols := 83 else uCols := ScreenColumns; @@ -410,17 +578,90 @@ begin end; end; end; + +{$IFDEF PATCH_GH} + if (0 < ScreenSize_Width) or (0 < ScreenSize_Height) then begin + for t := 1 to NumZones do begin + case t of + ZONE_Map: + begin + if ScreenColumns < ScreenSize_Width then begin + ScreenZone[t,3] := ScreenZone[t,3] * ScreenSize_Width div uCols; + end; + if ScreenRows < ScreenSize_Height then begin + ScreenZone[t,4] := ScreenZone[t,4] * ScreenSize_Height div uRows; + end; + end; + else + begin + if ScreenColumns < ScreenSize_Width then begin + if 2 < ScreenZone[t,1] then begin + ScreenZone[t,1] := ScreenZone[t,1] * ScreenSize_Width div uCols; + end; + ScreenZone[t,3] := ScreenZone[t,3] * ScreenSize_Width div uCols; + end; + if ScreenRows < ScreenSize_Height then begin + if 2 < ScreenZone[t,2] then begin + ScreenZone[t,2] := ScreenZone[t,2] * ScreenSize_Height div uRows; + end; + ScreenZone[t,4] := ScreenZone[t,4] * ScreenSize_Height div uRows; + end; + end; + end; + end; + if 49 < (ScreenZone[ZONE_Map,3] - ScreenZone[ZONE_Map,1]) then begin + ScreenZone[ZONE_Map,3] := ScreenZone[ZONE_Map,1] + 49; + end; + if 49 < (ScreenZone[ZONE_Map,4] - ScreenZone[ZONE_Map,2]) then begin + ScreenZone[ZONE_Map,4] := ScreenZone[ZONE_Map,2] + 49; + end; + ScreenColumns := ScreenSize_Width; + ScreenRows := ScreenSize_Height; + end; +{$ENDIF PATCH_GH} +{$IFDEF GUIMSWINMODE} + MSWINGUI_Width := ScreenColumns; + MSWINGUI_Height := ScreenRows; +{$ENDIF GUIMSWINMODE} end; + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: congfx.pp'); +{$ENDIF DEBUG} +{$IFDEF GUIMSWINMODE} + CheckDimensions; + w32crt.W32CrtInit; + w32crt.CursorOff; + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} CursorOff; {LINUX ALERT... Maybe also doesn't work on Win2000} ClrScr; CheckDimensions; +{$ENDIF GUIMSWINMODE} +end; finalization -{$IFNDEF DEBUG} +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: congfx.pp(finalization)'); +{$ENDIF DEBUG} +{$IFDEF GUIMSWINMODE} + w32crt.NormVideo; + w32crt.ClrScr; + w32crt.CursorOn; + w32crt.DisposeWindow; +{$ELSE GUIMSWINMODE} + {$IFDEF DEBUG} + {$ELSE DEBUG} NormVideo; ClrScr; -{$ENDIF} + {$ENDIF} CursorOn; +{$ENDIF GUIMSWINMODE} +end; + end. diff -x .svn -uprN GearHead1100repository.original/coninfo.pp branches/coninfo.pp --- GearHead1100repository.original/coninfo.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/coninfo.pp 2014-02-26 09:00:00.000000000 +0900 @@ -22,10 +22,17 @@ unit ConInfo; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; Procedure GearInfo( Part: GearPtr; X1,Y1,X2,Y2,BorColor: Byte ); Procedure LocationInfo( Part: GearPtr; gb: GameBoardPtr ); +{$IFDEF PATCH_GH} +Procedure DisplayGearInfo( Part: GearPtr; DebugMode: Boolean ); +{$ENDIF PATCH_GH} Procedure DisplayGearInfo( Part: GearPtr ); Procedure DisplayGearInfo( Part: GearPtr; gb: GameBoardPtr; Z: Integer ); Procedure DisplayGearInfo( Part: GearPtr; gb: GameBoardPtr ); @@ -40,13 +47,34 @@ Procedure MapEditInfo( Pen,Palette,X,Y: implementation -uses crt,ability,damage,gearutil,ghchars,ghmecha,ghmodule,ghweapon, - interact,movement,texutil,congfx,conmap,context; +uses +{$IFDEF GUIMSWINMODE} +{$ELSE GUIMSWINMODE} + crt, +{$ENDIF GUIMSWINMODE} +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + ui4gh, +{$ENDIF PATCH_CHEAT} +{$IFDEF GUIMSWINMODE} + w32crt, + conoutput, +{$ENDIF GUIMSWINMODE} + ability,damage,gearutil,ghchars,ghmecha,ghmodule,ghweapon, + interact,movement,texutil,congfx,conmap,context; var CX,CY: Byte; { Cursor Position } ZX1,ZY1,ZX2,ZY2: Byte; { Info Zone coords } +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} LastGearShown: GearPtr; +{$ENDIF PATCH_GH} const SX_Char: Array [1..Num_Status_FX] of Char = ( @@ -71,6 +99,10 @@ var it: LongInt; S: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + it := GearMaxArmor( Part ); S := Part^.InvCom; while S <> Nil do begin @@ -86,6 +118,10 @@ var it: LongInt; S: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + it := GearCurrentArmor( Part ); S := Part^.InvCom; while S <> Nil do begin @@ -100,11 +136,24 @@ Procedure AI_Title( msg: String; C: Byte var X: Integer; begin +{$IFDEF PATCH_I18N} + X := ( ( ZX2 - ZX1 ) div 2 ) - ( WidthMBcharStr( msg ) div 2 ) + 1; +{$ELSE PATCH_I18N} X := ( ( ZX2 - ZX1 ) div 2 ) - ( Length( msg ) div 2 ) + 1; +{$ENDIF PATCH_I18N} if X < 1 then X := 1; +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( X , CY ); + w32crt.TextColor( C ); +{$ELSE GUIMSWINMODE} GotoXY( X , CY ); TextColor( C ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr( msg, 0 ); +{$ELSE PATCH_I18N} Write( msg ); +{$ENDIF PATCH_I18N} CX := 1; CY := CY + 1; end; @@ -112,9 +161,18 @@ end; Procedure AI_Line( msg: String; C: Byte ); { Draw a left justified message on the current line. } begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ZX1 , CY ); + w32crt.TextColor( C ); +{$ELSE GUIMSWINMODE} GotoXY( ZX1 , CY ); TextColor( C ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr( msg, (ZX2-ZX1) ); +{$ELSE PATCH_I18N} Write( msg ); +{$ENDIF PATCH_I18N} CX := 1; Inc( CY ); end; @@ -122,10 +180,23 @@ end; Procedure AI_PrintFromRight( msg: String; Tab,C: Byte ); { Draw a left justified message on the current line. } begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( Tab , CY ); + w32crt.TextColor( C ); +{$ELSE GUIMSWINMODE} GotoXY( Tab , CY ); TextColor( C ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr( msg, 0 ); +{$ELSE PATCH_I18N} Write( msg ); +{$ENDIF PATCH_I18N} +{$IFDEF GUIMSWINMODE} + CX := w32crt.WhereX; +{$ELSE GUIMSWINMODE} CX := WhereX; +{$ENDIF GUIMSWINMODE} end; Procedure AI_PrintFromLeft( msg: String; Tab,C: Byte ); @@ -133,22 +204,52 @@ Procedure AI_PrintFromLeft( msg: String; var TP: Integer; begin +{$IFDEF PATCH_I18N} + TP := Tab - WidthMBcharStr( msg ); +{$ELSE PATCH_I18N} TP := Tab - Length( msg ); +{$ENDIF PATCH_I18N} if TP < 1 then TP := 1; +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( TP , CY ); + w32crt.TextColor( C ); +{$ELSE GUIMSWINMODE} GotoXY( TP , CY ); TextColor( C ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr( msg, 0 ); +{$ELSE PATCH_I18N} Write( msg ); +{$ENDIF PATCH_I18N} +{$IFDEF GUIMSWINMODE} + CX := w32crt.WhereX; +{$ELSE GUIMSWINMODE} CX := WhereX; +{$ENDIF GUIMSWINMODE} end; Procedure AI_PrintChar( msg: Char; C: Byte ); { Print a character on the current line, unless doing so would } { cause the line to spread onto the next line. } begin +{$IFDEF GUIMSWINMODE} + if w32crt.WhereX < ( ZX2 - ZX1 - 1 ) then begin + w32crt.TextColor( C ); +{$ELSE GUIMSWINMODE} if WhereX < ( ZX2 - ZX1 - 1 ) then begin TextColor( C ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr( msg, 0 ); +{$ELSE PATCH_I18N} Write( msg ); +{$ENDIF PATCH_I18N} +{$IFDEF GUIMSWINMODE} + CX := w32crt.WhereX; +{$ELSE GUIMSWINMODE} CX := WhereX; +{$ENDIF GUIMSWINMODE} end; end; @@ -191,6 +292,9 @@ end; Function ArmorColor( Part: GearPtr ): LongInt; { Decide upon a nice color to represent the armor of this part. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(StatusColor(100,0)); +{$ENDIF PATCH_GH} ArmorColor := StatusColor( MaxTArmor( Part ) , CurrentTArmor( Part ) ); end; @@ -199,6 +303,10 @@ Function ArmorDamageColor( Part: GearPtr var MA,CA: LongInt; { Max Armor, Current Armor } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(StatusColor(100,0)); +{$ENDIF PATCH_GH} + MA := MaxTArmor( Part ); CA := CurrentTArmor( Part ); @@ -218,8 +326,16 @@ Procedure ShowStatus( Part: GearPtr ); var T: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Show the character's status conditions. } +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( 2 , CY ); +{$ELSE GUIMSWINMODE} GotoXY( 2 , CY ); +{$ENDIF GUIMSWINMODE} { Hunger and morale come first. } if Part^.G = GG_Character then begin @@ -294,17 +410,44 @@ var BG := Red; end; +{$IFDEF GUIMSWINMODE} + w32crt.TextColor(FG); + w32crt.TextBackground(BG); +{$ELSE GUIMSWINMODE} TextColor(FG); TextBackground(BG); +{$ENDIF GUIMSWINMODE} if Odd( N ) then X := X0 - ( N div 2 ) - 1 else X := X0 + ( N div 2 ); Inc( N ); +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( X , CY ); +{$ELSE GUIMSWINMODE} GotoXY( X , CY ); +{$ENDIF GUIMSWINMODE} Case GS of +{$IFDEF GUIMSWINMODE} + GS_Head: conoutput.ConWrite('o'); + GS_Turret: conoutput.ConWrite('='); + GS_Storage: conoutput.ConWrite('x'); +{$IFDEF PATCH_CHEAT} + GS_Conversion: conoutput.ConWrite('O'); +{$ENDIF PATCH_CHEAT} + GS_Body: begin + conoutput.ConWrite('B'); + end; + GS_Arm: conoutput.ConWrite('+'); + GS_Wing: conoutput.ConWrite('W'); + GS_Tail: conoutput.ConWrite('t'); + GS_Leg: conoutput.ConWrite('l'); +{$ELSE GUIMSWINMODE} GS_Head: write('o'); GS_Turret: write('='); GS_Storage: write('x'); +{$IFDEF PATCH_CHEAT} + GS_Conversion: write('O'); +{$ENDIF PATCH_CHEAT} GS_Body: begin write('B'); end; @@ -312,6 +455,7 @@ var GS_Wing: write('W'); GS_Tail: write('t'); GS_Leg: write('l'); +{$ENDIF GUIMSWINMODE} end; end; MD := MD^.Next; @@ -319,14 +463,16 @@ var end; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} { this "if" is just a shortcut } if GearOperational(Mek) then begin Gutted := False; - Flayed := False; - end - else begin + Flayed := False; + end else begin Gutted := (NAttValue( Mek^.NA , NAG_EpisodeData , NAS_Gutted) = 1); Flayed := (NAttValue( Mek^.NA , NAG_EpisodeData , NAS_Flayed) = 1); end; @@ -339,6 +485,9 @@ begin N := 0; AddPartsToDiagram( GS_Head ); AddPartsToDiagram( GS_Turret ); +{$IFDEF PATCH_CHEAT} + AddPartsToDiagram( GS_Conversion ); +{$ENDIF PATCH_CHEAT} if N < 1 then N := 1; { Want storage to either side of body. } AddPartsToDiagram( GS_Storage ); AI_NextLine; @@ -358,7 +507,11 @@ begin AI_NextLine; { Restore background color to black. } +{$IFDEF GUIMSWINMODE} + w32crt.TextBackground( Black ); +{$ELSE GUIMSWINMODE} TextBackground( Black ); +{$ENDIF GUIMSWINMODE} { Restore CY. } CY := MM; @@ -372,9 +525,26 @@ var msg: String; MM,N,A,B: Integer; MD: GearPtr; -begin +{$IFDEF PATCH_CHEAT} + MoveOrder: Integer; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { General mecha information - Name, mass, maneuver } +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_DESIG then begin + AI_PrintFromLeft( GearName(Mek) , 0, White ); + AI_PrintFromRight( SAttValue( Mek^.SA , 'DESIG' ) , ZX2 - ZX1 - WidthMBcharStr(SAttValue(Mek^.SA,'DESIG')) , MenuItem ); + AI_NextLine; + end else begin + AI_Title( GearName(Mek) , White ); + end; +{$ELSE PATCH_CHEAT} AI_Title( GearName(Mek) , White ); +{$ENDIF PATCH_CHEAT} DisplayModules( Mek ); @@ -384,10 +554,23 @@ begin AI_NextLine; AI_PrintFromRight( 'SE:' + SgnStr(MechaSensorRating(Mek)) , ZX2 - ZX1 - 5 , LightGray ); AI_NextLine; +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_OverLoad then begin + MM := OverloadCapacity( Mek ) - NAttValue( Mek^.NA , NAG_Condition , NAS_Overload ); + if MM < 0 then AI_PrintFromRight( 'OL:' + SgnStr(MM) , ZX2 - ZX1 - 5 , EnemyRed ) + else AI_PrintFromRight( 'OC:' + BStr(MM) , ZX2 - ZX1 - 5 , MenuItem ); + AI_NextLine; + end; +{$ENDIF PATCH_CHEAT} { Pilot Information - Name, health, rank } MD := LocatePilot( Mek ); +{$IFDEF PATCH_GH} + if (NIL <> MD) and (GG_DisposeGear < MD^.G) then begin +{$ELSE PATCH_GH} if MD <> Nil then begin +{$ENDIF PATCH_GH} + { Pilot's name - Left Justified. } msg := GearName( MD ); @@ -413,9 +596,36 @@ begin { Movement information. } MM := NAttValue( Mek^.NA , NAG_Action , NAS_MoveMode ); if MM > 0 then begin +{$IFDEF PATCH_I18N} + msg := I18N_Name('MoveModeName',MoveModeName[ MM ]); +{$ELSE PATCH_I18N} msg := MoveModeName[ MM ]; +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_DamagePercent then begin + msg := msg + ReplaceHash( I18N_MsgString('MekStatDisplay','Broken'), BStr(100 - PercentDamaged(Mek)) ); + end else if Cheat_Display_SpeedoMeter then begin + if Cheat_Display_SW and ( BaseMoveRate( Mek ) = 0 ) then begin + msg := msg + ReplaceHash( I18N_MsgString('MekStatDisplay','Broken'), BStr(100 - PercentDamaged(Mek)) ); + end else begin + MoveOrder := NAttValue( Mek^.NA , NAG_Action , NAS_MoveAction ); + if ( NAV_TurnLeft = MoveOrder ) or ( NAV_TurnRight = MoveOrder ) then begin + msg := msg + ' (' + I18N_MsgString('MekStatDisplay','Turn') + ' ' + BStr( NAttValue( Mek^.NA , NAG_Action , NAS_SpeedoMeter ) ) + 'dpr)'; + end else begin + msg := msg + ' (' + BStr( NAttValue( Mek^.NA , NAG_Action , NAS_SpeedoMeter ) ) + 'dpr)'; + end; + end; + end else begin + msg := msg + ' (' + BStr( Speedometer( Mek ) ) + 'dpr)'; + end; +{$ELSE PATCH_CHEAT} msg := msg + ' (' + BStr( Speedometer( Mek ) ) + 'dpr)'; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_I18N} + end else msg := I18N_MsgString('MekStatDisplay','Immobile'); +{$ELSE PATCH_I18N} end else msg := 'Immobile'; +{$ENDIF PATCH_I18N} AI_Title( msg , DarkGray ); AI_NextLine; @@ -427,7 +637,14 @@ Procedure CharacterInfo( Part: GearPtr ) var T,TT,Width,S: Integer; C: Byte; -begin +{$IFDEF PATCH_CHEAT} + MPV,GV: Int64; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Show the character's name and health status. } AI_Title( GearName(Part) , White ); @@ -442,6 +659,15 @@ begin AI_PrintFromLeft( BStr( CharCurrentMental(Part)) + '/' + BStr( CharMental(Part)) , ZX2 - ZX1 - 2 , EnduranceColor( CharMental(Part) , CharCurrentMental(Part) ) ); AI_PrintFromLeft( 'Me' , ZX2 - ZX1 + 1 , LightGray ); AI_NextLine; +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_PV then begin + GV := Int64(GearValue(Part)) * Int64(Part^.Scale +1); + MPV := Int64(Part^.V) * Int64(Part^.V * 150 - 100) * Int64(Part^.Scale +1); + if MPV > GV then GV := MPV; + AI_PrintFromLeft( BStr( GV ) , ZX2 - ZX1 - 2 , MenuItem ); + AI_PrintFromLeft( 'PV' , ZX2 - ZX1 + 1 , MenuItem ); + end; +{$ENDIF PATCH_CHEAT} AI_NextLine; @@ -451,7 +677,11 @@ begin { Show the character's stats. } for t := 1 to ( NumGearStats div 4 ) do begin for tt := 1 to 4 do begin +{$IFDEF PATCH_I18N} + AI_PrintFromRight( HeadMBChar( I18N_Name('StatName', StatName[ T * 4 + TT - 4 ]) ) + ':' , ( TT-1 ) * Width + 1 , LightGray ); +{$ELSE PATCH_I18N} AI_PrintFromRight( StatName[ T * 4 + TT - 4 ][1] + StatName[ T * 4 + TT - 4 ][2] + ':' , ( TT-1 ) * Width + 1 , LightGray ); +{$ENDIF PATCH_I18N} { Determine the stat value. This may be higher or lower than natural... } S := CStat( Part , T * 4 + TT - 4 ); @@ -466,15 +696,27 @@ begin ShowStatus( Part ); end; +{$IFDEF PATCH_GH} +Procedure MiscInfo( Part: GearPtr; DebugMode: Boolean ); +{$ELSE PATCH_GH} Procedure MiscInfo( Part: GearPtr ); +{$ENDIF PATCH_GH} { Display info for any gear that doesn't have its own info } { procedure. } var N: LongInt; msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (not(DebugMode) and (Part^.G <= GG_DisposeGear)) then Exit; +{$ENDIF PATCH_GH} + { Show the part's name. } +{$IFDEF PATCH_GH} + AI_Title( GearName(Part,DebugMode) , White ); +{$ELSE PATCH_GH} AI_Title( GearName(Part) , White ); +{$ENDIF PATCH_GH} { Display the part's armor rating. } N := GearCurrentArmor( Part ); @@ -489,9 +731,20 @@ begin else msg := '-'; AI_PrintFromRight( msg + ' DP' , CX , HitsColor( Part ) ); +{$IFDEF PATCH_GH} + N := ( Int64(GearMass( Part )) + 1 ) div 2; +{$ELSE PATCH_GH} N := ( GearMass( Part ) + 1 ) div 2; +{$ENDIF PATCH_GH} if N > 0 then AI_PrintFromLeft( MassString( Part ) , ZX2 - ZX1 + 2 , LightGray ); +{$IFDEF PATCH_GH} + if Part^.G < 0 then begin + AI_NextLine; + AI_PrintFromRight( Bstr( Part^.G ) + ',' + BStr( Part^.S ) + ',' + BStr( Part^.V ), CX, LightGray ); + end; +{$ENDIF PATCH_GH} + GameMsg( ExtendedDescription( Part ) , ZX1 , ZY1 + 3 , ZX2 , ZY2 , LightGray ); end; @@ -510,14 +763,22 @@ begin CX := 1; CY := 1; +{$IFDEF GUIMSWINMODE} + w32crt.Window( ZX1 , ZY1 , ZX2 , ZY2 ); + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} Window( ZX1 , ZY1 , ZX2 , ZY2 ); ClrScr; +{$ENDIF GUIMSWINMODE} end; Procedure MetaTerrainInfo( Part: GearPtr ); { Display info for any gear that doesn't have its own info } { procedure. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} AI_Title( GearName(Part) , TerrainGreen ); end; @@ -525,20 +786,41 @@ Procedure RepairFuelInfo( Part: GearPtr { Display info for any gear that doesn't have its own info } { procedure. } var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Show the part's name. } AI_Title( GearName(Part) , White ); +{$IFDEF PATCH_GH} + N := ( Int64(GearMass( Part )) + 1 ) div 2; +{$ELSE PATCH_GH} N := ( GearMass( Part ) + 1 ) div 2; +{$ENDIF PATCH_GH} if N > 0 then AI_PrintFromLeft( MassString( Part ) , ZX2 - ZX1 + 2 , LightGray ); AI_NextLine; +{$IFDEF PATCH_I18N} + AI_Title( I18N_Name( 'SkillMan', SkillMan[ Part^.S ].Name ) , Yellow ); +{$ELSE PATCH_I18N} AI_Title( SkillMan[ Part^.S ].Name , Yellow ); +{$ENDIF PATCH_I18N} AI_Title( BStr( Part^.V ) + ' DP' , Green ); end; + +{$IFDEF PATCH_GH} +Procedure GearInfo( Part: GearPtr; X1,Y1,X2,Y2,BorColor: Byte; DebugMode: Boolean ); +{$ELSE PATCH_GH} Procedure GearInfo( Part: GearPtr; X1,Y1,X2,Y2,BorColor: Byte ); +{$ENDIF PATCH_GH} { Display some information for this gear inside the screen area } { X1,Y1,X2,Y2. } begin @@ -547,12 +829,16 @@ begin SetInfoZone( X1,Y1,X2,Y2,BorColor ); +{$IFDEF PATCH_GH} + if (NIL = Part) or (not(DebugMode) and (Part^.G <= GG_DisposeGear)) then Exit; +{$ELSE PATCH_GH} { Record this gear's address. } LastGearShown := Part; { Error check } { Note that we want the area cleared, even in case of an error. } if Part = Nil then exit; +{$ENDIF PATCH_GH} { Depending upon PART's type, branch to an appropriate procedure. } case Part^.G of @@ -560,13 +846,24 @@ begin GG_Character: CharacterInfo( Part ); GG_MetaTerrain: MetaTerrainInfo( Part ); GG_RepairFuel: RepairFuelInfo( Part ); +{$IFDEF PATCH_GH} + else MiscInfo( Part, DebugMode ); +{$ELSE PATCH_GH} else MiscInfo( Part ); +{$ENDIF PATCH_GH} end; { Restore the clip area to the full screen. } maxclipzone; end; +{$IFDEF PATCH_GH} +Procedure GearInfo( Part: GearPtr; X1,Y1,X2,Y2,BorColor: Byte ); +begin + GearInfo( Part, X1,Y1,X2,Y2,BorColor, False ); +end; +{$ENDIF PATCH_GH} + Procedure LocationInfo( Part: GearPtr; gb: GameBoardPtr ); { Display location info for this part, if it is on the map. } { This procedure is meant to be called after a GearInfo call, } @@ -578,67 +875,145 @@ const var D,Z: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Props are master gears, but they don't get location info. } if OnTheMap( Part ) and IsMasterGear( Part ) and ( Part^.G <> GG_Prop ) then begin { Clear the compass area. } +{$IFDEF GUIMSWINMODE} + w32crt.gotoXY( ZX1 + OX - 1 , ZY1 + OY - 1 ); + conoutput.ConWrite( ' ' ); + w32crt.gotoXY( ZX1 + OX - 1 , ZY1 + OY ); + conoutput.ConWrite( ' ' ); + w32crt.gotoXY( ZX1 + OX - 1 , ZY1 + OY + 1 ); + conoutput.ConWrite( ' ' ); +{$ELSE GUIMSWINMODE} gotoXY( ZX1 + OX - 1 , ZY1 + OY - 1 ); write( ' ' ); gotoXY( ZX1 + OX - 1 , ZY1 + OY ); write( ' ' ); gotoXY( ZX1 + OX - 1 , ZY1 + OY + 1 ); write( ' ' ); +{$ENDIF GUIMSWINMODE} D := NAttValue( Part^.NA , NAG_Location , NAS_D ); Z := MekAltitude( gb , Part ); if Z >= 0 then begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ZX1 + OX , ZY1 + OY ); + w32crt.TextColor( NeutralGrey ); + conoutput.ConWrite( BStr ( Z ) ); +{$ELSE GUIMSWINMODE} GotoXY( ZX1 + OX , ZY1 + OY ); TextColor( NeutralGrey ); Write( BStr ( Z ) ); +{$ENDIF GUIMSWINMODE} end else begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ZX1 + OX , ZY1 + OY ); + w32crt.TextColor( PlayerBlue ); + conoutput.ConWrite( BStr ( Abs( Z ) ) ); +{$ELSE GUIMSWINMODE} GotoXY( ZX1 + OX , ZY1 + OY ); TextColor( PlayerBlue ); Write( BStr ( Abs( Z ) ) ); +{$ENDIF GUIMSWINMODE} end; +{$IFDEF GUIMSWINMODE} + w32crt.TextColor( White ); + w32crt.GotoXY( ZX1 + OX + AngDir[D,1] , ZY1 + OY + AngDir[D,2] ); + conoutput.ConWrite( '+' ); + w32crt.TextColor( DarkGray ); + w32crt.GotoXY( ZX1 + OX - AngDir[D,1] , ZY1 + OY - AngDir[D,2] ); + conoutput.ConWrite( '=' ); +{$ELSE GUIMSWINMODE} TextColor( White ); GotoXY( ZX1 + OX + AngDir[D,1] , ZY1 + OY + AngDir[D,2] ); Write( '+' ); TextColor( DarkGray ); GotoXY( ZX1 + OX - AngDir[D,1] , ZY1 + OY - AngDir[D,2] ); Write( '=' ); +{$ENDIF GUIMSWINMODE} { Speedometer. } if Speedometer( Part ) > 0 then begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ZX1 + OX - 3 , ZY1 + OY ); +{$ELSE GUIMSWINMODE} GotoXY( ZX1 + OX - 3 , ZY1 + OY ); +{$ENDIF GUIMSWINMODE} if NAttValue( Part^.NA , NAG_Action , NAS_MoveAction ) = NAV_FullSPeed then begin +{$IFDEF GUIMSWINMODE} + w32crt.TextColor( LightCyan ); +{$ELSE GUIMSWINMODE} TextColor( LightCyan ); +{$ENDIF GUIMSWINMODE} end else begin +{$IFDEF GUIMSWINMODE} + w32crt.TextColor( Cyan ); +{$ELSE GUIMSWINMODE} TextColor( Cyan ); +{$ENDIF GUIMSWINMODE} end; +{$IFDEF GUIMSWINMODE} + conoutput.ConWrite( 'G' ); + w32crt.GotoXY( ZX1 + OX - 3 , ZY1 + OY + 1 ); + w32crt.TextColor( DarkGray ); + conoutput.ConWrite( 'S' ); +{$ELSE GUIMSWINMODE} Write( 'G' ); GotoXY( ZX1 + OX - 3 , ZY1 + OY + 1 ); TextColor( DarkGray ); Write( 'S' ); +{$ENDIF GUIMSWINMODE} end else begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ZX1 + OX - 3 , ZY1 + OY ); + w32crt.TextColor( DarkGray ); + conoutput.ConWrite( 'G' ); + w32crt.GotoXY( ZX1 + OX - 3 , ZY1 + OY + 1 ); + w32crt.TextColor( Cyan ); + conoutput.ConWrite( 'S' ); +{$ELSE GUIMSWINMODE} GotoXY( ZX1 + OX - 3 , ZY1 + OY ); TextColor( DarkGray ); Write( 'G' ); GotoXY( ZX1 + OX - 3 , ZY1 + OY + 1 ); TextColor( Cyan ); Write( 'S' ); +{$ENDIF GUIMSWINMODE} end; end; end; + +{$IFDEF PATCH_GH} Procedure DisplayGearInfo( Part: GearPtr ); +begin + DisplayGearInfo( Part, False ); +end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Procedure DisplayGearInfo( Part: GearPtr; DebugMode: Boolean ); +{$ELSE PATCH_GH} +Procedure DisplayGearInfo( Part: GearPtr ); +{$ENDIF PATCH_GH} { Show some stats for whatever sort of thing PART is. } begin { All this procedure does is call the ArenaInfo unit procedure } { with the dimensions of the Info Zone. } +{$IFDEF PATCH_GH} + GearInfo( Part, ScreenZone[ ZONE_Info, 1 ], ScreenZone[ ZONE_Info, 2 ], ScreenZone[ ZONE_Info, 3 ], ScreenZone[ ZONE_Info, 4 ], NeutralGrey, DebugMode ); +{$ELSE PATCH_GH} GearInfo( Part , ScreenZone[ ZONE_Info , 1 ] , ScreenZone[ ZONE_Info , 2 ] , ScreenZone[ ZONE_Info , 3 ] , ScreenZone[ ZONE_Info , 4 ] , NeutralGrey ); +{$ENDIF PATCH_GH} end; Procedure DisplayGearInfo( Part: GearPtr; gb: GameBoardPtr; Z: Integer ); @@ -663,12 +1038,23 @@ Function JobAgeGenderDesc( NPC: GearPtr var msg,job: String; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + JobAgeGenderDesc := ReplaceHash( I18N_MsgString('JobAgeGenderDesc'), + BStr( NAttValue( NPC^.NA , NAG_CharDescription , NAS_DAge ) + 20 ), + I18N_Name('GenderName',GenderName[ NAttValue( NPC^.NA , NAG_CharDescription , NAS_Gender ) ]), + I18N_Name('Jobs',SAttValue( NPC^.SA , 'JOB' )) ); +{$ELSE PATCH_I18N} msg := BStr( NAttValue( NPC^.NA , NAG_CharDescription , NAS_DAge ) + 20 ); msg := msg + ' year old ' + LowerCase( GenderName[ NAttValue( NPC^.NA , NAG_CharDescription , NAS_Gender ) ] ); job := SAttValue( NPC^.SA , 'JOB' ); if job <> '' then msg := msg + ' ' + LowerCase( job ); msg := msg + '.'; JobAgeGenderDesc := msg; +{$ENDIF PATCH_I18N} end; Procedure DisplayInteractStatus( GB: GameBoardPtr; NPC: GearPtr; React,Endurance: Integer ); @@ -678,14 +1064,23 @@ var C: Byte; T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + ZX1 := ScreenZone[ ZONE_InteractStatus , 1 ]; ZY1 := ScreenZone[ ZONE_InteractStatus , 2 ]; ZX2 := ScreenZone[ ZONE_InteractStatus , 3 ]; ZY2 := ScreenZone[ ZONE_InteractStatus , 4 ]; CX := 1; CY := 1; +{$IFDEF GUIMSWINMODE} + w32crt.Window( ZX1 , ZY1 , ZX2 , ZY2 ); + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} Window( ZX1 , ZY1 , ZX2 , ZY2 ); ClrScr; +{$ENDIF GUIMSWINMODE} { First the name, then the description. } AI_Title( GearName( NPC ) , InfoHiLight ); @@ -722,7 +1117,11 @@ Procedure QuickWeaponInfo( Part: GearPtr begin { Error check } { Note that we want the area cleared, even in case of an error. } +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if Part = Nil then exit; +{$ENDIF PATCH_GH} { Display the weapon description. } GameMsg( GearName( Part ) + ' ' + WeaponDescription( Part ) , ZONE_Menu1 , InfoGreen ); @@ -739,9 +1138,17 @@ var Mek: GearPtr; begin { Begin with one massive error check... } +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if PC = Nil then Exit; +{$ENDIF PATCH_GH} if PC^.G <> GG_Character then PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if PC = Nil then Exit; +{$ENDIF PATCH_GH} SetInfoZone( ScreenZone[ ZONE_Map , 1 ] - 1 , ScreenZone[ ZONE_Map , 2 ] - 1 , ScreenZone[ ZONE_Map , 3 ] + 1 , ScreenZone[ ZONE_Map , 4 ] + 1 , PlayerBlue ); @@ -767,7 +1174,11 @@ begin else C := Green; { Do the output. } +{$IFDEF PATCH_I18N} + AI_PrintFromRight( I18N_Name( 'StatName', StatName[ T ] ), 2 , LightGray ); +{$ELSE PATCH_I18N} AI_PrintFromRight( StatName[ T ] , 2 , LightGray ); +{$ENDIF PATCH_I18N} AI_PrintFromLeft( BStr( S ) , 15 , C ); AI_PrintFromRight( MsgString( 'STATRANK' + BStr( R ) ) , 16 , C ); @@ -796,6 +1207,33 @@ begin AI_NextLine; { Print info on the PC's mecha, if appropriate. } +{$IFDEF PATCH_GH} + if ( GB <> Nil ) then begin + Mek := FindPilotsMecha( GB^.Meks , PC ); + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + AI_NextLine; + AI_PrintFromRight( MsgString( 'INFO_MekSelect' ) , T , LightGray ); + AI_NextLine; + + msg := FullGearName( Mek ); + AI_PrintFromLeft( Msg , ZX2 - ZX1 + 1 , Green ); + end; + + { Print info on the PC's faction, if appropriate. } + FID := NAttValue( PC^.NA , NAG_Personal , NAS_FactionID ); + if ( FID <> 0 ) and ( GB^.Scene <> Nil ) then begin + Mek := SeekFaction( GB^.Scene , FID ); + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + AI_NextLine; + AI_PrintFromRight( MsgString( 'INFO_Faction' ) , T , LightGray ); + AI_NextLine; + + msg := GearName( Mek ); + AI_PrintFromLeft( Msg , ZX2 - ZX1 + 1 , Green ); + end; + end; + end; +{$ELSE PATCH_GH} if ( GB <> Nil ) then begin Mek := FindPilotsMecha( GB^.Meks , PC ); if Mek <> Nil then begin @@ -823,6 +1261,7 @@ begin AI_PrintFromLeft( Msg , ZX2 - ZX1 + 1 , Green ); end; end; +{$ENDIF PATCH_GH} msg := SAttValue( PC^.SA , 'BIO1' ); if msg <> '' then begin @@ -841,6 +1280,9 @@ Procedure InjuryViewer( PC: GearPtr ); MD,CD: Integer; begin while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} MD := GearMaxDamage( Part ); CD := GearCurrentDamage( Part ); if not PartActive( Part ) then begin @@ -851,6 +1293,9 @@ Procedure InjuryViewer( PC: GearPtr ); AI_NextLine; end; ShowSubInjuries( Part^.SubCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; @@ -858,9 +1303,17 @@ var SP,MP,T: Integer; begin { Begin with one massive error check... } +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if PC = Nil then Exit; +{$ENDIF PATCH_GH} if PC^.G <> GG_Character then PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if PC = Nil then Exit; +{$ENDIF PATCH_GH} SetInfoZone( ScreenZone[ ZONE_Map , 1 ] - 1 , ScreenZone[ ZONE_Map , 2 ] - 1 , ScreenZone[ ZONE_Map , 3 ] + 1 , ScreenZone[ ZONE_Map , 4 ] + 1 , PlayerBlue ); @@ -922,6 +1375,16 @@ Procedure MapEditInfo( Pen,Palette,X,Y: { Show the needed info for the map editor- the current pen } { terrain, the terrain palette, and the cursor position. } begin +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenZone[ ZONE_Info , 1 ] + 1 , ScreenZone[ ZONE_Info , 2 ] + 1 ); + w32crt.TextBackground( Black ); + w32crt.ClrEOL; + w32crt.TextColor( White ); + conoutput.ConWrite( '[' ); + w32crt.TextColor( TerrColor[ Pen ] ); + conoutput.ConWrite( TerrGfx[ Pen ] ); + w32crt.TextColor( White ); +{$ELSE GUIMSWINMODE} GotoXY( ScreenZone[ ZONE_Info , 1 ] + 1 , ScreenZone[ ZONE_Info , 2 ] + 1 ); TextBackground( Black ); ClrEOL; @@ -930,9 +1393,30 @@ begin TextColor( TerrColor[ Pen ] ); Write( TerrGfx[ Pen ] ); TextColor( White ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr( '] ' + I18N_Name('TerrMan',TerrMan[Pen].Name), 0 ); +{$ELSE PATCH_I18N} Write( '] ' + TerrMan[ Pen ].Name ); +{$ENDIF PATCH_I18N} CMessage( BStr( X ) + ',' + BStr( Y ) , ZONE_Clock , White ); end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: coninfo.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: coninfo.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/conmap.pp branches/conmap.pp --- GearHead1100repository.original/conmap.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/conmap.pp 2015-05-23 09:00:00.000000000 +0900 @@ -22,7 +22,16 @@ unit ConMap; interface -uses crt,gears,locale; +uses +{$IFDEF GUIMSWINMODE} + w32crt, +{$ELSE GUIMSWINMODE} + crt, +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; const { DISPLAYSHOT CONSTANTS } @@ -96,8 +105,26 @@ Procedure BeginTurn( GB: GameBoardPtr; M implementation -uses ability,action,damage,effects,gearutil,ghprop,menugear,movement, - texutil,ui4gh,congfx,context; +uses +{$IFDEF DEBUG} + sysutils, + errmsg, +{$ENDIF DEBUG} +{$IFDEF GUIMSWINMODE} + conoutput, +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + ui4gh, + ability,action,damage,effects,gearutil,ghprop,menugear,movement, + texutil,congfx,context +{$ELSE PATCH_GH} + ability,action,damage,effects,gearutil,ghprop,menugear,movement, + texutil,ui4gh,congfx,context +{$ENDIF PATCH_GH} + ; const OriginX: Integer = 1; { These constants tell what tile is being } @@ -116,7 +143,11 @@ Function TeamColor( GB: GameBoardPtr; G: var T,color: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = G) or (G^.G <= GG_DisposeGear) or (NIL = GB) then begin +{$ELSE PATCH_GH} if ( G = Nil ) or ( GB = Nil ) then begin +{$ENDIF PATCH_GH} { No gear provided - Neutral Gray. } color := NeutralGrey; @@ -179,6 +210,9 @@ end; Function OnTheScreen( Mek: GearPtr ): Boolean; { Check to see whether or not the specified mek is visible on screen. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} OnTheScreen := OnTheScreen( NAttValue( Mek^.NA , NAG_Location , NAS_X ) , NAttValue( Mek^.NA , NAG_Location , NAS_Y ) ); end; @@ -243,21 +277,38 @@ Procedure DrawMapImage( Gfx: Char; X,Y: { Draw the specified image at the specified map coordinates. } begin if not OnTheScreen( X , Y ) then exit; +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenX( X ) , ScreenY( Y ) ); + w32crt.TextColor( C ); + w32crt.TextBackground( StdBlack ); + conoutput.ConWrite( Gfx ); +{$ELSE GUIMSWINMODE} GotoXY( ScreenX( X ) , ScreenY( Y ) ); TextColor( C ); TextBackground( StdBlack ); Write( Gfx ); +{$ENDIF GUIMSWINMODE} end; Procedure DrawRvsImage( Gfx: Char; X,Y: Integer; C: Byte ); { Draw the specified image at the specified map coordinates. } begin if not OnTheScreen( X , Y ) then exit; +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenX( X ) , ScreenY( Y ) ); + w32crt.TextColor( StdBlack ); +{$ELSE GUIMSWINMODE} GotoXY( ScreenX( X ) , ScreenY( Y ) ); TextColor( StdBlack ); +{$ENDIF GUIMSWINMODE} if ( C = Black ) or ( C = DarkGray ) then C := Blue; +{$IFDEF GUIMSWINMODE} + w32crt.TextBackground( C ); + conoutput.ConWrite( Gfx ); +{$ELSE GUIMSWINMODE} TextBackground( C ); Write( Gfx ); +{$ENDIF GUIMSWINMODE} end; procedure DrawMekX( GB: GameBoardPtr; Mek: GearPtr; Hilight: Boolean ); @@ -270,7 +321,11 @@ var X,Y: Integer; begin { Error check- make sure we have a valid mek. } +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if Mek = Nil then Exit; +{$ENDIF PATCH_GH} if not OnTheScreen( Mek ) then Exit; { Extract the position information. } @@ -281,7 +336,11 @@ begin if not OnTheMap(X,Y) then exit; { Make sure the mek is visible to the player... } +{$IFDEF DEBUG} + if (MekVisible( gb , Mek ) or DEBUG_CanSeeAll) then begin +{$ELSE DEBUG} if MekVisible( gb , Mek ) then begin +{$ENDIF DEBUG} roguechar := SAttValue( Mek^.SA , 'ROGUECHAR' ); { If the mek is destroyed, draw wreckage instead of the regular image. } @@ -304,7 +363,11 @@ begin end else if ( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and ( NumActiveMasters( GB , NAV_DefPlayerTeam ) = 1 ) then begin Gfx := '@'; end else begin +{$IFDEF PATCH_I18N} + Gfx := InitialGearName( Mek ); +{$ELSE PATCH_I18N} Gfx := GearName( Mek )[1]; +{$ENDIF PATCH_I18N} end; if Mek^.G = GG_MetaTerrain then begin case Mek^.S of @@ -331,6 +394,9 @@ procedure DrawMek( gb: GameBoardPtr; Mek { Draw a mecha indicator at map location X , Y with } { direction D. Got all that? } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} DrawMekX( gb , Mek , False ); end; @@ -345,7 +411,11 @@ begin { If this tile is marked as visible better show it. } { Otherwise draw a blank spot. } +{$IFDEF DEBUG} + if (gb^.Map[ X , Y ].Visible or DEBUG_CanSeeAll) then begin +{$ELSE DEBUG} if gb^.Map[ X , Y ].Visible then begin +{$ENDIF DEBUG} if Hilight then DrawRvsImage( TerrGfx[ gb^.map[X,Y].terr ] , X , Y , TerrColor[ gb^.map[X,Y].terr ] ) else DrawMapImage( TerrGfx[ gb^.map[X,Y].terr ] , X , Y , TerrColor[ gb^.map[X,Y].terr ] ); end else begin @@ -387,22 +457,38 @@ begin { Items only get displayed if the tile they're in is already visible. } M := gb^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if not IsMasterGear(M) then begin X := NAttValue( M^.NA , NAG_Location , NAS_X ); Y := NAttValue( M^.NA , NAG_Location , NAS_Y ); + {$IFDEF DEBUG} + if OnTheMap( X , Y ) and (GB^.Map[X,Y].Visible or DEBUG_CanSeeAll) then begin + {$ELSE DEBUG} if OnTheMap( X , Y ) and GB^.Map[X,Y].Visible then begin + {$ENDIF DEBUG} DrawMek( GB , M ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; { Display the mecha, i.e. the master gears. } M := gb^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if IsMasterGear(M) then begin DrawMek( GB , M ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -422,14 +508,22 @@ begin M := FindVisibleBlockerAtSpot( GB , X , Y ); { If there's a visible gear here, plot that. } +{$IFDEF PATCH_GH} + if (NIL <> M) and (GG_DisposeGear < M^.G) then begin +{$ELSE PATCH_GH} if M <> Nil then begin +{$ENDIF PATCH_GH} DrawMekX( GB , M , Hilight ); end else begin { No master here, check for an item. } M := FindVisibleItemAtSpot( GB , X , Y ); +{$IFDEF PATCH_GH} + if (NIL <> M) and (GG_DisposeGear < M^.G) and GB^.Map[X,Y].Visible then begin +{$ELSE PATCH_GH} if ( M <> Nil ) and GB^.Map[X,Y].Visible then begin +{$ENDIF PATCH_GH} { Draw the item. } DrawMekX( GB , M , Hilight ); end else begin @@ -453,6 +547,10 @@ var Team: Integer; P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + team := NAttValue( Mek^.NA , NAG_Location , NAS_Team ); P := GearCurrentLocation( Mek ); if ( Team = NAV_DefPlayerTeam ) and NeedsRecentering( P.X , P.Y ) then begin @@ -479,6 +577,10 @@ procedure IndicateTile( GB: GameBoardPtr var team: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + team := NAttValue( Mek^.NA , NAG_Location , NAS_Team ); if MekVisible( GB , Mek ) and ( OnTheScreen( Mek ) or ( Team = NAV_DefPlayerTeam ) ) then IndicateTile( GB , NAttValue( Mek^.NA , NAG_Location , NAS_X ) , NAttValue( Mek^.NA , NAG_Location , NAS_Y ) ); end; @@ -488,6 +590,11 @@ Procedure RevealMek( GB: GameBoardPtr; M var team: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; + if (NIL = Spotter) or (Spotter^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + team := NAttValue( Spotter^.NA , NAG_Location , NAS_Team ); SetNAtt( Mek^.NA , NAG_Visibility , Team , NAV_Spotted ); RedrawTile( gb , Mek ); @@ -499,6 +606,10 @@ var P: Point; X,Y,MZ,R,Obs: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + P := GearCurrentLocation( Mek ); R := MappingRange( Mek , GB^.Scale ); MZ := MekAltitude( GB , Mek ); @@ -526,6 +637,9 @@ Procedure VisionCheck( GB: GameBoardPtr; var M2: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if ( Mek = Nil ) or ( not GearOperational( Mek ) ) or ( not OnTheMap( Mek ) ) then exit; { Start by assuming that the mek will be hidden after this. } @@ -534,6 +648,9 @@ begin M2 := GB^.Meks; while M2 <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M2^.G) then begin +{$ENDIF PATCH_GH} { We are only interested in this other mek if it's an } { enemy of the one we're checking. } if OnTheMap( M2 ) then begin @@ -552,6 +669,9 @@ begin if CheckLOS( GB , M2 , Mek ) then RevealMek( GB , Mek , M2 ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M2 := M2^.Next; end; @@ -573,7 +693,11 @@ var Team: GearPtr; P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) or (NIL = GB) then Exit; +{$ELSE PATCH_GH} if ( GB = Nil ) or ( Mek = Nil ) then Exit; +{$ENDIF PATCH_GH} { Find the team for this model. } Team := LocateTeam( GB , NAttValue( Mek^.NA , NAG_Location , NAS_Team ) ); @@ -608,11 +732,20 @@ begin SetNAtt( mek^.NA , NAG_EpisodeData, NAS_UID, MaxIdTag( GB^.Meks , NAG_EpisodeData, NAS_UID ) + 1 ); { Stick mek on board. } +{$IFDEF PATCH_GH} + Mek^.Next := NIL; + AppendGear( GB^.Meks, Mek ); +{$ELSE PATCH_GH} Mek^.Next := gb^.Meks; gb^.Meks := Mek; +{$ENDIF PATCH_GH} { Set default orders. } +{$IFDEF PATCH_GH} + if (NIL <> Team) and (GG_DisposeGear < Team^.G) then begin +{$ELSE PATCH_GH} if Team <> Nil then begin +{$ENDIF PATCH_GH} SetNAtt( Mek^.NA , NAG_EpisodeData , NAS_Orders , Team^.Stat[ STAT_TeamOrders ] ); end; end; @@ -623,6 +756,10 @@ Procedure DeployMek( GB: GameBoardPtr; M { PRECONDITION: Mek and Pilot are both unlinked gears. } begin if ( GB = Nil ) or ( Mek = Nil ) or ( Pilot = Nil ) then Exit; +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; + if (NIL = Pilot) or (Pilot^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} { Set the correct values for everything. } SetNAtt( mek^.NA , NAG_Location , NAS_Team , Team ); @@ -663,7 +800,11 @@ begin H := ( ComTime div AP_Hour ) mod 24; D := ComTime div AP_Day; +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('TIMESTRING'), BStr( D ), WideStr( H, 2 ), WideStr( M , 2 ), WideStr( S , 2 ) ); +{$ELSE PATCH_I18N} msg := Bstr( H ) + ':' + WideStr( M , 2 ) + ':' + WideStr( S , 2 ) + MsgString( 'CLOCK_days' ) + BStr( D ); +{$ENDIF PATCH_I18N} TimeString := msg; end; @@ -685,6 +826,9 @@ Procedure FocusOnMek( GB: GameBoardPtr; var P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if ( Mek <> Nil ) and ( GB <> Nil ) then begin P := GearCurrentLocation( Mek ); RecenterDisplay( P.X , P.Y ); @@ -706,6 +850,11 @@ const var P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = AnimList) or (AnimList^.G <= GG_DisposeGear) then Exit(False); + if (NIL = AnimOb) or (AnimOb^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Redraw the tile from last time. } P := SolveLine( AnimOb^.Stat[ X1 ] , AnimOb^.Stat[ Y1 ] , AnimOb^.Stat[ X2 ] , AnimOb^.Stat[ Y2 ] , AnimOb^.V ); RedrawTile( GB , P.X , P.Y ); @@ -713,6 +862,12 @@ begin { Increase the counter, and find the next spot. } Inc( AnimOb^.V ); P := SolveLine( AnimOb^.Stat[ X1 ] , AnimOb^.Stat[ Y1 ] , AnimOb^.Stat[ X2 ] , AnimOb^.Stat[ Y2 ] , AnimOb^.V ); +{$IFDEF PATCH_JPSSDL} + if SkipAnim and (AnimOb^.V > 1) then begin + P.X := AnimOb^.Stat[ X2 ]; + P.Y := AnimOb^.Stat[ Y2 ]; + end; +{$ENDIF PATCH_JPSSDL} { If this is the destination point, then we're done. } if ( P.X = AnimOb^.Stat[ X2 ] ) and ( P.Y = AnimOb^.Stat[ Y2 ] ) then begin @@ -723,6 +878,9 @@ begin end else begin {Display bullet...} DrawMapImage( '+' , P.X , p.Y , LightRed ); +{$IFDEF PATCH_JPSSDL} + if SkipAnim then DrawMapImage( '+' , AnimOb^.Stat[X2] , AnimOb^.Stat[Y2] , LightRed ); +{$ENDIF PATCH_JPSSDL} end; ProcessShotAnimation := OnTheScreen( P.X , P.Y ); @@ -746,6 +904,11 @@ var c: Byte; it: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = AnimList) or (AnimList^.G <= GG_DisposeGear) then Exit(False); + if (NIL = AnimOb) or (AnimOb^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if AnimOb^.V < 3 then begin case AnimOb^.S of GS_DamagingHit: begin @@ -777,6 +940,9 @@ begin { Increment the counter. } Inc( AnimOb^.V ); +{$IFDEF PATCH_JPSSDL} + if SkipAnim then AnimOb^.V := 10; +{$ENDIF PATCH_JPSSDL} it := OnTheScreen( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] ); end else begin @@ -804,7 +970,9 @@ begin while AnimOb <> Nil do begin A2 := AnimOb^.Next; - +{$IFDEF PATCH_GH} + if (GG_DisposeGear < AnimOb^.G) then begin +{$ENDIF PATCH_GH} { Call a routine based upon the type of } { animation requested. } case AnimOb^.S of @@ -823,13 +991,19 @@ begin end; DelayThisFrame := DelayThisFrame or PointDelay; - +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} { Move to the next animation. } AnimOb := A2; end; { Delay the animations, if appropriate. } +{$IFDEF GUIMSWINMODE} + if ( FrameDelay > 0 ) and DelayThisFrame then w32crt.Delay(FrameDelay); +{$ELSE GUIMSWINMODE} if ( FrameDelay > 0 ) and DelayThisFrame then Delay(FrameDelay); +{$ENDIF GUIMSWINMODE} end; end; @@ -879,18 +1053,37 @@ Procedure DisplayConsoleHistory( GB: Gam { Display the console history, then restore the display. } var SL: SAttPtr; +{$IFDEF PATCH_I18N} + MaxWidth: Integer; +{$ENDIF PATCH_I18N} begin MoreText( Console_History , MoreHighFirstLine( Console_History ) ); GFCombatDisplay( GB ); { Restore the console display. } +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenZone[ ZONE_Dialog , 1 ] , ScreenZone[ ZONE_Dialog , 2 ] -1 ); + w32crt.TextColor( Green ); +{$ELSE GUIMSWINMODE} GotoXY( ScreenZone[ ZONE_Dialog , 1 ] , ScreenZone[ ZONE_Dialog , 2 ] -1 ); TextColor( Green ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + MaxWidth := ScreenZone[ZONE_Dialog,3] - ScreenZone[ZONE_Dialog,1]; +{$ENDIF PATCH_I18N} SL := RetrieveSAtt( Console_History , NumSAtts( Console_History ) - ScreenRows + ScreenZone[ ZONE_Dialog , 2 ] ); if SL = Nil then SL := Console_History; while SL <> Nil do begin +{$IFDEF GUIMSWINMODE} + conoutput.ConWriteLn; +{$ELSE GUIMSWINMODE} writeln; +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr( SL^.Info, MaxWidth ); +{$ELSE PATCH_I18N} write( SL^.Info ); +{$ENDIF PATCH_I18N} SL := SL^.Next; end; end; @@ -903,6 +1096,10 @@ var X,Y: LongInt; msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Store the initial position of the mek. } X := NAttValue( Mek^.NA , NAG_Location , NAS_X ); Y := NAttValue( Mek^.NA , NAG_Location , NAS_Y ); @@ -920,7 +1117,11 @@ begin if OnTheMap( NAttValue( Mek^.NA , NAG_Location , NAS_X ) , NAttValue( Mek^.NA , NAG_Location , NAS_Y ) ) then VisionCheck( GB , Mek ) { Print message if mek has fled the battle. } else begin +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('ProcessMovement','Left'), PilotName(Mek)) ); +{$ELSE PATCH_I18N} DialogMSG( PilotName( Mek ) + ' has left this area.'); +{$ENDIF PATCH_I18N} { Set trigger here. } Team := NAttValue( Mek^.NA , NAG_Location , NAS_Team ); @@ -933,12 +1134,21 @@ begin RedrawTile( GB , X , Y ); RedrawTile( GB , Mek ); +{$IFDEF PATCH_I18N} + if Mek^.G = GG_Character then begin + msg := I18N_MsgString('ProcessMovement','Fall'); + end else begin + msg := I18N_MsgString('ProcessMovement','Crash'); + end; + DialogMsg( ReplaceHash( msg, GearName(Mek), BStr(DAMAGE_DamageDone) ) ); +{$ELSE PATCH_I18N} if Mek^.G = GG_Character then begin msg := ReplaceHash( MsgString( 'PROCESSMOVEMENT_Fall' ) , GearName( Mek ) ); end else begin msg := ReplaceHash( MsgString( 'PROCESSMOVEMENT_Crash' ) , GearName( Mek ) ); end; DialogMsg( ReplaceHash( msg , BStr( DAMAGE_DamageDone ) ) ); +{$ENDIF PATCH_I18N} end; end; @@ -956,6 +1166,18 @@ begin { Can't output the scene gear directly, since it'll be outputted } { with the rest of SOURCE later on. Output its reference number. } writeln( F , FindGearIndex( Camp^.Source , Camp^.GB^.Scene ) ); +{$IFDEF DEBUG} + ErrorMessage_fork( 'TRACE: WriteCampaign(): ' + + BStr(FindGearIndex( Camp^.Source , Camp^.GB^.Scene )) + + '/' + BStr(CountGearIndex( Camp^.Source, False, '' )) + + '/' + BStr(CountGearIndex( Camp^.Source, True, '' )) + + ': ' + Camp^.GB^.Scene^.SA^.info ); + DialogMsg( 'TRACE: WriteCampaign(): ' + + BStr(FindGearIndex( Camp^.Source , Camp^.GB^.Scene )) + + '/' + BStr(CountGearIndex( Camp^.Source, False, '' )) + + '/' + BStr(CountGearIndex( Camp^.Source, True, '' )) + + ': ' + Camp^.GB^.Scene^.SA^.info ); +{$ENDIF DEBUG} { Output map contents. } WriteCGears( F , Camp^.GB^.Meks ); @@ -983,6 +1205,9 @@ var SceneIndex: LongInt; N: Integer; Frz: FrozenLocationPtr; +{$IFDEF DEBUG} + msg: String; +{$ENDIF DEBUG} begin { Allocate the campaign and the gameboard. } Camp := NewCampaign; @@ -1013,7 +1238,21 @@ begin { Read the source, and set the gameboard's scene. } Camp^.Source := ReadCGears( F ); +{$IFDEF DEBUG} + Camp^.GB^.Scene := LocateGearByNumber( Camp^.Source , SceneIndex, False, 0, '' ); + msg := BStr(FindGearIndex( Camp^.Source , Camp^.GB^.Scene )); + msg := msg + '/' + BStr(CountGearIndex( Camp^.Source, False, '' )); + msg := msg + '/' + BStr(CountGearIndex( Camp^.Source, True, '' )); + if (NIL <> Camp^.GB^.Scene^.SA) then begin + msg := msg + ': ' + Camp^.GB^.Scene^.SA^.info; + end else begin + msg := msg + ': (NIL)'; + end; + ErrorMessage_fork( 'TRACE: ReadCampaign(): ' + msg ); + DialogMsg( 'TRACE: ReadCampaign(): ' + msg ); +{$ELSE DEBUG} Camp^.GB^.Scene := LocateGearByNumber( Camp^.Source , SceneIndex ); +{$ENDIF DEBUG} { Return the restored campaign structure. } ReadCampaign := Camp; @@ -1030,4 +1269,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: conmap.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: conmap.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/conmenus.pp branches/conmenus.pp --- GearHead1100repository.original/conmenus.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/conmenus.pp 2015-06-13 09:01:00.000000000 +0900 @@ -46,7 +46,11 @@ type RPGMenuItemPtr = ^RPGMenuItem; RPGMenuItem = Record msg: string; {The text which appears in the menu} +{$IFDEF PATCH_GH} + value: LongInt; {A value, returned by SelectMenu. -1 is reserved for Cancel} +{$ELSE PATCH_GH} value: integer; {A value, returned by SelectMenu. -1 is reserved for Cancel} +{$ENDIF PATCH_GH} desc: string; {Pointer to the item description. If Nil, no desc.} next: RPGMenuItemPtr; end; @@ -61,8 +65,19 @@ type end; RPGMenuPtr = ^RPGMenu; +{$IFDEF PATCH_GH} +Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: LongInt; desc: string): RPGMenuItemPtr; +Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: LongInt): RPGMenuItemPtr; +Function AddRPGMenuItem_Top(var RPM: RPGMenuPtr; const msg: string; value: LongInt; desc: string): RPGMenuItemPtr; +Function AddRPGMenuItem_Top(var RPM: RPGMenuPtr; const msg: string; value: LongInt): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: integer; desc: string): RPGMenuItemPtr; Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: integer): RPGMenuItemPtr; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} +Function PushRPGMenuItemFront( var RPM: RPGMenuPtr; msg: string; value: LongInt; desc: string ): RPGMenuItemPtr; +Function PushRPGMenuItemFront( var RPM: RPGMenuPtr; msg: string; value: LongInt ): RPGMenuItemPtr; +{$ENDIF PATCH_CHEAT} Procedure DisposeRPGMenuItem( var LList: RPGMenuItemPtr ); Procedure ClearMenu( RPM: RPGMenuPtr ); Procedure RemoveRPGMenuItem(RPM: RPGMenuPtr; var LMember: RPGMenuItemPtr); @@ -72,21 +87,73 @@ Function CreateRPGMenu(icolor,scolor,x1, Function CreateRPGMenu(icolor,scolor: byte; Z: Integer): RPGMenuPtr; Procedure AttachMenuDesc( RPM: RPGMenuPtr; Z: Integer ); +{$IFDEF PATCH_GH} +Procedure DisposeRPGMenu(var RPM_arg: RPGMenuPtr); +{$ELSE PATCH_GH} Procedure DisposeRPGMenu(var RPM: RPGMenuPtr); +{$ENDIF PATCH_GH} Procedure DisplayMenu(RPM: RPGMenuPtr); Function RPMLocateByPosition(RPM: RPGMenuPtr; i: integer): RPGMenuItemPtr; +{$IFDEF PATCH_GH} +Function SelectMenu( RPM: RPGMenuPtr ): LongInt; +{$ELSE PATCH_GH} Function SelectMenu( RPM: RPGMenuPtr ): integer; +{$ENDIF PATCH_GH} Procedure RPMSortAlpha(RPM: RPGMenuPtr); - +{$IFDEF PATCH_CHEAT} +Procedure RPMSortAlpha_withSubItem(RPM: RPGMenuPtr); +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_GH} +Function SetItemByValue( RPM: RPGMenuPtr ; V: LongInt ): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function SetItemByValue( RPM: RPGMenuPtr ; V: Integer ): RPGMenuItemPtr; +{$ENDIF PATCH_GH} Procedure SetItemByPosition( RPM: RPGMenuPtr ; N: Integer ); +{$IFDEF PATCH_GH} +Function BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String; N: Integer ): Integer; +Function BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String ): Integer; +{$ELSE PATCH_GH} Procedure BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String ); +{$ENDIF PATCH_GH} Function SelectFile( RPM: RPGMenuPtr ): String; implementation -uses crt,dos,congfx,context; +uses +{$IFDEF GUIMSWINMODE} +{$ELSE GUIMSWINMODE} + crt, +{$ENDIF GUIMSWINMODE} + dos, +{$IFDEF PATCH_GH} + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF GUIMSWINMODE} + w32crt,conoutput, +{$ELSE GUIMSWINMODE} +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + gears, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + ui4gh, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + texutil, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + menugear, +{$ENDIF PATCH_CHEAT} + congfx,context; Function LastMenuItem(MIList: RPGMenuItemPtr): RPGMenuItemPtr; {This procedure will find the last item in the linked list.} @@ -101,7 +168,11 @@ begin LastMenuItem := MIList; end; +{$IFDEF PATCH_GH} +Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: LongInt; desc: string): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: integer; desc: string): RPGMenuItemPtr; +{$ENDIF PATCH_GH} {This procedure will add an item to the RPGToolMenu.} {The new item will be added as the last item in the list.} var @@ -110,12 +181,23 @@ var begin {Allocate memory for it.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('AddRPGMenuItem() New',it); +{$ENDIF DEBUG} {Check to make sure that the allocation succeeded.} if it = Nil then begin {Oops... something went wrong. Better let the user know.} +{$IFDEF PATCH_GH} + ErrorMessage('Error: Popcorn Delta. AddRPGMenuItem messsed up.'); +{$ELSE PATCH_GH} writeln('Error: Popcorn Delta. AddRPGMenuItem messsed up.'); +{$ENDIF PATCH_GH} +{$IFDEF GUIMSWINMODE} + w32crt.readkey; +{$ELSE GUIMSWINMODE} readkey; +{$ENDIF GUIMSWINMODE} exit; end; @@ -142,12 +224,120 @@ begin AddRPGMenuItem := it; end; +{$IFDEF PATCH_GH} +Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: LongInt): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: integer): RPGMenuItemPtr; +{$ENDIF PATCH_GH} { Just like the above, but no desc. } begin AddRPGMenuItem := AddRPGMenuItem( RPM , msg , value , '' ); end; +{$IFDEF PATCH_GH} +Function AddRPGMenuItem_Top(var RPM: RPGMenuPtr; const msg: string; value: LongInt; desc: string): RPGMenuItemPtr; + {This procedure will add an item to the RPGToolMenu.} + {The new item will be added as the last item in the list.} +var + it: ^RPGMenuItem; {Here's a pointer for the item we're creating.} + temp: RPGMenuItemPtr; +begin + {Allocate memory for it.} + New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('AddRPGMenuItem_Top() New',it); +{$ENDIF DEBUG} + + {Check to make sure that the allocation succeeded.} + if it = Nil then begin + {Oops... something went wrong. Better let the user know.} + ErrorMessage('Error: Popcorn Delta. AddRPGMenuItem_Top messsed up.'); +{$IFDEF GUIMSWINMODE} + w32crt.readkey; +{$ELSE GUIMSWINMODE} + readkey; +{$ENDIF GUIMSWINMODE} + exit; + end; + + {Initialize it to the correct values.} + it^.msg := msg; + it^.value := value; + it^.next := Nil; + it^.desc := desc; {The desc field is assigned the value of PChar since it} + {is assumed that we arent responsible for the allocation,} + {disposal, or contents of this string.} + + it^.next := RPM^.firstitem; + RPM^.firstitem := it; + + {Increment the NumItem field.} + Inc(RPM^.numitem); + + AddRPGMenuItem_Top := it; +end; + +Function AddRPGMenuItem_Top(var RPM: RPGMenuPtr; const msg: string; value: LongInt): RPGMenuItemPtr; + { Just like the above, but no desc. } +begin + AddRPGMenuItem_Top := AddRPGMenuItem_Top( RPM , msg , value , '' ); +end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} +Function PushRPGMenuItemFront( var RPM: RPGMenuPtr; msg: string; value: LongInt; desc: string ): RPGMenuItemPtr; +var + it: ^RPGMenuItem; {Here's a pointer for the item we're creating.} + temp: RPGMenuItemPtr; +begin + {Allocate memory for it.} + New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('PushRPGMenuItemFront() New',it); +{$ENDIF DEBUG} + + {Check to make sure that the allocation succeeded.} + if it = Nil then begin + {Oops... something went wrong. Better let the user know.} + {$IFDEF PATCH_GH} + ErrorMessage('Error: Popcorn Delta. AddRPGMenuItem messsed up.'); + {$ELSE PATCH_GH} + writeln('Error: Popcorn Delta. AddRPGMenuItem messsed up.'); + {$ENDIF PATCH_GH} + {$IFDEF GUIMSWINMODE} + w32crt.readkey; + {$ELSE GUIMSWINMODE} + { readkey; } + {$ENDIF GUIMSWINMODE} + exit; + end; + + {Initialize it to the correct values.} + it^.msg := msg; + it^.value := value; + it^.next := Nil; + it^.desc := desc; {The desc field is assigned the value of PChar since it} + {is assumed that we arent responsible for the allocation,} + {disposal, or contents of this string.} + + {Locate the last item in the list, then assign "it" to it.} + {If the list is currently empty, stick "it" in as the first item.} + temp := RPM^.firstitem; + it^.next := temp; + RPM^.firstitem := it; + + {Increment the NumItem field.} + Inc(RPM^.numitem); + + PushRPGMenuItemFront := it; +end; + +Function PushRPGMenuItemFront( var RPM: RPGMenuPtr; msg:string; value: LongInt ): RPGMenuItemPtr; +begin + PushRPGMenuItemFront := PushRPGMenuItemFront( RPM, msg, value, '' ); +end; +{$ENDIF PATCH_CHEAT} + Procedure DisposeRPGMenuItem( var LList: RPGMenuItemPtr ); { Get rid of this list of items. } { WARNING - If you call this procedure for a menu, it will not } @@ -159,6 +349,18 @@ var begin while LList <> Nil do begin NextItem := LList^.Next; +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeRPGMenuItem() Dispose',LList); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('DisposeRPGMenuItem() Dispose',LList,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.msg[1] := '@'; + LList^.value := -32767; + LList^.desc[1] := '@'; + LList^.Next := RPGMenuItemPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose( LList ); LList := NextItem; end; @@ -195,18 +397,46 @@ begin if B = Nil then begin {Major FUBAR. The member we were trying to remove can't} {be found in the list.} +{$IFDEF PATCH_GH} + ErrorMessage('ERROR- RemoveLink asked to remove a link that doesnt exist.'); +{$ELSE PATCH_GH} writeln('ERROR- RemoveLink asked to remove a link that doesnt exist.'); +{$ENDIF PATCH_GH} end else if A = Nil then begin {There's no element before the one we want to remove,} {i.e. it's the first one in the list.} RPM^.FirstItem := B^.Next; +{$IFDEF DEBUG} + Trace_MemoryLeak('RemoveRPGMenuItem() Dispose',B); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('RemoveRPGMenuItem() Dispose',B,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + B^.msg[1] := '@'; + B^.value := -32767; + B^.desc[1] := '@'; + B^.Next := RPGMenuItemPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(B); end else begin {We found the attribute we want to delete and have another} {one standing before it in line. Go to work.} A^.next := B^.next; +{$IFDEF DEBUG} + Trace_MemoryLeak('RemoveRPGMenuItem() Dispose',B); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('RemoveRPGMenuItem() Dispose',B,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + B^.msg[1] := '@'; + B^.value := -32767; + B^.desc[1] := '@'; + B^.Next := RPGMenuItemPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(B); end; @@ -220,8 +450,15 @@ var it: RPGMenuKeyPtr; begin New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('AddRPGMenuKey() New',it); +{$ENDIF DEBUG} if it = Nil then begin +{$IFDEF PATCH_GH} + ErrorMessage('ERROR- AddRPGMenuKey failed on memory allocation. Buy some RAM.'); +{$ELSE PATCH_GH} writeln('ERROR- AddRPGMenuKey failed on memory allocation. Buy some RAM.'); +{$ENDIF PATCH_GH} exit; end; @@ -239,12 +476,23 @@ var begin {Allocate memory for it.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('CreateRPGMenu() New',it); +{$ENDIF DEBUG} {Check to make sure that we've actually initialized something.} if it = Nil then begin {Oops... something went wrong. Better let the user know.} +{$IFDEF PATCH_GH} + ErrorMessage('Error: Popaboner Overflow. CreateRPGMenu messsed up. I make no promises.'); +{$ELSE PATCH_GH} writeln('Error: Popaboner Overflow. CreateRPGMenu messsed up. I make no promises.'); +{$ENDIF PATCH_GH} +{$IFDEF GUIMSWINMODE} + w32crt.readkey; +{$ELSE GUIMSWINMODE} readkey; +{$ENDIF GUIMSWINMODE} exit; end; @@ -291,29 +539,78 @@ begin RPM^.dy2 := ScreenZone[ Z , 4 ]; end; +{$IFDEF PATCH_GH} +Procedure DisposeRPGMenu(var RPM_arg: RPGMenuPtr); +{$ELSE PATCH_GH} Procedure DisposeRPGMenu(var RPM: RPGMenuPtr); +{$ENDIF PATCH_GH} {This procedure is called when you want to get rid of the menu. It will deallocate} {the memory for the RPGMenu record and also for all of the linked RPGMenuItems.} var +{$IFDEF PATCH_GH} + RPM: RPGMenuPtr; +{$ENDIF PATCH_GH} c,d: RPGMenuKeyPtr; begin +{$IFDEF PATCH_GH} + RPM := RPM_arg; +{$ENDIF PATCH_GH} {Check to make sure that we've got a valid pointer here.} if RPM = Nil then begin +{$IFDEF PATCH_GH} + ErrorMessage('ERROR: Joe is a Doofus. DisposeRPGMenu has been passed a null pointer.'); +{$ELSE PATCH_GH} writeln('ERROR: Joe is a Doofus. DisposeRPGMenu has been passed a null pointer.'); +{$ENDIF PATCH_GH} +{$IFDEF GUIMSWINMODE} + w32crt.readkey; +{$ELSE GUIMSWINMODE} readkey; +{$ENDIF GUIMSWINMODE} exit; end; +{$IFDEF PATCH_GH} + RPM_arg := NIL; +{$ENDIF PATCH_GH} {Save the location of the first menu item...} DisposeRPGMenuItem( RPM^.FirstItem ); c := RPM^.FirstKey; {... then get rid of the menu record.} +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeRPGMenu() Dispose',RPM); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('DisposeRPGMenu() Dispose',RPM,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + RPM^.ItemColor := 126; + RPM^.SelColor := 126; + RPM^.DtexColor := 126; + RPM^.mode := 126; + RPM^.TopItem := -32767; + RPM^.SelectItem := -32767; + RPM^.NumItem := -32767; + RPM^.FirstItem := RPGMenuItemPtr(-1); + RPM^.FirstKey := RPGMenuKeyPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(RPM); RPM := Nil; {Keep processing the menu items until we hit a Nil nextitem.} while c <> Nil do begin d := c^.next; +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeRPGMenu() Dispose',c); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('DisposeRPGMenu() Dispose',c,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + c^.k := #126; + c^.value := -32767; + c^.Next := RPGMenuKeyPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(c); c := d; end; @@ -327,8 +624,16 @@ var begin {Error check, first off.} if i > RPM^.numitem then begin +{$IFDEF PATCH_GH} + ErrorMessage('ERROR: RPMLocateByPosition asked to find a message that doesnt exist.'); +{$ELSE PATCH_GH} writeln('ERROR: RPMLocateByPosition asked to find a message that doesnt exist.'); +{$ENDIF PATCH_GH} +{$IFDEF GUIMSWINMODE} + w32crt.readkey; +{$ELSE GUIMSWINMODE} readkey; +{$ENDIF GUIMSWINMODE} exit; end; @@ -343,12 +648,32 @@ begin RPMLocateByPosition := a; end; +{$IFDEF PATCH_GH} +Function MenuWidth( RPM: RPGMenuPtr ): Integer; + { Return the height of the menu, in text rows. } +var + MW: Integer; +begin + MW := RPM^.X2 - RPM^.X1 + 1; + if Show_MenuScrollbar then begin + Dec( MW ); + end; + if MW < 1 then MW := 1; + MenuWidth := MW; +end; +{$ENDIF PATCH_GH} + Function MenuHeight( RPM: RPGMenuPtr ): Integer; { Return the height of the menu, in text rows. } var MH: Integer; begin MH := RPM^.Y2 - RPM^.Y1 + 1; +{$IFDEF PATCH_GH} + if Show_MenuPage then begin + Dec( MH ); + end; +{$ENDIF PATCH_GH} if MH < 1 then MH := 1; MenuHeight := MH; end; @@ -356,7 +681,11 @@ end; Procedure SetMenuClipZone( RPM: RPGMenuPtr ); { Set the clip area for this menu. } begin +{$IFDEF GUIMSWINMODE} + w32crt.Window(RPM^.X1,RPM^.Y1,RPM^.X2,RPM^.Y2); +{$ELSE GUIMSWINMODE} Window(RPM^.X1,RPM^.Y1,RPM^.X2,RPM^.Y2); +{$ENDIF GUIMSWINMODE} end; Procedure RPMRefreshDesc(RPM: RPGMenuPtr); @@ -370,23 +699,58 @@ end; Procedure DisplayMenu(RPM: RPGMenuPtr); {Display the menu on the screen.} +{$IFDEF PATCH_GH} +const + MoreMark: String = '*'; + CurrentPageMark: String = '-'; +{$ENDIF PATCH_GH} var topitem: RPGMenuItemPtr; a: RPGMenuItemPtr; {A pointer to be used while printing.} t: integer; width,height: integer; {The width of the menu display.} +{$IFDEF PATCH_I18N} + maxwidth, trimedlength: integer; +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + MenuItemStr: String; + LastItem: Integer; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + Y: Integer; +{$ENDIF PATCH_GH} begin {Error check- make sure the menu has items in it.} if RPM^.FirstItem = Nil then Exit; +{$IFDEF PATCH_GH} + if RPM^.NumItem < RPM^.SelectItem then begin + RPM^.SelectItem := RPM^.NumItem; + end else if RPM^.SelectItem < 1 then begin + RPM^.SelectItem := 1; + end; + if RPM^.NumItem < RPM^.TopItem then begin + RPM^.TopItem := RPM^.NumItem; + end else if RPM^.TopItem < 1 then begin + RPM^.TopItem := 1; + end; +{$ENDIF PATCH_GH} {Display each menu item.} {Open an appropriately sized window and clear that area.} SetMenuClipZone( RPM ); +{$IFDEF GUIMSWINMODE} + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} ClrScr; +{$ENDIF GUIMSWINMODE} {Calculate the width and the height of the menu.} +{$IFDEF PATCH_GH} + width := MenuWidth( RPM ); +{$ELSE PATCH_GH} width := RPM^.X2 - RPM^.X1 + 1; +{$ENDIF PATCH_GH} height := MenuHeight( rpm ); {Locate the top of the menu.} @@ -395,18 +759,67 @@ begin a := topitem; for t := 1 to Height do begin {If we're at the currently selected item, highlight it.} +{$IFDEF GUIMSWINMODE} + if ((t + RPM^.topitem - 1) = RPM^.selectitem) and RPM^.Active then + w32crt.TextColor(RPM^.selcolor) + else + w32crt.TextColor(RPM^.itemcolor); + + w32crt.GotoXY(1,t); +{$ELSE GUIMSWINMODE} if ((t + RPM^.topitem - 1) = RPM^.selectitem) and RPM^.Active then TextColor(RPM^.selcolor) else TextColor(RPM^.itemcolor); GotoXY(1,t); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + maxwidth := width; + if T = Height then maxwidth := (width - 1); + trimedlength := MBCharTrimedLength( a^.msg, maxwidth ); + if (0 < trimedlength) then begin + if (1 < Length(a^.msg)) and (#$0 = a^.msg[1]) then begin + WriteMBCharStr(Copy(a^.msg,2,trimedlength), maxwidth ); + end else begin + WriteMBCharStr(Copy(a^.msg,1,trimedlength), maxwidth ); + end; + end; +{$ELSE PATCH_I18N} if T = Height then begin write(Copy(a^.msg,1,width - 1)); end else begin write(Copy(a^.msg,1,width)); end; +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_GH} + if Show_MenuScrollbar then begin + if (1 = t) and (1 < RPM^.topitem) then begin + {$IFDEF GUIMSWINMODE} + w32crt.TextColor(RPM^.selcolor); + w32crt.GotoXY(width+1,t); + conoutput.ConWrite(MoreMark); + {$ELSE GUIMSWINMODE} + TextColor(RPM^.selcolor); + GotoXY(width,t); + Write(MoreMark); + {$ENDIF GUIMSWINMODE} + end; + if (Height = t) and ((RPM^.topitem + Height - 1) < RPM^.numitem) then begin + {$IFDEF GUIMSWINMODE} + w32crt.TextColor(RPM^.selcolor); + w32crt.GotoXY(width+1,t); + conoutput.ConWrite(MoreMark); + {$ELSE GUIMSWINMODE} + TextColor(RPM^.selcolor); + GotoXY(width,t); + Write(MoreMark); + {$ENDIF GUIMSWINMODE} + end; + end; +{$ENDIF PATCH_GH} a := a^.next; @@ -415,6 +828,49 @@ begin break; end; +{$IFDEF PATCH_GH} + if Show_MenuScrollbar and (Height < RPM^.numitem) then begin + Y := (((RPM^.topitem + Height div 2 - 1) * (Height - 2)) div RPM^.numitem) + 1 + 1; + if ( RPM^.topitem <= 1 ) then begin + Y := 2; + end else if ( RPM^.numitem <= (RPM^.topitem + Height - 1) ) then begin + Y := Height - 1; + end; + {$IFDEF GUIMSWINMODE} + w32crt.TextColor(RPM^.selcolor); + w32crt.GotoXY(width+1,Y); + conoutput.ConWrite(CurrentPageMark); + {$ELSE GUIMSWINMODE} + TextColor(RPM^.selcolor); + GotoXY(width,Y); + Write(CurrentPageMark); + {$ENDIF GUIMSWINMODE} + end; + if Show_MenuPage then begin + LastItem := RPM^.topitem + Height - 1; + if RPM^.numitem < LastItem then begin + LastItem := RPM^.numitem; + end; + MenuItemStr := '(' + BStr(RPM^.topitem) + '-' + BStr(LastItem) + '/' + BStr(RPM^.numitem) + ')'; + {$IFDEF GUIMSWINMODE} + w32crt.TextColor(RPM^.itemcolor); + w32crt.GotoXY(1,Height+1); + {$ELSE GUIMSWINMODE} + TextColor(RPM^.itemcolor); + GotoXY(1,Height+1); + {$ENDIF GUIMSWINMODE} + {$IFDEF PATCH_I18N} + maxwidth := width - 1; + trimedlength := MBCharTrimedLength( MenuItemStr, maxwidth ); + if (0 < trimedlength) then begin + WriteMBCharStr(Copy(MenuItemStr,1,trimedlength), maxwidth ); + end; + {$ELSE PATCH_I18N} + write(Copy(MenuItemStr,1,width - 1)); + {$ENDIF PATCH_I18N} + end; +{$ENDIF PATCH_GH} + {Restore the window to its regular size.} MaxCLipZone; @@ -455,29 +911,88 @@ begin end; +{$IFDEF PATCH_GH} +Procedure RPMReposition_center( RPM: RPGMenuPtr ); +begin + { Check a limit. } + if (RPM^.selectitem < 1) then begin + RPM^.selectitem := 1 + end else if (RPM^.numitem < RPM^.selectitem) then begin + RPM^.selectitem := RPM^.numitem + end; + + { Auto reposition mode. } + if (RPM^.topitem < 1) then begin + RPM^.topitem := RPM^.selectitem - ( MenuHeight(RPM) div 2 ); + if (RPM^.topitem < 1) then begin + RPM^.topitem := 1; + end; + end else if (RPM^.numitem < RPM^.topitem) then begin + RPM^.topitem := RPM^.selectitem - MenuHeight(RPM) + 1; + if (RPM^.topitem < 1) then begin + RPM^.topitem := 1; + end; + end else if (RPM^.selectitem < RPM^.topitem) then begin + RPM^.topitem := RPM^.selectitem - MenuHeight(RPM) + 1; + if RPM^.topitem < 1 then begin + RPM^.topitem := 1; + end; + end else if (RPM^.topitem + MenuHeight(RPM) <= RPM^.selectitem) then begin + RPM^.topitem := RPM^.selectitem; + if RPM^.numitem < RPM^.topitem then begin + RPM^.topitem := RPM^.numitem; + end; + end; + +end; +{$ENDIF PATCH_GH} + Procedure RPMUpKey(RPM: RPGMenuPtr); {Someone just pressed the UP key, and we're gonna process that input.} {PRECONDITIONS: RPM has been initialized properly, and is currently being} { displayed on the screen.} var width: integer; {The width of the menu window} +{$IFDEF PATCH_I18N} + maxwidth, trimedlength: integer; +{$ENDIF PATCH_I18N} begin {Lets set up the window.} SetMenuClipZone( RPM ); {Calculate the width of the menu.} +{$IFDEF PATCH_GH} + width := MenuWidth( RPM ); +{$ELSE PATCH_GH} width := RPM^.X2 - RPM^.X1 + 1; +{$ENDIF PATCH_GH} {De-indicate the old selected item.} +{$IFDEF GUIMSWINMODE} + {Change color to the regular item color...} + w32crt.TextColor(RPM^.itemcolor); + {Then reprint the text of the previously selected item.} + w32crt.GotoXY(1,RPM^.selectitem - RPM^.topitem + 1); +{$ELSE GUIMSWINMODE} {Change color to the regular item color...} TextColor(RPM^.itemcolor); {Then reprint the text of the previously selected item.} GotoXY(1,RPM^.selectitem - RPM^.topitem + 1); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + maxwidth := width; + if ( RPM^.selectitem - RPM^.topitem + 1 ) = MenuHeight( RPM ) then maxwidth := (width - 1); + trimedlength := MBCharTrimedLength( RPMLocateByPosition(RPM,RPM^.selectitem)^.msg, maxwidth ); + if (0 < trimedlength) then begin + WriteMBCharStr(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,trimedlength), maxwidth ); + end; +{$ELSE PATCH_I18N} if ( RPM^.selectitem - RPM^.topitem + 1 ) = MenuHeight( RPM ) then begin write(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,width - 1)); end else begin write(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,width)); end; +{$ENDIF PATCH_I18N} {Decrement the selected item by one.} Dec(RPM^.selectitem); @@ -496,13 +1011,27 @@ begin end else begin +{$IFDEF GUIMSWINMODE} + w32crt.TextColor(RPM^.selcolor); + w32crt.GotoXY(1,RPM^.selectitem - RPM^.topitem + 1); +{$ELSE GUIMSWINMODE} TextColor(RPM^.selcolor); GotoXY(1,RPM^.selectitem - RPM^.topitem + 1); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + maxwidth := width; + if ( RPM^.selectitem - RPM^.topitem + 1 ) = MenuHeight( RPM ) then maxwidth := (width - 1); + trimedlength := MBCharTrimedLength( RPMLocateByPosition(RPM,RPM^.selectitem)^.msg, maxwidth ); + if (0 < trimedlength) then begin + WriteMBCharStr(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,trimedlength), maxwidth ); + end; +{$ELSE PATCH_I18N} if ( RPM^.selectitem - RPM^.topitem + 1 ) = MenuHeight( RPM ) then begin write(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,width-1)); end else begin write(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,width)); end; +{$ENDIF PATCH_I18N} MaxClipZone; @@ -520,22 +1049,43 @@ Procedure RPMDownKey(RPM: RPGMenuPtr); { displayed on the screen.} var width: integer; {The width of the menu window} +{$IFDEF PATCH_I18N} + maxwidth, trimedlength: integer; +{$ENDIF PATCH_I18N} begin {Lets set up the window.} SetMenuClipZone( RPM ); {Calculate the width of the menu.} +{$IFDEF PATCH_GH} + width := MenuWidth( RPM ); +{$ELSE PATCH_GH} width := RPM^.X2 - RPM^.X1 + 1; +{$ENDIF PATCH_GH} {De-indicate the item.} {Change color to the normal text color, then reprint the item's message.} +{$IFDEF GUIMSWINMODE} + w32crt.TextColor(RPM^.itemcolor); + w32crt.GotoXY(1,RPM^.selectitem - RPM^.topitem + 1); +{$ELSE GUIMSWINMODE} TextColor(RPM^.itemcolor); GotoXY(1,RPM^.selectitem - RPM^.topitem + 1); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + maxwidth := width; + if ( RPM^.selectitem - RPM^.topitem + 1 ) = MenuHeight( RPM ) then maxwidth := (width - 1); + trimedlength := MBCharTrimedLength( RPMLocateByPosition(RPM,RPM^.selectitem)^.msg, maxwidth ); + if (0 < trimedlength) then begin + WriteMBCharStr(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,trimedlength), maxwidth ); + end; +{$ELSE PATCH_I18N} if ( RPM^.selectitem - RPM^.topitem + 1 ) = MenuHeight( RPM ) then begin write(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,width - 1)); end else begin write(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,width)); end; +{$ENDIF PATCH_I18N} {Increment the selected item.} Inc(RPM^.selectitem); @@ -554,13 +1104,27 @@ begin end else begin +{$IFDEF GUIMSWINMODE} + w32crt.TextColor(RPM^.selcolor); + w32crt.GotoXY(1,RPM^.selectitem - RPM^.topitem + 1); +{$ELSE GUIMSWINMODE} TextColor(RPM^.selcolor); GotoXY(1,RPM^.selectitem - RPM^.topitem + 1); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + maxwidth := width; + if ( RPM^.selectitem - RPM^.topitem + 1 ) = MenuHeight( RPM ) then maxwidth := (width - 1); + trimedlength := MBCharTrimedLength( RPMLocateByPosition(RPM,RPM^.selectitem)^.msg, maxwidth ); + if (0 < trimedlength) then begin + WriteMBCharStr(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,trimedlength), maxwidth ); + end; +{$ELSE PATCH_I18N} if ( RPM^.selectitem - RPM^.topitem + 1 ) = MenuHeight( RPM ) then begin write(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,width-1)); end else begin write(Copy(RPMLocateByPosition(RPM,RPM^.selectitem)^.msg,1,width)); end; +{$ENDIF PATCH_I18N} {Restore the window to its regular size.} MaxClipZone; @@ -573,16 +1137,89 @@ begin end; +{$IFDEF PATCH_GH} +Procedure RPMPgUpKey(RPM: RPGMenuPtr); +begin + RPM^.selectitem := RPM^.selectitem - MenuHeight( RPM ); + if RPM^.selectitem < 1 then + RPM^.selectitem := 1; + + while RPM^.selectitem < RPM^.topitem do begin + RPM^.topitem := RPM^.topitem - MenuHeight( RPM ); + if RPM^.topitem < 1 then begin + RPM^.topitem := 1; + break; + end; + end; + + DisplayMenu(RPM); +end; + +Procedure RPMPgDownKey(RPM: RPGMenuPtr); +begin + RPM^.selectitem := RPM^.selectitem + MenuHeight( RPM ); + if RPM^.selectitem > RPM^.numitem then + RPM^.selectitem := RPM^.numitem; + + while RPM^.selectitem >= (RPM^.topitem + MenuHeight(RPM)) do begin + RPM^.topitem := RPM^.topitem + MenuHeight( RPM ); + if RPM^.topitem > RPM^.numitem then begin + RPM^.topitem := RPM^.numitem; + break; + end; + end; + + DisplayMenu(RPM); +end; + +Procedure RPMScrollUpKey(RPM: RPGMenuPtr); +begin + Dec(RPM^.selectitem); + if RPM^.selectitem < 1 then + RPM^.selectitem := 1; + Dec(RPM^.topitem); + if RPM^.topitem < 1 then + RPM^.topitem := 1; + DisplayMenu(RPM); +end; + +Procedure RPMScrollDownKey(RPM: RPGMenuPtr); +begin + Inc(RPM^.selectitem); + if RPM^.numitem < RPM^.selectitem then + RPM^.selectitem := RPM^.numitem; + Inc(RPM^.topitem); + if (RPM^.numitem > MenuHeight( RPM )) then begin + if RPM^.topitem > (RPM^.numitem - MenuHeight( RPM ) + 1) then RPM^.topitem := RPM^.numitem - MenuHeight( RPM ) + 1; + end else RPM^.topitem := 1; + + DisplayMenu(RPM); +end; +{$ENDIF PATCH_GH} + + +{$IFDEF PATCH_GH} +Function SelectMenu(RPM: RPGMenuPtr): LongInt; +{$ELSE PATCH_GH} Function SelectMenu(RPM: RPGMenuPtr): integer; +{$ENDIF PATCH_GH} {This function will allow the user to browse through the menu and will} {return a value based upon the user's selection.} var getit: char; {Character used to store user input} +{$IFDEF PATCH_GH} + r: LongInt; {The value we'll be sending back.} +{$ELSE PATCH_GH} r: integer; {The value we'll be sending back.} +{$ENDIF PATCH_GH} m: RPGMenuKeyPtr; UK: Boolean; {Has a special MenuKey been pressed?} begin +{$IFDEF PATCH_GH} + RPMReposition_center( RPM ); +{$ENDIF PATCH_GH} + {The menu is now active!} RPM^.Active := True; @@ -593,7 +1230,11 @@ begin UK := False; { Flush the buffer to prevent deviant keystrings. } +{$IFDEF GUIMSWINMODE} + while w32crt.keypressed do w32crt.readkey; +{$ELSE GUIMSWINMODE} while keypressed do readkey; +{$ENDIF GUIMSWINMODE} {Start the loop. Remain in this loop until either the player makes a selection} {or cancels the menu using the ESC key.} @@ -601,6 +1242,114 @@ begin {Read the input from the keyboard.} getit := RPGKey; +{$IFDEF PATCH_GH} + if getit = KeyMap[ KMC_MenuUp ].KCode then begin + getit := RPK_Up; + end else if getit = KeyMap[ KMC_MenuDown ].KCode then begin + getit := RPK_Down; + end else if getit = KeyMap[ KMC_PageUp ].KCode then begin + getit := RPK_UpRight; + end else if getit = KeyMap[ KMC_PageDown ].KCode then begin + getit := RPK_DownRight; + end else if getit = KeyMap[ KMC_ScrollUp ].KCode then begin + getit := RPK_UpLeft; + end else if getit = KeyMap[ KMC_ScrollDown ].KCode then begin + getit := RPK_DownLeft; + end; + if SelectMenu_UpDown_by_MouseWheel_UD_Reverse then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_Down; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_Up; + end; + end else if SelectMenu_UpDown_by_MouseWheel_UD then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_Up; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_Down; + end; + end; + if SelectMenu_UpDown_by_MouseWheel_LR_Reverse then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_Down; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_Up; + end; + end else if SelectMenu_UpDown_by_MouseWheel_LR then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_Up; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_Down; + end; + end; + if SelectMenu_Scroll_by_MouseWheel_UD_Reverse then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_DownLeft; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_UpLeft; + end; + end else if SelectMenu_Scroll_by_MouseWheel_UD then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_UpLeft; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_DownLeft; + end; + end; + if SelectMenu_Scroll_by_MouseWheel_LR_Reverse then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_DownLeft; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_UpLeft; + end; + end else if SelectMenu_Scroll_by_MouseWheel_LR then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_UpLeft; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_DownLeft; + end; + end; + if SelectMenu_ScrollPage_by_MouseWheel_UD_Reverse then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_DownRight; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_UpRight; + end; + end else if SelectMenu_ScrollPage_by_MouseWheel_UD then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_UpRight; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_DownRight; + end; + end; + if SelectMenu_ScrollPage_by_MouseWheel_LR_Reverse then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_DownRight; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_UpRight; + end; + end else if SelectMenu_ScrollPage_by_MouseWheel_LR then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_UpRight; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_DownRight; + end; + end; + + {Certain keys need processing- if so, process them.} + case getit of + {Selection Movement Keys} + RPK_Up: begin RPMUpKey(RPM); getit := #0; end; + RPK_Down: begin RPMDownKey(RPM); getit := #0; end; + RPK_UpRight: begin RPMPgUpKey(RPM); getit := #0; end; + RPK_DownRight: begin RPMPgDownKey(RPM); getit := #0; end; + RPK_UpLeft: begin RPMScrollUpKey(RPM); getit := #0; end; + RPK_DownLeft: begin RPMScrollDownKey(RPM); getit := #0; end; + + {If we receive an ESC, better check to make sure we're in a} + {cancelable menu. If not, convert the ESC to an unused key.} + #27: If RPM^.Mode = RPMNoCancel then getit := 'Q'; + end; +{$ELSE PATCH_GH} {Certain keys need processing- if so, process them.} case getit of {Selection Movement Keys} @@ -611,6 +1360,7 @@ begin {cancelable menu. If not, convert the ESC to an unused key.} #27: If RPM^.Mode = RPMNoCancel then getit := 'Q'; end; +{$ENDIF PATCH_GH} {Check to see if a special MENU KEY has been pressed.} if RPM^.FirstKey <> Nil then begin @@ -645,12 +1395,21 @@ begin {ClrScr in this language doesn't take paramters. Bummer.} SetMenuClipZone( RPM ); +{$IFDEF GUIMSWINMODE} + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} ClrScr; +{$ENDIF GUIMSWINMODE} {If there's an associated description box, clear that too.} if RPM^.dx1 > 0 then begin +{$IFDEF GUIMSWINMODE} + w32crt.Window(RPM^.DX1,RPM^.DY1,RPM^.DX2,RPM^.DY2); + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} Window(RPM^.DX1,RPM^.DY1,RPM^.DX2,RPM^.DY2); ClrScr; +{$ENDIF GUIMSWINMODE} end; end; @@ -719,7 +1478,69 @@ begin RPM^.firstitem := Sorted; end; +{$IFDEF PATCH_CHEAT} +Procedure RPMSortAlpha_withSubItem(RPM: RPGMenuPtr); +var + Sorted: RPGMenuItemPtr; + NextBranches: RPGMenuItemPtr; + CurrentBranch_Top, CurrentBranch_Bottom: RPGMenuItemPtr; + TmpBranch_Top, TmpBranch_Bottom: RPGMenuItemPtr; + TmpNextBranches: RPGMenuItemPtr; + youshouldstop: Boolean; {Can you think of a better name?} +begin + NextBranches := RPM^.firstitem; + Sorted := NIL; + + while NextBranches <> NIL do begin + { Take a current branch to 'CurrentBranch_Top' and 'CurrentBranch_Bottom', } + { and get the top of next branches to 'NextBranches'. } + CurrentBranch_Top := NextBranches; + CurrentBranch_Bottom := CurrentBranch_Top; + while (NIL <> CurrentBranch_Bottom^.next) and (#$0 = CurrentBranch_Bottom^.next^.msg[1]) do begin + CurrentBranch_Bottom := CurrentBranch_Bottom^.next; + end; + NextBranches := CurrentBranch_Bottom^.next; + CurrentBranch_Bottom^.next := NIL; + + { Locate the correct position in Sorted to store 'CurrentBranch_Top'. } + if Sorted = NIL then begin + Sorted := CurrentBranch_Top; + end else if CurrentBranch_Top^.msg < Sorted^.msg then begin + { CurrentBranch_Top/CurrentBranch_Bottom should be the first element in the list. } + TmpNextBranches := Sorted; + Sorted := CurrentBranch_Top; + CurrentBranch_Bottom^.next := TmpNextBranches; + end else begin + { Locate the last item lower than CurrentBranch_Top. } + TmpNextBranches := Sorted; + youshouldstop := false; + repeat + TmpBranch_Top := TmpNextBranches; + TmpBranch_Bottom := TmpBranch_Top; + while (NIL <> TmpBranch_Bottom^.next) and (#$0 = TmpBranch_Bottom^.next^.msg[1]) do begin + TmpBranch_Bottom := TmpBranch_Bottom^.next; + end; + TmpNextBranches := TmpBranch_Bottom^.next; + + if TmpNextBranches = NIL then + youshouldstop := true + else if CurrentBranch_Top^.msg < TmpNextBranches^.msg then begin + youshouldstop := true; + end; + until youshouldstop; + CurrentBranch_Bottom^.next := TmpNextBranches; + TmpBranch_Bottom^.next := CurrentBranch_Top; + end; + end; + RPM^.firstitem := Sorted; +end; +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_GH} +Function SetItemByValue( RPM: RPGMenuPtr ; V: LongInt ): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function SetItemByValue( RPM: RPGMenuPtr ; V: Integer ): RPGMenuItemPtr; +{$ENDIF PATCH_GH} { Search through the list, and set the SelectItem } { field to the first menu item which matches V. } var @@ -754,6 +1575,24 @@ Procedure SetItemByPosition( RPM: RPGMen begin if RPM = Nil then exit; +{$IFDEF PATCH_GH} + if RPM^.NumItem < N then begin + RPM^.SelectItem := RPM^.NumItem; + end else if N < 1 then begin + RPM^.SelectItem := 1; + end else begin + RPM^.SelectItem := N; + end; + if RPM^.NumItem < RPM^.TopItem then begin + RPM^.TopItem := RPM^.NumItem; + end else if RPM^.TopItem < 1 then begin + RPM^.TopItem := 1; + end; + if (RPM^.SelectItem < RPM^.TopItem) or ((RPM^.SelectItem - RPM^.TopItem + 1) > MenuHeight( RPM ) ) then begin + {Determine an appropriate new value for topitem.} + RPMReposition(RPM); + end; +{$ELSE PATCH_GH} if N <= RPM^.NumItem then begin RPM^.SelectItem := N; @@ -762,27 +1601,53 @@ begin RPMReposition(RPM); end; end; +{$ENDIF PATCH_GH} end; +{$IFDEF PATCH_GH} +Function BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String; N: Integer ): Integer; + { Do a DosSearch for files matching SearchPattern, then add } + { each of the files found to the menu. } +var + F: SearchRec; +{$ELSE PATCH_GH} Procedure BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String ); { Do a DosSearch for files matching SearchPattern, then add } { each of the files found to the menu. } var F: SearchRec; N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} N := 1; +{$ENDIF PATCH_GH} FindFirst( SearchPattern , AnyFile , F ); While DosError = 0 do begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , TextDecode(F.Name) , N ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , F.Name , N ); +{$ENDIF PATCH_I18N} Inc(N); FindNext( F ); end; FindClose( F ); +{$IFDEF PATCH_GH} + BuildFileMenu := N; +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} +end; +{$IFDEF PATCH_GH} +Function BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String ): Integer; +begin + BuildFileMenu := BuildFileMenu( RPM , SearchPattern , 1 ); end; +{$ENDIF PATCH_GH} Function SelectFile( RPM: RPGMenuPtr ): String; { RPM is a menu created by the BuildFileMenu procedure. } @@ -791,7 +1656,16 @@ Function SelectFile( RPM: RPGMenuPtr ): var N: Integer; { The number of the file selected. } Name: String; { The name of the filename selected. } -begin +{$IFDEF PATCH_CHEAT} + P: Integer; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_CHEAT} + if Cheat_Restore_AddMenuKey and (Pos(' ',RPM^.FirstItem^.msg) < 1) then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} + { Do the menu selection first. } N := SelectMenu( RPM ); @@ -800,11 +1674,33 @@ begin Name := ''; end else begin { Locate the selected element of the menu. } +{$IFDEF PATCH_CHEAT} + Name := SetItemByValue( RPM, N )^.msg; + if Cheat_Restore_AddMenuKey then begin + P := Pos(' ',Name) + 1; + Name := Copy( Name, P, Length(Name)-P+1 ); + end; +{$ELSE PATCH_CHEAT} Name := RPMLocateByPosition(RPM,RPM^.SelectItem)^.msg; +{$ENDIF PATCH_CHEAT} end; SelectFile := Name; end; +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: conmenus.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: conmenus.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/conoutput.pp branches/conoutput.pp --- GearHead1100repository.original/conoutput.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/conoutput.pp 2009-08-15 02:43:58.042405000 +0900 @@ -0,0 +1,78 @@ +{$IFDEF GUIMSWINMODE} +{ Made by l0ugh } +unit conoutput; + +interface + +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF WINDOWS} + w32crt +{$ELSE WINDOWS} + crt +{$ENDIF WINDOWS} + ; + +Procedure ConWriteLn(const Str:String); +Procedure ConWriteLn; +Procedure ConWrite(const Str:String); +Procedure ConWriteChar(c:Char); + +implementation + +Procedure ConWriteLn(const Str:String); +begin +{$IFDEF WINDOWS} + w32crt.W32WriteLn( Str ); +{$ELSE WINDOWS} + WriteLn( Str ); +{$ENDIF WINDOWS} +end; + +Procedure ConWriteLn; +begin +{$IFDEF WINDOWS} + w32crt.W32WriteLn(''); +{$ELSE WINDOWS} + WriteLn; +{$ENDIF WINDOWS} +end; + +Procedure ConWrite(const Str:String); +begin +{$IFDEF WINDOWS} + w32crt.W32Write( Str ); +{$ELSE WINDOWS} + Write( Str ); +{$ENDIF WINDOWS} +end; + +Procedure ConWriteChar(c:Char); +begin +{$IFDEF WINDOWS} + w32crt.W32WriteChar( c ); +{$ELSE WINDOWS} + Write( c ); +{$ENDIF WINDOWS} +end; + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: conoutput.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: conoutput.pp(finalization)'); +{$ENDIF DEBUG} +end; + +end. +{$ENDIF GUIMSWINMODE} diff -x .svn -uprN GearHead1100repository.original/context.pp branches/context.pp --- GearHead1100repository.original/context.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/context.pp 2015-05-22 09:00:00.000000000 +0900 @@ -23,7 +23,14 @@ unit context; interface -uses gears; +uses +{$IFDEF DEBUG} + sysutils, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; const Console_History_Length = 240; @@ -32,22 +39,212 @@ var Text_Messages: SAttPtr; Console_History: SAttPtr; +{$IFDEF PATCH_I18N} +Procedure WriteMBCharStr( const arg_msg: String; Xwidth: Integer ); +{$ENDIF PATCH_I18N} + Function RPGKey: Char; Function DirKey: Integer; Procedure EndOfGameMoreKey; Procedure CMessage( const msg: String; Z: Integer; C: Byte ); Procedure GameMSG( msg: string; X1,Y1,X2,Y2,C: Byte ); {no const} Procedure GameMSG( const msg: string; Z,C: Byte ); +{$IFDEF PATCH_GH} +Procedure RedrawConsole; +{$ENDIF PATCH_GH} Procedure DialogMSG(msg: string); {no const} +{$IFDEF PATCH_GH} +Function GetStringFromUser( const Prompt, Init_text: String ): String; +{$ENDIF PATCH_GH} Function GetStringFromUser( const Prompt: String ): String; Function MsgString( const MsgLabel: String ): String; Function MoreHighFirstLine( LList: SAttPtr ): Integer; Procedure MoreText( LList: SAttPtr; FirstLine: Integer ); +{$IFDEF PATCH_GH} + { SetupHQDisplay was moved from congfx.pp. } +Procedure SetupHQDisplay; +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} + implementation -uses crt,texutil,ui4gh,congfx; +uses +{$IFDEF PATCH_I18N} + {$IFDEF WITH_WIDECHAR} + strings, + {$ELSE WITH_WIDECHAR} + {$IFDEF GUIMSWINMODE} + strings, + {$ENDIF GUIMSWINMODE} + {$ENDIF WITH_WIDECHAR} +{$ENDIF PATCH_I18N} +{$IFDEF GUIMSWINMODE} +{$ELSE GUIMSWINMODE} + crt, +{$ENDIF GUIMSWINMODE} +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + {$IFDEF PATCH_GH} + i18nmsg, + {$ENDIF PATCH_GH} + {$IFDEF WITH_TENC} + iconv, + {$ENDIF WITH_TENC} + {$IFDEF GUIMSWINMODE} + w32crt, + conoutput, + {$ENDIF GUIMSWINMODE} +{$ENDIF PATCH_I18N} + texutil,ui4gh,congfx +{$IFDEF PATCH_GH} + ,conmenus +{$ENDIF PATCH_GH} + ; + +{$IFDEF PATCH_I18N} +Procedure WriteMBCharStr( const arg_msg: String; Xwidth: Integer ); + { NOTE: In CJK, there are many charctors, one charactor have double size for one ANK charactor and data length is 3 or 4 bytes. } + { NOTE: But, a function Write() clipped by data length. } + { NOTE: FPC's unicode functions is not stable, is its? } + {$IFDEF GUIMSWINMODE} +const + WCLen = 288; { 254; } + {$ELSE GUIMSWINMODE} + {$IFDEF WITH_WIDECHAR} +const + WCLen = 512; + {$ELSE WITH_WIDECHAR} + {$IFDEF WITH_TENC} +const + tmsgLen = 288; { 254; } + {$ENDIF WITH_TENC} + {$ENDIF WITH_WIDECHAR} + {$ENDIF GUIMSWINMODE} + +var + {$IFDEF GUIMSWINMODE} + pmsg: PChar; + pdst: PChar; + dstlen: Integer; + dst: String; + {$ELSE GUIMSWINMODE} + {$IFDEF WITH_WIDECHAR} + pmsg: PChar; + pdst: PWideChar; + dstlen: Integer; + wdst: WideString; + {$ELSE WITH_WIDECHAR} + msg: String; + {$IFDEF WITH_TENC} + tmsg: Array[0..tmsgLen] of Char; + pmsg, ptmsg: PChar; + {$ENDIF WITH_TENC} + MaxLen: Integer; + P, lastP: Integer; + X, Y: Integer; + Len: Integer; + {$ENDIF WITH_WIDECHAR} + {$ENDIF GUIMSWINMODE} + +begin + {$IFDEF GUIMSWINMODE} + pmsg := QuickPCopy(arg_msg); + pdst := StrAlloc(WCLen); + dstlen := Conv_ToTenc( pmsg, Length(arg_msg), pdst, WCLen ); + dst := pdst; + conoutput.ConWrite( dst ); + Dispose( pdst ); + Dispose( pmsg ); + {$ELSE GUIMSWINMODE} + {$IFDEF WITH_WIDECHAR} + pmsg := QuickPCopy(arg_msg); + pdst := PWideChar(StrAlloc(WCLen)); + dstlen := Conv_ToUni16( pmsg, Length(arg_msg), PWord(pdst), WCLen ); + wdst := pdst; + Write( wdst ); + Dispose( pdst ); + Dispose( pmsg ); + {$ELSE WITH_WIDECHAR} + {$IFDEF WITH_TENC} + if SYSTEM_CHARSET = TERMINAL_CHARSET then begin + if TERMINAL_bidiRTL then begin + msg := Conv_bidiRTL(arg_msg); + end else begin + msg := arg_msg; + end; + end else begin + ptmsg := tmsg; + if TERMINAL_bidiRTL then begin + pmsg := QuickPCopy(Conv_bidiRTL(arg_msg)); + end else begin + pmsg := QuickPCopy(arg_msg); + end; + Conv_ToTenc( pmsg, Length(arg_msg), ptmsg, tmsgLen ); + Dispose( pmsg ); + msg := StrPas( tmsg ); + end; + {$ELSE WITH_TENC} + msg := arg_msg; + {$ENDIF WITH_TENC} + + MaxLen := Length(msg); + P := 1; lastP := 1; + X := WhereX; Y := WhereY; + if TERMINAL_bidiRTL and (0 < Xwidth) then begin + X := X + Xwidth - WidthMBcharStr(msg); + if X < GOTOXY_MIN then begin + X := GOTOXY_MIN; + end; + GotoXY(X,Y); + end; + + {$IFDEF PASCAL_WRITE_BUG_HACK} + while (P <= MaxLen) do begin + {$IFDEF WITH_TENC} + Len := LengthMBChar( msg[P], TENC ); + {$ELSE WITH_TENC} + Len := LengthMBChar( msg[P] ); + {$ENDIF WITH_TENC} + if 0 < Len then begin + if Len <= 2 then begin + { BUG: Display width is mistook if use JISx0201-KANA. } + P := P + Len; + X := X + Len; + end else begin + Write(Copy(msg,lastP,P-lastP+len)); + P := P + Len; + lastP := P; + X := X + 2; + GotoXY(X,Y+1); + if (Y+1) <> WhereY then begin + GotoXY(X,Y-1); + if (Y-1) <> WhereY then begin + GotoXY(X+2,Y); + end; + end; + GotoXY(X,Y); + end; + end else begin + Inc(P); + Inc(X); + end; + end; + if lastP < P then Write(Copy(msg,lastP,MaxLen-lastP+1)); + {$ELSE PASCAL_WRITE_BUG_HACK} + Write( msg ); + {$ENDIF PASCAL_WRITE_BUG_HACK} + {$ENDIF WITH_WIDECHAR} + {$ENDIF GUIMSWINMODE} +end; +{$ENDIF PATCH_I18N} + Function RPGKey: Char; {Read a keypress from the keyboard. Convert it into a form} @@ -55,13 +252,65 @@ Function RPGKey: Char; var rk,getit: Char; begin +{$IFDEF GUIMSWINMODE} + RK := w32crt.ReadKey; +{$ELSE GUIMSWINMODE} RK := ReadKey; +{$ENDIF GUIMSWINMODE} +{$IFDEF DEBUG} + WriteLn(IntToHex(Ord(RK),2)); +{$ENDIF DEBUG} Case RK of + { 45 5B 1B: 5 in TenKey on Unix-Console } #0: begin {We have a two-part special key.} {Obtain the scan code.} - getit := Readkey; +{$IFDEF GUIMSWINMODE} + getit := w32crt.ReadKey; +{$ELSE GUIMSWINMODE} + getit := ReadKey; +{$ENDIF GUIMSWINMODE} +{$IFDEF DEBUG} + WriteLn(IntToHex(Ord(getit),2)); +{$ENDIF DEBUG} case getit of +{$IFDEF PATCH_GH} + #$52: RK := '0'; { 0 in TenKey } + #$53: RK := '.'; { . in TenKey on X-Window/MS-Windows } + #$5A: RK := KeyMap[ KMC_SouthWest ].KCode; { End Cursor Key on X-Window } + #$4F: RK := KeyMap[ KMC_SouthWest ].KCode; { End Cursor Key on Unix-Console, MS-Windows } + #$50: RK := KeyMap[ KMC_South ].KCode; { Down Cursor Key } + #$51: RK := KeyMap[ KMC_SouthEast ].KCode; { PageDown Cursor Key } + #$4B: RK := KeyMap[ KMC_West ].KCode; { Left Cursor Key } + #$5F: RK := '5'; { 5 in TenKey on X-Window } + #$4C: RK := '5'; { 5 in TenKey on MS-Windows } + #$4D: RK := KeyMap[ KMC_East ].KCode; { Right Cursor Key } + #$5B: begin + getit := ReadKey; + case getit of + #$1B: RK := KeyMap[ KMC_NorthWest ].KCode; { Home Cursor Key on X-Window } + else RK := #0; + end; + end; + #$47: RK := KeyMap[ KMC_NorthWest ].KCode; { Home Cursor Key on Unix-Console, MS-Windows } + #$48: RK := KeyMap[ KMC_North ].KCode; { Up Cursor Key } + #$49: RK := KeyMap[ KMC_NorthEast ].KCode; { PageUp Cursor Key } + #$35: RK := '/'; { Slash in TenKey on MS-Windows } + #$1C: RK := ' '; { Enter in TenKey on MS-Windows => Altanative-RET } + { #$3B: }{ F1 on Unix-Console, MS-Windows } + { #$3C: }{ F2 on Unix-Console, MS-Windows } + { #$3D: }{ F3 on Unix-Console, MS-Windows } + { #$3E: }{ F4 on Unix-Console, MS-Windows } + { #$3F: }{ F5 on Unix-Console, MS-Windows } + { #$40: }{ F6 } + { #$41: }{ F7 } + { #$42: }{ F8 } + { #$43: }{ F9 } + { #$44: }{ F10 } + { #$85: }{ F11 } + { #$86: }{ F12 } + #$29: RK := #$1B; { JP109key-Hankaku/Zenkaku on MS-Windows => ESC } +{$ELSE PATCH_GH} #72: RK := KeyMap[ KMC_North ].KCode; {Up Cursor Key} #71: RK := KeyMap[ KMC_NorthWest ].KCode; {Home Cursor Key} #73: RK := KeyMap[ KMC_NorthEast ].KCode; {PageUp Cursor Key} @@ -70,16 +319,23 @@ begin #81: RK := KeyMap[ KMC_SouthEast ].KCode; {PageDown Cursor Key} #75: RK := KeyMap[ KMC_West ].KCode; {Left Cursor Key} #77: RK := KeyMap[ KMC_East ].KCode; {Right Cursor Key} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + #$86: if Cheat_Display then if Cheat_Display_SW then Cheat_Display_SW := False else Cheat_Display_SW := True; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + else RK := #0; +{$ENDIF PATCH_GH} end; end; {Convert the Backspace character to ESCape.} - #8: RK := #27; {Backspace => ESC} + #8: RK := #27; { Backspace, DEL in TenKey on Unix-Console => ESC } {Normally, SPACE is the selection button, but ENTER should} {work as well. Therefore, convert all enter codes to spaces.} #10: RK := ' '; - #13: RK := ' '; + #13: RK := ' '; { Enter, Enter in TenKey on Unix-Console/X-Window } end; RPGKey := RK; @@ -110,8 +366,25 @@ begin DirKey := 6; end else if K = KeyMap[ KMC_NorthEast ].KCode then begin DirKey := 7; +{$IFDEF PATCH_GH} + end else if K = KeyMap[ KMC_Enter ].KCode then begin + DirKey := 8; + end else if K = KeyMap[ KMC_Enter2 ].KCode then begin + DirKey := 8; + end else if K = ' ' then begin + DirKey := 8; + end else if K = #27 then begin + DirKey := -1; + end else if K = KeyMap[ KMC_QuitGame ].KCode then begin + DirKey := -1; + end else if K = KeyMap[ KMC_Eject ].KCode then begin + DirKey := -1; + end else begin + DirKey := 8; +{$ELSE PATCH_GH} end else begin DirKey := -1; +{$ENDIF PATCH_GH} end; end; @@ -122,8 +395,20 @@ Procedure EndOfGameMoreKey; var A: Char; begin +{$IFDEF PATCH_GH} + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('EndOfGameMoreKey','Hit space bar') ); + {$ELSE PATCH_I18N} + DialogMSG( '[Hit space bar.]' ); + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} + { First, get rid of any pending keypresses. } +{$IFDEF GUIMSWINMODE} + while w32crt.keypressed do w32crt.readkey; +{$ELSE GUIMSWINMODE} while keypressed do readkey; +{$ENDIF GUIMSWINMODE} { Keep reading keypresses until either a space or an ESC is found. } repeat @@ -137,16 +422,29 @@ var X,Y: Integer; begin { Figure out the coordinates for centered display. } +{$IFDEF PATCH_I18N} + X := ( ScreenZone[Z,3] + ScreenZone[Z,1] ) div 2 - ( WidthMBcharStr( msg ) div 2 ) + 1; +{$ELSE PATCH_I18N} X := ( ScreenZone[Z,3] + ScreenZone[Z,1] ) div 2 - ( Length( msg ) div 2 ) + 1; +{$ENDIF PATCH_I18N} Y := ( ScreenZone[Z,4] + ScreenZone[Z,2] ) div 2; { Actually do the output. } ClrZone( Z ); if X < 1 then X := 1; if Y < 1 then Y := 1; +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( X , Y ); + w32crt.TextColor( C ); +{$ELSE GUIMSWINMODE} GotoXY( X , Y ); TextColor( C ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr(msg,0); +{$ELSE PATCH_I18N} Write(msg); +{$ENDIF PATCH_I18N} end; Procedure GameMSG( msg: string; X1,Y1,X2,Y2,C: Byte ); {not const-able} @@ -156,21 +454,41 @@ var NextWord: String; THELine: String; {The line under construction.} LC: Boolean; {Loop Condition.} +{$IFDEF PATCH_I18N} + LW_I18N: Boolean; {Is the last word I18N character?} + CW_I18N: Boolean; {Is the current word I18N character?} + DItS: Boolean; {Do insert the space, or not.} +{$ENDIF PATCH_I18N} begin { CLean up the message a bit. } DeleteWhiteSpace( msg ); +{$IFDEF GUIMSWINMODE} + w32crt.TextColor( C ); + w32crt.TextBackground( StdBlack ); +{$ELSE GUIMSWINMODE} TextColor( C ); TextBackground( StdBlack ); +{$ENDIF GUIMSWINMODE} {Clear the message area, and set clipping bounds.} +{$IFDEF GUIMSWINMODE} + w32crt.Window( X1 , Y1 , X2 , Y2 ); + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} Window( X1 , Y1 , X2 , Y2 ); ClrScr; +{$ENDIF GUIMSWINMODE} {Calculate the width of the text area.} Width := X2 - X1; {THELine = The first word in this iteration} +{$IFDEF PATCH_I18N} + LW_I18N := False; + THELine := ExtractWord( msg, DItS, CW_I18N ); +{$ELSE PATCH_I18N} THELine := ExtractWord( msg ); +{$ENDIF PATCH_I18N} {Start the main processing loop.} while TheLine <> '' do begin @@ -179,12 +497,30 @@ begin { Start building the line. } repeat +{$IFDEF PATCH_I18N} + NextWord := ExtractWord( Msg, DItS, CW_I18N ); + + if (False = LW_I18N) and (False = CW_I18N) then begin + DItS := True; + end; + LW_I18N := CW_I18N; + if DItS then begin + if WidthMBcharStr(THEline + ' ') <= Width then begin + THEline := THEline + ' '; + end; + end; + if WidthMBcharStr(THEline + NextWord) <= Width then begin + THEline := THEline + NextWord; + end else + LC := False; +{$ELSE PATCH_I18N} NextWord := ExtractWord( Msg ); if Length(THEline + ' ' + NextWord) < Width then THEline := THEline + ' ' + NextWord else LC := False; +{$ENDIF PATCH_I18N} until (not LC) or (NextWord = '') or ( TheLine[Length(TheLine)] = #13 ); @@ -192,14 +528,31 @@ begin if ( TheLine[Length(TheLine)] = #13 ) then begin { Display the line break as a space. } TheLine[Length(TheLine)] := ' '; +{$IFDEF PATCH_I18N} + NextWord := ExtractWord( msg, DItS, CW_I18N ); +{$ELSE PATCH_I18N} NextWord := ExtractWord( msg ); +{$ENDIF PATCH_I18N} end; { Output the line. } if NextWord = '' then begin +{$IFDEF PATCH_I18N} + WriteMBCharStr(THELine,Width); +{$ELSE PATCH_I18N} Write(THELine); +{$ENDIF PATCH_I18N} end else begin +{$IFDEF PATCH_I18N} + WriteMBCharStr(THELine,Width); + {$IFDEF GUIMSWINMODE} + conoutput.ConWriteLn; + {$ELSE GUIMSWINMODE} + WriteLn; + {$ENDIF GUIMSWINMODE} +{$ELSE PATCH_I18N} WriteLn(THELine); +{$ENDIF PATCH_I18N} end; { Prepare for the next iteration. } @@ -217,6 +570,44 @@ begin GameMSG( msg , ScreenZone[Z,1], ScreenZone[Z,2], ScreenZone[Z,3], ScreenZone[Z,4], C ); end; +{$IFDEF PATCH_GH} +Procedure RedrawConsole; + { Redraw the console. } +var + SL: SAttPtr; +{$IFDEF PATCH_I18N} + MaxWidth: Integer; +{$ENDIF PATCH_I18N} +begin + { Restore the console display. } +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenZone[ ZONE_Dialog , 1 ] , ScreenZone[ ZONE_Dialog , 2 ] -1 ); + w32crt.TextColor( Green ); +{$ELSE GUIMSWINMODE} + GotoXY( ScreenZone[ ZONE_Dialog , 1 ] , ScreenZone[ ZONE_Dialog , 2 ] -1 ); + TextColor( Green ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + MaxWidth := ScreenZone[ZONE_Dialog,3] - ScreenZone[ZONE_Dialog,1]; +{$ENDIF PATCH_I18N} + SL := RetrieveSAtt( Console_History , NumSAtts( Console_History ) - ScreenRows + ScreenZone[ ZONE_Dialog , 2 ] ); + if SL = Nil then SL := Console_History; + while SL <> Nil do begin +{$IFDEF GUIMSWINMODE} + conoutput.ConWriteLn; +{$ELSE GUIMSWINMODE} + writeln; +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr( SL^.Info, MaxWidth ); +{$ELSE PATCH_I18N} + write( SL^.Info ); +{$ENDIF PATCH_I18N} + SL := SL^.Next; + end; +end; +{$ENDIF PATCH_GH} + Procedure DialogMSG(msg: string); {not const-able} { Print a message in the scrolling dialog box. } var @@ -225,24 +616,49 @@ var THELine: String; {The line under construction.} LC: Boolean; {Loop Condition.} SA: SAttPtr; +{$IFDEF PATCH_I18N} + LW_I18N: Boolean; {Is the last word I18N ?} + CW_I18N: Boolean; {Is the current word I18N ?} + DItS: Boolean; {Do insert the space, or not.} + SL: SAttPtr; +{$ENDIF PATCH_I18N} begin +{$IFDEF DEBUG} + if DEBUG_TraceMacro then begin + ErrorMessage_fork( 'TRACE: DialogMSG() "' + msg + '"'); + end; +{$ENDIF DEBUG} { CLean up the message a bit. } DeleteWhiteSpace( msg ); +{$IFDEF GUIMSWINMODE} + w32crt.TextColor( InfoGreen ); + w32crt.TextBackground( StdBlack ); +{$ELSE GUIMSWINMODE} TextColor( InfoGreen ); TextBackground( StdBlack ); +{$ENDIF GUIMSWINMODE} msg := '> ' + msg; {Clear the message area, and set clipping bounds.} ClipZone( ZONE_Dialog ); {Set initial cursor position.} +{$IFDEF GUIMSWINMODE} + w32crt.GotoXY( 1 , ScreenZone[ZONE_Dialog,4] - ScreenZone[ZONE_Dialog,2] + 1 ); +{$ELSE GUIMSWINMODE} GotoXY( 1 , ScreenZone[ZONE_Dialog,4] - ScreenZone[ZONE_Dialog,2] + 1 ); +{$ENDIF GUIMSWINMODE} {Calculate the width of the text area.} Width := ScreenZone[ZONE_Dialog,3] - ScreenZone[ZONE_Dialog,1]; {THELine = The first word in this iteration} +{$IFDEF PATCH_I18N} + LW_I18N := False; + THELine := ExtractWord( msg, DItS, CW_I18N ); +{$ELSE PATCH_I18N} THELine := ExtractWord( msg ); +{$ENDIF PATCH_I18N} {Start the main processing loop.} while TheLine <> '' do begin @@ -251,12 +667,30 @@ begin { Start building the line. } repeat +{$IFDEF PATCH_I18N} + NextWord := ExtractWord( Msg, DItS, CW_I18N ); + + if (False = LW_I18N) and (False = CW_I18N) then begin + DItS := True; + end; + LW_I18N := CW_I18N; + if DItS then begin + if WidthMBcharStr(THEline + ' ') <= Width then begin + THEline := THEline + ' '; + end; + end; + if WidthMBcharStr(THEline + NextWord) <= Width then begin + THEline := THEline + NextWord; + end else + LC := False; +{$ELSE PATCH_I18N} NextWord := ExtractWord( Msg ); if Length(THEline + ' ' + NextWord) < Width then THEline := THEline + ' ' + NextWord else LC := False; +{$ENDIF PATCH_I18N} until (not LC) or (NextWord = '') or ( TheLine[Length(TheLine)] = #13 ); @@ -264,16 +698,26 @@ begin if ( TheLine[Length(TheLine)] = #13 ) then begin { Display the line break as a space. } TheLine[Length(TheLine)] := ' '; +{$IFDEF PATCH_I18N} + NextWord := ExtractWord( msg, DItS, CW_I18N ); +{$ELSE PATCH_I18N} NextWord := ExtractWord( msg ); +{$ENDIF PATCH_I18N} end; { Output the line. } if TheLine <> '' then begin +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} writeln; write( TheLine ); +{$ENDIF PATCH_I18N} if NumSAtts( Console_History ) >= Console_History_Length then begin SA := Console_History; RemoveSAtt( Console_History , SA ); +{$IFDEF PATCH_GH} + PurgeSAtt( Console_History ); +{$ENDIF PATCH_GH} end; StoreSAtt( Console_History , TheLine ); end; @@ -283,28 +727,264 @@ begin end; { while msg <> '' } +{$IFDEF PATCH_I18N} + { NOTE: In CJK, there are many charctors, one charactor have double size for one ANK charactor and data length is 3 or 4 bytes. } + { NOTE: But, a function Writeln() fail scrolling these charactors. } + { NOTE: FPC's unicode functions is not stable, is its? } + + ClrZone( ZONE_Dialog ); + MaxClipZone; + + { Restore the console display. } + {$IFDEF GUIMSWINMODE} + w32crt.GotoXY( ScreenZone[ ZONE_Dialog , 1 ] , ScreenZone[ ZONE_Dialog , 2 ] -1 ); + w32crt.TextColor( Green ); + {$ELSE GUIMSWINMODE} + GotoXY( ScreenZone[ ZONE_Dialog , 1 ] , ScreenZone[ ZONE_Dialog , 2 ] -1 ); + TextColor( Green ); + {$ENDIF GUIMSWINMODE} + SL := RetrieveSAtt( Console_History , NumSAtts( Console_History ) - ScreenRows + ScreenZone[ ZONE_Dialog , 2 ] ); + if SL = Nil then SL := Console_History; + while SL <> Nil do begin + {$IFDEF GUIMSWINMODE} + conoutput.ConWriteLn; + {$ELSE GUIMSWINMODE} + writeln; + {$ENDIF GUIMSWINMODE} + WriteMBCharStr( SL^.Info, Width ); + SL := SL^.Next; + end; +{$ELSE PATCH_I18N} {Restore the clip window to its maximum size.} MaxClipZone; +{$ENDIF PATCH_I18N} + end; +{$IFDEF PATCH_GH} Function GetStringFromUser( const Prompt: String ): String; +begin + GetStringFromUser := GetStringFromUser( Prompt, '' ); +end; + +Function GetStringFromUser( const Prompt, Init_text: String ): String; +{$ELSE PATCH_GH} +Function GetStringFromUser( const Prompt: String ): String; +{$ENDIF PATCH_GH} { Does what it says. } +{$IFDEF GUIMSWINMODE} +const + WCLen = 288; { 254; } +{$ENDIF GUIMSWINMODE} var it: String; +{$IFDEF PATCH_I18N} + {$IFDEF GUIMSWINMODE} + pmsg: PChar; + pdst: PChar; + dstlen: Integer; + dst: String; + {$ELSE GUIMSWINMODE} + RK: Char; + state: ShortInt = 0; + mbchar_work: String = ''; + {$ENDIF GUIMSWINMODE} + MaxInputWidth: Integer = 0; + {$IFDEF PATCH_GH} + trimedlength: integer; + getit: Char; + {$ENDIF PATCH_GH} + X: Integer; +{$ELSE PATCH_I18N} + {$IFDEF PATCH_GH} + MaxInputWidth: Integer = 0; + X: Integer; + {$ENDIF PATCH_GH} +{$ENDIF PATCH_I18N} begin DrawZoneBorder( ScreenZone[ ZONE_TextInput , 1 ] - 1 , ScreenZone[ ZONE_TextInput , 2 ] -1 , ScreenZone[ ZONE_TextInput , 3 ] + 1 , ScreenZone[ ZONE_TextInput , 4 ] + 1 , LightCyan ); ClrZone( ZONE_TextInput ); +{$IFDEF PATCH_I18N} + X := ( ScreenZone[ZONE_TextInput,3] + ScreenZone[ZONE_TextInput,1] ) div 2 - ( WidthMBcharStr( Prompt ) div 2 ) + 1; + if X < GOTOXY_MIN then begin + X := GOTOXY_MIN; + end; + {$IFDEF GUIMSWINMODE} + w32crt.GotoXY( X, ScreenZone[ ZONE_TextInput , 4 ] ); + w32crt.TextColor( InfoGreen ); + WriteMBCharStr( Prompt, 0 ); + w32crt.TextColor( InfoHilight ); + w32crt.CursorOn; + {$ELSE GUIMSWINMODE} + GotoXY( X, ScreenZone[ ZONE_TextInput , 4 ] ); + TextColor( InfoGreen ); + WriteMBCharStr( Prompt, 0 ); + TextColor( InfoHilight ); + CursorOn; + {$ENDIF GUIMSWINMODE} +{$ELSE PATCH_I18N} + {$IFDEF PATCH_GH} + X := ( ScreenZone[ZONE_TextInput,3] + ScreenZone[ZONE_TextInput,1] ) div 2 - ( WidthMBcharStr( Prompt ) div 2 ) + 1; + if X < GOTOXY_MIN then begin + X := GOTOXY_MIN; + end; + GotoXY( X, ScreenZone[ ZONE_TextInput , 4 ] ); + {$ELSE PATCH_GH} GotoXY( ( ScreenZone[ZONE_TextInput,3] + ScreenZone[ZONE_TextInput,1] ) div 2 - ( Length( Prompt ) div 2 ) + 1 , ScreenZone[ ZONE_TextInput , 4 ] ); + {$ENDIF PATCH_GH} TextColor( InfoGreen ); Write( Prompt ); TextColor( InfoHilight ); CursorOn; +{$ENDIF PATCH_I18N} ClipZone( ZONE_TextInput ); +{$IFDEF PATCH_GH} + MaxInputWidth := ScreenZone[ ZONE_TextInput , 3 ] - ScreenZone[ ZONE_TextInput , 1 ]; + if 127 < MaxInputWidth then MaxInputWidth := 127; + + {$IFDEF PATCH_I18N} + trimedlength := MBCharTrimedLength( Init_text, MaxInputWidth ); + if (0 < trimedlength) then begin + it := Copy(Init_text,1,trimedlength); + end else begin + it := ''; + end; + {$ELSE PATCH_I18N} + it := Copy(Init_text,1,MaxInputWidth); + {$ENDIF PATCH_I18N} + + {$IFDEF GUIMSWINMODE} + w32crt.GotoXY( 1 , 1 ); + w32crt.ClrEOL; + + pdst := StrAlloc(WCLen); + pmsg := QuickPCopy(it); + dstlen := Conv_ToTenc( pmsg, Length(it), pdst, WCLen ); + dst := pdst; + it := w32crt.W32GetLine( dst ); + Dispose( pmsg ); + pmsg := QuickPCopy(it); + dstlen := Conv_FromTenc( pmsg, Length(it), pdst, WCLen ); + it := pdst; + Dispose( pmsg ); + Dispose( pdst ); + {$ELSE GUIMSWINMODE} + {$IFDEF PATCH_I18N} + GotoXY( 1 , 1 ); + ClrEOL; + WriteMBCharStr( it, MaxInputWidth ); + + repeat + if TERMINAL_bidiRTL then begin + GotoXY( 1, 1 ); + end else begin + GotoXY( 1 + WidthMBcharStr(it) , 1 ); + end; + repeat + RK := ReadKey; +{$IFDEF DEBUG} + WriteLn(IntToHex(Ord(RK),2)); +{$ENDIF DEBUG} + { 45 5B 1B: 5 in TenKey on Unix-Console } + if #0 = RK then begin + {We have a two-part special key.} + getit := ReadKey; +{$IFDEF DEBUG} + WriteLn(IntToHex(Ord(getit),2)); +{$ENDIF DEBUG} + case getit of + #$52: RK := '0'; { 0 in TenKey } + #$53: RK := '.'; { . in TenKey on X-Window/MS-Windows } + #$5A: RK := '1'; { End Cursor Key on X-Window } + #$4F: RK := '1'; { End Cursor Key on Unix-Console, MS-Windows } + #$50: RK := '2'; { Down Cursor Key } + #$51: RK := '3'; { PageDown Cursor Key } + #$4B: RK := '4'; { Left Cursor Key } + #$5F: RK := '5'; { 5 in TenKey on X-Window } + #$4C: RK := '5'; { 5 in TenKey on MS-Windows } + #$4D: RK := '6'; { Right Cursor Key } + #$5B: begin + getit := ReadKey; + case getit of + #$1B: RK := '7'; { Home Cursor Key on X-Window } + else RK := #0; + end; + end; + #$47: RK := '7'; { Home Cursor Key on Unix-Console, MS-Windows } + #$48: RK := '8'; { Up Cursor Key } + #$49: RK := '9'; { PageUp Cursor Key } + #$35: RK := '/'; { Slash in TenKey on MS-Windows } + #$1C: RK := #$0A; { Enter in TenKey on MS-Windows => Altanative-RET } + { #$3B: }{ F1 on Unix-Console, MS-Windows } + { #$3C: }{ F2 on Unix-Console, MS-Windows } + { #$3D: }{ F3 on Unix-Console, MS-Windows } + { #$3E: }{ F4 on Unix-Console, MS-Windows } + { #$3F: }{ F5 on Unix-Console, MS-Windows } + { #$40: }{ F6 } + { #$41: }{ F7 } + { #$42: }{ F8 } + { #$43: }{ F9 } + { #$44: }{ F10 } + { #$85: }{ F11 } + { #$86: }{ F12 } + #$29: RK := #$1B; { JP109key-Hankaku/Zenkaku on MS-Windows => ESC } + else RK := #0; + end; + end; + RK := EditMBCharStr( it, 127, MaxInputWidth, RK, NIL, state, mbchar_work ); + until not(RK = #255); + GotoXY( 1 , 1 ); + ClrEOL; + WriteMBCharStr( it, MaxInputWidth ); + until (RK = #10) or (RK = #13) or (RK = #27); + if (#27 = RK) then begin + it := ''; + end; + {$ELSE PATCH_I18N} + GotoXY( 1 , 1 ); + ClrEOL; + Write( it ); + { ***BUG*** } + GotoXY( 1 , 1 ); + ReadLn( it ); + {$ENDIF PATCH_I18N} + {$ENDIF GUIMSWINMODE} +{$ELSE PATCH_GH} + {$IFDEF PATCH_I18N} + {$IFDEF GUIMSWINMODE} + w32crt.GotoXY( 1 , 1 ); + it := w32crt.W32GetLine; + {$ELSE GUIMSWINMODE} + it := ''; + MaxInputWidth := ScreenZone[ ZONE_TextInput , 3 ] - ScreenZone[ ZONE_TextInput , 1 ]; + if 127 < MaxInputWidth then MaxInputWidth := 127; + repeat + if TERMINAL_bidiRTL then begin + GotoXY( 1, 1 ); + end else begin + GotoXY( 1 + WidthMBcharStr(it) , 1 ); + end; + repeat + RK := ReadKey; + RK := EditMBCharStr( it, 127, MaxInputWidth, RK, NIL, state, mbchar_work ); + until not(RK = #255); + GotoXY( 1 , 1 ); + ClrEOL; + WriteMBCharStr( it, MaxInputWidth ); + until (RK = #10) or (RK = #13) or (RK = #27); + {$ENDIF GUIMSWINMODE} + {$ELSE PATCH_I18N} GotoXY( 1 , 1 ); ReadLn( it ); + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} +{$IFDEF GUIMSWINMODE} + w32crt.CursorOff; +{$ELSE GUIMSWINMODE} CursorOff; +{$ENDIF GUIMSWINMODE} ClrZone( ZONE_Map ); MaxClipZone; @@ -323,6 +1003,9 @@ Function MoreHighFirstLine( LList: SAttP var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = LList) then Exit(0); +{$ENDIF PATCH_GH} it := NumSAtts( LList ) - ( ScreenRows - 3 ); if it < 1 then it := 1; MoreHighFirstLine := it; @@ -335,40 +1018,133 @@ Procedure MoreText( LList: SAttPtr; Firs Procedure DisplayTextHere; var CLine: SAttPtr; { Current Line } + {$IFDEF PATCH_I18N} + trimedlength: integer; + {$ENDIF} begin { Error check. } if FirstLine < 1 then FirstLine := 1 else if FirstLine > MoreHighFirstLine( LList ) then FirstLine := MoreHighFirstLine( LList ); + {$IFDEF GUIMSWINMODE} + w32crt.GotoXY( 1 , 1 ); + {$ELSE GUIMSWINMODE} GotoXY( 1 , 1 ); + {$ENDIF GUIMSWINMODE} CLine := RetrieveSATt( LList , FirstLine ); + {$IFDEF GUIMSWINMODE} + while ( w32crt.WhereY < ( ScreenRows - 1 ) ) do begin + w32crt.ClrEOL; + {$ELSE GUIMSWINMODE} while ( WhereY < ( ScreenRows - 1 ) ) do begin ClrEOL; + {$ENDIF GUIMSWINMODE} if CLine <> Nil then begin + {$IFDEF PATCH_I18N} + trimedlength := MBCharTrimedLength( CLine^.Info, ScreenColumns - 2 ); + if (0 < trimedlength) then begin + WriteMBCharStr( Copy(CLine^.Info,1,trimedlength), ScreenColumns ); + end; + {$IFDEF GUIMSWINMODE} + conoutput.ConWriteLn; + {$ELSE GUIMSWINMODE} + WriteLn; + {$ENDIF GUIMSWINMODE} + {$ELSE PATCH_I18N} writeln( Copy( CLine^.Info , 1 , ScreenColumns - 2 ) ); + {$ENDIF PATCH_I18N} CLine := CLine^.Next; end else begin + {$IFDEF GUIMSWINMODE} + conoutput.ConWriteLn; + {$ELSE GUIMSWINMODE} writeln; + {$ENDIF GUIMSWINMODE} end; end; end; var A: Char; +{$IFDEF PATCH_GH} + RPM: RPGMenuPtr; + t, t_max: Integer; + CLine: SAttPtr; { Current Line } +{$ENDIF PATCH_GH} begin +{$IFDEF GUIMSWINMODE} + w32crt.ClrScr; + w32crt.GotoXY( 1 , ScreenRows ); + w32crt.TextColor( LightGreen ); + w32crt.TextBackground( Black ); +{$ELSE GUIMSWINMODE} ClrScr; GotoXY( 1 , ScreenROws ); TextColor( LightGreen ); TextBackground( Black ); +{$ENDIF GUIMSWINMODE} +{$IFDEF PATCH_I18N} + WriteMBCharStr( MsgString( 'MORETEXT_Prompt' ), ScreenColumns ); +{$ELSE PATCH_I18N} Write( MsgString( 'MORETEXT_Prompt' ) ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + if Show_MenuScrollbar then begin + RPM := CreateRPGMenu( LightGray , Green , ZONE_MoreText ); + CLine := RetrieveSAtt( LList , 1 ); + t_max := NumSAtts( LList ); + for t := 1 to t_max do begin + AddRPGMenuItem( RPM , CLine^.Info , -1 ); + CLine := CLine^.Next; + end; + RPM^.TopItem := FirstLine; + SetItemByPosition( RPM, FirstLine ); + SelectMenu( RPM ); + DisposeRPGMenu( RPM ); + end else begin +{$ENDIF PATCH_GH} { Display the screen. } +{$IFDEF GUIMSWINMODE} + w32crt.TextColor( LightGray ); +{$ELSE GUIMSWINMODE} TextColor( LightGray ); +{$ENDIF GUIMSWINMODE} DisplayTextHere; repeat { Get input from user. } A := RPGKey; +{$IFDEF PATCH_GH} + if A = KeyMap[ KMC_MenuUp ].KCode then begin + A := RPK_Up; + end else if A = KeyMap[ KMC_MenuDown ].KCode then begin + A := RPK_Down; + end else if A = KeyMap[ KMC_PageUp ].KCode then begin + A := RPK_UpRight; + end else if A = KeyMap[ KMC_PageDown ].KCode then begin + A := RPK_DownRight; + end else if A = KeyMap[ KMC_ScrollUp ].KCode then begin + A := RPK_UpRight; + end else if A = KeyMap[ KMC_ScrollDown ].KCode then begin + A := RPK_DownRight; + end; + + { Possibly process this input. } + if A = RPK_Down then begin + Inc( FirstLine ); + DisplayTextHere; + end else if A = RPK_Up then begin + Dec( FirstLine ); + DisplayTextHere; + end else if A = RPK_UpRight then begin + FirstLine := FirstLine - ScreenRows; + DisplayTextHere; + end else if A = RPK_DownRight then begin + FirstLine := FirstLine + ScreenRows; + DisplayTextHere; + end; +{$ELSE PATCH_GH} { Possibly process this input. } if A = KeyMap[ KMC_South ].KCode then begin Inc( FirstLine ); @@ -377,19 +1153,55 @@ begin Dec( FirstLine ); DisplayTextHere; end; +{$ENDIF PATCH_GH} until ( A = #27 ) or ( A = 'Q' ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} { CLear the display area. } +{$IFDEF GUIMSWINMODE} + w32crt.ClrScr; +{$ELSE GUIMSWINMODE} + ClrScr; +{$ENDIF GUIMSWINMODE} +end; + +{$IFDEF PATCH_GH} +Procedure SetupHQDisplay; + { CLear the screen & draw boxes. } +begin + {$IFDEF GUIMSWINMODE} + w32crt.ClrScr; + {$ELSE GUIMSWINMODE} ClrScr; + {$ENDIF GUIMSWINMODE} + RedrawConsole; end; +{$ENDIF PATCH_GH} + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: context.pp'); +{$ENDIF DEBUG} Text_Messages := LoadStringList( Standard_Message_File ); Console_History := Nil; +{$IFDEF PATCH_GH} + Attach_SmartPointer( 'Console_History: SAttPtr', @Console_History ); +{$ENDIF PATCH_GH} +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: context.pp(finalization)'); +{$ENDIF DEBUG} DisposeSAtt( Text_Messages ); DisposeSAtt( Console_History ); +end; end. diff -x .svn -uprN GearHead1100repository.original/cosplay.pas branches/cosplay.pas --- GearHead1100repository.original/cosplay.pas 2013-02-08 09:00:01.000000000 +0900 +++ branches/cosplay.pas 2013-02-08 09:01:01.000000000 +0900 @@ -192,7 +192,11 @@ var SpriteName: String; begin +{$IFDEF PATCH_GH} + Mouse_Pointer := Img_Load( 'Image' + DirectorySeparator + 'cosplay_pointer.png' ); +{$ELSE} Mouse_Pointer := Img_Load( 'Image\cosplay_pointer.png' ); +{$ENDIF} SDL_SetColorKey( Mouse_Pointer , SDL_SRCCOLORKEY or SDL_RLEACCEL , SDL_MapRGB( Mouse_Pointer^.Format , 0 , 0, 255 ) ); FileMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); diff -x .svn -uprN GearHead1100repository.original/damage.pp branches/damage.pp --- GearHead1100repository.original/damage.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/damage.pp 2016-03-18 09:01:00.000000000 +0900 @@ -23,7 +23,11 @@ unit damage; interface -uses gears; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; Const NAG_Damage = 12; @@ -36,7 +40,10 @@ Const NAS_Resurrections = 3; { Number of times the PC has cheated death. } { *** HISTORY VARIABLES *** } +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} DAMAGE_LastPartHit: GearPtr = Nil; +{$ENDIF PATCH_GH} DAMAGE_EjectRoll: Boolean = False; DAMAGE_EjectOK: Boolean = False; DAMAGE_PilotDied: Boolean = False; @@ -70,7 +77,12 @@ Function CountActivePoints(Master: GearP Function CountActiveParts(Master: GearPtr; G,S: Integer): Integer; Function CountTotalParts(Master: GearPtr; G,S: Integer): Integer; +{$IFDEF PATCH_CHEAT} +Function SeekActiveIntrinsic( Master: GearPtr; G,S: Integer; Enable_CockpitBarrier: Boolean ): GearPtr; Function SeekActiveIntrinsic( Master: GearPtr; G,S: Integer ): GearPtr; +{$ELSE PATCH_CHEAT} +Function SeekActiveIntrinsic( Master: GearPtr; G,S: Integer ): GearPtr; +{$ENDIF PATCH_CHEAT} Function SeekNDPart( Master: GearPtr; G,S: Integer ): GearPtr; Function OverloadCapacity( Mek: GearPtr ): Integer; Function MechaManeuver( Mek: GearPtr ): Integer; @@ -81,9 +93,15 @@ Function MechaStealthRating( Mek: GearPt Function PCommRating( Master: GearPtr ): Integer; Function LocateGoodAmmo( Weapon: GearPtr ): GearPtr; +{$IFDEF PATCH_GH} +Function SearchGoodAmmo( Mek, Weapon: GearPtr ): GearPtr; +{$ENDIF PATCH_GH} Function WeaponAttackAttributes( Attacker: GearPtr ): String; Function HasAttackAttribute( AtAt: String; N: Integer ): Boolean; +{$IFDEF PATCH_GH} +Function HasAttackAttributeNum( AtAt: String; N: Integer ): Integer; +{$ENDIF PATCH_GH} Function HasAreaEffect( AtAt: String ): Boolean; Function HasAreaEffect( Attacker: GearPtr ): Boolean; Function NonDamagingAttack( AtAt: String ): Boolean; @@ -99,8 +117,22 @@ Procedure ApplyCyberware( PC,Cyber: Gear implementation -uses gearutil,ghchars,ghguard,ghmecha,ghmodule,ghmovers,ghsensor, - ghsupport,ghswag,ghweapon,texutil; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + ui4gh, +{$ELSE PATCH_CHEAT} + {$IFDEF PATCH_BACKPORT} + ui4gh, + {$ENDIF PATCH_BACKPORT} +{$ENDIF PATCH_CHEAT} + gearutil,ghchars,ghguard,ghmecha,ghmodule,ghmovers,ghsensor, + ghsupport,ghswag,ghweapon,texutil; const MVSensorPenalty = 1; @@ -116,10 +148,18 @@ Function WeaponDC( Attacker: GearPtr ; A var D: Integer; Master: GearPtr; +{$IFDEF PATCH_BACKPORT} + Ammo: GearPtr; + CaliberFlag: Boolean; +{$ENDIF PATCH_BACKPORT} Procedure ApplyCCBonus; { Apply the close combat bonus for weapons. } begin +{$IFDEF PATCH_GH} + if (NIL <> Master) and (GG_DisposeGear < Master^.G) then begin +{$ELSE PATCH_GH} if Master <> Nil then begin +{$ENDIF PATCH_GH} if Master^.G = GG_Character then begin D := D + ( CStat( Master, STAT_Body ) - 10 ) div 2; @@ -142,21 +182,63 @@ var end; begin { Error check - make sure we have a valid weapon. } +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit( 0 ); +{$ELSE PATCH_GH} if Attacker = Nil then Exit( 0 ); +{$ENDIF PATCH_GH} + { Locate the master of this gear. } Master := Attacker^.Parent; if Master <> Nil then begin while Master^.Parent <> Nil do Master := Master^.Parent; end; +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Master := NIL; +{$ENDIF PATCH_GH} if Attacker^.G = GG_Weapon then begin D := Attacker^.V; +{$IFDEF PATCH_BACKPORT} + CaliberFlag := False; + if Backport_Caliber then CaliberFlag := True + else if Backport_Caliber_GH1Compatible then begin + if 0 < Length(SAttValue(Attacker^.SA,SATT_Caliber)) then CaliberFlag := True; + {$IFDEF PATCH_I18N} + if 0 < Length(SAttValue(Attacker^.SA,SATT_CaliberOrg)) then CaliberFlag := True; + {$ENDIF PATCH_I18N} + end; + + Ammo := LocateGoodAmmo( Attacker ); +{$IFDEF PATCH_GH} + if (NIL = Ammo) or (Ammo^.G <= GG_DisposeGear) then Ammo := NIL; +{$ENDIF PATCH_GH} + + if CaliberFlag then begin + { Apply damage bonuses here. } + if ( Attacker^.S = GS_Melee ) or ( Attacker^.S = GS_EMelee ) then begin + ApplyCCBonus; + end else if ( Attacker^.S = GS_Ballistic ) then begin + { A ballistic weapon can do no more damage than its ammunition will allow. } + if ( Ammo <> Nil ) and ( 0 < Ammo^.V ) and ( Ammo^.V < D ) then D := Ammo^.V; + end else if ( Attacker^.S = GS_Missile ) then begin + { The damage of a missile is determined by the missile. Duh. } + if ( Ammo <> Nil ) and ( 0 < Ammo^.V ) then D := Ammo^.V; + end; + end else begin + { Apply damage bonuses here. } + if ( Attacker^.S = GS_Melee ) or ( Attacker^.S = GS_EMelee ) then begin + ApplyCCBonus; + end; + end; +{$ELSE PATCH_BACKPORT} { Apply damage bonuses here. } if ( Attacker^.S = GS_Melee ) or ( Attacker^.S = GS_EMelee ) then begin ApplyCCBonus; end; +{$ENDIF PATCH_BACKPORT} end else if Attacker^.G = GG_Module then begin D := ModuleBaseDamage( Attacker ) div 2; @@ -189,6 +271,9 @@ Function GearCurrentDamage(Part: GearPtr var it: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} it := GearMaxDamage(Part); if it > 0 then begin it := it - NAttValue(Part^.NA,NAG_Damage,NAS_StrucDamage); @@ -203,6 +288,9 @@ Function GearCurrentArmor(Part: GearPtr) var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if ( Part <> Nil ) and ( Part^.G >= 0 ) then begin it := GearMaxArmor(Part); it := it - NAttValue( Part^.NA , NAG_Damage , NAS_ArmorDamage ); @@ -225,6 +313,9 @@ var D: Integer; SPart: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} D := GearMaxDamage( Part ); if D > 0 then begin MD := MD + D; @@ -255,18 +346,57 @@ begin PercentDamaged := ( CD * 100 ) div MD; end; +{$IFDEF PATCH_CHEAT} +Function NotDestroyed(Part: GearPtr; CheckEngine: Boolean): Boolean; +{$ELSE PATCH_CHEAT} Function NotDestroyed(Part: GearPtr): Boolean; +{$ENDIF PATCH_CHEAT} {Check this part and see whether or not it's been} {destroyed. For most parts, it isn't destroyed if it} {has any hits remaining. For parts whose HP = -1, the} {part counts as not destroyed if it has any not-destroyed} {subcomponents. For master gears, the not destroyed check} {might be a bit more complicated...} +{$IFDEF PATCH_CHEAT} + Function SeekPartAlongTrack( P: GearPtr ): Integer; + var + ret: Integer; + begin + ret := 0; + while P <> Nil do begin + if NotDestroyed( P ) then begin + if ( GG_Support = P^.G ) and ( GS_Engine = P^.S ) then begin + ret := ret + 1; + end else if Cheat_EnableCockpitBarrier and ( GG_Cockpit = P^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + ; + end else begin + ret := ret + SeekPartAlongTrack( P^.SubCom ); + end; + end; + P := P^.Next; + end; + SeekPartAlongTrack := ret; + end; +{$ENDIF PATCH_CHEAT} var CD: Integer; it: Boolean; -begin +{$IFDEF PATCH_CHEAT} + Mek: GearPtr; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + Base: GearPtr; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_CHEAT} + Mek := Part; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if Part = Nil then begin +{$ENDIF PATCH_GH} { Error Check - Undefined parts automatically count } { as destroyed. } it := False; @@ -298,6 +428,19 @@ begin { If the body is ok, check the engine. } if it then begin +{$IFDEF PATCH_CHEAT} + if Cheat_MechaCustomize_FreeSupport or ('' <> SAttValue(Mek^.SA,SATT_CUSTOM_ENGINE)) then begin + if CheckEngine then begin + if SeekPartAlongTrack( Mek^.SubCom ) < 1 then begin + it := false; + end else begin + it := true; + end; + end else begin + it := true; + end; + end else begin +{$ENDIF PATCH_CHEAT} Part := Part^.SubCom; while (Part <> Nil) and ((Part^.G <> GG_Support) or (Part^.S <> GS_Engine)) do begin Part := Part^.Next; @@ -307,6 +450,9 @@ begin { upon the state of the engine. } if Part = Nil then it := false else it := NotDestroyed(Part); +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} end; end else if Part^.G = GG_Character then begin @@ -337,9 +483,22 @@ begin {This gear is a pod or other storage type.} {It counts as not destroyed if it has any not} {destroyed children.} +{$IFDEF PATCH_GH} + Base := Part; +{$ENDIF PATCH_GH} Part := Part^.SubCom; it := false; +{$IFDEF PATCH_GH} + if ( GG_Weapon = Base^.G ) then begin + if ( ( GS_Ballistic = Base^.S ) or ( GS_Missile = Base^.S ) ) then begin + if ( NIL = Part ) then begin + it := True; + end; + end; + end; +{$ENDIF PATCH_GH} + while Part <> Nil do begin it := it OR NotDestroyed(Part); Part := Part^.Next; @@ -359,6 +518,13 @@ begin NotDestroyed := it; end; +{$IFDEF PATCH_CHEAT} +Function NotDestroyed(Part: GearPtr): Boolean; +begin + NotDestroyed := NotDestroyed( Part, True ); +end; +{$ENDIF PATCH_CHEAT} + Function Destroyed(Part: GearPtr): Boolean; { Some other procedures could use this one... } begin @@ -371,12 +537,24 @@ Function PartActive( Part: GearPtr ): Bo { and if all of its parents up to root are also not destroyed. } begin { ERROR CHECK - make sure PART is a valid pointer. } +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); +{$ELSE PATCH_GH} if Part = Nil then Exit( False ); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + if Part^.Parent = Nil then begin + PartActive := NotDestroyed( PART, not(Cheat_MechaCustomize_FreeSupport or ('' <> SAttValue(Part^.SA,SATT_CUSTOM_ENGINE))) ); + end else begin + PartActive := NotDestroyed( PART ) and PartActive( Part^.Parent ); + end; +{$ELSE PATCH_CHEAT} if Part^.Parent = Nil then PartActive := NotDestroyed( PART ) else PartActive := NotDestroyed( PART ) and PartActive( Part^.Parent ); +{$ENDIF PATCH_CHEAT} end; Function RollDamage( DC , Scale: Integer ): Integer; @@ -489,6 +667,9 @@ Function CountActivePoints(Master: GearP {This is sorta the same thing- it counts up the number of} {hits, then divides that by the scaling factor, rounding up.} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} CountActivePoints := CountUpSibs( Master^.SubCom , G , S , Master^.Scale ); end; @@ -524,6 +705,9 @@ Function CountActiveParts(Master: GearPt {Count the number of nondestroyed components which correspond} {to description G,S.} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} CountActiveParts := CountTheBits( Master^.SubCom , G , S , Master^.Scale ); end; @@ -538,6 +722,9 @@ begin {Scan through all parts in the line.} while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} {Check to see if this part matches our description.} if (Part^.G = G) and (Part^.S = S) and (Part^.Scale >= Scale) then begin Inc(it); @@ -546,6 +733,9 @@ begin if Part^.SubCom <> Nil then it := it + CountTotalBits(Part^.SubCom,G,S,Scale); if Part^.InvCom <> Nil then it := it + CountTotalBits(Part^.InvCom,G,S,Scale); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; @@ -557,10 +747,17 @@ Function CountTotalParts(Master: GearPtr {Count the number of components which correspond} {to description G,S.} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} CountTotalParts := CountTotalBits( Master^.SubCom , G , S , Master^.Scale ); end; +{$IFDEF PATCH_CHEAT} +Function SeekActiveIntrinsic( Master: GearPtr; G,S: Integer; Enable_CockpitBarrier: Boolean ): GearPtr; +{$ELSE PATCH_CHEAT} Function SeekActiveIntrinsic( Master: GearPtr; G,S: Integer ): GearPtr; +{$ENDIF PATCH_CHEAT} { Search through all the subcoms and equipment of MASTER and } { find a part which matches G,S. If more than one applicable } { part is found, return the part with the highest V field. } @@ -573,6 +770,10 @@ Function SeekActiveIntrinsic( Master: Ge it: GearPtr; begin it := Nil; +{$IFDEF PATCH_GH} + if (NIL = P1) or (P1^.G <= GG_DisposeGear) then P1 := NIL; + if (NIL = P2) or (P2^.G <= GG_DisposeGear) then P2 := NIL; +{$ENDIF PATCH_GH} if P1 = Nil then it := P2 else if P2 = Nil then it := P1 else begin @@ -594,8 +795,17 @@ Function SeekActiveIntrinsic( Master: Ge if ( P^.G = G ) and ( P^.S = S ) then begin it := CompGears( it , P ); end; +{$IFDEF PATCH_CHEAT} + if Enable_CockpitBarrier and ( GG_Cockpit = P^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + it := CompGears( it , SeekPartAlongTrack( P^.InvCom ) ); + end else begin +{$ENDIF PATCH_CHEAT} it := CompGears( SeekPartAlongTrack( P^.SubCom ) , it ); it := CompGears( it , SeekPartAlongTrack( P^.InvCom ) ); +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} end; P := P^.Next; end; @@ -603,10 +813,20 @@ Function SeekActiveIntrinsic( Master: Ge end; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} { Note that this procedure does not check the general inventory. } SeekActiveIntrinsic := SeekPartAlongTrack( Master^.SubCom ); end; +{$IFDEF PATCH_CHEAT} +Function SeekActiveIntrinsic( Master: GearPtr; G,S: Integer ): GearPtr; +begin + SeekActiveIntrinsic := SeekActiveIntrinsic( Master , G , S , Cheat_EnableCockpitBarrier ); +end; +{$ENDIF PATCH_CHEAT} + Function SeekNDPart( Master: GearPtr; G,S: Integer ): GearPtr; { Locate a component matching G,S. The component must be working, } { but otherwise can be located anywhere in the PART tree. } @@ -619,6 +839,10 @@ Function SeekNDPart( Master: GearPtr; G, it: GearPtr; begin it := Nil; +{$IFDEF PATCH_GH} + if (NIL = P1) or (P1^.G <= GG_DisposeGear) then P1 := NIL; + if (NIL = P2) or (P2^.G <= GG_DisposeGear) then P2 := NIL; +{$ENDIF PATCH_GH} if P1 = Nil then it := P2 else if P2 = Nil then it := P1 else begin @@ -639,6 +863,9 @@ Function SeekNDPart( Master: GearPtr; G, if ( P^.G = G ) and ( P^.S = S ) then begin it := CompGears( it , P ); end; +{$IFDEF PATCH_CHEAT} + { Do not check the cockpit barrier. } +{$ENDIF PATCH_CHEAT} it := CompGears( SeekPartAlongTrack( P^.SubCom ) , it ); it := CompGears( it , SeekPartAlongTrack( P^.InvCom ) ); end; @@ -648,14 +875,61 @@ Function SeekNDPart( Master: GearPtr; G, end; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} SeekNDPart := CompGears( SeekPartAlongTrack( Master^.SubCom ) , SeekPartAlongTrack( Master^.InvCom ) ); end; Function OverloadCapacity( Mek: GearPtr ): Integer; { Return the amount of energy this mecha can safely drain without } { suffering an overload penalty. } +{$IFDEF PATCH_CHEAT} + Function SeekPartAlongTrack( P: GearPtr ): Integer; + var + ret: Integer; + begin + ret := 0; + while ( NIL <> P ) do begin + if NotDestroyed( P ) then begin + if ( GG_Support = P^.G ) and ( GS_Engine = P^.S ) then begin + ret := ret + P^.V * 10; + end else if ( GG_Cockpit = P^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + ; + end else begin + ret := ret + SeekPartAlongTrack( P^.SubCom ); + end; + end; + P := P^.Next; + end; + SeekPartAlongTrack := ret; + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} +var + Engine: GearPtr; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + if ( '' <> SAttValue(Mek^.SA,SATT_CUSTOM_ENGINE) ) then begin + OverloadCapacity := SeekPartAlongTrack( Mek^.SubCom ); + end else if Cheat_MechaCustomize_FreeSupport then begin + Engine := SeekGear( Mek , GG_Support , GS_Engine ); + if (NIL <> Engine) and (GG_DisposeGear < Engine^.G) then begin + OverloadCapacity := Engine^.V * 10; + end else begin + OverloadCapacity := 0; + end; + end else begin +{$ENDIF PATCH_CHEAT} OverloadCapacity := Mek^.V * 10; +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} end; Function MechaManeuver( Mek: GearPtr ): Integer; @@ -666,6 +940,9 @@ var Gyro: GearPtr; begin { Error check- MV can only be calculated for valid mecha. } +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if (Mek = Nil) or (Mek^.G <> GG_Mecha) then Exit( 0 ); MV := FormMVBonus[ Mek^.S ] + BaseMVTVScore( Mek ); @@ -699,6 +976,9 @@ var TarCom: GearPtr; { Targeting Computer } begin { Error check- MV can only be calculated for valid mecha. } +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if (Mek = Nil) or (Mek^.G <> GG_Mecha) then Exit( 0 ); TR := FormTRBonus[ Mek^.S ] + BaseMVTVScore( Mek ); @@ -731,6 +1011,9 @@ var Sens: GearPtr; begin { Error check- MV can only be calculated for valid mecha. } +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if (Mek = Nil) or (Mek^.G <> GG_Mecha) then Exit( 0 ); { Locate the sensor package. } @@ -760,7 +1043,11 @@ Function MechaStealthRating( Mek: GearPt var SR: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if Mek = Nil then begin +{$ENDIF PATCH_GH} SR := 0; end else if Mek^.G = GG_Character then begin SR := 25 - Mek^.Stat[ STAT_Body ]; @@ -776,6 +1063,9 @@ Function PCommRating( Master: GearPtr ): var it: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} it := SeekNDPart( Master , GG_Electronics , GS_PCS ); if it = Nil then begin PCommRating := 0; @@ -792,6 +1082,9 @@ Function LocateGoodAmmo( Weapon: GearPtr var Ammo,GAmmo: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} Ammo := Weapon^.SubCom; GAmmo := Nil; while ( Ammo <> Nil ) and ( GAmmo = Nil ) do begin @@ -803,6 +1096,43 @@ begin LocateGoodAmmo := GAmmo; end; +{$IFDEF PATCH_GH} +Function SearchGoodAmmo( Mek, Weapon: GearPtr ): GearPtr; + Function SeekPartAlongTrack( P: GearPtr ): GearPtr; + var + it: GearPtr; + begin + it := NIL; + while ( NIL <> P ) do begin + if NotDestroyed( P ) then begin + if ( GG_Ammo = P^.G ) and IsInvCom( P ) then begin + if not ( NotGoodAmmo( Weapon , P ) ) then begin + it := P; + break; + end; + end; + SeekPartAlongTrack( P^.SubCom ); + SeekPartAlongTrack( P^.InvCom ); + end; + P := P^.Next; + end; + SeekPartAlongTrack := it; + end; +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(NIL); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + if ( GG_Weapon <> Weapon^.G ) then exit( NIL ); + if ( GS_Ballistic <> Weapon^.S ) and ( GS_Missile <> Weapon^.S ) then exit( NIL ); + + SearchGoodAmmo := SeekPartAlongTrack( Mek^.SubCom ); + if ( NIL = SearchGoodAmmo ) then begin + SearchGoodAmmo := SeekPartAlongTrack( Mek^.InvCom ); + end; +end; +{$ENDIF PATCH_GH} + Function WeaponAttackAttributes( Attacker: GearPtr ): String; { Return the attack type for this particular attack. } var @@ -810,7 +1140,11 @@ var ammo: GearPtr; begin { Error check. } +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit(''); +{$ELSE PATCH_GH} if Attacker = Nil then Exit( '' ); +{$ENDIF PATCH_GH} { Grab the TYPE SAtt from the weapon itself. } it := SAttValue( Attacker^.SA , 'TYPE' ); @@ -819,7 +1153,11 @@ begin if Attacker^.G = GG_Weapon then begin if ( Attacker^.S = GS_Ballistic ) or ( Attacker^.S = GS_Missile ) then begin Ammo := LocateGoodAmmo( Attacker ); +{$IFDEF PATCH_GH} + if (NIL <> Ammo) and (GG_DisposeGear < Ammo^.G) then begin +{$ELSE PATCH_GH} if Ammo <> Nil then begin +{$ENDIF PATCH_GH} it := SAttValue( Ammo^.SA , 'TYPE' ) + ' ' + it; end; end; @@ -846,6 +1184,21 @@ begin HasAttackAttribute := AStringHasBString( AtAt , AA_Name[ N ] ); end; +{$IFDEF PATCH_GH} +Function HasAttackAttributeNum( AtAt: String; N: Integer ): Integer; +var + num: Integer; +begin + if ( N < 1 ) or ( N > Num_Attack_Attributes ) then Exit( 0 ); + if not ( AStringHasBString( AtAt , AA_Name[ N ] ) ) then Exit( 0 ); + num := AStringHasBStringNum( AtAt , AA_Name[ N ] ); + if ( 0 = num ) then begin + num := 10; + end; + HasAttackAttributeNum := num; +end; +{$ENDIF PATCH_GH} + Function HasAreaEffect( AtAt: String ): Boolean; { Return TRUE if the provided attack attributes will result } { in an area effect attack, or FALSE otherwise. } @@ -857,6 +1210,9 @@ Function HasAreaEffect( Attacker: GearPt { Return TRUE if the listed weapon is of an area effect type, } { or FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} HasAreaEffect := HasAreaEffect( WeaponAttackAttributes( Attacker ) ); end; @@ -883,6 +1239,9 @@ var Ammo: GearPtr; begin { Error Check- make sure this is actually a weapon. } +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if ( Weapon = Nil ) or ( Weapon^.G <> GG_Weapon ) then Exit( 0 ); { Find the ammo gear, if one exists. } @@ -907,6 +1266,9 @@ end; Function BasicWeaponDesc( Weapon: GearPtr ): String; {Supply a default name for this particular weapon.} begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} {Convert the size of the weapon to a string.} if Weapon^.G = GG_Weapon then begin BasicWeaponDesc := DCName( WeaponDC( Weapon , 0 ) , Weapon^.Scale ) + ' ' + DefaultWeaponName[Weapon^.S]; @@ -921,13 +1283,34 @@ var Master: GearPtr; desc,AA: String; T: Integer; -begin +{$IFDEF PATCH_BACKPORT} + Ammo: GearPtr; + CaliberFlag: Boolean; + value: Integer; +{$ENDIF PATCH_BACKPORT} +begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} { Take the default name for the weapon from the WeaponName } { function in ghweapon. } desc := BasicWeaponDesc( Weapon ); if Weapon^.G = GG_Weapon then begin Master := FindMaster( Weapon ); +{$IFDEF PATCH_BACKPORT} + CaliberFlag := False; + if Backport_Caliber then CaliberFlag := True + else if Backport_Caliber_GH1Compatible then begin + if 0 < Length(SAttValue(Weapon^.SA,SATT_Caliber)) then CaliberFlag := True; + {$IFDEF PATCH_I18N} + if 0 < Length(SAttValue(Weapon^.SA,SATT_CaliberOrg)) then CaliberFlag := True; + {$ENDIF PATCH_I18N} + end; + + Ammo := LocateGoodAmmo( Weapon ); +{$ENDIF PATCH_BACKPORT} + if Master <> Nil then begin if Master^.Scale <> Weapon^.Scale then begin desc := desc + ' SF:' + BStr( Weapon^.Scale ); @@ -939,7 +1322,22 @@ begin AA := WeaponAttackAttributes( Weapon ); if (Weapon^.S = GS_Ballistic) or (Weapon^.S = GS_BeamGun) or (Weapon^.S = GS_Missile) then begin +{$IFDEF PATCH_BACKPORT} + value := 0; + if CaliberFlag and (Weapon^.S = GS_Missile) then begin + if Ammo <> Nil then begin + value := Ammo^.Stat[ STAT_Range ] + end; + if value <= 0 then begin + value := Weapon^.Stat[ STAT_Range ]; { fall back } + end; + end else begin + value := Weapon^.Stat[ STAT_Range ]; + end; + T := ScaleRange( value , Weapon^.Scale ); +{$ELSE PATCH_BACKPORT} T := ScaleRange( Weapon^.Stat[STAT_Range] , Weapon^.Scale ); +{$ENDIF PATCH_BACKPORT} if HasAttackAttribute( AA , AA_LineAttack ) then begin desc := desc + ' RNG:' + BStr( T ) + '-' + BStr( T * 2 ); end else begin @@ -949,11 +1347,30 @@ begin desc := desc + ' RNG:' + BStr( ScaleRange( 2 , Weapon^.Scale ) ); end; +{$IFDEF PATCH_BACKPORT} + value := 0; + if CaliberFlag and (Weapon^.S = GS_Missile) then begin + if Ammo <> Nil then begin + value := Ammo^.Stat[ STAT_Accuracy ] + end; + if 0 = value then begin + value := Weapon^.Stat[ STAT_Accuracy ]; { fall back } + end; + end else begin + value := Weapon^.Stat[ STAT_Accuracy ]; + end; + if -1 < value then begin + desc := desc + ' ACC:+' + BStr( value ); + end else begin + desc := desc + ' ACC:' + BStr( value ); + end; +{$ELSE PATCH_BACKPORT} if Weapon^.Stat[STAT_Accuracy] > -1 then begin desc := desc + ' ACC:+' + BStr( Weapon^.Stat[STAT_Accuracy] ); end else begin desc := desc + ' ACC:' + BStr( Weapon^.Stat[STAT_Accuracy] ); end; +{$ENDIF PATCH_BACKPORT} desc := desc + ' SPD:' + BStr( Weapon^.Stat[STAT_Recharge] ); @@ -962,7 +1379,19 @@ begin end; if (Weapon^.S = GS_Ballistic) or (Weapon^.S = GS_Missile) then begin +{$IFDEF PATCH_BACKPORT} + if CaliberFlag then begin + if NIL <> Ammo then begin + desc := desc + ' ' + BStr( AmmoRemaining( Weapon ) ) + '/' + BStr( Ammo^.Stat[ STAT_AmmoPresent] ) + 'a'; + end else begin + desc := desc + ' ' + BStr( AmmoRemaining( Weapon ) ) + '/' + BStr( Weapon^.Stat[ STAT_Magazine] ) + 'a'; + end; + end else begin + desc := desc + ' ' + BStr( AmmoRemaining( Weapon ) ) + '/' + BStr( Weapon^.Stat[ STAT_Magazine] ) + 'a'; + end; +{$ELSE PATCH_BACKPORT} desc := desc + ' ' + BStr( AmmoRemaining( Weapon ) ) + '/' + BStr( Weapon^.Stat[ STAT_Magazine] ) + 'a'; +{$ENDIF PATCH_BACKPORT} end; if HasAttackAttribute( AA , AA_Mystery ) then begin @@ -973,9 +1402,32 @@ begin end; end; +{$IFDEF PATCH_BACKPORT} + if CaliberFlag then begin + if SAttValue( Weapon^.SA , 'CALIBER' ) <> '' then desc := desc + ' <' + SAttValue( Weapon^.SA , 'CALIBER' ) + '>'; + end; +{$ENDIF PATCH_BACKPORT} + end else if Weapon^.G = GG_Ammo then begin AA := WeaponAttackAttributes( Weapon ); +{$IFDEF PATCH_BACKPORT} + if CaliberFlag and (Weapon^.S = GS_Missile) then begin + T := ScaleRange( Weapon^.Stat[STAT_Range] , Weapon^.Scale ); + if 0 < T then begin + if HasAttackAttribute( AA , AA_LineAttack ) then begin + desc := desc + ' RNG:' + BStr( T ) + '-' + BStr( T * 2 ); + end else begin + desc := desc + ' RNG:' + BStr( T ) + '-' + BStr( T * 2 ) + '-' + BStr( T * 3 ); + end; + end; + + if 0 <> Weapon^.Stat[STAT_Accuracy] then begin + desc := desc + ' ACC:' + SgnStr( Weapon^.Stat[STAT_Accuracy] ); + end; + end; +{$ENDIF PATCH_BACKPORT} + if Weapon^.S = GS_Grenade then begin desc := desc + ' RNG:T'; @@ -1005,6 +1457,10 @@ Function WAODescription( Weapon: GearPtr var desc,AA: String; begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + { Take the default name for the weapon from the WeaponName } { function in ghweapon. } desc := SAttValue( Damage_Strings , 'WAO_' + BStr( Weapon^.S ) ); @@ -1041,6 +1497,9 @@ Function MoveSysDescription( Part: GearP { Return a description of the size/type of this movement } { system. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} MoveSysDescription := SATtValue( Damage_Strings , 'MoveSys_Class' ) + ' ' + BStr( Part^.V ) + ' ' + MoveSysMan[ Part^.S ].Name; end; @@ -1050,19 +1509,34 @@ var it: String; T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} if Part^.S = GS_StatModifier then begin it := ''; for t := 1 to NumGearStats do begin if Part^.Stat[ T ] <> 0 then begin if it <> '' then it := it + ', '; +{$IFDEF PATCH_I18N} + it := it + SgnStr( Part^.Stat[ T ] ) + ' ' + I18N_Name( 'StatName', StatName[ T ] ); +{$ELSE PATCH_I18N} it := it + SgnStr( Part^.Stat[ T ] ) + ' ' + StatName[ T ]; +{$ENDIF PATCH_I18N} end; end; end else if Part^.S = GS_SkillModifier then begin if ( Part^.Stat[ STAT_SkillToModify ] >= 1 ) and ( Part^.Stat[ STAT_SkillToModify ] <= NumSkill ) then begin +{$IFDEF PATCH_I18N} + it := I18N_Name( 'SkillMan', SkillMan[ Part^.Stat[ STAT_SkillToModify ] ].Name ); +{$ELSE PATCH_I18N} it := SkillMan[ Part^.Stat[ STAT_SkillToModify ] ].Name; +{$ENDIF PATCH_I18N} end else begin +{$IFDEF PATCH_I18N} + it := I18N_Name( 'SkillMan', 'Unknown Skill' ); +{$ELSE PATCH_I18N} it := 'Unknown Skill'; +{$ENDIF PATCH_I18N} end; it := it + ' ' + SgnStr( Part^.Stat[ STAT_SkillModBonus ] ); end; @@ -1079,6 +1553,9 @@ Function ShieldDescription( Part: GearPt { Return a description of the size/type of this movement } { system. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} ShieldDescription := SATtValue( Damage_Strings , 'Shield_Desc' ) + SgnStr( Part^.Stat[ STAT_ShieldBonus ] ); end; @@ -1088,6 +1565,9 @@ Function UsableDescription( Part: GearPt var msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} msg := ReplaceHash( SATtValue( Damage_Strings , 'Usable_Desc' ) , BStr( Part^.Stat[ STAT_UseBonus ] ) ); msg := ReplaceHash( msg , BStr( Part^.Stat[ STAT_UseRange ] ) ); UsableDescription := msg; @@ -1099,9 +1579,17 @@ Function ExtendedDescription( Part: Gear var it: String; SC: GearPtr; +{$IFDEF PATCH_CHEAT} + T: Integer; + MaxT: Integer; +{$ENDIF PATCH_CHEAT} begin { Error check first. } +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ELSE PATCH_GH} if Part = Nil then Exit( '' ); +{$ENDIF PATCH_GH} { Start examining the part. } it := ''; @@ -1137,6 +1625,13 @@ begin end else if Part^.G = GG_Support then begin it := ReplaceHash( SAttValue( Damage_Strings , 'SupportDesc' ) , BStr( Part^.V ) ); +{$IFDEF PATCH_CHEAT} + if Cheat_ExtendedDescription_ShowHighOutput then begin + if EST_HighOutput = Part^.Stat[ STAT_EngineSubtype ] then begin + it := it + ' HighOutput'; + end; + end; +{$ENDIF PATCH_CHEAT} end else if Part^.G <> GG_Module then begin SC := Part^.SubCom; @@ -1145,6 +1640,26 @@ begin SC := SC^.Next; end; end; + +{$IFDEF DEBUG} + it := it + ' cmx:' + BStr( ComponentComplexity( Part ) ) + '.'; +{$ENDIF DEBUG} +{$IFDEF PATCH_CHEAT} + if (0 < SAttValueToInt(Part^.SA,SATT_TRANSFORMABLE)) then begin + it := it + ' Form:' + SAttValue( Part^.SA , SATT_TRANSFORM_NAME + BStr(SAttValueToInt( Part^.SA , SATT_TRANSFORM_CURRENT )) ); + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + MaxT := SAttValueToInt(Part^.SA,SATT_SEPARABLE); + if (0 < MaxT) then begin + it := it + ' Purge Mode:'; + for T := 1 to MaxT do begin + if ('' <> SAttValue(Part^.SA,SATT_SEPARATE + BStr(T))) then begin + it := it + BStr(T) + '.'; + end; + end; + end; +{$ENDIF PATCH_CHEAT} ExtendedDescription := it; end; @@ -1155,6 +1670,10 @@ var Injury: Integer; SC,SC2: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + Injury := Random( Num_Perm_Injuries ) + 1; SetNAtt( PC^.NA , NAG_StatusEffect , Perm_Injury_List[ Injury ] , -1 ); @@ -1162,9 +1681,15 @@ begin while SC <> Nil do begin SC2 := SC^.Next; +{$IFDEF PATCH_GH} + if (GG_DisposeGear < SC^.G) then begin +{$ENDIF PATCH_GH} if UpCase( SAttValue( SC^.SA , SAtt_CyberSlot ) ) = Perm_Injury_Slot[ Injury ] then begin RemoveGear( PC^.SubCom , SC ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} SC := SC2; end; @@ -1177,6 +1702,11 @@ var Slot: String; T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Cyber) or (Cyber^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + Slot := UpCase( SAttValue( Cyber^.SA , SAtt_CyberSlot ) ); for t := 1 to Num_Perm_Injuries do begin if Perm_Injury_Slot[ t ] = Slot then begin @@ -1186,10 +1716,21 @@ begin end; + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: damage.pp'); +{$ENDIF DEBUG} Damage_Strings := LoadStringList( Damage_Strings_File ); +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: damage.pp(finalization)'); +{$ENDIF DEBUG} DisposeSAtt( Damage_Strings ); +end; end. diff -x .svn -uprN GearHead1100repository.original/effects.pp branches/effects.pp --- GearHead1100repository.original/effects.pp 2013-02-08 10:00:00.000000000 +0900 +++ branches/effects.pp 2015-12-27 09:01:00.000000000 +0900 @@ -44,7 +44,11 @@ unit effects; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; const MOSMeasure = 5; { One Measure Of Success is gained for beating } @@ -90,13 +94,21 @@ const GS_AreaAttack = 7; { X Y Z } { Maximum length of line when adding list of destroyed parts. } +{$IFDEF PATCH_I18N} + Damage_List_Text_Length = 150; +{$ELSE PATCH_I18N} Damage_List_Text_Length = 170; +{$ENDIF PATCH_I18N} FX_DoDamage = 0; FX_CauseStatusFX = 1; FX_DoHealing = 2; FX_Overload = 3; +{$IFDEF PATCH_GH} + SDL_PointAnimation = 'SDL_POINTANIMATION'; +{$ENDIF PATCH_GH} + var { The variables in this unit hold values which may then be } @@ -104,20 +116,35 @@ var { of the attack. } ATTACK_AttackRoll,ATTACK_HiDefRoll: Integer; ATTACK_Error,ATTACK_ItHit,ATTACK_Dodge,ATTACK_Parry,ATTACK_Resist: Boolean; +{$IFDEF PATCH_GH} + ATTACK_DamageDone: LongInt; +{$ELSE PATCH_GH} ATTACK_DamageDone: Integer; +{$ENDIF PATCH_GH} ATTACK_MOS: Integer; { Attack Margin Of Success } ATTACK_NumberOfHits: Integer; ATTACK_AttSkillRank,ATTACK_DefSkillRank: Integer; +{$IFDEF PATCH_GH} + ATTACK_AttackerDamage: LongInt; +{$ELSE PATCH_GH} ATTACK_AttackerDamage: Integer; +{$ENDIF PATCH_GH} ATTACK_History: SAttPtr; +{$IFDEF PATCH_CHEAT} +Function ReadyToFire( GB: GameBoardPtr; User,Weapon: GearPtr; CheckForm,CheckAmmo,CheckTime: Boolean ): Boolean; +{$ENDIF PATCH_CHEAT} Function ReadyToFire( GB: GameBoardPtr; User,Weapon: GearPtr ): Boolean; Function ArcCheck( X0,Y0,D0,X1,Y1,A: Integer ): Boolean; Function ArcCheck( GB: GameBoardPtr; Master , Weapon: GearPtr; X,Y: Integer ): Boolean; Function ArcCheck( GB: GameBoardPtr; Master , Weapon , Target: GearPtr ): Boolean; +{$IFDEF PATCH_CHEAT} +Function RangeCheck( GB: GameBoardPtr; Master , Weapon: GearPtr; X,Y,Z: Integer ): Boolean; +Function RangeCheck( GB: GameBoardPtr; Master , Weapon , Target: GearPtr ): Boolean; +{$ENDIF PATCH_CHEAT} Function RangeArcCheck( GB: GameBoardPtr; Master , Weapon: GearPtr; X,Y,Z: Integer ): Boolean; Function RangeArcCheck( GB: GameBoardPtr; Master , Weapon , Target: GearPtr ): Boolean; @@ -132,12 +159,33 @@ Procedure Explosion( GB: GameBoardPtr; X Procedure DoAttack( GB: GameBoardPtr; Attacker,Target: GearPtr; X,Y,Z,AtOp,AMod: Integer); +{$IFDEF PATCH_GH} +Procedure HandleEffectString( GB: GameBoardPtr; Attacker,Target: GearPtr; FX_String,FX_Desc: String ); +{$ELSE PATCH_GH} Procedure HandleEffectString( GB: GameBoardPtr; Target: GearPtr; FX_String,FX_Desc: String ); +{$ENDIF PATCH_GH} implementation -uses ability,action,damage,gearutil,ghchars,ghmodule,ghguard,ghparser, +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_BACKPORT} + ui4gh, +{$ELSE PATCH_BACKPORT} + {$IFDEF PATCH_CHEAT} + ui4gh, + {$ENDIF PATCH_CHEAT} +{$ENDIF PATCH_BACKPORT} + ability,action,damage,gearutil,ghchars,ghmodule,ghguard,ghparser, ghprop,ghsensor,ghsupport,ghweapon,movement,rpgdice,skilluse,texutil; Type @@ -150,7 +198,11 @@ Type EffectRequest = Record FXName: String; FXType: Integer; +{$IFDEF PATCH_GH} + Originator,Attacker,Weapon,Target: GearPtr; +{$ELSE PATCH_GH} Originator,Weapon,Target: GearPtr; +{$ENDIF PATCH_GH} TX,TY: Integer; FXDice,FXOption,FXSkill,FXMod: Integer; AF: AttackFlags; @@ -178,23 +230,43 @@ begin AddSAtt( ATTACK_History , 'ANNOUNCE_' + BStr( EFFECTS_Event_Order ) + '_' , msg ); end; +{$IFDEF PATCH_GH} +Procedure Add_Shot_Precisely( GB: GameBoardPtr; X0,Y0,Z0,X1,Y1,Z1: Integer; SDL_image: String ); +{$ELSE PATCH_GH} Procedure Add_Shot_Precisely( GB: GameBoardPtr; X0,Y0,Z0,X1,Y1,Z1: Integer ); +{$ENDIF PATCH_GH} { Add a shot animation to the history list. } var msg: String; begin msg := BStr( GS_Shot ) + ' ' + BStr( X0 ) + ' ' + BStr( Y0 ) + ' ' + BStr( Z0 ); msg := msg + ' ' + BStr( X1 ) + ' ' + BStr( Y1 ) + ' ' + BStr( Z1 ); +{$IFDEF PATCH_GH} + if ( 0 < Length( SDL_image ) ) then begin + msg := msg + ' ' + SDL_PointAnimation + ' ' + SDL_image; + end; +{$ENDIF PATCH_GH} AddSAtt( ATTACK_History , SAtt_Anim_Direction + BStr( EFFECTS_Event_Order ) + '_' , msg ); end; +{$IFDEF PATCH_GH} +Procedure Add_Shot_Animation( GB: GameBoardPtr; Attacker_arg , Target: GearPtr ); +{$ELSE PATCH_GH} Procedure Add_Shot_Animation( GB: GameBoardPtr; Attacker , Target: GearPtr ); +{$ENDIF PATCH_GH} { Add a shot animation to the history list. } var +{$IFDEF PATCH_GH} + Attacker: GearPtr; +{$ENDIF PATCH_GH} P0,P1: Point; begin +{$IFDEF PATCH_GH} + Attacker := FindRoot( Attacker_arg ); +{$ELSE PATCH_GH} Attacker := FindRoot( Attacker ); +{$ENDIF PATCH_GH} Target := FindRoot( Target ); P0 := GearCurrentLocation( Attacker ); @@ -203,20 +275,37 @@ begin P1 := GearCurrentLocation( Target ); P1.Z := MekAltitude( GB , FindRoot( Target ) ); +{$IFDEF PATCH_GH} + Add_Shot_Precisely( GB , P0.X , P0.Y , P0.Z , P1.X , P1.Y , P1.Z , GearSAttValue( Attacker_arg , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Shot_Precisely( GB , P0.X , P0.Y , P0.Z , P1.X , P1.Y , P1.Z ); +{$ENDIF PATCH_GH} end; +{$IFDEF PATCH_GH} +Procedure Add_Point_Animation( X,Y,Z: Integer; CMD: Integer; SDL_image: String ); +{$ELSE PATCH_GH} Procedure Add_Point_Animation( X,Y,Z: Integer; CMD: Integer ); +{$ENDIF PATCH_GH} { Add a shot animation to the history list. } var msg: String; begin msg := BStr( cmd ) + ' ' + BStr( X ) + ' ' + BStr( Y ) + ' ' + BStr( Z ); +{$IFDEF PATCH_GH} + if ( 0 < Length( SDL_image ) ) then begin + msg := msg + ' ' + SDL_PointAnimation + ' ' + SDL_image; + end; +{$ENDIF PATCH_GH} AddSAtt( ATTACK_History , SAtt_Anim_Direction + BStr( EFFECTS_Event_Order ) + '_' , msg ); end; +{$IFDEF PATCH_GH} +Procedure Add_Mek_Animation( GB: GameBoardPtr; Attacker: GearPtr; Target: GearPtr; CMD: Integer ); +{$ELSE PATCH_GH} Procedure Add_Mek_Animation( GB: GameBoardPtr; Target: GearPtr; CMD: Integer ); +{$ENDIF PATCH_GH} { Add a shot animation to the history list. } var P: Point; @@ -225,7 +314,11 @@ begin { the point animation procedure above. } Target := FindRoot( Target ); P := GearCurrentLocation( Target ); +{$IFDEF PATCH_GH} + Add_Point_Animation( P.X , P.Y , MekAltitude( GB , Target ) , CMD , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Point_Animation( P.X , P.Y , MekAltitude( GB , Target ) , CMD ); +{$ENDIF PATCH_GH} end; @@ -233,17 +326,36 @@ Procedure ClearAttackHistory; { Get rid of any history variables leftover from previous attacks. } begin DisposeSAtt( ATTACK_History ); +{$IFDEF PATCH_GH_PARANOID_SAFER} + ATTACK_History := NIL; +{$ENDIF PATCH_GH_PARANOID_SAFER} EFFECTS_Event_Order := 0; end; +{$IFDEF PATCH_GH} +Procedure INDICATE_Latest_Attack( GB: GameBoardPtr; Attacker: GearPtr ); +{$ELSE PATCH_GH} Procedure INDICATE_Latest_Attack( GB: GameBoardPtr ); +{$ENDIF PATCH_GH} { Take all the stuff from the attack history values, and store it in the history } { list. } var msg: String; DP: SAttPtr; begin +{$IFDEF PATCH_GH} + if (NIL = ATTACK_TMaster) or (ATTACK_TMaster^.G <= GG_DisposeGear) then begin + ATTACK_TMaster := NIL; + ATTACK_TMasterOK := False; + end; + if (NIL = ATTACK_TPilot) or (ATTACK_TPilot^.G <= GG_DisposeGear) then begin + ATTACK_TPilot := NIL; + ATTACK_TPilotOK := False; + end; + if (NIL = ATTACK_AMaster) or (ATTACK_AMaster^.G <= GG_DisposeGear) then ATTACK_AMaster := NIL; +{$ENDIF PATCH_GH} + { Msg always starts with the target's name. } msg := PilotName( ATTACK_TMaster ); @@ -266,20 +378,48 @@ begin { indicate damage done. } if ATTACK_DamageDone > 0 then begin +{$IFDEF PATCH_I18N} + msg := msg + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','damaged'), BStr(ATTACK_DamageDone) ); +{$ELSE PATCH_I18N} msg := msg + SAttValue( FX_Messages , 'CFE_Damage1' ) + BStr( ATTACK_DamageDone ) + SAttValue( FX_Messages , 'CFE_Damage2' ); msg := msg + '.'; +{$ENDIF PATCH_I18N} { Add the list of destroyed parts now. } DP := Destroyed_Parts_List; +{$IFDEF PATCH_GH} + while DP <> Nil do begin + msg := msg + ' ' + DP^.Info + SAttValue( FX_Messages , 'CFE_Destroyed' ); + DP := DP^.Next; + if Damage_List_Text_Length < Length(msg) then begin + RecordAnnouncement( msg ); + msg := ''; + end; + end; +{$ELSE PATCH_GH} while ( DP <> Nil ) and ( Length( msg ) < Damage_List_Text_Length ) do begin msg := msg + ' ' + DP^.Info + SAttValue( FX_Messages , 'CFE_Destroyed' ); DP := DP^.Next; end; +{$ENDIF PATCH_GH} end else begin msg := msg + SAttValue( FX_Messages , 'CFE_NoDamage' ); end; +{$IFDEF PATCH_CHEAT} + if Cheat_Print_AmmoExplosion then begin + DP := Exploding_Parts_List; + while DP <> Nil do begin + msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','AmmoExplosion'), DP^.Info ); + DP := DP^.Next; + if Damage_List_Text_Length < Length(msg) then begin + RecordAnnouncement( msg ); + msg := ''; + end; + end; + end; +{$ENDIF PATCH_CHEAT} end else if ATTACK_Parry then begin if ( ATTACK_AttSkillRank + 1 + Random( 8 ) ) < ATTACK_DefSkillRank then begin @@ -315,43 +455,139 @@ begin end; end; +{$IFDEF PATCH_CHEAT} +{$IFDEF PATCH_I18N} + if ATTACK_TMasterOK and Destroyed(ATTACK_TMaster) then begin + msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','destroyed'), GearName(ATTACK_TMaster) ); + SetSAtt( ATTACK_TMaster^.SA, SATT_DESTROYED + ' '); + end; +{$ELSE PATCH_I18N} + if ATTACK_TMasterOK and Destroyed(ATTACK_TMaster) then begin + msg := msg + ' ' + GearName( ATTACK_TMaster ) + ' is destroyed!'; + SetSAtt( ATTACK_TMaster^.SA, SATT_DESTROYED + ' '); + end; +{$ENDIF PATCH_I18N} +{$ELSE PATCH_CHEAT} +{$IFDEF PATCH_I18N} + if ATTACK_TMasterOK and Destroyed(ATTACK_TMaster) then msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','destroyed'), GearName(ATTACK_TMaster) ); +{$ELSE PATCH_I18N} if ATTACK_TMasterOK and Destroyed(ATTACK_TMaster) then msg := msg + ' ' + GearName( ATTACK_TMaster ) + ' is destroyed!'; +{$ENDIF PATCH_I18N} +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} { Gotta check that the attack hit, since if the DAMAGE procedure } { wasn't called the history variables might be holding leftover } { information. } +{$IFDEF PATCH_I18N} + if ATTACK_TPilotOK and ATTACK_ItHit then begin + if DAMAGE_EjectRoll then begin + if DAMAGE_PilotDied then begin + msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','didnot eject'), GearName(ATTACK_TPilot) ); + SetSAtt( ATTACK_TPilot^.SA, SATT_DESTROYED + ' '); + end else if DAMAGE_EjectOK then begin + msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','ejected'), GearName(ATTACK_TPilot) ); + end; + end else if Destroyed(ATTACK_TPilot) then begin + msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','died'), GearName(ATTACK_TPilot) ); + SetSAtt( ATTACK_TPilot^.SA, SATT_DESTROYED + ' '); + end; + end; +{$ELSE PATCH_I18N} + if ATTACK_TPilotOK and ATTACK_ItHit then begin + if DAMAGE_EjectRoll then begin + if DAMAGE_PilotDied then begin + msg := msg + ' ' + GearName( ATTACK_TPilot ) + ' didn''t eject in time!'; + end else if DAMAGE_EjectOK then begin + msg := msg + ' ' + GearName( ATTACK_TPilot ) + ' ejected!'; + end; + end else if Destroyed(ATTACK_TPilot) then begin + msg := msg + ' ' + GearName( ATTACK_TPilot ) + ' died!'; + end; + end; +{$ENDIF PATCH_I18N} +{$ELSE PATCH_CHEAT} + { Gotta check that the attack hit, since if the DAMAGE procedure } + { wasn't called the history variables might be holding leftover } + { information. } +{$IFDEF PATCH_I18N} + if ATTACK_TPilotOK and ATTACK_ItHit then begin + if DAMAGE_EjectRoll then begin + if DAMAGE_PilotDied then msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','didnot eject'), GearName(ATTACK_TPilot) ) + else if DAMAGE_EjectOK then msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','ejected'), GearName(ATTACK_TPilot) ); + end else if Destroyed(ATTACK_TPilot) then msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','died'), GearName(ATTACK_TPilot) ); + end; +{$ELSE PATCH_I18N} if ATTACK_TPilotOK and ATTACK_ItHit then begin if DAMAGE_EjectRoll then begin if DAMAGE_PilotDied then msg := msg + ' ' + GearName( ATTACK_TPilot ) + ' didn''t eject in time!' else if DAMAGE_EjectOK then msg := msg + ' ' + GearName( ATTACK_TPilot ) + ' ejected!'; end else if Destroyed(ATTACK_TPilot) then msg := msg + ' ' + GearName( ATTACK_TPilot ) + ' died!'; end; +{$ENDIF PATCH_I18N} +{$ENDIF PATCH_CHEAT} RecordAnnouncement( msg ); { Add the correct animation. } if ATTACK_Parry or ATTACK_Resist then begin +{$IFDEF PATCH_GH} + Add_Mek_Animation( GB , Attacker , ATTACK_TMaster , GS_Parry ); +{$ELSE PATCH_GH} Add_Mek_Animation( GB , ATTACK_TMaster , GS_Parry ); +{$ENDIF PATCH_GH} end else if ATTACK_ItHit then begin if ( ATTACK_DamageDone > 0 ) then begin +{$IFDEF PATCH_GH} + Add_Mek_Animation( GB , Attacker , ATTACK_TMaster , GS_DamagingHit ); +{$ELSE PATCH_GH} Add_Mek_Animation( GB , ATTACK_TMaster , GS_DamagingHit ); +{$ENDIF PATCH_GH} end else begin +{$IFDEF PATCH_GH} + Add_Mek_Animation( GB , Attacker , ATTACK_TMaster , GS_ArmorDefHit ); +{$ELSE PATCH_GH} Add_Mek_Animation( GB , ATTACK_TMaster , GS_ArmorDefHit ); +{$ENDIF PATCH_GH} end; end else begin +{$IFDEF PATCH_GH} + Add_Mek_Animation( GB , Attacker , ATTACK_TMaster , GS_Dodge ); +{$ELSE PATCH_GH} Add_Mek_Animation( GB , ATTACK_TMaster , GS_Dodge ); +{$ENDIF PATCH_GH} end; if ATTACK_AttackerDamage > 0 then begin +{$IFDEF PATCH_GH} + Add_Mek_Animation( GB , Attacker , ATTACK_AMaster , GS_Backlash ); +{$ELSE PATCH_GH} Add_Mek_Animation( GB , ATTACK_AMaster , GS_Backlash ); +{$ENDIF PATCH_GH} end; end; +{$IFDEF PATCH_GH} +Procedure INDICATE_Attack_Effect( GB: GameBoardPtr; Attacker: GearPtr; EffectDesc: String ); +{$ELSE PATCH_GH} Procedure INDICATE_Attack_Effect( GB: GameBoardPtr; EffectDesc: String ); +{$ENDIF PATCH_GH} { Indicate effect stuff here. } var msg: String; DP: SAttPtr; begin +{$IFDEF PATCH_GH} + if (NIL = ATTACK_TMaster) or (ATTACK_TMaster^.G <= GG_DisposeGear) then begin + ATTACK_TMaster := NIL; + ATTACK_TMasterOK := False; + end; + if (NIL = ATTACK_TPilot) or (ATTACK_TPilot^.G <= GG_DisposeGear) then begin + ATTACK_TPilot := NIL; + ATTACK_TPilotOK := False; + end; + if (NIL = ATTACK_AMaster) or (ATTACK_AMaster^.G <= GG_DisposeGear) then ATTACK_AMaster := NIL; +{$ENDIF PATCH_GH} + { Miscellaneous effect only reported if target suffered damage. } if GearMaxDamage( ATTACK_TMAster ) = 0 then begin Exit; @@ -362,32 +598,81 @@ begin { Add the list of destroyed parts now. } DP := Destroyed_Parts_List; +{$IFDEF PATCH_GH} + while DP <> Nil do begin + msg := msg + ' ' + DP^.Info + SAttValue( FX_Messages , 'CFE_Destroyed' ); + DP := DP^.Next; + if Damage_List_Text_Length < Length(msg) then begin + RecordAnnouncement( msg ); + msg := ''; + end; + end; +{$ELSE PATCH_GH} while ( DP <> Nil ) and ( Length( msg ) < Damage_List_Text_Length ) do begin msg := msg + ' ' + DP^.Info + SAttValue( FX_Messages , 'CFE_Destroyed' ); DP := DP^.Next; end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} + if Cheat_Print_AmmoExplosion then begin + DP := Exploding_Parts_List; + while DP <> Nil do begin + msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','AmmoExplosion'), DP^.Info ); + DP := DP^.Next; + if Damage_List_Text_Length < Length(msg) then begin + RecordAnnouncement( msg ); + msg := ''; + end; + end; + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_I18N} + if ATTACK_TMasterOK and Destroyed(ATTACK_TMaster) then msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','destroyed'), GearName(ATTACK_TMaster) ); +{$ELSE PATCH_I18N} if ATTACK_TMasterOK and Destroyed(ATTACK_TMaster) then msg := msg + ' ' + GearName( ATTACK_TMaster ) + ' is destroyed!'; +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_I18N} + if ATTACK_TPilotOK then begin + if DAMAGE_EjectRoll then begin + if DAMAGE_PilotDied then msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','didnot eject'), GearName(ATTACK_TPilot) ) + else if DAMAGE_EjectOK then msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','ejected'), GearName(ATTACK_TPilot) ); + end else if Destroyed(ATTACK_TPilot) then msg := msg + ' ' + ReplaceHash( I18N_MsgString('INDICATE_Latest_Attack','died'), GearName(ATTACK_TPilot) ); + end; +{$ELSE PATCH_I18N} if ATTACK_TPilotOK then begin if DAMAGE_EjectRoll then begin if DAMAGE_PilotDied then msg := msg + ' ' + GearName( ATTACK_TPilot ) + ' didn''t eject in time!' else if DAMAGE_EjectOK then msg := msg + ' ' + GearName( ATTACK_TPilot ) + ' ejected!'; end else if Destroyed(ATTACK_TPilot) then msg := msg + ' ' + GearName( ATTACK_TPilot ) + ' died!'; end; +{$ENDIF PATCH_I18N} RecordAnnouncement( msg ); +{$IFDEF PATCH_GH} + Add_Mek_Animation( GB , Attacker , ATTACK_TMaster , GS_DamagingHit ); +{$ELSE PATCH_GH} Add_Mek_Animation( GB , ATTACK_TMaster , GS_DamagingHit ); +{$ENDIF PATCH_GH} end; if ATTACK_AttackerDamage > 0 then begin +{$IFDEF PATCH_GH} + Add_Mek_Animation( GB , Attacker , ATTACK_AMaster , GS_Backlash ); +{$ELSE PATCH_GH} Add_Mek_Animation( GB , ATTACK_AMaster , GS_Backlash ); +{$ENDIF PATCH_GH} end; end; Function InGeneralInventory( Part: GearPtr ): Boolean; { If in the general inventory, it may be thrown. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} InGeneralInventory := IsInvCom( Part ) and ( Part^.Parent = FindMaster( Part ) ); end; @@ -398,6 +683,10 @@ Function MustBeThrown( GB: GameBoardPtr; { the target otherwise- this is because throwing a weapon is a } { pain in the arse. You've got to go pick it up afterwards. } begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if Weapon^.G = GG_Ammo then begin { If you're attacking with ammo, that better be a grenade. } MustBeThrown := True; @@ -412,7 +701,11 @@ begin end; end; +{$IFDEF PATCH_CHEAT} +Function ReadyToFire( GB: GameBoardPtr; User,Weapon: GearPtr; CheckForm,CheckAmmo,CheckTime: Boolean ): Boolean; +{$ELSE PATCH_CHEAT} Function ReadyToFire( GB: GameBoardPtr; User,Weapon: GearPtr ): Boolean; +{$ENDIF PATCH_CHEAT} { Return TRUE if the gear in question is ready to perform an attack, } { or FALSE if it is currently unable to do so. } { Check to make sure that... } @@ -422,9 +715,37 @@ Function ReadyToFire( GB: GameBoardPtr; { 4) COMTIME is greater or equal to the RECHARGE time. } { 5) ATTACKER is mounted in a usable limb. } { 6) ATTACKER's MASTER is the same as ATTACKER's ROOT. } +{$IFDEF PATCH_CHEAT} + Function CheckTransformWeapon( Part: GearPtr ): Boolean; + var + Form: Integer; + Msg: String; + begin + while ( NIL <> Part ) and ( not IsMasterGear(Part) ) do begin + if (GG_DisposeGear < Part^.G) then begin + Form := SAttValueToInt( Part^.SA , SATT_TRANSFORM_CURRENT ); + if ( 0 < Form ) then begin + Msg := SAttValue( Part^.SA , SATT_TRANSFORM_WEAPON_LOCK + BStr(Form) ); + if ( '' <> Msg ) then begin + exit( False ); + end; + end; + end else begin + exit( False ); + end; + Part := Part^.Parent; + end; + CheckTransformWeapon := True; + end; +{$ENDIF PATCH_CHEAT} var AttackOK: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = User) or (User^.G <= GG_DisposeGear) then User := NIL; + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Weapon := NIL; +{$ENDIF PATCH_GH} + { This first check will return false if Weapon is nil, so I won't check here. } { Throwable weapons don't have to be in a good module- they can } { be in the general inventory. } @@ -435,6 +756,13 @@ begin AttackOK := PartActive( Weapon ) and InGoodModule( Weapon ) and ( NAttValue( Weapon^.NA , NAG_WeaponModifier , NAS_SafetySwitch ) = 0 ); end; +{$IFDEF PATCH_CHEAT} + if AttackOK then begin + if CheckForm and ( False = CheckTransformWeapon(Weapon) ) then begin + AttackOK := False; + end; + end; +{$ENDIF PATCH_CHEAT} if AttackOK then begin { Applicability Check } if ( Weapon^.G = GG_Weapon ) then begin @@ -442,7 +770,27 @@ begin { However, ballistic and missile weapons can't attack } { if they have no ammo left. } if ( Weapon^.S = GS_Ballistic ) or ( Weapon^.S = GS_Missile ) then begin +{$IFDEF PATCH_GH} + if ( NIL = LocateGoodAmmo( Weapon ) ) then begin +{$IFDEF PATCH_CHEAT} + AttackOK := not( CheckAmmo ); +{$ELSE PATCH_CHEAT} + AttackOK := False; +{$ENDIF PATCH_CHEAT} + end else begin +{$IFDEF PATCH_CHEAT} + if CheckTime then begin + AttackOK := Check_WaitAMinute_Part( GB , Weapon ); + end else begin + AttackOK := True; + end; +{$ELSE PATCH_CHEAT} + AttackOK := Check_WaitAMinute_Part( GB , Weapon ); +{$ENDIF PATCH_CHEAT} + end; +{$ELSE PATCH_GH} if LocateGoodAmmo( Weapon ) = Nil then AttackOK := False; +{$ENDIF PATCH_GH} end; end else if Weapon^.G = GG_Module then begin @@ -463,7 +811,15 @@ begin end; { ComTime Check } +{$IFDEF PATCH_CHEAT} + if CheckTime then begin + if ( GB^.ComTime < NAttValue( Weapon^.NA , NAG_WeaponModifier , NAS_Recharge ) ) then begin + AttackOK := False; + end; + end; +{$ELSE PATCH_CHEAT} if NAttValue( Weapon^.NA , NAG_WeaponModifier , NAS_Recharge ) > GB^.ComTime then AttackOK := False; +{$ENDIF PATCH_CHEAT} { If yer piloting a mecha can't punch the other guy yourself Check } if FindMaster( Weapon ) <> FindRoot( Weapon ) then AttackOK := False; @@ -472,6 +828,13 @@ begin ReadyToFire := AttackOK; end; +{$IFDEF PATCH_CHEAT} +Function ReadyToFire( GB: GameBoardPtr; User,Weapon: GearPtr ): Boolean; +begin + ReadyToFire := ReadyToFire( GB , User , Weapon , True , True , True ); +end; +{$ENDIF PATCH_CHEAT} + Function ArcCheck( X0,Y0,D0,X1,Y1,A: Integer ): Boolean; { CHeck that point X1,Y1 falls within Arc A as relative to } { point X0,Y0 with direction D0. } @@ -498,7 +861,12 @@ var X0 , Y0 , D: Integer; { Position of the firer. } A: Integer; { Range and Arc of the attack. } begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); +{$ELSE PATCH_GH} if ( Master = Nil ) or ( Weapon = Nil ) then Exit( False ); +{$ENDIF PATCH_GH} if Master^.Parent <> Nil then Master := FindRoot( Master ); @@ -519,7 +887,13 @@ var X0 , Y0 , D , X , Y: Integer; { Position of the firer. } A: Integer; { Range and Arc of the attack. } begin +{$IFDEF PATCH_GH} + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); +{$ELSE PATCH_GH} if ( Target = Nil ) or ( Master = Nil ) or ( Weapon = Nil ) then Exit( False ); +{$ENDIF PATCH_GH} if Target^.Parent <> Nil then Target := FindRoot( Target ); if Master^.Parent <> Nil then Master := FindRoot( Master ); @@ -536,6 +910,56 @@ begin ArcCheck := ArcCheck( X0 , Y0 , D , X , Y , A ); end; +{$IFDEF PATCH_CHEAT} +Function RangeCheck( GB: GameBoardPtr; Master , Weapon: GearPtr; X,Y,Z: Integer ): Boolean; +var + X0,Y0: Integer; + rng: Integer; + t_rng: Integer; + OK: Boolean; +begin + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); + + rng := WeaponRange( GB , Weapon ); + + X0 := NAttValue( Master^.NA , NAG_Location , NAS_X ); + Y0 := NAttValue( Master^.NA , NAG_Location , NAS_Y ); + + OK := False; + t_rng := Range( Master , X , Y ); + + if ( t_rng <= rng ) then begin + OK := True; + end else begin + OK := ( t_rng <= ThrowingRange( GB , Master , Weapon ) ); + end; + + RangeCheck := OK; +end; + +Function RangeCheck( GB: GameBoardPtr; Master , Weapon , Target: GearPtr ): Boolean; +var + X , Y: Integer; +begin + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); + + { Determine initial values for all the stuff. } + if ( NIL = Target ) then begin + Exit( False ); + end; + if ( NIL <> Target^.Parent ) then begin + Target := FindRoot( Target ); + end; + X := NAttValue( Target^.NA , NAG_Location , NAS_X ); + Y := NAttValue( Target^.NA , NAG_Location , NAS_Y ); + + RangeCheck := RangeCheck( GB , Master , Weapon , X , Y , MekAltitude( GB , Target ) ); +end; +{$ENDIF PATCH_CHEAT} + Function RangeArcCheck( GB: GameBoardPtr; Master , Weapon: GearPtr; X,Y,Z: Integer ): Boolean; { Check the range, arc, and cover between the listed gear and the listed tile. } { Returns true if the shot can take place, false otherwise. } @@ -544,6 +968,11 @@ var rng: Integer; { Range and Arc of the attack. } OK: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Calculate Range and Arc. } rng := WeaponRange( GB , Weapon ); @@ -572,6 +1001,12 @@ Function RangeArcCheck( GB: GameBoardPtr var X , Y: Integer; { Position of the firer. } begin +{$IFDEF PATCH_GH} + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Determine initial values for all the stuff. } if Target = Nil then Exit( False ); if Target^.Parent <> Nil then Target := FindRoot( Target ); @@ -587,6 +1022,10 @@ var WAO: GearPtr; it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Attacker^.G = GG_Weapon then begin it := Attacker^.Stat[STAT_Recharge]; end else begin @@ -596,9 +1035,15 @@ begin { Modify for weapon token. } WAO := Attacker^.InvCom; while WAO <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < WAO^.G) then begin +{$ENDIF PATCH_GH} if ( WAO^.G = GG_WeaponAddOn ) and NotDestroyed( WAO ) then begin it := it + WAO^.Stat[ STAT_Recharge ]; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} WAO := WAO^.Next; end; @@ -610,7 +1055,11 @@ begin end; end; +{$IFDEF PATCH_GH} +Function ClearAttack( GB: GameBoardPtr; Attacker: GearPtr ; var Ammo: GearPtr ; var AtOp: Integer ): Boolean; +{$ELSE PATCH_GH} Function ClearAttack( GB: GameBoardPtr; Attacker: GearPtr ; var AtOp: Integer ): Boolean; +{$ENDIF PATCH_GH} { This function sets up the weapon for performing an attack. } { It reduces ammo count by an appropriate amount. } { It sets the RECHARGE attribute. } @@ -619,8 +1068,18 @@ Function ClearAttack( GB: GameBoardPtr; { Note that this function does not do a range check. } var AttackOK: Boolean; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Ammo: GearPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + Ammo := NIL; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { First, make sure that this attack can even take place. } { Check to make sure that ATTACKER is active. } AttackOK := ReadyToFire( GB , FindRoot( Attacker ) , Attacker ); @@ -672,7 +1131,14 @@ Function AttackSkillNeeded( Attacker: Ge var ASkill: Integer; AMaster: GearPtr; -begin +{$IFDEF PATCH_GH} + Skill: Integer; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { The skills for human-scale and mecha-scale are set up in } { the same order, with the mecha skills being 1 to 5 and the } { personal skills being 6 to 10. So, just find the skill number } @@ -715,15 +1181,29 @@ begin ASkill := ASkill + 5; end; +{$IFDEF PATCH_GH} + Skill := SAttValueToInt( Attacker^.SA , 'UseSkill' ); + if ( 0 < Skill ) then begin + ASkill := Skill; + end; +{$ENDIF PATCH_GH} + { Return the value we found. } AttackSkillNeeded := ASkill; end; +{$IFDEF PATCH_CHEAT} +Function AttemptShieldBlock(GB: GameBoardPtr; TMaster , Attacker: GearPtr; SkRoll: Integer; var DefGear: GearPtr ): Integer; +{$ELSE PATCH_CHEAT} Function AttemptShieldBlock(GB: GameBoardPtr; TMaster , Attacker: GearPtr; SkRoll: Integer ): Integer; +{$ENDIF PATCH_CHEAT} { Attempt to block an attack using a shield. Return the defense } { roll result, or 0 if no shield could be found. } var +{$IFDEF PATCH_CHEAT} +{$ELSE PATCH_CHEAT} DefGear: GearPtr; +{$ENDIF PATCH_CHEAT} DefSkill,DefRoll: Integer; Procedure SeekShield( Part: GearPtr ); @@ -743,6 +1223,14 @@ var end; end; begin +{$IFDEF PATCH_CHEAT} + DefGear := NIL; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + if (NIL = TMaster) or (TMaster^.G <= GG_DisposeGear) then Exit(0); + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Attacker := NIL; +{$ENDIF PATCH_GH} + { Try to find a shield. } DefGear := Nil; DefRoll := 0; @@ -775,7 +1263,11 @@ begin { The shield is going to take damage from the hit, whether it was an } { energy shield or a beam shield- but beam shields only take damage } { from energy weapons. } +{$IFDEF PATCH_GH} + if (NIL <> Attacker) and (GG_DisposeGear < Attacker^.G) then begin +{$ELSE PATCH_GH} if ATtacker <> Nil then begin +{$ENDIF PATCH_GH} if DefGear^.S = GS_EnergyShield then begin if CanDamageBeamShield( Attacker ) then begin DamageGear( GB , DefGear , Attacker , Attacker^.V , 0 , 1 , '' ); @@ -799,15 +1291,25 @@ begin AttemptShieldBlock := DefRoll; end; +{$IFDEF PATCH_CHEAT} +Function AttemptParry(GB: GameBoardPtr; TMaster , Attacker: GearPtr; SkRoll: Integer; var DefGear: GearPtr ): Integer; +{$ELSE PATCH_CHEAT} Function AttemptParry(GB: GameBoardPtr; TMaster , Attacker: GearPtr; SkRoll: Integer ): Integer; +{$ENDIF PATCH_CHEAT} { Try to parry this attack, if it is in fact parryable. } var +{$IFDEF PATCH_CHEAT} +{$ELSE PATCH_CHEAT} DefGear: GearPtr; +{$ENDIF PATCH_CHEAT} DefSkill,DefRoll: Integer; Procedure SeekParryWeapon( Part: GearPtr ); { Seek a weapon which is capable of parrying an attack. } begin while ( Part <> Nil ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G = GG_Weapon ) and (( Part^.S = GS_Melee ) or ( Part^.S = GS_EMelee )) then begin if ReadyToFire( GB , Nil , Part ) and InGoodModule( Part ) and ( ( Attacker = Nil ) or ( Part^.Scale >= Attacker^.Scale ) ) then begin if DefGear = Nil then DefGear := Part @@ -816,11 +1318,26 @@ var end; if ( Part^.SubCom <> Nil ) then SeekParryWeapon( Part^.SubCom ); if ( Part^.InvCom <> Nil ) then SeekParryWeapon( Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; +{$IFDEF PATCH_GH} +var + Ammo: GearPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_CHEAT} + DefGear := NIL; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + if (NIL = TMaster) or (TMaster^.G <= GG_DisposeGear) then Exit(0); + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Attacker := NIL; +{$ENDIF PATCH_GH} + DefRoll := 0; { Search for a usable CC weapon. } @@ -843,11 +1360,19 @@ begin if DefRoll >= SkRoll then begin { After a succeful parry, weapon is "tapped". } DefSkill := 0; +{$IFDEF PATCH_GH} + ClearAttack( GB , DefGear , Ammo , DefSkill ); +{$ELSE PATCH_GH} ClearAttack( GB , DefGear , DefSkill ); +{$ENDIF PATCH_GH} { If the parrying weapon is not an energy weapon, } { it will take damage from the parrying attempt. } +{$IFDEF PATCH_GH} + if (NIL <> Attacker) and (GG_DisposeGear < Attacker^.G) then begin +{$ELSE PATCH_GH} if Attacker <> Nil then begin +{$ENDIF PATCH_GH} if ( DefGear^.S <> GS_EMelee ) then begin if ( Attacker^.G = GG_Weapon ) and ( Attacker^.S = GS_EMelee ) then begin DamageGear( GB , DefGear , Attacker , Attacker^.V , 0 , 1 , '' ); @@ -869,15 +1394,25 @@ begin AttemptParry := DefRoll; end; +{$IFDEF PATCH_CHEAT} +Function AttemptIntercept(GB: GameBoardPtr; TMaster , Attacker: GearPtr; SkRoll: Integer; var DefGear: GearPtr ): Integer; +{$ELSE PATCH_CHEAT} Function AttemptIntercept(GB: GameBoardPtr; TMaster , Attacker: GearPtr; SkRoll: Integer ): Integer; +{$ENDIF PATCH_CHEAT} { Try to intercept this attack. } var +{$IFDEF PATCH_CHEAT} +{$ELSE PATCH_CHEAT} DefGear: GearPtr; +{$ENDIF PATCH_CHEAT} DefSkill,DefRoll: Integer; Procedure SeekInterceptWeapon( Part: GearPtr ); { Seek a weapon which is capable of intercepting an attack. } begin while ( Part <> Nil ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G = GG_Weapon ) and HasAttackAttribute( WeaponAttackAttributes( Part ) , AA_Intercept ) then begin if ReadyToFire( GB , Nil , Part ) and InGoodModule( Part ) and ( ( Attacker = Nil ) or ( Part^.Scale >= Attacker^.Scale ) ) then begin if DefGear = Nil then DefGear := Part @@ -886,11 +1421,26 @@ var end; if ( Part^.SubCom <> Nil ) then SeekInterceptWeapon( Part^.SubCom ); if ( Part^.InvCom <> Nil ) then SeekInterceptWeapon( Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; +{$IFDEF PATCH_GH} +var + Ammo: GearPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_CHEAT} + DefGear := NIL; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + if (NIL = TMaster) or (TMaster^.G <= GG_DisposeGear) then Exit(0); + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Attacker := NIL; +{$ENDIF PATCH_GH} + DefRoll := 0; { Search for a usable CC weapon. } @@ -912,7 +1462,11 @@ begin { If the parry was successful, there will be some after-effects. } if DefRoll >= SkRoll then begin { After a succeful parry, weapon is "tapped". } +{$IFDEF PATCH_GH} + ClearAttack( GB , DefGear , Ammo , DefSkill ); +{$ELSE PATCH_GH} ClearAttack( GB , DefGear , DefSkill ); +{$ENDIF PATCH_GH} end; end; @@ -920,12 +1474,26 @@ begin AttemptIntercept := DefRoll; end; +{$IFDEF PATCH_CHEAT} +Function AttemptEWBlock(GB: GameBoardPtr; TMaster , Attacker: GearPtr; SkRoll: Integer; var DefGear: GearPtr ): Integer; +{$ELSE PATCH_CHEAT} Function AttemptEWBlock(GB: GameBoardPtr; TMaster , Attacker: GearPtr; SkRoll: Integer ): Integer; +{$ENDIF PATCH_CHEAT} { Try to stop this attack using Electronic Counter-Measures. } var +{$IFDEF PATCH_CHEAT} +{$ELSE PATCH_CHEAT} DefGear: GearPtr; +{$ENDIF PATCH_CHEAT} DefRoll: Integer; begin +{$IFDEF PATCH_CHEAT} + DefGear := NIL; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + if (NIL = TMaster) or (TMaster^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + DefRoll := 0; { Search for a usable CC weapon. } @@ -951,6 +1519,10 @@ Function AttemptResist(GB: GameBoardPtr; { ELECTRONIC WARFARE skills, depending upon whether the target } { is a character or a mecha. } begin +{$IFDEF PATCH_GH} + if (NIL = TMaster) or (TMaster^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if TMaster^.G = GG_MEcha then begin { Mecha use ELECTRONIC WARFARE. } ATTACK_DefSkillRank := SkillValue( TMaster , 17 ); @@ -970,7 +1542,15 @@ Function AttemptDefenses( GB: GameBoardP { defenses. Return the highest defense roll. } var DefRoll,HiDefRoll: Integer; +{$IFDEF PATCH_CHEAT} + DefGear: GearPtr; + announcement: String; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = TMaster) or (TMaster^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { First, check to see if this attack will be ineffective. } if HasAttackAttribute( AF.AtAt , AA_NoMetal ) and ( NAttValue( TMaster^.NA , NAG_GearOps , NAS_Material ) = NAV_Metal ) then begin ATTACK_Dodge := True; @@ -983,6 +1563,9 @@ begin ATTACK_Dodge := False; ATTACK_Parry := False; ATTACK_Resist := False; +{$IFDEF PATCH_CHEAT} + announcement := ''; +{$ENDIF PATCH_CHEAT} if AF.CanDodge then begin if TMaster^.G = GG_MEcha then begin { Mecha use Mecha Piloting. } @@ -1003,12 +1586,32 @@ begin DoleSkillExperience( TMaster , 10 , XPA_SK_Basic ); end; HiDefRoll := RollStep( ATTACK_DefSkillRank ); +{$IFDEF PATCH_CHEAT} + if Cheat_Print_AttemptDefenses then begin + if HiDefRoll >= SkRoll then begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Dodge'), I18N_MsgString('AttemptDefenses','Success') ); + end else begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Dodge'), I18N_MsgString('AttemptDefenses','Fail') ); + end; + end; +{$ENDIF PATCH_CHEAT} ATTACK_Dodge := HiDefRoll >= SkRoll; end; { Attempt ECM defense. } if AF.CanECM and ( HiDefRoll < SkRoll ) then begin +{$IFDEF PATCH_CHEAT} + DefRoll := AttemptEWBlock( GB , TMaster , ATtacker , SkRoll, DefGear ); + if Cheat_Print_AttemptDefenses and (NIL <> DefGear) then begin + if DefRoll >= SkRoll then begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','ECM'), I18N_MsgString('AttemptDefenses','Success'), GearName(DefGear) ); + end else begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','ECM'), I18N_MsgString('AttemptDefenses','Fail'), GearName(DefGear) ); + end; + end; +{$ELSE PATCH_CHEAT} DefRoll := AttemptEWBlock( GB , TMaster , ATtacker , SkRoll ); +{$ENDIF PATCH_CHEAT} if DefRoll > HiDefRoll then begin HiDefRoll := DefRoll; ATTACK_Dodge := HiDefRoll >= SkRoll; @@ -1017,7 +1620,18 @@ begin { Attempt physical shield parry, if charged. } if AF.CanBlock and ( HiDefRoll < SkRoll ) then begin +{$IFDEF PATCH_CHEAT} + DefRoll := AttemptShieldBlock( GB , TMaster , ATtacker , SkRoll, DefGear ); + if Cheat_Print_AttemptDefenses and (NIL <> DefGear) then begin + if DefRoll >= SkRoll then begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Shield'), I18N_MsgString('AttemptDefenses','Success'), GearName(DefGear) ); + end else begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Shield'), I18N_MsgString('AttemptDefenses','Fail'), GearName(DefGear) ); + end; + end; +{$ELSE PATCH_CHEAT} DefRoll := AttemptShieldBlock( GB , TMaster , ATtacker , SkRoll ); +{$ENDIF PATCH_CHEAT} if DefRoll > HiDefRoll then begin HiDefRoll := DefRoll; ATTACK_Parry := HiDefRoll >= SkRoll; @@ -1026,7 +1640,18 @@ begin { Attempt anti-missile intercept. } if AF.CanIntercept and ( HiDefRoll < SkRoll ) then begin +{$IFDEF PATCH_CHEAT} + DefRoll := AttemptIntercept( GB , TMaster , ATtacker , SkRoll, DefGear ); + if Cheat_Print_AttemptDefenses and (NIL <> DefGear) then begin + if DefRoll >= SkRoll then begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Intercept'), I18N_MsgString('AttemptDefenses','Success'), GearName(DefGear) ); + end else begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Intercept'), I18N_MsgString('AttemptDefenses','Fail'), GearName(DefGear) ); + end; + end; +{$ELSE PATCH_CHEAT} DefRoll := AttemptIntercept( GB , TMaster , ATtacker , SkRoll ); +{$ENDIF PATCH_CHEAT} if DefRoll > HiDefRoll then begin HiDefRoll := DefRoll; ATTACK_Parry := HiDefRoll >= SkRoll; @@ -1036,7 +1661,18 @@ begin { If a close combat attack, attempt a parry with any active } { CC weapon. } if AF.CanParry and ( HiDefRoll < SkRoll ) then begin +{$IFDEF PATCH_CHEAT} + DefRoll := AttemptParry( GB , TMaster , ATtacker , SkRoll, DefGear ); + if Cheat_Print_AttemptDefenses and (NIL <> DefGear) then begin + if DefRoll >= SkRoll then begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Parry'), I18N_MsgString('AttemptDefenses','Success'), GearName(DefGear) ); + end else begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Parry'), I18N_MsgString('AttemptDefenses','Fail'), GearName(DefGear) ); + end; + end; +{$ELSE PATCH_CHEAT} DefRoll := AttemptParry( GB , TMaster , ATtacker , SkRoll ); +{$ENDIF PATCH_CHEAT} if DefRoll > HiDefRoll then begin HiDefRoll := DefRoll; ATTACK_Parry := HiDefRoll >= SkRoll; @@ -1046,6 +1682,15 @@ begin { If resistable, try to resist. } if AF.CanResist and ( HiDefRoll < SkRoll ) then begin DefRoll := AttemptResist( GB , TMaster ); +{$IFDEF PATCH_CHEAT} + if Cheat_Print_AttemptDefenses then begin + if DefRoll >= SkRoll then begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Resist'), I18N_MsgString('AttemptDefenses','Success') ); + end else begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','Resist'), I18N_MsgString('AttemptDefenses','Fail') ); + end; + end; +{$ENDIF PATCH_CHEAT} if DefRoll > HiDefRoll then begin HiDefRoll := DefRoll; ATTACK_Resist := HiDefRoll >= SkRoll; @@ -1059,6 +1704,15 @@ begin ATTACK_DefSkillRank := SkillValue( TMaster , 9 ); DefRoll := RollStep( ATTACK_DefSkillRank ); AddStaminaDown( TMaster , 1 ); +{$IFDEF PATCH_CHEAT} + if Cheat_Print_AttemptDefenses then begin + if DefRoll >= SkRoll then begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','HapKiDo'), I18N_MsgString('AttemptDefenses','Success') ); + end else begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','HapKiDo'), I18N_MsgString('AttemptDefenses','Fail') ); + end; + end; +{$ENDIF PATCH_CHEAT} if DefRoll > HiDefRoll then begin HiDefRoll := DefRoll; ATTACK_Parry := HiDefRoll >= SkRoll; @@ -1073,6 +1727,15 @@ begin ATTACK_DefSkillRank := SkillValue( TMaster , 5 ); DefRoll := RollStep( ATTACK_DefSkillRank ); AddStaminaDown( TMaster , 1 ); +{$IFDEF PATCH_CHEAT} + if Cheat_Print_AttemptDefenses then begin + if DefRoll >= SkRoll then begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','StuntDriving'), I18N_MsgString('AttemptDefenses','Success') ); + end else begin + announcement := announcement + ReplaceHash( I18N_MsgString('AttemptDefenses','StuntDriving'), I18N_MsgString('AttemptDefenses','Fail') ); + end; + end; +{$ENDIF PATCH_CHEAT} if DefRoll > HiDefRoll then begin HiDefRoll := DefRoll; ATTACK_Dodge := HiDefRoll >= SkRoll; @@ -1087,6 +1750,12 @@ begin AddStaminaDown( TMaster , 1 ); end; +{$IFDEF PATCH_CHEAT} + if 0 < Length(announcement) then begin + RecordAnnouncement( announcement ); + end; +{$ENDIF PATCH_CHEAT} + { Return the highest rolled value. The ATTACK_HiDefRoll variable is set } { in the calling procedure. } AttemptDefenses := HiDefRoll; @@ -1098,14 +1767,54 @@ Function CalcTotalModifiers( gb: GameBoa var SkRoll,Spd,ZA,ZT: Integer; AMaster,TMaster,AModule,AShield: GearPtr; -begin +{$IFDEF PATCH_BACKPORT} + Ammo: GearPtr; + value: Integer; + CaliberFlag: Boolean; +{$ENDIF PATCH_BACKPORT} +{$IFDEF PATCH_GH} + num: Integer; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit(0); + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + SkRoll := 0; AMaster := FindRoot( Attacker ); TMaster := FindRoot( Target ); { Add the weapon accuracy, and possibly Attack Options. } if Attacker^.G = GG_Weapon then begin +{$IFDEF PATCH_BACKPORT} + CaliberFlag := False; + if Backport_Caliber then CaliberFlag := True + else if Backport_Caliber_GH1Compatible then begin + if 0 < Length(SAttValue(Attacker^.SA,SATT_Caliber)) then CaliberFlag := True; + {$IFDEF PATCH_I18N} + if 0 < Length(SAttValue(Attacker^.SA,SATT_CaliberOrg)) then CaliberFlag := True; + {$ENDIF PATCH_I18N} + end; + + if CaliberFlag then begin + value := Attacker^.Stat[STAT_Accuracy]; + if Attacker^.S = GS_Missile then begin + Ammo := LocateGoodAmmo( Attacker ); + if Ammo <> Nil then begin + value := Ammo^.Stat[STAT_Accuracy]; + end; + if 0 = value then begin + value := Attacker^.Stat[STAT_Accuracy]; { fall back } + end; + end; + SkRoll := SkRoll + value; + end else begin + SkRoll := SkRoll + Attacker^.Stat[STAT_Accuracy]; + end; +{$ELSE PATCH_BACKPORT} SkRoll := SkRoll + Attacker^.Stat[STAT_Accuracy]; +{$ENDIF PATCH_BACKPORT} { Add a modifier for any weapon add-ons that might be attached. } { I'll use the AShield var for this instead of declaring a new variable... } @@ -1163,7 +1872,10 @@ begin Spd := CalcRelativeSpeed( TMaster , GB ); if Spd > 0 then begin { Convert the speed from ClicksPerHex to HexPerRound } +{$IFDEF PATCH} +{$ELSE} Spd := ( ClicksPerRound * 10 ) div Spd; +{$ENDIF} SkRoll := SkRoll - ( Spd div ClicksPerPenalty ); end else begin if BaseMoveRate( TMaster ) > 0 then SkRoll := SkRoll + StopPenalty @@ -1172,7 +1884,12 @@ begin { Modify for attack attributes. } if HasAttackAttribute( AtAt , AA_STRAIN ) and ( AMaster <> Nil ) and ( CurrentStamina( AMaster ) < 1 ) then SkRoll := SkRoll - 10; +{$IFDEF PATCH_GH} + num := HasAttackAttributeNum( AtAt , AA_COMPLEX ); + if ( 0 < num ) and ( AMaster <> Nil ) and ( CurrentMental( AMaster ) < 1 ) then SkRoll := SkRoll - num; +{$ELSE PATCH_GH} if HasAttackAttribute( AtAt , AA_COMPLEX ) and ( AMaster <> Nil ) and ( CurrentMental( AMaster ) < 1 ) then SkRoll := SkRoll - 10; +{$ENDIF PATCH_GH} { Do the modifiers that only count if both meks are on the game board. } if OnTheMap( AMaster ) and OnTheMap( TMaster ) then begin @@ -1286,7 +2003,12 @@ begin if GearActive( TMaster ) and ( EReq.FXOption >= 1 ) and ( EReq.FXOption <= Num_Status_FX ) then begin { If a weapon is defined, it must be of a scale at least as great as the target. } +{$IFDEF PATCH_GH} + if (NIL <> EReq.Weapon) and (GG_DisposeGear < EReq.Weapon^.G) + and ( EReq.Weapon^.Scale < TMaster^.Scale ) then Exit; +{$ELSE PATCH_GH} if ( EReq.Weapon <> Nil ) and ( EReq.Weapon^.Scale < TMaster^.Scale ) then Exit; +{$ENDIF PATCH_GH} if SX_Vunerability[ EReq.FXOption , NAttValue( TMaster^.NA , NAG_GearOps , NAS_Material ) ] then begin AttackRoll := RollStep( EReq.FXSkill ); @@ -1321,8 +2043,12 @@ begin { Record the announcement, if any healing done. } if ( D0 - D1 ) > 0 then begin +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('ProcessHealingEffect','Healing_Announce'), GearName(TMaster), BStr(D0 - D1) ); +{$ELSE PATCH_I18N} msg := ReplaceHash( SAttValue( FX_Messages , 'Healing_Announce' ) , GearName( TMaster ) ); msg := ReplaceHash( msg , BStr( D0 - D1 ) ); +{$ENDIF PATCH_I18N} RecordAnnouncement( msg ); end; end; @@ -1359,6 +2085,9 @@ var begin { Initialize values. } ATTACK_TPilot := LocatePilot( AReq.Target ); +{$IFDEF PATCH_GH} + if (NIL = ATTACK_TPilot) or (ATTACK_TPilot^.G <= GG_DisposeGear) then ATTACK_TPilot := NIL; +{$ENDIF PATCH_GH} if ( ATTACK_TPilot = Nil ) or Destroyed( ATTACK_TPilot ) then ATTACK_TPilotOK := False else ATTACK_TPilotOK := True; @@ -1367,8 +2096,17 @@ begin AReq.Target := FindRoot( AReq.Target ); end; +{$IFDEF PATCH_GH} + if (NIL = AReq.Originator) or (AReq.Originator^.G <= GG_DisposeGear) then AReq.Originator := NIL; + if (NIL = Areq.Weapon) or (Areq.Weapon^.G <= GG_DisposeGear) then Areq.Weapon := NIL; +{$ENDIF PATCH_GH} + ATTACK_AMaster := FindRoot( AReq.Originator ); ATTACK_TMaster := FindRoot( Areq.Target ); +{$IFDEF PATCH_GH} + if (NIL = ATTACK_AMaster) or (ATTACK_AMaster^.G <= GG_DisposeGear) then ATTACK_AMaster := NIL; + if (NIL = ATTACK_TMaster) or (ATTACK_TMaster^.G <= GG_DisposeGear) then ATTACK_TMaster := NIL; +{$ENDIF PATCH_GH} ATTACK_Error := False; @@ -1581,9 +2319,25 @@ begin { Store the results of this attack. } if AReq.FXDesc = '' then begin +{$IFDEF PATCH_GH} + if ( NIL <> AReq.Weapon ) then begin + INDICATE_Latest_Attack( GB , AReq.Weapon ); + end else begin + INDICATE_Latest_Attack( GB , AReq.Attacker ); + end; +{$ELSE PATCH_GH} INDICATE_Latest_Attack( GB ); +{$ENDIF PATCH_GH} end else begin +{$IFDEF PATCH_GH} + if ( NIL <> AReq.Weapon ) then begin + INDICATE_Attack_Effect( GB , AReq.Weapon , AReq.FXDesc ); + end else begin + INDICATE_Attack_Effect( GB , AReq.Attacker , AReq.FXDesc ); + end; +{$ELSE PATCH_GH} INDICATE_Attack_Effect( GB , AReq.FXDesc ); +{$ENDIF PATCH_GH} end; { Cause status effects as appropriate. } @@ -1631,7 +2385,11 @@ begin { If the mek's move mode has been disabled, it will crash here. } if ATTACK_TMasterMove and (BaseMoveRate( ATTACK_TMaster ) = 0) then begin Crash( GB , ATTACK_TMaster ); +{$IFDEF PATCH_I18N} + AddSAtt( ATTACK_History , 'ANNOUNCE_' + BStr( EFFECTS_Event_Order + 1 ) + '_' , ReplaceHash( I18N_MsgString('ProcessAttackEffect','crashed'), PilotName(ATTACK_TMaster) ) ); +{$ELSE PATCH_I18N} AddSAtt( ATTACK_History , 'ANNOUNCE_' + BStr( EFFECTS_Event_Order + 1 ) + '_' , PilotName( ATTACK_TMaster ) + ' has crashed!' ); +{$ENDIF PATCH_I18N} end; end; @@ -1709,6 +2467,12 @@ var AReq.AF.CanBlock := False; end; end; +{$IFDEF PATCH_I18N} +var + W: String; + DItS: Boolean; {Do insert the space, or not.} + CW_I18N: Boolean; {Is the current word I18N ?} +{$ENDIF PATCH_I18N} begin { First, make sure we have an originator, and that it's a character. } if ( AReq.Originator = Nil ) or ( AReq.Originator^.G <> GG_Character ) then exit; @@ -1762,6 +2526,39 @@ begin AReq.FXName := ''; while msg <> '' do begin +{$IFDEF PATCH_I18N} + C := ExtractWord( msg, DItS, CW_I18N ); + while ( 2 <= Length(C) ) and ( '%' = C[1] ) do begin + W := ''; + if ( 'A' = C[2] ) then begin + if ( NIL <> Adjective ) then begin + W := SelectRandomSAtt( Adjective )^.Info; + end else begin + W := SAttValue( FX_Messages , 'FMAFT_MISCA' + BStr( Random( 5 ) + 1 ) ); + end; + end else if ( 'N' = C[2] ) then begin + if ( NIL <> Noun ) then begin + W := SelectRandomSAtt( Noun )^.Info; + end else begin + W := SAttValue( FX_Messages , 'FMAFT_MISCN' + BStr( Random( 5 ) + 1 ) ); + end; + end else begin + W := '%' + C[2]; + end; + C := Copy( C, 3, Length(C) - 2 ); + if DItS then begin + AReq.FXName := AReq.FXName + ' ' + W; + DItS := False; + end else begin + AReq.FXName := AReq.FXName + W; + end; + end; + if DItS then begin + AReq.FXName := AReq.FXName + ' ' + C; + end else begin + AReq.FXName := AReq.FXName + C; + end; +{$ELSE PATCH_I18N} C := ExtractWord( msg ); if C = '%A' then begin if Adjective <> Nil then begin @@ -1778,6 +2575,7 @@ begin end else begin AReq.FXName := AReq.FXName + ' ' + C; end; +{$ENDIF PATCH_I18N} end; DisposeSAtt( Adjective ); @@ -1792,11 +2590,19 @@ var AttackSkill: Integer; AReq: EffectRequest; begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Attacker := NIL; + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Target := NIL; +{$ENDIF PATCH_GH} + { Fill out the effect request. } AReq.FXName := GearName( Attacker ); AReq.FXType := FX_DoDamage; AReq.Target := Target; AReq.Originator := FindRoot( Attacker ); +{$IFDEF PATCH_GH} + AReq.Attacker := Attacker; +{$ENDIF PATCH_GH} AReq.Weapon := Attacker; AReq.AF.CantCallShot := NoCalledShots( AtAt , AtOp ); AReq.AF.CanDodge := True; @@ -1829,7 +2635,12 @@ begin end; { Add the surprise attack bonuses. } +{$IFDEF PATCH_GH} + if ((NIL <> AReq.Originator) and (GG_DisposeGear < AReq.Originator^.G)) + and (( Target <> Nil ) and not MekCanSeeTarget( GB , FindRoot( Target ) , AReq.Originator )) then begin +{$ELSE PATCH_GH} if ( Areq.Originator <> Nil ) and ( Target <> Nil ) and not MekCanSeeTarget( GB , FindRoot( Target ) , AReq.Originator ) then begin +{$ENDIF PATCH_GH} if HasTalent( Areq.Originator , NAS_Ninjitsu ) then begin AReq.FXMod := AReq.FXMod + MOSMeasure * 2; AReq.FXDice := AReq.FXDice * 3 div 2; @@ -1851,7 +2662,12 @@ var AReq: EffectRequest; begin { Error check. } +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) + or (NIL = Target) or (Target^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if ( Attacker = Nil ) or ( Target = Nil ) then begin +{$ENDIF PATCH_GH} ATTACK_Error := True; exit; end; @@ -1872,27 +2688,51 @@ var X0,Y0,Z0: Integer; AReq: EffectRequest; begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { If an initial shot animation is required, add that now. } X0 := NAttValue( FindMaster( Attacker )^.NA , NAG_Location , NAS_X ); Y0 := NAttValue( FindMaster( Attacker )^.NA , NAG_Location , NAS_Y ); Z0 := MekALtitude( GB , FindRoot( Attacker ) ); +{$IFDEF PATCH_GH} + Add_Shot_Precisely( GB , X0 , Y0 , Z0 , X , Y , Z , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Shot_Precisely( GB , X0 , Y0 , Z0 , X , Y , Z ); +{$ENDIF PATCH_GH} AReq := FillAttackRequest( GB,Attacker,Target,AtOp,AMod,AtAt,False ); { Actually perform the attack. } +{$IFDEF PATCH_GH} + if (NIL <> Target) and (GG_DisposeGear < Target^.G) then begin +{$ELSE PATCH_GH} if Target <> Nil then begin +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('DoDirectFireAttack','attacks'), PilotName(FindMaster(Attacker)), PilotName(FindMaster(Target)), AReq.FXName ); +{$ELSE PATCH_I18N} msg := PilotName( FindMaster( Attacker ) ) + ' attacks ' + PilotName( FindMaster( Target ) )+' with ' + AReq.FXName + '.'; +{$ENDIF PATCH_I18N} RecordAnnouncement( msg ); Inc( EFFECTS_Event_Order ); { Give a meager skill experience bonus. } DoleSkillExperience( AReq.Originator , AttackSkillNeeded( Attacker ) , XPA_SK_Basic ); ProcessAttackEffect( GB , AReq ); end else if Attacker^.Scale >= GB^.Scale then begin +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('DoDirectFireAttack','fires'), PilotName(FindMaster(Attacker)), GearName(Attacker) ); +{$ELSE PATCH_I18N} msg := PilotName( FindMaster( Attacker ) ) + ' fires ' + GearName( Attacker ) + '.'; +{$ENDIF PATCH_I18N} RecordAnnouncement( msg ); Inc( EFFECTS_Event_Order ); +{$IFDEF PATCH_GH} + Add_Point_Animation( X , Y , Z , GS_DamagingHit , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Point_Animation( X , Y , Z , GS_DamagingHit ); +{$ENDIF PATCH_GH} SceneryChewing( GB , X , Y , WeaponDC( Attacker , AtOp ) + 2 , False , AtAt ); end; end; @@ -1916,7 +2756,13 @@ begin N := 0; M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if MekIsTargetInRadius( GB, M, Attacker, Weapon, Spotter, X, Y, R ) then Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; NumTargetsInRadius := N; @@ -1926,6 +2772,10 @@ Function SwarmRadius( GB: GameBoardPtr; { Return the radius at which this weapon swarms. Default value } { is one-half the regular short range. } begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Attacker^.G = GG_Ammo then begin { Thrown weapons have an effectively infinite swarm } { spread. Why? Because I want shurikens to be cool. } @@ -1943,7 +2793,15 @@ var Mek: GearPtr; N,T,AtOp2,R: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('DoSwarmAttack','fires'), PilotName(FindMaster(Attacker)), GearName(Attacker) ); +{$ELSE PATCH_I18N} msg := PilotName( FindMaster( Attacker ) ) + ' fires ' + GearName( Attacker ) + '.'; +{$ENDIF PATCH_I18N} RecordAnnouncement( msg ); R := SwarmRadius( GB , Attacker ); @@ -1953,6 +2811,9 @@ begin Mek := GB^.Meks; T := 1; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} AtOp2 := ( AtOp + 1 ) div N; if T <= ( ( AtOp + 1 ) mod N ) then Inc( AtOp2 ); @@ -1963,6 +2824,9 @@ begin Dec( EFFECTS_Event_Order ); Inc( T ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} mek := Mek^.Next; end; @@ -1977,6 +2841,10 @@ var AA: String; R,T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Initialize radius to 0. } R := 0; @@ -2144,6 +3012,10 @@ var msg: String; Mek: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { First, check for deviation of the shot. } AP := GearCurrentLocation( Attacker ); AP.Z := MekAltitude( GB , FindRoot( Attacker ) ); @@ -2159,9 +3031,17 @@ begin end; { Start by making the initial display. } +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('DoSwarmAttack','fires'), PilotName(FindMaster(Attacker)), GearName(Attacker) ); +{$ELSE PATCH_I18N} msg := PilotName( FindMaster( Attacker ) ) + ' fires ' + GearName( Attacker ) + '.'; +{$ENDIF PATCH_I18N} RecordAnnouncement( msg ); +{$IFDEF PATCH_GH} + Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z ); +{$ENDIF PATCH_GH} Inc( EFFECTS_Event_Order ); { Calculate the range. } @@ -2186,7 +3066,11 @@ begin SceneryChewing( GB, X, Y, WeaponDC( Attacker , AtOp ), False, AtAt ); end; +{$IFDEF PATCH_GH} + Add_Point_Animation( X, Y, OP.Z, GS_AreaAttack , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Point_Animation( X, Y, OP.Z, GS_AreaAttack ); +{$ENDIF PATCH_GH} end; end; { FOR Y } end; { FOR X } @@ -2203,6 +3087,9 @@ begin AReq.FXType := FX_DoDamage; AReq.Target := Nil; AReq.Originator := Nil; +{$IFDEF PATCH_GH} + AReq.Attacker := NIL; +{$ENDIF PATCH_GH} AReq.Weapon := Nil; AReq.AF.CantCallShot := True; AReq.AF.CanDodge := True; @@ -2246,7 +3133,11 @@ begin SceneryChewing( GB, X, Y,AReq.FXDice, True , AReq.AF.AtAt ); +{$IFDEF PATCH_GH} + Add_Point_Animation( X, Y, TerrMan[GB^.Map[X,Y].terr].altitude, GS_AreaAttack , '' ); +{$ELSE PATCH_GH} Add_Point_Animation( X, Y, TerrMan[GB^.Map[X,Y].terr].altitude, GS_AreaAttack ); +{$ENDIF PATCH_GH} end; end; { FOR Y } end; { FOR X } @@ -2262,7 +3153,15 @@ var Rng,T,N,TT: Integer; Mek: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('DoLineAttack','fires'), PilotName(FindMaster(Attacker)), GearName(Attacker) ); +{$ELSE PATCH_I18N} msg := PilotName( FindMaster( Attacker ) ) + ' fires ' + GearName( Attacker ) + '.'; +{$ENDIF PATCH_I18N} RecordAnnouncement( msg ); Inc( EFFECTS_Event_Order ); @@ -2297,7 +3196,11 @@ begin end; end; +{$IFDEF PATCH_GH} + Add_Point_Animation( P.X, P.Y, P.Z, GS_AreaAttack , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Point_Animation( P.X, P.Y, P.Z, GS_AreaAttack ); +{$ENDIF PATCH_GH} if TileBlocksLOS( GB , P.X , P.Y , P.Z ) then T := rng; end; end; @@ -2305,7 +3208,11 @@ begin Inc( EFFECTS_Event_Order ); end; +{$IFDEF PATCH_GH} +Procedure DoSTCAttack( GB: GameBoardPtr; Attacker, Ammo: GearPtr; X,Y,AtOp,AMod: Integer; AtAt: String ); +{$ELSE PATCH_GH} Procedure DoSTCAttack( GB: GameBoardPtr; Attacker: GearPtr; X,Y,AtOp,AMod: Integer; AtAt: String ); +{$ENDIF PATCH_GH} { Perform a non-damaging STC attack. } { Instead of doing damage, this attack will produce a number of STC items on the gameboard. } var @@ -2314,8 +3221,20 @@ var X2,Y2,N,T,AtOp2,R: Integer; AP,OP: Point; SRS: NAttPtr; { Side Reaction Score. } -begin +{$IFDEF PATCH_GH} + Ammo_default: Boolean; + Ammo_Desig: String; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('DoSTCAttack','fires'), PilotName(FindMaster(Attacker)), GearName(Attacker) ); +{$ELSE PATCH_I18N} msg := PilotName( FindMaster( Attacker ) ) + ' fires ' + GearName( Attacker ) + '.'; +{$ENDIF PATCH_I18N} RecordAnnouncement( msg ); ClearStencil; @@ -2329,14 +3248,22 @@ begin { Depending on what other attack attributes this weapon has, fill the stencil. } if AtOp > 0 then begin Stencil[ X , Y ] := True; +{$IFDEF PATCH_GH} + Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z ); +{$ENDIF PATCH_GH} for t := 1 to AtOp do begin X2 := X + Random( 4 ) - Random( 4 ); Y2 := Y + Random( 4 ) - Random( 4 ); if OnTheMap( X2 , Y2 ) then begin Stencil[ X2 , Y2 ] := True; +{$IFDEF PATCH_GH} + Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z ); +{$ENDIF PATCH_GH} end; end; end else if HasAttackAttribute( AtAt , AA_BlastAttack ) then begin @@ -2346,7 +3273,11 @@ begin { Generate the blast stencil. } DrawBlastEffect( GB , X , Y , MekAltitude( GB , FindRoot( Attacker ) ) , R ); +{$IFDEF PATCH_GH} + Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z ); +{$ENDIF PATCH_GH} end else if HasAttackAttribute( AtAt , AA_LineAttack ) then begin T := 0; r := ( WeaponRange( GB , Attacker ) * 2 ) div 3; @@ -2355,14 +3286,22 @@ begin OP := SolveLine( AP.X , AP.Y , AP.Z , X , Y , AP.Z , T ); if OnTheMap( OP.X , OP.Y ) then begin Stencil[ OP.X , OP.Y ] := True; +{$IFDEF PATCH_GH} + Add_Point_Animation( OP.X, OP.Y, OP.Z, GS_AreaAttack , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Point_Animation( OP.X, OP.Y, OP.Z, GS_AreaAttack ); +{$ENDIF PATCH_GH} if TileBlocksLOS( GB , OP.X , OP.Y , OP.Z ) then T := r; end; end; end else begin Stencil[ X , Y ] := True; +{$IFDEF PATCH_GH} + Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Shot_Precisely( GB , AP.X , AP.Y , AP.Z , OP.X , OP.Y , OP.Z ); +{$ENDIF PATCH_GH} end; { Next, actually add the items. } @@ -2375,6 +3314,19 @@ begin Proto^.Stat[ STAT_CloudDuration ] := Attacker^.V * 5; Proto^.Scale := Attacker^.Scale; end else if HasAttackAttribute( AtAt , AA_Drone ) then begin +{$IFDEF PATCH_GH} + Ammo_default := True; + Ammo_Desig := ''; + if NIL <> Ammo then begin + Ammo_default := False; + Ammo_Desig := SAttValue( Ammo^.SA , 'DESIG' ); + end; + if 0 = Length(Ammo_Desig) then begin + Ammo_default := True; + Ammo_Desig := 'DRONE-1'; + end; +{$ENDIF PATCH_GH} + { Step one- decide on the team for our drones! } R := NAttValue( FindRoot( ATtacker )^.NA , NAG_Location , NAS_Team ); if ( R = NAV_DefPlayerTeam ) or ( R = NAV_LancemateTeam ) then begin @@ -2384,8 +3336,16 @@ begin end; { Finally, load and initialize the drone itself. } +{$IFDEF PATCH_GH} + Proto := LoadNewSTC( Ammo_Desig ); + if NIL = Proto then Exit; + if Ammo_default then begin + Rescale( Proto , Attacker^.Scale ); + end; +{$ELSE PATCH_GH} Proto := LoadNewSTC( 'DRONE-1' ); Rescale( Proto , Attacker^.Scale ); +{$ENDIF PATCH_GH} SetNAtt( Proto^.NA , NAG_Skill , 6 , Attacker^.V div 2 ); SetNAtt( Proto^.NA , NAG_Skill , 10 , ( Attacker^.V + 1 ) div 2 ); SetNAtt( Proto^.NA , NAG_Location , NAS_Team , T ); @@ -2415,11 +3375,44 @@ end; Procedure PostAttackCleanup( GB: GameBoardPtr; Attacker: GearPtr; TX,TY,TZ: Integer ); { Deal with whatever needs to be dealt with. } +{$IFDEF PATCH_CHEAT} + Function SeekPartAlongTrack( P: GearPtr ): Integer; + var + ret: Integer; + begin + ret := 0; + while ( NIL <> P ) do begin + if NotDestroyed( P ) then begin + if ( GG_Support = P^.G ) and ( GS_Engine = P^.S ) then begin + if ( EST_HighOutput = P^.Stat[ STAT_EngineSubType ] ) then begin + ret := ret + P^.V * 2; + end else begin + ret := ret + P^.V; + end; + end else if ( GG_Cockpit = P^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + ; + end else begin + ret := ret + SeekPartAlongTrack( P^.SubCom ); + end; + end; + P := P^.Next; + end; + SeekPartAlongTrack := ret; + end; +{$ENDIF PATCH_CHEAT} var Master,Engine: GearPtr; P: Point; OverLoad,T: Integer; -begin +{$IFDEF PATCH_GH} + num: Integer; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + Master := FindRoot( Attacker ); P.X := TX; P.Y := TY; @@ -2431,16 +3424,37 @@ begin if HasAttackAttribute( WeaponAttackAttributes( Attacker ) , AA_Hyper ) then OverLoad := OverLoad * 3; if HasAreaEffect( Attacker ) then OverLoad := OverLoad * 2; if Master^.Scale > Attacker^.Scale then for t := 1 to ( Master^.Scale - Attacker^.Scale ) do Overload := Overload div 4; +{$IFDEF PATCH_CHEAT} + if ( '' <> SAttValue(Master^.SA,SATT_CUSTOM_ENGINE) ) then begin + OverLoad := OverLoad - SeekPartAlongTrack( Master^.SubCom ); + end else if Cheat_MechaCustomize_FreeSupport then begin + Engine := SeekGear( Master , GG_Support , GS_Engine ); + if Engine <> Nil then begin + if EST_HighOutput = Engine^.Stat[ STAT_EngineSubType ] then Overload := Overload div 2; + OverLoad := OverLoad - Engine^.V; + end else begin + OverLoad := OverLoad - 0; + end; + end else begin +{$ENDIF PATCH_CHEAT} Engine := SeekGear( Master , GG_Support , GS_Engine ); if ( Engine <> Nil ) and ( Engine^.Stat[ STAT_EngineSubType ] = EST_HighOutput ) then Overload := Overload div 2; OverLoad := OverLoad - Master^.V; +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} if OverLoad < 1 then OverLoad := 1; AddNAtt( Master^.NA , NAG_Condition , NAS_Overload , OverLoad ); end; end; if HasAttackAttribute( WeaponAttackAttributes( Attacker ) , AA_STRAIN ) and ( Master <> Nil ) then AddStaminaDown( Master , 10 ); +{$IFDEF PATCH_GH} + num := HasAttackAttributeNum( WeaponAttackAttributes( Attacker ) , AA_COMPLEX ); + if ( 0 < num ) and ( Master <> Nil ) then AddMentalDown( Master , num ); +{$ELSE PATCH_GH} if HasAttackAttribute( WeaponAttackAttributes( Attacker ) , AA_COMPLEX ) and ( Master <> Nil ) then AddMentalDown( Master , 10 ); +{$ENDIF PATCH_GH} { If the weapon was thrown, deal with that here. } if MustBeThrown( GB , Master , Attacker , P.X , P.Y ) then begin @@ -2473,7 +3487,11 @@ begin end; end else begin Inc( EFFECTS_Event_Order ); +{$IFDEF PATCH_GH} + Add_Shot_Precisely( GB , TX , TY , TZ , NAttValue( Master^.NA , NAG_Location , NAS_X ) , NAttValue( Master^.NA , NAG_Location , NAS_Y ) , MekALtitude( GB , Master ) , GearSAttValue( Attacker , SDL_PointAnimation ) ); +{$ELSE PATCH_GH} Add_Shot_Precisely( GB , TX , TY , TZ , NAttValue( Master^.NA , NAG_Location , NAS_X ) , NAttValue( Master^.NA , NAG_Location , NAS_Y ) , MekALtitude( GB , Master ) ); +{$ENDIF PATCH_GH} end; end; @@ -2490,7 +3508,14 @@ Procedure DoAttack( GB: GameBoardPtr; At var AtAt: String; Master: GearPtr; +{$IFDEF PATCH_GH} + Ammo: GearPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Attacker) or (Attacker^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + ClearAttackHistory; { Attack attributes must be determined before the attack is cleared, } @@ -2499,15 +3524,28 @@ begin AtAt := WeaponAttackAttributes( Attacker ); { Clear the weapon for usage. } - if ClearAttack( GB , Attacker , AtOp ) then begin +{$IFDEF PATCH_GH} + if ClearAttack( GB , Attacker , Ammo , AtOp ) then +{$ELSE PATCH_GH} + if ClearAttack( GB , Attacker , AtOp ) then +{$ENDIF PATCH_GH} + begin +{$IFDEF PATCH_GH} + if (NIL <> Target) and (GG_DisposeGear < Target^.G) then begin +{$ELSE PATCH_GH} if Target <> Nil then begin +{$ENDIF PATCH_GH} X := NAttValue( FindRoot( Target )^.NA , NAG_LOcation , NAS_X ); Y := NAttValue( FindRoot( Target )^.NA , NAG_LOcation , NAS_Y ); Z := MekAltitude( GB , FindRoot( Target ) ); end; if NonDamagingAttack( AtAt ) then begin +{$IFDEF PATCH_GH} + DoSTCAttack( GB , Attacker , Ammo , X , Y , AtOp , AMod , AtAt ); +{$ELSE PATCH_GH} DoSTCAttack( GB , Attacker , X , Y , AtOp , AMod , AtAt ); +{$ENDIF PATCH_GH} end else if HasAttackAttribute( AtAt , AA_SwarmAttack ) then begin DoSwarmAttack( GB , Attacker , X , Y , AtOp , AMod , AtAt ); end else if HasAttackAttribute( AtAt , AA_BlastAttack ) then begin @@ -2534,16 +3572,27 @@ begin end; end; +{$IFDEF PATCH_GH} +Procedure HandleEffectString( GB: GameBoardPtr; Attacker,Target: GearPtr; FX_String,FX_Desc: String ); +{$ELSE PATCH_GH} Procedure HandleEffectString( GB: GameBoardPtr; Target: GearPtr; FX_String,FX_Desc: String ); +{$ENDIF PATCH_GH} { An effect has been triggered. Do the required operations, then } { store the effects in the effect list. } var EReq: EffectRequest; begin +{$IFDEF PATCH_GH} + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Target := NIL; +{$ENDIF PATCH_GH} + ClearAttackHistory; EReq.FXType := ExtractValue( FX_String ); EReq.Originator := Nil; +{$IFDEF PATCH_GH} + EReq.Attacker := Attacker; +{$ENDIF PATCH_GH} EReq.Weapon := Nil; EReq.Target := Target; EReq.TX := NAttValue( FindRoot( Target )^.NA , NAG_Location , NAS_X ); @@ -2566,15 +3615,37 @@ begin end; + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: effects.pp'); +{$ENDIF DEBUG} { Set the history list to 0, for now. } ATTACK_History := Nil; EFFECTS_Event_Order := 0; +{$IFDEF PATCH_GH} + ATTACK_AMaster := NIL; + ATTACK_TMaster := NIL; + ATTACK_TMasterOK := False; + ATTACK_TPilot := NIL; + ATTACK_TPilotOK := False; + Attach_SmartPointer( 'ATTACK_History: SAttPtr', @ATTACK_History ); + Attach_SmartPointer( 'ATTACK_AMaster: GearPtr', @ATTACK_AMaster ); + Attach_SmartPointer( 'ATTACK_TMaster: GearPtr', @ATTACK_TMaster ); + Attach_SmartPointer( 'ATTACK_TPilot: GearPtr', @ATTACK_TPilot ); +{$ENDIF PATCH_GH} FX_Messages := LoadStringList( Effects_Message_File ); +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: effects.pp(finalization)'); +{$ENDIF DEBUG} DisposeSAtt( FX_Messages ); DisposeSAtt( ATTACK_History ); +end; end. diff -x .svn -uprN GearHead1100repository.original/errmsg.pp branches/errmsg.pp --- GearHead1100repository.original/errmsg.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/errmsg.pp 2009-08-15 02:47:28.237904000 +0900 @@ -0,0 +1,197 @@ +{$IFDEF PATCH_GH} +unit errmsg; +{ Display the Error Message(s) to appropriate device. } + +interface + + +Procedure ErrorMessage_fork( const msg: String ); +Procedure ErrorMessage( const msg: String ); + + + +implementation + +{$IFDEF HAVE_NO_TERMINAL} + {$IFDEF Windows} + {$DEFINE WIN_USE_DEBUGGEROUTPUT} + {$DEFINE WIN_MUST_CREATE_CONSOLEWINDOW} + {$IFDEF WIN_USE_WRITECONSOLE} + {$ELSE WIN_USE_WRITECONSOLE} + {$DEFINE HAVE_TERMINAL} + {$ENDIF WIN_USE_WRITECONSOLE} + {$ENDIF Windows} +{$ENDIF HAVE_NO_TERMINAL} + +{ "sysutils" has to come before others. } +uses sysutils, +{$IFDEF WIN_MUST_CREATE_CONSOLEWINDOW} + windows + {$IFDEF SDLMODE} + ,w32 + {$ENDIF SDLMODE} + ; +{$ELSE WIN_MUST_CREATE_CONSOLEWINDOW} + dos; + {$DEFINE HAVE_TERMINAL} +{$ENDIF WIN_MUST_CREATE_CONSOLEWINDOW} + + +const + LOGFILE = 'debug.log'; + + +var + FP: Text; + FP_ready: Boolean = False; +{$IFDEF WIN_MUST_CREATE_CONSOLEWINDOW} + Console_stderr: Handle; + Console_HWND: Windows.HWND; +{$ENDIF WIN_MUST_CREATE_CONSOLEWINDOW} + + +{$IFDEF WIN_MUST_CREATE_CONSOLEWINDOW} +Function InitializeConsole(): Boolean; +const + title = 'GearHead ErrorMessages'#0; + cmsgLen = 255; +var + cmsg: Array[0..cmsgLen] of Char; +begin + if Windows.AllocConsole() then begin + Windows.SetConsoleTitle( title ); + Windows.GetConsoleTitle( cmsg, cmsgLen-1 ); cmsg[cmsgLen] := #0; + + { Connect handles to the console window. } + Console_stderr := Windows.GetStdHandle( Windows.STD_ERROR_HANDLE ); + {$IFDEF FPC} + System.IsConsole := True; + System.SysInitStdIO(); + {$ENDIF FPC} + + { Wait, until open the console window. } + repeat + Windows.sleep(0); + { In MS-Windows, the order of sleep is mili-second, not second. } + Console_HWND := Windows.FindWindow( NIL, cmsg ); + until Console_HWND <> 0; + end; + InitializeConsole := True; +end; +{$ENDIF WIN_MUST_CREATE_CONSOLEWINDOW} + + +Procedure ErrorMessage_fork( const msg: String ); +{$IFDEF Windows} +var + cmsg: Array[0..255] of Char; + {$IFDEF WIN_USE_WRITECONSOLE} + dw: LongWord; + {$ENDIF WIN_USE_WRITECONSOLE} +{$ENDIF Windows} +begin +{$IFDEF WIN_USE_DEBUGGEROUTPUT} + StrPCopy( cmsg, msg ); + Windows.OutputDebugString( cmsg ); +{$ENDIF WIN_USE_DEBUGGEROUTPUT} + +{$IFDEF DEBUG} + if FP_ready then begin + WriteLn( FP, msg ); + Flush( FP ); + end else begin + WriteLn( stderr, msg ); + Flush( stderr ); + end; +{$ELSE DEBUG} + {$IFDEF WIN_MUST_CREATE_CONSOLEWINDOW} + InitializeConsole(); + {$ENDIF WIN_MUST_CREATE_CONSOLEWINDOW} + {$IFDEF HAVE_TERMINAL} + WriteLn( stderr, msg ); + {$ENDIF HAVE_TERMINAL} + {$IFDEF WIN_USE_WRITECONSOLE} + StrPCopy( cmsg, msg + #$0a ); + Windows.WriteConsole( Console_stderr, @cmsg,Length(msg)+1, dw, NIL ); + {$ENDIF WIN_USE_WRITECONSOLE} +{$ENDIF DEBUG} +end; + + +Procedure ErrorMessage( const msg: String ); +{$IFDEF Windows} +var + cmsg: Array[0..255] of Char; + {$IFDEF WIN_USE_WRITECONSOLE} + dw: LongWord; + {$ENDIF WIN_USE_WRITECONSOLE} + {$IFDEF WIN_MUST_CREATE_CONSOLEWINDOW} + pwnd: Windows.HWND; + {$ENDIF WIN_MUST_CREATE_CONSOLEWINDOW} +{$ENDIF Windows} +begin +{$IFDEF WIN_USE_DEBUGGEROUTPUT} + StrPCopy( cmsg, msg ); + Windows.OutputDebugString( cmsg ); +{$ENDIF WIN_USE_DEBUGGEROUTPUT} + +{$IFDEF DEBUG} + if FP_ready then begin + WriteLn( FP, msg ); + Flush( FP ); + end else begin + WriteLn( stderr, msg ); + Flush( stderr ); + end; +{$ELSE DEBUG} + {$IFDEF WIN_MUST_CREATE_CONSOLEWINDOW} + InitializeConsole(); + {$ENDIF WIN_MUST_CREATE_CONSOLEWINDOW} + {$IFDEF HAVE_TERMINAL} + WriteLn( stderr, msg ); + {$ENDIF HAVE_TERMINAL} + {$IFDEF WIN_USE_WRITECONSOLE} + StrPCopy( cmsg, msg + #$0a ); + Windows.WriteConsole( Console_stderr, @cmsg,Length(msg)+1, dw, NIL ); + {$ENDIF WIN_USE_WRITECONSOLE} +{$ENDIF DEBUG} + +{$IFDEF WIN_MUST_CREATE_CONSOLEWINDOW} + StrPCopy( cmsg, msg ); +{$IFDEF SDLMODE} + pwnd := w32.GetSDLHWND(); +{$ELSE SDLMODE} + pwnd := 0; +{$ENDIF SDLMODE} + Windows.MessageBox( pwnd, cmsg, 'ERROR'#0, MB_OK ); +{$ENDIF WIN_MUST_CREATE_CONSOLEWINDOW} +end; + + + +initialization +begin +{$IFDEF DEBUG} + Assign( FP, LOGFILE ); + {$i-} + Append( FP ); + {$i+} + if 0 <> IoResult then begin + Rewrite( FP ); + end; + FP_ready := True; + ErrorMessage_fork('DEBUG: errmsg.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: errmsg.pp(finalization)'); + FP_ready := False; + Close( FP ); +{$ENDIF DEBUG} +end; + +end. +{$ENDIF PATCH_GH} diff -x .svn -uprN GearHead1100repository.original/factory.pp branches/factory.pp --- GearHead1100repository.original/factory.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/factory.pp 2009-08-15 03:21:16.378749000 +0900 @@ -29,7 +29,11 @@ Procedure CreateNewMecha; implementation -uses ghmecha,ghmodule,ghsupport; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + ghmecha,ghmodule,ghsupport; const FMI_SetName = 1; @@ -45,7 +49,11 @@ Function SelectMechaForm: Integer; msg: String; begin msg := FormName[ T ]; +{$IFDEF PATCH_I18N} + while WidthMBCharStr( msg ) < 15 do msg := msg + ' '; +{$ELSE} while Length( msg ) < 15 do msg := msg + ' '; +{$ENDIF} FormMenuItem := msg + ' [ ' + SgnStr( FormMVBonus[ T ] ) + ' MV / ' + SgnStr( FormTRBonus[ T ] ) + ' TR ]'; end; var @@ -93,6 +101,9 @@ Procedure SetMechaSAtt( Mek: GearPtr; la var info: String; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} info := GetStringFromUser( ReplaceHash( MsgString( 'FACTORY_GetSAtt' ) , label ) ); if info <> '' then SetSATt( Mek^.SA , label + ' <' + info + '>' ); end; @@ -101,6 +112,10 @@ Function SelectPartToAdd( Mek: GearPtr ) { Select a part to add to this mecha. Return a pointer to the } { new part, which must then be linked into the mecha somewhere. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { First, decide whether to add a weapon, module, movesys, or } { sensor. } @@ -114,7 +129,14 @@ Procedure AddPartToMecha( Mek: GearPtr ) var Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + Part := SelectPartToAdd( Mek ); +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} end; @@ -126,6 +148,10 @@ var PartMenu,ControlMenu: RPGMenuPtr; A: Integer; { Action } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + PartMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Factory_Parts ); BuildGearMenu( PartMenu , Mek ); DisplayGearInfo( Mek ); @@ -207,4 +233,20 @@ begin DisposeGear( Mek ); end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: factory.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: factory.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/gears.pp branches/gears.pp --- GearHead1100repository.original/gears.pp 2013-02-08 10:00:00.000000000 +0900 +++ branches/gears.pp 2015-07-31 09:01:00.000000000 +0900 @@ -25,6 +25,13 @@ unit gears; interface +{$IFDEF PATCH_GH} +uses gears_base; +{$ENDIF PATCH_GH} +{$IF 0} { PATCH_GH} +uses classes; +{$ENDIF 0} { PATCH_GH} + Const NumGearStats = 8; {The number of STAT slots} {in a GEAR record} @@ -32,6 +39,12 @@ Const { In general, negative G scores denote abstract things. } { Vitual gears are not subject to most game rules, range } { checking, and whatnot. } +{$IFDEF PATCH_GH} + { GG_Disposed = -32768;} { Gear was real disposed. This flag is existed to detect improper memory accesses. } + GG_DisposeGear = -32767; { Gear was disposed, but real dispose is delayed to avoid improper memory accesses. } + NAG_DisposeNA = -32767; { NAtt was disposed, but real dispose is delayed to avoid improper memory accesses. } + NAS_DisposeNA = -32767; { NAtt was disposed, but real dispose is delayed to avoid improper memory accesses. } +{$ENDIF PATCH_GH} GG_Story = -10; GG_Plot = -9; GG_MapFeature = -8; { Something that should be placed on the random map; subcom of SCENE. } @@ -113,6 +126,8 @@ Const NAG_Prefrences = 15; NAS_DefAtOp = 0; { Default Attack Option } +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} { ******************************* } { *** FILE NAME CONSTANTS *** } { ******************************* } @@ -163,22 +178,58 @@ Const RandMaps_Param_File = Data_Directory + 'randmaps.txt'; NPC_Chatter_File = Data_Directory + 'taunts.txt'; +{$IFDEF PATCH_I18N} + I18N_Settings_File = Data_Directory + 'I18N_settings.txt'; + I18N_Name_File = Data_Directory + 'I18N_name.txt'; + I18N_Messages_File = Data_Directory + 'I18N_messages.txt'; + I18N_Help_Keymap_Name_File = Data_Directory + 'i18n_keymap_name.txt'; + I18N_Help_Keymap_Desc_File = Data_Directory + 'i18n_keymap_desc.txt'; +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_I18N} + I18N_NPC_GenderTraits_File1 = Data_Directory + 'i18n_pgt_t_m1.txt'; + I18N_NPC_GenderTraits_File2 = Data_Directory + 'i18n_pgt_t_f1.txt'; + I18N_NPC_FirstPerson_File1 = Data_Directory + 'i18n_pgt_fp_m.txt'; + I18N_NPC_FirstPerson_File2 = Data_Directory + 'i18n_pgt_fp_f.txt'; + I18N_NPC_SecondPerson_File1 = Data_Directory + 'i18n_pgt_sp_m.txt'; + I18N_NPC_SecondPerson_File2 = Data_Directory + 'i18n_pgt_sp_f.txt'; + I18N_Standard_Modifier_File = Data_Directory + 'i18n_modifier.txt'; +{$ENDIF PATCH_I18N} + Doc_DirName = 'doc'; Doc_Directory = Doc_DirName + OS_Dir_Separator; +{$IFDEF PATCH_I18N} + Mecha_Help_File = Doc_Directory + 'i18n_man_umek.txt'; + FieldHQ_Help_File = Doc_Directory + 'i18n_man_mecha.txt'; + Chara_Help_File = Doc_Directory + 'i18n_man_chara.txt'; +{$ELSE PATCH_I18N} Mecha_Help_File = Doc_Directory + 'man_umek.txt'; FieldHQ_Help_File = Doc_Directory + 'man_mecha.txt'; Chara_Help_File = Doc_Directory + 'man_chara.txt'; +{$ENDIF PATCH_I18N} Config_File = 'arena.cfg'; -{$IFDEF SDLMODE} +{$IFDEF PATCH_CHEAT} + Graphics_DirName = 'Image'; + Graphics_Directory = Graphics_Dirname + OS_Dir_Separator; +{$ELSE PATCH_CHEAT} + {$IFDEF SDLMODE} Graphics_DirName = 'Image'; Graphics_Directory = Graphics_Dirname + OS_Dir_Separator; + {$ENDIF} +{$ENDIF PATCH_CHEAT} + +{$IFDEF ENABLE_ADDRESSBOOK} + Save_Campaign_AddressBook_Base = Save_Game_Directory + 'PHONE'; {$ENDIF} STARTUP_OK: Boolean = True; +{$ENDIF PATCH_GH} Type +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} SAttPtr = ^SAtt; SAtt = Record {*** STRING ATTRIBUTE ***} info: String; @@ -191,6 +242,7 @@ Type V: LongInt; next: NAttPtr; end; +{$ENDIF PATCH_GH} GearPtr = ^gear; gear = Record {*** GEARHEAD BIT ***} @@ -211,7 +263,40 @@ Type parent: GearPtr; {Parent of the current Gear.} end; - +{$IF 0} { PATCH_GH} + TCheckAlongPath = class + private + TopDown: Boolean; { True -> TopDown, False -> BottomUp } + Ignore_GG_DisposeGear: Boolean; + Procedure CheckAlongPath( var LList: GearPtr; Part: GearPtr ); + Procedure CheckAlongPath_RootOne( var LList: GearPtr; Part: GearPtr ); + protected + Interrupt_Execution: Boolean; + public + Procedure CheckAlongPath( var LList: GearPtr; TopDown_arg, Ignore_GG_DisposeGear_arg: Boolean ); + Procedure CheckAlongPath_RootOne( var LList: GearPtr; TopDown_arg, Ignore_GG_DisposeGear_arg: Boolean ); + Procedure SubProc( var LList: GearPtr; Part: GearPtr ); virtual; + end; +{$ENDIF 0} { PATCH_GH} + +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} +var + DEBUG_DONOT_NIL_Grabbed_Gear_when_NewGear : Boolean = False; + DEBUG_DONOT_NIL_Grabbed_Gear_when_DisposeGear : Boolean = False; + DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_AbsolutelyNothing : Boolean = False; + DEBUG_DONOT_NIL_Grabbed_Gear_when_Mark_GG_DisposeGear : Boolean = False; + DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_DisposeGear : Boolean = False; + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Procedure PurgeSAtt( var LList_arg: SAttPtr ); +Procedure RemoveSAtt( LList, LMember: SAttPtr ); +Function SetSAtt(var LList: SAttPtr; const Info: String): SAttPtr; +Function AddSAtt( var LList: SAttPtr; const S_Label_in,S_Data: String ): SAttPtr; +Function GearSAttValue( Part: GearPtr; const Code: String): String; +{$ELSE PATCH_GH} Function CreateSAtt(var LList: SAttPtr): SAttPtr; Procedure DisposeSAtt(var LList: SAttPtr); Procedure RemoveSAtt(var LList,LMember: SAttPtr); @@ -220,10 +305,20 @@ Function SetSAtt(var LList: SAttPtr; con Function StoreSAtt(var LList: SAttPtr; const Info: String): SAttPtr; Function AddSAtt( var LList: SAttPtr; const S_Label_in,S_Data: String ): SAttPtr; Function SAttValue(LList: SAttPtr; const Code: String): String; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} +Function SAttValueToInt(LList: SAttPtr; const Code: String): Integer; +{$ENDIF PATCH_CHEAT} function NumSAtts( GList: SAttPtr ): Integer; function RetrieveSAtt( List: SAttPtr; N: Integer ): SAttPtr; +{$IFDEF PATCH_GH_PARANOID_SAFER} +function SelectRndxSAtt( SAList: SAttPtr ): SAttPtr; +{$ENDIF PATCH_GH_PARANOID_SAFER} function SelectRandomSAtt( SAList: SAttPtr ): SAttPtr; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Function LoadStringList( const FName_In: String ): SAttPtr; +{$ENDIF PATCH_GH} Procedure SaveStringList( const FName: String; SList: SattPtr ); Procedure ExpandFileList( var FList: SAttPtr; const P: String ); Function CreateFileList( const P: String ): SAttPtr; @@ -232,22 +327,44 @@ Function NumHeadMatches( const head_in: Function FindHeadMatch( const head_in: String; LList: SAttPtr; N: Integer ): SAttPtr; Function CreateNAtt(var LList: NAttPtr): NAttPtr; +{$IFDEF PATCH_GH} +Procedure DisposeNAtt( var LList_arg: NAttPtr ); +Procedure PurgeNAtt( var LList_arg: NAttPtr ); +Procedure RemoveNAtt( LList, LMember: NAttPtr ); +{$ELSE PATCH_GH} Procedure DisposeNAtt(var LList: NAttPtr); Procedure RemoveNAtt(var LList,LMember: NAttPtr); +{$ENDIF PATCH_GH} Function FindNAtt(LList: NAttPtr; G,S: Integer): NAttPtr; Function SetNAtt(var LList: NAttPtr; G,S: Integer; V: LongInt): NAttPtr; Function AddNAtt(var LList: NAttPtr; G,S: Integer; V: LongInt): NAttPtr; Function NAttValue(LList: NAttPtr; G,S: Integer): LongInt; Procedure StripNAtt( Part: GearPtr ; G: Integer ); +{$IFDEF PATCH_GH} +Procedure Purge_Att( LList: GearPtr ); + +Procedure Purge_GG_AbsolutelyNothing( var LList: GearPtr ); +Procedure Mark_GG_AbsolutelyNothing( Part: GearPtr ); +Procedure Purge_GG_DisposeGear( var LList: GearPtr ); +Procedure Mark_GG_DisposeGear( Part: GearPtr ); +Procedure Mark_GG_DisposeGear_withNext( Part: GearPtr ); +{$ENDIF PATCH_GH} Function LastGear(LList: GearPtr): GearPtr; Function NewGear( Parent: GearPtr ): GearPtr; Procedure AppendGear( var LList: GearPtr; It: GearPtr ); Function AddGear(var LList: GearPtr; Parent: GearPtr): GearPtr; +{$IFDEF PATCH_GH} +Procedure DisposeGear( var LList_arg: GearPtr ); +{$ELSE PATCH_GH} Procedure DisposeGear(var LList: GearPtr); +{$ENDIF PATCH_GH} Procedure RemoveGear(var LList,LMember: GearPtr); Procedure DelinkGear(var LList,LMember: GearPtr); function NumSiblingGears( GList: GearPtr ): Integer; +{$IFDEF PATCH_GH_PARANOID_SAFER} +function SelectRndxGear( GList: GearPtr ): GearPtr; +{$ENDIF PATCH_GH_PARANOID_SAFER} function SelectRandomGear( GList: GearPtr ): GearPtr; function FindRoot( Part: GearPtr ): GearPtr; @@ -260,7 +377,11 @@ Function IsInvCom( Part: GearPtr ): Bool Function CloneSAtt( SA: SAttPtr ): SAttPtr; Function CloneGear( Part: GearPtr ): GearPtr; +{$IFDEF PATCH_GH} +Function RetrieveGearSib( List: GearPtr; N: LongInt ): GearPtr; +{$ELSE PATCH_GH} Function RetrieveGearSib( List: GearPtr; N: Integer ): GearPtr; +{$ENDIF PATCH_GH} Procedure Rescale( Part: GearPtr; SF: Integer ); @@ -268,8 +389,25 @@ Procedure Rescale( Part: GearPtr; SF: In implementation { "sysutils" has to come before "dos" } -uses sysutils,dos,texutil; +uses sysutils,dos, +{$IFDEF PATCH_GH} + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} + texutil +{$IFDEF PATCH_GH_PARANOID_SAFER} + ,rnd +{$ENDIF PATCH_GH_PARANOID_SAFER} + ; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Function LastSAtt( LList: SAttPtr ): SAttPtr; { Find the last SAtt in this particular list. } begin @@ -285,6 +423,10 @@ var begin {Allocate memory for our new element.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('CreateSAtt() New',it); + CheckAndNIL_Pointer('CreateSAtt() New', it, True ); +{$ENDIF DEBUG} if it = Nil then exit( Nil ); it^.Next := Nil; @@ -299,6 +441,30 @@ begin CreateSAtt := it; end; +{$IFDEF PATCH_GH} +Procedure DisposeSAtt( var LList_arg: SAttPtr ); + {Dispose of the list, freeing all associated system resources.} +var + LList: SAttPtr; + LTemp: SAttPtr; +begin + LList := LList_arg; + LList_arg := NIL; + while LList <> Nil do begin + LTemp := LList^.Next; + {$IFDEF DEBUG} + Trace_MemoryLeak('DisposeSAtt() Dispose',LList); + {$ENDIF DEBUG} + CheckAndNIL_Pointer('DisposeSAtt() Dispose',LList,True); + {$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.info[1] := '@'; + LList^.Next := SAttPtr(-1); + {$ENDIF PATCH_GH_PARANOID_SAFER} + Dispose(LList); + LList := LTemp; + end; +end; +{$ELSE PATCH_GH} Procedure DisposeSAtt(var LList: SAttPtr); {Dispose of the list, freeing all associated system resources.} var @@ -310,7 +476,43 @@ begin LList := LTemp; end; end; +{$ENDIF PATCH_GH} +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Procedure PurgeSAtt( var LList_arg: SAttPtr ); +var + LLast: ^SAttPtr; + LList: SAttPtr; + LTemp: SAttPtr; +begin + LLast := @LList_arg; + LList := LList_arg; + while LList <> Nil do begin + LTemp := LList^.Next; + if '@' = LList^.info then begin + LLast^ := LTemp; + {$IFDEF DEBUG} + Trace_MemoryLeak('PurgeSAtt() Dispose',LList); + {$ENDIF DEBUG} + CheckAndNIL_Pointer('PurgeSAtt() Dispose',LList,True); + {$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.info[1] := '@'; + LList^.Next := SAttPtr(-1); + {$ENDIF PATCH_GH_PARANOID_SAFER} + Dispose(LList); + end else begin + LLast := @(LList^.Next); + end; + LList := LTemp; + end; +end; +Procedure RemoveSAtt( LList, LMember: SAttPtr ); +begin + LMember^.info := '@'; +end; +{$ELSE PATCH_GH} Procedure RemoveSAtt(var LList,LMember: SAttPtr); {Locate and extract member LMember from list LList.} {Then, dispose of LMember.} @@ -347,7 +549,10 @@ begin Dispose(B); end; end; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Function LabelsMatch( const info,code: String ): Boolean; { Return TRUE if UpCase( CODE ) matches UpCase( INFO ) all the } { way to the first '<', ignoring spaces and tabs. } @@ -393,6 +598,7 @@ begin FindSAtt := it; end; +{$ENDIF PATCH_GH} Function SetSAtt(var LList: SAttPtr; const Info: String): SAttPtr; {Add string attribute Info to the list. However, a gear} @@ -424,6 +630,8 @@ begin SetSAtt := it; end; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Function StoreSAtt(var LList: SAttPtr; const Info: String): SAttPtr; { Add string attribute Info to the list. This procedure } { doesn't check to make sure this attribute isn't duplicated. } @@ -436,6 +644,7 @@ begin {Return a pointer to the new attribute.} StoreSAtt := it; end; +{$ENDIF PATCH_GH} Function AddSAtt( var LList: SAttPtr; const S_Label_In,S_Data: String ): SAttPtr; { Store this data in the string attributes list with kind-of the } @@ -472,6 +681,23 @@ begin AddSAtt := SetSAtt( LList , S_Label + BStr( Max ) + ' <' + S_Data + '>' ); end; +{$IFDEF PATCH_GH} +Function GearSAttValue( Part: GearPtr; const Code: String): String; + {Find a String Attribute which corresponds to Code, then} + {return its embedded alligator string.} +var + LList: SAttPtr; + it: SAttPtr; +begin + if ( NIL = Part ) then Exit(''); + LList := Part^.SA; + + it := FindSAtt( LList , Code ); + if ( NIL = it ) then Exit(''); + + GearSAttValue := RetrieveAString( it^.info ); +end; +{$ELSE PATCH_GH} Function SAttValue(LList: SAttPtr; const Code: String): String; {Find a String Attribute which corresponds to Code, then} {return its embedded alligator string.} @@ -484,6 +710,22 @@ begin SAttValue := RetrieveAString(it^.info); end; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} +Function SAttValueToInt(LList: SAttPtr; const Code: String): Integer; +var + it: SAttPtr; + S: String; +begin + it := FindSAtt( LList , Code ); + if ( NIL = it ) then exit(0); + + S := RetrieveAString( it^.info ); + if ( '' = S ) then exit(0); + + SAttValueToInt := StrToInt(S); +end; +{$ENDIF PATCH_CHEAT} function NumSAtts( GList: SAttPtr ): Integer; { Count the number of sibling gears along this track. } @@ -492,7 +734,13 @@ var begin N := 0; while GList <> Nil do begin +{$IFDEF PATCH_GH} + if (0 < Length(GList^.info)) and ('@' <> GList^.info[1]) then begin + Inc( N ); + end; +{$ELSE PATCH_GH} Inc( N ); +{$ENDIF PATCH_GH} GList := GList^.Next; end; NumSAtts := N; @@ -506,15 +754,47 @@ begin if N < 1 then Exit( Nil ); { Search for the desired gear. } +{$IFDEF PATCH_GH} + while (NIL <> List) do begin + if (0 < Length(List^.info)) and ('@' <> List^.info[1]) then begin + Dec( N ); + if N <= 0 then begin + break; + end; + end; + List := List^.Next; + end; +{$ELSE PATCH_GH} while ( N > 1 ) and ( List <> Nil ) do begin Dec( N ); List := List^.Next; end; +{$ENDIF PATCH_GH} { Return the last gear found. } RetrieveSAtt := List; end; +{$IFDEF PATCH_GH_PARANOID_SAFER} +function SelectRndxSAtt( SAList: SAttPtr ): SAttPtr; + { Pick one of the string attributes from the provided } + { list at random. } +var + ST: SAttPtr; + N,T: Integer; +begin + { Count the number of SAtts total. } + ST := SAList; + N := NumSAtts( SAList ); + { Choose one randomly. } + if N > 0 then begin + T := rndx( N ) + 1; + ST := RetrieveSATt( SAList , T ); + end; + SelectRndxSAtt := ST; +end; +{$ENDIF PATCH_GH_PARANOID_SAFER} + function SelectRandomSAtt( SAList: SAttPtr ): SAttPtr; { Pick one of the string attributes from the provided } { list at random. } @@ -533,6 +813,8 @@ begin SelectRandomSAtt := ST; end; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Function LoadStringList( const FName_In: String ): SAttPtr; { Load a list of string attributes from the listed file, } { if it can be found. } @@ -560,6 +842,7 @@ begin end; LoadStringList := SList; end; +{$ENDIF PATCH_GH} Procedure SaveStringList( const FName: String; SList: SattPtr ); { Save a list of string attributes to the listed filename. } @@ -588,7 +871,11 @@ begin { As long as there are files which match our description, } { process them. } While DosError = 0 do begin +{$IFDEF PATCH_I18N} + StoreSAtt( FList , TextDecode(SRec.Name) ); +{$ELSE PATCH_I18N} StoreSAtt( FList , SRec.Name ); +{$ENDIF PATCH_I18N} { Look for the next file in the directory. } FindNext( SRec ); @@ -652,6 +939,10 @@ var begin {Allocate memory for our new element.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('CreateNAtt() New',it); + CheckAndNIL_Pointer('CreateNAtt() New', it,True); +{$ENDIF DEBUG} if it = Nil then exit( Nil ); {Initialize values.} @@ -663,6 +954,32 @@ begin CreateNAtt := it; end; +{$IFDEF PATCH_GH} +Procedure DisposeNAtt( var LList_arg: NAttPtr ); + {Dispose of the list, freeing all associated system resources.} +var + LList: NAttPtr; + LTemp: NAttPtr; +begin + LList := LList_arg; + LList_arg := NIL; + while LList <> Nil do begin + LTemp := LList^.Next; + {$IFDEF DEBUG} + Trace_MemoryLeak('DisposeNAtt() Dispose',LList); + {$ENDIF DEBUG} + CheckAndNIL_Pointer('DisposeNAtt() Dispose',LList,True); + {$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.G := -32768; { GG_Disposed } + LList^.S := -32768; + LList^.V := -32768; + LList^.Next := NAttPtr(-1); + {$ENDIF PATCH_GH_PARANOID_SAFER} + Dispose(LList); + LList := LTemp; + end; +end; +{$ELSE PATCH_GH} Procedure DisposeNAtt(var LList: NAttPtr); {Dispose of the list, freeing all associated system resources.} var @@ -674,7 +991,48 @@ begin LList := LTemp; end; end; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} +Procedure PurgeNAtt( var LList_arg: NAttPtr ); +var + LLast: ^NAttPtr; + LList: NAttPtr; + LTemp: NAttPtr; +begin + LLast := @LList_arg; + LList := LList_arg; + while LList <> Nil do begin + LTemp := LList^.Next; + if LList^.G <= NAG_DisposeNA then begin + LLast^ := LTemp; + {$IFDEF DEBUG} + Trace_MemoryLeak('PurgeNAtt() Dispose',LList); + {$ENDIF DEBUG} + CheckAndNIL_Pointer('PurgeNAtt() Dispose',LList,True); + {$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.G := -32768; { GG_Disposed } + LList^.S := -32768; + LList^.V := -32768; + LList^.Next := NAttPtr(-1); + {$ENDIF PATCH_GH_PARANOID_SAFER} + Dispose(LList); + end else begin + LLast := @(LList^.Next); + end; + LList := LTemp; + end; +end; + +Procedure RemoveNAtt( LList, LMember: NAttPtr ); +begin + LMember^.G := NAG_DisposeNA; + {$IFDEF PATCH_GH_PARANOID_SAFER} + LMember^.S := NAS_DisposeNA; + LMember^.V := -32768; + {$ENDIF PATCH_GH_PARANOID_SAFER} +end; +{$ELSE PATCH_GH} Procedure RemoveNAtt(var LList,LMember: NAttPtr); {Locate and extract member LMember from list LList.} {Then, dispose of LMember.} @@ -711,6 +1069,7 @@ begin Dispose(B); end; end; +{$ENDIF PATCH_GH} Function FindNAtt(LList: NAttPtr; G,S: Integer): NAttPtr; {Locate the numerical attribute described by G,S and} @@ -765,8 +1124,16 @@ Function AddNAtt(var LList: NAttPtr; G,S {If, as a result of this operation, V drops to 0,} {the numerical attribute will be removed and Nil will} {be returned.} +{$IFDEF PATCH_GH} +const + V_MAX = 2147483647; + V_MIN = -2147483648; +{$ENDIF PATCH_GH} var it: NAttPtr; +{$IFDEF PATCH_GH} + tmp: Int64; +{$ENDIF PATCH_GH} begin it := FindNAtt(LList,G,S); @@ -777,7 +1144,18 @@ begin it^.S := S; it^.V := V; end else begin +{$IFDEF PATCH_GH} + tmp := Int64(it^.V) + Int64(V); + if (V_MAX < tmp) then begin + it^.V := V_MAX; + end else if (tmp < V_MIN) then begin + it^.V := V_MIN; + end else begin + it^.V := tmp; + end; +{$ELSE PATCH_GH} it^.V := it^.V + V; +{$ENDIF PATCH_GH} end; if it^.V = 0 then RemoveNAtt(LList,it); @@ -829,10 +1207,323 @@ begin end; end; + + +{$IF 0} { PATCH_GH} +Procedure TCheckAlongPath.SubProc( var LList: GearPtr; Part: GearPtr ); +begin + ErrorMessage('ERROR: ***BUG*** TCheckAlongPath.SubProc()'); +end; + +Procedure TCheckAlongPath.CheckAlongPath( var LList: GearPtr; Part: GearPtr ); +var + next: GearPtr; +begin + while (NIL <> Part) do begin + next := Part^.Next; + + CheckAlongPath_RootOne( LList, Part ); + + if (Interrupt_Execution) then begin + break; + end; + Part := next; + end; +end; + +Procedure TCheckAlongPath.CheckAlongPath_RootOne( var LList: GearPtr; Part: GearPtr ); +var + child1, child2: GearPtr; +begin + if Ignore_GG_DisposeGear or (GG_DisposeGear < Part^.G) then begin + child1 := Part^.SubCom; + child2 := Part^.InvCom; + + if (TopDown) then begin + SubProc( LList, Part ); + end; + + if not(Interrupt_Execution) then begin + CheckAlongPath( Part^.SubCom, child1 ); + end; + if not(Interrupt_Execution) then begin + CheckAlongPath( Part^.InvCom, child2 ); + end; + + if not(TopDown) then begin + SubProc( LList, Part ); + end; + end; +end; + + +Procedure TCheckAlongPath.CheckAlongPath( var LList: GearPtr; TopDown_arg, Ignore_GG_DisposeGear_arg: Boolean ); +begin + TopDown := TopDown_arg; + Ignore_GG_DisposeGear := Ignore_GG_DisposeGear_arg; + Interrupt_Execution := False; + CheckAlongPath( LList, LList ); +end; + +Procedure TCheckAlongPath.CheckAlongPath_RootOne( var LList: GearPtr; TopDown_arg, Ignore_GG_DisposeGear_arg: Boolean ); +begin + TopDown := TopDown_arg; + Ignore_GG_DisposeGear := Ignore_GG_DisposeGear_arg; + Interrupt_Execution := False; + CheckAlongPath_RootOne( LList, LList ); +end; + + + +type + T_Purge_GG_AbsolutelyNothing_CheckAlongPath = class(TCheckAlongPath) + public + Procedure SubProc( var LList: GearPtr; Part: GearPtr ); override; + end; + Procedure T_Purge_GG_AbsolutelyNothing_CheckAlongPath.SubProc( var LList: GearPtr; Part: GearPtr ); + begin + if (GG_AbsolutelyNothing = Part^.G) then begin + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_AbsolutelyNothing then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('Purge_GG_AbsolutelyNothing()', Part, False ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + RemoveGear( LList, Part ); + end; + end; + +Procedure Purge_GG_AbsolutelyNothing( var LList: GearPtr ); +var + Obj: T_Purge_GG_AbsolutelyNothing_CheckAlongPath; + Part: GearPtr; +begin + Part := LList; + Obj := T_Purge_GG_AbsolutelyNothing_CheckAlongPath.Create; + Obj.CheckAlongPath( Part, False, True ); + Obj.Free; +end; + + +type + T_Mark_GG_AbsolutelyNothing_CheckAlongPath = class(TCheckAlongPath) + public + Procedure SubProc( var LList: GearPtr; Part: GearPtr ); override; + end; + Procedure T_Mark_GG_AbsolutelyNothing_CheckAlongPath.SubProc( var LList: GearPtr; Part: GearPtr ); + begin + Part^.G := GG_AbsolutelyNothing; + end; + +Procedure Mark_GG_AbsolutelyNothing( Part: GearPtr ); +var + Obj: T_Mark_GG_AbsolutelyNothing_CheckAlongPath; +begin + Obj := T_Mark_GG_AbsolutelyNothing_CheckAlongPath.Create; + Obj.CheckAlongPath_RootOne( Part, True, True ); + Obj.Free; +end; + + + +type + T_Purge_GG_DisposeGear_CheckAlongPath = class(TCheckAlongPath) + public + Procedure SubProc( var LList: GearPtr; Part: GearPtr ); override; + end; + Procedure T_Purge_GG_DisposeGear_CheckAlongPath.SubProc( var LList: GearPtr; Part: GearPtr ); + begin + if (Part^.G <= GG_DisposeGear) then begin + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_DisposeGear then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('Purge_GG_DisposeGear()', Part, True ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + RemoveGear( LList, Part ); + end; + end; + +Procedure Purge_GG_DisposeGear( var LList: GearPtr ); +var + Obj: T_Purge_GG_DisposeGear_CheckAlongPath; + Part: GearPtr; +begin + Part := LList; + Obj := T_Purge_GG_DisposeGear_CheckAlongPath.Create; + Obj.CheckAlongPath( Part, False, True ); + Obj.Free; +end; + + +type + T_Mark_GG_DisposeGear_CheckAlongPath = class(TCheckAlongPath) + public + Procedure SubProc( var LList: GearPtr; Part: GearPtr ); override; + end; + Procedure T_Mark_GG_DisposeGear_CheckAlongPath.SubProc( var LList: GearPtr; Part: GearPtr ); + begin + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_Mark_GG_DisposeGear then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('Mark_GG_DisposeGear()', Part, False ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + Part^.G := GG_DisposeGear; + end; + +Procedure Mark_GG_DisposeGear( Part: GearPtr ); +var + Obj: T_Mark_GG_DisposeGear_CheckAlongPath; +begin + Obj := T_Mark_GG_DisposeGear_CheckAlongPath.Create; + Obj.CheckAlongPath_RootOne( Part, True, True ); + Obj.Free; +end; +{$ENDIF 0} { PATCH_GH} +{$IFDEF PATCH_GH} +Procedure Purge_Att( LList: GearPtr ); +begin + while (NIL <> LList) do begin + Purge_Att( LList^.SubCom ); + Purge_Att( LList^.InvCom ); + + if NIL <> LList^.SA then PurgeSAtt( LList^.SA ); + if NIL <> LList^.NA then PurgeNAtt( LList^.NA ); + + LList := LList^.Next; + end; +end; + + + +Procedure Purge_GG_AbsolutelyNothing( var LList: GearPtr ); +var + Part, P2: GearPtr; +begin + Part := LList; + while (NIL <> Part) do begin + P2 := Part^.Next; + + Purge_GG_AbsolutelyNothing( Part^.SubCom ); + Purge_GG_AbsolutelyNothing( Part^.InvCom ); + + if (GG_AbsolutelyNothing = Part^.G) then begin + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_AbsolutelyNothing then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('Purge_GG_AbsolutelyNothing()', Part, False ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + RemoveGear( LList, Part ); + end; + + Part := P2; + end; +end; + +Procedure Mark_GG_AbsolutelyNothing( Part: GearPtr ); + Procedure CheckAlongPath( Part: GearPtr ); + begin + while (NIL <> Part) do begin + Part^.G := GG_AbsolutelyNothing; + + CheckAlongPath( Part^.SubCom ); + CheckAlongPath( Part^.InvCom ); + + Part := Part^.Next; + end; + end; +begin + Part^.G := GG_AbsolutelyNothing; + + CheckAlongPath( Part^.SubCom ); + CheckAlongPath( Part^.InvCom ); +end; + + +Procedure Purge_GG_DisposeGear( var LList: GearPtr ); +var + Part, P2: GearPtr; +begin + Part := LList; + while (NIL <> Part) do begin + P2 := Part^.Next; + + Purge_GG_DisposeGear( Part^.SubCom ); + Purge_GG_DisposeGear( Part^.InvCom ); + + if (Part^.G <= GG_DisposeGear) then begin + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_DisposeGear then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('Purge_GG_DisposeGear()', Part, True ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + RemoveGear( LList, Part ); + end else begin + if NIL <> Part^.SA then PurgeSAtt( Part^.SA ); + if NIL <> Part^.NA then PurgeNAtt( Part^.NA ); + end; + + Part := P2; + end; +end; + +Procedure Mark_GG_DisposeGear_withNext( Part: GearPtr ); +begin + while (NIL <> Part) do begin + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_Mark_GG_DisposeGear then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('Mark_GG_DisposeGear()', Part, False ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + Part^.G := GG_DisposeGear; + + Mark_GG_DisposeGear_withNext( Part^.SubCom ); + Mark_GG_DisposeGear_withNext( Part^.InvCom ); + + Part := Part^.Next; + end; +end; + +Procedure Mark_GG_DisposeGear( Part: GearPtr ); +begin + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_Mark_GG_DisposeGear then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('Mark_GG_DisposeGear()', Part, False ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} + Part^.G := GG_DisposeGear; + + Mark_GG_DisposeGear_withNext( Part^.SubCom ); + Mark_GG_DisposeGear_withNext( Part^.InvCom ); +end; +{$ENDIF PATCH_GH} + + + Function LastGear(LList: GearPtr): GearPtr; {Search through the linked list, and return the last element.} {If LList is empty, return Nil.} begin + { PATCH_GH: Don't kick out the GG_DisposeGear in this Function. } if LList <> Nil then while LList^.Next <> Nil do LList := LList^.Next; @@ -847,7 +1538,20 @@ var begin {Allocate memory for our new element.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('NewGear() New',it); +{$ENDIF DEBUG} if it = Nil then exit; +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_NewGear then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('NewGear()', it, True ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} {Initialize values.} it^.Next := Nil; @@ -890,12 +1594,34 @@ begin AddGear := it; end; +{$IFDEF PATCH_GH} +Procedure DisposeGear( var LList_arg: GearPtr ); +{$ELSE PATCH_GH} Procedure DisposeGear( var LList: GearPtr); +{$ENDIF PATCH_GH} {Dispose of the list, freeing all associated system resources.} var +{$IFDEF PATCH_GH} + LList: GearPtr; +{$ENDIF PATCH_GH} LTemp: GearPtr; begin +{$IFDEF PATCH_GH} + LList := LList_arg; + LList_arg := NIL; +{$ENDIF PATCH_GH} while LList <> Nil do begin +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} + if DEBUG_DONOT_NIL_Grabbed_Gear_when_DisposeGear then begin + end else begin + {$ENDIF DEBUG} + CheckAndNIL_Pointer('DisposeGear()', LList, False ); + {$IFDEF DEBUG} + end; + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} + LTemp := LList^.Next; {Dispose of all resources and children attached to this GEAR.} @@ -906,6 +1632,29 @@ begin DisposeGear( LList^.InvCom ); {Dispose of the GEAR itself.} +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeGear() Dispose',LList); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.G := -32768; { GG_Disposed } + LList^.S := -32768; + LList^.V := -32768; + LList^.Scale := -32768; + LList^.Stat[1] := -32768; + LList^.Stat[2] := -32768; + LList^.Stat[3] := -32768; + LList^.Stat[4] := -32768; + LList^.Stat[5] := -32768; + LList^.Stat[6] := -32768; + LList^.Stat[7] := -32768; + LList^.Stat[8] := -32768; + LList^.SA := SAttPtr(-1); + LList^.NA := NAttPtr(-1); + LList^.Next := GearPtr(-1); + LList^.SubCom := GearPtr(-1); + LList^.InvCom := GearPtr(-1); + LList^.Parent := GearPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(LList); LList := LTemp; end; @@ -932,7 +1681,11 @@ begin if B = Nil then begin {Major FUBAR. The member we were trying to remove can't} {be found in the list.} +{$IFDEF PATCH_GH} + ErrorMessage_fork('ERROR- RemoveGear asked to remove a link that doesnt exist.'); +{$ELSE PATCH_GH} writeln('ERROR- RemoveGear asked to remove a link that doesnt exist.'); +{$ENDIF PATCH_GH} end else if A = Nil then begin {There's no element before the one we want to remove,} @@ -970,7 +1723,11 @@ begin if B = Nil then begin {Major FUBAR. The member we were trying to remove can't} {be found in the list.} +{$IFDEF PATCH_GH} + ErrorMessage_fork('ERROR- DelinkGear asked to remove a link that doesnt exist.'); +{$ELSE PATCH_GH} writeln('ERROR- DelinkGear asked to remove a link that doesnt exist.'); +{$ENDIF PATCH_GH} end else if A = Nil then begin {There's no element before the one we want to remove,} @@ -996,12 +1753,57 @@ var begin N := 0; while GList <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < GList^.G) then begin + Inc( N ); + end; +{$ELSE PATCH_GH} Inc( N ); +{$ENDIF PATCH_GH} GList := GList^.Next; end; NumSiblingGears := N; end; +{$IFDEF PATCH_GH_PARANOID_SAFER} +function SelectRndxGear( GList: GearPtr ): GearPtr; + { Pick one of the sibling gears from the provided } + { list at random. } +var + ST: GearPtr; + N,T: Integer; +begin + { Count the number of gears total. } + N := NumSiblingGears( GList ); + + { Choose one randomly. } + if N > 0 then begin + T := rndx( N ) + 1; + ST := GList; + N := 1; +{$IFDEF PATCH_GH} + while (NIL <> ST) do begin + if (GG_DisposeGear < ST^.G) then begin + Inc( N ); + if (T < N) then begin + break; + end; + end; + ST := ST^.Next; + end; +{$ELSE PATCH_GH} + while N < T do begin + Inc( N ); + St := St^.Next; + end; +{$ENDIF PATCH_GH} + end else begin + ST := Nil; + end; + SelectRndxGear := ST; +end; +{$ENDIF PATCH_GH_PARANOID_SAFER} + function SelectRandomGear( GList: GearPtr ): GearPtr; { Pick one of the sibling gears from the provided } { list at random. } @@ -1017,10 +1819,22 @@ begin T := Random( N ) + 1; ST := GList; N := 1; +{$IFDEF PATCH_GH} + while (NIL <> ST) do begin + if (GG_DisposeGear < ST^.G) then begin + Inc( N ); + if (T < N) then begin + break; + end; + end; + ST := ST^.Next; + end; +{$ELSE PATCH_GH} while N < T do begin Inc( N ); St := St^.Next; end; +{$ENDIF PATCH_GH} end else begin ST := Nil; end; @@ -1034,6 +1848,9 @@ begin { Move the pointer up to either root level or the first Master parent. } while ( Part <> Nil ) and ( Part^.Parent <> Nil ) do Part := Part^.Parent; +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} FindRoot := Part; end; @@ -1141,7 +1958,11 @@ begin CloneGear := it; end; +{$IFDEF PATCH_GH} +Function RetrieveGearSib( List: GearPtr; N: LongInt ): GearPtr; +{$ELSE PATCH_GH} Function RetrieveGearSib( List: GearPtr; N: Integer ): GearPtr; +{$ENDIF PATCH_GH} { Find the address of the Nth sibling gear in this list. } { If no such gear exists, return Nil. } begin @@ -1150,10 +1971,22 @@ begin if N < 1 then Exit( Nil ); { Search for the desired gear. } +{$IFDEF PATCH_GH} + while (NIL <> List) do begin + if (GG_DisposeGear < List^.G) then begin + Dec( N ); + if (N < 1) then begin + break; + end; + end; + List := List^.Next; + end; +{$ELSE PATCH_GH} while ( N > 1 ) and ( List <> Nil ) do begin Dec( N ); List := List^.Next; end; +{$ENDIF PATCH_GH} { Return the last gear found. } RetrieveGearSib := List; @@ -1168,7 +2001,15 @@ begin it := False; While Track <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Track^.G) then begin + if Track = Part then begin + it := True; + end; + end; +{$ELSE PATCH_GH} if Track = Part then it := True; +{$ENDIF PATCH_GH} Track := Track^.Next; end; @@ -1199,6 +2040,8 @@ begin end; end; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Procedure CheckDirectoryPresent; { Make sure that the default save directory exists. If not, } { create it. } @@ -1216,7 +2059,14 @@ begin {$IFDEF SDLMODE} Startup_OK := Startup_OK and DirectoryExists( Graphics_DirName ); {$ENDIF} +{$IFDEF PATCH_GH} + if False = Startup_OK then begin + ErrorMessage('Data directory(s) not found.'); + halt(1); + end; +{$ENDIF} end; +{$ENDIF PATCH_GH} Procedure Rescale( Part: GearPtr; SF: Integer ); { Alter the scale of this part and all its subcoms. } @@ -1236,9 +2086,27 @@ begin end; end; + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: gears.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} { Make sure we have the required data directories. } -{$IFNDEF go32v2} + {$IFNDEF go32v2} CheckDirectoryPresent; -{$ENDIF} + {$ENDIF} +{$ENDIF PATCH_GH} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: gears.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/gears_base.pp branches/gears_base.pp --- GearHead1100repository.original/gears_base.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/gears_base.pp 2014-06-29 09:00:00.000000000 +0900 @@ -0,0 +1,457 @@ +{$IFDEF PATCH_GH} +unit gears_base; + {The building block from which everything in this game} + {is constructed is called a GEAR. Just seemed a good} + {thing to name the record, given the name of the game.} +{ + GearHead: Arena, a roguelike mecha CRPG + Copyright (C) 2005 Joseph Hewitt + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Lesser General Public License as published by + the Free Software Foundation; either version 2.1 of the License, or (at + your option) any later version. + + The full text of the LGPL can be found in license.txt. + + This library is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser + General Public License for more details. + + You should have received a copy of the GNU Lesser General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +} + +interface + +Const + { ******************************* } + { *** FILE NAME CONSTANTS *** } + { ******************************* } + + OS_Dir_Separator = DirectorySeparator; + OS_Search_Separator = PathSeparator; + OS_Current_Directory = '.'; + + { All of the following file names have been checked for } + { correct capitalization. Hopefully, everything should run } + { fine. } + GZ_Archive_BufLen = 16384; + GZ_Archive_Suffix = '.gz'; + Default_File_Ending = '.txt'; + Default_Search_Pattern = '*.txt'; + Archive_Search_Pattern = '*.txt.gz'; + Save_Game_DirName = 'SaveGame'; + Save_Game_Directory = Save_Game_DirName + OS_Dir_Separator; + Save_Character_Base = Save_Game_Directory + 'CHA'; + Save_Unit_Base = Save_Game_Directory + 'GHU'; + Save_Campaign_Base = Save_Game_Directory + 'RPG'; + Design_DirName = 'Design'; + Design_Directory = Design_DirName + OS_Dir_Separator; + PC_Equipment_File = Design_Directory + 'PC_Equipment.txt'; + Mek_Equipment_File = Design_Directory + 'Mek_Equipment.txt'; + Series_DirName = 'Series'; + Series_Directory = Series_DirName + OS_Dir_Separator; + Archetypes_File = Series_Directory + 'ANPCdefault.txt'; + Adventure_File_Base = Series_Directory + 'ADV_'; + STC_Item_File = Series_Directory + 'STCdefault.txt'; + Plot_Seacrh_Pattern = Series_Directory + 'PLOT' + Default_Search_Pattern; + Jobs_File = Series_Directory + 'RCJobs.txt'; + Monsters_File = Series_Directory + 'WMONdefault.txt'; + Data_DirName = 'GameData'; + Data_Directory = Data_DirName + OS_Dir_Separator; + MetaTerrain_File_Base = Data_Directory + 'meta'; + Trait_Chatter_Base = Data_Directory + 'TC_'; + Standard_Message_File = Data_Directory + 'messages.txt'; + Damage_Strings_File = Data_Directory + 'damage.txt'; + Ability_Message_File = Data_Directory + 'ability.txt'; + Standard_Nouns_File = Data_Directory + 'nouns.txt'; + Standard_Phrases_File = Data_Directory + 'phrases.txt'; + Standard_Adjectives_File = Data_Directory + 'adjectives.txt'; + Standard_Rumors_File = Data_Directory + 'rumors.txt'; + Standard_Chatter_File = Data_Directory + 'chat_msg.txt'; + Standard_Threats_File = Data_Directory + 'threats.txt'; + Parser_Macro_File = Data_Directory + 'ghpmacro.txt'; + Script_Macro_File = Data_Directory + 'aslmacro.txt'; + Value_Macro_File = Data_Directory + 'asvmacro.txt'; + Effects_Message_File = Data_Directory + 'effects.txt'; + RandMaps_Param_File = Data_Directory + 'randmaps.txt'; + NPC_Chatter_File = Data_Directory + 'taunts.txt'; + +{$IFDEF PATCH_I18N} + I18N_Settings_File = Data_Directory + 'I18N_settings.txt'; + I18N_Name_File = Data_Directory + 'I18N_name.txt'; + I18N_Messages_File = Data_Directory + 'I18N_messages.txt'; + I18N_Help_Keymap_Name_File = Data_Directory + 'i18n_keymap_name.txt'; + I18N_Help_Keymap_Desc_File = Data_Directory + 'i18n_keymap_desc.txt'; +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_I18N} + I18N_NPC_GenderTraits_File1 = Data_Directory + 'i18n_pgt_t_m1.txt'; + I18N_NPC_GenderTraits_File2 = Data_Directory + 'i18n_pgt_t_f1.txt'; + I18N_NPC_FirstPerson_File1 = Data_Directory + 'i18n_pgt_fp_m.txt'; + I18N_NPC_FirstPerson_File2 = Data_Directory + 'i18n_pgt_fp_f.txt'; + I18N_NPC_SecondPerson_File1 = Data_Directory + 'i18n_pgt_sp_m.txt'; + I18N_NPC_SecondPerson_File2 = Data_Directory + 'i18n_pgt_sp_f.txt'; + I18N_Standard_Modifier_File = Data_Directory + 'i18n_modifier.txt'; +{$ENDIF PATCH_I18N} + + Doc_DirName = 'doc'; + Doc_Directory = Doc_DirName + OS_Dir_Separator; +{$IFDEF PATCH_I18N} + Mecha_Help_File = Doc_Directory + 'i18n_man_umek.txt'; + FieldHQ_Help_File = Doc_Directory + 'i18n_man_mecha.txt'; + Chara_Help_File = Doc_Directory + 'i18n_man_chara.txt'; +{$ELSE PATCH_I18N} + Mecha_Help_File = Doc_Directory + 'man_umek.txt'; + FieldHQ_Help_File = Doc_Directory + 'man_mecha.txt'; + Chara_Help_File = Doc_Directory + 'man_chara.txt'; +{$ENDIF PATCH_I18N} + + Config_File = 'arena.cfg'; + +{$IFDEF PATCH_CHEAT} + Graphics_DirName = 'Image'; + Graphics_Directory = Graphics_Dirname + OS_Dir_Separator; +{$ELSE PATCH_CHEAT} + {$IFDEF SDLMODE} + Graphics_DirName = 'Image'; + Graphics_Directory = Graphics_Dirname + OS_Dir_Separator; + {$ENDIF} +{$ENDIF PATCH_CHEAT} + +{$IFDEF ENABLE_ADDRESSBOOK} + Save_Campaign_AddressBook_Base = Save_Game_Directory + 'PHONE'; +{$ENDIF} + + Startup_OK: Boolean = True; + + +Type + SAttPtr = ^SAtt; + SAtt = Record {*** STRING ATTRIBUTE ***} + info: String; + next: SAttPtr; + end; + + NAttPtr = ^NAtt; + NAtt = Record {*** NUMERICAL ATTRIBUTE ***} + G,S: Integer; {General, Specific, Value} + V: LongInt; + next: NAttPtr; + end; + + +Function RetrieveAString(const S: String): String; + +{$IFDEF PATCH_GH} +Procedure DisposeSAtt( var LList_arg: SAttPtr ); +{$ELSE PATCH_GH} +Procedure DisposeSAtt(var LList: SAttPtr); +{$ENDIF PATCH_GH} +Function CreateSAtt(var LList: SAttPtr): SAttPtr; +Function StoreSAtt(var LList: SAttPtr; const Info: String): SAttPtr; +Function FindSAtt(LList: SAttPtr; const Code_In: String): SAttPtr; +Function SAttValue(LList: SAttPtr; const Code: String): String; +Function LoadStringList( const FName_In: String ): SAttPtr; + + + +implementation + +{ "sysutils" has to come before "dos" } +uses sysutils,dos +{$IFDEF PATCH_GH} + ,errmsg +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + ,errmsg + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + ,pseudosmartpointer +{$ENDIF PATCH_GH} + ; + +Function RetrieveAString(const S: String): String; + {Retrieve an Alligator String from S.} + {Alligator Strings are defined as the part of the string} + {that both alligarors want to eat, i.e. between < and >.} +var + A1,A2: Integer; +begin + {Locate the position of the two alligators.} + A1 := Pos('<',S); + A2 := Pos('>',S); + + {If the string has not been declared with <, return} + {an empty string.} + if A1 = 0 then Exit(''); + + {If the string has not been closed with >, return the} + {entire remaining length of the string.} + if A2 = 0 then A2 := Length(S)+1; + + RetrieveAString := Copy(S,A1+1,A2-A1-1); +end; + +{$IFDEF PATCH_GH} +Procedure DisposeSAtt( var LList_arg: SAttPtr ); + {Dispose of the list, freeing all associated system resources.} +var + LList: SAttPtr; + LTemp: SAttPtr; +begin + LList := LList_arg; + LList_arg := NIL; + while LList <> Nil do begin + LTemp := LList^.Next; + {$IFDEF DEBUG} + Trace_MemoryLeak('DisposeSAtt() Dispose',LList); + {$ENDIF DEBUG} + CheckAndNIL_Pointer('DisposeSAtt() Dispose',LList,True); + {$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.info := '@'; + LList^.Next := SAttPtr(-1); + {$ENDIF PATCH_GH_PARANOID_SAFER} + Dispose(LList); + LList := LTemp; + end; +end; +{$ELSE PATCH_GH} +Procedure DisposeSAtt(var LList: SAttPtr); + {Dispose of the list, freeing all associated system resources.} +var + LTemp: SAttPtr; +begin + while LList <> Nil do begin + LTemp := LList^.Next; + Dispose(LList); + LList := LTemp; + end; +end; +{$ENDIF PATCH_GH} + +Function LastSAtt( LList: SAttPtr ): SAttPtr; + { Find the last SAtt in this particular list. } +begin + if LList <> Nil then while LList^.Next <> Nil do LList := LList^.Next; + + LastSAtt := LList; +end; + +Function CreateSAtt(var LList: SAttPtr): SAttPtr; + {Add a new element to the tail of LList.} +var + it: SAttPtr; +begin + {Allocate memory for our new element.} + New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('CreateSAtt() New',it); + CheckAndNIL_Pointer('CreateSAtt() New', it, True ); +{$ENDIF DEBUG} + if it = Nil then exit( Nil ); + it^.Next := Nil; + + {Attach IT to the list.} + if LList = Nil then begin + LList := it; + end else begin + LastSAtt( LList )^.Next := it; + end; + + {Return a pointer to the new element.} + CreateSAtt := it; +end; + +Function StoreSAtt(var LList: SAttPtr; const Info: String): SAttPtr; + { Add string attribute Info to the list. This procedure } + { doesn't check to make sure this attribute isn't duplicated. } +var + it: SAttPtr; +begin + it := CreateSAtt(LList); + it^.info := Info; + + {Return a pointer to the new attribute.} + StoreSAtt := it; +end; + +Function LabelsMatch( const info,code: String ): Boolean; + { Return TRUE if UpCase( CODE ) matches UpCase( INFO ) all the } + { way to the first '<', ignoring spaces and tabs. } +var + i_pos,c_pos: Integer; +begin + { error check... } + if ( info = '' ) or ( code = '' ) then Exit( False ); + i_pos := 0; + c_pos := 0; + repeat + inc( i_pos ); + inc( c_pos ); + while (i_pos <= Length(info)) and ((info[i_pos] = ' ') or (info[i_pos] = #9)) do begin + Inc(i_pos); + end; + while (c_pos <= Length(code)) and ((code[c_pos] = ' ') or (code[c_pos] = #9)) do begin + Inc(c_pos); + end; + until ( i_pos > Length( info ) ) or ( c_pos > Length( code ) ) or ( UpCase( info[i_pos] ) <> UpCase( code[c_pos] ) ); + + LabelsMatch := ( c_pos > Length( code ) ) and ( i_pos <= Length( info ) ) and ( info[i_pos] = '<' ); +end; + +Function FindSAtt(LList: SAttPtr; const Code_In: String): SAttPtr; + {Search through the list looking for a String Attribute} + {whose code matches CODE and return its address.} + {Return Nil if no such SAtt can be found.} +var + it: SAttPtr; + Code: String; +begin + {Initialize IT to Nil.} + it := Nil; + + Code := UpCase(Code_In); + + {Check through all the SAtts looking for the SATT in question.} + while ( LList <> Nil ) and ( it = Nil ) do begin + if LabelsMatch( LList^.info , Code ) then it := LList; + LList := LList^.Next; + end; + + FindSAtt := it; +end; + +Function SAttValue(LList: SAttPtr; const Code: String): String; + {Find a String Attribute which corresponds to Code, then} + {return its embedded alligator string.} +var + it: SAttPtr; +begin + it := FindSAtt(LList,Code); + + if it = Nil then Exit(''); + + SAttValue := RetrieveAString(it^.info); +end; + +Function LoadStringList( const FName_In: String ): SAttPtr; + { Load a list of string attributes from the listed file, } + { if it can be found. } +var + SList: SAttPtr; + F: Text; + S: String; + FName: String; +begin + SList := Nil; + FName := FSearch( FName_In , '.' ); + if FName <> '' then begin + Assign( F , FName ); + Reset( F ); + + { Get rid of the opening comment } + ReadLn( F , S ); + + while not EOF( F ) do begin + ReadLn( F , S ); + if S <> '' then StoreSAtt( SList , S ); + end; + + Close( F ); + end; + LoadStringList := SList; +end; + + +{$IFDEF PATCH_GH} +Procedure ExceptionErrorMessage_CanNotMakeDir( Obj: TObject; Addr: Pointer; FrameCount: LongInt; Frame: PPointer ); +begin + ErrorMessage('Can not make a directory.'); + halt(1); +end; +{$ENDIF PATCH_GH} + +Procedure CheckDirectoryPresent; + { Make sure that the default save directory exists. If not, } + { create it. } +var + S: String; +{$IFDEF PATCH_GH} + OrgExceptProc: TExceptProc; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + { Check to make sure all the other directories can be found. } + if not DirectoryExists( Design_DirName ) then begin + ErrorMessage('Directory "'+Design_DirName+'" is not found.'); + Startup_OK := False; + end; + if not DirectoryExists( Series_DirName ) then begin + ErrorMessage('Directory "'+Series_DirName+'" is not found.'); + Startup_OK := False; + end; + if not DirectoryExists( Data_DirName ) then begin + ErrorMessage('Directory "'+Data_DirName+'" is not found.'); + Startup_OK := False; + end; + {$IFDEF SDLMODE} + if not DirectoryExists( Graphics_DirName ) then begin + ErrorMessage('Directory "'+Graphics_DirName+'" is not found.'); + Startup_OK := False; + end; + {$ENDIF} + + if not DirectoryExists( Save_Game_DirName ) then begin + ErrorMessage('Directory "'+Save_Game_DirName+'" is not found.'); + ErrorMessage('Making a directory "'+Save_Game_DirName+'" ...'); + OrgExceptProc := ExceptProc; + ExceptProc := @ExceptionErrorMessage_CanNotMakeDir; + MkDir( Save_Game_DirName ); + ExceptProc := OrgExceptProc; + end; + + if False = Startup_OK then begin + halt(1); + end; +{$ELSE PATCH_GH} + if not DirectoryExists( Save_Game_DirName ) then begin + MkDir( Save_Game_DirName ); + end; + + { Check to make sure all the other directories can be found. } + Startup_OK := Startup_OK and DirectoryExists( Design_DirName ); + Startup_OK := Startup_OK and DirectoryExists( Series_DirName ); + Startup_OK := Startup_OK and DirectoryExists( Data_DirName ); + {$IFDEF SDLMODE} + Startup_OK := Startup_OK and DirectoryExists( Graphics_DirName ); + {$ENDIF} +{$ENDIF PATCH_GH} +end; + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: gears_base.pp'); +{$ENDIF DEBUG} + { Make sure we have the required data directories. } +{$IFNDEF go32v2} + CheckDirectoryPresent; +{$ENDIF} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: gears_base.pp(finalization)'); +{$ENDIF DEBUG} +end; + +end. +{$ENDIF PATCH_GH} diff -x .svn -uprN GearHead1100repository.original/gearutil.pp branches/gearutil.pp --- GearHead1100repository.original/gearutil.pp 2013-02-05 09:01:00.000000000 +0900 +++ branches/gearutil.pp 2015-07-22 09:01:00.000000000 +0900 @@ -22,7 +22,18 @@ unit gearutil; interface -uses gears; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; + +{$IFDEF PATCH_GH} +Const + TAG_DisallowSelling = 'DisallowSelling'; + TAG_DisallowDropping = 'DisallowDropping'; + TAG_DisallowTransfering = 'DisallowTransfering'; +{$ENDIF PATCH_GH} Function IsMasterGear(G: GearPtr): Boolean; Procedure InitGear(Part: GearPtr); @@ -39,10 +50,22 @@ Function ScaleDP( DP , Scale , Material: Function UnscaledMaxDamage( Part: GearPtr ): Integer; Function GearMaxDamage(Part: GearPtr): Integer; Function GearMaxArmor(Part: GearPtr): Integer; +{$IFDEF PATCH_GH} +Function GearName( Part: GearPtr; DebugMode: Boolean ): String; +Function FullGearName( Part: GearPtr; DebugMode: Boolean ): String; +{$ENDIF PATCH_GH} Function GearName(Part: GearPtr): String; Function FullGearName(Part: GearPtr): String; - +{$IFDEF PATCH_I18N} +Function InitialGearName( Part: GearPtr ): Char; +Function FormatDescString( Part: GearPtr ): String; +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_GH} +Function GearMass( Master: GearPtr ): LongInt; +{$ELSE PATCH_GH} Function GearMass( Master: GearPtr ): Integer; +{$ENDIF PATCH_GH} Function IntrinsicMass( Master: GearPtr ): LongInt; Function EquipmentMass( Master: GearPtr ): LongInt; @@ -60,13 +83,20 @@ Function CanBeInstalled( Part , Equip: G Procedure CheckGearRange( Part: GearPtr ); Function EquipGear( Slot , Part: GearPtr ): GearPtr; +{$IFDEF PATCH_CHEAT} +Function SeekGear( Master: GearPtr; G,S: Integer; CheckInv,CockpitBarrier: Boolean ): GearPtr; +{$ENDIF PATCH_CHEAT} Function SeekGear( Master: GearPtr; G,S: Integer; CheckInv: Boolean ): GearPtr; Function SeekGear( Master: GearPtr; G,S: Integer ): GearPtr; Function SeekCurrentLevelGear( Master: GearPtr; G,S: Integer ): GearPtr; Function GearEncumberance( Mek: GearPtr ): Integer; Function BaseMVTVScore( Mek: GearPtr ): Integer; +{$IFDEF PATCH_GH} +Function BaseGearValue( Master: GearPtr ): Int64; +{$ELSE PATCH_GH} Function BaseGearValue( Master: GearPtr ): LongInt; +{$ENDIF PATCH_GH} Function GearValue( Master: GearPtr ): LongInt; function SeekGearByName( LList: GearPtr; Name: String ): GearPtr; @@ -80,12 +110,44 @@ function CStat( PC: GearPtr; Stat: Integ Procedure WriteCGears( var F: Text; G: GearPtr ); Function ReadCGears( var F: Text ): GearPtr; +{$IFDEF PATCH_GH} +Function DisallowSelling( P: GearPtr ): Boolean; +Function DisallowDropping( P: GearPtr ): Boolean; +Function DisallowTransfering( P: GearPtr ): Boolean; +Function CheckAlongPath_DisallowSelling( P: GearPtr ): Boolean; +Function CheckAlongPath_DisallowDropping( P: GearPtr ): Boolean; +Function CheckAlongPath_DisallowTransfering( P: GearPtr ): Boolean; +{$ENDIF PATCH_GH} + implementation -uses ghchars,ghcpit,ghguard,ghholder,ghmecha,ghmodule,ghmovers, - ghprop,ghsensor,ghsupport, - ghswag,ghweapon,texutil; +uses +{$IFDEF DEBUG} + sysutils, + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + ui4gh, +{$ELSE PATCH_CHEAT} + {$IFDEF PATCH_I18N} + ui4gh, + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_CHEAT} + ghchars,ghcpit,ghguard,ghholder,ghmecha,ghmodule,ghmovers, + ghprop,ghsensor,ghsupport, + ghswag,ghweapon,texutil +{$IFDEF DEBUG} + {$IFDEF SDLMODE} + ,sdlgfx + {$ELSE SDLMODE} + ,context + {$ENDIF SDLMODE} +{$ENDIF DEBUG} + ; Const SaveFileContinue = 0; @@ -95,6 +157,21 @@ Const GMMODE_Equipment = 2; Storage_Armor_Bonus = 2; +{$IFDEF PATCH_GH} +Function DisallowSelling( P: GearPtr ): Boolean; +begin + DisallowSelling := ( 0 < Length( SAttValue( P^.SA , TAG_DisallowSelling ) ) ); +end; +Function DisallowDropping( P: GearPtr ): Boolean; +begin + DisallowDropping := ( 0 < Length( SAttValue( P^.SA , TAG_DisallowDropping ) ) ); +end; +Function DisallowTransfering( P: GearPtr ): Boolean; +begin + DisallowTransfering := ( 0 < Length( SAttValue( P^.SA , TAG_DisallowTransfering ) ) ); +end; +{$ENDIF PATCH_GH} + Function IsMasterGear(G: GearPtr): Boolean; {This function checks gear G to see whether or not it counst} {as a Master Gear. Currently the only gears which count} @@ -158,6 +235,20 @@ begin Part := Part^.Parent; end; +{$IFDEF PATCH_GH} + it := 0; + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then begin + it := 0 + end else if Part^.G = GG_Mecha then begin + it := Part^.V + end else if Part^.G = GG_Character then begin + { The main purpose of this for character gears is to } + { determine the size of the character's limbs. } + it := ( Part^.Stat[ STAT_Body ] + 2 ) div 3; + if it < 1 then it := 1 + else if it > 10 then it := 10; + end; +{$ELSE PATCH_GH} if Part = Nil then it := 0 else if Part^.G = GG_Mecha then it := Part^.V else if Part^.G = GG_Character then begin @@ -167,6 +258,7 @@ begin if it < 1 then it := 1 else if it > 10 then it := 10; end; +{$ENDIF PATCH_GH} MasterSize := it; end; @@ -326,6 +418,10 @@ Function GearMaxDamage(Part: GearPtr): I var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Start with the unscaled mass damage. } it := UnscaledMaxDamage( Part ); @@ -343,6 +439,9 @@ var it: Integer; begin {Error Check} +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if Part = Nil then Exit(0); {Modules and Cockpits have armor ratings.} @@ -371,18 +470,51 @@ begin GearMaxArmor := it; end; +{$IFDEF PATCH_GH} +Function GearName(Part: GearPtr): String; +begin + GearName := GearName( Part, False ); +end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Function GearName( Part: GearPtr; DebugMode: Boolean ): String; +{$ELSE PATCH_GH} Function GearName(Part: GearPtr): String; +{$ENDIF PATCH_GH} {Determine the name of Part. If Part has a NAME attribute,} {this is easy. If not, locate a default name based upon} {Part's type.} var it: String; +{$IFDEF PATCH_CHEAT} + C_ptr: Integer; +{$ENDIF PATCH_CHEAT} begin {Error check- make sure we aren't trying to find a name} {for nothing.} +{$IFDEF PATCH_GH} + if NIL = Part then Exit(''); + if not(DebugMode) and (Part^.G <= GG_DisposeGear) then Exit(''); +{$ELSE PATCH_GH} if Part = Nil then Exit( '' ); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + if I18N_UseNameORG then begin + it := SAttValue(Part^.SA,'NAME_ORG'); + if '' = it then begin + it := SAttValue(Part^.SA,'NAME'); + end; + end else begin + it := SAttValue(Part^.SA,'NAME'); + if '' = it then begin + it := SAttValue(Part^.SA,'NAME_ORG'); + end; + end; +{$ELSE PATCH_I18N} it := SAttValue(Part^.SA,'NAME'); +{$ENDIF PATCH_I18N} if it = '' then case Part^.G of GG_Module: it := ModuleName(Part); @@ -409,25 +541,147 @@ begin else it := 'Platonic Form'; end; +{$IFDEF PATCH_I18N} + it := I18N_Name_withDefault( it, it ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_GearName_AddScaleNumber and (GG_Character <> Part^.G) then begin + it := it + ' (S' + BStr(Part^.Scale) + ')'; + end; + if Cheat_GearName_AddClassNumber_GGModule and (GG_Module = Part^.G) then begin + it := it + ' (C' + BStr(Part^.V) + ')'; + end; + if Cheat_GearName_AddClassNumber_GGMecha and (GG_Mecha = Part^.G) then begin + it := it + ' (C' + BStr(Part^.V) + ')'; + end; + if Cheat_GearName_AddClassNumber_GGHolder and (GG_Holder = Part^.G) then begin + it := it + ' (C' + BStr(Part^.V) + ')'; + end; + if Cheat_GearName_AddClassNumber_GGSupport and (GG_Support = Part^.G) then begin + C_ptr := Pos('C',it); + if (C_ptr < 1) or (Length(it) < (C_ptr +1)) or (it[C_ptr+1] < '0') or ('9' < it[C_ptr+1]) then begin + if (GS_Engine = Part^.S) and (EST_HighOutput = Part^.Stat[STAT_EngineSubType]) then begin + it := 'C' + BStr(Part^.V) + 'H' + it; + end else begin + it := 'C' + BStr(Part^.V) + it; + end; + end; + end; + if Cheat_GearName_AddClassNumber_GGConsumable and (GG_Consumable = Part^.G) then begin + it := it + ' (C' + BStr(Part^.V) + ')'; + end; +{$ENDIF PATCH_CHEAT} + GearName := it; end; +{$IFDEF PATCH_GH} +Function FullGearName(Part: GearPtr): String; +begin + FullGearName := FullGearName( Part, False ); +end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Function FullGearName( Part: GearPtr; DebugMode: Boolean ): String; +{$ELSE PATCH_GH} Function FullGearName(Part: GearPtr): String; +{$ENDIF PATCH_GH} { Return the name + designation for this gear. } var it: String; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} it := SAttValue( Part^.SA , 'DESIG' ); if it <> '' then it := it + ' '; +{$IFDEF PATCH_GH} + FullGearName := it + GearName( Part, DebugMode ); +{$ELSE PATCH_GH} FullGearName := it + GearName( Part ); +{$ENDIF PATCH_GH} +end; + +{$IFDEF PATCH_I18N} +Function InitialGearName( Part: GearPtr ): Char; + { Return the initial char of GearName. } +var + it: String; +begin + {$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(#0); + {$ENDIF PATCH_GH} + it := GearName( Part ); + if LengthMBChar(it[1]) <= 1 then Exit(it[1]); + it := SAttValue(Part^.SA,'NAME_ORG'); + if '' = it then Exit(#0); + InitialGearName := it[1]; +end; + + +Function FormatDescString( Part: GearPtr ): String; +var + S0, S1, W, S1_tail: String; + DItS: Boolean; {Do insert the space, or not.} + CW_I18N: Boolean; {Is the current word I18N ?} +begin + S0 := SAttValue( Part^.SA , 'DESC' ); + S1 := ''; + + while S0 <> '' do begin + W := ExtractWord( S0, DItS, CW_I18N ); + + if UpCase( W ) = '\NAME2' then begin + W := ExtractWord( S0 ); + W := I18N_Name( W, ExtractWord( S0 ) ); + end else if UpCase( W ) = '\NAME' then begin + W := I18N_Name( ExtractWord( S0 ) ); + end; + + S1_tail := ''; + if ( 1 <= Length(S1) ) then begin + S1_tail := Copy( S1, Length( S1 ), 1 ); + end; + if ( ( 1 <= Length(W) ) and IsPunctuation( W[1] ) ) or ( '$' = S1_tail ) or ( '@' = S1_tail ) then begin + S1 := S1 + W; + end else begin + if DItS then begin + S1 := S1 + ' ' + W; + end else begin + S1 := S1 + W; + end; + end; + + end; + + FormatDescString := S1; end; +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_GH} +Function ComponentMass( Part: GearPtr ): LongInt; +{$ELSE PATCH_GH} Function ComponentMass( Part: GearPtr ): Integer; +{$ENDIF PATCH_GH} {Calculate the unscaled mas of PART, ignoring for the} {moment its subcomponents.} -var +{$IFDEF PATCH_GH} +const + Mass_MAX = 2147483647; + Mass_MIN = -2147483648; +{$ENDIF PATCH_GH} +var +{$IFDEF PATCH_GH} + it,MAV: Int64; +{$ELSE PATCH_GH} it,MAV: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} Case Part^.G of GG_Module: it := ModuleBaseMass(Part); GG_Cockpit: it := CockpitBaseMass(Part); @@ -457,20 +711,50 @@ begin { Mass adjustment can't result in a negative mass. } if it < 0 then it := 0; +{$IFDEF PATCH_CHEAT} + if (0 < SAttValueToInt( Part^.SA, SATT_SEPARABLE )) then begin + Inc( it ); + end; +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_GH} + if it < Mass_MIN then begin + it := Mass_MIN; + end else if Mass_MAX < it then begin + it := Mass_MAX; + end; +{$ENDIF PATCH_GH} ComponentMass := it; end; +{$IFDEF PATCH_GH} +Function TrackMass( Part: GearPtr; Scale: Integer; Mode: Byte; AddThis: Boolean ): LongInt; +{$ELSE PATCH_GH} Function TrackMass( Part: GearPtr; Scale: Integer; Mode: Byte; AddThis: Boolean ): Integer; +{$ENDIF PATCH_GH} {Calculate the mass of this list of gears, including all} {subcomponents.} -var +{$IFDEF PATCH_GH} +const + Mass_MAX = 2147483647; + Mass_MIN = -2147483648; +{$ENDIF PATCH_GH} +var +{$IFDEF PATCH_GH} + it,W: Int64; + t: Integer; +{$ELSE PATCH_GH} it,W,t: Integer; +{$ENDIF PATCH_GH} begin {Initialize the total Mass to 0.} it := 0; {Loop through all components.} while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} {We will only add the mass of components which are} {in the same scale as the master gear.} if Part^.Scale >= Scale then begin @@ -497,40 +781,115 @@ begin if Part^.SubCom <> Nil then it := it + TrackMass(Part^.SubCom,Scale,Mode,AddThis); if Part^.InvCom <> Nil then it := it + TrackMass(Part^.InvCom,Scale,Mode,True); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} {Go to the next part in the series.} Part := Part^.Next; end; {Return the value.} +{$IFDEF PATCH_GH} + if it < Mass_MIN then begin + it := Mass_MIN; + end else if Mass_MAX < it then begin + it := Mass_MAX; + end; +{$ENDIF PATCH_GH} TrackMass := it; end; +{$IFDEF PATCH_GH} +Function GearMass( Master: GearPtr ): LongInt; +{$ELSE PATCH_GH} Function GearMass( Master: GearPtr ): Integer; +{$ENDIF PATCH_GH} {Calculate the mass of MASTER, including all of its} {subcomponents.} +{$IFDEF PATCH_GH} +const + Mass_MAX = 2147483647; + Mass_MIN = -2147483648; +var + tmp: Int64; +{$ENDIF PATCH_GH} begin {The formula to work out the total mass of this gear} {is basic mass + SubCom mass + InvCom mass.} if ( Master = Nil ) or ( Master^.G < 0 ) then begin GearMass := 0; end else begin +{$IFDEF PATCH_GH} + tmp := ComponentMass(Master); + tmp := tmp + TrackMass(Master^.SubCom,Master^.Scale,GMMODE_AddAll,True); + tmp := tmp + TrackMass(Master^.InvCom,Master^.Scale,GMMODE_AddAll,True); + if tmp < Mass_MIN then begin + tmp := Mass_MIN; + end else if Mass_MAX < tmp then begin + tmp := Mass_MAX; + end; + GearMass := tmp; +{$ELSE PATCH_GH} GearMass := ComponentMass(Master) + TrackMass(Master^.SubCom,Master^.Scale,GMMODE_AddAll,True) + TrackMass(Master^.InvCom,Master^.Scale,GMMODE_AddAll,True); +{$ENDIF PATCH_GH} end; end; Function IntrinsicMass( Master: GearPtr ): LongInt; { Return the mass of MASTER and all its subcomponents. Do not } { calculate the mass of inventory components. } +{$IFDEF PATCH_GH} +const + Mass_MAX = 2147483647; + Mass_MIN = -2147483648; +var + tmp: Int64; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + tmp := ComponentMass(Master); + tmp := tmp + TrackMass(Master^.SubCom,Master^.Scale,GMMODE_Intrinsic,True); + if tmp < Mass_MIN then begin + tmp := Mass_MIN; + end else if Mass_MAX < tmp then begin + tmp := Mass_MAX; + end; + IntrinsicMass := tmp; +{$ELSE PATCH_GH} IntrinsicMass := ComponentMass(Master) + TrackMass(Master^.SubCom,Master^.Scale,GMMODE_Intrinsic,True); +{$ENDIF PATCH_GH} end; Function EquipmentMass( Master: GearPtr ): LongInt; { Return the mass of all inventory components of MASTER. Do not } { include the mass of intrinsic components. } +{$IFDEF PATCH_GH} +const + Mass_MAX = 2147483647; + Mass_MIN = -2147483648; +var + tmp: Int64; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + tmp := TrackMass(Master^.SubCom,Master^.Scale,GMMODE_Equipment,False); + tmp := tmp + TrackMass(Master^.InvCom,Master^.Scale,GMMODE_Equipment,True); + if tmp < Mass_MIN then begin + tmp := Mass_MIN; + end else if Mass_MAX < tmp then begin + tmp := Mass_MAX; + end; + EquipmentMass := tmp; +{$ELSE PATCH_GH} EquipmentMass := TrackMass(Master^.SubCom,Master^.Scale,GMMODE_Equipment,False) + TrackMass(Master^.InvCom,Master^.Scale,GMMODE_Equipment,True); +{$ENDIF PATCH_GH} end; Function MakeMassString( BaseMass: LongInt; Scale: Integer ): String; @@ -559,6 +918,9 @@ Function MassString( Master: GearPtr ): var BaseMass: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} BaseMass := GearMass( Master ); MassString := MakeMassString( BaseMass , Master^.Scale ); end; @@ -603,15 +965,40 @@ Function SubComComplexity( Part: GearPtr var it: Integer; S: GearPtr; +{$IFDEF PATCH_CHEAT} + Gyro: GearPtr; + TarCom: GearPtr; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} it := 0; S := Part^.SubCom; while S <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < S^.G) then begin +{$ENDIF PATCH_GH} if S^.Scale >= Part^.Scale then begin it := it + ComponentComplexity( S ); end else begin Inc( it ); end; +{$IFDEF PATCH_CHEAT} + if ( GG_Cockpit = S^.G ) and not( Cheat_EnableCockpitBarrier ) then begin + Gyro := SeekGear( S , GG_Support , GS_Gyro , True , False ); + if ( NIL <> Gyro ) then begin + Inc( it ); + end; + TarCom := SeekGear( S , GG_Sensor , GS_TarCom , True , False ); + if ( NIL <> TarCom ) then begin + Inc( it ); + end; + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} S := S^.Next; end; SubComComplexity := it; @@ -625,7 +1012,12 @@ Function IsLegalSlot( Slot, Equip: GearP { it doesn't check whether the slot is already occupied or } { anything else. } begin +{$IFDEF PATCH_GH} + if (NIL = Slot) + or (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if ( Slot = Nil ) or ( Equip = Nil ) then begin +{$ENDIF PATCH_GH} { If either of the provided gears don't really exist, } { this can't very well be a legal installation, can it? } IsLegalSlot := False; @@ -679,12 +1071,18 @@ var MG: GearPtr; { Multiplicity Gear } N: Integer; { A number. That's all. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} LG := Part^.InvCom; while LG <> Nil do begin { We need to save the location of the next gear, } { since LG itself might get deleted. } LG2 := LG^.Next; +{$IFDEF PATCH_GH} + if (GG_DisposeGear < LG^.G) then begin +{$ENDIF PATCH_GH} if not IsLegalSlot( Part , LG ) then begin { LG failed the legality check. Delete it. } RemoveGear( Part^.InvCom , LG ); @@ -699,6 +1097,9 @@ begin { There's more than one gear here. Get rid of it. } if N > 1 then RemoveGear( Part^.InvCom , LG ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} LG := LG2; end; @@ -712,7 +1113,12 @@ Function IsLegalSubcom( Part, Equip: Gea { Note that this procedure only checks the legality of installation; } { it does not do a multiplicity test or anything else. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) + or (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if ( Part = Nil ) or ( Equip = Nil ) then begin +{$ENDIF PATCH_GH} { If either of the provided gears don't really exist, } { this can't very well be a legal installation, can it? } IsLegalSubcom := False; @@ -749,6 +1155,9 @@ Function MaximumInstancesAllowed( Slot: { Note that the results of this function are undefined if the } { part cannot be legally installed in the slot in the first place. } begin +{$IFDEF PATCH_GH} + if (NIL = Slot) or (SLot^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if Equip_G = GG_MoveSys then begin MaximumInstancesAllowed := 1; end else if Equip_G = GG_Support then begin @@ -778,6 +1187,9 @@ var N: Integer; PSC: GearPtr; { Part SubCom } begin +{$IFDEF PATCH_GH} + if (NIL = Parent) or (Parent^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} N := 0; PSC := Parent^.SubCom; while PSC <> Nil do begin @@ -807,12 +1219,22 @@ var PSC := Slot^.SubCom; CyberSlot := UpCase( CyberSlot ); while PSC <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < PSC^.G) then begin +{$ENDIF PATCH_GH} if ( UpCase( SAttValue( PSC^.SA , SATT_CyberSlot ) ) = CyberSlot ) and ( PSC <> Item ) then Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} PSC := PSC^.Next; end; CyberMatches := N; end; begin +{$IFDEF PATCH_GH} + if (NIL = Slot) or (Slot^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Item) or (Item^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} { Start by assuming TRUE. } it := True; @@ -842,6 +1264,9 @@ Procedure CheckGearSubs( Part: GearPtr ) var LG,LG2: GearPtr; { Loop Gear } begin +{$IFDEF PATCH_GH} + if (NIL = Part) then Exit; +{$ENDIF PATCH_GH} LG := Part^.SubCom; while LG <> Nil do begin { We need to save the location of the next gear, } @@ -868,10 +1293,40 @@ Function CanBeInstalled( Part , Equip: G { otherwise. } var it: Boolean; -begin +{$IFDEF PATCH_CHEAT} + Mek: GearPtr; + FormMek: Integer; + FormEquip: Integer; + SubComReceptacle: String; + SubComPlug: String; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} it := IsLegalSubCom( Part , Equip ); if it then begin +{$IFDEF PATCH_CHEAT} + { Check a form. } + Mek := FindMaster( Part ); + FormMek := SAttValueToInt( Mek^.SA, SATT_TRANSFORM_CURRENT ); + FormEquip := SAttValueToInt( Equip^.SA, SATT_TRANSFORM_CURRENT ); + if (0 < FormMek) and (0 < FormEquip) and (FormMek <> FormEquip) then begin + exit(False); + end; + + { Check a mechanical joint. } + SubComReceptacle := SAttValue( Part^.SA , SATT_SUBCOM_RECEPTACLE ); + SubComPlug := SAttValue( Equip^.SA, SATT_SUBCOM_PLUG ); + if ( ('' <> SubComReceptacle) or ('' <> SubComPlug) ) then begin + if ( SubComReceptacle <> SubComPlug ) then begin + exit(False); + end; + end; +{$ENDIF PATCH_CHEAT} + it := MultiplicityCheck( Part , Equip ); if it and ( Equip^.G = GG_Module ) and ( Part^.G = GG_Mecha ) then begin @@ -885,6 +1340,9 @@ Procedure CheckGearRange( Part: GearPtr { Check the G , S , V , Stat , SubCom , and InvCom values of } { this gear to make sure everything is all nice and legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if Part^.G = GG_Mecha then CheckMechaRange( Part ) else if Part^.G = GG_Module then CheckModuleRange( Part ) else if Part^.G = GG_Cockpit then CheckCPitRange( Part ) @@ -927,6 +1385,11 @@ var prev: GearPtr; { Previously Equipped Gear } IC: GearPtr; { Inv Com counter } begin +{$IFDEF PATCH_GH} + if (NIL = Slot) or (Slot^.G <= GG_DisposeGear) then Exit(NIL); + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + if ( Slot = Nil ) or ( Part = Nil ) then begin { Can't equip PART into SLOT if one or both are } { nonexistant. } @@ -960,7 +1423,11 @@ begin end; end; +{$IFDEF PATCH_CHEAT} +Function SeekGear( Master: GearPtr; G,S: Integer; CheckInv,CockpitBarrier: Boolean ): GearPtr; +{$ELSE PATCH_CHEAT} Function SeekGear( Master: GearPtr; G,S: Integer; CheckInv: Boolean ): GearPtr; +{$ENDIF PATCH_CHEAT} { Search through all the subcoms and invcoms of MASTER and } { find a part which matches G,S. If more than one applicable } { part is found, return the part with the highest V field... } @@ -973,6 +1440,10 @@ Function SeekGear( Master: GearPtr; G,S: var it: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = P1) or (P1^.G <= GG_DisposeGear) then P1 := NIL; + if (NIL = P2) or (P2^.G <= GG_DisposeGear) then P2 := NIL; +{$ENDIF PATCH_GH} it := Nil; if P1 = Nil then it := P2 else if P2 = Nil then it := P1 @@ -991,33 +1462,71 @@ Function SeekGear( Master: GearPtr; G,S: { which matches G , S. } var it: GearPtr; +{$IFDEF PATCH_CHEAT} + Backup_CheckInv: Boolean; +{$ENDIF PATCH_CHEAT} begin it := Nil; while P <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < P^.G) then begin +{$ENDIF PATCH_GH} if ( P^.G = G ) and ( P^.S = S ) then begin it := CompGears( it , P ); end; +{$IFDEF PATCH_CHEAT} + if ( GG_Cockpit = P^.G ) then begin + if not( CockpitBarrier ) then begin + Backup_CheckInv := CheckInv; + CheckInv := True; + it := CompGears( SeekPartAlongTrack( P^.SubCom ) , it ); + it := CompGears( it , SeekPartAlongTrack( P^.InvCom ) ); + CheckInv := Backup_CheckInv; + end; + end else begin + it := CompGears( SeekPartAlongTrack( P^.SubCom ) , it ); + if CheckInv then it := CompGears( it , SeekPartAlongTrack( P^.InvCom ) ); + end; +{$ELSE PATCH_CHEAT} if P^.G <> GG_Cockpit then begin it := CompGears( SeekPartAlongTrack( P^.SubCom ) , it ); if CheckInv then it := CompGears( it , SeekPartAlongTrack( P^.InvCom ) ); end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} P := P^.Next; end; SeekPartAlongTrack := it; end; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} if CheckInv then SeekGear := CompGears( SeekPartAlongTrack( Master^.InvCom ) , SeekPartAlongTrack( Master^.SubCom ) ) else SeekGear := SeekPartAlongTrack( Master^.SubCom ); end; +{$IFDEF PATCH_CHEAT} +Function SeekGear( Master: GearPtr; G,S: Integer; CheckInv: Boolean ): GearPtr; +begin + SeekGear := SeekGear( Master , G , S , CheckInv , True ); +end; +{$ENDIF PATCH_CHEAT} + Function SeekGear( Master: GearPtr; G,S: Integer ): GearPtr; { Seek an active gear, automatically checking the inventory as } { well as the subcomponents. } begin +{$IFDEF PATCH_CHEAT} + SeekGear := SeekGear( Master , G , S , True , True ); +{$ELSE PATCH_CHEAT} SeekGear := SeekGear( Master , G , S , True ); +{$ENDIF PATCH_CHEAT} end; Function SeekCurrentLevelGear( Master: GearPtr; G,S: Integer ): GearPtr; @@ -1037,7 +1546,11 @@ Function GearEncumberance( Mek: GearPtr { Return how many unscaled mass units this gear may carry without } { incurring a penalty. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if Mek = Nil then begin +{$ENDIF PATCH_GH} GearEncumberance := 0; end else if Mek^.G = GG_Mecha then begin { Encumberance value is basic MassPerMV + Size of mecha. } @@ -1057,7 +1570,14 @@ var IMass,EMass: LongInt; MV,EV: Integer; CPit: GearPtr; -begin +{$IFDEF PATCH_GH} + tmp: Int64; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + MV := 0; { Basic MV/TV is determined by the gear's mass and it's equipment. } @@ -1067,7 +1587,18 @@ begin EMass := EquipmentMass( Mek ) - EV; if EMass < 0 then EMass := 0; +{$IFDEF PATCH_GH} + tmp := - ( Int64(IMass) div MassPerMV + Int64(EMass) div EV ); + if tmp < -32767 then begin + MV := -32767; + end else if 32766 < tmp then begin + MV := 32766; + end else begin + MV := tmp; + end; +{$ELSE PATCH_GH} MV := - ( IMass div MassPerMV + EMass div EV ); +{$ENDIF PATCH_GH} { Seek the cockpit. If it's located in the head, +1 to MV and TR. } CPit := SeekGear( Mek , GG_Cockpit , 0 , False ); @@ -1080,7 +1611,11 @@ begin BaseMVTVScore := MV; end; +{$IFDEF PATCH_CHEAT} +Function ManeuverCost( Mek: GearPtr; Bonus: Boolean ): Integer; +{$ELSE PATCH_CHEAT} Function ManeuverCost( Mek: GearPtr ): Integer; +{$ENDIF PATCH_CHEAT} { Determine the MV cost multiplier for this mecha. } { A high MV results in a high multiplier; an augmented MV } { (by Gyros or other systems) increases that multiplier } @@ -1093,11 +1628,23 @@ begin if (Mek = Nil) or (Mek^.G <> GG_Mecha) then Exit( 0 ); { Find the basic maneuver value. } +{$IFDEF PATCH_CHEAT} + BMV := 0; + if Bonus then begin + BMV := BMV + FormMVBonus[ Mek^.S ]; + end; + BMV := BMV + BaseMVTVScore( Mek ); +{$ELSE PATCH_CHEAT} BMV := FormMVBonus[ Mek^.S ] + BaseMVTVScore( Mek ); +{$ENDIF PATCH_CHEAT} MV := BMV; { Modify for the gyroscope. } +{$IFDEF PATCH_CHEAT} + Gyro := SeekGear( Mek , GG_Support , GS_Gyro , False , Cheat_EnableCockpitBarrier ); +{$ELSE PATCH_CHEAT} Gyro := SeekGear( Mek , GG_Support , GS_Gyro , False ); +{$ENDIF PATCH_CHEAT} if Gyro <> Nil then MV := MV + Gyro^.V - 1; { Up to this point, no modifiers should take MV above 0. } @@ -1112,7 +1659,11 @@ begin ManeuverCost := MC; end; +{$IFDEF PATCH_CHEAT} +Function TargetingCost( Mek: GearPtr; Bonus: Boolean ): Integer; +{$ELSE PATCH_CHEAT} Function TargetingCost( Mek: GearPtr ): Integer; +{$ENDIF PATCH_CHEAT} { Determine the TR cost multiplier for this mecha. } { A high TR results in a high multiplier; an augmented TR } { (by TarComp or other systems) increases that multiplier } @@ -1124,11 +1675,23 @@ begin { Error check- MV can only be calculated for valid mecha. } if (Mek = Nil) or (Mek^.G <> GG_Mecha) then Exit( 0 ); +{$IFDEF PATCH_CHEAT} + BTR := 0; + if Bonus then begin + BTR := BTR + FormTRBonus[ Mek^.S ]; + end; + BTR := BTR + BaseMVTVScore( Mek ); +{$ELSE PATCH_CHEAT} BTR := FormTRBonus[ Mek^.S ] + BaseMVTVScore( Mek ); +{$ENDIF PATCH_CHEAT} TR := BTR; { Add the bonus for targeting computer, if applicable. } +{$IFDEF PATCH_CHEAT} + TarCom := SeekGear( Mek , GG_Sensor , GS_TarCom , False , Cheat_EnableCockpitBarrier ); +{$ELSE PATCH_CHEAT} TarCom := SeekGear( Mek , GG_Sensor , GS_TarCom , False ); +{$ENDIF PATCH_CHEAT} if TarCom <> Nil then TR := TR + TarCom^.V; { Up to this point, no modifiers should take TR above 0. } @@ -1144,13 +1707,27 @@ begin end; +{$IFDEF PATCH_GH} +Function ComponentValue( Part: GearPtr ): Int64; +{$ELSE PATCH_GH} Function ComponentValue( Part: GearPtr ): LongInt; +{$ENDIF PATCH_GH} {Calculate the scaled value of PART, ignoring for the} {moment its subcomponents.} var +{$IFDEF PATCH_GH} + it: Int64; + t,n: Integer; + MAV: Int64; +{$ELSE PATCH_GH} it: LongInt; t,n,MAV: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + Case Part^.G of GG_Module: it := 25 * Part^.V + 35 * Part^.Stat[ STAT_Armor ]; GG_Weapon: it := WeaponValue(Part); @@ -1176,6 +1753,11 @@ begin { Modify for mass adjustment. } MAV := NAttValue( PArt^.NA , NAG_GearOps , NAS_MassAdjust ); +{$IFDEF PATCH_CHEAT} + if (0 < SAttValueToInt( Part^.SA, SATT_SEPARABLE )) then begin + Dec( MAV ); + end; +{$ENDIF PATCH_CHEAT} { If at scale 0, mass reduction is FAR more expensive. } if ( Part^.Scale = 0 ) and ( MAV < 0 ) then MAV := MAV * 5; @@ -1212,14 +1794,29 @@ begin { Modify for Fudge. } it := it + NAttValue( Part^.NA , NAG_GearOps , NAS_Fudge ); +{$IFDEF PATCH_CHEAT} + { Modify for transformable. } + if ( 0 < SAttValueToInt(Part^.SA,SATT_TRANSFORMABLE) ) then begin + it := ( it * 175 ) div 100; + end; +{$ENDIF PATCH_CHEAT} + ComponentValue := it; end; +{$IFDEF PATCH_GH} +Function TrackValue( Part: GearPtr ): Int64; +{$ELSE PATCH_GH} Function TrackValue( Part: GearPtr ): LongInt; +{$ENDIF PATCH_GH} {Calculate the value of this list of gears, including all} {subcomponents.} var +{$IFDEF PATCH_GH} + it: Int64; +{$ELSE PATCH_GH} it: LongInt; +{$ENDIF PATCH_GH} begin {Initialize the total Value to 0.} it := 0; @@ -1240,10 +1837,17 @@ begin TrackValue := it; end; +{$IFDEF PATCH_GH} +Function BaseGearValue( Master: GearPtr ): Int64; +{$ELSE PATCH_GH} Function BaseGearValue( Master: GearPtr ): LongInt; +{$ENDIF PATCH_GH} {Calculate the value of MASTER, including all of its} {subcomponents.} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} {The formula to work out the total value of this gear} {is basic value + SubCom value + InvCom value.} BaseGearValue := ComponentValue(Master) + TrackValue(Master^.SubCom) + TrackValue(Master^.InvCom); @@ -1251,15 +1855,41 @@ end; Function GearValue( Master: GearPtr ): LongInt; { Calculate the value of this gear, adjusted for mecha stats. } +{$IFDEF PATCH_GH} +const + V_MAX = 2147483647; + V_MIN = -2147483648; +{$ENDIF PATCH_GH} var it: Int64; { Using a larger container than the cost needs so as to catch } MV: LongInt; { overflow when doing calculations. } -begin +{$IFDEF PATCH_CHEAT} + Bonus: Boolean; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} it := BaseGearValue( Master ); { Mecha have a special on-top-of-everything cost modifier for } { a high MV or TR. } if Master^.G = GG_Mecha then begin +{$IFDEF PATCH_CHEAT} + Bonus := True; + if ( '' <> SAttValue(Master^.SA,SATT_ADJUSTMENT_PV) ) then begin + it := ( it * SAttValueToInt( Master^.SA , SATT_ADJUSTMENT_PV ) ) div 100; + Bonus := False; + end; + + { Cost increases by 20% for every point above -4 } + MV := ManeuverCost( Master , Bonus ); + it := ( it * ( 100 + MV ) ) div 100; + + { The same rule applies for targeting. } + MV := TargetingCost( Master , Bonus ); + it := ( it * ( 100 + MV ) ) div 100; +{$ELSE PATCH_CHEAT} { Cost increases by 20% for every point above -4 } MV := ManeuverCost( Master ); it := ( it * ( 100 + MV ) ) div 100; @@ -1267,42 +1897,148 @@ begin { The same rule applies for targeting. } MV := TargetingCost( Master ); it := ( it * ( 100 + MV ) ) div 100; +{$ENDIF PATCH_CHEAT} end; +{$IFDEF PATCH_GH} + if (V_MAX < it) then begin + GearValue := V_MAX; + end else if (it < V_MIN) then begin + GearValue := V_MIN; + end else begin + GearValue := it; + end; +{$ELSE PATCH_GH} GearValue := it; +{$ENDIF PATCH_GH} end; function SeekGearByName( LList: GearPtr; Name: String ): GearPtr; { Seek a gear with the provided name. If no such gear is } { found, return NIL. } +{$IFDEF DEBUG} +var + Name_UpCase: String; + found: Integer; + + Function SeekGearByName_Sub( LList: GearPtr ): GearPtr; + var + it0, it1: GearPtr; + begin + it0 := NIL; + while (NIL <> LList) do begin + if (GG_DisposeGear < LList^.G) then begin + if UpCase( GearName( LList ) ) = Name_UpCase then begin + Inc(found); it0 := LList; + end; + {$IFDEF PATCH_I18N} + if UpCase( SAttValue( LList^.SA , 'NAME_ORG' ) ) = Name_UpCase then begin + Inc(found); if (NIL = it0) then it0 := LList; + end; + {$ENDIF PATCH_I18N} + it1 := SeekGearByName_Sub( LList^.SubCom ); if (NIL = it0) then it0 := it1; + it1 := SeekGearByName_Sub( LList^.InvCom ); if (NIL = it0) then it0 := it1; + end; + LList := LList^.Next; + end; + SeekGearByName_Sub := it0; + end; +{$ENDIF DEBUG} + var it: GearPtr; begin +{$IFDEF DEBUG} + found := 0; + Name_UpCase := UpCase( Name ); + it := SeekGearByName_Sub( LList ); + if (1 < found) then begin + ErrorMessage_fork('NOTICE: SeekGearByName(' + Name + ') found:'+ IntToStr(found) + '.' ); + end; +{$ELSE DEBUG} it := Nil; Name := UpCase( Name ); while LList <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < LList^.G) then begin +{$ENDIF PATCH_GH} if UpCase( GearName( LList ) ) = Name then it := LList; + {$IFDEF PATCH_I18N} + if ( it = Nil ) then if UpCase( SAttValue( LList^.SA , 'NAME_ORG' ) ) = Name then it := LList; + {$ENDIF PATCH_I18N} if ( it = Nil ) then it := SeekGearByName( LList^.SubCom , Name ); if ( it = Nil ) then it := SeekGearByName( LList^.InvCom , Name ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} LList := LList^.Next; end; +{$ENDIF DEBUG} SeekGearByName := it; end; function SeekGearByDesig( LList: GearPtr; Name: String ): GearPtr; { Seek a gear with the provided designation. If no such gear is } { found, return NIL. } +{$IFDEF DEBUG} +var + Name_UpCase: String; + found: Integer; + + Function SeekGearByDesig_Sub( LList: GearPtr ): GearPtr; + var + it0, it1: GearPtr; + begin + it0 := NIL; + while (NIL <> LList) do begin + if (GG_DisposeGear < LList^.G) then begin + if UpCase( SAttValue( LList^.SA , 'DESIG' ) ) = Name_UpCase then begin + Inc(found); it0 := LList; + end; + {$IFDEF PATCH_I18N} + if UpCase( SAttValue( LList^.SA , 'DESIG_ORG' ) ) = Name_UpCase then begin + Inc(found); if (NIL = it0) then it0 := LList; + end; + {$ENDIF PATCH_I18N} + it1 := SeekGearByDesig_Sub( LList^.SubCom ); if (NIL = it0) then it0 := it1; + it1 := SeekGearByDesig_Sub( LList^.InvCom ); if (NIL = it0) then it0 := it1; + end; + LList := LList^.Next; + end; + SeekGearByDesig_Sub := it0; + end; +{$ENDIF DEBUG} + var it: GearPtr; begin +{$IFDEF DEBUG} + found := 0; + Name_UpCase := UpCase( Name ); + it := SeekGearByDesig_Sub( LList ); + if (1 < found) then begin + ErrorMessage_fork('ERROR: SeekGearByDesig(' + Name + ') found:'+ IntToStr(found) + '.' ); + DialogMsg('ERROR: SeekGearByDesig(' + Name + ') found:'+ IntToStr(found) + '.' ); + end; +{$ELSE DEBUG} it := Nil; Name := UpCase( Name ); while LList <> Nil do begin + {$IFDEF PATCH_GH} + if (GG_DisposeGear < LList^.G) then begin + {$ENDIF PATCH_GH} if UpCase( SAttValue( LList^.SA , 'DESIG' ) ) = Name then it := LList; + {$IFDEF PATCH_I18N} + if ( it = Nil ) then if UpCase( SAttValue( LList^.SA , 'DESIG_ORG' ) ) = Name then it := LList; + {$ENDIF PATCH_I18N} if ( it = Nil ) then it := SeekGearByDesig( LList^.SubCom , Name ); if ( it = Nil ) then it := SeekGearByDesig( LList^.InvCom , Name ); + {$IFDEF PATCH_GH} + end; + {$ENDIF PATCH_GH} LList := LList^.Next; end; +{$ENDIF DEBUG} SeekGearByDesig := it; end; @@ -1312,16 +2048,54 @@ function SeekGearByIDTag( LList: GearPtr { ID numbers like Personal/CID or Narrative/NID, but I guess you } { could use it to find a part that's taken Damage/Struct/40 or } { whatever. } +{$IFDEF DEBUG} +var + found: Integer; + + Function SeekGearByIDTag_Sub( LList: GearPtr ): GearPtr; + var + it0, it1: GearPtr; + begin + it0 := NIL; + while (NIL <> LList) do begin + if (GG_DisposeGear < LList^.G) then begin + if NAttValue( LList^.NA , G , S ) = V then begin + Inc(found); it0 := LList; + end; + it1 := SeekGearByIDTag_Sub( LList^.SubCom ); if (NIL = it0) then it0 := it1; + it1 := SeekGearByIDTag_Sub( LList^.InvCom ); if (NIL = it0) then it0 := it1; + end; + LList := LList^.Next; + end; + SeekGearByIDTag_Sub := it0; + end; +{$ENDIF DEBUG} + var it: GearPtr; begin +{$IFDEF DEBUG} + found := 0; + it := SeekGearByIDTag_Sub( LList ); + if (1 < found) { and not((NAG_Personal = G) and (NAS_CID = S) and (0 = V)) } and not((5 = G) and (0 = S) and (0 = V)) then begin + ErrorMessage_fork('ERROR: SeekGearByIDTag( G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', V:' + IntToStr(V) + ' ) found:'+ IntToStr(found) + '.' ); + DialogMsg('ERROR: SeekGearByIDTag( G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', V:' + IntToStr(V) + ' ) found:'+ IntToStr(found) + '.' ); + end; +{$ELSE DEBUG} it := Nil; while LList <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < LList^.G) then begin +{$ENDIF PATCH_GH} if NAttValue( LList^.NA , G , S ) = V then it := LList; if ( it = Nil ) then it := SeekGearByIDTag( LList^.SubCom , G , S , V ); if ( it = Nil ) then it := SeekGearByIDTag( LList^.InvCom , G , S , V ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} LList := LList^.Next; end; +{$ENDIF DEBUG} SeekGearByIDTag := it; end; @@ -1371,8 +2145,18 @@ Function EncumberanceLevel( PC: GearPtr { Return a value indicating this character's current } { encumberance level. } var +{$IFDEF PATCH_GH} + EMass: LongInt; + EV: Integer; + ret: LongInt; +{$ELSE PATCH_GH} EMass,EV: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + EV := GearEncumberance( PC ); if EV < 1 then EV := 1; EMass := EquipmentMass( PC ) - EV; @@ -1383,7 +2167,16 @@ begin end; if EMass > 0 then begin +{$IFDEF PATCH_GH} + ret := EMass div EV; + if 32767 < ret then begin + EncumberanceLevel := 32767; + end else begin + EncumberanceLevel := ret; + end; +{$ELSE PATCH_GH} EncumberanceLevel := EMass div EV; +{$ENDIF PATCH_GH} end else begin EncumberanceLevel := 0; end; @@ -1488,6 +2281,11 @@ var NA: NAttPtr; { Numeric Attribute pointer } SA: SAttPtr; { String Attribute pointer } begin +{$IFDEF PATCH_GH} + { Garbage Collect } + Purge_Att( G ); +{$ENDIF PATCH_GH} + { Allocate memory for our SAMple. } Sam := NewGear( Nil ); @@ -1689,4 +2487,77 @@ begin ReadCGears := REALReadGears( Nil ); end; + +{$IFDEF PATCH_GH} +Function CheckAlongPath_DisallowSelling( P: GearPtr ): Boolean; + Function CheckAlongPath( P: GearPtr ): Boolean; + begin + while ( NIL <> P ) do begin + if DisallowSelling( P ) then Exit( True ); + if CheckAlongPath( P^.InvCom ) then Exit( True ); + if CheckAlongPath( P^.SubCom ) then Exit( True ); + P := P^.Next; + end; + CheckAlongPath := False; + end; +begin + if DisallowSelling( P ) then Exit( True ); + if CheckAlongPath( P^.InvCom ) then Exit( True ); + if CheckAlongPath( P^.SubCom ) then Exit( True ); + CheckAlongPath_DisallowSelling := False; +end; + +Function CheckAlongPath_DisallowDropping( P: GearPtr ): Boolean; + Function CheckAlongPath( P: GearPtr ): Boolean; + begin + while ( NIL <> P ) do begin + if DisallowDropping( P ) then Exit( True ); + if CheckAlongPath( P^.InvCom ) then Exit( True ); + if CheckAlongPath( P^.SubCom ) then Exit( True ); + P := P^.Next; + end; + CheckAlongPath := False; + end; +begin + if DisallowDropping( P ) then Exit( True ); + if CheckAlongPath( P^.InvCom ) then Exit( True ); + if CheckAlongPath( P^.SubCom ) then Exit( True ); + CheckAlongPath_DisallowDropping := False; +end; + +Function CheckAlongPath_DisallowTransfering( P: GearPtr ): Boolean; + Function CheckAlongPath( P: GearPtr ): Boolean; + begin + while ( NIL <> P ) do begin + if DisallowTransfering( P ) then Exit( True ); + if CheckAlongPath( P^.InvCom ) then Exit( True ); + if CheckAlongPath( P^.SubCom ) then Exit( True ); + P := P^.Next; + end; + CheckAlongPath := False; + end; +begin + if DisallowTransfering( P ) then Exit( True ); + if CheckAlongPath( P^.InvCom ) then Exit( True ); + if CheckAlongPath( P^.SubCom ) then Exit( True ); + CheckAlongPath_DisallowTransfering := False; +end; +{$ENDIF PATCH_GH} + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: gearutil.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: gearutil.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/gflooker.pp branches/gflooker.pp --- GearHead1100repository.original/gflooker.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/gflooker.pp 2015-08-01 09:00:00.000000000 +0900 @@ -28,7 +28,11 @@ unit gflooker; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; const LOOKER_AutoSelect: Boolean = True; { Auto select new target if no current target. } @@ -36,7 +40,10 @@ const var LOOKER_X,LOOKER_Y: Integer; { Last X , Y position accessed. } LOOKER_Gear: GearPtr; { Last mecha accessed. } +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} LOOKER_LastGearSelected: GearPtr; { Last enemy selected with select next enemy key. } +{$ENDIF PATCH_GH} Function WeaponBVSetting( Weapon: GearPtr ): Integer; @@ -45,15 +52,37 @@ Function SelectTarget( GB: GameBoardPtr; implementation +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + ui4gh, + ability,damage,gearutil,ghweapon,menugear,texutil, +{$ELSE PATCH_GH} + ability,damage,gearutil,ghweapon,menugear,texutil,ui4gh, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + backpack, +{$ENDIF PATCH_CHEAT} {$IFDEF SDLMODE} -uses ability,damage,gearutil,ghweapon,menugear,texutil,ui4gh, - sdlgfx,sdlinfo,sdlmap,sdlmenus; + sdlgfx,sdlinfo,sdlmap,sdlmenus {$ELSE} -uses ability,damage,gearutil,ghweapon,menugear,texutil,ui4gh, - congfx,coninfo,conmap,conmenus,context; + congfx,coninfo,conmap,conmenus,context {$ENDIF} + ; var +{$IFDEF PATCH_GH} + LOOKER_LastGearSelected: GearPtr; { Last enemy selected with select next enemy key. } +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} LOOKER_Origin,LOOKER_Weapon: GearPtr; LOOKER_CallShot: Boolean; LOOKER_RapidFire: Integer; @@ -68,7 +97,11 @@ Function WeaponBVSetting( Weapon: GearPt var BV: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(BV_Off); +{$ELSE PATCH_GH} if Weapon = Nil then Exit( BV_Off ); +{$ENDIF PATCH_GH} BV := NAttValue( Weapon^.NA , NAG_Prefrences , NAS_DefAtOp ); if BV = 0 then begin @@ -94,7 +127,11 @@ Procedure DoSwitchBV; var BV: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = LOOKER_Weapon) or (LOOKER_Weapon^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if LOOKER_Weapon = Nil then Exit; +{$ENDIF PATCH_GH} { Determine the current BV; this will tell us what to do next. } BV := WeaponBVSetting( LOOKER_Weapon ); @@ -116,6 +153,15 @@ var msg: String; begin { Generate instructions. } +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('WeaponDisplay_KeyMap','SwitchWeapon'), KeyMap[ KMC_SwitchWeapon ].KCode ); + msg := msg + #13 + ' ' + ReplaceHash( I18N_MsgString('WeaponDisplay_KeyMap','CalledShot'), KeyMap[ KMC_CalledShot ].KCode ); + if LOOKER_CallShot then msg := msg + I18N_MsgString('WeaponDisplay_KeyMap','CalledShot_On') + else msg := msg + I18N_MsgString('WeaponDisplay_KeyMap','CalledShot_Off'); + msg := msg + #13 + ' ' + ReplaceHash( I18N_MsgString('WeaponDisplay_KeyMap','SwitchBV'), KeyMap[ KMC_SwitchBV ].KCode ); + msg := msg + BVTypeName[ WeaponBVSetting( LOOKER_Weapon ) ]; + msg := msg + #13 + ' ' + ReplaceHash( I18N_MsgString('WeaponDisplay_KeyMap','SwitchTarget'), KeyMap[ KMC_SwitchTarget ].KCode ); +{$ELSE PATCH_I18N} msg := '[' + KeyMap[ KMC_SwitchWeapon ].KCode + '] Change Weapon' + #13; msg := msg + ' [' + KeyMap[ KMC_CalledShot ].KCode + '] Called Shot: '; if LOOKER_CallShot then msg := msg + 'On' @@ -123,6 +169,7 @@ begin msg := msg + #13 + ' [' + KeyMap[ KMC_SwitchBV ].KCode + '] Burst Value: '; msg := msg + BVTypeName[ WeaponBVSetting( LOOKER_Weapon ) ]; msg := msg + #13 + ' [' + KeyMap[ KMC_SwitchTarget ].KCode + '] Switch Target'; +{$ENDIF PATCH_I18N} { Print instructions. } {$IFDEF SDLMODE} @@ -139,7 +186,13 @@ Procedure GFLRedraw; { menu redrawer for this unit. } begin if LOOKER_GB <> Nil then BasicCombatDisplay( LOOKER_GB ); +{$IFDEF PATCH_GH} + if (NIL <> Looker_Weapon) and (GG_DisposeGear < Looker_Weapon^.G) then begin + WeaponDisplay; + end; +{$ELSE PATCH_GH} if LOOKER_Weapon <> Nil then WeaponDisplay; +{$ENDIF PATCH_GH} NFCMessage( LOOKER_Desc , ZONE_Clock , InfoHilight ); end; {$ENDIF} @@ -166,6 +219,26 @@ begin if PName <> msg then msg := msg + ' - ' + PName; if not GearOperational( Mek ) then begin +{$IFDEF PATCH_I18N} + if NAttValue( Mek^.NA , NAG_EpisodeData , NAS_Gutted) = 1 then begin + if NAttValue( Mek^.NA , NAG_EpisodeData , NAS_Flayed) = 1 then begin + msg := msg + I18N_MsgString('CreateTileMechaMenu', 'stripped'); + end else begin + msg := msg + I18N_MsgString('CreateTileMechaMenu', 'gutted'); + end; + end else begin + if NAttValue( Mek^.NA , NAG_EpisodeData , NAS_Flayed) = 1 then begin + msg := msg + I18N_MsgString('CreateTileMechaMenu', 'flayed'); + end else begin + msg := msg + I18N_MsgString('CreateTileMechaMenu', 'X'); + end; + end; + if NAttValue( Mek^.NA , NAG_EpisodeData , NAS_Ransacked) = 1 then begin + msg := msg + I18N_MsgString('CreateTileMechaMenu', 'looted'); + end else begin + msg := msg + I18N_MsgString('CreateTileMechaMenu', ''); + end; +{$ELSE PATCH_I18N} if NAttValue( Mek^.NA , NAG_EpisodeData , NAS_Gutted) = 1 then begin if NAttValue( Mek^.NA , NAG_EpisodeData , NAS_Flayed) = 1 @@ -187,6 +260,7 @@ begin msg := msg + ', looted)' else msg := msg + ')'; +{$ENDIF PATCH_I18N} end; if ShowAll or GearOperational( Mek ) then begin AddRPGMenuItem( TMM , msg , T ); @@ -209,14 +283,28 @@ begin { Display info for target square. } N := NumVisibleGears( GB , X , Y ); if not OnTheMap( X , Y ) then begin +{$IFDEF PATCH_I18N} + GameMSG( I18N_MsgString('DisplayTileInfo','Off The Map') , ZONE_Info , StdWhite ); +{$ELSE PATCH_I18N} GameMSG( 'Off The Map' , ZONE_Info , StdWhite ); +{$ENDIF PATCH_I18N} LOOKER_Gear := Nil; end else if N = 0 then begin if GB^.Map[X,Y].Visible then begin msg := ''; +{$IFDEF PATCH_GH} + if (NIL <> GB^.Scene) and (GG_DisposeGear < GB^.Scene^.G) then begin + msg := SAttValue( GB^.Scene^.SA , 'LOOKER' + BStr( X ) + '%' + BStr( Y ) ); + end; +{$ELSE PATCH_GH} if GB^.Scene <> Nil then msg := SAttValue( GB^.Scene^.SA , 'LOOKER' + BStr( X ) + '%' + BStr( Y ) ); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + if msg = '' then msg := I18N_Name('TerrMan',TerrMan[GB^.map[X,Y].Terr].Name); +{$ELSE PATCH_I18N} if msg = '' then msg := TerrMan[GB^.map[X,Y].Terr].Name; +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} NFCMessage( msg , ZONE_Info , TerrainGreen ); {$ELSE} @@ -224,9 +312,17 @@ begin {$ENDIF} end else begin {$IFDEF SDLMODE} +{$IFDEF PATCH_I18N} + NFCMessage( I18N_MsgString('DisplayTileInfo','UNKNOWN') , ZONE_Info , TerrainGreen ); +{$ELSE PATCH_I18N} NFCMessage( 'UNKNOWN' , ZONE_Info , TerrainGreen ); +{$ENDIF PATCH_I18N} {$ELSE} +{$IFDEF PATCH_I18N} + CMessage( I18N_MsgString('DisplayTileInfo','UNKNOWN') , ZONE_Info , TerrainGreen ); +{$ELSE PATCH_I18N} CMessage( 'UNKNOWN' , ZONE_Info , TerrainGreen ); +{$ENDIF PATCH_I18N} {$ENDIF} end; @@ -268,7 +364,18 @@ var PickNext: Boolean; begin { If we've already selected an enemy, find the next one from that point. } +{$IFDEF PATCH_GH} + if (NIL = LOOKER_LastGearSelected) or (LOOKER_LastGearSelected^.G <= GG_DisposeGear) then begin + if (NIL <> LOOKER_Gear) and (GG_DisposeGear < LOOKER_Gear^.G) then begin + LOOKER_LastGearSelected := LOOKER_Gear; + end else begin + LOOKER_LastGearSelected := NIL; + end; + end; + if (NIL = Origin) or (Origin^.G <= GG_DisposeGear) then Exit(NIL); +{$ELSE PATCH_GH} if ( LOOKER_LastGearSelected = Nil ) and ( LOOKER_Gear <> Nil ) then LOOKER_LastGearSelected := LOOKER_Gear; +{$ENDIF PATCH_GH} { Cycle through all the models on the map looking for a visible, operational enemy. } M := GB^.Meks; @@ -276,6 +383,9 @@ begin PickNext := False; FirstTarget := Nil; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} { If M fits our target criteria, check it to see what's going on. } if OnTheMap( M ) and AreEnemies( GB , Origin , M ) and GearOperational( M ) and MekCanSeeTarget( GB , Origin , M ) then begin { If M is the target we started with, set the flag to pick the next } @@ -288,6 +398,9 @@ begin end; if FirstTarget = Nil then FirstTarget := M; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -305,37 +418,126 @@ Function TrueLooker( GB: GameBoardPtr; X { If Mek <> Nil, do range calculations from that spot. } { If WPN <> Nil, allow weapon selection. } var +{$IFDEF PATCH_GH} + N: Integer; + MekNum: LongInt; +{$ELSE PATCH_GH} N,MekNum: Integer; +{$ENDIF PATCH_GH} TMM: RPGMenuPtr; A: Char; P: Point; +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + Target_X,Target_Y: Integer; + flag_mouse: Boolean; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} Procedure RepositionCursor( D: Integer ); begin RedrawTile( gb, X , Y ); if OnTheMap( X + AngDir[ D , 1 ] , Y + AngDir[ D , 2 ] ) then begin X := X + AngDir[ D , 1 ]; Y := Y + AngDir[ D , 2 ]; - end; - end; +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + RedrawTile( GB , Target_X , Target_Y ); + Target_X := X; + Target_Y := Y; + flag_mouse := False; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} + end; + end; +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} +var + M: Point; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} begin { Error check- make sure the start point is on the screen. } if not OnTheMap(X,Y) then begin +{$IFDEF PATCH_GH} + LOOKER_Gear := FindNextTarget( GB , LOOKER_Origin ); + if ( NIL <> LOOKER_Gear ) then begin + X := NAttValue( LOOKER_Gear^.NA , NAG_Location , NAS_X ); + Y := NAttValue( LOOKER_Gear^.NA , NAG_Location , NAS_Y ); + end; + if ( not OnTheMap(X,Y) ) and ( NIL <> LOOKER_Origin ) then begin + X := NAttValue( LOOKER_Origin^.NA , NAG_Location , NAS_X ); + Y := NAttValue( LOOKER_Origin^.NA , NAG_Location , NAS_Y ); + end; + if not OnTheMap(X,Y) then begin + X := 1; + Y := 1; + end; +{$ELSE PATCH_GH} X := 1; Y := 1; +{$ENDIF PATCH_GH} end; +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + Target_X := X; + Target_Y := Y; + flag_mouse := False; + MouseAtTile( GB , Target_X , Target_Y ); + RedrawTile( GB , Target_X , Target_Y ); + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} + LOOKER_LastGearSelected := Nil; +{$IFDEF PATCH_GH} + if (NIL <> LOOKER_Origin) and (GG_DisposeGear < LOOKER_Origin^.G) then begin + P := GearCurrentLocation( LOOKER_Origin ); + end else begin + LOOKER_Origin := NIL; + end; + if (NIL <> LOOKER_Gear) and (GG_DisposeGear < LOOKER_Gear^.G) then begin + end else begin + LOOKER_Gear := NIL; + end; + if (NIL <> LOOKER_Weapon) and (GG_DisposeGear < LOOKER_Weapon^.G) then begin + end else begin + LOOKER_Weapon := NIL; + end; +{$ELSE PATCH_GH} if LOOKER_Origin <> Nil then P := GearCurrentLocation( LOOKER_Origin ); +{$ENDIF PATCH_GH} { Start going here. } repeat {$IFDEF SDLMODE} LOOKER_GB := GB; + {$IFDEF PATCH_CHEAT} + if Cheat_Display_SW then begin + end else begin + GFLRedraw; + end; + {$ELSE PATCH_CHEAT} GFLRedraw; + {$ENDIF PATCH_CHEAT} {$ENDIF} { Display info on the selected tile. } +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + DisplayTileInfo( GB , Target_X , Target_Y ); + if flag_mouse then begin + if ( Target_X <> X ) or ( Target_Y <> Y ) then begin + MouseAtTile( GB , Target_X , Target_Y ); + end; + end else begin + MouseAtTile( GB , -1 , -1 ); + end; + {$ELSE SDLMODE} + DisplayTileInfo( GB , X , Y ); + {$ENDIF SDLMODE} +{$ELSE PATCH_GH} DisplayTileInfo( GB , X , Y ); +{$ENDIF PATCH_GH} if ( LOOKER_Origin <> Nil ) and OnTheMap( LOOKER_Origin ) then begin if LOOKER_Gear = Nil then begin @@ -346,9 +548,25 @@ begin {$ENDIF} end else begin {$IFDEF SDLMODE} + {$IFDEF PATCH_CHEAT} + if Cheat_Range_Colored and not MekCanSeeTarget( GB , FindRoot( LOOKER_Gear ) , LOOKER_Origin ) then begin + NFCMessage( 'Range* ' + BStr( ScaleRange( Range(gb,LOOKER_Origin,LOOKER_Gear) , GB^.Scale )) + ' Cover* '+CoverDesc( CalcObscurement( LOOKER_Origin , LOOKER_Gear , gb )) , ZONE_Clock , InfoHiLight ); + end else begin + NFCMessage( 'Range: ' + BStr( ScaleRange( Range(gb,LOOKER_Origin,LOOKER_Gear) , GB^.Scale )) + ' Cover: '+CoverDesc( CalcObscurement( LOOKER_Origin , LOOKER_Gear , gb )) , ZONE_Clock , InfoGreen ); + end; + {$ELSE PATCH_CHEAT} NFCMessage( 'Range: ' + BStr( ScaleRange( Range(gb,LOOKER_Origin,LOOKER_Gear) , GB^.Scale )) + ' Cover: '+CoverDesc( CalcObscurement( LOOKER_Origin , LOOKER_Gear , gb )) , ZONE_Clock , InfoGreen ); + {$ENDIF PATCH_CHEAT} {$ELSE} + {$IFDEF PATCH_CHEAT} + if Cheat_Range_Colored and not MekCanSeeTarget( GB , FindRoot( LOOKER_Gear ) , LOOKER_Origin ) then begin + CMessage( 'Range* ' + BStr( ScaleRange( Range(gb,LOOKER_Origin,LOOKER_Gear) , GB^.Scale )) + ' Cover* '+CoverDesc( CalcObscurement( LOOKER_Origin , LOOKER_Gear , gb )) , ZONE_Clock , InfoHiLight ); + end else begin + CMessage( 'Range: ' + BStr( ScaleRange( Range(gb,LOOKER_Origin,LOOKER_Gear) , GB^.Scale )) + ' Cover: '+CoverDesc( CalcObscurement( LOOKER_Origin , LOOKER_Gear , gb )) , ZONE_Clock , InfoGreen ); + end; + {$ELSE PATCH_CHEAT} CMessage( 'Range: ' + BStr( ScaleRange( Range(gb,LOOKER_Origin,LOOKER_Gear) , GB^.Scale )) + ' Cover: '+CoverDesc( CalcObscurement( LOOKER_Origin , LOOKER_Gear , gb )) , ZONE_Clock , InfoGreen ); + {$ENDIF PATCH_CHEAT} {$ENDIF} end; end; @@ -401,6 +619,16 @@ begin X := NATtValue( LOOKER_Gear^.NA , NAG_Location , NAS_X ); Y := NATtValue( LOOKER_Gear^.NA , NAG_Location , NAS_Y ); end; +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + if OnTheMap( X , Y ) then begin + RedrawTile( GB , Target_X , Target_Y ); + Target_X := X; + Target_Y := Y; + end; + flag_mouse := False; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} end else if ( A = KeyMap[ KMC_SwitchBV ].KCode ) and ( LOOKER_Weapon <> Nil ) and ( LOOKER_Origin <> Nil ) then begin DoSwitchBV; @@ -417,7 +645,73 @@ begin {$IFDEF SDLMODE} end else if A = #8 then begin A := #27; +{$IFDEF PATCH_GH} + end else if A = #13 then begin + A := ' '; + end else if A = #10 then begin + A := ' '; +{$ENDIF PATCH_GH} {$ENDIF} +{$IFDEF PATCH_CHEAT} + end else if Cheat_NPC_Edit and (A = KeyMap[ KMC_SelectPortrait ].KCode) then begin + if (LOOKER_Gear <> Nil) and (LOOKER_Gear^.G = GG_Character) then begin + SelectPortrait( LOOKER_Gear ); + ClrZone(ZONE_Menu); + end; + end else if Cheat_NPC_Edit and (A = KeyMap[ KMC_RenameMecha ].KCode) then begin + if (LOOKER_Gear <> Nil) then Rename_Mecha( GB , LOOKER_Gear ); + end else if Cheat_NPC_Edit and Cheat_MenuOrder_Edit and (A = KeyMap[ KMC_EditMenuOrder ].KCode) then begin + if (LOOKER_Gear <> Nil) then begin + {$IFDEF SDLMODE} + MechaPartBrowser( LOOKER_Gear , @GFLRedraw ) + {$ELSE SDLMODE} + MechaPartBrowser( LOOKER_Gear ) + {$ENDIF SDLMODE} + end else begin + LOOKER_Gear := NewGear(Nil); + LOOKER_Gear^.G := GG_Scene; + LOOKER_Gear^.InvCom := GB^.meks; + {$IFDEF SDLMODE} + MechaPartBrowser( LOOKER_Gear , @GFLRedraw ); + {$ELSE SDLMODE} + MechaPartBrowser( LOOKER_Gear ); + {$ENDIF SDLMODE} + GB^.meks := LOOKER_Gear^.InvCom; + LOOKER_Gear^.InvCom := Nil; + DisposeGear(LOOKER_Gear); + end; + ClrZone(ZONE_Menu); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + end else if ( RPK_MouseButton = A ) then begin + if IsMouseOnMap and ( not IsMenuActive ) then begin + flag_mouse := True; + RedrawTile( GB , X , Y ); + M := MouseMapPos; + if OnTheMap( M.X , M.Y ) then begin + X := M.X; + Y := M.Y; + Target_X := M.X; + Target_Y := M.Y; + end; + end; + + end else if ( RPK_RightButton = A ) then begin + A := #27; + + end else if ( RPK_MouseMotion = A ) then begin + if IsMouseOnMap and ( not IsMenuActive ) then begin + flag_mouse := True; + RedrawTile( GB , Target_X , Target_Y ); + M := MouseMapPos; + if OnTheMap( M.X , M.Y ) then begin + Target_X := M.X; + Target_Y := M.Y; + end; + end; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} end; @@ -425,6 +719,11 @@ begin { Restore the display. } RedrawTile( gb, X , Y ); +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + RedrawTile( GB, Target_X , Target_Y ); + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} if LOOKER_Origin <> Nil then RedrawTile( gb, LOOKER_Origin ); UpdateCombatDisplay( GB ); @@ -436,14 +735,70 @@ begin if N = 1 then begin LOOKER_Gear := FindVisibleGear( GB , X , Y , 1 ); +{$IFDEF PATCH} + end else if (N > 1) and (A = ' ') then begin +{$ELSE} end else if N > 1 then begin +{$ENDIF} TMM := CreateTileMechaMenu( GB , X , Y , Looker_Weapon = Nil ); if TMM^.NumItem > 1 then begin -{$IFDEF SDLMODE} +{$IFDEF PATCH_CHEAT} + if Cheat_LookInfo and not(LOOKER_CallShot and Cheat_CallShot and Cheat_CallShot_OmitLookInfo) then begin + repeat + {$IFDEF SDLMODE} + MekNum := SelectMenu( TMM , @GFLRedraw ); + {$ELSE SDLMODE} + MekNum := SelectMenu( TMM ); + {$ENDIF SDLMODE} + if MekNum <> -1 then begin + DisplayGearInfo( FindVisibleGear( GB , X , Y , MekNum ) , GB , ZONE_Info ); + {$IFDEF SDLMODE} + GHFlip; + {$IFDEF PATCH_GH} + repeat + A := RPGKey; + until ( ( RPK_TimeEvent <> A ) and ( RPK_MouseMotion <> A ) ); + + if A = #13 then begin + A := ' '; + end else if A = #10 then begin + A := ' '; + end; + {$ELSE PATCH_GH} + repeat + A := RPGKey; + until A <> RPK_TimeEvent; + {$ENDIF PATCH_GH} + {$ELSE SDLMODE} + A := RPGKey; + {$ENDIF SDLMODE} + if (A = KeyMap[ KMC_ExamineMap ].KCode) or (A = #8) then A := #27 + else if A = KeyMap[ KMC_Attack ].KCode then A := ' '; + + if (A = #27) then A := 'A'; + end; + until (MekNum = -1) or (A = ' ') or (A = #27) or (A = #10); + if MekNum = -1 then A := #27; + end else begin + {$IFDEF SDLMODE} + MekNum := SelectMenu( TMM , @GFLRedraw ); + {$ELSE SDLMODE} + MekNum := SelectMenu( TMM ); + {$ENDIF SDLMODE} + {$IFDEF PATCH_GH} + if MekNum = -1 then A := #27; + {$ENDIF PATCH_GH} + end; +{$ELSE PATCH_CHEAT} + {$IFDEF SDLMODE} MekNum := SelectMenu( TMM , @GFLRedraw ); -{$ELSE} + {$ELSE SDLMODE} MekNum := SelectMenu( TMM ); -{$ENDIF} + {$ENDIF SDLMODE} + {$IFDEF PATCH_GH} + if MekNum = -1 then A := #27; + {$ENDIF PATCH_GH} +{$ENDIF PATCH_CHEAT} end else if TMM^.NumItem > 0 then begin MekNum := TMM^.FirstItem^.Value; end else begin @@ -468,6 +823,12 @@ Function LookAround( GB: GameBoardPtr; M var X,Y: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then begin + Mek := NIL; + end; +{$ENDIF PATCH_GH} + LOOKER_Origin := Mek; LOOKER_Weapon := Nil; @@ -491,6 +852,11 @@ var X,Y: Integer; FunResult: Boolean; { Function Result } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Wpn) or (Wpn^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + LOOKER_Origin := Mek; LOOKER_Weapon := Wpn; LOOKER_CallShot := CallShot; @@ -538,4 +904,32 @@ end; +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: gflooker.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + LOOKER_Gear := NIL; + LOOKER_LastGearSelected := NIL; + LOOKER_Origin := NIL; + LOOKER_Weapon := NIL; + Attach_SmartPointer( 'LOOKER_Gear: GearPtr', @LOOKER_Gear ); + Attach_SmartPointer( 'LOOKER_LastGearSelected: GearPtr', @LOOKER_LastGearSelected ); + Attach_SmartPointer( 'LOOKER_Origin: GearPtr', @LOOKER_Origin ); + Attach_SmartPointer( 'LOOKER_Weapon: GearPtr', @LOOKER_Weapon ); + {$IFDEF SDLMODE} + LOOKER_GB := NIL; + Attach_SmartPointer( 'LOOKER_GB: GameBoardPtr', @LOOKER_GB ); + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: gflooker.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghchars.pp branches/ghchars.pp --- GearHead1100repository.original/ghchars.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghchars.pp 2014-08-16 09:00:00.000000000 +0900 @@ -30,7 +30,11 @@ interface { S = Undefined } { V = Threat Rating (used for wandering monsters and other encounters) } -uses gears; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; Type SkillDesc = Record @@ -53,6 +57,7 @@ Const NAG_StatImprovementLevel = 11; { Counts how many times a stat has been } { improved through experience. } + { PATCH_I18N: Don't translate here, use GameData/I18N_messages.txt. } StatName: Array [1..NumGearStats] of String = ( 'Reflexes','Body','Speed','Perception', 'Craft','Ego','Knowledge','Charm' @@ -80,6 +85,7 @@ Const NAV_Male = 0; NAV_Female = 1; + { PATCH_I18N: Don't translate here, use GameData/I18N_messages.txt. } GenderName: Array[0..1] of String = ( 'Male' , 'Female' ); NAS_DAge = 1; { CharDescription/Delta age - Offset from 20. } @@ -92,13 +98,14 @@ Const Num_Personality_Traits = 7; NAS_Heroic = -1; { CharDescription/ Heroic <-> Villanous } NAS_Lawful = -2; { CharDescription/ Lawful <-> Chaotic } - NAS_Sociable = -3; { CharDescription/ Assertive <-> Shy } + NAS_Sociable = -3; { CharDescription/ Sociable (Old-TypeName:Assertive) <-> Shy } NAS_Easygoing = -4; { CharDescription/ Easygoing <-> Passionate } NAS_Cheerful = -5; { CharDescription/ Cheerful <-> Melancholy } - NAS_Renowned = -6; { CharDescription/ Renowned <-> Hopeless } + NAS_Renowned = -6; { CharDescription/ Renowned <-> Wangtta (Old-TypeName:Hopeless) } NAS_Pragmatic = -7; { CharDescription/ Pragmatic <-> Spiritual } + { PATCH_I18N: Don't translate here, use GameData/I18N_messages.txt. } PTraitName: Array [1..Num_Personality_Traits,1..2] of String = ( ( 'Heroic','Villainous' ), ( 'Lawful','Chaotic' ), @@ -154,6 +161,7 @@ Const USAGE_DominateAnimal = 5; { Yet another unique skill. } USAGE_PickPockets = 6; { The same. } + { PATCH_I18N: Don't translate here, use GameData/I18N_messages.txt. } SkillMan: Array [1..NumSkill] of SkillDesc = ( ( name: 'Mecha Gunnery'; stat: STAT_Reflexes; @@ -410,6 +418,9 @@ Function SkillAdvCost( PC: GearPtr; Curr function IsLegalCharSub( SPC, Part: GearPtr ): Boolean; +{$IFDEF PATCH_I18N} +Function PersonalityTraitDesc( Trait,Level: Integer; I18N: Boolean ): String; +{$ENDIF PATCH_I18N} Function PersonalityTraitDesc( Trait,Level: Integer ): String; Function NPCTraitDesc( NPC: GearPtr ): String; @@ -419,12 +430,23 @@ Procedure ApplyTalent( PC: GearPtr; T: I implementation -uses texutil; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} + texutil; Procedure InitChar(Part: GearPtr); {PART is a newly created Character record.} {Initialize its stuff.} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + {Default scale for a PC is 0.} Part^.Scale := 0; @@ -438,6 +460,10 @@ Function CharBaseDamage( PC: GearPtr; CB var HP: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + {Error check- make sure we have a character here.} if PC^.G <> GG_Character then Exit(0); HP := ( CBod + 5 ) div 2; @@ -453,6 +479,10 @@ Function CharStamina( PC: GearPtr ): Int var SP: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + {Error check- make sure we have a character here.} if PC^.G <> GG_Character then Exit(0); @@ -470,6 +500,10 @@ Function CharMental( PC: GearPtr ): Inte var MP: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + {Error check- make sure we have a character here.} if PC^.G <> GG_Character then Exit(0); @@ -488,6 +522,10 @@ Function CharCurrentStamina( PC: GearPtr var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + {Error check- make sure we have a character here.} if PC^.G <> GG_Character then Exit(0); @@ -501,6 +539,10 @@ Function CharCurrentMental( PC: GearPtr var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + {Error check- make sure we have a character here.} if PC^.G <> GG_Character then Exit(0); @@ -700,6 +742,9 @@ Function NumberOfSkills( PC: GearPtr ): var T,N: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} N := 0; for t := 1 to NumSkill do begin if NAttValue( PC^.NA , NAG_Skill , T ) > 0 then Inc( N ); @@ -712,6 +757,9 @@ Function NumberOfSkillSlots( PC: GearPtr var N: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} N := ( ( PC^.STat[ STAT_Knowledge ] * 6 ) div 5 + 5 ); if NAttValue( PC^.NA , NAG_Talent , NAS_Savant ) <> 0 then N := N + 5; NumberOfSkillSlots := N; @@ -720,6 +768,9 @@ end; Function TooManySkillsPenalty( PC: GearPtr; N: Integer ): Integer; { Return the % XP penalty that this character will suffer. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} N := N - NumberOfSkillSlots( PC ); N := N * 10 - 5; if N < 0 then N := 0; @@ -735,9 +786,20 @@ const 500,800,1300,2100,3400, 5500,8900,14400,23300,37700 ); +{$IFDEF PATCH_GH} + SAC_MAX = 2147483647; + SAC_MIN = -2147483648; +{$ENDIF PATCH_GH} var SAC,N: LongInt; -begin +{$IFDEF PATCH_GH} + tmp: Int64; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then PC := NIL; +{$ENDIF PATCH_GH} + { The chart lists skill costs according to desired level, } { not current level. So, modify things a bit. } Inc( CurrentLevel ); @@ -756,7 +818,19 @@ begin if ( PC <> Nil ) and ( PC^.G = GG_Character ) then begin N := TooManySkillsPenalty( PC , NumberOfSkills( PC ) ); if N > 0 then begin +{$IFDEF PATCH_GH} + tmp := Int64(SAC) * Int64( 100 + N ); + tmp := tmp div 100; + if (SAC_MAX < tmp) then begin + SAC := SAC_MAX; + end else if (tmp < SAC_MIN) then begin + SAC := SAC_MIN; + end else begin + SAC := tmp; + end; +{$ELSE PATCH_GH} SAC := ( SAC * ( 100 + N ) ) div 100; +{$ENDIF PATCH_GH} end; end; @@ -767,19 +841,48 @@ function IsLegalCharSub( SPC, Part: Gear { Return TRUE if the specified part can be a subcomponent of } { SPC, false if it can't be. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if ( Part^.G = GG_Module ) then IsLegalCharSub := True else if ( Part^.G = GG_Modifier ) then IsLegalCharSub := AStringHasBString( SAttValue( Part^.SA , 'TYPE' ) , 'CHARA' ) else IsLegalCharSub := False; end; +{$IFDEF PATCH_I18N} Function PersonalityTraitDesc( Trait,Level: Integer ): String; +begin + PersonalityTraitDesc := PersonalityTraitDesc( Trait, Level, False ); +end; + +Function PersonalityTraitDesc( Trait,Level: Integer; I18N: Boolean ): String; +{$ELSE PATCH_I18N} +Function PersonalityTraitDesc( Trait,Level: Integer ): String; +{$ENDIF PATCH_I18N} { Return a string which describes the nature & intensity of this } { personality trait. } var msg: String; +{$IFDEF PATCH_I18N} + msg_pt, msg_lv: String; +{$ENDIF PATCH_I18N} begin if ( Level = 0 ) or ( Trait < 1 ) or ( Trait > Num_Personality_Traits ) then msg := '' else begin +{$IFDEF PATCH_I18N} + if Level > 0 then begin + msg_pt := I18N_Name( 'PTraitName', PTraitName[ Trait , 1 ], I18N ); + end else begin + msg_pt := I18N_Name( 'PTraitName', PTraitName[ Trait , 2 ], I18N ); + end; + + msg_lv := I18N_MsgString( 'PersonalityTraitDesc', '', I18N ); + if Abs( Level ) < 25 then msg_lv := I18N_MsgString( 'PersonalityTraitDesc', 'Slightly', I18N ) + else if Abs( Level ) >= 75 then msg_lv := I18N_MsgString( 'PersonalityTraitDesc', 'Extremely', I18N ) + else if Abs( Level ) >= 50 then msg_lv := I18N_MsgString( 'PersonalityTraitDesc', 'Very', I18N ); + + msg := ReplaceHash( msg_lv, msg_pt ); +{$ELSE PATCH_I18N} if Level > 0 then begin msg := PTraitName[ Trait , 1 ]; end else begin @@ -789,6 +892,7 @@ begin if Abs( Level ) < 25 then msg := 'Slightly ' + msg else if Abs( Level ) >= 75 then msg := 'Extremely ' + msg else if Abs( Level ) >= 50 then msg := 'Very ' + msg; +{$ENDIF PATCH_I18N} end; PersonalityTraitDesc := msg; end; @@ -808,6 +912,7 @@ begin if ( NPC = Nil ) or ( NPC^.G <> GG_Character ) then begin NPCTraitDesc := ''; end else begin + { PATCH_I18N: Don't translate it. } it := 'SEX:' + GenderName[ NATtValue( NPC^.NA , NAG_CharDescription , NAS_Gender ) ]; T := NATtValue( NPC^.NA , NAG_CharDescription , NAS_Dage ); @@ -847,6 +952,10 @@ end; Function CanLearnTalent( PC: GearPtr; T: Integer ): Boolean; { Return TRUE if the PC can learn this talent, or FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { The talent must be within the legal range in order to be } { learned. } if ( T < 1 ) or ( T > NumTalent ) then begin @@ -882,6 +991,10 @@ var N: Integer; XP: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Start by counting the number of talents the PC currently has. } TP := PC^.NA; N := 0; @@ -908,6 +1021,10 @@ var T,T2,S: Integer; StatDeck: Array [1..NumGearStats] of Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Start by shuffling the statdeck. } for t := 1 to NumGearStats do StatDeck[ t ] := T; for t := 1 to NumGearStats do begin @@ -925,6 +1042,10 @@ Procedure ApplyTalent( PC: GearPtr; T: I { Apply the listed talent to the PC, invoking any special effects } { if needed. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Start with an error check. } if ( T < 1 ) or ( T > NumTalent ) then Exit; @@ -947,4 +1068,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghchars.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghchars.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghcpit.pp branches/ghcpit.pp --- GearHead1100repository.original/ghcpit.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghcpit.pp 2009-08-15 03:21:16.378749000 +0900 @@ -38,11 +38,18 @@ Function IsLegalCPitSub( Part, Equip: Ge implementation +{$IFDEF DEBUG} +uses errmsg; +{$ENDIF DEBUG} + Function CockpitBaseMass( CPit: GearPtr ): Integer; {Cockpits usually have no weight... unless they're} {armored. In that case, the weight of the cockpit} {equals the armor rating assigned to it.} begin +{$IFDEF PATCH_GH} + if (NIL = CPit) or (CPit^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} CockpitBaseMass := CPit^.Stat[1]; end; @@ -51,8 +58,15 @@ Procedure CheckCPitRange( CPit: GearPtr { everything is nice and legal. } var T: Integer; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Master,S,S2: GearPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = CPit) or (CPit^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Currently Undefined } CPit^.S := 0; @@ -76,8 +90,29 @@ Function IsLegalCPitSub( Part, Equip: Ge { Return TRUE if the specified EQUIP may be legally installed } { in PART, FALSE if it can't be. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if ( Equip^.G = GG_Character ) and ( Equip^.Scale = Part^.Stat[2] ) then IsLegalCPitSub := True else IsLegalCPitSub := False; end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghcpit.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghcpit.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghguard.pp branches/ghguard.pp --- GearHead1100repository.original/ghguard.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghguard.pp 2009-08-15 03:21:16.378749000 +0900 @@ -23,7 +23,11 @@ unit ghguard; interface -uses gears; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; { *** SHIELD FORMAT *** } { G = GG_Shield } @@ -60,11 +64,19 @@ Function ArmorFitsMaster( Armor,Master: implementation -uses ghchars,ghmecha,ghmodule,texutil; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + ghchars,ghmecha,ghmodule,texutil; Function ShieldName( Part: GearPtr ): String; { Return a name for this particular shield. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + if Part^.S = GS_PhysicalShield then begin ShieldName := 'Class '+BStr( Part^.V ) + ' Shield'; end else begin @@ -78,6 +90,10 @@ Function ShieldBaseMass( Part: GearPtr ) var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { The base weight of a shield is its PV + Bonus. } { Easier to defend with shields tend to be larger, so they are heavier. } if Part^.S = GS_PhysicalShield then begin @@ -96,6 +112,10 @@ Function ShieldValue( Part: GearPtr ): L var it: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Part^.S = GS_EnergyShield then it := Part^.V * 75 else it := Part^.V * 25; @@ -114,6 +134,10 @@ end; Procedure CheckShieldRange( Part: GearPtr ); { Examine this sensor to make sure everything is legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Shield Type } if Part^.S < 0 then Part^.S := 0 else if Part^.S >= NumShieldType then Part^.S := 0; @@ -131,6 +155,11 @@ end; Function IsLegalShieldSub( Part, Equip: GearPtr ): Boolean; { TRUE if EQUIP can be installed in the shield, FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if Part^.S = GS_PhysicalShield then begin if Equip^.G = GG_Weapon then IsLegalShieldSub := True else IsLegalShieldSub := False; @@ -140,24 +169,37 @@ end; Function ArmorName( Part: GearPtr ): String; { Return a name for this particular armor. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} ArmorName := 'Class ' + BStr( Part^.V ) + ' ' + CModule[Part^.S].Name + ' Armor'; end; Function ArmorBaseMass( Part: GearPtr ): Integer; { Return the weight of this armor. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} ArmorBaseMass := Part^.V * 2; end; Function ArmorValue( Part: GearPtr ): LongInt; { Return the cost of this armor. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} ArmorValue := Part^.V * Part^.V * Part^.V * 5 + Part^.V * Part^.V * 10 + Part^.V * 35; end; Procedure CheckArmorRange( Part: GearPtr ); { Examine this sensor to make sure everything is legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Shield Type } if Part^.S < 1 then Part^.S := GS_Storage else if Part^.S > NumModule then Part^.S := GS_Storage; @@ -174,6 +216,11 @@ end; Function IsLegalArmorSub( Part, Equip: GearPtr ): Boolean; { Return TRUE if EQUIP can be mounted in PART, FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + case Equip^.G of GG_Weapon: IsLegalArmorSub := True; GG_MoveSys: IsLegalArmorSub := True; @@ -188,6 +235,11 @@ Function ArmorFitsMaster( Armor,Master: var ADesc,MDesc: String; begin +{$IFDEF PATCH_GH} + if (NIL = Armor) or (Armor^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + ADesc := SATTValue( Armor^.SA , 'FITS' ); if Master = Nil then begin @@ -204,4 +256,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghguard.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghguard.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghholder.pp branches/ghholder.pp --- GearHead1100repository.original/ghholder.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghholder.pp 2009-08-15 03:21:16.378749000 +0900 @@ -42,9 +42,17 @@ Function IsLegalHolderInv( Slot, Equip: implementation +{$IFDEF DEBUG} +uses errmsg; +{$ENDIF DEBUG} + function HolderName( Part: GearPtr ): String; { Return a default name for this part type. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + if Part^.S = GS_Hand then HolderName := 'Hand' else if Part^.S = GS_Mount then @@ -57,6 +65,10 @@ Procedure CheckHolderRange( Part: GearPt var T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Holder Type } if Part^.S < 0 then Part^.S := 1 else if Part^.S > ( 1 ) then Part^.S := 1; @@ -77,6 +89,11 @@ Function IsLegalHolderInv( Slot, Equip: var it: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = Slot) or (Slot^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if Slot^.S = GS_Hand then begin Case Equip^.G of GG_Weapon: it := true; @@ -98,4 +115,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghholder.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghholder.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghmecha.pp branches/ghmecha.pp --- GearHead1100repository.original/ghmecha.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghmecha.pp 2009-08-15 03:21:16.378749000 +0900 @@ -27,7 +27,11 @@ unit ghmecha; interface -uses gears; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; Const NumForm = 9; { The number of different FORMs which exist in the game.} @@ -43,6 +47,7 @@ Const GS_GroundCar = 8; { Land Vehicle - High Speed } + { PATCH_I18N: Don't translate it. } FormName: Array[ 0 .. ( NumForm - 1 ) ] of String = ( 'Battroid','Zoanoid','GroundHugger','Arachnoid','AeroFighter', 'Ornithoid','Gerwalk','HoverFighter','GroundCar' @@ -69,12 +74,20 @@ Function MechaTraitDesc( Mek: GearPtr ): implementation -uses texutil; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + texutil; Procedure InitMecha(Part: GearPtr); {Part is a newly created Mecha record.} {Initialize fields to default values.} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + {Default Scale = 2} Part^.Scale := 2; end; @@ -82,7 +95,12 @@ end; Function MechaName(Part: GearPtr): String; {Figure out a default name for a mecha.} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + {Error Check - if the thing isn't a mecha, return smartass answer.} + { PATCH_I18N: Don't translate it. } if Part^.G <> GG_Mecha then Exit('Not A Mecha'); MechaName := FormName[Part^.S]; @@ -94,6 +112,10 @@ Procedure CheckMechaRange( Mek: GearPtr var T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Mecha Form } if Mek^.S < 0 then Mek^.S := 0 else if Mek^.S > ( NumForm - 1 ) then Mek^.S := GS_Battroid; @@ -111,6 +133,11 @@ Function IsLegalMechaSubCom( Part, Equip { of PART, FALSE otherwise. Both inputs should be properly } { defined & initialized. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if Equip^.G = GG_Module then begin { The size of a module may not exceed the declared } { size of the mecha by more than one, and the size } @@ -136,7 +163,26 @@ Function MechaTraitDesc( Mek: GearPtr ): { Create a string describing the traits of this mecha. } { At the moment, this only contains form name. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} MechaTraitDesc := FormName[ Mek^.S ]; end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghmecha.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghmecha.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghmodule.pp branches/ghmodule.pp --- GearHead1100repository.original/ghmodule.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghmodule.pp 2013-08-16 09:01:00.000000000 +0900 @@ -25,7 +25,11 @@ unit ghmodule; interface -uses gears,ghmecha; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,ghmecha; Type ModuleDesc = Record @@ -35,7 +39,11 @@ Type Const +{$IFDEF PATCH_CHEAT} + NumModule = 9; +{$ELSE PATCH_CHEAT} NumModule = 8; +{$ENDIF PATCH_CHEAT} GS_Body = 1; GS_Head = 2; @@ -45,12 +53,64 @@ Const GS_Tail = 6; GS_Turret = 7; GS_Storage = 8; +{$IFDEF PATCH_CHEAT} + GS_Conversion = 9; +{$ENDIF PATCH_CHEAT} STAT_Armor = 1; +{$IFDEF PATCH_CHEAT} + SATT_TRANSFORMABLE = 'TRANSFORMABLE'; + SATT_TRANSFORM_CURRENT = 'TRANSFORM_CURRENT'; + SATT_TRANSFORM_NAME = 'TRANSFORM_NAME_'; + SATT_TRANSFORM_GS = 'TRANSFORM_GS_'; + SATT_TRANSFORM_SDL_SPRITE = 'TRANSFORM_SDL_SPRITE_'; + SATT_TRANSFORM_WAIT = 'TRANSFORM_WAIT_'; + SATT_TRANSFORM_WEAPON_LOCK = 'TRANSFORM_WEAPON_LOCK_'; +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_CHEAT} + SATT_SEPARABLE = 'SEPARABLE'; + SATT_SEPARATE_NAME = 'SEPARATE_NAME_'; + SATT_SEPARATE_WAIT = 'SEPARATE_WAIT_'; + SATT_SEPARATE = 'SEPARATE_'; +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_CHEAT} + SATT_DESTROYED = 'DESTROYED'; + SATT_CUSTOM_ENGINE = 'CUSTOM_ENGINE'; + SATT_SUBCOM_PLUG = 'SUBCOM_PLUG'; + SATT_SUBCOM_RECEPTACLE = 'SUBCOM_RECEPTACLE'; + SATT_EXARMOR_PLUG = 'EXARMOR_PLUG'; + SATT_EXARMOR_RECEPTACLE = 'EXARMOR_RECEPTACLE'; + SATT_SHIELD_PLUG = 'SHIELD_PLUG'; + SATT_SHIELD_RECEPTACLE = 'SHIELD_RECEPTACLE'; +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_CHEAT} + SATT_ADJUSTMENT_PV = 'ADJUSTMENT_PV'; + SATT_ADJUSTMENT_CMX = 'ADJUSTMENT_CMX'; + SATT_ADJUSTMENT_DP = 'ADJUSTMENT_DP'; + SATT_ADJUSTMENT_MASS = 'ADJUSTMENT_MASS'; +{$ENDIF PATCH_CHEAT} + { This array tells which modules are usable by which forms. } { Some systems ( movers, sensors, cockpits ) will function no matter where they are mounted. } { Others ( weapons, shields, hands ) will not function if placed in a bad module. } +{$IFDEF PATCH_CHEAT} + FORMxMODULE: Array [0..NumForm-1, 1..NumModule] of Boolean = ( +{ Body Head Arm Leg Wing Tail Turret Storage Conversion } +{Battroid} ( True, True, True, True, True, True, False, True ,True ), +{Zoanoid} ( True, True, False, True, True, True, False, True ,True ), +{GroundHugger} ( True, False, False, False, False, False, True, True ,True ), +{Arachnoid} ( True, True, False, True, False, True, True, True ,True ), +{AeroFighter} ( True, False, False, False, True, False, False, True ,True ), +{Ornithoid} ( True, True, False, True, True, True, False, True ,True ), +{Gerwalk} ( True, True, True, True, True, True, False, True ,True ), +{HoverFighter} ( True, False, False, False, True, False, True, True ,True ), +{GroundCar} ( True, False, False, False, False, False, True, True ,True ) + ); +{$ELSE PATCH_CHEAT} FORMxMODULE: Array [0..NumForm-1, 1..NumModule] of Boolean = ( { Body Head Arm Leg Wing Tail Turret Storage } {Battroid} ( True, True, True, True, True, True, False, True ), @@ -64,6 +124,7 @@ Const {GroundCar} ( True, False, False, False, False, False, True, True ) ); +{$ENDIF PATCH_CHEAT} { MODULE HIT POINT DEFINITIONS } {All these definitions are based on the module's size.} @@ -98,6 +159,12 @@ Const ( name: 'Storage'; MHP: MHP_NoHP; ) +{$IFDEF PATCH_CHEAT} + , + ( name: 'Conversion'; + MHP: MHP_EqualSize; + ) +{$ENDIF PATCH_CHEAT} ); @@ -140,7 +207,19 @@ Procedure CheckModifierRange( Part: Gear implementation -uses ghholder,texutil; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_CHEAT} + gearutil, + ghsupport, +{$ENDIF PATCH_CHEAT} + ghholder,texutil +{$IFDEF PATCH_CHEAT} + ,ui4gh +{$ENDIF PATCH_CHEAT} + ; Function LookupModuleCode(const name_In: String): Integer; @@ -164,6 +243,10 @@ Procedure InitModule(Part: GearPtr); {PART is a newly created module record.} {Initialize its stuff.} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Modules inherit GearOps/Material from their parent. } if Part^.Parent <> Nil then begin SetNAtt( Part^.NA , NAG_GearOps , NAS_Material , NAttValue( Part^.Parent^.NA , NAG_GearOps , NAS_Material ) ); @@ -177,10 +260,19 @@ var it: Integer; begin {Error check - make sure we actually have a Module.} +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ELSE PATCH_GH} if Part = Nil then Exit(0); +{$ENDIF PATCH_GH} if Part^.G <> GG_Module then Exit(0); if (Part^.S < 1) or (Part^.S > NumModule) then Exit(0); +{$IFDEF PATCH_CHEAT} + if ( '' <> SAttValue(Part^.SA,SATT_ADJUSTMENT_DP) ) then begin + it := (Part^.V * SAttValueToInt(Part^.SA,SATT_ADJUSTMENT_DP)) div 100; + end else begin +{$ENDIF PATCH_CHEAT} Case CModule[Part^.S].MHP of MHP_NoHP: it := -1; MHP_HalfSize: it := ( Part^.V + 1 ) div 2; @@ -189,6 +281,9 @@ begin MHP_SizeTimesTwo: it := Part^.V * 2; else it := 0; end; +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} ModuleBaseDamage := it; end; @@ -196,17 +291,32 @@ end; Function ModuleComplexity( Part: GearPtr ): Integer; { Return the complexity value for this part. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + if ( '' <> SAttValue(Part^.SA,SATT_ADJUSTMENT_CMX) ) then begin + ModuleComplexity := (( Part^.V + 1 ) * SAttValueToInt(Part^.SA,SATT_ADJUSTMENT_CMX)) div 100; + end else begin +{$ENDIF PATCH_CHEAT} if ( Part^.S = GS_Body ) or ( Part^.S = GS_Storage ) then begin ModuleComplexity := ( Part^.V + 1 ) * 2; end else begin ModuleComplexity := Part^.V + 1; end; +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} end; Function ModuleName(Part: GearPtr): String; {Determine the geneic name for this particular module.} begin {Eliminate all error cases first off...} + { PATCH_I18N: Don't translate it. } +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit('Unknown'); +{$ENDIF PATCH_GH} if (Part = Nil) or (Part^.G <> GG_Module) or (Part^.S < 1) or (Part^.S > NumModule) then Exit('Unknown'); ModuleName := CModule[Part^.S].Name; @@ -218,10 +328,19 @@ var it: Integer; begin {Error check - make sure we actually have a Module.} +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ELSE PATCH_GH} if Part = Nil then Exit(0); +{$ENDIF PATCH_GH} if Part^.G <> GG_Module then Exit(0); if (Part^.S < 1) or (Part^.S > NumModule) then Exit(0); +{$IFDEF PATCH_CHEAT} + if ( '' <> SAttValue(Part^.SA,SATT_ADJUSTMENT_MASS) ) then begin + it := (Part^.V * SAttValueToInt(Part^.SA,SATT_ADJUSTMENT_MASS)) div 100; + end else begin +{$ENDIF PATCH_CHEAT} Case CModule[Part^.S].MHP of MHP_NoHP: it := 0; MHP_EqualSize,MHP_Halfsize: it := Part^.V; @@ -229,6 +348,9 @@ begin MHP_SizeTimesTwo: it := Part^.V * 2; else it := 0; end; +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} {Armor also adds weight to a module.} it := it + Part^.Stat[ STAT_Armor ]; @@ -243,6 +365,10 @@ var InAMek: Boolean; T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Module Type } if Part^.S < 1 then Part^.S := GS_Storage else if Part^.S > NumModule then Part^.S := GS_Storage; @@ -278,7 +404,52 @@ Function IsLegalModuleInv( Slot, Equip: { See therules.txt for a list of acceptable equipment. } var it: Boolean; -begin +{$IFDEF PATCH_CHEAT} + ExArmorReceptacle: String; + ExArmorPlug: String; + ShieldReceptacle: String; + ShieldPlug: String; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = Slot) or (Slot^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} + Case Equip^.G of + GG_ExArmor: begin + if ( GS_Conversion = Equip^.S ) then begin + ExArmorReceptacle := SAttValue( Slot^.SA , SATT_EXARMOR_RECEPTACLE ); + ExArmorPlug := SAttValue( Equip^.SA, SATT_EXARMOR_PLUG ); + it := ( ExArmorReceptacle = ExArmorPlug ); + end else begin + it := ( Slot^.S = Equip^.S ); + end; + end; + GG_Shield: begin + Case Slot^.S of + GS_Arm: begin + it := True; + end; + GS_Tail: begin + it := True; + end; + GS_Conversion: begin + ShieldReceptacle := SAttValue( Slot^.SA , SATT_SHIELD_RECEPTACLE ); + ShieldPlug := SAttValue( Equip^.SA, SATT_SHIELD_PLUG ); + it := ( '' <> ShieldPlug ) and ( ShieldReceptacle = ShieldPlug ); + end; + else begin + it := False; + end; + end; + end; + else begin + it := False; + end; + end; +{$ELSE PATCH_CHEAT} if Slot^.S = GS_Arm then begin Case Equip^.G of GG_ExArmor: begin @@ -303,6 +474,7 @@ begin else it := False; end; end; +{$ENDIF PATCH_CHEAT} { If the item is of a different scale than the holder, } { it can't be held. } @@ -314,7 +486,25 @@ end; Function IsLegalModuleSub( Slot, Equip: GearPtr ): Boolean; { Return TRUE if EQUIP can be installed in SLOT, } { FALSE otherwise. } -begin +{$IFDEF PATCH_CHEAT} +var + M: GearPtr; + SubComReceptacle: String; + SubComPlug: String; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = Slot) or (Slot^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + SubComReceptacle := SAttValue( Slot^.SA , SATT_SUBCOM_RECEPTACLE ); + SubComPlug := SAttValue( Equip^.SA, SATT_SUBCOM_PLUG ); + if ( ('' <> SubComPlug) and (SubComReceptacle <> SubComPlug) ) then begin + Exit(False); + end; +{$ENDIF PATCH_CHEAT} + if Slot^.S = GS_Body then begin case Equip^.G of GG_Cockpit: IsLegalModuleSub := True; @@ -334,12 +524,50 @@ begin GG_Cockpit: IsLegalModuleSub := True; GG_Weapon: IsLegalModuleSub := True; GG_MoveSys: IsLegalModuleSub := True; +{$IFDEF PATCH_CHEAT} + GG_Holder: begin + if ( GS_Hand = Equip^.S ) then begin + if ( GS_Arm = Slot^.S ) then begin + IsLegalModuleSub := True; + end else begin + if ('' <> SubComPlug) and (SubComReceptacle = SubComPlug) then begin + IsLegalModuleSub := True; + end else begin + IsLegalModuleSub := False; + end; + end; + end else begin + IsLegalModuleSub := True; + end; + end; +{$ELSE PATCH_CHEAT} GG_Holder: begin if ( Equip^.S = GS_Hand ) and ( Slot^.S <> GS_Arm ) then IsLegalModuleSub := False else IsLegalModuleSub := True; end; +{$ENDIF PATCH_CHEAT} GG_Sensor: IsLegalModuleSub := True; GG_Electronics: IsLegalModuleSub := True; +{$IFDEF PATCH_CHEAT} + GG_Support: begin + if Cheat_MechaCustomize_FreeSupport then begin + IsLegalModuleSub := True; + end else begin + if ( GS_Engine = Equip^.S ) then begin + M := FindMaster( Slot ); + if ( '' <> SAttValue(M^.SA,SATT_CUSTOM_ENGINE) ) then begin + IsLegalModuleSub := True; + end else begin + IsLegalModuleSub := False; + end; + end else if ( GS_ConvEqp = Equip^.S ) then begin + IsLegalModuleSub := True; + end else begin + IsLegalModuleSub := False; + end; + end; + end; +{$ENDIF PATCH_CHEAT} else IsLegalModuleSub := False end; @@ -356,6 +584,10 @@ var plusses,minuses,T: Integer; it: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Initialize our counters. } plusses := 0; minuses := 0; @@ -412,6 +644,10 @@ Procedure CheckModifierRange( Part: Gear var T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { S = Modifier Type, must be 1 or 2. } if Part^.S < 1 then Part^.S := 1 else if Part^.S > 2 then Part^.S := 2; @@ -437,4 +673,20 @@ begin end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghmodule.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghmodule.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghmovers.pp branches/ghmovers.pp --- GearHead1100repository.original/ghmovers.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghmovers.pp 2009-08-15 03:21:16.378749000 +0900 @@ -85,7 +85,11 @@ Procedure CheckMoverRange( Part: GearPtr implementation -uses texutil; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + texutil; Function MovesysBaseDamage( Part: GearPtr ): Integer; {Calculate the number of damage points that may be} @@ -94,6 +98,9 @@ Function MovesysBaseDamage( Part: GearPt var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} if MovesysMan[ Part^.S ].DMG = 0 then begin {This part has one DP, regardless of value.} it := 1; @@ -114,6 +121,9 @@ end; Function MovesysName( Part: GearPtr ): String; {Return a default name for the movement system in question.} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} MovesysName := 'Class ' + BStr(Part^.V) + ' ' + MoveSysMan[ Part^.S ].Name; end; @@ -121,6 +131,9 @@ end; Function MoveSysValue( Part: GearPtr ): LongInt; { Return the unscaled cost of this movement system. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} MoveSysValue := Part^.V * MoveSysMan[ Part^.S ].Cost; end; @@ -130,6 +143,10 @@ Procedure CheckMoverRange( Part: GearPtr var T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Movement System Type } if Part^.S < 1 then Part^.S := 1 else if Part^.S > NumMoveSys then Part^.S := NumMoveSys; @@ -142,4 +159,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghmovers.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghmovers.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghparser.pp branches/ghparser.pp --- GearHead1100repository.original/ghparser.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghparser.pp 2015-11-16 09:01:00.000000000 +0900 @@ -25,7 +25,11 @@ unit ghparser; interface -uses gears; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; Const SLOT_Next = 0; @@ -33,39 +37,99 @@ Const SLOT_Inv = 2; var +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Parser_Macros: SAttPtr; Archetypes_List: GearPtr; +{$ENDIF PATCH_GH} WMonList: GearPtr; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Standard_Equipment_List: GearPtr; STC_Item_List: GearPtr; +{$ENDIF PATCH_GH} Procedure SelectCombatEquipment( NPC,EquipList: GearPtr; EPV: LongInt ); Procedure CheckValidity( var it: GearPtr ); +{$IFDEF PATCH_GH} +Function ReadGear(var F: Text; const FileName: String): GearPtr; +{$ELSE PATCH_GH} Function ReadGear(var F: Text): GearPtr; +{$ENDIF PATCH_GH} Function LoadFile( FName,DName: String ): GearPtr; Function LoadGearPattern( FName,DName: String ): GearPtr; Function LoadXRanPlot( FName,DName: String; Enemy,Mystery,BadThing: Integer ): GearPtr; Function LoadSingleMecha( FName,DName: String ): GearPtr; +{$IFDEF PATCH_GH} +Function LoadNewMonster_withoutErrorCheck( MonsterName: String ): GearPtr; Function LoadNewMonster( MonsterName: String ): GearPtr; +Function LoadNewNPC_withoutErrorCheck( NPCName: String ): GearPtr; Function LoadNewNPC( NPCName: String ): GearPtr; +Function LoadNewSTC_withoutErrorCheck( Desig: String ): GearPtr; Function LoadNewSTC( Desig: String ): GearPtr; +{$ELSE PATCH_GH} +Function LoadNewMonster( MonsterName: String ): GearPtr; +Function LoadNewNPC( NPCName: String ): GearPtr; +Function LoadNewSTC( Desig: String ): GearPtr; +{$ENDIF PATCH_GH} implementation -uses dos,ability,gearutil,ghchars,ghmodule, - ghsupport,interact,locale,rpgdice,texutil; +uses +{$IFDEF PATCH_GH} + sysutils, +{$ENDIF PATCH_GH} + dos, +{$IFDEF PATCH_GH} + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} + ability,gearutil,ghchars,ghmodule, + ghsupport,interact,locale,rpgdice,texutil +{$IFDEF PATCH_CHEAT} + ,ui4gh +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + ,sdlgfx + {$ELSE SDLMODE} + ,context + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} + ; Const Recursion_Level: Integer = 0; +{$IFDEF PATCH_GH} +var + Parser_Macros: SAttPtr; + + Archetypes_List: GearPtr; + + Standard_Equipment_List: GearPtr; + STC_Item_List: GearPtr; +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} + Procedure IndividualizeNPC( NPC: GearPtr ); { Randomize up this NPC a bit, to give it that hand-crafted } { NPC look. } var N,T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { If the NPC doesn't have a body defined, create one. } if NPC^.SubCom = Nil then begin ExpandCharacter( NPC ); @@ -114,6 +178,9 @@ Procedure SelectCombatEquipment( NPC,Equ Wep := EquipList; N := 1; while Wep <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Wep^.G) then begin +{$ENDIF PATCH_GH} { If this item is a weapon and affordable, add it to the list. } if ( Wep^.G = GG_Weapon ) and ( GearValue( Wep ) <= EPV ) then begin StoreSAtt( SL , BStr( N ) ); @@ -121,6 +188,9 @@ Procedure SelectCombatEquipment( NPC,Equ { Move to the next item. } Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Wep := Wep^.Next; end; if SL = Nil then Exit( Nil ); @@ -150,6 +220,9 @@ Procedure SelectCombatEquipment( NPC,Equ Armor := EquipList; N := 1; while Armor <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Armor^.G) then begin +{$ENDIF PATCH_GH} { If this item is a weapon and affordable, add it to the list. } if ( Armor^.G = GG_ExArmor ) and ( Armor^.S = BP ) and ( GearValue( Armor ) <= EPV ) then begin StoreSAtt( SL , BStr( N ) ); @@ -157,6 +230,9 @@ Procedure SelectCombatEquipment( NPC,Equ { Move to the next item. } Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Armor := Armor^.Next; end; if SL = Nil then Exit( Nil ); @@ -177,22 +253,45 @@ var Slot: GearPtr; { Place to stick current equipment. } Part,UEPart: GearPtr; { Part to equip, part that's been unequipped. } begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; + { Don't kick out the GG_DisposeGear of EquipList at here. } +{$ENDIF PATCH_GH} + { First, stick a weapon in the right hand. } Slot := SeekGearByName( NPC^.SubCOm , SATtValue( ABILITY_MESSAGES , 'EXPAND_RightHand' ) ); if Slot <> Nil then begin Part := BuyWeapon; UEPart := EquipGear( Slot , Part ); +{$IFDEF PATCH_GH} + if (NIL <> UEPart) and (GG_DisposeGear < UEPart^.G) then begin + InsertInvCom( NPC , UEPart ); + end; +{$ELSE PATCH_GH} if UEPart <> Nil then InsertInvCom( NPC , UEPart ); +{$ENDIF PATCH_GH} end; { Move through all the NPC's modules, possibly adding armor to each. } Slot := NPC^.SubCOm; while Slot <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Slot^.G) then begin +{$ENDIF PATCH_GH} if ( Slot^.G = GG_Module ) and ( EPV > Random( 100 ) ) and ( Random( 3 ) <> 1 ) then begin Part := BuyArmor( Slot^.S ); UEPart := EquipGear( Slot , Part ); +{$IFDEF PATCH_GH} + if (NIL <> UEPart) and (GG_DisposeGear < UEPart^.G) then begin + InsertInvCom( NPC , UEPart ); + end; +{$ELSE PATCH_GH} if UEPart <> Nil then InsertInvCom( NPC , UEPart ); +{$ENDIF PATCH_GH} + end; +{$IFDEF PATCH_GH} end; +{$ENDIF PATCH_GH} { Move to the next module. } Slot := Slot^.Next; @@ -204,7 +303,13 @@ begin if ( Slot <> Nil ) and ( EPV > Random( 100 ) ) then begin Part := BuyWeapon; UEPart := EquipGear( Slot , Part ); +{$IFDEF PATCH_GH} + if (NIL <> UEPart) and (GG_DisposeGear < UEPart^.G) then begin + InsertInvCom( NPC , UEPart ); + end; +{$ELSE PATCH_GH} if UEPart <> Nil then InsertInvCom( NPC , UEPart ); +{$ENDIF PATCH_GH} end; { Store remaining money. } @@ -217,11 +322,17 @@ Procedure ComponentScan( it: GearPtr ); begin {Loop through all the components.} while it <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < it^.G) then begin +{$ENDIF PATCH_GH} {Perform specific checks here.} CheckGearRange( it ); if it^.SubCom <> Nil then ComponentScan(it^.SubCom); if it^.InvCom <> Nil then ComponentScan(it^.InvCom); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} it := it^.Next; end; end; @@ -240,12 +351,22 @@ var procedure SubComScan( P: GearPtr ); begin while P <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < P^.G) then begin +{$ENDIF PATCH_GH} if P^.G = GG_Cockpit then Inc( CPit ); if P^.SubCom <> Nil then SubComScan( P^.SubCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} P := P^.Next; end; end; begin +{$IFDEF PATCH_GH} + if (NIL = it) or (it^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Count the number of body modules. } { ASSERT: All level one subcomponents will be modules, and } { if a body module is found it will be of the correct size. } @@ -254,9 +375,16 @@ begin S := it^.SubCom; Body := 0; while S <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < S^.G) then begin +{$ENDIF PATCH_GH} if ( S^.G = GG_Module ) and ( S^.S = GS_Body ) then begin Inc( Body ); if Body = 1 then begin +{$IFDEF PATCH_CHEAT} + if Cheat_MechaCustomize_FreeSupport or ('' <> SAttValue(it^.SA,SATT_CUSTOM_ENGINE)) then begin + end else begin +{$ENDIF PATCH_CHEAT} { Check for the engine. If no engine, install one. } SG := S^.SubCom; while ( SG <> Nil ) and (( SG^.G <> GG_Support ) or ( SG^.S <> GS_Engine )) do SG := SG^.Next; @@ -269,7 +397,14 @@ begin InitGear( SG ); InsertSubCom( S , SG ); end; +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + if Cheat_MechaCustomize_FreeSupport then begin + end else begin +{$ENDIF PATCH_CHEAT} { Check for the gyro. If no gyro, install one. } SG := S^.SubCom; while ( SG <> Nil ) and (( SG^.G <> GG_Support ) or ( SG^.S <> GS_Gyro )) do SG := SG^.Next; @@ -282,12 +417,21 @@ begin InitGear( SG ); InsertSubCom( S , SG ); end; +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} S := S^.Next; end; if Body <> 1 then begin it^.G := GG_AbsolutelyNothing; +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('CheckMechaMetrics()', it, False ); +{$ENDIF PATCH_GH} end; { Make sure the mecha has exactly one cockpit. } @@ -295,6 +439,9 @@ begin SubComScan( it^.SubCom ); if CPit <> 1 then begin it^.G := GG_AbsolutelyNothing; +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('CheckMechaMetrics()', it, False ); +{$ENDIF PATCH_GH} end; end; @@ -336,7 +483,11 @@ begin MetricScan( it ); end; +{$IFDEF PATCH_GH} +Function ReadGear(var F: Text; const FileName: String): GearPtr; +{$ELSE PATCH_GH} Function ReadGear(var F: Text): GearPtr; +{$ENDIF PATCH_GH} {F is an open file of type F.} {Start reading information from the file, stopping} {whenever all the info is read.} @@ -345,12 +496,29 @@ Function ReadGear(var F: Text): GearPtr; { in gearutil.pp. } const NDum: GearPtr = Nil; +{$IFDEF PATCH_GH} + MaxLineLength = 255; + {$IFDEF DEBUG} + WarningLineLength = 232; + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} var TheLine,cmd: String; it,C: GearPtr; {IT is the total list which is returned.} {C is the current GEAR being worked on.} dest: Byte; {DESTination of the next GEAR to be added.} { 0 = Sibling; 1 = SubCom; 2 = InvCom } +{$IFDEF PATCH_GH} + BrokenDataFlag: Boolean; + {$IFDEF DEBUG} + WarningDataFlag: Boolean; + {$ENDIF DEBUG} + CTheLine: Array[0..1024] of Char; + LineNumber: Integer = 0; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + SattOrg: String; +{$ENDIF PATCH_I18N} {*** LOCAL PROCEDURES FOR GHPARSER ***} @@ -732,6 +900,9 @@ begin { Error check- we must be dealing with an NPC here. } if ( C = Nil ) or ( C^.G <> GG_Character ) then exit; +{$IFDEF PATCH_GH} + if (NIL = Standard_Equipment_List) then Exit; +{$ENDIF PATCH_GH} SelectCOmbatEquipment( C , Standard_Equipment_List , ExtractValue( TheLine ) ); end; @@ -746,6 +917,7 @@ begin if ( C = Nil ) or ( C^.G <> GG_Character ) then Exit; while TheLine <> '' do begin + { PATCH_I18N: Don't translate it. } CCD_Cmd := ExtractWord( TheLine ); { Check to see if this is a gender command. } @@ -798,17 +970,94 @@ begin Inc( Recursion_Level ); while not EoF(F) do begin +{$IFDEF PATCH_GH} + Inc( LineNumber ); + BrokenDataFlag := False; + {$IFDEF DEBUG} + WarningDataFlag := False; + {$ENDIF DEBUG} + ReadLn(F, CTheLine ); + if (StrLen(CTheLine) < MaxLineLength) then begin + TheLine := StrPas(CTheLine); + {$IFDEF DEBUG} + if (Length(TheLine) < WarningLineLength) then begin + end else begin + WarningDataFlag := True; + end; + {$ENDIF DEBUG} + end else begin + TheLine := Copy(CTheLine,1,MaxLineLength); + BrokenDataFlag := True; + end; +{$ELSE PATCH_GH} {Read the line from disk, and delete leading whitespace.} readln(F,TheLine); +{$ENDIF PATCH_GH} DeleteWhiteSpace(TheLine); +{$IFDEF PATCH_GH} + if ( TheLine = '' ) or ( TheLine[1] = '%' ) then + else if BrokenDataFlag then begin + {$IFDEF SDLMODE} + ErrorMessage_fork('ERROR: Line is too long in ' + FileName + ':' + IntToStr(LineNumber) ); + {$ELSE SDLMODE} + { In CUI mode, Error messages are hindrances. } + {$ENDIF SDLMODE} + {$IFDEF DEBUG} + end else if WarningDataFlag then begin + {$IFDEF SDLMODE} + ErrorMessage_fork('NOTICE: Line is too long in ' + FileName + ':' + IntToStr(LineNumber) ); + {$ELSE SDLMODE} + { In CUI mode, Error messages are hindrances. } + {$ENDIF SDLMODE} + {$ENDIF DEBUG} + end; +{$ENDIF PATCH_GH} + if ( TheLine = '' ) or ( TheLine[1] = '%' ) then begin { *** COMMENT *** } TheLine := ''; end else if Pos('<',TheLine) > 0 then begin { *** STRING ATTRIBUTE *** } +{$IFDEF PATCH_I18N} + if C <> NIL then begin + if 'NAME ' = UpCase(Copy(TheLine,1,5)) then begin + SattOrg := SAttValue( C^.SA, 'NAME_ORG' ); + if '' = SattOrg then begin + SattOrg := SAttValue( C^.SA, 'NAME' ); + if '' <> SattOrg then begin + SetSAtt( C^.SA , 'NAME_ORG <' + SattOrg + '>' ); + end; + end; + SetSAtt(C^.SA,TheLine); + end else if 'DESC ' = UpCase(Copy(TheLine,1,5)) then begin + SattOrg := SAttValue( C^.SA, 'DESC_ORG' ); + if '' = SattOrg then begin + SattOrg := SAttValue( C^.SA, 'DESC' ); + if '' <> SattOrg then begin + SetSAtt( C^.SA , 'DESC_ORG <' + SattOrg + '>' ); + end; + end; + SetSAtt(C^.SA,TheLine); + {$IFDEF PATCH_BACKPORT} + end else if 'CALIBER ' = UpCase(Copy(TheLine,1,8)) then begin + SattOrg := SAttValue( C^.SA, 'CALIBER_ORG' ); + if '' = SattOrg then begin + SattOrg := SAttValue( C^.SA, 'CALIBER' ); + if '' <> SattOrg then begin + SetSAtt( C^.SA , 'CALIBER_ORG <' + SattOrg + '>' ); + end; + end; + SetSAtt(C^.SA,TheLine); + {$ENDIF PATCH_BACKPORT} + end else begin + SetSAtt(C^.SA,TheLine); + end; + end; +{$ELSE PATCH_I18N} if C <> Nil then SetSAtt(C^.SA,TheLine); +{$ENDIF PATCH_I18N} end else begin { *** COMMAND LINE *** } @@ -869,7 +1118,11 @@ begin { Actually load the file. } Assign( F , FName ); Reset( F ); +{$IFDEF PATCH_GH} + it := ReadGear( F, FName ); +{$ELSE PATCH_GH} it := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); end; LoadFile := it; @@ -993,7 +1246,11 @@ begin { Open and load the archetypes. } Assign( F , FName ); Reset( F ); +{$IFDEF PATCH_GH} + LList := ReadGear( F, FName ); +{$ELSE PATCH_GH} LList := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); { Locate the desired archetype. } @@ -1006,6 +1263,45 @@ begin end; +{$IFDEF PATCH_GH} +Function LoadNewMonster_withoutErrorCheck( MonsterName: String ): GearPtr; + { This function will load the default monster list and } + { return a monster of the requested type. } +var + Mon: GearPtr; +begin + { Load monster from disk. } + if WMonList = Nil then begin + Mon := LoadNamedGear( Monsters_File , MonsterName ); + end else begin + Mon := CloneGear( SeekGearByName( WMonList , MonsterName ) ); + end; + + { If it loaded successfully, set its job to "ANIMAL". } + if Mon <> Nil then begin + SetSATt( Mon^.SA , 'JOB ' ); + end; + + { Return whatever value was returned. } + LoadNewMonster_withoutErrorCheck := Mon; +end; + +Function LoadNewMonster( MonsterName: String ): GearPtr; + { This function will load the default monster list and } + { return a monster of the requested type. } +var + Mon: GearPtr; + Msg: String; +begin + Mon := LoadNewMonster_withoutErrorCheck( MonsterName ); + if ( NIL = Mon ) then begin + Msg := 'ERROR: LoadNewMonster failed : ' + MonsterName; + ErrorMessage_fork( Msg ); + DialogMsg( Msg ); + end; + LoadNewMonster := Mon; +end; +{$ELSE PATCH_GH} Function LoadNewMonster( MonsterName: String ): GearPtr; { This function will load the default monster list and } { return a monster of the requested type. } @@ -1027,12 +1323,55 @@ begin { Return whatever value was returned. } LoadNewMonster := Mon; end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Function LoadNewNPC_withoutErrorCheck( NPCName: String ): GearPtr; + { This function will load the NPC archetypes list and } + { return a character of the requested type. } +var + NPC: GearPtr; +begin + { Attempt to load the NPC from the standard archetypes file. } + if Archetypes_List = Nil then begin + NPC := LoadNamedGear( Archetypes_File , NPCName ); + end else begin + NPC := CloneGear( SeekGearByName( Archetypes_List , NPCName ) ); + end; + + { If the NPC was loaded, set its job name and individualize it. } + if NPC <> Nil then begin + { Store a JOB description. This will be the archetype name. } + SetSATt( NPC^.SA , 'JOB <' + NPCName + '>' ); + + IndividualizeNPC( NPC ); + end; + + { Return the finished product. } + LoadNewNPC_withoutErrorCheck := NPC; +end; Function LoadNewNPC( NPCName: String ): GearPtr; { This function will load the NPC archetypes list and } { return a character of the requested type. } var NPC: GearPtr; + Msg: String; +begin + NPC := LoadNewNPC_withoutErrorCheck( NPCName ); + if ( NIL = NPC ) then begin + Msg := 'ERROR: LoadNewNPC failed : ' + NPCName; + ErrorMessage_fork( Msg ); + DialogMsg( Msg ); + end; + LoadNewNPC := NPC; +end; +{$ELSE PATCH_GH} +Function LoadNewNPC( NPCName: String ): GearPtr; + { This function will load the NPC archetypes list and } + { return a character of the requested type. } +var + NPC: GearPtr; begin { Attempt to load the NPC from the standard archetypes file. } if Archetypes_List = Nil then begin @@ -1052,12 +1391,47 @@ begin { Return the finished product. } LoadNewNPC := NPC; end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Function LoadNewSTC_withoutErrorCheck( Desig: String ): GearPtr; + { This function will load the STC parts list and } + { return an item of the requested type. } +var + Item: GearPtr; +begin + { Attempt to load the item from the standard items file. } + if STC_Item_List = Nil then begin + Item := LoadNamedGear( STC_Item_File , Desig ); + end else begin + Item := CloneGear( SeekGearByDesig( STC_Item_List , Desig ) ); + end; + + { Return the finished product. } + LoadNewSTC_withoutErrorCheck := Item; +end; Function LoadNewSTC( Desig: String ): GearPtr; { This function will load the STC parts list and } { return an item of the requested type. } var Item: GearPtr; + Msg: String; +begin + Item := LoadNewSTC_withoutErrorCheck( Desig ); + if ( NIL = Item ) then begin + Msg := 'ERROR: LoadNewSTC failed : ' + Desig; + ErrorMessage_fork( Msg ); + DialogMsg( Msg ); + end; + LoadNewSTC := Item; +end; +{$ELSE PATCH_GH} +Function LoadNewSTC( Desig: String ): GearPtr; + { This function will load the STC parts list and } + { return an item of the requested type. } +var + Item: GearPtr; begin { Attempt to load the item from the standard items file. } if STC_Item_List = Nil then begin @@ -1069,6 +1443,7 @@ begin { Return the finished product. } LoadNewSTC := Item; end; +{$ENDIF PATCH_GH} Procedure LoadArchetypes; { Load the default, archetypal gears which may be used in the } @@ -1080,35 +1455,73 @@ begin { Open and load the archetypes. } Assign( F , Archetypes_File ); Reset( F ); +{$IFDEF PATCH_GH} + Archetypes_List := ReadGear( F, Archetypes_File ); +{$ELSE PATCH_GH} Archetypes_List := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); Assign( F , Monsters_File ); Reset( F ); +{$IFDEF PATCH_GH} + WMonList := ReadGear( F, Monsters_File ); +{$ELSE PATCH_GH} WMonList := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); Assign( F , PC_Equipment_File ); Reset( F ); +{$IFDEF PATCH_GH} + Standard_Equipment_List := ReadGear( F, PC_Equipment_File ); +{$ELSE PATCH_GH} Standard_Equipment_List := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); Assign( F , STC_Item_File ); Reset( F ); +{$IFDEF PATCH_GH} + STC_Item_List := ReadGear( F, STC_Item_File ); +{$ELSE PATCH_GH} STC_Item_List := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); end; + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghparser.pp'); +{$ENDIF DEBUG} Parser_Macros := LoadStringList( Parser_Macro_File ); +{$IFDEF PATCH_GH} + Archetypes_List := NIL; + WMonList := NIL; + Standard_Equipment_List := NIL; + STC_Item_List := NIL; + Attach_SmartPointer( 'Archetypes_List: GearPtr', @Archetypes_List ); + Attach_SmartPointer( 'WMonList: GearPtr', @WMonList ); + Attach_SmartPointer( 'Standard_Equipment_List: GearPtr', @Standard_Equipment_List ); + Attach_SmartPointer( 'STC_Item_List: GearPtr', @STC_Item_List ); +{$ENDIF PATCH_GH} LoadArchetypes; +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghparser.pp(finalization)'); +{$ENDIF DEBUG} DisposeSAtt( Parser_Macros ); DisposeGear( Archetypes_List ); DisposeGear( WMonList ); DisposeGear( Standard_Equipment_List ); DisposeGear( STC_Item_List ); +end; end. diff -x .svn -uprN GearHead1100repository.original/ghprop.pp branches/ghprop.pp --- GearHead1100repository.original/ghprop.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghprop.pp 2009-08-15 04:03:51.641068000 +0900 @@ -25,7 +25,11 @@ unit ghprop; interface -uses gears; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; { PROP DEFINITION } { G => GG_Prop } @@ -81,7 +85,11 @@ Procedure InitMetaTerrain( Part: GearPtr implementation -uses texutil; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + texutil; const { This array holds the default SDL sprite numbers. } @@ -95,23 +103,44 @@ Procedure CheckPropRange( Part: GearPtr { Examine the various bits of this gear to make sure everything } { is all nice and legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check V - Size Category } if Part^.V < 1 then Part^.V := 1 else if Part^.V > 100 then Part^.V := 100; - - end; Procedure InitMetaTerrain( Part: GearPtr ); { Initialize this metaterrain gear for a nice default example of } { the terrain type it's supposed to represent. } +{$IFDEF PATCH_I18N} +var + Name: String; + Name_org: String; +{$ENDIF PATCH_I18N} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { If this is a part for which we have a standard script, } { install that script now. } if ( Part^.S >= 1 ) and ( Part^.S <= NumBasicMetaTerrain ) then begin SetNAtt( Part^.NA , NAG_Display , 0 , Meta_Terrain_Sprite[ Part^.S ] ); SetSAtt( Part^.SA , 'ROGUECHAR <' + SAttValue( Meta_Terrain_Scripts[ Part^.S ] , 'roguechar' ) + '>' ); +{$IFDEF PATCH_I18N} + Name := SAttValue( Meta_Terrain_Scripts[ Part^.S ] , 'NAME' ); + Name_org := SAttValue( Meta_Terrain_Scripts[ Part^.S ] , 'NAME_ORG' ); + if Length(Name_org) <= 0 then begin + Name_org := Name; + end; + SetSAtt( Part^.SA , 'NAME_ORG <' + Name_org + '>' ); + SetSAtt( Part^.SA , 'NAME <' + Name + '>' ); +{$ELSE PATCH_I18N} SetSAtt( Part^.SA , 'NAME <' + SAttValue( Meta_Terrain_Scripts[ Part^.S ] , 'NAME' ) + '>' ); +{$ENDIF PATCH_I18N} SetSAtt( Part^.SA , 'SDL_SPRITE <' + SAttValue( Meta_Terrain_Scripts[ Part^.S ] , 'SDL_SPRITE' ) + '>' ); end; @@ -148,10 +177,22 @@ begin end; end; + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghprop.pp'); +{$ENDIF DEBUG} LoadMetaScripts; +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghprop.pp(finalization)'); +{$ENDIF DEBUG} ClearMetaScripts; +end; end. diff -x .svn -uprN GearHead1100repository.original/ghsensor.pp branches/ghsensor.pp --- GearHead1100repository.original/ghsensor.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghsensor.pp 2009-08-15 03:21:16.378749000 +0900 @@ -66,11 +66,19 @@ Procedure CheckElecRange( Part: GearPtr implementation -uses texutil; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + texutil; Function SensorBaseDamage( Part: GearPtr ): Integer; { Return the amount of damage this sensor can withstand. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} + if Part^.S = GS_MainSensor then begin { Higer grade sensors are more succeptable to damage. } SensorBaseDamage := 60 - ( 5 * Part^.V ); @@ -82,6 +90,10 @@ end; Function SensorName( Part: GearPtr ): String; { Return a name for this particular sensor. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + if Part^.S = GS_MainSensor then begin SensorName := 'Class ' + BStr( Part^.V ) + ' Sensor'; end else if Part^.S = GS_ECM then begin @@ -94,6 +106,10 @@ end; Function SensorBaseMass( Part: GearPtr ): Integer; { Return the amount of damage this sensor can withstand. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { As with most other components, the weight of a sensor is } { equal to the amount of damage it can withstand. } SensorBaseMass := SensorBaseDamage( Part ); @@ -102,6 +118,10 @@ end; Function SensorValue( Part: GearPtr ): LongInt; { Calculate the base cost of this sensor type. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Part^.S = GS_MainSensor then begin SensorValue := Part^.V * Part^.V * 50 + 50; end else if Part^.S = GS_TarCom then begin @@ -114,6 +134,10 @@ end; Procedure CheckSensorRange( Part: GearPtr ); { Examine this sensor to make sure everything is legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Sensor Type } if Part^.S < 1 then Part^.S := 1 else if Part^.S > NumSensorType then Part^.S := 1; @@ -132,30 +156,50 @@ end; Function ElecBaseDamage( Part: GearPtr ): Integer; { Return the base damage score of this electronic device. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} + ElecBaseDamage := 1; end; Function ElecName( Part: GearPtr ): String; { Return the default name for this electronic device. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + ElecName := 'Electronic Device'; end; Function ElecBaseMass( Part: GearPtr ): Integer; { Return the basic mass score for this electronic device. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + ElecBaseMass := Part^.V; end; Function ElecValue( Part: GearPtr ): LongInt; { Return the value score for this electronic device. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + ElecValue := Part^.V * Part^.V * Part^.V * 5 + Part^.V * 10 + 15; end; Procedure CheckElecRange( Part: GearPtr ); { Examine this device to make sure everything is legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Electronics Type } if Part^.S < 1 then Part^.S := 1 else if Part^.S > NumElectronicsType then Part^.S := 1; @@ -169,4 +213,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghsensor.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghsensor.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghsupport.pp branches/ghsupport.pp --- GearHead1100repository.original/ghsupport.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghsupport.pp 2013-08-08 09:01:00.000000000 +0900 @@ -38,9 +38,16 @@ uses gears; { Stat[2] = Engine Subtype } const +{$IFDEF PATCH_CHEAT} + NumSupportType = 3; +{$ELSE PATCH_CHEAT} NumSupportType = 2; +{$ENDIF PATCH_CHEAT} GS_Gyro = 1; GS_Engine = 2; +{$IFDEF PATCH_CHEAT} + GS_ConvEqp = 3; +{$ENDIF PATCH_CHEAT} STAT_EngineSubType = 2; EST_HighOutput = 1; @@ -55,14 +62,48 @@ Procedure CheckSupportRange( Part: GearP implementation +{$IFDEF PATCH_GH} +uses + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} + {$IFDEF PATCH_CHEAT} + gears_base, + ghmodule, + gearutil, + {$ENDIF PATCH_CHEAT} + ui4gh; +{$ELSE PATCH_GH} + {$IFDEF PATCH_CHEAT} +uses + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} + gearutil, + ui4gh; + {$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} +uses errmsg; + {$ENDIF DEBUG} + {$ENDIF PATCH_CHEAT} +{$ENDIF PATCH_GH} + const + { PATCH_I18N: Don't translate it. } SupName: Array [1..NumSupportType] of String = ( 'Gyroscope','Engine' +{$IFDEF PATCH_CHEAT} + ,'ConvEqp' +{$ENDIF PATCH_CHEAT} ); Function SupportBaseDamage( Part: GearPtr ): Integer; { Return the amount of damage this system can withstand. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} + if Part^.S = GS_Engine then begin SupportBaseDamage := 3; end else begin @@ -73,14 +114,32 @@ end; Function SupportName( Part: GearPtr ): String; { Return a name for this particular sensor. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + SupportName := SupName[ Part^.S ]; end; Function SupportBaseMass( Part: GearPtr ): Integer; { Return the mass of this system. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} + if ( GS_ConvEqp = Part^.S ) then begin + { The mass is equal to 10% of the size. } + SupportBaseMass := ( ( Part^.V + 9 ) div 10 ) + Part^.Stat[1]; + end else begin + { The mass is equal to the armor value } + SupportBaseMass := Part^.Stat[1]; + end; +{$ELSE PATCH_CHEAT} { The mass is equal to the armor value } SupportBaseMass := Part^.Stat[1]; +{$ENDIF PATCH_CHEAT} end; Function SupportValue( Part: GearPtr ): LongInt; @@ -88,6 +147,10 @@ Function SupportValue( Part: GearPtr ): var it: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Part^.S = GS_Gyro then begin it := Part^.V * Part^.V * 30; end else if Part^.S = GS_Engine then begin @@ -106,14 +169,32 @@ end; Procedure CheckSupportRange( Part: GearPtr ); { Examine this support system to make sure everything is legal. } +{$IFDEF PATCH_CHEAT} +var + Mek: GearPtr; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - System Type } if Part^.S < 1 then Part^.S := 1 else if Part^.S > NumSupportType then Part^.S := 1; { Check V - System Rating. Must be in the range from 1 to 10. } if ( Part^.S = GS_Engine ) and ( Part^.Parent <> Nil ) then begin +{$IFDEF PATCH_CHEAT} + Mek := FindMaster( Part ); + if Cheat_MechaCustomize_FreeSupport or ('' <> SAttValue(Mek^.SA,SATT_CUSTOM_ENGINE)) then begin + if Part^.V < 0 then Part^.V := Part^.Parent^.V + else if 10 < Part^.V then Part^.V := 10; + end else begin + if Part^.V <> Part^.Parent^.V then Part^.V := Part^.Parent^.V; + end; +{$ELSE PATCH_CHEAT} if Part^.V <> Part^.Parent^.V then Part^.V := Part^.Parent^.V; +{$ENDIF PATCH_CHEAT} if Part^.Scale <> Part^.Parent^.Scale then Part^.Scale := Part^.Parent^.Scale; end else begin if Part^.V < 1 then Part^.V := 1 @@ -122,8 +203,29 @@ begin { Check Stats - Stat 1 is armor. } +{$IFDEF PATCH_GH} { Bug Fix } + if Part^.Stat[1] < 0 then Part^.Stat[1] := 0 + else if Part^.Stat[1] > 2 then Part^.Stat[1] := 2; +{$ELSE PATCH_GH} if Part^.Stat[1] < 0 then Part^.Stat[1] := 0 else if Part^.Stat[1] > 2 then Part^.Stat[2] := 2; +{$ENDIF PATCH_GH} +end; + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghsupport.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghsupport.pp(finalization)'); +{$ENDIF DEBUG} end; end. diff -x .svn -uprN GearHead1100repository.original/ghswag.pp branches/ghswag.pp --- GearHead1100repository.original/ghswag.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghswag.pp 2009-08-15 03:21:16.378749000 +0900 @@ -80,9 +80,14 @@ Function FoodValue( Part: GearPtr ): Lon implementation -uses ghchars; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + ghchars; Const + { PATCH_I18N: Don't translate it. } UsableTypeName: Array [1..NumUsableType] of String = ( 'Instrument' ); @@ -91,12 +96,21 @@ Const Function SwagName( Part: GearPtr ): String; { This function will make up a default name for the provided item. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + + { PATCH_I18N: Don't translate it. } SwagName := 'Thing'; end; Function SwagBaseMass( Part: GearPtr ): Integer; { This function will find the mass of the provided item. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + SwagBaseMass := 1; end; @@ -104,6 +118,10 @@ Procedure CheckSwagRange( Part: GearPtr { Examine the various bits of this gear to make sure everything } { is all nice and legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Swag Exponent } if Part^.S < 0 then Part^.S := 0 else if Part^.S > 6 then Part^.S := 6; @@ -114,6 +132,10 @@ Function SwagValue( Part: GearPtr ): Lon var it,T: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + it := Part^.V; for t := 1 to Part^.S do it := it * 10; SwagValue := it; @@ -122,18 +144,30 @@ end; Function UsableName( Part: GearPtr ): String; { This function will make up a default name for the provided item. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + UsableName := UsableTypeName[ Part^.S ]; end; Function UsableDamage( Part: GearPtr ): Integer; { Return how much damage this usable gear can withstand. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + UsableDamage := Part^.V + 1; end; Function UsableValue( Part: GearPtr ): Integer; { Return the value of this usavle gear. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + UsableValue := ( 50 + Part^.Stat[ STAT_UseBonus ] * Part^.Stat[ STAT_UseBonus ] * Part^.Stat[ STAT_UseBonus ] * 10 + Part^.V * 5 ) * ( Part^.Stat[ STAT_UseRange ] + 5 ) div 10; end; @@ -141,6 +175,10 @@ Procedure CheckUsableRange( Part: GearPt { Examine the various bits of this gear to make sure everything } { is all nice and legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Swag Type } if Part^.S < 1 then Part^.S := 1 else if Part^.S > NumUsableType then Part^.S := NumUsableType; @@ -161,6 +199,11 @@ end; Function RepairFuelName( Part: GearPtr ): String; { Returns a default name for some repairfuel. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + + { PATCH_I18N: Don't translate it. } RepairFuelName := SkillMan[ Part^.S ].Name + ' Kit'; end; @@ -168,6 +211,10 @@ Procedure CheckRepairFuelRange( Part: Ge { Examine the various bits of this gear to make sure everything } { is all nice and legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Skill Type } if Part^.S < 1 then Part^.S := 23 else if Part^.S > NumSkill then Part^.S := 23; @@ -176,6 +223,10 @@ end; Procedure CheckFoodRange( Part: GearPtr ); { Check the range for this consumable gear. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { V = Hunger Value } if Part^.V < 0 then Part^.V := 0 else if Part^.V > 60 then Part^.V := 60; @@ -195,6 +246,10 @@ end; Function FoodMass( Part: GearPtr ): Integer; { Return the basic mass value for this food. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + FoodMass := ( Part^.V * Part^.Stat[ STAT_FoodQuantity ] ) div 5; end; @@ -203,6 +258,10 @@ Function FoodValue( Part: GearPtr ): Lon var it,M: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + it := Part^.V + Part^.Stat[ Stat_FoodEffectValue ]; if Part^.Stat[ STAT_MoraleBoost ] > 0 then begin @@ -218,4 +277,20 @@ begin FoodValue := it; end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghswag.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghswag.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ghweapon.pp branches/ghweapon.pp --- GearHead1100repository.original/ghweapon.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ghweapon.pp 2009-08-16 00:45:46.542846000 +0900 @@ -25,7 +25,11 @@ unit ghweapon; interface -uses gears; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; { *** WEAPON GEARS *** } { G = GG_WeaponSys } @@ -94,6 +98,7 @@ Const { Stick an attack attribute or status effect name in a weapon's TYPE string } { attribute to activate said ability. } Num_Attack_Attributes = 22; + { PATCH_I18N: Don't translate it. } AA_Name: Array [1..Num_Attack_Attributes] of string = ( 'SWARM', 'BLAST', 'LINE', 'SCATTER', 'EXTEND', 'HYPER', 'ARMORPIERCING', 'MYSTERY', 'THROWN', 'RETURN', @@ -153,6 +158,7 @@ Const NAS_Anemia = 11; NAS_Rust = 18; + { PATCH_I18N: Don't translate it. } SX_Name: Array [1..Num_Status_FX] of String = ( 'POISON','BURN','REGEN','STONE','HAYWIRE', 'Inhuman Visage', 'Twitchy Hands', 'Depression', 'Rejection', 'Body Aches', @@ -265,6 +271,7 @@ Const (-2,-5,-2, 0, 0,-2, 0, 0) { Heart Problem } ); + { PATCH_I18N: Don't translate it. } DefaultWeaponName: Array [0..4] of String = ( 'Melee Weapon', 'Energy Weapon', @@ -278,6 +285,15 @@ Const GS_Heavy_AO = 2; GS_Melee_AO = 3; +{$IFDEF PATCH_BACKPORT} + {$IFDEF PATCH_I18N} + SATT_CaliberOrg = 'CALIBER_ORG'; + SATT_Caliber = 'CALIBER'; + {$ELSE PATCH_I18N} + SATT_Caliber = 'CALIBER'; + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_BACKPORT} + Function ScaleDC( DC,Scale: LongInt ): LongInt; @@ -314,7 +330,14 @@ Function HasStatus( Mek: GearPtr; SFX: I implementation -uses texutil,gearutil,ghmodule; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_BACKPORT} + ui4gh, +{$ENDIF PATCH_BACKPORT} + texutil,gearutil,ghmodule; Function ScaleDC( DC,Scale: LongInt ): LongInt; { Take the basic, unscaled damage class DC and change it } @@ -350,6 +373,10 @@ Procedure InitWeapon( Weapon: GearPtr ); {Given Weapon's size and type, initialize all of its} {fields to the default values.} begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { The main purpose of this unit is to fill in default missile weapon } { ranges so "vanilla" weapons will have some character. } if Weapon^.S = GS_Ballistic then begin @@ -378,6 +405,10 @@ end; Procedure InitAmmo( Ammo: GearPtr ); {Initialize an ammo gear.} begin +{$IFDEF PATCH_GH} + if (NIL = Ammo) or (Ammo^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Set default # of shots. If the ammo is loaded into a gun, the default } { is the magazine capacity of the gun. } if ( Ammo^.Parent <> Nil ) and ( Ammo^.Parent^.G = GG_Weapon ) then begin @@ -398,6 +429,10 @@ Function WeaponBaseDamage( Weapon: GearP var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Weapon^.S = GS_EMelee then begin it := ( Weapon^.V + 1 ) div 2; end else if Weapon^.S = GS_Missile then begin @@ -417,6 +452,10 @@ Function WeaponBaseMass( Weapon: GearPtr var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Weapon^.S = GS_Missile then begin { Missile launchers weigh just one unit. It's the missiles } { themselves which are heavy. } @@ -447,6 +486,10 @@ var it: Integer; NumShots: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Ammo) or (Ammo^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + NumShots := Ammo^.Stat[STAT_AmmoPresent] - NAttValue( Ammo^.NA , NAG_WeaponModifier , NAS_AmmoSpent ); if Ammo^.S = GS_Missile then begin @@ -466,6 +509,10 @@ var it: Integer; NumShots: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Ammo) or (Ammo^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + NumShots := Ammo^.Stat[STAT_AmmoPresent] - NAttValue( Ammo^.NA , NAG_WeaponModifier , NAS_AmmoSpent ); if ( Ammo^.S = GS_Missile ) or ( Ammo^.S = GS_Grenade ) then begin @@ -482,9 +529,33 @@ Function AmmoName( Ammo: GearPtr ): Stri var it: String; NumShots: Integer; -begin +{$IFDEF PATCH_BACKPORT} + CaliberFlag: Boolean; +{$ENDIF PATCH_BACKPORT} +begin +{$IFDEF PATCH_GH} + if (NIL = Ammo) or (Ammo^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + {Fill in the size of the ammunition.} +{$IFDEF PATCH_BACKPORT} + CaliberFlag := False; + if Backport_Caliber then CaliberFlag := True + else if Backport_Caliber_GH1Compatible then begin + if 0 < Length(SAttValue(Ammo^.SA,SATT_Caliber)) then CaliberFlag := True; + {$IFDEF PATCH_I18N} + if 0 < Length(SAttValue(Ammo^.SA,SATT_CaliberOrg)) then CaliberFlag := True; + {$ENDIF PATCH_I18N} + end; + + if CaliberFlag then begin + it := DCName( Ammo^.V , Ammo^.Scale ) + ' ' + SAttValue( Ammo^.SA , SATT_Caliber ); + end else begin + it := DCName( Ammo^.V , Ammo^.Scale ); + end; +{$ELSE PATCH_BACKPORT} it := DCName( Ammo^.V , Ammo^.Scale ); +{$ENDIF PATCH_BACKPORT} {Fill in the description of the ammo.} if Ammo^.S = GS_Missile then begin @@ -508,29 +579,101 @@ Function NotGoodAmmo( Wep , Mag: GearPtr { this function will return FALSE. } var NumShots: Integer; +{$IFDEF PATCH_BACKPORT} + {$IFDEF PATCH_I18N} + Wep_CalibOrg, Mag_CalibOrg: String; + {$ENDIF PATCH_I18N} + Wep_Calib, Mag_Calib: String; + CaliberFlag: Boolean; + GoodCalib: Boolean; +{$ENDIF PATCH_BACKPORT} begin { Start with an error check. } +{$IFDEF PATCH_GH} + if (NIL = Wep) or (Wep^.G <= GG_DisposeGear) then Exit(True); + if (NIL = Mag) or (Mag^.G <= GG_DisposeGear) then Exit(True); +{$ENDIF PATCH_GH} if ( Wep = Nil ) or ( Mag = Nil ) then Exit( True ); +{$IFDEF PATCH_BACKPORT} + {$IFDEF PATCH_I18N} + Wep_CalibOrg := UpCase( SAttValue( Wep^.SA , SATT_CaliberOrg ) ); + Mag_CalibOrg := UpCase( SAttValue( Mag^.SA , SATT_CaliberOrg ) ); + {$ENDIF PATCH_I18N} + Wep_Calib := UpCase( SAttValue( Wep^.SA , SATT_Caliber ) ); + Mag_Calib := UpCase( SAttValue( Mag^.SA , SATT_Caliber ) ); + + CaliberFlag := False; + if Backport_Caliber then CaliberFlag := True + else if Backport_Caliber_GH1Compatible then begin + if 0 < Length(Wep_Calib) then CaliberFlag := True; + if 0 < Length(Mag_Calib) then CaliberFlag := True; + {$IFDEF PATCH_I18N} + if 0 < Length(Wep_CalibOrg) then CaliberFlag := True; + if 0 < Length(Mag_CalibOrg) then CaliberFlag := True; + {$ENDIF PATCH_I18N} + end; +{$ENDIF PATCH_BACKPORT} NumShots := Mag^.Stat[STAT_AmmoPresent] - NAttValue( Mag^.NA , NAG_WeaponModifier , NAS_AmmoSpent ); { Check compatability. } +{$IFDEF PATCH_BACKPORT} + if ( Mag^.G <> GG_Ammo ) or ( Mag^.S <> Wep^.S ) or ( Mag^.Scale <> Wep^.Scale ) then + NotGoodAmmo := True + else if not(CaliberFlag) and ( Mag^.V <> Wep^.V ) then + NotGoodAmmo := True +{$ELSE PATCH_BACKPORT} if ( Mag^.G <> GG_Ammo ) or ( Mag^.S <> Wep^.S ) or ( Mag^.V <> Wep^.V ) or ( Mag^.Scale <> Wep^.Scale ) then NotGoodAmmo := True +{$ENDIF PATCH_BACKPORT} { Check ammunition remaining. } else if NumShots < 1 then NotGoodAmmo := True +{$IFDEF PATCH_BACKPORT} + else if CaliberFlag and (Wep^.S = GS_Missile) and (( Mag^.V * Mag^.Stat[STAT_AmmoPresent] ) > ( Wep^.V * 10 )) then + NotGoodAmmo := True +{$ENDIF PATCH_BACKPORT} + { Everything is okay. This is good ammunition. } +{$IFDEF PATCH_BACKPORT} + else if Backport_Caliber and (Wep^.S = GS_Missile) then + NotGoodAmmo := False + else if CaliberFlag then begin + {$IFDEF PATCH_I18N} + if (0 < Length(Wep_Calib)) and (Length(Wep_CalibOrg) < 1) then Wep_CalibOrg := Wep_Calib; + if (0 < Length(Wep_CalibOrg)) and (Length(Wep_Calib) < 1) then Wep_Calib := Wep_CalibOrg; + if (0 < Length(Mag_Calib)) and (Length(Mag_CalibOrg) < 1) then Mag_CalibOrg := Mag_Calib; + if (0 < Length(Mag_CalibOrg)) and (Length(Mag_Calib) < 1) then Mag_Calib := Mag_CalibOrg; + + GoodCalib := False; + if Wep_CalibOrg = Mag_CalibOrg then GoodCalib := True + else if Wep_CalibOrg = Mag_Calib then GoodCalib := True + else if Wep_Calib = Mag_CalibOrg then GoodCalib := True + else if Wep_Calib = Mag_Calib then GoodCalib := True; + + if GoodCalib then NotGoodAmmo := False + else NotGoodAmmo := True; + {$ELSE PATCH_I18N} + NotGoodAmmo := UpCase( SAttValue( Mag^.SA , SATT_Caliber ) ) <> UpCase( SAttValue( Wep^.SA , SATT_Caliber ) ); + {$ENDIF PATCH_I18N} + end else + NotGoodAmmo := False; +{$ELSE PATCH_BACKPORT} else NotGoodAmmo := False; +{$ENDIF PATCH_BACKPORT} end; Procedure CheckWeaponRange( Wpn: GearPtr ); { Check all of the values associated with this weapon to make } { sure everything is nice and legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Wpn) or (Wpn^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Weapon Type } if Wpn^.S < 0 then Wpn^.S := 0 else if Wpn^.S > 4 then Wpn^.S := 4; @@ -575,6 +718,10 @@ Procedure CheckWeaponAddOnRange( Wpn: Ge { Check all of the values associated with this weapon to make } { sure everything is nice and legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Wpn) or (Wpn^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Mount Type } if Wpn^.S < 0 then Wpn^.S := 0 else if Wpn^.S > 3 then Wpn^.S := 3; @@ -602,6 +749,11 @@ Function IsLegalWeaponInv( Slot , Equip: { have Weapon AddOns as inventory, and then only if they themselves } { are inventory-held weapons. } begin +{$IFDEF PATCH_GH} + if (NIL = Slot) or (Slot^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if ( Equip^.G = GG_WeaponAddOn ) and IsInvCom( Slot ) and ( Slot^.Scale = Equip^.Scale ) then begin { Whether or not this Add-On can be equipped to this weapon will } { depend upon its listed mounting type, which is the S descriptor. } @@ -618,11 +770,41 @@ end; Function IsLegalWeaponSub( Wep, Equip: GearPtr ): Boolean; { Return TRUE if the provided EQUIP can be installed in WEP, } { FALSE if it can't be. } +{$IFDEF PATCH_BACKPORT} +var + CaliberFlag: Boolean; +{$ENDIF PATCH_BACKPORT} begin +{$IFDEF PATCH_GH} + if (NIL = Wep) or (Wep^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Equip) or (Equip^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if ( Wep^.S = GS_Ballistic ) or ( Wep^.S = GS_Missile ) then begin +{$IFDEF PATCH_BACKPORT} + if NotGoodAmmo( Wep, Equip ) then IsLegalWeaponSub := False + else begin + CaliberFlag := False; + if Backport_Caliber then CaliberFlag := True + else if Backport_Caliber_GH1Compatible then begin + if 0 < Length(SAttValue(Wep^.SA,SATT_Caliber)) then CaliberFlag := True; + {$IFDEF PATCH_I18N} + if 0 < Length(SAttValue(Wep^.SA,SATT_CaliberOrg)) then CaliberFlag := True; + {$ENDIF PATCH_I18N} + end; + + if CaliberFlag then begin + IsLegalWeaponSub := True; + end else begin + if Equip^.Stat[ STAT_AmmoPresent ] > Wep^.Stat[ STAT_Magazine ] then IsLegalWeaponSub := False + else IsLegalWeaponSub := True; + end; + end; +{$ELSE PATCH_BACKPORT} if NotGoodAmmo( Wep, Equip ) then IsLegalWeaponSub := False else if Equip^.Stat[ STAT_AmmoPresent ] > Wep^.Stat[ STAT_Magazine ] then IsLegalWeaponSub := False else IsLegalWeaponSub := True; +{$ENDIF PATCH_BACKPORT} end else IsLegalWeaponSub := False; end; @@ -630,6 +812,10 @@ Procedure CheckAmmoRange( Ammo: GearPtr { Check all of the values associated with this ammo to make } { sure everything is nice and legal. } begin +{$IFDEF PATCH_GH} + if (NIL = Ammo) or (Ammo^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Check S - Weapon Type } if ( Ammo^.S <> GS_Ballistic ) and ( Ammo^.S <> GS_Missile ) and ( Ammo^.S <> GS_Grenade ) then begin Ammo^.S := GS_Ballistic; @@ -664,6 +850,10 @@ var N,T,R: LongInt; AList,AA: String; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Find the basic attack attributes string. } AList := SAttValue( Part^.SA , 'TYPE' ); N := 10; @@ -704,11 +894,36 @@ begin AttackAttributeValue := N; end; +{$IFDEF PATCH_BACKPORT} +Function RangeCostMod( R: Integer ): Integer; + { Return the range cost multiplier for this weapon, measured in tenths of } + { total cost. } + { At Range = 0, weapon is 4/10 cost. } +var + it: Integer; +begin + { (R/2 + 2)^2 } + it := R * R div 4 + 2 * R + 4; + RangeCostMod := it; +end; +{$ENDIF PATCH_BACKPORT} + Function WeaponValue( Part: GearPtr ): LongInt; { Decide how many standard points this weapon should cost. } var it: LongInt; N,D: LongInt; { Numerator and Denominator } +{$IFDEF PATCH_GH} + Procedure AddToTotal( DN: LongInt; DD: Integer ); + begin + N := N * DN; + D := D * DD; + while (100000 < N) or (100000 < D) do begin + N := N div 100; + D := D div 100; + end; + end; +{$ELSE PATCH_GH} Procedure AddToTotal( DN,DD: Integer ); begin N := N * DN; @@ -718,7 +933,12 @@ var D := D div 100; end; end; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { The base cost of a weapon is 35x Damage Class, } { unless it's an energy melee weapon in which case 125x Damage Class, } { or a beam weapon in which case 75x Damage Class. } @@ -809,6 +1029,10 @@ Function WeaponAddOnCost( Part: GearPtr var it,AA: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Base price is 120. } it := 120; @@ -843,14 +1067,60 @@ var AAV: LongInt; NumShots: LongInt; AA: String; -begin +{$IFDEF PATCH_BACKPORT} + value: Integer; + CaliberFlag: Boolean; +{$ENDIF PATCH_BACKPORT} +begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { The base cost of a weapon is based on its Damage Class. } NumShots := Part^.Stat[STAT_AmmoPresent]; +{$IFDEF PATCH_BACKPORT} + if Part^.S = GS_Missile then begin + { Missiles are more expensive than bullets. } + NumShots := NumShots * 10; + + CaliberFlag := False; + if Backport_Caliber then CaliberFlag := True + else if Backport_Caliber_GH1Compatible then begin + if 0 < Length(SAttValue(Part^.SA,SATT_Caliber)) then CaliberFlag := True; + {$IFDEF PATCH_I18N} + if 0 < Length(SAttValue(Part^.SA,SATT_CaliberOrg)) then CaliberFlag := True; + {$ENDIF PATCH_I18N} + end; + + if CaliberFlag then begin + { Increase cost for Range and Accuracy. } + { value := Part^.Stat[ STAT_Range ]; + if 0 < value then begin + NumShots := NumShots * RangeCostMod( value ) div 10; + end; } + + { STAT 2 - Accuracy } + { Acc 0 = No effect } + value := Part^.Stat[ STAT_Accuracy ]; + if 0 < value then begin + { High accuracy costs 20% per pip. } + NumShots := NumShots * ( 5 + value ) div 5; + end else if value < 0 then begin + { Lowered accuracy costs 10% per pip. } + NumShots := NumShots * ( 10 + value ) div 10; + end; + end; + end else if Part^.S = GS_Grenade then begin + { Grenades are also more expensive. } + NumShots := NumShots * 2; + end; +{$ELSE PATCH_BACKPORT} { Missiles are more expensive than bullets. } if Part^.S = GS_Missile then NumShots := NumShots * 10 { Grenades are also more expensive. } else if Part^.S = GS_Grenade then NumShots := NumShots * 2; +{$ENDIF PATCH_BACKPORT} { STAT 4 - Burst Value } if Part^.S = GS_Grenade then begin @@ -874,6 +1144,10 @@ Function AmmoValue( Part: GearPtr ): Lon var NumShots: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { The base cost of a weapon is based on its Damage Class. } NumShots := Part^.Stat[STAT_AmmoPresent] - NAttValue( Part^.NA , NAG_WeaponModifier , NAS_AmmoSpent ); @@ -887,6 +1161,10 @@ Function WeaponComplexity( Part: GearPtr var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Part^.S = GS_Missile then begin { The formula for Missiles is ( Dmg x Mag ) div 10 } it := Part^.V * Part^.Stat[ STAT_Magazine ] div 10; @@ -903,6 +1181,10 @@ Function WeaponArc( Weapon: GearPtr ): I var M: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(ARC_F90); +{$ENDIF PATCH_GH} + if ( weapon = Nil ) or ( weapon^.Parent = Nil ) then WeaponArc := ARC_F90 else if weapon^.G = GG_Module then begin if ( Weapon^.S = GS_Arm ) then WeaponArc := ARC_F180 @@ -916,6 +1198,9 @@ begin end else begin M := Weapon^.Parent; while ( M <> Nil ) and ( M^.G <> GG_Module ) do M := M^.Parent; +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then M := NIL; +{$ENDIF PATCH_GH} if ( M = Nil ) then WeaponArc := ARC_F90 else if ( M^.S = GS_Arm ) or ( M^.S = GS_Head ) or ( M^.S = GS_Tail ) then WeaponArc := ARC_F180 else if M^.S = GS_Turret then WeaponArc := ARC_360 @@ -928,6 +1213,10 @@ end; Function WeaponName( Weapon: GearPtr ): String; {Supply a default name for this particular weapon.} begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + {Convert the size of the weapon to a string.} if Weapon^.G = GG_Weapon then begin WeaponName := DCName( Weapon^.V , Weapon^.Scale ) + ' ' + DefaultWeaponName[Weapon^.S]; @@ -942,6 +1231,10 @@ Function CanDamageBeamShield( Weapon: Ge { shield, or FALSE otherwise. In general only beam weapons } { can affect a beam shield. } begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if Weapon^.V = GG_Weapon then begin { If it's a beamgun or emelee, it will damage a beam shield. } CanDamageBeamShield := ( Weapon^.S = GS_BeamGun ) or ( Weapon^.S = GS_EMelee ); @@ -955,6 +1248,9 @@ Function HasStatus( Mek: GearPtr; SFX: I { Return TRUE if the listed status effect is active in this } { gear, or FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if Mek = Nil then begin HasStatus := False; end else begin @@ -962,4 +1258,20 @@ begin end; end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghweapon.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ghweapon.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/glmap.pp branches/glmap.pp --- GearHead1100repository.original/glmap.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/glmap.pp 2009-08-15 03:21:16.378749000 +0900 @@ -370,6 +370,9 @@ begin glDisable( GL_Lighting ); glDisable( GL_Light1 ); while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if OnTheMap( M ) then begin X := NAttValue( M^.NA , NAG_Location , NAS_X ); Y := NAttValue( M^.NA , NAG_Location , NAS_Y ); @@ -380,6 +383,9 @@ begin DrawModel( LocateTextureByID( NAttValue( M^.NA , NAG_Location , NAS_Image ) ) , 1.0 + ( ( Animation_Phase + X + Y ) div 5 mod 2 ) / 80 , 0 ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; diff -x .svn -uprN GearHead1100repository.original/grabgear.pp branches/grabgear.pp --- GearHead1100repository.original/grabgear.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/grabgear.pp 2009-08-15 03:57:07.331024000 +0900 @@ -39,11 +39,25 @@ Function Attempt_Gear_Grab( const Cmd: S implementation -{$IFDEF SDLMODE} -uses ability,arenascript,gearutil,interact,sdlmap; -{$ELSE} -uses ability,arenascript,gearutil,interact,conmap; -{$ENDIF} +uses +{$IFDEF DEBUG} + sysutils,errmsg, +{$ENDIF DEBUG} + ability,arenascript,gearutil,interact, +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + sdlgfx,sdlmap + {$ELSE SDLMODE} + conmap,context + {$ENDIF SDLMODE} +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} + sdlmap + {$ELSE} + conmap + {$ENDIF} +{$ENDIF PATCH_GH} + ; Function GG_LocatePC( GB: GameBoardPtr ): GearPtr; { Attempt to find the player character. If there's more than one } @@ -57,14 +71,24 @@ begin { We are going to cheat a little bit. } { If the interaction menu has been defined, we already know the } { location of the PC since it's stored in I_PC. } +{$IFDEF PATCH_GH} + if (NIL <> IntMenu) and (NIL <> I_PC) and (GG_DisposeGear < I_PC^.G) then begin +{$ELSE PATCH_GH} if ( IntMenu <> Nil ) and ( I_PC <> Nil ) then begin +{$ENDIF PATCH_GH} PC := I_PC; end else if GB <> Nil then begin Bits := GB^.Meks; while ( Bits <> Nil ) and ( PC = Nil ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Bits^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( Bits^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and IsMasterGear( Bits ) and OnTheMap( Bits ) and GearOperational( Bits ) then begin PC := Bits; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Bits := Bits^.Next; end; end; @@ -74,9 +98,15 @@ begin if PC = Nil then begin Bits := GB^.Meks; while ( Bits <> Nil ) and ( PC = Nil ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Bits^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( Bits^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and IsMasterGear( Bits ) and ( LocatePilot( Bits ) <> Nil ) then begin PC := Bits; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Bits := Bits^.Next; end; end; @@ -90,14 +120,33 @@ Function GG_LocateNPC( CID: LongInt; GB: var NPC: GearPtr; begin +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('GG_LocateNPC()'); +{$ENDIF DEBUG} + { Error check - no undefined searches!!! } if CID = 0 then Exit( Nil ); NPC := Nil; +{$IFDEF PATCH_GH} + if (NIL <> GB) then begin + NPC := SeekGearByCID( GB^.Meks , CID ); + end; + if (NIL = NPC) and (NIL <> GB^.Scene) then begin + NPC := SeekGearByCID( FindRoot( GB^.Scene ) , CID ); + end; + if (NIL = NPC) then begin + NPC := SeekGearByCID( FindRoot( Source ) , CID ); + end; + if (NIL = NPC) and (NIL <> SCRIPT_DynamicEncounter) then begin + NPC := SeekGearByCID( SCRIPT_DynamicEncounter , CID ); + end; +{$ELSE PATCH_GH} if ( GB <> Nil ) then NPC := SeekGearByCID( GB^.Meks , CID ); if ( NPC = Nil ) and ( GB^.Scene <> Nil ) then NPC := SeekGearByCID( FindRoot( GB^.Scene ) , CID ); if NPC = Nil then NPC := SeekGearByCID( FindRoot( Source ) , CID ); if ( NPC = Nil ) and ( SCRIPT_DynamicEncounter <> Nil ) then NPC := SeekGearByCID( SCRIPT_DynamicEncounter , CID ); +{$ENDIF PATCH_GH} GG_LocateNPC := NPC; end; @@ -110,9 +159,18 @@ begin { Error check - no undefined searches!!! } if NID = 0 then Exit( Nil ); +{$IFDEF PATCH_GH} + Item := NIL; +{$ENDIF PATCH_GH} if GB <> Nil then begin Item := SeekGearByIDTag( GB^.Meks , NAG_Narrative , NAS_NID , NID ); +{$IFDEF PATCH_GH} + if (NIL = Item) then begin + Item := SeekGearByIDTag( FindRoot( GB^.Scene ) , NAG_Narrative , NAS_NID , NID ); + end; +{$ELSE PATCH_GH} if Item = Nil then Item := SeekGearByIDTag( FindRoot( GB^.Scene ) , NAG_Narrative , NAS_NID , NID ); +{$ENDIF PATCH_GH} end else begin Item := SeekGearByIDTag( FindRoot( Source ) , NAG_Narrative , NAS_NID , NID ); end; @@ -155,7 +213,31 @@ begin { Note that the master plot may have a G of GG_AbsolutelyNothing, } { if a previous command in the script has set this plot to be } { advanced. } +{$IFDEF PATCH_GH} + { Before "AdvancePlot 0" : GG_Adventure -> GG_Plot -> GG_Persona } + { After "AdvancePlot 0" : GG_Adventure -> GG_AbsolutelyNothing -> GG_Persona } + if (NIL = Scene) then exit(NIL); + if (GG_AbsolutelyNothing = Scene^.G) or (Scene^.G <= GG_DisposeGear) then begin + {$IFDEF DEBUG} + if (Scene^.G <= GG_DisposeGear) then begin + ErrorMessage_fork('ERROR: PlotMaster(): Scene is GG_DisposeGear ' + IntToHex(Int64(Scene), 16) + ', Replaced by ' + IntToHex(Int64(Current_PlotMaster), 16) ); + DialogMsg('ERROR: PlotMaster(): Scene is GG_DisposeGear ' + IntToHex(Int64(Scene), 16) + ', Replaced by ' + IntToHex(Int64(Current_PlotMaster), 16) ); + end else begin + ErrorMessage_fork('WARNING: PlotMaster(): Scene is GG_AbsolutelyNothing ' + IntToHex(Int64(Scene), 16) + ', Replaced by ' + IntToHex(Int64(Current_PlotMaster), 16) ); + end; + {$ENDIF DEBUG} + while (NIL <> Scene^.Parent) and ((GG_AbsolutelyNothing = Scene^.Parent^.G) or (Scene^.Parent^.G <= GG_DisposeGear)) do begin + Scene := Scene^.Parent; + end; + Scene := Current_PlotMaster; + end else begin + while (NIL <> Scene) and (GG_Plot <> Scene^.G) and (GG_AbsolutelyNothing <> Scene^.G) do begin + Scene := Scene^.Parent; + end; + end; +{$ELSE PATCH_GH} while ( Scene <> Nil ) and (Scene^.G <> GG_Plot ) and ( Scene^.G <> GG_AbsolutelyNothing ) do Scene := Scene^.Parent; +{$ENDIF PATCH_GH} PlotMaster := Scene; end; @@ -166,7 +248,29 @@ begin { Note that the master plot may have a G of GG_AbsolutelyNothing, } { if a previous command in the script has set this plot to be } { advanced. } +{$IFDEF PATCH_GH} + if (NIL = Scene) then exit(NIL); + if (GG_AbsolutelyNothing = Scene^.G) or (Scene^.G <= GG_DisposeGear) then begin + {$IFDEF DEBUG} + if (Scene^.G <= GG_DisposeGear) then begin + ErrorMessage_fork('ERROR: StoryMaster(): Scene is GG_DisposeGear ' + IntToHex(Int64(Scene), 16) + ', Replaced by ' + IntToHex(Int64(Current_StoryMaster), 16) ); + DialogMsg('ERROR: StoryMaster(): Scene is GG_DisposeGear ' + IntToHex(Int64(Scene), 16) + ', Replaced by ' + IntToHex(Int64(Current_StoryMaster), 16) ); + end else begin + ErrorMessage_fork('WARNING: StoryMaster(): Scene is GG_AbsolutelyNothing ' + IntToHex(Int64(Scene), 16) + ', Replaced by ' + IntToHex(Int64(Current_StoryMaster), 16) ); + end; + {$ENDIF DEBUG} + while (NIL <> Scene^.Parent) and ((GG_AbsolutelyNothing = Scene^.Parent^.G) or (Scene^.Parent^.G <= GG_DisposeGear)) do begin + Scene := Scene^.Parent; + end; + Scene := Current_StoryMaster; + end else begin + while (NIL <> Scene) and (GG_Story <> Scene^.G) and (GG_AbsolutelyNothing <> Scene^.G) do begin + Scene := Scene^.Parent; + end; + end; +{$ELSE PATCH_GH} while ( Scene <> Nil ) and (Scene^.G <> GG_Story ) and ( Scene^.G <> GG_AbsolutelyNothing ) do Scene := Scene^.Parent; +{$ENDIF PATCH_GH} StoryMaster := Scene; end; @@ -190,6 +294,9 @@ begin end else if CMD = 'GRABDYNAMIC' then begin { Grab the dynamic scene currently under construction. } +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('Attempt_Gear_Grab()'); +{$ENDIF DEBUG} Grabbed_Gear := SCRIPT_DynamicEncounter; end else if ( CMD = 'GRABCURRENTSCENE' ) and ( GB <> Nil ) then begin @@ -219,8 +326,13 @@ begin X := ScriptValue( Event , GB , Source ); Grabbed_Gear := GG_LocateItem( X , GB , Source ); +{$IFDEF PATCH_GH} + end else if ( CMD = 'GRABCHATNPC' ) then begin + Grabbed_Gear := I_NPC; +{$ELSE PATCH_GH} end else if ( CMD = 'GRABCHATNPC' ) and ( IntMenu <> Nil ) then begin Grabbed_Gear := I_NPC; +{$ENDIF PATCH_GH} end else if ( CMD = 'GRABPC' ) and ( GB <> Nil ) then begin Grabbed_Gear := GG_LocatePC( GB ); @@ -240,7 +352,57 @@ begin it := False; end; +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} + if it then begin + if NIL = Grabbed_Gear then begin + Show_DebugMessage_Grabbed_Gear('TRACE: Attempt_Gear_Grab(): Grabbed_Gear is NIL.'); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT1( cmd + ' (' + Event + ')' ) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT2( cmd + ' (' + Event + ')' ) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT3( cmd + ' (' + Event + ')' ) ); + end else if (Grabbed_Gear^.G <= GG_DisposeGear) then begin + Show_DebugMessage_Grabbed_Gear('ERROR: Attempt_Gear_Grab(): '); + DialogMsg('ERROR: Attempt_Gear_Grab(): Grabbed_Gear is GG_DisposeGear.'); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT1( cmd + ' (' + Event + ')' ) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT1( cmd + ' (' + Event + ')' ) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT2( cmd + ' (' + Event + ')' ) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT2( cmd + ' (' + Event + ')' ) ); + ErrorMessage_fork( Make_ErrorMessage_ASL_CONTEXT3( cmd + ' (' + Event + ')' ) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT3( cmd + ' (' + Event + ')' ) ); + end else begin + Show_DebugMessage_Grabbed_Gear('TRACE: Attempt_Gear_Grab() cmd:"' + cmd + '".'); + end; + end; + {$ELSE DEBUG} + if it then begin + if NIL = Grabbed_Gear then begin + end else if (Grabbed_Gear^.G <= GG_DisposeGear) then begin + DialogMsg('ERROR: Attempt_Gear_Grab(): Grabbed_Gear is GG_DisposeGear.'); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT1( cmd + ' (' + Event + ')' ) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT2( cmd + ' (' + Event + ')' ) ); + DialogMsg( Make_ErrorMessage_ASL_CONTEXT3( cmd + ' (' + Event + ')' ) ); + end else begin + end; + end; + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} Attempt_Gear_Grab := it; end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: grabgear.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: grabgear.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/i18nmsg.pp branches/i18nmsg.pp --- GearHead1100repository.original/i18nmsg.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/i18nmsg.pp 2009-08-16 02:02:35.592236000 +0900 @@ -0,0 +1,232 @@ +{$IFDEF PATCH_I18N} +unit i18nmsg; + +interface + +var + I18N_UseOriginalName: Boolean = False; + + +{ Return the standard message string which has the requested label. } +Function I18N_Settings( const MsgLabel: String; const DefaultMsg: String ): String; +Function I18N_Name( const CategoryLabel, MsgLabel: String; const I18N: Boolean ): String; +Function I18N_Name( const CategoryLabel, MsgLabel: String ): String; +Function I18N_Name_withDefault( const MsgLabel, DefaultMsg: String ): String; +Function I18N_Name( const MsgLabel: String ): String; +Function I18N_MsgString( const CategoryLabel, MsgLabel: String; const I18N: Boolean ): String; +Function I18N_MsgString( const CategoryLabel, MsgLabel: String ): String; +Function I18N_MsgString( const MsgLabel: String ): String; + + + +implementation + +uses +{$IFDEF PATCH_GH} + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + gears_base +{$ELSE PATCH_GH} + gears +{$ENDIF PATCH_GH} + ; + + +var + I18N_Settings_SAtt: SAttPtr; + I18N_Name_SAtt: SAttPtr; + I18N_Messages_SAtt: SAttPtr; + + + +Function ConcatenateLabel( const CategoryLabel, MsgLabel: String ): String; +var + P: Integer; +begin + ConcatenateLabel := CategoryLabel + '_' + MsgLabel; + P := Pos( ' ', ConcatenateLabel ); + while (0 < P) do begin + ConcatenateLabel[P] := '_'; + P := Pos( ' ', ConcatenateLabel ); + end; +end; + + +Function DeconcatenateLabel( MsgLabel: String ): String; +var + P: Integer; +begin + DeconcatenateLabel := MsgLabel; + P := Pos( '_', DeconcatenateLabel ); + while (0 < P) do begin + DeconcatenateLabel[P] := ' '; + P := Pos( '_', DeconcatenateLabel ); + end; +end; + + + +Function I18N_Settings( const MsgLabel: String; const DefaultMsg: String ): String; +begin + I18N_Settings := SAttValue( I18N_Settings_SAtt, MsgLabel ); + if (0 = Length(I18N_Settings)) then begin +{$IFDEF PATCH_GH} + ErrorMessage_fork( 'I18N_Settings: "' + MsgLabel + '" not found.' ); +{$ELSE PATCH_GH} + WriteLn( 'I18N_Settings: "' + MsgLabel + '" not found.' ); +{$ENDIF PATCH_GH} + I18N_Settings := DefaultMsg; + end; +end; + + + +Function I18N_Name( const CategoryLabel, MsgLabel: String; const I18N: Boolean ): String; +begin + if I18N and not(I18N_UseOriginalName) then begin + I18N_Name := SAttValue( I18N_Name_SAtt, ConcatenateLabel( CategoryLabel, MsgLabel) ); + if (0 = Length(I18N_Name)) then begin +{$IFDEF PATCH_GH} + ErrorMessage_fork( 'I18N_Name: "' + CategoryLabel + ':' + MsgLabel + '" not found.' ); +{$ELSE PATCH_GH} + WriteLn( 'I18N_Name: "' + CategoryLabel + ':' + MsgLabel + '" not found.' ); +{$ENDIF PATCH_GH} + I18N_Name := MsgLabel; + end; + end else begin + I18N_Name := MsgLabel; + end; +end; + + +Function I18N_Name( const CategoryLabel, MsgLabel: String ): String; +begin + if I18N_UseOriginalName then begin + I18N_Name := MsgLabel; + end else begin + I18N_Name := SAttValue( I18N_Name_SAtt, ConcatenateLabel( CategoryLabel, MsgLabel) ); + if (0 = Length(I18N_Name)) then begin +{$IFDEF PATCH_GH} + ErrorMessage_fork( 'I18N_Name: "' + CategoryLabel + ':' + MsgLabel + '" not found.' ); +{$ELSE PATCH_GH} + WriteLn( 'I18N_Name: "' + CategoryLabel + ':' + MsgLabel + '" not found.' ); +{$ENDIF PATCH_GH} + I18N_Name := MsgLabel; + end; + end; +end; + + +Function I18N_Name_withDefault( const MsgLabel, DefaultMsg: String ): String; +var + lbl: String; +begin + lbl := ConcatenateLabel( '', MsgLabel ); + if I18N_UseOriginalName then begin + I18N_Name_withDefault := DefaultMsg; + end else begin + I18N_Name_withDefault := SAttValue( I18N_Name_SAtt, lbl ); + if (0 = Length(I18N_Name_withDefault)) then begin + I18N_Name_withDefault := DefaultMsg; + end; + end; +end; + + +Function I18N_Name( const MsgLabel: String ): String; +var + lbl: String; +begin + lbl := ConcatenateLabel( '', MsgLabel ); + if I18N_UseOriginalName then begin + I18N_Name := DeconcatenateLabel( lbl ); + end else begin + I18N_Name := SAttValue( I18N_Name_SAtt, lbl ); + if (0 = Length(I18N_Name)) then begin +{$IFDEF PATCH_GH} + ErrorMessage_fork( 'I18N_Name: "' + lbl + '" not found.' ); +{$ELSE PATCH_GH} + WriteLn( 'I18N_Name: "' + lbl + '" not found.' ); +{$ENDIF PATCH_GH} + I18N_Name := DeconcatenateLabel( lbl ); + end; + end; +end; + + + +Function I18N_MsgString( const CategoryLabel, MsgLabel: String; const I18N: Boolean ): String; +begin + if I18N then begin + I18N_MsgString := SAttValue( I18N_Messages_SAtt, ConcatenateLabel( CategoryLabel, MsgLabel) ); + if (0 = Length(I18N_MsgString)) then begin +{$IFDEF PATCH_GH} + ErrorMessage_fork( 'I18N_MsgString: "' + CategoryLabel + ':' + MsgLabel + '" not found.' ); +{$ELSE PATCH_GH} + WriteLn( 'I18N_MsgString: "' + CategoryLabel + ':' + MsgLabel + '" not found.' ); +{$ENDIF PATCH_GH} + I18N_MsgString := MsgLabel; + end; + end else begin + I18N_MsgString := MsgLabel; + end; +end; + + +Function I18N_MsgString( const CategoryLabel, MsgLabel: String ): String; +begin + I18N_MsgString := SAttValue( I18N_Messages_SAtt, ConcatenateLabel( CategoryLabel, MsgLabel) ); + if (0 = Length(I18N_MsgString)) then begin +{$IFDEF PATCH_GH} + ErrorMessage_fork( 'I18N_MsgString: "' + CategoryLabel + ':' + MsgLabel + '" not found.' ); +{$ELSE PATCH_GH} + WriteLn( 'I18N_MsgString: "' + CategoryLabel + ':' + MsgLabel + '" not found.' ); +{$ENDIF PATCH_GH} + I18N_MsgString := MsgLabel; + end; +end; + + +Function I18N_MsgString( const MsgLabel: String ): String; +begin + I18N_MsgString := SAttValue( I18N_Messages_SAtt, MsgLabel ); + if (0 = Length(I18N_MsgString)) then begin +{$IFDEF PATCH_GH} + ErrorMessage_fork( 'I18N_MsgString: "' + MsgLabel + '" not found.' ); +{$ELSE PATCH_GH} + WriteLn( 'I18N_MsgString: "' + MsgLabel + '" not found.' ); +{$ENDIF PATCH_GH} + I18N_MsgString := MsgLabel; + end; +end; + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: i18nmsg.pp'); +{$ENDIF DEBUG} + I18N_Settings_SAtt := LoadStringList( I18N_Settings_File ); + I18N_Name_SAtt := LoadStringList( I18N_Name_File ); + I18N_Messages_SAtt := LoadStringList( I18N_Messages_File ); +end; + + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: i18nmsg.pp(finalization)'); +{$ENDIF DEBUG} + DisposeSAtt( I18N_Messages_SAtt ); + DisposeSAtt( I18N_Name_SAtt ); + DisposeSAtt( I18N_Settings_SAtt ); +end; + +end. +{$ENDIF PATCH_I18N} diff -x .svn -uprN GearHead1100repository.original/iconv.pp branches/iconv.pp --- GearHead1100repository.original/iconv.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/iconv.pp 2009-08-16 01:59:58.507660000 +0900 @@ -0,0 +1,343 @@ +{$IFDEF PATCH_I18N} +unit iconv; + +interface + +uses sysutils, libiconv; + + +type + enc_type = (ENC_UNKNOWN, SINGLEBYTE, EUCJP, EUCKR, EUCCN, EUCTW, UTF8, SJIS, CP932); + + +const + SENC: enc_type = ENC_UNKNOWN; + SYSTEM_CHARSET: String = ''; + +{$IFDEF WITH_TENC} + { A conversion charset for the terminal. } + TENC: enc_type = ENC_UNKNOWN; + TERMINAL_CHARSET: String = ''; + + TERMINAL_bidiRTL: Boolean = False; + TERMINAL_bidiRTL_Punctuation: String = ''; + TERMINAL_bidiRTL_ConvPair1: String = ''; + TERMINAL_bidiRTL_ConvPair2: String = ''; +{$ENDIF WITH_TENC} + +{$IFDEF CONV_UNICODE} + { A conversion charset for SDL_TTF.TTF_RenderUnicode_Solid(). } + UNICODE_CHARSET = 'UTF-16LE'; +{$ENDIF CONV_UNICODE} + + +{$IFDEF ICONV} +var + {$IFDEF WITH_TENC} + { Conversion tables for the terminal. } + iconv_enc2tenc: iconv_t; + iconv_tenc2enc: iconv_t; + {$ENDIF WITH_TENC} + {$IFDEF CONV_UNICODE} + { Conversion tables for SDL_TTF.TTF_RenderUnicode_Solid(). } + iconv_enc2utf16: iconv_t; + iconv_utf16toenc: iconv_t; + {$ENDIF CONV_UNICODE} +{$ENDIF ICONV} + + + +implementation + +uses +{$IFDEF PATCH_GH} + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} + i18nmsg; + + +Function Parse_EncType( const encoding: String; var charset: String ): enc_type; +var + P1, P2: Integer; + codec: String; + encoding_order: Boolean = False; +begin + Parse_EncType := ENC_UNKNOWN; + + P1 := Pos( '.', encoding ); + if 0 < P1 then begin + charset := UpCase(Copy( encoding, P1+1, Length(encoding) -P1 )); + end else begin + charset := UpCase(encoding); + end; + + P2 := Pos('-', charset); + if 0 < P2 then begin + codec := Copy( charset, 1, P2-1 ); + if ('SINGLEBYTE' = codec) then begin + Parse_EncType := SINGLEBYTE; + encoding_order := True; + end else if ('MULTIBYTE' = codec) then begin + Parse_EncType := ENC_UNKNOWN; + encoding_order := True; + end else if ('2BYTE' = codec) then begin + Parse_EncType := ENC_UNKNOWN; + encoding_order := True; + end; + if encoding_order then begin + charset := Copy( charset, P2+1, Length(charset) -P2 ); + end; + end; + if (0 = Length(charset)) or ('SINGLEBYTE' = charset) then begin + charset := 'ISO8859-1'; + Parse_EncType := SINGLEBYTE; + end else if ('EUCJP' = charset) or ('EUC-JP' = charset) then begin + Parse_EncType := EUCJP; + end else if ('EUCKR' = charset) or ('EUC-KR' = charset) then begin + Parse_EncType := EUCKR; + end else if ('EUCCN' = charset) or ('EUC-CN' = charset) then begin + Parse_EncType := EUCCN; + end else if ('EUCTW' = charset) or ('EUC-TW' = charset) then begin + Parse_EncType := EUCTW; + end else if ('UTF-8' = charset) then begin + Parse_EncType := UTF8; + end else if ('SJIS' = charset) or ('SHIFT-JIS' = charset) or ('SHIFT_JIS' = charset) then begin + Parse_EncType := SJIS; + end else if ('CP932' = charset) or ('MS932' = charset) then begin + Parse_EncType := CP932; + end else begin + Parse_EncType := SINGLEBYTE; + end; +end; + + + +Procedure Get_senc(); +var + codec: String; +begin + codec := I18N_Settings('SYSTEM_ENCODING', ''); + SENC := Parse_EncType( codec, SYSTEM_CHARSET ); +end; + + +Procedure Get_tenc(); +{$IFDEF WITH_TENC} +var + codec: String; + bidiRTL: String; +begin + codec := ''; + if '' = codec then begin + codec := GetEnvironmentVariable('GEARHEAD_LANG'); + end; + if '' = codec then begin + codec := GetEnvironmentVariable('LC_ALL'); + end; + if '' = codec then begin + codec := GetEnvironmentVariable('LC_MESSAGES'); + end; + if '' = codec then begin + codec := GetEnvironmentVariable('LOCALE'); + end; + if '' = codec then begin + codec := GetEnvironmentVariable('LANGUAGE'); + end; + if '' = codec then begin + codec := GetEnvironmentVariable('LANG'); + end; + {$IFDEF Windows} + if '' = codec then begin + codec := I18N_Settings('TERMINAL_ENCODING_DEFAULT_MSWIN',''); + end; + {$ENDIF Windows} + if '' = codec then begin + codec := I18N_Settings('TERMINAL_ENCODING_DEFAULT',''); + end; + if '' = codec then begin + codec := I18N_Settings('SYSTEM_ENCODING',''); + end; + + TENC := Parse_EncType( codec, TERMINAL_CHARSET ); + + bidiRTL := I18N_Settings('TERMINAL_ENCODING_CONV_bidiRTL',''); + case bidiRTL[1] of + 'T': TERMINAL_bidiRTL := True; + 'F': TERMINAL_bidiRTL := False; + end; + TERMINAL_bidiRTL_Punctuation := ' ' + I18N_Settings('bidiRTL_CONVERT_PUNCTUATION',''); + TERMINAL_bidiRTL_ConvPair1 := '< ' + I18N_Settings('bidiRTL_CONVERT_CHAR_PAIR1',''); + TERMINAL_bidiRTL_ConvPair2 := '> ' + I18N_Settings('bidiRTL_CONVERT_CHAR_PAIR2',''); +{$ELSE WITH_TENC} +begin +{$ENDIF WITH_TENC} +end; + + + +Procedure Get_enc(); +var + err: Boolean = False; +begin + Get_senc(); + Get_tenc(); + + if ENC_UNKNOWN = SENC then begin +{$IFDEF PATCH_GH} + ErrorMessage('Unknown locale "' + SYSTEM_CHARSET + '".'); +{$ELSE PATCH_GH} + WriteLn('Unknown locale "' + SYSTEM_CHARSET + '".'); +{$ENDIF PATCH_GH} + err := True; + end; + +{$IFDEF WITH_TENC} + if ENC_UNKNOWN = TENC then begin + {$IFDEF PATCH_GH} + ErrorMessage('Unknown locale "' + TERMINAL_CHARSET + '".'); + {$ELSE PATCH_GH} + WriteLn('Unknown locale "' + TERMINAL_CHARSET + '".'); + {$ENDIF PATCH_GH} + err := True; + end; +{$ENDIF WITH_TENC} + + if err then begin + halt(255); + end; +end; + + + +Procedure Init_tenc(); +{$IFDEF WITH_TENC} + {$IFDEF ICONV} +var + tenc_cstr: Array[0..255] of Char; + senc_cstr: Array[0..255] of Char; + {$ENDIF ICONV} +begin + { Initialize conversion tables. } + {$IFDEF ICONV} + StrPCopy( tenc_cstr, TERMINAL_CHARSET ); + StrPCopy( senc_cstr, SYSTEM_CHARSET ); + if (CP932 = TENC) and (EUCJP = SENC) then begin + StrPCopy( senc_cstr, 'EUCJP-MS' ); + end; + if (CP932 = SENC) and (EUCJP = TENC) then begin + StrPCopy( tenc_cstr, 'EUCJP-MS' ); + end; + iconv_enc2tenc := libiconv.iconv_open( tenc_cstr, senc_cstr ); + iconv_tenc2enc := libiconv.iconv_open( senc_cstr, tenc_cstr ); + if (iconv_t(-1) = iconv_enc2tenc) or (iconv_t(-1) = iconv_tenc2enc) then begin + {$IFDEF PATCH_GH} + ErrorMessage('iconv initialization failed. (system encoding "' + SYSTEM_CHARSET + '", terminal encoding "' + TERMINAL_CHARSET + '")'); + {$ELSE PATCH_GH} + WriteLn('iconv initialization failed. (system encoding "' + SYSTEM_CHARSET + '", terminal encoding "' + TERMINAL_CHARSET + '")'); + {$ENDIF PATCH_GH} + halt(255); + end; + {$ENDIF ICONV} +{$ELSE WITH_TENC} +begin +{$ENDIF WITH_TENC} +end; + + +Procedure Init_unicode(); +{$IFDEF CONV_UNICODE} + {$IFDEF ICONV} +var + uenc_cstr: Array[0..255] of Char; + senc_cstr: Array[0..255] of Char; + {$ENDIF ICONV} +begin + { Initialize conversion tables. } + {$IFDEF ICONV} + StrPCopy( uenc_cstr, UNICODE_CHARSET ); + StrPCopy( senc_cstr, SYSTEM_CHARSET ); + iconv_enc2utf16 := libiconv.iconv_open( uenc_cstr, senc_cstr ); + iconv_utf16toenc := libiconv.iconv_open( senc_cstr, uenc_cstr ); + if (iconv_t(-1) = iconv_enc2utf16) or (iconv_t(-1) = iconv_utf16toenc) then begin + {$IFDEF PATCH_GH} + ErrorMessage('iconv initialization failed. (system encoding "' + SYSTEM_CHARSET + '", unicode encoding "' + UNICODE_CHARSET + '")'); + {$ELSE PATCH_GH} + WriteLn('iconv initialization failed. (system encoding "' + SYSTEM_CHARSET + '", unicode encoding "' + UNICODE_CHARSET + '")'); + {$ENDIF PATCH_GH} + halt(255); + end; + {$ENDIF ICONV} +{$ELSE CONV_UNICODE} +begin +{$ENDIF CONV_UNICODE} +end; + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: iconv.pp'); +{$ENDIF DEBUG} + +{$IFDEF ENCODING_SINGLEBYTE} + SENC := SINGLEBYTE; + SYSTEM_CHARSET := ''; +{$ENDIF} +{$IFDEF ENCODING_EUCJP} + SENC := EUCJP; + SYSTEM_CHARSET := 'EUCJP'; +{$ENDIF} +{$IFDEF ENCODING_EUCKR} + SENC := EUCKR; + SYSTEM_CHARSET := 'EUCKR'; +{$ENDIF} +{$IFDEF ENCODING_EUCCN} + SENC := EUCCN; + SYSTEM_CHARSET := 'EUCCN'; +{$ENDIF} +{$IFDEF ENCODING_EUCTW} + SENC := EUCTW; + SYSTEM_CHARSET := 'EUCTW'; +{$ENDIF} +{$IFDEF ENCODING_UTF8} + SENC := UTF8; + SYSTEM_CHARSET := 'UTF-8'; +{$ENDIF} +{$IFDEF ENCODING_SJIS} + SENC := SJIS; + SYSTEM_CHARSET := 'SJIS'; +{$ENDIF} +{$IFDEF ENCODING_CP932} + SENC := CP932; + SYSTEM_CHARSET := 'CP932'; +{$ENDIF} + + Get_enc(); + Init_tenc(); + Init_unicode(); +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: iconv.pp(finalization)'); +{$ENDIF DEBUG} +{$IFDEF ICONV} + {$IFDEF CONV_UNICODE} + libiconv.iconv_close( iconv_utf16toenc ); + libiconv.iconv_close( iconv_enc2utf16 ); + {$ENDIF CONV_UNICODE} + {$IFDEF WITH_TENC} + libiconv.iconv_close( iconv_tenc2enc ); + libiconv.iconv_close( iconv_enc2tenc ); + {$ENDIF WITH_TENC} +{$ENDIF ICONV} +end; + +end. +{$ENDIF PATCH_I18N} diff -x .svn -uprN GearHead1100repository.original/imm.pp branches/imm.pp --- GearHead1100repository.original/imm.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/imm.pp 2009-08-11 02:13:00.087836000 +0900 @@ -0,0 +1,718 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2005 by the Free Pascal development team + Header translation by Alexey Barkovoy for Free Pascal Platform + + Input Method Manager definitions + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + + +(**********************************************************************) +(* imm.h - Input Method Manager definitions *) +(* *) +(* Copyright (c) Microsoft Corporation. All rights reserved. *) +(**********************************************************************) + +{$mode objfpc} + +unit Imm; + +interface + +uses + Windows; + +type + HIMC = THandle; + HIMCC = THandle; + + LPHKL = ^HKL; + LPUINT = ^LongWord; + + tagCOMPOSITIONFORM = record + dwStyle: DWORD; + ptCurrentPos: TPoint; + rcArea: TRect; + end; + COMPOSITIONFORM = tagCOMPOSITIONFORM; + TCompositionForm = tagCOMPOSITIONFORM; + PCompositionForm = ^TCompositionForm; + + tagCANDIDATEFORM = record + dwIndex: DWORD; + dwStyle: DWORD; + ptCurrentPos: TPoint; + rcArea: TRect; + end; + CANDIDATEFORM = tagCANDIDATEFORM; + TCandidateForm = tagCANDIDATEFORM; + PCandidateForm = ^TCandidateForm; + + tagCANDIDATELIST = record + dwSize: DWORD; + dwStyle: DWORD; + dwCount: DWORD; + dwSelection: DWORD; + dwPageStart: DWORD; + dwPageSize: DWORD; + dwOffset: array[0..0] of DWORD; + end; + CANDIDATELIST = tagCANDIDATELIST; + TCandidateList = tagCANDIDATELIST; + PCandidateList = ^TCandidateList; + + tagREGISTERWORDA = record + lpReading: PAnsiChar; + lpWord: PAnsiChar; + end; + REGISTERWORDA = tagREGISTERWORDA; + TRegisterWordA = tagREGISTERWORDA; + PRegisterWordA = ^TRegisterWordA; + + tagREGISTERWORDW = record + lpReading: PWideChar; + lpWord: PWideChar; + end; + REGISTERWORDW = tagREGISTERWORDW; + TRegisterWordW = tagREGISTERWORDW; + PRegisterWordW = ^TRegisterWordW; + + {$IFDEF UNICODE} + REGISTERWORD = REGISTERWORDW; + TRegisterWord = TRegisterWordW; + PRegisterWord = PRegisterWordW; + {$ELSE} + REGISTERWORD = REGISTERWORDA; + TRegisterWord = TRegisterWordA; + PRegisterWord = PRegisterWordA; + {$ENDIF} + + tagRECONVERTSTRING = record + dwSize: DWORD; + dwVersion: DWORD; + dwStrLen: DWORD; + dwStrOffset: DWORD; + dwCompStrLen: DWORD; + dwCompStrOffset: DWORD; + dwTargetStrLen: DWORD; + dwTargetStrOffset: DWORD; + end; + RECONVERTSTRING = tagRECONVERTSTRING; + TReconvertString = tagRECONVERTSTRING; + PReconvertString = ^TReconvertString; + +const + STYLE_DESCRIPTION_SIZE = 32; + +type + tagSTYLEBUFA = record + dwStyle: DWORD; + szDescription: array [0..STYLE_DESCRIPTION_SIZE-1] of AnsiChar; + end; + STYLEBUFA = tagSTYLEBUFA; + TStyleBufA = tagSTYLEBUFA; + PStyleBufA = ^TStyleBufA; + + tagSTYLEBUFW = record + dwStyle: DWORD; + szDescription: array [0..STYLE_DESCRIPTION_SIZE-1] of WideChar; + end; + STYLEBUFW = tagSTYLEBUFW; + TStyleBufW = tagSTYLEBUFW; + PStyleBufW = ^TStyleBufW; + + {$IFDEF UNICODE} + STYLEBUF = STYLEBUFW; + TStyleBuf = TStyleBufW; + PStyleBuf = PStyleBufW; + {$ELSE} + STYLEBUF = STYLEBUFA; + TStyleBuf = TStyleBufA; + PStyleBuf = PStyleBufA; + {$ENDIF} + +const + IMEMENUITEM_STRING_SIZE = 80; + +type + tagIMEMENUITEMINFOA = record + cbSize: LongWord; + fType: LongWord; + fState: LongWord; + wID: LongWord; + hbmpChecked: HBITMAP; + hbmpUnchecked: HBITMAP; + dwItemData: DWORD; + szString: array[0..IMEMENUITEM_STRING_SIZE-1] of AnsiChar; + hbmpItem: HBITMAP; + end; + IMEMENUITEMINFOA = tagIMEMENUITEMINFOA; + TIMEMenuItemInfoA = tagIMEMENUITEMINFOA; + PIMEMenuItemInfoA = ^TIMEMenuItemInfoA; + + tagIMEMENUITEMINFOW = record + cbSize: LongWord; + fType: LongWord; + fState: LongWord; + wID: LongWord; + hbmpChecked: HBITMAP; + hbmpUnchecked: HBITMAP; + dwItemData: DWORD; + szString: array[0..IMEMENUITEM_STRING_SIZE-1] of WideChar; + hbmpItem: HBITMAP; + end; + IMEMENUITEMINFOW = tagIMEMENUITEMINFOW; + TIMEMenuItemInfoW = tagIMEMENUITEMINFOW; + PIMEMenuItemInfoW = ^TIMEMenuItemInfoW; + + {$IFDEF UNICODE} + IMEMENUITEMINFO = IMEMENUITEMINFOW; + TIMEMenuItemInfo = TIMEMenuItemInfoW; + PIMEMenuItemInfo = PIMEMenuItemInfoW; + {$ELSE} + IMEMENUITEMINFO = IMEMENUITEMINFOA; + TIMEMenuItemInfo = TIMEMenuItemInfoA; + PIMEMenuItemInfo = PIMEMenuItemInfoA; + {$ENDIF} + + + tagIMECHARPOSITION = record + dwSize: DWORD; + dwCharPos: DWORD; + pt: TPoint; + cLineHeight: LongWord; + rcDocument: TRect; + end; + IMECHARPOSITION = tagIMECHARPOSITION; + TIMECharPosition = tagIMECHARPOSITION; + PIMECharPosition = ^TIMECharPosition; + + + IMCEnumProc = function (h: HIMC; l: LPARAM): BOOL; stdcall; + + +{$IFDEF FPC} +type + PLOGFONTA = PLOGFONT; + PLOGFONTW = ^TLOGFONTW; + + tagLOGFONTW = packed record + lfHeight: Longint; + lfWidth: Longint; + lfEscapement: Longint; + lfOrientation: Longint; + lfWeight: Longint; + lfItalic: Byte; + lfUnderline: Byte; + lfStrikeOut: Byte; + lfCharSet: Byte; + lfOutPrecision: Byte; + lfClipPrecision: Byte; + lfQuality: Byte; + lfPitchAndFamily: Byte; + lfFaceName: array[0..LF_FACESIZE - 1] of WideChar; + end; + TLOGFONTW = tagLOGFONTW; + +{$ENDIF} + + +// prototype of IMM API + +const + imm32 = 'imm32.dll'; + +function ImmInstallIMEA(lpszIMEFileName, lpszLayoutText: PAnsiChar): HKL; stdcall; external imm32; +function ImmInstallIMEW(lpszIMEFileName, lpszLayoutText: PWideChar): HKL; stdcall; external imm32; +function ImmInstallIME(lpszIMEFileName, lpszLayoutText: PChar): HKL; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmInstallIMEW'{$ELSE}'ImmInstallIMEA'{$ENDIF}; + +function ImmGetDefaultIMEWnd(hWnd: HWND): HWND; stdcall; external imm32; + +function ImmGetDescriptionA(hKl: HKL; PAnsiChar: PAnsiChar; uBufLen: UINT): UINT; stdcall; external imm32; +function ImmGetDescriptionW(hKl: HKL; PWideChar: PWideChar; uBufLen: UINT): UINT; stdcall; external imm32; +function ImmGetDescription(hKl: HKL; PChar: PChar; uBufLen: UINT): UINT; stdcall; external imm32 name {$IFDEF UNICODE}'ImmGetDescriptionW'{$ELSE}'ImmGetDescriptionA'{$ENDIF}; + +function ImmGetIMEFileNameA(hKl: HKL; PAnsiChar: PAnsiChar; uBufLen: UINT): UINT; stdcall; external imm32; +function ImmGetIMEFileNameW(hKl: HKL; PWideChar: PWideChar; uBufLen: UINT): UINT; stdcall; external imm32; +function ImmGetIMEFileName(hKl: HKL; PChar: PChar; uBufLen: UINT): UINT; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmGetIMEFileNameW'{$ELSE}'ImmGetIMEFileNameA'{$ENDIF}; + +function ImmGetProperty(hKl: HKL; dWord: DWORD): DWORD; stdcall; external imm32; + +function ImmIsIME(hKl: HKL): Boolean; stdcall; external imm32; + +function ImmSimulateHotKey(hWnd: HWND; dWord: DWORD): Boolean; stdcall; external imm32; + +function ImmCreateContext: HIMC; stdcall; external imm32; +function ImmDestroyContext(hImc: HIMC): Boolean; stdcall; external imm32; +function ImmGetContext(hWnd: HWND): HIMC; stdcall; external imm32; +function ImmReleaseContext(hWnd: HWND; hImc: HIMC): Boolean; stdcall; external imm32; +function ImmAssociateContext(hWnd: HWND; hImc: HIMC): HIMC; stdcall; external imm32; + +function ImmAssociateContextEx(hWnd: HWND; hImc: HIMC; dw: DWORD): HIMC; stdcall; external imm32; + +function ImmGetCompositionStringA(hImc: HIMC; dWord1: DWORD; lpBuf: pointer; dwBufLen: DWORD): Longint; stdcall; external imm32; +function ImmGetCompositionStringW(hImc: HIMC; dWord1: DWORD; lpBuf: pointer; dwBufLen: DWORD): Longint; stdcall; external imm32; +function ImmGetCompositionString(hImc: HIMC; dWord1: DWORD; lpBuf: pointer; dwBufLen: DWORD): Longint; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmGetCompositionStringW'{$ELSE}'ImmGetCompositionStringA'{$ENDIF}; + +function ImmSetCompositionStringA(hImc: HIMC; dwIndex: DWORD; lpComp: Pointer; + dwCompLen: DWORD; lpRead: Pointer; dwReadLen: DWORD): Boolean; stdcall; external imm32; +function ImmSetCompositionStringW(hImc: HIMC; dwIndex: DWORD; lpComp: Pointer; + dwCompLen: DWORD; lpRead: Pointer; dwReadLen: DWORD): Boolean; stdcall; external imm32; +function ImmSetCompositionString(hImc: HIMC; dwIndex: DWORD; lpComp: Pointer; + dwCompLen: DWORD; lpRead: Pointer; dwReadLen: DWORD): Boolean; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmSetCompositionStringW'{$ELSE}'ImmSetCompositionStringA'{$ENDIF}; + +function ImmGetCandidateListCountA(hImc: HIMC; var ListCount: DWORD): DWORD; stdcall; external imm32; +function ImmGetCandidateListCountW(hImc: HIMC; var ListCount: DWORD): DWORD; stdcall; external imm32; +function ImmGetCandidateListCount(hImc: HIMC; var ListCount: DWORD): DWORD; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmGetCandidateListCountW'{$ELSE}'ImmGetCandidateListCountA'{$ENDIF}; + +function ImmGetCandidateListA(hImc: HIMC; deIndex: DWORD; lpCandidateList: PCandidateList; dwBufLen: DWORD): DWORD; stdcall; external imm32; +function ImmGetCandidateListW(hImc: HIMC; deIndex: DWORD; lpCandidateList: PCandidateList; dwBufLen: DWORD): DWORD; stdcall; external imm32; +function ImmGetCandidateList(hImc: HIMC; deIndex: DWORD; lpCandidateList: PCandidateList; dwBufLen: DWORD): DWORD; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmGetCandidateListW'{$ELSE}'ImmGetCandidateListA'{$ENDIF}; + +function ImmGetGuideLineA(hImc: HIMC; dwIndex: DWORD; lpBuf: PAnsiChar; dwBufLen: DWORD): DWORD; stdcall; external imm32; +function ImmGetGuideLineW(hImc: HIMC; dwIndex: DWORD; lpBuf: PWideChar; dwBufLen: DWORD): DWORD; stdcall; external imm32; +function ImmGetGuideLine(hImc: HIMC; dwIndex: DWORD; lpBuf: PChar; dwBufLen: DWORD): DWORD; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmGetGuideLineW'{$ELSE}'ImmGetGuideLineA'{$ENDIF}; + +function ImmGetConversionStatus(hImc: HIMC; var Conversion, Sentence: DWORD): Boolean; stdcall; external imm32; +function ImmSetConversionStatus(hImc: HIMC; Conversion, Sentence: DWORD): Boolean; stdcall; external imm32; +function ImmGetOpenStatus(hImc: HIMC): Boolean; stdcall; external imm32; +function ImmSetOpenStatus(hImc: HIMC; fOpen: Boolean): Boolean; stdcall; external imm32; + +function ImmGetCompositionFontA(hImc: HIMC; lpLogfont: PLogFontA): Boolean; stdcall; external imm32; +function ImmGetCompositionFontW(hImc: HIMC; lpLogfont: PLogFontW): Boolean; stdcall; external imm32; +function ImmGetCompositionFont(hImc: HIMC; lpLogfont: PLogFont): Boolean; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmGetCompositionFontW'{$ELSE}'ImmGetCompositionFontA'{$ENDIF}; + +function ImmSetCompositionFontA(hImc: HIMC; lpLogfont: PLogFontA): Boolean; stdcall; external imm32; +function ImmSetCompositionFontW(hImc: HIMC; lpLogfont: PLogFontW): Boolean; stdcall; external imm32; +function ImmSetCompositionFont(hImc: HIMC; lpLogfont: PLogFont): Boolean; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmSetCompositionFontW'{$ELSE}'ImmSetCompositionFontA'{$ENDIF}; + +function ImmConfigureIMEA(hKl: HKL; hWnd: HWND; dwMode: DWORD; lpData: Pointer): Boolean; stdcall; external imm32; +function ImmConfigureIMEW(hKl: HKL; hWnd: HWND; dwMode: DWORD; lpData: Pointer): Boolean; stdcall; external imm32; +function ImmConfigureIME(hKl: HKL; hWnd: HWND; dwMode: DWORD; lpData: Pointer): Boolean; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmConfigureIMEW'{$ELSE}'ImmConfigureIMEA'{$ENDIF}; + +function ImmEscapeA(hKl: HKL; hImc: HIMC; uEscape: UINT; lpData: Pointer): LRESULT; stdcall; external imm32; +function ImmEscapeW(hKl: HKL; hImc: HIMC; uEscape: UINT; lpData: Pointer): LRESULT; stdcall; external imm32; +function ImmEscape(hKl: HKL; hImc: HIMC; uEscape: UINT; lpData: Pointer): LRESULT; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmEscapeW'{$ELSE}'ImmEscapeA'{$ENDIF}; + +function ImmGetConversionListA(hKl: HKL; hImc: HIMC; lpSrc: PAnsiChar; lpDst: PCandidateList; + dwBufLen: DWORD; uFlag: UINT): DWORD; stdcall; external imm32; +function ImmGetConversionListW(hKl: HKL; hImc: HIMC; lpSrc: PWideChar; lpDst: PCandidateList; + dwBufLen: DWORD; uFlag: UINT): DWORD; stdcall; external imm32; +function ImmGetConversionList(hKl: HKL; hImc: HIMC; lpSrc: PChar; lpDst: PCandidateList; + dwBufLen: DWORD; uFlag: UINT): DWORD; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmGetConversionListW'{$ELSE}'ImmGetConversionListA'{$ENDIF}; + +function ImmNotifyIME(hImc: HIMC; dwAction, dwIndex, dwValue: DWORD): Boolean; stdcall; external imm32; + +function ImmGetStatusWindowPos(hImc: HIMC; var lpPoint: TPoint): Boolean; stdcall; external imm32; +function ImmSetStatusWindowPos(hImc: HIMC; lpPoint: PPoint): Boolean; stdcall; external imm32; +function ImmGetCompositionWindow(hImc: HIMC; lpCompForm: PCompositionForm): Boolean; stdcall; external imm32; +function ImmSetCompositionWindow(hImc: HIMC; lpCompForm: PCompositionForm): Boolean; stdcall; external imm32; +function ImmGetCandidateWindow(hImc: HIMC; dwBufLen: DWORD; lpCandidate: PCandidateForm): Boolean; stdcall; external imm32; +function ImmSetCandidateWindow(hImc: HIMC; lpCandidate: PCandidateForm): Boolean; stdcall; external imm32; + +function ImmIsUIMessageA(hWnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): Boolean; stdcall; external imm32; +function ImmIsUIMessageW(hWnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): Boolean; stdcall; external imm32; +function ImmIsUIMessage(hWnd: HWND; msg: UINT; wParam: WPARAM; lParam: LPARAM): Boolean; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmIsUIMessageW'{$ELSE}'ImmIsUIMessageA'{$ENDIF}; + +function ImmGetVirtualKey(hWnd: HWND): UINT; stdcall; external imm32; + +type + RegisterWordEnumProcA = function(lpReading: PAnsiChar; dwStyle: DWORD; lpszString: PAnsiChar; lpData: Pointer): Integer; + RegisterWordEnumProcW = function(lpReading: PWideChar; dwStyle: DWORD; lpszString: PWideChar; lpData: Pointer): Integer; + {$IFDEF UNICODE} + RegisterWordEnumProc = RegisterWordEnumProcW; + {$ELSE} + RegisterWordEnumProc = RegisterWordEnumProcA; + {$ENDIF} + +function ImmRegisterWordA(hKl: HKL; lpszReading: PAnsiChar; dwStyle: DWORD; lpszRegister: PAnsiChar): Boolean; stdcall; external imm32; +function ImmRegisterWordW(hKl: HKL; lpszReading: PWideChar; dwStyle: DWORD; lpszRegister: PWideChar): Boolean; stdcall; external imm32; +function ImmRegisterWord(hKl: HKL; lpszReading: PChar; dwStyle: DWORD; lpszRegister: PChar): Boolean; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmRegisterWordW'{$ELSE}'ImmRegisterWordA'{$ENDIF}; + +function ImmUnregisterWordA(hKl: HKL; lpszReading: PAnsiChar; dwStyle: DWORD; lpszUnregister: PAnsiChar): Boolean; stdcall; external imm32; +function ImmUnregisterWordW(hKl: HKL; lpszReading: PWideChar; dwStyle: DWORD; lpszUnregister: PWideChar): Boolean; stdcall; external imm32; +function ImmUnregisterWord(hKl: HKL; lpszReading: PChar; dwStyle: DWORD; lpszUnregister: PChar): Boolean; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmUnregisterWordW'{$ELSE}'ImmUnregisterWordA'{$ENDIF}; + +function ImmGetRegisterWordStyleA(hKl: HKL; nItem: UINT; lpStyleBuf: PStyleBufA): UINT; stdcall; external imm32; +function ImmGetRegisterWordStyleW(hKl: HKL; nItem: UINT; lpStyleBuf: PStyleBufW): UINT; stdcall; external imm32; +function ImmGetRegisterWordStyle(hKl: HKL; nItem: UINT; lpStyleBuf: PStyleBuf): UINT; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmGetRegisterWordStyleW'{$ELSE}'ImmGetRegisterWordStyleA'{$ENDIF}; + +function ImmEnumRegisterWordA(hKl: HKL; lpfnEnumProc: RegisterWordEnumProcA; + lpszReading: PAnsiChar; dwStyle: DWORD; lpszRegister: PAnsiChar; lpData: Pointer): UINT; stdcall; external imm32; +function ImmEnumRegisterWordW(hKl: HKL; lpfnEnumProc: RegisterWordEnumProcW; + lpszReading: PWideChar; dwStyle: DWORD; lpszRegister: PWideChar; lpData: Pointer): UINT; stdcall; external imm32; +function ImmEnumRegisterWord(hKl: HKL; lpfnEnumProc: RegisterWordEnumProc; + lpszReading: PChar; dwStyle: DWORD; lpszRegister: PChar; lpData: Pointer): UINT; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmEnumRegisterWordW'{$ELSE}'ImmEnumRegisterWordA'{$ENDIF}; + +function ImmDisableIME(dw: DWORD): BOOL; stdcall; external imm32; +function ImmEnumInputContext(idThread: DWORD; lpfn: IMCEnumProc; lParam: LPARAM): BOOL; stdcall; external imm32; + +function ImmGetImeMenuItemsA(hImc: HIMC; dwFlags: DWORD; dwType: DWORD; out lpImeParentMenu: TIMEMenuItemInfoA; + out lpImeMenu: TIMEMenuItemInfoA; dwSize: DWORD): BOOL; stdcall; external imm32; +function ImmGetImeMenuItemsW(hImc: HIMC; dwFlags: DWORD; dwType: DWORD; out lpImeParentMenu: TIMEMenuItemInfoW; + out lpImeMenu: TIMEMenuItemInfoW; dwSize: DWORD): BOOL; stdcall; external imm32; +function ImmGetImeMenuItems(hImc: HIMC; dwFlags: DWORD; dwType: DWORD; out lpImeParentMenu: TIMEMenuItemInfo; + out lpImeMenu: TIMEMenuItemInfo; dwSize: DWORD): BOOL; stdcall; external imm32 + name {$IFDEF UNICODE}'ImmGetImeMenuItemsW'{$ELSE}'ImmGetImeMenuItemsA'{$ENDIF}; + + +const + // wParam for WM_IME_CONTROL + IMC_GETCANDIDATEPOS = $0007; + IMC_SETCANDIDATEPOS = $0008; + IMC_GETCOMPOSITIONFONT = $0009; + IMC_SETCOMPOSITIONFONT = $000A; + IMC_GETCOMPOSITIONWINDOW = $000B; + IMC_SETCOMPOSITIONWINDOW = $000C; + IMC_GETSTATUSWINDOWPOS = $000F; + IMC_SETSTATUSWINDOWPOS = $0010; + IMC_CLOSESTATUSWINDOW = $0021; + IMC_OPENSTATUSWINDOW = $0022; + + + // dwAction for ImmNotifyIME + NI_OPENCANDIDATE = $0010; + NI_CLOSECANDIDATE = $0011; + NI_SELECTCANDIDATESTR = $0012; + NI_CHANGECANDIDATELIST = $0013; + NI_FINALIZECONVERSIONRESULT = $0014; + NI_COMPOSITIONSTR = $0015; + NI_SETCANDIDATE_PAGESTART = $0016; + NI_SETCANDIDATE_PAGESIZE = $0017; + NI_IMEMENUSELECTED = $0018; + + // lParam for WM_IME_SETCONTEXT + ISC_SHOWUICANDIDATEWINDOW = $00000001; + ISC_SHOWUICOMPOSITIONWINDOW = $80000000; + ISC_SHOWUIGUIDELINE = $40000000; + ISC_SHOWUIALLCANDIDATEWINDOW = $0000000F; + ISC_SHOWUIALL = $C000000F; + + + // dwIndex for ImmNotifyIME/NI_COMPOSITIONSTR + CPS_COMPLETE = $0001; + CPS_CONVERT = $0002; + CPS_REVERT = $0003; + CPS_CANCEL = $0004; + + // the modifiers of hot key + MOD_ALT = $0001; + MOD_CONTROL = $0002; + MOD_SHIFT = $0004; + + MOD_LEFT = $8000; + MOD_RIGHT = $4000; + + MOD_ON_KEYUP = $0800; + MOD_IGNORE_ALL_MODIFIER = $0400; + + // Windows for Simplified Chinese Edition hot key ID from 0x10 - 0x2F + IME_CHOTKEY_IME_NONIME_TOGGLE = $10; + IME_CHOTKEY_SHAPE_TOGGLE = $11; + IME_CHOTKEY_SYMBOL_TOGGLE = $12; + + // Windows for Japanese Edition hot key ID from 0x30 - 0x4F + IME_JHOTKEY_CLOSE_OPEN = $30; + + // Windows for Korean Edition hot key ID from 0x50 - 0x6F + IME_KHOTKEY_SHAPE_TOGGLE = $50; + IME_KHOTKEY_HANJACONVERT = $51; + IME_KHOTKEY_ENGLISH = $52; + + // Windows for Traditional Chinese Edition hot key ID from 0x70 - 0x8F + IME_THOTKEY_IME_NONIME_TOGGLE = $70; + IME_THOTKEY_SHAPE_TOGGLE = $71; + IME_THOTKEY_SYMBOL_TOGGLE = $72; + + // direct switch hot key ID from 0x100 - 0x11F + IME_HOTKEY_DSWITCH_FIRST = $100; + IME_HOTKEY_DSWITCH_LAST = $11F; + + // IME private hot key from 0x200 - 0x21F + IME_HOTKEY_PRIVATE_FIRST = $200; + IME_ITHOTKEY_RESEND_RESULTSTR = $200; + IME_ITHOTKEY_PREVIOUS_COMPOSITION = $201; + IME_ITHOTKEY_UISTYLE_TOGGLE = $202; + IME_ITHOTKEY_RECONVERTSTRING = $203; + IME_HOTKEY_PRIVATE_LAST = $21F; + + + // parameter of ImmGetCompositionString + GCS_COMPREADSTR = $0001; + GCS_COMPREADATTR = $0002; + GCS_COMPREADCLAUSE = $0004; + GCS_COMPSTR = $0008; + GCS_COMPATTR = $0010; + GCS_COMPCLAUSE = $0020; + GCS_CURSORPOS = $0080; + GCS_DELTASTART = $0100; + GCS_RESULTREADSTR = $0200; + GCS_RESULTREADCLAUSE = $0400; + GCS_RESULTSTR = $0800; + GCS_RESULTCLAUSE = $1000; + + // style bit flags for WM_IME_COMPOSITION + CS_INSERTCHAR = $2000; + CS_NOMOVECARET = $4000; + + // IME version constants + IMEVER_0310 = $0003000A; + IMEVER_0400 = $00040000; + + + // IME property bits + IME_PROP_AT_CARET = $00010000; + IME_PROP_SPECIAL_UI = $00020000; + IME_PROP_CANDLIST_START_FROM_1 = $00040000; + IME_PROP_UNICODE = $00080000; + IME_PROP_COMPLETE_ON_UNSELECT = $00100000; + + + // IME UICapability bits + UI_CAP_2700 = $00000001; + UI_CAP_ROT90 = $00000002; + UI_CAP_ROTANY = $00000004; + + // ImmSetCompositionString Capability bits + SCS_CAP_COMPSTR = $00000001; + SCS_CAP_MAKEREAD = $00000002; + SCS_CAP_SETRECONVERTSTRING = $00000004; + + + // IME WM_IME_SELECT inheritance Capability bits + SELECT_CAP_CONVERSION = $00000001; + SELECT_CAP_SENTENCE = $00000002; + + + // ID for deIndex of ImmGetGuideLine + GGL_LEVEL = $00000001; + GGL_INDEX = $00000002; + GGL_STRING = $00000003; + GGL_PRIVATE = $00000004; + + + // ID for dwLevel of GUIDELINE Structure + GL_LEVEL_NOGUIDELINE = $00000000; + GL_LEVEL_FATAL = $00000001; + GL_LEVEL_ERROR = $00000002; + GL_LEVEL_WARNING = $00000003; + GL_LEVEL_INFORMATION = $00000004; + + + // ID for dwIndex of GUIDELINE Structure + GL_ID_UNKNOWN = $00000000; + GL_ID_NOMODULE = $00000001; + GL_ID_NODICTIONARY = $00000010; + GL_ID_CANNOTSAVE = $00000011; + GL_ID_NOCONVERT = $00000020; + GL_ID_TYPINGERROR = $00000021; + GL_ID_TOOMANYSTROKE = $00000022; + GL_ID_READINGCONFLICT = $00000023; + GL_ID_INPUTREADING = $00000024; + GL_ID_INPUTRADICAL = $00000025; + GL_ID_INPUTCODE = $00000026; + GL_ID_INPUTSYMBOL = $00000027; + GL_ID_CHOOSECANDIDATE = $00000028; + GL_ID_REVERSECONVERSION = $00000029; + GL_ID_PRIVATE_FIRST = $00008000; + GL_ID_PRIVATE_LAST = $0000FFFF; + + + // ID for dwIndex of ImmGetProperty + IGP_GETIMEVERSION = DWORD(-4); + IGP_PROPERTY = $00000004; + IGP_CONVERSION = $00000008; + IGP_SENTENCE = $0000000c; + IGP_UI = $00000010; + IGP_SETCOMPSTR = $00000014; + IGP_SELECT = $00000018; + + // dwIndex for ImmSetCompositionString API + SCS_SETSTR = (GCS_COMPREADSTR or GCS_COMPSTR); + SCS_CHANGEATTR = (GCS_COMPREADATTR or GCS_COMPATTR); + SCS_CHANGECLAUSE = (GCS_COMPREADCLAUSE or GCS_COMPCLAUSE); + SCS_SETRECONVERTSTRING = $00010000; + SCS_QUERYRECONVERTSTRING = $00020000; + + // attribute for COMPOSITIONSTRING Structure + ATTR_INPUT = $00; + ATTR_TARGET_CONVERTED = $01; + ATTR_CONVERTED = $02; + ATTR_TARGET_NOTCONVERTED = $03; + ATTR_INPUT_ERROR = $04; + ATTR_FIXEDCONVERTED = $05; + + // bit field for IMC_SETCOMPOSITIONWINDOW, IMC_SETCANDIDATEWINDOW + CFS_DEFAULT = $0000; + CFS_RECT = $0001; + CFS_POINT = $0002; + CFS_FORCE_POSITION = $0020; + CFS_CANDIDATEPOS = $0040; + CFS_EXCLUDE = $0080; + + // conversion direction for ImmGetConversionList + GCL_CONVERSION = $0001; + GCL_REVERSECONVERSION = $0002; + GCL_REVERSE_LENGTH = $0003; + + // bit field for conversion mode + IME_CMODE_ALPHANUMERIC = $0000; + IME_CMODE_NATIVE = $0001; + IME_CMODE_CHINESE = IME_CMODE_NATIVE; + // IME_CMODE_HANGEUL is old name of IME_CMODE_HANGUL. It will be gone eventually. + IME_CMODE_HANGEUL = IME_CMODE_NATIVE; + IME_CMODE_HANGUL = IME_CMODE_NATIVE; + IME_CMODE_JAPANESE = IME_CMODE_NATIVE; + IME_CMODE_KATAKANA = $0002; // only effect under IME_CMODE_NATIVE + IME_CMODE_LANGUAGE = $0003; + IME_CMODE_FULLSHAPE = $0008; + IME_CMODE_ROMAN = $0010; + IME_CMODE_CHARCODE = $0020; + IME_CMODE_HANJACONVERT = $0040; + IME_CMODE_SOFTKBD = $0080; + IME_CMODE_NOCONVERSION = $0100; + IME_CMODE_EUDC = $0200; + IME_CMODE_SYMBOL = $0400; + IME_CMODE_FIXED = $0800; + + // bit field for sentence mode + IME_SMODE_NONE = $0000; + IME_SMODE_PLAURALCLAUSE = $0001; + IME_SMODE_SINGLECONVERT = $0002; + IME_SMODE_AUTOMATIC = $0004; + IME_SMODE_PHRASEPREDICT = $0008; + IME_SMODE_CONVERSATION = $0010; + + // style of candidate + IME_CAND_UNKNOWN = $0000; + IME_CAND_READ = $0001; + IME_CAND_CODE = $0002; + IME_CAND_MEANING = $0003; + IME_CAND_RADICAL = $0004; + IME_CAND_STROKE = $0005; + + // wParam of report message WM_IME_NOTIFY + IMN_CLOSESTATUSWINDOW = $0001; + IMN_OPENSTATUSWINDOW = $0002; + IMN_CHANGECANDIDATE = $0003; + IMN_CLOSECANDIDATE = $0004; + IMN_OPENCANDIDATE = $0005; + IMN_SETCONVERSIONMODE = $0006; + IMN_SETSENTENCEMODE = $0007; + IMN_SETOPENSTATUS = $0008; + IMN_SETCANDIDATEPOS = $0009; + IMN_SETCOMPOSITIONFONT = $000A; + IMN_SETCOMPOSITIONWINDOW = $000B; + IMN_SETSTATUSWINDOWPOS = $000C; + IMN_GUIDELINE = $000D; + IMN_PRIVATE = $000E; + + // wParam of report message WM_IME_REQUEST + IMR_COMPOSITIONWINDOW = $0001; + IMR_CANDIDATEWINDOW = $0002; + IMR_COMPOSITIONFONT = $0003; + IMR_RECONVERTSTRING = $0004; + IMR_CONFIRMRECONVERTSTRING = $0005; + IMR_QUERYCHARPOSITION = $0006; + IMR_DOCUMENTFEED = $0007; + + // error code of ImmGetCompositionString + IMM_ERROR_NODATA = (-1); + IMM_ERROR_GENERAL = (-2); + + + // dialog mode of ImmConfigureIME + IME_CONFIG_GENERAL = 1; + IME_CONFIG_REGISTERWORD = 2; + IME_CONFIG_SELECTDICTIONARY = 3; + + + // flags for ImmEscape + IME_ESC_QUERY_SUPPORT = $0003; + IME_ESC_RESERVED_FIRST = $0004; + IME_ESC_RESERVED_LAST = $07FF; + IME_ESC_PRIVATE_FIRST = $0800; + IME_ESC_PRIVATE_LAST = $0FFF; + + IME_ESC_SEQUENCE_TO_INTERNAL = $1001; + IME_ESC_GET_EUDC_DICTIONARY = $1003; + IME_ESC_SET_EUDC_DICTIONARY = $1004; + IME_ESC_MAX_KEY = $1005; + IME_ESC_IME_NAME = $1006; + IME_ESC_SYNC_HOTKEY = $1007; + IME_ESC_HANJA_MODE = $1008; + IME_ESC_AUTOMATA = $1009; + IME_ESC_PRIVATE_HOTKEY = $100a; + IME_ESC_GETHELPFILENAME = $100b; + // style of word registration + IME_REGWORD_STYLE_EUDC = $00000001; + IME_REGWORD_STYLE_USER_FIRST = $80000000; + IME_REGWORD_STYLE_USER_LAST = $FFFFFFFF; + + + // dwFlags for ImmAssociateContextEx + IACE_CHILDREN = $0001; + IACE_DEFAULT = $0010; + IACE_IGNORENOCONTEXT = $0020; + + // dwFlags for ImmGetImeMenuItems + IGIMIF_RIGHTMENU = $0001; + + // dwType for ImmGetImeMenuItems + IGIMII_CMODE = $0001; + IGIMII_SMODE = $0002; + IGIMII_CONFIGURE = $0004; + IGIMII_TOOLS = $0008; + IGIMII_HELP = $0010; + IGIMII_OTHER = $0020; + IGIMII_INPUTTOOLS = $0040; + + // fType of IMEMENUITEMINFO structure + IMFT_RADIOCHECK = $00001; + IMFT_SEPARATOR = $00002; + IMFT_SUBMENU = $00004; + + // fState of IMEMENUITEMINFO structure + IMFS_GRAYED = MFS_GRAYED; + IMFS_DISABLED = MFS_DISABLED; + IMFS_CHECKED = MFS_CHECKED; + IMFS_HILITE = MFS_HILITE; + IMFS_ENABLED = MFS_ENABLED; + IMFS_UNCHECKED = MFS_UNCHECKED; + IMFS_UNHILITE = MFS_UNHILITE; + IMFS_DEFAULT = MFS_DEFAULT; + + // type of soft keyboard + // for Windows Tranditional Chinese Edition + SOFTKEYBOARD_TYPE_T1 = $0001; + // for Windows Simplified Chinese Edition + SOFTKEYBOARD_TYPE_C1 = $0002; + +implementation + +end. diff -x .svn -uprN GearHead1100repository.original/interact.pp branches/interact.pp --- GearHead1100repository.original/interact.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/interact.pp 2009-08-16 01:50:29.583341000 +0900 @@ -27,7 +27,11 @@ unit interact; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; Const { *** PERSONA GEAR *** } @@ -64,6 +68,10 @@ Const { hate each other. The "S" identifier is the CID of the character } { to which this reaction score applies. } NAG_ReactionScore = 6; +{$IFDEF PATCH_GH} + MaxReactionScore = +30000; + MinReactionScore = -30000; +{$ENDIF PATCH_GH} { This attribute records the relationship between two factions. } NAG_FactionScore = 8; @@ -99,7 +107,11 @@ Function PersonalityCompatability( PC, N Function ReactionScore( Scene, PC, NPC: GearPtr ): Integer; Function CreateRumorList( GB: gameBoardPtr; PC,NPC: GearPtr ): SAttPtr; +{$IFDEF PATCH_I18N} +Function IdleChatter( NPC: GearPtr ): String; +{$ELSE PATCH_I18N} Function IdleChatter: String; +{$ENDIF PATCH_I18N} Function IsSexy( PC, NPC: GearPtr ): Boolean; function DoChatting( GB: GameBoardPtr; var Rumors: SAttPtr; PC,NPC: GearPtr; Var Endurance,FreeRumors: Integer ): String; @@ -120,10 +132,36 @@ Function LancematesPresent( GB: GameBoar Function FindNPCByKeyWord( GB: GameBoardPtr; KW: String ): GearPtr; +{$IFDEF PATCH_I18N} +Function FormatChatStringByGender( Msg1: String; NPC: GearPtr ): String; +{$ENDIF PATCH_I18N} implementation -uses ability,gearutil,ghchars,rpgdice,texutil; +uses +{$IFDEF DEBUG} + sysutils, + errmsg, +{$ELSE DEBUG} + {$IFDEF PATCH_GH} + errmsg, + {$ENDIF PATCH_GH} +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF DEBUG} + ui4gh, +{$ENDIF DEBUG} + ability,gearutil,ghchars,rpgdice,texutil +{$IFDEF DEBUG} + {$IFDEF SDLMODE} + ,sdlgfx + {$ELSE SDLMODE} + ,context + {$ENDIF SDLMODE} +{$ENDIF DEBUG} + ; const Num_Openings = 7; { Number of TraitChatter opening phrases. } @@ -136,6 +174,12 @@ var { Strings for the random conversation generator. } Noun_List,Phrase_List,Adjective_List,RLI_List,Chat_Msg_List,Threat_List: SAttPtr; Trait_Chatter: Array [1..Num_Personality_Traits,1..2] of SAttPtr; +{$IFDEF PATCH_I18N} + I18N_GenderTraits_M1, I18N_GenderTraits_F1 : SAttPtr; + I18N_Firstperson_M, I18N_Firstperson_F: SAttPtr; + I18N_Secondperson_M, I18N_Secondperson_F: SAttPtr; + I18N_Modifier_List: SAttPtr; +{$ENDIF PATCH_I18N} Function SeekFaction( Scene: GearPtr; ID: Integer ): GearPtr; @@ -143,13 +187,24 @@ Function SeekFaction( Scene: GearPtr; ID { Return NIL if no such faction is found. } var F: GearPtr; +{$IFDEF PATCH_GH} + FR: GearPtr; +{$ENDIF PATCH_GH} begin { Error check. } if ( Scene = Nil ) or ( ID = 0 ) then Exit( Nil ); { Find the root of SCENE, which should be the ADVENTURE. } { The faction should be located along the invcoms. } +{$IFDEF PATCH_GH} + FR := FindRoot( Scene ); + if (NIL = FR) then begin + Exit(NIL); + end; + F := FR^.InvCom; +{$ELSE PATCH_GH} F := FindRoot( Scene )^.InvCom; +{$ENDIF PATCH_GH} while ( F <> Nil ) and (( F^.G <> GG_Faction ) or ( F^.S <> ID )) do F := F^.Next; { If the faction was not in the normal place, call the } @@ -164,6 +219,9 @@ Function GetFactionID( Part: GearPtr ): { FOr a faction this will be it's "S" descriptor. } { For anything else, faction affiliation is stored as a NAtt. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} if Part^.G = GG_Faction then begin GetFactionID := Part^.S; end else begin @@ -175,6 +233,9 @@ Function FactionIsInactive( Fac: GearPtr { Return TRUE if this faction has an INACTIVE tag in its } { TYPE string attribute, or FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = Fac) or (Fac^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} FactionIsInactive := AStringHasBString( SATtValue( Fac^.SA , 'TYPE' ) , 'INACTIVE' ); end; @@ -189,6 +250,10 @@ var t,N: Integer; EDesc: String; begin +{$IFDEF PATCH_GH} + if (NIL = Plot) or (Plot^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + N := 0; Code := UpCase( Code ); @@ -211,6 +276,10 @@ Function FindMetaPersona( Source: GearPt var T,Meta: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Source) or (Source^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + T := Source^.SubCom; Meta := Nil; while T <> Nil do begin @@ -224,11 +293,62 @@ Function SeekPlotAlongPath( Part: GearPt { Seek a gear which uses the specified element along the given } { path. If no such plot is found return Nil. Recursively search } { all active subcomponents. } +{$IFDEF DEBUG} +var + found: Integer; + + Function SeekPlotAlongPath_Sub( Part: GearPtr ): GearPtr; + var + it0, it1: GearPtr; + begin + it0 := NIL; + it1 := NIL; + while (NIL <> Part) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} + if ( Part^.G = SeekType ) and ( PlotElementID( Part , Code , ID ) <> 0 ) then begin + if NeedsPersona then begin + if FindMetaPersona( Part , PlotElementID( Part , Code , ID ) ) <> Nil then begin + it0 := Part; Inc(found); + end; + end else begin + it0 := Part; Inc(found); + end; + end else if ( Part^.G = GG_Story ) or ( Part^.G = GG_Faction ) then begin + it0 := SeekPlotAlongPath_Sub( Part^.InvCom ); + end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} + + Part := Part^.Next; + if (NIL = it1) then it1 := it0; + end; + SeekPlotAlongPath_Sub := it1; + end; +{$ENDIF DEBUG} + var it: GearPtr; -begin +{$IFDEF DEBUG} + NP_str: String; +{$ENDIF DEBUG} +begin +{$IFDEF DEBUG} + found := 0; + it := SeekPlotAlongPath_Sub( Part ); + if (1 < found) then begin + if NeedsPersona then NP_str := 'T' else NP_str := 'F'; + ErrorMessage_fork('ERROR: SeekPlotAlongPath( Code:' + Code + ', ID:' + IntToStr(ID) + ', SeekType:' + IntToStr(SeekType) + ', NP:' + NP_str + ' ) found:'+ IntToStr(found) + '.' ); + DialogMsg('ERROR: SeekPlotAlongPath( Code:' + Code + ', ID:' + IntToStr(ID) + ', SeekType:' + IntToStr(SeekType) + ', NP:' + NP_str + ' ) found:'+ IntToStr(found) + '.' ); + end; +{$ELSE DEBUG} it := Nil; while ( Part <> Nil ) and ( it = Nil ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G = SeekType ) and ( PlotElementID( Part , Code , ID ) <> 0 ) then begin if NeedsPersona then begin if FindMetaPersona( Part , PlotElementID( Part , Code , ID ) ) <> Nil then begin @@ -240,9 +360,13 @@ begin end else if ( Part^.G = GG_Story ) or ( Part^.G = GG_Faction ) then begin it := SeekPlotALongPath( Part^.InvCom , Code , ID , SeekType , NeedsPersona ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; +{$ENDIF DEBUG} SeekPlotAlongPath := it; end; @@ -280,6 +404,10 @@ var Desc: String; Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Plot) or (Plot^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + { Start by locating the element description string. } Desc := UpCase( SAttValue( Plot^.SA , 'ELEMENT' + BStr( N ) ) ); Adventure := FindRoot( Adventure ); @@ -324,7 +452,11 @@ var begin { Error check - Make sure both the plot and the game board are } { defined. } +{$IFDEF PATCH_GH} + if (NIL = Plot) or (Plot^.G <= GG_DisposeGear) or (NIL = GB) then begin +{$ELSE PATCH_GH} if ( Plot = Nil ) or ( GB = Nil ) then begin +{$ENDIF PATCH_GH} PlotUsedHere := False; end else begin { Assume FALSE, then look for any element that's being used } @@ -345,8 +477,16 @@ begin EH := SeekGearByCID( GB^.Meks , Plot^.Stat[T] ) <> Nil; end else if Desc[1] = 'S' then begin { Find a scene. } +{$IFDEF PATCH_GH} + if (NIL <> GB^.Scene) and (GG_DisposeGear < GB^.Scene^.G) then begin + EH := Plot^.Stat[ T ] = GB^.Scene^.S + end else begin + EH := False; + end; +{$ELSE PATCH_GH} if GB^.Scene <> Nil then EH := Plot^.Stat[ T ] = GB^.Scene^.S else EH := False; +{$ENDIF PATCH_GH} end else if Desc[1] = 'I' then begin { Find an item. } EH := SeekGearByIDTag( GB^.Meks , NAG_Narrative , NAS_NID , Plot^.Stat[ T ] ) <> Nil; @@ -420,6 +560,11 @@ var T,CS: Integer; NPC_Score,PC_Score: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Initialize the Compatability Score to 0. } CS := 0; @@ -496,6 +641,11 @@ var NPC_FID,PC_FID,it: Integer; FAC: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Step one - Locate the FACTION information of the NPC, and } { the PC's FACTION ID.. } NPC_FID := NAttValue( NPC^.NA , NAG_Personal , NAS_FactionID ); @@ -517,6 +667,18 @@ Function ReactionScore( Scene, PC, NPC: var it,Persona: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(0); + + it := NAttValue( PC^.NA, NAG_ReactionScore, Persona ); + if (it < MinReactionScore) then begin + SetNAtt( PC^.NA, NAG_ReactionScore, Persona, MinReactionScore ); + end else if (MaxReactionScore < it) then begin + SetNAtt( PC^.NA, NAG_ReactionScore, Persona, MaxReactionScore ); + end; +{$ENDIF PATCH_GH} + { The basic Reaction Score is equal to GENERAL COMPATABILITY + the } { existing reaction modifier. } Persona := NAttValue( NPC^.NA , NAG_Personal , NAS_CID ); @@ -538,13 +700,21 @@ begin ReactionScore := it; end; +{$IFDEF PATCH_I18N} +Function BlowOff( NPC: GearPtr ): String; +{$ELSE PATCH_I18N} Function BlowOff: String; +{$ENDIF PATCH_I18N} { The NPC will just say something mostly useless to the PC. } begin { At some point in time I will make a lovely procedure that will } { create all sorts of useless chatter. Right now, I'll just return } { the following constant string. } +{$IFDEF PATCH_I18N} + BlowOff := FormatChatStringByGender( I18N_MsgString('INTERACT_BLOWOFF'), NPC ); +{$ELSE PATCH_I18N} BlowOff := 'I really don''t have much time to chat today, I have a lot of things to do.'; +{$ENDIF PATCH_I18N} end; function MadLibString( SList: SAttPtr ): String; @@ -557,12 +727,128 @@ begin else MadLibString := '***ERROR***'; end; +{$IFDEF PATCH_I18N} +Function PersonalizeGenderTraits( kind: Char; NPC: GearPtr ): String; + { returns gender based string of specified kind. } +var + gender,mv,R,t,v: Integer; + S: String; + ret: String; +begin + ret := ''; + {$IFDEF PATCH_GH} + if (NIL <> NPC) and (GG_DisposeGear < NPC^.G) then begin + {$ELSE PATCH_GH} + if ( NPC <> Nil ) then begin + {$ENDIF PATCH_GH} + gender := NAttValue( NPC^.NA , NAG_CharDescription , NAS_Gender ); + mv := 0; + R := 1; + for t := 1 to Num_Personality_Traits do begin + V := NAttValue( NPC^.NA , NAG_CHarDescription , -T ); + if (T <> 6) and (abs(mv) < abs(V)) then begin + mv := V; + R := T + end; + end; + V := NAttValue( NPC^.NA , NAG_CHarDescription , -6 ); + if (V < 0) and (abs(mv) < abs(V)) then begin + mv := V; + R := 6; + end; + + if Sgn(mv) = 1 then S := 'PGT' + BStr(R) + '+' + else S := 'PGT' + BStr(R) + '-'; + V := NAttValue( NPC^.NA , NAG_CHarDescription , NAS_DAge ); + if V > 19 then S := S + 'O' + else if V < -3 then S := S + 'Y'; + + end else begin + gender := -1; + end; + + if ( kind = 'G' ) then begin + if ( gender = NAV_Male ) then ret := SAttValue( I18N_GenderTraits_M1 , S ) + else if ( gender = NAV_Female ) then ret := SAttValue( I18N_GenderTraits_F1 , S ) + else ret := ''; + end else if ( kind = 'F' ) then begin + if ( gender = NAV_Male ) then ret := SAttValue( I18N_Firstperson_M , S ) + else if ( gender = NAV_Female ) then ret := SAttValue( I18N_Firstperson_F , S ) + else ret := I18N_MsgString('PersonalizeGenderTraits_Default','I'); + end else if ( kind = 'S' ) then begin + if ( gender = NAV_Male ) then ret := SAttValue( I18N_Secondperson_M , S ) + else if ( gender = NAV_Female ) then ret := SAttValue( I18N_Secondperson_F ,S ) + else ret := I18N_MsgString('PersonalizeGenderTraits_Default','You'); + end else if ( kind = 'A' ) then begin + if ( Random( 10 ) < 5 ) then ret := MadLibString( I18N_Modifier_List ) + else ret := MadLibString( Adjective_List ); + end; + + PersonalizeGenderTraits := ret; +end; +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_I18N} +Function FormatChatStringByGender( Msg1: String; NPC: GearPtr ): String; + { Do formatting on this string, adding nouns, adjectives, } + { and threats as needed. } + { Add some gender based changes to the string, if needed. } +{$ELSE PATCH_I18N} Function FormatChatString( Msg1: String ): String; { Do formatting on this string, adding nouns, adjectives, } { and threats as needed. } +{$ENDIF PATCH_I18N} var +{$IFDEF PATCH_I18N} + msg2: String; + MaxLen, P, len, checkP: Integer; +{$ELSE PATCH_I18N} msg2,w: String; +{$ENDIF PATCH_I18N} begin +{$IFDEF PATCH_I18N} + { In KANJI string, it is no mean to find English-style words, } + { because it usually does not use white space to separate words. } + + msg2 := ''; + MaxLen := Length( msg1 ); + P := 1; + checkP := 1; + + while ( P <= MaxLen ) do begin + if ( ( msg1[ P ] = '%' ) and ( P + 1 <= MaxLen ) ) then begin + if ( ( UpCase( msg1[ P + 1 ] ) = 'J' ) and ( P + 2 <= MaxLen ) ) then begin + msg2 := msg2 + Copy( msg1, checkP, P - checkP ) + PersonalizeGenderTraits( msg1[ P + 2 ], NPC ); + P := P + 2; + checkP := P + 1; + end else if ( UpCase( msg1[ P + 1 ] ) = 'N' ) then begin + msg2 := msg2 + Copy( msg1, checkP, P - checkP ) + MadLibString( Noun_List ); + Inc(P); + checkP := P + 1; + end else if ( UpCase( msg1[ P + 1 ] ) = 'A' ) then begin + msg2 := msg2 + Copy( msg1, checkP, P - checkP ) + MadLibString( Adjective_List ); + Inc(P); + checkP := P + 1; + end else if ( UpCase( msg1[ P + 1 ] ) = 'T' ) then begin + msg2 := msg2 + Copy( msg1, checkP, P - checkP ) + FormatChatStringByGender( MadLibString( Threat_List ) , NPC ); + Inc(P); + checkP := P + 1; + end; + end; + + len := LengthMBChar( msg1[P] ); + if len < 1 then + len := 1; + P := P + len; + end; + + if ( P > checkP ) then begin + msg2 := msg2 + Copy( msg1, checkP, P - checkP ); + end; + + DeleteWhiteSpace( Msg2 ); + FormatChatStringByGender := Msg2; +{$ELSE PATCH_I18N} msg2 := ''; while msg1 <> '' do begin @@ -587,9 +873,14 @@ begin DeleteWhiteSpace( Msg2 ); FormatChatString := Msg2; +{$ENDIF PATCH_I18N} end; +{$IFDEF PATCH_I18N} +Function IdleChatter( NPC: GearPtr ): String; +{$ELSE PATCH_I18N} Function IdleChatter: String; +{$ENDIF PATCH_I18N} { Create a Mad-Libs style line for the NPC to tell the PC. } { Hopefully, these mad-libs will simulate the cheerfully nonsensical } { things that poorly tanslated anime characters often say to } @@ -605,7 +896,12 @@ begin { nouns and adjectives along the way. } msg1 := MadLibString( Phrase_List ); +{$IFDEF PATCH_I18N} + { add some gender based changes to the message, if exists. } + IdleChatter := FormatChatStringByGender( msg1, NPC ); +{$ELSE PATCH_I18N} IdleChatter := FormatChatString( Msg1 ); +{$ENDIF PATCH_I18N} end; Function DoTraitChatter( NPC: GearPtr; Trait: Integer ): String; @@ -617,10 +913,54 @@ const var Rk,Pro: Integer; msg: String; -begin +{$IFDEF PATCH_I18N} + msg_lead, msg_lhe, msg_tc: String; +{$ENDIF PATCH_I18N} +begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + { To start with, find the trait rank. } Rk := NAttValue( NPC^.NA , NAG_CharDescription , -Trait ); +{$IFDEF PATCH_I18N} + { Insert a basic starting phrase in the message, or perhaps none } + { at all... } + if Random( 10 ) <> 1 then begin + msg_lead := SAttValue( Chat_Msg_List , 'TRAITCHAT_Lead' + BStr( Random( Num_Openings ) + 1 ) ); + end else begin + msg_lead := #$0; + end; + + if Abs( Rk ) > 10 then begin + { Determine which side of the trait the NPC is in favor of. } + if Rk > 0 then Pro := 1 + else Pro := 2; + + { The NPC will either say that they like something from their own side, } + { or that they dislike something from the other. } + if Random( 5 ) <> 1 then begin + { Like something. } + msg_lhe := SAttValue( Chat_Msg_List , 'TRAITCHAT_Like' + BStr( Random( Num_Phrase_Bases ) + 1 ) ); + msg_tc := MadLibString( Trait_Chatter[ Trait , Pro ] ); + + end else begin + { Dislike something. } + msg_lhe := SAttValue( Chat_Msg_List , 'TRAITCHAT_Hate' + BStr( Random( Num_Phrase_Bases ) + 1 ) ); + msg_tc := MadLibString( Trait_Chatter[ Trait , 3 - Pro ] ); + + end; + end else begin + Pro := Random( 2 ) + 1; + msg_lhe := SAttValue( Chat_Msg_List , 'TRAITCHAT_Ehhh' + BStr( Random( Num_Phrase_Bases ) + 1 ) ); + msg_tc := MadLibString( Trait_Chatter[ Trait , Pro ] ); + + end; + + { add some gender based changes to the message if exists. } + msg := FormatChatStringByGender( ReplaceHash( I18N_MsgString('DoTraitChatter_Sentence_Pattern'), msg_lead, msg_lhe, msg_tc ), NPC ); +{$ELSE PATCH_I18N} { Insert a basic starting phrase in the message, or perhaps none } { at all... } if Random( 10 ) <> 1 then begin @@ -650,6 +990,7 @@ begin msg := msg + SAttValue( Chat_Msg_List , 'TRAITCHAT_Ehhh' + BStr( Random( Num_Phrase_Bases ) + 1 ) ) + ' ' + MadLibString( Trait_Chatter[ Trait , Pro ] ) + '.'; end; +{$ENDIF PATCH_I18N} DoTraitChatter := Msg; end; @@ -669,7 +1010,16 @@ var begin if P <> NPC then begin Rumor := SAttValue( P^.SA , 'RUMOR' ); - if Rumor <> '' then StoreSAtt( InfoList , MadLibString( RLI_List ) + ' ' + Rumor ); + if Rumor <> '' then + {$IFDEF PATCH_I18N} + StoreSAtt( InfoList , FormatChatStringByGender( + ReplaceHash( I18N_MsgString('CreateRumorList_ExtractData_Series'), + MadLibString(RLI_List), + Rumor ), + NPC ) ); + {$ELSE PATCH_I18N} + StoreSAtt( InfoList , MadLibString( RLI_List ) + ' ' + Rumor ); + {$ENDIF PATCH_I18N} if P^.G = GG_Character then begin { At most one personality trait per NPC will be added } @@ -679,9 +1029,26 @@ var Level := NAttValue( P^.NA , NAG_CharDescription , -Trait ); if Level <> 0 then begin if P = PC then begin + {$IFDEF PATCH_I18N} + StoreSAtt( InfoList , FormatChatStringByGender( + ReplaceHash( I18N_MsgString('CREATERUMORLIST_YOUARE1'), + PersonalityTraitDesc( Trait, Level, True ), + MadLibString( RLI_List ) ), + NPC ) ); + {$ELSE PATCH_I18N} StoreSAtt( InfoList , MadLibString( RLI_List ) + ' you are ' + LowerCase( PersonalityTraitDesc( Trait,Level ) ) + '.' ); + {$ENDIF PATCH_I18N} end else begin + {$IFDEF PATCH_I18N} + StoreSAtt( InfoList , FormatChatStringByGender( + ReplaceHash( I18N_MsgString('CREATERUMORLIST_YOUARE2'), + GearName( P ), + PersonalityTraitDesc( Trait, Level, True ), + MadLibString( RLI_List ) ), + NPC ) ); + {$ELSE PATCH_I18N} StoreSAtt( InfoList , MadLibString( RLI_List ) + ' ' + GearName( P ) + ' is ' + LowerCase( PersonalityTraitDesc( Trait,Level ) ) + '.' ); + {$ENDIF PATCH_I18N} end; end; @@ -692,8 +1059,16 @@ var { Include a rumor based on what faction controls this scene. } Persona := SeekFaction( GB^.Scene , NAttValue( Part^.NA , NAG_Personal , NAS_FactionID ) ); if Persona <> Nil then begin + {$IFDEF PATCH_I18N} + Rumor := FormatChatStringByGender( + ReplaceHash( I18N_MsgString('CREATERUMORLIST_RUMOR_TownFac'), + GearName( Persona ), + MadLibString( RLI_List ) ), + NPC ); + {$ELSE PATCH_I18N} Rumor := MadLibString( RLI_List ) + ' '; Rumor := Rumor + SAttValue( Chat_Msg_List , 'RUMOR_TownFac1' ) + GearName( Persona ) + SAttValue( Chat_Msg_List , 'RUMOR_TownFac2' ); + {$ENDIF PATCH_I18N} StoreSAtt( InfoList , Rumor ); end; @@ -701,12 +1076,29 @@ var { If the faction is active, tell about its traits. } { Otherwise, tell that it has been disbanded. } if AStringHasBString( SAttValue( P^.SA , 'TYPE' ) , 'INACTIVE' ) then begin + {$IFDEF PATCH_I18N} + StoreSAtt( InfoList , FormatChatStringByGender( + ReplaceHash( I18N_MsgString('FACTION_IS_INACTIVE'), + GearName( P ), + MadLibString( RLI_List ) ), + NPC ) ); + {$ELSE PATCH_I18N} StoreSAtt( InfoList , MadLibString( RLI_List ) + ' ' + GearName( P ) + SAttValue( chat_msg_list , 'FACTION_IS_INACTIVE' ) ); + {$ENDIF PATCH_I18N} end else begin Trait := Random( Num_Personality_Traits ) + 1; Level := NAttValue( P^.NA , NAG_CharDescription , -Trait ); if Level <> 0 then begin + {$IFDEF PATCH_I18N} + StoreSAtt( InfoList , FormatChatStringByGender( + ReplaceHash( I18N_MsgString('CREATERUMORLIST_YOUARE3'), + GearName( P ), + PersonalityTraitDesc( Trait, Level, True ), + MadLibString( RLI_List ) ), + NPC ) ); + {$ELSE PATCH_I18N} StoreSAtt( InfoList , MadLibString( RLI_List ) + ' ' + GearName( P ) + ' is ' + LowerCase( PersonalityTraitDesc( Trait,Level ) ) + '.' ); + {$ENDIF PATCH_I18N} end; end; @@ -717,8 +1109,16 @@ var { if appropriate. } Persona := SeekFaction( GB^.Scene , NAttValue( NPC^.NA , NAG_Personal , NAS_FactionID ) ); if Persona <> Nil then begin + {$IFDEF PATCH_I18N} + Rumor := FormatChatStringByGender( + ReplaceHash( I18N_MsgString('CreateRumorList_RUMOR_Membership'), + GearName( Persona ), + SAttValue( Chat_Msg_List, 'TRAITCHAT_Lead' + BStr( Random( Num_Openings ) + 1 ) ) ), + NPC ); + {$ELSE PATCH_I18N} Rumor := SAttValue( Chat_Msg_List , 'TRAITCHAT_Lead' + BStr( Random( Num_Openings ) + 1 ) ) + ' '; Rumor := Rumor + SAttValue( Chat_Msg_List , 'RUMOR_Membership1' ) + GearName( Persona ) + SAttValue( Chat_Msg_List , 'RUMOR_Membership2' ); + {$ENDIF PATCH_I18N} StoreSAtt( InfoList , Rumor ); end; end; @@ -728,17 +1128,28 @@ var { procedure as needed. } begin while P <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < P^.G) then begin +{$ENDIF PATCH_GH} if P^.G = GG_Plot then begin if PlotUsedHere( P , GB ) then ExtractData( P ); end else if ( P^.G = GG_Story ) or ( P^.G = GG_Faction ) then begin ExtractData( P ); CheckTrackForRumors( P^.InvCom ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} P := P^.Next; end; end; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then PC := NIL; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then NPC := NIL; +{$ENDIF PATCH_GH} + { Initialize INFOLIST to Nil. String Attributes will be used to store } { all the possible bits of information that might be given to the PC. } InfoList := Nil; @@ -746,25 +1157,53 @@ begin { Check all objects on the map for RUMOR SAtts. } Part := GB^.Meks; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} ExtractData( Part ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; { If this gameboard has a SCENE gear defined, check both the scene } { and all of its level one children for runors. } +{$IFDEF PATCH_GH} + if (NIL <> GB^.Scene) and (GG_DisposeGear < GB^.Scene^.G) then begin +{$ELSE PATCH_GH} if GB^.Scene <> Nil then begin +{$ENDIF PATCH_GH} Part := GB^.Scene; +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} ExtractData( Part ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := GB^.Scene^.SubCom; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} ExtractData( Part ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; Part := GB^.Scene^.InvCom; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} ExtractData( Part ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; @@ -785,6 +1224,11 @@ function InOpposition( PC , NPC: GearPtr var T1,T2: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + T1 := NAttValue( PC^.NA , NAG_CharDescription , -Trait ); T2 := NAttValue( NPC^.NA , NAG_CharDescription , -Trait ); @@ -805,6 +1249,11 @@ function InHarmony( PC , NPC: GearPtr; T var T1,T2: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + T1 := NAttValue( PC^.NA , NAG_CharDescription , -Trait ); T2 := NAttValue( NPC^.NA , NAG_CharDescription , -Trait ); @@ -825,6 +1274,10 @@ Function IsSexy( PC, NPC: GearPtr ): Boo { universe we'll describe that as being if their genders } { aren't equal to each other. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} IsSexy := ( NAttValue( PC^.NA , NAG_CharDescription , NAS_Gender ) <> NAttValue( NPC^.NA , NAG_CharDescription , NAS_Gender ) ) or HasTalent( PC , NAS_Bishounen ); end; @@ -844,7 +1297,11 @@ begin Skill_To_Improve := 19; if IsSexy( PC , NPC ) and ( Random( 3 ) = 1 ) then Skill_To_Improve := 27; if DoleSkillExperience( PC , Skill_To_Improve , XPA_GoodChat ) then begin +{$IFDEF PATCH_I18N} + msg := FormatChatStringByGender( SAttValue( Chat_Msg_List , 'CHAT_Skill' + BStr( Skill_To_Improve ) + '_' + BStr( Random( Num_Improve_Msg ) + 1 ) ), NPC ); +{$ELSE PATCH_I18N} msg := SAttValue( Chat_Msg_List , 'CHAT_Skill' + BStr( Skill_To_Improve ) + '_' + BStr( Random( Num_Improve_Msg ) + 1 ) ); +{$ENDIF PATCH_I18N} end else begin msg := ''; end; @@ -899,10 +1356,19 @@ var msg := DoTraitChatter( NPC , Trait ); end else begin { Regular Chatter. } + {$IFDEF PATCH_I18N} + msg := IdleChatter( NPC ); + {$ELSE PATCH_I18N} msg := IdleChatter; + {$ENDIF PATCH_I18N} end; end; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(''); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + { Start by making a social interaction roll for the PC. } SkRoll := RollStep( SkillValue( PC , 19 ) ); @@ -934,7 +1400,11 @@ begin { Finally, decide what the result of all this die rolling will be. } { First see what useful (or useless) information the NPC will share. } if ( SkRoll + ReactionScore( GB^.Scene , PC , NPC ) + Random(10) - Random(10) ) < 0 then begin +{$IFDEF PATCH_I18N} + msg := BlowOff( NPC ); +{$ELSE PATCH_I18N} msg := BlowOff; +{$ENDIF PATCH_I18N} { Since the NPC is trying to get rid of the PC, } { decrement ENDURANCE one more time. } @@ -944,6 +1414,9 @@ begin RTemp := SelectRandomSAtt( Rumors ); msg := RTemp^.info; RemoveSAtt( Rumors, RTemp ); +{$IFDEF PATCH_GH} + PurgeSAtt( Rumors ); +{$ENDIF PATCH_GH} Dec( FreeRumors ); end else if ( SkRoll + ( ReactionScore( GB^.Scene , PC , NPC ) div 10 ) ) < 10 then begin @@ -954,6 +1427,9 @@ begin RTemp := SelectRandomSAtt( Rumors ); msg := RTemp^.info; RemoveSAtt( Rumors, RTemp ); +{$IFDEF PATCH_GH} + PurgeSAtt( Rumors ); +{$ENDIF PATCH_GH} end else begin SelectChatter; end; @@ -1048,26 +1524,149 @@ begin SeekGearByCID := SeekGearByIDTag( LList , NAG_Personal , NAS_CID , CID ); end; +{$IFDEF DEBUG} +Procedure Check_MaxIDTag( const Msg: String; const LList: GearPtr; const G,S: Integer ); + Procedure CheckNA( const LList: GearPtr ); + begin + if (G = LList^.G) then begin + if (S <= LList^.S) then begin + ErrorMessage_fork('ERROR: Max' + Msg + '(GP) is illigal. G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', S:' + IntToStr(LList^.S) + '.' ); + DialogMsg('ERROR: Max' + Msg + '(GP) is illigal. G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', S:' + IntToStr(LList^.S) + '.'); + end; + end; + end; + + Procedure CheckNA( const LList: NAttPtr ); + var + NAP: NAttPtr; + begin + NAP := LList; + while NIL <> NAP do begin + if (G = NAP^.G) then begin + if (S <= NAP^.S) then begin + ErrorMessage_fork('ERROR: Max' + Msg + '(NA) is illigal. G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', S:' + IntToStr(NAP^.S) + '.' ); + DialogMsg('ERROR: Max' + Msg + '(NA) is illigal. G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', S:' + IntToStr(NAP^.S) + '.'); + end; + end; + NAP := NAP^.Next; + end; + end; + + Procedure CheckAlongPath( const LList: GearPtr ); + var + GP: GearPtr; + begin + GP := LList; + while NIL <> GP do begin + { Check, however GP^.G have GG_DisposeGear or not. } + CheckNA( GP ); + CheckNA( GP^.NA ); + CheckAlongPath( GP^.SubCom ); + CheckAlongPath( GP^.InvCom ); + GP := GP^.Next; + end; + end; + +var + GP: GearPtr; +begin + GP := FindRoot( LList ); + CheckAlongPath( GP ); +end; + +Procedure Check_MaxIDTag( const Msg: String; const LList: GearPtr; const G,S,V: Integer ); + Procedure CheckNA( const LList: GearPtr ); + begin + if (G = LList^.G) and (S = LList^.S) then begin + if (V <= LList^.V) then begin + ErrorMessage_fork('ERROR: Max' + Msg + '(GP) is illigal. G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', V:' + IntToStr(V) + ', V:' + IntToStr(LList^.V) + '.' ); + DialogMsg('ERROR: Max' + Msg + '(GP) is illigal. G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', V:' + IntToStr(V) + ', V:' + IntToStr(LList^.V) + '.'); + end; + end; + end; + + Procedure CheckNA( const LList: NAttPtr ); + var + NAP: NAttPtr; + begin + NAP := LList; + while NIL <> NAP do begin + if (G = NAP^.G) and (S = NAP^.S) then begin + if (V <= NAP^.V) then begin + ErrorMessage_fork('ERROR: Max' + Msg + '(NA) is illigal. G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', V:' + IntToStr(V) + ', V:' + IntToStr(NAP^.V) + '.' ); + DialogMsg('ERROR: Max' + Msg + '(NA) is illigal. G:' + IntToStr(G) + ', S:' + IntToStr(S) + ', V:' + IntToStr(V) + ', V:' + IntToStr(NAP^.V) + '.'); + end; + end; + NAP := NAP^.Next; + end; + end; + + Procedure CheckAlongPath( const LList: GearPtr ); + var + GP: GearPtr; + begin + GP := LList; + while NIL <> GP do begin + { Check, however GP^.G have GG_DisposeGear or not. } + CheckNA( GP ); + CheckNA( GP^.NA ); + CheckAlongPath( GP^.SubCom ); + CheckAlongPath( GP^.InvCom ); + GP := GP^.Next; + end; + end; +var + GP: GearPtr; +begin + GP := FindRoot( LList ); + CheckAlongPath( GP ); +end; +{$ENDIF DEBUG} + Function NewCID( GB: GameBoardPtr; Adventure: GearPtr ): LongInt; { Determine a new, unique CID for a character being added to the } { campaign. To make sure our CID is unique, we'll be making it one } { point higher than the highest CID we can find. } var it,it2: LongInt; +{$IFDEF DEBUG} + it1, it0, it3: LongInt; +{$ENDIF DEBUG} + Procedure CheckAlongPath( LList: GearPtr ); begin while LList <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < LList^.G) then begin +{$ENDIF PATCH_GH} if ( LList^.G = GG_Persona ) and ( LList^.S > it ) then it := LList^.S; CheckAlongPath( LList^.SubCom ); CheckAlongPath( LList^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} LList := LList^.Next; end; end; begin +{$IFDEF PATCH_GH} + if (NIL = Adventure) then begin + ErrorMessage('ERROR: NewCID(): Adventure is NIL.'); + Exit(0); + end; + if (Adventure^.G <= GG_DisposeGear) then begin + ErrorMessage('ERROR: NewCID(): Adventure is GG_DisposeGear.'); + end; +{$ENDIF PATCH_GH} + { To start with, find the highest ID being used by a character. } it := NAttValue( Adventure^.NA , NAG_Narrative , NAS_MaxCID ); if it = 0 then begin - IT := MaxIDTag( Adventure , NAG_Personal , NAS_CID ); + it := MaxIDTag( Adventure , NAG_Personal , NAS_CID ); +{$IFDEF DEBUG} + it1 := it; + it2 := 0; +{$ENDIF DEBUG} if GB <> Nil then begin it2 := MaxIDTag( GB^.Meks , NAG_Personal , NAS_CID ); if it2 > it then it := it2; @@ -1075,9 +1674,30 @@ begin { Next, search all the PERSONA gears to make sure none of them } { have one higher. } +{$IFDEF DEBUG} + it0 := it; + it := 0; +{$ENDIF DEBUG} CheckAlongPath( Adventure ); +{$IFDEF DEBUG} + it3 := it; + if it < it0 then it := it0; + ErrorMessage_fork('NewCID: "0 7 3 ?" not found. "0 5 0 ?" search, IT1:' + IntToStr(it1) + ', IT2:' + IntToStr(it2) + ', "0 -5 ?" search, IT3:' + IntToStr(it3) + ', IT:' + IntToStr(it) + '.' ); + end else begin + ErrorMessage_fork('NewCID: "0 7 3 ' + IntToStr(it) + '".' ); +{$ENDIF DEBUG} end; +{$IFDEF DEBUG} + if DEBUG_MaxCID then begin + Check_MaxIDTag( 'CID(S)', GB^.Scene, NAG_Personal, NAS_CID, it + 1 ); + Check_MaxIDTag( 'CID(M)', GB^.Meks, NAG_Personal, NAS_CID, it + 1 ); + Check_MaxIDTag( 'CID(A)', Adventure, NAG_Personal, NAS_CID, it + 1 ); + Check_MaxIDTag( 'CID(S)', GB^.Scene, GG_Persona, it + 1 ); + Check_MaxIDTag( 'CID(M)', GB^.Meks, GG_Persona, it + 1 ); + Check_MaxIDTag( 'CID(A)', Adventure, GG_Persona, it + 1 ); + end; +{$ENDIF DEBUG} { Return the highest value found, +1. } SetNAtt( Adventure^.NA , NAG_Narrative , NAS_MaxCID , it + 1 ); NewCID := it + 1; @@ -1089,17 +1709,46 @@ Function NewNID( GB: GameBoardPtr; Adven { point higher than the highest NID we can find. } var it,it2: LongInt; -begin +{$IFDEF DEBUG} + it1: LongInt; +{$ENDIF DEBUG} +begin +{$IFDEF PATCH_GH} + if (NIL = Adventure) then begin + ErrorMessage('ERROR: NewNID(): Adventure is NIL.'); + Exit(0); + end; + if (Adventure^.G <= GG_DisposeGear) then begin + ErrorMessage('ERROR: NewNID(): Adventure is GG_DisposeGear.'); + end; +{$ENDIF PATCH_GH} + { To start with, find the highest ID being used by a character. } it := NAttValue( Adventure^.NA , NAG_Narrative , NAS_MaxNID ); if it = 0 then begin - IT := MaxIDTag( Adventure , NAG_Narrative , NAS_NID ); + it := MaxIDTag( Adventure , NAG_Narrative , NAS_NID ); +{$IFDEF DEBUG} + it1 := it; + it2 := 0; +{$ENDIF DEBUG} if GB <> Nil then begin it2 := MaxIDTag( GB^.Meks , NAG_Narrative , NAS_NID ); if it2 > it then it := it2; end; +{$IFDEF DEBUG} + ErrorMessage_fork('NewNID: "0 7 4 ?" not found. "0 7 0 ?" search, IT1:' + IntToStr(it1) + ', IT2:' + IntToStr(it2) + ', IT:' + IntToStr(it) + '.' ); + end else begin + ErrorMessage_fork('NewNID: "0 7 4 ' + IntToStr(it) + '".' ); +{$ENDIF DEBUG} end; +{$IFDEF DEBUG} + if DEBUG_MaxNID then begin + Check_MaxIDTag( 'NID(S)', GB^.Scene, NAG_Narrative, NAS_NID, it + 1 ); + Check_MaxIDTag( 'NID(M)', GB^.Meks, NAG_Narrative, NAS_NID, it + 1 ); + Check_MaxIDTag( 'NID(A)', Adventure, NAG_Narrative, NAS_NID, it + 1 ); + end; +{$ENDIF DEBUG} { Return the highest value found, +1. } SetNAtt( Adventure^.NA , NAG_Narrative , NAS_MaxNID , it + 1 ); NewNID := it + 1; @@ -1137,6 +1786,10 @@ var it: Boolean; PCF,NPCF: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + it := NATtValue( NPC^.NA , NAG_Relationship , 0 ) = NAV_ArchEnemy; { If this character is not an intrinsic enemy of the PC, maybe } @@ -1161,6 +1814,10 @@ var it: Boolean; PCF,NPCF: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + it := NATtValue( NPC^.NA , NAG_Relationship , 0 ) = NAV_ArchAlly; { If this character is not an intrinsic ally of the PC, maybe } @@ -1180,6 +1837,11 @@ Function XNPCDesc( Adv,NPC: GearPtr ): S var it: String; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + + { PATCH_I18N: Don't translate it. } it := NPCTraitDesc( NPC ); if IsArchEnemy( Adv, NPC ) then it := it + ' ARCHENEMY'; @@ -1286,6 +1948,11 @@ var greeting,msg1,cmd: String; N1,N2: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(NIL); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + { Create the gear for the hook. } Hook := NewGear( Nil ); Hook^.G := GG_Persona; @@ -1321,29 +1988,52 @@ begin if cmd = '+PCRA' then begin { Player can run away. Enemy will give player } { the option to leave. } +{$IFDEF PATCH_I18N} + msg1 := msg1 + ' ' + FormatChatStringByGender( SAttValue( Chat_Msg_List , 'EHOOK_PCRA_' + BStr( Random( 5 ) + 1 ) ) , NPC); + greeting := greeting + ' AddChat 2'; + SetSAtt( Hook^.SA , 'prompt2 <' + FormatChatStringByGender( SAttValue( Chat_Msg_List , 'EHOOK_P_2_' + BStr( Random( 5 ) + 1 ) ) , PC) + '>' ); + SetSAtt( Hook^.SA , 'result2 <' + SAttValue( Chat_Msg_List , 'EHOOK_R_2' ) + '>' ); + SetSAtt( Hook^.SA , 'msg3 <' + FormatChatStringByGender( SAttValue( Chat_Msg_List , 'EHOOK_Msg3_' + BStr( Random( 5 ) + 1 ) ) , NPC) + '>' ); +{$ELSE PATCH_I18N} msg1 := msg1 + ' ' + FormatChatString( SAttValue( Chat_Msg_List , 'EHOOK_PCRA_' + BStr( Random( 5 ) + 1 ) ) ); greeting := greeting + ' AddChat 2'; SetSAtt( Hook^.SA , 'prompt2 <' + FormatChatString( SAttValue( Chat_Msg_List , 'EHOOK_P_2_' + BStr( Random( 5 ) + 1 ) ) ) + '>' ); SetSAtt( Hook^.SA , 'result2 <' + SAttValue( Chat_Msg_List , 'EHOOK_R_2' ) + '>' ); SetSAtt( Hook^.SA , 'msg3 <' + FormatChatString( SAttValue( Chat_Msg_List , 'EHOOK_Msg3_' + BStr( Random( 5 ) + 1 ) ) ) + '>' ); +{$ENDIF PATCH_I18N} end else if cmd = '+ECRA' then begin { Enemy can run away. Player will have } { the option to threaten the NPC. } +{$IFDEF PATCH_I18N} + greeting := greeting + ' AddChat 3'; + SetSAtt( Hook^.SA , 'prompt3 <' + FormatChatStringByGender( SAttValue( Chat_Msg_List , 'EHOOK_P_3_' + BStr( Random( 5 ) + 1 ) ) , PC ) + '>' ); + SetSAtt( Hook^.SA , 'result3 <' + FormatChatStringByGender( SAttValue( Chat_Msg_List , 'EHOOK_R_3' ) , PC ) + '>' ); + SetSAtt( Hook^.SA , 'msg4 <' + FormatChatStringByGender( SAttValue( Chat_Msg_List , 'EHOOK_Msg4_' + BStr( Random( 5 ) + 1 ) ) , PC) + '>' ); + SetSAtt( Hook^.SA , 'msg5 <' + FormatChatStringByGender( SAttValue( Chat_Msg_List , 'EHOOK_Msg5' ) , NPC ) + '>' ); +{$ELSE PATCH_I18N} greeting := greeting + ' AddChat 3'; SetSAtt( Hook^.SA , 'prompt3 <' + FormatChatString( SAttValue( Chat_Msg_List , 'EHOOK_P_3_' + BStr( Random( 5 ) + 1 ) ) ) + '>' ); SetSAtt( Hook^.SA , 'result3 <' + SAttValue( Chat_Msg_List , 'EHOOK_R_3' ) + '>' ); SetSAtt( Hook^.SA , 'msg4 <' + FormatChatString( SAttValue( Chat_Msg_List , 'EHOOK_Msg4_' + BStr( Random( 5 ) + 1 ) ) ) + '>' ); SetSAtt( Hook^.SA , 'msg5 <' + FormatChatString( SAttValue( Chat_Msg_List , 'EHOOK_Msg5' ) ) + '>' ); +{$ENDIF PATCH_I18N} end; end; SetSAtt( Hook^.SA , 'greeting <' + greeting + '>' ); +{$IFDEF PATCH_I18N} + SetSAtt( Hook^.SA , 'msg1 <' + FormatChatStringByGender( msg1 , NPC ) + '>' ); + SetSAtt( Hook^.SA , 'msg2 <' + FormatChatStringByGender( SAttValue( Chat_Msg_List , 'EHOOK_Msg2_' + BStr( Random( 5 ) + 1 ) ) , PC) + '>' ); + SetSAtt( Hook^.SA , 'prompt1 <' + FormatChatStringByGender( SAttValue( Chat_Msg_List , 'EHOOK_P_1_' + BStr( Random( 5 ) + 1 ) ) , PC) + '>' ); + SetSAtt( Hook^.SA , 'result1 <' + SAttValue( Chat_Msg_List , 'EHook_R_1' ) + '>' ); +{$ELSE PATCH_I18N} SetSAtt( Hook^.SA , 'msg1 <' + FormatChatString( msg1 ) + '>' ); SetSAtt( Hook^.SA , 'msg2 <' + FormatChatString( SAttValue( Chat_Msg_List , 'EHOOK_Msg2_' + BStr( Random( 5 ) + 1 ) ) ) + '>' ); SetSAtt( Hook^.SA , 'prompt1 <' + FormatChatString( SAttValue( Chat_Msg_List , 'EHOOK_P_1_' + BStr( Random( 5 ) + 1 ) ) ) + '>' ); SetSAtt( Hook^.SA , 'result1 <' + SAttValue( Chat_Msg_List , 'EHook_R_1' ) + '>' ); +{$ENDIF PATCH_I18N} GenerateEnemyHook := Hook; end; @@ -1354,6 +2044,10 @@ Function GenerateAllyHook( Scene,PC,NPC: var Hook: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + { Create the gear for the hook. } Hook := NewGear( Nil ); Hook^.G := GG_Persona; @@ -1362,9 +2056,15 @@ begin SetSAtt( Hook^.SA , 'greeting <' + SAttValue( chat_msg_list , 'AHOOK_Greeting' ) + '>' ); SetSAtt( Hook^.SA , 'result1 <' + SAttValue( chat_msg_list , 'AHOOK_R_1' ) + '>' ); +{$IFDEF PATCH_I18N} + SetSAtt( Hook^.SA , 'Msg1 <' + FormatChatStringByGender( SAttValue( chat_msg_list , 'AHOOK_MSG1_' + BStr( Random( 3 ) + 1 ) ) , NPC ) + '>' ); + SetSAtt( Hook^.SA , 'Msg2 <' + FormatChatStringByGender( SAttValue( chat_msg_list , 'AHOOK_MSG2_' + BStr( Random( 3 ) + 1 ) ) , NPC ) + '>' ); + SetSAtt( Hook^.SA , 'Prompt1 <' + FormatChatStringByGender( SAttValue( chat_msg_list , 'AHOOK_P_1_' + BStr( Random( 5 ) + 1 ) ) , NPC ) + '>' ); +{$ELSE PATCH_I18N} SetSAtt( Hook^.SA , 'Msg1 <' + FormatChatString( SAttValue( chat_msg_list , 'AHOOK_MSG1_' + BStr( Random( 3 ) + 1 ) ) ) + '>' ); SetSAtt( Hook^.SA , 'Msg2 <' + FormatChatString( SAttValue( chat_msg_list , 'AHOOK_MSG2_' + BStr( Random( 3 ) + 1 ) ) ) + '>' ); SetSAtt( Hook^.SA , 'Prompt1 <' + FormatChatString( SAttValue( chat_msg_list , 'AHOOK_P_1_' + BStr( Random( 5 ) + 1 ) ) ) + '>' ); +{$ENDIF PATCH_I18N} GenerateAllyHook := Hook; end; @@ -1381,6 +2081,9 @@ begin M := GB^.Meks; N := 0; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) and GearActive( M ) then begin if ( M^.G = GG_Mecha ) or ( NAttValue( M^.NA , NAG_Personal , NAS_CID ) <> 0 ) then begin N := N + 2; @@ -1388,6 +2091,9 @@ begin N := N + 1; end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; LancematesPresent := N; @@ -1401,6 +2107,7 @@ Function FindNPCByKeyWord( GB: GameBoard desc: String; Persona: GearPtr; begin + { PATCH_I18N: Don't translate it. } desc := SAttValue( NPC^.SA , 'JOB' ); Persona := SeekPersona( GB , NAttValue( NPC^.NA , NAG_Personal , NAS_CID ) ); if Persona <> Nil then desc := desc + SAttValue( Persona^.SA , 'KEYWORDS' ); @@ -1441,22 +2148,52 @@ begin FindNPCByKeyWord := M; end; -initialization + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: interact.pp'); +{$ENDIF DEBUG} Noun_List := LoadStringList( Standard_Nouns_File ); Phrase_List := LoadStringList( Standard_Phrases_File ); Adjective_List := LoadStringList( Standard_Adjectives_File ); RLI_List := LoadStringList( Standard_Rumors_File ); Threat_List := LoadStringList( Standard_Threats_File ); Chat_Msg_List := LoadStringList( Standard_Chatter_File ); +{$IFDEF PATCH_I18N} + I18N_GenderTraits_M1 := LoadStringList( I18N_NPC_GenderTraits_File1 ); + I18N_GenderTraits_F1 := LoadStringList( I18N_NPC_GenderTraits_File2 ); + I18N_Firstperson_M := LoadStringList( I18N_NPC_FirstPerson_File1 ); + I18N_Firstperson_F := LoadStringList( I18N_NPC_FirstPerson_File2 ); + I18N_Secondperson_M := LoadStringList( I18N_NPC_SecondPerson_File1 ); + I18N_Secondperson_F := LoadStringList( I18N_NPC_SecondPerson_File2 ); + I18N_Modifier_List := LoadStringList( I18N_Standard_Modifier_File ); +{$ENDIF PATCH_I18N} LoadTraitChatter; +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: interact.pp(finalization)'); +{$ENDIF DEBUG} DisposeSAtt( Noun_List ); DisposeSAtt( Phrase_List ); DisposeSAtt( Adjective_List ); DisposeSAtt( RLI_List ); DisposeSAtt( Threat_List ); DisposeSAtt( Chat_Msg_List ); +{$IFDEF PATCH_I18N} + DisposeSAtt( I18N_GenderTraits_M1 ); + DisposeSAtt( I18N_GenderTraits_F1 ); + DisposeSAtt( I18N_Firstperson_M ); + DisposeSAtt( I18N_Firstperson_F ); + DisposeSAtt( I18N_Secondperson_M ); + DisposeSAtt( I18N_Secondperson_F ); + DisposeSAtt( I18N_Modifier_List ); +{$ENDIF PATCH_I18N} FreeTraitChatter; +end; + end. diff -x .svn -uprN GearHead1100repository.original/libiconv.pp branches/libiconv.pp --- GearHead1100repository.original/libiconv.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/libiconv.pp 2009-08-14 03:51:12.135805000 +0900 @@ -0,0 +1,108 @@ +unit libiconv; +{*******************************} +{ iconv wrapper } +{ Wed,27 Feb,2008 } +{*******************************} +{example: +uses unixtype,libiconv; +Function NewConvUni( const pmsg: PChar ): PWord; +const + WCLen = 512; +var + src_len, dst_len: size_t; + pdst: PChar; + psrc_tmp, pdst_tmp: PChar; + iconv_enc2utf16: iconv_t; + iconv_result: size_t; +begin + pdst := StrAlloc( WCLen ); + src_len := Length(pmsg); + dst_len := WCLen - 2; + psrc_tmp := pmsg; + pdst_tmp := pdst; + iconv_enc2tenc := libiconv.iconv_open( "EUCJP", "UTF-8" ); + iconv_result := libiconv.iconv( iconv_enc2utf16, + @psrc_tmp, @src_len, @pdst_tmp, @dst_len ); + iconv_result := libiconv.iconv( iconv_enc2utf16, + NIL, NIL, @pdst_tmp, @dst_len ); + pdst_tmp[0] := #0; pdst_tmp[1] := #0; + NewConvUni := PWord(pdst); + libiconv.iconv_close( iconv_enc2utf16 ); +end; +} +{*******************************} + +{$MODE FPC} + +interface + +{$IFDEF Windows} +uses windows, JwaWinType; +{$ENDIF Windows} +{$IFDEF UNIX} +uses pthreads, baseunix, unix, unixtype; +{$ENDIF UNIX} + + +type +{$IFDEF ICONV} +{{$IFDEF WIN32}} +{ Psize_t = ^size_t;} +{ size_t = LongWord;} +{{$ENDIF WIN32}} +{{$IFDEF WIN64}} +{ Psize_t = ^size_t;} +{ size_t = QWord;} +{{$ENDIF WIN64}} + Piconv_t = ^iconv_t; + iconv_t = pointer; +{$ENDIF ICONV} + + +const +{$IFDEF ICONV} + {$IFDEF UNIX} + {$IFDEF LIBC_ICONV} + libiconvname='c'; + {$DEFINE _LIBICONVNAME_} + {$ELSE LIBC_ICONV} + libiconvname='iconv'; + {$DEFINE _LIBICONVNAME_} + {$ENDIF LIBC_ICONV} + {$ENDIF UNIX} + {$IFDEF Windows} + libiconvname='iconv.dll'; + {$DEFINE _LIBICONVNAME_} + {$ENDIF Windows} + {$IFNDEF _LIBICONVNAME_} + libiconvname='iconv'; + {$ENDIF _LIBICONVNAME_} + {$IFDEF LIBICONV_PLUG} + libiconv_functionname_iconv_open = 'iconv_open'; + libiconv_functionname_iconv = 'iconv'; + libiconv_functionname_iconv_close = 'iconv_close'; + {$ELSE LIBICONV_PLUG} + libiconv_functionname_iconv_open = 'libiconv_open'; + libiconv_functionname_iconv = 'libiconv'; + libiconv_functionname_iconv_close = 'libiconv_close'; + {$ENDIF LIBICONV_PLUG} +{$ENDIF ICONV} + + + +{$IFDEF ICONV} +function iconv_open( __tocode: Pchar; __fromcode: Pchar ): iconv_t; +cdecl; external libiconvname name libiconv_functionname_iconv_open; + +function iconv( __cd: iconv_t; __inbuf: PPchar; __inbytesleft: Psize_t; __outbuf: PPchar; __outbytesleft: Psize_t ): size_t; +cdecl; external libiconvname name libiconv_functionname_iconv; + +function iconv_close( __cd: iconv_t ): longint; +cdecl; external libiconvname name libiconv_functionname_iconv_close; +{$ENDIF ICONV} + + + +implementation + +end. diff -x .svn -uprN GearHead1100repository.original/locale.pp branches/locale.pp --- GearHead1100repository.original/locale.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/locale.pp 2015-06-14 09:08:00.000000000 +0900 @@ -26,7 +26,11 @@ unit locale; interface -uses gears,movement; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,movement; Type TerrDesc = Record @@ -125,6 +129,7 @@ Const DefaultScale = 2; {The default map scale. 2 = Mecha Scale} + { PATCH_I18N: Don't translate here, use GameData/I18N_messages.txt. } NumTerr = 42; TerrMan: Array [1..NumTerr] of TerrDesc = ( ( name: 'Open Ground'; @@ -449,6 +454,11 @@ Const AngDir: Array [0..7 , 1..2] of SmallInt = ( (1,0),(1,1),(0,1),(-1,1),(-1,0),(-1,-1),(0,-1),(1,-1) ); +{$IFDEF PATCH_GH} + DirKeyAngDir: Array [0..8 , 1..2] of SmallInt = ( + (1,0),(1,1),(0,1),(-1,1),(-1,0),(-1,-1),(0,-1),(1,-1),(0,0) + ); +{$ENDIF PATCH_GH} LOCALE_CollectTriggers: Boolean = True; @@ -500,6 +510,16 @@ Const MapFeatureMaxHeight = 15; MapFeatureMinDimension = 5; +{$IFDEF PATCH_GH} +{ Moved from arenaplay.pp } + { Sets trigger NUMBEROFUNITS } + TRIGGER_InitStartGame = 'Init_Start'; + TRIGGER_StartGame = 'Start'; + TRIGGER_EntermapStartGame = 'EnterMap_Start'; + TRIGGER_RestoreStartGame = 'Restore_Start'; + TRIGGER_EndGame = 'END'; +{$ENDIF PATCH_GH} + { TIME CONSTANTS } AP_Minute = 60; AP_3Minutes = 180; @@ -524,6 +544,13 @@ Const PC_Team_X: Integer = 0; PC_Team_Y: Integer = 0; +{$IFDEF PATCH_GH} + LP_MustBeBlocker = 2; + LP_MustBeMaster = 1; + LP_MustNotBeMaster = -1; + LP_MustBeUsable = -2; +{$ENDIF PATCH_GH} + type Point = Record @@ -566,6 +593,16 @@ type end; CampaignPtr = ^Campaign; +{$IFDEF PATCH_GH} + LPattern = Record { Location Pattern } + X,Y,Z: Integer; { Tile to search } + { Set Z outside normal range -5...+5 to exclude it as a search parameter } + Trigger: String; { USed when searching for triggerable props. } + Only_Visibles: Boolean; { Only search for visible gears? } + Only_Masters: Integer; { Only search for master gears? } + end; +{$ENDIF PATCH_GH} + Function CreateFrozenLocation(var LList: FrozenLocationPtr): FrozenLocationPtr; @@ -574,8 +611,13 @@ Function SolveLine(X1,Y1,Z1,X2,Y2,Z2,N: function NewMap: GameBoardPtr; function NewCampaign: CampaignPtr; +{$IFDEF PATCH_GH} +procedure DisposeMap(var GB_arg: GameBoardPtr); +procedure DisposeCampaign(var Camp_arg: CampaignPtr); +{$ELSE PATCH_GH} procedure DisposeMap(var gb: GameBoardPtr); procedure DisposeCampaign(var Camp: CampaignPtr); +{$ENDIF PATCH_GH} function GearCurrentLocation( Mek: GearPtr ): Point; @@ -591,6 +633,10 @@ Function AreAllies( GB: GameBoardPtr; M1 Procedure DeleteObsoleteTeams( GB: GameBoardPtr ); Function IsSafeArea( GB: GameBoardPtr ): Boolean; +{$IFDEF PATCH_GH} +Function TeamSkill( LList: GearPtr; Skill: Integer): Integer; +Function TeamHasSkill( LList: GearPtr; Skill: Integer): Boolean; +{$ENDIF PATCH_GH} Function TeamSkill( GB: GameBoardPtr; Team,Skill: Integer): Integer; Function TeamHasSkill( GB: GameBoardPtr; Team,Skill: Integer): Boolean; @@ -602,6 +648,10 @@ Function OnTheMap( Mek: GearPtr ): Boole function MekVisible( gb: GameBoardPtr; Mek: GearPtr ): Boolean; function MekAltitude( gb: GameBoardPtr; Mek: GearPtr ): Integer; +{$IFDEF PATCH_GH} +Function GearMatchesLPattern( GB: GameBoardPtr; Mek: GearPtr; var Match: LPattern ): Boolean; +{$ENDIF PATCH_GH} + Function NumGearsXY( GB: GameBoardPtr; X,Y: Integer ): Integer; Function FindGearXY( GB: GameBoardPtr; X,Y,N: Integer): GearPtr; Function NumVisibleGears( GB: GameBoardPtr; X,Y: Integer ): Integer; @@ -676,8 +726,29 @@ Function FindDeploymentSpot( GB: GameBoa implementation -uses ability,damage,gearutil,ghchars,ghprop,ghweapon,rpgdice,texutil; +uses +{$IFDEF PATCH_GH} + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_BACKPORT} + ui4gh, +{$ELSE PATCH_BACKPORT} +{$IFDEF DEBUG} + ui4gh, +{$ENDIF DEBUG} +{$ENDIF PATCH_BACKPORT} + ability,damage,gearutil,ghchars,ghprop,ghweapon,rpgdice,texutil; +{$IFDEF PATCH_GH} +Const +{$ELSE PATCH_GH} Type LPattern = Record { Location Pattern } X,Y,Z: Integer; { Tile to search } @@ -693,6 +764,7 @@ Const LP_MustNotBeMaster = -1; LP_MustBeUsable = -2; +{$ENDIF PATCH_GH} Stealth_Per_Scale = 4; LowShadow = -3; @@ -710,6 +782,9 @@ var begin {Allocate memory for our new element.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('CreateFrozenLocation() New',it); +{$ENDIF DEBUG} if it = Nil then exit; {Attach IT to the list.} @@ -720,13 +795,32 @@ begin CreateFrozenLocation := it; end; +{$IFDEF PATCH_GH} +Procedure DisposeFrozenLocation(var LList_arg: FrozenLocationPtr); +{$ELSE PATCH_GH} Procedure DisposeFrozenLocation(var LList: FrozenLocationPtr); +{$ENDIF PATCH_GH} {Dispose of the list, freeing all associated system resources.} var +{$IFDEF PATCH_GH} + LList: FrozenLocationPtr; +{$ENDIF PATCH_GH} LTemp: FrozenLocationPtr; begin +{$IFDEF PATCH_GH} + LList := LList_arg; + LList_arg := NIL; +{$ENDIF PATCH_GH} while LList <> Nil do begin LTemp := LList^.Next; +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeFrozenLocation() Dispose',LList); + CheckAndNIL_Pointer('DisposeFrozenLocation() Dispose',LList,True); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.Name[1] := '@'; + LList^.Next := Pointer(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(LList); LList := LTemp; end; @@ -753,18 +847,38 @@ begin if B = Nil then begin {Major FUBAR. The member we were trying to remove can't} {be found in the list.} +{$IFDEF PATCH_GH} + ErrorMessage_fork('ERROR- RemoveFrozenLocation asked to remove a link that doesnt exist.'); +{$ELSE PATCH_GH} writeln('ERROR- RemoveFrozenLocation asked to remove a link that doesnt exist.'); +{$ENDIF PATCH_GH} end else if A = Nil then begin {There's no element before the one we want to remove,} {i.e. it's the first one in the list.} LList := B^.Next; +{$IFDEF DEBUG} + Trace_MemoryLeak('RemoveFrozenLocation() Dispose',B); + CheckAndNIL_Pointer('RemoveFrozenLocation() Dispose',B,True); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH_PARANOID_SAFER} + B^.Name[1] := '@'; + B^.Next := Pointer(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(B); end else begin {We found the attribute we want to delete and have another} {one standing before it in line. Go to work.} A^.next := B^.next; +{$IFDEF DEBUG} + Trace_MemoryLeak('RemoveFrozenLocation() Dispose',B); + CheckAndNIL_Pointer('RemoveFrozenLocation() Dispose',B,True); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH_PARANOID_SAFER} + B^.Name[1] := '@'; + B^.Next := Pointer(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(B); end; end; @@ -864,6 +978,9 @@ var begin {Allocate the needed memory space.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('NewMap() New',it); +{$ENDIF DEBUG} if it <> Nil then begin it^.Scale := DefaultScale; @@ -891,6 +1008,9 @@ var begin {Allocate the needed memory space.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('NewCampaign() New',it); +{$ENDIF DEBUG} if it <> Nil then begin it^.ComTime := 0; @@ -901,27 +1021,79 @@ begin NewCampaign := it; end; +{$IFDEF PATCH_GH} +procedure DisposeMap(var GB_arg: GameBoardPtr); +{$ELSE PATCH_GH} procedure DisposeMap(var gb: GameBoardPtr); +{$ENDIF PATCH_GH} {Get rid of the GameBoard.} { NOTE: Any gears, triggers, or scenes still attached will be } { lost as well!!! } +{$IFDEF PATCH_GH} +var + GB: GameBoardPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + GB := GB_arg; +{$ENDIF PATCH_GH} { Error check } if GB = Nil then Exit; +{$IFDEF PATCH_GH} + GB_arg := NIL; +{$ENDIF PATCH_GH} DisposeGear( gb^.Meks ); DisposeGear( gb^.Scene ); DisposeSAtt( gb^.Trig ); +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeMap() Dispose',GB); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('DisposeMap() Dispose',GB,False); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + GB^.ComTime := -32767; + GB^.Scale := -32767; + GB^.ReturnCode := -32767; + GB^.Scene := GearPtr(-1); + GB^.Trig := SattPtr(-1); + GB^.Meks := GearPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(gb); GB := Nil; end; +{$IFDEF PATCH_GH} +procedure DisposeCampaign(var Camp_arg: CampaignPtr); +{$ELSE PATCH_GH} procedure DisposeCampaign(var Camp: CampaignPtr); +{$ENDIF PATCH_GH} {Get rid of the campaign.} +{$IFDEF PATCH_GH} +var + Camp: CampaignPtr; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + Camp := Camp_arg; + Camp_arg := NIL; +{$ENDIF PATCH_GH} DisposeGear( Camp^.Source ); DisposeMap( Camp^.GB ); DisposeFrozenLocation( Camp^.Maps ); +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeCampaign() Dispose',Camp); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('DisposeCampaign() Dispose',Camp,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + Camp^.ComTime := -32767; + Camp^.GB := GameBoardPtr(-1); + Camp^.Maps := FrozenLocationPtr(-1); + Camp^.Source := GearPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(Camp); Camp := Nil; end; @@ -936,6 +1108,13 @@ var begin { Make sure first that we're dealing with a root-level gear. } Mek := FindRoot( Mek ); +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then begin + P.X := -1; + P.Y := -1; + Exit(P); + end; +{$ENDIF PATCH_GH} { Locate its X and Y coordinates. } P.X := NAttValue( Mek^.NA , NAG_Location , NAS_X ); @@ -950,7 +1129,11 @@ var TG,SE: GearPtr; begin TG := Nil; +{$IFDEF PATCH_GH} + if (NIL <> Scene) and (GG_DisposeGear < Scene^.G) then begin +{$ELSE PATCH_GH} if Scene <> Nil then begin +{$ENDIF PATCH_GH} SE := Scene^.SubCom; while SE <> Nil do begin if (SE^.G = GG_Team) and (SE^.S = TEAM) then TG := SE; @@ -1027,6 +1210,10 @@ Function AreEnemies( GB: GameBoardPtr; M var Team1,Team2: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = M1) or (M1^.G <= GG_DisposeGear) then Exit(False); + if (NIL = M2) or (M2^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} Team1 := NAttValue( M1^.NA , NAG_Location , NAS_Team ); Team2 := NAttValue( M2^.NA , NAG_Location , NAS_Team ); AreEnemies := AreEnemies( GB , Team1 , Team2 ); @@ -1084,6 +1271,10 @@ Function AreAllies( GB: GameBoardPtr; M1 var Team1,Team2: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = M1) or (M1^.G <= GG_DisposeGear) then Exit(False); + if (NIL = M2) or (M2^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} Team1 := NAttValue( M1^.NA , NAG_Location , NAS_Team ); Team2 := NAttValue( M2^.NA , NAG_Location , NAS_Team ); AreAllies := AreAllies( GB , Team1 , Team2 ); @@ -1094,6 +1285,10 @@ Procedure ForgetTeam( Scene: GearPtr; Te var Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Scene) or (Scene^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + Part := Scene^.SubCOm; while Part <> Nil do begin @@ -1154,10 +1349,16 @@ begin if it then begin M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if IsMasterGear( M ) and GearOperational( M ) and OnTheMap( M ) then begin T := NAttValue( M^.NA , NAG_Location , NAS_TEam ); if AreEnemies( GB , T , NAV_DefPlayerTeam ) then it := False; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -1167,6 +1368,58 @@ begin IsSafeArea := it; end; +{$IFDEF PATCH_GH} +Function TeamSkill( LList: GearPtr; Skill: Integer): Integer; + { Return the maximum skill value from the team. } +var + M: GearPtr; + MSkill, BigSkill, TSkill: Integer; +begin + { Check through every mek on the board. } + M := LList; + BigSkill := 0; + TSkill := 0; + while (NIL <> M) do begin + if (GG_DisposeGear < M^.G) then begin + if IsMasterGear( M ) then begin + MSkill := SkillValue( M, Skill ); + if MSkill > BigSkill then BigSkill := MSkill; + if MSkill >= 5 then TSkill := TSkill + ( MSkill div 5 ); + end; + end; + M := M^.Next; + end; + TeamSkill := BigSkill + TSkill - ( BigSkill div 5 ); +end; + +Function TeamHasSkill( LList: GearPtr; Skill: Integer): Boolean; + { Return TRUE if at least one member of the team has the requested skill. } +var + M,P: GearPtr; + Found: Boolean; + T2: Integer; +begin + { Check through every mek on the board. } + M := LList; + Found := False; + while (NIL <> M) do begin + if (GG_DisposeGear < M^.G) then begin + { Lancemates count as part of the PC team for skill purposes. } + if IsMasterGear( M ) and GearActive( M ) then begin + P := LocatePilot( M ); + if (P <> NIL) and (GG_DisposeGear < P^.G) then begin + if NAttValue( P^.NA , NAG_Skill , Skill ) > 0 then begin + Found := True; + end; + end; + end; + end; + M := M^.Next; + end; + TeamHasSkill := Found; +end; +{$ENDIF PATCH_GH} + Function TeamSkill( GB: GameBoardPtr; Team,Skill: Integer): Integer; { Return the maximum skill value from the team. } var @@ -1178,6 +1431,9 @@ begin BigSkill := 0; TSkill := 0; while m <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} { Lancemates count as part of the PC team for skill purposes. } T2 := NAttValue( M^.NA , NAG_Location , NAS_Team ); if T2 = NAV_LancemateTeam then T2 := NAV_DefPlayerTeam; @@ -1188,6 +1444,9 @@ begin if MSkill >= 5 then TSkill := TSkill + ( MSkill div 5 ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} m := m^.Next; end; TeamSkill := BigSkill + TSkill - ( BigSkill div 5 ); @@ -1200,19 +1459,35 @@ var Found: Boolean; T2: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = GB) then Exit(False); +{$ENDIF PATCH_GH} + { Check through every mek on the board. } M := GB^.Meks; Found := False; while m <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} { Lancemates count as part of the PC team for skill purposes. } T2 := NAttValue( M^.NA , NAG_Location , NAS_Team ); if T2 = NAV_LancemateTeam then T2 := NAV_DefPlayerTeam; if T2 = Team then begin if IsMasterGear( M ) and GearActive( M ) then begin P := LocatePilot( M ); +{$IFDEF PATCH_GH} + if (P <> NIL) and (GG_DisposeGear < P^.G) then begin +{$ENDIF PATCH_GH} if NAttValue( P^.NA , NAG_Skill , Skill ) > 0 then Found := True; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} m := m^.Next; end; TeamHasSkill := Found; @@ -1231,6 +1506,9 @@ var P: Point; begin it := False; +{$IFDEF PATCH_GH} + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} T2 := NAttValue( Target^.NA , NAG_Location , NAS_Team ); if AreAllies( GB , Team , T2 ) then begin @@ -1260,6 +1538,10 @@ Function MekCanSeeTarget( GB: GameBoardP var Team: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} Team := NAttValue( Mek^.NA , NAG_Location , NAS_Team ); MekCanSeeTarget := TeamCanSeeTarget( gb , Team , Target ); end; @@ -1281,6 +1563,9 @@ var X,Y: Integer; begin { Error check - MEK must be defined in order for this to work. } +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if Mek = Nil then Exit( False ); { The location info is stored at root level... so if this gear } @@ -1298,6 +1583,9 @@ function MekVisible( GB: GameBoardPtr; M var P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if Mek^.G = GG_MetaTerrain then begin P := GearCurrentLocation( Mek ); if OnTheMap( P.X , P.Y ) then begin @@ -1318,6 +1606,10 @@ function MekAltitude( gb: GameBoardPtr; var X,Y,Z: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Mek^.Parent <> Nil then Mek := FindRoot( Mek ); { Find the location of the mek. } @@ -1345,6 +1637,10 @@ end; Function IsBlocker( Mek: GearPtr ): Boolean; { Return TRUE if MEK is a blocker, FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + if IsMasterGear( mek ) then begin IsBlocker := True; end else if Mek^.G = GG_MetaTerrain then begin @@ -1361,7 +1657,11 @@ var it: Boolean; P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if Mek = Nil then begin +{$ENDIF PATCH_GH} { An undefined mek can't be a match. } it := False; @@ -1421,7 +1721,13 @@ begin C := 0; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if GearMatchesLPattern( GB , M , Match ) then Inc(C); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -1445,10 +1751,16 @@ begin if N < 1 then N := 1; while ( M <> Nil ) and ( Count <> N ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if GearMatchesLPattern( GB , M , Match ) then begin Inc(Count); SM := M; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -1471,6 +1783,9 @@ begin { Loop through all of the meks on the map. } while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} { If this mek matches the description we've been given, } { decide what to do with it next. } if GearMatchesLPattern( GB , Mek , Match ) then begin @@ -1486,6 +1801,9 @@ begin end; end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; @@ -1672,6 +1990,9 @@ begin { Loop through all gears on the map, looking for metaterrain. } M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if ( M^.G = GG_MetaTerrain ) and NotDestroyed( M ) then begin X := NAttValue( M^.NA , NAG_Location , NAS_X ); Y := NAttValue( M^.NA , NAG_Location , NAS_Y ); @@ -1689,6 +2010,9 @@ begin end; end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -1764,7 +2088,11 @@ begin { it won't block LOS. Why? Because the PC should } { be able to see a wall, even though the wall tile } { itself if blocking terrain. } +{$IFDEF PATCH_GH} + Wall := Wall or not(T = N); +{$ELSE PATCH_GH} Wall := T <> N; +{$ENDIF PATCH_GH} end; end; @@ -1787,6 +2115,10 @@ Function CalcObscurement( M1: GearPtr; X var X1,Y1: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = M1) or (M1^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} + if M1^.Parent <> Nil then M1 := FindRoot( M1 ); if OnTheMap( M1 ) and OnTheMap( X2 , Y2 ) then begin @@ -1803,6 +2135,11 @@ Function CalcObscurement( M1 , M2: GearP var X1,Y1,X2,Y2: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = M1) or (M1^.G <= GG_DisposeGear) then Exit(-1); + if (NIL = M2) or (M2^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} + if M1^.Parent <> Nil then M1 := FindRoot( M1 ); if M2^.Parent <> Nil then M2 := FindRoot( M2 ); @@ -1883,6 +2220,9 @@ Function CheckArc( M1: GearPtr; X2,Y2,A: var X1,Y1: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = M1) or (M1^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} X1 := NAttValue( M1^.NA , NAG_Location , NAS_X ); Y1 := NAttValue( M1^.NA , NAG_Location , NAS_Y ); CheckArc := CheckArc( X1 , Y1 , X2 , Y2 , A ); @@ -1894,6 +2234,10 @@ Function CheckArc( M1,M2: GearPtr; A: In var X2,Y2,X1,Y1: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = M1) or (M1^.G <= GG_DisposeGear) then Exit(False); + if (NIL = M2) or (M2^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} X1 := NAttValue( M1^.NA , NAG_Location , NAS_X ); Y1 := NAttValue( M1^.NA , NAG_Location , NAS_Y ); X2 := NAttValue( M2^.NA , NAG_Location , NAS_X ); @@ -1914,6 +2258,9 @@ Function Range( M1: GearPtr; X2,Y2: Inte var X1,Y1: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = M1) or (M1^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} X1 := NAttValue( M1^.NA , NAG_Location , NAS_X ); Y1 := NAttValue( M1^.NA , NAG_Location , NAS_Y ); Range := Range( X1 , Y1 , X2 , Y2 ); @@ -1924,6 +2271,10 @@ Function Range( gb: GameBoardPtr; M1 , M var X1,Y1,Z1,X2,Y2,Z2: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = M1) or (M1^.G <= GG_DisposeGear) then Exit(-1); + if (NIL = M2) or (M2^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} X1 := NAttValue( M1^.NA , NAG_Location , NAS_X ); Y1 := NAttValue( M1^.NA , NAG_Location , NAS_Y ); Z1 := MekAltitude( gb , M1 ); @@ -1940,13 +2291,46 @@ function WeaponRange( GB: GameBoardPtr; var rng,t: Integer; WAO: GearPtr; -begin +{$IFDEF PATCH_BACKPORT} + Ammo: GearPtr; + CaliberFlag: Boolean; +{$ENDIF PATCH_BACKPORT} +begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if Weapon = Nil then begin +{$ENDIF PATCH_GH} rng := 0; end else if Weapon^.G = GG_Weapon then begin if ( Weapon^.S = GS_Ballistic ) or ( Weapon^.S = GS_BeamGun ) or ( Weapon^.S = GS_Missile ) then begin +{$IFDEF PATCH_BACKPORT} + CaliberFlag := False; + if Backport_Caliber then CaliberFlag := True + else if Backport_Caliber_GH1Compatible then begin + if 0 < Length(SAttValue(Weapon^.SA,SATT_Caliber)) then CaliberFlag := True; + {$IFDEF PATCH_I18N} + if 0 < Length(SAttValue(Weapon^.SA,SATT_CaliberOrg)) then CaliberFlag := True; + {$ENDIF PATCH_I18N} + end; + + rng := 0; + Ammo := LocateGoodAmmo( Weapon ); + + if CaliberFlag and (Weapon^.S = GS_Missile) then begin + if Ammo <> Nil then begin + rng := Ammo^.Stat[ STAT_Range ] + end; + if rng <= 0 then begin + rng := Weapon^.Stat[ STAT_Range ]; { fall back } + end; + end else begin + rng := Weapon^.Stat[ STAT_Range ]; + end; +{$ELSE PATCH_BACKPORT} rng := Weapon^.Stat[ STAT_Range ]; +{$ENDIF PATCH_BACKPORT} WAO := Weapon^.InvCom; while WAO <> Nil do begin if ( WAO^.G = GG_WeaponAddOn ) and NotDestroyed( WAO ) then begin @@ -1988,6 +2372,9 @@ function ThrowingRange( GB: GameBoardPtr var rng,t: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = User) or (User^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} rng := 0; if ( Weapon <> Nil ) and ( Weapon^.G = GG_Weapon ) then begin if HasAttackAttribute( WeaponATtackAttributes( Weapon ) , AA_THrown ) then begin @@ -2018,6 +2405,14 @@ var P: Point; Action , D: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then begin + P.X := -1; + P.Y := -1; + Exit(P); + end; +{$ENDIF PATCH_GH} + P := GearCurrentLocation( Mek ); Action := NAttValue( Mek^.NA , NAG_Action , NAS_MoveAction ); D := NAttValue( Mek^.NA , NAG_Location , NAS_D ); @@ -2040,6 +2435,10 @@ var MekAlt,MM: Integer; it: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Primary Criterion - if terrain is defined as an obstacle, and } { is of the same or lower elevation as the master gear under } { consideration, it's an obstacle. } @@ -2086,6 +2485,10 @@ var it: Boolean; M: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(True); +{$ENDIF PATCH_GH} + P := GearCurrentLocation( Mek ); { Locate the SPECIAL string for this scene, if one exists. } @@ -2133,6 +2536,9 @@ Function FrontBlocked( Mek: GearPtr; GB: var P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(True); +{$ENDIF PATCH_GH} { Determine the destination square. } P := GearCurrentLocation( Mek ); P.X := P.X + AngDir[ D , 1 ]; @@ -2147,6 +2553,10 @@ Function MoveBlocked( Mek: GearPtr; GB: var P: Point; { Destination point. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(True); +{$ENDIF PATCH_GH} + { Determine the destination square. } P := GearDestination( Mek ); @@ -2161,6 +2571,10 @@ var TerrMod,MM: Integer; MTerr: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(200); +{$ENDIF PATCH_GH} + P1 := GearCurrentLocation( Mek ); P2 := GearDestination( Mek ); TerrMod := 0; @@ -2235,6 +2649,10 @@ var Terrain,TerrMod, MM, D: Integer; MTerr: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + it := CPHMoveRate( Mek , GB^.Scale ); Action := NAttValue( Mek^.NA , NAG_Action , NAS_MoveAction ); TerrMod := 0; @@ -2266,6 +2684,10 @@ Function CalcRelativeSpeed( Mek: GearPtr var MoveMode,Action,Spd: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + MoveMode := NAttValue( Mek^.NA , NAG_Action , NAS_MoveMode ); Action := NAttValue( Mek^.NA , NAG_Action , NAS_MoveAction ); @@ -2296,6 +2718,9 @@ var begin if Shadow_Map_Update < GB^.ComTime then UpdateShadowMap( GB ); +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if Master <> Nil then begin { Movement information is stored at root level. } if Master^.Parent <> Nil then Master := FindRoot( Master ); @@ -2325,6 +2750,11 @@ var O,T,Roll: Integer; it: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = Observer) or (Observer^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Calculate the obscurement. } O := CalcObscurement( Observer , Target , gb ); @@ -2370,10 +2800,16 @@ begin { Loop through all the meks on the board. } while mek <> nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < mek^.G) then begin +{$ENDIF PATCH_GH} if GearActive( Mek ) and OnTheMap( Mek ) then begin T := NAttValue( mek^.NA , NAG_Location , NAS_Team ); if T = Team then Inc( mem ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} mek := mek^.next; end; @@ -2392,10 +2828,16 @@ begin { Loop through all the meks on the board. } while mek <> nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < mek^.G) then begin +{$ENDIF PATCH_GH} if GearOperational( Mek ) and OnTheMap( Mek ) then begin T := NAttValue( mek^.NA , NAG_Location , NAS_Team ); if T = Team then Inc( mem ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} mek := mek^.next; end; @@ -2405,6 +2847,11 @@ end; Procedure SetTrigger( GB: GameBoardPtr; const msg: String ); { Store the trigger. } begin +{$IFDEF DEBUG} + if DEBUG_TraceMacro then begin + ErrorMessage_fork( 'TRACE: SetTrigger() "' + msg + '"'); + end; +{$ENDIF DEBUG} { Only store it if collection has been set to TRUE. } if LOCALE_CollectTriggers then begin StoreSAtt( GB^.Trig , msg ); @@ -2417,11 +2864,18 @@ var TTemp,TBest: GearPtr; BestScore,Score: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + TTemp := GB^.Meks; TBest := Nil; BestScore := 9999; while TTemp <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < TTemp^.G) then begin +{$ENDIF PATCH_GH} { If this mek is an enemy of the spotter, and is visible, } { and is still functional, } { then it's a candidate to be the target picked. } @@ -2438,6 +2892,9 @@ begin TBest := TTemp; end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} TTemp := TTemp^.Next; end; @@ -2511,6 +2968,16 @@ var it: LongInt; T: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Scene) then begin + ErrorMessage('ERROR: NewTeamID(): Scene is NIL.'); + Exit(0); + end; + if (Scene^.G <= GG_DisposeGear) then begin + ErrorMessage('ERROR: NewTeamID(): Scene is GG_DisposeGear.'); + end; +{$ENDIF PATCH_GH} + { Check the models on the map... } it := MaxIDTag( Scene^.InvCom , NAG_Location , NAS_Team ); @@ -2531,9 +2998,15 @@ var begin Part := GB^.Meks; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( Part^.NA , NAG_Location , NAS_Team ) = T ) and IsMasterGear( Part ) then begin AddReputation( Part , R , V ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; @@ -2585,7 +3058,12 @@ Function BoardMecha( Mek,Pilot: GearPtr var CP: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) + or (NIL = Pilot) or (Pilot^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if ( Mek = Nil ) or ( Pilot = Nil ) then begin +{$ENDIF PATCH_GH} { If either mecha or pilot are undefined, this } { attempt will of course fail. } BoardMecha := False; @@ -2621,7 +3099,12 @@ Function ExtractPilot( Mek: GearPtr ): G var Pilot: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) + or (GG_Character = Mek^.G) then begin +{$ELSE PATCH_GH} if ( Mek = Nil ) or ( Mek^.G = GG_Character ) then begin +{$ENDIF PATCH_GH} { Can't extract a pilot from a character or an undefined gear. } ExtractPilot := Nil; @@ -2642,6 +3125,10 @@ var mek,pmek: GearPtr; name: String; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + { Begin by finding the PC's name. } name := PilotName( PC ); @@ -2670,6 +3157,12 @@ Procedure AssociatePilotMek( LList , Pil var dup: GearPtr; { Duplication checker. } begin +{$IFDEF PATCH_GH} + if (NIL = LList) or (LList^.G <= GG_DisposeGear) then Exit; + if (NIL = Pilot) or (Pilot^.G <= GG_DisposeGear) then Exit; + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { If the pilot already has a mek assigned, negate that association. } repeat dup := FindPilotsMecha( LList , Pilot ); @@ -2691,7 +3184,11 @@ var begin it := 0; +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} if Part = Nil then begin +{$ENDIF PATCH_GH} it := 0; end else begin @@ -2724,14 +3221,32 @@ Function FindActualScene( GB: GameBoardP { temporary scenes which may have the same value. } var Part,Scene: GearPtr; +{$IFDEF PATCH_GH} + FR: GearPtr; +{$ENDIF PATCH_GH} begin Scene := Nil; if ( GB <> Nil ) and ( GB^.Scene <> Nil ) then begin +{$IFDEF PATCH_GH} + FR := FindRoot( GB^.Scene ); + if NIL <> FR then begin + Part := FR^.SubCom; + while ( Part <> Nil ) do begin + if (GG_DisposeGear < Part^.G) then begin + if ( Part^.G = GG_Scene ) and ( Part^.S = SID ) then begin + Scene := Part; + end; + end; + Part := Part^.Next; + end; + end; +{$ELSE PATCH_GH} Part := FindRoot( GB^.Scene )^.SubCom; while ( Part <> Nil ) do begin if ( Part^.G = GG_Scene ) and ( Part^.S = SID ) then Scene := Part; Part := Part^.Next; end; +{$ENDIF PATCH_GH} end; FindActualScene := Scene; @@ -2980,6 +3495,14 @@ var TeamNum,Tries: Integer; P,TP: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then begin + P.X := -1; + P.Y := -1; + Exit(P); + end; +{$ENDIF PATCH_GH} + { Find the team for this model. } TeamNum := NAttValue( Mek^.NA , NAG_Location , NAS_Team ); @@ -3036,12 +3559,22 @@ begin SetNAtt( GB^.Scene^.NA , NAG_ParaLocation , NAS_Y , 0 ); end else if ( Home <> Nil ) and ( Tries > 250 ) then begin +{$IFDEF PATCH_GH} + P.X := Random( Home^.Stat[ Stat_MFWidth ] ) + Home^.Stat[ STAT_XPos ]; + P.Y := Random( Home^.Stat[ Stat_MFHeight ] ) + Home^.Stat[ STAT_YPos ]; +{$ELSE PATCH_GH} P.X := Random( Home^.Stat[ Stat_MFWidth ] - 2 ) + Home^.Stat[ STAT_XPos ] + 1; P.Y := Random( Home^.Stat[ Stat_MFHeight ] - 2 ) + Home^.Stat[ STAT_YPos ] + 1; +{$ENDIF PATCH_GH} end else if ( THome <> Nil ) and ( Tries > 250 ) then begin +{$IFDEF PATCH_GH} + P.X := Random( THome^.Stat[ Stat_MFWidth ] ) + THome^.Stat[ STAT_XPos ]; + P.Y := Random( THome^.Stat[ Stat_MFHeight ] ) + THome^.Stat[ STAT_YPos ]; +{$ELSE PATCH_GH} P.X := Random( THome^.Stat[ Stat_MFWidth ] - 2 ) + THome^.Stat[ STAT_XPos ] + 1; P.Y := Random( THome^.Stat[ Stat_MFHeight ] - 2 ) + THome^.Stat[ STAT_YPos ] + 1; +{$ENDIF PATCH_GH} end else if ( Team <> Nil ) and OnTheMap( TP.X , TP.Y ) and ( Tries > 250 ) then begin { Place somewhere near the deployment area. } @@ -3084,8 +3617,20 @@ begin end; + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: locale.pp'); +{$ENDIF DEBUG} Shadow_Map_Update := -1; +end; +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: locale.pp(finalization)'); +{$ENDIF DEBUG} +end; end. diff -x .svn -uprN GearHead1100repository.original/mapedit.pp branches/mapedit.pp --- GearHead1100repository.original/mapedit.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/mapedit.pp 2009-08-15 02:47:28.237904000 +0900 @@ -26,10 +26,22 @@ Procedure EditMap; implementation +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + gears_base, + gears, + ui4gh, + locale, +{$ELSE PATCH_GH} + gears,locale,ui4gh, +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} -uses gears,locale,ui4gh,congfx,sdlinfo,sdlmap,sdlmenus; + sdlgfx,sdlinfo,sdlmap,sdlmenus; {$ELSE} -uses gears,locale,ui4gh,congfx,coninfo,conmap,conmenus,context; + congfx,coninfo,conmap,conmenus,context; {$ENDIF} Procedure SaveMap( GB: GameBoardPtr ); @@ -39,7 +51,11 @@ var F: Text; X,Y: Integer; begin +{$IFDEF SDLMODE} + FName := GetStringFromUser( 'Enter filename - format "MAP_*.txt"', NIL ); +{$ELSE SDLMODE} FName := GetStringFromUser( 'Enter filename - format "MAP_*.txt"' ); +{$ENDIF SDLMODE} for X := 1 to XMax do begin for Y := 1 to YMax do begin GB^.Map[ X , Y ].Visible := False; @@ -69,7 +85,11 @@ var begin RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); BuildFileMenu( RPM , Series_Directory + '*MAP_*.txt' ); +{$IFDEF SDLMODE} + FName := SelectFile( RPM, NIL ); +{$ELSE SDLMODE} FName := SelectFile( RPM ); +{$ENDIF SDLMODE} DisposeRPGMenu( RPM ); if FName <> '' then begin Assign( F , Series_Directory + FName ); @@ -187,4 +207,20 @@ begin DisposeMap( GB ); end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: mapedit.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: mapedit.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/menugear.pp branches/menugear.pp --- GearHead1100repository.original/menugear.pp 2013-02-05 09:01:00.000000000 +0900 +++ branches/menugear.pp 2015-08-30 09:00:00.000000000 +0900 @@ -23,43 +23,142 @@ unit menugear; interface +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale, {$IFDEF SDLMODE} -uses gears,locale,sdlmenus; + sdlmenus {$ELSE} -uses gears,locale,conmenus; + conmenus {$ENDIF} + ; Procedure BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr; G: Integer ); +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} +Function BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr; DebugMode: Boolean ): LongInt; + {$ELSE DEBUG} +Procedure BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr; DebugMode: Boolean ); + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} +Function BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr ): LongInt; +{$ELSE DEBUG} Procedure BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr ); +{$ENDIF DEBUG} +{$IFDEF DEBUG} +Function BuildEquipmentMenu( RPM: RPGMenuPtr; Master: GearPtr ): LongInt; +{$ELSE DEBUG} Procedure BuildEquipmentMenu( RPM: RPGMenuPtr; Master: GearPtr ); +{$ENDIF DEBUG} +{$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} +Function BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr; const ShowSub: Boolean ): LongInt; + {$ELSE DEBUG} +Procedure BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr; const ShowSub: Boolean ); + {$ENDIF DEBUG} +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} +Function BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr ): LongInt; +{$ELSE DEBUG} Procedure BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr ); +{$ENDIF DEBUG} +{$IFDEF DEBUG} +Function BuildSlotMenu( RPM: RPGMenuPtr; Master,Item: GearPtr ): LongInt; +{$ELSE DEBUG} Procedure BuildSlotMenu( RPM: RPGMenuPtr; Master,Item: GearPtr ); +{$ENDIF DEBUG} +{$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} +Function BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean; const ShowSub: Boolean ): LongInt; + {$ELSE DEBUG} +Procedure BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean; const ShowSub: Boolean ); + {$ENDIF DEBUG} +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} +Function BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean ): LongInt; +{$ELSE DEBUG} Procedure BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean ); +{$ENDIF DEBUG} +{$IFDEF DEBUG} +Function LocateGearByNumber( Master: GearPtr; Num: LongInt; DebugMode: Boolean; MaxNum: LongInt; DebugMsg: String ): GearPtr; +{$ELSE DEBUG} + {$IFDEF PATCH_GH} +Function LocateGearByNumber( Master: GearPtr; Num: LongInt; DebugMode: Boolean ): GearPtr; +Function LocateGearByNumber( Master: GearPtr; Num: LongInt ): GearPtr; + {$ELSE PATCH_GH} Function LocateGearByNumber( Master: GearPtr; Num: Integer ): GearPtr; + {$ENDIF PATCH_GH} +{$ENDIF DEBUG} Function FindNextWeapon( GB: GameBoardPtr; Master,Weapon: GearPtr; MinRange: Integer ): GearPtr; +{$IFDEF PATCH_GH} +Function FindGearIndex( Master , FindThis: GearPtr ): LongInt; +{$ELSE PATCH_GH} Function FindGearIndex( Master , FindThis: GearPtr ): Integer; +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} +Function CountGearIndex( Master: GearPtr; DebugMode: Boolean; DebugMsg: String ): LongInt; +{$ENDIF DEBUG} Procedure AlphaKeyMenu( RPM: RPGMenuPtr ); implementation -uses damage,effects,gearutil,ghswag,ghweapon,texutil; +uses +{$IFDEF DEBUG} + sysutils, + errmsg, +{$ELSE DEBUG} + {$IFDEF PATCH_GH} + sysutils, + {$ENDIF PATCH_GH} +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + ui4gh, +{$ENDIF PATCH_CHEAT} + damage,effects,gearutil,ghswag,ghweapon,texutil +{$IFDEF DEBUG} + {$IFDEF SDLMODE} + ,sdlgfx + {$ELSE SDLMODE} + ,context + {$ENDIF SDLMODE} +{$ENDIF DEBUG} + ; Procedure BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr; G: Integer ); { Search through MASTER, adding to menu RPM any part which } { corresponds to descriptor G. Add each matching part to the } { menu, along with its locator number. } var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} { PROCEDURES BLOCK } Procedure CheckAlongPath( Part: GearPtr; AddToMenu: Boolean ); { CHeck along the path specified. } begin while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} Inc(N); + {$IFDEF DEBUG} + if ( Part^.G = G ) and AddToMenu then begin + AddRPGMenuItem( RPM , BStr(N) + ':' + GearName( Part ) , N ); + end; + {$ELSE DEBUG} if ( Part^.G = G ) and AddToMenu then AddRPGMenuItem( RPM , GearName( Part ) , N ); + {$ENDIF DEBUG} if Part^.G = GG_Cockpit then begin { Don't add parts beyond the cockpit barrier. } CheckAlongPath( Part^.InvCom , False ); @@ -68,24 +167,122 @@ var CheckAlongPath( Part^.InvCom , AddToMenu ); CheckAlongPath( Part^.SubCom , AddToMenu ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} N := 0; if Master^.G = G then AddRPGMenuItem( RPM , GearName( Master ) , 0 ); CheckAlongPath( Master^.InvCom , True ); CheckAlongPath( Master^.SubCom , True ); end; { BuildGearMenu } +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} +Function BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr ): LongInt; +begin + BuildGearMenu := BuildGearMenu( RPM, Master, False ); +end; + {$ELSE DEBUG} +Procedure BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr ); +begin + BuildGearMenu( RPM, Master, False ); +end; + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} +Function BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr; DebugMode: Boolean ): LongInt; + {$ELSE DEBUG} +Procedure BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr; DebugMode: Boolean ); + {$ENDIF DEBUG} +{$ELSE PATCH_GH} + {$IFDEF DEBUG} +Function BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr ): LongInt; + {$ELSE DEBUG} Procedure BuildGearMenu( RPM: RPGMenuPtr; Master: GearPtr ); + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} { Search through MASTER, adding to menu all parts. } const InvStr = '+'; SubStr = '>'; var +{$IFDEF PATCH_GH} + N: LongInt; + N_clean: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} { PROCEDURES BLOCK } +{$IFDEF PATCH_GH} + Function MakeGearName( Part: GearPtr; TabPos,Prefix: String ): String; + var + Msg: String; + begin + Msg := TabPos; + if DebugMode then begin + case Part^.G of + GG_AbsolutelyNothing: Msg := Msg + 'A'; + GG_DisposeGear: Msg := Msg + 'D'; + -32768: Msg := Msg + '*'; + else Msg := Msg + ' '; + end; + end; +{$IFDEF PATCH_CHEAT} + if Cheat_EqpMenu_ShowFullGearName then begin + MakeGearName := Msg + Prefix + FullGearName( Part, DebugMode ); + end else begin + MakeGearName := Msg + Prefix + GearName( Part, DebugMode ); + end; +{$ELSE PATCH_CHEAT} + MakeGearName := Msg + Prefix + GearName( Part, DebugMode ); +{$ENDIF PATCH_CHEAT} + end; + + Procedure CheckAlongPath( Part: GearPtr; TabPos,Prefix: String; WithNext: Boolean; Show: Boolean ); + { CHeck along the path specified. } + begin + while Part <> Nil do begin + if DebugMode or (GG_DisposeGear < Part^.G) then begin + if Show then begin + if DebugMode then begin + AddRPGMenuItem( RPM, BStr(N_clean) + ':' + BStr(N) + ':' + MakeGearName( Part, TabPos,Prefix ), N ); + end else if (GG_AbsolutelyNothing <> Part^.G) then begin + AddRPGMenuItem( RPM, MakeGearName( Part, TabPos,Prefix ), N ); + end; + end; + Inc(N); + if (GG_DisposeGear < Part^.G) then begin + Inc(N_clean); + end; +{$IFDEF PATCH_CHEAT} + if Cheat_EnableCockpitBarrier and ( GG_Cockpit = Part^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + CheckAlongPath( Part^.InvCom, TabPos + ' ', InvStr, True, Show ); + CheckAlongPath( Part^.SubCom, TabPos + ' ', SubStr, True, False ); + end else begin +{$ENDIF PATCH_CHEAT} + CheckAlongPath( Part^.InvCom, TabPos + ' ', InvStr, True, Show ); + CheckAlongPath( Part^.SubCom, TabPos + ' ', SubStr, True, Show ); +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} + end; + if not(WithNext) then begin + break; + end; + Part := Part^.Next; + end; + end;{CheckAlongPath} +{$ELSE PATCH_GH} Procedure CheckAlongPath( Part: GearPtr; TabPos,Prefix: String ); { CHeck along the path specified. } begin @@ -97,52 +294,213 @@ var Part := Part^.Next; end; end;{CheckAlongPath} +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + N := 0; + N_clean := 0; + CheckAlongPath( Master, '', '', DebugMode, True ); +{$ELSE PATCH_GH} N := 0; AddRPGMenuItem( RPM , GearName( Master ) , 0 ); CheckAlongPath( Master^.InvCom , ' ' , '+' ); CheckAlongPath( Master^.SubCom , ' ' , '>' ); +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + BuildGearMenu := (N - 1); +{$ENDIF DEBUG} end; { BuildGearMenu } +{$IFDEF DEBUG} +Function BuildEquipmentMenu( RPM: RPGMenuPtr; Master: GearPtr ): LongInt; +{$ELSE DEBUG} Procedure BuildEquipmentMenu( RPM: RPGMenuPtr; Master: GearPtr ); +{$ENDIF DEBUG} { Create a menu for this master's equipment. Equipment is defined as } { an InvCom of any part other than the master itself. } +{$IFDEF PATCH_CHEAT} +const + InvStr = '+'; + SubStr = '>'; +{$ENDIF PATCH_CHEAT} var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} Procedure CheckAlongPath( Part: GearPtr; IsInv: Boolean ); { CHeck along the path specified. } var msg: String; begin while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} Inc(N); if ( Part^.G <> GG_AbsolutelyNothing ) and IsInv then begin { Creating a message line for this equipment is made tricky by the } { fact that a pilot riding in a mecha has a separate inventory from } { the mecha itself. } if IsMasterGear( Part^.Parent ) then begin +{$IFDEF PATCH_CHEAT} + if Cheat_EqpMenu_ShowFullGearName then begin + msg := '[' + GearName( Part^.Parent ) + '] ' + FullGearName( Part ); + end else begin + msg := '[' + GearName( Part^.Parent ) + '] ' + GearName( Part ); + end; +{$ELSE PATCH_CHEAT} msg := '[' + GearName( Part^.Parent ) + '] ' + GearName( Part ); +{$ENDIF PATCH_CHEAT} end else begin +{$IFDEF PATCH_CHEAT} + if Cheat_EqpMenu_ShowFullGearName then begin + msg := FullGearName( Part ) + ' ['; + end else begin + msg := GearName( Part ) + ' ['; + end; +{$ELSE PATCH_CHEAT} msg := GearName( Part ) + ' ['; +{$ENDIF PATCH_CHEAT} if FindMaster(Part)^.Parent <> Nil then msg := msg + GearName( FindMaster( Part ) ) + ':'; msg := msg + GearName( Part^.Parent ) + ']'; end; +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM, msg, N, FormatDescString(Part) ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , msg , N , SAttValue( Part^.SA , 'DESC' ) ); +{$ENDIF PATCH_I18N} end; CheckAlongPath( Part^.InvCom , True ); CheckAlongPath( Part^.SubCom , False ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end;{CheckAlongPath} +{$IFDEF PATCH_CHEAT} + Procedure CheckAlongPath( Part: GearPtr; const IsInv,IsInvSub: Boolean; const TabPos,Prefix: String; Show: Boolean ); + var + msg: String; + begin + while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} + Inc(N); + if ( Part^.G <> GG_AbsolutelyNothing ) and Show then begin + if IsInv then begin + if IsMasterGear( Part^.Parent ) then begin +{$IFDEF PATCH_CHEAT} + if Cheat_EqpMenu_ShowFullGearName then begin + msg := '[' + GearName( Part^.Parent ) + '] ' + FullGearName( Part ); + end else begin + msg := '[' + GearName( Part^.Parent ) + '] ' + GearName( Part ); + end; +{$ELSE PATCH_CHEAT} + msg := '[' + GearName( Part^.Parent ) + '] ' + GearName( Part ); +{$ENDIF PATCH_CHEAT} + end else begin +{$IFDEF PATCH_CHEAT} + if Cheat_EqpMenu_ShowFullGearName then begin + msg := FullGearName( Part ) + ' ['; + end else begin + msg := GearName( Part ) + ' ['; + end; +{$ELSE PATCH_CHEAT} + msg := GearName( Part ) + ' ['; +{$ENDIF PATCH_CHEAT} + if FindMaster(Part)^.Parent <> Nil then msg := msg + GearName( FindMaster( Part ) ) + ':'; + msg := msg + GearName( Part^.Parent ) + ']'; + end; +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM, msg, N, FormatDescString(Part) ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( RPM , msg , N , SAttValue( Part^.SA , 'DESC' ) ); +{$ENDIF PATCH_I18N} + end else if IsInvSub then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM, TabPos + Prefix + GearName(Part), N, FormatDescString(Part) ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( RPM, TabPos + Prefix + GearName(Part), N, SAttValue(Part^.SA , 'DESC') ); +{$ENDIF PATCH_I18N} + end; + end; +{$IFDEF PATCH_CHEAT} + if Cheat_EnableCockpitBarrier and ( GG_Cockpit = Part^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + CheckAlongPath( Part^.InvCom, True, True, '', InvStr, Show ); + CheckAlongPath( Part^.SubCom, False,IsInvSub, TabPos + ' ', SubStr, False ); + end else begin +{$ENDIF PATCH_CHEAT} + CheckAlongPath( Part^.InvCom, True, True, '', InvStr, Show ); + CheckAlongPath( Part^.SubCom, False,IsInvSub, TabPos + ' ', SubStr, Show ); +{$IFDEF PATCH_CHEAT} + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} + Part := Part^.Next; + end; + end; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} N := 0; +{$IFDEF PATCH_CHEAT} + if Cheat_EqpMenu_ShowSubItem then begin + CheckAlongPath( Master^.InvCom , False,False, '', InvStr, True ); + CheckAlongPath( Master^.SubCom , False,False, '', SubStr, True ); + end else begin + CheckAlongPath( Master^.InvCom , False ); + CheckAlongPath( Master^.SubCom , False ); + end; +{$ELSE PATCH_CHEAT} CheckAlongPath( Master^.InvCom , False ); CheckAlongPath( Master^.SubCom , False ); +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + BuildEquipmentMenu := N; +{$ENDIF DEBUG} end; {BuildEquipmentMenu} +{$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} +Function BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr ): LongInt; +begin + BuildInventoryMenu := BuildInventoryMenu( RPM, Master, False ); +end; + {$ELSE DEBUG} +Procedure BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr ); +begin + BuildInventoryMenu( RPM, Master, False ); +end; + {$ENDIF DEBUG} + + {$IFDEF DEBUG} +Function BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr; const ShowSub: Boolean ): LongInt; + {$ELSE DEBUG} +Procedure BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr; const ShowSub: Boolean ); + {$ENDIF DEBUG} +{$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} +Function BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr ): LongInt; + {$ELSE DEBUG} Procedure BuildInventoryMenu( RPM: RPGMenuPtr; Master: GearPtr ); + {$ENDIF DEBUG} +{$ENDIF PATCH_CHEAT} { Create a menu for this master's inventory. Inventory is defined as } { any InvCom of the master. } +{$IFDEF PATCH_CHEAT} +const + InvStr = '+'; + SubStr = '>'; +{$ENDIF PATCH_CHEAT} var N: Integer; Part: GearPtr; @@ -152,9 +510,15 @@ var { the locator numbers will work properly. } begin While P <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} Inc( N ); if P^.InvCom <> Nil then CountTheKids( P^.InvCom ); if P^.SubCom <> Nil then CountTheKids( P^.SubCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} P := P^.Next; end; end; @@ -164,6 +528,9 @@ var msg: String; ShotsUsed: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = P) or (P^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} msg := FullGearName( P ); { Add extra information, depending upon item type. } @@ -178,58 +545,441 @@ var msg := msg + ' (' + BStr( P^.STat[ STAT_FoodQuantity ] ) + ')'; end; +{$IFDEF PATCH_GH} + if DisallowSelling( P ) then begin +{$IFDEF PATCH_I18N} + msg := msg + I18N_MsgString( 'BuildInventoryMenu' , 'CannotBeSold' ); +{$ELSE PATCH_I18N} + msg := msg + ' [Unsellable]'; +{$ENDIF PATCH_I18N} + end; + if DisallowDropping( P ) then begin +{$IFDEF PATCH_I18N} + msg := msg + I18N_MsgString( 'BuildInventoryMenu' , 'CannotBeDropped' ); +{$ELSE PATCH_I18N} + msg := msg + ' [NoDrop]'; +{$ENDIF PATCH_I18N} + end; + if DisallowTransfering( P ) then begin +{$IFDEF PATCH_I18N} + msg := msg + I18N_MsgString( 'BuildInventoryMenu' , 'CannotBeTransfered' ); +{$ELSE PATCH_I18N} + msg := msg + ' [NoTransfer]'; +{$ENDIF PATCH_I18N} + end; +{$ENDIF PATCH_GH} + IMString := Msg; end; +{$IFDEF PATCH_CHEAT} + Procedure CheckAlongPath( Part: GearPtr; const TabPos,Prefix: String ); + begin + while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} + Inc(N); +{$IFDEF PATCH_I18N} + if Part^.G <> GG_AbsolutelyNothing then begin + AddRPGMenuItem( RPM, #$0 + TabPos + Prefix + IMString(Part), N, FormatDescString(Part) ); + end; +{$ELSE PATCH_I18N} + if Part^.G <> GG_AbsolutelyNothing then AddRPGMenuItem( RPM, #$0 + TabPos + Prefix + IMString(Part), N, SAttValue(Part^.SA , 'DESC') ); +{$ENDIF PATCH_I18N} + CheckAlongPath( Part^.InvCom , TabPos + ' ' , InvStr ); + CheckAlongPath( Part^.SubCom , TabPos + ' ' , SubStr ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} + Part := Part^.Next; + end; + end; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} N := 0; Part := Master^.InvCom; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} Inc( N ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM, IMString(Part), N, FormatDescString(Part) ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , IMString( Part ) , N , SAttValue( Part^.SA , 'DESC' ) ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if ShowSub then begin + CheckAlongPath( Part^.InvCom, ' ', InvStr ); + CheckAlongPath( Part^.SubCom, ' ', SubStr ); + end else begin + CountTheKids( Part^.InvCom ); + CountTheKids( Part^.SubCom ); + end; +{$ELSE PATCH_CHEAT} if Part^.InvCom <> Nil then CountTheKids( Part^.InvCom ); if Part^.SubCom <> Nil then CountTheKids( Part^.SubCom ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; +{$IFDEF DEBUG} + BuildInventoryMenu := CountGearIndex( Master, False, '' ); +{$ENDIF DEBUG} end; +{$IFDEF DEBUG} +Function BuildSlotMenu( RPM: RPGMenuPtr; Master,Item: GearPtr ): LongInt; +{$ELSE DEBUG} Procedure BuildSlotMenu( RPM: RPGMenuPtr; Master,Item: GearPtr ); +{$ENDIF DEBUG} { Search through MASTER, adding to menu all parts which can } { equip ITEM. } +{$IFDEF PATCH_CHEAT} +const + InvStr = '+'; + SubStr = '>'; +{$ENDIF PATCH_CHEAT} var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} { PROCEDURES BLOCK } +{$IFDEF PATCH_CHEAT} + Function IMString_addParent( const Part: GearPtr; const basemsg: String ): String; + var + msg: String; + begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + if IsMasterGear( Part^.Parent ) then begin + msg := '[' + GearName( Part^.Parent ) + '] ' + basemsg; + end else begin + msg := basemsg + ' ['; + if FindMaster(Part)^.Parent <> Nil then msg := msg + GearName( FindMaster( Part ) ) + ':'; + msg := msg + GearName( Part^.Parent ) + ']'; + end; + IMString_addParent := msg; + end; + Function IMString( const P: GearPtr ): String; + var + msg: String; + ShotsUsed: Integer; + begin +{$IFDEF PATCH_GH} + if (NIL = P) or (P^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + msg := FullGearName( P ); + if P^.G = GG_Weapon then begin + msg := msg + ' (DC:' + BStr( ScaleDC( P^.V , P^.Scale ) ) + ')'; + end else if ( P^.G = GG_ExArmor ) or ( P^.G = GG_Shield ) then begin + msg := msg + ' [AC:' + BStr( GearMaxArmor( P ) ) + ']'; + end else if P^.G = GG_Ammo then begin + ShotsUsed := NAttValue( P^.NA , NAG_WeaponModifier , NAS_AmmoSpent ); + msg := msg + ' (' + BStr( P^.STat[ STAT_AmmoPresent ] - ShotsUsed ) + '/' + BStr( P^.Stat[ STAT_AmmoPresent ] ) + 'a)'; + end else if P^.G = GG_Consumable then begin + msg := msg + ' (' + BStr( P^.STat[ STAT_FoodQuantity ] ) + ')'; + end; + IMString := Msg; + end; + Procedure CheckAlongPath( Part: GearPtr; const LastN: LongInt; const IsHitSub: Boolean; const TabPos,Prefix: String ); + var + Hit: Boolean; + NewN: LongInt; + NewTabPos: String; + msg: String; + begin + while Part <> Nil do begin + {$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin + Hit := False; + NewN := -2; + NewTabPos := ''; + Inc(N); + if IsLegalSlot( Part , Item ) and PartActive( Part ) then begin + msg := ''; + if Cheat_EquipItem_ShowInvStr then begin + msg := Prefix; + end; + if Cheat_EquipItem_ShowParentItem then begin + msg := msg + IMString_addParent( Part, GearName(Part) ); + end else begin + msg := msg + GearName( Part ); + end; + AddRPGMenuItem( RPM, msg, N ); + Hit := True; + NewN := N; + NewTabPos := ' '; + end else begin + if Cheat_EquipItem_ShowSubItem and IsHitSub then begin + AddRPGMenuItem( RPM, TabPos + Prefix + IMString(Part), LastN ); + Hit := True; + NewTabPos := TabPos + ' '; + end; + end; + CheckAlongPath( Part^.InvCom, NewN, Hit, NewTabPos, InvStr ); + CheckAlongPath( Part^.SubCom, NewN, Hit, NewTabPos, SubStr ); + end; + {$ELSE PATCH_GH} + Hit := False; + NewN := -2; + NewTabPos := ''; + Inc(N); + if IsLegalSlot( Part , Item ) and PartActive( Part ) then begin + msg := ''; + if Cheat_EquipItem_ShowInvStr then begin + msg := Prefix; + end; + if Cheat_EquipItem_ShowParentItem then begin + msg := msg + IMString_addParent( Part, GearName(Part) ); + end else begin + msg := msg + GearName( Part ); + end; + AddRPGMenuItem( RPM, msg, N ); + Hit := True; + NewN := N; + NewTabPos := ' '; + end else begin + if Cheat_EquipItem_ShowSubItem and IsHitSub then begin + AddRPGMenuItem( RPM, TabPos + Prefix + IMString(Part), LastN ); + Hit := True; + NewTabPos := TabPos + ' '; + end; + end; + CheckAlongPath( Part^.InvCom, NewN, Hit, NewTabPos, InvStr ); + CheckAlongPath( Part^.SubCom, NewN, Hit, NewTabPos, SubStr ); + {$ENDIF PATCH_GH} + Part := Part^.Next; + end; + end;{CheckAlongPath} +{$ELSE PATCH_CHEAT} Procedure CheckAlongPath( Part: GearPtr ); { CHeck along the path specified. } begin while Part <> Nil do begin + {$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin + Inc(N); + if IsLegalSlot( Part , Item ) and PartActive( Part ) then AddRPGMenuItem( RPM , GearName( Part ) , N ); + CheckAlongPath( Part^.InvCom ); + CheckAlongPath( Part^.SubCom ); + end; + {$ELSE PATCH_GH} Inc(N); if IsLegalSlot( Part , Item ) and PartActive( Part ) then AddRPGMenuItem( RPM , GearName( Part ) , N ); CheckAlongPath( Part^.InvCom ); CheckAlongPath( Part^.SubCom ); + {$ENDIF PATCH_GH} Part := Part^.Next; end; end;{CheckAlongPath} +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} N := 0; +{$IFDEF PATCH_CHEAT} + CheckAlongPath( Master^.InvCom, -2, False, '', InvStr ); + CheckAlongPath( Master^.SubCom, -2, False, '', SubStr ); +{$ELSE PATCH_CHEAT} CheckAlongPath( Master^.InvCom ); CheckAlongPath( Master^.SubCom ); +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + BuildSlotMenu := N; +{$ENDIF DEBUG} end; { BuildSlotMenu } +{$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} +Function BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean ): LongInt; +begin + BuildSubMenu := BuildSubMenu( RPM, Master, Item, DoMultiplicityCheck, False ); +end; + {$ELSE DEBUG} Procedure BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean ); +begin + BuildSubMenu( RPM, Master, Item, DoMultiplicityCheck, False ); +end; + {$ENDIF DEBUG} + + {$IFDEF DEBUG} +Function BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean; const ShowSub: Boolean ): LongInt; + {$ELSE DEBUG} +Procedure BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean; const ShowSub: Boolean ); + {$ENDIF DEBUG} +{$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} +Function BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean ): LongInt; + {$ELSE DEBUG} +Procedure BuildSubMenu( RPM: RPGMenuPtr; Master,Item: GearPtr; DoMultiplicityCheck: Boolean ); + {$ENDIF DEBUG} +{$ENDIF PATCH_CHEAT} { Search through MASTER, adding to menu all parts which can } { take ITEM as a subcomponent. } +{$IFDEF PATCH_CHEAT} +const + InvStr = '+'; + SubStr = '>'; +{$ENDIF PATCH_CHEAT} var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + Hit: Boolean; + NewN: LongInt; + NewTabPos: String; +{$ENDIF PATCH_CHEAT} { PROCEDURES BLOCK } Function MenuMsg( Part: GearPtr ): String; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} MenuMsg := GearName( Part ) + ' (' + BStr( SubComComplexity( Part ) ) + '/' + BStr( ComponentComplexity( Part ) ) + ')'; end; +{$IFDEF PATCH_CHEAT} + Function IMString_addParent( const Part: GearPtr; const basemsg: String ): String; + var + msg: String; + begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + if IsMasterGear( Part^.Parent ) then begin + msg := '[' + GearName( Part^.Parent ) + '] ' + basemsg; + end else begin + msg := basemsg + ' ['; + if FindMaster(Part)^.Parent <> Nil then msg := msg + GearName( FindMaster( Part ) ) + ':'; + msg := msg + GearName( Part^.Parent ) + ']'; + end; + IMString_addParent := msg; + end; + Function IMString( const P: GearPtr ): String; + var + msg: String; + ShotsUsed: Integer; + begin +{$IFDEF PATCH_GH} + if (NIL = P) or (P^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + msg := FullGearName( P ); + if P^.G = GG_Weapon then begin + msg := msg + ' (DC:' + BStr( ScaleDC( P^.V , P^.Scale ) ) + ')'; + end else if ( P^.G = GG_ExArmor ) or ( P^.G = GG_Shield ) then begin + msg := msg + ' [AC:' + BStr( GearMaxArmor( P ) ) + ']'; + end else if P^.G = GG_Ammo then begin + ShotsUsed := NAttValue( P^.NA , NAG_WeaponModifier , NAS_AmmoSpent ); + msg := msg + ' (' + BStr( P^.STat[ STAT_AmmoPresent ] - ShotsUsed ) + '/' + BStr( P^.Stat[ STAT_AmmoPresent ] ) + 'a)'; + end else if P^.G = GG_Consumable then begin + msg := msg + ' (' + BStr( P^.STat[ STAT_FoodQuantity ] ) + ')'; + end; + IMString := Msg; + end; + Function CheckThisBit( const Part: GearPtr; const Prefix: String ): Boolean; + var + msg, basemsg: String; + begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + msg := ''; + if Cheat_InstallMisc_ShowInvStr then begin + msg := Prefix; + end; + if DoMultiplicityCheck then begin + if CanBeInstalled( Part , Item ) then begin + basemsg := MenuMsg( Part ); + if Cheat_InstallMisc_ShowParentItem then begin + msg := msg + IMString_addParent( Part, basemsg ); + end else begin + msg := msg + basemsg; + end; + AddRPGMenuItem( RPM, msg, N ); + Exit( True ); + end; + end else begin + if IsLegalSubCom( Part , Item ) then begin + basemsg := GearName( Part ); + if Cheat_InstallMisc_ShowParentItem then begin + msg := msg + IMString_addParent( Part, basemsg ); + end else begin + msg := msg + basemsg; + end; + AddRPGMenuItem( RPM, msg, N ); + Exit( True ); + end; + end; + Exit( False ); + end; + Procedure CheckAlongPath( Part: GearPtr; const LastN: LongInt; const IsHitSub: Boolean; const TabPos,Prefix: String ); + var + Hit: Boolean; + NewN: LongInt; + NewTabPos: String; + begin + while Part <> Nil do begin + {$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin + Inc(N); + Hit := CheckThisBit( Part, Prefix ); + NewN := -2; + NewTabPos := ''; + If Hit then begin + NewN := N; + NewTabPos := ' '; + end else begin + if ShowSub and IsHitSub then begin + AddRPGMenuItem( RPM, TabPos + Prefix + IMString(Part), LastN ); + Hit := True; + NewTabPos := TabPos + ' '; + end; + end; + CheckAlongPath( Part^.InvCom, NewN, Hit, NewTabPos, InvStr ); + CheckAlongPath( Part^.SubCom, NewN, Hit, NewTabPos, SubStr ); + end; + {$ELSE PATCH_GH} + Inc(N); + Hit := CheckThisBit( Part, Prefix ); + NewN := -2; + NewTabPos := ''; + If Hit then begin + NewN := N; + NewTabPos := ' '; + end else begin + if ShowSub and IsHitSub then begin + AddRPGMenuItem( RPM, TabPos + Prefix + IMString(Part), LastN ); + Hit := True; + NewTabPos := TabPos + ' '; + end; + end; + CheckAlongPath( Part^.InvCom, NewN, Hit, NewTabPos, InvStr ); + CheckAlongPath( Part^.SubCom, NewN, Hit, NewTabPos, SubStr ); + {$ENDIF PATCH_GH} + Part := Part^.Next; + end; + end; +{$ELSE PATCH_CHEAT} Procedure CheckThisBit( Part: GearPtr ); { Check this bit, and maybe add it to the menu. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if DoMultiplicityCheck then begin if CanBeInstalled( Part , Item ) then AddRPGMenuItem( RPM , MenuMsg( Part ) , N ); end else begin @@ -240,48 +990,156 @@ var { CHeck along the path specified. } begin while Part <> Nil do begin + {$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin + Inc(N); + CheckThisBit( Part ); + CheckAlongPath( Part^.InvCom ); + CheckAlongPath( Part^.SubCom ); + end; + {$ELSE PATCH_GH} Inc(N); CheckThisBit( Part ); CheckAlongPath( Part^.InvCom ); CheckAlongPath( Part^.SubCom ); + {$ENDIF PATCH_GH} Part := Part^.Next; end; end;{CheckAlongPath} +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} N := 0; +{$IFDEF PATCH_CHEAT} + Hit := CheckThisBit( Master, '' ); + NewN := -2; + NewTabPos := ''; + if Hit then begin + NewN := N; + NewTabPos := ' '; + end; + CheckAlongPath( Master^.InvCom, NewN, Hit, NewTabPos, InvStr ); + CheckAlongPath( Master^.SubCom, NewN, Hit, NewTabPos, SubStr ); +{$ELSE PATCH_CHEAT} CheckThisBit( Master ); CheckAlongPath( Master^.InvCom ); CheckAlongPath( Master^.SubCom ); +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + BuildSubMenu := N; +{$ENDIF DEBUG} end; { BuildSubMenu } +{$IFDEF DEBUG} +{$ELSE DEBUG} + {$IFDEF PATCH_GH} +Function LocateGearByNumber( Master: GearPtr; Num: LongInt ): GearPtr; +begin + LocateGearByNumber := LocateGearByNumber( Master, Num, False ); +end; + {$ENDIF PATCH_GH} +{$ENDIF DEBUG} + +{$IFDEF DEBUG} +Function LocateGearByNumber( Master: GearPtr; Num: LongInt; DebugMode: Boolean; MaxNum: LongInt; DebugMsg: String ): GearPtr; +{$ELSE DEBUG} + {$IFDEF PATCH_GH} +Function LocateGearByNumber( Master: GearPtr; Num: LongInt; DebugMode: Boolean ): GearPtr; + {$ELSE PATCH_GH} Function LocateGearByNumber( Master: GearPtr; Num: Integer ): GearPtr; + {$ENDIF PATCH_GH} +{$ENDIF DEBUG} { Locate the Nth part in the tree. } var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} TheGearWeWant: GearPtr; { PROCEDURES BLOCK. } Procedure CheckAlongPath( Part: GearPtr ); { CHeck along the path specified. } begin + {$IFDEF DEBUG} + while (NIL <> Part) do begin + if DebugMode or (GG_DisposeGear < Part^.G) then begin + Inc(N); + if N = Num then TheGearWeWant := Part; + CheckAlongPath( Part^.InvCom ); + CheckAlongPath( Part^.SubCom ); + end; + Part := Part^.Next; + end; + {$ELSE DEBUG} while ( Part <> Nil ) and ( TheGearWeWant = Nil ) do begin + {$IFDEF PATCH_GH} + if DebugMode or (GG_DisposeGear < Part^.G) then begin + Inc(N); + if N = Num then TheGearWeWant := Part; + if TheGearWeWant = Nil then CheckAlongPath( Part^.InvCom ); + if TheGearWeWant = Nil then CheckAlongPath( Part^.SubCom ); + end; + {$ELSE PATCH_GH} Inc(N); if N = Num then TheGearWeWant := Part; if TheGearWeWant = Nil then CheckAlongPath( Part^.InvCom ); if TheGearWeWant = Nil then CheckAlongPath( Part^.SubCom ); + {$ENDIF PATCH_GH} Part := Part^.Next; end; + {$ENDIF DEBUG} end; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (not(DebugMode) and (Master^.G <= GG_DisposeGear)) then begin + {$IFDEF DEBUG} + ErrorMessage('ERROR: ' + DebugMsg + ': LocateGearByNumber(): GG_DisposeGear'); + DialogMsg('ERROR: ' + DebugMsg + ': LocateGearByNumber(): GG_DisposeGear'); + {$ENDIF DEBUG} + Exit(NIL); + end; +{$ENDIF PATCH_GH} + TheGearWeWant := Nil; N := 0; { Part 0 is the master gear itself. } +{$IFDEF DEBUG} + if Num < 1 then begin + TheGearWeWant := Master; + end; + + CheckAlongPath( Master^.InvCom ); + CheckAlongPath( Master^.SubCom ); + + if (NIL = TheGearWeWant) then begin + ErrorMessage('ERROR: ' + DebugMsg + ': LocateGearByNumber(): NotFound: ' + BStr(Num) ); + DialogMsg('ERROR: ' + DebugMsg + ': LocateGearByNumber(): NotFound: ' + BStr(Num) ); + end else begin + if (0 < Length(DebugMsg)) then begin + if (NIL <> TheGearWeWant^.SA) then begin + ErrorMessage_fork( 'TRACE: LocateGearByNumber(): ' + BStr(Num) + ':' + TheGearWeWant^.SA^.info ); + DialogMsg( 'TRACE: LocateGearByNumber(): ' + BStr(Num) + ':' + TheGearWeWant^.SA^.info ); + end else begin + ErrorMessage_fork( 'TRACE: LocateGearByNumber(): ' + BStr(Num) + ':NIL' ); + DialogMsg( 'TRACE: LocateGearByNumber(): ' + BStr(Num) + ':NIL' ); + end; + end; + end; + if (0 < Length(DebugMsg)) and (MaxNum <> N) then begin + ErrorMessage('ERROR: ' + DebugMsg + ': MaxNum is mismatch, arg:' + BStr(MaxNum) + ', Now:' + IntToStr(N) + '.'); + DialogMsg('ERROR: ' + DebugMsg + ': MaxNum is mismatch, arg:' + BStr(MaxNum) + ', Now:' + IntToStr(N) + '.'); + end; +{$ELSE DEBUG} if Num < 1 then Exit( Master ); CheckAlongPath( Master^.InvCom ); if TheGearWeWant = Nil then CheckAlongPath( Master^.SubCom ); - +{$ENDIF DEBUG} LocateGearByNumber := TheGearWeWant; end; { LocateGearByNumber } @@ -299,6 +1157,9 @@ var { Return TRUE if W is ready to fire and meets our other criteria, or } { FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = W) or (W^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if MinRange = 0 then begin WeaponIsOkay := ReadyToFire( GB , Master , W ); end else begin @@ -309,19 +1170,38 @@ var { CHeck along the path specified. } begin while Part <> Nil do begin + {$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin + if WeaponIsOkay( Part ) then begin + if FirstWep = Nil then FirstWep := Part; + if FoundStart and ( NextWep = Nil ) then NextWep := Part; + end; + if Part = Weapon then FoundStart := True; + CheckAlongPath( Part^.InvCom ); + CheckAlongPath( Part^.SubCom ); + end; + {$ELSE PATCH_GH} if WeaponIsOkay( Part ) then begin if FirstWep = Nil then FirstWep := Part; if FoundStart and ( NextWep = Nil ) then NextWep := Part; end; if Part = Weapon then FoundStart := True; - CheckAlongPath( Part^.InvCom ); CheckAlongPath( Part^.SubCom ); + {$ENDIF PATCH_GH} + Part := Part^.Next; end; end; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(NIL); + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then begin + Weapon := NIL; + end; +{$ENDIF PATCH_GH} + FirstWep := Nil; NextWep := Nil; @@ -333,29 +1213,58 @@ begin { Return either the next weapon or the first weapon, } { depending upon what we found. } +{$IFDEF PATCH_CHEAT} + if NextWep = Nil then FindNextWeapon := FirstWep + else FindNextWeapon := NextWep; + if Cheat_FindNextWeapon then begin + if FindNextWeapon = Nil then FindNextWeapon := Weapon; + end; +{$ELSE PATCH_CHEAT} if NextWep = Nil then FindNextWeapon := Weapon else FindNextWeapon := NextWep; +{$ENDIF PATCH_CHEAT} end; { FindNextWeapon } +{$IFDEF PATCH_GH} +Function FindGearIndex( Master , FindThis: GearPtr ): LongInt; +{$ELSE PATCH_GH} Function FindGearIndex( Master , FindThis: GearPtr ): Integer; +{$ENDIF PATCH_GH} { Search through master looking for FINDTHIS. } { Once found, return its index number. Return -1 if it } { cannot be found. } var +{$IFDEF PATCH_GH} + N,it: LongInt; +{$ELSE PATCH_GH} N,it: Integer; +{$ENDIF PATCH_GH} { PROCEDURES BLOCK } Procedure CheckAlongPath( Part: GearPtr ); { CHeck along the path specified. } begin while ( Part <> Nil ) and ( it = -1 ) do begin + {$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin + Inc(N); + if ( Part = FindThis ) then it := N; + CheckAlongPath( Part^.InvCom ); + CheckAlongPath( Part^.SubCom ); + end; + {$ELSE PATCH_GH} Inc(N); if ( Part = FindThis ) then it := N; CheckAlongPath( Part^.InvCom ); CheckAlongPath( Part^.SubCom ); + {$ENDIF PATCH_GH} Part := Part^.Next; end; end; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(-1); + if (NIL = FindThis) or (FindThis^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} N := 0; it := -1; if Master = FindThis then it := 0; @@ -364,6 +1273,39 @@ begin FindGearIndex := it; end; { FindGearIndex } +{$IFDEF DEBUG} +Function CountGearIndex( Master: GearPtr; DebugMode: Boolean; DebugMsg: String ): LongInt; +var + N: LongInt; + Procedure CheckAlongPath( Part: GearPtr ); + begin + while (NIL <> Part) do begin + if DebugMode or (GG_DisposeGear < Part^.G) then begin + Inc(N); + CheckAlongPath( Part^.InvCom ); + CheckAlongPath( Part^.SubCom ); + end; + Part := Part^.Next; + end; + end; +begin + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then begin + N := -1; + end else begin + N := 0; + CheckAlongPath( Master^.InvCom ); + CheckAlongPath( Master^.SubCom ); + end; + + if 0 < Length(DebugMsg) then begin + ErrorMessage_fork('TRACE: ' + DebugMsg + ': MaxNum is ' + IntToStr(N) + '.'); + DialogMsg('TRACE: ' + DebugMsg + ': MaxNum is ' + IntToStr(N) + '.'); + end; + + CountGearIndex := N; +end; { CountGearIndex } +{$ENDIF DEBUG} + Procedure AlphaKeyMenu( RPM: RPGMenuPtr ); { Alter this menu so that each item in it has a letter key } { hotlinked. } @@ -371,28 +1313,189 @@ Procedure AlphaKeyMenu( RPM: RPGMenuPtr { to stick it here than keep two copies in the conmenus and } { sdlmenus units. What I really need is a separate menu-utility } { unit, I guess. } +{$IFDEF PATCH_GH} +const + MENUKEY_TABLE_MAX = 20; + MenuKey_Table: Array [1..MENUKEY_TABLE_MAX] of Integer = ( + KMC_Up, + KMC_Down, + KMC_Left, + KMC_Right, + KMC_UpRight, + KMC_DownRight, + KMC_UpLeft, + KMC_DownLeft, + KMC_MenuUp, + KMC_MenuDown, + KMC_MenuLeft, + KMC_MenuRight, + KMC_PageUp, + KMC_PageDown, + KMC_ScrollUp, + KMC_ScrollDown, + KMC_ButtonWUp, + KMC_ButtonWDown, + KMC_ButtonWLeft, + KMC_ButtonWRight + ); +{$ENDIF PATCH_GH} var Key: Char; MI: RPGMenuItemPtr; +{$IFDEF PATCH_GH} + i: Integer; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} +label + NextKey; +{$ENDIF PATCH_GH} begin { The hotkeys start with 'a'. } Key := 'a'; MI := RPM^.firstitem; while MI <> Nil do begin +{$IFDEF PATCH_CHEAT} + if #$0 = MI^.msg[1] then begin + MI^.msg := ' ' + Copy( MI^.msg, 2, Length(MI^.msg) -1 ); + end else begin + { Alter the message. } + MI^.msg := Key + ') ' + MI^.msg; + + {$IFDEF PATCH_GH} + { Add the key. } + if ('*' <> Key) then begin + AddRPGMenuKey( RPM , Key , MI^.value ); + end; + + { Move to the next letter in the series. } + { note that only 52 letters can be assigned. } + while ('*' <> Key) do begin + NextKey: + if ('z' = Key) then Key := 'A' + else if ('Z' = Key) or ('*' = Key) then Key := '*' + else inc( Key ); + {$IFDEF PATCH_l0ugh} + if KeyBind_RogueMove then begin + if (Key = 'b') then Key := 'c' {skip b} + else if (Key = 'h') then Key := 'i' {skip h} + else if (Key = 'j') then Key := 'm' {skip j,k,l} + else if (Key = 'k') then Key := 'm' {skip k,l} + else if (Key = 'l') then Key := 'm' {skip l} + else if (Key = 'n') then Key := 'o' {skip n} + else if (Key = 'u') then Key := 'v' {skip u} + else if (Key = 'y') then Key := 'z' {skip y} + end; + {$ENDIF PATCH_l0ugh} + if ('*' <> Key) then begin + for i := 1 to MENUKEY_TABLE_MAX do begin + if (KeyMap[ MenuKey_Table[i] ].KCode = Key) then begin + goto NextKey; + end; + end; + end; + break; + end; + {$ELSE PATCH_GH} + { Add the key. } + AddRPGMenuKey( RPM , Key , MI^.value ); + + { Move to the next letter in the series. } + { note that only 52 letters can be assigned. } + if key = 'z' then key := 'A' + {$IFDEF PATCH_l0ugh} + else if KeyBind_RogueMove and (key = 'a') then key := 'c' {skip b} + else if KeyBind_RogueMove and (key = 'g') then key := 'i' {skip h} + else if KeyBind_RogueMove and (key = 'i') then key := 'm' {skip j,k,l} + else if KeyBind_RogueMove and (key = 'j') then key := 'm' {skip k,l} + else if KeyBind_RogueMove and (key = 'k') then key := 'm' {skip l} + else if KeyBind_RogueMove and (key = 'm') then key := 'o' {skip n} + else if KeyBind_RogueMove and (key = 't') then key := 'v' {skip u} + else if KeyBind_RogueMove and (key = 'x') then key := 'z' {skip y} + {$ENDIF PATCH_l0ugh} + {$IFDEF PATCH_GH} + else if ('Z' = key) or ('*' = key) then key := '*' + {$ENDIF PATCH_GH} + else inc( key ); + {$ENDIF PATCH_GH} + end; +{$ELSE PATCH_CHEAT} { Alter the message. } MI^.msg := Key + ') ' + MI^.msg; { Add the key. } + {$IFDEF PATCH_GH} + { Add the key. } + if ('*' <> Key) then begin + AddRPGMenuKey( RPM , Key , MI^.value ); + end; + + { Move to the next letter in the series. } + { note that only 52 letters can be assigned. } + while ('*' <> Key) do begin + NextKey: + if ('z' = Key) then Key := 'A' + else if ('Z' = Key) or ('*' = Key) then Key := '*' + else inc( Key ); + {$IFDEF PATCH_l0ugh} + if KeyBind_RogueMove then begin + if (Key = 'b') then Key := 'c' {skip b} + else if (Key = 'h') then Key := 'i' {skip h} + else if (Key = 'j') then Key := 'm' {skip j,k,l} + else if (Key = 'k') then Key := 'm' {skip k,l} + else if (Key = 'l') then Key := 'm' {skip l} + else if (Key = 'n') then Key := 'o' {skip n} + else if (Key = 'u') then Key := 'v' {skip u} + else if (Key = 'y') then Key := 'z' {skip y} + end; + {$ENDIF PATCH_l0ugh} + if ('*' <> Key) then begin + for i := 1 to MENUKEY_TABLE_MAX do begin + if (KeyMap[ MenuKey_Table[i] ].KCode = Key) then begin + goto NextKey; + end; + end; + end; + break; + end; + {$ELSE PATCH_GH} AddRPGMenuKey( RPM , Key , MI^.value ); { Move to the next letter in the series. } { note that only 52 letters can be assigned. } if key = 'z' then key := 'A' + {$IFDEF PATCH_l0ugh} + else if KeyBind_RogueMove and (key = 'a') then key := 'c' {skip b} + else if KeyBind_RogueMove and (key = 'g') then key := 'i' {skip h} + else if KeyBind_RogueMove and (key = 'i') then key := 'm' {skip j,k,l} + else if KeyBind_RogueMove and (key = 'j') then key := 'm' {skip k,l} + else if KeyBind_RogueMove and (key = 'k') then key := 'm' {skip l} + else if KeyBind_RogueMove and (key = 'm') then key := 'o' {skip n} + else if KeyBind_RogueMove and (key = 't') then key := 'v' {skip u} + else if KeyBind_RogueMove and (key = 'x') then key := 'z' {skip y} + {$ENDIF PATCH_l0ugh} else inc( key ); + {$ENDIF PATCH_GH} +{$ENDIF PATCH_CHEAT} MI := MI^.Next; end; end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: menugear.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: menugear.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/movement.pp branches/movement.pp --- GearHead1100repository.original/movement.pp 2013-02-06 10:00:02.000000000 +0900 +++ branches/movement.pp 2013-04-21 09:00:01.000000000 +0900 @@ -102,6 +102,7 @@ const Overcharge_Thrust = 125; + { PATCH_I18N: Don't translate here, use GameData/I18N_messages.txt. } MoveModeName: Array [ 1 .. NumMoveMode ] of string = ( 'Walk', 'Roll', 'Skim', 'Fly' ); @@ -117,6 +118,7 @@ const NumMoveAction = 5; + { PATCH_I18N: Don't translate here, use GameData/I18N_messages.txt. } MoveActionName: Array [0..NumMoveAction] of String = ( 'Stop','Cruise Speed','Full Speed','Turn Left','Turn Right','Reverse' ); @@ -126,6 +128,9 @@ const NAS_CallTime = 4; { Time when control procedure is called } NAS_TimeLimit = 5; { Time limit for jumping movement. } NAS_JumpRecharge = 6; +{$IFDEF PATCH_CHEAT} + NAS_SpeedoMeter = 7; +{$ENDIF PATCH_CHEAT} @@ -143,7 +148,11 @@ Function HasAtLeastOneValidMovemode( Mek implementation -uses damage,gearutil,ghchars,ghmodule,ghsupport; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + damage,gearutil,ghchars,ghmodule,ghsupport; const ZoaWalkBonus = 20; { Bonus to walking movement for Zoanoid mecha. } @@ -161,6 +170,10 @@ var it: LongInt; Bitz: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Initialize the count to 0. } it := 0; @@ -177,7 +190,13 @@ begin { Check sub-components. } Bitz := Master^.SubCom; while Bitz <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Bitz^.G) then begin +{$ENDIF PATCH_GH} it := it + CountThrustPoints( Bitz , MM , Scale ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Bitz := Bitz^.Next; end; @@ -189,7 +208,13 @@ begin if not IsMasterGear( Master ) then begin Bitz := Master^.InvCom; while Bitz <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Bitz^.G) then begin +{$ENDIF PATCH_GH} it := it + CountThrustPoints( Bitz , MM , Scale ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Bitz := Bitz^.Next; end; end; @@ -201,15 +226,32 @@ end; function CalcWalk( Mek: GearPtr ): Integer; { Calculate the base walking rate for this mecha. } var +{$IFDEF PATCH_GH} + mass: LongInt; + spd: Integer; +{$ELSE PATCH_GH} mass,spd: Integer; +{$ENDIF PATCH_GH} ActualLegPoints,MinLegPoints,NumLegs,MaxLegs: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Mek^.G = GG_Mecha then begin { Find the mass of the mecha. This will give the basic } { movement rate. } mass := GearMass( Mek ); if mass < 20 then mass := 20; +{$IFDEF PATCH_GH} + if (0 < ((TMWalkSpeed - mass) div 3)) then begin + spd := (TMWalkSpeed - mass) div 3; + end else begin + spd := 0; + end; +{$ELSE PATCH_GH} spd := (TMWalkSpeed - mass) div 3; +{$ENDIF PATCH_GH} if Mek^.S = GS_Zoanoid then spd := spd + ZoaWalkBonus; @@ -275,15 +317,32 @@ end; function CalcRoll( Mek: GearPtr ): Integer; { Calculate the base ground movement rate for this mecha. } var +{$IFDEF PATCH_GH} + mass: LongInt; + spd: Integer; +{$ELSE PATCH_GH} mass,spd: Integer; +{$ENDIF PATCH_GH} ActualWheelPoints,MinWheelPoints: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Find the mass of the mecha. This will give the basic } { movement rate. } if Mek^.G = GG_Mecha then begin mass := GearMass( Mek ); if mass < 20 then mass := 20; +{$IFDEF PATCH_GH} + if (0 < ((TMRollSpeed - mass) div 3)) then begin + spd := (TMRollSpeed - mass) div 3; + end else begin + spd := 0; + end; +{$ELSE PATCH_GH} spd := ( TMRollSpeed - mass ) div 3; +{$ENDIF PATCH_GH} if spd < MinWalkSpeed then spd := MinWalkSpeed; if Mek^.S = GS_GroundCar then begin @@ -318,8 +377,18 @@ end; function CalcSkim( Mek: GearPtr ): Integer; { Calculate the base hovering speed for this mecha. } var +{$IFDEF PATCH_GH} + mass: Int64; + thrust: LongInt; + spd: Integer; +{$ELSE PATCH_GH} mass,thrust,spd: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Mek^.G = GG_Mecha then begin { Calculate the mass... } mass := GearMass( Mek ); @@ -341,7 +410,15 @@ begin { Speed is equal to Thrust divided by Mass. } { Multiply by 10 since we want it expressed in } { decihexes per round. } +{$IFDEF PATCH_GH} + if (32767 < ((thrust * 10) div mass)) then begin + spd := 32767; + end else begin + spd := (thrust * 10) div mass; + end; +{$ELSE PATCH_GH} spd := (thrust * 10) div mass; +{$ENDIF PATCH_GH} { Check the gyroscope. Lacking one will slow down the mek. } if ( SeekActiveIntrinsic( Mek , GG_Support , GS_Gyro ) = Nil ) and ( Mek^.G = GG_Mecha ) then spd := spd div 2; @@ -360,8 +437,18 @@ function CalcFly( Mek: GearPtr; TrueSpee { mecha, or to FALSE if you want its projected speed (needed } { to calculate jumpjet time- see below. } var +{$IFDEF PATCH_GH} + mass: Int64; + thrust: LongInt; + spd,WingPoints: Integer; +{$ELSE PATCH_GH} mass,thrust,spd,WingPoints: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + if Mek^.G = GG_Mecha then begin { Calculate the mass... } mass := GearMass( Mek ); @@ -405,7 +492,15 @@ begin { Speed is equal to Thrust divided by Mass. } { Multiply by 10 since we want it expressed in } { decihexes per round. } +{$IFDEF PATCH_GH} + if (32767 < ((thrust * 10) div mass)) then begin + spd := 32767; + end else begin + spd := (thrust * 10) div mass; + end; +{$ELSE PATCH_GH} spd := (thrust * 10) div mass; +{$ENDIF PATCH_GH} { The speed will not drop below the minimum flight speed, } { so long as it's above the minimum jump speed. } @@ -428,8 +523,17 @@ end; Function OverchargeBonus( Master: GearPtr ): Integer; { Overchargers add a bonus to a mek's FULLSPEED action. } var +{$IFDEF PATCH_GH} + mass: LongInt; + thrust,it,T,SF: Integer; +{$ELSE PATCH_GH} mass,thrust,it,T,SF: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + mass := GearMass( Master ); thrust := CountActivePoints( Master , GG_MoveSys , GS_Overchargers ); it := ( thrust * Overcharge_Thrust * 10 ) div mass; @@ -454,6 +558,10 @@ function BaseMoveRate( Master: GearPtr ; var it,SF,t: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + {Error check- make sure we have a valid master here.} if not IsMasterGear(Master) then Exit( 0 ); if MoveMode = 0 then Exit( 0 ); @@ -496,6 +604,9 @@ function BaseMoveRate( Master: GearPtr ) { Determine the basic movement rate for the mecha based upon its } { current move mode. Do not adjust for actions. } begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} BaseMoveRate := BaseMoveRate( Master , NAttValue( Master^.NA , NAG_Action , NAS_MoveMode ) ); end; @@ -504,14 +615,30 @@ function CalcMaxTurnRate( Mek: GearPtr ) { The actual turn rate will be limited by the mecha's actual } { movement rate. } var +{$IFDEF PATCH_GH} + mass: LongInt; + spd: Integer; +{$ELSE PATCH_GH} mass,spd: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if Mek^.G = GG_Mecha then begin { Find the mass of the mecha. This will give the basic } { movement rate. } mass := GearMass( Mek ); if mass < 20 then mass := 20; +{$IFDEF PATCH_GH} + if (0 < ((TMWalkSpeed - mass) div 3)) then begin + spd := (TMWalkSpeed - mass) div 3; + end else begin + spd := 0; + end; +{$ELSE PATCH_GH} spd := (TMWalkSpeed - mass) div 3; +{$ENDIF PATCH_GH} if Mek^.S = GS_Zoanoid then spd := spd + ZoaWalkBonus; @@ -529,6 +656,9 @@ Function AdjustedMoveRate( Master: GearP var BMR,T,SF: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} BMR := BaseMoveRate( Master , MoveMode ); { If turning, the mecha's speed will be limited by the } @@ -563,6 +693,9 @@ function Speedometer( Master: GearPtr ): var MM,Order: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} MM := NAttValue( Master^.NA , NAG_Action , NAS_MoveMode ); Order := NAttValue( Master^.NA , NAG_Action , NAS_MoveAction ); @@ -579,6 +712,9 @@ procedure GearUP( Mek: GearPtr ); var T,MM: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} MM := 0; for T := NumMoveMode downto 1 do begin if BaseMoveRate( Mek , T ) > 0 then MM := T; @@ -594,6 +730,10 @@ function CPHMoveRate( Master: GearPtr ; var MoveMode,Spd,T,Order: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + MoveMode := NAttValue( Master^.NA , NAG_Action , NAS_MoveMode ); Order := NAttValue( Master^.NA , NAG_Action , NAS_MoveAction ); Spd := AdjustedMoveRate( Master , MoveMode , Order ); @@ -631,6 +771,10 @@ Function JumpTime( Master: GearPtr ): In var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + it := CalcFly( Master , False ); { Zoanoids and Arachnoids cannot fly, but they jump really well. } @@ -650,6 +794,10 @@ var it: Boolean; CMA: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Assume TRUE unless this is one of the exceptions. } it := True; @@ -690,6 +838,9 @@ Function MoveLegal( Mek: GEarPtr; MoveAc var MoveMode: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} MoveMode := NAttValue( Mek^.NA , NAG_Action , NAS_MoveMode ); MoveLegal := MoveLegal( Mek , MoveMode , MoveAction , ComTime ); end; @@ -700,6 +851,9 @@ var T: Integer; ItDoes: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} { Assume FALSE, until we find a working movemode. } ItDoes := False; for t := 1 to NumMoveMode do begin @@ -708,4 +862,20 @@ begin HasAtLeastOneValidMovemode := ItDoes; end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: movement.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: movement.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/navigate.pp branches/navigate.pp --- GearHead1100repository.original/navigate.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/navigate.pp 2014-07-10 09:00:00.000000000 +0900 @@ -25,7 +25,11 @@ unit navigate; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; Const Max_Number_Of_Plots = 40; @@ -36,13 +40,40 @@ Procedure RestoreCampaign; implementation +uses +{$IFDEF PATCH_GH} + gzio,errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, + texutil, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + ui4gh, + arenaplay,arenascript,damage,interact,gearutil, + ghchars,ghweapon,movement,randchar, +{$ELSE PATCH_GH} + arenaplay,arenascript,damage,interact,gearutil, + ghchars,ghweapon,movement,randchar,ui4gh, +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} -uses arenaplay,arenascript,damage,interact,gearutil, - ghchars,ghweapon,movement,randchar,ui4gh,sdlgfx,sdlmap,sdlmenus; -{$ELSE} -uses arenaplay,arenascript,damage,interact,gearutil, - ghchars,ghweapon,movement,randchar,ui4gh,congfx,conmap,conmenus,context; -{$ENDIF} + sdlgfx,sdlmap,sdlmenus +{$ELSE SDLMODE} + congfx,conmap,conmenus,context +{$ENDIF SDLMODE} +{$IFDEF ENABLE_ADDRESSBOOK} + ,pcaction +{$ENDIF ENABLE_ADDRESSBOOK} + ; + +{$IFDEF PATCH_GH} +var + Load_Game_Archive_Buf: packed array [0..GZ_Archive_BufLen-1] of byte; { Global uses BSS instead of stack } +{$ENDIF PATCH_GH} Function NoLivingPlayers( PList: GearPtr ): Boolean; { Return TRUE if the provided list of gears contains no } @@ -86,14 +117,31 @@ begin end; end; +{$IFDEF PATCH_GH} +Procedure Navigator( Camp: CampaignPtr; Scene: GearPtr; var PCForces: GearPtr; RestoreMode_arg: Boolean ); +{$ELSE PATCH_GH} Procedure Navigator( Camp: CampaignPtr; Scene: GearPtr; var PCForces: GearPtr ); +{$ENDIF PATCH_GH} { This is the role-playing flow controller. It decides what scene } { of an adventure gear to load next. } var N: Integer; +{$IFDEF PATCH_GH} + RestoreMode: Boolean; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + RestoreMode := RestoreMode_arg; +{$ENDIF PATCH_GH} repeat +{$IFDEF PATCH_GH} + if (NIL <> Scene) and (GG_DisposeGear < Scene^.G) then begin + N := ScenePlayer( Camp , Scene , PCForces, RestoreMode ); + end; + RestoreMode := False; +{$ELSE PATCH_GH} if SCene <> Nil then N := ScenePlayer( Camp , Scene , PCForces ); +{$ENDIF PATCH_GH} { Move to the destination scene, if appropriate. } if N > 0 then begin @@ -105,7 +153,15 @@ begin { If no destination scene was implied, check to see if there's } { a dynamic scene waiting to be processed. } +{$IFDEF PATCH_GH} + end else if (NIL <> SCRIPT_DynamicEncounter) and (GG_DisposeGear < SCRIPT_DynamicEncounter^.G) then begin +{$ELSE PATCH_GH} end else if SCRIPT_DynamicEncounter <> Nil then begin +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + Show_DebugMessage_SCRIPT_DynamicEncounter('Navigator()'); +{$ENDIF DEBUG} + Scene := SCRIPT_DynamicEncounter; { Stick the scene into the campaign. Normally scenes } @@ -123,13 +179,23 @@ begin N := 1; end; +{$IFDEF PATCH_GH} + until ( N < 1 ) or NoLivingPlayers( PCForces ) or ( NIL = Scene ) or ( Scene^.G <= GG_DisposeGear ); +{$ELSE PATCH_GH} until ( N < 1 ) or NoLivingPlayers( PCForces ) or ( Scene = Nil ); +{$ENDIF PATCH_GH} { If the game is over because the PC died, do a [MORE] prompt. } if NoLivingPlayers( PCForces ) then begin EndOfGameMoreKey; end; end; +{$IFDEF PATCH_GH} +Procedure Navigator( Camp: CampaignPtr; Scene: GearPtr; var PCForces: GearPtr ); +begin + Navigator( Camp, Scene, PCForces, False ); +end; +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} Procedure RCRedraw; @@ -142,6 +208,51 @@ end; Procedure RestoreCampaign; { Select a previously saved unit from the menu. If no unit is } { found, jump to the CreateNewUnit procedure above. } +{$IFDEF PATCH_GH} + Function decompress( InFileName, OutFileName: String ): Boolean; + var + InFile: gzFile; + OutFile: File; + len: LongInt; + written: cardinal; + err: integer; + begin + InFile := gzopen( InFileName , 'r' ); + if ( NIL = InFile ) then begin + ErrorMessage('RestoreCampaign Failed "' + InFileName + '".' ); + exit (False); + end; + + Assign( OutFile , OutFileName ); + Rewrite( OutFile , 1 ); + + while True do begin + len := gzread( InFile , @Load_Game_Archive_Buf, GZ_Archive_BufLen ); + if ( 0 = len ) then begin + decompress := True; + break; + end; + if ( len < 0 ) then begin + decompress := False; + ErrorMessage('RestoreCampaign Failed : ' + gzerror( InFile , err ) ); + break; + end; + + blockwrite( OutFile , Load_Game_Archive_Buf , len , written ); + if ( written <> len ) then begin + decompress := False; + ErrorMessage('RestoreCampaign Failed "' + InFileName + '".' ); + break; + end; + end; + + close( OutFile ); + if ( 0 <> gzclose( InFile ) ) then begin + ErrorMessage('RestoreCampaign Failed "' + InFileName + '".' ); + exit (False); + end; + end; +{$ENDIF PATCH_GH} var RPM: RPGMenuPtr; rpgname: String; { Campaign Name } @@ -149,28 +260,78 @@ var F: Text; { A File } PC,Part,P2: GearPtr; DoSave: Boolean; +{$IFDEF ENABLE_ADDRESSBOOK} + cname: String; +{$ENDIF} +{$IFDEF PATCH_GH} + N: Integer; + InFileName: String; + OutFileName: String; +{$ENDIF PATCH_GH} begin { Create a menu listing all the units in the SaveGame directory. } RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); +{$IFDEF PATCH_GH} + N := BuildFileMenu( RPM , Save_Campaign_Base + Default_Search_Pattern ); + BuildFileMenu( RPM , Save_Campaign_Base + Archive_Search_Pattern , N ); +{$ELSE PATCH_GH} BuildFileMenu( RPM , Save_Campaign_Base + Default_Search_Pattern ); +{$ENDIF PATCH_GH} PC := Nil; { If any units are found, allow the player to load one. } if RPM^.NumItem > 0 then begin RPMSortAlpha( RPM ); +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('RestoreCampaign','Select campaign') ); +{$ELSE PATCH_I18N} DialogMSG('Select campaign file to load.'); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} rpgname := SelectFile( RPM , @RCRedraw ); {$ELSE} rpgname := SelectFile( RPM ); {$ENDIF} if rpgname <> '' then begin +{$IFDEF DEBUG} + ErrorMessage_fork('RestoreCampaign: "' + rpgname + '".' ); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + {$IFDEF PATCH_I18N} + InFileName := Save_Game_Directory + TextEncode( rpgname ); + {$ELSE PATCH_I18N} + InFileName := Save_Game_Directory + rpgname; + {$ENDIF PATCH_I18N} + if ( ( ( 3 + 1 + 4 + 3 ) <= Length(rpgname) ) and ( GZ_Archive_Suffix = Copy( rpgname , Length(rpgname) - Length(GZ_Archive_Suffix) + 1 , Length(GZ_Archive_Suffix) ) ) ) then begin + OutFileName := Save_Game_Directory + TextEncode( Copy( rpgname , 1 , ( Pos( '.' , rpgname ) - 1 ) ) + Default_File_Ending ); + decompress( InFileName , OutFileName ); + InFileName := OutFileName; + end; + Assign(F, InFileName ); +{$ELSE PATCH_GH} + {$IFDEF PATCH_I18N} + Assign(F, Save_Game_Directory + TextEncode(rpgname) ); + {$ELSE PATCH_I18N} Assign(F, Save_Game_Directory + rpgname ); + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} reset(F); Camp := ReadCampaign(F); Close(F); +{$IFDEF ENABLE_ADDRESSBOOK} + cname := Copy( rpgname, 4, Length(rpgname) - 3 ); +{$IFDEF PATCH_I18N} + LoadAddressBook( Save_Campaign_AddressBook_Base + TextEncode(cname) ); +{$ELSE PATCH_I18N} + LoadAddressBook( Save_Campaign_AddressBook_Base + cname ); +{$ENDIF PATCH_I18N} +{$ENDIF ENABLE_ADDRESSBOOK} +{$IFDEF PATCH_GH} + Navigator( Camp , Camp^.GB^.Scene , PC, True ); +{$ELSE PATCH_GH} Navigator( Camp , Camp^.GB^.Scene , PC ); +{$ENDIF PATCH_GH} DoSave := Camp^.Source^.S <> 0; DisposeCampaign( Camp ); end else begin @@ -188,6 +349,10 @@ begin Part := PC; while Part <> Nil do begin P2 := Part^.Next; +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} { Lancemates don't get saved to the character file. } if NAttValue( Part^.NA , NAG_CharDescription , NAS_CharType ) = NAV_CTLancemate then begin RemoveGear( PC , Part ); @@ -206,6 +371,10 @@ begin StripNAtt( Part , NAG_Narrative ); SetNAtt( Part^.NA , NAG_Personal , NAS_FactionID , 0 ); end; +{$IFDEF PATCH_GH} + end; +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} Part := P2; end; SaveChar( PC ); @@ -217,4 +386,20 @@ begin DisposeRPGMenu( RPM ); end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: navigate.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: navigate.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/pcaction.pp branches/pcaction.pp --- GearHead1100repository.original/pcaction.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/pcaction.pp 2016-03-08 09:01:00.000000000 +0900 @@ -24,28 +24,77 @@ unit pcaction; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; Procedure PCSaveCampaign( Camp: CampaignPtr; PC: gearPtr; PrintMsg: Boolean ); +{$IFDEF PATCH_CHEAT} +Procedure PCSaveCampaign_for_Trace( Camp: CampaignPtr; PC: gearPtr ); +{$ENDIF PATCH_CHEAT} Procedure DoTraining( GB: GameBoardPtr; PC: GearPtr ); Procedure GetPlayerInput( Mek: GearPtr; Camp: CampaignPtr ); - +{$IFDEF PATCH_CHEAT} +Function CheckConversionSystem( Mek: GearPtr; FieldHQ_mode: Boolean ): Boolean; +Procedure DoTransformation( GB: GameBoardPtr; Mek: GearPtr; NewForm: Integer ); +Procedure UserTransformation( GB: GameBoardPtr; Mek: GearPtr; FieldHQ_mode: Boolean ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} +Procedure DoPurgeParts( GB: GameBoardPtr; Mek: GearPtr; SelectMode: Integer ); +Procedure UserPurgeParts( GB: GameBoardPtr; Mek: GearPtr ); +{$ENDIF PATCH_CHEAT} + +{$IFDEF ENABLE_ADDRESSBOOK} +Procedure LoadAddressBook( Filename: String ); +{$ENDIF ENABLE_ADDRESSBOOK} implementation -{$IFDEF SDLMODE} -uses ability,action,aibrain,arenacfe,arenascript,backpack, +uses +{$IFDEF DEBUG} + sysutils, + errmsg, + {$IFDEF PATCH_GH} + gzio, + {$ENDIF PATCH_GH} +{$ELSE DEBUG} + {$IFDEF PATCH_GH} + sysutils, + errmsg, + gzio, + {$ENDIF PATCH_GH} +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, + version, + grabgear, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + ui4gh, + ability,action,aibrain,arenacfe,arenascript,backpack, + damage,effects,gearutil,gflooker,ghchars,ghparser, + ghprop,ghswag,ghweapon,interact,menugear,movement, + playwright,randchar,rpgdice,skilluse,texutil, +{$ELSE PATCH_GH} + ability,action,aibrain,arenacfe,arenascript,backpack, damage,effects,gearutil,gflooker,ghchars,ghparser, ghprop,ghswag,ghweapon,interact,menugear,movement, playwright,randchar,rpgdice,skilluse,texutil,ui4gh, - sdlgfx,sdlinfo,sdlmap,sdlmenus; -{$ELSE} -uses ability,action,aibrain,arenacfe,arenascript,backpack, - damage,effects,gearutil,gflooker,ghchars,ghparser, - ghprop,ghswag,ghweapon,interact,menugear,movement, - playwright,randchar,rpgdice,skilluse,texutil,ui4gh, - congfx,coninfo,conmap,conmenus,context; -{$ENDIF} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + ghmodule, ghsupport, +{$ENDIF PATCH_CHEAT} +{$IFDEF SDLMODE} + sdlgfx,sdlinfo,sdlmap,sdlmenus +{$ELSE SDLMODE} + congfx,coninfo,conmap,conmenus,context +{$ENDIF SDLMODE} + ; const { This array cross-references the RL direction key with } @@ -57,21 +106,93 @@ const var PCACTIONRD_PC: GearPtr; PCACTIONRD_GB: GameBoardPtr; + {$IFDEF PATCH_GH} + PCACTIONRD_Menu: RPGMenuPtr; + PCACTIONRD_MenuMek: GearPtr; + {$ENDIF PATCH_GH} + {$IFDEF ENABLE_ADDRESSBOOK} + PHONE_Name_List: SAttPtr; + LastCalledNPC: String; + {$ENDIF ENABLE_ADDRESSBOOK} + {$IFDEF PATCH_GH} + {$IFDEF PATCH_CHEAT} + Save_Game_Archive_Buf: packed array [0..GZ_Archive_BufLen-1] of byte; { Global uses BSS instead of stack } + {$ENDIF PATCH_CHEAT} + {$ENDIF PATCH_GH} + Procedure PCActionRedraw; { Redraw the map and the PC's info. } +{$IFDEF PATCH_GH} +var + P: Point; + Mek: GearPtr; + MekNum: LongInt; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if Mouse_Active then begin + if IsMouseOnMap and ( not IsMenuActive ) then begin + P := MouseMapPos; + if OnTheMap( P.X , P.Y ) then begin + MouseAtTile( PCACTIONRD_GB , P.X , P.Y ); + DisplayMap( PCACTIONRD_GB ); + end; + end else begin + MouseAtTile( PCACTIONRD_GB , -1 , -1 ); + DisplayMap( PCACTIONRD_GB ); + end; + end; + QuickCombatDisplay( PCACTIONRD_GB ); + Mek := NIL; + if (NIL <> PCACTIONRD_Menu) then begin + MekNum := RPMLocateByPosition(PCACTIONRD_Menu,PCACTIONRD_Menu^.selectitem)^.value; + if (0 <= MekNum) then begin + Mek := RetrieveGearSib( PCACTIONRD_MenuMek, MekNum ); + end; + end else if (NIL <> PCACTIONRD_PC) then begin + Mek := PCACTIONRD_PC; + end; + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + DisplayGearInfo( Mek, PCACTIONRD_GB ); + end; +{$ELSE PATCH_GH} QuickCombatDisplay( PCACTIONRD_GB ); DisplayGearInfo( PCACTIONRD_PC , PCACTIONRD_GB ); +{$ENDIF PATCH_GH} end; Procedure PCSRedraw; { Redraw the map and the PC's info. } begin QuickCombatDisplay( PCACTIONRD_GB ); +{$IFDEF PATCH_GH} + if (NIL <> PCACTIONRD_PC) and (GG_DisposeGear < PCACTIONRD_PC^.G) then begin + DisplayGearInfo( PCACTIONRD_PC , PCACTIONRD_GB ); + end; +{$ELSE PATCH_GH} DisplayGearInfo( PCACTIONRD_PC , PCACTIONRD_GB ); +{$ENDIF PATCH_GH} SetupMemoDisplay; end; -{$ENDIF} +{$ELSE SDLMODE} + {$IFDEF ENABLE_ADDRESSBOOK} +var + PHONE_Name_List: SAttPtr; + LastCalledNPC: String; + {$IFDEF PATCH_GH} + {$IFDEF PATCH_CHEAT} + Save_Game_Archive_Buf: packed array [0..GZ_Archive_BufLen-1] of byte; { Global uses BSS instead of stack } + {$ENDIF PATCH_CHEAT} + {$ENDIF PATCH_GH} + {$ELSE ENABLE_ADDRESSBOOK} + {$IFDEF PATCH_GH} + {$IFDEF PATCH_CHEAT} +var + Save_Game_Archive_Buf: packed array [0..GZ_Archive_BufLen-1] of byte; { Global uses BSS instead of stack } + {$ENDIF PATCH_CHEAT} + {$ENDIF PATCH_GH} + {$ENDIF ENABLE_ADDRESSBOOK} +{$ENDIF SDLMODE} Procedure FHQ_Rename( GB: GameBoardPtr; NPC: GearPtr ); @@ -79,12 +200,23 @@ Procedure FHQ_Rename( GB: GameBoardPtr; var name: String; begin -{$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} +{$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + name := GetStringFromUser( ReplaceHash( MsgString( 'FHQ_Rename_Prompt' ) , GearName( NPC ) ) , @PCActionRedraw , GearName( NPC ) ); + {$ELSE PATCH_GH} name := GetStringFromUser( ReplaceHash( MsgString( 'FHQ_Rename_Prompt' ) , GearName( NPC ) ) , @PCActionRedraw ); -{$ELSE} + {$ENDIF PATCH_GH} +{$ELSE SDLMODE} + {$IFDEF PATCH_GH} + name := GetStringFromUser( ReplaceHash( MsgString( 'FHQ_Rename_Prompt' ) , GearName( NPC ) ) , GearName( NPC ) ); + {$ELSE PATCH_GH} name := GetStringFromUser( ReplaceHash( MsgString( 'FHQ_Rename_Prompt' ) , GearName( NPC ) ) ); + {$ENDIF PATCH_GH} GFCombatDisplay( GB ); -{$ENDIF} +{$ENDIF SDLMODE} if name <> '' then SetSAtt( NPC^.SA , 'name <' + name + '>' ); end; @@ -92,6 +224,10 @@ end; Procedure FHQ_Rejoin( GB: GameBoardPtr; PC,NPC: GearPtr ); { NPC will rejoin the party if there's enough room. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if LancematesPresent( GB ) < LancematePoints( PC ) then begin DialogMsg( ReplaceHash( MsgString( 'REJOIN_OK' ) , GearName( NPC ) ) ); AddLancemate( GB , NPC ); @@ -109,6 +245,9 @@ var M,M2: GearPtr; Gene: String; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} TrainedSome := False; repeat FXP := NAttValue( NPC^.NA , NAG_Experience , NAS_TotalXP ) - NAttValue( NPC^.NA , NAG_Experience , NAS_SpentXP ); @@ -128,7 +267,11 @@ begin if N = 0 then begin AddNAtt( NPC^.NA , NAG_Experience , NAS_SpentXP , SkillAdvCost( NPC , NAttValue( NPC^.NA , NAG_SKill , T ) ) ); AddNAtt( NPC^.NA , NAG_Skill , T , 1 ); +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('AUTOTRAIN_LEARN'), GearName(NPC), I18N_Name('SkillMan',SkillMan[ T ].Name) ) ); +{$ELSE PATCH_I18N} dialogmsg( ReplaceHash( ReplaceHash( MsgString( 'AUTOTRAIN_LEARN' ) , GearName( NPC ) ) , SkillMan[ T ].Name ) ); +{$ENDIF PATCH_I18N} TrainedSome := True; N := 5; end; @@ -147,7 +290,13 @@ begin Gene := UpCase( SATtValue( NPC^.SA , 'GENEPOOL' ) ); N := 0; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if ( UpCase( SAttValue( M^.SA , 'GENEPOOL' ) ) = Gene ) and ( M^.V > NPC^.V ) then Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -158,10 +307,16 @@ begin M2 := Nil; M := WMonList; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} if ( UpCase( SAttValue( M^.SA , 'GENEPOOL' ) ) = Gene ) and ( M^.V > NPC^.V ) then begin Dec( N ); if N = -1 then M2 := M; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -176,7 +331,11 @@ begin { Insert M into the map. } DeployMek( GB , M , True ); +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('AUTOTRAIN','EVOLVE'), GearName(NPC), GearName(M) ) ); +{$ELSE PATCH_I18N} DialogMsg( ReplaceHash( ReplaceHash( MsgString( 'AUTOTRAIN_EVOLVE' ) , GearName( NPC ) ) , GearName( M ) ) ); +{$ENDIF PATCH_I18N} { Copy over name, XP, team, location, and skills. } SetSAtt( M^.SA , 'name <' + GearName( NPC ) + '>' ); @@ -209,8 +368,17 @@ Procedure FHQ_Disassemble( GB: GameBoard { Robot NPC is no longer desired. Disassemble it into spare parts, delete the NPC, } { then give the parts to PC. } var +{$IFDEF PATCH_GH} + M: LongInt; +{$ELSE PATCH_GH} M: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Error check- NPC must be on the gameboard. } if not IsFoundAlongTrack( GB^.Meks , NPC ) then Exit; @@ -228,7 +396,15 @@ begin { Get the spare parts. } NPC := LoadNewSTC( 'SPAREPARTS-1' ); +{$IFDEF PATCH_GH} + if (32767 < (Int64(M) * 5)) then begin + NPC^.V := 32767; + end else begin + NPC^.V := M * 5; + end; +{$ELSE PATCH_GH} NPC^.V := M * 5; +{$ENDIF PATCH_GH} InsertInvCom( PC , NPC ); end; @@ -239,6 +415,11 @@ var RPM: RPGMenuPtr; N: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); if IsSafeArea( GB ) or OnTheMap( NPC ) then AddRPGMenuItem( RPM , MsgString( 'FHQ_LMV_Equip' ) , 1 ); AddRPGMenuItem( RPM , MsgString( 'FHQ_LMV_Train' ) , 2 ); @@ -252,6 +433,11 @@ begin AddRPGMenuItem( RPM , MsgString( 'FHQ_PartEditor' ) , 8 ); AddRPGMenuItem( RPM , MsgString( 'EXIT' ) , -1 ); +{$IFDEF PATCH_CHEAT} + if Cheat_FieldHQ_AddMenuKey then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} repeat {$IFDEF SDLMODE} @@ -306,15 +492,44 @@ Procedure FieldHQ( GB: GameBoardPtr; PC: end; var RPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} M: GearPtr; -begin +{$IFDEF PATCH_CHEAT} + top: LongInt; + sel: LongInt; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} + top := 0; + sel := 0; +{$ENDIF PATCH_CHEAT} repeat { Create the menu. } RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); M := GB^.Meks; N := 1; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin + if ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) then begin + AddRPGMenuItem( RPM , LanceMateMenuName( M ) , N ); + end else if ( NAttValue( M^.NA , NAG_CharDescription , NAS_CharType ) = NAV_CTLancemate ) and ( NAttValue( M^.NA , NAG_Personal , NAS_CID ) = 0 ) Then begin + AddRPGMenuItem( RPM , LanceMateMenuName( M ) , N ); + end else if ( M^.G <> GG_Character ) and ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) then begin + AddRPGMenuItem( RPM , LanceMateMenuName( M ) , N ); + end; + Inc( N ); + end; + M := M^.Next; +{$ELSE PATCH_GH} if ( NAttValue( M^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) then begin AddRPGMenuItem( RPM , LanceMateMenuName( M ) , N ); end else if ( NAttValue( M^.NA , NAG_CharDescription , NAS_CharType ) = NAV_CTLancemate ) and ( NAttValue( M^.NA , NAG_Personal , NAS_CID ) = 0 ) Then begin @@ -324,16 +539,58 @@ begin end; M := M^.Next; Inc( N ); +{$ENDIF PATCH_GH} + end; +{$IFDEF PATCH_CHEAT} + if not(Cheat_FieldHQ_Mecha_NoSort) then begin + RPMSortAlpha( RPM ); + end; + AddRPGMenuItem( RPM, MSgString('EXIT'), -1 ); + if Cheat_FieldHQ_Mecha_AddMenuKey then begin + AlphaKeyMenu( RPM ); + end; + if Cheat_FieldHQ_Mecha_KeepPosition and (0 < sel) then begin + RPM^.TopItem := top; + SetItemByValue( RPM, sel ); + end; + if Cheat_MenuOrder_Edit then begin + AddRPGMenuKey( RPM, KeyMap[ KMC_EditMenuOrder ].KCode, -128 ); end; +{$ELSE PATCH_CHEAT} RPMSortAlpha( RPM ); AddRPGMenuItem( RPM , MSgString( 'EXIT' ) , -1 ); +{$ENDIF PATCH_CHEAT} { Get a selection from the menu. } {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + PCACTIONRD_Menu := RPM; + PCACTIONRD_MenuMek := GB^.Meks; + end; + {$ENDIF PATCH_GH} n := SelectMenu( RPM , @PCActionRedraw ); + {$IFDEF PATCH_GH} + PCACTIONRD_MenuMek := NIL; + PCACTIONRD_Menu := NIL; + {$ENDIF PATCH_GH} {$ELSE} n := SelectMenu( RPM ); {$ENDIF} +{$IFDEF PATCH_CHEAT} + top := RPM^.TopItem; + if 0 < N then begin + sel := N; + end else begin + sel := RPM^.SelectItem; + end; + + if -128 = N then begin + M := RetrieveGearSib( GB^.Meks, RPMLocateByPosition( RPM, RPM^.SelectItem )^.value ); + SwapMenu_NoParent( GB^.Meks, ZONE_Menu, M ); + N := 0; + end; +{$ENDIF PATCH_CHEAT} DisposeRPGMenu( RPM ); if N > 0 Then begin @@ -357,12 +614,19 @@ var T: String; P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { First record the PC's current position, for future reference. } P := GearCurrentLocation( Mek ); { Look through all the gears on the board, searching for metaterrain. } MT := GB^.Meks; while MT <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < MT^.G) then begin +{$ENDIF PATCH_GH} { If this terrain matches our basic criteria, } { we'll perform the next few tests. } if ( MT^.G = GG_MetaTerrain ) and ( MT^.Stat[ STAT_MetaVisibility ] > 0 ) and ( Range( MT , P.X , P.Y ) <= 1 ) then begin @@ -375,6 +639,9 @@ begin VisionCheck( GB , Mek ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} MT := MT^.Next; end; @@ -386,6 +653,10 @@ Procedure PCSearch( GB: GameBoardPtr; PC var Mek: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Costs one point of MENTAL and an action. } AddMentalDown( PC , 1 ); WaitAMinute( GB , PC , ReactionTime( PC ) ); @@ -396,12 +667,18 @@ begin { to being spotted himself. } Mek := GB^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if OnTheMap( Mek ) and not MekCanSeeTarget( GB , PC , Mek ) then begin if IsMasterGear( Mek ) and CheckLOS( GB , PC , Mek ) then begin { The mek has just been spotted. } RevealMek( GB , Mek , PC ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; CheckHiddenMetaTerrain( GB , PC ); @@ -414,6 +691,10 @@ var MainMenu: RPGMenuPtr; CRating,A: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + CRating := PCommRating( PC ); if CRating < 1 then begin DialogMsg( MsgString( 'MEMO_NoBrowser' ) ); @@ -455,6 +736,10 @@ end; Function InterfaceType( GB: GameBoardPtr; Mek: GearPtr ): Integer; { Return the constant for the currently-being-used control type. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(WorldMapMethod); +{$ENDIF PATCH_GH} + if GB^.Scale > 2 then begin InterfaceType := WorldMapMethod; end else if Mek^.G = GG_Character then begin @@ -467,19 +752,51 @@ end; Procedure DoTalkingWIthNPC( GB: GameBoardPtr; PC,NPC: GearPtr; ByTelephone: Boolean ); { Actually handle the talking with an NPC already selected. } var +{$IFDEF PATCH_GH} + Mek: GearPtr; +{$ENDIF PATCH_GH} Persona: GearPtr; CID: Integer; React: Integer; ReTalk: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + Mek := NIL; + if ( GG_Character = NPC^.G ) then begin + Mek := FindRoot( NPC ); + if ( Mek = NPC ) then begin + Mek := NIL; + end; + end else begin + Mek := NPC; + NPC := LocatePilot( NPC ); + end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + if ( NPC <> Nil ) and GearActive( NPC ) + and ( GearOperational( Mek ) or ( (0 <> NAttValue(NPC^.NA, NAG_Location, NAS_X)) and (0 <> NAttValue(NPC^.NA, NAG_Location, NAS_Y)) ) ) then begin +{$ELSE PATCH_GH} if ( NPC <> Nil ) and GearActive( NPC ) then begin +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + if ByTelephone or ( NIL <> Mek ) or ( Range( GB , PC , NPC ) < 5 ) or (Cheat_Chat and HasPCommCapability( PC , PCC_Comm )) then begin +{$ELSE PATCH_CHEAT} if ByTelephone or ( Range( GB , PC , NPC ) < 5 ) then begin +{$ENDIF PATCH_CHEAT} CID := NAttValue( NPC^.NA , NAG_Personal , NAS_CID ); if CID <> 0 then begin { Everything should be okay to talk... Now see if the NPC wants to. } { Determine the NPC's RETALK and REACT values. } ReTalk := NAttValue( NPC^.NA , NAG_Personal , NAS_Retalk ); React := ReactionScore( GB^.Scene , PC , NPC ); +{$IFDEF ENABLE_ADDRESSBOOK} + SetSAtt( PC^.SA , 'REDIAL <' + GearName( NPC ) + '>' ); +{$ENDIF ENABLE_ADDRESSBOOK} if NAttValue( NPC^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam then begin Persona := lancemate_tactics_persona; @@ -490,41 +807,82 @@ begin { If the NPC really doesn't like the PC, } { they'll refuse to talk on principle. } if ( ( React + RollStep( SkillValue ( PC , 28 ) ) ) < -Random( 120 ) ) or AreEnemies( GB , NPC , PC ) then begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('DoTalkingWithNPC','doesnt talk'), GearName(NPC) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( NPC ) + ' doesn''t want to talk to you.' ); +{$ENDIF PATCH_I18N} SetNAtt( NPC^.NA , NAG_Personal , NAS_Retalk , GB^.ComTime + 1500 ); { If the NPC is ready to talk, is friendly with the PC, or has a PERSONA gear defined, } { they'll be willing to talk. } end else if ( ReTalk < GB^.ComTime ) or ( Random( 50 ) < ( React + 20 ) ) or ( Persona <> Nil ) then begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('DoTalkingWithNPC','conversation'), GearName(NPC) ) ); +{$ELSE PATCH_I18N} DialogMsg( 'You strike up a conversation with ' + GearName( NPC ) + '.' ); +{$ENDIF PATCH_I18N} HandleInteract( GB , PC , NPC , Persona ); GFCombatDisplay( gb ); DisplayGearInfo( PC , GB ); end else begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('DoTalkingWithNPC','doesnt talk now'), GearName(NPC) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( NPC ) + ' doesn''t want to talk right now.' ); +{$ENDIF PATCH_I18N} end; end else begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('DoTalkingWithNPC','No response') ); +{$ELSE PATCH_I18N} DialogMsg( 'No response!' ); +{$ENDIF PATCH_I18N} end; end else begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('DoTalkingWithNPC','too far away'), GearName(NPC) ) ); +{$ELSE PATCH_I18N} DialogMsg( 'You''re too far away to talk with ' + GearName( NPC ) + '.' ); +{$ENDIF PATCH_I18N} end; end else begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('DoTalkingWithNPC','Not found') ); +{$ELSE PATCH_I18N} DialogMsg( 'Not found!' ); +{$ENDIF PATCH_I18N} end; end; Procedure PCTalk( GB: GameBoardPtr; PC: GearPtr ); { PC wants to do some talking. Select an NPC, then let 'er rip. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('PCTalk','Select') ); +{$ELSE PATCH_I18N} DialogMsg( 'Select a character to talk with.' ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + if LookAround( GB , PC ) and (NIL <> LOOKER_Gear) then begin + { LOOKER_Gear is a returned value by LookAround(). } +{$ELSE PATCH_GH} if LookAround( GB , PC ) then begin +{$ENDIF PATCH_GH} DoTalkingWithNPC( GB , PC , LOOKER_Gear , False ); end else begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('PCTalk','cancelled') ); +{$ELSE PATCH_I18N} DialogMsg( 'Talking cancelled.' ); +{$ENDIF PATCH_I18N} end; end; @@ -534,21 +892,40 @@ var Name: String; NPC: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if HasPCommCapability( PC , PCC_Comm ) then begin DialogMsg( MsgString( 'PHONE_Prompt' ) ); {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + Name := GetStringFromUser( MsgString( 'PHONE_GetName' ) , @PCActionRedraw , SAttValue( PC^.SA , 'REDIAL' ) ); + {$ELSE PATCH_GH} Name := GetStringFromUser( MsgString( 'PHONE_GetName' ) , @PCActionRedraw ); -{$ELSE} + {$ENDIF PATCH_GH} +{$ELSE SDLMODE} + {$IFDEF PATCH_GH} + Name := GetStringFromUser( MsgString( 'PHONE_GetName' ) , SAttValue( PC^.SA , 'REDIAL' ) ); + {$ELSE PATCH_GH} Name := GetStringFromUser( MsgString( 'PHONE_GetName' ) ); -{$ENDIF} + {$ENDIF PATCH_GH} +{$ENDIF SDLMODE} if Name = '*' then Name := SAttValue( PC^.SA , 'REDIAL' ) +{$IFDEF PATCH_JPSSDL} + else if Name <> '' then SetSAtt( PC^.SA , 'REDIAL <' + Name + '>' ); +{$ELSE PATCH_JPSSDL} else SetSAtt( PC^.SA , 'REDIAL <' + Name + '>' ); +{$ENDIF PATCH_JPSSDL} if Name <> '' then begin NPC := SeekGearByName( GB^.Meks , Name ); if NPC = Nil then NPC := FindNPCByKeyword( GB , Name ); if NPC <> Nil then begin +{$IFDEF ENABLE_ADDRESSBOOK} + SetSAtt( PC^.SA , 'REDIAL <' + Name + '>' ); +{$ENDIF ENABLE_ADDRESSBOOK} DoTalkingWithNPC( GB , PC , NPC , True ); end else begin DialogMsg( ReplaceHash( MsgString( 'PHONE_NotFound' ) , Name ) ); @@ -562,9 +939,224 @@ begin end; end; +{$IFDEF ENABLE_ADDRESSBOOK} +Procedure LoadAddressBook( Filename: String ); +begin + PHONE_Name_List := LoadStringList( Filename ); +end; + +Function PCSelectNameFromAddressBook( Msg: String ): Integer; + { Select a name from address book. } +var + RPM: RPGMenuPtr; + N: Integer; + List: SAttPtr; + Name, Desc: String; + t: Integer; +begin + t := 1; + List := PHONE_Name_List; + RPM := CreateRPGMenu( MenuItem, MenuSelect, ZONE_Menu2 ); + RPM^.dtexcolor := InfoGreen; +{$IFDEF SDLMODE} + AttachMenuDesc( RPM , ZONE_Info ); +{$ELSE} + AttachMenuDesc( RPM , ZONE_SubInfo ); +{$ENDIF} + CMessage( Msg , ZONE_Menu1 , InfoHilight ); + + { Add names in address book into menu. } + while List <> Nil do begin + Name := List^.info; + Desc := RetrieveAString( Name ); + Name := RetrieveAPreamble( Name ); + AddRPGMenuItem( RPM, Name, t, Desc ); + Inc(t); + List := List^.next; + end; + + AddRPGMenuItem( RPM, ' [cancel]', -1 ); +{$IFDEF SDLMODE} + N := SelectMenu( RPM, Nil ); +{$ELSE} + N := SelectMenu( RPM ); +{$ENDIF} + + DisposeRPGMenu( RPM ); + PCSelectNameFromAddressBook := N; +end; + +Procedure PCAddressBookCall( GB:GameBoardPtr; PC: GearPtr ); + { Make a call from address book. } +var + N: Integer; + Name: String; + Rec: SAttPtr; + NPC: GearPtr; +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + + N := PCSelectNameFromAddressBook( MsgString( 'PHONE_GetName' ) ); + Rec := RetrieveSAtt( PHONE_Name_List, N ); + if ( Rec = Nil ) then exit; + + Name := RetrieveAPreamble( Rec^.info ); + + if ( Name <> '' ) then begin + NPC := SeekGearByName( GB^.Meks, Name ); + if NPC = Nil then begin + Name := ExtractWord( Name ); + NPC := FindNPCByKeyword( GB , Name ); + end; + if ( NPC <> Nil ) then begin + SetSAtt( PC^.SA , 'REDIAL <' + Name + '>' ); + DoTalkingWithNPC( GB , PC , NPC , True ); + end else begin + DialogMsg( ReplaceHash( MsgString( 'PHONE_NotFound' ) , Name ) ) + end; + end; + GFCombatDisplay( gb ); +end; + +Procedure PCAddressBookAdd( GB: GameBoardPtr; PC: GearPtr ); + { Add a record to address book. } +var + Name, Desc: String; +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + Name := GetStringFromUser( I18N_MsgString('PCAddressBookAdd','PHONE_AddName') , @PCActionRedraw , SAttValue( PC^.SA , 'REDIAL' ) ); + {$ELSE PATCH_GH} + Name := GetStringFromUser( I18N_MsgString('PCAddressBookAdd','PHONE_AddName') , @PCActionRedraw); + {$ENDIF PATCH_GH} +{$ELSE SDLMODE} + {$IFDEF PATCH_GH} + Name := GetStringFromUser( I18N_MsgString('PCAddressBookAdd','PHONE_AddName') , SAttValue( PC^.SA , 'REDIAL' ) ); + {$ELSE PATCH_GH} + Name := GetStringFromUser( I18N_MsgString('PCAddressBookAdd','PHONE_AddName') ); + {$ENDIF PATCH_GH} +{$ENDIF SDLMODE} + if ( Name <> '' ) then begin + GFCombatDisplay( gb ); +{$IFDEF SDLMODE} + Desc := GetStringFromUser( I18N_MsgString('PCAddressBookAdd','PHONE_AddDesc' ) , @PCActionRedraw ); +{$ELSE SDLMODE} + Desc := GetStringFromUser( I18N_MsgString('PCAddressBookAdd','PHONE_AddDesc' ) ); +{$ENDIF SDLMODE} + DialogMsg( Name ); + DialogMsg( Desc ); + StoreSAtt( PHONE_Name_List, Name + ' <' + Desc +'>'); + end; + GFCombatDisplay( gb ); +end; + +Procedure PCAddressBookDelete; + { Delete a record from address book. } +var + N: Integer; + RecordToDelete: SAttPtr; +begin + N := PCSelectNameFromAddressBook( MsgString( 'PHONE_GetNameToDelete' ) ); + if ( N = -1 ) then exit; + + RecordToDelete := RetrieveSAtt( PHONE_Name_List, N ); + if ( RecordToDelete <> Nil ) then begin + RemoveSAtt( PHONE_Name_List, RecordToDelete ); +{$IFDEF PATCH_GH} + PurgeSAtt( PHONE_Name_List ); +{$ENDIF PATCH_GH} + end; +end; + +Procedure PCAddressBookRedial( GB: GameBoardPtr; PC: GearPtr ); +var + NPC: GearPtr; + LC: String; +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + + LC := SAttValue( PC^.SA , 'REDIAL' ); + if ( LC <> '' ) then begin + NPC := SeekGearByName( GB^.Meks, LC ); + if ( NPC <> Nil ) then begin + DoTalkingWithNPC( GB , PC , NPC , True ); + end else begin + DialogMsg( ReplaceHash( MsgString( 'PHONE_NotFound' ) , LC ) ) + end; + end; +end; + +Procedure PCAddressBook( GB: GameBoardPtr; PC: GearPtr ); + { Use a address book. PC must has a telephone. } +var + RPM: RPGMenuPtr; + N: Integer; +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + + if HasPCommCapability( PC , PCC_Comm ) then begin + + RPM := CreateRPGMenu( MenuItem, MenuSelect, ZONE_Menu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM, I18N_MsgString('PCAddressBook','call'), 1 ); + AddRPGMenuItem( RPM, I18N_MsgString('PCAddressBook','add'), 2 ); + {AddRPGMenuItem( RPM, I18N_MsgString('PCAddressBook','edit'), 3 );} + AddRPGMenuItem( RPM, I18N_MsgString('PCAddressBook','delete'), 4 ); + if ( SAttValue( PC^.SA , 'REDIAL' ) <> '' ) then begin + AddRPGMenuItem( RPM, I18N_MsgString('PCAddressBook','redial'), 5 ); + end; + AddRPGMenuItem( RPM, I18N_MsgString('PCAddressBook','cancel'), -1 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( RPM, 'call', 1 ); + AddRPGMenuItem( RPM, 'add', 2 ); + {AddRPGMenuItem( RPM, 'edit', 3 );} + AddRPGMenuItem( RPM, 'delete', 4 ); + if ( SAttValue( PC^.SA , 'REDIAL' ) <> '' ) then begin + AddRPGMenuItem( RPM, 'redial', 5 ); + end; + AddRPGMenuItem( RPM, ' [cancel]', -1 ); +{$ENDIF PATCH_I18N} + AlphaKeyMenu( RPM ); + + repeat +{$IFDEF SDLMODE} + N := SelectMenu( RPM, Nil ); +{$ELSE} + N := SelectMenu( RPM ); +{$ENDIF} + case N of + 1: PCAddressBookCall( GB, PC ); + 2: PCAddressBookAdd( GB, PC ); + {3: PCAddressBookEdit( GB );} + 4: PCAddressBookDelete; + 5: PCAddressBookRedial( GB, PC ); + end; + until N = -1; + DisposeRPGMenu( RPM ); + end else begin + DialogMsg( MsgString( 'PHONE_NoPhone' ) ); + end; +end; +{$ENDIF ENABLE_ADDRESSBOOK} + Procedure UsePropFrontEnd( GB: GameBoardPtr; PC , Prop: GearPtr; T: String ); { Do everything that needs to be done when a prop is used. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Prop) or (Prop^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + TriggerGearScript( GB , Prop , T ); VisionCheck( GB , PC ); WaitAMinute( GB , PC , ReactionTime( PC ) ); @@ -639,6 +1231,10 @@ var D,PropD: Integer; P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { See whether or not there's only one prop to use. } PropD := -1; P := GearCurrentLocation( PC ); @@ -652,15 +1248,29 @@ begin if PropD < 0 then begin DialogMsg( MsgString( 'PCUS_Prompt' ) ); {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + PropD := DirKey( P, @PCActionRedraw ); + {$ELSE PATCH_GH} PropD := DirKey( @PCActionRedraw ); + {$ENDIF PATCH_GH} {$ELSE} PropD := DirKey; {$ENDIF} end; +{$IFDEF PATCH_GH} + if (0 <= PropD) then begin + if not ActivatePropAtSpot( GB , PC , P.X + DirKeyAngDir[ PropD , 1 ] , P.Y + DirKeyAngDir[ PropD , 2 ] , 'USE' ) then begin + DialogMsg( MsgString( 'PCUS_NotFound' ) ); + end; + end else begin + DialogMsg( I18N_MsgString( 'pcaction', 'Cancelled' ) ); + end; +{$ELSE PATCH_GH} if PropD > -1 then begin if not ActivatePropAtSpot( GB , PC , P.X + AngDir[ PropD , 1 ] , P.Y + AngDir[ PropD , 2 ] , 'USE' ) then DialogMsg( MsgString( 'PCUS_NotFound' ) ); end; +{$ENDIF PATCH_GH} end; Procedure PCEnter( GB: GameBoardPtr; PC: GearPtr ); @@ -669,6 +1279,10 @@ Procedure PCEnter( GB: GameBoardPtr; PC: var P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + P := GearCurrentLocation( PC ); if not ActivatePropAtSpot( GB , PC , P.X , P.Y , 'USE' ) then DialogMsg( MsgString( 'PCUS_NotFound' ) );; end; @@ -680,15 +1294,47 @@ var P: Point; Trigger: String; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + P := GearCurrentLocation( PC ); DialogMsg( MsgString( 'PCUSOP_Prompt' ) ); {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + PropD := DirKey( P, @PCActionRedraw ); + {$ELSE PATCH_GH} PropD := DirKey( @PCActionRedraw ); + {$ENDIF PATCH_GH} {$ELSE} PropD := DirKey; {$ENDIF} Trigger := 'CLUE' + BStr( Skill ); +{$IFDEF PATCH_GH} + if (0 <= PropD) then begin + if (0 < NumVisibleUsableGearsXY( GB , P.X + DirKeyAngDir[ PropD , 1 ] , P.Y + DirKeyAngDir[ PropD , 2 ] , Trigger )) then begin + if not ActivatePropAtSpot( GB , PC , P.X + DirKeyAngDir[ PropD , 1 ] , P.Y + DirKeyAngDir[ PropD , 2 ] , Trigger ) then begin + DialogMsg( MsgString( 'PCUS_NotFound' ) );; + end; + end else if (NIL <> GB^.Scene) then begin + if (GB^.Scene^.G <= GG_DisposeGear) then begin + {$IFDEF DEBUG} + ErrorMessage_fork('ERROR: GB^.Scene is GG_DisposeGear in PCUseSkillOnProp' + IntToHex(Int64(GB^.Scene), 16) + ', Skill:' + BStr(Skill) + '.'); + {$ENDIF DEBUG} + DialogMsg('ERROR: GB^.Scene is GG_DisposeGear in PCUseSkillOnProp' + IntToHex(Int64(GB^.Scene), 16) + ', Skill:' + BStr(Skill) + '.'); + end; + if TriggerGearScript( GB , GB^.Scene , Trigger ) then begin + end else begin + DialogMsg( MsgString( 'PCUS_NotFound' ) );; + end; + end else begin + DialogMsg( MsgString( 'PCUS_NotFound' ) );; + end; + end else begin + DialogMsg( I18N_MsgString( 'pcaction', 'Cancelled' ) ); + end; +{$ELSE PATCH_GH} if ( PropD = -1 ) and ( NumVisibleUsableGearsXY( GB , P.X , P.Y , Trigger ) > 0 ) then begin if not ActivatePropAtSpot( GB , PC , P.X , P.Y , Trigger ) then DialogMsg( MsgString( 'PCUS_NotFound' ) );; end else if ( PropD <> -1 ) and ( NumVisibleUsableGearsXY( GB , P.X + AngDir[ PropD , 1 ] , P.Y + AngDir[ PropD , 2 ] , Trigger ) > 0 ) then begin @@ -696,36 +1342,68 @@ begin end else if GB^.Scene <> Nil then begin TriggerGearScript( GB , GB^.Scene , Trigger ); end; +{$ENDIF PATCH_GH} end; Procedure DoPCRepair( GB: GameBoardPtr; PC: GearPtr; Skill: Integer ); { The PC is going to use one of the repair skills. Call the } { standard procedure, then print output. } var +{$IFDEF PATCH_GH} + D: Integer; + Best: LongInt; +{$ELSE PATCH_GH} D,Best: Integer; +{$ENDIF PATCH_GH} P: Point; Mek,Target: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + DialogMsg( MsgString( 'PCREPAIR_Prompt' ) ); -{$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + D := DirKey( P, @PCActionRedraw ); + {$ELSE SDLMODE} + D := DirKey; + {$ENDIF SDLMODE} + P := GearCurrentLocation( PC ); + if (0 <= D) then begin + P.X := P.X + DirKeyAngDir[ D , 1 ]; + P.Y := P.Y + DirKeyAngDir[ D , 2 ]; + end else begin + DialogMsg( I18N_MsgString( 'pcaction', 'Cancelled' ) ); + Exit; + end; +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} D := DirKey( @PCActionRedraw ); -{$ELSE} + {$ELSE} D := DirKey; -{$ENDIF} + {$ENDIF} P := GearCurrentLocation( PC ); if D <> -1 then begin P.X := P.X + AngDir[ D , 1 ]; P.Y := P.Y + AngDir[ D , 2 ]; end; +{$ENDIF PATCH_GH} Mek := GB^.Meks; Target := Nil; Best := 0; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if ( not AreEnemies( GB , PC , Mek ) ) and ( TotalRepairableDamage( Mek , Skill ) > Best ) and ( NAttValue( Mek^.NA , NAG_Location , NAS_X ) = P.X ) and ( NAttValue( Mek^.NA , NAG_Location , NAS_Y ) = P.Y ) then begin Target := Mek; Best := TotalRepairableDamage( Mek , Skill ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} mek := mek^.Next; end; if Target <> Nil then begin @@ -743,6 +1421,10 @@ Procedure StartPerforming( GB: GameBoard var Instrument: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + Instrument := SeekBestInstrument( PC ); if Instrument <> Nil then begin StartContinuousUseItem( GB , PC , Instrument ); @@ -759,6 +1441,10 @@ var Ingredients,Robot: GearPtr; T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if CurrentMental( PC ) < 1 then begin DialogMsg( MsgString( 'BUILD_ROBOT_TOO_TIRED' ) ); Exit; @@ -803,7 +1489,11 @@ begin { Give the PC a rundown on the new robot's skills. } for t := 1 to Num_Robot_Skill do begin if NAttValue( Robot^.NA , NAG_Skill , Robot_Skill[ T ] ) > 0 then begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('BUILD_ROBOT_SKILL'), GearName(Robot), I18N_Name('SkillMan',SkillMan[ Robot_Skill[ t ] ].Name) ) ); +{$ELSE PATCH_I18N} DialogMsg( ReplaceHash( ReplaceHash( MsgString( 'BUILD_ROBOT_SKILL' ) , GearName( Robot ) ) , SkillMan[ Robot_Skill[ t ] ].Name ) ); +{$ENDIF PATCH_I18N} end; end; end; @@ -815,6 +1505,9 @@ Procedure DominateAnimal( GB: GameBoardP Function IsGoodTarget( M: GearPtr ): Boolean; { Return TRUE if M is a good target for domination, or FALSE otherwise. } begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if GearActive( M ) and AreEnemies( GB , M , PC ) and ( NAttValue( M^.NA , NAG_PErsonal , NAS_CID ) = 0 ) then begin IsGoodTarget := True; end else if GearActive( M ) and ( NAttValue( M^.NA , NAG_PErsonal , NAS_CID ) = 0 ) and ( NAttValue( M^.NA , NAG_CharDescription , NAS_CharType ) = NAV_CTLancemate ) and ( NAttValue( M^.NA , NAG_Location , NAS_Team ) <> NAV_LancemateTeam ) then begin @@ -828,6 +1521,10 @@ var SkTarget,SkRoll: Integer; P,P2: Point; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if CurrentMental( PC ) < 1 then begin DialogMsg( MsgString( 'DOMINATE_TOO_TIRED' ) ); Exit; @@ -841,6 +1538,9 @@ begin Target := Nil; D := 0; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} { Two types of animal may be dominated: those which are hostile } { to the PC, and those which are already his pets. } P2 := GearCurrentLocation( M ); @@ -848,27 +1548,51 @@ begin Target := M; Inc( D ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; { If more than one monster was found, prompt for a direction. } if D > 1 then begin DialogMsg( MsgString( 'DOMINATE_Prompt' ) ); -{$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + D := DirKey( P, @PCActionRedraw ); + {$ELSE SDLMODE} + D := DirKey; + {$ENDIF SDLMODE} + if (0 <= D) then begin + P.X := P.X + DirKeyAngDir[ D , 1 ]; + P.Y := P.Y + DirKeyAngDir[ D , 2 ]; + end else begin + DialogMsg( I18N_MsgString( 'pcaction', 'Cancelled' ) ); + Exit; + end; +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} D := DirKey( @PCActionRedraw ); -{$ELSE} + {$ELSE} D := DirKey; -{$ENDIF} + {$ENDIF} P.X := P.X + AngDir[ D , 1 ]; P.Y := P.Y + AngDir[ D , 2 ]; +{$ENDIF PATCH_GH} M := GB^.Meks; Target := Nil; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} { Two types of animal may be dominated: those which are hostile } { to the PC, and those which are already his pets. } P2 := GearCurrentLocation( M ); if ( P2.X = P.X ) and ( P2.Y = P.Y ) and IsGoodTarget( M ) then Target := M; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end; @@ -933,6 +1657,9 @@ Procedure PickPockets( GB: GameBoardPtr; var Team: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} if GearActive( M ) and ( M^.G = GG_Character ) and ( NAttValue( M^.NA , NAG_PErsonal , NAS_CID ) <> 0 ) then begin Team := NAttValue( M^.NA , NAG_Location , NAS_Team ); IsGoodTarget := ( Team <> NAV_DefPlayerTeam ) and ( Team <> NAV_LancemateTeam ); @@ -947,6 +1674,10 @@ var P,P2: Point; Cash,NID: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if CurrentMental( PC ) < 1 then begin DialogMsg( MsgString( 'PICKPOCKET_TOO_TIRED' ) ); Exit; @@ -960,30 +1691,57 @@ begin Target := Nil; D := 0; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} P2 := GearCurrentLocation( M ); if ( Abs( P2.X - P.X ) <= 1 ) and ( Abs( P2.Y - P.Y ) <= 1 ) and IsGoodTarget( M ) then begin Target := M; Inc( D ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; { If more than one monster was found, prompt for a direction. } if D > 1 then begin DialogMsg( MsgString( 'PICKPOCKET_Prompt' ) ); -{$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + D := DirKey( P, @PCActionRedraw ); + {$ELSE SDLMODE} + D := DirKey; + {$ENDIF SDLMODE} + if (0 <= D) then begin + P.X := P.X + DirKeyAngDir[ D , 1 ]; + P.Y := P.Y + DirKeyAngDir[ D , 2 ]; + end else begin + DialogMsg( I18N_MsgString( 'pcaction', 'Cancelled' ) ); + Exit; + end; +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} D := DirKey( @PCActionRedraw ); -{$ELSE} + {$ELSE} D := DirKey; -{$ENDIF} + {$ENDIF} P.X := P.X + AngDir[ D , 1 ]; P.Y := P.Y + AngDir[ D , 2 ]; +{$ENDIF PATCH_GH} M := GB^.Meks; Target := Nil; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} P2 := GearCurrentLocation( M ); if ( P2.X = P.X ) and ( P2.Y = P.Y ) and IsGoodTarget( M ) then Target := M; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end; @@ -1025,7 +1783,11 @@ begin NID := NAttValue( M^.NA , NAG_Narrative , NAS_NID ); if NID <> 0 then SetTrigger( GB , TRIGGER_GetItem + BStr( NID ) ); +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('PICKPOCKET','CASH+ITEM'), BStr(Cash), GearName(M) ) ); +{$ELSE PATCH_I18N} DialogMsg( ReplaceHash( ReplaceHash( MsgString( 'PICKPOCKET_CASH+ITEM' ) , BStr( Cash ) ) , GearName( M ) ) ); +{$ENDIF PATCH_I18N} end else begin DialogMsg( ReplaceHash( MsgString( 'PICKPOCKET_CASH' ) , BStr( Cash ) ) ); end; @@ -1081,9 +1843,17 @@ begin { Add all usable skills to the list, as long as the PC knows them. } for N := 1 to NumSkill do begin if ( SkillMan[ N ].Usage = USAGE_Clue ) and ( TeamHasSkill( GB , NAV_DefPlayerTeam , N ) or HasTalent( PC , NAS_JackOfAll ) ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_Name('SkillMan',SkillMan[N].Name) , N , SkillDesc( N ) ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , SkillMan[N].Name , N , SkillDesc( N ) ); +{$ENDIF PATCH_I18N} end else if ( SkillMan[ N ].Usage > 0 ) and HasSkill( PC , N ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_Name('SkillMan',SkillMan[N].Name) , N , SkillDesc( N ) ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , SkillMan[N].Name , N , SkillDesc( N ) ); +{$ENDIF PATCH_I18N} end; end; RPMSortAlpha( RPM ); @@ -1126,6 +1896,9 @@ var Plot: GearPtr; F: text; begin +{$IFDEF PATCH_GH} + if (NIL = Scene) or (Scene^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if ( scene = Nil ) or ( Scene^.Parent = Nil ) then exit; { Create a menu listing all the units in the SaveGame directory. } RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); @@ -1133,7 +1906,11 @@ begin if RPM^.NumItem > 0 then begin RPMSortAlpha( RPM ); +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('ForcePlot','Select') ); +{$ELSE PATCH_I18N} DialogMSG('Select plot file to load.'); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} pname := SelectFile( RPM , @PCActionRedraw ); {$ELSE} @@ -1142,12 +1919,24 @@ begin if pname <> '' then begin Assign( F , Series_Directory + pname ); reset(F); +{$IFDEF PATCH_GH} + Plot := ReadGear(F, Series_Directory + pname); +{$ELSE PATCH_GH} Plot := ReadGear(F); +{$ENDIF PATCH_GH} Close(F); if InsertPlot( FindRoot( Scene ) , Plot , True , GB ) then begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('ForcePlot','successfully') ); +{$ELSE PATCH_I18N} DialogMsg( 'Plot successfully loaded.' ); +{$ENDIF PATCH_I18N} end else begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('ForcePlot','rejected') ); +{$ELSE PATCH_I18N} DialogMsg( 'Plot rejected.' ); +{$ENDIF PATCH_I18N} end; end; end; @@ -1165,21 +1954,159 @@ begin Dialogmsg( MsgString( 'SAVEGAME_NoGood' ) ); Exit; end; +{$IFDEF PATCH_I18N} + { Output DEBUG info. } + SetSAtt( GG_LocatePC( Camp^.GB )^.SA, Version_Running_TAG + ' <' + Version_all + '>' ); +{$ENDIF PATCH_I18N} { Find the PC's name, open the file, and save. } +{$IFDEF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_Autosave_with_Timestamp and not(PrintMsg) then begin + Name := Save_Campaign_Base + TextEncode(PilotName( PC )) + '_' + TextEncode_(TimeString( Camp^.GB^.ComTime )) + Default_File_Ending; + end else begin + Name := Save_Campaign_Base + TextEncode(PilotName( PC ) + Default_File_Ending); + end; +{$ELSE PATCH_CHEAT} + Name := Save_Campaign_Base + TextEncode(PilotName( PC ) + Default_File_Ending); +{$ENDIF PATCH_CHEAT} +{$ELSE PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_Autosave_with_Timestamp and not(PrintMsg) then begin + Name := Save_Campaign_Base + PilotName( PC ) + '_' + TimeString( Camp^.GB^.ComTime ) + Default_File_Ending; + end else begin + Name := Save_Campaign_Base + PilotName( PC ) + Default_File_Ending; + end; +{$ELSE PATCH_CHEAT} Name := Save_Campaign_Base + PilotName( PC ) + Default_File_Ending; +{$ENDIF PATCH_CHEAT} +{$ENDIF PATCH_I18N} Assign( F , Name ); Rewrite( F ); WriteCampaign( Camp , F ); Close( F ); +{$IFDEF ENABLE_ADDRESSBOOK} +{$IFDEF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_Autosave_with_Timestamp and not(PrintMsg) then begin + Name := Save_Campaign_AddressBook_Base + TextEncode(PilotName( PC )) + '_' + TextEncode_(TimeString( Camp^.GB^.ComTime )) + Default_File_Ending; + end else begin + Name := Save_Campaign_AddressBook_Base + TextEncode(PilotName( PC ) + Default_File_Ending); + end; +{$ELSE PATCH_CHEAT} + Name := Save_Campaign_AddressBook_Base + TextEncode(PilotName( PC ) + Default_File_Ending); +{$ENDIF PATCH_CHEAT} +{$ELSE PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_Autosave_with_Timestamp and not(PrintMsg) then begin + Name := Save_Campaign_AddressBook_Base + PilotName( PC ) + '_' + TimeString( Camp^.GB^.ComTime ) + Default_File_Ending; + end else begin + Name := Save_Campaign_AddressBook_Base + PilotName( PC ) + Default_File_Ending; + end; +{$ELSE PATCH_CHEAT} + Name := Save_Campaign_AddressBook_Base + PilotName( PC ) + Default_File_Ending; +{$ENDIF PATCH_CHEAT} +{$ENDIF PATCH_I18N} + SaveStringList( Name, PHONE_Name_List ); +{$ENDIF ENABLE_ADDRESSBOOK} { Let the player know that everything went fine. } if PrintMsg then Dialogmsg( MsgString( 'SAVEGAME_OK' ) ); +{$IFDEF DEBUG} + ErrorMessage_fork('SaveCampaign: "' + Name + '".' ); +{$ENDIF DEBUG} end; +{$IFDEF PATCH_CHEAT} +Procedure PCSaveCampaign_for_Trace( Camp: CampaignPtr; PC: gearPtr ); + { Save the campaign and all associated info to disk. } + {$IFDEF PATCH_GH} + Function compress( InFileName: String ): Boolean; + const + OutMode: String = 'w9'; + var + OutFileName: String; + InFile: File; + OutFile: gzFile; + len: Cardinal; + err: integer; + begin + Assign( InFile , InFileName ); + Reset( InFile , 1 ); + + OutFileName := InFileName + GZ_Archive_Suffix; + OutFile := gzopen( OutFileName , OutMode ); + + while True do begin + blockread( InFile , Save_Game_Archive_Buf, GZ_Archive_BufLen , len ); + if ( 0 = len ) then begin + compress := True; + break; + end; + + if ( gzwrite( OutFile , @Save_Game_Archive_Buf, len ) <> len ) then begin + compress := False; + ErrorMessage('SaveCampaign Failed : ' + gzerror( OutFile , err ) ); + break; + end; + end; + + gzclose( OutFile ); + Close( InFile ); + end; + {$ENDIF PATCH_GH} +var + Name: String; + F: Text; +begin + { Decide whether or not CAMP is suitable to be saved. } + if ( Camp = Nil ) or ( Camp^.GB = Nil ) or ( Camp^.GB^.Scene = Nil ) then begin + Dialogmsg( MsgString( 'SAVEGAME_NoGood' ) ); + Exit; + end; +{$IFDEF PATCH_I18N} + { Output DEBUG info. } + SetSAtt( GG_LocatePC( Camp^.GB )^.SA, Version_Running_TAG + ' <' + Version_all + '>' ); +{$ENDIF PATCH_I18N} + + { Find the PC's name, open the file, and save. } +{$IFDEF PATCH_I18N} + Name := Save_Campaign_Base + TextEncode(PilotName( PC )) + '.' + TextEncode_(TimeString( Camp^.GB^.ComTime )) + Default_File_Ending; +{$ELSE PATCH_I18N} + Name := Save_Campaign_Base + PilotName( PC ) + '.' + TimeString( Camp^.GB^.ComTime ) + Default_File_Ending; +{$ENDIF PATCH_I18N} + Assign( F , Name ); + Rewrite( F ); + WriteCampaign( Camp , F ); + Close( F ); + + {$IFDEF PATCH_GH} + if compress( Name ) then begin + Assign( F , Name ); + Erase( F ); + {$IFDEF DEBUG} + ErrorMessage_fork('SaveCampaign: "' + Name + GZ_Archive_Suffix + '".' ); + {$ENDIF DEBUG} + end else begin + {$IFDEF DEBUG} + ErrorMessage_fork('SaveCampaign: "' + Name + '".' ); + {$ENDIF DEBUG} + end; + {$ELSE PATCH_GH} + {$IFDEF DEBUG} + ErrorMessage_fork('SaveCampaign: "' + Name + '".' ); + {$ENDIF DEBUG} + {$ENDIF PATCH_GH} +end; +{$ENDIF PATCH_CHEAT} + Procedure DoSelectPCMek( GB: GameBoardPtr; PC: GearPtr ); { Select one of the team 1 mecha for the player to use. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + CMessage( MsgString( 'SELECTMECHA_PROMPT' ) , ZONE_Menu1 , InfoHilight ); {$IFDEF SDLMODE} MechaSelectionMenu( GB , GB^.Meks ,PC , ZONE_Menu2 ); @@ -1194,18 +2121,42 @@ Procedure TrainingRedraw; { Redraw the training screen. } begin SetupCombatDisplay; +{$IFDEF PATCH_GH} + if (NIL <> PCACTIONRD_PC) and (GG_DisposeGear < PCACTIONRD_PC^.G) then begin + CharacterDisplay( PCACTIONRD_PC , PCACTIONRD_GB ); + end; +{$ELSE PATCH_GH} CharacterDisplay( PCACTIONRD_PC , PCACTIONRD_GB ); +{$ENDIF PATCH_GH} RedrawConsole; +{$IFDEF PATCH_GH} + if (NIL <> PCACTIONRD_PC) and (GG_DisposeGear < PCACTIONRD_PC^.G) then begin + NFCMessage( 'FREE XP: ' + BStr( NAttValue( PCACTIONRD_PC^.NA , NAG_Experience , NAS_TotalXP ) - NAttValue( PCACTIONRD_PC^.NA , NAG_Experience , NAS_SpentXP ) ) , ZONE_Menu1 , InfoHilight ); + end; +{$ELSE PATCH_GH} NFCMessage( 'FREE XP: ' + BStr( NAttValue( PCACTIONRD_PC^.NA , NAG_Experience , NAS_TotalXP ) - NAttValue( PCACTIONRD_PC^.NA , NAG_Experience , NAS_SpentXP ) ) , ZONE_Menu1 , InfoHilight ); +{$ENDIF PATCH_GH} end; Procedure NewSkillRedraw; { Redraw the training screen. } begin SetupCombatDisplay; +{$IFDEF PATCH_GH} + if (NIL <> PCACTIONRD_PC) and (GG_DisposeGear < PCACTIONRD_PC^.G) then begin + CharacterDisplay( PCACTIONRD_PC , PCACTIONRD_GB ); + end; +{$ELSE PATCH_GH} CharacterDisplay( PCACTIONRD_PC , PCACTIONRD_GB ); +{$ENDIF PATCH_GH} RedrawConsole; +{$IFDEF PATCH_GH} + if (NIL <> PCACTIONRD_PC) and (GG_DisposeGear < PCACTIONRD_PC^.G) then begin + NFCMessage( BStr( NumberOfSkills( PCACTIONRD_PC ) ) + '/' + BStr( NumberOfSkillSlots( PCACTIONRD_PC ) ) , ZONE_Menu1 , InfoHilight ); + end; +{$ELSE PATCH_GH} NFCMessage( BStr( NumberOfSkills( PCACTIONRD_PC ) ) + '/' + BStr( NumberOfSkillSlots( PCACTIONRD_PC ) ) , ZONE_Menu1 , InfoHilight ); +{$ENDIF PATCH_GH} end; {$ENDIF} @@ -1247,7 +2198,11 @@ Procedure DoTraining( GB: GameBoardPtr; while Sk <> Nil do begin if ( Sk^.G = NAG_Skill ) and ( Sk^.S > 0 ) then begin { Add this skill to the menu. This is going to be one doozy of a long description. } +{$IFDEF PATCH_I18N} + AddRPGMenuItem( SkMenu , I18N_Name('SkillMan',SkillMan[Sk^.S].Name) + ' +' + BStr( Sk^.V ) + '(' + BStr( SkillAdvCost( PC , Sk^.V ) ) + ' XP)' , Sk^.S , SkillDesc( Sk^.S ) ); +{$ELSE PATCH_I18N} AddRPGMenuItem( SkMenu , SkillMan[Sk^.S].Name + ' +' + BStr( Sk^.V ) + ' (' + BStr( SkillAdvCost( PC , Sk^.V ) ) + ' XP)' , Sk^.S , SkillDesc( Sk^.S ) ); +{$ENDIF PATCH_I18N} end; Sk := Sk^.Next; end; @@ -1282,10 +2237,18 @@ Procedure DoTraining( GB: GameBoardPtr; { If the PC has enough free XP, this skill will be improved. } { Otherwise, do nothing. } if N > FXP then begin +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('DOTRAINING_IMPROVESKILLS_DOESNOTDO'), GearName(PC), I18N_Name('SkillMan',SkillMan[Sk^.S].Name) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( PC ) + ' doesn''t have enough experience points to improve ' + SkillMan[Sk^.S].name + '.' ); +{$ENDIF PATCH_I18N} end else begin { Improve the skill, pay the XP. } +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('DOTRAINING_IMPROVESKILLS_DONE'), GearName(PC), I18N_Name('SkillMan',SkillMan[Sk^.S].Name) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( PC ) + ' has improved ' + SkillMan[Sk^.S].name + '.' ); +{$ENDIF PATCH_I18N} AddNAtt( PC^.NA , NAG_Skill , Sk^.S , 1 ); AddNAtt( PC^.NA , NAG_Experience , NAS_SpentXP , N ); end; @@ -1367,7 +2330,11 @@ Procedure DoTraining( GB: GameBoardPtr; { Find out how many times this stat has been } { improved thus far. } CIV := NAttValue( PC^.NA , NAG_StatImprovementLevel , T ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( StMenu , I18N_Name( 'StatName', StatName[ T ] ) + ' (' + BStr( StatImprovementCost( CIV ) ) + ' XP)' , T ); +{$ELSE PATCH_I18N} AddRPGMenuItem( StMenu , StatName[ T ] + ' (' + BStr( StatImprovementCost( CIV ) ) + ' XP)' , T ); +{$ENDIF PATCH_I18N} end; end; @@ -1398,10 +2365,18 @@ Procedure DoTraining( GB: GameBoardPtr; XP := StatImprovementCost( CIV ); if XP > FXP then begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('IMPROVESTATS_NOTIMPROVED'), GearName( PC ) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( PC ) + ' doesn''t have enough experience points.' ); +{$ENDIF PATCH_I18N} end else begin { Improve the skill, pay the XP. } +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('IMPROVESTATS_IMPROVED'), GearName( PC ), I18N_Name( 'StatName', StatName[ N ] ) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( PC ) + ' has improved ' + StatName[ N ] + '.' ); +{$ENDIF PATCH_I18N} Inc( PC^.Stat[ N ] ); AddNAtt( PC^.NA , NAG_Experience , NAS_SpentXP , XP ); AddNAtt( PC^.NA , NAG_StatImprovementLevel , N , 1 ); @@ -1463,11 +2438,19 @@ Procedure DoTraining( GB: GameBoardPtr; for N := 1 to NumSkill do begin if FindNAtt( PC^.NA , NAG_Skill , N ) = Nil then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( SkMenu , I18N_Name('SkillMan',SkillMan[N].Name) + ' (' + BStr( SkillAdvCost( PC , 0 ) ) + ' XP)' , N , SkillDesc( N ) ); +{$ELSE PATCH_I18N} AddRPGMenuItem( SkMenu , SkillMan[N].Name + ' (' + BStr( SkillAdvCost( PC , 0 ) ) + ' XP)' , N , SkillDesc( N ) ); +{$ENDIF PATCH_I18N} end; end; RPMSortAlpha( SkMenu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( SkMenu , I18N_MsgString('DoTraining_GetNewSkill','Cancel') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( SkMenu , ' Cancel' , -1 ); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} N := SelectMenu( SkMenu , @NewSkillRedraw ); @@ -1481,7 +2464,11 @@ Procedure DoTraining( GB: GameBoardPtr; { If the PC has enough free XP, this skill will be improved. } { Otherwise, do nothing. } if SkillAdvCost( PC , 0 ) > FXP then begin +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('DOTRAINING_GETNEWSKILL_DOESNOTDO'), GearName(PC), I18N_Name('SkillMan',SkillMan[N].Name) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( PC ) + ' doesn''t have enough experience points to learn ' + SkillMan[N].name + '.' ); +{$ENDIF PATCH_I18N} end else begin { Improve the skill, pay the XP. } @@ -1516,7 +2503,11 @@ Procedure DoTraining( GB: GameBoardPtr; if ( N >= 1 ) and ( N <= NumSkill ) then begin +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('DOTRAINING_GETNEWSKILL_DONE'), GearName(PC), I18N_Name('SkillMan',SkillMan[N].Name) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( PC ) + ' has learned the ' + SkillMan[N].name + ' skill.' ); +{$ENDIF PATCH_I18N} SetNAtt( PC^.NA , NAG_Skill , N , 1 ); AddNAtt( PC^.NA , NAG_Experience , NAS_SpentXP , SkillAdvCost( PC , 0 ) ); @@ -1524,7 +2515,7 @@ Procedure DoTraining( GB: GameBoardPtr; end; end; end; -end; + end; Procedure GetNewTalent( PC: GearPtr ); { The PC is going to purchase a new talent. } @@ -1551,11 +2542,19 @@ end; for N := 1 to NumTalent do begin if CanLearnTalent( PC , N ) then begin +{$IFDEF PATCH_GH} + AddRPGMenuItem( TMenu , MsgString( 'TALENT' + BStr( N ) ) + ' (1000 XP)' , N , MsgString( 'TALENTDESC' + BStr( N ) ) ); +{$ELSE PATCH_GH} AddRPGMenuItem( TMenu , MsgString( 'TALENT' + BStr( N ) ) , N , MsgString( 'TALENTDESC' + BStr( N ) ) ); +{$ENDIF PATCH_GH} end; end; RPMSortAlpha( TMenu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TMenu , I18N_MsgString('DoTraining_GetNewTalent','CANCEL') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( TMenu , ' Cancel' , -1 ); +{$ENDIF PATCH_I18N} CMessage( 'FREE XP: ' + BStr( FXP ) , ZONE_Menu1 , InfoHilight ); @@ -1575,7 +2574,11 @@ end; DialogMsg( MsgString( 'NOFREETALENTS' ) ); end else begin { Improve the skill, pay the XP. } +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('DoTraining_GetNewTalent','learned'), GearName(PC), MsgString('TALENT' + BStr( N )) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( PC ) + ' has learned ' + MsgString( 'TALENT' + BStr( N ) ) + '.' ); +{$ENDIF PATCH_I18N} ApplyTalent( PC , N ); AddNAtt( PC^.NA , NAG_Experience , NAS_SpentXP , 1000 ); @@ -1618,7 +2621,11 @@ end; end; end; RPMSortAlpha( TMenu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TMenu , I18N_MsgString('DoTraining_ReviewTalents','Exit') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( TMenu , ' Exit' , -1 ); +{$ENDIF PATCH_I18N} CMessage( 'FREE XP: ' + BStr( FXP ) , ZONE_Menu1 , InfoHilight ); @@ -1660,7 +2667,11 @@ end; S := S^.Next; end; RPMSortAlpha( TMenu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( TMenu , I18N_MsgString('DoTraining_ReviewCyberware','Exit') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( TMenu , ' Exit' , -1 ); +{$ENDIF PATCH_I18N} CMessage( 'FREE XP: ' + BStr( FXP ) , ZONE_Menu1 , InfoHilight ); @@ -1675,6 +2686,9 @@ end; var DTMenu: RPGMenuPtr; N: Integer; +{$IFDEF PATCH_CHEAT} + top, sel: Integer; +{$ENDIF PATCH_CHEAT} begin { Error check - PC must point to the character record. } if PC^.G <> GG_Character then PC := LocatePilot( PC ); @@ -1686,6 +2700,10 @@ begin {$ENDIF} +{$IFDEF PATCH_CHEAT} + top := 0; + sel := 0; +{$ENDIF PATCH_CHEAT} repeat DTMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); AddRPGMenuItem( DTMenu , MsgString( 'TRAINING_ImproveSkill' ) , 1 ); @@ -1699,6 +2717,15 @@ begin AddRPGMenuItem( DTMenu , MsgString( 'TRAINING_ImproveStat' ) , 3 ); end; AddRPGMenuItem( DTMenu , MsgString( 'Exit' ) , -1 ); +{$IFDEF PATCH_CHEAT} + if Cheat_PCVIEW_Training_AddMenuKey then begin + AlphaKeyMenu( DTMenu ); + end; + if Cheat_PCVIEW_Training_KeepPosition and (0 < sel) then begin + DTMenu^.TopItem := top; + SetItemByValue( DTMenu, sel ); + end; +{$ENDIF PATCH_CHEAT} {$IFDEF SDLMODE} N := SelectMenu( DTMenu , @TrainingRedraw ); {$ELSE} @@ -1706,6 +2733,14 @@ begin CMessage( 'FREE XP: ' + BStr( NAttValue( PC^.NA , NAG_Experience , NAS_TotalXP ) - NAttValue( PC^.NA , NAG_Experience , NAS_SpentXP ) ) , ZONE_Menu1 , InfoHilight ); N := SelectMenu( DTMenu ); {$ENDIF} +{$IFDEF PATCH_CHEAT} + top := DTMenu^.TopItem; + if 0 < N then begin + sel := N; + end else begin + sel := DTMenu^.SelectItem; + end; +{$ENDIF PATCH_CHEAT} DisposeRPGMenu( DTMenu ); if N = 1 then ImproveSkills( PC ) @@ -1723,6 +2758,9 @@ Procedure DoFirstAid( GB: GameBoardPtr; { All this procedure does is call the general repair procedure } { with the first aid skill. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} DoPCRepair( GB , PC , 20 ); end; @@ -1730,6 +2768,9 @@ Procedure PCBackpackMenu( GB: GameBoardP { This is a front-end for the BackpackMenu command; all it does is } { call that procedure, then redraw the map afterwards. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} BackpackMenu( GB , PC , StartWithInv ); GFCombatDisplay( GB ); DisplayGearInfo( PC , GB ); @@ -1739,6 +2780,9 @@ Procedure PCFieldHQ( GB: GameBoardPtr; P { This is a front-end for the BackpackMenu command; all it does is } { call that procedure, then redraw the map afterwards. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} FieldHQ( GB , PC ); GFCombatDisplay( GB ); DisplayGearInfo( PC , GB ); @@ -1754,7 +2798,11 @@ begin { The menu needs to be re-created with each iteration, since the } { data in it needs to be updated. } {$IFNDEF SDLMODE} +{$IFDEF PATCH_I18N} + CMessage( I18N_MsgString('SetPlayOptions','prefrences') , ZONE_Menu1 , NeutralGrey ); +{$ELSE PATCH_I18N} CMessage( 'Set game prefrences' , ZONE_Menu1 , NeutralGrey ); +{$ENDIF PATCH_I18N} {$ENDIF} N := 1; repeat @@ -1763,30 +2811,67 @@ begin {$ELSE} RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); {$ENDIF} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Mecha Control') +ControlTypeName[ControlMethod] , 1 ); + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Chara Control') +ControlTypeName[CharacterMethod] , 5 ); + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Explore Control') +ControlTypeName[WorldMapMethod] , 6 ); + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Ballistic Wpn BV') +BVTypeName[DefBallisticBV] , 2 ); + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Energy Wpn BV') +BVTypeName[DefBeamGunBV] , 3 ); + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Missile BV') +BVTypeName[DefMissileBV] , 4 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Mecha Control: '+ControlTypeName[ControlMethod] , 1 ); AddRPGMenuItem( RPM , 'Chara Control: '+ControlTypeName[CharacterMethod] , 5 ); AddRPGMenuItem( RPM , 'Explore Control: '+ControlTypeName[WorldMapMethod] , 6 ); AddRPGMenuItem( RPM , 'Ballistic Wpn BV: '+BVTypeName[DefBallisticBV] , 2 ); AddRPGMenuItem( RPM , 'Energy Wpn BV: '+BVTypeName[DefBeamGunBV] , 3 ); AddRPGMenuItem( RPM , 'Missile BV: '+BVTypeName[DefMissileBV] , 4 ); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} if Use_Alpha_Blending then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Enable Transparency') , 7 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Disable Transparency' , 7 ); +{$ENDIF PATCH_I18N} end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Disable Transparency') , 7 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Enable Transparency' , 7 ); +{$ENDIF PATCH_I18N} end; if Display_Mini_Map then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Enable Mini-Map') , 8 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Disable Mini-Map' , 8 ); +{$ENDIF PATCH_I18N} end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Disable Mini-Map') , 8 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Enable Mini-Map' , 8 ); +{$ENDIF PATCH_I18N} end; if Names_Above_Heads then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Enable Name Display') , 9 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Disable Name Display' , 9 ); +{$ENDIF PATCH_I18N} end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Disable Name Display') , 9 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Enable Name Display' , 9 ); +{$ENDIF PATCH_I18N} end; {$ENDIF} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('SetPlayOptions','Exit') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , ' Exit Prefrences' , -1 ); +{$ENDIF PATCH_I18N} SetItemByValue( RPM , N ); {$IFDEF SDLMODE} N := SelectMenu( RPM , @PCActionRedraw ); @@ -1842,6 +2927,10 @@ var HList,SA: SAttPtr; Adv: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + HList := Nil; Adv := FindRoot( GB^.Scene ); if Adv <> Nil then begin @@ -1870,7 +2959,13 @@ Procedure PCViewChar( GB: GameBoardPtr; var RPM: RPGMenuPtr; N: Integer; -begin +{$IFDEF PATCH_CHEAT} + top, sel: Integer; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu ); @@ -1885,9 +2980,24 @@ begin if PC^.G = GG_Character then AddRPGMenuItem( RPM , MsgString( 'PCVIEW_SetSprite' ) , 8 ); {$ENDIF} AddRPGMenuItem( RPM , MsgString( 'PCVIEW_Exit' ) , -1 ); +{$IFDEF PATCH_CHEAT} + if Cheat_PCVIEW_AddMenuKey then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + top := 0; + sel := 0; +{$ENDIF PATCH_CHEAT} repeat +{$IFDEF PATCH_CHEAT} + if Cheat_PCVIEW_KeepPosition and (0 < sel) then begin + RPM^.TopItem := top; + SetItemByValue( RPM, sel ); + end; +{$ENDIF PATCH_CHEAT} {$IFDEF SDLMODE} PCACTIONRD_PC := PC; N := SelectMenu( RPM , @TrainingRedraw ); @@ -1895,6 +3005,14 @@ begin CharacterDisplay( PC , GB ); N := SelectMenu( RPM ); {$ENDIF} +{$IFDEF PATCH_CHEAT} + top := RPM^.TopItem; + if 0 < N then begin + sel := N; + end else begin + sel := RPM^.SelectItem; + end; +{$ENDIF PATCH_CHEAT} case N of 1: BackPackMenu( GB , PC , True ); @@ -1947,6 +3065,10 @@ var end; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Set a default waiting period of a single round. If no weapon will } { recharge before this time, return control to the player anyhow. } CT := GB^.ComTime + ClicksPerRound + 1; @@ -1963,6 +3085,10 @@ Function DefaultAtOp( Weapon: GearPtr ): var atop,PVal: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + AtOp := 0; PVal := WeaponBVSetting( Weapon ); @@ -2000,6 +3126,10 @@ var Enemy,Weapon: GearPtr; CD,MoveAction,T,TX,TY,N,AtOp: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Find out the mek's current target. } T := NAttValue( Mek^.NA , NAG_EpisodeData , NAS_Target ); Enemy := LocateMekByUID( GB , T ); @@ -2012,12 +3142,23 @@ begin if NAttValue( Mek^.NA , NAG_Location , NAS_SmartCount ) > 5 then begin SetNAtt( Mek^.NA , NAG_Location , NAS_SmartAction , 0 ); SetNAtt( Mek^.NA , NAG_Location , NAS_SmartWeapon , 0 ); +{$IFDEF PATCH_GH} + DialogMsg( MsgString( 'PCATTACK_OutOfSmartAttack' ) ); + {$IFDEF DEBUG} + DialogMsg( 'NAS_SmartCount:' + IntToStr(NAttValue( Mek^.NA , NAG_Location , NAS_SmartCount )) ); + {$ENDIF DEBUG} +{$ELSE PATCH_GH} DialogMsg( MsgString( 'PCATTACK_OutOfArc' ) ); +{$ENDIF PATCH_GH} Exit; end; { Find the weapon being used in the attack. } +{$IFDEF DEBUG} + Weapon := LocateGearByNumber( Mek , NAttValue( Mek^.NA , NAG_Location , NAS_SmartWeapon ), False, 0, 'RLSmartAttack1' ); +{$ELSE DEBUG} Weapon := LocateGearByNumber( Mek , NAttValue( Mek^.NA , NAG_Location , NAS_SmartWeapon ) ); +{$ENDIF DEBUG} if ( T = -1 ) and OnTheMap( TX , TY ) then begin { If T=-1, the PC is firing at a spot instead of a } { specific enemy. } @@ -2063,7 +3204,11 @@ begin { See if we're aiming for the main body or a subcom. } N := NAttValue( Mek^.NA , NAG_Location , NAS_SmartTarget ); if N > 0 then begin +{$IFDEF DEBUG} + Enemy := LocateGearByNumber( Enemy , N, False, 0, 'RLSmartAttack2' ); +{$ELSE DEBUG} Enemy := LocateGearByNumber( Enemy , N ); +{$ENDIF DEBUG} AtOp := 0; end else begin AtOp := DefaultAtOp( Weapon ); @@ -2098,8 +3243,18 @@ Procedure AimThatAttack( Mek,Weapon: Gea { A weapon has been selected; now, select a target. } var WPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; + AtOp: Integer; +{$ELSE PATCH_GH} N,AtOp: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; + if (NIL = Weapon) or (Weapon^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if not ReadyToFire( GB , Mek , Weapon ) then begin DialogMsg( ReplaceHash( MsgString( 'ATA_NotReady' ) , GearName( Weapon ) ) ); Exit; @@ -2114,7 +3269,11 @@ begin if ( LOOKER_Gear = Nil ) and RangeArcCheck( GB , Mek , Weapon , LOOKER_X , LOOKER_Y , TerrMan[ GB^.Map[ LOOKER_X , LOOKER_Y ].terr ].Altitude ) then begin AttackerFrontEnd( GB , Mek , Weapon , LOOKER_X , LOOKER_Y , TerrMan[ GB^.Map[ LOOKER_X , LOOKER_Y ].terr ].Altitude , DefaultAtOp( Weapon ) ); +{$IFDEF PATCH_GH} + end else if (NIL = LOOKER_Gear) or (LOOKER_Gear^.G <= GG_DisposeGear) then begin +{$ELSE PATCH_GH} end else if LOOKER_Gear = Nil then begin +{$ENDIF PATCH_GH} if ( Range( Mek , LOOKER_X , LOOKER_Y ) > WeaponRange( GB , Weapon ) ) and ( Range( Mek , LOOKER_X , LOOKER_Y ) > ThrowingRange( GB , Mek , Weapon ) ) then begin DialogMSG( MsgString( 'PCATTACK_OutOfRange' ) ); end else if InterfaceType( GB , Mek ) = MenuBasedInput then begin @@ -2131,7 +3290,11 @@ begin end; end else if ( FindRoot( LOOKER_Gear ) = FindRoot( Mek ) ) then begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('AimThatAttack','cancelled') ); +{$ELSE PATCH_I18N} DialogMSG( 'Attack cancelled.' ); +{$ENDIF PATCH_I18N} end else if RangeArcCheck( GB , Mek , Weapon , LOOKER_Gear ) then begin { Call the Attack procedure with the info we've gained. } @@ -2139,23 +3302,47 @@ begin { If a called shot was requested, create the menu here. } { Note that called shots cannot be made using burst firing. } +{$IFDEF PATCH_CHEAT} + N := -2; +{$ENDIF PATCH_CHEAT} if CallShot and ( LOOKER_Gear^.SubCom <> Nil ) then begin { Create a menu, fill it with bits. } WPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); BuildGearMenu( WPM , LOOKER_Gear , GG_Module ); {$IFDEF SDLMODE} + {$IFDEF PATCH_CHEAT} + if Cheat_CallShot then begin + PCACTIONRD_PC := LOOKER_Gear; + end; + {$ENDIF PATCH_CHEAT} N := SelectMenu( WPM , @PCActionRedraw ); {$ELSE} + {$IFDEF PATCH_CHEAT} + if Cheat_CallShot then begin + DisplayGearInfo( LOOKER_Gear , GB ); + end; + {$ENDIF PATCH_CHEAT} N := SelectMenu( WPM ); {$ENDIF} if N <> -1 then begin +{$IFDEF DEBUG} + LOOKER_Gear := LocateGearByNumber( LOOKER_Gear , N, False, 0, 'AimThatAttack' ); +{$ELSE DEBUG} LOOKER_Gear := LocateGearByNumber( LOOKER_Gear , N ); +{$ENDIF DEBUG} end; DisposeRPGMenu( WPM ); AtOp := 0; end; +{$IFDEF PATCH_CHEAT} + if (-1 = N) and Cheat_CallShot_Cancel then begin + end else begin + AttackerFrontEnd( GB , Mek , Weapon , LOOKER_Gear , AtOp ); + end; +{$ELSE PATCH_CHEAT} AttackerFrontEnd( GB , Mek , Weapon , LOOKER_Gear , AtOp ); +{$ENDIF PATCH_CHEAT} end else begin if ArcCheck( GB , Mek , Weapon , LOOKER_Gear ) then begin @@ -2163,6 +3350,33 @@ begin end else if InterfaceType( GB , Mek ) = MenuBasedInput then begin DialogMSG( MsgString( 'PCATTACK_OutOfArc' ) ); end else begin +{$IFDEF PATCH_CHEAT} + N := -2; + if CallShot and ( LOOKER_Gear^.SubCom <> Nil ) then begin + { Create a menu, fill it with bits. } + WPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); + BuildGearMenu( WPM , LOOKER_Gear , GG_Module ); + {$IFDEF SDLMODE} + N := SelectMenu( WPM , @PCActionRedraw ); + {$ELSE SDLMODE} + N := SelectMenu( WPM ); + {$ENDIF SDLMODE} + DisposeRPGMenu( WPM ); + end; + + if (-1 = N) and Cheat_CallShot_Cancel then begin + end else begin + SetNAtt( Mek^.NA , NAG_Location , NAS_SmartAction , NAV_SmartAttack ); + SetNAtt( Mek^.NA , NAG_Location , NAS_SmartCount , 0 ); + SetNAtt( Mek^.NA , NAG_Location , NAS_SmartWeapon , FindGearIndex( Mek , Weapon ) ); + if -1 < N then begin + SetNAtt( Mek^.NA , NAG_Location , NAS_SmartTarget , N ); + end else begin + SetNAtt( Mek^.NA , NAG_Location , NAS_SmartTarget , 0 ); + end; + RLSmartAttack( GB , Mek ); + end; +{$ELSE PATCH_CHEAT} SetNAtt( Mek^.NA , NAG_Location , NAS_SmartAction , NAV_SmartAttack ); SetNAtt( Mek^.NA , NAG_Location , NAS_SmartCount , 0 ); SetNAtt( Mek^.NA , NAG_Location , NAS_SmartWeapon , FindGearIndex( Mek , Weapon ) ); @@ -2188,6 +3402,7 @@ begin RLSmartAttack( GB , Mek ); +{$ENDIF PATCH_CHEAT} end; end; end; @@ -2198,16 +3413,28 @@ Procedure DoPlayerAttack( Mek: GearPtr; { The player has accessed the weapons menu. Select an active } { weapon, then select a target. If the target is within range, } { process the attack and report upon it to the user. } +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} const CalledShotOff = ' Called Shot: Off [/]'; CalledShotOn = ' Called Shot: On [/]'; +{$ENDIF PATCH_I18N} var WPM: RPGMenuPtr; { The Weapons Menu } MI,MI2: RPGMenuItemPtr; { For checking all the weapons. } Weapon: GearPtr; { Also for checking all the weapons. } N: Integer; CallShot: Boolean; -begin +{$IFDEF PATCH_I18N} + CalledShotOff: String; + CalledShotOn: String; +{$ELSE PATCH_I18N} +{$ENDIF PATCH_I18N} +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Error check - make sure that MEK is a valid, active master gear. } if not IsMasterGear( Mek ) then exit; @@ -2233,7 +3460,11 @@ begin while MI <> Nil do begin MI2 := MI^.Next; +{$IFDEF DEBUG} + Weapon := LocateGearByNumber( Mek , MI^.Value, False, 0, 'DoPlayerAttack1' ); +{$ELSE DEBUG} Weapon := LocateGearByNumber( Mek , MI^.Value ); +{$ENDIF DEBUG} if not ReadyToFire( GB , Mek , Weapon ) then begin { This weapon isn't ready to fire. Remove it from the menu. } @@ -2248,15 +3479,27 @@ begin MI := MI2; end; +{$IFDEF PATCH_I18N} + CalledShotOff := I18N_MsgString('DoPlayerAttack','Called Off'); + CalledShotOn := I18N_MsgString('DoPlayerAttack','Called On'); +{$ENDIF PATCH_I18N} { Add the firing options. Save the address of the called shot entry. } MI := AddRPGMenuItem( WPM , CalledShotOff , -4 ); AddRPGMenuKey( WPM , '/' , -4 ); CallShot := False; +{$IFDEF PATCH_I18N} + AddRPGMenuItem( WPM , I18N_MsgString('DoPlayerAttack','Wait for recharge') , -3 ); + AddRPGMenuKey( WPM , '.' , -3 ); + AddRPGMenuItem( WPM , I18N_MsgString('DoPlayerAttack','Options') , -2 ); + AddRPGMenuKey( WPM , '?' , -2 ); + AddRPGMenuItem( WPM , I18N_MsgString('DoPlayerAttack','Cancel') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( WPM , ' Wait for recharge [.]' , -3 ); AddRPGMenuKey( WPM , '.' , -3 ); AddRPGMenuItem( WPM , ' Options [?]' , -2 ); AddRPGMenuKey( WPM , '?' , -2 ); AddRPGMenuItem( WPM , ' Cancel [ESC]' , -1 ); +{$ENDIF PATCH_I18N} { *** END MENU BUILDER *** } { Actually get a selection from the menu. } @@ -2285,7 +3528,11 @@ begin { If the selection wasn't cancelled, proceed with the attack. } if N > -1 then begin { A weapon has been selected. Now, select a target. } +{$IFDEF DEBUG} + Weapon := LocateGearByNumber( Mek , N, False, 0, 'DoPlayerAttack2' ); +{$ELSE DEBUG} Weapon := LocateGearByNumber( Mek , N ); +{$ENDIF DEBUG} { Call the LOOKER procedure to select a target. } AimThatAttack( Mek , Weapon , CallShot , GB ); @@ -2333,7 +3580,11 @@ begin Pilot := ExtractPilot( Mek ); if Pilot <> Nil then begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('EJECT_Message'), GearName(Pilot), GearName(Mek) ) ); +{$ELSE PATCH_I18N} DialogMsg( GearName( Pilot ) + MsgString( 'EJECT_Message' ) + GearName( Mek ) + '.' ); +{$ENDIF PATCH_I18N} { In a safe area, deploy the pilot in the same tile as the mecha. } if IsSafeArea( GB ) and not IsBlocked( Pilot , GB , P.X , P.Y ) then begin SetNAtt( Pilot^.NA , NAG_Location , NAS_X , P.X ); @@ -2354,7 +3605,7 @@ begin { as an easy out to any combat without risking losing a } { mecha. If the player team wins and gets salvage, they } { should get this mek back anyhow. } - SetNAtt( Mek^.NA , NAG_Location , NAS_Team , 0 ); + SetNAtt( Mek^.NA , NAG_Location , NAS_Team , NAV_DefNeutralTeam ); end; end; @@ -2365,6 +3616,10 @@ Procedure DoRest( GB: GameBoardPtr; Mek: { The PC wants to rest, probably because he's out of stamina. Take a break for } { an hour or so of game time. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if ( NAttValue( LocatePilot( Mek )^.NA , NAG_Condition , NAS_Hunger ) > HUNGER_PENALTY_STARTS ) then begin DialogMsg( MsgString( 'REST_TooHungry' ) ); end else if IsSafeArea( GB ) then begin @@ -2385,6 +3640,10 @@ procedure ShiftGears( Mek: GearPtr ); var MM,CMM: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + CMM := NAttValue( Mek^.NA , NAG_Action , NAS_MoveMode ); MM := CMM mod NumMoveMode + 1; @@ -2395,6 +3654,398 @@ begin if MM <> 0 then SetNAtt( Mek^.NA , NAG_Action , NAS_MoveMode , MM); end; +{$IFDEF PATCH_CHEAT} +Function CheckConversionSystem( Mek: GearPtr; FieldHQ_mode: Boolean ): Boolean; + + Function Check( P: GearPtr): Boolean; + var + Eqp: GearPtr; + ShieldReceptacle: String; + ShieldPlug: String; + ret: Boolean; + begin + if 0 < SAttValueToInt( P^.SA, SATT_TRANSFORMABLE ) then begin + if Destroyed( P ) then begin + exit( False ); + end; + + Eqp := P^.SubCom; + ret := False; + while ( NIL <> Eqp ) do begin + if (GG_DisposeGear < Eqp^.G) then begin + if ( GG_Support = Eqp^.G ) and ( GS_ConvEqp = Eqp^.S ) then begin + if Destroyed( Eqp ) then begin + exit( False ); + end; + if ( Eqp^.V < P^.V ) then begin + exit( False ); + end; + if ( (GearMass(Eqp) * 10) < GearMass(P) ) then begin + exit( False ); + end; + ret := True; + break; + end; + end; + Eqp := Eqp^.Next; + end; + if not ret then begin + exit( False ); + end; + + Eqp := P^.InvCom; + while ( NIL <> Eqp ) do begin + if (GG_DisposeGear < Eqp^.G) then begin + if ( GG_ExArmor = Eqp^.G ) then begin + if ( GS_Conversion <> Eqp^.S ) then begin + exit( False ); + end; + end else if ( GG_Shield = Eqp^.G ) then begin + ShieldReceptacle := SAttValue( P^.SA , SATT_SHIELD_RECEPTACLE ); + ShieldPlug := SAttValue( Eqp^.SA, SATT_SHIELD_PLUG ); + if ( '' = ShieldPlug ) then begin + exit( False ); + end; + if ( ShieldReceptacle <> ShieldPlug ) then begin + exit( False ); + end; + end; + end; + Eqp := Eqp^.Next; + end; + end; + Check := True; + end; + Function CheckPartAlongTrack( P: GearPtr ): Boolean; + begin + while ( NIL <> P ) do begin + if (GG_DisposeGear < P^.G) then begin + if not Check( P ) then begin + exit( False ); + end; + + if ( GG_Cockpit = P^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + ; + end else begin + if not CheckPartAlongTrack( P^.SubCom ) then begin + exit( False ); + end; + end; + end; + P := P^.Next; + end; + CheckPartAlongTrack := True; + end; + +var + MaxForm: Integer; + OldForm: Integer; + T: Integer; + WaitTime: Integer; + ret: Boolean; +begin + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit( False ); + + MaxForm := SAttValueToInt( Mek^.SA, SATT_TRANSFORMABLE ); + if MaxForm < 1 then exit( False ); + OldForm := SAttValueToInt( Mek^.SA, SATT_TRANSFORM_CURRENT ); + if OldForm < 1 then exit( False ); + + for T := 1 to MaxForm do begin + WaitTime := SAttValueToInt( Mek^.SA , SATT_TRANSFORM_WAIT + BStr(OldForm) + '_' + BStr(T) ); + if ( ( 0 <> WaitTime ) and ( FieldHQ_mode or ( 0 < WaitTime ) ) ) then begin + ret := True; + end; + end; + if not ret then exit( False ); + + CheckConversionSystem := CheckPartAlongTrack( Mek^.SubCom ); +end; + +Procedure DoTransformation( GB: GameBoardPtr; Mek: GearPtr; NewForm: Integer ); +var + SAtt_NEWFORM: String; + GS_Tag: String; + + Procedure Change( PC, P: GearPtr ); + var + GS_Tag_Str: String; + GS_Tag_Value: Integer; + begin + GS_Tag_Str := SAttValue( P^.SA, GS_Tag ); + if ( '' <> GS_Tag_Str ) then begin + GS_Tag_Value := StrToInt( GS_Tag_Str ); + if ( GS_Tag_Value < 0 ) then begin + { Mark_GG_DisposeGear( P ); } + DelinkGear( P^.Parent^.SubCom , P ); + SetNAtt( P^.NA , NAG_Location , NAS_X , NAttValue( PC^.NA , NAG_Location , NAS_X ) ); + SetNAtt( P^.NA , NAG_Location , NAS_Y , NAttValue( PC^.NA , NAG_Location , NAS_Y ) ); + if not OnTheMap( PC ) then SetNAtt( P^.NA , NAG_Location , NAS_Team , NAV_DefPlayerTeam ); + + P^.Next := PC^.Next; + PC^.Next := P; + end else begin + SetSAtt( P^.SA, SAtt_NEWFORM ); + if ( NumModule < GS_Tag_Value ) then begin + P^.S := GS_Storage; + end else begin + P^.S := GS_Tag_Value; + end; + end; + end; + end; + + Procedure SeekPartAlongTrack( P: GearPtr ); + var + PC: GearPtr; + P_Next: GearPtr; + begin + PC := FindRoot( P ); + while ( NIL <> P ) do begin + P_Next := P^.Next; + if (GG_DisposeGear < P^.G) then begin + Change( PC, P ); + + if ( GG_Cockpit = P^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + ; + end else begin + SeekPartAlongTrack( P^.SubCom ); + end; + end; + P := P_Next; + end; + end; +var + MaxForm: Integer; + OldForm: Integer; + WaitTime: Integer; +begin + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; + + MaxForm := SAttValueToInt( Mek^.SA, SATT_TRANSFORMABLE ); + if MaxForm < 1 then exit; + if NewForm < 1 then exit; + if MaxForm < NewForm then exit; + OldForm := SAttValueToInt( Mek^.SA, SATT_TRANSFORM_CURRENT ); + if OldForm = NewForm then exit; + WaitTime := abs( SAttValueToInt( Mek^.SA , SATT_TRANSFORM_WAIT + BStr(OldForm) + '_' + BStr(NewForm) ) ); + + SetSAtt( Mek^.SA , 'SDL_SPRITE <' + SAttValue(Mek^.SA,SATT_TRANSFORM_SDL_SPRITE + BStr(NewForm)) + '>' ); + + SAtt_NEWFORM := SATT_TRANSFORM_CURRENT + ' <' + BStr(NewForm) + '>'; + GS_Tag := SATT_TRANSFORM_GS + BStr(NewForm); + Change( FindRoot(Mek), Mek ); + SeekPartAlongTrack( Mek^.SubCom ); + + WaitAMinute( GB , Mek , WaitTime ); +end; + +Procedure UserTransformation( GB: GameBoardPtr; Mek: GearPtr; FieldHQ_mode: Boolean ); +var + RPM: RPGMenuPtr; + MaxForm: Integer; + OldForm: Integer; + T: Integer; + NewForm: Integer; + WaitTime: Integer; +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + + MaxForm := SAttValueToInt( Mek^.SA, SATT_TRANSFORMABLE ); + if MaxForm < 1 then exit; + OldForm := SAttValueToInt( Mek^.SA, SATT_TRANSFORM_CURRENT ); + if OldForm < 1 then exit; + +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('Transformation', 'Select Form') ); +{$ELSE PATCH_I18N} + DialogMSG( 'Select Form' ); +{$ENDIF PATCH_I18N} + + { Do not check the "Mek" itself. } + if not CheckConversionSystem( Mek , FieldHQ_mode ) then begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('Transformation', 'Can not transform') ); +{$ELSE PATCH_I18N} + DialogMSG( 'Can not transform.' ); +{$ENDIF PATCH_I18N} + exit; + end; + + RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); + AttachMenuDesc( RPM , ZONE_Menu1 ); + + for T := 1 to MaxForm do begin + WaitTime := SAttValueToInt( Mek^.SA , SATT_TRANSFORM_WAIT + BStr(OldForm) + '_' + BStr(T) ); + if ( OldForm = T ) or ( ( 0 <> WaitTime ) and ( FieldHQ_mode or ( 0 < WaitTime ) ) ) then begin + AddRPGMenuItem( RPM , SAttValue( Mek^.SA , SATT_TRANSFORM_NAME + BStr(T) ) , T ); + end; + end; +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('Transformation', 'Cancel') , -1 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( RPM , ' [Cancel]' , -1 ); +{$ENDIF PATCH_I18N} + SetItemByValue( RPM , OldForm ); + +{$IFDEF SDLMODE} + PCACTIONRD_PC := Mek; + NewForm := SelectMenu( RPM , @PCActionRedraw ); +{$ELSE} + NewForm := SelectMenu( RPM ); +{$ENDIF} + + DisposeRPGMenu( RPM ); + ClrZone( ZONE_Menu ); + + WaitTime := abs( SAttValueToInt( Mek^.SA , SATT_TRANSFORM_WAIT + BStr(OldForm) + '_' + BStr(NewForm) ) ); + if (OldForm < 1) or (MaxForm < OldForm) or (NewForm < 1) or (MaxForm < NewForm) or (WaitTime < 0) then begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('Transformation', 'Cancelled') ); +{$ELSE PATCH_I18N} + DialogMSG( 'Cancelled.' ); +{$ENDIF PATCH_I18N} + exit; + end; + DialogMSG( SAttValue(Mek^.SA,SATT_TRANSFORM_NAME + BStr(NewForm)) ); + + DoTransformation( GB , Mek , NewForm ); +end; +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_CHEAT} +Procedure DoPurgeParts( GB: GameBoardPtr; Mek: GearPtr; SelectMode: Integer ); +var + GS_Tag: String; + + Procedure Change( PC, P: GearPtr; IsSubCom: Boolean ); + begin + if '' <> SAttValue( P^.SA, GS_Tag ) then begin + { Mark_GG_DisposeGear( P ); } + if IsSubCom then begin + DelinkGear( P^.Parent^.SubCom , P ); + end else begin + DelinkGear( P^.Parent^.InvCom , P ); + end; + SetNAtt( P^.NA , NAG_Location , NAS_X , NAttValue( PC^.NA , NAG_Location , NAS_X ) ); + SetNAtt( P^.NA , NAG_Location , NAS_Y , NAttValue( PC^.NA , NAG_Location , NAS_Y ) ); + if not OnTheMap( PC ) then SetNAtt( P^.NA , NAG_Location , NAS_Team , NAV_DefPlayerTeam ); + + P^.Next := PC^.Next; + PC^.Next := P; + end; + end; + Procedure SeekPartAlongTrack( P: GearPtr; IsSubCom: Boolean ); + var + PC: GearPtr; + P_Next: GearPtr; + begin + PC := FindRoot( P ); + while P <> Nil do begin + P_Next := P^.Next; + if (GG_DisposeGear < P^.G) then begin + Change( PC , P , IsSubCom ); + + if ( GG_Cockpit = P^.G ) then begin + { Don't add parts beyond the cockpit barrier. } + SeekPartAlongTrack( P^.InvCom , False ); + end else begin + SeekPartAlongTrack( P^.SubCom , True ); + SeekPartAlongTrack( P^.InvCom , False ); + end; + end; + P := P_Next; + end; + end; + +var + MaxMode: Integer; + WaitTime: Integer; +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + + MaxMode := SAttValueToInt( Mek^.SA, SATT_SEPARABLE ); + if MaxMode < 1 then exit; + + WaitTime := SAttValueToInt(Mek^.SA,SATT_SEPARATE_WAIT + BStr(SelectMode)); + if (SelectMode < 1) or (MaxMode < SelectMode) or (WaitTime < 0) then begin + exit; + end; + + GS_Tag := SATT_SEPARATE + BStr(SelectMode); + + { Do not change the "Mek" itself. } + SeekPartAlongTrack( Mek^.SubCom , True ); + + WaitAMinute( GB , Mek , WaitTime ); +end; + +Procedure UserPurgeParts( GB: GameBoardPtr; Mek: GearPtr ); +var + RPM: RPGMenuPtr; + T: Integer; + MaxMode: Integer; + SelectMode: Integer; + WaitTime: Integer; +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + + MaxMode := SAttValueToInt( Mek^.SA, SATT_SEPARABLE ); + if MaxMode < 1 then exit; + +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('PurgeParts', 'Select Mode') ); +{$ELSE PATCH_I18N} + DialogMSG( 'Select Mode' ); +{$ENDIF PATCH_I18N} + RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_Menu2 ); + AttachMenuDesc( RPM , ZONE_Menu1 ); + + for T := 1 to MaxMode do begin + if (0 <= SAttValueToInt(Mek^.SA,SATT_SEPARATE_WAIT + BStr(T))) then begin + AddRPGMenuItem( RPM , SAttValue(Mek^.SA,SATT_SEPARATE_NAME + BStr(T)) , T ); + end; + end; +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('PurgeParts', 'Cancel') , -1 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( RPM , ' [Cancel]' , -1 ); +{$ENDIF PATCH_I18N} + SetItemByValue( RPM , -1 ); + +{$IFDEF SDLMODE} + PCACTIONRD_PC := Mek; + SelectMode := SelectMenu( RPM , @PCActionRedraw ); +{$ELSE} + SelectMode := SelectMenu( RPM ); +{$ENDIF} + + DisposeRPGMenu( RPM ); + ClrZone( ZONE_Menu ); + + WaitTime := SAttValueToInt(Mek^.SA,SATT_SEPARATE_WAIT + BStr(SelectMode)); + if (SelectMode < 1) or (MaxMode < SelectMode) or (WaitTime < 0) then begin +{$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('PurgeParts', 'Cancelled') ); +{$ELSE PATCH_I18N} + DialogMSG( 'Cancelled.' ); +{$ENDIF PATCH_I18N} + exit; + end; + DialogMSG( SAttValue(Mek^.SA,SATT_SEPARATE_NAME + BStr(SelectMode)) ); + + DoPurgeParts( GB , Mek , SelectMode ); +end; +{$ENDIF PATCH_CHEAT} + Procedure KeyMapDisplay; { Display the game commands and their associated keystrokes. } var @@ -2407,10 +4058,30 @@ begin AttachMenuDesc( RPM , ZONE_Menu1 ); for t := 1 to NumMappedKeys do begin +{$IFDEF PATCH_GH} + if 0 = Length( KeyMap[T].CmdDesc ) then + continue; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , KeyMap[T].CmdName + '(' + I18N_Help_Keymap_Name_String(KeyMap[T].CmdName) + ')' , T , I18N_Help_Keymap_Desc_String(KeyMap[T].CmdName) ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , KeyMap[T].CmdName , T , KeyMap[T].CmdDesc ); +{$ENDIF PATCH_I18N} end; +{$IFDEF PATCH_GH} + {$IFDEF PATCH_I18N} + for t := 1 to KeyMapAliasMax do begin + if 0 = Length( I18N_Help_Keymap_Name_String(KeyMapAlias[t].CmdAlias) ) then + continue; + AddRPGMenuItem( RPM , KeyMapAlias[t].CmdAlias + '(' + I18N_Help_Keymap_Name_String(KeyMapAlias[t].CmdAlias) + ')' , T , I18N_Help_Keymap_Desc_String(KeyMapAlias[t].CmdAlias) ); + end; + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} RPMSortAlpha( RPM ); +{$ENDIF PATCH_I18N} RPI := RPM^.FirstItem; while RPI <> Nil do begin RPI^.msg := KeyMap[RPI^.Value].KCode + ' - ' + RPI^.msg; @@ -2487,6 +4158,9 @@ var begin while ( Part <> Nil ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ReadyToFire( GB , PC , Part ) then begin WR1 := WeaponRange( GB , Weapon ); if ThrowingRange( GB , PC , Weapon ) > WR1 then WR1 := ThrowingRange( GB , PC , Weapon ); @@ -2500,17 +4174,28 @@ var if ( Part^.SubCom <> Nil ) then SeekWeapon( Part^.SubCom ); if ( Part^.InvCom <> Nil ) then SeekWeapon( Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Start by looking for a weapon to use. } Weapon := Nil; SeekWeapon( PC^.SubCom ); SeekWeapon( PC^.InvCom ); if Weapon = Nil then begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('RLQuickAttack','dont have a weapon') ); +{$ELSE PATCH_I18N} DialogMsg( 'You don''t have a weapon ready!' ); +{$ENDIF PATCH_I18N} WaitOnRecharge( GB , PC ); end else begin @@ -2546,6 +4231,9 @@ var { Preference is given to short-range weapons. } begin while ( Part <> Nil ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G = GG_Module ) or ( Part^.G = GG_Weapon ) then begin if ReadyToFire( GB , PC , Part ) and RangeArcCheck( GB , PC , Part , Target ) then begin if Weapon = Nil then Weapon := Part @@ -2558,10 +4246,18 @@ var end; if ( Part^.SubCom <> Nil ) then SeekWeapon( Part^.SubCom ); if ( Part^.InvCom <> Nil ) then SeekWeapon( Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Start by looking for a weapon to use. } Weapon := Nil; SeekWeapon( PC^.SubCom ); @@ -2579,8 +4275,17 @@ end; Procedure RLBumpAttack( GB: GameBoardPtr; PC,Target: GearPtr ); { Call the core bumpattack procedure, cancelling the action if it fails. } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if not CoreBumpAttack( GB , PC , Target ) then begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('RLBumpAttack','dont have a weapon') ); +{$ELSE PATCH_I18N} DialogMsg( 'You don''t have a weapon ready!' ); +{$ENDIF PATCH_I18N} WaitOnRecharge( GB , PC ); SetNAtt( PC^.NA , NAG_Location , NAS_SmartAction , 0 ); end; @@ -2594,6 +4299,11 @@ var Success: LongInt; msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = Instrument) or (Instrument^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Call the performance procedure to find out how well the } { player has done. } Success := UsePerformance( GB , PC , Instrument ); @@ -2619,7 +4329,15 @@ Procedure ContinuousItemUse( GB: GameBoa var Item: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + +{$IFDEF DEBUG} + Item := LocateGearByNumber( Mek , NAttValue( Mek^.NA , NAG_Location , NAS_SmartWeapon ), False, 0, 'ContinuousItemUse' ); +{$ELSE DEBUG} Item := LocateGearByNumber( Mek , NAttValue( Mek^.NA , NAG_Location , NAS_SmartWeapon ) ); +{$ENDIF DEBUG} if ( Item <> Nil ) and NotDestroyed( Item ) and ( Item^.G = GG_Usable ) then begin { Depending upon what kind of usable item this is, } { branch to a different procedure. } @@ -2644,6 +4362,10 @@ Procedure RLSmartGo( GB: GameBoardPtr; M var DX,DY: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + DX := NAttValue( Mek^.NA , NAG_Location , NAS_SmartX ); DY := NAttValue( Mek^.NA , NAG_Location , NAS_SmartY ); @@ -2668,6 +4390,10 @@ var P,P2: Point; M2: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + CD := NAttValue( Mek^.NA , NAG_Location , NAS_D ); SD := NAttValue( Mek^.NA , NAG_Location , NAS_SmartAction ); @@ -2715,7 +4441,11 @@ begin SetNAtt( Mek^.NA , NAG_Location , NAS_SmartAction , 0 ); if IsBlocked( Mek , GB , P.X , P.Y ) then begin +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('RLSmartAction','Blocked') ); +{$ELSE PATCH_I18N} DialogMsg( 'Blocked!' ); +{$ENDIF PATCH_I18N} end else begin { The move isn't blocked, so walk straight ahead. } if PC_SHOULD_RUN and ( CurrentStamina( Mek ) > 0 ) then begin @@ -2737,7 +4467,18 @@ begin { M2 is an enemy! Thwack it! Thwack it now!!! } RLBumpAttack( GB , Mek , M2 ); +{$IFDEF PATCH_GH} + end else if (NAV_LancemateTeam = NAttValue( M2^.NA, NAG_Location, NAS_Team )) and not (OnTheMap(P.X,P.Y) and IsObstacle(GB,Mek,GB^.Map[P.X,P.Y].terr)) then begin + if not OnTheMap(P.X,P.Y) then begin + { There is a lancemate, but out of map. } + { Then, the move isn't blocked, so walk straight ahead. } + SetNAtt( Mek^.NA, NAG_Location, NAS_SmartAction, 0 ); + PrepAction( GB, Mek, NAV_NormSpeed ); + Exit; + end; +{$ELSE PATCH_GH} end else if ( NAttValue( M2^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) and not IsObstacle( GB , Mek , GB^.Map[ P.X , P.Y ].terr ) then begin +{$ENDIF PATCH_GH} { M2 is a lancemate. Try changing places with it. } { This will happen outside of the normal movement code... I hope that } { it won't be exploitable... } @@ -2769,6 +4510,10 @@ Procedure RLWalker( GB: GameBoardPtr; Me { walk in that direction... or, alternatively, to attack } { an enemy in that tile, or to speak with an ally in that tile. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + SetNAtt( Mek^.NA , NAG_Location , NAS_SmartAction , D ); RLSmartAction( GB , Mek ); end; @@ -2781,7 +4526,22 @@ var N: Integer; RPM: RPGMenuPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + RPM := CreateRPGMenu( teamcolor( GB , mek ) , StdWhite , ZONE_Menu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('GameOptionMenu','Inventory') , 2 ); + AddRPGMenuItem( RPM , I18N_MsgString('GameOptionMenu','Get Item') , 3 ); + AddRPGMenuItem( RPM , I18N_MsgString('GameOptionMenu','Enter Location') , 4 ); + AddRPGMEnuItem( RPM , I18N_MsgString('GameOptionMenu','Do Repairs') , 5 ); + AddRPGMenuItem( RPM , I18N_MsgString('GameOptionMenu','Combat Settings') , 1 ); + AddRPGMEnuItem( RPM , I18N_MsgString('GameOptionMenu','Eject from Mecha') , -6 ); + AddRPGMenuItem( RPM , I18N_MsgString('GameOptionMenu','Character Info') , 6 ); + AddRPGMenuItem( RPM , I18N_MsgString('GameOptionMenu','Quit Game') , -2 ); + AddRPGMenuItem( RPM , I18N_MsgString('GameOptionMenu','Return to Main') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Inventory' , 2 ); AddRPGMenuItem( RPM , 'Get Item' , 3 ); AddRPGMenuItem( RPM , 'Enter Location' , 4 ); @@ -2791,8 +4551,13 @@ begin AddRPGMenuItem( RPM , 'Character Info' , 6 ); AddRPGMenuItem( RPM , 'Quit Game' , -2 ); AddRPGMenuItem( RPM , 'Return to Main' , -1 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('GameOptionMenu','Advanced options menu') ); +{$ELSE PATCH_I18N} DialogMsg('Advanced options menu.'); +{$ENDIF PATCH_I18N} repeat {$IFDEF SDLMODE} @@ -2821,12 +4586,26 @@ var N: Integer; RPM: RPGMenuPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + RPM := CreateRPGMenu( teamcolor( GB , mek ) , StdWhite , ZONE_Menu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('InfoMenu','Examine Map') , 1 ); + AddRPGMenuItem( RPM , I18N_MsgString('InfoMenu','Mecha Browser') , 3 ); + AddRPGMenuItem( RPM , I18N_MsgString('InfoMenu','Return to Main') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Examine Map' , 1 ); AddRPGMenuItem( RPM , 'Mecha Browser' , 3 ); AddRPGMenuItem( RPM , 'Return to Main' , -1 ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_I18N} + DialogMsg( I18N_MsgString('InfoMenu','Information Menu') ); +{$ELSE PATCH_I18N} DialogMsg('Information Menu.'); +{$ENDIF PATCH_I18N} repeat {$IFDEF SDLMODE} @@ -2852,6 +4631,10 @@ var MoveMode, T , S: Integer; RPM: RPGMenuPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Create the action menu. } RPM := CreateRPGMenu( teamcolor( GB , mek ) , StdWhite , ZONE_Menu ); @@ -2861,15 +4644,31 @@ begin MoveMode := NAttValue( Mek^.NA , NAG_Action , NAS_MoveMode ); if CPHMoveRate( Mek , gb^.Scale ) > 0 then begin if MoveMode = MM_Walk then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Walk') , NAV_NormSpeed ); + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Run') , NAV_FullSpeed ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Walk' , NAV_NormSpeed ); AddRPGMenuItem( RPM , 'Run' , NAV_FullSpeed ); +{$ENDIF PATCH_I18N} end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Cruise Speed') , NAV_NormSpeed ); + if MoveLegal( Mek , NAV_FullSpeed , GB^.ComTime ) then AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Full Speed') , NAV_FullSpeed ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Cruise Speed' , NAV_NormSpeed ); if MoveLegal( Mek , NAV_FullSpeed , GB^.ComTime ) then AddRPGMenuItem( RPM , 'Full Speed' , NAV_FullSpeed ); +{$ENDIF PATCH_I18N} end; +{$IFDEF PATCH_I18N} + if MoveLegal( Mek , NAV_TurnLeft , GB^.ComTime ) then AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Turn Left'), NAV_TurnLeft ); + if MoveLegal( Mek , NAV_TurnRight , GB^.ComTime ) then AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Turn Right'), NAV_TurnRight); + if MoveLegal( Mek , NAV_Reverse , GB^.ComTime ) then AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Reverse'), NAV_Reverse); +{$ELSE PATCH_I18N} if MoveLegal( Mek , NAV_TurnLeft , GB^.ComTime ) then AddRPGMenuItem( RPM , '<<< Turn Left', NAV_TurnLeft ); if MoveLegal( Mek , NAV_TurnRight , GB^.ComTime ) then AddRPGMenuItem( RPM , ' Turn Right >>>', NAV_TurnRight); if MoveLegal( Mek , NAV_Reverse , GB^.ComTime ) then AddRPGMenuItem( RPM , ' Reverse', NAV_Reverse); +{$ENDIF PATCH_I18N} end; { Add movemode switching options, if applicable. } @@ -2882,12 +4681,24 @@ begin if ( BaseMoveRate( Mek , T ) > 0 ) and MoveLegal( Mek , T , NAV_NormSpeed , GB^.ComTime ) then begin if T = MM_Fly then begin if JumpTime( Mek ) > 0 then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Jump') , 100+T ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Jump' , 100+T ); +{$ENDIF PATCH_I18N} end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_Name('MoveModeName',MoveModeName[T]) , 100+T ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , MoveModeName[T] , 100+T ); +{$ENDIF PATCH_I18N} end; end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_Name('MoveModeName',MoveModeName[T]) , 100+T ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , MoveModeName[T] , 100+T ); +{$ENDIF PATCH_I18N} end; end; end; @@ -2897,15 +4708,30 @@ begin { had their movement systems disabled, this will } { be the only option. } if NAttValue( Mek^.NA , NAG_Action , NAS_MoveAction ) = NAV_Stop then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Wait'), -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Wait', -1 ); +{$ENDIF PATCH_I18N} end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Stop'), -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Stop', -1 ); +{$ENDIF PATCH_I18N} end; +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Weapons Menu'), -3 ); + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Info Menu'), -2 ); + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Options Menu'), -5 ); + AddRPGMenuItem( RPM , I18N_MsgString('MenuPlayerInput','Search') , -6 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Weapons Menu', -3 ); AddRPGMenuItem( RPM , 'Info Menu', -2 ); AddRPGMenuItem( RPM , 'Options Menu', -5 ); AddRPGMenuItem( RPM , 'Search' , -6 ); +{$ENDIF PATCH_I18N} { Set the SelectItem field of the menu to the } { item which matches the mek's last menu action. } @@ -2981,7 +4807,11 @@ begin if PC <> Nil then begin for t := 1 to 7 do begin N := NAttValue( PC^.NA , NAG_CharDescription , -T ); +{$IFDEF PATCH_I18N} + if N <> 0 then DialogMsg( PersonalityTraitDesc( T , N , True ) + ' (' + BStr( Abs( N ) ) + ')' ); +{$ELSE PATCH_I18N} if N <> 0 then DialogMsg( PersonalityTraitDesc( T , N ) + ' (' + BStr( Abs( N ) ) + ')' ); +{$ENDIF PATCH_I18N} end; end; end; @@ -3031,6 +4861,9 @@ var { Preference is given to short-range weapons. } begin while ( Part <> Nil ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( Part^.G = GG_Module ) or ( Part^.G = GG_Weapon ) then begin if ReadyToFire( GB , PC , Part ) then begin if Weapon = Nil then Weapon := Part @@ -3043,6 +4876,9 @@ var end; if ( Part^.SubCom <> Nil ) then SeekWeapon( Part^.SubCom ); if ( Part^.InvCom <> Nil ) then SeekWeapon( Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; @@ -3053,6 +4889,10 @@ const ( 9 , 6 , 3 ) ); begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Find out where the PC is. } P1 := GearCurrentLocation( PC ); @@ -3116,23 +4956,55 @@ var Mobile: Boolean; P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Record where the mek currently is. } Mobile := BaseMoveRate( Mek ) > 0; if ( NAttValue( Mek^.NA , NAG_Location , NAS_SmartAction ) <> 0 ) and Mobile then begin { The player is smartbumping. Call the appropriate procedure. } +{$IFDEF PATCH_I18N} +{$IFDEF SDLMODE} + IndicateTile( Camp^.GB , Mek , True ); +{$ELSE} + IndicateTile( Camp^.GB , Mek ); +{$ENDIF} +{$ENDIF PATCH_I18N} RLSmartAction( Camp^.GB , Mek ); end else begin GotMove := False; +{$IFDEF PATCH_CHEAT} + if Cheat_Print_TimeString then begin + DialogMsg( TimeString( Camp^.GB^.ComTime ) ); + end; + if Cheat_Autosave_Trace then begin + PCSaveCampaign_for_Trace( Camp , Mek ); + end; +{$ENDIF PATCH_CHEAT} { Start the input loop. } while (NAttValue( Mek^.NA , NAG_Action , NAS_CallTime) <= Camp^.GB^.ComTime) and (not GotMove) and (not Camp^.GB^.QuitTheGame) and GearActive( Mek ) do begin { Indicate the mek to get the action for. } DisplayGearInfo( Mek , Camp^.gb ); {$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + if Mouse_Active then begin + if IsMouseOnMap and ( not IsMenuActive ) then begin + P := MouseMapPos; + if OnTheMap( P.X , P.Y ) then begin + MouseAtTile( Camp^.GB , P.X , P.Y ); + end; + end else begin + MouseAtTile( Camp^.GB , -1 , -1 ); + end; + end; +{$ELSE PATCH_GH} P := MouseMapPos; if OnTheMap( P.X , P.Y ) and Mouse_Active then MouseAtTile( Camp^.GB , P.X , P.Y ); +{$ENDIF PATCH_GH} IndicateTile( Camp^.GB , Mek , True ); {$ELSE} @@ -3184,6 +5056,14 @@ begin end else if KP = KeyMap[ KMC_ShiftGears ].KCode then begin ShiftGears( Mek ); +{$IFDEF PATCH_CHEAT} + end else if KP = KeyMap[ KMC_Transformation ].KCode then begin + UserTransformation( Camp^.GB , Mek , False ); +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + end else if KP = KeyMap[ KMC_PurgeParts ].KCode then begin + UserPurgeParts( Camp^.GB , Mek ); +{$ENDIF PATCH_CHEAT} end else if KP = KeyMap[ KMC_ExamineMap ].KCode then begin LookAround( Camp^.GB , Mek ); end else if KP = KeyMap[ KMC_AttackMenu ].KCode then begin @@ -3265,26 +5145,63 @@ begin PCRunToggle; {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + end else if ( KP = RPK_MouseButton ) and Mouse_Active and IsMouseOnMap and ( not IsMenuActive ) then begin + PCLeftButton( Camp^.GB , Mek ); + end else if ( KP = RPK_RightButton ) and Mouse_Active then begin + GameOptionMenu( Mek , Camp^.GB ); + {$ELSE PATCH_GH} end else if ( KP = RPK_MouseButton ) and Mouse_Active then begin PCLeftButton( Camp^.GB , Mek ); end else if ( KP = RPK_RightButton ) and Mouse_Active then begin GameOptionMenu( Mek , Camp^.GB ); + {$ENDIF PATCH_GH} {$ENDIF} +{$IFDEF PATCH_GH} + end else if KP = KeyMap[ KMC_ForcePlot ].KCode then begin +{$ELSE PATCH_GH} end else if KP = 'P' then begin +{$ENDIF PATCH_GH} ForcePlot( Camp^.GB , Camp^.GB^.Scene ); +{$IFDEF PATCH_GH} + end else if ( KP = KeyMap[ KMC_MechaPartBrowser ].KCode ) and ( Camp^.GB^.Scene <> Nil ) then begin + {$IFDEF SDLMODE} + MechaPartBrowser( FindRoot( Camp^.GB^.Scene ), True, @PCActionRedraw ); + {$ELSE} + MechaPartBrowser( FindRoot( Camp^.GB^.Scene ), True ); + {$ENDIF} +{$ELSE PATCH_GH} end else if ( KP = '!' ) and ( Camp^.GB^.Scene <> Nil ) then begin -{$IFDEF SDLMODE} + {$IFDEF SDLMODE} MechaPartBrowser( FindRoot( Camp^.GB^.Scene ) , @PCActionRedraw ); -{$ELSE} + {$ELSE} MechaPartBrowser( FindRoot( Camp^.GB^.Scene ) ); -{$ENDIF} + {$ENDIF} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + end else if KP = KeyMap[ KMC_ShowRep ].KCode then begin +{$ELSE PATCH_GH} end else if KP = '@' then begin +{$ENDIF PATCH_GH} ShowRep( Mek ); +{$IFDEF PATCH_GH} + end else if KP = KeyMap[ KMC_DirectScript ].KCode then begin +{$ELSE PATCH_GH} end else if KP = '#' then begin +{$ENDIF PATCH_GH} DirectScript( Camp^.GB ); +{$IFDEF ENABLE_ADDRESSBOOK} + end else if KP = KeyMap[ KMC_AddressBook ].KCode then begin + PCAddressBook( Camp^.GB , Mek ); +{$ENDIF ENABLE_ADDRESSBOOK} + +{$IFDEF DEBUG} + end else if KP = KeyMap[ KMC_CanSeeAll ].KCode then begin + if DEBUG_CanSeeAll then DEBUG_CanSeeAll := False else DEBUG_CanSeeAll := True; +{$ENDIF DEBUG} end; {if} end; {While} @@ -3300,6 +5217,10 @@ var IT: Integer; TL: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + {$IFDEF SDLMODE} PCACTIONRD_PC := Mek; PCACTIONRD_GB := Camp^.GB; @@ -3308,7 +5229,11 @@ begin { Check the player for jumping. } TL := NAttValue( Mek^.NA , NAG_Action , NAS_TimeLimit ); if ( TL > 0 ) then begin +{$IFDEF PATCH_I18N} + DialogMsg( ReplaceHash( I18N_MsgString('GetPlayerInput','time left'), BStr( Abs( TL - Camp^.GB^.ComTime ) ) ) ); +{$ELSE PATCH_I18N} DialogMsg( BStr( Abs( TL - Camp^.GB^.ComTime ) ) + ' seconds jump time left.' ); +{$ENDIF PATCH_I18N} end; { Check the player for valid movemode. This is needed } @@ -3335,4 +5260,43 @@ begin if GearActive( Mek ) then CheckHiddenMetaterrain( Camp^.GB , Mek ); end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: pcaction.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + PCACTIONRD_PC := NIL; + PCACTIONRD_GB := NIL; + PCACTIONRD_Menu := NIL; + PCACTIONRD_MenuMek := NIL; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} +{$IFDEF ENABLE_ADDRESSBOOK} + PHONE_Name_List := Nil; +{$ENDIF ENABLE_ADDRESSBOOK} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + Attach_SmartPointer( 'PCACTIONRD_PC: GearPtr', @PCACTIONRD_PC ); + Attach_SmartPointer( 'PCACTIONRD_GB: GameBoardPtr', @PCACTIONRD_GB ); + {$ENDIF SDLMODE} + {$IFDEF ENABLE_ADDRESSBOOK} + Attach_SmartPointer( 'PHONE_Name_List: SAttPtr', @PHONE_Name_List ); + {$ENDIF ENABLE_ADDRESSBOOK} +{$ENDIF PATCH_GH} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: pcaction.pp(finalization)'); +{$ENDIF DEBUG} +{$IFDEF ENABLE_ADDRESSBOOK} + if ( PHONE_Name_List <> Nil ) then DisposeSAtt( PHONE_Name_List ); +{$ENDIF ENABLE_ADDRESSBOOK} +end; + end. diff -x .svn -uprN GearHead1100repository.original/playwright.pp branches/playwright.pp --- GearHead1100repository.original/playwright.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/playwright.pp 2009-08-16 01:40:03.922319000 +0900 @@ -24,7 +24,11 @@ unit playwright; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; { G = GG_Plot } { S = ID Number (not nessecarily unique) } @@ -57,11 +61,26 @@ Procedure AddArchAllyToScene( Adventure, implementation +uses +{$IFDEF PATCH_GH} + sysutils, +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} + ability,interact,gearutil,ghchars,ghparser,texutil,rpgdice, +{$IFDEF PATCH_GH} + arenascript, +{$ENDIF PATCH_GH} {$IFDEF SDLMODE} -uses ability,interact,gearutil,ghchars,ghparser,texutil,rpgdice,sdlgfx; + sdlgfx {$ELSE} -uses ability,interact,gearutil,ghchars,ghparser,texutil,rpgdice,context; + context {$ENDIF} + ; var Fast_Seek_Element: Array [1..NumGearStats] of GearPtr; @@ -177,6 +196,10 @@ var cmd: String; Q: Char; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Assume TRUE unless shown otherwise. } it := True; @@ -237,6 +260,10 @@ Function NPCMatchesDesc( Adv,Plot,NPC: G var it: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { DESC should contain a string list of all the stuff we want } { our NPC to have. Things like gender, personality traits, } { et cetera. Most of these things are intrinsic to the NPC, } @@ -263,6 +290,9 @@ var begin N := 0; while P <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < P^.G) then begin +{$ENDIF PATCH_GH} if ( P^.G = GG_Character ) and NPCMatchesDesc( Adv, Plot, P , IDesc , RDesc , GB ) then begin { Next, check to make sure it has an assigned CID. } CID := NAttValue( P^.NA , NAG_Personal , NAS_CID ); @@ -270,6 +300,9 @@ var end; N := N + CheckAlongPath( P^.SubCom ); N := N + CheckAlongPath( P^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} P := P^.Next; end; CheckAlongPath := N; @@ -308,6 +341,9 @@ var { CHeck along the path specified. } begin while ( Part <> Nil ) and ( TheGearWeWant = Nil ) do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} { Increment N if this gear matches our description. } if ( Part^.G = GG_Character ) and NPCMatchesDesc( Adventure, Plot, Part , Desc , RDesc , GB ) then begin { Next, check to make sure it has an assigned CID. } @@ -318,6 +354,9 @@ var if N = Num then TheGearWeWant := Part; if TheGearWeWant = Nil then CheckAlongPath( Part^.InvCom ); if TheGearWeWant = Nil then CheckAlongPath( Part^.SubCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; @@ -366,6 +405,10 @@ Function SceneDesc( Scene: GearPtr ): St var it: String; begin +{$IFDEF PATCH_GH} + if (NIL = Scene) or (Scene^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + if ( Scene = Nil ) or ( Scene^.G <> GG_Scene ) then begin it := ''; end else begin @@ -381,6 +424,10 @@ var RDesc: String; N: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Adventure) or (Adventure^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + Scene := Adventure^.SubCom; N := 0; RDesc := FilterElementDescription( Desc ); @@ -399,15 +446,25 @@ var Scene,S2: GearPtr; RDesc: String; begin +{$IFDEF PATCH_GH} + if (NIL = Adventure) or (Adventure^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + Scene := Adventure^.SubCom; S2 := Nil; RDesc := FilterElementDescription( Desc ); while Scene <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Scene^.G) then begin +{$ENDIF PATCH_GH} if ( Scene^.G = GG_Scene ) and PartMatchesCriteria( SceneDesc( Scene ) , Desc ) and PartMatchesRelativeCriteria( Adventure, Plot, Scene, GB, RDesc ) then begin Dec( Num ); if Num = 0 then S2 := Scene; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Scene := Scene^.Next; end; @@ -433,6 +490,10 @@ function FactionDesc( Fac: GearPtr ): St var it: String; begin +{$IFDEF PATCH_GH} + if (NIL = Fac) or (Fac^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + { Basic description is the faction's TYPE string attribute. } it := SATtValue( Fac^.SA , 'TYPE' ); @@ -446,12 +507,22 @@ var N: Integer; RDesc: String; begin +{$IFDEF PATCH_GH} + if (NIL = Adventure) or (Adventure^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + Fac := Adventure^.InvCom; N := 0; RDesc := FilterElementDescription( Desc ); while Fac <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Fac^.G) then begin +{$ENDIF PATCH_GH} if ( Fac^.G = GG_Faction ) and PartMatchesCriteria( FactionDesc( Fac ) , Desc ) and PartMatchesRelativeCriteria( Adventure, Plot, Fac, GB, RDesc ) then Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Fac := Fac^.Next; end; @@ -464,15 +535,25 @@ var Fac,F2: GearPtr; RDesc: String; begin +{$IFDEF PATCH_GH} + if (NIL = Adventure) or (Adventure^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + Fac := Adventure^.InvCom; F2 := Nil; RDesc := FilterElementDescription( Desc ); while Fac <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Fac^.G) then begin +{$ENDIF PATCH_GH} if ( Fac^.G = GG_Faction ) and PartMatchesCriteria( FactionDesc( Fac ) , Desc ) and PartMatchesRelativeCriteria( Adventure, Plot, Fac, GB, RDesc ) then begin Dec( Num ); if Num = 0 then F2 := Fac; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Fac := Fac^.Next; end; @@ -489,7 +570,11 @@ begin { Start with an empty string. } it := ''; +{$IFDEF PATCH_GH} + if (NIL <> Team) and (GG_DisposeGear < Team^.G) then begin +{$ELSE PATCH_GH} if Team <> Nil then begin +{$ENDIF PATCH_GH} if AreEnemies( Scene, Team^.S , NAV_DefPlayerTeam ) then begin it := it + ' enemy'; end else if AreAllies( Scene , Team^.S , NAV_DefPlayerTeam ) then begin @@ -546,6 +631,10 @@ Function FindMatchingTeam( Scene: GearPt var T,it: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Scene) or (Scene^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + { Teams are located as root subcomponents of the scene, } { so look there. } T := Scene^.SubCom; @@ -570,6 +659,10 @@ var TeamData: String; Team: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + TeamData := SAttValue( NPC^.SA , 'TEAMDATA' ); Team := FindMatchingTeam( Scene , TeamData ); @@ -592,11 +685,19 @@ Procedure DelinkNPCForEncounter( NPC: Ge var Scene: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { If the NPC is currently local, add information so that it } { will be able to return home. } Scene := NPC^.Parent; while ( Scene <> Nil ) and ( Scene^.G <> GG_Scene ) do Scene := Scene^.Parent; +{$IFDEF PATCH_GH} + if (NIL <> Scene) and (GG_DisposeGear < Scene^.G) then begin +{$ELSE PATCH_GH} if Scene <> Nil then begin +{$ENDIF PATCH_GH} SetNAtt( NPC^.NA , NAG_ParaLocation , NAS_OriginalHome , Scene^.S ); SetSATt( NPC^.SA , 'TEAMDATA <' + TeamDescription( Scene, LocateTeam( Scene , NAttValue( NPC^.NA , NAG_Location , NAS_Team ) ) ) + '>' ); end else begin @@ -620,12 +721,27 @@ var Place: String; ID: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Plot) or (Plot^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + { Find the first uninitialized entry in the list. } { This is gonna be our next element. } E := Plot^.InvCom; +{$IFDEF PATCH_GH} + While ( E <> Nil ) do begin + if (GG_DisposeGear < E^.G) then begin + if ('' = SAttValue( E^.SA , 'ELEMENT' )) then begin + break; + end; + end; + E := E^.Next; + end; +{$ELSE PATCH_GH} While ( E <> Nil ) and ( SAttValue( E^.SA , 'ELEMENT' ) <> '' ) do begin E := E^.Next; end; +{$ENDIF PATCH_GH} if E <> Nil then begin { Give our new element a unique ID, and store its ID in the Plot. } @@ -671,7 +787,11 @@ begin { and stick E in there. } while ( Dest <> Nil ) and ( Dest^.G <> GG_Scene ) do Dest := Dest^.Parent; +{$IFDEF PATCH_GH} + if (NIL <> Dest) and (GG_DisposeGear < Dest^.G) then begin +{$ELSE PATCH_GH} if Dest <> Nil then begin +{$ENDIF PATCH_GH} InsertInvCom( Dest , E ); { If E is a character, this brings us to the next problem: } @@ -704,6 +824,11 @@ var OK: Boolean; NumElements: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Adventure) or (Adventure^.G <= GG_DisposeGear) then Exit(False); + if (NIL = Plot) or (Plot^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Error check } if ( N < 1 ) or ( N > NumGearStats ) then Exit( False ); @@ -713,6 +838,9 @@ begin { Initialize OK to TRUE. } OK := True; +{$IFDEF PATCH_GH} + Element := NIL; +{$ENDIF PATCH_GH} if desc <> '' then begin EKind := ExtractWord( Desc ); @@ -775,7 +903,16 @@ begin Element := DeploySceneElement( GB , Adventure , Plot , N ); Fast_Seek_Element[ N ] := Element; OK := Element <> Nil; - end; + +{$IFDEF PATCH_GH} + end else begin + OK := False; + if Debug or ( GearName( Plot ) = 'DEBUG' ) then begin + DialogMsg( 'PLOT ERROR: Unknown Element Kind "' + EKind + '"' ) + end; + +{$ENDIF PATCH_GH} + end; end; if Debug or ( GearName( Plot ) = 'DEBUG' ) then begin @@ -793,6 +930,10 @@ var Desc: String; Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Plot) or (Plot^.G <= GG_DisposeGear) then Exit('***GG_DisposeGear***'); +{$ENDIF PATCH_GH} + Desc := UpCase( SAttValue( Plot^.SA , 'ELEMENT' + BStr( N ) ) ); if Desc <> '' then begin @@ -816,7 +957,15 @@ var R0,R1,W,C: String; S: GearPtr; N: Integer; -begin +{$IFDEF PATCH_I18N} + DItS: Boolean; {Do insert the space, or not.} + CW_I18N: Boolean; {Is the current word I18N ?} +{$ENDIF PATCH_I18N} +begin +{$IFDEF PATCH_GH} + if (NIL = RBase) or (RBase^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Locate the rumor string. } R0 := SAttValue( RBase^.SA , 'RUMOR' ); R1 := ''; @@ -825,7 +974,11 @@ begin { the actual element names. } if R0 <> '' then begin while R0 <> '' do begin +{$IFDEF PATCH_I18N} + W := ExtractWord( R0, DItS, CW_I18N ); +{$ELSE PATCH_I18N} W := ExtractWord( R0 ); +{$ENDIF PATCH_I18N} { If a string begins with !, it's to be replaced. } if W[1] = '!' then begin @@ -836,7 +989,15 @@ begin W := ElementName( Adventure , Plot , N , GB ) + W; end; +{$IFDEF PATCH_I18N} + if DItS then begin + R1 := R1 + ' ' + W; + end else begin + R1 := R1 + W; + end; +{$ELSE PATCH_I18N} R1 := R1 + ' ' + W; +{$ENDIF PATCH_I18N} end; DeleteWhiteSpace( R1 ); @@ -876,8 +1037,15 @@ var E: STring; Adventure,PFE: GearPtr; { Prefab Element } EverythingOK,OKNow: Boolean; +{$IFDEF PATCH_GH} + Trigger_tmp: String; +{$ENDIF PATCH_GH} begin { Error Check } +{$IFDEF PATCH_GH} + if (NIL = Plot) or (Plot^.G <= GG_DisposeGear) then Exit; + if (NIL = Slot) or (Slot^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if ( Plot = Nil ) or ( Slot = Nil ) then Exit; EverythingOK := True; @@ -887,6 +1055,9 @@ begin { multiple elements. } InsertInvCom( Slot , Plot ); Adventure := FindRoot( Slot ); +{$IFDEF PATCH_GH} + if (NIL = Adventure) or (Adventure^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} { Select Actors } { First clear the FastSeek array. } @@ -919,6 +1090,10 @@ begin { adventure. Initialize the stuff... rumor strings } { mostly. } InitPlot( Adventure , Plot , GB ); +{$IFDEF PATCH_GH} + Trigger_tmp := TRIGGER_InitStartGame; + CheckTriggerAlongPath( Trigger_tmp, GB, Plot, False ); +{$ENDIF PATCH_GH} end else begin { This plot won't fit in this adventure. Dispose of it. } @@ -928,16 +1103,24 @@ begin if AStringHasBString( E , 'PREFAB' ) then begin PFE := SeekPlotElement( Adventure , Plot , T , GB ); if PFE <> Nil then begin +{$IFDEF PATCH_GH} + Mark_GG_DisposeGear( PFE ); +{$ELSE PATCH_GH} if IsSubCom( PFE ) then begin RemoveGear( PFE^.Parent^.SubCom , PFE ); end else if IsInvCom( PFE ) then begin RemoveGear( PFE^.Parent^.InvCom , PFE ); end; +{$ENDIF PATCH_GH} end; {if PFE <> Nil} end; end; +{$IFDEF PATCH_GH} + Mark_GG_DisposeGear( Plot ); +{$ELSE PATCH_GH} RemoveGear( Plot^.Parent^.InvCom , Plot ); +{$ENDIF PATCH_GH} end; MatchPlotToAdventure := EverythingOK; @@ -967,6 +1150,10 @@ var T,N: Integer; E,Plot: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Arc) or (Arc^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Step One - If there are any characters requested by this plot, } { check to see if they are currently involved in other plots. If so, } { remove those other plots from play. } @@ -980,7 +1167,11 @@ begin E := SeekPlotElement( Adventure , Arc , T , GB ); if ( E <> Nil ) and ( E^.G = GG_Character ) and ( NAttValue( E^.NA , NAG_Personal , NAS_CID ) <> 0 ) then begin Plot := FindPersonaPlot( Adventure , NAttValue( E^.NA , NAG_Personal , NAS_CID ) ); +{$IFDEF PATCH_GH} + if Plot <> Nil then Mark_GG_DisposeGear( Plot ); +{$ELSE PATCH_GH} if Plot <> Nil then RemoveGear( Plot^.Parent^.InvCom , Plot ); +{$ENDIF PATCH_GH} end; Arc^.Stat[ T ] := N; @@ -1001,6 +1192,14 @@ var Plot: GearPtr; EverythingOK: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = Story) or (Story^.G <= GG_DisposeGear) + or (NIL = Arc) or (Arc^.G <= GG_DisposeGear) then begin + DisposeGear( Arc ); + Exit(False); + end; +{$ENDIF PATCH_GH} + EverythingOK := True; { Step One - Copy element info from the parent story as required. } @@ -1055,7 +1254,14 @@ var T: Integer; SubPlot,P2: GearPtr; EName: String; -begin +{$IFDEF PATCH_GH} + Trigger_tmp: String; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = Plot) or (Plot^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Find the sub-plot, if one exists. } P2 := Plot^.SubCom; SubPlot := Nil; @@ -1076,11 +1282,18 @@ begin DelinkGear( Plot^.SubCom , SubPlot ); InsertInvCom( Adv , SubPlot ); InitPlot( FindRoot( Adv ) , SubPlot , GB ); +{$IFDEF PATCH_GH} + Trigger_tmp := TRIGGER_InitStartGame; + CheckTriggerAlongPath( Trigger_tmp, GB, SubPlot, False ); +{$ENDIF PATCH_GH} end; { Finally, set the PLOT's type to absolutely nothing, so it will } { be removed. } Plot^.G := GG_AbsolutelyNothing; +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('AdvancePlot()', Plot, False ); +{$ENDIF PATCH_GH} end; Procedure SkillCheater( PC , NPC: GearPtr ); @@ -1094,6 +1307,10 @@ const var T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} if ( PC <> Nil ) and ( NPC <> Nil ) then begin { First, the combat skills get a big push. } for t := 1 to 10 do begin @@ -1120,6 +1337,11 @@ Procedure InsertNPCIntoDynamicScene( NPC var Mek: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; + if (NIL = Scene) or (Scene^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Set the NPC team value. } SetNAtt( NPC^.NA , NAG_Location , NAS_Team , Team ); @@ -1158,6 +1380,10 @@ var NPC,HOOK: GearPtr; HDesc,EDesc,CMD: String; begin +{$IFDEF PATCH_GH} + if (NIL = Scene) or (Scene^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Divide the description string into those parts which refer to } { the hook and those parts which refer to the NPC. } HDesc := ''; @@ -1199,9 +1425,15 @@ begin end; { Add the START trigger. } +{$IFDEF PATCH_GH} + CMD := SAttValue( Scene^.SA , TRIGGER_StartGame ); + CMD := 'ForceChat ' + BStr( NAttValue( NPC^.NA , NAG_Personal , NAS_CID ) ) + ' ' + CMD; + SetSATt( Scene^.SA , TRIGGER_StartGame + ' <' + CMD + '>' ); +{$ELSE PATCH_GH} CMD := SAttValue( Scene^.SA , 'START' ); CMD := 'ForceChat ' + BStr( NAttValue( NPC^.NA , NAG_Personal , NAS_CID ) ) + ' ' + CMD; SetSATt( Scene^.SA , 'START <' + CMD + '>' ); +{$ENDIF PATCH_GH} { Do NPC skill train-cheating. } { For each of the combat skills (that's the first 10) } @@ -1230,6 +1462,10 @@ var NPC,Team,Hook: GearPtr; CMD: String; begin +{$IFDEF PATCH_GH} + if (NIL = Scene) or (Scene^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Locate a suitable NPC. } NPC := CharacterSearch( Adventure , Nil , AllySearch , Nil ); @@ -1254,9 +1490,15 @@ begin InsertSubCom( Scene , Hook ); { Add the START trigger. } +{$IFDEF PATCH_GH} + CMD := SAttValue( Scene^.SA , TRIGGER_StartGame ); + CMD := 'ForceChat ' + BStr( NAttValue( NPC^.NA , NAG_Personal , NAS_CID ) ) + ' ' + CMD; + SetSATt( Scene^.SA , TRIGGER_StartGame + ' <' + CMD + '>' ); +{$ELSE PATCH_GH} CMD := SAttValue( Scene^.SA , 'START' ); CMD := 'ForceChat ' + BStr( NAttValue( NPC^.NA , NAG_Personal , NAS_CID ) ) + ' ' + CMD; SetSATt( Scene^.SA , 'START <' + CMD + '>' ); +{$ENDIF PATCH_GH} { Do NPC skill train-cheating. } { For each of the combat skills (that's the first 10) } @@ -1268,4 +1510,35 @@ begin end; +{$IFDEF PATCH_GH} +Procedure Init(); +var + i: Integer; +begin + for i := 1 to NumGearStats do begin + Fast_Seek_Element[i] := NIL; + Attach_SmartPointer( 'Fast_Seek_Element[' + IntToStr(i) + ']: GearPtr', @(Fast_Seek_Element[i]) ); + end; +end; +{$ENDIF PATCH_GH} + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: playwright.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + Init(); +{$ENDIF PATCH_GH} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: playwright.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/pseudosmartpointer.pp branches/pseudosmartpointer.pp --- GearHead1100repository.original/pseudosmartpointer.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/pseudosmartpointer.pp 2009-08-15 03:38:00.129308000 +0900 @@ -0,0 +1,123 @@ +{$IFDEF PATCH_GH} +unit pseudosmartpointer; +{ Pseudo Smart Pointer } +{ This unit is only for single threading programs. } + +interface + +type + PointerPtr = ^Pointer; + +{$IFDEF DEBUG} +var + DEBUG_MemoryLeak : Boolean = True; +{$ENDIF DEBUG} + +Procedure Trace_MemoryLeak( Msg: String; P: Pointer ); +Procedure Attach_SmartPointer( const Msg: String; const it: PointerPtr ); +Function CheckAndNIL_Pointer( const Msg: String; const it: Pointer; const ErrorMode: Boolean ): Boolean; + + + +implementation + +uses sysutils, errmsg; + +type + PseudoSmartPointerListPtr = ^PseudoSmartPointerList; + PseudoSmartPointerList = Record + P: PointerPtr; + Msg: String; + next: PseudoSmartPointerListPtr; + end; + +var + Top : PseudoSmartPointerListPtr; + + + +Procedure Trace_MemoryLeak( Msg: String; P: Pointer ); +begin +{$IFDEF DEBUG} + if DEBUG_MemoryLeak then begin + ErrorMessage_fork( 'MEMORY_TRACE: ' + Msg + ' :' + IntToHex(Int64(P), 16) ); + end; +{$ENDIF DEBUG} +end; + + + +Procedure Attach_SmartPointer( const Msg: String; const it: PointerPtr ); +var + next: PseudoSmartPointerListPtr; +begin + New( next ); + Trace_MemoryLeak('Attach_SmartPointer() New',next); + next^.P := it; + next^.Msg := Msg; + next^.next := Top; + Top := next; +end; + + + +Function CheckAndNIL_Pointer( const Msg: String; const it: Pointer; const ErrorMode: Boolean ): Boolean; +var + hit: Boolean = False; + checkptr: PseudoSmartPointerListPtr; +begin + checkptr := Top; + while NIL <> checkptr do begin + if it = checkptr^.P^ then begin + if '' <> Msg then begin + if ErrorMode then begin + ErrorMessage_fork('ERROR: ' + Msg + ' (' + checkptr^.Msg + ') is purged. :' + IntToHex(Int64(it), 16) ); + end else begin +{$IFDEF DEBUG} + ErrorMessage_fork('WARNING: ' + Msg + ' (' + checkptr^.Msg + ') is purged. :' + IntToHex(Int64(it), 16) ); +{$ENDIF DEBUG} + end; + end; + checkptr^.P^ := NIL; + hit := True; + end; + checkptr := checkptr^.next; + end; + CheckAndNIL_Pointer := hit; +end; + + + +Procedure Purge(); +var + n2: PseudoSmartPointerListPtr; +begin + while NIL <> Top do begin + n2 := Top^.next; + Trace_MemoryLeak('Purge() Dispose',Top); + Dispose( Top ); + Top := n2; + end; + Top := NIL; +end; + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: pseudosmartpointer.pp'); +{$ENDIF DEBUG} + Top := NIL; +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: pseudosmartpointer.pp(finalization)'); +{$ENDIF DEBUG} + Purge(); +end; + +end. +{$ENDIF PATCH_GH} diff -x .svn -uprN GearHead1100repository.original/randchar.pp branches/randchar.pp --- GearHead1100repository.original/randchar.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/randchar.pp 2014-12-25 09:01:00.000000000 +0900 @@ -24,7 +24,11 @@ unit randchar; interface -uses gears; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears; Const RC_DirList = Series_Directory + OS_Search_Separator + OS_Current_Directory; @@ -39,11 +43,29 @@ Procedure GenerateNewPC; implementation -{$IFDEF SDLMODE} -uses gearutil,ghchars,texutil,ui4gh,sdlgfx,sdlinfo,sdlmenus; -{$ELSE} -uses gearutil,ghchars,texutil,ui4gh,congfx,coninfo,conmenus,context; -{$ENDIF} +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, + version, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + ui4gh, + gearutil,ghchars,texutil, +{$ELSE PATCH_GH} + gearutil,ghchars,texutil,ui4gh, +{$ENDIF PATCH_GH} +{$IFDEF SDLMODE} + sdlgfx,sdlinfo,sdlmenus +{$ELSE SDLMODE} + congfx,coninfo,conmenus,context +{$ENDIF SDLMODE} + ; {$IFDEF SDLMODE} var @@ -54,7 +76,13 @@ Procedure RandCharRedraw; { Redraw the screen for SDL. } begin DrawCharGenBorder; +{$IFDEF PATCH_GH} + if (NIL <> RCPC) and (GG_DisposeGear < RCPC^.G) then begin + CharacterDisplay( RCPC , Nil ); + end; +{$ELSE PATCH_GH} if RCPC <> Nil then CharacterDisplay( RCPC , Nil ); +{$ENDIF PATCH_GH} NFGameMsg( RCDescMessage , ZONE_CharGenDesc , InfoGreen ); NFCMessage( RCPromptMessage , ZONE_CharGenPrompt , InfoGreen ); if RCCaption <> '' then NFCMessage( RCCaption , ZONE_CharGenCaption , InfoGreen ); @@ -73,7 +101,11 @@ begin { Error check- only provide description for a legal skill } { number. Otherwise just return an empty string. } if ( N >= 1 ) and ( N <= NumSkill ) then begin +{$IFDEF PATCH_I18N} + msg := '[' + I18N_Name( 'StatName', StatName[SkillMan[N].Stat] ) + '] ' + MsgString( 'SKILL_' + BStr( N ) ); +{$ELSE PATCH_I18N} msg := '[' + UpCase( StatName[SkillMan[N].Stat] ) + '] ' + MsgString( 'SKILL_' + BStr( N ) ); +{$ENDIF PATCH_I18N} end; SkillDesc := msg; end; @@ -86,10 +118,26 @@ var F: Text; { The file to write to. } begin Leader := PC; +{$IFDEF PATCH_GH} + while ( Leader <> Nil ) do begin + if (GG_DisposeGear < Leader^.G) then begin + if (GG_Character = Leader^.G) and (0 = NAttValue( Leader^.NA , NAG_CharDescription , NAS_CharType )) then begin + break; + end; + end; + Leader := Leader^.Next; + end; + if (NIL = Leader) or (Leader^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} while ( Leader <> Nil ) and ( ( Leader^.G <> GG_Character ) or ( NAttValue( Leader^.NA , NAG_CharDescription , NAS_CharType ) <> 0 ) ) do Leader := Leader^.Next; if Leader = Nil then Exit; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + FName := Save_Character_Base + TextEncode(GearName(Leader) + Default_File_Ending); +{$ELSE PATCH_I18N} FName := Save_Character_Base + GearName(Leader) + Default_File_Ending; +{$ENDIF PATCH_I18N} Assign( F , FName ); Rewrite( F ); WriteCGears( F , PC ); @@ -128,8 +176,13 @@ var begin RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_CharGenMenu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_Name('GenderName',GenderName[ NAV_Male ]) , NAV_Male ); + AddRPGMenuItem( RPM , I18N_Name('GenderName',GenderName[ NAV_Female ]) , NAV_Female ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , GenderName[ NAV_Male ] , NAV_Male ); AddRPGMenuItem( RPM , GenderName[ NAV_Female ] , NAV_Female ); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} RCDescMessage := MsgString( 'RANDCHAR_SGDesc' ); RCPromptMessage := MsgString( 'RANDCHAR_SGPrompt' ); @@ -158,7 +211,11 @@ begin RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_CharGenMenu ); for t := -4 to 10 do begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , ReplaceHash( I18N_MsgString('SelectAge','years old'), BStr(T + 20) ), T ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , BStr( T + 20 ) + ' years old' , T ); +{$ENDIF PATCH_I18N} end; {$IFDEF SDLMODE} @@ -240,6 +297,29 @@ begin if Random(3) <> 1 then M := SelectRandomSAtt( JobList ) else M := Nil; +{$IFDEF PATCH_I18N} + if ( F <> Nil ) and ( M <> Nil ) then begin + { Both father and mother had jobs worth mentioning. } + if F = M then begin + Bio1 := MsgString( 'RANDCHAR_FHBothParents1' ) + I18N_Name('Jobs',RetrieveAPreamble( F^.Info )) + MsgString( 'RANDCHAR_FHBothParents2' ); + end else if Random( 2 ) = 1 then begin + Bio1 := MsgString( 'RANDCHAR_FM1' ) + I18N_Name('Jobs',RetrieveAPreamble( F^.Info )); + Bio1 := Bio1 + MsgString( 'RANDCHAR_FM2' ) + I18N_Name('Jobs',RetrieveAPreamble( M^.Info )) + MsgString( 'RANDCHAR_FM3' ); + end else begin + Bio1 := MsgString( 'RANDCHAR_MF1' ) + I18N_Name('Jobs',RetrieveAPreamble( M^.Info )); + Bio1 := Bio1 + MsgString( 'RANDCHAR_MF2' ) + I18N_Name('Jobs',RetrieveAPreamble( F^.Info )) + MsgString( 'RANDCHAR_MF3' ); + end; + end else if F <> Nil then begin + { Father had a special job; Mother didn't. } + Bio1 := MsgString( 'RANDCHAR_F1' ) + I18N_Name('Jobs',RetrieveAPreamble( F^.Info )) + MsgString( 'RANDCHAR_F2' ); + end else if M <> Nil then begin + { Mother had a special job; Father didn't. } + Bio1 := MsgString( 'RANDCHAR_M1' ) + I18N_Name('Jobs',RetrieveAPreamble( M^.Info )) + MsgString( 'RANDCHAR_M2' ); + end else begin + { Neither father nor mother had a special job. } + Bio1 := MsgString( 'RANDCHAR_WCF' ); + end; +{$ELSE PATCH_I18N} if ( F <> Nil ) and ( M <> Nil ) then begin { Both father and mother had jobs worth mentioning. } if F = M then begin @@ -261,6 +341,7 @@ begin { Neither father nor mother had a special job. } Bio1 := MsgString( 'RANDCHAR_WCF' ); end; +{$ENDIF PATCH_I18N} { Display the created biography for the user. } {$IFDEF SDLMODE} @@ -301,12 +382,20 @@ var var msg: String; begin +{$IFDEF PATCH_I18N} + msg := I18N_Name( 'StatName', StatName[ N ] ); +{$ELSE PATCH_I18N} msg := StatName[ N ]; +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} while TextLength( Game_Font , msg ) < ( ZONE_CharGenMenu.W - 50 ) do msg := msg + ' '; -{$ELSE} +{$ELSE SDLMODE} + {$IFDEF PATCH_I18N} + while WidthMBCharStr( msg ) < 12 do msg := msg + ' '; + {$ELSE PATCH_I18N} while Length( msg ) < 12 do msg := msg + ' '; -{$ENDIF} + {$ENDIF PATCH_I18N} +{$ENDIF SDLMODE} msg := msg + BStr( PCStats[ N ] + PC^.Stat[ N ] ); StatSelectorMsg := msg; end; @@ -349,13 +438,33 @@ begin { Add RPGKeys for the left and right buttons, since these will be } { used to spend & retrieve points. } -{$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + AddRPGMenuKey( RPM, RPK_Right, 1 ); + AddRPGMenuKey( RPM, RPK_Left, -1 ); + AddRPGMenuKey( RPM, KeyMap[ KMC_Right ].KCode, 1 ); + AddRPGMenuKey( RPM, KeyMap[ KMC_Left ].KCode, -1 ); + AddRPGMenuKey( RPM, '+', 1 ); + AddRPGMenuKey( RPM, '-', -1 ); +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} + {$IFDEF PATCH_JPSSDL} + AddRPGMenuKey( RPM , '+' , 1 ); + AddRPGMenuKey( RPM , '-' , -1 ); + {$ELSE PATCH_JPSSDL} AddRPGMenuKey( RPM , RPK_Right , 1 ); AddRPGMenuKey( RPM , RPK_Left , -1 ); -{$ELSE} + {$ENDIF PATCH_JPSSDL} + {$ELSE} AddRPGMenuKey( RPM , KeyMap[ KMC_East ].KCode , 1 ); AddRPGMenuKey( RPM , KeyMap[ KMC_West ].KCode , -1 ); -{$ENDIF} + {$IFDEF PATCH_l0ugh} + if ( KeyMap[ KMC_East ].KCode <> RPK_Right ) then + AddRPGMenuKey( RPM, RPK_Right, 1 ); + if ( KeyMap[ KMC_East ].KCode <> RPK_Left ) then + AddRPGMenuKey( RPM, RPK_Left, -1 ); + {$ENDIF PATCH_l0ugh} + {$ENDIF} +{$ENDIF PATCH_GH} repeat {$IFDEF SDLMODE} @@ -483,11 +592,18 @@ begin N := 1; Job := JobList; while Job <> Nil do begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_Name('Jobs',RetrieveAPreamble( Job^.Info )) , N ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , RetrieveAPreamble( Job^.Info ) , N ); +{$ENDIF PATCH_I18N} Inc( N ); Job := Job^.Next; end; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} RPMSortAlpha( RPM ); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} N := SelectMenu( RPM , @RandCharRedraw ); @@ -536,12 +652,20 @@ var var msg: String; begin +{$IFDEF PATCH_I18N} + msg := I18N_Name('SkillMan',SkillMan[ N ].Name); +{$ELSE PATCH_I18N} msg := SkillMan[ N ].Name; +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} while TextLength( Game_Font , msg ) < ( ZONE_CharGenMenu.W - 50 ) do msg := msg + ' '; {$ELSE} +{$IFDEF PATCH_I18N} + while WidthMBCharStr( msg ) < 20 do msg := msg + ' '; +{$ELSE} while Length( msg ) < 20 do msg := msg + ' '; {$ENDIF} +{$ENDIF} msg := msg + BStr( NAttValue( PC^.NA , NAG_Skill , N ) + PCSkills[ N ] ); SkillSelectorMsg := msg; end; @@ -580,7 +704,10 @@ begin for t := 1 to NumSkill do begin AddRPGMenuItem( RPM , SkillSelectorMsg( T ) , T , SkillDesc( T ) ); end; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} RPMSortAlpha( RPM ); +{$ENDIF PATCH_I18N} AddRPGMenuItem( RPM , MsgString( 'RANDCHAR_ASPDone' ) , -2 ); RPM^.dtexcolor := InfoGreen; @@ -592,13 +719,33 @@ begin { Add RPGKeys for the left and right buttons, since these will be } { used to spend & retrieve points. } -{$IFDEF SDLMODE} +{$IFDEF PATCH_GH} + AddRPGMenuKey( RPM, RPK_Right, 1 ); + AddRPGMenuKey( RPM, RPK_Left, -1 ); + AddRPGMenuKey( RPM, KeyMap[ KMC_Right ].KCode, 1 ); + AddRPGMenuKey( RPM, KeyMap[ KMC_Left ].KCode, -1 ); + AddRPGMenuKey( RPM, '+', 1 ); + AddRPGMenuKey( RPM, '-', -1 ); +{$ELSE PATCH_GH} + {$IFDEF SDLMODE} + {$IFDEF PATCH_JPSSDL} + AddRPGMenuKey( RPM , '+' , 1 ); + AddRPGMenuKey( RPM , '-' , -1 ); + {$ELSE PATCH_JPSSDL} AddRPGMenuKey( RPM , RPK_Right , 1 ); AddRPGMenuKey( RPM , RPK_Left , -1 ); -{$ELSE} + {$ENDIF PATCH_JPSSDL} + {$ELSE} AddRPGMenuKey( RPM , KeyMap[ KMC_East ].KCode , 1 ); AddRPGMenuKey( RPM , KeyMap[ KMC_West ].KCode , -1 ); -{$ENDIF} + {$IFDEF PATCH_l0ugh} + if ( KeyMap[ KMC_East ].KCode <> RPK_Right ) then + AddRPGMenuKey( RPM, RPK_Right, 1 ); + if ( KeyMap[ KMC_East ].KCode <> RPK_Left ) then + AddRPGMenuKey( RPM, RPK_Left, -1 ); + {$ENDIF PATCH_l0ugh} + {$ENDIF} +{$ENDIF PATCH_GH} repeat {$IFDEF SDLMODE} @@ -762,11 +909,19 @@ begin if N <> Abs( NAS_Renowned ) then begin { Store the positive traits as 1... , } { the negative ones as 1+Num_Personality_Traits... } +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_Name('PTraitName',PTraitName[ N , 1 ]) , N ); + AddRPGMenuItem( RPM , I18N_Name('PTraitName',PTraitName[ N , 2 ]) , N + Num_Personality_Traits ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , PTraitName[ N , 1 ] , N ); AddRPGMenuItem( RPM , PTraitName[ N , 2 ] , N + Num_Personality_Traits ); +{$ENDIF PATCH_I18N} end; end; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} RPMSortAlpha( RPM ); +{$ENDIF PATCH_I18N} AddRPGMenuItem( RPM , MsgString( 'RANDCHAR_STCancel' ) , -1 ); Traits := 3; @@ -811,6 +966,9 @@ var RPM: RPGMenuPtr; PList: SAttPtr; P,N: Integer; +{$IFDEF PATCH_GH} + fname: String; +{$ENDIF PATCH_GH} begin RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_CharGenMenu ); AddRPGMenuItem( RPM , MsgString( 'RANDCHAR_NextPicture' ) , 1 ); @@ -826,7 +984,16 @@ begin RCDescMessage := ''; RCPromptMessage := MsgString( 'RANDCHAR_PicturePrompt' ); RCCaption := ''; +{$IFDEF PATCH_GH} + fname := PortraitName( PC ); + for P := 1 to ( NumSAtts( PList ) - 1 ) do begin + if RetrieveSAtt( PList , P )^.Info = fname then begin + break; + end; + end; +{$ELSE PATCH_GH} P := 1; +{$ENDIF PATCH_GH} repeat CleanSpriteList; @@ -873,7 +1040,11 @@ begin SkillPt := 50; Cash := 35000; {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + SetSAtt( PC^.SA , 'SDL_COLORS <' + SDL_colors_CharacterCreate + '>' ); + {$ELSE PATCH_GH} SetSAtt( PC^.SA , 'SDL_COLORS <49 91 161 252 212 195 150 112 89>' ); + {$ENDIF PATCH_GH} {$ENDIF} { First select gender, keeping in mind that the selection may be } @@ -981,6 +1152,11 @@ var begin PC := CharacterCreator; if PC <> Nil then begin +{$IFDEF PATCH_I18N} + { Output DEBUG info. } + SetSAtt( PC^.SA , Version_Generate_TAG + ' <' + Version_all + '>' ); +{$ENDIF PATCH_I18N} + { Write this character to disk. } SaveChar( PC ); @@ -989,4 +1165,26 @@ begin end; end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: randchar.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + RCPC := NIL; + Attach_SmartPointer( 'RCPC: GearPtr', @RCPC ); + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: randchar.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/randmaps.pp branches/randmaps.pp --- GearHead1100repository.original/randmaps.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/randmaps.pp 2009-08-16 01:50:29.583341000 +0900 @@ -38,7 +38,11 @@ unit RandMaps; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; const MG_Normal = 0; @@ -60,10 +64,18 @@ function RandomMap( Scene: GearPtr ): Ga implementation +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} + gearutil,ghprop,rpgdice,texutil, {$IFDEF SDLMODE} -uses gearutil,ghprop,rpgdice,texutil,sdlgfx; + sdlgfx; {$ELSE} -uses gearutil,ghprop,rpgdice,texutil,context; + context; {$ENDIF} var @@ -241,6 +253,9 @@ begin { Delete this cell, to prevent it from being chosen again. } RemoveSAtt( Cells , TheCell ); +{$IFDEF PATCH_GH} + PurgeSAtt( Cells ); +{$ENDIF PATCH_GH} end else if not OnTheMap( MF^.Stat[ STAT_XPos ] , MF^.Stat[ STAT_YPos ] ) then begin Tries := 0; @@ -330,6 +345,9 @@ Procedure AddDoor( GB: GameBoardPtr; MF, var NewDoor: GearPtr; Name: String; +{$IFDEF PATCH_I18N} + Name_org: String; +{$ENDIF PATCH_I18N} Roll,Chance: Integer; begin if DoorPrototype <> Nil then begin @@ -347,8 +365,19 @@ begin if MF <> Nil then begin Name := SAttValue( MF^.SA , 'NAME' ); +{$IFDEF PATCH_I18N} + Name_org := SAttValue( MF^.SA , 'NAME_ORG' ); + if Length(Name_org) <= 0 then begin + Name_org := Name; + end; +{$ENDIF PATCH_I18N} if Name <> '' then begin +{$IFDEF PATCH_I18N} + SetSAtt( NewDoor^.SA , 'NAME_ORG <' + ReplaceHash( I18N_MsgString('RANDMAPS_DoorSign_org'), Name_org ) + '>' ); + SetSAtt( NewDoor^.SA , 'NAME <' + ReplaceHash( I18N_MsgString('RANDMAPS_DoorSign'), Name ) + '>' ); +{$ELSE PATCH_I18N} SetSAtt( NewDoor^.SA , 'NAME <' + MsgString( 'RANDMAPS_DoorSign' ) + Name + '>' ); +{$ENDIF PATCH_I18N} end; { Possibly make the door either LOCKED or SECRET, } @@ -1225,7 +1254,13 @@ begin if GB^.Scene <> Nil then begin M := GB^.Scene^.InvCom; while ( M <> Nil ) and not it do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} it := ( NAttValue( M^.NA , NAG_Location , NAS_X ) = X ) and ( NAttValue( M^.NA , NAG_Location , NAS_Y ) = Y ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; end; @@ -1508,6 +1543,9 @@ begin if MF <> Nil then begin SubFeature := MF^.SubCom; while SubFeature <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < SubFeature^.G) then begin +{$ENDIF PATCH_GH} { Select placement of SubFeature within boundaries of MF. } if SubFeature^.G = GG_MapFeature then begin SelectPlacementPoint( GB , MF , SubFeature , Cells , Select_Check , Select_Terrain ); @@ -1515,6 +1553,9 @@ begin { Call the renderer. } RenderFeature( GB , SubFeature ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} { Move to the next sub-feature. } SubFeature := SubFeature^.Next; @@ -1536,6 +1577,12 @@ var FName: String; F: Text; begin +{$IFDEF PATCH_GH} + if (NIL = Scene) or (Scene^.G <= GG_DisposeGear) then begin + Scene := NIL; + end; +{$ENDIF PATCH_GH} + it := NewMap; it^.Scene := Scene; @@ -1555,10 +1602,22 @@ begin RandomMap := it; end; + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: randmaps.pp'); +{$ENDIF DEBUG} Standard_Param_List := LoadStringList( RandMaps_Param_File ); +end; finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: randmaps.pp(finalization)'); +{$ENDIF DEBUG} DisposeSAtt( Standard_Param_List ); +end; end. diff -x .svn -uprN GearHead1100repository.original/rnd.pp branches/rnd.pp --- GearHead1100repository.original/rnd.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/rnd.pp 2014-10-04 09:00:00.000000000 +0900 @@ -0,0 +1,76 @@ +unit rnd; +{ + Copyright(C)2014 G-HAL +} + +interface + +Procedure set_rndx(seed: LongWord); +Procedure init_rndx; +Function rndx(range: Word): Word; + + +implementation + +{$IFDEF DEBUG} +uses errmsg, texutil; +{$ENDIF DEBUG} + +var + RndWork: LongWord; + + +Procedure set_rndx(seed: LongWord); +begin + RndWork := seed; +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: set_rndx:' + BStr(seed) ); +{$ENDIF DEBUG} +end; + + +Procedure init_rndx; +begin + set_rndx($00001F71); +end; + + +Function rndx(range: Word): Word; +{$IFDEF PATCH_GH_PARANOID_SAFER} +var + tmp: Word; +{$ELSE PATCH_GH_PARANOID_SAFER} +{$ENDIF PATCH_GH_PARANOID_SAFER} +begin +{$IFDEF PATCH_GH_PARANOID_SAFER} + repeat + RndWork := ((Int64(RndWork) * Int64(5) + Int64($32113573)) mod Int64($100000000)); + tmp := (RndWork mod $10000) xor (RndWork div $10000); + until (LongWord(tmp) < ((LongWord($10000) div LongWord(range)) * LongWord(range))); + rndx := tmp mod range; +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: rndx:' + BStr(tmp) ); +{$ENDIF DEBUG} +{$ELSE PATCH_GH_PARANOID_SAFER} + rndx := Random( range ); +{$ENDIF PATCH_GH_PARANOID_SAFER} +end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: rnd.pp'); +{$ENDIF DEBUG} + init_rndx(); +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: rnd.pp(finalization)'); +{$ENDIF DEBUG} +end; + +end. +{ End of File } diff -x .svn -uprN GearHead1100repository.original/rpgdice.pp branches/rpgdice.pp --- GearHead1100repository.original/rpgdice.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/rpgdice.pp 2014-10-04 09:00:00.000000000 +0900 @@ -43,6 +43,10 @@ Const ( 0, 0, 0, 1, 1) ); +{$IFDEF PATCH_GH_PARANOID_SAFER} +Function DiceRndx(die: integer): Integer; +Function RollStepRndx(n: Integer): Integer; +{$ENDIF PATCH_GH_PARANOID_SAFER} Function Dice(die: integer): Integer; Function RollStep(n: Integer): Integer; Function RollStat(n: integer): integer; @@ -51,6 +55,39 @@ Function RollStat(n: integer): integer; implementation +{$IFDEF DEBUG} +uses errmsg + {$IFDEF PATCH_GH_PARANOID_SAFER} + ,rnd + {$ENDIF PATCH_GH_PARANOID_SAFER} + ; +{$ELSE DEBUG} + {$IFDEF PATCH_GH_PARANOID_SAFER} +uses rnd; + {$ENDIF PATCH_GH_PARANOID_SAFER} +{$ENDIF DEBUG} + +{$IFDEF PATCH_GH_PARANOID_SAFER} +Function DiceRndx(die: integer): Integer; + {Roll a die- D(6), D(8), D(100), whatever.} + {Die rolling is done as per Earthdawn- whenever a maximum is} + {rolled, the score is kept and the die rerolled. } +var + total,dr: Integer; +begin + {Range check} + if die < 2 then die := 2; + + total := 0; + repeat + dr := rndx( die ) + 1; + total := total + dr; + until dr <> Die; + + DiceRndx := total; +end; +{$ENDIF PATCH_GH_PARANOID_SAFER} + Function Dice(die: integer): Integer; {Roll a die- D(6), D(8), D(100), whatever.} {Die rolling is done as per Earthdawn- whenever a maximum is} @@ -70,6 +107,31 @@ begin Dice := total; end; +{$IFDEF PATCH_GH_PARANOID_SAFER} +Function RollStepRndx(n: Integer): Integer; + {Roll a dice step number, a la Earthdawn.} +var + N2,t1,t2,RS: Integer; +begin + RS := 0; + While N > 0 do begin + if N > 10 then + N2 := 10 + else + N2 := N; + for t1 := 1 to 5 do begin + if DieStep[N2,t1] > 0 then begin + for t2 := 1 to DieStep[N2,t1] do RS := RS + DiceRndx(DieSize[t1]); + end; + end; + + {Decrease N by 10.} + N := N - 10; + end; + RollStepRndx := RS; +end; +{$ENDIF PATCH_GH_PARANOID_SAFER} + Function RollStep(n: Integer): Integer; {Roll a dice step number, a la Earthdawn.} var @@ -136,8 +198,24 @@ begin end; + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: rpgdice.pp'); +{$ENDIF DEBUG} {Set the random seed} +{$IFDEF PATCH_GH_PARANOID_SAFER} +{$ELSE PATCH_GH_PARANOID_SAFER} Randomize; +{$ENDIF PATCH_GH_PARANOID_SAFER} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: rpgdice.pp(finalization)'); +{$ENDIF DEBUG} +end; end. diff -x .svn -uprN GearHead1100repository.original/sdlgfx.pp branches/sdlgfx.pp --- GearHead1100repository.original/sdlgfx.pp 2016-02-28 09:01:00.000000000 +0900 +++ branches/sdlgfx.pp 2016-02-28 09:01:00.000000000 +0900 @@ -23,13 +23,30 @@ unit sdlgfx; interface -uses SDL,SDL_TTF,SDL_Image,texutil,gears,dos,ui4gh; +uses +{$IFDEF PATCH_GH} +{ "sysutils" has to come before others. } + sysutils, + dos, + gears_base, + ui4gh, + SDL,SDL_TTF,SDL_Image,texutil +{$ELSE PATCH_GH} + SDL,SDL_TTF,SDL_Image,texutil,gears,dos,ui4gh +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + ,strings +{$ENDIF PATCH_I18N} + ; Type SensibleSpritePtr = ^SensibleSprite; SensibleSprite = Record Name,Color: String; W,H: Integer; { Width and Height of each cell. } +{$IFDEF PATCH_GH} + alpha_blending: Boolean; +{$ENDIF PATCH_GH} Img: PSDL_Surface; Next: SensibleSpritePtr; end; @@ -38,6 +55,9 @@ Type const +{$IFDEF PATCH_GH} + { Moved into ui4gh.pp } +{$ELSE PATCH_GH} Avocado: TSDL_Color = ( r:136; g:141; b:101 ); Bacardi: TSDL_Color = ( r:121; g:105; b:137 ); Jade: TSDL_Color = ( r: 66; g:121; b:119 ); @@ -59,12 +79,79 @@ const NeutralBrown: TSDL_Color = ( r:240; g:201; b: 20 ); BorderBlue: TSDL_Color = ( r: 0; g:101; b:151 ); BrightYellow: TSDL_Color = ( r:255; g:201; b: 0 ); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + Default_ScreenWidth = 800; + Default_ScreenHeight = 600; + Default_Right_Column_Width = 220; + Default_Dialog_Area_Height = 110; + + ScreenWidth: Integer = 800; + ScreenHeight: Integer = 600; + {$IFDEF PATCH_I18N} + {$ELSE PATCH_I18N} + BigFontSize: Integer = 14; + SmallFontSize: Integer = 11; + {$ENDIF PATCH_I18N} + Right_Column_Width: Integer = 220; + Dialog_Area_Height: Integer = 110; + + ZONE_Map: TSDL_Rect = ( x:10; y:10; w:Default_ScreenWidth - Default_Right_Column_Width - 30; h:Default_ScreenHeight - Default_Dialog_Area_Height - 20 ); + ZONE_Clock: TSDL_Rect = ( x:Default_ScreenWidth - Default_Right_Column_Width - 10; y:Default_ScreenHeight - Default_Dialog_Area_Height - 30; w:Default_Right_Column_Width; h:20 ); + ZONE_Info: TSDL_Rect = ( x:Default_ScreenWidth - Default_Right_Column_Width - 10; y:10; w:Default_Right_Column_Width; h:150 ); + ZONE_Menu: TSDL_Rect = ( x:Default_ScreenWidth - Default_Right_Column_Width - 10; y:170; w:Default_Right_Column_Width; h:Default_ScreenHeight - 210 - Default_Dialog_Area_Height ); + ZONE_Menu1: TSDL_Rect = ( x:Default_ScreenWidth - Default_Right_Column_Width - 10; y:170; w:Default_Right_Column_Width; h:130 ); + ZONE_Menu2: TSDL_Rect = ( x:Default_ScreenWidth - Default_Right_Column_Width - 10; y:310; w:Default_Right_Column_Width; h:Default_ScreenHeight - 350 - Default_Dialog_Area_Height ); + ZONE_Dialog: TSDL_Rect = ( x:10; y:Default_ScreenHeight - Default_Dialog_Area_Height; w:Default_ScreenWidth - 20; h:Default_Dialog_Area_Height - 10 ); + + ZONE_HQPilots: TSDL_Rect = ( x: 20; y:10; w:200; h:400 ); + ZONE_HQMecha: TSDL_Rect = ( x:240; y:10; w:200; h:400 ); + + ZONE_CharGenMenu: TSDL_Rect = ( x:Default_ScreenWidth - Default_Right_Column_Width - 10; y:190; w:Default_Right_Column_Width; h:Default_ScreenHeight - 230 ); + ZONE_CharGenCaption: TSDL_Rect = ( x:Default_ScreenWidth - Default_Right_Column_Width - 10; y:Default_ScreenHeight - 30; w:Default_Right_Column_Width; h:20 ); + ZONE_CharGenDesc: TSDL_Rect = ( x:10; y:Default_ScreenHeight - Default_Dialog_Area_Height; w:Default_ScreenWidth - Default_Right_Column_Width - 30; h:Default_Dialog_Area_Height - 10 ); + ZONE_CharGenPrompt: TSDL_Rect = ( x:Default_ScreenWidth - Default_Right_Column_Width - 10; y:10; w:Default_Right_Column_Width; h:170 ); + + ZONE_InteractStatus: TSDL_Rect = ( x: 35; y: 58; w:395; h: 40 ); + ZONE_InteractMsg: TSDL_Rect = ( x: 35; y:148; w:395; h:110 ); + ZONE_InteractPhoto: TSDL_Rect = ( x:435; y: 58; w:100; h:199 ); + ZONE_InteractInfo: TSDL_Rect = ( x: 35; y:103; w:395; h: 40 ); + ZONE_InteractMenu: TSDL_Rect = ( x: 35; y:263; w:500; h:120 ); + ZONE_InteractTotal: TSDL_Rect = ( x: 30; y: 53; w:510; h:335 ); + + ZONE_TextInputPrompt: TSDL_Rect = ( x:40; y:165; w:420; h:30 ); + ZONE_TextInput: TSDL_Rect = ( x:40; y:205; w:420; h:30 ); + ZONE_TextInputBigBox: TSDL_Rect = ( x:30; y:155; w:440; h:90 ); + ZONE_TextInputSmallBox: TSDL_Rect = ( x:35; y:200; w:430; h:40 ); + + ZONE_EqpMenu: TSDL_Rect = ( x:50; y: 50; w:380; h:100 ); + ZONE_InvMenu: TSDL_Rect = ( x:50; y:160; w:380; h:245 ); + ZONE_SuperBP: TSDL_Rect = ( x:40; y: 40; w:400; h:375 ); + + ZONE_Biography: TSDL_Rect = ( x:20; y:340; w:460; h:60 ); + + ZONE_YesNoTotal: TSDL_Rect = ( x:100; y:115; w:Default_ScreenWidth - Default_Right_Column_Width - 210; h:280 ); + ZONE_YesNoPrompt: TSDL_Rect = ( x:110; y:125; w:Default_ScreenWidth - Default_Right_Column_Width - 230; h:200 ); + ZONE_YesNoMenu: TSDL_Rect = ( x:110; y:335; w:Default_ScreenWidth - Default_Right_Column_Width - 230; h: 50 ); + + ZONE_UsagePrompt: TSDL_Rect = ( x:500; y:190; w:130; h:170 ); + ZONE_UsageMenu: TSDL_Rect = ( x: 50; y:155; w:380; h:245 ); + + ZONE_MoreText: TSDL_Rect = ( x:10; y:10; w:Default_ScreenWidth - 20; h:Default_ScreenHeight - 50 ); + ZONE_MorePrompt: TSDL_Rect = ( x:10; y:Default_ScreenHeight - 40; w:Default_ScreenWidth - 20; h:30 ); + + ZONE_MemoText: TSDL_Rect = ( x:110; y:125; w:Default_ScreenWidth - Default_Right_Column_Width - 230; h:200 ); + ZONE_MemoMenu: TSDL_Rect = ( x:110; y:335; w:Default_ScreenWidth - Default_Right_Column_Width - 230; h: 50 ); +{$ELSE PATCH_GH} {$IFDEF MINI} ScreenWidth = 640; ScreenHeight = 480; + {$IFDEF PATCH_I18N} + {$ELSE PATCH_I18N} BigFontSize = 10; SmallFontSize = 8; + {$ENDIF PATCH_I18N} Right_Column_Width = 180; Dialog_Area_Height = 90; @@ -118,8 +205,11 @@ const {$ELSE} ScreenWidth = 800; ScreenHeight = 600; + {$IFDEF PATCH_I18N} + {$ELSE PATCH_I18N} BigFontSize = 14; SmallFontSize = 11; + {$ENDIF PATCH_I18N} Right_Column_Width = 220; Dialog_Area_Height = 110; @@ -170,6 +260,7 @@ const ZONE_MemoText: TSDL_Rect = ( x:110; y:125; w:ScreenWidth - Right_Column_Width - 230; h:200 ); ZONE_MemoMenu: TSDL_Rect = ( x:110; y:335; w:ScreenWidth - Right_Column_Width - 230; h:50 ); {$ENDIF} +{$ENDIF PATCH_GH} Console_History_Length = 240; @@ -211,6 +302,10 @@ procedure DrawSprite( Spr: SensibleSprit procedure DrawAlphaSprite( Spr: SensibleSpritePtr; MyDest: TSDL_Rect; Frame: Integer ); Function ConfirmSprite( Name: String; const Color: String; W,H: Integer ): SensibleSpritePtr; +{$IFDEF PATCH_I18N} +function RPGKey( var Unicode: Word; const UnicodeMode: Boolean ): Char; +function RPGKey( var Unicode: Word ): Char; +{$ENDIF PATCH_I18N} function RPGKey: Char; Procedure ClrZone( var Z: TSDL_Rect ); Procedure ClrScreen; @@ -218,11 +313,17 @@ Procedure ClrScreen; Procedure QuickText( const msg: String; MyDest: TSDL_Rect; Color: TSDL_Color ); Procedure QuickTinyText( const msg: String; MyDest: TSDL_Rect; Color: TSDL_Color ); Procedure CMessage( const msg: String; Z: TSDL_Rect; var C: TSDL_Color ); +{$IFDEF PATCH_I18N} +Procedure NFVCMessage( const msg: String; Z: TSDL_Rect; var C: TSDL_Color ); +{$ENDIF PATCH_I18N} Procedure NFCMessage( const msg: String; Z: TSDL_Rect; var C: TSDL_Color ); Procedure GameMSG( const msg: string; Z: TSDL_Rect; var C: TSDL_Color ); Procedure NFGameMSG( const msg: string; Z: TSDL_Rect; var C: TSDL_Color ); +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Function DirKey( ReDrawer: RedrawProcedureType ): Integer; +{$ENDIF PATCH_GH} Procedure EndOfGameMoreKey; Function TextLength( F: PTTF_Font; const msg: String ): LongInt; @@ -230,6 +331,9 @@ Procedure InsertDialogLine( const TheLin Procedure RedrawConsole; Procedure DialogMSG(msg: string); {can't const} +{$IFDEF PATCH_GH} +Function GetStringFromUser( const Prompt: String; ReDrawer: RedrawProcedureType; const Init_text: String ): String; +{$ENDIF PATCH_GH} Function GetStringFromUser( const Prompt: String; ReDrawer: RedrawProcedureType ): String; Function MsgString( const MsgLabel: String ): String; Function MoreHighFirstLine( LList: SAttPtr ): Integer; @@ -244,14 +348,83 @@ Procedure SetupYesNoDisplay; Procedure SetupInteractDisplay( TeamColor: TSDL_Color ); Procedure SetupMemoDisplay; +{$IFDEF PATCH_I18N} +Function New_Conv_ToUni16( const arg_msg: String ): PUInt16; +Function I18N_TTF_RenderText(var font: PTTF_Font; const pline: String; var fg: TSDL_Color ): PSDL_Surface; +{$ENDIF PATCH_I18N} implementation +{$IFDEF PATCH_GH} +uses + {$IFDEF Unix} + xlib, + {$ENDIF Unix} + {$IFDEF Windows} + windows, + {$ENDIF Windows} + math, + errmsg,pseudosmartpointer, + {$IFDEF PATCH_I18N} + i18nmsg,iconv, + {$ENDIF PATCH_I18N} + gears, sdlmenus + {$IFDEF WITHOUT_SDLIM} + ,w32eb + {$ENDIF WITHOUT_SDLIM} + ; +{$ELSE PATCH_GH} + {$IFDEF PATCH_I18N} +uses + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} + i18nmsg,iconv + {$IFDEF WITHOUT_SDLIM} + ,w32eb + {$ENDIF WITHOUT_SDLIM} + ; + {$ELSE PATCH_I18N} + {$IFDEF WITHOUT_SDLIM} +uses + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} + w32eb; + {$ELSE WITHOUT_SDLIM} + {$IFDEF DEBUG} +uses errmsg; + {$ENDIF DEBUG} + {$ENDIF WITHOUT_SDLIM} + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} const WindowName: PChar = 'GearHead Arena SDL Version'; IconName: PChar = 'GearHead'; +{$IFDEF PATCH_GH} +var + wmi: TSDL_SysWMinfo; + {$IFDEF Unix} + gX11_Lock : procedure(); + gX11_Unlock : procedure(); + {$ENDIF Unix} + {$IFDEF Windows} + r: Windows.RECT; + {$ENDIF Windows} + FrameDrawDone: Boolean = False; + RPGKey_LastEvent: String = ''; + {$IFDEF PATCH_I18N} + I18N_Width_Of_One_Character: String = 'M'; + {$ENDIF PATCH_I18N} +{$ELSE PATCH_GH} + {$IFDEF PATCH_I18N} +var + I18N_Width_Of_One_Character: String = 'M'; + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} + Function RandomColorString( ColorSet: Integer ): String; { Select a random color string belonging to the provided color set. } var @@ -296,6 +469,9 @@ begin SDL_BlitSurface( Mouse_Pointer , Nil , actual_Screen , @MyDest ); end; +{$IFDEF PATCH_GH} + FrameDrawDone := True; +{$ENDIF PATCH_GH} SDL_Flip( actual_Screen ); end; @@ -398,6 +574,249 @@ begin SDL_SetPalette( MyImage , SDL_LOGPAL or SDL_PHYSPAL , MyPal , 0 , 256 ); end; +{$IFDEF PATCH_GH} +Function MakeSwapBitmapRYGA( MyImage: PSDL_Surface; RSwap,YSwap,GSwap: PSDL_Color ): PSDL_Surface; + { Swap those colors out for the requested colors. } +var + MyImage2: PSDL_Surface; + flags: UInt32; + ret: Integer; + bpp, w, h: Integer; + pitch: Uint16; + pixels: Pointer; + x, y: Integer; + p: PUint32; + c: Uint32; + rr, gg, bb, aa: Uint8; + t: Integer; +begin + { Create replacement surface. } + MyImage2 := SDL_CreateRGBSurface( ( SDL_SRCALPHA or SDL_SWSURFACE ) , MyImage^.W , MyImage^.H , 32 , $FF000000 , $00FF0000 , $0000FF00 , $000000FF ); + if ( NIL = MyImage2 ) then exit( NIL ); + + { Blit from the original to the copy. } + flags := MyImage^.flags; + SDL_SetAlpha( MyImage , ( MyImage^.flags and ( not SDL_SRCALPHA ) or SDL_RLEACCEL ) , SDL_ALPHA_OPAQUE ); + SDL_BlitSurface( MyImage , NIL , MyImage2 , NIL ); + SDL_SetAlpha( MyImage , flags , SDL_ALPHA_OPAQUE ); + SDL_SetAlpha( MyImage2 , ( MyImage2^.flags or SDL_RLEACCEL ) , SDL_ALPHA_OPAQUE ); + + { Swap colors } + ret := SDL_LockSurface( MyImage2 ); + if ( 0 <> ret ) then begin + ErrorMessage( 'Surface can not locked.' ); + exit( MyImage2 ); + end; + bpp := MyImage2^.format^.BytesPerPixel; + pixels := MyImage2^.pixels; + pitch := MyImage2^.pitch; + w := ( MyImage2^.W - 1 ); + h := ( MyImage2^.H - 1 ); + if ( 4 = bpp ) then begin + for y := 0 to h do begin + for x := 0 to w do begin + p := pixels + y * pitch + x * bpp; + c := p^; + rr := ( ( c and $FF000000 ) shr 24 ); + gg := ( ( c and $00FF0000 ) shr 16 ); + bb := ( ( c and $0000FF00 ) shr 8 ); + aa := ( ( c and $000000FF ) shr 0 ); + + if ( ( 0 = gg ) and ( 0 = bb ) ) then begin + t := rr; + rr := ScaleColorValue( RSwap^.R , t ); + gg := ScaleColorValue( RSwap^.G , t ); + bb := ScaleColorValue( RSwap^.B , t ); + end else if ( ( 0 = bb ) and ( rr = gg ) ) then begin + t := rr; + rr := ScaleColorValue( YSwap^.R , t ); + gg := ScaleColorValue( YSwap^.G , t ); + bb := ScaleColorValue( YSwap^.B , t ); + end else if ( ( 0 = rr ) and ( 0 = rr ) ) then begin + t := gg; + rr := ScaleColorValue( GSwap^.R , t ); + gg := ScaleColorValue( GSwap^.G , t ); + bb := ScaleColorValue( GSwap^.B , t ); + end; + p^ := ( ( rr shl 24 ) or ( gg shl 16 ) or ( bb shl 8 ) or ( aa shl 0 ) ); + end; + end; + end else begin + ErrorMessage( 'Surface is not 32bit RGB+alpha image.' ); + end; + SDL_UnlockSurface( MyImage2 ); + + MakeSwapBitmapRYGA := MyImage2; +end; + +Function MakeSwapBitmapHSVA( MyImage: PSDL_Surface; RSwap,YSwap,GSwap: PSDL_Color ): PSDL_Surface; + { Swap those colors out for the requested colors. } +var + MyImage2: PSDL_Surface; + flags: UInt32; + ret: Integer; + bpp, w, h: Integer; + pitch: Uint16; + pixels: Pointer; + x, y: Integer; + p: PUint32; + c: Uint32; + rr, gg, bb, aa: Uint8; + r, g, b: double; + rgb_min: double; + hsv_h, hsv_s, hsv_v: double; + t: Integer; +begin + { Create replacement surface. } + MyImage2 := SDL_CreateRGBSurface( ( SDL_SRCALPHA or SDL_SWSURFACE ) , MyImage^.W , MyImage^.H , 32 , $FF000000 , $00FF0000 , $0000FF00 , $000000FF ); + if ( NIL = MyImage2 ) then exit( NIL ); + + { Blit from the original to the copy. } + flags := MyImage^.flags; + SDL_SetAlpha( MyImage , ( MyImage^.flags and ( not SDL_SRCALPHA ) or SDL_RLEACCEL ) , SDL_ALPHA_OPAQUE ); + SDL_BlitSurface( MyImage , NIL , MyImage2 , NIL ); + SDL_SetAlpha( MyImage , flags , SDL_ALPHA_OPAQUE ); + SDL_SetAlpha( MyImage2 , ( MyImage2^.flags or SDL_RLEACCEL ) , SDL_ALPHA_OPAQUE ); + + { Swap colors } + ret := SDL_LockSurface( MyImage2 ); + if ( 0 <> ret ) then begin + ErrorMessage( 'Surface can not locked.' ); + exit( MyImage2 ); + end; + bpp := MyImage2^.format^.BytesPerPixel; + pixels := MyImage2^.pixels; + pitch := MyImage2^.pitch; + w := ( MyImage2^.W - 1 ); + h := ( MyImage2^.H - 1 ); + if ( 4 = bpp ) then begin + for y := 0 to h do begin + for x := 0 to w do begin + p := pixels + y * pitch + x * bpp; + c := p^; + rr := ( ( c and $FF000000 ) shr 24 ); + gg := ( ( c and $00FF0000 ) shr 16 ); + bb := ( ( c and $0000FF00 ) shr 8 ); + aa := ( ( c and $000000FF ) shr 0 ); + + r := ( float(rr) / 255.0 ); + g := ( float(gg) / 255.0 ); + b := ( float(bb) / 255.0 ); + hsv_v := Max( Max( r , g ) , b ); + rgb_min := Min( Min( r , g ) , b ); + hsv_h := ( hsv_v - rgb_min ); + hsv_s := hsv_h; + if ( 0.0 < hsv_h ) then begin + if ( hsv_v = r ) then begin + hsv_h := ( g - b ) / hsv_h; + if ( hsv_h < 0.0 ) then begin + hsv_h := hsv_h + 6.0; + end; + end else if ( hsv_v = g ) then begin + hsv_h := ( 2.0 + ( b - r ) / hsv_h ); + end else begin + hsv_h := ( 4.0 + ( r - g ) / hsv_h ); + end; + end; + if ( 0.0 < hsv_v ) then begin + hsv_s := ( hsv_s / hsv_v ); + end; + + t := trunc( hsv_v * 255.0 ); + if ( hsv_s < 0.5 ) then begin + rr := t; + gg := t; + bb := t; + end else if ( ( 0 = rr ) and ( 0 = gg ) ) then begin + bb := 0; + aa := 0; + end else if ( ( 4.0 < hsv_h ) or ( hsv_h < 0.5 ) ) then begin + rr := ScaleColorValue( RSwap^.R , t ); + gg := ScaleColorValue( RSwap^.G , t ); + bb := ScaleColorValue( RSwap^.B , t ); + end else if ( ( 0.5 <= hsv_h ) and ( hsv_h < 1.5 ) ) then begin + rr := ScaleColorValue( YSwap^.R , t ); + gg := ScaleColorValue( YSwap^.G , t ); + bb := ScaleColorValue( YSwap^.B , t ); + end else begin + rr := ScaleColorValue( GSwap^.R , t ); + gg := ScaleColorValue( GSwap^.G , t ); + bb := ScaleColorValue( GSwap^.B , t ); + end; + p^ := ( ( rr shl 24 ) or ( gg shl 16 ) or ( bb shl 8 ) or ( aa shl 0 ) ); + end; + end; + end else begin + ErrorMessage( 'Surface is not 32bit RGB+alpha image.' ); + end; + SDL_UnlockSurface( MyImage2 ); + + MakeSwapBitmapHSVA := MyImage2; +end; + +Function MakeSwapBitmapBA( MyImage: PSDL_Surface ): PSDL_Surface; + { Swap those colors out for the requested colors. } +var + MyImage2: PSDL_Surface; + flags: UInt32; + ret: Integer; + bpp, w, h: Integer; + pitch: Uint16; + pixels: Pointer; + x, y: Integer; + p: PUint32; + c: Uint32; + rr, gg, bb, aa: Uint8; +begin + { Create replacement surface. } + MyImage2 := SDL_CreateRGBSurface( ( SDL_SRCALPHA or SDL_SWSURFACE ) , MyImage^.W , MyImage^.H , 32 , $FF000000 , $00FF0000 , $0000FF00 , $000000FF ); + if ( NIL = MyImage2 ) then exit( NIL ); + + { Blit from the original to the copy. } + flags := MyImage^.flags; + SDL_SetAlpha( MyImage , ( MyImage^.flags and ( not SDL_SRCALPHA ) or SDL_RLEACCEL ) , SDL_ALPHA_OPAQUE ); + SDL_BlitSurface( MyImage , NIL , MyImage2 , NIL ); + SDL_SetAlpha( MyImage , flags , SDL_ALPHA_OPAQUE ); + SDL_SetAlpha( MyImage2 , ( MyImage2^.flags or SDL_RLEACCEL ) , SDL_ALPHA_OPAQUE ); + + { Swap colors } + ret := SDL_LockSurface( MyImage2 ); + if ( 0 <> ret ) then begin + ErrorMessage( 'Surface can not locked.' ); + exit( MyImage2 ); + end; + bpp := MyImage2^.format^.BytesPerPixel; + pixels := MyImage2^.pixels; + pitch := MyImage2^.pitch; + w := ( MyImage2^.W - 1 ); + h := ( MyImage2^.H - 1 ); + if ( 4 = bpp ) then begin + for y := 0 to h do begin + for x := 0 to w do begin + p := pixels + y * pitch + x * bpp; + c := p^; + rr := ( ( c and $FF000000 ) shr 24 ); + gg := ( ( c and $00FF0000 ) shr 16 ); + bb := ( ( c and $0000FF00 ) shr 8 ); + aa := ( ( c and $000000FF ) shr 0 ); + + if ( ( 0 = rr ) and ( 0 = gg ) ) then begin + bb := 0; + aa := 0; + end else begin + end; + p^ := ( ( rr shl 24 ) or ( gg shl 16 ) or ( bb shl 8 ) or ( aa shl 0 ) ); + end; + end; + end else begin + ErrorMessage( 'Surface is not 32bit RGB+alpha image.' ); + end; + SDL_UnlockSurface( MyImage2 ); + + MakeSwapBitmapBA := MyImage2; +end; +{$ENDIF PATCH_GH} + Procedure GenerateColor( var ColorString: String; var ColorStruct: TSDL_Color ); { Generate the color from the string. } var @@ -434,10 +853,16 @@ var it: SensibleSpritePtr; begin New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('NewSprite() New',it); +{$ENDIF DEBUG} if it = Nil then exit( Nil ); {Initialize values.} it^.Next := Game_Sprites; it^.Color := ''; +{$IFDEF PATCH_GH} + it^.alpha_blending := False; +{$ENDIF PATCH_GH} Game_Sprites := it; NewSprite := it; end; @@ -450,6 +875,10 @@ var it: SensibleSpritePtr; tmp: PSDL_Surface; RSwap,YSwap,GSwap: TSDL_Color; +{$IFDEF PATCH_GH} + org_name: String; + ColorSwapMode: Boolean; +{$ENDIF PATCH_GH} begin {Allocate memory for our new element.} it := NewSprite; @@ -459,6 +888,9 @@ begin it^.W := W; it^.H := H; +{$IFDEF PATCH_GH} + org_name := name; +{$ENDIF PATCH_GH} name := FSearch( name , Graphics_Directory ); if name <> '' then begin @@ -468,6 +900,64 @@ begin it^.Img := IMG_Load( fname ); if it^.Img <> Nil then begin +{$IFDEF PATCH_GH} + ColorSwapMode := False; + if ( '' <> Color ) then begin + ColorSwapMode := True; + GenerateColor( Color , RSwap ); + GenerateColor( Color , YSwap ); + GenerateColor( Color , GSwap ); + end; + if ( SDL_SRCALPHA = ( SDL_SRCALPHA and it^.Img^.flags ) ) then begin + it^.alpha_blending := True; + + { If a color swap has been specified, handle that here. } + if ColorSwapMode then begin + if ( 1 <= Pos( '.nsc.' , fname ) ) then begin + end else if ( 1 <= Pos( '.psc.' , fname ) ) then begin + tmp := MakeSwapBitmapRYGA( it^.Img , @RSwap , @YSwap , @GSwap ); + SDL_FreeSurface( it^.Img ); + it^.img := tmp; + end else begin + tmp := MakeSwapBitmapHSVA( it^.Img , @RSwap , @YSwap , @GSwap ); + SDL_FreeSurface( it^.Img ); + it^.img := tmp; + end; + end else begin + if ( 1 <= Pos( '.nsc.' , fname ) ) then begin + end else if ( 1 <= Pos( '.psc.' , fname ) ) then begin + tmp := MakeSwapBitmapBA( it^.Img ); + SDL_FreeSurface( it^.Img ); + it^.img := tmp; + end else begin + tmp := MakeSwapBitmapBA( it^.Img ); + SDL_FreeSurface( it^.Img ); + it^.img := tmp; + end; + end; + end else begin + { Set transparency color. } + SDL_SetColorKey( it^.Img , SDL_SRCCOLORKEY or SDL_RLEACCEL , SDL_MapRGB( it^.Img^.Format , 0 , 0, 255 ) ); + + { If a color swap has been specified, handle that here. } + if ColorSwapMode then begin + if UseAdvancedColoring and ( it^.Img^.format^.palette <> Nil ) then begin + RedefinePalette( it^.Img , @RSwap , @YSwap , @GSwap ); + end else begin + tmp := MakeSwapBitmap( it^.Img , @RSwap , @YSwap , @GSwap ); + SDL_FreeSurface( it^.Img ); + it^.img := tmp; + end; + + end; + + { Convert to the screen mode. } + { This will make blitting far quicker. } + tmp := SDL_ConvertSurface( it^.Img , Game_Screen^.Format , SDL_SRCCOLORKEY ); + SDL_FreeSurface( it^.Img ); + it^.Img := TMP; + end; +{$ELSE PATCH_GH} { Set transparency color. } SDL_SetColorKey( it^.Img , SDL_SRCCOLORKEY or SDL_RLEACCEL , SDL_MapRGB( it^.Img^.Format , 0 , 0, 255 ) ); @@ -492,7 +982,7 @@ begin tmp := SDL_ConvertSurface( it^.Img , Game_Screen^.Format , SDL_SRCCOLORKEY ); SDL_FreeSurface( it^.Img ); it^.Img := TMP; - +{$ENDIF PATCH_GH} end; Dispose( fname ); @@ -501,6 +991,12 @@ begin end; +{$IFDEF PATCH_GH} + if NIL = it^.Img then begin + ErrorMessage_fork('Sprite data "' + org_name + '" is not found.'); + end; +{$ENDIF PATCH_GH} + {Return a pointer to the new element.} AddSprite := it; end; @@ -513,8 +1009,32 @@ begin while LList <> Nil do begin LTemp := LList^.Next; +{$IFDEF DEBUG} + if LList^.Img <> Nil then begin + Trace_MemoryLeak('DisposeSpriteList() Dispose Img',LList^.Img); + CheckAndNIL_Pointer('DisposeSpriteList() Dispose',LList^.Img,True); + SDL_FreeSurface( LList^.Img ); + LList^.Img := NIL; + end; +{$ELSE DEBUG} if LList^.Img <> Nil then SDL_FreeSurface( LList^.Img ); +{$ENDIF DEBUG} +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeSpriteList() Dispose',LList); + CheckAndNIL_Pointer('DisposeSpriteList() Dispose',LList,True); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.Name[1] := '@'; + LList^.Color[1] := '@'; + LList^.W := -32767; + LList^.H := -32767; +{$IFDEF PATCH_GH} + LList^.alpha_blending := False; +{$ENDIF PATCH_GH} + LList^.Img := PSDL_Surface(-1); + LList^.Next := SensibleSpritePtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(LList); LList := LTemp; end; @@ -542,7 +1062,11 @@ begin if B = Nil then begin {Major FUBAR. The member we were trying to remove can't} {be found in the list.} +{$IFDEF PATCH_GH} + ErrorMessage_fork('ERROR- RemoveLink asked to remove a link that doesnt exist.'); +{$ELSE PATCH_GH} writeln('ERROR- RemoveLink asked to remove a link that doesnt exist.'); +{$ENDIF PATCH_GH} end else if A = Nil then begin {There's no element before the one we want to remove,} @@ -592,6 +1116,22 @@ begin SDL_BlitSurface( Image , @MySource , Game_Screen , @MyDest ); end; +{$IFDEF PATCH_GH} +Procedure DrawAnimImageRGBA( Image: PSDL_Surface; W,H,Frame: Integer; var MyDest: TSDL_Rect ); + { This procedure is modeled after the command from Blitz Basic. } +var + MySource: TSDL_Rect; +begin + MySource.W := W; + MySource.H := H; + if W > Image^.W then W := Image^.W; + MySource.X := ( Frame mod ( Image^.W div W ) ) * W; + MySource.Y := ( Frame div ( Image^.W div W ) ) * H + ( Image^.H div 2 ); + + SDL_BlitSurface( Image , @MySource , Game_Screen , @MyDest ); +end; +{$ENDIF PATCH_GH} + procedure DrawSprite( Spr: SensibleSpritePtr; MyDest: TSDL_Rect; Frame: Integer ); { Draw a sensible sprite. } begin @@ -607,10 +1147,18 @@ procedure DrawAlphaSprite( Spr: Sensible begin { First make sure that we have some valid sprite data... } if ( Spr <> Nil ) and ( Spr^.Img <> Nil ) then begin +{$IFDEF PATCH_GH} + if ( Spr^.alpha_blending ) then begin + DrawAnimImageRGBA( Spr^.Img , Spr^.W , Spr^.H , Frame , MyDest ); + end else begin +{$ENDIF PATCH_GH} { All the info checks out. Print it. } SDL_SetAlpha( Spr^.Img , SDL_SRCAlpha , Alpha_Level ); DrawAnimImage( Spr^.Img , Spr^.W , Spr^.H , Frame , MyDest ); SDL_SetAlpha( Spr^.Img , SDL_SRCAlpha , SDL_Alpha_Opaque ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} end; end; @@ -633,14 +1181,39 @@ begin end; +{$IFDEF PATCH_I18N} +function RPGKey( var Unicode: Word ): Char; +begin + RPGKey := RPGKey( Unicode, True ); +end; + +function RPGKey: Char; +var + dummy: Word; +begin + RPGKey := RPGKey( dummy, False ); +end; +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_I18N} +function RPGKey( var Unicode: Word; const UnicodeMode: Boolean ): Char; +{$ELSE PATCH_I18N} function RPGKey: Char; +{$ENDIF PATCH_I18N} { Read a readable key from the keyboard and return its ASCII value. } var a: String; event : TSDL_Event; m2: PChar; +{$IFDEF PATCH_GH} + t: LongInt; + MouseMoved: Boolean = False; +{$ENDIF PATCH_GH} begin a := ''; +{$IFDEF PATCH_I18N} + Unicode := 0; +{$ENDIF PATCH_I18N} repeat { Wait for events. } if SDL_PollEvent( @event ) = 1 then begin @@ -649,6 +1222,12 @@ begin { Check to see if it was an ASCII character we received. } case event.key.keysym.sym of SDLK_F1: SDL_SaveBmp( Game_Screen , 'Demo.bmp' ); +{$IFDEF PATCH_JPSSDL} + SDLK_F9: if SkipAnim then SkipAnim := False else SkipAnim := True; +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_CHEAT} + SDLK_F12: if Cheat_Display then if Cheat_Display_SW then Cheat_Display_SW := False else Cheat_Display_SW := True; +{$ENDIF PATCH_CHEAT} SDLK_Up,SDLK_KP8: a := RPK_Up; SDLK_Down,SDLK_KP2: a := RPK_Down; SDLK_Left,SDLK_KP4: a := RPK_Left; @@ -660,31 +1239,113 @@ begin SDLK_Backspace: a := #8; SDLK_KP_Enter: a := #10; SDLK_KP5: a := '5'; +{$IFDEF PATCH_GH} + SDLK_PAGEUP: a := RPK_UpRight; + SDLK_PAGEDOWN: a := RPK_DownRight; +{$ENDIF PATCH_GH} else +{$IFDEF PATCH_I18N} + if( event.key.keysym.unicode < $80 ) and ( event.key.keysym.unicode > 0 ) then begin + a := Char( event.key.keysym.unicode ); + end else if (True = UnicodeMode) and (event.key.keysym.unicode > 0) then begin + Unicode := event.key.keysym.unicode; + a := #$80; + end; +{$ELSE PATCH_I18N} if( event.key.keysym.unicode < $80 ) and ( event.key.keysym.unicode > 0 ) then begin a := Char( event.key.keysym.unicode ); end; +{$ENDIF PATCH_I18N} end; +{$IFDEF PATCH_JPSSDL} + if a = KeyMap[ KMC_ToggleDrawWall ].KCode then begin + Inc(DrawWallMode); + if 4 < DrawWallMode then DrawWallMode := 0 + else if DrawWallMode < 0 then DrawWallMode := 4; + end; +{$ENDIF PATCH_JPSSDL} end else if ( event.type_ = SDL_MOUSEButtonDown ) then begin { Return a mousebutton event, and call GHFlip to set the mouse position } { variables. } +{$IFDEF PATCH_GH} + case event.button.button of + SDL_BUTTON_LEFT: a := RPK_MouseButton; + SDL_BUTTON_MIDDLE: a := KeyMap[ KMC_ButtonMiddle ].KCode; + SDL_BUTTON_RIGHT: a := RPK_RightButton; + SDL_BUTTON_WHEELUP: a := KeyMap[ KMC_ButtonWUp ].KCode; + SDL_BUTTON_WHEELDOWN: a := KeyMap[ KMC_ButtonWDown ].KCode; + (SDL_BUTTON_WHEELDOWN+1): a := KeyMap[ KMC_ButtonWLeft ].KCode; { SDL_BUTTON_X1: (WHEEL-LEFT) } + (SDL_BUTTON_WHEELDOWN+2): a := KeyMap[ KMC_ButtonWRight ].KCode; { SDL_BUTTON_X2: (WHEEL-RIGHT) } + end; +{$ELSE PATCH_GH} if event.button.button = SDL_BUTTON_LEFT then begin a := RPK_MouseButton; end else if event.button.button = SDL_BUTTON_RIGHT then begin a := RPK_RightButton; end; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + end else if ( SDL_MOUSEButtonUp = event.type_ ) then begin + case event.button.button of + SDL_BUTTON_LEFT: a := RPK_MouseButtonRelease; + end; + + end else if ( SDL_MOUSEMOTION = event.type_ ) then begin + MouseMoved := True; +{$ENDIF PATCH_GH} end; end else begin +{$IFDEF PATCH_GH} + if 0 = Last_Clock_Update then begin + Last_Clock_Update := SDL_GetTicks - FrameInterval; + end; + if SDL_GetTicks < ( Last_Clock_Update + FrameInterval - SleepGranularity ) then begin + t := Last_Clock_Update + FrameInterval - SDL_GetTicks; + if 0 < t then begin + if t > KeysamplingInterval then SDL_Delay( KeysamplingInterval ) + else SDL_Delay( t ); + end; + end; + while (SDL_GetTicks >= (Last_Clock_Update + FrameInterval - 1)) and (FrameSkip or FrameDrawDone) do begin + Last_Clock_Update := Last_Clock_Update + FrameInterval; + Animation_Phase := ( Animation_Phase + 1 ) mod 6000; + FrameDrawDone := False; + a := RPK_TimeEvent; + end; +{$ELSE PATCH_GH} if SDL_GetTicks < ( Last_Clock_Update + 20 ) then SDL_Delay( Last_Clock_Update + 30 - SDL_GetTicks ); Last_Clock_Update := SDL_GetTicks + 30; Animation_Phase := ( Animation_Phase + 1 ) mod 6000; a := RPK_TimeEvent; +{$ENDIF PATCH_GH} end; +{$IFDEF PATCH_GH} + if ('' <> a) then begin + if RPGKey_LastEvent <> a then begin + RPGKey_LastEvent := a; + end else if ( RPK_TimeEvent = a ) then begin + if SDL_NoTimeEvent then begin + if MouseMoved then begin + MouseMoved := False; + a := RPK_MouseMotion; + end else begin + a := ''; + end; + end else begin + if MouseMoved then begin + MouseMoved := False; + a := RPK_MouseMotion; + end; + end; + end; + end; +{$ENDIF PATCH_GH} + { Keep going until either a character is found, or an error is reported. } until ( a <> '' ); @@ -716,9 +1377,18 @@ end; Function TextLength( F: PTTF_Font; const msg: String ): LongInt; { Determine how long "msg" will be using the default "game_font". } var +{$IFDEF PATCH_I18N} + pWC: PUInt16; +{$ELSE PATCH_I18N} pmsg: PChar; { Gotta convert to pchar, pain in the ass... } +{$ENDIF PATCH_I18N} W,Y: LongInt; { W means width I guess... Y is anyone's guess. Height? } begin +{$IFDEF PATCH_I18N} + pWC := New_Conv_ToUni16( msg ); + TTF_SizeUnicode( F , pWC , W , Y ); + Dispose( pWC ); +{$ELSE PATCH_I18N} { Convert the string to a pchar. } pmsg := QuickPCopy( msg ); @@ -727,10 +1397,64 @@ begin { get rid of the PChar, since it's served its usefulness. } Dispose( pmsg ); +{$ENDIF PATCH_I18N} TextLength := W; end; +{$IFDEF PATCH_I18N} +Procedure GetNextLine( var TheLine , msg , NextWord: String; Width: Integer ); + { Get a line of text of maximum width "Width". } +var + LC: Boolean; { Loop Condition. So I wasn't very creative when I named it, so what? } + BW: String; + CW_I18N: Boolean; {Is the current word I18N ?} + DItS: Boolean; {Do insert the space, or not.} +begin + { Loop condition starts out as TRUE. } + LC := True; + if TheLine = ' ' then TheLine := ''; + + { Start building the line. } + repeat + NextWord := ExtractWord( Msg, DItS, CW_I18N ); + + if '' <> NextWord then + if False = CW_I18N then begin + if TextLength( Game_Font , TheLine + ' ' + NextWord) < Width then + if DItS then TheLine := TheLine + ' ' + NextWord + else TheLine := TheLine + NextWord + else + LC := False; + end else begin + if TextLength( Game_Font , TheLine + NextWord + I18N_Width_Of_One_Character) < Width then + if DItS then TheLine := TheLine + ' ' + NextWord + else TheLine := TheLine + NextWord + else begin + LC := False; + + if Pos(NextWord, ProhibitationHead) > 0 then begin + TheLine := TheLine + NextWord + #13; + end else begin + BW := TailMBChar(TheLine); + if (0 < Length(BW)) and (0 < Pos(BW, ProhibitationTrail)) then begin + TheLine := Copy(TheLine,1,Length(TheLine)-Length(BW)); + NextWord := BW + NextWord; + end; + end; + end; + end; + until (not LC) or (NextWord = '') or ( TheLine[Length(TheLine)] = #13 ); + + { If the line ended due to a line break, deal with it. } + if ( TheLine[Length(TheLine)] = #13 ) then begin + { Display the line break as a space. } + TheLine[Length(TheLine)] := ' '; + NextWord := ExtractWord( Msg, DItS, CW_I18N ); + end; + +end; +{$ELSE PATCH_I18N} Procedure GetNextLine( var TheLine , msg , NextWord: String; Width: Integer ); { Get a line of text of maximum width "Width". } var @@ -758,6 +1482,46 @@ begin end; end; +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_I18N} +Function New_Conv_ToUni16( const arg_msg: String ): PUInt16; +const + WCLen = 576; { 512; } +var + pmsg: PChar; + pdst: PWord; +begin + pmsg := QuickPCopy(arg_msg); + pdst := PWord(StrAlloc(WCLen)); + Conv_ToUni16( pmsg, Length(arg_msg), pdst, WCLen ); + New_Conv_ToUni16 := pdst; + Dispose( pmsg ); +end; + +Function I18N_TTF_RenderText(var font: PTTF_Font; const pline: String; var fg: TSDL_Color ): PSDL_Surface; +var + pWC: PUInt16; + bg: TSDL_Color; +begin + if TERMINAL_bidiRTL then begin + pWC := New_Conv_ToUni16( Conv_bidiRTL(pline) ); + end else begin + pWC := New_Conv_ToUni16( pline ); + end; + if not(SDL_AAFont) and not(SDL_AAFont_Shaded) then begin + I18N_TTF_RenderText := TTF_RenderUnicode_Solid( font, pWC, fg ); + end else if SDL_AAFont_Shaded then begin + bg.r := 0; + bg.b := 0; + bg.g := 0; + I18N_TTF_RenderText := TTF_RenderUnicode_Shaded( font, pWC, fg, bg ); + end else begin + I18N_TTF_RenderText := TTF_RenderUnicode_Blended( font, pWC, fg ); + end; + Dispose( pWC ); +end; +{$ENDIF PATCH_I18N} {Can't const} Function PrettyPrint( msg: string; Width: Integer; var FG: TSDL_Color; DoCenter: Boolean ): PSDL_Surface; @@ -768,7 +1532,10 @@ var SList,SA: SAttPtr; S_Total,S_Temp: PSDL_Surface; MyDest: SDL_Rect; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} pline: PChar; +{$ENDIF PATCH_I18N} NextWord: String; THELine: String; {The line under construction.} begin @@ -777,7 +1544,11 @@ begin if msg = '' then Exit( Nil ); {THELine = The first word in this iteration} +{$IFDEF PATCH_I18N} + TheLine := ' '; +{$ELSE PATCH_I18N} THELine := ExtractWord( msg ); +{$ENDIF PATCH_I18N} NextWord := ''; SList := Nil; @@ -803,15 +1574,26 @@ begin { Add each stored string to the bitmap. } SA := SList; while SA <> Nil do begin +{$IFDEF PATCH_I18N} + S_Temp := I18N_TTF_RenderText( game_font , SA^.Info , fg ); +{$ELSE PATCH_I18N} pline := QuickPCopy( SA^.Info ); S_Temp := TTF_RenderText_Solid( game_font , pline , fg ); Dispose( pline ); +{$ENDIF PATCH_I18N} { We may or may not be required to do centering of the text. } if DoCenter then begin MyDest.X := ( Width - TextLength( Game_Font , SA^.Info ) ) div 2; end else begin +{$IFDEF PATCH_I18N} MyDest.X := 0; + if TERMINAL_bidiRTL then begin + MyDest.X := Width - S_Temp^.W; + end; +{$ELSE PATCH_I18N} + MyDest.X := 0; +{$ENDIF PATCH_I18N} end; SDL_BlitSurface( S_Temp , Nil , S_Total , @MyDest ); @@ -833,12 +1615,19 @@ Procedure QuickText( const msg: String; { Quickly draw some text to the screen, without worrying about } { line-splitting or justification or anything. } var +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} pline: PChar; +{$ENDIF PATCH_I18N} MyText: PSDL_Surface; begin +{$IFDEF PATCH_I18N} + MyText := I18N_TTF_RenderText( game_font , msg , Color ); +{$ELSE PATCH_I18N} pline := QuickPCopy( msg ); MyText := TTF_RenderText_Solid( game_font , pline , Color ); Dispose( pline ); +{$ENDIF PATCH_I18N} SDL_BlitSurface( MyText , Nil , Game_Screen , @MyDest ); SDL_FreeSurface( MyText ); end; @@ -847,12 +1636,19 @@ Procedure QuickTinyText( const msg: Stri { Quickly draw some text to the screen, without worrying about } { line-splitting or justification or anything. } var +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} pline: PChar; +{$ENDIF PATCH_I18N} MyText: PSDL_Surface; begin +{$IFDEF PATCH_I18N} + MyText := I18N_TTF_RenderText( info_font , msg , Color ); +{$ELSE PATCH_I18N} pline := QuickPCopy( msg ); MyText := TTF_RenderText_Solid( info_font , pline , Color ); Dispose( pline ); +{$ENDIF PATCH_I18N} MyDest.X := MyDest.X - ( MyText^.W div 2 ); SDL_BlitSurface( MyText , Nil , Game_Screen , @MyDest ); SDL_FreeSurface( MyText ); @@ -898,6 +1694,34 @@ begin end; end; +{$IFDEF PATCH_I18N} +Procedure NFVCMessage( const msg: String; Z: TSDL_Rect; var C: TSDL_Color ); + { NoFlip, No Horizontial centering, but apply Vertical centering. } +var + MyText: PSDL_Surface; + MyDest: TSDL_Rect; +begin + ClrZone( Z ); + + {$IFDEF PATCH_JPSSDL} + Z.X := Z.X + Pad_Left; + Z.Y := Z.Y + Pad_Top; + Z.W := Z.W - Pad_Left; + Z.H := Z.H - Pad_Top; + {$ENDIF PATCH_JPSSDL} + + MyText := PrettyPrint( msg , Z.W , C , False ); + if MyText <> Nil then begin + MyDest := Z; + MyDest.Y := MyDest.Y + ( Z.H - MyText^.H ) div 2; + SDL_SetClipRect( Game_Screen , @Z ); + SDL_BlitSurface( MyText , Nil , Game_Screen , @MyDest ); + SDL_FreeSurface( MyText ); + SDL_SetClipRect( Game_Screen , Nil ); + end; +end; +{$ENDIF PATCH_I18N} + Procedure NFCMessage( const msg: String; Z: TSDL_Rect; var C: TSDL_Color ); { Print a message to the screen, centered in the requested rect. } { Clear the specified zone before doing so. } @@ -924,6 +1748,12 @@ var MyText: PSDL_Surface; begin ClrZone( Z ); +{$IFDEF PATCH_JPSSDL} + Z.X := Z.X + Pad_Left; + Z.Y := Z.Y + Pad_Top; + Z.W := Z.W - Pad_Left; + Z.H := Z.H - Pad_Top; +{$ENDIF PATCH_JPSSDL} MyText := PrettyPrint( msg , Z.W , C , False ); if MyText <> Nil then begin SDL_SetClipRect( Game_Screen , @Z ); @@ -940,7 +1770,15 @@ var MyText: PSDL_Surface; begin ClrZone( Z ); +{$IFDEF PATCH_JPSSDL} + Z.X := Z.X + Pad_Left; + Z.Y := Z.Y + Pad_Top; + Z.W := Z.W - Pad_Left; + Z.H := Z.H - Pad_Top; + MyText := PrettyPrint( msg , Z.W , C , False ); +{$ELSE PATCH_JPSSDL} MyText := PrettyPrint( msg , Z.W , C , True ); +{$ENDIF PATCH_JPSSDL} if MyText <> Nil then begin SDL_SetClipRect( Game_Screen , @Z ); SDL_BlitSurface( MyText , Nil , Game_Screen , @Z ); @@ -949,6 +1787,8 @@ begin end; end; +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Function DirKey( ReDrawer: RedrawProcedureType ): Integer; { Get a direction selection from the user. If a standard direction } { key was selected, return its direction (0 is East, increase } @@ -983,6 +1823,7 @@ begin end; until DirKey <> -2; end; +{$ENDIF PATCH_GH} Procedure EndOfGameMoreKey; { The end of the game has been reached. Wait for the user to } @@ -990,16 +1831,32 @@ Procedure EndOfGameMoreKey; var A: Char; begin +{$IFDEF PATCH_GH} + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('EndOfGameMoreKey','Hit space bar') ); + {$ELSE PATCH_I18N} + DialogMSG( '[Hit space bar.]' ); + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} + { Keep reading keypresses until either a space or an ESC/Backspace is found. } repeat A := RPGKey; +{$IFDEF PATCH_GH} + if A = RPK_RightButton then begin + A := #8; + end; +{$ENDIF PATCH_GH} until ( A = ' ' ) or ( A = #27 ) or ( A = #8 ); end; Procedure InsertDialogLine( const TheLine: String ); { Insert a line of text into the dialog message area. } var +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} PLine: PChar; +{$ENDIF PATCH_I18N} MySource,MyDest: TSDL_Rect; S_Temp: PSDL_Surface; begin @@ -1019,9 +1876,20 @@ begin { Display the line in the bottom space. } MyDest := ZONE_Dialog; MyDest.Y := MyDest.Y + MyDest.H - TTF_FontLineSkip( game_font ); +{$IFDEF PATCH_JPSSDL} + MyDest.X := MyDest.X + Pad_Left; + MyDest.W := MyDest.W - Pad_Left; +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_I18N} + S_Temp := I18N_TTF_RenderText( game_font , TheLine , InfoGreen ); + if TERMINAL_bidiRTL then begin + MyDest.X := MyDest.X + MyDest.W - S_Temp^.W; + end; +{$ELSE PATCH_I18N} pline := QuickPCopy( TheLine ); S_Temp := TTF_RenderText_Solid( game_font , pline , InfoGreen ); Dispose( pline ); +{$ENDIF PATCH_I18N} SDL_BlitSurface( S_Temp , Nil , Game_Screen , @MyDest ); SDL_FreeSurface( S_Temp ); @@ -1051,6 +1919,11 @@ var THELine: String; {The line under construction.} SA: SAttPtr; begin +{$IFDEF DEBUG} + if DEBUG_TraceMacro then begin + ErrorMessage_fork( 'TRACE: DialogMSG() "' + msg + '"'); + end; +{$ENDIF DEBUG} { CLean up the message a bit. } { CLean up the message a bit. } DeleteWhiteSpace( msg ); @@ -1058,7 +1931,11 @@ begin msg := '> ' + Msg; {THELine = The first word in this iteration} +{$IFDEF PATCH_I18N} + THELine := ' '; +{$ELSE PATCH_I18N} THELine := ExtractWord( msg ); +{$ENDIF PATCH_I18N} NextWord := ''; {Start the main processing loop.} @@ -1073,6 +1950,9 @@ begin if NumSAtts( Console_History ) >= Console_History_Length then begin SA := Console_History; RemoveSAtt( Console_History , SA ); +{$IFDEF PATCH_GH} + PurgeSAtt( Console_History ); +{$ENDIF PATCH_GH} end; StoreSAtt( Console_History , TheLine ); end; @@ -1095,19 +1975,49 @@ begin SDL_FillRect( game_screen , @Dest , SDL_MapRGB( Game_Screen^.Format , 0 , 0 , 0 ) ); end; +{$IFDEF PATCH_GH} Function GetStringFromUser(const Prompt: String; ReDrawer: RedrawProcedureType ): String; +begin + GetStringFromUser := GetStringFromUser( Prompt, ReDrawer, '' ); +end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Function GetStringFromUser(const Prompt: String; ReDrawer: RedrawProcedureType; const Init_text: String ): String; +{$ELSE PATCH_GH} +Function GetStringFromUser(const Prompt: String; ReDrawer: RedrawProcedureType ): String; +{$ENDIF PATCH_GH} { Does what it says. } const +{$IFDEF PATCH_I18N} + MaxInputWidth = 80; + WCLen = 16; +{$ELSE PATCH_I18N} AllowableCharacters = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ 1234567890()-=_+,.?"*'; MaxInputLength = 80; +{$ENDIF PATCH_I18N} var A: Char; it: String; MyDest: TSDL_Rect; +{$IFDEF PATCH_I18N} + Unicode: Word; + work_dst: Array[0..WCLen] of Char; + work_pdst: PChar; + state: ShortInt = 0; + mbchar_work: String = ''; +{$ENDIF PATCH_I18N} begin { Initialize string. } +{$IFDEF PATCH_GH} + it := Init_text; +{$ELSE PATCH_GH} it := ''; +{$ENDIF PATCH_GH} +{$IFDEF WITHOUT_SDLIM} + it := w32eb.EditBox(Prompt,it); +{$ELSE WITHOUT_SDLIM} repeat { Set up the display. } if ReDrawer <> Nil then ReDrawer; @@ -1118,10 +2028,33 @@ begin NFNCCMessage( Prompt , ZONE_TextInputPrompt , StdWhite ); NFCMessage( it , ZONE_TextInput , InfoGreen ); MyDest.Y := ZONE_TextInput.Y + 2; + {$IFDEF PATCH_I18N} + if TERMINAL_bidiRTL then begin + MyDest.X := ZONE_TextInput.X + ( ZONE_TextInput.W div 2 ) - ( TextLength( Game_Font , it ) div 2 ) - Cursor_Sprite^.W; + end else begin + MyDest.X := ZONE_TextInput.X + ( ZONE_TextInput.W div 2 ) + ( TextLength( Game_Font , it ) div 2 ); + end; + {$ELSE PATCH_I18N} MyDest.X := ZONE_TextInput.X + ( ZONE_TextInput.W div 2 ) + ( TextLength( Game_Font , it ) div 2 ); + {$ENDIF PATCH_I18N} DrawSprite( Cursor_Sprite , MyDest , ( Animation_Phase div 2 ) mod 4 ); GHFlip; + {$IFDEF PATCH_I18N} + A := RPGKey( Unicode ); + + if (0 < Unicode) then begin + work_pdst := work_dst; + Conv_FromUni16( @Unicode, 2, work_pdst, WCLen ); + A := EditMBCharStr( it, 127, MaxInputWidth, #0, work_pdst, state, mbchar_work ); + {$IFDEF PATCH_GH} + end else if ( RPK_TimeEvent <> A ) and ( RPK_MouseMotion <> A ) then begin + {$ELSE PATCH_GH} + end else if RPK_TimeEvent <> A then begin + {$ENDIF PATCH_GH} + A := EditMBCharStr( it, 127, MaxInputWidth, A, NIL, state, mbchar_work ); + end; + {$ELSE PATCH_I18N} A := RPGKey; if ( A = #8 ) and ( Length( it ) > 0 ) then begin @@ -1129,7 +2062,14 @@ begin end else if ( Pos( A , AllowableCharacters ) > 0 ) and ( Length( it ) < MaxInputLength ) then begin it := it + A; end; - until ( A = #13 ) or ( A = #27 ); + {$ENDIF PATCH_I18N} + until ( A = #10 ) or ( A = #13 ) or ( A = #27 ); + {$IFDEF PATCH_GH} + if (#27 = A) then begin + it := ''; + end; + {$ENDIF PATCH_GH} +{$ENDIF WITHOUT_SDLIM} GetStringFromUser := it; end; @@ -1146,6 +2086,9 @@ Function MoreHighFirstLine( LList: SAttP var it: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = LList) then Exit(0); +{$ENDIF PATCH_GH} it := NumSAtts( LList ) - ( ZONE_MoreText.H div TTF_FontLineSkip( game_font ) ) + 1; if it < 1 then it := 1; MoreHighFirstLine := it; @@ -1161,12 +2104,19 @@ Procedure MoreText( LList: SAttPtr; Firs MyDest: TSDL_Rect; MyImage: PSDL_Surface; CLine: SAttPtr; { Current Line } + {$IFDEF PATCH_I18N} + {$ELSE PATCH_I18N} PLine: PChar; + {$ENDIF PATCH_I18N} begin { Set the clip area. } ClrZone( ZONE_MoreText ); SDL_SetClipRect( Game_Screen , @ZONE_MoreText ); MyDest := ZONE_MoreText; + {$IFDEF PATCH_JPSSDL} + MyDest.X := MyDest.X + Pad_Left; + MyDest.W := MyDest.W - Pad_Left; + {$ENDIF PATCH_JPSSDL} { Error check. } if FirstLine < 1 then FirstLine := 1 @@ -1175,9 +2125,16 @@ Procedure MoreText( LList: SAttPtr; Firs CLine := RetrieveSATt( LList , FirstLine ); for t := 1 to ( ZONE_MoreText.H div TTF_FontLineSkip( game_font ) ) do begin if CLine <> Nil then begin + {$IFDEF PATCH_I18N} + MyImage := I18N_TTF_RenderText( game_font , CLine^.Info , NeutralGrey ); + if TERMINAL_bidiRTL then begin + MyDest.X := MyDest.X + MyDest.W - MyImage^.W; + end; + {$ELSE PATCH_I18N} pline := QuickPCopy( CLine^.Info ); MyImage := TTF_RenderText_Solid( game_font , pline , NeutralGrey ); Dispose( pline ); + {$ENDIF PATCH_I18N} SDL_BlitSurface( MyImage , Nil , Game_Screen , @MyDest ); SDL_FreeSurface( MyImage ); MyDest.Y := MyDest.Y + TTF_FontLineSkip( game_font ); @@ -1191,7 +2148,29 @@ Procedure MoreText( LList: SAttPtr; Firs end; var A: Char; -begin +{$IFDEF PATCH_GH} + RPM: RPGMenuPtr; + t, t_max: Integer; + CLine: SAttPtr; { Current Line } +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if SDL_Show_MenuScrollbar then begin + CMessage( I18N_MsgString( 'MoreText' , 'Prompt' ) , ZONE_MorePrompt , InfoGreen ); + + RPM := CreateRPGMenu( NeutralGrey , MenuSelect , ZONE_MoreText ); + CLine := RetrieveSAtt( LList , 1 ); + t_max := NumSAtts( LList ); + for t := 1 to t_max do begin + AddRPGMenuItem( RPM , CLine^.Info , -1 ); + CLine := CLine^.Next; + end; + RPM^.TopItem := FirstLine; + SetItemByPosition( RPM, FirstLine ); + SelectMenu( RPM , NIL ); + DisposeRPGMenu( RPM ); + end else begin +{$ENDIF PATCH_GH} CMessage( MsgString( 'MORETEXT_Prompt' ) , ZONE_MorePrompt , InfoGreen ); { Display the screen. } @@ -1201,6 +2180,22 @@ begin { Get input from user. } A := RPGKey; +{$IFDEF PATCH_GH} + if A = KeyMap[ KMC_MenuUp ].KCode then begin + A := RPK_Up; + end else if A = KeyMap[ KMC_MenuDown ].KCode then begin + A := RPK_Down; + end else if A = KeyMap[ KMC_PageUp ].KCode then begin + A := RPK_UpRight; + end else if A = KeyMap[ KMC_PageDown ].KCode then begin + A := RPK_DownRight; + end else if A = KeyMap[ KMC_ScrollUp ].KCode then begin + A := RPK_UpRight; + end else if A = KeyMap[ KMC_ScrollDown ].KCode then begin + A := RPK_DownRight; + end; +{$ENDIF PATCH_GH} + { Possibly process this input. } if A = RPK_Down then begin Inc( FirstLine ); @@ -1208,9 +2203,32 @@ begin end else if A = RPK_Up then begin Dec( FirstLine ); DisplayTextHere; +{$IFDEF PATCH_GH} + end else if A = RPK_UpRight then begin + FirstLine := FirstLine - ( ZONE_MoreText.H div TTF_FontLineSkip( game_font ) ); + DisplayTextHere; + end else if A = RPK_DownRight then begin + FirstLine := FirstLine + ( ZONE_MoreText.H div TTF_FontLineSkip( game_font ) ); + DisplayTextHere; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_JPSSDL} + end else if A = RPK_Left then begin + FirstLine := FirstLine - ( ZONE_MoreText.H div TTF_FontLineSkip( game_font ) ); + DisplayTextHere; + end else if A = RPK_Right then begin + FirstLine := FirstLine + ( ZONE_MoreText.H div TTF_FontLineSkip( game_font ) ); + DisplayTextHere; +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_GH} + end else if A = RPK_RightButton then begin + A := #8; +{$ENDIF PATCH_GH} end; until ( A = #27 ) or ( A = 'Q' ) or ( A = #8 ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} end; Procedure DrawBPBorder; @@ -1247,6 +2265,13 @@ end; Procedure SetupHQDisplay; begin +{$IFDEF PATCH_GH} + SDL_FillRect( game_screen , Nil , SDL_MapRGB( Game_Screen^.Format , BorderBlue.R , BorderBlue.G , BorderBlue.B ) ); + ClearExtendedBorder( ZONE_Info ); + ClearExtendedBorder( ZONE_Dialog ); + ClearExtendedBorder( ZONE_Clock ); + RedrawConsole(); +{$ENDIF PATCH_GH} end; Procedure SetupFactoryDisplay; begin @@ -1284,9 +2309,226 @@ begin end; -initialization +{$IFDEF PATCH_GH} +Procedure CheckSleepGranularity; +var + i, j, t, Count, Granularity: UInt32; + sGranularity: Single; +begin + if 0 > SleepGranularity then begin + Count := 40; + for j := 0 to 1 do begin + t := 0; + i := 0; + Last_Clock_Update := SDL_GetTicks; + while (i < Count) do begin + SDL_Delay( i ); + t := t + i; + i := i + 2; + end; + Last_Clock_Update := SDL_GetTicks - Last_Clock_Update; + sGranularity := (Last_Clock_Update - t); + sGranularity := sGranularity / Count; + Granularity := (Last_Clock_Update - t) div Count; + end; + + if -1 > SleepGranularity then begin + ErrorMessage( 'Granularity of SDL_Delay is ' + IntToStr(trunc(sGranularity)) + '.' + IntToStr(trunc(sGranularity * 10.0) mod 10) + IntToStr(trunc(sGranularity * 100.0) mod 10) + IntToStr(trunc(sGranularity * 1000.0) mod 10) + ' [ms] .' ); + end; + SleepGranularity := Granularity; + Last_Clock_Update := 0; + end; +end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} +Function SearchAndOpenFont( const FontInfo: PFontSearchNameDesc; arg_ptsize: integer ): PTTF_Font; +const + TmpLen = 255; +var + i, j: Integer; + FontFile: String; + tmp: array[0..TmpLen] of Char; + ptsize: Integer; +begin + SearchAndOpenFont := NIL; + for j := 0 to (MaxFontSearchNameNum-1) do begin + for i := 1 to MaxFontSearchDirNum do begin + if 0 < Length(FontSearchDir[i]) then begin + FontFile := FontSearchDir[i] + OS_Dir_Separator + FontInfo[j].FontFile; + end else begin + FontFile := FontInfo[j].FontFile; + end; + ptsize := arg_ptsize; + if ptsize <= 0 then begin + ptsize := FontInfo[j].FontSize; + end; + if 0 < Length(FontInfo[j].FontFile) then begin + StrPCopy( tmp, FontFile ); + {$IFDEF DEBUG} + {$IFDEF PATCH_GH} + ErrorMessage_fork( '[Name:' + BStr(j) + ';Dir:' + BStr(i) + ']=' + FontFile ); + {$ENDIF PATCH_GH} + {$ENDIF DEBUG} + SearchAndOpenFont := TTF_OpenFontIndex( @tmp, ptsize, FontInfo[j].FontFace ); + if (NIL <> SearchAndOpenFont) then + break; + end; + end; + if (NIL <> SearchAndOpenFont) then + break; + end; +end; +{$ENDIF PATCH_I18N} + + +{$IFDEF PATCH_GH} +Procedure Preset_SIZE; + Procedure Set_SDLrect( Rect: PSDL_Rect ); + begin + if 0 < ScreenSize_Width then begin + Rect^.x := Rect^.x * ScreenSize_Width div ScreenWidth; + Rect^.w := Rect^.w * ScreenSize_Width div ScreenWidth; + end; + if 0 < ScreenSize_Height then begin + Rect^.y := Rect^.y * ScreenSize_Height div ScreenHeight; + Rect^.h := Rect^.h * ScreenSize_Height div ScreenHeight; + end; + end; +begin + if SDL_Mini then begin + ScreenWidth := 640; + ScreenHeight := 480; + {$IFDEF PATCH_I18N} + {$ELSE PATCH_I18N} + BigFontSize := 10; + SmallFontSize := 8; + {$ENDIF PATCH_I18N} + Right_Column_Width := 180; + Dialog_Area_Height := 90; + + with ZONE_Map do begin x := 10; y := 10; w := (ScreenWidth - Right_Column_Width - 30); h := (ScreenHeight - Dialog_Area_Height - 20); end; + with ZONE_Clock do begin x := (ScreenWidth - Right_Column_Width - 10); y := (ScreenHeight - Dialog_Area_Height - 30); w := Right_Column_Width; h := 20; end; + with ZONE_Info do begin x := (ScreenWidth - Right_Column_Width - 10); y := 10; w := Right_Column_Width; h := 150; end; + with ZONE_Menu do begin x := (ScreenWidth - Right_Column_Width - 10); y := 170; w := Right_Column_Width; h := (ScreenHeight - 210 - Dialog_Area_Height); end; + with ZONE_Menu1 do begin x := (ScreenWidth - Right_Column_Width - 10); y := 170; w := Right_Column_Width; h := 100; end; + with ZONE_Menu2 do begin x := (ScreenWidth - Right_Column_Width - 10); y := 280; w := Right_Column_Width; h := (ScreenHeight - 320 - Dialog_Area_Height); end; + with ZONE_Dialog do begin x := 10; y := (ScreenHeight - Dialog_Area_Height); w := (ScreenWidth - 20); h := (Dialog_Area_Height - 10); end; + + with ZONE_HQPilots do begin x := 20; y := 10; w := 200; h := 400; end; + with ZONE_HQMecha do begin x := 240; y := 10; w := 200; h := 400; end; + + with ZONE_CharGenMenu do begin x := (ScreenWidth - Right_Column_Width - 10); y := 190; w := Right_Column_Width; h := (ScreenHeight - 230); end; + with ZONE_CharGenCaption do begin x := (ScreenWidth - Right_Column_Width - 10); y := (ScreenHeight - 30); w := Right_Column_Width; h := 20; end; + with ZONE_CharGenDesc do begin x := 10; y := (ScreenHeight - Dialog_Area_Height); w := (ScreenWidth - Right_Column_Width - 30); h := (Dialog_Area_Height - 10); end; + with ZONE_CharGenPrompt do begin x := (ScreenWidth - Right_Column_Width - 10); y := 10; w := Right_Column_Width; h := 170; end; + + with ZONE_InteractStatus do begin x := 25; y := 48; w := 295; h := 30; end; + with ZONE_InteractMsg do begin x := 25; y := 118; w := 295; h := 90; end; + with ZONE_InteractPhoto do begin x := 325; y := 48; w := 100; h := 160; end; + with ZONE_InteractInfo do begin x := 25; y := 83; w := 295; h := 30; end; + with ZONE_InteractMenu do begin x := 25; y := 218; w := 400; h := 115; end; + with ZONE_InteractTotal do begin x := 20; y := 43; w := 410; h := 295; end; + + with ZONE_TextInputPrompt do begin x := 40; y := 165; w := 320; h := 30; end; + with ZONE_TextInput do begin x := 40; y := 205; w := 320; h := 30; end; + with ZONE_TextInputBigBox do begin x := 30; y := 155; w := 340; h := 95; end; + with ZONE_TextInputSmallBox do begin x := 35; y := 200; w := 330; h := 40; end; + + with ZONE_EqpMenu do begin x := 50; y := 50; w := 280; h := 75; end; + with ZONE_InvMenu do begin x := 50; y := 135; w := 280; h := 180; end; + with ZONE_SuperBP do begin x := 40; Y := 40; W := 300; H := 285; end; + + with ZONE_Biography do begin x := 20; y := 340; w := 460; h := 60; end; + + with ZONE_YesNoTotal do begin x := 100; y := 115; w := (ScreenWidth - Right_Column_Width - 210); h := 280; end; + with ZONE_YesNoPrompt do begin x := 110; y := 125; w := (ScreenWidth - Right_Column_Width - 230); h := 200; end; + with ZONE_YesNoMenu do begin x := 110; y := 335; w := (ScreenWidth - Right_Column_Width - 230); h := 50; end; + + with ZONE_UsagePrompt do begin x := 500; y := 190; w := 130; h := 170; end; + with ZONE_UsageMenu do begin x := 50; y := 155; w := 380; h := 245; end; + + with ZONE_MoreText do begin x := 10; y := 10; w := (ScreenWidth - 20); h := (ScreenHeight - 50); end; + with ZONE_MorePrompt do begin x := 10; y := (ScreenHeight - 40); w := (ScreenWidth - 20); h := 30; end; + + with ZONE_MemoText do begin x := 110; y := 125; w := (ScreenWidth - Right_Column_Width - 230); h := 200; end; + with ZONE_MemoMenu do begin x := 110; y := 335; w := (ScreenWidth - Right_Column_Width - 230); h := 50; end; + end; + if (0 < ScreenSize_Width) or (0 < ScreenSize_Height) then begin + Set_SDLrect( @ZONE_Map ); + Set_SDLrect( @ZONE_Clock ); + Set_SDLrect( @ZONE_Info ); + Set_SDLrect( @ZONE_Menu ); + Set_SDLrect( @ZONE_Menu1 ); + Set_SDLrect( @ZONE_Menu2 ); + Set_SDLrect( @ZONE_Dialog ); + + Set_SDLrect( @ZONE_HQPilots ); + Set_SDLrect( @ZONE_HQMecha ); + + Set_SDLrect( @ZONE_CharGenMenu ); + Set_SDLrect( @ZONE_CharGenCaption ); + Set_SDLrect( @ZONE_CharGenDesc ); + Set_SDLrect( @ZONE_CharGenPrompt ); + + Set_SDLrect( @ZONE_InteractStatus ); + Set_SDLrect( @ZONE_InteractMsg ); + Set_SDLrect( @ZONE_InteractPhoto ); + Set_SDLrect( @ZONE_InteractInfo ); + Set_SDLrect( @ZONE_InteractMenu ); + Set_SDLrect( @ZONE_InteractTotal ); + + Set_SDLrect( @ZONE_TextInputPrompt ); + Set_SDLrect( @ZONE_TextInput ); + Set_SDLrect( @ZONE_TextInputBigBox ); + Set_SDLrect( @ZONE_TextInputSmallBox ); + + Set_SDLrect( @ZONE_EqpMenu ); + Set_SDLrect( @ZONE_InvMenu ); + Set_SDLrect( @ZONE_SuperBP ); + + Set_SDLrect( @ZONE_Biography ); + + Set_SDLrect( @ZONE_YesNoTotal ); + Set_SDLrect( @ZONE_YesNoPrompt ); + Set_SDLrect( @ZONE_YesNoMenu ); + + Set_SDLrect( @ZONE_UsagePrompt ); + Set_SDLrect( @ZONE_UsageMenu ); + + Set_SDLrect( @ZONE_MoreText ); + Set_SDLrect( @ZONE_MorePrompt ); + + Set_SDLrect( @ZONE_MemoText ); + Set_SDLrect( @ZONE_MemoMenu ); + ScreenWidth := ScreenSize_Width; + ScreenHeight := ScreenSize_Height; + end; +end; +{$ENDIF PATCH_GH} + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: sdlgfx.pp'); +{$ENDIF DEBUG} + +{$IFDEF PATCH_GH} + Preset_SIZE; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + I18N_Width_Of_One_Character := I18N_Settings('SDLGFX_I18N_WIDTH_OF_ONE_CHARACTER','M'); +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH} + SDL_Init( SDL_INIT_VIDEO or SDL_INIT_TIMER ); +{$ELSE PATCH} SDL_Init( SDL_INIT_VIDEO or SDL_INIT_AUDIO ); +{$ENDIF PATCH} if DoFullScreen then begin Actual_Screen := SDL_SetVideoMode(ScreenWidth, ScreenHeight, 0, SDL_HWSURFACE or SDL_FULLSCREEN or SDL_DoubleBuf ); @@ -1296,9 +2538,39 @@ initialization Actual_Screen := SDL_SetVideoMode(ScreenWidth, ScreenHeight, 0, SDL_HWSURFACE or SDL_DoubleBuf ); Mouse_Pointer := Nil; end; +{$IFDEF PATCH_GH} + if (NIL = Actual_Screen) then begin + ErrorMessage('SDL_SetVideoMode() failed.'); + halt(255); + end; +{$ENDIF PATCH_GH} { Game_Screen := SDL_CreateRGBSurface( SDL_HWSURFACE , ScreenWidth , ScreenHeight , 16 , 0 , 0 , 0 , 0 );} Game_Screen := SDL_ConvertSurface( Actual_Screen , Actual_Screen^.Format , SDL_HWSURFACE ); +{$IFDEF PATCH_GH} + if (NIL = Game_Screen) then begin + ErrorMessage('SDL_ConvertSurface() failed.'); + halt(255); + end; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + if ( ( -1 <> ScreenPos_X ) and ( -1 <> ScreenPos_Y ) ) then begin + SDL_VERSION( wmi.version ); + if ( 1 = SDL_GetWMInfo( @wmi ) ) then begin + {$IFDEF Unix} + Pointer(gX11_Lock) := wmi.x11.lock_func; + Pointer(gX11_Unlock) := wmi.x11.unlock_func; + gX11_Lock; + xlib.XMoveWindow( wmi.x11.display , wmi.x11.wmwindow , ScreenPos_X , ScreenPos_Y ); + gX11_Unlock; + {$ENDIF Unix} + {$IFDEF Windows} + Windows.GetWindowRect( wmi.window , @r ); + Windows.MoveWindow( wmi.window , ScreenPos_X , ScreenPos_Y , ( r.right - r.left ) , ( r.bottom - r.top ) , FALSE ); + {$ENDIF Windows} + end; + end; +{$ENDIF PATCH_GH} SDL_EnableUNICODE( 1 ); SDL_EnableKeyRepeat( GH_REPEAT_DELAY , GH_REPEAT_INTERVAL ); @@ -1309,15 +2581,35 @@ initialization Cursor_Sprite := ConfirmSprite( 'cursor.png' , '' , 8 , 16 ); TTF_Init; +{$IFDEF PATCH_I18N} + Game_Font := SearchAndOpenFont( @FontSearchName_Big, FontSize_Big ); + Info_Font := SearchAndOpenFont( @FontSearchName_Small, FontSize_Small ); +{$ELSE PATCH_I18N} Game_Font := TTF_OpenFont( 'Image' + OS_Dir_Separator + 'VeraBd.ttf' , BigFontSize ); Info_Font := TTF_OpenFont( 'Image' + OS_Dir_Separator + 'VeraMoBd.ttf' , SmallFontSize ); +{$ENDIF PATCH_I18N} Text_Messages := LoadStringList( Standard_Message_File ); Console_History := Nil; +{$IFDEF PATCH_GH} + if (NIL = Game_Font) or (NIL = Info_Font) then begin + ErrorMessage('No fonts were found.'); + halt(1); + end; + if (NIL = Text_Messages) then begin + ErrorMessage('Standard_Message_File was not found.'); + halt(1); + end; + Attach_SmartPointer( 'Console_History: SAttPtr', @Console_History ); +{$ENDIF PATCH_GH} + SDL_WM_SetCaption( WindowName , IconName ); Animation_Phase := 0; +{$IFDEF PATCH_GH} + CheckSleepGranularity; +{$ENDIF PATCH_GH} Last_Clock_Update := 0; MasterColorList := LoadStringList( Data_Directory + 'sdl_colors.txt' ); @@ -1327,7 +2619,13 @@ initialization Music_List := LoadStringList( 'music.cfg' ); MyMusic := Nil; } +end; + finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: sdlgfx.pp(finalization)'); +{$ENDIF DEBUG} { if MyMusic <> Nil then MIX_FreeMusic( MyMusic ); MIX_CloseAudio; @@ -1347,6 +2645,8 @@ finalization DisposeSAtt( Text_Messages ); DisposeSAtt( Console_History ); - DisposeSAtt( MasterColorList ) + DisposeSAtt( MasterColorList ) + +end; end. diff -x .svn -uprN GearHead1100repository.original/sdlinfo.pp branches/sdlinfo.pp --- GearHead1100repository.original/sdlinfo.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/sdlinfo.pp 2015-01-12 09:01:00.000000000 +0900 @@ -23,7 +23,15 @@ unit sdlinfo; interface -uses sdl,sdl_ttf,sdlgfx,gears,gearutil,damage,movement,texutil,ability,locale,sdlmap,interact,effects; +uses +{$IFDEF PATCH_GH} + gears_base, + gears, + sdl,sdl_ttf,sdlgfx,gearutil,damage,movement,texutil,ability,locale,sdlmap,interact,effects +{$ELSE PATCH_GH} + sdl,sdl_ttf,sdlgfx,gears,gearutil,damage,movement,texutil,ability,locale,sdlmap,interact,effects +{$ENDIF PATCH_GH} + ; var CHAT_Message: String; @@ -32,9 +40,15 @@ var Function JobAgeGenderDesc( NPC: GearPtr ): String; Procedure LocationInfo( Part: GearPtr; gb: GameBoardPtr ); +{$IFDEF PATCH_GH} +Procedure DisplayGearInfo( Part: GearPtr; DebugMode: Boolean ); +{$ENDIF PATCH_GH} Procedure DisplayGearInfo( Part: GearPtr ); Procedure DisplayGearInfo( Part: GearPtr; gb: GameBoardPtr ); Procedure DisplayGearInfo( Part: GearPtr; gb: GameBoardPtr; Z: TSDL_Rect ); +{$IFDEF PATCH_GH} +Function PortraitName( NPC: GearPtr ): String; +{$ENDIF PATCH_GH} Procedure DisplayInteractStatus( GB: GameBoardPtr; NPC: GearPtr; React,Endurance: Integer ); Procedure QuickWeaponInfo( Part: GearPtr ); @@ -46,15 +60,35 @@ Procedure MapEditInfo( Pen,Palette,X,Y: implementation -uses ghmodule,ghweapon,ghmecha,ghchars,ghsupport; +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + i18nmsg,iconv, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + ui4gh, +{$ENDIF PATCH_CHEAT} + ghmodule,ghweapon,ghmecha,ghchars,ghsupport; const +{$IFDEF PATCH_GH} + { for Color Barrier Free } + { Moved into sdlgfx.pp } +{$ELSE PATCH_GH} StatusPerfect:TSDL_Color = ( r: 0; g:255; b: 65 ); StatusOK:TSDL_Color = ( r: 30; g:190; b: 10 ); StatusFair:TSDL_Color = ( r:220; g:190; b: 0 ); StatusBad:TSDL_Color = ( r:220; g: 50; b: 0 ); StatusCritical:TSDL_Color = ( r:150; g: 0; b: 0 ); StatusKO:TSDL_Color = ( r: 75; g: 75; b: 75 ); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + MaxDamageGauge = 10; + MaxModule = 9; +{$ENDIF PATCH_GH} Interact_Sprite_Name = 'interact.png'; Module_Sprite_Name = 'modules.png'; @@ -77,12 +111,23 @@ Function JobAgeGenderDesc( NPC: GearPtr var msg,job: String; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + JobAgeGenderDesc := ReplaceHash( I18N_MsgString('JobAgeGenderDesc'), + BStr( NAttValue( NPC^.NA , NAG_CharDescription , NAS_DAge ) + 20 ), + I18N_Name('GenderName',GenderName[ NAttValue( NPC^.NA , NAG_CharDescription , NAS_Gender ) ]), + I18N_Name('Jobs',SAttValue( NPC^.SA , 'JOB' )) ); +{$ELSE PATCH_I18N} msg := BStr( NAttValue( NPC^.NA , NAG_CharDescription , NAS_DAge ) + 20 ); msg := msg + ' year old ' + LowerCase( GenderName[ NAttValue( NPC^.NA , NAG_CharDescription , NAS_Gender ) ] ); job := SAttValue( NPC^.SA , 'JOB' ); if job <> '' then msg := msg + ' ' + LowerCase( job ); msg := msg + '.'; JobAgeGenderDesc := msg; +{$ENDIF PATCH_I18N} end; Function MaxTArmor( Part: GearPtr ): LongInt; @@ -91,6 +136,10 @@ var it: LongInt; S: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + it := GearMaxArmor( Part ); S := Part^.InvCom; while S <> Nil do begin @@ -106,6 +155,10 @@ var it: LongInt; S: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + it := GearCurrentArmor( Part ); S := Part^.InvCom; while S <> Nil do begin @@ -126,11 +179,18 @@ Procedure AI_Title( msg: String; C: TSDL { Draw a centered message on the current line. } var MyImage: PSDL_Surface; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} PLine: PChar; +{$ENDIF PATCH_I18N} begin +{$IFDEF PATCH_I18N} + MyImage := I18N_TTF_RenderText( Game_Font , msg , C ); +{$ELSE PATCH_I18N} pline := QuickPCopy( msg ); MyImage := TTF_RenderText_Solid( Game_Font , pline , C ); Dispose( pline ); +{$ENDIF PATCH_I18N} if MyImage <> Nil then CDest.X := CZone.X + ( ( CZone.W - MyImage^.W ) div 2 ); @@ -144,11 +204,18 @@ Procedure AI_SmallTitle( msg: String; C: { Draw a centered message on the current line. } var MyImage: PSDL_Surface; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} PLine: PChar; +{$ENDIF PATCH_I18N} begin +{$IFDEF PATCH_I18N} + MyImage := I18N_TTF_RenderText( Info_Font , msg , C ); +{$ELSE PATCH_I18N} pline := QuickPCopy( msg ); MyImage := TTF_RenderText_Solid( Info_Font , pline , C ); Dispose( pline ); +{$ENDIF PATCH_I18N} CDest.X := CZone.X + ( ( CZone.W - MyImage^.W ) div 2 ); @@ -163,13 +230,25 @@ Procedure AI_Line( msg: String; C: TSDL_ { Draw a left justified message on the current line. } var MyImage: PSDL_Surface; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} PLine: PChar; +{$ENDIF PATCH_I18N} begin +{$IFDEF PATCH_I18N} + MyImage := I18N_TTF_RenderText( Info_Font , msg , C ); + + CDest.X := CZone.X; + if TERMINAL_bidiRTL then begin + CDest.X := CDest.X + CZone.W - MyImage^.W; + end; +{$ELSE PATCH_I18N} pline := QuickPCopy( msg ); MyImage := TTF_RenderText_Solid( Info_Font , pline , C ); Dispose( pline ); CDest.X := CZone.X; +{$ENDIF PATCH_I18N} SDL_BlitSurface( MyImage , Nil , Game_Screen , @CDest ); SDL_FreeSurface( MyImage ); @@ -181,11 +260,18 @@ Procedure AI_PrintFromRight( msg: String { Draw a left justified message on the current line. } var MyImage: PSDL_Surface; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} PLine: PChar; +{$ENDIF PATCH_I18N} begin +{$IFDEF PATCH_I18N} + MyImage := I18N_TTF_RenderText( Info_Font , msg , C ); +{$ELSE PATCH_I18N} pline := QuickPCopy( msg ); MyImage := TTF_RenderText_Solid( Info_Font , pline , C ); Dispose( pline ); +{$ENDIF PATCH_I18N} CDest.X := CZone.X + Tab; @@ -197,11 +283,18 @@ Procedure AI_PrintFromLeft( msg: String; { Draw a left justified message on the current line. } var MyImage: PSDL_Surface; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} PLine: PChar; +{$ENDIF PATCH_I18N} begin +{$IFDEF PATCH_I18N} + MyImage := I18N_TTF_RenderText( Info_Font , msg , C ); +{$ELSE PATCH_I18N} pline := QuickPCopy( msg ); MyImage := TTF_RenderText_Solid( Info_Font , pline , C ); Dispose( pline ); +{$ENDIF PATCH_I18N} CDest.X := CZone.X + Tab - MyImage^.W; @@ -241,6 +334,9 @@ end; Function ArmorColor( Part: GearPtr ): TSDL_Color; { Decide upon a nice color to represent the armor of this part. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(StatusColor(100,0)); +{$ENDIF PATCH_GH} ArmorColor := StatusColor( MaxTArmor( Part ) , CurrentTArmor( Part ) ); end; @@ -249,6 +345,10 @@ Function ArmorDamageColor( Part: GearPtr var MA,CA: LongInt; { Max Armor, Current Armor } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit(StatusColor(100,0)); +{$ENDIF PATCH_GH} + MA := MaxTArmor( Part ); CA := CurrentTArmor( Part ); @@ -273,23 +373,57 @@ var Function PartStructImage( GS, CuD, MxD: Integer ): Integer; { Given module type GS, with current damage score CuD and maximum damage } { score MxD, return the correct image to use for it in the diagram. } +{$IFDEF PATCH_GH} + var + DamageGauge: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if ( CuD <= 0 ) or ( MxD <= 0) then begin + PartStructImage := ( ( MD^.S + 0 ) * MaxDamageGauge ) - 1; + end else begin + DamageGauge := ( CuD * (MaxDamageGauge - 2) div MxD ); + if ( 0 = DamageGauge ) then begin + PartStructImage := ( ( MD^.S + 0 ) * MaxDamageGauge ) - 1 - 1; + end else begin + PartStructImage := ( ( MD^.S + 0 ) * MaxDamageGauge ) - 1 - 1 - DamageGauge; + end; + end; +{$ELSE PATCH_GH} if ( MxD > 0 ) and ( CuD < 1 ) then begin PartStructImage := ( MD^.S * 9 ) - 1; end else begin PartStructImage := ( MD^.S * 9 ) - 1 - ( CuD * 8 div MxD ); end; +{$ENDIF PATCH_GH} end; Function PartArmorImage( GS, CuD, MxD: Integer ): Integer; { Given module type GS, with current armor score CuD and maximum armor } { score MxD, return the correct image to use for it in the diagram. } +{$IFDEF PATCH_GH} + var + DamageGauge: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if ( CuD <= 0 ) or ( MxD <= 0 ) then begin + PartArmorImage := ( ( MD^.S + MaxModule ) * MaxDamageGauge ) - 1; + end else begin + DamageGauge := ( CuD * (MaxDamageGauge - 2) div MxD ); + if ( 0 = DamageGauge ) then begin + PartArmorImage := ( ( MD^.S + MaxModule ) * MaxDamageGauge ) - 1 - 1; + end else begin + PartArmorImage := ( ( MD^.S + MaxModule ) * MaxDamageGauge ) - 1 - 1 - DamageGauge; + end; + end; +{$ELSE PATCH_GH} if CuD < 1 then begin PartArmorImage := ( MD^.S * 9 ) + 71; end else begin PartArmorImage := ( MD^.S * 9 ) + 71 - ( CuD * 8 div MxD ); end; +{$ENDIF PATCH_GH} end; Procedure AddPartsToDiagram( GS: Integer ); @@ -323,6 +457,10 @@ var end; end; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Draw the status diagram for this mek. } { Line One - Heads, Turrets, Storage } MyDest.Y := CDest.Y + 12; @@ -331,6 +469,9 @@ begin N := 0; AddPartsToDiagram( GS_Head ); AddPartsToDiagram( GS_Turret ); +{$IFDEF PATCH_CHEAT} + AddPartsToDiagram( GS_Conversion ); +{$ENDIF PATCH_CHEAT} if N < 1 then N := 1; { Want pods to either side of body; head and/or turret in middle. } AddPartsToDiagram( GS_Storage ); @@ -356,6 +497,10 @@ var MyDest: TSDL_Rect; T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + MyDest.X := CZone.X + 8; MyDest.Y := CZone.Y + CZone.H - 20; @@ -414,11 +559,19 @@ var MyDest: TSDL_Rect; n: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + if ( GB <> Nil ) and OnTheMap( Part ) and IsMasterGear( Part ) and ( Part^.G <> GG_Prop ) then begin { Props are master gears, but they don't get location info. } MyDest.Y := CDest.Y + 12; MyDest.X := CZone.X + ( CZone.W div 8 ); +{$IFDEF PATCH_GH} + DrawSprite( Module_Sprite , MyDest , ( MaxModule * MaxDamageGauge * 2 ) + ( NAttValue( Part^.NA , NAG_Location , NAS_D ) + 1 ) mod 8 ); +{$ELSE PATCH_GH} DrawSprite( Module_Sprite , MyDest , 144 + ( NAttValue( Part^.NA , NAG_Location , NAS_D ) + 1 ) mod 8 ); +{$ENDIF PATCH_GH} n := mekAltitude( GB , Part ) + 3; if N < 0 then n := 0 @@ -457,9 +610,24 @@ var MM,A,B: Integer; MD: GearPtr; C: TSDL_Color; -begin +{$IFDEF PATCH_CHEAT} + T: Integer; + MaxT: Integer; + MoveOrder: Integer; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { General mecha information - Name, mass, maneuver } AI_Title( GearName(Mek) , NeutralGrey ); +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_DESIG then begin + AI_PrintFromRight( SAttValue( Mek^.SA , 'DESIG' ) , ( CZone.W div 2 ) - 19 , MenuItem ); + CDest.Y := CDest.Y + TTF_FontLineSkip( Info_Font ) div 2; + end; +{$ENDIF PATCH_CHEAT} { Draw the status diagram for this mek. } DisplayModules( Mek ); @@ -472,11 +640,23 @@ begin AI_NextLine; AI_PrintFromRight( 'SE:' + SgnStr(MechaSensorRating(Mek)) , ( CZone.W * 3 ) div 4 , NeutralGrey ); AI_NextLine; +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_OverLoad then begin + MM := OverloadCapacity( Mek ) - NAttValue( Mek^.NA , NAG_Condition , NAS_Overload ); + if MM < 0 then AI_PrintFromRight( 'OL:' + SgnStr(MM) , ( CZone.W * 3 ) div 4 , EnemyRed ) + else AI_PrintFromRight( 'OC:' + BStr(MM) , ( CZone.W * 3 ) div 4 , MenuItem ); + end; +{$ENDIF PATCH_CHEAT} AI_NextLine; { Pilot Information - Name, health, rank } MD := LocatePilot( Mek ); +{$IFDEF PATCH_GH} + if (NIL <> MD) and (GG_DisposeGear < MD^.G) then begin +{$ELSE PATCH_GH} if MD <> Nil then begin +{$ENDIF PATCH_GH} + { Pilot's name - Left Justified. } msg := GearName( MD ); @@ -502,10 +682,55 @@ begin { Movement information. } MM := NAttValue( Mek^.NA , NAG_Action , NAS_MoveMode ); if MM > 0 then begin +{$IFDEF PATCH_I18N} + msg := I18N_Name('MoveModeName',MoveModeName[ MM ]); +{$ELSE PATCH_I18N} msg := MoveModeName[ MM ]; +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_DamagePercent then begin + msg := msg + ReplaceHash( I18N_MsgString('MekStatDisplay','Broken'), BStr(100 - PercentDamaged(Mek)) ); + end else if Cheat_Display_SpeedoMeter then begin + if Cheat_Display_SW and ( BaseMoveRate( Mek ) = 0 ) then begin + msg := msg + ReplaceHash( I18N_MsgString('MekStatDisplay','Broken'), BStr(100 - PercentDamaged(Mek)) ); + end else begin + MoveOrder := NAttValue( Mek^.NA , NAG_Action , NAS_MoveAction ); + if ( NAV_TurnLeft = MoveOrder ) or ( NAV_TurnRight = MoveOrder ) then begin + msg := msg + ' (' + I18N_MsgString('MekStatDisplay','Turn') + ' ' + BStr( NAttValue( Mek^.NA , NAG_Action , NAS_SpeedoMeter ) ) + 'dpr)'; + end else begin + msg := msg + ' (' + BStr( NAttValue( Mek^.NA , NAG_Action , NAS_SpeedoMeter ) ) + 'dpr)'; + end; + end; + end else begin + msg := msg + ' (' + BStr( Speedometer( Mek ) ) + 'dpr)'; + end; +{$ELSE PATCH_CHEAT} msg := msg + ' (' + BStr( Speedometer( Mek ) ) + 'dpr)'; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_I18N} + end else msg := I18N_MsgString('MekStatDisplay','Immobile'); +{$ELSE PATCH_I18N} end else msg := 'Immobile'; +{$ENDIF PATCH_I18N} AI_SmallTitle( msg , NeutralGrey ); +{$IFDEF PATCH_CHEAT} + if (0 < SAttValueToInt(Mek^.SA,SATT_TRANSFORMABLE)) then begin + msg := 'Form:' + SAttValue( Mek^.SA , SATT_TRANSFORM_NAME + BStr(SAttValueToInt( Mek^.SA , SATT_TRANSFORM_CURRENT )) ); + AI_SmallTitle( msg , NeutralGrey ); + end; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_CHEAT} + MaxT := SAttValueToInt(Mek^.SA,SATT_SEPARABLE); + if (0 < MaxT) then begin + msg := ' Purge Mode:'; + for T := 1 to MaxT do begin + if ('' <> SAttValue(Mek^.SA,SATT_SEPARATE_NAME + BStr(T))) then begin + msg := msg + BStr(T) + '.'; + end; + end; + AI_SmallTitle( msg , NeutralGrey ); + end; +{$ENDIF PATCH_CHEAT} DisplayStatusFX( Mek ); end; @@ -515,10 +740,22 @@ Procedure CharacterInfo( Part: GearPtr; var T,TT,Width,S: Integer; C: TSDL_Color; - -begin +{$IFDEF PATCH_CHEAT} + MPV,GV: Int64; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Show the character's name and health status. } AI_Title( GearName(Part) , NeutralGrey ); +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_DESIG then begin + AI_PrintFromRight( SAttValue( Part^.SA , 'DESIG' ) , ( CZone.W div 2 ) - 19 , MenuItem ); + CDest.Y := CDest.Y + TTF_FontLineSkip( Info_Font ) div 2; + end; +{$ENDIF PATCH_CHEAT} DisplayModules( Part ); LocationInfo( Part , GB ); @@ -533,6 +770,19 @@ begin AI_PrintFromRight( 'Me:' , ( CZone.W * 13 ) div 16 - TextLength( Info_Font , 'Me:' ) - 2 , NeutralGrey ); AI_PrintFromRight( BStr( CharCurrentMental(Part)) + '/' + BStr( CharMental(Part)) , ( CZone.W * 13 ) div 16 , EnduranceColor( CharMental(Part) , CharCurrentMental(Part) ) ); AI_NextLine; +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_PV then begin + GV := Int64(GearValue(Part)) * Int64(Part^.Scale +1); + MPV := INt64(Part^.V) * Int64(Part^.V * 150 - 100) * Int64(Part^.Scale +1); + if MPV > GV then GV := MPV; + if ( CZone.W * 3 ) div 16 < TextLength( Info_Font , BStr( GV ) ) then begin + AI_PrintFromLeft( 'PV:' + BStr( GearValue( Part ) ) , CZone.W , MenuItem ); + end else begin + AI_PrintFromRight( 'PV:' , ( CZone.W * 13 ) div 16 - TextLength( Info_Font , 'PV:' ) - 2 , MenuItem ); + AI_PrintFromRight( BStr( GV ) , ( CZone.W * 13 ) div 16 , MenuItem ); + end; + end; +{$ENDIF PATCH_CHEAT} AI_NextLine; @@ -542,7 +792,11 @@ begin { Show the character's stats. } for t := 1 to ( NumGearStats div 4 ) do begin for tt := 1 to 4 do begin +{$IFDEF PATCH_I18N} + AI_PrintFromRight( HeadMBChar( I18N_Name('StatName', StatName[ T * 4 + TT - 4 ]) ) + ':' , ( TT-1 ) * Width + 1 , NeutralGrey ); +{$ELSE PATCH_I18N} AI_PrintFromRight( StatName[ T * 4 + TT - 4 ][1] + StatName[ T * 4 + TT - 4 ][2] + ':' , ( TT-1 ) * Width + 1 , NeutralGrey ); +{$ENDIF PATCH_I18N} { Determine the stat value. This may be higher or lower than natural... } S := CStat( Part , T * 4 + TT - 4 ); @@ -557,7 +811,11 @@ begin DisplayStatusFX( Part ); end; +{$IFDEF PATCH_GH} +Procedure MiscInfo( Part: GearPtr; DebugMode: Boolean ); +{$ELSE PATCH_GH} Procedure MiscInfo( Part: GearPtr ); +{$ENDIF PATCH_GH} { Display info for any gear that doesn't have its own info } { procedure. } var @@ -565,8 +823,22 @@ var msg: String; AI_Dest: TSDL_Rect; begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (not(DebugMode) and (Part^.G <= GG_DisposeGear)) then Exit; +{$ENDIF PATCH_GH} + { Show the part's name. } +{$IFDEF PATCH_GH} + AI_Title( GearName(Part,DebugMode) , NeutralGrey ); +{$ELSE PATCH_GH} AI_Title( GearName(Part) , NeutralGrey ); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_DESIG then begin + AI_PrintFromRight( SAttValue( Part^.SA , 'DESIG' ) , ( CZone.W div 2 ) - 19 , MenuItem ); + AI_NextLine; + end; +{$ENDIF PATCH_CHEAT} { Display the part's armor rating. } N := GearCurrentArmor( Part ); @@ -581,7 +853,11 @@ begin else msg := '-'; AI_PrintFromRight( msg + ' DP' , CZone.W div 2 , HitsColor( Part ) ); +{$IFDEF PATCH_GH} + N := ( Int64(GearMass( Part )) + 1 ) div 2; +{$ELSE PATCH_GH} N := ( GearMass( Part ) + 1 ) div 2; +{$ENDIF PATCH_GH} if N > 0 then AI_PrintFromLeft( MassString( Part ) , CZone.W - 1 , NeutralGrey ); if Part^.G < 0 then begin @@ -612,21 +888,43 @@ Procedure RepairFuelInfo( Part: GearPtr { Display info for any gear that doesn't have its own info } { procedure. } var +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Show the part's name. } AI_Title( GearName(Part) , NeutralGrey ); +{$IFDEF PATCH_CHEAT} + if Cheat_Display_SW and Cheat_Display_DESIG then begin + AI_PrintFromRight( SAttValue( Part^.SA , 'DESIG' ) , ( CZone.W div 2 ) - 19 , MenuItem ); + AI_NextLine; + end; +{$ENDIF PATCH_CHEAT} N := GearMass( Part ); if N > 0 then AI_PrintFromLeft( MassString( Part ) , CZone.W - 1 , NeutralGrey ); AI_NextLine; +{$IFDEF PATCH_I18N} + AI_SmallTitle( I18N_Name('SkillMan',SkillMan[ Part^.S ].Name) , BrightYellow ); +{$ELSE PATCH_I18N} AI_SmallTitle( SkillMan[ Part^.S ].Name , BrightYellow ); +{$ENDIF PATCH_I18N} AI_SmallTitle( BStr( Part^.V ) + ' DP' , InfoGreen ); end; +{$IFDEF PATCH_GH} +Procedure GearInfo( Part: GearPtr; var Z: TSDL_Rect; BorColor: TSDL_Color; GB: GameBoardPtr; DebugMode: Boolean ); +{$ELSE PATCH_GH} Procedure GearInfo( Part: GearPtr; var Z: TSDL_Rect; BorColor: TSDL_Color; GB: GameBoardPtr ); +{$ENDIF PATCH_GH} { Display some information for this gear inside the screen area } { X1,Y1,X2,Y2. } begin @@ -634,24 +932,54 @@ begin { Error check } { Note that we want the area cleared, even in case of an error. } +{$IFDEF PATCH_GH} + if (NIL = Part) or (not(DebugMode) and (Part^.G <= GG_DisposeGear)) then Exit; +{$ELSE PATCH_GH} if Part = Nil then exit; +{$ENDIF PATCH_GH} { Depending upon PART's type, branch to an appropriate procedure. } case Part^.G of GG_Mecha: MekStatDisplay( Part , GB ); GG_Character: CharacterInfo( Part , GB ); GG_RepairFuel: RepairFuelInfo( Part ); +{$IFDEF PATCH_GH} + else MiscInfo( Part, DebugMode ); +{$ELSE PATCH_GH} else MiscInfo( Part ); +{$ENDIF PATCH_GH} end; end; +{$IFDEF PATCH_GH} +Procedure GearInfo( Part: GearPtr; var Z: TSDL_Rect; BorColor: TSDL_Color; GB: GameBoardPtr ); +begin + GearInfo( Part, Z, BorColor, GB, False ); +end; +{$ENDIF PATCH_GH} + + +{$IFDEF PATCH_GH} +Procedure DisplayGearInfo( Part: GearPtr ); +begin + DisplayGearInfo( Part, False ); +end; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} +Procedure DisplayGearInfo( Part: GearPtr; DebugMode: Boolean ); +{$ELSE PATCH_GH} Procedure DisplayGearInfo( Part: GearPtr ); +{$ENDIF PATCH_GH} { Show some stats for whatever sort of thing PART is. } begin { All this procedure does is call the ArenaInfo unit procedure } { with the dimensions of the Info Zone. } +{$IFDEF PATCH_GH} + GearInfo( Part, ZONE_Info, NeutralGrey, NIL, DebugMode ); +{$ELSE PATCH_GH} GearInfo( Part, ZONE_Info, NeutralGrey , Nil ); +{$ENDIF PATCH_GH} end; Procedure DisplayGearInfo( Part: GearPtr; gb: GameBoardPtr; Z: TSDL_Rect ); @@ -675,7 +1003,11 @@ var PList: SAttPtr; { Portrait List. } begin { Error check - better safe than sorry, unless in an A-ha song. } +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit(''); +{$ELSE PATCH_GH} if NPC = Nil then Exit( '' ); +{$ENDIF PATCH_GH} { Check the standard place first. If no portrait is defined, } { grab one from the IMAGE/ directory. } @@ -707,7 +1039,14 @@ var MyDest: TSDL_Rect; T,RStep: Integer; SS: SensibleSpritePtr; -begin +{$IFDEF PATCH_GH} + MySource: TSDL_Rect; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + SetInfoZone( ZONE_InteractStatus , NeutralBrown ); CHAT_React := React; @@ -766,19 +1105,44 @@ begin MyDest.X := MyDest.X + 4; end; +{$IFDEF PATCH_GH} + MySource.W := 100; + MySource.H := 150; + MyDest := ZONE_InteractPhoto; + if (MySource.W < MyDest.W) then begin + MyDest.X := MyDest.X + (MyDest.W div 2) - (MySource.W div 2); + end; + if (MySource.H < MyDest.H) then begin + MyDest.Y := MyDest.Y + (MyDest.H div 2) - (MySource.H div 2); + end; + + { Draw the portrait. } + DrawSprite( Backdrop_Sprite , MyDest , 0 ); + SS := ConfirmSprite( PortraitName( NPC ) , TeamColorString( GB , NPC ) , MySource.W , MySource.H ); + DrawSprite( SS , MyDest , 0 ); +{$ELSE PATCH_GH} { Draw the portrait. } DrawSprite( Backdrop_Sprite , ZONE_InteractPhoto , 0 ); SS := ConfirmSprite( PortraitName( NPC ) , TeamColorString( GB , NPC ) , 100 , 150 ); DrawSprite( SS , ZONE_InteractPhoto , 0 ); +{$ENDIF PATCH_GH} end; Procedure QuickWeaponInfo( Part: GearPtr ); { Provide quick info for this weapon in the MENU2 zone. } begin +{$IFDEF PATCH_GH} + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if Part = Nil then exit; +{$ENDIF PATCH_GH} { Display the weapon description. } +{$IFDEF PATCH_I18N} + NFVCMessage( GearName( Part ) + ' ' + WeaponDescription( Part ) , ZONE_Menu1 , InfoGreen ); +{$ELSE PATCH_I18N} NFCMessage( GearName( Part ) + ' ' + WeaponDescription( Part ) , ZONE_Menu1 , InfoGreen ); +{$ENDIF PATCH_I18N} end; Procedure CharacterDisplay( PC: GearPtr; GB: GameBoardPtr ); @@ -794,9 +1158,17 @@ var SS: SensibleSpritePtr; begin { Begin with one massive error check... } +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if PC = Nil then Exit; +{$ENDIF PATCH_GH} if PC^.G <> GG_Character then PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if PC = Nil then Exit; +{$ENDIF PATCH_GH} SetInfoZone( ZONE_Map , PlayerBlue ); @@ -825,7 +1197,11 @@ begin { Do the output. } MyDest.X := ZONE_Map.X + 10; +{$IFDEF PATCH_I18N} + QuickText( I18N_Name( 'StatName', StatName[ T ] ) , MyDest , NeutralGrey ); +{$ELSE PATCH_I18N} QuickText( StatName[ T ] , MyDest , NeutralGrey ); +{$ENDIF PATCH_I18N} msg := BStr( S ); MyDest.X := X0 - 30 - TextLength( Game_Font , msg ); QuickText( msg , MyDest , C ); @@ -862,7 +1238,11 @@ begin if ( GB <> Nil ) then begin { Print the name of the PC's mecha. } Mek := FindPilotsMecha( GB^.Meks , PC ); +{$IFDEF PATCH_GH} + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin +{$ELSE PATCH_GH} if Mek <> Nil then begin +{$ENDIF PATCH_GH} MyDest.Y := MyDest.Y + TTF_FontLineSkip( Game_Font ); MyDest.X := X0; QuickText( MsgString( 'INFO_MekSelect' ) , MyDest , NeutralGrey ); @@ -877,7 +1257,11 @@ begin FID := NAttValue( PC^.NA , NAG_Personal , NAS_FactionID ); if ( FID <> 0 ) and ( GB^.Scene <> Nil ) then begin Mek := SeekFaction( GB^.Scene , FID ); +{$IFDEF PATCH_GH} + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin +{$ELSE PATCH_GH} if Mek <> Nil then begin +{$ENDIF PATCH_GH} MyDest.X := X0; MyDest.Y := MyDest.Y + TTF_FontLineSkip( Game_Font ); QuickText( MsgString( 'INFO_Faction' ) , MyDest , NeutralGrey ); @@ -920,6 +1304,9 @@ Procedure InjuryViewer( PC: GearPtr ); MD,CD: Integer; begin while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} MD := GearMaxDamage( Part ); CD := GearCurrentDamage( Part ); if not PartActive( Part ) then begin @@ -930,6 +1317,9 @@ Procedure InjuryViewer( PC: GearPtr ); AI_NextLine; end; ShowSubInjuries( Part^.SubCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; @@ -938,9 +1328,17 @@ Procedure InjuryViewer( PC: GearPtr ); SP,MP,T: Integer; begin { Begin with one massive error check... } +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if PC = Nil then Exit; +{$ENDIF PATCH_GH} if PC^.G <> GG_Character then PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit; +{$ELSE PATCH_GH} if PC = Nil then Exit; +{$ENDIF PATCH_GH} SetInfoZone( ZONE_Map , PlayerBlue ); @@ -1012,10 +1410,24 @@ Procedure MapEditInfo( Pen,Palette,X,Y: { Show the needed info for the map editor- the current pen } { terrain, the terrain palette, and the cursor position. } begin +{$IFDEF PATCH_GH} + SetInfoZone( ZONE_Info, StdWhite ); + {$IFDEF PATCH_I18N} + AI_Title( I18N_Name('TerrMan',TerrMan[Pen].Name), StdWhite ); + {$ELSE PATCH_I18N} + AI_Title( TerrMan[Pen].Name, StdWhite ); + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} CMessage( BStr( X ) + ',' + BStr( Y ) , ZONE_Clock , StdWhite ); end; + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: sdlinfo.pp'); +{$ENDIF DEBUG} Interact_Sprite := ConfirmSprite( Interact_Sprite_Name , '' , 4 , 16 ); Module_Sprite := ConfirmSprite( Module_Sprite_Name , '' , 16 , 16 ); Backdrop_Sprite := ConfirmSprite( Backdrop_Sprite_Name , '' , 100 , 150 ); @@ -1023,5 +1435,13 @@ initialization Speedometer_Sprite := ConfirmSprite( Speedometer_Sprite_Name , '' , 26 , 65 ); StatusFX_Sprite := ConfirmSprite( StatusFX_Sprite_Name , '' , 10 , 12 ); OtherFX_Sprite := ConfirmSprite( OtherFX_Sprite_Name , '' , 10 , 12 ); +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: sdlinfo.pp(finalization)'); +{$ENDIF DEBUG} +end; end. diff -x .svn -uprN GearHead1100repository.original/sdlmap.pp branches/sdlmap.pp --- GearHead1100repository.original/sdlmap.pp 2013-02-06 10:00:02.000000000 +0900 +++ branches/sdlmap.pp 2015-08-01 09:00:00.000000000 +0900 @@ -23,7 +23,15 @@ unit sdlmap; interface -uses SDL,SDL_ttf,sdlgfx,gears,gearutil,damage,locale,movement,ability,action,randmaps,effects,ghmecha,ui4gh,ghprop; +uses +{$IFDEF PATCH_GH} + gears_base, + gears, + ui4gh, + SDL,SDL_ttf,sdlgfx,gearutil,damage,locale,movement,ability,action,randmaps,effects,ghmecha,ghprop; +{$ELSE PATCH_GH} + SDL,SDL_ttf,sdlgfx,gears,gearutil,damage,locale,movement,ability,action,randmaps,effects,ghmecha,ui4gh,ghprop; +{$ENDIF PATCH_GH} const { DISPLAYSHOT CONSTANTS } @@ -83,13 +91,35 @@ Procedure PrepOpening; Procedure RedrawOpening; Function ScreenToMap( X,Y: Integer ): Point; +{$IFDEF PATCH_GH} +Function IsMouseOnMap: Boolean; +{$ENDIF PATCH_GH} Function MouseMapPos: Point; +{$IFDEF PATCH_GH} +Function DirKey( P: Point; ReDrawer: RedrawProcedureType ): Integer; +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} Procedure BeginTurn( GB: GameBoardPtr; M: GearPtr ); implementation -uses texutil,menugear,ghchars; +uses +{$IFDEF DEBUG} + sysutils, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + math, + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} + texutil,menugear,ghchars; Type Overlay_Description = Record @@ -124,6 +154,15 @@ const -1,32,33,34,-4, 36,37,38,39,40, 41,42 ); +{$IFDEF PATCH_JPSSDL} + Terrain_IsNotWall: Array [1..NumTerr] of Boolean = ( + True ,True ,True ,True ,True , True ,True ,True ,True ,True , + True ,False,False,True ,False, True ,True ,False,True ,True , + True ,True ,False,False,True , True ,False,True ,False,True , + False,False,False,False,False, False,False,False,True ,True , + True ,False + ); +{$ENDIF PATCH_JPSSDL} HalfTileWidth = 32; HalfTileHeight = 16; @@ -135,7 +174,7 @@ const Terrain_Sprite_Name = 'big_terrain.png'; Meta_Terrain_Sprite_Name = 'meta_terrain.png'; Terrain_Toupee_Sprite_Name = 'iso_64b.png'; - Targeting_Srpite_Name = 'target64.png'; + Targeting_Sprite_Name = 'target64.png'; Items_Sprite_Name = 'default_items.png'; Default_Wreckage = 1; @@ -150,6 +189,9 @@ const DefaultFemaleSpriteHead = 'cha_f_'; +{$IFDEF PATCH_GH} + Default_PointAnimation_Name = 'pointanimation.png'; +{$ENDIF PATCH_GH} Strong_Hit_Sprite_Name = 'blast64.png'; Weak_Hit_Sprite_Name = 'nodamage64.png'; Parry_Sprite_Name = 'misc_parry.png'; @@ -184,8 +226,12 @@ const OM_South = 4; OM_West = 3; +{$IFDEF PATCH_GH} + Map_Mid: TSDL_Rect = ( x:285; y:229; w:128; h:64 ); +{$ELSE PATCH_GH} Map_Mid_X = 285; Map_Mid_Y = 229; +{$ENDIF PATCH_GH} var OVERLAY_MAP: Array [ 1..XMax, 1..YMax, LowAlt..HiAlt, 0..NumOverlayLayers ] of Overlay_Description; @@ -193,7 +239,10 @@ var OFF_MAP_MODELS: Array [1..4,0..NumOMM] of Integer; - Terrain_Sprite,Meta_Terrain_Sprite,Terrain_Toupee_Sprite,Targeting_Srpite,Items_Sprite: SensibleSpritePtr; + Terrain_Sprite,Meta_Terrain_Sprite,Terrain_Toupee_Sprite,Targeting_Sprite,Items_Sprite: SensibleSpritePtr; +{$IFDEF PATCH_GH} + Default_PointAnimation_Sprite: SensibleSpritePtr; +{$ENDIF PATCH_GH} Strong_Hit_Sprite,Weak_Hit_Sprite,Parry_Sprite,Miss_Sprite: SensibleSpritePtr; Thin_wall_Cap: SensibleSpritePtr; hill_1,hill_2,hill_3: SensibleSpritePtr; @@ -263,7 +312,11 @@ var color: TSDL_Color; T: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = G) or (G^.G <= GG_DisposeGear) or (NIL = GB) then begin +{$ELSE PATCH_GH} if ( G = Nil ) or ( GB = Nil ) then begin +{$ENDIF PATCH_GH} { No gear provided - Neutral Gray. } color := NeutralGrey; @@ -339,6 +392,9 @@ end; Function OnTheScreen( Mek: GearPtr ): Boolean; { Check to see whether or not the specified mek is visible on screen. } begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} OnTheScreen := OnTheScreen( NAttValue( Mek^.NA , NAG_Location , NAS_X ) , NAttValue( Mek^.NA , NAG_Location , NAS_Y ) ); end; @@ -383,6 +439,9 @@ Procedure RenderMap; var X,Y,Z,T,Quad: Integer; MyDest: TSDL_Rect; +{$IFDEF PATCH_GH} + len_x, len_y: Integer; +{$ENDIF PATCH_GH} begin { Set the clip area. } ClrZone( ZONE_Map ); @@ -406,11 +465,27 @@ begin MyDest.X := ScreenX( X , Y ); MyDest.Y := ScreenY( X , Y ) - Altitude_Height * Z; if OVERLAY_MAP[ X ,Y , Z , T ].Sprite^.H > 64 then MyDest.Y := MyDest.Y - 32; +{$IFDEF PATCH_GH} + len_x := MyDest.X - Map_Mid.X; + len_y := MyDest.Y - Map_Mid.Y; + if (Use_Alpha_Blending and (1 <= DrawWallMode)) + and OVERLAY_MAP[ X ,Y , Z , T ].UseAlpha + { and ((2 <= DrawWallMode) or (( Abs( MyDest.Y - Map_Mid.Y ) < Map_Mid.H ) and ( Abs( MyDest.X - Map_Mid.X ) < Map_Mid.W ))) } + and ( (2 <= DrawWallMode) or (( len_x * len_x + len_y * len_y ) < ( Map_Mid.W * Map_Mid.H + 64 + 64 )) ) + then begin + if (DrawWallMode < 4) then begin + DrawAlphaSprite( OVERLAY_MAP[ X ,Y , Z , T ].Sprite , MyDest , OVERLAY_MAP[ X ,Y , Z , T ].F ); + end; + end else begin + DrawSprite( OVERLAY_MAP[ X ,Y , Z , T ].Sprite , MyDest , OVERLAY_MAP[ X ,Y , Z , T ].F ); + end; +{$ELSE PATCH_GH} if Use_Alpha_Blending and OVERLAY_MAP[ X ,Y , Z , T ].UseAlpha and ( Abs( MyDest.Y - Map_Mid_Y ) < 64 ) and ( Abs( MyDest.X - Map_Mid_X ) < 128 ) then begin DrawAlphaSprite( OVERLAY_MAP[ X ,Y , Z , T ].Sprite , MyDest , OVERLAY_MAP[ X ,Y , Z , T ].F ); end else begin DrawSprite( OVERLAY_MAP[ X ,Y , Z , T ].Sprite , MyDest , OVERLAY_MAP[ X ,Y , Z , T ].F ); end; +{$ENDIF PATCH_GH} if ( OVERLAY_MAP[ X ,Y , Z , T ].name <> '' ) and NAMES_ABOVE_HEADS then begin MyDest.X := ScreenX( X , Y ) + HalfTileWidth; MyDest.Y := ScreenY( X , Y ) - Altitude_Height * Z - 10; @@ -491,6 +566,10 @@ var it: String; FList: SAttPtr; begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + { If this model is an out-of-scale character, return the mini-sprite. } if ( M^.G = GG_Character ) and ( M^.Scale < GB^.Scale ) then Exit( mini_sprite ); @@ -531,6 +610,10 @@ var T: Integer; Team: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then Exit(''); +{$ENDIF PATCH_GH} + it := SAttValue( M^.SA , 'SDL_COLORS' ); if ( it = '' ) then begin T := NAttValue( M^.NA , NAG_Location , NAS_Team ); @@ -540,23 +623,55 @@ begin if it = '' then begin if M^.G = GG_Character then begin if T = NAV_DefPlayerTeam then begin +{$IFDEF PATCH_GH} + it := SDL_colors_TeamColor_Character_DefPlayerTeam; +{$ELSE PATCH_GH} it := '66 121 179 255 212 195 205 25 0'; +{$ENDIF PATCH_GH} end else if AreEnemies( GB , T , NAV_DefPlayerTeam ) then begin +{$IFDEF PATCH_GH} + it := SDL_colors_TeamColor_Character_Enemies; +{$ELSE PATCH_GH} it := '180 10 120 255 212 195 170 205 75'; +{$ENDIF PATCH_GH} end else if AreAllies( GB , T , NAV_DefPlayerTeam ) then begin +{$IFDEF PATCH_GH} + it := SDL_colors_TeamColor_Character_Allies; +{$ELSE PATCH_GH} it := '66 121 119 255 212 195 0 205 0'; +{$ENDIF PATCH_GH} end else begin +{$IFDEF PATCH_GH} + it := SDL_colors_TeamColor_Character_Others; +{$ELSE PATCH_GH} it := '175 175 171 255 212 195 0 200 200'; +{$ENDIF PATCH_GH} end; end else begin if T = NAV_DefPlayerTeam then begin +{$IFDEF PATCH_GH} + it := SDL_colors_TeamColor_Mecha_DefPlayerTeam; +{$ELSE PATCH_GH} it := '66 121 179 210 215 80 205 25 0'; +{$ENDIF PATCH_GH} end else if AreEnemies( GB , T , NAV_DefPlayerTeam ) then begin +{$IFDEF PATCH_GH} + it := SDL_colors_TeamColor_Mecha_Enemies; +{$ELSE PATCH_GH} it := '180 10 120 125 125 125 170 205 75'; +{$ENDIF PATCH_GH} end else if AreAllies( GB , T , NAV_DefPlayerTeam ) then begin +{$IFDEF PATCH_GH} + it := SDL_colors_TeamColor_Mecha_Allies; +{$ELSE PATCH_GH} it := '66 121 119 190 190 190 0 205 0'; +{$ENDIF PATCH_GH} end else begin +{$IFDEF PATCH_GH} + it := SDL_colors_TeamColor_Mecha_Others; +{$ELSE PATCH_GH} it := '175 175 171 100 100 120 0 200 200'; +{$ENDIF PATCH_GH} end; end; end; @@ -653,8 +768,21 @@ begin { Draw the terrain itself first. } for x := 1 to XMax do begin for Y := 1 to YMax do begin +{$IFDEF DEBUG} + if (GB^.Map[ X , Y ].Visible or DEBUG_CanSeeAll) then begin +{$ELSE DEBUG} if GB^.Map[ X , Y ].Visible then begin +{$ENDIF DEBUG} Mini_Map[ X , Y ] := GB^.Map[ X , Y ].terr + 9; +{$IFDEF PATCH_JPSSDL} + if (2 <= DrawWallMode) and not(Terrain_IsNotWall[ GB^.Map[ X , Y ].terr ]) then begin + if not(Use_Alpha_Blending) or (3 <= DrawWallMode) then begin + continue; + end else begin + Overlay_Map[ X , Y , 0 , OVERLAY_Terrain ].UseAlpha := True; + end; + end; +{$ENDIF PATCH_JPSSDL} if GB^.Map[ X , Y ].terr = 8 then begin AddInstantOverlay( X , Y , 0 , OVERLAY_Terrain , HillFrame( X , Y ) , Hill_1 ); Overlay_Map[ X , Y , 0 , OVERLAY_Terrain ].UseAlpha := True; @@ -684,11 +812,18 @@ begin { Next add the items to the map. } M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} X := NAttValue( M^.NA , NAG_Location , NAS_X ); Y := NAttValue( M^.NA , NAG_Location , NAS_Y ); Z := MekAltitude( GB , M ); if IsMasterGear(M) and NotDestroyed( M ) then begin +{$IFDEF DEBUG} + if OnTheMap( X , Y ) and (MekVisible( GB , M ) or DEBUG_CanSeeAll) then begin +{$ELSE DEBUG} if OnTheMap( X , Y ) and MekVisible( GB , M ) then begin +{$ENDIF DEBUG} if M^.G = GG_Prop then begin AddOverlay( X , Y , Z , OVERLAY_Master , GearSpriteName( GB , M ) , '' , GearName( M ) , 64 , 64 , NAttValue( M^.NA , NAG_Display , NAS_PrimaryFrame ) ); end else begin @@ -711,13 +846,21 @@ begin AddInstantOverlay( X , Y , TerrMan[ GB^.Map[ X , Y ].terr ].altitude , OVERLAY_Shadow , Default_Shadow , Items_Sprite ); end; end else begin +{$IFDEF DEBUG} + if OnTheMap( X , Y ) and (GB^.Map[X,Y].Visible or DEBUG_CanSeeAll) then begin +{$ELSE DEBUG} if OnTheMap( X , Y ) and GB^.Map[X,Y].Visible then begin +{$ENDIF DEBUG} if ( M^.G = GG_Mecha ) or ( M^.G = GG_Prop ) then begin AddInstantOverlay( X , Y , Z , OVERLAY_Item , Default_Wreckage , Items_Sprite ); end else if M^.G = GG_Character then begin AddInstantOverlay( X , Y , Z , OVERLAY_Item , Default_Dead_Thing , Items_Sprite ); end else if M^.G = GG_MetaTerrain then begin +{$IFDEF DEBUG} + if NotDestroyed( M ) and (MekVisible( GB , M ) or DEBUG_CanSeeAll) then +{$ELSE DEBUG} if NotDestroyed( M ) and MekVisible( GB , M ) then +{$ENDIF DEBUG} if M^.S = GS_MetaCloud then begin for t := Z to HiAlt do begin AddOverlayIfClear( X , Y , T , OVERLAY_Metaterrain , NAttValue( M^.NA , NAG_Display , NAS_PrimaryFrame ) , Meta_Terrain_Sprite ); @@ -734,6 +877,9 @@ begin end; end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -765,6 +911,9 @@ procedure RedrawTile( gb: GameBoardPtr; var P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} P := GearCurrentLocation( Mek ); if OnTheMap( p.X , P.Y ) then RedrawTile( gb , P.X , P.Y ); end; @@ -776,7 +925,7 @@ begin if not OnTheMap( X , Y ) then exit; if ( Z < LowAlt ) or ( Z > HiAlt ) then Z := 0; - Overlay_MAP[ X , Y , Z , OVERLAY_IMAGE ].Sprite := Targeting_Srpite; + Overlay_MAP[ X , Y , Z , OVERLAY_IMAGE ].Sprite := Targeting_Sprite; Overlay_MAP[ X , Y , Z , OVERLAY_IMAGE ].F := 0; if Primary then begin @@ -790,6 +939,9 @@ procedure IndicateTile( GB: GameBoardPtr var team: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} team := NAttValue( Mek^.NA , NAG_Location , NAS_Team ); if MekVisible( GB , Mek ) and ( OnTheScreen( Mek ) or ( Team = NAV_DefPlayerTeam ) ) then IndicateTile( GB , NAttValue( Mek^.NA , NAG_Location , NAS_X ) , NAttValue( Mek^.NA , NAG_Location , NAS_Y ) , MekAltitude( GB , Mek ) , Primary ); end; @@ -807,7 +959,7 @@ Procedure MouseAtTile( GB: GameBoardPtr; begin ClearOverlayLayer( OVERLAY_IMAGE ); if OnTheMap( X , Y ) then begin - Overlay_MAP[ X , Y , 0 , OVERLAY_IMAGE ].Sprite := Targeting_Srpite; + Overlay_MAP[ X , Y , 0 , OVERLAY_IMAGE ].Sprite := Targeting_Sprite; Overlay_MAP[ X , Y , 0 , OVERLAY_IMAGE ].F := 1; end; end; @@ -818,6 +970,10 @@ Procedure RevealMek( GB: GameBoardPtr; M var team: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; + if (NIL = Spotter) or (Spotter^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} team := NAttValue( Spotter^.NA , NAG_Location , NAS_Team ); SetNAtt( Mek^.NA , NAG_Visibility , Team , NAV_Spotted ); end; @@ -828,6 +984,9 @@ var P: Point; X,Y,MZ,R,Obs: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} P := GearCurrentLocation( Mek ); R := MappingRange( Mek , GB^.Scale ); MZ := MekAltitude( GB , Mek ); @@ -897,7 +1056,11 @@ var Team: GearPtr; P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) or (NIL = GB) then Exit; +{$ELSE PATCH_GH} if ( GB = Nil ) or ( Mek = Nil ) then Exit; +{$ENDIF PATCH_GH} { Find the team for this model. } Team := LocateTeam( GB , NAttValue( Mek^.NA , NAG_Location , NAS_Team ) ); @@ -932,11 +1095,20 @@ begin SetNAtt( mek^.NA , NAG_EpisodeData, NAS_UID, MaxIdTag( GB^.Meks , NAG_EpisodeData, NAS_UID ) + 1 ); { Stick mek on board. } +{$IFDEF PATCH_GH} + Mek^.Next := NIL; + AppendGear( GB^.Meks, Mek ); +{$ELSE PATCH_GH} Mek^.Next := gb^.Meks; gb^.Meks := Mek; +{$ENDIF PATCH_GH} { Set default orders. } +{$IFDEF PATCH_GH} + if (NIL <> Team) and (GG_DisposeGear < Team^.G) then begin +{$ELSE PATCH_GH} if Team <> Nil then begin +{$ENDIF PATCH_GH} SetNAtt( Mek^.NA , NAG_EpisodeData , NAS_Orders , Team^.Stat[ STAT_TeamOrders ] ); end; end; @@ -947,6 +1119,10 @@ Procedure DeployMek( GB: GameBoardPtr; M { PRECONDITION: Mek and Pilot are both unlinked gears. } begin if ( GB = Nil ) or ( Mek = Nil ) or ( Pilot = Nil ) then Exit; +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; + if (NIL = Pilot) or (Pilot^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} { Set the correct values for everything. } SetNAtt( mek^.NA , NAG_Location , NAS_Team , Team ); @@ -987,7 +1163,11 @@ begin H := ( ComTime div AP_Hour ) mod 24; D := ComTime div AP_Day; +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('TIMESTRING'), BStr( D ), WideStr( H, 2 ), WideStr( M , 2 ), WideStr( S , 2 ) ); +{$ELSE PATCH_I18N} msg := Bstr( H ) + ':' + WideStr( M , 2 ) + ':' + WideStr( S , 2 ) + MsgString( 'CLOCK_days' ) + BStr( D ); +{$ENDIF PATCH_I18N} TimeString := msg; end; @@ -1039,7 +1219,12 @@ Procedure FocusOnMek( GB: GameBoardPtr; var P: Point; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit; + if (NIL <> GB) then begin +{$ELSE PATCH_GH} if ( Mek <> Nil ) and ( GB <> Nil ) then begin +{$ENDIF PATCH_GH} P := GearCurrentLocation( Mek ); RecenterDisplay( P.X , P.Y ); DisplayMap( gb ); @@ -1052,6 +1237,14 @@ Function ProcessShotAnimation( GB: GameB { V = Timer } { Stat 1 , 2 , 3 -> X1 , Y1 , Z1 } { Stat 4 , 5 , 6 -> X2 , Y2 , Z2 } +{$IFDEF PATCH_GH} + function MapDirToScreenDir( D: Integer ): Integer; + { Given an in-game map dir, convert this to a screen dir which } + { can be used to render sprites. } + begin + MapDirToScreenDir := ( D + 9 ) mod 8; + end; +{$ENDIF PATCH_GH} const X1 = 1; Y1 = 2; @@ -1061,10 +1254,38 @@ const Z2 = 6; var P: Point; -begin +{$IFDEF PATCH_GH} + New_PointAnimation_Name: String; + New_PointAnimation_Sprite: SensibleSpritePtr; + diff_X, diff_y: Integer; + dir: Integer; + F: Integer; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = AnimList) or (AnimList^.G <= GG_DisposeGear) then Exit(False); + if (NIL = AnimOb) or (AnimOb^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Increase the counter, and find the next spot. } Inc( AnimOb^.V ); P := SolveLine( AnimOb^.Stat[ X1 ] , AnimOb^.Stat[ Y1 ] , AnimOb^.Stat[ Z1 ] , AnimOb^.Stat[ X2 ] , AnimOb^.Stat[ Y2 ] , AnimOb^.Stat[ Z2 ] , AnimOb^.V ); +{$IFDEF PATCH_GH} + diff_x := ( AnimOb^.Stat[ X2 ] - AnimOb^.Stat[ X1 ] ); + diff_y := ( AnimOb^.Stat[ Y2 ] - AnimOb^.Stat[ Y1 ] ); + if SkipAnim and (AnimOb^.V > 1) then begin + F := 0; + end else begin + dir := MapDirToScreenDir( Round( Radtocycle( Arctan2( diff_y , diff_x ) ) * 8.0 ) ); + F := 1 + dir; + end; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_JPSSDL} + if SkipAnim and (AnimOb^.V > 1) then begin + P.X := AnimOb^.Stat[ X2 ]; + P.Y := AnimOb^.Stat[ Y2 ]; + end; +{$ENDIF PATCH_JPSSDL} { If this is the destination point, then we're done. } if ( P.X = AnimOb^.Stat[ X2 ] ) and ( P.Y = AnimOb^.Stat[ Y2 ] ) then begin @@ -1074,7 +1295,26 @@ begin { If this is not the destination point, draw the missile. } end else begin {Display bullet...} +{$IFDEF PATCH_GH} + if Enable_PointAnimation then begin + New_PointAnimation_Name := SAttValue( AnimList^.SA , SDL_POINTANIMATION ); + New_PointAnimation_Sprite := NIL; + if ( 0 < Length( New_PointAnimation_Name ) ) then begin + New_PointAnimation_Sprite := ConfirmSprite( New_PointAnimation_Name , '' , 64, 64 ); + end; + if ( NIL = New_PointAnimation_Sprite ) then begin + New_PointAnimation_Sprite := Default_PointAnimation_Sprite; + end; + AddInstantOverlay( P.X , P.Y , P.Z , OVERLAY_IMAGE , F , New_PointAnimation_Sprite ); + end else begin +{$ENDIF PATCH_GH} AddInstantOverlay( P.X , P.Y , P.Z , OVERLAY_IMAGE , 1 , Strong_Hit_Sprite ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_JPSSDL} + if SkipAnim then AddInstantOverlay( AnimOb^.Stat[X2] , AnimOb^.Stat[Y2] , AnimOb^.Stat[Z2] , OVERLAY_IMAGE , 2 , Targeting_Sprite ); +{$ENDIF PATCH_JPSSDL} end; ProcessShotAnimation := OnTheScreen( P.X , P.Y ); @@ -1089,10 +1329,85 @@ const X = 1; Y = 2; Z = 3; +{$IFDEF PATCH_GH} + MaxAnimation = 10; +{$ENDIF PATCH_GH} var it: Boolean; -begin +{$IFDEF PATCH_GH} + New_PointAnimation_Name: String; + New_PointAnimation_Sprite: SensibleSpritePtr; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + if (NIL = AnimList) or (AnimList^.G <= GG_DisposeGear) then Exit(False); + if (NIL = AnimOb) or (AnimOb^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + if Enable_PointAnimation then begin + if AnimOb^.V < MaxAnimation then begin + New_PointAnimation_Name := SAttValue( AnimList^.SA , SDL_POINTANIMATION ); + New_PointAnimation_Sprite := NIL; + if ( 0 < Length( New_PointAnimation_Name ) ) then begin + New_PointAnimation_Sprite := ConfirmSprite( New_PointAnimation_Name , '' , 64, 64 ); + end; + if ( NIL = New_PointAnimation_Sprite ) then begin + New_PointAnimation_Sprite := Default_PointAnimation_Sprite; + end; + +{$IFDEF PATCH_JPSSDL} + if SkipAnim then AnimOb^.V := 2; +{$ENDIF PATCH_JPSSDL} + case AnimOb^.S of + GS_DamagingHit: begin + AddInstantOverlay( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] , AnimOb^.Stat[ Z ] , OVERLAY_IMAGE , AnimOb^.V + MaxAnimation * 1 , New_PointAnimation_Sprite ); + + end; + GS_ArmorDefHit: begin + AddInstantOverlay( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] , AnimOb^.Stat[ Z ] , OVERLAY_IMAGE , AnimOb^.V + MaxAnimation * 2 , New_PointAnimation_Sprite ); + + end; + + GS_Parry: begin + AddInstantOverlay( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] , AnimOb^.Stat[ Z ] , OVERLAY_IMAGE , AnimOb^.V + MaxAnimation * 3 , New_PointAnimation_Sprite ); + Inc( AnimOb^.V ); + end; + + GS_Dodge: begin + AddInstantOverlay( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] , AnimOb^.Stat[ Z ] , OVERLAY_IMAGE , AnimOb^.V + MaxAnimation * 4 , New_PointAnimation_Sprite ); + Inc( AnimOb^.V ); + end; + + GS_Backlash: begin + AddInstantOverlay( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] , AnimOb^.Stat[ Z ] , OVERLAY_IMAGE , AnimOb^.V + MaxAnimation * 5 , New_PointAnimation_Sprite ); + + end; + GS_AreaAttack: begin + AddInstantOverlay( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] , AnimOb^.Stat[ Z ] , OVERLAY_IMAGE , AnimOb^.V + MaxAnimation * 6 , New_PointAnimation_Sprite ); + + end; + end; + + + { Increment the counter. } + Inc( AnimOb^.V ); +{$IFDEF PATCH_JPSSDL} + if SkipAnim then AnimOb^.V := MaxAnimation; +{$ENDIF PATCH_JPSSDL} + + it := OnTheScreen( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] ); + end else begin + + RemoveGear( AnimList , AnimOb ); + it := False; + end; + end else begin +{$ENDIF PATCH_GH} if AnimOb^.V < 10 then begin +{$IFDEF PATCH_JPSSDL} + if SkipAnim then AnimOb^.V := 2; +{$ENDIF PATCH_JPSSDL} case AnimOb^.S of GS_DamagingHit: begin AddInstantOverlay( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] , AnimOb^.Stat[ Z ] , OVERLAY_IMAGE , AnimOb^.V , Strong_Hit_Sprite ); @@ -1126,6 +1441,9 @@ begin { Increment the counter. } Inc( AnimOb^.V ); +{$IFDEF PATCH_JPSSDL} + if SkipAnim then AnimOb^.V := 10; +{$ENDIF PATCH_JPSSDL} it := OnTheScreen( AnimOb^.Stat[ X ] , AnimOb^.Stat[ Y ] ); end else begin @@ -1133,6 +1451,9 @@ begin RemoveGear( AnimList , AnimOb ); it := False; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} ProcessPointAnimation := it; end; @@ -1156,7 +1477,9 @@ begin while AnimOb <> Nil do begin A2 := AnimOb^.Next; - +{$IFDEF PATCH_GH} + if (GG_DisposeGear < AnimOb^.G) then begin +{$ENDIF PATCH_GH} { Call a routine based upon the type of } { animation requested. } case AnimOb^.S of @@ -1175,7 +1498,9 @@ begin end; DelayThisFrame := DelayThisFrame or PointDelay; - +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} { Move to the next animation. } AnimOb := A2; end; @@ -1201,6 +1526,9 @@ var AnimFound: Boolean; AnimList,AnimItem: GearPtr; AnimLabel,AnimCode: String; +{$IFDEF PATCH_GH} + S: String; +{$ENDIF PATCH_GH} begin A := ATTACK_History; AnimFound := False; @@ -1220,9 +1548,22 @@ begin T := 1; while ( AnimCode <> '' ) and ( T <= NumGearStats ) do begin +{$IFDEF PATCH_GH} + S := ExtractWord( AnimCode ); + if ( SDL_PointAnimation = S ) then begin + SetSAtt( AnimList^.SA , SDL_PointAnimation + ' <' + ExtractWord( AnimCode ) + '>' ); + end else begin + AnimItem^.Stat[ T ] := ExtractValue( S ); + Inc( T ); + end; +{$ELSE PATCH_GH} AnimItem^.Stat[ T ] := ExtractValue( AnimCode ); Inc( T ); +{$ENDIF PATCH_GH} end; +{$IFDEF PATCH_GH_PARANOID_SAFER} + A^.Info := '@'; +{$ENDIF PATCH_GH_PARANOID_SAFER} end; A := A^.Next; end; @@ -1259,6 +1600,18 @@ begin { Can't output the scene gear directly, since it'll be outputted } { with the rest of SOURCE later on. Output its reference number. } writeln( F , FindGearIndex( Camp^.Source , Camp^.GB^.Scene ) ); +{$IFDEF DEBUG} + ErrorMessage_fork( 'TRACE: WriteCampaign(): ' + + BStr(FindGearIndex( Camp^.Source , Camp^.GB^.Scene )) + + '/' + BStr(CountGearIndex( Camp^.Source, False, '' )) + + '/' + BStr(CountGearIndex( Camp^.Source, True, '' )) + + ': ' + Camp^.GB^.Scene^.SA^.info ); + DialogMsg( 'TRACE: WriteCampaign(): ' + + BStr(FindGearIndex( Camp^.Source , Camp^.GB^.Scene )) + + '/' + BStr(CountGearIndex( Camp^.Source, False, '' )) + + '/' + BStr(CountGearIndex( Camp^.Source, True, '' )) + + ': ' + Camp^.GB^.Scene^.SA^.info ); +{$ENDIF DEBUG} { Output map contents. } WriteCGears( F , Camp^.GB^.Meks ); @@ -1316,7 +1669,21 @@ begin { Read the source, and set the gameboard's scene. } Camp^.Source := ReadCGears( F ); +{$IFDEF DEBUG} + Camp^.GB^.Scene := LocateGearByNumber( Camp^.Source , SceneIndex, False, 0, '' ); + ErrorMessage_fork( 'TRACE: ReadCampaign(): ' + + BStr(FindGearIndex( Camp^.Source , Camp^.GB^.Scene )) + + '/' + BStr(CountGearIndex( Camp^.Source, False, '' )) + + '/' + BStr(CountGearIndex( Camp^.Source, True, '' )) + + ': ' + Camp^.GB^.Scene^.SA^.info ); + DialogMsg( 'TRACE: ReadCampaign(): ' + + BStr(FindGearIndex( Camp^.Source , Camp^.GB^.Scene )) + + '/' + BStr(CountGearIndex( Camp^.Source, False, '' )) + + '/' + BStr(CountGearIndex( Camp^.Source, True, '' )) + + ': ' + Camp^.GB^.Scene^.SA^.info ); +{$ELSE DEBUG} Camp^.GB^.Scene := LocateGearByNumber( Camp^.Source , SceneIndex ); +{$ENDIF DEBUG} { Return the restored campaign structure. } ReadCampaign := Camp; @@ -1331,6 +1698,10 @@ var MSV: Boolean; { Mek Started Visible. } Msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then Exit(False); +{$ENDIF PATCH_GH} + { Store the initial position of the mek. } X := NAttValue( Mek^.NA , NAG_Location , NAS_X ); Y := NAttValue( Mek^.NA , NAG_Location , NAS_Y ); @@ -1348,7 +1719,11 @@ begin if OnTheMap( NAttValue( Mek^.NA , NAG_Location , NAS_X ) , NAttValue( Mek^.NA , NAG_Location , NAS_Y ) ) then VisionCheck( GB , Mek ) { Print message if mek has fled the battle. } else begin +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('ProcessMovement','Left'), PilotName(Mek)) ); +{$ELSE PATCH_I18N} DialogMSG( PilotName( Mek ) + ' has left this area.'); +{$ENDIF PATCH_I18N} { Set trigger here. } Team := NAttValue( Mek^.NA , NAG_Location , NAS_Team ); @@ -1356,12 +1731,21 @@ begin end; end else if result = EMR_Crash then begin +{$IFDEF PATCH_I18N} + if Mek^.G = GG_Character then begin + msg := I18N_MsgString('ProcessMovement','Fall'); + end else begin + msg := I18N_MsgString('ProcessMovement','Crash'); + end; + DialogMsg( ReplaceHash( msg, GearName(Mek), BStr(DAMAGE_DamageDone) ) ); +{$ELSE PATCH_I18N} if Mek^.G = GG_Character then begin msg := ReplaceHash( MsgString( 'PROCESSMOVEMENT_Fall' ) , GearName( Mek ) ); end else begin msg := ReplaceHash( MsgString( 'PROCESSMOVEMENT_Crash' ) , GearName( Mek ) ); end; DialogMsg( ReplaceHash( msg , BStr( DAMAGE_DamageDone ) ) ); +{$ENDIF PATCH_I18N} end; ProcessMovement := ( Result <> 0 ) and ( MSV or ( OnTheScreen( Mek ) and MekVisible( GB , Mek ) ) ); end; @@ -1423,6 +1807,11 @@ begin for t := 1 to NumForm do begin ExpandFileList( Sprite_Names , Graphics_Directory + FormPat[ T ] ); end; +{$IFDEF PATCH_GH} + if NIL = Sprite_Names then begin + ErrorMessage('No sprite data was found.'); + end else begin +{$ENDIF PATCH_GH} { Add one sprite per 10x10 area of the map. } for t := 0 to 24 do begin @@ -1448,6 +1837,10 @@ begin end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} + { Finally, get rid of the random map. } { This will also get rid of the attached scene. Bonus! } DisposeMap( GB ); @@ -1511,6 +1904,13 @@ var AX,AY,DX,TX,TY: Integer; { Absolute X , Absolute Y } P: Point; begin +{$IFDEF PATCH_GH} + if ( X < ZONE_Map.X ) then X := ZONE_Map.X; + if ( Y < ZONE_Map.Y ) then Y := ZONE_Map.X; + if ( ( ZONE_Map.X + ZONE_Map.W ) < X ) then X := ZONE_Map.X + ZONE_Map.W; + if ( ( ZONE_Map.Y + ZONE_Map.H ) < Y ) then Y := ZONE_Map.Y + ZONE_Map.H; +{$ENDIF PATCH_GH} + AX := X - ZONE_Map.X - OriginX; AY := Y - ZONE_Map.Y - OriginY; @@ -1531,12 +1931,94 @@ begin ScreenToMap := P; end; +{$IFDEF PATCH_GH} +Function IsMouseOnMap: Boolean; +begin + if ( Mouse_X < ZONE_Map.X ) then Exit( False ); + if ( Mouse_Y < ZONE_Map.Y ) then Exit( False ); + if ( ( ZONE_Map.X + ZONE_Map.W ) < Mouse_X ) then Exit( False ); + if ( ( ZONE_Map.Y + ZONE_Map.H ) < Mouse_Y ) then Exit( False ); + IsMouseOnMap := True; +end; +{$ENDIF PATCH_GH} + Function MouseMapPos: Point; { Return the map position of the mouse. } begin MouseMapPos := ScreenToMap( Mouse_X , Mouse_Y ); end; +{$IFDEF PATCH_GH} +Function DirKey( P: Point; ReDrawer: RedrawProcedureType ): Integer; + { Get a direction selection from the user. If a standard direction } + { key was selected, return its direction (0 is East, increase } + { clockwise). See Locale.pp for details. } + { Return -1 if no good direction was chosen. } +var + K: Char; + M: Point; +begin + repeat + K := RPGKey; + if K = KeyMap[ KMC_East ].KCode then begin + DirKey := 0; + end else if K = KeyMap[ KMC_SouthEast ].KCode then begin + DirKey := 1; + end else if K = KeyMap[ KMC_South ].KCode then begin + DirKey := 2; + end else if K = KeyMap[ KMC_SouthWest ].KCode then begin + DirKey := 3; + end else if K = KeyMap[ KMC_West ].KCode then begin + DirKey := 4; + end else if K = KeyMap[ KMC_NorthWest ].KCode then begin + DirKey := 5; + end else if K = KeyMap[ KMC_North ].KCode then begin + DirKey := 6; + end else if K = KeyMap[ KMC_NorthEast ].KCode then begin + DirKey := 7; + end else if K = KeyMap[ KMC_Enter ].KCode then begin + DirKey := 8; + end else if K = KeyMap[ KMC_Enter2 ].KCode then begin + DirKey := 8; + end else if K = ' ' then begin + DirKey := 8; + end else if K = #27 then begin + DirKey := -1; + end else if K = KeyMap[ KMC_QuitGame ].KCode then begin + DirKey := -1; + end else if K = KeyMap[ KMC_Eject ].KCode then begin + DirKey := -1; + end else if K = RPK_MouseMotion then begin + ReDrawer; + DirKey := -2; + end else if K = RPK_TimeEvent then begin + ReDrawer; + DirKey := -2; + end else if K = RPK_MouseButtonRelease then begin + ReDrawer; + DirKey := -2; + end else if K = RPK_RightButton then begin + DirKey := -1; + end else if K = RPK_MouseButton then begin + M := MouseMapPos; + DirKey := 0; + repeat + if (M.X = P.X + DirKeyAngDir[DirKey,1]) and (M.Y = P.Y + DirKeyAngDir[DirKey,2]) then begin + break; + end; + Inc( DirKey ); + if (9 <= DirKey) then begin + DirKey := -2; + break; + end; + until False; + end else begin + DirKey := 8; + end; + until DirKey <> -2; +end; +{$ENDIF PATCH_GH} + Procedure BeginTurn( GB: GameBoardPtr; M: GearPtr ); { Time to start the turn. } var @@ -1548,12 +2030,29 @@ begin EndOfGameMoreKey; end; + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: sdlmap.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + Map_Mid.X := ( ZONE_Map.W div 2 ) + ZONE_Map.X; + Map_Mid.Y := ( ZONE_Map.H div 2 ) + ZONE_Map.Y; + Map_Mid.W := ( ZONE_Map.W div 6 ); + Map_Mid.H := ( ZONE_Map.H div 6 ); +{$ENDIF PATCH_GH} Terrain_Sprite := ConfirmSprite( Terrain_Sprite_Name , '' , 64 , 96 ); Meta_Terrain_Sprite := ConfirmSprite( Meta_Terrain_Sprite_Name , '' , 64 , 96 ); Terrain_Toupee_Sprite := ConfirmSprite( Terrain_Toupee_Sprite_Name , '' , 64 , 64 ); - Targeting_Srpite := ConfirmSprite( Targeting_Srpite_Name , '' , 64 , 64 ); + Targeting_Sprite := ConfirmSprite( Targeting_Sprite_Name , '' , 64 , 64 ); Items_Sprite := ConfirmSprite( Items_Sprite_Name , '' , 64 , 64 ); +{$IFDEF PATCH_GH} + if Enable_PointAnimation then begin + Default_PointAnimation_Sprite := ConfirmSprite( Default_PointAnimation_Name , '' , 64, 64 ); + end; +{$ENDIF PATCH_GH} Strong_Hit_Sprite := ConfirmSprite( Strong_Hit_Sprite_Name , '' , 64 , 64 ); Weak_Hit_Sprite := ConfirmSprite( Weak_Hit_Sprite_Name , '' , 64 , 64 ); Parry_Sprite := ConfirmSprite( Parry_Sprite_Name , '' , 64 , 64 ); @@ -1573,6 +2072,24 @@ initialization Off_Map_Model_Sprite := ConfirmSprite( 'off_map.png' , '' , 16 , 16 ); Mini_Map_Sprite := ConfirmSprite( 'minimap.png' , '' , 3 , 3 ); +{$IFDEF PATCH_GH} + if Use_Alpha_Blending then begin + if not(NIL = Mini_Map_Sprite) and not(NIL = Mini_Map_Sprite^.Img) then begin + SDL_SetAlpha( Mini_Map_Sprite^.Img , SDL_SRCAlpha , Alpha_Level ); + end else begin + ErrorMessage_fork('Sprite of minimap is not found.'); + end; + end; +{$ELSE PATCH_GH} if Use_Alpha_Blending then SDL_SetAlpha( Mini_Map_Sprite^.Img , SDL_SRCAlpha , Alpha_Level ); +{$ENDIF PATCH_GH} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: sdlmap.pp(finalization)'); +{$ENDIF DEBUG} +end; end. diff -x .svn -uprN GearHead1100repository.original/sdlmenus.pp branches/sdlmenus.pp --- GearHead1100repository.original/sdlmenus.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/sdlmenus.pp 2015-08-01 09:00:00.000000000 +0900 @@ -26,11 +26,13 @@ unit sdlmenus; interface +uses SDL,SDL_TTF,dos, {$IFDEF PLUSGL} -uses SDL,SDL_TTF,dos,glgfx,texutil,ui4gh; + glgfx, {$ELSE} -uses SDL,SDL_TTF,dos,sdlgfx,texutil,ui4gh; + sdlgfx, {$ENDIF} + texutil,ui4gh; const {These two constants are used to tell the SELECT procedure whether or not} @@ -40,6 +42,10 @@ const RPMNoCleanup = 2; {If you want the menu left on the screen after we've finished, use this.} +{$IFDEF PATCH_GH} + IsMenuActive: Boolean = False; +{$ENDIF PATCH_GH} + type RPGMenuKeyPtr = ^RPGMenuKey; RPGMenuKey = Record @@ -51,7 +57,11 @@ type RPGMenuItemPtr = ^RPGMenuItem; RPGMenuItem = Record msg: string; {The text which appears in the menu} +{$IFDEF PATCH_GH} + value: LongInt; {A value, returned by SelectMenu. -1 is reserved for Cancel} +{$ELSE PATCH_GH} value: integer; {A value, returned by SelectMenu. -1 is reserved for Cancel} +{$ENDIF PATCH_GH} desc: string; {Pointer to the item description. If Nil, no desc.} next: RPGMenuItemPtr; end; @@ -68,8 +78,19 @@ type +{$IFDEF PATCH_GH} +Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: LongInt; const desc: string): RPGMenuItemPtr; +Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: LongInt): RPGMenuItemPtr; +Function AddRPGMenuItem_Top(var RPM: RPGMenuPtr; const msg: string; value: LongInt; const desc: string): RPGMenuItemPtr; +Function AddRPGMenuItem_Top(var RPM: RPGMenuPtr; const msg: string; value: LongInt): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: integer; const desc: string): RPGMenuItemPtr; Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: integer): RPGMenuItemPtr; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} +Function PushRPGMenuItemFront( var RPM: RPGMenuPtr; msg: string; value: LongInt; desc: string ): RPGMenuItemPtr; +Function PushRPGMenuItemFront( var RPM: RPGMenuPtr; msg: string; value: LongInt ): RPGMenuItemPtr; +{$ENDIF PATCH_CHEAT} Procedure DisposeRPGMenuItem( var LList: RPGMenuItemPtr ); Procedure ClearMenu( RPM: RPGMenuPtr ); Procedure RemoveRPGMenuItem(RPM: RPGMenuPtr; var LMember: RPGMenuItemPtr); @@ -78,20 +99,82 @@ Procedure AddRPGMenuKey(RPM: RPGMenuPtr; Function CreateRPGMenu(icolor,scolor: TSDL_Color; Z: TSDL_Rect): RPGMenuPtr; Procedure AttachMenuDesc( RPM: RPGMenuPtr; Z: TSDL_Rect ); +{$IFDEF PATCH_GH} +Procedure DisposeRPGMenu(var RPM_arg: RPGMenuPtr); +{$ELSE PATCH_GH} Procedure DisposeRPGMenu(var RPM: RPGMenuPtr); +{$ENDIF PATCH_GH} Procedure DisplayMenu( RPM: RPGMenuPtr; ReDrawer: RedrawProcedureType ); Function RPMLocateByPosition(RPM: RPGMenuPtr; i: integer): RPGMenuItemPtr; +{$IFDEF PATCH_GH} +Function SelectMenu( RPM: RPGMenuPtr; ReDrawer: RedrawProcedureType ): LongInt; +{$ELSE PATCH_GH} Function SelectMenu( RPM: RPGMenuPtr; ReDrawer: RedrawProcedureType ): integer; +{$ENDIF PATCH_GH} Procedure RPMSortAlpha(RPM: RPGMenuPtr); - +{$IFDEF PATCH_CHEAT} +Procedure RPMSortAlpha_withSubItem(RPM: RPGMenuPtr); +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_GH} +Function SetItemByValue( RPM: RPGMenuPtr ; V: LongInt ): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function SetItemByValue( RPM: RPGMenuPtr ; V: Integer ): RPGMenuItemPtr; +{$ENDIF PATCH_GH} Procedure SetItemByPosition( RPM: RPGMenuPtr ; N: Integer ); +{$IFDEF PATCH_GH} +Function BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String; N: Integer ): Integer; +Function BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String ): Integer; +{$ELSE PATCH_GH} Procedure BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String ); +{$ENDIF PATCH_GH} Function SelectFile( RPM: RPGMenuPtr; ReDrawer: RedrawProcedureType ): String; implementation +{$IFDEF PATCH_I18N} +uses + {$IFDEF PATCH_GH} + errmsg, + {$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} + {$ENDIF PATCH_GH} + {$IFDEF PATCH_GH} + pseudosmartpointer, + {$ENDIF PATCH_GH} + {$IFDEF DEBUG} + gears, + {$ENDIF DEBUG} + iconv + {$IFDEF PATCH_CHEAT} + ,menugear + {$ENDIF PATCH_CHEAT} + ; +{$ELSE PATCH_I18N} + {$IFDEF PATCH_GH} +uses errmsg, pseudosmartpointer + {$IFDEF PATCH_CHEAT} + ,menugear + {$ENDIF PATCH_CHEAT} + ; + {$ELSE PATCH_GH} + {$IFDEF DEBUG} +uses errmsg, gears + {$IFDEF PATCH_CHEAT} + ,menugear + {$ENDIF PATCH_CHEAT} + ; + {$ELSE DEBUG} + {$IFDEF PATCH_CHEAT} +uses menugear; + {$ENDIF PATCH_CHEAT} + {$ENDIF DEBUG} + {$ENDIF PATCH_GH} +{$ENDIF PATCH_I18N} + Function LastMenuItem(MIList: RPGMenuItemPtr): RPGMenuItemPtr; {This procedure will find the last item in the linked list.} begin @@ -105,7 +188,11 @@ begin LastMenuItem := MIList; end; +{$IFDEF PATCH_GH} +Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: LongInt; const desc: string): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: integer; const desc: string): RPGMenuItemPtr; +{$ENDIF PATCH_GH} {This procedure will add an item to the RPGToolMenu.} {The new item will be added as the last item in the list.} var @@ -114,6 +201,9 @@ var begin {Allocate memory for it.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('AddRPGMenuItem() New',it); +{$ENDIF DEBUG} {Check to make sure that the allocation succeeded.} if it = Nil then begin @@ -143,12 +233,109 @@ begin AddRPGMenuItem := it; end; +{$IFDEF PATCH_GH} +Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: LongInt): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function AddRPGMenuItem(var RPM: RPGMenuPtr; const msg: string; value: integer): RPGMenuItemPtr; +{$ENDIF PATCH_GH} { Just like the above, but no desc. } begin AddRPGMenuItem := AddRPGMenuItem( RPM , msg , value , '' ); end; +{$IFDEF PATCH_GH} +Function AddRPGMenuItem_Top(var RPM: RPGMenuPtr; const msg: string; value: LongInt; const desc: string): RPGMenuItemPtr; + {This procedure will add an item to the RPGToolMenu.} + {The new item will be added as the last item in the list.} +var + it: ^RPGMenuItem; {Here's a pointer for the item we're creating.} + temp: RPGMenuItemPtr; +begin + {Allocate memory for it.} + New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('AddRPGMenuItem_Top() New',it); +{$ENDIF DEBUG} + + {Check to make sure that the allocation succeeded.} + if it = Nil then begin + exit( Nil ); + end; + + {Initialize it to the correct values.} + it^.msg := msg; + it^.value := value; + it^.next := Nil; + it^.desc := desc; {The desc field is assigned the value of PChar since it} + {is assumed that we arent responsible for the allocation,} + {disposal, or contents of this string.} + + it^.next := RPM^.firstitem; + RPM^.firstitem := it; + + {Increment the NumItem field.} + Inc(RPM^.numitem); + + AddRPGMenuItem_Top := it; +end; + +Function AddRPGMenuItem_Top(var RPM: RPGMenuPtr; const msg: string; value: LongInt): RPGMenuItemPtr; + { Just like the above, but no desc. } +begin + AddRPGMenuItem_Top := AddRPGMenuItem_Top( RPM , msg , value , '' ); +end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} +Function PushRPGMenuItemFront( var RPM: RPGMenuPtr; msg: string; value: LongInt; desc: string ): RPGMenuItemPtr; +var + it: ^RPGMenuItem; {Here's a pointer for the item we're creating.} + temp: RPGMenuItemPtr; +begin + {Allocate memory for it.} + New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('PushRPGMenuItemFront() New',it); +{$ENDIF DEBUG} + + {Check to make sure that the allocation succeeded.} + if it = Nil then begin + {Oops... something went wrong. Better let the user know.} + {$IFDEF PATCH_GH} + ErrorMessage('Error: Popcorn Delta. AddRPGMenuItem messsed up.'); + {$ELSE PATCH_GH} + writeln('Error: Popcorn Delta. AddRPGMenuItem messsed up.'); + {$ENDIF PATCH_GH} + { readkey; } + exit; + end; + + {Initialize it to the correct values.} + it^.msg := msg; + it^.value := value; + it^.next := Nil; + it^.desc := desc; {The desc field is assigned the value of PChar since it} + {is assumed that we arent responsible for the allocation,} + {disposal, or contents of this string.} + + {Locate the last item in the list, then assign "it" to it.} + {If the list is currently empty, stick "it" in as the first item.} + temp := RPM^.firstitem; + it^.next := temp; + RPM^.firstitem := it; + + {Increment the NumItem field.} + Inc(RPM^.numitem); + + PushRPGMenuItemFront := it; +end; + +Function PushRPGMenuItemFront( var RPM: RPGMenuPtr; msg:string; value: LongInt ): RPGMenuItemPtr; +begin + PushRPGMenuItemFront := PushRPGMenuItemFront( RPM, msg, value, '' ); +end; +{$ENDIF PATCH_CHEAT} + Procedure DisposeRPGMenuItem( var LList: RPGMenuItemPtr ); { Get rid of this list of items. } { WARNING - If you call this procedure for a menu, it will not } @@ -160,6 +347,18 @@ var begin while LList <> Nil do begin NextItem := LList^.Next; +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeRPGMenuItem() Dispose',LList); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('DisposeRPGMenuItem() Dispose',LList,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + LList^.msg[1] := '@'; + LList^.value := -32767; + LList^.desc[1] := '@'; + LList^.Next := RPGMenuItemPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose( LList ); LList := NextItem; end; @@ -196,18 +395,46 @@ begin if B = Nil then begin {Major FUBAR. The member we were trying to remove can't} {be found in the list.} +{$IFDEF PATCH_GH} + ErrorMessage_fork('ERROR- RemoveLink asked to remove a link that doesnt exist.'); +{$ELSE PATCH_GH} writeln('ERROR- RemoveLink asked to remove a link that doesnt exist.'); +{$ENDIF PATCH_GH} end else if A = Nil then begin {There's no element before the one we want to remove,} {i.e. it's the first one in the list.} RPM^.FirstItem := B^.Next; +{$IFDEF DEBUG} + Trace_MemoryLeak('RemoveRPGMenuItem() Dispose',B); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('RemoveRPGMenuItem() Dispose',B,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + B^.msg[1] := '@'; + B^.value := -32767; + B^.desc[1] := '@'; + B^.Next := RPGMenuItemPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(B); end else begin {We found the attribute we want to delete and have another} {one standing before it in line. Go to work.} A^.next := B^.next; +{$IFDEF DEBUG} + Trace_MemoryLeak('RemoveRPGMenuItem() Dispose',B); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('RemoveRPGMenuItem() Dispose',B,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + B^.msg[1] := '@'; + B^.value := -32767; + B^.desc[1] := '@'; + B^.Next := RPGMenuItemPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(B); end; @@ -221,6 +448,9 @@ var it: RPGMenuKeyPtr; begin New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('AddRPGMenuKey() New',it); +{$ENDIF DEBUG} if it = Nil then begin exit; end; @@ -239,6 +469,9 @@ var begin {Allocate memory for it.} New(it); +{$IFDEF DEBUG} + Trace_MemoryLeak('CreateRPGMenu() New',it); +{$ENDIF DEBUG} {Check to make sure that we've actually initialized something.} if it = Nil then exit( Nil ); @@ -273,27 +506,85 @@ begin RPM^.Desc_Zone := Z; end; +{$IFDEF PATCH_GH} +Procedure DisposeRPGMenu(var RPM_arg: RPGMenuPtr); +{$ELSE PATCH_GH} Procedure DisposeRPGMenu(var RPM: RPGMenuPtr); +{$ENDIF PATCH_GH} {This procedure is called when you want to get rid of the menu. It will deallocate} {the memory for the RPGMenu record and also for all of the linked RPGMenuItems.} var +{$IFDEF PATCH_GH} + RPM: RPGMenuPtr; +{$ENDIF PATCH_GH} c,d: RPGMenuKeyPtr; begin +{$IFDEF PATCH_GH} + RPM := RPM_arg; +{$ENDIF PATCH_GH} {Check to make sure that we've got a valid pointer here.} if RPM = Nil then begin +{$IFDEF PATCH_GH} + ErrorMessage('ERROR: Joe is a Doofus. DisposeRPGMenu has been passed a null pointer.'); +{$ENDIF PATCH_GH} exit; end; +{$IFDEF PATCH_GH} + RPM_arg := NIL; +{$ENDIF PATCH_GH} {Save the location of the first menu item...} DisposeRPGMenuItem( RPM^.FirstItem ); c := RPM^.FirstKey; {... then get rid of the menu record.} +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeRPGMenu() Dispose',RPM); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('DisposeRPGMenu() Dispose',RPM,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + RPM^.ItemColor.r := 126; + RPM^.ItemColor.g := 126; + RPM^.ItemColor.b := 126; + RPM^.SelColor.r := 126; + RPM^.SelColor.g := 126; + RPM^.SelColor.b := 126; + RPM^.DtexColor.r := 126; + RPM^.DtexColor.g := 126; + RPM^.DtexColor.b := 126; + RPM^.Menu_Zone.x := -32767; + RPM^.Menu_Zone.y := -32767; + RPM^.Menu_Zone.w := 32766; + RPM^.Menu_Zone.h := 32766; + RPM^.Desc_Zone.x := -32767; + RPM^.Desc_Zone.y := -32767; + RPM^.Desc_Zone.w := 32766; + RPM^.Desc_Zone.h := 32766; + RPM^.mode := 126; + RPM^.TopItem := -32767; + RPM^.SelectItem := -32767; + RPM^.NumItem := -32767; + RPM^.FirstItem := RPGMenuItemPtr(-1); + RPM^.FirstKey := RPGMenuKeyPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(RPM); RPM := Nil; {Keep processing the menu items until we hit a Nil nextitem.} while c <> Nil do begin d := c^.next; +{$IFDEF DEBUG} + Trace_MemoryLeak('DisposeRPGMenu() Dispose',c); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + CheckAndNIL_Pointer('DisposeRPGMenu() Dispose',c,True); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH_PARANOID_SAFER} + c^.k := #126; + c^.value := -32767; + c^.Next := RPGMenuKeyPtr(-1); +{$ENDIF PATCH_GH_PARANOID_SAFER} Dispose(c); c := d; end; @@ -327,6 +618,11 @@ var MH: Integer; begin MH := ( RPM^.Menu_Zone.h div TTF_FontLineSkip( game_font ) ); +{$IFDEF PATCH_GH} + if Show_MenuPage then begin + Dec( MH ); + end; +{$ENDIF PATCH_GH} if MH < 1 then MH := 1; MenuHeight := MH; end; @@ -336,12 +632,21 @@ Procedure RPMRefreshDesc(RPM: RPGMenuPtr begin {Check to make sure that this menu has a description box, first off.} if RPM^.Desc_Zone.W > 0 then begin +{$IFDEF PATCH_I18N} + NFVCMessage( RPMLocateByPosition(RPM,RPM^.selectitem)^.desc , RPM^.Desc_Zone , RPM^.dtexcolor ); +{$ELSE PATCH_I18N} NFCMessage( RPMLocateByPosition(RPM,RPM^.selectitem)^.desc , RPM^.Desc_Zone , RPM^.dtexcolor ); +{$ENDIF PATCH_I18N} end; end; Procedure DisplayMenu( RPM: RPGMenuPtr; ReDrawer: RedrawProcedureType ); {Display the menu on the screen.} +{$IFDEF PATCH_GH} +const + MoreMark: String = '*'; + CurrentPageMark: String = '-'; +{$ENDIF PATCH_GH} var topitem: RPGMenuItemPtr; a: RPGMenuItemPtr; {A pointer to be used while printing.} @@ -349,12 +654,33 @@ var height: integer; {The width of the menu display.} NextColor: PSDL_Color; Item_Image: PSDL_Surface; +{$IFDEF PATCH_I18N} + MyDestRTL: TSDL_Rect; +{$ELSE PATCH_I18N} Item_PText: PChar; +{$ENDIF PATCH_I18N} MyDest: TSDL_Rect; Y,DY: Integer; +{$IFDEF PATCH_GH} + MyDestBase: TSDL_Rect; + MenuItemStr: String; + LastItem: Integer; +{$ENDIF PATCH_GH} begin {Error check- make sure the menu has items in it.} if RPM^.FirstItem = Nil then Exit; +{$IFDEF PATCH_GH} + if RPM^.NumItem < RPM^.SelectItem then begin + RPM^.SelectItem := RPM^.NumItem; + end else if RPM^.SelectItem < 1 then begin + RPM^.SelectItem := 1; + end; + if RPM^.NumItem < RPM^.TopItem then begin + RPM^.TopItem := RPM^.NumItem; + end else if RPM^.TopItem < 1 then begin + RPM^.TopItem := 1; + end; +{$ENDIF PATCH_GH} { If a redraw procedure has been specified, call it. } if ReDrawer <> Nil then ReDrawer; @@ -371,10 +697,24 @@ begin {Locate the top of the menu.} topitem := RPMLocateByPosition(RPM,RPM^.topitem); +{$IFDEF PATCH_JPSSDL} + MyDest.X := RPM^.Menu_Zone.X + Pad_Left; +{$ELSE PATCH_JPSSDL} MyDest.X := RPM^.Menu_Zone.X; +{$ENDIF PATCH_JPSSDL} Y := RPM^.Menu_Zone.Y; DY := TTF_FontLineSkip( game_font ); +{$IFDEF PATCH_JPSSDL} + MyDest.W := RPM^.Menu_Zone.W - Pad_Left; +{$ELSE PATCH_JPSSDL} MyDest.W := RPM^.Menu_Zone.W; +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_I18N} + MyDestRTL := MyDest; +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + MyDestBase := MyDest; +{$ENDIF PATCH_GH} a := topitem; for t := 1 to Height do begin @@ -387,18 +727,148 @@ begin else NextColor := @RPM^.itemcolor; +{$IFDEF PATCH_I18N} + if (1 < Length(a^.msg)) and (#$0 = a^.msg[1]) then begin + Item_Image := I18N_TTF_RenderText( game_font, Copy(a^.msg,2,Length(a^.msg)-1), NextColor^ ); + end else begin + Item_Image := I18N_TTF_RenderText( game_font , a^.msg , NextColor^ ); + end; + if TERMINAL_bidiRTL then begin + MyDest.X := MyDestRTL.X + MyDestRTL.W - Item_Image^.W; + end; +{$ELSE PATCH_I18N} Item_PText := QuickPCopy( a^.msg ); Item_Image := TTF_RenderText_Solid( game_font , Item_PText , NextColor^ ); Dispose( Item_PText ); +{$ENDIF PATCH_I18N} SDL_BlitSurface( Item_Image , Nil , Game_Screen , @MyDest ); SDL_FreeSurface( Item_Image ); +{$IFDEF PATCH_GH} + if not(SDL_Show_MenuScrollbar) and Show_MenuScrollbar then begin + if ((1 = t) and (1 < RPM^.topitem)) or ((Height = t) and ((RPM^.topitem + Height - 1) < RPM^.numitem)) then begin + {$IFDEF PATCH_I18N} + Item_Image := I18N_TTF_RenderText( game_font , MoreMark , RPM^.selcolor ); + if TERMINAL_bidiRTL then begin + MyDest.X := MyDestBase.X; + end else begin + MyDest.X := MyDestBase.X + MyDestBase.W - Item_Image^.W; + end; + {$ELSE PATCH_I18N} + Item_PText := QuickPCopy( MoreMark ); + Item_Image := TTF_RenderText_Solid( game_font , Item_PText , RPM^.selcolor ); + Dispose( Item_PText ); + MyDest.X := MyDestBase.X + MyDestBase.W - Item_Image^.W; + {$ENDIF PATCH_I18N} + SDL_BlitSurface( Item_Image , NIL , Game_Screen , @MyDest ); + SDL_FreeSurface( Item_Image ); + MyDest.X := MyDestBase.X; + end; + end; +{$ENDIF PATCH_GH} + a := a^.next; {Check to see if we've prematurely encountered the end of the list.} if a = Nil then break; end; +{$IFDEF PATCH_GH} + if SDL_Show_MenuScrollbar then begin + MyDestBase.X := RPM^.Menu_Zone.X; + MyDestBase.W := RPM^.Menu_Zone.W; + MyDestBase.Y := RPM^.Menu_Zone.Y + SDL_Scrollbar_Size; + MyDestBase.H := RPM^.Menu_Zone.H - SDL_Scrollbar_Size - SDL_Scrollbar_Size; + + { Button: Up } + MyDest.W := SDL_Scrollbar_Size - 2; + MyDest.X := MyDestBase.X + MyDestBase.W - SDL_Scrollbar_Size + 1; + MyDest.H := SDL_Scrollbar_Size - 2; + MyDest.Y := RPM^.Menu_Zone.Y; + if (1 < RPM^.topitem) then begin + SDL_FillRect( Game_Screen, @MyDest, SDL_MapRGB( Game_Screen^.Format , MenuSelect.R , MenuSelect.G , MenuSelect.B ) ); + end else begin + SDL_FillRect( Game_Screen, @MyDest, SDL_MapRGB( Game_Screen^.Format , MenuItem.R , MenuItem.G , MenuItem.B ) ); + end; + + { Button: Down } + MyDest.H := SDL_Scrollbar_Size - 2; + MyDest.Y := RPM^.Menu_Zone.Y + RPM^.Menu_Zone.H - SDL_Scrollbar_Size + 2; + if (Height <= (RPM^.numitem - RPM^.topitem)) then begin + SDL_FillRect( Game_Screen, @MyDest, SDL_MapRGB( Game_Screen^.Format , MenuSelect.R , MenuSelect.G , MenuSelect.B ) ); + end else begin + SDL_FillRect( Game_Screen, @MyDest, SDL_MapRGB( Game_Screen^.Format , MenuItem.R , MenuItem.G , MenuItem.B ) ); + end; + + { Bar: Silhouette } + MyDest.W := SDL_Scrollbar_Size; + MyDest.X := MyDestBase.X + MyDestBase.W - MyDest.W; + MyDest.H := MyDestBase.H; + MyDest.Y := MyDestBase.Y; + SDL_FillRect( Game_Screen, @MyDest, SDL_MapRGB( Game_Screen^.Format , MenuItem.R , MenuItem.G , MenuItem.B ) ); + + { Bar: Light } + MyDest.Y := MyDestBase.Y + (((RPM^.topitem - 1) * MyDestBase.H) div RPM^.numitem); + MyDest.H := ((Height * MyDestBase.H) div RPM^.numitem); + if (MyDest.H < 1) then begin + MyDest.H := 1; + end; + if (MyDestBase.H < MyDest.H) then begin + MyDest.H := MyDestBase.H; + end; + SDL_FillRect( Game_Screen, @MyDest, SDL_MapRGB( Game_Screen^.Format , MenuSelect.R , MenuSelect.G , MenuSelect.B ) ); + + { Bar: Highlight } + MyDest.X := MyDestBase.X + MyDestBase.W - (SDL_Scrollbar_Size div 2); + MyDest.W := 1; + MyDest.Y := MyDestBase.Y + (((RPM^.selectitem - 1) * MyDestBase.H) div RPM^.numitem); + MyDest.H := (MyDestBase.H div RPM^.numitem); + if (MyDest.H < 1) then begin + MyDest.H := 1; + end; + SDL_FillRect( Game_Screen, @MyDest, SDL_MapRGB( Game_Screen^.Format , BorderBlue.R , BorderBlue.G , BorderBlue.B ) ); + end else if Show_MenuScrollbar and (Height < RPM^.numitem) then begin + MyDest.Y := RPM^.Menu_Zone.Y + (((RPM^.selectitem - 1) * (Height * DY - DY)) div (RPM^.numitem - 1)); + {$IFDEF PATCH_I18N} + Item_Image := I18N_TTF_RenderText( game_font , CurrentPageMark , RPM^.selcolor ); + if TERMINAL_bidiRTL then begin + MyDest.X := MyDestBase.X; + end else begin + MyDest.X := MyDestBase.X + MyDestBase.W - Item_Image^.W; + end; + {$ELSE PATCH_I18N} + Item_PText := QuickPCopy( CurrentPageMark ); + Item_Image := TTF_RenderText_Solid( game_font , Item_PText , RPM^.selcolor ); + Dispose( Item_PText ); + MyDest.X := MyDestBase.X + MyDestBase.W - Item_Image^.W; + {$ENDIF PATCH_I18N} + SDL_BlitSurface( Item_Image , NIL , Game_Screen , @MyDest ); + SDL_FreeSurface( Item_Image ); + MyDest.X := MyDestBase.X; + end; + if Show_MenuPage then begin + LastItem := RPM^.topitem + Height - 1; + if RPM^.numitem < LastItem then begin + LastItem := RPM^.numitem; + end; + MenuItemStr := '(' + BStr(RPM^.topitem) + '-' + BStr(RPM^.selectitem) + '-' + BStr(LastItem) + '/' + BStr(RPM^.numitem) + ')'; + MyDest.X := MyDestBase.X; + MyDest.Y := RPM^.Menu_Zone.Y + DY * Height; + {$IFDEF PATCH_I18N} + Item_Image := I18N_TTF_RenderText( game_font, MenuItemStr, RPM^.itemcolor ); + if TERMINAL_bidiRTL then begin + MyDest.X := MyDestRTL.X + MyDestRTL.W - Item_Image^.W; + end; + {$ELSE PATCH_I18N} + Item_PText := QuickPCopy( a^.msg ); + Item_Image := TTF_RenderText_Solid( game_font, MenuItemStr, @RPM^.itemcolor ); + Dispose( Item_PText ); + {$ENDIF PATCH_I18N} + SDL_BlitSurface( Item_Image, NIL, Game_Screen, @MyDest ); + SDL_FreeSurface( Item_Image ); + end; +{$ENDIF PATCH_GH} + {Restore the window to its regular size.} SDL_SetClipRect( Game_Screen , Nil ); @@ -406,6 +876,77 @@ begin RPMRefreshDesc(RPM); end; +{$IFDEF PATCH_GH} +Procedure RPMReposition( RPM: RPGMenuPtr; FullScroll: Boolean ); + {The selected item has just changed, and is no longer visible on screen.} + {Adjust the RPGMenu's topitem field to an appropriate value.} +begin + {When this function is called, there are two possibilities: either the} + {selector has moved off the bottom of the page or the top.} + + if RPM^.selectitem < RPM^.topitem then begin + {The selector has moved off the bottom of the list. The new page} + {display should start with SelectItem on the bottom.} + if FullScroll then begin + RPM^.topitem := RPM^.selectitem - MenuHeight( RPM ) + 1; + end else begin + RPM^.topitem := RPM^.selectitem; + end; + + {Error check- if this moves topitem below 1, that's bad.} + if RPM^.topitem < 1 then begin + RPM^.topitem := 1; + end; + end else begin + {The selector has moved off the top of the list. The new page should} + {start with SelectItem at the top, unless this would make things look} + {funny.} + if FullScroll then begin + if ((RPM^.selectitem + MenuHeight( RPM ) - 1) > RPM^.numitem) then begin + {There will be whitespace at the bottom of the menu if we assign} + {SelectItem to TopItem. Make TopItem equal to the effective last} + {page.} + RPM^.topitem := RPM^.numitem - MenuHeight( RPM ) + 1; + if RPM^.topitem < 1 then begin + RPM^.topitem := 1; + end; + end else begin + RPM^.topitem := RPM^.selectitem; + end; + end else if ((RPM^.topitem + MenuHeight( RPM ) - 1) < RPM^.numitem) then begin + Inc( RPM^.TopItem ); + end; + end; + +end; + +Procedure RPMReposition( RPM: RPGMenuPtr ); +begin + { Check a limit. } + if (RPM^.selectitem < 1) then begin RPM^.selectitem := 1 + end else if (RPM^.numitem < RPM^.selectitem) then begin RPM^.selectitem := RPM^.numitem + end; + + if (RPM^.selectitem < RPM^.topitem) then begin + { Page Up } + RPM^.topitem := RPM^.selectitem; + + { Check a limit. } + if RPM^.topitem < 1 then begin + RPM^.topitem := 1; + end; + end else if (RPM^.topitem + MenuHeight(RPM) <= RPM^.selectitem) then begin + { Page Down } + RPM^.topitem := RPM^.selectitem - MenuHeight(RPM) + 1; + + { Check a limit. } + if RPM^.numitem < RPM^.topitem then begin + RPM^.topitem := RPM^.numitem; + end; + end; + +end; +{$ELSE PATCH_GH} Procedure RPMReposition( RPM: RPGMenuPtr; FullScroll: Boolean ); {The selected item has just changed, and is no longer visible on screen.} {Adjust the RPGMenu's topitem field to an appropriate value.} @@ -446,6 +987,43 @@ begin end; end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Procedure RPMReposition_center( RPM: RPGMenuPtr ); +begin + { Check a limit. } + if (RPM^.selectitem < 1) then begin + RPM^.selectitem := 1 + end else if (RPM^.numitem < RPM^.selectitem) then begin + RPM^.selectitem := RPM^.numitem + end; + + { Auto reposition mode. } + if (RPM^.topitem < 1) then begin + RPM^.topitem := RPM^.selectitem - ( MenuHeight(RPM) div 2 ); + if (RPM^.topitem < 1) then begin + RPM^.topitem := 1; + end; + end else if (RPM^.numitem < RPM^.topitem) then begin + RPM^.topitem := RPM^.selectitem - MenuHeight(RPM) + 1; + if (RPM^.topitem < 1) then begin + RPM^.topitem := 1; + end; + end else if (RPM^.selectitem < RPM^.topitem) then begin + RPM^.topitem := RPM^.selectitem - MenuHeight(RPM) + 1; + if RPM^.topitem < 1 then begin + RPM^.topitem := 1; + end; + end else if (RPM^.topitem + MenuHeight(RPM) <= RPM^.selectitem) then begin + RPM^.topitem := RPM^.selectitem; + if RPM^.numitem < RPM^.topitem then begin + RPM^.topitem := RPM^.numitem; + end; + end; + +end; +{$ENDIF PATCH_GH} Procedure RPMUpKey( RPM: RPGMenuPtr; FullScroll: Boolean ); {Someone just pressed the UP key, and we're gonna process that input.} @@ -486,19 +1064,85 @@ begin end; end; +{$IFDEF PATCH_JPSSDL} +Procedure RPMPgUpKey( RPM: RPGMenuPtr; FullScroll: Boolean ); +var + p: Integer; +begin + p := RPM^.selectitem - RPM^.topitem; + RPM^.selectitem := RPM^.selectitem - MenuHeight( RPM ); + RPM^.topitem := RPM^.selectitem - p; + + if RPM^.selectitem < 1 then RPM^.selectitem := 1; + if RPM^.topitem < 1 then RPM^.topitem := 1; +end; + +Procedure RPMPgDownKey( RPM: RPGMenuPtr; FullScroll: Boolean ); +var + p: Integer; +begin + p := RPM^.selectitem - RPM^.topitem; + RPM^.selectitem := RPM^.selectitem + MenuHeight( RPM ); + RPM^.topitem := RPM^.selectitem - p; + + if RPM^.selectitem > RPM^.numitem then RPM^.selectitem := RPM^.numitem; + if (RPM^.numitem > MenuHeight( RPM )) then begin + if RPM^.topitem > (RPM^.numitem - MenuHeight( RPM ) + 1) then RPM^.topitem := RPM^.numitem - MenuHeight( RPM ) + 1; + end else RPM^.topitem := 1; +end; +{$ENDIF PATCH_JPSSDL} + +{$IFDEF PATCH_GH} +Procedure RPMScrollUpKey( RPM: RPGMenuPtr; FullScroll: Boolean ); +begin + Dec(RPM^.selectitem); + if RPM^.selectitem < 1 then + RPM^.selectitem := 1; + Dec(RPM^.topitem); + if RPM^.topitem < 1 then + RPM^.topitem := 1; +end; +Procedure RPMScrollDownKey( RPM: RPGMenuPtr; FullScroll: Boolean ); +begin + Inc(RPM^.selectitem); + if RPM^.numitem < RPM^.selectitem then + RPM^.selectitem := RPM^.numitem; + Inc(RPM^.topitem); + if (RPM^.numitem > MenuHeight( RPM )) then begin + if RPM^.topitem > (RPM^.numitem - MenuHeight( RPM ) + 1) then RPM^.topitem := RPM^.numitem - MenuHeight( RPM ) + 1; + end else RPM^.topitem := 1; +end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} +Function SelectMenu( RPM: RPGMenuPtr; ReDrawer: RedrawProcedureType ): LongInt; +{$ELSE PATCH_GH} Function SelectMenu( RPM: RPGMenuPtr; ReDrawer: RedrawProcedureType ): integer; +{$ENDIF PATCH_GH} {This function will allow the user to browse through the menu and will} {return a value based upon the user's selection.} var getit: char; {Character used to store user input} +{$IFDEF PATCH_GH} + r: LongInt; {The value we'll be sending back.} + I: integer; +{$ELSE PATCH_GH} r,I: integer; {The value we'll be sending back.} +{$ENDIF PATCH_GH} m: RPGMenuKeyPtr; UK: Boolean; {Has a special MenuKey been pressed?} OldMouseX, OldMouseY: Integer; { TUNGINOBI: I got sick of the mouse cursor getting } { in the way of the keyboard, so this will only } { change the menu item if the mouse has moved. } -begin +{$IFDEF PATCH_GH} + Scrollbar_DragMode: Boolean = False; +{$ENDIF PATCH_GH} +begin +{$IFDEF PATCH_GH} + RPMReposition_center( RPM ); +{$ENDIF PATCH_GH} + {The menu is now active!} RPM^.Active := True; {Show the menu to the user.} @@ -512,6 +1156,10 @@ begin {Initialize UK} UK := False; +{$IFDEF PATCH_GH} + IsMenuActive := True; +{$ENDIF PATCH_GH} + {Start the loop. Remain in this loop until either the player makes a selection} {or cancels the menu using the ESC key.} repeat @@ -521,11 +1169,184 @@ begin {Read the input from the keyboard.} getit := RPGKey; +{$IFDEF PATCH_GH} + if getit = KeyMap[ KMC_MenuUp ].KCode then begin + getit := RPK_Up; + end else if getit = KeyMap[ KMC_MenuDown ].KCode then begin + getit := RPK_Down; + end else if getit = KeyMap[ KMC_PageUp ].KCode then begin + getit := RPK_UpRight; + end else if getit = KeyMap[ KMC_PageDown ].KCode then begin + getit := RPK_DownRight; + end else if getit = KeyMap[ KMC_ScrollUp ].KCode then begin + getit := RPK_UpLeft; + end else if getit = KeyMap[ KMC_ScrollDown ].KCode then begin + getit := RPK_DownLeft; + end; + if SelectMenu_UpDown_by_MouseWheel_UD_Reverse then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_Down; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_Up; + end; + end else if SelectMenu_UpDown_by_MouseWheel_UD then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_Up; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_Down; + end; + end; + if SelectMenu_UpDown_by_MouseWheel_LR_Reverse then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_Down; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_Up; + end; + end else if SelectMenu_UpDown_by_MouseWheel_LR then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_Up; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_Down; + end; + end; + if SelectMenu_Scroll_by_MouseWheel_UD_Reverse then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_DownLeft; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_UpLeft; + end; + end else if SelectMenu_Scroll_by_MouseWheel_UD then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_UpLeft; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_DownLeft; + end; + end; + if SelectMenu_Scroll_by_MouseWheel_LR_Reverse then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_DownLeft; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_UpLeft; + end; + end else if SelectMenu_Scroll_by_MouseWheel_LR then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_UpLeft; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_DownLeft; + end; + end; + if SelectMenu_ScrollPage_by_MouseWheel_UD_Reverse then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_DownRight; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_UpRight; + end; + end else if SelectMenu_ScrollPage_by_MouseWheel_UD then begin + if getit = KeyMap[ KMC_ButtonWUp ].KCode then begin + getit := RPK_UpRight; + end else if getit = KeyMap[ KMC_ButtonWDown ].KCode then begin + getit := RPK_DownRight; + end; + end; + if SelectMenu_ScrollPage_by_MouseWheel_LR_Reverse then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_DownRight; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_UpRight; + end; + end else if SelectMenu_ScrollPage_by_MouseWheel_LR then begin + if getit = KeyMap[ KMC_ButtonWLeft ].KCode then begin + getit := RPK_UpRight; + end else if getit = KeyMap[ KMC_ButtonWRight ].KCode then begin + getit := RPK_DownRight; + end; + end; +{$ENDIF PATCH_GH} + {Certain keys need processing- if so, process them.} case getit of {Selection Movement Keys} +{$IFDEF PATCH_GH} + RPK_Up: begin RPMUpKey( RPM , True ); getit := #0; end; + RPK_Down: begin RPMDownKey( RPM , True ); getit := #0; end; + RPK_UpRight: begin RPMPgUpKey( RPM , True ); getit := #0; end; + RPK_DownRight: begin RPMPgDownKey( RPM , True ); getit := #0; end; + RPK_UpLeft: begin RPMScrollUpKey( RPM , False ); getit := #0; end; + RPK_DownLeft: begin RPMScrollDownKey( RPM , False ); getit := #0; end; + RPK_MouseMotion: + if Mouse_Active then begin + if Scrollbar_DragMode and SDL_Show_MenuScrollbar then begin + if (RPM^.Menu_Zone.Y <= Mouse_Y) and (Mouse_Y <= (RPM^.Menu_Zone.Y + RPM^.Menu_Zone.H)) then begin + RPM^.selectitem := ((Mouse_Y - (RPM^.Menu_Zone.Y + SDL_Scrollbar_Size)) * RPM^.numitem) div (RPM^.Menu_Zone.H - SDL_Scrollbar_Size - SDL_Scrollbar_Size) + 1; + RPMReposition( RPM ); + end; + end else + { If the mouse pointer is around } + { the menu, we may have to do something. } + if ( Mouse_X >= RPM^.Menu_Zone.X ) and ( Mouse_X <= ( RPM^.Menu_Zone.X + RPM^.Menu_Zone.W ) ) and (( Mouse_X <> OldMouseX ) or ( Mouse_Y <> OldMouseY )) then begin + if SDL_Show_MenuScrollbar and ((RPM^.Menu_Zone.X + RPM^.Menu_Zone.W - SDL_Scrollbar_Size) <= Mouse_X) then begin + { Region of ScrollBar } + end else if ( Mouse_Y < ( RPM^.Menu_Zone.Y ) ) then begin + if SelectMenu_Scroll_by_Edge and ( RPM^.SelectItem > 1 ) then RPMUpKey( RPM , False ); + end else if ( Mouse_Y > ( RPM^.Menu_Zone.Y + RPM^.Menu_Zone.H ) ) then begin + if SelectMenu_Scroll_by_Edge and ( (RPM^.selectitem - RPM^.topitem) < MenuHeight( RPM ) ) and ( RPM^.selectitem < RPM^.numitem ) then RPMDownKey( RPM , False ); + end else begin + I := ( Mouse_Y - RPM^.Menu_Zone.Y ) div TTF_FontLineSkip( game_font ); + if (0 <= I) and (I < MenuHeight( RPM )) then begin + SetItemByPosition( RPM , RPM^.TopItem + I ); + end; + { Upon setting an item directly, freeze the mouse. } + OldMouseX := Mouse_X; + OldMouseY := Mouse_Y; + end; + end; + end; + RPK_MouseButton: + if Mouse_Active then begin + { If the mouse hit happened inside } + { the menu area, it was a selection. } + { Otherwise it was a cancel. } + if ( Mouse_X >= RPM^.Menu_Zone.X ) and ( Mouse_X <= ( RPM^.Menu_Zone.X + RPM^.Menu_Zone.W )) and ( Mouse_Y >= RPM^.Menu_Zone.Y ) and ( Mouse_Y <= ( RPM^.Menu_Zone.Y + RPM^.Menu_Zone.H )) then begin + if SDL_Show_MenuScrollbar and ((RPM^.Menu_Zone.X + RPM^.Menu_Zone.W - SDL_Scrollbar_Size) <= Mouse_X) then begin + { Region of ScrollBar } + if (Mouse_Y <= (RPM^.Menu_Zone.Y + SDL_Scrollbar_Size)) then begin + RPMScrollUpKey( RPM , False ); + end else if ((RPM^.Menu_Zone.Y + RPM^.Menu_Zone.H - SDL_Scrollbar_Size) <= Mouse_Y) then begin + RPMScrollDownKey( RPM , False ); + end else if (Mouse_Y < (RPM^.Menu_Zone.Y + SDL_Scrollbar_Size + (((RPM^.topitem - 1) * (RPM^.Menu_Zone.H - SDL_Scrollbar_Size - SDL_Scrollbar_Size)) div RPM^.numitem))) then begin + RPMPgUpKey( RPM , True ); + end else if ((RPM^.Menu_Zone.Y + SDL_Scrollbar_Size + (((RPM^.topitem - 1 + MenuHeight(RPM)) * (RPM^.Menu_Zone.H - SDL_Scrollbar_Size - SDL_Scrollbar_Size)) div RPM^.numitem)) < Mouse_Y) then begin + RPMPgDownKey( RPM , True ); + end else begin + Scrollbar_DragMode := True; + end; + getit := #0; + end else begin + getit := ' '; + end; + end else begin + if RPM^.Mode <> RPMNoCancel then getit := #27 + else getit := ' '; + end; + end; + RPK_MouseButtonRelease: + if Mouse_Active then begin + if Scrollbar_DragMode and SDL_Show_MenuScrollbar then begin + if (RPM^.Menu_Zone.Y <= Mouse_Y) and (Mouse_Y <= (RPM^.Menu_Zone.Y + RPM^.Menu_Zone.H)) then begin + RPM^.selectitem := ((Mouse_Y - (RPM^.Menu_Zone.Y + SDL_Scrollbar_Size)) * RPM^.numitem) div (RPM^.Menu_Zone.H - SDL_Scrollbar_Size - SDL_Scrollbar_Size) + 1; + RPMReposition( RPM ); + end; + end; + Scrollbar_DragMode := False; + getit := #0; + end; +{$ELSE PATCH_GH} RPK_Up: RPMUpKey( RPM , True ); RPK_Down: RPMDownKey( RPM , True ); + {$IFDEF PATCH_JPSSDL} + RPK_Left: RPMPgUpKey( RPM , True ); + RPK_Right: RPMPgDownKey( RPM , True ); + {$ENDIF PATCH_JPSSDL} RPK_TimeEvent: begin { If the mouse pointer is around } @@ -556,6 +1377,7 @@ begin else getit := ' '; end; end; +{$ENDIF PATCH_GH} RPK_RightButton: if ( RPM^.Mode <> RPMNoCancel ) and Mouse_Active then getit := #27; @@ -584,6 +1406,10 @@ begin {Check for a SPACE or ESC.} until (getit = ' ') or (getit = #27) or UK; +{$IFDEF PATCH_GH} + IsMenuActive := False; +{$ENDIF PATCH_GH} + {The menu is no longer active.} RPM^.Active := False; @@ -659,7 +1485,69 @@ begin RPM^.firstitem := Sorted; end; +{$IFDEF PATCH_CHEAT} +Procedure RPMSortAlpha_withSubItem(RPM: RPGMenuPtr); +var + Sorted: RPGMenuItemPtr; + NextBranches: RPGMenuItemPtr; + CurrentBranch_Top, CurrentBranch_Bottom: RPGMenuItemPtr; + TmpBranch_Top, TmpBranch_Bottom: RPGMenuItemPtr; + TmpNextBranches: RPGMenuItemPtr; + youshouldstop: Boolean; {Can you think of a better name?} +begin + NextBranches := RPM^.firstitem; + Sorted := NIL; + + while NextBranches <> NIL do begin + { Take a current branch to 'CurrentBranch_Top' and 'CurrentBranch_Bottom', } + { and get the top of next branches to 'NextBranches'. } + CurrentBranch_Top := NextBranches; + CurrentBranch_Bottom := CurrentBranch_Top; + while (NIL <> CurrentBranch_Bottom^.next) and (#$0 = CurrentBranch_Bottom^.next^.msg[1]) do begin + CurrentBranch_Bottom := CurrentBranch_Bottom^.next; + end; + NextBranches := CurrentBranch_Bottom^.next; + CurrentBranch_Bottom^.next := NIL; + + { Locate the correct position in Sorted to store 'CurrentBranch_Top'. } + if Sorted = NIL then begin + Sorted := CurrentBranch_Top; + end else if CurrentBranch_Top^.msg < Sorted^.msg then begin + { CurrentBranch_Top/CurrentBranch_Bottom should be the first element in the list. } + TmpNextBranches := Sorted; + Sorted := CurrentBranch_Top; + CurrentBranch_Bottom^.next := TmpNextBranches; + end else begin + { Locate the last item lower than CurrentBranch_Top. } + TmpNextBranches := Sorted; + youshouldstop := false; + repeat + TmpBranch_Top := TmpNextBranches; + TmpBranch_Bottom := TmpBranch_Top; + while (NIL <> TmpBranch_Bottom^.next) and (#$0 = TmpBranch_Bottom^.next^.msg[1]) do begin + TmpBranch_Bottom := TmpBranch_Bottom^.next; + end; + TmpNextBranches := TmpBranch_Bottom^.next; + + if TmpNextBranches = NIL then + youshouldstop := true + else if CurrentBranch_Top^.msg < TmpNextBranches^.msg then begin + youshouldstop := true; + end; + until youshouldstop; + CurrentBranch_Bottom^.next := TmpNextBranches; + TmpBranch_Bottom^.next := CurrentBranch_Top; + end; + end; + RPM^.firstitem := Sorted; +end; +{$ENDIF PATCH_CHEAT} + +{$IFDEF PATCH_GH} +Function SetItemByValue( RPM: RPGMenuPtr ; V: LongInt ): RPGMenuItemPtr; +{$ELSE PATCH_GH} Function SetItemByValue( RPM: RPGMenuPtr ; V: Integer ): RPGMenuItemPtr; +{$ENDIF PATCH_GH} { Search through the list, and set the SelectItem } { field to the first menu item which matches V. } var @@ -694,6 +1582,24 @@ Procedure SetItemByPosition( RPM: RPGMen begin if RPM = Nil then exit; +{$IFDEF PATCH_GH} + if RPM^.NumItem < N then begin + RPM^.SelectItem := RPM^.NumItem; + end else if N < 1 then begin + RPM^.SelectItem := 1; + end else begin + RPM^.SelectItem := N; + end; + if RPM^.NumItem < RPM^.TopItem then begin + RPM^.TopItem := RPM^.NumItem; + end else if RPM^.TopItem < 1 then begin + RPM^.TopItem := 1; + end; + if (RPM^.SelectItem < RPM^.TopItem) or ((RPM^.SelectItem - RPM^.TopItem + 1) > MenuHeight( RPM ) ) then begin + {Determine an appropriate new value for topitem.} + RPMReposition(RPM,True); + end; +{$ELSE PATCH_GH} if N <= RPM^.NumItem then begin RPM^.SelectItem := N; @@ -702,25 +1608,53 @@ begin RPMReposition(RPM,True); end; end; +{$ENDIF PATCH_GH} end; +{$IFDEF PATCH_GH} +Function BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String; N: Integer ): Integer; + { Do a DosSearch for files matching SearchPattern, then add } + { each of the files found to the menu. } +var + F: SearchRec; +{$ELSE PATCH_GH} Procedure BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String ); { Do a DosSearch for files matching SearchPattern, then add } { each of the files found to the menu. } var F: SearchRec; N: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} N := 1; +{$ENDIF PATCH_GH} FindFirst( SearchPattern , AnyFile , F ); While DosError = 0 do begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , TextDecode(F.Name) , N ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , F.Name , N ); +{$ENDIF PATCH_I18N} Inc(N); FindNext( F ); end; + +{$IFDEF PATCH_GH} + FindClose( F ); + BuildFileMenu := N; +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} end; +{$IFDEF PATCH_GH} +Function BuildFileMenu( RPM: RPGMenuPtr; const SearchPattern: String ): Integer; +begin + BuildFileMenu := BuildFileMenu( RPM , SearchPattern , 1 ); +end; +{$ENDIF PATCH_GH} Function SelectFile( RPM: RPGMenuPtr; ReDrawer: RedrawProcedureType ): String; { RPM is a menu created by the BuildFileMenu procedure. } @@ -729,7 +1663,16 @@ Function SelectFile( RPM: RPGMenuPtr; Re var N: Integer; { The number of the file selected. } Name: String; { The name of the filename selected. } -begin +{$IFDEF PATCH_CHEAT} + P: Integer; +{$ENDIF PATCH_CHEAT} +begin +{$IFDEF PATCH_CHEAT} + if Cheat_Restore_AddMenuKey and (Pos(' ',RPM^.FirstItem^.msg) < 1) then begin + AlphaKeyMenu( RPM ); + end; +{$ENDIF PATCH_CHEAT} + { Do the menu selection first. } N := SelectMenu( RPM , ReDrawer ); @@ -738,13 +1681,37 @@ begin Name := ''; end else begin { Locate the selected element of the menu. } +{$IFDEF PATCH_CHEAT} + Name := SetItemByValue( RPM, N )^.msg; + if Cheat_Restore_AddMenuKey then begin + P := Pos(' ',Name) + 1; + Name := Copy( Name, P, Length(Name)-P+1 ); + end; +{$ELSE PATCH_CHEAT} Name := RPMLocateByPosition(RPM,RPM^.SelectItem)^.msg; +{$ENDIF PATCH_CHEAT} end; SelectFile := Name; end; -end. +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: sdlmenus.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + IsMenuActive := False; +{$ENDIF PATCH_GH} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: sdlmenus.pp(finalization)'); +{$ENDIF DEBUG} +end; +end. diff -x .svn -uprN GearHead1100repository.original/services.pp branches/services.pp --- GearHead1100repository.original/services.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/services.pp 2016-01-09 09:01:00.000000000 +0900 @@ -25,7 +25,11 @@ unit services; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; procedure PurchaseGear( GB: GameBoardPtr; PC,NPC,Part: GearPtr ); Procedure OpenShop( GB: GameBoardPtr; PC,NPC: GearPtr; Stuff: String ); @@ -35,15 +39,42 @@ Procedure ExpressDelivery( GB: GameBoard implementation -{$IFDEF SDLMODE} -uses ability,arenacfe,backpack,damage,gearutil,ghchars,ghmodule,ghparser, - ghswag,ghweapon,interact,menugear,rpgdice,skilluse,texutil,sdlgfx, - sdlinfo,sdlmap,sdlmenus,ui4gh; -{$ELSE} -uses ability,arenacfe,backpack,damage,gearutil,ghchars,ghmodule,ghparser, - ghswag,ghweapon,interact,menugear,rpgdice,skilluse,texutil,congfx, - coninfo,conmap,conmenus,context,ui4gh; -{$ENDIF} +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + ui4gh, + ability,arenacfe,backpack,damage,gearutil,ghchars,ghmodule,ghparser, + ghswag,ghweapon,interact,menugear,rpgdice,skilluse,texutil, + {$IFDEF SDLMODE} + sdlgfx,sdlinfo,sdlmap,sdlmenus + {$ELSE SDLMODE} + congfx,coninfo,conmap,conmenus,context + {$ENDIF SDLMODE} +{$ELSE PATCH_GH} + ability,arenacfe,backpack,damage,gearutil,ghchars,ghmodule,ghparser, + ghswag,ghweapon,interact,menugear,rpgdice,skilluse,texutil, + {$IFDEF SDLMODE} + sdlgfx,sdlinfo,sdlmap,sdlmenus, + {$ELSE} + congfx,coninfo,conmap,conmenus,context, + {$ENDIF} + ui4gh +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + ,pcaction +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH_PARANOID_SAFER} + ,rnd +{$ENDIF PATCH_GH_PARANOID_SAFER} + ; Const CredsPerDP = 1; { Cost to repair 1DP of damage. } @@ -53,6 +84,11 @@ Const var SERV_GB: GameBoardPtr; SERV_PC,SERV_NPC,SERV_Info: GearPtr; + {$IFDEF PATCH_GH} + SERV_Menu: RPGMenuPtr; + SERV_MenuLGBN: GearPtr; + SERV_MenuRGS: GearPtr; + {$ENDIF PATCH_GH} {$ENDIF} Function ScalePrice( PC,NPC: GearPtr; Price: Int64 ): LongInt; @@ -60,6 +96,10 @@ Function ScalePrice( PC,NPC: GearPtr; Pr var ShopRk,ShopTr,R: Integer; { ShopRank and ShopTarget } begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit(Price); +{$ENDIF PATCH_GH} + { Determine the Shopping skill rank of the buyer. } ShopRk := SkillValue( PC , 21 ); @@ -87,7 +127,11 @@ begin ShopRk := ( ShopRk - ShopTr ) * 2; if ShopRk > 50 then ShopRk := 50; +{$IFDEF PATCH_GH} + Price := ( Int64(Price) * Int64(100 - ShopRk) ) div 100; +{$ELSE PATCH_GH} Price := ( Price * (100 - ShopRk ) ) div 100; +{$ENDIF PATCH_GH} end; if Price < 1 then Price := 1; @@ -108,6 +152,10 @@ Procedure ShoppingXP( PC , Part: GearPtr var Price: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { Find the price of the gear. This must be positive or it'll } { crash the logarithm function. } Price := GearValue( Part ); @@ -120,18 +168,59 @@ end; {$IFDEF SDLMODE} Procedure ServiceRedraw; { Redraw the screen for whatever service is going to go on. } + {$IFDEF PATCH_GH} +var + Mek: GearPtr; + MekNum: LongInt; + {$ENDIF PATCH_GH} begin + {$IFDEF PATCH_GH} + if (NIL = SERV_NPC) or (SERV_NPC^.G <= GG_DisposeGear) then exit; + if (NIL = SERV_PC) or (SERV_PC^.G <= GG_DisposeGear) then exit; + {$ENDIF PATCH_GH} QuickCombatDisplay( SERV_GB ); SetupInteractDisplay( TeamColor( SERV_GB , SERV_NPC ) ); DisplayInteractStatus( SERV_GB , SERV_NPC , CHAT_React , CHAT_Endurance ); + {$IFDEF PATCH_GH} + if (NIL <> SERV_Menu) then begin + Mek := NIL; + MekNum := RPMLocateByPosition(SERV_Menu,SERV_Menu^.selectitem)^.value; + if (0 <= MekNum) then begin + if (NIL <> SERV_MenuLGBN) then begin + {$IFDEF DEBUG} + Mek := LocateGearByNumber( SERV_MenuLGBN, MekNum, False, 0, '' ); + {$ELSE DEBUG} + Mek := LocateGearByNumber( SERV_MenuLGBN, MekNum ); + {$ENDIF DEBUG} + end else if (NIL <> SERV_MenuRGS) then begin + Mek := RetrieveGearSib( SERV_MenuRGS, MekNum ); + end; + end; + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin + DisplayGearInfo( Mek, SERV_GB ); + end; + end else if (NIL <> SERV_Info) and (GG_DisposeGear < SERV_Info^.G) then begin + DisplayGearInfo( SERV_Info , SERV_GB ); + {$IFDEF PATCH_I18N} + NFCMessage( FormatDescString(SERV_Info), ZONE_Menu, MenuItem ); + {$ELSE PATCH_I18N} + NFCMessage( SAttValue( SERV_Info^.SA , 'DESC' ) , ZONE_Menu , MenuItem ); + {$ENDIF PATCH_I18N} + end; + {$ELSE PATCH_GH} if SERV_Info <> Nil then begin DisplayGearInfo( SERV_Info , SERV_GB ); + {$IFDEF PATCH_I18N} + NFCMessage( FormatDescString(SERV_Info), ZONE_Menu, MenuItem ); + {$ELSE PATCH_I18N} NFCMessage( SAttValue( SERV_Info^.SA , 'DESC' ) , ZONE_Menu , MenuItem ); + {$ENDIF PATCH_I18N} end; + {$ENDIF PATCH_GH} NFCMessage( '$' + BStr( NAttValue( SERV_PC^.NA , NAG_Experience , NAS_Credits ) ) , ZONE_Clock , InfoHilight ); NFGameMsg( CHAT_Message , ZONE_InteractMsg , InfoHiLight ); end; -{$ENDIF} + {$ENDIF} procedure PurchaseGear( GB: GameBoardPtr; PC,NPC,Part: GearPtr ); { The unit may or may not want to buy PART. } @@ -143,9 +232,31 @@ var N: Integer; msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + Cost := PurchasePrice( PC , NPC , Part ); YNMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( YNMenu , ReplaceHash( I18N_MsgString('PurchaseGear','Buy It'), GearName(Part), BStr(Cost) ) , 1 ); + if ( Part^.G = GG_Mecha ) then begin + AddRPGMenuItem( YNMenu , I18N_MsgString('PurchaseGear','View Tech Stats') , 3 ); +{$IFDEF PATCH_CHEAT} + if 0 < SAttValueToInt(Part^.SA,SATT_TRANSFORMABLE) then begin + AddRPGMenuItem( YNMenu , ReplaceHash( I18N_MsgString('BACKPACK','Transformation'), GearName(Part) ) , 4 ); + end; +{$ENDIF PATCH_CHEAT} + end; + if ( Part^.SubCom <> Nil ) or ( Part^.InvCom <> Nil ) then begin + AddRPGMenuItem( YNMenu , MsgString( 'SERVICES_BrowseParts' ) , 2 ); + end; + AddRPGMenuItem( YNMenu , I18N_MsgString('PurchaseGear','Search Again') , -1 ); + msg := ReplaceHash( I18N_MsgString('PurchaseGear','BuyPROMPT' + Bstr( Random(4) +1 ) ), GearName(Part), BStr(Cost) ); +{$ELSE PATCH_I18N} AddRPGMenuItem( YNMenu , 'Buy ' + GearName( Part ) + ' ($' + BStr( Cost ) + ')' , 1 ); if ( Part^.G = GG_Mecha ) then AddRPGMenuItem( YNMenu , 'View Tech Stats' , 3 ); if ( Part^.SubCom <> Nil ) or ( Part^.InvCom <> Nil ) then AddRPGMenuItem( YNMenu , MsgString( 'SERVICES_BrowseParts' ) , 2 ); @@ -154,6 +265,7 @@ begin msg := MSgString( 'BuyPROMPT' + Bstr( Random( 4 ) + 1 ) ); msg := ReplaceHash( msg , GearName( Part ) ); msg := ReplaceHash( msg , BStr( Cost ) ); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} CHAT_Message := Msg; @@ -186,13 +298,21 @@ begin {$ELSE} GameMsg( MsgString( 'BUYREPLY' + BStr( Random( 4 ) + 1 ) ) , ZONE_InteractMsg , InfoHilight ); {$ENDIF} +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('PurchaseGear','Purchased'), GearName(Part) ) ); +{$ELSE PATCH_I18N} DialogMSG( 'You have purchased ' + GearName( Part ) + '.' ); +{$ENDIF PATCH_I18N} { Give some XP to the PC's SHOPPING skill. } ShoppingXP( PC , Part ); end else begin { Not enough cash to buy... } +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('PurchaseGear','Not enough money'), GearName(Part) ) ); +{$ELSE PATCH_I18N} DialogMSG( 'You don''t have enough money to buy ' + GearName( Part ) + '.' ); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} CHAT_Message := MsgString( 'BUYNOCASH' + BStr( Random( 4 ) + 1 ) ); {$ELSE} @@ -213,6 +333,11 @@ begin EndOfGameMoreKey; {$ENDIF} N := 2; +{$IFDEF PATCH_CHEAT} + end else if 4 = N then begin + UserTransformation( GB , Part , True ); + N := 2; +{$ENDIF PATCH_CHEAT} end else if N = -1 then begin {$IFDEF SDLMODE} CHAT_Message := MsgString( 'BUYCANCEL' + BStr( Random( 4 ) + 1 ) ); @@ -225,18 +350,35 @@ begin DisposeRPGMenu( YNMenu ); end; +{$IFDEF PATCH_GH} +Function SellGear( var LList,Part: GearPtr; PC,NPC: GearPtr; AlwaysYes: Boolean ): Boolean; +{$ELSE PATCH_GH} Function SellGear( var LList,Part: GearPtr; PC,NPC: GearPtr ): Boolean; +{$ENDIF PATCH_GH} { The unit may or may not want to sell PART. } { Show the price of this gear, and ask whether or not the } { player wants to make this sale. } +{$IFDEF PATCH_GH} +const + V_MAX = 2147483647; +{$ENDIF PATCH_GH} var YNMenu: RPGMenuPtr; Cost: Int64; +{$IFDEF PATCH_CHEAT} + Cost_Limit: Int64; +{$ENDIF PATCH_CHEAT} R,ShopRk,ShopTr: Integer; N: Integer; WasStolen: Boolean; msg: String; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit(False); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit(False); + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit(False); +{$ENDIF PATCH_GH} + { First - check to see whether or not the item is stolen. } { Most shopkeepers won't buy stolen goods. The PC has to locate } { a fence for illicit transactions. } @@ -296,24 +438,94 @@ begin else if ShopRk < 0 then ShopRk := 0; Cost := ( Cost * (20 + ShopRk ) ) div 100; +{$IFDEF PATCH_GH} + if (V_MAX < Cost) then begin + Cost := V_MAX; + end else if (Cost < 1) then begin + Cost := 1; + end; +{$ELSE PATCH_GH} if Cost < 1 then Cost := 1; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + if Cheat_Enable_Limit_SellingPrice then begin + Cost_Limit := PurchasePrice( PC , NPC , Part ); + if (Cost_Limit <= Cost) then begin + Cost := Cost_Limit - 1; + end; + end; +{$ENDIF PATCH_CHEAT} YNMenu := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); +{$IFDEF PATCH_GH} + if CheckAlongPath_DisallowSelling( Part ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( YNMenu , I18N_MsgString( 'SellGear', 'YouCannotSellIt' ) , -1 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( YNMenu , 'You Cannot Sell It.' , -1 ); +{$ENDIF PATCH_I18N} + end else if ( IsMasterGear( Part ) and ( 0 < Length( SAttValue( Part^.SA , 'PILOT' ) ) ) ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( YNMenu , I18N_MsgString( 'SellGear', 'ItHasAPilotAssigned' ) , -1 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( YNMenu , 'It has a pilot assigned.' , -1 ); +{$ENDIF PATCH_I18N} + end else begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( YNMenu , ReplaceHash( I18N_MsgString('SellGear','Sell it'), GearName(Part), BStr(Cost) ) , 1 ); +{$ELSE PATCH_I18N} + AddRPGMenuItem( YNMenu , 'Sell ' + GearName( Part ) + ' ($' + BStr( Cost ) + ')' , 1 ); +{$ENDIF PATCH_I18N} + end; +{$ELSE PATCH_GH} AddRPGMenuItem( YNMenu , 'Sell ' + GearName( Part ) + ' ($' + BStr( Cost ) + ')' , 1 ); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + AddRPGMenuItem( YNMenu , I18N_MsgString('SellGear','Maybe later') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( YNMenu , 'Maybe later' , -1 ); +{$ENDIF PATCH_I18N} { Query the menu - Sell it or not? } +{$IFDEF PATCH_I18N} + msg := ReplaceHash( I18N_MsgString('SellGear','SELLPROMPT' + Bstr( Random(4) +1 ) ), GearName(Part), BStr(Cost) ); +{$ELSE PATCH_I18N} msg := MSgString( 'SELLPROMPT' + Bstr( Random( 4 ) + 1 ) ); msg := ReplaceHash( msg , BStr( Cost ) ); msg := ReplaceHash( msg , GearName( Part ) ); +{$ENDIF PATCH_I18N} {$IFDEF SDLMODE} SERV_Info := Part; CHAT_Message := Msg; +{$IFDEF PATCH_GH} + if AlwaysYes then begin + if CheckAlongPath_DisallowSelling( Part ) then begin + N := -1; + end else begin + N := 1; + end; + end else begin + N := SelectMenu( YNMenu , @ServiceRedraw ); + end; +{$ELSE PATCH_GH} N := SelectMenu( YNMenu , @ServiceRedraw ); +{$ENDIF PATCH_GH} SERV_Info := Pc; {$ELSE} GameMsg( msg , ZONE_InteractMsg , InfoHilight ); +{$IFDEF PATCH_GH} + if AlwaysYes then begin + if CheckAlongPath_DisallowSelling( Part ) then begin + N := -1; + end else begin + N := 1; + end; + end else begin + N := SelectMenu( YNMenu ); + end; +{$ELSE PATCH_GH} N := SelectMenu( YNMenu ); +{$ENDIF PATCH_GH} {$ENDIF} if N = 1 then begin { Increase the buyer's cash by the price of the gear. } @@ -324,7 +536,11 @@ begin {$ELSE} GameMsg( MSgString( 'SELLREPLY' + Bstr( Random( 4 ) + 1 ) ) , ZONE_InteractMsg , InfoHilight ); {$ENDIF} +{$IFDEF PATCH_I18N} + DialogMSG( ReplaceHash( I18N_MsgString('SellGear','Sold'), GearName(Part), BStr(Cost) ) ); +{$ELSE PATCH_I18N} DialogMSG( 'You have sold ' + GearName( Part ) + ' for $' + BStr( Cost ) + '.' ); +{$ENDIF PATCH_I18N} { Give some XP to the PC's SHOPPING skill. } ShoppingXP( PC , Part ); @@ -353,10 +569,26 @@ end; Function RepairMasterCost( Master: GearPtr; Skill: Integer ): LongInt; { Return the expected cost of repairing every component of } { MASTER which can be handled using SKILL. } +{$IFDEF PATCH_GH} +const + it_MAX = 2147483647; +{$ENDIF PATCH_GH} var +{$IFDEF PATCH_GH} + it: Int64; +{$ELSE PATCH_GH} it: LongInt; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_GH} + it := Int64(TotalRepairableDamage(Master, SKill)) * Int64(CredsPerDP); +{$ELSE PATCH_GH} it := TotalRepairableDamage( Master , SKill ) * CredsPerDP; +{$ENDIF PATCH_GH} { Since parts that could be helped by First Aid heal by themselves } { usually, the cost to treat injuries using the First Aid skill is } @@ -366,6 +598,13 @@ begin if it < 1 then it := 1; end; +{$IFDEF PATCH_GH} + if it < 0 then begin + it := 0; + end else if it_MAX < it then begin + it := it_MAX; + end; +{$ENDIF PATCH_GH} RepairMasterCost := it; end; @@ -382,6 +621,9 @@ begin { Browse through each gear on the board, adding the cost to repair } { each Team 1 mek or character. } while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( Part^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) or ( NAttValue( Part^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) then begin { Only repair mecha which have pilots assigned!!! } { If the PC had to patch up all that salvage every time... Brr... } @@ -389,6 +631,9 @@ begin Cost := Cost + RepairMasterCost( Part , Skill ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; @@ -402,6 +647,11 @@ Procedure DoRepairMaster( GB: GameBoardP var TRD: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Master) or (Master^.G <= GG_DisposeGear) then exit; + if (NIL = Repairer) or (Repairer^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { Repair this part, if appropriate. } TRD := TotalRepairableDamage( Master , SKill ); ApplyRepairPoints( Master , Skill , TRD ); @@ -416,12 +666,19 @@ Procedure DoRepairAll( GB: GameBoardPtr; var Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { Initialize values. } Part := GB^.Meks; { Browse through each gear on the board, repairing } { each Team 1 mek or character. } while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( NAttValue( Part^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) or ( NAttValue( Part^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) then begin { Only repair mecha which have pilots assigned!!! } { If the PC had to patch up all that salvage every time... Brr... } @@ -429,6 +686,9 @@ begin DoRepairMaster( GB , Part , NPC , Skill ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; @@ -445,6 +705,11 @@ var Cost,Cash: LongInt; R: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { Determine the cost of repairing everything, and also } { the amount of cash the PC has. } Cost := ScalePrice( PC , NPC , RepairAllCost( GB , Skill ) ); @@ -489,6 +754,12 @@ var Cost,Cash: LongInt; R: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; + if (NIL = Part) or (Part^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { Determine the cost of repairing everything, and also } { the amount of cash the PC has. } Cost := ScalePrice( PC , NPC , RepairMasterCost( PArt , Skill ) ); @@ -526,6 +797,10 @@ var Spent: Integer; it: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = Mag) or (Mag^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} + it := 0; if Mag^.G = GG_Ammo then begin Spent := NAttValue( Mag^.NA , NAG_WeaponModifier , NAS_AmmoSpent ); @@ -543,6 +818,10 @@ var Part: GearPtr; it: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} + it := ReloadMagazineCost( M ); Part := M^.SubCom; @@ -565,6 +844,10 @@ Procedure DoReloadMaster( M: GearPtr ); var Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = M) or (M^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + { If this is an ammunition gear, set the number of shots fired to 0. } if M^.G = GG_Ammo then SetNAtt( M^.NA , NAG_WeaponModifier , NAS_AmmoSpent , 0 ); @@ -587,12 +870,23 @@ var it: LongInt; Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit(0); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} + it := 0; Part := GB^.Meks; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( ( NATtVAlue( Part^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) or ( NAttValue( Part^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) ) and ( Part^.G = GG_Character ) then begin it := it + ReloadMasterCost( Part ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; @@ -608,15 +902,29 @@ var COst: LongInt; Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + Cost := ReloadCharsCost( GB , PC , NPC ); if Cost <= NAttValue( PC^.NA , NAG_Experience , NAS_Credits ) then begin Part := GB^.Meks; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( ( NATtVAlue( Part^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) or ( NAttValue( Part^.NA , NAG_Location , NAS_Team ) = NAV_LancemateTeam ) ) and ( Part^.G = GG_Character ) then begin DoReloadMaster( Part ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; +{$IFDEF PATCH_GH} + AddNAtt( PC^.NA, NAG_Experience , NAS_Credits , -Cost ); +{$ENDIF PATCH_GH} { Print the message. } {$IFDEF SDLMODE} @@ -640,12 +948,23 @@ var it: LongInt; Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit(0); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} + it := 0; Part := GB^.Meks; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( NATtVAlue( Part^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and ( Part^.G = GG_Mecha ) then begin it := it + ReloadMasterCost( Part ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; @@ -661,15 +980,29 @@ var COst: LongInt; Part: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + Cost := ReloadMechaCost( GB , PC , NPC ); if Cost <= NAttValue( PC^.NA , NAG_Experience , NAS_Credits ) then begin Part := GB^.Meks; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if ( NATtVAlue( Part^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and ( Part^.G = GG_Mecha ) then begin DoReloadMaster( Part ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; +{$IFDEF PATCH_GH} + AddNAtt( PC^.NA, NAG_Experience , NAS_Credits , -Cost ); +{$ENDIF PATCH_GH} { Print the message. } {$IFDEF SDLMODE} @@ -697,6 +1030,11 @@ var N: Integer; Cost: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = I) or (I^.G <= GG_DisposeGear) then exit(True); + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit(True); +{$ENDIF PATCH_GH} + { Begin by assuming TRUE. } NGW := True; @@ -724,7 +1062,7 @@ begin Cost := Cost div 2; end; - if RollStep( SkillValue( NPC , 21 ) ) < N then NGW := True; + if RollStepRndx( SkillValue( NPC , 21 ) ) < N then NGW := True; end; @@ -738,10 +1076,18 @@ var A,A2: GearPtr; begin while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} { Spare magazines shouldn't be as common as the weapons } { themselves, so only add ammo for this weapon on a } { random chance. } - if ( Part^.G = GG_Weapon ) and ( Random( 3 ) = 1 ) then begin +{$IFDEF PATCH_GH_PARANOID_SAFER} + if ( Part^.G = GG_Weapon ) and ( 1 = rndx( 3 ) ) then +{$ELSE PATCH_GH_PARANOID_SAFER} + if ( Part^.G = GG_Weapon ) and ( Random( 3 ) = 1 ) then +{$ENDIF PATCH_GH_PARANOID_SAFER} + begin if ( Part^.S = GS_Ballistic ) or ( Part^.S = GS_Missile ) then begin A := Part^.SubCom; while A <> nil do begin @@ -760,6 +1106,9 @@ begin AddAmmo( Wares , Part^.SubCom ); AddAmmo( Wares , Part^.InvCom ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; @@ -777,13 +1126,20 @@ begin { From the list of filenames, pick a number of them at random. } N := 20; while ( N > 0 ) and ( ShopList <> Nil ) do begin +{$IFDEF PATCH_GH_PARANOID_SAFER} + MekFile := SelectRndxSAtt( ShopList ); +{$ELSE PATCH_GH_PARANOID_SAFER} MekFile := SelectRandomSAtt( ShopList ); +{$ENDIF PATCH_GH_PARANOID_SAFER} { Load this file } Mek := LoadSingleMecha( MekFile^.Info , Design_Directory ); { Remove this SAtt from the list, so we don't load it twice. } RemoveSAtt( ShopList , MekFile ); +{$IFDEF PATCH_GH} + PurgeSAtt( ShopList ); +{$ENDIF PATCH_GH} { Attach the loaded mek to the end of WARES. } if ( Mek <> Nil ) and ( Mek^.G = GG_Mecha ) then begin @@ -808,17 +1164,32 @@ begin { wares afterwards. } Assign( F , Mek_Equipment_File ); Reset( F ); +{$IFDEF PATCH_GH} + MEX := ReadGear( F, Mek_Equipment_File ); +{$ELSE PATCH_GH} MEX := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); T := MEX; while T <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < T^.G) then begin +{$ENDIF PATCH_GH} { On a random chance, add this item to the wares list. } - if Random( 7 ) = 1 then begin +{$IFDEF PATCH_GH_PARANOID_SAFER} + if ( 1 = rndx( 7 ) ) then +{$ELSE PATCH_GH_PARANOID_SAFER} + if Random( 7 ) = 1 then +{$ENDIF PATCH_GH_PARANOID_SAFER} + begin Item := CloneGear( T ); Item^.Next := Wares; Wares := Item; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} T := T^.Next; end; @@ -834,7 +1205,22 @@ var F: Text; NPCSeed,NPCRestock: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit(NIL); +{$ENDIF PATCH_GH} + { Set the random seed to something less than random... } +{$IFDEF PATCH_GH_PARANOID_SAFER} + NPCSeed := NAttValue( NPC^.NA , NAG_PErsonal , NAS_RandSeed ); + NPCRestock := NAttValue( NPC^.NA , NAG_PErsonal , NAS_RestockTime ); + if ( 0 = NPCSeed ) and ( 0 = NPCRestock ) then begin + NPCSeed := Random( Int64($80000000) ); + NPCRestock := Random( 86400 ) + 1; + SetNAtt( NPC^.NA , NAG_PErsonal , NAS_RandSeed , NPCSeed ); + SetNAtt( NPC^.NA , NAG_PErsonal , NAS_RestockTime , NPCRestock ); + end; + set_rndx( ( ( ( Int64(GB^.ComTime) + Int64(NPCRestock) ) div Int64(86400) ) + Int64(NPCSeed) ) mod Int64($80000000) ); +{$ELSE PATCH_GH_PARANOID_SAFER} NPCSeed := NAttValue( NPC^.NA , NAG_PErsonal , NAS_RandSeed ); NPCRestock := NAttValue( NPC^.NA , NAG_PErsonal , NAS_RestockTime ); if NPCSeed = 0 then begin @@ -844,12 +1230,17 @@ begin SetNAtt( NPC^.NA , NAG_PErsonal , NAS_RestockTime , NPCRestock ); end; RandSeed := ( ( GB^.ComTime + NPCRestock ) div 86400 ) + NPCSeed; +{$ENDIF PATCH_GH_PARANOID_SAFER} { Read the basic items list, then filter it for appropriate } { wares afterwards. } Assign( F , PC_Equipment_File ); Reset( F ); +{$IFDEF PATCH_GH} + Wares := ReadGear( F, PC_Equipment_File ); +{$ELSE PATCH_GH} Wares := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); { Pass Two - Add extra ammo clips for all projectile and } @@ -882,12 +1273,19 @@ begin { If N is too large for this shopkeeper, remove a number of items } { from the inventory. } while NumSiblingGears( Wares ) > MaxShopItems do begin +{$IFDEF PATCH_GH_PARANOID_SAFER} + I := SelectRndxGear( Wares ); +{$ELSE PATCH_GH_PARANOID_SAFER} I := SelectRandomGear( Wares ); +{$ENDIF PATCH_GH_PARANOID_SAFER} RemoveGear( Wares , I ); end; { Re-randomize the random seed. } +{$IFDEF PATCH_GH_PARANOID_SAFER} +{$ELSE PATCH_GH_PARANOID_SAFER} Randomize; +{$ENDIF PATCH_GH_PARANOID_SAFER} { Return the list we've created. } CreateWaresList := Wares; @@ -897,12 +1295,67 @@ Procedure BrowseWares( GB: GameBoardPtr; { Take a look through the items this NPC has for sale. } { First, construct the shop list. Then, browse each item, } { potentially buying whichever one strikes your fancy. } +{$IFDEF PATCH_CHEAT} +const + InvStr = '+'; + SubStr = '>'; +{$ENDIF PATCH_CHEAT} var RPM: RPGMenuPtr; { Buying menu. } I: GearPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} msg: String; +{$IFDEF PATCH_CHEAT} + Function IMString( P: GearPtr ): String; + { Given part P, return a string to use in the menu. } + var + msg: String; + ShotsUsed: Integer; + begin + msg := FullGearName( P ); + + { Add extra information, depending upon item type. } + if P^.G = GG_Weapon then begin + msg := msg + ' (DC:' + BStr( ScaleDC( P^.V , P^.Scale ) ) + ')'; + end else if ( P^.G = GG_ExArmor ) or ( P^.G = GG_Shield ) then begin + msg := msg + ' [AC:' + BStr( GearMaxArmor( P ) ) + ']'; + end else if P^.G = GG_Ammo then begin + ShotsUsed := NAttValue( P^.NA , NAG_WeaponModifier , NAS_AmmoSpent ); + msg := msg + ' (' + BStr( P^.STat[ STAT_AmmoPresent ] - ShotsUSed ) + '/' + BStr( P^.Stat[ STAT_AmmoPresent ] ) + 'a)'; + end else if P^.G = GG_Consumable then begin + msg := msg + ' (' + BStr( P^.STat[ STAT_FoodQuantity ] ) + ')'; + end; + + IMString := Msg; + end; + Procedure CheckAlongPath( Part: GearPtr; TabPos,Prefix: String ); + begin + while NIL <> Part do begin + if GG_DisposeGear < Part^.G then begin + {$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM, #$0 + TabPos + Prefix + IMString(Part), -2, FormatDescString(Part) ); + {$ELSE PATCH_I18N} + AddRPGMenuItem( RPM, #$0 + TabPos + Prefix + IMString(Part), -2, SAttValue(Part^.SA, 'DESC') ); + {$ENDIF PATCH_I18N} + if (GG_Mecha <> Part^.G) or Cheat_BuyStuff_Mecha_ShowSubItem then begin + CheckAlongPath( Part^.InvCom, TabPos + ' ', InvStr ); + CheckAlongPath( Part^.SubCom, TabPos + ' ', SubStr ); + end; + end; + Part := Part^.Next; + end; + end; +{$ENDIF PATCH_CHEAT} begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; + { Don't kick out the GG_DisposeGear of Wares at here. } +{$ENDIF PATCH_GH} { Create the browsing menu. } RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); @@ -910,9 +1363,15 @@ begin I := Wares; N := 1; while I <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < I^.G) then begin +{$ENDIF PATCH_GH} msg := FullGearName( I ); { Add extra information, depending upon item type. } +{$IFDEF PATCH_CHEAT} + msg := IMString(I); +{$ELSE PATCH_CHEAT} if I^.G = GG_Weapon then begin msg := msg + ' (DC:' + BStr( ScaleDC( I^.V , I^.Scale ) ) + ')'; end else if ( I^.G = GG_ExArmor ) or ( I^.G = GG_Shield ) then begin @@ -920,6 +1379,7 @@ begin end else if I^.G = GG_Consumable then begin msg := msg + ' (' + BStr( I^.Stat[ STAT_FoodQuantity ] ) + ')'; end; +{$ENDIF PATCH_CHEAT} { Add extra information, depending upon item scale. } if ( I^.G <> GG_Mecha ) and ( I^.Scale > 0 ) then begin @@ -930,15 +1390,49 @@ begin {$IFDEF SDLMODE} while TextLength( GAME_FONT , ( msg + ' $' + BStr( PurchasePrice( PC , NPC , I ) ) ) ) < ( ZONE_InteractMenu.W - 50 ) do msg := msg + ' '; {$ELSE} + {$IFDEF PATCH_I18N} + while WidthMBCharStr( msg ) < ( ScreenZone[ ZONE_InteractMenu , 3 ] - ScreenZone[ ZONE_InteractMenu , 1 ] - 12 ) do msg := msg + ' '; + {$ELSE PATCH_I18N} while Length( msg ) < ( ScreenZone[ ZONE_InteractMenu , 3 ] - ScreenZone[ ZONE_InteractMenu , 1 ] - 12 ) do msg := msg + ' '; + {$ENDIF PATCH_I18N} {$ENDIF} { Add it to the menu. } +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , msg + ' $' + BStr( PurchasePrice( PC , NPC , I ) ) , N , FormatDescString(I) ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , msg + ' $' + BStr( PurchasePrice( PC , NPC , I ) ) , N , SAttValue( I^.SA , 'DESC' ) ); +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + if GG_Mecha = I^.G then begin + if Cheat_BuyStuff_Mecha_ShowSubItem then begin + CheckAlongPath( I^.InvCom, ' ', InvStr ); + CheckAlongPath( I^.SubCom, ' ', SubStr ); + end; + end else begin + if Cheat_BuyStuff_ShowSubItem then begin + CheckAlongPath( I^.InvCom, ' ', InvStr ); + CheckAlongPath( I^.SubCom, ' ', SubStr ); + end; + end; +{$ELSE PATCH_CHEAT} +{$ENDIF PATCH_CHEAT} Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} I := I^.Next; end; +{$IFDEF PATCH_CHEAT} + if Cheat_BuyStuff_Sort then begin + RPMSortAlpha_withSubItem( RPM ); + end; + if Cheat_BuyStuff_ShowSubItem or Cheat_BuyStuff_Mecha_ShowSubItem then begin + AlphaKeyMenu( RPM ); + end; +{$ELSE PATCH_CHEAT} RPMSortAlpha( RPM ); +{$ENDIF PATCH_CHEAT} { Error check - if for some reason we are left with a blank } { menu, better leave this procedure. } @@ -954,14 +1448,34 @@ begin {$IFDEF SDLMODE} SERV_Info := PC; + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + SERV_Menu := RPM; + SERV_MenuRGS := Wares; + end; + {$ENDIF PATCH_GH} N := SelectMenu( RPM , @ServiceRedraw ); + {$IFDEF PATCH_GH} + SERV_MenuRGS := NIL; + SERV_Menu := NIL; + {$ENDIF PATCH_GH} {$ELSE} DisplayGearInfo( PC ); CMessage( '$' + BStr( NAttValue( PC^.NA , NAG_Experience , NAS_Credits ) ) , ZONE_Clock , InfoHilight ); N := SelectMenu( RPM ); {$ENDIF} +{$IFDEF PATCH_CHEAT} + if N < -1 then begin + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('BrowseWares','You can not buy only it') ); + {$ELSE PATCH_I18N} + DialogMSG( 'You can not buy only it.' ); + {$ENDIF PATCH_I18N} + end else if 0 <= N then begin +{$ELSE PATCH_CHEAT} if N > 0 then begin +{$ENDIF PATCH_CHEAT} PurchaseGear( GB , PC , NPC , RetrieveGearSib( Wares , N ) ); end; @@ -974,7 +1488,11 @@ Function CreateMechaMenu( GB: GameBoardP { Create a menu listing all the Team1 meks on the board. } var RPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} Mek: GearPtr; msg: String; begin @@ -985,6 +1503,9 @@ begin N := 1; Mek := GB^.Meks; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} { If this gear is a mecha, and it belongs to the PC, } { add it to the menu. } if ( NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam ) and not GearActive( Mek ) then begin @@ -993,6 +1514,9 @@ begin end; Inc( N ); +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; @@ -1008,27 +1532,138 @@ Procedure SellStuff( GB: GameBoardPtr; P { PCChar points to the actual player character. } var RPM: RPGMenuPtr; +{$IFDEF PATCH_CHEAT} + N: LongInt; + top, sel: LongInt; +{$ELSE PATCH_CHEAT} +{$IFDEF PATCH_GH} + MI: Integer; + N: LongInt; +{$ELSE PATCH_GH} MI,N: Integer; +{$ENDIF PATCH_GH} +{$ENDIF PATCH_CHEAT} Part : GearPtr; -begin +{$IFDEF PATCH_GH} + Part_Next: GearPtr; +{$ENDIF PATCH_GH} +{$IFDEF DEBUG} + MaxNum: LongInt; +{$ENDIF DEBUG} +begin +{$IFDEF PATCH_GH} + if (NIL = PCInv) or (PCInv^.G <= GG_DisposeGear) then exit; + if (NIL = PCChar) or (PCChar^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_CHEAT} + top := 0; + sel := 0; +{$ELSE PATCH_CHEAT} MI := 1; +{$ENDIF PATCH_CHEAT} repeat { Create the menu. } RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); RPM^.Mode := RPMNoCleanup; AttachMenuDesc( RPM , ZONE_Menu ); +{$IFDEF PATCH_CHEAT} + {$IFDEF DEBUG} + MaxNum := BuildInventoryMenu( RPM , PCInv , Cheat_SellStuff_ShowSubItem ); + {$ELSE DEBUG} + BuildInventoryMenu( RPM , PCInv , Cheat_SellStuff_ShowSubItem ); + {$ENDIF DEBUG} + if Cheat_SellStuff_Sort then begin + RPMSortAlpha_withSubItem( RPM ); + end; + if Cheat_SellStuff_ShowSubItem then begin + AlphaKeyMenu( RPM ); + end; +{$ELSE PATCH_CHEAT} + {$IFDEF DEBUG} + MaxNum := BuildInventoryMenu( RPM , PCInv ); + {$ELSE DEBUG} BuildInventoryMenu( RPM , PCInv ); + {$ENDIF DEBUG} +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_GH} + if ( 1 < RPM^.NumItem ) then begin + AddRPGMenuItem_Top( RPM , I18N_MsgString( 'SellStuff', 'SellAll' ), -2 ); + end; +{$ENDIF PATCH_GH} AddRPGMenuItem( RPM , MsgString( 'SERVICES_Exit' ) , -1 ); +{$IFDEF PATCH_CHEAT} + if Cheat_SellStuff_KeepPosition and (0 < sel) then begin + RPM^.TopItem := top; + SetItemByPosition( RPM, sel ); + end; +{$ELSE PATCH_CHEAT} SetItemByPosition( RPM , MI ); +{$ENDIF PATCH_CHEAT} { Get a choice from the menu, then record the current item } { number. } {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + SERV_Menu := RPM; + SERV_MenuLGBN := PCInv; + end; + {$ENDIF PATCH_GH} N := SelectMenu( RPM , @ServiceRedraw ); + {$IFDEF PATCH_GH} + SERV_MenuLGBN := NIL; + SERV_Menu := NIL; + {$ENDIF PATCH_GH} {$ELSE} N := SelectMenu( RPM ); {$ENDIF} +{$IFDEF PATCH_CHEAT} + top := RPM^.TopItem; + sel := RPM^.SelectItem; + + { If N is positive, prompt to sell that item. } + if 0 <= N then begin + if ' ' = RPMLocateByPosition( RPM, sel )^.msg[1] then begin + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('SellStuff','You can not sell only it') ); + {$ELSE PATCH_I18N} + DialogMSG( 'You can not sell only it.' ); + {$ENDIF PATCH_I18N} + end else begin + {$IFDEF DEBUG} + Part := LocateGearByNumber( PCInv , N, False, MaxNum, 'SellStuff' ); + {$ELSE DEBUG} + Part := LocateGearByNumber( PCInv , N ); + {$ENDIF DEBUG} +{$IFDEF PATCH_GH} + SellGear( Part^.Parent^.InvCom , Part , PCChar , NPC , False ); +{$ELSE PATCH_GH} + SellGear( Part^.Parent^.InvCom , Part , PCChar , NPC ); +{$ENDIF PATCH_GH} + end; +{$IFDEF PATCH_GH} + end else if ( -2 = N ) then begin + Part := PCInv^.InvCom; + while ( NIL <> Part ) do begin + Part_Next := Part^.Next; + SellGear( Part^.Parent^.InvCom , Part , PCChar , NPC , True ); + Part := Part_Next; + end; +{$ENDIF PATCH_GH} + end else if N < -1 then begin + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('SellStuff','You can not sell only it') ); + {$ELSE PATCH_I18N} + DialogMSG( 'You can not sell only it.' ); + {$ENDIF PATCH_I18N} + end; + + { Dispose of the menu. } + DisposeRPGMenu( RPM ); +{$ELSE PATCH_CHEAT} MI := RPM^.SelectItem; { Dispose of the menu. } @@ -1036,9 +1671,27 @@ begin { If N is positive, prompt to sell that item. } if N > -1 then begin + {$IFDEF DEBUG} + Part := LocateGearByNumber( PCInv , N, False, MaxNum, 'SellStuff' ); + {$ELSE DEBUG} Part := LocateGearByNumber( PCInv , N ); + {$ENDIF DEBUG} +{$IFDEF PATCH_GH} + SellGear( Part^.Parent^.InvCom , Part , PCChar , NPC , False ); +{$ELSE PATCH_GH} SellGear( Part^.Parent^.InvCom , Part , PCChar , NPC ); +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + end else if ( -2 = N ) then begin + Part := PCInv^.InvCom; + while ( NIL <> Part ) do begin + Part_Next := Part^.Next; + SellGear( Part^.Parent^.InvCom , Part , PCChar , NPC , True ); + Part := Part_Next; + end; +{$ENDIF PATCH_GH} end; +{$ENDIF PATCH_CHEAT} until N = -1; end; @@ -1062,9 +1715,20 @@ begin RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); { Add options, depending on the mek. } +{$IFDEF PATCH_I18N} + if not OnTheMap( Mek ) then AddRPGMenuItem( RPM , ReplaceHash( I18N_MsgString('SERVICES','Sell'), GearName(Mek) ) , 1 ); +{$ELSE PATCH_I18N} if not OnTheMap( Mek ) then AddRPGMenuItem( RPM , MsgString( 'SERVICES_Sell' ) + GearName( Mek ) , 1 ); +{$ENDIF PATCH_I18N} if TotalRepairableDamage( Mek , 15 ) > 0 then AddRPGMenuItem( RPM , MsgString( 'SERVICES_OSRSP1' ) + ' [$' + BStr( RepairMasterCost( Mek , 15 ) ) + ']' , 2 ); AddRPGMenuItem( RPM , MsgString( 'SERVICES_SellMekInv' ) , 4 ); +{$IFDEF PATCH_CHEAT} + if (GG_Mecha = Mek^.G) then begin + if (0 < SAttValueToInt(Mek^.SA,SATT_TRANSFORMABLE)) then begin + AddRPGMenuItem( RPM , ReplaceHash( I18N_MsgString('BACKPACK','Transformation'), GearName(Mek) ) , 5 ); + end; + end; +{$ENDIF PATCH_CHEAT} AddRPGMenuItem( RPM , MsgString( 'SERVICES_BrowseParts' ) , 3 ); AddRPGMenuItem( RPM , MsgString( 'SERVICES_Exit' ) , -1 ); @@ -1079,7 +1743,11 @@ begin if N = 1 then begin { Sell the mecha. } +{$IFDEF PATCH_GH} + if SellGear( GB^.Meks , Mek , PC , NPC , False ) then N := -1; +{$ELSE PATCH_GH} if SellGear( GB^.Meks , Mek , PC , NPC ) then N := -1; +{$ENDIF PATCH_GH} end else if N = 2 then begin { Repair the mecha. } @@ -1097,6 +1765,10 @@ begin { Sell items. } SellStuff( GB , Mek , PC , NPC ); +{$IFDEF PATCH_CHEAT} + end else if 5 = N then begin + UserTransformation( GB , Mek , True ); +{$ENDIF PATCH_CHEAT} end; until N = -1; @@ -1107,7 +1779,11 @@ Procedure BrowseMecha( GB: GameBoardPtr; { sell some of them, maybe repair some of them... } var RPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} begin repeat { Create the browsing menu. } @@ -1115,7 +1791,17 @@ begin { Select an item from the menu, then get rid of the menu. } {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + SERV_Menu := RPM; + SERV_MenuRGS := GB^.Meks; + end; + {$ENDIF PATCH_GH} N := SelectMenu( RPM , @ServiceRedraw ); + {$IFDEF PATCH_GH} + SERV_MenuRGS := NIL; + SERV_Menu := NIL; + {$ENDIF PATCH_GH} {$ELSE} N := SelectMenu( RPM ); {$ENDIF} @@ -1152,11 +1838,15 @@ Procedure InstallCyberware( GB: GameBoar SC := Slot^.SubCom; while SC <> Nil do begin SC2 := SC^.Next; - +{$IFDEF PATCH_GH} + if (GG_DisposeGear < SC^.G) then begin +{$ENDIF PATCH_GH} if UpCase( SAttValue( SC^.SA , SAtt_CyberSlot ) ) = CyberSlot then begin RemoveGear( Slot^.SubCom , SC ); end; - +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} SC := SC2; end; end; @@ -1208,8 +1898,18 @@ Procedure InstallCyberware( GB: GameBoar var RPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} Item,Slot: GearPtr; +{$IFDEF PATCH_CHEAT} + ReBrowse: Boolean; +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + MaxNum: LongInt; +{$ENDIF DEBUG} Procedure CreateCyberMenu; { Check through PC's inventory, adding items which bear } @@ -1219,9 +1919,15 @@ var begin Part := LocatePilot( PC )^.InvCom; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if AStringHasBString( SAttValue( Part^.SA , 'TYPE' ) , 'CYBER' ) then begin AddRPGMenuItem( RPM , GearName( Part ) , FindGearIndex( PC , Part ) ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; end; @@ -1290,8 +1996,16 @@ var DialogMsg( ReplaceHash( MsgString( 'SERVICES_Cyber_Confirmation' ) , GearName( Item ) ) ); end; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); CreateCyberMenu; +{$IFDEF DEBUG} + MaxNum := CountGearIndex( PC, False, '' ); +{$ENDIF DEBUG} if RPM^.NumItem > 0 then begin {$IFDEF SDLMODE} @@ -1304,31 +2018,88 @@ begin DisposeRPGMenu( RPM ); if N > 0 then begin +{$IFDEF DEBUG} + Item := LocateGearByNumber( PC , N, False, MaxNum, 'InstallCyberware' ); +{$ELSE DEBUG} Item := LocateGearByNumber( PC , N ); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + if (NIL <> Item) and (GG_DisposeGear < Item^.G) then begin +{$ELSE PATCH_GH} if Item <> Nil then begin +{$ENDIF PATCH_GH} RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); +{$IFDEF PATCH_CHEAT} + BuildSubMenu( RPM , PC , Item , False, Cheat_InstallCyberware_ShowSubItem ); + Slot := Nil; + if 1 = RPM^.NumItem then begin + {$IFDEF DEBUG} + Slot := LocateGearByNumber( PC , RPM^.FirstItem^.Value, False, MaxNum, 'InstallCyberware' ); + {$ELSE DEBUG} + Slot := LocateGearByNumber( PC , RPM^.FirstItem^.Value ); + {$ENDIF DEBUG} + end else if 1 < RPM^.NumItem then begin + repeat + ReBrowse := False; + {$IFDEF SDLMODE} + CHAT_Message := MsgString( 'SERVICES_Cyber_SelectSlot' ); + N := SelectMenu( RPM , @ServiceRedraw ); + {$ELSE SDLMODE} + GameMsg( MsgString( 'SERVICES_Cyber_SelectSlot' ) , ZONE_InteractMsg , InfoHiLight ); + N := SelectMenu( RPM ); + {$ENDIF SDLMODE} + if N < -1 then begin + {$IFDEF PATCH_I18N} + DialogMSG( I18N_MsgString('InstallCyberware','You can not install to it') ); + {$ELSE PATCH_I18N} + DialogMSG( 'You can not install to it.' ); + {$ENDIF PATCH_I18N} + ReBrowse := True; + end else if 0 <= N then begin + {$IFDEF DEBUG} + Slot := LocateGearByNumber( PC , N, False, MaxNum, 'InstallCyberware' ); + {$ELSE DEBUG} + Slot := LocateGearByNumber( PC , N ); + {$ENDIF DEBUG} + end; + until False = ReBrowse; + end; +{$ELSE PATCH_CHEAT} BuildSubMenu( RPM , PC , Item , False ); if RPM^.NumItem = 1 then begin + {$IFDEF DEBUG} + Slot := LocateGearByNumber( PC , RPM^.FirstItem^.Value, False, MaxNum, 'InstallCyberware' ); + {$ELSE DEBUG} Slot := LocateGearByNumber( PC , RPM^.FirstItem^.Value ); + {$ENDIF DEBUG} end else if RPM^.NumItem > 1 then begin -{$IFDEF SDLMODE} + {$IFDEF SDLMODE} CHAT_Message := MsgString( 'SERVICES_Cyber_SelectSlot' ); N := SelectMenu( RPM , @ServiceRedraw ); -{$ELSE} + {$ELSE} GameMsg( MsgString( 'SERVICES_Cyber_SelectSlot' ) , ZONE_InteractMsg , InfoHiLight ); N := SelectMenu( RPM ); -{$ENDIF} + {$ENDIF} if N > 0 then begin + {$IFDEF DEBUG} + Slot := LocateGearByNumber( PC , N, False, MaxNum, 'InstallCyberware' ); + {$ELSE DEBUG} Slot := LocateGearByNumber( PC , N ); + {$ENDIF DEBUG} end else begin Slot := Nil; end; end else begin Slot := Nil; end; +{$ENDIF PATCH_CHEAT} DisposeRPGMenu( RPM ); +{$IFDEF PATCH_GH} + if (NIL <> Slot) and (GG_DisposeGear < Slot^.G) then begin +{$ELSE PATCH_GH} if Slot <> Nil then begin +{$ENDIF PATCH_GH} if WillingToPay then begin PerformInstallation; end else begin @@ -1381,6 +2152,11 @@ var N: Integer; Cost: LongInt; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + {$IFDEF SDLMODE} SERV_GB := GB; SERV_NPC := NPC; @@ -1400,7 +2176,14 @@ begin RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); { Add the basic options. } +{$IFDEF PATCH_GH} + { Don't kick out the GG_DisposeGear of Wares at here. } +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + if Wares <> Nil then AddRPGMenuItem( RPM , I18N_MsgString('OpenShop','Browse Wares') , 0 ); +{$ELSE PATCH_I18N} if Wares <> Nil then AddRPGMenuItem( RPM , 'Browse Wares' , 0 ); +{$ENDIF PATCH_I18N} { Add options for each of the repair skills. } { The repair skills are: } @@ -1438,7 +2221,11 @@ begin AddRPGMenuItem( RPM , MsgString( 'SERVICES_Inventory' ) , -6 ); +{$IFDEF PATCH_I18N} + AddRPGMenuItem( RPM , I18N_MsgString('OpenShop','Exit Shop') , -1 ); +{$ELSE PATCH_I18N} AddRPGMenuItem( RPM , 'Exit Shop' , -1 ); +{$ENDIF PATCH_I18N} { Display the trading stats. } {$IFDEF SDLMODE} @@ -1513,6 +2300,11 @@ var Cash: LongInt; DSLTemp: Boolean; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + {$IFDEF SDLMODE} SERV_GB := GB; SERV_NPC := NPC; @@ -1531,10 +2323,17 @@ begin while Stuff <> '' do begin N := ExtractValue( Stuff ); if ( N >= 1 ) and ( N <= NumSkill ) then begin +{$IFDEF PATCH_I18N} + AddRPGMenuItem( SkillMenu , I18N_Name('SkillMan',SkillMan[ N ].Name) , N ); +{$ELSE PATCH_I18N} AddRPGMenuItem( SkillMenu , SkillMan[ N ].Name , N ); +{$ENDIF PATCH_I18N} end; end; +{$IFDEF PATCH_I18N} +{$ELSE PATCH_I18N} RPMSortAlpha( SkillMenu ); +{$ENDIF PATCH_I18N} AddRPGMenuItem( SkillMenu , MsgString( 'SCHOOL_Exit' ) , -1 ); repeat @@ -1630,20 +2429,36 @@ begin if GB^.Scene = Nil then Exit; Adv := FindRoot( GB^.Scene ); +{$IFDEF PATCH_GH} + if (NIL = Adv) or (Adv^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} Scene := Adv^.SubCom; + while Scene <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Scene^.G) then begin +{$ENDIF PATCH_GH} { If this isn't the current scene, search it for bits. } if Scene <> GB^.Scene then begin Mek := Scene^.InvCom; while Mek <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Mek^.G) then begin +{$ENDIF PATCH_GH} if NAttValue( Mek^.NA , NAG_Location , NAS_Team ) = NAV_DefPlayerTeam then begin AddRPGMenuItem( RPM , FullGearName( Mek ) + ' (' + GearName( Scene ) + ')' , FindGearIndex( Adv , Mek ) ); end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Mek := Mek^.Next; end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} Scene := Scene^.Next; end; @@ -1652,9 +2467,23 @@ end; Function DeliveryCost( Mek: GearPtr ): LongInt; { Return the cost to deliver this mecha from one location } { to the next. Cost is determined by mass. } -var +{$IFDEF PATCH_GH} +const + Cost_MAX = 2147483647; + Cost_MIN = -2147483648; +{$ENDIF PATCH_GH} +var +{$IFDEF PATCH_GH} + C: Int64; + T: LongInt; +{$ELSE PATCH_GH} C,T: LongInt; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Mek) or (Mek^.G <= GG_DisposeGear) then exit(0); +{$ENDIF PATCH_GH} + { Base value is the mass of the mek. } C := GearMass( Mek ); @@ -1662,7 +2491,16 @@ begin for t := 1 to Mek^.Scale do C := C * 5; { Return the finished cost. } +{$IFDEF PATCH_GH} + if C < Cost_MIN then begin + C := Cost_MIN; + end else if Cost_MAX < C then begin + C := Cost_MAX; + end; DeliveryCost := C; +{$ELSE PATCH_GH} + DeliveryCost := C; +{$ENDIF PATCH_GH} end; Procedure ExpressDelivery( GB: GameBoardPtr; PC,NPC: GearPtr ); @@ -1671,10 +2509,22 @@ Procedure ExpressDelivery( GB: GameBoard { belonging to the PC. } var RPM: RPGMenuPtr; +{$IFDEF PATCH_GH} + N: LongInt; +{$ELSE PATCH_GH} N: Integer; +{$ENDIF PATCH_GH} Mek: GearPtr; Cost: LongInt; -begin +{$IFDEF DEBUG} + MaxNum: LongInt; +{$ENDIF DEBUG} +begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then exit; + if (NIL = NPC) or (NPC^.G <= GG_DisposeGear) then exit; +{$ENDIF PATCH_GH} + {$IFDEF SDLMODE} SERV_GB := GB; SERV_NPC := NPC; @@ -1686,18 +2536,39 @@ begin repeat RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); FillExpressMenu( GB , RPM ); +{$IFDEF DEBUG} + MaxNum := CountGearIndex( FindRoot( GB^.Scene ), False, '' ); +{$ENDIF DEBUG} RPMSortAlpha( RPM ); AddRPGMenuItem( RPM , MsgString( 'EXIT' ) , -1 ); {$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + if Cheat_DisplayGearInfo then begin + SERV_Menu := RPM; + SERV_MenuLGBN := FindRoot( GB^.Scene ); + end; + {$ENDIF PATCH_GH} N := SelectMenu( RPM , @ServiceRedraw ); + {$IFDEF PATCH_GH} + SERV_MenuLGBN := NIL; + SERV_Menu := NIL; + {$ENDIF PATCH_GH} {$ELSE} N := SelectMenu( RPM ); {$ENDIF} DisposeRPGMenu( RPM ); if N > -1 then begin +{$IFDEF DEBUG} + Mek := LocateGearByNumber( FindRoot( GB^.Scene ) , N, False, MaxNum, 'ExpressDelivery' ); +{$ELSE DEBUG} Mek := LocateGearByNumber( FindRoot( GB^.Scene ) , N ); +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + if (NIL <> Mek) and (GG_DisposeGear < Mek^.G) then begin +{$ELSE PATCH_GH} if Mek <> Nil then begin +{$ENDIF PATCH_GH} Cost := ScalePrice( PC , NPC , DeliveryCost( Mek ) ); RPM := CreateRPGMenu( MenuItem , MenuSelect , ZONE_InteractMenu ); AddRPGMenuItem( RPM , ReplaceHash( MsgString( 'SERVICES_MoveYes' ) , GearName( Mek ) ) , 1 ); @@ -1737,10 +2608,38 @@ begin until N = -1; end; -{$IFDEF SDLMODE} + + initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: services.pp'); +{$ENDIF DEBUG} +{$IFDEF SDLMODE} + {$IFDEF PATCH_GH} + SERV_GB := Nil; + SERV_PC := Nil; + SERV_NPC := Nil; + SERV_Info := Nil; + SERV_Menu := NIL; + SERV_MenuRGS := NIL; + SERV_MenuLGBN := NIL; + Attach_SmartPointer( 'SERV_GB: GameBoardPtr', @SERV_GB ); + Attach_SmartPointer( 'SERV_PC: GearPtr', @SERV_PC ); + Attach_SmartPointer( 'SERV_NPC: GearPtr', @SERV_NPC ); + Attach_SmartPointer( 'SERV_Info: GearPtr', @SERV_Info ); + {$ELSE PATCH_GH} SERV_GB := Nil; SERV_NPC := Nil; + {$ENDIF PATCH_GH} {$ENDIF} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: services.pp(finalization)'); +{$ENDIF DEBUG} +end; end. diff -x .svn -uprN GearHead1100repository.original/skilluse.pp branches/skilluse.pp --- GearHead1100repository.original/skilluse.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/skilluse.pp 2013-04-21 09:00:01.000000000 +0900 @@ -56,7 +56,14 @@ Function UseRobotics( GB: GameBoardPtr; implementation -uses ability,action,damage,gearutil,ghchars,ghholder,ghmodule,ghmovers,ghswag, +uses +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} +{$IFDEF PATCH_GH} + ui4gh, +{$ENDIF PATCH_GH} + ability,action,damage,gearutil,ghchars,ghholder,ghmodule,ghmovers,ghswag, ghweapon,movement,interact,rpgdice,texutil; Function TotalRepairableDamage( Target: GearPtr; Skill: Integer ): LongInt; @@ -67,6 +74,10 @@ var AD,SD,TCom,SCom,it: LongInt; T: Integer; begin +{$IFDEF PATCH_GH} + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} + { Normally damage must be positive I know, but I just had a bug } { which resulted in negative damage. This prevented the rest of } { the damage to a mek/character from being repaired. So, taking } @@ -118,11 +129,22 @@ end; Procedure ApplyRepairPoints( Target: GearPtr; Skill: Integer; var RP: LongInt ); { Search through TARGET, and restore DPs to parts } { that can be repaired using SKILL. } +{$IFDEF PATCH_GH} +const + tmp_MAX = 2147483647; +{$ENDIF PATCH_GH} var Part: GearPtr; SD,AD,TCom,SCom,ARP,RPNeeded: LongInt; T: Integer; +{$IFDEF PATCH_GH} + tmp: Int64; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_GH} + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit; +{$ENDIF PATCH_GH} + { Only examine TARGET for damage if it's of a type that can be } { repaired using SKILL. } if RepairSkillNeeded( Target ) = Skill then begin @@ -137,9 +159,28 @@ begin TCom := ComponentComplexity( Target ); SCom := SubComComplexity( Target ); if SCom > TCom then begin +{$IFDEF PATCH_GH} + tmp := ( Int64(RPNeeded) * Int64(SCom) ) div TCom; + if tmp < 0 then begin + RPNeeded := 0; + end else if tmp_MAX < tmp then begin + RPNeeded := tmp_MAX; + end else begin + RPNeeded := tmp; + end; + tmp := ( Int64(ARP) * Int64(TCom) ) div SCom; + if tmp < 1 then begin + ARP := 1; + end else if tmp_MAX < tmp then begin + ARP := tmp_MAX; + end else begin + ARP := tmp; + end; +{$ELSE PATCH_GH} RPNeeded := ( RPNeeded * SCom ) div TCom; ARP := ( ARP * TCom ) div SCom; if ARP < 1 then ARP := 1; +{$ENDIF PATCH_GH} end; end; @@ -159,9 +200,28 @@ begin TCom := ComponentComplexity( Target ); SCom := SubComComplexity( Target ); if SCom > TCom then begin +{$IFDEF PATCH_GH} + tmp := ( Int64(RPNeeded) * Int64(SCom) ) div TCom; + if tmp < 0 then begin + RPNeeded := 0; + end else if tmp_MAX < tmp then begin + RPNeeded := tmp_MAX; + end else begin + RPNeeded := tmp; + end; + tmp := ( Int64(ARP) * Int64(TCom) ) div SCom; + if tmp < 1 then begin + ARP := 1; + end else if tmp_MAX < tmp then begin + ARP := tmp_MAX; + end else begin + ARP := tmp; + end; +{$ELSE PATCH_GH} RPNeeded := ( RPNeeded * SCom ) div TCom; ARP := ( ARP * TCom ) div SCom; if ARP < 1 then ARP := 1; +{$ENDIF PATCH_GH} end; end; @@ -227,8 +287,16 @@ var begin { Depending upon how much damage the target has, the PC can make } { several repair attempts. } +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); + if (NIL = Target) or (Target^.G <= GG_DisposeGear) then Exit(0); +{$ENDIF PATCH_GH} PC := LocatePilot( PC ); +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(0); +{$ELSE PATCH_GH} if PC = Nil then Exit( 0 ); +{$ENDIF PATCH_GH} if GB <> Nil then begin if not MoveLegal( FindRoot( PC ) , NAV_Stop , GB^.ComTime ) then Exit( 0 ); @@ -283,6 +351,10 @@ Function SeekBestInstrument( PC: GearPtr var Item,Best: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(NIL); +{$ENDIF PATCH_GH} + Best := Nil; Item := PC^.InvCom; while Item <> Nil do begin @@ -312,6 +384,11 @@ var Cash: LongInt; M: GearPtr; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(-1); + if (NIL = Instrument) or (Instrument^.G <= GG_DisposeGear) then Exit(-1); +{$ENDIF PATCH_GH} + { Determine the performance skill, and modify for instrument. } Perf := SkillValue( PC , NAS_Performance ) + Instrument^.Stat[ STAT_UseBonus ]; @@ -338,6 +415,9 @@ begin M := GB^.Meks; while M <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < M^.G) then begin +{$ENDIF PATCH_GH} { If M is a character, not the PC, and is active, } { and is not hostile towards the PC, and is in range, } { check its reaction to the performance. } @@ -360,6 +440,9 @@ begin Dec( N ); end; end; +{$IFDEF PATCH_GH} + end; +{$ENDIF PATCH_GH} M := M^.Next; end; @@ -443,9 +526,20 @@ Function UseRobotics( GB: GameBoardPtr; { adding a GENE BLENDER for the BioTech skill later on... } { This function returns the robot, or NIL if construction failed. } { The calling procedure should place the robot on the map or dispose of it. } +{$IFDEF PATCH_GH} +const + BP_MAX = 2147483647; + BP_MIN = -2147483648; +{$ENDIF PATCH_GH} var Robot,Part,Part2: GearPtr; +{$IFDEF PATCH_GH} + BP: LongInt; + BP_tmp: Int64; + SkRk,T,BaseSkill,Sensor,Electronic,Armor,Skill: Integer; +{$ELSE PATCH_GH} BP,SkRk,T,BaseSkill,Sensor,Electronic,Armor,Skill: Integer; +{$ENDIF PATCH_GH} Viable,Good: Boolean; Procedure InstallLimb( N,Size: Integer ); @@ -503,6 +597,12 @@ var end; begin +{$IFDEF PATCH_GH} + if (NIL = PC) or (PC^.G <= GG_DisposeGear) then Exit(NIL); + if (NIL = LocatePilot(PC)) or (LocatePilot(PC)^.G <= GG_DisposeGear) then Exit(NIL); + { Don't kick out the GG_DisposeGear of Ingredients at here. } +{$ENDIF PATCH_GH} + { PC must have some energy to do this. } if CurrentMental( PC ) < 1 then begin DisposeGear( Ingredients ); @@ -522,7 +622,11 @@ begin SetSAtt( Robot^.SA , 'NAME <' + RandomRobotName + '>' ); SetNAtt( Robot^.NA , NAG_CharDescription , NAS_DAge , -19 ); SetSAtt( Robot^.SA , 'ROGUECHAR ' ); +{$IFDEF PATCH_GH} + SetSAtt( Robot^.SA , 'SDL_COLORS <' + SDL_colors_RobotCreate + '>' ); +{$ELSE PATCH_GH} SetSAtt( Robot^.SA , 'SDL_COLORS <80 80 85 170 155 230 6 42 120>' ); +{$ENDIF PATCH_GH} { Determine the PC's ROBOTICS skill. } { The skill rank is penalized by 10 here since it will be given a bonus } @@ -539,16 +643,43 @@ begin BP := 0; Part := Ingredients; while Part <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ENDIF PATCH_GH} if Part^.G = GG_RepairFuel then begin BP := BP + Part^.V; end else begin +{$IFDEF PATCH_GH} + BP_tmp := BP; + BP_tmp := BP_tmp + GearMaxDamage( Part ); + BP_tmp := BP_tmp + GearMaxArmor( Part ); + BP_tmp := BP_tmp + GearMass( Part ); + if BP_tmp < BP_MIN then begin + BP_tmp := BP_MIN; + end else if BP_MAX < BP_tmp then begin + BP_tmp := BP_MAX; + end; + BP := BP_tmp; +{$ELSE PATCH_GH} BP := BP + GearMaxDamage( Part ) + GearMaxArmor( Part ) + GearMass( Part ); +{$ENDIF PATCH_GH} + end; +{$IFDEF PATCH_GH} end; +{$ENDIF PATCH_GH} Part := Part^.Next; end; { Use the BP total to calculate the robot's BODY stat. } +{$IFDEF PATCH_GH} + if (32767 < (BP div 25)) then begin + Robot^.Stat[ STAT_Body ] := 32767; + end else begin + Robot^.Stat[ STAT_Body ] := BP div 25; + end; +{$ELSE PATCH_GH} Robot^.Stat[ STAT_Body ] := BP div 25; +{$ENDIF PATCH_GH} if Robot^.Stat[ STAT_Body ] < 1 then Robot^.Stat[ STAT_Body ] := 1 else if Robot^.Stat[ STAT_Body ] > 25 then Robot^.Stat[ STAT_Body ] := 25; @@ -649,6 +780,10 @@ begin Armor := 0; while Part <> Nil do begin Part2 := Part^.Next; +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Part^.G) then begin +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} if ( Part^.G = GG_Weapon ) and ( RollStep( SkRk ) > Part^.V ) and ( BaseSkill > 0 ) then begin DelinkGear( Ingredients , Part ); InsertSubCom( SelectRandomGear( Robot^.SubCom ) , Part ); @@ -660,6 +795,10 @@ begin end else if ( Part^.G = GG_ExArmor ) and ( Part^.V > Armor ) then begin Armor := Part^.V; end; +{$IFDEF PATCH_GH} + end; +{$ELSE PATCH_GH} +{$ENDIF PATCH_GH} Part := Part2; end; @@ -706,4 +845,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: skilluse.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: skilluse.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/stamp.inc branches/stamp.inc --- GearHead1100repository.original/stamp.inc 1970-01-01 09:00:00.000000000 +0900 +++ branches/stamp.inc 2016-03-18 09:01:00.000000000 +0900 @@ -0,0 +1 @@ +Version_I18N = ' I18N 2016031801'; diff -x .svn -uprN GearHead1100repository.original/texutil.pp branches/texutil.pp --- GearHead1100repository.original/texutil.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/texutil.pp 2015-04-04 09:02:00.000000000 +0900 @@ -25,11 +25,132 @@ unit texutil; interface +{$IFDEF WITH_TENC} +{ "sysutils" has to come before others. } +uses sysutils, iconv; +{$ENDIF WITH_TENC} + +{ Check whether PATCH_EXTRACTTF is required or not. } +{$IFDEF PATCH_I18N} + {$IFNDEF PATCH_EXTRACTTF} + {$DEFINE PATCH_EXTRACTTF} + {$ENDIF PATCH_EXTRACTTF} +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_CHEAT} + {$IFNDEF PATCH_EXTRACTTF} + {$DEFINE PATCH_EXTRACTTF} + {$ENDIF PATCH_EXTRACTTF} +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_BACKPORT} + {$IFNDEF PATCH_EXTRACTTF} + {$DEFINE PATCH_EXTRACTTF} + {$ENDIF PATCH_EXTRACTTF} +{$ENDIF PATCH_BACKPORT} +{$IFDEF PATCH_GH} + {$IFNDEF PATCH_EXTRACTTF} + {$DEFINE PATCH_EXTRACTTF} + {$ENDIF PATCH_EXTRACTTF} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_JPSSDL} + {$IFNDEF PATCH_EXTRACTTF} + {$DEFINE PATCH_EXTRACTTF} + {$ENDIF PATCH_EXTRACTTF} +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_l0ugh} + {$IFNDEF PATCH_EXTRACTTF} + {$DEFINE PATCH_EXTRACTTF} + {$ENDIF PATCH_EXTRACTTF} +{$ENDIF PATCH_l0ugh} + +{ Check whether options is conflicted or not. } +{$IFDEF PATCH_I18N} + {$IFDEF ICONV} + {$ELSE ICONV} + {$IFDEF CONV_UNICODE} + Error. Not supported this setting. + {$ENDIF CONV_UNICODE} + {$IFDEF WITH_TENC} + Error. Not supported this setting. + {$ENDIF WITH_TENC} + {$ENDIF ICONV} +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_I18N} +Function TextISO646_AllowableCheck( const c: Char ): Boolean; + +Function TextEncode( const src: String ): String; +Function TextEncode_( const src: String ): String; +Function TextDecode( const src: String ): String; + +Function IsEUCCharLeadByte( c: Char ): Boolean; +Function IsEUCCharTrailByte( c: Char ): Boolean; +Function IsUTF8CharLeadByte( c: Char ): Boolean; +Function IsUTF8CharTrailByte( c: Char ): Boolean; +Function IsSJISCharLeadByte( c: Char ): Boolean; +Function IsSJISCharTrailByte( c: Char ): Boolean; +Function IsCP932CharLeadByte( c: Char ): Boolean; +Function IsCP932CharTrailByte( c: Char ): Boolean; + {$IFDEF WITH_TENC} +Function IsMBCharLeadByte( c: Char; enc: enc_type ): Boolean; +Function IsMBCharTrailByte( c: Char; enc: enc_type ): Boolean; + {$ENDIF WITH_TENC} +Function IsMBCharLeadByte( c: Char ): Boolean; +Function IsMBCharTrailByte( c: Char ): Boolean; + +Function LengthEUCJPChar( c: Char ): Integer; +Function LengthEUCKRChar( c: Char ): Integer; +Function LengthEUCCNChar( c: Char ): Integer; +Function LengthEUCTWChar( c: Char ): Integer; +Function LengthUTF8Char( c: Char ): Integer; +Function LengthSJISChar( c: Char ): Integer; +Function LengthCP932Char( c: Char ): Integer; + {$IFDEF WITH_TENC} +Function LengthMBChar( c: Char; enc: enc_type ): Integer; +Function LengthMBChar_bidiRTL( c: Char; enc: enc_type ): Integer; + {$ENDIF WITH_TENC} +Function LengthMBChar( c: Char ): Integer; + + {$IFDEF CONV_UNICODE} +Function Conv_FromUni16( const psrc: PWord; const srclen: Integer; var pdst: PChar; const dstlen: Integer ): Integer; +Function Conv_ToUni16( const psrc: PChar; const srclen: Integer; var pdst: PWord; const dstlen: Integer ): Integer; + {$ENDIF CONV_UNICODE} + + {$IFDEF WITH_TENC} +Function Conv_FromTenc( const psrc: PChar; const srclen: Integer; var pdst: PChar; const dstlen: Integer ): Integer; +Function Conv_ToTenc( const psrc: PChar; const srclen: Integer; var pdst: PChar; const dstlen: Integer ): Integer; +Function Conv_bidiRTL( const msg: String ): String; + {$ENDIF WITH_TENC} + +Function WidthMBcharStr( const msg: String ): Integer; +Function HeadMBChar( const msg: String ): String; + {$IFDEF WITH_TENC} +Function TailMBChar( const msg: String; enc: enc_type ): String; + {$ENDIF WITH_TENC} +Function TailMBChar( const msg: String ): String; + +Function EditMBCharStr( var basestr: String; const MaxLen: Integer; const MaxWidth: Integer; const key: Char; const addstr: PChar; var state: ShortInt; var mbchar_work: String ): Char; +{$ENDIF PATCH_I18N} + +{$IFDEF PATCH_I18N} +Function DeleteWhiteSpace(var S: String): Boolean; +{$ELSE PATCH_I18N} Procedure DeleteWhiteSpace(var S: String); +{$ENDIF PATCH_I18N} Procedure DeleteFirstChar(var S: String); + +{$IFDEF PATCH_I18N} +Function MBCharTrimedLength( const S: String; MaxWidth: Integer ): Integer; +Function ExtractWord(var S: String; var SpaceDeleted,WordIsI18N: Boolean ): String; +{$ENDIF PATCH_I18N} Function ExtractWord(var S: String): String; Function ExtractValue(var S: String): LongInt; +{$IFDEF PATCH_EXTRACTTF} +Function ExtractTF(var S: String): Boolean; +{$ENDIF PATCH_EXTRACTTF} +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Function RetrieveAString(const S: String): String; +{$ENDIF PATCH_GH} Function RetrieveAPreamble(const S: String ): String; Function BStr( N: LongInt ): String; @@ -44,6 +165,7 @@ Function Sgn( N: LongInt ): Integer; Function PartMatchesCriteria( const Part_In,Desc_In: String ): Boolean; Function AStringHasBString( const A,B: String ): Boolean; +Function AStringHasBStringNum( const A,B: String ): Integer; Function HeadMatchesString( const H,S: String ): Boolean; Function QuickPCopy( const msg: String ): PChar; @@ -51,14 +173,907 @@ Function QuickPCopy( const msg: String ) Function IsPunctuation( C: Char ): Boolean; Procedure ReplacePat( var msg: String; const pat_in,s: String ); +{$IFDEF PATCH_I18N} +Function ReplaceHash( const msg, S1, S2, S3, S4: String ): String; +Function ReplaceHash( const msg, S1, S2, S3: String ): String; +Function ReplaceHash( const msg, S1, S2: String ): String; +{$ENDIF PATCH_I18N} Function ReplaceHash( const msg, s: String ): String; implementation -uses strings; +uses strings +{$IFDEF ICONV} + {$IFDEF Windows} + , windows + {$ENDIF Windows} + {$IFDEF UNIX} + , unixtype + {$ENDIF UNIX} + , libiconv +{$ENDIF ICONV} +{$IFDEF DEBUG} + ,errmsg +{$ENDIF DEBUG} + ; + + +{$IFDEF PATCH_I18N} +Function TextISO646_AllowableCheck( const C: Char ): Boolean; + { Check, is a character C in ISO/IEC 646 (in other words, ISO 8859-1 G0 GL page), printable and allowable by SAtt in gears.pp. } + { return-code: True is OK, False is BAD. } +begin + if c < #$20 then Exit( False ); { Not Printable } + if #$7E < c then Exit( False ); { Not ISO/IEC 646 } + if '<' = c then Exit( False ); { Used by *SAtt() } + if '>' = c then Exit( False ); { Used by *SAtt() } + { if '#' = c then Exit( False ); } { Used by ReplaceHash() } + if '%' = c then Exit( False ); { Used by FormatChatStringByGender() } + { if '\\' = c then Exit( False ); } { Used by script } + Exit( True ); +end; + +Function TextEncode( const src: String ): String; +const + AllowableCharacters = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890()-=_.'; +var + Len, P: Integer; +begin + TextEncode := ''; + Len := Length(src); + P := 1; + while (P <= Len) do begin + if 0 < Pos(src[P], AllowableCharacters) then begin + TextEncode := TextEncode + src[P]; + Inc(P); + end else begin + TextEncode := TextEncode + '%' + IntToHex(Ord(src[P]),2); + Inc(P); + end; + end; +end; + +Function TextEncode_( const src: String ): String; +const + AllowableCharacters = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890()-=_.'; +var + Len, P: Integer; +begin + TextEncode_ := ''; + Len := Length(src); + P := 1; + while (P <= Len) do begin + if 0 < Pos(src[P], AllowableCharacters) then begin + TextEncode_ := TextEncode_ + src[P]; + Inc(P); + end else begin + TextEncode_ := TextEncode_ + '_'; + Inc(P); + end; + end; +end; + +Function TextDecode( const src: String ): String; +var + Len, P: Integer; + tmp: String; +begin + TextDecode := ''; + Len := Length(src); + P := 1; + while (P <= Len) do begin + if '%' = src[P] then begin + Inc(P); + tmp := ''; + if (P +1) <= Len then begin + tmp := '$' + src[P] + src[P+1]; + Inc(P); + Inc(P); + end else if P <= Len then begin + tmp := '$' + src[P]; + Inc(P); + end; + TextDecode := TextDecode + Chr(StrToInt(tmp)); + end else begin + TextDecode := TextDecode + src[P]; + Inc(P); + end; + end; +end; + + +Function IsEUCCharLeadByte( c: Char ): Boolean; +begin + exit ((#$A1 <= c) and (c <= #$FE) or (c = #$8E) or (c = #$8F)); +end; + +Function IsEUCCharTrailByte( c: Char ): Boolean; +begin + exit ((#$A1 <= c) and (c <= #$FE)); +end; + +Function IsUTF8CharLeadByte( c: Char ): Boolean; +begin + exit (((#$C0 <= c) and (c <= #$DF)) or ((#$E0 <= c) and (c <= #$EF)) or ((#$F0 <= c) and (c <= #$F7))); +end; + +Function IsUTF8CharTrailByte( c: Char ): Boolean; +begin + exit ((#$80 <= c) and (c <= #$BF)); +end; + +Function IsSJISCharLeadByte( c: Char ): Boolean; +begin + exit (((c>=#$81) and (c<=#$9F)) or ((c>=#$E0) and (c<=#$EF))); +end; + +Function IsSJISCharTrailByte( c: Char ): Boolean; +begin + exit (((c>=#$40) and (c<=#$7E)) or ((c>=#$80) and (c<=#$FC))); +end; + +Function IsCP932CharLeadByte( c: Char ): Boolean; +begin + exit (((c>=#$81) and (c<=#$9F)) or ((c>=#$E0) and (c<=#$FC))); +end; + +Function IsCP932CharTrailByte( c: Char ): Boolean; +begin + exit (((c>=#$40) and (c<=#$7E)) or ((c>=#$80) and (c<=#$FC))); +end; + +{$IFDEF WITH_TENC} +Function IsMBCharLeadByte( c: Char; enc: enc_type ): Boolean; +begin + case enc of + SINGLEBYTE: IsMBCharLeadByte := False; + EUCJP: IsMBCharLeadByte := IsEUCCharLeadByte(c); + EUCKR: IsMBCharLeadByte := IsEUCCharLeadByte(c); + EUCCN: IsMBCharLeadByte := IsEUCCharLeadByte(c); + EUCTW: IsMBCharLeadByte := IsEUCCharLeadByte(c); + UTF8: IsMBCharLeadByte := IsUTF8CharLeadByte(c); + SJIS: IsMBCharLeadByte := IsSJISCharLeadByte(c); + CP932: IsMBCharLeadByte := IsCP932CharLeadByte(c); + end; +end; + +Function IsMBCharTrailByte( c: Char; enc: enc_type ): Boolean; +begin + case enc of + SINGLEBYTE: IsMBCharTrailByte := False; + EUCJP: IsMBCharTrailByte := IsEUCCharTrailByte(c); + EUCKR: IsMBCharTrailByte := IsEUCCharTrailByte(c); + EUCCN: IsMBCharTrailByte := IsEUCCharTrailByte(c); + EUCTW: IsMBCharTrailByte := IsEUCCharTrailByte(c); + UTF8: IsMBCharTrailByte := IsUTF8CharTrailByte(c); + SJIS: IsMBCharTrailByte := IsSJISCharTrailByte(c); + CP932: IsMBCharTrailByte := IsCP932CharTrailByte(c); + end; +end; +{$ENDIF WITH_TENC} + +Function IsMBCharLeadByte( c: Char ): Boolean; +begin + IsMBCharLeadByte := IsMBCharLeadByte( c, SENC ); + {$IFDEF ENCODING_SINGLEBYTE} + IsMBCharLeadByte := False; + {$ENDIF} + {$IFDEF ENCODING_EUCJP} + IsMBCharLeadByte := IsEUCCharLeadByte(c); + {$ENDIF} + {$IFDEF ENCODING_EUCKR} + IsMBCharLeadByte := IsEUCCharLeadByte(c); + {$ENDIF} + {$IFDEF ENCODING_EUCCN} + IsMBCharLeadByte := IsEUCCharLeadByte(c); + {$ENDIF} + {$IFDEF ENCODING_EUCTW} + IsMBCharLeadByte := IsEUCCharLeadByte(c); + {$ENDIF} + {$IFDEF ENCODING_UTF8} + IsMBCharLeadByte := IsUTF8CharLeadByte(c); + {$ENDIF} + {$IFDEF ENCODING_SJIS} + IsMBCharLeadByte := IsSJISCharLeadByte(c); + {$ENDIF} + {$IFDEF ENCODING_CP932} + IsMBCharLeadByte := IsCP932CharLeadByte(c); + {$ENDIF} +end; + +Function IsMBCharTrailByte( c: Char ): Boolean; +begin + IsMBCharTrailByte := IsMBCharTrailByte( c, SENC ); + {$IFDEF ENCODING_SINGLEBYTE} + IsMBCharTrailByte := False; + {$ENDIF} + {$IFDEF ENCODING_EUCJP} + IsMBCharTrailByte := IsEUCCharTrailByte(c); + {$ENDIF} + {$IFDEF ENCODING_EUCKR} + IsMBCharTrailByte := IsEUCCharTrailByte(c); + {$ENDIF} + {$IFDEF ENCODING_EUCCN} + IsMBCharTrailByte := IsEUCCharTrailByte(c); + {$ENDIF} + {$IFDEF ENCODING_EUCTW} + IsMBCharTrailByte := IsEUCCharTrailByte(c); + {$ENDIF} + {$IFDEF ENCODING_UTF8} + IsMBCharTrailByte := IsUTF8CharTrailByte(c); + {$ENDIF} + {$IFDEF ENCODING_SJIS} + IsMBCharTrailByte := IsSJISCharTrailByte(c); + {$ENDIF} + {$IFDEF ENCODING_CP932} + IsMBCharTrailByte := IsCP932CharTrailByte(c); + {$ENDIF} +end; + + +Function LengthEUCJPChar( c: Char ): Integer; +begin + if IsEUCCharLeadByte(c) then begin + if #$8F = c then LengthEUCJPChar := 3 + else if #$8E = c then LengthEUCJPChar := 2 + else LengthEUCJPChar := 2; + end else if IsEUCCharTrailByte(c) then LengthEUCJPChar := 1 + else LengthEUCJPChar := 0; +end; + +Function LengthEUCKRChar( c: Char ): Integer; +begin + if IsEUCCharLeadByte(c) then begin + if #$8F = c then LengthEUCKRChar := 0 + else if #$8E = c then LengthEUCKRChar := 0 + else LengthEUCKRChar := 2; + end else if IsEUCCharTrailByte(c) then LengthEUCKRChar := 1 + else LengthEUCKRChar := 0; +end; + +Function LengthEUCCNChar( c: Char ): Integer; +begin + if IsEUCCharLeadByte(c) then begin + if #$8F = c then LengthEUCCNChar := 0 + else if #$8E = c then LengthEUCCNChar := 0 + else LengthEUCCNChar := 2; + end else if IsEUCCharTrailByte(c) then LengthEUCCNChar := 1 + else LengthEUCCNChar := 0; +end; + +Function LengthEUCTWChar( c: Char ): Integer; +begin + if IsEUCCharLeadByte(c) then begin + if #$8F = c then LengthEUCTWChar := 0 + else if #$8E = c then LengthEUCTWChar := 4 + else LengthEUCTWChar := 2; + end else if IsEUCCharTrailByte(c) then LengthEUCTWChar := 1 + else LengthEUCTWChar := 0; +end; + +Function LengthUTF8Char( c: Char ): Integer; +begin + if IsUTF8CharLeadByte(c) then begin + if (#$C0 <= c) and (c <= #$DF) then LengthUTF8Char := 2 + else if (#$E0 <= c) and (c <= #$EF) then LengthUTF8Char := 3 + else if (#$F0 <= c) and (c <= #$F7) then LengthUTF8Char := 4; + end else if IsUTF8CharTrailByte(c) then LengthUTF8Char := 1 + else LengthUTF8Char := 0; +end; + +Function LengthSJISChar( c: Char ): Integer; +begin + if IsSJISCharLeadByte(c) then LengthSJISChar := 2 + else if IsSJISCharTrailByte(c) then LengthSJISChar := 1 + else LengthSJISChar := 0; +end; + +Function LengthCP932Char( c: Char ): Integer; +begin + if IsCP932CharLeadByte(c) then LengthCP932Char := 2 + else if IsCP932CharTrailByte(c) then LengthCP932Char := 1 + else LengthCP932Char := 0; +end; + +{$IFDEF WITH_TENC} +Function LengthMBChar( c: Char; enc: enc_type ): Integer; +begin + case enc of + SINGLEBYTE: LengthMBChar := 0; + EUCJP: LengthMBChar := LengthEUCJPChar(c); + EUCKR: LengthMBChar := LengthEUCKRChar(c); + EUCCN: LengthMBChar := LengthEUCCNChar(c); + EUCTW: LengthMBChar := LengthEUCTWChar(c); + UTF8: LengthMBChar := LengthUTF8Char(c); + SJIS: LengthMBChar := LengthSJISChar(c); + CP932: LengthMBChar := LengthCP932Char(c); + end; +end; + +Function LengthMBChar_bidiRTL( c: Char; enc: enc_type ): Integer; +begin + LengthMBChar_bidiRTL := LengthMBChar(c,enc); + if (0 = LengthMBChar_bidiRTL) and (#$80 <= c) then begin + LengthMBChar_bidiRTL := 1; { May be ISO8859-6. } + end; +end; +{$ENDIF WITH_TENC} + +Function LengthMBChar( c: Char ): Integer; +begin + LengthMBChar := LengthMBChar( c, SENC ); + {$IFDEF ENCODING_SINGLEBYTE} + LengthMBChar := 0; + {$ENDIF} + {$IFDEF ENCODING_EUCJP} + LengthMBChar := LengthEUCJPChar(c); + {$ENDIF} + {$IFDEF ENCODING_EUCKR} + LengthMBChar := LengthEUCKRChar(c); + {$ENDIF} + {$IFDEF ENCODING_EUCCN} + LengthMBChar := LengthEUCCNChar(c); + {$ENDIF} + {$IFDEF ENCODING_EUCTW} + LengthMBChar := LengthEUCTWChar(c); + {$ENDIF} + {$IFDEF ENCODING_UTF8} + LengthMBChar := LengthUTF8Char(c); + {$ENDIF} + {$IFDEF ENCODING_SJIS} + LengthMBChar := LengthSJISChar(c); + {$ENDIF} + {$IFDEF ENCODING_CP932} + LengthMBChar := LengthCP932Char(c); + {$ENDIF} +end; + + +{$IFDEF CONV_UNICODE} +Function Conv_FromUni16( const psrc: PWord; const srclen: Integer; var pdst: PChar; const dstlen: Integer ): Integer; +var +{$IFDEF ICONV} + work_srclen, work_dstlen: size_t; + work_psrc, work_pdst: PChar; + iconv_result: size_t; +{$ELSE ICONV} + codepage: Word; +{$ENDIF ICONV} +begin +{$IFDEF ICONV} + work_psrc := PChar(psrc); work_srclen := srclen; + work_pdst := pdst; work_dstlen := dstlen - 1; // -1 for #00 + while (0 < work_srclen) do begin + iconv_result := libiconv.iconv( iconv_utf16toenc, + @work_psrc, @work_srclen, @work_pdst, @work_dstlen ); + if (work_dstlen < 8) then + break; + if (0 < work_srclen) then begin + StrPCopy( work_pdst, '#$' + IntToHex(Ord(work_psrc[0]),2) + IntToHex(Ord(work_psrc[1]),2) ); + work_psrc := work_psrc + 2; work_srclen := work_srclen - 2; + work_pdst := work_pdst + 6; work_dstlen := work_dstlen - 6; + end; + end; + iconv_result := libiconv.iconv( iconv_utf16toenc, + NIL, NIL, @work_pdst, @work_dstlen ); + work_pdst[0] := #0; + Conv_FromUni16 := (dstlen - 1 - work_dstlen); +{$ELSE ICONV} + codepage := 0; + {$IFDEF ENCODING_SINGLEBYTE} + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + {$IFDEF ENCODING_EUCJP} + codepage := 20932;//51932; { 20932 : eucJP-ms, 51932 : EUC-JP } + { CP20932 is shrinked eucJP, CP51932 is true eucJP, but applications without .NET can not use CP51932. } + {$ENDIF} + {$IFDEF ENCODING_EUCKR} + codepage := 51949; + {$ENDIF} + {$IFDEF ENCODING_EUCCN} + codepage := 51936; { 20936 : CP2312, 51936 : GB2312, 54936 : GB18030 } + {$ENDIF} + {$IFDEF ENCODING_EUCTW} + codepage := 51950; + {$ENDIF} + {$IFDEF ENCODING_UTF8} + codepage := Windows.CP_UTF8; { 65001, Later than MS-Windows 98/Me/NT4.0. } + {$ENDIF} + {$IFDEF ENCODING_SJIS} + { codepage := 932; } { CP932 } + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + {$IFDEF ENCODING_CP932} + { codepage := 932; } { CP932 } + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + Conv_FromUni16 := Windows.WideCharToMultiByte( codepage, 0, PWideChar(psrc), srclen, pdst, dstlen, NIL, NIL ); + pdst[Conv_FromUni16] := #0; +{$ENDIF ICONV} +end; + + +Function Conv_ToUni16( const psrc: PChar; const srclen: Integer; var pdst: PWord; const dstlen: Integer ): Integer; +var +{$IFDEF ICONV} + work_srclen, work_dstlen, work_tmplen: size_t; + work_psrc, work_pdst, ptmp: PChar; + tmp: array[0..4] of Char; + iconv_result: size_t; +{$ELSE ICONV} + codepage: Word; +{$ENDIF ICONV} +begin +{$IFDEF ICONV} + work_psrc := psrc; work_srclen := srclen; + work_pdst := PChar(pdst); work_dstlen := dstlen - 2; // -2 for #0000 + while (0 < work_srclen) do begin + iconv_result := libiconv.iconv( iconv_enc2utf16, + @work_psrc, @work_srclen, @work_pdst, @work_dstlen ); + if (work_dstlen < 16) then + break; + if (0 < work_srclen) then begin + StrPCopy( tmp, '#$' + IntToHex(Ord(work_psrc[0]),2) ); + ptmp := tmp; work_tmplen := 4; + Inc( work_psrc ); Dec( work_srclen ); + iconv_result := libiconv.iconv( iconv_enc2utf16, + @ptmp, @work_tmplen, @work_pdst, @work_dstlen ); + end; + end; + iconv_result := libiconv.iconv( iconv_enc2utf16, + NIL, NIL, @work_pdst, @work_dstlen ); + work_pdst[0] := #0; work_pdst[1] := #0; + Conv_ToUni16 := (dstlen - 2 - work_dstlen) div 2; +{$ELSE ICONV} + codepage := 0; + {$IFDEF ENCODING_SINGLEBYTE} + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + {$IFDEF ENCODING_EUCJP} + codepage := 20932;//51932; { 20932 : eucJP-ms, 51932 : EUC-JP } + { CP20932 is shrinked eucJP, CP51932 is true eucJP, but applications without .NET can not use CP51932. } + {$ENDIF} + {$IFDEF ENCODING_EUCKR} + codepage := 51949; + {$ENDIF} + {$IFDEF ENCODING_EUCCN} + codepage := 51936; { 20936 : CP2312, 51936 : GB2312, 54936 : GB18030 } + {$ENDIF} + {$IFDEF ENCODING_EUCTW} + codepage := 51950; + {$ENDIF} + {$IFDEF ENCODING_UTF8} + codepage := Windows.CP_UTF8; { 65001, Later than MS-Windows 98/Me/NT4.0. } + {$ENDIF} + {$IFDEF ENCODING_SJIS} + { codepage := 932; } { CP932 } + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + {$IFDEF ENCODING_CP932} + { codepage := 932; } { CP932 } + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + Conv_ToUni16 := Windows.MultiByteToWideChar( codepage, 0, psrc , srclen, PWideChar(pdst), dstlen ); + pdst[Conv_ToUni16] := 0000; +{$ENDIF ICONV} +end; +{$ENDIF CONV_UNICODE} + + +{$IFDEF WITH_TENC} +Function Conv_FromTenc( const psrc: PChar; const srclen: Integer; var pdst: PChar; const dstlen: Integer ): Integer; +{$IFDEF ICONV} +{$ELSE ICONV} +const + WCLen = 255; +{$ENDIF ICONV} +var +{$IFDEF ICONV} + work_srclen, work_dstlen: size_t; + work_psrc, work_pdst: PChar; + iconv_result: size_t; +{$ELSE ICONV} + codepage: Word; + tmp: array[0..WCLen] of WideChar; +{$ENDIF ICONV} +begin +{$IFDEF ICONV} + work_psrc := psrc; work_srclen := srclen; + work_pdst := pdst; work_dstlen := dstlen - 1; // -1 for #00 + while (0 < work_srclen) do begin + iconv_result := libiconv.iconv( iconv_tenc2enc, + @work_psrc, @work_srclen, @work_pdst, @work_dstlen ); + if (work_dstlen < 8) then + break; + if (0 < work_srclen) then begin + StrPCopy( work_pdst, '#$' + IntToHex(Ord(work_psrc[0]),2) + IntToHex(Ord(work_psrc[1]),2) ); + work_psrc := work_psrc + 2; work_srclen := work_srclen - 2; + work_pdst := work_pdst + 6; work_dstlen := work_dstlen - 6; + end; + end; + iconv_result := libiconv.iconv( iconv_tenc2enc, + NIL, NIL, @work_pdst, @work_dstlen ); + work_pdst[0] := #0; + Conv_FromTenc := (dstlen - 1 - work_dstlen); +{$ELSE ICONV} + case TENC of + SINGLEBYTE: codepage := Windows.CP_ACP; + EUCJP: codepage := 20932;//51932; + EUCKR: codepage := 51949; + EUCCN: codepage := 51936; + EUCTW: codepage := 51950; + UTF8: codepage := Windows.CP_UTF8; + SJIS: codepage := Windows.CP_ACP; + CP932: codepage := Windows.CP_ACP; + end; + Conv_FromTenc := Windows.MultiByteToWideChar( codepage, 0, psrc , srclen, tmp, WCLen ); + tmp[Conv_FromTenc] := #0000; + codepage := 0; + {$IFDEF ENCODING_SINGLEBYTE} + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + {$IFDEF ENCODING_EUCJP} + codepage := 20932;//51932; { 20932 : eucJP-ms, 51932 : EUC-JP } + { CP20932 is shrinked eucJP, CP51932 is true eucJP, but applications without .NET can not use CP51932. } + {$ENDIF} + {$IFDEF ENCODING_EUCKR} + codepage := 51949; + {$ENDIF} + {$IFDEF ENCODING_EUCCN} + codepage := 51936; { 20936 : CP2312, 51936 : GB2312, 54936 : GB18030 } + {$ENDIF} + {$IFDEF ENCODING_EUCTW} + codepage := 51950; + {$ENDIF} + {$IFDEF ENCODING_UTF8} + codepage := Windows.CP_UTF8; { 65001, Later than MS-Windows 98/Me/NT4.0. } + {$ENDIF} + {$IFDEF ENCODING_SJIS} + { codepage := 932; } { CP932 } + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + {$IFDEF ENCODING_CP932} + { codepage := 932; } { CP932 } + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + Conv_FromTenc := Windows.WideCharToMultiByte( codepage, 0, tmp, Conv_FromTenc, pdst, dstlen, NIL, NIL ); + pdst[Conv_FromTenc] := #0; +{$ENDIF ICONV} +end; + + +Function Conv_ToTenc( const psrc: PChar; const srclen: Integer; var pdst: PChar; const dstlen: Integer ): Integer; +{$IFDEF ICONV} +{$ELSE ICONV} +const + WCLen = 255; +{$ENDIF ICONV} +var +{$IFDEF ICONV} + work_srclen, work_dstlen, work_tmplen: size_t; + work_psrc, work_pdst, ptmp: PChar; + tmp: array[0..4] of Char; + iconv_result: size_t; +{$ELSE ICONV} + codepage: Word; + tmp: array[0..WCLen] of WideChar; +{$ENDIF ICONV} +begin +{$IFDEF ICONV} + work_psrc := psrc; work_srclen := srclen; + work_pdst := pdst; work_dstlen := dstlen - 2; // -2 for #0000 + while (0 < work_srclen) do begin + iconv_result := libiconv.iconv( iconv_enc2tenc, + @work_psrc, @work_srclen, @work_pdst, @work_dstlen ); + if (work_dstlen < 16) then + break; + if (0 < work_srclen) then begin + StrPCopy( tmp, '#$' + IntToHex(Ord(work_psrc[0]),2) ); + ptmp := tmp; work_tmplen := 4; + Inc( work_psrc ); Dec( work_srclen ); + iconv_result := libiconv.iconv( iconv_enc2tenc, + @ptmp, @work_tmplen, @work_pdst, @work_dstlen ); + end; + end; + iconv_result := libiconv.iconv( iconv_enc2tenc, + NIL, NIL, @work_pdst, @work_dstlen ); + work_pdst[0] := #0; work_pdst[1] := #0; + Conv_ToTenc := (dstlen - 2 - work_dstlen); +{$ELSE ICONV} + codepage := 0; + {$IFDEF ENCODING_SINGLEBYTE} + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + {$IFDEF ENCODING_EUCJP} + codepage := 20932;//51932; { 20932 : eucJP-ms, 51932 : EUC-JP } + { CP20932 is shrinked eucJP, CP51932 is true eucJP, but applications without .NET can not use CP51932. } + {$ENDIF} + {$IFDEF ENCODING_EUCKR} + codepage := 51949; + {$ENDIF} + {$IFDEF ENCODING_EUCCN} + codepage := 51936; { 20936 : CP2312, 51936 : GB2312, 54936 : GB18030 } + {$ENDIF} + {$IFDEF ENCODING_EUCTW} + codepage := 51950; + {$ENDIF} + {$IFDEF ENCODING_UTF8} + codepage := Windows.CP_UTF8; { 65001, Later than MS-Windows 98/Me/NT4.0. } + {$ENDIF} + {$IFDEF ENCODING_SJIS} + { codepage := 932; } { CP932 } + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + {$IFDEF ENCODING_CP932} + { codepage := 932; } { CP932 } + codepage := Windows.CP_ACP; { 0, ANSI } + {$ENDIF} + Conv_ToTenc := Windows.MultiByteToWideChar( codepage, 0, psrc , srclen, tmp, WCLen ); + tmp[Conv_ToTenc] := #0000; + case TENC of + SINGLEBYTE: codepage := Windows.CP_ACP; + EUCJP: codepage := 20932;//51932; + EUCKR: codepage := 51949; + EUCCN: codepage := 51936; + EUCTW: codepage := 51950; + UTF8: codepage := Windows.CP_UTF8; + SJIS: codepage := Windows.CP_ACP; + CP932: codepage := Windows.CP_ACP; + end; + Conv_ToTenc := Windows.WideCharToMultiByte( codepage, 0, tmp, Conv_ToTenc, pdst, dstlen, NIL, NIL ); + pdst[Conv_ToTenc] := #0; +{$ENDIF ICONV} +end; + + +Function Conv_bidiRTL( const msg: String ): String; +var + MaxLen: Integer; + P, CheckP: Integer; + len: Integer; + c: String; + ConvKey: Integer; + buf_flush: Boolean; +begin + MaxLen := Length(msg); + Conv_bidiRTL := ''; + P := 1; + CheckP := P; + + while (P <= MaxLen) do begin + buf_flush := False; + len := LengthMBChar_bidiRTL( msg[P], TENC ); + if 0 = len then begin + len := 1; + end else begin + buf_flush := True; + end; + + c := Copy( msg, P, len ); + ConvKey := Pos( c, TERMINAL_bidiRTL_Punctuation ); + if 0 < ConvKey then begin + buf_flush := True; + end else begin + ConvKey := Pos( c, TERMINAL_bidiRTL_ConvPair1 ); + if 0 < ConvKey then begin + c := Copy( TERMINAL_bidiRTL_ConvPair2, ConvKey, len ); + buf_flush := True; + end else begin + ConvKey := Pos( c, TERMINAL_bidiRTL_ConvPair2 ); + if 0 < ConvKey then begin + c := Copy( TERMINAL_bidiRTL_ConvPair1, ConvKey, len ); + buf_flush := True; + end; + end; + end; + + if buf_flush then begin + Conv_bidiRTL := c + Copy( msg, CheckP, (P - CheckP) ) + Conv_bidiRTL; + P := P + len; + CheckP := P; + end else begin + P := P + len; + end; + end; + Conv_bidiRTL := Copy( msg, CheckP, (P - CheckP) ) + Conv_bidiRTL; +end; +{$ENDIF WITH_TENC} + + +Function WidthMBcharStr( const msg: String ): Integer; +var + MaxLen: Integer; + P: Integer; + len: Integer; +begin + MaxLen := Length( msg ); + WidthMBcharStr := 0; + P := 1; + while (P <= MaxLen) do begin + len := LengthMBChar( msg[P] ); + if 0 = len then begin + Inc(P); + WidthMBcharStr := WidthMBcharStr + 1; + end else begin + P := P + len; + WidthMBcharStr := WidthMBcharStr + 2; + end; + end; +end; + +Function HeadMBChar( const msg: String ): String; +var + len: Integer; +begin + len := LengthMBChar( msg[1] ); + if 0 = len then HeadMBChar := msg[1] + else HeadMBChar := Copy( msg, 1, len ); +end; + + +{$IFDEF WITH_TENC} +Function TailMBChar( const msg: String; enc: enc_type ): String; +var + MaxLen: Integer; + P, LastP: Integer; + len: Integer; +begin + MaxLen := Length( msg ); + P := 1; LastP := 1; + while (P <= MaxLen) do begin + LastP := P; + len := LengthMBChar( msg[P], enc ); + if 0 = len then Inc(P) + else P := P + len; + end; + + if 1 = P then TailMBChar := '' + else if 0 = len then TailMBChar := msg[LastP] + else TailMBChar := Copy( msg, LastP, len ); +end; +{$ENDIF WITH_TENC} + +Function TailMBChar( const msg: String ): String; +var + MaxLen: Integer; + P, LastP: Integer; + len: Integer; +begin + MaxLen := Length( msg ); + P := 1; LastP := 1; + while (P <= MaxLen) do begin + LastP := P; + len := LengthMBChar( msg[P] ); + if 0 = len then Inc(P) + else P := P + len; + end; + + if 1 = P then TailMBChar := '' + else if 0 = len then TailMBChar := msg[LastP] + else TailMBChar := Copy( msg, LastP, len ); +end; + + +Function EditMBCharStr( var basestr: String; const MaxLen: Integer; const MaxWidth: Integer; const key: Char; const addstr: PChar; var state: ShortInt; var mbchar_work: String ): Char; + { input: 'basestr': To edit string. } + { input: 'MaxLen': Maximum size (byte length) of basestr. } + { input: 'MaxWidth': Maximum width (drawable length) of basestr. } + { input: 'key': A charactor to add basestr. It is exclusive using with 'addstr'. } + { input: 'addstr': Charactors to add basestr. It is exclusive using with 'key'. } + { input: 'state': In initially, set 0 by calling side. If not 0, now in processing multi-byte charactors. } + { return: 'basestr': Edited string. } + { return: 'state': Length of remnant multi-byte chractors. } + { return code is #255: 'key' is continued multi-byte charctor. 'state' is length of the continuing. } + { return code is #0: Finished successfully. } + { return code is others: 'key' is unknown charactor. Do nothing. } + { ATTENTION: Input value 'MaxLen' is a length of bytes. } + { ATTENTION: Input value 'MaxWidth' is a width for display. } + { ATTENTION: In CJK, there are some charctors, one charactor have double size for one ANK charactor and data length is 3 or 4 bytes. } +const +{$IFDEF WITH_TENC} + WCLen = 16; +{$ENDIF WITH_TENC} +var + BW: String; +{$IFDEF WITH_TENC} + work_dst: Array[0..WCLen] of Char; + pmsg, work_pdst: PChar; +{$ENDIF WITH_TENC} +begin + EditMBCharStr := #0; + if (0 = Length(basestr)) and (0 = state) then begin + mbchar_work := ''; + end; + + if (#0 = key) and (NIL = addstr) then begin + // May be bug. + end else if (#0 = key) then begin + // if not(0 = state) then May be bug. + if ((Length(basestr) + Length(addstr)) <= MaxLen) and ((WidthMBcharStr(basestr) + WidthMBcharStr(addstr)) <= MaxWidth) then begin + basestr := basestr + addstr; + end; + state := 0; + mbchar_work := ''; + end else begin + if 0 = state then begin + if (#$8 = key) then begin + BW := TailMBChar( basestr ); + basestr := Copy( basestr, 1, Length(basestr) - Length(BW) ); + state := 0; + mbchar_work := ''; + end else if (#$15 = key) then begin + basestr := ''; + state := 0; + mbchar_work := ''; + end else if TextISO646_AllowableCheck(key) then begin + if (Length( basestr ) < MaxLen) and (WidthMBcharStr(basestr) < MaxWidth) then begin + basestr := basestr + key; + end; + state := 0; + mbchar_work := ''; +{$IFDEF WITH_TENC} + end else if IsMBCharLeadByte(key,TENC) then begin + state := LengthMBChar( key, TENC ); +{$ELSE WITH_TENC} + end else if IsMBCharLeadByte(key) then begin + state := LengthMBChar( key ); +{$ENDIF WITH_TENC} + if ((Length(basestr) + state) <= MaxLen) and ((WidthMBcharStr(basestr) +2) <= MaxWidth) then begin + mbchar_work := key; + end else begin + mbchar_work := ''; + end; + Dec( state ); + EditMBCharStr := #$FF; + end else begin + state := 0; + mbchar_work := ''; + EditMBCharStr := key; + end; + end else begin +{$IFDEF WITH_TENC} + if IsMBCharTrailByte(key,TENC) then begin +{$ELSE WITH_TENC} + if IsMBCharTrailByte(key) then begin +{$ENDIF WITH_TENC} + if '' <> mbchar_work then begin + mbchar_work := mbchar_work + key; + end; + Dec( state ); + if 0 < state then EditMBCharStr := #$FF + else begin + EditMBCharStr := #0; +{$IFDEF WITH_TENC} + work_pdst := work_dst; + pmsg := QuickPCopy(mbchar_work); + Conv_FromTenc( pmsg, Length(mbchar_work), work_pdst, WCLen ); + Dispose(pmsg); + basestr := basestr + StrPas(work_dst); +{$ELSE WITH_TENC} + basestr := basestr + mbchar_work; +{$ENDIF WITH_TENC} + state := 0; + mbchar_work := ''; + end; + end else begin + // May be bug. + EditMBCharStr := #0; + state := 0; + mbchar_work := ''; + end; + end; + end; +end; +{$ENDIF PATCH_I18N} + + +{$IFDEF PATCH_I18N} +Function DeleteWhiteSpace(var S: String): Boolean; +{$ELSE PATCH_I18N} Procedure DeleteWhiteSpace(var S: String); +{$ENDIF PATCH_I18N} {Delete any whitespace which is at the beginning of} {string S. If S is nothing but whitespace, or if it} {contains nothing, return an empty string.} @@ -66,6 +1081,9 @@ Procedure DeleteWhiteSpace(var S: String var P: Integer; begin +{$IFDEF PATCH_I18N} + DeleteWhiteSpace := False; +{$ENDIF PATCH_I18N} { Error check } if S = '' then Exit; @@ -76,17 +1094,167 @@ begin end; {Copy the string from the first nonspace to the end.} +{$IFDEF PATCH_I18N} + if (S[P] = ' ') or (S[P] = #9) then begin + S := ''; + DeleteWhiteSpace := true; + end else if (1 < P) then begin + S := Copy(S,P,Length(S)-P+1); + DeleteWhiteSpace := true; + end; +{$ELSE PATCH_I18N} if (S[P] = ' ') or (S[P] = #9) then S := '' else S := Copy(S,P,Length(S)); +{$ENDIF PATCH_I18N} end; Procedure DeleteFirstChar(var S: String); { Remove the first character from string S. } +{$IFDEF PATCH_I18N} +var + len: Integer; +{$ENDIF PATCH_I18N} begin {Copy the string from the first nonspace to the end.} if Length( S ) < 2 then S := '' +{$IFDEF PATCH_I18N} + else begin + len := LengthMBChar( S[1] ); + if 0 = len then S := Copy(S,2,Length(S)-1) + else S := Copy(S,1+len,Length(S)-len); + end; +{$ELSE PATCH_I18N} else S := Copy(S,2,Length(S)); +{$ENDIF PATCH_I18N} +end; + +{$IFDEF PATCH_I18N} +Function MBCharTrimedLength( const S: String; MaxWidth: Integer ): Integer; + { Calclate a length, a string to be in a MaxWidth. } + { ATTENTION: Input value 'MaxWidth' is a width for display. } + { ATTENTION: Returned value is a length of bytes. } + { ATTENTION: In CJK, there are many charctors, one charactor have double size for one ANK charactor and data length is 3 or 4 bytes. } +var + MaxLen: Integer; + len: Integer; + TrimedWidth: Integer; +begin + MaxLen := Length(S); + TrimedWidth := 0; + MBCharTrimedLength := 0; + + while (MBCharTrimedLength < MaxLen) and (TrimedWidth < MaxWidth) do begin + len := LengthMBChar( S[MBCharTrimedLength +1] ); + if 0 < len then begin + if ((TrimedWidth + 2) <= MaxWidth) then begin + TrimedWidth := TrimedWidth + 2; + MBCharTrimedLength := MBCharTrimedLength + len; + end else begin + break; + end; + end else begin + Inc(TrimedWidth); + Inc(MBCharTrimedLength); + end; + end; +end; +{$ENDIF PATCH_I18N} + + +{$IFDEF PATCH_I18N} +Function ExtractWord(var S: String; var SpaceDeleted,WordIsI18N: Boolean ): String; + {Extract the next word from string S.} + {Return this substring as the function's result;} + {truncate S so that it is now the remainder of the string.} + {If there is no word to extract, both S and the function} + {result will be set to empty strings.} + { BUGS - None found.} +var +{$IFDEF PATCH_I18N} + Len: Integer; + P, P2: Integer; + I: Integer; + it: String; +{$ELSE PATCH_I18N} + P: Integer; + it: String; +{$ENDIF PATCH_I18N} +begin + {To start the process, strip all whitespace from the} + {beginning of the string.} +{$IFDEF PATCH_I18N} + SpaceDeleted := DeleteWhiteSpace(S); + WordIsI18N := False; +{$ELSE PATCH_I18N} + DeleteWhiteSpace(S); +{$ENDIF PATCH_I18N} + + {Error check- make sure that we have something left to} + {extract! The string could have been nothing but white space.} + if S <> '' then begin + + {Determine the position of the next whitespace.} +{$IFDEF PATCH_I18N} + if IsMBCharLeadByte(S[1]) then begin + { When a function parse KANJI string, } + { it is difficult to determine pauses of words. } + { Therefore, this function return } + { only one KANJI character. } + len := LengthMBChar( S[1] ); + if (len <= Length(S)) then begin + it := Copy(S,1,len); + S := Copy(S,1+len,Length(S)-len); + end else begin + // May be bug. + it := Copy(S,1,Length(S)); + S := ''; + end; + WordIsI18N := true; + end else begin + P := Pos(' ',S); + P2 := Pos(#9,S); + if (0 = P) or ((0 < P2) and (P2 < P)) then P := P2; + + if 0 < P then Len := P - 1 + else Len := Length(S); + + for I := 1 to Len do begin + if IsMBCharLeadByte(S[I]) then begin + P := I; + break; + end; + end; + + {Extract the command.} + if P <> 0 then begin + it := Copy(S,1,P-1); + S := Copy(S,P,Length(S)-P+1); + end else begin + it := Copy(S,1,Length(S)); + S := ''; + end; + end; +{$ELSE PATCH_I18N} + P := Pos(' ',S); + if P = 0 then P := Pos(#9,S); + + {Extract the command.} + if P <> 0 then begin + it := Copy(S,1,P-1); + S := Copy(S,P,Length(S)); + end else begin + it := Copy(S,1,Length(S)); + S := ''; + end; +{$ENDIF PATCH_I18N} + + end else begin + it := ''; + end; + + ExtractWord := it; end; +{$ENDIF PATCH_I18N} Function ExtractWord(var S: String): String; {Extract the next word from string S.} @@ -96,8 +1264,15 @@ Function ExtractWord(var S: String): Str {result will be set to empty strings.} { BUGS - None found.} var +{$IFDEF PATCH_I18N} + Len: Integer; + P, P2: Integer; + I: Integer; + it: String; +{$ELSE PATCH_I18N} P: Integer; it: String; +{$ENDIF PATCH_I18N} begin {To start the process, strip all whitespace from the} {beginning of the string.} @@ -108,6 +1283,49 @@ begin if S <> '' then begin {Determine the position of the next whitespace.} +{$IFDEF PATCH_I18N} + if IsMBCharLeadByte(S[1]) then begin + { When a function parse KANJI string, } + { it is difficult to determine pauses of words. } + { Therefore, this function return } + { from start of KANJI string to end of KANJI string. } + P := 1; + repeat + len := LengthMBChar( S[P] ); + P := P + len; + until (P > Length(S)) or not(IsMBCharLeadByte(S[P])); + if P <= Length(S) then begin + it := Copy(S,1,P-1); + S := Copy(S,P,Length(S)-P+1); + end else begin + it := Copy(S,1,Length(S)); + S := ''; + end; + end else begin + P := Pos(' ',S); + P2 := Pos(#9,S); + if (0 = P) or ((0 < P2) and (P2 < P)) then P := P2; + + if 0 < P then Len := P - 1 + else Len := Length(S); + + for I := 1 to Len do begin + if IsMBCharLeadByte(S[I]) then begin + P := I; + break; + end; + end; + + {Extract the command.} + if P <> 0 then begin + it := Copy(S,1,P-1); + S := Copy(S,P,Length(S)-P+1); + end else begin + it := Copy(S,1,Length(S)); + S := ''; + end; + end; +{$ELSE PATCH_I18N} P := Pos(' ',S); if P = 0 then P := Pos(#9,S); @@ -119,6 +1337,7 @@ begin it := Copy(S,1,Length(S)); S := ''; end; +{$ENDIF PATCH_I18N} end else begin it := ''; @@ -141,6 +1360,35 @@ begin ExtractValue := it; end; +{$IFDEF PATCH_EXTRACTTF} +Function ExtractTF(var S: String): Boolean; +var + S2: String; +begin + S2 := UpCase(ExtractWord(S)); + + if '' = S2 then Exit(True); + + if 'TRUE' = S2 then Exit(True); + if 'FALSE' = S2 then Exit(False); + if 'T' = S2[1] then Exit(True); + if 'F' = S2[1] then Exit(False); + + if 'YES' = S2 then Exit(True); + if 'NO' = S2 then Exit(False); + if 'Y' = S2[1] then Exit(True); + if 'N' = S2[1] then Exit(False); + + if '-1' = S2 then Exit(True); + if '1' = S2 then Exit(True); + if '0' = S2 then Exit(False); + + ExtractTF := False; +end; +{$ENDIF PATCH_EXTRACTTF} + +{$IFDEF PATCH_GH} +{$ELSE PATCH_GH} Function RetrieveAString(const S: String): String; {Retrieve an Alligator String from S.} {Alligator Strings are defined as the part of the string} @@ -162,6 +1410,7 @@ begin RetrieveAString := Copy(S,A1+1,A2-A1-1); end; +{$ENDIF PATCH_GH} Function RetrieveAPreamble( const S: String ): String; { Usually an alligator string will have some kind of label in } @@ -210,7 +1459,11 @@ var msg: String; begin msg := BStr( Abs( N ) ); +{$IFDEF PATCH_I18N} + while WidthMBCharStr( msg ) < Width do msg := '0' + msg; +{$ELSE PATCH_I18N} while Length( msg ) < Width do msg := '0' + msg; +{$ENDIF PATCH_I18N} if N < 0 then msg := '-' + msg; WideStr := msg; end; @@ -248,7 +1501,11 @@ begin if Length( A ) > NumPlaces then begin A := Copy( A , 1 , NumPlaces ); end else if Length( A ) < NumPlaces then begin +{$IFDEF PATCH_I18N} + while WidthMBCharStr( A ) < NumPlaces do A := A + ' '; +{$ELSE PATCH_I18N} while Length( A ) < NumPlaces do A := A + ' '; +{$ENDIF PATCH_I18N} end; Acronym := A; @@ -309,6 +1566,26 @@ begin AStringHasBString := Pos( UpCase( B ) , UpCase( A ) ) > 0; end; +{$IFDEF PATCH_GH} +Function AStringHasBStringNum( const A,B: String ): Integer; +var + p: Integer; + l: Integer; + s: String; + n: Integer; +begin + p := Pos( UpCase( B ) , UpCase( A ) ); + if ( p <= 0 ) then exit( 0 ); + l := p + length( B ); + if ( length( A ) <= l ) then exit( 0 ); + s := Copy( A , ( l + 1 ), length( A ) - l ); + s := ExtractWord( s ); + if ( Pos( Copy( S , 1 , 1 ) , '-0123456789' ) <= 0 ) then exit( 0 ); + n := StrToInt( s ); + AStringHasBStringNum := n; +end; +{$ENDIF PATCH_GH} + Function HeadMatchesString( const H,S: String ): Boolean; { Return TRUE if the beginning characters of S are H. } var @@ -356,6 +1633,59 @@ begin until N = 0; end; +{$IFDEF PATCH_I18N} +Function ReplaceHash( const msg, S1, S2, S3, S4: String ): String; +var + MaxLen: Integer; + P: Integer; + len: Integer; + msg_out: String; + tmp: String; +begin + MaxLen := Length( msg ); + P := 1; + msg_out := ''; + while (P <= MaxLen) do begin + len := LengthMBChar( msg[P] ); + if 0 < len then begin + msg_out := msg_out + Copy( msg, P, len ); + P := P + len; + end else if ('#' = msg[P]) and (P+1 <= MaxLen) then begin + case msg[P+1] of + '1': tmp := S1; + '2': tmp := S2; + '3': tmp := S3; + '4': tmp := S4; + else tmp := ''; + end; + if 0 < Length(tmp) then begin + if #$0 <> tmp[1] then begin + msg_out := msg_out + tmp; + end; + P := P + 2; + end else begin + msg_out := msg_out + msg[P]; + Inc(P); + end; + end else begin + msg_out := msg_out + msg[P]; + Inc(P); + end; + end; + ReplaceHash := msg_out; +end; + +Function ReplaceHash( const msg, S1, S2, S3: String ): String; +begin + ReplaceHash := ReplaceHash( msg, S1, S2, S3, '' ); +end; + +Function ReplaceHash( const msg, S1, S2: String ): String; +begin + ReplaceHash := ReplaceHash( msg, S1, S2, '', '' ); +end; +{$ENDIF PATCH_I18N} + Function ReplaceHash( const msg,s: String ): String; { Look for a hash sign in MSG. Replace it with S. } var @@ -371,4 +1701,20 @@ begin ReplaceHash := msg_out; end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: textutil.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: textutil.pp(finalization)'); +{$ENDIF DEBUG} +end; + end. diff -x .svn -uprN GearHead1100repository.original/ui4gh.pp branches/ui4gh.pp --- GearHead1100repository.original/ui4gh.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/ui4gh.pp 2016-03-18 09:01:00.000000000 +0900 @@ -26,12 +26,34 @@ unit ui4gh; interface +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} +uses SDL; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} + type KeyMapDesc = Record CmdName,CmdDesc: String; KCode: Char; end; +{$IFDEF PATCH_GH} + KeyMapAliasDesc = Record + CmdAlias: String; + CmdName: String; + end; +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} + FontSearchNameDesc = Record + FontFile: String; + FontFace: Integer; + FontSize: Integer; + end; + PFontSearchNameDesc = ^FontSearchNameDesc; +{$ENDIF PATCH_I18N} + const {$IFDEF SDLMODE} RPK_UpRight = #$89; @@ -45,6 +67,10 @@ const RPK_MouseButton = #$90; RPK_TimeEvent = #$91; RPK_RightButton = #$92; + {$IFDEF PATCH_GH} + RPK_MouseButtonRelease = #$93; + RPK_MouseMotion = #$94; + {$ENDIF PATCH_GH} FrameDelay: Integer = 50; {$ELSE} @@ -65,6 +91,7 @@ const ControlMethod: Byte = MenuBasedInput; CharacterMethod: Byte = RLBasedInput; WorldMapMethod: Byte = RLBasedInput; + { PATCH_I18N: Converted by Load_I18N_Default } ControlTypeName: Array [0..1] of string = ('Menu','Roguelike'); DoFullScreen: Boolean = False; @@ -85,6 +112,7 @@ const DefMissileBV: Byte = BV_Quarter; DefBallisticBV: Byte = BV_Max; DefBeamgunBV: Byte = BV_Max; + { PATCH_I18N: Converted by Load_I18N_Default } BVTypeName: Array [1..4] of string = ('Off','1/4','1/2','Max'); DoAutoSave: Boolean = True; @@ -97,7 +125,7 @@ const Max_Plots_Per_Adventure: Byte = 50; Load_Plots_At_Start: Boolean = False; - Display_Mini_Map: Boolean = FaLSE; + Display_Mini_Map: Boolean = False; UseTacticsMode: Boolean = False; @@ -107,8 +135,37 @@ const ScreenRows: Byte = 25; ScreenColumns: Byte = 80; - - NumMappedKeys = 47; +{$IFDEF PATCH_GH} + Direct_Skill_Learning: Boolean = False; +{$ENDIF PATCH_GH} + + +{$IFDEF ENABLE_ADDRESSBOOK} + NumMappedKeys_ADDRESSBOOK = 1; +{$ELSE ENABLE_ADDRESSBOOK} + NumMappedKeys_ADDRESSBOOK = 0; +{$ENDIF ENABLE_ADDRESSBOOK} +{$IFDEF PATCH_JPSSDL} + NumMappedKeys_JPSSDL = 1; +{$ELSE PATCH_JPSSDL} + NumMappedKeys_JPSSDL = 0; +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_GH} + NumMappedKeys_GH = 17; +{$ELSE PATCH_GH} + NumMappedKeys_GH = 0; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + NumMappedKeys_CHEAT = 5; +{$ELSE PATCH_CHEAT} + NumMappedKeys_CHEAT = 0; +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + NumMappedKeys_DEBUG = 1; +{$ELSE DEBUG} + NumMappedKeys_DEBUG = 0; +{$ENDIF DEBUG} + NumMappedKeys = 47 + NumMappedKeys_ADDRESSBOOK + NumMappedKeys_JPSSDL + NumMappedKeys_GH + NumMappedKeys_CHEAT + NumMappedKeys_DEBUG; KeyMap: Array [1..NumMappedKeys] of KeyMapDesc = ( ( CmdName: 'NormSpeed'; CmdDesc: 'Travel foreword at normal speed.'; @@ -154,7 +211,7 @@ const ( CmdName: 'Dir-NorthEast'; CmdDesc: 'Move northeast.'; KCode: RPK_Right; ), -{$ELSE} +{$ELSE SDLMODE} ( CmdName: 'Dir-SouthWest'; CmdDesc: 'Move southwest.'; KCode: RPK_DownLeft; ), @@ -180,7 +237,7 @@ const ( CmdName: 'Dir-NorthEast'; CmdDesc: 'Move northeast.'; KCode: RPK_UpRight; ), -{$ENDIF} +{$ENDIF SDLMODE} ( CmdName: 'ShiftGears'; CmdDesc: 'Change movement mode.'; @@ -297,7 +354,137 @@ const CmdDesc: 'Toggle running on or off.'; KCode: 'r'; ) +{$IFDEF ENABLE_ADDRESSBOOK} + , + ( CmdName: 'AddressBook'; + CmdDesc: 'Use AddressBook.'; + KCode: 'b'; ) +{$ENDIF ENABLE_ADDRESSBOOK} +{$IFDEF PATCH_JPSSDL} + , + ( CmdName: 'ToggleDrawWall'; + CmdDesc: 'Toggle Draw Wall.'; + KCode: '0'; ) +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_GH} + , + ( CmdName: 'ForcePlot'; + CmdDesc: ''; + KCode: 'P'; ) + , + ( CmdName: 'MechaPartBrowser'; + CmdDesc: ''; + KCode: '!'; ) + , + ( CmdName: 'ShowRep'; + CmdDesc: ''; + KCode: '@'; ) + , + ( CmdName: 'DirectScript'; + CmdDesc: ''; + KCode: '#'; ) + , + ( CmdName: 'WheelClick'; + CmdDesc: 'Do the key event when a mouse wheel is clicked.'; + KCode: '5'; ) + , + ( CmdName: 'WheelUp'; + CmdDesc: 'Do the key event when a mouse wheel is rolled to up.'; + KCode: '['; ) + , + ( CmdName: 'WheelDown'; + CmdDesc: 'Do the key event when a mouse wheel is rolled to down.'; + KCode: ']'; ) + , + ( CmdName: 'WheelLeft'; + CmdDesc: 'Do the key event when a mouse wheel is rolled to left.'; + KCode: '-'; ) + , + ( CmdName: 'WheelRight'; + CmdDesc: 'Do the key event when a mouse wheel is rolled to right.'; + KCode: '='; ) + , + ( CmdName: 'Menu-Up'; + CmdDesc: 'Move up.'; + KCode: RPK_Up; ), + ( CmdName: 'Menu-Down'; + CmdDesc: 'Move down.'; + KCode: RPK_Down; ), + ( CmdName: 'Menu-Left'; + CmdDesc: 'Move left.'; + KCode: RPK_Left; ), + ( CmdName: 'Menu-Right'; + CmdDesc: 'Move right.'; + KCode: RPK_Right; ), + ( CmdName: 'Menu-PageUp'; + CmdDesc: 'Page up.'; + KCode: RPK_UpRight; ), + ( CmdName: 'Menu-PageDown'; + CmdDesc: 'Page down.'; + KCode: RPK_DownRight; ), + ( CmdName: 'Menu-ScrollUp'; + CmdDesc: 'Scroll Up.'; + KCode: RPK_UpLeft; ), + ( CmdName: 'Menu-ScrollDown'; + CmdDesc: 'Scroll down.'; + KCode: RPK_DownLeft; ) +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + , + ( CmdName: 'SelectPortrait'; + CmdDesc: ''; + KCode: '/'; ) + , + ( CmdName: 'RenameMecha'; + CmdDesc: ''; + KCode: '@'; ) + , + ( CmdName: 'EditMenuOrder'; + CmdDesc: ''; + KCode: '\'; ) + , + ( CmdName: 'Transformation'; + CmdDesc: 'Change form mode.'; + KCode: '*'; ) + , + ( CmdName: 'PurgeParts'; + CmdDesc: 'Purge parts form mecha.'; + KCode: '*'; ) +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + , + ( CmdName: 'CanSeeAll'; + CmdDesc: ''; + KCode: '~'; ) +{$ENDIF DEBUG} + ); + +{$IFDEF PATCH_GH} + KeyMapAliasMax = 9; + + KeyMapAlias: Array [1..KeyMapAliasMax] of KeyMapAliasDesc = ( + {$IFDEF SDLMODE} + ( CmdAlias: 'Dir-UpLeft'; CmdName: 'Dir-West'; ), + ( CmdAlias: 'Dir-Up'; CmdName: 'Dir-NorthWest'; ), + ( CmdAlias: 'Dir-UpRight'; CmdName: 'Dir-North'; ), + ( CmdAlias: 'Dir-Left'; CmdName: 'Dir-SouthWest'; ), + ( CmdAlias: 'Dir-Right'; CmdName: 'Dir-NorthEast'; ), + ( CmdAlias: 'Dir-DownLeft'; CmdName: 'Dir-South'; ), + ( CmdAlias: 'Dir-Down'; CmdName: 'Dir-SouthEast'; ), + ( CmdAlias: 'Dir-DownRight'; CmdName: 'Dir-East'; ), + {$ELSE SDLMODE} + ( CmdAlias: 'Dir-UpLeft'; CmdName: 'Dir-NorthWest'; ), + ( CmdAlias: 'Dir-Up'; CmdName: 'Dir-North'; ), + ( CmdAlias: 'Dir-UpRight'; CmdName: 'Dir-NorthEast'; ), + ( CmdAlias: 'Dir-Left'; CmdName: 'Dir-West'; ), + ( CmdAlias: 'Dir-Right'; CmdName: 'Dir-East'; ), + ( CmdAlias: 'Dir-DownLeft'; CmdName: 'Dir-SouthWest'; ), + ( CmdAlias: 'Dir-Down'; CmdName: 'Dir-South'; ), + ( CmdAlias: 'Dir-DownRight'; CmdName: 'Dir-SouthEast'; ), + {$ENDIF SDLMODE} + ( CmdAlias: ''; CmdName: ''; ) ); +{$ENDIF PATCH_GH} { *** KEYMAP COMMAND NUMBERS *** } KMC_NormSpeed = 1; @@ -313,6 +500,27 @@ const KMC_NorthWest = 11; KMC_North = 12; KMC_NorthEast = 13; +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + KMC_UpLeft = 9; + KMC_Up = 11; + KMC_UpRight = 12; + KMC_Left = 6; + KMC_Right = 13; + KMC_DownLeft = 7; + KMC_Down = 8; + KMC_DownRight = 10; + {$ELSE SDLMODE} + KMC_UpLeft = 11; + KMC_Up = 12; + KMC_UpRight = 13; + KMC_Left = 9; + KMC_Right = 10; + KMC_DownLeft = 6; + KMC_Down = 7; + KMC_DownRight = 8; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} KMC_ShiftGears = 14; KMC_ExamineMap = 15; KMC_AttackMenu = 16; @@ -347,10 +555,668 @@ const KMC_Reverse = 45; KMC_SwitchTarget = 46; KMC_RunToggle = 47; +{$IFDEF ENABLE_ADDRESSBOOK} + KMC_AddressBook = KMC_RunToggle + 1; + KMC_AddressBook_NEXT = KMC_RunToggle + 2; +{$ELSE ENABLE_ADDRESSBOOK} + KMC_AddressBook_NEXT = KMC_RunToggle + 1; +{$ENDIF ENABLE_ADDRESSBOOK} +{$IFDEF PATCH_JPSSDL} + KMC_ToggleDrawWall = KMC_AddressBook_NEXT; + KMC_ToggleDrawWall_NEXT = KMC_AddressBook_NEXT + 1; +{$ELSE PATCH_JPSSDL} + KMC_ToggleDrawWall_NEXT = KMC_AddressBook_NEXT; +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_GH} + KMC_ForcePlot = KMC_ToggleDrawWall_NEXT; + KMC_MechaPartBrowser = KMC_ToggleDrawWall_NEXT + 1; + KMC_ShowRep = KMC_ToggleDrawWall_NEXT + 2; + KMC_DirectScript = KMC_ToggleDrawWall_NEXT + 3; + KMC_ButtonMiddle = KMC_ToggleDrawWall_NEXT + 4; + KMC_ButtonWUp = KMC_ToggleDrawWall_NEXT + 5; + KMC_ButtonWDown = KMC_ToggleDrawWall_NEXT + 6; + KMC_ButtonWLeft = KMC_ToggleDrawWall_NEXT + 7; + KMC_ButtonWRight = KMC_ToggleDrawWall_NEXT + 8; + KMC_MenuUp = KMC_ToggleDrawWall_NEXT + 9; + KMC_MenuDown = KMC_ToggleDrawWall_NEXT + 10; + KMC_MenuLeft = KMC_ToggleDrawWall_NEXT + 11; + KMC_MenuRight = KMC_ToggleDrawWall_NEXT + 12; + KMC_PageUp = KMC_ToggleDrawWall_NEXT + 13; + KMC_PageDown = KMC_ToggleDrawWall_NEXT + 14; + KMC_ScrollUp = KMC_ToggleDrawWall_NEXT + 15; + KMC_ScrollDown = KMC_ToggleDrawWall_NEXT + 16; + KMC_PATCH_GH_NEXT = KMC_ToggleDrawWall_NEXT + 17; +{$ELSE PATCH_GH} + KMC_PATCH_GH_NEXT = KMC_ToggleDrawWall_NEXT; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + KMC_SelectPortrait = KMC_PATCH_GH_NEXT; + KMC_RenameMecha = KMC_PATCH_GH_NEXT + 1; + KMC_EditMenuOrder = KMC_PATCH_GH_NEXT + 2; + KMC_Transformation = KMC_PATCH_GH_NEXT + 3; + KMC_PurgeParts = KMC_PATCH_GH_NEXT + 4; + KMC_PATCH_CHEAT_NEXT = KMC_PATCH_GH_NEXT + 5; +{$ELSE PATCH_CHEAT} + KMC_PATCH_CHEAT_NEXT = KMC_PATCH_GH_NEXT; +{$ENDIF PATCH_CHEAT} +{$IFDEF DEBUG} + KMC_CanSeeAll = KMC_PATCH_CHEAT_NEXT; + KMC_DEBUG_NEXT = KMC_PATCH_CHEAT_NEXT + 1; +{$ELSE DEBUG} + KMC_DEBUG_NEXT = KMC_PATCH_CHEAT_NEXT; +{$ENDIF DEBUG} + +{$IFDEF PATCH_I18N} + {$IFDEF UNIX} + MaxFontSearchDirNum = 7; + FontSearchDir: Array [1..MaxFontSearchDirNum] of String = ( + '', { Read from arena.cfg } + 'Image', { default directory } + '', { current directory } + {$IFDEF FONTFILE_USR_X11R6} + '/usr/X11R6/lib/X11/fonts/TrueType', { FreeBSD 6.2 and before, some Distribution of GNU/Linux } + {$DEFINE _FONTDIR_2} + {$ENDIF} + {$IFDEF FONTFILE_USR_LOCAL} + '/usr/local/lib/X11/fonts/TrueType', { FreeBSD 6.3 and later } + {$DEFINE _FONTDIR_2} + {$ENDIF} + {$IFDEF FONTFILE_USR_SHARE} + '/usr/share/fonts/truetype/sazanami', { Debian GNU/Linux } + {$DEFINE _FONTDIR_2} + {$ENDIF} + {$IFNDEF _FONTDIR_2} + '', + {$ENDIF _FONTDIR_2} + '/usr/X11R6/lib/X11/fonts/TrueType', { FreeBSD 6.2 and before, some Distribution of GNU/Linux } + '/usr/local/lib/X11/fonts/TrueType', { FreeBSD 6.3 and later } + '/usr/share/fonts/truetype/sazanami' { Debian GNU/Linux } + ); + MaxFontSearchNameNum = 11; + FontSearchName_Big: Array [1..MaxFontSearchNameNum] of FontSearchNameDesc = ( + ( { Read from arena.cfg } + FontFile: ''; + FontFace: 0; + FontSize: 14; + ), ( { Read from GameData/I18N_messages.txt } + FontFile: ''; + FontFace: 0; + FontSize: 14; + ), ( { Normal Font, 1 } + FontFile: 'sazanami-gothic.ttf'; + FontFace: 0; + FontSize: 14; + ), ( { Normal Font, 2 } + FontFile: 'sazanami-mincho.ttf'; + FontFace: 0; + FontSize: 14; + ), ( { Normal Font, 3 } + FontFile: 'ipag.ttf'; + FontFace: 0; + FontSize: 14; + ), ( { Normal Font, 4 } + FontFile: 'ipam.ttf'; + FontFace: 0; + FontSize: 14; + ), ( { Normal Font, 5 } + FontFile: 'kochi-gothic-subst.ttf'; + FontFace: 0; + FontSize: 14; + ), ( { Normal Font, 6 } + FontFile: 'kochi-mincho-subst.ttf'; + FontFace: 0; + FontSize: 14; + ), ( { Normal Font, 7 } + FontFile: 'kochi-gothic.ttf'; + FontFace: 0; + FontSize: 14; + ), ( { Normal Font, 8 } + FontFile: 'kochi-mincho.ttf'; + FontFace: 0; + FontSize: 14; + ), ( { Default font } + FontFile: 'VeraBd.ttf'; + FontFace: 0; + FontSize: 14; + ) + ); + FontSearchName_Small: Array [1..MaxFontSearchNameNum] of FontSearchNameDesc = ( + ( { Read from arena.cfg } + FontFile: ''; + FontFace: 0; + FontSize: 11; + ), ( { Read from GameData/I18N_messages.txt } + FontFile: ''; + FontFace: 0; + FontSize: 11; + ), ( { Normal Font, 1 } + FontFile: 'sazanami-gothic.ttf'; + FontFace: 0; + FontSize: 12; + ), ( { Normal Font, 2 } + FontFile: 'sazanami-mincho.ttf'; + FontFace: 0; + FontSize: 12; + ), ( { Normal Font, 3 } + FontFile: 'ipag.ttf'; + FontFace: 0; + FontSize: 12; + ), ( { Normal Font, 4 } + FontFile: 'ipam.ttf'; + FontFace: 0; + FontSize: 12; + ), ( { Normal Font, 5 } + FontFile: 'kochi-gothic-subst.ttf'; + FontFace: 0; + FontSize: 12; + ), ( { Normal Font, 6 } + FontFile: 'kochi-mincho-subst.ttf'; + FontFace: 0; + FontSize: 12; + ), ( { Normal Font, 7 } + FontFile: 'kochi-gothic.ttf'; + FontFace: 0; + FontSize: 12; + ), ( { Normal Font, 8 } + FontFile: 'kochi-mincho.ttf'; + FontFace: 0; + FontSize: 12; + ), ( { Default font } + FontFile: 'VeraMoBd.ttf'; + FontFace: 0; + FontSize: 11; + ) + ); + {$DEFINE _FONTSEARCH_} + {$ENDIF UNIX} + {$IFDEF Windows} + MaxFontSearchDirNum = 6; + FontSearchDir: Array [1..MaxFontSearchDirNum] of String = ( + '', { Read from arena.cfg } + 'Image', { default directory } + '', { current directory } + '', { Read environment %windir% or %SystemRoot% } + 'C:\WINDOWS\Fonts', { MS-Windows XP } + 'C:\WINNT\Fonts' { MS-Windows 2000 } + ); + MaxFontSearchNameNum = 6; + FontSearchName_Big: Array [1..MaxFontSearchNameNum] of FontSearchNameDesc = ( + ( { Read from arena.cfg } + FontFile: ''; + FontFace: 0; + FontSize: 15; + ), ( { Read from GameData/I18N_messages.txt } + FontFile: ''; + FontFace: 0; + FontSize: 14; + ), ( { Normal Font, 1 } + FontFile: 'meiryo.ttc'; + FontFace: 0; + FontSize: 15; + ), ( { Normal Font, 2 } + FontFile: 'msgothic.ttc'; + FontFace: 0; + FontSize: 15; + ), ( { Normal Font, 3 } + FontFile: 'msmincho.ttc'; + FontFace: 0; + FontSize: 15; + ), ( { Default font } + FontFile: 'VeraBd.ttf'; + FontFace: 0; + FontSize: 14; + ) + ); + FontSearchName_Small: Array [1..MaxFontSearchNameNum] of FontSearchNameDesc = ( + ( { Read from arena.cfg } + FontFile: ''; + FontFace: 0; + FontSize: 13; + ), ( { Read from GameData/I18N_messages.txt } + FontFile: ''; + FontFace: 0; + FontSize: 11; + ), ( { Normal Font, 1 } + FontFile: 'meiryo.ttc'; + FontFace: 0; + FontSize: 13; + ), ( { Normal Font, 2 } + FontFile: 'msgothic.ttc'; + FontFace: 0; + FontSize: 13; + ), ( { Normal Font, 3 } + FontFile: 'msmincho.ttc'; + FontFace: 0; + FontSize: 13; + ), ( { Default font } + FontFile: 'VeraMoBd.ttf'; + FontFace: 0; + FontSize: 11; + ) + ); + {$DEFINE _FONTSEARCH_} + {$ENDIF Windows} + {$IFNDEF _FONTSEARCH_} + MaxFontSearchDirNum = 3; + FontSearchDir: Array [1..MaxFontSearchDirNum] of String = ( + '', { Read from arena.cfg } + 'Image', { default directory } + '' { current directory } + ); + MaxFontSearchNameNum = 3; + FontSearchName_Big: Array [1..MaxFontSearchNameNum] of FontSearchNameDesc = ( + ( { Read from arena.cfg } + FontFile: ''; + FontFace: 0; + FontSize: 14; + ), ( { Read from GameData/I18N_messages.txt } + FontFile: ''; + FontFace: 0; + FontSize: 14; + ), ( { Default font } + FontFile: 'VeraBd.ttf'; + FontFace: 0; + FontSize: 14; + ) + ); + FontSearchName_Small: Array [1..MaxFontSearchNameNum] of FontSearchNameDesc = ( + ( { Read from arena.cfg } + FontFile: ''; + FontFace: 0; + FontSize: 11; + ), ( { Read from GameData/I18N_messages.txt } + FontFile: ''; + FontFace: 0; + FontSize: 11; + ), ( { Default font } + FontFile: 'VeraMoBd.ttf'; + FontFace: 0; + FontSize: 11; + ) + ); + {$DEFINE _FONTSEARCH_} + {$ENDIF _FONTSEARCH_} + + FontSize_Big: Integer = 0; + FontSize_Small: Integer = 0; + { PATCH_I18N: Converted by Load_I18N_Default } + ProhibitationHead : String = '! ) , . > ? ] }'; + ProhibitationTrail : String = '( < [ {'; +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_I18N} + I18N_UseNameORG : Boolean = False; +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_JPSSDL} + Pad_Left : Integer = 0; + Pad_Top : Integer = 0; + SkipAnim : Boolean = False; + DrawWallMode : Integer = 1; +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_GH} + SDL_NoTimeEvent : Boolean = False; + FrameSkip : Boolean = True; + FrameInterval : Integer = 33; + SleepGranularity : Integer = 0; + KeysamplingInterval : Integer = 11; + SDL_Mini : Boolean = False; + ScreenPos_X: Integer = -1; + ScreenPos_Y: Integer = -1; + ScreenSize_Width : Integer = 0; + ScreenSize_Height : Integer = 0; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + {$IFDEF SDLMODE} + SDL_AAFont : Boolean = False; + SDL_AAFont_Shaded : Boolean = False; + {$ENDIF SDLMODE} +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} + { for Color Barrier Free } + Avocado: TSDL_Color = ( r:136; g:141; b:101 ); + Bacardi: TSDL_Color = ( r:121; g:105; b:137 ); + Jade: TSDL_Color = ( r: 66; g:121; b:119 ); + BrightJade: TSDL_Color = ( r:100; g:200; b:180 ); + {} + StdBlack: TSDL_Color = ( r: 0; g: 0; b: 0 ); + StdWhite: TSDL_Color = ( r:255; g:255; b:255 ); + MenuItem: TSDL_Color = ( r: 66; g:121; b:119 ); + MenuSelect: TSDL_Color = ( r:100; g:200; b:180 ); + TerrainGreen: TSDL_Color = ( r:100; g:210; b: 0 ); + PlayerBlue: TSDL_Color = ( r: 0; g:141; b:211 ); + AllyPurple: TSDL_Color = ( r:236; g: 0; b:211 ); + EnemyRed: TSDL_Color = ( r:230; g: 0; b: 0 ); + NeutralGrey: TSDL_Color = ( r:150; g:150; b:150 ); + DarkGrey: TSDL_Color = ( r:100; g:100; b:100 ); + InfoGreen: TSDL_Color = ( r: 0; g:141; b: 0 ); + InfoHiLight: TSDL_Color = ( r: 0; g:210; b: 0 ); + TextboxGrey: TSDL_Color = ( r:130; g:120; b:125 ); + NeutralBrown: TSDL_Color = ( r:240; g:201; b: 20 ); + BorderBlue: TSDL_Color = ( r: 0; g:101; b:151 ); + BrightYellow: TSDL_Color = ( r:255; g:201; b: 0 ); + { sdlinfo.pp } + StatusPerfect:TSDL_Color = ( r: 0; g:255; b: 65 ); + StatusOK:TSDL_Color = ( r: 30; g:190; b: 10 ); + StatusFair:TSDL_Color = ( r:220; g:190; b: 0 ); + StatusBad:TSDL_Color = ( r:220; g: 50; b: 0 ); + StatusCritical:TSDL_Color = ( r:150; g: 0; b: 0 ); + StatusKO:TSDL_Color = ( r: 75; g: 75; b: 75 ); + {$ENDIF SDLMODE} + MaxSDLColors_Str = 64; + SDL_colors_TeamColor_Character_DefPlayerTeam : Array [0..MaxSDLColors_Str] of Char = '66 121 179 255 212 195 205 25 0'; + SDL_colors_TeamColor_Character_Enemies : Array [0..MaxSDLColors_Str] of Char = '180 10 120 255 212 195 170 205 75'; + SDL_colors_TeamColor_Character_Allies : Array [0..MaxSDLColors_Str] of Char = '66 121 119 255 212 195 0 205 0'; + SDL_colors_TeamColor_Character_Others : Array [0..MaxSDLColors_Str] of Char = '175 175 171 255 212 195 0 200 200'; + SDL_colors_TeamColor_Mecha_DefPlayerTeam : Array [0..MaxSDLColors_Str] of Char = '66 121 179 210 215 80 205 25 0'; + SDL_colors_TeamColor_Mecha_Enemies : Array [0..MaxSDLColors_Str] of Char = '180 10 120 125 125 125 170 205 75'; + SDL_colors_TeamColor_Mecha_Allies : Array [0..MaxSDLColors_Str] of Char = '66 121 119 190 190 190 0 205 0'; + SDL_colors_TeamColor_Mecha_Others : Array [0..MaxSDLColors_Str] of Char = '175 175 171 100 100 120 0 200 200'; + SDL_colors_RobotCreate : Array [0..MaxSDLColors_Str] of Char = '80 80 85 170 155 230 6 42 120'; + SDL_colors_CharacterCreate : Array [0..MaxSDLColors_Str] of Char = '49 91 161 252 212 195 150 112 89'; + {$IFDEF SDLMODE} + Enable_ArenaMode : Boolean = False; + Enable_EditMap : Boolean = False; + {$ELSE SDLMODE} + Enable_ArenaMode : Boolean = True; + Enable_EditMap : Boolean = True; + {$ENDIF SDLMODE} + Enable_PointAnimation : Boolean = False; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_l0ugh} + KeyBind_RogueMove: Boolean = False; +{$ENDIF PATCH_l0ugh} +{$IFDEF PATCH_GH} + SelectMenu_Scroll_by_Edge: Boolean = True; + Show_MenuScrollbar : Boolean = False; + {$IFDEF SDLMODE} + SDL_Show_MenuScrollbar : Boolean = False; + SDL_Scrollbar_Size : Integer = 12; + {$ENDIF SDLMODE} + Show_MenuPage : Boolean = False; + SelectMenu_UpDown_by_MouseWheel_UD: Boolean = False; + SelectMenu_UpDown_by_MouseWheel_UD_Reverse: Boolean = False; + SelectMenu_UpDown_by_MouseWheel_LR: Boolean = False; + SelectMenu_UpDown_by_MouseWheel_LR_Reverse: Boolean = False; + SelectMenu_Scroll_by_MouseWheel_UD: Boolean = True; + SelectMenu_Scroll_by_MouseWheel_UD_Reverse: Boolean = False; + SelectMenu_Scroll_by_MouseWheel_LR: Boolean = False; + SelectMenu_Scroll_by_MouseWheel_LR_Reverse: Boolean = False; + SelectMenu_ScrollPage_by_MouseWheel_UD: Boolean = False; + SelectMenu_ScrollPage_by_MouseWheel_UD_Reverse: Boolean = False; + SelectMenu_ScrollPage_by_MouseWheel_LR: Boolean = True; + SelectMenu_ScrollPage_by_MouseWheel_LR_Reverse: Boolean = False; + Cheat_DisplayGearInfo : Boolean = False; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + Cheat_Display : Boolean = False; + Cheat_Display_SW : Boolean = False; + Cheat_Display_DESIG : Boolean = False; + Cheat_Display_OverLoad : Boolean = False; + Cheat_Display_DamagePercent : Boolean = False; + Cheat_Display_SpeedoMeter : Boolean = False; + Cheat_Display_PV : Boolean = False; + Cheat_Print_TimeString : Boolean = False; + Cheat_Print_AttemptDefenses : Boolean = False; + Cheat_Print_AmmoExplosion : Boolean = False; + Cheat_Print_DoPillage : Boolean = False; + Cheat_Autosave_Trace : Boolean = False; + Cheat_Autosave_with_Timestamp : Boolean = False; + Cheat_MainMenu_AddMenuKey : Boolean = False; + Cheat_Restore_AddMenuKey : Boolean = False; + Cheat_Chat : Boolean = False; + Cheat_Chat_ReverseSort : Boolean = False; + Cheat_CallShot : Boolean = False; + Cheat_CallShot_Cancel : Boolean = False; + Cheat_CallShot_OmitLookInfo : Boolean = False; + Cheat_Range_Colored : Boolean = False; + Cheat_FindNextWeapon : Boolean = True; + Cheat_MenuOrder_Edit : Boolean = False; + Cheat_MechaPartBrowser_Delete : Boolean = False; + Cheat_RenameBackup : Boolean = False; + Cheat_NPC_Edit : Boolean = False; + Cheat_LookInfo : Boolean = False; + Cheat_Enable_Limit_SellingPrice : Boolean = False; + Cheat_BuyStuff_ShowSubItem : Boolean = False; + Cheat_BuyStuff_Mecha_ShowSubItem : Boolean = False; + Cheat_BuyStuff_Sort : Boolean = True; + Cheat_SellStuff_ShowSubItem : Boolean = False; + Cheat_SellStuff_Sort : Boolean = False; + Cheat_SellStuff_KeepPosition : Boolean = False; + Cheat_EqpMenu_AddMenuKey : Boolean = False; + Cheat_EqpMenu_KeepPosition : Boolean = False; + Cheat_EqpMenu_ShowSubItem : Boolean = False; + Cheat_EqpMenu_ShowMassMeter : Boolean = False; + Cheat_EqpMenu_ShowFullGearName : Boolean = False; + Cheat_InvMenu_KeepPosition : Boolean = False; + Cheat_InvMenu_ShowSubItem : Boolean = False; + Cheat_InvMenu_NoSort : Boolean = False; + Cheat_MechaDescription_ShowMassMeter : Boolean = False; + Cheat_MechaPartEditor_AddMenuKey : Boolean = True; + Cheat_MechaPartEditor_KeepPosition : Boolean = True; + Cheat_PCVIEW_AddMenuKey : Boolean = False; + Cheat_PCVIEW_KeepPosition : Boolean = False; + Cheat_PCVIEW_Training_AddMenuKey : Boolean = False; + Cheat_PCVIEW_Training_KeepPosition : Boolean = False; + Cheat_FieldHQ_Mecha_NoSort : Boolean = False; + Cheat_FieldHQ_Mecha_AddMenuKey : Boolean = False; + Cheat_FieldHQ_Mecha_KeepPosition : Boolean = False; + Cheat_FieldHQ_AddMenuKey : Boolean = False; + Cheat_InstallMisc_ShowParentItem : Boolean = False; + Cheat_EquipItem_ShowParentItem : Boolean = False; + Cheat_InstallMisc_ShowInvStr : Boolean = False; + Cheat_EquipItem_ShowInvStr : Boolean = False; + Cheat_InstallAmmo_ShowSubItem : Boolean = False; + Cheat_EquipItem_ShowSubItem : Boolean = False; + Cheat_Install_ShowSubItem : Boolean = False; + Cheat_InstallCyberware_ShowSubItem : Boolean = False; + Cheat_ExtendedDescription_ShowHighOutput : Boolean = False; + Cheat_GearName_AddScaleNumber : Boolean = False; + Cheat_GearName_AddClassNumber_GGModule : Boolean = False; + Cheat_GearName_AddClassNumber_GGMecha : Boolean = False; + Cheat_GearName_AddClassNumber_GGHolder : Boolean = False; + Cheat_GearName_AddClassNumber_GGSupport : Boolean = False; + Cheat_GearName_AddClassNumber_GGConsumable : Boolean = False; + Cheat_MechaCustomize_Limitless : Boolean = False; + Cheat_MechaCustomize_FreeSupport : Boolean = False; + Cheat_MechaCustomize_FreeCockpit : Boolean = False; + Cheat_MechaCustomize_FreeMasterGear : Boolean = False; + Cheat_MechaCustomize_FreeParent : Boolean = False; + Cheat_MechaCustomize_FreeScale : Boolean = False; + Cheat_MechaCustomize_FreeModifier : Boolean = False; + Cheat_MechaCustomize_FreeBodyModule : Boolean = False; + Cheat_Trade_NotSafeArea : Boolean = False; + Cheat_Roguelike_Death : Boolean = False; + Cheat_ArenaMode_MainMenu_AddMenuKey : Boolean = False; + Cheat_ArenaMode_PilotsMenu_AddMenuKey : Boolean = False; + Cheat_ArenaMode_MechaMenu_AddMenuKey : Boolean = False; + Cheat_ArenaMode_PilotsHQ_AddMenuKey : Boolean = False; + Cheat_ArenaMode_MechaHQ_AddMenuKey : Boolean = False; + Cheat_ArenaMode_AllRecoveryInHQ : Boolean = False; + Cheat_ArenaMode_InventoryInHQ : Boolean = False; + Cheat_ArenaMode_FieldHQInHQ : Boolean = False; + Cheat_ThisItemWasSelected_AddMenuKey : Boolean = False; + Cheat_EnableCockpitBarrier : Boolean = True; + Cheat_EnableCockpitBarrier_Hand : Boolean = True; + Cheat_DoNotRunWhenMouseClicked : Boolean = True; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_BACKPORT} + Backport_Caliber : Boolean = False; + Backport_Caliber_GH1Compatible : Boolean = True; +{$ENDIF PATCH_BACKPORT} +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} +{ DEBUG_MemoryLeak : Boolean = True; } + DEBUG_TraceMacro : Boolean = True; + DEBUG_Grabbed_Gear : Boolean = True; + DEBUG_SCRIPT_DynamicEncounter : Boolean = True; +{ DEBUG_DONOT_NIL_Grabbed_Gear_when_NewGear : Boolean = False; } +{ DEBUG_DONOT_NIL_Grabbed_Gear_when_DisposeGear : Boolean = False; } + DEBUG_DONOT_NIL_Grabbed_Gear_when_DelegeGG : Boolean = False; + DEBUG_DONOT_NIL_Grabbed_Gear_when_EndStory : Boolean = False; + DEBUG_DONOT_NIL_Grabbed_Gear_when_CleanupStoryPlots : Boolean = False; +{ DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_AbsolutelyNothing : Boolean = False; } +{ DEBUG_DONOT_NIL_Grabbed_Gear_when_Mark_GG_DisposeGear : Boolean = False; } +{ DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_DisposeGear : Boolean = False; } + DEBUG_DONOT_NIL_Grabbed_Gear_when_Change_Scene : Boolean = False; + DEBUG_DONOT_NIL_SCRIPT_DynamicEncounter : Boolean = False; + DEBUG_FORCE_EXEC_MacroUPDATE_when_Restore : Boolean = False; + DEBUG_FORCE_EXEC_MacroSTART_when_Restore : Boolean = False; + DEBUG_STOP_MacroRESTORESTART_when_Restore : Boolean = False; + DEBUG_FORCE_RestockRandomMonsters_when_Restore : Boolean = False; + DEBUG_MaxCID : Boolean = True; + DEBUG_MaxNID : Boolean = True; + DEBUG_CanSeeAll : Boolean = False; + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} + + +{$IFDEF PATCH_I18N} +Function I18N_Help_Keymap_Name_String( const MsgLabel: String ): String; +Function I18N_Help_Keymap_Desc_String( const MsgLabel: String ): String; +{$ENDIF PATCH_I18N} + implementation -uses dos,ability,gears,texutil; +uses +{$IFDEF PATCH_GH} +{ "sysutils" has to come before others. } + sysutils, +{$ELSE PATCH_GH} + {$IFDEF PATCH_I18N} + sysutils, + {$ENDIF PATCH_I18N} +{$ENDIF PATCH_GH} + dos, +{$IFDEF PATCH_GH} + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + pseudosmartpointer, +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + i18nmsg, +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + gears_base, + gears, + texutil +{$ELSE PATCH_GH} + ability, + gears, + texutil +{$ENDIF PATCH_GH} +{$IFDEF Windows} + ,w32 +{$ENDIF Windows} + ; + + +{$IFDEF PATCH_GH} + {$IFDEF SDLMODE} +type + T_ColorTable = Record + Name: String; + DataPtr: PSDL_Color; + end; + T_SDLColorTable = Record + Name: String; + DataPtr: PChar; + end; + +const + ColorTable_Num = 26; + ColorTable: Array [1..ColorTable_Num] of T_ColorTable = ( + ( Name: 'Avocado'; DataPtr: @Avocado; ), + ( Name: 'Bacardi'; DataPtr: @Bacardi; ), + ( Name: 'Jade'; DataPtr: @Jade; ), + ( Name: 'BrightJade'; DataPtr: @BrightJade; ), + ( Name: 'StdBlack'; DataPtr: @StdBlack; ), + ( Name: 'StdWhite'; DataPtr: @StdWhite; ), + ( Name: 'MenuItem'; DataPtr: @MenuItem; ), + ( Name: 'MenuSelect'; DataPtr: @MenuSelect; ), + ( Name: 'TerrainGreen'; DataPtr: @TerrainGreen; ), + ( Name: 'PlayerBlue'; DataPtr: @PlayerBlue; ), + ( Name: 'AllyPurple'; DataPtr: @AllyPurple; ), + ( Name: 'EnemyRed'; DataPtr: @EnemyRed; ), + ( Name: 'NeutralGrey'; DataPtr: @NeutralGrey; ), + ( Name: 'DarkGrey'; DataPtr: @DarkGrey; ), + ( Name: 'InfoGreen'; DataPtr: @InfoGreen; ), + ( Name: 'InfoHiLight'; DataPtr: @InfoHiLight; ), + ( Name: 'TextboxGrey'; DataPtr: @TextboxGrey; ), + ( Name: 'NeutralBrown'; DataPtr: @NeutralBrown; ), + ( Name: 'BorderBlue'; DataPtr: @BorderBlue; ), + ( Name: 'BrightYellow'; DataPtr: @BrightYellow; ), + ( Name: 'StatusPerfect'; DataPtr: @StatusPerfect; ), + ( Name: 'StatusOK'; DataPtr: @StatusOK; ), + ( Name: 'StatusFair'; DataPtr: @StatusFair; ), + ( Name: 'StatusBad'; DataPtr: @StatusBad; ), + ( Name: 'StatusCritical'; DataPtr: @StatusCritical; ), + ( Name: 'StatusKO'; DataPtr: @StatusKO; ) + ); + + SDLColorTable_Num = 10; + SDLColorTable: Array [1..SDLColorTable_Num] of T_SDLColorTable = ( + ( Name: 'TeamColor_Character_DefPlayerTeam'; DataPtr: @SDL_colors_TeamColor_Character_DefPlayerTeam; ), + ( Name: 'TeamColor_Character_Enemies'; DataPtr: @SDL_colors_TeamColor_Character_Enemies ; ), + ( Name: 'TeamColor_Character_Allies'; DataPtr: @SDL_colors_TeamColor_Character_Allies ; ), + ( Name: 'TeamColor_Character_Others'; DataPtr: @SDL_colors_TeamColor_Character_Others ; ), + ( Name: 'TeamColor_Mecha_DefPlayerTeam'; DataPtr: @SDL_colors_TeamColor_Mecha_DefPlayerTeam ; ), + ( Name: 'TeamColor_Mecha_Enemies'; DataPtr: @SDL_colors_TeamColor_Mecha_Enemies ; ), + ( Name: 'TeamColor_Mecha_Allies'; DataPtr: @SDL_colors_TeamColor_Mecha_Allies ; ), + ( Name: 'TeamColor_Mecha_Others'; DataPtr: @SDL_colors_TeamColor_Mecha_Others ; ), + ( Name: 'RobotCreate'; DataPtr: @SDL_colors_RobotCreate; ), + ( Name: 'CharacterCreate'; DataPtr: @SDL_colors_CharacterCreate; ) + ); + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} + +{$IFDEF PATCH_I18N} +var + I18N_Help_Keymap_Name: SAttPtr; + I18N_Help_Keymap_Desc: SAttPtr; +{$ENDIF PATCH_I18N} + + +{$IFDEF PATCH_I18N} +Function I18N_Help_Keymap_Name_String( const MsgLabel: String ): String; +begin + I18N_Help_Keymap_Name_String := SAttValue( I18N_Help_Keymap_Name, MsgLabel ); +end; + +Function I18N_Help_Keymap_Desc_String( const MsgLabel: String ): String; +begin + I18N_Help_Keymap_Desc_String := SAttValue( I18N_Help_Keymap_Desc, MsgLabel ); +end; + +Procedure Load_I18N_Default; +begin + ControlTypeName[0] := I18N_MsgString('ui4gh_ControlTypeName','Menu'); + ControlTypeName[1] := I18N_MsgString('ui4gh_ControlTypeName','Roguelike'); + BVTypeName[1] := I18N_MsgString('ui4gh','BVTypeName1'); + BVTypeName[2] := I18N_MsgString('ui4gh','BVTypeName2'); + BVTypeName[3] := I18N_MsgString('ui4gh','BVTypeName3'); + BVTypeName[4] := I18N_MsgString('ui4gh','BVTypeName4'); + ProhibitationHead := I18N_Settings('ProhibitationHead',ProhibitationHead); + ProhibitationTrail := I18N_Settings('ProhibitationTrail',ProhibitationTrail); + FontSearchName_Big[2].FontFile := I18N_Settings('Default_FontFileBig',FontSearchName_Big[2].FontFile); + FontSearchName_Big[2].FontFace := StrToInt(I18N_Settings('Default_FontFaceBig',IntToStr(FontSearchName_Big[2].FontFace))); + FontSearchName_Big[2].FontSize := StrToInt(I18N_Settings('Default_FontSizeBig',IntToStr(FontSearchName_Big[2].FontSize))); + FontSearchName_Small[2].FontFile := I18N_Settings('Default_FontFileSmall',FontSearchName_Small[2].FontFile); + FontSearchName_Small[2].FontFace := StrToInt(I18N_Settings('Default_FontFaceSmall',IntToStr(FontSearchName_Small[2].FontFace))); + FontSearchName_Small[2].FontSize := StrToInt(I18N_Settings('Default_FontSizeSmall',IntToStr(FontSearchName_Small[2].FontSize))); + {$IFDEF Windows} + MSWINGUI_FontName := I18N_Settings('MSWIN_Default_FontNameOther',MSWINGUI_FontName); + MSWINGUI_FontWeight := StrToInt(I18N_Settings('MSWIN_Default_FontWeightOther',IntToStr(MSWINGUI_FontWeight))); + MSWINGUI_FontSize := StrToInt(I18N_Settings('MSWIN_Default_FontSizeOther',IntToStr(MSWINGUI_FontSize))); + {$ENDIF Windows} +end; +{$ENDIF PATCH_I18N} + Procedure LoadConfig; { Open the configuration file and set the variables } @@ -359,7 +1225,31 @@ uses dos,ability,gears,texutil; F: Text; S,CMD,C: String; T: Integer; +{$IFDEF PATCH_I18N} + {$IFDEF Windows} + WinDir: String; + {$ENDIF Windows} +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + Done: Boolean; + KCode_tmp: Char; + ColorNum: Integer; +{$ENDIF PATCH_GH} begin +{$IFDEF PATCH_I18N} + {$IFDEF Windows} + WinDir := ''; + if '' = WinDir then begin + WinDir := GetEnvironmentVariable('SystemRoot'); + end; + if '' = WinDir then begin + WinDir := GetEnvironmentVariable('windir'); + end; + if '' <> WinDir then begin + FontSearchDir[4] := WinDir + DirectorySeparator + 'Fonts'; + end; + {$ENDIF Windows} +{$ENDIF PATCH_I18N} {See whether or not there's a configuration file.} S := FSearch(Config_File,'.'); if S <> '' then begin @@ -372,13 +1262,35 @@ uses dos,ability,gears,texutil; ReadLn(F,S); cmd := ExtractWord(S); if (cmd <> '') then begin +{$IFDEF PATCH_GH} + Done := False; +{$ENDIF PATCH_GH} {Check to see if CMD is one of the standard keys.} cmd := UpCase(cmd); +{$IFDEF PATCH_GH} + for t := 1 to KeyMapAliasMax do begin + if (UpCase(KeyMapAlias[t].CmdAlias) = cmd) then begin + cmd := UpCase(KeyMapAlias[t].CmdName); + break; + end; + end; +{$ENDIF PATCH_GH} for t := 1 to NumMappedKeys do begin - if UpCase(KeyMap[t].CmdName) = cmd then begin + if UpCase(KeyMap[t].CmdName) = cmd then + begin +{$IFDEF PATCH_GH} + Done := true; +{$ENDIF PATCH_GH} C := ExtractWord(S); if Length(C) = 1 then begin KeyMap[t].KCode := C[1]; +{$IFDEF PATCH_GH} + end else if ('#' = C[1]) and (2 <= Length(C)) then begin + KCode_tmp := Char(StrToInt(Copy(C,2,Length(C)-1))); + if #0 < KCode_tmp then begin + KeyMap[t].KCode := KCode_tmp; + end; +{$ENDIF PATCH_GH} end; end; end; @@ -489,9 +1401,425 @@ uses dos,ability,gears,texutil; end else if cmd = 'USETACTICSMODE' then begin UseTacticsMode := True; - end else if cmd = 'AdvancedColors' then begin + end else if cmd = 'ADVANCEDCOLORS' then begin UseAdvancedColoring := True; +{$IFDEF PATCH_I18N} + end else if cmd = 'I18N_USEORIGINALNAME' then begin + if ExtractTF(S) then I18N_UseOriginalName := True else I18N_UseOriginalName := False; + end else if cmd = 'I18N_USENAMEORG' then begin + if ExtractTF(S) then I18N_UseNameORG := True else I18N_UseNameORG := False; + end else if cmd = 'FONTFILEBIG' then begin + FontSearchName_Big[1].FontFile := ExtractWord( S ); + FontSearchName_Big[1].FontFace := ExtractValue( S ); + if FontSearchName_Big[1].FontFace < 0 then begin FontSearchName_Big[1].FontFace := 0; end; + end else if cmd = 'FONTFILESMALL' then begin + FontSearchName_Small[1].FontFile := ExtractWord( S ); + FontSearchName_Small[1].FontFace := ExtractValue( S ); + if FontSearchName_Small[1].FontFace < 0 then begin FontSearchName_Small[1].FontFace := 0; end; + end else if cmd = 'FONTSIZEBIG' then begin + FontSize_Big := ExtractValue( S ); + if FontSize_Big < 1 then begin FontSize_Big := 1; end; + end else if cmd = 'FONTSIZESMALL' then begin + FontSize_Small := ExtractValue( S ); + if FontSize_Small < 1 then begin FontSize_Small := 1; end; + end else if cmd = 'FONTNAMEOTHER' then begin + {$IFDEF Windows} + MSWINGUI_FontName := S; + {$ENDIF Windows} + end else if cmd = 'FONTWEIGHTOTHER' then begin + {$IFDEF Windows} + MSWINGUI_FontWeight := ExtractValue( S ); + if MSWINGUI_FontWeight < 0 then begin MSWINGUI_FontWeight := 0; end; + {$ENDIF Windows} + end else if cmd = 'FONTSIZEOTHER' then begin + {$IFDEF Windows} + MSWINGUI_FontSize := ExtractValue( S ); + if MSWINGUI_FontSize < 1 then begin MSWINGUI_FontSize := 1; end; + {$ENDIF Windows} + end else if cmd = 'PROHIBITATIONTRAIL' then begin + ProhibitationTrail := S; + end else if cmd = 'PROHIBITATIONHEAD' then begin + ProhibitationHead := S; +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_JPSSDL} + end else if cmd = 'PADLEFT' then begin + Pad_Left := ExtractValue( S ); + end else if cmd = 'PADTOP' then begin + Pad_Top := ExtractValue( S ); + end else if cmd = 'SKIPANIM' then begin + if ExtractTF(S) then SkipAnim := True else SkipAnim := False; + end else if cmd = 'DRAWWALLMODE' then begin + DrawWallMode := ExtractValue( S ); + if 4 < DrawWallMode then begin DrawWallMode := 4 end + else if DrawWallMode < 0 then begin DrawWallMode := 0 end; +{$ENDIF PATCH_JPSSDL} +{$IFDEF PATCH_GH} + end else if cmd = 'SDL_NOTIMEEVENT' then begin + if ExtractTF(S) then SDL_NoTimeEvent := True else SDL_NoTimeEvent := False; + end else if cmd = 'FRAMESKIP' then begin + if ExtractTF(S) then FrameSkip := True else FrameSkip := False; + end else if cmd = 'FRAMEINTERVAL' then begin + FrameInterval := ExtractValue( S ); + if FrameInterval < 0 then begin FrameInterval := 0; end; + end else if cmd = 'SLEEPGRANULARITY' then begin + SleepGranularity := ExtractValue( S ); + if SleepGranularity < 0 then begin SleepGranularity := 0; end; + end else if cmd = 'KEYSAMPLINGINTERVAL' then begin + KeysamplingInterval := ExtractValue( S ); + if KeysamplingInterval < 0 then begin KeysamplingInterval := 0; end; + end else if cmd = 'COLOR' then begin + C := ExtractWord( S ); + {$IFDEF SDLMODE} + for ColorNum := 1 to ColorTable_Num do begin + if UpCase(ColorTable[ColorNum].Name) = UpCase(C) then begin + ColorTable[ColorNum].DataPtr^.r := ExtractValue( S ); + ColorTable[ColorNum].DataPtr^.g := ExtractValue( S ); + ColorTable[ColorNum].DataPtr^.b := ExtractValue( S ); + if ColorTable[ColorNum].DataPtr^.r < 0 then begin ColorTable[ColorNum].DataPtr^.r := 0; end; + if ColorTable[ColorNum].DataPtr^.g < 0 then begin ColorTable[ColorNum].DataPtr^.g := 0; end; + if ColorTable[ColorNum].DataPtr^.b < 0 then begin ColorTable[ColorNum].DataPtr^.b := 0; end; + if 255 < ColorTable[ColorNum].DataPtr^.r then begin ColorTable[ColorNum].DataPtr^.r := 255; end; + if 255 < ColorTable[ColorNum].DataPtr^.g then begin ColorTable[ColorNum].DataPtr^.g := 255; end; + if 255 < ColorTable[ColorNum].DataPtr^.b then begin ColorTable[ColorNum].DataPtr^.b := 255; end; + end; + end; + {$ENDIF SDLMODE} + end else if cmd = 'SDL_COLORS' then begin + C := ExtractWord( S ); + {$IFDEF SDLMODE} + for ColorNum := 1 to SDLColorTable_Num do begin + if UpCase(SDLColorTable[ColorNum].Name) = UpCase(C) then begin + StrPCopy( SDLColorTable[ColorNum].DataPtr, RetrieveAString(S) ); + end; + end; + {$ENDIF SDLMODE} + end else if cmd = 'SDL_MINI' then begin + if ExtractTF(S) then SDL_Mini := True else SDL_Mini := False; + end else if cmd = 'CUI_SCREENSIZE' then begin + {$IFDEF SDLMODE} + {$ELSE SDLMODE} + ScreenSize_Width := ExtractValue( S ); + ScreenSize_Height := ExtractValue( S ); + if ScreenSize_Width < 3 then begin ScreenSize_Width := 3; end; + if ScreenSize_Height < 3 then begin ScreenSize_Height := 3; end; + {$ENDIF SDLMODE} + end else if cmd = 'SDL_SCREENPOS' then begin + {$IFDEF SDLMODE} + ScreenPos_X := ExtractValue( S ); + ScreenPos_Y := ExtractValue( S ); + {$ENDIF SDLMODE} + end else if cmd = 'SDL_SCREENSIZE' then begin + {$IFDEF SDLMODE} + ScreenSize_Width := ExtractValue( S ); + ScreenSize_Height := ExtractValue( S ); + if ScreenSize_Width < 3 then begin ScreenSize_Width := 3; end; + if ScreenSize_Height < 3 then begin ScreenSize_Height := 3; end; + {$ENDIF SDLMODE} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_I18N} + end else if cmd = 'SDL_AAFONT' then begin + {$IFDEF SDLMODE} + if ExtractTF(S) then SDL_AAFont := True else SDL_AAFont := False; + {$ENDIF SDLMODE} + end else if cmd = 'SDL_AAFONT_SHADED' then begin + {$IFDEF SDLMODE} + if ExtractTF(S) then SDL_AAFont_Shaded := True else SDL_AAFont_Shaded := False; + {$ENDIF SDLMODE} +{$ENDIF PATCH_I18N} +{$IFDEF PATCH_GH} + end else if cmd = 'ENABLE_ARENAMODE' then begin + if ExtractTF(S) then Enable_ArenaMode := True else Enable_ArenaMode := False; + end else if cmd = 'ENABLE_EDITMAP' then begin + if ExtractTF(S) then Enable_EditMap := True else Enable_EditMap := False; + end else if cmd = 'ENABLE_POINTANIMATION' then begin + if ExtractTF(S) then Enable_PointAnimation := True else Enable_PointAnimation := False; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_l0ugh} + end else if cmd = 'KEYBIND_ROGUEMOVE' then begin + if ExtractTF(S) then KeyBind_RogueMove := True else KeyBind_RogueMove := False; +{$ENDIF PATCH_l0ugh} +{$IFDEF PATCH_GH} + end else if cmd = 'SELECTMENU_SCROLL_BY_EDGE' then begin + if ExtractTF(S) then SelectMenu_Scroll_by_Edge := True else SelectMenu_Scroll_by_Edge := False; + end else if cmd = 'SHOW_MENUSCROLLBAR' then begin + if ExtractTF(S) then Show_MenuScrollbar := True else Show_MenuScrollbar := False; + end else if cmd = 'SDL_SHOW_MENUSCROLLBAR' then begin + {$IFDEF SDLMODE} + if ExtractTF(S) then SDL_Show_MenuScrollbar := True else SDL_Show_MenuScrollbar := False; + {$ENDIF SDLMODE} + end else if cmd = 'SDL_SCROLLBAR_SIZE' then begin + {$IFDEF SDLMODE} + SDL_Scrollbar_Size := ExtractValue( S ); + if SDL_Scrollbar_Size < 3 then begin SDL_Scrollbar_Size := 3; end; + {$ENDIF SDLMODE} + end else if cmd = 'SHOW_MENUPAGE' then begin + if ExtractTF(S) then Show_MenuPage := True else Show_MenuPage := False; + end else if cmd = 'SELECTMENU_UPDOWN_BY_MOUSEWHEEL_UD' then begin + if ExtractTF(S) then SelectMenu_UpDown_by_MouseWheel_UD := True else SelectMenu_UpDown_by_MouseWheel_UD := False; + end else if cmd = 'SELECTMENU_UPDOWN_BY_MOUSEWHEEL_UD_REVERSE' then begin + if ExtractTF(S) then SelectMenu_UpDown_by_MouseWheel_UD_Reverse := True else SelectMenu_UpDown_by_MouseWheel_UD_Reverse := False; + end else if cmd = 'SELECTMENU_UPDOWN_BY_MOUSEWHEEL_LR' then begin + if ExtractTF(S) then SelectMenu_UpDown_by_MouseWheel_LR := True else SelectMenu_UpDown_by_MouseWheel_LR := False; + end else if cmd = 'SELECTMENU_UPDOWN_BY_MOUSEWHEEL_LR_REVERSE' then begin + if ExtractTF(S) then SelectMenu_UpDown_by_MouseWheel_LR_Reverse := True else SelectMenu_UpDown_by_MouseWheel_LR_Reverse := False; + end else if cmd = 'SELECTMENU_SCROLL_BY_MOUSEWHEEL_UD' then begin + if ExtractTF(S) then SelectMenu_Scroll_by_MouseWheel_UD := True else SelectMenu_Scroll_by_MouseWheel_UD := False; + end else if cmd = 'SELECTMENU_SCROLL_BY_MOUSEWHEEL_UD_REVERSE' then begin + if ExtractTF(S) then SelectMenu_Scroll_by_MouseWheel_UD_Reverse := True else SelectMenu_Scroll_by_MouseWheel_UD_Reverse := False; + end else if cmd = 'SELECTMENU_SCROLL_BY_MOUSEWHEEL_LR' then begin + if ExtractTF(S) then SelectMenu_Scroll_by_MouseWheel_LR := True else SelectMenu_Scroll_by_MouseWheel_LR := False; + end else if cmd = 'SELECTMENU_SCROLL_BY_MOUSEWHEEL_LR_REVERSE' then begin + if ExtractTF(S) then SelectMenu_Scroll_by_MouseWheel_LR_Reverse := True else SelectMenu_Scroll_by_MouseWheel_LR_Reverse := False; + end else if cmd = 'SELECTMENU_SCROLLPAGE_BY_MOUSEWHEEL_UD' then begin + if ExtractTF(S) then SelectMenu_ScrollPage_by_MouseWheel_UD := True else SelectMenu_ScrollPage_by_MouseWheel_UD := False; + end else if cmd = 'SELECTMENU_SCROLLPAGE_BY_MOUSEWHEEL_UD_REVERSE' then begin + if ExtractTF(S) then SelectMenu_ScrollPage_by_MouseWheel_UD_Reverse := True else SelectMenu_ScrollPage_by_MouseWheel_UD_Reverse := False; + end else if cmd = 'SELECTMENU_SCROLLPAGE_BY_MOUSEWHEEL_LR' then begin + if ExtractTF(S) then SelectMenu_ScrollPage_by_MouseWheel_LR := True else SelectMenu_ScrollPage_by_MouseWheel_LR := False; + end else if cmd = 'SELECTMENU_SCROLLPAGE_BY_MOUSEWHEEL_LR_REVERSE' then begin + if ExtractTF(S) then SelectMenu_ScrollPage_by_MouseWheel_LR_Reverse := True else SelectMenu_ScrollPage_by_MouseWheel_LR_Reverse := False; + end else if cmd = 'CHEAT_DISPLAYGEARINFO' then begin + if ExtractTF(S) then Cheat_DisplayGearInfo := True else Cheat_DisplayGearInfo := False; +{$ENDIF PATCH_GH} +{$IFDEF PATCH_CHEAT} + end else if cmd = 'CHEAT_DISPLAY' then begin + if ExtractTF(S) then Cheat_Display := True else Cheat_Display := False; + Cheat_Display_SW := Cheat_Display; + end else if cmd = 'CHEAT_DISPLAY_DESIG' then begin + if ExtractTF(S) then Cheat_Display_DESIG := True else Cheat_Display_DESIG := False; + end else if cmd = 'CHEAT_DISPLAY_OVERLOAD' then begin + if ExtractTF(S) then Cheat_Display_OverLoad := True else Cheat_Display_OverLoad := False; + end else if cmd = 'CHEAT_DISPLAY_DAMAGEPERCENT' then begin + if ExtractTF(S) then Cheat_Display_DamagePercent := True else Cheat_Display_DamagePercent := False; + end else if cmd = 'CHEAT_DISPLAY_SPEEDOMETER' then begin + if ExtractTF(S) then Cheat_Display_SpeedoMeter := True else Cheat_Display_SpeedoMeter := False; + end else if cmd = 'CHEAT_DISPLAY_PV' then begin + if ExtractTF(S) then Cheat_Display_PV := True else Cheat_Display_PV := False; + end else if cmd = 'CHEAT_PRINT_TIMESTRING' then begin + if ExtractTF(S) then Cheat_Print_TimeString := True else Cheat_Print_TimeString := False; + end else if cmd = 'CHEAT_PRINT_ATTEMPTDEFENSES' then begin + if ExtractTF(S) then Cheat_Print_AttemptDefenses := True else Cheat_Print_AttemptDefenses := False; + end else if cmd = 'CHEAT_PRINT_AMMOEXPLOSION' then begin + if ExtractTF(S) then Cheat_Print_AmmoExplosion := True else Cheat_Print_AmmoExplosion := False; + end else if cmd = 'CHEAT_PRINT_DOPILLAGE' then begin + if ExtractTF(S) then Cheat_Print_DoPillage := True else Cheat_Print_DoPillage := False; + end else if cmd = 'CHEAT_AUTOSAVE_TRACE' then begin + if ExtractTF(S) then Cheat_Autosave_Trace := True else Cheat_Autosave_Trace := False; + end else if cmd = 'CHEAT_AUTOSAVE_WITH_TIMESTAMP' then begin + if ExtractTF(S) then Cheat_Autosave_with_Timestamp := True else Cheat_Autosave_with_Timestamp := False; + end else if cmd = 'CHEAT_MAINMENU_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_MainMenu_AddMenuKey := True else Cheat_MainMenu_AddMenuKey := False; + end else if cmd = 'CHEAT_RESTORE_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_Restore_AddMenuKey := True else Cheat_Restore_AddMenuKey := False; + end else if cmd = 'CHEAT_CHAT' then begin + if ExtractTF(S) then Cheat_Chat := True else Cheat_Chat := False; + end else if cmd = 'CHEAT_CHAT_REVERSESORT' then begin + if ExtractTF(S) then Cheat_Chat_ReverseSort := True else Cheat_Chat_ReverseSort := False; + end else if cmd = 'CHEAT_CALLSHOT' then begin + if ExtractTF(S) then Cheat_CallShot := True else Cheat_CallShot := False; + end else if cmd = 'CHEAT_CALLSHOT_CANCEL' then begin + if ExtractTF(S) then Cheat_CallShot_Cancel := True else Cheat_CallShot_Cancel := False; + end else if cmd = 'CHEAT_CALLSHOT_OMITLOOKINFO' then begin + if ExtractTF(S) then Cheat_CallShot_OmitLookInfo := True else Cheat_CallShot_OmitLookInfo := False; + end else if cmd = 'CHEAT_RANGE_COLORED' then begin + if ExtractTF(S) then Cheat_Range_Colored := True else Cheat_Range_Colored := False; + end else if cmd = 'CHEAT_FINDNEXTWEAPON' then begin + if ExtractTF(S) then Cheat_FindNextWeapon := True else Cheat_FindNextWeapon := False; + end else if cmd = 'CHEAT_MENUORDER_EDIT' then begin + if ExtractTF(S) then Cheat_MenuOrder_Edit := True else Cheat_MenuOrder_Edit := False; + end else if cmd = 'CHEAT_MECHAPARTBROWSER_DELETE' then begin + if ExtractTF(S) then Cheat_MechaPartBrowser_Delete := True else Cheat_MechaPartBrowser_Delete := False; + end else if cmd = 'CHEAT_RENAMEBACKUP' then begin + if ExtractTF(S) then Cheat_RenameBackup := True else Cheat_RenameBackup := False; + end else if cmd = 'CHEAT_NPC_EDIT' then begin + if ExtractTF(S) then Cheat_NPC_Edit := True else Cheat_NPC_Edit := False; + end else if cmd = 'CHEAT_LOOKINFO' then begin + if ExtractTF(S) then Cheat_LookInfo := True else Cheat_LookInfo := False; + end else if cmd = 'CHEAT_ENABLE_LIMIT_SELLINGPRICE' then begin + if ExtractTF(S) then Cheat_Enable_Limit_SellingPrice := True else Cheat_Enable_Limit_SellingPrice := False; + end else if cmd = 'CHEAT_BUYSTUFF_SHOWSUBITEM' then begin + if ExtractTF(S) then Cheat_BuyStuff_ShowSubItem := True else Cheat_BuyStuff_ShowSubItem := False; + end else if cmd = 'CHEAT_BUYSTUFF_MECHA_SHOWSUBITEM' then begin + if ExtractTF(S) then Cheat_BuyStuff_Mecha_ShowSubItem := True else Cheat_BuyStuff_Mecha_ShowSubItem := False; + end else if cmd = 'CHEAT_BUYSTUFF_SORT' then begin + if ExtractTF(S) then Cheat_BuyStuff_Sort := True else Cheat_BuyStuff_Sort := False; + end else if cmd = 'CHEAT_SELLSTUFF_SHOWSUBITEM' then begin + if ExtractTF(S) then Cheat_SellStuff_ShowSubItem := True else Cheat_SellStuff_ShowSubItem := False; + end else if cmd = 'CHEAT_SELLSTUFF_SORT' then begin + if ExtractTF(S) then Cheat_SellStuff_Sort := True else Cheat_SellStuff_Sort := False; + end else if cmd = 'CHEAT_SELLSTUFF_KEEPPOSITION' then begin + if ExtractTF(S) then Cheat_SellStuff_KeepPosition := True else Cheat_SellStuff_KeepPosition := False; + end else if cmd = 'CHEAT_EQPMENU_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_EqpMenu_AddMenuKey := True else Cheat_EqpMenu_AddMenuKey := False; + end else if cmd = 'CHEAT_EQPMENU_KEEPPOSITION' then begin + if ExtractTF(S) then Cheat_EqpMenu_KeepPosition := True else Cheat_EqpMenu_KeepPosition := False; + end else if cmd = 'CHEAT_EQPMENU_SHOWSUBITEM' then begin + if ExtractTF(S) then Cheat_EqpMenu_ShowSubItem := True else Cheat_EqpMenu_ShowSubItem := False; + end else if cmd = 'CHEAT_EQPMENU_SHOWMASSMETER' then begin + if ExtractTF(S) then Cheat_EqpMenu_ShowMassMeter := True else Cheat_EqpMenu_ShowMassMeter := False; + end else if cmd = 'CHEAT_EQPMENU_SHOWFULLGEARNAME' then begin + if ExtractTF(S) then Cheat_EqpMenu_ShowFullGearName := True else Cheat_EqpMenu_ShowFullGearName := False; + end else if cmd = 'CHEAT_INVMENU_KEEPPOSITION' then begin + if ExtractTF(S) then Cheat_InvMenu_KeepPosition := True else Cheat_InvMenu_KeepPosition := False; + end else if cmd = 'CHEAT_INVMENU_SHOWSUBITEM' then begin + if ExtractTF(S) then Cheat_InvMenu_ShowSubItem := True else Cheat_InvMenu_ShowSubItem := False; + end else if cmd = 'CHEAT_INVMENU_NOSORT' then begin + if ExtractTF(S) then Cheat_InvMenu_NoSort := True else Cheat_InvMenu_NoSort := False; + end else if cmd = 'CHEAT_MECHADESCRIPTION_SHOWMASSMETER' then begin + if ExtractTF(S) then Cheat_MechaDescription_ShowMassMeter := True else Cheat_MechaDescription_ShowMassMeter := False; + end else if cmd = 'CHEAT_MECHAPARTEDITOR_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_MechaPartEditor_AddMenuKey := True else Cheat_MechaPartEditor_AddMenuKey := False; + end else if cmd = 'CHEAT_MECHAPARTEDITOR_KEEPPOSITION' then begin + if ExtractTF(S) then Cheat_MechaPartEditor_KeepPosition := True else Cheat_MechaPartEditor_KeepPosition := False; + end else if cmd = 'CHEAT_PCVIEW_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_PCVIEW_AddMenuKey := True else Cheat_PCVIEW_AddMenuKey := False; + end else if cmd = 'CHEAT_PCVIEW_KEEPPOSITION' then begin + if ExtractTF(S) then Cheat_PCVIEW_KeepPosition := True else Cheat_PCVIEW_KeepPosition := False; + end else if cmd = 'CHEAT_PCVIEW_TRAINING_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_PCVIEW_Training_AddMenuKey := True else Cheat_PCVIEW_Training_AddMenuKey := False; + end else if cmd = 'CHEAT_PCVIEW_TRAINING_KEEPPOSITION' then begin + if ExtractTF(S) then Cheat_PCVIEW_Training_KeepPosition := True else Cheat_PCVIEW_Training_KeepPosition := False; + end else if cmd = 'CHEAT_FIELDHQ_MECHA_NOSORT' then begin + if ExtractTF(S) then Cheat_FieldHQ_Mecha_NoSort := True else Cheat_FieldHQ_Mecha_NoSort := False; + end else if cmd = 'CHEAT_FIELDHQ_MECHA_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_FieldHQ_Mecha_AddMenuKey := True else Cheat_FieldHQ_Mecha_AddMenuKey := False; + end else if cmd = 'CHEAT_FIELDHQ_MECHA_KEEPPOSITION' then begin + if ExtractTF(S) then Cheat_FieldHQ_Mecha_KeepPosition := True else Cheat_FieldHQ_Mecha_KeepPosition := False; + end else if cmd = 'CHEAT_FIELDHQ_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_FieldHQ_AddMenuKey := True else Cheat_FieldHQ_AddMenuKey := False; + end else if cmd = 'CHEAT_INSTALLMISC_SHOWPARENTITEM' then begin + if ExtractTF(S) then Cheat_InstallMisc_ShowParentItem := True else Cheat_InstallMisc_ShowParentItem := False; + end else if cmd = 'CHEAT_EQUIPITEM_SHOWPARENTITEM' then begin + if ExtractTF(S) then Cheat_EquipItem_ShowParentItem := True else Cheat_EquipItem_ShowParentItem := False; + end else if cmd = 'CHEAT_INSTALLMISC_SHOWINVSTR' then begin + if ExtractTF(S) then Cheat_InstallMisc_ShowInvStr := True else Cheat_InstallMisc_ShowInvStr := False; + end else if cmd = 'CHEAT_EQUIPITEM_SHOWINVSTR' then begin + if ExtractTF(S) then Cheat_EquipItem_ShowInvStr := True else Cheat_EquipItem_ShowInvStr := False; + end else if cmd = 'CHEAT_INSTALLAMMO_SHOWSUBITEM' then begin + if ExtractTF(S) then Cheat_InstallAmmo_ShowSubItem := True else Cheat_InstallAmmo_ShowSubItem := False; + end else if cmd = 'CHEAT_EQUIPITEM_SHOWSUBITEM' then begin + if ExtractTF(S) then Cheat_EquipItem_ShowSubItem := True else Cheat_EquipItem_ShowSubItem := False; + end else if cmd = 'CHEAT_INSTALL_SHOWSUBITEM' then begin + if ExtractTF(S) then Cheat_Install_ShowSubItem := True else Cheat_Install_ShowSubItem := False; + end else if cmd = 'CHEAT_INSTALLCYBERWARE_SHOWSUBITEM' then begin + if ExtractTF(S) then Cheat_InstallCyberware_ShowSubItem := True else Cheat_InstallCyberware_ShowSubItem := False; + end else if cmd = 'CHEAT_EXTENDEDDESCRIPTION_SHOWHIGHOUTPUT' then begin + if ExtractTF(S) then Cheat_ExtendedDescription_ShowHighOutput := True else Cheat_ExtendedDescription_ShowHighOutput := False; + end else if cmd = 'CHEAT_GEARNAME_ADDSCALENUMBER' then begin + if ExtractTF(S) then Cheat_GearName_AddScaleNumber := True else Cheat_GearName_AddScaleNumber := False; + end else if cmd = 'CHEAT_GEARNAME_ADDCLASSNUMBER_GGMODULE' then begin + if ExtractTF(S) then Cheat_GearName_AddClassNumber_GGModule := True else Cheat_GearName_AddClassNumber_GGModule := False; + end else if cmd = 'CHEAT_GEARNAME_ADDCLASSNUMBER_GGMECHA' then begin + if ExtractTF(S) then Cheat_GearName_AddClassNumber_GGMecha := True else Cheat_GearName_AddClassNumber_GGMecha := False; + end else if cmd = 'CHEAT_GEARNAME_ADDCLASSNUMBER_GGHOLDER' then begin + if ExtractTF(S) then Cheat_GearName_AddClassNumber_GGHolder := True else Cheat_GearName_AddClassNumber_GGHolder := False; + end else if cmd = 'CHEAT_GEARNAME_ADDCLASSNUMBER_GGSUPPORT' then begin + if ExtractTF(S) then Cheat_GearName_AddClassNumber_GGSupport := True else Cheat_GearName_AddClassNumber_GGSupport := False; + end else if cmd = 'CHEAT_GEARNAME_ADDCLASSNUMBER_GGCONSUMABLE' then begin + if ExtractTF(S) then Cheat_GearName_AddClassNumber_GGConsumable := True else Cheat_GearName_AddClassNumber_GGConsumable := False; + end else if cmd = 'CHEAT_MECHACUSTOMIZE_LIMITLESS' then begin + if ExtractTF(S) then Cheat_MechaCustomize_Limitless := True else Cheat_MechaCustomize_Limitless := False; + end else if cmd = 'CHEAT_MECHACUSTOMIZE_FREESUPPORT' then begin + if ExtractTF(S) then Cheat_MechaCustomize_FreeSupport := True else Cheat_MechaCustomize_FreeSupport := False; + end else if cmd = 'CHEAT_MECHACUSTOMIZE_FREECOCKPIT' then begin + if ExtractTF(S) then Cheat_MechaCustomize_FreeCockpit := True else Cheat_MechaCustomize_FreeCockpit := False; + end else if cmd = 'CHEAT_MECHACUSTOMIZE_FREEMASTERGEAR' then begin + if ExtractTF(S) then Cheat_MechaCustomize_FreeMasterGear := True else Cheat_MechaCustomize_FreeMasterGear := False; + end else if cmd = 'CHEAT_MECHACUSTOMIZE_FREEPARENT' then begin + if ExtractTF(S) then Cheat_MechaCustomize_FreeParent := True else Cheat_MechaCustomize_FreeParent := False; + end else if cmd = 'CHEAT_MECHACUSTOMIZE_FREESCALE' then begin + if ExtractTF(S) then Cheat_MechaCustomize_FreeScale := True else Cheat_MechaCustomize_FreeScale := False; + end else if cmd = 'CHEAT_MECHACUSTOMIZE_FREEMODIFIER' then begin + if ExtractTF(S) then Cheat_MechaCustomize_FreeModifier := True else Cheat_MechaCustomize_FreeModifier := False; + end else if cmd = 'CHEAT_MECHACUSTOMIZE_FREEBODYMODULE' then begin + if ExtractTF(S) then Cheat_MechaCustomize_FreeBodyModule := True else Cheat_MechaCustomize_FreeBodyModule := False; + end else if cmd = 'CHEAT_TRADE_NOTSAFEAREA' then begin + if ExtractTF(S) then Cheat_Trade_NotSafeArea := True else Cheat_Trade_NotSafeArea := False; + end else if cmd = 'CHEAT_ROGUELIKE_DEATH' then begin + if ExtractTF(S) then Cheat_Roguelike_Death := True else Cheat_Roguelike_Death := False; + end else if cmd = 'CHEAT_ARENAMODE_MAINMENU_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_ArenaMode_MainMenu_AddMenuKey := True else Cheat_ArenaMode_MainMenu_AddMenuKey := False; + end else if cmd = 'CHEAT_ARENAMODE_PILOTSMENU_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_ArenaMode_PilotsMenu_AddMenuKey := True else Cheat_ArenaMode_PilotsMenu_AddMenuKey := False; + end else if cmd = 'CHEAT_ARENAMODE_MECHAMENU_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_ArenaMode_MechaMenu_AddMenuKey := True else Cheat_ArenaMode_MechaMenu_AddMenuKey := False; + end else if cmd = 'CHEAT_ARENAMODE_PILOTSHQ_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_ArenaMode_PilotsHQ_AddMenuKey := True else Cheat_ArenaMode_PilotsHQ_AddMenuKey := False; + end else if cmd = 'CHEAT_ARENAMODE_MECHAHQ_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_ArenaMode_MechaHQ_AddMenuKey := True else Cheat_ArenaMode_MechaHQ_AddMenuKey := False; + end else if cmd = 'CHEAT_ARENAMODE_ALLRECOVERYINHQ' then begin + if ExtractTF(S) then Cheat_ArenaMode_AllRecoveryInHQ := True else Cheat_ArenaMode_AllRecoveryInHQ := False; + end else if cmd = 'CHEAT_ARENAMODE_INVENTORYINHQ' then begin + if ExtractTF(S) then Cheat_ArenaMode_InventoryInHQ := True else Cheat_ArenaMode_InventoryInHQ := False; + end else if cmd = 'CHEAT_ARENAMODE_FIELDHQINHQ' then begin + if ExtractTF(S) then Cheat_ArenaMode_FieldHQInHQ := True else Cheat_ArenaMode_FieldHQInHQ := False; + end else if cmd = 'CHEAT_THISITEMWASSELECTED_ADDMENUKEY' then begin + if ExtractTF(S) then Cheat_ThisItemWasSelected_AddMenuKey := True else Cheat_ThisItemWasSelected_AddMenuKey := False; + end else if cmd = 'CHEAT_ENABLECOCKPITBARRIER' then begin + if ExtractTF(S) then Cheat_EnableCockpitBarrier := True else Cheat_EnableCockpitBarrier := False; + end else if cmd = 'CHEAT_ENABLECOCKPITBARRIER_HAND' then begin + if ExtractTF(S) then Cheat_EnableCockpitBarrier_Hand := True else Cheat_EnableCockpitBarrier_Hand := False; + end else if cmd = 'CHEAT_DONOTRUNWHENMOUSECLICKED' then begin + if ExtractTF(S) then Cheat_DoNotRunWhenMouseClicked := True else Cheat_DoNotRunWhenMouseClicked := False; +{$ENDIF PATCH_CHEAT} +{$IFDEF PATCH_BACKPORT} + end else if cmd = 'BACKPORT_CALIBER' then begin + if ExtractTF(S) then Backport_Caliber := True else Backport_Caliber := False; + end else if cmd = 'BACKPORT_CALIBER_GH1COMPATIBLE' then begin + if ExtractTF(S) then Backport_Caliber_GH1Compatible := True else Backport_Caliber_GH1Compatible := False; +{$ENDIF PATCH_BACKPORT} +{$IFDEF PATCH_GH} + {$IFDEF DEBUG} + end else if cmd = 'DEBUG_MEMORYLEAK' then begin + if ExtractTF(S) then DEBUG_MemoryLeak := True else DEBUG_MemoryLeak := False; + end else if cmd = 'DEBUG_TRACEMACRO' then begin + if ExtractTF(S) then DEBUG_TraceMacro := True else DEBUG_TraceMacro := False; + end else if cmd = 'DEBUG_GRABBED_GEAR' then begin + if ExtractTF(S) then DEBUG_Grabbed_Gear := True else DEBUG_Grabbed_Gear := False; + end else if cmd = 'DEBUG_SCRIPT_DYNAMICENCOUNTER' then begin + if ExtractTF(S) then DEBUG_SCRIPT_DynamicEncounter := True else DEBUG_SCRIPT_DynamicEncounter := False; + end else if cmd = 'DEBUG_DONOT_NIL_GRABBED_GEAR_WHEN_NEWGEAR' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_Grabbed_Gear_when_NewGear := True else DEBUG_DONOT_NIL_Grabbed_Gear_when_NewGear := False; + end else if cmd = 'DEBUG_DONOT_NIL_GRABBED_GEAR_WHEN_DISPOSEGEAR' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_Grabbed_Gear_when_DisposeGear := True else DEBUG_DONOT_NIL_Grabbed_Gear_when_DisposeGear := False; + end else if cmd = 'DEBUG_DONOT_NIL_GRABBED_GEAR_WHEN_DELEGEGG' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_Grabbed_Gear_when_DelegeGG := True else DEBUG_DONOT_NIL_Grabbed_Gear_when_DelegeGG := False; + end else if cmd = 'DEBUG_DONOT_NIL_GRABBED_GEAR_WHEN_ENDSTORY' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_Grabbed_Gear_when_EndStory := True else DEBUG_DONOT_NIL_Grabbed_Gear_when_EndStory := False; + end else if cmd = 'DEBUG_DONOT_NIL_GRABBED_GEAR_WHEN_CLEANUPSTORYPLOTS' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_Grabbed_Gear_when_CleanupStoryPlots := True else DEBUG_DONOT_NIL_Grabbed_Gear_when_CleanupStoryPlots := False; + end else if cmd = 'DEBUG_DONOT_NIL_GRABBED_GEAR_WHEN_PURGE_GG_ABSOLUTELYNOTHING' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_AbsolutelyNothing := True else DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_AbsolutelyNothing := False; + end else if cmd = 'DEBUG_DONOT_NIL_GRABBED_GEAR_WHEN_MARK_GG_DisposeGear' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_Grabbed_Gear_when_Mark_GG_DisposeGear := True else DEBUG_DONOT_NIL_Grabbed_Gear_when_Mark_GG_DisposeGear := False; + end else if cmd = 'DEBUG_DONOT_NIL_GRABBED_GEAR_WHEN_PURGE_GG_DisposeGear' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_DisposeGear := True else DEBUG_DONOT_NIL_Grabbed_Gear_when_Purge_GG_DisposeGear := False; + end else if cmd = 'DEBUG_DONOT_NIL_GRABBED_GEAR_WHEN_CHANGE_SCENE' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_Grabbed_Gear_when_Change_Scene := True else DEBUG_DONOT_NIL_Grabbed_Gear_when_Change_Scene := False; + end else if cmd = 'DEBUG_DONOT_NIL_SCRIPT_DYNAMICENCOUNTER' then begin + if ExtractTF(S) then DEBUG_DONOT_NIL_SCRIPT_DynamicEncounter := True else DEBUG_DONOT_NIL_SCRIPT_DynamicEncounter := False; + end else if cmd = 'DEBUG_FORCE_EXEC_MACROUPDATE_WHEN_RESTORE' then begin + if ExtractTF(S) then DEBUG_FORCE_EXEC_MacroUPDATE_when_Restore := True else DEBUG_FORCE_EXEC_MacroUPDATE_when_Restore := False; + end else if cmd = 'DEBUG_FORCE_EXEC_MACROSTART_WHEN_RESTORE' then begin + if ExtractTF(S) then DEBUG_FORCE_EXEC_MacroSTART_when_Restore := True else DEBUG_FORCE_EXEC_MacroSTART_when_Restore := False; + end else if cmd = 'DEBUG_STOP_MACRORESTORESTART_WHEN_RESTORE' then begin + if ExtractTF(S) then DEBUG_STOP_MacroRESTORESTART_when_Restore := True else DEBUG_STOP_MacroRESTORESTART_when_Restore := False; + end else if cmd = 'DEBUG_FORCE_RESTOCKRANDOMMONSTERS_WHEN_RESTORE' then begin + if ExtractTF(S) then DEBUG_FORCE_RestockRandomMonsters_when_Restore := True else DEBUG_FORCE_RestockRandomMonsters_when_Restore := False; + end else if cmd = 'DEBUG_MAXCID' then begin + if ExtractTF(S) then DEBUG_MaxCID := True else DEBUG_MaxCID := False; + end else if cmd = 'DEBUG_MAXNID' then begin + if ExtractTF(S) then DEBUG_MaxNID := True else DEBUG_MaxNID := False; + end else if cmd = 'DEBUG_CANSEEALL' then begin + if ExtractTF(S) then DEBUG_CanSeeAll := True else DEBUG_CanSeeAll := False; + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} +{$IFDEF PATCH_GH} + end else if cmd = '%' then begin + end else if (False = Done) then begin + ErrorMessage_fork('Unknown option : ' + cmd); +{$ENDIF PATCH_GH} end; end; end; @@ -502,8 +1830,31 @@ uses dos,ability,gears,texutil; end; -initialization + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ui4gh.pp'); +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + I18N_Help_Keymap_Name := LoadStringList( I18N_Help_Keymap_Name_File ); + I18N_Help_Keymap_Desc := LoadStringList( I18N_Help_Keymap_Desc_File ); + Load_I18N_Default; +{$ENDIF PATCH_I18N} LoadConfig; +end; + + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: ui4gh.pp(finalization)'); +{$ENDIF DEBUG} +{$IFDEF PATCH_I18N} + DisposeSAtt( I18N_Help_Keymap_Desc ); + DisposeSAtt( I18N_Help_Keymap_Name ); +{$ENDIF PATCH_I18N} +end; end. diff -x .svn -uprN GearHead1100repository.original/version.pp branches/version.pp --- GearHead1100repository.original/version.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/version.pp 2016-02-28 09:01:00.000000000 +0900 @@ -0,0 +1,63 @@ +unit version; +{ Define version strings. } + +interface + + +const + Version_org = '1.100-github'; + {$I stamp.inc} + Version_txt: String = ''; + Version_all: String = ''; + rcsid = '@(#) $version: GearHead Arena v' + Version_org + ' BIN:' + Version_I18N + ' $'; + + Version_Generate_TAG = 'VERSION_GENERATE'; + Version_Start_TAG = 'VERSION_START'; + Version_Running_TAG = 'VERSION_RUNNING'; + + + +implementation + +uses dos +{$IFDEF DEBUG} + ,errmsg +{$ENDIF DEBUG} + ; + +const + FN_Version_txt = 'txt_stamp.txt'; + + +Procedure load_version; +var + S: String; + F: Text; +begin + S := FSearch( FN_Version_txt, '.' ); + if S <> '' then begin + Assign( F, S ); + Reset( F ); + ReadLn( F, Version_txt ); + Close( F ); + end; + Version_all := Version_org + ' BIN:' + Version_I18N + ' MSG:' + Version_txt; +end; + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: version.pp'); +{$ENDIF DEBUG} + load_version; +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: version.pp(finalization)'); +{$ENDIF DEBUG} +end; + +end. diff -x .svn -uprN GearHead1100repository.original/w32.pp branches/w32.pp --- GearHead1100repository.original/w32.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/w32.pp 2009-08-15 02:49:42.757901000 +0900 @@ -0,0 +1,60 @@ +{$IFDEF Windows} +unit w32; + + +interface + +uses windows; + +var + MSWINGUI_FontName: String = 'Terminal'; + MSWINGUI_FontWeight: Integer = 0; + MSWINGUI_FontSize: Integer = 15; + + MSWINGUI_Width: Integer = 80; + MSWINGUI_Height: Integer = 25; + +{$IFDEF SDLMODE} +Function GetSDLHWND: Windows.HWND; +{$ENDIF SDLMODE} + +implementation + +{$IFDEF DEBUG} + { Don't include errmsg. It cause a infinite depending loop. } + {errmsg,} +{$ENDIF DEBUG} +{$IFDEF SDLMODE} +uses SDL; +{$ENDIF SDLMODE} + +{$IFDEF SDLMODE} +Function GetSDLHWND: Windows.HWND; +var + wmi: TSDL_SysWMinfo; +begin + wmi.window := 0; { Fallback data. Don't forget it! } + SDL_VERSION( wmi.version ); + SDL_GetWMInfo( @wmi ); + GetSDLHWND := wmi.window; +end; +{$ENDIF SDLMODE} + + + +initialization +begin +{$IFDEF DEBUG} + {ErrorMessage_fork('DEBUG: w32.pp');} +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + {ErrorMessage_fork('DEBUG: w32.pp(finalization)');} +{$ENDIF DEBUG} +end; + +end. +{$ENDIF Windows} diff -x .svn -uprN GearHead1100repository.original/w32crt.pp branches/w32crt.pp --- GearHead1100repository.original/w32crt.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/w32crt.pp 2009-08-15 02:43:58.042405000 +0900 @@ -0,0 +1,1106 @@ +{$IFDEF GUIMSWINMODE} +{ Proposed and made by l0ugh, Internationalizationed by G-HAL. } +{ GearHead W32 non-console ASCII port } +unit w32crt; + +interface + +uses windows,dos; + +const +{ Foreground and background color constants } + Black = 0; + Blue = 1; + Green = 2; + Cyan = 3; + Red = 4; + Magenta = 5; + Brown = 6; + LightGray = 7; + +{ Foreground color constants } + DarkGray = 8; + LightBlue = 9; + LightGreen = 10; + LightCyan = 11; + LightRed = 12; + LightMagenta = 13; + Yellow = 14; + White = 15; + +{ configuration file } +{ to avoid circular unit reference this defined here instead of gears.pp } + WIN_CONFIG_FILE = 'win.cfg'; + + keybufsize = 63; + +Procedure ClrEol( myhdc: Windows.HDC ); +Procedure ClrEol; +Procedure ClrScr; +Procedure CursorOn; +Procedure CursorOff; +Procedure Delay( MS: Word ); +Procedure GotoXY( X: Byte; Y: Byte ); +Function KeyPressed: Boolean; +Function ReadKey: Char; +Procedure TextBackground( CL: Byte ); +Procedure TextColor( CL: Byte ); +Function WhereX: Byte; +Function WhereY: Byte; +Procedure Window( AX1, AY1, AX2, AY2: Byte ); +Function W32GetLine( it: String ): String; +Function W32GetLine: String; +Procedure W32WriteLn( const Str: String ); +Procedure W32Write( myhdc: Windows.HDC; const Str: String ); +Procedure W32Write( const Str: String ); +Procedure W32WriteChar( myhdc: Windows.HDC; c: Char ); +Procedure W32WriteChar( c: Char ); +Procedure W32CrtInit; +Procedure NormVideo; +Function DisposeWindow: LongInt; + + + +implementation + +uses iconv,texutil, +{$IFDEF PATCH_GH} + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} + w32; + +Procedure DebugLog( Str: String ); +var + F: Text; + S: String; +begin + Assign( F, 'debuglog.txt' ); + S := FSearch( 'debuglog.txt', '.' ); + if ( S <> '' ) then begin + Append( F ); + end else begin + Rewrite( F ); + end; + + WriteLn( F, Str ); + Close( F ); +end; + +{ -------- color table -------- } +const + MaxColorTable = 15; +var + colortable: array[0..MaxColorTable] of Windows.COLORREF = ( + $00000000, {RGB( 0, 0, 0),} { black } + $00c00000, {RGB( 0, 0, 0xc0),} { blue } + $00008000, {RGB( 0, 0x80, 0),} { green } + $00808000, {RGB( 0, 0x80, 0x80),} { cyan } + $000000c0, {RGB(0xc0, 0, 0),} { red } + $00800080, {RGB(0x80, 0, 0x80),} { magenta } + $00006080, {RGB(0x80, 0x60, 0),} { brown } + $00c0c0c0, {RGB(0xc0, 0xc0, 0xc0),} { lightgray } + $00808080, {RGB(0x80, 0x80, 0x80),} { darkgray } + $00ff0000, {RGB( 0, 0, 0xff),} { light blue } + $0000ff00, {RGB( 0, 0xff, 0),} { light green } + $00ffff00, {RGB( 0, 0xff, 0xff),} { light cyan } + $000000ff, {RGB(0xff, 0, 0),} { light red } + $00ff00ff, {RGB(0xff, 0, 0xff),} { light magenta } + $0000ffff, {RGB(0xff, 0xff, 0),} { yellow } + $00ffffff {RGB(0xff, 0xff, 0xff)} { white } + ); + +{ -------- Virtual Console-VRAM -------- } +const + MaxMultibyteLen = 8; +var + MaxCol: Integer = 80; + MaxRow: Integer = 25; + chara: PChar = NIL; { Text Image } + fgcol: PBYTE = NIL; { foreground color } + bgcol: PBYTE = NIL; { background color } + currfgc: Integer = MaxColorTable; + currbgc: Integer = 0; + + { cursorstate: Integer; } + cursorx: Integer = 0; + cursory: Integer = 0; + + x1, x2, y1, y2: Integer; { clipping } + + FONTH, FONTW: Integer; + WIN_X, WIN_Y: LongInt; + FontName: String; + FontWeight: Integer; + bWindowClosing: Boolean = True; + + myhwnd: Windows.HWND; + +{ -------- font -------- } +var + myfont: Windows.HFONT; + +Procedure PrepareFont; +var + lf: Windows.LOGFONT; +begin + Windows.ZeroMemory( @lf, sizeof(Windows.LOGFONT) ); + With lf do + begin + lfHeight := FONTH; + lfOutPrecision := Windows.OUT_DEFAULT_PRECIS; + lfClipPrecision := Windows.CLIP_DEFAULT_PRECIS; + lfQuality := Windows.DEFAULT_QUALITY; + lfWeight := FontWeight; + lfPitchAndFamily := Windows.FIXED_PITCH or Windows.FF_DONTCARE; + lfFaceName := FontName + #0; + lfCharSet := Windows.DEFAULT_CHARSET; + end; + myfont := Windows.CreateFontIndirect( @lf ); + + {if creating font failed, then create default font.} + if ( myfont = 0 ) then begin + FONTH := 16; + FONTW := 8; + FontName := 'Terminal'; + With lf do begin + lfHeight := FONTH; + lfFaceName := FontName + #0; + lfWeight := 0; + end; + myfont := Windows.CreateFontIndirect( @lf ); + if ( myfont = 0 ) then begin + Windows.MessageBox( + myhwnd, + 'failed to create font. program will be aborted.'#0, + 'Sorry'#0, + Windows.MB_OK or Windows.MB_ICONERROR ); + DisposeWindow; + end; + end; +end; + +Procedure DestroyFont; +begin + if ( not Windows.DeleteObject(myfont) ) then begin +{$IFDEF PATCH_GH} + ErrorMessage( 'failed to delete font. ' ); +{$ELSE PATCH_GH} + WriteLn( 'failed to delete font. ' ); +{$ENDIF PATCH_GH} + end; + myfont := 0; +end; + +{ -------- Key Buffering -------- } +var + keybuf: array[0..keybufsize] of Char; + keybufrp: Integer; + keybufwp: Integer; + +Procedure KeybufPut( c: Char ); +begin + if (((keybufwp+1) and keybufsize) <> keybufrp) then + begin + keybuf[keybufwp] := c; + keybufwp := (keybufwp + 1) and keybufsize; + end; +end; + +Function KeybufEmpty: Boolean; +begin + KeybufEmpty := (keybufrp = keybufwp); +end; + +Function KeybufGet: Char; +var + c: Char; +begin + if (KeybufEmpty) then Exit(#0); + c := keybuf[keybufrp]; + keybufrp := (keybufrp + 1) and keybufsize; + KeybufGet := c; +end; + +{ -------- window proc -------- } +Procedure RedrawArea( myhdc: Windows.HDC; ax1, ay1, ax2, ay2: BYTE ); +var + mybrush: Windows.HBRUSH; + r: Windows.RECT; + i, j, k: Integer; + hFontOld: Windows.HFONT; + MBCharLen: Integer; +begin + if bWindowClosing then Exit; + if ( myfont = 0 ) then exit; + hFontOld := Windows.SelectObject( myhdc, myfont ); + +{$IFDEF DEBUG} + mybrush := Windows.CreateSolidBrush( colortable[currfgc] ); +{$ELSE DEBUG} + mybrush := Windows.CreateSolidBrush( colortable[currbgc] ); +{$ENDIF DEBUG} + Windows.SetRect( @r, ax1*FONTW, ay1*FONTH, (ax2+1)*FONTW, (ay2+1)*FONTH ); + Windows.FillRect( myhdc, r, mybrush ); + Windows.DeleteObject( mybrush ); + + for i := ay1 to ay2 do begin + k := i * MaxCol + ax1; + j := ax1; + while j <= ax2 do begin + if (' ' = chara[k*MaxMultibyteLen]) or (#$0 = chara[k*MaxMultibyteLen]) then begin + mybrush := Windows.CreateSolidBrush( colortable[bgcol[k]] ); + Windows.SetRect( @r, j*FONTW, i*FONTH, (j+1)*FONTW, (i+1)*FONTH ); + Windows.FillRect( myhdc, r, mybrush ); + Windows.DeleteObject( mybrush ); + Inc( k ); + Inc( j ); + end else begin + Windows.SetTextColor( myhdc, colortable[fgcol[k]] ); + Windows.SetBkColor( myhdc, colortable[bgcol[k]] ); +{$IFDEF WITH_TENC} + MBCharLen := LengthMBChar( chara[k*MaxMultibyteLen], TENC ); +{$ELSE WITH_TENC} + MBCharLen := LengthMBChar( chara[k*MaxMultibyteLen] ); +{$ENDIF WITH_TENC} + if 1 < MBCharLen then begin + Windows.TextOut( myhdc, j*FONTW, i*FONTH, @chara[k*MaxMultibyteLen], MBCharLen ); + k := k + 2; + j := j + 2; + end else begin + Windows.TextOut( myhdc, j*FONTW, i*FONTH, @chara[k*MaxMultibyteLen], 1 ); + Inc( k ); + Inc( j ); + end; + end; + end; + end; + Windows.SelectObject( myhdc, hFontOld ); +end; + +Function MyWndProc( myhwnd: Windows.HWND; msg: Windows.UINT; wp: Windows.WPARAM; lp: Windows.LPARAM ): Windows.LRESULT; StdCall; +const + KB_STAT_LEN = 256; +var + myhdc: Windows.HDC; + ps: Windows.PAINTSTRUCT; + c: Char; + kb_stat: array[0..(KB_STAT_LEN-1)] of BYTE; +begin + Case msg of + + Windows.WM_CREATE: + begin + PrepareFont; + end; + + Windows.WM_PAINT: + begin + myhdc := Windows.BeginPaint( myhwnd, @ps ); + RedrawArea( myhdc, 0,0, (MaxCol - 1),(MaxRow - 1) ); + Windows.EndPaint( myhwnd, @ps ); + exit(0); + end; + + Windows.WM_DESTROY: + begin + DestroyFont; + Windows.PostQuitMessage( 0 ); + exit(0); + end; + + Windows.WM_CLOSE: + begin + if ( not bWindowClosing ) then begin + Windows.MessageBox( myhwnd, 'Please Quit from a game menu.'#0, 'Sorry'#0, Windows.MB_OK ); + exit(0); + end; + end; + + Windows.WM_CHAR: + begin + c := Chr( wp ); + KeybufPut( c ); + exit(0); + end; + + Windows.WM_KEYDOWN: {, Windows.WM_KEYUP:} + begin + { get current keyboard status } + Windows.ZeroMemory( @kb_stat[0], KB_STAT_LEN ); + Windows.GetKeyboardState( @kb_stat[0] ); + c := #0; + + { process numberpad keys } + Case wp of + Windows.VK_INSERT: c := ','; + Windows.VK_END: c := '1'; + Windows.VK_DOWN: c := '2'; + Windows.VK_NEXT: c := '3'; + Windows.VK_LEFT: c := '4'; + Windows.VK_CLEAR: c := '5'; + Windows.VK_RIGHT: c := '6'; + Windows.VK_HOME: c := '7'; + Windows.VK_UP: c := '8'; + Windows.VK_PRIOR: c := '9'; + Windows.VK_DELETE: c := #$1b; + Windows.VK_F1: begin KeybufPut(#0); c := #123; end; + Windows.VK_F2: begin KeybufPut(#0); c := #124; end; + Windows.VK_F3: begin KeybufPut(#0); c := #125; end; + Windows.VK_F4: begin KeybufPut(#0); c := #126; end; + Windows.VK_F5: begin KeybufPut(#0); c := #127; end; + Windows.VK_F6: begin KeybufPut(#0); c := #128; end; + Windows.VK_F7: begin KeybufPut(#0); c := #129; end; + Windows.VK_F8: begin KeybufPut(#0); c := #130; end; + Windows.VK_F9: begin KeybufPut(#0); c := #131; end; + Windows.VK_F10: begin KeybufPut(#0); c := #132; end; + Windows.VK_F11: begin KeybufPut(#0); c := #133; end; + Windows.VK_F12: begin KeybufPut(#0); c := #134; end; + end; + + if ((c <> #0) and ((kb_stat[wp] and $80{KEY_PRESSED}) <> 0)) then + begin + KeybufPut( c ); + exit(0); + end; + + end;{KEYDOWN,KEYUP} + + end; + + MyWndProc := Windows.DefWindowProc( myhwnd, msg, wp, lp ); +end; + +Procedure LoadWinCfg; +{$IFDEF WITH_TENC} +const + cmsgLen = 32; +{$ENDIF WITH_TENC} +var + F: Text; + S, CMD, C: String; + T: Integer; + ColorNum: Integer; +{$IFDEF WITH_TENC} + pmsg: PChar; + tmsg: Array[0..cmsgLen] of Char; + ptmsg: PChar; +{$ENDIF WITH_TENC} +begin + + WIN_X := -1; + WIN_Y := -1; + FONTH := MSWINGUI_FontSize; + FONTW := MSWINGUI_FontSize div 2; +{$IFDEF WITH_TENC} + pmsg := QuickPCopy( MSWINGUI_FontName ); + ptmsg := tmsg; + Conv_FromTenc( pmsg, Length(pmsg), ptmsg, cmsgLen ); + Dispose( pmsg ); + FontName := StrPas( tmsg ); +{$ELSE WITH_TENC} + FontName := MSWINGUI_FontName; +{$ENDIF WITH_TENC} + FontWeight := MSWINGUI_FontWeight; + + S := FSearch( WIN_CONFIG_FILE, '.' ); + if S <> '' then begin + Assign( F, S ); + Reset( F ); + + while not Eof(F) do begin + ReadLn( F, S ); + if ( S[1] = '%' ) then continue; + cmd := UpCase( ExtractWord( S ) ); + if ( cmd = 'FONTHEIGHT' ) then begin + T := ExtractValue( S ); + if ( T > 0 ) then begin + FONTH := T; + FONTW := T DIV 2; + end; + end else if ( cmd = 'FONTNAME' ) then begin + C := ''; + while S <> '' do begin + if ( C <> '' ) then C := C + ' '; + C := C + ExtractWord( S ); + end; + FontName := C; + end else if ( cmd = 'WINPOS_X' ) then begin + T := ExtractValue( S ); + if ( T > 0 ) then begin + WIN_X := T; + end; + end else if ( cmd = 'WINPOS_Y' ) then begin + T := ExtractValue( S ); + if ( T > 0 ) then begin + WIN_Y := T; + end; + end else if ( cmd = 'FONTWEIGHT' ) then begin + T := ExtractValue( S ); + if ( ( T > 0 ) and ( T <= 900 ) ) then begin + FontWeight := T; + end; + end else if ( cmd = 'COLOR' ) then begin + ColorNum := ExtractValue( S ); + if (0 <= ColorNum) and (ColorNum <= MaxColorTable) then begin + colortable[ColorNum] := ExtractValue( S ) * $10000 + ExtractValue( S ) * $100 + ExtractValue( S ) * $1; + end; + end; + end; + Close( F ); + end; +end; + +{$IFDEF 0} +Procedure SaveWinCfg; +var + F: Text; + r: Windows.RECT; +begin + Windows.GetWindowRect( myhwnd, @r ); + WIN_X := r.left; + WIN_Y := r.top; + + Assign( F, WIN_CONFIG_FILE ); + Rewrite( F ); + WriteLn( F, '% window configuration file' ); + WriteLn( F, '' ); + WriteLn( F, '% font name' ); + WriteLn( F, 'FontName ' + FontName ); + WriteLn( F, '% height of the font' ); + WriteLn( F, 'FontHeight ' + BSTR(FONTH) ); + WriteLn( F, '% weight of the font (default 0, bold = 700)' ); + WriteLn( F, 'FontWeight ' + BSTR(FontWeight) ); + WriteLn( F, '% x position of the window' ); + WriteLn( F, 'WinPos_X ' + BSTR(WIN_X) ); + WriteLn( F, '% y position of the window' ); + WriteLn( F, 'WinPos_Y ' + BSTR(WIN_Y) ); + Close( F ); +end; +{$ENDIF 0} + +{ -------- main -------- } +Procedure MyMain; +const + mywndclassname = 'GHWindow'#0; + mywndtitle = 'GearHead'#0; +var + wndclass: Windows.WNDCLASSEX; + myhinst: Windows.HINST; + r: Windows.RECT; + hDeskWnd: Windows.HWND; + deskRect: Windows.RECT; +begin + myhinst := Windows.GetModuleHandle( NIL ); + LoadWinCfg; + + With wndclass do + begin + cbSize := sizeof(wndclass); + style := Windows.CS_HREDRAW or Windows.CS_VREDRAW; + lpfnWndProc := @MyWndProc; + cbClsExtra := 0; + cbWndExtra := 0; + hInstance := myhinst; + hIcon := Windows.LoadIcon( 0, Windows.IDI_APPLICATION ); + hCursor := Windows.LoadCursor( 0, Windows.IDC_ARROW ); + hbrBackground := Windows.GetStockObject( Windows.BLACK_BRUSH ); + lpszMenuName := NIL; + lpszClassName := mywndclassname; + hIconSm := Windows.LoadIcon( 0, Windows.IDI_APPLICATION ); + end; + + Windows.RegisterClassEx( @wndclass ); + + myhwnd := Windows.CreateWindow( + mywndclassname, { name of window class } + mywndtitle, { title of the window } + Windows.WS_OVERLAPPEDWINDOW and (not Windows.WS_THICKFRAME), + { style of the window } + 0, 0, { position of the window } + 10,{temp} { size of the window } + 10,{temp} + 0, { handle of the parent window } + 0, { handle of the menu } + myhinst, { handle of the instance } + NIL ); { pointer to window arguments } + + With r do + begin + r.left := 0; + r.top := 0; + r.right := FONTW * MaxCol; + r.bottom := FONTH * MaxRow; + end; + Windows.AdjustWindowRect( @r, Windows.WS_OVERLAPPEDWINDOW and (not Windows.WS_THICKFRAME), FALSE{nomenu} ); + if ( ( WIN_X = -1 ) and ( WIN_Y = -1 ) ) then begin + hDeskWnd := Windows.GetDesktopWindow; + Windows.GetWindowRect( hDeskWnd, @deskRect ); + WIN_X := (deskRect.right - (r.right - r.left) ) DIV 2; + WIN_Y := (deskRect.bottom - (r.bottom - r.top) ) DIV 2; + end; + Windows.SetWindowPos( myhwnd, 0, WIN_X, WIN_Y, r.right - r.left, r.bottom - r.top, + Windows.SWP_NOACTIVATE or Windows.SWP_NOMOVE or Windows.SWP_NOZORDER {or Windows.SWP_NOREDRAW} ); + Windows.MoveWindow( myhwnd, WIN_X, WIN_Y, r.right - r.left, r.bottom - r.top, FALSE ); + Windows.ShowWindow( myhwnd, Windows.SW_SHOWDEFAULT ); + Windows.UpdateWindow( myhwnd ); + +end; + +{----------------------------------------------------------------------------------} +Procedure ClrEol( myhdc: Windows.HDC ); +var + i, j, m: Integer; + mybrush: Windows.HBRUSH; + r: Windows.RECT; +begin + if bWindowClosing then Exit; + + j := cursory * MaxCol + cursorx; + for i := cursorx to x2 do + begin + for m := 0 to (MaxMultibyteLen - 1) do begin + chara[j*MaxMultibyteLen+m] := #$0; + end; + chara[j*MaxMultibyteLen] := ' '; + fgcol[j] := currfgc; + bgcol[j] := currbgc; + j := j+1; + end; + if (myhwnd = 0) then exit; + if (myhdc = 0) then exit; + +{$IFDEF DEBUG} + mybrush := Windows.CreateSolidBrush( colortable[currfgc] ); +{$ELSE DEBUG} + mybrush := Windows.CreateSolidBrush( colortable[currbgc] ); +{$ENDIF DEBUG} + Windows.SetRect( @r, cursorx*FONTW, cursory*FONTH, (x2+1)*FONTW, (cursory+1)*FONTH ); + Windows.FillRect( myhdc, r, mybrush ); + Windows.DeleteObject( mybrush ); +end; + +Procedure ClrEol; +var + myhdc: Windows.HDC; +begin + if ( myhwnd = 0 ) then exit; + myhdc := Windows.GetDC( myhwnd ); + ClrEol( myhdc ); + Windows.ReleaseDC( myhwnd, myhdc ); +end; + + +Procedure ClrScr; +var + i, j, k, m: Integer; + myhdc: Windows.HDC; + mybrush: Windows.HBRUSH; + r: Windows.RECT; +begin + if bWindowClosing then Exit; + + for i := y1 to y2 do + begin + k := i * MaxCol + x1; + for j := x1 to x2 do + begin + for m := 0 to (MaxMultibyteLen - 1) do begin + chara[k*MaxMultibyteLen+m] := #$0; + end; + chara[k*MaxMultibyteLen] := ' '; + fgcol[k] := currfgc; + bgcol[k] := currbgc; + k := k + 1; + end; + end; + if (myhwnd = 0) then exit; + myhdc := Windows.GetDC( myhwnd ); +{$IFDEF DEBUG} + mybrush := Windows.CreateSolidBrush( colortable[currfgc] ); +{$ELSE DEBUG} + mybrush := Windows.CreateSolidBrush( colortable[currbgc] ); +{$ENDIF DEBUG} + Windows.SetRect( @r, x1*FONTW, y1*FONTH, (x2+1)*FONTW, (y2+1)*FONTH ); + Windows.FillRect( myhdc, r, mybrush ); + Windows.DeleteObject( mybrush ); + Windows.ReleaseDC( myhwnd, myhdc ); +end; + +Procedure CursorOn; +begin +end; + +Procedure CursorOff; +begin +end; + +Procedure Delay(MS: Word); +begin + Windows.Sleep( MS ); +end; + +Procedure GotoXY( X: Byte; Y: Byte ); +begin + cursorx := X - 1 + x1; + cursory := Y - 1 + y1; + if (cursorx < x1) then cursorx := x1 + else if (cursorx > x2) then cursorx := x2; + if (cursory < y1) then cursory := y1 + else if (cursory > y2) then cursory := y2; +end; + +Function KeyPressed: Boolean; +begin + KeyPressed := not KeybufEmpty; +end; + +Function ReadKeyOrig: Char; +var + mymsg: Windows.MSG; +begin + while KeybufEmpty do + begin + if (Windows.PeekMessage(@mymsg, 0, 0, 0, Windows.PM_NOREMOVE)) then + begin + if (not Windows.GetMessage(@mymsg, 0, 0, 0)) then break; + Windows.TranslateMessage( @mymsg ); + Windows.DispatchMessage( @mymsg ); + end + else Windows.Sleep( 10 ); + end; + ReadKeyOrig := KeybufGet; +end; + +Function ReadKey: Char; +var + c: Char; +begin + c := ReadKeyOrig; + Case c of + #$08: c := '['; {^h} + #$0a: c := '-'; {^j} + #$0b: c := '='; {^k} + #$0c: c := ']'; {^l} + #$03: c := #$1b; {^c} + #$05: c := '8'; {^e} + #$18: c := '2'; {^x} + end; + ReadKey := c; +end; + +Procedure TextBackground( CL: Byte ); +begin + currbgc := CL; +end; + +Procedure TextColor( CL: Byte ); +begin + currfgc := CL; +end; + +Function WhereX: Byte; +begin + WhereX := cursorx - x1 + 1; +end; + +Function WhereY: Byte; +begin + WhereY := cursory - y1 + 1; +end; + +Procedure Window( AX1, AY1, AX2, AY2: Byte ); +var + i: Integer; +begin + x1 := AX1-1; + y1 := AY1-1; + x2 := AX2-1; + y2 := AY2-1; + if (x1 > x2) then begin i := x1; x1 := x2; x2 := i; end; + if (y1 > y2) then begin i := y1; y1 := y2; y2 := i; end; + if (x1 < 0) then x1 := 0; + if (y1 < 0) then y1 := 0; + if (x2 > (MaxCol - 1)) then x2 := (MaxCol - 1); + if (y2 > (MaxRow - 1)) then y2 := (MaxRow - 1); + cursorx := x1; + cursory := y1; +end; + +Procedure NormVideo; +begin + currfgc := LightGray; + currbgc := Black; + Window( 0,0, (MaxCol - 1),(MaxRow - 1) ); + ClrScr; +end; + +Procedure ScrollOneLine( myhdc: Windows.HDC ); +var + i, j, k, l, m: Integer; +begin + if bWindowClosing then Exit; + if ( myhdc = 0 ) then exit; + + if y1 < y2 then + begin + for i := y1 + 1 to y2 do + begin + k := (i-1) * MaxCol + x1; + l := i * MaxCol + x1; + for j := x1 to x2 do + begin + for m := 0 to (MaxMultibyteLen - 1) do begin + chara[k*MaxMultibyteLen+m] := chara[l*MaxMultibyteLen+m]; + end; + fgcol[k] := fgcol[l]; + bgcol[k] := bgcol[l]; + Inc( k ); + Inc( l ); + end; + end; + RedrawArea( myhdc, x1,y1, x2,y2-1 ); + ClrEol( myhdc ); + end; +end; + +Procedure W32Write( myhdc: Windows.HDC; const Str: String ); +var + i, j, k: Integer; + l, n, p: Integer; + ux1, ux2, uy1, uy2: Integer; + MBCharLen: Integer; +begin + if bWindowClosing then Exit; + if (myhwnd = 0) then exit; + if (myhdc = 0) then exit; + + l := Length(Str); + if (l = 0) then exit; + + ux1 := cursorx; + uy1 := cursory; + ux2 := cursorx; + uy2 := cursory; + p := 1; + repeat + n := x2 - cursorx + 1; + if (n > l) then n := l; + + j := cursory * MaxCol + cursorx; + i := 1; + while i <= n do begin +{$IFDEF WITH_TENC} + MBCharLen := LengthMBChar( Str[p], TENC ); +{$ELSE WITH_TENC} + MBCharLen := LengthMBChar( Str[p] ); +{$ENDIF WITH_TENC} + if l < MBCharLen then begin + { If the last char is incompleted multibyte character, exit loop. } + l := -1; + break; + end; + if 1 < MBCharLen then begin + if (i + 1) <= n then begin + { multibyte character } + l := l - MBCharLen; + for k := 0 to (MBCharLen - 1) do begin + chara[j*MaxMultibyteLen+k] := Str[p]; + Inc( p ); + end; + fgcol[j] := currfgc; + bgcol[j] := currbgc; + Inc( cursorx ); + Inc( j ); + Inc( i ); + chara[j*MaxMultibyteLen] := #$0; + fgcol[j] := currfgc; + bgcol[j] := currbgc; + Inc( cursorx ); + Inc( j ); + Inc( i ); + end else begin + { first byte of multibyte char is placed at last of line } + while cursorx <= x2 do begin + for k := 0 to (MBCharLen - 1) do begin + chara[j*MaxMultibyteLen+k] := #$0; + end; + chara[j*MaxMultibyteLen] := ' '; + fgcol[j] := currfgc; + bgcol[j] := currbgc; + Inc( cursorx ); + Inc( j ); + end; + cursorx := 9999; + break; + end; + end else begin + { single byte character } + Dec( l ); + for k := 0 to (MBCharLen - 1) do begin + chara[j*MaxMultibyteLen+k] := #$0; + end; + chara[j*MaxMultibyteLen] := Str[p]; + Inc( p ); + fgcol[j] := currfgc; + bgcol[j] := currbgc; + Inc( cursorx ); + Inc( j ); + Inc( i ); + end; + end; + if ( ux2 < cursorx ) then ux2 := cursorx; + + if (cursorx > x2) then + begin + cursorx := x1; + cursory := cursory + 1; + ux2 := x2; + if (cursory > y2) then + begin + cursory := y2; + { ScrollOneLine( myhdc ); } + { ClrEol( myhdc ); } + uy1 := y1; + uy2 := y2; + end; + end; + if ( cursorx < ux1 ) then ux1 := cursorx; + uy2 := cursory; + + until l <= 0; + + RedrawArea( myhdc, ux1, uy1, ux2, uy2 ); +end; + +Procedure W32Write( const Str: String ); +var + myhdc: Windows.HDC; +begin + if (myhwnd = 0) then exit; + myhdc := Windows.GetDC( myhwnd ); + W32Write( myhdc, Str ); + Windows.ReleaseDC( myhwnd, myhdc ); +end; + +Procedure W32WriteChar( myhdc: Windows.HDC; c: Char ); +var + j, k: Integer; +begin + if bWindowClosing then Exit; + if (myhwnd = 0) then exit; + if (myhdc = 0) then exit; + + j := cursory * MaxCol + cursorx; + if ((chara[j*MaxMultibyteLen] <> c) or (fgcol[j] <> currfgc) or (bgcol[j] <> currbgc)) then begin + for k := 0 to (MaxMultibyteLen - 1) do begin + chara[j*MaxMultibyteLen+k] := #$0; + end; + chara[j*MaxMultibyteLen] := c; + fgcol[j] := currfgc; + bgcol[j] := currbgc; + RedrawArea( myhdc, cursorx, cursory, cursorx, cursory ); + end; + cursorx := cursorx + 1; + if (cursorx > x2) then begin + cursorx := x1; + cursory := cursory + 1; + if (cursory > y2) then begin + cursory := y2; + { ScrollOneLine( myhdc ); } + { ClrEol( myhdc ); } + end; + end; +end; + +Procedure W32WriteChar( c: Char ); +var + myhdc: Windows.HDC; +begin + if ( myhwnd = 0 ) then exit; + + myhdc := Windows.GetDC( myhwnd ); + W32WriteChar( myhdc, c ); + Windows.ReleaseDC( myhwnd, myhdc ); +end; + + +Procedure W32WriteLn( const Str: String ); +var + myhdc: Windows.HDC; +begin + if (myhwnd = 0) then exit; + myhdc := Windows.GetDC( myhwnd ); + + if (Str <> '') then W32Write( myhdc, Str ); + cursorx := x1; + Inc( cursory ); + if cursory > y2 then + begin + cursory := y2; + ScrollOneLine( myhdc ); + ClrEol( myhdc ); + end; + + Windows.ReleaseDC( myhwnd, myhdc ); +end; + +Function W32GetLine: String; +begin + W32GetLine := W32GetLine(''); +end; + +Function W32GetLine( it: String ): String; +const +{$IFDEF IBMGraphics} + CARETCHR = #$16; +{$ELSE} + CARETCHR = '_'; +{$ENDIF} +var + buf: String; + c: Char; + x, y: Integer; + len, mxl: Integer; + myhdc: Windows.HDC; + clen: Integer; + i: Integer; +begin + if (myhwnd = 0) then exit; + myhdc := Windows.GetDC( myhwnd ); + if (myhdc = 0 ) then exit; + + buf := it; + len := Length(buf); + + x := WhereX; + y := WhereY; + mxl := (x2-x1+1) - (x-1) - 1; + + W32Write( myhdc, buf + CARETCHR ); + ClrEol( myhdc ); + repeat + c := ReadKeyOrig; + if #$08 = c then begin + { Backspace } +{$IFDEF WITH_TENC} + clen := Length(TailMBChar(buf,TENC)); +{$ELSE WITH_TENC} + clen := Length(TailMBChar(buf)); +{$ENDIF WITH_TENC} + buf := Copy( buf, 1, Length(buf) - clen ); + len := len - clen; + end else if #$15 = c then begin + { Clear Line } + buf := ''; + len := 0; + end else if #$1b = c then begin + { Esc - cancelled } + buf := ''; + c := #$0d; {exit loop} + end else if TextISO646_AllowableCheck(c) then begin + if len < mxl then begin + buf := buf + c; + Inc( len ); + end; +{$IFDEF WITH_TENC} + end else if IsMBCharLeadByte(c,TENC) then begin + clen := LengthMBChar( c, TENC ); +{$ELSE WITH_TENC} + end else if IsMBCharLeadByte(c) then begin + clen := LengthMBChar( c ); +{$ENDIF WITH_TENC} + if clen <= 1 then begin + end else begin + if (len + clen) < mxl then begin + buf := buf + c; + i := clen - 1; + while 0 < i do begin + buf := buf + ReadKeyOrig; + Dec( i ); + end; + len := len + clen; + end else begin + i := clen - 1; + while 0 < i do begin + ReadKeyOrig; + Dec( i ); + end; + end; + end; + end; + GotoXY( x, y ); + W32Write( myhdc, buf + CARETCHR ); + ClrEol( myhdc ); + until (#$0d = c) or (#$0a = c); + + Windows.ReleaseDC( myhwnd, myhdc ); + W32GetLine := buf; +end; + +Procedure W32CrtInit; +begin + if bWindowClosing then begin + MaxCol := MSWINGUI_Width; + MaxRow := MSWINGUI_Height; + chara := AllocMem( MaxCol * MaxRow * MaxMultibyteLen ); + fgcol := AllocMem( MaxCol * MaxRow ); + bgcol := AllocMem( MaxCol * MaxRow ); + if (NIL = chara) or (NIL = fgcol) or (NIL = bgcol) then begin +{$IFDEF PATCH_GH} + ErrorMessage('ERROR- w32crt. Out of memory.'); +{$ELSE PATCH_GH} + WriteLn('ERROR- w32crt. Out of memory.'); +{$ENDIF PATCH_GH} + halt(255); + end; + bWindowClosing := False; + end; + MyMain; + NormVideo; +end; + +Function DisposeWindow: LongInt; +var + mymsg: Windows.MSG; +begin + if not bWindowClosing then begin + { SaveWinCfg; } + bWindowClosing := true; + Windows.SendMessage( myhwnd, Windows.WM_CLOSE, 0, 0 ); + { while ( Windows.GetMessage(@mymsg, 0, 0, 0) > 0) do begin} + while ( Windows.GetMessage( @mymsg, 0, 0, 0 ) ) do begin + { no dispatch. } + end; + FreeMem( bgcol ); + FreeMem( fgcol ); + FreeMem( chara ); + bgcol := NIL; + fgcol := NIL; + chara := NIL; + DisposeWindow := mymsg.wParam; + end else begin + DisposeWindow := 0; + end; +end; + +{----------------------------------------------------------------------------------} +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: w32crt.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: w32crt.pp(finalization)'); +{$ENDIF DEBUG} +end; + +end. +{$ENDIF GUIMSWINMODE} diff -x .svn -uprN GearHead1100repository.original/w32eb.pp branches/w32eb.pp --- GearHead1100repository.original/w32eb.pp 1970-01-01 09:00:00.000000000 +0900 +++ branches/w32eb.pp 2009-08-15 02:47:28.237904000 +0900 @@ -0,0 +1,417 @@ +{$IFDEF Windows} +unit w32eb; +{GearHead W32 EditBox} + + +interface + +uses windows; + +Function EditBox( const title, text: String ): String; + +implementation + +uses strings, +{$IFDEF PATCH_GH} + errmsg, +{$ELSE PATCH_GH} + {$IFDEF DEBUG} + errmsg, + {$ENDIF DEBUG} +{$ENDIF PATCH_GH} + iconv,texutil, + imm,w32; + +const + mywcname = 'GHEditDialog'#0; + MaxTextBuf = 255; + +var + myhwSDL: Windows.HWND; + myhinst: Windows.HINST; + mydlg: Windows.HWND; + dlgTitle: Windows.HWND; + dlgEdit: Windows.HWND; + Org_edit: Windows.WNDPROC; + myfont: Windows.HFONT; + textbuf: array[0..MaxTextBuf] of Char; + bIMEMode: Boolean = False; + dw : LongInt = 550; + bw : LongInt = 10; + th : LongInt = 30; + hbBorderBlue: Windows.HBRUSH; + + +Function myTextHeight( hw: Windows.HWND ): LongInt; +var + hd: Windows.HDC; + sz: Windows.SIZE; +begin + hd := Windows.GetDC( hw ); + Windows.GetTextExtentPoint32( hd, 'My'#0, 2, sz ); + Windows.ReleaseDC( hw, hd ); + myTextHeight := sz.cy; +end; + +Function myWndPos( myhwnd: Windows.HWND ): Windows.RECT; +{$IFDEF WITH_TENC} +const + cmsgLen = 255; +{$ENDIF WITH_TENC} +var + wp: Windows.WINDOWPLACEMENT; + msg: String; + pmsg: PChar; +{$IFDEF WITH_TENC} + tmsg: Array[0..cmsgLen] of Char; + ptmsg: PChar; +{$ENDIF WITH_TENC} +begin + wp.length := sizeof(wp); + if Windows.GetWindowPlacement( myhwnd, wp ) = False then begin + msg := 'Windows.GetWindowPlacement() failed.'; + pmsg := QuickPCopy(msg); +{$IFDEF WITH_TENC} + ptmsg := tmsg; + Conv_ToTenc( pmsg, Length(pmsg), ptmsg, cmsgLen ); + Windows.MessageBox( 0, tmsg, 'Sorry'#0, MB_OK ); +{$ELSE WITH_TENC} + Windows.MessageBox( 0, pmsg, 'Sorry'#0, MB_OK ); +{$ENDIF WITH_TENC} + Dispose( pmsg ); + end; + myWndPos := wp.rcNormalPosition; +end; + +Function EditProc( myhwnd: Windows.HWND; msg: UINT; wp: Windows.WPARAM; lp: Windows.LPARAM ): Windows.LRESULT; StdCall; +var + c: Char; + i,j: Integer; + state: Integer; +begin + Case msg of + Windows.WM_CHAR: + begin + c := Chr( wp ); + if #$15 = c then begin + Windows.SetWindowText( dlgEdit, ''#0 ); + exit(0); + end else if (c <= #$1F) or (#$7F <= c) then begin + end else if not TextISO646_AllowableCheck(c) then begin + exit(0); + end; + end; + + Windows.WM_KEYDOWN: + begin + if (wp = Windows.VK_ESCAPE) then begin + textbuf[0] := #0; + + Windows.EnableWindow( myhwSDL, True ); + Windows.BringWindowToTop( myhwSDL ); + Windows.DestroyWindow( mydlg ); + mydlg := 0; + exit(0); + end; + + if (wp = Windows.VK_RETURN) or (wp = Windows.VK_SEPARATOR) then begin + Windows.GetWindowText( dlgEdit, textbuf, MaxTextBuf); + + textbuf[MaxTextBuf] := #0; + i := 0; + while i < MaxTextBuf do begin + if #0 = textbuf[i] then begin + break; + end else if TextISO646_AllowableCheck(textbuf[i]) then begin + Inc( i ); +{$IFDEF WITH_TENC} + end else if IsMBCharLeadByte(textbuf[i],TENC) then begin + state := LengthMBChar( textbuf[i], TENC ); + i := i + state; +{$ELSE WITH_TENC} + end else if IsMBCharLeadByte(textbuf[i]) then begin + state := LengthMBChar( textbuf[i] ); + i := i + state; +{$ENDIF WITH_TENC} + end else begin + for j := i + 1 to MaxTextBuf do begin + textbuf[j - 1] := textbuf[j]; + end; + end; + end; + + Windows.EnableWindow( myhwSDL, True ); + Windows.BringWindowToTop( myhwSDL ); + Windows.DestroyWindow( mydlg ); + mydlg := 0; + exit(0); + end; + end; + end; + EditProc := Windows.CallWindowProc( Org_edit, myhwnd, msg, wp, lp ); +end; + +Procedure PrepareDlgProc( myhwnd: Windows.HWND ); +var + lf: Windows.LOGFONT; + myhimc: imm.HIMC; +{$IFDEF WITH_TENC} + pmsg: PChar; + ptmsg: PChar; +{$ENDIF WITH_TENC} +begin + Windows.ZeroMemory( @lf, sizeof(Windows.LOGFONT) ); +{$IFDEF WITH_TENC} + pmsg := QuickPCopy( MSWINGUI_FontName ); + ptmsg := lf.lfFaceName; + Conv_FromTenc( pmsg, Length(pmsg), ptmsg, sizeof(lf.lfFaceName) ); + Dispose( pmsg ); +{$ENDIF WITH_TENC} + With lf do + begin + lfHeight := MSWINGUI_FontSize; + lfOutPrecision := Windows.OUT_DEFAULT_PRECIS; + lfClipPrecision := Windows.CLIP_DEFAULT_PRECIS; + lfQuality := Windows.DEFAULT_QUALITY; + lfWeight := MSWINGUI_FontWeight; + lfPitchAndFamily := Windows.FIXED_PITCH or Windows.FF_DONTCARE; +{$IFDEF WITH_TENC} +{$ELSE WITH_TENC} + lfFaceName := MSWINGUI_FontName + #0; +{$ENDIF WITH_TENC} + lfCharSet := Windows.DEFAULT_CHARSET; + end; + myfont := Windows.CreateFontIndirect( @lf ); + + dlgTitle := Windows.CreateWindow( + 'STATIC'#0, Nil, + Windows.WS_CHILD or Windows.WS_VISIBLE or Windows.SS_CENTER, + bw, bw, dw-bw*2, th*2, + myhwnd, Windows.HMENU(1), myhInst, NIL ); + dlgEdit := Windows.CreateWindow( + 'EDIT'#0, NIL, + Windows.WS_CHILD or Windows.WS_VISIBLE or Windows.ES_CENTER, + bw, bw*2+th*2, dw-bw*2, th, + myhwnd, Windows.HMENU(2), myhInst, NIL ); + Org_edit := Windows.WNDPROC( Windows.GetWindowLong(dlgEdit, Windows.GWL_WNDPROC) ); + Windows.SetWindowLong( dlgEdit, Windows.GWL_WNDPROC, LongInt(@EditProc) ); + + myhimc := imm.ImmGetContext( myhwnd ); + imm.ImmSetOpenStatus( myhimc, bIMEMode ); + imm.ImmReleaseContext( myhwnd, myhimc ); +end; + +Procedure DestroyDlgProc( myhwnd: Windows.HWND ); +var + myhimc: imm.HIMC; +begin + if ( not Windows.DeleteObject(myfont) ) then begin +{$IFDEF PATCH_GH} + ErrorMessage( 'failed to delete font. ' ); +{$ELSE PATCH_GH} + WriteLn( 'failed to delete font. ' ); +{$ENDIF PATCH_GH} + end; + myfont := 0; + + myhimc := imm.ImmGetContext( myhwnd ); + bIMEMode := imm.ImmGetOpenStatus( myhimc ); + imm.ImmSetOpenStatus( myhimc, False ); + imm.ImmReleaseContext( myhwnd, myhimc ); +end; + +Function DlgProc( myhwnd: Windows.HWND; msg: UINT; wp: Windows.WPARAM; lp: Windows.LPARAM ): Windows.LRESULT; StdCall; +var + hd: Windows.HDC; +begin + Case msg of + Windows.WM_CREATE: + begin + PrepareDlgProc( myhwnd ); + end; + + Windows.WM_DESTROY: + begin + DestroyDlgProc( myhwnd ); + end; + + Windows.WM_SETFOCUS: + begin + Windows.SetFocus( dlgEdit ); + end; + + Windows.WM_CTLCOLORSTATIC: + begin + hd := Windows.HDC(wp); + if (dlgTitle = Windows.HWND(lp)) then begin + Windows.SelectObject( hd, myfont ); + Windows.SetBkMode( hd, Windows.TRANSPARENT ); + Windows.SetTextColor( hd, Windows.RGB(255,255,255) ); + Windows.SetBkColor( hd, Windows.RGB(0,101,151) ); + exit(Windows.LRESULT(hbBorderBlue)); + end; + end; + + Windows.WM_CTLCOLOREDIT: + begin + hd := Windows.HDC(wp); + if (dlgEdit = Windows.HWND(lp)) then begin + Windows.SelectObject( hd, myfont ); + Windows.SetTextColor( hd, Windows.RGB(0,141,0) ); + Windows.SetBkColor( hd, Windows.RGB(0,0,0) ); + exit(Windows.LRESULT( Windows.GetStockObject(Windows.BLACK_BRUSH) )); + end; + end; + end; + DlgProc := Windows.DefWindowProc( myhwnd, msg, wp, lp ); +end; + + +Function EditBox( const title , text: String ): String; +{$IFDEF WITH_TENC} +const + cmsgLen = 255; +{$ENDIF WITH_TENC} +var + mymsg: Windows.MSG; + rc: Windows.RECT; + pt: PChar; + msg: String; + pmsg: PChar; +{$IFDEF WITH_TENC} + tmsg: Array[0..cmsgLen] of Char; + ptmsg: PChar; +{$ENDIF WITH_TENC} +begin + myhwSDL := GetSDLHWND; + th := myTextHeight(myhwSDL) + 3; + rc := myWndPos(myhwSDL); + + mydlg := Windows.CreateWindow( + mywcname, NIL, + DWORD(Windows.WS_POPUP) or Windows.WS_BORDER, {<-Cast: error Range Check...} + rc.left+40, rc.top+300, dw, bw*3+th*3, + myhwSDL, 0, myhInst, NIL ); + + if mydlg = 0 then begin + msg := 'Windows.CreateWindow() failed.'; + pmsg := QuickPCopy(msg); +{$IFDEF WITH_TENC} + ptmsg := tmsg; + Conv_ToTenc( pmsg, Length(pmsg), ptmsg, cmsgLen ); + Windows.MessageBox( 0, tmsg, 'Sorry'#0, MB_OK ); +{$ELSE WITH_TENC} + Windows.MessageBox( 0, pmsg, 'Sorry'#0, MB_OK ); +{$ENDIF WITH_TENC} + Dispose( pmsg ); + end; + + pt := QuickPCopy( title ); +{$IFDEF WITH_TENC} + pmsg := pt; + ptmsg := tmsg; + Conv_ToTenc( pmsg, Length(pmsg), ptmsg, cmsgLen ); + Windows.SetWindowText( dlgTitle, tmsg ); +{$ELSE WITH_TENC} + Windows.SetWindowText( dlgTitle, pt ); +{$ENDIF WITH_TENC} + Dispose(pt); + pt := QuickPCopy( text ); +{$IFDEF WITH_TENC} + pmsg := pt; + ptmsg := tmsg; + Conv_ToTenc( pmsg, Length(pmsg), ptmsg, cmsgLen ); + Windows.SetWindowText( dlgEdit, tmsg ); +{$ELSE WITH_TENC} + Windows.SetWindowText( dlgEdit, pt ); +{$ENDIF WITH_TENC} + Dispose(pt); + + Windows.SetFocus( dlgEdit ); + Windows.SendMessage( dlgEdit, Windows.EM_SETSEL, 0, -1 ); + Windows.ShowWindow( mydlg, SW_SHOW ); + Windows.EnableWindow( myhwSDL, FALSE ); + + while( mydlg <> 0 ) do begin + Windows.GetMessage( @mymsg, 0, 0, 0 ); + Windows.TranslateMessage( @mymsg ); + Windows.DispatchMessage( @mymsg ); + end; + + pmsg := textbuf; +{$IFDEF WITH_TENC} + ptmsg := tmsg; + Conv_FromTenc( pmsg, Length(pmsg), ptmsg, cmsgLen ); + EditBox := StrPas(tmsg); +{$ELSE WITH_TENC} + EditBox := StrPas(pmsg); +{$ENDIF WITH_TENC} +end; + +Procedure InitEditBox; +{$IFDEF WITH_TENC} +const + cmsgLen = 255; +{$ENDIF WITH_TENC} +var + mywc: Windows.WNDCLASSEX; + msg: String; + pmsg: PChar; +{$IFDEF WITH_TENC} + tmsg: Array[0..cmsgLen] of Char; + ptmsg: PChar; +{$ENDIF WITH_TENC} +begin + myhinst := Windows.GetModuleHandle( NIL ); + + With mywc do + begin + cbSize := sizeof(mywc); + style := Windows.CS_HREDRAW or Windows.CS_VREDRAW; + lpfnWndProc := @DlgProc; + cbClsExtra := 0; + cbWndExtra := 0; + hInstance := myhinst; + hIcon := 0; + hCursor := Windows.LoadCursor( 0, Windows.IDC_ARROW ); + hbrBackground := hbBorderBlue; + lpszMenuName := NIL; + lpszClassName := mywcname; + hIconSm := 0; + end; + + if (Windows.RegisterClassEX( @mywc ) = 0) then begin + msg := 'Windows.RegisterClassEX() failed.'; + pmsg := QuickPCopy(msg); +{$IFDEF WITH_TENC} + ptmsg := tmsg; + Conv_ToTenc( pmsg, Length(pmsg), ptmsg, cmsgLen ); + Windows.MessageBox( 0, tmsg, 'Sorry'#0, MB_OK ); +{$ELSE WITH_TENC} + Windows.MessageBox( 0, pmsg, 'Sorry'#0, MB_OK ); +{$ENDIF WITH_TENC} + Dispose( pmsg ); + end; +end; + + + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: w32eb.pp'); +{$ENDIF DEBUG} + hbBorderBlue := Windows.CreateSolidBrush( Windows.RGB(0,101,151) ); + InitEditBox; +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: w32eb.pp(finalization)'); +{$ENDIF DEBUG} + Windows.DeleteObject( hbBorderBlue ); +end; + +end. +{$ENDIF Windows} diff -x .svn -uprN GearHead1100repository.original/wmonster.pp branches/wmonster.pp --- GearHead1100repository.original/wmonster.pp 2012-01-09 14:01:36.526131000 +0900 +++ branches/wmonster.pp 2009-08-16 01:47:56.929119000 +0900 @@ -22,7 +22,11 @@ unit WMonster; interface -uses gears,locale; +uses +{$IFDEF PATCH_GH} + gears_base, +{$ENDIF PATCH_GH} + gears,locale; const { This is the minimum point value for meks when calling the STOCKSCENE } @@ -41,11 +45,18 @@ Procedure StockSceneWithMonsters( Scene: implementation +uses + dos, +{$IFDEF DEBUG} + errmsg, +{$ENDIF DEBUG} + ability,action,gearutil,ghchars,ghparser,texutil, {$IFDEF SDLMODE} -uses dos,ability,action,gearutil,ghchars,ghparser,texutil,sdlmap; -{$ELSE} -uses dos,ability,action,gearutil,ghchars,ghparser,texutil,conmap; -{$ENDIF} + sdlmap +{$ELSE SDLMODE} + conmap +{$ENDIF SDLMODE} + ; Function MatchWeight( S, M: String ): Integer; { Return a value showing how well the monster M matches the } @@ -82,6 +93,19 @@ begin N := 1; Total := 0; while WM <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < WM^.G) then begin + { If this monster matches our criteria, add its number to the list. } + if ( WM^.V <= MTV ) and ( WM^.Scale <= Scale ) then begin + Match := MatchWeight( MDesc , SAttValue( WM^.SA , 'TYPE' ) ); + SetNAtt( ShoppingList , 0 , N , Match ); + Total := Total + Match; + end; + Inc( N ); + end; + { Move to the next monster, and increase the monster index. } + WM := WM^.Next; +{$ELSE PATCH_GH} { If this monster matches our criteria, add its number to the list. } if ( WM^.V <= MTV ) and ( WM^.Scale <= Scale ) then begin Match := MatchWeight( MDesc , SAttValue( WM^.SA , 'TYPE' ) ); @@ -92,6 +116,7 @@ begin { Move to the next monster, and increase the monster index. } WM := WM^.Next; Inc( N ); +{$ENDIF PATCH_GH} end; if Total > 0 then begin @@ -135,6 +160,20 @@ begin N := 1; Total := 0; while WM <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < WM^.G) then begin + { If this monster matches our criteria, add its number to the list. } + if ( WM^.V <= MTV ) and ( WM^.Scale <= GB^.Scale ) then begin + Match := MatchWeight( WMonType , SAttValue( WM^.SA , 'TYPE' ) ); + SetNAtt( ShoppingList , N , N , Match ); + Total := Total + Match; + + end; + Inc( N ); + end; + { Move to the next monster, and increase the monster index. } + WM := WM^.Next; +{$ELSE PATCH_GH} { If this monster matches our criteria, add its number to the list. } if ( WM^.V <= MTV ) and ( WM^.Scale <= GB^.Scale ) then begin Match := MatchWeight( WMonType , SAttValue( WM^.SA , 'TYPE' ) ); @@ -148,6 +187,7 @@ begin { Move to the next monster, and increase the monster index. } WM := WM^.Next; Inc( N ); +{$ENDIF PATCH_GH} end; @@ -198,6 +238,20 @@ begin { monsters. If they don't have enough PV, add some monsters. } Team := GB^.Scene^.SubCom; while Team <> Nil do begin +{$IFDEF PATCH_GH} + if (GG_DisposeGear < Team^.G) then begin + { if this gear is a team, and it has a wandering monster } + { allocation set, add some monsters. } + if ( Team^.G = GG_Team ) and ( Team^.STat[ STAT_WanderMon ] > 0 ) then begin + { Calculate total point value of this team's units. } + TPV := TeamTV( GB^.Meks , Team^.S ); + + if TPV < Team^.Stat[ STAT_WanderMon ] then begin + AddRandomMonsters( GB , Team , Team^.Stat[ STAT_WanderMon ] - TPV ); + end; + end; + end; +{$ELSE PATCH_GH} { if this gear is a team, and it has a wandering monster } { allocation set, add some monsters. } if ( Team^.G = GG_Team ) and ( Team^.STat[ STAT_WanderMon ] > 0 ) then begin @@ -208,7 +262,7 @@ begin AddRandomMonsters( GB , Team , Team^.Stat[ STAT_WanderMon ] - TPV ); end; end; - +{$ENDIF PATCH_GH} { Move to the next gear. } Team := Team^.Next; end; @@ -241,9 +295,21 @@ begin { process them. } While DosError = 0 do begin { Load this mecha design file from disk. } +{$IFDEF PATCH_I18N} + Assign( F , Design_Directory + TextDecode(SRec.Name) ); +{$ELSE PATCH_I18N} Assign( F , Design_Directory + SRec.Name ); +{$ENDIF PATCH_I18N} reset(F); +{$IFDEF PATCH_GH} +{$IFDEF PATCH_I18N} + DList := ReadGear(F, Design_Directory + TextDecode(SRec.Name)); +{$ELSE PATCH_I18N} + DList := ReadGear(F, Design_Directory + SRec.Name); +{$ENDIF PATCH_I18N} +{$ELSE PATCH_GH} DList := ReadGear(F); +{$ENDIF PATCH_GH} Close(F); { Search through it for mecha. } @@ -253,9 +319,17 @@ begin if ( Mek^.G = GG_Mecha ) then begin if ( GearValue( Mek ) <= MPV ) then begin Current := CreateSAtt( it ); +{$IFDEF PATCH_I18N} + Current^.Info := BStr( GearValue( Mek ) ) + ' ' + BStr( N ) + ' <' + TextDecode(SRec.Name) + '>'; +{$ELSE PATCH_I18N} Current^.Info := BStr( GearValue( Mek ) ) + ' ' + BStr( N ) + ' <' + SRec.Name + '>'; +{$ENDIF PATCH_I18N} end else if ( GearValue( Mek ) < MinValFound ) or ( MinValFound = 0 ) then begin +{$IFDEF PATCH_I18N} + MVInfo := BStr( GearValue( Mek ) ) + ' ' + BStr( N ) + ' <' + TextDecode(SRec.Name) + '>'; +{$ELSE PATCH_I18N} MVInfo := BStr( GearValue( Mek ) ) + ' ' + BStr( N ) + ' <' + SRec.Name + '>'; +{$ENDIF PATCH_I18N} MinValFound := GearValue( Mek ); end; end; @@ -295,7 +369,11 @@ Function PurchaseForces( ShoppingList: S { Load the design file. } Assign(F, Design_Directory + RetrieveAString( S ) ); reset(F); +{$IFDEF PATCH_GH} + FList := ReadGear(F, Design_Directory + RetrieveAString( S )); +{$ELSE PATCH_GH} FList := ReadGear(F); +{$ENDIF PATCH_GH} Close(F); { Get the number of the mek we want. } @@ -367,20 +445,34 @@ begin Lvl := Random( 6 ); StPt := StPt - ( Lvl * 3 ); SkPt := SkPt - ( Lvl div 2 ); +{$IFDEF PATCH_GH} + MPV := ( Int64(MPV) * Int64(10 - Lvl) ) div 10; +{$ELSE PATCH_GH} MPV := ( MPV * ( 10 - Lvl ) ) div 10; +{$ENDIF PATCH_GH} end else if Random( MPV ) < Random( UPV ) then begin { Level will be between 0 and 20 } Lvl := Random( 21 ); { Make sure we don't go overboard. } +{$IFDEF PATCH_GH} + while ( ( ( Int64(MPV) * Int64(5 + Lvl) ) div 5 ) > Int64(UPV) ) and ( Lvl > 0 ) do begin + Dec( Lvl ); + end; +{$ELSE PATCH_GH} while ( ( ( MPV * ( 5 + Lvl ) ) div 5 ) > UPV ) and ( Lvl > 0 ) do begin Dec( Lvl ); end; +{$ENDIF PATCH_GH} StPt := StPt + Lvl; SkPt := SkPt + ( Lvl div 2 ); +{$IFDEF PATCH_GH} + MPV := ( Int64(MPV) * Int64(5 + Lvl) ) div 5; +{$ELSE PATCH_GH} MPV := ( MPV * ( 5 + Lvl ) ) div 5; +{$ENDIF PATCH_GH} end; { Add this mecha to our list. } @@ -434,7 +526,11 @@ var begin Assign( F , PC_Equipment_File ); Reset( F ); +{$IFDEF PATCH_GH} + EquipList := ReadGear( F, PC_Equipment_File ); +{$ELSE PATCH_GH} EquipList := ReadGear( F ); +{$ENDIF PATCH_GH} Close( F ); AvgPointValue := 800; @@ -547,4 +643,19 @@ begin end; + +initialization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: wmonster.pp'); +{$ENDIF DEBUG} +end; + +finalization +begin +{$IFDEF DEBUG} + ErrorMessage_fork('DEBUG: wmonster.pp(finalization)'); +{$ENDIF DEBUG} +end; + end.