src/flexui/fui_common.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, either version 3 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program. If not, see <http://www.gnu.org/licenses/>.
  16  *)
  17 {$INCLUDE ../shared/a_modes.inc}
  18 unit fui_common;
  19
  20 interface
  21
  22
  23 // ////////////////////////////////////////////////////////////////////////// //
  24 type
  25   TLaySize = record
  26   public
  27     w, h: Integer;
  28
  29   private
  30     function getIdx (idx: Integer): Integer; inline;
  31     procedure setIdx (idx, v: Integer); inline;
  32
  33   public
  34     constructor Create (aw, ah: Integer);
  35
  36     function toString (): AnsiString;
  37
  38     function equals (constref a: TLaySize): Boolean; inline;
  39   public
  40     property item[idx: Integer]: Integer read getIdx write setIdx; default;
  41   end;
  42
  43   TLayPos = record
  44   public
  45     x, y: Integer;
  46
  47   private
  48     function getIdx (idx: Integer): Integer; inline;
  49     procedure setIdx (idx, v: Integer); inline;
  50
  51   public
  52     constructor Create (ax, ay: Integer);
  53
  54     function toString (): AnsiString;
  55
  56     function equals (constref a: TLayPos): Boolean; inline;
  57
  58   public
  59     property item[idx: Integer]: Integer read getIdx write setIdx; default;
  60   end;
  61
  62   TLayMargins = record
  63   public
  64     top, right, bottom, left: Integer;
  65
  66   public
  67     constructor Create (atop, aright, abottom, aleft: Integer);
  68
  69     function toString (): AnsiString;
  70
  71     function horiz (): Integer; inline;
  72     function vert (): Integer; inline;
  73   end;
  74
  75
  76 // ////////////////////////////////////////////////////////////////////////// //
  77 type
  78   TGxRGBA = packed record
  79   public
  80     r, g, b, a: Byte;
  81
  82   public
  83     constructor Create (ar, ag, ab: Integer; aa: Integer=255);
  84
  85     function asUInt (): LongWord; inline;
  86     function isOpaque (): Boolean; inline;
  87     function isTransparent (): Boolean; inline;
  88
  89     // WARNING! This function does blending in RGB space, and RGB space is not linear!
  90     // alpha value of `self` doesn't matter
  91     // `aa` means: 255 for replace color, 0 for keep `self`
  92     function blend (ar, ag, ab, aa: Integer): TGxRGBA; inline;
  93   end;
  94
  95
  96 // ////////////////////////////////////////////////////////////////////////// //
  97 // return `false` if destination rect is empty
  98 // modifies rect0
  99 function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; inline;
 100 procedure normRGBA (var r, g, b, a: Integer); inline;
 101
 102
 103 implementation
 104
 105 uses
 106   utils;
 107
 108
 109 // ////////////////////////////////////////////////////////////////////////// //
 110 constructor TLaySize.Create (aw, ah: Integer); begin w := aw; h := ah; end;
 111 function TLaySize.getIdx (idx: Integer): Integer; inline; begin if (idx = 0) then result := w else if (idx = 1) then result := h else result := -1; end;
 112 procedure TLaySize.setIdx (idx, v: Integer); inline; begin if (idx = 0) then w := v else if (idx = 1) then h := v; end;
 113 function TLaySize.toString (): AnsiString; begin result := formatstrf('[%d,%d]', [w, h]); end;
 114 function TLaySize.equals (constref a: TLaySize): Boolean; inline; begin result := (w = a.w) and (h = a.h); end;
 115
 116 constructor TLayPos.Create (ax, ay: Integer); begin x := ax; y := ay; end;
 117 function TLayPos.getIdx (idx: Integer): Integer; inline; begin if (idx = 0) then result := x else if (idx = 1) then result := y else result := -1; end;
 118 procedure TLayPos.setIdx (idx, v: Integer); inline; begin if (idx = 0) then x := v else if (idx = 1) then y := v; end;
 119 function TLayPos.toString (): AnsiString; begin result := formatstrf('(%d,%d)', [x, y]); end;
 120 function TLayPos.equals (constref a: TLayPos): Boolean; inline; begin result := (x = a.x) and (y = a.y); end;
 121
 122 constructor TLayMargins.Create (atop, aright, abottom, aleft: Integer);
 123 begin
 124   if (atop < 0) then atop := 0;
 125   if (aright < 0) then aright := 0;
 126   if (abottom < 0) then abottom := 0;
 127   if (aleft < 0) then aleft := 0;
 128   left := aleft;
 129   right := aright;
 130   top := atop;
 131   bottom := abottom;
 132 end;
 133 function TLayMargins.toString (): AnsiString; begin result := formatstrf('(%s,%s,%s,%s)', [top, right, bottom, left]); end;
 134 function TLayMargins.horiz (): Integer; inline; begin result := left+right; end;
 135 function TLayMargins.vert (): Integer; inline; begin result := top+bottom; end;
 136
 137
 138 // ////////////////////////////////////////////////////////////////////////// //
 139 constructor TGxRGBA.Create (ar, ag, ab: Integer; aa: Integer=255);
 140 begin
 141   if (ar < 0) then r := 0 else if (ar > 255) then r := 255 else r := Byte(ar);
 142   if (ag < 0) then g := 0 else if (ag > 255) then g := 255 else g := Byte(ag);
 143   if (ab < 0) then b := 0 else if (ab > 255) then b := 255 else b := Byte(ab);
 144   if (aa < 0) then a := 0 else if (aa > 255) then a := 255 else a := Byte(aa);
 145 end;
 146
 147 function TGxRGBA.asUInt (): LongWord; inline; begin result := LongWord(r) or (LongWord(g) shl 8) or (LongWord(b) shl 16) or (LongWord(a) shl 24); end;
 148
 149 function TGxRGBA.isOpaque (): Boolean; inline; begin result := (a = 255); end;
 150 function TGxRGBA.isTransparent (): Boolean; inline; begin result := (a = 0); end;
 151
 152 function TGxRGBA.blend (ar, ag, ab, aa: Integer): TGxRGBA; inline;
 153 var
 154   me, it, a_tmp_, dc_tmp_, srb_tmp_, sg_tmp_, drb_tmp_, dg_tmp_, orb_tmp_, og_tmp_: LongWord;
 155 begin
 156   if (aa <= 0) then begin result := self; exit; end;
 157   result := TGxRGBA.Create(ar, ag, ab, aa);
 158   if (aa >= 255) then begin result.a := a; exit; end;
 159   me := asUInt;
 160   it := result.asUInt;
 161   a_tmp_ := (256-(255-(it shr 24))) and (-(1-(((255-(it shr 24))+1) shr 8))); // to not loose bits, but 255 should become 0
 162   dc_tmp_ := me and $ffffff;
 163   srb_tmp_ := (it and $ff00ff);
 164   sg_tmp_ := (it and $00ff00);
 165   drb_tmp_ := (dc_tmp_ and $ff00ff);
 166   dg_tmp_ := (dc_tmp_ and $00ff00);
 167   orb_tmp_ := (drb_tmp_+(((srb_tmp_-drb_tmp_)*a_tmp_+$800080) shr 8)) and $ff00ff;
 168   og_tmp_ := (dg_tmp_+(((sg_tmp_-dg_tmp_)*a_tmp_+$008000) shr 8)) and $00ff00;
 169   me := (orb_tmp_ or og_tmp_); // or $ff000000; /* and $ffffff;*/
 170   result.r := Byte(me and $ff);
 171   result.g := Byte((me shr 8) and $ff);
 172   result.b := Byte((me shr 16) and $ff);
 173   result.a := a;
 174 end;
 175
 176
 177 // ////////////////////////////////////////////////////////////////////////// //
 178 //TODO: overflow checks
 179 function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; inline;
 180 var
 181   ex0, ey0: Integer;
 182   ex1, ey1: Integer;
 183 begin
 184   result := false;
 185   if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit; // at least one rect is null
 186   // check for intersection
 187   ex0 := x0+w0;
 188   ey0 := y0+h0;
 189   ex1 := x1+w1;
 190   ey1 := y1+h1;
 191   if (ex0 <= x1) or (ey0 <= y1) or (ex1 <= x0) or (ey1 <= y0) then exit;
 192   if (x0 >= ex1) or (y0 >= ey1) or (x1 >= ex0) or (y1 >= ey0) then exit;
 193   // ok, intersects
 194   if (x0 < x1) then x0 := x1;
 195   if (y0 < y1) then y0 := y1;
 196   if (ex0 > ex1) then ex0 := ex1;
 197   if (ey0 > ey1) then ey0 := ey1;
 198   w0 := ex0-x0;
 199   h0 := ey0-y0;
 200   result := (w0 > 0) and (h0 > 0);
 201 end;
 202
 203
 204 procedure normRGBA (var r, g, b, a: Integer); inline;
 205 begin
 206   if (a < 0) then a := 0 else if (a > 255) then a := 255;
 207   if (r < 0) then r := 0 else if (r > 255) then r := 255;
 208   if (g < 0) then g := 0 else if (g > 255) then g := 255;
 209   if (b < 0) then b := 0 else if (b > 255) then b := 255;
 210 end;
 211
 212
 213 end.