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)