[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
gEDA-cvs: CVS update: auto-place-attribs.scm
User: pcjc2
Date: 07/04/17 12:18:56
Modified: . Tag: noscreen auto-place-attribs.scm
Log:
Sync with trunk
Revision Changes Path
No revision
No revision
1.4.2.3 +52 -19 eda/geda/gaf/gschem/scheme/auto-place-attribs.scm
(In the diff below, changes in quantity of whitespace are not shown.)
Index: auto-place-attribs.scm
===================================================================
RCS file: /home/cvspsrv/cvsroot/eda/geda/gaf/gschem/scheme/auto-place-attribs.scm,v
retrieving revision 1.4.2.2
retrieving revision 1.4.2.3
diff -u -b -r1.4.2.2 -r1.4.2.3
--- auto-place-attribs.scm 6 Apr 2007 17:29:13 -0000 1.4.2.2
+++ auto-place-attribs.scm 17 Apr 2007 16:18:55 -0000 1.4.2.3
@@ -72,6 +72,42 @@
">"
"<"))))))
+; This function returns the net direction of the net object parameter.
+; It returns a string :
+; "^v": vertical net
+; "<>": horizontal net
+(define get-net-connection-sides
+ (lambda (object)
+ (let ( (bounds (get-object-bounds object (list "all") (list)))
+ )
+ (begin
+ (if (or (char=? (get-object-type object) OBJ_NET)
+ (char=? (get-object-type object) OBJ_BUS))
+ (let ( ; Get the net bounds without the attribute
+ (min-x (get-point-of-bound "min-x" bounds))
+ (max-x (get-point-of-bound "max-x" bounds))
+ (min-y (get-point-of-bound "min-y" bounds))
+ (max-y (get-point-of-bound "max-y" bounds))
+ )
+ (if (eq? min-x max-x)
+ ; If the x bounds are the same, this is a vertical segment.
+ "^v"
+ (if (eq? min-y max-y)
+ ; If the y bounds are, this is a horizontal segment.
+ "<>"
+ ; X or Y bounds are not the same. We don't know.
+ ""
+ )
+ )
+ )
+ ; This is not a OBJ_NET object. Return an empty list.
+ (list)
+ )
+ )
+ )
+ )
+ )
+
; This function returns a list with the end coordinate of the pins,
; if they are in the desired side.
; - desired_side: is a one character string: "^", "v", "<" or ">".
@@ -406,19 +442,15 @@
; one grid spacing to the offset.
(if (eq? x_offset 0)
(if (string-index move-direction #\<)
- (set! y_offset (- 0
+ (set! x_offset (- 0
autoplace-attributes-grid))
- (set! y_offset
+ (set! x_offset
autoplace-attributes-grid))
)
; Snap the offset to the grid.
(set! x_offset (snap-coord-to-grid x_offset))
- ; Loop again from the beginning
- (set! pin-directions-list-index -1)
- (set! pass 2)
-
; Set the new attrib bounds.
(set! new-attrib-bounds-adjusted
(cons (cons (+ (get-point-of-bound
@@ -477,10 +509,6 @@
(set! y_offset
(snap-coord-to-grid y_offset))
- ; Loop again from the beginning
- (set! pin-directions-list-index -1)
- (set! pass 2)
-
; Set the new attrib bounds.
(set! new-attrib-bounds-adjusted
(cons
@@ -544,7 +572,7 @@
(horiz-pos (if (string=? horiz-string "Left")
(min (car horiz-bounds) (cdr horiz-bounds))
(if (string=? horiz-string "Middle")
- (inexact->exact (/ (+ (car horiz-bounds)
+ (ceiling (/ (+ (car horiz-bounds)
(cdr horiz-bounds)) 2))
(if (string=? horiz-string "Right")
(max (car horiz-bounds) (cdr horiz-bounds))
@@ -554,7 +582,7 @@
(vertical-pos (if (string=? vertical-string "Lower")
(min (car vertical-bounds) (cdr vertical-bounds))
(if (string=? vertical-string "Middle")
- (inexact->exact (/ (+ (car vertical-bounds)
+ (ceiling (/ (+ (car vertical-bounds)
(cdr vertical-bounds)) 2))
(if (string=? vertical-string "Upper")
(max (car vertical-bounds)
@@ -742,7 +770,12 @@
(define (autoplace-object-attributes object)
(let* ((pin-list (get-object-pins object))
(pin-directions (get-pin-directions pin-list))
- (connection-sides (get-connection-sides pin-directions))
+ (connection-sides (if (or (char=? (get-object-type object)
+ OBJ_NET)
+ (char=? (get-object-type object)
+ OBJ_BUS))
+ (get-net-connection-sides object)
+ (get-connection-sides pin-directions)))
(attribute-list (get-object-attributes object)) )
(autoplace-text object connection-sides attribute-list)))
_______________________________________________
geda-cvs mailing list
geda-cvs@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-cvs