From e86b10a732817fa9289a2003e9bdb916fefa1443 Mon Sep 17 00:00:00 2001 From: Dave Peticolas Date: Tue, 20 Mar 2001 02:08:30 +0000 Subject: [PATCH] Robert Graham Merkel's income/expense graphs. git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@3803 57a11ea4-9604-0410-9ed3-97b8803252fd --- src/scm/date-utilities.scm | 8 +- src/scm/html-piechart.scm | 6 +- src/scm/report/Makefile.am | 2 + src/scm/report/income-expense-graph.scm | 178 +++++++++++++++++++++++ src/scm/report/income-or-expense-pie.scm | 149 +++++++++++++++++++ src/scm/report/report-list.scm | 4 +- 6 files changed, 341 insertions(+), 6 deletions(-) create mode 100644 src/scm/report/income-expense-graph.scm create mode 100644 src/scm/report/income-or-expense-pie.scm diff --git a/src/scm/date-utilities.scm b/src/scm/date-utilities.scm index 4fe7c1cd49..e86a71d9a1 100644 --- a/src/scm/date-utilities.scm +++ b/src/scm/date-utilities.scm @@ -196,11 +196,11 @@ (gnc:timepair-canonical-day-time t2))) ;; Build a list of time intervals -(define (dateloop curd endd incr) +(define (gnc:dateloop curd endd incr) (cond ((gnc:timepair-later curd endd) (let ((nextd (incdate curd incr))) (cons (list curd (decdate nextd SecDelta) '()) - (dateloop nextd endd incr)))) + (gnc:dateloop nextd endd incr)))) (else '()))) ; A reference zero date - the Beginning Of The Epoch @@ -249,6 +249,10 @@ (set-tm:mon ddt 1) ddt)) +(define QuarterDelta + (let ((ddt (make-zdate))) + (set-tm:mon ddt 3) + ddt)) ;; Find difference in seconds time 1 and time2 (define (gnc:timepair-delta t1 t2) diff --git a/src/scm/html-piechart.scm b/src/scm/html-piechart.scm index cbff41ed8c..1c7889041f 100644 --- a/src/scm/html-piechart.scm +++ b/src/scm/html-piechart.scm @@ -45,7 +45,7 @@ (record-constructor )) (define (gnc:make-html-piechart) - (gnc:make-html-piechart-internal -1 -1 #f #f #f #f #f)) + (gnc:make-html-piechart-internal -1 -1 #f #f #f #f #f #f #f #f #f #f #f)) (define gnc:html-piechart-data (record-accessor 'data)) @@ -169,10 +169,10 @@ (gnc:html-piechart-button-1-slice-urls piechart))) (url-2 (catenate-escaped-strings - (gnc:html-piechart-button-2-slice--urls piechart))) + (gnc:html-piechart-button-2-slice-urls piechart))) (url-3 (catenate-escaped-strings - (gnc:html-piechart-button-3-slice--urls piechart))) + (gnc:html-piechart-button-3-slice-urls piechart))) (legend-1 (catenate-escaped-strings (gnc:html-piechart-button-1-legend-urls piechart))) diff --git a/src/scm/report/Makefile.am b/src/scm/report/Makefile.am index f95c3336ab..8253053a19 100644 --- a/src/scm/report/Makefile.am +++ b/src/scm/report/Makefile.am @@ -5,6 +5,8 @@ gncscm_DATA = \ account-summary.scm \ average-balance.scm \ pnl.scm \ + income-expense-graph.scm \ + income-or-expense-pie.scm \ hello-world.scm \ register.scm \ report-list.scm \ diff --git a/src/scm/report/income-expense-graph.scm b/src/scm/report/income-expense-graph.scm new file mode 100644 index 0000000000..0b0711654b --- /dev/null +++ b/src/scm/report/income-expense-graph.scm @@ -0,0 +1,178 @@ +;; -*-scheme-*- + + +;; income-expense-graph.scm +;; Display a simple time series for graphs +;; by Robert Merkel (rgmerk@mira.net) + + + +(gnc:support "report/income-expense-graph.scm") +(gnc:depend "report-html.scm") +(gnc:depend "date-utilities.scm") + +(let () + + + (define (options-generator) + (let* ((options (gnc:new-options)) + ;; This is just a helper function for making options. + ;; See gnucash/src/scm/options.scm for details. + (add-option + (lambda (new-option) + (gnc:register-option options new-option)))) + + (gnc:options-add-date-interval! + options "Report Options" + (N_ "From") (N_ "To") + "d") + + (add-option + (gnc:make-account-list-option + (N_ "Report Options") (N_ "Accounts") + "b" + "Select accounts to calculate income on" + (lambda () + (filter + gnc:account-is-inc-exp? + (gnc:group-get-account-list (gnc:get-current-group)))) + gnc:account-is-inc-exp? + #t)) + + (add-option + (gnc:make-currency-option + "Report Options" + "Report Currency" + "c" + "Select the display value for the currency" + (gnc:locale-default-currency))) + + (add-option + (gnc:make-multichoice-option + (N_ "Report Options") (N_ "Step Size") + "e" (N_ "The amount of time between data points") 'MonthDelta + (list #(WeekDelta "Week" "Week") + #(TwoWeekDelta "Two Week" "Two Weeks") + #(MonthDelta "Month" "Month") + #(QuarterDelta "Quarter" "Quarter") + #(YearDelta "Year" "Year") + ))) + + (add-option + (gnc:make-number-range-option + (N_ "Display Format") (N_ "Plot Width") + "a" (N_ "Width of plot in pixels.") 400 + 100 1000 0 1)) + + (add-option + (gnc:make-number-range-option + (N_ "Display Format") (N_ "Plot Height") + "b" (N_ "Height of plot in pixels.") 400 + 100 1000 0 1)) + + + (gnc:options-set-default-section options "Report Options") + options)) + + ;; This is the rendering function. It accepts a database of options + ;; and generates an object of type . See the file + ;; report-html.txt for documentation; the file report-html.scm + ;; includes all the relevant Scheme code. The option database passed + ;; to the function is one created by the options-generator function + ;; defined above. + (define (inc-exp-graph-renderer report-obj) + + + ;; These are some helper functions for looking up option values. + (define (get-op section name) + (gnc:lookup-option (gnc:report-options report-obj) section name)) + + (define (op-value section name) + (gnc:option-value (get-op section name))) + + (let* ( + (report-currency (op-value "Report Options" "Report Currency")) + (height (op-value "Display Format" "Plot Height")) + (width (op-value "Display Format" "Plot Width")) + (accounts (op-value "Report Options" "Accounts")) + (to-date-tp (gnc:timepair-end-day-time + (vector-ref (op-value "Report Options" + "To") 1))) + (from-date-tp (gnc:timepair-start-day-time + (vector-ref (op-value "Report Options" + "From") 1))) + (interval (op-value "Report Options" "Step Size")) + (document (gnc:make-html-document)) + (chart (gnc:make-html-barchart)) + (exchange-alist (gnc:make-exchange-alist + report-currency to-date-tp)) + (exchange-fn-internal (gnc:make-exchange-function exchange-alist)) + (exchange-fn (lambda (foriegn) (exchange-fn-internal foriegn report-currency))) + (dates-list (gnc:dateloop (gnc:timepair-start-day-time from-date-tp) + (gnc:timepair-end-day-time + (decdate to-date-tp DayDelta)) + (eval interval))) + (profit-collector-fn + (lambda (date-list-entry) + (let ((start-date (car date-list-entry)) + (end-date (cadr date-list-entry))) + (gnc:accounts-get-comm-total-profit accounts + (lambda (account) + (gnc:account-get-comm-balance-interval + account + start-date + end-date + #t)))))) + (profit-collector-list + (map profit-collector-fn dates-list)) + (double-list + (map (lambda (commodity-collector) + (- (gnc:numeric-to-double + (cadr (commodity-collector 'getpair report-currency #t))))) + profit-collector-list)) + (date-string-list + (map (lambda (date-list-item) + (gnc:timepair-to-datestring + (car date-list-item))) + dates-list))) + + +; (gnc:warn "dates-list" dates-list) + (gnc:warn "double-list" double-list) + (gnc:warn "date-string-list" date-string-list) + (gnc:html-barchart-set-title! chart (N_ "Income/Expense Chart")) + (gnc:html-barchart-set-subtitle! chart (string-append + (gnc:timepair-to-datestring from-date-tp) + " " (N_ "to") " " + (gnc:timepair-to-datestring to-date-tp))) + (gnc:html-barchart-set-width! chart width) + (gnc:html-barchart-set-height! chart height) + (gnc:html-barchart-append-column! chart double-list) + (gnc:html-barchart-set-col-labels! chart date-string-list) + (gnc:html-barchart-set-y-axis-label! chart (gnc:commodity-get-mnemonic report-currency)) + (gnc:html-document-add-object! document chart) + +; (gnc:html-document-add-object! +; document ;;(gnc:html-markup-p +; (gnc:html-make-exchangerates +; report-currency exchange-alist accounts #f)) + + document)) + + + ;; Here we define the actual report with gnc:define-report + (gnc:define-report + + ;; The version of this report. + 'version 1 + + ;; The name of this report. This will be used, among other things, + ;; for making its menu item in the main menu. You need to use the + ;; untranslated value here! + 'name (N_ "Income/Expense Graph") + + ;; The options generator function defined above. + 'options-generator options-generator + + ;; The rendering function defined above. + 'renderer inc-exp-graph-renderer)) diff --git a/src/scm/report/income-or-expense-pie.scm b/src/scm/report/income-or-expense-pie.scm new file mode 100644 index 0000000000..4f27bd8715 --- /dev/null +++ b/src/scm/report/income-or-expense-pie.scm @@ -0,0 +1,149 @@ +;; -*-scheme-*- + +;; income-or-expense-pie.scm +;; Display expenses/incomes from various accounts as a pie chart +;; by Robert Merkel (rgmerk@mira.net) + + + +(gnc:support "report/income-or-expense-pie.scm") +(gnc:depend "report-html.scm") +(gnc:depend "date-utilities.scm") + + +(let () + + ;; Note the options-generator has a boolean argument, which + ;; is true for income piecharts. We use a lambda to wrap + ;; up this function in the define-reports. + + (define (options-generator is-income?) + (let* ((options (gnc:new-options)) + (add-option + (lambda (new-option) + (gnc:register-option options new-option)))) + + (gnc:options-add-date-interval! + options "Report Options" + (N_ "From") (N_ "To") + "d") + + (add-option + (gnc:make-account-list-option + (N_ "Report Options") (N_ "Accounts") + "b" + "Select accounts to calculate income on" + (lambda () + (gnc:filter-accountlist-type + (if is-income? '(income) '(expense)) + (gnc:group-get-account-list (gnc:get-current-group)))) + (lambda (account) + (let ((type (gw:enum--val->sym + (gnc:account-type account) + #f))) + (member type (if is-income? '(income) '(expense))))) + #t)) + + (add-option + (gnc:make-currency-option + "Report Options" + "Report Currency" + "c" + "Select the display value for the currency" + (gnc:locale-default-currency))) + + (add-option + (gnc:make-number-range-option + (N_ "Display Format") (N_ "Plot Width") + "a" (N_ "Width of plot in pixels.") 400 + 100 1000 0 1)) + + (add-option + (gnc:make-number-range-option + (N_ "Display Format") (N_ "Plot Height") + "b" (N_ "Height of plot in pixels.") 400 + 100 1000 0 1)) + (gnc:options-set-default-section options "Report Options") + options)) + + ;; Similar arrangement to the options-generator. + (define (income-or-expense-pie-renderer report-obj is-income?) + + + ;; These are some helper functions for looking up option values. + (define (get-op section name) + (gnc:lookup-option (gnc:report-options report-obj) section name)) + + (define (op-value section name) + (gnc:option-value (get-op section name))) + + (let* ( + (report-currency (op-value "Report Options" "Report Currency")) + (height (op-value "Display Format" "Plot Height")) + (width (op-value "Display Format" "Plot Width")) + (accounts (op-value "Report Options" "Accounts")) + (to-date-tp (gnc:timepair-end-day-time + (vector-ref (op-value "Report Options" + "To") 1))) + (from-date-tp (gnc:timepair-start-day-time + (vector-ref (op-value "Report Options" + "From") 1))) + (document (gnc:make-html-document)) + (chart (gnc:make-html-piechart)) + (exchange-alist (gnc:make-exchange-alist + report-currency to-date-tp)) + (exchange-fn-internal (gnc:make-exchange-function exchange-alist)) + (profit-collector-fn + (lambda (account) + (gnc:account-get-comm-balance-interval + account + from-date-tp + to-date-tp + #t))) + (profit-collector-list + (map profit-collector-fn accounts)) + + + ;;; FIXME: better currency handling here + + (double-list + (map (lambda (commodity-collector) + (abs (gnc:numeric-to-double + (cadr (commodity-collector 'getpair report-currency #t))))) + profit-collector-list)) + (account-name-list (map gnc:account-get-name accounts))) + (gnc:warn "account-name-list" account-name-list) + + + (gnc:html-piechart-set-title! chart (if is-income? + (N_ "Income by Account") + (N_ "Expenses by Account"))) + (gnc:html-piechart-set-subtitle! chart (string-append + (gnc:timepair-to-datestring from-date-tp) + " " (N_ "to") " " + (gnc:timepair-to-datestring to-date-tp))) + (gnc:html-piechart-set-width! chart width) + (gnc:html-piechart-set-height! chart height) + (gnc:html-piechart-set-data! chart double-list) + (gnc:html-piechart-set-labels! chart account-name-list) + + (gnc:html-document-add-object! document chart) + + + document)) + + + (gnc:define-report + + 'version 1 + + 'name (N_ "Income Breakdown Piechart") + + 'options-generator (lambda () (options-generator #t)) + 'renderer (lambda (report-obj) (income-or-expense-pie-renderer report-obj #t))) + + (gnc:define-report + 'version 1 + 'name (N_ "Expense Breakdown Piechart") + 'options-generator (lambda () (options-generator #f)) + 'renderer (lambda (report-obj) (income-or-expense-pie-renderer report-obj #f)))) diff --git a/src/scm/report/report-list.scm b/src/scm/report/report-list.scm index 8f0fe05baf..0ebd166fcd 100644 --- a/src/scm/report/report-list.scm +++ b/src/scm/report/report-list.scm @@ -8,8 +8,10 @@ ;; reports (gnc:depend "report/account-summary.scm") (gnc:depend "report/average-balance.scm") -(gnc:depend "report/hello-world.scm") +(gnc:depend "report/income-expense-graph.scm") +(gnc:depend "report/income-or-expense-pie.scm") (gnc:depend "report/pnl.scm") +(gnc:depend "report/hello-world.scm") (gnc:depend "report/register.scm") (let ((locale (setlocale LC_MESSAGES))) (if (or (equal? locale "C")