steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

minimize crash fix, win32 -> win32-api rename

erg 2006-03-26 23:02:57 +00:00
parent ca0ec4afaf
commit 1a95f1aee8
10 changed files with 95 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
contrib/win32/clipboard.factor
View File

@ -1,5 +1,5 @@
USING: kernel win32 math namespaces io prettyprint errors sequences alien ;
IN: clipboard
USING: kernel win32-api math namespaces io prettyprint errors sequences alien ;
IN: win32
: (enum-clipboard) ( n -- )
EnumClipboardFormats win32-error dup 0 > [ dup , (enum-clipboard) ] when ;

2
contrib/win32/gdi32.factor
View File

@ -1,7 +1,7 @@
IN: win32
USING: alien kernel errors ;
LIBRARY: gdi
LIBRARY: gdi32
! Stock Logical Objects
: WHITE_BRUSH 0 ; inline

4
contrib/win32/kernel32.factor
View File

@ -1,7 +1,7 @@
USING: alien kernel errors ;
IN: win32
IN: win32-api
LIBRARY: kernel
LIBRARY: kernel32
! FUNCTION: MAKEINTRESOURCEA
! FUNCTION: MAKEINTRESOURCEW

6
contrib/win32/load.factor
View File

@ -2,9 +2,9 @@ IN: scratchpad
USING: alien compiler kernel parser sequences words ;
{
{ "gdi" "gdi32" }
{ "user" "user32" }
{ "kernel" "kernel32" }
{ "gdi32" "gdi32" }
{ "user32" "user32" }
{ "kernel32" "kernel32" }
} [ first2 add-simple-library ] each
{

2
contrib/win32/opengl32.factor
View File

@ -1,5 +1,5 @@
USING: alien parser namespaces kernel syntax words math io prettyprint ;
IN: win32
IN: win32-api
! PIXELFORMATDESCRIPTOR flags
: PFD_DOUBLEBUFFER HEX: 00000001 ; inline

2
contrib/win32/types.factor
View File

@ -1,5 +1,5 @@
USING: alien namespaces kernel words ;
IN: win32
IN: win32-api
! http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winprog/winprog/windows_data_types.asp

19
contrib/win32/ui.factor
View File

@ -1,6 +1,6 @@
USING: alien arrays errors freetype gadgets gadgets-launchpad gadgets-layouts
gadgets-listener hashtables io kernel lists math namespaces prettyprint
sequences strings vectors words windows-messages ;
sequences strings vectors words win32-api-messages win32-api ;
USING: inspector threads memory ;
IN: win32
@ -11,6 +11,8 @@ SYMBOL: msg-obj
! hDC = handle to device context, hRC = handle to render context
TUPLE: gadget-window world hWnd hDC hRC ;
: class-name "Factor" ;
: get-world ( hWnd -- world ) windows get hash gadget-window-world ;
: get-gadget-window ( hWnd -- gadget-window )
windows get hash ;
@ -41,7 +43,12 @@ TUPLE: gadget-window world hWnd hDC hRC ;
: handle-wm-size ( hWnd uMsg wParam lParam -- )
[ lo-word ] keep hi-word make-RECT get-RECT-dimensions 0 3array
2nip swap get-world set-gadget-dim ;
2nip
dup { 0 0 0 } = [
2drop
] [
swap get-world set-gadget-dim
] if ;
: wm-keydown-codes ( n -- key )
H{
@ -212,11 +219,11 @@ SYMBOL: hWnd
: init-win32-ui
"MSG" <c-object> msg-obj set
"Factor" ui-wndproc register-wndclassex win32-error=0
class-name ui-wndproc register-wndclassex win32-error=0
H{ } clone windows set
init-ui ;
: cleanup-win32-ui ( -- ) "Factor" f UnregisterClass drop ;
: cleanup-win32-ui ( -- ) class-name f UnregisterClass drop ;
: setup-pixel-format ( hdc -- )
16 make-pfd [ ChoosePixelFormat dup win32-error=0 ] 2keep
@ -234,7 +241,7 @@ SYMBOL: hWnd
dup get-rc ;
: make-gadget-window ( world title -- <gadget-window> )
"Factor" swap pick rect-dim first2 create-window
class-name swap pick rect-dim first2 create-window
dup setup-gl <gadget-window> ;
IN: gadgets
@ -255,7 +262,7 @@ IN: gadgets
get-gadget-window [ gadget-window-hDC SwapBuffers win32-error=0 ] when* ;
IN: shells
: ui ( -- )
: ui
[
[
init-win32-ui

77
contrib/win32/user32.factor
View File

@ -1,5 +1,5 @@
USING: alien parser namespaces kernel syntax words math io prettyprint ;
IN: win32
IN: win32-api
TYPEDEF: void* MSGBOXPARAMSA
@ -438,8 +438,53 @@ TYPEDEF: void* MSGBOXPARAMSW
: MK_XBUTTON2 HEX: 0040 ; inline
! Some fields are not defined for win64
! Window field offsets for GetWindowLong()
! TODO: win32 only!!
windows? [
: GWL_WNDPROC -4 ;
: GWL_HINSTANCE -6 ;
: GWL_HWNDPARENT -8 ;
: GWL_USERDATA -21 ;
: GWL_ID -12 ;
] when
LIBRARY: user
: GWL_STYLE -16 ;
: GWL_EXSTYLE -20 ;
: GWLP_WNDPROC -4 ;
: GWLP_HINSTANCE -6 ;
: GWLP_HWNDPARENT -8 ;
: GWLP_USERDATA -21 ;
: GWLP_ID -12 ;
! Class field offsets for GetClassLong()
! TODO: win32 only!
windows? [
: GCL_MENUNAME -8 ;
: GCL_HBRBACKGROUND -10 ;
: GCL_HCURSOR -12 ;
: GCL_HICON -14 ;
: GCL_HMODULE -16 ;
: GCL_WNDPROC -24 ;
: GCL_HICONSM -34 ;
] when
: GCL_CBWNDEXTRA -18 ;
: GCL_CBCLSEXTRA -20 ;
: GCL_STYLE -26 ;
: GCW_ATOM -32 ;
: GCLP_MENUNAME -8 ;
: GCLP_HBRBACKGROUND -10 ;
: GCLP_HCURSOR -12 ;
: GCLP_HICON -14 ;
: GCLP_HMODULE -16 ;
: GCLP_WNDPROC -24 ;
: GCLP_HICONSM -34 ;
LIBRARY: user32
FUNCTION: HKL ActivateKeyboardLayout ( HKL hkl, UINT Flags ) ;
FUNCTION: BOOL AdjustWindowRect ( LPRECT lpRect, DWORD dwStyle, BOOL bMenu ) ;
@ -734,12 +779,20 @@ FUNCTION: UINT EnumClipboardFormats ( UINT format ) ;
! FUNCTION: GetCapture
! FUNCTION: GetCaretBlinkTime
! FUNCTION: GetCaretPos
! FUNCTION: GetClassInfoA
! FUNCTION: GetClassInfoExA
! FUNCTION: GetClassInfoExW
! FUNCTION: GetClassInfoW
! FUNCTION: GetClassLongA
! FUNCTION: GetClassLongW
FUNCTION: BOOL GetClassInfoA ( HINSTANCE hInst, LPCTSTR lpszClass, LPWNDCLASS lpwcx ) ;
FUNCTION: BOOL GetClassInfoW ( HINSTANCE hInst, LPCWSTR lpszClass, LPWNDCLASS lpwcx ) ;
: GetClassInfo \ GetClassInfoW \ GetClassInfoA unicode-exec ;
FUNCTION: BOOL GetClassInfoExA ( HINSTANCE hInst, LPCTSTR lpszClass, LPWNDCLASSEX lpwcx ) ;
FUNCTION: BOOL GetClassInfoExW ( HINSTANCE hInst, LPCWSTR lpszClass, LPWNDCLASSEX lpwcx ) ;
: GetClassInfoEx \ GetClassInfoExW \ GetClassInfoExA unicode-exec ;
FUNCTION: ULONG_PTR GetClassLongA ( HWND hWnd, int nIndex ) ;
FUNCTION: ULONG_PTR GetClassLongW ( HWND hWnd, int nIndex ) ;
: GetClassLong \ GetClassLongW \ GetClassLongA unicode-exec ;
: GetClassLongPtr \ GetClassLongW \ GetClassLongA unicode-exec ;
! FUNCTION: GetClassNameA
! FUNCTION: GetClassNameW
! FUNCTION: GetClassWord
@ -1156,8 +1209,12 @@ FUNCTION: int ReleaseDC ( HWND hWnd, HDC hDC ) ;
! FUNCTION: SetCapture
! FUNCTION: SetCaretBlinkTime
! FUNCTION: SetCaretPos
! FUNCTION: SetClassLongA
! FUNCTION: SetClassLongW
FUNCTION: ULONG_PTR SetClassLongW ( HWND hWnd, int nIndex, LONG_PTR dwNewLong ) ;
FUNCTION: ULONG_PTR SetClassLongA ( HWND hWnd, int nIndex, LONG_PTR dwNewLong ) ;
: SetClassLongPtr \ SetClassLongW \ SetClassLongA unicode-exec ;
: SetClassLong \ SetClassLongW \ SetClassLongA unicode-exec ;
! FUNCTION: SetClassWord
FUNCTION: HANDLE SetClipboardData ( UINT uFormat, HANDLE hMem ) ;
! FUNCTION: SetClipboardViewer

9
contrib/win32/utils.factor
View File

@ -1,17 +1,14 @@
USING: alien parser namespaces kernel syntax words math io prettyprint ;
IN: win32
IN: win32-api
: win32-error=0 0 = [ win32-error ] when ;
: win32-error=0 zero? [ win32-error ] when ;
: win32-error>0 0 > [ win32-error ] when ;
: win32-error<0 0 < [ win32-error ] when ;
: win32-error<>0 0 = [ win32-error ] unless ;
: win32-error<>0 zero? [ win32-error ] unless ;
: lo-word ( wparam -- lo ) HEX: ffff bitand ;
: hi-word ( wparam -- hi ) -16 shift ;
: hello-world
f "Hello, world!" "First Application" MB_OK MessageBox win32-error drop ;
: msgbox ( str -- )
f swap "DebugMsg" MB_OK MessageBox drop ;

2
contrib/win32/windows-messages.factor
View File

@ -1,5 +1,5 @@
USING: hashtables kernel math namespaces parser prettyprint words ;
IN: windows-messages
IN: win32-api-messages
SYMBOL: windows-messages