cube.obj

v -1.000000 -1.000000 1.000000
v -1.000000 1.000000 1.000000
v -1.000000 -1.000000 -1.000000
v -1.000000 1.000000 -1.000000
v 1.000000 -1.000000 1.000000
v 1.000000 1.000000 1.000000
v 1.000000 -1.000000 -1.000000
v 1.000000 1.000000 -1.000000
vn -1.0000 0.0000 0.0000
vn 0.0000 0.0000 -1.0000
vn 1.0000 0.0000 0.0000
vn 0.0000 0.0000 1.0000
vn 0.0000 -1.0000 0.0000
vn 0.0000 1.0000 0.0000
s off
f 2//1 3//1 1//1
f 4//2 7//2 3//2
f 8//3 5//3 7//3
f 6//4 1//4 5//4
f 7//5 1//5 3//5
f 4//6 6//6 8//6
f 2//1 4//1 3//1
f 4//2 8//2 7//2
f 8//3 6//3 5//3
f 6//4 2//4 1//4
f 7//5 5//5 1//5
f 4//6 2//6 6//6

obj2f3d.fs

\ This file loads a WaveFront OBJ file (see cube.obj for sample) into
\ memory.
\
\ # WaveFront OBJ File Format
\
\ The file contains a text representation of a 3D scene. A minimal and
\ supported file format looks like the following:
\ 
\ v -1.000000 -1.000000 1.000000
\ v -1.000000 1.000000 1.000000
\ v -1.000000 -1.000000 -1.000000
\ vn -1.000000 0.000000 0.000000
\ vn -1.000000 0.000000 0.000000
\ vn -1.000000 0.000000 0.000000
\ f 2//1 3//1 1//1
\
\ The line that starts with letter "v" denotes the position vector X,
\ Y and Z.
\
\ The letters "vn" denote the 3 floats denoting the normal vector X, Y
\ and Z.
\
\ The letter "f" denotes the face indices (starting from 1) into the
\ vertex list forming a triangle, and normal indices respectively.
\
\ # How to use
\
\ load-obj ( addr0 u -- paddr naddr iaddr p n i )
\
\ addr0 u is the string that contains the file name for the OBJ file.
\
\ paddr is the array of vertex positions.
\
\ naddr is the array of normal positions.
\
\ iaddr is the array of vertex and normal indices interleaved. See
\ face-cells for layout
\
\ p, n and i are the count of elements for each of the arrays
\ respectively.

require fi.fs

0
dup constant face.v0.p cell +
dup constant face.v0.n cell +
dup constant face.v1.p cell +
dup constant face.v1.n cell +
dup constant face.v2.p cell +
dup constant face.v2.n cell +
constant face-cells

0
dup constant position.x cell +
dup constant position.y cell +
dup constant position.z cell +
constant position-cells

0
dup constant normal.x cell +
dup constant normal.y cell +
dup constant normal.z cell +
constant normal-cells

0 value fd              \ file handle
0 value positions       \ array of vertex positions
0 value normals         \ array of vertex normals
0 value faces           \ array of face-cells
0 value pcount          \ number of x, y, z positions
0 value ncount          \ number of x, y, z normals
0 value fcount          \ number of offset faces

\ file related words
: fd>pad       ( -- u ) pad 80 fd read-line throw drop ;
: open ( addr u -- fd ) r/o open-file throw ;
: open-obj   ( addr u ) open to fd ;
: close-obj      ( -- ) fd close-file throw ;
: rewind         ( -- ) 0. fd reposition-file throw ;

\ Count the number of positions and faces in currently open file
0 value position
0 value normal
0 value index
: count-elements ( -- position normal index )
  0 to position
  0 to normal
  0 to index
  begin
    fd>pad
  while
    pad 3 s" vn " compare 0= if normal   1+ to normal then
    pad 2 s" v "  compare 0= if position 1+ to position then
    pad 2 s" f "  compare 0= if index    1+ to index then
  repeat
  position to pcount
  normal   to ncount
  index    to fcount
;

0 value poffset
0 value noffset
0 value foffset

: position-at ( n -- adr ) position-cells * positions + ;
: normal-at   ( n -- adr ) normal-cells   * normals + ;
: face-at     ( n -- adr ) face-cells     * faces + ;

: next-paddr ( -- addr ) poffset position-at poffset 1+ to poffset ;
: next-naddr ( -- addr ) noffset normal-at   noffset 1+ to noffset ;
: next-faddr ( -- addr ) foffset face-at     foffset 1+ to foffset ;

\ Parse next float from string delimited by spaces and return the
\ string for next float
: next-float ( addr0 u0 -- addr1 u1 ) ( F: f0 -- )
  2dup s"  " search
  if
    2dup 1 /string 2>r          \ save next string
    nip -
    >float 0= throw
    2r>                         \ restore next string skip space
  else
    2drop 2 -
    >float 0= throw
  then
;

\ skip until next space or /
: skip-space-or/ ( addr0 u0 -- addr1 u1 )
  begin
    2dup drop c@ >r
    1 /string
    dup 0=
    r@ [char] / = or
    r> 32 = or
  until
;

\ Parse next integer from string delimited by space or "/" and return
\ the string for next integer
: next-face-int ( addr0 u0 -- addr1 u1 n )
  2dup skip-space-or/ dup 0<>
  if
    2dup 2>r         \ save next string
    nip -
    0. 2swap >number 2drop drop
    2r> rot          \ restore next string skip space
  else
    2drop
    0. 2swap >number 2drop drop
  then
;

: add-normal ( addr u -- ) \ s" -1.000000 -1.000000 -1.000000"
  next-float f>fi >r
  next-float f>fi >r
  next-float f>fi >r

  next-naddr
  r> over normal.z + !
  r> over normal.y + !
  r> swap normal.x + !
;

: add-vertex ( addr u -- ) \ s" -1.000000 -2.000000 3.000000"
  next-float f>fi >r
  next-float f>fi >r
  next-float f>fi >r

  next-paddr
  r> over position.z + !
  r> over position.y + !
  r> swap position.x + !
;

: add-face ( addr u -- ) \ s" 1//2 3//4 5//6"
  next-faddr >r
  next-face-int r@ face.v0.p + !
  next-face-int drop
  next-face-int r@ face.v0.n + !
  next-face-int r@ face.v1.p + !
  next-face-int drop
  next-face-int r@ face.v1.n + !
  next-face-int r@ face.v2.p + !
  next-face-int drop
  next-face-int r> face.v2.n + !
;

\ consume the current line
: gulp ( addr n -- )
  over 3 s" vn " compare 0= if 3 /string add-normal exit then
  over 2 s" v "  compare 0= if 2 /string add-vertex exit then
  over 2 s" f "  compare 0= if 2 /string add-face   exit then

  2drop
;

\ consume the lines in the file
: slurp ( -- ) begin fd>pad ?dup while pad swap gulp repeat ;

: allocate-buffers ( -- )
  here pcount position-cells * allot to positions
  here ncount normal-cells   * allot to normals
  here fcount face-cells     * allot to faces

  positions pcount position-cells * erase
  normals   ncount normal-cells   * erase
  faces     fcount face-cells     * erase
;

: load-obj ( addr0 u -- paddr naddr iaddr p n i )
  open-obj count-elements rewind allocate-buffers slurp close-obj
  positions normals faces pcount ncount fcount
;

output.txt

Positions: 
7F4152D0B4C8: 00 C0 FF FF  FF FF FF FF - 00 C0 FF FF  FF FF FF FF  ................
7F4152D0B4D8: 00 40 00 00  00 00 00 00 - 00 C0 FF FF  FF FF FF FF  .@..............
7F4152D0B4E8: 00 40 00 00  00 00 00 00 - 00 40 00 00  00 00 00 00  .@.......@......
7F4152D0B4F8: 00 C0 FF FF  FF FF FF FF - 00 C0 FF FF  FF FF FF FF  ................
7F4152D0B508: 00 C0 FF FF  FF FF FF FF - 00 C0 FF FF  FF FF FF FF  ................
7F4152D0B518: 00 40 00 00  00 00 00 00 - 00 C0 FF FF  FF FF FF FF  .@..............
7F4152D0B528: 00 40 00 00  00 00 00 00 - 00 C0 FF FF  FF FF FF FF  .@..............
7F4152D0B538: 00 40 00 00  00 00 00 00 - 00 40 00 00  00 00 00 00  .@.......@......
7F4152D0B548: 00 40 00 00  00 00 00 00 - 00 40 00 00  00 00 00 00  .@.......@......
7F4152D0B558: 00 40 00 00  00 00 00 00 - 00 C0 FF FF  FF FF FF FF  .@..............
7F4152D0B568: 00 C0 FF FF  FF FF FF FF - 00 40 00 00  00 00 00 00  .........@......
7F4152D0B578: 00 40 00 00  00 00 00 00 - 00 C0 FF FF  FF FF FF FF  .@..............

Normals: 
7F4152D0B588: 00 C0 FF FF  FF FF FF FF - 00 00 00 00  00 00 00 00  ................
7F4152D0B598: 00 00 00 00  00 00 00 00 - 00 00 00 00  00 00 00 00  ................
7F4152D0B5A8: 00 00 00 00  00 00 00 00 - 00 C0 FF FF  FF FF FF FF  ................
7F4152D0B5B8: 00 40 00 00  00 00 00 00 - 00 00 00 00  00 00 00 00  .@..............
7F4152D0B5C8: 00 00 00 00  00 00 00 00 - 00 00 00 00  00 00 00 00  ................
7F4152D0B5D8: 00 00 00 00  00 00 00 00 - 00 40 00 00  00 00 00 00  .........@......
7F4152D0B5E8: 00 00 00 00  00 00 00 00 - 00 C0 FF FF  FF FF FF FF  ................
7F4152D0B5F8: 00 00 00 00  00 00 00 00 - 00 00 00 00  00 00 00 00  ................
7F4152D0B608: 00 40 00 00  00 00 00 00 - 00 00 00 00  00 00 00 00  .@..............

Faces: 
7F4152D0B618: 02 00 00 00  00 00 00 00 - 01 00 00 00  00 00 00 00  ................
7F4152D0B628: 03 00 00 00  00 00 00 00 - 01 00 00 00  00 00 00 00  ................
7F4152D0B638: 01 00 00 00  00 00 00 00 - 01 00 00 00  00 00 00 00  ................
7F4152D0B648: 04 00 00 00  00 00 00 00 - 02 00 00 00  00 00 00 00  ................
7F4152D0B658: 07 00 00 00  00 00 00 00 - 02 00 00 00  00 00 00 00  ................
7F4152D0B668: 03 00 00 00  00 00 00 00 - 02 00 00 00  00 00 00 00  ................
7F4152D0B678: 08 00 00 00  00 00 00 00 - 03 00 00 00  00 00 00 00  ................
7F4152D0B688: 05 00 00 00  00 00 00 00 - 03 00 00 00  00 00 00 00  ................
7F4152D0B698: 07 00 00 00  00 00 00 00 - 03 00 00 00  00 00 00 00  ................
7F4152D0B6A8: 06 00 00 00  00 00 00 00 - 04 00 00 00  00 00 00 00  ................
7F4152D0B6B8: 01 00 00 00  00 00 00 00 - 04 00 00 00  00 00 00 00  ................
7F4152D0B6C8: 05 00 00 00  00 00 00 00 - 04 00 00 00  00 00 00 00  ................
7F4152D0B6D8: 07 00 00 00  00 00 00 00 - 05 00 00 00  00 00 00 00  ................
7F4152D0B6E8: 01 00 00 00  00 00 00 00 - 05 00 00 00  00 00 00 00  ................
7F4152D0B6F8: 03 00 00 00  00 00 00 00 - 05 00 00 00  00 00 00 00  ................
7F4152D0B708: 04 00 00 00  00 00 00 00 - 06 00 00 00  00 00 00 00  ................
7F4152D0B718: 06 00 00 00  00 00 00 00 - 06 00 00 00  00 00 00 00  ................
7F4152D0B728: 08 00 00 00  00 00 00 00 - 06 00 00 00  00 00 00 00  ................
7F4152D0B738: 02 00 00 00  00 00 00 00 - 01 00 00 00  00 00 00 00  ................
7F4152D0B748: 04 00 00 00  00 00 00 00 - 01 00 00 00  00 00 00 00  ................
7F4152D0B758: 03 00 00 00  00 00 00 00 - 01 00 00 00  00 00 00 00  ................
7F4152D0B768: 04 00 00 00  00 00 00 00 - 02 00 00 00  00 00 00 00  ................
7F4152D0B778: 08 00 00 00  00 00 00 00 - 02 00 00 00  00 00 00 00  ................
7F4152D0B788: 07 00 00 00  00 00 00 00 - 02 00 00 00  00 00 00 00  ................
7F4152D0B798: 08 00 00 00  00 00 00 00 - 03 00 00 00  00 00 00 00  ................
7F4152D0B7A8: 06 00 00 00  00 00 00 00 - 03 00 00 00  00 00 00 00  ................
7F4152D0B7B8: 05 00 00 00  00 00 00 00 - 03 00 00 00  00 00 00 00  ................
7F4152D0B7C8: 06 00 00 00  00 00 00 00 - 04 00 00 00  00 00 00 00  ................
7F4152D0B7D8: 02 00 00 00  00 00 00 00 - 04 00 00 00  00 00 00 00  ................
7F4152D0B7E8: 01 00 00 00  00 00 00 00 - 04 00 00 00  00 00 00 00  ................
7F4152D0B7F8: 07 00 00 00  00 00 00 00 - 05 00 00 00  00 00 00 00  ................
7F4152D0B808: 05 00 00 00  00 00 00 00 - 05 00 00 00  00 00 00 00  ................
7F4152D0B818: 01 00 00 00  00 00 00 00 - 05 00 00 00  00 00 00 00  ................
7F4152D0B828: 04 00 00 00  00 00 00 00 - 06 00 00 00  00 00 00 00  ................
7F4152D0B838: 02 00 00 00  00 00 00 00 - 06 00 00 00  00 00 00 00  ................
7F4152D0B848: 06 00 00 00  00 00 00 00 - 06 00 00 00  00 00 00 00  ................