Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 182 lines (141 sloc) 6.604 kB
13104d3 @michaelfeathers first commit
authored
1
2 module EditBuffer
3 ( EditBuffer(..)
4 , Location
5 , emptyBuffer
6 , enterCommandMode
7 , getBufferContents
8 , lineCount
c3676ba @michaelfeathers Added `replace char' support with 'r'
authored
9 , insertChar, deleteChar, replaceChar
13104d3 @michaelfeathers first commit
authored
10 , insertLineAfter
11 , deleteLine
12 , moveLeft, moveRight, moveUp, moveDown
3467978 @michaelfeathers Added moveToLine
authored
13 , moveToHome, moveToEnd, moveToLine
13104d3 @michaelfeathers first commit
authored
14 , moveToLineStart, moveToLineEnd
0afdd78 @michaelfeathers Added wordBackward
authored
15 , wordForward, wordBackward
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
16 , frame
13104d3 @michaelfeathers first commit
authored
17 , showRepresentation
18 )
19 where
20
d31b8ba @michaelfeathers Added support for `word forward' with 'w'. Works only on alnums curre…
authored
21 import Char
22
13104d3 @michaelfeathers first commit
authored
23 type Location = (Int, Int)
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
24 data EditBuffer = EditBuffer Int Location String deriving (Eq,Show)
13104d3 @michaelfeathers first commit
authored
25
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
26 emptyBuffer = EditBuffer 0 (0,0) ""
13104d3 @michaelfeathers first commit
authored
27
28 enterCommandMode :: EditBuffer -> EditBuffer
29 enterCommandMode = forceLocation
30
31 getBufferContents:: EditBuffer -> String
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
32 getBufferContents (EditBuffer _ _ contents) = contents
13104d3 @michaelfeathers first commit
authored
33
34 lineCount :: EditBuffer -> Int
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
35 lineCount (EditBuffer _ _ contents) = length . lines $ contents
13104d3 @michaelfeathers first commit
authored
36
37 insertChar :: Char -> EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
38 insertChar ch buffer@(EditBuffer topLine (x, y) contents)
39 | ch == '\n' = EditBuffer topLine (0, y+1) newContents
40 | otherwise = EditBuffer topLine (x+1, y) newContents
13104d3 @michaelfeathers first commit
authored
41 where newContents = before ++ [ch] ++ after
42 (before, after) = split buffer
43
44 deleteChar :: EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
45 deleteChar buffer@(EditBuffer topLine location@(x,y) contents)
13104d3 @michaelfeathers first commit
authored
46 | (currentLineLength buffer == 0) = buffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
47 | otherwise = satX 0 (EditBuffer topLine location newContents)
13104d3 @michaelfeathers first commit
authored
48 where newContents = before ++ (tail after)
49 (before, after) = split buffer
50
c3676ba @michaelfeathers Added `replace char' support with 'r'
authored
51 replaceChar :: Char -> EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
52 replaceChar replacementChar buffer@(EditBuffer topLine location contents) =
1118ee4 @michaelfeathers Some cleanup
authored
53 let newContents = map f . numberedElements $ contents
54 f (ch, pos) = if pos == (absPosition buffer) then replacementChar else ch
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
55 in EditBuffer topLine location newContents
c3676ba @michaelfeathers Added `replace char' support with 'r'
authored
56
13104d3 @michaelfeathers first commit
authored
57 insertLineAfter :: EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
58 insertLineAfter (EditBuffer topLine _ "") = EditBuffer topLine (0,1) "\n"
59 insertLineAfter (EditBuffer topLine (_,y) contents) = EditBuffer topLine (0,y+1) newContents
3467978 @michaelfeathers Added moveToLine
authored
60 where newContents = unlines . map f . numberedLines $ contents
61 f (line, pos) = if pos == y then line ++ "\n" else line
13104d3 @michaelfeathers first commit
authored
62
63 deleteLine :: EditBuffer ->EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
64 deleteLine (EditBuffer topLine location@(_,y) contents) = forceLocation (EditBuffer topLine location newContents)
d31b8ba @michaelfeathers Added support for `word forward' with 'w'. Works only on alnums curre…
authored
65 where newContents = unlines [ line | (line, pos) <- numberedLines contents, pos /= y]
13104d3 @michaelfeathers first commit
authored
66
67 moveLeft, moveRight, moveUp, moveDown :: EditBuffer -> EditBuffer
68 moveLeft = saturate (-1, 0)
69 moveRight = saturate ( 1, 0)
70 moveUp = saturate ( 0,-1)
71 moveDown = saturate ( 0, 1)
72
73 moveToHome :: EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
74 moveToHome (EditBuffer topLine _ contents) = EditBuffer topLine (0,0) contents
13104d3 @michaelfeathers first commit
authored
75
76 moveToEnd :: EditBuffer -> EditBuffer
77 moveToEnd = saturate (lastPos, lastPos)
78 where lastPos = (maxBound :: Int) - 1
79
3467978 @michaelfeathers Added moveToLine
authored
80 moveToLine :: Int -> EditBuffer -> EditBuffer
81 moveToLine lineNumber (EditBuffer topLine (x,y) contents) =
82 forceLocation (EditBuffer topLine (x, lineNumber) contents)
83
13104d3 @michaelfeathers first commit
authored
84 moveToLineStart :: EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
85 moveToLineStart (EditBuffer topLine (_,y) contents) = EditBuffer topLine (0,y) contents
13104d3 @michaelfeathers first commit
authored
86
87 moveToLineEnd :: EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
88 moveToLineEnd buffer@(EditBuffer topLine (_,y) contents) =
89 satX 0 $ (EditBuffer topLine ((currentLineLength buffer), y) contents)
13104d3 @michaelfeathers first commit
authored
90
d31b8ba @michaelfeathers Added support for `word forward' with 'w'. Works only on alnums curre…
authored
91 wordForward :: EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
92 wordForward buffer@(EditBuffer topLine _ contents) =
b2a3e7e @michaelfeathers Made wordForward advance through punct groups
authored
93 case dropSpaces . dropWord . drop (absPosition buffer) . numberedElements $ contents of
d31b8ba @michaelfeathers Added support for `word forward' with 'w'. Works only on alnums curre…
authored
94 [] -> buffer
7df5582 @michaelfeathers Rewrote locationFromPosition
authored
95 ((_,pos) : _) -> EditBuffer topLine (locationFromPosition pos contents) contents
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
96
0afdd78 @michaelfeathers Added wordBackward
authored
97 wordBackward :: EditBuffer -> EditBuffer
98 wordBackward buffer@(EditBuffer topLine _ contents) =
99 case dropWord . dropSpaces . reverse . take (absPosition buffer) . numberedElements $ contents of
a25a23f @michaelfeathers Fixed bug in wordBackword which prevented from moving all the way to …
authored
100 [] -> EditBuffer topLine (locationFromPosition 0 contents) contents
0afdd78 @michaelfeathers Added wordBackward
authored
101 ((_,pos) : _) -> EditBuffer topLine (locationFromPosition (pos+1) contents) contents
102
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
103 frame :: EditBuffer -> EditBuffer
104 frame buffer@(EditBuffer topLine (x,y) contents)
105 | y > topLine + 40 = EditBuffer (y - 40) (x,y) contents
106 | y < topLine = EditBuffer y (x,y) contents
107 | otherwise = buffer
d31b8ba @michaelfeathers Added support for `word forward' with 'w'. Works only on alnums curre…
authored
108
13104d3 @michaelfeathers first commit
authored
109 showRepresentation :: EditBuffer -> String
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
110 showRepresentation (EditBuffer topLine location contents) =
111 show topLine ++ " " ++ show location ++ " " ++ show contents
13104d3 @michaelfeathers first commit
authored
112
113
114 forceLocation = saturate (0,0)
115
116 currentLine :: EditBuffer -> String
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
117 currentLine (EditBuffer _ _ "") = ""
118 currentLine buffer@(EditBuffer _ (_, y) contents)
13104d3 @michaelfeathers first commit
authored
119 | (y < 0) || (y >= (lineCount buffer)) = ""
120 | otherwise = (lines contents) !! y
121
122 currentLineLength :: EditBuffer -> Int
123 currentLineLength = length . currentLine
124
125 split :: EditBuffer -> (String,String)
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
126 split buffer@(EditBuffer _ _ contents) = splitAt point contents
13104d3 @michaelfeathers first commit
authored
127 where point = absPosition buffer
128
129 absPosition :: EditBuffer -> Int
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
130 absPosition (EditBuffer _ (x, y) contents) =
13104d3 @michaelfeathers first commit
authored
131 (x+) . length . unlines . take y . lines $ contents
132
7df5582 @michaelfeathers Rewrote locationFromPosition
authored
133 locationFromPosition :: Int -> String -> Location
134 locationFromPosition pos contents =
1118ee4 @michaelfeathers Some cleanup
authored
135 let foreLines = init . lines . take (pos + 1) $ contents
136 x = pos - (length $ unlines foreLines)
137 y = length foreLines
7df5582 @michaelfeathers Rewrote locationFromPosition
authored
138 in (x, y)
d31b8ba @michaelfeathers Added support for `word forward' with 'w'. Works only on alnums curre…
authored
139
b2a3e7e @michaelfeathers Made wordForward advance through punct groups
authored
140 isPunct :: Char -> Bool
0afdd78 @michaelfeathers Added wordBackward
authored
141 isPunct ch = isAscii ch && not (isAlphaNum ch) && not (isSpace ch) && not (isControl ch)
b2a3e7e @michaelfeathers Made wordForward advance through punct groups
authored
142
143 dropWord :: [(Char,a)] -> [(Char,a)]
144 dropWord [] = []
1118ee4 @michaelfeathers Some cleanup
authored
145 dropWord all@((ch,_):_)
b2a3e7e @michaelfeathers Made wordForward advance through punct groups
authored
146 | isPunct ch = dropPuncts all
147 | isAlphaNum ch = dropAlphaNums all
148 | otherwise = all
149
150 dropPuncts, dropSpaces, dropAlphaNums :: [(Char,a)] -> [(Char,a)]
151 dropPuncts = dropInNumbered isPunct
152 dropSpaces = dropInNumbered isSpace
153 dropAlphaNums = dropInNumbered isAlphaNum
154
155 dropInNumbered :: (Char -> Bool) -> [(Char,a)] -> [(Char,a)]
156 dropInNumbered f = dropWhile (\(ch,_) -> f ch)
157
13104d3 @michaelfeathers first commit
authored
158 saturate :: (Int,Int) -> EditBuffer -> EditBuffer
159 saturate (adjX,adjY) = satX adjX . satY adjY
160
161 satX :: Int -> EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
162 satX adjX buffer@(EditBuffer topLine (x,y) contents) =
163 EditBuffer topLine (saturateValue (currentLineLength buffer) (x + adjX), y) contents
13104d3 @michaelfeathers first commit
authored
164
165 satY :: Int -> EditBuffer -> EditBuffer
91a14d4 @michaelfeathers Added autoscrolling via frame function on EditBuffer
authored
166 satY adjY buffer@(EditBuffer topLine (x,y) contents) =
167 EditBuffer topLine (x, saturateValue (lineCount buffer) (y + adjY)) contents
13104d3 @michaelfeathers first commit
authored
168
169 saturateValue :: Int -> Int -> Int
170 saturateValue bound value
171 | bound <= 1 = 0
172 | value <= 0 = 0
173 | value >= bound = bound - 1
174 | otherwise = value
175
d31b8ba @michaelfeathers Added support for `word forward' with 'w'. Works only on alnums curre…
authored
176 numberedElements :: [a] -> [(a,Int)]
177 numberedElements = (flip zip) [0..]
178
179 numberedLines :: String -> [(String,Int)]
180 numberedLines = numberedElements . lines
13104d3 @michaelfeathers first commit
authored
181
Something went wrong with that request. Please try again.