steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'master' of git://repo.or.cz/factor/jcg

db4
Slava Pestov 2008-08-04 14:58:13 -05:00
parent 175b6deee5 af80e5c97f
commit 6b058d6bee
13 changed files with 111 additions and 82 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
basis/windows/com/com-tests.factor
View File

@ -45,7 +45,7 @@ C: <test-implementation> test-implementation
} }
{ "IUnrelated" {
[ swap x>> + ] ! IUnrelated::xPlus
[ spin x>> * + ] ! IUnrealted::xMulAdd
[ spin x>> * + ] ! IUnrelated::xMulAdd
} }
} <com-wrapper>
dup +test-wrapper+ set [

53
basis/windows/com/wrapper/wrapper.factor
View File

@ -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 ;
<PRIVATE
@ -14,6 +14,11 @@ SYMBOL: +wrapped-objects+
[ H{ } +wrapped-objects+ set-global ]
unless
SYMBOL: +live-wrappers+
+live-wrappers+ get-global
[ V{ } +live-wrappers+ set-global ]
unless
SYMBOL: +vtbl-counter+
+vtbl-counter+ get-global
[ 0 +vtbl-counter+ set-global ]
@ -82,13 +87,12 @@ unless
[ '[ , [ swap 2array ] curry map ] ] bi bi*
swap append ;
: compile-alien-callback ( word return parameters abi quot -- alien )
: compile-alien-callback ( word return parameters abi quot -- word )
'[ , , , , alien-callback ]
[ [ (( -- alien )) define-declared ] pick slip ]
with-compilation-unit
execute ;
with-compilation-unit ;
: (byte-array-to-malloced-buffer) ( byte-array -- alien )
: byte-array>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 <displaced-alien>
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 ;
: <com-wrapper> ( 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

18
extra/bunny/cel-shaded/cel-shaded.factor
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 ;
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) ;

15
extra/bunny/outlined/outlined.factor
View File

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

21
extra/game-input/backend/backend.factor
View File

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

9
extra/game-input/backend/dinput/dinput.factor
View File

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

6
extra/game-input/backend/iokit/iokit.factor
View File

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

14
extra/game-input/game-input.factor
View File

@ -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 ;
<PRIVATE
M: f (reset-game-input) ;
: reset-game-input ( -- )
game-input-opened off ;
game-input-opened off
(reset-game-input) ;
: load-game-input-backend ( -- )
game-input-backend get
[ "game-input.backend" load-vocab drop ] unless ;
[ reset-game-input ] "game-input" add-init-hook
PRIVATE>
: open-game-input ( -- )
load-game-input-backend
game-input-opened? [
(open-game-input)
game-input-opened on

2
extra/joystick-demo/joystick-demo.factor
View File

@ -1,6 +1,6 @@
USING: ui ui.gadgets sequences kernel arrays math colors
ui.render math.vectors accessors fry ui.gadgets.packs game-input
game-input.backend ui.gadgets.labels ui.gadgets.borders alarms
ui.gadgets.labels ui.gadgets.borders alarms
calendar locals combinators.lib strings ui.gadgets.buttons
combinators math.parser assocs threads ;
IN: joystick-demo

2
extra/key-caps/key-caps.factor
View File

@ -1,4 +1,4 @@
USING: game-input game-input.backend game-input.scancodes
USING: game-input game-input.scancodes
kernel ui.gadgets ui.gadgets.buttons sequences accessors
words arrays assocs math calendar fry alarms ui
ui.gadgets.borders ui.gestures ;

15
extra/opengl/shaders/shaders-docs.factor
View File

@ -95,18 +95,7 @@ HELP: delete-gl-program
{ $description "Deletes the program object, invalidating it and releasing any resources allocated for it by the OpenGL implementation. Any attached " { $link gl-shader } "s are also deleted.\n\nIf the shader objects should be preserved, they should each be detached using " { $link detach-gl-program-shader } ". The program object can then be destroyed alone using " { $link delete-gl-program-only } "." } ;
HELP: with-gl-program
{ $values { "program" "A " { $link gl-program } " object" } { "uniforms" "An " { $link assoc } " between uniform parameter names and quotations with effect " { $snippet "( uniform-location -- )" } } { "quot" "A quotation" } }
{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in the dynamic extent of " { $snippet "quot" } ". The fixed-function pipeline is restored at the end of " { $snippet "quot" } ". Before calling " { $snippet "quot" } ", calls " { $link glGetUniformLocation } " on each key of " { $snippet "uniforms" } " to get the address of the uniform parameter, which is then placed on top of the stack as the associated quotation is called.\n\nExample:" }
{ $code <"
! From bunny.cel-shaded
: (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 ;
"> } ;
{ $values { "program" "A " { $link gl-program } " object" } { "quot" "A quotation with stack effect " { $snippet "( program -- )" } } }
{ $description "Enables " { $snippet "program" } " for all OpenGL calls made in the dynamic extent of " { $snippet "quot" } ". " { $snippet "program" } " is left on the top of the stack when " { $snippet "quot" } " is called. The fixed-function pipeline is restored at the end of " { $snippet "quot" } "." } ;
ABOUT: "gl-utilities"

20
extra/opengl/shaders/shaders.factor
View File

@ -2,7 +2,7 @@
! 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 ;
combinators.lib macros arrays io.encodings.ascii fry ;
IN: opengl.shaders
: with-gl-shader-source-ptr ( string quot -- )
@ -107,22 +107,8 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ;
2dup detach-gl-program-shader delete-gl-shader
] each delete-gl-program-only ;
: (with-gl-program) ( program quot -- )
swap glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
: (with-gl-program-uniforms) ( uniforms -- quot )
[ [ swap , \ glGetUniformLocation , % ] [ ] make ]
{ } assoc>map ;
: (make-with-gl-program) ( uniforms quot -- q )
[
\ dup ,
[ swap (with-gl-program-uniforms) , \ cleave , % ]
[ ] make ,
\ (with-gl-program) ,
] [ ] make ;
MACRO: with-gl-program ( uniforms quot -- )
(make-with-gl-program) ;
: with-gl-program ( program quot -- )
over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline
PREDICATE: gl-program < integer (gl-program?) ;

16
extra/spheres/spheres.factor
View File

@ -194,10 +194,9 @@ M: spheres-gadget pref-dim* ( gadget -- dim )
: sphere-scene ( gadget -- )
GL_DEPTH_BUFFER_BIT GL_COLOR_BUFFER_BIT bitor glClear
[
solid-sphere-program>> dup {
{ "light_position" [ 0.0 0.0 100.0 glUniform3f ] }
} [
solid-sphere-program>> [
{
[ "light_position" glGetUniformLocation 0.0 0.0 100.0 glUniform3f ]
[ { 7.0 0.0 0.0 } 1.0 { 1.0 0.0 0.0 1.0 } (draw-sphere) ]
[ { -7.0 0.0 0.0 } 1.0 { 0.0 1.0 0.0 1.0 } (draw-sphere) ]
[ { 0.0 0.0 7.0 } 1.0 { 0.0 0.0 1.0 1.0 } (draw-sphere) ]
@ -207,7 +206,8 @@ M: spheres-gadget pref-dim* ( gadget -- dim )
} cleave
] with-gl-program
] [
plane-program>> { } [
plane-program>> [
drop
GL_QUADS [
-1000.0 -30.0 1000.0 glVertex3f
-1000.0 -30.0 -1000.0 glVertex3f
@ -269,10 +269,10 @@ M: spheres-gadget draw-gadget* ( gadget -- )
[ sphere-scene ]
[ reflection-texture>> GL_TEXTURE_CUBE_MAP GL_TEXTURE0 bind-texture-unit ]
[
texture-sphere-program>> dup {
{ "surface_texture" [ 0 glUniform1i ] }
} [
{ 0.0 0.0 0.0 } 4.0 { 1.0 0.0 0.0 1.0 } (draw-sphere)
texture-sphere-program>> [
[ "surface_texture" glGetUniformLocation 0 glUniform1i ]
[ { 0.0 0.0 0.0 } 4.0 { 1.0 0.0 0.0 1.0 } (draw-sphere) ]
bi
] with-gl-program
]
} cleave ;