[Author Prev][Author Next][Thread Prev][Thread Next][Author Index][Thread Index]
gEDA-user: Using the Scheme API: an example!
Hi folks,
Here's a nice example of what can be done with the Scheme API even in its
incomplete state. The attached plugin for gschem improves on gschem's
built-in code for selecting a whole net (double-clicking on a net) by
recognising and following "netname=" attributes. [1]
To run it, check out and install my `guile-scheme-api' branch by following
the instructions in my original e-mail:
http://thread.gmane.org/gmane.comp.cad.geda.user/33328
If you've already done this, you'll need to update it with `git pull' and
recompile/reinstall it.
Download the attached files (`select-whole-net.scm' and
`select-whole-net.sch') and create a gschemrc file with the following
contents:
;; Load select-whole-net plugin
(load "select-whole-net.scm")
Open `select-whole-net.sch' in gschem, and select a single net segment.
Then use the Scheme prompt to run:
(select-whole-selected-net)
I hope this interesting & useful example will inspire you all to using this
stuff to do cool things. ;-)
Peter
[1] Extending this plugin to recognise and handle net= attributes on
symbols is left as an exercise to the reader.
--
Peter Brett <peter@xxxxxxxxxxxxx>
Remote Sensing Research Group
Surrey Space Centre
v 20100214 2
C 40000 40000 0 0 0 title-B.sym
N 43000 49000 45000 49000 4
{
T 43000 49100 5 10 1 1 0 0 1
netname=foo
}
N 45000 49000 45000 47000 4
N 45000 47000 43000 47000 4
N 43000 47000 43000 49000 4
N 45500 49000 47500 49000 4
{
T 45500 49100 5 10 1 1 0 0 1
netname=foo
}
N 47500 49000 47500 47000 4
N 47500 47000 45500 47000 4
N 45500 47000 45500 49000 4
N 48000 49000 50000 49000 4
{
T 48000 49100 5 10 1 1 0 0 1
netname=bar
}
N 50000 49000 50000 47000 4
N 50000 47000 48000 47000 4
N 48000 47000 48000 49000 4
;; Select the whole of a net in gschem
;; Copyright (C) 2010 Peter Brett <peter@xxxxxxxxxxxxx>
;;
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA
;;
(use-modules (ice-9 optargs))
(use-modules (geda object))
(use-modules (geda page))
(use-modules (geda attrib))
(use-modules (gschem window))
(use-modules (gschem selection))
(use-modules (srfi srfi-1))
;; Deselects everything on page
(define (deselect-all! page)
(for-each deselect-object! (page-contents page)))
;; Returns the values of all netname attributes of net
(define (netnames net)
(fold
;; If attrib is a "netname=" attribute, adds it to the front of lst
;; and returns lst. Otherwise, returns lst unmodified.
(lambda (attrib lst)
(let ((name-value (parse-attrib attrib)))
(if (and name-value (string=? "netname" (car name-value)))
(cons (cdr name-value) lst)
lst)))
'() ;; Initial value of lst
(object-attribs net) ;; Iterate over all attributes of net
))
;; Returns #f if net doesn't have a netname= attribute with value
;; equal to name.
(define (netname-match? net name)
(member name (netnames net)))
;; Selects net and all attached attributes.
(define (select-net-segment net)
(for-each select-object! (cons net (object-attribs net))))
;; Recursive function for finding netnames from directly-connected
;; net segments.
(define* (select-adjacent/netnames net #:optional (netname-lst '()))
(if (or (not (net? net)) (object-selected? net))
;; Either this object is not a net, or it's already selected
;; (i.e. we've already visited it). Eitherway, just return
;; the net names we've already found.
netname-lst
;; Otherwise, we need to:
(begin
;; 1. Select the segment (& attributes)
(select-net-segment net)
;; 2. Recurse to find any net names on directly-connected
;; net segments.
(fold select-adjacent/netnames
(append! (netnames net) netname-lst)
(object-connections net)))))
;; Recursive function for finding netnames from name-connected net
;; segments.
(define* (select-remote/netnames
name #:optional (netname-lst '()) (page (active-page)))
(fold
;; If obj is a net with a netname= attribute matching name,
;; recursively adds any related netnames to lst and returns lst.
;; Otherwise, returns lst unmodified.
(lambda (obj lst)
(if (and (net? obj)
(netname-match? obj name))
(select-adjacent/netnames obj lst)
lst))
netname-lst ;; Initial value of lst
(page-contents page) ;; Iterate over full page contents
))
;; Select all net segments connected to net, either directly or via
;; netname= attributes.
(define* (select-whole-net net #:optional (page (active-page)))
;; Start loop by making a list of netnames from directly-connected
;; net segments.
(let loop ((names (select-adjacent/netnames net)))
(if (null? names)
;; No new netnames were found, so we're done!
#t
;; Recurse, with new list of netnames that excludes all the
;; ones we already know about. (lset-difference takes the
;; difference of lists).
(loop (lset-difference equal?
(fold (lambda (x l)
(select-remote/netnames x l page))
'()
names)
names)))))
;; Select all net segments connected to currently-selected net
;; segments. Probably the most useful entry point to this code.
(define (select-whole-selected-net)
(let* ((page (active-page))
(selected-nets (filter! net? (page-selection page))))
(deselect-all! page)
(for-each (lambda (x) (if (net? x) (select-whole-net x)))
selected-nets))
#t)
_______________________________________________
geda-user mailing list
geda-user@xxxxxxxxxxxxxx
http://www.seul.org/cgi-bin/mailman/listinfo/geda-user