Модуль с оберткой для кроссплатформенных функций

Вопросы программирования на Free Pascal, использования компилятора и утилит.

Модератор: Модераторы

Модуль с оберткой для кроссплатформенных функций

Сообщение @!!ex » 25.04.2008 08:08:51

Уже вторые сутки пишу модуль, в котором бы были все нужные функции, специфичные для конкретной платформы.
Модуль еще не совсем завершен.

Отметки:
Теоретически готоввый код
//

Не готовый код, нв таком виде, как он есть, его можно использовать, но дописать все равно нужно
//-

Код, который нужно обязательно дописать, прежде чем использовать
//--

код, в котором я абсолютно не уверен
//Need Testing!

Описание:
В проекте не должно быть обращений к специфичным функциям ОС. Все обращения только через функции с префиксом OSAL_.

OSAL_GlCreateWindow - создание GL окна. Либо через wgl(Windows), либо через glx(linux)

CALLBACK_MESSAGE - процедура, которая вызывается для обработки сообщений. Пока обрабатывает только Resize окна.
Эту процедуру нужно инициализировать в самом начале. Иначе проект упадет при первом же обращении к ней.
У меня это выглядит так:

Код: Выделить всё
Procedure ProcessMessage(Msg:integer; wParam: integer; lParam: integer); extdecl;
begin
  case Msg of
    OSAL_MESSAGE_RESIZE: begin
      glResizeWnd(wParam,lParam);
    end;
  end;
end; 

begin
  CALLBACK_MESSAGES:=ProcessMessage;
end.


OSAL_UpdateWNDMessages - вызов обработки сообщений. Это примерно тоже самое что Application.ProcessMessages в Delphi/Lazarus. Крутится пока не обработает все сообщения, потом выход. Это НЕ циклическая обработка.
У меня выглядит примерно так:
Код: Выделить всё
while not finished do  begin
    OSAL_UpdateWNDMessages;
   //Расчет кадра
end;


glKillWindow - грохает окно.

Модуль Data, который требуется для работы модуля - содержит следующий код:
Код: Выделить всё
{$ifdef windows}
  h_DC:HDC;
  h_RC:HGLRC;
  h_Wnd:HWND;
  {$else}
  hXDisplay: PDisplay;
  hglXContext: GLXContext;
  hXWindow: TWindow;
  hXVisualInfo: PXVisualInfo;
  {$endif}
  finished:boolean = false;


Вот собственно код модуля. Просьба сильно не пиннать, делается все в очень сжатые сроки, рефакторить буду, когда все работать будет.

Код: Выделить всё
{$MACRO ON}
{$IFDEF Windows}
  {$DEFINE extdecl := stdcall}
{$ELSE}
  {$DEFINE extdecl := cdecl}
{$ENDIF}
unit uOSAL;

interface

uses
  {$ifdef win32}
  windows, ShellAPI,
  {$else}
  libc,
  glx,unix,x,xlib,xutil,
  {$endif}
  {$ifdef FPC}
  gl,
  {$else}
  OpenGL,
  {$endif}
  Types
;
 
  {$ifdef win32}
  type HDC = windows.HDC;
  type HGLRC = windows.HGLRC;
  type HWND = windows.HWND;
  {$else}
  type HDC = integer;
  type HGLRC = integer;
  type HWND = integer;
  {$endif}
 
{ type TRect = record
         Left,Right,Top,Bottom:integer;
       end;
       
  type TPoint = record
         X,Y:integer;
       end;  }
       
const
  VK_LBUTTON = 1;
  VK_RBUTTON = 2;
  VK_TAB = 9;
  VK_BACK = 19;   //!!!BACKSPACE!!!
  VK_ESCAPE = 27;
  VK_SPACE = 32;
  VK_RETURN = 13;
 
Function  OSAL_GetScreenWidth:integer;
Function  OSAL_GetScreenHeight:integer;

Procedure OSAL_CopyMemory(Dst,Src:Pointer; Length:integer);
Procedure OSAL_ZeroMemory(Dst:Pointer; Length:integer);

Function OSAL_isKeyBoardLayoutRussian:boolean;

Function  OSAL_GetKeyState(Key:byte):boolean;

Procedure OSAL_ShowMouse(Show:boolean);
Procedure OSAL_SetWorldMousePos(X,Y:integer);
Function  OSAL_GetWorldMousePos:TPoint;
Function  OSAL_GetWindowMousePos:TPoint;

Procedure OSAL_SetFocus();
Procedure OSAL_SetForeground();
Function  OSAL_isOnFocus:boolean;


Function  OSAL_GetTextSize(const Text:string):TPoint;

procedure OSAL_SwapBuffers;

procedure OSAL_ExecuteWebPage(const URL:String);
procedure OSAL_ExecuteFile(const FileName:String);
procedure OSAL_ExecuteExe(const FileName,Param:String);

Function  OSAL_GetWindowPos:TPoint;
Function  OSAL_GetWindowClientSize:TPoint;
Procedure OSAL_SetWindowPos(X,Y, Width, Height: integer);
Procedure OSAL_SetWindowText(const Text:String);
function  OSAL_glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer; const Title:string) : Boolean;
procedure OSAL_glKillWnd(Fullscreen : Boolean);
procedure OSAL_UpdateWNDMessages;

Procedure OSAL_Sleep(TimeForSleep:integer);
Procedure OSAL_InitCounter;
Function  OSAL_GetCounterValue:int64;

const
  OSAL_MESSAGE_RESIZE = 0;  //wParam - Width, lParam - Height

var
  CALLBACK_MESSAGES: procedure(Msg:integer; wParam: integer; lParam: integer); extdecl;
implementation
uses Data;

var
  Keys:array[0..255] of boolean; //Key States array for X System
  MousePos:TPoint;
  WndX,WndY,WndWidth,WndHeight:integer;
 
function OSAL_GetScreenWidth: integer;                             //
begin
  {$ifdef win32}
  Result:=GetSystemMetrics(SM_CXSCREEN);
  {$else}
  Result:=XDisplayWidth(hXDisplay,0);
  {$endif}
end;

function OSAL_GetScreenHeight: integer;                            //
begin
  {$ifdef win32}
  Result:=GetSystemMetrics(SM_CYSCREEN);
  {$else}
  Result:=XDisplayHeight(hXDisplay,0);
  {$endif}
end;

Function OSAL_isKeyBoardLayoutRussian:boolean;                     //-
begin
  {$ifdef win32}
  Result:=($000000FF and (GetKeyboardLayout(0))) = LANG_RUSSIAN;
  {$else}
  Result:=false;
  {$endif}
end;

Function  OSAL_GetKeyState(Key:byte):boolean;                      //
begin
  {$ifdef win32}
  Result:=GetAsyncKeyState(Key) And $8000<>0;
  {$else}
  Result:=Keys[Key];
  {$endif}
end;

procedure OSAL_ShowMouse(Show: boolean);                           //--
begin
  {$ifdef win32}
  ShowCursor(Show);
  {$else}
  {$endif}
end;

Procedure OSAL_SetWorldMousePos(X,Y:integer);                      //           //Need Testing!
begin
  {$ifdef win32}
  SetCursorPos(X,Y);
  {$else}
  XWarpPointer(hXDisplay,0, hXWindow,0,0,0,0,X-WndX,Y-WndY);
  {$endif}
end;

Function  OSAL_GetWorldMousePos:TPoint;                            //
begin
  {$ifdef win32}
  GetCursorPos(Result);
  {$else}
  Result.X:=MousePos.X+WndX;
  Result.Y:=MousePos.Y+WndY;
  {$endif}
end;

Function  OSAL_GetWindowMousePos:TPoint;                           //
begin
  {$ifdef win32}
  GetCursorPos(Result);
  ScreenToClient(h_Wnd,Result);
  {$else}
  Result:=MousePos;
  {$endif}
end;


procedure OSAL_SetFocus();                                         //-
begin
  {$ifdef win32}
  SetFocus(h_Wnd);
  {$else}
  {$endif}
end;

procedure OSAL_SetForeground();                                    //-
begin
  {$ifdef win32}
  SetForegroundWindow(h_Wnd);
  {$else}
  {$endif}
end;

function OSAL_isOnFocus: boolean;                                  //-
begin
  {$ifdef win32}
  Result:= GetFocus = h_Wnd;
  {$else}
  Result:=true;
  {$endif}
end;

Function  OSAL_GetTextSize(const Text:string):TPoint;              //--
{$ifdef win32}
var
  Size:TSize;
begin
  GetTextExtentPoint32(h_Dc,PChar(Text),Length(Text),Size);
  Result.x:=Size.cx;
  Result.y:=Size.cy;
end;
{$else}
begin
  Result.x:=0;
  Result.y:=0;
end;
{$endif}

procedure OSAL_SwapBuffers;                                        //
begin
  {$ifdef win32}
  SwapBuffers(h_DC);
  {$else}
  glXSwapBuffers(hXDisplay, hXWindow);
  {$endif}
end;

procedure OSAL_ExecuteWebPage(const URL:String);                   //-
begin
  {$ifdef win32}
  ShellExecute(0,Pchar('open'),PChar(URL),nil,nil,SW_NORMAL);
  {$else}
  {$endif}
end;

procedure OSAL_ExecuteFile(const FileName: String);                //-
begin
  {$ifdef win32}
  ShellExecute(0,'open',PChar(FileName),'','',SW_SHOW);
  {$else}
  {$endif}
end;

procedure OSAL_ExecuteExe(const FileName, Param: String);          //-
begin
  {$ifdef win32}
  ShellExecute(0,'open',PChar(FileName),PChar(Param),'',SW_NORMAL);
  {$else}
  {$endif}
end;

function OSAL_GetWindowPos: TPoint;                                //-
{$ifdef win32}
var
  WndPlace:TWindowPlacement;
begin
  GetWindowPlacement(h_Wnd,@WndPlace);
  Result:=WndPlace.rcNormalPosition;
end;
{$else}
begin
  Result.X:=WndX;
  Result.Y:=WndY;
end;
{$endif}


{$ifdef win32}
procedure OSAL_glKillWnd(Fullscreen : Boolean);                    //-
begin
  if Fullscreen then
  begin
    ChangeDisplaySettings(devmode(nil^), 0);
    ShowCursor(True);
  end;

  if (not wglMakeCurrent(h_DC, 0)) then
   begin
    MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);
   end;

  if (not wglDeleteContext(h_RC)) then
  begin
    MessageBox(0, 'Release of rendering context failed!', 'Error', MB_OK or MB_ICONERROR);
    h_RC := 0;
  end;

  if ((h_DC > 0) and (ReleaseDC(h_Wnd, h_DC) = 0)) then
  begin
    MessageBox(0, 'Release of device context failed!', 'Error', MB_OK or MB_ICONERROR);
    h_DC := 0;
  end;

  if ((h_Wnd <> 0) and (not DestroyWindow(h_Wnd))) then
  begin
    MessageBox(0, 'Unable to destroy window!', 'Error', MB_OK or MB_ICONERROR);
    h_Wnd := 0;
  end;

  if (not Windows.UnRegisterClass('OpenGL', hInstance)) then
  begin
    MessageBox(0, 'Unable to unregister window class!', 'Error', MB_OK or MB_ICONERROR);
    //hInstance := 0;
  end;
end;
{$else}
procedure OSAL_glKillWnd(Fullscreen : Boolean);
begin
  glXDestroyContext(hXDisplay, hglXContext);
  XDestroyWindow(hXDisplay, hXWindow);
  XCloseDisplay(hXDisplay);
end;
{$endif}

procedure OSAL_UpdateWNDMessages;                                  //
{$ifdef win32}
var
  Msg:TMessage;
begin
  while (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) do begin
    if (msg.message = WM_QUIT) then
      finished := True
    else
    begin
      TranslateMessage(msg);
      DispatchMessage(msg);
    end;
  end;
end;
{$else}
var
  Event:TXEvent;
begin
  while XPending(hXDisplay)>0 do begin
    XNextEvent(hXDisplay, @Event);
    case Event._type of
      KeyPress:     begin
                      Keys[XLookupKeysym(@event, 0)]:=true;                 //Need Testing!
                    end;
      KeyRelease:   begin
                      Keys[XLookupKeysym(@event, 0)]:=false;                //Need Testing!
                    end;
      ButtonPress:  begin
                      case event.xbutton.button of                          //Need Testing!
                        0:Keys[1]:=true;
                        1:Keys[2]:=true;
                        2:Keys[3]:=true;
                      end;
                    end;
      ButtonRelease:begin
                      case event.xbutton.button of                          //Need Testing!
                        0:Keys[1]:=false;
                        1:Keys[2]:=false;
                        2:Keys[3]:=false;
                      end;
                    end;
      MotionNotify: begin
                      MousePos.X:=Event.xmotion.x;
                      MousePos.Y:=Event.xmotion.y;
                    end;
      ConfigureNotify:begin
                      CALLBACK_MESSAGES(OSAL_MESSAGE_RESIZE,Event.xconfigure.width,Event.xconfigure.height);
                      WndX:=Event.xconfigure.x;
                      WndY:=Event.xconfigure.y;
                      WndWidth:=Event.xconfigure.width;
                      WndHeight:=Event.xconfigure.height;
                    end;
    end;
  end;
end;

procedure OSAL_Sleep(TimeForSleep: integer);                       //
begin
  {$ifdef win32}
  Sleep(TimeForSleep);
  {$else}
  usleep(TimeForSleep);
  {$endif}
end;

var
  TimerFreq:int64;


Procedure OSAL_InitCounter;                                        //
begin
  {$ifdef win32}
  QueryPerformanceFrequency(TimerFreq);
  TimerFreq:=TimerFreq div 1000;
  {$else}
  {$endif}
end;

function OSAL_GetCounterValue: int64;                              //
{$ifdef win32}
begin
  QueryPerformanceCounter(Result);
  Result:=Result div TimerFreq;
end;
{$else}
var
  tp:Ttimeval;
  tpz:Ttimezone;
begin
  gettimeofday(@tp,@tpz);
  Result:=tp.tv_usec;
end;
{$endif}

Procedure OSAL_CopyMemory(Dst,Src:Pointer; Length:integer);        //
begin
  {$ifdef win32}
  CopyMemory(Dst,Src,Length);
  {$else}
  memcpy(Dst,Src,Length);
  {$endif}
end;

procedure OSAL_ZeroMemory(Dst: Pointer; Length: integer);          //
begin
  {$ifdef win32}
  ZeroMemory(Dst,Length);
  {$else}
  memset(Dst,0,Length);
  {$endif}
end;

{$endif}

Procedure OSAL_SetWindowText(const Text:String);                   //
{$ifdef win32}
begin
  SetWindowText(h_Wnd,PChar(Text));
end;
{$else}
var
  window_title_property: TXTextProperty;
begin
  XStringListToTextProperty(@Text,1,@window_title_property);
  XSetWMName(hXDisplay,hXWindow,@window_title_property);
end;
{$endif}



{$ifdef win32}
function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  case (Msg) of
    WM_CLOSE:
      begin
        PostQuitMessage(0);
        Result := 1;
      end;
{    WM_ACCEPT:
      begin
        if LanServer<>nil then
          Result:=LanServer.WMSERVER(hWnd,Msg,WParam, LParam)
        else
          Result := 0;
      end;
    WM_SERVER:
      begin
        if LanServer<>nil then
          Result:=LanServer.WMSCLIENT(hWnd,Msg,WParam, LParam)
        else
          Result := 0;
      end;
    WM_CLIENT:
      begin
        if LanClient<>nil then
          Result:=LanClient.WMCLIENT(hWnd,Msg,WParam, LParam)
        else
          Result := 0;
      end;    }
    WM_SIZE:
      begin
        CALLBACK_MESSAGES(OSAL_MESSAGE_RESIZE,LOWORD(lParam),HIWORD(lParam));
        Result := 0;
      end;
    else
      Result := DefWindowProc(hWnd, Msg, wParam, lParam);
  end;
end;


function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer; const Title:string) : Boolean;
var
  wndClass : TWndClass;         // Window class
  dwStyle : DWORD;              // Window styles
  dwExStyle : DWORD;            // Extended window styles
  dmScreenSettings : DEVMODE;   // Screen settings (fullscreen, etc...)
  PixelFormat : GLuint;         // Settings for the OpenGL rendering
  h_Instance : HINST;           // Current instance
  pfd : TPIXELFORMATDESCRIPTOR;  // Settings for the OpenGL window
begin
  h_Instance := GetModuleHandle(nil);       //Grab An Instance For Our Window
  ZeroMemory(@wndClass, SizeOf(wndClass));  // Clear the window class structure

  with wndClass do                    // Set up the window class
  begin
    style         := CS_HREDRAW or    // Redraws entire window if length changes
                     CS_VREDRAW or    // Redraws entire window if height changes
                     CS_OWNDC;        // Unique device context for the window
    lpfnWndProc   := @WndProc;        // Set the window procedure to our func WndProc
    hInstance     := h_Instance;
    hCursor       := LoadCursor(0, IDC_ARROW);
    hIcon         := LoadIcon(h_Instance,'MAINICON');
    lpszClassName := 'OpenGL';
  end;

  if (Windows.RegisterClass(wndClass) = 0) then  // Attemp to register the window class
  begin
    MessageBox(0, 'Failed to register the window class!', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit
  end;

  if Fullscreen then
  begin
    ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
    with dmScreenSettings do begin              // Set parameters for the screen setting
      dmSize       := SizeOf(dmScreenSettings);
      dmPelsWidth  := Width;                    // Window width
      dmPelsHeight := Height;                   // Window height
      dmBitsPerPel := PixelDepth;               // Window color depth
      dmFields     := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;
    end;

    if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
    begin
      MessageBox(0, 'Unable to switch to fullscreen!', 'Error', MB_OK or MB_ICONERROR);
      Fullscreen := False;
    end;

  end;

  if (Fullscreen) then
  begin
    dwStyle := WS_POPUP or                // Creates a popup window
               WS_CLIPCHILDREN            // Doesn't draw within child windows
               or WS_CLIPSIBLINGS;        // Doesn't draw within sibling windows
    dwExStyle := WS_EX_APPWINDOW or WS_EX_TOPMOST;         // Top level window
  end
  else
  begin
    dwStyle :=    // Creates an overlapping window
               WS_CLIPCHILDREN or         // Doesn't draw within child windows
               WS_CLIPSIBLINGS or WS_SYSMENU or WS_MINIMIZEBOX{ or            // Doesn't draw within sibling windows
               WS_POPUP};
    dwExStyle := WS_EX_APPWINDOW;{ or       // Top level window
                 WS_EX_WINDOWEDGE;        // Border with a raised edge}
  end;

  h_Wnd := CreateWindowEx(dwExStyle,      // Extended window styles
                          'OpenGL',       // Class name
                          PChar(Title),      // Window title (caption)
                          dwStyle,        // Window styles
                          0, 0,           // Window position
                          Width, Height,  // Size of window
                          0,              // No parent window
                          0,              // No menu
                          h_Instance,     // Instance
                          nil);           // Pass nothing to WM_CREATE
  if h_Wnd = 0 then
  begin
    glKillWnd(Fullscreen);                // Undo all the settings we've changed
    MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;


  h_DC := GetDC(h_Wnd);
  if (h_DC = 0) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;

  with pfd do
  begin
    nSize           := SizeOf(TPIXELFORMATDESCRIPTOR); // Size Of This Pixel Format Descriptor
    nVersion        := 1;                    // The version of this data structure
    dwFlags         := PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER or PFD_GENERIC_ACCELERATED;  // Supports double buffering
    iPixelType      := PFD_TYPE_RGBA;        // RGBA color format
    cColorBits      := PixelDepth;           // OpenGL color depth
    cRedBits        := 0;                    // Number of red bitplanes
    cRedShift       := 0;                    // Shift count for red bitplanes
    cGreenBits      := 0;                    // Number of green bitplanes
    cGreenShift     := 0;                    // Shift count for green bitplanes
    cBlueBits       := 0;                    // Number of blue bitplanes
    cBlueShift      := 0;                    // Shift count for blue bitplanes
    cAlphaBits      := 0;                    // Not supported
    cAlphaShift     := 0;                    // Not supported
    cAccumBits      := 0;                    // No accumulation buffer
    cAccumRedBits   := 0;                    // Number of red bits in a-buffer
    cAccumGreenBits := 0;                    // Number of green bits in a-buffer
    cAccumBlueBits  := 0;                    // Number of blue bits in a-buffer
    cAccumAlphaBits := 0;                    // Number of alpha bits in a-buffer
    cDepthBits      := 8;                   // Specifies the depth of the depth buffer
    cStencilBits    := 32;                    // Turn off stencil buffer
    cAuxBuffers     := 0;                    // Not supported
    iLayerType      := PFD_MAIN_PLANE;       // Ignored
    bReserved       := 0;                    // Number of overlay and underlay planes
    dwLayerMask     := 0;                    // Ignored
    dwVisibleMask   := 0;                    // Transparent color of underlay plane
    dwDamageMask    := 0;                     // Ignored
  end;

  PixelFormat := ChoosePixelFormat(h_DC, @pfd);
  if (PixelFormat = 0) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;

  if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;

  h_RC := wglCreateContext(h_DC);
  if (h_RC = 0) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;

  if (not wglMakeCurrent(h_DC, h_RC)) then
  begin
    glKillWnd(Fullscreen);
    MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
    Result := False;
    Exit;
  end;

  //SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, nil);

  ShowWindow(h_Wnd, SW_SHOW);
  SetForegroundWindow(h_Wnd);
  SetFocus(h_Wnd);

  glResizeWnd(Width, Height);

  Result := True;
end;
{$else}
function OSAL_glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer; const Title:string) : Boolean;
var
  errorBase,eventBase: integer;
  Attr: Array[0..8] of integer = (GLX_RGBA,GLX_RED_SIZE,1,GLX_GREEN_SIZE,1,GLX_BLUE_SIZE,1,GLX_DOUBLEBUFFER,no
ne);
  cm: TColormap;
  winAttr: TXSetWindowAttributes;
  window_title_property: TXTextProperty;
begin
  initGlx();
  hXDisplay := XOpenDisplay(nil);
  if(hXDisplay = nil) then
  writeLn('Error: Could not connect to X server');

  if not (glXQueryExtension(hXDisplay,errorBase,eventBase)) then
  writeLn('Error: GLX extension not supported');

  hXVisualInfo := glXChooseVisual(hXDisplay,DefaultScreen(hXDisplay), Attr);
  if(hXVisualInfo = nil) then
  writeLn('Error: Could not find visual');
 
  //Create a new colormap
  cm := XCreateColormap(hXDisplay,RootWindow(hXDisplay,hXVisualInfo.screen),hXVisualInfo.visual,AllocNone);
  winAttr.colormap := cm;
  winAttr.border_pixel := 0;
  winAttr.background_pixel := 0;
  winAttr.event_mask := KeyPressMask or KeyReleaseMask or ButtonPressMask or ButtonReleaseMask or PointerMotionMask or StructureNotifyMask;
 
  //Create a window
  hXWindow := XCreateWindow(hXDisplay,RootWindow(hXDisplay,hXVisualInfo.screen),0,0,Width,Height,0,hXVisualInfo.depth,InputOutput,hXVisualInfo.visual,CWBor
derPixel or CWColormap or CWEventMask,@winAttr);
 
  OSAL_SetWindowText(Title);

  //Create an OpenGL rendering context
  hglXContext := glXCreateContext(hXDisplay,hXVisualInfo,none,true);
  if(hglXContext = nil) then
  writeLn('Error: Could not create an OpenGL rendering context');

  //Make it current
  glXMakeCurrent(hXDisplay,hXWindow,hglXContext);

  //Map the window on the display
  XMapWindow(hXDisplay,hXWindow);
end;
{$endif}

{$ifdef win32}
type

TWindowInfo = packed record
   cbSize: DWORD;
   rcWindow: TRect;
   rcClient: TRect;
   dwStyle: DWORD;
   dwExStyle: DWORD;
   dwOtherStuff: DWORD;
   cxWindowBorders: uInt;
   cyWindowBorders: uInt;
   atomWindowType: TAtom;
   wCreatorVersion: WORD;
end;}

function GetWindowInfo(hwnd: HWND; var pwi: TWindowInfo): BOOL; stdcall; external 'user32.dll' name 'GetWindowInfo';
{$endif}

function OSAL_GetWindowClientSize: TPoint;                           //-
{$ifdef win32}
var
  Info:TWindowInfo;
begin
  GetWindowInfo(h_Wnd,Info);
  Result.X:=Info.Info.rcClient.Right;
  Result.Y:=Info.rcClient.Bottom-Info.rcClient.Top;
end;
{$else}
begin
  Result.X:=ScreenWidth;
  Result.Y:=ScreenHeight;
end;
{$endif}

procedure OSAL_SetWindowPos(X,Y, Width, Height: integer);            //-
{$ifdef win32}
begin
  SetWindowPos(h_Wnd,HWND_TOP,X,Y, Width, Height,SWP_NOZORDER);
end;
{$else}
var
  wndAttr:TXWindowAttributes;
begin
  wndAttr.x:=X;
  wndAttr.y:=Y;
  wndAttr.width:=Width;
  wndAttr.height:=Height;
  XChangeWindowAttributes(hXDisplay,hXWindow,CWX or CWY or CWWidth or CWHeight,@wndAttr);
end;
{$endif}

end.

Код: Выделить всё
@!!ex
новенький
 
Сообщения: 35
Зарегистрирован: 12.04.2008 11:55:32

Сообщение Mirage » 25.04.2008 13:11:56

Procedure OSAL_CopyMemory(Dst,Src:Pointer; Length:integer);
Procedure OSAL_ZeroMemory(Dst:Pointer; Length:integer);


Для этого есть процедуры Move()/FillChar(). В отличие от всяких zeromemory кроссплатформенны и оптимизированны.

Еще можешь глянуть мой OsUtils ( http://www.casteng.com/cast2docs/OSUtils.htm ) - там правда пока только для Win32 реализация.
Mirage
энтузиаст
 
Сообщения: 881
Зарегистрирован: 06.05.2005 20:29:07
Откуда: Russia

Сообщение @!!ex » 25.04.2008 13:15:19

Еще можешь глянуть мой OsUtils ( http://www.casteng.com/cast2docs/OSUtils.htm ) - там правда пока только для Win32 реализация.

Win32 я знаю.. Вот если бы там было для Linux... :)
@!!ex
новенький
 
Сообщения: 35
Зарегистрирован: 12.04.2008 11:55:32

Сообщение halyavin » 25.04.2008 16:19:02

SDL же вроде делает ровно то же самое. Лучше к нему переходники напишите или объектный интерфейс придумайте.
halyavin
новенький
 
Сообщения: 25
Зарегистрирован: 23.10.2007 16:35:55

Сообщение @!!ex » 25.04.2008 16:30:47

Чем SDL лучше?
Интересно, почему ни один коммерческий проект SDL Не использует? :)
а объектный интерфейс нафиг?
@!!ex
новенький
 
Сообщения: 35
Зарегистрирован: 12.04.2008 11:55:32

Сообщение NXP » 25.04.2008 17:58:27

@!!ex писал(а):Чем SDL лучше?
Интересно, почему ни один коммерческий проект SDL Не использует? :)

А чем SDL хуже?
Не используют потому, что просто лень что-то менять. Необходимости в этом нет. Зато почти все GNUтые используют :D
Путевая обертка для SDL - действительно хорошая мысля :wink:
@!!ex писал(а):а объектный интерфейс нафиг?

Не помешало бы полностью кросс-платформировать KOL (xlib + Wingdi), так чтобы девелопать без бубна + добавить KOL (заместо LCL) режим для лазаря, чтобы без левых классов и макросов плясать с KOL
Аватара пользователя
NXP
постоялец
 
Сообщения: 187
Зарегистрирован: 02.01.2008 16:11:56
Откуда: Воронеж

Сообщение @!!ex » 25.04.2008 18:07:10

А чем SDL хуже?

Например тем, что тащит с собой кучу ненужного хлама. Тем, что не прозрачен в использовании.

Не используют потому, что просто лень что-то менять.

Потому что незачем, :))

Необходимости в этом нет.

Также фигня.

Зато почти все GNUтые используют

действительно серьезные - вроде не используют.

Обертка для SDL - действительно хорошая мысля

Обертка для обертки? :))
@!!ex
новенький
 
Сообщения: 35
Зарегистрирован: 12.04.2008 11:55:32

Сообщение FedeX » 26.04.2008 10:18:20

SDL использует немало проффесиональных проектов, и не только игровых (я не держу всех в памяти, но хотябы такие названия как хоррор Penumbra(кажеться так пишеться),трёхмерный редактор Blender, сетевой екшн Nexuiz, кроссплатформенный эмулятор доса DosBox, Total Video Converter и пр.). SDL юзают именно потому, что он стабильный и многофункциональный (если учитывать все дополнительные библиотеки). Хедеры его к ФриПаскалю имеються, а обьектная обёртка ИМХО действительно не нужна. Хотя написать такую - дело не сложное.
Что же касаеться кроссплатформенных функциональных (а не как здесь - только создание уничтожение окон) OpenGL движков для ФриПаскаля, то их тоже ужо пруд пруди (GLScene, Omega Engine, а на Source Forge я недавно вообще с десяток таких нашол). Я для себя тож кое-что такое написал... Так что идея очень не нова :wink:
Аватара пользователя
FedeX
постоялец
 
Сообщения: 422
Зарегистрирован: 27.03.2006 09:25:34
Откуда: украина, житомир

Сообщение @!!ex » 26.04.2008 11:14:56

Движков дохрена а проектов чего-то нету...
Практически все что я видел - находится между стабильной альфы - нестабильной демы.
@!!ex
новенький
 
Сообщения: 35
Зарегистрирован: 12.04.2008 11:55:32

Сообщение @!!ex » 26.04.2008 11:16:10

Что касается кроссплатформенной функциональности - то она не нужна.
Все взаимодействие с системой сводится к работе с вводом/выводом. И нафиг сюда прикручивать кучу хлама - нипанятна.
@!!ex
новенький
 
Сообщения: 35
Зарегистрирован: 12.04.2008 11:55:32

Сообщение FedeX » 27.04.2008 14:25:35

Я о том, что нет смысла выкладывать абсолютно сырой модуль, который написать - пол часа дело :wink:
Аватара пользователя
FedeX
постоялец
 
Сообщения: 422
Зарегистрирован: 27.03.2006 09:25:34
Откуда: украина, житомир


Вернуться в Free Pascal Compiler

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 3

Рейтинг@Mail.ru
cron