From 562a9a52d599d9a05f871404050968a5fd282640 Mon Sep 17 00:00:00 2001
From: elioat <elioat@tilde.institute>
Date: Wed, 23 Aug 2023 07:52:19 -0400
Subject: *

---
 js/games/nluqo.github.io/~bh/v1ch6/ttt.lg | 198 ++++++++++++++++++++++++++++++
 1 file changed, 198 insertions(+)
 create mode 100644 js/games/nluqo.github.io/~bh/v1ch6/ttt.lg

(limited to 'js/games/nluqo.github.io/~bh/v1ch6/ttt.lg')

diff --git a/js/games/nluqo.github.io/~bh/v1ch6/ttt.lg b/js/games/nluqo.github.io/~bh/v1ch6/ttt.lg
new file mode 100644
index 0000000..aa1c7a0
--- /dev/null
+++ b/js/games/nluqo.github.io/~bh/v1ch6/ttt.lg
@@ -0,0 +1,198 @@
+;; 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]
-- 
cgit 1.4.1-2-gfad0