diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uConsole.pas --- a/hedgewars/uConsole.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uConsole.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,297 +1,297 @@ -(* - * 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('gmflags' , vtInteger, @GameFlags ); -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. +(* + * 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('gmflags' , vtInteger, @GameFlags ); +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.