Pen.hs

{-# LANGUAGE OverloadedStrings #-}

-----------------------------------------------------------------------------
-- |
-- Module      : Application.HXournal.ModelAction.Pen 
-- Copyright   : (c) 2011, 2012 Ian-Woo Kim
--
-- License     : BSD3
-- Maintainer  : Ian-Woo Kim <ianwookim@gmail.com>
-- Stability   : experimental
-- Portability : GHC
--
-----------------------------------------------------------------------------

module Application.HXournal.ModelAction.Pen where


import Application.HXournal.ModelAction.Page
import Application.HXournal.ModelAction.Layer
import Application.HXournal.Type.Canvas
import Application.HXournal.Type.Enum
import Application.HXournal.Type.PageArrangement
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 Data.Xournal.Simple
import Data.Xournal.Generic
import Data.Xournal.BBox
import Graphics.Xournal.Render.BBoxMapPDF

-- | 

addPDraw :: PenInfo 
            -> TXournalBBoxMapPDFBuf 
            -> PageNum 
            -> Seq (Double,Double,Double) 
            -> IO (TXournalBBoxMapPDFBuf,BBox) 
                       -- ^ new xournal and bbox in page coordinate
addPDraw pinfo xoj (PageNum pgnum) pdraw = do 
    let ptype = get penType pinfo
        pcolor = get (penColor.currentTool) pinfo
        pcolname = fromJust (M.lookup pcolor penColorNameMap)
        pwidth = get (penWidth.currentTool) pinfo
        pvwpen = get variableWidthPen pinfo
        (mcurrlayer,currpage) = getCurrentLayerOrSet (getPageFromGXournalMap pgnum xoj)
        currlayer = maybe (error "something wrong in addPDraw") id mcurrlayer 
        ptool = case ptype of 
                  PenWork -> "pen" 
                  HighlighterWork -> "highlighter"
                  _ -> error "error in addPDraw"
        newstroke = 
          case pvwpen of 
            False -> Stroke { stroke_tool = ptool 
                            , stroke_color = pcolname 
                            , stroke_width = pwidth
                            , stroke_data = map (\(x,y,_)->x:!:y) . toList $ pdraw
                          } 
            True -> VWStroke { stroke_tool = ptool
                             , stroke_color = pcolname                 
                             , stroke_vwdata = map (\(x,y,z)->(x,y,pwidth*z)) . toList $ pdraw
                             }
                                           
        newstrokebbox = mkStrokeBBoxFromStroke newstroke
        bbox = strokebbox_bbox newstrokebbox
    newlayerbbox <- updateLayerBuf (Just bbox)
                    . set g_bstrokes (get g_bstrokes currlayer ++ [newstrokebbox]) 
                    $ currlayer

    let newpagebbox = adjustCurrentLayer newlayerbbox currpage 
        newxojbbox = set g_pages (IM.adjust (const newpagebbox) pgnum (get g_pages xoj) ) xoj 
    return (newxojbbox,bbox)