Cards export.
This commit is contained in:
parent
3f126e1aa4
commit
a4b4ea764a
4 changed files with 47 additions and 6 deletions
|
@ -64,6 +64,8 @@ action is required.
|
|||
|
||||
### Member Base
|
||||
|
||||
### Cards
|
||||
|
||||
Specific Support Modules
|
||||
------------------------
|
||||
|
||||
|
|
2
Makefile
2
Makefile
|
@ -191,7 +191,7 @@ table.so: table.o
|
|||
table.o: table.import.scm
|
||||
table.import.scm: $(TABLE-SOURCES)
|
||||
|
||||
CARDS-SOURCES=cards.scm
|
||||
CARDS-SOURCES=cards.scm dictionary.import.scm members-base.import.scm
|
||||
|
||||
cards.so: cards.o
|
||||
cards.o: cards.import.scm
|
||||
|
|
48
cards.scm
48
cards.scm
|
@ -31,13 +31,51 @@
|
|||
cards-export
|
||||
)
|
||||
|
||||
(import scheme)
|
||||
(import scheme
|
||||
(chicken base)
|
||||
(chicken sort)
|
||||
(chicken format)
|
||||
dictionary
|
||||
members-base
|
||||
member-record)
|
||||
|
||||
(define (cards-export/type mb type fname)
|
||||
#f)
|
||||
(define (cards-print/type mb type)
|
||||
(let* ((rmb (filter-members-by-predicate
|
||||
mb
|
||||
(lambda (mr)
|
||||
(and (member-active? mr)
|
||||
(dict-has-key? (dict-ref mr 'info) type)
|
||||
(not (null? (dict-ref (dict-ref mr 'info) type)))))))
|
||||
(recs (map (lambda (mr)
|
||||
(let ((mi (dict-ref mr 'info)))
|
||||
(cons (dict-ref mi 'nick)
|
||||
(dict-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? calias ""))))
|
||||
(print cardname (car cards))
|
||||
(cloop (cdr cards)))))
|
||||
(uloop (cdr srecs)))))))
|
||||
|
||||
(define (cards-export mb cardsfn desfirefn)
|
||||
(cards-export/type mb 'cards cardsfn)
|
||||
(cards-export/type mb 'desfire desfirefn))
|
||||
(cards-print/type mb 'card)
|
||||
(newline)
|
||||
(cards-print/type mb 'desfire))
|
||||
|
||||
)
|
||||
|
|
|
@ -32,6 +32,7 @@
|
|||
find-member-by-id
|
||||
find-member-by-nick
|
||||
list-members-ids
|
||||
filter-members-by-predicate
|
||||
list-members-nicks
|
||||
members-base-stats
|
||||
print-members-base-info
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue