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
((:div :class "outer-west ui-widget pane")
((: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")
"Click-mode:" (str (the tree-status-object main-div)))
)
......@@ -404,7 +406,13 @@ The error was: ~a
((:div :class "footer ui-widget-header")
((:span :class "fltrt")
"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 :id "gdlStatus")"Done.")
(when *tasty-developing?*
......
......@@ -197,16 +197,17 @@
(:center
((:span :style "font-style: italic; font-weight: bold;")
(:p "Inspecting: "
(fmt "\"~a\"" (the node strings-for-display))
:br
"root-path: "
(esc (format nil "~s"
(cons 'the (reverse (butlast (the node-root-path))))))
(unless (butlast (the node-root-path))
(htm " [the root object]")))
(:p " of type: " ((:span :style "color: blue; cursor: pointer;"
(htm " [the root object]"))
:br
" type: " ((:span :style "color: blue; cursor: pointer;"
:onclick (the (gdl-ajax-call :function-key :visit-definition-in-emacs
:arguments (list (format nil "~s" (the node type)))))
)
:arguments (list (format nil "~s" (the node type))))))
(esc (format nil "~s" (the node type)))))))
((:table :class "inspector-table" :border 1)
......
......@@ -537,18 +537,23 @@ overview of <tt>define-object</tt> syntax."
#+nil
(defmethod gdl-rule::%object-keywords%
((,self-arg ,name))
(remove-duplicates
(append ',object-syms ',quantified-object-syms
(when (next-method-p) (call-next-method)))))
#+nil
(defmethod gdl-rule::%hidden-object-keywords%
((,self-arg ,name))
(remove-duplicates
(append ',hidden-object-syms ',quantified-hidden-object-syms
(when (next-method-p) (call-next-method)))))
;;
;; FLAG -- maybe some of these others can go away as well.
;;
(defmethod gdl-rule::%trickle-down-slots%
((,self-arg ,name))
......
......@@ -96,9 +96,20 @@ parent), followed by an index number if the part is an element of a sequence."
self)))
(%trickle-down-slots% (gdl-rule::%trickle-down-slots% self))
(%settable-slots% (gdl-rule::%settable-slots% self))
#+nil
(%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
the type name if this is the root instance."
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:4bar :description
"The Gendl™ 4bar Subsystem" :author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20130730" :depends-on ()
#+asdf-encoding :encoding #+asdf-encoding :utf-8
:components ((:gdl "source/4bar")))
"The Gendl™ 4bar Subsystem" :author
"Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20131030" :depends-on (:bus)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components ((:gdl "source/4bar") (:gdl "source/bus")))
()
\ No newline at end of file
(:bus)
\ No newline at end of file
;;
;; Copyright 20012 Genworks International
;; Copyright 2012 Genworks International
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
......@@ -281,7 +281,24 @@
(when fill (fmt "~a.attr({fill: '~a'});" name fill)))
(let ((line-thickness (getf display-controls :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))
......
......@@ -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))
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."
smlib-string nil))
smlib-string nil)
(sew-and-shrink-breps? nil))
:computed-slots
((data (read-native-file *geometry-kernel*
(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)))
......
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