hedgewars/uCommandHandlers.pas
changeset 4661 f5d858e4b634
parent 4611 445d382cd401
child 4744 ecc2c757d0df
child 4808 7c3e5b52344a
equal deleted inserted replaced
4660:8ff3dead5850 4661:f5d858e4b634
   163 s:= s; // avoid compiler hint
   163 s:= s; // avoid compiler hint
   164 if CheckNoTeamOrHH or isPaused then exit;
   164 if CheckNoTeamOrHH or isPaused then exit;
   165 if not CurrentTeam^.ExtDriven then SendIPC('L');
   165 if not CurrentTeam^.ExtDriven then SendIPC('L');
   166 bShowFinger:= false;
   166 bShowFinger:= false;
   167 with CurrentHedgehog^.Gear^ do
   167 with CurrentHedgehog^.Gear^ do
   168     Message:= Message or (gmLeft and InputMask)
   168     Message:= Message or (gmLeft and InputMask);
       
   169     ScriptCall('onLeft');
   169 end;
   170 end;
   170 
   171 
   171 procedure chLeft_m(var s: shortstring);
   172 procedure chLeft_m(var s: shortstring);
   172 begin
   173 begin
   173 s:= s; // avoid compiler hint
   174 s:= s; // avoid compiler hint
   174 if CheckNoTeamOrHH then exit;
   175 if CheckNoTeamOrHH then exit;
   175 if not CurrentTeam^.ExtDriven then SendIPC('l');
   176 if not CurrentTeam^.ExtDriven then SendIPC('l');
   176 with CurrentHedgehog^.Gear^ do
   177 with CurrentHedgehog^.Gear^ do
   177     Message:= Message and not (gmLeft and InputMask)
   178     Message:= Message and not (gmLeft and InputMask);
       
   179     ScriptCall('onLeftUp');
   178 end;
   180 end;
   179 
   181 
   180 procedure chRight_p(var s: shortstring);
   182 procedure chRight_p(var s: shortstring);
   181 begin
   183 begin
   182 s:= s; // avoid compiler hint
   184 s:= s; // avoid compiler hint
   183 if CheckNoTeamOrHH or isPaused then exit;
   185 if CheckNoTeamOrHH or isPaused then exit;
   184 if not CurrentTeam^.ExtDriven then SendIPC('R');
   186 if not CurrentTeam^.ExtDriven then SendIPC('R');
   185 bShowFinger:= false;
   187 bShowFinger:= false;
   186 with CurrentHedgehog^.Gear^ do
   188 with CurrentHedgehog^.Gear^ do
   187     Message:= Message or (gmRight and InputMask)
   189     Message:= Message or (gmRight and InputMask);
       
   190     ScriptCall('onRight');
   188 end;
   191 end;
   189 
   192 
   190 procedure chRight_m(var s: shortstring);
   193 procedure chRight_m(var s: shortstring);
   191 begin
   194 begin
   192 s:= s; // avoid compiler hint
   195 s:= s; // avoid compiler hint
   193 if CheckNoTeamOrHH then exit;
   196 if CheckNoTeamOrHH then exit;
   194 if not CurrentTeam^.ExtDriven then SendIPC('r');
   197 if not CurrentTeam^.ExtDriven then SendIPC('r');
   195 with CurrentHedgehog^.Gear^ do
   198 with CurrentHedgehog^.Gear^ do
   196     Message:= Message and not (gmRight and InputMask)
   199     Message:= Message and not (gmRight and InputMask);
       
   200     ScriptCall('onRightUp');
   197 end;
   201 end;
   198 
   202 
   199 procedure chUp_p(var s: shortstring);
   203 procedure chUp_p(var s: shortstring);
   200 begin
   204 begin
   201 s:= s; // avoid compiler hint
   205 s:= s; // avoid compiler hint
   202 if CheckNoTeamOrHH or isPaused then exit;
   206 if CheckNoTeamOrHH or isPaused then exit;
   203 if not CurrentTeam^.ExtDriven then SendIPC('U');
   207 if not CurrentTeam^.ExtDriven then SendIPC('U');
   204 bShowFinger:= false;
   208 bShowFinger:= false;
   205 with CurrentHedgehog^.Gear^ do
   209 with CurrentHedgehog^.Gear^ do
   206     Message:= Message or (gmUp and InputMask)
   210     Message:= Message or (gmUp and InputMask);
       
   211     ScriptCall('onUp');
   207 end;
   212 end;
   208 
   213 
   209 procedure chUp_m(var s: shortstring);
   214 procedure chUp_m(var s: shortstring);
   210 begin
   215 begin
   211 s:= s; // avoid compiler hint
   216 s:= s; // avoid compiler hint
   212 if CheckNoTeamOrHH then exit;
   217 if CheckNoTeamOrHH then exit;
   213 if not CurrentTeam^.ExtDriven then SendIPC('u');
   218 if not CurrentTeam^.ExtDriven then SendIPC('u');
   214 with CurrentHedgehog^.Gear^ do
   219 with CurrentHedgehog^.Gear^ do
   215     Message:= Message and not (gmUp and InputMask);
   220     Message:= Message and not (gmUp and InputMask);
       
   221     ScriptCall('onUpUp');
   216 end;
   222 end;
   217 
   223 
   218 procedure chDown_p(var s: shortstring);
   224 procedure chDown_p(var s: shortstring);
   219 begin
   225 begin
   220 s:= s; // avoid compiler hint
   226 s:= s; // avoid compiler hint
   221 if CheckNoTeamOrHH or isPaused then exit;
   227 if CheckNoTeamOrHH or isPaused then exit;
   222 if not CurrentTeam^.ExtDriven then SendIPC('D');
   228 if not CurrentTeam^.ExtDriven then SendIPC('D');
   223 bShowFinger:= false;
   229 bShowFinger:= false;
   224 with CurrentHedgehog^.Gear^ do
   230 with CurrentHedgehog^.Gear^ do
   225     Message:= Message or (gmDown and InputMask)
   231     Message:= Message or (gmDown and InputMask);
       
   232     ScriptCall('onDown');
   226 end;
   233 end;
   227 
   234 
   228 procedure chDown_m(var s: shortstring);
   235 procedure chDown_m(var s: shortstring);
   229 begin
   236 begin
   230 s:= s; // avoid compiler hint
   237 s:= s; // avoid compiler hint
   231 if CheckNoTeamOrHH then exit;
   238 if CheckNoTeamOrHH then exit;
   232 if not CurrentTeam^.ExtDriven then SendIPC('d');
   239 if not CurrentTeam^.ExtDriven then SendIPC('d');
   233 with CurrentHedgehog^.Gear^ do
   240 with CurrentHedgehog^.Gear^ do
   234     Message:= Message and not (gmDown and InputMask)
   241     Message:= Message and not (gmDown and InputMask);
       
   242     ScriptCall('onDownUp');
   235 end;
   243 end;
   236 
   244 
   237 procedure chPrecise_p(var s: shortstring);
   245 procedure chPrecise_p(var s: shortstring);
   238 begin
   246 begin
   239 s:= s; // avoid compiler hint
   247 s:= s; // avoid compiler hint
   240 if CheckNoTeamOrHH or isPaused then exit;
   248 if CheckNoTeamOrHH or isPaused then exit;
   241 if not CurrentTeam^.ExtDriven then SendIPC('Z');
   249 if not CurrentTeam^.ExtDriven then SendIPC('Z');
   242 bShowFinger:= false;
   250 bShowFinger:= false;
   243 with CurrentHedgehog^.Gear^ do
   251 with CurrentHedgehog^.Gear^ do
   244     Message:= Message or (gmPrecise and InputMask);
   252     Message:= Message or (gmPrecise and InputMask);
       
   253     ScriptCall('onPrecise');
   245 end;
   254 end;
   246 
   255 
   247 procedure chPrecise_m(var s: shortstring);
   256 procedure chPrecise_m(var s: shortstring);
   248 begin
   257 begin
   249 s:= s; // avoid compiler hint
   258 s:= s; // avoid compiler hint
   250 if CheckNoTeamOrHH then exit;
   259 if CheckNoTeamOrHH then exit;
   251 if not CurrentTeam^.ExtDriven then SendIPC('z');
   260 if not CurrentTeam^.ExtDriven then SendIPC('z');
   252 with CurrentHedgehog^.Gear^ do
   261 with CurrentHedgehog^.Gear^ do
   253     Message:= Message and not (gmPrecise and InputMask);
   262     Message:= Message and not (gmPrecise and InputMask);
       
   263     ScriptCall('onPreciseUp');
   254 end;
   264 end;
   255 
   265 
   256 procedure chLJump(var s: shortstring);
   266 procedure chLJump(var s: shortstring);
   257 begin
   267 begin
   258 s:= s; // avoid compiler hint
   268 s:= s; // avoid compiler hint
   259 if CheckNoTeamOrHH or isPaused then exit;
   269 if CheckNoTeamOrHH or isPaused then exit;
   260 if not CurrentTeam^.ExtDriven then SendIPC('j');
   270 if not CurrentTeam^.ExtDriven then SendIPC('j');
   261 bShowFinger:= false;
   271 bShowFinger:= false;
   262 with CurrentHedgehog^.Gear^ do
   272 with CurrentHedgehog^.Gear^ do
   263     Message:= Message or (gmLJump and InputMask)
   273     Message:= Message or (gmLJump and InputMask);
       
   274     ScriptCall('onLJump');
   264 end;
   275 end;
   265 
   276 
   266 procedure chHJump(var s: shortstring);
   277 procedure chHJump(var s: shortstring);
   267 begin
   278 begin
   268 s:= s; // avoid compiler hint
   279 s:= s; // avoid compiler hint
   269 if CheckNoTeamOrHH or isPaused then exit;
   280 if CheckNoTeamOrHH or isPaused then exit;
   270 if not CurrentTeam^.ExtDriven then SendIPC('J');
   281 if not CurrentTeam^.ExtDriven then SendIPC('J');
   271 bShowFinger:= false;
   282 bShowFinger:= false;
   272 with CurrentHedgehog^.Gear^ do
   283 with CurrentHedgehog^.Gear^ do
   273     Message:= Message or (gmHJump and InputMask)
   284     Message:= Message or (gmHJump and InputMask);
       
   285     ScriptCall('onHJump');
   274 end;
   286 end;
   275 
   287 
   276 procedure chAttack_p(var s: shortstring);
   288 procedure chAttack_p(var s: shortstring);
   277 begin
   289 begin
   278 s:= s; // avoid compiler hint
   290 s:= s; // avoid compiler hint
   283     {$IFDEF DEBUGFILE}AddFileLog('/+attack: hedgehog''s Gear^.State = '+inttostr(State));{$ENDIF}
   295     {$IFDEF DEBUGFILE}AddFileLog('/+attack: hedgehog''s Gear^.State = '+inttostr(State));{$ENDIF}
   284     if ((State and gstHHDriven) <> 0) then
   296     if ((State and gstHHDriven) <> 0) then
   285         begin
   297         begin
   286         FollowGear:= CurrentHedgehog^.Gear;
   298         FollowGear:= CurrentHedgehog^.Gear;
   287         if not CurrentTeam^.ExtDriven then SendIPC('A');
   299         if not CurrentTeam^.ExtDriven then SendIPC('A');
   288         Message:= Message or (gmAttack and InputMask)
   300         Message:= Message or (gmAttack and InputMask);
       
   301 	ScriptCall('onAttack');
   289         end
   302         end
   290     end
   303     end
   291 end;
   304 end;
   292 
   305 
   293 procedure chAttack_m(var s: shortstring);
   306 procedure chAttack_m(var s: shortstring);
   296 if CheckNoTeamOrHH then exit;
   309 if CheckNoTeamOrHH then exit;
   297 with CurrentHedgehog^.Gear^ do
   310 with CurrentHedgehog^.Gear^ do
   298     begin
   311     begin
   299     if not CurrentTeam^.ExtDriven and
   312     if not CurrentTeam^.ExtDriven and
   300         ((Message and gmAttack) <> 0) then SendIPC('a');
   313         ((Message and gmAttack) <> 0) then SendIPC('a');
   301     Message:= Message and not (gmAttack and InputMask)
   314     Message:= Message and not (gmAttack and InputMask);
       
   315     ScriptCall('onAttackUp');
   302     end
   316     end
   303 end;
   317 end;
   304 
   318 
   305 procedure chSwitch(var s: shortstring);
   319 procedure chSwitch(var s: shortstring);
   306 begin
   320 begin
   307 s:= s; // avoid compiler hint
   321 s:= s; // avoid compiler hint
   308 if CheckNoTeamOrHH or isPaused then exit;
   322 if CheckNoTeamOrHH or isPaused then exit;
   309 if not CurrentTeam^.ExtDriven then SendIPC('S');
   323 if not CurrentTeam^.ExtDriven then SendIPC('S');
   310 bShowFinger:= false;
   324 bShowFinger:= false;
   311 with CurrentHedgehog^.Gear^ do
   325 with CurrentHedgehog^.Gear^ do
   312     Message:= Message or (gmSwitch and InputMask)
   326     Message:= Message or (gmSwitch and InputMask);
       
   327     ScriptCall('onSwitch');
   313 end;
   328 end;
   314 
   329 
   315 procedure chNextTurn(var s: shortstring);
   330 procedure chNextTurn(var s: shortstring);
   316 begin
   331 begin
   317     s:= s; // avoid compiler hint
   332     s:= s; // avoid compiler hint
   330 if not CurrentTeam^.ExtDriven then SendIPC(s);
   345 if not CurrentTeam^.ExtDriven then SendIPC(s);
   331 bShowFinger:= false;
   346 bShowFinger:= false;
   332 with CurrentHedgehog^.Gear^ do
   347 with CurrentHedgehog^.Gear^ do
   333     begin
   348     begin
   334     Message:= Message or (gmTimer and InputMask);
   349     Message:= Message or (gmTimer and InputMask);
   335     MsgParam:= byte(s[1]) - ord('0')
   350     MsgParam:= byte(s[1]) - ord('0');
       
   351     ScriptCall('onTimer');
   336     end
   352     end
   337 end;
   353 end;
   338 
   354 
   339 procedure chSlot(var s: shortstring);
   355 procedure chSlot(var s: shortstring);
   340 var slot: LongWord;
   356 var slot: LongWord;
   345 if not CurrentTeam^.ExtDriven then SendIPC(char(byte(s[1]) + 79));
   361 if not CurrentTeam^.ExtDriven then SendIPC(char(byte(s[1]) + 79));
   346 bShowFinger:= false;
   362 bShowFinger:= false;
   347 with CurrentHedgehog^.Gear^ do
   363 with CurrentHedgehog^.Gear^ do
   348     begin
   364     begin
   349     Message:= Message or (gmSlot and InputMask);
   365     Message:= Message or (gmSlot and InputMask);
   350     MsgParam:= slot
   366     MsgParam:= slot; 
       
   367     ScriptCall('onSlot');
   351     end
   368     end
   352 end;
   369 end;
   353 
   370 
   354 procedure chSetWeapon(var s: shortstring);
   371 procedure chSetWeapon(var s: shortstring);
   355 begin
   372 begin
   361 
   378 
   362     with CurrentHedgehog^.Gear^ do
   379     with CurrentHedgehog^.Gear^ do
   363     begin
   380     begin
   364         Message:= Message or (gmWeapon and InputMask);
   381         Message:= Message or (gmWeapon and InputMask);
   365         MsgParam:= byte(s[1]);
   382         MsgParam:= byte(s[1]);
       
   383 	ScriptCall('onSetWeapon');
   366     end;
   384     end;
   367 end;
   385 end;
   368 
   386 
   369 procedure chTaunt(var s: shortstring);
   387 procedure chTaunt(var s: shortstring);
   370 begin
   388 begin
   375 if not CurrentTeam^.ExtDriven then SendIPC('t' + s);
   393 if not CurrentTeam^.ExtDriven then SendIPC('t' + s);
   376 
   394 
   377 with CurrentHedgehog^.Gear^ do
   395 with CurrentHedgehog^.Gear^ do
   378     begin
   396     begin
   379     Message:= Message or (gmAnimate and InputMask);
   397     Message:= Message or (gmAnimate and InputMask);
   380     MsgParam:= byte(s[1])
   398     MsgParam:= byte(s[1]) ; 
       
   399     ScriptCall('onTaunt');
   381     end
   400     end
   382 end;
   401 end;
   383 
   402 
   384 procedure chPut(var s: shortstring);
   403 procedure chPut(var s: shortstring);
   385 begin
   404 begin