path: root/js/games/nluqo.github.io/~bh/v1ch6/ttt.lg

;; Overall orchestration

to ttt
local [me you position]
draw.board
init
if equalp :me "x [meplay 5]
forever [
  if already.wonp :me [print [I win!] stop]
  if tiedp [print [Tie game!] stop]
  youplay getmove                         ;; ask person for move
  if already.wonp :you [print [You win!] stop]
  if tiedp [print [Tie game!] stop]
  meplay pickmove make.triples            ;; compute program's move
]
end

to make.triples
output map "substitute.triple [123 456 789 147 258 369 159 357]
end

to substitute.triple :combination
output map [item ? :position] :combination
end

to already.wonp :player
output memberp (word :player :player :player) (make.triples)
end

to tiedp
output not reduce "or map.se "numberp arraytolist :position
end

to youplay :square
draw :you :square
setitem :square :position :you
end

to meplay :square
draw :me :square
setitem :square :position :me
end

;; Initialization

to draw.board
splitscreen clearscreen hideturtle
drawline [-20 -50] 0 120
drawline [20 -50] 0 120
drawline [-60 -10] 90 120
drawline [-60 30] 90 120
end

to drawline :pos :head :len
penup
setpos :pos
setheading :head
pendown
forward :len
end

to init
make "position {1 2 3 4 5 6 7 8 9}
print [Do you want to play first (X)]
type [or second (O)? Type X or O:]
choose
print [For each move, type a digit 1-9.]
end

to choose
local "side
forever [
  make "side readchar
  pr :side
  if equalp :side "x [choosex stop]
  if equalp :side "o [chooseo stop]
  type [Huh? Type X or O:]
]
end

to chooseo
make "me "x
make "you "o
end

to choosex
make "me "o
make "you "x
end

;; Get opponent's moves

to getmove
local "square
forever [
  type [Your move:]
  make "square readchar
  print :square
  if numberp :square ~
     [if and (:square > 0) (:square < 10)
         [if freep :square [output :square]]]
  print [not a valid move.]
]
end

to freep :square
output numberp item :square :position
end

;; Compute program's moves

to pickmove :triples
local "try
make "try find.win :me
if not emptyp :try [output :try]
make "try find.win :you
if not emptyp :try [output :try]
make "try find.fork
if not emptyp :try [output :try]
make "try find.advance
if not emptyp :try [output :try]
output find [memberp ? :position] [5 1 3 7 9 2 4 6 8]
end

to find.win :who
output filter "numberp find "win.nowp :triples
end

to win.nowp :triple
output equalp (filter [not numberp ?] :triple) (word :who :who)
end

to find.fork
local "singles
make "singles singles :me
if emptyp :singles [output []]
output repeated.number reduce "word :singles
end

to singles :who
output filter [singlep ? :who] :triples
end

to singlep :triple :who
output equalp (filter [not numberp ?] :triple) :who
end

to repeated.number :squares
output find [memberp ? ?rest] filter "numberp :squares
end

to find.advance
output best.move filter "numberp find [singlep ? :me] :triples
end

to best.move :my.single
local "your.singles
if emptyp :my.single [output []]
make "your.singles singles :you
if emptyp :your.singles [output first :my.single]
ifelse (count filter [? = first :my.single]
                     reduce "word :your.singles) > 1 ~
       [output first :my.single] ~
       [output last :my.single]
end

;; Drawing moves on screen

to draw :who :square
move :square
ifelse :who = "x [drawx] [drawo]
end

to move :square
penup
setpos thing word "box :square
end

to drawo
pendown
arc 360 18
end

to drawx
setheading 45
pendown
repeat 4 [forward 25.5 back 25.5 right 90]
end

make "box1 [-40 50]
make "box2 [0 50]
make "box3 [40 50]
make "box4 [-40 10]
make "box5 [0 10]
make "box6 [40 10]
make "box7 [-40 -30]
make "box8 [0 -30]
make "box9 [40 -30]