hedgewars/uChat.pas
changeset 1118 caf47265d03f
parent 1116 dd6db8e09f9e
child 1378 1a391883261d
equal deleted inserted replaced
1117:82378325b5c1 1118:caf47265d03f
    33 const MaxStrIndex = 27;
    33 const MaxStrIndex = 27;
    34 
    34 
    35 type TChatLine = record
    35 type TChatLine = record
    36 		s: shortstring;
    36 		s: shortstring;
    37 		Time: Longword;
    37 		Time: Longword;
    38 		Texb, Texf: PTexture;
    38 		Tex: PTexture;
    39 		end;
    39 		end;
    40 
    40 
    41 var Strs: array[0 .. MaxStrIndex] of TChatLine;
    41 var Strs: array[0 .. MaxStrIndex] of TChatLine;
    42 	lastStr: Longword = 0;
    42 	lastStr: Longword = 0;
    43 	visibleCount: Longword = 0;
    43 	visibleCount: Longword = 0;
    44 	
    44 	
    45 	InputStr: TChatLine;
    45 	InputStr: TChatLine;
    46 	InputStrL: array[0..260] of char; // for full str + 4-byte utf-8 char
    46 	InputStrL: array[0..260] of char; // for full str + 4-byte utf-8 char
    47 
    47 
    48 procedure SetLine(var cl: TChatLine; str: shortstring; isInput: boolean);
    48 procedure SetLine(var cl: TChatLine; str: shortstring; isInput: boolean);
    49 var surf: PSDL_Surface;
    49 var strSurface, resSurface: PSDL_Surface;
       
    50     r: TSDL_Rect;
       
    51     w, h: LongInt;
    50 begin
    52 begin
    51 if cl.Texb <> nil then
    53 if cl.Tex <> nil then
    52 	begin
    54 	FreeTexture(cl.Tex);
    53 	FreeTexture(cl.Texb);
       
    54 	FreeTexture(cl.Texf)
       
    55 	end;
       
    56 
    55 
    57 cl.s:= str;
    56 cl.s:= str;
    58 
    57 
    59 if isInput then str:= UserNick + '> ' + str + '_';
    58 if isInput then str:= UserNick + '> ' + str + '_';
    60 
    59 
       
    60 TTF_SizeUTF8(Fontz[fnt16].Handle, Str2PChar(str), w, h);
       
    61 
       
    62 resSurface:= SDL_CreateRGBSurface(0,
       
    63 		toPowerOf2(w + 2),
       
    64 		toPowerOf2(h + 2),
       
    65 		32,
       
    66 		RMask, GMask, BMask, AMask);
       
    67 
       
    68 strSurface:= TTF_RenderUTF8_Solid(Fontz[fnt16].Handle, Str2PChar(str), $202020);
       
    69 r.x:= 1;
       
    70 r.y:= 1;
       
    71 SDL_UpperBlit(strSurface, nil, resSurface, @r);
       
    72 
       
    73 strSurface:= TTF_RenderUTF8_Solid(Fontz[fnt16].Handle, Str2PChar(str), $FFFFFF);
       
    74 SDL_UpperBlit(strSurface, nil, resSurface, nil);
       
    75 
       
    76 SDL_FreeSurface(strSurface);
       
    77 
    61 cl.Time:= RealTicks + 12500;
    78 cl.Time:= RealTicks + 12500;
    62 
    79 cl.Tex:= Surface2Tex(resSurface);
    63 TryDo(str <> '', 'Error: null chat string', true);
    80 SDL_FreeSurface(resSurface)
    64 
       
    65 surf:= TTF_RenderUTF8_Solid(Fontz[fnt16].Handle, Str2PChar(str), $202020);
       
    66 surf:= SDL_DisplayFormatAlpha(surf);
       
    67 TryDo(surf <> nil, 'Chat: fail to render string', true);
       
    68 cl.Texb:= Surface2Tex(surf);
       
    69 SDL_FreeSurface(surf);
       
    70 
       
    71 surf:= TTF_RenderUTF8_Solid(Fontz[fnt16].Handle, Str2PChar(str), $FFFFFF);
       
    72 surf:= SDL_DisplayFormatAlpha(surf);
       
    73 TryDo(surf <> nil, 'Chat: fail to render string', true);
       
    74 cl.Texf:= Surface2Tex(surf);
       
    75 SDL_FreeSurface(surf)
       
    76 end;
    81 end;
    77 
    82 
    78 procedure AddChatString(s: shortstring);
    83 procedure AddChatString(s: shortstring);
    79 begin
    84 begin
    80 lastStr:= (lastStr + 1) mod (MaxStrIndex + 1);
    85 lastStr:= (lastStr + 1) mod (MaxStrIndex + 1);
    83 
    88 
    84 inc(visibleCount)
    89 inc(visibleCount)
    85 end;
    90 end;
    86 
    91 
    87 procedure DrawChat;
    92 procedure DrawChat;
    88 const shift = 2;
       
    89 var i, t, cnt: Longword;
    93 var i, t, cnt: Longword;
    90 begin
    94 begin
    91 cnt:= 0;
    95 cnt:= 0;
    92 t:= 0;
    96 t:= 0;
    93 i:= lastStr;
    97 i:= lastStr;
    96 			((t < 7) and (Strs[i].Time > RealTicks))
   100 			((t < 7) and (Strs[i].Time > RealTicks))
    97 		or
   101 		or
    98 			((t < MaxStrIndex) and showAll)
   102 			((t < MaxStrIndex) and showAll)
    99 	)
   103 	)
   100 	and
   104 	and
   101 		(Strs[i].Texb <> nil) do
   105 		(Strs[i].Tex <> nil) do
   102 	begin
   106 	begin
   103 	DrawTexture(8 + shift, (visibleCount - t) * 16 - 6 + shift, Strs[i].Texb);
   107 	DrawTexture(8, (visibleCount - t) * 16 - 6, Strs[i].Tex);
   104 	DrawTexture(8, (visibleCount - t) * 16 - 6, Strs[i].Texf);
       
   105 	if i = 0 then i:= MaxStrIndex else dec(i);
   108 	if i = 0 then i:= MaxStrIndex else dec(i);
   106 	inc(cnt);
   109 	inc(cnt);
   107 	inc(t)
   110 	inc(t)
   108 	end;
   111 	end;
   109 
   112 
   110 visibleCount:= cnt;
   113 visibleCount:= cnt;
   111 
   114 
   112 if (GameState = gsChat)
   115 if (GameState = gsChat)
   113 	and (InputStr.Texb <> nil) then
   116 	and (InputStr.Tex <> nil) then
   114 	begin
   117 	DrawTexture(8, visibleCount * 16 + 10, InputStr.Tex);
   115 	DrawTexture(8 + shift, visibleCount * 16 + 10 + shift, InputStr.Texb);
       
   116 	DrawTexture(8, visibleCount * 16 + 10, InputStr.Texf)
       
   117 	end
       
   118 end;
   118 end;
   119 
   119 
   120 procedure AcceptChatString(s: shortstring);
   120 procedure AcceptChatString(s: shortstring);
   121 var i: TWave;
   121 var i: TWave;
   122 begin
   122 begin
   150 		27: SetLine(InputStr, '', true);
   150 		27: SetLine(InputStr, '', true);
   151 		13, 271: begin
   151 		13, 271: begin
   152 			if Length(InputStr.s) > 0 then
   152 			if Length(InputStr.s) > 0 then
   153 				begin
   153 				begin
   154 				AcceptChatString(InputStr.s);
   154 				AcceptChatString(InputStr.s);
   155 				SetLine(InputStr, '', true)
   155 				SetLine(InputStr, '', false)
   156 				end;
   156 				end;
   157 			FreezeEnterKey;
   157 			FreezeEnterKey;
   158 			GameState:= gsGame
   158 			GameState:= gsGame
   159 			end
   159 			end
   160 	else
   160 	else