unit CBI;
interface

uses GfxManager;

type
    PWord = ^Word;
    IndexArray = array[0..1249] of Word;
    PIndexArray = ^IndexArray;
    ChunkArray = array[0..1249] of Chunk;
    PChunkArray = ^ChunkArray;
    ChunkLocation = (locVram, locRam);
    SubImage = record
        num_chunks: Word;
        num_indexes: Word;
        indexes: PIndexArray;
        case loc: ChunkLocation of
            locVram: (chunk_char_start: Word);
            locRam: (chunk_address: PChunkArray);
    end;
    PSubImage = ^SubImage;
    ChunkedBitmapImage = record
        width: Byte;
        height: Byte;
        image: SubImage;
        mask: PSubImage;
    end;

procedure LoadCBI(const filename: string; var out: ChunkedBitmapImage);
procedure DisposeCBI(var cbi: ChunkedBitmapImage);
procedure DisplayCBI(const cbi: ChunkedBitmapImage; x, y: Byte);

implementation

uses Util, Apricot;

type PackedIndexArray = array[0..1874] of Byte;

const MAGIC: array[0..3] of Byte = ($A7, $63, $69, $00);

var tmp: String;

procedure LoadChunkList(var f: File; var out: SubImage; chunk_location: ChunkLocation);
var count, byte_len, actualRead: Word;
    chunk: array[0..15] of Word;
    chunkPtr: PChunkArray;
begin
    BlockRead(f, count, 2, actualRead);
    if actualRead = 0 then
        Die('could not read chunk count');

    out.loc := chunk_location;
    byte_len := count * 32;
    case chunk_location of
        locVram:
            { AllocChars counts characters, not bytes }
            gfxman.AllocChars(count, Pointer(chunkPtr), out.chunk_char_start);
        locRam:
            GetMem(chunkPtr, byte_len);
    end;

    BlockRead(f, chunkPtr^, byte_len, actualRead);
    if actualRead < byte_len then
        Die('short read loading chunks');

    if chunk_location = locRam then
        out.chunk_address := chunkPtr;
    out.num_chunks := count;
end;

procedure LoadIndexes(var f: File; var out: SubImage; count: Word);
var i, j, packedCount, actualRead: Word;
    buf: array[0..1] of Byte;
    tmpIndexes: ^PackedIndexArray;
    unpackedIndexes: PIndexArray;
begin
    { Indexes are packed as 12-bit values across three bytes: LH1 UH2UH1 LH2 }
    packedCount := ((count + 1) div 2) * 3;

    out.num_indexes := count;
    GetMem(unpackedIndexes, count * 2);
    GetMem(tmpIndexes, packedCount);
    BlockRead(f, tmpIndexes^, packedCount, actualRead);
    if actualRead < packedCount then
        Die('could not read indexes');

    i := 0;
    j := 0;
    while i < count do begin
        unpackedIndexes^[i] := Word(tmpIndexes^[j]) OR (Word(tmpIndexes^[j+1] AND $0F) SHL 8);
        if i < count then
            unpackedIndexes^[i + 1] := Word(tmpIndexes^[j+2]) OR (Word(tmpIndexes^[j+1] AND $F0) SHL 4);
        i := i + 2;
        j := j + 3;
    end;
    FreeMem(tmpIndexes, packedCount);
    out.indexes := unpackedIndexes;
end;

procedure LoadCBI(const filename: string; var out: ChunkedBitmapImage);
var f: File;
    char_count, actualRead: Word;
    buf: array[0..3] of Byte;
begin
    Assign(f, filename);
    Reset(f, 1);
    BlockRead(f, buf, 4, actualRead);
    if not CompareArray(buf, MAGIC, 4) then
        Die('Invalid Magic in CBI: ' + filename);

    BlockRead(f, buf, 2, actualRead);
    if actualRead < 2 then
        Die('could not read header');
    out.width := buf[0];
    out.height := buf[1];
    out.mask := nil;
    char_count := out.width * out.height;

    repeat
        BlockRead(f, buf, 1, actualRead);
        case buf[0] of
            8:  begin
                LoadChunkList(f, out.image, locVram);
            end;
            9:  LoadIndexes(f, out.image, char_count);
            16: begin
                New(out.mask);
                LoadChunkList(f, out.mask^, locRam);
            end;
            17: LoadIndexes(f, out.mask^, char_count);
        else
            begin
                Writeln('unknown chunk type: ', buf[0]);
                Halt(1);
            end;
        end;
    until Eof(f);
    Close(f);
end;

procedure DisposeSubimage(var img: SubImage);
begin
    FreeMem(img.indexes, img.num_indexes * 2);
    if img.loc = locRam then
        FreeMem(img.chunk_address, img.num_chunks * 32);
end;

procedure DisposeCBI(var cbi: ChunkedBitmapImage);
begin
    DisposeSubimage(cbi.image);
    if cbi.mask <> nil then begin
        DisposeSubimage(cbi.mask^);
        Dispose(cbi.mask);
    end;
end;

procedure DisplayCBI(const cbi: ChunkedBitmapImage; x, y: Byte);
var i, j, k, max_x, max_y: Byte;
    src_idx, mask: Word;
    iptr, mptr: PWord;
    char_data, sdata, idata, mdata: PChunk;
begin
    max_x := x + cbi.width - 1;
    if max_x >= 50 then
        max_x := 49;
    max_y := y + cbi.height - 1;
    if max_y >= 25 then
        max_y := 24;

    if cbi.mask = nil then begin
        for j := y to max_y do begin
            iptr := @cbi.image.indexes^[(j - y) * cbi.width];
            for i := x to max_x do begin
                case iptr^ of
                    $FFE: src_idx := CHAR_BLACK;
                    $FFF: src_idx := CHAR_WHITE;
                else
                    src_idx := cbi.image.chunk_char_start + iptr^;
                end;
                charTable[j * 50 + i] := src_idx;
                Inc(iptr);
            end;
        end;
    end
    else begin
        for j := y to max_y do begin
            { image pointer - pointer to index array for image }
            iptr := @cbi.image.indexes^[(j - y) * cbi.width];
            { mask pointer - pointer to index array for mask }
            mptr := @cbi.mask^.indexes^[(j - y) * cbi.width];
            for i := x to max_x do begin
                case iptr^ of
                    $FFE: src_idx := CHAR_BLACK;
                    $FFF: src_idx := CHAR_WHITE;
                else
                    src_idx := cbi.image.chunk_char_start + iptr^;
                end;
                case mptr^ of
                    $FFE: ;  { zero mask - no data copied }
                    $FFF:    { full mask - all data copied }
                        charTable[j * 50 + i] := src_idx;
                else
                    begin    { composite screen data into the character }
                        { clone the source data }
                        gfxman.CloneChar(src_idx, src_idx);
                        iptr^ := src_idx;
                        { screen data - what is already displayed }
                        sdata := Ptr($0000, charTable[j * 50 + i] SHL 5);
                        { image data - new data being added }
                        idata := Ptr($0000, src_idx SHL 5);
                        { mask data - 0 is screen data, 1 is image data }
                        mdata := @cbi.mask^.chunk_address^[mptr^];
                        for k := 0 to 15 do begin
                            mask := mdata^[k];
                            idata^[k] :=
                                (sdata^[k] AND (NOT mask)) OR
                                (idata^[k] AND mask);
                        end;
                        charTable[j * 50 + i] := src_idx;
                    end;
                end;
                Inc(iptr);
                Inc(mptr);
            end;
        end;
    end;
end;

end.