Commit e88a508a authored by Steffen Michels's avatar Steffen Michels

Merge branch 'remove-deprecated-js-functions' into 'master'

Remove deprecated conversion functions of JSVal

See merge request !530
parents 977b87e6 64a7e75d
Pipeline #47439 passed with stages
in 12 minutes and 3 seconds
......@@ -21,12 +21,9 @@ where
]
userAgent :: *JSWorld -> (String, *JSWorld)
userAgent world
# (ua, world) = jsGlobal "navigator" .# "userAgent" .? world
# ua = jsValToString` "" ua
= (ua, world)
userAgent world = jsGlobal "navigator" .# "userAgent" .?? ("", world)
doNotTrack :: JS () String
doNotTrack =
jsValToString` "undefined" <$>
fromJS "undefined" <$>
accJS ((.?) (jsWindow .# "navigator.doNotTrack"))
......@@ -5,7 +5,7 @@ implementation module iTasks.Extensions.Clock
import iTasks
import iTasks.UI.Definition, iTasks.UI.Editor
import iTasks.Extensions.DateTime
import qualified Data.Map as DM, Data.Tuple, Data.Error
import qualified Data.Map as DM, Data.Error
import Data.Maybe
import Text.HTML, Data.Func
import ABC.Interpreter.JavaScript
......@@ -57,8 +57,7 @@ where
onAttributeChange me {[0]=name,[1]=changes} world
| jsValToString name == ?Just "diff"
# (length,world) = changes .# "length" .? world
# length = jsValToInt` 0 length
# (length,world) = changes .# "length" .?? (0, world)
# world = updateHand me (changes .# 0) world
| length < 2 = world
# world = updateHand me (changes .# 1) world
......@@ -69,8 +68,8 @@ where
= jsTrace "Unknown attribute change" world
updateHand me change world
# (which,world) = appFst (jsValToInt` 0) (change .# 0 .? world)
# (value,world) = appFst (jsValToInt` 0) (change .# 1 .? world)
# (which,world) = change .# 0 .?? (0, world)
# (value,world) = change .# 1 .?? (0, world)
# svgEl = me .# "domEl.children" .# 0
# (handEl,world) = svgEl .# "children" .# (13 + which) .? world //The first 13 svg elements are the clock face and markers
# world = (handEl .# "setAttribute" .$! ("transform","rotate("+++toString (degrees which value - 90)+++" 50 50)")) world
......
......@@ -38,7 +38,7 @@ where
onAttributeChange me {[0]=name,[1]=value} world = case jsValToString name of
?Just "value"
# color = jsValToString` "" value
# color = fromJS "" value
= (me .# "domEl.children" .# 0 .# "children" .# 1 .# "setAttribute" .$! ("fill",color)) world
_
= jsTrace "Unknown attribute change" world
......
......@@ -130,10 +130,10 @@ where
= world
onChange editor me world
# (noEvents,world) = me .# "noEvents" .? world
| jsValToBool` True noEvents
# (noEvents,world) = me .# "noEvents" .?? (True, world)
| noEvents
= world
# (value,world) = (editor .# "getValue" .$ ()) world
# (value,world) = (editor .# "getValue" .$ ()) world
# (?Just value) = jsValToString value
# world = (me .# "doEditEvent" .$!
( me .# "attributes.taskId"
......@@ -143,10 +143,10 @@ where
= world
onCursorChange selection me world
# (noEvents,world) = me .# "noEvents" .? world
| jsValToBool` True noEvents
# (noEvents,world) = me .# "noEvents" .?? (True, world)
| noEvents
= world
# (cursor,world) = (selection .# "getCursor" .$ ()) world
# (cursor,world) = (selection .# "getCursor" .$ ()) world
# (row,world) = cursor .# "row" .? world
# (column,world) = cursor .# "column" .? world
# (?Just row) = jsValToInt row
......@@ -159,11 +159,11 @@ where
= world
onSelectionChange selection me world
# (noEvents,world) = me .# "noEvents" .? world
| jsValToBool` True noEvents
# (noEvents,world) = me .# "noEvents" .?? (True, world)
| noEvents
= world
# (empty,world) = (selection .# "isEmpty" .$ ()) world
| jsValToBool` True empty
# (empty,world) = (selection .# "isEmpty" .$? ()) (True, world)
| empty
= (me .# "doEditEvent" .$!
( me .# "attributes.taskId"
, me .# "attributes.editorId"
......
......@@ -45,8 +45,8 @@ where
= (observer .# "observe" .$! (me .# "domEl", config)) world
installSelect2 onSelect onUnselect elem world
# (tag,world) = elem .# "tagName" .? world
| jsValToString` "" tag == "SELECT"
# (tag,world) = elem .# "tagName" .?? ("", world)
| tag == "SELECT"
= initSelect2 elem world
# (elem,world) = (jQuery .$ elem) world
# (elems,world) = (elem .# "find" .$ "select") world
......@@ -56,8 +56,8 @@ where
initSelect2 elem world
# (jelem,world) = (jQuery .$ elem) world
// Don't reinitialize; https://select2.org/programmatic-control/methods#checking-if-the-plugin-is-initialized
# (initialized,world) = (jelem .# "hasClass" .$ "select2-hidden-accessible") world
| jsValToBool` False initialized
# (initialized,world) = (jelem .# "hasClass" .$? "select2-hidden-accessible") (False, world)
| initialized
= world
// Initialize
# (width,world) = computeWidth elem world
......@@ -71,8 +71,7 @@ where
# (options,world) = (elem .# "querySelectorAll" .$ "option") world
# (options,world) = jsValToList` options id world
# (lengths,world) = mapSt getLength options world
# (multiple,world) = elem .# "multiple" .? world
multiple = jsValToBool` False multiple
# (multiple,world) = elem .# "multiple" .?? (False, world)
= (if multiple 3 1 * maxList [12:lengths], world) // 12ex as a lower limit
where
getLength option world
......@@ -81,8 +80,7 @@ where
onChange selected {[0]=ev} world
# target = ev .# "target"
# (value,world) = ev .# "params" .# "data" .# "id" .? world
# value = jsValToString` "" value
# (value,world) = ev .# "params.data.id" .?? ("", world)
# (options,world) = target .# "options" .? world
# (options,world) = jsValToList` options id world
# world = selectOption value options world
......@@ -92,8 +90,8 @@ where
selectOption _ [] world
= world
selectOption id [opt:opts] world
# (value,world) = opt .# "value" .? world
| jsValToString` "" value == id
# (value,world) = opt .# "value" .?? ("", world)
| value == id
= (opt .# "selected" .= selected) world
= selectOption id opts world
......
......@@ -73,8 +73,8 @@ where
= world
onSelect me args world
# (noEvents,world) = me .# "noEvents" .? world
| not (jsIsUndefined noEvents) && jsValToBool noEvents == ?Just True
# (noEvents,world) = me .# "noEvents" .?? (False, world)
| noEvents
= world
# (value,world) = (me .# "picker.toString" .$ "YYYY-MM-DD") world
# value = jsValToString value
......
......@@ -162,8 +162,8 @@ where
//Check if the leaflet library is loaded and either load it,
//and delay dom initialization or set the initDOM method to continue
//as soon as the component's DOM element is available
# (l, world) = jsTypeOf (jsGlobal "L") .? world
| jsValToString` "undefined" l == "undefined"
# (l, world) = jsTypeOf (jsGlobal "L") .?? ("undefined", world)
| l == "undefined"
# world = addCSSFromUrl (serverDirectory+++LEAFLET_CSS_WINDOW) ?None world
# (cb,world) = jsWrapFun (loadJS serverDirectory jsInitDOM) me world
# world = addCSSFromUrl (serverDirectory+++LEAFLET_CSS) (?Just cb) world
......@@ -281,7 +281,7 @@ where
= world
onMapZoomEnd me args world
# (ignore,world) = me .# "attributes.ignorezoomend" .? world
# (ignore,world) = me .# "attributes.ignorezoomend" .?? (False, world)
# world = (me .# "attributes.ignorezoomend" .= False) world
# (taskId,world) = me .# "attributes.taskId" .? world
# (editorId,world) = me .# "attributes.editorId" .? world
......@@ -293,7 +293,7 @@ where
[ LDSetCenter center
, LDSetZoom zoom
, LDSetBounds bounds
: if (jsValToBool` False ignore) [] [LDSetManualPerspective]
: if ignore [] [LDSetManualPerspective]
]
# world = (me .# "doEditEvent" .$! (taskId,editorId,edit)) world
= world
......@@ -315,7 +315,7 @@ where
# world = (me .# "doEditEvent" .$! (taskId,editorId,edit)) world
= world
onAttributeChange me args world = case jsValToString` "" args.[0] of
onAttributeChange me args world = case fromJS "" args.[0] of
"perspective" -> setMapPerspective me args.[1] world
"icons" -> setMapIcons me (me .# "map") args.[1] world
"fitbounds" -> fitBounds me args.[1] (me .# "attributes.perspective" .# 1) world
......@@ -377,16 +377,16 @@ where
= world
where
removeWindow idx layer world
# (layerWindowId, world) = layer .# "attributes.windowId" .? world
| not (jsIsUndefined layerWindowId) && LeafletObjectID (jsValToString` "" layerWindowId) === windowId =
# (layerWindowId, world) = layer .# "attributes.windowId" .?? ("", world)
| LeafletObjectID layerWindowId === windowId =
((me .# "removeChild" .$! idx) world)
= world
//Map object access
toLatLng obj world
# (lat,world) = obj .# "lat" .? world
# (lng,world) = obj .# "lng" .? world
= ({LeafletLatLng|lat=jsValToReal` 0.0 lat,lng=jsValToReal` 0.0 lng}, world)
# (lat,world) = obj .# "lat" .?? (0.0, world)
# (lng,world) = obj .# "lng" .?? (0.0, world)
= ({LeafletLatLng|lat=lat,lng=lng}, world)
toBounds bounds env
# (sw,env) = (bounds .# "getSouthWest" .$ ()) env
......@@ -400,16 +400,16 @@ where
= toBounds bounds env
getMapZoom mapObj world
# (zoom,world) = (mapObj .# "getZoom" .$ ()) world
= (jsValToInt` 1 zoom, world)
# (zoom,world) = (mapObj .# "getZoom" .$? ()) (1, world)
= (zoom, world)
getMapCenter mapObj world
# (center,world) = (mapObj .# "getCenter" .$ ()) world
= toLatLng center world
setMapPerspective me attr world
# (type,world) = attr .# 0 .? world
= case jsValToString` "" type of
# (type,world) = attr .# 0 .?? ("", world)
= case type of
"CenterAndZoom"
# world = (me .# "map.setView" .$! (attr .# 1, attr .# 2)) world
-> syncCurrentState me world
......@@ -441,10 +441,10 @@ where
= forall (createMapIcon me mapObj l index) icons world
where
createMapIcon me mapObj l index _ def world
# (iconId,world) = def .# 0 .? world
# (iconId,world) = def .# 0 .?? ("", world)
# (iconSpec,world) = def .# 1 .? world
# (icon,world) = (l .# "icon" .$ iconSpec) world
# world = (index .# jsValToString` "" iconId .= icon) world
# world = (index .# iconId .= icon) world
= world
createMapObjects viewMode me mapObj objects world
......@@ -463,7 +463,7 @@ where
_ = world
createMarker me mapObj l object world
# (markerId,world) = object .# "attributes.markerId" .? world
# (markerId,world) = object .# "attributes.markerId" .?? ("", world)
# (options,world) = jsEmptyObject world
//Set title
# (title,world) = object .# "attributes.title" .? world
......@@ -483,7 +483,7 @@ where
//Store marker ID, needed for related markers of windows
# world = (layer .# "markerId" .= markerId) world
//Set click handler
# (cb,world) = jsWrapFun (\a w -> onMarkerClick me (LeafletObjectID (jsValToString` "" markerId)) a w) me world
# (cb,world) = jsWrapFun (\a w -> onMarkerClick me (LeafletObjectID markerId) a w) me world
# world = (layer .# "addEventListener" .$! ("click",cb)) world
//Add to map
# world = (layer .# "addTo" .$! mapObj) world
......@@ -491,7 +491,7 @@ where
where
addIconOption iconId icons options world
| jsIsUndefined iconId = world
# (icon,world) = icons .# (jsValToString` "" iconId) .? world
# (icon,world) = icons .# (fromJS "" iconId) .? world
| jsIsUndefined icon = world
# world = (options .# "icon" .= icon) world
= world
......@@ -565,10 +565,10 @@ where
= world
where
getUpdate layer world
# (radius, world) = (layer .# "getRadius" .$ ()) world
# (radius, world) = (layer .# "getRadius" .$? ()) (0.0, world)
# (center, world) = (layer .# "getLatLng" .$ ()) world
# (center, world) = toLatLng center world
= (UpdateCircle center $ jsValToReal` 0.0 radius, world)
= (UpdateCircle center radius, world)
createRectangle me mapObj l object world
//Set options
......@@ -589,8 +589,8 @@ where
= (UpdateRectangle bounds, world)
enableEdit idFieldName me mapObj layer object getUpdate world
# (isEditable,world) = object .# "attributes.editable" .? world
| not $ jsValToBool` False isEditable = world
# (isEditable,world) = object .# "attributes.editable" .?? (False, world)
| not isEditable = world
# (_, world) = (layer .# "enableEdit" .$ ()) world
# (cb, world) = jsWrapFun (onEditing layer) me world
# (_, world) = (layer .# "addEventListener" .$ ("editable:vertex:dragend", cb)) world
......@@ -600,8 +600,8 @@ where
where
onEditing layer _ world
# (update, world) = getUpdate layer world
# (objectId, world) = object .# "attributes." +++ idFieldName .? world
# edit = toJSON [LDUpdateObject (LeafletObjectID (jsValToString` "" objectId)) update]
# (objectId, world) = object .# "attributes." +++ idFieldName .?? ("", world)
# edit = toJSON [LDUpdateObject (LeafletObjectID objectId) update]
# (taskId, world) = me .# "attributes.taskId" .? world
# (editorId, world) = me .# "attributes.editorId" .? world
# (_, world) = (me .# "doEditEvent" .$ (taskId, editorId, edit)) world
......@@ -647,8 +647,8 @@ where
True
= world
False
# (windowId,world) = object .# "attributes.windowId" .? world
# (onWRemove, world) = jsWrapFun (onWindowRemove me (LeafletObjectID (jsValToString` "" windowId))) me world
# (windowId,world) = object .# "attributes.windowId" .?? ("", world)
# (onWRemove, world) = jsWrapFun (onWindowRemove me (LeafletObjectID windowId)) me world
= (layer .# "_onWindowClose" .= onWRemove) world
// inject function to handle window update
# (cb,world) = jsWrapFun (onUIChange layer) me world
......@@ -667,8 +667,7 @@ where
= world
updateAttr _ attrChange world
# (name, world) = attrChange .# "name" .? world
# name = jsValToString` "" name
# (name, world) = attrChange .# "name" .?? ("", world)
# (value, world) = attrChange .# "value" .? world
= case name of
"content" = layer .# "setContent" .$! value $ world
......@@ -698,8 +697,8 @@ where
//Loop through a javascript array
forall :: !(Int JSVal *JSWorld -> *JSWorld) !JSVal !*JSWorld -> *JSWorld
forall f array world
# (len,world) = array .# "length" .? world
= forall` 0 (jsValToInt` 0 len) world
# (len,world) = array .# "length" .?? (0, world)
= forall` 0 len world
where
forall` :: !Int !Int !*JSWorld -> *JSWorld
forall` i len world
......
......@@ -95,9 +95,7 @@ addEventListener svg event useCapture callback me world
= world
getCurrentTimeInMilliseconds :: !*JSWorld -> (!Int,!*JSWorld)
getCurrentTimeInMilliseconds world
#! (ms,world) = (jsGlobal "Date.now" .$ ()) world
= (jsValToInt` 0 ms,world)
getCurrentTimeInMilliseconds world = (jsGlobal "Date.now" .$? ()) (0, world)
:: ImageSpanReal :== (!Real, !Real)
......@@ -359,18 +357,15 @@ serverSVG {SVGEditor | renderImage} font_spans text_spans taskId s v
= Right (svg,es,tags)
clientGetTaskId :: !JSVal !*JSWorld -> (!String,!*JSWorld)
clientGetTaskId me world
#! (cidJS,world) = me .# "attributes.taskId" .? world
#! taskId = jsValToString` "" cidJS
= (taskId,world)
clientGetTaskId me world = me .# "attributes.taskId" .?? ("", world)
// client side initialisation of DOM:
// The client receives the model value via the .value attribute and stores it at the client side.
// This makes the client ready to receive the SVG rendering that is computed at the server side (via `doEditEvent' and ClientNeedsSVG message).
clientInitDOMEl :: !(SVGEditor s v) !JSVal !{!JSVal} !*JSWorld -> *JSWorld | JSONEncode{|*|} s
clientInitDOMEl svglet me args world
#! (model, world) = me .# "attributes.value" .? world
#! (model, world) = jsDeserializeGraph (ensure_uniqueness (jsValToString` "" model)) world
#! (model, world) = me .# "attributes.value" .?? ("", world)
#! (model, world) = jsDeserializeGraph (ensure_uniqueness model) world
#! (jsView, world) = jsMakeCleanReference (svglet.initView model) me world
#! (jsModel,world) = jsMakeCleanReference model me world
#! world = (me .# JS_ATTR_VIEW .= jsView) world
......@@ -391,7 +386,7 @@ clientHandleAttributeChange svglet me args world
#! world = timeTrace ("clientHandleAttributeChange [" +++ join "," (map fst nv_pairs) +++ "] started at ") world
= case svg_or_text of
?Just json
#! (request,world) = fromUIAttributes (ensure_uniqueness (jsValToString` "" json)) world
#! (request,world) = fromUIAttributes (ensure_uniqueness (fromJS "" json)) world
= case request of
(ServerNeedsTextMetrics new_fonts new_texts)
#! world = timeTrace "clientHandleAttributeChange (ServerNeedsTextMetrics) started at " world
......@@ -417,7 +412,7 @@ where
svg_or_text = lookup JS_ATTR_SVG nv_pairs
to_name_value_pairs :: ![JSVal] -> [(String,JSVal)]
to_name_value_pairs [n,v : nvs] = [(jsValToString` "" n,v) : to_name_value_pairs nvs]
to_name_value_pairs [n,v : nvs] = [(fromJS "" n,v) : to_name_value_pairs nvs]
to_name_value_pairs _ = []
clientHandlesTextMetrics :: !(SVGEditor s v) !ImgFonts !ImgTexts !JSVal !*JSWorld -> *JSWorld | JSONEncode{|*|} s
......@@ -504,7 +499,7 @@ where
loadCachedFontSpan jsWebStorage (cached,new,world) font
#! (v,world) = (jsWebStorage `getItem` (FONT_WEB_STORAGE_KEY font)) (jsTrace` ("loadCachedFontSpan \"" +++ FONT_WEB_STORAGE_KEY font +++ "\"") world)
| jsIsNull v = jsTrace` ("(loadCachedFontSpan " +++ FONT_WEB_STORAGE_KEY font +++ ") retrieved null value ") (cached,new,world) // font metric not in cache, need to measure (remains in new)
| otherwise = ('Data.Map'.put font (jsValToReal` (getfontysize` font) v) cached,'Data.Set'.delete font new,world) // font metric in cache, no need to measure (remove from new)
| otherwise = ('Data.Map'.put font (fromJS (getfontysize` font) v) cached,'Data.Set'.delete font new,world) // font metric in cache, no need to measure (remove from new)
// store new font dimensions
storeFontsSpansToCache :: !FontSpans !*JSWorld -> *JSWorld
......@@ -565,7 +560,7 @@ where
loadCachedTextSpan jsWebStorage font (cached,new,world) str
#! (v,world) = (jsWebStorage `getItem` (TEXT_WEB_STORAGE_KEY font str)) (jsTrace` ("loadCachedTextSpan \"" +++ TEXT_WEB_STORAGE_KEY font str +++ "\"") world)
| jsIsNull v = jsTrace` ("(loadCachedTextSpan " +++ TEXT_WEB_STORAGE_KEY font str +++ ") retrieved null value ") (cached,new,world)
| otherwise = ('Data.Map'.alter (merge ('Data.Map'.singleton str (jsValToReal` zero v))) font cached,'Data.Map'.alter (remove str) font new,world)
| otherwise = ('Data.Map'.alter (merge ('Data.Map'.singleton str (fromJS zero v))) font cached,'Data.Map'.alter (remove str) font new,world)
where
remove :: !String !(?(Set String)) -> ?(Set String)
remove str (?Just set)
......@@ -615,7 +610,7 @@ where
calcTextLength elem str (text_spans, world)
#! world = (elem .# "textContent" .= str) world
#! (ctl, world) = (elem `getComputedTextLength` ()) world
= ('Data.Map'.put str (jsValToReal` 0.0 ctl) text_spans, world)
= ('Data.Map'.put str (fromJS 0.0 ctl) text_spans, world)
merge :: !(Map String TextSpan) !(?(Map String TextSpan)) -> ?(Map String TextSpan)
merge ws` (?Just ws) = ?Just ('Data.Map'.union ws` ws)
......@@ -707,26 +702,24 @@ where
#! (to,world) = (jsGlobal "setTimeout" .$ (cb, CLICK_DELAY)) world
#! world = (me .# "clickTimeOut" .= to) world
// Increase click counter, so we can determine how many times the element was clicked when the timeout passes
#! (nc,world) = me .# "clickCount" .? world
#! world = (me .# "clickCount" .= jsValToInt` 0 nc + 1) world
#! (nc,world) = me .# "clickCount" .?? (0, world)
#! world = (me .# "clickCount" .= nc + 1) world
= world
doNClickEvent` :: !(SVGEditor s v) !JSVal !JSObj !String !ImgTagNo !ImgNodePath !Bool !{!JSVal} !*JSWorld-> *JSWorld | JSONEncode{|*|} s
doNClickEvent` svglet me svg elemId uniqId p local args world
// Get click count
#! (nc,world) = me .# "clickCount" .? world
#! (nc,world) = me .# "clickCount" .?? (0, world)
// Reset click count
#! world = (me .# "clickCount" .= 0) world
#! world = (me .# "clickHandler" .= jsNull) world
#! nc = jsValToInt` 0 nc
= doMouseEvent` svglet me svg elemId uniqId p (MouseOnClickData nc) local args world
doMouseEvent` :: !(SVGEditor s v) !JSVal !JSObj !String !ImgTagNo !ImgNodePath !MouseCallbackData !Bool !{!JSVal} !*JSWorld -> *JSWorld | JSONEncode{|*|} s
doMouseEvent` svglet=:{SVGEditor | initView,renderImage,updModel} me svg elemId uniqId p cb_data local args world
#! world = jsTrace` ("doMouseEvent` " +++ "[" +++ join "," (map toString p) +++ "] " +++ toString cb_data) world
#! world = timeTrace "doMouseEvent` started at " world
#! (cidJS,world) = me .# "attributes.taskId" .? world
#! taskId = jsValToString` "" cidJS
#! (taskId,world) = me .# "attributes.taskId" .?? ("", world)
#! (?Just view, world) = jsGetCleanReference (me .# JS_ATTR_VIEW) world
#! (?Just model,world) = jsGetCleanReference (me .# JS_ATTR_MODEL) world
#! image` = renderImage model view (imgTagSource taskId)
......@@ -752,18 +745,15 @@ where
#! (m, world) = (svg `getScreenCTM` ()) world
#! (inv, world) = (m `inverse` ()) world
#! (point, world) = (point `matrixTransform` inv) world
#! (ax, world) = point .# "x" .? world
#! (ay, world) = point .# "y" .? world
#! (ax, ay) = (jsValToReal` 0.0 ax, jsValToReal` 0.0 ay)
#! (ax, world) = point .# "x" .?? (0.0, world)
#! (ay, world) = point .# "y" .?? (0.0, world)
// Get the coordinates for the image that was clicked in
#! (bRect, world) = (args.[0] .# "target" .# "getBoundingClientRect" .$ ()) world
#! (ix, world) = bRect .# "left" .? world
#! (iy, world) = bRect .# "top" .? world
#! (ix, iy) = (jsValToReal` 0.0 ix, jsValToReal` 0.0 iy)
#! (ix, world) = bRect .# "left" .?? (0.0, world)
#! (iy, world) = bRect .# "top" .?? (0.0, world)
// Compensate for the scrolling
#! (sx, world) = jsWindow .# "scrollX" .? world
#! (sy, world) = jsWindow .# "scrollY" .? world
#! (sx, sy) = (jsValToReal` 0.0 sx, jsValToReal` 0.0 sy)
#! (sx, world) = jsWindow .# "scrollX" .?? (0.0, world)
#! (sy, world) = jsWindow .# "scrollY" .?? (0.0, world)
-> ((px (ax - (ix + sx)), px (ay - (iy + sy))), world)
// Update the view & the model
#! view = applyImgEventhandler span f cb_data view
......@@ -777,7 +767,7 @@ where
= clientHandleModel svglet me model view world
| otherwise // the new model value is rendered on the server
#! (editId,world) = me .# "attributes.editorId" .? world
#! (_, world) = (me .# "doEditEvent" .$ (cidJS,editId,toJSON (ClientHasNewModel model))) world
#! (_, world) = (me .# "doEditEvent" .$ (taskId,editId,toJSON (ClientHasNewModel model))) world
#! world = timeTrace "doMouseEvent` calls server round trip started at " world
= world // rendering is completed by clientHandleAttributeChange
where
......@@ -827,9 +817,8 @@ where
#! (m, world) = (svg `getScreenCTM` ()) world
#! (inv, world) = (m `inverse` ()) world
#! (point, world) = (point `matrixTransform` inv) world
#! (px, world) = point .# "x" .? world
#! (py, world) = point .# "y" .? world
#! (e,f) = (jsValToReal` 0.0 px, jsValToReal` 0.0 py)
#! (e, world) = point .# "x" .?? (0.0, world)
#! (f, world) = point .# "y" .?? (0.0, world)
#! (taskId, world) = clientGetTaskId me world
#! (?Just view, world) = jsGetCleanReference (me .# JS_ATTR_VIEW) world
......@@ -920,11 +909,7 @@ where
firstIdentifiableParentId :: !JSObj !*JSWorld -> *(!String, !*JSWorld)
firstIdentifiableParentId elem world
#! (idval,world) = elem .# "id" .? world
| jsIsNull idval
#! (parent,world) = elem .# "parentNode" .? world
= firstIdentifiableParentId parent world
#! idval = jsValToString` "" idval
#! (idval,world) = elem .# "id" .?? ("", world)
| idval == ""
#! (parent,world) = elem .# "parentNode" .? world
= firstIdentifiableParentId parent world
......@@ -934,15 +919,14 @@ firstIdentifiableParentId elem world
getNewTrueCoords :: !JSVal !JSObj !*JSWorld -> *(!Real, !Real, !*JSWorld)
getNewTrueCoords me evt world
#! (svg, world) = clientRootSVGElt me world
#! (newScale, world) = svg .# "currentScale" .? world
#! newScale = jsValToReal` 0.0 newScale
#! (newScale, world) = svg .# "currentScale" .?? (0.0, world)
#! (translation, world) = svg .# "currentTranslate" .? world
#! (translationX,world) = translation .# "x" .? world
#! (translationY,world) = translation .# "y" .? world
#! (clientX, world) = evt .# "clientX" .? world
#! (clientY, world) = evt .# "clientY" .? world
#! newTrueCoordsX = ((jsValToReal` 0.0 clientX) - (jsValToReal` 0.0 translationX)) / newScale