{- |
Module : TextArea.hs
Description : .
Maintainer : Kelvin Glaß, Chritoph Graebnitz, Kristin Knorr, Nicolas Lehmann (c)
License : MIT
Stability : experimental
The TextArea-module depicts the view on the data structure stored in the TextAreaContent-module for the editor.
-}
module TextArea(
-- * Types
TextArea,
-- * Constructors
initTextAreaWithContent,
-- * Constants
-- * Methods
textAreaContent,
currentPosition,
setTextAreaContent,
drawingArea,
getTextAreaContainer, -- This function should be used to get a widget to place in MainWindow
setInputMode,
setHighlighting,
redrawContent
)where
-- imports --
import qualified TextAreaContent as TAC
import qualified KeyHandler
import qualified Highlighter as HIGH
import qualified Selection
import qualified Graphics.Rendering.Cairo as CAIRO
import qualified Graphics.UI.Gtk as GTK
import qualified Graphics.UI.Gtk.Gdk.Events as Events
import Control.Concurrent (threadDelay)
import Data.IORef as IORef
import Data.Maybe
import qualified Data.Map as Map
import Control.Monad
import qualified Graphics.UI.Gtk.Gdk.GC as GC
{-
This is the main datatype of TextArea
-}
data TextArea = TA { drawingArea :: GTK.DrawingArea,
textAreaContent :: IORef TAC.TextAreaContent, --The TAC
scrolledWindow :: GTK.ScrolledWindow, --The part to bind it in a container
currentPosition :: IORef TAC.Position, --The current position of cursor without hef and bef
vAdjustment :: GTK.Adjustment, --needed to create a scrolledWindow
hAdjustment :: GTK.Adjustment, --needed to create a scrolledWindow
inputMode :: IORef KeyHandler.InputMode, -- needed to set and get the current input mode
getHighlighted :: IORef Bool} -- needed to determine, whether the area is highlighted
--The cursor color
defaultCursorColor :: GC.Color
defaultCursorColor = GC.Color 65535 0 0
--The background color
defaultBgColor :: GC.Color
defaultBgColor = GC.Color 65535 65535 65535
bef = 15 :: TAC.Coord --width of a character
hef = 15 :: TAC.Coord --height of a character
width = 400
height = 600
{-
This function returns a scrolled Window which can be used
to bind it on a widget.
-}
getTextAreaContainer :: TextArea -> IO GTK.ScrolledWindow
getTextAreaContainer textArea = return $ scrolledWindow textArea
setInputMode :: TextArea -> KeyHandler.InputMode -> IO ()
setInputMode area mode = do
let modeRef = inputMode area
writeIORef modeRef mode
{-
This function sets the TextArea TAC to the TAC given in argument 2.
-}
setTextAreaContent :: TextArea -> TAC.TextAreaContent -> IO ()
setTextAreaContent textArea areaContent= do
let
areaRef = textAreaContent textArea
drawArea = drawingArea textArea
highlightedIORef = getHighlighted textArea
writeIORef areaRef areaContent
highlighted <- readIORef highlightedIORef
--expand the drawWindow when needed
tac <- readIORef areaRef
s@(xMax,yMax) <- TAC.size tac
(w,h) <- GTK.widgetGetSizeRequest drawArea
if yMax*hef > h && xMax*bef > w
then GTK.widgetSetSizeRequest drawArea (w + (xMax*bef-w)) (h+(yMax*hef-w))
else do
when (yMax*hef > h ) $
GTK.widgetSetSizeRequest drawArea w (h+((yMax*hef)-w))
when (xMax*bef > w) $
GTK.widgetSetSizeRequest drawArea (w + (xMax*bef-w)) h
when highlighted $ HIGH.highlight tac
redrawContent textArea
-- | sets (True) or unsets (False) the highlighting
setHighlighting :: TextArea -> Bool -> IO ()
setHighlighting area val = do
writeIORef (getHighlighted area) val
tac <- readIORef $ textAreaContent area
if val
then HIGH.highlight tac
else TAC.deleteColors tac
redrawContent area
{-
This function setup the TextArea. It Set up the drawWindow
related to textAreaContent. It also setup the different user events
for editing the TextArea
-}
initTextAreaWithContent :: TAC.TextAreaContent -> IO TextArea
initTextAreaWithContent areaContent = do
veAdjustment <- GTK.adjustmentNew 0 0 0 (fromIntegral hef) 0 0
hoAdjustment <- GTK.adjustmentNew 0 0 0 (fromIntegral bef) 0 0
scrwin <- GTK.scrolledWindowNew (Just hoAdjustment) (Just veAdjustment)
areaRef <- newIORef areaContent
drawArea <- setUpDrawingArea
GTK.scrolledWindowAddWithViewport scrwin drawArea
posRef <- newIORef (0,0)
modRef <- newIORef KeyHandler.Insert
highlighted <- newIORef True
let textArea = TA drawArea areaRef scrwin posRef veAdjustment hoAdjustment modRef highlighted
{-This function is called when the user press a mouse button.
It calls the handleButtonPress function.
-}
GTK.onButtonPress drawArea $ \event -> do
let posRef = currentPosition textArea
GTK.widgetGrabFocus drawArea
readIORef posRef >>= clearCursor textArea
handleButtonPress textArea (round(Events.eventX event),round(Events.eventY event)) >>= writeIORef posRef
return $ Events.eventSent event
GTK.on drawArea GTK.motionNotifyEvent $ do
actualPos <- GTK.eventCoordinates
CAIRO.liftIO $ do
let areaRef = textAreaContent textArea
tac <- readIORef areaRef
currentPos <- readIORef posRef
newPos <- updatePosition actualPos
clearCursor textArea currentPos
showCursor textArea newPos
when (currentPos /= newPos) $ do
(isAlreadySelected,selectedContent) <- Selection.handleSelection tac currentPos newPos
if isAlreadySelected
then deselectEntries textArea tac selectedContent
else selectEntries textArea selectedContent
writeIORef posRef newPos
GTK.eventRequestMotions
return True
{-
This function is called when the user presses a key.
It starts the heyHandler the highlighter and redraw the textAreaContent.
-}
GTK.onKeyPress drawArea $ \event -> do
let
posRef = currentPosition textArea
areaRef = textAreaContent textArea
modif = Events.eventModifier event
key = Events.eventKeyName event
val = Events.eventKeyVal event
modRef = inputMode textArea
modus <- readIORef modRef
tac <- readIORef areaRef --TextAreaContent
readIORef posRef >>= clearCursor textArea
posBef@(x,y) <- readIORef posRef
pos@(kx,ky) <- KeyHandler.handleKey tac posBef modus modif key val
--expand the drawWindow when needed
extendDrawingAreaHorizontally textArea kx
extendDrawingAreaVertically textArea ky
writeIORef posRef pos
highlighted <- readIORef (getHighlighted textArea)
when highlighted $ HIGH.highlight tac
redrawContent textArea
showCursor textArea pos
return $ Events.eventSent event
{-
Called when the application starts
It setting the cursor and draw the textAreaContent
-}
GTK.onExpose drawArea $ \(Events.Expose sent _ _ _) -> do
let
posRef = currentPosition textArea
areaRef = textAreaContent textArea
content <- readIORef areaRef
redrawContent textArea
readIORef posRef >>= showCursor textArea
return sent
return textArea
{-
This function setup the DrawArea using GTK.DrawingArea.
-}
setUpDrawingArea :: IO GTK.DrawingArea
setUpDrawingArea = do
drawingArea <- GTK.drawingAreaNew
GTK.widgetModifyBg drawingArea GTK.StateNormal defaultBgColor
GTK.set drawingArea [GTK.widgetCanFocus GTK.:= True]
GTK.widgetAddEvents drawingArea [GTK.ButtonMotionMask]
GTK.widgetSetSizeRequest drawingArea width height
return drawingArea
--This handles a mouse button press event
handleButtonPress :: TextArea -> TAC.Position -> IO TAC.Position
handleButtonPress textArea (x,y) = do
let tacIORef = textAreaContent textArea
curPosIORef = currentPosition textArea
showCursor textArea newPos
tac <- readIORef tacIORef
selection <- TAC.getSelectedPositons tac
deselectEntries textArea tac selection
Selection.updateCells tac selection False
return newPos
where newPos = (div x bef,div y hef)-- position without hef and bef
{-
This function renders a character at the given position.
It calculate the coords for drawingArea from TAC.Position.
-}
renderScene :: TextArea -> TAC.Position -> Char -> TAC.RGBColor -> Bool -> Bool -> IO ()
renderScene textArea (x,y) char (TAC.RGBColor r g b) breakpoint isIP = do
let drawArea = drawingArea textArea
removeCharacter textArea (x,y)
drawWindow <- GTK.widgetGetDrawWindow drawArea
GTK.renderWithDrawable drawWindow $ do
CAIRO.setSourceRGBA r g b 1.0
CAIRO.moveTo (fromIntegral (xCoord x + 2)) (fromIntegral (yCoord y - 3))
CAIRO.setFontSize 14
CAIRO.showText [char]
gc <- GC.gcNew drawWindow
GC.gcSetValues gc $ GC.newGCValues { GC.foreground = defaultCursorColor }
when breakpoint $ GTK.drawRectangle drawWindow gc False (xCoord x-2) (yCoord (y-1)) (bef-2) (hef-2)
when isIP $ GTK.drawArc drawWindow gc False (xCoord x-2) (yCoord (y-1)) (bef-2) (hef-2) 0 23040
--This function returns the y coord in relation to drawingArea
yCoord :: TAC.Coord -> TAC.Coord
yCoord 0 = hef
yCoord y = y*hef + hef
--This function returns the coord in relation to drawingArea
xCoord :: TAC.Coord -> TAC.Coord
xCoord x = x*bef
{-
This Function removes the caracter at given position
The function should be called in renderScene to avoid overwriting.
-}
removeCharacter :: TextArea -> TAC.Position -> IO ()
removeCharacter textArea (x,y) = do
let drawArea = drawingArea textArea
drawWindow <- GTK.widgetGetDrawWindow drawArea
GTK.drawWindowClearArea drawWindow (fromIntegral $ xCoord x)
(fromIntegral(y*hef)) (fromIntegral bef) (fromIntegral hef)
-- This Function draws every character in scrollable Frame.
redrawContent :: TextArea -> IO ()
redrawContent textArea = do
let
tacIORef = textAreaContent textArea
drawArea = drawingArea textArea
vAdj = vAdjustment textArea
hAdj = hAdjustment textArea
vAdjValue <- GTK.adjustmentGetValue vAdj
hAdjValue <- GTK.adjustmentGetValue hAdj
drawFrameHeight <- GTK.adjustmentGetPageSize vAdj
drawFrameWidth <- GTK.adjustmentGetPageSize hAdj
drawWindow <- GTK.widgetGetDrawWindow drawArea
s@(w,h) <- GTK.drawableGetSize drawWindow
GTK.drawWindowClearArea drawWindow (round hAdjValue) (round vAdjValue) w h
let
xFrom = div (round hAdjValue) bef
yFrom = div (round vAdjValue) hef
xTo = div (round hAdjValue + round drawFrameWidth) bef
yTo = div (round vAdjValue + round drawFrameHeight) hef
tac <- readIORef tacIORef
--Function from Control.Monad Monad m => [a] -> (a -> m b) -> m ()
forM_ [xFrom..xTo] (\x -> forM_ [yFrom..yTo] (\y -> draw textArea (x,y)))
where
-- Call renderScene to
draw:: TextArea -> TAC.Position -> IO()
draw textArea pos = do
let tacIORef = textAreaContent textArea
tac <- readIORef tacIORef
mayCell <- TAC.getCell tac pos
unless (isNothing mayCell) $ do
let ((char,isSelected), color) = fromJust mayCell
cnt <- readIORef (TAC.context tac)
renderScene textArea pos char color (Map.findWithDefault False pos (TAC.breakMap cnt)) (pos == TAC.curIPPos cnt)
when isSelected $ selectEntry textArea pos
--Draws a cursor at the position.
--The function adds the TACU offsets
showCursor :: TextArea -> TAC.Position -> IO ()
showCursor textArea (x,y) = do
let drawArea = drawingArea textArea
drawWindow <- GTK.widgetGetDrawWindow drawArea
gc <- GC.gcNew drawWindow
GC.gcSetValues gc $ GC.newGCValues { GC.foreground = defaultCursorColor }
GTK.drawRectangle drawWindow gc True (curX (x*bef)) (curY (y*hef)) 2 hef
--http://hackage.haskell.org/package/gtk-0.12.5.7/docs/Graphics-UI-Gtk-Gdk-Drawable.html#t:Drawable
return ()
-- delets the cursor at the given position.
clearCursor :: TextArea -> TAC.Position -> IO ()
clearCursor textArea (x,y) = do
let drawArea = drawingArea textArea
drawWindow <- GTK.widgetGetDrawWindow drawArea
GTK.drawWindowClearArea drawWindow
(fromIntegral (curX (x*bef)))
(fromIntegral (curY (y*hef)))
2
(fromIntegral hef)
--Coords for the cursor to fit the cells of characters
curX x = abs(x - mod x bef-1)
curY y = y - mod y hef
{-
This function extends the TextArea horizontal and set the scroll Frame.
It should be called after KeyHandler
-}
extendDrawingAreaHorizontally :: TextArea -> TAC.Coord -> IO ()
extendDrawingAreaHorizontally textArea x = do
let
drawArea = drawingArea textArea
adjustment = hAdjustment textArea
width <- GTK.adjustmentGetPageSize adjustment
(w,h) <- GTK.widgetGetSizeRequest drawArea
value <- GTK.adjustmentGetValue adjustment
when ((x*bef)+bef >= w) $
GTK.widgetSetSizeRequest drawArea ((x*bef)+bef) h
when (x*bef +bef >= round width + round value || x*bef-bef < round value) $
GTK.adjustmentSetValue adjustment $ fromIntegral (x*bef)
{-
This function extends the TextArea vertically and set the scroll Frame.
It should be called after KeyHandler
-}
extendDrawingAreaVertically :: TextArea -> TAC.Coord -> IO ()
extendDrawingAreaVertically textArea y = do
let
drawArea = drawingArea textArea
adjustment = vAdjustment textArea
height <- GTK.adjustmentGetPageSize adjustment
(w,h) <- GTK.widgetGetSizeRequest drawArea
value <- GTK.adjustmentGetValue adjustment
when (y*hef + hef >= h) $
GTK.widgetSetSizeRequest drawArea w (y*hef + hef)
when (y*hef+hef >= round height + round value) $
GTK.adjustmentSetValue adjustment $ value + fromIntegral hef
when (y*hef-hef < round value) $
GTK.adjustmentSetValue adjustment $ value - fromIntegral hef
selectEntries :: TextArea -> [TAC.Position] -> IO ()
selectEntries _ [] = return ()
selectEntries textArea (x:xs) = do
selectEntry textArea x
selectEntries textArea xs
selectEntry :: TextArea -> TAC.Position -> IO ()
selectEntry textArea (x,y) = drawSelection textArea TAC.black 0.1 (x,y) (fromIntegral bef) (fromIntegral hef)
deselectEntries :: TextArea -> TAC.TextAreaContent -> [TAC.Position] -> IO ()
deselectEntries _ _ [] = return ()
deselectEntries textArea tac (x:xs) = do
deselectEntry textArea tac x
deselectEntries textArea tac xs
deselectEntry :: TextArea -> TAC.TextAreaContent -> TAC.Position -> IO ()
deselectEntry textArea tac pos = do
drawSelection textArea TAC.white 1 pos (bef+2) hef
maybeCell <- TAC.getCell tac pos
let ((char,isSelected),color) = fromJust maybeCell
cnt <- readIORef (TAC.context tac)
renderScene textArea pos char color (Map.findWithDefault False pos (TAC.breakMap cnt)) (pos == TAC.curIPPos cnt)
drawSelection :: TextArea -> TAC.RGBColor -> Double -> TAC.Position -> TAC.Coord -> TAC.Coord -> IO ()
drawSelection textArea (TAC.RGBColor r g b) alpha (x,y) width height = do
drawWindow <- GTK.widgetGetDrawWindow $ drawingArea textArea
GTK.renderWithDrawable drawWindow $ do
CAIRO.setSourceRGBA r g b alpha
CAIRO.rectangle (fromIntegral (xCoord x)) (fromIntegral (hef * y)) (fromIntegral width) (fromIntegral height)
CAIRO.fill
updatePosition :: (Double,Double) -> IO TAC.Position
updatePosition (x,y) =
return (round leftX,round topY)
where leftX = getMultiplier x (fromIntegral bef) 0
topY = getMultiplier y (fromIntegral hef) 0
getMultiplier :: Double -> Double -> Double -> Double
getMultiplier a b count
| a > b * (count+1) = getMultiplier a b (count+1)
| otherwise = count