module DrawCompiledGraphics(drawK,drawK',drawChangesK,drawChangesK') where
import qualified DrawCompiledGraphics1 as D1
--import qualified DrawCompiledGraphics2 as D2
--import qualified DrawCompiledGraphics3 as D3
import DrawTypes(Drawable(MyWindow))
import CmdLineEnv(argReadKey)

drawK :: (GCId, Rect -> [t])
-> (t -> [Rect]) -> CompiledGraphics -> f hi ho -> f hi ho
drawK (GCId, Rect -> [t])
x = Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
forall (f :: * -> * -> *) t hi ho.
FudgetIO f =>
Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
D1.drawK' Drawable
MyWindow (GCId, Rect -> [t])
x
drawChangesK :: Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
drawChangesK Bool
x = Maybe (Drawable, GCId)
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
Maybe (Drawable, GCId)
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
D1.drawChangesK' Maybe (Drawable, GCId)
forall a. Maybe a
Nothing Bool
x

drawK' :: Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
drawK' Drawable
x = Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
forall (f :: * -> * -> *) t hi ho.
FudgetIO f =>
Drawable
-> (GCId, Rect -> [t])
-> (t -> [Rect])
-> CompiledGraphics
-> f hi ho
-> f hi ho
D1.drawK' Drawable
x
drawChangesK' :: Maybe (Drawable, GCId)
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
drawChangesK' Maybe (Drawable, GCId)
x = Maybe (Drawable, GCId)
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
forall (f :: * -> * -> *) hi ho.
FudgetIO f =>
Maybe (Drawable, GCId)
-> Bool
-> (GCId, Rect -> [Rect])
-> CompiledGraphics
-> CompiledGraphics
-> [[Int]]
-> f hi ho
-> f hi ho
D1.drawChangesK' Maybe (Drawable, GCId)
x
--drawK' = drawChoice D1.drawK' D2.drawK' D3.drawK'
--drawChangesK' = drawChoice D1.drawChangesK' D2.drawChangesK' D3.drawChangesK'


drawChoice :: p -> p -> p -> p
drawChoice =
  case Int
choice of
    Int
1 -> \ p
d1 p
d2 p
d3 -> p
d1
--  2 -> \ d1 d2 d3 -> d2
--  3 -> \ d1 d2 d3 -> d3
    Int
_ -> [Char] -> p -> p -> p -> p
forall a. HasCallStack => [Char] -> a
error [Char]
"unkown version of DrawCompiledGraphics"
  where
    choice :: Int
choice = [Char] -> Int -> Int
forall p. (Read p, Show p) => [Char] -> p -> p
argReadKey [Char]
"draw" (Int
1::Int)