diff --git a/Nmakefile b/Nmakefile index 7d0dd250f4..065d24a757 100644 --- a/Nmakefile +++ b/Nmakefile @@ -58,6 +58,13 @@ CL_FLAGS = $(CL_FLAGS) $(CL_FLAGS_VISTA) PLAF_DLL_OBJS = vm\os-windows-x86.64.obj vm\cpu-x86.obj SUBSYSTEM_COM_FLAGS = console SUBSYSTEM_EXE_FLAGS = windows + +!ELSE +CL_FLAGS = $(CL_FLAGS) $(CL_FLAGS_VISTA) +PLAF_DLL_OBJS = vm\os-windows-x86.64.obj vm\cpu-x86.obj +SUBSYSTEM_COM_FLAGS = console +SUBSYSTEM_EXE_FLAGS = windows + !ENDIF !IF DEFINED(DEBUG) @@ -143,6 +150,16 @@ factor.com: $(EXE_OBJS) $(DLL_OBJS) factor.exe: $(EXE_OBJS) $(DLL_OBJS) link $(LINK_FLAGS) /out:factor.exe /SUBSYSTEM:$(SUBSYSTEM_EXE_FLAGS) $(EXE_OBJS) $(DLL_OBJS) +# If we compile factor.exe, run mt.exe, and run factor.exe, +# then Windows caches the manifest. Even on a recompile without applying +# the mt.exe tool, if the factor.exe.manifest file is present, the manifest +# is applied. To avoid this, we delete the .manifest file on clean +# and copy it from a reference file on compilation and mt.exe. +# +factor.exe.manifest: factor.exe + copy factor.exe.manifest.in factor.exe.manifest + mt -manifest factor.exe.manifest -outputresource:"factor.exe;#1" + all: factor.com factor.exe factor.dll.lib libfactor-ffi-test.dll !ENDIF @@ -174,12 +191,15 @@ clean: if exist factor.lib del factor.lib if exist factor.com del factor.com if exist factor.exe del factor.exe + if exist factor.exe.manifest del factor.exe.manifest + if exist factor.exp del factor.exp if exist factor.dll del factor.dll if exist factor.dll.lib del factor.dll.lib + if exist factor.dll.exp del factor.dll.exp if exist libfactor-ffi-test.dll del libfactor-ffi-test.dll if exist libfactor-ffi-test.exp del libfactor-ffi-test.exp if exist libfactor-ffi-test.lib del libfactor-ffi-test.lib -.PHONY: all default x86-32 x86-64 x86-32-vista x86-64-vista clean +.PHONY: all default x86-32 x86-64 x86-32-vista x86-64-vista clean factor.exe.manifest .SUFFIXES: .rs diff --git a/README.md b/README.md index 5901506db2..f9f7fde4f7 100644 --- a/README.md +++ b/README.md @@ -127,6 +127,25 @@ The Factor source tree is organized as follows: * `misc/` - editor modes, icons, etc * `unmaintained/` - now at [factor-unmaintained](https://github.com/factor/factor-unmaintained) +## Source History + +During Factor's lifetime, sourcecode has lived in many repositories. Unfortunately, the first import in Git did not keep history. History has been partially recreated from what could be salvaged. Due to the nature of Git, it's only possible to add history without disturbing upstream work, by using replace objects. These need to be manually fetched, or need to be explicitly added to your git remote configuration. + +Use: +`git fetch origin 'refs/replace/*:refs/replace/*'` + +or add the following line to your configuration file + +``` +[remote "origin"] + url = ... + fetch = +refs/heads/*:refs/remotes/origin/* + ... + fetch = +refs/replace/*:refs/replace/* +``` + +Then subsequent fetches will automatically update any replace objects. + ## Community Factor developers meet in the `#concatenative` channel on diff --git a/basis/cache/cache.factor b/basis/cache/cache.factor index 4caa5b40ac..f2e31d9369 100644 --- a/basis/cache/cache.factor +++ b/basis/cache/cache.factor @@ -38,9 +38,9 @@ M: cache-assoc dispose* clear-assoc ; PRIVATE> : purge-cache ( cache -- ) - [ assoc>> ] [ max-age>> ] bi V{ } clone [ + dup [ assoc>> ] [ max-age>> ] bi V{ } clone [ '[ nip dup age>> 1 + [ >>age ] keep _ < [ drop t ] [ _ dispose-to f ] if - ] assoc-filter! drop + ] assoc-filter >>assoc drop ] keep [ last rethrow ] unless-empty ; diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index 5efafdbb7e..a34dfbf8bc 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -116,13 +116,13 @@ M: object edit-tests M: word edit-tests vocabulary>> edit-tests ; : edit-platforms ( vocab -- ) - dup vocab-platforms-path vocab-append-path 1 edit-location ; + public-vocab-name vocab-platforms-path 1 edit-location ; : edit-authors ( vocab -- ) - dup vocab-authors-path vocab-append-path 1 edit-location ; + public-vocab-name vocab-authors-path 1 edit-location ; : edit-tags ( vocab -- ) - dup vocab-tags-path vocab-append-path 1 edit-location ; + public-vocab-name vocab-tags-path 1 edit-location ; : edit-summary ( vocab -- ) - dup vocab-summary-path vocab-append-path 1 edit-location ; + public-vocab-name vocab-summary-path 1 edit-location ; diff --git a/basis/images/loader/gdiplus/gdiplus.factor b/basis/images/loader/gdiplus/gdiplus.factor index c8714843f2..7e9bdc08a4 100644 --- a/basis/images/loader/gdiplus/gdiplus.factor +++ b/basis/images/loader/gdiplus/gdiplus.factor @@ -64,7 +64,7 @@ os windows? [ ERROR: unsupported-pixel-format component-order ; : check-pixel-format ( component-order -- ) - dup { BGRX BGRA } member? [ drop ] [ unsupported-pixel-format ] if ; + dup { BGRX BGRA RGBA } member? [ drop ] [ unsupported-pixel-format ] if ; : image>gdi+-bitmap ( image -- bitmap ) dup component-order>> check-pixel-format @@ -84,8 +84,7 @@ ERROR: unsupported-pixel-format component-order ; nip swap ImageCodecInfo ; : extension>mime-type ( extension -- mime-type ) - ! Crashes if you let this mime through on my machine. - dup mime-types at dup "image/bmp" = [ unknown-image-extension ] when nip ; + mime-types ?at [ unknown-image-extension ] unless ; : mime-type>clsid ( mime-type -- clsid ) image-encoders [ MimeType>> alien>native-string = ] with find nip Clsid>> ; diff --git a/basis/images/loader/loader-tests.factor b/basis/images/loader/loader-tests.factor index d3f73df2fa..26a83c010c 100644 --- a/basis/images/loader/loader-tests.factor +++ b/basis/images/loader/loader-tests.factor @@ -1,5 +1,5 @@ USING: accessors continuations glib.ffi images.loader -io.files.temp kernel sequences system tools.test ; +io.files.temp kernel layouts sequences system tools.test ; IN: images.loader.tests : open-png-image ( -- image ) @@ -40,17 +40,13 @@ os { linux windows } member? [ ] [ unknown-image-extension? ] recover ] unit-test - ! Windows can't save .bmp-files for unknown reason. It can load + ! Windows 32 can't save .bmp-files for unknown reason. It can load ! them though. - os windows? [ - [ - open-png-image "foo.bmp" temp-file save-graphic-image - ] [ unknown-image-extension? ] must-fail-with - ] [ + 64bit? [ { t } [ open-png-image dup "bmp" convert-to = ] unit-test - ] if + ] when { t } [ "vocab:images/testing/bmp/rgb_8bit.bmp" load-image dup diff --git a/basis/tools/deploy/config/editor/editor.factor b/basis/tools/deploy/config/editor/editor.factor index f4ef9cc2df..c9ecac3b0a 100644 --- a/basis/tools/deploy/config/editor/editor.factor +++ b/basis/tools/deploy/config/editor/editor.factor @@ -5,17 +5,17 @@ prettyprint.config sequences splitting tools.deploy.config vocabs.loader vocabs.metadata ; IN: tools.deploy.config.editor -: deploy-config-path ( vocab -- string ) - vocab-dir "deploy.factor" append-path ; +: deploy-config-path ( vocab -- path/f ) + "deploy.factor" vocab-file-path ; : deploy-config ( vocab -- assoc ) - dup default-config swap - dup deploy-config-path vocab-file-lines + [ default-config ] keep + "deploy.factor" vocab-file-lines parse-fresh [ first assoc-union ] unless-empty ; : set-deploy-config ( assoc vocab -- ) [ [ unparse-use ] without-limits string-lines ] dip - dup deploy-config-path set-vocab-file-lines ; + "deploy.factor" set-vocab-file-lines ; : set-deploy-flag ( value key vocab -- ) [ deploy-config [ set-at ] keep ] keep set-deploy-config ; diff --git a/basis/tools/deploy/libraries/unix/unix.factor b/basis/tools/deploy/libraries/unix/unix.factor index 73b95d38a9..ca9c999ad1 100644 --- a/basis/tools/deploy/libraries/unix/unix.factor +++ b/basis/tools/deploy/libraries/unix/unix.factor @@ -6,9 +6,14 @@ IN: tools.deploy.libraries.unix ! stupid hack. better ways to find the library name would be open the library, ! note a symbol address found in the library, then call dladdr (or use + + + M: unix find-library-file dup absolute-path? [ ?exists ] [ { "/lib" "/usr/lib" "/usr/local/lib" "/opt/local/lib" "resource:" } diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index b751a681f3..28756a4c0e 100644 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -523,6 +523,9 @@ SYMBOL: nc-buttons INITIALIZED-SYMBOL: 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 ] } @@ -606,6 +609,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 ) @@ -633,6 +637,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 diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index 6338c917cb..2a81f56718 100644 --- a/basis/ui/gadgets/gadgets.factor +++ b/basis/ui/gadgets/gadgets.factor @@ -385,6 +385,8 @@ GENERIC: focusable-child* ( gadget -- child/t ) M: gadget focusable-child* drop t ; +M: f focusable-child* drop f ; + : focusable-child ( gadget -- child ) dup focusable-child* dup t eq? [ drop ] [ nip focusable-child ] if ; diff --git a/basis/ui/text/core-text/core-text.factor b/basis/ui/text/core-text/core-text.factor index 079a53f136..734b170621 100644 --- a/basis/ui/text/core-text/core-text.factor +++ b/basis/ui/text/core-text/core-text.factor @@ -49,9 +49,9 @@ M:: core-text-renderer x>offset ( x font string -- n ) [ 2drop 0 ] [ cached-line line>> swap scale 0 CTLineGetStringIndexForPosition - ] if-empty - 2 * 0 swap string utf16n encode subseq - utf16n decode length ; + 2 * 0 swap string utf16n encode subseq + utf16n decode length + ] if-empty ; M:: core-text-renderer offset>x ( n font string -- x ) font string cached-line line>> diff --git a/basis/vocabs/files/files-docs.factor b/basis/vocabs/files/files-docs.factor index 5d2a9559ed..9a607101f9 100644 --- a/basis/vocabs/files/files-docs.factor +++ b/basis/vocabs/files/files-docs.factor @@ -2,19 +2,15 @@ USING: help.markup help.syntax literals sequences strings ; IN: vocabs.files HELP: vocab-tests-path -{ $values { "vocab" "a vocabulary specifier" } { "path" "pathname string to test file" } } +{ $values { "vocab" "a vocabulary specifier" } { "path/f" { $maybe "pathname string to test file" } } } { $description "Outputs a pathname where the unit test file for " { $snippet "vocab" } " is located. Outputs " { $link f } " if the vocabulary does not have a directory on disk." } ; -HELP: vocab-tests-file -{ $values { "vocab" "a vocabulary specifier" } { "path/f" "pathname string to test file" } } -{ $description "Outputs a pathname where the unit test file is located, or " { $link f } " if the file does not exist." } ; - HELP: vocab-tests-dir { $values { "vocab" "a vocabulary specifier" } { "paths" "a sequence of pathname strings" } } { $description "Outputs a sequence of pathnames for the tests in the test directory." } ; HELP: vocab-files -{ $values { "vocab" "a vocabulary specifier" } { "seq" "a sequence of pathname strings" } } +{ $values { "vocab" "a vocabulary specifier" } { "paths" "a sequence of pathname strings" } } { $description "Outputs a sequence of files comprising this vocabulary, or " { $link f } " if the vocabulary does not have a directory on disk." } { $examples { $example @@ -33,7 +29,7 @@ HELP: vocab-files } ; HELP: vocab-tests -{ $values { "vocab" "a vocabulary specifier" } { "tests" "a sequence of pathname strings" } } +{ $values { "vocab" "a vocabulary specifier" } { "paths" "a sequence of pathname strings" } } { $description "Outputs a sequence of pathnames where the unit tests for " { $snippet "vocab" } " are located." } { $examples { $example diff --git a/basis/vocabs/files/files.factor b/basis/vocabs/files/files.factor index c9a828ac19..33af6889c7 100644 --- a/basis/vocabs/files/files.factor +++ b/basis/vocabs/files/files.factor @@ -1,33 +1,31 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: io.directories io.files io.pathnames kernel make -sequences vocabs vocabs.loader ; +USING: combinators io.directories io.files io.pathnames kernel +make sequences vocabs.loader ; IN: vocabs.files -: vocab-tests-path ( vocab -- path ) +: vocab-tests-path ( vocab -- path/f ) dup "-tests.factor" append-vocab-dir vocab-append-path ; -: vocab-tests-file ( vocab -- path/f ) - vocab-tests-path dup - [ dup exists? [ drop f ] unless ] [ drop f ] if ; - : vocab-tests-dir ( vocab -- paths ) - dup vocab-dir "tests" append-path vocab-append-path dup [ + dup vocab-dir "tests" append-path vocab-append-path [ dup exists? [ dup directory-files [ ".factor" tail? ] filter [ append-path ] with map ] [ drop f ] if - ] [ drop f ] if ; + ] [ f ] if* ; -: vocab-tests ( vocab -- tests ) +: vocab-tests ( vocab -- paths ) [ - [ vocab-tests-file [ , ] when* ] - [ vocab-tests-dir [ % ] when* ] bi + [ vocab-tests-path [ dup exists? [ , ] [ drop ] if ] when* ] + [ vocab-tests-dir % ] bi ] { } make ; -: vocab-files ( vocab -- seq ) +: vocab-files ( vocab -- paths ) [ - [ vocab-source-path [ , ] when* ] - [ vocab-docs-path [ , ] when* ] - [ vocab-tests % ] tri + { + [ vocab-source-path [ , ] when* ] + [ vocab-docs-path [ , ] when* ] + [ vocab-tests % ] + } cleave ] { } make ; diff --git a/basis/vocabs/metadata/metadata-docs.factor b/basis/vocabs/metadata/metadata-docs.factor index 9081619e6c..f24144f850 100644 --- a/basis/vocabs/metadata/metadata-docs.factor +++ b/basis/vocabs/metadata/metadata-docs.factor @@ -3,32 +3,20 @@ IN: vocabs.metadata ARTICLE: "vocabs.metadata" "Vocabulary metadata" "Vocabulary directories can contain text files with metadata:" -{ $list - { { $snippet "authors.txt" } " - a series of lines, with one author name per line. These are listed under " { $link "vocab-authors" } "." } - { { $snippet "platforms.txt" } " - a series of lines, with one operating system name per line." } - { { $snippet "resources.txt" } " - a series of lines, with one file glob pattern per line. Files inside the vocabulary directory whose names match any of these glob patterns will be included with the compiled application as " { $link "deploy-resources" } "." } - { { $snippet "summary.txt" } " - a one-line description." } - { { $snippet "tags.txt" } " - a series of lines, with one tag per line. Tags help classify the vocabulary. Consult " { $link "vocab-tags" } " for a list of existing tags you can reuse." } +{ $table + { { $snippet "authors.txt" } { "a series of lines, with one author name per line. These are listed under " { $link "vocab-authors" } "." } } + { { $snippet "platforms.txt" } { "a series of lines, with one operating system name per line." } } + { { $snippet "resources.txt" } { "a series of lines, with one file glob pattern per line. Files inside the vocabulary directory whose names match any of these glob patterns will be included with the compiled application as " { $link "deploy-resources" } "." } } + { { $snippet "summary.txt" } { "a one-line description." } } + { { $snippet "tags.txt" } { "a series of lines, with one tag per line. Tags help classify the vocabulary. Consult " { $link "vocab-tags" } " for a list of existing tags you can reuse." } } } -"Words for reading " { $snippet "summary.txt" } ":" -{ $subsections - vocab-summary -} -"Words for reading " { $snippet "authors.txt" } ":" +"These metadata files can be accessed with the following words:" { $subsections vocab-authors -} -"Words for reading " { $snippet "tags.txt" } ":" -{ $subsections - vocab-tags -} -"Words for reading " { $snippet "platforms.txt" } ":" -{ $subsections vocab-platforms -} -"Words for reading " { $snippet "resources.txt" } ":" -{ $subsections vocab-resources + vocab-summary + vocab-tags } "Getting and setting arbitrary vocabulary metadata:" { $subsections diff --git a/basis/vocabs/metadata/metadata.factor b/basis/vocabs/metadata/metadata.factor index 7be704d680..b797a80b4c 100644 --- a/basis/vocabs/metadata/metadata.factor +++ b/basis/vocabs/metadata/metadata.factor @@ -1,17 +1,20 @@ ! Copyright (C) 2009, 2010 Slava Pestov, Joe Groff. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs classes.algebra +USING: accessors assocs classes.algebra combinators.short-circuit continuations io.directories io.encodings.utf8 io.files io.pathnames kernel make math.parser -memoize namespaces sequences sets summary system vocabs -vocabs.loader words ; +memoize namespaces sequences summary system vocabs vocabs.loader +words ; IN: vocabs.metadata : check-vocab ( vocab -- vocab ) dup find-vocab-root [ no-vocab ] unless ; +: vocab-file-path ( vocab name -- path/f ) + [ dup vocab-dir ] [ append-path ] bi* vocab-append-path ; + MEMO: vocab-file-lines ( vocab name -- lines/f ) - vocab-append-path dup [ + vocab-file-path dup [ dup exists? [ utf8 file-lines harvest ] [ @@ -20,23 +23,22 @@ MEMO: vocab-file-lines ( vocab name -- lines/f ) ] when ; : set-vocab-file-lines ( lines vocab name -- ) - dupd vocab-append-path [ + dupd vocab-file-path [ swap [ ?delete-file ] [ swap utf8 set-file-lines ] if-empty \ vocab-file-lines reset-memoized ] [ vocab-name no-vocab ] ?if ; -: vocab-resources-path ( vocab -- string ) - vocab-dir "resources.txt" append-path ; +: vocab-resources-path ( vocab -- path/f ) + "resources.txt" vocab-file-path ; : vocab-resources ( vocab -- patterns ) - dup vocab-resources-path vocab-file-lines ; + "resources.txt" vocab-file-lines ; -: vocab-summary-path ( vocab -- string ) - vocab-dir "summary.txt" append-path ; +: vocab-summary-path ( vocab -- path/f ) + "summary.txt" vocab-file-path ; : vocab-summary ( vocab -- summary ) - dup dup vocab-summary-path vocab-file-lines - [ + dup "summary.txt" vocab-file-lines [ vocab-name " vocabulary" append ] [ nip first @@ -52,25 +54,25 @@ M: vocab summary M: vocab-link summary vocab-summary ; -: vocab-tags-path ( vocab -- string ) - vocab-dir "tags.txt" append-path ; +: vocab-tags-path ( vocab -- path/f ) + "tags.txt" vocab-file-path ; : vocab-tags ( vocab -- tags ) - dup vocab-tags-path vocab-file-lines ; + "tags.txt" vocab-file-lines ; -: vocab-authors-path ( vocab -- string ) - vocab-dir "authors.txt" append-path ; +: vocab-authors-path ( vocab -- path/f ) + "authors.txt" vocab-file-path ; : vocab-authors ( vocab -- authors ) - dup vocab-authors-path vocab-file-lines ; + "authors.txt" vocab-file-lines ; -: vocab-platforms-path ( vocab -- string ) - vocab-dir "platforms.txt" append-path ; +: vocab-platforms-path ( vocab -- path/f ) + "platforms.txt" vocab-file-path ; ERROR: bad-platform name ; : vocab-platforms ( vocab -- platforms ) - dup vocab-platforms-path vocab-file-lines + "platforms.txt" vocab-file-lines [ dup "system" lookup-word [ ] [ bad-platform ] ?if ] map ; : supported-platform? ( platforms -- ? ) diff --git a/basis/windows/com/com.factor b/basis/windows/com/com.factor index 1823f367f6..615e0791e5 100644 --- a/basis/windows/com/com.factor +++ b/basis/windows/com/com.factor @@ -11,8 +11,14 @@ COM-INTERFACE: IUnknown f {00000000-0000-0000-C000-000000000046} ULONG Release ( ) ; C-TYPE: IAdviseSink -C-TYPE: IEnumFORMATETC C-TYPE: IEnumSTATDATA +C-TYPE: IStorage + +COM-INTERFACE: IEnumFORMATETC IUnknown {00000103-0000-0000-C000-000000000046} + HRESULT Clone ( IEnumFORMATETC **ppenum ) + HRESULT Next ( ULONG celt, FORMATETC *rgelt, ULONG* pceltFetched ) + HRESULT Reset ( ) + HRESULT Skip ( ULONG celt ) ; COM-INTERFACE: IDataObject IUnknown {0000010E-0000-0000-C000-000000000046} HRESULT GetData ( FORMATETC* pFormatetc, STGMEDIUM* pmedium ) @@ -35,6 +41,42 @@ COM-INTERFACE: IDropTarget IUnknown {00000122-0000-0000-C000-000000000046} HRESULT DragLeave ( ) HRESULT Drop ( IDataObject* pDataObject, DWORD grfKeyState, POINTL pt, DWORD* pdwEffect ) ; +TYPEDEF: LPWSTR LPCOLESTR +TYPEDEF: LPWSTR OLESTR +TYPEDEF: OLESTR** SNB +TYPEDEF: wchar_t* OLECHAR +C-TYPE: IEnumSTATSTG + +STRUCT: STATSTG + { pwcsName LPOLESTR } + { type DWORD } + { cbSize ULARGE_INTEGER } + { mtime FILETIME } + { ctime FILETIME } + { atime FILETIME } + { grfMode DWORD } + { grfLocksSupported DWORD } + { clsid CLSID } + { grfStateBits DWORD } + { reserved DWORD } ; + +COM-INTERFACE: IStorage IUnknown {0000000B-0000-0000-C000-000000000046} + HRESULT Commit ( DWORD grfCommitFlags ) + HRESULT CopyTo ( DWORD ciidExclude, IID *rgiidExclude, SNB snbExclude, IStorage *pstgDest ) + HRESULT CreateStorage ( OLECHAR *pwcsName, DWORD grfMode, DWORD reserved1, DWORD reserved2, IStorage **ppstg ) + HRESULT CreateStream ( OLECHAR *pwcsName, DWORD grfMode, DWORD reserved1, DWORD reserved2, IStream **ppstm ) + HRESULT DestroyElement ( OLECHAR *pwcsName ) + HRESULT EnumElements ( DWORD reserved1, void *reserved2, DWORD reserved3, IEnumSTATSTG **ppenum ) + HRESULT MoveElementTo ( OLECHAR *pwcsName, IStorage *pstgDest, OLECHAR *pwcsNewName, DWORD grfFlags ) + HRESULT OpenStorage ( OLECHAR *pwcsName, IStorage *pstgPriority, DWORD grfMode, SNB snbExclude, DWORD reserved, IStorage **ppstg ) + HRESULT OpenStream ( OLECHAR *pwcsName, void *reserved1, DWORD grfMode, DWORD reserved2, IStream **ppstm ) + HRESULT RenameElement ( OLECHAR *pwcsOldName, OLECHAR *pwcsNewName ) + HRESULT Revert ( ) + HRESULT SetClass ( REFCLSID clsid ) + HRESULT SetElementTimes ( OLECHAR *pwcsName, FILETIME *pctime, FILETIME *patime, FILETIME *pmtime ) + HRESULT SetStateBits ( DWORD grfStateBits, DWORD grfMask ) + HRESULT Stat ( STATSTG *pstatstg, DWORD grfStatFlag ) ; + TYPEDEF: IDataObject* LPDATAOBJECT TYPEDEF: IDropSource* LPDROPSOURCE @@ -49,18 +91,6 @@ COM-INTERFACE: ISequentialStream IUnknown {0C733A30-2A1C-11CE-ADE5-00AA0044773D} HRESULT Read ( void* pv, ULONG cb, ULONG* pcbRead ) HRESULT Write ( void* pv, ULONG cb, ULONG* pcbWritten ) ; -STRUCT: STATSTG - { pwcsName LPOLESTR } - { type DWORD } - { cbSize ULARGE_INTEGER } - { mtime FILETIME } - { ctime FILETIME } - { atime FILETIME } - { grfMode DWORD } - { grfLocksSupported DWORD } - { clsid CLSID } - { grfStateBits DWORD } - { reserved DWORD } ; CONSTANT: STGM_READ 0 CONSTANT: STGM_WRITE 1 diff --git a/basis/windows/gdi32/gdi32.factor b/basis/windows/gdi32/gdi32.factor index 20fb2090b1..a39b4f427b 100644 --- a/basis/windows/gdi32/gdi32.factor +++ b/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 diff --git a/basis/windows/messages/messages.factor b/basis/windows/messages/messages.factor index a0c18106ec..422ed45f86 100644 --- a/basis/windows/messages/messages.factor +++ b/basis/windows/messages/messages.factor @@ -210,6 +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_BEFOREPARENT 0x02e2 +CONSTANT: WM_DPICHANGED_AFTERPARENT 0x02e3 +CONSTANT: WM_GETDPISCALEDSIZE 0x2e4 CONSTANT: WM_CUT 0x0300 CONSTANT: WM_COPY 0x0301 CONSTANT: WM_PASTE 0x0302 diff --git a/basis/windows/ole32/ole32.factor b/basis/windows/ole32/ole32.factor index 7256a221bc..1ee7bbe63b 100644 --- a/basis/windows/ole32/ole32.factor +++ b/basis/windows/ole32/ole32.factor @@ -1,8 +1,8 @@ -USING: alien alien.syntax alien.c-types alien.data alien.strings -math kernel sequences windows.errors windows.types io accessors -math.order namespaces make math.parser windows.kernel32 -combinators locals specialized-arrays literals splitting -grouping classes.struct combinators.smart ; +USING: accessors alien.c-types alien.data alien.syntax +classes.struct combinators combinators.smart grouping kernel +literals math.order math.parser parser sequences +specialized-arrays splitting windows.errors windows.kernel32 +windows.types words.constant ; SPECIALIZED-ARRAY: uchar IN: windows.ole32 @@ -33,12 +33,57 @@ CONSTANT: DRAGDROP_S_DROP 0x00040100 CONSTANT: DRAGDROP_S_CANCEL 0x00040101 CONSTANT: DRAGDROP_S_USEDEFAULTCURSORS 0x00040102 -CONSTANT: E_NOTIMPL 0x80004001 -CONSTANT: E_NOINTERFACE 0x80004002 -CONSTANT: E_FAIL 0x80004005 -CONSTANT: E_UNEXPECTED 0x8000FFFF -CONSTANT: E_OUTOFMEMORY 0x8007000E -CONSTANT: E_INVALIDARG 0x80070057 +<< +: >long ( integer -- long ) + long long deref ; inline +>> +<< +SYNTAX: LONG: scan-new-word scan-object >long define-constant ; +>> + +LONG: E_NOTIMPL 0x80004001 +LONG: E_NOINTERFACE 0x80004002 +LONG: E_FAIL 0x80004005 +LONG: E_UNEXPECTED 0x8000FFFF +LONG: E_OUTOFMEMORY 0x8007000E +LONG: E_INVALIDARG 0x80070057 + +LONG: OLE_E_OLEVERB 0x80040000 +LONG: OLE_E_ADVF 0x80040001 +LONG: OLE_E_ENUM_NOMORE 0x80040002 +LONG: OLE_E_ADVISENOTSUPPORTED 0x80040003 +LONG: OLE_E_NOCONNECTION 0x80040004 +LONG: OLE_E_NOTRUNNING 0x80040005 +LONG: OLE_E_NOCACHE 0x80040006 +LONG: OLE_E_BLANK 0x80040007 +LONG: OLE_E_CLASSDIFF 0x80040008 +LONG: OLE_E_CANT_GETMONIKER 0x80040009 +LONG: OLE_E_CANT_BINDTOSOURCE 0x8004000A +LONG: OLE_E_STATIC 0x8004000B +LONG: OLE_E_PROMPTSAVECANCELLED 0x8004000C +LONG: OLE_E_INVALIDRECT 0x8004000D +LONG: OLE_E_WRONGCOMPOBJ 0x8004000E +LONG: OLE_E_INVALIDHWND 0x8004000F +LONG: OLE_E_NOT_INPLACEACTIVE 0x80040010 +LONG: OLE_E_CANTCONVERT 0x80040011 +LONG: OLE_E_NOSTORAGE 0x80040012 + +LONG: CO_E_NOTINITIALIZED 0x800401F0 +LONG: CO_E_ALREADYINITIALIZED 0x800401F1 +LONG: CO_E_CANTDETERMINECLASS 0x800401F2 +LONG: CO_E_CLASSSTRING 0x800401F3 +LONG: CO_E_IIDSTRING 0x800401F4 +LONG: CO_E_APPNOTFOUND 0x800401F5 +LONG: CO_E_APPSINGLEUSE 0x800401F6 +LONG: CO_E_ERRORINAPP 0x800401F7 +LONG: CO_E_DLLNOTFOUND 0x800401F8 +LONG: CO_E_ERRORINDLL 0x800401F9 +LONG: CO_E_WRONGOSFORAPP 0x800401FA +LONG: CO_E_OBJNOTREG 0x800401FB +LONG: CO_E_OBJISREG 0x800401FC +LONG: CO_E_OBJNOTCONNECTED 0x800401FD +LONG: CO_E_APPDIDNTREG 0x800401FE +LONG: CO_E_RELEASED 0x800401FF CONSTANT: MK_ALT 0x20 CONSTANT: DROPEFFECT_NONE 0 diff --git a/basis/windows/shcore/authors.txt b/basis/windows/shcore/authors.txt new file mode 100644 index 0000000000..156fc8269d --- /dev/null +++ b/basis/windows/shcore/authors.txt @@ -0,0 +1 @@ +Benjamin Pollack diff --git a/basis/windows/shcore/platforms.txt b/basis/windows/shcore/platforms.txt new file mode 100644 index 0000000000..8e1a55995e --- /dev/null +++ b/basis/windows/shcore/platforms.txt @@ -0,0 +1 @@ +windows diff --git a/basis/windows/shcore/shcore.factor b/basis/windows/shcore/shcore.factor new file mode 100644 index 0000000000..f36064d01a --- /dev/null +++ b/basis/windows/shcore/shcore.factor @@ -0,0 +1,75 @@ +! Copyright (C) 2017 Benjamin Pollack. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.syntax windows.types ; +IN: windows.shcore + +LIBRARY: shcore + +ENUM: MONITOR_DPI_TYPE + MDT_EFFECTIVE_DPI + MDT_ANGULAR_DPI + 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 } ; \ No newline at end of file diff --git a/basis/windows/shcore/tags.txt b/basis/windows/shcore/tags.txt new file mode 100644 index 0000000000..bb863cf9a0 --- /dev/null +++ b/basis/windows/shcore/tags.txt @@ -0,0 +1 @@ +bindings diff --git a/basis/windows/types/types.factor b/basis/windows/types/types.factor index e58ab2b1f7..7bf1fa2208 100644 --- a/basis/windows/types/types.factor +++ b/basis/windows/types/types.factor @@ -109,6 +109,7 @@ TYPEDEF: HANDLE HKL TYPEDEF: HANDLE HLOCAL TYPEDEF: HANDLE HMENU TYPEDEF: HANDLE HMETAFILE +TYPEDEF: HANDLE HMETAFILEPICT TYPEDEF: HINSTANCE HMODULE TYPEDEF: HANDLE HMONITOR TYPEDEF: HANDLE HPALETTE diff --git a/basis/windows/user32/user32.factor b/basis/windows/user32/user32.factor index ab04228ff1..c70e1a5c4e 100644 --- a/basis/windows/user32/user32.factor +++ b/basis/windows/user32/user32.factor @@ -1898,7 +1898,7 @@ ALIAS: MessageBoxEx MessageBoxExW ! FUNCTION: ModifyMenuA ! FUNCTION: ModifyMenuW -! FUNCTION: MonitorFromPoint +FUNCTION: HMONITOR MonitorFromPoint ( POINT pt, DWORD dwFlags ) ! FUNCTION: MonitorFromRect FUNCTION: HMONITOR MonitorFromWindow ( HWND hWnd, DWORD dwFlags ) ! FUNCTION: mouse_event @@ -2258,3 +2258,145 @@ STRUCT: POWERBROADCAST_SETTING : msgbox ( str -- ) f swap "DebugMsg" MB_OK MessageBox drop ; + +! HighDPI +TYPEDEF: HANDLE DPI_AWARENESS_CONTEXT + +ENUM: DPI_AWARENESS + { DPI_AWARENESS_INVALID -1 } + { DPI_AWARENESS_UNAWARE 0 } + { DPI_AWARENESS_SYSTEM_AWARE 1 } + { DPI_AWARENESS_PER_MONITOR_AWARE 2 } ; + +FUNCTION: BOOL AdjustWindowRectExForDpi ( + LPRECT lpRect, + DWORD dwStyle, + BOOL bMenu, + DWORD dwExStyle, + UINT dpi +) + +FUNCTION: BOOL EnableNonClientDpiScaling ( + HWND hwnd +) + +FUNCTION: BOOL AreDpiAwarenessContextsEqual ( + DPI_AWARENESS_CONTEXT dpiContextA, + DPI_AWARENESS_CONTEXT dpiContextB +) + +ENUM: DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS + DCDC_DEFAULT + DCDC_DISABLE_FONT_UPDATE + DCDC_DISABLE_RELAYOUT ; + +FUNCTION: DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS GetDialogControlDpiChangeBehavior ( + HWND hWnd +) + +ENUM: DIALOG_DPI_CHANGE_BEHAVIORS + DDC_DEFAULT + DDC_DISABLE_ALL + DDC_DISABLE_RESIZE + DDC_DISABLE_CONTROL_RELAYOUT ; + +FUNCTION: DIALOG_DPI_CHANGE_BEHAVIORS GetDialogDpiChangeBehavior ( + HWND hDlg +) + +FUNCTION: UINT GetDpiForSystem ( ) + +FUNCTION: UINT GetDpiForWindow ( HWND hwnd ) + +FUNCTION: UINT GetSystemDpiForProcess ( + HANDLE hProcess +) + +FUNCTION: int GetSystemMetricsForDpi ( + int nIndex, + UINT dpi +) + +FUNCTION: DPI_AWARENESS_CONTEXT GetThreadDpiAwarenessContext ( ) +FUNCTION: DPI_AWARENESS_CONTEXT SetThreadDpiAwarenessContext ( DPI_AWARENESS_CONTEXT dpiContext ) + +ENUM: DPI_HOSTING_BEHAVIOR + DPI_HOSTING_BEHAVIOR_INVALID + DPI_HOSTING_BEHAVIOR_DEFAULT + DPI_HOSTING_BEHAVIOR_MIXED ; + +FUNCTION: DPI_HOSTING_BEHAVIOR GetThreadDpiHostingBehavior ( ) + +FUNCTION: DPI_HOSTING_BEHAVIOR GetWindowDpiHostingBehavior ( + HWND hwnd +) + +FUNCTION: BOOL SetProcessDPIAware ( ) +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 +) + +! DPI_AWARENESS_CONTEXT experimentally: +! USE: math.ranges -100 1000 [a,b] [ IsValidDpiAwarenessContext ] map-zip +! [ nip 0 > ] assoc-filter keys . +! { -5 -4 -3 -2 -1 17 18 34 273 529 785 } + +! -4 34 AreDpiAwarenessContextsEqual . ! t +! -5 -5 AreDpiAwarenessContextsEqual . ! t +! -6 -6 AreDpiAwarenessContextsEqual . ! f +: DPI_AWARENESS_CONTEXT_UNAWARE ( -- DPI_AWARENESS_CONTEXT ) + -1 ; + +: DPI_AWARENESS_CONTEXT_SYSTEM_AWARE ( -- DPI_AWARENESS_CONTEXT ) + -2 ; + +: DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE ( -- DPI_AWARENESS_CONTEXT ) + -3 ; + +: DPI_AWARENESS_CONTEXT_PER_MONITOR_AWARE_V2 ( -- DPI_AWARENESS_CONTEXT ) + -4 ; + +: DPI_AWARENESS_CONTEXT_UNAWARE_GDISCALED ( -- DPI_AWARENESS_CONTEXT ) + -5 ; + +FUNCTION: BOOL LogicalToPhysicalPointForPerMonitorDPI ( + HWND hWnd, + LPPOINT lpPoint +) + +FUNCTION: BOOL PhysicalToLogicalPointForPerMonitorDPI ( + HWND hWnd, + LPPOINT lpPoint +) + +FUNCTION: BOOL SetDialogControlDpiChangeBehavior ( + HWND hWnd, + DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS mask, + DIALOG_CONTROL_DPI_CHANGE_BEHAVIORS values +) + +FUNCTION: BOOL SetDialogDpiChangeBehavior ( + HWND hDlg, + DIALOG_DPI_CHANGE_BEHAVIORS mask, + DIALOG_DPI_CHANGE_BEHAVIORS values +) + +FUNCTION: DPI_HOSTING_BEHAVIOR SetThreadDpiHostingBehavior ( + DPI_HOSTING_BEHAVIOR value +) + +FUNCTION: BOOL SystemParametersInfoForDpi ( + UINT uiAction, + UINT uiParam, + PVOID pvParam, + UINT fWinIni, + UINT dpi +) diff --git a/basis/windows/windows.factor b/basis/windows/windows.factor index 47123f60a4..938ceae370 100644 --- a/basis/windows/windows.factor +++ b/basis/windows/windows.factor @@ -20,6 +20,7 @@ CONSTANT: MAX_UNICODE_PATH 32768 { "gl" "opengl32.dll" stdcall } { "glu" "glu32.dll" stdcall } { "ole32" "ole32.dll" stdcall } + { "shcore" "shcore.dll" stdcall } { "usp10" "usp10.dll" stdcall } { "psapi" "psapi.dll" stdcall } { "winmm" "winmm.dll" stdcall } diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 585c5f46ef..f32fcc87a1 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -155,32 +155,23 @@ PRIVATE> : fuel-scaffold-tests ( name devname -- result ) [ scaffold-name dup require dup scaffold-tests ] with-scope - vocab-tests-file absolute-path ; + vocab-tests-path absolute-path ; : fuel-scaffold-authors ( name devname -- result ) [ scaffold-name dup require dup scaffold-authors ] with-scope - [ vocab-authors-path ] keep swap vocab-append-path absolute-path ; + vocab-authors-path absolute-path ; : fuel-scaffold-tags ( name tags -- result ) [ scaffold-tags ] - [ - drop [ vocab-tags-path ] keep swap - vocab-append-path absolute-path - ] 2bi ; + [ drop vocab-tags-path absolute-path ] 2bi ; : fuel-scaffold-summary ( name summary -- result ) [ scaffold-summary ] - [ - drop [ vocab-summary-path ] keep swap - vocab-append-path absolute-path - ] 2bi ; + [ drop vocab-summary-path absolute-path ] 2bi ; : fuel-scaffold-platforms ( name platforms -- result ) [ scaffold-platforms ] - [ - drop [ vocab-platforms-path ] keep swap - vocab-append-path absolute-path - ] 2bi ; + [ drop vocab-platforms-path absolute-path ] 2bi ; : fuel-scaffold-get-root ( name -- result ) find-vocab-root ; diff --git a/extra/ui/render/test/reference.bmp b/extra/ui/render/test/reference.bmp index 807d8760c7..1873a5cda0 100644 Binary files a/extra/ui/render/test/reference.bmp and b/extra/ui/render/test/reference.bmp differ diff --git a/extra/windows/fullscreen/fullscreen.factor b/extra/windows/fullscreen/fullscreen.factor index 039caae071..dec93893d6 100644 --- a/extra/windows/fullscreen/fullscreen.factor +++ b/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 + [ GetScaleFactorForMonitor win32-error=0/f ] keep le> ; \ No newline at end of file diff --git a/factor.exe.manifest.in b/factor.exe.manifest.in new file mode 100644 index 0000000000..42ade3e48d --- /dev/null +++ b/factor.exe.manifest.in @@ -0,0 +1,12 @@ + + + + + + True/PM + + + diff --git a/vm/allot.hpp b/vm/allot.hpp index b6bb8c1b71..1987b2b0e4 100644 --- a/vm/allot.hpp +++ b/vm/allot.hpp @@ -20,9 +20,10 @@ inline code_block* factor_vm::allot_code_block(cell size, // Insufficient room even after code GC, give up if (block == NULL) { - std::cout << "Code heap used: " << code->allocator->occupied_space() - << "\n"; - std::cout << "Code heap free: " << code->allocator->free_space << "\n"; + std::cout << "Code heap used: " << code->allocator->occupied_space() << "\n"; + std::cout << "Code heap free: " << code->allocator->free_space << "\n"; + std::cout << "Code heap free_block_count: " << code->allocator->free_block_count << "\n"; + std::cout << "Code heap largest_free_block: " << code->allocator->largest_free_block() << "\n"; std::cout << "Request : " << block_size << "\n"; fatal_error("Out of memory in allot_code_block", 0); } diff --git a/vm/image.cpp b/vm/image.cpp index f29ca779a3..c61a0a83cd 100644 --- a/vm/image.cpp +++ b/vm/image.cpp @@ -232,9 +232,9 @@ void factor_vm::load_image(vm_parameters* p) { FILE* file = OPEN_READ(p->image_path); if (file == NULL) { - std::cout << "Cannot open image file: " << p->image_path << std::endl; + std::cout << "Cannot open image file: " << AS_UTF8(p->image_path) << std::endl; char *msg = threadsafe_strerror(errno); - std::cout << "strerror:2: " << msg << std::endl; + std::cout << "strerror: " << msg << std::endl; free(msg); exit(1); } diff --git a/vm/os-unix.hpp b/vm/os-unix.hpp index 33bde83e5b..b89a9bfcd6 100644 --- a/vm/os-unix.hpp +++ b/vm/os-unix.hpp @@ -53,4 +53,5 @@ void check_ENOMEM(const char* msg); static inline void breakpoint() { __builtin_trap(); } +#define AS_UTF8(ptr) ptr } diff --git a/vm/os-windows.hpp b/vm/os-windows.hpp index cca3c7e776..a21a67361b 100644 --- a/vm/os-windows.hpp +++ b/vm/os-windows.hpp @@ -92,4 +92,36 @@ inline static void breakpoint() { DebugBreak(); } extern HANDLE boot_thread; +inline static std::string to_utf8(const wchar_t* buffer, int len) { + int nChars = ::WideCharToMultiByte( + CP_UTF8, + 0, + buffer, + len, + NULL, + 0, + NULL, + NULL); + if (nChars == 0) return ""; + + std::string newbuffer; + newbuffer.resize(nChars) ; + ::WideCharToMultiByte( + CP_UTF8, + 0, + buffer, + len, + const_cast(newbuffer.c_str()), + nChars, + NULL, + NULL); + return newbuffer; +} + +inline static std::string to_utf8(const std::wstring& str) { + return to_utf8(str.c_str(), (int)str.size()); +} + +#define AS_UTF8(ptr) to_utf8(ptr) + }