fix httpd loading, update examples to work, fix status bar bug

README.txt

@@ -41,8 +41,12 @@ parameters to build the Factor runtime:
   linux
   linux-ppc
   macosx
+  macosx-sdl
   windows
 
+Note: If you wish to use the Factor UI on Mac OS X, you must build with the
+macosx-sdl target.
+
 The following options can be given to make:
 
   SITE_CFLAGS="..."
@@ -108,20 +112,15 @@ naming the libraries during bootstrap, as in the next section.
 
 * Setting up SDL libraries for use with Factor
 
-Factor's UI requires recent versions of the following three libraries in
+The Windows binary package for Factor includes all prerequisite DLLs. On Unix,
-order to operate:
+you need recent versions of SDL and FreeType.
-
-  libSDL.so
-  libSDL_ttf.so
-  libSDL_gfx.so
 
 If you have installed these libraries but the UI still fails with an
 error, you will need to find out the exact names that they are installed
 as, and issue a command similar to the following to bootstrap Factor:
 
   ./f boot.image.<foo> -libraries:sdl:name=libSDL-1.2.so
-                       -libraries:sdl-ttf:name=libSDL_ttf.so
+                       -libraries:freetype:name=libfreetype.so
-                       -libraries:sdl-gfx:name=libSDL_gfx.so
 
 * Source organization
 
@@ -133,6 +132,7 @@ as, and issue a command similar to the following to bootstrap Factor:
     collections/ - data types including but not limited to lists,
       vectors, hashtables, and operations on them
     compiler/ - optimizing native compiler
+    freetype/ - FreeType binding, rendering glyphs to OpenGL textures
     generic/ - generic words, for object oriented programming style
     help/ - online help system
     httpd/ - HTTP client, server, and web application framework
@@ -140,7 +140,8 @@ as, and issue a command similar to the following to bootstrap Factor:
       useful development tool of its own
     io/ - input and output streams
     math/ - integers, ratios, floats, complex numbers, vectors, matrices
-    sdl/ - bindings for libSDL, libSDL_ttf and libSDL_gfx
+    opengl/ - OpenGL graphics library binding
+    sdl/ - SDL binding
     syntax/ - parser and object prettyprinter
     test/ - unit test framework and test suite
     tools/ - interactive development tools

TODO.FACTOR.txt

@@ -1,9 +1,8 @@
 0.79:
 
-- fix prettyprinter
+- test everything in contrib
-- syntax updates and testing for contrib/
+- update handbook
-- get stuff in examples dir running in the ui
+- fix remaining GL issues
-- pixelColor replacement
 
 + ui:
 

contrib/httpd/test/html.factor

@@ -23,7 +23,7 @@ USING: html io kernel namespaces styles test ;
 [ "<span style='color: #ff00ff; font-family: Monospaced; '>car</span>" ]
 [
     [
-        [ [ foreground 255 0 255 ] [[ font "Monospaced" ]] ]
+        [ [ foreground 1 0 1 ] [[ font "Monospaced" ]] ]
         [ drop "car" write ]
         span-tag
     ] string-out
@@ -41,7 +41,7 @@ USING: html io kernel namespaces styles test ;
 [
     [
         "car"
-        [ [ foreground 255 0 255 ] [[ font "Monospaced" ]] ]
+        [ [ foreground 1 0 1 ] [[ font "Monospaced" ]] ]
         html-format
     ] string-out
 ] unit-test

contrib/math/TODO.txt

@@ -16,6 +16,7 @@ Nice to have:
   - square root of a matrix, e^matrix
   - finding roots of polynomials
 - Algebra:
+  - polynomial derivative
   - ^mod for polynomials
   - mod-inv for polynomials
   - arithmetic modulo a+sqrt(b)
@@ -28,6 +29,10 @@ Nice to have:
   - interval arithmetic
   - combinatorics: stirling numbers
   - factoring polynomials over finite fields
+  - minimal and characteristic polynomials of algebraic numbers
+  - norm and trace of algebraic numbers
+  - minimal and characteristic polynomials of matrices
+  - eigenvalues of matrices
 - Graphs:
   - minimum spanning trees
 - Logic:

contrib/math/polynomials.factor

@@ -5,10 +5,6 @@ USING: kernel sequences vectors math math-internals namespaces ;
 
 : zero-vector ( n -- vector ) 0 <repeated> >vector ;
 
-: nzero-pad ( n seq -- seq )
-    #! extend seq by n zeros
-    >r zero-vector r> swap nappend ;
-
 : zero-pad ( n seq -- seq )
     #! extend seq by n zeros
     >r zero-vector r> swap append ;
@@ -16,6 +12,10 @@ USING: kernel sequences vectors math math-internals namespaces ;
 : zero-pad-front ( n seq -- seq )
     >r zero-vector r> append ;
 
+: nzero-pad ( n seq -- )
+    #! extend seq by n zeros
+    >r zero-vector r> swap nappend ;
+
 : zero-extend ( n seq -- )
     #! extend seq to max(n,length) with 0s
     [ length ] keep -rot - swap nzero-pad ;
@@ -56,17 +56,14 @@ IN: math-contrib
 : conv*b ( seq -- seq )
     rot dup pop drop 1 zero-vector swap append -rot ;
 
-: conv ( p p -- p )
-    conv*a [ 3dup -rot v* sum >r pick r> -rot set-nth conv*b ] repeat nip ;
-
-! polynomial multiply
 : p* ( p p -- p )
-    conv ;
+    #! Multiply two polynomials.
+    conv*a [ 3dup -rot v* sum >r pick r> -rot set-nth conv*b ] repeat nip ;
 
 : p-sq ( p -- p-sq )
     dup p* ;
 
-IN: polynomial-internals
+IN: polynomials-internals
 
 : pop-front ( seq -- seq )
     1 swap tail ;
@@ -82,18 +79,22 @@ IN: polynomial-internals
 : (p/mod)
     2dup /-last 2dup , n*p swapd p- dup pop drop swap pop-front ;
 
-IN: math
+IN: math-contrib
 
 : p/mod
-    p/mod-setup [ [ (p/mod) ] times ] { } make reverse nip swap 2ptrim pextend ;
+    p/mod-setup [ [ (p/mod) ] times ] V{ } make
+    reverse nip swap 2ptrim pextend ;
 
 : (pgcd) ( b a y x -- a d )
-    dup { 0 } clone p= [
+    dup V{ 0 } clone p= [
         drop nip
     ] [
         tuck p/mod >r pick p* swap >r swapd p- r> r> (pgcd)
     ] if ;
     
 : pgcd ( p p -- p )
-    swap { 0 } clone { 1 } clone 2swap (pgcd) ;
+    swap V{ 0 } clone V{ 1 } clone 2swap (pgcd) ;
 
+: pdiff ( p -- p' )
+    #! Polynomial derivative.
+    [ length reverse-slice ] keep [ 1+ * ] 2map 1 swap head* ;

examples/dejong.factor

@@ -1,70 +0,0 @@
-! DeJong attractor renderer.
-!
-! To run this code, bootstrap Factor like so:
-!
-! ./f boot.image.le32
-!     -libraries:sdl:name=libSDL.so
-!     -libraries:sdl-gfx:name=libSDL_gfx.so
-!
-! (But all on one line)
-!
-! Then, start Factor as usual (./f factor.image) and enter this
-! at the listener:
-!
-! "examples/dejong.factor" run-file
-
-! For details on DeJong attractors, see
-! http://www.complexification.net/gallery/machines/peterdejong/
-
-IN: dejong
-USING: compiler kernel math namespaces sdl styles test ;
-
-SYMBOL: a
-SYMBOL: b
-SYMBOL: c
-SYMBOL: d
-
-: next-x ( x y -- x ) a get * sin swap b get * cos - ;
-: next-y ( x y -- y ) swap c get * sin swap d get * cos - ;
-
-: pixel ( C{ x y } color -- )
-    >r >r surface get r> >rect r> pixelColor ;
-
-: iterate-dejong ( x y -- x y )
-    2dup next-y >r next-x r> ;
-
-: scale-dejong ( x y -- x y )
-    swap width get 4 / * width get 2 / + >fixnum
-    swap height get 4 / * height get 2 / + >fixnum ;
-
-: draw-dejong ( x0 y0 iterations -- )
-    [
-        iterate-dejong 2dup scale-dejong rect> white rgb pixel
-    ] times 2drop ; compiled
-
-: event-loop ( event -- )
-    dup SDL_WaitEvent [
-        dup event-type SDL_QUIT = [
-            drop
-        ] [
-            event-loop
-        ] if
-    ] [
-        drop
-    ] if ; compiled
-
-: dejong ( -- )
-    ! Fiddle with these four values!
-    1.0 a set
-    -1.3 b set
-    0.8 c set
-    -2.1 d set
-
-    800 600 0 SDL_HWSURFACE [
-        [ 0 0 200000 [ draw-dejong ] time ] with-surface
-
-        <event> event-loop
-        SDL_Quit
-    ] with-screen ;
-
-dejong

examples/mandel.factor

@@ -14,22 +14,15 @@
 ! "examples/mandel.factor" run-file
 
 IN: mandel
-USE: compiler
+USING: arrays compiler io kernel math namespaces sequences
-USE: alien
+strings test ;
-USE: errors
+
-USE: kernel
+: max-color 360 ; inline
-USE: lists
+: zoom-fact 0.8 ; inline
-USE: math
+: width 640 ; inline
-USE: namespaces
+: height 480 ; inline
-USE: sdl
+: nb-iter 40 ; inline
-USE: sdl-event
+: center -0.65 ; inline
-USE: sdl-gfx
-USE: sdl-video
-USE: vectors
-USE: prettyprint
-USE: sequences
-USE: io
-USE: test
 
 : f_ ( h s v i -- f ) >r swap rot >r 2dup r> 6 * r> - ;
 : p ( v s x -- v p x ) >r dupd neg 1 + * r> ;
@@ -75,81 +68,65 @@ USE: test
 [ 1 0 0 ] [ 1 1 1 hsv>rgb ] unit-test
 [ 1/6 1/9 1/9 ] [ 1 1/3 1/6 hsv>rgb ] unit-test
 
-: scale 255 * >fixnum ;
+: scale 255 * >fixnum ; inline
 
-: scale-rgb ( r g b a -- n )
+: scale-rgb ( r g b -- n )
-    scale
+    rot scale rot scale rot scale 3array ;
-    swap scale 8 shift bitor
-    swap scale 16 shift bitor
-    swap scale 24 shift bitor ;
 
-: sat 0.85 ;
+: sat 0.85 ; inline
-: val 0.85 ;
+: val 0.85 ; inline
 
 : <color-map> ( nb-cols -- map )
     dup [
-        360 * swap 1 + / 360 / sat val
+        360 * swap 1+ / 360 / sat val
-        hsv>rgb 1.0 scale-rgb
+        hsv>rgb scale-rgb
     ] map-with ;
 
 : iter ( c z nb-iter -- x )
     over absq 4.0 >= over 0 = or
-    [ 2nip ] [ 1- >r sq dupd + r> iter ] if ;
+    [ 2nip ] [ 1- >r sq dupd + r> iter ] if ; inline
 
-: max-color 360 ;
-
-SYMBOL: zoom-fact
-SYMBOL: x-inc
-SYMBOL: y-inc
-SYMBOL: nb-iter
 SYMBOL: cols
-SYMBOL: center
 
-: init-mandel ( -- )
+: x-inc width 200000 zoom-fact * / ; inline
-    width get 200000 zoom-fact get * / x-inc set
+: y-inc height 150000 zoom-fact * / ; inline
-    height get 150000 zoom-fact get * / y-inc set
-    nb-iter get max-color min <color-map> cols set ;
 
 : c ( i j -- c )
     >r
-    x-inc get * center get real x-inc get width get 2 / * - + >float
+    x-inc * center real x-inc width 2 / * - + >float
     r>
-    y-inc get * center get imaginary y-inc get height get 2 / * - + >float
+    y-inc * center imaginary y-inc height 2 / * - + >float
-    rect> ;
+    rect> ; inline
 
 : render ( -- )
+    height [
+        width [
+            2dup swap c 0 nb-iter iter dup 0 = [
+                drop "\0\0\0"
+            ] [
+                cols get [ length mod ] keep nth
+            ] if %
+        ] repeat
+    ] repeat ;
+
+: ppm-header ( w h -- )
+    "P6\n" % swap # " " % # "\n255\n" % ;
+
+: sbuf-size width height * 3 * 100 + ;
+
+: run ( -- string )
     [
-        c 0 nb-iter get iter dup 0 = [
+        sbuf-size <sbuf> building set
-            drop 0
+        width height ppm-header
-        ] [
+        nb-iter max-color min <color-map> cols set
-            cols get [ length mod ] keep nth
+        render
-        ] if
+        building get >string
-    ] with-pixels ; compiled
+    ] with-scope ;
 
-: event-loop ( event -- )
+: run>file ( file -- )
-    dup SDL_WaitEvent [
+    "Generating " write dup write "..." print
-        dup event-type SDL_QUIT = [
+    <file-writer> [ run write ] with-stream ;
-            drop
-        ] [
-            event-loop
-        ] if
-    ] [
-        drop
-    ] if ; compiled
 
-: mandel ( -- )
+\ render compile
-    1280 1024 0 SDL_HWSURFACE  [
-        [
-            3.7 zoom-fact set
-            -0.45 center set
-            100 nb-iter set
-            init-mandel
-            [ render ] time
-            "Done." print flush
-        ] with-surface
 
-        <event> event-loop
+[ "mandel.pnm" run>file ] time
-        SDL_Quit
-    ] with-screen ;
-
-mandel

examples/raytracer.factor

@@ -1,7 +1,8 @@
 ! Factor port of the raytracer benchmark from
 ! http://www.ffconsultancy.com/free/ray_tracer/languages.html
 
-USING: arrays generic io kernel lists math namespaces sequences ;
+USING: arrays compiler generic io kernel lists math namespaces
+sequences test ;
 IN: ray
 
 ! parameters
@@ -142,18 +143,24 @@ DEFER: create ( level c r -- scene )
         ] map-with
     ] map ;
 
-: pnm-header ( w h -- )
+: pgm-header ( w h -- )
     "P5\n" % swap # " " % # "\n255\n" % ;
 
-: pnm-pixel ( n -- ) 255 * 0.5 + >fixnum , ;
+: pgm-pixel ( n -- ) 255 * 0.5 + >fixnum , ;
 
 : ray-trace ( scene -- pixels )
     pixel-grid [ [ ray-pixel ] map-with ] map-with ;
 
 : run ( -- string )
     levels { 0.0 -1.0 0.0 } 1.0 create ray-trace [
-        size size pnm-header
+        size size pgm-header
-        [ [ oversampling sq / pnm-pixel ] each ] each
+        [ [ oversampling sq / pgm-pixel ] each ] each
     ] "" make ;
 
-: run>file ( file -- ) <file-writer> [ run write ] with-stream ;
+: run>file ( file -- )
+    "Generating " write dup write "..." print
+    <file-writer> [ run write ] with-stream ;
+
+\ run compile
+
+[ "raytracer.pnm" run>file ] time

library/syntax/prettyprint.factor

@@ -346,19 +346,12 @@ M: wrapper pprint* ( wrapper -- )
 : .o >oct print ;
 : .h >hex print ;
 
-: define-open
-    #! The word will be pretty-printed as a block opener.
-    t "pprint-open" set-word-prop ;
-
-: define-close ( word -- )
-    #! The word will be pretty-printed as a block closer.
-    t "pprint-close" set-word-prop ;
-
 { 
     POSTPONE: [ POSTPONE: [[
     POSTPONE: { POSTPONE: V{ POSTPONE: H{
     POSTPONE: T{ POSTPONE: W{
-} [ define-open ] each
+} [ t "pprint-open" set-word-prop ] each
 
-{ POSTPONE: [ POSTPONE: } POSTPONE: ]] }
+{
-[ define-close ] each
+    POSTPONE: ] POSTPONE: } POSTPONE: ]]
+} [ t "pprint-close" set-word-prop ] each

library/ui/listener.factor

@@ -63,7 +63,7 @@ C: display ( -- display )
     1/2 <x-splitter> ;
 
 : <status-bar> ( -- gadget )
-    "" <label> dup reverse-video-theme ;
+    "" <label> dup status-theme ;
 
 : listener-application ( -- )
     t t <pane> dup pane global set-hash

library/ui/theme.factor

@@ -81,6 +81,11 @@ USING: arrays gadgets kernel sequences styles ;
     { 0.0 0.0 0.0 1.0 } over set-label-color
     { "Monospaced" plain 12 } swap set-label-font ;
 
-: editor-theme ( editor -- )
+: editor-theme ( label -- )
     { 0.0 0.0 0.0 1.0 } over set-label-color
     { "Monospaced" bold 12 } swap set-label-font ;
+
+: status-theme ( label -- )
+    dup reverse-video-theme
+    { 1.0 1.0 1.0 1.0 } over set-label-color
+    { "Monospaced" plain 12 } swap set-label-font ;