! 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 *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 ;