Commit ce18c1be authored by Dave Cooper's avatar Dave Cooper

added some line-arc constraints.

parent d4b63fb3
Pipeline #1304 failed with stages
in 2 seconds
......@@ -85,6 +85,8 @@
;; http://emacswiki.org/emacs/AutoIndentation).
;;
;;(global-set-key (kbd "C-m") 'newline-and-indent)
)
(gdl:global-keys)
......@@ -422,8 +424,8 @@
"make option key behave as meta"
(setq mac-option-modifier 'meta))
(when (eql system-type 'darwin)
(mac-switch-meta))
;;(when (eql system-type 'darwin)
;; (mac-switch-meta))
......
......@@ -296,25 +296,34 @@
(first-tangent-index (position :tangent-to (plist-keys (the arc-constraints))))
(second-tangent-index (position :tangent-to (plist-keys (the arc-constraints)) :from-end t))
(constraint-type
(cond ((let ((first-tangent (getf (the arc-constraints) :tangent-to))
(second-tangent (getf (reverse-plist (the arc-constraints)) :tangent-to))
(radius (getf (the arc-constraints) :radius)))
(or
(and (eql (first first-tangent) :arc-geometry)
(eql (first second-tangent) :line-geometry) radius)
(and (eql (first first-tangent) :line-geometry)
(eql (first second-tangent) :arc-geometry) radius)))
:tangent-arc-tangent-line-radius)
((let ((keys (plist-keys (the arc-constraints))))
(and (= (length keys) 3) (= (count :through-point keys) 2) (= (count :tangent-to keys) 1)))
:tangent-to-through-two-points)
(constraint-type
(let ((constraints (the arc-constraints)))
(cond ((let ((first-tangent (getf (the arc-constraints) :tangent-to))
(second-tangent (getf (reverse-plist (the arc-constraints)) :tangent-to))
(radius (getf (the arc-constraints) :radius)))
(or
(and (eql (first first-tangent) :arc-geometry)
(eql (first second-tangent) :line-geometry) radius)
(and (eql (first first-tangent) :line-geometry)
(eql (first second-tangent) :arc-geometry) radius)))
:tangent-arc-tangent-line-radius)
((and (getf plist :tangent-to)(getf plist :center-on)(getf plist :through-point) (getf plist :select-side))
:tangent-to--center-on--through-point--select-side)
((let ((keys (plist-keys (the arc-constraints))))
(and (= (length keys) 3) (= (count :through-point keys) 2) (= (count :tangent-to keys) 1)))
:tangent-to-through-two-points)
((equalp (plist-keys (the arc-constraints)) '(:through-point :through-point :through-point))
:through-three-points)
((equalp (plist-keys (the arc-constraints)) '(:through-point :through-point :through-point))
:through-three-points)
(t (error "Constrained-arc --- constraint configuration is not yet supported")))))
((and (getf constraints :center) (getf constraints :radius) (getf constraints :plane-normal))
:center-radius-plane-normal)
(t (error "Constrained-arc --- constraint configuration is not yet supported"))))))
:hidden-objects
((constraint-object :type (ecase (the constraint-type)
......@@ -323,7 +332,11 @@
(:through-three-points
'arc-constraints-through-three-points)
(:tangent-to-through-two-points
'arc-constraint-tangent-to-through-two-points))
'arc-constraint-tangent-to-through-two-points)
(:center-radius-plane-normal
'arc-constraint-center-radius-plane-normal)
(:tangent-to--center-on--through-point--select-side
'arc-constraint-tangent-to--center-on--through-point--select-side))
:pass-down (first-tangent-index)
:constraints (the arc-constraints)))
......@@ -351,6 +364,28 @@ and it automatically trims the result to each point of tangency")
(end-angle (max (the angle-0) (the angle-1)))))
(define-object constrained-arc-base-mixin (base-object)
:input-slots (constraints center radius))
(define-object arc-constraint-tangent-to--center-on--through-point--select-side (constrained-arc-base-mixin)
)
(define-object arc-constraint-center-radius-plane-normal (constrained-arc-base-mixin)
:computed-slots ((center (getf (the constraints) :center))
(radius (getf (the constraints) :radius))
(orientation (alignment :top (getf (the constraints) :plane-normal)))))
(define-object arc-constraint-tangent-to-through-two-points (base-object)
:input-slots (constraints first-tangent-index) ;; first-tangent-index is ignored for this case.
......
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