Merge commit 'origin/master' into emacs
commit
0ba761eee7
basis
cocoa/application
core-foundation
fsevents
run-loop
time
timers
io
thread
unix/multiplexers/run-loop
tools/deploy/shaker
ui
backend
cocoa
event-loop
tools/deploy
windows
x11
x11/xlib
extra/bunny
cel-shaded
model
|
@ -12,5 +12,6 @@ namespaces eval kernel vocabs.loader io ;
|
||||||
ignore-cli-args? not script get and
|
ignore-cli-args? not script get and
|
||||||
[ run-script ] [ "run" get run ] if*
|
[ run-script ] [ "run" get run ] if*
|
||||||
output-stream get [ stream-flush ] when*
|
output-stream get [ stream-flush ] when*
|
||||||
|
0 exit
|
||||||
] [ print-error 1 exit ] recover
|
] [ print-error 1 exit ] recover
|
||||||
] set-boot-quot
|
] set-boot-quot
|
||||||
|
|
|
@ -7,4 +7,5 @@ io ;
|
||||||
(command-line) parse-command-line
|
(command-line) parse-command-line
|
||||||
"run" get run
|
"run" get run
|
||||||
output-stream get [ stream-flush ] when*
|
output-stream get [ stream-flush ] when*
|
||||||
|
0 exit
|
||||||
] set-boot-quot
|
] set-boot-quot
|
||||||
|
|
|
@ -102,6 +102,8 @@ SYMBOL: bootstrap-time
|
||||||
] if
|
] if
|
||||||
] [
|
] [
|
||||||
drop
|
drop
|
||||||
load-help? off
|
[
|
||||||
"resource:basis/bootstrap/bootstrap-error.factor" run-file
|
load-help? off
|
||||||
|
"resource:basis/bootstrap/bootstrap-error.factor" run-file
|
||||||
|
] with-scope
|
||||||
] recover
|
] recover
|
||||||
|
|
|
@ -30,10 +30,6 @@ HELP: cocoa-app
|
||||||
{ $values { "quot" quotation } }
|
{ $values { "quot" quotation } }
|
||||||
{ $description "Initializes Cocoa, calls the quotation, and starts the Cocoa event loop." } ;
|
{ $description "Initializes Cocoa, calls the quotation, and starts the Cocoa event loop." } ;
|
||||||
|
|
||||||
HELP: do-event
|
|
||||||
{ $values { "app" "an " { $snippet "NSApplication" } } { "?" "a boolean" } }
|
|
||||||
{ $description "Processes a pending event in the queue, if any, returning a boolean indicating if there was one. Does not block." } ;
|
|
||||||
|
|
||||||
HELP: add-observer
|
HELP: add-observer
|
||||||
{ $values { "observer" "an " { $snippet "NSObject" } } { "selector" string } { "name" "an " { $snippet "NSString" } } { "object" "an " { $snippet "NSObject" } } }
|
{ $values { "observer" "an " { $snippet "NSObject" } } { "selector" string } { "name" "an " { $snippet "NSString" } } { "object" "an " { $snippet "NSObject" } } }
|
||||||
{ $description "Registers an observer with the " { $snippet "NSNotificationCenter" } " singleton." } ;
|
{ $description "Registers an observer with the " { $snippet "NSNotificationCenter" } " singleton." } ;
|
||||||
|
@ -52,7 +48,6 @@ HELP: objc-error
|
||||||
ARTICLE: "cocoa-application-utils" "Cocoa application utilities"
|
ARTICLE: "cocoa-application-utils" "Cocoa application utilities"
|
||||||
"Utilities:"
|
"Utilities:"
|
||||||
{ $subsection NSApp }
|
{ $subsection NSApp }
|
||||||
{ $subsection do-event }
|
|
||||||
{ $subsection add-observer }
|
{ $subsection add-observer }
|
||||||
{ $subsection remove-observer }
|
{ $subsection remove-observer }
|
||||||
{ $subsection install-delegate }
|
{ $subsection install-delegate }
|
||||||
|
|
|
@ -1,10 +1,10 @@
|
||||||
! Copyright (C) 2006, 2008 Slava Pestov
|
! Copyright (C) 2006, 2008 Slava Pestov
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.syntax io kernel namespaces core-foundation
|
USING: alien alien.syntax io kernel namespaces core-foundation
|
||||||
core-foundation.run-loop core-foundation.arrays
|
core-foundation.arrays core-foundation.data
|
||||||
core-foundation.data core-foundation.strings cocoa.messages
|
core-foundation.strings cocoa.messages cocoa cocoa.classes
|
||||||
cocoa cocoa.classes cocoa.runtime sequences threads init summary
|
cocoa.runtime sequences threads init summary kernel.private
|
||||||
kernel.private assocs ;
|
assocs ;
|
||||||
IN: cocoa.application
|
IN: cocoa.application
|
||||||
|
|
||||||
: <NSString> ( str -- alien ) <CFString> -> autorelease ;
|
: <NSString> ( str -- alien ) <CFString> -> autorelease ;
|
||||||
|
@ -35,13 +35,6 @@ FUNCTION: void NSBeep ( ) ;
|
||||||
: with-cocoa ( quot -- )
|
: with-cocoa ( quot -- )
|
||||||
[ NSApp drop call ] with-autorelease-pool ; inline
|
[ NSApp drop call ] with-autorelease-pool ; inline
|
||||||
|
|
||||||
: next-event ( app -- event )
|
|
||||||
NSAnyEventMask f CFRunLoopDefaultMode 1
|
|
||||||
-> nextEventMatchingMask:untilDate:inMode:dequeue: ;
|
|
||||||
|
|
||||||
: do-event ( app -- ? )
|
|
||||||
dup next-event [ dupd -> sendEvent: -> updateWindows t ] [ drop f ] if* ;
|
|
||||||
|
|
||||||
: add-observer ( observer selector name object -- )
|
: add-observer ( observer selector name object -- )
|
||||||
[
|
[
|
||||||
[ NSNotificationCenter -> defaultCenter ] 2dip
|
[ NSNotificationCenter -> defaultCenter ] 2dip
|
||||||
|
|
|
@ -14,8 +14,6 @@ TYPEDEF: int SInt32
|
||||||
TYPEDEF: uint UInt32
|
TYPEDEF: uint UInt32
|
||||||
TYPEDEF: ulong CFTypeID
|
TYPEDEF: ulong CFTypeID
|
||||||
TYPEDEF: UInt32 CFOptionFlags
|
TYPEDEF: UInt32 CFOptionFlags
|
||||||
TYPEDEF: double CFTimeInterval
|
|
||||||
TYPEDEF: double CFAbsoluteTime
|
|
||||||
|
|
||||||
FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ;
|
FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ;
|
||||||
|
|
||||||
|
|
|
@ -5,7 +5,8 @@ math sequences namespaces make assocs init accessors
|
||||||
continuations combinators io.encodings.utf8 destructors locals
|
continuations combinators io.encodings.utf8 destructors locals
|
||||||
arrays specialized-arrays.direct.alien
|
arrays specialized-arrays.direct.alien
|
||||||
specialized-arrays.direct.int specialized-arrays.direct.longlong
|
specialized-arrays.direct.int specialized-arrays.direct.longlong
|
||||||
core-foundation core-foundation.run-loop core-foundation.strings ;
|
core-foundation core-foundation.run-loop core-foundation.strings
|
||||||
|
core-foundation.time ;
|
||||||
IN: core-foundation.fsevents
|
IN: core-foundation.fsevents
|
||||||
|
|
||||||
: kFSEventStreamCreateFlagUseCFTypes 2 ; inline
|
: kFSEventStreamCreateFlagUseCFTypes 2 ; inline
|
||||||
|
|
|
@ -1,8 +1,10 @@
|
||||||
! Copyright (C) 2008 Slava Pestov
|
! Copyright (C) 2008 Slava Pestov
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.syntax kernel namespaces core-foundation
|
USING: accessors alien alien.syntax kernel math namespaces
|
||||||
core-foundation.strings core-foundation.file-descriptors
|
sequences destructors combinators threads heaps deques calendar
|
||||||
core-foundation.timers ;
|
core-foundation core-foundation.strings
|
||||||
|
core-foundation.file-descriptors core-foundation.timers
|
||||||
|
core-foundation.time ;
|
||||||
IN: core-foundation.run-loop
|
IN: core-foundation.run-loop
|
||||||
|
|
||||||
: kCFRunLoopRunFinished 1 ; inline
|
: kCFRunLoopRunFinished 1 ; inline
|
||||||
|
@ -59,3 +61,80 @@ FUNCTION: void CFRunLoopRemoveTimer (
|
||||||
"kCFRunLoopDefaultMode" <CFString>
|
"kCFRunLoopDefaultMode" <CFString>
|
||||||
dup \ CFRunLoopDefaultMode set-global
|
dup \ CFRunLoopDefaultMode set-global
|
||||||
] when ;
|
] when ;
|
||||||
|
|
||||||
|
TUPLE: run-loop fds sources timers ;
|
||||||
|
|
||||||
|
: <run-loop> ( -- run-loop )
|
||||||
|
V{ } clone V{ } clone V{ } clone \ run-loop boa ;
|
||||||
|
|
||||||
|
SYMBOL: expiry-check
|
||||||
|
|
||||||
|
: run-loop ( -- run-loop )
|
||||||
|
\ run-loop get-global not expiry-check get expired? or
|
||||||
|
[
|
||||||
|
31337 <alien> expiry-check set-global
|
||||||
|
<run-loop> dup \ run-loop set-global
|
||||||
|
] [ \ run-loop get-global ] if ;
|
||||||
|
|
||||||
|
: add-source-to-run-loop ( source -- )
|
||||||
|
[ run-loop sources>> push ]
|
||||||
|
[
|
||||||
|
CFRunLoopGetMain
|
||||||
|
swap CFRunLoopDefaultMode
|
||||||
|
CFRunLoopAddSource
|
||||||
|
] bi ;
|
||||||
|
|
||||||
|
: create-fd-source ( CFFileDescriptor -- source )
|
||||||
|
f swap 0 CFFileDescriptorCreateRunLoopSource ;
|
||||||
|
|
||||||
|
: add-fd-to-run-loop ( fd callback -- )
|
||||||
|
[
|
||||||
|
<CFFileDescriptor> |CFRelease
|
||||||
|
[ run-loop fds>> push ]
|
||||||
|
[ create-fd-source |CFRelease add-source-to-run-loop ]
|
||||||
|
bi
|
||||||
|
] with-destructors ;
|
||||||
|
|
||||||
|
: add-timer-to-run-loop ( timer -- )
|
||||||
|
[ run-loop timers>> push ]
|
||||||
|
[
|
||||||
|
CFRunLoopGetMain
|
||||||
|
swap CFRunLoopDefaultMode
|
||||||
|
CFRunLoopAddTimer
|
||||||
|
] bi ;
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: ((reset-timer)) ( timer counter timestamp -- )
|
||||||
|
nip >CFAbsoluteTime CFRunLoopTimerSetNextFireDate ;
|
||||||
|
|
||||||
|
: (reset-timer) ( timer counter -- )
|
||||||
|
yield {
|
||||||
|
{ [ dup 0 = ] [ now ((reset-timer)) ] }
|
||||||
|
{ [ run-queue deque-empty? not ] [ 1- (reset-timer) ] }
|
||||||
|
{ [ sleep-queue heap-empty? ] [ 5 minutes hence ((reset-timer)) ] }
|
||||||
|
[ sleep-queue heap-peek nip micros>timestamp ((reset-timer)) ]
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
: reset-timer ( timer -- )
|
||||||
|
10 (reset-timer) ;
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
: reset-run-loop ( -- )
|
||||||
|
run-loop
|
||||||
|
[ timers>> [ reset-timer ] each ]
|
||||||
|
[ fds>> [ enable-all-callbacks ] each ] bi ;
|
||||||
|
|
||||||
|
: timer-callback ( -- callback )
|
||||||
|
"void" { "CFRunLoopTimerRef" "void*" } "cdecl"
|
||||||
|
[ 2drop reset-run-loop yield ] alien-callback ;
|
||||||
|
|
||||||
|
: init-thread-timer ( -- )
|
||||||
|
timer-callback <CFTimer> add-timer-to-run-loop ;
|
||||||
|
|
||||||
|
: run-one-iteration ( us -- handled? )
|
||||||
|
reset-run-loop
|
||||||
|
CFRunLoopDefaultMode
|
||||||
|
swap [ microseconds ] [ 5 minutes ] if* >CFTimeInterval
|
||||||
|
t CFRunLoopRunInMode kCFRunLoopRunHandledSource = ;
|
||||||
|
|
|
@ -0,0 +1,14 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: calendar alien.syntax ;
|
||||||
|
IN: core-foundation.time
|
||||||
|
|
||||||
|
TYPEDEF: double CFTimeInterval
|
||||||
|
TYPEDEF: double CFAbsoluteTime
|
||||||
|
|
||||||
|
: >CFTimeInterval ( duration -- interval )
|
||||||
|
duration>seconds ; inline
|
||||||
|
|
||||||
|
: >CFAbsoluteTime ( timestamp -- time )
|
||||||
|
T{ timestamp { year 2001 } { month 1 } { day 1 } } time-
|
||||||
|
duration>seconds ; inline
|
|
@ -1,6 +1,7 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien.syntax system math kernel core-foundation ;
|
USING: alien.syntax system math kernel calendar core-foundation
|
||||||
|
core-foundation.time ;
|
||||||
IN: core-foundation.timers
|
IN: core-foundation.timers
|
||||||
|
|
||||||
TYPEDEF: void* CFRunLoopTimerRef
|
TYPEDEF: void* CFRunLoopTimerRef
|
||||||
|
@ -18,12 +19,16 @@ FUNCTION: CFRunLoopTimerRef CFRunLoopTimerCreate (
|
||||||
) ;
|
) ;
|
||||||
|
|
||||||
: <CFTimer> ( callback -- timer )
|
: <CFTimer> ( callback -- timer )
|
||||||
[ f millis 1000 /f 60 0 0 ] dip f CFRunLoopTimerCreate ;
|
[ f now >CFAbsoluteTime 60 0 0 ] dip f CFRunLoopTimerCreate ;
|
||||||
|
|
||||||
FUNCTION: void CFRunLoopTimerInvalidate (
|
FUNCTION: void CFRunLoopTimerInvalidate (
|
||||||
CFRunLoopTimerRef timer
|
CFRunLoopTimerRef timer
|
||||||
) ;
|
) ;
|
||||||
|
|
||||||
|
FUNCTION: Boolean CFRunLoopTimerIsValid (
|
||||||
|
CFRunLoopTimerRef timer
|
||||||
|
) ;
|
||||||
|
|
||||||
FUNCTION: void CFRunLoopTimerSetNextFireDate (
|
FUNCTION: void CFRunLoopTimerSetNextFireDate (
|
||||||
CFRunLoopTimerRef timer,
|
CFRunLoopTimerRef timer,
|
||||||
CFAbsoluteTime fireDate
|
CFAbsoluteTime fireDate
|
||||||
|
|
|
@ -1,14 +1,20 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: threads io.backend namespaces init math kernel ;
|
||||||
IN: io.thread
|
IN: io.thread
|
||||||
USING: threads io.backend namespaces init math ;
|
|
||||||
|
! The Cocoa UI backend stops the I/O thread and takes over
|
||||||
|
! completely.
|
||||||
|
SYMBOL: io-thread-running?
|
||||||
|
|
||||||
: io-thread ( -- )
|
: io-thread ( -- )
|
||||||
sleep-time io-multiplex yield ;
|
sleep-time io-multiplex yield ;
|
||||||
|
|
||||||
: start-io-thread ( -- )
|
: start-io-thread ( -- )
|
||||||
[ io-thread t ]
|
[ [ io-thread-running? get-global ] [ io-thread ] [ ] while ]
|
||||||
"I/O wait" spawn-server
|
"I/O wait" spawn drop ;
|
||||||
\ io-thread set-global ;
|
|
||||||
|
|
||||||
[ start-io-thread ] "io.thread" add-init-hook
|
[
|
||||||
|
t io-thread-running? set-global
|
||||||
|
start-io-thread
|
||||||
|
] "io.thread" add-init-hook
|
||||||
|
|
|
@ -1,5 +0,0 @@
|
||||||
USING: io.unix.multiplexers.run-loop tools.test
|
|
||||||
destructors ;
|
|
||||||
IN: io.unix.multiplexers.run-loop.tests
|
|
||||||
|
|
||||||
[ ] [ <run-loop-mx> dispose ] unit-test
|
|
|
@ -1,50 +1,27 @@
|
||||||
! Copyright (C) 2008 Slava Pestov.
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel namespaces math accessors threads alien locals
|
USING: kernel arrays namespaces math accessors alien locals
|
||||||
destructors combinators io.unix.multiplexers
|
destructors system threads io.unix.multiplexers
|
||||||
io.unix.multiplexers.kqueue core-foundation
|
io.unix.multiplexers.kqueue core-foundation
|
||||||
core-foundation.run-loop core-foundation.file-descriptors ;
|
core-foundation.run-loop ;
|
||||||
IN: io.unix.multiplexers.run-loop
|
IN: io.unix.multiplexers.run-loop
|
||||||
|
|
||||||
TUPLE: run-loop-mx kqueue-mx fd source ;
|
TUPLE: run-loop-mx kqueue-mx ;
|
||||||
|
|
||||||
: kqueue-callback ( -- callback )
|
: file-descriptor-callback ( -- callback )
|
||||||
"void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" }
|
"void" { "CFFileDescriptorRef" "CFOptionFlags" "void*" }
|
||||||
"cdecl" [
|
"cdecl" [
|
||||||
3drop
|
3drop
|
||||||
0 mx get kqueue-mx>> wait-for-events
|
0 mx get kqueue-mx>> wait-for-events
|
||||||
mx get fd>> enable-all-callbacks
|
reset-run-loop
|
||||||
yield
|
yield
|
||||||
]
|
] alien-callback ;
|
||||||
alien-callback ;
|
|
||||||
|
|
||||||
SYMBOL: kqueue-run-loop-source
|
|
||||||
|
|
||||||
: create-kqueue-source ( fd -- source )
|
|
||||||
f swap 0 CFFileDescriptorCreateRunLoopSource ;
|
|
||||||
|
|
||||||
: add-kqueue-to-run-loop ( mx -- )
|
|
||||||
CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopAddSource ;
|
|
||||||
|
|
||||||
: remove-kqueue-from-run-loop ( source -- )
|
|
||||||
CFRunLoopGetMain swap source>> CFRunLoopDefaultMode CFRunLoopRemoveSource ;
|
|
||||||
|
|
||||||
: <run-loop-mx> ( -- mx )
|
: <run-loop-mx> ( -- mx )
|
||||||
[
|
[
|
||||||
<kqueue-mx> |dispose
|
<kqueue-mx> |dispose
|
||||||
dup fd>> kqueue-callback <CFFileDescriptor> |dispose
|
dup fd>> file-descriptor-callback add-fd-to-run-loop
|
||||||
dup create-kqueue-source run-loop-mx boa
|
run-loop-mx boa
|
||||||
dup add-kqueue-to-run-loop
|
|
||||||
] with-destructors ;
|
|
||||||
|
|
||||||
M: run-loop-mx dispose
|
|
||||||
[
|
|
||||||
{
|
|
||||||
[ fd>> &CFRelease drop ]
|
|
||||||
[ source>> &CFRelease drop ]
|
|
||||||
[ remove-kqueue-from-run-loop ]
|
|
||||||
[ kqueue-mx>> &dispose drop ]
|
|
||||||
} cleave
|
|
||||||
] with-destructors ;
|
] with-destructors ;
|
||||||
|
|
||||||
M: run-loop-mx add-input-callback kqueue-mx>> add-input-callback ;
|
M: run-loop-mx add-input-callback kqueue-mx>> add-input-callback ;
|
||||||
|
@ -52,7 +29,5 @@ M: run-loop-mx add-output-callback kqueue-mx>> add-output-callback ;
|
||||||
M: run-loop-mx remove-input-callbacks kqueue-mx>> remove-input-callbacks ;
|
M: run-loop-mx remove-input-callbacks kqueue-mx>> remove-input-callbacks ;
|
||||||
M: run-loop-mx remove-output-callbacks kqueue-mx>> remove-output-callbacks ;
|
M: run-loop-mx remove-output-callbacks kqueue-mx>> remove-output-callbacks ;
|
||||||
|
|
||||||
M:: run-loop-mx wait-for-events ( us mx -- )
|
M: run-loop-mx wait-for-events ( us mx -- )
|
||||||
mx fd>> enable-all-callbacks
|
swap run-one-iteration [ 0 swap wait-for-events ] [ drop ] if ;
|
||||||
CFRunLoopDefaultMode us [ 1000000 /f ] [ 60 ] if* t CFRunLoopRunInMode
|
|
||||||
kCFRunLoopRunHandledSource = [ 0 mx wait-for-events ] when ;
|
|
||||||
|
|
|
@ -2,8 +2,8 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel opengl.gl alien.c-types continuations namespaces
|
USING: kernel opengl.gl alien.c-types continuations namespaces
|
||||||
assocs alien alien.strings libc opengl math sequences combinators
|
assocs alien alien.strings libc opengl math sequences combinators
|
||||||
combinators.lib macros arrays io.encodings.ascii fry
|
macros arrays io.encodings.ascii fry specialized-arrays.uint
|
||||||
specialized-arrays.uint destructors accessors ;
|
destructors accessors ;
|
||||||
IN: opengl.shaders
|
IN: opengl.shaders
|
||||||
|
|
||||||
: with-gl-shader-source-ptr ( string quot -- )
|
: with-gl-shader-source-ptr ( string quot -- )
|
|
@ -365,6 +365,7 @@ SYMBOL: deploy-vocab
|
||||||
init-hooks get values concat %
|
init-hooks get values concat %
|
||||||
,
|
,
|
||||||
strip-io? [ \ flush , ] unless
|
strip-io? [ \ flush , ] unless
|
||||||
|
[ 0 exit ] %
|
||||||
] [ ] make
|
] [ ] make
|
||||||
set-boot-quot ;
|
set-boot-quot ;
|
||||||
|
|
||||||
|
|
|
@ -19,12 +19,8 @@ IN: cocoa.application
|
||||||
|
|
||||||
[ [ die ] 19 setenv ] "cocoa.application" add-init-hook
|
[ [ die ] 19 setenv ] "cocoa.application" add-init-hook
|
||||||
|
|
||||||
"stop-after-last-window?" get
|
|
||||||
|
|
||||||
H{ } clone \ pool [
|
H{ } clone \ pool [
|
||||||
global [
|
global [
|
||||||
"stop-after-last-window?" "ui" lookup set
|
|
||||||
|
|
||||||
! Only keeps those methods that we actually call
|
! Only keeps those methods that we actually call
|
||||||
sent-messages get super-sent-messages get assoc-union
|
sent-messages get super-sent-messages get assoc-union
|
||||||
objc-methods [ assoc-intersect pool-values ] change
|
objc-methods [ assoc-intersect pool-values ] change
|
||||||
|
|
|
@ -5,8 +5,6 @@ IN: ui.backend
|
||||||
|
|
||||||
SYMBOL: ui-backend
|
SYMBOL: ui-backend
|
||||||
|
|
||||||
HOOK: do-events ui-backend ( -- )
|
|
||||||
|
|
||||||
HOOK: set-title ui-backend ( string world -- )
|
HOOK: set-title ui-backend ( string world -- )
|
||||||
|
|
||||||
HOOK: set-fullscreen* ui-backend ( ? world -- )
|
HOOK: set-fullscreen* ui-backend ( ? world -- )
|
||||||
|
|
|
@ -3,10 +3,11 @@
|
||||||
USING: accessors math arrays assocs cocoa cocoa.application
|
USING: accessors math arrays assocs cocoa cocoa.application
|
||||||
command-line kernel memory namespaces cocoa.messages
|
command-line kernel memory namespaces cocoa.messages
|
||||||
cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
|
cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
|
||||||
cocoa.windows cocoa.classes cocoa.nibs sequences system
|
cocoa.windows cocoa.classes cocoa.nibs sequences system ui
|
||||||
ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
|
ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
|
||||||
ui.cocoa.views core-foundation threads math.geometry.rect fry
|
ui.cocoa.views core-foundation core-foundation.run-loop threads
|
||||||
libc generalizations alien.c-types cocoa.views combinators ;
|
math.geometry.rect fry libc generalizations alien.c-types
|
||||||
|
cocoa.views combinators io.thread ;
|
||||||
IN: ui.cocoa
|
IN: ui.cocoa
|
||||||
|
|
||||||
TUPLE: handle ;
|
TUPLE: handle ;
|
||||||
|
@ -18,9 +19,6 @@ C: <offscreen-handle> offscreen-handle
|
||||||
|
|
||||||
SINGLETON: cocoa-ui-backend
|
SINGLETON: cocoa-ui-backend
|
||||||
|
|
||||||
M: cocoa-ui-backend do-events ( -- )
|
|
||||||
[ NSApp '[ _ do-event ] loop ui-wait ] with-autorelease-pool ;
|
|
||||||
|
|
||||||
TUPLE: pasteboard handle ;
|
TUPLE: pasteboard handle ;
|
||||||
|
|
||||||
C: <pasteboard> pasteboard
|
C: <pasteboard> pasteboard
|
||||||
|
@ -134,8 +132,8 @@ CLASS: {
|
||||||
{ +name+ "FactorApplicationDelegate" }
|
{ +name+ "FactorApplicationDelegate" }
|
||||||
}
|
}
|
||||||
|
|
||||||
{ "applicationDidFinishLaunching:" "void" { "id" "SEL" "id" }
|
{ "applicationDidUpdate:" "void" { "id" "SEL" "id" }
|
||||||
[ 3drop event-loop ]
|
[ 3drop reset-run-loop ]
|
||||||
} ;
|
} ;
|
||||||
|
|
||||||
: install-app-delegate ( -- )
|
: install-app-delegate ( -- )
|
||||||
|
@ -153,6 +151,9 @@ M: cocoa-ui-backend ui
|
||||||
init-clipboard
|
init-clipboard
|
||||||
cocoa-init-hook get call
|
cocoa-init-hook get call
|
||||||
start-ui
|
start-ui
|
||||||
|
f io-thread-running? set-global
|
||||||
|
init-thread-timer
|
||||||
|
reset-run-loop
|
||||||
NSApp -> run
|
NSApp -> run
|
||||||
] ui-running
|
] ui-running
|
||||||
] with-cocoa ;
|
] with-cocoa ;
|
||||||
|
|
|
@ -0,0 +1,4 @@
|
||||||
|
IN: ui.event-loop.tests
|
||||||
|
USING: ui.event-loop tools.test ;
|
||||||
|
|
||||||
|
\ event-loop must-infer
|
|
@ -0,0 +1,18 @@
|
||||||
|
! Copyright (C) 2008 Slava Pestov.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: calendar combinators deques kernel namespaces sequences
|
||||||
|
threads ui ui.backend ui.gadgets ;
|
||||||
|
IN: ui.event-loop
|
||||||
|
|
||||||
|
: event-loop? ( -- ? )
|
||||||
|
{
|
||||||
|
{ [ graft-queue deque-empty? not ] [ t ] }
|
||||||
|
{ [ windows get-global empty? not ] [ t ] }
|
||||||
|
[ f ]
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
HOOK: do-events ui-backend ( -- )
|
||||||
|
|
||||||
|
: event-loop ( -- ) [ event-loop? ] [ do-events ] [ ] while ;
|
||||||
|
|
||||||
|
: ui-wait ( -- ) 10 milliseconds sleep ;
|
|
@ -18,10 +18,6 @@ TUPLE: deploy-gadget < pack vocab settings ;
|
||||||
deploy-ui? get
|
deploy-ui? get
|
||||||
"Include user interface framework" <checkbox> add-gadget ;
|
"Include user interface framework" <checkbox> add-gadget ;
|
||||||
|
|
||||||
: exit-when-windows-closed ( parent -- parent )
|
|
||||||
"stop-after-last-window?" get
|
|
||||||
"Exit when last UI window closed" <checkbox> add-gadget ;
|
|
||||||
|
|
||||||
: io-settings ( parent -- parent )
|
: io-settings ( parent -- parent )
|
||||||
"Input/output support:" <label> add-gadget
|
"Input/output support:" <label> add-gadget
|
||||||
deploy-io get deploy-io-options <radio-buttons> add-gadget ;
|
deploy-io get deploy-io-options <radio-buttons> add-gadget ;
|
||||||
|
@ -50,7 +46,6 @@ TUPLE: deploy-gadget < pack vocab settings ;
|
||||||
<pile>
|
<pile>
|
||||||
bundle-name
|
bundle-name
|
||||||
deploy-ui
|
deploy-ui
|
||||||
os macosx? [ exit-when-windows-closed ] when
|
|
||||||
io-settings
|
io-settings
|
||||||
reflection-settings
|
reflection-settings
|
||||||
advanced-settings
|
advanced-settings
|
||||||
|
|
|
@ -143,9 +143,7 @@ ARTICLE: "ui-backend-init" "UI initialization and the event loop"
|
||||||
}
|
}
|
||||||
"The above word must call the following:"
|
"The above word must call the following:"
|
||||||
{ $subsection start-ui }
|
{ $subsection start-ui }
|
||||||
"The " { $link ui } " word must not return until the event loop has stopped and the UI has been shut down."
|
"The " { $link ui } " word must not return until the event loop has stopped and the UI has been shut down." ;
|
||||||
$nl
|
|
||||||
"The event loop must not block, since otherwise other Factor threads and I/O will not run. Instead, it should poll for pending events, then call " { $link ui-wait } "." ;
|
|
||||||
|
|
||||||
ARTICLE: "ui-backend-windows" "UI backend window management"
|
ARTICLE: "ui-backend-windows" "UI backend window management"
|
||||||
"The high-level " { $link open-window } " word eventually calls a low-level word which you must implement:"
|
"The high-level " { $link open-window } " word eventually calls a low-level word which you must implement:"
|
||||||
|
|
|
@ -1,5 +1,4 @@
|
||||||
IN: ui.tests
|
IN: ui.tests
|
||||||
USING: ui tools.test ;
|
USING: ui tools.test ;
|
||||||
|
|
||||||
\ event-loop must-infer
|
|
||||||
\ open-window must-infer
|
\ open-window must-infer
|
||||||
|
|
|
@ -10,18 +10,6 @@ IN: ui
|
||||||
! Assoc mapping aliens to gadgets
|
! Assoc mapping aliens to gadgets
|
||||||
SYMBOL: windows
|
SYMBOL: windows
|
||||||
|
|
||||||
SYMBOL: stop-after-last-window?
|
|
||||||
|
|
||||||
: event-loop? ( -- ? )
|
|
||||||
{
|
|
||||||
{ [ stop-after-last-window? get not ] [ t ] }
|
|
||||||
{ [ graft-queue deque-empty? not ] [ t ] }
|
|
||||||
{ [ windows get-global empty? not ] [ t ] }
|
|
||||||
[ f ]
|
|
||||||
} cond ;
|
|
||||||
|
|
||||||
: event-loop ( -- ) [ event-loop? ] [ do-events ] [ ] while ;
|
|
||||||
|
|
||||||
: window ( handle -- world ) windows get-global at ;
|
: window ( handle -- world ) windows get-global at ;
|
||||||
|
|
||||||
: window-focus ( handle -- gadget ) window world-focus ;
|
: window-focus ( handle -- gadget ) window world-focus ;
|
||||||
|
@ -155,9 +143,6 @@ SYMBOL: ui-hook
|
||||||
] assert-depth
|
] assert-depth
|
||||||
] [ ui-error ] recover ;
|
] [ ui-error ] recover ;
|
||||||
|
|
||||||
: ui-wait ( -- )
|
|
||||||
10 milliseconds sleep ;
|
|
||||||
|
|
||||||
SYMBOL: ui-thread
|
SYMBOL: ui-thread
|
||||||
|
|
||||||
: ui-running ( quot -- )
|
: ui-running ( quot -- )
|
||||||
|
@ -220,7 +205,6 @@ MAIN: ui
|
||||||
f windows set-global
|
f windows set-global
|
||||||
[
|
[
|
||||||
ui-hook set
|
ui-hook set
|
||||||
stop-after-last-window? on
|
|
||||||
ui
|
ui
|
||||||
] with-scope
|
] with-scope
|
||||||
] if ;
|
] if ;
|
||||||
|
|
|
@ -3,14 +3,14 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types alien.strings arrays assocs ui
|
USING: alien alien.c-types alien.strings arrays assocs ui
|
||||||
ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
|
ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
|
||||||
ui.gestures io kernel math math.vectors namespaces make
|
ui.gestures ui.event-loop io kernel math math.vectors namespaces
|
||||||
sequences strings vectors words windows.kernel32 windows.gdi32
|
make sequences strings vectors words windows.kernel32
|
||||||
windows.user32 windows.opengl32 windows.messages windows.types
|
windows.gdi32 windows.user32 windows.opengl32 windows.messages
|
||||||
windows.nt windows threads libc combinators fry
|
windows.types windows.nt windows threads libc combinators fry
|
||||||
combinators.short-circuit continuations command-line shuffle
|
combinators.short-circuit continuations command-line shuffle
|
||||||
opengl ui.render ascii math.bitwise locals symbols accessors
|
opengl ui.render ascii math.bitwise locals symbols accessors
|
||||||
math.geometry.rect math.order ascii calendar
|
math.geometry.rect math.order ascii calendar io.encodings.utf16n
|
||||||
io.encodings.utf16n ;
|
;
|
||||||
IN: ui.windows
|
IN: ui.windows
|
||||||
|
|
||||||
SINGLETON: windows-ui-backend
|
SINGLETON: windows-ui-backend
|
||||||
|
@ -574,7 +574,6 @@ M: windows-ui-backend set-title ( string world -- )
|
||||||
M: windows-ui-backend ui
|
M: windows-ui-backend ui
|
||||||
[
|
[
|
||||||
[
|
[
|
||||||
stop-after-last-window? on
|
|
||||||
init-clipboard
|
init-clipboard
|
||||||
init-win32-ui
|
init-win32-ui
|
||||||
start-ui
|
start-ui
|
||||||
|
|
|
@ -2,9 +2,9 @@
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alien alien.c-types arrays ui ui.gadgets
|
USING: accessors alien alien.c-types arrays ui ui.gadgets
|
||||||
ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
|
ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
|
||||||
assocs kernel math namespaces opengl sequences strings x11.xlib
|
ui.event-loop assocs kernel math namespaces opengl sequences
|
||||||
x11.events x11.xim x11.glx x11.clipboard x11.constants
|
strings x11.xlib x11.events x11.xim x11.glx x11.clipboard
|
||||||
x11.windows io.encodings.string io.encodings.ascii
|
x11.constants x11.windows io.encodings.string io.encodings.ascii
|
||||||
io.encodings.utf8 combinators command-line qualified
|
io.encodings.utf8 combinators command-line qualified
|
||||||
math.vectors classes.tuple opengl.gl threads math.geometry.rect
|
math.vectors classes.tuple opengl.gl threads math.geometry.rect
|
||||||
environment ascii ;
|
environment ascii ;
|
||||||
|
@ -281,7 +281,6 @@ M: x11-ui-backend ui ( -- )
|
||||||
[
|
[
|
||||||
f [
|
f [
|
||||||
[
|
[
|
||||||
stop-after-last-window? on
|
|
||||||
init-clipboard
|
init-clipboard
|
||||||
start-ui
|
start-ui
|
||||||
event-loop
|
event-loop
|
||||||
|
|
|
@ -31,7 +31,6 @@ TYPEDEF: XID KeySym
|
||||||
TYPEDEF: ulong Atom
|
TYPEDEF: ulong Atom
|
||||||
|
|
||||||
TYPEDEF: char* XPointer
|
TYPEDEF: char* XPointer
|
||||||
TYPEDEF: void* Display*
|
|
||||||
TYPEDEF: void* Screen*
|
TYPEDEF: void* Screen*
|
||||||
TYPEDEF: void* GC
|
TYPEDEF: void* GC
|
||||||
TYPEDEF: void* Visual*
|
TYPEDEF: void* Visual*
|
||||||
|
@ -66,6 +65,12 @@ TYPEDEF: void* Atom**
|
||||||
! 2 - Display Functions
|
! 2 - Display Functions
|
||||||
!
|
!
|
||||||
|
|
||||||
|
! This struct is incomplete
|
||||||
|
C-STRUCT: Display
|
||||||
|
{ "void*" "ext_data" }
|
||||||
|
{ "void*" "free_funcs" }
|
||||||
|
{ "int" "fd" } ;
|
||||||
|
|
||||||
FUNCTION: Display* XOpenDisplay ( void* display_name ) ;
|
FUNCTION: Display* XOpenDisplay ( void* display_name ) ;
|
||||||
|
|
||||||
! 2.2 Obtaining Information about the Display, Image Formats, or Screens
|
! 2.2 Obtaining Information about the Display, Image Formats, or Screens
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
USING: arrays bunny.model continuations destructors kernel
|
USING: arrays bunny.model continuations destructors kernel
|
||||||
multiline opengl opengl.shaders opengl.capabilities opengl.gl
|
multiline opengl opengl.shaders opengl.capabilities opengl.gl
|
||||||
sequences sequences.lib accessors combinators ;
|
sequences accessors combinators ;
|
||||||
IN: bunny.cel-shaded
|
IN: bunny.cel-shaded
|
||||||
|
|
||||||
STRING: vertex-shader-source
|
STRING: vertex-shader-source
|
||||||
|
|
|
@ -2,8 +2,8 @@ USING: accessors alien.c-types arrays combinators destructors
|
||||||
http.client io io.encodings.ascii io.files kernel math
|
http.client io io.encodings.ascii io.files kernel math
|
||||||
math.matrices math.parser math.vectors opengl
|
math.matrices math.parser math.vectors opengl
|
||||||
opengl.capabilities opengl.gl opengl.demo-support sequences
|
opengl.capabilities opengl.gl opengl.demo-support sequences
|
||||||
sequences.lib splitting vectors words
|
splitting vectors words specialized-arrays.float
|
||||||
specialized-arrays.float specialized-arrays.uint ;
|
specialized-arrays.uint ;
|
||||||
IN: bunny.model
|
IN: bunny.model
|
||||||
|
|
||||||
: numbers ( str -- seq )
|
: numbers ( str -- seq )
|
||||||
|
@ -27,7 +27,7 @@ IN: bunny.model
|
||||||
vneg normalize ;
|
vneg normalize ;
|
||||||
|
|
||||||
: normal ( ns vs triple -- )
|
: normal ( ns vs triple -- )
|
||||||
[ n ] keep [ rot [ v+ ] change-nth ] each-with2 ;
|
[ n ] keep [ rot [ v+ ] change-nth ] with with each ;
|
||||||
|
|
||||||
: normals ( vs is -- ns )
|
: normals ( vs is -- ns )
|
||||||
over length { 0.0 0.0 0.0 } <array> -rot
|
over length { 0.0 0.0 0.0 } <array> -rot
|
||||||
|
@ -50,10 +50,10 @@ IN: bunny.model
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
: (draw-triangle) ( ns vs triple -- )
|
: (draw-triangle) ( ns vs triple -- )
|
||||||
[ dup roll nth gl-normal swap nth gl-vertex ] each-with2 ;
|
[ dup roll nth gl-normal swap nth gl-vertex ] with with each ;
|
||||||
|
|
||||||
: draw-triangles ( ns vs is -- )
|
: draw-triangles ( ns vs is -- )
|
||||||
GL_TRIANGLES [ [ (draw-triangle) ] each-with2 ] do-state ;
|
GL_TRIANGLES [ [ (draw-triangle) ] with with each ] do-state ;
|
||||||
|
|
||||||
TUPLE: bunny-dlist list ;
|
TUPLE: bunny-dlist list ;
|
||||||
TUPLE: bunny-buffers array element-array nv ni ;
|
TUPLE: bunny-buffers array element-array nv ni ;
|
||||||
|
|
Loading…
Reference in New Issue