Merge branch 'master' of git://factorcode.org/git/factor
commit
2f1ffc5d35
|
@ -0,0 +1,10 @@
|
||||||
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: alien.c-types io.directories.unix kernel system unix ;
|
||||||
|
IN: io.directories.unix.linux
|
||||||
|
|
||||||
|
M: unix find-next-file ( DIR* -- byte-array )
|
||||||
|
"dirent" <c-object>
|
||||||
|
f <void*>
|
||||||
|
[ readdir64_r 0 = [ (io-error) ] unless ] 2keep
|
||||||
|
*void* [ drop f ] unless ;
|
|
@ -0,0 +1 @@
|
||||||
|
unportable
|
|
@ -4,7 +4,7 @@ USING: accessors alien.c-types alien.strings combinators
|
||||||
continuations destructors fry io io.backend io.backend.unix
|
continuations destructors fry io io.backend io.backend.unix
|
||||||
io.directories io.encodings.binary io.encodings.utf8 io.files
|
io.directories io.encodings.binary io.encodings.utf8 io.files
|
||||||
io.pathnames io.files.types kernel math.bitwise sequences system
|
io.pathnames io.files.types kernel math.bitwise sequences system
|
||||||
unix unix.stat ;
|
unix unix.stat vocabs.loader ;
|
||||||
IN: io.directories.unix
|
IN: io.directories.unix
|
||||||
|
|
||||||
: touch-mode ( -- n )
|
: touch-mode ( -- n )
|
||||||
|
@ -34,7 +34,9 @@ M: unix copy-file ( from to -- )
|
||||||
[ opendir dup [ (io-error) ] unless ] dip
|
[ opendir dup [ (io-error) ] unless ] dip
|
||||||
dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
|
dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
|
||||||
|
|
||||||
: find-next-file ( DIR* -- byte-array )
|
HOOK: find-next-file os ( DIR* -- byte-array )
|
||||||
|
|
||||||
|
M: unix find-next-file ( DIR* -- byte-array )
|
||||||
"dirent" <c-object>
|
"dirent" <c-object>
|
||||||
f <void*>
|
f <void*>
|
||||||
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
|
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
|
||||||
|
@ -54,8 +56,10 @@ M: unix copy-file ( from to -- )
|
||||||
} case ;
|
} case ;
|
||||||
|
|
||||||
M: unix >directory-entry ( byte-array -- directory-entry )
|
M: unix >directory-entry ( byte-array -- directory-entry )
|
||||||
[ dirent-d_name utf8 alien>string ]
|
{
|
||||||
[ dirent-d_type dirent-type>file-type ] bi directory-entry boa ;
|
[ dirent-d_name utf8 alien>string ]
|
||||||
|
[ dirent-d_type dirent-type>file-type ]
|
||||||
|
} cleave directory-entry boa ;
|
||||||
|
|
||||||
M: unix (directory-entries) ( path -- seq )
|
M: unix (directory-entries) ( path -- seq )
|
||||||
[
|
[
|
||||||
|
@ -63,3 +67,5 @@ M: unix (directory-entries) ( path -- seq )
|
||||||
[ >directory-entry ]
|
[ >directory-entry ]
|
||||||
produce nip
|
produce nip
|
||||||
] with-unix-directory ;
|
] with-unix-directory ;
|
||||||
|
|
||||||
|
os linux? [ "io.directories.unix.linux" require ] when
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2008 Doug Coleman, Eduardo Cavazos.
|
! Copyright (C) 2008 Doug Coleman, Eduardo Cavazos.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors kernel system sequences combinators
|
USING: accessors kernel system sequences combinators
|
||||||
vocabs.loader io.files.types ;
|
vocabs.loader io.files.types math ;
|
||||||
IN: io.files.info
|
IN: io.files.info
|
||||||
|
|
||||||
! File info
|
! File info
|
||||||
|
@ -14,6 +14,9 @@ HOOK: link-info os ( path -- info )
|
||||||
|
|
||||||
: directory? ( file-info -- ? ) type>> +directory+ = ;
|
: directory? ( file-info -- ? ) type>> +directory+ = ;
|
||||||
|
|
||||||
|
: sparse-file? ( file-info -- ? )
|
||||||
|
[ size-on-disk>> ] [ size>> ] bi < ;
|
||||||
|
|
||||||
! File systems
|
! File systems
|
||||||
HOOK: file-systems os ( -- array )
|
HOOK: file-systems os ( -- array )
|
||||||
|
|
||||||
|
|
|
@ -35,6 +35,6 @@ ERROR: bad-byte-array-length byte-array ;
|
||||||
heap-size struct-array boa ; inline
|
heap-size struct-array boa ; inline
|
||||||
|
|
||||||
: malloc-struct-array ( length c-type -- struct-array )
|
: malloc-struct-array ( length c-type -- struct-array )
|
||||||
[ heap-size calloc ] 2keep <direct-struct-array> ;
|
[ heap-size calloc ] 2keep <direct-struct-array> ; inline
|
||||||
|
|
||||||
INSTANCE: struct-array sequence
|
INSTANCE: struct-array sequence
|
||||||
|
|
|
@ -97,4 +97,8 @@ M: quit-responder call-responder*
|
||||||
shake-and-bake
|
shake-and-bake
|
||||||
run-temp-image
|
run-temp-image
|
||||||
] curry unit-test
|
] curry unit-test
|
||||||
] each
|
] each
|
||||||
|
|
||||||
|
os windows? os macosx? or [
|
||||||
|
[ ] [ "tools.deploy.test.8" shake-and-bake run-temp-image ] unit-test
|
||||||
|
] when
|
|
@ -41,7 +41,7 @@ IN: tools.deploy.shaker
|
||||||
] when
|
] when
|
||||||
strip-dictionary? [
|
strip-dictionary? [
|
||||||
{
|
{
|
||||||
"compiler.units"
|
! "compiler.units"
|
||||||
"vocabs"
|
"vocabs"
|
||||||
"vocabs.cache"
|
"vocabs.cache"
|
||||||
"source-files.errors"
|
"source-files.errors"
|
||||||
|
@ -271,7 +271,7 @@ IN: tools.deploy.shaker
|
||||||
compiled-generic-crossref
|
compiled-generic-crossref
|
||||||
compiler-impl
|
compiler-impl
|
||||||
compiler.errors:compiler-errors
|
compiler.errors:compiler-errors
|
||||||
definition-observers
|
! definition-observers
|
||||||
interactive-vocabs
|
interactive-vocabs
|
||||||
lexer-factory
|
lexer-factory
|
||||||
print-use-hook
|
print-use-hook
|
||||||
|
@ -301,16 +301,16 @@ IN: tools.deploy.shaker
|
||||||
compiler.errors:compiler-errors
|
compiler.errors:compiler-errors
|
||||||
continuations:thread-error-hook
|
continuations:thread-error-hook
|
||||||
} %
|
} %
|
||||||
|
|
||||||
|
deploy-ui? get [
|
||||||
|
"ui-error-hook" "ui.gadgets.worlds" lookup ,
|
||||||
|
] when
|
||||||
] when
|
] when
|
||||||
|
|
||||||
deploy-c-types? get [
|
deploy-c-types? get [
|
||||||
"c-types" "alien.c-types" lookup ,
|
"c-types" "alien.c-types" lookup ,
|
||||||
] unless
|
] unless
|
||||||
|
|
||||||
deploy-ui? get [
|
|
||||||
"ui-error-hook" "ui.gadgets.worlds" lookup ,
|
|
||||||
] when
|
|
||||||
|
|
||||||
"windows-messages" "windows.messages" lookup [ , ] when*
|
"windows-messages" "windows.messages" lookup [ , ] when*
|
||||||
] { } make ;
|
] { } make ;
|
||||||
|
|
||||||
|
@ -443,6 +443,9 @@ SYMBOL: deploy-vocab
|
||||||
strip-debugger? [
|
strip-debugger? [
|
||||||
"debugger" require
|
"debugger" require
|
||||||
"inspector" require
|
"inspector" require
|
||||||
|
deploy-ui? get [
|
||||||
|
"ui.debugger" require
|
||||||
|
] when
|
||||||
] unless
|
] unless
|
||||||
deploy-vocab set
|
deploy-vocab set
|
||||||
deploy-vocab get require
|
deploy-vocab get require
|
||||||
|
|
|
@ -0,0 +1,21 @@
|
||||||
|
USING: calendar game-input threads ui ui.gadgets.worlds kernel
|
||||||
|
method-chains system ;
|
||||||
|
IN: tools.deploy.test.8
|
||||||
|
|
||||||
|
TUPLE: my-world < world ;
|
||||||
|
|
||||||
|
BEFORE: my-world begin-world drop open-game-input ;
|
||||||
|
|
||||||
|
AFTER: my-world end-world drop close-game-input ;
|
||||||
|
|
||||||
|
: test-game-input ( -- )
|
||||||
|
[
|
||||||
|
f T{ world-attributes
|
||||||
|
{ world-class my-world }
|
||||||
|
{ title "Test" }
|
||||||
|
} open-window
|
||||||
|
1 seconds sleep
|
||||||
|
0 exit
|
||||||
|
] with-ui ;
|
||||||
|
|
||||||
|
MAIN: test-game-input
|
|
@ -0,0 +1,14 @@
|
||||||
|
USING: tools.deploy.config ;
|
||||||
|
H{
|
||||||
|
{ deploy-c-types? f }
|
||||||
|
{ deploy-unicode? f }
|
||||||
|
{ deploy-word-defs? f }
|
||||||
|
{ deploy-name "tools.deploy.test.8" }
|
||||||
|
{ "stop-after-last-window?" t }
|
||||||
|
{ deploy-reflection 1 }
|
||||||
|
{ deploy-ui? t }
|
||||||
|
{ deploy-math? t }
|
||||||
|
{ deploy-io 2 }
|
||||||
|
{ deploy-word-props? f }
|
||||||
|
{ deploy-threads? t }
|
||||||
|
}
|
|
@ -616,10 +616,8 @@ M: windows-ui-backend do-events
|
||||||
GetDoubleClickTime milliseconds double-click-timeout set-global ;
|
GetDoubleClickTime milliseconds double-click-timeout set-global ;
|
||||||
|
|
||||||
: cleanup-win32-ui ( -- )
|
: cleanup-win32-ui ( -- )
|
||||||
class-name-ptr [
|
class-name-ptr [ [ [ f UnregisterClass drop ] [ free ] bi ] when* f ] change-global
|
||||||
[ [ f UnregisterClass drop ] [ free ] bi ] when* f
|
msg-obj [ [ free ] when* f ] change-global ;
|
||||||
] change-global
|
|
||||||
msg-obj change-global [ [ free ] when* f ] ;
|
|
||||||
|
|
||||||
: get-dc ( world -- )
|
: get-dc ( world -- )
|
||||||
handle>> dup hWnd>> GetDC dup win32-error=0/f >>hDC drop ;
|
handle>> dup hWnd>> GetDC dup win32-error=0/f >>hDC drop ;
|
||||||
|
|
|
@ -0,0 +1,19 @@
|
||||||
|
! Copyright (C) 2006, 2009 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors debugger io kernel namespaces prettyprint
|
||||||
|
ui.gadgets.panes ui.gadgets.worlds ui ;
|
||||||
|
IN: ui.debugger
|
||||||
|
|
||||||
|
: <error-pane> ( error -- pane )
|
||||||
|
<pane> [ [ print-error ] with-pane ] keep ; inline
|
||||||
|
|
||||||
|
: error-window ( error -- )
|
||||||
|
<error-pane> "Error" open-window ;
|
||||||
|
|
||||||
|
[ error-window ] ui-error-hook set-global
|
||||||
|
|
||||||
|
M: world-error error.
|
||||||
|
"An error occurred while drawing the world " write
|
||||||
|
dup world>> pprint-short "." print
|
||||||
|
"This world has been deactivated to prevent cascading errors." print
|
||||||
|
error>> error. ;
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2005, 2009 Slava Pestov.
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: arrays accessors definitions hashtables io kernel sequences
|
USING: arrays accessors definitions hashtables io kernel sequences
|
||||||
strings words help math models namespaces quotations ui.gadgets
|
strings words math models namespaces quotations ui.gadgets
|
||||||
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private
|
ui.gadgets.borders ui.gadgets.buttons ui.gadgets.buttons.private
|
||||||
ui.gadgets.labels ui.gadgets.menus ui.gadgets.worlds
|
ui.gadgets.labels ui.gadgets.menus ui.gadgets.worlds
|
||||||
ui.gadgets.status-bar ui.commands ui.operations ui.gestures ;
|
ui.gadgets.status-bar ui.commands ui.operations ui.gestures ;
|
||||||
|
|
|
@ -101,7 +101,7 @@ M: world layout*
|
||||||
[ call-next-method ]
|
[ call-next-method ]
|
||||||
[ dup layers>> [ as-big-as-possible ] with each ] bi ;
|
[ dup layers>> [ as-big-as-possible ] with each ] bi ;
|
||||||
|
|
||||||
M: world focusable-child* gadget-child ;
|
M: world focusable-child* children>> [ t ] [ first ] if-empty ;
|
||||||
|
|
||||||
M: world children-on nip children>> ;
|
M: world children-on nip children>> ;
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,7 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays definitions kernel ui.commands
|
USING: accessors arrays definitions kernel ui.commands
|
||||||
ui.gestures sequences strings math words generic namespaces
|
ui.gestures sequences strings math words generic namespaces
|
||||||
hashtables help.markup quotations assocs fry linked-assocs ;
|
hashtables quotations assocs fry linked-assocs ;
|
||||||
IN: ui.operations
|
IN: ui.operations
|
||||||
|
|
||||||
SYMBOL: +keyboard+
|
SYMBOL: +keyboard+
|
||||||
|
|
|
@ -8,7 +8,7 @@ ui.gadgets.buttons ui.gadgets.labels ui.gadgets.panes
|
||||||
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.tables
|
ui.gadgets.presentations ui.gadgets.viewports ui.gadgets.tables
|
||||||
ui.gadgets.tracks ui.gadgets.scrollers ui.gadgets.panes
|
ui.gadgets.tracks ui.gadgets.scrollers ui.gadgets.panes
|
||||||
ui.gadgets.borders ui.gadgets.status-bar ui.tools.traceback
|
ui.gadgets.borders ui.gadgets.status-bar ui.tools.traceback
|
||||||
ui.tools.inspector ui.tools.browser ;
|
ui.tools.inspector ui.tools.browser ui.debugger ;
|
||||||
IN: ui.tools.debugger
|
IN: ui.tools.debugger
|
||||||
|
|
||||||
TUPLE: debugger < track error restarts restart-hook restart-list continuation ;
|
TUPLE: debugger < track error restarts restart-hook restart-list continuation ;
|
||||||
|
@ -27,9 +27,6 @@ M: restart-renderer row-columns
|
||||||
t >>selection-required?
|
t >>selection-required?
|
||||||
t >>single-click? ; inline
|
t >>single-click? ; inline
|
||||||
|
|
||||||
: <error-pane> ( error -- pane )
|
|
||||||
<pane> [ [ print-error ] with-pane ] keep ; inline
|
|
||||||
|
|
||||||
: <error-display> ( debugger -- gadget )
|
: <error-display> ( debugger -- gadget )
|
||||||
[ <filled-pile> ] dip
|
[ <filled-pile> ] dip
|
||||||
[ error>> <error-pane> add-gadget ]
|
[ error>> <error-pane> add-gadget ]
|
||||||
|
@ -72,12 +69,6 @@ M: object error-in-debugger? drop f ;
|
||||||
[ rethrow ] [ error-continuation get debugger-window ] if
|
[ rethrow ] [ error-continuation get debugger-window ] if
|
||||||
] ui-error-hook set-global
|
] ui-error-hook set-global
|
||||||
|
|
||||||
M: world-error error.
|
|
||||||
"An error occurred while drawing the world " write
|
|
||||||
dup world>> pprint-short "." print
|
|
||||||
"This world has been deactivated to prevent cascading errors." print
|
|
||||||
error>> error. ;
|
|
||||||
|
|
||||||
debugger "gestures" f {
|
debugger "gestures" f {
|
||||||
{ T{ button-down } request-focus }
|
{ T{ button-down } request-focus }
|
||||||
} define-command-map
|
} define-command-map
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! Copyright (C) 2005, 2008 Slava Pestov.
|
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.syntax ;
|
USING: alien.syntax alien system ;
|
||||||
IN: unix
|
IN: unix
|
||||||
|
|
||||||
! Linux.
|
! Linux.
|
||||||
|
@ -93,13 +93,20 @@ C-STRUCT: passwd
|
||||||
{ "char*" "pw_dir" }
|
{ "char*" "pw_dir" }
|
||||||
{ "char*" "pw_shell" } ;
|
{ "char*" "pw_shell" } ;
|
||||||
|
|
||||||
|
! dirent64
|
||||||
C-STRUCT: dirent
|
C-STRUCT: dirent
|
||||||
{ "__ino_t" "d_ino" }
|
{ "ulonglong" "d_ino" }
|
||||||
{ "__off_t" "d_off" }
|
{ "longlong" "d_off" }
|
||||||
{ "ushort" "d_reclen" }
|
{ "ushort" "d_reclen" }
|
||||||
{ "uchar" "d_type" }
|
{ "uchar" "d_type" }
|
||||||
{ { "char" 256 } "d_name" } ;
|
{ { "char" 256 } "d_name" } ;
|
||||||
|
|
||||||
|
FUNCTION: int open64 ( char* path, int flags, int prot ) ;
|
||||||
|
FUNCTION: dirent64* readdir64 ( DIR* dirp ) ;
|
||||||
|
FUNCTION: int readdir64_r ( void* dirp, dirent* entry, dirent** result ) ;
|
||||||
|
|
||||||
|
M: linux open-file [ open64 ] unix-system-call ;
|
||||||
|
|
||||||
CONSTANT: EPERM 1
|
CONSTANT: EPERM 1
|
||||||
CONSTANT: ENOENT 2
|
CONSTANT: ENOENT 2
|
||||||
CONSTANT: ESRCH 3
|
CONSTANT: ESRCH 3
|
||||||
|
|
|
@ -1,29 +1,28 @@
|
||||||
USING: kernel alien.syntax math ;
|
USING: kernel alien.syntax math sequences unix
|
||||||
|
alien.c-types arrays accessors combinators ;
|
||||||
IN: unix.stat
|
IN: unix.stat
|
||||||
|
|
||||||
! Ubuntu 8.04 32-bit
|
! stat64
|
||||||
|
|
||||||
C-STRUCT: stat
|
C-STRUCT: stat
|
||||||
{ "dev_t" "st_dev" }
|
{ "dev_t" "st_dev" }
|
||||||
{ "ushort" "__pad1" }
|
{ "ushort" "__pad1" }
|
||||||
{ "ino_t" "st_ino" }
|
{ "__ino_t" "__st_ino" }
|
||||||
{ "mode_t" "st_mode" }
|
{ "mode_t" "st_mode" }
|
||||||
{ "nlink_t" "st_nlink" }
|
{ "nlink_t" "st_nlink" }
|
||||||
{ "uid_t" "st_uid" }
|
{ "uid_t" "st_uid" }
|
||||||
{ "gid_t" "st_gid" }
|
{ "gid_t" "st_gid" }
|
||||||
{ "dev_t" "st_rdev" }
|
{ "dev_t" "st_rdev" }
|
||||||
{ "ushort" "__pad2" }
|
{ { "ushort" 2 } "__pad2" }
|
||||||
{ "off_t" "st_size" }
|
{ "off64_t" "st_size" }
|
||||||
{ "blksize_t" "st_blksize" }
|
{ "blksize_t" "st_blksize" }
|
||||||
{ "blkcnt_t" "st_blocks" }
|
{ "blkcnt64_t" "st_blocks" }
|
||||||
{ "timespec" "st_atimespec" }
|
{ "timespec" "st_atimespec" }
|
||||||
{ "timespec" "st_mtimespec" }
|
{ "timespec" "st_mtimespec" }
|
||||||
{ "timespec" "st_ctimespec" }
|
{ "timespec" "st_ctimespec" }
|
||||||
{ "ulong" "unused4" }
|
{ "ulonglong" "st_ino" } ;
|
||||||
{ "ulong" "unused5" } ;
|
|
||||||
|
|
||||||
FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ;
|
FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ;
|
||||||
FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
|
FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ;
|
||||||
|
|
||||||
: stat ( pathname buf -- int ) [ 3 ] 2dip __xstat ;
|
: stat ( pathname buf -- int ) [ 1 ] 2dip __xstat64 ;
|
||||||
: lstat ( pathname buf -- int ) [ 3 ] 2dip __lxstat ;
|
: lstat ( pathname buf -- int ) [ 1 ] 2dip __lxstat64 ;
|
||||||
|
|
|
@ -2,29 +2,27 @@ USING: kernel alien.syntax math sequences unix
|
||||||
alien.c-types arrays accessors combinators ;
|
alien.c-types arrays accessors combinators ;
|
||||||
IN: unix.stat
|
IN: unix.stat
|
||||||
|
|
||||||
! Ubuntu 7.10 64-bit
|
! stat64
|
||||||
|
|
||||||
C-STRUCT: stat
|
C-STRUCT: stat
|
||||||
{ "dev_t" "st_dev" }
|
{ "dev_t" "st_dev" }
|
||||||
{ "ino_t" "st_ino" }
|
{ "ushort" "__pad1" }
|
||||||
{ "nlink_t" "st_nlink" }
|
{ "__ino_t" "__st_ino" }
|
||||||
{ "mode_t" "st_mode" }
|
{ "mode_t" "st_mode" }
|
||||||
{ "uid_t" "st_uid" }
|
{ "nlink_t" "st_nlink" }
|
||||||
{ "gid_t" "st_gid" }
|
{ "uid_t" "st_uid" }
|
||||||
{ "int" "pad0" }
|
{ "gid_t" "st_gid" }
|
||||||
{ "dev_t" "st_rdev" }
|
{ "dev_t" "st_rdev" }
|
||||||
{ "off_t" "st_size" }
|
{ { "ushort" 2 } "__pad2" }
|
||||||
{ "blksize_t" "st_blksize" }
|
{ "off64_t" "st_size" }
|
||||||
{ "blkcnt_t" "st_blocks" }
|
{ "blksize_t" "st_blksize" }
|
||||||
{ "timespec" "st_atimespec" }
|
{ "blkcnt64_t" "st_blocks" }
|
||||||
{ "timespec" "st_mtimespec" }
|
{ "timespec" "st_atimespec" }
|
||||||
{ "timespec" "st_ctimespec" }
|
{ "timespec" "st_mtimespec" }
|
||||||
{ "long" "__unused0" }
|
{ "timespec" "st_ctimespec" }
|
||||||
{ "long" "__unused1" }
|
{ "ulonglong" "st_ino" } ;
|
||||||
{ "long" "__unused2" } ;
|
|
||||||
|
|
||||||
FUNCTION: int __xstat ( int ver, char* pathname, stat* buf ) ;
|
FUNCTION: int __xstat64 ( int ver, char* pathname, stat* buf ) ;
|
||||||
FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
|
FUNCTION: int __lxstat64 ( int ver, char* pathname, stat* buf ) ;
|
||||||
|
|
||||||
: stat ( pathname buf -- int ) [ 1 ] 2dip __xstat ;
|
: stat ( pathname buf -- int ) [ 1 ] 2dip __xstat64 ;
|
||||||
: lstat ( pathname buf -- int ) [ 1 ] 2dip __lxstat ;
|
: lstat ( pathname buf -- int ) [ 1 ] 2dip __lxstat64 ;
|
||||||
|
|
|
@ -23,7 +23,11 @@ TYPEDEF: __slongword_type blkcnt_t
|
||||||
TYPEDEF: __sword_type ssize_t
|
TYPEDEF: __sword_type ssize_t
|
||||||
TYPEDEF: __s32_type pid_t
|
TYPEDEF: __s32_type pid_t
|
||||||
TYPEDEF: __slongword_type time_t
|
TYPEDEF: __slongword_type time_t
|
||||||
|
TYPEDEF: __slongword_type __time_t
|
||||||
|
|
||||||
TYPEDEF: ssize_t __SWORD_TYPE
|
TYPEDEF: ssize_t __SWORD_TYPE
|
||||||
|
TYPEDEF: ulonglong blkcnt64_t
|
||||||
TYPEDEF: ulonglong __fsblkcnt64_t
|
TYPEDEF: ulonglong __fsblkcnt64_t
|
||||||
TYPEDEF: ulonglong __fsfilcnt64_t
|
TYPEDEF: ulonglong __fsfilcnt64_t
|
||||||
|
TYPEDEF: ulonglong ino64_t
|
||||||
|
TYPEDEF: ulonglong off64_t
|
||||||
|
|
|
@ -140,9 +140,11 @@ FUNCTION: int shutdown ( int fd, int how ) ;
|
||||||
|
|
||||||
FUNCTION: int open ( char* path, int flags, int prot ) ;
|
FUNCTION: int open ( char* path, int flags, int prot ) ;
|
||||||
|
|
||||||
FUNCTION: DIR* opendir ( char* path ) ;
|
HOOK: open-file os ( path flags mode -- fd )
|
||||||
|
|
||||||
: open-file ( path flags mode -- fd ) [ open ] unix-system-call ;
|
M: unix open-file [ open ] unix-system-call ;
|
||||||
|
|
||||||
|
FUNCTION: DIR* opendir ( char* path ) ;
|
||||||
|
|
||||||
C-STRUCT: utimbuf
|
C-STRUCT: utimbuf
|
||||||
{ "time_t" "actime" }
|
{ "time_t" "actime" }
|
||||||
|
@ -165,7 +167,6 @@ FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ;
|
||||||
|
|
||||||
FUNCTION: dirent* readdir ( DIR* dirp ) ;
|
FUNCTION: dirent* readdir ( DIR* dirp ) ;
|
||||||
FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ;
|
FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ;
|
||||||
|
|
||||||
FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
|
FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
|
||||||
|
|
||||||
CONSTANT: PATH_MAX 1024
|
CONSTANT: PATH_MAX 1024
|
||||||
|
|
|
@ -2,7 +2,7 @@ USING: windows.dinput windows.kernel32 windows.ole32 windows.com
|
||||||
windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
|
windows.com.syntax alien alien.c-types alien.syntax kernel system namespaces
|
||||||
combinators sequences fry math accessors macros words quotations
|
combinators sequences fry math accessors macros words quotations
|
||||||
libc continuations generalizations splitting locals assocs init
|
libc continuations generalizations splitting locals assocs init
|
||||||
struct-arrays ;
|
struct-arrays memoize ;
|
||||||
IN: windows.dinput.constants
|
IN: windows.dinput.constants
|
||||||
|
|
||||||
! Some global variables aren't provided by the DirectInput DLL (they're in the
|
! Some global variables aren't provided by the DirectInput DLL (they're in the
|
||||||
|
@ -18,12 +18,15 @@ SYMBOLS:
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
|
MEMO: c-type* ( name -- c-type ) c-type ;
|
||||||
|
MEMO: heap-size* ( c-type -- n ) heap-size ;
|
||||||
|
|
||||||
: (field-spec-of) ( field struct -- field-spec )
|
: (field-spec-of) ( field struct -- field-spec )
|
||||||
c-type fields>> [ name>> = ] with find nip ;
|
c-type* fields>> [ name>> = ] with find nip ;
|
||||||
: (offsetof) ( field struct -- offset )
|
: (offsetof) ( field struct -- offset )
|
||||||
[ (field-spec-of) offset>> ] [ drop 0 ] if* ;
|
[ (field-spec-of) offset>> ] [ drop 0 ] if* ;
|
||||||
: (sizeof) ( field struct -- size )
|
: (sizeof) ( field struct -- size )
|
||||||
[ (field-spec-of) type>> "[" split1 drop heap-size ] [ drop 1 ] if* ;
|
[ (field-spec-of) type>> "[" split1 drop heap-size* ] [ drop 1 ] if* ;
|
||||||
|
|
||||||
: (flag) ( thing -- integer )
|
: (flag) ( thing -- integer )
|
||||||
{
|
{
|
||||||
|
@ -79,6 +82,9 @@ SYMBOLS:
|
||||||
[ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi
|
[ nip length ] [ malloc-DIOBJECTDATAFORMAT-array ] 2bi
|
||||||
"DIDATAFORMAT" <c-object> (DIDATAFORMAT) ;
|
"DIDATAFORMAT" <c-object> (DIDATAFORMAT) ;
|
||||||
|
|
||||||
|
: initialize ( symbol quot -- )
|
||||||
|
call swap set-global ; inline
|
||||||
|
|
||||||
: (malloc-guid-symbol) ( symbol guid -- )
|
: (malloc-guid-symbol) ( symbol guid -- )
|
||||||
'[
|
'[
|
||||||
_ execute( -- value )
|
_ execute( -- value )
|
||||||
|
|
|
@ -1,11 +1,7 @@
|
||||||
IN: game-input.tests
|
IN: game-input.tests
|
||||||
USING: ui game-input tools.test kernel system threads
|
USING: ui game-input tools.test kernel system threads calendar ;
|
||||||
combinators.short-circuit calendar ;
|
|
||||||
|
|
||||||
{
|
os windows? os macosx? or [
|
||||||
[ os windows? ui-running? and ]
|
|
||||||
[ os macosx? ]
|
|
||||||
} 0|| [
|
|
||||||
[ ] [ open-game-input ] unit-test
|
[ ] [ open-game-input ] unit-test
|
||||||
[ ] [ 1 seconds sleep ] unit-test
|
[ ] [ 1 seconds sleep ] unit-test
|
||||||
[ ] [ close-game-input ] unit-test
|
[ ] [ close-game-input ] unit-test
|
||||||
|
|
|
@ -21,5 +21,3 @@ M: game-world end-world
|
||||||
[ [ stop-loop ] when* f ] change-game-loop
|
[ [ stop-loop ] when* f ] change-game-loop
|
||||||
drop ;
|
drop ;
|
||||||
|
|
||||||
M: game-world focusable-child* drop t ;
|
|
||||||
|
|
||||||
|
|
|
@ -36,9 +36,6 @@ M: demo-world distance-step ( gadget -- dz )
|
||||||
: zoom-demo-world ( distance gadget -- )
|
: zoom-demo-world ( distance gadget -- )
|
||||||
[ + ] with change-distance relayout-1 ;
|
[ + ] with change-distance relayout-1 ;
|
||||||
|
|
||||||
M: demo-world focusable-child* ( world -- gadget )
|
|
||||||
drop t ;
|
|
||||||
|
|
||||||
M: demo-world pref-dim* ( gadget -- dim )
|
M: demo-world pref-dim* ( gadget -- dim )
|
||||||
drop { 640 480 } ;
|
drop { 640 480 } ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue