OSNCL/src/osn-viewer.lisp

;;;; OpenScenarioNext --- OpenScenario Language Design
;;;; This is copyrighted software.  See documentation for terms.
;;;; 
;;;; osn-viewer.lisp --- Generic OSN Viewer User Interface

(cl:in-package #:openscenarionext-bench)

;;;; %File Description:
;;;; 
;;;; OSN Viewer/Editor
;;;; 

(defun application-interface-new-osn (interface)
  (capi:display 
   (make-instance 'osn-viewer
                  :source nil
                  :osn-buffer
                  (editor:make-buffer "Unknown" :temporary t))
   :screen
   (derive-main-interface-screen interface)))

;;;
;;; OSN Viewer
;;;

(defun osn-maybe-parse-buffer (buffer)
  (editor:with-buffer-locked (buffer :for-modification nil)
    (let ((string (editor:points-to-string  
                   (editor:buffers-start buffer)
                   (editor:buffers-end buffer))))
      (with-input-from-string (stream string)
        (ignore-errors 
          (list (osn-io:parse-osn-stream stream)))))))

(capi:define-interface osn-viewer (document-interface)
  ((document-kind :initform "OSN Viewer")
   (document-icon :initform "FMIBenchFMD.ico")
   (osn-buffer :initarg :osn-buffer :initform nil
               :accessor osn-viewer-osn-buffer))
  (:panes
   (osn-editor-pane
    capi:editor-pane
    :echo-area t
    :change-callback
    (lambda (pane point old-len new-len)
      (setf (capi:graph-pane-roots osn-graph-pane)
            (osn-maybe-parse-buffer
             (capi:editor-pane-buffer pane))))
    :buffer osn-buffer)
   (osn-graph-pane
    capi:graph-pane
    :roots (osn-maybe-parse-buffer osn-buffer)
    :print-function
    (lambda (object)
      (typecase object
        (scenario (format nil "Scenario ~A"
                          (scenario-name object)))
        (act (format nil "Act ~A" (act-name object)))
        (rule (format nil "Rule @~A~@[ %~A~]"
                      (rule-condition object)
                      (rule-modifier object)))
        (t (princ-to-string object))))
    :children-function
    (lambda (root)
      (typecase root
        (osn-file (list (osn-file-scenario root)))
        (scenario
         (append (scenario-acts root)
                 (scenario-prototypes root)
                 (scenario-resources root)))
        (act (act-rules root))
        (rule (rule-actions root))
        (t nil)))))
  (:layouts
   (osn-editor-layout 
    capi:column-layout
    '(osn-editor-pane))
   (osn-graph-layout 
    capi:column-layout
    '(osn-graph-pane))
   (switchable-layout
    capi:switchable-layout
    '(osn-editor-layout osn-graph-layout))
   (tab-layout
    capi:tab-layout
    '(switchable-layout)
    :items (list
            '("Editor" . osn-editor-layout)
            '("Graph" . osn-graph-layout))
    :print-function #'car
    :callback-type :interface-data
    :selection-callback 
    (lambda (interface item)
      (let ((view (slot-value interface (cdr item))))
        (setf (capi:switchable-layout-visible-child switchable-layout) view))))
   (main-layout 
    capi:column-layout
    '(tab-layout)))
  (:menus
   (file-menu
    "File"
    ((:component
      ((:menu 
        (("OSN File" 
          :callback 'application-interface-new-osn
          :callback-type :interface)
         ("XOSC File" 
          :callback 'application-interface-new-xosc
          :callback-type :interface))
        :title "New")
       ("Open ..."
        :accelerator "accelerator-o"
        :callback 'application-interface-open
        :callback-type :interface)
       ("Close"
        :accelerator "accelerator-w"
        :callback 'capi:quit-interface
        :callback-type :interface)))
     (:component
      (("Save"
        :callback 'document-interface-save
        :callback-type :interface
        :enabled-function 'document-interface-save-p)
       ("Save As ..."
        :callback 'document-interface-save-as
        :callback-type :interface)))
     (:component
      (("Refresh From File"
        :callback 'document-interface-refresh
        :callback-type :interface
        :enabled-function #'document-interface-source)))
     (:component
      (("Quit OSN Bench"
        :accelerator "accelerator-q"
        :callback 'quit-osn-bench
        :callback-type :interface)))))
   (osn-menu
    "OpenScenarioNext"
    (
     #+(or)
     (:component
      (("Export Import Warnings to CSV ..."
        :callback 'export-viewer-warnings-to-csv
        :callback-type :interface
        :enabled-function 'viewer-warnings)))
     (:component
      (("Export to XOSC ..."
        :callback 'export-osn-to-xosc
        :callback-type :interface
        :enabled-function
        (lambda (x)
          (declare (ignore x))
          (capi:graph-pane-roots osn-graph-pane))))))))
  (:menu-bar file-menu osn-menu)
  (:default-initargs
   :layout 'main-layout
   :best-width 900
   :best-height 600))

(defmethod document-interface-title-details ((interface osn-viewer))
  "")

(defmethod document-interface-save-as-dialog ((interface osn-viewer))
  (capi:prompt-for-file "OSN File"
                        :pathname (document-interface-source interface)
                        :operation :save
                        :if-exists :prompt
                        :if-does-not-exist :ok
                        :filters '("OSN Files" "*.osn"
                                   "All Files" "*.*")
                        :filter "*.osn"
                        :owner interface)
  "osn")

(defmethod document-interface-save-internal ((interface osn-viewer) pathname)
  #+(or)
  (csv-io:write-csv-file (csv-viewer-csv interface) pathname))

(defmethod document-interface-refresh-reader ((interface osn-viewer) pathname)
  #+(or)
  (csv-io:read-csv-file pathname))

(defmethod document-interface-refresh-internal ((interface osn-viewer) entity warnings)
  (declare (ignore warnings))
  (untouch-document-interface interface))

(defmethod export-osn-to-xosc ((viewer osn-viewer))
  (let ((osn (first (capi:graph-pane-roots (slot-value viewer 'osn-graph-pane)))))
    (when osn
      (application-interface-new-xosc
       viewer
       :content
       (with-output-to-string (stream)
         (osn-os10:write-os10-stream osn stream))))))