EdText.icl 3.73 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
/*
 * EdText.icl: operations on text areas (extends EdLineText)
 */

implementation module EdText

import StdClass, StdArray, StdMisc, StdInt, StdString, StdMaybe
import EdLineText, EdSelection
import StrictList

getTextFragment :: !Selection !Text -> (!TextFragment, !Text)
getTextFragment {start={col=col1,row=row1},end={col=col2,row=row2}} text
  // selection is within one line ?
  | row1 == row2 
	# (line, text) = getLine row1 text
	= ( SCons (line % (col1, col2 - 1)) SNil
	  , text
	  )
  // selection contains more than one line
  # (SCons firstLine restLines, text) 
				= getLines row1 row2 text
  = ( SCons (firstLine % (col1, size firstLine - 1)) 
		   (chopLastLine restLines)
	, text
	)
where
	chopLastLine SNil 
	  = SNil
	chopLastLine (SCons lastLine SNil)
	  = SCons (lastLine % (0, col2 - 1)) SNil
	chopLastLine (SCons aLine lines)
	  = SCons aLine (chopLastLine lines)

removeText :: !Selection !Text -> (Maybe Int,Text)
removeText {start={col=col1,row=row1},end={col=col2,row=row2}} text
  # (firstLine, text)	= getLine row1 text
  // selection within one line?
  | row1 == row2 
	# (fin,text)		= updateLine row1 
							(	firstLine % (0, col1 - 1) 
							+++ firstLine % (col2, size firstLine - 1)
							) text
	= (Just fin,text)
  // selection contains more than one line
  # (lastLine, text)	= getLine row2 text
  # newLine				= firstLine % (0, col1 - 1) +++ 
						  lastLine	% (col2, size lastLine - 1)
  # (_,text)			= updateLine row1 newLine text
  # text				= removeLines (row1 + 1) row2 text
  = (Nothing,text)

insertText :: !Position !TextFragment !Text -> (Maybe Int,Text)
insertText { col, row } strings text
  # (line, text) = getLine row text
	left  = line % (0, col - 1)
	right = line % (col, size line - 1)
  // no strings at all
  | nrOfStrings == 0
	= (Nothing,text)
  // insertion in a single line
  | nrOfStrings == 1
	# newLine = left +++ slHead strings +++ right
	# (fin,text) = updateLine row newLine text
	= (Just fin,text)
  // insertion of more than one line
  # fragment
	  = SCons
	  		(left +++ slHead strings)
			(appendToLastLine (slTail strings) right)
  // deze volgorde om ruzie met removeLine in combinatie met newText te vermijden...
  # text = insertLines (inc row) fragment text
  # text = removeLine row text
  = (Nothing,text )
where
	nrOfStrings = slLength strings

replaceText :: !Selection !TextFragment !Text -> !Text
replaceText sel=:{start={col=col1,row=row1},end={col=col2,row=row2}} strings text
	# (firstLine, text)	= getLine row1 text
	# (lastLine, text)	= if (row1==row2)
							(firstLine,text)
							(getLine row2 text)
	# left = firstLine%(0, col1 - 1)
	# right = lastLine%(col2, size lastLine - 1)
	# text				= if (row1 == row2)
							text
							(removeLines (row1 + 1) row2 text)
	// no strings at all
	| nrOfStrings == 0
		# newLine			= left +++ right
		# (_,text)			= updateLine row1 newLine text
		= text
	// insertion in a single line
	| nrOfStrings == 1
		# newLine			= left +++ slHead strings +++ right
		# (_,text)			= updateLine row1 newLine text
		= text
	// insertion of more than one line
	# fragment = SCons
	  		(left +++ slHead strings)
			(appendToLastLine (slTail strings) right)
	// deze volgorde om ruzie met removeLine in combinatie met newText te vermijden...
	# text = insertLines (inc row1) fragment text
	# text = removeLine row1 text
	= text
where
	nrOfStrings = slLength strings

appendText :: !TextFragment !Text -> Text
appendText SNil text
	= text
appendText strings text
	# text = appendLines` strings text
	= text

appendToLastLine :: .(StrictList String) String -> .StrictList String
appendToLastLine (SCons string SNil) right
  = SCons (string +++ right) SNil
appendToLastLine (SCons string strings) right
  = SCons string (appendToLastLine strings right)
appendToLastLine SNil right
  = SCons right SNil