#include "windows.bi"
#include "fbgfx.bi"
#include "crt.bi"

#include "win\ddraw.bi"
dim shared as LPDIRECTDRAW DD7

extern fbCTX alias "__fb_ctx" as ulong

dim shared as handle hOldScreen,pMiniBuff
dim shared as string sMyTitle
sMyTitle = "Mysoft Console"

#define CharColor(_CH, _CF, _CB) clng(((_CF and 15) shl 16) or ((_CB and 15) shl 20)) or (cshort(_CH))

sub MsgBox( sMsg as string , iMode as integer = MB_ICONERROR)
  MessageBox( null , sMsg , sMyTitle , iMode or MB_TASKMODAL )
end sub
function Console_Create(iWidth as integer = 80, iHeight as integer = 25) as handle

  if iWidth <= 8 or iHeight <= 4 then
    MsgBox("ConsoleCreate: Bad console size selected")
    return null
  end if

  width iWidth,iHeight

  hOldScreen = GetStdHandle( STD_OUTPUT_HANDLE )
  var hCon = hOldScreen

  if SetConsoleActiveScreenBuffer( hCon ) = false then
    MsgBox("ConsoleCreate: Failed to SetActiveScreenBuffer")
    CloseHandle(hCon): return null
  end if

  var pTemp = cast(any ptr,@fbCTX)
  var pOldCtx = allocate(4096)
  memcpy( pOldCtx , pTemp , 4096 )
  screenres iWidth,iHeight,32,,fb.gfx_null
  memcpy( pTemp , pOldCtx , 4096 )
  deallocate(pOldCtx)

  return hCon

end function
function Console_ImageCreate( iWidth as integer , iHeight as integer ) as fb.image ptr

  if iWidth <= 1 or iHeight <= 1 then
    MsgBox("Console_ImageCreate: Bad console size selected")
    return null
  end if

  dim as fb.image ptr pImg = callocate( iWidth*iHeight*4 + sizeof(fb.image) )
  if pImg = null then
    MsgBox("Console_ImageCreate: Failed to create image (no memory?)")
    return null
  end if

  pImg->Type = 7
  pImg->Width = iWidth: pImg->Height = iHeight
  pImg->Bpp = 4: pImg->Pitch = iWidth*pImg->Bpp

  return pImg
end function
sub Console_ImageDestroy( pImage as fb.image ptr )
  if pImage = 0 orelse IsBadWritePtr( pImage , sizeof(fb.image) ) orelse pImage->Type<>7 then
    MsgBox("Console_ImageDestroy: Bad Image handle.")
    exit sub
  end if
end sub
sub Console_Update()
  var iXY = width(), ConWid = LoWord(iXY), ConHei = HiWord(iXY)
  WriteConsoleOutput( hOldScreen, cptr( CHAR_INFO ptr , screenptr ) , _
  type(ConWid,ConHei) , type(0,0) , @type<SMALL_RECT>(0,0,ConWid-1,ConHei-1) )
end sub
sub Console_SyncedUpdate()

  do
    if DD7 = INVALID_HANDLE_VALUE then
      static as double TMR
      var dwOldPri = GetThreadPriority( GetCurrentThread() )
      SetThreadPriority(GetCurrentThread() , THREAD_PRIORITY_TIME_CRITICAL )
      SwitchToThread()
      Console_Update()
      if abs(timer-TMR) > 1/2 then TMR = timer
      while (timer-TMR) < 1/60
        SleepEx 1,1
      wend
      TMR += 1/60
      SetThreadPriority(GetCurrentThread() , dwOldPri )
      SwitchToThread()
      exit sub
    end if
    if DD7 = null then
      if DirectDrawCreate(cast(any ptr,DDCREATE_HARDWAREONLY),@DD7,null) <> DD_OK then
        DD7 = cast(any ptr,INVALID_HANDLE_VALUE)
        continue do
      end if
    end if
    exit do
  loop


  var dwOldPri = GetThreadPriority( GetCurrentThread() )
  SetThreadPriority(GetCurrentThread() , THREAD_PRIORITY_TIME_CRITICAL )
  SwitchToThread()

  var iXY = width(), ConWid = LoWord(iXY), ConHei = HiWord(iXY)
  var hConWnd = GetConsoleWindow(), iCellHei = 0
  dim RcDesk as rect, RcScr as rect, tPt as point, iScan as integer
  GetWindowRect( GetDesktopWindow(), @RcDesk )
  GetClientRect( hConWnd, @RcScr )

  do
    DD7->lpVtbl->GetScanLine(DD7,@iScan)
    if iScan > (RcDesk.bottom shr 1) then exit do
    SleepEx(1,1)
  loop

  var hStart = cptr( CHAR_INFO ptr , screenptr ), iStart = 0
  tPt = type(0,(RcDesk.bottom shr 1)): iCellHei = RcScr.Bottom\ConHei
  if ScreenToClient( hConWnd , @tPt ) = 0 then exit sub
  if cshort(tPt.y) >= 0 and cshort(tPt.y) < RcDesk.Bottom then
    iStart = (cshort(tPt.y)\iCellHei)+1
    WriteConsoleOutput( hOldScreen, hStart , type(ConWid,iStart) , _
    type(0,0) , @type<SMALL_RECT>(0,0,ConWid-1,iStart-1) )
    hStart += iStart*ConWid
  end if

  do
    DD7->lpVtbl->GetScanLine(DD7,@iScan)
    if iScan <= (RcDesk.bottom shr 1) then exit do
    SleepEx(1,1)
  loop

  if iStart < RcDesk.Bottom then
    var iHeight = ConHei-iStart
    WriteConsoleOutput( hOldScreen, hStart , type(ConWid,iHeight) , _
    type(0,0) , @type<SMALL_RECT>(0,iStart,ConWid-1,iStart+iHeight-1) )
  end if

  SetThreadPriority(GetCurrentThread() , dwOldPri )
  SwitchToThread()

end sub

const ConWid = 80, ConHei = 50
const CenX = ConWid\2, CenY = ConHei\2
const PI = atn(1)/(ConWid/4)

var hConsole = Console_Create(ConWid,ConHei)
'var fbBuff = Console_ImageCreate(ConWid,ConHei)

do

  static as integer iBase : iBase += 1

  select case ((iBase shr 8) and 3)
  case 0
    for CNT as integer = ConWid to 0 step -1
      circle(CenX,CenY),CNT,CharColor(177,CNT+iBase,((CNT+iBase) shr 4)),,,.66,f
    next CNT
  case 1
    for CNT as integer = ConWid to 0 step -1
      var pYM = CenY-CNT, pYP = CenY+CNT,pXM = CenX-CNT, pXP = CenX+CNT
      line(pXM,CenY)-(CenX,pYM),CharColor(177,CNT+iBase,((CNT+iBase) shr 4))
      line -(pXP,CenY),CharColor(177,CNT+iBase,((CNT+iBase) shr 4))
      line -(CenX,pYP),CharColor(177,CNT+iBase,((CNT+iBase) shr 4))
      line -(pXM,CenY),CharColor(177,CNT+iBase,((CNT+iBase) shr 4))
    next CNT
  case 2
    for CNT as integer = ConHei to 0 step -1
      line(CenX-CNT,CenY-CNT*.66)-(CenX+CNT,CenY+CNT*.66),CharColor(177,CNT+iBase,((CNT+iBase) shr 4)),b
    next CNT
  case 3
    for CNT as integer = ConWid to 0 step -1
      line(CNT,0)-(ConWid-CNT,ConHei),CharColor(177,CNT+iBase,((CNT+iBase) shr 4))
      line(ConWid,CNT)-(0,ConHei-CNT),CharColor(177,CNT+iBase,((CNT+iBase) shr 4))
    next CNT
  end select

  var iOX = int(sin(iBase*PI)*(CenX-14))
  var iOY = cint(sin(iBase*PI+timer)*(CenY-3))
  for iY as integer = -1 to 1
    for iX as integer = -1 to 1
      draw string (CenX-14+iOX+iX,CenY-3+iOY+iY),"Hi!!",CharColor( asc(" ") , 0 , 0 )
    next iX
  next iY
  draw string (CenX-14+iOX,CenY-3+iOY),"Hi!!",CharColor( iBase , 15 , 0 )

  Console_SyncedUpdate()

loop until len(inkey$)