74 lines
2.4 KiB
Factor
74 lines
2.4 KiB
Factor
|
! Copyright (C) 2015 Your name.
|
||
|
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
|
USING: accessors arrays assocs byte-vectors formatting fry
|
||
|
|
images images.loader kernel locals make math math.vectors
|
||
|
|
opengl.textures sequences ;
|
||
|
|
|
||
|
|
IN: snake-game.sprites
|
||
|
|
|
||
|
|
: new-image-like ( image w h -- image )
|
||
|
|
[ clone ] 2dip
|
||
|
|
[ 2array >>dim ] 2keep *
|
||
|
|
over bytes-per-pixel * <byte-vector> >>bitmap ;
|
||
|
|
|
||
|
|
:: image-part ( image x y w h -- image )
|
||
|
|
image w h new-image-like :> new-image
|
||
|
|
h iota [| i |
|
||
|
|
new-image bitmap>>
|
||
|
|
x y i + w image pixel-row-slice-at
|
||
|
|
append! drop
|
||
|
|
] each new-image ;
|
||
|
|
|
||
|
|
:: generate-sprite-sheet ( image rows cols -- seq )
|
||
|
|
cols rows 2array :> split-dims
|
||
|
|
image dim>> split-dims [ / ] 2map first2 :> ( sw sh )
|
||
|
|
rows iota sh v*n :> ys
|
||
|
|
cols iota sh v*n :> xs
|
||
|
|
ys xs [
|
||
|
|
swap [ image ] 2dip sw sh image-part
|
||
|
|
] cartesian-map f join ;
|
||
|
|
|
||
|
|
: load-sprite-image ( filename -- image )
|
||
|
|
"vocab:snake-game/_resources/%s" sprintf load-image ;
|
||
|
|
|
||
|
|
: make-texture ( image -- texture )
|
||
|
|
{ 0 0 } <texture> ;
|
||
|
|
|
||
|
|
: make-sprites ( filename cols rows -- seq )
|
||
|
|
[ load-sprite-image ] 2dip generate-sprite-sheet
|
||
|
|
[ make-texture ] map ;
|
||
|
|
|
||
|
|
: snake-head-textures ( -- assoc )
|
||
|
|
"head.png" 1 4 make-sprites
|
||
|
|
{ "head-up" "head-right" "head-down" "head-left" }
|
||
|
|
[ swap 2array ] 2map ;
|
||
|
|
|
||
|
|
:: assoc-with-value-like ( assoc key seq -- )
|
||
|
|
key assoc at :> value
|
||
|
|
seq [ [ value ] dip assoc set-at ] each ;
|
||
|
|
|
||
|
|
: snake-body-textures ( -- assoc )
|
||
|
|
"body.png" 3 2 make-sprites
|
||
|
|
{ 1 2 3 4 5 6 }
|
||
|
|
[ swap 2array ] 2map
|
||
|
|
dup 1 { "body-right-up" "body-down-left" } assoc-with-value-like
|
||
|
|
dup 2 { "body-down-right" "body-left-up" } assoc-with-value-like
|
||
|
|
dup 3 { "body-right-right" "body-left-left" } assoc-with-value-like
|
||
|
|
dup 4 { "body-up-up" "body-down-down" } assoc-with-value-like
|
||
|
|
dup 5 { "body-up-right" "body-left-down" } assoc-with-value-like
|
||
|
|
dup 6 { "body-right-down" "body-up-left" } assoc-with-value-like
|
||
|
|
dup [ { 1 2 3 4 5 6 } ] dip [ delete-at ] curry each ;
|
||
|
|
|
||
|
|
: snake-tail-textures ( -- assoc )
|
||
|
|
"tail.png" 2 2 make-sprites
|
||
|
|
{ "tail-down" "tail-left" "tail-up" "tail-right" }
|
||
|
|
[ swap 2array ] 2map ;
|
||
|
|
|
||
|
|
: food-texture ( -- assoc )
|
||
|
|
"food" "food.png" load-sprite-image make-texture
|
||
|
|
2array 1array ;
|
||
|
|
|
||
|
|
: background-texture ( -- assoc )
|
||
|
|
"background" "background.png" load-sprite-image make-texture
|
||
|
|
2array 1array ;
|