hedgewars/uChat.pas
branchqmlfrontend
changeset 12855 1b2b84315d27
parent 12846 e5c461729fe3
child 13077 c213645ff848
equal deleted inserted replaced
11843:01f88c3b7b66 12855:1b2b84315d27
    45     Time: Longword;
    45     Time: Longword;
    46     Width: LongInt;
    46     Width: LongInt;
    47     s: shortstring;
    47     s: shortstring;
    48     Color: TSDL_Color;
    48     Color: TSDL_Color;
    49     end;
    49     end;
    50     TChatCmd = (ccQuit, ccPause, ccFinish, ccShowHistory, ccFullScreen);
    50     TChatCmd = (ccQuit, ccPause, ccShowHistory, ccFullScreen);
    51 
    51 
    52 var Strs: array[0 .. MaxStrIndex] of TChatLine;
    52 var Strs: array[0 .. MaxStrIndex] of TChatLine;
    53     MStrs: array[0 .. MaxStrIndex] of shortstring;
    53     MStrs: array[0 .. MaxStrIndex] of shortstring;
    54     LocalStrs: array[0 .. MaxStrIndex] of shortstring;
    54     LocalStrs: array[0 .. MaxStrIndex] of shortstring;
    55     missedCount: LongWord;
    55     missedCount: LongWord;
    86             ChatCmd: string[31];
    86             ChatCmd: string[31];
    87             ProcedureCallChatCmd: string[31];
    87             ProcedureCallChatCmd: string[31];
    88             end = (
    88             end = (
    89             (ChatCmd: '/quit'; ProcedureCallChatCmd: 'halt'),
    89             (ChatCmd: '/quit'; ProcedureCallChatCmd: 'halt'),
    90             (ChatCmd: '/pause'; ProcedureCallChatCmd: 'pause'),
    90             (ChatCmd: '/pause'; ProcedureCallChatCmd: 'pause'),
    91             (ChatCmd: '/finish'; ProcedureCallChatCmd: 'finish'),
       
    92             (ChatCmd: '/history'; ProcedureCallChatCmd: 'history'),
    91             (ChatCmd: '/history'; ProcedureCallChatCmd: 'history'),
    93             (ChatCmd: '/fullscreen'; ProcedureCallChatCmd: 'fullscr')
    92             (ChatCmd: '/fullscreen'; ProcedureCallChatCmd: 'fullscr')
    94             );
    93             );
    95 
    94 
    96 
    95 
   159 
   158 
   160 (* This procedure [re]renders a texture showing str for the chat line cl.
   159 (* 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
   160  * It will use the color stored in cl and update width
   162  *)
   161  *)
   163 procedure RenderChatLineTex(var cl: TChatLine; var str: shortstring);
   162 procedure RenderChatLineTex(var cl: TChatLine; var str: shortstring);
   164 var strSurface,
   163 var strSurface, tmpSurface,
   165     resSurface: PSDL_Surface;
   164     resSurface: PSDL_Surface;
   166     dstrect   : TSDL_Rect; // destination rectangle for blitting
   165     dstrect   : TSDL_Rect; // destination rectangle for blitting
   167     font      : THWFont;
   166     font      : THWFont;
   168 const
   167 const
   169     shadowint  = $80 shl AShift;
   168     shadowint  = $80 shl AShift;
   192 
   191 
   193 // draw background
   192 // draw background
   194 SDL_FillRect(resSurface, @dstrect, shadowint);
   193 SDL_FillRect(resSurface, @dstrect, shadowint);
   195 
   194 
   196 // create and blit text
   195 // create and blit text
       
   196 tmpSurface:= nil;
   197 strSurface:= TTF_RenderUTF8_Blended(Fontz[font].Handle, Str2PChar(str), cl.color);
   197 strSurface:= TTF_RenderUTF8_Blended(Fontz[font].Handle, Str2PChar(str), cl.color);
       
   198 // fix format
       
   199 if strSurface <> nil then tmpSurface:= SDL_ConvertSurface(strSurface, resSurface^.format, 0);
       
   200 SDL_FreeSurface(strSurface);
   198 //SDL_UpperBlit(strSurface, nil, resSurface, @dstrect);
   201 //SDL_UpperBlit(strSurface, nil, resSurface, @dstrect);
   199 if strSurface <> nil then copyToXY(strSurface, resSurface, Padding, Padding);
   202 if tmpSurface <> nil then copyToXY(tmpSurface, resSurface, Padding, Padding);
   200 SDL_FreeSurface(strSurface);
   203 SDL_FreeSurface(tmpSurface);
   201 
   204 
   202 cl.Tex:= Surface2Tex(resSurface, false);
   205 cl.Tex:= Surface2Tex(resSurface, false);
   203 
   206 
   204 SDL_FreeSurface(resSurface)
   207 SDL_FreeSurface(resSurface)
   205 end;
   208 end;
  1093                 inc(visibleCount);
  1096                 inc(visibleCount);
  1094             end;
  1097             end;
  1095 end;
  1098 end;
  1096 
  1099 
  1097 procedure chChat(var s: shortstring);
  1100 procedure chChat(var s: shortstring);
       
  1101 var i: Integer;
  1098 begin
  1102 begin
  1099     s:= s; // avoid compiler hint
  1103     s:= s; // avoid compiler hint
  1100     GameState:= gsChat;
  1104     GameState:= gsChat;
  1101     SDL_StopTextInput();
  1105     SDL_StopTextInput();
  1102     SDL_StartTextInput();
  1106     SDL_StartTextInput();
       
  1107     //Make REALLY sure unexpected events are flushed (1 time is insufficient as of SDL 2.0.7)
       
  1108     for i := 1 to 2 do
       
  1109     begin
       
  1110         SDL_PumpEvents();
       
  1111         SDL_FlushEvent(SDL_TEXTINPUT);
       
  1112     end;
  1103     //SDL_EnableKeyRepeat(200,45);
  1113     //SDL_EnableKeyRepeat(200,45);
  1104     if length(s) = 0 then
  1114     if length(s) = 0 then
  1105         SetLine(InputStr, '', true)
  1115         SetLine(InputStr, '', true)
  1106     else
  1116     else
  1107         begin
  1117         begin