bork
authorMart Lubbers <mart@martlubbers.net>
Mon, 2 Sep 2019 09:18:43 +0000 (11:18 +0200)
committerMart Lubbers <mart@martlubbers.net>
Mon, 2 Sep 2019 09:18:43 +0000 (11:18 +0200)
7gui/test.icl
abc/test.icl [new file with mode: 0644]
benchmark/test.icl [new file with mode: 0644]
benchmark/test.sh [new file with mode: 0644]
onclick/test.icl [new file with mode: 0644]
test.icl

index 8bb3901..b76ee57 100644 (file)
@@ -1,12 +1,14 @@
 module test
 
+import StdMisc
 import Data.Func
 import Data.Tuple
 import System.Time
 
 import iTasks
-import iTasks.Extensions.DateTime
 import iTasks.UI.Editor.Common
+import iTasks.Extensions.DateTime
+import iTasks.Extensions.SVG.SVGEditor => qualified grid
 
 import qualified Data.Map as DM
 import Data.Map.GenJSON
@@ -15,7 +17,8 @@ import Data.Map.GenJSON
 //Start w = doTasks gui2 w
 //Start w = doTasks gui3 w
 //Start w = doTasks (get currentTimestamp >>- \t->gui4 30 t) w
-Start w = doTasks gui5 w
+//Start w = doTasks gui5 w
+Start w = doTasks gui6 w
        
 gui1 :: Int -> Task Int
 gui1 c = viewInformation "Counter" [] c
@@ -61,6 +64,7 @@ name name surname = {name=name, surname=surname}
 derive class iTask Name
 instance toString Name where toString n = n.Name.name +++ ", " +++ n.surname
 
+gui5 :: Task (Int, Name)
 gui5 = withShared ('DM'.fromList [(0, name "Emil" "Hans"), (1, name "Mustermann" "Max"), (2, name "Tisch" "Roman")]) \data->
                enterInformation "Filter prefix" []
        >&> \v->whileUnchanged (mapRead (fromMaybe " ") v) \filter->
@@ -73,3 +77,23 @@ gui5 = withShared ('DM'.fromList [(0, name "Emil" "Hans"), (1, name "Mustermann"
                    , OnAction (Action "update") $ withValue \(i, n)->Just $ upd ('DM'.put i n) data
                    , OnAction (Action "delete") $ withValue \(i, n)->Just $ upd ('DM'.del i) data
                    ]
+
+gui6 :: Task [(Real, Real, Real)]
+gui6 = updateInformation ()
+       [UpdateUsing id (const id) (fromSVGEditor svged)]
+       [(5.0, 5.0, 5.0)]
+
+svged :: SVGEditor [(Real, Real, Real)] [(Real, Real, Real)]
+svged = {initView=id, renderImage=renderImage, updModel=const id}
+where
+       renderImage _ images ts
+               # (_, images) = trace_stdout ("img: ", images)
+               = collage [(px x, px y)\\(_, x, y)<-images] [circle (px r)\\(r, _, _)<-images]
+               $ Host $ rect (px 100.0) (px 100.0)
+                       <@< {fill=toSVGColor "white"}
+                       <@< {onclick=clicker,local=False}
+
+       clicker m = jsTrace "click" [(5.0, 10.0, 10.0):m]
+
+import Debug.Trace, StdDebug
+import iTasks.UI.JavaScript
diff --git a/abc/test.icl b/abc/test.icl
new file mode 100644 (file)
index 0000000..9912de1
--- /dev/null
@@ -0,0 +1,40 @@
+module test
+
+(+) :: !Int !Int -> Int
+(+) a b
+       = code {
+               addI
+       }
+
+(*) :: !Int !Int -> Int
+(*) a b
+       = code {
+               mulI
+       }
+
+(-) :: !Int !Int -> Int
+(-) a b
+       = code {
+               subI
+       }
+
+fac :: Int -> Int
+fac 0 = 1
+fac n = n * fac (n - 1)
+
+:: List a = Cons a (List a) | Nil
+toList :: [a] -> List a
+toList [] = Nil
+toList [x:xs] = Cons x (toList xs)
+
+length :: (List a) -> Int
+length Nil = 0
+length (Cons _ xs) = 1 + length xs
+
+inc :: (Int -> Int)
+inc = (+) 1
+
+plus :: Int -> (Int -> Int)
+plus x = \y->(+) x y
+
+Start = (fac 5, length (toList [0,1,2,3,4,5]), inc, plus)
diff --git a/benchmark/test.icl b/benchmark/test.icl
new file mode 100644 (file)
index 0000000..f3b8fa3
--- /dev/null
@@ -0,0 +1,62 @@
+module test
+
+import iTasks
+import Data.Func
+import Debug.Performance
+import iTasks.Extensions.Terminal
+import Text.Terminal.VT100
+
+n :== 5000
+
+Start w
+       = printTime (toString n +++ " steps: ") (doTasks $ onStartup $ steps n)
+       $ printTime (toString n +++ " sequence: ") (doTasks $ onStartup $ seq n)
+       $ printTime (toString n +++ " all: ") (doTasks $ onStartup $ all n)
+       $ printTime (toString n +++ " for: ") (doTasks $ onStartup $ for n)
+       $ printTime (toString (n/100) +++ " exproc: ") (doTasks $ onStartup $ exp (n/100))
+       $ printTime (toString n +++ " get: ") (doTasks $ onStartup $ getter n)
+       $ printTime (toString n +++ " set: ") (doTasks $ onStartup $ setter n)
+       $ printTime (toString n +++ " upd: ") (doTasks $ onStartup $ updater n)
+       $ printTime (toString n +++ " view: ") (doTasks $ onStartup $ view n)
+       $ printTime (toString n +++ " update: ") (doTasks $ onStartup $ update n)
+       $ w
+
+sds = sharedStore "bork" 42
+
+steps :: Int -> Task Int
+steps 0 = return 0
+steps n = return n @ dec >>= steps
+
+seq :: Int -> Task [Int]
+seq n = sequence (repeatn n (return 42))
+
+all :: Int -> Task [Int]
+all n = allTasks (repeatn n (return 42))
+
+for :: Int -> Task Int
+for n = foreverStIf (\x->x < n) 0 (return o inc)
+
+exp :: Int -> Task Int
+exp 0 = return 0
+exp n = runProcessInteractive zero "/bin/ls" [] Nothing
+       >>| exp (n-1)
+
+getter :: Int -> Task Int
+getter 0 = return 0
+getter n = get sds >>| getter (n-1)
+
+setter :: Int -> Task Int
+setter 0 = return 0
+setter n = set 42 sds >>| setter (n-1)
+
+updater :: Int -> Task Int
+updater 0 = return 0
+updater n = upd id sds >>| updater (n-1)
+
+view :: Int -> Task Int
+view 0 = return 0
+view n = viewInformation () [] n >>~ view o dec
+
+update :: Int -> Task Int
+update 0 = return 0
+update n = updateInformation () [] n >>~ update o dec
diff --git a/benchmark/test.sh b/benchmark/test.sh
new file mode 100644 (file)
index 0000000..5242e7d
--- /dev/null
@@ -0,0 +1,26 @@
+#!/bin/bash
+set -e
+
+if [ $# -lt 2 ]
+then
+       echo "Usage $0 project.prj branch1 [branch2 [..]]"
+       exit 0
+fi
+
+log="/dev/null"
+
+prj=$1
+bin="$(grep -Po "(?<=Exec:     ).*" test.prj | sed 's/{Project}/'"$(dirname "$1")"/g)"
+
+shift
+
+for branch in "$@"
+do
+       echo "$branch:"
+       rm -fr iTasks-SDK
+       git clone -q --depth 1 --branch="$branch" gitlab.science.ru.nl:clean-and-itasks/iTasks-SDK
+
+       cpm project "$prj" build >"$log" 2>&1
+       "$bin" || true
+       rm -rf "$bin" "$bin"-{www,data} "Clean System Files"
+done
diff --git a/onclick/test.icl b/onclick/test.icl
new file mode 100644 (file)
index 0000000..86dec60
--- /dev/null
@@ -0,0 +1,22 @@
+module test
+
+import iTasks
+import StdDebug
+import Data.Func
+import iTasks.UI.JavaScript
+import iTasks.Extensions.SVG.SVGEditor => qualified grid
+
+Start w = doTasks gui6 w
+
+gui6 = updateInformation () [UpdateUsing id (const id) (fromSVGEditor svged)] [(5.0, 5.0, 5.0)]
+
+svged :: SVGEditor [(Real, Real, Real)] [(Real, Real, Real)]
+svged = {initView=id, renderImage=renderImage, updModel=const}
+where
+       renderImage images _ ts
+               = collage [(px x, px y)\\(_, x, y)<-images] [circle (px r)\\(r, _, _)<-images]
+               $ Host $ rect (px 100.0) (px 100.0)
+                       <@< {fill=toSVGColor "white"}
+                       <@< {onclick=clicker,local=False}
+
+       clicker m = jsTrace "click" [(10.0, 10.0, 5.0):m]
index 97f071a..8a75a61 100644 (file)
--- a/test.icl
+++ b/test.icl
@@ -1,11 +1,12 @@
 module test
 
+import Debug.Trace
 import iTasks
 
 import iTasks.Extensions.DateTime
 import iTasks.UI.Layout.Minimal
 
-Start w = doTasksWithOptions opt t2 w
+Start w = doTasksWithOptions opt w2 w
 where
        t :: Task DateTime
        t = waitForTimer 7
@@ -23,10 +24,23 @@ where
        t7 :: Int -> Task Int
        t7 i = viewInformation () [] i >>= \x->t7 (x + 1)
 
+       t8 = viewInformation () [] 1
+               >>= \_->(viewInformation () [] 2
+               >>= \_->viewInformation () [] 3
+               >>= \_->viewInformation () [] 4)
+
        p = parallel [(Embedded, \_->waitForTimer 5)] []
        p1 = waitForTimer 5 -||- waitForTimer 10
        p2 = withShared 3 \sh->watch sh
 
+       w1 = withShared 0 \sds -> (watch sds @? trace_stdout) -&&- updateInformation () [] 0 -&&- updateSharedInformation () [] sds
+
+       w2 = withShared 0 \sds ->
+                     updateSharedInformation () [] sds
+               -&&- (whileUnchanged sds (viewInformation () []) @? trace_stdout)
+
+       w3 = forever (viewInformation () [] 32) @? trace_stdout
+       
        opt args eo = Ok eo
 //     opt args eo = Ok {eo & autoLayout=False}