EdKeyboard.icl 3.64 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1 2
implementation module EdKeyboard

3 4
// handling keyboard events

Diederik van Arkel's avatar
Diederik van Arkel committed
5 6
import StdClass, StdBool, StdArray, StdInt, StdChar, StdTuple, StdList, StdMisc
import StdIOCommon, StdWindow, StdPSt
7 8
import EdVisualText, EdVisualCursor, EdSelection, EdAction, EdKeyMapping, EdState
import StrictList
Diederik van Arkel's avatar
Diederik van Arkel committed
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
import EdActionType

//from dodebug import trace_n`
trace_n _ f :== f

backspaceKey	:== '\b'
//returnKey		:== '\n'
tabKey			:== '\t'

/* editWindowKeyboard wraps the monadic keyboard function, so that the type
 * conforms to that of a call-back function in the Object I/O library.
 */
editWindowKeyboard ::	KeyMapping
	KeyboardState
	!(!EditState, !PSt PLocState)
	->
	(!EditState, !PSt PLocState)
editWindowKeyboard keyMapping keyboardState state
  # state = noResult 
			  (	getFontInfo						>>>= \{autoTab} ->
			    keyboard autoTab keyboardState
			  )
					  state
  = state
where
	/* The keyboard function ignores 'key up'-events. In the case of 'key down' events,
	 * the cursor is temporarily disabled and the event is passed to keyDown.
	 */
	 
	//keyboard :: KeyboardState -> EditMonad (PSt .l .p) nothing
	keyboard _ (SpecialKey _ KeyUp _)	= skip
	keyboard _ (CharKey _ KeyUp)		= skip
	keyboard _ KeyLost					= skip
	keyboard autoTab keyboardState		= keyDown keyboardState
	
	where
		keyDown :: KeyboardState -> EditMonad (PSt PLocState) nothing
		
		keyDown keyboardState=:(SpecialKey key _ _)								// special keys
		  | key == enterKey || key == returnKey
		  	= (enterKeyAction autoTab)
		  = let maybeAction	= findAction keyboardState keyMapping in
			onlyIf (not (isNothing maybeAction)) 
			  ( performAction (fromJust maybeAction) )
		
		keyDown (CharKey char _)												// character keys
//		  | char == returnKey
//			= (enterKeyAction autoTab)
		  | (asciiCode >= 32 || asciiCode == toInt tabKey) && asciiCode <> 127
			= performAction (Insert (SCons (toString char) SNil))
		  | otherwise
		    = skip
		  where
		    asciiCode = toInt char
		   
		keyDown KeyLost = skip
	
noeditWindowKeyboard ::
	KeyMapping KeyboardState (!EditState, !PSt PLocState)
	-> (!EditState, !PSt PLocState)
noeditWindowKeyboard keyMapping keyboardState state
  # state = noResult 
			  (	getFontInfo						>>>= \{autoTab} ->
			    keyboard autoTab keyboardState	
			  )
					  state
  = state
where
	/* The keyboard function ignores 'key up'-events. In the case of 'key down' events,
	 * the cursor is temporarily disabled and the event is passed to keyDown.
	 */
	 
	//keyboard :: KeyboardState -> EditMonad (PSt .l .p) nothing
	keyboard _ (SpecialKey _ KeyUp _)	= skip
	keyboard _ (CharKey _ _)			= skip
	keyboard _ (KeyLost)				= skip
	keyboard autoTab keyboardState		= keyDown keyboardState
	
	where
		//keyDown :: KeyboardState -> EditMonad (PSt .l .p) nothing
		
		keyDown keyboardState=:(SpecialKey key _ _)								// special keys
		  | key == enterKey = skip
		  = let maybeAction	= findAction keyboardState keyMapping in
			onlyIf (isSafe maybeAction) 
			  ( performAction (fromJust maybeAction) )
		keyDown _ = skip
		
		isSafe Nothing = False
		isSafe (Just (Insert _)) = False
		isSafe (Just (Remove _)) = False
		isSafe _ = True
//--

enterKeyAction autoTab
	:== case autoTab of
			True	-> autoinAction
106
			_		-> performAction (Insert (SCons "" (SCons "" SNil)))	// ["",""]
Diederik van Arkel's avatar
Diederik van Arkel committed
107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
where
	autoinAction =
		getText					>>>= \text ->
		getSelection			>>>= \{start} ->
		// if first line start in col 0...
		let
			(line,_) = getLine start.row text
			front = stripfront (line%(0,dec start.col))
		in
		performAction (Insert (SCons "" (SCons front SNil)))

	stripfront :: String -> String
	stripfront s
		= f 0
	where
		m = size s
		f i
			| i >= m
			= s
			# c = s.[i]
			| c == '\t' || c == ' '
				= f (inc i)
			= s % (0,dec i)