diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uConsole.pas --- /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 + * + * 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.