Commit 2e69256f authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

*** empty log message ***

parent a7ec97b3
module Counter
import StdEnv
import StdHtml
//Start world = doHtml MyPage world
Start world = doHtmlServer MyPage world
MyPage hst
# (counter0,hst) = counterForm (nFormId "counter0") 0 hst
# (counter1,hst) = counterForm (nFormId "counter1") 0 hst
= mkHtml "Counter Example"
[ H1 [] "Counter Example"
, BodyTag counter0.form
, toBody counter0
, toBody counter1
, toHtml (counter0.value + counter1.value)
] hst
This diff is collapsed.
module arrow
import StdEnv
import StdHtml
derive gUpd []
derive gForm []
import tree
Start world = doHtml MyPage world
MyPage hst
# (mycircuitf,hst) = startCircuit mycircuit [1] hst
# [list,tree:_] = mycircuitf.form
= mkHtml "List to Balance Tree"
[ H1 [] "List to Balance Tree"
, Txt "This is the list :", Br
, list
, Txt "This is the resulting balanced tree :", Br
, tree
] hst
where
mycircuit :: GecCircuit [Int] (Tree Int)
mycircuit = edit (nFormId "list") >>> arr fromListToBalTree >>> display (nFormId "tree")
<html>
<?php
// collect posted values
$args = "#";
foreach ($_POST as $key => $value)
{ $args = $args . $key . " = " . $value . " ; " ; }
// collect arguments passed to this script
$arguments = $_SERVER['argv'];
$phpargs = "#";
foreach ($arguments as $key => $value)
{ $phpargs = $phpargs . $key . " == " . $value . " : " ; }
echo exec("arrow.exe -con $phpargs $args");
?>
</html>
\ No newline at end of file
This diff is collapsed.
module balanceTree
import StdEnv
import StdHtml
import tree
derive gForm []
derive gUpd []
Start world = doHtmlServer MyPage world
//Start world = doHtml MyPage world
MyPage hst
# (balancedtree,hst) = mkSelfForm (nFormId "BalancedTree")
(fromListToBalTree [0]) balanceTree hst
= mkHtml "Balanced Tree"
[ H1 [] "Balanced Tree"
, BodyTag balancedtree.form
] hst
MyPage2 hst
# (sortedlist,hst) = mkSelfForm (nFormId "SortedList")
[0] sort hst
= mkHtml "Sorted List"
[ H1 [] "Sorted List"
, BodyTag sortedlist.form
, toHtml (reverse sortedlist.value)
] hst
MyPage3 hst
# (treef,hst) = startCircuit mycircuit (Node Leaf 1 Leaf) hst
= mkHtml "Self Balancing Tree"
[ H1 [] "Self Balancing Tree"
, toBody treef
] hst
where
mycircuit = feedback (edit (nFormId "tree")) (arr balanceTree)
MyPage4 hst
# (sortedlist,hst) = startCircuit mycircuit [1] hst
# (test,hst) = mkApplyEditForm (nFormId "test") 1 1 hst
# (test2,hst) = mkApplyEditForm (nFormId "test") 1 1 hst
= mkHtml "Self Balancing Tree"
[ H1 [] "Self Balancing Tree"
, toBody sortedlist
, toHtml sortedlist.changed
, toHtml sortedlist.value
, toBody test
, toBody test
, toHtml test.changed
, toHtml test2.changed
] hst
where
mycircuit = feedback (edit (nFormId "list")) (arr sort)
<html>
<?php
// collect posted values
$args = "#";
foreach ($_POST as $key => $value)
{ $args = $args . $key . " = " . $value . " ; " ; }
// collect arguments passed to this script
$arguments = $_SERVER['argv'];
$phpargs = "#";
foreach ($arguments as $key => $value)
{ $phpargs = $phpargs . $key . " == " . $value . " : " ; }
echo exec("balanceTree.exe -con $phpargs $args");
// echo exec("balanceTree.exe -con $args $phpargs");
?>
</html>
\ No newline at end of file
This diff is collapsed.
module calculator
// simple spreadsheet example
// (c) MJP 2005
import StdEnv
import StdHtml
//Start world = doHtml arrowcalculator world
Start world = doHtmlServer calculator world
calculator hst
# (calcfun,hst) = TableFuncBut (nFormId "calcbut") calcbuttons hst // shows buttons
# (display,hst) = mkStoreForm (nFormId "display") initcalc calcfun.value hst // calculates new values
= mkHtml "Calculator"
[ H1 [] "Calculator Example: "
, toBody display
, toBody calcfun
] hst
arrowcalculator hst
# (calcfun,hst) = TableFuncBut (nFormId "calcfun") calcbuttons hst // shows buttons
# (display,hst) = startCircuit circuit calcfun.value hst // calculates new values
= mkHtml "Calculator"
[ H1 [] "Calculator Example: "
, toBody display
, toBody calcfun
] hst
where
circuit = store (nFormId "display") initcalc
initcalc = (0 <|> 0)
calcbuttons = [ [(but "7",set 7), (but "8",set 8), (but "9",set 9) ]
, [(but "4",set 4), (but "5",set 5), (but "6",set 6) ]
, [(but "1",set 1), (but "2",set 2), (but "3",set 3) ]
, [(but "0",set 0), (but "C",clear), (but "CA",cla) ]
, [(but "+",app (+)), (but "-",app (-)), (but "*",app (*))]
, [(but "^2",app2 (*))]
]
where
set i (t <|> b) = (t <|> b*10 + i)
clear (t <|> b) = (t <|> 0)
cla (t <|> b) = (0 <|> 0)
app fun (t <|> b) = (fun t b <|> 0)
app2 fun (t <|> b) = (fun t t <|> 0)
but i = LButton (defpixel / 3) i
<html>
<?php
// collect posted values
$args = "#";
foreach ($_POST as $key => $value)
{ $args = $args . $key . " = " . $value . " ; " ; }
// collect arguments passed to this script
$arguments = $_SERVER['argv'];
$phpargs = "#";
foreach ($arguments as $key => $value)
{ $phpargs = $phpargs . $key . " == " . $value . " : " ; }
echo exec("calculator.exe -con $phpargs $args");
?>
</html>
\ No newline at end of file
This diff is collapsed.
This diff is collapsed.
module coffeemachine
import StdEnv
import StdHtml
derive gForm Machine, Output, Product
derive gUpd Machine, Output, Product
derive gPrint Machine, Output, Product
derive gParse Machine, Output, Product
//Start world = doHtml coffeemachine world
Start world = doHtmlServer coffeemachine world
coffeemachine hst
# (command,hst) = TableFuncBut (nFormId "cb") commandbuttons hst
# (option,hst) = TableFuncBut (nFormId "ob") optionbuttons hst
# (machine,hst) = mkStoreForm (nFormId "hidden") initmachine (option.value o command.value) hst
= mkHtml "Coffee Machine"
[ H1 [] "Coffee Machine: "
, [toHtml (displaycontents machine.value)] <=> command.form
, BodyTag option.form
, Br
, B [] (displayoutput machine.value)
] hst
where
commandbuttons =
[ [(but "Insert_Coins", \m -> CoffeeMachine (InsertCoin, m))]
, [(but "Add_beans", \m -> CoffeeMachine (AddBeans, m))]
, [(but "Empty_Trash", \m -> CoffeeMachine (EmptyTrash, m))]
]
optionbuttons =
[ [(but "Coffee", \m -> CoffeeMachine (Ask Coffee, m))
,(but "Capuccino", \m -> CoffeeMachine (Ask Capuccino, m))
,(but "Espresso", \m -> CoffeeMachine (Ask Espresso, m))
]
]
but s = LButton defpixel s
initmachine = {money=0,beans=6,trash=0,out=Message "Welcome."}
displayoutput {out} = toString out
displaycontents {money,beans,trash}
= ("money ",money) <|>
("beans ",beans) <|>
("trash ",trash)
// The defintion below is copied from the GEC coffeemachine, and slightly improved...
:: Client // Client actions:
= InsertCoin // insert a coin
| Ask Product // ask for product
| AddBeans // add beans in machine
| EmptyTrash // empty bean trash of machine
| Idle // does nothing
:: Machine // CoffeeMachine:
= { money :: Int // nr of coins (maxCoins)
, beans :: Int // amount of beans (maxBeans)
, trash :: Int // amount of bean-trash (maxTrash)
, out :: Output // output of machine
}
:: Product = Coffee | Capuccino | Espresso
:: Msg :== String // Errors or customer-friendly information
:: Output = Message Msg | Prod Product
// CoffeeMachine is the self-correcting function on the model data of the Client-Coffee Machine:
CoffeeMachine :: (Client,Machine) -> Machine
CoffeeMachine (InsertCoin, m=:{money})
| money >= maxCoins = { m & out = Message "Coin not accepted." }
| otherwise = { m & money = money+1, out = Message "Thank you." }
CoffeeMachine (EmptyTrash, m) = { m & trash = 0, out = Message "Trash emptied." }
CoffeeMachine (AddBeans, m=:{beans})
| beans > maxBeans-beanBag = { m & out = Message "Too many beans." }
| otherwise = { m & beans = beans+beanBag, out = Message "Beans refilled." }
CoffeeMachine (Ask p,m=:{money,beans,trash})
| beans < beancost p = { m & out = Message "Not enough beans." }
| money < cost p = { m & out = Message "Not enough coins." }
| trash + ptrash p > maxTrash = { m & out = Message "Trash full." }
| otherwise = { m & out = Prod p
, beans = beans - beancost p
, money = money - cost p
, trash = trash + ptrash p
}
CoffeeMachine (_,m) = m
maxCoins :== 10 // max. number of coins in machine
maxBeans :== 20 // max. amount of coffeebeans in machine
maxTrash :== 5 // max. amount of coffeetrash in machine
beanBag :== 10 // unit of bean refill
// The number of coins that a product costs
cost :: Product -> Int
cost Coffee = 1
cost Capuccino = 2
cost Espresso = 3
// The number of beans that a product costs
beancost :: Product -> Int
beancost Coffee = 2
beancost Capuccino = 1
beancost Espresso = 1
// Amount of trash generated by product
ptrash :: Product -> Int
ptrash _ = 1
instance toString Output where
toString (Message s) = s
toString (Prod Coffee) = "Coffee"
toString (Prod Capuccino) = "Capuccino"
toString (Prod Espresso) = "Espresso"
<html>
<?php
// collect posted values
$args = "#";
foreach ($_POST as $key => $value)
{ $args = $args . $key . " = " . $value . " ; " ; }
// collect arguments passed to this script
$arguments = $_SERVER['argv'];
$phpargs = "#";
foreach ($arguments as $key => $value)
{ $phpargs = $phpargs . $key . " == " . $value . " : " ; }
echo exec("coffeemachine.exe -con $phpargs $args");
?>
</html>
\ No newline at end of file
This diff is collapsed.
<html>
<?php
// collect posted values
$args = "#";
foreach ($_POST as $key => $value)
{ $args = $args . $key . " = " . $value . " ; " ; }
// collect arguments passed to this script
$arguments = $_SERVER['argv'];
$phpargs = "#";
foreach ($arguments as $key => $value)
{ $phpargs = $phpargs . $key . " == " . $value . " : " ; }
echo exec("counter.exe -con $phpargs $args");
?>
</html>
\ No newline at end of file
module helloworld
import StdEnv, StdHtml
Start world = doHtmlServer helloWorld world
helloWorld hst
= mkHtml "Hello World Example" [Txt "Hello World!"] hst
\ No newline at end of file
<html>
<?php
// collect posted values
$args = "#";
foreach ($_POST as $key => $value)
{ $args = $args . $key . " = " . $value . " ; " ; }
// collect arguments passed to this script
$arguments = $_SERVER['argv'];
$phpargs = "#";
foreach ($arguments as $key => $value)
{ $phpargs = $phpargs . $key . " == " . $value . " : " ; }
echo exec("helloworld.exe -con $phpargs $args");
?>
</html>
\ No newline at end of file
This diff is collapsed.
Supports Markdown
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