On Sat, Nov 14 14:28, Kevin Wolf wrote:
> + 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)
Bei den nicht so wirklich offensichtlichen Klassen, wäre ich wenigstens
über einen Kommentar zur Klasse noch dankbar... ;-)
> + public
> + constructor create(num: integer);
> + destructor free;
> +
> + protected
> + cols: integer;
Das sind in Wahrheit nicht nur cols, oder? ;-) Vielleicht wäre da eine
etwas allgemeinere Bezeichnung angebrachter.
> + 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);
Hm verstehe ich einfach nur das FillByte nicht, oder willst du da auf
Nummer sicher gehen? ;-)
> + 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;
Hier vielleicht f_prop[i] noch auf 0 setzen? Dann wäre jedenfalls klar
geregelt, was gilt, wenn beides gemacht wird.
> +end;
> +
> +procedure TUIRowColContainer.SetPropWidth(i: integer; w: integer);
> +begin
> + f_prop[i] := w;
Dito, nur anders rum.
> +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);
Die Lücken sollen nicht irgendwie noch bunt gemacht werden oder so?
> + 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);
Dito.
> + 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;
Mit Wörtern die länger sind als eine Zeile gibts hier wohl noch ein
Problem, oder? Das müsste sich doch auch relativ einfach behandeln
lassen, und sonst halt doch wenigstens ein TODO oder ein FIXME ;-)
> + 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);
Hm, hier auch wieder... Sollte ich vielleicht lieber mal in die Doku
sehen, was das genau macht? ;-)
> +
> + 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);
Hm hier vielleicht in einem Else-Zweig noch eine Exception werfen?
> + end;
> +end;
> +
> +
> +initialization
> +
> + ClrScr;
> +
> +finalization
> +
> + TextBackground(0);
> + TextColor(7);
> + WriteLn;
> +
> +end.
--
Antoine Kaufmann
<toni@xxxxxxxxxxxxxxxx>
Attachment:
pgp7nAhwvAT97.pgp
Description: PGP signature