Untitled

(define TRUE 1)
(define FALSE 0)
(define users '())
(define rooms '("standard", "standard2"))
(define (draw-client)
        (<HTML>
            (<HEAD>
             (<SCRIPT>

             ~(define user "")
             ~(define (load-page v) (alert "page loaded") (innerHTML-set! (dom-get-element-by-id "body") v))


             ~(define (welcome-user)

                           (set! user (dom-get-element-by-id "username").value)
                           (<DIV> (<H1> "Welcome " user)
                           (<P>(<INPUT>

                                    :onclick (begin (with-hop ($logout user) (lambda (x) (innerHTML-set! (dom-get-element-by-id "body") (show-login)) )))
                                    :type "button"
                                    :value "log out"
                                    ))
                           (<DIV> :id "rooms"))
                           )
             ~(define (print-rooms)
                                 (with-hop ($get-rooms) (lambda (x)
                                       (innerHTML-set! (dom-get-element-by-id "rooms") x))))


             ~(define (login) (with-hop ($login (dom-get-element-by-id "username"))
                                           (lambda (x) (if
                                                        (eq? x $FALSE)
                                                        (begin (alert "login failed, choose another nickname")
                                                                  (dom-set-attribute!
                                                                   (dom-get-element-by-id "username")
                                                                   "value"
                                                                   ""))
                                                           (begin (innerHTML-set! (dom-get-element-by-id "body") (welcome-user))
                                                                  (print-rooms))


                                   ))) )

          ~(define (show-login)
                          (<DIV> (<P> "Username"
                                      (<INPUT> :id "username" :value "test"))
                                 (<P>
                                  (<INPUT> :type "button"
                                           :value "login"
                                           :onclick (login)))
                          ))))

              (<BODY>
              (<DIV> :id "body" (show-login-s)))
              ~(add-event-listener! "NEWROOM" "server" (lambda (x) (alert x)) 1)
             ))


(define (show-login-s)
             (<DIV> (<P> "Username"
                  (<INPUT> :id "username" :value "test"))
             (<P>
              (<INPUT> :type "button"
                       :value "login"
                       :onclick ~(login)))))


(define (delete-from-list element list)
  (tprint "car list: " (car list))
  (tprint "equal? " (equal? element (car list)))
  (if (eq? '() list)
      '()
      (if (equal? element (car list))
          (cdr list)
          (cons (car list) (delete-from-list element (cdr list))))))


(define-service (logout user)
  (tprint "ok we will delete " user)
  (set! users (delete-from-list user users))
  (tprint users))


 (define (get-room-iter list)
  (if (eq? '() list)
      '()
      (cons (<TR> (<TD> (car list))
                  (<TD> (<INPUT> :type "button" :value "delete"
                               :onclick ~(alert "we will delete " (car list))))
                  ) (get-room-iter (cdr list)))))

(define-service (get-rooms)
  (<DIV>
   (<P> "New room"
     (<INPUT> :id "newroom"))
  (<P>
     (<INPUT> :type "button"
     :value "add room"
     :onclick ~(begin (alert "New room: " (dom-get-element-by-id "newroom").value) (with-hop ($add-room (dom-get-element-by-id "newroom"))
                                                                                             (lambda (x) x)
                                                                                             ) )
     ))
  (<TABLE> (get-room-iter rooms))
  ;code for new rooms
  )
  )


(define-service (login user)
  (if (or (equal? "" user)(member user users))
      FALSE
      (begin (set! users (cons user users)) (tprint users) TRUE)))


(define-service (add-room room)
  (if (or (equal? "" room)(member room rooms))
      FALSE
      (begin (set! rooms (cons room rooms))  (hop-event-broadcast! "NEWROOM" "test")(tprint "NEWROOM send"))))

(define-service (draw)
    (draw-client))

(draw)