fullscreen* -> (fullscreen?), set-fullscreen* -> (set-fullscreen), fix jamshred screen toggling

db4
Doug Coleman 2009-05-13 22:28:33 -05:00
parent 4848473cfd
commit 0d8115a940
7 changed files with 20 additions and 18 deletions

View File

@ -7,9 +7,9 @@ SYMBOL: ui-backend
HOOK: set-title ui-backend ( string world -- )
HOOK: set-fullscreen* ui-backend ( ? world -- )
HOOK: (set-fullscreen) ui-backend ( world ? -- )
HOOK: fullscreen* ui-backend ( world -- ? )
HOOK: (fullscreen?) ui-backend ( world -- ? )
HOOK: (open-window) ui-backend ( world -- )

View File

@ -101,10 +101,10 @@ M: cocoa-ui-backend set-title ( string world -- )
: exit-fullscreen ( world -- )
handle>> view>> f -> exitFullScreenModeWithOptions: ;
M: cocoa-ui-backend set-fullscreen* ( ? world -- )
swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
M: cocoa-ui-backend (set-fullscreen) ( world ? -- )
[ enter-fullscreen ] [ exit-fullscreen ] if ;
M: cocoa-ui-backend fullscreen* ( world -- ? )
M: cocoa-ui-backend (fullscreen?) ( world -- ? )
handle>> view>> -> isInFullScreenMode zero? not ;
M:: cocoa-ui-backend (open-window) ( world -- )

View File

@ -758,10 +758,10 @@ M: windows-ui-backend (ungrab-input) ( handle -- )
[ SW_RESTORE ShowWindow win32-error=0/f ]
} cleave ;
M: windows-ui-backend set-fullscreen* ( ? world -- )
swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
M: windows-ui-backend (set-fullscreen) ( ? world -- )
[ enter-fullscreen ] [ exit-fullscreen ] if ;
M: windows-ui-backend fullscreen* ( world -- ? )
M: windows-ui-backend (fullscreen?) ( world -- ? )
[ handle>> hWnd>> hwnd>RECT ]
[ handle>> hWnd>> fullscreen-RECT ] bi
[ get-RECT-dimensions 2array 2nip ] bi@ = ;

View File

@ -268,10 +268,12 @@ M: x11-ui-backend set-title ( string world -- )
handle>> window>> swap
[ dpy get ] 2dip [ set-title-old ] [ set-title-new ] 3bi ;
M: x11-ui-backend set-fullscreen* ( ? world -- )
handle>> window>> "XClientMessageEvent" <c-object>
[ set-XClientMessageEvent-window ] keep
swap _NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
M: x11-ui-backend (set-fullscreen) ( world ? -- )
[
handle>> window>> "XClientMessageEvent" <c-object>
[ set-XClientMessageEvent-window ] keep
] dip
_NET_WM_STATE_ADD _NET_WM_STATE_REMOVE ?
over set-XClientMessageEvent-data0
ClientMessage over set-XClientMessageEvent-type
dpy get over set-XClientMessageEvent-display

View File

@ -26,7 +26,7 @@ HELP: world-attributes
} ;
HELP: set-fullscreen
{ $values { "?" "a boolean" } { "gadget" gadget } }
{ $values { "gadget" gadget } { "?" "a boolean" } }
{ $description "Sets and unsets fullscreen mode for the gadget's world." } ;
HELP: fullscreen?

View File

@ -209,14 +209,14 @@ PRIVATE>
: open-window ( gadget title/attributes -- )
?attributes <world> open-world-window ;
: set-fullscreen ( ? gadget -- )
find-world set-fullscreen* ;
: set-fullscreen ( gadget ? -- )
[ find-world ] dip (set-fullscreen) ;
: fullscreen? ( gadget -- ? )
find-world fullscreen* ;
find-world (fullscreen?) ;
: toggle-fullscreen ( gadget -- )
[ fullscreen? not ] keep set-fullscreen ;
dup fullscreen? not set-fullscreen ;
: raise-window ( gadget -- )
find-world raise-window* ;

View File

@ -64,7 +64,7 @@ M: jamshred-gadget ungraft* ( gadget -- )
[ second mouse-scroll-y ] 2bi ;
: quit ( gadget -- )
[ no-fullscreen ] [ close-window ] bi ;
[ f set-fullscreen ] [ close-window ] bi ;
jamshred-gadget H{
{ T{ key-down f f "r" } [ jamshred-restart ] }