API tools faq
paste
Advertisement
snake5

wip opengl demo in temp lang v2

snake5
Jun 30th, 2017
395
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Lisp 8.35 KB | None | 0 0
raw download clone embed print report
  1.  
  2. (class RECT
  3.     (var left i32)
  4.     (var top i32)
  5.     (var right i32)
  6.     (var bottom i32)
  7. )
  8. (class WNDCLASS
  9.     (var style u32)             // UINT
  10.     (var lpfnWndProc intptr)    // WNDPROC
  11.     (var cbClsExtra i32)        // INT
  12.     (var cbWndExtra i32)        // INT
  13.     (var hInstance intptr)      // HINSTANCE
  14.     (var hIcon intptr)          // HICON
  15.     (var hCursor intptr)        // HCURSOR
  16.     (var hbrBackground intptr)  // HBRUSH
  17.     (var lpszMenuName intptr)   // LPCTSTR
  18.     (var lpszClassName intptr)  // LPCTSTR
  19. )
  20. (class POINT
  21.     (var x i32)
  22.     (var y i32)
  23. )
  24. (class MSG
  25.     (var hwnd intptr)   // HWND hwnd
  26.     (var message u32)   // UINT message
  27.     (var wParam intptr) // WPARAM wParam
  28.     (var lParam intptr) // LPARAM lParam
  29.     (var time u32)      // DWORD time
  30.     (var pt POINT)      // POINT pt
  31. )
  32. (class PIXELFORMATDESCRIPTOR
  33.     (var nSize u16)          // WORD
  34.     (var nVersion u16)       // WORD
  35.     (var dwFlags u32)        // DWORD
  36.     (var iPixelType u8)      // BYTE
  37.     (var cColorBits u8)      // BYTE
  38.     (var cRedBits u8)        // BYTE
  39.     (var cRedShift u8)       // BYTE
  40.     (var cGreenBits u8)      // BYTE
  41.     (var cGreenShift u8)     // BYTE
  42.     (var cBlueBits u8)       // BYTE
  43.     (var cBlueShift u8)      // BYTE
  44.     (var cAlphaBits u8)      // BYTE
  45.     (var cAlphaShift u8)     // BYTE
  46.     (var cAccumBits u8)      // BYTE
  47.     (var cAccumRedBits u8)   // BYTE
  48.     (var cAccumGreenBits u8) // BYTE
  49.     (var cAccumBlueBits u8)  // BYTE
  50.     (var cAccumAlphaBits u8) // BYTE
  51.     (var cDepthBits u8)      // BYTE
  52.     (var cStencilBits u8)    // BYTE
  53.     (var cAuxBuffers u8)     // BYTE
  54.     (var iLayerType u8)      // BYTE
  55.     (var bReserved u8)       // BYTE
  56.     (var dwLayerMask u32)    // DWORD
  57.     (var dwVisibleMask u32)  // DWORD
  58.     (var dwDamageMask u32)   // DWORD
  59. )
  60.  
  61. (impfunc GetModuleHandleA
  62.     (conv stdcall)
  63.     (ret intptr)
  64.     (arg intptr)
  65. )
  66. (impfunc MessageBoxA
  67.     (conv stdcall)
  68.     (ret i32)
  69.     (arg intptr)
  70.     (arg intptr)
  71.     (arg intptr)
  72.     (arg u32)
  73. )
  74. (impfunc DefWindowProcA
  75.     (conv stdcall)
  76.     (ret intptr) // LRESULT
  77.     (arg intptr) // HWND
  78.     (arg u32)    // UINT msg
  79.     (arg intptr) // WPARAM
  80.     (arg intptr) // LPARAM
  81. )
  82. (impfunc RegisterClassA
  83.     (conv stdcall)
  84.     (ret u16)    // ATOM
  85.     (arg intptr) // LPWNDCLASS
  86. )
  87. (impfunc AdjustWindowRectEx
  88.     (conv stdcall)
  89.     (ret i32)    // BOOL
  90.     (arg intptr) // LPRECT lpRect
  91.     (arg u32)    // DWORD  dwStyle
  92.     (arg i32)    // BOOL   bMenu
  93.     (arg u32)    // DWORD  dwExStyle
  94. )
  95. (impfunc CreateWindowExA
  96.     (conv stdcall)
  97.     (ret intptr) // HWND
  98.     (arg i32)    // DWORD     dwExStyle
  99.     (arg intptr) // LPCTSTR   lpClassName
  100.     (arg intptr) // LPCTSTR   lpWindowName
  101.     (arg i32)    // DWORD     dwStyle
  102.     (arg i32)    // int       x
  103.     (arg i32)    // int       y
  104.     (arg i32)    // int       nWidth
  105.     (arg i32)    // int       nHeight
  106.     (arg intptr) // HWND      hWndParent
  107.     (arg intptr) // HMENU     hMenu
  108.     (arg intptr) // HINSTANCE hInstance
  109.     (arg intptr) // LPVOID    lpParam
  110. )
  111. (impfunc ShowWindow
  112.     (conv stdcall)
  113.     (ret i32)    // BOOL
  114.     (arg intptr) // HWND hWnd
  115.     (arg i32)    // int show
  116. )
  117. (impfunc PeekMessageA
  118.     (conv stdcall)
  119.     (ret i32)    // BOOL
  120.     (arg intptr) // LPMSG lpMsg
  121.     (arg intptr) // HWND hWnd
  122.     (arg u32)    // UINT wMsgFilterMin
  123.     (arg u32)    // UINT wMsgFilterMax
  124.     (arg u32)    // UINT wRemoveMsg
  125. )
  126. (impfunc TranslateMessage
  127.     (conv stdcall)
  128.     (ret i32)    // BOOL
  129.     (arg intptr) // LPMSG lpMsg
  130. )
  131. (impfunc DispatchMessageA
  132.     (conv stdcall)
  133.     (ret i32)    // LONG
  134.     (arg intptr) // LPMSG lpMsg
  135. )
  136. (impfunc PostQuitMessage
  137.     (conv stdcall)
  138.     (ret void)
  139.     (arg i32) // int
  140. )
  141. (impfunc LoadIconA
  142.     (conv stdcall)
  143.     (ret intptr) // HICON
  144.     (arg intptr) // HINSTANCE
  145.     (arg intptr) // LPCTSTR
  146. )
  147. (impfunc LoadCursorA
  148.     (conv stdcall)
  149.     (ret intptr) // HCURSOR
  150.     (arg intptr) // HINSTANCE
  151.     (arg intptr) // LPCTSTR
  152. )
  153. (impfunc GetDC
  154.     (conv stdcall)
  155.     (ret intptr) // HDC
  156.     (arg intptr) // HWND hWnd
  157. )
  158. (impfunc ChoosePixelFormat
  159.     (conv stdcall)
  160.     (ret u32)    // GLuint
  161.     (arg intptr) // HDC
  162.     (arg intptr) // PIXELFORMATDESCRIPTOR*
  163. )
  164. (impfunc SetPixelFormat
  165.     (conv stdcall)
  166.     (ret i32)    // BOOL
  167.     (arg intptr) // HDC
  168.     (arg u32)    // GLuint pixelFormat
  169.     (arg intptr) // PIXELFORMATDESCRIPTOR*
  170. )
  171. (impfunc wglCreateContext
  172.     (conv stdcall)
  173.     (ret intptr) // HGLRC
  174.     (arg intptr) // HDC
  175. )
  176. (impfunc wglMakeCurrent
  177.     (conv stdcall)
  178.     (ret i32)    // BOOL
  179.     (arg intptr) // HDC
  180.     (arg intptr) // HGLRC
  181. )
  182.  
  183. (impfunc print (ret void) (arg string))
  184.  
  185. (func WndProc
  186.     (conv stdcall)
  187.     (ret intptr)        // LRESULT
  188.     (arg intptr hwnd)   // HWND
  189.     (arg u32    uMsg)   // UINT msg
  190.     (arg intptr wParam) // WPARAM
  191.     (arg intptr lParam) // LPARAM
  192.     (body
  193.         (if (eq uMsg 16) (block /* WM_CLOSE */
  194.             (call PostQuitMessage 0)
  195.             (return 0)
  196.         ))
  197.         (return (call DefWindowProcA hwnd uMsg wParam lParam))
  198.     )
  199. )
  200.  
  201. (class OpenGLWindow
  202.    
  203.     (var hInstance intptr (call GetModuleHandleA null))
  204.     (var hWnd intptr)
  205.     (var hDC intptr)
  206.     (var hRC intptr)
  207.    
  208.     (func __construct (body
  209.         (var wc (call WNDCLASS))
  210.         (set (getprop wc style) 0x23)             /* CS_HREDRAW | CS_VREDRAW | CS_OWNDC */
  211.         (set (getprop wc lpfnWndProc) WndProc)
  212.         (set (getprop wc hInstance) hInstance)
  213.         (set (getprop wc hIcon) (call LoadIconA null (cast intptr 32517))) /* IDI_WINLOGO */
  214.         (set (getprop wc hCursor) (call LoadCursorA null (cast intptr 32512))) /* IDC_ARROW */
  215.         (set (getprop wc lpszClassName) (getprop "OpenGLWndClass" cStringPtr))
  216.         (if (not (call RegisterClassA wc))
  217.             (block
  218.                 (call MessageBoxA null (getprop "Failed to register the window class" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
  219.                 (return)
  220.             )
  221.         )
  222.        
  223.         (var dwExStyle 0x40100) /* WS_EX_APPWINDOW | WS_EX_WINDOWEDGE */
  224.         (var dwStyle 0xCA0000) /* WS_CAPTION | WS_SYSMENU | WS_MINIMIZEBOX */
  225.         (var windowRect (call RECT))
  226.         (set (getprop windowRect right) 1024)
  227.         (set (getprop windowRect bottom) 768)
  228.         (call AdjustWindowRectEx windowRect dwStyle false dwExStyle)
  229.        
  230.         // Create The Window
  231.         (set hWnd (call CreateWindowExA
  232.             dwExStyle
  233.             (getprop "OpenGLWndClass" cStringPtr)
  234.             (getprop "OpenGL Example" cStringPtr)
  235.             dwStyle
  236.             0x80000000 // CW_USEDEFAULT
  237.             0x80000000 // CW_USEDEFAULT
  238.             (sub (getprop windowRect right) (getprop windowRect left))
  239.             (sub (getprop windowRect bottom) (getprop windowRect top))
  240.             null
  241.             null
  242.             hInstance
  243.             null
  244.         ))
  245.         (if (not hWnd)
  246.             (block
  247.                 (call MessageBoxA null (getprop "Failed to create a window" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
  248.                 (return)
  249.             )
  250.         )
  251.        
  252.         (var pfd (call PIXELFORMATDESCRIPTOR))
  253.         (set (getprop pfd nSize) (getprop (typeof pfd) size))
  254.         (set (getprop pfd nVersion) 1)
  255.         (set (getprop pfd dwFlags) 0x25) /* PFD_DRAW_TO_WINDOW | PFD_SUPPORT_OPENGL | PFD_DOUBLEBUFFER */
  256.         (set (getprop pfd iPixelType) 0) /* PFD_TYPE_RGBA */
  257.         (set (getprop pfd cColorBits) 24)
  258.         (set (getprop pfd cDepthBits) 16)
  259.         (set (getprop pfd iLayerType) 0) /* PFD_MAIN_PLANE */
  260.        
  261.         (set hDC (call GetDC hWnd))
  262.         (if (not hDC)
  263.             (block
  264.                 (call MessageBoxA null (getprop "Can't create an OpenGL device context" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
  265.                 (return)
  266.             )
  267.         )
  268.        
  269.         (var pixelFormat (call ChoosePixelFormat hDC pfd))
  270.         (if (not pixelFormat)
  271.             (block
  272.                 (call MessageBoxA null (getprop "Can't find a suitable pixel format" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
  273.                 (return)
  274.             )
  275.         )
  276.         (if (not (call SetPixelFormat hDC pixelFormat pfd))
  277.             (block
  278.                 (call MessageBoxA null (getprop "Can't set the pixel format" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
  279.                 (return)
  280.             )
  281.         )
  282.        
  283.         (set hRC (call wglCreateContext hDC))
  284.         (if (not hRC)
  285.             (block
  286.                 (call MessageBoxA null (getprop "Can't create the OpenGL context" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
  287.                 (return)
  288.             )
  289.         )
  290.         (if (not (call wglMakeCurrent hDC hRC))
  291.             (block
  292.                 (call MessageBoxA null (getprop "Can't set OpenGL context as current" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
  293.                 (return)
  294.             )
  295.         )
  296.        
  297.         // ...
  298.        
  299.         (call ShowWindow hWnd 5) /* SW_SHOW */
  300.     ))
  301. )
  302.  
  303. (func main
  304.     (ret void)
  305.     (body
  306.         (var window (call OpenGLWindow))
  307.        
  308.         (var msg (call MSG))
  309.         (var done false)
  310.         (while (not done) (block
  311.             (while (call PeekMessageA msg null 0 0 1) (block /* PM_REMOVE */
  312.                 (if (eq (getprop msg message) 18) (block /* WM_QUIT */
  313.                     (set done true)
  314.                 ))
  315.                 (call TranslateMessage msg)
  316.                 (call DispatchMessageA msg)
  317.             ))
  318.         ))
  319.     )
  320. )
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!