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

Merge branch 'master' of git://factorcode.org/git/factor

db4
Joe Groff 2009-05-14 10:09:16 -05:00
parent ba9ba118a6 06efcd1502
commit 7c10b6d4d5
1 changed files with 14 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
basis/ui/backend/windows/windows.factor
View File

@ -556,11 +556,9 @@ M: windows-ui-backend do-events
[ DispatchMessage drop ] bi [ DispatchMessage drop ] bi
] if ; ] if ;
: register-wndclassex ( -- class ) :: register-window-class ( class-name-ptr -- )
"WNDCLASSEX" <c-object> "WNDCLASSEX" <c-object> f GetModuleHandle
f GetModuleHandle class-name-ptr pick GetClassInfoEx 0 = [
class-name-ptr get-global
pick GetClassInfoEx zero? [
"WNDCLASSEX" heap-size over set-WNDCLASSEX-cbSize "WNDCLASSEX" heap-size over set-WNDCLASSEX-cbSize
{ CS_HREDRAW CS_VREDRAW CS_OWNDC } flags over set-WNDCLASSEX-style { CS_HREDRAW CS_VREDRAW CS_OWNDC } flags over set-WNDCLASSEX-style
ui-wndproc over set-WNDCLASSEX-lpfnWndProc ui-wndproc over set-WNDCLASSEX-lpfnWndProc
@ -571,9 +569,9 @@ M: windows-ui-backend do-events
over set-WNDCLASSEX-hIcon over set-WNDCLASSEX-hIcon
f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor f IDC_ARROW LoadCursor over set-WNDCLASSEX-hCursor
class-name-ptr get-global over set-WNDCLASSEX-lpszClassName class-name-ptr over set-WNDCLASSEX-lpszClassName
RegisterClassEx dup win32-error=0/f RegisterClassEx win32-error=0/f
] when ; ] [ drop ] if ;
: adjust-RECT ( RECT -- ) : adjust-RECT ( RECT -- )
style 0 ex-style AdjustWindowRectEx win32-error=0/f ; style 0 ex-style AdjustWindowRectEx win32-error=0/f ;
@ -594,9 +592,16 @@ M: windows-ui-backend do-events
dup adjust-RECT dup adjust-RECT
swap [ dup default-position-RECT ] when ; swap [ dup default-position-RECT ] when ;
: get-window-class ( -- class-name )
class-name-ptr [
dup expired? [ drop "Factor-window" utf16n malloc-string ] when
dup register-window-class
dup
] change-global ;
: create-window ( rect -- hwnd ) : create-window ( rect -- hwnd )
make-adjusted-RECT make-adjusted-RECT
[ class-name-ptr get-global f ] dip [ get-window-class f ] dip
[ [
[ ex-style ] 2dip [ ex-style ] 2dip
{ WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags { WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags
@ -611,8 +616,6 @@ M: windows-ui-backend do-events
: init-win32-ui ( -- ) : init-win32-ui ( -- )
V{ } clone nc-buttons set-global V{ } clone nc-buttons set-global
"MSG" malloc-object msg-obj set-global "MSG" malloc-object msg-obj set-global
"Factor-window" utf16n malloc-string class-name-ptr set-global
register-wndclassex drop
GetDoubleClickTime milliseconds double-click-timeout set-global ; GetDoubleClickTime milliseconds double-click-timeout set-global ;
: cleanup-win32-ui ( -- ) : cleanup-win32-ui ( -- )