Merge branch 'maintenance' into experimental

db4
Alex Chapman 2009-04-16 13:39:29 +10:00
commit 122203d142
45 changed files with 76 additions and 67 deletions

View File

@ -6,8 +6,8 @@ math.functions math.vectors opengl opengl.gl opengl.glu
opengl.demo-support sequences specialized-arrays.float ; opengl.demo-support sequences specialized-arrays.float ;
IN: jamshred.gl IN: jamshred.gl
: min-vertices 6 ; inline : min-vertices ( -- n ) 6 ; inline
: max-vertices 32 ; inline : max-vertices ( -- n ) 32 ; inline
: n-vertices ( -- n ) 32 ; inline : n-vertices ( -- n ) 32 ; inline
@ -55,7 +55,7 @@ IN: jamshred.gl
: draw-segment ( next-segment segment -- ) : draw-segment ( next-segment segment -- )
GL_QUAD_STRIP [ GL_QUAD_STRIP [
[ draw-vertex-pair ] 2curry [ draw-vertex-pair ] 2curry
n-vertices equally-spaced-radians F{ 0.0 } append swap each n-vertices equally-spaced-radians float-array{ 0.0 } append swap each
] do-state ; ] do-state ;
: draw-segments ( segments -- ) : draw-segments ( segments -- )
@ -68,15 +68,13 @@ IN: jamshred.gl
: draw-tunnel ( player -- ) : draw-tunnel ( player -- )
segments-to-render draw-segments ; segments-to-render draw-segments ;
: init-graphics ( width height -- ) : init-graphics ( -- )
GL_DEPTH_TEST glEnable GL_DEPTH_TEST glEnable
GL_SCISSOR_TEST glDisable GL_SCISSOR_TEST glDisable
1.0 glClearDepth 1.0 glClearDepth
0.0 0.0 0.0 0.0 glClearColor 0.0 0.0 0.0 0.0 glClearColor
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear GL_PROJECTION glMatrixMode glPushMatrix
GL_PROJECTION glMatrixMode glLoadIdentity GL_MODELVIEW glMatrixMode glPushMatrix
dup 0 = [ 2drop ] [ / >float 45.0 swap 0.1 100.0 gluPerspective ] if
GL_MODELVIEW glMatrixMode glLoadIdentity
GL_LEQUAL glDepthFunc GL_LEQUAL glDepthFunc
GL_LIGHTING glEnable GL_LIGHTING glEnable
GL_LIGHT0 glEnable GL_LIGHT0 glEnable
@ -89,11 +87,26 @@ IN: jamshred.gl
GL_LIGHT0 GL_DIFFUSE float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv GL_LIGHT0 GL_DIFFUSE float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv
GL_LIGHT0 GL_SPECULAR float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv ; GL_LIGHT0 GL_SPECULAR float-array{ 1.0 1.0 1.0 1.0 } underlying>> glLightfv ;
: cleanup-graphics ( -- )
GL_DEPTH_TEST glDisable
GL_SCISSOR_TEST glEnable
GL_MODELVIEW glMatrixMode glPopMatrix
GL_PROJECTION glMatrixMode glPopMatrix
GL_LIGHTING glDisable
GL_LIGHT0 glDisable
GL_FOG glDisable
GL_COLOR_MATERIAL glDisable ;
: pre-draw ( width height -- )
GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
GL_PROJECTION glMatrixMode glLoadIdentity
dup 0 = [ 2drop ] [ / >float 45.0 swap 0.1 100.0 gluPerspective ] if
GL_MODELVIEW glMatrixMode glLoadIdentity ;
: player-view ( player -- ) : player-view ( player -- )
[ location>> ] [ location>> ]
[ [ location>> ] [ forward>> ] bi v+ ] [ [ location>> ] [ forward>> ] bi v+ ]
[ up>> ] tri gl-look-at ; [ up>> ] tri gl-look-at ;
: draw-jamshred ( jamshred width height -- ) : draw-jamshred ( jamshred width height -- )
init-graphics jamshred-player [ player-view ] [ draw-tunnel ] bi ; pre-draw jamshred-player [ player-view ] [ draw-tunnel ] bi ;

View File

@ -1,12 +1,12 @@
! Copyright (C) 2007, 2008 Alex Chapman ! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.geometry.rect math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ; USING: accessors arrays calendar jamshred.game jamshred.gl jamshred.player jamshred.log kernel math math.constants math.rectangles math.vectors namespaces sequences threads ui ui.backend ui.gadgets ui.gadgets.worlds ui.gestures ui.render ;
IN: jamshred IN: jamshred
TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ; TUPLE: jamshred-gadget < gadget { jamshred jamshred } last-hand-loc ;
: <jamshred-gadget> ( jamshred -- gadget ) : <jamshred-gadget> ( jamshred -- gadget )
jamshred-gadget new-gadget swap >>jamshred ; jamshred-gadget new swap >>jamshred ;
: default-width ( -- x ) 800 ; : default-width ( -- x ) 800 ;
: default-height ( -- y ) 600 ; : default-height ( -- y ) 600 ;
@ -15,7 +15,7 @@ M: jamshred-gadget pref-dim*
drop default-width default-height 2array ; drop default-width default-height 2array ;
M: jamshred-gadget draw-gadget* ( gadget -- ) M: jamshred-gadget draw-gadget* ( gadget -- )
[ jamshred>> ] [ rect-dim first2 draw-jamshred ] bi ; [ jamshred>> ] [ dim>> first2 draw-jamshred ] bi ;
: jamshred-loop ( gadget -- ) : jamshred-loop ( gadget -- )
dup jamshred>> quit>> [ dup jamshred>> quit>> [
@ -23,7 +23,7 @@ M: jamshred-gadget draw-gadget* ( gadget -- )
] [ ] [
[ jamshred>> jamshred-update ] [ jamshred>> jamshred-update ]
[ relayout-1 ] [ relayout-1 ]
[ 10 milliseconds sleep yield jamshred-loop ] tri [ 100 milliseconds sleep jamshred-loop ] tri
] if ; ] if ;
: fullscreen ( gadget -- ) : fullscreen ( gadget -- )
@ -36,10 +36,11 @@ M: jamshred-gadget draw-gadget* ( gadget -- )
[ fullscreen? not ] keep set-fullscreen* ; [ fullscreen? not ] keep set-fullscreen* ;
M: jamshred-gadget graft* ( gadget -- ) M: jamshred-gadget graft* ( gadget -- )
[ jamshred-loop ] curry in-thread ; [ find-gl-context init-graphics ]
[ [ jamshred-loop ] curry in-thread ] bi ;
M: jamshred-gadget ungraft* ( gadget -- ) M: jamshred-gadget ungraft* ( gadget -- )
jamshred>> t swap (>>quit) ; dup find-gl-context cleanup-graphics jamshred>> t swap (>>quit) ;
: jamshred-restart ( jamshred-gadget -- ) : jamshred-restart ( jamshred-gadget -- )
<jamshred> >>jamshred drop ; <jamshred> >>jamshred drop ;
@ -49,16 +50,15 @@ M: jamshred-gadget ungraft* ( gadget -- )
: x>radians ( x gadget -- theta ) : x>radians ( x gadget -- theta )
#! translate motion of x pixels to an angle #! translate motion of x pixels to an angle
rect-dim first pix>radians neg ; dim>> first pix>radians neg ;
: y>radians ( y gadget -- theta ) : y>radians ( y gadget -- theta )
#! translate motion of y pixels to an angle #! translate motion of y pixels to an angle
rect-dim second pix>radians ; dim>> second pix>radians ;
: (handle-mouse-motion) ( jamshred-gadget mouse-motion -- ) : (handle-mouse-motion) ( jamshred-gadget mouse-motion -- )
over jamshred>> >r dupd [ first swap x>radians ] [ second swap y>radians ] 2bi
[ first swap x>radians ] 2keep second swap y>radians rot jamshred>> mouse-moved ;
r> mouse-moved ;
: handle-mouse-motion ( jamshred-gadget -- ) : handle-mouse-motion ( jamshred-gadget -- )
hand-loc get [ hand-loc get [
@ -84,11 +84,11 @@ jamshred-gadget H{
{ T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] } { T{ key-down f f "LEFT" } [ jamshred>> 1 jamshred-roll ] }
{ T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] } { T{ key-down f f "RIGHT" } [ jamshred>> -1 jamshred-roll ] }
{ T{ key-down f f "q" } [ quit ] } { T{ key-down f f "q" } [ quit ] }
{ T{ motion } [ handle-mouse-motion ] } { motion [ handle-mouse-motion ] }
{ T{ mouse-scroll } [ handle-mouse-scroll ] } { mouse-scroll [ handle-mouse-scroll ] }
} set-gestures } set-gestures
: jamshred-window ( -- gadget ) : jamshred-window ( -- )
[ <jamshred> <jamshred-gadget> dup "Jamshred" open-window ] with-ui ; [ <jamshred> <jamshred-gadget> "Jamshred" open-window ] with-ui ;
MAIN: jamshred-window MAIN: jamshred-window

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Alex Chapman ! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays float-arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ; USING: accessors arrays kernel locals math math.constants math.functions math.matrices math.vectors math.quaternions random sequences ;
IN: jamshred.oint IN: jamshred.oint
! An oint is a point with three linearly independent unit vectors ! An oint is a point with three linearly independent unit vectors
@ -12,7 +12,7 @@ TUPLE: oint location forward up left ;
C: <oint> oint C: <oint> oint
: rotation-quaternion ( theta axis -- quaternion ) : rotation-quaternion ( theta axis -- quaternion )
swap 2 / dup cos swap sin rot n*v first3 rect> >r rect> r> 2array ; swap 2 / dup cos swap sin rot n*v first3 rect> [ rect> ] dip 2array ;
: rotate-vector ( q qrecip v -- v ) : rotate-vector ( q qrecip v -- v )
v>q swap q* q* q>v ; v>q swap q* q* q>v ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Alex Chapman ! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors colors combinators float-arrays jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle strings system ; USING: accessors colors.constants combinators jamshred.log jamshred.oint jamshred.sound jamshred.tunnel kernel locals math math.constants math.order math.ranges math.vectors math.matrices sequences shuffle specialized-arrays.float strings system ;
IN: jamshred.player IN: jamshred.player
TUPLE: player < oint TUPLE: player < oint
@ -16,11 +16,11 @@ TUPLE: player < oint
: max-speed ( -- speed ) 30.0 ; : max-speed ( -- speed ) 30.0 ;
: <player> ( name sounds -- player ) : <player> ( name sounds -- player )
[ F{ 0 0 5 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] 2dip [ float-array{ 0 0 5 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } ] 2dip
f f 0 default-speed player boa ; f f 0 default-speed player boa ;
: turn-player ( player x-radians y-radians -- ) : turn-player ( player x-radians y-radians -- )
>r over r> left-pivot up-pivot ; [ over ] dip left-pivot up-pivot ;
: roll-player ( player z-radians -- ) : roll-player ( player z-radians -- )
forward-pivot ; forward-pivot ;
@ -134,4 +134,4 @@ TUPLE: player < oint
[ update-time ] [ distance-to-move ] [ (move-player) 2drop ] tri ; [ update-time ] [ distance-to-move ] [ (move-player) 2drop ] tri ;
: update-player ( player -- ) : update-player ( player -- )
[ move-player ] [ nearest-segment>> white swap (>>color) ] bi ; [ move-player ] [ nearest-segment>> "white" named-color swap (>>color) ] bi ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Alex Chapman ! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors io.files kernel openal sequences ; USING: accessors io.pathnames kernel openal sequences ;
IN: jamshred.sound IN: jamshred.sound
TUPLE: sounds bang ; TUPLE: sounds bang ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2007, 2008 Alex Chapman ! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays float-arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences tools.test ; USING: accessors arrays jamshred.oint jamshred.tunnel kernel math.vectors sequences specialized-arrays.float tools.test ;
IN: jamshred.tunnel.tests IN: jamshred.tunnel.tests
[ 0 ] [ T{ segment f { 0 0 0 } f f f 0 } [ 0 ] [ T{ segment f { 0 0 0 } f f f 0 }
@ -14,7 +14,7 @@ IN: jamshred.tunnel.tests
[ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward number>> ] unit-test [ 3 ] [ <straight-tunnel> T{ oint f { 0 0 -3.25 } } 0 nearest-segment-forward number>> ] unit-test
[ F{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test [ float-array{ 0 0 0 } ] [ <straight-tunnel> T{ oint f { 0 0 -0.25 } } over first nearest-segment location>> ] unit-test
: test-segment-oint ( -- oint ) : test-segment-oint ( -- oint )
{ 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ; { 0 0 0 } { 0 0 -1 } { 0 1 0 } { -1 0 0 } <oint> ;

View File

@ -1,8 +1,6 @@
! Copyright (C) 2007, 2008 Alex Chapman ! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays colors combinators float-arrays kernel USING: accessors arrays colors combinators kernel locals math math.constants math.matrices math.order math.ranges math.vectors math.quadratic random sequences specialized-arrays.float vectors jamshred.oint ;
locals math math.constants math.matrices math.order math.ranges
math.vectors math.quadratic random sequences vectors jamshred.oint ;
IN: jamshred.tunnel IN: jamshred.tunnel
: n-segments ( -- n ) 5000 ; inline : n-segments ( -- n ) 5000 ; inline
@ -26,20 +24,20 @@ C: <segment> segment
: (random-segments) ( segments n -- segments ) : (random-segments) ( segments n -- segments )
dup 0 > [ dup 0 > [
>r dup peek random-segment over push r> 1- (random-segments) [ dup peek random-segment over push ] dip 1- (random-segments)
] [ drop ] if ; ] [ drop ] if ;
: default-segment-radius ( -- r ) 1 ; : default-segment-radius ( -- r ) 1 ;
: initial-segment ( -- segment ) : initial-segment ( -- segment )
F{ 0 0 0 } F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } float-array{ 0 0 0 } float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 }
0 random-color default-segment-radius <segment> ; 0 random-color default-segment-radius <segment> ;
: random-segments ( n -- segments ) : random-segments ( n -- segments )
initial-segment 1vector swap (random-segments) ; initial-segment 1vector swap (random-segments) ;
: simple-segment ( n -- segment ) : simple-segment ( n -- segment )
[ F{ 0 0 -1 } n*v F{ 0 0 -1 } F{ 0 1 0 } F{ -1 0 0 } ] keep [ float-array{ 0 0 -1 } n*v float-array{ 0 0 -1 } float-array{ 0 1 0 } float-array{ -1 0 0 } ] keep
random-color default-segment-radius <segment> ; random-color default-segment-radius <segment> ;
: simple-segments ( n -- segments ) : simple-segments ( n -- segments )
@ -58,12 +56,12 @@ C: <segment> segment
: nearer-segment ( segment segment oint -- segment ) : nearer-segment ( segment segment oint -- segment )
#! return whichever of the two segments is nearer to the oint #! return whichever of the two segments is nearer to the oint
>r 2dup r> tuck distance >r distance r> < -rot ? ; [ 2dup ] dip tuck distance [ distance ] dip < -rot ? ;
: (find-nearest-segment) ( nearest next oint -- nearest ? ) : (find-nearest-segment) ( nearest next oint -- nearest ? )
#! find the nearest of 'next' and 'nearest' to 'oint', and return #! find the nearest of 'next' and 'nearest' to 'oint', and return
#! t if the nearest hasn't changed #! t if the nearest hasn't changed
pick >r nearer-segment dup r> = ; pick [ nearer-segment dup ] dip = ;
: find-nearest-segment ( oint segments -- segment ) : find-nearest-segment ( oint segments -- segment )
dup first swap rest-slice rot [ (find-nearest-segment) ] curry dup first swap rest-slice rot [ (find-nearest-segment) ] curry
@ -78,9 +76,9 @@ C: <segment> segment
: nearest-segment ( segments oint start-segment -- segment ) : nearest-segment ( segments oint start-segment -- segment )
#! find the segment nearest to 'oint', and return it. #! find the segment nearest to 'oint', and return it.
#! start looking at segment 'start-segment' #! start looking at segment 'start-segment'
number>> over >r number>> over [
[ nearest-segment-forward ] 3keep [ nearest-segment-forward ] 3keep nearest-segment-backward
nearest-segment-backward r> nearer-segment ; ] dip nearer-segment ;
: get-segment ( segments n -- segment ) : get-segment ( segments n -- segment )
over sequence-index-range clamp-to-range swap nth ; over sequence-index-range clamp-to-range swap nth ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2007, 2008 Alex Chapman ! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs combinators hashtables kernel lists math USING: accessors ascii assocs combinators hashtables kernel lists math
namespaces make openal parser-combinators promises sequences namespaces make openal parser-combinators promises sequences
strings symbols synth synth.buffers unicode.case ; strings synth synth.buffers unicode.case ;
IN: morse IN: morse
<PRIVATE <PRIVATE
@ -135,7 +135,7 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
: intra-char-gap ( -- ) intra-char-gap-buffer queue ; : intra-char-gap ( -- ) intra-char-gap-buffer queue ;
: letter-gap ( -- ) letter-gap-buffer queue ; : letter-gap ( -- ) letter-gap-buffer queue ;
: beep-freq 880 ; : beep-freq ( -- n ) 880 ;
: <morse-buffer> ( -- buffer ) : <morse-buffer> ( -- buffer )
half-sample-freq <8bit-mono-buffer> ; half-sample-freq <8bit-mono-buffer> ;
@ -160,7 +160,7 @@ SYMBOLS: source dot-buffer dash-buffer intra-char-gap-buffer letter-gap-buffer ;
init-openal 1 gen-sources first source set make-buffers init-openal 1 gen-sources first source set make-buffers
call call
source get source-play source get source-play
] with-scope ; ] with-scope ; inline
: play-char ( ch -- ) : play-char ( ch -- )
[ intra-char-gap ] [ [ intra-char-gap ] [
@ -176,7 +176,7 @@ PRIVATE>
: play-as-morse* ( str unit-length -- ) : play-as-morse* ( str unit-length -- )
[ [
[ letter-gap ] [ ch>morse play-char ] interleave [ letter-gap ] [ ch>morse play-char ] interleave
] swap playing-morse ; ] swap playing-morse ; inline
: play-as-morse ( str -- ) : play-as-morse ( str -- )
0.05 play-as-morse* ; 0.05 play-as-morse* ; inline

View File

@ -1,7 +1,7 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types kernel alien alien.syntax shuffle USING: alien.c-types kernel alien alien.syntax shuffle
combinators.lib openal.backend namespaces system ; openal.backend namespaces system generalizations ;
IN: openal.macosx IN: openal.macosx
LIBRARY: alut LIBRARY: alut
@ -10,5 +10,5 @@ FUNCTION: void alutLoadWAVFile ( ALbyte* fileName, ALenum* format, void** data,
M: macosx load-wav-file ( path -- format data size frequency ) M: macosx load-wav-file ( path -- format data size frequency )
0 <int> f <void*> 0 <int> 0 <int> 0 <int> f <void*> 0 <int> 0 <int>
[ alutLoadWAVFile ] 4keep [ alutLoadWAVFile ] 4 nkeep
[ [ [ *int ] dip *void* ] dip *int ] dip *int ; [ [ [ *int ] dip *void* ] dip *int ] dip *int ;

View File

@ -1,8 +1,8 @@
! Copyright (C) 2007 Chris Double. ! Copyright (C) 2007 Chris Double.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: kernel arrays alien system combinators alien.syntax namespaces USING: kernel accessors arrays alien system combinators alien.syntax namespaces
alien.c-types sequences vocabs.loader shuffle alien.c-types sequences vocabs.loader shuffle
openal.backend specialized-arrays.uint ; openal.backend specialized-arrays.uint alien.libraries generalizations ;
IN: openal IN: openal
<< "alut" { << "alut" {
@ -245,13 +245,11 @@ SYMBOL: init
f init set-global f init set-global
] unless ; ] unless ;
: <uint-array> ( n -- byte-array ) "ALuint" <c-array> ;
: gen-sources ( size -- seq ) : gen-sources ( size -- seq )
dup <uint-array> 2dup underlying>> alGenSources swap ; dup <uint-array> [ alGenSources ] keep ;
: gen-buffers ( size -- seq ) : gen-buffers ( size -- seq )
dup <uint-array> 2dup underlying>> alGenBuffers swap ; dup <uint-array> [ alGenBuffers ] keep ;
: gen-buffer ( -- buffer ) 1 gen-buffers first ; : gen-buffer ( -- buffer ) 1 gen-buffers first ;
@ -264,10 +262,10 @@ os macosx? "openal.macosx" "openal.other" ? require
: create-buffer-from-wav ( filename -- buffer ) : create-buffer-from-wav ( filename -- buffer )
gen-buffer dup rot load-wav-file gen-buffer dup rot load-wav-file
[ alBufferData ] 4keep alutUnloadWAV ; [ alBufferData ] 4 nkeep alutUnloadWAV ;
: queue-buffers ( source buffers -- ) : queue-buffers ( source buffers -- )
[ length ] [ >uint-array underlying>> ] bi alSourceQueueBuffers ; [ length ] [ >uint-array ] bi alSourceQueueBuffers ;
: queue-buffer ( source buffer -- ) : queue-buffer ( source buffer -- )
1array queue-buffers ; 1array queue-buffers ;

View File

@ -1,6 +1,6 @@
! Copyright (C) 2008 Alex Chapman ! Copyright (C) 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged ; USING: accessors alien.c-types combinators kernel locals math math.ranges openal sequences sequences.merged specialized-arrays.uchar specialized-arrays.short ;
IN: synth.buffers IN: synth.buffers
TUPLE: buffer sample-freq 8bit? id ; TUPLE: buffer sample-freq 8bit? id ;
@ -57,11 +57,11 @@ M: 8bit-stereo-buffer buffer-data
M: 16bit-stereo-buffer buffer-data M: 16bit-stereo-buffer buffer-data
interleaved-stereo-data 16bit-buffer-data ; interleaved-stereo-data 16bit-buffer-data ;
: telephone-sample-freq 8000 ; : telephone-sample-freq ( -- n ) 8000 ;
: half-sample-freq 22050 ; : half-sample-freq ( -- n ) 22050 ;
: cd-sample-freq 44100 ; : cd-sample-freq ( -- n ) 44100 ;
: digital-sample-freq 48000 ; : digital-sample-freq ( -- n ) 48000 ;
: professional-sample-freq 88200 ; : professional-sample-freq ( -- n ) 88200 ;
: send-buffer ( buffer -- buffer ) : send-buffer ( buffer -- buffer )
{ {