Merge branch 'master' of git://factorcode.org/git/factor into clean-linux-x86-32
commit
f513127b61
|
@ -5,6 +5,8 @@ io.streams.byte-array kernel math namespaces
|
||||||
sequences strings io.crlf ;
|
sequences strings io.crlf ;
|
||||||
IN: base64
|
IN: base64
|
||||||
|
|
||||||
|
ERROR: malformed-base64 ;
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: read1-ignoring ( ignoring -- ch )
|
: read1-ignoring ( ignoring -- ch )
|
||||||
|
@ -18,8 +20,6 @@ IN: base64
|
||||||
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
|
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
|
||||||
nth ; inline
|
nth ; inline
|
||||||
|
|
||||||
ERROR: malformed-base64 ;
|
|
||||||
|
|
||||||
: base64>ch ( ch -- ch )
|
: base64>ch ( ch -- ch )
|
||||||
{
|
{
|
||||||
f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f
|
f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f f
|
||||||
|
|
|
@ -1,3 +1,4 @@
|
||||||
Slava Pestov
|
Slava Pestov
|
||||||
Eduardo Cavazos
|
Eduardo Cavazos
|
||||||
Joe Groff
|
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.
|
! Portions copyright (C) 2008 Joe Groff.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: alien alien.c-types continuations kernel libc math macros
|
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
|
combinators.smart arrays sequences splitting words byte-arrays assocs
|
||||||
colors colors.constants accessors generalizations locals fry
|
colors colors.constants accessors generalizations locals fry
|
||||||
specialized-arrays.float specialized-arrays.uint ;
|
specialized-arrays.float specialized-arrays.uint ;
|
||||||
|
@ -16,10 +16,23 @@ IN: opengl
|
||||||
: gl-clear ( color -- )
|
: gl-clear ( color -- )
|
||||||
gl-clear-color GL_COLOR_BUFFER_BIT glClear ;
|
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 ( -- )
|
: gl-error ( -- )
|
||||||
glGetError dup zero? [
|
glGetError dup 0 = [ drop ] [
|
||||||
"GL error: " over gluErrorString append throw
|
dup error>string \ gl-error boa throw
|
||||||
] unless drop ;
|
] if ;
|
||||||
|
|
||||||
: do-enabled ( what quot -- )
|
: do-enabled ( what quot -- )
|
||||||
over glEnable dip glDisable ; inline
|
over glEnable dip glDisable ; inline
|
||||||
|
@ -151,9 +164,6 @@ MACRO: all-enabled-client-state ( seq quot -- )
|
||||||
MACRO: set-draw-buffers ( buffers -- )
|
MACRO: set-draw-buffers ( buffers -- )
|
||||||
words>values '[ _ (set-draw-buffers) ] ;
|
words>values '[ _ (set-draw-buffers) ] ;
|
||||||
|
|
||||||
: gl-look-at ( eye focus up -- )
|
|
||||||
[ first3 ] tri@ gluLookAt ;
|
|
||||||
|
|
||||||
: gen-dlist ( -- id ) 1 glGenLists ;
|
: gen-dlist ( -- id ) 1 glGenLists ;
|
||||||
|
|
||||||
: make-dlist ( type quot -- id )
|
: make-dlist ( type quot -- id )
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
! Copyright (C) 2005, 2009 Slava Pestov.
|
! Copyright (C) 2005, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: math.rectangles math.vectors namespaces kernel accessors
|
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 ;
|
colors.constants ui.gadgets ui.pens ;
|
||||||
IN: ui.render
|
IN: ui.render
|
||||||
|
|
||||||
|
@ -22,7 +22,7 @@ SYMBOL: viewport-translation
|
||||||
dim>>
|
dim>>
|
||||||
[ { 0 1 } v* viewport-translation set ]
|
[ { 0 1 } v* viewport-translation set ]
|
||||||
[ [ { 0 0 } ] dip gl-viewport ]
|
[ [ { 0 0 } ] dip gl-viewport ]
|
||||||
[ [ 0 ] dip first2 0 gluOrtho2D ] tri
|
[ [ 0 ] dip first2 0 1 -1 glOrtho ] tri
|
||||||
]
|
]
|
||||||
[ clip set ] bi
|
[ clip set ] bi
|
||||||
do-clip ;
|
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
|
IN: 4DNav.camera
|
||||||
|
|
||||||
|
|
|
@ -37,89 +37,89 @@ SYMBOL: tagstack
|
||||||
swap >>name
|
swap >>name
|
||||||
swap >>text ; inline
|
swap >>text ; inline
|
||||||
|
|
||||||
: (read-quote) ( state-parser ch -- string )
|
: (read-quote) ( sequence-parser ch -- string )
|
||||||
'[ [ current _ = ] take-until ] [ advance drop ] bi ;
|
'[ [ current _ = ] take-until ] [ advance drop ] bi ;
|
||||||
|
|
||||||
: read-single-quote ( state-parser -- string )
|
: read-single-quote ( sequence-parser -- string )
|
||||||
CHAR: ' (read-quote) ;
|
CHAR: ' (read-quote) ;
|
||||||
|
|
||||||
: read-double-quote ( state-parser -- string )
|
: read-double-quote ( sequence-parser -- string )
|
||||||
CHAR: " (read-quote) ;
|
CHAR: " (read-quote) ;
|
||||||
|
|
||||||
: read-quote ( state-parser -- string )
|
: read-quote ( sequence-parser -- string )
|
||||||
dup get+increment CHAR: ' =
|
dup get+increment CHAR: ' =
|
||||||
[ read-single-quote ] [ read-double-quote ] if ;
|
[ read-single-quote ] [ read-double-quote ] if ;
|
||||||
|
|
||||||
: read-key ( state-parser -- string )
|
: read-key ( sequence-parser -- string )
|
||||||
skip-whitespace
|
skip-whitespace
|
||||||
[ current { [ CHAR: = = ] [ blank? ] } 1|| ] take-until ;
|
[ current { [ CHAR: = = ] [ blank? ] } 1|| ] take-until ;
|
||||||
|
|
||||||
: read-token ( state-parser -- string )
|
: read-token ( sequence-parser -- string )
|
||||||
[ current blank? ] take-until ;
|
[ current blank? ] take-until ;
|
||||||
|
|
||||||
: read-value ( state-parser -- string )
|
: read-value ( sequence-parser -- string )
|
||||||
skip-whitespace
|
skip-whitespace
|
||||||
dup current quote? [ read-quote ] [ read-token ] if
|
dup current quote? [ read-quote ] [ read-token ] if
|
||||||
[ blank? ] trim ;
|
[ blank? ] trim ;
|
||||||
|
|
||||||
: read-comment ( state-parser -- )
|
: read-comment ( sequence-parser -- )
|
||||||
"-->" take-until-sequence comment new-tag push-tag ;
|
"-->" take-until-sequence comment new-tag push-tag ;
|
||||||
|
|
||||||
: read-dtd ( state-parser -- )
|
: read-dtd ( sequence-parser -- )
|
||||||
">" take-until-sequence dtd new-tag push-tag ;
|
">" take-until-sequence dtd new-tag push-tag ;
|
||||||
|
|
||||||
: read-bang ( state-parser -- )
|
: read-bang ( sequence-parser -- )
|
||||||
advance dup { [ current CHAR: - = ] [ peek-next CHAR: - = ] } 1&&
|
advance dup { [ current CHAR: - = ] [ peek-next CHAR: - = ] } 1&&
|
||||||
[ advance advance read-comment ] [ read-dtd ] if ;
|
[ advance advance read-comment ] [ read-dtd ] if ;
|
||||||
|
|
||||||
: read-tag ( state-parser -- string )
|
: read-tag ( sequence-parser -- string )
|
||||||
[ [ current "><" member? ] take-until ]
|
[ [ current "><" member? ] take-until ]
|
||||||
[ dup current CHAR: < = [ advance ] unless drop ] bi ;
|
[ dup current CHAR: < = [ advance ] unless drop ] bi ;
|
||||||
|
|
||||||
: read-until-< ( state-parser -- string )
|
: read-until-< ( sequence-parser -- string )
|
||||||
[ current CHAR: < = ] take-until ;
|
[ current CHAR: < = ] take-until ;
|
||||||
|
|
||||||
: parse-text ( state-parser -- )
|
: parse-text ( sequence-parser -- )
|
||||||
read-until-< [ text new-tag push-tag ] unless-empty ;
|
read-until-< [ text new-tag push-tag ] unless-empty ;
|
||||||
|
|
||||||
: parse-key/value ( state-parser -- key value )
|
: parse-key/value ( sequence-parser -- key value )
|
||||||
[ read-key >lower ]
|
[ read-key >lower ]
|
||||||
[ skip-whitespace "=" take-sequence ]
|
[ skip-whitespace "=" take-sequence ]
|
||||||
[ swap [ read-value ] [ drop dup ] if ] tri ;
|
[ swap [ read-value ] [ drop dup ] if ] tri ;
|
||||||
|
|
||||||
: (parse-attributes) ( state-parser -- )
|
: (parse-attributes) ( sequence-parser -- )
|
||||||
skip-whitespace
|
skip-whitespace
|
||||||
dup state-parse-end? [
|
dup sequence-parse-end? [
|
||||||
drop
|
drop
|
||||||
] [
|
] [
|
||||||
[ parse-key/value swap set ] [ (parse-attributes) ] bi
|
[ parse-key/value swap set ] [ (parse-attributes) ] bi
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: parse-attributes ( state-parser -- hashtable )
|
: parse-attributes ( sequence-parser -- hashtable )
|
||||||
[ (parse-attributes) ] H{ } make-assoc ;
|
[ (parse-attributes) ] H{ } make-assoc ;
|
||||||
|
|
||||||
: (parse-tag) ( string -- string' hashtable )
|
: (parse-tag) ( string -- string' hashtable )
|
||||||
[
|
[
|
||||||
[ read-token >lower ] [ parse-attributes ] bi
|
[ read-token >lower ] [ parse-attributes ] bi
|
||||||
] state-parse ;
|
] parse-sequence ;
|
||||||
|
|
||||||
: read-< ( state-parser -- string/f )
|
: read-< ( sequence-parser -- string/f )
|
||||||
advance dup current [
|
advance dup current [
|
||||||
CHAR: ! = [ read-bang f ] [ read-tag ] if
|
CHAR: ! = [ read-bang f ] [ read-tag ] if
|
||||||
] [
|
] [
|
||||||
drop f
|
drop f
|
||||||
] if* ;
|
] if* ;
|
||||||
|
|
||||||
: parse-tag ( state-parser -- )
|
: parse-tag ( sequence-parser -- )
|
||||||
read-< [ (parse-tag) make-tag push-tag ] unless-empty ;
|
read-< [ (parse-tag) make-tag push-tag ] unless-empty ;
|
||||||
|
|
||||||
: (parse-html) ( state-parser -- )
|
: (parse-html) ( sequence-parser -- )
|
||||||
dup peek-next [
|
dup peek-next [
|
||||||
[ parse-text ] [ parse-tag ] [ (parse-html) ] tri
|
[ parse-text ] [ parse-tag ] [ (parse-html) ] tri
|
||||||
] [ drop ] if ;
|
] [ drop ] if ;
|
||||||
|
|
||||||
: tag-parse ( quot -- vector )
|
: tag-parse ( quot -- vector )
|
||||||
V{ } clone tagstack [ state-parse ] with-variable ; inline
|
V{ } clone tagstack [ parse-sequence ] with-variable ; inline
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Alex Chapman
|
|
@ -1,8 +1,17 @@
|
||||||
! Copyright (C) 2005 Alex Chapman.
|
! Copyright (C) 2005 Alex Chapman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! 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
|
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
|
! These are defined as structs in glu.h, but we only ever use pointers to them
|
||||||
TYPEDEF: void* GLUnurbs*
|
TYPEDEF: void* GLUnurbs*
|
||||||
TYPEDEF: void* GLUquadric*
|
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: 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: 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 ) ;
|
! 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
|
ifdef NO_UI
|
||||||
X11_UI_LIBS =
|
X11_UI_LIBS =
|
||||||
else
|
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
|
endif
|
||||||
|
|
||||||
# CFLAGS += -fPIC
|
# CFLAGS += -fPIC
|
||||||
|
|
29
vm/image.c
29
vm/image.c
|
@ -86,7 +86,8 @@ void load_image(F_PARAMETERS *p)
|
||||||
}
|
}
|
||||||
|
|
||||||
F_HEADER h;
|
F_HEADER h;
|
||||||
fread(&h,sizeof(F_HEADER),1,file);
|
if(fread(&h,sizeof(F_HEADER),1,file) != 1)
|
||||||
|
fatal_error("Cannot read image header",0);
|
||||||
|
|
||||||
if(h.magic != IMAGE_MAGIC)
|
if(h.magic != IMAGE_MAGIC)
|
||||||
fatal_error("Bad image: magic number check failed",h.magic);
|
fatal_error("Bad image: magic number check failed",h.magic);
|
||||||
|
@ -145,27 +146,19 @@ bool save_image(const F_CHAR *filename)
|
||||||
h.userenv[i] = userenv[i];
|
h.userenv[i] = userenv[i];
|
||||||
}
|
}
|
||||||
|
|
||||||
fwrite(&h,sizeof(F_HEADER),1,file);
|
bool ok = true;
|
||||||
|
|
||||||
if(fwrite((void*)tenured->start,h.data_size,1,file) != 1)
|
if(fwrite(&h,sizeof(F_HEADER),1,file) != 1) ok = false;
|
||||||
|
if(fwrite((void*)tenured->start,h.data_size,1,file) != 1) ok = false;
|
||||||
|
if(fwrite(first_block(&code_heap),h.code_size,1,file) != 1) ok = false;
|
||||||
|
if(fclose(file)) ok = false;
|
||||||
|
|
||||||
|
if(!ok)
|
||||||
{
|
{
|
||||||
print_string("Save data heap failed: "); print_string(strerror(errno)); nl();
|
print_string("save-image failed: "); print_string(strerror(errno)); nl();
|
||||||
return false;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
if(fwrite(first_block(&code_heap),h.code_size,1,file) != 1)
|
return ok;
|
||||||
{
|
|
||||||
print_string("Save code heap failed: "); print_string(strerror(errno)); nl();
|
|
||||||
return false;
|
|
||||||
}
|
|
||||||
|
|
||||||
if(fclose(file))
|
|
||||||
{
|
|
||||||
print_string("Failed to close image file: "); print_string(strerror(errno)); nl();
|
|
||||||
return false;
|
|
||||||
}
|
|
||||||
|
|
||||||
return true;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void primitive_save_image(void)
|
void primitive_save_image(void)
|
||||||
|
|
Loading…
Reference in New Issue