Commit 2d67a49a authored by Diederik van Arkel's avatar Diederik van Arkel
Browse files

More Editor state threading

parent 18653865
...@@ -15,7 +15,7 @@ from StdString import String ...@@ -15,7 +15,7 @@ from StdString import String
from StdPSt import PSt, IOSt from StdPSt import PSt, IOSt
import EdMonad import EdMonad
editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture) editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture))
// editWindowLook: defines the look of the editor window. This function // editWindowLook: defines the look of the editor window. This function
// is used to handle update events. // is used to handle update events.
......
...@@ -15,12 +15,12 @@ trace_n _ f :== f ...@@ -15,12 +15,12 @@ trace_n _ f :== f
// editWindowLook: updating the affected areas is done by updating // editWindowLook: updating the affected areas is done by updating
// each of the rectangles. // each of the rectangles.
editWindowLook :: EditState SelectState !UpdateState -> (!*Picture -> *Picture) editWindowLook :: EditState -> (EditState, SelectState !UpdateState -> (!*Picture -> *Picture))
editWindowLook editState selectState updateState=:{ updArea, newFrame, oldFrame } editWindowLook editState
= trace_n ("Look",updateState) editWindowLook` = (editState`,editWindowLook`)
where where
editWindowLook` :: !*Picture -> *Picture // editWindowLook` :: !*Picture -> *Picture
editWindowLook` picture editWindowLook` selectState updateState=:{ updArea, newFrame, oldFrame } picture
// # picture = traceUpdate updArea picture // # picture = traceUpdate updArea picture
# updArea = cleanUpdate updArea // hack around object i/o bug... # updArea = cleanUpdate updArea // hack around object i/o bug...
// # picture = traceUpdate updArea picture // # picture = traceUpdate updArea picture
...@@ -34,7 +34,7 @@ where ...@@ -34,7 +34,7 @@ where
(text,ds2) = getText ds1 (text,ds2) = getText ds1
(visible,ds3) = getCursorVisibility ds2 (visible,ds3) = getCursorVisibility ds2
(height,ds4) = getCursorHeight ds3 (height,ds4) = getCursorHeight ds3
(selection=:{end},_) = getSelection ds4 (selection=:{end},(editState`,_)) = getSelection ds4
/* /*
import StdDebug,dodebug import StdDebug,dodebug
......
...@@ -7,15 +7,14 @@ definition module EdMessage ...@@ -7,15 +7,14 @@ definition module EdMessage
from StdId import Id,RId,Ids from StdId import Id,RId,Ids
from StdPSt import PSt, IOSt from StdPSt import PSt, IOSt
from StdReceiver import Receiver2, R2Id, Receiver2Function, ReceiverAttribute from StdReceiver import Receiver2, R2Id, Receiver2Function, ReceiverAttribute
from EdMonad import EditState from EdMonad import EditState, EditMonad
:: EditId :: EditId
:: Message :: Message
:: EditAction l a :== EditMonad (PSt l) a
openEditId :: *env -> (EditId, *env) | Ids env openEditId :: *env -> (EditId, *env) | Ids env
openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt *l) openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt *l)
hasEditState :: !EditId !*(PSt *l) -> *(Bool, *PSt *l) hasEditState :: !EditId !*(PSt *l) -> *(Bool, *PSt *l)
getEditState :: !EditId !*(PSt *l) -> *(EditState, *PSt *l) appEditState :: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l)
setEditState :: !EditId !EditState !*(PSt *l) -> *PSt *l
...@@ -16,6 +16,8 @@ import EdMonad ...@@ -16,6 +16,8 @@ import EdMonad
| MsgGet // ask for the state | MsgGet // ask for the state
| MsgOk // signifies that a send operation was successful | MsgOk // signifies that a send operation was successful
:: EditAction l a :== EditMonad (PSt l) a
openEditId :: *env -> (EditId, *env) | Ids env openEditId :: *env -> (EditId, *env) | Ids env
openEditId pstate openEditId pstate
= openR2Id pstate = openR2Id pstate
...@@ -41,6 +43,15 @@ hasEditState editId pstate ...@@ -41,6 +43,15 @@ hasEditState editId pstate
# ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate # ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate
= (isJust maybeResp, pstate) = (isJust maybeResp, pstate)
// appEditState
appEditState :: !EditId !.(EditAction *l .r) !*(PSt *l) -> *(.r,*PSt *l)
appEditState editId monad pState
# (editState, pState) = getEditState editId pState
# (x, (editState, pState)) = monad (editState, pState)
# pState = setEditState editId editState pState
= (x, pState)
// getEditState // getEditState
getEditState :: !EditId !*(PSt *l) -> *(EditState, *PSt *l) getEditState :: !EditId !*(PSt *l) -> *(EditState, *PSt *l)
......
...@@ -382,7 +382,10 @@ updateLook :: EditMonad (PSt *l) nothing ...@@ -382,7 +382,10 @@ updateLook :: EditMonad (PSt *l) nothing
updateLook updateLook
= getWindowId >>>= \windowId -> = getWindowId >>>= \windowId ->
getEditState >>>= \editState -> getEditState >>>= \editState ->
appEnv (appPIO (setWindowLook windowId False (True,editWindowLook editState))) let
(editState,editLook) = editWindowLook editState
in
appEnv (appPIO (setWindowLook windowId False (True,editLook)))
// compute some properties of a font // compute some properties of a font
......
...@@ -22,7 +22,7 @@ instance Editor (PSt *p) | Editor p ...@@ -22,7 +22,7 @@ instance Editor (PSt *p) | Editor p
initEditorState :: !KeyMapping -> EditorState initEditorState :: !KeyMapping -> EditorState
findReceiver :: !Id !EditorState -> Maybe EditId findReceiver :: !Id !EditorState -> (!Maybe EditId, !EditorState)
addReceiver :: Id EditId !EditorState -> EditorState addReceiver :: Id EditId !EditorState -> EditorState
removeReceiver :: Id !EditorState -> EditorState removeReceiver :: Id !EditorState -> EditorState
......
...@@ -46,10 +46,10 @@ removeReceiver windowId editorState=:{ windows } ...@@ -46,10 +46,10 @@ removeReceiver windowId editorState=:{ windows }
// lookup the window identification number in the global administration // lookup the window identification number in the global administration
findReceiver :: !Id !EditorState -> Maybe EditId findReceiver :: !Id !EditorState -> (!Maybe EditId, !EditorState)
findReceiver windowId { windows } findReceiver windowId (es=:{ windows })
| isEmpty matches = Nothing | isEmpty matches = (Nothing, es)
| otherwise = Just (hd matches) | otherwise = (Just (hd matches), es)
where where
matches = tableLookup windowId windows matches = tableLookup windowId windows
...@@ -24,13 +24,14 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps ...@@ -24,13 +24,14 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps
// compute the view domain of the visual text // compute the view domain of the visual text
(viewDomain, (editState, ps)) = computeViewDomain (editState, ps) (viewDomain, (editState, ps)) = computeViewDomain (editState, ps)
// setup the window attributes // setup the window attributes
(editState,editLook) = editWindowLook editState
windowAttrs = atts ++ // in this order so that new attributes override default atts windowAttrs = atts ++ // in this order so that new attributes override default atts
[ WindowViewSize { w = 800, h = fontInfo.FontInfo.lineHeight * 40 } [ WindowViewSize { w = 800, h = fontInfo.FontInfo.lineHeight * 40 }
, WindowHMargin 0 0 , WindowHMargin 0 0
, WindowVMargin 0 0 , WindowVMargin 0 0
, WindowId windowId , WindowId windowId
, WindowViewDomain viewDomain , WindowViewDomain viewDomain
, WindowLook True (editWindowLook editState) , WindowLook True editLook
, WindowHScroll (hScrollFun fontInfo) , WindowHScroll (hScrollFun fontInfo)
, WindowVScroll (vScrollFun fontInfo) , WindowVScroll (vScrollFun fontInfo)
, WindowPos (Fix, OffsetVector {vx=10, vy=10}) , WindowPos (Fix, OffsetVector {vx=10, vy=10})
...@@ -48,11 +49,12 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps ...@@ -48,11 +49,12 @@ openEditWindow uId title pathName text font tabs syncols windowId atts ps
closeEditWindow :: !Id !*(PSt *b) -> *PSt *b | Editor b; closeEditWindow :: !Id !*(PSt *b) -> *PSt *b | Editor b;
closeEditWindow windowId pState closeEditWindow windowId pState
# (editorState,pState) = getEditorState pState # (editorState,pState) = getEditorState pState
# notEdit = isNothing (findReceiver windowId editorState) # (maybeEditId, editorState) = findReceiver windowId editorState
| notEdit = setEditorState editorState pState | isNothing maybeEditId
# editorState = removeReceiver windowId editorState = setEditorState editorState pState
pState = closeWindow windowId pState # editorState = removeReceiver windowId editorState
pState = closeWindow windowId pState
= setEditorState editorState pState = setEditorState editorState pState
/********************** /**********************
......
definition module EdClient definition module EdClient
import EdMonad, EdState, EdCommon import EdMonad, EdState, EdCommon
from EdMessage import EditAction
sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
message :: !.Id !.(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b; message :: !.Id !.(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b;
:: EditAction l a :== EditMonad (PSt l) a
// Messages // Messages
msgSave :: EditAction *l nothing msgSave :: EditAction *l nothing
......
...@@ -12,13 +12,13 @@ import ExtNotice, StrictList ...@@ -12,13 +12,13 @@ import ExtNotice, StrictList
//sendToActiveWindow :: (EditAction .l .p a) (EditorState,(PSt .l)) -> (Maybe a, (EditorState,(PSt .l))) //sendToActiveWindow :: (EditAction .l .p a) (EditorState,(PSt .l)) -> (Maybe a, (EditorState,(PSt .l)))
sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b sendToActiveWindow :: .(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
sendToActiveWindow editAction pState sendToActiveWindow editAction pState
# (maybeId, pState) = accPIO getActiveWindow pState # (maybeId, pState) = accPIO getActiveWindow pState
| isNothing maybeId | isNothing maybeId
= (Nothing,pState) // fail silently = (Nothing,pState) // fail silently
# windowId = fromJust maybeId # windowId = fromJust maybeId
(editorState,pState) = getEditorState pState (editorState,pState) = getEditorState pState
notEdit = isNothing (findReceiver windowId editorState) # (maybeEditId, editorState) = findReceiver windowId editorState
| notEdit | isNothing maybeEditId
= (Nothing,pState) = (Nothing,pState)
= message windowId editAction pState = message windowId editAction pState
...@@ -26,19 +26,15 @@ sendToActiveWindow editAction pState ...@@ -26,19 +26,15 @@ sendToActiveWindow editAction pState
message :: !.Id !.(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b; message :: !.Id !.(*(EditState,*PSt *b) -> *(.c,*(.EditState,*PSt *b))) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b;
message windowId monad pState message windowId monad pState
# (editorState, pState) = getEditorState pState # (editorState, pState) = getEditorState pState
# maybeEditId = findReceiver windowId editorState # (maybeEditId, editorState) = findReceiver windowId editorState
| isNothing maybeEditId | isNothing maybeEditId
= (Nothing, setEditorState editorState pState) = (Nothing, setEditorState editorState pState)
# editId = fromJust maybeEditId # editId = fromJust maybeEditId
# (editState, pState) = getEditState editId pState # (x, pState) = appEditState editId monad pState
# (x, (editState, pState)) = monad (editState, pState)
# pState = setEditState editId editState pState
# pState = setEditorState editorState pState # pState = setEditorState editorState pState
= (Just x, pState) = (Just x, pState)
:: EditAction l a :== EditMonad (PSt l) a
// Messages // Messages
msgSave :: EditAction *l nothing msgSave :: EditAction *l nothing
......
...@@ -23,15 +23,13 @@ definition module EdClient ...@@ -23,15 +23,13 @@ definition module EdClient
import StdMaybe, StdId, StdPSt, StdPicture, StdPrint import StdMaybe, StdId, StdPSt, StdPicture, StdPrint
from EdState import Editor, EditorState from EdState import Editor, EditorState
from EdMessage import EditId from EdMessage import EditId, EditAction
from EdLineText import Text from EdLineText import Text
import EdPosition import EdPosition
from EdSelection import Selection, emptySelection, lineSelection from EdSelection import Selection, emptySelection, lineSelection
from EdMonad import UndoState, EditMonad, EditState, StateM, getPathName from EdMonad import UndoState, EditMonad, EditState, StateM, getPathName
import IdeState import IdeState
:: EditAction l a :== EditMonad (PSt l) a
isEditWin :: Id *(PSt *a) -> *(Bool,*PSt *a) | Editor a isEditWin :: Id *(PSt *a) -> *(Bool,*PSt *a) | Editor a
// "Remote method invocations". The destination is denoted by a window identifier. // "Remote method invocations". The destination is denoted by a window identifier.
......
...@@ -33,12 +33,10 @@ import EdText ...@@ -33,12 +33,10 @@ import EdText
import IdeState, UtilNewlinesFile import IdeState, UtilNewlinesFile
:: EditAction l a :== EditMonad (PSt l) a
isEditWin :: Id *(PSt *a) -> *(Bool,*PSt *a) | Editor a isEditWin :: Id *(PSt *a) -> *(Bool,*PSt *a) | Editor a
isEditWin windowId pState isEditWin windowId pState
# (editorState, pState) = getEditorState pState # (editorState, pState) = getEditorState pState
# maybeEditId = findReceiver windowId editorState # (maybeEditId, editorState) = findReceiver windowId editorState
# iseditwin = not (isNothing maybeEditId) # iseditwin = not (isNothing maybeEditId)
# pState = setEditorState editorState pState # pState = setEditorState editorState pState
= (iseditwin, pState) = (iseditwin, pState)
...@@ -46,25 +44,23 @@ isEditWin windowId pState ...@@ -46,25 +44,23 @@ isEditWin windowId pState
message :: !Id !.(EditAction *b .c) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b message :: !Id !.(EditAction *b .c) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
message windowId monad pState message windowId monad pState
# (editorState, pState) = getEditorState pState # (editorState, pState) = getEditorState pState
# maybeEditId = findReceiver windowId editorState # (maybeEditId, editorState) = findReceiver windowId editorState
| isNothing maybeEditId | isNothing maybeEditId
= (Nothing, setEditorState editorState pState) = (Nothing, setEditorState editorState pState)
# editId = fromJust maybeEditId # editId = fromJust maybeEditId
# (editState, pState) = getEditState editId pState # (x, pState) = appEditState editId monad pState
# (x, (editState, pState)) = monad (editState, pState)
# pState = setEditState editId editState pState
# pState = setEditorState editorState pState # pState = setEditorState editorState pState
= (Just x, pState) = (Just x, pState)
sendToActiveWindow :: .(EditAction *b .c) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b sendToActiveWindow :: .(EditAction *b .c) !*(PSt *b) -> *(Maybe .c,*PSt *b) | Editor b
sendToActiveWindow editAction pState sendToActiveWindow editAction pState
# (maybeId, pState) = accPIO getActiveWindow pState # (maybeId, pState) = accPIO getActiveWindow pState
| isNothing maybeId | isNothing maybeId
= (Nothing,pState) // fail silently = (Nothing,pState) // fail silently
# windowId = fromJust maybeId # windowId = fromJust maybeId
(editorState,pState) = getEditorState pState (editorState,pState) = getEditorState pState
notEdit = isNothing (findReceiver windowId editorState) # (maybeEditId, editorState) = findReceiver windowId editorState
| notEdit | isNothing maybeEditId
= (Nothing,pState) = (Nothing,pState)
= message windowId editAction pState = message windowId editAction pState
......
...@@ -118,9 +118,7 @@ maybe_cons_win_message2 message ps ...@@ -118,9 +118,7 @@ maybe_cons_win_message2 message ps
= (Nothing,ps) = (Nothing,ps)
cons_message editId monad pState cons_message editId monad pState
# (editState, pState) = getEditState editId pState # (x,pState) = appEditState editId monad pState
# (x, (editState, pState)) = monad (editState, pState)
#! pState = setEditState editId editState pState
= (Just x,pState) = (Just x,pState)
//--- //---
...@@ -135,13 +133,14 @@ openConsoleWindow cwi text atts ps ...@@ -135,13 +133,14 @@ openConsoleWindow cwi text atts ps
# (_, (editState, ps)) = setText text (editState, ps) # (_, (editState, ps)) = setText text (editState, ps)
# (fontInfo, (editState, ps)) = getFontInfo (editState, ps) # (fontInfo, (editState, ps)) = getFontInfo (editState, ps)
# (viewDomain, (editState, ps)) = computeViewDomain (editState, ps) # (viewDomain, (editState, ps)) = computeViewDomain (editState, ps)
# (editState,editLook) = editWindowLook editState
# windowAttrs # windowAttrs
= [ WindowOuterSize cwi.tsiz = [ WindowOuterSize cwi.tsiz
, WindowHMargin 0 0 , WindowHMargin 0 0
, WindowVMargin 0 0 , WindowVMargin 0 0
, WindowId windowId , WindowId windowId
, WindowViewDomain viewDomain , WindowViewDomain viewDomain
, WindowLook True (editWindowLook editState) , WindowLook True editLook
, WindowHScroll (hScrollFun fontInfo) , WindowHScroll (hScrollFun fontInfo)
, WindowVScroll (vScrollFun fontInfo) , WindowVScroll (vScrollFun fontInfo)
, WindowPos (Fix, OffsetVector cwi.tpos) , WindowPos (Fix, OffsetVector cwi.tpos)
......
...@@ -130,9 +130,7 @@ type_win_message message ps ...@@ -130,9 +130,7 @@ type_win_message message ps
type_message :: !EditId !.(EditMonad *(PSt *b) .c) !*(PSt *b) -> *(Maybe .c,*(PSt *b)) type_message :: !EditId !.(EditMonad *(PSt *b) .c) !*(PSt *b) -> *(Maybe .c,*(PSt *b))
type_message editId monad pState type_message editId monad pState
# (editState, pState) = getEditState editId pState # (x,pState) = appEditState editId monad pState
# (x, (editState, pState)) = monad (editState, pState)
#! pState = setEditState editId editState pState
= (Just x,pState) = (Just x,pState)
//--- //---
...@@ -147,13 +145,14 @@ openTypeWindow twi text atts ps ...@@ -147,13 +145,14 @@ openTypeWindow twi text atts ps
# (_, (editState, ps)) = setText text (editState, ps) # (_, (editState, ps)) = setText text (editState, ps)
# (fontInfo, (editState, ps)) = getFontInfo (editState, ps) # (fontInfo, (editState, ps)) = getFontInfo (editState, ps)
# (viewDomain, (editState, ps)) = computeViewDomain (editState, ps) # (viewDomain, (editState, ps)) = computeViewDomain (editState, ps)
# (editState,editLook) = editWindowLook editState
# windowAttrs # windowAttrs
= [ WindowOuterSize twi.tsiz = [ WindowOuterSize twi.tsiz
, WindowHMargin 0 0 , WindowHMargin 0 0
, WindowVMargin 0 0 , WindowVMargin 0 0
, WindowId windowId , WindowId windowId
, WindowViewDomain viewDomain , WindowViewDomain viewDomain
, WindowLook True (editWindowLook editState) , WindowLook True editLook
, WindowHScroll (hScrollFun fontInfo) , WindowHScroll (hScrollFun fontInfo)
, WindowVScroll (vScrollFun fontInfo) , WindowVScroll (vScrollFun fontInfo)
, WindowPos (Fix, OffsetVector twi.tpos) , WindowPos (Fix, OffsetVector twi.tpos)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment