module Drawcmd(move, moveDrawCommands, moveDrawCommand) where
import DrawTypes
import Geometry(Move(..))
--import Xtypes

instance Move DrawCommand where move :: Point -> DrawCommand -> DrawCommand
move = (DrawCommand -> Point -> DrawCommand)
-> Point -> DrawCommand -> DrawCommand
forall a b c. (a -> b -> c) -> b -> a -> c
flip DrawCommand -> Point -> DrawCommand
moveDrawCommand

moveDrawCommand :: DrawCommand -> Point -> DrawCommand
moveDrawCommand DrawCommand
cmd Point
v =
    case DrawCommand
cmd of
      DrawLine Line
l -> Line -> DrawCommand
DrawLine (Point -> Line -> Line
forall a. Move a => Point -> a -> a
move Point
v Line
l)
      DrawLines CoordMode
cm [Point]
ps -> CoordMode -> [Point] -> DrawCommand
DrawLines CoordMode
cm (CoordMode -> [Point] -> Point -> [Point]
forall a. Move a => CoordMode -> [a] -> Point -> [a]
movePoints CoordMode
cm [Point]
ps Point
v)
      DrawImageString Point
p String
s -> Point -> String -> DrawCommand
DrawImageString (Point -> Point -> Point
forall a. Move a => Point -> a -> a
move Point
v Point
p) String
s
      DrawString Point
p String
s -> Point -> String -> DrawCommand
DrawString (Point -> Point -> Point
forall a. Move a => Point -> a -> a
move Point
v Point
p) String
s
      DrawRectangle Rect
r -> Rect -> DrawCommand
DrawRectangle (Point -> Rect -> Rect
forall a. Move a => Point -> a -> a
move Point
v Rect
r)
      FillRectangle Rect
r -> Rect -> DrawCommand
FillRectangle (Point -> Rect -> Rect
forall a. Move a => Point -> a -> a
move Point
v Rect
r)
      FillPolygon Shape
shape CoordMode
coordMode [Point]
ps ->
	Shape -> CoordMode -> [Point] -> DrawCommand
FillPolygon Shape
shape CoordMode
coordMode (CoordMode -> [Point] -> Point -> [Point]
forall a. Move a => CoordMode -> [a] -> Point -> [a]
movePoints CoordMode
coordMode [Point]
ps Point
v)
      DrawArc Rect
r Int
a1 Int
a2 -> Rect -> Int -> Int -> DrawCommand
DrawArc (Point -> Rect -> Rect
forall a. Move a => Point -> a -> a
move Point
v Rect
r) Int
a1 Int
a2
      FillArc Rect
r Int
a1 Int
a2 -> Rect -> Int -> Int -> DrawCommand
FillArc (Point -> Rect -> Rect
forall a. Move a => Point -> a -> a
move Point
v Rect
r) Int
a1 Int
a2
      CopyArea Drawable
d Rect
r Point
p -> Drawable -> Rect -> Point -> DrawCommand
CopyArea Drawable
d Rect
r (Point -> Point -> Point
forall a. Move a => Point -> a -> a
move Point
v Point
p)
      CopyPlane Drawable
d Rect
r Point
p Int
n -> Drawable -> Rect -> Point -> Int -> DrawCommand
CopyPlane Drawable
d Rect
r (Point -> Point -> Point
forall a. Move a => Point -> a -> a
move Point
v Point
p) Int
n
      DrawPoint Point
p -> Point -> DrawCommand
DrawPoint (Point -> Point -> Point
forall a. Move a => Point -> a -> a
move Point
v Point
p)
      CreatePutImage Rect
r ImageFormat
fmt [Pixel]
pxls -> Rect -> ImageFormat -> [Pixel] -> DrawCommand
CreatePutImage (Point -> Rect -> Rect
forall a. Move a => Point -> a -> a
move Point
v Rect
r) ImageFormat
fmt [Pixel]
pxls
      DrawImageStringPS Point
p PackedString
s -> Point -> PackedString -> DrawCommand
DrawImageStringPS (Point -> Point -> Point
forall a. Move a => Point -> a -> a
move Point
v Point
p) PackedString
s
      DrawStringPS Point
p PackedString
s -> Point -> PackedString -> DrawCommand
DrawStringPS (Point -> Point -> Point
forall a. Move a => Point -> a -> a
move Point
v Point
p) PackedString
s
      DrawImageString16 Point
p String
s -> Point -> String -> DrawCommand
DrawImageString16 (Point -> Point -> Point
forall a. Move a => Point -> a -> a
move Point
v Point
p) String
s
      DrawString16 Point
p String
s -> Point -> String -> DrawCommand
DrawString16 (Point -> Point -> Point
forall a. Move a => Point -> a -> a
move Point
v Point
p) String
s

movePoints :: CoordMode -> [a] -> Point -> [a]
movePoints CoordMode
cm [a]
ps Point
v =
 case CoordMode
cm of
   CoordMode
CoordModeOrigin -> Point -> [a] -> [a]
forall a. Move a => Point -> a -> a
move Point
v [a]
ps
   CoordMode
CoordModePrevious ->
     case [a]
ps of
       a
p:[a]
ps' -> Point -> a -> a
forall a. Move a => Point -> a -> a
move Point
v a
pa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ps'
       [] -> []

moveDrawCommands :: [DrawCommand] -> Point -> [DrawCommand]
moveDrawCommands [DrawCommand]
cmds Point
p = (DrawCommand -> DrawCommand) -> [DrawCommand] -> [DrawCommand]
forall a b. (a -> b) -> [a] -> [b]
map (DrawCommand -> Point -> DrawCommand
`moveDrawCommand` Point
p) [DrawCommand]
cmds