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

More Editor state threading

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