From: Doug Coleman Date: Sat, 6 Aug 2022 04:38:37 +0000 (-0500) Subject: papier: Add papier as a demo (2009) X-Git-Tag: 0.99~1196 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=3b7b56a3314cf48e878c1df1992394b34b867c8f papier: Add papier as a demo (2009) from https://github.com/jckarter/papier --- diff --git a/extra/papier/_resources/backdrop.png b/extra/papier/_resources/backdrop.png new file mode 100644 index 0000000000..d42745d817 Binary files /dev/null and b/extra/papier/_resources/backdrop.png differ diff --git a/extra/papier/_resources/dancing-cat001.png b/extra/papier/_resources/dancing-cat001.png new file mode 100644 index 0000000000..cfa58164cc Binary files /dev/null and b/extra/papier/_resources/dancing-cat001.png differ diff --git a/extra/papier/_resources/dancing-cat002.png b/extra/papier/_resources/dancing-cat002.png new file mode 100644 index 0000000000..4294750cd7 Binary files /dev/null and b/extra/papier/_resources/dancing-cat002.png differ diff --git a/extra/papier/_resources/dancing-cat003.png b/extra/papier/_resources/dancing-cat003.png new file mode 100644 index 0000000000..69fa1e142b Binary files /dev/null and b/extra/papier/_resources/dancing-cat003.png differ diff --git a/extra/papier/_resources/dancing-cat004.png b/extra/papier/_resources/dancing-cat004.png new file mode 100644 index 0000000000..da22465a5f Binary files /dev/null and b/extra/papier/_resources/dancing-cat004.png differ diff --git a/extra/papier/_resources/dancing-cat005.png b/extra/papier/_resources/dancing-cat005.png new file mode 100644 index 0000000000..d62f5f273a Binary files /dev/null and b/extra/papier/_resources/dancing-cat005.png differ diff --git a/extra/papier/_resources/dancing-cat006.png b/extra/papier/_resources/dancing-cat006.png new file mode 100644 index 0000000000..81ae0a7911 Binary files /dev/null and b/extra/papier/_resources/dancing-cat006.png differ diff --git a/extra/papier/_resources/dancing-cat007.png b/extra/papier/_resources/dancing-cat007.png new file mode 100644 index 0000000000..d3bc1db260 Binary files /dev/null and b/extra/papier/_resources/dancing-cat007.png differ diff --git a/extra/papier/_resources/dancing-cat008.png b/extra/papier/_resources/dancing-cat008.png new file mode 100644 index 0000000000..269324dbaf Binary files /dev/null and b/extra/papier/_resources/dancing-cat008.png differ diff --git a/extra/papier/_resources/dancing-cat009.png b/extra/papier/_resources/dancing-cat009.png new file mode 100644 index 0000000000..45e6ffb654 Binary files /dev/null and b/extra/papier/_resources/dancing-cat009.png differ diff --git a/extra/papier/_resources/dancing-cat010.png b/extra/papier/_resources/dancing-cat010.png new file mode 100644 index 0000000000..6308b8ea7d Binary files /dev/null and b/extra/papier/_resources/dancing-cat010.png differ diff --git a/extra/papier/_resources/dancing-cat011.png b/extra/papier/_resources/dancing-cat011.png new file mode 100644 index 0000000000..f0542fae06 Binary files /dev/null and b/extra/papier/_resources/dancing-cat011.png differ diff --git a/extra/papier/_resources/dancing-cat012.png b/extra/papier/_resources/dancing-cat012.png new file mode 100644 index 0000000000..5f19f4fb77 Binary files /dev/null and b/extra/papier/_resources/dancing-cat012.png differ diff --git a/extra/papier/_resources/ground.png b/extra/papier/_resources/ground.png new file mode 100644 index 0000000000..f4ab380135 Binary files /dev/null and b/extra/papier/_resources/ground.png differ diff --git a/extra/papier/_resources/marco-still001.png b/extra/papier/_resources/marco-still001.png new file mode 100644 index 0000000000..bd8fdeead4 Binary files /dev/null and b/extra/papier/_resources/marco-still001.png differ diff --git a/extra/papier/_resources/marco-walk001.png b/extra/papier/_resources/marco-walk001.png new file mode 100644 index 0000000000..4f51e8beb3 Binary files /dev/null and b/extra/papier/_resources/marco-walk001.png differ diff --git a/extra/papier/_resources/marco-walk002.png b/extra/papier/_resources/marco-walk002.png new file mode 100644 index 0000000000..c551f72969 Binary files /dev/null and b/extra/papier/_resources/marco-walk002.png differ diff --git a/extra/papier/_resources/marco-walk003.png b/extra/papier/_resources/marco-walk003.png new file mode 100644 index 0000000000..7d9a5ae204 Binary files /dev/null and b/extra/papier/_resources/marco-walk003.png differ diff --git a/extra/papier/_resources/marco-walk004.png b/extra/papier/_resources/marco-walk004.png new file mode 100644 index 0000000000..4729b5a955 Binary files /dev/null and b/extra/papier/_resources/marco-walk004.png differ diff --git a/extra/papier/_resources/marco-walk005.png b/extra/papier/_resources/marco-walk005.png new file mode 100644 index 0000000000..9d2cc34b34 Binary files /dev/null and b/extra/papier/_resources/marco-walk005.png differ diff --git a/extra/papier/_resources/marco-walk006.png b/extra/papier/_resources/marco-walk006.png new file mode 100644 index 0000000000..dcaa8017b7 Binary files /dev/null and b/extra/papier/_resources/marco-walk006.png differ diff --git a/extra/papier/_resources/marco-walk007.png b/extra/papier/_resources/marco-walk007.png new file mode 100644 index 0000000000..1a135e726d Binary files /dev/null and b/extra/papier/_resources/marco-walk007.png differ diff --git a/extra/papier/_resources/marco-walk008.png b/extra/papier/_resources/marco-walk008.png new file mode 100644 index 0000000000..fc0ec3044b Binary files /dev/null and b/extra/papier/_resources/marco-walk008.png differ diff --git a/extra/papier/_resources/marco-walk009.png b/extra/papier/_resources/marco-walk009.png new file mode 100644 index 0000000000..4513fe22f6 Binary files /dev/null and b/extra/papier/_resources/marco-walk009.png differ diff --git a/extra/papier/_resources/marco-walk010.png b/extra/papier/_resources/marco-walk010.png new file mode 100644 index 0000000000..cec704a8ec Binary files /dev/null and b/extra/papier/_resources/marco-walk010.png differ diff --git a/extra/papier/_resources/marco-walk011.png b/extra/papier/_resources/marco-walk011.png new file mode 100644 index 0000000000..b41685bed1 Binary files /dev/null and b/extra/papier/_resources/marco-walk011.png differ diff --git a/extra/papier/_resources/marco-walk012.png b/extra/papier/_resources/marco-walk012.png new file mode 100644 index 0000000000..4ebe430264 Binary files /dev/null and b/extra/papier/_resources/marco-walk012.png differ diff --git a/extra/papier/_resources/marco-walk013.png b/extra/papier/_resources/marco-walk013.png new file mode 100644 index 0000000000..9aa2b4f2d8 Binary files /dev/null and b/extra/papier/_resources/marco-walk013.png differ diff --git a/extra/papier/_resources/marco-walk014.png b/extra/papier/_resources/marco-walk014.png new file mode 100644 index 0000000000..8986e69a48 Binary files /dev/null and b/extra/papier/_resources/marco-walk014.png differ diff --git a/extra/papier/map/map.factor b/extra/papier/map/map.factor new file mode 100644 index 0000000000..48ca52ecb1 --- /dev/null +++ b/extra/papier/map/map.factor @@ -0,0 +1,100 @@ +! (c)2010 Joe Groff bsd license +USING: accessors alien assocs classes.struct combinators +combinators.short-circuit fry gpu.shaders images images.atlas +images.loader io.directories io.encodings.utf8 io.files +io.pathnames json json.reader kernel locals math math.matrices.simd +math.vectors.simd sequences sets specialized-arrays +strings typed ; +FROM: alien.c-types => float ; +SPECIALIZED-ARRAYS: float float-4 ; +IN: papier.map + +ERROR: bad-papier-version version ; + +CONSTANT: papier-map-version 3 + +: check-papier-version ( hash -- hash ) + "papier" over at dup papier-map-version = [ drop ] [ bad-papier-version ] if ; + +UNION: ?string string POSTPONE: f ; + +TUPLE: slab + { name ?string } + images + { frame fixnum } + { center float-4 } + { size float-4 } + { orient float-4 } + { color float-4 } + + { matrix matrix4 } + { texcoords float-4-array } ; + +VERTEX-FORMAT: papier-vertex + { "vertex" float-components 3 f } + { f float-components 1 f } + { "texcoord" float-components 2 f } + { f float-components 2 f } + { "color" float-components 4 f } ; +STRUCT: papier-vertex-struct + { vertex float-4 } + { texcoord float-4 } + { color float-4 } ; +SPECIALIZED-ARRAY: papier-vertex-struct + +ERROR: bad-matrix-dim matrix ; + +: parse-slab ( hash -- name images frame center size orient color ) + { + [ "name" swap at [ f ] when-json-null ] + [ "images" swap at ] + [ "frame" swap at >fixnum ] + [ "center" swap at 3 0.0 pad-tail 4 1.0 pad-tail >float-4 ] + [ "size" swap at 4 1.0 pad-tail >float-4 ] + [ "orient" swap at >float-4 ] + [ "color" swap at >float-4 ] + } cleave ; + +TYPED: slab-matrix ( slab: slab -- matrix: matrix4 ) + [ center>> translation-matrix4 ] + [ size>> scale-matrix4 m4. ] + [ orient>> q>matrix4 m4. ] tri ; + +TYPED: update-slab-matrix ( slab: slab -- ) + dup slab-matrix >>matrix drop ; + +TYPED: cycle-slab-frame ( slab: slab -- ) + dup images>> length '[ 1 + dup _ < [ drop 0 ] unless ] change-frame drop ; + +: ( -- slab ) slab new ; inline + +: set-up-slab ( name images frame center size orient color slab -- slab ) + swap >>color + swap >>orient + swap >>size + swap >>center + swap >>frame + swap >>images + swap >>name + dup update-slab-matrix ; inline + +TYPED: update-slab-for-atlas ( slab: slab images -- ) + [ dup images>> ] dip '[ _ at >float-4 ] float-4-array{ } map-as >>texcoords drop ; + +: update-slabs-for-atlas ( slabs images -- ) + '[ _ update-slab-for-atlas ] each ; inline + +: parse-papier-map ( hash -- slabs ) + check-papier-version + "slabs" swap at [ parse-slab set-up-slab ] map ; + +: load-papier-map ( path name -- slabs ) + append-path utf8 file-contents json> parse-papier-map ; + +: load-papier-images ( path -- images atlas ) + [ + [ file-extension { "tiff" "png" } member? ] filter [ dup load-image ] H{ } map>assoc + ] with-directory-files make-atlas-assoc ; + +: slabs-by-name ( slabs -- assoc ) + [ name>> ] filter [ [ name>> ] keep ] H{ } map>assoc ; inline diff --git a/extra/papier/papier.factor b/extra/papier/papier.factor new file mode 100644 index 0000000000..b2ec00e3af --- /dev/null +++ b/extra/papier/papier.factor @@ -0,0 +1,216 @@ +! (c)2010 Joe Groff bsd license +USING: accessors alien.c-types alien.data.map arrays assocs +combinators fry game.input game.input.scancodes game.loop +game.worlds gpu gpu.buffers gpu.framebuffers gpu.render +gpu.shaders gpu.state gpu.textures hashtables images kernel +literals math math.matrices.simd math.order math.vectors +math.vectors.simd papier.map papier.render papier.sprites +sequences sorting typed ui ui.gadgets ui.gadgets.worlds +ui.gestures ui.pixel-formats math.functions ; +IN: papier + +CONSTANT: fov 0.7 +CONSTANT: near-plane 0.25 +CONSTANT: far-plane 1024.0 +CONSTANT: move-rate 0.05 +CONSTANT: eye float-4{ 0.0 2.5 7.0 0.0 } + +CONSTANT: 1/√2 $[ 0.5 sqrt ] +CONSTANT: -1/√2 $[ 0.5 sqrt neg ] + +TUPLE: papier-world < game-world + { slabs array } + { slabs-by-name hashtable } + { slab-images hashtable } + { atlas image } + { uniforms papier-uniforms } + { renderer papier-renderer } ; + +: load-slabs ( -- slabs ) + + "backdrop" >>name + { "backdrop.png" } >>images + 0 >>frame + float-4{ 0 9.0 -2.0 1 } >>center + float-4{ 10 10 1 1 } >>size + float-4{ 1 0 0 0 } >>orient + float-4{ 1 1 1 1 } >>color + { { T{ animation-frame f 0 1 } } } swap set-up-sprite + dup update-slab-matrix + + + "ground" >>name + { "ground.png" } >>images + 0 >>frame + float-4{ 0 -1 0 1 } >>center + float-4{ 10 2 2 1 } >>size + float-4{ $ 1/√2 $ 1/√2 0 0 } >>orient + float-4{ 1 1 1 1 } >>color + { { T{ animation-frame f 0 1 } } } swap set-up-sprite + dup update-slab-matrix + + + "cat" >>name + { + "dancing-cat001.png" + "dancing-cat002.png" + "dancing-cat003.png" + "dancing-cat004.png" + "dancing-cat005.png" + "dancing-cat006.png" + "dancing-cat007.png" + "dancing-cat008.png" + "dancing-cat009.png" + "dancing-cat010.png" + "dancing-cat011.png" + "dancing-cat012.png" + } >>images + 0 >>frame + float-4{ 3 -0.25 -0.1 1 } >>center + float-4{ 0.75 0.75 1.0 1.0 } >>size + float-4{ 1 0 0 0 } >>orient + float-4{ 1 1 1 1 } >>color + { + { + T{ animation-frame f 0 2 } + T{ animation-frame f 1 2 } + T{ animation-frame f 2 2 } + T{ animation-frame f 3 2 } + T{ animation-frame f 4 2 } + T{ animation-frame f 5 2 } + T{ animation-frame f 6 2 } + T{ animation-frame f 7 2 } + T{ animation-frame f 8 2 } + T{ animation-frame f 9 2 } + T{ animation-frame f 10 2 } + T{ animation-frame f 11 2 } + } + } swap set-up-sprite + dup update-slab-matrix + + + "marco" >>name + { + "marco-still001.png" + "marco-walk001.png" + "marco-walk002.png" + "marco-walk003.png" + "marco-walk004.png" + "marco-walk005.png" + "marco-walk006.png" + "marco-walk007.png" + "marco-walk008.png" + "marco-walk009.png" + "marco-walk010.png" + "marco-walk011.png" + "marco-walk012.png" + "marco-walk013.png" + "marco-walk014.png" + } >>images + 0 >>frame + float-4{ -3 0 0 1 } >>center + float-4{ 0.75 1.0 1.0 1.0 } >>size + float-4{ 1 0 0 0 } >>orient + float-4{ 1 1 1 1 } >>color + { + { + T{ animation-frame f 0 1 } + } + { + T{ animation-frame f 3 2 } + T{ animation-frame f 4 2 } + T{ animation-frame f 5 2 } + T{ animation-frame f 6 2 } + T{ animation-frame f 7 2 } + T{ animation-frame f 8 2 } + T{ animation-frame f 9 2 } + T{ animation-frame f 10 2 } + T{ animation-frame f 11 2 } + T{ animation-frame f 12 2 } + T{ animation-frame f 13 2 } + T{ animation-frame f 14 2 } + T{ animation-frame f 1 2 } + T{ animation-frame f 2 2 } + } + } swap set-up-sprite + dup update-slab-matrix + + 4array ; + +: load-images ( -- images atlas ) + "vocab:papier/_resources" load-papier-images ; + +TYPED: prepare-world-slabs ( world: papier-world -- ) + [ dup slabs>> slabs-by-name >>slabs-by-name drop ] + [ [ slabs>> ] [ slab-images>> ] bi update-slabs-for-atlas ] + [ [ uniforms>> atlas>> 0 ] [ atlas>> ] bi allocate-texture-image ] tri ; + +: dim4 ( world -- dim ) dim>> first2 0 0 float-4-boa ; inline + +M: papier-world begin-game-world + init-gpu + set-papier-state + + >>renderer + load-slabs >>slabs + load-images [ >>slab-images ] [ >>atlas ] bi* + + papier-uniforms new + over dim4 fov near-plane far-plane >>p_matrix + eye >>eye + RGBA ubyte-components T{ texture-parameters + { min-mipmap-filter f } + } >>atlas + >>uniforms + + prepare-world-slabs ; + +: move-eye ( world amount -- ) + [ uniforms>> ] dip '[ _ v+ ] change-eye drop ; inline + +: keyboard-input ( papier-world -- movement/f face/f ) + read-keyboard keys>> { + { [ key-left-arrow over nth ] [ 2drop float-4{ $ move-rate 0 0 0 } vneg float-4{ 0 0 1 0 } ] } + { [ key-right-arrow over nth ] [ 2drop float-4{ $ move-rate 0 0 0 } float-4{ 1 0 0 0 } ] } + { [ key-escape over nth ] [ drop close-window f f ] } + [ 2drop f f ] + } cond ; + +: update-slabs ( slabs -- ) + [ inc-sprite drop ] each ; + +: move-player ( world move face -- ) + [ slabs-by-name>> "marco" swap at dup animations>> second switch-animation ] 2dip + [ '[ _ v+ ] change-center ] [ >>orient ] bi* update-slab-matrix ; + +: stop-player ( world -- ) + slabs-by-name>> "marco" swap at dup animations>> first switch-animation drop ; + +M: papier-world tick-game-world + dup slabs>> update-slabs + dup focused?>> [ + dup keyboard-input + [ move-player ] + [ drop stop-player ] if* + ] [ drop ] if ; + +M: papier-world draw-world* + [ renderer>> ] [ uniforms>> ] [ slabs>> ] tri draw-slabs ; + +M: papier-world resize-world + [ uniforms>> ] + [ dim4 fov near-plane far-plane ] bi + >>p_matrix drop ; + +GAME: papier-game { + { world-class papier-world } + { title "Papier" } + { pixel-format-attributes { + windowed + double-buffered + T{ depth-bits { value 24 } } + } } + { use-game-input? t } + { pref-dim { 1024 768 } } + { tick-interval-nanos $[ 24 fps ] } + } ; diff --git a/extra/papier/render/papier.f.glsl b/extra/papier/render/papier.f.glsl new file mode 100644 index 0000000000..bda6cf60c7 --- /dev/null +++ b/extra/papier/render/papier.f.glsl @@ -0,0 +1,11 @@ +#version 110 + +uniform sampler2D atlas; + +varying vec2 frag_texcoord; +varying vec4 frag_color; + +void main() +{ + gl_FragColor = frag_color * texture2D(atlas, frag_texcoord); +} diff --git a/extra/papier/render/papier.v.glsl b/extra/papier/render/papier.v.glsl new file mode 100644 index 0000000000..4a0fd4b4ba --- /dev/null +++ b/extra/papier/render/papier.v.glsl @@ -0,0 +1,19 @@ +#version 110 + +uniform mat4 p_matrix; +uniform vec3 eye; + +attribute vec3 vertex; +attribute vec2 texcoord; +attribute vec4 color; + +varying vec2 frag_texcoord; +varying vec4 frag_color; + +void +main() +{ + gl_Position = p_matrix * vec4(vertex - eye, 1.0); + frag_texcoord = texcoord; + frag_color = color; +} diff --git a/extra/papier/render/render.factor b/extra/papier/render/render.factor new file mode 100644 index 0000000000..ce325b8562 --- /dev/null +++ b/extra/papier/render/render.factor @@ -0,0 +1,94 @@ +! (c)2010 Joe Groff bsd license +USING: accessors alien.c-types alien.data.map combinators fry +gpu.buffers gpu.framebuffers gpu.render gpu.shaders gpu.state +images images.atlas kernel locals math math.matrices.simd +math.order math.vectors math.vectors.simd papier.map sequences +sorting typed ; +IN: papier.render + +CONSTANT: slab-buffer-chunk-size 1024 + +GLSL-SHADER-FILE: papier-vertex-shader vertex-shader "papier.v.glsl" +GLSL-SHADER-FILE: papier-fragment-shader fragment-shader "papier.f.glsl" +GLSL-PROGRAM: papier-program + papier-vertex-shader papier-fragment-shader + papier-vertex ; + +UNIFORM-TUPLE: papier-uniforms + { "p_matrix" mat4-uniform f } + { "eye" vec3-uniform f } + { "atlas" texture-uniform f } ; + +TUPLE: papier-renderer + { vertex-buffer buffer } + { index-buffer buffer } + { vertex-array vertex-array initial: T{ vertex-array-object } } ; + +: set-papier-state ( -- ) + { + T{ blend-state { rgb-mode T{ blend-mode } } { alpha-mode T{ blend-mode } } } + } set-gpu-state ; + +TYPED:: ( -- renderer: papier-renderer ) + papier-renderer new + stream-upload draw-usage index-buffer slab-buffer-chunk-size f >>index-buffer + stream-upload draw-usage vertex-buffer slab-buffer-chunk-size f + [ >>vertex-buffer ] + [ papier-program >>vertex-array ] bi ; + +:: ( dim fov near-plane far-plane -- matrix ) + dim dup first2 min >float v/n fov v*n near-plane v*n + near-plane far-plane frustum-matrix4 ; inline + +: slab-vertices ( slab -- av at ac bv bt bc cv ct cc dv dt dc ) + [ matrix>> ] [ [ frame>> ] [ texcoords>> ] bi nth ] [ color>> ] tri { + [ [ float-4{ -1 -1 0 1 } m4.v ] [ ] [ ] tri* ] + [ [ float-4{ 1 -1 0 1 } m4.v ] [ { 2 1 0 3 } vshuffle ] [ ] tri* ] + [ [ float-4{ -1 1 0 1 } m4.v ] [ { 0 3 2 1 } vshuffle ] [ ] tri* ] + [ [ float-4{ 1 1 0 1 } m4.v ] [ { 2 3 0 1 } vshuffle ] [ ] tri* ] + } 3cleave ; inline + +: slab-indexes ( i -- a b c d e f ) + 4 * { [ ] [ 1 + ] [ 2 + ] [ 2 + ] [ 1 + ] [ 3 + ] } cleave ; inline + +: order-slabs ( slabs eye -- slabs' ) + ! NO + ! '[ center>> _ v- norm-sq ] inv-sort-with ; inline + drop ; + +: render-slabs ( slabs -- vertices indexes ) + dup length [ + [ slab-vertices ] + [ slab-indexes ] bi* + ] data-map( object object -- float-4[12] uint[6] ) ; inline + +TYPED:: render-slabs-to-buffers ( renderer: papier-renderer uniforms: papier-uniforms slabs -- ) + slabs uniforms eye>> order-slabs render-slabs :> ( vertices indexes ) + renderer vertex-buffer>> vertices allocate-byte-array + renderer index-buffer>> indexes allocate-byte-array ; inline + +: slab-index-count ( slabs -- count ) + length 6 * ; inline + +TYPED: prep-slab-atlas ( slabs images -- atlas-image: image ) + make-atlas-assoc [ update-slabs-for-atlas ] dip ; + +TYPED:: draw-slabs ( renderer: papier-renderer uniforms: papier-uniforms slabs -- ) + system-framebuffer { { default-attachment { 0.0 0.0 0.0 0.0 } } } clear-framebuffer + + renderer uniforms slabs render-slabs-to-buffers + + renderer index-buffer>> 0 slabs slab-index-count + uint-indexes :> indexes + + renderer vertex-array>> :> vertex-array + + triangles-mode + vertex-array + uniforms + indexes + f + system-framebuffer + { default-attachment } + f render-set boa render ; + diff --git a/extra/papier/resources.txt b/extra/papier/resources.txt new file mode 100644 index 0000000000..fcacd6e132 --- /dev/null +++ b/extra/papier/resources.txt @@ -0,0 +1 @@ +_resources diff --git a/extra/papier/sprites/sprites-tests.factor b/extra/papier/sprites/sprites-tests.factor new file mode 100644 index 0000000000..814489e099 --- /dev/null +++ b/extra/papier/sprites/sprites-tests.factor @@ -0,0 +1,20 @@ +! (c)2010 Joe Groff bsd license +USING: combinators papier.sprites tools.test ; +IN: papier.sprites.tests + +[ 10 10 10 11 11 12 10 ] +[ + { + T{ animation-frame f 10 3 } + T{ animation-frame f 11 2 } + T{ animation-frame f 12 1 } + } { + [ cursor++ ] + [ cursor++ ] + [ cursor++ ] + [ cursor++ ] + [ cursor++ ] + [ cursor++ ] + [ cursor++ ] + } cleave +] unit-test diff --git a/extra/papier/sprites/sprites.factor b/extra/papier/sprites/sprites.factor new file mode 100644 index 0000000000..7f67dae210 --- /dev/null +++ b/extra/papier/sprites/sprites.factor @@ -0,0 +1,61 @@ +! (c)2010 Joe Groff bsd license +USING: accessors kernel locals math papier.map sequences typed ; +IN: papier.sprites + +TUPLE: animation-frame + { slab-frame fixnum } + { duration fixnum } ; + +TUPLE: animation-cursor + animation + { frame fixnum } + { time fixnum } ; + +: ( animation -- cursor ) + 0 0 animation-cursor boa ; inline + +TYPED:: inc-cursor ( cursor: animation-cursor -- ) + cursor [ time>> ] [ frame>> ] [ animation>> ] tri :> ( time# frame# animation ) + frame# animation nth :> frame + time# 1 + :> time' + time' frame duration>> = [ + frame# 1 + :> frame' + frame' animation length = [ 0 ] [ frame' ] if :> frame'' + cursor + 0 >>time + frame'' >>frame + drop + ] [ + cursor time' >>time drop + ] if ; + +TYPED: cursor-frame ( cursor: animation-cursor -- frame: fixnum ) + [ frame>> ] [ animation>> nth ] bi slab-frame>> ; inline + +: cursor++ ( cursor -- frame ) + [ cursor-frame ] [ inc-cursor ] bi ; inline + +: ++cursor ( cursor -- frame ) + [ inc-cursor ] [ cursor-frame ] bi ; inline + +TUPLE: sprite < slab + animations + { cursor animation-cursor } ; + +: ( -- sprite ) sprite new ; inline + +: start-animation ( sprite animation -- sprite ) + [ >>cursor ] keep + cursor-frame >>frame ; inline + +: switch-animation ( sprite animation -- sprite ) + 2dup swap cursor>> animation>> eq? + [ drop ] [ start-animation ] if ; inline + +: set-up-sprite ( animations sprite -- sprite ) + swap + [ >>animations ] keep + first start-animation ; inline + +: inc-sprite ( sprite -- sprite ) + dup cursor>> ++cursor >>frame ; inline diff --git a/extra/papier/tags.txt b/extra/papier/tags.txt new file mode 100644 index 0000000000..a98b4edb56 --- /dev/null +++ b/extra/papier/tags.txt @@ -0,0 +1,2 @@ +demos +graphics