Merge branch 'master' of git://factorcode.org/git/factor
						commit
						6efbe50543
					
				| 
						 | 
				
			
			@ -1,3 +1,4 @@
 | 
			
		|||
Slava Pestov
 | 
			
		||||
Eduardo Cavazos
 | 
			
		||||
Joe Groff
 | 
			
		||||
Alex Chapman
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1 +1 @@
 | 
			
		|||
Slava Pestov
 | 
			
		||||
Alex Chapman
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1 +0,0 @@
 | 
			
		|||
Slava Pestov
 | 
			
		||||
| 
						 | 
				
			
			@ -3,7 +3,7 @@
 | 
			
		|||
! Portions copyright (C) 2008 Joe Groff.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: alien alien.c-types continuations kernel libc math macros
 | 
			
		||||
namespaces math.vectors math.parser opengl.gl opengl.glu combinators
 | 
			
		||||
namespaces math.vectors math.parser opengl.gl combinators
 | 
			
		||||
combinators.smart arrays sequences splitting words byte-arrays assocs
 | 
			
		||||
colors colors.constants accessors generalizations locals fry
 | 
			
		||||
specialized-arrays.float specialized-arrays.uint ;
 | 
			
		||||
| 
						 | 
				
			
			@ -16,10 +16,23 @@ IN: opengl
 | 
			
		|||
: gl-clear ( color -- )
 | 
			
		||||
    gl-clear-color GL_COLOR_BUFFER_BIT glClear ;
 | 
			
		||||
 | 
			
		||||
: error>string ( n -- string )
 | 
			
		||||
    H{
 | 
			
		||||
        { HEX: 0 "No error" }
 | 
			
		||||
        { HEX: 0501 "Invalid value" }
 | 
			
		||||
        { HEX: 0500 "Invalid enumerant" }
 | 
			
		||||
        { HEX: 0502 "Invalid operation" }
 | 
			
		||||
        { HEX: 0503 "Stack overflow" }
 | 
			
		||||
        { HEX: 0504 "Stack underflow" }
 | 
			
		||||
        { HEX: 0505 "Out of memory" }
 | 
			
		||||
    } at "Unknown error" or ;
 | 
			
		||||
 | 
			
		||||
TUPLE: gl-error code string ;
 | 
			
		||||
 | 
			
		||||
: gl-error ( -- )
 | 
			
		||||
    glGetError dup zero? [
 | 
			
		||||
        "GL error: " over gluErrorString append throw
 | 
			
		||||
    ] unless drop ;
 | 
			
		||||
    glGetError dup 0 = [ drop ] [
 | 
			
		||||
        dup error>string \ gl-error boa throw
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: do-enabled ( what quot -- )
 | 
			
		||||
    over glEnable dip glDisable ; inline
 | 
			
		||||
| 
						 | 
				
			
			@ -151,9 +164,6 @@ MACRO: all-enabled-client-state ( seq quot -- )
 | 
			
		|||
MACRO: set-draw-buffers ( buffers -- )
 | 
			
		||||
    words>values '[ _ (set-draw-buffers) ] ;
 | 
			
		||||
 | 
			
		||||
: gl-look-at ( eye focus up -- )
 | 
			
		||||
    [ first3 ] tri@ gluLookAt ;
 | 
			
		||||
 | 
			
		||||
: gen-dlist ( -- id ) 1 glGenLists ;
 | 
			
		||||
 | 
			
		||||
: make-dlist ( type quot -- id )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -102,8 +102,10 @@ MEMO: simple-category-table ( -- table )
 | 
			
		|||
        { CHAR: s dotall }
 | 
			
		||||
    } ;
 | 
			
		||||
 | 
			
		||||
ERROR: nonexistent-option name ;
 | 
			
		||||
 | 
			
		||||
: ch>option ( ch -- singleton )
 | 
			
		||||
    options-assoc at ;
 | 
			
		||||
    dup options-assoc at [ ] [ nonexistent-option ] ?if ;
 | 
			
		||||
 | 
			
		||||
: option>ch ( option -- string )
 | 
			
		||||
    options-assoc value-at ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! Copyright (C) 2005, 2009 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: math.rectangles math.vectors namespaces kernel accessors
 | 
			
		||||
assocs combinators sequences opengl opengl.gl opengl.glu colors
 | 
			
		||||
assocs combinators sequences opengl opengl.gl colors
 | 
			
		||||
colors.constants ui.gadgets ui.pens ;
 | 
			
		||||
IN: ui.render
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -22,7 +22,7 @@ SYMBOL: viewport-translation
 | 
			
		|||
        dim>>
 | 
			
		||||
        [ { 0 1 } v* viewport-translation set ]
 | 
			
		||||
        [ [ { 0 0 } ] dip gl-viewport ]
 | 
			
		||||
        [ [ 0 ] dip first2 0 gluOrtho2D ] tri
 | 
			
		||||
        [ [ 0 ] dip first2 0 1 -1 glOrtho ] tri
 | 
			
		||||
    ]
 | 
			
		||||
    [ clip set ] bi
 | 
			
		||||
    do-clip ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,4 +1,4 @@
 | 
			
		|||
USING: kernel namespaces math.vectors opengl 4DNav.turtle  ;
 | 
			
		||||
USING: kernel namespaces math.vectors opengl opengl.glu 4DNav.turtle  ;
 | 
			
		||||
 | 
			
		||||
IN: 4DNav.camera
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -71,13 +71,13 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
 | 
			
		|||
    {
 | 
			
		||||
        [ length id3v1-offset >= ]
 | 
			
		||||
        [ id3v1-length tail-slice* "TAG" head? ]
 | 
			
		||||
    } 1&& ; inline
 | 
			
		||||
    } 1&& ;
 | 
			
		||||
 | 
			
		||||
: id3v1+? ( seq -- ? )
 | 
			
		||||
    {
 | 
			
		||||
        [ length id3v1+-offset >= ]
 | 
			
		||||
        [ id3v1+-length tail-slice* "TAG+" head? ]
 | 
			
		||||
    } 1&& ; inline
 | 
			
		||||
    } 1&& ;
 | 
			
		||||
 | 
			
		||||
: pair>frame ( string key -- frame/f )
 | 
			
		||||
    over [
 | 
			
		||||
| 
						 | 
				
			
			@ -86,7 +86,7 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
 | 
			
		|||
            swap >>data
 | 
			
		||||
    ] [
 | 
			
		||||
        2drop f
 | 
			
		||||
    ] if ; inline
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: id3v1>frames ( id3v1 -- seq )
 | 
			
		||||
    [
 | 
			
		||||
| 
						 | 
				
			
			@ -101,25 +101,25 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
 | 
			
		|||
    ] output>array sift ;
 | 
			
		||||
 | 
			
		||||
: seq>synchsafe ( seq -- n )
 | 
			
		||||
    0 [ [ 7 shift ] dip bitor ] reduce ; inline
 | 
			
		||||
    0 [ [ 7 shift ] dip bitor ] reduce ;
 | 
			
		||||
 | 
			
		||||
: synchsafe>seq ( n -- seq )
 | 
			
		||||
    dup 1+ log2 1+ 7 / ceiling
 | 
			
		||||
    [ [ -7 shift ] keep HEX: 7f bitand  ] replicate nip reverse ; inline
 | 
			
		||||
    [ [ -7 shift ] keep HEX: 7f bitand  ] replicate nip reverse ;
 | 
			
		||||
 | 
			
		||||
: filter-text-data ( data -- filtered )
 | 
			
		||||
    [ printable? ] filter ; inline
 | 
			
		||||
    [ printable? ] filter ;
 | 
			
		||||
 | 
			
		||||
: valid-tag? ( id -- ? )
 | 
			
		||||
    [ { [ digit? ] [ LETTER? ] } 1|| ] all? ; inline
 | 
			
		||||
    [ { [ digit? ] [ LETTER? ] } 1|| ] all? ;
 | 
			
		||||
 | 
			
		||||
: read-frame-data ( frame seq -- frame data )
 | 
			
		||||
    [ 10 over size>> 10 + ] dip <slice> filter-text-data ; inline
 | 
			
		||||
    [ 10 over size>> 10 + ] dip <slice> filter-text-data ;
 | 
			
		||||
 | 
			
		||||
: decode-text ( string -- string' )
 | 
			
		||||
    dup 2 short head
 | 
			
		||||
    { { HEX: ff HEX: fe } { HEX: fe HEX: ff } } member?
 | 
			
		||||
    utf16 ascii ? decode ; inline
 | 
			
		||||
    utf16 ascii ? decode ;
 | 
			
		||||
 | 
			
		||||
: (read-frame) ( seq -- frame )
 | 
			
		||||
    [ <frame> ] dip
 | 
			
		||||
| 
						 | 
				
			
			@ -128,20 +128,20 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
 | 
			
		|||
        [ [ 4 8 ] dip subseq seq>synchsafe >>size ]
 | 
			
		||||
        [ [ 8 10 ] dip subseq >byte-array >>flags ]
 | 
			
		||||
        [ read-frame-data decode-text >>data ]
 | 
			
		||||
    } cleave ; inline
 | 
			
		||||
    } cleave ;
 | 
			
		||||
 | 
			
		||||
: read-frame ( seq -- frame/f )
 | 
			
		||||
    dup 4 head-slice valid-tag?
 | 
			
		||||
    [ (read-frame) ] [ drop f ] if ; inline
 | 
			
		||||
    [ (read-frame) ] [ drop f ] if ;
 | 
			
		||||
 | 
			
		||||
: remove-frame ( seq frame -- seq )
 | 
			
		||||
    size>> 10 + tail-slice ; inline
 | 
			
		||||
    size>> 10 + tail-slice ;
 | 
			
		||||
 | 
			
		||||
: frames>assoc ( seq -- assoc )
 | 
			
		||||
    [ [ tag>> ] keep ] H{ } map>assoc ; inline
 | 
			
		||||
    [ [ tag>> ] keep ] H{ } map>assoc ;
 | 
			
		||||
 | 
			
		||||
: read-frames ( seq -- assoc )
 | 
			
		||||
    [ dup read-frame dup ] [ [ remove-frame ] keep ] produce 2nip ; inline
 | 
			
		||||
    [ dup read-frame dup ] [ [ remove-frame ] keep ] produce 2nip ;
 | 
			
		||||
    
 | 
			
		||||
: read-v2-header ( seq -- header )
 | 
			
		||||
    [ <header> ] dip
 | 
			
		||||
| 
						 | 
				
			
			@ -149,18 +149,18 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
 | 
			
		|||
        [ [ 3 5 ] dip <slice> >array >>version ]
 | 
			
		||||
        [ [ 5 ] dip nth >>flags ]
 | 
			
		||||
        [ [ 6 10 ] dip <slice> seq>synchsafe >>size ]
 | 
			
		||||
    } cleave ; inline
 | 
			
		||||
    } cleave ;
 | 
			
		||||
 | 
			
		||||
: merge-frames ( id3 assoc -- id3 )
 | 
			
		||||
    [ dup frames>> ] dip update ; inline
 | 
			
		||||
    [ dup frames>> ] dip update ;
 | 
			
		||||
 | 
			
		||||
: merge-id3v1 ( id3 -- id3 )
 | 
			
		||||
    dup id3v1>frames frames>assoc merge-frames ; inline
 | 
			
		||||
    dup id3v1>frames frames>assoc merge-frames ;
 | 
			
		||||
 | 
			
		||||
: read-v2-tags ( id3 seq -- id3 )
 | 
			
		||||
    10 cut-slice
 | 
			
		||||
    [ read-v2-header >>header ]
 | 
			
		||||
    [ read-frames frames>assoc merge-frames ] bi* ; inline
 | 
			
		||||
    [ read-frames frames>assoc merge-frames ] bi* ;
 | 
			
		||||
    
 | 
			
		||||
: extract-v1-tags ( id3 seq -- id3 )
 | 
			
		||||
    {
 | 
			
		||||
| 
						 | 
				
			
			@ -170,11 +170,11 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
 | 
			
		|||
        [ [ 90 94 ] dip subseq decode-text filter-text-data >>year ]
 | 
			
		||||
        [ [ 94 124 ] dip subseq decode-text filter-text-data >>comment ]
 | 
			
		||||
        [ [ 124 ] dip nth number>string >>genre ]
 | 
			
		||||
    } cleave ; inline
 | 
			
		||||
    } cleave ;
 | 
			
		||||
 | 
			
		||||
: read-v1-tags ( id3 seq -- id3 )
 | 
			
		||||
    id3v1-offset tail-slice* 3 tail-slice
 | 
			
		||||
    extract-v1-tags ; inline
 | 
			
		||||
    extract-v1-tags ;
 | 
			
		||||
 | 
			
		||||
: extract-v1+-tags ( id3 seq -- id3 )
 | 
			
		||||
    {
 | 
			
		||||
| 
						 | 
				
			
			@ -191,11 +191,11 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
 | 
			
		|||
        [ [ 181 211 ] dip subseq decode-text >>genre-name ]
 | 
			
		||||
        [ [ 211 217 ] dip subseq decode-text >>start-time ]
 | 
			
		||||
        [ [ 217 223 ] dip subseq decode-text >>end-time ]
 | 
			
		||||
    } cleave ; inline
 | 
			
		||||
    } cleave ;
 | 
			
		||||
 | 
			
		||||
: read-v1+-tags ( id3 seq -- id3 )
 | 
			
		||||
    id3v1+-offset tail-slice* 4 tail-slice
 | 
			
		||||
    extract-v1+-tags ; inline
 | 
			
		||||
    extract-v1+-tags ;
 | 
			
		||||
 | 
			
		||||
: parse-genre ( string -- n/f )
 | 
			
		||||
    dup "(" ?head-slice drop ")" ?tail-slice drop
 | 
			
		||||
| 
						 | 
				
			
			@ -203,7 +203,7 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
 | 
			
		|||
        genres ?nth swap or
 | 
			
		||||
    ] [
 | 
			
		||||
        drop
 | 
			
		||||
    ] if ; inline
 | 
			
		||||
    ] if ;
 | 
			
		||||
 | 
			
		||||
: (mp3>id3) ( path -- id3v2/f )
 | 
			
		||||
    [
 | 
			
		||||
| 
						 | 
				
			
			@ -218,29 +218,29 @@ CONSTANT: id3v1+-offset $[ 128 227 + ]
 | 
			
		|||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
: mp3>id3 ( path -- id3/f )
 | 
			
		||||
    dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ; inline
 | 
			
		||||
    dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ;
 | 
			
		||||
 | 
			
		||||
: find-id3-frame ( id3 name -- obj/f )
 | 
			
		||||
    swap frames>> at* [ data>> ] when ; inline
 | 
			
		||||
    swap frames>> at* [ data>> ] when ;
 | 
			
		||||
 | 
			
		||||
: title ( id3 -- string/f ) "TIT2" find-id3-frame ; inline
 | 
			
		||||
: title ( id3 -- string/f ) "TIT2" find-id3-frame ;
 | 
			
		||||
 | 
			
		||||
: artist ( id3 -- string/f ) "TPE1" find-id3-frame ; inline
 | 
			
		||||
: artist ( id3 -- string/f ) "TPE1" find-id3-frame ;
 | 
			
		||||
 | 
			
		||||
: album ( id3 -- string/f ) "TALB" find-id3-frame ; inline
 | 
			
		||||
: album ( id3 -- string/f ) "TALB" find-id3-frame ;
 | 
			
		||||
 | 
			
		||||
: year ( id3 -- string/f ) "TYER" find-id3-frame ; inline
 | 
			
		||||
: year ( id3 -- string/f ) "TYER" find-id3-frame ;
 | 
			
		||||
 | 
			
		||||
: comment ( id3 -- string/f ) "COMM" find-id3-frame ; inline
 | 
			
		||||
: comment ( id3 -- string/f ) "COMM" find-id3-frame ;
 | 
			
		||||
 | 
			
		||||
: genre ( id3 -- string/f )
 | 
			
		||||
    "TCON" find-id3-frame parse-genre ; inline
 | 
			
		||||
    "TCON" find-id3-frame parse-genre ;
 | 
			
		||||
 | 
			
		||||
: find-mp3s ( path -- seq )
 | 
			
		||||
    [ >lower ".mp3" tail? ] find-all-files ; inline
 | 
			
		||||
    [ >lower ".mp3" tail? ] find-all-files ;
 | 
			
		||||
 | 
			
		||||
: mp3-paths>id3s ( seq -- seq' )
 | 
			
		||||
    [ dup mp3>id3 ] { } map>assoc ; inline
 | 
			
		||||
    [ dup mp3>id3 ] { } map>assoc ;
 | 
			
		||||
 | 
			
		||||
: parse-mp3-directory ( path -- seq )
 | 
			
		||||
    find-mp3s mp3-paths>id3s ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -0,0 +1 @@
 | 
			
		|||
Alex Chapman
 | 
			
		||||
| 
						 | 
				
			
			@ -1,8 +1,17 @@
 | 
			
		|||
! Copyright (C) 2005 Alex Chapman.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: alien alien.syntax kernel sequences words ;
 | 
			
		||||
USING: alien alien.libraries alien.syntax kernel sequences words system
 | 
			
		||||
combinators ;
 | 
			
		||||
IN: opengl.glu
 | 
			
		||||
 | 
			
		||||
os {
 | 
			
		||||
    { [ dup macosx? ] [ drop ] }
 | 
			
		||||
    { [ dup windows? ] [ drop ] }
 | 
			
		||||
    { [ dup unix? ] [ drop "glu" "libGLU.so.1" "cdecl" add-library ] }
 | 
			
		||||
} cond
 | 
			
		||||
 | 
			
		||||
LIBRARY: glu
 | 
			
		||||
 
 | 
			
		||||
! These are defined as structs in glu.h, but we only ever use pointers to them
 | 
			
		||||
TYPEDEF: void* GLUnurbs*
 | 
			
		||||
TYPEDEF: void* GLUquadric*
 | 
			
		||||
| 
						 | 
				
			
			@ -253,3 +262,6 @@ FUNCTION: GLint gluUnProject ( GLdouble winX, GLdouble winY, GLdouble winZ, GLdo
 | 
			
		|||
! FUNCTION: GLint gluBuild3DMipmaps ( GLenum target, GLint internalFormat, GLsizei width, GLsizei height, GLsizei depth, GLenum format, GLenum type, void* data ) ;
 | 
			
		||||
! FUNCTION: GLboolean gluCheckExtension ( GLubyte* extName, GLubyte* extString ) ;
 | 
			
		||||
! FUNCTION: GLint gluUnProject4 ( GLdouble winX, GLdouble winY, GLdouble winZ, GLdouble clipW, GLdouble* model, GLdouble* proj, GLint* view, GLdouble nearVal, GLdouble farVal, GLdouble* objX, GLdouble* objY, GLdouble* objZ, GLdouble* objW ) ;
 | 
			
		||||
 | 
			
		||||
: gl-look-at ( eye focus up -- )
 | 
			
		||||
    [ first3 ] tri@ gluLookAt ;
 | 
			
		||||
| 
						 | 
				
			
			@ -14,7 +14,7 @@ PLAF_EXE_OBJS += vm/main-unix.o
 | 
			
		|||
ifdef NO_UI
 | 
			
		||||
	X11_UI_LIBS =
 | 
			
		||||
else
 | 
			
		||||
	X11_UI_LIBS = -lpango-1.0 -lpangocairo-1.0 -lcairo -lglib-2.0 -lgobject-2.0 -lGL -lGLU -lX11
 | 
			
		||||
	X11_UI_LIBS = -lpango-1.0 -lpangocairo-1.0 -lcairo -lglib-2.0 -lgobject-2.0 -lGL -lX11
 | 
			
		||||
endif
 | 
			
		||||
 | 
			
		||||
# CFLAGS += -fPIC
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue