1 (*
2 * Hedgewars, a free turn based strategy game
3 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; version 2 of the License
8 *
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
13 *
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
17 *)
18
19 {$INCLUDE "options.inc"}
20
21 unit uChat;
22
23 interface
24 uses SDLh;
25
26 procedure initModule;
27 procedure freeModule;
28 procedure ReloadLines;
29 procedure CleanupInput;
30 procedure AddChatString(s: shortstring);
31 procedure DrawChat;
32 procedure KeyPressChat(keysym: TSDL_Keysym);
33 procedure SendHogSpeech(s: shortstring);
34 procedure CopyToClipboard(var newContent: shortstring);
35 procedure TextInput(var event: TSDL_TextInputEvent);
36
37 implementation
38 uses uInputHandler, uTypes, uVariables, uCommands, uUtils, uTextures, uRender, uIO, uScript, uRenderUtils, uLocale
39 {$IFDEF USE_VIDEO_RECORDING}, uVideoRec{$ENDIF};
40
41 const MaxStrIndex = 27;
42 MaxInputStrLen = 200;
43
44 type TChatLine = record
45 Tex: PTexture;
46 Time: Longword;
47 Width: LongInt;
48 s: shortstring;
49 Color: TSDL_Color;
50 end;
51 TChatCmd = (ccQuit, ccPause, ccShowHistory, ccFullScreen);
52
53 var Strs: array[0 .. MaxStrIndex] of TChatLine;
54 MStrs: array[0 .. MaxStrIndex] of shortstring;
55 LocalStrs: array[0 .. MaxStrIndex] of shortstring;
56 missedCount: LongWord;
57 lastStr: LongWord;
58 localLastStr: LongInt;
59 history: LongInt;
60 visibleCount: LongWord;
61 InputStr: TChatLine;
62 ChatReady: boolean;
63 showAll: boolean;
64 liveLua: boolean;
65 ChatHidden: boolean;
66 firstDraw: boolean;
67 InputLinePrefix: TChatLine;
68 // cursor
69 cursorPos, cursorX, selectedPos, selectionDx: LongInt;
70 LastKeyPressTick: LongWord;
71
72
73 const
74 colors: array[#0..#9] of TSDL_Color = (
75 (r:$FF; g:$FF; b:$00; a:$FF), // #0 warning message [Yellow]
76 (r:$FF; g:$FF; b:$FF; a:$FF), // #1 chat message [White]
77 (r:$FF; g:$00; b:$FF; a:$FF), // #2 action message [Purple]
78 (r:$90; g:$FF; b:$90; a:$FF), // #3 join/leave message [Lime]
79 (r:$FF; g:$FF; b:$A0; a:$FF), // #4 team message [Light Yellow]
80 (r:$FF; g:$00; b:$00; a:$FF), // #5 error messages [Red]
81 (r:$00; g:$FF; b:$FF; a:$FF), // #6 input line [Light Blue]
82 (r:$FF; g:$80; b:$80; a:$FF), // #7 team gone [Light Red]
83 (r:$FF; g:$D0; b:$80; a:$FF), // #8 team back [Light Orange]
84 (r:$DF; g:$DF; b:$DF; a:$FF) // #9 hog speech [Light Gray]
85 );
86 ChatCommandz: array [TChatCmd] of record
87 ChatCmd: string[31];
88 ProcedureCallChatCmd: string[31];
89 end = (
90 (ChatCmd: '/quit'; ProcedureCallChatCmd: 'halt'),
91 (ChatCmd: '/pause'; ProcedureCallChatCmd: 'pause'),
92 (ChatCmd: '/history'; ProcedureCallChatCmd: 'history'),
93 (ChatCmd: '/fullscreen'; ProcedureCallChatCmd: 'fullscr')
94 );
95
96
97 const Padding = 2;
98 ClHeight = 2 * Padding + 16; // font height
99
100 // relevant for UTF-8 handling
IsFirstCharBytenull101 function IsFirstCharByte(c: char): boolean; inline;
102 begin
103 // based on https://en.wikipedia.org/wiki/UTF-8#Description
104 IsFirstCharByte:= (byte(c) and $C0) <> $80;
105 end;
106
charIsForHogSpeechnull107 function charIsForHogSpeech(c: char): boolean;
108 begin
109 exit((c = '"') or (c = '''') or (c = '-'));
110 end;
111
112 procedure ResetSelection();
113 begin
114 selectedPos:= -1;
115 end;
116
117 procedure UpdateCursorCoords();
118 var font: THWFont;
119 str : shortstring;
120 coff, soff: LongInt;
121 begin
122 if cursorPos = selectedPos then
123 ResetSelection();
124
125 // calculate cursor offset
126
127 str:= InputStr.s;
128 font:= CheckCJKFont(ansistring(str), fnt16);
129
130 // get only substring before cursor to determine length
131 // SetLength(str, cursorPos); // makes pas2c unhappy
132 str[0]:= char(cursorPos);
133 // get render size of text
134 TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(str), @coff, nil);
135
136 cursorX:= 2 + coff;
137
138 // calculate selection width on screen
139 if selectedPos >= 0 then
140 begin
141 if selectedPos > cursorPos then
142 str:= InputStr.s;
143 // SetLength(str, selectedPos); // makes pas2c unhappy
144 str[0]:= char(selectedPos);
145 TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(str), @soff, nil);
146 selectionDx:= soff - coff;
147 end
148 else
149 selectionDx:= 0;
150 end;
151
152
153 procedure ResetCursor();
154 begin
155 ResetSelection();
156 cursorPos:= 0;
157 UpdateCursorCoords();
158 end;
159
160 (* This procedure [re]renders a texture showing str for the chat line cl.
161 * It will use the color stored in cl and update width
162 *)
163 procedure RenderChatLineTex(var cl: TChatLine; var str: shortstring);
164 var strSurface, tmpSurface,
165 resSurface: PSDL_Surface;
166 dstrect : TSDL_Rect; // destination rectangle for blitting
167 font : THWFont;
168 const
169 shadowint = $80 shl AShift;
170 begin
171
172 FreeAndNilTexture(cl.Tex);
173
174 font:= CheckCJKFont(ansistring(str), fnt16);
175
176 // get render size of text
177 TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(str), @cl.Width, nil);
178
179 // calculate and save size
180 cl.Width := cl.Width + 2 * Padding;
181
182 // create surface to draw on
183 resSurface:= SDL_CreateRGBSurface(
184 0, toPowerOf2(cl.Width), toPowerOf2(ClHeight),
185 32, RMask, GMask, BMask, AMask);
186
187 // define area we want to draw in
188 dstrect.x:= 0;
189 dstrect.y:= 0;
190 dstrect.w:= cl.Width;
191 dstrect.h:= ClHeight;
192
193 // draw background
194 SDL_FillRect(resSurface, @dstrect, shadowint);
195
196 // create and blit text
197 tmpSurface:= nil;
198 strSurface:= TTF_RenderUTF8_Blended(Fontz[font].Handle, Str2PChar(str), cl.color);
199 // fix format
200 if strSurface <> nil then tmpSurface:= SDL_ConvertSurface(strSurface, resSurface^.format, 0);
201 SDL_FreeSurface(strSurface);
202 //SDL_UpperBlit(strSurface, nil, resSurface, @dstrect);
203 if tmpSurface <> nil then copyToXY(tmpSurface, resSurface, Padding, Padding);
204 SDL_FreeSurface(tmpSurface);
205
206 cl.Tex:= Surface2Tex(resSurface, false);
207
208 SDL_FreeSurface(resSurface)
209 end;
210
211 const ClDisplayDuration = 12500;
212
213 procedure SetLine(var cl: TChatLine; str: shortstring; isInput: boolean);
214 var color : TSDL_Color;
215 begin
216 if isInput then
217 begin
218 cl.s:= str;
219 color:= colors[#6];
220 str:= str + ' ';
221 end
222 else
223 begin
224 if str[1] <= High(colors) then
225 begin
226 color:= colors[str[1]];
227 delete(str, 1, 1);
228 end
229 // fallback if invalid color
230 else
231 color:= colors[Low(colors)];
232
233 cl.s:= str;
234 end;
235
236 cl.color:= color;
237
238 // set texture, note: variables cl.s and str will be different here if isInput
239 RenderChatLineTex(cl, str);
240
241 cl.Time:= RealTicks + ClDisplayDuration;
242 end;
243
244 // For uStore texture recreation
245 procedure ReloadLines;
246 var i: LongWord;
247 begin
248 if InputStr.s <> '' then
249 SetLine(InputStr, InputStr.s, true);
250 for i:= 0 to MaxStrIndex do
251 if Strs[i].s <> '' then
252 begin
253 RenderChatLineTex(Strs[i], Strs[i].s);
254 end;
255 end;
256
257 procedure AddChatString(s: shortstring);
258 begin
259 if not ChatReady then
260 begin
261 if MissedCount < MaxStrIndex - 1 then
262 MStrs[MissedCount]:= s
263 else if MissedCount < MaxStrIndex then
264 MStrs[MissedCount]:= #5 + '[...]';
265 inc(MissedCount);
266 exit
267 end;
268
269 lastStr:= (lastStr + 1) mod (MaxStrIndex + 1);
270
271 SetLine(Strs[lastStr], s, false);
272
273 inc(visibleCount)
274 end;
275
276 procedure UpdateInputLinePrefix();
277 begin
278 if liveLua then
279 begin
280 InputLinePrefix.color:= colors[#1];
281 InputLinePrefix.s:= '[Lua] >';
282 end
283 else
284 begin
285 InputLinePrefix.color:= colors[#6];
286 InputLinePrefix.s:= UserNick + '>';
287 end;
288
289 FreeAndNilTexture(InputLinePrefix.Tex);
290 end;
291
292 procedure DrawChat;
293 var i, t, left, top, cnt: LongInt;
294 selRect: TSDL_Rect;
295 c: char;
296 begin
297 ChatReady:= true; // maybe move to somewhere else?
298
299 if ChatHidden and (not showAll) then
300 visibleCount:= 0;
301
302 // draw chat lines with some distance from screen border
303 {$IFDEF USE_TOUCH_INTERFACE}
304 left:= 4 - cScreenWidth div 2;
305 top := 55 + visibleCount * ClHeight; // we start with input line (if any)
306 {$ELSE}
307 left:= 4 - cScreenWidth div 2;
308 top := 10 + visibleCount * ClHeight; // we start with input line (if any)
309 {$ENDIF}
310
311 // draw chat input line first and under all other lines
312 if isInChatMode and (InputStr.Tex <> nil) then
313 begin
314
315 if InputLinePrefix.Tex = nil then
316 RenderChatLineTex(InputLinePrefix, InputLinePrefix.s);
317
318 DrawTexture(left, top, InputLinePrefix.Tex);
319 inc(left, InputLinePrefix.Width);
320 DrawTexture(left, top, InputStr.Tex);
321
322 if firstDraw then
323 begin
324 UpdateCursorCoords();
325 firstDraw:= false;
326 end;
327
328 if selectedPos < 0 then
329 begin
330 // draw cursor
331 if ((RealTicks - LastKeyPressTick) and 512) < 256 then
332 DrawLineOnScreen(left + cursorX, top + 2, left + cursorX, top + ClHeight - 2, 2.0, $00, $FF, $FF, $FF);
333 end
334 else // draw selection
335 begin
336 selRect.y:= top + 2;
337 selRect.h:= clHeight - 4;
338 if selectionDx < 0 then
339 begin
340 selRect.x:= left + cursorX + selectionDx;
341 selRect.w:= -selectionDx;
342 end
343 else
344 begin
345 selRect.x:= left + cursorX;
346 selRect.w:= selectionDx;
347 end;
348
349 DrawRect(selRect, $FF, $FF, $FF, $40, true);
350 end;
351
352 dec(left, InputLinePrefix.Width);
353
354
355 if (Length(InputStr.s) > 0) and ((CursorPos = 1) or (CursorPos = 2)) then
356 begin
357 c:= InputStr.s[1];
358 if charIsForHogSpeech(c) then
359 begin
360 SpeechHogNumber:= 0;
361 if Length(InputStr.s) > 1 then
362 begin
363 c:= InputStr.s[2];
364 if (c > '0') and (c < '9') then
365 SpeechHogNumber:= byte(c) - 48;
366 end;
367 // default to current hedgehog (if own) or first hedgehog
368 if SpeechHogNumber = 0 then
369 begin
370 if (not CurrentTeam^.ExtDriven) and (not CurrentHedgehog^.Unplaced) then
371 SpeechHogNumber:= CurrentTeam^.CurrHedgehog + 1
372 else
373 SpeechHogNumber:= 1;
374 end;
375 end;
376 end
377 else
378 SpeechHogNumber:= -1;
379 end
380 else
381 SpeechHogNumber:= -1;
382
383 // draw chat lines
384 if ((not ChatHidden) or showAll) and (UIDisplay <> uiNone) then
385 begin
386 if MissedCount <> 0 then // there are chat strings we missed, so print them now
387 begin
388 for i:= 0 to MissedCount - 1 do
389 AddChatString(MStrs[i]);
390 MissedCount:= 0;
391 end;
392 i:= lastStr;
393
394 cnt:= 0; // count of lines displayed
395 t := 1; // # of current line processed
396
397 // draw lines in reverse order
398 while (((t < 7) and (Strs[i].Time > RealTicks)) or ((t <= MaxStrIndex + 1) and showAll))
399 and (Strs[i].Tex <> nil) do
400 begin
401 top:= top - ClHeight;
402 // draw chatline only if not offscreen
403 if top > 0 then
404 DrawTexture(left, top, Strs[i].Tex);
405
406 if i = 0 then
407 i:= MaxStrIndex
408 else
409 dec(i);
410
411 inc(cnt);
412 inc(t)
413 end;
414
415 visibleCount:= cnt;
416 end;
417 end;
418
419 procedure SendHogSpeech(s: shortstring);
420 begin
421 SendIPC('h' + s);
422 ParseCommand('/hogsay '+s, true)
423 end;
424
425 procedure SendConsoleCommand(s: shortstring);
426 begin
427 Delete(s, 1, 1);
428 SendIPC('~' + s)
429 end;
430
431 procedure AcceptChatString(s: shortstring);
432 var i: TWave;
433 j: TChatCmd;
434 c, t: LongInt;
435 x: byte;
436 begin
437 if s <> LocalStrs[localLastStr] then
438 begin
439 // put in input history
440 localLastStr:= (localLastStr + 1) mod MaxStrIndex;
441 LocalStrs[localLastStr]:= s;
442 end;
443
444 t:= LocalTeam;
445 x:= 0;
446 // speech bubble
447 if (s[1] = '"') and (s[Length(s)] = '"')
448 then x:= 1
449
450 // thinking bubble
451 else if (s[1] = '''') and (s[Length(s)] = '''') then
452 x:= 2
453
454 // yelling bubble
455 else if (s[1] = '-') and (s[Length(s)] = '-') then
456 x:= 3;
457
458 if (not CurrentTeam^.ExtDriven) and (x <> 0) then
459 for c:= 0 to Pred(TeamsCount) do
460 if (TeamsArray[c] = CurrentTeam) then
461 t:= c;
462
463 if x <> 0 then
464 begin
465 if t = -1 then
466 ParseCommand('/say ' + copy(s, 2, Length(s)-2), true)
467 else
468 SendHogSpeech(char(x) + char(t) + copy(s, 2, Length(s)-2));
469 exit
470 end;
471
472 if (s[1] = '/') then
473 begin
474 if (Length(s) <= 1) then
475 begin
476 // empty chat command
477 AddChatString(#0 + shortstring(trcmd[sidCmdUnknown]));
478 exit;
479 end;
480
481 // Ignore message-type commands with empty argument list
482 if (copy(s, 2, 2) = 'me') and (Length(s) = 3) then
483 exit;
484 if ((copy(s, 2, 3) = 'hsa') or (copy(s, 2, 3) = 'hta') or (copy(s, 2, 3) = 'hya')) and (Length(s) = 4) then
485 exit;
486 if ((copy(s, 2, 4) = 'team') or (copy(s, 2, 4) = 'clan')) and (Length(s) = 5) then
487 exit;
488
489 // Speech bubble, but on next attack
490 if (copy(s, 2, 4) = 'hsa ') then
491 begin
492 if CurrentTeam^.ExtDriven then
493 ParseCommand('/say ' + copy(s, 6, Length(s)-5), true)
494 else
495 SendHogSpeech(#4 + copy(s, 6, Length(s)-5));
496 exit
497 end;
498
499 // Thinking bubble, but on next attack
500 if (copy(s, 2, 4) = 'hta ') then
501 begin
502 if CurrentTeam^.ExtDriven then
503 ParseCommand('/say ' + copy(s, 6, Length(s)-5), true)
504 else
505 SendHogSpeech(#5 + copy(s, 6, Length(s)-5));
506 exit
507 end;
508
509 // Yelling bubble, but on next attack
510 if (copy(s, 2, 4) = 'hya ') then
511 begin
512 if CurrentTeam^.ExtDriven then
513 ParseCommand('/say ' + copy(s, 6, Length(s)-5), true)
514 else
515 SendHogSpeech(#6 + copy(s, 6, Length(s)-5));
516 exit
517 end;
518
519 // "/clan" or "/team" ("/team" is an alias for "/clan")
520 if ((copy(s, 2, 5) = 'clan ') or (copy(s, 2, 5) = 'team ')) then
521 begin
522 if (Length(s) > 6) then
523 ParseCommand('team ' + copy(s, 7, Length(s) - 6), true);
524 exit
525 end;
526
527 if (copy(s, 2, 3) = 'me ') then
528 begin
529 ParseCommand('/say ' + s, true);
530 exit
531 end;
532
533 if (copy(s, 2, 10) = 'togglechat') then
534 begin
535 ChatHidden:= (not ChatHidden);
536 if ChatHidden then
537 showAll:= false;
538 exit
539 end;
540
541 // debugging commands
542 if (copy(s, 2, 7) = 'debugvl') then
543 // This command intentionally not documented in /help
544 begin
545 cViewLimitsDebug:= (not cViewLimitsDebug);
546 UpdateViewLimits();
547 exit
548 end;
549
550 if (copy(s, 2, 3) = 'lua') then
551 begin
552 LuaCmdUsed:= true;
553 AddFileLog('/lua issued');
554 {$IFDEF USE_VIDEO_RECORDING}
555 if flagPrerecording then
556 begin
557 AddFileLog('Force-stopping prerecording! Lua commands can not be recorded');
558 StopPreRecording;
559 end;
560 {$ENDIF}
561 if gameType <> gmtNet then
562 begin
563 liveLua:= (not liveLua);
564 if liveLua then
565 begin
566 AddFileLog('[Lua] chat input string parsing enabled');
567 AddChatString(#3 + shortstring(trmsg[sidLuaParsingOn]));
568 end
569 else
570 begin
571 AddFileLog('[Lua] chat input string parsing disabled');
572 AddChatString(#3 + shortstring(trmsg[sidLuaParsingOff]));
573 end;
574 UpdateInputLinePrefix();
575 end
576 else
577 AddChatString(#5 + shortstring(trmsg[sidLuaParsingDenied]));
578 exit
579 end;
580
581 // Help commands
582 if (copy(s, 2, 11) = 'help taunts') then
583 begin
584 AddChatString(#3 + shortstring(trcmd[sidCmdHeaderTaunts]));
585 AddChatString(#3 + shortstring(trcmd[sidCmdSpeech]));
586 AddChatString(#3 + shortstring(trcmd[sidCmdThink]));
587 AddChatString(#3 + shortstring(trcmd[sidCmdYell]));
588 AddChatString(#3 + shortstring(trcmd[sidCmdSpeechNumberHint]));
589 AddChatString(#3 + shortstring(trcmd[sidCmdHsa]));
590 AddChatString(#3 + shortstring(trcmd[sidCmdHta]));
591 AddChatString(#3 + shortstring(trcmd[sidCmdHya]));
592 AddChatString(#3 + shortstring(trcmd[sidCmdHurrah]));
593 AddChatString(#3 + shortstring(trcmd[sidCmdIlovelotsoflemonade]));
594 AddChatString(#3 + shortstring(trcmd[sidCmdJuggle]));
595 AddChatString(#3 + shortstring(trcmd[sidCmdRollup]));
596 AddChatString(#3 + shortstring(trcmd[sidCmdShrug]));
597 AddChatString(#3 + shortstring(trcmd[sidCmdWave]));
598 exit
599 end;
600
601 if (copy(s, 2, 9) = 'help room') then
602 begin
603 if (gameType = gmtNet) then
604 SendConsoleCommand('/help')
605 else
606 AddChatString(#0 + shortstring(trcmd[sidCmdHelpRoomFail]));
607 exit;
608 end;
609
610 if (copy(s, 2, 4) = 'help') then
611 begin
612 AddChatString(#3 + shortstring(trcmd[sidCmdHeaderBasic]));
613 if gameType = gmtNet then
614 AddChatString(#3 + shortstring(trcmd[sidCmdPauseNet]))
615 else
616 AddChatString(#3 + shortstring(trcmd[sidCmdPause]));
617 AddChatString(#3 + shortstring(trcmd[sidCmdFullscreen]));
618 AddChatString(#3 + shortstring(trcmd[sidCmdQuit]));
619 if gameType <> gmtNet then
620 AddChatString(#3 + shortstring(trcmd[sidLua]));
621 // history and help commands needs to be close to the end because they are always visible
622 // with a short chat history length.
623 AddChatString(#3 + shortstring(trcmd[sidCmdTeam]));
624 AddChatString(#3 + shortstring(trcmd[sidCmdMe]));
625 AddChatString(#3 + shortstring(trcmd[sidCmdTogglechat]));
626 AddChatString(#3 + shortstring(trcmd[sidCmdHistory]));
627 AddChatString(#3 + shortstring(trcmd[sidCmdHelp]));
628 AddChatString(#3 + shortstring(trcmd[sidCmdHelpTaunts]));
629 if gameType = gmtNet then
630 AddChatString(#3 + shortstring(trcmd[sidCmdHelpRoom]));
631 exit
632 end;
633
634 // hedghog animations/taunts and engine commands
635 if (not CurrentTeam^.ExtDriven) and (CurrentTeam^.Hedgehogs[0].BotLevel = 0) then
636 begin
637 for i:= Low(TWave) to High(TWave) do
638 if (s = Wavez[i].cmd) then
639 begin
640 ParseCommand('/taunt ' + char(i), true);
641 exit
642 end;
643 end;
644
645 for j:= Low(TChatCmd) to High(TChatCmd) do
646 if (s = ChatCommandz[j].ChatCmd) then
647 begin
648 ParseCommand(ChatCommandz[j].ProcedureCallChatCmd, true);
649 exit
650 end;
651
652 if (gameType = gmtNet) then
653 SendConsoleCommand(s)
654 else
655 AddChatString(#0 + shortstring(trcmd[sidCmdUnknown]));
656 end
657 else
658 begin
659 if liveLua then
660 LuaParseString(s)
661 else
662 ParseCommand('/say ' + s, true);
663 end;
664 end;
665
666 procedure CleanupInput;
667 begin
668 FreezeEnterKey;
669 history:= 0;
670 SDL_StopTextInput();
671 //SDL_EnableKeyRepeat(0,0);
672 isInChatMode:= false;
673 ResetKbd;
674 end;
675
676 procedure DelBytesFromInputStrBack(endIdx: integer; count: byte);
677 var startIdx: integer;
678 begin
679 // nothing to do if count is 0
680 if count = 0 then
681 exit;
682
683 // first byte to delete
684 startIdx:= endIdx - (count - 1);
685
686 // delete bytes from string
687 Delete(InputStr.s, startIdx, count);
688
689 SetLine(InputStr, InputStr.s, true);
690 end;
691
692 procedure MoveCursorToPreviousChar();
693 begin
694 if cursorPos > 0 then
695 repeat
696 dec(cursorPos);
697 until ((cursorPos = 0) or IsFirstCharByte(InputStr.s[cursorPos + 1]));
698 end;
699
700 procedure MoveCursorToNextChar();
701 var len: integer;
702 begin
703 len:= Length(InputStr.s);
704 if cursorPos < len then
705 repeat
706 inc(cursorPos);
707 until ((cursorPos = len) or IsFirstCharByte(InputStr.s[cursorPos + 1]));
708 end;
709
710 procedure DeleteLastUTF8CharFromStr(var s: shortstring);
711 var l: byte;
712 begin
713 l:= Length(s);
714
715 while (l > 1) and (not IsFirstCharByte(s[l])) do
716 begin
717 dec(l);
718 end;
719
720 if l > 0 then
721 dec(l);
722
723 s[0]:= char(l);
724 end;
725
726 procedure DeleteSelected();
727 begin
728 if (selectedPos >= 0) and (cursorPos <> selectedPos) then
729 begin
730 DelBytesFromInputStrBack(max(cursorPos, selectedPos), abs(selectedPos-cursorPos));
731 cursorPos:= min(cursorPos, selectedPos);
732 end;
733 ResetSelection();
734 UpdateCursorCoords();
735 end;
736
737 procedure HandleSelection(enabled: boolean);
738 begin
739 if enabled then
740 begin
741 if selectedPos < 0 then
742 selectedPos:= cursorPos;
743 end
744 else
745 ResetSelection();
746 end;
747
748 type TCharSkip = ( none, wspace, numalpha, special );
749
GetInputCharSkipClassnull750 function GetInputCharSkipClass(index: LongInt): TCharSkip;
751 var c: char;
752 begin
753 c:= InputStr.s[index];
754
755 // non-ascii counts as letter
756 if c > #127 then
757 exit(numalpha);
758
759 // low-ascii whitespaces and DEL
760 if (c < #33) or (c = #127) then
761 exit(wspace);
762
763 // low-ascii special chars
764 if c < #48 then
765 exit(special);
766
767 // digits
768 if c < #58 then
769 exit(numalpha);
770
771 // make c upper-case
772 if c > #96 then
773 c:= char(byte(c) - 32);
774
775 // letters
776 if (c > #64) and (c < #90) then
777 exit(numalpha);
778
779 // remaining ascii are special chars
780 exit(special);
781 end;
782
783 // skip from word to word, similar to Qt
784 procedure SkipInputChars(skip: TCharSkip; backwards: boolean);
785 begin
786 if backwards then
787 begin
788 // skip trailing whitespace, similar to Qt
789 while (skip = wspace) and (cursorPos > 0) do
790 begin
791 skip:= GetInputCharSkipClass(cursorPos);
792 if skip = wspace then
793 MoveCursorToPreviousChar();
794 end;
795 // skip same-type chars
796 while (cursorPos > 0) and (GetInputCharSkipClass(cursorPos) = skip) do
797 MoveCursorToPreviousChar();
798 end
799 else
800 begin
801 // skip same-type chars
802 while cursorPos < Length(InputStr.s) do
803 begin
804 MoveCursorToNextChar();
805 if (GetInputCharSkipClass(cursorPos) <> skip) then
806 begin
807 MoveCursorToPreviousChar();
808 break;
809 end;
810 end;
811 // skip trailing whitespace, similar to Qt
812 while cursorPos < Length(InputStr.s) do
813 begin
814 MoveCursorToNextChar();
815 if (GetInputCharSkipClass(cursorPos) <> wspace) then
816 begin
817 MoveCursorToPreviousChar();
818 break;
819 end;
820 end;
821 end;
822 end;
823
824 procedure CopyToClipboard(var newContent: shortstring);
825 begin
826 // SDL2 clipboard
827 SDL_SetClipboardText(Str2PChar(newContent));
828 end;
829
830 procedure CopySelectionToClipboard();
831 var selection: shortstring;
832 begin
833 if selectedPos >= 0 then
834 begin
835 selection:= copy(InputStr.s, min(CursorPos, selectedPos) + 1, abs(CursorPos - selectedPos));
836 CopyToClipboard(selection);
837 end;
838 end;
839
840 procedure InsertIntoInputStr(s: shortstring);
841 var limit: integer;
842 begin
843 // we check limit for trailing stuff before insertion limit for a reason
844 // (possible remaining space after too long UTF8-insertion has been shortened)
845
846 // length limit for stuff to that will trail the insertion
847 limit:= max(cursorPos, MaxInputStrLen-Length(s));
848
849 while Length(InputStr.s) > limit do
850 begin
851 DeleteLastUTF8CharFromStr(InputStr.s);
852 end;
853
854 // length limit for stuff to insert
855 limit:= max(0, MaxInputStrLen-cursorPos);
856
857 if limit = 0 then
858 s:= ''
859 else while Length(s) > limit do
860 begin
861 DeleteLastUTF8CharFromStr(s);
862 end;
863
864 if Length(s) > 0 then
865 begin
866 // insert string truncated to safe length
867 Insert(s, InputStr.s, cursorPos + 1);
868
869 if Length(InputStr.s) > MaxInputStrLen then
870 InputStr.s[0]:= char(MaxInputStrLen);
871
872 SetLine(InputStr, InputStr.s, true);
873
874 // move cursor to end of inserted string
875 inc(cursorPos, Length(s));
876 UpdateCursorCoords();
877 end;
878 end;
879
880 procedure PasteFromClipboard();
881 var clip: PChar;
882 begin
883 // use SDL2 clipboard functions
884 if SDL_HasClipboardText() then
885 begin
886 clip:= SDL_GetClipboardText();
887 // returns NULL if not enough memory for a copy of clipboard content
888 if clip <> nil then
889 begin
890 InsertIntoInputStr(shortstring(clip));
891 SDL_free(Pointer(clip));
892 end;
893 end;
894 end;
895
896 procedure KeyPressChat(keysym: TSDL_Keysym);
897 const nonStateMask = (not (KMOD_NUM or KMOD_CAPS));
898 var i, index: integer;
899 selMode, ctrl, ctrlonly: boolean;
900 skip: TCharSkip;
901 Scancode: TSDL_Scancode;
902 Modifier: Word;
903 begin
904 Scancode:= keysym.scancode;
905 Modifier:= keysym.modifier;
906
907 LastKeyPressTick:= RealTicks;
908
909 selMode:= (modifier and (KMOD_LSHIFT or KMOD_RSHIFT)) <> 0;
910 ctrl:= (modifier and (KMOD_LCTRL or KMOD_RCTRL)) <> 0;
911 ctrlonly:= ctrl and ((modifier and nonStateMask and (not (KMOD_LCTRL or KMOD_RCTRL))) = 0);
912 skip:= none;
913
914 case Scancode of
915 SDL_SCANCODE_BACKSPACE:
916 begin
917 if selectedPos < 0 then
918 begin
919 HandleSelection(true);
920
921 // delete more if ctrl is held
922 if ctrl then
923 SkipInputChars(GetInputCharSkipClass(cursorPos), true)
924 else
925 MoveCursorToPreviousChar();
926
927 end;
928
929 DeleteSelected();
930 UpdateCursorCoords();
931 end;
932 SDL_SCANCODE_DELETE:
933 begin
934 if selectedPos < 0 then
935 begin
936 HandleSelection(true);
937
938 // delete more if ctrl is held
939 if ctrl then
940 SkipInputChars(GetInputCharSkipClass(cursorPos), false)
941 else
942 MoveCursorToNextChar();
943
944 end;
945
946 DeleteSelected();
947 UpdateCursorCoords();
948 end;
949 SDL_SCANCODE_ESCAPE:
950 begin
951 if Length(InputStr.s) > 0 then
952 begin
953 SetLine(InputStr, '', true);
954 ResetCursor();
955 end
956 else CleanupInput
957 end;
958 SDL_SCANCODE_RETURN, SDL_SCANCODE_KP_ENTER:
959 begin
960 if Length(InputStr.s) > 0 then
961 begin
962 AcceptChatString(InputStr.s);
963 SetLine(InputStr, '', false);
964 ResetCursor();
965 end;
966 CleanupInput
967 end;
968 SDL_SCANCODE_UP, SDL_SCANCODE_DOWN:
969 begin
970 if (Scancode = SDL_SCANCODE_UP) and (history < localLastStr) then inc(history);
971 if (Scancode = SDL_SCANCODE_DOWN) and (history > 0) then dec(history);
972 index:= localLastStr - history + 1;
973 if (index > localLastStr) then
974 begin
975 SetLine(InputStr, '', true);
976 end
977 else
978 begin
979 SetLine(InputStr, LocalStrs[index], true);
980 end;
981 cursorPos:= Length(InputStr.s);
982 ResetSelection();
983 UpdateCursorCoords();
984 end;
985 SDL_SCANCODE_HOME:
986 begin
987 if cursorPos > 0 then
988 begin
989 HandleSelection(selMode);
990 cursorPos:= 0;
991 end
992 else if (not selMode) then
993 ResetSelection();
994
995 UpdateCursorCoords();
996 end;
997 SDL_SCANCODE_END:
998 begin
999 i:= Length(InputStr.s);
1000 if cursorPos < i then
1001 begin
1002 HandleSelection(selMode);
1003 cursorPos:= i;
1004 end
1005 else if (not selMode) then
1006 ResetSelection();
1007
1008 UpdateCursorCoords();
1009 end;
1010 SDL_SCANCODE_LEFT:
1011 begin
1012 if cursorPos > 0 then
1013 begin
1014
1015 if ctrl then
1016 skip:= GetInputCharSkipClass(cursorPos);
1017
1018 if selMode or (selectedPos < 0) then
1019 begin
1020 HandleSelection(selMode);
1021 // go to end of previous utf8-char
1022 MoveCursorToPreviousChar();
1023 end
1024 else // if we're leaving selection mode, jump to its left end
1025 begin
1026 cursorPos:= min(cursorPos, selectedPos);
1027 ResetSelection();
1028 end;
1029
1030 if ctrl then
1031 SkipInputChars(skip, true);
1032
1033 end
1034 else if (not selMode) then
1035 ResetSelection();
1036
1037 UpdateCursorCoords();
1038 end;
1039 SDL_SCANCODE_RIGHT:
1040 begin
1041 if cursorPos < Length(InputStr.s) then
1042 begin
1043
1044 if selMode or (selectedPos < 0) then
1045 begin
1046 HandleSelection(selMode);
1047 MoveCursorToNextChar();
1048 end
1049 else // if we're leaving selection mode, jump to its right end
1050 begin
1051 cursorPos:= max(cursorPos, selectedPos);
1052 ResetSelection();
1053 end;
1054
1055 if ctrl then
1056 SkipInputChars(GetInputCharSkipClass(cursorPos), false);
1057
1058 end
1059 else if (not selMode) then
1060 ResetSelection();
1061
1062 UpdateCursorCoords();
1063 end;
1064 SDL_SCANCODE_PAGEUP, SDL_SCANCODE_PAGEDOWN:
1065 begin
1066 // ignore me!!!
1067 end;
1068 // TODO: figure out how to determine those keys better
1069 SDL_SCANCODE_a:
1070 begin
1071 // select all
1072 if ctrlonly then
1073 begin
1074 ResetSelection();
1075 cursorPos:= 0;
1076 HandleSelection(true);
1077 cursorPos:= Length(InputStr.s);
1078 UpdateCursorCoords();
1079 end
1080 end;
1081 SDL_SCANCODE_c:
1082 begin
1083 // copy
1084 if ctrlonly then
1085 CopySelectionToClipboard()
1086 end;
1087 SDL_SCANCODE_v:
1088 begin
1089 // paste
1090 if ctrlonly then
1091 begin
1092 DeleteSelected();
1093 PasteFromClipboard();
1094 end
1095 end;
1096 SDL_SCANCODE_x:
1097 begin
1098 // cut
1099 if ctrlonly then
1100 begin
1101 CopySelectionToClipboard();
1102 DeleteSelected();
1103 end
1104 end;
1105 end;
1106 end;
1107
1108 procedure TextInput(var event: TSDL_TextInputEvent);
1109 var s: shortstring;
1110 l: byte;
1111 isl: integer;
1112 begin
1113 DeleteSelected();
1114
1115 l:= 0;
1116 // fetch all bytes of character/input
1117 while event.text[l] <> #0 do
1118 begin
1119 s[l + 1]:= event.text[l];
1120 inc(l)
1121 end;
1122
1123 if l > 0 then
1124 begin
1125 isl:= Length(InputStr.s);
1126 // check if user is typing a redundant closing hog-speech quotation mark
1127 if (l = 1) and (isl >= 2) and (cursorPos = isl - 1) and charIsForHogSpeech(s[1])
1128 and (s[1] = InputStr.s[1]) and (s[1] = InputStr.s[isl]) then
1129 begin
1130 MoveCursorToNextChar();
1131 UpdateCursorCoords();
1132 end
1133 else
1134 begin
1135 // don't add input that doesn't fit
1136 if isl + l > MaxInputStrLen then exit;
1137 s[0]:= char(l);
1138 InsertIntoInputStr(s);
1139
1140 // add closing hog speech quotation marks automagically
1141 if (l = 1) and (Length(InputStr.s) = 1) and charIsForHogSpeech(s[1]) then
1142 begin
1143 InsertIntoInputStr(s);
1144 MoveCursorToPreviousChar();
1145 UpdateCursorCoords();
1146 end;
1147 end;
1148
1149 end
1150 end;
1151
1152
1153 procedure chChatMessage(var s: shortstring);
1154 begin
1155 AddChatString(s)
1156 end;
1157
1158 procedure chSay(var s: shortstring);
1159 begin
1160 SendIPC('s' + s);
1161
1162 if copy(s, 1, 4) = '/me ' then
1163 s:= #2 + '* ' + UserNick + ' ' + copy(s, 5, Length(s) - 4)
1164 else
1165 s:= #1 + Format(shortstring(trmsg[sidChat]), UserNick, s);
1166
1167 AddChatString(s)
1168 end;
1169
1170 procedure chTeamSay(var s: shortstring);
1171 begin
1172 SendIPC('b' + s);
1173
1174 s:= #4 + Format(shortstring(trmsg[sidChatTeam]), UserNick, s);
1175
1176 AddChatString(s)
1177 end;
1178
1179 procedure chHistory(var s: shortstring);
1180 var i: LongInt;
1181 begin
1182 s:= s; // avoid compiler hint
1183 showAll:= not showAll;
1184 // immediatly recount
1185 visibleCount:= 0;
1186 if showAll or (not ChatHidden) then
1187 for i:= 0 to MaxStrIndex do
1188 begin
1189 if (Strs[i].Tex <> nil) and (showAll or (Strs[i].Time > RealTicks)) then
1190 inc(visibleCount);
1191 end;
1192 end;
1193
1194 procedure chChat(var s: shortstring);
1195 var i: Integer;
1196 begin
1197 s:= s; // avoid compiler hint
1198 isInChatMode:= true;
1199 SDL_StopTextInput();
1200 SDL_StartTextInput();
1201 //Make REALLY sure unexpected events are flushed (1 time is insufficient as of SDL 2.0.7)
1202 for i := 1 to 2 do
1203 begin
1204 SDL_PumpEvents();
1205 SDL_FlushEvent(SDL_TEXTINPUT);
1206 end;
1207 //SDL_EnableKeyRepeat(200,45);
1208 if length(s) = 0 then
1209 SetLine(InputStr, '', true)
1210 else
1211 begin
1212 SetLine(InputStr, '/clan ', true);
1213 cursorPos:= 6;
1214 UpdateCursorCoords();
1215 end;
1216 end;
1217
1218 procedure initModule;
1219 var i: ShortInt;
1220 begin
1221 RegisterVariable('chatmsg', @chChatMessage, true);
1222 RegisterVariable('say', @chSay, true);
1223 RegisterVariable('team', @chTeamSay, true);
1224 RegisterVariable('history', @chHistory, true );
1225 RegisterVariable('chat', @chChat, true );
1226
1227 lastStr:= 0;
1228 localLastStr:= 0;
1229 history:= 0;
1230 visibleCount:= 0;
1231 showAll:= false;
1232 ChatReady:= false;
1233 missedCount:= 0;
1234 liveLua:= false;
1235 ChatHidden:= false;
1236 firstDraw:= true;
1237
1238 InputLinePrefix.Tex:= nil;
1239 UpdateInputLinePrefix();
1240 inputStr.s:= '';
1241 inputStr.Tex := nil;
1242 for i:= 0 to MaxStrIndex do
1243 Strs[i].Tex := nil;
1244
1245 LastKeyPressTick:= 0;
1246 ResetCursor();
1247 SDL_StopTextInput();
1248 end;
1249
1250 procedure freeModule;
1251 var i: ShortInt;
1252 begin
1253 FreeAndNilTexture(InputLinePrefix.Tex);
1254 FreeAndNilTexture(InputStr.Tex);
1255 for i:= 0 to MaxStrIndex do
1256 FreeAndNilTexture(Strs[i].Tex);
1257 end;
1258
1259 end.
1260