gnetlist/scheme/gnet-gsch2pcb.scm.in

   1 ;;; -*-scheme-*-
   2 ;;;
   3
   4 ;;; gEDA - GPL Electronic Design Automation
   5 ;;; gnetlist - gEDA Netlist
   6 ;;; Copyright (C) 1998-2010 Ales Hvezda
   7 ;;;
   8 ;;; This program is free software; you can redistribute it and/or modify
   9 ;;; it under the terms of the GNU General Public License as published by
  10 ;;; the Free Software Foundation; either version 2 of the License, or
  11 ;;; (at your option) any later version.
  12 ;;;
  13 ;;; This program is distributed in the hope that it will be useful,
  14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;;; GNU General Public License for more details.
  17 ;;;
  18 ;;; You should have received a copy of the GNU General Public License
  19 ;;; along with this program; if not, write to the Free Software
  20 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  21
  22 ;;  gsch2pcb format  (based on PCBboard format by JM Routoure & Stefan Petersen)
  23 ;;  Bill Wilson    billw@wt.net
  24 ;;  6/17/2003
  25
  26
  27 ;;
  28 ;;
  29 (define gsch2pcb:write-top-header
  30   (lambda (port)
  31     (display "# release: pcb 1.99x\n" port)
  32     (display "# To read pcb files, the pcb version (or the" port)
  33     (display " cvs source date) must be >= the file version\n" port)
  34     (display "FileVersion[20070407]\n" port)
  35     (display "PCB[\"\" 600000 500000]\n" port)
  36     (display "Grid[10000.000000 0 0 0]\n" port)
  37     (display "Cursor[0 0 0.000000]\n" port)
  38     (display "PolyArea[200000000.000000]\n" port)
  39     (display "Thermal[0.500000]\n" port)
  40     (display "DRC[1000 1000 1000 1000 1500 1000]\n" port)
  41     (display "Flags(\"nameonpcb,uniquename,clearnew,snappin\")\n" port)
  42     (display "Groups(\"1,c:2,s:3:4:5:6:7:8\")\n" port)
  43     (display "Styles[\"Signal,1000,3600,2000,1000:" port)
  44     (display "Power,2500,6000,3500,1000:" port)
  45     (display "Fat,4000,6000,3500,1000:" port)
  46     (display "Skinny,600,2402,1181,600\"]\n" port)
  47 ))
  48
  49 ;;
  50 ;;
  51 (define gsch2pcb:write-bottom-footer
  52   (lambda (port)
  53     (display "Layer(1 \"component\")\n(\n)\n" port)
  54     (display "Layer(2 \"solder\")\n(\n)\n" port)
  55     (display "Layer(3 \"outline\")\n(\n)\n" port)
  56     (display "Layer(4 \"GND\")\n(\n)\n" port)
  57     (display "Layer(5 \"power\")\n(\n)\n" port)
  58     (display "Layer(6 \"signal1\")\n(\n)\n" port)
  59     (display "Layer(7 \"signal2\")\n(\n)\n" port)
  60     (display "Layer(8 \"signal3\")\n(\n)\n" port)
  61     (display "Layer(9 \"silk\")\n(\n)\n" port)
  62     (display "Layer(10 \"silk\")\n(\n)" port)
  63     (newline port)))
  64
  65 ;;
  66 ;;
  67
  68 ;; Split string at current split-char and returns
  69 ;; a pair with substrings. If string is not splitable
  70 ;; it returns #f.
  71 (define (gsch2pcb:string-split the-string split-char)
  72 ;;string-index is Guile specific
  73   (let ((split-index (string-index the-string split-char))
  74         (last-index (- (string-length the-string) 1)))
  75 ;;Check if split-char happens to be in the beginning or end of the string
  76     (cond ((not split-index)
  77            #f)
  78           ((= split-index 0)
  79            (gsch2pcb:string-split
  80             (substring the-string 1 (string-length the-string))
  81             split-char))
  82           ((= split-index last-index)
  83            #f)
  84           (split-index
  85            (cons (substring the-string 0 split-index)
  86                  (substring the-string (+ split-index 1)
  87                             (string-length the-string))))
  88           (else
  89            #f))))
  90
  91 ;; Splits a string with space separated words and returns a list
  92 ;; of the words (still as strings).
  93 (define (gsch2pcb:split-to-list the-string)
  94   (let ((the-list (gsch2pcb:string-split the-string #\space)))
  95     (if the-list
  96         (cons (car the-list) (gsch2pcb:split-to-list (cdr the-list)))
  97         (list the-string))))
  98
  99 ;; Joins the elements of a list of strings into a single string,
 100 ;; with each element prefixed by a given prefix string.
 101 (define (gsch2pcb:list-join-with-prefixes the-list prefix)
 102   (if (null? the-list)
 103       ""
 104       (string-append prefix (car the-list)
 105                      (gsch2pcb:list-join-with-prefixes (cdr the-list) prefix))))
 106
 107
 108 (define gsch2pcb:write-value-footprint
 109   (lambda (pipe ls)
 110     (if (not (null? ls))
 111 ;;       refdes contains the first element of ls
 112         (let* ((refdes (car ls))
 113                (value (gnetlist:get-package-attribute refdes "value"))
 114                (footprint (gsch2pcb:split-to-list
 115                           (gnetlist:get-package-attribute refdes  "footprint") ) )
 116                (lquote (if gsch2pcb:use-m4 "`" ""))
 117                (rquote (if gsch2pcb:use-m4 "'" ""))
 118
 119                )
 120
 121                (display (string-append "PKG_" (car footprint)) pipe)
 122                (display (string-append "(" lquote (car footprint)) pipe)
 123                (display (gsch2pcb:list-join-with-prefixes (cdr footprint) "-") pipe)
 124                (display (string-append rquote "," lquote refdes rquote "," lquote ) pipe)
 125
 126                (display value pipe)
 127                (display (gsch2pcb:list-join-with-prefixes (cdr footprint) (string-append rquote "," lquote)) pipe)
 128                (display (string-append rquote ")") pipe)
 129                (newline pipe)
 130                (gsch2pcb:write-value-footprint pipe (cdr ls))) )))
 131
 132 ;;
 133 ;;
 134
 135 (define gsch2pcb:use-m4 #f)
 136
 137
 138 ;; Let the user override the m4 command, the directory
 139 ;; where pcb stores its m4 files and the pcb config directory.
 140 (if (not (defined? 'gsch2pcb:pcb-m4-command)) (define gsch2pcb:pcb-m4-command "@m4@"))
 141 (if (not (defined? 'gsch2pcb:pcb-m4-dir)) (define gsch2pcb:pcb-m4-dir "@pcbm4dir@"))
 142 (if (not (defined? 'gsch2pcb:pcb-m4-confdir)) (define gsch2pcb:pcb-m4-confdir "@pcbconfdir@"))
 143
 144 ;; Let the user override the m4 search path
 145 (if (not (defined? 'gsch2pcb:pcb-m4-path))
 146     (define gsch2pcb:pcb-m4-path (list gsch2pcb:pcb-m4-dir gsch2pcb:pcb-m4-confdir "$HOME/.pcb" "."))
 147 )
 148
 149 ;; Build up the m4 command line
 150
 151 (define gsch2pcb:m4-command-line-tmp (string-append
 152                                   gsch2pcb:pcb-m4-command " -d ") )
 153 (define gsch2pcb:pcb-m4-path-str #f)
 154 (for-each (lambda (d)
 155             (set! gsch2pcb:m4-command-line-tmp (string-append
 156                                                 gsch2pcb:m4-command-line-tmp
 157                                                 " -I" d))
 158             (if gsch2pcb:pcb-m4-path-str
 159                 (set! gsch2pcb:pcb-m4-path-str (string-append
 160                                                 gsch2pcb:pcb-m4-path-str
 161                                                 "  " d) )
 162                 (set! gsch2pcb:pcb-m4-path-str d)
 163                 )
 164             )
 165           gsch2pcb:pcb-m4-path
 166           )
 167
 168
 169
 170 (set! gsch2pcb:m4-command-line-tmp
 171       ( string-append gsch2pcb:m4-command-line-tmp
 172                       " " gsch2pcb:pcb-m4-dir "/common.m4 - >> "
 173                       )
 174       )
 175
 176 (if (not (defined? 'gsch2pcb:pcb-m4-command-line))
 177     (define gsch2pcb:pcb-m4-command-line
 178       gsch2pcb:m4-command-line-tmp)
 179     )
 180
 181 (use-modules (ice-9 popen))
 182
 183 (define (gsch2pcb output-filename)
 184   (let ((port (open-output-file output-filename)))
 185     (gsch2pcb:write-top-header port)
 186     (close-port port)
 187     )
 188
 189   (set! gsch2pcb:pcb-m4-command-line (string-append
 190                                   gsch2pcb:pcb-m4-command-line
 191                                   output-filename))
 192   (display (string-append
 193             "=====================================================\n"
 194             "gsch2pcb backend configuration:\n"
 195             "\n"
 196             "   ----------------------------------------\n"
 197             "   Variables which may be changed in gafrc:\n"
 198             "   ----------------------------------------\n"
 199             "   gsch2pcb:pcb-m4-command:    " gsch2pcb:pcb-m4-command "\n"
 200             "   gsch2pcb:pcb-m4-dir:        " gsch2pcb:pcb-m4-dir "\n"
 201             "   gsch2pcb:pcb-m4-confdir:    " gsch2pcb:pcb-m4-confdir "\n"
 202             "   gsch2pcb:pcb-m4-path:       " gsch2pcb:pcb-m4-path-str "\n"
 203             "   gsch2pcb:m4-command-line:   " gsch2pcb:pcb-m4-command-line  "\n"
 204             "\n"
 205             "   ---------------------------------------------------\n"
 206             "   Variables which may be changed in the project file:\n"
 207             "   ---------------------------------------------------\n"
 208             "   gsch2pcb:use-m4:            " (if gsch2pcb:use-m4 "yes" "no") "\n"
 209             "\n"
 210             "=====================================================\n"
 211             )
 212            )
 213
 214   ;; If we have defined gsch2pcb:use-m4 then run the footprints
 215   ;; through the pcb m4 setup.  Otherwise skip m4 entirely
 216   (if gsch2pcb:use-m4
 217       ;; pipe with the macro define in pcb program
 218       (let ((pipe (open-output-pipe gsch2pcb:pcb-m4-command-line))
 219             )
 220
 221         (display "Using the m4 processor for pcb footprints\n")
 222         ;; packages is a list with the different refdes value
 223         (gsch2pcb:write-value-footprint pipe packages)
 224         (close-pipe pipe)
 225         )
 226
 227       (let ((port  (open output-filename (logior O_WRONLY O_APPEND))))
 228         (display "Skipping the m4 processor for pcb footprints\n")
 229         (gsch2pcb:write-value-footprint port packages)
 230         (close-port port)
 231         )
 232       )
 233
 234   (let ((port (open output-filename (logior O_WRONLY O_APPEND))))
 235     (gsch2pcb:write-bottom-footer port)
 236     close-port port)
 237   )
 238