extra/papier/sprites/sprites.factor

   1 ! (c)2010 Joe Groff bsd license
   2 USING: accessors kernel locals math papier.map sequences typed ;
   3 IN: papier.sprites
   4
   5 TUPLE: animation-frame
   6     { slab-frame fixnum }
   7     { duration fixnum } ;
   8
   9 TUPLE: animation-cursor
  10     animation
  11     { frame fixnum }
  12     { time fixnum } ;
  13
  14 : <animation-cursor> ( animation -- cursor )
  15     0 0 animation-cursor boa ; inline
  16
  17 TYPED:: inc-cursor ( cursor: animation-cursor -- )
  18     cursor [ time>> ] [ frame>> ] [ animation>> ] tri :> ( time# frame# animation )
  19     frame# animation nth :> frame
  20     time# 1 + :> time'
  21     time' frame duration>> = [
  22         frame# 1 + :> frame'
  23         frame' animation length = [ 0 ] [ frame' ] if :> frame''
  24         cursor
  25             0 >>time
  26             frame'' >>frame
  27             drop
  28     ] [
  29         cursor time' >>time drop
  30     ] if ;
  31
  32 TYPED: cursor-frame ( cursor: animation-cursor -- frame: fixnum )
  33     [ frame>> ] [ animation>> nth ] bi slab-frame>> ; inline
  34
  35 : cursor++ ( cursor -- frame )
  36     [ cursor-frame ] [ inc-cursor ] bi ; inline
  37
  38 : ++cursor ( cursor -- frame )
  39     [ inc-cursor ] [ cursor-frame ] bi ; inline
  40
  41 TUPLE: sprite < slab
  42     animations
  43     { cursor animation-cursor } ;
  44
  45 : <sprite> ( -- sprite ) sprite new ; inline
  46
  47 : start-animation ( sprite animation -- sprite )
  48     <animation-cursor> [ >>cursor ] keep
  49     cursor-frame >>frame ; inline
  50
  51 : switch-animation ( sprite animation -- sprite )
  52     2dup swap cursor>> animation>> eq?
  53     [ drop ] [ start-animation ] if ; inline
  54
  55 : set-up-sprite ( animations sprite -- sprite )
  56     swap
  57     [ >>animations ] keep
  58     first start-animation ; inline
  59
  60 : inc-sprite ( sprite -- sprite )
  61     dup cursor>> ++cursor >>frame ; inline