remove windows \r\n at end of some lines
erg
parent
8a2120d436
commit
4ceb4d7971
|
|
@ -1,59 +1,59 @@
|
||||||
USING: kernel win32-api math namespaces io prettyprint errors sequences alien ;
|
USING: kernel win32-api math namespaces io prettyprint errors sequences alien ;
|
||||||
IN: win32
|
IN: win32
|
||||||
|
|
||||||
: (enum-clipboard) ( n -- )
|
: (enum-clipboard) ( n -- )
|
||||||
EnumClipboardFormats win32-error dup 0 > [ dup , (enum-clipboard) ] when ;
|
EnumClipboardFormats win32-error dup 0 > [ dup , (enum-clipboard) ] when ;
|
||||||
|
|
||||||
: enum-clipboard ( -- seq )
|
: enum-clipboard ( -- seq )
|
||||||
[ 0 (enum-clipboard) ] { } make nip ;
|
[ 0 (enum-clipboard) ] { } make nip ;
|
||||||
|
|
||||||
: paste ( -- str )
|
: paste ( -- str )
|
||||||
f OpenClipboard drop
|
f OpenClipboard drop
|
||||||
CF_TEXT IsClipboardFormatAvailable 0 = [
|
CF_TEXT IsClipboardFormatAvailable 0 = [
|
||||||
"no text in clipboard" print
|
"no text in clipboard" print
|
||||||
] [
|
] [
|
||||||
! "text found" print
|
! "text found" print
|
||||||
CF_TEXT GetClipboardData
|
CF_TEXT GetClipboardData
|
||||||
dup GlobalLock swap
|
dup GlobalLock swap
|
||||||
GlobalUnlock drop
|
GlobalUnlock drop
|
||||||
] if
|
] if
|
||||||
CloseClipboard drop alien>string ;
|
CloseClipboard drop alien>string ;
|
||||||
|
|
||||||
LIBRARY: libc
|
LIBRARY: libc
|
||||||
FUNCTION: void memcpy ( char* dst, char* src, ulong size ) ;
|
FUNCTION: void memcpy ( char* dst, char* src, ulong size ) ;
|
||||||
|
|
||||||
: copy ( str -- )
|
: copy ( str -- )
|
||||||
f OpenClipboard drop
|
f OpenClipboard drop
|
||||||
EmptyClipboard drop
|
EmptyClipboard drop
|
||||||
GMEM_MOVEABLE over length 1+ GlobalAlloc dup 0 = [
|
GMEM_MOVEABLE over length 1+ GlobalAlloc dup 0 = [
|
||||||
"unable to allocate memory" throw
|
"unable to allocate memory" throw
|
||||||
] when
|
] when
|
||||||
|
|
||||||
dup GlobalLock
|
dup GlobalLock
|
||||||
rot dup length memcpy
|
rot dup length memcpy
|
||||||
dup GlobalUnlock drop
|
dup GlobalUnlock drop
|
||||||
CF_TEXT swap SetClipboardData 0 = [
|
CF_TEXT swap SetClipboardData 0 = [
|
||||||
win32-error
|
win32-error
|
||||||
"SetClipboardData failed" throw
|
"SetClipboardData failed" throw
|
||||||
] when
|
] when
|
||||||
|
|
||||||
CloseClipboard drop ;
|
CloseClipboard drop ;
|
||||||
|
|
||||||
|
|
||||||
! hglbCopy = GlobalAlloc(GMEM_MOVEABLE,
|
! hglbCopy = GlobalAlloc(GMEM_MOVEABLE,
|
||||||
! (cch + 1) * sizeof(TCHAR));
|
! (cch + 1) * sizeof(TCHAR));
|
||||||
|
|
||||||
|
|
||||||
! // Lock the handle and copy the text to the buffer.
|
! // Lock the handle and copy the text to the buffer.
|
||||||
|
|
||||||
! lptstrCopy = GlobalLock(hglbCopy);
|
! lptstrCopy = GlobalLock(hglbCopy);
|
||||||
! memcpy(lptstrCopy, &pbox->atchLabel[ich1],
|
! memcpy(lptstrCopy, &pbox->atchLabel[ich1],
|
||||||
! cch * sizeof(TCHAR));
|
! cch * sizeof(TCHAR));
|
||||||
! lptstrCopy[cch] = (TCHAR) 0; // null character
|
! lptstrCopy[cch] = (TCHAR) 0; // null character
|
||||||
! GlobalUnlock(hglbCopy);
|
! GlobalUnlock(hglbCopy);
|
||||||
|
|
||||||
! // Place the handle on the clipboard.
|
! // Place the handle on the clipboard.
|
||||||
! SetClipboardData(CF_TEXT, hglbCopy);
|
! SetClipboardData(CF_TEXT, hglbCopy);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,59 +1,59 @@
|
||||||
USING: alien kernel errors ;
|
USING: alien kernel errors ;
|
||||||
IN: win32-api
|
IN: win32-api
|
||||||
|
|
||||||
LIBRARY: kernel32
|
LIBRARY: kernel32
|
||||||
|
|
||||||
! FUNCTION: MAKEINTRESOURCEA
|
! FUNCTION: MAKEINTRESOURCEA
|
||||||
! FUNCTION: MAKEINTRESOURCEW
|
! FUNCTION: MAKEINTRESOURCEW
|
||||||
|
|
||||||
! : MAKEINTRESOURCE \ MAKEINTRESOURCEW \ MAKEINTRESOURCEA unicode-exec ;
|
! : MAKEINTRESOURCE \ MAKEINTRESOURCEW \ MAKEINTRESOURCEA unicode-exec ;
|
||||||
! #define IS_INTRESOURCE(_r) (((ULONG_PTR)(_r) >> 16) == 0)
|
! #define IS_INTRESOURCE(_r) (((ULONG_PTR)(_r) >> 16) == 0)
|
||||||
! #define MAKEINTRESOURCEA(i) (LPSTR)((ULONG_PTR)((WORD)(i)))
|
! #define MAKEINTRESOURCEA(i) (LPSTR)((ULONG_PTR)((WORD)(i)))
|
||||||
! #define MAKEINTRESOURCEW(i) (LPWSTR)((ULONG_PTR)((WORD)(i)))
|
! #define MAKEINTRESOURCEW(i) (LPWSTR)((ULONG_PTR)((WORD)(i)))
|
||||||
|
|
||||||
|
|
||||||
! FUNCTION: DWORD FormatMessage(
|
! FUNCTION: DWORD FormatMessage(
|
||||||
! DWORD dwFlags,
|
! DWORD dwFlags,
|
||||||
! LPCVOID lpSource,
|
! LPCVOID lpSource,
|
||||||
! DWORD dwMessageId,
|
! DWORD dwMessageId,
|
||||||
! DWORD dwLanguageId,
|
! DWORD dwLanguageId,
|
||||||
! LPTSTR lpBuffer,
|
! LPTSTR lpBuffer,
|
||||||
! DWORD nSize,
|
! DWORD nSize,
|
||||||
! va_list* Arguments
|
! va_list* Arguments
|
||||||
! ) ;
|
! ) ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
FUNCTION: HMODULE GetModuleHandleA ( char* lpModulename ) ;
|
FUNCTION: HMODULE GetModuleHandleA ( char* lpModulename ) ;
|
||||||
FUNCTION: HMODULE GetModuleHandleW ( char* lpModulename ) ;
|
FUNCTION: HMODULE GetModuleHandleW ( char* lpModulename ) ;
|
||||||
|
|
||||||
: GetModuleHandle \ GetModuleHandleW \ GetModuleHandleA unicode-exec ;
|
: GetModuleHandle \ GetModuleHandleW \ GetModuleHandleA unicode-exec ;
|
||||||
|
|
||||||
|
|
||||||
! FUNCTION: HMODULE GetModuleHandleEx (
|
! FUNCTION: HMODULE GetModuleHandleEx (
|
||||||
! DWORD dwFlags,
|
! DWORD dwFlags,
|
||||||
! LPCTSTR lpModulename,
|
! LPCTSTR lpModulename,
|
||||||
! HMODULE* phModule ) ;
|
! HMODULE* phModule ) ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
FUNCTION: DWORD GetLastError ( ) ;
|
FUNCTION: DWORD GetLastError ( ) ;
|
||||||
|
|
||||||
: (win32-error) ( id -- string )
|
: (win32-error) ( id -- string )
|
||||||
"char*" f "error_message" [ "int" ] alien-invoke ;
|
"char*" f "error_message" [ "int" ] alien-invoke ;
|
||||||
|
|
||||||
: win32-error ( -- )
|
: win32-error ( -- )
|
||||||
GetLastError dup 0 = [ (win32-error) throw ] unless drop ;
|
GetLastError dup 0 = [ (win32-error) throw ] unless drop ;
|
||||||
|
|
||||||
: GHND HEX: 40 ; inline
|
: GHND HEX: 40 ; inline
|
||||||
: GMEM_FIXED 0 ; inline
|
: GMEM_FIXED 0 ; inline
|
||||||
: GMEM_MOVEABLE 2 ; inline
|
: GMEM_MOVEABLE 2 ; inline
|
||||||
: GMEM_ZEROINIT HEX: 40 ; inline
|
: GMEM_ZEROINIT HEX: 40 ; inline
|
||||||
: GPTR HEX: 40 ; inline
|
: GPTR HEX: 40 ; inline
|
||||||
|
|
||||||
FUNCTION: HGLOBAL GlobalAlloc ( UINT uFlags, SIZE_T dwBytes ) ;
|
FUNCTION: HGLOBAL GlobalAlloc ( UINT uFlags, SIZE_T dwBytes ) ;
|
||||||
FUNCTION: LPVOID GlobalLock ( HGLOBAL hMem ) ;
|
FUNCTION: LPVOID GlobalLock ( HGLOBAL hMem ) ;
|
||||||
! FUNCTION: char* GlobalLock ( HGLOBAL hMem ) ;
|
! FUNCTION: char* GlobalLock ( HGLOBAL hMem ) ;
|
||||||
FUNCTION: BOOL GlobalUnlock ( HGLOBAL hMem ) ;
|
FUNCTION: BOOL GlobalUnlock ( HGLOBAL hMem ) ;
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,35 +1,35 @@
|
||||||
IN: scratchpad
|
IN: scratchpad
|
||||||
USING: alien compiler kernel namespaces parser sequences words ;
|
USING: alien compiler kernel namespaces parser sequences words ;
|
||||||
|
|
||||||
{
|
{
|
||||||
{ "gdi32" "gdi32" }
|
{ "gdi32" "gdi32" }
|
||||||
{ "user32" "user32" }
|
{ "user32" "user32" }
|
||||||
{ "kernel32" "kernel32" }
|
{ "kernel32" "kernel32" }
|
||||||
{ "winsock" "ws2_32" }
|
{ "winsock" "ws2_32" }
|
||||||
{ "mswsock" "mswsock" }
|
{ "mswsock" "mswsock" }
|
||||||
} [ first2 add-simple-library ] each
|
} [ first2 add-simple-library ] each
|
||||||
"libc" "msvcrt.dll" "cdecl" add-library
|
"libc" "msvcrt.dll" "cdecl" add-library
|
||||||
|
|
||||||
{
|
{
|
||||||
"windows-messages"
|
"windows-messages"
|
||||||
"types"
|
"types"
|
||||||
"gdi32"
|
"gdi32"
|
||||||
"kernel32"
|
"kernel32"
|
||||||
"user32"
|
"user32"
|
||||||
"opengl32"
|
"opengl32"
|
||||||
"utils"
|
"utils"
|
||||||
|
|
||||||
"win32-io"
|
"win32-io"
|
||||||
"win32-errors"
|
"win32-errors"
|
||||||
"winsock"
|
"winsock"
|
||||||
"win32-io-internals"
|
"win32-io-internals"
|
||||||
"win32-stream"
|
"win32-stream"
|
||||||
"win32-server"
|
"win32-server"
|
||||||
} [ "/library/win32/" swap ".factor" append3 run-resource ] each
|
} [ "/library/win32/" swap ".factor" append3 run-resource ] each
|
||||||
|
|
||||||
"native-io" get [
|
"native-io" get [
|
||||||
"/library/bootstrap/win32-io.factor" run-resource
|
"/library/bootstrap/win32-io.factor" run-resource
|
||||||
] when
|
] when
|
||||||
|
|
||||||
IN: kernel
|
IN: kernel
|
||||||
: default-shell "tty" ;
|
: default-shell "tty" ;
|
||||||
|
|
|
||||||
|
|
@ -1,358 +1,358 @@
|
||||||
USING: alien namespaces kernel words ;
|
USING: alien namespaces kernel words ;
|
||||||
IN: win32-api
|
IN: win32-api
|
||||||
|
|
||||||
! http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winprog/winprog/windows_data_types.asp
|
! http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winprog/winprog/windows_data_types.asp
|
||||||
|
|
||||||
SYMBOL: unicode f unicode set
|
SYMBOL: unicode f unicode set
|
||||||
: unicode-exec ( unicode-func ascii-func -- func )
|
: unicode-exec ( unicode-func ascii-func -- func )
|
||||||
unicode get [
|
unicode get [
|
||||||
drop execute
|
drop execute
|
||||||
] [
|
] [
|
||||||
nip execute
|
nip execute
|
||||||
] if ; inline
|
] if ; inline
|
||||||
|
|
||||||
: unicode? unicode get ; inline
|
: unicode? unicode get ; inline
|
||||||
|
|
||||||
: win64? f ;
|
: win64? f ;
|
||||||
|
|
||||||
! win64
|
! win64
|
||||||
! char uchar short ushort int uint long ulong longlong ulonglong
|
! char uchar short ushort int uint long ulong longlong ulonglong
|
||||||
! 1 1 2 2 * * ?
|
! 1 1 2 2 * * ?
|
||||||
! win32
|
! win32
|
||||||
! char uchar short ushort int uint long ulong longlong ulonglong
|
! char uchar short ushort int uint long ulong longlong ulonglong
|
||||||
! 1 1 2 2 * * 4 4 8 8
|
! 1 1 2 2 * * 4 4 8 8
|
||||||
|
|
||||||
|
|
||||||
TYPEDEF: char CHAR
|
TYPEDEF: char CHAR
|
||||||
TYPEDEF: uchar UCHAR
|
TYPEDEF: uchar UCHAR
|
||||||
TYPEDEF: uchar BYTE
|
TYPEDEF: uchar BYTE
|
||||||
|
|
||||||
TYPEDEF: short wchar_t
|
TYPEDEF: short wchar_t
|
||||||
TYPEDEF: wchar_t WCHAR
|
TYPEDEF: wchar_t WCHAR
|
||||||
|
|
||||||
TYPEDEF: short SHORT
|
TYPEDEF: short SHORT
|
||||||
TYPEDEF: ushort USHORT
|
TYPEDEF: ushort USHORT
|
||||||
|
|
||||||
TYPEDEF: ushort WORD
|
TYPEDEF: ushort WORD
|
||||||
TYPEDEF: ulong DWORD
|
TYPEDEF: ulong DWORD
|
||||||
|
|
||||||
TYPEDEF: int INT
|
TYPEDEF: int INT
|
||||||
TYPEDEF: uint UINT
|
TYPEDEF: uint UINT
|
||||||
|
|
||||||
TYPEDEF: int BOOL
|
TYPEDEF: int BOOL
|
||||||
|
|
||||||
TYPEDEF: int* PINT
|
TYPEDEF: int* PINT
|
||||||
TYPEDEF: int* LPINT
|
TYPEDEF: int* LPINT
|
||||||
TYPEDEF: int HFILE
|
TYPEDEF: int HFILE
|
||||||
|
|
||||||
TYPEDEF: long LONG
|
TYPEDEF: long LONG
|
||||||
TYPEDEF: long* LPLONG
|
TYPEDEF: long* LPLONG
|
||||||
TYPEDEF: long LONG_PTR
|
TYPEDEF: long LONG_PTR
|
||||||
TYPEDEF: long* PLONG_PTR
|
TYPEDEF: long* PLONG_PTR
|
||||||
|
|
||||||
TYPEDEF: uint ULONG
|
TYPEDEF: uint ULONG
|
||||||
TYPEDEF: ulong ULONG_PTR
|
TYPEDEF: ulong ULONG_PTR
|
||||||
TYPEDEF: ulong* PULONG_PTR
|
TYPEDEF: ulong* PULONG_PTR
|
||||||
|
|
||||||
TYPEDEF: void VOID
|
TYPEDEF: void VOID
|
||||||
TYPEDEF: void* PVOID
|
TYPEDEF: void* PVOID
|
||||||
TYPEDEF: void* LPVOID
|
TYPEDEF: void* LPVOID
|
||||||
TYPEDEF: void* LPCVOID
|
TYPEDEF: void* LPCVOID
|
||||||
|
|
||||||
TYPEDEF: float FLOAT
|
TYPEDEF: float FLOAT
|
||||||
win64? [
|
win64? [
|
||||||
! TODO: check these!
|
! TODO: check these!
|
||||||
TYPEDEF: INT32 HALF_PTR
|
TYPEDEF: INT32 HALF_PTR
|
||||||
TYPEDEF: UINT32 UHALF_PTR
|
TYPEDEF: UINT32 UHALF_PTR
|
||||||
TYPEDEF: long INT_PTR
|
TYPEDEF: long INT_PTR
|
||||||
TYPEDEF: ulong UINT_PTR
|
TYPEDEF: ulong UINT_PTR
|
||||||
|
|
||||||
TYPEDEF: longlong LONG_PTR ! 64bit
|
TYPEDEF: longlong LONG_PTR ! 64bit
|
||||||
TYPEDEF: ulonglong ULONG_PTR ! 64bit
|
TYPEDEF: ulonglong ULONG_PTR ! 64bit
|
||||||
|
|
||||||
TYPEDEF: int INT32
|
TYPEDEF: int INT32
|
||||||
TYPEDEF: uint UINT32
|
TYPEDEF: uint UINT32
|
||||||
TYPEDEF: uint DWORD32
|
TYPEDEF: uint DWORD32
|
||||||
TYPEDEF: uint ULONG32
|
TYPEDEF: uint ULONG32
|
||||||
TYPEDEF: ulong ULONG64
|
TYPEDEF: ulong ULONG64
|
||||||
TYPEDEF: int* POINTER_32
|
TYPEDEF: int* POINTER_32
|
||||||
TYPEDEF: long* POINTER_64
|
TYPEDEF: long* POINTER_64
|
||||||
TYPEDEF: longlong INT64
|
TYPEDEF: longlong INT64
|
||||||
TYPEDEF: ulonglong UINT64
|
TYPEDEF: ulonglong UINT64
|
||||||
TYPEDEF: longlong LONGLONG ! 64bit
|
TYPEDEF: longlong LONGLONG ! 64bit
|
||||||
TYPEDEF: ulonglong ULONGLONG
|
TYPEDEF: ulonglong ULONGLONG
|
||||||
TYPEDEF: longlong LONG64
|
TYPEDEF: longlong LONG64
|
||||||
TYPEDEF: ulonglong DWORD64
|
TYPEDEF: ulonglong DWORD64
|
||||||
] [
|
] [
|
||||||
TYPEDEF: short HALF_PTR
|
TYPEDEF: short HALF_PTR
|
||||||
TYPEDEF: ushort UHALF_PTR
|
TYPEDEF: ushort UHALF_PTR
|
||||||
TYPEDEF: int INT_PTR
|
TYPEDEF: int INT_PTR
|
||||||
TYPEDEF: uint UINT_PTR
|
TYPEDEF: uint UINT_PTR
|
||||||
|
|
||||||
TYPEDEF: int LONG_PTR
|
TYPEDEF: int LONG_PTR
|
||||||
TYPEDEF: ulong ULONG_PTR
|
TYPEDEF: ulong ULONG_PTR
|
||||||
|
|
||||||
TYPEDEF: int INT32
|
TYPEDEF: int INT32
|
||||||
TYPEDEF: uint UINT32
|
TYPEDEF: uint UINT32
|
||||||
TYPEDEF: uint DWORD32
|
TYPEDEF: uint DWORD32
|
||||||
TYPEDEF: ulong ULONG32
|
TYPEDEF: ulong ULONG32
|
||||||
TYPEDEF: ulonglong ULONG64
|
TYPEDEF: ulonglong ULONG64
|
||||||
TYPEDEF: long* POINTER_32
|
TYPEDEF: long* POINTER_32
|
||||||
TYPEDEF: longlong* POINTER_64
|
TYPEDEF: longlong* POINTER_64
|
||||||
TYPEDEF: longlong INT64
|
TYPEDEF: longlong INT64
|
||||||
TYPEDEF: ulonglong UINT64
|
TYPEDEF: ulonglong UINT64
|
||||||
TYPEDEF: longlong LONGLONG
|
TYPEDEF: longlong LONGLONG
|
||||||
TYPEDEF: ulonglong ULONGLONG
|
TYPEDEF: ulonglong ULONGLONG
|
||||||
TYPEDEF: longlong LONG64
|
TYPEDEF: longlong LONG64
|
||||||
TYPEDEF: ulonglong DWORD64
|
TYPEDEF: ulonglong DWORD64
|
||||||
] if
|
] if
|
||||||
|
|
||||||
unicode? [
|
unicode? [
|
||||||
TYPEDEF: WCHAR TBYTE
|
TYPEDEF: WCHAR TBYTE
|
||||||
TYPEDEF: WCHAR TCHAR
|
TYPEDEF: WCHAR TCHAR
|
||||||
] [
|
] [
|
||||||
TYPEDEF: uchar TBYTE
|
TYPEDEF: uchar TBYTE
|
||||||
TYPEDEF: char TCHAR
|
TYPEDEF: char TCHAR
|
||||||
] if
|
] if
|
||||||
|
|
||||||
! Below down is based on the above definitions
|
! Below down is based on the above definitions
|
||||||
! There should be no 32/64bit issues
|
! There should be no 32/64bit issues
|
||||||
|
|
||||||
TYPEDEF: WORD ATOM
|
TYPEDEF: WORD ATOM
|
||||||
TYPEDEF: BYTE BOOLEAN
|
TYPEDEF: BYTE BOOLEAN
|
||||||
! TYPEDEF: __stdcall CALLBACK
|
! TYPEDEF: __stdcall CALLBACK
|
||||||
TYPEDEF: DWORD COLORREF
|
TYPEDEF: DWORD COLORREF
|
||||||
TYPEDEF: ULONGLONG DWORDLONG
|
TYPEDEF: ULONGLONG DWORDLONG
|
||||||
TYPEDEF: ULONG_PTR DWORD_PTR
|
TYPEDEF: ULONG_PTR DWORD_PTR
|
||||||
TYPEDEF: PVOID HANDLE
|
TYPEDEF: PVOID HANDLE
|
||||||
TYPEDEF: HANDLE HACCEL
|
TYPEDEF: HANDLE HACCEL
|
||||||
TYPEDEF: HANDLE HBITMAP
|
TYPEDEF: HANDLE HBITMAP
|
||||||
TYPEDEF: HANDLE HBRUSH
|
TYPEDEF: HANDLE HBRUSH
|
||||||
TYPEDEF: HANDLE HCOLORSPACE
|
TYPEDEF: HANDLE HCOLORSPACE
|
||||||
TYPEDEF: HANDLE HCONV
|
TYPEDEF: HANDLE HCONV
|
||||||
TYPEDEF: HANDLE HCONVLIST
|
TYPEDEF: HANDLE HCONVLIST
|
||||||
TYPEDEF: HANDLE HICON
|
TYPEDEF: HANDLE HICON
|
||||||
TYPEDEF: HICON HCURSOR
|
TYPEDEF: HICON HCURSOR
|
||||||
TYPEDEF: HANDLE HDC
|
TYPEDEF: HANDLE HDC
|
||||||
TYPEDEF: HANDLE HDDEDATA
|
TYPEDEF: HANDLE HDDEDATA
|
||||||
TYPEDEF: HANDLE HDESK
|
TYPEDEF: HANDLE HDESK
|
||||||
TYPEDEF: HANDLE HDROP
|
TYPEDEF: HANDLE HDROP
|
||||||
TYPEDEF: HANDLE HDWP
|
TYPEDEF: HANDLE HDWP
|
||||||
TYPEDEF: HANDLE HENMETAFILE
|
TYPEDEF: HANDLE HENMETAFILE
|
||||||
TYPEDEF: HANDLE HFONT
|
TYPEDEF: HANDLE HFONT
|
||||||
TYPEDEF: HANDLE HGDIOBJ
|
TYPEDEF: HANDLE HGDIOBJ
|
||||||
TYPEDEF: HANDLE HGLOBAL
|
TYPEDEF: HANDLE HGLOBAL
|
||||||
TYPEDEF: HANDLE HHOOK
|
TYPEDEF: HANDLE HHOOK
|
||||||
TYPEDEF: HANDLE HINSTANCE
|
TYPEDEF: HANDLE HINSTANCE
|
||||||
TYPEDEF: HANDLE HKEY
|
TYPEDEF: HANDLE HKEY
|
||||||
TYPEDEF: HANDLE HKL
|
TYPEDEF: HANDLE HKL
|
||||||
TYPEDEF: HANDLE HLOCAL
|
TYPEDEF: HANDLE HLOCAL
|
||||||
TYPEDEF: HANDLE HMENU
|
TYPEDEF: HANDLE HMENU
|
||||||
TYPEDEF: HANDLE HMETAFILE
|
TYPEDEF: HANDLE HMETAFILE
|
||||||
TYPEDEF: HINSTANCE HMODULE
|
TYPEDEF: HINSTANCE HMODULE
|
||||||
TYPEDEF: HANDLE HMONITOR
|
TYPEDEF: HANDLE HMONITOR
|
||||||
TYPEDEF: HANDLE HPALETTE
|
TYPEDEF: HANDLE HPALETTE
|
||||||
TYPEDEF: HANDLE HPEN
|
TYPEDEF: HANDLE HPEN
|
||||||
TYPEDEF: LONG HRESULT
|
TYPEDEF: LONG HRESULT
|
||||||
TYPEDEF: HANDLE HRGN
|
TYPEDEF: HANDLE HRGN
|
||||||
TYPEDEF: HANDLE HRSRC
|
TYPEDEF: HANDLE HRSRC
|
||||||
TYPEDEF: HANDLE HSZ
|
TYPEDEF: HANDLE HSZ
|
||||||
TYPEDEF: HANDLE WINSTA ! MS docs say typedef HANDLE WINSTA ;
|
TYPEDEF: HANDLE WINSTA ! MS docs say typedef HANDLE WINSTA ;
|
||||||
TYPEDEF: HANDLE HWINSTA ! typo??
|
TYPEDEF: HANDLE HWINSTA ! typo??
|
||||||
TYPEDEF: HANDLE HWND
|
TYPEDEF: HANDLE HWND
|
||||||
TYPEDEF: WORD LANGID
|
TYPEDEF: WORD LANGID
|
||||||
TYPEDEF: DWORD LCID
|
TYPEDEF: DWORD LCID
|
||||||
TYPEDEF: DWORD LCTYPE
|
TYPEDEF: DWORD LCTYPE
|
||||||
TYPEDEF: DWORD LGRPID
|
TYPEDEF: DWORD LGRPID
|
||||||
TYPEDEF: LONG_PTR LPARAM
|
TYPEDEF: LONG_PTR LPARAM
|
||||||
TYPEDEF: BOOL* LPBOOL
|
TYPEDEF: BOOL* LPBOOL
|
||||||
TYPEDEF: BYTE* LPBYTE
|
TYPEDEF: BYTE* LPBYTE
|
||||||
TYPEDEF: DWORD* LPCOLORREF
|
TYPEDEF: DWORD* LPCOLORREF
|
||||||
TYPEDEF: CHAR* LPCSTR
|
TYPEDEF: CHAR* LPCSTR
|
||||||
TYPEDEF: WCHAR* LPCWSTR
|
TYPEDEF: WCHAR* LPCWSTR
|
||||||
TYPEDEF: WCHAR* LPWSTR
|
TYPEDEF: WCHAR* LPWSTR
|
||||||
unicode? [
|
unicode? [
|
||||||
TYPEDEF: LPCWSTR LPCTSTR
|
TYPEDEF: LPCWSTR LPCTSTR
|
||||||
TYPEDEF: LPWSTR LPTSTR
|
TYPEDEF: LPWSTR LPTSTR
|
||||||
TYPEDEF: LPCWSTR PCTSTR
|
TYPEDEF: LPCWSTR PCTSTR
|
||||||
TYPEDEF: LPWSTR PTSTR
|
TYPEDEF: LPWSTR PTSTR
|
||||||
] [
|
] [
|
||||||
TYPEDEF: LPCSTR LPCTSTR
|
TYPEDEF: LPCSTR LPCTSTR
|
||||||
TYPEDEF: LPSTR LPTSTR
|
TYPEDEF: LPSTR LPTSTR
|
||||||
TYPEDEF: LPCSTR PCTSTR
|
TYPEDEF: LPCSTR PCTSTR
|
||||||
TYPEDEF: LPSTR PTSTR
|
TYPEDEF: LPSTR PTSTR
|
||||||
] if
|
] if
|
||||||
TYPEDEF: DWORD* LPDWORD
|
TYPEDEF: DWORD* LPDWORD
|
||||||
TYPEDEF: HANDLE* LPHANDLE
|
TYPEDEF: HANDLE* LPHANDLE
|
||||||
TYPEDEF: CHAR* LPSTR
|
TYPEDEF: CHAR* LPSTR
|
||||||
TYPEDEF: WORD* LPWORD
|
TYPEDEF: WORD* LPWORD
|
||||||
TYPEDEF: WCHAR* LPWSTR
|
TYPEDEF: WCHAR* LPWSTR
|
||||||
TYPEDEF: LONG_PTR LRESULT
|
TYPEDEF: LONG_PTR LRESULT
|
||||||
TYPEDEF: BOOL* PBOOL
|
TYPEDEF: BOOL* PBOOL
|
||||||
TYPEDEF: BOOLEAN* PBOOLEAN
|
TYPEDEF: BOOLEAN* PBOOLEAN
|
||||||
TYPEDEF: BYTE* PBYTE
|
TYPEDEF: BYTE* PBYTE
|
||||||
TYPEDEF: CHAR* PCHAR
|
TYPEDEF: CHAR* PCHAR
|
||||||
TYPEDEF: CHAR* PCSTR
|
TYPEDEF: CHAR* PCSTR
|
||||||
TYPEDEF: WCHAR* PCWSTR
|
TYPEDEF: WCHAR* PCWSTR
|
||||||
TYPEDEF: DWORD* PDWORD
|
TYPEDEF: DWORD* PDWORD
|
||||||
TYPEDEF: DWORDLONG* PDWORDLONG
|
TYPEDEF: DWORDLONG* PDWORDLONG
|
||||||
TYPEDEF: DWORD_PTR* PDWORD_PTR
|
TYPEDEF: DWORD_PTR* PDWORD_PTR
|
||||||
TYPEDEF: DWORD32* PDWORD32
|
TYPEDEF: DWORD32* PDWORD32
|
||||||
TYPEDEF: DWORD64* PDWORD64
|
TYPEDEF: DWORD64* PDWORD64
|
||||||
TYPEDEF: FLOAT* PFLOAT
|
TYPEDEF: FLOAT* PFLOAT
|
||||||
TYPEDEF: HALF_PTR* PHALF_PTR
|
TYPEDEF: HALF_PTR* PHALF_PTR
|
||||||
TYPEDEF: HANDLE* PHANDLE
|
TYPEDEF: HANDLE* PHANDLE
|
||||||
TYPEDEF: HKEY* PHKEY
|
TYPEDEF: HKEY* PHKEY
|
||||||
TYPEDEF: INT_PTR* PINT_PTR
|
TYPEDEF: INT_PTR* PINT_PTR
|
||||||
TYPEDEF: INT32* PINT32
|
TYPEDEF: INT32* PINT32
|
||||||
TYPEDEF: INT64* PINT64
|
TYPEDEF: INT64* PINT64
|
||||||
TYPEDEF: PDWORD PLCID
|
TYPEDEF: PDWORD PLCID
|
||||||
TYPEDEF: LONG* PLONG
|
TYPEDEF: LONG* PLONG
|
||||||
TYPEDEF: LONGLONG* PLONGLONG
|
TYPEDEF: LONGLONG* PLONGLONG
|
||||||
TYPEDEF: LONG_PTR* PLONG_PTR
|
TYPEDEF: LONG_PTR* PLONG_PTR
|
||||||
TYPEDEF: LONG32* PLONG32
|
TYPEDEF: LONG32* PLONG32
|
||||||
TYPEDEF: LONG64* PLONG64
|
TYPEDEF: LONG64* PLONG64
|
||||||
TYPEDEF: SHORT* PSHORT
|
TYPEDEF: SHORT* PSHORT
|
||||||
TYPEDEF: SIZE_T* PSIZE_T
|
TYPEDEF: SIZE_T* PSIZE_T
|
||||||
TYPEDEF: SSIZE_T* PSSIZE_T
|
TYPEDEF: SSIZE_T* PSSIZE_T
|
||||||
TYPEDEF: CHAR* PSTR
|
TYPEDEF: CHAR* PSTR
|
||||||
TYPEDEF: TBYTE* PTBYTE
|
TYPEDEF: TBYTE* PTBYTE
|
||||||
TYPEDEF: TCHAR* PTCHAR
|
TYPEDEF: TCHAR* PTCHAR
|
||||||
TYPEDEF: UCHAR* PUCHAR
|
TYPEDEF: UCHAR* PUCHAR
|
||||||
TYPEDEF: UHALF_PTR* PUHALF_PTR
|
TYPEDEF: UHALF_PTR* PUHALF_PTR
|
||||||
TYPEDEF: UINT* PUINT
|
TYPEDEF: UINT* PUINT
|
||||||
TYPEDEF: UINT_PTR* PUINT_PTR
|
TYPEDEF: UINT_PTR* PUINT_PTR
|
||||||
TYPEDEF: UINT32* PUINT32
|
TYPEDEF: UINT32* PUINT32
|
||||||
TYPEDEF: UINT64* PUINT64
|
TYPEDEF: UINT64* PUINT64
|
||||||
TYPEDEF: ULONG* PULONG
|
TYPEDEF: ULONG* PULONG
|
||||||
TYPEDEF: ULONGLONG* PULONGLONG
|
TYPEDEF: ULONGLONG* PULONGLONG
|
||||||
TYPEDEF: ULONG_PTR* PULONG_PTR
|
TYPEDEF: ULONG_PTR* PULONG_PTR
|
||||||
TYPEDEF: ULONG32* PULONG32
|
TYPEDEF: ULONG32* PULONG32
|
||||||
TYPEDEF: ULONG64* PULONG64
|
TYPEDEF: ULONG64* PULONG64
|
||||||
TYPEDEF: USHORT* PUSHORT
|
TYPEDEF: USHORT* PUSHORT
|
||||||
TYPEDEF: WCHAR* PWCHAR
|
TYPEDEF: WCHAR* PWCHAR
|
||||||
TYPEDEF: WORD* PWORD
|
TYPEDEF: WORD* PWORD
|
||||||
TYPEDEF: WCHAR* PWSTR
|
TYPEDEF: WCHAR* PWSTR
|
||||||
TYPEDEF: HANDLE SC_HANDLE
|
TYPEDEF: HANDLE SC_HANDLE
|
||||||
TYPEDEF: LPVOID SC_LOCK
|
TYPEDEF: LPVOID SC_LOCK
|
||||||
TYPEDEF: HANDLE SERVICE_STATUS_HANDLE
|
TYPEDEF: HANDLE SERVICE_STATUS_HANDLE
|
||||||
TYPEDEF: ULONG_PTR SIZE_T
|
TYPEDEF: ULONG_PTR SIZE_T
|
||||||
TYPEDEF: LONG_PTR SSIZE_T
|
TYPEDEF: LONG_PTR SSIZE_T
|
||||||
TYPEDEF: LONGLONG USN
|
TYPEDEF: LONGLONG USN
|
||||||
! TYPEDEF: __stdcall WINAPI
|
! TYPEDEF: __stdcall WINAPI
|
||||||
TYPEDEF: UINT_PTR WPARAM
|
TYPEDEF: UINT_PTR WPARAM
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
TYPEDEF: RECT* LPRECT
|
TYPEDEF: RECT* LPRECT
|
||||||
TYPEDEF: void* PWNDCLASS
|
TYPEDEF: void* PWNDCLASS
|
||||||
TYPEDEF: void* PWNDCLASSEX
|
TYPEDEF: void* PWNDCLASSEX
|
||||||
|
|
||||||
TYPEDEF: void* WNDPROC
|
TYPEDEF: void* WNDPROC
|
||||||
|
|
||||||
! typedef LRESULT (CALLBACK* WNDPROC)(HWND, UINT, WPARAM, LPARAM);
|
! typedef LRESULT (CALLBACK* WNDPROC)(HWND, UINT, WPARAM, LPARAM);
|
||||||
|
|
||||||
BEGIN-STRUCT: WNDCLASS
|
BEGIN-STRUCT: WNDCLASS
|
||||||
FIELD: UINT style
|
FIELD: UINT style
|
||||||
FIELD: WNDPROC lpfnWndProc
|
FIELD: WNDPROC lpfnWndProc
|
||||||
FIELD: int cbClsExtra
|
FIELD: int cbClsExtra
|
||||||
FIELD: int cbWndExtra
|
FIELD: int cbWndExtra
|
||||||
FIELD: HINSTANCE hInstance
|
FIELD: HINSTANCE hInstance
|
||||||
FIELD: HICON hIcon
|
FIELD: HICON hIcon
|
||||||
FIELD: HCURSOR hCursor
|
FIELD: HCURSOR hCursor
|
||||||
FIELD: HBRUSH hbrBackground
|
FIELD: HBRUSH hbrBackground
|
||||||
FIELD: LPCTSTR lpszMenuName
|
FIELD: LPCTSTR lpszMenuName
|
||||||
FIELD: LPCTSTR lpszClassName
|
FIELD: LPCTSTR lpszClassName
|
||||||
END-STRUCT
|
END-STRUCT
|
||||||
|
|
||||||
BEGIN-STRUCT: WNDCLASSEX
|
BEGIN-STRUCT: WNDCLASSEX
|
||||||
FIELD: UINT cbSize
|
FIELD: UINT cbSize
|
||||||
FIELD: UINT style
|
FIELD: UINT style
|
||||||
FIELD: WNDPROC lpfnWndProc
|
FIELD: WNDPROC lpfnWndProc
|
||||||
FIELD: int cbClsExtra
|
FIELD: int cbClsExtra
|
||||||
FIELD: int cbWndExtra
|
FIELD: int cbWndExtra
|
||||||
FIELD: HINSTANCE hInstance
|
FIELD: HINSTANCE hInstance
|
||||||
FIELD: HICON hIcon
|
FIELD: HICON hIcon
|
||||||
FIELD: HCURSOR hCursor
|
FIELD: HCURSOR hCursor
|
||||||
FIELD: HBRUSH hbrBackground
|
FIELD: HBRUSH hbrBackground
|
||||||
FIELD: LPCTSTR lpszMenuName
|
FIELD: LPCTSTR lpszMenuName
|
||||||
FIELD: LPCTSTR lpszClassName
|
FIELD: LPCTSTR lpszClassName
|
||||||
FIELD: HICON hIconSm
|
FIELD: HICON hIconSm
|
||||||
END-STRUCT
|
END-STRUCT
|
||||||
|
|
||||||
BEGIN-STRUCT: RECT
|
BEGIN-STRUCT: RECT
|
||||||
FIELD: LONG left
|
FIELD: LONG left
|
||||||
FIELD: LONG top
|
FIELD: LONG top
|
||||||
FIELD: LONG right
|
FIELD: LONG right
|
||||||
FIELD: LONG bottom
|
FIELD: LONG bottom
|
||||||
END-STRUCT
|
END-STRUCT
|
||||||
|
|
||||||
BEGIN-STRUCT: PAINTSTRUCT
|
BEGIN-STRUCT: PAINTSTRUCT
|
||||||
FIELD: HDC hdc
|
FIELD: HDC hdc
|
||||||
FIELD: BOOL fErase
|
FIELD: BOOL fErase
|
||||||
FIELD: RECT rcPaint
|
FIELD: RECT rcPaint
|
||||||
FIELD: BOOL fRestore
|
FIELD: BOOL fRestore
|
||||||
FIELD: BOOL fIncUpdate
|
FIELD: BOOL fIncUpdate
|
||||||
FIELD: BYTE rgbReserved[32]
|
FIELD: BYTE rgbReserved[32]
|
||||||
END-STRUCT
|
END-STRUCT
|
||||||
|
|
||||||
TYPEDEF: PAINTSTRUCT* LPPAINTSTRUCT
|
TYPEDEF: PAINTSTRUCT* LPPAINTSTRUCT
|
||||||
|
|
||||||
BEGIN-STRUCT: POINT
|
BEGIN-STRUCT: POINT
|
||||||
FIELD: LONG x
|
FIELD: LONG x
|
||||||
FIELD: LONG y
|
FIELD: LONG y
|
||||||
END-STRUCT
|
END-STRUCT
|
||||||
|
|
||||||
BEGIN-STRUCT: MSG
|
BEGIN-STRUCT: MSG
|
||||||
FIELD: HWND hWnd
|
FIELD: HWND hWnd
|
||||||
FIELD: UINT message
|
FIELD: UINT message
|
||||||
FIELD: WPARAM wParam
|
FIELD: WPARAM wParam
|
||||||
FIELD: LPARAM lParam
|
FIELD: LPARAM lParam
|
||||||
FIELD: DWORD time
|
FIELD: DWORD time
|
||||||
FIELD: POINT pt
|
FIELD: POINT pt
|
||||||
END-STRUCT
|
END-STRUCT
|
||||||
TYPEDEF: MSG* LPMSG
|
TYPEDEF: MSG* LPMSG
|
||||||
|
|
||||||
BEGIN-STRUCT: PIXELFORMATDESCRIPTOR
|
BEGIN-STRUCT: PIXELFORMATDESCRIPTOR
|
||||||
FIELD: WORD nSize
|
FIELD: WORD nSize
|
||||||
FIELD: WORD nVersion
|
FIELD: WORD nVersion
|
||||||
FIELD: DWORD dwFlags
|
FIELD: DWORD dwFlags
|
||||||
FIELD: BYTE iPixelType
|
FIELD: BYTE iPixelType
|
||||||
FIELD: BYTE cColorBits
|
FIELD: BYTE cColorBits
|
||||||
FIELD: BYTE cRedBits
|
FIELD: BYTE cRedBits
|
||||||
FIELD: BYTE cRedShift
|
FIELD: BYTE cRedShift
|
||||||
FIELD: BYTE cGreenBits
|
FIELD: BYTE cGreenBits
|
||||||
FIELD: BYTE cGreenShift
|
FIELD: BYTE cGreenShift
|
||||||
FIELD: BYTE cBlueBits
|
FIELD: BYTE cBlueBits
|
||||||
FIELD: BYTE cBlueShift
|
FIELD: BYTE cBlueShift
|
||||||
FIELD: BYTE cAlphaBits
|
FIELD: BYTE cAlphaBits
|
||||||
FIELD: BYTE cAlphaShift
|
FIELD: BYTE cAlphaShift
|
||||||
FIELD: BYTE cAccumBits
|
FIELD: BYTE cAccumBits
|
||||||
FIELD: BYTE cAccumRedBits
|
FIELD: BYTE cAccumRedBits
|
||||||
FIELD: BYTE cAccumGreenBits
|
FIELD: BYTE cAccumGreenBits
|
||||||
FIELD: BYTE cAccumBlueBits
|
FIELD: BYTE cAccumBlueBits
|
||||||
FIELD: BYTE cAccumAlphaBits
|
FIELD: BYTE cAccumAlphaBits
|
||||||
FIELD: BYTE cDepthBits
|
FIELD: BYTE cDepthBits
|
||||||
FIELD: BYTE cStencilBits
|
FIELD: BYTE cStencilBits
|
||||||
FIELD: BYTE cAuxBuffers
|
FIELD: BYTE cAuxBuffers
|
||||||
FIELD: BYTE iLayerType
|
FIELD: BYTE iLayerType
|
||||||
FIELD: BYTE bReserved
|
FIELD: BYTE bReserved
|
||||||
FIELD: DWORD dwLayerMask
|
FIELD: DWORD dwLayerMask
|
||||||
FIELD: DWORD dwVisibleMask
|
FIELD: DWORD dwVisibleMask
|
||||||
FIELD: DWORD dwDamageMask
|
FIELD: DWORD dwDamageMask
|
||||||
END-STRUCT
|
END-STRUCT
|
||||||
|
|
||||||
BEGIN-STRUCT: RECT
|
BEGIN-STRUCT: RECT
|
||||||
FIELD: LONG left
|
FIELD: LONG left
|
||||||
FIELD: LONG top
|
FIELD: LONG top
|
||||||
FIELD: LONG right
|
FIELD: LONG right
|
||||||
FIELD: LONG bottom
|
FIELD: LONG bottom
|
||||||
END-STRUCT
|
END-STRUCT
|
||||||
|
|
||||||
TYPEDEF: RECT* PRECT
|
TYPEDEF: RECT* PRECT
|
||||||
TYPEDEF: RECT* LPRECT
|
TYPEDEF: RECT* LPRECT
|
||||||
TYPEDEF: PIXELFORMATDESCRIPTOR PFD
|
TYPEDEF: PIXELFORMATDESCRIPTOR PFD
|
||||||
TYPEDEF: PFD* LPPFD
|
TYPEDEF: PFD* LPPFD
|
||||||
TYPEDEF: HANDLE HGLRC
|
TYPEDEF: HANDLE HGLRC
|
||||||
TYPEDEF: HANDLE HRGN
|
TYPEDEF: HANDLE HRGN
|
||||||
|
|
|
||||||
|
|
@ -1,276 +1,276 @@
|
||||||
USING: alien arrays errors freetype gadgets gadgets-launchpad gadgets-layouts
|
USING: alien arrays errors freetype gadgets gadgets-launchpad gadgets-layouts
|
||||||
gadgets-listener hashtables io kernel lists math namespaces prettyprint
|
gadgets-listener hashtables io kernel lists math namespaces prettyprint
|
||||||
sequences strings vectors words win32-api-messages win32-api ;
|
sequences strings vectors words win32-api-messages win32-api ;
|
||||||
USING: inspector threads memory ;
|
USING: inspector threads memory ;
|
||||||
IN: win32
|
IN: win32
|
||||||
|
|
||||||
SYMBOL: windows
|
SYMBOL: windows
|
||||||
SYMBOL: msg-obj
|
SYMBOL: msg-obj
|
||||||
|
|
||||||
! 'SYMBOL: windows' is a hashtable of 'gadget-window' objects indexed by hWnd.
|
! 'SYMBOL: windows' is a hashtable of 'gadget-window' objects indexed by hWnd.
|
||||||
! hDC = handle to device context, hRC = handle to render context
|
! hDC = handle to device context, hRC = handle to render context
|
||||||
TUPLE: gadget-window world hWnd hDC hRC ;
|
TUPLE: gadget-window world hWnd hDC hRC ;
|
||||||
|
|
||||||
: class-name "Factor" ;
|
: class-name "Factor" ;
|
||||||
|
|
||||||
: get-world ( hWnd -- world ) windows get hash gadget-window-world ;
|
: get-world ( hWnd -- world ) windows get hash gadget-window-world ;
|
||||||
: get-gadget-window ( hWnd -- gadget-window )
|
: get-gadget-window ( hWnd -- gadget-window )
|
||||||
windows get hash ;
|
windows get hash ;
|
||||||
|
|
||||||
: style ( -- n ) WS_OVERLAPPEDWINDOW ; inline
|
: style ( -- n ) WS_OVERLAPPEDWINDOW ; inline
|
||||||
: ex-style ( -- n ) WS_EX_APPWINDOW WS_EX_WINDOWEDGE bitor ; inline
|
: ex-style ( -- n ) WS_EX_APPWINDOW WS_EX_WINDOWEDGE bitor ; inline
|
||||||
|
|
||||||
: adjust-RECT ( RECT -- )
|
: adjust-RECT ( RECT -- )
|
||||||
style 0 ex-style AdjustWindowRectEx win32-error=0 ;
|
style 0 ex-style AdjustWindowRectEx win32-error=0 ;
|
||||||
|
|
||||||
: make-RECT ( width height -- RECT )
|
: make-RECT ( width height -- RECT )
|
||||||
"RECT" <c-object> [ set-RECT-bottom ] keep [ set-RECT-right ] keep ;
|
"RECT" <c-object> [ set-RECT-bottom ] keep [ set-RECT-right ] keep ;
|
||||||
|
|
||||||
: make-adjusted-RECT ( width height -- RECT )
|
: make-adjusted-RECT ( width height -- RECT )
|
||||||
make-RECT dup adjust-RECT ;
|
make-RECT dup adjust-RECT ;
|
||||||
|
|
||||||
: cleanup-gadget-window ( gadget-window -- )
|
: cleanup-gadget-window ( gadget-window -- )
|
||||||
dup gadget-window-hRC wglDeleteContext win32-error=0
|
dup gadget-window-hRC wglDeleteContext win32-error=0
|
||||||
[ gadget-window-hWnd ] keep gadget-window-hDC ReleaseDC win32-error=0 ;
|
[ gadget-window-hWnd ] keep gadget-window-hDC ReleaseDC win32-error=0 ;
|
||||||
|
|
||||||
: get-RECT-dimensions ( RECT -- width height )
|
: get-RECT-dimensions ( RECT -- width height )
|
||||||
[ RECT-right ] keep [ RECT-left - ] keep
|
[ RECT-right ] keep [ RECT-left - ] keep
|
||||||
[ RECT-bottom ] keep RECT-top - ;
|
[ RECT-bottom ] keep RECT-top - ;
|
||||||
|
|
||||||
: handle-wm-paint ( hWnd uMsg wParam lParam -- )
|
: handle-wm-paint ( hWnd uMsg wParam lParam -- )
|
||||||
#! wParam and lParam are unused
|
#! wParam and lParam are unused
|
||||||
3drop get-world redraw-world ;
|
3drop get-world redraw-world ;
|
||||||
|
|
||||||
: handle-wm-size ( hWnd uMsg wParam lParam -- )
|
: handle-wm-size ( hWnd uMsg wParam lParam -- )
|
||||||
[ lo-word ] keep hi-word make-RECT get-RECT-dimensions 0 3array
|
[ lo-word ] keep hi-word make-RECT get-RECT-dimensions 0 3array
|
||||||
2nip
|
2nip
|
||||||
dup { 0 0 0 } = [
|
dup { 0 0 0 } = [
|
||||||
2drop
|
2drop
|
||||||
] [
|
] [
|
||||||
swap get-world set-gadget-dim
|
swap get-world set-gadget-dim
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: wm-keydown-codes ( n -- key )
|
: wm-keydown-codes ( n -- key )
|
||||||
H{
|
H{
|
||||||
{ 8 "BACKSPACE" }
|
{ 8 "BACKSPACE" }
|
||||||
{ 9 "TAB" }
|
{ 9 "TAB" }
|
||||||
{ 13 "RETURN" }
|
{ 13 "RETURN" }
|
||||||
{ 27 "ESCAPE" }
|
{ 27 "ESCAPE" }
|
||||||
{ 33 "PAGE_UP" }
|
{ 33 "PAGE_UP" }
|
||||||
{ 34 "PAGE_DOWN" }
|
{ 34 "PAGE_DOWN" }
|
||||||
{ 35 "END" }
|
{ 35 "END" }
|
||||||
{ 36 "HOME" }
|
{ 36 "HOME" }
|
||||||
{ 37 "LEFT" }
|
{ 37 "LEFT" }
|
||||||
{ 38 "UP" }
|
{ 38 "UP" }
|
||||||
{ 39 "RIGHT" }
|
{ 39 "RIGHT" }
|
||||||
{ 40 "DOWN" }
|
{ 40 "DOWN" }
|
||||||
{ 45 "INSERT" }
|
{ 45 "INSERT" }
|
||||||
{ 46 "DELETE" }
|
{ 46 "DELETE" }
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
: wm-char-exclude-keys
|
: wm-char-exclude-keys
|
||||||
H{
|
H{
|
||||||
{ 8 "BACKSPACE" }
|
{ 8 "BACKSPACE" }
|
||||||
{ 13 "RETURN" }
|
{ 13 "RETURN" }
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
: handle-key? ( n -- bool ) wm-keydown-codes hash* nip ;
|
: handle-key? ( n -- bool ) wm-keydown-codes hash* nip ;
|
||||||
: exclude-key? ( n -- bool ) wm-char-exclude-keys hash* nip ;
|
: exclude-key? ( n -- bool ) wm-char-exclude-keys hash* nip ;
|
||||||
: keystroke>gesture ( n -- list ) wm-keydown-codes hash unit ;
|
: keystroke>gesture ( n -- list ) wm-keydown-codes hash unit ;
|
||||||
|
|
||||||
SYMBOL: lParam
|
SYMBOL: lParam
|
||||||
SYMBOL: wParam
|
SYMBOL: wParam
|
||||||
SYMBOL: uMsg
|
SYMBOL: uMsg
|
||||||
SYMBOL: hWnd
|
SYMBOL: hWnd
|
||||||
|
|
||||||
! wparam = keystroke, lparam = parameters
|
! wparam = keystroke, lparam = parameters
|
||||||
: handle-wm-keydown ( hWnd uMsg wParam lParam -- )
|
: handle-wm-keydown ( hWnd uMsg wParam lParam -- )
|
||||||
lParam set wParam set uMsg set hWnd set
|
lParam set wParam set uMsg set hWnd set
|
||||||
wParam get handle-key? [
|
wParam get handle-key? [
|
||||||
wParam get keystroke>gesture
|
wParam get keystroke>gesture
|
||||||
hWnd get get-world world-focus handle-gesture 0
|
hWnd get get-world world-focus handle-gesture 0
|
||||||
] [
|
] [
|
||||||
hWnd get uMsg get wParam get lParam get DefWindowProc
|
hWnd get uMsg get wParam get lParam get DefWindowProc
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: handle-wm-destroy ( hWnd uMsg wParam lParam -- )
|
: handle-wm-destroy ( hWnd uMsg wParam lParam -- )
|
||||||
3drop
|
3drop
|
||||||
|
|
||||||
[
|
[
|
||||||
get-gadget-window
|
get-gadget-window
|
||||||
dup gadget-window-world close-world
|
dup gadget-window-world close-world
|
||||||
cleanup-gadget-window
|
cleanup-gadget-window
|
||||||
] keep
|
] keep
|
||||||
windows get remove-hash
|
windows get remove-hash
|
||||||
0 PostQuitMessage ;
|
0 PostQuitMessage ;
|
||||||
|
|
||||||
|
|
||||||
: handle-wm-char ( hWnd uMsg wParam lParam -- )
|
: handle-wm-char ( hWnd uMsg wParam lParam -- )
|
||||||
lParam set wParam set uMsg set hWnd set
|
lParam set wParam set uMsg set hWnd set
|
||||||
wParam get exclude-key? [
|
wParam get exclude-key? [
|
||||||
hWnd get uMsg get wParam get lParam get DefWindowProc
|
hWnd get uMsg get wParam get lParam get DefWindowProc
|
||||||
] [
|
] [
|
||||||
wParam get ch>string hWnd get get-world world-focus user-input
|
wParam get ch>string hWnd get get-world world-focus user-input
|
||||||
0 ! retval
|
0 ! retval
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
! TODO: handle alt keystrokes as gestures
|
! TODO: handle alt keystrokes as gestures
|
||||||
: handle-wm-syschar ( hWnd uMsg wParam lParam -- )
|
: handle-wm-syschar ( hWnd uMsg wParam lParam -- )
|
||||||
lParam set wParam set uMsg set hWnd set
|
lParam set wParam set uMsg set hWnd set
|
||||||
;
|
;
|
||||||
|
|
||||||
: mouse-button ( uMsg -- n )
|
: mouse-button ( uMsg -- n )
|
||||||
{
|
{
|
||||||
{ [ dup WM_LBUTTONDOWN = ] [ drop 1 ] }
|
{ [ dup WM_LBUTTONDOWN = ] [ drop 1 ] }
|
||||||
{ [ dup WM_LBUTTONUP = ] [ drop 1 ] }
|
{ [ dup WM_LBUTTONUP = ] [ drop 1 ] }
|
||||||
{ [ dup WM_MBUTTONDOWN = ] [ drop 2 ] }
|
{ [ dup WM_MBUTTONDOWN = ] [ drop 2 ] }
|
||||||
{ [ dup WM_MBUTTONUP = ] [ drop 2 ] }
|
{ [ dup WM_MBUTTONUP = ] [ drop 2 ] }
|
||||||
{ [ dup WM_RBUTTONDOWN = ] [ drop 3 ] }
|
{ [ dup WM_RBUTTONDOWN = ] [ drop 3 ] }
|
||||||
{ [ dup WM_RBUTTONUP = ] [ drop 3 ] }
|
{ [ dup WM_RBUTTONUP = ] [ drop 3 ] }
|
||||||
{ [ t ] [ "bad button" throw ] }
|
{ [ t ] [ "bad button" throw ] }
|
||||||
} cond ;
|
} cond ;
|
||||||
|
|
||||||
: mouse-coordinate ( lParam -- seq ) [ lo-word ] keep hi-word 0 3array ;
|
: mouse-coordinate ( lParam -- seq ) [ lo-word ] keep hi-word 0 3array ;
|
||||||
: mouse-wheel ( lParam -- n ) hi-word 0 > 1 -1 ? ;
|
: mouse-wheel ( lParam -- n ) hi-word 0 > 1 -1 ? ;
|
||||||
|
|
||||||
: prepare-mouse ( hWnd uMsg wParam lParam -- )
|
: prepare-mouse ( hWnd uMsg wParam lParam -- )
|
||||||
nip >r mouse-button r> mouse-coordinate rot get-world ;
|
nip >r mouse-button r> mouse-coordinate rot get-world ;
|
||||||
|
|
||||||
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
|
: handle-wm-buttondown ( hWnd uMsg wParam lParam -- )
|
||||||
prepare-mouse send-button-down ;
|
prepare-mouse send-button-down ;
|
||||||
|
|
||||||
: handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
|
: handle-wm-buttonup ( hWnd uMsg wParam lParam -- )
|
||||||
prepare-mouse send-button-up ;
|
prepare-mouse send-button-up ;
|
||||||
|
|
||||||
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
|
: handle-wm-mousemove ( hWnd uMsg wParam lParam -- )
|
||||||
2nip mouse-coordinate swap get-world move-hand ;
|
2nip mouse-coordinate swap get-world move-hand ;
|
||||||
|
|
||||||
: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
|
: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
|
||||||
mouse-coordinate >r mouse-wheel nip r> rot get-world send-wheel ;
|
mouse-coordinate >r mouse-wheel nip r> rot get-world send-wheel ;
|
||||||
|
|
||||||
! return 0 if you handle the message, else just let DefWindowProc return its val
|
! return 0 if you handle the message, else just let DefWindowProc return its val
|
||||||
: ui-wndproc ( hWnd uMsg wParam lParam -- lresult )
|
: ui-wndproc ( hWnd uMsg wParam lParam -- lresult )
|
||||||
"uint" { "void*" "uint" "long" "long" } [
|
"uint" { "void*" "uint" "long" "long" } [
|
||||||
[
|
[
|
||||||
pick
|
pick
|
||||||
! "Message: " write dup get-windows-message-name write
|
! "Message: " write dup get-windows-message-name write
|
||||||
! " " write dup unparse print
|
! " " write dup unparse print
|
||||||
{
|
{
|
||||||
{ [ dup WM_DESTROY = ] [ drop handle-wm-destroy 0 ] }
|
{ [ dup WM_DESTROY = ] [ drop handle-wm-destroy 0 ] }
|
||||||
{ [ dup WM_PAINT = ] [ drop handle-wm-paint 0 ] }
|
{ [ dup WM_PAINT = ] [ drop handle-wm-paint 0 ] }
|
||||||
{ [ dup WM_SIZE = ] [ drop handle-wm-size 0 ] }
|
{ [ dup WM_SIZE = ] [ drop handle-wm-size 0 ] }
|
||||||
|
|
||||||
! Keyboard events
|
! Keyboard events
|
||||||
{ [ dup WM_KEYDOWN = over WM_SYSKEYDOWN = or ]
|
{ [ dup WM_KEYDOWN = over WM_SYSKEYDOWN = or ]
|
||||||
[ drop handle-wm-keydown ] }
|
[ drop handle-wm-keydown ] }
|
||||||
{ [ dup WM_CHAR = over WM_SYSCHAR = or ]
|
{ [ dup WM_CHAR = over WM_SYSCHAR = or ]
|
||||||
[ drop handle-wm-char ] }
|
[ drop handle-wm-char ] }
|
||||||
|
|
||||||
! Mouse events
|
! Mouse events
|
||||||
{ [ dup WM_LBUTTONDOWN = ] [ drop handle-wm-buttondown 0 ] }
|
{ [ dup WM_LBUTTONDOWN = ] [ drop handle-wm-buttondown 0 ] }
|
||||||
{ [ dup WM_MBUTTONDOWN = ] [ drop handle-wm-buttondown 0 ] }
|
{ [ dup WM_MBUTTONDOWN = ] [ drop handle-wm-buttondown 0 ] }
|
||||||
{ [ dup WM_RBUTTONDOWN = ] [ drop handle-wm-buttondown 0 ] }
|
{ [ dup WM_RBUTTONDOWN = ] [ drop handle-wm-buttondown 0 ] }
|
||||||
{ [ dup WM_LBUTTONUP = ] [ drop handle-wm-buttonup 0 ] }
|
{ [ dup WM_LBUTTONUP = ] [ drop handle-wm-buttonup 0 ] }
|
||||||
{ [ dup WM_MBUTTONUP = ] [ drop handle-wm-buttonup 0 ] }
|
{ [ dup WM_MBUTTONUP = ] [ drop handle-wm-buttonup 0 ] }
|
||||||
{ [ dup WM_RBUTTONUP = ] [ drop handle-wm-buttonup 0 ] }
|
{ [ dup WM_RBUTTONUP = ] [ drop handle-wm-buttonup 0 ] }
|
||||||
{ [ dup WM_MOUSEMOVE = ] [ drop handle-wm-mousemove 0 ] }
|
{ [ dup WM_MOUSEMOVE = ] [ drop handle-wm-mousemove 0 ] }
|
||||||
{ [ dup WM_MOUSEWHEEL = ] [ drop handle-wm-mousewheel 0 ] }
|
{ [ dup WM_MOUSEWHEEL = ] [ drop handle-wm-mousewheel 0 ] }
|
||||||
|
|
||||||
{ [ t ] [ drop DefWindowProc ] }
|
{ [ t ] [ drop DefWindowProc ] }
|
||||||
} cond
|
} cond
|
||||||
] catch [ error. 0 ] when*
|
] catch [ error. 0 ] when*
|
||||||
] alien-callback ;
|
] alien-callback ;
|
||||||
|
|
||||||
: event-loop ( -- )
|
: event-loop ( -- )
|
||||||
msg-obj get f 0 0 PM_REMOVE PeekMessage
|
msg-obj get f 0 0 PM_REMOVE PeekMessage
|
||||||
zero? not [
|
zero? not [
|
||||||
msg-obj get MSG-message WM_QUIT = [
|
msg-obj get MSG-message WM_QUIT = [
|
||||||
msg-obj get [ TranslateMessage drop ] keep DispatchMessage drop
|
msg-obj get [ TranslateMessage drop ] keep DispatchMessage drop
|
||||||
] unless
|
] unless
|
||||||
] when
|
] when
|
||||||
ui-step windows get hash-empty? [ event-loop ] unless ;
|
ui-step windows get hash-empty? [ event-loop ] unless ;
|
||||||
|
|
||||||
: register-wndclassex ( classname wndproc -- )
|
: register-wndclassex ( classname wndproc -- )
|
||||||
"WNDCLASSEX" <c-object>
|
"WNDCLASSEX" <c-object>
|
||||||
"WNDCLASSEX" c-size over set-WNDCLASSEX-cbSize
|
"WNDCLASSEX" c-size over set-WNDCLASSEX-cbSize
|
||||||
CS_HREDRAW CS_VREDRAW bitor CS_OWNDC bitor over set-WNDCLASSEX-style
|
CS_HREDRAW CS_VREDRAW bitor CS_OWNDC bitor over set-WNDCLASSEX-style
|
||||||
[ set-WNDCLASSEX-lpfnWndProc ] keep
|
[ set-WNDCLASSEX-lpfnWndProc ] keep
|
||||||
0 over set-WNDCLASSEX-cbClsExtra
|
0 over set-WNDCLASSEX-cbClsExtra
|
||||||
0 over set-WNDCLASSEX-cbWndExtra
|
0 over set-WNDCLASSEX-cbWndExtra
|
||||||
f GetModuleHandle over set-WNDCLASSEX-hInstance
|
f GetModuleHandle over set-WNDCLASSEX-hInstance
|
||||||
f IDI_APPLICATION LoadIcon over set-WNDCLASSEX-hIcon
|
f IDI_APPLICATION LoadIcon over set-WNDCLASSEX-hIcon
|
||||||
f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
|
f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
|
||||||
[ set-WNDCLASSEX-lpszClassName ] keep
|
[ set-WNDCLASSEX-lpszClassName ] keep
|
||||||
RegisterClassEx dup win32-error=0 ;
|
RegisterClassEx dup win32-error=0 ;
|
||||||
|
|
||||||
|
|
||||||
: create-window ( className title width height -- hwnd )
|
: create-window ( className title width height -- hwnd )
|
||||||
make-adjusted-RECT
|
make-adjusted-RECT
|
||||||
>r >r >r ex-style r> r>
|
>r >r >r ex-style r> r>
|
||||||
WS_CLIPSIBLINGS WS_CLIPCHILDREN bitor style bitor
|
WS_CLIPSIBLINGS WS_CLIPCHILDREN bitor style bitor
|
||||||
0 0 r>
|
0 0 r>
|
||||||
get-RECT-dimensions
|
get-RECT-dimensions
|
||||||
f f f GetModuleHandle f CreateWindowEx dup win32-error=0 ;
|
f f f GetModuleHandle f CreateWindowEx dup win32-error=0 ;
|
||||||
|
|
||||||
: show-window ( hWnd -- )
|
: show-window ( hWnd -- )
|
||||||
dup SW_SHOW ShowWindow drop ! always succeeds
|
dup SW_SHOW ShowWindow drop ! always succeeds
|
||||||
dup SetForegroundWindow drop
|
dup SetForegroundWindow drop
|
||||||
SetFocus drop ;
|
SetFocus drop ;
|
||||||
|
|
||||||
: init-win32-ui
|
: init-win32-ui
|
||||||
"MSG" <c-object> msg-obj set
|
"MSG" <c-object> msg-obj set
|
||||||
class-name ui-wndproc register-wndclassex win32-error=0
|
class-name ui-wndproc register-wndclassex win32-error=0
|
||||||
H{ } clone windows set
|
H{ } clone windows set
|
||||||
init-ui ;
|
init-ui ;
|
||||||
|
|
||||||
: cleanup-win32-ui ( -- ) class-name f UnregisterClass drop ;
|
: cleanup-win32-ui ( -- ) class-name f UnregisterClass drop ;
|
||||||
|
|
||||||
: setup-pixel-format ( hdc -- )
|
: setup-pixel-format ( hdc -- )
|
||||||
16 make-pfd [ ChoosePixelFormat dup win32-error=0 ] 2keep
|
16 make-pfd [ ChoosePixelFormat dup win32-error=0 ] 2keep
|
||||||
swapd SetPixelFormat win32-error=0 ;
|
swapd SetPixelFormat win32-error=0 ;
|
||||||
|
|
||||||
: get-dc ( hWnd -- hDC ) GetDC dup win32-error=0 ;
|
: get-dc ( hWnd -- hDC ) GetDC dup win32-error=0 ;
|
||||||
|
|
||||||
: get-rc ( hDC -- hRC )
|
: get-rc ( hDC -- hRC )
|
||||||
dup wglCreateContext dup win32-error=0
|
dup wglCreateContext dup win32-error=0
|
||||||
[ wglMakeCurrent win32-error=0 ] keep ;
|
[ wglMakeCurrent win32-error=0 ] keep ;
|
||||||
|
|
||||||
: setup-gl ( hwnd -- hDC hRC )
|
: setup-gl ( hwnd -- hDC hRC )
|
||||||
get-dc
|
get-dc
|
||||||
dup setup-pixel-format
|
dup setup-pixel-format
|
||||||
dup get-rc ;
|
dup get-rc ;
|
||||||
|
|
||||||
: make-gadget-window ( world title -- <gadget-window> )
|
: make-gadget-window ( world title -- <gadget-window> )
|
||||||
class-name swap pick rect-dim first2 create-window
|
class-name swap pick rect-dim first2 create-window
|
||||||
dup setup-gl <gadget-window> ;
|
dup setup-gl <gadget-window> ;
|
||||||
|
|
||||||
IN: gadgets
|
IN: gadgets
|
||||||
|
|
||||||
: open-window* ( world title -- )
|
: open-window* ( world title -- )
|
||||||
make-gadget-window
|
make-gadget-window
|
||||||
[ [ gadget-window-hWnd ] keep gadget-window-world set-world-handle ] keep
|
[ [ gadget-window-hWnd ] keep gadget-window-world set-world-handle ] keep
|
||||||
dup gadget-window-hWnd [ windows get set-hash ] keep show-window ;
|
dup gadget-window-hWnd [ windows get set-hash ] keep show-window ;
|
||||||
|
|
||||||
: select-gl-context ( handle -- )
|
: select-gl-context ( handle -- )
|
||||||
get-gadget-window
|
get-gadget-window
|
||||||
[
|
[
|
||||||
[ gadget-window-hDC ] keep gadget-window-hRC
|
[ gadget-window-hDC ] keep gadget-window-hRC
|
||||||
wglMakeCurrent win32-error=0
|
wglMakeCurrent win32-error=0
|
||||||
] when* ;
|
] when* ;
|
||||||
|
|
||||||
: flush-gl-context ( handle -- )
|
: flush-gl-context ( handle -- )
|
||||||
get-gadget-window [ gadget-window-hDC SwapBuffers win32-error=0 ] when* ;
|
get-gadget-window [ gadget-window-hDC SwapBuffers win32-error=0 ] when* ;
|
||||||
|
|
||||||
IN: shells
|
IN: shells
|
||||||
: ui
|
: ui
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
init-win32-ui
|
init-win32-ui
|
||||||
launchpad-window
|
launchpad-window
|
||||||
listener-window
|
listener-window
|
||||||
event-loop
|
event-loop
|
||||||
] with-freetype
|
] with-freetype
|
||||||
] [ cleanup-win32-ui ] cleanup ;
|
] [ cleanup-win32-ui ] cleanup ;
|
||||||
|
|
||||||
IN: kernel
|
IN: kernel
|
||||||
: default-shell "ui" ;
|
: default-shell "ui" ;
|
||||||
|
|
|
||||||
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue