[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