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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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. ! 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

View File

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

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

View File

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

View File

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

View File

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

View File

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

View File

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

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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