src/flexui/fui_gfx.pas

   1 (* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
   2  * Understanding is not required. Only obedience.
   3  *
   4  * This program is free software: you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation, version 3 of the License ONLY.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program. If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 {$DEFINE FUI_TEXT_ICONS}
  18 unit fui_gfx;
  19
  20 interface
  21
  22   uses fui_common;
  23
  24   type
  25     TGxContext = class abstract
  26       public
  27         type
  28           TMarkIcon = (Checkbox, Radiobox);
  29           TWinIcon = (Close);
  30
  31       public (* abstract interface *)
  32         procedure line (x1, y1, x2, y2: Integer); virtual; abstract;
  33         procedure hline (x, y, len: Integer); virtual; abstract;
  34         procedure vline (x, y, len: Integer); virtual; abstract;
  35         procedure rect (x, y, w, h: Integer); virtual; abstract;
  36         procedure fillRect (x, y, w, h: Integer); virtual; abstract;
  37         procedure darkenRect (x, y, w, h: Integer; a: Integer);  virtual; abstract;
  38
  39         function charWidth (const ch: AnsiChar): Integer; virtual; abstract;
  40         function charHeight (const ch: AnsiChar): Integer; virtual; abstract;
  41         function textWidth (const s: AnsiString): Integer; virtual; abstract;
  42         function textHeight (const s: AnsiString): Integer; virtual; abstract;
  43         function drawChar (x, y: Integer; const ch: AnsiChar): Integer; virtual; abstract; // returns char width
  44         function drawText (x, y: Integer; const s: AnsiString): Integer; virtual; abstract; // returns text width
  45
  46         procedure resetClip (); virtual; abstract;
  47         function combineClip (constref aclip: TGxRect): TGxRect; virtual; abstract; // returns previous clip
  48
  49       protected (* abstract interface *)
  50         function  getColor (): TGxRGBA; virtual; abstract;
  51         procedure setColor (const clr: TGxRGBA); virtual; abstract;
  52
  53         function getFont (): AnsiString; virtual; abstract;
  54         procedure setFont (const aname: AnsiString); virtual; abstract;
  55
  56         function  getClipRect (): TGxRect; virtual; abstract;
  57         procedure setClipRect (const aclip: TGxRect); virtual; abstract;
  58
  59         procedure onActivate (); virtual; abstract;
  60         procedure onDeactivate (); virtual; abstract;
  61
  62         procedure setScale (a: Single); virtual; abstract;
  63
  64       public (* portable interface *)
  65         function iconMarkWidth (ic: TMarkIcon): Integer;
  66         function iconMarkHeight (ic: TMarkIcon): Integer;
  67         procedure drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
  68
  69         function iconWinWidth (ic: TWinIcon): Integer;
  70         function iconWinHeight (ic: TWinIcon): Integer;
  71         procedure drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
  72
  73         procedure drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
  74         procedure drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
  75
  76         class function sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
  77         class function sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
  78
  79       private
  80         mActive: Boolean;
  81
  82       public
  83         property active: Boolean read mActive;
  84         property color: TGxRGBA read getColor write setColor;
  85         property font: AnsiString read getFont write setFont;
  86         property clip: TGxRect read getClipRect write setClipRect; // clipping is unaffected by offset
  87     end;
  88
  89   // set active context; `ctx` can be `nil`
  90   function gxCreateContext (): TGxContext;
  91   procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
  92   procedure gxGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
  93
  94   var (* installed by implementation *)
  95     gxPreSetContextCallback: procedure = nil;
  96     gxCreateContextCallback: function (): TGxContext = nil;
  97     gxFuiGfxLoadFontCallback: procedure (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean) = nil;
  98
  99 implementation
 100
 101   uses SysUtils, utils;
 102
 103   var
 104     curCtx: TGxContext = nil;
 105
 106   function gxCreateContext (): TGxContext;
 107   begin
 108     result := nil;
 109     if Assigned(gxCreateContextCallback) then
 110       result := gxCreateContextCallback();
 111   end;
 112
 113   procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
 114   begin
 115     if Assigned(gxPreSetContextCallback) then
 116       gxPreSetContextCallback;
 117     if curCtx <> nil then
 118     begin
 119       curCtx.onDeactivate();
 120       curCtx.mActive := false;
 121     end;
 122     curCtx := ctx;
 123     if ctx <> nil then
 124     begin
 125       ctx.mActive := true;
 126       ctx.onActivate();
 127       ctx.setScale(ascale);
 128     end;
 129   end;
 130
 131   procedure gxGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
 132   begin
 133     if Assigned(gxFuiGfxLoadFontCallback) then
 134       gxFuiGfxLoadFontCallback(fontname, fontFile, proportional)
 135     else
 136       raise Exception.Create('FlexUI: hook not installed: font named '''+fontname+''' can not be loaded')
 137   end;
 138
 139   function TGxContext.iconMarkWidth (ic: TMarkIcon): Integer;
 140   begin
 141     {$IFDEF FUI_TEXT_ICONS}
 142     case ic of
 143       TMarkIcon.Checkbox: result := textWidth('[x]');
 144       TMarkIcon.Radiobox: result := textWidth('(*)');
 145       else result := textWidth('[x]');
 146     end;
 147     {$ELSE}
 148     result := 11;
 149     {$ENDIF}
 150   end;
 151
 152   function TGxContext.iconMarkHeight (ic: TMarkIcon): Integer;
 153   begin
 154     {$IFDEF FUI_TEXT_ICONS}
 155     case ic of
 156       TMarkIcon.Checkbox: result := textHeight('[x]');
 157       TMarkIcon.Radiobox: result := textHeight('(*)');
 158       else result := textHeight('[x]');
 159     end;
 160     {$ELSE}
 161     result := 8;
 162     {$ENDIF}
 163   end;
 164
 165   procedure TGxContext.drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
 166   var
 167     {$IFDEF FUI_TEXT_ICONS}
 168     xstr: AnsiString;
 169     {$ELSE}
 170     f: Integer;
 171     {$ENDIF}
 172   begin
 173     if (not self.active) or (self.clip.w < 1) or (self.clip.h < 1) or (self.color.a = 0) then exit;
 174     {$IFDEF FUI_TEXT_ICONS}
 175     case ic of
 176       TMarkIcon.Checkbox: xstr := '[x]';
 177       TMarkIcon.Radiobox: xstr := '(*)';
 178       else exit;
 179     end;
 180     if (marked) then
 181     begin
 182       drawText(x, y, xstr);
 183     end
 184     else
 185     begin
 186       drawChar(x, y, xstr[1]);
 187       drawChar(x+textWidth(xstr)-charWidth(xstr[3]), y, xstr[3]);
 188     end;
 189     {$ELSE}
 190     if (ic = TMarkIcon.Checkbox) then
 191     begin
 192       vline(x, y, 7);
 193       vline(x+10, y, 7);
 194       hline(x+1, y, 1);
 195       hline(x+1, y+6, 1);
 196       hline(x+9, y, 1);
 197       hline(x+9, y+6, 1);
 198     end
 199     else
 200     begin
 201       vline(x, y+1, 5);
 202       vline(x+10, y+1, 5);
 203       hline(x+1, y, 1);
 204       hline(x+1, y+6, 1);
 205       hline(x+9, y, 1);
 206       hline(x+9, y+6, 1);
 207     end;
 208     if (not marked) then exit;
 209     case ic of
 210       TMarkIcon.Checkbox:
 211         begin
 212           for f := 0 to 4 do
 213           begin
 214             vline(x+3+f, y+1+f, 1);
 215             vline(x+7-f, y+1+f, 1);
 216           end;
 217         end;
 218       TMarkIcon.Radiobox:
 219         begin
 220           hline(x+4, y+1, 3);
 221           hline(x+3, y+2, 5);
 222           hline(x+3, y+3, 5);
 223           hline(x+3, y+4, 5);
 224           hline(x+4, y+5, 3);
 225         end;
 226     end;
 227     {$ENDIF}
 228   end;
 229
 230   function TGxContext.iconWinWidth (ic: TWinIcon): Integer;
 231   begin
 232     {$IFDEF FUI_TEXT_ICONS}
 233     case ic of
 234       TWinIcon.Close: result := nmax(textWidth('[x]'), textWidth('[#]'));
 235       else result := nmax(textWidth('[x]'), textWidth('[#]'));
 236     end;
 237     {$ELSE}
 238     result := 9;
 239     {$ENDIF}
 240   end;
 241
 242   function TGxContext.iconWinHeight (ic: TWinIcon): Integer;
 243   begin
 244     {$IFDEF FUI_TEXT_ICONS}
 245     case ic of
 246       TWinIcon.Close: result := nmax(textHeight('[x]'), textHeight('[#]'));
 247       else result := nmax(textHeight('[x]'), textHeight('[#]'));
 248     end;
 249     {$ELSE}
 250     result := 8;
 251     {$ENDIF}
 252   end;
 253
 254   procedure TGxContext.drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
 255   var
 256     {$IFDEF FUI_TEXT_ICONS}
 257     xstr: AnsiString;
 258     wdt: Integer;
 259     {$ELSE}
 260     f: Integer;
 261     {$ENDIF}
 262   begin
 263     if (not self.active) or (self.clip.w < 1) or (self.clip.h < 1) or (self.color.a = 0) then exit;
 264     {$IFDEF FUI_TEXT_ICONS}
 265     case ic of
 266       TWinIcon.Close: if (pressed) then xstr := '[#]' else xstr := '[x]';
 267       else exit;
 268     end;
 269     wdt := nmax(textWidth('[x]'), textWidth('[#]'));
 270     drawChar(x, y, xstr[1]);
 271     drawChar(x+wdt-charWidth(xstr[3]), y, xstr[3]);
 272     drawChar(x+((wdt-charWidth(xstr[2])) div 2), y, xstr[2]);
 273     {$ELSE}
 274     if pressed then rect(x, y, 9, 8);
 275     for f := 1 to 5 do
 276     begin
 277       vline(x+1+f, y+f, 1);
 278       vline(x+1+6-f, y+f, 1);
 279     end;
 280     {$ENDIF}
 281   end;
 282
 283   // vertical scroll bar
 284   procedure TGxContext.drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
 285   var
 286     filled: Integer;
 287   begin
 288     if (wdt < 1) or (hgt < 1) then exit;
 289     filled := sbarFilled(hgt, cur, min, max);
 290     color := clrfull;
 291     fillRect(x, y, wdt, filled);
 292     color := clrempty;
 293     fillRect(x, y+filled, wdt, hgt-filled);
 294   end;
 295
 296   // horizontal scrollbar
 297   procedure TGxContext.drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA);
 298   var
 299     filled: Integer;
 300   begin
 301     if (wdt < 1) or (hgt < 1) then exit;
 302     filled := sbarFilled(wdt, cur, min, max);
 303     color := clrfull;
 304     fillRect(x, y, filled, hgt);
 305     color := clrempty;
 306     fillRect(x+filled, y, wdt-filled, hgt);
 307   end;
 308
 309   class function TGxContext.sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
 310   begin
 311          if (wh < 1) then result := 0
 312     else if (min > max) then result := 0
 313     else if (min = max) then result := wh
 314     else
 315     begin
 316       if (cur < min) then cur := min else if (cur > max) then cur := max;
 317       result := wh*(cur-min) div (max-min);
 318     end;
 319   end;
 320
 321   class function TGxContext.sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
 322   begin
 323     if (wh < 1) then begin result := 0; exit; end;
 324     if (min > max) then begin result := 0; exit; end;
 325     if (min = max) then begin result := max; exit; end;
 326     if (cxy < xy) then begin result := min; exit; end;
 327     if (cxy >= xy+wh) then begin result := max; exit; end;
 328     result := min+((max-min)*(cxy-xy) div wh);
 329     assert((result >= min) and (result <= max));
 330   end;
 331
 332 end.