EdAction.icl 9.38 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
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}	>>>
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's avatar
Diederik van Arkel committed
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}	>>>
60 61 62
// DvA: we know we are going from selection to no selection so...
//	                mChangeSelectionTo {start=newPos,end=newPos}	>>>
					mRemoveSelection								>>>
Diederik van Arkel's avatar
Diederik van Arkel committed
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's avatar
Diederik van Arkel committed
189
undoStuff :: !Action -> EditMonad (PSt .l) nothing
Diederik van Arkel's avatar
Diederik van Arkel committed
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's avatar
Diederik van Arkel committed
211
undoAction :: EditMonad (PSt .l) nothing
Diederik van Arkel's avatar
Diederik van Arkel committed
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