extra/snake-game/sprites/sprites.factor

   1 ! Copyright (C) 2015 Sankaranarayanan Viswanathan.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays assocs byte-vectors formatting
   4 images images.loader kernel make math math.vectors
   5 opengl.textures sequences ;
   6
   7 IN: snake-game.sprites
   8
   9 : new-image-like ( image w h -- image )
  10     [ clone ] 2dip
  11     [ 2array >>dim ] 2keep *
  12     over bytes-per-pixel * <byte-vector> >>bitmap ;
  13
  14 :: image-part ( image x y w h -- image )
  15     image w h new-image-like :> new-image
  16     h <iota> [| i |
  17         new-image bitmap>>
  18         x y i + w image pixel-row-slice-at
  19         append! drop
  20     ] each new-image ;
  21
  22 :: generate-sprite-sheet ( image rows cols -- seq )
  23     cols rows 2array :> split-dims
  24     image dim>> split-dims [ / ] 2map first2 :> ( sw sh )
  25     rows <iota> sh v*n :> ys
  26     cols <iota> sh v*n :> xs
  27     ys xs [
  28         swap [ image ] 2dip sw sh image-part
  29     ] cartesian-map f join ;
  30
  31 : load-snake-image ( filename -- image )
  32     "vocab:snake-game/_resources/%s" sprintf load-image ;
  33
  34 : load-snake-texture ( file-name -- texture )
  35     load-snake-image { 0 0 } <texture> ;
  36
  37 : load-sprite-textures ( filename cols rows -- seq )
  38     [ load-snake-image ] 2dip generate-sprite-sheet
  39     [ { 0 0 } <texture> ] map ;
  40
  41 : snake-head-textures ( -- assoc )
  42     { "head-up" "head-right" "head-down" "head-left" }
  43     "head.png" 1 4 load-sprite-textures zip ;
  44
  45 : snake-body-textures ( -- assoc )
  46     {
  47         "body-right-up" "body-down-right" "body-right-right"
  48         "body-up-up" "body-up-right" "body-right-down"
  49     }
  50     {
  51         "body-down-left" "body-left-up" "body-left-left"
  52         "body-down-down" "body-left-down" "body-up-left"
  53     }
  54     "body.png" 3 2 load-sprite-textures '[ _ zip ] bi@ append ;
  55
  56 : snake-tail-textures ( -- assoc )
  57     { "tail-down" "tail-left" "tail-up" "tail-right" }
  58     "tail.png" 2 2 load-sprite-textures zip ;
  59
  60 : food-texture ( -- assoc )
  61     "food" "food.png" load-snake-texture 2array 1array ;
  62
  63 : background-texture ( -- assoc )
  64     "background" "background.png" load-snake-texture 2array 1array ;
  65
  66 : snake-textures ( -- assoc )
  67     [
  68         snake-head-textures %%
  69         snake-body-textures %%
  70         snake-tail-textures %%
  71         food-texture %%
  72         background-texture %%
  73     ] H{ } make ;