Add initial User Interface code
This commit is contained in:
198
src/osn-viewer.lisp
Normal file
198
src/osn-viewer.lisp
Normal file
@ -0,0 +1,198 @@
|
||||
;;;; 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))
|
||||
: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
|
||||
(multiple-value-bind (pathname ok)
|
||||
(capi:prompt-for-file "Export OSN To XOSC"
|
||||
:operation :save
|
||||
:filters '("XOSC Files" "*.XOSC")
|
||||
:filter "*.XOSC")
|
||||
(when ok
|
||||
(capi:with-busy-interface (viewer)
|
||||
(with-open-file (stream pathname #+(or) (ensure-pathname-type pathname "xosc")
|
||||
:external-format :utf-8
|
||||
:element-type :default
|
||||
:direction :output :if-exists :supersede)
|
||||
(osn-os10:write-os10-stream osn stream))))))))
|
||||
Reference in New Issue
Block a user