module Flexidisc.Record.Transformation

import Flexidisc.Record
import Flexidisc.RecordContent
import Flexidisc.OrdList.Disjoint
import Flexidisc.OrdList.Nub
import public Flexidisc.Transformation.Type
import public Flexidisc.Transformation.TransHeader

import public Control.Monad.Identity

%default total
%access export

||| A list of transformation of tagged values.
||| Its purpose is to apply several transformation on different fields
||| simultaneously.
data TransformationM : (m : Type -> Type) -> (k : Type) ->
                       (header : TransHeader k) -> Type where
  Trans : (o : Ord k) =>
          (values : MapValuesM m k o header) ->
          (nubProof : Nub header) ->
          TransformationM m k (T header)

public export
Transformation : (k : Type) -> (header : TransHeader k) -> Type
Transformation = TransformationM id

||| Monomorphic `id` to help inference
transM : (m : Type -> Type) -> TransformationM m k header -> TransformationM m k header
transM _ = id

||| Monomorphic `id` to help inference
trans : TransformationM Identity k header -> TransformationM Identity k header
trans = id

||| The empty record
Nil : Ord k => TransformationM m k []
Nil = Trans [] []

||| Insert a new transformation function in a `Transformation`
(::) : (DecEq k, Ord k) => TaggedValue k' (s -> m t) -> TransformationM m k header ->
       {default SoTrue fresh : IsFresh k' header} ->
       TransformationM m k ((k', s :-> t) :: header)
(::) x (Trans xs isnub) {fresh} =
  Trans (insert x xs) (freshInsert (getProof fresh) isnub)

transPreservesFresh : Ord k => (xs : OrdList k o MapValue) -> (y : Fresh l (toSource xs)) -> Fresh l (toTarget xs)
transPreservesFresh [] y = y
transPreservesFresh ((k, s :-> t) :: xs) (f :: fresh) = f :: transPreservesFresh xs fresh

transPreservesNub : (header : OrdList k o MapValue) -> Nub (toSource header) -> Nub (toTarget header)
transPreservesNub [] xs = xs
transPreservesNub ((l, s :-> t) :: xs) (y::ys) = transPreservesFresh xs y :: transPreservesNub xs ys

||| Map all the field of a record
mapRecord : (trans : TransformationM m k mapper) ->
            (xs : Record k (toSource mapper)) ->
            RecordM m k (toTarget mapper)
mapRecord (Trans trans nubT) (Rec xs nubXS) {mapper = T mapper} =
  Rec (mapRecord trans xs) (transPreservesNub mapper nubXS)

||| Map all the field of a record, extract the effect
traverseRecord : Applicative m =>
                 (trans : TransformationM m k mapper) ->
                 (xs : Record k (toSource mapper)) ->
                 m (Record k (toTarget mapper))
traverseRecord (Trans trans nubT) (Rec xs nubXS) {mapper = T mapper} =
  map (flip Rec (transPreservesNub mapper nubXS)) (traverseRecord trans xs)

||| Map all the field of a record
traverseRecord' : (trans : Transformation k mapper) ->
                  (xs : Record k (toSource mapper)) ->
                  Record k (toTarget mapper)
traverseRecord' = mapRecord

||| Create a record of Maybe type, with the values of the initial record,
||| if defined, or with `Nothing` if the field is not defined.
optional : DecEq k =>
           (xs : Record k header) ->
           {auto prf : HereOrNot post header} ->
           {default SoTrue postNub : IsNub post} ->
           RecordM Maybe k post
optional (Rec xs nubXS) {prf = HN prf} {postNub} =
  Rec (optional xs prf) (getProof postNub)

||| Change the effect
hoist : (f: {a : _} -> m a -> n a) -> (xs : RecordM m k header) -> RecordM n k header
hoist f (Rec xs nubXS) = Rec (hoist f xs) nubXS

||| Perform a `Record` transformation under the `Identity` Monad
withIdentity : (RecordM Identity k pre -> RecordM Identity k post) ->
               Record k pre -> Record k post
withIdentity f = hoist runIdentity . f . hoist Id

||| lift fields of a Record
lift : (f: {a : _} -> a -> m a) -> (xs : Record k header) -> RecordM m k header
lift = hoist

||| extract an effect from a record
sequence : Applicative m => (xs : RecordM m k header) -> m (Record k header)
sequence (Rec xs nubXS) = flip Rec nubXS <$> sequence xs

||| embed the effect in the values, directly into the `Record`
unlift : RecordM m k header -> Record k (map m header)
unlift (Rec values nubProof) = Rec (unlift values) (mapValuesPreservesNub nubProof)

||| Map a subset of a record
patchRecord : (DecEq k, Applicative m) =>
              (trans : TransformationM m k mapper) ->
              (xs : Record k header) ->
              {auto prf : Sub (toSource mapper) header} ->
              m (Record k (patch (toTarget mapper) header))
patchRecord (Trans trans nubT) (Rec xs nubXS) {prf = S prf} {mapper = T mapper} = let
  nubProof = disjointNub diffIsDisjoint
                         (isNubFromSub diffIsSub nubXS)
                         (transPreservesNub mapper (isNubFromSub prf nubXS))
  in map (flip Rec nubProof) (patchRecord trans xs prf)

||| Map a subset of a record
patchRecord' : DecEq k =>
               (trans : Transformation k mapper) ->
               (xs : Record k header) ->
               {auto prf : Sub (toSource mapper) header} ->
               Record k (patch (toTarget mapper) header)
patchRecord' (Trans trans nubT) (Rec xs nubXS) {prf = S prf} {mapper = T mapper} = let
  nubProof = disjointNub diffIsDisjoint
                         (isNubFromSub diffIsSub nubXS)
                         (transPreservesNub mapper (isNubFromSub prf nubXS))
  in (flip Rec nubProof) (patchRecord' trans xs prf)

-- Foldmap

public export
data RecordFunc : (required : Header k) ->
                  (optional : Header k) ->
                  (result : Type) -> Type where
  Func : (Record k required -> RecordM Maybe k opt -> a) ->
         RecordFunc required opt a

||| Apply a function on a known set of data
foldRecord : (Ord k, DecEq k) =>
             RecordFunc required opt a ->
             Record k header ->
             {auto optNub : IsNub opt} ->
             {auto decomp : Decomp required opt header} ->
             a
foldRecord (Func f) xs {decomp = D sub op} {optNub} =
  f (project xs) (optional xs {postNub = optNub})

||| Apply a modifier Record to a record
(<**>) : RecordM (endoM m n) k header -> RecordM m k header -> RecordM n k header
(<**>) (Rec fs _) (Rec xs nubXS) = Rec (fs <**> xs) nubXS

-- Operators

keepIf : (Alternative m, Applicative m) => (a -> Bool) -> a -> m a
keepIf f x = map (const x) (guard (f x))

is : (Eq a, Alternative m, Applicative m) => a -> a -> m a
is expected = keepIf (== expected)

isnot : (Eq a, Alternative m, Applicative m) => a -> a -> m a
isnot expected = keepIf (/= expected)


module Text.CSS.Rule

import Data.String
import Text.CSS.Declaration
import Text.CSS.Render
import Text.CSS.Selector

%default total

public export
data Rule : (n : Nat) -> Type where
  MkRule :  (selector : Selector selDepth hasPseudoClass hasPseudoElem)
         -> (decls    : List Declaration)
         -> Rule n

  Media :   (query : String)
         -> (rules : List $ Rule 0)
         -> Rule 1

infix 2 !!

export %inline
(!!) : Selector n b1 b1 -> List Declaration -> Rule k
(!!) = MkRule

export
Render (Rule n) where
  render (MkRule s ds) = "\{render s}{\{fastConcat $ map render ds}}"
  render (Media q rs)  = "@media (\{q}){\{fastUnlines $ map render rs}}"


module Bautzen.GameUnit

import Data.Fin
import Data.Maybe
import Data.Nat
import Data.Vect

%default total

-- Base Types
-- Section 1.1
public export
data Nation : Type where
  German : Nation
  Russian : Nation
  Polish : Nation

public export
Eq Nation where
  (==) German German = True
  (==) Russian Russian = True
  (==) Polish Polish = True
  (==) _ _ = False

public export
Show Nation where
  show German = "German"
  show Russian = "Russian"
  show Polish = "Polish"

public export
data Side : Type where
  Axis : Side
  Allies : Side

public export
Show Side where
  show Axis = "Axis"
  show Allies = "Allies"

public export
Eq Side where
  Axis == Axis = True
  Allies == Allies = True
  _ == _ = False

public export
flipSide : Side -> Side
flipSide Axis = Allies
flipSide Allies = Axis

public export
side : Nation -> Side
side German = Axis
side Polish = Allies
side Russian = Allies

public export
friendly : Nation -> Nation -> Bool
friendly n n' = side n == side n'

public export
data UnitType : Type where
  Armored : UnitType
  HeavyArmored : UnitType
  MechInfantry : UnitType
  Infantry : UnitType
  HeavyEngineer : UnitType
  Artillery : UnitType
  AntiTank : UnitType
  HQ : UnitType
  SupplyColumn : UnitType

public export
Eq UnitType where
  Armored == Armored = True
  HeavyArmored == HeavyArmored = True
  MechInfantry == MechInfantry = True
  Infantry == Infantry = True
  HeavyEngineer == HeavyEngineer = True
  Artillery == Artillery = True
  AntiTank == AntiTank = True
  HQ == HQ = True
  SupplyColumn == SupplyColumn = True
  _ == _ = False

public export
Show UnitType where
  show Armored = "Armored"
  show HeavyArmored = "HeavyArmored"
  show MechInfantry = "MechInfantry"
  show Infantry = "Infantry"
  show HeavyEngineer = "HeavyEngineer"
  show Artillery = "Artillery"
  show AntiTank = "AntiTank"
  show HQ = "HQ"
  show SupplyColumn = "SupplyColumn"

public export
data UnitSize : Type where
  Regiment : UnitSize
  Brigade : UnitSize
  Division : UnitSize
  Corps : UnitSize
  Army : UnitSize

public export
Show UnitSize where
  show Regiment = "Regiment"
  show Brigade = "Brigade"
  show Division = "Division"
  show Corps = "Corps"
  show Army = "Army"

public export
record StdFactors where
  constructor MkStdFactors
  attack : Nat
  defense : Nat

public export
Show StdFactors where
  show (MkStdFactors atk def) = "Standard attack=" ++ show atk++", defense=" ++ show def

public export
record Arty where
  constructor MkArty
  support : Nat
  distance : Nat

public export
Show Arty where
  show (MkArty sup dist) = "Arty support=" ++ show sup ++ ", distance=" ++ show dist

public export
record Pak where
  constructor MkPak
  antitank : Nat

public export
Show Pak where
  show (MkPak at) = "Antitank factor=" ++ show at

public export
Factors : UnitType -> Type
Factors Armored       = StdFactors
Factors HeavyArmored  = StdFactors
Factors MechInfantry  = StdFactors
Factors Infantry      = StdFactors
Factors HeavyEngineer = StdFactors
Factors Artillery     = Arty
Factors AntiTank      = Pak
Factors HQ            = Arty
Factors SupplyColumn  = Unit

public export
record GameUnit where
  constructor MkGameUnit
  nation : Nation
  unitType : UnitType
  name : String
  parent : Maybe String
  size : UnitSize
  move : Nat
  currentMP : Nat
  steps : Nat
  hits : Fin steps
  combat : Vect steps (Factors unitType)

public export
Show GameUnit where
  show (MkGameUnit nation unitType name parent size move currentMP steps hits combat) =
    "MkGameUnit nation=" ++ show nation ++
    ", unitType=" ++ show unitType ++
    ", name=" ++ name ++
    ", parent=" ++ fromMaybe "" parent ++
    ", size=" ++ show size ++
    ", move=" ++ show move ++
    ", currentMP=" ++ show currentMP ++
    ", steps=" ++ show steps ++
    ", hit=" ++ show (finToNat hits) ++
    ", combat=" ++ case unitType of
                     Armored => show combat
                     HeavyArmored => show combat
                     MechInfantry => show combat
                     Infantry => show combat
                     HeavyEngineer => show combat
                     Artillery => show combat
                     AntiTank => show combat
                     HQ => show combat
                     SupplyColumn => show combat

public export
Eq GameUnit where
  unit == unit' = name unit == name unit' && parent unit == parent unit'

public export
fullName : GameUnit -> String
fullName u = name u ++ maybe "" (\ n => "/" ++ n) (parent u)

public export
isHQ : GameUnit -> Bool
isHQ unit = unitType unit == HQ

||| Check if given `unit` is a HQ for the given formation name
||| To provide valid command for a unit, another unit:
|||
||| * be a `HQ` type of unit
||| * be part of the same formation than the given unit
||| * _or_ be an army/group HQ
|||
||| @hq the HQ we test command for
||| @unit the possibly commanded unit
public export
isHQFor : (hq : GameUnit) -> (unit : GameUnit) -> Bool
isHQFor (MkGameUnit nationality HQ _ Nothing Army _ _ _ _ _ ) unit = nation unit == nationality
isHQFor (MkGameUnit _ HQ _ formation _ _ _ _ _ _ ) unit = parent unit == formation
isHQFor _ _ = False

||| Attack factor of a `unit` when directly involved
||| in a combat
public export
attackCapacity : (unit : GameUnit) -> Nat
attackCapacity (MkGameUnit _ Armored  _ _ _ _ _ _ hits combat) = attack (index hits combat)
attackCapacity (MkGameUnit _ HeavyArmored  _ _ _ _ _ _ hits combat) = attack (index hits combat)
attackCapacity (MkGameUnit _ MechInfantry  _ _ _ _ _ _ hits combat) = attack (index hits combat)
attackCapacity (MkGameUnit _ Infantry  _ _ _ _ _ _ hits combat) = attack (index hits combat)
attackCapacity (MkGameUnit _ HeavyEngineer  _ _ _ _ _ _ hits combat) = attack (index hits combat)
-- all other units have a raw attack factor of 0 because they can't attack alone
attackCapacity _ = 0

||| Defense factor of a `unit` when directly involved
||| in a combat
public export
defenseCapacity : (unit : GameUnit) -> Nat
defenseCapacity (MkGameUnit _ Armored _ _ _ _ _ _ hits combat) = defense (index hits combat)
defenseCapacity (MkGameUnit _ HeavyArmored _ _ _ _ _ _ hits combat) = defense (index hits combat)
defenseCapacity (MkGameUnit _ MechInfantry _ _ _ _ _ _ hits combat) = defense (index hits combat)
defenseCapacity (MkGameUnit _ Infantry _ _ _ _ _ _ hits combat) = defense (index hits combat)
defenseCapacity (MkGameUnit _ HeavyEngineer _ _ _ _ _ _ hits combat) = defense (index hits combat)
defenseCapacity (MkGameUnit _ Artillery _ _ _ _ _ _ _ _) = 1
defenseCapacity (MkGameUnit _ AntiTank _ _ _ _ _ _ _ _) = 1
defenseCapacity (MkGameUnit _ HQ _ _ _ _ _ _ hits combat) =
  case index hits combat of
    (MkArty Z distance) => 0
    (MkArty (S k) distance) => divNatNZ (S k) 2 SIsNotZ
defenseCapacity (MkGameUnit _ SupplyColumn _ _ _ _ _ _ _ _) = 0

||| Is the unit a supporting unit?
public export
isSupportingUnit : (unit : GameUnit) -> Bool
isSupportingUnit unit =
  case unitType unit of
    Artillery => True
    AntiTank => True
    HQ => True
    _ => False

||| Support factor of a unit
public export
supportCapacity : (unit : GameUnit) -> Nat
supportCapacity (MkGameUnit _ Artillery _ _ _ _ _ _  hits combat) = support (index hits combat)
supportCapacity (MkGameUnit _ AntiTank _ _ _ _ _ _ hits combat) = antitank (index hits combat)
supportCapacity (MkGameUnit _ HQ _ _ _ _ _ _ hits combat) = support (index hits combat)
supportCapacity _ = 0

public export
supportDistance : (unit : GameUnit) -> Nat
supportDistance (MkGameUnit _ Artillery _ _ _ _ _ _ hits combat) = distance (index hits combat)
supportDistance (MkGameUnit _ AntiTank _ _ _ _ _ _ _ _) = 0
supportDistance (MkGameUnit _ HQ _ _ _ _ _ _ hits combat) = distance (index hits combat)
supportDistance _ = 0

-- -- list of existing units

-- -- Polish

public export
p13_5dp : GameUnit
p13_5dp = MkGameUnit Polish Infantry "13" (Just "5DP") Regiment 6 6 2 0 [ MkStdFactors 3 4, MkStdFactors 1 3 ]

public export
p15_5dp : GameUnit
p15_5dp = MkGameUnit Polish Infantry "15" (Just "5DP") Regiment 6 6 2 0 [ MkStdFactors 3 4, MkStdFactors 1 3 ]

public export
p17_5dp : GameUnit
p17_5dp = MkGameUnit Polish Infantry "17" (Just "5DP") Regiment 6 6 2 0 [ MkStdFactors 3 4, MkStdFactors 1 3 ]

public export
p5dp : GameUnit
p5dp = MkGameUnit Polish HQ "HQ" (Just "5DP") Division 4 4 1 0 [ MkArty 5 2 ]

public export
p33_7dp : GameUnit
p33_7dp = MkGameUnit Polish Infantry "33" (Just "7DP") Regiment 6 6 2 0 [ MkStdFactors 3 4, MkStdFactors 1 3 ]

public export
p32_8dp : GameUnit
p32_8dp = MkGameUnit Polish Infantry "32" (Just "8DP") Regiment 6 6 2 0 [ MkStdFactors 3 4, MkStdFactors 1 3 ]

public export
p6l : GameUnit
p6l = MkGameUnit Polish Artillery "6L" Nothing Brigade 4 4 1 0 [ MkArty 4 4 ]

public export
p2awp : GameUnit
p2awp = MkGameUnit Polish HQ "2AWP" Nothing Army 3 3 1 0 [ MkArty 9 5 ]

-- -- Russian

public export
r857_294 : GameUnit
r857_294 = MkGameUnit Russian Infantry "857" (Just "294") Brigade 8 8 1 0 [ MkStdFactors 2 4 ]

-- -- German

public export
g21_20pz : GameUnit
g21_20pz = MkGameUnit German Armored "21" (Just "20Pz") Regiment 10 10 2 0 [ MkStdFactors 6 4, MkStdFactors 4 3 ]

public export
g59_20pz : GameUnit
g59_20pz = MkGameUnit German MechInfantry "59" (Just "20Pz") Regiment 10 10 2  0 [ MkStdFactors 4 5, MkStdFactors 2 3 ]

public export
g20pz : GameUnit
g20pz = MkGameUnit German HQ "HQ" (Just "20Pz") Division 8 8 1 0 [ MkArty 6 3 ]

public export
gBrgPzG : GameUnit
gBrgPzG = MkGameUnit German HQ "HQ" (Just "BrgPzG") Division 8 8 1 0 [ MkArty 7 3 ]

public export
g777Arty : GameUnit
g777Arty = MkGameUnit German Artillery "777" Nothing Brigade 5 5 1 0 [ MkArty 6 4 ]

public export
gSupplyColumn : GameUnit
gSupplyColumn = MkGameUnit German SupplyColumn "SC" Nothing Brigade 4 4 1 0 [ () ]


module Main

import GLCore
import JSArrays
import Shaders

-- Save time, just get the canvas directly by id
getElemById : String -> IO Element
getElemById s = do
  x <- mkForeign (FFun "document.getElementById(%0)" [FString] FPtr) s
  return (MkElem x)

-- Shader Functions
vShader : String
vShader = "attribute vec2 pos;void main() { gl_Position = vec4(pos, 0, 1); }"
fShader : String
fShader = "precision mediump float;void main() { gl_FragColor = vec4(0,0.8,0,1); }"

-- Create the 2D Vector
-- Populate the 2D Vector
-- var vertices = [-0.5, -0.5, 0.5, -0.5, 0, 0.5]
triangleVertices : List Float
triangleVertices = [-0.5, -0.5, 0.5, -0.5, 0, 0.5]

-- Some basic settings for starting our GL env
baseGLInit : GLCxt -> IO GLCxt
baseGLInit c = do
  clearColor c
  enableGLSetting c
  depthFun c
  glClear c

-- Create an array, populate it with vertices, and use it to create a proper Float32Array
prepareTriangleArray : IO F32Array
prepareTriangleArray = createJSArray >>= fromFloatList triangleVertices >>= createF32Array

-- Wrapper for finding and init'ing our GL env and context
locateInitCanvas : IO GLCxt
locateInitCanvas = getElemById "canvas" >>= getGLCxt >>= baseGLInit

-- Wrapper for the process of assigning a shader variable the correct location
-- for our program to locate vertex information when the shader runs.
assignVertexPositionAttribs : (GLProgram,GLCxt) -> IO (GLProgram,GLCxt)
assignVertexPositionAttribs glProg = getAttribLocation "pos" glProg
                                     >>= setVertexPosAttrib glProg
                                     >>= enableVertexAttribArray
                                     >>= setVertexAttribPointer 2

main : IO ()
main = do
  f32Arr <- prepareTriangleArray -- prepare our vertices
  glCxt <- locateInitCanvas -- start our engines
  buffer <- createBuffer glCxt -- create a buffer to store our vertex information
  bindArrayBuffer glCxt buffer -- bind the buffer to the current gl context
  program <- bufferVertexData f32Arr glCxt >>= createProg -- fill the buffer with vertex info
  -- Pass our shader code to be built,compiled, and linked to the GL context
  compileAndLinkShaders [(Vertex vShader),(Fragment fShader)] program glCxt
    >>= useProg -- set the gl context to use this created program
    >>= assignVertexPositionAttribs -- assign our pointer information for the shaders
    >>= \glProg => drawTriangles glProg 0 3 -- draw our vertices to the screen
  putStrLn "We're finished?"


module Bautzen.Game.Map

import Bautzen.Terrain
import Bautzen.GameUnit

import Data.Nat
import Data.Vect
import Data.List

V : Terrain -> Terrain
V = Village

Wd  : Terrain
Wd = Wood

Cl  : Terrain
Cl = Clear

Rg  : Terrain
Rg = Rough

RW  : Terrain
RW = RoughWood

H : Terrain -> Terrain
H = Hill

SA : Terrain -> Terrain
SA = SupplySource Allies

SX : Terrain -> Terrain
SX = SupplySource Axis

T : Terrain
T = Town

N : Terrain
N = Clear

A : Side
A = Allies

Rd : Connection -> Connection
Rd = Road

Rv : Connection -> Connection
Rv = Road

Pl : Connection
Pl = Plain

Lk : Connection
Lk = Lake

terrains : Vect 13 (Vect 23 Terrain)
terrains = [-- 01      02     03          04    05     06     07     08     09      10     11     12     13     14         15     16     17     18      19     20          21    22      23
 {- 01 -}    [ Cl    , Wd   , Cl        , Wd  , Wd   , V Cl , Cl   , Wd    , Cl   , Wd   , Wd   , Wd   , Wd   , Wd       , Wd   , Wd   , Wd   , Wd    , Cl   , SA (V Wd) , Cl   , Wd   , Cl    ]
 {- 02 -}  , [ Wd    , Wd   , Wd        , Wd  , Wd   , Wd   , Wd   , Wd    , Wd   , V Wd , Wd   , Wd   , Wd   , Wd       , Wd   , Wd   , Wd   , V Wd  , Wd   , V Wd      , V Wd , Wd   , Wd    ]
 {- 03 -}  , [ Wd    , Wd   , Wd        , Wd  , Wd   , Cl   , V Wd , Wd    , Wd   , Cl   , Wd   , Wd   , Wd   , Wd       , Wd   , Wd   , Wd   , Wd    , Wd   , Wd        , Wd   , Wd   , Cl    ]
 {- 04 -}  , [ SX Wd , Cl   , Wd        , Wd  , Wd   , Cl   , V Cl , Cl    , Cl   , V Cl , Cl   , Cl   , V Wd , Wd       , V Wd , Wd   , V Wd , Cl    , Cl   , Cl        , V Cl , Cl   , Cl    ]
 {- 05 -}  , [ Cl    , Wd   , Wd        , Cl  , Cl   , Cl   , Cl   , Cl    , Cl   , Cl   , Cl   , Cl   , Cl   , Cl       , Wd   , Wd   , Wd   , Wd    , V Cl , Cl        , Cl   , Cl   , SA Cl ]
 {- 06 -}  , [ Cl    , Wd   , Wd        , Cl  , Cl   , Cl   , V Cl , Cl    , Cl   , H RW , RW   , Wd   , RW   , H (V RW) , Cl   , V Wd , Wd   , Wd    , V Wd , Wd        , Cl   , T    , SA Cl ]
 {- 07 -}  , [ SX Wd , Wd   , V Wd      , H Rg, Cl   , Cl   , H Rg , T     , Cl   , Cl   , RW   , V Cl , Cl   , V Cl     , Wd   , Cl   , Cl   , Wd    , Cl   , Wd        , V Cl , V Cl , Cl    ]
 {- 08 -}  , [ Wd    , RW   , Wd        , RW  , Cl   , Cl   , V Cl , Rg    , V Cl , Cl   , V Cl , Cl   , Cl   , Cl       , Cl   , Cl   , V Cl , Cl    , Cl   , Cl        , V Cl , Cl   , Cl    ]
 {- 09 -}  , [ Cl    , Rg   , Wd        , Rg  , Cl   , Wd   , Cl   , H RW  , Wd   , V Cl , Cl   , V Cl , Cl   , T        , Cl   , Cl   , Cl   , Cl    , V Cl , Cl        , Cl   , Cl   , Cl    ]
 {- 10 -}  , [ SX Wd , V Cl , V Cl      , Wd  , V Cl , Cl   , Wd   , Cl    , V Rg , Rg   , Wd   , Cl   , Cl   , Cl       , T    , Cl   , Cl   , Cl    , V Cl , Cl        , Cl   , Cl   , Cl    ]
 {- 11 -}  , [ Wd    , V Wd , Cl        , Cl  , Wd   , Cl   , Cl   , Cl    , T    , H Rg , Cl   , RW   , RW   , Rg       , Cl   , H RW , RW   , H Rg  , Cl   , Cl        , Cl   , V Cl , Cl    ]
 {- 12 -}  , [ Wd    , Wd   , V Wd      , Wd  , Cl   , Cl   , Rg   , SX Rg , Rg   , Cl   , RW   , Cl   , Rg   , Cl       , RW   , Cl   , Cl   , SX Cl , T    , Cl        , Cl   , Cl   , Cl    ]
 {- 13 -}  , [ T     , N    , SX (V Cl) , N   , Cl   , N    , Cl   , N     , Cl   , N    , Cl   , N    , Cl   , N        , Cl   , N    , Cl   , N     , Cl   , N         , Cl   , N    , Cl    ]
           ]

links : List (Pos, List (Pos, Connection))
links = [
  (hex 00 00, [(hex 01 00, Pl), (hex 00 01, Pl)]),
  (hex 00 01, [(hex 00 00, Pl), (hex 01 00, Pl), (hex 01 01, Pl), (hex 00 02, Pl)]),
  (hex 00 02, [(hex 00 01, Pl), (hex 01 01, Rd Pl), (hex 01 02, Pl), (hex 00 03, Rd Pl)]),
  (hex 00 03, [(hex 00 02, Rd Pl), (hex 01 02, Pl), (hex 01 03, Rd Pl), (hex 00 04, Pl)]),
  (hex 00 04, [(hex 00 03, Pl), (hex 01 03, Pl), (hex 01 04, Pl), (hex 00 05, Pl)]),
  (hex 00 05, [(hex 00 04, Pl), (hex 01 04, Pl), (hex 01 05, Pl), (hex 00 06, Pl)]),
  (hex 00 06, [(hex 00 05, Pl), (hex 01 05, Rd Pl), (hex 01 06, Pl), (hex 00 07, Pl)]),
  (hex 00 07, [(hex 00 06, Pl), (hex 01 06, Pl), (hex 01 07, Pl), (hex 00 08, Pl)]),
  (hex 00 08, [(hex 00 07, Pl), (hex 01 07, Pl), (hex 01 08, Pl), (hex 00 09, Pl)]),
  (hex 00 09, [(hex 00 08, Pl), (hex 01 08, Pl), (hex 01 09, Rd Pl), (hex 00 10, Pl)]),
  (hex 00 10, [(hex 00 09, Pl), (hex 01 09, Pl), (hex 01 10, Rd Pl), (hex 00 11, Pl)]),
  (hex 00 11, [(hex 00 10, Pl), (hex 01 10, Rd Pl), (hex 01 11, Rd Pl), (hex 00 12, Pl)]),
  (hex 00 12, [(hex 00 11, Pl), (hex 01 11, Rd Pl), (hex 01 12, Pl)]),
  (hex 01 00, [(hex 00 00, Pl), (hex 02 00, Pl), (hex 02 01, Pl), (hex 01 01, Pl), (hex 00 01, Pl)]),
  (hex 01 01, [(hex 00 01, Pl), (hex 01 00, Pl), (hex 02 01, Rd Pl), (hex 02 02, Pl), (hex 01 02, Pl), (hex 00 02, Rd Pl)]),
  (hex 01 02, [(hex 00 02, Pl), (hex 01 01, Pl), (hex 02 02, Pl), (hex 02 03, Pl), (hex 01 03, Pl), (hex 00 03, Pl)]),
  (hex 01 03, [(hex 00 03, Rd Pl), (hex 01 02, Pl), (hex 02 03, Rd Pl), (hex 02 04, Pl), (hex 01 04, Pl), (hex 00 04, Pl)]),
  (hex 01 04, [(hex 00 04, Pl), (hex 01 03, Pl), (hex 02 04, Pl), (hex 02 05, Pl), (hex 01 05, Pl), (hex 00 05, Pl)]),
  (hex 01 05, [(hex 00 05, Pl), (hex 01 04, Pl), (hex 02 05, Pl), (hex 02 06, Rd Pl), (hex 01 06, Pl), (hex 00 06, Rd Pl)]),
  (hex 01 06, [(hex 00 06, Pl), (hex 01 05, Pl), (hex 02 06, Pl), (hex 02 07, Pl), (hex 01 07, Pl), (hex 00 07, Pl)]),
  (hex 01 07, [(hex 00 07, Pl), (hex 01 06, Pl), (hex 02 07, Pl), (hex 02 08, Pl), (hex 01 08, Pl), (hex 00 08, Pl)]),
  (hex 01 08, [(hex 00 08, Pl), (hex 01 07, Pl), (hex 02 08, Pl), (hex 02 09, Pl), (hex 01 09, Pl), (hex 00 09, Pl)]),
  (hex 01 09, [(hex 00 09, Rd Pl), (hex 01 08, Pl), (hex 02 09, Rd Pl), (hex 02 10, Pl), (hex 01 10, Rd Pl), (hex 00 10, Pl)]),
  (hex 01 10, [(hex 00 10, Rd Pl), (hex 01 09, Rd Pl), (hex 02 10, Pl), (hex 02 11, Rd Pl), (hex 01 11, Pl), (hex 00 11, Rd Pl)]),
  (hex 01 11, [(hex 00 11, Rd Pl), (hex 01 10, Pl), (hex 02 11, Pl), (hex 02 12, Pl), (hex 01 12, Pl), (hex 00 12, Rd Pl)]),
  (hex 02 00, [(hex 03 00, Pl), (hex 02 01, Rd Pl), (hex 01 00, Pl)]),
  (hex 02 01, [(hex 01 00, Pl), (hex 02 00, Rd Pl), (hex 03 00, Rd Pl), (hex 03 01, Pl), (hex 02 02, Rd Pl), (hex 01 01, Rd Pl)]),
  (hex 02 02, [(hex 01 01, Pl), (hex 02 01, Rd Pl), (hex 03 01, Pl), (hex 03 02, Rd Pl), (hex 02 03, Pl), (hex 01 02, Pl)]),
  (hex 02 03, [(hex 01 02, Pl), (hex 02 02, Pl), (hex 03 02, Rd Pl), (hex 03 03, Rd Pl), (hex 02 04, Pl), (hex 01 03, Rd Pl)]),
  (hex 02 04, [(hex 01 03, Pl), (hex 02 03, Pl), (hex 03 03, Pl), (hex 03 04, Pl), (hex 02 05, Pl), (hex 01 04, Pl)]),
  (hex 02 05, [(hex 01 04, Pl), (hex 02 04, Pl), (hex 03 04, Rd Pl), (hex 03 05, Pl), (hex 02 06, Rd Pl), (hex 01 05, Pl)]),
  (hex 02 06, [(hex 01 05, Rd Pl), (hex 02 05, Rd Pl), (hex 03 05, Rd Pl), (hex 03 06, Pl), (hex 02 07, Rd Pl), (hex 01 06, Pl)]),
  (hex 02 07, [(hex 01 06, Pl), (hex 02 06, Rd Pl), (hex 03 06, Pl), (hex 03 07, Pl), (hex 02 08, Rd Pl), (hex 01 07, Pl)]),
  (hex 02 08, [(hex 01 07, Pl), (hex 02 07, Rd Pl), (hex 03 07, Pl), (hex 03 08, Pl), (hex 02 09, Rd Pl), (hex 01 08, Pl)]),
  (hex 02 09, [(hex 01 08, Pl), (hex 02 08, Rd Pl), (hex 03 08, Pl), (hex 03 09, Rd Pl), (hex 02 10, Pl), (hex 01 09, Rd Pl)]),
  (hex 02 10, [(hex 01 09, Pl), (hex 02 09, Pl), (hex 03 09, Pl), (hex 03 10, Pl), (hex 02 11, Pl), (hex 01 10, Pl)]),
  (hex 02 11, [(hex 01 10, Rd Pl), (hex 02 10, Pl), (hex 03 10, Rd Pl), (hex 03 11, Pl), (hex 02 12, Rd Pl), (hex 01 11, Pl)]),
  (hex 02 12, [(hex 01 11, Pl), (hex 02 11, Rd Pl), (hex 03 11, Pl), (hex 03 12, Pl), (hex 01 12, Pl)]),
  (hex 03 00, [(hex 02 00, Pl), (hex 04 00, Pl), (hex 04 01, Rd Pl), (hex 03 01, Pl), (hex 02 01, Rd Pl)]),
  (hex 03 01, [(hex 02 01, Pl), (hex 03 00, Pl), (hex 04 01, Pl), (hex 04 02, Pl), (hex 03 02, Pl), (hex 02 02, Pl)]),
  (hex 03 02, [(hex 02 02, Rd Pl), (hex 03 01, Pl), (hex 04 02, Pl), (hex 04 03, Rd Pl), (hex 03 03,Rd Pl), (hex 02 03, Rd Pl)]),
  (hex 03 03, [(hex 02 03, Rd Pl), (hex 03 02, Rd Pl), (hex 04 03, Pl), (hex 04 04, Rd Pl), (hex 03 04, Rd Pl), (hex 02 04, Pl)]),
  (hex 03 04, [(hex 02 04, Pl), (hex 03 03, Rd Pl), (hex 04 04, Rd Pl), (hex 04 05, Rd Pl), (hex 03 05, Pl), (hex 02 05, Rd Pl)]),
  (hex 03 05, [(hex 02 05, Pl), (hex 03 04, Pl), (hex 04 05, Pl), (hex 04 06, Rd Pl), (hex 03 06, Pl), (hex 02 06, Rd Pl)]),
  (hex 03 06, [(hex 02 06, Pl), (hex 03 05, Pl), (hex 04 06, Pl), (hex 04 07, Pl), (hex 03 07, Pl), (hex 02 07, Pl)]),
  (hex 03 07, [(hex 02 07, Pl), (hex 03 06, Pl), (hex 04 07, Pl), (hex 04 08, Pl), (hex 03 08, Pl), (hex 02 08, Pl)]),
  (hex 03 08, [(hex 02 08, Pl), (hex 03 07, Pl), (hex 04 08, Pl), (hex 04 09, Pl), (hex 03 09, Pl), (hex 02 09, Pl)]),
  (hex 03 09, [(hex 02 09, Rd Pl), (hex 03 08, Pl), (hex 04 09, Rd Pl), (hex 04 10, Pl), (hex 03 10, Rd Pl), (hex 02 10, Pl)]),
  (hex 03 10, [(hex 02 10, Pl), (hex 03 09, Rd Pl), (hex 04 10, Pl), (hex 04 11, Rd Pl), (hex 03 11, Pl), (hex 02 11, Rd Pl)]),
  (hex 03 11, [(hex 02 11, Pl), (hex 03 10, Pl), (hex 04 11, Pl), (hex 04 12, Pl), (hex 03 12, Pl), (hex 02 12, Pl)]),
  (hex 04 00, [(hex 05 00, Pl), (hex 04 01, Pl), (hex 03 00, Pl)]),
  (hex 04 01, [(hex 03 00, Rd Pl), (hex 04 00, Pl), (hex 05 00, Rd Pl), (hex 05 01, Pl), (hex 04 02, Pl), (hex 03 01, Pl)]),
  (hex 04 02, [(hex 03 01, Pl), (hex 04 01, Pl), (hex 05 01, Pl), (hex 05 02, Pl), (hex 04 03, Pl), (hex 03 02, Pl)]),
  (hex 04 03, [(hex 03 02, Rd Pl), (hex 04 02, Pl), (hex 05 02, Rd Pl), (hex 05 03, Pl), (hex 04 04, Pl), (hex 03 03, Pl)]),
  (hex 04 04, [(hex 03 03, Rd Pl), (hex 04 03, Pl), (hex 05 03, Rd Pl), (hex 05 04, Rd Pl), (hex 04 05, Pl), (hex 03 04, Rd Pl)]),
  (hex 04 05, [(hex 03 04, Rd Pl), (hex 04 04, Pl), (hex 05 04, Pl), (hex 05 05, Pl), (hex 04 06, Rd Pl), (hex 03 05, Pl)]),
  (hex 04 06, [(hex 03 05, Rd Pl), (hex 04 05, Rd Pl), (hex 05 05, Rd Pl), (hex 05 06, Pl), (hex 04 07, Rd Pl), (hex 03 06, Pl)]),
  (hex 04 07, [(hex 03 06, Pl), (hex 04 06, Rd Pl), (hex 05 06, Pl), (hex 05 07, Rd Pl), (hex 04 08, Pl), (hex 03 07, Pl)]),
  (hex 04 08, [(hex 03 07, Pl), (hex 04 07, Pl), (hex 05 07, Pl), (hex 05 08, Pl), (hex 04 09, Pl), (hex 03 08, Pl)]),
  (hex 04 09, [(hex 03 08, Pl), (hex 04 08, Pl), (hex 05 08, Rd Pl), (hex 05 09, Pl), (hex 04 10, Pl), (hex 03 09, Rd Pl)]),
  (hex 04 10, [(hex 03 09, Pl), (hex 04 09, Pl), (hex 05 09, Pl), (hex 05 10, Pl), (hex 04 11, Pl), (hex 03 10, Pl)]),
  (hex 04 11, [(hex 03 10, Rd Pl), (hex 04 10, Pl), (hex 05 10, Rd Pl), (hex 05 11, Pl), (hex 04 12, Pl), (hex 03 11, Pl)]),
  (hex 04 12, [(hex 03 11, Pl), (hex 04 11, Pl), (hex 05 11, Rd Pl), (hex 05 12, Pl), (hex 03 12, Pl)]),
  (hex 05 00, [(hex 04 00, Pl), (hex 06 00, Pl), (hex 06 01, Rd Pl), (hex 05 01, Pl), (hex 04 01, Rd Pl)]),
  (hex 05 01, [(hex 04 01, Pl), (hex 05 00, Rd Pl), (hex 06 01, Pl), (hex 06 02, Pl), (hex 05 02, Rd Pl), (hex 04 02, Pl)]),
  (hex 05 02, [(hex 04 02, Pl), (hex 05 01, Rd Pl), (hex 06 02, Pl), (hex 06 03, Rd Pl), (hex 05 03, Rd Pl), (hex 04 03, Rd Pl)]),
  (hex 05 03, [(hex 04 03, Pl), (hex 05 02, Rd Pl), (hex 06 03, Rd Pl), (hex 06 04, Rd Pl), (hex 05 04, Pl), (hex 04 04, Rd Pl)]),
  (hex 05 04, [(hex 04 04, Rd Pl), (hex 05 03, Pl), (hex 06 04, Pl), (hex 06 05, Pl), (hex 05 05, Rd Pl), (hex 04 05, Pl)]),
  (hex 05 05, [(hex 04 05, Pl), (hex 05 04, Rd Pl), (hex 06 05, Pl), (hex 06 06, Rd Pl), (hex 05 06, Pl), (hex 04 06, Rd Pl)]),
  (hex 05 06, [(hex 04 06, Pl), (hex 05 05, Pl), (hex 06 06, Pl), (hex 06 07, Pl), (hex 05 07, Pl), (hex 04 07, Pl)]),
  (hex 05 07, [(hex 04 07, Rd Pl), (hex 05 06, Pl), (hex 06 07, Rd Pl), (hex 06 08, Pl), (hex 05 08, Rd Pl), (hex 04 08, Pl)]),
  (hex 05 08, [(hex 04 08, Pl), (hex 05 07, Rd Pl), (hex 06 08, Pl), (hex 06 09, Pl), (hex 05 09, Pl), (hex 04 09, Rd Pl)]),
  (hex 05 09, [(hex 04 09, Pl), (hex 05 08, Pl), (hex 06 09, Pl), (hex 06 10, Pl), (hex 05 10, Pl), (hex 04 10, Pl)]),
  (hex 05 10, [(hex 04 10, Pl), (hex 05 09, Pl), (hex 06 10, Pl), (hex 06 11, Rd Pl), (hex 05 11, Pl), (hex 04 11, Rd Pl)]),
  (hex 05 11, [(hex 04 11, Pl), (hex 05 10, Pl), (hex 06 11, Rd Pl), (hex 06 12, Pl), (hex 05 12, Pl), (hex 04 12, Rd Pl)]),
  (hex 06 00, [(hex 07 00, Rv Pl), (hex 06 01, Pl), (hex 05 00, Pl)]),
  (hex 06 01, [(hex 05 00, Rd Pl), (hex 06 00, Pl), (hex 07 00, Rv Pl), (hex 07 01, Rv (Rd Pl)), (hex 06 02, Pl), (hex 05 01, Pl)]),
  (hex 06 02, [(hex 05 01, Pl), (hex 06 01, Pl), (hex 07 01, Rv Pl), (hex 07 02, Pl), (hex 06 03, Pl), (hex 05 02, Pl)]),
  (hex 06 03, [(hex 05 02, Rd Pl), (hex 06 02, Pl), (hex 07 02, Rd Pl), (hex 07 03, Rd Pl), (hex 06 04, Pl), (hex 05 03, Rd Pl)]),
  (hex 06 04, [(hex 05 03, Rd Pl), (hex 06 03, Pl), (hex 07 03, Pl), (hex 07 04, Pl), (hex 06 05, Rd Pl), (hex 05 04, Pl)]),
  (hex 06 05, [(hex 05 04, Pl), (hex 06 04, Rd Pl), (hex 07 04, Pl), (hex 07 05, Pl), (hex 06 06, Rd Pl), (hex 05 05, Pl)]),
  (hex 06 06, [(hex 05 05, Rd Pl), (hex 06 05, Rd Pl), (hex 07 05, Rd Pl), (hex 07 06, Rd Pl), (hex 06 07, Rd Pl), (hex 05 06, Pl)]),
  (hex 06 07, [(hex 05 06, Pl), (hex 06 06, Rd Pl), (hex 07 06, Pl), (hex 07 07, Pl), (hex 06 08, Pl), (hex 05 07, Rd Pl)]),
  (hex 06 08, [(hex 05 07, Pl), (hex 06 07, Pl), (hex 07 07, Pl), (hex 07 08, Pl), (hex 06 09, Pl), (hex 05 08, Pl)]),
  (hex 06 09, [(hex 05 08, Pl), (hex 06 08, Pl), (hex 07 08, Pl), (hex 07 09, Pl), (hex 06 10, Pl), (hex 05 09, Pl)]),
  (hex 06 10, [(hex 05 09, Pl), (hex 06 09, Pl), (hex 07 09, Pl), (hex 07 10, Pl), (hex 06 11, Pl), (hex 05 10, Pl)]),
  (hex 06 11, [(hex 05 10, Rd Pl), (hex 06 10, Pl), (hex 07 10, Rd Pl), (hex 07 11, Pl), (hex 06 12, Pl), (hex 05 11, Rd Pl)]),
  (hex 06 12, [(hex 05 11, Pl), (hex 06 11, Pl), (hex 07 11, Pl), (hex 07 12, Pl), (hex 05 12, Pl)]),
  (hex 07 00, [(hex 06 00, Rv Pl), (hex 08 00, Pl), (hex 08 01, Pl), (hex 07 01, Pl), (hex 06 01, Rv Pl)]),
  (hex 07 01, [(hex 06 01, Rd (Rv Pl)), (hex 07 00, Pl), (hex 08 01, Pl), (hex 08 02, Rd Pl), (hex 07 02, Rv Pl), (hex 06 02, Rv Pl)]),
  (hex 07 02, [(hex 06 02, Pl), (hex 07 01, Rv Pl), (hex 08 02, Rd (Rv Pl)), (hex 08 03, Pl), (hex 07 03, Pl), (hex 06 03, Rd Pl)]),
  (hex 07 03, [(hex 06 03, Rd Pl), (hex 07 02, Pl), (hex 08 03, Pl), (hex 08 04, Rd Pl), (hex 07 04, Pl), (hex 06 04, Pl)]),
  (hex 07 04, [(hex 06 04, Pl), (hex 07 03, Pl), (hex 08 04, Rd Pl), (hex 08 05, Pl), (hex 07 05, Rd Pl), (hex 06 05, Pl)]),
  (hex 07 05, [(hex 06 05, Pl), (hex 07 04, Rd Pl), (hex 08 05, Pl), (hex 08 06, Rd Pl), (hex 07 06, Lk), (hex 06 06, Rd Pl)]),
  (hex 07 06, [(hex 06 06, Rd Pl), (hex 07 05, Lk), (hex 08 06, Pl), (hex 08 07, Rd Pl), (hex 07 07, Rd Pl), (hex 06 07, Pl)]),
  (hex 07 07, [(hex 06 07, Pl), (hex 07 06, Rd Pl), (hex 08 07, Pl), (hex 08 08, Pl), (hex 07 08, Rd Pl), (hex 06 08, Pl)]),
  (hex 07 08, [(hex 06 08, Pl), (hex 07 07, Rd Pl), (hex 08 08, Pl), (hex 08 09, Rd Pl), (hex 07 09, Rd Pl), (hex 06 09, Pl)]),
  (hex 07 09, [(hex 06 09, Pl), (hex 07 08, Rd Pl), (hex 08 09, Pl), (hex 08 10, Rd Pl), (hex 07 10, Pl), (hex 06 10, Pl)]),
  (hex 07 10, [(hex 06 10, Pl), (hex 07 09, Pl), (hex 08 10, Rd Pl), (hex 08 11, Pl), (hex 07 11, Pl), (hex 06 11, Rd Pl)]),
  (hex 07 11, [(hex 06 11, Pl), (hex 07 10, Pl), (hex 08 11, Rd Pl), (hex 08 12, Pl), (hex 07 12, Pl), (hex 06 12, Pl)]),
  (hex 08 00, [(hex 09 00, Pl), (hex 08 01, Pl), (hex 07 00, Pl)]),
  (hex 08 01, [(hex 07 00, Pl), (hex 08 00, Pl), (hex 09 00, Pl), (hex 09 01, Pl), (hex 08 02, Pl), (hex 07 01, Pl)]),
  (hex 08 02, [(hex 07 01, Rd Pl), (hex 08 01, Pl), (hex 09 01, Rd Pl), (hex 09 02, Pl), (hex 08 03, Rv Pl), (hex 07 02, Rv (Rd Pl))]),
  (hex 08 03, [(hex 07 02, Pl), (hex 08 02, Rv Pl), (hex 09 02, Pl), (hex 09 03, Rd Pl), (hex 08 04, Rd Pl), (hex 07 03, Pl)]),
  (hex 08 04, [(hex 07 03, Rd Pl), (hex 08 03, Rd Pl), (hex 09 03, Pl), (hex 09 04, Pl), (hex 08 05, Lk), (hex 07 04, Rd Pl)]),
  (hex 08 05, [(hex 07 04, Pl), (hex 08 04, Lk), (hex 09 04, Rd Pl), (hex 09 05, Rd Pl), (hex 08 06, Rd Pl), (hex 07 05, Pl)]),
  (hex 08 06, [(hex 07 05, Rd Pl), (hex 08 05, Rd Pl), (hex 09 05, Pl), (hex 09 06, Pl), (hex 08 07, Pl), (hex 07 06, Pl)]),
  (hex 08 07, [(hex 07 06, Rd Pl), (hex 08 06, Pl), (hex 09 06, Rd Pl), (hex 09 07, Rd Pl), (hex 08 08, Pl), (hex 07 07, Pl)]),
  (hex 08 08, [(hex 07 07, Pl), (hex 08 07, Pl), (hex 09 07, Pl), (hex 09 08, Pl), (hex 08 09, Pl), (hex 07 08, Pl)]),
  (hex 08 09, [(hex 07 08, Rd Pl), (hex 08 08, Pl), (hex 09 08, Pl), (hex 09 09, Pl), (hex 08 10, Rd Pl), (hex 07 09, Pl)]),
  (hex 08 10, [(hex 07 09, Rd Pl), (hex 08 09, Rd Pl), (hex 09 09, Rd Pl), (hex 09 10, Pl), (hex 08 11, Rd Pl), (hex 07 10, Rd Pl)]),
  (hex 08 11, [(hex 07 10, Pl), (hex 08 10, Rd Pl), (hex 09 10, Pl), (hex 09 11, Pl), (hex 08 12, Pl), (hex 07 11, Rd Pl)]),
  (hex 08 12, [(hex 07 11, Pl), (hex 08 11, Pl), (hex 09 11, Pl), (hex 09 12, Pl), (hex 07 12, Pl)]),
  --
  (hex 09 00, [(hex 08 00, Pl), (hex 10 00, Pl), (hex 10 01, Pl), (hex 09 01, Pl), (hex 08 01, Pl)]),
  (hex 09 01, [(hex 08 01, Pl), (hex 09 00, Pl), (hex 10 01, Pl), (hex 10 02, Pl), (hex 09 02, Pl), (hex 08 02, Pl)]),
  (hex 09 02, [(hex 08 02, Pl), (hex 09 01, Pl), (hex 10 02, Pl), (hex 10 03, Pl), (hex 09 03, Pl), (hex 08 03, Pl)]),
  (hex 09 03, [(hex 08 03, Pl), (hex 09 02, Pl), (hex 10 03, Pl), (hex 10 04, Pl), (hex 09 04, Pl), (hex 08 04, Pl)]),
  (hex 09 04, [(hex 08 04, Pl), (hex 09 03, Pl), (hex 10 04, Pl), (hex 10 05, Pl), (hex 09 05, Pl), (hex 08 05, Pl)]),
  (hex 09 05, [(hex 08 05, Pl), (hex 09 04, Pl), (hex 10 05, Pl), (hex 10 06, Pl), (hex 09 06, Pl), (hex 08 06, Pl)]),
  (hex 09 06, [(hex 08 06, Pl), (hex 09 05, Pl), (hex 10 06, Pl), (hex 10 07, Pl), (hex 09 07, Pl), (hex 08 07, Pl)]),
  (hex 09 07, [(hex 08 07, Pl), (hex 09 06, Pl), (hex 10 07, Pl), (hex 10 08, Pl), (hex 09 08, Pl), (hex 08 08, Pl)]),
  (hex 09 08, [(hex 08 08, Pl), (hex 09 07, Pl), (hex 10 08, Pl), (hex 10 09, Pl), (hex 09 09, Pl), (hex 08 09, Pl)]),
  (hex 09 09, [(hex 08 09, Pl), (hex 09 08, Pl), (hex 10 09, Pl), (hex 10 10, Pl), (hex 09 10, Pl), (hex 08 10, Pl)]),
  (hex 09 10, [(hex 08 10, Pl), (hex 09 09, Pl), (hex 10 10, Pl), (hex 10 11, Pl), (hex 09 11, Pl), (hex 08 11, Pl)]),
  (hex 09 11, [(hex 08 11, Pl), (hex 09 10, Pl), (hex 10 11, Pl), (hex 10 12, Pl), (hex 09 12, Pl), (hex 08 12, Pl)]),
  (hex 09 12, [(hex 08 12, Pl), (hex 09 11, Pl), (hex 10 12, Pl)]),
  (hex 10 00, [(hex 11 00, Pl), (hex 10 01, Pl), (hex 09 00, Pl)]),
  (hex 10 01, [(hex 09 00, Pl), (hex 10 00, Pl), (hex 11 00, Pl), (hex 11 01, Pl), (hex 10 02, Pl), (hex 09 01, Pl)]),
  (hex 10 02, [(hex 09 01, Pl), (hex 10 01, Pl), (hex 11 01, Pl), (hex 11 02, Pl), (hex 10 03, Pl), (hex 09 02, Pl)]),
  (hex 10 03, [(hex 09 02, Pl), (hex 10 02, Pl), (hex 11 02, Pl), (hex 11 03, Pl), (hex 10 04, Pl), (hex 09 03, Pl)]),
  (hex 10 04, [(hex 09 03, Pl), (hex 10 03, Pl), (hex 11 03, Pl), (hex 11 04, Pl), (hex 10 05, Pl), (hex 09 04, Pl)]),
  (hex 10 05, [(hex 09 04, Pl), (hex 10 04, Pl), (hex 11 04, Pl), (hex 11 05, Pl), (hex 10 06, Pl), (hex 09 05, Pl)]),
  (hex 10 06, [(hex 09 05, Pl), (hex 10 05, Pl), (hex 11 05, Pl), (hex 11 06, Pl), (hex 10 07, Pl), (hex 09 06, Pl)]),
  (hex 10 07, [(hex 09 06, Pl), (hex 10 06, Pl), (hex 11 06, Pl), (hex 11 07, Pl), (hex 10 08, Pl), (hex 09 07, Pl)]),
  (hex 10 08, [(hex 09 07, Pl), (hex 10 07, Pl), (hex 11 07, Pl), (hex 11 08, Pl), (hex 10 09, Pl), (hex 09 08, Pl)]),
  (hex 10 09, [(hex 09 08, Pl), (hex 10 08, Pl), (hex 11 08, Pl), (hex 11 09, Pl), (hex 10 10, Pl), (hex 09 09, Pl)]),
  (hex 10 10, [(hex 09 09, Pl), (hex 10 09, Pl), (hex 11 09, Pl), (hex 11 10, Pl), (hex 10 11, Pl), (hex 09 10, Pl)]),
  (hex 10 11, [(hex 09 10, Pl), (hex 10 10, Pl), (hex 11 10, Pl), (hex 11 11, Pl), (hex 10 12, Pl), (hex 09 11, Pl)]),
  (hex 10 12, [(hex 09 11, Pl), (hex 10 11, Pl), (hex 11 11, Pl), (hex 11 12, Pl), (hex 09 12, Pl)]),
  (hex 11 00, [(hex 10 00, Pl), (hex 12 00, Pl), (hex 12 01, Pl), (hex 11 01, Pl), (hex 10 01, Pl)]),
  (hex 11 01, [(hex 10 01, Pl), (hex 11 00, Pl), (hex 12 01, Pl), (hex 12 02, Pl), (hex 11 02, Pl), (hex 10 02, Pl)]),
  (hex 11 02, [(hex 10 02, Pl), (hex 11 01, Pl), (hex 12 02, Pl), (hex 12 03, Pl), (hex 11 03, Pl), (hex 10 03, Pl)]),
  (hex 11 03, [(hex 10 03, Pl), (hex 11 02, Pl), (hex 12 03, Pl), (hex 12 04, Pl), (hex 11 04, Pl), (hex 10 04, Pl)]),
  (hex 11 04, [(hex 10 04, Pl), (hex 11 03, Pl), (hex 12 04, Pl), (hex 12 05, Pl), (hex 11 05, Pl), (hex 10 05, Pl)]),
  (hex 11 05, [(hex 10 05, Pl), (hex 11 04, Pl), (hex 12 05, Pl), (hex 12 06, Pl), (hex 11 06, Pl), (hex 10 06, Pl)]),
  (hex 11 06, [(hex 10 06, Pl), (hex 11 05, Pl), (hex 12 06, Pl), (hex 12 07, Pl), (hex 11 07, Pl), (hex 10 07, Pl)]),
  (hex 11 07, [(hex 10 07, Pl), (hex 11 06, Pl), (hex 12 07, Pl), (hex 12 08, Pl), (hex 11 08, Pl), (hex 10 08, Pl)]),
  (hex 11 08, [(hex 10 08, Pl), (hex 11 07, Pl), (hex 12 08, Pl), (hex 12 09, Pl), (hex 11 09, Pl), (hex 10 09, Pl)]),
  (hex 11 09, [(hex 10 09, Pl), (hex 11 08, Pl), (hex 12 09, Pl), (hex 12 10, Pl), (hex 11 10, Pl), (hex 10 10, Pl)]),
  (hex 11 10, [(hex 10 10, Pl), (hex 11 09, Pl), (hex 12 10, Pl), (hex 12 11, Pl), (hex 11 11, Pl), (hex 10 11, Pl)]),
  (hex 11 11, [(hex 10 11, Pl), (hex 11 10, Pl), (hex 12 11, Pl), (hex 12 12, Pl), (hex 11 12, Pl), (hex 10 12, Pl)]),
  (hex 11 12, [(hex 10 12, Pl), (hex 11 11, Pl), (hex 12 12, Pl)]),
  (hex 12 00, [(hex 13 00, Pl), (hex 12 01, Pl), (hex 11 00, Pl)]),
  (hex 12 01, [(hex 11 00, Pl), (hex 12 00, Pl), (hex 13 00, Pl), (hex 13 01, Pl), (hex 12 02, Pl), (hex 11 01, Pl)]),
  (hex 12 02, [(hex 11 01, Pl), (hex 12 01, Pl), (hex 13 01, Pl), (hex 13 02, Pl), (hex 12 03, Pl), (hex 11 02, Pl)]),
  (hex 12 03, [(hex 11 02, Pl), (hex 12 02, Pl), (hex 13 02, Pl), (hex 13 03, Pl), (hex 12 04, Pl), (hex 11 03, Pl)]),
  (hex 12 04, [(hex 11 03, Pl), (hex 12 03, Pl), (hex 13 03, Pl), (hex 13 04, Pl), (hex 12 05, Pl), (hex 11 04, Pl)]),
  (hex 12 05, [(hex 11 04, Pl), (hex 12 04, Pl), (hex 13 04, Pl), (hex 13 05, Pl), (hex 12 06, Pl), (hex 11 05, Pl)]),
  (hex 12 06, [(hex 11 05, Pl), (hex 12 05, Pl), (hex 13 05, Pl), (hex 13 06, Pl), (hex 12 07, Pl), (hex 11 06, Pl)]),
  (hex 12 07, [(hex 11 06, Pl), (hex 12 06, Pl), (hex 13 06, Pl), (hex 13 07, Pl), (hex 12 08, Pl), (hex 11 07, Pl)]),
  (hex 12 08, [(hex 11 07, Pl), (hex 12 07, Pl), (hex 13 07, Pl), (hex 13 08, Pl), (hex 12 09, Pl), (hex 11 08, Pl)]),
  (hex 12 09, [(hex 11 08, Pl), (hex 12 08, Pl), (hex 13 08, Pl), (hex 13 09, Pl), (hex 12 10, Pl), (hex 11 09, Pl)]),
  (hex 12 10, [(hex 11 09, Pl), (hex 12 09, Pl), (hex 13 09, Pl), (hex 13 10, Pl), (hex 12 11, Pl), (hex 11 10, Pl)]),
  (hex 12 11, [(hex 11 10, Pl), (hex 12 10, Pl), (hex 13 10, Pl), (hex 13 11, Pl), (hex 12 12, Pl), (hex 11 11, Pl)]),
  (hex 12 12, [(hex 11 11, Pl), (hex 12 11, Pl), (hex 13 11, Pl), (hex 13 12, Pl), (hex 11 12, Pl)]),
  (hex 13 00, [(hex 12 00, Pl), (hex 14 00, Pl), (hex 14 01, Pl), (hex 13 01, Pl), (hex 12 01, Pl)]),
  (hex 13 01, [(hex 12 01, Pl), (hex 13 00, Pl), (hex 14 01, Pl), (hex 14 02, Pl), (hex 13 02, Pl), (hex 12 02, Pl)]),
  (hex 13 02, [(hex 12 02, Pl), (hex 13 01, Pl), (hex 14 02, Pl), (hex 14 03, Pl), (hex 13 03, Pl), (hex 12 03, Pl)]),
  (hex 13 03, [(hex 12 03, Pl), (hex 13 02, Pl), (hex 14 03, Pl), (hex 14 04, Pl), (hex 13 04, Pl), (hex 12 04, Pl)]),
  (hex 13 04, [(hex 12 04, Pl), (hex 13 03, Pl), (hex 14 04, Pl), (hex 14 05, Pl), (hex 13 05, Pl), (hex 12 05, Pl)]),
  (hex 13 05, [(hex 12 05, Pl), (hex 13 04, Pl), (hex 14 05, Pl), (hex 14 06, Pl), (hex 13 06, Pl), (hex 12 06, Pl)]),
  (hex 13 06, [(hex 12 06, Pl), (hex 13 05, Pl), (hex 14 06, Pl), (hex 14 07, Pl), (hex 13 07, Pl), (hex 12 07, Pl)]),
  (hex 13 07, [(hex 12 07, Pl), (hex 13 06, Pl), (hex 14 07, Pl), (hex 14 08, Pl), (hex 13 08, Pl), (hex 12 08, Pl)]),
  (hex 13 08, [(hex 12 08, Pl), (hex 13 07, Pl), (hex 14 08, Pl), (hex 14 09, Pl), (hex 13 09, Pl), (hex 12 09, Pl)]),
  (hex 13 09, [(hex 12 09, Pl), (hex 13 08, Pl), (hex 14 09, Pl), (hex 14 10, Pl), (hex 13 10, Pl), (hex 12 10, Pl)]),
  (hex 13 10, [(hex 12 10, Pl), (hex 13 09, Pl), (hex 14 10, Pl), (hex 14 11, Pl), (hex 13 11, Pl), (hex 12 11, Pl)]),
  (hex 13 11, [(hex 12 11, Pl), (hex 13 10, Pl), (hex 14 11, Pl), (hex 14 12, Pl), (hex 13 12, Pl), (hex 12 12, Pl)]),
  (hex 13 12, [(hex 12 12, Pl), (hex 13 11, Pl), (hex 14 12, Pl)]),
  (hex 14 00, [(hex 15 00, Pl), (hex 14 01, Pl), (hex 13 00, Pl)]),
  (hex 14 01, [(hex 13 00, Pl), (hex 14 00, Pl), (hex 15 00, Pl), (hex 15 01, Pl), (hex 14 02, Pl), (hex 13 01, Pl)]),
  (hex 14 02, [(hex 13 01, Pl), (hex 14 01, Pl), (hex 15 01, Pl), (hex 15 02, Pl), (hex 14 03, Pl), (hex 13 02, Pl)]),
  (hex 14 03, [(hex 13 02, Pl), (hex 14 02, Pl), (hex 15 02, Pl), (hex 15 03, Pl), (hex 14 04, Pl), (hex 13 03, Pl)]),
  (hex 14 04, [(hex 13 03, Pl), (hex 14 03, Pl), (hex 15 03, Pl), (hex 15 04, Pl), (hex 14 05, Pl), (hex 13 04, Pl)]),
  (hex 14 05, [(hex 13 04, Pl), (hex 14 04, Pl), (hex 15 04, Pl), (hex 15 05, Pl), (hex 14 06, Pl), (hex 13 05, Pl)]),
  (hex 14 06, [(hex 13 05, Pl), (hex 14 05, Pl), (hex 15 05, Pl), (hex 15 06, Pl), (hex 14 07, Pl), (hex 13 06, Pl)]),
  (hex 14 07, [(hex 13 06, Pl), (hex 14 06, Pl), (hex 15 06, Pl), (hex 15 07, Pl), (hex 14 08, Pl), (hex 13 07, Pl)]),
  (hex 14 08, [(hex 13 07, Pl), (hex 14 07, Pl), (hex 15 07, Pl), (hex 15 08, Pl), (hex 14 09, Pl), (hex 13 08, Pl)]),
  (hex 14 09, [(hex 13 08, Pl), (hex 14 08, Pl), (hex 15 08, Pl), (hex 15 09, Pl), (hex 14 10, Pl), (hex 13 09, Pl)]),
  (hex 14 10, [(hex 13 09, Pl), (hex 14 09, Pl), (hex 15 09, Pl), (hex 15 10, Pl), (hex 14 11, Pl), (hex 13 10, Pl)]),
  (hex 14 11, [(hex 13 10, Pl), (hex 14 10, Pl), (hex 15 10, Pl), (hex 15 11, Pl), (hex 14 12, Pl), (hex 13 11, Pl)]),
  (hex 14 12, [(hex 13 11, Pl), (hex 14 11, Pl), (hex 15 11, Pl), (hex 15 12, Pl), (hex 13 12, Pl)]),
  (hex 15 00, [(hex 14 00, Pl), (hex 16 00, Pl), (hex 16 01, Pl), (hex 15 01, Pl), (hex 14 01, Pl)]),
  (hex 15 01, [(hex 14 01, Pl), (hex 15 00, Pl), (hex 16 01, Pl), (hex 16 02, Pl), (hex 15 02, Pl), (hex 14 02, Pl)]),
  (hex 15 02, [(hex 14 02, Pl), (hex 15 01, Pl), (hex 16 02, Pl), (hex 16 03, Pl), (hex 15 03, Pl), (hex 14 03, Pl)]),
  (hex 15 03, [(hex 14 03, Pl), (hex 15 02, Pl), (hex 16 03, Pl), (hex 16 04, Pl), (hex 15 04, Pl), (hex 14 04, Pl)]),
  (hex 15 04, [(hex 14 04, Pl), (hex 15 03, Pl), (hex 16 04, Pl), (hex 16 05, Pl), (hex 15 05, Pl), (hex 14 05, Pl)]),
  (hex 15 05, [(hex 14 05, Pl), (hex 15 04, Pl), (hex 16 05, Pl), (hex 16 06, Pl), (hex 15 06, Pl), (hex 14 06, Pl)]),
  (hex 15 06, [(hex 14 06, Pl), (hex 15 05, Pl), (hex 16 06, Pl), (hex 16 07, Pl), (hex 15 07, Pl), (hex 14 07, Pl)]),
  (hex 15 07, [(hex 14 07, Pl), (hex 15 06, Pl), (hex 16 07, Pl), (hex 16 08, Pl), (hex 15 08, Pl), (hex 14 08, Pl)]),
  (hex 15 08, [(hex 14 08, Pl), (hex 15 07, Pl), (hex 16 08, Pl), (hex 16 09, Pl), (hex 15 09, Pl), (hex 14 09, Pl)]),
  (hex 15 09, [(hex 14 09, Pl), (hex 15 08, Pl), (hex 16 09, Pl), (hex 16 10, Pl), (hex 15 10, Pl), (hex 14 10, Pl)]),
  (hex 15 10, [(hex 14 10, Pl), (hex 15 09, Pl), (hex 16 10, Pl), (hex 16 11, Pl), (hex 15 11, Pl), (hex 14 11, Pl)]),
  (hex 15 11, [(hex 14 11, Pl), (hex 15 10, Pl), (hex 16 11, Pl), (hex 16 12, Pl), (hex 15 12, Pl), (hex 14 12, Pl)]),
  (hex 15 12, [(hex 14 12, Pl), (hex 15 11, Pl), (hex 16 12, Pl)]),
  (hex 16 00, [(hex 17 00, Pl), (hex 16 01, Pl), (hex 15 00, Pl)]),
  (hex 16 01, [(hex 15 00, Pl), (hex 16 00, Pl), (hex 17 00, Pl), (hex 17 01, Pl), (hex 16 02, Pl), (hex 15 01, Pl)]),
  (hex 16 02, [(hex 15 01, Pl), (hex 16 01, Pl), (hex 17 01, Pl), (hex 17 02, Pl), (hex 16 03, Pl), (hex 15 02, Pl)]),
  (hex 16 03, [(hex 15 02, Pl), (hex 16 02, Pl), (hex 17 02, Pl), (hex 17 03, Pl), (hex 16 04, Pl), (hex 15 03, Pl)]),
  (hex 16 04, [(hex 15 03, Pl), (hex 16 03, Pl), (hex 17 03, Pl), (hex 17 04, Pl), (hex 16 05, Pl), (hex 15 04, Pl)]),
  (hex 16 05, [(hex 15 04, Pl), (hex 16 04, Pl), (hex 17 04, Pl), (hex 17 05, Pl), (hex 16 06, Pl), (hex 15 05, Pl)]),
  (hex 16 06, [(hex 15 05, Pl), (hex 16 05, Pl), (hex 17 05, Pl), (hex 17 06, Pl), (hex 16 07, Pl), (hex 15 06, Pl)]),
  (hex 16 07, [(hex 15 06, Pl), (hex 16 06, Pl), (hex 17 06, Pl), (hex 17 07, Pl), (hex 16 08, Pl), (hex 15 07, Pl)]),
  (hex 16 08, [(hex 15 07, Pl), (hex 16 07, Pl), (hex 17 07, Pl), (hex 17 08, Pl), (hex 16 09, Pl), (hex 15 08, Pl)]),
  (hex 16 09, [(hex 15 08, Pl), (hex 16 08, Pl), (hex 17 08, Pl), (hex 17 09, Pl), (hex 16 10, Pl), (hex 15 09, Pl)]),
  (hex 16 10, [(hex 15 09, Pl), (hex 16 09, Pl), (hex 17 09, Pl), (hex 17 10, Pl), (hex 16 11, Pl), (hex 15 10, Pl)]),
  (hex 16 11, [(hex 15 10, Pl), (hex 16 10, Pl), (hex 17 10, Pl), (hex 17 11, Pl), (hex 16 12, Pl), (hex 15 11, Pl)]),
  (hex 16 12, [(hex 15 11, Pl), (hex 16 11, Pl), (hex 17 11, Pl), (hex 17 12, Pl), (hex 15 12, Pl)]),
  (hex 17 00, [(hex 16 00, Pl), (hex 18 00, Pl), (hex 18 01, Pl), (hex 17 01, Pl), (hex 16 01, Pl)]),
  (hex 17 01, [(hex 16 01, Pl), (hex 17 00, Pl), (hex 18 01, Pl), (hex 18 02, Pl), (hex 17 02, Pl), (hex 16 02, Pl)]),
  (hex 17 02, [(hex 16 02, Pl), (hex 17 01, Pl), (hex 18 02, Pl), (hex 18 03, Pl), (hex 17 03, Pl), (hex 16 03, Pl)]),
  (hex 17 03, [(hex 16 03, Pl), (hex 17 02, Pl), (hex 18 03, Pl), (hex 18 04, Pl), (hex 17 04, Pl), (hex 16 04, Pl)]),
  (hex 17 04, [(hex 16 04, Pl), (hex 17 03, Pl), (hex 18 04, Pl), (hex 18 05, Pl), (hex 17 05, Pl), (hex 16 05, Pl)]),
  (hex 17 05, [(hex 16 05, Pl), (hex 17 04, Pl), (hex 18 05, Pl), (hex 18 06, Pl), (hex 17 06, Pl), (hex 16 06, Pl)]),
  (hex 17 06, [(hex 16 06, Pl), (hex 17 05, Pl), (hex 18 06, Pl), (hex 18 07, Pl), (hex 17 07, Pl), (hex 16 07, Pl)]),
  (hex 17 07, [(hex 16 07, Pl), (hex 17 06, Pl), (hex 18 07, Pl), (hex 18 08, Pl), (hex 17 08, Pl), (hex 16 08, Pl)]),
  (hex 17 08, [(hex 16 08, Pl), (hex 17 07, Pl), (hex 18 08, Pl), (hex 18 09, Pl), (hex 17 09, Pl), (hex 16 09, Pl)]),
  (hex 17 09, [(hex 16 09, Pl), (hex 17 08, Pl), (hex 18 09, Pl), (hex 18 10, Pl), (hex 17 10, Pl), (hex 16 10, Pl)]),
  (hex 17 10, [(hex 16 10, Pl), (hex 17 09, Pl), (hex 18 10, Pl), (hex 18 11, Pl), (hex 17 11, Pl), (hex 16 11, Pl)]),
  (hex 17 11, [(hex 16 11, Pl), (hex 17 10, Pl), (hex 18 11, Pl), (hex 18 12, Pl), (hex 17 12, Pl), (hex 16 12, Pl)]),
  (hex 17 12, [(hex 16 12, Pl), (hex 17 11, Pl), (hex 18 12, Pl)]),
  (hex 18 00, [(hex 19 00, Pl), (hex 18 01, Pl), (hex 17 00, Pl)]),
  (hex 18 01, [(hex 17 00, Pl), (hex 18 00, Pl), (hex 19 00, Pl), (hex 19 01, Pl), (hex 18 02, Pl), (hex 17 01, Pl)]),
  (hex 18 02, [(hex 17 01, Pl), (hex 18 01, Pl), (hex 19 01, Pl), (hex 19 02, Pl), (hex 18 03, Pl), (hex 17 02, Pl)]),
  (hex 18 03, [(hex 17 02, Pl), (hex 18 02, Pl), (hex 19 02, Pl), (hex 19 03, Pl), (hex 18 04, Pl), (hex 17 03, Pl)]),
  (hex 18 04, [(hex 17 03, Pl), (hex 18 03, Pl), (hex 19 03, Pl), (hex 19 04, Pl), (hex 18 05, Pl), (hex 17 04, Pl)]),
  (hex 18 05, [(hex 17 04, Pl), (hex 18 04, Pl), (hex 19 04, Pl), (hex 19 05, Pl), (hex 18 06, Pl), (hex 17 05, Pl)]),
  (hex 18 06, [(hex 17 05, Pl), (hex 18 05, Pl), (hex 19 05, Pl), (hex 19 06, Pl), (hex 18 07, Pl), (hex 17 06, Pl)]),
  (hex 18 07, [(hex 17 06, Pl), (hex 18 06, Pl), (hex 19 06, Pl), (hex 19 07, Pl), (hex 18 08, Pl), (hex 17 07, Pl)]),
  (hex 18 08, [(hex 17 07, Pl), (hex 18 07, Pl), (hex 19 07, Pl), (hex 19 08, Pl), (hex 18 09, Pl), (hex 17 08, Pl)]),
  (hex 18 09, [(hex 17 08, Pl), (hex 18 08, Pl), (hex 19 08, Pl), (hex 19 09, Pl), (hex 18 10, Pl), (hex 17 09, Pl)]),
  (hex 18 10, [(hex 17 09, Pl), (hex 18 09, Pl), (hex 19 09, Pl), (hex 19 10, Pl), (hex 18 11, Pl), (hex 17 10, Pl)]),
  (hex 18 11, [(hex 17 10, Pl), (hex 18 10, Pl), (hex 19 10, Pl), (hex 19 11, Pl), (hex 18 12, Pl), (hex 17 11, Pl)]),
  (hex 18 12, [(hex 17 11, Pl), (hex 18 11, Pl), (hex 19 11, Pl), (hex 19 12, Pl), (hex 17 12, Pl)]),
  (hex 19 00, [(hex 18 00, Pl), (hex 20 00, Pl), (hex 20 01, Pl), (hex 19 01, Pl), (hex 18 01, Pl)]),
  (hex 19 01, [(hex 18 01, Pl), (hex 19 00, Pl), (hex 20 01, Pl), (hex 20 02, Pl), (hex 19 02, Pl), (hex 18 02, Pl)]),
  (hex 19 02, [(hex 18 02, Pl), (hex 19 01, Pl), (hex 20 02, Pl), (hex 20 03, Pl), (hex 19 03, Pl), (hex 18 03, Pl)]),
  (hex 19 03, [(hex 18 03, Pl), (hex 19 02, Pl), (hex 20 03, Pl), (hex 20 04, Pl), (hex 19 04, Pl), (hex 18 04, Pl)]),
  (hex 19 04, [(hex 18 04, Pl), (hex 19 03, Pl), (hex 20 04, Pl), (hex 20 05, Pl), (hex 19 05, Pl), (hex 18 05, Pl)]),
  (hex 19 05, [(hex 18 05, Pl), (hex 19 04, Pl), (hex 20 05, Pl), (hex 20 06, Pl), (hex 19 06, Pl), (hex 18 06, Pl)]),
  (hex 19 06, [(hex 18 06, Pl), (hex 19 05, Pl), (hex 20 06, Pl), (hex 20 07, Pl), (hex 19 07, Pl), (hex 18 07, Pl)]),
  (hex 19 07, [(hex 18 07, Pl), (hex 19 06, Pl), (hex 20 07, Pl), (hex 20 08, Pl), (hex 19 08, Pl), (hex 18 08, Pl)]),
  (hex 19 08, [(hex 18 08, Pl), (hex 19 07, Pl), (hex 20 08, Pl), (hex 20 09, Pl), (hex 19 09, Pl), (hex 18 09, Pl)]),
  (hex 19 09, [(hex 18 09, Pl), (hex 19 08, Pl), (hex 20 09, Pl), (hex 20 10, Pl), (hex 19 10, Pl), (hex 18 10, Pl)]),
  (hex 19 10, [(hex 18 10, Pl), (hex 19 09, Pl), (hex 20 10, Pl), (hex 20 11, Pl), (hex 19 11, Pl), (hex 18 11, Pl)]),
  (hex 19 11, [(hex 18 11, Pl), (hex 19 10, Pl), (hex 20 11, Pl), (hex 20 12, Pl), (hex 19 12, Pl), (hex 18 12, Pl)]),
  (hex 19 12, [(hex 18 12, Pl), (hex 19 11, Pl), (hex 20 12, Pl)]),
  (hex 20 00, [(hex 21 00, Pl), (hex 20 01, Pl), (hex 19 00, Pl)]),
  (hex 20 01, [(hex 19 00, Pl), (hex 20 00, Pl), (hex 21 00, Pl), (hex 21 01, Pl), (hex 20 02, Pl), (hex 19 01, Pl)]),
  (hex 20 02, [(hex 19 01, Pl), (hex 20 01, Pl), (hex 21 01, Pl), (hex 21 02, Pl), (hex 20 03, Pl), (hex 19 02, Pl)]),
  (hex 20 03, [(hex 19 02, Pl), (hex 20 02, Pl), (hex 21 02, Pl), (hex 21 03, Pl), (hex 20 04, Pl), (hex 19 03, Pl)]),
  (hex 20 04, [(hex 19 03, Pl), (hex 20 03, Pl), (hex 21 03, Pl), (hex 21 04, Pl), (hex 20 05, Pl), (hex 19 04, Pl)]),
  (hex 20 05, [(hex 19 04, Pl), (hex 20 04, Pl), (hex 21 04, Pl), (hex 21 05, Pl), (hex 20 06, Pl), (hex 19 05, Pl)]),
  (hex 20 06, [(hex 19 05, Pl), (hex 20 05, Pl), (hex 21 05, Pl), (hex 21 06, Pl), (hex 20 07, Pl), (hex 19 06, Pl)]),
  (hex 20 07, [(hex 19 06, Pl), (hex 20 06, Pl), (hex 21 06, Pl), (hex 21 07, Pl), (hex 20 08, Pl), (hex 19 07, Pl)]),
  (hex 20 08, [(hex 19 07, Pl), (hex 20 07, Pl), (hex 21 07, Pl), (hex 21 08, Pl), (hex 20 09, Pl), (hex 19 08, Pl)]),
  (hex 20 09, [(hex 19 08, Pl), (hex 20 08, Pl), (hex 21 08, Pl), (hex 21 09, Pl), (hex 20 10, Pl), (hex 19 09, Pl)]),
  (hex 20 10, [(hex 19 09, Pl), (hex 20 09, Pl), (hex 21 09, Pl), (hex 21 10, Pl), (hex 20 11, Pl), (hex 19 10, Pl)]),
  (hex 20 11, [(hex 19 10, Pl), (hex 20 10, Pl), (hex 21 10, Pl), (hex 21 11, Pl), (hex 20 12, Pl), (hex 19 11, Pl)]),
  (hex 20 12, [(hex 19 11, Pl), (hex 20 11, Pl), (hex 21 11, Pl), (hex 21 12, Pl), (hex 19 12, Pl)]),
  (hex 21 00, [(hex 20 00, Pl), (hex 22 00, Pl), (hex 22 01, Pl), (hex 21 01, Pl), (hex 20 01, Pl)]),
  (hex 21 01, [(hex 20 01, Pl), (hex 21 00, Pl), (hex 22 01, Pl), (hex 22 02, Pl), (hex 21 02, Pl), (hex 20 02, Pl)]),
  (hex 21 02, [(hex 20 02, Pl), (hex 21 01, Pl), (hex 22 02, Pl), (hex 22 03, Pl), (hex 21 03, Pl), (hex 20 03, Pl)]),
  (hex 21 03, [(hex 20 03, Pl), (hex 21 02, Pl), (hex 22 03, Pl), (hex 22 04, Pl), (hex 21 04, Pl), (hex 20 04, Pl)]),
  (hex 21 04, [(hex 20 04, Pl), (hex 21 03, Pl), (hex 22 04, Pl), (hex 22 05, Pl), (hex 21 05, Pl), (hex 20 05, Pl)]),
  (hex 21 05, [(hex 20 05, Pl), (hex 21 04, Pl), (hex 22 05, Pl), (hex 22 06, Pl), (hex 21 06, Pl), (hex 20 06, Pl)]),
  (hex 21 06, [(hex 20 06, Pl), (hex 21 05, Pl), (hex 22 06, Pl), (hex 22 07, Pl), (hex 21 07, Pl), (hex 20 07, Pl)]),
  (hex 21 07, [(hex 20 07, Pl), (hex 21 06, Pl), (hex 22 07, Pl), (hex 22 08, Pl), (hex 21 08, Pl), (hex 20 08, Pl)]),
  (hex 21 08, [(hex 20 08, Pl), (hex 21 07, Pl), (hex 22 08, Pl), (hex 22 09, Pl), (hex 21 09, Pl), (hex 20 09, Pl)]),
  (hex 21 09, [(hex 20 09, Pl), (hex 21 08, Pl), (hex 22 09, Pl), (hex 22 10, Pl), (hex 21 10, Pl), (hex 20 10, Pl)]),
  (hex 21 10, [(hex 20 10, Pl), (hex 21 09, Pl), (hex 22 10, Pl), (hex 22 11, Pl), (hex 21 11, Pl), (hex 20 11, Pl)]),
  (hex 21 11, [(hex 20 11, Pl), (hex 21 10, Pl), (hex 22 11, Pl), (hex 22 12, Pl), (hex 21 12, Pl), (hex 20 12, Pl)]),
  (hex 21 12, [(hex 20 12, Pl), (hex 21 11, Pl), (hex 22 12, Pl)]),
  (hex 22 00, [(hex 22 01, Pl), (hex 21 00, Pl)]),
  (hex 22 01, [(hex 21 00, Pl), (hex 22 00, Pl), (hex 22 02, Pl), (hex 21 01, Pl)]),
  (hex 22 02, [(hex 21 01, Pl), (hex 22 01, Pl), (hex 22 03, Pl), (hex 21 02, Pl)]),
  (hex 22 03, [(hex 21 02, Pl), (hex 22 02, Pl), (hex 22 04, Pl), (hex 21 03, Pl)]),
  (hex 22 04, [(hex 21 03, Pl), (hex 22 03, Pl), (hex 22 05, Pl), (hex 21 04, Pl)]),
  (hex 22 05, [(hex 21 04, Pl), (hex 22 04, Pl), (hex 22 06, Pl), (hex 21 05, Pl)]),
  (hex 22 06, [(hex 21 05, Pl), (hex 22 05, Pl), (hex 22 07, Pl), (hex 21 06, Pl)]),
  (hex 22 07, [(hex 21 06, Pl), (hex 22 06, Pl), (hex 22 08, Pl), (hex 21 07, Pl)]),
  (hex 22 08, [(hex 21 07, Pl), (hex 22 07, Pl), (hex 22 09, Pl), (hex 21 08, Pl)]),
  (hex 22 09, [(hex 21 08, Pl), (hex 22 08, Pl), (hex 22 10, Pl), (hex 21 09, Pl)]),
  (hex 22 10, [(hex 21 09, Pl), (hex 22 09, Pl), (hex 22 11, Pl), (hex 21 10, Pl)]),
  (hex 22 11, [(hex 21 10, Pl), (hex 22 10, Pl), (hex 22 12, Pl), (hex 21 11, Pl)]),
  (hex 22 12, [(hex 21 11, Pl), (hex 22 11, Pl), (hex 21 12, Pl)])
      ]

public export
PartialGameMap : Map
PartialGameMap = MkMap positions []
  where
    positions : List (Pos, Terrain)
    positions = [(hex 0 0, Clear),
                 (hex 0 1, Clear),
                 (hex 0 2, Clear),
                 (hex 0 3, SupplySource Axis $ Clear),
                 (hex 0 4, Clear),
                 (hex 1 0, Clear),
                 (hex 1 1, Clear),
                 (hex 1 2, Clear),
                 (hex 1 3, Clear),
                 (hex 1 4, Clear),
                 (hex 2 0, Clear),
                 (hex 2 1, Clear),
                 (hex 2 2, Clear),
                 (hex 2 3, Clear),
                 (hex 2 4, Clear),
                 (hex 3 0, Clear),
                 (hex 3 1, Clear),
                 (hex 3 2, Clear),
                 (hex 3 3, Clear),
                 (hex 3 4, Clear),
                 (hex 4 0, Clear),
                 (hex 4 1, Clear),
                 (hex 4 2, Clear),
                 (hex 4 3, Clear),
                 (hex 4 4, Clear)]

public export
FullGameMap : Map
FullGameMap = MkMap positions links
  where
    mkPosition : (c : Nat) -> (r : Nat) -> Maybe ( Pos, Terrain)
    mkPosition c r with (natToFin c 23, natToFin r 13, isLTE c 22, isLTE r 12)
      mkPosition c r | (Just col, Just row, Yes cprf, Yes rprf) =
           let terrain = index col $ index row terrains
           in Just (hex col row, terrain)
      mkPosition c r | (_, _, _, _) = Nothing

    positions : List (Pos, Terrain)
    positions = catMaybes [ mkPosition c r | c <- [ 0 .. 22 ], r <- [ 0 .. 12 ]]


module ProcessLib

import Data.Fuel
import System.Concurrency.Channels

%default total

export
data MessagePID : (iface : reqType -> Type) -> Type where
     MkMessage : PID -> MessagePID iface

public export
NoRecv : Void -> Type
NoRecv = const Void

public export
data ProcState = Ready | Sent | Looping

public export
data Process : (iface : reqType -> Type) ->
               Type -> ProcState -> ProcState -> Type where
     Request : MessagePID service_iface ->
               (msg : service_reqType) ->
               Process iface (service_iface msg) st st
     Respond : ((msg : reqType) -> Process iface (iface msg) Ready Ready) ->
               Process iface (Maybe reqType) st Sent
     Spawn : Process service_iface () Ready Looping ->
             Process iface (Maybe (MessagePID service_iface)) st st

     Loop : Inf (Process iface a Ready Looping) ->
            Process iface a Sent Looping
     Action : IO a -> Process iface a st st
     Pure : a -> Process iface a st st
     (>>=) : Process iface a st1 st2 -> (a -> Process iface b st2 st3) ->
             Process iface b st1 st3

export total
run : Fuel -> Process iface t in_state out_state -> IO (Maybe t)
run fuel (Request {service_iface} (MkMessage process) msg)
          = do Just chan <- connect process
                    | _ => pure Nothing
               ok <- unsafeSend chan msg
               if ok then do Just x <- unsafeRecv (service_iface msg) chan
                                  | Nothing => pure Nothing
                             pure (Just x)
                     else pure Nothing
run fuel (Respond {reqType} calc)
          = do Just sender <- listen 1
                    | Nothing => pure (Just Nothing)
               Just msg <- unsafeRecv reqType sender
                    | Nothing => pure (Just Nothing)
               Just res <- run fuel (calc msg)
                    | Nothing => pure Nothing
               unsafeSend sender res
               pure (Just (Just msg))
run (More fuel) (Loop proc) = run fuel proc
run fuel (Spawn proc) = do Just pid <- spawn (do run fuel proc
                                                 pure ())
                                | Nothing => pure (Just Nothing)
                           pure (Just (Just (MkMessage pid)))
run fuel (Action act) = do res <- act
                           pure (Just res)
run fuel (Pure val) = pure (Just val)
run fuel (act >>= next) = do Just x <- run fuel act
                                  | Nothing => pure Nothing
                             run fuel (next x)
run Dry _ = pure Nothing

public export
Service : (iface : reqType -> Type) -> Type -> Type
Service iface a = Process iface a Ready Looping

public export
Client : Type -> Type
Client a = Process NoRecv a Ready Ready

partial export
runProc : Process iface () in_state out_state -> IO ()
runProc proc = do run forever proc
                  pure ()


module Language.Reflection.TTImp

import public Language.Reflection.TT

%default total

-- Unchecked terms and declarations in the intermediate language
mutual
  public export
  data BindMode = PI Count | PATTERN | NONE

  -- For as patterns matching linear arguments, select which side is
  -- consumed
  public export
  data UseSide = UseLeft | UseRight

  public export
  data DotReason = NonLinearVar
                 | VarApplied
                 | NotConstructor
                 | ErasedArg
                 | UserDotted
                 | UnknownDot
                 | UnderAppliedCon

  public export
  data TTImp : Type where
       IVar : FC -> Name -> TTImp
       IPi : FC -> Count -> PiInfo TTImp -> Maybe Name ->
             (argTy : TTImp) -> (retTy : TTImp) -> TTImp
       ILam : FC -> Count -> PiInfo TTImp -> Maybe Name ->
              (argTy : TTImp) -> (lamTy : TTImp) -> TTImp
       ILet : FC -> (lhsFC : FC) -> Count -> Name ->
              (nTy : TTImp) -> (nVal : TTImp) ->
              (scope : TTImp) -> TTImp
       ICase : FC -> TTImp -> (ty : TTImp) ->
               List Clause -> TTImp
       ILocal : FC -> List Decl -> TTImp -> TTImp
       IUpdate : FC -> List IFieldUpdate -> TTImp -> TTImp

       IApp : FC -> TTImp -> TTImp -> TTImp
       INamedApp : FC -> TTImp -> Name -> TTImp -> TTImp
       IAutoApp : FC -> TTImp -> TTImp -> TTImp
       IWithApp : FC -> TTImp -> TTImp -> TTImp

       ISearch : FC -> (depth : Nat) -> TTImp
       IAlternative : FC -> AltType -> List TTImp -> TTImp
       IRewrite : FC -> TTImp -> TTImp -> TTImp

       -- Any implicit bindings in the scope should be bound here, using
       -- the given binder
       IBindHere : FC -> BindMode -> TTImp -> TTImp
       -- A name which should be implicitly bound
       IBindVar : FC -> String -> TTImp
       -- An 'as' pattern, valid on the LHS of a clause only
       IAs : FC -> (nameFC : FC) -> UseSide -> Name -> TTImp -> TTImp
       -- A 'dot' pattern, i.e. one which must also have the given value
       -- by unification
       IMustUnify : FC -> DotReason -> TTImp -> TTImp

       -- Laziness annotations
       IDelayed : FC -> LazyReason -> TTImp -> TTImp -- the type
       IDelay : FC -> TTImp -> TTImp -- delay constructor
       IForce : FC -> TTImp -> TTImp

       -- Quasiquotation
       IQuote : FC -> TTImp -> TTImp
       IQuoteName : FC -> Name -> TTImp
       IQuoteDecl : FC -> List Decl -> TTImp
       IUnquote : FC -> TTImp -> TTImp

       IPrimVal : FC -> (c : Constant) -> TTImp
       IType : FC -> TTImp
       IHole : FC -> String -> TTImp

       -- An implicit value, solved by unification, but which will also be
       -- bound (either as a pattern variable or a type variable) if unsolved
       -- at the end of elaborator
       Implicit : FC -> (bindIfUnsolved : Bool) -> TTImp
       IWithUnambigNames : FC -> List Name -> TTImp -> TTImp

  public export
  data IFieldUpdate : Type where
       ISetField : (path : List String) -> TTImp -> IFieldUpdate
       ISetFieldApp : (path : List String) -> TTImp -> IFieldUpdate

  public export
  data AltType : Type where
       FirstSuccess : AltType
       Unique : AltType
       UniqueDefault : TTImp -> AltType

  public export
  data FnOpt : Type where
       Inline : FnOpt
       TCInline : FnOpt
       -- Flag means the hint is a direct hint, not a function which might
       -- find the result (e.g. chasing parent interface dictionaries)
       Hint : Bool -> FnOpt
       -- Flag means to use as a default if all else fails
       GlobalHint : Bool -> FnOpt
       ExternFn : FnOpt
       -- Defined externally, list calling conventions
       ForeignFn : List TTImp -> FnOpt
       -- assume safe to cancel arguments in unification
       Invertible : FnOpt
       Totality : TotalReq -> FnOpt
       Macro : FnOpt
       SpecArgs : List Name -> FnOpt

  public export
  data ITy : Type where
       MkTy : FC -> (nameFC : FC) -> (n : Name) -> (ty : TTImp) -> ITy

  public export
  data DataOpt : Type where
       SearchBy : List Name -> DataOpt -- determining arguments
       NoHints : DataOpt -- Don't generate search hints for constructors
       UniqueSearch : DataOpt -- auto implicit search must check result is unique
       External : DataOpt -- implemented externally
       NoNewtype : DataOpt -- don't apply newtype optimisation

  public export
  data Data : Type where
       MkData : FC -> (n : Name) -> (tycon : TTImp) ->
                (opts : List DataOpt) ->
                (datacons : List ITy) -> Data
       MkLater : FC -> (n : Name) -> (tycon : TTImp) -> Data

  public export
  data IField : Type where
       MkIField : FC -> Count -> PiInfo TTImp -> Name -> TTImp ->
                  IField

  public export
  data Record : Type where
       MkRecord : FC -> (n : Name) ->
                  (params : List (Name, Count, PiInfo TTImp, TTImp)) ->
                  (conName : Name) ->
                  (fields : List IField) ->
                  Record

  public export
  data WithFlag = Syntactic

  public export
  data Clause : Type where
       PatClause : FC -> (lhs : TTImp) -> (rhs : TTImp) -> Clause
       WithClause : FC -> (lhs : TTImp) -> (wval : TTImp) ->
                    (prf : Maybe Name) -> (flags : List WithFlag) ->
                    List Clause -> Clause
       ImpossibleClause : FC -> (lhs : TTImp) -> Clause

  public export
  data Decl : Type where
       IClaim : FC -> Count -> Visibility -> List FnOpt ->
                ITy -> Decl
       IData : FC -> Visibility -> Data -> Decl
       IDef : FC -> Name -> List Clause -> Decl
       IParameters : FC -> List (Name, Count, PiInfo TTImp, TTImp) ->
                     List Decl -> Decl
       IRecord : FC ->
                 Maybe String -> -- nested namespace
                 Visibility -> Record -> Decl
       INamespace : FC -> Namespace -> List Decl -> Decl
       ITransform : FC -> Name -> TTImp -> TTImp -> Decl
       IRunElabDecl : FC -> TTImp -> Decl
       ILog : Maybe (List String, Nat) -> Decl
       IBuiltin : FC -> BuiltinType -> Name -> Decl

public export
getFC : TTImp -> FC
getFC (IVar fc y)                = fc
getFC (IPi fc _ _ _ _ _)         = fc
getFC (ILam fc _ _ _ _ _)        = fc
getFC (ILet fc _ _ _ _ _ _)      = fc
getFC (ICase fc _ _ _)           = fc
getFC (ILocal fc _ _)            = fc
getFC (IUpdate fc _ _)           = fc
getFC (IApp fc _ _)              = fc
getFC (INamedApp fc _ _ _)       = fc
getFC (IAutoApp fc _ _)          = fc
getFC (IWithApp fc _ _)          = fc
getFC (ISearch fc _)             = fc
getFC (IAlternative fc _ _)      = fc
getFC (IRewrite fc _ _)          = fc
getFC (IBindHere fc _ _)         = fc
getFC (IBindVar fc _)            = fc
getFC (IAs fc _ _ _ _)           = fc
getFC (IMustUnify fc _ _)        = fc
getFC (IDelayed fc _ _)          = fc
getFC (IDelay fc _)              = fc
getFC (IForce fc _)              = fc
getFC (IQuote fc _)              = fc
getFC (IQuoteName fc _)          = fc
getFC (IQuoteDecl fc _)          = fc
getFC (IUnquote fc _)            = fc
getFC (IPrimVal fc _)            = fc
getFC (IType fc)                 = fc
getFC (IHole fc _)               = fc
getFC (Implicit fc _)            = fc
getFC (IWithUnambigNames fc _ _) = fc


module Main

import Dart.Core
import Dart.FFI

%inline
export
Point : Type
Point = Struct "Point,
// All foreign names must be fully qualified and
// the following import can always be assumed to exist:
// import 'dart:core' as $;
class Point {
  final $.int x;
  final $.int y;
  Point({this.x, this.y});
  Point.of(this.x, this.y);
}" [
  ("x", Int),
  ("y", Int)
]

Show Point where
  show pt = show (the Int (getField pt "x"), the Int (getField pt "y"))

namespace Point

  namespace New

    data Tag : Type where

    %inline
    public export
    x : Parameter Tag
    x = MkParameter "x" Int Tag

    %inline
    public export
    y : Parameter Tag
    y = MkParameter "y" Int Tag

  %inline
  public export
  new : Parameters [New.x, New.y] -> IO Point
  new ps = primIO $ prim__dart_new Point [] ps

%inline
export
Callbacks : Type
Callbacks = Struct "Callbacks,
class Callbacks {
  $.Object Function($.Object) x;
  $.Object Function($.Object) y;
  $.bool enabled;
  Callbacks({this.x, this.y, this.enabled});
  $.Object callX($.Object arg) => x(arg);
  $.Object callY($.Object arg) => y(arg);
}" [
  ("enabled", DartBool)
]

namespace Callbacks

  namespace New

    data Tag : Type where

    %inline
    public export
    x : Parameter Tag
    x = MkParameter "x" (Int -> Int) Tag

    %inline
    public export
    y : Parameter Tag
    y = MkParameter "y" (Int -> IO Int) Tag

    %inline
    public export
    enabled : Parameter Tag
    enabled = MkParameter "enabled" DartBool Tag

  %inline
  public export
  new : Parameters [Callbacks.New.x, Callbacks.New.y, Callbacks.New.enabled] -> IO Callbacks
  new ps = primIO $ prim__dart_new Callbacks [] ps

  export
  %foreign "Dart:.callX"
  callX : Callbacks -> Int -> Int

  export
  %foreign "Dart:.callY"
  callY : Callbacks -> Int -> PrimIO Int

||| A pure foreign function with a bool argument.
%foreign "Dart:ifBool,
$.Object ifBool($.bool condition, $.Object then, $.Object else_) {
  return condition ? then : else_;
}"
ifBool : DartBool -> Int -> Int -> Int

main : IO ()
main = do
  pt <- Point.new [
    x @= 42,
    y @= 37
  ]
  printLn pt

  cb <- Callbacks.new [
    x @= (\i => i * 2),
    y @= (\i => printLn i *> pure (i * 2)),
    enabled @= true
  ]
  printLn (callX cb 21)
  printLn !(primIO (callY cb 21))

  -- Dart bool
  printLn (the DartBool (cb `getField` "enabled"))
  printLn (ifBool true 1 2)
  printLn (ifBool false 1 2)
  pure ()


module IR.Event

import IR.Lens

KeyCode : Type
KeyCode = Int

record Key : Type where
  MkKey : (keyCode : KeyCode) ->
          (keyHasAlt : Bool) ->
          (keyHasCmd : Bool) ->
          (keyHasCtrl : Bool) ->
          (keyHasShift : Bool) ->
          Key

instance Eq Key where
  (==) (MkKey a b c d e) (MkKey a' b' c' d' e') = a == a' && b == b' && c == c' && d == d' && e == e'

-- Should be the Monoid instance:
infixl 3 <!>
(<!>) : Ordering -> Ordering -> Ordering
(<!>) EQ r = r
(<!>) l  r = l

-- Should be the Ord instance:
compareBool : Bool -> Bool -> Ordering
compareBool False False = EQ
compareBool False True = LT
compareBool True False = GT
compareBool True True = EQ

instance Ord Key where
  compare (MkKey a b c d e) (MkKey a' b' c' d' e') = compare a a'
                                                 <!> compareBool b b'
                                                 <!> compareBool c c'
                                                 <!> compareBool d d'
                                                 <!> compareBool e e'

keyCode' : Lens Key KeyCode
keyCode' = lens (\(MkKey x _ _ _ _) => x) (\x, (MkKey _ a b c d) => MkKey x a b c d)

keyHasAlt' : Lens Key Bool
keyHasAlt' = lens (\(MkKey _ x _ _ _) => x) (\x, (MkKey a _ b c d) => MkKey a x b c d)

keyHasCmd' : Lens Key Bool
keyHasCmd' = lens (\(MkKey _ _ x _ _) => x) (\x, (MkKey a b _ c d) => MkKey a b x c d)

keyHasCtrl' : Lens Key Bool
keyHasCtrl' = lens (\(MkKey _ _ _ x _) => x) (\x, (MkKey a b c _ d) => MkKey a b c x d)

keyHasShift' : Lens Key Bool
keyHasShift' = lens (\(MkKey _ _ _ _ x) => x) (\x, (MkKey a b c d _) => MkKey a b c d x)

data Event = KeyEvent Key
           | RefreshEvent
           | IgnoredEvent

eventFromPtr : Ptr -> IO Event
eventFromPtr p = do
  t <- mkForeign (FFun "irEventType" [FPtr] FInt) p
  c <- mkForeign (FFun "irEventKeyCode" [FPtr] FInt) p
  alt <- map (/= 0) (mkForeign (FFun "irEventKeyAlternate" [FPtr] FInt) p)
  cmd <- map (/= 0) (mkForeign (FFun "irEventKeyCommand" [FPtr] FInt) p)
  ctrl <- map (/= 0) (mkForeign (FFun "irEventKeyControl" [FPtr] FInt) p)
  shift <- map (/= 0) (mkForeign (FFun "irEventKeyShift" [FPtr] FInt) p)
  mkForeign (FFun "irEventFree" [FPtr] FUnit) p
  return (case t of
    0 => KeyEvent (MkKey c alt cmd ctrl shift)
    1 => RefreshEvent
    _ => IgnoredEvent)


module Salo.Language.Parser

import Salo.Language.Lexer
import Salo.Language.TT
import Salo.Language.AST

import Text.Lexer
import Text.Parser

import Data.SortedMap

Rule : Type -> Type
Rule = Grammar (TokenData Token) True

record Globals where
  constructor MkGlobals
  definitions : SortedMap Name (Definition)

implementation Show Globals where
  show x = "Globals: " ++ show x.definitions

token : Token -> Rule ()
token t = terminal ("expecting " ++ show t) $ \t' =>
  if t == tok t'
    then Just ()
    else Nothing

kwd : String -> Rule ()
kwd s = token (Keyword s)

dataDecl : Rule Definition
dataDecl = do
  kwd "data"
  pure (MkDef (B "AAA" (P)) Postulate)

export
parse : String -> Either ParseError (Definition)
parse src = case lex src of
  Left err => Left err
  Right ts => case Text.Parser.Core.parse (dataDecl <* eof) ts of
    Left (Error msg []) => Left $ SyntaxError 0 0 msg []
    Left (Error msg (tt :: tts)) => Left $ SyntaxError (line tt) (col tt) msg (tt :: tts)
    Right (gs, []) => Right gs
    Right (gs, t::ts) => Left $ SyntaxError (line t) (col t) "eof expected" (t :: ts)

namespace Test
  namespace Examples
    export
    exampleData : List (TokenData Token)
    exampleData = [MkToken 0 0 (Keyword "data")]

  ParserType : Type
  ParserType = Either ParseError (Definition)

  parseData : ParserType
  parseData = parse "data"

  testHarness : ParserType -> IO ()
  testHarness t = case t of
    Left err => putStrLn $ "  -> Error: "   ++ (show err)
    Right gs => putStrLn $ "  -> Success: " ++ (show gs)

  export
  test : IO ()
  test = do putStrLn "Parser:"
            testHarness parseData


module Circuits.NetList.Pretty

import System.File

import Data.String

import Data.Fin

import Text.Lexer
import Text.Parser

import Toolkit.Data.Whole
import Toolkit.Data.Location
import Toolkit.Text.Lexer.Run
import Toolkit.Text.Parser.Run

import Toolkit.Data.List.DeBruijn
import Toolkit.Data.List.Occurs.Does
import Toolkit.Data.Graph.EdgeBounded
import Toolkit.Data.Graph.EdgeBounded.HasExactDegree
import Toolkit.Data.List.AtIndex
import Toolkit.DeBruijn.Context.Item
import Toolkit.DeBruijn.Context
import Toolkit.DeBruijn.Renaming

import Circuits.Common
import public Circuits.Common.Pretty

import Circuits.NetList.Error
import Circuits.NetList.AST
import Circuits.NetList.Types

import Circuits.NetList.Terms

export
Show AST where
  show (Var (MkRef span get))
    = "(Var \{get})"

  show (Port x y z (MkRef span get) scope)
    = "(Port \{show y} \{show z} \{show get} \{show scope})"

  show (Wire x y (MkRef span get) scope)
    = "(Wire \{show y} \{show get} \{show scope})"

  show (GateDecl x (MkRef span get) z scope)
    = "(Gate \{show get} \{show z} \{show scope})"

  show (Shim x y z)
    = "(Shim \{show y} \{show z})"

  show (Assign x y z w)
    = "(Assign \{show y} \{show z} \{show w})"

  show (Mux x y z w v)
    = "(Mux \{show y} \{show z} \{show w} \{show v})"

  show (GateU x y z w)
    = "(GateU \{show y} \{show z} \{show w})"

  show (GateB x y z w v)
    = "(GateB \{show y} \{show z} \{show w} \{show v})"

  show (Index x k y)
    = "(Index \{show k} \{show y})"

  show (Split x y z w)
    = "(Split \{show y} \{show z} \{show w})"

  show (Collect x y z w)
    = "(Collect \{show y} \{show z} \{show w})"

  show (Stop x)
    = "(Stop)"

toNat : IsVar ctxt type -> Nat
toNat (V pos prf) = pos

Show (Project dir) where
  show WRITE = "Write"
  show READ = "Read"

export
Show (Term ctxt type) where
  show (Var prf)
    = "(Var \{show (toNat prf)})"

  show (Port flow dtype body)
    = "(Port \{show flow} \{show dtype} \{show body})"

  show (Wire x body)
    = "(Wire \{show x} \{show body})"

  show (GateDecl g body)
    = "(Gate \{show g} \{show body})"

  show Stop
    = "Stop"

  show (Assign i o body)
    = "(Assign \{show i} <- \{show o} \{show body})"

  show (Index idir what idx)
    = "(Index \{show idir} \{show what} \{show idx})"

  show (Mux o c l r)
    = "(Mux \{show o} \{show c} \{show l} \{show r})"

  show (GateB x o l r)
    = "(GateB \{show x} \{show o} \{show l} \{show r})"

  show (GateU x o i)
    = "(GateU \{show x} \{show o} \{show i})"

  show (Collect o l r)
    = "(Collect \{show o} \{show l} \{show r})"

  show (Split l r i)
    = "(Split \{show l} \{show r} \{show i})"

  show (Project how what)
    = "(Project \{show how} \{show what})"

  show (Cast dir what)
    = "(Cast \{show dir} \{show what})"

-- [ EOF ]


module WebAssembly.Validation.Modules.Exports

import WebAssembly.Structure
import WebAssembly.Validation.Conventions
import WebAssembly.Validation.Types

||| [🔗 Spec](https://webassembly.github.io/spec/core/valid/modules.html#exports)
public export
data ValidExportDesc : Context -> ExportDesc -> ExternType -> Type where

  ||| [🔗 Spec](https://webassembly.github.io/spec/core/valid/modules.html#xref-syntax-modules-syntax-exportdesc-mathsf-func-x)
  |||
  ||| ```
  ||| C.funcs[x] = functype
  ||| --------------------------
  ||| C ⊢ func x : func functype
  ||| ```
  MkValidExternalFunc    : (c : Context)
                        -> (x : FuncIdx)
                        -> {auto in_bounds: InBounds x (funcs c)}
                        -> ValidExportDesc c (FuncExport x) (Func (index x (funcs c)))

  ||| [🔗 Spec](https://webassembly.github.io/spec/core/valid/modules.html#xref-syntax-modules-syntax-exportdesc-mathsf-table-x)
  |||
  ||| ```
  ||| C.tables[x] = tabletype
  ||| --------------------------
  ||| C ⊢ table x : table tabletype
  ||| ```
  MkValidExternalTable   : (c : Context)
                        -> (x : TableIdx)
                        -> {auto in_bounds: InBounds x (tables c)}
                        -> ValidExportDesc c (TableExport x) (Table (index x (tables c)))

  ||| [🔗 Spec](https://webassembly.github.io/spec/core/valid/modules.html#xref-syntax-modules-syntax-exportdesc-mathsf-mem-x)
  |||
  ||| ```
  ||| C.mems[x] = memtype
  ||| --------------------------
  ||| C ⊢ mem x : mem memtype
  ||| ```
  MkValidExternalMem     : (c : Context)
                        -> (x : MemIdx)
                        -> {auto in_bounds: InBounds x (mems c)}
                        -> ValidExportDesc c (MemExport x) (Mem (index x (mems c)))

  ||| [🔗 Spec](https://webassembly.github.io/spec/core/valid/modules.html#xref-syntax-modules-syntax-exportdesc-mathsf-global-x)
  |||
  ||| ```
  ||| C.globals[x] = globaltype
  ||| --------------------------
  ||| C ⊢ global x : global globaltype
  ||| ```
  MkValidExternalGlobal  : (c : Context)
                        -> (x : GlobalIdx)
                        -> {auto in_bounds: InBounds x (globals c)}
                        -> ValidExportDesc c (GlobalExport x) (Global (index x (globals c)))

||| [🔗 Spec](https://webassembly.github.io/spec/core/valid/modules.html#exports)
public export
data ValidExport : Context -> Export -> ExternType -> Type where

  ||| [🔗 Spec](https://webassembly.github.io/spec/core/valid/modules.html#xref-syntax-modules-syntax-export-mathsf-name-xref-syntax-values-syntax-name-mathit-name-xref-syntax-modules-syntax-export-mathsf-desc-xref-syntax-modules-syntax-exportdesc-mathit-exportdesc)
  |||
  ||| ```
  ||| C ⊢ exportdesc : externtype
  ||| ---------------------------------------------
  ||| C ⊢ {name name, desc exportdesc} : externtype
  ||| ```
  MkValidExport  : (c : Context)
                -> (name : Name)
                -> (desc : ExportDesc)
                -> (externtype : ExternType)
                -> ValidExportDesc c desc externType
                -> ValidExport c (MkExport name desc) externType


module Hedgehog.Internal.Runner

import Data.Colist
import Data.Cotree
import Data.IORef
import Data.List
import Hedgehog.Internal.Config
import Hedgehog.Internal.Gen
import Hedgehog.Internal.Options
import Hedgehog.Internal.Property
import Hedgehog.Internal.Range
import Hedgehog.Internal.Report
import Hedgehog.Internal.Seed
import Hedgehog.Internal.Terminal
import System

%default total

public export
TestRes : Type
TestRes = (Either Failure (), Journal)

--------------------------------------------------------------------------------
--          Shrinking
--------------------------------------------------------------------------------

-- Shrinking
shrink : Monad m => Nat -> Coforest a -> b -> (Nat -> a -> m (Maybe b)) -> m b
shrink _     []        b _ = pure b
shrink 0 _             b _ = pure b
shrink (S k) (t :: ts) b f = do Just b2 <- f (S k) t.value
                                  | Nothing => shrink k ts b f
                                shrink k t.forest b2 f

takeSmallest :
     Monad m
  => Size
  -> Seed
  -> ShrinkLimit
  -> (Progress -> m ())
  -> Cotree TestRes
  -> m Result
takeSmallest si se (MkTagged slimit) updateUI t =
  do res <- run 0 t.value
     if isFailure res
        then shrink slimit t.forest res runMaybe
        else pure res

  where
    -- calc number of shrinks from the remaining
    -- allowed numer and the shrink limit
    calcShrinks : Nat -> ShrinkCount
    calcShrinks rem = MkTagged $ (slimit `minus` rem) + 1

    run : ShrinkCount -> TestRes -> m Result
    run shrinks t =
      case t of
        (Left $ MkFailure err diff, MkJournal logs) =>
           let fail = mkFailure si se shrinks Nothing err diff (reverse logs)
            in updateUI (Shrinking fail) $> Failed fail

        (Right x, _) => pure OK

    runMaybe : Nat -> TestRes -> m (Maybe Result)
    runMaybe shrinksLeft testRes =
      do res <- run (calcShrinks shrinksLeft) testRes
         if isFailure res then pure (Just res) else pure Nothing

--------------------------------------------------------------------------------
--          Test Runners
--------------------------------------------------------------------------------

-- main test runner
checkReport :
     Monad m
  => PropertyConfig
  -> Size
  -> Seed
  -> PropertyT ()
  -> (Report Progress -> m ())
  -> m (Report Result)
checkReport cfg si0 se0 test updateUI =
  let (conf, MkTagged numTests) = unCriteria cfg.terminationCriteria
   in loop numTests 0 si0 se0 neutral conf

  where
    loop :  Nat
         -> TestCount
         -> Size
         -> Seed
         -> Coverage CoverCount
         -> Maybe Confidence
         -> m (Report Result)
    loop n tests si se cover conf = do
      updateUI (MkReport tests cover Running)
      case n of
        0   =>
          -- required number of tests run
          pure $ report False tests si se cover conf
        S k =>
          if abortEarly cfg.terminationCriteria tests cover conf
             then
               -- at this point we know that enough
               -- tests have been run due to early termination
               pure $ report True tests si se cover conf
             else
              -- run another test
              let (s0,s1) = split se
                  tr      = runGen si s0 $ runTestT test
                  nextSize = if si < maxSize then (si + 1) else 0
               in case tr.value of
                    -- the test failed, so we abort and shrink
                    (Left x, _)  =>
                      let upd = updateUI . MkReport (tests+1) cover
                       in map (MkReport (tests+1) cover) $
                            takeSmallest si se cfg.shrinkLimit upd tr

                    -- the test succeeded, so we accumulate results
                    -- and loop once more
                    (Right x, journal) =>
                      let cover1 = journalCoverage journal <+> cover
                       in loop k (tests + 1) nextSize s1 cover1 conf

checkTerm :  HasIO io
          => Terminal
          -> UseColor
          -> Maybe PropertyName
          -> Size
          -> Seed
          -> Property
          -> io (Report Result)
checkTerm term color name si se prop =
  do result <- checkReport {m = io} prop.config si se prop.test $ \prog =>
               if multOf100 prog.tests
                  then let ppprog = renderProgress color name prog
                        in case prog.status of
                               Running     => putTmp term ppprog
                               Shrinking _ => putTmp term ppprog
                  else pure ()

     putOut term (renderResult color name result)
     pure result

checkWith :  HasIO io
          => Terminal
          -> UseColor
          -> Maybe PropertyName
          -> Property
          -> io (Report Result)
checkWith term color name prop =
  initSMGen >>= \se => checkTerm term color name 0 se prop

||| Check a property.
export
checkNamed : HasIO io => PropertyName -> Property -> io Bool
checkNamed name prop = do
  color <- detectColor
  term  <- console
  rep   <- checkWith term color (Just name) prop
  pure $ rep.status == OK

||| Check a property.
export
check : HasIO io => Property -> io Bool
check prop = do
  color <- detectColor
  term  <- console
  rep   <- checkWith term color Nothing prop
  pure $ rep.status == OK

||| Check a property using a specific size and seed.
export
recheck : HasIO io => Size -> Seed -> Property -> io ()
recheck si se prop = do
  color <- detectColor
  term  <- console
  _     <- checkTerm term color Nothing si se (withTests 1 prop)
  pure ()

checkGroupWith :  Terminal
               -> UseColor
               -> List (PropertyName, Property)
               -> IO Summary
checkGroupWith term color = run neutral
  where run : Summary -> List (PropertyName, Property) -> IO Summary
        run s [] = pure s
        run s ((pn,p) :: ps) = do rep  <- checkWith term color (Just pn) p
                                  run (s <+> fromResult rep.status) ps

export
checkGroup : HasIO io => Group -> io Bool
checkGroup (MkGroup group props) =
  do term    <- console
     putOut term $ "━━━ " ++ unTag group ++ " ━━━"
     color   <- detectColor
     summary <- liftIO $ checkGroupWith term color props
     putOut term (renderSummary color summary)
     pure $ summary.failed == 0

||| Simple test runner.
|||
||| Use this in a `main` function in order to test a list of
||| property groups. The runner will take into account several
||| command line arguments in order to adjust the number of
||| tests to be run for each property, the maximal number of
||| shrinks and the confidence value to use.
|||
||| ```idris example
||| main : IO ()
||| main = test myGroups
||| ```
|||
||| The resulting executable can then be run as follows:
|||
||| ```sh
||| build/exec/runTests -n 1000
||| ```
|||
||| It will fail with an exit code of 1 if at least one property
||| fails.
export
test : HasIO io => List Group -> io ()
test gs = do
  args    <- getArgs
  Right c <- pure $ applyArgs args
    | Left errs => do
        putStrLn "Errors when parsing command line args:"
        traverse_ putStrLn errs
        exitFailure
  if c.printHelp
     then putStrLn info >> exitSuccess
     else
       let gs2 = map (applyConfig c) gs
        in do
             res <- foldlM (\b,g => map (b &&) (checkGroup g)) True gs2
             if res
                then exitSuccess
                else putStrLn "\n\nSome tests failed" >> exitFailure


module Streaming.Encoding.Base64

import Streaming.Internal as S
import Streaming.API as S

import Data.Functor.Of

import Streaming.Bytes

import System.File

import Data.Strings

-- import Data.LazyList
import Data.List -- zip

import Data.IOArray

import Control.Monad.State

import Util

import Language.Reflection

import public Streaming.Encoding.Base64.Alphabet

-- base64 is an encoding _from_ binary data _to_ binary data matching a
-- restricted alphabet of characters.
-- https://tools.ietf.org/rfc/rfc4648#section-1

export
data EncodeError = CodepointOutOfRange
                 | InvalidStartByte Bits8
                 | CodepointEndedEarly

export
Show EncodeError where
  show CodepointOutOfRange = "CodepointOutOfRange"
  show (InvalidStartByte x) = "InvalidStartByte " ++ show x
  show CodepointEndedEarly = "CodepointEndedEarly"

export
data DecodeError = CharNotInAlphabet Char | DataEndedEarly | TooMuchPadding

export
Show DecodeError where
  show (CharNotInAlphabet x) = "CharNotInAlphabet: " ++ show x
  show DataEndedEarly = "Encoded data ended early"
  show TooMuchPadding = "TooMuchPadding"

-- base64 can't have a decode error because it pads missing bits.
export
encodeBase64 : Monad m => Alphabet -> Stream (Of Bits8) m r
          -> Stream (Of Char) m r
encodeBase64 alph str0
    = str0 &$
       chunksOf 3 -- this foldl needs to account for folding over 3 instead of less
    |> mapf (store (\str => foldl (\acc,b => shiftL acc 8 .|. cast b) 0
                              (take'' 3 $ str <* replicate 3 0)) -- pad to 3
            |> length -- <^ compute length and combine bits in one pass
            |> \res => effect $ do
                       len :> b <- res
                       pure $ case len of
                         1 => splitGroup 2 b <* yield 65 <* yield 65 -- pads
                         2 => splitGroup 3 b <* yield 65
                         _ => splitGroup 4 b)
    -- ^ Combine up to three Bits8, note the number we got, split based on it
    |> concats
    |> encode alph
  where
    -- Split the Int into 4 six bit parts. Left as Int to skip a cast.
    -- Because we construct the pieces ourself we don't need to do checks later
    -- to be sure our Int fits into our alphabet. Their size means they must.
    splitGroup : forall r. Int -> Of Int r -> Stream (Of Int) m r
    splitGroup n (x :> r) = (iterate (`shiftR`6) x
                         &$ take {r=()} 4
                         |> maps (.&. 0x3F)
                         |> rev -- the shifting makes the order backward
                         |> take n) *> pure r
                         -- e. = 101 46
                         -- Z S 4 = 25 28 56
                         -- A G U u = 0 6 20 46
    -- Take our six bit parts and convert them to chars.
    encode : forall r. Alphabet -> Stream (Of Int) m r -> Stream (Of Char) m r
    encode alph str0 = effect $ do
      Right (b :> str) <- inspect str0
        | Left r => pure . pure $ r
      pure $ if b == 65 -- pad
        then yield alph.pad *> encode alph str
        else yield (alph.toChar b) *> encode alph str

-- What to do if encoded data ends early?
-- Return what was decoded and the rest of the stream?
||| decode Char (from an Alphabet) to binary data
export
decodeBase64 : Monad m => Alphabet -> Stream (Of Char) m r
         -> Stream (Of Bits8) m (Either DecodeError r)
decodeBase64 alph str0 = str0
                      &$ S.filter (not . alph.whitespace) -- ignore whitespace
                      |> validate alph
                      |> chunksOf 4
                      |> mapf (graft alph)
                      |> concats
  where
    -- Ensure the encountered character is part of our alphabet
    validate : forall r. Alphabet -> Stream (Of Char) m r
            -> Stream (Of Char) m (Either DecodeError r)
    validate alph str0 = effect $ do
       Right (c :> str) <- inspect str0
         | Left l => pure . pure . Right $ l
       pure $ if c /= alph.pad
         then case alph.fromChar c of
                Nothing => pure . Left $ CharNotInAlphabet c
                Just _ => wrap (c :> validate alph str)
         else wrap (c :> validate alph str)

    -- Split the collected bytes into `n` eight bit parts.
    splitGroup : forall r. Int -> Of Int r -> Stream (Of Bits8) m r
    splitGroup n (x :> r) = (iterate (`shiftR`8) x
                         &$ take {r=()} 3
                         |> rev
                         |> take n
                         |> maps cast) -- the shifting makes the order backward
                         *> Return r
    -- process 4 chars into 3 bytes
    -- store, check length gotten, unSplit, use what length demands pad otherwise
    graft : forall r. Alphabet -> Stream (Of Char) m r -> Stream (Of Bits8) m r
    graft alph str0 = str0 &$ store (maps (maybe 0 id . alph.fromChar)
                                    |> foldl (\acc,c => shiftL acc 6 .|. c) 0) -- merge chars)
                           |> (length . S.filter (/= alph.pad))
                           |> \x => effect $ do
                             len :> res <- x
                             case len of
                               -- 1 => pure . pure $ Left TooMuchPadding
                               2 => pure (splitGroup 1 res)
                               3 => pure (splitGroup 2 res)
                               _ => pure (splitGroup len res)
-- doesn't quite handle padding right yet


module LuaAst

import Core.Name
import Core.TT

import Data.Vect

%hide Core.TT.Visibility

public export
data Visibility = Local
                | Global

export
Eq Visibility where
 (==) Local Local = True
 (==) Global Global = True
 (==) _ _ = False

public export
data LuaExpr =  LLVar Name -- references some local variable
              | LGVar Name -- references some global variable defined inside `idris` table
              | LLambda (List Name) LuaExpr
              | LApp LuaExpr (List LuaExpr)
              | LPrimFn (PrimFn arity) (Vect arity LuaExpr)
              | LTrue          --literal 'true'
              | LFalse         --literal 'false'
              | LNil           --literal 'nil'
              | LNumber String --literal number
              | LBigInt String --literal bigint
              | LString String --literal string
              | LTable (List (LuaExpr, LuaExpr))
              | LIndex LuaExpr LuaExpr
              | LSeq LuaExpr LuaExpr
              | LReturn LuaExpr
              | LAssign (Maybe Visibility) LuaExpr LuaExpr  --decl with initial val and reassignment
              | LDeclVar Visibility Name
              | LIfThenElse LuaExpr LuaExpr LuaExpr
              | LBreak
              | LWhile LuaExpr LuaExpr
              | LDoNothing
              | LComment String

public export
Semigroup LuaExpr where
  LDoNothing <+> y = y
  x <+> LDoNothing = x
  x <+> y = LSeq x y

public export
Monoid LuaExpr where
  neutral = LDoNothing

public export
primFnNames : List String
primFnNames =
   ["prim__cast_IntChar"
   ,"prim__cast_IntegerDouble"
   ,"prim__cast_IntDouble"
   ,"prim__cast_StringDouble"
   ,"prim__cast_DoubleInt"
   ,"prim__cast_CharInt"
   ,"prim__cast_IntegerInt"
   ,"prim__cast_StringInt"
   ,"prim__cast_DoubleInteger"
   ,"prim__cast_CharInteger"
   ,"prim__cast_IntInteger"
   ,"prim__cast_StringInteger"
   ,"prim__cast_DoubleString"
   ,"prim__cast_CharString"
   ,"prim__cast_IntegerString"
   ,"prim__cast_IntString"
   ,"prim__doubleCeiling"
   ,"prim__doubleFloor"
   ,"prim__doubleSqrt"
   ,"prim__doubleATan"
   ,"prim__doubleACos"
   ,"prim__doubleASin"
   ,"prim__doubleTan"
   ,"prim__doubleCos"
   ,"prim__doubleSin"
   ,"prim__doubleLog"
   ,"prim__doubleExp"
   ,"prim__crash"
   ,"prim__believe_me"
   ,"prim__strSubstr"
   ,"prim__strReverse"
   ,"prim__strAppend"
   ,"prim__strCons"
   ,"prim__strIndex"
   ,"prim__strTail"
   ,"prim__strHead"
   ,"prim__strLength"
   ,"prim__gt_String"
   ,"prim__gt_Double"
   ,"prim__gt_Char"
   ,"prim__gt_Integer"
   ,"prim__gt_Int"
   ,"prim__gte_String"
   ,"prim__gte_Double"
   ,"prim__gte_Char"
   ,"prim__gte_Integer"
   ,"prim__gte_Int"
   ,"prim__eq_String"
   ,"prim__eq_Double"
   ,"prim__eq_Char"
   ,"prim__eq_Integer"
   ,"prim__eq_Int"
   ,"prim__lte_String"
   ,"prim__lte_Double"
   ,"prim__lte_Char"
   ,"prim__lte_Integer"
   ,"prim__lte_Int"
   ,"prim__lt_String"
   ,"prim__lt_Double"
   ,"prim__lt_Char"
   ,"prim__lt_Integer"
   ,"prim__lt_Int"
   ,"prim__xor_Int"
   ,"prim__or_Integer"
   ,"prim__or_Int"
   ,"prim__and_Integer"
   ,"prim__and_Int"
   ,"prim__shr_Integer"
   ,"prim__shr_Int"
   ,"prim__shl_Integer"
   ,"prim__shl_Int"
   ,"prim__negate_Double"
   ,"prim__mod_Integer"
   ,"prim__mod_Int"
   ,"prim__div_Double"
   ,"prim__div_Integer"
   ,"prim__div_Int"
   ,"prim__mul_Double"
   ,"prim__mul_Integer"
   ,"prim__mul_Int"
   ,"prim__sub_Double"
   ,"prim__sub_Integer"
   ,"prim__sub_Int"
   ,"prim__add_Double"
   ,"prim__add_Integer"
   ,"prim__add_Int"
   ]


module Extra.C.Float

import Extra.C.FFI
import Extra.C.Types

-- DO NOT public export, otherwise it will be evaluated to canonical form
export
CFloat : Type
CFloat = Bits32

%foreign libextra "double_to_cfloat"
export
prim__double_to_cfloat : CDouble -> PrimIO CFloat

%foreign libextra "cfloat_to_double"
export
prim__cfloat_to_double : CFloat -> PrimIO CDouble

%foreign libextra "cfloat_add"
export
prim__cfloat_add : CFloat -> CFloat -> PrimIO CFloat

%foreign libextra "cfloat_sub"
export
prim__cfloat_sub : CFloat -> CFloat -> PrimIO CFloat

%foreign libextra "cfloat_neg"
export
prim__cfloat_neg : CFloat -> PrimIO CFloat

%foreign libextra "cfloat_mul"
export
prim__cfloat_mul : CFloat -> CFloat -> PrimIO CFloat

%foreign libextra "cfloat_div"
export
prim__cfloat_div : CFloat -> CFloat -> PrimIO CFloat

%foreign libextra "cfloat_recip"
export
prim__cfloat_recip : CFloat -> PrimIO CFloat

%foreign libextra "cfloat_abs"
export
prim__cfloat_abs : CFloat -> PrimIO CFloat

%foreign libextra "peek_float_t"
prim__peek_float_t : Ptr CFloat -> PrimIO CFloat

%foreign libextra "poke_float_t"
prim__poke_float_t : Ptr CFloat -> CFloat -> PrimIO ()

export
peekFloat : Ptr CFloat -> PrimIO CFloat
peekFloat ptr = prim__peek_float_t ptr

export
pokeFloat : Ptr CFloat -> CFloat -> PrimIO ()
pokeFloat ptr x = prim__poke_float_t ptr x

export
fromDouble : CDouble -> CFloat
fromDouble d = unsafePerformIO $ primIO $ prim__double_to_cfloat d

export
toDouble : CFloat -> CDouble
toDouble d = unsafePerformIO $ primIO $ prim__cfloat_to_double d

export
Show CFloat where
  show x = (show $ toDouble x) <+> "f"

export
[FloatNum] Num CFloat where
  a + b = unsafePerformIO $ primIO $ prim__cfloat_add a b
  a * b = unsafePerformIO $ primIO $ prim__cfloat_mul a b
  fromInteger = fromDouble . fromInteger

export
Neg CFloat using FloatNum where
  negate a = unsafePerformIO $ primIO $ prim__cfloat_neg a
  a - b = unsafePerformIO $ primIO $ prim__cfloat_sub a b

export
Fractional CFloat using FloatNum where
  a / b = unsafePerformIO $ primIO $ prim__cfloat_div a b
  recip a = unsafePerformIO $ primIO $ prim__cfloat_recip a

export
Abs CFloat using FloatNum where
  abs a = unsafePerformIO $ primIO $ prim__cfloat_abs a