1 (*

     2  * Hedgewars, a worms-like game

     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * Distributed under the terms of the BSD-modified licence:

     6  *

     7  * Permission is hereby granted, free of charge, to any person obtaining a copy

     8  * of this software and associated documentation files (the "Software"), to deal

     9  * with the Software without restriction, including without limitation the

    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or

    11  * sell copies of the Software, and to permit persons to whom the Software is

    12  * furnished to do so, subject to the following conditions:

    13  *

    14  * 1. Redistributions of source code must retain the above copyright notice,

    15  *    this list of conditions and the following disclaimer.

    16  * 2. Redistributions in binary form must reproduce the above copyright notice,

    17  *    this list of conditions and the following disclaimer in the documentation

    18  *    and/or other materials provided with the distribution.

    19  * 3. The name of the author may not be used to endorse or promote products

    20  *    derived from this software without specific prior written permission.

    21  *

    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED

    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF

    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO

    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,

    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,

    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;

    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,

    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR

    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF

    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

    32  *)

    33 

    34 unit uConsole;

    35 interface

    36 uses SDLh;

    37 {$INCLUDE options.inc}

    38 const isDeveloperMode: boolean = true;

    39 type TVariableType = (vtCommand, vtInteger, vtReal, vtBoolean);

    40      TCommandHandler = procedure (var params: shortstring);

    41 

    42 procedure DrawConsole(Surface: PSDL_Surface);

    43 procedure WriteToConsole(s: shortstring);

    44 procedure WriteLnToConsole(s: shortstring);

    45 procedure KeyPressConsole(Key: Longword);

    46 procedure ParseCommand(CmdStr: shortstring);

    47 procedure AfterAttack; // экспортируется только для вызова из CurrAmmoGear

    48 

    49 implementation

    50 {$J+}

    51 uses uMisc, uStore, Types, uConsts, uGears, uTeams, uIO, uKeys, uSound, uWorld, uLand;

    52 const cLineWidth: integer = 0;

    53       cLinesCount = 256;

    54       

    55 type  PVariable = ^TVariable;

    56       TVariable = record

    57                      Next: PVariable;

    58                      Name: string[15];

    59                     VType: TVariableType;

    60                   Handler: pointer;

    61                   end;

    62 

    63 var   ConsoleLines: array[byte] of ShortString;

    64       CurrLine: integer = 0;

    65       InputStr: shortstring;

    66       Variables: PVariable = nil;

    67 

    68 function RegisterVariable(Name: string; VType: TVariableType; p: pointer): PVariable;

    69 begin

    70 try

    71    New(Result);

    72 except Result:= nil; OutError(errmsgDynamicVar, true) end;

    73 FillChar(Result^, sizeof(TVariable), 0);

    74 Result.Name:= Name;

    75 Result.VType:= VType;

    76 Result.Handler:= p;

    77 if Variables = nil then Variables:= Result

    78                    else begin

    79                         Result.Next:= Variables;

    80                         Variables:= Result

    81                         end

    82 end;

    83 

    84 procedure FreeVariablesList;

    85 var t, tt: PVariable;

    86 begin

    87 tt:= Variables;

    88 Variables:= nil;

    89 while tt<>nil do

    90       begin

    91       t:= tt;

    92       tt:= tt.Next;

    93       try

    94       Dispose(t)

    95       except OutError(errmsgDynamicVar) end;

    96       end;

    97 end;

    98 

    99 procedure SplitBySpace(var a, b: shortstring);

   100 var i, t: integer;

   101 begin

   102 i:= Pos(' ', a);

   103 if i>0 then

   104    begin

   105    for t:= 1 to Pred(i) do

   106        if (a[t] >= 'A')and(a[t] <= 'Z') then Inc(a[t], 32);

   107    b:= copy(a, i + 1, Length(a) - i);

   108    while (b[0]<>#0) and (b[1]=#32) do Delete(b, 1, 1);

   109    byte(a[0]):= Pred(i)

   110    end else b:= '';

   111 end;

   112 

   113 procedure DrawConsole(Surface: PSDL_Surface);

   114 var x, y: integer;

   115     r: TSDL_Rect;

   116 begin

   117 with r do

   118      begin

   119      x:= 0;

   120      y:= cConsoleHeight;

   121      w:= cScreenWidth;

   122      h:= 4;

   123      end;

   124 SDL_FillRect(Surface, @r, cConsoleSplitterColor);

   125 for y:= 0 to cConsoleHeight div 256 + 1 do

   126     for x:= 0 to cScreenWidth div 256 + 1 do

   127         DrawGear(sConsoleBG, x * 256, cConsoleHeight - 256 - y * 256, Surface);

   128 for y:= 0 to cConsoleHeight div Fontz[fnt16].Height do

   129     DXOutText(4, cConsoleHeight - (y + 2) * (Fontz[fnt16].Height + 2), fnt16, ConsoleLines[(CurrLine - 1 - y + cLinesCount) mod cLinesCount], Surface);

   130 DXOutText(4, cConsoleHeight - Fontz[fnt16].Height - 2, fnt16, '> '+InputStr, Surface);

   131 end;

   132 

   133 procedure WriteToConsole(s: shortstring);

   134 var Len: integer;

   135 begin

   136 {$IFDEF DEBUGFILE}AddFileLog('Console write: ' + s);{$ENDIF}

   137 Write(s);

   138 repeat

   139 Len:= cLineWidth - Length(ConsoleLines[CurrLine]);

   140 ConsoleLines[CurrLine]:= ConsoleLines[CurrLine] + copy(s, 1, Len);

   141 Delete(s, 1, Len);

   142 if byte(ConsoleLines[CurrLine][0])=cLineWidth then

   143    begin

   144    inc(CurrLine);

   145    if CurrLine = cLinesCount then CurrLine:= 0;

   146    PLongWord(@ConsoleLines[CurrLine])^:= 0

   147    end;

   148 until Length(s) = 0

   149 end;

   150 

   151 procedure WriteLnToConsole(s: shortstring);

   152 begin

   153 WriteToConsole(s);

   154 WriteLn;

   155 inc(CurrLine);

   156 if CurrLine = cLinesCount then CurrLine:= 0;

   157 PLongWord(@ConsoleLines[CurrLine])^:= 0

   158 end;

   159 

   160 procedure InitConsole;

   161 var i: integer;

   162 begin

   163 cLineWidth:= cScreenWidth div 10;

   164 if cLineWidth > 255 then cLineWidth:= 255;

   165 for i:= 0 to Pred(cLinesCount) do PLongWord(@ConsoleLines[i])^:= 0

   166 end;

   167 

   168 procedure ParseCommand(CmdStr: shortstring);

   169 type PReal = ^real;

   170 var i, ii: integer;

   171     s: shortstring;

   172     t: PVariable;

   173     c: char;

   174 begin

   175 //WriteLnToConsole(CmdStr);

   176 if CmdStr[0]=#0 then exit;

   177 {$IFDEF DEBUGFILE}AddFileLog('ParseCommand "' + CmdStr + '"');{$ENDIF}

   178 c:= CmdStr[1];

   179 if c in ['/', '$'] then Delete(CmdStr, 1, 1) else c:= '/';

   180 SplitBySpace(CmdStr, s);

   181 t:= Variables;

   182 while t <> nil do

   183       begin

   184       if t.Name = CmdStr then

   185          begin

   186          case t.VType of

   187               vtCommand: if c='/' then

   188                          begin

   189                          TCommandHandler(t.Handler)(s);

   190                          end;

   191               vtInteger: if c='$' then

   192                          if s[0]=#0 then

   193                             begin

   194                             str(PInteger(t.Handler)^, s);

   195                             WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');

   196                             end else val(s, PInteger(t.Handler)^, i);

   197                  vtReal: if c='$' then

   198                          if s[0]=#0 then

   199                             begin

   200                             str(PReal(t.Handler)^:4:6, s);

   201                             WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');

   202                             end else val(s, PReal(t.Handler)^   , i);

   203              vtBoolean: if c='$' then

   204                          if s[0]=#0 then

   205                             begin

   206                             str(ord(boolean(t.Handler^)), s);

   207                             WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');

   208                             end else

   209                             begin

   210                             val(s, ii, i);

   211                             boolean(t.Handler^):= not (ii = 0)

   212                             end;

   213               end;

   214          exit

   215          end else t:= t.Next

   216       end;

   217 case c of

   218      '$': WriteLnToConsole(errmsgUnknownVariable + ': "$' + CmdStr + '"')

   219      else WriteLnToConsole(errmsgUnknownCommand  + ': "/' + CmdStr + '"') end

   220 end;

   221 

   222 procedure KeyPressConsole(Key: Longword);

   223 begin

   224 case Key of

   225       8: if Length(InputStr)>0 then dec(InputStr[0]);

   226  13,271: begin

   227          ParseCommand('/say ' + InputStr);

   228          InputStr:= ''

   229          end;

   230      96: begin

   231          GameState:= gsGame;

   232          cConsoleYAdd:= 0;

   233          ResetKbd

   234          end;

   235      else InputStr:= InputStr + char(Key)

   236      end

   237 end;

   238 

   239 {$INCLUDE CCHandlers.inc}

   240 

   241 procedure AfterAttack;

   242 begin

   243 with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^,

   244      CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do

   245      begin

   246         Inc(AttacksNum);

   247         State:= State and not gstAttacking;

   248         if Ammo[CurSlot, CurAmmo].NumPerTurn >= AttacksNum then isInMultiShoot:= true

   249            else begin

   250            TurnTimeLeft:= Ammoz[Ammo[CurSlot, CurAmmo].AmmoType].TimeAfterTurn;

   251            State:= State or gstAttacked;

   252            OnUsedAmmo(Ammo)

   253            end;

   254      AttackBar:= 0

   255      end

   256 end;

   257 

   258 initialization

   259 InitConsole;

   260 RegisterVariable('quit'    , vtCommand, @chQuit         );

   261 RegisterVariable('capture' , vtCommand, @chCapture      );

   262 RegisterVariable('addteam' , vtCommand, @chAddTeam      );

   263 RegisterVariable('rdriven' , vtCommand, @chTeamLocal    );

   264 //RegisterVariable('gravity' , vtReal   , @cGravity       ); гравитация не должна быть доступна вообще

   265 RegisterVariable('c_height', vtInteger, @cConsoleHeight );

   266 RegisterVariable('showfps' , vtBoolean, @cShowFPS       );

   267 RegisterVariable('sound'   , vtBoolean, @isSoundEnabled );

   268 RegisterVariable('name'    , vtCommand, @chName         );

   269 RegisterVariable('fort'    , vtCommand, @chFort         );

   270 RegisterVariable('grave'   , vtCommand, @chGrave        );

   271 RegisterVariable('bind'    , vtCommand, @chBind         );

   272 RegisterVariable('add'     , vtCommand, @chAdd          );

   273 RegisterVariable('say'     , vtCommand, @chSay          );

   274 RegisterVariable('+left'   , vtCommand, @chLeft_p       );

   275 RegisterVariable('-left'   , vtCommand, @chLeft_m       );

   276 RegisterVariable('+right'  , vtCommand, @chRight_p      );

   277 RegisterVariable('-right'  , vtCommand, @chRight_m      );

   278 RegisterVariable('+up'     , vtCommand, @chUp_p         );

   279 RegisterVariable('-up'     , vtCommand, @chUp_m         );

   280 RegisterVariable('+down'   , vtCommand, @chDown_p       );

   281 RegisterVariable('-down'   , vtCommand, @chDown_m       );

   282 RegisterVariable('+attack' , vtCommand, @chAttack_p     );

   283 RegisterVariable('-attack' , vtCommand, @chAttack_m     );

   284 RegisterVariable('color'   , vtCommand, @chColor        );

   285 RegisterVariable('switch'  , vtCommand, @chSwitch       );

   286 RegisterVariable('nextturn', vtCommand, @chNextTurn     );

   287 RegisterVariable('timer'   , vtCommand, @chTimer        );

   288 RegisterVariable('slot'    , vtCommand, @chSlot         );

   289 RegisterVariable('put'     , vtCommand, @chPut          );

   290 RegisterVariable('ljump'   , vtCommand, @chLJump        );

   291 RegisterVariable('hjump'   , vtCommand, @chHJump        );

   292 

   293 finalization

   294 FreeVariablesList

   295 

   296 end.