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="..."
* Setting up SDL libraries for use with Factor
-Factor's UI requires recent versions of the following three libraries in
-order to operate:
-
- libSDL.so
- libSDL_ttf.so
- libSDL_gfx.so
+The Windows binary package for Factor includes all prerequisite DLLs. On Unix,
+you need recent versions of SDL and FreeType.
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:sdl-gfx:name=libSDL_gfx.so
+ -libraries:freetype:name=libfreetype.so
* Source organization
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
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
0.79:\r
\r
-- fix prettyprinter\r
-- syntax updates and testing for contrib/\r
-- get stuff in examples dir running in the ui\r
-- pixelColor replacement\r
+- test everything in contrib\r
+- update handbook\r
+- fix remaining GL issues\r
\r
+ ui:\r
\r
[ "<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
[
[
"car"
- [ [ foreground 255 0 255 ] [[ font "Monospaced" ]] ]
+ [ [ foreground 1 0 1 ] [[ font "Monospaced" ]] ]
html-format
] string-out
] unit-test
- 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)
- 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:
: 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 ;
: 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 ;
: 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 ;
: (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* ;
+++ /dev/null
-! 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" run-file
IN: mandel
-USE: compiler
-USE: alien
-USE: errors
-USE: kernel
-USE: lists
-USE: math
-USE: namespaces
-USE: sdl
-USE: sdl-event
-USE: sdl-gfx
-USE: sdl-video
-USE: vectors
-USE: prettyprint
-USE: sequences
-USE: io
-USE: test
+USING: arrays compiler io kernel math namespaces sequences
+strings test ;
+
+: max-color 360 ; inline
+: zoom-fact 0.8 ; inline
+: width 640 ; inline
+: height 480 ; inline
+: nb-iter 40 ; inline
+: center -0.65 ; inline
: 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> ;
[ 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
- swap scale 8 shift bitor
- swap scale 16 shift bitor
- swap scale 24 shift bitor ;
+: scale-rgb ( r g b -- n )
+ rot scale rot scale rot scale 3array ;
-: sat 0.85 ;
-: val 0.85 ;
+: sat 0.85 ; inline
+: val 0.85 ; inline
: <color-map> ( nb-cols -- map )
dup [
- 360 * swap 1 + / 360 / sat val
- hsv>rgb 1.0 scale-rgb
+ 360 * swap 1+ / 360 / sat val
+ 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 ;
-
-: max-color 360 ;
+ [ 2nip ] [ 1- >r sq dupd + r> iter ] if ; inline
-SYMBOL: zoom-fact
-SYMBOL: x-inc
-SYMBOL: y-inc
-SYMBOL: nb-iter
SYMBOL: cols
-SYMBOL: center
-: init-mandel ( -- )
- width get 200000 zoom-fact get * / x-inc set
- height get 150000 zoom-fact get * / y-inc set
- nb-iter get max-color min <color-map> cols set ;
+: x-inc width 200000 zoom-fact * / ; inline
+: y-inc height 150000 zoom-fact * / ; inline
: 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
- rect> ;
+ y-inc * center imaginary y-inc height 2 / * - + >float
+ 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 = [
- drop 0
- ] [
- cols get [ length mod ] keep nth
- ] if
- ] with-pixels ; compiled
-
-: event-loop ( event -- )
- dup SDL_WaitEvent [
- dup event-type SDL_QUIT = [
- drop
- ] [
- event-loop
- ] if
- ] [
- drop
- ] if ; compiled
-
-: mandel ( -- )
- 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
- SDL_Quit
- ] with-screen ;
-
-mandel
+ sbuf-size <sbuf> building set
+ width height ppm-header
+ nb-iter max-color min <color-map> cols set
+ render
+ building get >string
+ ] with-scope ;
+
+: run>file ( file -- )
+ "Generating " write dup write "..." print
+ <file-writer> [ run write ] with-stream ;
+
+\ render compile
+
+[ "mandel.pnm" run>file ] time
! 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
] 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
- [ [ oversampling sq / pnm-pixel ] each ] each
+ size size pgm-header
+ [ [ 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
: .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
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
{ 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 ;
projects / factor.git / commitdiff