1 ;;; Altus Metrum CSV part list plug-in for lepton-netlist
2 ;;; Copyright (C) 2018 Bdale Garbee
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.
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.
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,
17 ;;; MA 02111-1301 USA.
19 ;; --------------------------------------------------------------------------
20 ;; This program generates a bill of materials in Altus Metrum format.
22 ;; You must have a file 'attribs' in the project directory with one attribute
23 ;; per line of all the attributes you want included, no comments allowed.
25 ;; The output consists of comma-separated fields for each of the attributes
26 ;; per part, quantity of that part, and a space-separated list of refdes.
28 ;; This program is inspired by the 'bom2' netlist module initially written
30 ;; --------------------------------------------------------------------------
32 (use-modules (ice-9 rdelim)
33 (netlist backend-getopt)
36 (netlist schematic toplevel)
39 (define bomAM:open-input-file
41 (let ((filename (backend-option-ref options 'attrib_file "attribs")))
42 (if (file-exists? filename)
43 (open-input-file filename)
44 (if (backend-option-ref options 'attribs) #f
46 (format (current-error-port)
47 "ERROR: Attribute file '~A' not found. You must do one of the following:\n"
48 " - Create an 'attribs' file\n"
49 " - Specify an attribute file using -Oattrib_file=<filename>\n"
50 " - Specify which attributes to include using -Oattribs=attrib1,attrib2,... (no spaces)\n"
52 (primitive-exit 1)))))))
55 (lambda (output-filename)
56 (let* ((options (backend-getopt
57 (gnetlist:get-backend-arguments)
58 '((attrib_file (value #t)) (attribs (value #t)))))
59 (attriblist (bomAM:parseconfig (bomAM:open-input-file options) options)))
62 (bomAM:printlist (append attriblist (list "quantity" "refdes")) #\,)
64 (bomAM:printbom (bomAM:components (schematic-package-names (toplevel-schematic))
68 (define bomAM:printbom
69 (lambda (bomlist count)
70 (if (not (null? bomlist))
71 (if (not (null? (caar bomlist)))
73 (bomAM:printlist (cdar bomlist) #\,)
75 (bomAM:printcount bomlist 0)
77 (bomAM:printrefdes bomlist 0)
79 (bomAM:printbom (cdr bomlist) 0)
82 (define bomAM:printcount
83 (lambda (bomlist count)
84 (if (not (null? bomlist))
85 (if (not (null? (caar bomlist)))
87 (bomAM:printcount (cons (cons (cdaar bomlist)(cdar bomlist))(cdr bomlist)) (+ count 1))
92 (define bomAM:printrefdes
93 (lambda (bomlist count)
94 (if (not (null? bomlist))
95 (if (not (null? (caar bomlist)))
97 (display (caaar bomlist))
98 (if (not (null? (cdaar bomlist)))
100 (bomAM:printrefdes (cons (cons (cdaar bomlist)(cdar bomlist))(cdr bomlist)) (+ count 1))
103 (define bomAM:printlist
104 (lambda (ls delimiter)
109 (if (not (null? (cdr ls)))
110 (write-char delimiter))
111 (bomAM:printlist (cdr ls) delimiter)))))
113 ; Parses attrib file. Returns a list of read attributes.
114 (define bomAM:parseconfig
115 (lambda (port options)
116 (let ((attribs (backend-option-ref options 'attribs)))
117 (if attribs (string-split attribs #\,)
119 (let ((read-from-file (read-delimited " \n\t" port)))
120 (cond ((eof-object? read-from-file)
122 ((= 0 (string-length read-from-file))
123 (bomAM:parseconfig port options))
125 (cons read-from-file (bomAM:parseconfig port options))))))))))
127 (define bomAM:match-list?
130 ((and (null? l1)(null? l2))#t)
133 ((not (string=? (car l1)(car l2)))#f)
134 (#t (bomAM:match-list? (cdr l1)(cdr l2))))))
137 (lambda (uref attriblist bomlist)
139 (list (cons (list uref) attriblist))
140 (if (bomAM:match-list? attriblist (cdar bomlist))
141 (cons (cons (merge (list uref) (caar bomlist) string<? ) (cdar bomlist))(cdr bomlist))
142 (cons (car bomlist)(bomAM:match? uref attriblist (cdr bomlist)))))))
144 (define (bomAM:in-bom? package)
146 (gnetlist:get-package-attribute package "nobom")))
148 (define (bomAM:components-impl ls attriblist bomlist)
151 (let* ((package (car ls))
152 (attribs (bomAM:find-attribs package attriblist)))
153 (bomAM:components-impl (cdr ls) attriblist
154 (if (bomAM:in-bom? package)
155 (bomAM:match? package attribs bomlist)
158 (define (bomAM:components ls attriblist)
159 (bomAM:components-impl ls attriblist '()))
161 (define (bomAM:find-attribs package attriblist)
162 (map (cut gnetlist:get-package-attribute package <>) attriblist))