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              (gnetlist backend-getopt)
  34              (gnetlist schematic)
  35              (srfi srfi-26))
  36
  37 (define bomAM:open-input-file
  38   (lambda (options)
  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
  43               (begin
  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"
  49 filename)
  50                 (primitive-exit 1)))))))
  51
  52 (define bomAM
  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)))
  58       (and attriblist
  59            (begin
  60              (bomAM:printlist (append attriblist (list "quantity" "refdes")) #\,)
  61              (newline)
  62              (bomAM:printbom (bomAM:components (schematic-packages toplevel-schematic)
  63                                              attriblist)
  64                             0))))))
  65
  66 (define bomAM:printbom
  67   (lambda (bomlist count)
  68     (if (not (null? bomlist))
  69       (if (not (null? (caar bomlist)))
  70         (begin
  71           (bomAM:printlist (cdar bomlist) #\,)
  72           (display #\,)
  73           (bomAM:printcount bomlist 0)
  74           (display #\,)
  75           (bomAM:printrefdes bomlist 0)
  76           (newline)
  77           (bomAM:printbom (cdr bomlist) 0)
  78         )))))
  79
  80 (define bomAM:printcount
  81   (lambda (bomlist count)
  82     (if (not (null? bomlist))
  83       (if (not (null? (caar bomlist)))
  84         (begin
  85           (bomAM:printcount (cons (cons (cdaar bomlist)(cdar bomlist))(cdr bomlist)) (+ count 1))
  86         )
  87         (display count)
  88       ))))
  89
  90 (define bomAM:printrefdes
  91   (lambda (bomlist count)
  92     (if (not (null? bomlist))
  93       (if (not (null? (caar bomlist)))
  94         (begin
  95           (display (caaar bomlist))
  96           (if (not (null? (cdaar bomlist)))
  97             (write-char #\  ))
  98           (bomAM:printrefdes (cons (cons (cdaar bomlist)(cdar bomlist))(cdr bomlist)) (+ count 1))
  99 )))))
 100
 101 (define bomAM:printlist
 102   (lambda (ls delimiter)
 103     (if (null? ls)
 104         #f
 105         (begin
 106           (display (car ls))
 107           (if (not (null? (cdr ls)))
 108             (write-char delimiter))
 109           (bomAM:printlist (cdr ls) delimiter)))))
 110
 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 #\,)
 116           (and port
 117                (let ((read-from-file (read-delimited " \n\t" port)))
 118                  (cond ((eof-object? read-from-file)
 119                         '())
 120                        ((= 0 (string-length read-from-file))
 121                         (bomAM:parseconfig port options))
 122                        (else
 123                         (cons read-from-file (bomAM:parseconfig port options))))))))))
 124
 125 (define bomAM:match-list?
 126   (lambda (l1 l2)
 127     (cond
 128       ((and (null? l1)(null? l2))#t)
 129       ((null? l1) #f)
 130       ((null? l2) #f)
 131       ((not (string=? (car l1)(car l2)))#f)
 132       (#t (bomAM:match-list? (cdr l1)(cdr l2))))))
 133
 134 (define bomAM:match?
 135   (lambda (uref attriblist bomlist)
 136     (if (null? 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)))))))
 141
 142 (define (bomAM:in-bom? package)
 143   (string=? "unknown"
 144             (gnetlist:get-package-attribute package "nobom")))
 145
 146 (define (bomAM:components-impl ls attriblist bomlist)
 147   (if (null? ls)
 148       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)
 154                                   bomlist)))))
 155
 156 (define (bomAM:components ls attriblist)
 157    (bomAM:components-impl ls attriblist '()))
 158
 159 (define (bomAM:find-attribs package attriblist)
 160   (map (cut gnetlist:get-package-attribute package <>) attriblist))
 161