extra/gamelib/cell-object/cell-object.factor

   1 USING: accessors math kernel sequences math.vectors gamelib.board ;
   2
   3 IN: gamelib.cell-object
   4
   5 TUPLE: cell-object draw-cell-delegate ;
   6
   7 GENERIC: draw-cell-object* ( loc dim delegate -- )
   8
   9 : <cell-object*> ( draw-delegate -- cell )
  10     cell-object boa ;
  11
  12 : <cell-object> ( delegate -- cell )
  13     <cell-object*> ; inline
  14
  15
  16 TUPLE: flowcell-object < cell-object flow ;
  17
  18 ! the flowcell-object will move every target frames
  19 ! counter keeps track of how many frames have passed since the flowcell-object has last moved
  20 TUPLE: flow is-on direction target counter ;
  21
  22 ! -------------------- Helper methods ----------------------------------------
  23 ! Checks if the flow constant is at the specified location on the board
  24 :: flow-on? ( flowcell-object -- ? )
  25     flowcell-object flow>> is-on>> ;
  26
  27 ! Add flow information to the cell
  28 :: set-flow ( flowcell-object direction target -- flowcell-object )
  29     t direction target 0 flow boa :> flow-obj
  30     flowcell-object flow-obj >>flow
  31     ;
  32
  33 :: turn-off-flow ( cell -- cell )
  34     f f f f flow boa :> flow-obj
  35     flowcell-object flow-obj >>flow
  36     ;
  37
  38
  39 TUPLE: child-cell < cell-object parent ;
  40
  41
  42 GENERIC: call-parent* ( resources instruction delegate -- )
  43
  44 TUPLE: parent children function ;
  45
  46 : <parent*> ( children function -- parent )
  47     parent boa ;
  48
  49 : <parent> ( children function -- parent )
  50     <parent*> ; inline
  51
  52 :: new-child ( child-pos parent -- )
  53     parent parent children>> { child-pos } append >>children drop ;
  54
  55 :: fill-board-parent ( board parent -- board )
  56     board parent children>> { parent } set-cells ;
  57
  58 :: move-children ( board move parent -- board )
  59     parent children>> :> children
  60     parent children [ move v+ ] map >>children drop
  61     board children children [ move v+ ] map board children first get-cell move-many-objects ;