Rename cards to export-cards.

src/export-cards.scm

@@ -0,0 +1,90 @@
+;;
+;; export-cards.scm
+;;
+;; Cards exporter as required by brmdoor.
+;;
+;; ISC License
+;;
+;; Copyright 2023 Brmlab, z.s.
+;; Dominik Pantůček <dominik.pantucek@trustica.cz>
+;;
+;; Permission to use, copy, modify, and/or distribute this software
+;; for any purpose with or without fee is hereby granted, provided
+;; that the above copyright notice and this permission notice appear
+;; in all copies.
+;; 
+;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
+;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
+;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
+;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
+;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
+;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
+;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
+;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+;;
+
+(declare (unit export-cards))
+
+(module
+ export-cards
+ (
+  cards-export
+  )
+
+ (import scheme
+	 (chicken base)
+	 (chicken sort)
+	 (chicken format)
+	 (chicken irregex)
+	 util-dict-list
+	 mbase
+	 brmember)
+
+ ;; Prints single card type records.
+ (define (cards-print/type mb type)
+   (let* ((rmb (find-members-by-predicate
+		mb
+		(lambda (mr)
+		  (and (brmember-active? mr)
+		       (ldict-contains? (ldict-ref mr 'info) type)
+		       (not (null? (ldict-ref (ldict-ref mr 'info) type)))))))
+	  (recs (map (lambda (mr)
+		       (let ((mi (ldict-ref mr 'info)))
+			 (cons (ldict-ref mi 'nick)
+			       (ldict-ref mi type))))
+		     rmb))
+	  (srecs (sort recs
+		       (lambda (a b)
+			 (string<? (car a)
+				   (car b))))))
+     (let uloop ((srecs srecs))
+       (when (not (null? srecs))
+	 (let* ((srec (car srecs))
+		(nick (car srec)))
+	   (let cloop ((cards (cdr srec)))
+	     (when (not (null? cards))
+	       (let* ((card (car cards))
+		      (cardid (car card))
+		      (calias (cdr card))
+		      (aliased? (> (string-length calias) 0))
+		      (cardname (sprintf "~A~A~A"
+					 nick
+					 (if aliased? "." "")
+					 (if aliased?
+					     (irregex-replace/all (irregex " " 'u) calias "_")
+					     ""))))
+		 (print cardname " " cardid)
+		 (cloop (cdr cards)))))
+	   (uloop (cdr srecs)))))))
+
+ ;; Exports single card type records for all members to given file.
+ (define (cards-export/type mb type fname)
+   (parameterize ((current-output-port (open-output-file fname)))
+     (cards-print/type mb type)))
+
+ ;; Exports cards and desfires to the files specified.
+ (define (cards-export mb cardsfn desfirefn)
+   (cards-export/type mb 'card cardsfn)
+   (cards-export/type mb 'desfire desfirefn))
+
+ )