unit Gui32;

interface

uses
  Windows, Config, Messages, SysUtils;

type
   PArrayRGBQUAD=^TArrayRGBQUAD;
   TArrayRGBQUAD = array of TRGBQuad;
   intg=integer;

PQueueEvent = ^QueueEvent;
QueueEvent = record
  key_event:Bit32u;
  mouse_x:Integer;
  mouse_y:Integer;
  mouse_button_state:Integer;
end;

const
  SCANCODE_BUFSIZE  = 20;
  BX_KEY_PRESSED    = $00000000;
  BX_KEY_RELEASED   = $80000000;
  MOUSE_PRESSED     =  $20000000;
  HEADERBAR_CLICKED =  $08000000;
  MOUSE_MOTION      =  $22000000;
var
  MainWnd:THandle;
  dimension_x , dimension_y : Word;
  prev_block_cursor_x:unsigned = 0;
  prev_block_cursor_y:unsigned = 0;
  yChar:integer = 16;
  cursorBmp:HBITMAP;
  crPal:array[0..16] of COLORREF;
  updated_area_valid:Boolean = false;
  updated_area:TRect;
  x_tilesize,y_tilesize:Integer;
  bitmap_info:PBitmapInfo;
  cmap_index:PRGBQUAD;  // indeces into system colormap
  black_quad:RGBQUAD;
  stretched_x, stretched_y:unsigned;
  y_caption:Integer=20;
  count_tot_tiles:longword=0;
  tail:LongWord=0;
  head:LongWord=0;
  keyevents:array[0..SCANCODE_BUFSIZE] of QueueEvent;

function CreateMainForm:boolean; stdcall; 
procedure clear_screen;
procedure processMouseXY( x:intg; y:intg;  windows_state:intg;implied_state_change:intg);
procedure text_update(old_text:PChar; new_text:PChar; cursor_x:longword; cursor_y:longword;
                           cursor_state:Bit16u; nrows:unsigned);
function palette_change(index, red, green, blue:unsigned):Bool;
procedure graphics_tile_update(tile:PBit8u; x0:unsigned; y0:unsigned);
procedure DrawBitmap(hdc:HDC; hBitmap:HBITMAP; xStart:integer; yStart:Integer;dwRop:DWORD; cColor:byte);
procedure DrawChar(hdc:HDC; c:char; xStart:integer; yStart:Integer;cColor:byte;cs_start:integer;cs_end:integer);
procedure CreateFont;
procedure TerminateEmul;
procedure FlushGui;
procedure updateUpdated(x1,y1,x2,y2:Integer);
procedure Gui32Init(WinHandle:THandle;DW:Integer);
procedure Gui32Stop;
procedure enq_key_event(key:Bit32u; press_release:Bit32u);
procedure handle_events;
function deq_key_event:PQueueEvent;
procedure dimension_update(x:unsigned; y:unsigned );
procedure cursorWarped;

implementation

uses VgaBitmap,service,keyboard,math,cpu;

var
  MemoryDC:THandle = 0;
  MemoryBitmap:THandle;
  fontID:Integer = 2;
  vgafont:array[0..256] of THandle;
  stretch_factor:Integer=1;
  DeltaWidth:Integer;
  mouse_button_state:unsigned = 0;
  ms_xdelta:intg=0; ms_ydelta:intg=0;
  ms_lastx:intg=0; ms_lasty:intg=0;
  ms_savedx:intg=0; ms_savedy:intg=0;
  mouseCaptureMode:longbool = FALSE;

function MainWndProc(Wnd: HWND; Msg, wParam, lParam: Longint): Integer; stdcall;
var
  ps:PAINTSTRUCT;
  VideoDC,MemDC:HDC;
  OldObject:THandle;
begin
  case Msg of
    WM_CLOSE:
      begin
        stoprun:=True;
        ExitThread(ThreadGui);
        DestroyWindow(Wnd);
      end;
  WM_PAINT:
      begin
        EnterCriticalSection(DrawCS);
        VideoDC :=BeginPaint(wnd, ps);
        MemDC:=CreateCompatibleDC(VideoDC);

        OldObject:=SelectObject(MemDC,MemoryBitmap);

        StretchBlt(VideoDC, ps.rcPaint.left, ps.rcPaint.top, ps.rcPaint.right - ps.rcPaint.left + 1,
           ps.rcPaint.bottom - ps.rcPaint.top + 1, MemDC,
           ps.rcPaint.left div stretch_factor, ps.rcPaint.top div stretch_factor,
            (ps.rcPaint.right - ps.rcPaint.left+1) div stretch_factor, (ps.rcPaint.bottom - ps.rcPaint.top+1)
            div stretch_factor,SRCCOPY);

        SelectObject(MemDC,OldObject);

        DeleteDC(MemDC);
        EndPaint(wnd, ps);
        leavecriticalsection(DrawCs);
        Result:=0;
        Exit;
      end;
    WM_KEYDOWN,WM_SYSKEYDOWN:
      begin
        if wParam=VK_F5 then
         begin
            StopRun:=True;
         end;
        if wParam=VK_F11 then
          begin
            MouseEnabled:=not MouseEnabled;
            if MouseEnabled then
              SetWindowText(Wnd,'Mozaa - Mouse Enabled')
            else
              SetWindowText(Wnd,'Mozaa - Mouse Disabled')
          end;
        EnterCriticalSection(KeyCS);
        enq_key_event(HiWord(lParam) and $01FF,BX_KEY_PRESSED);
        leavecriticalsection(KeyCs);
        Result:=0;
        exit;
      end;
    WM_KEYUP,WM_SYSKEYUP:
      begin
        EnterCriticalSection(KeyCS);
        enq_key_event(HiWord(lParam) and $01FF,BX_KEY_RELEASED);
        leavecriticalsection(KeyCs);
        Result:=0;
        exit;
      end;
    WM_MOUSEMOVE:
      begin
        if MouseEnabled then
          processMouseXY( LOWORD(lParam), HIWORD(lParam), wParam, 0);
        Result:=0;
        Exit;
      end;
    WM_LBUTTONDOWN,WM_LBUTTONDBLCLK:
      begin
        if MouseEnabled then
          processMouseXY( LOWORD(lParam), HIWORD(lParam), wParam, 1);
        Result:=0;
        Exit;
      end;
    WM_LBUTTONUP:
      begin
        if MouseEnabled then
  			  processMouseXY( LOWORD(lParam), HIWORD(lParam), wParam, 1);
        Result:=0;
        Exit;
      end;
    WM_CHAR,
    WM_DEADCHAR,
    WM_SYSCHAR,
    WM_SYSDEADCHAR:
      begin
        result := 0;
        exit;
      end;
    end;
  Result := DefWindowProc(Wnd, Msg, WParam, LParam);
end;

function PrepareMenu:Boolean;
begin
  MozaaMenu:=CreateMenu;
  if MozaaMenu<>0 then
    begin
    end;
  Result:=MozaaMenu<>0;
end;

function CreateMainForm:boolean; stdcall;
var
   wc:WNDCLASSEX;
   Msg:TMsg;
   _result:Integer;
   _okMenu:Boolean;
begin
  wc.cbSize := sizeof(wc);
  wc.style:=CS_HREDRAW or CS_VREDRAW;
  wc.cbClsExtra:= 0;
  wc.cbWndExtra:= 0;
  wc.hInstance:= hInstance;
  wc.lpfnWndProc := @MainWndProc;
  wc.hIcon:= 0;
  wc.hCursor:= LoadCursor(0,IDC_ARROW);
  wc.hbrBackground:= GetStockObject(WHITE_BRUSH);
  wc.lpszMenuName:= nil;
  wc.lpszClassName:= 'MozaaMainForm';
  wc.hIconSm := LoadIcon (0, IDI_APPLICATION);
  _result:=RegisterClassEx(wc);

  MainWnd:=CreateWindow('MozaaMainForm','MozaaMainForm',WS_OVERLAPPEDWINDOW,CW_USEDEFAULT,
   CW_USEDEFAULT,dimension_x*2,dimension_y*2,0,0,hInstance,nil);
  _okMenu:=PrepareMenu;
  if _okMenu then
    SetMenu(MainWnd,MozaaMenu);
  Result:=True;
  if MainWnd=0 then
    begin
   	  raise exception.Create('');
    end
  else
    begin
      SetEvent(StartEvent);
      while GetMessage(Msg,0,0,0) do
        begin
          TranslateMessage(Msg);
          DispatchMessage(Msg);
       end;
   end;    
end;

procedure clear_screen;
var
  oldObj:HGDIOBJ;
begin
  //if (!stInfo.UIinited) return;

  EnterCriticalSection(drawCS);

  oldObj := SelectObject(MemoryDC, MemoryBitmap);
  PatBlt(MemoryDC, 0, 0, stretched_x, stretched_y, BLACKNESS);
  SelectObject(MemoryDC, oldObj);

  updateUpdated(0, 0, dimension_x-1, dimension_y-1);

  LeaveCriticalSection(drawCS);
end;

procedure resetDelta;
begin
  EnterCriticalSection( mouseCS);
  ms_savedx:=ms_lastx;
  ms_savedy:=ms_lasty;
  ms_xdelta:=0;
  ms_ydelta:=ms_xdelta;
  LeaveCriticalSection( mouseCS);
end;


procedure enq_mouse_event;

var
  current:PQueueEvent;
begin
  EnterCriticalSection( mouseCS);
  if ( (ms_xdelta<>0) or (ms_ydelta<>0)) then
    begin
    if (((tail+1) mod SCANCODE_BUFSIZE) = head) then begin
      BX_ERROR(( 'enq_scancode: buffer full' ));
      exit;
    end;
    current:=@keyevents[tail];
    current.key_event:=MOUSE_MOTION;
    current.mouse_x:=ms_xdelta;
    current.mouse_y:=ms_ydelta;
    current.mouse_button_state:=mouse_button_state;
    resetDelta();
    tail := (tail + 1) mod SCANCODE_BUFSIZE;
  end;
  LeaveCriticalSection( mouseCS);
end;

procedure cursorWarped;
begin

  enq_mouse_event();

  ms_lastx:=stretched_x div 2;
  ms_lasty:=stretched_y div 2;
  ms_savedx:=ms_lastx;
  ms_savedy:=ms_lasty;
end;

procedure processMouseXY( x:intg; y:intg;  windows_state:intg;implied_state_change:intg);
var
  bx_state:intg;
  old_bx_state:intg;
begin
  EnterCriticalSection( mouseCS);
  bx_state:=( ( ifthen((windows_state and MK_LBUTTON) <> 0, 1 , 0 ) + ( ifthen( (windows_state and MK_RBUTTON)<>0 , 2 , 0))));
  old_bx_state:=bx_state xor implied_state_change;
  if ( old_bx_state<>mouse_button_state) then
  begin
    // Make up for missing message
    BX_INFO(( '&&&missing mouse state change'));
    EnterCriticalSection( keyCS);
    enq_mouse_event();
    mouse_button_state:=old_bx_state;
    enq_key_event( mouse_button_state, MOUSE_PRESSED);
    LeaveCriticalSection( keyCS);
  end;
  ms_ydelta:=ms_savedy-y;
  ms_xdelta:=x-ms_savedx;
  ms_lastx:=x;
  ms_lasty:=y;
  if ( bx_state<>mouse_button_state) then
  begin
    EnterCriticalSection( keyCS);
    enq_mouse_event();
    mouse_button_state:=bx_state;
    enq_key_event( mouse_button_state, MOUSE_PRESSED);
    LeaveCriticalSection( keyCS);
  end;
  LeaveCriticalSection( mouseCS);
end;

procedure handle_events;
var
  key:Bit32u;
  scancode:byte;
  queue_event:PQueueEvent;
  label end_procedure;
begin
  EnterCriticalSection(keyCS);
  enq_mouse_event();
  while (head <> tail) do
    begin
      queue_event:=deq_key_event;
      if queue_event=nil then break;
      key:=queue_event^.key_event;
      if ( key=MOUSE_MOTION) then
      begin
        bx_keyboard.mouse_motion( queue_event.mouse_x,
          queue_event.mouse_y, queue_event.mouse_button_state);
      end
      // Check for mouse buttons first
      else if ( key and MOUSE_PRESSED)<>0 then begin
        // printf("# click!\n");
        bx_keyboard.mouse_motion( 0, 0, LOWORD(key));
      end
      else if (key and HEADERBAR_CLICKED)<>0 then begin
        //headerbar_click(LOWORD(key));
      end else

      if ((key and $ff)=$45) then key := key xor $100;
      if Boolean(key and $0100) then begin
        // This makes the "AltGr" key on European keyboards work
      	if (key=$138) then begin
          scancode := $9d; // left control key released
          bx_keyboard.put_scancode(@scancode, 1);
      	end;
        // Its an extended key
        scancode := $E0;
        bx_keyboard.put_scancode(@scancode, 1);
      end;
      // Its a key
      scancode := LOBYTE(LOWORD(key));
      // printf("# key = %d, scancode = %d\n",key,scancode);
      if (key and BX_KEY_RELEASED)<>0 then scancode := scancode or $80;
      bx_keyboard.put_scancode(@scancode, 1);
    end;
  leavecriticalsection(keyCS);
  end_procedure:
end;

function deq_key_event:PQueueEvent;
var
  key:PQueueEvent;
begin
  if ( head = tail ) then begin
    BX_ERROR(('deq_scancode: buffer empty'));
    Result:=nil;
    Exit;
  end;
  key := @keyevents[head];
  head := (head + 1) mod SCANCODE_BUFSIZE;
  Result:=key;
end;

procedure enq_key_event(key:Bit32u; press_release:Bit32u);
begin
  if (((tail+1) mod SCANCODE_BUFSIZE) = head) then begin
    BX_ERROR(( 'enq_scancode: buffer full'));
    exit;
  end;
  keyevents[tail].key_event := key or press_release;
  tail := (tail + 1) mod SCANCODE_BUFSIZE;
end;

procedure Gui32Init(WinHandle:THandle;DW:Integer);
var
   i:unsigned;
begin
  DeltaWidth:=DW;
  MainWnd:=WinHandle;
  crPal[0]:=RGB(0 ,0 ,0 );
  crPal[1]:=RGB(0 ,0 ,$A8 );
  crPal[2]:=RGB(0 ,$A8 ,0 );
  crPal[3]:=RGB(0 ,$A8 ,$A8 );
  crPal[4]:=RGB($A8 ,0 ,0 );
  crPal[5]:=RGB($A8 ,0 ,$A8 );
  crPal[6]:=RGB($A8 ,$54 ,0 );
  crPal[7]:=RGB($A8 ,$A8 ,$A8 );
  crPal[8]:=RGB($54 ,$54 ,$54 );
  crPal[9]:=RGB($54 ,$54 ,$FC );
  crPal[10]:=RGB($54 ,$FC ,$54 );
  crPal[11]:=RGB($54 ,$FC ,$FC );
  crPal[12]:=RGB($FC ,$54 ,$54 );
  crPal[13]:=RGB($FC ,$54 ,$FC );
  crPal[14]:=RGB($FC ,$FC ,$54 );
  crPal[15]:=RGB($FC ,$FC ,$FC );

  black_quad.rgbBlue:=0;
  black_quad.rgbGreen:=0;
  black_quad.rgbRed:=0;
  black_quad.rgbReserved:=0;
  x_tilesize:=32;
  y_tilesize:=32;
  bitmap_Info:=AllocMem(sizeof(TBitmapInfoheader) + 256*sizeof(RGBQUAD));
  bitmap_info^.bmiHeader.biSize:=sizeof(BITMAPINFOHEADER);
  bitmap_info^.bmiHeader.biWidth:=x_tilesize;
  // Height is negative for top-down bitmap
  bitmap_info^.bmiHeader.biHeight:= -y_tilesize;
  bitmap_info^.bmiHeader.biPlanes:=1;
  bitmap_info^.bmiHeader.biBitCount:=8;
  bitmap_info^.bmiHeader.biCompression:=BI_RGB;
  bitmap_info^.bmiHeader.biSizeImage:=x_tilesize*y_tilesize;
  // I think these next two figures don't matter; saying 45 pixels/centimeter
  bitmap_info^.bmiHeader.biXPelsPerMeter:=4500;
  bitmap_info^.bmiHeader.biYPelsPerMeter:=4500;
  bitmap_info^.bmiHeader.biClrUsed:=256;
  bitmap_info^.bmiHeader.biClrImportant:=0;
  cmap_index:=@bitmap_info^.bmiColors;
  // start out with all color map indeces pointing to Black
  i:=1;
  while i < 256 do begin
    PRGBQuad(Integer(cmap_index) + (i*SizeOf(RGBQUAD)))^ :=
      PRGBQuad(Integer(cmap_index))^;
    inc(i);
    end;
  Dimension_x:=320;
  Dimension_y:=400;
  CreateFont;
end;

procedure Gui32Stop;
var
  I:Integer;
begin
  FreeMem(bitmap_Info);
  for i:= 0 to 256 do
    begin
      DeleteObject(vgafont[i]);
    end;
  DeleteObject(MemoryBitmap);
  DeleteDC(MemoryDC);
end;

procedure dimension_update(x:unsigned; y:unsigned );
begin
if (x=dimension_x) and (y=dimension_y) then
    Exit;
  dimension_x := x;
  dimension_y := y;
  stretched_x := dimension_x;
  stretched_y := dimension_y;
  stretch_factor := 1;
  while ( stretched_x<400) do
  begin
    stretched_x := stretched_x * 2;
    stretched_y := stretched_y * 2;
    stretch_factor := stretch_factor * 2;
  end;

  FontId := 2;
  yChar := 16;
  if(y>600) then
  begin
    FontId := 0;
    yChar := 12;
    dimension_y := trunc(y * yChar / 16);
    stretched_y := dimension_y * stretch_factor;
  end else if (y>480) then
    begin
    FontId := 1;
    yChar := 14;
    dimension_y := trunc(y * yChar / 16);
    stretched_y := dimension_y * stretch_factor;
    end;

  SetWindowPos(MainWnd, HWND_TOP, 0, 0, stretched_x + DeltaWidth,
              stretched_y+ y_caption+60,
               SWP_NOMOVE or SWP_NOZORDER);
  end;

function palette_change(index, red, green, blue:unsigned):Bool;
begin
  PRGBQuad(Integer(cmap_index) + (index*SizeOf(RGBQUAD)))^.rgbRed:=red;
  PRGBQuad(Integer(cmap_index) + (index*SizeOf(RGBQUAD)))^.rgbBlue:=Blue;
  PRGBQuad(Integer(cmap_index) + (index*SizeOf(RGBQUAD)))^.rgbGreen:=Green;
  Result:=1;
end;

procedure graphics_tile_update(tile:PBit8u; x0:unsigned; y0:unsigned);
var
  hdc:THandle;
  oldObj:THandle;
  true_y0:unsigned;
  Cannato:Integer;
  S:array[0..10] of char;
begin
  inc(count_tot_tiles);
  true_y0 := y0 ;//+ bx_headerbar_y;

  EnterCriticalSection(drawCS);
  hdc := GetDC(MainWnd);

  oldObj := SelectObject(MemoryDC, MemoryBitmap);

  Cannato:=StretchDIBits( MemoryDC, x0, true_y0, x_tilesize, y_tilesize, 0, 0,
    x_tilesize, y_tilesize, tile, bitmap_info^, DIB_RGB_COLORS, SRCCOPY);
  SelectObject(MemoryDC, oldObj);

  updateUpdated(x0, true_y0, x0 + x_tilesize - 1, true_y0 + y_tilesize - 1);

  ReleaseDC(MainWnd, hdc);
  leavecriticalsection(drawCS);
end;

function reverse_bitorder(b:byte):byte;
var
  ret:byte;
  I:Integer;
begin
  ret:=0;

  for i:=0 to 8 do
    begin
       ret:=ret or (b and $01) shl (7-i);
       b := b shr 1;
    end;

  Result:=Ret;
end;

procedure text_update(old_text:PChar; new_text:PChar; cursor_x:longword; cursor_y:longword;
                           cursor_state:Bit16u; nrows:unsigned);
var
  hdc:THandle;
  cChar:char;
  i, x, y:unsigned;
  cs_start, cs_end:Bit8u;
  nchars:unsigned;
  data:array[0..32] of byte;
  cAttr:char;
begin
  if StrComp(old_text,new_text) = 0 then Exit;
  cs_start := (cursor_state shr 8)  and $3f;
  cs_end := cursor_state  and $1f;

  //if Boolean(stInfo.UIinited=0) then exit;

  EnterCriticalSection(drawCS);

  hdc := GetDC(MainWnd);

  // Number of characters on screen, variable number of rows
  nchars := 80*nrows;

  if Boolean( (prev_block_cursor_y*80 + prev_block_cursor_x) < nchars) then begin
    cChar := PChar(Integer(new_text) + (prev_block_cursor_y*80 + prev_block_cursor_x)*2)^;
    if Boolean(yChar >= 16) then begin
      DrawBitmap(hdc, vgafont[Byte(cChar)], prev_block_cursor_x*8,
	              prev_block_cursor_y*16, SRCCOPY,
				  Integer(new_text[((prev_block_cursor_y*80 + prev_block_cursor_x)*2)+1]));
    end else begin
      DrawChar(hdc, cChar, prev_block_cursor_x*8,
               prev_block_cursor_y*yChar,
               Integer(new_text[((prev_block_cursor_y*80 + prev_block_cursor_x)*2)+1]), 1, 0);
    end;
  end;

  i:=0;
  while i<nchars*2 do
   begin
    if Boolean((old_text[i] <> new_text[i]) or
	(old_text[i+1] <> new_text[i+1])) then begin

      cChar := new_text[i];

      x := Trunc(i/2) mod 80;
      y := Trunc(i/2) div 80;
      if(yChar>=16) then begin
        DrawBitmap(hdc, vgafont[Byte(cChar)], x*8, y*16, SRCCOPY, Integer(new_text[i+1]));
      end else begin
        DrawChar(hdc, cChar, x*8, y*yChar, Integer(new_text[i+1]), 1, 0);
      end;
    end;
    Inc(i,2);
  end;

  prev_block_cursor_x := cursor_x;
  prev_block_cursor_y := cursor_y;

  // now draw character at new block cursor location in reverse
  if Boolean(((cursor_y*80 + cursor_x) < nchars ) and (cs_start <= cs_end)) then begin
    cChar := new_text[(cursor_y*80 + cursor_x)*2];
    if Boolean(yChar>=16) then
    begin
      FillChar(data, sizeof(data), 0);
      i:=0;
      while i<16 do begin
        data[i*2] := reverse_bitorder(bx_vgafont[Byte(cChar)][i]);
        if Boolean((i >= cs_start) and (i <= cs_end)) then
          Byte(data[i*2]) := 255 - Byte(data[i*2]);
        Inc(i);
      end;
      SetBitmapBits(cursorBmp, 32, @data);
      DrawBitmap(hdc, cursorBmp, cursor_x*8, cursor_y*16,
	         SRCCOPY, Integer(new_text[((cursor_y*80 + cursor_x)*2)+1]));
    end else begin
      cAttr := new_text[((cursor_y*80 + cursor_x)*2)+1];
      DrawChar(hdc, cChar, cursor_x*8, cursor_y*yChar, Byte(cAttr), cs_start, cs_end);
    end;
  end;

  ReleaseDC(MainWnd, hdc);
  leavecriticalsection(drawCS);
end;

procedure DrawBitmap(hdc:HDC; hBitmap:HBITMAP; xStart:integer; yStart:Integer;dwRop:DWORD; cColor:byte);
var
  bm:tagBITMAP;
  hdcMem:THandle;
  ptSize, ptOrg:TPOINT;
  oldObj:HGDIOBJ;
  crFore,crBack:COLORREF;
begin
  hdcMem := CreateCompatibleDC (hdc);
  SelectObject (hdcMem, hBitmap);
  SetMapmode (hdcMem, GetMapmode(hdc));

  GetObject(hBitmap, sizeof (BITMAP), @bm);

  ptSize.x := bm.bmWidth;
  ptSize.y := bm.bmHeight;

  DPtoLP (hdc, ptSize, 1);

  ptOrg.x := 0;
  ptOrg.y := 0;
  DPtoLP (hdcMem, ptOrg, 1);

  // BitBlt (hdc, xStart, yStart, ptSize.x, ptSize.y, hdcMem, ptOrg.x,
  // 	    ptOrg.y, dwRop);

  oldObj := SelectObject(MemoryDC, MemoryBitmap);
//	BitBlt(MemoryDC, xStart, yStart, ptSize.x, ptSize.y, hdcMem, ptOrg.x,
//		  ptOrg.y, dwRop);
//Colors taken from Ralf Browns interrupt list.
//(0:=black, 1:=blue, 2:=red, 3:=purple, 4:=green, 5:=cyan, 6:=yellow, 7:=white)
//The highest background bit usually means blinking characters. No idea
//how to implement that so for now it's just implemented as color.
//Note: it is also possible to program the VGA controller to have the
//high bit for the foreground color enable blinking characters.

	crFore := SetTextColor(MemoryDC, crPal[(cColor shr 4) and $f]);
	crBack := SetBkColor(MemoryDC, crPal[cColor and $f]);
	BitBlt (MemoryDC, xStart, yStart, ptSize.x, ptSize.y, hdcMem, ptOrg.x,
		  ptOrg.y, dwRop);
	SetBkColor(MemoryDC, crBack);
	SetTextColor(MemoryDC, crFore);

  SelectObject(MemoryDC, oldObj);

  updateUpdated(xStart, yStart, ptSize.x + xStart - 1, ptSize.y + yStart - 1);

  DeleteDC (hdcMem);
end;

procedure DrawChar(hdc:HDC; c:char; xStart:integer; yStart:Integer;cColor:byte;cs_start:integer;cs_end:integer);
var
  hdcMem:THandle;
  ptSize, ptOrg:TPoint;
  oldObj:THandle;
  str:array[0..2] of char;
  hFontOld:HFONT;
  crFore,crBack:COLORREF;
  y:integer;
  rc:TRECT;
begin
  hdcMem := CreateCompatibleDC (hdc);
  SetMapmode (hdcMem, GetMapmode (hdc));
  ptSize.x := 8;
  ptSize.y := yChar;

  DPtoLP (hdc, ptSize, 1);

  ptOrg.x := 0;
  ptOrg.y := 0;

  DPtoLP (hdcMem, ptOrg, 1);

  oldObj := SelectObject(MemoryDC, MemoryBitmap);
  //hFontOld:=SelectObject(MemoryDC, hFont[FontId]);

//Colors taken from Ralf Browns interrupt list.
//(0:=black, 1:=blue, 2:=red, 3:=purple, 4:=green, 5:=cyan, 6:=yellow, 7:=white)
//The highest background bit usually means blinking characters. No idea
//how to implement that so for now it's just implemented as color.
//Note: it is also possible to program the VGA controller to have the
//high bit for the foreground color enable blinking characters.

  crFore := SetTextColor(MemoryDC, crPal[cColor and $f]);
  crBack := SetBkColor(MemoryDC, crPal[(cColor shr 4) and $f]);
  str[0]:=c;
  str[1]:=#0;

  if y =2 then fontID:=16 else fontID:=8;

  TextOut(MemoryDC, xStart, yStart, str, 1);
  if Boolean((cs_start <= cs_end) and (cs_start < y)) then
  begin
    SetBkColor(MemoryDC, crPal[cColor and $f]);
    SetTextColor(MemoryDC, crPal[(cColor shr 4) and $f]);
    rc.left := xStart+0;
    rc.right := xStart+8;
    if Boolean(cs_end >= y) then
      cs_end := y-1;
    rc.top := Trunc(yStart+cs_start*yChar/y);
    rc.bottom := Trunc(yStart+(cs_end+1)*yChar/y);
    ExtTextOut(MemoryDC, xStart, yStart, ETO_CLIPPED or ETO_OPAQUE, @rc, str, 1, NULL);
  end;

  SetBkColor(MemoryDC, crBack);
  SetTextColor(MemoryDC, crFore);

  SelectObject(MemoryDC, hFontOld);
  SelectObject(MemoryDC, oldObj);

  updateUpdated(xStart, yStart, ptSize.x + xStart - 1, ptSize.y + yStart - 1);

  DeleteDC (hdcMem);
end;

procedure CreateFont;
var
   HDC:THandle;
   data:array[0..32] of byte;
   c,i:Word;
   Res:LongInt;
begin
   HDC:=GetDC(MainWnd);
   for c:= 0 to 255 do
      begin
         vgafont[c]:=CreateBitmap(8,16,1,1,nil);
         FillChar(data,32,0);
         for i:=0 to 15 do
           data[i*2]:=reverse_bitorder(bx_vgafont[c][i]);
         SetBitmapBits(vgafont[c],32,@data);
      end;
   ReleaseDC(MainWnd,HDC);
   hdc := GetDC(MainWnd);
   MemoryBitmap := CreateCompatibleBitmap(hdc, 1024,768);
   MemoryDC := CreateCompatibleDC(hdc);
   ReleaseDC(MainWnd, hdc);
end;

procedure TerminateEmul;
var
  c:Integer;
begin
  DeleteCriticalSection(DrawCs);
  DeleteDC(MemoryDC);
  DeleteObject(MemoryBitmap);
  for c:= 0 to 256 do
    DeleteObject(VgaFont[c]);
end;

procedure FlushGui;
begin
  EnterCriticalSection(drawCS);
  if updated_area_valid then
    begin
       Inc(updated_area.right);
       Inc(updated_area.bottom);
       InvalidateRect(MainWnd,@updated_area,False);
       updated_area_valid:=False;
    end;
  leavecriticalsection(drawCS);
end;

procedure updateUpdated(x1,y1,x2,y2:Integer);
begin
  x1:=x1*stretch_factor;
  y1:=y1*stretch_factor;
  x2:=x2*stretch_factor;
  y2:=y2*stretch_factor;
  if (updated_area_valid=false) then
   begin
    updated_area.left := x1 ;
    updated_area.top := y1 ;
    updated_area.right := x2 ;
    updated_area.bottom := y2 ;
   end else begin
    if (x1 < updated_area.left) then updated_area.left := x1 ;
    if (y1 < updated_area.top) then updated_area.top := y1 ;
    if (x2 > updated_area.right) then updated_area.right := x2 ;
    if (y2 > updated_area.bottom) then updated_area.bottom := y2;
   end;

  updated_area_valid := TRUE;
end;
end.

