unit GfxManager;
interface

type
    Chunk = array[0..15] of Word;
    PChunk = ^Chunk;
    { An array that can hold all character memory from 0x800 to 0xC800 }
    ScreenCharArray = array[0..1535] of Chunk;
    ScreenTableArray = array[0..2047] of Word;
    GfxTableArray = array[0..1249] of Word; { smaller for gfx mode }
    PGfxTableArray = ^GfxTableArray;
    GfxManagerObj = object
        top: Word; { in 32 byte chunks; starts at $2800 }
        procedure Reset;
        procedure Init;
        procedure AllocSingle(var p: Pointer; var index: Word);
        procedure CloneChar(const from_index: Word; var to_index: Word);
        procedure AllocChars(const n: Word; var p: Pointer; var index_start: Word);
        function SaveTop: Word;
        procedure RestoreTop(rtop: Word);
    end;

const CHAR_BLACK: Word = $18;
const CHAR_WHITE: Word = $19;
var gfxman: GfxManagerObj;
    charTable: ScreenTableArray absolute $F000:0000;
    charmem: ScreenCharArray absolute $0080:0000;

function SaveScreen: PGfxTableArray;
procedure RestoreScreen(const savedTable: PGfxTableArray);

implementation

uses Util;

procedure GfxManagerObj.Reset;
begin
    top := 192; { 0000:1800 - we're using the top half of the first font area for gfx chunks }
end;

procedure GfxManagerObj.Init;
var i: Integer;
    p: ^Word;
begin
    Reset;
    { Create known characters in the top of vector space }
    p := Ptr(0, $300);
    for i := 0 to 15 do begin
        p^ := $0000;
        Inc(p);
    end;
    for i := 0 to 15 do begin
        p^ := $FFFF;
        Inc(p);
    end;
end;

procedure GfxManagerObj.AllocSingle(var p: Pointer; var index: Word);
begin
    if top + 1 > 1600 then
        Die('cannot allocate graphics character');
    index := top;
    p := Ptr($0000, index SHL 5);
    Inc(top);
end;

procedure GfxManagerObj.CloneChar(const from_index: Word; var to_index: Word);
var a, b: PChunk;
    i: Integer;
begin
    a := Ptr($0000, from_index SHL 5);
    AllocSingle(Pointer(b), to_index);
    for i := 0 to 15 do
        b^[i] := a^[i];
end;

{ Allocate a block of characters and return a pointer to it }
procedure GfxManagerObj.AllocChars(const n: Word; var p: Pointer; var index_start: Word);
var str1, str2: string[5];
begin
    if top + n >= 1600 then begin
        Str(n, str1);
        Str(n - (1600 - top), str2);
        Die('character memory overflow allocating ' + str1 + ' characters (overflow by ' + str2 + ')');
    end;
    index_start := top;
    p := Ptr($0000, index_start SHL 5);
    top := top + n;
end;

function GfxManagerObj.SaveTop: Word;
begin
    SaveTop := top;
end;

procedure GfxManagerObj.RestoreTop(rtop: Word);
begin
    top := rtop;
end;

function SaveScreen: PGfxTableArray;
var savedTable: PGfxTableArray;
begin
    New(savedTable);
    Move(charTable, savedTable^, SizeOf(GfxTableArray));
    SaveScreen := savedTable;
end;

procedure RestoreScreen(const savedTable: PGfxTableArray);
begin
    Move(savedTable^, charTable, SizeOf(GfxTableArray));
end;

begin
    gfxman.Init;
end.