EdAction.icl 9.38 KB
 Diederik van Arkel committed Oct 08, 2001 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 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} >>>  Diederik van Arkel committed Feb 12, 2002 41 42 // DvA: can skip this as we know we are going from no selection to no selection... // mChangeSelectionTo {start=newPos,end=newPos} >>>  Diederik van Arkel committed Oct 08, 2001 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59  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} >>>  Diederik van Arkel committed Feb 12, 2002 60 61 62 // DvA: we know we are going from selection to no selection so... // mChangeSelectionTo {start=newPos,end=newPos} >>> mRemoveSelection >>>  Diederik van Arkel committed Oct 08, 2001 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 186 187 188  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 committed Oct 24, 2001 189 undoStuff :: !Action -> EditMonad (PSt .l) nothing  Diederik van Arkel committed Oct 08, 2001 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 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 committed Oct 24, 2001 211 undoAction :: EditMonad (PSt .l) nothing  Diederik van Arkel committed Oct 08, 2001 212 213 214 215 216 217 218 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