Verified Commit 35727c1d authored by Camil Staps's avatar Camil Staps 🙂

Restore commented out portions of iTasks.Extensions.GIS.Leaflet; this now...

Restore commented out portions of iTasks.Extensions.GIS.Leaflet; this now works with the ABC interpreter
parent 0a639676
Pipeline #21062 failed with stage
in 1 minute and 57 seconds
......@@ -415,7 +415,6 @@ where
= world
createPolyline me mapObj l object world
= jsTrace "createPolyline temporarily commented" world /*
//Set options
# (options,world) = jsEmptyObject world
# (style,world) = object .# "attributes.style" .? world
......@@ -429,14 +428,13 @@ where
where
getUpdate layer world
# (points, world) = (layer .# "getLatLngs" .$ ()) world
# (points, world) = fromJSArray points id world
# (points, world) = jsValToList` points id world
# (points, world) = foldl (\(res, world) point = appFst (\latLng -> [latLng: res]) $ toLatLng point world)
([], world)
points
= (UpdatePolyline $ reverse points, world)*/
= (UpdatePolyline $ reverse points, world)
createPolygon me mapObj l object world
= jsTrace "createPolygon temporarily commented" world /*
//Set options
# (options,world) = jsEmptyObject world
# (style,world) = object .# "attributes.style" .? world
......@@ -451,11 +449,11 @@ where
getUpdate layer world
# (points, world) = (layer .# "getLatLngs" .$ ()) world
# (points, world) = points .# 0 .? world
# (points, world) = fromJSArray points id world
# (points, world) = jsValToList` points id world
# (points, world) = foldl (\(res, world) point = appFst (\latLng -> [latLng: res]) $ toLatLng point world)
([], world)
points
= (UpdatePolygon $ reverse points, world)*/
= (UpdatePolygon $ reverse points, world)
createCircle me mapObj l object world
//Set options
......@@ -484,7 +482,6 @@ where
# world = forall (applyAreaStyle options) style world
# (sw,world) = object .# "attributes.bounds.southWest" .? world
# (ne,world) = object .# "attributes.bounds.northEast" .? world
= world /* TODO
# (layer,world) = (l .# "rectangle" .$ ([sw, ne], options)) world
# world = (layer .# "addTo" .$! mapObj) world
# world = enableEdit "rectangleId" me mapObj layer object getUpdate world
......@@ -494,7 +491,7 @@ where
getUpdate layer world
# (bounds, world) = (layer .# "getBounds" .$ ()) world
# (bounds, world) = toBounds bounds world
= (UpdateRectangle bounds, world)*/
= (UpdateRectangle bounds, world)
enableEdit idFieldName me mapObj layer object getUpdate world
# (isEditable,world) = object .# "attributes.editable" .? world
......@@ -522,15 +519,16 @@ where
# (directStyle, world) = style .# 1 .? world
# (directStyleType, world) = directStyle .# 0 .? world
# (directStyleVal, world) = directStyle .# 1 .? world
# directStyleType = jsValToString` "" directStyleType
| directStyleType == "AreaLineStrokeColor" = (options .# "color" .= directStyleVal) world
| directStyleType == "AreaLineStrokeWidth" = (options .# "weight" .= directStyleVal) world
| directStyleType == "AreaLineOpacity" = (options .# "opacity" .= directStyleVal) world
| directStyleType == "AreaLineDashArray" = (options .# "dashArray" .= directStyleVal) world
| directStyleType == "AreaNoFill" = (options .# "fill" .= False) world
| directStyleType == "AreaFillColor" = (options .# "fillColor" .= directStyleVal) world
| directStyleType == "AreaFillOpacity" = (options .# "fillOpacity" .= directStyleVal) world
= abort "unknown style"
# directStyleType = jsValToString directStyleType
= case directStyleType of
Just "AreaLineStrokeColor" = (options .# "color" .= directStyleVal) world
Just "AreaLineStrokeWidth" = (options .# "weight" .= directStyleVal) world
Just "AreaLineOpacity" = (options .# "opacity" .= directStyleVal) world
Just "AreaLineDashArray" = (options .# "dashArray" .= directStyleVal) world
Just "AreaNoFill" = (options .# "fill" .= False) world
Just "AreaFillColor" = (options .# "fillColor" .= directStyleVal) world
Just "AreaFillOpacity" = (options .# "fillOpacity" .= directStyleVal) world
_ = abort "unknown style"
| styleType == Just "Class"
# (cls, world) = style .# 1 .? world
= (options .# "className" .= cls) world
......@@ -586,17 +584,18 @@ where
applyLineStyle options _ style world
# (styleType, world) = style .# 0 .? world
# styleType = jsValToString styleType
| styleType == "Style"
| styleType == Just "Style"
# (directStyle, world) = style .# 1 .? world
# (directStyleType, world) = directStyle .# 0 .? world
# (directStyleVal, world) = directStyle .# 1 .? world
# directStyleType = jsValToString directStyleType
| directStyleType == "LineStrokeColor" = (options .# "color" .= directStyleVal) world
| directStyleType == "LineStrokeWidth" = (options .# "weight" .= directStyleVal) world
| directStyleType == "LineOpacity" = (options .# "opacity" .= directStyleVal) world
| directStyleType == "LineDashArray" = (options .# "dashArray" .= directStyleVal) world
= abort "unknown style"
| styleType == "Class"
= case directStyleType of
Just "LineStrokeColor" = (options .# "color" .= directStyleVal) world
Just "LineStrokeWidth" = (options .# "weight" .= directStyleVal) world
Just "LineOpacity" = (options .# "opacity" .= directStyleVal) world
Just "LineDashArray" = (options .# "dashArray" .= directStyleVal) world
_ = abort "unknown style"
| styleType == Just "Class"
# (cls, world) = style .# 1 .? world
= (options .# "className" .= cls) world
= abort "unknown style"
......
......@@ -12,7 +12,7 @@ from Text.GenJSON import :: JSONNode
:: JSObj :== JSVal
generic gToJS a :: !a -> JSVal
derive gToJS Int, Bool, String, Real, JSVal, Maybe, (), JSONNode
derive gToJS Int, Bool, String, Real, JSVal, Maybe, [], JSONNode
derive gToJS PAIR, FIELD of {gfd_name}, RECORD
toJS x :== gToJS{|*|} x
......@@ -34,6 +34,9 @@ jsValToBool` :: !Bool !JSVal -> Bool
jsValToString` :: !String !JSVal -> String
jsValToReal` :: !Real !JSVal -> Real
jsValToList :: !JSVal !(JSVal -> Maybe a) !*JSWorld -> *(!Maybe [a], !*JSWorld)
jsValToList` :: !JSVal !(JSVal -> a) !*JSWorld -> *(![a], !*JSWorld)
/**
* Access properties of a JavaScript value.
*/
......
......@@ -132,6 +132,32 @@ jsValToString` s v = fromMaybe s (jsValToString v)
jsValToReal` :: !Real !JSVal -> Real
jsValToReal` r v = fromMaybe r (jsValToReal v)
jsValToList :: !JSVal !(JSVal -> Maybe a) !*JSWorld -> *(!Maybe [a], !*JSWorld)
jsValToList arr get w
# (len,w) = arr .# "length" .? w
= case jsValToInt len of
Nothing -> (Nothing,w)
Just len -> get_elements [] (len-1) w
where
get_elements xs -1 w = (Just xs,w)
get_elements xs i w
# (x,w) = arr .# i .? w
= case get x of
Nothing -> (Nothing,w)
Just x -> get_elements [x:xs] (i-1) w
jsValToList` :: !JSVal !(JSVal -> a) !*JSWorld -> *(![a], !*JSWorld)
jsValToList` arr get w
# (len,w) = arr .# "length" .? w
= case jsValToInt len of
Nothing -> ([],w)
Just len -> get_elements [] (len-1) w
where
get_elements xs -1 w = (xs,w)
get_elements xs i w
# (x,w) = arr .# i .? w
= get_elements [get x:xs] (i-1) w
gToJS{|Int|} i = JSInt i
gToJS{|Bool|} b = JSBool b
gToJS{|String|} s = JSString s
......@@ -140,7 +166,7 @@ gToJS{|JSVal|} v = v
gToJS{|Maybe|} fx v = case v of
Nothing -> JSNull
Just x -> fx x
gToJS{|()|} _ = abort "gToJS{|()|} should not be called!"
gToJS{|[]|} fx xs = JSArray {fx x \\ x <- xs}
gToJS{|JSONNode|} n = case n of
JSONNull -> JSNull
JSONBool b -> JSBool b
......@@ -178,9 +204,11 @@ where
contains_dot i s = if (s.[i]=='.') True (contains_dot (i-1) s)
(.?) infixl 1 :: !JSVal !*JSWorld -> *(!JSVal, !*JSWorld)
(.?) js w = case try_local_computation js of
(True,v) -> (v,w)
_ -> (eval_js_with_return_value (toString js), w)
(.?) js w
# (done,js) = try_local_computation js
| done
= (js,w)
= (eval_js_with_return_value (toString js), w)
where
try_local_computation :: !JSVal -> (!Bool, !JSVal)
try_local_computation v = case v of
......@@ -193,7 +221,7 @@ where
JSUndefined -> (True,v)
JSSel (JSArray xs) (JSInt i)
| 0<=i && i<size xs -> (True,xs.[i])
| 0<=i && i<size xs -> try_local_computation xs.[i]
| otherwise -> (True,JSUndefined)
// TODO add a case for JSObject and JSString?
......
......@@ -109,17 +109,15 @@ const ABC={
ABC.memory_array[hp/4+1]=0;
ABC.memory_array[hp/4+2]=values[i]; // TODO also support >32-bit
ABC.memory_array[hp/4+3]=0;
hp+=16;
hp_free-=2;
} else {
ABC.memory_array[store_ptrs/4]=hp;
ABC.memory_array[hp/4]=21*8+2; // REAL
ABC.memory_array[hp/4+1]=0;
const float_array=new Float64Array(ABC.memory_array.buffer, hp+8);
float_array[0]=values[i];
hp+=16;
hp_free-=2;
}
hp+=16;
hp_free-=2;
} else if (typeof values[i]=='boolean') {
ABC.memory_array[store_ptrs/4]=hp;
ABC.memory_array[hp/4]=11*8+2; // BOOL
......@@ -159,10 +157,10 @@ const ABC={
ABC.memory_array[hp/4+4]=0;
ABC.memory_array[hp/4+5]=0;
hp+=24;
hp_free-=3;
hp_free-=3+values[i].length;;
var copied=ABC.copy_js_to_clean(values[i], hp, hp+8*values[i].length, hp_free, false);
hp=copied.hp;
hp_free=copied.hp_free-values[i].length;
hp_free=copied.hp_free;
} else if ('shared_clean_value_index' in values[i]) {
ABC.memory_array[store_ptrs/4]=hp;
ABC.memory_array[hp/4]=661*8+2; // DOMNode type
......@@ -278,7 +276,7 @@ ABC.loading_promise=fetch('js/app.pbc').then(function(resp){
console.log('eval',string);
Function(string)();
break;
case 2:
case 2: /* iTasks.UI.JS.Interface: eval_js_with_return_value */
var string=ABC.get_clean_string(ABC.memory_array[asp/4]);
if (ABC_DEBUG)
console.log('eval',string);
......
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