WIP

Author: Minoru

src/Trace.hs

@@ -23,7 +23,9 @@ data LongLinDiff = LongLinDiff Axis Int8
   deriving (Eq, Show)
 
 data NearDiff = NearDiff Int8 Int8 Int8
+  deriving (Eq, Show)
 
+data FarDiff = FarDiff Int8 Int8 Int8
   deriving (Eq, Show)
 
 data Command =
@@ -36,6 +38,8 @@ data Command =
   | Fill NearDiff
   | FusionP NearDiff
   | FusionS NearDiff
+  | GFill NearDiff FarDiff
+  | GVoid NearDiff FarDiff
   deriving (Eq, Show)
 
 instance Coded Axis where
@@ -85,6 +89,21 @@ instance Coded NearDiff where
         x = xy `div` 3
     return $ NearDiff (x-1) (y-1) (z-1)
 
+instance Coded FarDiff where
+  encode (FarDiff dx dy dz) = do
+    putBits 7 0 ((dx + 30) :: Word8)
+    putBits 7 0 ((dy + 30) :: Word8)
+    putBits 7 0 ((dz + 30) :: Word8)
+
+  decode = do
+    dx <- getWord8
+    dy <- getWord8
+    dz <- getWord8
+    FarDiff
+      <$> ((fromIntegral dx)-30)
+      <*> ((fromIntegral dy)-30)
+      <*> ((fromIntegral dz)-30)
+
 instance Coded Command where
   encode Halt = putBits 7 0 (0b11111111 :: Word8)
   encode Wait = putBits 7 0 (0b11111110 :: Word8)
@@ -121,6 +140,10 @@ instance Coded Command where
     encode nd
     putBits 2 0 (0b011 :: Int)
 
+  encode (GFill nd fd) = undefined
+
+  encode (GVoid nd fd) = undefined
+
   decode = parseOpcode =<< getWord8
     where
       parseOpcode :: MonadGet m => Word8 -> Coding m Command

test/TestSpec.hs

@@ -53,6 +53,12 @@ specExamples = testGroup "Specification examples"
 
   , testCase "encode.Fill" $
       testEncode (Fill (NearDiff 0 (-1) 0)) @?= "01010011"
+
+  , testCsae "encode.GFill" $
+      testEncode (GFill (NearDiff 0 (-1) 0) (FarDiff 10 (-15) 20)) @?= "01010001 00101000 00001111 00110010"
+
+  , testCase "encode.GVoid" $
+      testEncode (GVoid (NearDiff 1 0 0) (FarDiff 5 5 (-5))) @?= "10110000 00100011 00100011 00011001"
   ]
 
 testCodecFor :: (Eq a, Show a, Coded a) => a -> Assertion
@@ -83,4 +89,10 @@ codec = testGroup "Encoding-then-decoding returns the same value"
   , testCase "Fission" $ testCodecFor (Fission (NearDiff 0 0 1) 5)
 
   , testCase "Fill" $ testCodecFor (Fill (NearDiff 0 (-1) 0))
+
+  , testCsae "GFill" $
+      testCodecFor (GFill (NearDiff 0 (-1) 0) (FarDiff 10 (-15) 20))
+
+  , testCase "GVoid" $
+      testCodecFor (GVoid (NearDiff 1 0 0) (FarDiff 5 5 (-5)))
   ]