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)
37 (define bomAM:open-input-file
39 (let ((filename (backend-option-ref options 'attrib_file "attribs")))
40 (if (file-exists? filename)
41 (open-input-file filename)
42 (if (backend-option-ref options 'attribs) #f
44 (format (current-error-port)
45 "ERROR: Attribute file '~A' not found. You must do one of the following:\n"
46 " - Create an 'attribs' file\n"
47 " - Specify an attribute file using -Oattrib_file=<filename>\n"
48 " - Specify which attributes to include using -Oattribs=attrib1,attrib2,... (no spaces)\n"
50 (primitive-exit 1)))))))
53 (lambda (output-filename)
54 (let* ((options (backend-getopt
55 (gnetlist:get-backend-arguments)
56 '((attrib_file (value #t)) (attribs (value #t)))))
57 (attriblist (bomAM:parseconfig (bomAM:open-input-file options) options)))
60 (bomAM:printlist (append attriblist (list "quantity" "refdes")) #\,)
62 (bomAM:printbom (bomAM:components (schematic-package-names toplevel-schematic)
66 (define bomAM:printbom
67 (lambda (bomlist count)
68 (if (not (null? bomlist))
69 (if (not (null? (caar bomlist)))
71 (bomAM:printlist (cdar bomlist) #\,)
73 (bomAM:printcount bomlist 0)
75 (bomAM:printrefdes bomlist 0)
77 (bomAM:printbom (cdr bomlist) 0)
80 (define bomAM:printcount
81 (lambda (bomlist count)
82 (if (not (null? bomlist))
83 (if (not (null? (caar bomlist)))
85 (bomAM:printcount (cons (cons (cdaar bomlist)(cdar bomlist))(cdr bomlist)) (+ count 1))
90 (define bomAM:printrefdes
91 (lambda (bomlist count)
92 (if (not (null? bomlist))
93 (if (not (null? (caar bomlist)))
95 (display (caaar bomlist))
96 (if (not (null? (cdaar bomlist)))
98 (bomAM:printrefdes (cons (cons (cdaar bomlist)(cdar bomlist))(cdr bomlist)) (+ count 1))
101 (define bomAM:printlist
102 (lambda (ls delimiter)
107 (if (not (null? (cdr ls)))
108 (write-char delimiter))
109 (bomAM:printlist (cdr ls) delimiter)))))
111 ; Parses attrib file. Returns a list of read attributes.
112 (define bomAM:parseconfig
113 (lambda (port options)
114 (let ((attribs (backend-option-ref options 'attribs)))
115 (if attribs (string-split attribs #\,)
117 (let ((read-from-file (read-delimited " \n\t" port)))
118 (cond ((eof-object? read-from-file)
120 ((= 0 (string-length read-from-file))
121 (bomAM:parseconfig port options))
123 (cons read-from-file (bomAM:parseconfig port options))))))))))
125 (define bomAM:match-list?
128 ((and (null? l1)(null? l2))#t)
131 ((not (string=? (car l1)(car l2)))#f)
132 (#t (bomAM:match-list? (cdr l1)(cdr l2))))))
135 (lambda (uref attriblist bomlist)
137 (list (cons (list uref) attriblist))
138 (if (bomAM:match-list? attriblist (cdar bomlist))
139 (cons (cons (merge (list uref) (caar bomlist) string<? ) (cdar bomlist))(cdr bomlist))
140 (cons (car bomlist)(bomAM:match? uref attriblist (cdr bomlist)))))))
142 (define (bomAM:in-bom? package)
144 (gnetlist:get-package-attribute package "nobom")))
146 (define (bomAM:components-impl ls attriblist bomlist)
149 (let* ((package (car ls))
150 (attribs (bomAM:find-attribs package attriblist)))
151 (bomAM:components-impl (cdr ls) attriblist
152 (if (bomAM:in-bom? package)
153 (bomAM:match? package attribs bomlist)
156 (define (bomAM:components ls attriblist)
157 (bomAM:components-impl ls attriblist '()))
159 (define (bomAM:find-attribs package attriblist)
160 (map (cut gnetlist:get-package-attribute package <>) attriblist))