Merge commit 'origin/master' into emacs

db4
Jose A. Ortega Ruiz 2008-12-13 20:33:35 +01:00
commit 0ba761eee7
43 changed files with 194 additions and 132 deletions

View File

@ -12,5 +12,6 @@ namespaces eval kernel vocabs.loader io ;
ignore-cli-args? not script get and
[ run-script ] [ "run" get run ] if*
output-stream get [ stream-flush ] when*
0 exit
] [ print-error 1 exit ] recover
] set-boot-quot

View File

@ -7,4 +7,5 @@ io ;
(command-line) parse-command-line
"run" get run
output-stream get [ stream-flush ] when*
0 exit
] set-boot-quot

View File

@ -102,6 +102,8 @@ SYMBOL: bootstrap-time
] if
] [
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

View File

@ -30,10 +30,6 @@ HELP: cocoa-app
{ $values { "quot" quotation } }
{ $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
{ $values { "observer" "an " { $snippet "NSObject" } } { "selector" string } { "name" "an " { $snippet "NSString" } } { "object" "an " { $snippet "NSObject" } } }
{ $description "Registers an observer with the " { $snippet "NSNotificationCenter" } " singleton." } ;
@ -52,7 +48,6 @@ HELP: objc-error
ARTICLE: "cocoa-application-utils" "Cocoa application utilities"
"Utilities:"
{ $subsection NSApp }
{ $subsection do-event }
{ $subsection add-observer }
{ $subsection remove-observer }
{ $subsection install-delegate }

View File

@ -1,10 +1,10 @@
! Copyright (C) 2006, 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax io kernel namespaces core-foundation
core-foundation.run-loop core-foundation.arrays
core-foundation.data core-foundation.strings cocoa.messages
cocoa cocoa.classes cocoa.runtime sequences threads init summary
kernel.private assocs ;
core-foundation.arrays core-foundation.data
core-foundation.strings cocoa.messages cocoa cocoa.classes
cocoa.runtime sequences threads init summary kernel.private
assocs ;
IN: cocoa.application
: <NSString> ( str -- alien ) <CFString> -> autorelease ;
@ -35,13 +35,6 @@ FUNCTION: void NSBeep ( ) ;
: with-cocoa ( quot -- )
[ 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 -- )
[
[ NSNotificationCenter -> defaultCenter ] 2dip

View File

@ -14,8 +14,6 @@ TYPEDEF: int SInt32
TYPEDEF: uint UInt32
TYPEDEF: ulong CFTypeID
TYPEDEF: UInt32 CFOptionFlags
TYPEDEF: double CFTimeInterval
TYPEDEF: double CFAbsoluteTime
FUNCTION: CFTypeRef CFRetain ( CFTypeRef cf ) ;

View File

@ -5,7 +5,8 @@ math sequences namespaces make assocs init accessors
continuations combinators io.encodings.utf8 destructors locals
arrays specialized-arrays.direct.alien
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
: kFSEventStreamCreateFlagUseCFTypes 2 ; inline

View File

@ -1,8 +1,10 @@
! Copyright (C) 2008 Slava Pestov
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.syntax kernel namespaces core-foundation
core-foundation.strings core-foundation.file-descriptors
core-foundation.timers ;
USING: accessors alien alien.syntax kernel math namespaces
sequences destructors combinators threads heaps deques calendar
core-foundation core-foundation.strings
core-foundation.file-descriptors core-foundation.timers
core-foundation.time ;
IN: core-foundation.run-loop
: kCFRunLoopRunFinished 1 ; inline
@ -59,3 +61,80 @@ FUNCTION: void CFRunLoopRemoveTimer (
"kCFRunLoopDefaultMode" <CFString>
dup \ CFRunLoopDefaultMode set-global
] 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 = ;

View File

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

View File

@ -1,6 +1,7 @@
! Copyright (C) 2008 Slava Pestov.
! 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
TYPEDEF: void* CFRunLoopTimerRef
@ -18,12 +19,16 @@ FUNCTION: CFRunLoopTimerRef CFRunLoopTimerCreate (
) ;
: <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 (
CFRunLoopTimerRef timer
) ;
FUNCTION: Boolean CFRunLoopTimerIsValid (
CFRunLoopTimerRef timer
) ;
FUNCTION: void CFRunLoopTimerSetNextFireDate (
CFRunLoopTimerRef timer,
CFAbsoluteTime fireDate

View File

@ -1,14 +1,20 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: threads io.backend namespaces init math kernel ;
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 ( -- )
sleep-time io-multiplex yield ;
: start-io-thread ( -- )
[ io-thread t ]
"I/O wait" spawn-server
\ io-thread set-global ;
[ [ io-thread-running? get-global ] [ io-thread ] [ ] while ]
"I/O wait" spawn drop ;
[ start-io-thread ] "io.thread" add-init-hook
[
t io-thread-running? set-global
start-io-thread
] "io.thread" add-init-hook

View File

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

View File

@ -1,50 +1,27 @@
! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces math accessors threads alien locals
destructors combinators io.unix.multiplexers
USING: kernel arrays namespaces math accessors alien locals
destructors system threads io.unix.multiplexers
io.unix.multiplexers.kqueue core-foundation
core-foundation.run-loop core-foundation.file-descriptors ;
core-foundation.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*" }
"cdecl" [
3drop
0 mx get kqueue-mx>> wait-for-events
mx get fd>> enable-all-callbacks
reset-run-loop
yield
]
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 ;
] alien-callback ;
: <run-loop-mx> ( -- mx )
[
<kqueue-mx> |dispose
dup fd>> kqueue-callback <CFFileDescriptor> |dispose
dup create-kqueue-source 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
dup fd>> file-descriptor-callback add-fd-to-run-loop
run-loop-mx boa
] with-destructors ;
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-output-callbacks kqueue-mx>> remove-output-callbacks ;
M:: run-loop-mx wait-for-events ( us mx -- )
mx fd>> enable-all-callbacks
CFRunLoopDefaultMode us [ 1000000 /f ] [ 60 ] if* t CFRunLoopRunInMode
kCFRunLoopRunHandledSource = [ 0 mx wait-for-events ] when ;
M: run-loop-mx wait-for-events ( us mx -- )
swap run-one-iteration [ 0 swap wait-for-events ] [ drop ] if ;

View File

@ -2,8 +2,8 @@
! See http://factorcode.org/license.txt for BSD license.
USING: kernel opengl.gl alien.c-types continuations namespaces
assocs alien alien.strings libc opengl math sequences combinators
combinators.lib macros arrays io.encodings.ascii fry
specialized-arrays.uint destructors accessors ;
macros arrays io.encodings.ascii fry specialized-arrays.uint
destructors accessors ;
IN: opengl.shaders
: with-gl-shader-source-ptr ( string quot -- )

View File

@ -365,6 +365,7 @@ SYMBOL: deploy-vocab
init-hooks get values concat %
,
strip-io? [ \ flush , ] unless
[ 0 exit ] %
] [ ] make
set-boot-quot ;

View File

@ -19,12 +19,8 @@ IN: cocoa.application
[ [ die ] 19 setenv ] "cocoa.application" add-init-hook
"stop-after-last-window?" get
H{ } clone \ pool [
global [
"stop-after-last-window?" "ui" lookup set
! Only keeps those methods that we actually call
sent-messages get super-sent-messages get assoc-union
objc-methods [ assoc-intersect pool-values ] change

View File

@ -5,8 +5,6 @@ IN: ui.backend
SYMBOL: ui-backend
HOOK: do-events ui-backend ( -- )
HOOK: set-title ui-backend ( string world -- )
HOOK: set-fullscreen* ui-backend ( ? world -- )

View File

@ -3,10 +3,11 @@
USING: accessors math arrays assocs cocoa cocoa.application
command-line kernel memory namespaces cocoa.messages
cocoa.runtime cocoa.subclassing cocoa.pasteboard cocoa.types
cocoa.windows cocoa.classes cocoa.nibs sequences system
ui ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
ui.cocoa.views core-foundation threads math.geometry.rect fry
libc generalizations alien.c-types cocoa.views combinators ;
cocoa.windows cocoa.classes cocoa.nibs sequences system ui
ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
ui.cocoa.views core-foundation core-foundation.run-loop threads
math.geometry.rect fry libc generalizations alien.c-types
cocoa.views combinators io.thread ;
IN: ui.cocoa
TUPLE: handle ;
@ -18,9 +19,6 @@ C: <offscreen-handle> offscreen-handle
SINGLETON: cocoa-ui-backend
M: cocoa-ui-backend do-events ( -- )
[ NSApp '[ _ do-event ] loop ui-wait ] with-autorelease-pool ;
TUPLE: pasteboard handle ;
C: <pasteboard> pasteboard
@ -134,8 +132,8 @@ CLASS: {
{ +name+ "FactorApplicationDelegate" }
}
{ "applicationDidFinishLaunching:" "void" { "id" "SEL" "id" }
[ 3drop event-loop ]
{ "applicationDidUpdate:" "void" { "id" "SEL" "id" }
[ 3drop reset-run-loop ]
} ;
: install-app-delegate ( -- )
@ -153,6 +151,9 @@ M: cocoa-ui-backend ui
init-clipboard
cocoa-init-hook get call
start-ui
f io-thread-running? set-global
init-thread-timer
reset-run-loop
NSApp -> run
] ui-running
] with-cocoa ;

View File

@ -0,0 +1,4 @@
IN: ui.event-loop.tests
USING: ui.event-loop tools.test ;
\ event-loop must-infer

View File

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

View File

@ -18,10 +18,6 @@ TUPLE: deploy-gadget < pack vocab settings ;
deploy-ui? get
"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 )
"Input/output support:" <label> add-gadget
deploy-io get deploy-io-options <radio-buttons> add-gadget ;
@ -50,7 +46,6 @@ TUPLE: deploy-gadget < pack vocab settings ;
<pile>
bundle-name
deploy-ui
os macosx? [ exit-when-windows-closed ] when
io-settings
reflection-settings
advanced-settings

View File

@ -143,9 +143,7 @@ ARTICLE: "ui-backend-init" "UI initialization and the event loop"
}
"The above word must call the following:"
{ $subsection start-ui }
"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 } "." ;
"The " { $link ui } " word must not return until the event loop has stopped and the UI has been shut down." ;
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:"

View File

@ -1,5 +1,4 @@
IN: ui.tests
USING: ui tools.test ;
\ event-loop must-infer
\ open-window must-infer

View File

@ -10,18 +10,6 @@ IN: ui
! Assoc mapping aliens to gadgets
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-focus ( handle -- gadget ) window world-focus ;
@ -155,9 +143,6 @@ SYMBOL: ui-hook
] assert-depth
] [ ui-error ] recover ;
: ui-wait ( -- )
10 milliseconds sleep ;
SYMBOL: ui-thread
: ui-running ( quot -- )
@ -220,7 +205,6 @@ MAIN: ui
f windows set-global
[
ui-hook set
stop-after-last-window? on
ui
] with-scope
] if ;

View File

@ -3,14 +3,14 @@
! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.strings arrays assocs ui
ui.gadgets ui.backend ui.clipboards ui.gadgets.worlds
ui.gestures io kernel math math.vectors namespaces make
sequences strings vectors words windows.kernel32 windows.gdi32
windows.user32 windows.opengl32 windows.messages windows.types
windows.nt windows threads libc combinators fry
ui.gestures ui.event-loop io kernel math math.vectors namespaces
make sequences strings vectors words windows.kernel32
windows.gdi32 windows.user32 windows.opengl32 windows.messages
windows.types windows.nt windows threads libc combinators fry
combinators.short-circuit continuations command-line shuffle
opengl ui.render ascii math.bitwise locals symbols accessors
math.geometry.rect math.order ascii calendar
io.encodings.utf16n ;
math.geometry.rect math.order ascii calendar io.encodings.utf16n
;
IN: ui.windows
SINGLETON: windows-ui-backend
@ -574,7 +574,6 @@ M: windows-ui-backend set-title ( string world -- )
M: windows-ui-backend ui
[
[
stop-after-last-window? on
init-clipboard
init-win32-ui
start-ui

View File

@ -2,9 +2,9 @@
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien alien.c-types arrays ui ui.gadgets
ui.gestures ui.backend ui.clipboards ui.gadgets.worlds ui.render
assocs kernel math namespaces opengl sequences strings x11.xlib
x11.events x11.xim x11.glx x11.clipboard x11.constants
x11.windows io.encodings.string io.encodings.ascii
ui.event-loop assocs kernel math namespaces opengl sequences
strings x11.xlib x11.events x11.xim x11.glx x11.clipboard
x11.constants x11.windows io.encodings.string io.encodings.ascii
io.encodings.utf8 combinators command-line qualified
math.vectors classes.tuple opengl.gl threads math.geometry.rect
environment ascii ;
@ -281,7 +281,6 @@ M: x11-ui-backend ui ( -- )
[
f [
[
stop-after-last-window? on
init-clipboard
start-ui
event-loop

View File

@ -31,7 +31,6 @@ TYPEDEF: XID KeySym
TYPEDEF: ulong Atom
TYPEDEF: char* XPointer
TYPEDEF: void* Display*
TYPEDEF: void* Screen*
TYPEDEF: void* GC
TYPEDEF: void* Visual*
@ -66,6 +65,12 @@ TYPEDEF: void* Atom**
! 2 - Display Functions
!
! This struct is incomplete
C-STRUCT: Display
{ "void*" "ext_data" }
{ "void*" "free_funcs" }
{ "int" "fd" } ;
FUNCTION: Display* XOpenDisplay ( void* display_name ) ;
! 2.2 Obtaining Information about the Display, Image Formats, or Screens

View File

@ -1,6 +1,6 @@
USING: arrays bunny.model continuations destructors kernel
multiline opengl opengl.shaders opengl.capabilities opengl.gl
sequences sequences.lib accessors combinators ;
sequences accessors combinators ;
IN: bunny.cel-shaded
STRING: vertex-shader-source

View File

@ -2,8 +2,8 @@ USING: accessors alien.c-types arrays combinators destructors
http.client io io.encodings.ascii io.files kernel math
math.matrices math.parser math.vectors opengl
opengl.capabilities opengl.gl opengl.demo-support sequences
sequences.lib splitting vectors words
specialized-arrays.float specialized-arrays.uint ;
splitting vectors words specialized-arrays.float
specialized-arrays.uint ;
IN: bunny.model
: numbers ( str -- seq )
@ -27,7 +27,7 @@ IN: bunny.model
vneg normalize ;
: 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 )
over length { 0.0 0.0 0.0 } <array> -rot
@ -50,10 +50,10 @@ IN: bunny.model
] unless ;
: (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 -- )
GL_TRIANGLES [ [ (draw-triangle) ] each-with2 ] do-state ;
GL_TRIANGLES [ [ (draw-triangle) ] with with each ] do-state ;
TUPLE: bunny-dlist list ;
TUPLE: bunny-buffers array element-array nv ni ;