--- a/hedgewars/uChat.pas Tue Nov 10 18:16:35 2015 +0100
+++ b/hedgewars/uChat.pas Tue Nov 10 20:43:13 2015 +0100
@@ -1,6 +1,6 @@
(*
* Hedgewars, a free turn based strategy game
- * Copyright (c) 2004-2013 Andrey Korotaev <unC0Rr@gmail.com>
+ * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
@@ -13,7 +13,7 @@
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+ * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
*)
{$INCLUDE "options.inc"}
@@ -29,23 +29,26 @@
procedure CleanupInput;
procedure AddChatString(s: shortstring);
procedure DrawChat;
+procedure KeyPressChat(Key, Sym: Longword; Modifier: Word);
procedure SendHogSpeech(s: shortstring);
+procedure CopyToClipboard(var newContent: shortstring);
-procedure KeyPressChat(Sym: Longword);
procedure TextInput(var event: TSDL_TextInputEvent);
implementation
-uses uInputHandler, uTypes, uVariables, uCommands, uUtils, uTextures, uRender, uIO;
+uses uInputHandler, uTypes, uVariables, uCommands, uUtils, uTextures, uRender, uIO, uScript, uRenderUtils;
const MaxStrIndex = 27;
+ MaxInputStrLen = 200;
type TChatLine = record
Tex: PTexture;
Time: Longword;
Width: LongInt;
s: shortstring;
+ Color: TSDL_Color;
end;
- TChatCmd = (quit, pause, finish, showhistory, fullscreen);
+ TChatCmd = (ccQuit, ccPause, ccFinish, ccShowHistory, ccFullScreen);
var Strs: array[0 .. MaxStrIndex] of TChatLine;
MStrs: array[0 .. MaxStrIndex] of shortstring;
@@ -56,19 +59,29 @@
history: LongInt;
visibleCount: LongWord;
InputStr: TChatLine;
- InputStrL: array[0..260] of char; // for full str + 4-byte utf-8 char
ChatReady: boolean;
showAll: boolean;
+ liveLua: boolean;
+ ChatHidden: boolean;
+ firstDraw: boolean;
+ InputLinePrefix: TChatLine;
+ // cursor
+ cursorPos, cursorX, selectedPos, selectionDx: LongInt;
+ LastKeyPressTick: LongWord;
+
const
- colors: array[#0..#6] of TSDL_Color = (
- (r:$FF; g:$FF; b:$FF; a:$FF), // unused, feel free to take it for anything
- (r:$FF; g:$FF; b:$FF; a:$FF), // chat message [White]
- (r:$FF; g:$00; b:$FF; a:$FF), // action message [Purple]
- (r:$90; g:$FF; b:$90; a:$FF), // join/leave message [Lime]
- (r:$FF; g:$FF; b:$A0; a:$FF), // team message [Light Yellow]
- (r:$FF; g:$00; b:$00; a:$FF), // error messages [Red]
- (r:$00; g:$FF; b:$FF; a:$FF) // input line [Light Blue]
+ colors: array[#0..#9] of TSDL_Color = (
+ (r:$FF; g:$FF; b:$FF; a:$FF), // #0 unused, feel free to take it for anything
+ (r:$FF; g:$FF; b:$FF; a:$FF), // #1 chat message [White]
+ (r:$FF; g:$00; b:$FF; a:$FF), // #2 action message [Purple]
+ (r:$90; g:$FF; b:$90; a:$FF), // #3 join/leave message [Lime]
+ (r:$FF; g:$FF; b:$A0; a:$FF), // #4 team message [Light Yellow]
+ (r:$FF; g:$00; b:$00; a:$FF), // #5 error messages [Red]
+ (r:$00; g:$FF; b:$FF; a:$FF), // #6 input line [Light Blue]
+ (r:$FF; g:$80; b:$80; a:$FF), // #7 team gone [Light Red]
+ (r:$FF; g:$D0; b:$80; a:$FF), // #8 team back [Light Orange]
+ (r:$DF; g:$DF; b:$DF; a:$FF) // #9 hog speech [Light Gray]
);
ChatCommandz: array [TChatCmd] of record
ChatCmd: string[31];
@@ -81,57 +94,160 @@
(ChatCmd: '/fullscreen'; ProcedureCallChatCmd: 'fullscr')
);
-procedure SetLine(var cl: TChatLine; str: shortstring; isInput: boolean);
-var strSurface, resSurface: PSDL_Surface;
- w, h: LongInt;
- color: TSDL_Color;
- font: THWFont;
+
+const Padding = 2;
+ ClHeight = 2 * Padding + 16; // font height
+
+// relevant for UTF-8 handling
+function IsFirstCharByte(c: char): boolean; inline;
+begin
+ // based on https://en.wikipedia.org/wiki/UTF-8#Description
+ IsFirstCharByte:= (byte(c) and $C0) <> $80;
+end;
+
+function charIsForHogSpeech(c: char): boolean;
+begin
+exit((c = '"') or (c = '''') or (c = '-'));
+end;
+
+procedure ResetSelection();
begin
-if cl.Tex <> nil then
- FreeTexture(cl.Tex);
+ selectedPos:= -1;
+end;
+
+procedure UpdateCursorCoords();
+var font: THWFont;
+ str : shortstring;
+ coff, soff: LongInt;
+begin
+ if cursorPos = selectedPos then
+ ResetSelection();
-cl.s:= str;
+ // calculate cursor offset
+
+ str:= InputStr.s;
+ font:= CheckCJKFont(ansistring(str), fnt16);
+
+ // get only substring before cursor to determine length
+ // SetLength(str, cursorPos); // makes pas2c unhappy
+ str[0]:= char(cursorPos);
+ // get render size of text
+ TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(str), @coff, nil);
+
+ cursorX:= 2 + coff;
-if isInput then
- begin
- color:= colors[#6];
- str:= UserNick + '> ' + str + '_'
- end
-else
- begin
- color:= colors[str[1]];
- delete(str, 1, 1)
- end;
+ // calculate selection width on screen
+ if selectedPos >= 0 then
+ begin
+ if selectedPos > cursorPos then
+ str:= InputStr.s;
+ // SetLength(str, selectedPos); // makes pas2c unhappy
+ str[0]:= char(selectedPos);
+ TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(str), @soff, nil);
+ selectionDx:= soff - coff;
+ end
+ else
+ selectionDx:= 0;
+end;
+
+
+procedure ResetCursor();
+begin
+ ResetSelection();
+ cursorPos:= 0;
+ UpdateCursorCoords();
+end;
-font:= CheckCJKFont(str, fnt16);
-w:= 0; h:= 0; // avoid compiler hints
-TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(str), @w, @h);
+(* This procedure [re]renders a texture showing str for the chat line cl.
+ * It will use the color stored in cl and update width
+ *)
+procedure RenderChatLineTex(var cl: TChatLine; var str: shortstring);
+var strSurface,
+ resSurface: PSDL_Surface;
+ dstrect : TSDL_Rect; // destination rectangle for blitting
+ font : THWFont;
+const
+ shadowint = $80 shl AShift;
+begin
+
+FreeAndNilTexture(cl.Tex);
+
+font:= CheckCJKFont(ansistring(str), fnt16);
+
+// get render size of text
+TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(str), @cl.Width, nil);
-resSurface:= SDL_CreateRGBSurface(0, toPowerOf2(w), toPowerOf2(h), 32, RMask, GMask, BMask, AMask);
+// calculate and save size
+cl.Width := cl.Width + 2 * Padding;
+
+// create surface to draw on
+resSurface:= SDL_CreateRGBSurface(
+ 0, toPowerOf2(cl.Width), toPowerOf2(ClHeight),
+ 32, RMask, GMask, BMask, AMask);
-strSurface:= TTF_RenderUTF8_Solid(Fontz[font].Handle, Str2PChar(str), color);
-cl.Width:= w + 4;
-SDL_UpperBlit(strSurface, nil, resSurface, nil);
+// define area we want to draw in
+dstrect.x:= 0;
+dstrect.y:= 0;
+dstrect.w:= cl.Width;
+dstrect.h:= ClHeight;
+
+// draw background
+SDL_FillRect(resSurface, @dstrect, shadowint);
+
+// create and blit text
+strSurface:= TTF_RenderUTF8_Blended(Fontz[font].Handle, Str2PChar(str), cl.color);
+//SDL_UpperBlit(strSurface, nil, resSurface, @dstrect);
+if strSurface <> nil then copyTOXY(strSurface, resSurface, Padding, Padding);
SDL_FreeSurface(strSurface);
-cl.Time:= RealTicks + 12500;
cl.Tex:= Surface2Tex(resSurface, false);
SDL_FreeSurface(resSurface)
end;
+const ClDisplayDuration = 12500;
+
+procedure SetLine(var cl: TChatLine; str: shortstring; isInput: boolean);
+var color : TSDL_Color;
+begin
+if isInput then
+ begin
+ cl.s:= str;
+ color:= colors[#6];
+ str:= str + ' ';
+ end
+else
+ begin
+ if str[1] <= High(colors) then
+ begin
+ color:= colors[str[1]];
+ delete(str, 1, 1);
+ end
+ // fallback if invalid color
+ else
+ color:= colors[Low(colors)];
+
+ cl.s:= str;
+ end;
+
+cl.color:= color;
+
+// set texture, note: variables cl.s and str will be different here if isInput
+RenderChatLineTex(cl, str);
+
+cl.Time:= RealTicks + ClDisplayDuration;
+end;
+
// For uStore texture recreation
procedure ReloadLines;
-var i, t: LongWord;
+var i: LongWord;
begin
if InputStr.s <> '' then
SetLine(InputStr, InputStr.s, true);
for i:= 0 to MaxStrIndex do
if Strs[i].s <> '' then
begin
- t:= Strs[i].Time;
- SetLine(Strs[i], Strs[i].s, false);
- Strs[i].Time:= t
+ RenderChatLineTex(Strs[i], Strs[i].s);
end;
end;
@@ -154,58 +270,145 @@
inc(visibleCount)
end;
+procedure CheckPasteBuffer(); forward;
+
+procedure UpdateInputLinePrefix();
+begin
+if liveLua then
+ begin
+ InputLinePrefix.color:= colors[#1];
+ InputLinePrefix.s:= '[Lua] >';
+ end
+else
+ begin
+ InputLinePrefix.color:= colors[#6];
+ InputLinePrefix.s:= UserNick + '>';
+ end;
+
+FreeAndNilTexture(InputLinePrefix.Tex);
+end;
+
procedure DrawChat;
-var i, t, cnt: Longword;
- r: TSDL_Rect;
+var i, t, left, top, cnt: LongInt;
+ selRect: TSDL_Rect;
+ c: char;
begin
ChatReady:= true; // maybe move to somewhere else?
-if MissedCount <> 0 then // there are chat strings we missed, so print them now
- begin
- for i:= 0 to MissedCount - 1 do
- AddChatString(MStrs[i]);
- MissedCount:= 0;
- end;
-cnt:= 0;
-t:= 0;
-i:= lastStr;
+
+if ChatHidden and (not showAll) then
+ visibleCount:= 0;
-r.x:= 6 - cScreenWidth div 2;
-r.y:= (visibleCount - t) * 16 + 10;
-r.h:= 16;
+// draw chat lines with some distance from screen border
+left:= 4 - cScreenWidth div 2;
+top := 10 + visibleCount * ClHeight; // we start with input line (if any)
+// draw chat input line first and under all other lines
if (GameState = gsChat) and (InputStr.Tex <> nil) then
begin
- r.w:= InputStr.Width;
- DrawFillRect(r);
- Tint($00, $00, $00, $80);
- DrawTexture(9 - cScreenWidth div 2, visibleCount * 16 + 11, InputStr.Tex);
- untint;
- DrawTexture(8 - cScreenWidth div 2, visibleCount * 16 + 10, InputStr.Tex);
- end;
+ CheckPasteBuffer();
+
+ if InputLinePrefix.Tex = nil then
+ RenderChatLineTex(InputLinePrefix, InputLinePrefix.s);
+
+ DrawTexture(left, top, InputLinePrefix.Tex);
+ inc(left, InputLinePrefix.Width);
+ DrawTexture(left, top, InputStr.Tex);
+
+ if firstDraw then
+ begin
+ UpdateCursorCoords();
+ firstDraw:= false;
+ end;
+
+ if selectedPos < 0 then
+ begin
+ // draw cursor
+ if ((RealTicks - LastKeyPressTick) and 512) < 256 then
+ DrawLineOnScreen(left + cursorX, top + 2, left + cursorX, top + ClHeight - 2, 2.0, $00, $FF, $FF, $FF);
+ end
+ else // draw selection
+ begin
+ selRect.y:= top + 2;
+ selRect.h:= clHeight - 4;
+ if selectionDx < 0 then
+ begin
+ selRect.x:= left + cursorX + selectionDx;
+ selRect.w:= -selectionDx;
+ end
+ else
+ begin
+ selRect.x:= left + cursorX;
+ selRect.w:= selectionDx;
+ end;
-dec(r.y, 16);
+ DrawRect(selRect, $FF, $FF, $FF, $40, true);
+ end;
+
+ dec(left, InputLinePrefix.Width);
+
-while (((t < 7) and (Strs[i].Time > RealTicks)) or ((t < MaxStrIndex) and showAll))
-and (Strs[i].Tex <> nil) do
+ if (Length(InputStr.s) > 0) and ((CursorPos = 1) or (CursorPos = 2)) then
+ begin
+ c:= InputStr.s[1];
+ if charIsForHogSpeech(c) then
+ begin
+ SpeechHogNumber:= 0;
+ if Length(InputStr.s) > 1 then
+ begin
+ c:= InputStr.s[2];
+ if (c > '0') and (c < '9') then
+ SpeechHogNumber:= byte(c) - 48;
+ end;
+ // default to current hedgehog (if own) or first hedgehog
+ if SpeechHogNumber = 0 then
+ begin
+ if not CurrentTeam^.ExtDriven then
+ SpeechHogNumber:= CurrentTeam^.CurrHedgehog + 1
+ else
+ SpeechHogNumber:= 1;
+ end;
+ end;
+ end
+ else
+ SpeechHogNumber:= -1;
+ end
+else
+ SpeechHogNumber:= -1;
+
+// draw chat lines
+if ((not ChatHidden) or showAll) and (UIDisplay <> uiNone) then
begin
- r.w:= Strs[i].Width;
- DrawFillRect(r);
- Tint($00, $00, $00, $80);
- DrawTexture(9 - cScreenWidth div 2, (visibleCount - t) * 16 - 5, Strs[i].Tex);
- untint;
- DrawTexture(8 - cScreenWidth div 2, (visibleCount - t) * 16 - 6, Strs[i].Tex);
- dec(r.y, 16);
+ if MissedCount <> 0 then // there are chat strings we missed, so print them now
+ begin
+ for i:= 0 to MissedCount - 1 do
+ AddChatString(MStrs[i]);
+ MissedCount:= 0;
+ end;
+ i:= lastStr;
+
+ cnt:= 0; // count of lines displayed
+ t := 1; // # of current line processed
- if i = 0 then
- i:= MaxStrIndex
- else
- dec(i);
+ // draw lines in reverse order
+ while (((t < 7) and (Strs[i].Time > RealTicks)) or ((t <= MaxStrIndex + 1) and showAll))
+ and (Strs[i].Tex <> nil) do
+ begin
+ top:= top - ClHeight;
+ // draw chatline only if not offscreen
+ if top > 0 then
+ DrawTexture(left, top, Strs[i].Tex);
- inc(cnt);
- inc(t)
+ if i = 0 then
+ i:= MaxStrIndex
+ else
+ dec(i);
+
+ inc(cnt);
+ inc(t)
+ end;
+
+ visibleCount:= cnt;
end;
-
-visibleCount:= cnt;
end;
procedure SendHogSpeech(s: shortstring);
@@ -214,12 +417,25 @@
ParseCommand('/hogsay '+s, true)
end;
+procedure SendConsoleCommand(s: shortstring);
+begin
+ Delete(s, 1, 1);
+ SendIPC('~' + s)
+end;
+
procedure AcceptChatString(s: shortstring);
var i: TWave;
j: TChatCmd;
c, t: LongInt;
x: byte;
begin
+if s <> LocalStrs[localLastStr] then
+ begin
+ // put in input history
+ localLastStr:= (localLastStr + 1) mod MaxStrIndex;
+ LocalStrs[localLastStr]:= s;
+ end;
+
t:= LocalTeam;
x:= 0;
if (s[1] = '"') and (s[Length(s)] = '"')
@@ -231,7 +447,7 @@
else if (s[1] = '-') and (s[Length(s)] = '-') then
x:= 3;
-if not CurrentTeam^.ExtDriven and (x <> 0) then
+if (not CurrentTeam^.ExtDriven) and (x <> 0) then
for c:= 0 to Pred(TeamsCount) do
if (TeamsArray[c] = CurrentTeam) then
t:= c;
@@ -248,7 +464,7 @@
if (s[1] = '/') then
begin
// These 3 are same as above, only are to make the hedgehog say it on next attack
- if (copy(s, 1, 5) = '/hsa ') then
+ if (copy(s, 2, 4) = 'hsa ') then
begin
if CurrentTeam^.ExtDriven then
ParseCommand('/say ' + copy(s, 6, Length(s)-5), true)
@@ -257,7 +473,7 @@
exit
end;
- if (copy(s, 1, 5) = '/hta ') then
+ if (copy(s, 2, 4) = 'hta ') then
begin
if CurrentTeam^.ExtDriven then
ParseCommand('/say ' + copy(s, 6, Length(s)-5), true)
@@ -266,7 +482,7 @@
exit
end;
- if (copy(s, 1, 5) = '/hya ') then
+ if (copy(s, 2, 4) = 'hya ') then
begin
if CurrentTeam^.ExtDriven then
ParseCommand('/say ' + copy(s, 6, Length(s)-5), true)
@@ -275,18 +491,56 @@
exit
end;
- if (copy(s, 1, 6) = '/team ') and (length(s) > 6) then
+ if (copy(s, 2, 5) = 'team ') and (length(s) > 6) then
begin
ParseCommand(s, true);
exit
end;
- if (copy(s, 1, 4) = '/me ') then
+ if (copy(s, 2, 3) = 'me ') then
begin
ParseCommand('/say ' + s, true);
exit
end;
+ if (copy(s, 2, 10) = 'togglechat') then
+ begin
+ ChatHidden:= (not ChatHidden);
+ if ChatHidden then
+ showAll:= false;
+ exit
+ end;
+
+ // debugging commands
+ if (copy(s, 2, 7) = 'debugvl') then
+ begin
+ cViewLimitsDebug:= (not cViewLimitsDebug);
+ UpdateViewLimits();
+ exit
+ end;
+
+ if (copy(s, 2, 3) = 'lua') then
+ begin
+ AddFileLog('/lua issued');
+ if gameType <> gmtNet then
+ begin
+ liveLua:= (not liveLua);
+ if liveLua then
+ begin
+ AddFileLog('[Lua] chat input string parsing enabled');
+ AddChatString(#3 + 'Lua parsing: ON');
+ end
+ else
+ begin
+ AddFileLog('[Lua] chat input string parsing disabled');
+ AddChatString(#3 + 'Lua parsing: OFF');
+ end;
+ UpdateInputLinePrefix();
+ end;
+ exit
+ end;
+
+ // hedghog animations/taunts and engine commands
if (not CurrentTeam^.ExtDriven) and (CurrentTeam^.Hedgehogs[0].BotLevel = 0) then
begin
for i:= Low(TWave) to High(TWave) do
@@ -295,17 +549,25 @@
ParseCommand('/taunt ' + char(i), true);
exit
end;
+ end;
- for j:= Low(TChatCmd) to High(TChatCmd) do
- if (s = ChatCommandz[j].ChatCmd) then
- begin
- ParseCommand(ChatCommandz[j].ProcedureCallChatCmd, true);
- exit
- end;
- end
+ for j:= Low(TChatCmd) to High(TChatCmd) do
+ if (s = ChatCommandz[j].ChatCmd) then
+ begin
+ ParseCommand(ChatCommandz[j].ProcedureCallChatCmd, true);
+ exit
+ end;
+
+ if (gameType = gmtNet) then
+ SendConsoleCommand(s)
end
+else
+ begin
+ if liveLua then
+ LuaParseString(s)
else
ParseCommand('/say ' + s, true);
+ end;
end;
procedure CleanupInput;
@@ -317,10 +579,215 @@
ResetKbd;
end;
+procedure DelBytesFromInputStrBack(endIdx: integer; count: byte);
+var startIdx: integer;
+begin
+ // nothing to do if count is 0
+ if count = 0 then
+ exit;
+
+ // first byte to delete
+ startIdx:= endIdx - (count - 1);
+
+ // delete bytes from string
+ Delete(InputStr.s, startIdx, count);
+
+ SetLine(InputStr, InputStr.s, true);
+end;
+
+procedure MoveCursorToPreviousChar();
+begin
+ if cursorPos > 0 then
+ repeat
+ dec(cursorPos);
+ until ((cursorPos = 0) or IsFirstCharByte(InputStr.s[cursorPos + 1]));
+end;
+
+procedure MoveCursorToNextChar();
+var len: integer;
+begin
+ len:= Length(InputStr.s);
+ if cursorPos < len then
+ repeat
+ inc(cursorPos);
+ until ((cursorPos = len) or IsFirstCharByte(InputStr.s[cursorPos + 1]));
+end;
+
+procedure DeleteLastUTF8CharFromStr(var s: shortstring);
+var l: byte;
+begin
+ l:= Length(s);
+
+ while (l > 1) and (not IsFirstCharByte(s[l])) do
+ begin
+ dec(l);
+ end;
+
+ if l > 0 then
+ dec(l);
+
+ s[0]:= char(l);
+end;
+
+procedure DeleteSelected();
+begin
+ if (selectedPos >= 0) and (cursorPos <> selectedPos) then
+ begin
+ DelBytesFromInputStrBack(max(cursorPos, selectedPos), abs(selectedPos-cursorPos));
+ cursorPos:= min(cursorPos, selectedPos);
+ end;
+ ResetSelection();
+ UpdateCursorCoords();
+end;
+
+procedure HandleSelection(enabled: boolean);
+begin
+if enabled then
+ begin
+ if selectedPos < 0 then
+ selectedPos:= cursorPos;
+ end
+else
+ ResetSelection();
+end;
+
+type TCharSkip = ( none, wspace, numalpha, special );
+
+function GetInputCharSkipClass(index: LongInt): TCharSkip;
+var c: char;
+begin
+ c:= InputStr.s[index];
+
+ // non-ascii counts as letter
+ if c > #127 then
+ exit(numalpha);
+
+ // low-ascii whitespaces and DEL
+ if (c < #33) or (c = #127) then
+ exit(wspace);
+
+ // low-ascii special chars
+ if c < #48 then
+ exit(special);
+
+ // digits
+ if c < #58 then
+ exit(numalpha);
+
+ // make c upper-case
+ if c > #96 then
+ c:= char(byte(c) - 32);
+
+ // letters
+ if (c > #64) and (c < #90) then
+ exit(numalpha);
+
+ // remaining ascii are special chars
+ exit(special);
+end;
+
+// skip from word to word, similar to Qt
+procedure SkipInputChars(skip: TCharSkip; backwards: boolean);
+begin
+if backwards then
+ begin
+ // skip trailing whitespace, similar to Qt
+ while (skip = wspace) and (cursorPos > 0) do
+ begin
+ skip:= GetInputCharSkipClass(cursorPos);
+ if skip = wspace then
+ MoveCursorToPreviousChar();
+ end;
+ // skip same-type chars
+ while (cursorPos > 0) and (GetInputCharSkipClass(cursorPos) = skip) do
+ MoveCursorToPreviousChar();
+ end
+else
+ begin
+ // skip same-type chars
+ while cursorPos < Length(InputStr.s) do
+ begin
+ MoveCursorToNextChar();
+ if (GetInputCharSkipClass(cursorPos) <> skip) then
+ begin
+ MoveCursorToPreviousChar();
+ break;
+ end;
+ end;
+ // skip trailing whitespace, similar to Qt
+ while cursorPos < Length(InputStr.s) do
+ begin
+ MoveCursorToNextChar();
+ if (GetInputCharSkipClass(cursorPos) <> wspace) then
+ begin
+ MoveCursorToPreviousChar();
+ break;
+ end;
+ end;
+ end;
+end;
+
+procedure CopyToClipboard(var newContent: shortstring);
+begin
+ SendIPC(_S'y' + copy(newContent, 1, 253) + #0);
+end;
+
+procedure CopySelectionToClipboard();
+var selection: shortstring;
+begin
+ if selectedPos >= 0 then
+ begin
+ selection:= copy(InputStr.s, min(CursorPos, selectedPos) + 1, abs(CursorPos - selectedPos));
+ CopyToClipboard(selection);
+ end;
+end;
+
+procedure InsertIntoInputStr(s: shortstring);
+var limit: integer;
+begin
+ // we check limit for trailing stuff before insertion limit for a reason
+ // (possible remaining space after too long UTF8-insertion has been shortened)
+
+ // length limit for stuff to that will trail the insertion
+ limit:= max(cursorPos, MaxInputStrLen-Length(s));
+
+ while Length(InputStr.s) > limit do
+ begin
+ DeleteLastUTF8CharFromStr(InputStr.s);
+ end;
+
+ // length limit for stuff to insert
+ limit:= max(0, MaxInputStrLen-cursorPos);
+
+ if limit = 0 then
+ s:= ''
+ else while Length(s) > limit do
+ begin
+ DeleteLastUTF8CharFromStr(s);
+ end;
+
+ if Length(s) > 0 then
+ begin
+ // insert string truncated to safe length
+ Insert(s, InputStr.s, cursorPos + 1);
+
+ if Length(InputStr.s) > MaxInputStrLen then
+ InputStr.s[0]:= char(MaxInputStrLen);
+
+ SetLine(InputStr, InputStr.s, true);
+
+ // move cursor to end of inserted string
+ inc(cursorPos, Length(s));
+ UpdateCursorCoords();
+ end;
+end;
+
procedure TextInput(var event: TSDL_TextInputEvent);
var s: shortstring;
l: byte;
begin
+ DeleteSelected();
+
l:= 0;
while event.text[l] <> #0 do
begin
@@ -331,30 +798,83 @@
if byte(InputStr.s[0]) + l > 240 then exit;
- InputStrL[byte(InputStr.s[0]) + l]:= InputStr.s[0];
- SetLine(InputStr, InputStr.s + s, true)
+ InsertIntoInputStr(s);
+end;
+
+procedure PasteFromClipboard();
+begin
+ SendIPC(_S'Y');
+end;
+
+procedure CheckPasteBuffer();
+begin
+ if Length(ChatPasteBuffer) > 0 then
+ begin
+ InsertIntoInputStr(ChatPasteBuffer);
+ ChatPasteBuffer:= '';
+ end;
end;
-procedure KeyPressChat(Sym: Longword);
+procedure KeyPressChat(Key, Sym: Longword; Modifier: Word);
const firstByteMark: array[0..3] of byte = (0, $C0, $E0, $F0);
+ nonStateMask = (not (KMOD_NUM or KMOD_CAPS));
var i, btw, index: integer;
utf8: shortstring;
- action: boolean;
+ action, selMode, ctrl, ctrlonly: boolean;
+ skip: TCharSkip;
begin
+ LastKeyPressTick:= RealTicks;
action:= true;
+
+ CheckPasteBuffer();
+
+ selMode:= (modifier and (KMOD_LSHIFT or KMOD_RSHIFT)) <> 0;
+ ctrl:= (modifier and (KMOD_LCTRL or KMOD_RCTRL)) <> 0;
+ ctrlonly:= ctrl and ((modifier and nonStateMask and (not (KMOD_LCTRL or KMOD_RCTRL))) = 0);
+ skip:= none;
+
case Sym of
SDLK_BACKSPACE:
begin
- if Length(InputStr.s) > 0 then
+ if selectedPos < 0 then
begin
- InputStr.s[0]:= InputStrL[byte(InputStr.s[0])];
- SetLine(InputStr, InputStr.s, true)
- end
+ HandleSelection(true);
+
+ // delete more if ctrl is held
+ if ctrl then
+ SkipInputChars(GetInputCharSkipClass(cursorPos), true)
+ else
+ MoveCursorToPreviousChar();
+
+ end;
+
+ DeleteSelected();
+ UpdateCursorCoords();
+ end;
+ SDLK_DELETE:
+ begin
+ if selectedPos < 0 then
+ begin
+ HandleSelection(true);
+
+ // delete more if ctrl is held
+ if ctrl then
+ SkipInputChars(GetInputCharSkipClass(cursorPos), false)
+ else
+ MoveCursorToNextChar();
+
+ end;
+
+ DeleteSelected();
+ UpdateCursorCoords();
end;
SDLK_ESCAPE:
begin
if Length(InputStr.s) > 0 then
- SetLine(InputStr, '', true)
+ begin
+ SetLine(InputStr, '', true);
+ ResetCursor();
+ end
else CleanupInput
end;
SDLK_RETURN, SDLK_KP_ENTER:
@@ -362,7 +882,8 @@
if Length(InputStr.s) > 0 then
begin
AcceptChatString(InputStr.s);
- SetLine(InputStr, '', false)
+ SetLine(InputStr, '', false);
+ ResetCursor();
end;
CleanupInput
end;
@@ -372,19 +893,149 @@
if (Sym = SDLK_DOWN) and (history > 0) then dec(history);
index:= localLastStr - history + 1;
if (index > localLastStr) then
- SetLine(InputStr, '', true)
- else SetLine(InputStr, LocalStrs[index], true)
+ begin
+ SetLine(InputStr, '', true);
+ end
+ else
+ begin
+ SetLine(InputStr, LocalStrs[index], true);
+ end;
+ cursorPos:= Length(InputStr.s);
+ ResetSelection();
+ UpdateCursorCoords();
+ end;
+ SDLK_HOME:
+ begin
+ if cursorPos > 0 then
+ begin
+ HandleSelection(selMode);
+ cursorPos:= 0;
+ end
+ else if (not selMode) then
+ ResetSelection();
+
+ UpdateCursorCoords();
+ end;
+ SDLK_END:
+ begin
+ i:= Length(InputStr.s);
+ if cursorPos < i then
+ begin
+ HandleSelection(selMode);
+ cursorPos:= i;
+ end
+ else if (not selMode) then
+ ResetSelection();
+
+ UpdateCursorCoords();
end;
- SDLK_RIGHT, SDLK_LEFT, SDLK_DELETE,
- SDLK_HOME, SDLK_END,
+ SDLK_LEFT:
+ begin
+ if cursorPos > 0 then
+ begin
+
+ if ctrl then
+ skip:= GetInputCharSkipClass(cursorPos);
+
+ if selMode or (selectedPos < 0) then
+ begin
+ HandleSelection(selMode);
+ // go to end of previous utf8-char
+ MoveCursorToPreviousChar();
+ end
+ else // if we're leaving selection mode, jump to its left end
+ begin
+ cursorPos:= min(cursorPos, selectedPos);
+ ResetSelection();
+ end;
+
+ if ctrl then
+ SkipInputChars(skip, true);
+
+ end
+ else if (not selMode) then
+ ResetSelection();
+
+ UpdateCursorCoords();
+ end;
+ SDLK_RIGHT:
+ begin
+ if cursorPos < Length(InputStr.s) then
+ begin
+
+ if selMode or (selectedPos < 0) then
+ begin
+ HandleSelection(selMode);
+ MoveCursorToNextChar();
+ end
+ else // if we're leaving selection mode, jump to its right end
+ begin
+ cursorPos:= max(cursorPos, selectedPos);
+ ResetSelection();
+ end;
+
+ if ctrl then
+ SkipInputChars(GetInputCharSkipClass(cursorPos), false);
+
+ end
+ else if (not selMode) then
+ ResetSelection();
+
+ UpdateCursorCoords();
+ end;
SDLK_PAGEUP, SDLK_PAGEDOWN:
begin
// ignore me!!!
end;
+ SDLK_a:
+ begin
+ // select all
+ if ctrlonly then
+ begin
+ ResetSelection();
+ cursorPos:= 0;
+ HandleSelection(true);
+ cursorPos:= Length(InputStr.s);
+ UpdateCursorCoords();
+ end
+ else
+ action:= false;
+ end;
+ SDLK_c:
+ begin
+ // copy
+ if ctrlonly then
+ CopySelectionToClipboard()
+ else
+ action:= false;
+ end;
+ SDLK_v:
+ begin
+ // paste
+ if ctrlonly then
+ begin
+ DeleteSelected();
+ PasteFromClipboard();
+ end
+ else
+ action:= false;
+ end;
+ SDLK_x:
+ begin
+ // cut
+ if ctrlonly then
+ begin
+ CopySelectionToClipboard();
+ DeleteSelected();
+ end
+ else
+ action:= false;
+ end;
else
action:= false;
end;
+ // TODO: ctrl+c etc. probably won't work anymore while in text input mode
end;
procedure chChatMessage(var s: shortstring);
@@ -399,11 +1050,7 @@
if copy(s, 1, 4) = '/me ' then
s:= #2 + '* ' + UserNick + ' ' + copy(s, 5, Length(s) - 4)
else
- begin
- localLastStr:= (localLastStr + 1) mod MaxStrIndex;
- LocalStrs[localLastStr]:= s;
s:= #1 + UserNick + ': ' + s;
- end;
AddChatString(s)
end;
@@ -418,9 +1065,18 @@
end;
procedure chHistory(var s: shortstring);
+var i: LongInt;
begin
s:= s; // avoid compiler hint
- showAll:= not showAll
+ showAll:= not showAll;
+ // immediatly recount
+ visibleCount:= 0;
+ if showAll or (not ChatHidden) then
+ for i:= 0 to MaxStrIndex do
+ begin
+ if (Strs[i].Tex <> nil) and (showAll or (Strs[i].Time > RealTicks)) then
+ inc(visibleCount);
+ end;
end;
procedure chChat(var s: shortstring);
@@ -431,7 +1087,11 @@
if length(s) = 0 then
SetLine(InputStr, '', true)
else
- SetLine(InputStr, '/team ', true)
+ begin
+ SetLine(InputStr, '/team ', true);
+ cursorPos:= 6;
+ UpdateCursorCoords();
+ end;
end;
procedure initModule;
@@ -450,18 +1110,28 @@
showAll:= false;
ChatReady:= false;
missedCount:= 0;
+ liveLua:= false;
+ ChatHidden:= false;
+ firstDraw:= true;
+ InputLinePrefix.Tex:= nil;
+ UpdateInputLinePrefix();
+ inputStr.s:= '';
inputStr.Tex := nil;
for i:= 0 to MaxStrIndex do
Strs[i].Tex := nil;
+
+ LastKeyPressTick:= 0;
+ ResetCursor();
end;
procedure freeModule;
var i: ShortInt;
begin
- FreeTexture(InputStr.Tex);
+ FreeAndNilTexture(InputLinePrefix.Tex);
+ FreeAndNilTexture(InputStr.Tex);
for i:= 0 to MaxStrIndex do
- FreeTexture(Strs[i].Tex);
+ FreeAndNilTexture(Strs[i].Tex);
end;
end.