Commit 5c073813 authored by Rinus Plasmeijer's avatar Rinus Plasmeijer
Browse files

password type added

parent 45880782
......@@ -12,7 +12,18 @@ derive gParse Pounds, Euros
:: Euros = {euros :: Real}
//Start world = doHtml mutual world
Start world = doHtmlServer mutual world
Start world = doHtmlServer test world
test hst
# (first,hst) = startCircuit circuit (0,0) hst
= mkHtml "first"
[ H1 [] "test of first"
, toBody first
] hst
where
circuit = first (edit (nFormId "in" 0) >>> arr ((+) 1)) >>> display (nFormId "out" (0,0))
myEuroId :: (FormId Euros)
myEuroId = nFormId "euros" initEuros
......
......@@ -143,7 +143,7 @@ OtherModules
Y: 0
SizeX: 500
SizeY: 300
DclOpen: False
DclOpen: True
Icl
WindowPosition
X: 0
......@@ -4694,32 +4694,18 @@ 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\ExceptionsWindows
Path: {Application}\Libraries\MersenneTwister
Path: {Application}\Libraries\ExtendedArith\ExtendedArith
Path: {Application}\Libraries\GameLib
Path: {Application}\Libraries\GEC
Path: {Application}\Libraries\GEC\GEC Implementation
Path: {Application}\Libraries\WrapDebug
Path: {Application}\Libraries\htmlGEC
Path: {Application}\Libraries\htmlGEC\graph_copy
Path: {Application}\Libraries\Hilde
Path: {Application}\Libraries\Hilde\Loes 0.2
Path: {Application}\Libraries\Hilde\OS Windows\Foreign
Path: {Application}\Libraries\Hilde\OS Windows\NoDynamicFileSystem
Path: {Application}\Libraries\Hilde\Parser combinators 2002
Path: {Application}\Libraries\ExtEnv
Path: {Application}\Libraries\ExtendedArith
Path: {Application}\Libraries\StdLib
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\Work Administration
Path: {Application}\Libraries\htmlGEC\htmlTest
Path: {Application}\Libraries\MersenneTwister
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\Work Administration
......@@ -4,15 +4,15 @@ definition module htmlButtons
import htmlHandler
derive gForm (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML
derive gUpd (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML
derive gPrint (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML
derive gParse (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML
derive gForm (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, HTML, PasswordBox
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
instance toBool CheckBox, Button, RadioButton // True if checkbox checked, button pressed
instance toInt PullDownMenu // Current index in pull down list
instance toString PullDownMenu // Corresponding element in pull down list
instance == PasswordBox
// lay out
:: <-> a b = (<->) infixl 5 a b // place b to the left of a
......@@ -40,6 +40,7 @@ instance toString PullDownMenu // Corresponding element in pull down list
| TR Int Real // Input box of size Size for Reals
| TS Int String // Input box of size Size for Strings
:: TextArea = TextArea Int Int String // Input Area Box, row col initial string
:: PasswordBox = PasswordBox String
// special's
......
......@@ -4,9 +4,9 @@ import StdEnv, ArgEnv
import htmlHandler, htmlStylelib, htmlTrivial
derive gUpd (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, /*Button, */CheckBox, RadioButton /*, PullDownMenu, TextInput */, TextArea
derive gPrint (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea
derive gParse (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea
derive gUpd (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, /*Button, */CheckBox, RadioButton /*, PullDownMenu, TextInput */, TextArea/*, PasswordBox*/
derive gPrint (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, PasswordBox
derive gParse (,), (,,), (,,,), (<->), <|>, HtmlDate, HtmlTime, DisplayMode, Button, CheckBox, RadioButton, PullDownMenu, TextInput, TextArea, PasswordBox
:: TextInput = TI Int Int // Input box of size Size for Integers
| TR Int Real // Input box of size Size for Reals
......@@ -237,6 +237,35 @@ gForm{|TextInput|} (init,formid) hst
# (body,hst) = mkInput size (init,formid) (SV s) (UpdS s) hst
= ({changed=False, value=TS size s, form=[body]},incrHSt 2 hst)
:: PasswordBox = PasswordBox String
gForm{|PasswordBox|} (init,formid) hst
= case formid.ival of
(PasswordBox password)
# (body,hst) = mkPswInput defsize (init,formid) password (UpdS password) hst
= ({changed=False, value=PasswordBox password, form=[body]},incrHSt 1 hst)
where
mkPswInput :: !Int !(InIDataId d) String UpdValue *HSt -> (BodyTag,*HSt)
mkPswInput size (init,formid=:{mode = Edit}) sval updval hst=:{cntr}
= ( Input [ Inp_Type Inp_Password
, Inp_Value (SV sval)
, Inp_Name (encodeTriplet (formid.id,cntr,updval))
, Inp_Size size
, `Inp_Std [EditBoxStyle, Std_Title "::Password"]
, `Inp_Events [OnChange callClean]
] ""
,incrHSt 1 hst)
mkPswInput size (init,{mode = Display}) sval _ hst=:{cntr}
= ( Input [ Inp_Type Inp_Password
, Inp_Value (SV sval)
, Inp_ReadOnly ReadOnly
, `Inp_Std [DisplayBoxStyle]
, Inp_Size size
] ""
,incrHSt 1 hst)
mkPswInput size (init,_) val _ hst=:{cntr}
= ( EmptyBody,incrHSt 1 hst)
//derive gForm HtmlTime
gForm {|HtmlTime|} (init,formid) hst
......@@ -344,6 +373,10 @@ gUpd{|TextInput|} (UpdSearch val cnt) i = (UpdSearch val (cnt - 3),i) //
gUpd{|TextInput|} (UpdCreate l) _ = (UpdCreate l,TI defsize 0) // create default value
gUpd{|TextInput|} mode i = (mode,i) // don't change
gUpd{|PasswordBox|} (UpdSearch (UpdS name) 0) _ = (UpdDone,PasswordBox name) // update password value
gUpd{|PasswordBox|} (UpdSearch val cnt) b = (UpdSearch val (cnt - 2),b) // continue search, don't change
gUpd{|PasswordBox|} (UpdCreate l) _ = (UpdCreate l,PasswordBox "") // create default value
gUpd{|PasswordBox|} mode b = (mode,b) // don't change
// small utility stuf
......@@ -367,3 +400,7 @@ where
instance toString PullDownMenu
where
toString (PullDown _ (i,s)) = if (i>=0 && i <length s) (s!!i) ""
instance == PasswordBox
where
(==) (PasswordBox psw1) (PasswordBox psw2) = psw1 == psw2
......@@ -8,7 +8,7 @@ import htmlDataDef, htmlFormData
import StdBool
import GenPrint, GenParse
TraceInput :== False//True // set it to True if you want to see what kind of information is received from browser
TraceInput :== False // set it to True if you want to see what kind of information is received from browser
derive bimap Form, FormId
......
......@@ -56,6 +56,7 @@ where
doHtmlServer :: (*HSt -> (Html,!*HSt)) *World -> *World
doHtmlServer userpage world
= StartServer 80 (map (\(id,_,f) -> (id,f)) pages) world
// = StartServer 80 pages world
where
// pages :: [(String,String, String String Arguments *World -> ([String],String,*World))]
pages
......
......@@ -6,11 +6,11 @@ import htmlHandler, htmlFormlib
(>>=) fM gM = \hSt -> let (a,hSt1) = fM hSt in gM a hSt1
mkHtmlM :: String [BodyTag] -> HStM Html // string is used for the title of the page
mkHtmlM s tags = return (simpleHtml s tags)
mkHtmlM s tags = return (simpleHtml s [] tags)
/* Experiment with more do-like notation.
(>>=) :: u:(.a -> (.(.b -> (.a,.c)),.(.c -> .d))) -> v:(.b -> .d), [v <= u]
(>>=) f = help f
// Experiment with more do-like notation.
(>>>=) :: u:(.a -> (.(.b -> (.a,.c)),.(.c -> .d))) -> v:(.b -> .d), [v <= u]
(>>>=) f = help f
where
help :: !.(.a -> (.(.b -> (.a,.c)),.(.c -> .d))) .b -> .d
help f hSt
......@@ -18,4 +18,3 @@ where
where
(a,hSt1) = fM hSt
(fM,gM) = f a
*/
\ No newline at end of file
......@@ -6,7 +6,7 @@ definition module httpServer
// StartServer takes a port number + list of virtual pages
StartServer :: Int [(String,(String String Arguments *World-> ([String],String,*World)))] *World -> *World
StartServer :: Int [(String,(String String Arguments *World -> ([String],String,*World)))] *World -> *World
getArgValue :: String Arguments -> String
getContentType :: String -> 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