--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uConsole.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,296 @@
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
+ *
+ * Distributed under the terms of the BSD-modified licence:
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a copy
+ * of this software and associated documentation files (the "Software"), to deal
+ * with the Software without restriction, including without limitation the
+ * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+ * sell copies of the Software, and to permit persons to whom the Software is
+ * furnished to do so, subject to the following conditions:
+ *
+ * 1. Redistributions of source code must retain the above copyright notice,
+ * this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright notice,
+ * this list of conditions and the following disclaimer in the documentation
+ * and/or other materials provided with the distribution.
+ * 3. The name of the author may not be used to endorse or promote products
+ * derived from this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
+ * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
+ * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+ * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
+ * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
+ * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+ * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *)
+
+unit uConsole;
+interface
+uses SDLh;
+{$INCLUDE options.inc}
+const isDeveloperMode: boolean = true;
+type TVariableType = (vtCommand, vtInteger, vtReal, vtBoolean);
+ TCommandHandler = procedure (var params: shortstring);
+
+procedure DrawConsole(Surface: PSDL_Surface);
+procedure WriteToConsole(s: shortstring);
+procedure WriteLnToConsole(s: shortstring);
+procedure KeyPressConsole(Key: Longword);
+procedure ParseCommand(CmdStr: shortstring);
+procedure AfterAttack; // экспортируется только для вызова из CurrAmmoGear
+
+implementation
+{$J+}
+uses uMisc, uStore, Types, uConsts, uGears, uTeams, uIO, uKeys, uSound, uWorld, uLand;
+const cLineWidth: integer = 0;
+ cLinesCount = 256;
+
+type PVariable = ^TVariable;
+ TVariable = record
+ Next: PVariable;
+ Name: string[15];
+ VType: TVariableType;
+ Handler: pointer;
+ end;
+
+var ConsoleLines: array[byte] of ShortString;
+ CurrLine: integer = 0;
+ InputStr: shortstring;
+ Variables: PVariable = nil;
+
+function RegisterVariable(Name: string; VType: TVariableType; p: pointer): PVariable;
+begin
+try
+ New(Result);
+except Result:= nil; OutError(errmsgDynamicVar, true) end;
+FillChar(Result^, sizeof(TVariable), 0);
+Result.Name:= Name;
+Result.VType:= VType;
+Result.Handler:= p;
+if Variables = nil then Variables:= Result
+ else begin
+ Result.Next:= Variables;
+ Variables:= Result
+ end
+end;
+
+procedure FreeVariablesList;
+var t, tt: PVariable;
+begin
+tt:= Variables;
+Variables:= nil;
+while tt<>nil do
+ begin
+ t:= tt;
+ tt:= tt.Next;
+ try
+ Dispose(t)
+ except OutError(errmsgDynamicVar) end;
+ end;
+end;
+
+procedure SplitBySpace(var a, b: shortstring);
+var i, t: integer;
+begin
+i:= Pos(' ', a);
+if i>0 then
+ begin
+ for t:= 1 to Pred(i) do
+ if (a[t] >= 'A')and(a[t] <= 'Z') then Inc(a[t], 32);
+ b:= copy(a, i + 1, Length(a) - i);
+ while (b[0]<>#0) and (b[1]=#32) do Delete(b, 1, 1);
+ byte(a[0]):= Pred(i)
+ end else b:= '';
+end;
+
+procedure DrawConsole(Surface: PSDL_Surface);
+var x, y: integer;
+ r: TSDL_Rect;
+begin
+with r do
+ begin
+ x:= 0;
+ y:= cConsoleHeight;
+ w:= cScreenWidth;
+ h:= 4;
+ end;
+SDL_FillRect(Surface, @r, cConsoleSplitterColor);
+for y:= 0 to cConsoleHeight div 256 + 1 do
+ for x:= 0 to cScreenWidth div 256 + 1 do
+ DrawGear(sConsoleBG, x * 256, cConsoleHeight - 256 - y * 256, Surface);
+for y:= 0 to cConsoleHeight div Fontz[fnt16].Height do
+ DXOutText(4, cConsoleHeight - (y + 2) * (Fontz[fnt16].Height + 2), fnt16, ConsoleLines[(CurrLine - 1 - y + cLinesCount) mod cLinesCount], Surface);
+DXOutText(4, cConsoleHeight - Fontz[fnt16].Height - 2, fnt16, '> '+InputStr, Surface);
+end;
+
+procedure WriteToConsole(s: shortstring);
+var Len: integer;
+begin
+{$IFDEF DEBUGFILE}AddFileLog('Console write: ' + s);{$ENDIF}
+Write(s);
+repeat
+Len:= cLineWidth - Length(ConsoleLines[CurrLine]);
+ConsoleLines[CurrLine]:= ConsoleLines[CurrLine] + copy(s, 1, Len);
+Delete(s, 1, Len);
+if byte(ConsoleLines[CurrLine][0])=cLineWidth then
+ begin
+ inc(CurrLine);
+ if CurrLine = cLinesCount then CurrLine:= 0;
+ PLongWord(@ConsoleLines[CurrLine])^:= 0
+ end;
+until Length(s) = 0
+end;
+
+procedure WriteLnToConsole(s: shortstring);
+begin
+WriteToConsole(s);
+WriteLn;
+inc(CurrLine);
+if CurrLine = cLinesCount then CurrLine:= 0;
+PLongWord(@ConsoleLines[CurrLine])^:= 0
+end;
+
+procedure InitConsole;
+var i: integer;
+begin
+cLineWidth:= cScreenWidth div 10;
+if cLineWidth > 255 then cLineWidth:= 255;
+for i:= 0 to Pred(cLinesCount) do PLongWord(@ConsoleLines[i])^:= 0
+end;
+
+procedure ParseCommand(CmdStr: shortstring);
+type PReal = ^real;
+var i, ii: integer;
+ s: shortstring;
+ t: PVariable;
+ c: char;
+begin
+//WriteLnToConsole(CmdStr);
+if CmdStr[0]=#0 then exit;
+{$IFDEF DEBUGFILE}AddFileLog('ParseCommand "' + CmdStr + '"');{$ENDIF}
+c:= CmdStr[1];
+if c in ['/', '$'] then Delete(CmdStr, 1, 1) else c:= '/';
+SplitBySpace(CmdStr, s);
+t:= Variables;
+while t <> nil do
+ begin
+ if t.Name = CmdStr then
+ begin
+ case t.VType of
+ vtCommand: if c='/' then
+ begin
+ TCommandHandler(t.Handler)(s);
+ end;
+ vtInteger: if c='$' then
+ if s[0]=#0 then
+ begin
+ str(PInteger(t.Handler)^, s);
+ WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
+ end else val(s, PInteger(t.Handler)^, i);
+ vtReal: if c='$' then
+ if s[0]=#0 then
+ begin
+ str(PReal(t.Handler)^:4:6, s);
+ WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
+ end else val(s, PReal(t.Handler)^ , i);
+ vtBoolean: if c='$' then
+ if s[0]=#0 then
+ begin
+ str(ord(boolean(t.Handler^)), s);
+ WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
+ end else
+ begin
+ val(s, ii, i);
+ boolean(t.Handler^):= not (ii = 0)
+ end;
+ end;
+ exit
+ end else t:= t.Next
+ end;
+case c of
+ '$': WriteLnToConsole(errmsgUnknownVariable + ': "$' + CmdStr + '"')
+ else WriteLnToConsole(errmsgUnknownCommand + ': "/' + CmdStr + '"') end
+end;
+
+procedure KeyPressConsole(Key: Longword);
+begin
+case Key of
+ 8: if Length(InputStr)>0 then dec(InputStr[0]);
+ 13,271: begin
+ ParseCommand('/say ' + InputStr);
+ InputStr:= ''
+ end;
+ 96: begin
+ GameState:= gsGame;
+ cConsoleYAdd:= 0;
+ ResetKbd
+ end;
+ else InputStr:= InputStr + char(Key)
+ end
+end;
+
+{$INCLUDE CCHandlers.inc}
+
+procedure AfterAttack;
+begin
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^,
+ CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
+ begin
+ Inc(AttacksNum);
+ State:= State and not gstAttacking;
+ if Ammo[CurSlot, CurAmmo].NumPerTurn >= AttacksNum then isInMultiShoot:= true
+ else begin
+ TurnTimeLeft:= Ammoz[Ammo[CurSlot, CurAmmo].AmmoType].TimeAfterTurn;
+ State:= State or gstAttacked;
+ OnUsedAmmo(Ammo)
+ end;
+ AttackBar:= 0
+ end
+end;
+
+initialization
+InitConsole;
+RegisterVariable('quit' , vtCommand, @chQuit );
+RegisterVariable('capture' , vtCommand, @chCapture );
+RegisterVariable('addteam' , vtCommand, @chAddTeam );
+RegisterVariable('rdriven' , vtCommand, @chTeamLocal );
+//RegisterVariable('gravity' , vtReal , @cGravity ); гравитация не должна быть доступна вообще
+RegisterVariable('c_height', vtInteger, @cConsoleHeight );
+RegisterVariable('showfps' , vtBoolean, @cShowFPS );
+RegisterVariable('sound' , vtBoolean, @isSoundEnabled );
+RegisterVariable('name' , vtCommand, @chName );
+RegisterVariable('fort' , vtCommand, @chFort );
+RegisterVariable('grave' , vtCommand, @chGrave );
+RegisterVariable('bind' , vtCommand, @chBind );
+RegisterVariable('add' , vtCommand, @chAdd );
+RegisterVariable('say' , vtCommand, @chSay );
+RegisterVariable('+left' , vtCommand, @chLeft_p );
+RegisterVariable('-left' , vtCommand, @chLeft_m );
+RegisterVariable('+right' , vtCommand, @chRight_p );
+RegisterVariable('-right' , vtCommand, @chRight_m );
+RegisterVariable('+up' , vtCommand, @chUp_p );
+RegisterVariable('-up' , vtCommand, @chUp_m );
+RegisterVariable('+down' , vtCommand, @chDown_p );
+RegisterVariable('-down' , vtCommand, @chDown_m );
+RegisterVariable('+attack' , vtCommand, @chAttack_p );
+RegisterVariable('-attack' , vtCommand, @chAttack_m );
+RegisterVariable('color' , vtCommand, @chColor );
+RegisterVariable('switch' , vtCommand, @chSwitch );
+RegisterVariable('nextturn', vtCommand, @chNextTurn );
+RegisterVariable('timer' , vtCommand, @chTimer );
+RegisterVariable('slot' , vtCommand, @chSlot );
+RegisterVariable('put' , vtCommand, @chPut );
+RegisterVariable('ljump' , vtCommand, @chLJump );
+RegisterVariable('hjump' , vtCommand, @chHJump );
+
+finalization
+FreeVariablesList
+
+end.