Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-05-11 22:05:23 -05:00
commit 2f1ffc5d35
24 changed files with 173 additions and 97 deletions

View File

@ -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 ;

View File

@ -0,0 +1 @@
unportable

View File

@ -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

View File

@ -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 )

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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 }
}

View File

@ -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 ;

View File

@ -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. ;

2
basis/ui/gadgets/presentations/presentations.factor Normal file → Executable file
View File

@ -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 ;

View File

@ -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
basis/ui/operations/operations.factor Normal file → Executable file
View File

@ -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+

11
basis/ui/tools/debugger/debugger.factor Normal file → Executable file
View File

@ -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

View File

@ -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

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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

View File

@ -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

View File

@ -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 )

View File

@ -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

View File

@ -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 ;

View File

@ -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 } ;