Pastey Window Demo Using struct branch
- Posted by mattlewis (admin) Nov 17, 2011
--**** -- === win32/window.exw -- -- A Standard Windows Window coded at the primitive API level -- Most Euphoria programmers should simply use Win32Lib, wxWidgets, EuGTK or EuIUP! -- include std/os.e include std/machine.e include std/dll.e include std/math.e include std/error.e include std/console.e --**** -- === Windows Type constants for function/procedure calls public constant C_BYTE = C_CHAR, C_BOOL = C_INT, C_ATOM = C_USHORT, C_WORD = C_USHORT, C_DWORD= C_ULONG, C_WPARAM = C_UINT, C_LPARAM = C_ULONG, C_HANDLE = C_POINTER, C_HWND = C_POINTER, C_LPSTR = C_POINTER, $ public constant C_LONG_PTR = C_POINTER public constant C_LRESULT = C_LONG_PTR --**** -- === Windows Type constants for structs -- ifdef not EU4_0 then public memtype char as BYTE, int as BOOL, int as INT, -- unsigned int as UINT, int as UINT, long as LONG, -- unsigned long as ULONG, long as ULONG, double as DOUBLE, short as WORD, long as DWORD, object as HANDLE, object as HWND, object as LPSTR, object as WNDPROC, -- signed long int as ZWORD, --test $ -- elsedef -- crash("requires EU<4.1 w/memstruct") -- --program will synax error before can run crash() <4.1 -- -- the memtype fails inside ifdef too? -- end ifdef memstruct WNDCLASSEX UINT cbSize UINT style WNDPROC lpfnWndProc --WNDPROC INT cbClsExtra INT cbWndExtra HANDLE hInstance --HINSTANCE HANDLE hIcon --HICON HANDLE hCursor --HCURSOR HANDLE hbrBackground --HBRUSH LPSTR lpszMenuName --LPCSTR LPSTR lpszClassName --LPCSTR HANDLE hIconSm --HICON end memstruct memstruct PAINTSTRUCT HANDLE hdc --HDC BOOL fErase RECT rcPaint --RECT BOOL fRestore BOOL fIncUpdate BYTE rgbReserved[32] --BYTE,32 end memstruct --no idea where sizeof message 40 comes from memstruct MESSAGE BYTE rgbReserved[40] end memstruct memstruct RECT LONG left LONG top LONG right LONG bottom end memstruct ifdef UNITTEST then --sizes&offsets may be different on win64 -- constant cbSize = 0, -- style = 4, test_equal("style=4", 4, offsetof(WNDCLASSEX.style) ) -- lpfnWndProc = 8, -- cbClsExtra = 12, -- cbWndExtra = 16, -- hInstance = 20, -- hIcon = 24, -- hCursor = 28, test_equal("hCursor=28", 28, offsetof(WNDCLASSEX.hCursor) ) -- hbrBackground = 32, -- lpszMenuName = 36, -- lpszClassName = 40, -- hIconSm = 44, test_equal("hIconSm = 44", 44, offsetof(WNDCLASSEX.hIconSm) ) -- --SIZE_OF_WNDCLASSEX win32 = 48, test_equal("SIZE_OF_WNDCLASSEX win32 = 48", 48, sizeof(WNDCLASSEX) ) -- $ --constant SIZE_OF_MESSAGE = 40 test_equal("SIZE_OF_MESSAGE = 40", 40, sizeof(MESSAGE) ) --ps = allocate(64) test_equal("SIZE_OF_PAINTSTRUCT = 64", 64, sizeof(PAINTSTRUCT) ) --rect = allocate(16) test_equal("SIZE_OF_RECT", 16, sizeof(RECT) ) end ifdef constant CS_HREDRAW = 2, CS_VREDRAW = 1 constant SW_SHOWNORMAL = 1 constant WM_CREATE = #01, WM_PAINT = #0F, WM_DESTROY= #02 constant SND_FILENAME = #00020000, SND_ASYNC = #00000001 constant DT_SINGLELINE = #0020, DT_CENTER = #0001, DT_VCENTER = #0004 constant WS_OVERLAPPED = #00000000, WS_CAPTION = #00C00000, WS_SYSMENU = #00080000, WS_THICKFRAME = #00040000, WS_MINIMIZEBOX = #00020000, WS_MAXIMIZEBOX = #00010000 constant IDC_ARROW = 32512, WHITE_BRUSH = 0, CW_USEDEFAULT = #80000000, WS_OVERLAPPEDWINDOW = or_all({WS_OVERLAPPED, WS_CAPTION, WS_SYSMENU, WS_THICKFRAME, WS_MINIMIZEBOX, WS_MAXIMIZEBOX}) integer LoadIcon, LoadCursor, GetStockObject, RegisterClassEx, CreateWindow, ShowWindow, UpdateWindow, GetMessage, TranslateMessage, DispatchMessage, PlaySound, BeginPaint, GetClientRect, DrawText, EndPaint, PostQuitMessage, DefWindowProc procedure not_found(sequence name) crash( "Couldn't find " & name ) end procedure -- dynamically link a C routine as a Euphoria function function link_c_func(atom dll, sequence name, sequence args, atom result) integer handle handle = define_c_func(dll, name, args, result) if handle = -1 then not_found(name) else return handle end if end function -- dynamically link a C routine as a Euphoria function function link_c_proc(atom dll, sequence name, sequence args) integer handle handle = define_c_proc(dll, name, args) if handle = -1 then not_found(name) else return handle end if end function -- get handles to all dll routines that we need procedure link_dll_routines() atom user32, gdi32, winmm user32 = open_dll("user32.dll") if user32 = NULL then not_found("user32.dll") end if gdi32 = open_dll("gdi32.dll") if gdi32 = NULL then not_found("gdi32.dll") end if winmm = open_dll("winmm.dll") if winmm = NULL then not_found("winmm.dll") end if --new code would use LoadImage LoadIcon = link_c_func(user32, "LoadIconA", {C_HANDLE, C_LPSTR}, C_HANDLE) LoadCursor = link_c_func(user32, "LoadCursorA", {C_HANDLE, C_LPSTR}, C_HANDLE) GetStockObject = link_c_func(gdi32, "GetStockObject", {C_INT}, C_HANDLE) RegisterClassEx = link_c_func(user32, "RegisterClassExA", {C_POINTER}, C_ATOM) CreateWindow = link_c_func(user32, "CreateWindowExA", {C_DWORD, C_LPSTR, C_LPSTR,C_DWORD,C_INT,C_INT,C_INT,C_INT, C_HWND,C_HANDLE,C_HANDLE, C_POINTER}, C_HWND) ShowWindow = link_c_proc(user32, "ShowWindow", {C_HWND, C_INT}) --BOOL UpdateWindow = link_c_proc(user32, "UpdateWindow", {C_HWND}) --BOOL GetMessage = link_c_func(user32, "GetMessageA", {C_LPSTR, C_HWND, C_UINT, C_UINT}, C_BOOL) TranslateMessage = link_c_proc(user32, "TranslateMessage", {C_LPSTR}) --BOOL DispatchMessage = link_c_proc(user32, "DispatchMessageA", {C_LPSTR}) --LRESULT PlaySound = link_c_proc(winmm, "PlaySound", {C_LPSTR, C_HANDLE, C_DWORD}) --BOOL BeginPaint = link_c_func(user32, "BeginPaint", {C_HWND, C_POINTER}, C_HANDLE) GetClientRect = link_c_proc(user32, "GetClientRect", {C_HWND, C_POINTER}) --BOOL DrawText = link_c_proc(user32, "DrawTextA", {C_HANDLE, C_LPSTR, C_INT, C_POINTER, C_UINT}) --INT EndPaint = link_c_proc(user32, "EndPaint", {C_HWND, C_POINTER}) --BOOL PostQuitMessage = link_c_proc(user32, "PostQuitMessage", {C_INT}) DefWindowProc = link_c_func(user32, "DefWindowProcA", {C_HWND, C_UINT, C_WPARAM, C_LPARAM}, C_LRESULT) end procedure link_dll_routines() atom ps = allocate( sizeof(PAINTSTRUCT) ), rect = allocate( sizeof(RECT) ), wav_file = allocate_string("\\Windows\\Media\\tada.wav"), Euphoria = allocate_string("A Plain Vanilla Window using Euphoria!") -- callback routine to handle Window class public function WndProc(atom hwnd, atom iMsg, atom wParam, atom lParam) atom hdc integer temp if iMsg = WM_CREATE then c_proc(PlaySound, {wav_file, NULL, or_bits(SND_FILENAME, SND_ASYNC)}) return 0 elsif iMsg = WM_PAINT then hdc = c_func(BeginPaint, {hwnd, ps}) c_proc(GetClientRect, {hwnd, rect}) c_proc(DrawText, {hdc, Euphoria, -1, rect, or_all({DT_SINGLELINE, DT_CENTER, DT_VCENTER})}) c_proc(EndPaint, {hwnd, ps}) return 0 elsif iMsg = WM_DESTROY then c_proc(PostQuitMessage, {0}) return 0 end if temp = c_func(DefWindowProc, {hwnd, iMsg, wParam, lParam}) return temp end function atom my_title = allocate_string("Euphoria for WINDOWS") procedure WinMain() -- main routine atom szAppName atom hwnd atom msg atom wndclass atom WndProcAddress atom class integer id atom icon_handle wndclass = allocate( sizeof(WNDCLASSEX), 1) msg = allocate( sizeof(MESSAGE), 1) szAppName = allocate_string("Hello Windows", 1) id = routine_id("WndProc") if id = -1 then crash( "routine_id failed!") end if WndProcAddress = call_back(id) -- get address for callback wndclass.WNDCLASSEX.cbSize = sizeof(WNDCLASSEX) wndclass.WNDCLASSEX.style = or_bits(CS_HREDRAW, CS_VREDRAW) wndclass.WNDCLASSEX.lpfnWndProc = WndProcAddress wndclass.WNDCLASSEX.cbClsExtra = 0 wndclass.WNDCLASSEX.cbWndExtra = 0 wndclass.WNDCLASSEX.hInstance = 0 -- set icon in top-left of window icon_handle = c_func(LoadIcon, {instance(), allocate_string("eui", 1)}) wndclass.WNDCLASSEX.hIcon = icon_handle wndclass.WNDCLASSEX.hIconSm = icon_handle -- Wolfgang Fritz observes that you can set an icon -- dynamically using: -- junk = sendMessage(YourWindow, 128, 1, icon_handle) -- where 128 is WM_SETICON wndclass.WNDCLASSEX.hCursor = c_func(LoadCursor, {NULL, IDC_ARROW}) wndclass.WNDCLASSEX.hbrBackground = c_func(GetStockObject, {WHITE_BRUSH}) wndclass.WNDCLASSEX.lpszMenuName = NULL wndclass.WNDCLASSEX.lpszClassName = szAppName class = c_func(RegisterClassEx, {wndclass}) if class = 0 then crash( "Couldn't register class\n") end if hwnd = c_func(CreateWindow, { 0, -- extended style szAppName, -- window class name my_title, -- window caption WS_OVERLAPPEDWINDOW, -- window style CW_USEDEFAULT, -- initial x position CW_USEDEFAULT, -- initial y position CW_USEDEFAULT, -- initial x size CW_USEDEFAULT, -- initial y size NULL, -- parent window handle NULL, -- window menu handle 0 , --hInstance // program instance handle NULL}) -- creation parameters if hwnd = 0 then crash("Couldn't CreateWindow\n") end if c_proc(ShowWindow, {hwnd, SW_SHOWNORMAL}) c_proc(UpdateWindow, {hwnd}) while c_func(GetMessage, {msg, NULL, 0, 0}) do c_proc(TranslateMessage, {msg}) c_proc(DispatchMessage, {msg}) end while end procedure WinMain() --update for struct branch, replace or_all w/std/math --really need a mini win wrap. there are 3 demos that will use it -- assuming these will even survive the 4.1 cycle
