hedgewars/uRenderUtils.pas
branchtransitional_engine
changeset 16004 2146cb7be36f
parent 15929 128ace913837
parent 16003 8bb07b0f50ca
equal deleted inserted replaced
15958:772a43d88e6b 16004:2146cb7be36f
    27 
    27 
    28 procedure copyRotatedSurface(src, dest: PSDL_Surface); // this is necessary since width/height are read only in SDL
    28 procedure copyRotatedSurface(src, dest: PSDL_Surface); // this is necessary since width/height are read only in SDL
    29 procedure copyToXY(src, dest: PSDL_Surface; destX, destY: LongInt); 
    29 procedure copyToXY(src, dest: PSDL_Surface; destX, destY: LongInt); 
    30 procedure copyToXYFromRect(src, dest: PSDL_Surface; srcX, srcY, srcW, srcH, destX, destY: LongInt);
    30 procedure copyToXYFromRect(src, dest: PSDL_Surface; srcX, srcY, srcW, srcH, destX, destY: LongInt);
    31 
    31 
    32 procedure DrawSprite2Surf(sprite: TSprite; dest: PSDL_Surface; x,y: LongInt); 
    32 function GetSurfaceFrameCoordinateX(Surface: PSDL_Surface; Frame, frameWidth, frameHeight: LongInt): LongInt;
       
    33 function GetSurfaceFrameCoordinateY(Surface: PSDL_Surface; Frame, frameHeight: LongInt): LongInt;
       
    34 
       
    35 procedure DrawSprite2Surf(sprite: TSprite; dest: PSDL_Surface; x,y: LongInt);
    33 procedure DrawSpriteFrame2Surf(sprite: TSprite; dest: PSDL_Surface; x,y: LongInt; frame: LongInt);
    36 procedure DrawSpriteFrame2Surf(sprite: TSprite; dest: PSDL_Surface; x,y: LongInt; frame: LongInt);
    34 procedure DrawLine2Surf(dest: PSDL_Surface; x0,y0,x1,y1:LongInt; r,g,b: byte);
    37 procedure DrawLine2Surf(dest: PSDL_Surface; x0,y0,x1,y1:LongInt; r,g,b: byte);
    35 procedure DrawRoundRect(rect: PSDL_Rect; BorderColor, FillColor: Longword; Surface: PSDL_Surface; Clear: boolean);
    38 procedure DrawRoundRect(rect: PSDL_Rect; BorderColor, FillColor: Longword; Surface: PSDL_Surface; Clear: boolean);
    36 
    39 
    37 function  RenderStringTex(s: ansistring; Color: Longword; font: THWFont): PTexture;
    40 function  RenderStringTex(s: ansistring; Color: Longword; font: THWFont): PTexture;
    76 function WriteInRoundRect(Surface: PSDL_Surface; X, Y: LongInt; Color: LongWord; Font: THWFont; s: ansistring): TSDL_Rect;
    79 function WriteInRoundRect(Surface: PSDL_Surface; X, Y: LongInt; Color: LongWord; Font: THWFont; s: ansistring): TSDL_Rect;
    77 begin
    80 begin
    78     WriteInRoundRect:= WriteInRoundRect(Surface, X, Y, Color, Font, s, 0);
    81     WriteInRoundRect:= WriteInRoundRect(Surface, X, Y, Color, Font, s, 0);
    79 end;*)
    82 end;*)
    80 
    83 
    81 function IsTooDarkToRead(TextColor: LongWord): boolean; 
    84 function GetSurfaceFrameCoordinateX(Surface: PSDL_Surface; Frame, frameWidth, frameHeight: LongInt): LongInt;
       
    85 var nx, ny: LongInt;
       
    86 begin
       
    87    nx:= Surface^.w div frameWidth; // number of horizontal frames
       
    88    if nx = 0 then nx:= 1; // one frame is minimum
       
    89    ny:= Surface^.h div frameHeight; // number of vertical frames
       
    90    if ny = 0 then ny:= 1;
       
    91    GetSurfaceFrameCoordinateX:= (Frame div ny) * frameWidth;
       
    92 end;
       
    93 
       
    94 function GetSurfaceFrameCoordinateY(Surface: PSDL_Surface; Frame, frameHeight: LongInt): LongInt;
       
    95 var ny: LongInt;
       
    96 begin
       
    97    ny:= Surface^.h div frameHeight; // number of vertical frames
       
    98    if ny = 0 then ny:= 1; // one frame is minimum
       
    99    GetSurfaceFrameCoordinateY:= (Frame mod ny) * frameHeight;
       
   100 end;
       
   101 
       
   102 function IsTooDarkToRead(TextColor: LongWord): boolean;
    82 var clr: TSDL_Color;
   103 var clr: TSDL_Color;
    83 begin
   104 begin
    84     clr.r:= (TextColor shr 16) and $FF;
   105     clr.r:= (TextColor shr 16) and $FF;
    85     clr.g:= (TextColor shr 8) and $FF;
   106     clr.g:= (TextColor shr 8) and $FF;
    86     clr.b:= TextColor and $FF;
   107     clr.b:= TextColor and $FF;
    92     tmpsurf: PSDL_Surface;
   113     tmpsurf: PSDL_Surface;
    93     finalRect, textRect: TSDL_Rect;
   114     finalRect, textRect: TSDL_Rect;
    94     clr: TSDL_Color;
   115     clr: TSDL_Color;
    95 begin
   116 begin
    96     TTF_SizeUTF8(Fontz[Font].Handle, PChar(s), @w, @h);
   117     TTF_SizeUTF8(Fontz[Font].Handle, PChar(s), @w, @h);
    97     if (maxLength > 0) and (w > maxLength * HDPIScaleFactor) then w := maxLength * HDPIScaleFactor;
   118     if (maxLength > 0) and (w > round(maxLength * HDPIScaleFactor)) then w := round(maxLength * HDPIScaleFactor);
    98     finalRect.x:= X;
   119     finalRect.x:= X;
    99     finalRect.y:= Y;
   120     finalRect.y:= Y;
   100     finalRect.w:= w + cFontBorder * 2 + cFontPadding * 2;
   121     finalRect.w:= w + cFontBorder * 2 + cFontPadding * 2;
   101     finalRect.h:= h + cFontBorder * 2;
   122     finalRect.h:= h + cFontBorder * 2;
   102     textRect.x:= X;
   123     textRect.x:= X;
   320     SDL_UnlockSurface(src);
   341     SDL_UnlockSurface(src);
   321     SDL_UnlockSurface(dest);
   342     SDL_UnlockSurface(dest);
   322 
   343 
   323 end;
   344 end;
   324 
   345 
       
   346 {$IFNDEF PAS2C}
       
   347 // Wraps the text s by inserting breakStr as newlines with
       
   348 // maximum column length maxCol.
       
   349 // Same as Pascal's WrapText, but without the annoying
       
   350 // behavior that text enclosed in " and ' disables word-wrapping
       
   351 function SimpleWrapText(s, breakStr: string; maxCol: integer): string;
       
   352 var
       
   353     breakChars: set of char = [#9,' ','-'];
       
   354 begin
       
   355     // escape the " and ' characters before calling WrapText
       
   356     // using ASCII ESC control character
       
   357     s:= StringReplace(s, '"', #27+'Q', [rfReplaceAll]);
       
   358     s:= StringReplace(s, '''', #27+'q', [rfReplaceAll]);
       
   359 
       
   360     s:= WrapText(s, #1, breakChars, maxCol);
       
   361 
       
   362     // Undo the escapes
       
   363     s:= StringReplace(s, #27+'Q', '"', [rfReplaceAll]);
       
   364     s:= StringReplace(s, #27+'q', '''', [rfReplaceAll]);
       
   365     SimpleWrapText:= s;
       
   366 end;
       
   367 {$ENDIF}
       
   368 
   325 function RenderStringTex(s: ansistring; Color: Longword; font: THWFont): PTexture;
   369 function RenderStringTex(s: ansistring; Color: Longword; font: THWFont): PTexture;
   326 begin
   370 begin
   327     RenderStringTex:= RenderStringTexLim(s, Color, font, 0);
   371     RenderStringTex:= RenderStringTexLim(s, Color, font, 0);
   328 end;
   372 end;
   329 
   373 
   339         begin
   383         begin
   340         if length(s) = 0 then s:= _S' ';
   384         if length(s) = 0 then s:= _S' ';
   341         font:= CheckCJKFont(s, font);
   385         font:= CheckCJKFont(s, font);
   342         w:= 0; h:= 0; // avoid compiler hints
   386         w:= 0; h:= 0; // avoid compiler hints
   343         TTF_SizeUTF8(Fontz[font].Handle, PChar(s), @w, @h);
   387         TTF_SizeUTF8(Fontz[font].Handle, PChar(s), @w, @h);
   344         if (maxLength > 0) and (w > maxLength * HDPIScaleFactor) then w := maxLength * HDPIScaleFactor;
   388         if (maxLength > 0) and (w > round(maxLength * HDPIScaleFactor)) then w := round(maxLength * HDPIScaleFactor);
   345 
   389 
   346         finalSurface:= SDL_CreateRGBSurface(SDL_SWSURFACE, w + cFontBorder*2 + cFontPadding*2, h + cFontBorder * 2,
   390         finalSurface:= SDL_CreateRGBSurface(SDL_SWSURFACE, w + cFontBorder*2 + cFontPadding*2, h + cFontBorder * 2,
   347                 32, RMask, GMask, BMask, AMask);
   391                 32, RMask, GMask, BMask, AMask);
   348 
   392 
   349         if checkFails(finalSurface <> nil, 'RenderString: fail to create surface', true) then
   393         if checkFails(finalSurface <> nil, 'RenderString: fail to create surface', true) then
   411 
   455 
   412 function RenderSpeechBubbleTex(s: ansistring; SpeechType: Longword; font: THWFont): PTexture;
   456 function RenderSpeechBubbleTex(s: ansistring; SpeechType: Longword; font: THWFont): PTexture;
   413 var textWidth, textHeight, x, y, w, h, i, j, pos, line, numLines, edgeWidth, edgeHeight, cornerWidth, cornerHeight: LongInt;
   457 var textWidth, textHeight, x, y, w, h, i, j, pos, line, numLines, edgeWidth, edgeHeight, cornerWidth, cornerHeight: LongInt;
   414     finalSurface, tmpsurf, rotatedEdge: PSDL_Surface;
   458     finalSurface, tmpsurf, rotatedEdge: PSDL_Surface;
   415     rect: TSDL_Rect;
   459     rect: TSDL_Rect;
   416     {$IFNDEF PAS2C}
       
   417     breakChars: set of char = [#9,' ','-'];
       
   418     {$ENDIF}
       
   419     substr: ansistring;
   460     substr: ansistring;
   420     edge, corner, tail: TSPrite;
   461     edge, corner, tail: TSPrite;
   421 begin
   462 begin
   422     if cOnlyStats then exit(nil);
   463     if cOnlyStats then exit(nil);
   423 
   464 
   442         end;
   483         end;
   443     edgeHeight:= SpritesData[edge].Height;
   484     edgeHeight:= SpritesData[edge].Height;
   444     edgeWidth:= SpritesData[edge].Width;
   485     edgeWidth:= SpritesData[edge].Width;
   445     cornerWidth:= SpritesData[corner].Width;
   486     cornerWidth:= SpritesData[corner].Width;
   446     cornerHeight:= SpritesData[corner].Height;
   487     cornerHeight:= SpritesData[corner].Height;
   447     // This one screws up WrapText
       
   448     //s:= 'This is the song that never ends.  ''cause it goes on and on my friends. Some people, started singing it not knowing what it was. And they''ll just go on singing it forever just because... This is the song that never ends...';
       
   449     // This one does not
       
   450     //s:= 'This is the song that never ends.  cause it goes on and on my friends. Some people, started singing it not knowing what it was. And they will go on singing it forever just because... This is the song that never ends... ';
       
   451 
   488 
   452     numLines:= 0;
   489     numLines:= 0;
   453 
   490 
   454     if length(s) = 0 then
   491     if length(s) = 0 then
   455         s:= '...';
   492         s:= '...';
   462     if (length(s) > 20) then
   499     if (length(s) > 20) then
   463         begin
   500         begin
   464         w:= 0;
   501         w:= 0;
   465         i:= round(Sqrt(length(s)) * 2);
   502         i:= round(Sqrt(length(s)) * 2);
   466         {$IFNDEF PAS2C}
   503         {$IFNDEF PAS2C}
   467         s:= WrapText(s, #1, breakChars, i);
   504         s:= SimpleWrapText(s, #1, i);
   468         {$ENDIF}
   505         {$ENDIF}
   469         pos:= 1; line:= 0;
   506         pos:= 1; line:= 0;
   470     // Find the longest line for the purposes of centring the text.  Font dependant.
   507     // Find the longest line for the purposes of centring the text.  Font dependant.
   471         while GetNextSpeechLine(s, #1, pos, substr) do
   508         while GetNextSpeechLine(s, #1, pos, substr) do
   472             begin
   509             begin