--- /dev/null
+! (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 ) 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 <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
--- /dev/null
+! (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 )
+ <sprite>
+ "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
+
+ <sprite>
+ "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
+
+ <sprite>
+ "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
+
+ <sprite>
+ "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
+
+ <papier-renderer> >>renderer
+ load-slabs >>slabs
+ load-images [ >>slab-images ] [ >>atlas ] bi*
+
+ papier-uniforms new
+ over dim4 fov near-plane far-plane <p-matrix> >>p_matrix
+ eye >>eye
+ RGBA ubyte-components T{ texture-parameters
+ { min-mipmap-filter f }
+ } <texture-2d> >>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 <p-matrix> ] 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 ] }
+ } ;
--- /dev/null
+#version 110
+
+uniform sampler2D atlas;
+
+varying vec2 frag_texcoord;
+varying vec4 frag_color;
+
+void main()
+{
+ gl_FragColor = frag_color * texture2D(atlas, frag_texcoord);
+}
--- /dev/null
+#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;
+}
--- /dev/null
+! (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:: <papier-renderer> ( -- renderer: papier-renderer )
+ papier-renderer new
+ stream-upload draw-usage index-buffer slab-buffer-chunk-size f <buffer> >>index-buffer
+ stream-upload draw-usage vertex-buffer slab-buffer-chunk-size f <buffer>
+ [ >>vertex-buffer ]
+ [ papier-program <program-instance> <vertex-array> >>vertex-array ] bi ;
+
+:: <p-matrix> ( 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 <iota> [
+ [ 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 <buffer-ptr> slabs slab-index-count
+ uint-indexes <index-elements> :> indexes
+
+ renderer vertex-array>> :> vertex-array
+
+ triangles-mode
+ vertex-array
+ uniforms
+ indexes
+ f
+ system-framebuffer
+ { default-attachment }
+ f render-set boa render ;
+
--- /dev/null
+_resources
--- /dev/null
+! (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 }
+ } <animation-cursor> {
+ [ cursor++ ]
+ [ cursor++ ]
+ [ cursor++ ]
+ [ cursor++ ]
+ [ cursor++ ]
+ [ cursor++ ]
+ [ cursor++ ]
+ } cleave
+] unit-test
--- /dev/null
+! (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> ( 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 ) sprite new ; inline
+
+: start-animation ( sprite animation -- sprite )
+ <animation-cursor> [ >>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
--- /dev/null
+demos
+graphics
projects / factor.git / commitdiff
