gnetlist/scheme/gnet-partslist1.scm

   1 ; Copyright (C) 2001 MIYAMOTO Takanori
   2 ; gnet-partslist1.scm
   3 ;
   4 ; This program is free software; you can redistribute it and/or modify
   5 ; it under the terms of the GNU General Public License as published by
   6 ; the Free Software Foundation; either version 2 of the License, or
   7 ; (at your option) any later version.
   8 ;
   9 ; This program is distributed in the hope that it will be useful,
  10 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ; GNU General Public License for more details.
  13 ;
  14 ; You should have received a copy of the GNU General Public License
  15 ; along with this program; if not, write to the Free Software
  16 ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111 USA
  17
  18 ; The /'s may not work on win32
  19 (load (string-append gedadata "/scheme/gnet-partslist-common.scm"))
  20
  21 (define partslist1:write-top-header
  22   (lambda (port)
  23     (display ".START\n" port)
  24     (display "..refdes\tdevice\tvalue\tfootprint\tquantity\n" port)))
  25
  26 (define (partslist1:write-partslist ls port)
  27   (if (null? ls)
  28       '()
  29       (begin (write-one-row (append (car ls) (list 1)) "\t" "\n" port)
  30              (partslist1:write-partslist (cdr ls) port))))
  31
  32 (define partslist1:write-bottom-footer
  33   (lambda (port)
  34     (display ".END" port)
  35     (newline port)))
  36
  37 (define partslist1
  38   (lambda (output-filename)
  39     (let ((port (open-output-file output-filename))
  40           (parts-table (marge-sort-with-multikey (get-parts-table packages) '(0 1 2 3))))
  41       (partslist1:write-top-header port)
  42       (partslist1:write-partslist parts-table port)
  43       (partslist1:write-bottom-footer port)
  44       (close-output-port port))))