Squashed commit of the following:

author John Benediktsson <mrjbq7@gmail.com>

Sun, 31 Jul 2022 21:16:08 +0000 (14:16 -0700)

committer John Benediktsson <mrjbq7@gmail.com>

Sun, 31 Jul 2022 21:16:08 +0000 (14:16 -0700)
author John Benediktsson <mrjbq7@gmail.com>
Sun, 31 Jul 2022 21:16:08 +0000 (14:16 -0700)
committer John Benediktsson <mrjbq7@gmail.com>
Sun, 31 Jul 2022 21:16:08 +0000 (14:16 -0700)
diff --git a/extra/gamelib/board/board.factor b/extra/gamelib/board/board.factor

new file mode 100644 (file)

index 0000000..03f2521
--- /dev/null
+++ b/extra/gamelib/board/board.factor
@@ -0,0 +1,260 @@
+USING: assocs classes sequences sequences.generalizations math
+timers sets kernel accessors sequences.extras ranges
+math.vectors generalizations strings prettyprint gamelib.loop
+ui.gadgets ;
+
+IN: gamelib.board
+
+TUPLE: board width height cells ;
+
+
+CONSTANT: UP { 0 -1 } 
+CONSTANT: DOWN { 0 1 } 
+CONSTANT: RIGHT { 1 0 }
+CONSTANT: LEFT { -1 0 }
+
+! Make cells, with an empty sequence as the default cell
+:: make-cells ( width height -- cells )
+    height [ width [ { } clone ] replicate ] replicate ;
+
+:: make-board ( width height -- board )
+    width height make-cells :> cells
+    width height cells board boa ;
+
+! Sets all cells to an empty sequence
+:: reset-board ( board -- board )
+    board width>> board height>> make-board ;
+
+:: get-cell ( board location -- cell )
+    location first2 :> ( x y )
+    board cells>> :> cells
+    x y cells nth nth ;
+
+! Gets all cells in locations array and return as a sequence
+:: get-cells ( board locations -- seq )
+    locations [ board swap get-cell ] map ;
+
+:: get-instance-from-cell ( cell class -- object )
+    cell [ class instance? ] find swap drop ;
+
+! returns all elements of a specified row as a seq
+:: get-row ( board index -- seq )
+    index board cells>> nth ;
+
+! returns all elements of a specified column as a seq
+:: get-col ( board index -- seq )
+    board 
+    board height>> [ index ] replicate 
+    board height>> [0..b) zip 
+    get-cells ;
+
+! For a board, set the cell at the given location to new-cell (should be a sequence)
+:: set-cell ( board location new-cell -- board )
+    location first2 :> ( x y )
+    board cells>> :> cells
+    new-cell sequence? new-cell string? not and
+    [
+        new-cell x y cells nth set-nth
+    ]
+    [ "New cell is not a sequence! No changes made." . ] if
+    board ;
+
+! For a board, set all the given locations to a new cell (should be a sequence)
+:: set-cells ( board locations new-cell -- board )
+    locations [ board swap new-cell set-cell drop ] each
+    board ;
+
+! Applies a quotation to a specific cell
+:: change-cell ( board location quot -- board )
+    location first2 :> ( x y )
+    board cells>> :> cells
+    x y cells nth quot change-nth
+    board ; inline
+
+! Adds an object to the cell at the specified location in a board
+:: add-to-cell ( board location obj -- board )
+    board cells>> :> cells
+    board location get-cell :> old-cell
+    old-cell { obj } append :> new-cell
+    board location new-cell set-cell ;
+
+! Adds an object to all the given locations to new-cell 
+:: add-to-cells ( board locations obj -- board )
+    locations [ board swap obj add-to-cell drop ] each
+    board ;
+
+! Adds a copy of an object to all the given locations to new-cell
+:: add-copy-to-cells ( board locations obj -- board )
+    locations [ board swap obj clone add-to-cell drop ] each
+    board ;
+
+! Sets a cell back to the default cell
+:: delete-cell ( board location -- board )
+    board location { } set-cell ;
+
+! Delete the first instance of obj in the cell at the specified location in the board (if found)
+:: delete-from-cell ( board location obj -- board )
+    board location get-cell :> cell
+    cell [ obj = ] find drop :> obj-index
+    obj-index
+    [
+        obj-index cell remove-nth :> new-cell
+        board location new-cell set-cell
+    ] [
+        board
+    ] if ;
+
+! Delete the first instance of obj from all cells at the specified locations in the board (if found)
+:: delete-from-cells ( board locations obj -- board )
+    locations [ board swap obj delete-from-cell drop ] each
+    board ;
+
+! Like delete-from-cell, but delete all instances of obj (if found)
+:: delete-all-from-cell ( board location obj -- board )
+    board location [ obj swap remove ] change-cell ;
+
+! Like delete-all-from-cell, but deletes from all specified locations in the board (if found)
+:: delete-all-from-cells ( board locations obj -- board )
+    locations [ board swap obj delete-all-from-cell drop ] each
+    board ;
+
+! Helper word that creates a sequence of n k's
+:: make-n-k ( n k -- seq )
+    n [ k ] replicate ;
+
+! Helper word that creates a list of all cell locations in the board
+:: location-matrix ( board -- loclist )
+    board width>> :> w
+    board height>> :> h
+    w [0..b) :> single-row
+    h [0..b) :> single-col
+    h [ single-row ] replicate concat :> x-vals
+    h [ w ] replicate :> w-list
+    w-list single-col [ make-n-k ] 2map concat :> y-vals
+    x-vals y-vals zip ;
+
+! Sets all cells to a given sequence
+:: set-all ( board seq -- board )
+    board location-matrix :> loclist
+    board loclist seq set-cells ;
+
+! Deletes all instances of obj from all cells (if found)
+:: delete-from-all ( board obj -- board )
+    board location-matrix :> loclist
+    board loclist obj delete-all-from-cells ;
+
+:: duplicate-cell ( board start dest -- board )
+    board dup start get-cell dest swap set-cell ;
+
+! Moves an entire cell if it can be moved to a new destination, leaving the original cell empty
+:: move-entire-cell ( board start dest -- board )
+    ! bound checking
+    { start dest } [ first board width>> < ] all? 
+    { start dest } [ second board height>> < ] all? and
+    start [ 0 >= ] all? and 
+    dest [ 0 >= ] all? and 
+    ! move cell
+    [ board start dest duplicate-cell
+    start delete-cell drop ] when 
+    board ;
+
+! Move an object from a cell, relative to its original cell
+:: move-object ( board object-pos move object -- board )
+    object-pos move v+ :> dest
+    { object-pos dest } [ first board width>> < ] all? 
+    { object-pos dest } [ second board height>> < ] all? and
+    object-pos [ 0 >= ] all? and 
+    dest [ 0 >= ] all? and 
+    [ board object-pos object delete-from-cell
+    dest object add-to-cell drop ] when
+    board ;
+
+! Move a specified object in many cells to different locations
+:: move-objects ( board start dest object -- board )
+    board start object delete-from-cells
+    dest object add-to-cells ;
+
+:: move-many-objects ( board start dest objects -- board )
+    board objects [ start swap dest swap move-objects ] each ;
+
+! move a cell with a move relative to its start
+:: move-entire-cell-rel ( board start move -- board )
+    board start start move v+ move-entire-cell ;
+
+! move cells of a parent (only works when cells are all the same)
+:: move-cells ( board start dest -- board )
+    board start first get-cell :> cell
+    board start [ delete-cell ] each
+    dest cell set-cells ;
+
+:: swap-cells ( board loc1 loc2 -- board )
+    board loc1 get-cell :> cell1
+    board loc2 get-cell :> cell2
+    board loc2 cell1 set-cell
+    loc1 cell2 set-cell ;
+
+! Returns true if cell at location is the default cell
+:: is-cell-empty? ( board location -- ? )
+    board location get-cell { } = ;
+
+:: is-board-empty? ( board -- ? )
+    board cells>> [ [ { } = ] all? ] all? ;
+
+! Return index and row that contains the first cell that satisfies the quot
+:: find-row ( board quot -- index row )
+    board cells>> [ [ quot find drop ] find drop ] find ; inline
+
+! Return first location and cell that satisfies the quot
+:: find-cell ( board quot -- seq cell )
+    board quot find-row swap :> y
+    [ quot find drop ] find swap :> x
+    { x y } swap ; inline
+
+! Return first cell that satisfies the quot
+:: find-cell-nopos ( board quot -- cell )
+    board cells>> [ quot find swap drop ] map-find drop ; inline
+
+: find-cell-pos ( board quot -- seq )
+    find-cell drop ; inline
+
+! Returns a vector containing index row pairs
+:: find-all-rows ( board quot -- index row )
+    board cells>> [ quot find swap drop ] find-all ; inline
+
+: is-empty? ( cell -- ?  )
+    { } = ;
+
+: cell-contains? ( cell object -- ? )
+    swap in? ;
+
+:: cell-only-contains? ( cell object -- ? )
+    cell length 1 = 
+    cell object cell-contains? and ;
+
+:: cell-contains-instance? ( cell class -- ? )
+    cell [ class instance? ] any? ;
+
+:: cell-only-contains-instance? ( cell class -- ? )
+    cell length 1 = 
+    cell class cell-contains-instance? and ;
+
+! Helper function that formats a position cell pair
+:: label-cell ( x cell y -- seq )
+    { { x y } cell } ;
+
+! Helper function that finds all cells in an given row that satisfy the quot 
+:: row-to-cells ( seq quot -- cells )
+    seq first2 :> ( y row )
+    row quot find-all :> indexed-cells
+    indexed-cells [ first2 y label-cell ] map ; inline
+
+! Return a vector of position cell pairs of all cells in the board that satisfy the quot
+:: find-all-cells ( board quot -- assoc )
+    board quot find-all-rows :> row-list ! find-all - returns vector w/ index/elt
+    row-list [ quot row-to-cells ] map concat ; inline
+
+:: find-all-cells-nopos ( board quot -- assoc )
+    board quot find-all-cells [ second ] map ; inline
+
+:: all-equal-value? ( value seq -- ? )
+    seq [ value = ] all? ;
diff --git a/extra/gamelib/cell-object/cell-object.factor b/extra/gamelib/cell-object/cell-object.factor

new file mode 100644 (file)

index 0000000..98472dc
--- /dev/null
+++ b/extra/gamelib/cell-object/cell-object.factor
@@ -0,0 +1,61 @@
+USING: accessors math kernel sequences math.vectors gamelib.board ;
+
+IN: gamelib.cell-object 
+
+TUPLE: cell-object draw-cell-delegate ;
+    
+GENERIC: draw-cell-object* ( loc dim delegate -- )
+
+: <cell-object*> ( draw-delegate -- cell )
+    cell-object boa ;
+
+: <cell-object> ( delegate -- cell )
+    <cell-object*> ; inline
+
+
+TUPLE: flowcell-object < cell-object flow ;
+
+! the flowcell-object will move every target frames
+! counter keeps track of how many frames have passed since the flowcell-object has last moved
+TUPLE: flow is-on direction target counter ;
+
+! -------------------- Helper methods ----------------------------------------
+! Checks if the flow constant is at the specified location on the board
+:: flow-on? ( flowcell-object -- ? )
+    flowcell-object flow>> is-on>> ;
+
+! Add flow information to the cell
+:: set-flow ( flowcell-object direction target -- flowcell-object ) 
+    t direction target 0 flow boa :> flow-obj
+    flowcell-object flow-obj >>flow
+    ;
+
+:: turn-off-flow ( cell -- cell ) 
+    f f f f flow boa :> flow-obj
+    flowcell-object flow-obj >>flow
+    ;
+
+
+TUPLE: child-cell < cell-object parent ;
+
+
+GENERIC: call-parent* ( resources instruction delegate -- )
+
+TUPLE: parent children function ;
+
+: <parent*> ( children function -- parent )
+    parent boa ;
+
+: <parent> ( children function -- parent )
+    <parent*> ; inline
+
+:: new-child ( child-pos parent -- )
+    parent parent children>> { child-pos } append >>children drop ;
+
+:: fill-board-parent ( board parent -- board )
+    board parent children>> { parent } set-cells ;
+
+:: move-children ( board move parent -- board )
+    parent children>> :> children
+    parent children [ move v+ ] map >>children drop
+    board children children [ move v+ ] map board children first get-cell move-many-objects ;
diff --git a/extra/gamelib/demos/flow-demo/flow-demo.factor b/extra/gamelib/demos/flow-demo/flow-demo.factor

new file mode 100644 (file)

index 0000000..22c0e2d
--- /dev/null
+++ b/extra/gamelib/demos/flow-demo/flow-demo.factor
@@ -0,0 +1,93 @@
+
+USING: literals kernel namespaces accessors sequences
+combinators math.vectors colors gamelib.ui gamelib.board
+gamelib.cell-object gamelib.loop game.loop ui.gestures
+ui.gadgets opengl opengl.textures images.loader prettyprint
+classes math ;
+
+IN: gamelib.demos.flow-demo
+
+CONSTANT: light-crate "vocab:gamelib/demos/sokoban/resources/Crate_Yellow.png"
+
+TUPLE: crate-cell < flowcell-object image-path ;
+
+! Note -- probably need to cache larger images
+M: crate-cell draw-cell-object* 
+    rot [ image-path>> load-image ] dip <texture> draw-scaled-texture ;
+
+:: make-crate ( image-path -- crate )
+    crate-cell new 
+    f image-path crate-cell boa ;
+
+: board-one ( gadget -- gadget )
+    8 9 make-board
+
+    { { 1 1 } } light-crate make-crate RIGHT 220 set-flow add-to-cells 
+    { { 3 1 } } light-crate make-crate DOWN 75 set-flow add-to-cells
+    { { 5 1 } } light-crate make-crate DOWN 20 set-flow add-to-cells 
+    { } 1sequence add-board ;
+
+! -------------------- Game loop --------------------------------------------------
+    
+TUPLE: game-state gadget ;
+
+:: <game-state> ( gadget -- gadget game-state )
+    gadget 
+    game-state new 
+    gadget >>gadget ;
+
+: create-loop ( game-state -- )
+    10000000 swap new-game-loop start-loop ;
+
+! Updates a crate-cell's location if a target number of frames have passed, otherwise it updates the counter
+:: update-location ( board loc flowcell-object -- )
+    flowcell-object flow-on?
+    [
+        flowcell-object flow>> :> flow-obj
+        flow-obj target>> :> target
+        flow-obj counter>> 1 + :> counter
+        counter target =
+        [
+            flow-obj direction>> :> direction
+            board loc direction flowcell-object move-object drop
+            flow-obj 0 >>counter drop
+
+        ]
+        [
+            flow-obj counter >>counter drop
+        ]
+        if
+        flowcell-object flow-obj >>flow drop
+    ] when ;
+
+! Takes in a cell object and updates its location based on its flow if the cell object is a crate-cell
+:: update-all-flowcells ( board loc obj -- )
+    obj crate-cell instance?
+    [
+        board loc obj update-location
+    ] when ;
+
+! Takes a board, a location, and the corresponding cell and updates all crate-cell objects in the cell
+:: update-all-cells-with-flowcells ( board pair -- )
+    pair first2 :> ( loc cell )
+    board loc cell [ update-all-flowcells ] 2with each ;
+
+:: tick-update ( game-state -- )
+    game-state gadget>> :> g
+    g board>> :> boards
+    boards first [ crate-cell cell-contains-instance? ] find-all-cells :> all-cells
+    boards first all-cells [ update-all-cells-with-flowcells ] with each
+    g relayout ;
+
+M: game-state tick* tick-update ;
+
+M: game-state draw* drop drop ;
+
+
+: main ( -- )
+    { 700 800 } init-board-gadget
+    board-one
+    <game-state> create-loop
+    display ;
+
+MAIN: main
diff --git a/extra/gamelib/demos/maze-game/maze-game.factor b/extra/gamelib/demos/maze-game/maze-game.factor

new file mode 100644 (file)

index 0000000..4903aa2
--- /dev/null
+++ b/extra/gamelib/demos/maze-game/maze-game.factor
@@ -0,0 +1,84 @@
+USING: accessors colors combinators gamelib.board gamelib.ui
+kernel math math.vectors prettyprint sequences ui ui.gadgets
+ui.gadgets.scrollers ui.gadgets.sliders ui.gadgets.tracks
+ui.gestures ;
+
+IN: gamelib.demos.maze-game
+
+TUPLE: maze-gadget < track maze-scroller board-gadget ;
+
+: board ( gadget -- gadget )
+    17 17 make-board
+    { 
+        { 0  0 } { 1  0 } { 2  0 } { 3  0 } { 4  0 } { 5  0 } { 6  0 } { 7  0 } { 8  0 } { 9  0 } { 10  0 } { 11  0 } { 12  0 } { 13  0 } { 14  0 } { 15  0 } { 16  0 }
+                                                                                { 8  1 }                                                                      { 16  1 }
+        { 0  2 } { 1  2 } { 2  2 } { 3  2 } { 4  2 }          { 6  2 }          { 8  2 } { 9  2 } { 10  2 } { 11  2 } { 12  2 }           { 14  2 }           { 16  2 }                  
+        { 0  3 }                                              { 6  3 }                                                { 12  3 }           { 14  3 }           { 16  3 }
+        { 0  4 }          { 2  4 } { 3  4 } { 4  4 } { 5  4 } { 6  4 } { 7  4 } { 8  4 } { 9  4 } { 10  4 }           { 12  4 }           { 14  4 } { 15  4 } { 16  4 }
+        { 0  5 }                            { 4  5 }                            { 8  5 }                              { 12  5 }                               { 16  5 }
+        { 0  6 } { 1  6 } { 2  6 }          { 4  6 }          { 6  6 }          { 8  6 }          { 10  6 } { 11  6 } { 12  6 } { 13  6 } { 14  6 }           { 16  6 }
+        { 0  7 }                            { 4  7 }          { 6  7 }          { 8  7 }                              { 12  7 }                               { 16  7 }
+        { 0  8 }          { 2  8 } { 3  8 } { 4  8 } { 5  8 } { 6  8 }          { 8  8 } { 9  8 } { 10  8 }           { 12  8 }           { 14  8 }           { 16  8 }
+        { 0  9 }                                              { 6  9 }                            { 10  9 }                               { 14  9 }           { 16  9 }
+        { 0 10 } { 1 10 } { 2 10 } { 3 10 } { 4 10 }          { 6 10 }          { 8 10 }          { 10 10 } { 11 10 } { 12 10 } { 13 10 } { 14 10 }           { 16 10 }
+        { 0 11 }          { 2 11 }                            { 6 11 }          { 8 11 }                                                  { 14 11 }           { 16 11 }
+        { 0 12 }          { 2 12 } { 3 12 } { 4 12 } { 5 12 } { 6 12 }          { 8 12 }          { 10 12 } { 11 12 } { 12 12 } { 13 12 } { 14 12 }           { 16 12 }
+        { 0 13 }                                              { 6 13 }          { 8 13 }                                                                      { 16 13 }
+        { 0 14 }          { 2 14 } { 3 14 } { 4 14 } { 5 14 } { 6 14 }          { 8 14 } { 9 14 } { 10 14 } { 11 14 } { 12 14 } { 13 14 } { 14 14 } { 15 14 } { 16 14 }
+        { 0 15 }                                                                                                                                              
+        { 0 16 } { 1 16 } { 2 16 } { 3 16 } { 4 16 } { 5 16 } { 6 16 } { 7 16 } { 8 16 } { 9 16 } { 10 16 } { 11 16 } { 12 16 } { 13 16 } { 14 16 } { 15 16 } { 16 16 }
+    } COLOR: black add-to-cells
+
+    { 1 1 } COLOR: blue add-to-cell
+    
+    { } 1sequence add-board ;
+
+:: bound-check ( new-pos -- ? )
+    new-pos [ 0 >= ] all? 
+    new-pos [ 17 < ] all? and ;
+
+: can-move? ( board new-pos -- ? )
+    get-cell is-empty? ;
+
+:: move-window ( scroller move -- )
+    {
+        { [ move LEFT = ] [ scroller x>> -100 swap slide-by ] }
+        { [ move RIGHT = ] [ scroller x>> 100 swap slide-by ] }
+        { [ move DOWN = ] [ scroller y>> 100 swap slide-by ] }
+        { [ move UP = ] [ scroller y>> -100 swap slide-by ] }
+    } cond ;
+
+:: move ( maze-gadget move -- ) 
+    maze-gadget board-gadget>> board>> first :> board
+    maze-gadget maze-scroller>> :> scroller
+    board [ COLOR: blue = ] find-cell-pos :> player-pos
+    player-pos move v+ :> new-pos
+    
+    new-pos bound-check ! check new pos is still inside of board
+    [   
+        board new-pos can-move? ! check if new pos is an empty space
+        [   
+            player-pos { 0 1 } = not player-pos { 16 15 } = not and ! check player isn't at edge of board
+            [ 
+                scroller move move-window
+            ] when
+            board player-pos new-pos move-entire-cell drop
+        ] when
+    ] when  
+    maze-gadget relayout-1 ; 
+
+maze-gadget H{
+    { T{ key-down f f "RIGHT" } [ RIGHT move ] } 
+    { T{ key-down f f "LEFT" } [ LEFT move ] }  
+    { T{ key-down f f "UP" } [ UP move ] } 
+    { T{ key-down f f "DOWN" } [ DOWN move ] } 
+} set-gestures
+
+: main ( -- gadget )
+    vertical maze-gadget new-track
+    { 1700 1700 } init-board-gadget
+    board [ >>board-gadget ] keep
+    <scroller> [ >>maze-scroller ] keep
+    1 track-add ;
+
+MAIN-WINDOW: maze-game-demo { { title "maze" } { pref-dim { 400 400 } } } main >>gadgets ;
diff --git a/extra/gamelib/demos/multiple-board-demo/multiple-board-demo.factor b/extra/gamelib/demos/multiple-board-demo/multiple-board-demo.factor

new file mode 100644 (file)

index 0000000..798b5d6
--- /dev/null
+++ b/extra/gamelib/demos/multiple-board-demo/multiple-board-demo.factor
@@ -0,0 +1,35 @@
+USING: accessors sequences kernel opengl gamelib.ui colors math
+math.vectors ui.gadgets.tracks ui.gestures ui.gadgets
+gamelib.board assocs calendar timers ;
+
+IN: multiple-board-demo
+
+: board-init ( -- board )
+    10 10 make-board 
+    { 0 0 } COLOR: blue add-to-cell
+    { } 1sequence ;
+
+:: move ( board mov -- )
+    board [ COLOR: blue = ] find-cell-pos :> player-pos
+    player-pos mov v+ :> new-pos
+    new-pos first 0 >= 
+    new-pos first 10 < and
+    [ board player-pos new-pos move-entire-cell drop ] when ;
+
+:: first-gadget ( -- gadget )
+    { 400 400 } init-board-gadget
+    T{ key-down f f "RIGHT" } [ dup board>> first RIGHT move relayout ] new-gesture
+    T{ key-down f f "LEFT" } [ dup board>> first LEFT move relayout ] new-gesture
+    board-init add-board ;
+
+:: second-gadget ( -- gadget )
+    { 500 400 } init-board-gadget
+    board-init add-board ;
+
+ :: display-window ( -- )
+    first-gadget :> g1
+    second-gadget :> g2
+    { g1 g2 } horizontal 0 f <window> ! initalize two boards   
+    display ;
+
+MAIN: display-window
diff --git a/extra/gamelib/demos/parent-demo/parent-demo.factor b/extra/gamelib/demos/parent-demo/parent-demo.factor

new file mode 100644 (file)

index 0000000..91b4dc5
--- /dev/null
+++ b/extra/gamelib/demos/parent-demo/parent-demo.factor
@@ -0,0 +1,134 @@
+
+USING: literals kernel namespaces accessors sequences
+combinators math.vectors colors gamelib.ui gamelib.board
+gamelib.cell-object gamelib.loop game.loop ui.gestures
+ui.gadgets opengl opengl.textures images.loader prettyprint
+strings classes ;
+
+IN: gamelib.demos.parent-demo
+
+CONSTANT: player "vocab:gamelib/demos/parent-demo/resources/CharR.png"
+CONSTANT: wall "vocab:gamelib/demos/parent-demo/resources/Wall_Brown.png"
+CONSTANT: goal "vocab:gamelib/demos/parent-demo/resources/Goal.png"
+CONSTANT: light-crate "vocab:gamelib/demos/parent-demo/resources/Crate_Yellow.png"
+CONSTANT: dark-crate "vocab:gamelib/demos/parent-demo/resources/CrateDark_Yellow.png"
+
+TUPLE: crate-cell < child-cell image-path ;
+M: crate-cell draw-cell-object* 
+    rot [ image-path>> load-image ] dip <texture> draw-scaled-texture ;
+
+M: crate-cell call-parent*
+    parent>> dup function>> call( board move parent -- board ) drop ; inline
+
+SYMBOL: level 
+0 level set-global
+
+: <crate-parent> ( -- parent )
+    { } [ move-children ] <parent> ;
+
+:: make-crate ( image-path parent -- crate )
+    crate-cell new
+    parent image-path crate-cell boa ;
+
+:: board-one-bg ( parent -- board )
+    8 9 make-board
+    
+    { 2 2 } player add-to-cell
+
+    {
+        { 0 0 } { 1 0 } { 2 0 } { 3 0 } { 4 0 } { 5 0 } { 6 0 } { 7 0 }
+        { 0 1 }                                                 { 7 1 }
+        { 0 2 }                                                 { 7 2 }
+        { 0 3 }                                                 { 7 3 }
+        { 0 4 }                                                 { 7 4 }
+        { 0 5 }                                                 { 7 5 }
+        { 0 6 }                                                 { 7 6 }
+        { 0 7 }                                                 { 7 7 }
+        { 0 8 } { 1 8 } { 2 8 } { 3 8 } { 4 8 } { 5 8 } { 6 8 } { 7 8 }
+
+    } $ wall add-to-cells
+    
+    { 
+
+        { 3 4 } { 4 4 } { 5 4 } { 4 3 }
+    } dup parent swap >>children drop light-crate parent make-crate add-copy-to-cells ;
+
+: board-one ( gadget parent -- gadget )
+    board-one-bg { } 1sequence add-board ;
+
+:: get-pos ( board object -- seq )
+    board [ object = ] find-cell-pos ;
+
+:: move-crate ( board player-pos move crate -- )
+    player-pos move v+ :> crate-pos
+    board crate-pos move v+ get-cell :> next-cell
+    ! Move both the player and crate if possible, otherwise do nothing
+    {
+        { 
+            [ next-cell class-of wall class-of = not ] ! crate can be moved to free space
+            [ crate light-crate >>image-path drop 
+            ! board crate parent>> move move-children
+            board move crate call-parent*
+            board player-pos move player move-object drop ] 
+        }
+        { 
+            [ next-cell goal cell-only-contains? ] ! crate can be moved to goal
+            [ crate dark-crate >>image-path drop 
+            board crate-pos move crate move-object 
+            player-pos move player move-object drop ] 
+        }
+        [ ] ! Else do nothing
+    } cond ;
+
+:: sokoban-move ( board move -- )
+    board player get-pos :> player-pos
+    player-pos move v+ :> new-pos
+    board new-pos get-cell :> adjacent-cell
+    ! Move player to free space or have player push crate if possible, otherwise do nothing
+    {
+        { 
+            [ adjacent-cell crate-cell cell-contains-instance? ] ! player is moving into a crate
+            [ adjacent-cell crate-cell get-instance-from-cell :> crate
+            board player-pos move crate move-crate ]
+        }
+        {
+            [ adjacent-cell is-empty? adjacent-cell goal cell-contains? or ] ! player can be moved to free space or goal
+            [ board player-pos move player move-object drop ] 
+        }
+        [ ] ! Else do nothing
+    } cond ;
+
+: game-logic ( gadget -- gadget )
+    ! Move pieces according to user input
+    T{ key-down f f "UP" } [ board>> first UP sokoban-move ] new-gesture
+    T{ key-down f f "DOWN" } [ board>> first DOWN sokoban-move ] new-gesture
+    T{ key-down f f "RIGHT" } [ board>> first RIGHT sokoban-move ] new-gesture
+    T{ key-down f f "LEFT" } [ board>> first LEFT sokoban-move ] new-gesture ;
+
+TUPLE: game-state gadget ;
+
+:: <game-state> ( gadget -- gadget game-state )
+    gadget 
+    game-state new 
+    gadget >>gadget ;
+
+: create-loop ( game-state -- )
+    10000000 swap new-game-loop start-loop ;
+
+:: tick-update ( game-state -- )
+    game-state gadget>> relayout ;
+
+M: game-state tick* tick-update ;
+
+M: game-state draw* drop drop ;
+
+
+: main ( -- )
+    { 700 800 } init-board-gadget
+    <crate-parent>
+    board-one
+    <game-state> create-loop
+    game-logic
+    display ;
+
+MAIN: main
diff --git a/extra/gamelib/demos/parent-demo/resources/CharB.png b/extra/gamelib/demos/parent-demo/resources/CharB.png

new file mode 100644 (file)

index 0000000..7f94ffa

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/CharB.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/CharF.png b/extra/gamelib/demos/parent-demo/resources/CharF.png

new file mode 100644 (file)

index 0000000..0315373

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/CharF.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/CharL.png b/extra/gamelib/demos/parent-demo/resources/CharL.png

new file mode 100644 (file)

index 0000000..cbf6857

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/CharL.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/CharR.png b/extra/gamelib/demos/parent-demo/resources/CharR.png

new file mode 100644 (file)

index 0000000..6e21bb3

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/CharR.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/CharWalkB.png b/extra/gamelib/demos/parent-demo/resources/CharWalkB.png

new file mode 100644 (file)

index 0000000..74d9819

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/CharWalkB.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/CharWalkF.png b/extra/gamelib/demos/parent-demo/resources/CharWalkF.png

new file mode 100644 (file)

index 0000000..03d27e1

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/CharWalkF.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/CharWalkL.png b/extra/gamelib/demos/parent-demo/resources/CharWalkL.png

new file mode 100644 (file)

index 0000000..465e48b

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/CharWalkL.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/CharWalkR.png b/extra/gamelib/demos/parent-demo/resources/CharWalkR.png

new file mode 100644 (file)

index 0000000..13e717f

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/CharWalkR.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/CrateDark_Yellow.png b/extra/gamelib/demos/parent-demo/resources/CrateDark_Yellow.png

new file mode 100644 (file)

index 0000000..3de6977

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/CrateDark_Yellow.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/Crate_Yellow.png b/extra/gamelib/demos/parent-demo/resources/Crate_Yellow.png

new file mode 100644 (file)

index 0000000..06c7b99

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/Crate_Yellow.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/Goal.png b/extra/gamelib/demos/parent-demo/resources/Goal.png

new file mode 100644 (file)

index 0000000..5be73ab

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/Goal.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/Tetris.wav b/extra/gamelib/demos/parent-demo/resources/Tetris.wav

new file mode 100644 (file)

index 0000000..705f847

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/Tetris.wav differ
diff --git a/extra/gamelib/demos/parent-demo/resources/Wall_Brown.png b/extra/gamelib/demos/parent-demo/resources/Wall_Brown.png

new file mode 100644 (file)

index 0000000..44fff22

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/Wall_Brown.png differ
diff --git a/extra/gamelib/demos/parent-demo/resources/once.wav b/extra/gamelib/demos/parent-demo/resources/once.wav

new file mode 100644 (file)

index 0000000..3fc85b0

Binary files /dev/null and b/extra/gamelib/demos/parent-demo/resources/once.wav differ
diff --git a/extra/gamelib/demos/sokoban/layouts/layouts.factor b/extra/gamelib/demos/sokoban/layouts/layouts.factor

new file mode 100644 (file)

index 0000000..198919b
--- /dev/null
+++ b/extra/gamelib/demos/sokoban/layouts/layouts.factor
@@ -0,0 +1,107 @@
+USING: accessors colors gamelib.board gamelib.cell-object
+gamelib.ui images.loader kernel literals opengl.textures
+sequences namespaces ;
+
+IN: gamelib.demos.sokoban.layouts
+
+CONSTANT: player "vocab:gamelib/demos/sokoban/resources/CharR.png"
+CONSTANT: wall "vocab:gamelib/demos/sokoban/resources/Wall_Brown.png"
+CONSTANT: goal "vocab:gamelib/demos/sokoban/resources/Goal.png"
+CONSTANT: light-crate "vocab:gamelib/demos/sokoban/resources/Crate_Yellow.png"
+CONSTANT: dark-crate "vocab:gamelib/demos/sokoban/resources/CrateDark_Yellow.png"
+
+TUPLE: crate-cell < cell-object image-path ;
+M: crate-cell draw-cell-object* 
+    rot [ image-path>> load-image ] dip <texture> draw-scaled-texture ;
+
+:: make-crate ( image-path -- crate )
+    crate-cell new
+    image-path crate-cell boa ;
+
+: board-one ( gadget -- gadget )
+    8 9 make-board
+    
+    { 2 2 } player add-to-cell
+
+    {
+                        { 2 0 } { 3 0 } { 4 0 } { 5 0 } { 6 0 }
+        { 0 1 } { 1 1 } { 2 1 }                         { 6 1 }
+        { 0 2 }                                         { 6 2 }
+        { 0 3 } { 1 3 } { 2 3 }                         { 6 3 }
+        { 0 4 }         { 2 4 } { 3 4 }                 { 6 4 }
+        { 0 5 }         { 2 5 }                         { 6 5 } { 7 5 }
+        { 0 6 }                                                 { 7 6 }
+        { 0 7 }                                                 { 7 7 }
+        { 0 8 } { 1 8 } { 2 8 } { 3 8 } { 4 8 } { 5 8 } { 6 8 } { 7 8 }
+
+    } $ wall add-to-cells
+
+    { 
+
+        { 1 6 } { 3 2 } { 4 3 } { 4 4 } { 4 6 } { 3 6 } { 5 6 }
+    } $ light-crate make-crate add-copy-to-cells
+
+    {
+        { 1 2 } { 5 3 } { 1 4 } { 4 5 } { 3 6 } { 6 6 } { 4 7 } 
+    } $ goal add-to-cells 
+    
+    { } 1sequence add-board ;
+
+
+: board-two ( gadget -- gadget )
+    22 11 make-board
+    
+    { 11 8 } player add-to-cell
+
+    {
+                                        { 4 0 } { 5 0 } { 6 0 } { 7 0 } { 8 0 }
+                                        { 4 1 }                         { 8 1 }
+                                        { 4 2 }                         { 8 2 }
+                        { 2 3 } { 3 3 } { 4 3 }                         { 8 3 } { 9 3 } { 10 3 }
+                        { 2 4 }                                                         { 10 4 }
+        { 0 5 } { 1 5 } { 2 5 }         { 4 5 }         { 6 5 } { 7 5 } { 8 5 }         { 10 5 }                                              { 16 5 } { 17 5 } { 18 5 } { 19 5 } { 20 5 } { 21 5 }
+        { 0 6 }                         { 4 6 }         { 6 6 } { 7 6 } { 8 6 }         { 10 6 } { 11 6 } { 12 6 } { 13 6 } { 14 6 } { 15 6 } { 16 6 }                                     { 21 6 }
+        { 0 7 }                                                                                                                                                                            { 21 7 }
+        { 0 8 } { 1 8 } { 2 8 } { 3 8 } { 4 8 }         { 6 8 } { 7 8 } { 8 8 }         { 10 8 }          { 12 8 } { 13 8 } { 14 8 } { 15 8 } { 16 8 }                                     { 21 8 }
+                                        { 4 9 }                                         { 10 9 } { 11 9 } { 12 9 }                            { 16 9 } { 17 9 } { 18 9 } { 19 9 } { 20 9 } { 21 9 }
+                                        { 4 10 } { 5 10 } { 6 10 } { 7 10 } { 8 10 } { 9 10 } { 10 10 }  
+    } $ wall add-to-cells
+    
+    {
+        { 19 6 } { 20 6 }
+        { 19 7 } { 20 7 }
+        { 19 8 } { 20 8 }
+    } $ goal add-to-cells
+
+    { 
+        { 5 2 } { 7 3 } { 5 4 } { 8 4 } { 5 7 } { 2 7 }
+    } $ light-crate make-crate add-copy-to-cells
+
+    { } 1sequence 
+
+    add-board ;
+
+
+: board-three ( gadget -- gadget )
+    8 8 make-board
+    
+    { 1 1 } player add-to-cell
+
+    {
+        { 0 0 } { 1 0 } { 2 0 } { 3 0 } { 4 0 } { 5 0 } { 6 0 } { 7 0 }
+        { 0 1 }                                                 { 7 1 }
+        { 0 2 }                                                 { 7 2 }
+        { 0 3 }                                                 { 7 3 }
+        { 0 4 }                                                 { 7 4 }
+        { 0 5 }                                                 { 7 5 }
+        { 0 6 }                                                 { 7 6 }
+        { 0 7 } { 1 7 } { 2 7 } { 3 7 } { 4 7 } { 5 7 } { 6 7 } { 7 7 }
+    } $ wall add-to-cells
+
+    { 2 1 } $ light-crate make-crate add-to-cell
+
+    { 3 1 } $ goal add-to-cell                                         
+
+    { } 1sequence 
+
+    add-board ;
diff --git a/extra/gamelib/demos/sokoban/loop/loop.factor b/extra/gamelib/demos/sokoban/loop/loop.factor

new file mode 100644 (file)

index 0000000..77cd966
--- /dev/null
+++ b/extra/gamelib/demos/sokoban/loop/loop.factor
@@ -0,0 +1,42 @@
+
+USING: accessors colors fonts game.loop gamelib.board
+gamelib.loop gamelib.ui kernel math namespaces opengl
+prettyprint sequences gamelib.demos.sokoban.layouts ui ui.gadgets ui.text
+combinators ;
+
+IN: gamelib.demos.sokoban.loop
+
+SYMBOL: level
+
+TUPLE: game-state gadget ;
+
+:: check-win ( board -- ? )
+    board [ crate-cell cell-contains-instance? ] find-all-cells-nopos :> seq
+    seq length 0 = not seq [ dark-crate make-crate cell-contains? ] all? and ;
+
+:: <game-state> ( gadget -- gadget game-state )
+    gadget 
+    game-state new 
+    gadget >>gadget ;
+
+: create-loop ( game-state -- )
+    10000000 swap new-game-loop start-loop ;
+
+: game-over ( gadget -- gadget )
+    [ { 200 200 } [ monospace-font t >>bold? 50 >>size COLOR: red >>foreground "YOU WIN!" draw-text ] with-translation ] draw-quote ;
+
+:: tick-update ( game-state -- )
+    game-state gadget>> :> g
+    g relayout-window
+    g board>> first check-win
+    [ 
+        {
+            { [ level get-global 0 = ] [ level [ 1 + ] change-global game-state g { } >>board { } >>draw-quotes board-two >>gadget drop g { 1500 750 } set-dim relayout ] }
+            { [ level get-global 1 = ] [ level [ 1 + ] change-global game-state g { } >>board { } >>draw-quotes board-three >>gadget drop g { 600 600 } set-dim relayout ] }
+            { [ level get-global 2 = ] [ g game-over relayout-1 stop-game ] }
+        } cond
+    ] when ;
+
+M: game-state tick* tick-update ;
+
+M: game-state draw* drop drop ;
diff --git a/extra/gamelib/demos/sokoban/resources/CharB.png b/extra/gamelib/demos/sokoban/resources/CharB.png

new file mode 100644 (file)

index 0000000..7f94ffa

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/CharB.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/CharF.png b/extra/gamelib/demos/sokoban/resources/CharF.png

new file mode 100644 (file)

index 0000000..0315373

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/CharF.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/CharL.png b/extra/gamelib/demos/sokoban/resources/CharL.png

new file mode 100644 (file)

index 0000000..cbf6857

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/CharL.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/CharR.png b/extra/gamelib/demos/sokoban/resources/CharR.png

new file mode 100644 (file)

index 0000000..6e21bb3

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/CharR.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/CharWalkB.png b/extra/gamelib/demos/sokoban/resources/CharWalkB.png

new file mode 100644 (file)

index 0000000..74d9819

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/CharWalkB.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/CharWalkF.png b/extra/gamelib/demos/sokoban/resources/CharWalkF.png

new file mode 100644 (file)

index 0000000..03d27e1

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/CharWalkF.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/CharWalkL.png b/extra/gamelib/demos/sokoban/resources/CharWalkL.png

new file mode 100644 (file)

index 0000000..465e48b

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/CharWalkL.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/CharWalkR.png b/extra/gamelib/demos/sokoban/resources/CharWalkR.png

new file mode 100644 (file)

index 0000000..13e717f

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/CharWalkR.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/CrateDark_Yellow.png b/extra/gamelib/demos/sokoban/resources/CrateDark_Yellow.png

new file mode 100644 (file)

index 0000000..3de6977

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/CrateDark_Yellow.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/Crate_Yellow.png b/extra/gamelib/demos/sokoban/resources/Crate_Yellow.png

new file mode 100644 (file)

index 0000000..06c7b99

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/Crate_Yellow.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/Goal.png b/extra/gamelib/demos/sokoban/resources/Goal.png

new file mode 100644 (file)

index 0000000..5be73ab

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/Goal.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/Tetris.wav b/extra/gamelib/demos/sokoban/resources/Tetris.wav

new file mode 100644 (file)

index 0000000..705f847

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/Tetris.wav differ
diff --git a/extra/gamelib/demos/sokoban/resources/Wall_Brown.png b/extra/gamelib/demos/sokoban/resources/Wall_Brown.png

new file mode 100644 (file)

index 0000000..44fff22

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/Wall_Brown.png differ
diff --git a/extra/gamelib/demos/sokoban/resources/hardwood-tree.jpg b/extra/gamelib/demos/sokoban/resources/hardwood-tree.jpg

new file mode 100644 (file)

index 0000000..617d969

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/hardwood-tree.jpg differ
diff --git a/extra/gamelib/demos/sokoban/resources/large-tree.jpg b/extra/gamelib/demos/sokoban/resources/large-tree.jpg

new file mode 100644 (file)

index 0000000..62a8716

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/large-tree.jpg differ
diff --git a/extra/gamelib/demos/sokoban/resources/once.wav b/extra/gamelib/demos/sokoban/resources/once.wav

new file mode 100644 (file)

index 0000000..3fc85b0

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/once.wav differ
diff --git a/extra/gamelib/demos/sokoban/resources/tree.png b/extra/gamelib/demos/sokoban/resources/tree.png

new file mode 100644 (file)

index 0000000..b9f0285

Binary files /dev/null and b/extra/gamelib/demos/sokoban/resources/tree.png differ
diff --git a/extra/gamelib/demos/sokoban/sokoban.factor b/extra/gamelib/demos/sokoban/sokoban.factor

new file mode 100644 (file)

index 0000000..8b7b71f
--- /dev/null
+++ b/extra/gamelib/demos/sokoban/sokoban.factor
@@ -0,0 +1,68 @@
+USING: literals kernel namespaces accessors sequences
+combinators math.vectors colors gamelib.ui gamelib.board
+gamelib.cell-object gamelib.loop game.loop ui.gestures
+ui.gadgets opengl opengl.textures images.loader prettyprint
+layouts gamelib.demos.sokoban.layouts gamelib.demos.sokoban.loop ;
+
+IN: gamelib.demos.sokoban
+
+CONSTANT: player "vocab:gamelib/demos/sokoban/resources/CharR.png"
+CONSTANT: wall "vocab:gamelib/demos/sokoban/resources/Wall_Brown.png"
+CONSTANT: goal "vocab:gamelib/demos/sokoban/resources/Goal.png"
+CONSTANT: light-crate "vocab:gamelib/demos/sokoban/resources/Crate_Yellow.png"
+CONSTANT: dark-crate "vocab:gamelib/demos/sokoban/resources/CrateDark_Yellow.png"
+
+:: move-crate ( board player-pos move crate -- )
+    player-pos move v+ :> crate-pos
+    board crate-pos move v+ get-cell :> next-cell
+    ! Move both the player and crate if possible, otherwise do nothing
+    {
+        { 
+            [ next-cell is-empty? ] ! crate can be moved to free space
+            [ crate light-crate >>image-path drop 
+            board crate-pos move crate move-object 
+            player-pos move player move-object drop ] 
+        }
+        { 
+            [ next-cell goal cell-only-contains? ] ! crate can be moved to goal
+            [ crate dark-crate >>image-path drop 
+            board crate-pos move crate move-object 
+            player-pos move player move-object drop ] 
+        }
+        [ ] ! Else do nothing
+    } cond ;
+
+:: sokoban-move ( board move -- )
+    board [ player = ] find-cell-pos :> player-pos
+    player-pos move v+ :> new-pos
+    board new-pos get-cell :> adjacent-cell
+    ! Move player to free space or have player push crate if possible, otherwise do nothing
+    {
+        { 
+            [ adjacent-cell crate-cell cell-contains-instance? ] ! player is moving into a crate
+            [ adjacent-cell crate-cell get-instance-from-cell :> crate
+            board player-pos move crate move-crate ]
+        }
+        {
+            [ adjacent-cell is-empty? adjacent-cell goal cell-contains? or ] ! player can be moved to free space or goal
+            [ board player-pos move player move-object drop ] 
+        }
+        [ ] ! Else do nothing
+    } cond ;
+
+: game-logic ( gadget -- gadget )
+    ! Move pieces according to user input
+    T{ key-down f f "UP" } [ board>> first UP sokoban-move ] new-gesture
+    T{ key-down f f "DOWN" } [ board>> first DOWN sokoban-move ] new-gesture
+    T{ key-down f f "RIGHT" } [ board>> first RIGHT sokoban-move ] new-gesture
+    T{ key-down f f "LEFT" } [ board>> first LEFT sokoban-move ] new-gesture ;
+
+: main ( -- )
+    [ 0 level set-global ] with-global ! set global level variable to 0
+    { 600 675 } init-board-gadget
+    board-one
+    <game-state> create-loop
+    game-logic
+    display ;
+
+MAIN: main
diff --git a/extra/gamelib/demos/tic-tac-toe/resources/O.png b/extra/gamelib/demos/tic-tac-toe/resources/O.png

new file mode 100644 (file)

index 0000000..2c45370

Binary files /dev/null and b/extra/gamelib/demos/tic-tac-toe/resources/O.png differ
diff --git a/extra/gamelib/demos/tic-tac-toe/resources/X.png b/extra/gamelib/demos/tic-tac-toe/resources/X.png

new file mode 100644 (file)

index 0000000..c1fc7a8

Binary files /dev/null and b/extra/gamelib/demos/tic-tac-toe/resources/X.png differ
diff --git a/extra/gamelib/demos/tic-tac-toe/tic-tac-toe.factor b/extra/gamelib/demos/tic-tac-toe/tic-tac-toe.factor

new file mode 100644 (file)

index 0000000..c80b7e4
--- /dev/null
+++ b/extra/gamelib/demos/tic-tac-toe/tic-tac-toe.factor
@@ -0,0 +1,105 @@
+USING: kernel namespaces accessors fonts literals ui.text
+sequences math gamelib.ui gamelib.board colors ui.gestures
+ui.gadgets opengl gamelib.loop game.loop ;
+
+IN: gamelib.demos.tic-tac-toe
+
+CONSTANT: X "vocab:gamelib/demos/tic-tac-toe/resources/X.png"
+CONSTANT: O "vocab:gamelib/demos/tic-tac-toe/resources/O.png"
+
+SYMBOL: player
+X player set-global 
+
+: background ( gadget -- gadget )
+    COLOR: pink set-background-color
+    X { 80 80 } { 30 30 } draw-image
+    X { 10 10 } { 40 40 } draw-image ;
+
+: foreground ( gadget -- gadget ) 
+    COLOR: black { 123 0 } { 10 400 } draw-filled-rectangle
+    COLOR: black { 256 0 } { 10 400 } draw-filled-rectangle
+    COLOR: black { 0 123 } { 400 10 } draw-filled-rectangle
+    COLOR: black { 0 256 } { 400 10 } draw-filled-rectangle ;
+
+: board ( gadget -- gadget )
+    3 3 make-board { } 1sequence
+    add-board ; 
+
+: set-player ( -- )
+    player get-global X =
+    [ O player set-global ]
+    [ X player set-global ]
+    if ;
+
+:: set-board ( board cell-pos cell -- )
+    board cell-pos is-cell-empty?
+    [ 
+        board cell-pos cell add-to-cell drop
+        set-player
+    ] when ;
+
+:: on-click ( -- quot )
+    [ dup board>> first swap hand-rel-cell player get-global set-board ] ;
+
+:: row-win ( board -- ? )
+    ! Returns true if either X or O has a row win
+    ! For each row, check if every element in specified row equals X, returning true if any row meets the condition
+    { 0 1 2 } [ { $ X } swap board swap get-row all-equal-value? ] any?
+    ! Same check but with O
+    { 0 1 2 } [ { $ O } swap board swap get-row all-equal-value? ] any? or ;
+
+:: col-win ( board -- ? )
+    ! Same as row win except checks column wins
+    { 0 1 2 } [ { $ X } swap board swap get-col all-equal-value? ] any?
+    { 0 1 2 } [ { $ O } swap board swap get-col all-equal-value? ] any? or ;
+
+:: diag-win ( board -- ? )
+    ! Same as row win except checks diagonal wins
+    { $ X } board { { 0 0 } { 1 1 } { 2 2 } } get-cells all-equal-value?
+    { $ X } board { { 2 0 } { 1 1 } { 0 2 } } get-cells all-equal-value? or
+    { $ O } board { { 0 0 } { 1 1 } { 2 2 } } get-cells all-equal-value? or
+    { $ O } board { { 2 0 } { 1 1 } { 0 2 } } get-cells all-equal-value? or ;
+
+:: check-win ( board -- ? )
+    ! Returns true if any win condition is met
+    board row-win board col-win or board diag-win or ;
+
+: game-logic ( gadget -- gadget )
+    T{ button-down { # 1 } } on-click new-gesture 
+    T{ button-down { # 3 } } on-click new-gesture ;
+
+TUPLE: game-state gadget ;
+
+
+: game-over ( gadget -- gadget )
+    [ { 75 75 } [ monospace-font t >>bold? 50 >>size COLOR: red >>foreground "GAME OVER" draw-text ] with-translation ] draw-quote ;
+
+:: <game-state> ( gadget -- gadget game-state )
+    gadget 
+    game-state new 
+    gadget >>gadget ;
+
+
+: create-loop ( game-state -- )
+    1000 swap new-game-loop start-loop ;
+
+
+: tick-update ( game-state -- )
+    dup gadget>> board>> first check-win 
+    [ gadget>> game-over relayout-1 stop-game ] 
+    [ gadget>> relayout-1 ] if ;
+
+
+M: game-state tick* tick-update ;
+
+M: game-state draw* drop drop ;
+
+
+: main ( -- )
+    { 400 400 } init-board-gadget
+    background board foreground
+    game-logic
+    <game-state> create-loop 
+    display ; 
+
+MAIN: main
diff --git a/extra/gamelib/loop/loop.factor b/extra/gamelib/loop/loop.factor

new file mode 100644 (file)

index 0000000..03f7c21
--- /dev/null
+++ b/extra/gamelib/loop/loop.factor
@@ -0,0 +1,15 @@
+USING: accessors sequences kernel opengl grouping words game.loop delegate namespaces ;
+
+IN: gamelib.loop
+
+
+SYMBOL: game-loop
+
+
+: new-game-loop ( interval game-state -- game-loop )
+    <game-loop> dup game-loop set-global ;
+
+:: stop-game ( -- )
+    game-loop get-global :> loop
+    loop
+    [ loop stop-loop ] when ;
diff --git a/extra/gamelib/ui/ui.factor b/extra/gamelib/ui/ui.factor

new file mode 100644 (file)

index 0000000..74e8ce0
--- /dev/null
+++ b/extra/gamelib/ui/ui.factor
@@ -0,0 +1,146 @@
+USING: accessors arrays classes quotations ui.gadgets kernel
+ui.gadgets.status-bar ui ui.render opengl locals.types strings
+sequences combinators peg images.loader opengl.textures assocs
+math ranges gamelib.board gamelib.cell-object ui.gestures
+ui.gadgets.tracks ui.gadgets.worlds colors destructors
+gamelib.loop ;
+
+IN: gamelib.ui
+
+TUPLE: board-gadget < gadget dimension bg-color draw-quotes board gests textures ;
+
+:: get-cell-dimension ( n gadget -- celldims )
+    ! Calculates cell height and width based on gadget height and width
+    gadget dimension>> first2 :> ( wdt hgt )
+    n gadget board>> nth dup width>> swap height>> :> ( cols rows )
+
+    wdt cols /i :> cellwidth 
+    hgt rows /i :> cellheight
+
+   cellwidth cellheight { } 2sequence ;
+
+:: get-dimension-matrix ( n gadget -- matrix )
+    ! gets a matrix of all starting locations of cells
+    n gadget get-cell-dimension :> celldims
+    ! applies appropriate offset to starting locations based on the cell heigh/width
+    n gadget board>> nth width>> [0..b) [ celldims first * ] map :> widths
+    n gadget board>> nth height>> [0..b) [ celldims second * ] map :> heights
+
+    widths heights cartesian-product flip ;
+
+:: draw-append ( gadget quot -- gadget )
+    gadget
+    gadget draw-quotes>> 
+    quot { } 1sequence append
+    >>draw-quotes ;
+
+:: draw-background-color ( gadget -- )
+    ! if given a background color, draw the background color
+    gadget bg-color>> 
+    [ gadget bg-color>> gl-color { 0 0 } gadget dimension>> gl-fill-rect ] 
+    [ ] if ;
+
+:: draw-filled-rectangle ( gadget color loc dim -- gadget )
+    ! appends instruction to draw a rectangle to current set of instructions in draw-quotes attribute
+    gadget [ color gl-color loc dim gl-fill-rect ] draw-append ;
+
+:: draw-image ( gadget path loc dim -- gadget )
+    ! appends instructions to draw a sprite to current set of instructions in draw-quotes attributes
+    gadget [ dim { path loc } gadget textures>> [ first load-image loc <texture> ] cache draw-scaled-texture ] draw-append ;
+    ! gadget [ dim path load-image loc <texture> draw-scaled-texture ] draw-append ;
+
+:: draw-quote ( gadget quote -- gadget )
+    gadget quote draw-append ;
+
+:: draw-single ( display-cell loc dim gadget -- )
+    ! Executes instructions based on content of the cell, does nothing if cell isn't a 
+    ! string, color or quote.
+    { 
+        { [ display-cell cell-object instance? ] [ loc dim display-cell draw-cell-object* ] }
+        { [ display-cell string? ] [ dim { display-cell loc } gadget textures>> [ first load-image loc <texture> ] cache draw-scaled-texture ] }
+        { [ display-cell color? ] [ display-cell gl-color loc dim gl-fill-rect ] }
+        { [ display-cell quotation? ] [ loc dim display-cell 2curry call( -- ) ] }
+        { [ display-cell array? ] [ display-cell [ loc dim gadget draw-single ] each ] }
+        [ ]
+    } cond ;
+
+:: draw-cells ( n gadget -- )
+    ! board is always valid since this instruction gets added on creation of board
+    n gadget board>> nth cells>> :> cell
+    n gadget get-cell-dimension :> celldims
+    n gadget get-dimension-matrix :> dim-matrix
+    cell dim-matrix [ [ celldims gadget draw-single ] 2each ] 2each ;
+
+: draw-all ( gadget -- )
+    ! draws everything in draw-quotes (which we added to using draw-filled-rectangle and draw-image)
+    draw-quotes>> [ call( -- ) ] each ;
+
+! TODO: change to have a board
+: init-board-gadget ( dim -- gadget )
+    ! makes a window gadget with given dimensions
+    board-gadget new
+    swap >>dimension 
+    H{ } >>gests 
+    H{ } clone >>textures ;
+
+:: add-board ( gadget board -- gadget )
+    ! board should be a seq
+    gadget board >>board
+    [ board length [0..b) [ gadget draw-cells ] each ] draw-append ;
+
+:: display ( gadget -- )
+    [ 
+        gadget
+        "Display window"
+        open-status-window 
+    ] with-ui ;
+
+: set-background-color ( gadget color -- gadget )
+    >>bg-color ;
+
+: set-dim ( gadget dim -- gadget )
+    >>dimension ;
+
+: get-dim ( gadget -- dim )
+    dimension>> ;
+
+:: hand-rel-cell ( gadget -- cellpos )
+    gadget hand-rel first2 :> ( w h )
+    0 gadget get-cell-dimension first2 :> ( cw ch )
+    w cw /i :> row
+    h ch /i :> col
+    row col { } 2sequence ;
+
+:: new-gesture ( gadget key value -- gadget )
+    value key gadget gests>> set-at gadget ;
+
+
+! SECTION: gadget methods
+M: board-gadget pref-dim*
+   dimension>> ;
+
+M: board-gadget handle-gesture
+    swap over gests>> ?at
+    [
+        2dup call( gadget -- )
+    ] when 2drop f ;
+
+M: board-gadget draw-gadget*
+    {
+        [ draw-background-color ]
+        [ draw-all ]
+    } cleave ;
+
+M: board-gadget ungraft*
+    [   dup find-gl-context [ values dispose-each H{ } clone ] change-textures drop
+        stop-game
+    ] [ call-next-method ] bi ; 
+
+TUPLE: window-gadget < track focusable-child-number ;
+
+:: <window> ( board-gadgets orientation fsn constraint -- gadget )
+    orientation window-gadget new-track 
+    fsn >>focusable-child-number
+    board-gadgets [ constraint track-add ] each ;
+
+M: window-gadget focusable-child* dup children>> swap focusable-child-number>> swap nth ;
diff --git a/extra/sokoban/README.txt b/extra/sokoban/README.txt

new file mode 100644 (file)

index 0000000..a3bdf79
--- /dev/null
+++ b/extra/sokoban/README.txt
@@ -0,0 +1,7 @@
+This is a simple sokoban game. To play, open factor (in GUI mode), and run:
+
+"sokoban" run
+
+This should open a new window with a running sokoban game. The commands are:
+
+left,right,up,down arrows -- moves the player in the given direction
diff --git a/extra/sokoban/authors.txt b/extra/sokoban/authors.txt

new file mode 100644 (file)

index 0000000..36ce64f
--- /dev/null
+++ b/extra/sokoban/authors.txt
@@ -0,0 +1 @@
+Factor Clinic Team 2021-2022
diff --git a/extra/sokoban/board/board-tests.factor b/extra/sokoban/board/board-tests.factor

new file mode 100644 (file)

index 0000000..bbcff3c
--- /dev/null
+++ b/extra/sokoban/board/board-tests.factor
@@ -0,0 +1,23 @@
+USING: accessors arrays colors colors.constants kernel sokoban.board sokoban.piece tools.test ;
+
+{ { { f f } { f f } { f f } } } [ 2 3 make-rows ] unit-test
+{ { { f f } { f f } { f f } } } [ 2 3 <board> rows>> ] unit-test
+{ 1 { f f } } [ 2 3 <board> { 1 1 } board@block ] unit-test
+{ f } [ 2 3 <board> { 1 1 } block ] unit-test
+[ 2 3 <board> { 2 3 } block ] must-fail
+{ COLOR: red } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } block ] unit-test
+{ t } [ 2 3 <board> { 1 1 } block-free? ] unit-test
+{ f } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } block-free? ] unit-test
+{ t } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 2 } block-free? ] unit-test
+{ t } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 0 1 } block-free? ] unit-test
+{ t } [ 2 3 <board> { 0 0 } block-in-bounds? ] unit-test
+{ f } [ 2 3 <board> { -1 0 } block-in-bounds? ] unit-test
+{ t } [ 2 3 <board> { 1 2 } block-in-bounds? ] unit-test
+{ f } [ 2 3 <board> { 2 2 } block-in-bounds? ] unit-test
+{ t } [ 2 3 <board> { 1 1 } location-valid? ] unit-test
+{ f } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } location-valid? ] unit-test
+! { t } [ 10 10 <board> 10 <random-piece> piece-valid? ] unit-test
+! { f } [ 2 3 <board> 10 <random-piece> { 1 2 } >>location piece-valid? ] unit-test
+{ { { f } { f } } } [ 1 1 <board> add-row rows>> ] unit-test
+{ { { f } } } [ 1 2 <board> dup { 0 1 } COLOR: red set-block remove-full-rows rows>> ] unit-test
+{ { { f } { f } } } [ 1 2 <board> dup { 0 1 } COLOR: red set-block dup check-rows drop rows>> ] unit-test
diff --git a/extra/sokoban/board/board.factor b/extra/sokoban/board/board.factor

new file mode 100644 (file)

index 0000000..800bf84
--- /dev/null
+++ b/extra/sokoban/board/board.factor
@@ -0,0 +1,39 @@
+! Copyright (C) 2006, 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays combinators.short-circuit fry kernel
+math sequences sokoban.piece sokoban.layout ;
+IN: sokoban.board
+
+TUPLE: board
+    { width integer }
+    { height integer }
+    { rows array } ;
+
+: make-rows ( width height -- rows )
+    swap '[ _ f <array> ] replicate ;
+
+: <board> ( width height -- board )
+    2dup make-rows board boa ;
+
+! A block is simply an array of form { x y } where { 0 0 } is
+! the top-left of the sokoban board, and { 9 19 } is the bottom
+! right on a 10x20 board.
+
+: board@block ( board block -- n row )
+    [ second swap rows>> nth ] keep first swap ;
+
+: set-block ( board block color -- ) -rot board@block set-nth ;
+
+: block ( board block -- color ) board@block nth ;
+
+: block-free? ( board block -- ? ) block not ;
+
+: block-in-bounds? ( board block -- ? )
+    [ first swap width>> <iota> bounds-check? ]
+    [ second swap height>> <iota> bounds-check? ] 2bi and ;
+
+: location-valid? ( board block -- ? )
+    { [ block-in-bounds? ] [ block-free? ] } 2&& ;
+
+: piece-valid? ( board piece -- ? )
+    piece-blocks [ location-valid? ] with all? ;
diff --git a/extra/sokoban/deploy.factor b/extra/sokoban/deploy.factor

new file mode 100644 (file)

index 0000000..ea8750f
--- /dev/null
+++ b/extra/sokoban/deploy.factor
@@ -0,0 +1,13 @@
+USING: tools.deploy.config ;
+H{
+    { deploy-ui? t }
+    { deploy-threads? t }
+    { deploy-word-props? f }
+    { deploy-reflection 1 }
+    { "stop-after-last-window?" t }
+    { deploy-io 3 }
+    { deploy-math? t }
+    { deploy-word-defs? f }
+    { deploy-c-types? f }
+    { deploy-name "sokoban" }
+}
diff --git a/extra/sokoban/game/game-tests.factor b/extra/sokoban/game/game-tests.factor

new file mode 100644 (file)

index 0000000..b5e9736
--- /dev/null
+++ b/extra/sokoban/game/game-tests.factor
@@ -0,0 +1,15 @@
+USING: accessors kernel sokoban.game sokoban.board sokoban.piece tools.test
+sequences ;
+
+{ t } [ <default-sokoban> [ current-piece ] [ next-piece ] bi and t f ? ] unit-test
+{ t } [ <default-sokoban> { 1 1 } can-move? ] unit-test
+{ t } [ <default-sokoban> { 1 1 } sokoban-move ] unit-test
+{ 1 } [ <default-sokoban> dup { 1 1 } sokoban-move drop current-piece location>> second ] unit-test
+{ 1 } [ <default-sokoban> level ] unit-test
+{ 1 } [ <default-sokoban> 9 >>rows level ] unit-test
+{ 2 } [ <default-sokoban> 10 >>rows level ] unit-test
+{ 0 } [ 3 0 rows-score ] unit-test
+{ 80 } [ 1 1 rows-score ] unit-test
+{ 4800 } [ 3 4 rows-score ] unit-test
+{ 1 } [ <default-sokoban> dup 3 score-rows dup 3 score-rows dup 3 score-rows level ] unit-test
+{ 2 } [ <default-sokoban> dup 4 score-rows dup 4 score-rows dup 2 score-rows level ] unit-test
diff --git a/extra/sokoban/game/game.factor b/extra/sokoban/game/game.factor

new file mode 100644 (file)

index 0000000..fa4cfd1
--- /dev/null
+++ b/extra/sokoban/game/game.factor
@@ -0,0 +1,119 @@
+! Copyright (C) 2006, 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+
+USING: accessors combinators kernel lists math math.functions math.vectors
+sequences system sokoban.board sokoban.piece sokoban.layout sokoban.sound colors 
+namespaces locals ;
+
+IN: sokoban.game
+
+TUPLE: sokoban
+    { board }
+    { player }
+    { boxes }
+    { goals }
+    { engine }
+    { last-update integer initial: 0 }
+    { level integer initial: 0 }
+    { paused? initial: f }
+    { running? initial: t } ;
+
+: add-wall-block ( sokoban block -- )
+    over [ board>> ] 2dip <board-piece> swap level>> rotate-piece layout>> color>> set-block ;
+
+: add-walls ( sokoban -- ) 
+    dup <board-piece> swap level>> rotate-piece wall-blocks [ add-wall-block ] with each ;
+
+:: <sokoban> ( lev w h -- sokoban )
+    ! make components
+    w h <board> :> board
+    lev <player-piece> :> player
+    lev <goal-piece> :> goals
+
+    ! put components into sokoban instance
+    sokoban new :> soko
+    soko player >>player
+    lev >>level
+    board >>board
+    goals >>goals
+    goals lev <box-seq> >>boxes
+    soko add-walls ; ! draw walls
+
+
+: <default-sokoban> ( -- sokoban )
+    ! Level 0 sokoban
+    0 8 9 <sokoban> ;
+
+: toggle-pause ( sokoban -- )
+    [ not ] change-paused? drop ;
+    
+: can-player-move? ( sokoban move -- ? )
+    [ drop board>> ] [ [ player>> clone ] dip move-piece ] 2bi piece-valid? ;
+
+:: get-adj-box ( soko piece mov -- box ) 
+    ! If the input piece (either a player or another box) has a box at its move location,
+    ! return the box at the move location. Otherwise, return false
+    piece location>> :> player_loc
+    player_loc mov v+ :> next_loc
+    soko boxes>> :> box_list
+    box_list [ location>> next_loc = ] find swap drop ;
+
+:: can-box-move? ( soko box mov -- ? )
+    soko box mov get-adj-box :> box2move ! Checks if input box has a box at its move location
+    box2move
+    [   ! If there is another box at the move location, the current box is unable to move
+        f
+    ]
+    [   ! Otherwise, we check if there is a wall blocking the box
+        soko board>> box clone mov move-piece piece-valid?
+    ] if ;
+
+:: sokoban-move ( soko mov -- ? )
+    ! Collision logic -- checks if player can move and moves the player accordingly
+    soko mov can-player-move?
+    [   ! Player can move
+        soko dup player>> mov get-adj-box :> box2move
+        box2move
+        [   ! Next location of player is a box
+            soko box2move mov can-box-move?
+            [   ! Next location of player is a box and box is able to move
+                soko goals>> box2move location>> mov is-goal?
+                [   ! Next location of box is a goal point
+                    soko player>> mov move-piece drop
+                    box2move mov move-piece
+                    soko engine>> play-beep
+                    "vocab:sokoban/resources/CrateDark_Yellow.png" >>path
+                    layout>> COLOR: blue >>color drop t ! change color once box is on goal
+                ]
+                [   ! Next location of box is a free space
+                    soko player>> mov move-piece drop
+                    box2move mov move-piece
+                    layout>> COLOR: orange >>color drop t
+                ] if
+            ]
+            [   ! Next location of player is a box but box cannot move
+                f
+            ] if
+        ]
+        [   ! Next location of player is a free space, move the player onto the free space
+            soko player>> mov move-piece drop t
+        ] if 
+    ]
+    [   ! Player cannot move
+        f
+    ] if ;
+
+: move-left ( sokoban -- ) dup player>> "vocab:sokoban/resources/CharL.png" >>path drop { -1 0 } sokoban-move drop ;
+
+: move-right ( sokoban -- ) dup player>> "vocab:sokoban/resources/CharR.png" >>path drop { 1 0 } sokoban-move drop ;
+
+: move-down ( sokoban -- ) dup player>> "vocab:sokoban/resources/CharF.png" >>path drop { 0 1 } sokoban-move drop ;
+
+: move-up ( sokoban -- ) dup player>> "vocab:sokoban/resources/CharB.png" >>path drop { 0 -1 } sokoban-move drop ;
+
+: update-level? ( sokoban -- ? )
+    ! Get color color of each box
+    boxes>> [ layout>> ] map [ color>> ] map 
+    ! All boxes are on correct spots if there are no orange boxes left and level should be updated
+    [ COLOR: orange ] first swap member? not ;
+
diff --git a/extra/sokoban/gl/gl.factor b/extra/sokoban/gl/gl.factor

new file mode 100644 (file)

index 0000000..b8fe358
--- /dev/null
+++ b/extra/sokoban/gl/gl.factor
@@ -0,0 +1,66 @@
+! Copyright (C) 2006, 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays colors combinators math.vectors
+kernel math opengl opengl.gl opengl.textures sequences sokoban.game sokoban.piece images.loader
+;
+
+IN: sokoban.gl
+
+! OpenGL rendering for sokoban ;
+
+: draw-block ( block -- )
+    { 1 1 } gl-fill-rect ;
+
+: draw-sprite ( block path -- )
+    load-image swap <texture> { 1 1 } swap draw-scaled-texture ;
+
+:: draw-piece-blocks ( piece -- )
+    piece piece-blocks [ piece path>> draw-sprite ] each ;
+
+: draw-piece ( piece -- )
+    dup layout>> color>> gl-color draw-piece-blocks ;
+
+: draw-goal ( block -- )
+    { 0.38 0.38 } v+ { 0.24 0.24 } gl-fill-rect ;
+
+: draw-goal-blocks ( piece -- )
+    ! implement goals the same way we do as walls
+    wall-blocks [ draw-goal ] each ;
+
+: draw-goal-piece ( piece -- )
+    dup layout>> color>> gl-color draw-goal-blocks ;
+
+! TODO: move implementation specific stuff into sokoban-board
+: (draw-row) ( x y row -- )
+    overd nth [ gl-color 2array draw-block ] [ 2drop ] if* ;
+
+: draw-row ( y row -- )
+    [ length <iota> swap ] keep [ (draw-row) ] 2curry each ;
+
+: draw-board ( board -- )
+    rows>> [ swap draw-row ] each-index ;
+
+: scale-board ( width height board -- )
+    [ width>> ] [ height>> ] bi swapd [ / ] dup 2bi* 1 glScalef ;
+
+: set-background-color ( sokoban -- )
+    dup running?>> [
+        paused?>> COLOR: light-gray COLOR: white ?
+    ] [ drop COLOR: black ] if gl-color ;
+
+: draw-background ( board -- )
+    [ 0 0 ] dip [ width>> ] [ height>> ] bi glRectf ;
+
+: draw-sokoban ( width height sokoban -- )
+    ! width and height are in pixels
+    [
+        {
+            [ board>> scale-board ]
+            [ set-background-color ]
+            [ board>> draw-background ]
+            [ board>> draw-board ]
+            [ player>> draw-piece ]
+            [ goals>> draw-goal-piece ]
+            [ boxes>> [ draw-piece ] each ]
+        } cleave
+    ] do-matrix ;
diff --git a/extra/sokoban/layout/layout.factor b/extra/sokoban/layout/layout.factor

new file mode 100644 (file)

index 0000000..aaf70b4
--- /dev/null
+++ b/extra/sokoban/layout/layout.factor
@@ -0,0 +1,171 @@
+! Copyright (C) 2006, 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel arrays namespaces sequences math math.order
+math.vectors colors random ;
+IN: gamelib.demos.sokoban.layout
+
+TUPLE: layout states color ;
+
+C: <layout> layout
+
+SYMBOL: component
+
+{
+  [ ! walls on each level
+    {
+      {
+                        { 2 0 } { 3 0 } { 4 0 } { 5 0 } { 6 0 }
+        { 0 1 } { 1 1 } { 2 1 }                         { 6 1 }
+        { 0 2 }                                         { 6 2 }
+        { 0 3 } { 1 3 } { 2 3 }                         { 6 3 }
+        { 0 4 }         { 2 4 } { 3 4 }                 { 6 4 }
+        { 0 5 }         { 2 5 }                         { 6 5 } { 7 5 }
+        { 0 6 }                                                 { 7 6 }
+        { 0 7 }                                                 { 7 7 }
+        { 0 8 } { 1 8 } { 2 8 } { 3 8 } { 4 8 } { 5 8 } { 6 8 } { 7 8 }
+      }
+      { ! new level (access it by rotating the level piece)
+                                        { 4 0 } { 5 0 } { 6 0 } { 7 0 } { 8 0 }
+                                        { 4 1 }                         { 8 1 }
+                                        { 4 2 }                         { 8 2 }
+                        { 2 3 } { 3 3 } { 4 3 }                         { 8 3 } { 9 3 } { 10 3 }
+                        { 2 4 }                                                         { 10 4 }
+        { 0 5 } { 1 5 } { 2 5 }         { 4 5 }         { 6 5 } { 7 5 } { 8 5 }         { 10 5 }                                              { 16 5 } { 17 5 } { 18 5 } { 19 5 } { 20 5 } { 21 5 }
+        { 0 6 }                         { 4 6 }         { 6 6 } { 7 6 } { 8 6 }         { 10 6 } { 11 6 } { 12 6 } { 13 6 } { 14 6 } { 15 6 } { 16 6 }                                     { 21 6 }
+        { 0 7 }                                                                                                                                                                            { 21 7 }
+        { 0 8 } { 1 8 } { 2 8 } { 3 8 } { 4 8 }         { 6 8 } { 7 8 } { 8 8 }         { 10 8 }          { 12 8 } { 13 8 } { 14 8 } { 15 8 } { 16 8 }                                     { 21 8 }
+                                        { 4 9 }                                         { 10 9 } { 11 9 } { 12 9 }                            { 16 9 } { 17 9 } { 18 9 } { 19 9 } { 20 9 } { 21 9 }
+                                        { 4 10 } { 5 10 } { 6 10 } { 7 10 } { 8 10 } { 9 10 } { 10 10 } 
+
+      }
+    } COLOR: gray
+  ]
+  [ ! player position on each level
+    {
+      {
+        { 2 2 }
+      }
+      {
+        { 11 8 }
+      }
+    } COLOR: green
+  ]
+  [
+    {
+      {
+        { 1 2 } { 5 3 } { 1 4 } { 4 5 } { 3 6 } { 6 6 } { 4 7 } 
+      }
+      {
+        { 19 6 } { 20 6 }
+        { 19 7 } { 20 7 }
+        { 19 8 } { 20 8 }
+      }
+    } COLOR: pink
+  ]
+} [ first2 <layout> ] map component set-global
+
+SYMBOL: boxes
+{
+  { ! first box on each level
+    {
+      { ! level 0
+        { 3 2 }
+      }
+
+      { ! level 1
+        { 5 2 }
+      }
+    } COLOR: orange
+  }
+
+  { ! second box on each level
+    {
+      { ! level 0
+        { 4 3 }
+      }
+
+      { ! level 1
+        { 7 3 }
+      }
+    } COLOR: orange
+  }
+
+  { ! third box on each level
+    {
+      { ! level 0
+        { 4 4 }
+      }
+      { ! level 1
+        { 5 4 }
+      }
+    } COLOR: orange
+  }
+
+  { ! fourth box on each level
+    {
+      { ! level 0
+        { 4 6 }
+      }
+      { ! level 1
+        { 8 4 }
+      }
+    } COLOR: orange
+  }
+
+  { ! fifth box on each level
+    {
+      { ! level 0
+        { 3 6 }
+      }
+      { ! level 1
+        { 5 7 }
+      }
+    } COLOR: orange
+  }
+
+  { ! sixth box on each level
+    {
+      { ! level 0
+        { 5 6 }
+      }
+      { ! level 1
+        { 2 7 }
+      }
+    } COLOR: orange
+  }
+
+    { ! seventh box on each level
+    {
+      { ! level 0
+        { 1 6 }
+      }
+    } COLOR: orange
+  }
+
+  ! etc
+} [ first2 <layout> ] map boxes set-global
+
+
+SYMBOL: num-boxes
+{
+  ! number of boxes -1 of each level
+  6
+  5
+} num-boxes set-global
+
+: get-board ( -- layout )
+    component get first ;
+
+: get-player ( -- layout )
+    component get second ;
+
+: get-box ( n -- layout )
+    boxes get nth ;
+    ! TODO add an n argument and get (n + 1)th
+
+: get-goal ( -- layout )
+    component get third ;
+
+: get-num-boxes ( n -- m )
+    ! outputs how many boxes are on each level, allows for different numbers of boxes per level
+    num-boxes get nth ;
diff --git a/extra/sokoban/piece/piece-tests.factor b/extra/sokoban/piece/piece-tests.factor

new file mode 100644 (file)

index 0000000..aff8ba1
--- /dev/null
+++ b/extra/sokoban/piece/piece-tests.factor
@@ -0,0 +1,23 @@
+USING: accessors kernel sokoban.tetromino sokoban.piece tools.test sequences arrays namespaces ;
+
+! Tests for sokoban.tetromino and sokoban.piece, since there's not much to test in sokoban.tetromino
+
+! these two tests rely on the first level_num of the first tetromino being the
+! 'I' tetromino in its vertical orientation.
+{ 4 } [ tetrominoes get first states>> first blocks-width ] unit-test
+{ 1 } [ tetrominoes get first states>> first blocks-height ] unit-test
+
+! { { 0 0 } } [ random-tetromino <piece> location>> ] unit-test
+! { 0 } [ 10 <random-piece> level_num>> ] unit-test
+
+{ { { 0 0 } { 1 0 } { 2 0 } { 3 0 } } }
+[ tetrominoes get first <piece> piece-blocks ] unit-test
+
+{ { { 0 0 } { 0 1 } { 0 2 } { 0 3 } } }
+[ tetrominoes get first <piece> 1 rotate-piece piece-blocks ] unit-test
+
+{ { { 1 1 } { 2 1 } { 3 1 } { 4 1 } } }
+[ tetrominoes get first <piece> { 1 1 } move-piece piece-blocks ] unit-test
+
+{ 3 } [ tetrominoes get second <piece> piece-width ] unit-test
+{ 2 } [ tetrominoes get second <piece> 1 rotate-piece piece-width ] unit-test
diff --git a/extra/sokoban/piece/piece.factor b/extra/sokoban/piece/piece.factor

new file mode 100644 (file)

index 0000000..01aca87
--- /dev/null
+++ b/extra/sokoban/piece/piece.factor
@@ -0,0 +1,75 @@
+! Copyright (C) 2006, 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays kernel math math.vectors sequences
+sokoban.layout lists.lazy namespaces colors
+ranges random ;
+IN: sokoban.piece
+
+! The level_num is an index into the layout's states array,
+! and the position is added to the layout's blocks to give
+! them their location on the sokoban board. If the location is f
+! then the piece is not yet on the board.
+
+TUPLE: piece
+    { layout layout }
+    { level_num integer initial: 0 }
+    { location array initial: { 0 0 } }
+    { path } ;
+
+: <piece> ( layout -- piece )
+    piece new swap >>layout ;
+
+: (piece-blocks) ( piece -- blocks )
+    ! rotates the piece
+    [ level_num>> ] [ layout>> states>> ] bi nth ;
+
+: wall-blocks ( piece -- blocks )
+    [ (piece-blocks) ] [ location>> ] bi [ v+ ] curry map ;
+
+: piece-blocks ( piece -- blocks )
+    location>> { } 1sequence ; ! literally just returns the location in a sequence
+
+: set-location ( piece level -- piece )
+    ! sets the location of piece to where they are defined in layout
+    over layout>> states>> nth first >>location ; 
+
+: is-goal? ( goal-piece location move -- ? )
+    ! check if next move is a goal or not
+    v+ swap [ level_num>> ] [ layout>> ] bi states>> nth member? ;
+
+: <board-piece> ( -- piece )
+    get-board <piece> ;
+
+: <player-piece> ( level -- piece )
+    get-player <piece> swap set-location "vocab:sokoban/resources/CharR.png" >>path ;
+    
+
+:: <box-piece> ( box-number goal-piece level  -- piece )
+    box-number get-box <piece> level set-location "vocab:sokoban/resources/Crate_Yellow.png" >>path dup [ layout>> ] [ location>> ] bi
+    goal-piece swap { 0 0 } is-goal?
+    [
+        COLOR: blue
+    ]
+    [
+        COLOR: orange
+    ] if
+    >>color drop ;
+
+:: <box-seq> ( goal-piece level -- seq )
+    ! get list of boxes on corresponding level
+    level get-num-boxes [0..b] [ goal-piece level <box-piece> ] map ;
+
+: (rotate-piece) ( level_num inc n-states -- level_num' )
+    [ + ] dip rem ;
+
+: rotate-piece ( piece inc -- piece )
+    over layout>> states>> length
+    [ (rotate-piece) ] 2curry change-level_num ;
+
+: <goal-piece> ( level -- piece )
+    ! rotate goal according to level
+    get-goal <piece> swap rotate-piece ;
+
+
+: move-piece ( piece move -- piece )
+    [ v+ ] curry change-location ;
diff --git a/extra/sokoban/resources/CharB.png b/extra/sokoban/resources/CharB.png

new file mode 100644 (file)

index 0000000..7f94ffa

Binary files /dev/null and b/extra/sokoban/resources/CharB.png differ
diff --git a/extra/sokoban/resources/CharF.png b/extra/sokoban/resources/CharF.png

new file mode 100644 (file)

index 0000000..0315373

Binary files /dev/null and b/extra/sokoban/resources/CharF.png differ
diff --git a/extra/sokoban/resources/CharL.png b/extra/sokoban/resources/CharL.png

new file mode 100644 (file)

index 0000000..cbf6857

Binary files /dev/null and b/extra/sokoban/resources/CharL.png differ
diff --git a/extra/sokoban/resources/CharR.png b/extra/sokoban/resources/CharR.png

new file mode 100644 (file)

index 0000000..6e21bb3

Binary files /dev/null and b/extra/sokoban/resources/CharR.png differ
diff --git a/extra/sokoban/resources/CharWalkB.png b/extra/sokoban/resources/CharWalkB.png

new file mode 100644 (file)

index 0000000..74d9819

Binary files /dev/null and b/extra/sokoban/resources/CharWalkB.png differ
diff --git a/extra/sokoban/resources/CharWalkF.png b/extra/sokoban/resources/CharWalkF.png

new file mode 100644 (file)

index 0000000..03d27e1

Binary files /dev/null and b/extra/sokoban/resources/CharWalkF.png differ
diff --git a/extra/sokoban/resources/CharWalkL.png b/extra/sokoban/resources/CharWalkL.png

new file mode 100644 (file)

index 0000000..465e48b

Binary files /dev/null and b/extra/sokoban/resources/CharWalkL.png differ
diff --git a/extra/sokoban/resources/CharWalkR.png b/extra/sokoban/resources/CharWalkR.png

new file mode 100644 (file)

index 0000000..13e717f

Binary files /dev/null and b/extra/sokoban/resources/CharWalkR.png differ
diff --git a/extra/sokoban/resources/CrateDark_Yellow.png b/extra/sokoban/resources/CrateDark_Yellow.png

new file mode 100644 (file)

index 0000000..3de6977

Binary files /dev/null and b/extra/sokoban/resources/CrateDark_Yellow.png differ
diff --git a/extra/sokoban/resources/Crate_Yellow.png b/extra/sokoban/resources/Crate_Yellow.png

new file mode 100644 (file)

index 0000000..06c7b99

Binary files /dev/null and b/extra/sokoban/resources/Crate_Yellow.png differ
diff --git a/extra/sokoban/resources/music.wav b/extra/sokoban/resources/music.wav

new file mode 100644 (file)

index 0000000..b0ee936

Binary files /dev/null and b/extra/sokoban/resources/music.wav differ
diff --git a/extra/sokoban/resources/once.wav b/extra/sokoban/resources/once.wav

new file mode 100644 (file)

index 0000000..3fc85b0

Binary files /dev/null and b/extra/sokoban/resources/once.wav differ
diff --git a/extra/sokoban/sokoban.factor b/extra/sokoban/sokoban.factor

new file mode 100644 (file)

index 0000000..efe91c3
--- /dev/null
+++ b/extra/sokoban/sokoban.factor
@@ -0,0 +1,98 @@
+! Copyright (C) 2006, 2007, 2008 Alex Chapman
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors timers arrays calendar destructors kernel make math math.rectangles
+math.parser namespaces sequences system sokoban.game sokoban.layout sokoban.gl sokoban.sound ui.gadgets
+ui.gadgets.labels ui.gadgets.worlds ui.gadgets.status-bar ui.gestures
+ui.render ui ;
+IN: sokoban
+
+TUPLE: sokoban-gadget < gadget { sokoban sokoban } { timer } { window-dims array initial: { 700 800 } } ;
+
+: <sokoban-gadget> ( sokoban -- gadget )
+    create-engine >>engine
+    sokoban-gadget new swap >>sokoban ;
+
+:: get-dim ( sokoban level -- level w h )
+    ! Look for maximum height and width of wall layout to determine size of board
+    level component get first states>> nth :> new_board
+    level
+    new_board [ first ] map supremum 1 +
+    new_board [ second ] map supremum 1 + ;
+
+: new-sokoban ( gadget -- gadget )
+    ! Restarts sokoban without changing levels
+    dup sokoban>> engine>> swap
+    [ dup level>> get-dim <sokoban> ] change-sokoban
+    swap over sokoban>> swap >>engine >>sokoban ;
+
+:: window-size ( sokoban -- window-size )
+    sokoban level>> :> level
+    sokoban level get-dim :> ( lev w h )
+    100 w * :> xpix
+    100 h * :> ypix
+    { xpix ypix } ;
+
+
+: update-sokoban ( gadget -- gadget )
+    ! Changes to the next level of sokoban
+    dup sokoban>> engine>> swap
+    [ dup level>> 1 + get-dim <sokoban> ] change-sokoban 
+    dup sokoban>> window-size >>window-dims 
+    swap over sokoban>> swap >>engine >>sokoban ;
+
+M: sokoban-gadget pref-dim* ( gadget -- dim ) 
+    sokoban>> window-size ;
+    ! drop { 700 800 } ; ! needs to be changed as well
+
+: update-status ( gadget -- )
+    dup sokoban>> [
+        [ "Level: " % level>> # ]
+        [ paused?>> [ " (Paused)" % ] when ] bi
+    ] "" make swap show-status ;
+
+M: sokoban-gadget draw-gadget* ( gadget -- )
+    [
+        [ dim>> first2 ] [ sokoban>> ] bi draw-sokoban
+    ] keep update-status ;
+
+: unless-paused ( sokoban quot -- )
+    over sokoban>> paused?>> [
+        2drop
+    ] [
+        call
+    ] if ; inline
+
+sokoban-gadget H{
+    { T{ button-down f f 1 }     [ request-focus ] }
+    { T{ key-down f f "UP" }     [ [ sokoban>> move-up ] unless-paused ] }
+    { T{ key-down f f "LEFT" }   [ [ sokoban>> move-left ] unless-paused ] }
+    { T{ key-down f f "RIGHT" }  [ [ sokoban>> move-right ] unless-paused ] }
+    { T{ key-down f f "DOWN" }   [ [ sokoban>> move-down ] unless-paused ] }
+    { T{ key-down f f "p" }      [ sokoban>> toggle-pause ] }
+    { T{ key-down f f "n" }      [ new-sokoban drop ] }
+} set-gestures
+
+: tick ( gadget -- )
+    dup sokoban>> update-level? [
+        update-sokoban
+        relayout-window
+    ] [ 
+        relayout-1
+    ] if 
+     ;
+
+M: sokoban-gadget graft* ( gadget -- )
+    dup sokoban>> engine>> play-music
+    [ [ tick ] curry 100 milliseconds every ] keep timer<< ;
+
+M: sokoban-gadget ungraft* ( gadget -- )
+    dup sokoban>> engine>> dispose
+    [ stop-timer f ] change-timer drop ;
+
+: sokoban-window ( -- )
+    [
+        <default-sokoban> <sokoban-gadget>
+        "sokoban" open-status-window
+    ] with-ui ;
+
+MAIN: sokoban-window
+\ No newline at end of file
diff --git a/extra/sokoban/sound/sound.factor b/extra/sokoban/sound/sound.factor

new file mode 100644 (file)

index 0000000..c1b308b
--- /dev/null
+++ b/extra/sokoban/sound/sound.factor
@@ -0,0 +1,27 @@
+! Copyright (C) 2009 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors timers audio audio.engine audio.loader calendar
+destructors io kernel locals math math.functions ranges specialized-arrays
+sequences random math.vectors literals ;
+
+
+IN: sokoban.sound
+
+: create-engine ( -- engine )
+    f 10 <audio-engine> ;
+
+:: play-beep ( engine -- )
+    $[ "vocab:sokoban/resources/once.wav" read-audio ] :> once-sound
+    engine start-audio*
+    
+    engine T{ audio-source f { 0.0 0.0 0.0 } 1.0 { 0.0 0.0 0.0 } f } once-sound f
+        play-static-audio-clip drop ;
+
+:: play-music ( engine -- )
+    $[ "vocab:sokoban/resources/music.wav" read-audio ] :> loop-sound
+    engine start-audio*
+    
+    engine T{ audio-source f { 0.0 0.0 0.0 } 1.0 { 0.0 0.0 0.0 } f } loop-sound t
+        play-static-audio-clip drop ;
+    
+
diff --git a/extra/sokoban/summary.txt b/extra/sokoban/summary.txt

new file mode 100644 (file)

index 0000000..f5e5143
--- /dev/null
+++ b/extra/sokoban/summary.txt
@@ -0,0 +1 @@
+Graphical sokoban game
diff --git a/extra/sokoban/tags.txt b/extra/sokoban/tags.txt

new file mode 100644 (file)

index 0000000..0993457
--- /dev/null
+++ b/extra/sokoban/tags.txt
@@ -0,0 +1,3 @@
+demos
+applications
+games
author	John Benediktsson <mrjbq7@gmail.com>
	Sun, 31 Jul 2022 21:16:08 +0000 (14:16 -0700)
committer	John Benediktsson <mrjbq7@gmail.com>
	Sun, 31 Jul 2022 21:16:08 +0000 (14:16 -0700)
extra/gamelib/board/board.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/cell-object/cell-object.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/flow-demo/flow-demo.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/maze-game/maze-game.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/multiple-board-demo/multiple-board-demo.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/parent-demo.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/CharB.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/CharF.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/CharL.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/CharR.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/CharWalkB.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/CharWalkF.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/CharWalkL.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/CharWalkR.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/CrateDark_Yellow.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/Crate_Yellow.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/Goal.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/Tetris.wav	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/Wall_Brown.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/parent-demo/resources/once.wav	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/layouts/layouts.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/loop/loop.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/CharB.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/CharF.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/CharL.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/CharR.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/CharWalkB.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/CharWalkF.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/CharWalkL.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/CharWalkR.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/CrateDark_Yellow.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/Crate_Yellow.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/Goal.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/Tetris.wav	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/Wall_Brown.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/hardwood-tree.jpg	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/large-tree.jpg	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/once.wav	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/resources/tree.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/sokoban/sokoban.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/tic-tac-toe/resources/O.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/tic-tac-toe/resources/X.png	[new file with mode: 0644]	patch \| blob
extra/gamelib/demos/tic-tac-toe/tic-tac-toe.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/loop/loop.factor	[new file with mode: 0644]	patch \| blob
extra/gamelib/ui/ui.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/README.txt	[new file with mode: 0644]	patch \| blob
extra/sokoban/authors.txt	[new file with mode: 0644]	patch \| blob
extra/sokoban/board/board-tests.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/board/board.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/deploy.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/game/game-tests.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/game/game.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/gl/gl.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/layout/layout.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/piece/piece-tests.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/piece/piece.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/CharB.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/CharF.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/CharL.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/CharR.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/CharWalkB.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/CharWalkF.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/CharWalkL.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/CharWalkR.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/CrateDark_Yellow.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/Crate_Yellow.png	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/music.wav	[new file with mode: 0644]	patch \| blob
extra/sokoban/resources/once.wav	[new file with mode: 0644]	patch \| blob
extra/sokoban/sokoban.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/sound/sound.factor	[new file with mode: 0644]	patch \| blob
extra/sokoban/summary.txt	[new file with mode: 0644]	patch \| blob
extra/sokoban/tags.txt	[new file with mode: 0644]	patch \| blob