DEADSOFTWARE

flexui: move portable drawing code back to fui_gfx
[d2df-sdl.git] / src / flexui / fui_gfx.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