unit GfxText;
interface

procedure LoadFont(const filename: String);
procedure WriteLine(const x, y: Byte; const s: String; w: Byte);
procedure Box(const x1, y1, x2, y2: Byte);
procedure TextRegion(const x1, y1, x2, y2: Byte; const s: String);
procedure TextBox(const x1, y1, x2, y2: Byte; const s: String);

implementation

uses Apricot, GfxManager, Util;

type PWord = ^Word;

procedure LoadFont(const filename: String);
var actualRead: Integer;
    f: File;
begin
    Assign(f, filename);
    Reset(f, $1000);
    BlockRead(f, charmem, 1, actualRead);
    if actualRead < 1 then
        Die('could not read font ' + filename);
    Close(f);
end;

function NextBreak(const s: String; const start, width: Byte): Byte;
var i: Byte;
begin
    { first check for a newline }
    for i := start to start + width - 1 do
        if s[i] = #$0D then begin
            NextBreak := i;
            Exit;
        end;

    { If the remaining characters aren't long enough, we won't find a break }
    if Length(s) - start < width - 1 then begin
        NextBreak := 0;
        Exit;
    end;

    { And finally, look for the last whitespace before the width limit }
    for i := start + width - 1 downto start do
        if s[i] = #$20 then begin
            NextBreak := i;
            Exit;
        end;

    { And if we didn't find anything, break at the last character }
    NextBreak := start + width;
end;

procedure WriteLine(const x, y: Byte; const s: String; w: Byte);
var i: Byte;
    p: PWord;
begin
    if x + w > 50 then
        w := 50 - x;
    if w > Length(s) then
        w := Length(s);
    p := @charTable[y * 50 + x];
    for i:= 1 to w do begin
        p^ := $40 + Word(s[i]);
        Inc(p);
    end;
end;

procedure Box(const x1, y1, x2, y2: Byte);
var i, j, w, h: Byte;
    p: PWord;
begin
    w := x2 - x1 - 2;
    h := y2 - y1 - 2;
    p := @charTable[y1 * 50 + x1];
    p^ := Word($40 + $10);
    for i := 0 to w do begin
        Inc(p);
        p^ := Word($40 + $15);
    end;
    Inc(p);
    p^ := Word($40 + $11);
    for i := 0 to h do begin
        p := PWord(PChar(p) + (48 - w) * 2); { Advance to next line }
        p^ := Word($40 + $14);
        for j := 0 to w do begin
            Inc(p);
            p^ := Word($40 + $20);
        end;
        Inc(p);
        p^ := Word($40 + $14);
    end;
    p := PWord(PChar(p) + (48 - w) * 2);
    p^ := Word($40 + $13);
    for i := 0 to w do begin
        Inc(p);
        p^ := Word($40 + $15);
    end;
    Inc(p);
    p^ := Word($40 + $12);
end;

procedure TextRegion(const x1, y1, x2, y2: Byte; const s: String);
var b, i, j, w, h, x: Byte;
    p: PWord;
begin
    w := x2 - x1;
    h := y2 - y1;
    p := @charTable[y1 * 50 + x1];

    j := 0;
    x := 0;
    b := NextBreak(s, 1, w);
    for i := 1 to Length(s) do begin
        if i = b then begin
            j := j + 1;
            if j = h + 1 then
                Exit;  { out of space }
            { calculate the next break }
            b := NextBreak(s, i + 1, w);
            { and skip pointer to the next line }
            p := PWord(PChar(p) + (50 - x) * 2);
            x := 0;
            Continue;
        end;
        p^ := $40 + Word(s[i]);
        Inc(p);
        x := x + 1;
        if (i AND 3) = 0 then
            Delay50(1);
    end;
end;

procedure TextBox(const x1, y1, x2, y2: Byte; const s: String);
var b, i, j, w, h, x: Byte;
    p: PWord;
begin
    Box(x1, y1, x2, y2);
    TextRegion(x1+1, y1+1, x2-1, y2-1, s);
end;

end.