[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[tyndur-devel] [PATCH 2/4] Pascal-RTL: Units zum Pinseln von TUIs
+ Pascal-RTL: Unit tui
Signed-off-by: Kevin Wolf <kevin@xxxxxxxxxx>
---
src/modules/pas/lib/tui/Makefile.all | 1 +
src/modules/pas/lib/tui/tui.pas | 533 ++++++++++++++++++++++++++++++++++
2 files changed, 534 insertions(+), 0 deletions(-)
create mode 100644 src/modules/pas/lib/tui/Makefile.all
create mode 100644 src/modules/pas/lib/tui/tui.pas
diff --git a/src/modules/pas/lib/tui/Makefile.all b/src/modules/pas/lib/tui/Makefile.all
new file mode 100644
index 0000000..a645d3e
--- /dev/null
+++ b/src/modules/pas/lib/tui/Makefile.all
@@ -0,0 +1 @@
+cp libptui.a tui.ppu ../units
diff --git a/src/modules/pas/lib/tui/tui.pas b/src/modules/pas/lib/tui/tui.pas
new file mode 100644
index 0000000..a130f81
--- /dev/null
+++ b/src/modules/pas/lib/tui/tui.pas
@@ -0,0 +1,533 @@
+unit tui;
+{$MODE ObjFPC}
+{$H+}
+{$COPERATORS ON}
+
+interface
+
+type
+ TUIObject = class
+ public
+ color: byte;
+ bgcolor: byte;
+
+ protected
+ f_w, f_h: integer;
+
+ public
+ constructor create;
+ procedure align(w, h: integer); virtual;
+ procedure draw(x, y: integer); virtual;
+
+ property width: integer read f_w write f_w;
+ property height: integer read f_h write f_h;
+ end;
+ PTUIObject = ^TUIObject;
+
+ TUIRowColContainer = class(TUIObject)
+ public
+ constructor create(num: integer);
+ destructor free;
+
+ protected
+ cols: integer;
+ children: PTUIObject;
+
+ f_fixed: PInteger;
+ f_prop: PInteger;
+
+ public
+ spacer: boolean;
+
+ protected
+ procedure SetChild(i: integer; obj: TUIObject);
+ procedure SetFixedWidth(i: integer; w: integer);
+ procedure SetPropWidth(i: integer; w: integer);
+
+ public
+ property _children[i: integer]: TUIObject write SetChild; default;
+ property fixed[i: integer]: integer write SetFixedWidth;
+ property prop[i: integer]: integer write SetPropWidth;
+ end;
+
+ TUIColContainer = class(TUIRowColContainer)
+ public
+ procedure align(w, h: integer); override;
+ procedure draw(x, y: integer); override;
+ end;
+
+ TUIRowContainer = class(TUIRowColContainer)
+ public
+ procedure align(w, h: integer); override;
+ procedure draw(x, y: integer); override;
+ end;
+
+ TUIFrame = class(TUIObject)
+ protected
+ f_obj: TUIObject;
+ f_obj_w: integer;
+ f_obj_h: integer;
+
+ public
+ constructor create(obj: TUIObject; w, h: integer);
+ procedure align(w, h: integer); override;
+ procedure draw(x, y: integer); override;
+
+ property obj: TUIObject read f_obj write f_obj;
+ end;
+
+ TUILabel = class(TUIObject)
+ protected
+ f_content: UnicodeString;
+
+ public
+ procedure draw(x, y: integer); override;
+ property content: UnicodeString read f_content write f_content;
+ end;
+
+ TUIButton = class(TUILabel)
+ public
+ procedure draw(x, y: integer); override;
+ end;
+
+ TMenuItem = record
+ s: UnicodeString;
+ opaque: Pointer;
+ end;
+ PMenuItem = ^TMenuItem;
+
+ TUIMenu = class(TUIObject)
+ protected
+ f_num: integer;
+ f_cur: integer;
+ f_selected: integer;
+ f_items: PMenuItem;
+
+ public
+ sel_color: byte;
+ sel_bgcolor: byte;
+
+ public
+ constructor create(num: integer);
+ destructor free;
+
+ procedure draw(x, y: integer); override;
+ procedure AddItem(s: UnicodeString; opaque: Pointer);
+ property selected: integer read f_selected write f_selected;
+ end;
+
+implementation
+
+uses crt, sysutils, strutils;
+
+procedure FillRect(x, y, w, h: integer);
+var
+ i: integer;
+begin
+ for i := y to y + h - 1 do begin
+ GotoXY(x, i);
+ Write(StringOfChar(' ', w));
+ end;
+end;
+
+procedure WritePadded(s: UnicodeString; w: integer);
+begin
+ if Length(s) >= w then begin
+ Write(Copy(s, 1, w));
+ end else begin
+ Write(Utf8Encode(s));
+ Write(StringOfChar(' ', w - Length(s)));
+ end;
+end;
+
+
+constructor TUIObject.create;
+begin
+ color := 7;
+ bgcolor := 0;
+end;
+
+procedure TUIObject.align(w, h: integer);
+begin
+ f_w := w;
+ f_h := h;
+end;
+
+procedure TUIObject.draw(x, y: integer);
+begin
+ TextColor(color);
+ TextBackground(bgcolor);
+ FillRect(x, y, f_w, f_h);
+end;
+
+constructor TUIRowColContainer.create(num: integer);
+var
+ i: integer;
+begin
+ if num < 1 then begin
+ raise Exception.create('TUIColContainer: num < 1');
+ end;
+
+ spacer := false;
+
+ cols := num;
+ children := GetMem(sizeof(PTUIObject) * num);
+ f_fixed := GetMem(sizeof(integer) * num);
+ f_prop := GetMem(sizeof(integer) * num);
+
+ FillByte(children^, sizeof(PTUIObject) * num, 0);
+ FillByte(f_fixed^, sizeof(integer) * num, 0);
+ FillByte(f_prop^, sizeof(integer) * num, 0);
+
+ for i := 0 to cols - 1 do begin
+ children[i] := nil;
+ f_fixed[i] := 0;
+ f_prop[i] := 0;
+ end;
+end;
+
+destructor TUIRowColContainer.free;
+var
+ i: integer;
+begin
+ for i := 0 to cols - 1 do begin
+ if children[i] <> nil then begin
+ children[i].free;
+ end;
+ end;
+
+ FreeMem(children);
+ FreeMem(f_fixed);
+ FreeMem(f_prop);
+end;
+
+procedure TUIRowColContainer.SetChild(i: integer; obj: TUIObject);
+begin
+ children[i] := obj;
+end;
+
+procedure TUIRowColContainer.SetFixedWidth(i: integer; w: integer);
+begin
+ f_fixed[i] := w;
+end;
+
+procedure TUIRowColContainer.SetPropWidth(i: integer; w: integer);
+begin
+ f_prop[i] := w;
+end;
+
+procedure TUIColContainer.align(w, h: integer);
+var
+ i: integer;
+ prop_space: integer;
+ cur_w: integer;
+begin
+ f_w := w;
+ f_h := h;
+
+ prop_space := 0;
+ for i := 0 to cols - 1 do begin
+ if f_fixed[i] > 0 then begin
+ if w >= f_fixed[i] then begin
+ w -= f_fixed[i];
+ end else begin
+ f_fixed[i] := w;
+ w := 0;
+ end;
+
+ children[i].align(f_fixed[i], h);
+ end else begin
+ prop_space += f_prop[i];
+ end;
+
+ if spacer and (w > 0) and (i < cols - 1) then begin
+ Dec(w);
+ end;
+ end;
+
+ for i := 0 to cols - 1 do begin
+ if f_fixed[i] = 0 then begin
+ if prop_space = 0 then begin
+ children[i].align(0, h);
+ end else begin
+ cur_w := (w * f_prop[i]) div prop_space;
+ children[i].align(cur_w, h);
+ prop_space -= f_prop[i];
+ w -= cur_w;
+ end;
+ end;
+ end;
+end;
+
+procedure TUIColContainer.draw(x, y: integer);
+var
+ i: integer;
+ w: integer;
+begin
+ w := 0;
+ for i := 0 to cols - 1 do begin
+ children[i].draw(x + w, y);
+ w += children[i].width;
+
+ if spacer then begin
+ Inc(w);
+ end;
+ end;
+
+ if w < f_w then begin
+ TextColor(color);
+ TextBackground(bgcolor);
+ FillRect(x + w, y, f_w - w, f_h);
+ end;
+end;
+
+procedure TUIRowContainer.align(w, h: integer);
+var
+ i: integer;
+ prop_space: integer;
+ cur_h: integer;
+begin
+ f_w := w;
+ f_h := h;
+
+ prop_space := 0;
+ for i := 0 to cols - 1 do begin
+ if f_fixed[i] > 0 then begin
+ if w >= f_fixed[i] then begin
+ h -= f_fixed[i];
+ end else begin
+ f_fixed[i] := h;
+ h := 0;
+ end;
+
+ children[i].align(w, f_fixed[i]);
+ end else begin
+ prop_space += f_prop[i];
+ end;
+
+ if spacer and (h > 0) and (i <> cols - 1) then begin
+ Dec(h);
+ end;
+ end;
+
+ for i := 0 to cols - 1 do begin
+ if f_fixed[i] = 0 then begin
+ if prop_space = 0 then begin
+ children[i].align(w, 0);
+ end else begin
+ cur_h := (h * f_prop[i]) div prop_space;
+ children[i].align(w, cur_h);
+ prop_space -= f_prop[i];
+ h -= cur_h;
+ end;
+ end;
+ end;
+end;
+
+procedure TUIRowContainer.draw(x, y: integer);
+var
+ i: integer;
+ h: integer;
+begin
+ h := 0;
+ for i := 0 to cols - 1 do begin
+ children[i].draw(x, y + h);
+ h += children[i].height;
+
+ if spacer then begin
+ Inc(h);
+ end;
+ end;
+
+ if h < f_h then begin
+ TextColor(color);
+ TextBackground(bgcolor);
+ FillRect(x, y + h, f_w, f_h - h);
+ end;
+end;
+
+constructor TUIFrame.create(obj: TUIObject; w, h: integer);
+begin
+ f_obj := obj;
+ f_obj_w := w;
+ f_obj_h := h;
+end;
+
+procedure TUIFrame.align(w, h: integer);
+begin
+ f_w := w;
+ f_h := h;
+
+ if f_obj_w < w then begin
+ w := f_obj_w;
+ end;
+
+ if f_obj_h < h then begin
+ h := f_obj_h;
+ end;
+
+ f_obj.align(w, h);
+end;
+
+procedure TUIFrame.draw(x, y: integer);
+var
+ w, h: integer;
+begin
+ w := f_w;
+ h := f_h;
+
+ TextColor(color);
+ TextBackground(bgcolor);
+ FillRect(x, y, w, h);
+
+ if f_obj_w < w then begin
+ w := f_obj_w;
+ end;
+
+ if f_obj_h < h then begin
+ h := f_obj_h;
+ end;
+
+ f_obj.draw(x + ((f_w - w) div 2), y + ((f_h - h) div 2));
+end;
+
+procedure TUILabel.draw(x, y: integer);
+var
+ s: UnicodeString;
+ pos: integer;
+ cnt: integer;
+ row: integer;
+ line_start_pos: integer;
+begin
+ if f_h > 0 then begin
+ TextColor(color);
+ TextBackground(bgcolor);
+ FillRect(x, y, f_w, f_h);
+
+ pos := 0;
+ row := 0;
+ cnt := 1;
+ line_start_pos := 1;
+
+ while (pos < Length(f_content)) and (row < f_h) do begin
+
+ s := ExtractWordPos(cnt, f_content, [' '], pos);
+ Inc(cnt);
+ if s = '' then begin
+ break;
+ end;
+
+ if pos - line_start_pos + Length(s) > f_w then begin
+ Inc(row);
+ line_start_pos := pos;
+ if row >= f_h then begin
+ break;
+ end;
+ end;
+
+ GotoXY(x + pos - line_start_pos, y + row);
+ Write(Utf8Encode(s));
+ end;
+ end;
+end;
+
+procedure TUIButton.draw(x, y: integer);
+var
+ s: UnicodeString;
+ diff: integer;
+begin
+ if f_w > 2 then begin
+ TextColor(color);
+ TextBackground(bgcolor);
+ FillRect(x, y, f_w, f_h);
+
+ if Length(content) > f_w - 2 then begin
+ s := '<' + Copy(content, 1, f_w - 2) + '>';
+ end else begin
+ diff := f_w - 2 - Length(content);
+ s := '<' + StringOfChar(' ', diff div 2) + content +
+ StringOfChar(' ', diff - (diff div 2)) + '>';
+ end;
+
+ GotoXY(x, y);
+ Write(Utf8Encode(s));
+ end;
+end;
+
+constructor TUIMenu.create(num: integer);
+var
+ i: integer;
+begin
+ if num < 1 then begin
+ raise Exception.create('TUIColContainer: num < 1');
+ end;
+
+ sel_color := 14;
+ sel_bgcolor := 1;
+
+ f_cur := 0;
+ f_selected := 0;
+ f_num := num;
+ f_items := GetMem(sizeof(TMenuItem) * num);
+ FillByte(f_items^, sizeof(TMenuItem) * num, 0);
+
+ for i := 0 to f_num - 1 do begin
+ f_items[i].s := '';
+ f_items[i].opaque := nil;
+ end;
+end;
+
+destructor TUIMenu.free;
+begin
+ FreeMem(f_items);
+end;
+
+procedure TUIMenu.draw(x, y: integer);
+var
+ i: integer;
+ last: integer;
+begin
+ TextColor(color);
+ TextBackground(bgcolor);
+ FillRect(x, y, f_w, f_h);
+
+ last := f_cur - 1;
+ if last >= f_h then begin
+ last := f_h - 1;
+ end;
+
+ for i := 0 to last do begin
+ GotoXY(x, y + i);
+ if f_selected = i then begin
+ TextColor(sel_color);
+ TextBackground(sel_bgcolor);
+ end;
+ WritePadded(f_items[i].s, f_w);
+ if f_selected = i then begin
+ TextColor(color);
+ TextBackground(bgcolor);
+ end;
+ end;
+end;
+
+procedure TUIMenu.AddItem(s: UnicodeString; opaque: Pointer);
+begin
+ if f_cur < f_num then begin
+ f_items[f_cur].s := s;
+ f_items[f_cur].opaque := opaque;
+ Inc(f_cur);
+ end;
+end;
+
+
+initialization
+
+ ClrScr;
+
+finalization
+
+ TextBackground(0);
+ TextColor(7);
+ WriteLn;
+
+end.
--
1.6.0.2