;;; Connect-the-dots game

to dotgame :size
; Connect-the-dots game.  Input is the number of dots on each side.
if :LogoPlatform = "Windows [maximize.window "true]
ht cs
setpc 7
setpensize [6 6]
localmake "offset (:size-1)*20
pu setpos list -:offset -:offset
board :size
localmake "lines ~
   se (crossmap [list (list ?1 ?2) (list ?1 1+?2)]
                (iseq 0 :size-1) (iseq 0 :size-2)) ~
      (crossmap [list (list ?1 ?2) (list 1+?1 ?2)]
                (iseq 0 :size-2) (iseq 0 :size-1))
localmake "computer 0
localmake "person 0
localmake "numboxes (:size-1)*(:size-1)
localmake "boxlists (array 5 0)
localmake "oldmove []
for [i 1 4] [setitem :i :boxlists []]
setitem 0 :boxlists ~
        (crossmap [list ?1 ?2] (iseq 0 :size-2) (iseq 0 :size-2))
localmake "boxes (array :size-1 0)
for [i 0 :size-2] [setitem :i :boxes (array :size-1 0)]

CATCH "WIN [FOREVER [PERSONMOVE COMMOVE]]	; play the game!

if not emptyp :oldmove [	; make the last move white
  setpc 7
  pu
  setpos map [40*? - :offset] first :oldmove
  pd
  setpos map [40*? - :offset] last :oldmove
]
if computer > :person ~
   [print (se [you lost] :computer "to :person)]
if :computer < :person ~
   [print (se [you won] :person "to :computer)]
if :computer = :person [print (se [tie game])]
setpensize [1 1]
end

; --------------- Initial board display -------------------------

to board :num
repeat :num [dots :num]
end

to dots :num
pd
repeat :num [fd 0 pu rt 90 fd 40 lt 90 pd]
pu lt 90 fd 40 * :num rt 90 fd 40
end

; -------------- Human player's move ---------------------

to personmove
; Read a mouse click, turn it into a move if legal.
localmake "move gmove
if not legal? :move [print [Not a legal move!  Try again.]
                     personmove stop]
drawline :move 6
localmake "direction reverse (map "difference (last :move) (first :move))
localmake "found "false
fillboxes 6 "person
if :found [personmove]
end

to gmove
while [not buttonp] []
while [buttonp] []
output findline (map [? + :offset] mousepos)
end

to findline :pos
; Find the nearest vertical or horizontal line to the mouse click.
localmake "xrem remainder (first :pos)+10 40
localmake "yrem remainder (last :pos)+10 40
localmake "xpos (first :pos)+10-:xrem
localmake "ypos (last :pos)+10-:yrem
if :xrem > :yrem ~
   [output list (list :xpos/40 :ypos/40) (list :xpos/40+1 :ypos/40)]
output list (list :xpos/40 :ypos/40) (list :xpos/40 :ypos/40+1)
end

to legal? :move
; Output true if this is an undrawn line segment connecting two dots.
output memberp :move :lines
end

; ----------------- Computer's move ----------------------

to commove
; The computer chooses a move, does the housekeeping for it.
; Strategy: complete boxes if possible, otherwise pick a move that doesn't
; let the opponent complete a box.
ifelse not emptyp (item 3 :boxlists) [
  localmake "move lastline first (item 3 :boxlists)
] [
  localmake "goodlines filter "lineokay? :lines
  ifelse not emptyp :goodlines [
    localmake "move pick :goodlines
  ] [
    localmake "cohorts []
    makecohorts :lines
    localmake "move lastline first smallest :cohorts
  ]
]
drawline :move 4
localmake "direction reverse (map "difference (last :move) (first :move))
localmake "found "false
fillboxes 4 "computer
if :found [commove]
end

to lineokay? :move
; Output true if this move won't let the opponent complete a box.
localmake "direction reverse (map "difference (last :move) (first :move))
output and (boxokay? first :move) ~
           (boxokay? (map "difference (first :move) :direction))
end

to boxokay? :box
; Output true if this box has fewer than 2 edges already drawn.
if or ((first :box) < 0) ((last :box) < 0) [output "true]
if or ((first :box) > (:size-2)) ((last :box) > (:size-2)) [output "true]
localmake "count item (last :box) item (first :box) :boxes
if emptyp :count [make "count 0]
output :count<2
end

to lastline :box
; Box has three lines drawn; find the missing one for us to draw.
if memberp (list :box (map "sum :box [0 1])) :lines [
  output (list :box (map "sum :box [0 1]))]
if memberp (list :box (map "sum :box [1 0])) :lines [
  output (list :box (map "sum :box [1 0]))]
if memberp (list (map "sum :box [0 1]) (map "sum :box [1 1])) :lines [
  output (list (map "sum :box [0 1]) (map "sum :box [1 1]))]
if memberp (list (map "sum :box [1 0]) (map "sum :box [1 1])) :lines [
  output (list (map "sum :box [1 0]) (map "sum :box [1 1]))]
output []	; box was full already (from makecohort)
end

to makecohorts :lines
; Partition the available boxes into chains, to look for the smallest.
; Note, the partition is not necessarily optimal -- this algorithm needs work.
; It's important that LINES be a local variable here, so that we can "draw"
; lines hypothetically that we're not really going to draw on the board.
while [not emptyp :lines] [
  localmake "cohort []
  makecohort first :lines
  push "cohorts :cohort
]
end

to makecohort :line
; Group all the boxes in a chain that starts with this line.
; Mark the line as drawn (locally to caller), then look in both directions
; for completable boxes.
make "lines remove :line :lines
localmake "direction reverse (map "difference (last :line) (first :line))
makecohort1 (map "difference (first :line) :direction)
makecohort1 first :line
end

to makecohort1 :box
; Examine one of the boxes adjoining the line just hypothetically drawn.
; It has 0, 1, or 2 undrawn sides.  (If 3 or 4, wouldn't have gotten here.)
; 0 sides -> count the box if not already, but no further lines in the chain.
; 1 side -> count the box, continue the chain with its last side.
; 2 sides -> the box isn't ready to complete, so it's not in this chain.
if or ((first :box) < 0) ((last :box) < 0) [stop]
if or ((first :box) > (:size-2)) ((last :box) > (:size-2)) [stop]
localmake "togo filter [memberp (list (map "sum :box first ?)
				      (map "sum :box last ?))
				:lines] ~
		       [[[0 0] [0 1]] [[0 0] [1 0]]
		        [[1 0] [1 1]] [[0 1] [1 1]]]
if (count :togo)=2 [stop]
if not memberp :box :cohort [push "cohort :box]
if emptyp :togo [stop]
localmake "line (list (map "sum :box first first :togo)
                      (map "sum :box last first :togo))
makecohort :line
end

to smallest :cohorts [:sofar []] [:minsize :numboxes+1]
if emptyp :cohorts [output :sofar]
if (count first :cohorts) < :minsize ~
   [output (smallest bf :cohorts first :cohorts count first :cohorts)]
output (smallest bf :cohorts :sofar :minsize)
end

; ----------- Common procedures for person and computer moves --------

to drawline :move :color
; Actually draw the selected move on the screen.
if not emptyp :oldmove [
  setpc 7
  pu
  setpos map [40*? - :offset] first :oldmove
  pd
  setpos map [40*? - :offset] last :oldmove
]
setpc :color
pu
setpos map [40*? - :offset] first :move
pd
setpos map [40*? - :offset] last :move
make "oldmove :move
end

to fillboxes :color :owner
; Implicit inputs (inherited from caller):
;   :move is the move someone just made.
;   :direction is [1 0] for vertical move, [0 1] for horizontal.
; Note that the line is drawn, check the two boxes (maybe) on either side,
; color them and count them for the appropriate player, see if game over.
make "lines remove :move :lines
if boxbefore? :move [fillbox (map "difference (first :move) :direction)]
if boxafter? :move [fillbox first :move]
testwin
end

to boxafter? :move
; Output true if the box above or to the right of the move is now complete.
output (increment first :move)=4
end

to boxbefore? :move
; Output true if the box below or to the left of the move is now complete.
localmake "p3 (map "difference (first :move) :direction)
output (increment :p3)=4
end

to increment :box
; If this isn't a box at all (might be if the move was on a border),
; just output [].  Otherwise, increment the number in the :boxes array,
; and move this box from one of the :boxlists to the next higher one.
; Output the new count of number of lines drawn in this box.
if or ((first :box) < 0) ((last :box) < 0) [output []]
if or ((first :box) > (:size-2)) ((last :box) > (:size-2)) [output []]
localmake "count item (last :box) item (first :box) :boxes
if emptyp :count [make "count 0]
setitem (last :box) item (first :box) :boxes :count+1
setitem :count :boxlists (remove :box item :count :boxlists)
setitem :count+1 :boxlists (fput :box item :count+1 :boxlists)
output :count+1
end

to fillbox :box
; Color in a completed box, increase the box count of its owner, and
; flag that a box was completed.
pu
setpos (map [40*? - :offset] :box)
filled :color [repeat 4 [fd 40 rt 90]]
make :owner (thing :owner)+1
make "found "true
end

; ------------------- Endgame processing --------------------

to testwin
if :computer+:person = :numboxes [throw "win]
end