hedgewars/uChat.pas
changeset 946 42c5cc87cbd1
parent 945 4ead9cde4e14
child 947 4e0c3ad89483
equal deleted inserted replaced
945:4ead9cde4e14 946:42c5cc87cbd1
    20 
    20 
    21 interface
    21 interface
    22 
    22 
    23 procedure AddChatString(s: shortstring);
    23 procedure AddChatString(s: shortstring);
    24 procedure DrawChat;
    24 procedure DrawChat;
       
    25 procedure KeyPressChat(Key: Longword);
    25 
    26 
    26 implementation
    27 implementation
    27 uses uMisc, uStore, uConsts, SDLh;
    28 uses uMisc, uStore, uConsts, SDLh;
    28 
    29 
    29 const MaxStrIndex = 7;
    30 const MaxStrIndex = 7;
    30 
    31 
    31 type TStr = record
    32 type TChatLine = record
       
    33 		s: shortstring;
    32 		Time: Longword;
    34 		Time: Longword;
    33 		Tex: PTexture;
    35 		Tex: PTexture;
    34 		end;
    36 		end;
    35 
    37 
    36 var Strs: array[0 .. MaxStrIndex] of TStr;
    38 
       
    39 var Strs: array[0 .. MaxStrIndex] of TChatLine;
    37 	lastStr: Longword = 0;
    40 	lastStr: Longword = 0;
    38 	visibleCount: Longword = 0;
    41 	visibleCount: Longword = 0;
       
    42 	
       
    43 	InputStr: TChatLine;
       
    44 	InputStrL: array[0..260] of char; // for full str + 4-byte utf-8 char
    39 
    45 
    40 procedure AddChatString(s: shortstring);
    46 procedure SetLine(var cl: TChatLine; str: shortstring);
    41 var strSurface, resSurface: PSDL_Surface;
    47 var strSurface, resSurface: PSDL_Surface;
    42     r: TSDL_Rect;
    48     r: TSDL_Rect;
    43     w, h: LongInt;
    49     w, h: LongInt;
    44 begin
    50 begin
    45 lastStr:= (lastStr + 1) mod (MaxStrIndex + 1);
    51 if cl.Tex <> nil then
       
    52 	FreeTexture(cl.Tex);
    46 
    53 
    47 TTF_SizeUTF8(Fontz[fnt16].Handle, Str2PChar(s), w, h);
    54 TTF_SizeUTF8(Fontz[fnt16].Handle, Str2PChar(str), w, h);
    48 
    55 
    49 resSurface:= SDL_CreateRGBSurface(0,
    56 resSurface:= SDL_CreateRGBSurface(0,
    50 		toPowerOf2(w + 2),
    57 		toPowerOf2(w + 2),
    51 		toPowerOf2(h + 2),
    58 		toPowerOf2(h + 2),
    52 		32,
    59 		32,
    53 		RMask, GMask, BMask, AMask);
    60 		RMask, GMask, BMask, AMask);
    54 
    61 
    55 strSurface:= TTF_RenderUTF8_Solid(Fontz[fnt16].Handle, Str2PChar(s), $202020);
    62 strSurface:= TTF_RenderUTF8_Solid(Fontz[fnt16].Handle, Str2PChar(str), $202020);
    56 r.x:= 1;
    63 r.x:= 1;
    57 r.y:= 1;
    64 r.y:= 1;
    58 SDL_UpperBlit(strSurface, nil, resSurface, @r);
    65 SDL_UpperBlit(strSurface, nil, resSurface, @r);
    59 
    66 
    60 strSurface:= TTF_RenderUTF8_Solid(Fontz[fnt16].Handle, Str2PChar(s), $FFFFFF);
    67 strSurface:= TTF_RenderUTF8_Solid(Fontz[fnt16].Handle, Str2PChar(str), $FFFFFF);
    61 SDL_UpperBlit(strSurface, nil, resSurface, nil);
    68 SDL_UpperBlit(strSurface, nil, resSurface, nil);
    62 
    69 
    63 SDL_FreeSurface(strSurface);
    70 SDL_FreeSurface(strSurface);
    64 
    71 
    65 
    72 
    66 Strs[lastStr].Time:= RealTicks + 7500;
    73 cl.Time:= RealTicks + 7500;
    67 Strs[lastStr].Tex:= Surface2Tex(resSurface);
    74 cl.Tex:= Surface2Tex(resSurface);
    68 SDL_FreeSurface(resSurface);
    75 SDL_FreeSurface(resSurface)
       
    76 end;
       
    77 
       
    78 procedure AddChatString(s: shortstring);
       
    79 begin
       
    80 lastStr:= (lastStr + 1) mod (MaxStrIndex + 1);
       
    81 
       
    82 SetLine(Strs[lastStr], s);
    69 
    83 
    70 inc(visibleCount)
    84 inc(visibleCount)
    71 end;
    85 end;
    72 
    86 
    73 procedure DrawChat;
    87 procedure DrawChat;
    78 i:= lastStr;
    92 i:= lastStr;
    79 while (t <= MaxStrIndex)
    93 while (t <= MaxStrIndex)
    80 	and (Strs[i].Tex <> nil)
    94 	and (Strs[i].Tex <> nil)
    81 	and (Strs[i].Time > RealTicks) do
    95 	and (Strs[i].Time > RealTicks) do
    82 	begin
    96 	begin
    83 	DrawTexture(8, (visibleCount - t) * 16 - 8, Strs[i].Tex);
    97 	DrawTexture(8, (visibleCount - t) * 16 - 6 + cConsoleYAdd, Strs[i].Tex);
    84 	if i = 0 then i:= MaxStrIndex else dec(i);
    98 	if i = 0 then i:= MaxStrIndex else dec(i);
    85 	inc(cnt);
    99 	inc(cnt);
    86 	inc(t)
   100 	inc(t)
    87 	end;
   101 	end;
    88 
   102 
    89 visibleCount:= cnt
   103 visibleCount:= cnt
    90 end;
   104 end;
    91 
   105 
       
   106 procedure KeyPressChat(Key: Longword);
       
   107 const firstByteMark: array[1..4] of byte = (0, $C0, $E0, $F0);
       
   108 var i, btw: integer;
       
   109     utf8: shortstring;
       
   110 begin
       
   111 if Key <> 0 then
       
   112 	case Key of
       
   113 		8: if Length(InputStr.s) > 0 then
       
   114 				begin
       
   115 				InputStr.s[0]:= InputStrL[byte(InputStr.s[0])];
       
   116 				SetLine(InputStr, InputStr.s)
       
   117 				end;
       
   118 		13,271: begin
       
   119 			AddChatString(InputStr.s);
       
   120 			SetLine(InputStr, '');
       
   121 			GameState:= gsGame
       
   122 			end
       
   123 	else
       
   124 	if (Key < $80) then btw:= 1
       
   125 	else if (Key < $800) then btw:= 2
       
   126 	else if (Key < $10000) then btw:= 3
       
   127 	else btw:= 4;
       
   128 	
       
   129 	utf8:= '';
       
   130 
       
   131 	for i:= btw downto 2 do
       
   132 		begin
       
   133 		utf8:= char((Key or $80) and $BF) + utf8;
       
   134 		Key:= Key shr 6
       
   135 		end;
       
   136 	
       
   137 	utf8:= char(Key or firstByteMark[btw]) + utf8;
       
   138 
       
   139 	InputStrL[byte(InputStr.s[0]) + btw]:= InputStr.s[0];
       
   140 	SetLine(InputStr, InputStr.s + utf8)
       
   141 	end
       
   142 end;
       
   143 
       
   144 
    92 end.
   145 end.