Start with small tweaks as proof of concept.

This commit is contained in:
Dominik Pantůček 2023-03-30 19:09:55 +02:00
parent 1147d73b11
commit 8f0d5acf0a
6 changed files with 35 additions and 31 deletions

View file

@ -209,7 +209,8 @@ MEMBERS-PRINT-SOURCES=members-print.scm dictionary.import.scm \
member-record.import.scm month.import.scm utils.import.scm \
table.import.scm listing.import.scm ansi.import.scm \
period.import.scm primes.import.scm members-base.import.scm \
configuration.import.scm bank-account.import.scm
configuration.import.scm bank-account.import.scm \
member-fees.import.scm
members-print.so: members-print.o
members-print.o: members-print.import.scm

View file

@ -66,17 +66,7 @@
(cons (cons transaction (car account))
(cdr account)))
;; Creates a new bank transaction. The order of elements is
;; well-suited for fast access to commonly used fields.
(define (make-bank-transaction id date amount currency varsym)
(list varsym amount currency date id))
;; Accessors for the fields actually used
(define bank-transaction-varsym car)
(define bank-transaction-amount cadr)
(define bank-transaction-currency caddr)
(define bank-transaction-date cadddr)
(define (bank-transaction-id tr)
(list-ref tr 4))
;; Creates a new bank transaction.
(define-record bank-transaction id date amount currency varsym)
)

View file

@ -143,9 +143,15 @@ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
(if mr
(let ()
(print-member-table mr)
(print-member-calendar-table mr)
(print "Total fees: " (member-fees-total mr))
)
(let* ((fees (member-fees-total mr))
(credit (member-credit-total mr))
(payments (member-payments-total mr))
(balance (- (+ credit payments) fees)))
(print "Total fees: " fees)
(print "Total credit: " credit)
(print "Total payments: " payments)
(print "Balance: " balance)
))
(print-members-base-table MB))
(newline))
((print-stats)

View file

@ -37,7 +37,7 @@
member-fees-total
member-credit-total
print-members-fees-table
print-member-calendar-table
member-calendar->table
)
(import scheme
@ -89,14 +89,14 @@
(if e
(if (member 'existing (cadr e))
(if (member 'suspended (cadr e))
(ansi-string #:bgdarkgrey " ") ; Suspended
(ansi-string #:bgdarkgrey " ") ; Suspended
(if (member 'destroyed (cadr e))
(ansi-string #:bgblack "~~~") ; Destroyed
(ansi-string #:bgblack "~~") ; Destroyed
(if (member 'student (cadr e))
(ansi-string #:bgyellow " ") ; Student
(ansi-string #:bggreen " ")))) ; Normal
" ") ; Nonexistent - should not happen
" ")) ; Nonexistent
(ansi-string #:bgyellow " ") ; Student
(ansi-string #:bggreen " ")))) ; Normal
" ") ; Nonexistent - should not happen
" ")) ; Nonexistent
;; Converts the entry into the fee
(define (member-calendar-entry->fee e)
@ -169,18 +169,17 @@
#:col-border #t #:row0-border #t)))
;; Nicely print calendar for given member
(define (print-member-calendar-table mr)
(define (member-calendar->table mr)
(let* ((mc (member-calendar mr))
(fees (member-calendar->fees mc)))
(print (table->string (cons (map (lambda (c)
(table->string (cons (map (lambda (c)
(sprintf "\t~A\t" c))
(list "" 1 2 3 4 5 6 7 8 9 10 11 12))
(member-calendar->years-table mc))
#:table-border #t
#:table-border #f
#:row-border #t
#:col-border #t
#:ansi #t
))
))
)))
)

View file

@ -29,6 +29,7 @@
members-payments
(
members-payments-process
member-payments-total
)
(import scheme
@ -81,4 +82,9 @@
accounts))
mb))
;; Total amount paid
(define (member-payments-total mr)
(foldl + 0 (map bank-transaction-amount
(member-payments mr))))
)

View file

@ -54,7 +54,8 @@
primes
members-base
configuration
bank-account)
bank-account
member-fees)
;; Prints human-readable information
(define (print-member-info mr)
@ -139,9 +140,10 @@
(define (print-member-table mr)
(print
(table->string
(list (list "Basic Information" "Payments")
(list (list "Basic Information" "Payments" "Membership Status")
(list (member-info->table mr)
(member-payments->table mr))
(member-payments->table mr)
(member-calendar->table mr))
)
#:row0-border #t
#:col-border #t)))