DEADSOFTWARE

flexui: move portable drawing code back to fui_gfx
authorDeaDDooMER <deaddoomer@deadsoftware.ru>
Thu, 29 Dec 2022 17:35:55 +0000 (20:35 +0300)
committerDeaDDooMER <deaddoomer@deadsoftware.ru>
Fri, 9 Jun 2023 09:10:12 +0000 (12:10 +0300)
src/flexui/fui_gfx.pas
src/game/renders/opengl/r_fui_gfx_gl.pas

index dce01e5f780012bce8b5f78016e685801e998c3b..ddf324b1db2bac41d73472ba3baf62f5802f967e 100644 (file)
@@ -28,7 +28,7 @@ interface
           TMarkIcon = (Checkbox, Radiobox);
           TWinIcon = (Close);
 
-      public
+      public (* abstract interface *)
         procedure line (x1, y1, x2, y2: Integer); virtual; abstract;
         procedure hline (x, y, len: Integer); virtual; abstract;
         procedure vline (x, y, len: Integer); virtual; abstract;
@@ -43,30 +43,10 @@ interface
         function drawChar (x, y: Integer; const ch: AnsiChar): Integer; virtual; abstract; // returns char width
         function drawText (x, y: Integer; const s: AnsiString): Integer; virtual; abstract; // returns text width
 
-        function iconMarkWidth (ic: TMarkIcon): Integer; virtual; abstract;
-        function iconMarkHeight (ic: TMarkIcon): Integer; virtual; abstract;
-        procedure drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean); virtual; abstract;
-
-        function iconWinWidth (ic: TWinIcon): Integer; virtual; abstract;
-        function iconWinHeight (ic: TWinIcon): Integer; virtual; abstract;
-        procedure drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean); virtual; abstract;
-
         procedure resetClip (); virtual; abstract;
-
-//        function setOffset (constref aofs: TGxOfs): TGxOfs; virtual; abstract; // returns previous offset
-//        function setClip (constref aclip: TGxRect): TGxRect; virtual; abstract; // returns previous clip
-
         function combineClip (constref aclip: TGxRect): TGxRect; virtual; abstract; // returns previous clip
 
-        // vertical scrollbar
-        procedure drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA); virtual; abstract;
-        // horizontal scrollbar
-        procedure drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA); virtual; abstract;
-
-        class function sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
-        class function sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
-
-      protected
+      protected (* abstract interface *)
         function  getColor (): TGxRGBA; virtual; abstract;
         procedure setColor (const clr: TGxRGBA); virtual; abstract;
 
@@ -79,6 +59,23 @@ interface
         procedure onActivate (); virtual; abstract;
         procedure onDeactivate (); virtual; abstract;
 
+        procedure setScale (a: Single); virtual; abstract;
+
+      public (* portable interface *)
+        function iconMarkWidth (ic: TMarkIcon): Integer;
+        function iconMarkHeight (ic: TMarkIcon): Integer;
+        procedure drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
+
+        function iconWinWidth (ic: TWinIcon): Integer;
+        function iconWinHeight (ic: TWinIcon): Integer;
+        procedure drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
+
+        procedure drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
+        procedure drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
+
+        class function sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
+        class function sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
+
       private
         mActive: Boolean;
 
@@ -101,7 +98,7 @@ interface
 
 implementation
 
-  uses SysUtils;
+  uses SysUtils, utils;
 
   var
     curCtx: TGxContext = nil;
@@ -127,6 +124,7 @@ implementation
     begin
       ctx.mActive := true;
       ctx.onActivate();
+      ctx.setScale(ascale);
     end;
   end;
 
@@ -138,6 +136,176 @@ implementation
       raise Exception.Create('FlexUI: hook not installed: font named '''+fontname+''' can not be loaded')
   end;
 
+  function TGxContext.iconMarkWidth (ic: TMarkIcon): Integer;
+  begin
+    {$IFDEF FUI_TEXT_ICONS}
+    case ic of
+      TMarkIcon.Checkbox: result := textWidth('[x]');
+      TMarkIcon.Radiobox: result := textWidth('(*)');
+      else result := textWidth('[x]');
+    end;
+    {$ELSE}
+    result := 11;
+    {$ENDIF}
+  end;
+
+  function TGxContext.iconMarkHeight (ic: TMarkIcon): Integer;
+  begin
+    {$IFDEF FUI_TEXT_ICONS}
+    case ic of
+      TMarkIcon.Checkbox: result := textHeight('[x]');
+      TMarkIcon.Radiobox: result := textHeight('(*)');
+      else result := textHeight('[x]');
+    end;
+    {$ELSE}
+    result := 8;
+    {$ENDIF}
+  end;
+
+  procedure TGxContext.drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
+  var
+    {$IFDEF FUI_TEXT_ICONS}
+    xstr: AnsiString;
+    {$ELSE}
+    f: Integer;
+    {$ENDIF}
+  begin
+    if (not self.active) or (self.clip.w < 1) or (self.clip.h < 1) or (self.color.a = 0) then exit;
+    {$IFDEF FUI_TEXT_ICONS}
+    case ic of
+      TMarkIcon.Checkbox: xstr := '[x]';
+      TMarkIcon.Radiobox: xstr := '(*)';
+      else exit;
+    end;
+    if (marked) then
+    begin
+      drawText(x, y, xstr);
+    end
+    else
+    begin
+      drawChar(x, y, xstr[1]);
+      drawChar(x+textWidth(xstr)-charWidth(xstr[3]), y, xstr[3]);
+    end;
+    {$ELSE}
+    if (ic = TMarkIcon.Checkbox) then
+    begin
+      vline(x, y, 7);
+      vline(x+10, y, 7);
+      hline(x+1, y, 1);
+      hline(x+1, y+6, 1);
+      hline(x+9, y, 1);
+      hline(x+9, y+6, 1);
+    end
+    else
+    begin
+      vline(x, y+1, 5);
+      vline(x+10, y+1, 5);
+      hline(x+1, y, 1);
+      hline(x+1, y+6, 1);
+      hline(x+9, y, 1);
+      hline(x+9, y+6, 1);
+    end;
+    if (not marked) then exit;
+    case ic of
+      TMarkIcon.Checkbox:
+        begin
+          for f := 0 to 4 do
+          begin
+            vline(x+3+f, y+1+f, 1);
+            vline(x+7-f, y+1+f, 1);
+          end;
+        end;
+      TMarkIcon.Radiobox:
+        begin
+          hline(x+4, y+1, 3);
+          hline(x+3, y+2, 5);
+          hline(x+3, y+3, 5);
+          hline(x+3, y+4, 5);
+          hline(x+4, y+5, 3);
+        end;
+    end;
+    {$ENDIF}
+  end;
+
+  function TGxContext.iconWinWidth (ic: TWinIcon): Integer;
+  begin
+    {$IFDEF FUI_TEXT_ICONS}
+    case ic of
+      TWinIcon.Close: result := nmax(textWidth('[x]'), textWidth('[#]'));
+      else result := nmax(textWidth('[x]'), textWidth('[#]'));
+    end;
+    {$ELSE}
+    result := 9;
+    {$ENDIF}
+  end;
+
+  function TGxContext.iconWinHeight (ic: TWinIcon): Integer;
+  begin
+    {$IFDEF FUI_TEXT_ICONS}
+    case ic of
+      TWinIcon.Close: result := nmax(textHeight('[x]'), textHeight('[#]'));
+      else result := nmax(textHeight('[x]'), textHeight('[#]'));
+    end;
+    {$ELSE}
+    result := 8;
+    {$ENDIF}
+  end;
+
+  procedure TGxContext.drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
+  var
+    {$IFDEF FUI_TEXT_ICONS}
+    xstr: AnsiString;
+    wdt: Integer;
+    {$ELSE}
+    f: Integer;
+    {$ENDIF}
+  begin
+    if (not self.active) or (self.clip.w < 1) or (self.clip.h < 1) or (self.color.a = 0) then exit;
+    {$IFDEF FUI_TEXT_ICONS}
+    case ic of
+      TWinIcon.Close: if (pressed) then xstr := '[#]' else xstr := '[x]';
+      else exit;
+    end;
+    wdt := nmax(textWidth('[x]'), textWidth('[#]'));
+    drawChar(x, y, xstr[1]);
+    drawChar(x+wdt-charWidth(xstr[3]), y, xstr[3]);
+    drawChar(x+((wdt-charWidth(xstr[2])) div 2), y, xstr[2]);
+    {$ELSE}
+    if pressed then rect(x, y, 9, 8);
+    for f := 1 to 5 do
+    begin
+      vline(x+1+f, y+f, 1);
+      vline(x+1+6-f, y+f, 1);
+    end;
+    {$ENDIF}
+  end;
+
+  // vertical scroll bar
+  procedure TGxContext.drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
+  var
+    filled: Integer;
+  begin
+    if (wdt < 1) or (hgt < 1) then exit;
+    filled := sbarFilled(hgt, cur, min, max);
+    color := clrfull;
+    fillRect(x, y, wdt, filled);
+    color := clrempty;
+    fillRect(x, y+filled, wdt, hgt-filled);
+  end;
+
+  // horizontal scrollbar
+  procedure TGxContext.drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
+  var
+    filled: Integer;
+  begin
+    if (wdt < 1) or (hgt < 1) then exit;
+    filled := sbarFilled(wdt, cur, min, max);
+    color := clrfull;
+    fillRect(x, y, filled, hgt);
+    color := clrempty;
+    fillRect(x+filled, y, wdt-filled, hgt);
+  end;
+
   class function TGxContext.sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
   begin
          if (wh < 1) then result := 0
index b4ab11bf421334107877508b550960915504f160..06c6891f6cac17947f3fa57a3cdcb4a86c529cde 100644 (file)
@@ -57,13 +57,16 @@ type
     mClipRect: TGxRect;
     mClipOfs: TGxOfs;
 
-  protected
+  protected (* internal *)
     procedure realizeClip (); // setup scissoring
     procedure setClipOfs (const aofs: TGxOfs); // !!!
 
-  public
+  public (* internal *)
     function setOffset (constref aofs: TGxOfs): TGxOfs; // returns previous offset
     function setClip (constref aclip: TGxRect): TGxRect; // returns previous clip
+    procedure glSetScale (ascale: Single);
+    procedure glSetTrans (ax, ay: Single);
+    procedure glSetScaleTrans (ascale, ax, ay: Single);
 
   protected
     function getFont (): AnsiString; override;
@@ -78,6 +81,8 @@ type
     function  getClipRect (): TGxRect; override;
     procedure setClipRect (const aclip: TGxRect); override;
 
+    procedure setScale (a: Single); override;
+
   public
     constructor Create ();
     destructor Destroy (); override;
@@ -96,28 +101,9 @@ type
     function drawChar (x, y: Integer; const ch: AnsiChar): Integer; override; // returns char width
     function drawText (x, y: Integer; const s: AnsiString): Integer; override; // returns text width
 
-    function iconMarkWidth (ic: TMarkIcon): Integer; override;
-    function iconMarkHeight (ic: TMarkIcon): Integer; override;
-    procedure drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean); override;
-
-    function iconWinWidth (ic: TWinIcon): Integer; override;
-    function iconWinHeight (ic: TWinIcon): Integer; override;
-    procedure drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean); override;
-
     procedure resetClip (); override;
-
     function combineClip (constref aclip: TGxRect): TGxRect; override; // returns previous clip
 
-    // vertical scrollbar
-    procedure drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA); override;
-    // horizontal scrollbar
-    procedure drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA); override;
-
-  public //HACK!
-    procedure glSetScale (ascale: Single);
-    procedure glSetTrans (ax, ay: Single);
-    procedure glSetScaleTrans (ascale, ax, ay: Single);
-
   public
     property color: TGxRGBA read mColor write setColor;
     property offset: TGxOfs read mClipOfs write setClipOfs;
@@ -797,26 +783,8 @@ end;
 
 
 procedure TGxContext.onActivate ();
-//ascale: Single; domatrix: Boolean;
-var
-  mt: packed array [0..15] of GLfloat;
 begin
   savedGLState.save();
-//  if (domatrix) then
-//  begin
-//    oglSetup2D(fuiScrWdt, fuiScrHgt);
-//    glScalef(ascale, ascale, 1.0);
-//    self.mScaled := (ascale <> 1.0);
-//    self.mScale := ascale;
-//  end
-//  else
-  begin
-    // assume uniform scale
-    glGetFloatv(GL_MODELVIEW_MATRIX, @mt[0]);
-    self.mScaled := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
-    self.mScale := mt[0];
-    oglSetup2DState();
-  end;
   setupGLColor(mColor);
   realizeClip();
 end;
@@ -1129,152 +1097,11 @@ begin
 end;
 
 
-function TGxContext.iconMarkWidth (ic: TMarkIcon): Integer;
-begin
-  {$IFDEF FUI_TEXT_ICONS}
-  case ic of
-    TMarkIcon.Checkbox: result := textWidth('[x]');
-    TMarkIcon.Radiobox: result := textWidth('(*)');
-    else result := textWidth('[x]');
-  end;
-  {$ELSE}
-  result := 11;
-  {$ENDIF}
-end;
-
-function TGxContext.iconMarkHeight (ic: TMarkIcon): Integer;
-begin
-  {$IFDEF FUI_TEXT_ICONS}
-  case ic of
-    TMarkIcon.Checkbox: result := textHeight('[x]');
-    TMarkIcon.Radiobox: result := textHeight('(*)');
-    else result := textHeight('[x]');
-  end;
-  {$ELSE}
-  result := 8;
-  {$ENDIF}
-end;
-
-procedure TGxContext.drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
-var
-  {$IFDEF FUI_TEXT_ICONS}
-  xstr: AnsiString;
-  {$ELSE}
-  f: Integer;
-  {$ENDIF}
-begin
-  if (not self.active) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
-  {$IFDEF FUI_TEXT_ICONS}
-  case ic of
-    TMarkIcon.Checkbox: xstr := '[x]';
-    TMarkIcon.Radiobox: xstr := '(*)';
-    else exit;
-  end;
-  if (marked) then
-  begin
-    drawText(x, y, xstr);
-  end
-  else
-  begin
-    drawChar(x, y, xstr[1]);
-    drawChar(x+textWidth(xstr)-charWidth(xstr[3]), y, xstr[3]);
-  end;
-  {$ELSE}
-  if (ic = TMarkIcon.Checkbox) then
-  begin
-    vline(x, y, 7);
-    vline(x+10, y, 7);
-    hline(x+1, y, 1);
-    hline(x+1, y+6, 1);
-    hline(x+9, y, 1);
-    hline(x+9, y+6, 1);
-  end
-  else
-  begin
-    vline(x, y+1, 5);
-    vline(x+10, y+1, 5);
-    hline(x+1, y, 1);
-    hline(x+1, y+6, 1);
-    hline(x+9, y, 1);
-    hline(x+9, y+6, 1);
-  end;
-  if (not marked) then exit;
-  case ic of
-    TMarkIcon.Checkbox:
-      begin
-        for f := 0 to 4 do
-        begin
-          vline(x+3+f, y+1+f, 1);
-          vline(x+7-f, y+1+f, 1);
-        end;
-      end;
-    TMarkIcon.Radiobox:
-      begin
-        hline(x+4, y+1, 3);
-        hline(x+3, y+2, 5);
-        hline(x+3, y+3, 5);
-        hline(x+3, y+4, 5);
-        hline(x+4, y+5, 3);
-      end;
-  end;
-  {$ENDIF}
-end;
-
-
-function TGxContext.iconWinWidth (ic: TWinIcon): Integer;
-begin
-  {$IFDEF FUI_TEXT_ICONS}
-  case ic of
-    TWinIcon.Close: result := nmax(textWidth('[x]'), textWidth('[#]'));
-    else result := nmax(textWidth('[x]'), textWidth('[#]'));
-  end;
-  {$ELSE}
-  result := 9;
-  {$ENDIF}
-end;
-
-function TGxContext.iconWinHeight (ic: TWinIcon): Integer;
-begin
-  {$IFDEF FUI_TEXT_ICONS}
-  case ic of
-    TWinIcon.Close: result := nmax(textHeight('[x]'), textHeight('[#]'));
-    else result := nmax(textHeight('[x]'), textHeight('[#]'));
-  end;
-  {$ELSE}
-  result := 8;
-  {$ENDIF}
-end;
-
-procedure TGxContext.drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
-var
-  {$IFDEF FUI_TEXT_ICONS}
-  xstr: AnsiString;
-  wdt: Integer;
-  {$ELSE}
-  f: Integer;
-  {$ENDIF}
+procedure TGxContext.setScale (a: Single);
 begin
-  if (not self.active) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
-  {$IFDEF FUI_TEXT_ICONS}
-  case ic of
-    TWinIcon.Close: if (pressed) then xstr := '[#]' else xstr := '[x]';
-    else exit;
-  end;
-  wdt := nmax(textWidth('[x]'), textWidth('[#]'));
-  drawChar(x, y, xstr[1]);
-  drawChar(x+wdt-charWidth(xstr[3]), y, xstr[3]);
-  drawChar(x+((wdt-charWidth(xstr[2])) div 2), y, xstr[2]);
-  {$ELSE}
-  if pressed then rect(x, y, 9, 8);
-  for f := 1 to 5 do
-  begin
-    vline(x+1+f, y+f, 1);
-    vline(x+1+6-f, y+f, 1);
-  end;
-  {$ENDIF}
+  self.glSetScale(a);
 end;
 
-
 procedure TGxContext.glSetScale (ascale: Single);
 begin
   if (ascale < 0.01) then ascale := 0.01;
@@ -1299,34 +1126,6 @@ begin
 end;
 
 
-// vertical scroll bar
-procedure TGxContext.drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
-var
-  filled: Integer;
-begin
-  if (wdt < 1) or (hgt < 1) then exit;
-  filled := sbarFilled(hgt, cur, min, max);
-  color := clrfull;
-  fillRect(x, y, wdt, filled);
-  color := clrempty;
-  fillRect(x, y+filled, wdt, hgt-filled);
-end;
-
-
-// horizontal scrollbar
-procedure TGxContext.drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
-var
-  filled: Integer;
-begin
-  if (wdt < 1) or (hgt < 1) then exit;
-  filled := sbarFilled(wdt, cur, min, max);
-  color := clrfull;
-  fillRect(x, y, filled, hgt);
-  color := clrempty;
-  fillRect(x+filled, y, wdt-filled, hgt);
-end;
-
-
 // ////////////////////////////////////////////////////////////////////////// //
 (*
 procedure oglRestoreMode (doClear: Boolean);