{$I M_OPS.PAS}

Unit m_Output_Windows;

Interface

Uses
  Windows,
  m_Types;

Type
  TOutputWindows = Class
  Private
    ConOut      : THandle;
    Cursor      : TCoord;
  Public
    ScreenSize : Byte;
    Active   : Boolean;
    TextAttr : Byte;
    Buffer   : TConsoleScreenRec;
    LineBuf  : TConsoleLineRec;
    Window   : TSmallRect;

    Constructor Create (A: Boolean);
    Destructor  Destroy; Override;
    Procedure   ClearScreen; Virtual;
    Procedure   ClearScreenNoUpdate;
    Procedure   ScrollWindow; Virtual;
    Procedure   ClearEOL;
    Procedure   CursorXY (X, Y: Byte);
    Function    CursorX : Byte;
    Function    CursorY : Byte;
    Procedure   SetScreenSize (Mode: Byte);
    Procedure   SetWindowTitle (Title: String);
    Procedure   SetWindow (X1, Y1, X2, Y2: Byte; Home: Boolean);
    Procedure   GetScreenImage (X1, Y1, X2, Y2: Byte; Var Image: TConsoleImageRec);
    Procedure   PutScreenImage (Var Image: TConsoleImageRec);
    Procedure   LoadScreenImage (Var DataPtr; Len, Width, X, Y: Integer);
    Procedure   WriteXY (X, Y, A: Byte; Text: String);
    Procedure   WriteXYNoUpdate (X, Y, A: Byte; Text: String);
    Procedure   WriteXYPipe (X, Y, Attr, Pad: Integer; Text: String);
    Procedure   WriteLineRec (YPos: Integer; Line: TConsoleLineRec);
    Function    ReadCharXY (X, Y: Byte) : Char;
    Function    ReadAttrXY (X, Y: Byte) : Byte;
    Procedure   WriteChar (Ch: Char);
    Procedure   WriteLine (Str: String);
    Procedure   WriteStr (Str: String);
    Procedure   ShowBuffer;
    Procedure   BufFlush; // Linux compatibility only

//    Property ScreenSize : Byte Read FScreenSize;
//    Property TextAttr   : Byte Read FTextAttr    Write FTextAttr;
  End;

Implementation

Uses
  m_Strings;

Procedure TOutputWindows.WriteLineRec (YPos: Integer; Line: TConsoleLineRec);
Var
  BufSize  : TCoord;
  BufCoord : TCoord;
  Region   : TSmallRect;
Begin
  BufSize.X     := 80;
  BufSize.Y     := 1;
  BufCoord.X    := 0;
  BufCoord.Y    := 0;
  Region.Left   := 0;
  Region.Top    := YPos - 1;
  Region.Right  := 79;
  Region.Bottom := YPos - 1;

  WriteConsoleOutput(ConOut, @Line, BufSize, BufCoord, Region);
End;

Procedure TOutputWindows.SetWindow (X1, Y1, X2, Y2 : Byte; Home: Boolean);
Begin
  If (X1 > X2) or (X2 > 80) or
     (Y1 > Y2) or (Y2 > ScreenSize) Then Exit;

  Window.Left   := X1 - 1;
  Window.Top    := Y1 - 1;
  Window.Right  := X2 - 1;
  Window.Bottom := Y2 - 1;

  If Home Then CursorXY (X1, Y1) Else CursorXY (Cursor.X + 1, Cursor.Y + 1);
End;

Constructor TOutputWindows.Create (A: Boolean);
Var
  ScreenMode : TConsoleScreenBufferInfo;
  CursorInfo : TConsoleCursorInfo;
Begin
  Inherited Create;

  Active := A;
  ConOut := GetStdHandle(STD_OUTPUT_HANDLE);

  GetConsoleScreenBufferInfo(ConOut, ScreenMode);

  Case ScreenMode.dwSize.Y of
    25 : ScreenSize := 25;
    50 : ScreenSize := 50;
  Else
    SetScreenSize(25);
    ScreenSize := 25;
  End;

  CursorInfo.bVisible := True;
  CursorInfo.dwSize   := 15;

  SetConsoleCursorInfo(ConOut, CursorInfo);

  Window.Top    := 0;
  Window.Left   := 0;
  Window.Right  := 79;
  Window.Bottom := ScreenSize - 1;

  TextAttr := 7;

  ClearScreen;
End;

Destructor TOutputWindows.Destroy;
Begin
  Inherited Destroy;
End;

Procedure TOutputWindows.SetScreenSize (Mode: Byte);
Var
  Size : TCoord;
Begin
  If (Mode = ScreenSize) Or Not (Mode in [25, 50]) Then Exit;

  Size.X := 80;
  Size.Y := Mode;

  Window.Top    := 0;
  Window.Left   := 0;
  Window.Right  := Size.X - 1;
  Window.Bottom := Size.Y - 1;

  SetConsoleScreenBufferSize (ConOut, Size);
  SetConsoleWindowInfo       (ConOut, True, Window);
  SetConsoleScreenBufferSize (ConOut, Size);

  ScreenSize := Mode;
End;

Procedure TOutputWindows.CursorXY (X, Y: Byte);
Begin
  // don't move to x/y coordinate outside of window

  Cursor.X := X - 1;
  Cursor.Y := Y - 1;

  If Cursor.X < Window.Left   Then Cursor.X := Window.Left Else
  If Cursor.X > Window.Right  Then Cursor.X := Window.Right;
  If Cursor.Y < Window.Top    Then Cursor.Y := Window.Top Else
  If Cursor.Y > Window.Bottom Then Cursor.Y := Window.Bottom;

  If Active Then
    SetConsoleCursorPosition(ConOut, Cursor);
End;

Procedure TOutputWindows.ClearEOL;
Var
  Buf      : Array[1..80] of TCharInfo;
  Count    : Byte;
  BufSize  : TCoord;
  BufCoord : TCoord;
  Region   : TSmallRect;
Begin
  Count := 0;

  While Count <= Window.Right - Cursor.X Do Begin
    Inc (Count);
    Buf[Count].Attributes  := TextAttr;
    Buf[Count].UnicodeChar := ' ';
  End;

  Move(Buf[1], Buffer[Cursor.Y + 1][Cursor.X + 1], Count);

  If Active Then Begin
    BufSize.X     := Count;
    BufSize.Y     := 1;
    BufCoord.X    := 0;
    BufCoord.Y    := 0;
    Region.Left   := Cursor.X;
    Region.Top    := Cursor.Y;
    Region.Right  := Cursor.X + Count - 1;
    Region.Bottom := Cursor.Y;

    WriteConsoleOutput(ConOut, @Buf, BufSize, BufCoord, Region);
  End;
End;

Procedure TOutputWindows.ClearScreenNoUpdate;
Var
  Res   : ULong;
  Count : Byte;
  Size  : Byte;
  Cell  : TCharInfo;
Begin
  Size             := Window.Right - Window.Left + 1;
  Cursor.X         := Window.Left;
  Cell.Attributes  := TextAttr;
  Cell.UnicodeChar := ' ';

  For Count := Window.Top To Window.Bottom Do Begin
    Cursor.Y := Count;

    FillConsoleOutputAttribute(ConOut, Cell.Attributes, Size, Cursor, Res);
    FillConsoleOutputCharacter(ConOut, ' ', Size, Cursor, Res);
  End;
End;

Procedure TOutputWindows.ClearScreen;
Var
  Res   : ULong;
  Count : Byte;
  Size  : Byte;
  Cell  : TCharInfo;
Begin
  Size             := Window.Right - Window.Left + 1;
  Cursor.X         := Window.Left;
  Cell.Attributes  := TextAttr;
  Cell.UnicodeChar := ' ';

  If Active Then Begin
    For Count := Window.Top To Window.Bottom Do Begin
      Cursor.Y := Count;

      FillConsoleOutputAttribute(ConOut, Cell.Attributes, Size, Cursor, Res);
      FillConsoleOutputCharacter(ConOut, ' ', Size, Cursor, Res);
    End;
  End;

  FillChar (Buffer, SizeOf(Buffer), 0);

  CursorXY (Window.Left + 1, Window.Top + 1);
End;

Procedure TOutputWindows.SetWindowTitle (Title: String);
Begin
  Title := Title + #0;
  SetConsoleTitle(@Title[1]);
End;

Procedure TOutputWindows.WriteXY (X, Y, A: Byte; Text: String);
Var
  Buf      : Array[1..80] of TCharInfo;
  BufSize  : TCoord;
  BufCoord : TCoord;
  Region   : TSmallRect;
  Count    : Byte;
Begin
  Count := 1;

  While Count <= Length(Text) Do Begin
    Buf[Count].Attributes  := A;
    Buf[Count].UnicodeChar := Text[Count];
    Inc (Count);
  End;

  // add to screen buffer
  Move (Buf[1], Buffer[Y][X], (Count - 1) * SizeOf(TCharInfo));

  If Active Then Begin
    BufSize.X     := Count - 1;
    BufSize.Y     := 1;
    BufCoord.X    := 0;
    BufCoord.Y    := 0;
    Region.Left   := X - 1;
    Region.Top    := Y - 1;
    Region.Right  := X + Count - 1;
    Region.Bottom := Y - 1;

    If Region.Right > 79 Then Region.Right := 79;

    WriteConsoleOutput(ConOut, @Buf, BufSize, BufCoord, Region);
  End;
End;

Procedure TOutputWindows.WriteXYNoUpdate (X, Y, A: Byte; Text: String);
Var
  Buf      : Array[1..80] of TCharInfo;
  BufSize  : TCoord;
  BufCoord : TCoord;
  Region   : TSmallRect;
  Count    : Byte;
Begin
  Count := 1;

  While Count <= Length(Text) Do Begin
    Buf[Count].Attributes  := A;
    Buf[Count].UnicodeChar := Text[Count];
    Inc (Count);
  End;

  BufSize.X     := Count - 1;
  BufSize.Y     := 1;
  BufCoord.X    := 0;
  BufCoord.Y    := 0;
  Region.Left   := X - 1;
  Region.Top    := Y - 1;
  Region.Right  := X + Count - 1;
  Region.Bottom := Y - 1;

  If Region.Right > 79 Then Region.Right := 79;

  WriteConsoleOutput(ConOut, @Buf, BufSize, BufCoord, Region);
End;

Procedure TOutputWindows.WriteXYPipe (X, Y, Attr, Pad: Integer; Text: String);
Var
  Buf      : Array[1..80] of TCharInfo;
  BufPos   : Byte;
  Count    : Byte;
  Code     : String[2];
  CodeNum  : Byte;
  BufSize  : TCoord;
  BufCoord : TCoord;
  Region   : TSmallRect;

  Procedure AddChar;
  Begin
    Inc (BufPos);

    Buf[BufPos].Attributes  := Attr;
    Buf[BufPos].UnicodeChar := Text[Count];
  End;

Begin
  FillChar(Buf, SizeOf(Buf), #0);

  Count  := 1;
  BufPos := 0;

  While Count <= Length(Text) Do Begin
    If Text[Count] = '|' Then Begin
      Code    := Copy(Text, Count + 1, 2);
      CodeNum := strS2I(Code);

      If (Code = '00') or ((CodeNum > 0) and (CodeNum < 24) and (Code[1] <> '$') and (Code[1] <> '&')) Then Begin
        Inc (Count, 2);
        If CodeNum in [00..15] Then
          Attr := CodeNum + ((Attr SHR 4) AND 7) * 16
        Else
          Attr := (Attr AND $F) + (CodeNum - 16) * 16;
      End Else
        AddChar;
    End Else
      AddChar;

    If BufPos = Pad Then Break;

    Inc (Count);
  End;

  Text[1] := #32;
  Count   := 1;

  While BufPos < Pad Do AddChar;

  BufSize.X     := Pad;
  BufSize.Y     := 1;
  BufCoord.X    := 0;
  BufCoord.Y    := 0;
  Region.Left   := X - 1;
  Region.Top    := Y - 1;
  Region.Right  := X + Pad;
  Region.Bottom := Y - 1;

  If Region.Right > 79 Then Region.Right := 79;

  Move (Buf[1], Buffer[Y][X], BufSize.X * SizeOf(TCharInfo));

  If Active Then
    WriteConsoleOutput(ConOut, @Buf, BufSize, BufCoord, Region);
End;

Function TOutputWindows.CursorX : Byte;
Begin
  CursorX := Cursor.X + 1;
End;

Function TOutputWindows.CursorY : Byte;
Begin
  CursorY := Cursor.Y + 1;
End;

Procedure TOutputWindows.WriteChar (Ch: Char);
Var
  BufferSize,
  BufferCoord : TCoord;
  WriteRegion : TSmallRect;
  OneCell     : TCharInfo;
Begin
  Case Ch of
    #08 : If Cursor.X > Window.Left Then Begin
            Dec(Cursor.X);
            If Active Then SetConsoleCursorPosition(ConOut, Cursor);
          End;
    #10 : Begin
            If Cursor.Y = Window.Bottom Then
              ScrollWindow
            Else Begin
              Inc (Cursor.Y);
              Cursor.X := Window.Left;
            End;

            If Active Then SetConsoleCursorPosition(ConOut, Cursor);
          End;
    #13 : Cursor.X := Window.Left;
  Else
    If Active Then Begin
      OneCell.UnicodeChar := Ch;
      OneCell.Attributes  := TextAttr;

      BufferSize.X  := 1;
      BufferSize.Y  := 1;
      BufferCoord.X := 0;
      BufferCoord.Y := 0;

      WriteRegion.Left   := Cursor.X;
      WriteRegion.Top    := Cursor.Y;
      WriteRegion.Right  := Cursor.X;
      WriteRegion.Bottom := Cursor.Y;

      WriteConsoleOutput (ConOut, @OneCell, BufferSize, BufferCoord, WriteRegion);
    End;

    Buffer[Cursor.Y + 1][Cursor.X + 1].UnicodeChar := Ch;
    Buffer[Cursor.Y + 1][Cursor.X + 1].Attributes  := TextAttr;

    If Cursor.X < Window.Right Then
      Inc (Cursor.X)
    Else Begin
      If (Cursor.X = Window.Right) And (Cursor.Y = Window.Bottom - 1) Then Begin
        Inc (Cursor.X);
        Exit;
      End;

      Cursor.X := Window.Left;

      If Cursor.Y = Window.Bottom Then
        ScrollWindow
      Else
        Inc (Cursor.Y);
    End;

    If Active Then SetConsoleCursorPosition(ConOut, Cursor);
  End;
End;

Procedure TOutputWindows.WriteLine (Str: String);
Var
  Count : Byte;
Begin
  Str := Str + #13#10;

  For Count := 1 to Length(Str) Do WriteChar(Str[Count]);
End;

Procedure TOutputWindows.WriteStr (Str: String);
Var
  Count : Byte;
Begin
  For Count := 1 to Length(Str) Do WriteChar(Str[Count]);
End;

Procedure TOutputWindows.ScrollWindow;
Var
  ClipRect,
  ScrollRect : TSmallRect;
  DestCoord  : TCoord;
  Fill       : TCharInfo;
Begin
  Fill.UnicodeChar := ' ';
//  Fill.Attributes  := TextAttr;
  Fill.Attributes := 7;

  ScrollRect.Left   := Window.Left;
  ScrollRect.Top    := Window.Top;
  ScrollRect.Right  := Window.Right;
  ScrollRect.Bottom := Window.Bottom;

  // might not need cliprect... might be able to pass scrollrect twice

  ClipRect := ScrollRect;

  DestCoord.X := Window.Left;
  DestCoord.Y := Window.Top - 1;

  If Active Then
    ScrollConsoleScreenBuffer(ConOut, ScrollRect, ClipRect, DestCoord, PCharInfo(@Fill)^);

  Move (Buffer[2][1], Buffer[1][1], SizeOf(TConsoleLineRec) * 49);
  FillChar(Buffer[Window.Bottom + 1][1], SizeOf(TConsoleLineRec), #0);
End;

Procedure TOutputWindows.GetScreenImage (X1, Y1, X2, Y2: Byte; Var Image: TConsoleImageRec);
Var
  CountY : Byte;
  CountX : Byte;
  BufPos : Integer;
  NewBuf : Array[1..SizeOf(TConsoleScreenRec) DIV 2] of Word Absolute Image.Data;
Begin
  Image.X1      := X1;
  Image.X2      := X2;
  Image.Y1      := Y1;
  Image.Y2      := Y2;
  Image.CursorX := CursorX;
  Image.CursorY := CursorY;
  Image.CursorA := TextAttr;

  BufPos := 1;

  For CountY := Y1 to Y2 Do Begin
    For CountX := X1 to X2 Do Begin
      NewBuf[BufPos]   := Word(Buffer[CountY][CountX].UnicodeChar);
      NewBuf[BufPos+1] := Buffer[CountY][CountX].Attributes;
      Inc (BufPos, 2);
    End;
  End;
End;

(*
Procedure TOutputWindows.GetScreenImage (X1, Y1, X2, Y2: Byte; Var Image: TConsoleImageRec);
Var
  BufSize  : TCoord;
  BufCoord : TCoord;
  Region   : TSmallRect;
//  x,y,cx,cy:byte;
Begin
  BufSize.X     := X2 - X1 + 1;
  BufSize.Y     := Y2 - Y1 + 1;
  BufCoord.X    := 0;
  BufCoord.Y    := 0;
  Region.Left   := X1 - 1;
  Region.Top    := Y1 - 1;
  Region.Right  := X2 - 1;
  Region.Bottom := Y2 - 1;
  Image.X1      := X1;
  Image.X2      := X2;
  Image.Y1      := Y1;
  Image.Y2      := Y2;
  Image.CursorX := CursorX;
  Image.CursorY := CursorY;
  Image.CursorA := TextAttr;

  If Active Then
    ReadConsoleOutput (ConOut, @Image.Data[1][1], BufSize, BufCoord, Region)
  Else
    Image.Data := Buffer;
End;
*)

Procedure TOutputWindows.ShowBuffer;
Var
  BufSize  : TCoord;
  BufCoord : TCoord;
  Region   : TSmallRect;
Begin
  BufSize.X     := 80;
  BufSize.Y     := ScreenSize;
  BufCoord.X    := 0;
  BufCoord.Y    := 0;
  Region.Left   := 0;
  Region.Top    := 0;
  Region.Right  := 79;
  Region.Bottom := ScreenSize - 1;

  WriteConsoleOutput (ConOut, @Buffer[1][1], BufSize, BufCoord, Region);

  CursorXY (Cursor.X + 1, Cursor.Y + 1);
End;

Procedure TOutputWindows.PutScreenImage (Var Image: TConsoleImageRec);
Var
  BufSize  : TCoord;
  BufCoord : TCoord;
  Region   : TSmallRect;

  CountX  : Byte;
  CountY  : Byte;
  BufPos  : Integer;
  TempBuf : Array[1..SizeOf(TConsoleScreenRec) DIV 2] of LongInt Absolute Image.Data;
Begin
  BufSize.X     := Image.X2 - Image.X1 + 1;
  BufSize.Y     := Image.Y2 - Image.Y1 + 1;
  BufCoord.X    := 0;
  BufCoord.Y    := 0;
  Region.Left   := Image.X1 - 1;
  Region.Top    := Image.Y1 - 1;
  Region.Right  := Image.X2 - 1;
  Region.Bottom := Image.Y2 - 1;

  WriteConsoleOutput (ConOut, @Image.Data[1][1], BufSize, BufCoord, Region);

  BufPos := 1;

  For CountY := Image.Y1 to Image.Y2 Do
    For CountX := Image.X1 to Image.X2 Do Begin
      Buffer[CountY][CountX] := TCharInfo(TempBuf[BufPos]);
      Inc(BufPos);
    End;

  CursorXY (Image.CursorX, Image.CursorY);

  TextAttr := Image.CursorA;
End;

Procedure TOutputWindows.LoadScreenImage (Var DataPtr; Len, Width, X, Y: Integer);
Var
  Image  : TConsoleImageRec;
  Data   : Array[1..8000] of Byte Absolute DataPtr;
  PosX   : Word;
  PosY   : Byte;
  Attrib : Byte;
  Count  : Word;
  A      : Byte;
  B      : Byte;
  C      : Byte;
Begin
  PosX   := 1;
  PosY   := 1;
  Attrib := 7;
  Count  := 1;

  FillChar(Image.Data, SizeOf(Image.Data), #0);

  While (Count <= Len) Do Begin
    Case Data[Count] of
      00..
      15  : Attrib := Data[Count] + ((Attrib SHR 4) and 7) * 16;
      16..
      23  : Attrib := (Attrib And $F) + (Data[Count] - 16) * 16;
      24  : Begin
              Inc (PosY);
              PosX := 1;
            End;
      25  : Begin
              Inc (Count);
              For A := 0 to Data[Count] Do Begin
                Image.Data[PosY][PosX].UnicodeChar := ' ';
                Image.Data[PosY][PosX].Attributes  := Attrib;

                Inc (PosX);
              End;
            End;
      26  : Begin
              A := Data[Count + 1];
              B := Data[Count + 2];

              Inc (Count, 2);

              For C := 0 to A Do Begin
                Image.Data[PosY][PosX].UnicodeChar := Char(B);
                Image.data[PosY][PosX].Attributes  := Attrib;

                Inc (PosX);
              End;
            End;
      27..
      31  : ;
    Else
      Image.Data[PosY][PosX].UnicodeChar := Char(Data[Count]);
      Image.Data[PosY][PosX].Attributes  := Attrib;

      Inc (PosX);
    End;

    Inc (Count);
  End;

  Image.X1      := X;
  Image.X2      := Width;
  Image.Y1      := Y;
  Image.Y2      := PosY;
  Image.CursorX := PosX;
  Image.CursorY := PosY;
  Image.CursorA := Attrib;

  PutScreenImage(Image);
End;

(*
Procedure TOutputWindows.LoadScreenImage (Var DataPtr; Len, Width, X, Y: Integer);
Var
  Screen   : TConsoleScreenRec;
  Data     : Array[1..8000] of Byte Absolute DataPtr;
  PosX     : Word;
  PosY     : Byte;
  Attrib   : Byte;
  Count    : Word;
  A        : Byte;
  B        : Byte;
  C        : Byte;
  BufSize  : TCoord;
  BufCoord : TCoord;
  Region   : TSmallRect;
Begin
  PosX   := 1;
  PosY   := 1;
  Attrib := 7;
  Count  := 1;

  FillChar(Screen, SizeOf(Screen), #0);

  While (Count <= Len) Do Begin
    Case Data[Count] of
      00..
      15  : Attrib := Data[Count] + ((Attrib SHR 4) and 7) * 16;
      16..
      23  : Attrib := (Attrib And $F) + (Data[Count] - 16) * 16;
      24  : Begin
              Inc (PosY);
              PosX := 1;
            End;
      25  : Begin
              Inc (Count);
              For A := 0 to Data[Count] Do Begin
                Screen[PosY][PosX].UnicodeChar := ' ';
                Screen[PosY][PosX].Attributes  := Attrib;

                Inc (PosX);
              End;
            End;
      26  : Begin
              A := Data[Count + 1];
              B := Data[Count + 2];

              Inc (Count, 2);

              For C := 0 to A Do Begin
                Screen[PosY][PosX].UnicodeChar := Char(B);
                Screen[PosY][PosX].Attributes  := Attrib;

                Inc (PosX);
              End;
            End;
      27..
      31  : ;
    Else
      Screen[PosY][PosX].UnicodeChar := Char(Data[Count]);
      Screen[PosY][PosX].Attributes  := Attrib;

      Inc (PosX);
    End;

    Inc (Count);
  End;

  BufSize.Y     := PosY - (Y - 1);
  BufSize.X     := Width;
  BufCoord.X    := 0;
  BufCoord.Y    := 0;
  Region.Left   := X - 1;
  Region.Top    := Y - 1;
  Region.Right  := Width - 1;
  Region.Bottom := PosY - 1;

  WriteConsoleOutput (ConOut, @Screen[1][1], BufSize, BufCoord, Region);

  CursorXY(PosX, PosY);
End;
*)

Function TOutputWindows.ReadCharXY (X, Y: Byte) : Char;
Begin
  Result := Buffer[Y][X].UnicodeChar;
End;

Function TOutputWindows.ReadAttrXY (X, Y: Byte) : Byte;
Begin
  Result := Buffer[Y][X].Attributes;
End;

Procedure TOutputWindows.BufFlush;
Begin
End;

End.