Merge branch 'master' of git://factorcode.org/git/factor into clean-linux-x86-32

basis/base64/base64.factor

@@ -5,6 +5,8 @@ io.streams.byte-array kernel math namespaces
 sequences strings io.crlf ;
 IN: base64
 
+ERROR: malformed-base64 ;
+
 <PRIVATE
 
 : read1-ignoring ( ignoring -- ch )
@@ -18,8 +20,6 @@ IN: base64
     "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
     nth ; inline
 
-ERROR: malformed-base64 ;
-
 : 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

basis/opengl/authors.txt

@@ -1,3 +1,4 @@
 Slava Pestov
 Eduardo Cavazos
 Joe Groff
+Alex Chapman

basis/opengl/gl/authors.txt

@@ -1 +1 @@
-Slava Pestov
+Alex Chapman

basis/opengl/glu/authors.txt

@@ -1 +0,0 @@
-Slava Pestov

basis/opengl/opengl.factor

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

basis/ui/render/render.factor

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

extra/4DNav/camera/camera.factor

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

extra/html/parser/parser.factor

@@ -37,89 +37,89 @@ SYMBOL: tagstack
         swap >>name
         swap >>text ; inline
 
-: (read-quote) ( state-parser ch -- string )
+: (read-quote) ( sequence-parser ch -- string )
     '[ [ current _ = ] take-until ] [ advance drop ] bi ;
 
-: read-single-quote ( state-parser -- string )
+: read-single-quote ( sequence-parser -- string )
     CHAR: ' (read-quote) ;
 
-: read-double-quote ( state-parser -- string )
+: read-double-quote ( sequence-parser -- string )
     CHAR: " (read-quote) ;
 
-: read-quote ( state-parser -- string )
+: read-quote ( sequence-parser -- string )
     dup get+increment CHAR: ' =
     [ read-single-quote ] [ read-double-quote ] if ;
 
-: read-key ( state-parser -- string )
+: read-key ( sequence-parser -- string )
     skip-whitespace
     [ current { [ CHAR: = = ] [ blank? ] } 1|| ] take-until ;
 
-: read-token ( state-parser -- string )
+: read-token ( sequence-parser -- string )
     [ current blank? ] take-until ;
 
-: read-value ( state-parser -- string )
+: read-value ( sequence-parser -- string )
     skip-whitespace
     dup current quote? [ read-quote ] [ read-token ] if
     [ blank? ] trim ;
 
-: read-comment ( state-parser -- )
+: read-comment ( sequence-parser -- )
     "-->" take-until-sequence comment new-tag push-tag ;
 
-: read-dtd ( state-parser -- )
+: read-dtd ( sequence-parser -- )
     ">" 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 advance read-comment ] [ read-dtd ] if ;
 
-: read-tag ( state-parser -- string )
+: read-tag ( sequence-parser -- string )
     [ [ current "><" member? ] take-until ]
     [ dup current CHAR: < = [ advance ] unless drop ] bi ;
 
-: read-until-< ( state-parser -- string )
+: read-until-< ( sequence-parser -- string )
     [ current CHAR: < = ] take-until ;
 
-: parse-text ( state-parser -- )
+: parse-text ( sequence-parser -- )
     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 ]
     [ skip-whitespace "=" take-sequence ]
     [ swap [ read-value ] [ drop dup ] if ] tri ;
 
-: (parse-attributes) ( state-parser -- )
+: (parse-attributes) ( sequence-parser -- )
     skip-whitespace
-    dup state-parse-end? [
+    dup sequence-parse-end? [
         drop
     ] [
         [ parse-key/value swap set ] [ (parse-attributes) ] bi
     ] if ;
 
-: parse-attributes ( state-parser -- hashtable )
+: parse-attributes ( sequence-parser -- hashtable )
     [ (parse-attributes) ] H{ } make-assoc ;
 
 : (parse-tag) ( string -- string' hashtable )
     [
         [ read-token >lower ] [ parse-attributes ] bi
-    ] state-parse ;
+    ] parse-sequence ;
 
-: read-< ( state-parser -- string/f )
+: read-< ( sequence-parser -- string/f )
     advance dup current [
         CHAR: ! = [ read-bang f ] [ read-tag ] if
     ] [
         drop f
     ] if* ;
 
-: parse-tag ( state-parser -- )
+: parse-tag ( sequence-parser -- )
     read-< [ (parse-tag) make-tag push-tag ] unless-empty ;
 
-: (parse-html) ( state-parser -- )
+: (parse-html) ( sequence-parser -- )
     dup peek-next [
         [ parse-text ] [ parse-tag ] [ (parse-html) ] tri
     ] [ drop ] if ;
 
 : tag-parse ( quot -- vector )
-    V{ } clone tagstack [ state-parse ] with-variable ; inline
+    V{ } clone tagstack [ parse-sequence ] with-variable ; inline
 
 PRIVATE>
 

extra/opengl/glu/authors.txt

@@ -0,0 +1 @@
+Alex Chapman

extra/opengl/glu/glu.factor

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

vm/Config.unix

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

vm/image.c

@@ -86,7 +86,8 @@ void load_image(F_PARAMETERS *p)
 	}
 
 	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)
 		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];
 	}
 
-	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();
-		return false;
+		print_string("save-image failed: "); print_string(strerror(errno)); nl();
 	}
 
-	if(fwrite(first_block(&code_heap),h.code_size,1,file) != 1)
-	{
-		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;
+	return ok;
 }
 
 void primitive_save_image(void)