Merge branch 'master' of git://factorcode.org/git/factor
commit
bb61580171
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! 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.syntax destructors accessors kernel calendar ;
|
USING: alien.syntax destructors accessors kernel ;
|
||||||
IN: core-foundation
|
IN: core-foundation
|
||||||
|
|
||||||
TYPEDEF: void* CFTypeRef
|
TYPEDEF: void* CFTypeRef
|
||||||
|
@ -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 ) ;
|
||||||
|
|
||||||
|
@ -30,10 +28,3 @@ M: CFRelease-destructor dispose* alien>> CFRelease ;
|
||||||
|
|
||||||
: |CFRelease ( alien -- alien )
|
: |CFRelease ( alien -- alien )
|
||||||
dup f CFRelease-destructor boa |dispose drop ; inline
|
dup f CFRelease-destructor boa |dispose drop ; inline
|
||||||
|
|
||||||
: >CFTimeInterval ( duration -- interval )
|
|
||||||
duration>seconds ; inline
|
|
||||||
|
|
||||||
: >CFAbsoluteTime ( timestamp -- time )
|
|
||||||
T{ timestamp { year 2001 } { month 1 } { day 1 } } time-
|
|
||||||
duration>seconds ; inline
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -3,7 +3,8 @@
|
||||||
USING: accessors alien alien.syntax kernel math namespaces
|
USING: accessors alien alien.syntax kernel math namespaces
|
||||||
sequences destructors combinators threads heaps deques calendar
|
sequences destructors combinators threads heaps deques calendar
|
||||||
core-foundation core-foundation.strings
|
core-foundation core-foundation.strings
|
||||||
core-foundation.file-descriptors core-foundation.timers ;
|
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
|
||||||
|
|
|
@ -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 calendar ;
|
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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -0,0 +1,4 @@
|
||||||
|
IN: ui.event-loop.tests
|
||||||
|
USING: ui.event-loop tools.test ;
|
||||||
|
|
||||||
|
\ event-loop must-infer
|
|
@ -1,12 +1,11 @@
|
||||||
! 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: ui.backend kernel namespaces sequences deques calendar
|
USING: calendar combinators deques kernel namespaces sequences
|
||||||
threads ;
|
threads ui ui.backend ui.gadgets ;
|
||||||
IN: ui.event-loop
|
IN: ui.event-loop
|
||||||
|
|
||||||
: event-loop? ( -- ? )
|
: event-loop? ( -- ? )
|
||||||
{
|
{
|
||||||
{ [ stop-after-last-window? get not ] [ t ] }
|
|
||||||
{ [ graft-queue deque-empty? not ] [ t ] }
|
{ [ graft-queue deque-empty? not ] [ t ] }
|
||||||
{ [ windows get-global empty? not ] [ t ] }
|
{ [ windows get-global empty? not ] [ t ] }
|
||||||
[ f ]
|
[ f ]
|
||||||
|
@ -14,6 +13,6 @@ IN: ui.event-loop
|
||||||
|
|
||||||
HOOK: do-events ui-backend ( -- )
|
HOOK: do-events ui-backend ( -- )
|
||||||
|
|
||||||
: event-loop ( quot -- ) [ event-loop? ] [ do-events ] [ ] while ;
|
: event-loop ( -- ) [ event-loop? ] [ do-events ] [ ] while ;
|
||||||
|
|
||||||
: ui-wait ( -- ) 10 milliseconds sleep ;
|
: 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
|
||||||
|
|
|
@ -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,8 +10,6 @@ IN: ui
|
||||||
! Assoc mapping aliens to gadgets
|
! Assoc mapping aliens to gadgets
|
||||||
SYMBOL: windows
|
SYMBOL: windows
|
||||||
|
|
||||||
SYMBOL: stop-after-last-window?
|
|
||||||
|
|
||||||
: 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 ;
|
||||||
|
@ -207,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 ;
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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