[ t ] [ [ 1 whatever2 at ] { at* hashcode* } inlined? ] unit-test
[ f ] [ [ whatever2 at ] { at* hashcode* } inlined? ] unit-test
+SYMBOL: not-an-assoc
+
+[ f ] [ [ not-an-assoc at ] { at* } inlined? ] unit-test
+
[ t ] [ [ { 1 2 3 } member? ] { member? } inlined? ] unit-test
[ f ] [ [ { 1 2 3 } swap member? ] { member? } inlined? ] unit-test
] ;
: at-quot ( assoc -- quot )
- dup lookup-table-at? [
- dup fast-lookup-table-at? [
- fast-lookup-table-quot
- ] [
- lookup-table-quot
- ] if
+ dup assoc? [
+ dup lookup-table-at? [
+ dup fast-lookup-table-at? [
+ fast-lookup-table-quot
+ ] [
+ lookup-table-quot
+ ] if
+ ] [ drop f ] if
] [ drop f ] if ;
\ at* [ at-quot ] 1 define-partial-eval
io.files.windows io.files.windows.nt io.files io.pathnames io.buffers
io.streams.c io.streams.null libc kernel math namespaces sequences
threads windows windows.errors windows.kernel32 strings splitting
-ascii system accessors locals ;
+ascii system accessors locals classes.struct ;
QUALIFIED: windows.winsock
IN: io.backend.windows.nt
io.buffers io.files io.ports io.binary io.timeouts system
strings kernel math namespaces sequences windows.errors
windows.kernel32 windows.shell32 windows.types windows.winsock
-splitting continuations math.bitwise accessors init sets assocs ;
+splitting continuations math.bitwise accessors init sets assocs
+classes.struct classes ;
IN: io.backend.windows
TUPLE: win32-handle < disposable handle ;
} flags ; foldable
: default-security-attributes ( -- obj )
- "SECURITY_ATTRIBUTES" <c-object>
- "SECURITY_ATTRIBUTES" heap-size
- over set-SECURITY_ATTRIBUTES-nLength ;
+ SECURITY_ATTRIBUTES <struct>
+ dup class heap-size >>nLength ;
--- /dev/null
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test io.files.info.windows system kernel ;
+IN: io.files.info.windows.tests
+
+[ ] [ vm file-times 3drop ] unit-test
windows.time windows accessors alien.c-types combinators
generalizations system alien.strings io.encodings.utf16n
sequences splitting windows.errors fry continuations destructors
-calendar ascii combinators.short-circuit locals ;
+calendar ascii combinators.short-circuit locals classes.struct ;
IN: io.files.info.windows
:: round-up-to ( n multiple -- n' )
: BY_HANDLE_FILE_INFORMATION>file-info ( HANDLE_FILE_INFORMATION -- file-info )
[ \ windows-file-info new ] dip
{
- [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-type >>type ]
- [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes win32-file-attributes >>attributes ]
+ [ dwFileAttributes>> win32-file-type >>type ]
+ [ dwFileAttributes>> win32-file-attributes >>attributes ]
[
- [ BY_HANDLE_FILE_INFORMATION-nFileSizeLow ]
- [ BY_HANDLE_FILE_INFORMATION-nFileSizeHigh ] bi >64bit >>size
+ [ nFileSizeLow>> ]
+ [ nFileSizeHigh>> ] bi >64bit >>size
]
- [ BY_HANDLE_FILE_INFORMATION-dwFileAttributes >>permissions ]
- [
- BY_HANDLE_FILE_INFORMATION-ftCreationTime
- FILETIME>timestamp >>created
- ]
- [
- BY_HANDLE_FILE_INFORMATION-ftLastWriteTime
- FILETIME>timestamp >>modified
- ]
- [
- BY_HANDLE_FILE_INFORMATION-ftLastAccessTime
- FILETIME>timestamp >>accessed
- ]
- ! [ BY_HANDLE_FILE_INFORMATION-nNumberOfLinks ]
+ [ dwFileAttributes>> >>permissions ]
+ [ ftCreationTime>> FILETIME>timestamp >>created ]
+ [ ftLastWriteTime>> FILETIME>timestamp >>modified ]
+ [ ftLastAccessTime>> FILETIME>timestamp >>accessed ]
+ ! [ nNumberOfLinks>> ]
! [
- ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexLow ]
- ! [ BY_HANDLE_FILE_INFORMATION-nFileIndexHigh ] bi >64bit
+ ! [ nFileIndexLow>> ]
+ ! [ nFileIndexHigh>> ] bi >64bit
! ]
} cleave ;
: get-file-information ( handle -- BY_HANDLE_FILE_INFORMATION )
[
- "BY_HANDLE_FILE_INFORMATION" <c-object>
+ BY_HANDLE_FILE_INFORMATION <struct>
[ GetFileInformationByHandle win32-error=0/f ] keep
] keep CloseHandle win32-error=0/f ;
: file-times ( path -- timestamp timestamp timestamp )
[
- normalize-path open-existing &dispose handle>>
- "FILETIME" <c-object>
- "FILETIME" <c-object>
- "FILETIME" <c-object>
+ normalize-path open-read &dispose handle>>
+ FILETIME <struct>
+ FILETIME <struct>
+ FILETIME <struct>
[ GetFileTime win32-error=0/f ] 3keep
[ FILETIME>timestamp >local-time ] tri@
] with-destructors ;
: redirect-stderr ( process args -- handle )
over stderr>> +stdout+ eq? [
nip
- lpStartupInfo>> STARTUPINFO-hStdOutput
+ lpStartupInfo>> hStdOutput>>
] [
drop
stderr>>
STD_INPUT_HANDLE GetStdHandle or ;
M: winnt fill-redirection ( process args -- )
- [ 2dup redirect-stdout ] keep lpStartupInfo>> set-STARTUPINFO-hStdOutput
- [ 2dup redirect-stderr ] keep lpStartupInfo>> set-STARTUPINFO-hStdError
- [ 2dup redirect-stdin ] keep lpStartupInfo>> set-STARTUPINFO-hStdInput
- 2drop ;
+ dup lpStartupInfo>>
+ [ [ redirect-stdout ] dip (>>hStdOutput) ]
+ [ [ redirect-stderr ] dip (>>hStdError) ]
+ [ [ redirect-stdin ] dip (>>hStdInput) ] 3tri ;
splitting system threads init strings combinators
io.backend accessors concurrency.flags io.files assocs
io.files.private windows destructors specialized-arrays.ushort
-specialized-arrays.alien ;
+specialized-arrays.alien classes classes.struct ;
IN: io.launcher.windows
TUPLE: CreateProcess-args
: default-CreateProcess-args ( -- obj )
CreateProcess-args new
- "STARTUPINFO" <c-object>
- "STARTUPINFO" heap-size over set-STARTUPINFO-cb >>lpStartupInfo
- "PROCESS_INFORMATION" <c-object> >>lpProcessInformation
+ STARTUPINFO <struct>
+ dup class heap-size >>cb
+ >>lpStartupInfo
+ PROCESS_INFORMATION <struct> >>lpProcessInformation
TRUE >>bInheritHandles
0 >>dwCreateFlags ;
] when ;
: fill-startup-info ( process args -- process args )
- STARTF_USESTDHANDLES over lpStartupInfo>> set-STARTUPINFO-dwFlags ;
+ dup lpStartupInfo>> STARTF_USESTDHANDLES >>dwFlags drop ;
HOOK: fill-redirection io-backend ( process args -- )
] with-destructors ;
M: windows kill-process* ( handle -- )
- PROCESS_INFORMATION-hProcess
- 255 TerminateProcess win32-error=0/f ;
+ hProcess>> 255 TerminateProcess win32-error=0/f ;
: dispose-process ( process-information -- )
#! From MSDN: "Handles in PROCESS_INFORMATION must be closed
#! with CloseHandle when they are no longer needed."
- dup PROCESS_INFORMATION-hProcess [ CloseHandle drop ] when*
- PROCESS_INFORMATION-hThread [ CloseHandle drop ] when* ;
+ [ hProcess>> [ CloseHandle drop ] when* ]
+ [ hThread>> [ CloseHandle drop ] when* ] bi ;
: exit-code ( process -- n )
- PROCESS_INFORMATION-hProcess
+ hProcess>>
0 <ulong> [ GetExitCodeProcess ] keep *ulong
swap win32-error=0/f ;
M: windows wait-for-processes ( -- ? )
processes get keys dup
- [ handle>> PROCESS_INFORMATION-hProcess ] void*-array{ } map-as
+ [ handle>> hProcess>> ] void*-array{ } map-as
[ length ] keep 0 0
WaitForMultipleObjects
dup HEX: ffffffff = [ win32-error ] when
! Rendering
{ "drawRect:" "void" { "id" "SEL" "NSRect" }
- [ 2drop window relayout-1 ]
+ [ 2drop window relayout-1 yield ]
}
! Events
! Copyright (C) 2005, 2006 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.syntax kernel windows.types multiline ;
+USING: alien alien.syntax kernel windows.types multiline
+classes.struct ;
IN: windows.kernel32
CONSTANT: MAX_PATH 260
{ "DWORD" "offset-high" }
{ "HANDLE" "event" } ;
-C-STRUCT: SYSTEMTIME
- { "WORD" "wYear" }
- { "WORD" "wMonth" }
- { "WORD" "wDayOfWeek" }
- { "WORD" "wDay" }
- { "WORD" "wHour" }
- { "WORD" "wMinute" }
- { "WORD" "wSecond" }
- { "WORD" "wMilliseconds" } ;
+STRUCT: SYSTEMTIME
+ { wYear WORD }
+ { wMonth WORD }
+ { wDayOfWeek WORD }
+ { wDay WORD }
+ { wHour WORD }
+ { wMinute WORD }
+ { wSecond WORD }
+ { wMilliseconds WORD } ;
C-STRUCT: TIME_ZONE_INFORMATION
{ "LONG" "Bias" }
{ "SYSTEMTIME" "DaylightDate" }
{ "LONG" "DaylightBias" } ;
-C-STRUCT: FILETIME
- { "DWORD" "dwLowDateTime" }
- { "DWORD" "dwHighDateTime" } ;
-
-C-STRUCT: STARTUPINFO
- { "DWORD" "cb" }
- { "LPTSTR" "lpReserved" }
- { "LPTSTR" "lpDesktop" }
- { "LPTSTR" "lpTitle" }
- { "DWORD" "dwX" }
- { "DWORD" "dwY" }
- { "DWORD" "dwXSize" }
- { "DWORD" "dwYSize" }
- { "DWORD" "dwXCountChars" }
- { "DWORD" "dwYCountChars" }
- { "DWORD" "dwFillAttribute" }
- { "DWORD" "dwFlags" }
- { "WORD" "wShowWindow" }
- { "WORD" "cbReserved2" }
- { "LPBYTE" "lpReserved2" }
- { "HANDLE" "hStdInput" }
- { "HANDLE" "hStdOutput" }
- { "HANDLE" "hStdError" } ;
+STRUCT: FILETIME
+ { dwLowDateTime DWORD }
+ { dwHighDateTime DWORD } ;
+
+STRUCT: STARTUPINFO
+ { cb DWORD }
+ { lpReserved LPTSTR }
+ { lpDesktop LPTSTR }
+ { lpTitle LPTSTR }
+ { dwX DWORD }
+ { dwY DWORD }
+ { dwXSize DWORD }
+ { dwYSize DWORD }
+ { dwXCountChars DWORD }
+ { dwYCountChars DWORD }
+ { dwFillAttribute DWORD }
+ { dwFlags DWORD }
+ { wShowWindow WORD }
+ { cbReserved2 WORD }
+ { lpReserved2 LPBYTE }
+ { hStdInput HANDLE }
+ { hStdOutput HANDLE }
+ { hStdError HANDLE } ;
TYPEDEF: void* LPSTARTUPINFO
-C-STRUCT: PROCESS_INFORMATION
- { "HANDLE" "hProcess" }
- { "HANDLE" "hThread" }
- { "DWORD" "dwProcessId" }
- { "DWORD" "dwThreadId" } ;
-
-C-STRUCT: SYSTEM_INFO
- { "DWORD" "dwOemId" }
- { "DWORD" "dwPageSize" }
- { "LPVOID" "lpMinimumApplicationAddress" }
- { "LPVOID" "lpMaximumApplicationAddress" }
- { "DWORD_PTR" "dwActiveProcessorMask" }
- { "DWORD" "dwNumberOfProcessors" }
- { "DWORD" "dwProcessorType" }
- { "DWORD" "dwAllocationGranularity" }
- { "WORD" "wProcessorLevel" }
- { "WORD" "wProcessorRevision" } ;
+STRUCT: PROCESS_INFORMATION
+ { hProcess HANDLE }
+ { hThread HANDLE }
+ { dwProcessId DWORD }
+ { dwThreadId DWORD } ;
+
+STRUCT: SYSTEM_INFO
+ { dwOemId DWORD }
+ { dwPageSize DWORD }
+ { lpMinimumApplicationAddress LPVOID }
+ { lpMaximumApplicationAddress LPVOID }
+ { dwActiveProcessorMask DWORD_PTR }
+ { dwNumberOfProcessors DWORD }
+ { dwProcessorType DWORD }
+ { dwAllocationGranularity DWORD }
+ { wProcessorLevel WORD }
+ { wProcessorRevision WORD } ;
TYPEDEF: void* LPSYSTEM_INFO
-C-STRUCT: MEMORYSTATUS
- { "DWORD" "dwLength" }
- { "DWORD" "dwMemoryLoad" }
- { "SIZE_T" "dwTotalPhys" }
- { "SIZE_T" "dwAvailPhys" }
- { "SIZE_T" "dwTotalPageFile" }
- { "SIZE_T" "dwAvailPageFile" }
- { "SIZE_T" "dwTotalVirtual" }
- { "SIZE_T" "dwAvailVirtual" } ;
+STRUCT: MEMORYSTATUS
+ { dwLength DWORD }
+ { dwMemoryLoad DWORD }
+ { dwTotalPhys SIZE_T }
+ { dwAvailPhys SIZE_T }
+ { dwTotalPageFile SIZE_T }
+ { dwAvailPageFile SIZE_T }
+ { dwTotalVirtual SIZE_T }
+ { dwAvailVirtual SIZE_T } ;
TYPEDEF: void* LPMEMORYSTATUS
-C-STRUCT: MEMORYSTATUSEX
- { "DWORD" "dwLength" }
- { "DWORD" "dwMemoryLoad" }
- { "DWORDLONG" "ullTotalPhys" }
- { "DWORDLONG" "ullAvailPhys" }
- { "DWORDLONG" "ullTotalPageFile" }
- { "DWORDLONG" "ullAvailPageFile" }
- { "DWORDLONG" "ullTotalVirtual" }
- { "DWORDLONG" "ullAvailVirtual" }
- { "DWORDLONG" "ullAvailExtendedVirtual" } ;
+STRUCT: MEMORYSTATUSEX
+ { dwLength DWORD }
+ { dwMemoryLoad DWORD }
+ { ullTotalPhys DWORDLONG }
+ { ullAvailPhys DWORDLONG }
+ { ullTotalPageFile DWORDLONG }
+ { ullAvailPageFile DWORDLONG }
+ { ullTotalVirtual DWORDLONG }
+ { ullAvailVirtual DWORDLONG }
+ { ullAvailExtendedVirtual DWORDLONG } ;
TYPEDEF: void* LPMEMORYSTATUSEX
{ { "TCHAR" 260 } "cFileName" }
{ { "TCHAR" 14 } "cAlternateFileName" } ;
-C-STRUCT: BY_HANDLE_FILE_INFORMATION
- { "DWORD" "dwFileAttributes" }
- { "FILETIME" "ftCreationTime" }
- { "FILETIME" "ftLastAccessTime" }
- { "FILETIME" "ftLastWriteTime" }
- { "DWORD" "dwVolumeSerialNumber" }
- { "DWORD" "nFileSizeHigh" }
- { "DWORD" "nFileSizeLow" }
- { "DWORD" "nNumberOfLinks" }
- { "DWORD" "nFileIndexHigh" }
- { "DWORD" "nFileIndexLow" } ;
+STRUCT: BY_HANDLE_FILE_INFORMATION
+ { dwFileAttributes DWORD }
+ { ftCreationTime FILETIME }
+ { ftLastAccessTime FILETIME }
+ { ftLastWriteTime FILETIME }
+ { dwVolumeSerialNumber DWORD }
+ { nFileSizeHigh DWORD }
+ { nFileSizeLow DWORD }
+ { nNumberOfLinks DWORD }
+ { nFileIndexHigh DWORD }
+ { nFileIndexLow DWORD } ;
TYPEDEF: WIN32_FIND_DATA* PWIN32_FIND_DATA
TYPEDEF: WIN32_FIND_DATA* LPWIN32_FIND_DATA
TYPEDEF: int GET_FILEEX_INFO_LEVELS
-C-STRUCT: SECURITY_ATTRIBUTES
- { "DWORD" "nLength" }
- { "LPVOID" "lpSecurityDescriptor" }
- { "BOOL" "bInheritHandle" } ;
+STRUCT: SECURITY_ATTRIBUTES
+ { nLength DWORD }
+ { lpSecurityDescriptor LPVOID }
+ { bInheritHandle BOOL } ;
CONSTANT: HANDLE_FLAG_INHERIT 1
CONSTANT: HANDLE_FLAG_PROTECT_FROM_CLOSE 2
! Copyright (C) 2007 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types kernel math windows.errors
-windows.kernel32 namespaces calendar math.bitwise ;
+windows.kernel32 namespaces calendar math.bitwise accessors
+classes.struct ;
IN: windows.time
: >64bit ( lo hi -- n )
1601 1 1 0 0 0 instant <timestamp> ;
: FILETIME>windows-time ( FILETIME -- n )
- [ FILETIME-dwLowDateTime ]
- [ FILETIME-dwHighDateTime ]
- bi >64bit ;
+ [ dwLowDateTime>> ] [ dwHighDateTime>> ] bi >64bit ;
: windows-time>timestamp ( n -- timestamp )
10000000 /i seconds windows-1601 swap time+ ;
: windows-time ( -- n )
- "FILETIME" <c-object> [ GetSystemTimeAsFileTime ] keep
+ FILETIME <struct> [ GetSystemTimeAsFileTime ] keep
FILETIME>windows-time ;
: timestamp>windows-time ( timestamp -- n )
>gmt windows-1601 (time-) 10000000 * >integer ;
: windows-time>FILETIME ( n -- FILETIME )
- "FILETIME" <c-object>
- [
- [ [ 32 bits ] dip set-FILETIME-dwLowDateTime ]
- [ [ -32 shift ] dip set-FILETIME-dwHighDateTime ] 2bi
- ] keep ;
+ [ FILETIME <struct> ] dip
+ [ 32 bits >>dwLowDateTime ] [ -32 shift >>dwHighDateTime ] bi ;
: timestamp>FILETIME ( timestamp -- FILETIME/f )
dup [ >gmt timestamp>windows-time windows-time>FILETIME ] when ;
! Copyright (C) 2007, 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors images images.loader io.pathnames kernel namespaces
-opengl opengl.gl opengl.textures sequences strings ui ui.gadgets
-ui.gadgets.panes ui.render ui.images ;
+USING: accessors images images.loader io.pathnames kernel
+models namespaces opengl opengl.gl opengl.textures sequences
+strings ui ui.gadgets ui.gadgets.panes ui.images ui.render
+constructors ;
IN: images.viewer
TUPLE: image-gadget < gadget image texture ;
dup texture>> [ ] [ dup image>> { 0 0 } <texture> >>texture texture>> ] ?if ;
M: image-gadget draw-gadget* ( gadget -- )
- [ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture ;
+ dup image>> [
+ [ dim>> ] [ image-gadget-texture ] bi draw-scaled-texture
+ ] [
+ drop
+ ] if ;
+
+TUPLE: image-control < image-gadget ;
+
+CONSTRUCTOR: image-control ( model -- image-control ) ;
+
+M: image-control pref-dim* image>> [ dim>> ] [ { 640 480 } ] if* ;
+
+M: image-control model-changed
+ swap value>> >>image relayout ;
! Todo: delete texture on ungraft
USING: alien alien.c-types alien.strings
kernel libc math namespaces system-info.backend
system-info.windows windows windows.advapi32
-windows.kernel32 system byte-arrays windows.errors ;
+windows.kernel32 system byte-arrays windows.errors
+classes classes.struct ;
IN: system-info.windows.nt
M: winnt cpus ( -- n )
system-info SYSTEM_INFO-dwNumberOfProcessors ;
: memory-status ( -- MEMORYSTATUSEX )
- "MEMORYSTATUSEX" <c-object>
- "MEMORYSTATUSEX" heap-size over set-MEMORYSTATUSEX-dwLength
+ "MEMORYSTATUSEX" <struct>
+ dup class heap-size >>dwLength
dup GlobalMemoryStatusEx win32-error=0/f ;
M: winnt memory-load ( -- n )
- memory-status MEMORYSTATUSEX-dwMemoryLoad ;
+ memory-status dwMemoryLoad>> ;
M: winnt physical-mem ( -- n )
- memory-status MEMORYSTATUSEX-ullTotalPhys ;
+ memory-status ullTotalPhys>> ;
M: winnt available-mem ( -- n )
- memory-status MEMORYSTATUSEX-ullAvailPhys ;
+ memory-status ullAvailPhys>> ;
M: winnt total-page-file ( -- n )
- memory-status MEMORYSTATUSEX-ullTotalPageFile ;
+ memory-status ullTotalPageFile>> ;
M: winnt available-page-file ( -- n )
- memory-status MEMORYSTATUSEX-ullAvailPageFile ;
+ memory-status ullAvailPageFile>> ;
M: winnt total-virtual-mem ( -- n )
- memory-status MEMORYSTATUSEX-ullTotalVirtual ;
+ memory-status ullTotalVirtual>> ;
M: winnt available-virtual-mem ( -- n )
- memory-status MEMORYSTATUSEX-ullAvailVirtual ;
+ memory-status ullAvailVirtual>> ;
: computer-name ( -- string )
MAX_COMPUTERNAME_LENGTH 1 +
IN: system-info.windows
: system-info ( -- SYSTEM_INFO )
- "SYSTEM_INFO" <c-object> [ GetSystemInfo ] keep ;
+ SYSTEM_INFO <struct> [ GetSystemInfo ] keep ;
: page-size ( -- n )
- system-info SYSTEM_INFO-dwPageSize ;
+ system-info dwPageSize>> ;
! 386, 486, 586, 2200 (IA64), 8664 (AMD_X8664)
: processor-type ( -- n )
- system-info SYSTEM_INFO-dwProcessorType ;
+ system-info dwProcessorType>> ;
! 0 = x86, 6 = Intel Itanium, 9 = x64 (AMD or Intel), 10 = WOW64, 0xffff = Unk
: processor-architecture ( -- n )
- system-info SYSTEM_INFO-dwOemId HEX: ffff0000 bitand ;
+ system-info dwOemId>> HEX: ffff0000 bitand ;
: os-version ( -- os-version )
"OSVERSIONINFO" <c-object>
projects / factor.git / commitdiff