Tuesday, February 27, 2007

Factor meets the Stanford Bunny

I ported another one of Jon D. Harrop's Ocaml demos to Factor, this time the Stanford Bunny. From the page: "The Stanford bunny is a 3D mesh of triangles commonly used as a benchmark for computer graphics applications."

Screenshot:


I found an FFI bug while working on this; on Mac OS X, Factor would spill floating point parameters on the C stack if there was more than 8 of them, however this is only correct for Linux. The Mac OS X PowerPC ABI stipulates that the first 13 floating point parameters are passed in registers.

I also had a problem where the depth buffer was not working on Mac OS X. Thanks to Kevin P. Reid (kpreid on #concatenative) who asked:
kpreid: well, did you ask for a depth buffer? :)

Turns out I did not ask for a depth buffer, and I had to change the code which creates the Cocoa GLView to request one. This is not a good solution since now every UI window has a depth buffer, wasting memory. And of course at some point somebody will come along and want to do something with accumulation buffers, stereo display, and other odd stuff. So eventually I'll need a portable way to configure the GL context. For now, changing the Cocoa, X11 and Windows UI backends to always request a depth buffer will suffice.

I wanted to ship this demo with Factor, but the data file is 2.9 Mb. So what the program does is download the data file (using libs/http-client) and save it the first time it is run. Clean and elegant.

Source code - this time it's only 4 lines longer than the Ocaml version:
! From http://www.ffconsultancy.com/ocaml/bunny/index.html
USING: alien-contrib arrays sequences math io kernel
matrices opengl shuffle gadgets http-client tools
vectors timers namespaces ;
IN: bunny

: numbers ( str -- seq )
" " split [ string>number ] map [ ] subset ;

: (parse-model) ( vs is -- vs is )
readln [
numbers {
{ [ dup length 5 = ] [ 3 head pick push ] }
{ [ dup first 3 = ] [ 1 tail over push ] }
{ [ t ] [ drop ] }
} cond (parse-model)
] when* ;

: parse-model ( stream -- vs is )
[
100000 <vector> 100000 <vector> (parse-model)
] with-stream
[
over length # " vertices, " %
dup length # " triangles" %
] "" make print ;

: n ( vs triple -- n )
[ swap nth ] map-with
dup third over first v- >r dup second swap first v- r> cross
vneg normalize ;

: normal ( ns vs triple -- )
[ n ] keep [ rot [ v+ ] change-nth ] each-with2 ;

: normals ( vs is -- ns )
over length { 0.0 0.0 0.0 } <array> -rot
[ >r 2dup r> normal ] each drop
[ normalize ] map ;

: read-model ( stream -- model )
"Reading model" print flush [
<file-reader> parse-model [ normals ] 2keep 3array
] time ;

: model-path "demos/bunny/bun_zipper.ply" ;

: model-url "http://factorcode.org/bun_zipper.ply" ;

: maybe-download ( -- path )
model-path resource-path dup exists? [
"Downloading bunny from " write
model-url dup print flush
over download
] unless ;

: draw-triangle ( ns vs triple -- )
[
dup roll nth first3 glNormal3d
swap nth first3 glVertex3d
] each-with2 ;

: draw-bunny ( ns vs is -- )
GL_TRIANGLES [ [ draw-triangle ] each-with2 ] do-state ;

: cache-bunny ( triple -- displaylist )
GL_COMPILE [ first3 draw-bunny ] make-dlist ;

TUPLE: bunny-gadget dlist model ;

C: bunny-gadget ( model -- gadget )
<gadget> over set-gadget-delegate
[ set-bunny-gadget-model ] keep ;

M: bunny-gadget graft* 10 10 add-timer ;

M: bunny-gadget ungraft*
dup remove-timer
bunny-gadget-dlist [ delete-dlist ] when* ;

M: bunny-gadget tick relayout-1 ;

: aspect ( gadget -- x ) rect-dim first2 /f ;

: cache-bunny-dlist ( gadget -- dlist )
dup bunny-gadget-dlist [ ] [
dup bunny-gadget-model cache-bunny
dup rot set-bunny-gadget-dlist
] ?if ;

M: bunny-gadget draw-gadget*
GL_DEPTH_TEST glEnable
GL_SCISSOR_TEST glDisable
1.0 glClearDepth
GL_DEPTH_BUFFER_BIT glClear
0.0 0.0 0.0 1.0 glClearColor
GL_COLOR_BUFFER_BIT glClear
GL_PROJECTION glMatrixMode
glLoadIdentity
45.0 over aspect 0.1 1.0 gluPerspective
0.0 0.12 -0.25 0.0 0.1 0.0 0.0 1.0 0.0 gluLookAt
GL_MODELVIEW glMatrixMode
glLoadIdentity
GL_LEQUAL glDepthFunc
GL_LIGHTING glEnable
GL_LIGHT0 glEnable
GL_COLOR_MATERIAL glEnable
GL_LIGHT0 GL_POSITION { 1.0 -1.0 1.0 1.0 } >float-array glLightfv
millis 24000 mod 0.015 * 0.0 1.0 0.0 glRotated
GL_FRONT_AND_BACK GL_SHININESS 100.0 glMaterialf
GL_FRONT_AND_BACK GL_SPECULAR glColorMaterial
GL_FRONT_AND_BACK GL_AMBIENT_AND_DIFFUSE glColorMaterial
0.6 0.5 0.5 1.0 glColor4d
cache-bunny-dlist glCallList ;

M: bunny-gadget pref-dim* drop { 400 300 } ;

: bunny-window ( -- )
maybe-download read-model <bunny-gadget>
"Bunny" open-window ;

No comments: