Paste: a basic tic-tac-toe

Author:	rks
Mode:	factor
Date:	Sat, 25 Dec 2010 12:48:40

Plain Text |

Delete Paste

USING: arrays sequences kernel io prettyprint generalizations 
    namespaces combinators.short-circuit math math.parser 
    splitting ;

IN: tic-tac-toe

SYMBOLS: X O ;

: set-nth! ( elt n seq -- seq ) [ set-nth ] keep ;
: dup! ( obj -- obj clone ) dup clone ;
: draw ( grid -- grid ) dup [ . ] each ;
 
: create-grid ( -- grid ) 3 f <array> dup! dup! 3array ;

: valid-pos? ( x y -- ? ) 
    { [ 0 >= ] [ 3 < ] } [ 1&& ] keep swapd 1&& and ;

: is-free? ( grid x y -- ? ) rot nth nth f = ;

: update-case ( a grid x y -- a grid ) 
    [ pick nth 4 npick -rot set-nth! ] keep rot set-nth! ;

: switch-player ( p g -- p g ) swap X = O X ? swap ;

: read-tuple ( -- n n )
    readln "," split [ string>number ] map
    dup 0 swap nth 1 rot nth ;

: read-pos ( -- n n )
    4 4 [ 2dup valid-pos? ]
    [ 2drop "Enter a position: " write read-tuple ] do until ;

: place ( p g -- p g )
    read-pos
    [ 3dup is-free? ] [ 2drop "Occupied zone." print read-pos ]
    until update-case ;

: is-complete ( seq -- ? )
    { [ { X X X } = ] [ { O O O } = ] } 1|| ;

: get-column ( g n -- col ) swap [ dupd nth ] map nip ;
: transpose ( g -- g g ) 3 iota [ dupd get-column ] map ;

: get-diags ( grid -- grid seq ) dup
    3 iota [ dup pick nth nth ] map swap
    3 iota [ 2 over - swap pick nth nth ] map nip 2array ;

: game-over? ( grid -- ? )
    transpose get-diags append append [ is-complete ] any? ;

: game ( -- )
    X create-grid ! push the initial values on the stack
    [ dup game-over? ] [ draw switch-player place ] until 
    "Game over." print 2drop ;

Annotation: wip

Author:	rks
Mode:	factor
Date:	Sat, 25 Dec 2010 15:09:04

Plain Text |

Delete Annotation

USING: arrays sequences kernel io prettyprint generalizations 
    namespaces combinators.short-circuit math math.parser 
    splitting ;

IN: tic-tac-toe

SYMBOLS: X O ;

: set-nth! ( elt n seq -- seq ) [ set-nth ] keep ;
: draw ( grid -- grid ) dup [ . ] each ;
 
: row ( e -- seq ) 3 swap <array> ;
: create-grid ( -- grid ) 3 [ row ] replicate ;

: inside? ( x -- ? ) { [ 0 >= ] [ 3 < ] } 1&& ;
: valid-pos? ( x y -- ? ) [ inside? ] both? ;
: is-free? ( grid x y -- ? ) rot nth nth f = ;

: update-case ( a grid x y -- a grid ) 
    [ pick nth 4 npick -rot set-nth! ] keep rot set-nth! ;

: switch-player ( p g -- p g ) swap X = O X ? swap ;

: read-tuple ( -- n n )
    readln "," split [ string>number ] map
    0 over nth 1 rot nth ;

: read-pos ( -- n n )
    4 4 [ 2dup valid-pos? ]
    [ 2drop "Enter a position: " write read-tuple ] do until ;

: place ( p g -- p g )
    read-pos
    [ 3dup is-free? ] [ 2drop "Occupied zone." print read-pos ]
    until update-case ;

: complete? ( seq -- ? ) { [ X row = ] [ O row = ] } 1|| ;

: diag ( grid -- seq ) 3 iota [ dup pick nth nth ] map nip ;
: diags ( grid -- seq ) [ diag ] [ reverse diag ] bi 2array ;

: game-over? ( grid -- ? )
    dup clone flip dup diags append append [ complete? ] any? ;

: game ( -- )
    X create-grid ! push the initial values on the stack
    [ dup game-over? ] [ draw switch-player place ] until 
    "Game over." print 2drop ;

Annotation: wip2

Author:	rks
Mode:	factor
Date:	Sat, 25 Dec 2010 15:25:44

Plain Text |

Delete Annotation

USING: arrays sequences kernel io prettyprint generalizations 
    namespaces combinators.short-circuit math math.parser 
    splitting ;

IN: tic-tac-toe

SYMBOLS: X O ;

: at ( n n g -- x ) nth nth ;
: set-nth! ( elt n seq -- seq ) [ set-nth ] keep ;
: draw ( grid -- grid ) dup [ . ] each ;
 
: row ( e -- seq ) 3 swap <array> ;
: create-grid ( -- grid ) 3 [ f row ] replicate ;

: inside? ( x -- ? ) { [ 0 >= ] [ 3 < ] } 1&& ;
: valid-pos? ( x y -- ? ) [ inside? ] both? ;
: is-free? ( grid x y -- ? ) rot at f = ;

: update-case ( a grid x y -- a grid ) 
    [ pick nth 4 npick -rot set-nth! ] keep rot set-nth! ;

: switch-player ( p -- p ) X = O X ? ;

: read-tuple ( -- n n )
    readln "," split [ string>number ] map
    0 over nth 1 rot nth ;

: read-pos ( -- n n )
    4 4 [ 2dup valid-pos? ]
    [ 2drop "Enter a position: " write read-tuple ] do until ;

: place ( p g -- p g )
    read-pos
    [ 3dup is-free? ] [ 2drop "Occupied zone." print read-pos ]
    until update-case ;

: complete? ( seq -- ? ) X row O row 2array member? ;

: diag ( grid -- seq ) 3 iota [ dup pick at ] map nip ;
: diags ( grid -- seq ) [ diag ] [ reverse diag ] bi 2array ;

: game-over? ( grid -- ? )
    dup clone flip dup diags append append [ complete? ] any? ;

: game ( -- )
    X create-grid ! push the initial values on the stack
    [ dup game-over? ] [ draw [ switch-player ] dip place ] 
    until "Game over." print 2drop ;

Annotation: wip3

Author:	rks
Mode:	factor
Date:	Sat, 25 Dec 2010 16:31:19

Plain Text |

Delete Annotation

USING: arrays sequences kernel io prettyprint generalizations namespaces math
    math.parser math.order splitting combinators combinators.short-circuit ;

IN: tic-tac-toe
SYMBOLS: X O ;

: at ( n n g -- x ) nth nth ;
: set-nth! ( elt n seq -- seq ) [ set-nth ] keep ;
: draw ( grid -- grid ) dup [ . ] each ;
 
: row ( e -- seq ) 3 swap <array> ;
: create-grid ( -- grid ) 3 [ f row ] replicate ;

: outside? ( x y -- ? ) [ 0 2 between? ] both? not ;
: free? ( grid x y -- ? ) rot at f = ;
: invalid-pos? ( g x y -- ? ) {
        { [ 2dup outside? ] [ 3drop "Invalid pos." . t ] }
        { [ free? not ] [ "Occupied zone." . t ] }
        [ f ]
    } cond ;

: read-tuple ( -- n n ) readln "," split [ string>number ] map first2 ;
: ask ( -- n n ) "Enter a position: " write read-tuple ;
: read-pos ( g -- g n n ) [ ask 3dup invalid-pos? ] [ 2drop ] while ;

: update-case ( a x y g -- ) nth set-nth ;
: play ( p g -- p g ) 2dup read-pos rot update-case ;

: complete? ( seq -- ? ) X row O row 2array member? ;

: diag ( grid -- seq ) [ swap nth ] map-index ;
: diags ( grid -- seq ) [ diag ] [ reverse diag ] bi 2array ;

: game-over? ( g -- ? ) dup flip dup diags append append [ complete? ] any? ;

: game ( -- )
    X create-grid ! push the initial values on the stack
    [ dup game-over? ] [ draw [ X = O X ? ] dip play ] until
    "Game over." print 2drop ;

Annotation: wip4

Author:	rks
Mode:	factor
Date:	Sat, 25 Dec 2010 16:52:54

Plain Text |

Delete Annotation

USING: arrays sequences kernel io prettyprint generalizations namespaces math
    math.parser math.order splitting combinators combinators.short-circuit 
    sequences.deep ;

IN: tic-tac-toe
SYMBOLS: X O ;

: at ( n n g -- x ) nth nth ;
: draw ( grid -- grid ) dup [ . ] each ;
 
: row ( e -- seq ) 3 swap <array> ;
: create-grid ( -- grid ) 3 [ f row ] replicate ;

: outside? ( x y -- ? ) [ 0 2 between? ] both? not ;
: taken? ( grid x y -- ? ) rot at f = ;
: invalid-pos? ( g x y -- ? ) {
        { [ 2dup outside? ] [ 3drop "Invalid pos." . t ] }
        { [ taken? ] [ "Occupied zone." . t ] }
        [ f ]
    } cond ;

: read-tuple ( -- n n ) readln "," split [ string>number ] map first2 ;
: ask ( -- n n ) "Enter a position: " write read-tuple ;
: read-pos ( g -- g n n ) [ ask 3dup invalid-pos? ] [ 2drop ] while ;

: update-case ( a x y g -- ) nth set-nth ;
: play ( p g -- p g ) 2dup read-pos rot update-case ;

: diag ( grid -- seq ) [ swap nth ] map-index ;
: diags ( grid -- seq ) [ diag ] [ reverse diag ] bi 2array ;

: complete? ( seq -- ? ) X row O row 2array member? ;
: full? ( g -- ? ) flatten f swap member? not ;
: game-over? ( g -- ? ) 
    { [ full? ] [ dup flip dup diags append append [ complete? ] any? ] } 1|| ;

: game ( -- )
    X create-grid ! push the initial values on the stack
    [ dup game-over? ] [ draw [ X = O X ? ] dip play ] until
    "Game over." print 2drop ;

Annotation: final result (?)

Author:	rks
Mode:	factor
Date:	Sat, 25 Dec 2010 17:01:44

Plain Text |

Delete Annotation

USING: arrays sequences kernel io prettyprint generalizations namespaces math
    math.parser math.order splitting combinators combinators.short-circuit ;

IN: tic-tac-toe
SYMBOLS: X O ;

: at ( n n g -- x ) nth nth ;
: draw ( grid -- grid ) dup [ . ] each ;
 
: row ( e -- seq ) 3 swap <array> ;
: create-grid ( -- grid ) 3 [ f row ] replicate ;

: outside? ( x y -- ? ) [ 0 2 between? ] both? not ;
: taken? ( grid x y -- ? ) rot at f = not ;
: invalid-pos? ( g x y -- ? ) {
        { [ 2dup outside? ] [ 3drop "Invalid pos." . t ] }
        { [ taken? ] [ "Occupied zone." . t ] }
        [ f ]
    } cond ;

: read-tuple ( -- n n ) readln "," split [ string>number ] map first2 ;
: ask ( -- n n ) "Enter a position: " write read-tuple ;
: read-pos ( g -- g n n ) [ ask 3dup invalid-pos? ] [ 2drop ] while ;

: update-case ( a x y g -- ) nth set-nth ;
: play ( p g -- p g ) 2dup read-pos rot update-case ;

: diag ( grid -- seq ) [ swap nth ] map-index ;
: diags ( grid -- seq ) [ diag ] [ reverse diag ] bi 2array ;

: complete? ( seq -- ? ) X row O row 2array member? ;
: full? ( g -- ? ) concat f swap member? not ;
: game-over? ( g -- ? ) 
    { [ full? ] [ dup flip dup diags append append [ complete? ] any? ] } 1|| ;

: game ( -- )
    X create-grid ! push the initial values on the stack
    [ dup game-over? ] [ draw [ X = O X ? ] dip play ] until
    "Game over." print 2drop ;

Annotation: final

Author:	rks
Mode:	factor
Date:	Sat, 25 Dec 2010 17:23:04

Plain Text |

Delete Annotation

USING: arrays sequences kernel io prettyprint generalizations namespaces math
    math.parser math.order splitting combinators combinators.short-circuit ;

IN: tic-tac-toe
SYMBOLS: X O ;

: at ( n n g -- x ) nth nth ;
: draw ( grid -- grid ) dup [ . ] each ;
 
: row ( e -- seq ) 3 swap <array> ;
: create-grid ( -- grid ) 3 [ f row ] replicate ;

: inside? ( x y grid -- ? ) drop [ 0 2 between? ] both? ;
: free? ( x y grid -- ? ) at f = ;
: check ( ? s -- ? ) over [ drop ] [ . ] if ;
: valid? ( x y g -- ? )
    { [ inside? "Outside" check ] [ free? "Occupied" check ] } 3&& ;

: read-tuple ( -- n n ) readln "," split [ string>number ] map first2 ;
: ask ( -- n n ) "Enter a position: " write read-tuple ;
: read-pos ( g -- n n g ) [ ask rot 3dup valid? ] [ 2nip ] until ;

: update-case ( a x y g -- ) nth set-nth ;
: play ( p g -- p g ) 2dup read-pos update-case ;

: diag ( grid -- seq ) [ swap nth ] map-index ;
: diags ( grid -- seq ) [ diag ] [ reverse diag ] bi 2array ;

: complete? ( seq -- ? ) X row O row 2array member? ;
: full? ( g -- ? ) concat f swap member? not ;
: 3-aligned? ( g -- ? ) dup flip dup diags append append [ complete? ] any? ;
: game-over? ( g -- ? ) { [ full? ] [ 3-aligned? ] } 1|| ;

: game ( -- )
    X O create-grid ! push the initial values on the stack
    [ dup game-over? ] [ draw swapd play ] until "Game over." print 3drop ;

New Annotation

Summary:
Author:
Mode:	PostgreSQLPowerCenter Parameter Fileactionscriptadaada95ans-forth94antantlrantlr4apacheconfapdlapplescriptaspaspect-jassembly-agcassembly-agsassembly-arm32assembly-m68kassembly-macro32assembly-mcs51assembly-parrotassembly-r2000assembly-x86avroawkbbatchbbjbcelbeanshellbibtexbinsource-agccc#c++cfscriptchillcilclipsclojurecmakecobolcoffeescriptcoldfusioncplex-lpcsscsvcvs-commitddartdjangodockerfiledotdoxygendrawj2ddsssleiffelembperlerlangfactorfhtmlforthfortranfortran90foxprofreemarkergcbasicgettextgherkingnuplotgogradlegroovygsphaskellhaxehexhl7v2hlslhtaccesshtmlhxmli4glicalendariconidlinforminiinno-setupinterlisiojamonjavajava module-infojavaccjavafxjavascriptjcljedit-actionsjflexjhtmljmkjsonjspkotlinlatexlexlilypondlispliterate-haskelllogslogtalklotosluam4macroschedulermailmakefilemaplemarkdownmavenmavscriptmetapostmlmodula3moinmqscmustache-templatemxmlmyghtymysqln3netrexxnqcnsis2objective-cobjectrexxoccamomnimarkopensipsoutlinepascalpatchperlphppikepl-sqlpl-sql9pl1plaintexplantumlpop11postscriptpovraypowerdynamopowershellprogressprologpropertiesprotobufpspptlpurepvwavepyrexpythonrakefilercprdrebolredcoderelax-ng-compactrenderman-ribrestrfcrhtmlroffrpm-specrtfrubyrustrviews#s+sassbtscalaschemesdl/prsgmlshellscriptshtmlsipsippslateslaxsmalltalksmartysmi-mibsql-loadersqrsquidconfstatasvn-commitswiftswigtcltemplate-toolkittextexinfotexttldtransact-sqltsptwikityposcripturluscriptvalavbscriptvelocityverilogvhdlvisualbasicvrml2wellknowntextxmlxqxslyabyamlzpt
Body:

Done