extra/sokoban/piece/piece.factor

   1 ! Copyright (C) 2006, 2007, 2008 Alex Chapman
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays kernel math math.vectors sequences
   4 sokoban.layout lists.lazy namespaces colors
   5 ranges random ;
   6 IN: sokoban.piece
   7
   8 ! The level_num is an index into the layout's states array,
   9 ! and the position is added to the layout's blocks to give
  10 ! them their location on the sokoban board. If the location is f
  11 ! then the piece is not yet on the board.
  12
  13 TUPLE: piece
  14     { layout layout }
  15     { level_num integer initial: 0 }
  16     { location array initial: { 0 0 } }
  17     { path } ;
  18
  19 : <piece> ( layout -- piece )
  20     piece new swap >>layout ;
  21
  22 : (piece-blocks) ( piece -- blocks )
  23     ! rotates the piece
  24     [ level_num>> ] [ layout>> states>> ] bi nth ;
  25
  26 : wall-blocks ( piece -- blocks )
  27     [ (piece-blocks) ] [ location>> ] bi [ v+ ] curry map ;
  28
  29 : piece-blocks ( piece -- blocks )
  30     location>> { } 1sequence ; ! literally just returns the location in a sequence
  31
  32 : set-location ( piece level -- piece )
  33     ! sets the location of piece to where they are defined in layout
  34     over layout>> states>> nth first >>location ;
  35
  36 : is-goal? ( goal-piece location move -- ? )
  37     ! check if next move is a goal or not
  38     v+ swap [ level_num>> ] [ layout>> ] bi states>> nth member? ;
  39
  40 : <board-piece> ( -- piece )
  41     get-board <piece> ;
  42
  43 : <player-piece> ( level -- piece )
  44     get-player <piece> swap set-location "vocab:sokoban/resources/CharR.png" >>path ;
  45
  46
  47 :: <box-piece> ( box-number goal-piece level  -- piece )
  48     box-number get-box <piece> level set-location "vocab:sokoban/resources/Crate_Yellow.png" >>path dup [ layout>> ] [ location>> ] bi
  49     goal-piece swap { 0 0 } is-goal?
  50     [
  51         COLOR: blue
  52     ]
  53     [
  54         COLOR: orange
  55     ] if
  56     >>color drop ;
  57
  58 :: <box-seq> ( goal-piece level -- seq )
  59     ! get list of boxes on corresponding level
  60     level get-num-boxes [0..b] [ goal-piece level <box-piece> ] map ;
  61
  62 : (rotate-piece) ( level_num inc n-states -- level_num' )
  63     [ + ] dip rem ;
  64
  65 : rotate-piece ( piece inc -- piece )
  66     over layout>> states>> length
  67     [ (rotate-piece) ] 2curry change-level_num ;
  68
  69 : <goal-piece> ( level -- piece )
  70     ! rotate goal according to level
  71     get-goal <piece> swap rotate-piece ;
  72
  73
  74 : move-piece ( piece move -- piece )
  75     [ v+ ] curry change-location ;