gnetlist/scheme/gnet-gsch2pcb.scm.in

   1 ;;; -*-scheme-*-
   2 ;;; $Id$
   3 ;;;
   4
   5 ;;; gEDA - GNU Electronic Design Automation
   6 ;;; gnetlist - GNU Netlist
   7 ;;; Copyright (C) 1998-2000 Ales V. Hvezda
   8 ;;;
   9 ;;; This program is free software; you can redistribute it and/or modify
  10 ;;; it under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 2 of the License, or
  12 ;;; (at your option) any later version.
  13 ;;;
  14 ;;; This program is distributed in the hope that it will be useful,
  15 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with this program; if not, write to the Free Software
  21 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22
  23 ;;  gsch2pcb format  (based on PCBboard format by JM Routoure & Stefan Petersen)
  24 ;;  Bill Wilson    billw@wt.net
  25 ;;  6/17/2003
  26
  27
  28 ;;
  29 ;;
  30 (define gsch2pcb:write-top-header
  31   (lambda (port)
  32     (display "# release: pcb 1.6.3\n" port)
  33     (display "PCB(\"\" 6000 5000)\n" port)
  34     (display "Grid(10 0 0)\n" port)
  35     (display "Cursor(0 0 3)\n" port)
  36     (display "Flags(0x000000d0)\n" port)
  37     (display "Groups(\"1,2,3,s:4,5,6,c:7:8:\")\n" port)
  38     (display "Styles(\"Signal,10,40,20:Power,25,60,35:Fat,40,60,35:Skinny,8,36,20\")\n" port)))
  39
  40
  41 ;;
  42 ;;
  43 (define gsch2pcb:write-bottom-footer
  44   (lambda (port)
  45     (display "Layer(1 \"solder\")\n(\n)\n" port)
  46     (display "Layer(2 \"GND-sldr\")\n(\n)\n" port)
  47     (display "Layer(3 \"Vcc-sldr\")\n(\n)\n" port)
  48     (display "Layer(4 \"component\")\n(\n)\n" port)
  49     (display "Layer(5 \"GND-comp\")\n(\n)\n" port)
  50     (display "Layer(6 \"Vcc-comp\")\n(\n)\n" port)
  51     (display "Layer(7 \"unused\")\n(\n)\n" port)
  52     (display "Layer(8 \"unused\")\n(\n)" port)
  53     (newline port)))
  54
  55 ;;
  56 ;;
  57
  58 ;; Split string at current split-char and returns
  59 ;; a pair with substrings. If string is not splitable
  60 ;; it returns #f.
  61 (define (string-split the-string split-char)
  62 ;;string-index is Guile specific
  63   (let ((split-index (string-index the-string split-char))
  64         (last-index (- (string-length the-string) 1)))
  65 ;;Check if split-char happens to be in the beginning or end of the string
  66     (cond ((not split-index)
  67            #f)
  68           ((= split-index 0)
  69            (string-split
  70             (substring the-string 1 (string-length the-string))
  71             split-char))
  72           ((= split-index last-index)
  73            #f)
  74           (split-index
  75            (cons (substring the-string 0 split-index)
  76                  (substring the-string (+ split-index 1)
  77                             (string-length the-string))))
  78           (else
  79            #f))))
  80
  81 ;; Splits a string with space separated words and returns a list
  82 ;; of the words (still as strings).
  83 (define (split-to-list the-string)
  84   (let ((the-list (string-split the-string #\space)))
  85     (if the-list
  86         (cons (car the-list) (split-to-list (cdr the-list)))
  87         (list the-string))))
  88
  89 ;; Joins the elements of a list of strings into a single string,
  90 ;; with each element prefixed by a given prefix string.
  91 (define (list-join-with-prefixes the-list prefix)
  92   (if (null? the-list)
  93       ""
  94       (string-append prefix (car the-list)
  95                      (list-join-with-prefixes (cdr the-list) prefix))))
  96
  97
  98 (define gsch2pcb:write-value-footprint
  99   (lambda (pipe ls)
 100     (if (not (null? ls))
 101 ;;       refdes contains the first element of ls
 102         (let* ((refdes (car ls))
 103                (value (gnetlist:get-package-attribute refdes "value"))
 104                (footprint (split-to-list
 105                           (gnetlist:get-package-attribute refdes  "footprint") ) )
 106                (lquote (if gsch2pcb:use-m4 "`" ""))
 107                (rquote (if gsch2pcb:use-m4 "'" ""))
 108
 109                )
 110
 111                (display (string-append "PKG_" (car footprint)) pipe)
 112                (display (string-append "(" lquote (car footprint)) pipe)
 113                (display (list-join-with-prefixes (cdr footprint) "-") pipe)
 114                (display (string-append rquote "," lquote refdes rquote "," lquote ) pipe)
 115
 116                (display value pipe)
 117                (display (list-join-with-prefixes (cdr footprint) (string-append rquote "," lquote)) pipe)
 118                (display (string-append rquote ")") pipe)
 119                (newline pipe)
 120                (gsch2pcb:write-value-footprint pipe (cdr ls))) )))
 121
 122 ;;
 123 ;;
 124
 125 (define m4-command "@m4@")
 126 (define m4-pcbdir "@pcbm4dir@")
 127 (define m4-pcbconfdir "@pcbconfdir@")
 128 (define m4-files "")
 129 (define gsch2pcb:use-m4 #f)
 130
 131 ;; To emulate popen. Guileish again.
 132 ; Needed after guile ver. 1.3.2. To save 1.3a users, wrap it in.
 133 ; Doesn't work in guile 1.6 (false-if-exception (use-modules (ice-9 popen)))
 134 (use-modules (ice-9 popen))
 135
 136 (define (gsch2pcb output-filename)
 137   (let ((port (open-output-file output-filename)))
 138     (gsch2pcb:write-top-header port)
 139     (close-port port)
 140     )
 141
 142   ;; If we have defined gsch2pcb:use-m4 then run the footprints
 143   ;; through the pcb m4 setup.  Otherwise skip m4 entirely
 144  (if gsch2pcb:use-m4
 145       ;; pipe with the macro define in pcb program
 146       (let ((pipe (open-output-pipe (string-append
 147                                      m4-command " -d -I. -I" m4-pcbdir " "
 148                                      " -I " m4-pcbconfdir " -I$HOME/.pcb -I. "
 149                                      m4-pcbdir "/common.m4 " m4-files " - >> "
 150                                      output-filename)))
 151             )
 152
 153         (display "Using the m4 processor for pcb footprints\n")
 154         ;; packages is a list with the different refdes value
 155         (gsch2pcb:write-value-footprint pipe packages)
 156         (close-pipe pipe)
 157         )
 158
 159       (let ((port  (open output-filename (logior O_WRONLY O_APPEND))))
 160         (display "Skipping the m4 processor for pcb footprints\n")
 161         (gsch2pcb:write-value-footprint port packages)
 162         (close-port port)
 163         )
 164       )
 165
 166   (let ((port (open output-filename (logior O_WRONLY O_APPEND))))
 167     (gsch2pcb:write-bottom-footer port)
 168     close-port port)
 169   )
 170