hex 0 constant computer-token 0 constant computer-move create game-board 9 allot 0 constant #empty 0 constant row0 0 constant row1 0 constant row2 0 constant row3 0 constant row4 0 constant row5 0 constant row6 0 constant row7 : square@ (s square# -- value ) game-board + c@ ; : square! (s value square# -- ) game-board + c! #empty 1- is #empty ; 0 constant empty 1 constant x-token 2 constant o-token : .x (s val -- ) dup x-token = if ." X " then dup o-token = if ." O " then empty = if ." " then ; : .board cr ." " 108 ram@ .x ." |" 109 ram@ .x ." |" 10a ram@ .x ." 0 | 1 | 2" cr ." ----------- -----------" cr ." " 10b ram@ .x ." |" 110 ram@ .x ." |" 10d ram@ .x ." 3 | 4 | 5" cr ." ----------- -----------" cr ." " 10e ram@ .x ." |" 10f ram@ .x ." |" 10c ram@ .x ." 6 | 7 | 8" ; 0 constant computer-first-move ff constant u ( illegal ) : human-first-table {{ 8 8 8 8 8 8 8 8 0 }} ; : comp-first-table {{ u 8 6 8 2 8 2 8 4 }} ; : hf0 {{ u 2 1 6 3 7 3 5 u }} ; : hf1 {{ 2 u 0 6 3 4 5 3 u }} ; : hf2 {{ 1 0 u 7 5 4 7 3 u }} ; : hf3 {{ 6 6 7 u 1 7 0 4 u }} ; : hf4 {{ 7 3 5 1 u 2 7 6 u }} ; : hf5 {{ 7 0 4 1 2 u 1 2 u }} ; : hf6 {{ 3 5 5 0 7 1 u 4 u }} ; : hf7 {{ 5 5 3 4 6 6 4 u u }} ; : hf8 {{ u 7 6 5 2 3 2 1 u }} ; : human-first-table-n {{ hf0 hf1 hf2 hf3 hf4 hf5 hf6 hf7 hf8 }} ; : cf0 {{ u u u u u u u u u }} ; : cf1 {{ u u c c 6 c c c u }} ; : cf2 {{ u b u 4 b b u b b }} ; : cf3 {{ u c c u 1 c c c u }} ; : cf4 {{ u 6 u 9 u 9 9 9 9 }} ; : cf5 {{ u c c c 2 u c c u }} ; : cf6 {{ u 4 u 9 9 9 u 9 9 }} ; : cf7 {{ u c c c 6 c c u u }} ; : cf8 {{ u 7 6 5 u 3 2 1 u }} ; : comp-first-table-n {{ cf0 cf1 cf2 cf3 cf4 cf5 cf6 cf7 cf8 }} ; : row-n {{ row0 row1 row2 row3 row4 row5 row6 row7 }} ; : n1 (s row# -- element#1 ) {{ 0 3 6 0 1 2 0 2 }} ; : n2 (s row# -- element#1 ) {{ 1 8 7 3 8 5 8 8 }} ; : n3 (s row# -- element#1 ) {{ 2 5 4 6 7 4 4 6 }} ; : row? (s row# -- who.wins ) dup n1 square@ over n2 square@ rot n3 square@ 3dup xor xor 0= -rot or and nip ; : any-move-order {{ 1 7 3 5 0 2 6 4 8 }} ; : any-move u is computer-move 9 0 do i any-move-order square@ 0= if i any-move-order is computer-move leave then loop ; 0 value win : end-game-move (s -- move ) 0 row? dup is row0 1 row? dup is row1 or 2 row? dup is row2 or 3 row? dup is row3 or 4 row? dup is row4 or 5 row? dup is row5 or 6 row? dup is row6 or 7 row? dup is row7 or ?dup if computer-token and if 1 is win computer-token else true then 8 0 do dup i row-n and if i n1 square@ 0= if i n1 is computer-move then i n2 square@ 0= if i n2 is computer-move then i n3 square@ 0= if i n3 is computer-move then leave then loop drop else 0 square@ empty = 1 square@ computer-token = 3 square@ computer-token = or and if 0 is computer-move else 2 square@ empty = 1 square@ computer-token = 5 square@ computer-token = or and if 2 is computer-move else 6 square@ empty = 3 square@ computer-token = 7 square@ computer-token = or and if 6 is computer-move else 8 square@ empty = 5 square@ computer-token = 7 square@ computer-token = or and if 8 is computer-move else any-move then then then then then computer-move ; : move? (s move -- move ) dup square@ empty <> if drop u else computer-token o-token = if x-token else o-token then over square! then ; : clear-gb game-board 9 erase 9 is #empty ; : unsquare! (s sq1 sq2 -- ) 0 swap game-board + c! 0 swap game-board + c! #empty 2 + is #empty ; 0 value l \ human moves first : gen-tab clear-gb o-token is computer-token 9 0 do i move? human-first-table dup computer-token swap square! 8 0 do i move? u <> if i j human-first-table-n dup computer-token swap square! dup 2 c << j 8 << + i 4 << + ram! 8 0 do i move? u <> if end-game-move dup computer-token swap square! dup win if 8 + 3 c << k 8 << + j 4 << + i + ram! 0 is win else 3 c << k 8 << + j 4 << + i + ram! 0 is l begin l 8 < while l move? u <> if end-game-move dup computer-token swap square! dup win if 8 + k 4 + c << j 8 << + i 4 << + l + ram! 0 is win else k 4 + c << j 8 << + i 4 << + l + ram! then l unsquare! then l 1+ is l repeat then i unsquare! then loop i unsquare! then loop i unsquare! loop x-token is computer-token computer-token computer-first-move square! 9 1 do i move? comp-first-table dup computer-token swap square! dup 1- 4 << 1 c << i 8 << + dup ram@ rot + swap ram! 9 1 do i move? u <> if i j comp-first-table-n dup dup 1- 4 << 2 c << j 8 << + i 4 << + dup ram@ rot + swap ram! 8 < if dup computer-token swap square! 9 1 do i move? u <> if end-game-move dup computer-token swap square! dup 1- 4 << win if 8 4 << + 3 c << k 8 << + j 4 << + i + dup ram@ rot + swap ram! 0 is win else 3 c << k 8 << + j 4 << + i + dup ram@ rot + swap ram! 1 is l begin l 9 < while l move? u <> if end-game-move dup computer-token swap square! dup 1- 4 << win if 8 4 << + k 4 + c << j 8 << + i 4 << + l + dup ram@ rot + swap ram! 0 is win else k 4 + c << j 8 << + i 4 << + l + dup ram@ rot + swap ram! then l unsquare! then l 1+ is l repeat then i unsquare! then loop else 8 - dup computer-token swap square! then i unsquare! then loop i unsquare! loop ; gen-tab : clear-game-board \ white = black = 0 the game board 0 100 ram! 0 101 ram! 0 102 ram! 0 103 ram! 0 104 ram! 0 105 ram! 0 106 ram! 0 107 ram! 0 108 ram! 0 109 ram! 0 10a ram! 0 10b ram! 0 10c ram! 0 10d ram! 0 10e ram! 0 10f ram! 0 110 ram! 0 111 ram! 0 112 ram! ; : play1 clear-game-board .board cr cr ." Do you wish to go first? (y/n)" key ascii y = cr if cr ." You go first " cr cr ." Enter your move " cr key ascii 0 - dup 8 = if 4 nip else dup 4 = if 8 nip then then cr 100 ram! 1 106 ram! 2 107 ram! else cr ." Sexium goes first " cr 2 106 ram! 1 107 ram! then begin 111 ram@ 0 = while Reset-Sexium logic+processing logic+processing stepping on begin stepping @ while logic+processing repeat .board 111 ram@ 0 = if 112 ram@ 1 = if cr ." According to the Sexium, your move is not valid " cr 0 112 ram! then cr ." Enter your move " cr key ascii 0 - dup 8 = if 4 nip else dup 4 = if 8 nip then then cr 100 ram! then repeat 111 ram@ dup 1 = if cr ." Draw " cr drop else 2 = if cr ." Computer wins " cr then then cr cr ." Thanks for the game!" ; : play cr ." Welcome to TIC TAC TOE! " begin play1 ." Play again? (y/n)" key ascii y <> cr until ; play