gnetlist-legacy/scheme/gnet-partslist2.scm

   1 ; Copyright (C) 2001-2010 MIYAMOTO Takanori
   2 ; gnet-partslist2.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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  17
  18 (load-from-path "partslist-common.scm")
  19
  20 (define (partslist2:write-top-header)
  21   (display ".START\n")
  22   (display "..refdes\tdevice\tvalue\tfootprint\tquantity\n"))
  23
  24 (define (partslist2:write-partslist ls)
  25   (if (null? ls)
  26       '()
  27       (begin (write-one-row (append (car ls) (list 1)) "\t" "\n")
  28              (partslist2:write-partslist (cdr ls)))))
  29
  30 (define (partslist2:write-bottom-footer)
  31   (display ".END")
  32   (newline))
  33
  34 (define (partslist2 output-filename)
  35   (set-current-output-port (gnetlist:output-port output-filename))
  36   (let ((parts-table (marge-sort-with-multikey (get-parts-table packages) '(1 2 3 0))))
  37     (partslist2:write-top-header)
  38     (partslist2:write-partslist parts-table)
  39     (partslist2:write-bottom-footer))
  40   (close-output-port (current-output-port)))