Paste: Simple test program

! Copyright (C) 2012 Your name.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel strings namespaces grouping io sequences math 
    combinators generalizations ;
IN: mapgen

CONSTANT: WIDTH  10
CONSTANT: HEIGHT 10
CONSTANT: AREA   100

CONSTANT: WALL  CHAR: #
CONSTANT: FLOOR CHAR: .

SYMBOL: *map* AREA WALL <string> *map* set-global

: map-rows   ( -- *mam*>group  ) *map* get WIDTH group ;
: map>string ( --      >string ) map-rows "\n" join ;
: .map       ( --              ) map>string print ;

: i'-map ( i j -- i' map   ) WIDTH * + *map* get ;
: map[]  ( i j -- map[i,j] ) i'-map nth ;
: map[]! ( elt i j --      ) i'-map set-nth ;

: left  ( room -- n ) [ 0 ] dip nth ;
: right ( room -- n ) [ 1 ] dip nth ;
: up    ( room -- n ) [ 2 ] dip nth ;
: down  ( room -- n ) [ 3 ] dip nth ;

: left-right ( room -- l r ) { [ left ] [ right ] } cleave ;
: up-down    ( room -- u d ) { [  up  ] [ down  ] } cleave ;

: left!  ( elt room -- ) [ 0 ] dip set-nth ;
: right! ( elt room -- ) [ 1 ] dip set-nth ;
: up!    ( elt room -- ) [ 2 ] dip set-nth ;
: down!  ( elt room -- ) [ 3 ] dip set-nth ;

: room-area ( room -- n ) 
    {  
        [ left-right swap - ] ! width
        [  up-down   swap - ] ! height
    } cleave * ;

: dig-here ( i j -- ) FLOOR -rot map[]! ;

: dig ( room -- )
    { [ left-right ] [ up-down ] } cleave
    [ dig-here ] 2each 
    2drop ;