From: John Benediktsson Date: Mon, 1 Aug 2022 15:14:26 +0000 (-0700) Subject: sokoban: removing in favor of newer gamelib.demos.sokoban X-Git-Tag: 0.99~1232 X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=edffcfb6e37886035aa696e7431f587082eb96d7 sokoban: removing in favor of newer gamelib.demos.sokoban --- diff --git a/extra/sokoban/README.txt b/extra/sokoban/README.txt deleted file mode 100644 index a3bdf792ef..0000000000 --- a/extra/sokoban/README.txt +++ /dev/null @@ -1,7 +0,0 @@ -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 deleted file mode 100644 index 36ce64f6f0..0000000000 --- a/extra/sokoban/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Factor Clinic Team 2021-2022 diff --git a/extra/sokoban/board/board-tests.factor b/extra/sokoban/board/board-tests.factor deleted file mode 100644 index 2d25adeb71..0000000000 --- a/extra/sokoban/board/board-tests.factor +++ /dev/null @@ -1,23 +0,0 @@ -USING: accessors arrays colors 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 rows>> ] unit-test -{ 1 { f f } } [ 2 3 { 1 1 } board@block ] unit-test -{ f } [ 2 3 { 1 1 } block ] unit-test -[ 2 3 { 2 3 } block ] must-fail -{ COLOR: red } [ 2 3 dup { 1 1 } COLOR: red set-block { 1 1 } block ] unit-test -{ t } [ 2 3 { 1 1 } block-free? ] unit-test -{ f } [ 2 3 dup { 1 1 } COLOR: red set-block { 1 1 } block-free? ] unit-test -{ t } [ 2 3 dup { 1 1 } COLOR: red set-block { 1 2 } block-free? ] unit-test -{ t } [ 2 3 dup { 1 1 } COLOR: red set-block { 0 1 } block-free? ] unit-test -{ t } [ 2 3 { 0 0 } block-in-bounds? ] unit-test -{ f } [ 2 3 { -1 0 } block-in-bounds? ] unit-test -{ t } [ 2 3 { 1 2 } block-in-bounds? ] unit-test -{ f } [ 2 3 { 2 2 } block-in-bounds? ] unit-test -{ t } [ 2 3 { 1 1 } location-valid? ] unit-test -{ f } [ 2 3 dup { 1 1 } COLOR: red set-block { 1 1 } location-valid? ] unit-test -! { t } [ 10 10 10 piece-valid? ] unit-test -! { f } [ 2 3 10 { 1 2 } >>location piece-valid? ] unit-test -! { { { f } { f } } } [ 1 1 add-row rows>> ] unit-test -! { { { f } } } [ 1 2 dup { 0 1 } COLOR: red set-block remove-full-rows rows>> ] unit-test -! { { { f } { f } } } [ 1 2 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 deleted file mode 100644 index 800bf8416e..0000000000 --- a/extra/sokoban/board/board.factor +++ /dev/null @@ -1,39 +0,0 @@ -! 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 ] replicate ; - -: ( 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>> bounds-check? ] - [ second swap height>> 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 deleted file mode 100644 index ea8750f6d1..0000000000 --- a/extra/sokoban/deploy.factor +++ /dev/null @@ -1,13 +0,0 @@ -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 deleted file mode 100644 index 07cd3c20b2..0000000000 --- a/extra/sokoban/game/game-tests.factor +++ /dev/null @@ -1,15 +0,0 @@ -USING: accessors kernel sokoban.game sokoban.board sokoban.piece tools.test -sequences ; - -! { t } [ [ current-piece ] [ next-piece ] bi and t f ? ] unit-test -! { t } [ { 1 1 } can-move? ] unit-test -{ t } [ { 1 1 } sokoban-move ] unit-test -! { 1 } [ dup { 1 1 } sokoban-move drop current-piece location>> second ] unit-test -{ 0 } [ level>> ] unit-test -! { 1 } [ 9 >>rows level>> ] unit-test -! { 2 } [ 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 } [ dup 3 score-rows dup 3 score-rows dup 3 score-rows level ] unit-test -! { 2 } [ 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 deleted file mode 100644 index fa4cfd1ab2..0000000000 --- a/extra/sokoban/game/game.factor +++ /dev/null @@ -1,119 +0,0 @@ -! 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 swap level>> rotate-piece layout>> color>> set-block ; - -: add-walls ( sokoban -- ) - dup swap level>> rotate-piece wall-blocks [ add-wall-block ] with each ; - -:: ( lev w h -- sokoban ) - ! make components - w h :> board - lev :> player - lev :> goals - - ! put components into sokoban instance - sokoban new :> soko - soko player >>player - lev >>level - board >>board - goals >>goals - goals lev >>boxes - soko add-walls ; ! draw walls - - -: ( -- sokoban ) - ! Level 0 sokoban - 0 8 9 ; - -: 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 deleted file mode 100644 index b8fe358b9c..0000000000 --- a/extra/sokoban/gl/gl.factor +++ /dev/null @@ -1,66 +0,0 @@ -! 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 { 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 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 deleted file mode 100644 index 7a5517d1e9..0000000000 --- a/extra/sokoban/layout/layout.factor +++ /dev/null @@ -1,171 +0,0 @@ -! 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: sokoban.layout - -TUPLE: layout states color ; - -C: 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 ] 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 ] 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.factor b/extra/sokoban/piece/piece.factor deleted file mode 100644 index 01aca87e0b..0000000000 --- a/extra/sokoban/piece/piece.factor +++ /dev/null @@ -1,75 +0,0 @@ -! 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 } ; - -: ( 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? ; - -: ( -- piece ) - get-board ; - -: ( level -- piece ) - get-player swap set-location "vocab:sokoban/resources/CharR.png" >>path ; - - -:: ( box-number goal-piece level -- piece ) - box-number get-box 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 ; - -:: ( goal-piece level -- seq ) - ! get list of boxes on corresponding level - level get-num-boxes [0..b] [ goal-piece level ] 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 ; - -: ( level -- piece ) - ! rotate goal according to level - get-goal 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 deleted file mode 100644 index 7f94ffa295..0000000000 Binary files a/extra/sokoban/resources/CharB.png and /dev/null differ diff --git a/extra/sokoban/resources/CharF.png b/extra/sokoban/resources/CharF.png deleted file mode 100644 index 0315373306..0000000000 Binary files a/extra/sokoban/resources/CharF.png and /dev/null differ diff --git a/extra/sokoban/resources/CharL.png b/extra/sokoban/resources/CharL.png deleted file mode 100644 index cbf68570e6..0000000000 Binary files a/extra/sokoban/resources/CharL.png and /dev/null differ diff --git a/extra/sokoban/resources/CharR.png b/extra/sokoban/resources/CharR.png deleted file mode 100644 index 6e21bb3b51..0000000000 Binary files a/extra/sokoban/resources/CharR.png and /dev/null differ diff --git a/extra/sokoban/resources/CharWalkB.png b/extra/sokoban/resources/CharWalkB.png deleted file mode 100644 index 74d981939f..0000000000 Binary files a/extra/sokoban/resources/CharWalkB.png and /dev/null differ diff --git a/extra/sokoban/resources/CharWalkF.png b/extra/sokoban/resources/CharWalkF.png deleted file mode 100644 index 03d27e184a..0000000000 Binary files a/extra/sokoban/resources/CharWalkF.png and /dev/null differ diff --git a/extra/sokoban/resources/CharWalkL.png b/extra/sokoban/resources/CharWalkL.png deleted file mode 100644 index 465e48b412..0000000000 Binary files a/extra/sokoban/resources/CharWalkL.png and /dev/null differ diff --git a/extra/sokoban/resources/CharWalkR.png b/extra/sokoban/resources/CharWalkR.png deleted file mode 100644 index 13e717f343..0000000000 Binary files a/extra/sokoban/resources/CharWalkR.png and /dev/null differ diff --git a/extra/sokoban/resources/CrateDark_Yellow.png b/extra/sokoban/resources/CrateDark_Yellow.png deleted file mode 100644 index 3de69773b7..0000000000 Binary files a/extra/sokoban/resources/CrateDark_Yellow.png and /dev/null differ diff --git a/extra/sokoban/resources/Crate_Yellow.png b/extra/sokoban/resources/Crate_Yellow.png deleted file mode 100644 index 06c7b993c6..0000000000 Binary files a/extra/sokoban/resources/Crate_Yellow.png and /dev/null differ diff --git a/extra/sokoban/resources/once.wav b/extra/sokoban/resources/once.wav deleted file mode 100644 index 3fc85b03d3..0000000000 Binary files a/extra/sokoban/resources/once.wav and /dev/null differ diff --git a/extra/sokoban/sokoban.factor b/extra/sokoban/sokoban.factor deleted file mode 100644 index 43ba45a06b..0000000000 --- a/extra/sokoban/sokoban.factor +++ /dev/null @@ -1,97 +0,0 @@ -! 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 ) - 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 ] 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 ] 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 -- ) - [ [ tick ] curry 100 milliseconds every ] keep timer<< ; - -M: sokoban-gadget ungraft* ( gadget -- ) - dup sokoban>> engine>> dispose - [ stop-timer f ] change-timer drop ; - -: sokoban-window ( -- ) - [ - - "sokoban" open-status-window - ] with-ui ; - -MAIN: sokoban-window diff --git a/extra/sokoban/sound/sound.factor b/extra/sokoban/sound/sound.factor deleted file mode 100644 index 7db45b6e8b..0000000000 --- a/extra/sokoban/sound/sound.factor +++ /dev/null @@ -1,18 +0,0 @@ -! 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 ; - -:: 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 ; diff --git a/extra/sokoban/summary.txt b/extra/sokoban/summary.txt deleted file mode 100644 index f5e5143269..0000000000 --- a/extra/sokoban/summary.txt +++ /dev/null @@ -1 +0,0 @@ -Graphical sokoban game diff --git a/extra/sokoban/tags.txt b/extra/sokoban/tags.txt deleted file mode 100644 index 09934571b3..0000000000 --- a/extra/sokoban/tags.txt +++ /dev/null @@ -1,3 +0,0 @@ -demos -applications -games