commit
1cfd19f3c8
|
@ -132,8 +132,8 @@ FUNCTION: int ffi_test_10 int a int b double c int d float e int f int g int h ;
|
|||
[ -34 ] [ 1 2 3.0 4 5.0 6 7 8 ffi_test_10 ] unit-test
|
||||
|
||||
FUNCTION: void ffi_test_20 double x1, double x2, double x3,
|
||||
double y1, double y2, double y3,
|
||||
double z1, double z2, double z3 ;
|
||||
double y1, double y2, double y3,
|
||||
double z1, double z2, double z3 ;
|
||||
|
||||
[ ] [ 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 ffi_test_20 ] unit-test
|
||||
|
||||
|
|
|
@ -54,6 +54,8 @@ M: pair (bitfield-quot) ( spec -- quot )
|
|||
|
||||
\ bitfield [ bitfield-quot ] 1 define-transform
|
||||
|
||||
\ flags [ flags [ ] curry ] 1 define-transform
|
||||
|
||||
! Tuple operations
|
||||
: [get-slots] ( slots -- quot )
|
||||
[ [ 1quotation , \ keep , ] each \ drop , ] [ ] make ;
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2007 Slava Pestov.
|
||||
! Copyright (C) 2007, 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math sequences words ;
|
||||
IN: math.bitfields
|
||||
|
@ -13,3 +13,6 @@ M: pair (bitfield) ( value accum pair -- newaccum )
|
|||
|
||||
: bitfield ( values... bitspec -- n )
|
||||
0 [ (bitfield) ] reduce ;
|
||||
|
||||
: flags ( values -- n )
|
||||
0 [ dup word? [ execute ] when bitor ] reduce ;
|
||||
|
|
|
@ -21,9 +21,9 @@ IN: temporary
|
|||
[ "hello\\backslash" unparse ]
|
||||
unit-test
|
||||
|
||||
[ "\"\\u123456\"" ]
|
||||
[ "\u123456" unparse ]
|
||||
unit-test
|
||||
! [ "\"\\u123456\"" ]
|
||||
! [ "\u123456" unparse ]
|
||||
! unit-test
|
||||
|
||||
[ "\"\\e\"" ]
|
||||
[ "\e" unparse ]
|
||||
|
|
|
@ -88,8 +88,6 @@ unit-test
|
|||
|
||||
! Make sure aux vector is not shared
|
||||
[ "\udeadbe" ] [
|
||||
"\udeadbe" clone
|
||||
CHAR: \u123456 over clone set-first
|
||||
"\udeadbe" clone
|
||||
CHAR: \u123456 over clone set-first
|
||||
] unit-test
|
||||
|
||||
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2006, 2007 Slava Pestov
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel math cocoa cocoa.messages cocoa.classes
|
||||
sequences ;
|
||||
sequences math.bitfields ;
|
||||
IN: cocoa.windows
|
||||
|
||||
: NSBorderlessWindowMask 0 ; inline
|
||||
|
@ -15,10 +15,12 @@ IN: cocoa.windows
|
|||
: NSBackingStoreBuffered 2 ; inline
|
||||
|
||||
: standard-window-type
|
||||
NSTitledWindowMask
|
||||
NSClosableWindowMask bitor
|
||||
NSMiniaturizableWindowMask bitor
|
||||
NSResizableWindowMask bitor ; inline
|
||||
{
|
||||
NSTitledWindowMask
|
||||
NSClosableWindowMask
|
||||
NSMiniaturizableWindowMask
|
||||
NSResizableWindowMask
|
||||
} flags ; inline
|
||||
|
||||
: <NSWindow> ( rect -- window )
|
||||
NSWindow -> alloc swap
|
||||
|
|
|
@ -14,7 +14,7 @@ TUPLE: buffer size ptr fill pos ;
|
|||
dup buffer-ptr free f swap set-buffer-ptr ;
|
||||
|
||||
: buffer-reset ( n buffer -- )
|
||||
[ set-buffer-fill ] keep 0 swap set-buffer-pos ;
|
||||
0 swap { set-buffer-fill set-buffer-pos } set-slots ;
|
||||
|
||||
: buffer-consume ( n buffer -- )
|
||||
[ buffer-pos + ] keep
|
||||
|
|
|
@ -1,11 +1,39 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.backend kernel continuations ;
|
||||
USING: io.backend kernel continuations namespaces sequences
|
||||
assocs hashtables sorting arrays ;
|
||||
IN: io.monitor
|
||||
|
||||
<PRIVATE
|
||||
|
||||
TUPLE: monitor queue closed? ;
|
||||
|
||||
: check-monitor ( monitor -- )
|
||||
monitor-closed? [ "Monitor closed" throw ] when ;
|
||||
|
||||
: (monitor) ( delegate -- monitor )
|
||||
H{ } clone {
|
||||
set-delegate
|
||||
set-monitor-queue
|
||||
} monitor construct ;
|
||||
|
||||
HOOK: fill-queue io-backend ( monitor -- assoc )
|
||||
|
||||
: changed-file ( changed path -- )
|
||||
namespace [ append ] change-at ;
|
||||
|
||||
: dequeue-change ( assoc -- path changes )
|
||||
delete-any prune natural-sort >array ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
HOOK: <monitor> io-backend ( path recursive? -- monitor )
|
||||
|
||||
HOOK: next-change io-backend ( monitor -- path changes )
|
||||
: next-change ( monitor -- path changed )
|
||||
dup check-monitor
|
||||
dup monitor-queue dup assoc-empty? [
|
||||
drop dup fill-queue over set-monitor-queue next-change
|
||||
] [ nip dequeue-change ] if ;
|
||||
|
||||
SYMBOL: +add-file+
|
||||
SYMBOL: +remove-file+
|
||||
|
|
|
@ -14,9 +14,9 @@ TUPLE: io-task port callbacks ;
|
|||
|
||||
: io-task-fd io-task-port port-handle ;
|
||||
|
||||
: <io-task> ( port continuation class -- task )
|
||||
>r 1vector io-task construct-boa r> construct-delegate ;
|
||||
inline
|
||||
: <io-task> ( port continuation/f class -- task )
|
||||
>r [ 1vector ] [ V{ } clone ] if* io-task construct-boa
|
||||
r> construct-delegate ; inline
|
||||
|
||||
TUPLE: input-task ;
|
||||
|
||||
|
@ -194,7 +194,7 @@ TUPLE: mx-port mx ;
|
|||
TUPLE: mx-task ;
|
||||
|
||||
: <mx-task> ( port -- task )
|
||||
f io-task construct-boa mx-task construct-delegate ;
|
||||
f mx-task <io-task> ;
|
||||
|
||||
M: mx-task do-io-task
|
||||
io-task-port mx-port-mx 0 swap wait-for-events f ;
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2007 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io.backend io.nonblocking io.unix.backend io.files io
|
||||
unix kernel math continuations ;
|
||||
unix kernel math continuations math.bitfields ;
|
||||
IN: io.unix.files
|
||||
|
||||
: read-flags O_RDONLY ; inline
|
||||
|
@ -12,7 +12,7 @@ IN: io.unix.files
|
|||
M: unix-io <file-reader> ( path -- stream )
|
||||
open-read <reader> ;
|
||||
|
||||
: write-flags O_WRONLY O_CREAT O_TRUNC bitor bitor ; inline
|
||||
: write-flags { O_WRONLY O_CREAT O_TRUNC } flags ; inline
|
||||
|
||||
: open-write ( path -- fd )
|
||||
write-flags file-mode open dup io-error ;
|
||||
|
@ -20,7 +20,7 @@ M: unix-io <file-reader> ( path -- stream )
|
|||
M: unix-io <file-writer> ( path -- stream )
|
||||
open-write <writer> ;
|
||||
|
||||
: append-flags O_WRONLY O_APPEND O_CREAT bitor bitor ; inline
|
||||
: append-flags { O_WRONLY O_APPEND O_CREAT } flags ; inline
|
||||
|
||||
: open-append ( path -- fd )
|
||||
append-flags file-mode open dup io-error
|
||||
|
|
|
@ -1,15 +1,136 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: kernel io.backend io.monitor io.monitor.private io.files
|
||||
io.buffers io.nonblocking io.unix.backend io.unix.select
|
||||
io.unix.launcher unix.linux.inotify assocs namespaces threads
|
||||
continuations init math alien.c-types alien ;
|
||||
IN: io.unix.linux
|
||||
USING: io.backend io.unix.backend io.unix.launcher io.unix.select
|
||||
namespaces kernel assocs unix.process init ;
|
||||
|
||||
TUPLE: linux-io ;
|
||||
|
||||
INSTANCE: linux-io unix-io
|
||||
|
||||
TUPLE: linux-monitor path wd callback ;
|
||||
|
||||
: <linux-monitor> ( path wd -- monitor )
|
||||
f (monitor) {
|
||||
set-linux-monitor-path
|
||||
set-linux-monitor-wd
|
||||
set-delegate
|
||||
} linux-monitor construct ;
|
||||
|
||||
TUPLE: inotify watches ;
|
||||
|
||||
: wd>path ( wd -- path )
|
||||
inotify get-global inotify-watches at linux-monitor-path ;
|
||||
|
||||
: <inotify> ( -- port )
|
||||
H{ } clone
|
||||
inotify_init dup io-error inotify <buffered-port>
|
||||
{ set-inotify-watches set-delegate } inotify construct ;
|
||||
|
||||
: inotify-fd inotify get-global port-handle ;
|
||||
|
||||
: watches inotify get-global inotify-watches ;
|
||||
|
||||
: (add-watch) ( path mask -- wd )
|
||||
inotify-fd -rot inotify_add_watch dup io-error ;
|
||||
|
||||
: check-existing ( wd -- )
|
||||
watches key? [
|
||||
"Cannot open multiple monitors for the same file" throw
|
||||
] when ;
|
||||
|
||||
: add-watch ( path mask -- monitor )
|
||||
dupd (add-watch)
|
||||
dup check-existing
|
||||
[ <linux-monitor> dup ] keep watches set-at ;
|
||||
|
||||
: remove-watch ( monitor -- )
|
||||
dup linux-monitor-wd watches delete-at
|
||||
linux-monitor-wd inotify-fd swap inotify_rm_watch io-error ;
|
||||
|
||||
M: linux-io <monitor> ( path recursive? -- monitor )
|
||||
drop IN_CHANGE_EVENTS add-watch ;
|
||||
|
||||
: notify-callback ( assoc monitor -- )
|
||||
linux-monitor-callback dup
|
||||
[ schedule-thread-with ] [ 2drop ] if ;
|
||||
|
||||
M: linux-io fill-queue ( monitor -- assoc )
|
||||
dup linux-monitor-callback [
|
||||
"Cannot wait for changes on the same file from multiple threads" throw
|
||||
] when
|
||||
[ swap set-linux-monitor-callback stop ] callcc1
|
||||
swap check-monitor ;
|
||||
|
||||
M: linux-monitor dispose ( monitor -- )
|
||||
dup check-monitor
|
||||
t over set-monitor-closed?
|
||||
H{ } over notify-callback
|
||||
remove-watch ;
|
||||
|
||||
: ?flag ( n mask symbol -- n )
|
||||
pick rot bitand 0 > [ , ] [ drop ] if ;
|
||||
|
||||
: parse-action ( mask -- changed )
|
||||
[
|
||||
IN_CREATE +add-file+ ?flag
|
||||
IN_DELETE +remove-file+ ?flag
|
||||
IN_DELETE_SELF +remove-file+ ?flag
|
||||
IN_MODIFY +modify-file+ ?flag
|
||||
IN_ATTRIB +modify-file+ ?flag
|
||||
IN_MOVED_FROM +rename-file+ ?flag
|
||||
IN_MOVED_TO +rename-file+ ?flag
|
||||
IN_MOVE_SELF +rename-file+ ?flag
|
||||
drop
|
||||
] { } make ;
|
||||
|
||||
: parse-file-notify ( buffer -- changed path )
|
||||
{
|
||||
inotify-event-wd
|
||||
inotify-event-name
|
||||
inotify-event-mask
|
||||
} get-slots
|
||||
parse-action -rot alien>char-string >r wd>path r> path+ ;
|
||||
|
||||
: events-exhausted? ( i buffer -- ? )
|
||||
buffer-fill >= ;
|
||||
|
||||
: inotify-event@ ( i buffer -- alien )
|
||||
buffer-ptr <displaced-alien> ;
|
||||
|
||||
: next-event ( i buffer -- i buffer )
|
||||
2dup inotify-event@
|
||||
inotify-event-len "inotify-event" heap-size +
|
||||
swap >r + r> ;
|
||||
|
||||
: parse-file-notifications ( i buffer -- )
|
||||
2dup events-exhausted? [ 2drop ] [
|
||||
2dup inotify-event@ parse-file-notify changed-file
|
||||
next-event parse-file-notifications
|
||||
] if ;
|
||||
|
||||
: read-notifications ( port -- )
|
||||
dup refill drop
|
||||
0 over parse-file-notifications
|
||||
0 swap buffer-reset ;
|
||||
|
||||
TUPLE: inotify-task ;
|
||||
|
||||
: <inotify-task> ( port -- task )
|
||||
f inotify-task <input-task> ;
|
||||
|
||||
: init-inotify ( mx -- )
|
||||
<inotify>
|
||||
dup inotify set-global
|
||||
<inotify-task> swap register-io-task ;
|
||||
|
||||
M: inotify-task do-io-task ( task -- )
|
||||
io-task-port read-notifications f ;
|
||||
|
||||
M: linux-io init-io ( -- )
|
||||
<select-mx> mx set-global ;
|
||||
<select-mx> mx set-global ; ! init-inotify ;
|
||||
|
||||
T{ linux-io } set-io-backend
|
||||
|
||||
|
|
|
@ -3,12 +3,10 @@
|
|||
USING: alien.c-types destructors io.windows
|
||||
io.windows.nt.backend kernel math windows windows.kernel32
|
||||
windows.types libc assocs alien namespaces continuations
|
||||
io.monitor io.nonblocking io.buffers io.files io sequences
|
||||
hashtables sorting arrays combinators ;
|
||||
io.monitor io.monitor.private io.nonblocking io.buffers io.files
|
||||
io sequences hashtables sorting arrays combinators ;
|
||||
IN: io.windows.nt.monitor
|
||||
|
||||
TUPLE: monitor path recursive? queue closed? ;
|
||||
|
||||
: open-directory ( path -- handle )
|
||||
FILE_LIST_DIRECTORY
|
||||
share-mode
|
||||
|
@ -22,23 +20,26 @@ TUPLE: monitor path recursive? queue closed? ;
|
|||
dup add-completion
|
||||
f <win32-file> ;
|
||||
|
||||
TUPLE: win32-monitor path recursive? ;
|
||||
|
||||
: <win32-monitor> ( path recursive? port -- monitor )
|
||||
(monitor) {
|
||||
set-win32-monitor-path
|
||||
set-win32-monitor-recursive?
|
||||
set-delegate
|
||||
} win32-monitor construct ;
|
||||
|
||||
M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
||||
[
|
||||
>r dup open-directory monitor <buffered-port> r> {
|
||||
set-monitor-path
|
||||
set-delegate
|
||||
set-monitor-recursive?
|
||||
} monitor construct
|
||||
over open-directory win32-monitor <buffered-port>
|
||||
<win32-monitor>
|
||||
] with-destructors ;
|
||||
|
||||
: check-closed ( monitor -- )
|
||||
port-type closed eq? [ "Monitor closed" throw ] when ;
|
||||
|
||||
: begin-reading-changes ( monitor -- overlapped )
|
||||
dup port-handle win32-file-handle
|
||||
over buffer-ptr
|
||||
pick buffer-size
|
||||
roll monitor-recursive? 1 0 ?
|
||||
roll win32-monitor-recursive? 1 0 ?
|
||||
FILE_NOTIFY_CHANGE_ALL
|
||||
0 <uint>
|
||||
(make-overlapped)
|
||||
|
@ -49,6 +50,7 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
|||
[
|
||||
dup begin-reading-changes
|
||||
swap [ save-callback ] 2keep
|
||||
dup check-monitor ! we may have closed it...
|
||||
get-overlapped-result
|
||||
] with-port-timeout
|
||||
] with-destructors ;
|
||||
|
@ -63,30 +65,19 @@ M: windows-nt-io <monitor> ( path recursive? -- monitor )
|
|||
{ [ t ] [ +modify-file+ ] }
|
||||
} cond nip ;
|
||||
|
||||
: changed-file ( directory buffer -- changed path )
|
||||
: parse-file-notify ( directory buffer -- changed path )
|
||||
{
|
||||
FILE_NOTIFY_INFORMATION-FileName
|
||||
FILE_NOTIFY_INFORMATION-FileNameLength
|
||||
FILE_NOTIFY_INFORMATION-Action
|
||||
} get-slots >r memory>u16-string path+ r> parse-action swap ;
|
||||
} get-slots parse-action 1array -rot
|
||||
memory>u16-string path+ ;
|
||||
|
||||
: (changed-files) ( directory buffer -- )
|
||||
2dup changed-file namespace [ swap add ] change-at
|
||||
2dup parse-file-notify changed-file
|
||||
dup FILE_NOTIFY_INFORMATION-NextEntryOffset dup zero?
|
||||
[ 3drop ] [ swap <displaced-alien> (changed-files) ] if ;
|
||||
|
||||
: changed-files ( directory buffer len -- assoc )
|
||||
M: windows-nt-io fill-queue ( monitor -- assoc )
|
||||
dup win32-monitor-path over buffer-ptr rot read-changes
|
||||
[ zero? [ 2drop ] [ (changed-files) ] if ] H{ } make-assoc ;
|
||||
|
||||
: fill-queue ( monitor -- )
|
||||
dup monitor-path over buffer-ptr pick read-changes
|
||||
changed-files
|
||||
swap set-monitor-queue ;
|
||||
|
||||
M: windows-nt-io next-change ( monitor -- path changes )
|
||||
dup check-closed
|
||||
dup monitor-queue dup assoc-empty? [
|
||||
drop dup fill-queue next-change
|
||||
] [
|
||||
nip delete-any prune natural-sort >array
|
||||
] if ;
|
||||
|
|
|
@ -5,7 +5,7 @@ io.buffers io.files io.nonblocking io.sockets io.binary
|
|||
io.sockets.impl windows.errors strings io.streams.duplex kernel
|
||||
math namespaces sequences windows windows.kernel32
|
||||
windows.shell32 windows.types windows.winsock splitting
|
||||
continuations ;
|
||||
continuations math.bitfields ;
|
||||
IN: io.windows
|
||||
|
||||
TUPLE: windows-nt-io ;
|
||||
|
@ -31,8 +31,11 @@ M: windows-io normalize-directory ( string -- string )
|
|||
"\\" ?tail drop "\\*" append ;
|
||||
|
||||
: share-mode ( -- fixnum )
|
||||
FILE_SHARE_READ FILE_SHARE_WRITE bitor
|
||||
FILE_SHARE_DELETE bitor ; foldable
|
||||
{
|
||||
FILE_SHARE_READ
|
||||
FILE_SHARE_WRITE
|
||||
FILE_SHARE_DELETE
|
||||
} flags ; foldable
|
||||
|
||||
: default-security-attributes ( -- obj )
|
||||
"SECURITY_ATTRIBUTES" <c-object>
|
||||
|
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
|
@ -1,38 +0,0 @@
|
|||
|
||||
USING: kernel quotations arrays sequences sequences.private macros ;
|
||||
|
||||
IN: macros.zoo
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! MACRO: narray ( n -- quot )
|
||||
! dup [ f <array> ] curry
|
||||
! swap <reversed> [
|
||||
! [ swap [ set-nth-unsafe ] keep ] curry
|
||||
! ] map concat append ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! MACRO: map-call-with ( quots -- )
|
||||
! [ [ [ keep ] curry ] map concat ] keep length [ nip narray ] curry compose ;
|
||||
|
||||
! MACRO: map-call-with2 ( quots -- )
|
||||
! dup >r
|
||||
! [ [ 2dup >r >r ] swap append [ r> r> ] append ] map concat
|
||||
! [ 2drop ] append
|
||||
! r> length [ narray ] curry append ;
|
||||
|
||||
! MACRO: map-exec-with ( words -- ) [ 1quotation ] map [ map-call-with ] curry ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
! Conceptual implementation:
|
||||
|
||||
! : pcall ( seq quots -- seq ) [ call ] 2map ;
|
||||
|
||||
! MACRO: pcall ( quots -- )
|
||||
! [ [ unclip ] swap append ] map
|
||||
! [ [ r> swap add >r ] append ] map
|
||||
! concat
|
||||
! [ { } >r ] swap append ! pre
|
||||
! [ drop r> ] append ; ! post
|
|
@ -1,11 +1,11 @@
|
|||
! Copyright (C) 2005, 2007 Slava Pestov.
|
||||
! Copyright (C) 2005, 2008 Slava Pestov.
|
||||
! Portions copyright (C) 2007 Eduardo Cavazos.
|
||||
! Portions copyright (C) 2008 Joe Groff.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types continuations kernel libc math macros
|
||||
namespaces math.vectors math.constants math.functions
|
||||
math.parser opengl.gl opengl.glu combinators arrays sequences
|
||||
splitting words byte-arrays ;
|
||||
splitting words byte-arrays assocs ;
|
||||
IN: opengl
|
||||
|
||||
: coordinates [ first2 ] 2apply ;
|
||||
|
@ -233,7 +233,8 @@ TUPLE: sprite loc dim dim2 dlist texture ;
|
|||
dup sprite-dlist delete-dlist
|
||||
sprite-texture delete-texture ;
|
||||
|
||||
: free-sprites ( sprites -- ) [ [ free-sprite ] when* ] each ;
|
||||
: free-sprites ( sprites -- )
|
||||
[ nip [ free-sprite ] when* ] assoc-each ;
|
||||
|
||||
: with-translation ( loc quot -- )
|
||||
GL_MODELVIEW [ >r gl-translate r> call ] do-matrix ; inline
|
||||
|
|
|
@ -1 +0,0 @@
|
|||
Eduardo Cavazos
|
|
@ -1,6 +0,0 @@
|
|||
USING: math arrays sequences kernel splitting strings ;
|
||||
IN: strings.lib
|
||||
|
||||
! : char>digit ( c -- i ) 48 - ;
|
||||
|
||||
! : string>digits ( s -- seq ) [ char>digit ] { } map-as ;
|
|
@ -1 +0,0 @@
|
|||
collections
|
|
@ -36,13 +36,13 @@ M: font hashcode* drop font hashcode* ;
|
|||
|
||||
: close-freetype ( -- )
|
||||
global [
|
||||
open-fonts [ values [ close-font ] each f ] change
|
||||
open-fonts [ [ drop close-font ] assoc-each f ] change
|
||||
freetype [ FT_Done_FreeType f ] change
|
||||
] bind ;
|
||||
|
||||
M: freetype-renderer free-fonts ( world -- )
|
||||
dup world-handle select-gl-context
|
||||
world-fonts values [ second free-sprites ] each ;
|
||||
world-fonts [ nip second free-sprites ] assoc-each ;
|
||||
|
||||
: ttf-name ( font style -- name )
|
||||
2array H{
|
||||
|
@ -100,7 +100,7 @@ SYMBOL: dpi
|
|||
swap set-font-height ;
|
||||
|
||||
: <font> ( handle -- font )
|
||||
V{ } clone
|
||||
H{ } clone
|
||||
{ set-font-handle set-font-widths } font construct
|
||||
dup init-font ;
|
||||
|
||||
|
@ -119,7 +119,7 @@ M: freetype-renderer open-font ( font -- open-font )
|
|||
: char-width ( open-font char -- w )
|
||||
over font-widths [
|
||||
dupd load-glyph glyph-hori-advance ft-ceil
|
||||
] cache-nth nip ;
|
||||
] cache nip ;
|
||||
|
||||
M: freetype-renderer string-width ( open-font string -- w )
|
||||
0 -rot [ char-width + ] with each ;
|
||||
|
@ -175,7 +175,7 @@ M: freetype-renderer string-height ( open-font string -- h )
|
|||
[ bitmap>texture ] keep [ init-sprite ] keep ;
|
||||
|
||||
: draw-char ( open-font char sprites -- )
|
||||
[ dupd <char-sprite> ] cache-nth nip
|
||||
[ dupd <char-sprite> ] cache nip
|
||||
sprite-dlist glCallList ;
|
||||
|
||||
: (draw-string) ( open-font sprites string loc -- )
|
||||
|
@ -186,7 +186,7 @@ M: freetype-renderer string-height ( open-font string -- h )
|
|||
] do-enabled ;
|
||||
|
||||
: font-sprites ( open-font world -- pair )
|
||||
world-fonts [ open-font V{ } clone 2array ] cache ;
|
||||
world-fonts [ open-font H{ } clone 2array ] cache ;
|
||||
|
||||
M: freetype-renderer draw-string ( font string loc -- )
|
||||
>r >r world get font-sprites first2 r> r> (draw-string) ;
|
||||
|
|
|
@ -6,7 +6,8 @@ math math.vectors namespaces prettyprint sequences strings
|
|||
vectors words windows.kernel32 windows.gdi32 windows.user32
|
||||
windows.opengl32 windows.messages windows.types
|
||||
windows.nt windows threads timers libc combinators continuations
|
||||
command-line shuffle opengl ui.render unicode.case ascii ;
|
||||
command-line shuffle opengl ui.render unicode.case ascii
|
||||
math.bitfields ;
|
||||
IN: ui.windows
|
||||
|
||||
TUPLE: windows-ui-backend ;
|
||||
|
@ -370,7 +371,7 @@ M: windows-ui-backend (close-window)
|
|||
class-name-ptr get-global
|
||||
pick GetClassInfoEx zero? [
|
||||
"WNDCLASSEX" heap-size over set-WNDCLASSEX-cbSize
|
||||
CS_HREDRAW CS_VREDRAW bitor CS_OWNDC bitor over set-WNDCLASSEX-style
|
||||
{ CS_HREDRAW CS_VREDRAW CS_OWNDC } flags over set-WNDCLASSEX-style
|
||||
ui-wndproc over set-WNDCLASSEX-lpfnWndProc
|
||||
0 over set-WNDCLASSEX-cbClsExtra
|
||||
0 over set-WNDCLASSEX-cbWndExtra
|
||||
|
@ -387,7 +388,7 @@ M: windows-ui-backend (close-window)
|
|||
make-adjusted-RECT
|
||||
>r class-name-ptr get-global f r>
|
||||
>r >r >r ex-style r> r>
|
||||
WS_CLIPSIBLINGS WS_CLIPCHILDREN bitor style bitor
|
||||
{ WS_CLIPSIBLINGS WS_CLIPCHILDREN style } flags
|
||||
CW_USEDEFAULT dup r>
|
||||
get-RECT-dimensions
|
||||
f f f GetModuleHandle f CreateWindowEx dup win32-error=0/f ;
|
||||
|
|
|
@ -58,10 +58,4 @@ IN: unix.linux.ifreq
|
|||
rot string>char-alien over set-struct-ifreq-ifr-ifrn
|
||||
swap <int> over set-struct-ifreq-ifr-ifru
|
||||
|
||||
AF_INET SOCK_DGRAM 0 socket SIOCSIFMETRIC rot ioctl drop ;
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
USING: words quotations sequences math macros ;
|
||||
|
||||
MACRO: flags ( seq -- ) 0 swap [ execute bitor ] each 1quotation ;
|
||||
AF_INET SOCK_DGRAM 0 socket SIOCSIFMETRIC rot ioctl drop ;
|
|
@ -0,0 +1,57 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien.syntax math math.bitfields ;
|
||||
IN: unix.linux.inotify
|
||||
|
||||
C-STRUCT: inotify-event
|
||||
{ "int" "wd" } ! watch descriptor
|
||||
{ "uint" "mask" } ! watch mask
|
||||
{ "uint" "cookie" } ! cookie to synchronize two events
|
||||
{ "uint" "len" } ! length (including nulls) of name
|
||||
{ "char[0]" "name" } ! stub for possible name
|
||||
;
|
||||
|
||||
: IN_ACCESS HEX: 1 ; inline ! File was accessed
|
||||
: IN_MODIFY HEX: 2 ; inline ! File was modified
|
||||
: IN_ATTRIB HEX: 4 ; inline ! Metadata changed
|
||||
: IN_CLOSE_WRITE HEX: 8 ; inline ! Writtable file was closed
|
||||
: IN_CLOSE_NOWRITE HEX: 10 ; inline ! Unwrittable file closed
|
||||
: IN_OPEN HEX: 20 ; inline ! File was opened
|
||||
: IN_MOVED_FROM HEX: 40 ; inline ! File was moved from X
|
||||
: IN_MOVED_TO HEX: 80 ; inline ! File was moved to Y
|
||||
: IN_CREATE HEX: 100 ; inline ! Subfile was created
|
||||
: IN_DELETE HEX: 200 ; inline ! Subfile was deleted
|
||||
: IN_DELETE_SELF HEX: 400 ; inline ! Self was deleted
|
||||
: IN_MOVE_SELF HEX: 800 ; inline ! Self was moved
|
||||
|
||||
: IN_UNMOUNT HEX: 2000 ; inline ! Backing fs was unmounted
|
||||
: IN_Q_OVERFLOW HEX: 4000 ; inline ! Event queued overflowed
|
||||
: IN_IGNORED HEX: 8000 ; inline ! File was ignored
|
||||
|
||||
: IN_CLOSE IN_CLOSE_WRITE IN_CLOSE_NOWRITE bitor ; inline ! close
|
||||
: IN_MOVE IN_MOVED_FROM IN_MOVED_TO bitor ; inline ! moves
|
||||
|
||||
: IN_ONLYDIR HEX: 1000000 ; inline ! only watch the path if it is a directory
|
||||
: IN_DONT_FOLLOW HEX: 2000000 ; inline ! don't follow a sym link
|
||||
: IN_MASK_ADD HEX: 20000000 ; inline ! add to the mask of an already existing watch
|
||||
: IN_ISDIR HEX: 40000000 ; inline ! event occurred against dir
|
||||
: IN_ONESHOT HEX: 80000000 ; inline ! only send event once
|
||||
|
||||
: IN_CHANGE_EVENTS
|
||||
{
|
||||
IN_MODIFY IN_ATTRIB IN_MOVED_FROM
|
||||
IN_MOVED_TO IN_DELETE IN_CREATE IN_DELETE_SELF
|
||||
IN_MOVE_SELF
|
||||
} flags ; foldable
|
||||
|
||||
: IN_ALL_EVENTS
|
||||
{
|
||||
IN_ACCESS IN_MODIFY IN_ATTRIB IN_CLOSE_WRITE
|
||||
IN_CLOSE_NOWRITE IN_OPEN IN_MOVED_FROM
|
||||
IN_MOVED_TO IN_DELETE IN_CREATE IN_DELETE_SELF
|
||||
IN_MOVE_SELF
|
||||
} flags ; foldable
|
||||
|
||||
FUNCTION: int inotify_init ( ) ;
|
||||
FUNCTION: int inotify_add_watch ( int fd, char* name, uint mask ) ;
|
||||
FUNCTION: int inotify_rm_watch ( int fd, uint wd ) ;
|
|
@ -1,4 +1,4 @@
|
|||
USING: alien.syntax kernel math windows.types ;
|
||||
USING: alien.syntax kernel math windows.types math.bitfields ;
|
||||
IN: windows.advapi32
|
||||
LIBRARY: advapi32
|
||||
|
||||
|
@ -483,20 +483,28 @@ FUNCTION: BOOL LookupPrivilegeValueW ( LPCTSTR lpSystemName,
|
|||
: TOKEN_QUERY_SOURCE HEX: 0010 ; inline
|
||||
: TOKEN_ADJUST_DEFAULT HEX: 0080 ; inline
|
||||
: TOKEN_READ STANDARD_RIGHTS_READ TOKEN_QUERY bitor ;
|
||||
: TOKEN_WRITE STANDARD_RIGHTS_WRITE
|
||||
TOKEN_ADJUST_PRIVILEGES bitor
|
||||
TOKEN_ADJUST_GROUPS bitor
|
||||
TOKEN_ADJUST_DEFAULT bitor ; foldable
|
||||
: TOKEN_ALL_ACCESS STANDARD_RIGHTS_REQUIRED
|
||||
TOKEN_ASSIGN_PRIMARY bitor
|
||||
TOKEN_DUPLICATE bitor
|
||||
TOKEN_IMPERSONATE bitor
|
||||
TOKEN_QUERY bitor
|
||||
TOKEN_QUERY_SOURCE bitor
|
||||
TOKEN_ADJUST_PRIVILEGES bitor
|
||||
TOKEN_ADJUST_GROUPS bitor
|
||||
TOKEN_ADJUST_SESSIONID bitor
|
||||
TOKEN_ADJUST_DEFAULT bitor ; foldable
|
||||
|
||||
: TOKEN_WRITE
|
||||
{
|
||||
STANDARD_RIGHTS_WRITE
|
||||
TOKEN_ADJUST_PRIVILEGES
|
||||
TOKEN_ADJUST_GROUPS
|
||||
TOKEN_ADJUST_DEFAULT
|
||||
} flags ; foldable
|
||||
|
||||
: TOKEN_ALL_ACCESS
|
||||
{
|
||||
STANDARD_RIGHTS_REQUIRED
|
||||
TOKEN_ASSIGN_PRIMARY
|
||||
TOKEN_DUPLICATE
|
||||
TOKEN_IMPERSONATE
|
||||
TOKEN_QUERY
|
||||
TOKEN_QUERY_SOURCE
|
||||
TOKEN_ADJUST_PRIVILEGES
|
||||
TOKEN_ADJUST_GROUPS
|
||||
TOKEN_ADJUST_SESSIONID
|
||||
TOKEN_ADJUST_DEFAULT
|
||||
} flags ; foldable
|
||||
|
||||
FUNCTION: BOOL OpenProcessToken ( HANDLE ProcessHandle,
|
||||
DWORD DesiredAccess,
|
||||
|
|
|
@ -1,7 +1,8 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.c-types alien.syntax parser namespaces kernel
|
||||
math windows.types windows.types init assocs sequences libc ;
|
||||
math math.bitfields windows.types windows.types init assocs
|
||||
sequences libc ;
|
||||
IN: windows.opengl32
|
||||
|
||||
! PIXELFORMATDESCRIPTOR flags
|
||||
|
@ -70,10 +71,8 @@ IN: windows.opengl32
|
|||
: WGL_SWAP_UNDERLAY14 HEX: 20000000 ; inline
|
||||
: WGL_SWAP_UNDERLAY15 HEX: 40000000 ; inline
|
||||
|
||||
|
||||
|
||||
: pfd-dwFlags
|
||||
PFD_DRAW_TO_WINDOW PFD_SUPPORT_OPENGL bitor PFD_DOUBLEBUFFER bitor ;
|
||||
{ PFD_DRAW_TO_WINDOW PFD_SUPPORT_OPENGL PFD_DOUBLEBUFFER } flags ;
|
||||
|
||||
! TODO: compare to http://www.nullterminator.net/opengl32.html
|
||||
: make-pfd ( bits -- pfd )
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2005, 2006 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: alien alien.syntax parser namespaces kernel math
|
||||
windows.types shuffle ;
|
||||
windows.types shuffle math.bitfields ;
|
||||
IN: windows.user32
|
||||
|
||||
! HKL for ActivateKeyboardLayout
|
||||
|
@ -32,9 +32,18 @@ IN: windows.user32
|
|||
: WS_MAXIMIZEBOX HEX: 00010000 ; inline
|
||||
|
||||
! Common window styles
|
||||
: WS_OVERLAPPEDWINDOW WS_OVERLAPPED WS_CAPTION WS_SYSMENU WS_THICKFRAME WS_MINIMIZEBOX WS_MAXIMIZEBOX bitor bitor bitor bitor bitor ; foldable inline
|
||||
: WS_OVERLAPPEDWINDOW
|
||||
{
|
||||
WS_OVERLAPPED
|
||||
WS_CAPTION
|
||||
WS_SYSMENU
|
||||
WS_THICKFRAME
|
||||
WS_MINIMIZEBOX
|
||||
WS_MAXIMIZEBOX
|
||||
} flags ; foldable
|
||||
|
||||
: WS_POPUPWINDOW WS_POPUP WS_BORDER WS_SYSMENU bitor bitor ; foldable inline
|
||||
: WS_POPUPWINDOW
|
||||
{ WS_POPUP WS_BORDER WS_SYSMENU } flags ; foldable
|
||||
|
||||
: WS_CHILDWINDOW WS_CHILD ; inline
|
||||
|
||||
|
@ -66,10 +75,9 @@ IN: windows.user32
|
|||
: WS_EX_STATICEDGE HEX: 00020000 ; inline
|
||||
: WS_EX_APPWINDOW HEX: 00040000 ; inline
|
||||
: WS_EX_OVERLAPPEDWINDOW ( -- n )
|
||||
WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; foldable inline
|
||||
WS_EX_WINDOWEDGE WS_EX_CLIENTEDGE bitor ; foldable
|
||||
: WS_EX_PALETTEWINDOW ( -- n )
|
||||
WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW bitor
|
||||
WS_EX_TOPMOST bitor ; foldable inline
|
||||
{ WS_EX_WINDOWEDGE WS_EX_TOOLWINDOW WS_EX_TOPMOST } flags ; foldable
|
||||
|
||||
: CS_VREDRAW HEX: 0001 ; inline
|
||||
: CS_HREDRAW HEX: 0002 ; inline
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2006 Mackenzie Straight, Doug Coleman.
|
||||
|
||||
USING: alien alien.c-types alien.syntax arrays byte-arrays kernel
|
||||
math sequences windows.types windows.kernel32 windows.errors structs
|
||||
windows ;
|
||||
USING: alien alien.c-types alien.syntax arrays byte-arrays
|
||||
kernel math sequences windows.types windows.kernel32
|
||||
windows.errors structs windows math.bitfields ;
|
||||
IN: windows.winsock
|
||||
|
||||
USE: libc
|
||||
|
@ -74,7 +74,7 @@ TYPEDEF: void* SOCKET
|
|||
: AI_PASSIVE 1 ; inline
|
||||
: AI_CANONNAME 2 ; inline
|
||||
: AI_NUMERICHOST 4 ; inline
|
||||
: AI_MASK AI_PASSIVE AI_CANONNAME bitor AI_NUMERICHOST bitor ;
|
||||
: AI_MASK { AI_PASSIVE AI_CANONNAME AI_NUMERICHOST } flags ;
|
||||
|
||||
: NI_NUMERICHOST 1 ;
|
||||
: NI_NUMERICSERV 2 ;
|
||||
|
|
|
@ -21,14 +21,16 @@ SYMBOL: <wm-frame>
|
|||
swap <wm-child> new* >>child
|
||||
<gc> new* "white" <-- set-foreground >>gc
|
||||
|
||||
SubstructureRedirectMask
|
||||
ExposureMask bitor
|
||||
ButtonPressMask bitor
|
||||
ButtonReleaseMask bitor
|
||||
ButtonMotionMask bitor
|
||||
EnterWindowMask bitor
|
||||
! experimental masks
|
||||
SubstructureNotifyMask bitor
|
||||
{
|
||||
SubstructureRedirectMask
|
||||
ExposureMask
|
||||
ButtonPressMask
|
||||
ButtonReleaseMask
|
||||
ButtonMotionMask
|
||||
EnterWindowMask
|
||||
! experimental masks
|
||||
SubstructureNotifyMask
|
||||
} flags
|
||||
>>mask
|
||||
|
||||
<- init-widget
|
||||
|
|
|
@ -5,14 +5,28 @@ namespaces sequences x11.xlib x11.constants x11.glx ;
|
|||
IN: x11.windows
|
||||
|
||||
: create-window-mask ( -- n )
|
||||
CWBackPixel CWBorderPixel bitor
|
||||
CWColormap bitor CWEventMask bitor ;
|
||||
{ CWBackPixel CWBorderPixel CWColormap CWEventMask } flags ;
|
||||
|
||||
: create-colormap ( visinfo -- colormap )
|
||||
dpy get root get rot XVisualInfo-visual AllocNone
|
||||
XCreateColormap ;
|
||||
|
||||
: event-mask ( -- n )
|
||||
<<<<<<< HEAD:extra/x11/windows/windows.factor
|
||||
{
|
||||
ExposureMask
|
||||
StructureNotifyMask
|
||||
KeyPressMask
|
||||
KeyReleaseMask
|
||||
ButtonPressMask
|
||||
ButtonReleaseMask
|
||||
PointerMotionMask
|
||||
FocusChangeMask
|
||||
EnterWindowMask
|
||||
LeaveWindowMask
|
||||
PropertyChangeMask
|
||||
} flags ;
|
||||
=======
|
||||
ExposureMask
|
||||
StructureNotifyMask bitor
|
||||
KeyPressMask bitor
|
||||
|
@ -24,6 +38,7 @@ IN: x11.windows
|
|||
EnterWindowMask bitor
|
||||
LeaveWindowMask bitor
|
||||
PropertyChangeMask bitor ;
|
||||
>>>>>>> a05c18152b59073c49aa313ba685516310ec74a8:extra/x11/windows/windows.factor
|
||||
|
||||
: window-attributes ( visinfo -- attributes )
|
||||
"XSetWindowAttributes" <c-object>
|
||||
|
|
|
@ -1078,18 +1078,18 @@ FUNCTION: Status XWithdrawWindow (
|
|||
|
||||
! 17.1.7 - Setting and Reading the WM_NORMAL_HINTS Property
|
||||
|
||||
: USPosition 1 0 shift ; inline
|
||||
: USSize 1 1 shift ; inline
|
||||
: PPosition 1 2 shift ; inline
|
||||
: PSize 1 3 shift ; inline
|
||||
: PMinSize 1 4 shift ; inline
|
||||
: PMaxSize 1 5 shift ; inline
|
||||
: PResizeInc 1 6 shift ; inline
|
||||
: PAspect 1 7 shift ; inline
|
||||
: PBaseSize 1 8 shift ; inline
|
||||
: PWinGravity 1 9 shift ; inline
|
||||
: PAllHints [ PPosition PSize PMinSize PMaxSize PResizeInc PAspect ]
|
||||
0 [ execute bitor ] reduce ; inline
|
||||
: USPosition 1 0 shift ; inline
|
||||
: USSize 1 1 shift ; inline
|
||||
: PPosition 1 2 shift ; inline
|
||||
: PSize 1 3 shift ; inline
|
||||
: PMinSize 1 4 shift ; inline
|
||||
: PMaxSize 1 5 shift ; inline
|
||||
: PResizeInc 1 6 shift ; inline
|
||||
: PAspect 1 7 shift ; inline
|
||||
: PBaseSize 1 8 shift ; inline
|
||||
: PWinGravity 1 9 shift ; inline
|
||||
: PAllHints
|
||||
{ PPosition PSize PMinSize PMaxSize PResizeInc PAspect } flags ; foldable
|
||||
|
||||
C-STRUCT: XSizeHints
|
||||
{ "long" "flags" }
|
||||
|
|
|
@ -17,3 +17,18 @@ const char *vm_executable_path(void)
|
|||
return safe_strdup(path);
|
||||
}
|
||||
}
|
||||
|
||||
int inotify_init(void)
|
||||
{
|
||||
return syscall(SYS_inotify_init);
|
||||
}
|
||||
|
||||
int inotify_add_watch(int fd, const char *name, u32 mask)
|
||||
{
|
||||
return syscall(SYS_inotify_add_watch, fd, name, mask);
|
||||
}
|
||||
|
||||
int inotify_rm_watch(int fd, u32 wd)
|
||||
{
|
||||
return syscall(SYS_inotify_rm_watch, fd, wd);
|
||||
}
|
||||
|
|
|
@ -1,6 +1,12 @@
|
|||
#include <sys/syscall.h>
|
||||
|
||||
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
|
||||
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
|
||||
|
||||
#ifndef environ
|
||||
extern char **environ;
|
||||
#endif
|
||||
|
||||
int inotify_init(void);
|
||||
int inotify_add_watch(int fd, const char *name, u32 mask);
|
||||
int inotify_rm_watch(int fd, u32 wd);
|
||||
|
|
Loading…
Reference in New Issue