diff --git a/basis/windows/com/com-tests.factor b/basis/windows/com/com-tests.factor index cd67fd19d2..289581a929 100755 --- a/basis/windows/com/com-tests.factor +++ b/basis/windows/com/com-tests.factor @@ -45,7 +45,7 @@ C: test-implementation } } { "IUnrelated" { [ swap x>> + ] ! IUnrelated::xPlus - [ spin x>> * + ] ! IUnrealted::xMulAdd + [ spin x>> * + ] ! IUnrelated::xMulAdd } } } dup +test-wrapper+ set [ diff --git a/basis/windows/com/wrapper/wrapper.factor b/basis/windows/com/wrapper/wrapper.factor index 40c61dfbe7..782ebae516 100755 --- a/basis/windows/com/wrapper/wrapper.factor +++ b/basis/windows/com/wrapper/wrapper.factor @@ -1,11 +1,11 @@ -USING: alien alien.c-types windows.com.syntax +USING: alien alien.c-types windows.com.syntax init windows.com.syntax.private windows.com continuations kernel namespaces windows.ole32 libc vocabs assocs accessors arrays sequences quotations combinators math words compiler.units -destructors fry math.parser generalizations ; +destructors fry math.parser generalizations sets ; IN: windows.com.wrapper -TUPLE: com-wrapper vtbls disposed ; +TUPLE: com-wrapper callbacks vtbls disposed ; malloc ( byte-array -- alien ) [ byte-length malloc ] [ over byte-array>memory ] bi ; : (callback-word) ( function-name interface-name counter -- word ) @@ -99,7 +103,7 @@ unless [ dup empty? [ 2drop [ ] ] [ swap 1- '[ , , ndip ] ] if ] dip compose ; -: (make-vtbl) ( interface-name quots iunknown-methods n -- vtbl ) +: (make-interface-callbacks) ( interface-name quots iunknown-methods n -- words ) (thunk) (thunked-quots) swap [ find-com-interface-definition family-tree-functions ] keep (next-vtbl-counter) '[ @@ -114,12 +118,12 @@ unless first2 (finish-thunk) ] bi* "stdcall" swap compile-alien-callback - ] 2map >c-void*-array - (byte-array-to-malloced-buffer) ; + ] 2map ; -: (make-vtbls) ( implementations -- vtbls ) +: (make-callbacks) ( implementations -- sequence ) dup [ first ] map (make-iunknown-methods) - [ >r >r first2 r> r> swap (make-vtbl) ] curry map-index ; + [ >r >r first2 r> r> swap (make-interface-callbacks) ] + curry map-index ; : (malloc-wrapped-object) ( wrapper -- wrapped-object ) vtbls>> length "void*" heap-size * @@ -127,13 +131,34 @@ unless over 1 0 rot set-ulong-nth ; +: (callbacks>vtbl) ( callbacks -- vtbl ) + [ execute ] map >c-void*-array byte-array>malloc ; +: (callbacks>vtbls) ( callbacks -- vtbls ) + [ (callbacks>vtbl) ] map ; + +: (allocate-wrapper) ( wrapper -- ) + dup callbacks>> (callbacks>vtbls) >>vtbls + f >>disposed drop ; + +: (init-hook) ( -- ) + +live-wrappers+ get-global [ (allocate-wrapper) ] each + H{ } +wrapped-objects+ set-global ; + +[ (init-hook) ] "windows.com.wrapper" add-init-hook + PRIVATE> +: allocate-wrapper ( wrapper -- ) + [ (allocate-wrapper) ] + [ +live-wrappers+ get adjoin ] bi ; + : ( implementations -- wrapper ) - (make-vtbls) f com-wrapper boa ; + (make-callbacks) f f com-wrapper boa + dup allocate-wrapper ; M: com-wrapper dispose* - vtbls>> [ free ] each ; + [ [ free ] each f ] change-vtbls + +live-wrappers+ get-global delete ; : com-wrap ( object wrapper -- wrapped-object ) [ vtbls>> ] [ (malloc-wrapped-object) ] bi diff --git a/extra/bunny/cel-shaded/cel-shaded.factor b/extra/bunny/cel-shaded/cel-shaded.factor index 8285cd776f..e481b47161 100644 --- a/extra/bunny/cel-shaded/cel-shaded.factor +++ b/extra/bunny/cel-shaded/cel-shaded.factor @@ -1,6 +1,6 @@ USING: arrays bunny.model continuations destructors kernel multiline opengl opengl.shaders opengl.capabilities opengl.gl -sequences sequences.lib accessors ; +sequences sequences.lib accessors combinators ; IN: bunny.cel-shaded STRING: vertex-shader-source @@ -78,13 +78,15 @@ TUPLE: bunny-cel-shaded program ; ] [ f ] if ; : (draw-cel-shaded-bunny) ( geom program -- ) - { - { "light_direction" [ 1.0 -1.0 1.0 glUniform3f ] } - { "color" [ 0.6 0.5 0.5 1.0 glUniform4f ] } - { "ambient" [ 0.2 0.2 0.2 0.2 glUniform4f ] } - { "diffuse" [ 0.8 0.8 0.8 0.8 glUniform4f ] } - { "shininess" [ 100.0 glUniform1f ] } - } [ bunny-geom ] with-gl-program ; + [ + { + [ "light_direction" glGetUniformLocation 1.0 -1.0 1.0 glUniform3f ] + [ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ] + [ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ] + [ "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ] + [ "shininess" glGetUniformLocation 100.0 glUniform1f ] + } cleave bunny-geom + ] with-gl-program ; M: bunny-cel-shaded draw-bunny program>> (draw-cel-shaded-bunny) ; diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index fcba98a0e9..bf757c4fb3 100755 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -220,13 +220,14 @@ TUPLE: bunny-outlined [ normal-texture>> GL_TEXTURE_2D GL_TEXTURE1 bind-texture-unit ] [ depth-texture>> GL_TEXTURE_2D GL_TEXTURE2 bind-texture-unit ] [ - pass2-program>> { - { "colormap" [ 0 glUniform1i ] } - { "normalmap" [ 1 glUniform1i ] } - { "depthmap" [ 2 glUniform1i ] } - { "line_color" [ 0.1 0.0 0.1 1.0 glUniform4f ] } - } [ { -1.0 -1.0 } { 1.0 1.0 } rect-vertices ] - with-gl-program + pass2-program>> [ + { + [ "colormap" glGetUniformLocation 0 glUniform1i ] + [ "normalmap" glGetUniformLocation 1 glUniform1i ] + [ "depthmap" glGetUniformLocation 2 glUniform1i ] + [ "line_color" glGetUniformLocation 0.1 0.0 0.1 1.0 glUniform4f ] + } cleave { -1.0 -1.0 } { 1.0 1.0 } rect-vertices + ] with-gl-program ] } cleave ; diff --git a/extra/game-input/backend/backend.factor b/extra/game-input/backend/backend.factor index 451bbf1c34..a31b9d6649 100644 --- a/extra/game-input/backend/backend.factor +++ b/extra/game-input/backend/backend.factor @@ -1,8 +1,19 @@ -USING: kernel system combinators parser ; +USING: multiline system parser combinators ; IN: game-input.backend -<< { - { [ os macosx? ] [ "game-input.backend.iokit" use+ ] } - { [ os windows? ] [ "game-input.backend.dinput" use+ ] } +STRING: set-backend-for-macosx +USING: namespaces game-input.backend.iokit game-input ; +iokit-game-input-backend game-input-backend set-global +; + +STRING: set-backend-for-windows +USING: namespaces game-input.backend.dinput game-input ; +dinput-game-input-backend game-input-backend set-global +; + +{ + { [ os macosx? ] [ set-backend-for-macosx eval ] } + { [ os windows? ] [ set-backend-for-windows eval ] } { [ t ] [ ] } -} cond >> +} cond + diff --git a/extra/game-input/backend/dinput/dinput.factor b/extra/game-input/backend/dinput/dinput.factor index 69b2d41962..73c9f511a1 100755 --- a/extra/game-input/backend/dinput/dinput.factor +++ b/extra/game-input/backend/dinput/dinput.factor @@ -206,6 +206,13 @@ M: dinput-game-input-backend (close-game-input) close-device-change-window delete-dinput ; +M: dinput-game-input-backend (reset-game-input) + { + +dinput+ +keyboard-device+ +keyboard-state+ + +controller-devices+ +controller-guids+ + +device-change-window+ +device-change-handle+ + } [ f swap set-global ] each ; + M: dinput-game-input-backend get-controllers +controller-devices+ get [ drop controller boa ] { } assoc>map ; @@ -278,5 +285,3 @@ M: dinput-game-input-backend read-keyboard +keyboard-device+ get [ +keyboard-state+ get [ keys>> underlying>> get-device-state ] keep ] [ ] [ f ] with-acquisition ; - -dinput-game-input-backend game-input-backend set-global diff --git a/extra/game-input/backend/iokit/iokit.factor b/extra/game-input/backend/iokit/iokit.factor index 1871569227..dcdfa6d192 100755 --- a/extra/game-input/backend/iokit/iokit.factor +++ b/extra/game-input/backend/iokit/iokit.factor @@ -231,6 +231,10 @@ M: iokit-game-input-backend (open-game-input) ] } cleave ; +M: iokit-game-input-backend (reset-game-input) + { +hid-manager+ +keyboard-state+ +controller-states+ } + [ f swap set-global ] each ; + M: iokit-game-input-backend (close-game-input) +hid-manager+ get-global [ +hid-manager+ global [ @@ -271,5 +275,3 @@ M: iokit-game-input-backend read-keyboard ( -- keyboard-state ) M: iokit-game-input-backend calibrate-controller ( controller -- ) drop ; - -iokit-game-input-backend game-input-backend set-global diff --git a/extra/game-input/game-input.factor b/extra/game-input/game-input.factor index 4d25b06ead..208c8476fc 100755 --- a/extra/game-input/game-input.factor +++ b/extra/game-input/game-input.factor @@ -1,26 +1,34 @@ USING: arrays accessors continuations kernel symbols -combinators.lib sequences namespaces init ; +combinators.lib sequences namespaces init vocabs ; IN: game-input SYMBOLS: game-input-backend game-input-opened ; HOOK: (open-game-input) game-input-backend ( -- ) HOOK: (close-game-input) game-input-backend ( -- ) +HOOK: (reset-game-input) game-input-backend ( -- ) : game-input-opened? ( -- ? ) game-input-opened get ; - : open-game-input ( -- ) + load-game-input-backend game-input-opened? [ (open-game-input) game-input-opened on diff --git a/extra/html/streams/streams.factor b/extra/html/streams/streams.factor index 76719b6ffa..d21c743dcd 100755 --- a/extra/html/streams/streams.factor +++ b/extra/html/streams/streams.factor @@ -50,8 +50,8 @@ TUPLE: html-sub-stream < html-stream style parent ; ] [ call ] if* ; inline : hex-color, ( color -- ) - { [ red>> ] [ green>> ] [ blue>> ] } cleave 3array - [ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] each ; + [ red>> ] [ green>> ] [ blue>> ] tri + [ 255 * >fixnum >hex 2 CHAR: 0 pad-left % ] tri@ ; : fg-css, ( color -- ) "color: #" % hex-color, "; " % ; diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index 0c9fdee6e0..a524168d54 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -3,7 +3,7 @@ USING: accessors kernel threads combinators concurrency.mailboxes sequences strings hashtables splitting fry assocs hashtables colors - sorting qualified unicode.case math.order + sorting qualified unicode.collation math.order ui ui.gadgets ui.gadgets.panes ui.gadgets.editors ui.gadgets.scrollers ui.commands ui.gadgets.frames ui.gestures ui.gadgets.tabs ui.gadgets.grids ui.gadgets.packs ui.gadgets.labels @@ -76,6 +76,14 @@ M: quit write-irc " has left IRC" dark-red write-color trailing>> dot-or-parens dark-red write-color ; +M: kick write-irc + "* " dark-red write-color + [ prefix>> parse-name write ] keep + " has kicked " dark-red write-color + [ who>> write ] keep + " from the channel" dark-red write-color + trailing>> dot-or-parens dark-red write-color ; + : full-mode ( message -- mode ) parameters>> rest " " sjoin ; @@ -126,7 +134,7 @@ M: irc-message write-irc GENERIC: handle-inbox ( tab message -- ) : value-labels ( assoc val -- seq ) - '[ nip , = ] assoc-filter keys [ >lower <=> ] sort [