' Copyright (c) 2021 Thomas Hugo Williams
' For Colour Maximite 2, MMBasic 5.06

Option Explicit On
Option Default None

Const chd.BLACK%   = 0
Const chd.RED%     = 1
Const chd.GREEN%   = 2
Const chd.YELLOW%  = 3
Const chd.BLUE%    = 4
Const chd.MAGENTA% = 5
Const chd.CYAN%    = 6
Const chd.WHITE%   = 7

Dim chd.vt$(255)  ' map of attribute values to VT100 control codes
Dim chd.fg%(255)  ' map of attribute values to VGA foreground colours
Dim chd.bg%(255)  ' map of attribute values to VGA background colours
Dim chd.data%(1)  ' large block of memory for storing window state.
                 ' Not properly sized until init() is called
Dim chd.ptr%(1)   ' pointers into chd.data%() such that chd.ptr%(i) is the
                 ' memory address where the data for window 'i' starts.
                 ' Not properly sized until init() is called
Dim chd.max_num%  ' max number of windows allowed
Dim chd.num%      ' current number of windows created

' For the currently selected window:
Dim chd.id% = -1 ' id
Dim chd.a%       ' x-coordinate of left hand side
Dim chd.b%       ' y-coordinate of top
Dim chd.w%       ' width
Dim chd.h%       ' height
Dim chd.x%       ' x cursor-position
Dim chd.y%       ' y cursor-position
Dim chd.at%      ' attributes to use for printing
Dim chd.pc%      ' pointer to the character data
Dim chd.pa%      ' pointer to the attribute data

' Initialises the 'chardisp' library.
'
' @param  max_num%  the maximum number of windows to support.
' @param  mem_sz%   number of bytes of memory to allocate for window data.
'                   Each window requires 7 + 2 * (width * height) bytes.
Sub chd.init(max_num%, mem_sz%)
 If max_num% < 1 Or max_num% > 10 Then Error "invalid max number of windows: " + Str$(max_num%)
 If mem_sz% < 100 Then Error "invalid memory size: " + Str$(mem_sz%)

 ' Allocate data buffer.
 Erase chd.data%()
 Dim chd.data%(mem_sz% - 1)

 ' Allocate array of pointers (one for each window) into the fata buffer.
 ' Because MMBasic can't have 1 element arrays we always allocate space for at least 2 windows.
 Erase chd.ptr%()
 Dim chd.ptr%(Choice(max_num% = 1, 1, max_num% - 1))

 chd.max_num% = max_num%

 Local i%, vt$, tmp%
 For i% = 0 To 255
   ' Clear attributes
   vt$ = Chr$(27) + "[0m"

   ' Foreground (with/out bold)
   Cat vt$, Chr$(27) + "[" + Choice(i% And &b01000000, "1;3", "3") + Str$(i% And &b00000111) + "m"

   ' Background
   Cat vt$, Chr$(27) + "[4" + Str$((i% And &b00111000) >> 3) + "m"

   ' Reverse video
   If i% And &b10000000 Then Cat vt$, Chr$(27) + "[7m"

   chd.vt$(i%) = vt$
 Next

 For i% = 0 To 255
   ' Foreground
   Select Case i% And &b00000111
     Case chd.BLACK%   : chd.fg%(i%) = RGB(Black)
     Case chd.RED%     : chd.fg%(i%) = RGB(Red)
     Case chd.GREEN%   : chd.fg%(i%) = RGB(Green)
     Case chd.YELLOW%  : chd.fg%(i%) = RGB(Yellow)
     Case chd.BLUE%    : chd.fg%(i%) = RGB(Blue)
     Case chd.MAGENTA% : chd.fg%(i%) = RGB(Magenta)
     Case chd.CYAN%    : chd.fg%(i%) = RGB(Cyan)
     Case chd.WHITE%   : chd.fg%(i%) = RGB(White)
   End Select

   ' TODO: Bold/Bright text

   ' Background
   Select Case (i% And &b00111000) >> 3
     Case chd.BLACK%   : chd.bg%(i%) = RGB(Black)
     Case chd.RED%     : chd.bg%(i%) = RGB(Red)
     Case chd.GREEN%   : chd.bg%(i%) = RGB(Green)
     Case chd.YELLOW%  : chd.bg%(i%) = RGB(Yellow)
     Case chd.BLUE%    : chd.bg%(i%) = RGB(Blue)
     Case chd.MAGENTA% : chd.bg%(i%) = RGB(Magenta)
     Case chd.CYAN%    : chd.bg%(i%) = RGB(Cyan)
     Case chd.WHITE%   : chd.bg%(i%) = RGB(White)
   End Select

   ' Reverse video
   If i% And &b10000000 Then
     tmp% = chd.bg%(i%)
     chd.bg%(i%) = chd.fg%(i%)
     chd.fg%(i%) = tmp%
   EndIf
 Next

End Sub

Function chd.new_win%(x%, y%, w%, h%)
 If chd.num% > Bound(chd.ptr%(), 1) Then Error "maximum number of windows reached: " + Str$(chd.num%)

 Local ptr%

 ' Store pointer into the data buffer for the new window.
 If chd.num% = 0 Then
   ptr% = Peek(VarAddr chd.data%())
 Else
   ptr% = chd.ptr%(chd.num% - 1)
   ptr% = ptr% + 7 + Peek(Byte ptr% + 2) * Peek(Byte ptr% + 3) * 2
 EndIf
 chd.ptr%(chd.num%) = ptr%

 Local reqd% = ptr% + 7 + w% * h% * 2 - chd.ptr%(0)
 Local alloc% = Bound(chd.data%(), 1) + 1
 If reqd% > alloc% Then
   Error "out of chardisp memory: " + Str$(alloc%) + " bytes allocated, " + Str$(reqd%) + " required"
 EndIf

 ' Note we add 1 to window x & y positions to account for VT100 using (1, 1) as origin.
 Poke Byte ptr% + 0, x% + 1                          ' window x-position
 Poke Byte ptr% + 1, y% + 1                          ' window y-position
 Poke Byte ptr% + 2, w%                              ' window width
 Poke Byte ptr% + 3, h%                              ' window height
 Poke Byte ptr% + 4, 0                               ' x-cursor position
 Poke Byte ptr% + 5, 0                               ' y-cursor position
 Poke Byte ptr% + 6, chd.WHITE%                      ' current attribute value
 Memory Set ptr% + 7, 32, w% * h%                    ' character buffer
 Memory Set ptr% + 7 + w% * h%, chd.WHITE%, w% * h%  ' attribute buffer

 chd.new_win% = chd.num%
 Inc chd.num%
End Function

Sub chd.switch(id%)
 Local ptr%

 If chd.id% > -1 Then
   ptr% = chd.ptr%(chd.id%)
   Poke Byte ptr% + 4, chd.x%
   Poke Byte ptr% + 5, chd.y%
   Poke Byte ptr% + 6, chd.at%
 EndIf

 chd.id% = id%
 ptr%    = chd.ptr%(chd.id%)
 chd.a%  = Peek(Byte ptr% + 0)
 chd.b%  = Peek(Byte ptr% + 1)
 chd.w%  = Peek(Byte ptr% + 2)
 chd.h%  = Peek(Byte ptr% + 3)
 chd.x%  = Peek(Byte ptr% + 4)
 chd.y%  = Peek(Byte ptr% + 5)
 chd.at% = Peek(Byte ptr% + 6)
 chd.pc% = ptr% + 7
 chd.pa% = chd.pc% + chd.w% * chd.h%
End Sub

Sub chd.foreground(col%)
 chd.at% = (chd.at% And &b11111000) Or col%
End Sub

Sub chd.background(col%)
 chd.at% = (chd.at% And &b11000111) Or (col% << 3)
End Sub

Sub chd.bold(z%)
 chd.at% = (chd.at% And &b10111111) Or (z% << 6)
End Sub

Sub chd.inverse(z%)
 chd.at% = (chd.at% And &b01111111) Or (z% << 7)
End Sub

Sub chd.print(s$)
 chd.print_at(chd.x%, chd.y%, s$)
End Sub

Function sys.int_bounds_err$(var$, value%, lb%, ub%)
 sys.int_bounds_err$ = "'" + var$ + "' value " + Str$(value%) + " out of bounds (" + Str$(lb%)
 Cat sys.int_bounds_err$, " ... " + Str$(ub%) + ")"
End Function

' Print s$ at (x%, y%) in the current window.
' Leaves chd.x% and chd.y% one beyond the last printed char position.
Sub chd.print_at(x%, y%, s$)

 If x% < 0 Or x% >= chd.w% Then Error sys.int_bounds_err$("x", x%, 0, chd.w% - 1)

 ' If y% = chd.h% then the window will immediately scroll before printing the first character.
 If y% < 0 Or y% > chd.h% Then Error sys.int_bounds_err$("y", y%, 0, chd.h%)

 chd.x% = x%
 chd.y% = y%
 Local is% = 1                         ' current index into s$
 Local ls% = Len(s$)                   ' length of s$
 Local ps% = Peek(VarAddr s$)          ' pointer to s$
 Local nc% = Min(chd.w% - chd.x%, ls%) ' number of characters to print on the current line
 Local of%                             ' offset for writing to chd.data%()
 Local fw% = Mm.Info(FontWidth)
 Local fh% = Mm.Info(FontHeight)
 Local at% = chd.at%
 Local fg% = chd.fg%(at%)
 Local bg% = chd.bg%(at%)
 Local ax%
 Local by%
 Local seg$
 Local vt$ = chd.vt$(at%)

 If nc% = 0 Then Exit Sub

 Do
   If chd.y% = chd.h% Then
     chd.scroll_up(1)
     Inc chd.y%, -1
   EndIf

   ' Write text and attributes to chd.data%()
   of% = chd.y% * chd.w% + chd.x%
   Memory Copy ps% + is%, chd.pc% + of%, nc%
   Memory Set chd.pa% + of%, at%, nc%

   seg$ = Mid$(s$, is%, nc%)
   ax% = chd.a% + chd.x%
   by% = chd.b% + chd.y%

   ' Update serial console:
   Print vt$ Chr$(27) "[" Str$(by%) ";" Str$(ax%) "H" seg$;

   ' Update VGA display:
   Text (ax% - 1) * fw%, (by% - 1) * fh%, seg$,,,, fg%, bg%

   Inc is%, nc%
   Inc chd.x%, nc%

   ' Otherwise move to the next line of text.
   If chd.x% = chd.w% Then
     chd.x% = 0
     Inc chd.y%
     nc% = Min(chd.w% - chd.x%, ls% - is% + 1)
   EndIf
 Loop While is% <= ls%

End Sub

Sub chd.scroll_down(redraw%)
 Local pa% = chd.pa% + chd.w% * (chd.h% - 1)
 Local pc% = chd.pc% + chd.w% * (chd.h% - 1)
 Local y%

 Do While pa% > chd.pa%
   ' Copy attribute and character data down one line.
   Memory Copy pa% - chd.w%, pa%, chd.w%
   Memory Copy pc% - chd.w%, pc%, chd.w%
   Inc pa%, -chd.w%
   Inc pc%, -chd.w%
 Loop

 ' Clear the first line using the current attributes.
 Memory Set pa%, chd.at%, chd.w%
 Memory Set pc%, 32, chd.w%

 If redraw% Then chd.redraw()
End Sub

Sub chd.scroll_up(redraw%)
 Local pa% = chd.pa%
 Local pc% = chd.pc%
 Local y%

 For y% = 1 To chd.h% - 1
   ' Copy attribute and character data from line y + 1 to line y.
   Memory Copy pa% + chd.w%, pa%, chd.w%
   Memory Copy pc% + chd.w%, pc%, chd.w%
   Inc pa%, chd.w%
   Inc pc%, chd.w%
 Next

 ' Clear the last line using the current attributes.
 Memory Set pa%, chd.at%, chd.w%
 Memory Set pc%, 32, chd.w%

 If redraw% Then chd.redraw()
End Sub

Sub chd.redraw()
 Local at% = -1, b%, ch$, x%, y%
 Local pa% = chd.pa%
 Local pc% = chd.pc%
 Local fw% = Mm.Info(FontWidth)
 Local fh% = Mm.Info(FontHeight)

 For y% = 0 To chd.h% - 1
   Print Chr$(27) "[" Str$(chd.b% + y%) ";" Str$(chd.a%) "H";
   For x% = 0 To chd.w% - 1
     b% = Peek(Byte pa% + x%)
     ch$ = Chr$(Peek(Byte pc% + x%))

     ' Update serial console:
     If at% <> b% Then at% = b% : Print chd.vt$(at%);
     Print ch$;

     ' Update VGA display:
     Text (chd.a% + x% - 1)*fw%, (chd.b% + y% - 1)*fh%, ch$,,,, chd.fg%(at%), chd.bg%(at%)
   Next x%
   Inc pa%, chd.w%
   Inc pc%, chd.w%
 Next y%
End Sub

Sub chd.cls()
 Memory Set chd.pc%, 32, chd.w% * chd.h%
 Memory Set chd.pa%, chd.at%, chd.w% * chd.h%
 chd.redraw()
End Sub

Sub chd.box(x%, y%, w%, h%)
 Local i%
 Local pc% = chd.pc%
 Local s$
 Local ad%

 ' Top
 Poke Var s$, 0, w%
 ad% = pc% + chd.w% * y% + x%
 Poke Var s$, 1, chd.box_or%(&hC9, Peek(Byte ad%))
 For i% = 2 To w% - 1
   Poke Var s$, i%, chd.box_or%(&hCD, Peek(Byte ad% + i% - 1))
 Next
 Poke Var s$, w%, chd.box_or%(&hBB, Peek(Byte ad% + w% - 1))
 chd.print_at(x%, y%, s$)

 ' Sides - note using print_at() for single characters involves unnecessary overhead
 For i% = y% + 1 To y% + h% - 2
   Inc ad%, chd.w%
   chd.print_at(x%, i%, Chr$(chd.box_or%(&hBA, Peek(Byte ad%))))
   chd.print_at(x% + w% - 1, i%, Chr$(chd.box_or%(&hBA, Peek(Byte ad% + w% - 1))))
 Next

 ' Bottom
 Inc ad%, chd.w%
 Poke Var s$, 1, chd.box_or%(&hC8, Peek(Byte ad%))
 For i% = 2 To w% - 1
   Poke Var s$, i%, chd.box_or%(&hCD, Peek(Byte ad% + i% - 1))
 Next
 Poke Var s$, w%, chd.box_or%(&hBC, Peek(Byte ad% + w% - 1))
 chd.print_at(x%, y% + h% - 1, s$)
End Sub

' Combines a new character 'ch%' and an existing character 'ex%'.
' If they are both 'box-drawing' characters then returns an appropriate junction character,
' otherwise returns the new character 'ch%'.
'
' @param ch%  new 'box-drawing' character.
' @param ex%  existing character.
' @return     junction character, or 'ch%'.
Function chd.box_or%(ch%, ex%)

 Static a%(255), b%(15)
 If a%(&hB9) = 0 Then
   a%(&hB9) = &b1101
   a%(&hBA) = &b0101
   a%(&hBB) = &b1100
   a%(&hBC) = &b1001
   a%(&hC8) = &b0011
   a%(&hC9) = &b0110
   a%(&hCA) = &b1011
   a%(&hCB) = &b1110
   a%(&hCC) = &b0111
   a%(&hCD) = &b1010
   a%(&hCE) = &b1111

   b%(&b1101) = &hB9
   b%(&b0101) = &hBA
   b%(&b1100) = &hBB
   b%(&b1001) = &hBC
   b%(&b0011) = &hC8
   b%(&b0110) = &hC9
   b%(&b1011) = &hCA
   b%(&b1110) = &hCB
   b%(&b0111) = &hCC
   b%(&b1010) = &hCD
   b%(&b1111) = &hCE
 EndIf

 Local tmp% = a%(ch%)
 chd.box_or% = Choice(tmp% = 0, ch%, b%(tmp% Or a%(ex%)))
End Function

Cls
Option Console Serial
Print Chr$(27) "[?25l"; ' hide cursor

chd.init(5, 13000)
Dim win0% = chd.new_win%( 0,  0, 100, 50)
Dim win1% = chd.new_win%( 3,  3,  10, 40)
Dim win2% = chd.new_win%(19, 16,  33, 10)
Dim win3% = chd.new_win%(61, 11,  10, 28)
Dim win4% = chd.new_win%(45, 28,  10, 20)

chd.switch(win0%)
chd.box( 0,  0, 100, 50)
chd.box( 2,  2,  12, 42)
chd.box(18, 15,  35, 12)
chd.box(60, 10,  12, 30)
chd.box(44, 27,  12, 22)

chd.switch(win1%)
chd.foreground(chd.RED%)
chd.bold(1)
chd.print_at(0, 37, "    ||    ")
chd.print_at(0, 38, "    ||    ")
chd.print_at(0, 39, "   /**\   ")
chd.print_at(0, 40, "  /****\  ")
chd.print_at(0, 0)

chd.switch(win3%)
chd.foreground(chd.YELLOW%)
chd.inverse(1)
chd.print_at(0, 24, "    ||    ")
chd.print_at(0, 25, "    ||    ")
chd.print_at(0, 26, "   /**\   ")
chd.print_at(0, 27, "  /****\  ")
chd.inverse(0)

chd.switch(win4%)
chd.foreground(chd.GREEN%)
chd.print_at(0, 0, "  \****/  ")
chd.print_at(0, 1, "   \**/   ")
chd.print_at(0, 2, "    ||    ")
chd.print_at(0, 3, "    ||    ")

Dim i%
For i% = 1 To 255
 chd.switch(win2%)
 chd.foreground(1 + i% Mod 6)
 chd.print("Moses supposes his toeses are roses, but moses supposes erroneously.")
 chd.print(" For nobody's toeses are roses as moses supposes his toeses to be. ")
 chd.switch(win1%)
 chd.scroll_up(1)
 chd.switch(win3%)
 chd.scroll_up(1)
 chd.switch(win4%)
 chd.scroll_down(1)
Next