Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
122 lines (101 sloc) 4.03 KB
(in-package #:plot-window)
;;;; Our Javascript code module DW
(declare-javascript-library jquery ()
:url "//ajax.googleapis.com/ajax/libs/jquery/1.9.1/jquery.min.js"
:loaded-p (boundp j-query))
(declare-javascript-library jquery-json (jquery)
:url "/jquery.json-2.4.js"
:loaded-p (boundp (@ j-query to-j-s-o-n)))
(declare-javascript-library graceful-web-socket (jquery)
:url "/jquery.gracefulWebSocket.js"
:loaded-p (boundp (@ j-query graceful-web-socket)))
(define-javascript-code-module dw ()
:requires (graceful-web-socket jquery-json))
(defun-javascript (dw lg) (msg)
(send-ws-message (create :type "page-log" :message msg))
(chain console (log msg)))
(defun-javascript (dw make-element-inserter) (how location)
(create 'how how 'location location))
(defvar-javascript (dw *inserter*) ($ (lambda () (setf (@ dw *inserter*) (make-element-inserter :prepend ($ "body"))))))
(defun-javascript (dw insert-element) (new-element continuation &optional (element-inserter (@ dw *inserter*)))
(let* ((loc (@ element-inserter location)))
(unless (= 1 (length loc))
(throw
(new (-error
(interpolate
"{Selector \"$[place]\" found $[(length loc)] elements, must result in exactly one.}")))))
(case (@ element-inserter how)
(:before
(chain new-element (hide))
(chain loc (before new-element))
(chain new-element (slide-down 1000 continuation)))
(:after
(chain new-element (hide))
(chain loc (after new-element))
(chain new-element (slide-down 1000 continuation)))
(:append
(chain new-element (hide) (fade-in 1000 continuation))
(chain loc (append new-element)))
(:prepend
(chain new-element (hide))
(chain loc (prepend new-element))
(chain new-element (slide-down 1000 continuation)))
(:replace-content
(cprogn (continuation)
(progn
(chain ($ (chain loc (children))) (wrap-all "<div/>"))
(chain loc (children) (fade-out 400 next)))
(progn
(chain loc (empty))
(chain new-element (hide) (fade-in 400 next))
(chain loc (prepend new-element))))))))
(defvar-javascript (dw ws) 1)
(defun-javascript (dw on-message) (e)
(let* ((msg (chain $ (parse-j-s-o-n (@ e data))))
(target (@ msg target))
(selection (if target
(j-query (@ msg target))
j-query))
(event (@ msg event))
(argument (if (@ msg argument)
(@ msg argument)
msg)))
(lg (concatenate 'string "Got: " (chain -J-S-O-N (stringify msg))))
(funcall (aref selection event) argument)))
(defun-javascript (dw initialize) ()
;;; establish dw.ws
(let ((x (chain $ (graceful-web-socket (websocket-url)))))
(flet ((ws-error (e)
(chain console (log "ws hd an error.")))
(ws-open (e)
;; This next line sets *last-websocket-client* over
;; on the lisp side. This should be done in a more
;; fastidious manner.
(lg "websocket has opened")))
(setf (@ dw ws) x)
(setf (@ x onerror) #'ws-error)
(setf (@ x onopen) #'ws-open)
(setf (@ x onmessage) #'on-message)))
(chain console (log "dw module has initialized")))
(defun-javascript (dw send-ws-message) (data)
(cond
((and (boundp (@ this dw))
(boundp (@ dw ws))
(eql (typeof (@ dw ws)) :object)
(not (eql null (@ dw ws))))
(cond
((eql (@ dw ws ready-state) 1)
(chain dw ws (send (chain $ (to-J-S-O-N data)))))
(t
(chain console (log "dw.ws is not open")))))
(t
(chain console (log "dw.ws is unavailable")))))
(defun-javascript (dw clear-screen) ()
(chain ($ :body) (empty)))
(defun clear-display-window ()
(ps-eval-in-client (chain dw (clear-screen))))
#+nil
(defun-javascript (dw create) (prototype-object)
(flet ((-f () (create)))
(setf (@ -f prototype) o)
(new -f)))
Something went wrong with that request. Please try again.