;; ssc3.el - (c) rohan drape, 2004-2008

;; This mode is implemented as a derivation of `rsc3' mode, which is a
;; derivation of `scheme' mode.  

(require 'rsc3)
(require 'sclang "sclang" t)

;; SSC.

(defvar ssc3-buffer
  "*ssc3*"
  "*The name of the ssc3 process buffer.")

(defun ssc3-start-scheme ()
  "Start the ssc3 process.  

Start rsc3, require the ssc3 module and setup the ssc3 send client to the
default port for sclang, 57120, on the local machine."
  (interactive)
  (rsc3-start-scheme)
  (rsc3-evaluate-expression "(import (ssc3))")
  (rsc3-evaluate-expression "(current-ssc3-client (make-ssc3-client \"127.0.0.1\" 57120))"))


;; SCL.

(defun ssc3-start-scl ()
  "Start the sclang process. 

Start sclang and start the EvalListener server."
  (interactive)
  (sclang-start)
  (sit-for 1)
  (sclang-eval-string "EvalListener.init;"))

(defun ssc3-see-scl ()
  "See the ssc3 buffer."
  (interactive)
  (sclang-show-post-buffer))

(defun ssc3-stop-scl ()
  "Stop the SCL process."
  (interactive)
  (sclang-stop))


;; Evaluate.

(defun ssc3-evaluate-expression (expression)
  "Evaluate an arbitrary expression."
  (interactive "sString to evaluate: ")
  (rsc3-evaluate-expression 
   (concat "(ssc3-eval (quote " expression "))")))

(defun ssc3-evaluate ()
  "Evaluate the complete s-expression that precedes point."
  (interactive)
  (ssc3-evaluate-expression (rsc3-expression-before-point)))

(defun ssc3-play ()
  "Rewrite and evaluate the s-expression that precedes point."
  (interactive)
  (ssc3-evaluate-expression
   (concat "(play (lambda () " 
	   (rsc3-expression-before-point)
	   "))")))

(defun ssc3-draw ()
  "Rewrite and evaluate the s-expression that precedes point."
  (interactive)
  (ssc3-evaluate-expression
   (concat "(draw (lambda () " 
	   (rsc3-expression-before-point)
	   "))")))

(defun ssc3-translate-expression (expression)
  "Translate an arbitrary expression."
  (interactive "sString to evaluate: ")
  (rsc3-evaluate-expression 
   (concat "(ssc3->sc (quote " expression "))")))

(defun ssc3-translate ()
  "translate the complete s-expression that precedes point."
  (interactive)
  (ssc3-translate-expression (rsc3-expression-before-point)))

(defun ssc3-translate-file (input-file output-file)
  "Rewrite the ssc3 expressions at a file to SCL expressions."
  (interactive "fInput file: \nFOutput file: ")
  (rsc3-evaluate-expression
   (concat "(ssc3-file->sc-file \"" input-file "\" \"" output-file "\")")))


;; SC3 Server.

(defun ssc3-boot-sc3 ()
  "Start the current SC3 server and establish a connection."
  (interactive)
  (ssc3-evaluate-expression "(boot s)"))

(defun ssc3-clear-sc3 ()
  "Free all nodes running at the current SC3 server and stop managed
threads."
  (interactive)
  (ssc3-evaluate-expression "(stop thisProcess)"))

(defun ssc3-shutdown-sc3 ()
  "Shutdown the current SC3 server."
  (interactive)
  (ssc3-evaluate-expression "(quit s)"))


;; Mode

(defvar ssc3-mode-map nil
  "Keymap for ssc3 mode.")

(defun ssc3-font-lock-special-forms ()
  "Rules to font lock special forms."
  (interactive)
  (font-lock-add-keywords 
   'ssc3-mode
   (list (cons (regexp-opt '("class" "extend" "method" "classvar" "var") t) font-lock-keyword-face))))

(defun ssc3-mode-keybindings (map)
  "Install ssc3 keybindings into `map'."
  ;; Scheme.
  (define-key map "\C-c\C-s" 'ssc3-start-scheme)
  ;; SCL.
  (define-key map "\C-c!"    'ssc3-start-scl)
  (define-key map "\C-c>"    'ssc3-see-scl)
  (define-key map "\C-c_"    'ssc3-stop-scl)  
  ;; SC3.
  (define-key map "\C-c\C-o" 'ssc3-shutdown-sc3)
  (define-key map "\C-c\C-k" 'ssc3-clear-sc3)
  (define-key map "\C-c\C-b" 'ssc3-boot-sc3)
  ;; Expression.
  (define-key map "\C-c\C-e" 'ssc3-evaluate)
  (define-key map "\C-c\C-p" 'ssc3-play)
  (define-key map "\C-c\C-d" 'ssc3-draw)
  (define-key map "\C-c\C-t" 'ssc3-translate)
  (define-key map "\C-c\C-f" 'ssc3-translate-file))

(defun ssc3-mode-menu (map)
  "Install ssc3 menu into `map'."

  ;; SSC3.
  (define-key map [menu-bar ssc3]
    (cons "SSC3" (make-sparse-keymap "ssc3")))
  ;; Expression.
  (define-key map [menu-bar ssc3 expression] 
    (cons "Expression" (make-sparse-keymap "Expression")))
  (define-key map [menu-bar ssc3 expression translate-file]
    '("Translate File" . ssc3-translate-file))
  (define-key map [menu-bar ssc3 expression translate]
    '("Translate" . ssc3-translate))
  (define-key map [menu-bar ssc3 expression draw]
    '("Draw" . ssc3-draw))
  (define-key map [menu-bar ssc3 expression play]
    '("Play" . ssc3-play))
  (define-key map [menu-bar ssc3 expression evaluate]
    '("Evaluate" . ssc3-evaluate))
  ;; SC3.
  (define-key map [menu-bar ssc3 sc3]
    (cons "SC3" (make-sparse-keymap "SC3")))
  (define-key map [menu-bar ssc3 sc3 shutdown]
    '("Shutdown SC3" . ssc3-shutdown-sc3))
  (define-key map [menu-bar ssc3 sc3 clear]
    '("Clear SC3" . ssc3-clear-sc3))
  (define-key map [menu-bar ssc3 sc3 start]
    '("Start SC3" . ssc3-boot-sc3))
  ;; SCL.
  (define-key map [menu-bar ssc3 scl]
    (cons "SCL" (make-sparse-keymap "SCL")))
  (define-key map [menu-bar ssc3 scl see-scl]
    '("See SCL" . ssc3-see-scl))
  (define-key map [menu-bar ssc3 scl stop-scl]
    '("Stop SCL" . ssc3-stop-scl))
  (define-key map [menu-bar ssc3 scl start-scl]
    '("Start SCL" . ssc3-start-scl))
  ;; Scheme.
  (define-key map [menu-bar ssc3 listener]
    (cons "Scheme" (make-sparse-keymap "Scheme")))
  (define-key map [menu-bar ssc3 listener start-scheme]
    '("Start scheme" . ssc3-start-scheme)))

;; If there is no exitsing map create one and install the keybindings
;; and menu.
(if ssc3-mode-map
    ()
  (let ((map (make-sparse-keymap "ssc3")))
    (ssc3-mode-keybindings map)
    (ssc3-mode-menu map)
    (setq ssc3-mode-map map)))

(define-derived-mode 
  ssc3-mode 
  rsc3-mode 
  "ssc3-mode"
  "Major mode for writing ssc3 code.  Derived from `rsc3-mode' and
requiring `comint-mode' mode.

The following keys are bound:
\\{ssc3-mode-map}

Customisation: Entry to this mode runs the hooks on
`scheme-mode-hook', `rsc3-mode-hook' and `ssc3-mode-hook' (in that
order).
"
  (put 'class 'scheme-indent-function 'scheme-let-indent)
  (put 'extend 'scheme-indent-function 'scheme-let-indent)
  (put 'method 'scheme-indent-function 'scheme-let-indent)
  (put 'classmethod 'scheme-indent-function 'scheme-let-indent)
  (ssc3-font-lock-special-forms))

;; Declare this mode to emacs.

(add-to-list 'auto-mode-alist '("\\.ssc3$" . ssc3-mode))
(add-to-list 'interpreter-mode-alist '("ssc3" . ssc3-mode))

(provide 'ssc3)