'*****************************************************************************
'* 
'* VARIOUS TOOLS, USEFUL IN VGA BIOS EMULATION
'*
'*****************************************************************************

//DEBUG.ON 'uncomment to enable debug messages (can be slow for hi-freq events)

//Detect if current mode is text mode
public function IsTextMode as boolean
 dim mode as byte=mem.Byte(0x449) 'video mode
 result=mode<=3
end

//Set cursor pos
public function SetCursorPos(Page as byte, Row as byte, Col as byte) as boolean
 //only 8 text pages allowed (0-7)
 if Page>=8 then exit(false)
 //write to mem
 mem.Word(0x450+Page*2)=Col or shl(Row,8)
 //write to controller if current page
 if Page=mem.Byte(0x462) then 
   dim cols as word=mem.Word(0x44A), rows as word
   dim mode=mem.Byte(0x449) 'video mode
   if (mode>=0x11) and (mode<=12) then rows=60 else rows=25
   dim port as word=mem.Word(0x463) 
   dim pos as word=(Page*rows+row)*cols+col //symbols from video memory start
   pc.WritePort(Port,0xE) : pc.WritePort(Port+1,shr(pos,8))
   pc.WritePort(Port,0xF) : pc.WritePort(Port+1,pos and 0xFF)
 end if
 result=true
end


//Read text char
public function ReadTextChar(Page as byte, Row as byte, Col as byte, _
 byref Char as byte, byref Attrib as byte) as boolean
 dim buf_size as word=mem.Word(0x44C) 'size of page buffer
 dim col_count as word=mem.Word(0x44A) 'column count
 dim pos as integer=Page*buf_size+(Row*col_count+Col)*2 'char pos in memory
 pos=0xB8000+pos : Char=mem.Byte(pos) : Attrib=mem.Byte(pos+1) 
 result=true
 ?? "[VBIOS] Read text char"
end


//Write text char
public function WriteTextChar(Page as byte, Row as byte, Col as byte, Char as byte, _
 Attrib as integer,Count as word) as boolean
 dim buf_size as word=mem.Word(0x44C) 'size of page buffer
 dim col_count as word=mem.Word(0x44A) 'column count
 dim pos as integer=Page*buf_size+(Row*col_count+Col)*2 'char pos in memory
 dim i as integer : pos=0xB8000+pos 
 if Attrib>=0 then //with attribute
   for i=0 to Count-1 : mem.Byte(pos)=Char 
    mem.Byte(pos+1)=Attrib and 0x7F //TODO - xor/inversion???
   pos=pos+2:  next i
 else //without attribute
    for i=0 to Count-1 : mem.Byte(pos)=Char : pos=pos+2 : next i
 end if
 result=true
 ?? "[CGA BIOS] Write text char"
end


//Scroll text rect
public function ScrollTextRect(Page as byte, Left as integer, Top as integer, _
 Right as integer, Bottom as integer, Lines as integer, Char as byte, _
 Attrib as integer) as boolean
 if Page>7 then exit(false)
 dim i as integer, j as integer, n as integer, a as byte
 dim Cols as word=mem.Word(0x44A), Rows as word=25

 //order rectangle coords
 if Left>Right then : i=Left : Left=Right : Right=i : end
 if Top>Bottom then : i=Top : Top=Bottom : Bottom=i : end
 if (Right<0) or (Bottom<0) or (Left>=Cols) or (Top>=Rows) then exit(false)
 if Left<0 then Left=0 : if Right>=Cols then Right=Cols-1
 if Top<0 then Top=0 : if Bottom>=Rows then Bottom=Rows-1

 //scroll up 
 if Lines<0 then : for j=Top to Bottom : n=j+Lines 
   if n>=Top then for i=Left to Right : if ReadTextChar(Page,j,i,Char,a) then 
      WriteTextChar(Page,n,i,Char,a,1) : end if : next i
   for i=Left to Right : WriteTextChar(Page,j,i,Char,Attrib,1) : next i
 next j : exit(true) : end if 

 //scroll down
 if Lines=0 then Lines=Rows //scroll whole rectangle
 for j=Bottom to Top step -1 : n=j+Lines 
   if n<=Bottom then for i=Left to Right : if ReadTextChar(Page,j,i,Char,a) then 
      WriteTextChar(Page,n,i,Char,a,1) : end if : next i
   for i=Left to Right : WriteTextChar(Page,j,i,Char,Attrib,1) : next i
 next j : result=true
end


//Read pixel
public function ReadPixel(Page as byte, X as word, Y as word, _
 byref Color as byte) as boolean

 //params
 dim mode as byte=mem.Byte(0x449) : if mode<=3 then exit(false)

 //calc width and hegiht of screen (cols*8 and rows*8)
 dim width as word=mem.Word(0x44A)*8, height as word=(mem.Byte(0x484)+1)*8
 if (x>=width) or (y>=height) then exit(false)

 //draw pixel 
 select case mode 
 case 4 to 5 //GRAPH 320x200x4 (CGA)
   dim addr as dword=0xB8000+mem.Word(0x44E) 
   if (y and 1)<>0 then Addr=Addr+0x2000 //second plane
   Addr=Addr+shr(Width,2)*shr(Y,1)
   Addr=Addr+shr(X,2) 
   Color=shr(mem.Byte(Addr),shl(3-(X and 3),1)) and 3
 case 6 //GRAPH 640x200x2 (CGA)
   dim addr as dword=0xB8000+mem.Word(0x44E) 
   if (y and 1)<>0 then Addr=Addr+0x2000 //second plane
   Addr=Addr+shr(Width,3)*shr(Y,1)
   Addr=Addr+shr(X,3) 
   Color=shr(mem.Byte(Addr),7-(X and 7)) and 1
 case 0x13 //GRAPH 320x200x256 (VGA)
   dim addr as dword=0xA0000+mem.Word(0x44E) 
   Addr=Addr+Width*Y+X : Color=mem.Byte(Addr)
case else : exit(false) : end select

//success
result=true : end

//Write pixel
public function WritePixel(Page as byte, X as word, Y as word, Color as byte) as boolean

 //variables
 dim Mask as byte, b as byte, b2 as byte

 //params
 dim mode as byte=mem.Byte(0x449) : if mode<=3 then exit(false)

 //calc width and hegiht of screen (cols*8 and rows*8)
 dim width as word=mem.Word(0x44A)*8, height as word=(mem.Byte(0x484)+1)*8
 if (x>=width) or (y>=height) then exit(false) 

 //draw pixel 
 select case mode 
 case 4 to 5 //GRAPH 320x200x4 (CGA)
   dim Addr as dword=0xB8000+mem.Word(0x44E)
   if (y and 1)<>0 then Addr=Addr+0x2000 //second plane
   Addr=Addr+shr(Width,2)*shr(Y,1)+shr(X,2) 
   b=mem.Byte(Addr) : b2=(3-(X and 3))*2  
   mask=shl(3,b2) : b2=shl(Color and 3,b2)
   if (Color and 0x80)<>0 then : b=(b and (not mask)) or ((b xor b2) and mask)
   else : b=(b and (not mask)) or (b2 and mask) : end if
   mem.Byte(Addr)=b 
 case 6 //GRAPH 640x200x2 (CGA)
   dim Addr as dword=0xB8000+mem.Word(0x44E)
   if (y and 1)<>0 then Addr=Addr+0x2000 //second plane
   Addr=Addr+shr(Width,3)*shr(Y,1)+shr(X,3) : b=mem.Byte(Addr)
   b2=7-(X and 7) : mask=shl(1,b2) : b2=shl(Color and 1,b2)
   if (Color and 0x80)<>0 then : b=(b and (not mask)) or ((b xor b2) and mask)
   else : b=(b and (not mask)) or (b2 and mask) : end if
   mem.Byte(Addr)=b
 case 0xD,0xE,0x10,0x12 //GRAPH MODES 16 (EGA)
   dim Addr as dword=0xA0000+mem.Word(0x44E)
   Addr=Addr+shr(Width,3)*Y+shr(X,3) 
   mask=shl(1,7-(X and 7)) 
   pc.WritePort(0x3CE,5) : pc.WritePort(0x3CF,2) //Write Mode 2, Read Mode 0
   pc.WritePort(0x3CE,3) : pc.WritePort(0x3CF,0) //Data Rotate/Function Select
   pc.WritePort(0x3CE,8) : pc.WritePort(0x3CF,mask) //pixel mask
   b=mem.Byte(Addr) : mem.Byte(Addr)=Color
 case 0x13 //GRAPH 320x200x256 (VGA)
   dim addr as dword=0xA0000+mem.Word(0x44E) 
   Addr=Addr+Width*Y+X : mem.Byte(Addr)=Color
 case else : exit(false) : end select

//success
result=true : end


//Write graph char
public function WriteGraphChar(Page as byte, Row as byte, Col as byte, Char as byte, _
 FgColor as integer, BgColor as integer,Count as word) as boolean
 //calc address of 8x8 char
 dim CharAddr as dword : if Char<128 then : CharAddr=0xFFA6E+Char*8+7 'ROM
 else : CharAddr=shl(mem.Word(0x1F*4+2),4)+mem.Word(0x1F*4)+7 : end if 'INT 1Fh
 //check colors
 if FgColor>=0 then : if (FgColor and 0x80)<>0 then //TODO XOR and BgColor
  BgColor=FgColor and (not 0x80) : FgColor=0 : else
  BgColor=0 : end if 
  else : FgColor=0xF : BgColor=0 : end if //white on black
 //writing 8x8 char
 dim Cols as word=mem.Word(0x44A), Rows as word=25
 dim i as integer, j as integer, k as integer, pos as integer, b as byte
 for k=0 to Count-1 : if Col>=Cols then : Row=Row+1 : Col=0 : end if
 if Row>=Rows then exit for : 
 pos=CharAddr : for j=7 to 0 step -1 'lines
 b=mem.Byte(pos) : pos=pos-1 : for i=0 to 7 'pixels
 if (b and 0x80)<>0 then WritePixel(Page,Col*8+i,Row*8+j,FgColor) _
 else WritePixel(Page,Col*8+i,Row*8+j,BgColor)
 b=shl(b,1) : next i : next j : Col=Col+1 : next k
 result=true
 ?? "[VBIOS] Write graph char"
end


//Scroll graph rect
public function ScrollGraphRect(Page as byte, Left as integer, Top as integer, _
 Right as integer, Bottom as integer, Lines as integer, FgColor as byte, _
 BgColor as integer) as boolean

 if Page>7 then exit(false)
 dim i as integer, j as integer, n as integer, color as byte
 dim Cols as word=mem.Word(0x44A), Rows as word=25

 //order rectangle coords
 if Left>Right then : i=Left : Left=Right : Right=i : end
 if Top>Bottom then : i=Top : Top=Bottom : Bottom=i : end
 if (Right<0) or (Bottom<0) or (Left>=Cols) or (Top>=Rows) then exit(false)
 if Left<0 then Left=0 : if Right>=Cols then Right=Cols-1
 if Top<0 then Top=0 : if Bottom>=Rows then Bottom=Rows-1

 //params
 dim x as byte=8, y as byte=8 : if BgColor<0 then BgColor=0 
 if Lines=0 then Lines=Rows //scroll whole rectangle
 Lines=Lines*y : Left=Left*x : Top=Top*y 
 Right=(Right+1)*x-1 : Bottom=(Bottom+1)*y-1

 //scroll up 
 if Lines<0 then : for j=Top to Bottom : n=j+Lines 
   if n>=Top then for i=Left to Right : if ReadPixel(Page,i,j,color) then 
      WritePixel(Page,i,n,Color) : end if : next i
   for i=Left to Right : WritePixel(Page,i,j,BgColor) : next i
 next j : exit(true) : end if 

 //scroll down
 for j=Bottom to Top step -1 : n=j+Lines 
   if n<=Bottom then for i=Left to Right : if ReadPixel(Page,i,j,color) then 
      WritePixel(Page,i,n,color) : end if : next i
   for i=Left to Right : WritePixel(Page,i,j,BgColor) : next i
 next j : result=true

end