gnetlist/scheme/gnet-pcbpins.scm

   1 ;;; gEDA - GPL Electronic Design Automation
   2 ;;; gnetlist - gEDA Netlist
   3 ;;; Backend for propagating pin names from gschem to footprints in pcb
   4 ;;; Copyright (C) 2005-2010 Dan McMahill
   5 ;;;
   6 ;;; This program is free software; you can redistribute it and/or modify
   7 ;;; it under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 2 of the License, or
   9 ;;; (at your option) any later version.
  10 ;;;
  11 ;;; This program is distributed in the hope that it will be useful,
  12 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with this program; if not, write to the Free Software
  18 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19
  20
  21 (use-modules (ice-9 regex))
  22
  23 ;; A comma or close parenthesis will cause problems with the pcb
  24 ;; action script, so if one of the arguments to ChangePinName contains
  25 ;; one it should be quoted.  Any quote characters within the argument
  26 ;; are escaped.
  27 ;;
  28 ;; At present, this function only quotes if there is a comma or close
  29 ;; parenthesis present in the string.
  30 (define pcbpins:quote_string
  31   (lambda (s)
  32     (if (string-match "[,)]" s)
  33         (string-join (list "\""
  34                            (regexp-substitute/global #f "\"" s 'pre "\\\"" 'post)
  35                            "\"")
  36                      "")
  37         s)))
  38
  39 ;; write out the pins for a particular component
  40 (define pcbpins:component_pins
  41   (lambda (port package pins)
  42     (if (and (not (null? package)) (not (null? pins)))
  43         (begin
  44           (let (
  45                 (pin (car pins))
  46                 (label #f)
  47                 (pinnum #f)
  48                 )
  49             (display "ChangePinName(" port)
  50             (display (pcbpins:quote_string package) port)
  51             (display ", " port)
  52
  53             (set! pinnum (gnetlist:get-attribute-by-pinnumber package pin "pinnumber"))
  54
  55             (display (pcbpins:quote_string pinnum) port)
  56             (display ", " port)
  57
  58             (set! label (gnetlist:get-attribute-by-pinnumber package pin "pinlabel"))
  59             (if (string=? label "unknown")
  60                 (set! label pinnum)
  61                 )
  62             (display (pcbpins:quote_string label) port)
  63             (display ")\n" port)
  64             )
  65           (pcbpins:component_pins port package (cdr pins))
  66           )
  67         )
  68     )
  69   )
  70
  71
  72 ;; write out the components
  73 (define pcbpins:components
  74    (lambda (port packages symcnt)
  75       (if (not (null? packages))
  76          (begin
  77            (let ((package (car packages)))
  78
  79              ;;
  80              (display "\n# Start of element " port)
  81              (display package port)
  82              (newline port)
  83
  84              ;; write the pins
  85              (pcbpins:component_pins port package (gnetlist:get-pins package))
  86              )
  87            (pcbpins:components port (cdr packages) (+ symcnt 1))
  88            )
  89          )
  90       )
  91    )
  92
  93 ;; The top level netlister for pcbpins
  94 (define pcbpins
  95   (lambda (filename)
  96     (let ((port (open-output-file filename)))
  97
  98       ;; write the header
  99       (display "# Pin name action command file\n" port)
 100
 101       ;; write the components
 102       (pcbpins:components port packages 1)
 103
 104       ;; close netlist
 105       (close-output-port port)
 106       )
 107     )
 108   )
 109