git.gag.com Git - hw/altusmetrum/blob - scheme/gnet-bomAM.scm

   1 ;;; Altus Metrum CSV part list plug-in for lepton-netlist
   2 ;;; Copyright (C) 2018 Bdale Garbee
   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,
  17 ;;; MA 02111-1301 USA.
  18
  19 ;; --------------------------------------------------------------------------
  20 ;; This program generates a bill of materials in Altus Metrum format.
  21 ;;
  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.
  24 ;;
  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.
  27 ;;
  28 ;; This program is inspired by the 'bom2' netlist module initially written
  29 ;; by Matt Ettus.
  30 ;; --------------------------------------------------------------------------
  31
  32 (use-modules (ice-9 rdelim)
  33              (netlist backend-getopt)
  34              (netlist error)
  35              (netlist schematic)
  36              (netlist schematic toplevel)
  37              (srfi srfi-26))
  38
  39 (define bomAM:open-input-file
  40   (lambda (options)
  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
  45               (begin
  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"
  51 filename)
  52                 (primitive-exit 1)))))))
  53
  54 (define bomAM
  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)))
  60       (and attriblist
  61            (begin
  62              (bomAM:printlist (append attriblist (list "quantity" "refdes")) #\,)
  63              (newline)
  64              (bomAM:printbom (bomAM:components (schematic-package-names (toplevel-schematic))
  65                                              attriblist)
  66                             0))))))
  67
  68 (define bomAM:printbom
  69   (lambda (bomlist count)
  70     (if (not (null? bomlist))
  71       (if (not (null? (caar bomlist)))
  72         (begin
  73           (bomAM:printlist (cdar bomlist) #\,)
  74           (display #\,)
  75           (bomAM:printcount bomlist 0)
  76           (display #\,)
  77           (bomAM:printrefdes bomlist 0)
  78           (newline)
  79           (bomAM:printbom (cdr bomlist) 0)
  80         )))))
  81
  82 (define bomAM:printcount
  83   (lambda (bomlist count)
  84     (if (not (null? bomlist))
  85       (if (not (null? (caar bomlist)))
  86         (begin
  87           (bomAM:printcount (cons (cons (cdaar bomlist)(cdar bomlist))(cdr bomlist)) (+ count 1))
  88         )
  89         (display count)
  90       ))))
  91
  92 (define bomAM:printrefdes
  93   (lambda (bomlist count)
  94     (if (not (null? bomlist))
  95       (if (not (null? (caar bomlist)))
  96         (begin
  97           (display (caaar bomlist))
  98           (if (not (null? (cdaar bomlist)))
  99             (write-char #\  ))
 100           (bomAM:printrefdes (cons (cons (cdaar bomlist)(cdar bomlist))(cdr bomlist)) (+ count 1))
 101 )))))
 102
 103 (define bomAM:printlist
 104   (lambda (ls delimiter)
 105     (if (null? ls)
 106         #f
 107         (begin
 108           (display (car ls))
 109           (if (not (null? (cdr ls)))
 110             (write-char delimiter))
 111           (bomAM:printlist (cdr ls) delimiter)))))
 112
 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 #\,)
 118           (and port
 119                (let ((read-from-file (read-delimited " \n\t" port)))
 120                  (cond ((eof-object? read-from-file)
 121                         '())
 122                        ((= 0 (string-length read-from-file))
 123                         (bomAM:parseconfig port options))
 124                        (else
 125                         (cons read-from-file (bomAM:parseconfig port options))))))))))
 126
 127 (define bomAM:match-list?
 128   (lambda (l1 l2)
 129     (cond
 130       ((and (null? l1)(null? l2))#t)
 131       ((null? l1) #f)
 132       ((null? l2) #f)
 133       ((not (string=? (car l1)(car l2)))#f)
 134       (#t (bomAM:match-list? (cdr l1)(cdr l2))))))
 135
 136 (define bomAM:match?
 137   (lambda (uref attriblist bomlist)
 138     (if (null? 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)))))))
 143
 144 (define (bomAM:in-bom? package)
 145   (string=? "unknown"
 146             (gnetlist:get-package-attribute package "nobom")))
 147
 148 (define (bomAM:components-impl ls attriblist bomlist)
 149   (if (null? ls)
 150       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)
 156                                   bomlist)))))
 157
 158 (define (bomAM:components ls attriblist)
 159    (bomAM:components-impl ls attriblist '()))
 160
 161 (define (bomAM:find-attribs package attriblist)
 162   (map (cut gnetlist:get-package-attribute package <>) attriblist))
 163