fullscreen: looks like the vocab belongs in the windows hierarchy

diff --git a/extra/fullscreen/authors.txt b/extra/fullscreen/authors.txt
deleted file mode 100644 (file)
index 7c1b2f2..0000000
--- a/extra/fullscreen/authors.txt
+++ /dev/null
@@ -1 +0,0 @@
-Doug Coleman

diff --git a/extra/fullscreen/fullscreen.factor b/extra/fullscreen/fullscreen.factor
deleted file mode 100755 (executable)
index 7b30d25..0000000
--- a/extra/fullscreen/fullscreen.factor
+++ /dev/null
@@ -1,142 +0,0 @@
-! Copyright (C) 2010 Doug Coleman.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors alien.c-types arrays classes.struct fry kernel
-literals locals make math math.bitwise multiline sequences
-slots.syntax ui.backend.windows vocabs.loader windows.errors
-windows.gdi32 windows.kernel32 windows.types windows.user32
-ui.gadgets.worlds ;
-IN: fullscreen
-
-: hwnd>hmonitor ( HWND -- HMONITOR )
-    MONITOR_DEFAULTTOPRIMARY MonitorFromWindow ;
-
-: desktop-hmonitor ( -- HMONITOR )
-    GetDesktopWindow hwnd>hmonitor ;
-
-:: (monitor-info>devmodes) ( monitor-info n -- )
-    DEVMODE <struct>
-        DEVMODE heap-size >>dmSize
-        flags{ DM_BITSPERPEL DM_PELSWIDTH DM_PELSHEIGHT } >>dmFields
-    :> devmode
-
-    monitor-info szDevice>>
-    n
-    devmode
-    EnumDisplaySettings 0 = [
-        devmode ,
-        monitor-info n 1 + (monitor-info>devmodes)
-    ] unless ;
-
-: monitor-info>devmodes ( monito-info -- devmodes )
-    [ 0 (monitor-info>devmodes) ] { } make ;
-
-: hmonitor>monitor-info ( HMONITOR -- monitor-info )
-    MONITORINFOEX <struct>
-        MONITORINFOEX heap-size >>cbSize
-    [ GetMonitorInfo win32-error=0/f ] keep ;
-
-: hwnd>monitor-info ( HWND -- monitor-info )
-    hwnd>hmonitor hmonitor>monitor-info ;
-
-: hmonitor>devmodes ( HMONITOR -- devmodes )
-    hmonitor>monitor-info monitor-info>devmodes ;
-
-: desktop-devmodes ( -- DEVMODEs )
-    desktop-hmonitor hmonitor>devmodes ;
-
-: desktop-monitor-info ( -- monitor-info )
-    desktop-hmonitor hmonitor>monitor-info ;
-
-: desktop-RECT ( -- RECT )
-    GetDesktopWindow RECT <struct> [ GetWindowRect win32-error=0/f ] keep ;
-
-ERROR: display-change-error n ;
-
-: fullscreen-mode ( monitor-info devmode -- )
-    [ szDevice>> ] dip f CDS_FULLSCREEN f
-    ChangeDisplaySettingsEx dup DISP_CHANGE_SUCCESSFUL =
-    [ drop ] [ display-change-error ] if ;
-
-: non-fullscreen-mode ( monitor-info devmode -- )
-    [ szDevice>> ] dip f 0 f
-    ChangeDisplaySettingsEx dup DISP_CHANGE_SUCCESSFUL =
-    [ drop ] [ display-change-error ] if ;
-
-: get-style ( hwnd n -- style )
-    GetWindowLongPtr [ win32-error=0/f ] keep ;
-
-: set-style ( hwnd n style -- )
-    SetWindowLongPtr win32-error=0/f ;
-
-: change-style ( hwnd n quot -- )
-    [ 2dup get-style ] dip call set-style ; inline
-
-: set-fullscreen-styles ( hwnd -- )
-    [ GWL_STYLE [ WS_OVERLAPPEDWINDOW unmask ] change-style ]
-    [ GWL_EXSTYLE [ flags{ WS_EX_APPWINDOW WS_EX_TOPMOST } bitor ] change-style ] bi ;
-
-: set-non-fullscreen-styles ( hwnd -- )
-    [ GWL_STYLE [ WS_OVERLAPPEDWINDOW bitor ] change-style ]
-    [ GWL_EXSTYLE [ flags{ WS_EX_APPWINDOW WS_EX_TOPMOST } unmask ] change-style ] bi ;
-
-ERROR: unsupported-resolution triple ;
-
-:: find-devmode ( triple hwnd -- devmode )
-    hwnd hwnd>hmonitor hmonitor>devmodes
-    [
-        slots{ dmPelsWidth dmPelsHeight dmBitsPerPel }
-        triple =
-    ] find nip [ triple unsupported-resolution ] unless* ;
-
-:: set-fullscreen-window-position ( hwnd triple -- )
-    hwnd f
-    desktop-monitor-info rcMonitor>> slots{ left top } first2
-    triple first2
-    flags{
-        SWP_NOACTIVATE SWP_NOCOPYBITS SWP_NOOWNERZORDER
-        SWP_NOREPOSITION SWP_NOZORDER
-    }
-    SetWindowPos win32-error=0/f ;
-
-:: enable-fullscreen ( triple hwnd -- rect )
-    hwnd hwnd>RECT :> rect
-
-    desktop-monitor-info
-    triple GetDesktopWindow find-devmode
-    hwnd set-fullscreen-styles
-    fullscreen-mode
-
-    hwnd triple set-fullscreen-window-position
-    rect ;
-
-:: set-window-position ( hwnd rect -- )
-    hwnd f rect get-RECT-dimensions SWP_FRAMECHANGED
-    SetWindowPos win32-error=0/f ;
-
-:: disable-fullscreen ( rect triple hwnd -- )
-    desktop-monitor-info
-    triple
-    GetDesktopWindow find-devmode non-fullscreen-mode
-    hwnd set-non-fullscreen-styles
-    hwnd rect set-window-position ;
-
-: enable-factor-fullscreen ( triple -- rect )
-    GetForegroundWindow enable-fullscreen ;
-
-: disable-factor-fullscreen ( rect triple -- )
-    GetForegroundWindow disable-fullscreen ;
-
-:: (set-fullscreen) ( world triple fullscreen? -- )
-    world fullscreen?>> fullscreen? xor [
-        triple
-        world handle>> hWnd>>
-        fullscreen? [
-            enable-fullscreen world saved-position<<
-        ] [
-            [ world saved-position>> ] 2dip disable-fullscreen
-        ] if
-        fullscreen? world fullscreen?<<
-    ] when ;
-
-: set-fullscreen ( gadget triple fullscreen? -- )
-    [ find-world ] 2dip (set-fullscreen) ;

diff --git a/extra/fullscreen/platforms.txt b/extra/fullscreen/platforms.txt
deleted file mode 100644 (file)
index 8e1a559..0000000
--- a/extra/fullscreen/platforms.txt
+++ /dev/null
@@ -1 +0,0 @@
-windows

diff --git a/extra/windows/fullscreen/authors.txt b/extra/windows/fullscreen/authors.txt
new file mode 100644 (file)
index 0000000..7c1b2f2
--- /dev/null
+++ b/extra/windows/fullscreen/authors.txt
@@ -0,0 +1 @@
+Doug Coleman

diff --git a/extra/windows/fullscreen/fullscreen.factor b/extra/windows/fullscreen/fullscreen.factor
new file mode 100755 (executable)
index 0000000..7b30d25
--- /dev/null
+++ b/extra/windows/fullscreen/fullscreen.factor
@@ -0,0 +1,142 @@
+! Copyright (C) 2010 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien.c-types arrays classes.struct fry kernel
+literals locals make math math.bitwise multiline sequences
+slots.syntax ui.backend.windows vocabs.loader windows.errors
+windows.gdi32 windows.kernel32 windows.types windows.user32
+ui.gadgets.worlds ;
+IN: fullscreen
+
+: hwnd>hmonitor ( HWND -- HMONITOR )
+    MONITOR_DEFAULTTOPRIMARY MonitorFromWindow ;
+
+: desktop-hmonitor ( -- HMONITOR )
+    GetDesktopWindow hwnd>hmonitor ;
+
+:: (monitor-info>devmodes) ( monitor-info n -- )
+    DEVMODE <struct>
+        DEVMODE heap-size >>dmSize
+        flags{ DM_BITSPERPEL DM_PELSWIDTH DM_PELSHEIGHT } >>dmFields
+    :> devmode
+
+    monitor-info szDevice>>
+    n
+    devmode
+    EnumDisplaySettings 0 = [
+        devmode ,
+        monitor-info n 1 + (monitor-info>devmodes)
+    ] unless ;
+
+: monitor-info>devmodes ( monito-info -- devmodes )
+    [ 0 (monitor-info>devmodes) ] { } make ;
+
+: hmonitor>monitor-info ( HMONITOR -- monitor-info )
+    MONITORINFOEX <struct>
+        MONITORINFOEX heap-size >>cbSize
+    [ GetMonitorInfo win32-error=0/f ] keep ;
+
+: hwnd>monitor-info ( HWND -- monitor-info )
+    hwnd>hmonitor hmonitor>monitor-info ;
+
+: hmonitor>devmodes ( HMONITOR -- devmodes )
+    hmonitor>monitor-info monitor-info>devmodes ;
+
+: desktop-devmodes ( -- DEVMODEs )
+    desktop-hmonitor hmonitor>devmodes ;
+
+: desktop-monitor-info ( -- monitor-info )
+    desktop-hmonitor hmonitor>monitor-info ;
+
+: desktop-RECT ( -- RECT )
+    GetDesktopWindow RECT <struct> [ GetWindowRect win32-error=0/f ] keep ;
+
+ERROR: display-change-error n ;
+
+: fullscreen-mode ( monitor-info devmode -- )
+    [ szDevice>> ] dip f CDS_FULLSCREEN f
+    ChangeDisplaySettingsEx dup DISP_CHANGE_SUCCESSFUL =
+    [ drop ] [ display-change-error ] if ;
+
+: non-fullscreen-mode ( monitor-info devmode -- )
+    [ szDevice>> ] dip f 0 f
+    ChangeDisplaySettingsEx dup DISP_CHANGE_SUCCESSFUL =
+    [ drop ] [ display-change-error ] if ;
+
+: get-style ( hwnd n -- style )
+    GetWindowLongPtr [ win32-error=0/f ] keep ;
+
+: set-style ( hwnd n style -- )
+    SetWindowLongPtr win32-error=0/f ;
+
+: change-style ( hwnd n quot -- )
+    [ 2dup get-style ] dip call set-style ; inline
+
+: set-fullscreen-styles ( hwnd -- )
+    [ GWL_STYLE [ WS_OVERLAPPEDWINDOW unmask ] change-style ]
+    [ GWL_EXSTYLE [ flags{ WS_EX_APPWINDOW WS_EX_TOPMOST } bitor ] change-style ] bi ;
+
+: set-non-fullscreen-styles ( hwnd -- )
+    [ GWL_STYLE [ WS_OVERLAPPEDWINDOW bitor ] change-style ]
+    [ GWL_EXSTYLE [ flags{ WS_EX_APPWINDOW WS_EX_TOPMOST } unmask ] change-style ] bi ;
+
+ERROR: unsupported-resolution triple ;
+
+:: find-devmode ( triple hwnd -- devmode )
+    hwnd hwnd>hmonitor hmonitor>devmodes
+    [
+        slots{ dmPelsWidth dmPelsHeight dmBitsPerPel }
+        triple =
+    ] find nip [ triple unsupported-resolution ] unless* ;
+
+:: set-fullscreen-window-position ( hwnd triple -- )
+    hwnd f
+    desktop-monitor-info rcMonitor>> slots{ left top } first2
+    triple first2
+    flags{
+        SWP_NOACTIVATE SWP_NOCOPYBITS SWP_NOOWNERZORDER
+        SWP_NOREPOSITION SWP_NOZORDER
+    }
+    SetWindowPos win32-error=0/f ;
+
+:: enable-fullscreen ( triple hwnd -- rect )
+    hwnd hwnd>RECT :> rect
+
+    desktop-monitor-info
+    triple GetDesktopWindow find-devmode
+    hwnd set-fullscreen-styles
+    fullscreen-mode
+
+    hwnd triple set-fullscreen-window-position
+    rect ;
+
+:: set-window-position ( hwnd rect -- )
+    hwnd f rect get-RECT-dimensions SWP_FRAMECHANGED
+    SetWindowPos win32-error=0/f ;
+
+:: disable-fullscreen ( rect triple hwnd -- )
+    desktop-monitor-info
+    triple
+    GetDesktopWindow find-devmode non-fullscreen-mode
+    hwnd set-non-fullscreen-styles
+    hwnd rect set-window-position ;
+
+: enable-factor-fullscreen ( triple -- rect )
+    GetForegroundWindow enable-fullscreen ;
+
+: disable-factor-fullscreen ( rect triple -- )
+    GetForegroundWindow disable-fullscreen ;
+
+:: (set-fullscreen) ( world triple fullscreen? -- )
+    world fullscreen?>> fullscreen? xor [
+        triple
+        world handle>> hWnd>>
+        fullscreen? [
+            enable-fullscreen world saved-position<<
+        ] [
+            [ world saved-position>> ] 2dip disable-fullscreen
+        ] if
+        fullscreen? world fullscreen?<<
+    ] when ;
+
+: set-fullscreen ( gadget triple fullscreen? -- )
+    [ find-world ] 2dip (set-fullscreen) ;

diff --git a/extra/windows/fullscreen/platforms.txt b/extra/windows/fullscreen/platforms.txt
new file mode 100644 (file)
index 0000000..8e1a559
--- /dev/null
+++ b/extra/windows/fullscreen/platforms.txt
@@ -0,0 +1 @@
+windows