(load "@lib/http.l" "@lib/xhtml.l" "@lib/form.l" "@lib/ps.l")

### DB ###
(class +Person +Entity)
(rel name (+Need +Sn +Idx +String))    # Name
(rel prefname (+Sn +Idx +String))      # Preferred Name
(rel sex (+Need +String))              # Gender
(rel dob (+Need +Ref +Date))           # Birthdate
(rel age (+Number))                    # Age (calculated)
(rel email (+Need +String))            # Email
(rel txt (+String))                    # Memo

(dm T (name NAME prefname PREFNAME sex SEX dob DOB email EMAIL txt TXT)
  (=: name NAME)
  (=: prefname PREFNAME)
  (=: sex SEX)
  (=: dob DOB)
  (=: age (/ (- (date) DOB) 365) )
  (=: email EMAIL)
  (=: txt TXT) )

(dm url> (Tab)
   (list "!person" '*ID This) )

(dm check> ()
   (make
      (or (: name) (link ,"Enter a name.")) 
      (or (: sex) (link ,"Choose a sex.")) 
      (or (: dob) (link ,"Enter a date of birth.") ) ) )


# Database sizes
(dbs
   (3 +Person)			  		      # 512 Prevalent objects
   (0 )                          # A:64 Tiny objects
   (1 (+Person name prefname))   # B:128 Small objects
   (2 )                  		   # C:256 Normal objects
   (4 )          				      # D:1024 Large objects
   (6 )						         # E:4096 Huge objects
   (2 )					            # F:256 Small indices
   (4 )						         # G:1024 Normal indices
   (6 ) )				 	         # H:4096 Large indices


### GUI ###
(de choPerson (Dst)
   (diaform '(Dst)
      (<grid> "--.-.-." 
         "Name" (gui 'name '(+Focus +Var +TextField) '*Name 20)
         "Preferred Name" (gui 'prefname '(+Var +TextField) '*PrefName 20)
         "Birthdate" (gui 'dob '(+Var +DateField) '*DOB 10)
         (searchButton '(init> (: home query)))
         "Email" (gui 'email '(+Var +TextField) '*Email 20)
         "" ""
         "" ""
         (resetButton '(name prefname dob email)) )
      (gui 'query '(+QueryChart) (cho)
         '(goal
            (quote
               @Name *Name
               @PrefName *PrefName
               @DOB *DOB
               @Email *Email
               (select (@@)
                  ((name +Person @Name)
                     (prefname +Person @PrefName)
                     (dob +Person @DOB)
                     (email +Person @Email) )
                  (tolr @Name @@ name)
                  (tolr @PrefName @@ prefname)
                  (tolr @DOB @@ dob)
                  (tolr @Email @@ email) ) ) )
          5
          '((This) (list This This This This This This)) )
      (<table> 'chart NIL
         '((btn) (NIL "Name") (NIL "Peferred Name") (NIL "Birthdate") (NIL "Email"))
         (do (cho)
            (<row> (alternating)
               (gui 1 '(+DstButton) Dst)
               (gui 2 '(+ObjView +TextField) '(: name))
               (gui 3 '(+ObjView +TextField) '(: prefname))
               (gui 4 '(+ObjView +DateField) '(: dob))
               (gui 5 '(+ObjView +TextField) '(: email)) ) ) )
      (<spread>
         (scroll (cho))
         (<nbsp>)
         (prin "Person")
         (newButton T Dst '(+Person) 'name *Name 'prefname *PrefName)
         (<nbsp> 4)
         (cancelButton) ) ) )


# Person HTML Page
(de person ()
   (app)
   (action
      (html 0 (get (default *ID (val *DB)) 'name) "@lib.css" NIL
         (form NIL
            (gui '(+OnClick +Button) "alert('OK')" "Alert")
            (<h2> NIL (<id> (: name)))
            (panel T "Person '@1'" T '(choPerson) 'name '+Person)
            (<grid> 6
               "Name" (gui '(+E/R +TextField) '(name : home obj) 20 *Name)
               "Preferred Name" (gui '(+E/R +TextField) '(prefname : home obj) 20 *PrefName)
               "Sex" (gui '(+E/R +TextField) '(sex : home obj) '("Male" "Female"))
               "Birthdate" (gui '(+E/R +DateField) '(dob : home obj) 10 *DOB)
               "Age" (gui '(+Lock +E/R +NumField) '(age : home obj) 5)
               "Email" (gui '(+E/R +TextField) '(email : home obj) 20 *Email)
               "Memo" (gui '(+E/R +TextField) '(txt : home obj) 40 10)
               (----)
               (editButton T) 
               (newButton T Dst '(+Person) 'name *Name 'prefname *PrefName) ) ) ) ) )


### RUN ###
(de main ()
   (pool "database/" *Dbs)
   (unless (val *DB)
      (put>
         (set *DB (request '(+Person) 'name "Choochoo Chacha" 'prefname "Bobobaba" 'sex "Male" 'dob (date (1970 05 21)) 'email "choocha@bobobaba.net" 'txt '"Hooray for text!") ) )
      (commit) ) )

(de go ()
   (rollback)
   (server 8080 "!person") )

# vi:et:ts=3:sw=3