EdAction.icl 9.2 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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
implementation module EdAction

import StdInt, StdArray, StdTuple, StdBool, StdChar, StdList, StdMisc
import StdIOCommon, StdPSt, StdWindow
import EdVisualCursor, EdVisualText, EdMovement, StrictList, EdMonad
import EdActionType, EdSelection

import EdCommon

performAction :: Action -> EditMonad (PSt PLocState) nothing
performAction action =
        // things to do before the action is applied
        undoStuff action									>>>
		vHideCursor											>>>
        onlyIf (needsCenterCursor action) 
                vCenterCursor								>>>
        getSelection										>>>= \selection ->
        onlyIf (needsResetVirtualX action selection)
                ( setVirtualX 0 )							>>>
        onlyIf (needsRemoveSelection action)
                removeSelectionIfNecessary					>>>= \selectionRemoved ->
        // apply the action
        applyAction selectionRemoved action					>>>
        vShowCursor

applyAction :: Bool Action -> EditMonad (PSt PLocState) nothing
applyAction selectionRemoved action =
        case action of

          // Move actions are performed in the following way. If there is a selection,
          // the cursor moves to the start or end of the selection. Otherwise, the
          // new position is computed by "positionAfterMove". After moving the cursor,
          // the selection is emptied and hidden.
         
          Move move ->
                getSelection                                  >>>= \selection ->
                IF (selection.start == selection.end)
                THEN
                  ( positionAfterMove move selection.start          >>>= \newPos ->
	                vChangeSelectionTo {start=newPos,end=newPos}	>>>
	                mChangeSelectionTo {start=newPos,end=newPos}	>>>
					IF (move == PageUp || move == PageDown)
					THEN
						(vMoveCursor move)
					ELSE
						vScrollToCursor
				  )
                ELSE 
                  (
                      ( if (isMember move [CharLeft,WordLeft,PageUp,LineUp,StartOfLine])
                                    (result (orderSelection selection).start)
                                    (case move of
                                    	StartOfText	-> positionAfterMove move selection.start
                                    	EndOfText	-> positionAfterMove move selection.start
                                    	_			-> result (orderSelection selection).end
                                    )
                      )                                             >>>= \newPos ->
	                vChangeSelectionTo {start=newPos,end=newPos}	>>>
	                mChangeSelectionTo {start=newPos,end=newPos}	>>>
					vScrollToCursor
                  )

          // The insert action is mainly done by "vInsertText". It inserts the
          // text into the internal representation and then redraws as much of
          // the screen as is necessary. After inserting the text, the cursor
          // is position behind that text.
          
          Insert fragment ->
            getSelection                                  >>>= \selection ->
            let newPos = positionAfterText selection.start fragment
            in
            vInsertText selection.start fragment            >>>
            vChangeSelectionTo {start=newPos,end=newPos}    >>> 
            mChangeSelectionTo {start=newPos,end=newPos}    >>>
			vScrollToCursor									>>>
            setNeedSave True

          // Scrolling has no effect on the cursor position. It just 
          // changes which part of the whole view domain is visible.
          
          Scroll move ->
                getFontInfo                                  >>>= \{lineHeight} ->
                getText                                      >>>= \text ->
                getWindowId                                  >>>= \windowId ->
                accEnv (accPIO (getWindowViewFrame windowId))>>>= \frame ->
                let
                	linesInFrame        = (frame.corner2.y - frame.corner1.y) / lineHeight
                    pagePixels          = (linesInFrame - 1) * lineHeight 
                    topPixel			= 0
                    botPixel			= textLength text * lineHeight
                    newTopPixel         = case move of
                                            PageUp          -> max topPixel (frame.corner1.y - pagePixels)
                                            PageDown        -> min botPixel (frame.corner1.y + pagePixels)
                                            StartOfText     -> topPixel
                                            EndOfText       -> botPixel - pagePixels
                                            _				-> frame.corner1.y	// if unknown -> ignore
 
                in
                appEnv (appPIO (moveWindowViewFrame windowId {vx=0, vy=newTopPixel-frame.corner1.y}))
 
          // A select action changes the current selection if there is any and
          // otherwise starts a new one.
          
          Select move ->
			getSelection                                            >>>= \selection ->
			positionAfterMove move selection.end                    >>>= \newPos ->
			let selectionStart = selection.start
			in
			vChangeSelectionTo {start=selectionStart,end=newPos}	>>>
			mChangeSelectionTo {start=selectionStart,end=newPos}	>>>
			vScrollToCursor									

          // A remove action has to remove the selection if there is any. This
          // has already been done by the 'preprocessing' in "performAction".
          // If that preprocessing has removed the selection, nothing has to
          // be done here. Otherwise, the position after the movement is computed
          // and every character from the original position to the new one is
          // removed.
          
          Remove move ->
                setNeedSave True                                >>>
            IF selectionRemoved
            THEN skip
            ELSE
              (
                getSelection									>>>= \{start} ->
                positionAfterMove move start                    >>>= \newPos ->
                setSelection {start=start,end=newPos}           >>>
                vRemoveSelection								>>>
				mRemoveSelection
              )													>>>
			vScrollToCursor									
              

          _ ->
                abort "applyAction (EdAction.icl): unknown action"

where
        positionAfterText :: !Position !TextFragment -> Position
        positionAfterText position SNil = position
        positionAfterText {col, row} (SCons string SNil)
          = {col=col+size string, row=row}
        positionAfterText {row} strings
          = {col=size (slLast strings), row=row+slLength strings-1}


// The "needs..." functions specify whether certain actions
// need certain preprocessing or postprocessing.
 
needsCenterCursor :: Action -> Bool
needsCenterCursor (Scroll _)    = False
needsCenterCursor _             = True

needsRemoveSelection :: Action -> Bool
needsRemoveSelection (Remove _) = True
needsRemoveSelection (Insert _) = True
needsRemoveSelection _                  = False

needsResetVirtualX :: Action Selection -> Bool
needsResetVirtualX (Scroll _) _ = False
needsResetVirtualX (Move move) selection
  | isVerticalMove move
    = not (isEmptySelection selection)
    = True
needsResetVirtualX (Select move) _
  = not (isVerticalMove move)
needsResetVirtualX _ _ = True

// removeSelectionIfNecessary removes the selection if there
// is any. It also results a boolean to indicate whether removal
// was necessary.

removeSelectionIfNecessary :: EditMonad (PSt PLocState) Bool
removeSelectionIfNecessary
  = getSelection                                                >>>= \selection ->
        IF (not (isEmptySelection selection))
        THEN
          (
                vRemoveSelection                                >>>
 				mRemoveSelection								>>>
                result True
          )
        ELSE
          ( result False )

Diederik van Arkel's avatar
Diederik van Arkel committed
186
undoStuff :: !Action -> EditMonad (PSt .l) nothing
Diederik van Arkel's avatar
Diederik van Arkel committed
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
undoStuff (Insert _) =
        getUndoInfo                                     >>>= \undoinfo ->
        case undoinfo.uninfo of
        (InsertInfo True _) -> skip
        _ ->
                getState                                >>>= \state ->
                setUndoInfo {state=Undo,action=" Typing",uninfo=(InsertInfo True state)}
undoStuff (Remove _) =
        getUndoInfo                                     >>>= \undoinfo ->
        case undoinfo.uninfo of
        (RemoveInfo True _) -> skip
        _ ->
                getState                                >>>= \state ->
                setUndoInfo {state=Undo,action=" Deletion",uninfo=(RemoveInfo True state)}
undoStuff _ =
        getUndoInfo                                     >>>= \undoinfo ->
        case undoinfo.uninfo of
        (InsertInfo True state) -> setUndoInfo {undoinfo & uninfo=(InsertInfo False state)}
        (RemoveInfo True state) -> setUndoInfo {undoinfo & uninfo=(RemoveInfo False state)}
        _ -> skip

Diederik van Arkel's avatar
Diederik van Arkel committed
208
undoAction :: EditMonad (PSt .l) nothing
Diederik van Arkel's avatar
Diederik van Arkel committed
209
210
211
212
213
214
215
undoAction =
        getUndoInfo                                     >>>= \undoinfo ->
        getState                                        >>>= \fin ->
        case undoinfo.uninfo of
        (InsertInfo _ ini) -> setUndoInfo {undoinfo & uninfo=(UndoneInfo ini fin)}
        (RemoveInfo _ ini) -> setUndoInfo {undoinfo & uninfo=(UndoneInfo ini fin)}
        _ -> skip