From: Mart Lubbers <mart@martlubbers.net>
Date: Thu, 10 Mar 2016 17:14:15 +0000 (+0100)
Subject: started with some necoding
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=528cda8a5116dbed02a1e603d7fca2033dd0c100;p=mc1516pa.git

started with some necoding
---

diff --git a/code/Makefile b/code/Makefile
index 5e9ea1b..6f9676d 100644
--- a/code/Makefile
+++ b/code/Makefile
@@ -1,5 +1,5 @@
-CLM:=clm
-CLMFLAGS:=
+CLM:=~/projects/clean/bin/clm
+CLMFLAGS:=-nr -nt
 
 all: SokobanObjectwise
 
diff --git a/code/Sokoban.dcl b/code/Sokoban.dcl
index c23bf22..f503287 100644
--- a/code/Sokoban.dcl
+++ b/code/Sokoban.dcl
@@ -9,3 +9,6 @@ instance toString SokobanTile
 instance toString SokobanPuzzle
 
 parse :: String *World -> (SokobanPuzzle, *World)
+parseFromFile :: *File -> (SokobanPuzzle, *File)
+
+numberOfBlocks :: SokobanPuzzle -> Int
diff --git a/code/Sokoban.icl b/code/Sokoban.icl
index 2788930..804a7cd 100644
--- a/code/Sokoban.icl
+++ b/code/Sokoban.icl
@@ -25,15 +25,24 @@ instance toString SokobanTile where
 	toString TargetBox = "*"
 	toString TargetAgent = "+"
 
+parseFromFile :: *File -> (SokobanPuzzle, *File)
+parseFromFile f
+# (contents, f) = readEntireFile f
+| isEmpty contents = abort "File is empty or unreadable"
+= (Sokoban (parseRows contents), f)
+
 parse :: String *World -> (SokobanPuzzle, *World)
 parse fp w
 # (ok, f, w) = fopen fp FReadText w
 | not ok = abort ("Couldn't open file: '" +++ fp +++ "'")
-# (contents, f) = readEntireFile f
-| isEmpty contents = abort "File is empty or unreadable"
+# (puzzle, f) = parseFromFile f
 # (ok, w) = fclose f w
 | not ok = abort "Couldn't close file"
-= (Sokoban (parseRows contents), w)
+= (puzzle, w)
+
+numberOfBlocks :: SokobanPuzzle -> Int
+numberOfBlocks (Sokoban bs) = let fbs = flatten bs in
+	length ([1\\(Box)<-fbs] ++ [1\\(TargetBox)<-fbs])
 
 parseRows :: [Char] -> [[SokobanTile]]
 parseRows cs = case parseRow cs of
diff --git a/code/SokobanObjectwise.icl b/code/SokobanObjectwise.icl
index f234ae1..558cc4f 100644
--- a/code/SokobanObjectwise.icl
+++ b/code/SokobanObjectwise.icl
@@ -1,5 +1,51 @@
 module SokobanObjectwise
 
+import StdString
+import StdFile
+import StdTuple
+import StdFunc
+import StdOrdList
+import StdList
 import Sokoban
 
-Start = "hi"
+Start :: *World -> *World
+Start w
+# (io, w) = stdio w
+# (puzzle, io) = parseFromFile io
+# io = io <<< encode puzzle <<< "\n"
+= snd (fclose io w)
+
+encode :: SokobanPuzzle -> String
+encode p = foldr ((+++) o (+++) "\n") "" ([
+	"MODULE", 
+	"main",
+	"VAR":encodeBoxes p maxX maxY])
+	where
+		annot = annotate p
+		(maxX, maxY) = getMetrics annot
+
+:: AnnotatedSokoban :== [(Int, Int, SokobanTile)]
+
+annotate :: SokobanPuzzle -> AnnotatedSokoban
+annotate (Sokoban p) = flatten [[(x, y, t)\\t<-r & x<-[0..]]\\r<-p & y<-[0..]]
+
+getMetrics :: AnnotatedSokoban -> (Int, Int)
+getMetrics p = (maxList (map fst3 p),maxList (map snd3 p))
+
+getBoxes :: AnnotatedSokoban -> [(Int, Int)]
+getBoxes p = [t\\t=:(_, _, Box)<-p] ++ 
+
+	where
+		getBox` _ [] = []
+		getBox` x [b:bs] = let r = getBox` (x+1) bs in case b of
+				Box = [x:r]
+				TargetBox = [x:r]
+				_ = r
+
+(<+) infixr 5 :: a b -> String | toString a & toString b
+(<+) a b = toString a +++ toString b
+
+encodeBoxes :: SokobanPuzzle Int Int -> [String]
+encodeBoxes p mx my = [
+	"\tbox" <+ i <+ "x: " <+ "0 .. " <+ mx <+ ";\n\tbox" <+
+	i <+ "y: " <+ "0 .. " <+ my <+ ";"\\(bx, by)<-getBoxes p & i<-[0..]]