DEADSOFTWARE

flexui: remove direct dependency on opengl
[d2df-sdl.git] / 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;
20 interface
22 uses fui_common;
24 type
25 TGxContext = class abstract
26 public
27 type
28 TMarkIcon = (Checkbox, Radiobox);
29 TWinIcon = (Close);
31 public
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;
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
46 function iconMarkWidth (ic: TMarkIcon): Integer; virtual; abstract;
47 function iconMarkHeight (ic: TMarkIcon): Integer; virtual; abstract;
48 procedure drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean); virtual; abstract;
50 function iconWinWidth (ic: TWinIcon): Integer; virtual; abstract;
51 function iconWinHeight (ic: TWinIcon): Integer; virtual; abstract;
52 procedure drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean); virtual; abstract;
54 procedure resetClip (); virtual; abstract;
56 // function setOffset (constref aofs: TGxOfs): TGxOfs; virtual; abstract; // returns previous offset
57 // function setClip (constref aclip: TGxRect): TGxRect; virtual; abstract; // returns previous clip
59 function combineClip (constref aclip: TGxRect): TGxRect; virtual; abstract; // returns previous clip
61 // vertical scrollbar
62 procedure drawVSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA); virtual; abstract;
63 // horizontal scrollbar
64 procedure drawHSBar (x, y, wdt, hgt: Integer; cur, min, max: Integer; constref clrfull, clrempty: TGxRGBA); virtual; abstract;
66 class function sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
67 class function sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
69 protected
70 function getColor (): TGxRGBA; virtual; abstract;
71 procedure setColor (const clr: TGxRGBA); virtual; abstract;
73 function getFont (): AnsiString; virtual; abstract;
74 procedure setFont (const aname: AnsiString); virtual; abstract;
76 function getClipRect (): TGxRect; virtual; abstract;
77 procedure setClipRect (const aclip: TGxRect); virtual; abstract;
79 procedure onActivate (); virtual; abstract;
80 procedure onDeactivate (); virtual; abstract;
82 private
83 mActive: Boolean;
85 public
86 property active: Boolean read mActive;
87 property color: TGxRGBA read getColor write setColor;
88 property font: AnsiString read getFont write setFont;
89 property clip: TGxRect read getClipRect write setClipRect; // clipping is unaffected by offset
90 end;
92 // set active context; `ctx` can be `nil`
93 function gxCreateContext (): TGxContext;
94 procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
95 procedure gxGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
97 var (* installed by implementation *)
98 gxPreSetContextCallback: procedure = nil;
99 gxCreateContextCallback: function (): TGxContext = nil;
100 gxFuiGfxLoadFontCallback: procedure (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean) = nil;
102 implementation
104 uses SysUtils;
106 var
107 curCtx: TGxContext = nil;
109 function gxCreateContext (): TGxContext;
110 begin
111 result := nil;
112 if Assigned(gxCreateContextCallback) then
113 result := gxCreateContextCallback();
114 end;
116 procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
117 begin
118 if Assigned(gxPreSetContextCallback) then
119 gxPreSetContextCallback;
120 if curCtx <> nil then
121 begin
122 curCtx.onDeactivate();
123 curCtx.mActive := false;
124 end;
125 curCtx := ctx;
126 if ctx <> nil then
127 begin
128 ctx.mActive := true;
129 ctx.onActivate();
130 end;
131 end;
133 procedure gxGfxLoadFont (const fontname: AnsiString; const fontFile: AnsiString; proportional: Boolean=false);
134 begin
135 if Assigned(gxFuiGfxLoadFontCallback) then
136 gxFuiGfxLoadFontCallback(fontname, fontFile, proportional)
137 else
138 raise Exception.Create('FlexUI: hook not installed: font named '''+fontname+''' can not be loaded')
139 end;
141 class function TGxContext.sbarFilled (wh: Integer; cur, min, max: Integer): Integer;
142 begin
143 if (wh < 1) then result := 0
144 else if (min > max) then result := 0
145 else if (min = max) then result := wh
146 else
147 begin
148 if (cur < min) then cur := min else if (cur > max) then cur := max;
149 result := wh*(cur-min) div (max-min);
150 end;
151 end;
153 class function TGxContext.sbarPos (cxy: Integer; xy, wh: Integer; min, max: Integer): Integer;
154 begin
155 if (wh < 1) then begin result := 0; exit; end;
156 if (min > max) then begin result := 0; exit; end;
157 if (min = max) then begin result := max; exit; end;
158 if (cxy < xy) then begin result := min; exit; end;
159 if (cxy >= xy+wh) then begin result := max; exit; end;
160 result := min+((max-min)*(cxy-xy) div wh);
161 assert((result >= min) and (result <= max));
162 end;
164 end.