From 6711bcdf1c1e1d8f5f64d84a10ddb4e1148c85f2 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 22 Jun 2017 18:07:26 +0200
Subject: [PATCH] Initial commit

---
 .gitignore |  2 ++
 Makefile   | 37 +++++++++++++++++++++++++
 peg.icl    | 81 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 120 insertions(+)
 create mode 100644 .gitignore
 create mode 100644 Makefile
 create mode 100644 peg.icl

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..be5442f
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+Clean System Files
+peg
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..9966f02
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,37 @@
+CLEAN_HOME?=/opt/clean
+CLM:=clm
+
+override CLMFLAGS+=-dynamics -h 200M -nt
+GCCVERSIONGTEQ6:=$(shell expr `gcc -dumpversion | cut -f1 -d.` \>= 6)
+ifeq "$(GCCVERSIONGTEQ6)" "1"
+	override CLMFLAGS+=-l -no-pie
+endif
+
+ITASKS:=~/projects/iTasks-SDK/Libraries
+
+#	-I ~/projects/iTasks-SDK/Libraries
+CLMLIBS:=\
+	-I $(CLEAN_HOME)/lib/Platform\
+	-I $(CLEAN_HOME)/lib/Platform/Deprecated/StdLib\
+	-I $(ITASKS)\
+	-I $(CLEAN_HOME)/lib/GraphCopy\
+	-I $(CLEAN_HOME)/lib/Sapl\
+	-I $(CLEAN_HOME)/lib/StdEnv\
+	-I $(CLEAN_HOME)/lib/Generics\
+	-I $(CLEAN_HOME)/lib/Dynamics\
+	-I $(CLEAN_HOME)/lib/TCPIP\
+	-I ./CleanSerial
+
+BINARIES:=peg
+
+all: $(BINARIES)
+
+%: %.icl $(wildcard */*.[id]cl *.[id]cl)
+	$(CLM) $(CLMLIBS) $(CLMFLAGS) $(basename $<) -o $@
+
+clean-%:
+	$(RM) -r $(addprefix $(@:clean-%=%),-data -www) $(@:clean-%=%)
+
+clean: $(addprefix clean-,$(BINARIES))
+	find . -type d -name 'Clean System Files' -print0 | xargs -r0 $(RM) -r
+	make -C CleanSerial clean
diff --git a/peg.icl b/peg.icl
new file mode 100644
index 0000000..bbe537d
--- /dev/null
+++ b/peg.icl
@@ -0,0 +1,81 @@
+module peg
+
+import StdEnv
+
+from Text import class Text, instance Text String
+import qualified Text
+from Data.Func import $
+import Data.Tuple
+import Control.Monad
+import Control.Monad.State
+import Control.Applicative
+import Data.Maybe
+import Data.Functor
+
+:: Coord :== (Int, Int)
+:: Position = Inv | Emp | Peg
+:: PegBoard :== {#{Position}}
+:: Move :== (Coord, Direction)
+:: Direction = N | E | S | W
+
+european :: PegBoard
+european = 
+	{{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
+	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
+	,{Peg, Peg, Peg, Peg, Peg, Peg, Peg}
+	,{Peg, Peg, Peg, Emp, Peg, Peg, Peg}
+	,{Peg, Peg, Peg, Peg, Peg, Peg, Peg}
+	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
+	,{Inv, Inv, Peg, Peg, Peg, Inv, Inv}
+	}
+
+instance toChar Position where
+	toChar p = case p of Inv = ' '; Emp = '.'; Peg = 'o'
+
+instance == Position where
+	(==) Inv Inv = True
+	(==) Emp Emp = True
+	(==) Peg Peg = True
+	(==) _ _ = False
+
+transform :: Coord Direction -> Coord
+transform (x, y) d = case d of
+	N = (x, y-1)
+	S = (x, y+1)	
+	W = (x-1, y)
+	E = (x+1, y)
+
+getPos :: Coord -> StateT PegBoard Maybe Position
+getPos c=:(x, y) = getState >>= \b->if (valid b c)
+		fail (pure b.[y].[x])
+
+valid :: PegBoard Coord -> Bool
+valid b (x, y) = y<0 || x<0 || y >= size b || x >= size b.[0] || b.[y].[x] == Inv
+
+fail :: StateT PegBoard Maybe a
+fail = StateT \s->Nothing
+
+applyMove :: Move PegBoard -> Maybe PegBoard
+applyMove (c=:(fx, fy), d) b = Nothing
+//# sc=:(sx, sy) = transform c d
+//# tc=:(tx, ty) = transform sc d
+//= liftM3 tuple3 (getPos c b) (getPos sc b) (getPos tc b)
+//	>>= \f->case f of
+//		(Peg, Peg, Emp) = Nothing//Just {b & [fx,fy]=Emp, [sx,sy]=Emp, [tx,ty]=Peg}
+//		_ = Nothing
+
+getCoords :: (Position -> Bool) PegBoard -> [Coord]
+getCoords f b = [(x, y)\\r<-:b & y<-[0..] , c<-:r & x<-[0..] | f c]
+
+win :: (PegBoard -> Bool)
+win = isEmpty o getCoords ((<>)Peg)
+
+printPegBoard :: PegBoard -> String
+printPegBoard b = 'Text'.join "\n" [{#toChar x\\x<-:r}\\r <-: b]
+
+Start =
+	( getCoords ((==)Emp) european
+	, win european
+	, printPegBoard <$> applyMove ((3,2), S) european
+	)
+//Start = printPegBoard european
-- 
2.20.1