Pen.hs

{-# LANGUAGE OverloadedStrings #-}

module Application.HXournal.ModelAction.Pen where

import Application.HXournal.ModelAction.Page
import Graphics.Xournal.Type
import Graphics.Xournal.Type.Map
import Application.HXournal.Type.Canvas
import Application.HXournal.Type.Enum
import Data.Foldable
import Data.Maybe
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Control.Category
import Data.Sequence hiding (take, drop)
import Data.Label
import Prelude hiding ((.), id)
import Data.Strict.Tuple hiding (uncurry)
import Text.Xournal.Type

addPDraw :: PenInfo -> XournalBBoxMap -> Int -> Seq (Double,Double) 
            -> (XournalBBoxMap,BBox)
addPDraw pinfo xoj pgnum pdraw = 
  let pcolor = get penColor pinfo
      pcolname = fromJust (M.lookup pcolor penColorNameMap)
      pwidth = get penWidth pinfo
      currpage = getPageFromXojBBoxMap  pgnum xoj
      currlayer = case IM.lookup 0 (pbm_layers currpage) of
                    Nothing -> error "something wrong in addPDraw"
                    Just l -> l
      newstroke = Stroke { stroke_tool = "pen" 
                         , stroke_color = pcolname 
                         , stroke_width = pwidth
                         , stroke_data = map (uncurry (:!:)) . toList $ pdraw
                         } 
      newstrokebbox = mkStrokeBBoxFromStroke newstroke
      newlayerbbox =  currlayer {layerbbox_strokes = layerStrokes currlayer 
                                                    ++ [newstrokebbox] }
      newpagebbox = currpage { 
        pbm_layers = IM.adjust (const newlayerbbox) 0 (pbm_layers currpage) 
      }

      newxojbbox = xoj { 
        xbm_pages = IM.adjust (const newpagebbox) pgnum (xbm_pages xoj) 
      }
  in  (newxojbbox,strokebbox_bbox newstrokebbox)