Framebuffer.zig conversion

FrameBuffer.pas

unit FrameBuffer;

{$mode ObjFPC}{$H+}{$J-}
{$asmmode GAS}
{$modeswitch AdvancedRecords}
{$modeswitch AutoDeref}
{$coperators On}

interface

uses SysUtils;

//PSFData.inc contains a static 'array of byte' constant generated from 'font.psf'
//with FPC's data2inc utility, using this command-line: 'data2inc -b -A font.psf PSFData.inc FontEmbed'

{$I PSFData.inc}

type
  TRegister = record
  public type
    TRegisterState = (rsReadOnly, rsWriteOnly, rsReadWrite);
  public
    case State: TRegisterState of
      rsReadOnly: (ReadOnly: UInt32);
      rsWriteOnly: (WriteOnly: UInt32);
      rsReadWrite: (ReadWrite: UInt32);
  end;
  
function MMIOWrite(var Reg: TRegister; const Data: UInt32): Boolean;
function MMIORead(constref Reg: TRegister): UInt32;
procedure MMIOWait(const Count: SizeUInt);
function MBoxCall(const D: UInt8): Boolean;

type
  TPSFFont = packed record
  public
    Magic: UInt32;
    Version: UInt32;
    HeaderSize: UInt32;
    Flags: UInt32;
    NumGlyph: UInt32;
    BytesPerGlyph: UInt32;
    Height: UInt32;
    Width: UInt32;
  end;

  PPSFFont = ^TPSFFont;

  TFrameBuffer = record
  public
    Ptr: PUInt8;
    Width: UInt32;
    Height: UInt32;
    Pitch: UInt32;
    Column: UInt32;
    Row: UInt32;
  private
    class function Init: TFrameBuffer; static;
    procedure Put(const C: UInt8);
  public
    class procedure WriteBytes(const Data: AnsiString); static;
  end;

const
  MMIO_BASE = $3F000000;
  VCORE_MBOX = MMIO_BASE + $0000B880;
  MBOX_REQUEST = 0;
  MBOX_TAG_LAST = 0;
  MBOX_CH_PROP = 8;
  MBOX_RESPONSE = $80000000;
  MBOX_FULL = $80000000;
  MBOX_EMPTY = $40000000;
  {$push}{$J+}
  MBOX_STATUS: TRegister = (State: rsReadOnly; ReadOnly: VCORE_MBOX + $18);
  MBOX_READ: TRegister = (State: rsReadOnly; ReadOnly: VCORE_MBOX + $0);
  MBOX_WRITE: TRegister = (State: rsWriteOnly; WriteOnly: VCORE_MBOX + $20);
  {$pop}
var
  {$push}{$CodeAlign VarMin=16}{$CodeAlign VarMax=16}
  MBox: array[0..35] of UInt32;
  {$pop}

procedure Put(const C: UInt8);
procedure Write(const Data: AnsiString; const Args: array of const);

var InitState: Boolean = False;

implementation

const Font: PPSFFont = @FontEmbed[0];
var GBuffer: TFrameBuffer;

function MMIOWrite(var Reg: TRegister; const Data: UInt32): Boolean;
begin
  ReadWriteBarrier();
  case Reg.State of
    rsReadOnly: Exit(False);
    rsWriteOnly:
    begin
      Reg.WriteOnly := Data;
      Exit(True);
    end;
    rsReadWrite:
    begin
      Reg.ReadWrite := Data;
      Exit(True);
    end;
  end;
end;

function MMIORead(constref Reg: TRegister): UInt32;
begin
  ReadWriteBarrier();
  case Reg.State of
    rsWriteOnly: Exit(0);
    rsReadOnly: Exit(Reg.ReadOnly);
    rsReadWrite: Exit(Reg.ReadWrite);
  end;
end;

procedure MMIOWait(const Count: SizeUInt);
var I: SizeUInt;
begin
  for I := 0 to Pred(Count) do 
    asm MOV W0, W0 end;
end;

function MBoxCall(const D: UInt8): Boolean;
var R: UInt32;
begin
  R := (UInt32(@MBox) and (not $F)) or (D and $F);
  while MMIORead(MBOX_STATUS) and MBOX_FULL <> 0 do MMIOWait(1);
  MMIOWrite(MBOX_WRITE, R);
  while True do begin
    while MMIORead(MBOX_STATUS) and MBOX_EMPTY <> 0 do MMIOWait(1);
    if MMIORead(MBOX_READ) = R then
      case MBox[1] of
        MBOX_RESPONSE: Exit(True);
        otherwise Exit(False);
      end;
  end;
end;

class function TFrameBuffer.Init: TFrameBuffer;
begin
  MBox[0] := 35 * 4;
  MBox[1] := MBOX_REQUEST;
  MBox[2] := $48003;  //set phy wh
  MBox[3] := 8;
  MBox[4] := 8;
  MBox[5] := 1920;
  MBox[6] := 1080;
  MBox[7] := $48004;  //set virt wh
  MBox[8] := 8;
  MBox[9] := 8;
  MBox[10] := 1920;
  MBox[11] := 1080;
  MBox[12] := $48009; //set virt offset
  MBox[13] := 8;
  MBox[14] := 8;
  MBox[15] := 0;
  MBox[16] := 0;
  MBox[17] := $48005; //set depth
  MBox[18] := 4;
  MBox[19] := 4;
  MBox[20] := 32;
  MBox[21] := $48006; //set pixel order
  MBox[22] := 4;
  MBox[23] := 4;
  MBox[24] := 1;
  MBox[25] := $40001; //get framebuffer, gets alignment on request
  MBox[26] := 8;
  MBox[27] := 8;
  MBox[28] := 4096;
  MBox[29] := 0;
  MBox[30] := $40008; //get pitch
  MBox[31] := 4;
  MBox[32] := 4;
  MBox[33] := 0;
  MBox[34] := MBOX_TAG_LAST;
  if MBoxCall(MBOX_CH_PROP) and (MBox[20] = 32) and (MBox[28] <> 0) then
  begin
    MBox[28] := MBox[28] and $3FFFFFFF;
    Result.Column := 0;
    Result.Row := 0;
    Result.Width := MBox[5];
    Result.Height := MBox[6];
    Result.Pitch := MBox[33];
    Result.Ptr := @MBox[28];
    InitState := True;
  end
  else InitState := False;
end;

procedure TFrameBuffer.Put(const C: UInt8);
var
  Color: UInt8;
  BytesPerLine, Offset, Line, Mask: UInt32;
  X, Y: SizeUInt;
  Idx: SizeUInt = 0;
begin
  BytesPerLine := (Font.Width + 7) div 8;
  Offset := (Row * Font.Height * Pitch) + (Column * (Font.Width + 1) * 4);
  case C of
    13:
    begin
      WriteBytes(#10);
      WriteBytes('READY:> ');
    end;
    10:
    begin
      Column := 0;
      Row += 1;
    end;
    8:
    begin
      if Column > 8 then Column -= 1;
      Offset := (Row * Font.Height * Pitch) + (Column * (Font.Width + 1) * 4);
      for Y := 0 to Pred(Font.Height) do begin
        Line := Offset;
        for X := 0 to Pred(Font.Width) do begin
          Ptr[Line] := 0;
          Ptr[Line + 1] := 0;
          Ptr[Line + 2] := 0;
          Line += 4;
        end;
        Offset += Pitch;
      end;
    end;
    otherwise
    begin
      if C < Font.NumGlyph then
        Idx += (Font.HeaderSize + (C * Font.BytesPerGlyph))
      else
        Idx += (Font.HeaderSize + (0 * Font.BytesPerGlyph));
      for Y := 0 to Pred(Font.Height) do begin
        Line := Offset;
        Mask := 1 shl (Font.Width - 1);
        for X := 0 to Pred(Font.Width) do begin
          if FontEmbed[Idx] and Mask = 0 then
            Color := 0
          else
            Color := 255;
          Ptr[Line] := Color;
          Ptr[Line + 1] := Color;
          Ptr[Line + 2] := Color;
          Mask := Mask shr 1;
          Line += 4;
        end;
        Idx += BytesPerLine;
        Offset += Pitch;
      end;
      Column += 1;
    end;
  end;
end;

class procedure TFrameBuffer.WriteBytes(const Data: AnsiString);
var C: AnsiChar;
begin
  if not InitState then GBuffer := Init();
  if InitState then for C in Data do GBuffer.Put(UInt8(C));   
end;

procedure Put(const C: UInt8);
begin
  GBuffer.Put(C);
end;

procedure WriteHandler(const Data: AnsiString);
begin
  GBuffer.WriteBytes(Data);
end;

procedure Write(const Data: AnsiString; const Args: array of const);
begin
  WriteHandler(Format(Data, Args));
end;

end.