snake5 icon

wip opengl demo in temp lang v2

snake5 | PRO | 06/30/17 07:09:09 AM UTC | 0 ⭐ | 8970 👁️ | Never ⏰ | []
Lisp |

8.35 KB

|

None

|

0 👍

/

0 👎

 
(class RECT
    (var left i32)
    (var top i32)
    (var right i32)
    (var bottom i32)
)
(class WNDCLASS
    (var style u32)             // UINT
    (var lpfnWndProc intptr)    // WNDPROC
    (var cbClsExtra i32)        // INT
    (var cbWndExtra i32)        // INT
    (var hInstance intptr)      // HINSTANCE
    (var hIcon intptr)          // HICON
    (var hCursor intptr)        // HCURSOR
    (var hbrBackground intptr)  // HBRUSH
    (var lpszMenuName intptr)   // LPCTSTR
    (var lpszClassName intptr)  // LPCTSTR
)
(class POINT
    (var x i32)
    (var y i32)
)
(class MSG
    (var hwnd intptr)   // HWND hwnd
    (var message u32)   // UINT message
    (var wParam intptr) // WPARAM wParam
    (var lParam intptr) // LPARAM lParam
    (var time u32)      // DWORD time
    (var pt POINT)      // POINT pt
)
(class PIXELFORMATDESCRIPTOR
    (var nSize u16)          // WORD
    (var nVersion u16)       // WORD
    (var dwFlags u32)        // DWORD
    (var iPixelType u8)      // BYTE
    (var cColorBits u8)      // BYTE
    (var cRedBits u8)        // BYTE
    (var cRedShift u8)       // BYTE
    (var cGreenBits u8)      // BYTE
    (var cGreenShift u8)     // BYTE
    (var cBlueBits u8)       // BYTE
    (var cBlueShift u8)      // BYTE
    (var cAlphaBits u8)      // BYTE
    (var cAlphaShift u8)     // BYTE
    (var cAccumBits u8)      // BYTE
    (var cAccumRedBits u8)   // BYTE
    (var cAccumGreenBits u8) // BYTE
    (var cAccumBlueBits u8)  // BYTE
    (var cAccumAlphaBits u8) // BYTE
    (var cDepthBits u8)      // BYTE
    (var cStencilBits u8)    // BYTE
    (var cAuxBuffers u8)     // BYTE
    (var iLayerType u8)      // BYTE
    (var bReserved u8)       // BYTE
    (var dwLayerMask u32)    // DWORD
    (var dwVisibleMask u32)  // DWORD
    (var dwDamageMask u32)   // DWORD
)
 
(impfunc GetModuleHandleA
    (conv stdcall)
    (ret intptr)
    (arg intptr)
)
(impfunc MessageBoxA
    (conv stdcall)
    (ret i32)
    (arg intptr)
    (arg intptr)
    (arg intptr)
    (arg u32)
)
(impfunc DefWindowProcA
    (conv stdcall)
    (ret intptr) // LRESULT
    (arg intptr) // HWND
    (arg u32)    // UINT msg
    (arg intptr) // WPARAM
    (arg intptr) // LPARAM
)
(impfunc RegisterClassA
    (conv stdcall)
    (ret u16)    // ATOM
    (arg intptr) // LPWNDCLASS
)
(impfunc AdjustWindowRectEx
    (conv stdcall)
    (ret i32)    // BOOL
    (arg intptr) // LPRECT lpRect
    (arg u32)    // DWORD  dwStyle
    (arg i32)    // BOOL   bMenu
    (arg u32)    // DWORD  dwExStyle
)
(impfunc CreateWindowExA
    (conv stdcall)
    (ret intptr) // HWND
    (arg i32)    // DWORD     dwExStyle
    (arg intptr) // LPCTSTR   lpClassName
    (arg intptr) // LPCTSTR   lpWindowName
    (arg i32)    // DWORD     dwStyle
    (arg i32)    // int       x
    (arg i32)    // int       y
    (arg i32)    // int       nWidth
    (arg i32)    // int       nHeight
    (arg intptr) // HWND      hWndParent
    (arg intptr) // HMENU     hMenu
    (arg intptr) // HINSTANCE hInstance
    (arg intptr) // LPVOID    lpParam
)
(impfunc ShowWindow
    (conv stdcall)
    (ret i32)    // BOOL
    (arg intptr) // HWND hWnd
    (arg i32)    // int show
)
(impfunc PeekMessageA
    (conv stdcall)
    (ret i32)    // BOOL
    (arg intptr) // LPMSG lpMsg
    (arg intptr) // HWND hWnd
    (arg u32)    // UINT wMsgFilterMin
    (arg u32)    // UINT wMsgFilterMax
    (arg u32)    // UINT wRemoveMsg
)
(impfunc TranslateMessage
    (conv stdcall)
    (ret i32)    // BOOL
    (arg intptr) // LPMSG lpMsg
)
(impfunc DispatchMessageA
    (conv stdcall)
    (ret i32)    // LONG
    (arg intptr) // LPMSG lpMsg
)
(impfunc PostQuitMessage
    (conv stdcall)
    (ret void)
    (arg i32) // int
)
(impfunc LoadIconA
    (conv stdcall)
    (ret intptr) // HICON
    (arg intptr) // HINSTANCE
    (arg intptr) // LPCTSTR
)
(impfunc LoadCursorA
    (conv stdcall)
    (ret intptr) // HCURSOR
    (arg intptr) // HINSTANCE
    (arg intptr) // LPCTSTR
)
(impfunc GetDC
    (conv stdcall)
    (ret intptr) // HDC
    (arg intptr) // HWND hWnd
)
(impfunc ChoosePixelFormat
    (conv stdcall)
    (ret u32)    // GLuint
    (arg intptr) // HDC
    (arg intptr) // PIXELFORMATDESCRIPTOR*
)
(impfunc SetPixelFormat
    (conv stdcall)
    (ret i32)    // BOOL
    (arg intptr) // HDC
    (arg u32)    // GLuint pixelFormat
    (arg intptr) // PIXELFORMATDESCRIPTOR*
)
(impfunc wglCreateContext
    (conv stdcall)
    (ret intptr) // HGLRC
    (arg intptr) // HDC
)
(impfunc wglMakeCurrent
    (conv stdcall)
    (ret i32)    // BOOL
    (arg intptr) // HDC
    (arg intptr) // HGLRC
)
 
(impfunc print (ret void) (arg string))
 
(func WndProc
    (conv stdcall)
    (ret intptr)        // LRESULT
    (arg intptr hwnd)   // HWND
    (arg u32    uMsg)   // UINT msg
    (arg intptr wParam) // WPARAM
    (arg intptr lParam) // LPARAM
    (body
        (if (eq uMsg 16) (block /* WM_CLOSE */
            (call PostQuitMessage 0)
            (return 0)
        ))
        (return (call DefWindowProcA hwnd uMsg wParam lParam))
    )
)
 
(class OpenGLWindow
    
    (var hInstance intptr (call GetModuleHandleA null))
    (var hWnd intptr)
    (var hDC intptr)
    (var hRC intptr)
    
    (func __construct (body
        (var wc (call WNDCLASS))
        (set (getprop wc style) 0x23)             /* CS_HREDRAW | CS_VREDRAW | CS_OWNDC */
        (set (getprop wc lpfnWndProc) WndProc)
        (set (getprop wc hInstance) hInstance)
        (set (getprop wc hIcon) (call LoadIconA null (cast intptr 32517))) /* IDI_WINLOGO */
        (set (getprop wc hCursor) (call LoadCursorA null (cast intptr 32512))) /* IDC_ARROW */
        (set (getprop wc lpszClassName) (getprop "OpenGLWndClass" cStringPtr))
        (if (not (call RegisterClassA wc))
            (block
                (call MessageBoxA null (getprop "Failed to register the window class" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
                (return)
            )
        )
        
        (var dwExStyle 0x40100) /* WS_EX_APPWINDOW | WS_EX_WINDOWEDGE */
        (var dwStyle 0xCA0000) /* WS_CAPTION | WS_SYSMENU | WS_MINIMIZEBOX */
        (var windowRect (call RECT))
        (set (getprop windowRect right) 1024)
        (set (getprop windowRect bottom) 768)
        (call AdjustWindowRectEx windowRect dwStyle false dwExStyle)
        
        // Create The Window
        (set hWnd (call CreateWindowExA
            dwExStyle
            (getprop "OpenGLWndClass" cStringPtr)
            (getprop "OpenGL Example" cStringPtr)
            dwStyle
            0x80000000 // CW_USEDEFAULT
            0x80000000 // CW_USEDEFAULT
            (sub (getprop windowRect right) (getprop windowRect left))
            (sub (getprop windowRect bottom) (getprop windowRect top))
            null
            null
            hInstance
            null
        ))
        (if (not hWnd)
            (block
                (call MessageBoxA null (getprop "Failed to create a window" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
                (return)
            )
        )
        
        (var pfd (call PIXELFORMATDESCRIPTOR))
        (set (getprop pfd nSize) (getprop (typeof pfd) size))
        (set (getprop pfd nVersion) 1)
        (set (getprop pfd dwFlags) 0x25) /* PFD_DRAW_TO_WINDOW | PFD_SUPPORT_OPENGL | PFD_DOUBLEBUFFER */
        (set (getprop pfd iPixelType) 0) /* PFD_TYPE_RGBA */
        (set (getprop pfd cColorBits) 24)
        (set (getprop pfd cDepthBits) 16)
        (set (getprop pfd iLayerType) 0) /* PFD_MAIN_PLANE */
        
        (set hDC (call GetDC hWnd))
        (if (not hDC)
            (block
                (call MessageBoxA null (getprop "Can't create an OpenGL device context" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
                (return)
            )
        )
        
        (var pixelFormat (call ChoosePixelFormat hDC pfd))
        (if (not pixelFormat)
            (block
                (call MessageBoxA null (getprop "Can't find a suitable pixel format" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
                (return)
            )
        )
        (if (not (call SetPixelFormat hDC pixelFormat pfd))
            (block
                (call MessageBoxA null (getprop "Can't set the pixel format" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
                (return)
            )
        )
        
        (set hRC (call wglCreateContext hDC))
        (if (not hRC)
            (block
                (call MessageBoxA null (getprop "Can't create the OpenGL context" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
                (return)
            )
        )
        (if (not (call wglMakeCurrent hDC hRC))
            (block
                (call MessageBoxA null (getprop "Can't set OpenGL context as current" cStringPtr) (getprop "OpenGL Example - error" cStringPtr) 0x30)
                (return)
            )
        )
        
        // ...
        
        (call ShowWindow hWnd 5) /* SW_SHOW */
    ))
)
 
(func main
    (ret void)
    (body
        (var window (call OpenGLWindow))
        
        (var msg (call MSG))
        (var done false)
        (while (not done) (block
            (while (call PeekMessageA msg null 0 0 1) (block /* PM_REMOVE */
                (if (eq (getprop msg message) 18) (block /* WM_QUIT */
                    (set done true)
                ))
                (call TranslateMessage msg)
                (call DispatchMessageA msg)
            ))
        ))
    )
)

Comments

  •  icon
    01/01/70 12:00:00 AM UTC
    Plain Text |

    0 B

    |

    👍

    /

    👎

    
        
  •  icon
    01/01/70 12:00:00 AM UTC
    Plain Text |

    0 B

    |

    👍

    /

    👎