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 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 ;