windows: Fix user32/shcore DPI functions.

basis/ui/backend/windows/windows.factor

@@ -533,6 +533,9 @@ SYMBOL: wm-handlers
 wm-handlers [
     H{
         ${ WM_CLOSE [ handle-wm-close 0 ] }
+        ! ${ WM_NCCREATE [ [ 3drop EnableNonClientDpiScaling drop ] [ DefWindowProc ] 4bi ] }
+        ! ${ WM_GETDPISCALEDSIZE [ DefWindowProc ] }
+        ! ${ WM_DPICHANGED [ DefWindowProc ] }
         ${ WM_PAINT [ 4dup handle-wm-paint DefWindowProc ] }
 
         ${ WM_SIZE [ handle-wm-size 0 ] }
@@ -603,6 +606,7 @@ M: windows-ui-backend do-events
     ] [ drop ] if ;
 
 : adjust-RECT ( RECT style ex-style -- )
+    ! [ 0 ] dip GetDpiForSystem AdjustWindowRectExForDpi win32-error=0/f ;
     [ 0 ] dip AdjustWindowRectEx win32-error=0/f ;
 
 : make-RECT ( world -- RECT )
@@ -630,6 +634,14 @@ M: windows-ui-backend do-events
         dup
     ] change-global ;
 
+: get-device-caps ( handle -- x y )
+    GetDC
+    [ LOGPIXELSX GetDeviceCaps ]
+    [ LOGPIXELSY GetDeviceCaps ] bi ;
+
+: get-default-device-caps ( -- x y )
+    f get-device-caps ;
+
 :: create-window ( rect style ex-style -- hwnd )
     rect style ex-style make-adjusted-RECT
     [ get-window-class f ] dip

basis/windows/gdi32/gdi32.factor

@@ -1640,7 +1640,7 @@ FUNCTION: BOOL GdiFlush ( )
 ! FUNCTION: GetDCBrushColor
 ! FUNCTION: GetDCOrgEx
 ! FUNCTION: GetDCPenColor
-! FUNCTION: GetDeviceCaps
+FUNCTION: int GetDeviceCaps ( HDC hdc, int index )
 ! FUNCTION: GetDeviceGammaRamp
 ! FUNCTION: GetDIBColorTable
 ! FUNCTION: GetDIBits

basis/windows/messages/messages.factor

@@ -210,7 +210,10 @@ CONSTANT: WM_NCMOUSELEAVE 0x02A2
 CONSTANT: WM_WTSSESSION_CHANGE 0x02B1
 CONSTANT: WM_TABLET_FIRST 0x02c0
 CONSTANT: WM_TABLET_LAST 0x02df
-CONSTANT: WM_DPICHANGED 0x02E0
+CONSTANT: WM_DPICHANGED 0x02e0
+CONSTANT: WM_DPICHANGED_BEFOREPARENT 0x02e2
+CONSTANT: WM_DPICHANGED_AFTERPARENT 0x02e3
+CONSTANT: WM_GETDPISCALEDSIZE 0x2e4
 CONSTANT: WM_CUT 0x0300
 CONSTANT: WM_COPY 0x0301
 CONSTANT: WM_PASTE 0x0302

basis/windows/shcore/shcore.factor

@@ -11,4 +11,65 @@ ENUM: MONITOR_DPI_TYPE
     MDT_RAW_DPI
     { MDT_DEFAULT 0 } ;
 
+ENUM: PROCESS_DPI_AWARENESS
+    { PROCESS_DPI_UNAWARE 0 }
+    { PROCESS_SYSTEM_DPI_AWARE 1 }
+    { PROCESS_PER_MONITOR_DPI_AWARE 2 } ;
+
+ENUM: SCALE_CHANGE_FLAGS
+    { SCF_VALUE_NONE 0 }
+    { SCF_SCALE 1 }
+    { SCF_PHYSICAL 2 } ;
+
 FUNCTION: HRESULT GetDpiForMonitor ( HMONITOR hMonitor, MONITOR_DPI_TYPE dpiType, UINT* dpiX, UINT *dpiY )
+
+ENUM: DEVICE_SCALE_FACTOR
+    { DEVICE_SCALE_FACTOR_INVALID 0 }
+    { SCALE_100_PERCENT 100 }
+    { SCALE_120_PERCENT 120 }
+    { SCALE_125_PERCENT 125 }
+    { SCALE_140_PERCENT 140 }
+    { SCALE_150_PERCENT 150 }
+    { SCALE_160_PERCENT 160 }
+    { SCALE_175_PERCENT 175 }
+    { SCALE_180_PERCENT 180 }
+    { SCALE_200_PERCENT 200 }
+    { SCALE_225_PERCENT 223 }
+    { SCALE_250_PERCENT 250 }
+    { SCALE_300_PERCENT 300 }
+    { SCALE_350_PERCENT 350 }
+    { SCALE_400_PERCENT 400 }
+    { SCALE_450_PERCENT 450 }
+    { SCALE_500_PERCENT 500 } ;
+
+FUNCTION: HRESULT GetScaleFactorForMonitor (
+    HMONITOR            hMon,
+    DEVICE_SCALE_FACTOR *pScale
+)
+
+FUNCTION: HRESULT RegisterScaleChangeEvent (
+    HANDLE    hEvent,
+    DWORD_PTR *pdwCookie
+)
+
+ENUM: DISPLAY_DEVICE_TYPE
+    { DEVICE_PRIMARY 0 }
+    { DEVICE_IMMERSIVE 1 } ;
+
+
+FUNCTION: HRESULT RevokeScaleChangeNotifications (
+    DISPLAY_DEVICE_TYPE displayDevice,
+    DWORD               dwCookie
+)
+
+FUNCTION: HRESULT UnregisterScaleChangeEvent (
+    DWORD_PTR dwCookie
+)
+
+FUNCTION: HRESULT GetProcessDpiAwareness ( HANDLE hprocess, PROCESS_DPI_AWARENESS* value )
+FUNCTION: HRESULT SetProcessDpiAwareness ( PROCESS_DPI_AWARENESS value )
+
+ENUM: SHELL_UI_COMPONENT
+    { SHELL_UI_COMPONENT_TASKBARS 0 }
+    { SHELL_UI_COMPONENT_NOTIFICATIONAREA 1 }
+    { SHELL_UI_COMPONENT_DESKBAND 2 } ;

basis/windows/user32/user32.factor

@@ -2263,11 +2263,6 @@ STRUCT: POWERBROADCAST_SETTING
 ! HighDPI
 TYPEDEF: HANDLE DPI_AWARENESS_CONTEXT
 
-ENUM: PROCESS_DPI_AWARENESS
-    { PROCESS_DPI_UNAWARE 0 }
-    { PROCESS_SYSTEM_DPI_AWARE 1 }
-    { PROCESS_PER_MONITOR_DPI_AWARE 2 } ;
-
 ENUM: DPI_AWARENESS
     { DPI_AWARENESS_INVALID -1 }
     { DPI_AWARENESS_UNAWARE 0 }
@@ -2314,8 +2309,6 @@ FUNCTION: UINT GetDpiForSystem ( )
 
 FUNCTION: UINT GetDpiForWindow ( HWND hwnd )
 
-FUNCTION: HRESULT GetProcessDpiAwareness ( HANDLE hprocess, PROCESS_DPI_AWARENESS* value )
-
 FUNCTION: UINT GetSystemDpiForProcess (
     HANDLE hProcess
 )
@@ -2340,28 +2333,40 @@ FUNCTION: DPI_HOSTING_BEHAVIOR GetWindowDpiHostingBehavior (
 )
 
 FUNCTION: BOOL SetProcessDPIAware ( )
-FUNCTION: HRESULT SetProcessDpiAwareness ( PROCESS_DPI_AWARENESS value )
 FUNCTION: BOOL SetProcessDpiAwarenessContext ( DPI_AWARENESS_CONTEXT value )
 
 FUNCTION: DPI_AWARENESS_CONTEXT GetWindowDpiAwarenessContext ( HWND hwnd )
 FUNCTION: DPI_AWARENESS GetAwarenessFromDpiAwarenessContext ( DPI_AWARENESS_CONTEXT value )
 
+: get-thread-dpi-awareness ( -- enum )
+    GetThreadDpiAwarenessContext GetAwarenessFromDpiAwarenessContext ;
+
 FUNCTION: BOOL IsValidDpiAwarenessContext (
     DPI_AWARENESS_CONTEXT value
 )
 
-! Needs work
-! GetThreadDpiAwarenessContext -8 swap <displaced-alien> IsValidDpiAwarenessContext ! 0, should be 1
-! : DPI_AWARENESS_CONTEXT_UNAWARE ( -- DPI_AWARENESS_CONTEXT )
-!     GetThreadDpiAwarenessContext -1 swap <displaced-alien> ;
-! : DPI_AWARENESS_CONTEXT_SYSTEM_AWARE ( -- DPI_AWARENESS_CONTEXT )
-!     GetThreadDpiAwarenessContext -2 swap <displaced-alien> ;
-! : DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE ( -- DPI_AWARENESS_CONTEXT )
-!     GetThreadDpiAwarenessContext -3 swap <displaced-alien> ;
-! : DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 ( -- DPI_AWARENESS_CONTEXT )
-!     GetThreadDpiAwarenessContext -4 swap <displaced-alien> ;
-! : DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED ( -- DPI_AWARENESS_CONTEXT )
-!     GetThreadDpiAwarenessContext -5 swap <displaced-alien> ;
+! DPI_AWARENESS_CONTEXT experimentally:
+! USE: math.ranges -100 1000 [a,b] [ <alien> IsValidDpiAwarenessContext ] map-zip
+! [ nip 0 > ] assoc-filter keys .
+! { -5 -4 -3 -2 -1 17 18 34 273 529 785 }
+
+! -4 <alien> 34 <alien> AreDpiAwarenessContextsEqual . ! t
+! -5 <alien> -5 <alien> AreDpiAwarenessContextsEqual . ! t
+! -6 <alien> -6 <alien> AreDpiAwarenessContextsEqual . ! f
+: DPI_AWARENESS_CONTEXT_UNAWARE ( -- DPI_AWARENESS_CONTEXT )
+    -1 <alien> ;
+
+: DPI_AWARENESS_CONTEXT_SYSTEM_AWARE ( -- DPI_AWARENESS_CONTEXT )
+    -2 <alien> ;
+
+: DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE ( -- DPI_AWARENESS_CONTEXT )
+    -3 <alien> ;
+
+: DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 ( -- DPI_AWARENESS_CONTEXT )
+    -4 <alien> ;
+
+: DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED ( -- DPI_AWARENESS_CONTEXT )
+    -5 <alien> ;
 
 FUNCTION: BOOL LogicalToPhysicalPointForPerMonitorDPI (
     HWND    hWnd,

extra/windows/fullscreen/fullscreen.factor

@@ -1,10 +1,10 @@
 ! 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 ;
+USING: accessors alien.c-types alien.data classes.struct
+io.binary kernel literals locals make math math.bitwise
+sequences slots.syntax ui.backend.windows ui.gadgets.worlds
+windows.errors windows.gdi32 windows.shcore windows.types
+windows.user32 ;
 IN: windows.fullscreen
 
 : hwnd>hmonitor ( HWND -- HMONITOR )
@@ -140,3 +140,7 @@ ERROR: unsupported-resolution triple ;
 
 : set-fullscreen ( gadget triple fullscreen? -- )
     [ find-world ] 2dip (set-fullscreen) ;
+
+: get-desktop-scale-factor ( -- n )
+    desktop-hmonitor 0 DEVICE_SCALE_FACTOR <ref>
+    [ GetScaleFactorForMonitor win32-error=0/f ] keep le> ;