hedgewars-draft: comparison hedgewars/uChat.pas

equal deleted inserted replaced

-:1ff3dd3705b1
+:99273b7afbff
 procedure freeModule;
 procedure ReloadLines;
 procedure CleanupInput;
 procedure AddChatString(s: shortstring);
 procedure DrawChat;
-procedure KeyPressChat(Key, Sym: Longword);
+procedure KeyPressChat(Key, Sym: Longword; Modifier: Word);
 procedure SendHogSpeech(s: shortstring);
+procedure CopyToClipboard(var newContent: shortstring);
 implementation
 uses SDLh, uInputHandler, uTypes, uVariables, uCommands, uUtils, uTextures, uRender, uIO, uScript, uRenderUtils;
 const MaxStrIndex = 27;
+MaxInputStrLen = 240;
 type TChatLine = record
 Tex: PTexture;
 Time: Longword;
 Width: LongInt;
 s: shortstring;
 Color: TSDL_Color;
 end;
 TChatCmd = (ccQuit, ccPause, ccFinish, ccShowHistory, ccFullScreen);
+type TInputStrL = array[0..260] of byte;
 var Strs: array[0 .. MaxStrIndex] of TChatLine;
 MStrs: array[0 .. MaxStrIndex] of shortstring;
 LocalStrs: array[0 .. MaxStrIndex] of shortstring;
+LocalStrsL: array[0 .. MaxStrIndex] of TInputStrL;
 missedCount: LongWord;
 lastStr: LongWord;
 localLastStr: LongInt;
 history: LongInt;
 visibleCount: LongWord;
 InputStr: TChatLine;
-InputStrL: array[0..260] of char; // for full str + 4-byte utf-8 char
+InputStrL: TInputStrL; // 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
+InputStrLNoPred: byte = 255;
 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]
 const Padding  = 2;
 ClHeight = 2 * Padding + 16; // font height
+function charIsForHogSpeech(c: char): boolean;
+begin
+exit((c = '"') or (c = '''') or (c = '-'));
+end;
+procedure ResetSelection();
+begin
+selectedPos:= -1;
+end;
+procedure UpdateCursorCoords();
+var font: THWFont;
+str : shortstring;
+coff, soff: LongInt;
+begin
+if cursorPos = selectedPos then
+ResetSelection();
+// 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;
+// 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;
 procedure RenderChatLineTex(var cl: TChatLine; var str: shortstring);
 var strSurface,
 resSurface: PSDL_Surface;
 dstrect   : TSDL_Rect; // destination rectangle for blitting
 font      : THWFont;
 if isInput then
 begin
 cl.s:= str;
 color:= colors[#6];
-str:= UserNick + '> ' + str + '_'
+str:= str + ' ';
 end
 else
 begin
-color:= colors[str[1]];
+if str[1] <= High(colors) then
-delete(str, 1, 1);
+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;
 SetLine(Strs[lastStr], s, false);
 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, left, top, cnt: LongInt;
+selRect: TSDL_Rect;
+c: char;
 begin
 ChatReady:= true; // maybe move to somewhere else?
 if ChatHidden and (not showAll) then
 visibleCount:= 0;
 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
+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;
+DrawRect(selRect, $FF, $FF, $FF, $40, true);
+end;
+dec(left, InputLinePrefix.Width);
+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
 if MissedCount <> 0 then // there are chat strings we missed, so print them now
 begin
 for i:= 0 to MissedCount - 1 do
 if s <> LocalStrs[localLastStr] then
 begin
 // put in input history
 localLastStr:= (localLastStr + 1) mod MaxStrIndex;
 LocalStrs[localLastStr]:= s;
+LocalStrsL[localLastStr]:= InputStrL;
 end;
 t:= LocalTeam;
 x:= 0;
 if (s[1] = '"') and (s[Length(s)] = '"')
 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
 {$ENDIF}
 GameState:= gsGame;
 ResetKbd;
 end;
-procedure KeyPressChat(Key, Sym: Longword);
+procedure DelBytesFromInputStrBack(endIdx: integer; count: byte);
+var i, 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);
+// wipe utf8 info for deleted char
+InputStrL[endIdx]:= InputStrLNoPred;
+// shift utf8 char info to reflect new string
+for i:= endIdx + 1 to Length(InputStr.s) + count do
+begin
+if InputStrL[i] <> InputStrLNoPred then
+begin
+InputStrL[i-count]:= InputStrL[i] - count;
+InputStrL[i]:= InputStrLNoPred;
+end;
+end;
+SetLine(InputStr, InputStr.s, true);
+end;
+// returns count of removed bytes
+function DelCharFromInputStr(idx: integer): integer;
+var btw: byte;
+begin
+// note: idx is always at last byte of utf8 chars. cuz relevant for InputStrL
+if (Length(InputStr.s) < 1) or (idx < 1) or (idx > Length(InputStr.s)) then
+exit(0);
+btw:= byte(idx) - InputStrL[idx];
+DelCharFromInputStr:= btw;
+DelBytesFromInputStrBack(idx, btw);
+end;
+// unchecked
+procedure DoCursorStepForward();
+begin
+// go to end of next utf8-char
+repeat
+inc(cursorPos);
+until InputStrL[cursorPos] <> InputStrLNoPred;
+end;
+procedure DeleteSelected();
+begin
+if (selectedPos >= 0) and (cursorPos <> selectedPos) then
+begin
+DelBytesFromInputStrBack(max(cursorPos, selectedPos), abs(selectedPos-cursorPos));
+cursorPos:= min(cursorPos, selectedPos);
+ResetSelection();
+end;
+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
+// multi-byte chars counts as letter
+if (index > 1) and (InputStrL[index] <> index - 1) then
+exit(numalpha);
+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
+cursorPos:= InputStrL[cursorPos];
+end;
+// skip same-type chars
+while (cursorPos > 0) and (GetInputCharSkipClass(cursorPos) = skip) do
+cursorPos:= InputStrL[cursorPos];
+end
+else
+begin
+// skip same-type chars
+while cursorPos < Length(InputStr.s) do
+begin
+DoCursorStepForward();
+if (GetInputCharSkipClass(cursorPos) <> skip) then
+begin
+// go back 1 char
+cursorPos:= InputStrL[cursorPos];
+break;
+end;
+end;
+// skip trailing whitespace, similar to Qt
+while cursorPos < Length(InputStr.s) do
+begin
+DoCursorStepForward();
+if (GetInputCharSkipClass(cursorPos) <> wspace) then
+begin
+// go back 1 char
+cursorPos:= InputStrL[cursorPos];
+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;
+// TODO: honor utf8, don't break utf8 chars when shifting chars beyond limit
+procedure InsertIntoInputStr(s: shortstring);
+var i, l, il, lastc: integer;
+begin
+// safe length for string
+l:= min(MaxInputStrLen-cursorPos, Length(s));
+s:= copy(s,1,l);
+// if we insert rather than append, shift info in InputStrL accordingly
+if cursorPos < Length(InputStr.s) then
+begin
+for i:= Length(InputStr.s) downto cursorPos + 1 do
+begin
+if InputStrL[i] <> InputStrLNoPred then
+begin
+il:= i + l;
+// only shift if not overflowing
+if il <= MaxInputStrLen then
+InputStrL[il]:= InputStrL[i] + l;
+InputStrL[i]:= InputStrLNoPred;
+end;
+end;
+end;
+InputStrL[cursorPos + l]:= cursorPos;
+// 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
+lastc:= MaxInputStrLen;
+cursorPos:= min(lastc, cursorPos + l);
+UpdateCursorCoords();
+end;
+procedure PasteFromClipboard();
+begin
+SendIPC(_S'Y');
+end;
+procedure CheckPasteBuffer();
+begin
+if Length(ChatPasteBuffer) > 0 then
+begin
+InsertIntoInputStr(ChatPasteBuffer);
+ChatPasteBuffer:= '';
+end;
+end;
+procedure KeyPressChat(Key, Sym: Longword; Modifier: Word);
 const firstByteMark: array[0..3] of byte = (0, $C0, $E0, $F0);
 var i, btw, index: integer;
 utf8: shortstring;
-action: boolean;
+action, selMode, ctrl: boolean;
-begin
+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;
+skip:= none;
 case Sym of
 SDLK_BACKSPACE:
 begin
+if selectedPos < 0 then
+begin
+if ctrl then
+skip:= GetInputCharSkipClass(cursorPos);
+// remove char before cursor
+dec(cursorPos, DelCharFromInputStr(cursorPos));
+// delete more if ctrl is held
+if ctrl and (selectedPos < 0) then
+begin
+HandleSelection(true);
+SkipInputChars(skip, true);
+DeleteSelected();
+end
+else
+UpdateCursorCoords();
+end
+else
+DeleteSelected();
+end;
+SDLK_DELETE:
+begin
+if selectedPos < 0 then
+begin
+// remove char after cursor
+if cursorPos < Length(InputStr.s) then
+begin
+DoCursorStepForward();
+if ctrl then
+skip:= GetInputCharSkipClass(cursorPos);
+// delete char
+dec(cursorPos, DelCharFromInputStr(cursorPos));
+// delete more if ctrl is held
+if ctrl and (cursorPos < Length(InputStr.s)) then
+begin
+HandleSelection(true);
+SkipInputChars(skip, false);
+DeleteSelected();
+end;
+end
+else
+UpdateCursorCoords();
+end
+else
+DeleteSelected();
+end;
+SDLK_ESCAPE:
+begin
 if Length(InputStr.s) > 0 then
 begin
-InputStr.s[0]:= InputStrL[byte(InputStr.s[0])];
+SetLine(InputStr, '', true);
-SetLine(InputStr, InputStr.s, true)
+FillChar(InputStrL, sizeof(InputStrL), InputStrLNoPred);
+ResetCursor();
 end
-end;
+else CleanupInput
-SDLK_ESCAPE:
+end;
+SDLK_RETURN, SDLK_KP_ENTER:
 begin
 if Length(InputStr.s) > 0 then
-SetLine(InputStr, '', true)
-else CleanupInput
-end;
-SDLK_RETURN, SDLK_KP_ENTER:
-begin
-if Length(InputStr.s) > 0 then
 begin
 AcceptChatString(InputStr.s);
-SetLine(InputStr, '', false)
+SetLine(InputStr, '', false);
+FillChar(InputStrL, sizeof(InputStrL), InputStrLNoPred);
+ResetCursor();
 end;
 CleanupInput
 end;
 SDLK_UP, SDLK_DOWN:
 begin
 if (Sym = SDLK_UP) and (history < localLastStr) then inc(history);
 if (Sym = SDLK_DOWN) and (history > 0) then dec(history);
 index:= localLastStr - history + 1;
 if (index > localLastStr) then
-SetLine(InputStr, '', true)
+begin
-else SetLine(InputStr, LocalStrs[index], true)
+SetLine(InputStr, '', true);
-end;
+FillChar(InputStrL, sizeof(InputStrL), InputStrLNoPred);
-SDLK_RIGHT, SDLK_LEFT, SDLK_DELETE,
+end
-SDLK_HOME, SDLK_END,
+else
+begin
+SetLine(InputStr, LocalStrs[index], true);
+InputStrL:= LocalStrsL[index];
+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_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
+cursorPos:= InputStrL[cursorPos];
+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);
+DoCursorStepForward();
+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 ctrl then
+begin
+ResetSelection();
+cursorPos:= 0;
+HandleSelection(true);
+cursorPos:= Length(InputStr.s);
+UpdateCursorCoords();
+end
+else
+action:= false;
+end;
+SDLK_c:
+begin
+// copy
+if ctrl then
+CopySelectionToClipboard()
+else
+action:= false;
+end;
+SDLK_v:
+begin
+// paste
+if ctrl then
+PasteFromClipboard()
+else
+action:= false;
+end;
+SDLK_x:
+begin
+// cut
+if ctrl then
+begin
+CopySelectionToClipboard();
+DeleteSelected();
+end
+else
+action:= false;
 end;
 else
 action:= false;
 end;
 if not action and (Key <> 0) then
 begin
+DeleteSelected();
 if (Key < $80) then
 btw:= 1
 else if (Key < $800) then
 btw:= 2
 else if (Key < $10000) then
 Key:= Key shr 6
 end;
 utf8:= char(Key or firstByteMark[Pred(btw)]) + utf8;
-if byte(InputStr.s[0]) + btw > 240 then
+if Length(InputStr.s) + btw > MaxInputStrLen then
 exit;
-InputStrL[byte(InputStr.s[0]) + btw]:= InputStr.s[0];
+if (Length(InputStr.s) = 0) and (Length(utf8) = 1) and (charIsForHogSpeech(utf8[1])) then
-SetLine(InputStr, InputStr.s + utf8, true)
+begin
+InsertIntoInputStr(utf8);
+InsertIntoInputStr(utf8);
+cursorPos:= 1;
+UpdateCursorCoords();
+end
+else
+InsertIntoInputStr(utf8);
 end
 end;
 procedure chChatMessage(var s: shortstring);
 begin
 SDL_EnableKeyRepeat(200,45);
 {$ENDIF}
 if length(s) = 0 then
 SetLine(InputStr, '', true)
 else
-SetLine(InputStr, '/team ', true)
+begin
+SetLine(InputStr, '/team ', true);
+// update InputStrL and cursor accordingly
+// this allows cursor-jumping over '/team ' as if it was a single char
+InputStrL[6]:= 0;
+cursorPos:= 6;
+UpdateCursorCoords();
+end;
 end;
 procedure initModule;
 var i: ShortInt;
 begin
 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;
+FillChar(InputStrL, sizeof(InputStrL), InputStrLNoPred);
+LastKeyPressTick:= 0;
+ResetCursor();
 end;
 procedure freeModule;
 var i: ShortInt;
 begin
+FreeAndNilTexture(InputLinePrefix.Tex);
 FreeAndNilTexture(InputStr.Tex);
 for i:= 0 to MaxStrIndex do
 FreeAndNilTexture(Strs[i].Tex);
 end;

branch	qmlfrontend
changeset 10886	99273b7afbff
parent 10868	acb03a9712c3
child 10919	8aed2bfc43c5