EdActionType.icl 2.77 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
3
4
5
implementation module EdActionType

import StdOverloaded, StdArray, StdInt, StdString, StdChar, StdList
import StrictList
import EdMovement
6
from EdText import :: TextFragment
Diederik van Arkel's avatar
Diederik van Arkel committed
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

:: Action
        = Move          Movement
        | Insert        TextFragment
//		| InsertChar	Char			// DvA: try this for typing speed?
        | Scroll        Movement
        | Select        Movement
        | Remove        Movement

instance toString Action where
  toString (Move   movement) = "Move to "   +++ toString movement
  toString (Scroll movement) = "Scroll to " +++ toString movement 
  toString (Select movement) = "Select to " +++ toString movement
  toString (Remove movement) = "Remove to " +++ toString movement
  toString (Insert fragment) = "Insert " +++ toStr fragment
  toString _                 = "toString (EdAction.icl): unknown action"

instance fromString Action
where
	fromString s
		# (move,s) = hasprefix "Move to " s
		| move = Move (fromString s)
		# (scroll,s) = hasprefix "Scroll to " s
		| scroll  = Scroll (fromString s)
		# (select,s) = hasprefix "Select to " s
		| select = Select (fromString s)
		# (remove,s) = hasprefix "Remove to " s
		| remove = Remove (fromString s)
		# (insert,s) = hasprefix "Insert " s
		| insert = Insert (fromStr s)
		= Scroll StartOfText	// silly default
	where
		hasprefix p s
			# x = size p - 1
			| p == s%(0,x)
				= (True,s%(x+1,size s - 1))
			= (False,s)

//toStr TextFragment
toStr SNil = ""
toStr (SCons t ts)
	= tosafe t +++ toStr ts

//fromStr TextFragment
fromStr "" = SNil
fromStr s
	# (l,r) = fromsafe s
	= SCons l (fromStr r)

tosafe "" = "$@"
tosafe s
	| s.[0] == '$'
		= "$!" +++ tosafe s%(1,size s - 1)
	= s%(0,0) +++ tosafe s%(1,size s - 1)

fromsafe s
	# (dollar,s) = hasprefix "$!" s
	| dollar
		# (l,r) = fromsafe s
		= ("$"+++l,r)
	# (eoflin,s) = hasprefix "$@" s
	| eoflin
		= ("",s)
	# (l,r) = fromsafe (s%(1,size s - 1))
	= (s%(0,0)+++l,r)
where
	hasprefix p s
		# x = size p - 1
		| p == s%(0,x)
			= (True,s%(x+1,size s - 1))
		= (False,s)

instance == Action
where
  (==) (Move   movement)        (Move   movement`)      = movement == movement`
  (==) (Scroll movement)        (Scroll movement`)      = movement == movement`
  (==) (Select movement)        (Select movement`)      = movement == movement`
  (==) (Remove movement)        (Remove movement`)      = movement == movement`
  (==) (Insert text)            (Insert text`)          = text == text`
  (==) _                                        _       = False

allActions :: [Action]
allActions
  =      [ Move   movement \\ movement <- allMovements ]
  ++ [ Select movement \\ movement <- allMovements ]
  ++ [ Scroll movement \\ movement <- [ PageUp, PageDown, StartOfText, EndOfText ] ]
  ++ [ Remove movement \\ movement <- [ CharLeft, CharRight, WordLeft, WordRight, StartOfLine, EndOfLine ] ]