Verified Commit b7fe60a9 authored by Camil Staps's avatar Camil Staps 🚀

Continue previous commit; some parts of pikaday are working with the wasm interpreter now

parent 4f6e27f3
......@@ -14,10 +14,11 @@ import iTasks.WF.Tasks.Interaction
Start w = doTasks task w
//import iTasks.Internal.SDS
//import iTasks.SDS.Sources.System
//
//task = viewSharedInformation "Current date and time" [] currentDateTime
import iTasks.Internal.SDS
import iTasks.SDS.Sources.System
task :: Task Date
task = enterInformation "date" []
task = updateInformation "test"
[ UpdateUsing (\m -> m) (\_ v -> v) $ leafEditorToEditor
......
......@@ -23,7 +23,7 @@ import Text, Text.GenJSON, System.Time
import Data.Maybe, Data.Error
import qualified Data.Map as DM
//from iTasks.Extensions.Form.Pikaday import pikadayDateField // TODO restore
from iTasks.Extensions.Form.Pikaday import pikadayDateField
from iTasks.Internal.Util import tmToDateTime
//* (Local) date and time
......@@ -69,9 +69,7 @@ JSONDecode{|Date|} _ c = (Nothing, c)
gText{|Date|} _ val = [maybe "" toString val]
// TODO restore
//gEditor{|Date|} = pikadayDateField
derive gEditor Date
gEditor{|Date|} = pikadayDateField
gDefault{|Date|} = {Date|day = 1, mon = 1, year = 2017}
derive gEq Date
......
......@@ -13,75 +13,76 @@ pikadayField :: Editor String
pikadayField = leafEditorToEditor {LeafEditor|genUI = withClientSideInit initUI genUI, onEdit = onEdit, onRefresh = onRefresh, valueFromState = valueFromState}
where
genUI attr dp mode vst=:{VSt|taskId,optional}
# val = editModeValue mode
# val = editModeValue mode
# valAttr = maybe JSONNull JSONString val
# attr = 'DM'.unions [optionalAttr optional, taskIdAttr taskId, editorIdAttr (editorId dp), valueAttr valAttr, attr]
# attr = 'DM'.unions [optionalAttr optional, taskIdAttr taskId, editorIdAttr (editorId dp), valueAttr valAttr, attr]
= (Ok (uia UITextField attr, val),vst)
initUI me world
//Load css
# world = addCSSFromUrl PIKADAY_CSS_URL world
//Defer further action till after the field is created...
# (cb,world) = jsWrapFun (\a w -> (jsNull,initDOMEl me w)) world
# world = ((me .# "initDOMEl") .= cb) world
# (cb,world) = jsWrapFun (\a w -> (jsNull,beforeRemove me w)) world
# world = ((me .# "beforeRemove") .= cb) world
# (cb,world) = jsWrapFun (initDOMEl me) world
# world = (me .# "initDOMEl" .= cb) world
# (cb,world) = jsWrapFun (beforeRemove me) world
# world = (me .# "beforeRemove" .= cb) world
= world
beforeRemove me = snd o (me .# "picker" .# "destroy" .$ [])
beforeRemove me = snd o (me .# "picker" .# "destroy" .$ ())
initDOMEl me world
//Load javascript library first, then start
# (cb,world) = jsWrapFun (\_ w -> (jsNull,initDOMEl` me w)) world
# (cb,world) = jsWrapFun (initDOMEl` me) world
# world = addJSFromUrl MOMENT_JS_URL Nothing world
# world = addJSFromUrl PIKADAY_JS_URL (Just cb) world
= world
initDOMEl` me world
//Create pikaday object
# (value,world) = .? (me .# "attributes.value") world
# (domEl,world) = .? (me .# "domEl") world
# world = ((domEl .# "value") .= value) world
# (value,world) = me .# "attributes.value" .? world
# (domEl,world) = me .# "domEl" .? world
# world = (domEl .# "value" .= value) world
//Create onselect/keyup
# (onSelectCb,world) = jsWrapFun (\a w -> (jsNull,onSelect me w)) world
# (onKeyupCb,world) = jsWrapFun (\a w -> (jsNull,onKeyup me w)) world
# (cfg,world) = jsEmptyObject world
# world = ((cfg .# "field") .= domEl) world
# world = ((cfg .# "format") .= "YYYY-MM-DD") world
# world = ((cfg .# "firstDay") .= 1) world
# world = ((cfg .# "onSelect") .= onSelectCb) world
# (_,world) = ((domEl .# "addEventListener") .$ ("keyup", onKeyupCb)) world
# (picker,world) = jsNewObject "Pikaday" [toJSArg cfg] world
# world = ((me .# "picker") .= picker) world
# (onSelectCb,world) = jsWrapFun (onSelect me) world
# (onKeyupCb,world) = jsWrapFun (onKeyup me) world
# (cfg,world) = jsEmptyObject world
# world = (cfg .# "field" .= domEl) world
# world = (cfg .# "format" .= "YYYY-MM-DD") world
# world = (cfg .# "firstDay" .= 1) world
# world = (cfg .# "onSelect" .= onSelectCb) world
# world = (domEl .# "addEventListener" .$! ("keyup", onKeyupCb)) world
# (picker,world) = jsNew "Pikaday" cfg world
# world = (me .# "picker" .= picker) world
//Handle attribute changes
# (cb,world) = jsWrapFun (\a w -> (jsNull,onAttributeChange picker me a w)) world
# world = ((me .# "onAttributeChange") .= cb) world
# (cb,world) = jsWrapFun (\n v w -> onAttributeChange picker me n v w) world
# world = (me .# "onAttributeChange" .= cb) world
//React to selects
= world
onAttributeChange picker me [name,value] world
# world = ((me.# "noEvents") .= True ) world
# (_,world) = ((picker .# "setDate") .$ value) world
# world = ((me.# "noEvents") .= False) world
onAttributeChange :: !(JSObj ()) !(JSObj ()) !String !String !*JSWorld -> *JSWorld
onAttributeChange picker me name value world
# world = (me.# "noEvents" .= True ) world
# (_,world) = (picker .# "setDate" .$ value) world
# world = (me.# "noEvents" .= False) world
= world
onSelect me world
# (noEvents,world) = .? (me .# "noEvents") world
| (not (jsIsUndefined noEvents)) && jsValToBool noEvents
# (noEvents,world) = me .# "noEvents" .? world
| (not (jsIsUndefined noEvents)) // TODO && jsValToBool noEvents
= world
# (picker,world) = .? (me .# "picker") world
# (value,world) = ((picker .# "toString") .$ "YYYY-MM-DD" ) world
# (taskId,world) = .? (me .# "attributes.taskId") world
# (editorId,world) = .? (me .# "attributes.editorId") world
# (_,world) = ((me .# "doEditEvent") .$ (taskId,editorId,Just value)) world
# (picker,world) = me .# "picker" .? world
# (value,world) = (picker .# "toString" .$ "YYYY-MM-DD" ) world
# (taskId,world) = me .# "attributes.taskId" .? world
# (editorId,world) = me .# "attributes.editorId" .? world
# (_,world) = (me .# "doEditEvent" .$ (taskId,editorId,Just value)) world
= world
onKeyup me world
# (taskId,world) = .? (me .# "attributes.taskId") world
# (editorId,world) = .? (me .# "attributes.editorId") world
# (value,world) = .? (me .# "domEl.value") world
# value = if (jsValToString value == "") Nothing (Just value)
# (_,world) = ((me .# "doEditEvent") .$ (taskId, editorId,value)) world
onKeyup me world
# (taskId,world) = me .# "attributes.taskId" .? world
# (editorId,world) = me .# "attributes.editorId" .? world
# (value,world) = me .# "domEl.value" .? world
//# value = if (jsValToString value == "") Nothing (Just value) // TODO
# (_,world) = (me .# "doEditEvent" .$ (taskId, editorId,value)) world
= world
onEdit dp (tp,e) _ vst = (Ok (NoChange, e),vst)
......@@ -95,5 +96,5 @@ where
pikadayDateField :: Editor Date
pikadayDateField = selectByMode
(bijectEditorValue toString fromString textView)
(injectEditorValue toString parseDate (withDynamicHintAttributes "date (yyyy-mm-dd)" (withEditModeAttr pikadayField)))
(injectEditorValue toString parseDate (withDynamicHintAttributes "date (yyyy-mm-dd)" (withEditModeAttr pikadayField)))
(injectEditorValue toString parseDate (withDynamicHintAttributes "date (yyyy-mm-dd)" (withEditModeAttr pikadayField)))
(injectEditorValue toString parseDate (withDynamicHintAttributes "date (yyyy-mm-dd)" (withEditModeAttr pikadayField)))
......@@ -14,6 +14,8 @@ from StdMaybe import :: Maybe
class toJS a :: !a -> JSVal b
instance toJS Int, Bool, String, (JSVal b), (Maybe b) | toJS b
jsIsUndefined :: !(JSVal a) -> Bool
/**
* Access properties of a JavaScript value.
*/
......
......@@ -14,6 +14,7 @@ import Text
| JSCleanRef !Int // a reference to shared_clean_values
| JSVar !String
| JSNull
| JSUndefined
| E.b c: JSSel !(JSVal b) !(JSVal c) // b[c]
| E.b: JSSelPath !(JSVal b) !String // b.path1.path2...pathn
......@@ -31,10 +32,14 @@ where
JSCleanRef i -> "abc_interpreter.apply_to_clean_value("+++toString i+++")"
JSVar v -> v
JSNull -> "null"
JSUndefined -> "undefined"
JSSel obj attr -> toString obj+++"["+++toString attr+++"]"
JSSelPath obj path -> toString obj+++"."+++path
jsIsUndefined :: !(JSVal a) -> Bool
jsIsUndefined v = v=:JSUndefined
instance toJS Int where toJS i = JSInt i
instance toJS Bool where toJS b = JSBool b
instance toJS String where toJS s = JSString s
......@@ -99,7 +104,7 @@ where
call = "new "+++cons+++"("+++join "," [toString a \\ a <- toJSArgs args]+++")"
jsEmptyObject :: !*JSWorld -> *(!JSVal a, !*JSWorld)
jsEmptyObject w = (store_js_value "{}", w)
jsEmptyObject w = (eval_js_with_return_value "{}", w)
jsGlobal :: !String -> JSVal a
jsGlobal s = JSVar s
......@@ -148,25 +153,39 @@ eval_js_with_return_value s = code {
instruction 2
eq_desc dINT 0 0
jmp_true return_int
print "eval_js_with_return_value: return type unknown\n"
pushD_a 0
pushI 5290 | 661*8+2; DOMNode (bcprelink.c)
eqI
jmp_true return_ref
print "eval_js_with_return_value: return type unknown:\n"
print_symbol_sc 0
print "\n"
halt
:return_int
repl_r_args 0 1
push_b 0
pushI 4611686018427387904 | 1<<62; null
eqI
jmp_true return_null
push_b 0
pushI 4611686018427387905 | 1<<62+1; undefined
eqI
jmp_true return_undefined
fill_r e_iTasks.UI.JS.Interface_kJSInt 0 1 0 0 0
jmp return
:return_null
fillh e_iTasks.UI.JS.Interface_dJSNull 0 0
jmp return
:return_undefined
fillh e_iTasks.UI.JS.Interface_dJSUndefined 0 0
jmp return
:return_ref
repl_r_args 0 1
fill_r e_iTasks.UI.JS.Interface_kJSRef 0 1 0 0 0
jmp return
:return
}
store_js_value :: !String -> JSVal a
store_js_value s = JSRef (eval_and_store s)
where
eval_and_store :: !String -> Int
eval_and_store _ = code {
pushI 0 | to return the result
instruction 3
pop_a 1
}
share :: !a -> JSVal b
share x = JSCleanRef (get_shared_value_index x)
where
......
......@@ -87,7 +87,22 @@ const abc_interpreter={
copy_js_to_clean: function (values, asp, hp, hp_free) {
for (var i=values.length-1; i>=0; i--) {
asp+=8;
if (typeof values[i]=='number') {
console.log('copy',values[i]);
if (values[i]===null) {
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=26*8+2; // INT
abc_interpreter.memory_array[hp/4+2]=0;
abc_interpreter.memory_array[hp/4+3]=1<<30;
hp+=16;
hp_free-=2;
} else if (typeof values[i]=='undefined') {
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=26*8+2; // INT
abc_interpreter.memory_array[hp/4+2]=0;
abc_interpreter.memory_array[hp/4+3]=(1<<30)+1;
hp+=16;
hp_free-=2;
} else if (typeof values[i]=='number') {
// TODO use small integers
// TODO check garbage collection
if (Number.isInteger(values[i])) {
......@@ -110,7 +125,7 @@ const abc_interpreter={
default:
throw ('unknown abc_type '+values[i].abc_type);
}
} else if ('domEl' in values[i]) { /* probably an iTasks.Component; TODO: come up with a better check for this */
} else if (typeof values[i]=='object') {
// TODO: check if garbage collection is needed
abc_interpreter.memory_array[asp/4]=hp;
abc_interpreter.memory_array[hp/4]=661*8+2; // DOMNode type
......@@ -220,7 +235,7 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
case 2:
var string=abc_interpreter.get_clean_string(abc_interpreter.memory_array[asp/4]);
console.log('eval',string);
var result=eval(string);
var result=eval('('+string+')'); // the parentheses are needed for {}, for instance
var copied=abc_interpreter.copy_js_to_clean([result], asp-8, hp, hp_free);
abc_interpreter.interpreter.instance.exports.set_hp(copied.hp);
abc_interpreter.interpreter.instance.exports.set_hp_free(copied.hp_free);
......@@ -248,7 +263,6 @@ abc_interpreter.loading_promise=fetch('js/app.pbc').then(function(resp){
js.type='text/javascript';
if (callback.length>0)
js.onload=Function(callback+'();');
console.log(url,callback,js);
document.head.appendChild(js);
js.src=url;
break;
......
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