unit DDraw;

interface
uses
  Windows, DirectDraw;

var

  d_x: integer = 1024;
  d_y: integer = 256;

  IsWindowed: boolean = false;

  rcSaveWindowSize,
  fscreen: TRECT;

  IsColor: boolean = true;

  ColorMode:integer = 3;


function  DirectDrawInit(ddWnd: HWND): boolean;
procedure ToggleFullScreen(ddWnd: HWND);
procedure DrawScreen(ddWnd: hwnd; BKSCR:pointer; ScrReg:integer);
procedure CreatePixelTable;

implementation

var
  lpDD: IDIRECTDRAW7 = nil;
  lpDDSPrimary: IDIRECTDRAWSURFACE7 = nil;
  lpDDSBack: IDIRECTDRAWSURFACE7 = nil;
  lpClipper: iDirectDrawClipper = nil;

// пиксельный массив для быстрого вывода
  pix32tbl : PIntegerArray = nil;
  pix32data: array [0..256*8] of integer;


function DirectDrawWindowedInit(ddWnd: HWND): boolean;
begin
  IsWindowed := true;
  lpDD.FlipToGDISurface;
  lpDD.SetCooperativeLevel(ddWnd, DDSCL_NORMAL);
  lpDDSPrimary.SetClipper(lpClipper);
  result := true;
end;


function DirectDrawInit(ddWnd: HWND): boolean;
var
  ddrval: HRESULT;
  DD: IDIRECTDRAW;
  ddsd: DDSURFACEDESC2;
begin
  result := false;

  CreatePixelTable;

  ddrval := DirectDrawCreate(nil, DD, nil); if ddrval <> DD_OK then exit;
// получить интерфейс IDirectDraw7
  DD.QueryInterface(IID_IDirectDraw7, lpDD);
// using DDSCL_NORMAL means we will coexist with GDI
  ddrval := lpDD.SetCooperativeLevel(ddWnd, DDSCL_NORMAL);

// создание основной поверхности
  FillChar(ddsd, SizeOf(ddsd), 0);
  ddsd.dwSize := sizeof(ddsd);
  ddsd.dwFlags := DDSD_CAPS;
  ddsd.ddsCaps.dwCaps := DDSCAPS_PRIMARYSURFACE;

  ddrval := lpDD.CreateSurface(ddsd, lpDDSPrimary, nil);
  if (ddrval <> DD_OK) then exit;

// создание вторичной поверхности
  ddsd.dwFlags := DDSD_CAPS or DDSD_HEIGHT or DDSD_WIDTH;
  ddsd.ddsCaps.dwCaps := DDSCAPS_OFFSCREENPLAIN;
  ddsd.dwWidth := d_x;
  ddsd.dwHeight := d_y;

  ddrval := lpDD.CreateSurface(ddsd, lpDDSBack, nil);
  if (ddrval <> DD_OK) then exit;

// Создание клипера окна
  ddrval := lpDD.CreateClipper(0, lpClipper, nil);
  if (ddrval <> DD_OK) then exit;
// Установливаем клипер в наш HWND,
  ddrval := lpClipper.SetHWnd(0, ddWnd);

  GetWindowRect(ddWnd, rcSaveWindowSize);
  DirectDrawWindowedInit(ddWnd);
  result := true;
end;


function DirectDrawFullScreenInit(d_hwnd: HWND): boolean;
begin
  IsWindowed := false;
  lpDD.SetCooperativeLevel(d_hwnd, DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN);
  GetWindowRect(GetDesktopWindow, fscreen);
  lpDDSPrimary.SetClipper(nil);
  result := true;
end;

procedure ToggleFullScreen(ddWnd: hwnd);
begin
//  finiObjects(ddWnd);
  if IsWindowed then
  begin

    SetWindowLong(ddwnd,GWL_STYLE,WS_OVERLAPPEDWINDOW and not WS_SYSMENU);

    ShowCursor(false);

//    GetWindowRect(ddWnd, rcSaveWindowSize);
    DirectDrawFullScreenInit(ddWnd);

  end
  else
  begin

    DirectDrawWindowedInit(ddWnd);

    SetWindowPos(ddWnd, 0, rcSaveWindowSize.Left, rcSaveWindowSize.Top,
      rcSaveWindowSize.Right - rcSaveWindowSize.Left, rcSaveWindowSize.Bottom - rcSaveWindowSize.Top, SWP_DRAWFRAME);

    SetWindowLong(ddwnd,GWL_STYLE,WS_OVERLAPPEDWINDOW);
    ShowWindow(ddwnd, SW_SHOWDEFAULT);
    ShowCursor(true);
  end;
end;

//
// Пакетная запись пиксельной таблицы (цвет = 32бит),
// в экранный буфер, с удвоением при размере 1024
//
procedure PSet(scr,clr:pointer);
asm
//    mov eax,scr
//    mov edx,clr
    movaps xmm0, [edx]
    movaps xmm1, [edx+16]

    cmp d_x, 1024
    jnz @@sk

    movaps xmm2, xmm0     //111111 222222 333333 444444
    shufps xmm0,xmm0,50h  //111111 111111 222222 222222
    shufps xmm2,xmm2,0fah //333333 333333 444444 444444

    movaps [eax], xmm0
    movaps [eax+16], xmm2

/////////////////////
    movaps xmm0, xmm1

    shufps xmm0,xmm0,50h
    shufps xmm1,xmm1,0fah

    movaps [eax+16+16], xmm0
    movaps [eax+16+16+16], xmm1
    ret

@@sk:
    movaps [eax], xmm0
    movaps [eax+16], xmm1
end;


procedure DrawScreen(ddWnd: hwnd; BKScr:pointer; ScrReg:integer);
type
  TByteArray = array [0..65535] of byte;
  PByteArray = ^TByteArray;

var
   BKScreen: PByteArray;
   BackScr: PIntegerArray;
   x, y, y2, data: integer;
   p: tPOINT;
   ddsd: DDSURFACEDESC2;
begin
// проверить доступность и восстановление экранов
  if lpDDSBack.IsLost <> S_OK then begin
     lpDDSBack._Restore;
     lpDDSPrimary._Restore;
  end;

  ddsd.dwSize  := sizeof(ddsd);

  if lpDDSBack.Lock (nil, ddsd, DDLOCK_SURFACEMEMORYPTR, 0) <> S_OK
  then exit;
// получить указатель памяти теневого буффера
  BackScr := ddsd.lpSurface;

  BKScreen := BKScr;

  for y := 0 to 255 do begin

//    y2 := y - (k1801vm1.mem.b[p177664] - 216);

    y2 := y - byte(ScrReg - 216);

    if y2 < 0 then y2 := y2 + 256;
    if y2 < 0 then y2 := y2 + 256;
    if y2 >= 256 then y2 := y2 - 256;

    for x := 0 to 63 do begin

    data := BKScreen[x + y * 64];

    PSet(@BackScr[(x * (d_x div 64) ) + (y2 * d_x)],@pix32tbl[data*8]);

// очистить неактивную часть экрана в режиме "РП"
    if byte(hi(ScrReg) and 2) = 0 then if y > 63 then
    PSet(@BackScr[(x * (d_x div 64) ) + (y * d_x)],@pix32tbl[0]);

     end;//x
   end;//y

  if lpDDSBack.Unlock (nil) <> S_OK then exit;

  if (IsWindowed) then
  begin
    p.x := 0; p.y := 0;
    ClientToScreen(ddWnd, p);
    GetClientRect(ddWnd, fscreen);
    OffsetRect(fscreen, p.x, p.y);
  end;

  lpDDSPrimary.Blt(@fscreen, lpDDSBack, nil, DDBLT_ASYNC, nil);
end;

procedure CreatePixelTable;
var
  v_data, bit, pix0,pix1,color, i,j: integer;

begin
    if pix32tbl = nil then begin
    pix32tbl := @pix32data;
//выровнять указатель массива для комманд SSE
    while integer(pix32tbl)and $f <> 0 do
            integer(pix32tbl) := integer(pix32tbl)+1;
    end;


    for i := 0 to 255 do begin

          v_data := i;

          for bit := 0 to 3 do
          begin

            color := v_data and 3;
            v_data := (v_data shr 2);

               pix0:=0;
               pix1:=0;

           if ColorMode = 2 then
               case color of

               1: pix0 := $90090FF;
               2: pix1 := integer($9902f070);
               3: begin
                  pix0 := $f07f7f;
                  pix1 := $f07f7f;
                 end;
               end;

           if ColorMode = 3 then
               case color of

        1: begin
                  pix0 := $90090FF;
                  pix1 := $000708F;
                 end;
        2: begin
                  pix0 := $007F00;
                  pix1 := integer($9902f070);
                 end;
        3: begin
                  pix0 := $f07f7f;
                  pix1 := $f07f7f;
                 end;
               end;

           if ColorMode = 1 then
               case color of

        1: begin
                  pix0 := $0000FF;
                  pix1 := $0000FF;
                 end;
        2: begin
                  pix0 := $00FF00;
                  pix1 := $00FF00;
                 end;
        3: begin
                  pix0 := $FF0000;
                  pix1 := $FF0000;
                 end;
        end;


           if ColorMode = 0 then
               case color of

        1:pix0 := $FFFFFF;
        2:pix1 := $FFFFFF;
        3: begin
          pix0 := $FFFFFF;
          pix1 := $FFFFFF;
         end;
        end;

               pix32tbl [(i*8)+(bit*2)] := pix0;
               pix32tbl [1+(i*8)+(bit*2)] := pix1;
           end; //bit
    end;//i
end;

end.