Commit 9dbbf937 authored by Dave Cooper's avatar Dave Cooper
Browse files

updated selection in raphael, added optional sew-and-shrink to native reader,...

updated selection in raphael, added optional sew-and-shrink to native reader, changed footer of tasty and added strings-for-display in header of inspector.
parent 1be1ba4a
...@@ -391,7 +391,9 @@ The error was: ~a ...@@ -391,7 +391,9 @@ The error was: ~a
((:div :class "outer-west ui-widget pane") ((:div :class "outer-west ui-widget pane")
((:div :class "header ui-widget-header")"Tree") ((:div :class "header ui-widget-header")"Tree")
((:div :class "ui-widget-content")(str (the tree main-div))) ((:div :class "ui-widget-content"
:style (format nil "background-color: ~a" (or (getf *colors-default* :background) "#fafafa")))
(str (the tree main-div)))
((:div :class "footer ui-widget-header") ((:div :class "footer ui-widget-header")
"Click-mode:" (str (the tree-status-object main-div))) "Click-mode:" (str (the tree-status-object main-div)))
) )
...@@ -404,7 +406,13 @@ The error was: ~a ...@@ -404,7 +406,13 @@ The error was: ~a
((:div :class "footer ui-widget-header") ((:div :class "footer ui-widget-header")
((:span :class "fltrt") ((:span :class "fltrt")
"powered by " ((:a :href "http://www.genworks.com" :target "_new")"Genworks GDL") "powered by " ((:a :href "http://www.genworks.com" :target "_new")"Genworks GDL")
"- empowered by " ((:a :href "http://www.ke-works.com" :target "_new")"KE-works")) (if (glisp:featurep :smlib) ", " " and ")
((:a :href "http://www.quicklisp.org" :target "_new")"Quicklisp")
(if (glisp:featurep :smlib)
(progn
(str ", and ")
(htm ((:a :href "http://www.smlib.com" :target "_new") "SMLib")))
""))
((:span) "GDL status: ") ((:span) "GDL status: ")
((:span :id "gdlStatus")"Done.") ((:span :id "gdlStatus")"Done.")
(when *tasty-developing?* (when *tasty-developing?*
......
...@@ -197,17 +197,18 @@ ...@@ -197,17 +197,18 @@
(:center (:center
((:span :style "font-style: italic; font-weight: bold;") ((:span :style "font-style: italic; font-weight: bold;")
(:p "Inspecting: " (:p "Inspecting: "
(fmt "\"~a\"" (the node strings-for-display))
:br
"root-path: "
(esc (format nil "~s" (esc (format nil "~s"
(cons 'the (reverse (butlast (the node-root-path)))))) (cons 'the (reverse (butlast (the node-root-path))))))
(unless (butlast (the node-root-path)) (unless (butlast (the node-root-path))
(htm " [the root object]"))) (htm " [the root object]"))
(:p " of type: " ((:span :style "color: blue; cursor: pointer;" :br
:onclick (the (gdl-ajax-call :function-key :visit-definition-in-emacs " type: " ((:span :style "color: blue; cursor: pointer;"
:arguments (list (format nil "~s" (the node type))))) :onclick (the (gdl-ajax-call :function-key :visit-definition-in-emacs
:arguments (list (format nil "~s" (the node type))))))
(esc (format nil "~s" (the node type)))))))
)
(esc (format nil "~s" (the node type)))))))
((:table :class "inspector-table" :border 1) ((:table :class "inspector-table" :border 1)
(:tr (:td "Settables") (:td (str (the settables-form control-view)))) (:tr (:td "Settables") (:td (str (the settables-form control-view))))
......
...@@ -537,18 +537,23 @@ overview of <tt>define-object</tt> syntax." ...@@ -537,18 +537,23 @@ overview of <tt>define-object</tt> syntax."
#+nil
(defmethod gdl-rule::%object-keywords% (defmethod gdl-rule::%object-keywords%
((,self-arg ,name)) ((,self-arg ,name))
(remove-duplicates (remove-duplicates
(append ',object-syms ',quantified-object-syms (append ',object-syms ',quantified-object-syms
(when (next-method-p) (call-next-method))))) (when (next-method-p) (call-next-method)))))
#+nil
(defmethod gdl-rule::%hidden-object-keywords% (defmethod gdl-rule::%hidden-object-keywords%
((,self-arg ,name)) ((,self-arg ,name))
(remove-duplicates (remove-duplicates
(append ',hidden-object-syms ',quantified-hidden-object-syms (append ',hidden-object-syms ',quantified-hidden-object-syms
(when (next-method-p) (call-next-method))))) (when (next-method-p) (call-next-method)))))
;;
;; FLAG -- maybe some of these others can go away as well.
;;
(defmethod gdl-rule::%trickle-down-slots% (defmethod gdl-rule::%trickle-down-slots%
((,self-arg ,name)) ((,self-arg ,name))
......
...@@ -96,10 +96,21 @@ parent), followed by an index number if the part is an element of a sequence." ...@@ -96,10 +96,21 @@ parent), followed by an index number if the part is an element of a sequence."
self))) self)))
(%trickle-down-slots% (gdl-rule::%trickle-down-slots% self)) (%trickle-down-slots% (gdl-rule::%trickle-down-slots% self))
(%settable-slots% (gdl-rule::%settable-slots% self)) (%settable-slots% (gdl-rule::%settable-slots% self))
#+nil
(%object-keywords% (mapcar #'make-keyword (gdl-rule::%object-keywords% self))) (%object-keywords% (mapcar #'make-keyword (gdl-rule::%object-keywords% self)))
(%hidden-object-keywords% (mapcar #'make-keyword (gdl-rule::%hidden-object-keywords% self)))
(%object-keywords% (safe-sort (append (the (message-list :category :objects))
(the (message-list :category :quantified-objects)))
#'string-lessp))
;;(%hidden-object-keywords% (mapcar #'make-keyword (gdl-rule::%hidden-object-keywords% self)))
(%hidden-object-keywords% (safe-sort (append (the (message-list :category :hidden-objects))
(the (message-list :category :quantified-hidden-objects)))
#'string-lessp))
("Keyword symbol. The part's simple name, derived from its object specification in the parent or from ("Keyword symbol. The part's simple name, derived from its object specification in the parent or from
the type name if this is the root instance." the type name if this is the root instance."
name-for-display (make-keyword (the %name%))) ;;(gdl-acc::%name% self) name-for-display (make-keyword (the %name%))) ;;(gdl-acc::%name% self)
......
;;;; -*- coding: utf-8 -*- ;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:4bar :description (asdf:defsystem #:4bar :description
"The Gendl™ 4bar Subsystem" :author "John McCarthy" :license "The Gendl™ 4bar Subsystem" :author
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t "Dave Cooper and Genworks International" :license
:version "20130730" :depends-on () "Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
#+asdf-encoding :encoding #+asdf-encoding :utf-8 :serial t :version "20131030" :depends-on (:bus)
:components ((:gdl "source/4bar"))) #-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components ((:gdl "source/4bar") (:gdl "source/bus")))
() (:bus)
\ No newline at end of file \ No newline at end of file
;; ;;
;; Copyright 20012 Genworks International ;; Copyright 2012 Genworks International
;; ;;
;; This source file is part of the General-purpose Declarative ;; This source file is part of the General-purpose Declarative
;; Language project (GDL). ;; Language project (GDL).
...@@ -281,7 +281,24 @@ ...@@ -281,7 +281,24 @@
(when fill (fmt "~a.attr({fill: '~a'});" name fill))) (when fill (fmt "~a.attr({fill: '~a'});" name fill)))
(let ((line-thickness (getf display-controls :line-thickness))) (let ((line-thickness (getf display-controls :line-thickness)))
(when line-thickness (when line-thickness
(fmt "~&~a.attr('stroke-width','~a');" name (number-round line-thickness 4)))) (fmt "~&~a.attr('stroke-width','~a');" name (number-round line-thickness 4)))
(fmt " ~a.node.onmouseover = function (){~a.attr({'stroke-width': '~a'});};"
name name
(floor (to-single-float (* (or line-thickness 1) 3))))
(fmt " ~a.node.onmouseout = function (){~a.attr({'stroke-width': '~a'});};"
name name (to-single-float (or line-thickness 1))))
;;
;; FLAG -- do something better here than ignore-errors
;;
(when (ignore-errors (and (the viewport) (eql (the viewport digitation-mode) :select-object)))
(fmt "~a.node.onclick = function (event) {~a};" name
(the viewport (gdl-ajax-call :function-key :set-object-to-inspect!
:arguments (list object)))))
(write-the (drag-controls :name name :display-controls display-controls)) (write-the (drag-controls :name name :display-controls display-controls))
......
...@@ -38,13 +38,16 @@ curves, surfaces, breps, and brep trees as sequences of GDL objects. ...@@ -38,13 +38,16 @@ curves, surfaces, breps, and brep trees as sequences of GDL objects.
("String. Contains output from a call to (with-format (native ...) (write-the cad-output)) ("String. Contains output from a call to (with-format (native ...) (write-the cad-output))
for an SMLib object (e.g. curve, surface, brep). Defaults to nil. If you specify this as well as a for an SMLib object (e.g. curve, surface, brep). Defaults to nil. If you specify this as well as a
file-name, the file-name will take precedence." file-name, the file-name will take precedence."
smlib-string nil)) smlib-string nil)
(sew-and-shrink-breps? nil))
:computed-slots :computed-slots
((data (read-native-file *geometry-kernel* ((data (read-native-file *geometry-kernel*
(format nil "~a" (format nil "~a"
(translate-logical-pathname (the file-name))))) (translate-logical-pathname (the file-name)))
:sew-and-shrink-breps? (the sew-and-shrink-breps?)))
(breps-list (list-elements (the breps))) (breps-list (list-elements (the breps)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment