win32 support for window-controls
Joe Groff
parent
c19c0d0395
commit
62ed8d1404
|
|
@ -190,7 +190,7 @@ TUPLE: window-rect < rect window-loc ;
|
|||
DBT_DEVTYP_DEVICEINTERFACE over set-DEV_BROADCAST_DEVICEW-dbcc_devicetype ;
|
||||
|
||||
: create-device-change-window ( -- )
|
||||
<zero-window-rect> create-window
|
||||
<zero-window-rect> WS_OVERLAPPEDWINDOW 0 create-window
|
||||
[
|
||||
(device-notification-filter)
|
||||
DEVICE_NOTIFY_WINDOW_HANDLE DEVICE_NOTIFY_ALL_INTERFACE_CLASSES bitor
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: help.markup help.syntax math sequences ;
|
||||
USING: assocs help.markup help.syntax math sequences ;
|
||||
IN: math.bitwise
|
||||
|
||||
HELP: bitfield
|
||||
|
|
@ -145,6 +145,25 @@ HELP: flags
|
|||
}
|
||||
} ;
|
||||
|
||||
HELP: symbols>flags
|
||||
{ $values { "symbols" sequence } { "assoc" assoc } { "flag-bits" integer } }
|
||||
{ $description "Constructs an integer value by mapping the values in the " { $snippet "symbols" } " sequence to integer values using " { $snippet "assoc" } " and " { $link bitor } "ing the values together." }
|
||||
{ $examples
|
||||
{ $example "USING: math.bitwise prettyprint ui.gadgets.worlds ;"
|
||||
"IN: scratchpad"
|
||||
"CONSTANT: window-controls>flags H{"
|
||||
" { close-button 1 }"
|
||||
" { minimize-button 2 }"
|
||||
" { maximize-button 4 }"
|
||||
" { resize-handles 8 }"
|
||||
" { small-title-bar 16 }"
|
||||
" { normal-title-bar 32 }"
|
||||
"}"
|
||||
"{ resize-handles close-button small-title-bar } window-controls>flags symbols>flags ."
|
||||
"25"
|
||||
}
|
||||
} ;
|
||||
|
||||
HELP: mask
|
||||
{ $values
|
||||
{ "x" integer } { "n" integer }
|
||||
|
|
|
|||
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2007, 2008 Slava Pestov, Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math sequences accessors math.bits
|
||||
sequences.private words namespaces macros hints
|
||||
combinators fry io.binary combinators.smart ;
|
||||
USING: arrays assocs kernel math sequences accessors
|
||||
math.bits sequences.private words namespaces macros
|
||||
hints combinators fry io.binary combinators.smart ;
|
||||
IN: math.bitwise
|
||||
|
||||
! utilities
|
||||
|
|
@ -44,6 +44,10 @@ IN: math.bitwise
|
|||
MACRO: flags ( values -- )
|
||||
[ 0 ] [ [ ?execute bitor ] curry compose ] reduce ;
|
||||
|
||||
: symbols>flags ( symbols assoc -- flag-bits )
|
||||
[ at ] curry map
|
||||
0 [ bitor ] reduce ;
|
||||
|
||||
! bitfield
|
||||
<PRIVATE
|
||||
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@ cocoa.pasteboard cocoa.runtime cocoa.subclassing cocoa.types
|
|||
cocoa.views cocoa.windows combinators command-line
|
||||
core-foundation core-foundation.run-loop core-graphics
|
||||
core-graphics.types destructors fry generalizations io.thread
|
||||
kernel libc literals locals math math.rectangles memory
|
||||
kernel libc literals locals math math.bitwise math.rectangles memory
|
||||
namespaces sequences specialized-arrays.int threads ui
|
||||
ui.backend ui.backend.cocoa.views ui.clipboards ui.gadgets
|
||||
ui.gadgets.worlds ui.pixel-formats ui.pixel-formats.private
|
||||
|
|
@ -120,7 +120,7 @@ CONSTANT: window-control>styleMask
|
|||
}
|
||||
|
||||
: world>styleMask ( world -- n )
|
||||
window-controls>> [ window-control>styleMask at ] map 0 [ bitor ] reduce ;
|
||||
window-controls>> window-control>styleMask symbols>flags ;
|
||||
|
||||
M:: cocoa-ui-backend (open-window) ( world -- )
|
||||
world [ [ dim>> ] dip <FactorView> ]
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@ windows.kernel32 windows.gdi32 windows.user32 windows.opengl32
|
|||
windows.messages windows.types windows.offscreen windows.nt
|
||||
threads libc combinators fry combinators.short-circuit continuations
|
||||
command-line shuffle opengl ui.render math.bitwise locals
|
||||
accessors math.rectangles math.order calendar ascii
|
||||
accessors math.rectangles math.order calendar ascii sets
|
||||
io.encodings.utf16n windows.errors literals ui.pixel-formats
|
||||
ui.pixel-formats.private memoize classes struct-arrays ;
|
||||
IN: ui.backend.windows
|
||||
|
|
@ -223,8 +223,36 @@ M: pasteboard set-clipboard-contents drop copy ;
|
|||
|
||||
SYMBOLS: msg-obj class-name-ptr mouse-captured ;
|
||||
|
||||
: style ( -- n ) WS_OVERLAPPEDWINDOW ; inline
|
||||
: ex-style ( -- n ) WS_EX_APPWINDOW WS_EX_WINDOWEDGE bitor ; inline
|
||||
CONSTANT: window-control>style
|
||||
H{
|
||||
{ close-button 0 }
|
||||
{ minimize-button $ WS_MINIMIZEBOX }
|
||||
{ maximize-button $ WS_MAXIMIZEBOX }
|
||||
{ resize-handles $ WS_THICKFRAME }
|
||||
{ small-title-bar $ WS_CAPTION }
|
||||
{ normal-title-bar $ WS_CAPTION }
|
||||
}
|
||||
|
||||
CONSTANT: window-control>ex-style
|
||||
H{
|
||||
{ close-button 0 }
|
||||
{ minimize-button 0 }
|
||||
{ maximize-button 0 }
|
||||
{ resize-handles $ WS_EX_WINDOWEDGE }
|
||||
{ small-title-bar $ WS_EX_TOOLWINDOW }
|
||||
{ normal-title-bar $ WS_EX_APPWINDOW }
|
||||
}
|
||||
|
||||
: needs-sysmenu? ( controls -- ? )
|
||||
{ close-button minimize-button maximize-button } intersects? ;
|
||||
|
||||
: world>style ( world -- n )
|
||||
window-controls>>
|
||||
[ window-control>style symbols>flags ]
|
||||
[ needs-sysmenu? [ WS_SYSMENU bitor ] when ] bi ;
|
||||
|
||||
: world>ex-style ( world -- n )
|
||||
window-controls>> window-control>ex-style symbols>flags ;
|
||||
|
||||
: get-RECT-top-left ( RECT -- x y )
|
||||
[ RECT-left ] keep RECT-top ;
|
||||
|
|
@ -571,8 +599,8 @@ M: windows-ui-backend do-events
|
|||
RegisterClassEx win32-error=0/f
|
||||
] [ drop ] if ;
|
||||
|
||||
: adjust-RECT ( RECT -- )
|
||||
style 0 ex-style AdjustWindowRectEx win32-error=0/f ;
|
||||
: adjust-RECT ( RECT style ex-style -- )
|
||||
[ 0 ] dip AdjustWindowRectEx win32-error=0/f ;
|
||||
|
||||
: make-RECT ( world -- RECT )
|
||||
[ window-loc>> ] [ dim>> ] bi <RECT> ;
|
||||
|
|
@ -584,10 +612,12 @@ M: windows-ui-backend do-events
|
|||
CW_USEDEFAULT over set-RECT-left
|
||||
CW_USEDEFAULT swap set-RECT-top ;
|
||||
|
||||
: make-adjusted-RECT ( rect -- RECT )
|
||||
make-RECT
|
||||
dup get-RECT-top-left [ zero? ] both? swap
|
||||
dup adjust-RECT
|
||||
: make-adjusted-RECT ( rect style ex-style -- RECT )
|
||||
[
|
||||
make-RECT
|
||||
dup get-RECT-top-left [ zero? ] both? swap
|
||||
dup
|
||||
] 2dip adjust-RECT
|
||||
swap [ dup default-position-RECT ] when ;
|
||||
|
||||
: get-window-class ( -- class-name )
|
||||
|
|
@ -597,12 +627,12 @@ M: windows-ui-backend do-events
|
|||
dup
|
||||
] change-global ;
|
||||
|
||||
: create-window ( rect -- hwnd )
|
||||
make-adjusted-RECT
|
||||
:: create-window ( rect style ex-style -- hwnd )
|
||||
rect style ex-style make-adjusted-RECT
|
||||
[ get-window-class f ] dip
|
||||
[
|
||||
[ ex-style ] 2dip
|
||||
{ WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags
|
||||
WS_CLIPSIBLINGS WS_CLIPCHILDREN bitor style bitor
|
||||
] dip get-RECT-dimensions
|
||||
f f f GetModuleHandle f CreateWindowEx dup win32-error=0/f ;
|
||||
|
||||
|
|
@ -636,8 +666,21 @@ M: windows-ui-backend do-events
|
|||
[ swap [ handle>> hDC>> set-pixel-format ] [ get-rc ] bi ]
|
||||
with-world-pixel-format ;
|
||||
|
||||
: disable-close-button ( hwnd -- )
|
||||
0 GetSystemMenu
|
||||
SC_CLOSE MF_BYCOMMAND MF_GRAYED bitor EnableMenuItem drop ;
|
||||
|
||||
: ?disable-close-button ( world hwnd -- )
|
||||
swap window-controls>> close-button swap member? not
|
||||
[ disable-close-button ] [ drop ] if ;
|
||||
|
||||
M: windows-ui-backend (open-window) ( world -- )
|
||||
[ dup create-window [ f f ] dip f f <win> >>handle setup-gl ]
|
||||
[
|
||||
dup
|
||||
[ ] [ world>style ] [ world>ex-style ] tri create-window
|
||||
[ ?disable-close-button ]
|
||||
[ [ f f ] dip f f <win> >>handle setup-gl ] 2bi
|
||||
]
|
||||
[ dup handle>> hWnd>> register-window ]
|
||||
[ handle>> hWnd>> show-window ] tri ;
|
||||
|
||||
|
|
@ -743,13 +786,9 @@ M: windows-ui-backend (ungrab-input) ( handle -- )
|
|||
} cleave ;
|
||||
|
||||
: exit-fullscreen ( world -- )
|
||||
handle>> hWnd>>
|
||||
dup handle>> hWnd>>
|
||||
{
|
||||
[
|
||||
GWL_STYLE GetWindowLong
|
||||
fullscreen-flags bitor
|
||||
]
|
||||
[ GWL_STYLE rot SetWindowLong win32-error=0/f ]
|
||||
[ GWL_STYLE rot world>style SetWindowLong win32-error=0/f ]
|
||||
[
|
||||
f
|
||||
over hwnd>RECT get-RECT-dimensions
|
||||
|
|
|
|||
|
|
@ -582,6 +582,28 @@ CONSTANT: SWP_NOREPOSITION SWP_NOOWNERZORDER
|
|||
CONSTANT: SWP_DEFERERASE 8192
|
||||
CONSTANT: SWP_ASYNCWINDOWPOS 16384
|
||||
|
||||
CONSTANT: MF_ENABLED HEX: 0000
|
||||
CONSTANT: MF_GRAYED HEX: 0001
|
||||
CONSTANT: MF_DISABLED HEX: 0002
|
||||
CONSTANT: MF_STRING HEX: 0000
|
||||
CONSTANT: MF_BITMAP HEX: 0004
|
||||
CONSTANT: MF_UNCHECKED HEX: 0000
|
||||
CONSTANT: MF_CHECKED HEX: 0008
|
||||
CONSTANT: MF_POPUP HEX: 0010
|
||||
CONSTANT: MF_MENUBARBREAK HEX: 0020
|
||||
CONSTANT: MF_MENUBREAK HEX: 0040
|
||||
CONSTANT: MF_UNHILITE HEX: 0000
|
||||
CONSTANT: MF_HILITE HEX: 0080
|
||||
CONSTANT: MF_OWNERDRAW HEX: 0100
|
||||
CONSTANT: MF_USECHECKBITMAPS HEX: 0200
|
||||
CONSTANT: MF_BYCOMMAND HEX: 0000
|
||||
CONSTANT: MF_BYPOSITION HEX: 0400
|
||||
CONSTANT: MF_SEPARATOR HEX: 0800
|
||||
CONSTANT: MF_DEFAULT HEX: 1000
|
||||
CONSTANT: MF_SYSMENU HEX: 2000
|
||||
CONSTANT: MF_HELP HEX: 4000
|
||||
CONSTANT: MF_RIGHTJUSTIFY HEX: 4000
|
||||
CONSTANT: MF_MOUSESELECT HEX: 8000
|
||||
|
||||
LIBRARY: user32
|
||||
|
||||
|
|
@ -807,7 +829,7 @@ FUNCTION: BOOL DrawIcon ( HDC hDC, int X, int Y, HICON hIcon ) ;
|
|||
! FUNCTION: DrawTextW
|
||||
! FUNCTION: EditWndProc
|
||||
FUNCTION: BOOL EmptyClipboard ( ) ;
|
||||
! FUNCTION: EnableMenuItem
|
||||
FUNCTION: BOOL EnableMenuItem ( HMENU hMenu, UINT uIDEnableItem, UINT uEnable ) ;
|
||||
! FUNCTION: EnableScrollBar
|
||||
! FUNCTION: EnableWindow
|
||||
! FUNCTION: EndDeferWindowPos
|
||||
|
|
@ -975,7 +997,7 @@ FUNCTION: int GetPriorityClipboardFormat ( UINT* paFormatPriorityList, int cForm
|
|||
! FUNCTION: GetSubMenu
|
||||
! FUNCTION: GetSysColor
|
||||
FUNCTION: HBRUSH GetSysColorBrush ( int nIndex ) ;
|
||||
! FUNCTION: GetSystemMenu
|
||||
FUNCTION: HMENU GetSystemMenu ( HWND hWnd, BOOL bRevert ) ;
|
||||
! FUNCTION: GetSystemMetrics
|
||||
! FUNCTION: GetTabbedTextExtentA
|
||||
! FUNCTION: GetTabbedTextExtentW
|
||||
|
|
|
|||
|
|
@ -7,9 +7,10 @@ CONSTANT: window-control-sets-to-test
|
|||
H{
|
||||
{ "No controls" { } }
|
||||
{ "Normal title bar" { normal-title-bar } }
|
||||
{ "Small title bar" { small-title-bar } }
|
||||
{ "Small title bar" { small-title-bar close-button } }
|
||||
{ "Close button" { normal-title-bar close-button } }
|
||||
{ "Close and minimize buttons" { normal-title-bar close-button minimize-button } }
|
||||
{ "Minimize button" { normal-title-bar minimize-button } }
|
||||
{ "Close, minimize, and maximize buttons" { normal-title-bar close-button minimize-button maximize-button } }
|
||||
{ "Resizable" { normal-title-bar close-button minimize-button maximize-button resize-handles } }
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue