Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-libraries
Commits
d7c8f212
Commit
d7c8f212
authored
Dec 28, 2006
by
Rinus Plasmeijer
Browse files
*** empty log message ***
parent
5058bb79
Changes
18
Expand all
Hide whitespace changes
Inline
Side-by-side
libraries/htmlGEC/Examples/Conf Management System/ConfManager.icl
View file @
d7c8f212
...
...
@@ -209,7 +209,7 @@ where
=
guestHomePage
newaccount
accounts
hst
guestPerson
hst
// 2. administrate personel administration
#
(
personf
,
hst
)
=
mkEditForm
(
Init
,
nFormId
"cms_guest_person"
createDefault
)
hst
#
(
personf
,
hst
)
=
mkEditForm
(
Init
,
nFormId
"cms_guest_person"
createDefault
<@
Submit
)
hst
#
(
exception
,
hst
)
=
ExceptionStore
((+)
(
invariantPerson
account
.
login
.
loginName
personf
.
value
))
hst
|
isJust
exception
=
([
Txt
"2. Please fill in your personal data so that we can inform you."
,
Br
,
Br
]
++
personf
.
form
,
hst
)
#
(_,
hst
)
=
guestSubPages
Set
(\_
->
GuestSubmitPaper
)
hst
...
...
@@ -218,7 +218,7 @@ where
=
guestHomePage
account
accounts
hst
guestSubmitPaper
hst
// 3. handle paper submission
#
(
paperf
,
hst
)
=
mkEditForm
(
Init
,
nFormId
"cms_guest_paper"
createDefault
)
hst
#
(
paperf
,
hst
)
=
mkEditForm
(
Init
,
nFormId
"cms_guest_paper"
createDefault
<@
Submit
)
hst
#
(
exception
,
hst
)
=
ExceptionStore
((+)
(
invariantPaper
account
.
login
.
loginName
paperf
.
value
))
hst
|
isJust
exception
=
([
Txt
"3. Now submit your paper."
,
Br
,
Br
]
++
paperf
.
form
,
hst
)
#
(
paperNr
,
hst
)
=
PaperNrStore
inc
hst
// now all iformation is there, make it all persistent
...
...
libraries/htmlGEC/Examples/Conf Management System/ConfManager.prj
View file @
d7c8f212
This diff is collapsed.
Click to expand it.
libraries/htmlGEC/Examples/Simple Examples/balanceTree.prj
View file @
d7c8f212
Version: 1.4
Global
Built: True
Target:
Web Applications
Target:
Everything
Exec: {Project}\balanceTree.exe
CodeGen
CheckStacks: False
...
...
@@ -56,11 +56,11 @@ MainModule
DclOpen: False
Icl
WindowPosition
X:
23
0
Y: 1
4
X:
1
0
Y: 1
0
SizeX: 800
SizeY: 624
IclOpen:
Tru
e
IclOpen:
Fals
e
LastModified: No 0 0 0 0 0 0
OtherModules
Module
...
...
@@ -138,7 +138,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes:
No
Types
ListTypes:
StrictExport
Types
ListAttributes: True
Warnings: True
Verbose: True
...
...
@@ -155,7 +155,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes:
No
Types
ListTypes:
StrictExport
Types
ListAttributes: True
Warnings: True
Verbose: True
...
...
@@ -172,7 +172,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes:
No
Types
ListTypes:
StrictExport
Types
ListAttributes: True
Warnings: True
Verbose: True
...
...
@@ -189,7 +189,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes:
No
Types
ListTypes:
StrictExport
Types
ListAttributes: True
Warnings: True
Verbose: True
...
...
@@ -257,7 +257,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes:
No
Types
ListTypes:
StrictExport
Types
ListAttributes: True
Warnings: True
Verbose: True
...
...
@@ -274,7 +274,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes:
No
Types
ListTypes:
StrictExport
Types
ListAttributes: True
Warnings: True
Verbose: True
...
...
@@ -291,7 +291,7 @@ OtherModules
NeverMemoryProfile: False
NeverTimeProfile: False
StrictnessAnalysis: True
ListTypes:
No
Types
ListTypes:
StrictExport
Types
ListAttributes: True
Warnings: True
Verbose: True
...
...
@@ -457,7 +457,7 @@ OtherModules
Y: 10
SizeX: 800
SizeY: 624
DclOpen:
Fals
e
DclOpen:
Tru
e
IclOpen: False
LastModified: No 0 0 0 0 0 0
Module
...
...
@@ -477,8 +477,8 @@ OtherModules
DclOpen: False
Icl
WindowPosition
X:
143
Y:
-5
X:
84
Y:
8
SizeX: 800
SizeY: 624
IclOpen: False
...
...
@@ -3516,23 +3516,28 @@ Static
Path: {Application}\Libraries\StdLib
Path: {Application}\Libraries\ObjectIO
Path: {Application}\Libraries\ObjectIO\OS Windows
Path: {Application}\Libraries\Directory
Path: {Application}\Libraries\Dynamics\extension
Path: {Application}\Libraries\Dynamics\general
Path: {Application}\Libraries\Dynamics\implementation
Path: {Application}\Libraries\Dynamics\implementation\windows
Path: {Application}\Libraries\Generics
Path: {Application}\Libraries\ArgEnvWindows
Path: {Application}\Libraries\Gast
Path: {Application}\Libraries\Directory
Path: {Application}\Libraries\Tcp
Path: {Application}\Libraries\GEC\GEC Implementation
Path: {Application}\Libraries\ExceptionsWindows
Path: {Application}\Libraries\MersenneTwister
Path: {Application}\Libraries\WrapDebug
Path: {Application}\Libraries\ExtendedArith\ExtendedArith
Path: {Application}\Libraries\GameLib
Path: {Application}\Libraries\htmlGEC
Path: {Application}\Libraries\GEC\GEC Implementation
Path: {Application}\Libraries\Hilde
Path: {Application}\Libraries\GEC
Path: {Application}\Libraries\htmlGEC\graph_copy
Path: {Application}\Libraries\htmlGEC\htmlTest
Path: {Application}\Libraries\MersenneTwister
Path: {Application}\Libraries\Gerda
Path: {Application}\Libraries\Hilde
Path: {Application}\Libraries\Hilde\Parser combinators 2002
Path: {Application}\Libraries\ExceptionsWindows
Path: {Application}\Libraries\WrapDebug
AppP: C:\Documents and Settings\rinus\Bureaublad\Current Work\Clean 2.1.1
PrjP: C:\Documents and Settings\rinus\Bureaublad\Current Work\Clean 2.1.1\Libraries\htmlGEC\Examples\Simple Examples
Path: {Application}\Libraries\ExtEnv
AppP: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1
PrjP: C:\Documents and Settings\rinus\Desktop\Clean 2.1.1\Libraries\htmlGEC\Examples\Simple Examples
libraries/htmlGEC/Examples/Simple Workflows/date.icl
0 → 100644
View file @
d7c8f212
module
date
import
StdEnv
,
StdHtml
// findDate will settle a date and time between two persons that want to meet
// first a person is chosen by the person taken the initiative
// then a date is settled by the two persons by repeatedly asking each other for a convenient date
// if such a date is found both have to confirm the date and the task is finished
npersons
=
5
Start
world
=
doHtmlServer
(
multiUserTask
npersons
[]
findDate
)
world
findDate
tst
#
(
whomPD
,
tst
)
=
(
[
Txt
"Choose person you want to date:"
,
Br
]
?>>
STask
"Set"
(
PullDown
(
1
,
100
)
(
0
,[
toString
i
\\
i
<-
[
1
..
npersons
]]))
)
tst
#
whom
=
toInt
(
toString
whomPD
)
#
(
datetime
,
tst
)
=
(
[
Txt
"Determining date:"
,
Br
,
Br
]
?>>
findDate`
whom
(
Date
1
1
2007
,
Time
9
0
0
)
)
tst
#
(
me
,
tst
)
=
myId
tst
#
(_,
tst
)
=
(
[]
?>>
PTask2
(
confirm
me
whom
datetime
,
confirm
whom
me
datetime
)
)
tst
=
(
datetime
,
tst
)
where
findDate`
whom
daytime
tst
#
(
daytime
,
tst
)
=
proposeDateTime
daytime
tst
#
((
ok
,
daytime
),
tst
)=
((
whom
,
"Meeting Request"
)
@:
determineDateTime
daytime
)
tst
|
ok
=
returnV
daytime
tst
#
(
ok
,
tst
)
=
askDateTime
daytime
tst
|
ok
=
returnV
daytime
tst
=
mkTask
(
findDate`
whom
daytime
)
tst
where
proposeDateTime
(
date
,
time
)
tst
#
input
=
(
showHtml
[
Txt
"Propose date: "
],
date
,
showHtml
[
Txt
"Propose time: "
],
time
)
#
((_,
date
,_,
time
),
tst
)
=
STask
"Set"
input
tst
=
((
date
,
time
),
tst
)
determineDateTime
daytime
tst
#
(
ok
,
tst
)
=
askDateTime
daytime
tst
|
ok
=
returnV
(
ok
,
daytime
)
tst
#
(
daytime
,
tst
)
=
proposeDateTime
daytime
tst
=
returnV
(
ok
,
daytime
)
tst
askDateTime
(
date
,
time
)
tst
=
(
[
Txt
(
"Can we meet on the "
<+++
date
<+++
" at "
<+++
time
<+++
"?"
),
Br
]
?>>
CTask_button
[(
"Accept"
,
returnV
True
),(
"Sorry"
,
returnV
False
)]
)
tst
confirm
me
you
(
date
,
time
)
tst
=
(
me
@::
(
[
Txt
(
"Person "
<+++
me
<+++
" and person "
<+++
you
<+++
" will meet on "
<+++
date
<+++
" at "
<+++
time
),
Br
,
Br
]
?>>
STask
"OK"
Void
)
)
tst
libraries/htmlGEC/Examples/Simple Workflows/deadline.icl
0 → 100644
View file @
d7c8f212
module
deadline
import
StdEnv
,
StdHtml
derive
gForm
[]
derive
gUpd
[]
npersons
=
5
Start
world
=
doHtmlServer
(
multiUserTask
npersons
[]
(
deadline
mytask
))
world
mytask
=
STask
"Press"
0
deadline
task
tst
#
(
whomPD
,
tst
)
=
(
[
Txt
"Choose person you want to shift work to:"
,
Br
,
Br
]
?>>
STask
"Set"
(
PullDown
(
1
,
100
)
(
0
,[
toString
i
\\
i
<-
[
1
..
npersons
]]))
)
tst
#
who
=
toInt
(
toString
whomPD
)
#
(
time
,
tst
)
=
(
[
Txt
"Until what time do you want to wait today?"
,
Br
,
Br
]
?>>
STask
"SetTimer"
(
Time
0
0
0
)
)
tst
#
((
ok
,
value
),
tst
)
=
(
[]
?>>
shifttask
who
time
task
)
tst
#
(_,
tst
)
=
(
if
ok
[
Txt
(
"Result of task: "
<+++
value
),
Br
,
Br
]
[
Txt
"Task Expired !"
,
Br
,
Br
]
?>>
STask
"OK"
Void
)
tst
=
(
value
,
tst
)
where
shifttask
who
time
task
tst
=
((
who
,
"Timed Task"
)
@:
PCTask2
(
waitForTimeTask
time
// wait for deadline
#>>
returnV
(
False
,
createDefault
)
// return default
,
[
Txt
(
"Please finish task before"
<+++
time
),
Br
,
Br
]
// tell deadline
?>>
(
task
=>>
\
v
->
returnV
(
True
,
v
))
// do task and return its result
)
)
tst
libraries/htmlGEC/Examples/Simple Workflows/sum.icl
0 → 100644
View file @
d7c8f212
module
sum
import
StdEnv
,
StdHtml
// choose one of the following variants
Start
world
=
doHtmlServer
(
singleUserTask
count
)
world
// Start world = doHtmlServer (multiUserTask 3 [] countMU) world
// Start world = doHtmlServer (multiUserTask 3 [setTaskAttribute Persistent] countMU) world
count
tst
#
(
v1
,
tst
)
=
STask
"Set"
initVal
tst
#
(
v2
,
tst
)
=
STask
"Set"
initVal
tst
#
tst
=
returnF
[
Hr
[]]
tst
=
returnTask
(
v1
+
v2
)
tst
countMU
tst
#
(
v1
,
tst
)
=
((
1
,
"number"
)
@:
STask
"Set"
initVal
)
tst
// user 1
#
(
v2
,
tst
)
=
((
2
,
"number"
)
@:
STask
"Set"
initVal
)
tst
// user 2
#
tst
=
returnF
[
Hr
[]]
tst
// user 0
=
returnTask
(
v1
+
v2
)
tst
// user 0
// Change the type to any type one can apply addition to
initVal
::
Int
initVal
=
createDefault
libraries/htmlGEC/Examples/Simple Workflows/travel.icl
0 → 100644
View file @
d7c8f212
module
travel
import
StdEnv
,
StdHtml
derive
gForm
[]
derive
gUpd
[]
Start
world
=
doHtmlServer
(
singleUserTask
travel
)
world
travel
tst
#
(
booked
,
tst
)=
PCTask2
(
STasks
[
(
"Choose Booking options"
,
MCTask_ckbox
[
(
"Book_Flight"
,
BookFlight
)
,
(
"Book_Hotel"
,
BookHotel
)
,
(
"Book_Car"
,
BookCar
)
]
)
,
(
"Booking confirmation"
,
STask_button
"Confirm"
(
returnV
[])
)
]
,
STask_button
"Cancel"
(
returnV
[])
)
tst
|
isNil
booked
=
returnTask
"Cancelled"
tst
#
(_,
tst
)
=
STask
"Pay"
(
Dsp
(
calcCosts
booked
))
tst
=
returnTask
"Paid"
tst
where
BookFlight
tst
=
STask
"BookFlight"
(
Dsp
"Flight Number"
,
""
,
Dsp
"Costs"
,
0
)
tst
BookHotel
tst
=
STask
"BookHotel"
(
Dsp
"Hotel Name"
,
""
,
Dsp
"Costs"
,
0
)
tst
BookCar
tst
=
STask
"BookCar"
(
Dsp
"Car Brand"
,
""
,
Dsp
"Costs"
,
0
)
tst
Pay
booked
bookings
tst
=
returnTask
"OK"
tst
calcCosts
booked
=
sum
[
cost
\\
(_,_,_,
cost
)
<-
hd
booked
]
isNil
[]
=
True
isNil
_
=
False
Dsp
=
DisplayMode
libraries/htmlGEC/Examples/Simple Workflows/workflowExamples.icl
View file @
d7c8f212
...
...
@@ -9,7 +9,7 @@ derive gUpd []
//Start world = doHtmlServer (multiUser twotasks3) world
Start
world
=
doHtmlServer
(
multiUser
agenda2
)
world
Start
world
=
doHtmlServer
(
singleUser
CoffeeMachineInf
)
world
where
singleUser
tasks
hst
#
(_,
html
,
hst
)
=
startTask
0
tasks
hst
...
...
@@ -26,6 +26,7 @@ where
// # tst = setTaskAttribute Persistent tst
// # tst = setTaskAttribute StaticDynamic tst
// # tst = setTaskAttribute Database tst
// # tst = setTaskAttribute Submit tst
=
tasks
tst
...
...
@@ -35,9 +36,19 @@ list tst
#
(
a
,
tst
)
=
returnTask
a
tst
=
(
a
,
tst
)
onetwo
tst
#
(
v
,
tst
)
=
STasks
[
(
"First"
,
simple
1
|>>
(\
n
->
n
>
100
,
\_
->
"Value should be larger than 100"
)
=>>
(\
t
->
returnTask
t
))
,
(
"Second"
,
simple
2
=>>
(\
t
->
returnTask
t
))
]
tst
=
STask
"Klaar"
(
sum
v
)
tst
testEenTwee
tst
#
(
v
,
tst
)
=
STasks
[
(
"een"
,
(
1
,
"number1"
)
@:
simple
1
=>>
\
t
->
returnTask
t
)
,
(
"twee"
,(
2
,
"number2"
)
@:
simple
2
=>>
\
t
->
returnTask
t
)
#
(
v
,
tst
)
=
STasks
[
(
"een"
,
(
1
,
"number1"
)
@:
simple
1
|>>
(\
n
->
n
>
100
,\_
->
"Value should be larger than 100"
)
=>>
\
t
->
returnTask
t
)
,
(
"twee"
,(
2
,
"number2"
)
@:
simple
2
=>>
\
t
->
returnTask
t
)
]
tst
=
STask
"Klaar"
(
sum
v
)
tst
...
...
libraries/htmlGEC/PrintUtil.icl
View file @
d7c8f212
...
...
@@ -66,10 +66,10 @@ htmlCmnd :: !a !b -> FoF | gHpr{|*|} a & gHpr{|*|} b
htmlCmnd
hdr
txt
=
\
file
->
closeCmnd
hdr
(
openCmnd
hdr
""
file
<+
txt
)
openCmnd
::
!
a
!
b
->
FoF
|
gHpr
{|*|}
a
&
gHpr
{|*|}
b
openCmnd
hdr
attr
=
\
file
->
[|
"<"
:
file
]
<+
hdr
<+
attr
<+
">"
openCmnd
hdr
attr
=
\
file
->
[|
"
\r
<"
:
file
]
<+
hdr
<+
attr
<+
">"
closeCmnd
::
!
a
->
FoF
|
gHpr
{|*|}
a
closeCmnd
hdr
=
\
file
->
print
"</"
file
<+
hdr
<+
">"
closeCmnd
hdr
=
\
file
->
print
"
\r
</"
file
<+
hdr
<+
">"
htmlAttrCmnd
::
!
hdr
!
attr
!
body
->
FoF
|
gHpr
{|*|}
hdr
&
gHpr
{|*|}
attr
&
gHpr
{|*|}
body
htmlAttrCmnd
hdr
attr
txt
=
\
file
->
closeCmnd
hdr
(
openCmnd
hdr
attr
file
<+
txt
)
...
...
libraries/htmlGEC/htmlButtons.dcl
View file @
d7c8f212
...
...
@@ -10,7 +10,7 @@ derive gForm (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, But
derive
gUpd
(,),
(,,),
(,,,),
(<->),
<|>,
HtmlDate
,
HtmlTime
,
DisplayMode
,
Button
,
CheckBox
,
RadioButton
,
PullDownMenu
,
TextInput
,
TextArea
,
HTML
,
PasswordBox
derive
gPrint
(,),
(,,),
(,,,),
(<->),
<|>,
HtmlDate
,
HtmlTime
,
DisplayMode
,
Button
,
CheckBox
,
RadioButton
,
PullDownMenu
,
TextInput
,
TextArea
,
HTML
,
PasswordBox
derive
gParse
(,),
(,,),
(,,,),
(<->),
<|>,
HtmlDate
,
HtmlTime
,
DisplayMode
,
Button
,
CheckBox
,
RadioButton
,
PullDownMenu
,
TextInput
,
TextArea
,
HTML
,
PasswordBox
derive
gerda
(,),
(,,),
(,,,),
(<->),
<|>,
HtmlDate
,
HtmlTime
,
DisplayMode
,
Button
,
CheckBox
,
RadioButton
,
PullDownMenu
,
TextInput
,
TextArea
,
PasswordBox
derive
gerda
(,),
(,,),
(,,,),
(<->),
<|>,
HtmlDate
,
HtmlTime
,
DisplayMode
,
Button
,
CheckBox
,
RadioButton
,
PullDownMenu
,
TextInput
,
TextArea
,
HTML
,
PasswordBox
instance
toBool
CheckBox
,
Button
,
RadioButton
// True if checkbox checked, button pressed
instance
toInt
PullDownMenu
// Current index in pull down list
...
...
libraries/htmlGEC/htmlButtons.icl
View file @
d7c8f212
...
...
@@ -31,6 +31,7 @@ gParse{|HTML|} st = case gParse {|*|} st of
Just
"XYX"
->
Just
(
HTML
[
EmptyBody
])
_
->
Just
(
HTML
[
EmptyBody
])
gerda
{|
HTML
|}
=
undef
// Tuples are placed next to each other, pairs below each other ...
layoutTableAtts
:==
[
Tbl_CellPadding
(
Pixels
0
),
Tbl_CellSpacing
(
Pixels
0
)]
// default table attributes for arranging layout
...
...
libraries/htmlGEC/htmlDataDef.icl
View file @
d7c8f212
...
...
@@ -3,10 +3,10 @@ implementation module htmlDataDef
import
StdStrictLists
,
StdString
import
htmlStyleDef
,
htmlStylelib
gHpr
{|
Html
|}
prev
(
Html
head
rest
)
=
prev
<+
head
<+
rest
gHpr
{|
Html
|}
prev
(
Html
head
rest
)
=
prev
<+
htmlbegin
<+
head
<+
rest
<+
htmlend
where
htmlbegin
=
"<html>"
htmlend
=
"</html>
/n/n
"
htmlend
=
"</html>"
gHpr
{|
Head
|}
prev
(
Head
attr
tags
)
=
prev
<+>
htmlAttrCmnd
"head"
attr
tags
...
...
libraries/htmlGEC/htmlFormlib.icl
View file @
d7c8f212
...
...
@@ -29,7 +29,10 @@ mkHtmlB s attr tags hst = (simpleHtml s attr tags,hst)
// Place two bodies next to each other
(<=>)
infixl
5
::
[
BodyTag
]
[
BodyTag
]
->
BodyTag
(<=>)
b1
b2
=
(
BodyTag
b1
)
<.=.>
(
BodyTag
b2
)
(<=>)
[]
[]
=
EmptyBody
(<=>)
[]
b2
=
BodyTag
b2
(<=>)
b1
[]
=
BodyTag
b1
(<=>)
b1
b2
=
(
BodyTag
b1
)
<.=.>
(
BodyTag
b2
)
(<.=.>)
infixl
5
::
BodyTag
BodyTag
->
BodyTag
(<.=.>)
b1
b2
=
STable
[
Tbl_CellPadding
(
Pixels
0
),
Tbl_CellSpacing
(
Pixels
0
)]
[[
b1
,
b2
]]
...
...
@@ -40,6 +43,9 @@ mkHtmlB s attr tags hst = (simpleHtml s attr tags,hst)
(<||>)
b1
b2
=
(
BodyTag
b1
)
<.||.>
(
BodyTag
b2
)
(<|.|>)
infixl
4
::
[
BodyTag
]
[
BodyTag
]
->
[
BodyTag
]
// Place a above b
(<|.|>)
[]
[]
=
[]
(<|.|>)
[]
b2
=
b2
(<|.|>)
b1
[]
=
b1
(<|.|>)
b1
b2
=
[(
BodyTag
b1
)
<.||.>
(
BodyTag
b2
)]
...
...
libraries/htmlGEC/htmlSettings.dcl
View file @
d7c8f212
...
...
@@ -11,7 +11,7 @@ class iData a // The collection of generic functions needed to make iData:
class
iDataSerialize
a
|
gPrint
{|*|}
// To serialize a value to a String
,
gerda
{|*|}
// OPTION: To store and retrieve a value in a database
//
, gerda {|*|} // OPTION: To store and retrieve a value in a database
,
TC
a
// To be able to store values in a dynamic
// TC is a special class cannot be included here
class
iDataSerAndDeSerialize
a
...
...
@@ -21,6 +21,8 @@ class iDataSerAndDeSerialize a
TraceInput
:==
False
// show what kind of information is received from Client
TraceOutput
:==
False
// show what kind of information is stored
DEBUGSERVER
:==
True
// show what kind of information is transmitted by the Clean HtmlServer
MyDataBase
:==
"iDataDatabase"
// name of database being used by iData applications
iDataIdSeparator
:==
"."
// used as separator when combining iData form id's
...
...
@@ -28,5 +30,5 @@ radioButtonSeparator :== '.' // used as extension for family of radiobuttons
// OPTIONS WHICH CAN BE SET OFF AND ON
IF_GERDA
gerda
no_gerda
:==
gerda
// If database option is used
//
IF_GERDA gerda no_gerda :== no_gerda // otherwise, BUT manually flag of ", gerda{|*|}" in the class definition above
//
IF_GERDA gerda no_gerda :== gerda // If database option is used
IF_GERDA
gerda
no_gerda
:==
no_gerda
// otherwise, BUT manually flag of ", gerda{|*|}" in the class definition above
libraries/htmlGEC/htmlTask.dcl
View file @
d7c8f212
...
...
@@ -22,17 +22,20 @@ multiUserTask :: wrapper for [0..users - 1], optional set of global Task attrib
*/
startTask
::
!
Int
!(
Task
a
)
HSt
->
(
a
,[
BodyTag
],
HSt
)
|
iData
a
singleUserTask
::
!(
Task
a
)
!*
HSt
->
(
Html
,*
HSt
)
|
iData
a
multiUserTask
::
!
Int
!(
Task
a
)
[*
TSt
->
*
TSt
]
!*
HSt
->
(
Html
,*
HSt
)
|
iData
a
multiUserTask
::
!
Int
[*
TSt
->
*
TSt
]
!(
Task
a
)
!*
HSt
->
(
Html
,*
HSt
)
|
iData
a
/* Global Attribute settings: iTask are by default Lifespan = Session, StorageFormt = PlainString
For multi user systems
*/
class
setTaskAttribute
a
::
!
a
*
TSt
->
*
TSt
instance
setTaskAttribute
Lifespan
,
StorageFormat
instance
setTaskAttribute
Lifespan
,
StorageFormat
,
Mode
/* Assign tasks with informative name to user with indicated id
(@:) :: will prompt who is waiting for what
(@::) :: no prompting
*/
(@:)
infix
0
::
!(!
Int
,!
String
)
(
Task
a
)
->
(
Task
a
)
|
iData
a
(@:)
infix
1
::
!(!
Int
,!
String
)
(
Task
a
)
->
(
Task
a
)
|
iData
a
(@::)
infix
1
::
!
Int
(
Task
a
)
->
(
Task
a
)
|
iData
a
/* Promote any TSt state transition function to an iTask:
mkTask :: function will only be called when it is its turn to be activated
...
...
@@ -90,7 +93,8 @@ returnV :: a -> (Task a) | iData a
returnTask
::
a
->
(
Task
a
)
|
iData
a
returnVF
::
a
[
BodyTag
]
->
(
Task
a
)
|
iData
a
returnF
::
[
BodyTag
]
->
TSt
->
TSt
(?>>)
infix
3
::
[
BodyTag
]
v
:(
St
TSt
.
a
)
->
v
:(
St
TSt
.
a
)
(?>>)
infix
0
::
[
BodyTag
]
v
:(
St
TSt
.
a
)
->
v
:(
St
TSt
.
a
)
myId
::
TSt
->
(
Int
,
TSt
)
/* Setting up communication channels between users:
mkRTask :: Remote Task: split indicated task in two tasks: a calling task and a receiving task
...
...
@@ -125,3 +129,4 @@ appHSt :: (HSt -> (a,HSt)) TSt -> (a,TSt)
(=>>)
infix
2
::
w
:(
St
.
s
.
a
)
v
:(.
a
->
.(
St
.
s
.
b
))
->
u
:(
St
.
s
.
b
),
[
u
<=
v
,
u
<=
w
]
// `bind`
(#>>)
infix
1
::
w
:(
St
.
s
.
a
)
v
:(
St
.
s
.
b
)
->
u
:(
St
.
s
.
b
),
[
u
<=
v
,
u
<=
w
]
// `bind` ignoring argument
(|>>)
infix
3
::
(*
TSt
->
*(
a
,*
TSt
))
(
a
->
.
Bool
,
a
->
String
)
->
.(*
TSt
->
*(
a
,*
TSt
))
|
iData
a
// repeat as long as predicate does not hold
libraries/htmlGEC/htmlTask.icl
View file @
d7c8f212
...
...
@@ -19,6 +19,7 @@ import dynamic_string, EncodeDecode
}
::
Storage
=
{
tasklife
::
!
Lifespan
,
taskstorage
::
!
StorageFormat
,
taskmode
::
!
Mode
}
::
HtmlTree
=
BT
[
BodyTag
]
...
...
@@ -42,17 +43,18 @@ startTask thisUser taska hst
,
myId
=
defaultUser
,
html
=
defaultUser
@@:
BT
[]
,
hst
=
hst
,
storageInfo
=
{
tasklife
=
Session
,
taskstorage
=
PlainString
}}
,
storageInfo
=
{
tasklife
=
Session
,
taskstorage
=
PlainString
,
taskmode
=
Edit
}}
#
(
pversion
,
hst
)
=
mkStoreForm
(
Init
,
pFormId
userVersionNr
0
)
inc
hst
#
(
sversion
,
hst
)
=
mkStoreForm
(
Init
,
nFormId
sessionVersionNr
pversion
.
value
)
inc
hst
=
(
a
,
refresh
.
form
++
[
Br
,
Br
,
Hr
[],
Br
]
<|.|>
Filter
thisUser
defaultUser
html
,
hst
)
=
(
a
,
refresh
.
form
++
[
Br
,
Br
,
Hr
[],
Br
]
<|.|>
Filter
((==)
thisUser
)
defaultUser
html
,
hst
)
where
Filter
thisUser
user
(
BT
bdtg
)
=
if
(
thisUser
==
user
)
bdtg
[]
Filter
thisUser
user
(
nuser
@@:
tree
)
=
Filter
thisUser
nuser
tree
Filter
thisUser
user
(
tree1
+|+
tree2
)
=
Filter
thisUser
user
tree1
<|.|>
Filter
thisUser
user
tree2
Filter
thisUser
user
(
tree1
+-+
tree2
)
=
[
Filter
thisUser
user
tree1
<=>
Filter
thisUser
user
tree2
]
defaultUser
=
0
Filter
pred
user
(
BT
bdtg
)
=
if
(
pred
user
)
bdtg
[]
Filter
pred
user
(
nuser
@@:
tree
)
=
Filter
pred
nuser
tree
Filter
pred
user
(
tree1
+|+
tree2
)
=
Filter
pred
user
tree1
<|.|>
Filter
pred
user
tree2
Filter
pred
user
(
tree1
+-+
tree2
)
=
[
Filter
pred
user
tree1
<=>
Filter
pred
user
tree2
]
// options settings
instance
setTaskAttribute
Lifespan
...
...
@@ -61,13 +63,16 @@ where setTaskAttribute lifespan tst = {tst & storageInfo.tasklife = lifespan}
instance
setTaskAttribute
StorageFormat
where
setTaskAttribute
storageformat
tst
=
{
tst
&
storageInfo
.
taskstorage
=
storageformat
}
instance
setTaskAttribute
Mode
where
setTaskAttribute
mode
tst
=
{
tst
&
storageInfo
.
taskmode
=
mode
}
singleUserTask
::
!(
Task
a
)
!*
HSt
->
(
Html
,*
HSt
)
|
iData
a
singleUserTask
task
hst
#
(_,
html
,
hst
)
=
startTask
0
task
hst
=
mkHtml
"stest"
html
hst
multiUserTask
::
!
Int
!(
Task
a
)
[*
TSt
->
*
TSt
]
!*
HSt
->
(
Html
,*
HSt
)
|
iData
a
multiUserTask
nusers
task
attr
hst
multiUserTask
::
!
Int
[*
TSt
->
*
TSt
]
!(
Task
a
)
!*
HSt
->
(
Html
,*
HSt
)
|
iData
a
multiUserTask
nusers
attr
task
hst
#
(
idform
,
hst
)
=
FuncMenu
(
Init
,
nFormId
"pdm_chooseWorker"
(
0
,[(
"User "
+++
toString
i
,\_
->
i
)
\\
i
<-[
0
..
nusers
-
1
]
]))
hst
#
currentWorker
=
snd
idform
.
value
...
...
@@ -78,26 +83,39 @@ where
#
tst
=
seq
attr
tst