IntenseFinance/gnucash
3
0
Fork 0
mirror of https://github.com/Gnucash/gnucash.git synced 2025-02-25 18:55:30 -06:00
Code Issues Packages Projects Releases Wiki Activity

Convert the check printing code from Scheme to C. Add support for

Browse Source 
using the GtkPrint API when compiled against gtk+ 2.10 or later.  Add
support for reading check description files instead of hard coding
check descriptions.


git-svn-id: svn+ssh://svn.gnucash.org/repo/gnucash/trunk@15709 57a11ea4-9604-0410-9ed3-97b8803252fd
This commit is contained in:
David Hampton 2007-03-13 03:43:24 +00:00
parent 5246632fb4
commit 2af48fcb16
19 changed files with 1746 additions and 447 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.am
View File

@ -1,5 +1,5 @@
SUBDIRS = . doc lib src intl-scm packaging po accounts
SUBDIRS = . doc lib src intl-scm packaging po accounts checks
docdir = ${GNC_DOC_INSTALL_DIR}

17
checks/Makefile.am Normal file
View File

@ -0,0 +1,17 @@
checksdir = ${GNC_CHECKS_DIR}
if HAVE_GTK_2_10
checks_DATA = \
deluxe.chk \
quicken.chk \
quicken_wallet.chk
else
checks_DATA = \
gnomeprint/deluxe.chk \
gnomeprint/quicken.chk \
gnomeprint/quicken_wallet.chk
endif
EXTRA_DIST = \
${checks_DATA}

22
checks/deluxe.chk Normal file
View File

@ -0,0 +1,22 @@
[Top]
Title = Deluxe(tm) Personal Checks US-Letter
Rotation = -90.0
Translation = 4;492
Show_Grid = 0
Show_Boxes = 0
[Check Items]
Type_1 = PAYEE
Coords_1 = 126.0;85.0
Type_2 = AMOUNT_WORDS
Coords_2 = 90.0;107.0
Type_3 = AMOUNT_NUMBER
Coords_3 = 395.0;85.0
Type_4 = DATE
Coords_4 = 343.0;54.0
Type_5 = MEMO
Coords_5 = 100.0;159.0

22
checks/gnomeprint/deluxe.chk Normal file
View File

@ -0,0 +1,22 @@
[Top]
Title = Deluxe(tm) Personal Checks US-Letter
Rotation = 90
Translation = 232;300
Show_Grid = 0
Show_Boxes = 0
[Check Items]
Type_1 = PAYEE
Coords_1 = 126.0;147.0
Type_2 = AMOUNT_WORDS
Coords_2 = 90.0;125.0
Type_3 = AMOUNT_NUMBER
Coords_3 = 395.0;147.0
Type_4 = DATE
Coords_4 = 343.0;178.0
Type_5 = MEMO
Coords_5 = 100.0;73.0

28
checks/gnomeprint/quicken.chk Normal file
View File

@ -0,0 +1,28 @@
[Top]
Title = Quicken/QuickBooks (tm) US-Letter
Rotation = 0.0
Translation = 0.0;0.0
Show_Grid = 0
Show_Boxes = 0
[Check Positions]
Height = 252.0
Name_1 = Top
Name_2 = Middle
Name_3 = Bottom
[Check Items]
Type_1 = PAYEE
Coords_1 = 90.0;150.0;400.0;20.0
Type_2 = AMOUNT_WORDS
Coords_2 = 90.0;120.0
Type_3 = AMOUNT_NUMBER
Coords_3 = 500.0;150.0
Type_4 = DATE
Coords_4 = 500.0;185.0
Type_5 = MEMO
Coords_5 = 50.0;40.0

40
checks/gnomeprint/quicken_wallet.chk Normal file
View File

@ -0,0 +1,40 @@
[Top]
Title = Quicken(tm) Wallet Checks w/ side stub
Rotation = 0.0
Translation = 0.0;0.0
Show_Grid = 0
Show_Boxes = 0
[Check Positions]
Height = 204.0
Name_1 = Top
Name_2 = Middle
Name_3 = Bottom
[Check Items]
Type_1 = PAYEE
Coords_1 = 231.0;140.0
Type_2 = AMOUNT_WORDS
Coords_2 = 195.0;125.0
Type_3 = AMOUNT_NUMBER
Coords_3 = 518.0;137.0
Type_4 = DATE
Coords_4 = 504.0;151.0
Type_5 = MEMO
Coords_5 = 216.0;37.0
Type_6 = DATE
Coords_6 = 36.0;151.0
Type_7 = PAYEE
Coords_7 = 26.0;126.0
Type_8 = AMOUNT_NUMBER
Coords_8 = 50.0;90.0
Type_9 = MEMO
Coords_9 = 28.0;65.0

28
checks/quicken.chk Normal file
View File

@ -0,0 +1,28 @@
[Top]
Title = Quicken/QuickBooks (tm) US-Letter
Rotation = 0.0
Translation = 0.0;4.0
Show_Grid = 0
Show_Boxes = 0
[Check Positions]
Height = 252.0
Name_1 = Top
Name_2 = Middle
Name_3 = Bottom
[Check Items]
Type_1 = PAYEE
Coords_1 = 90.0;102.0;400.0;20.0
Type_2 = AMOUNT_WORDS
Coords_2 = 90.0;132.0
Type_3 = AMOUNT_NUMBER
Coords_3 = 500.0;102.0
Type_4 = DATE
Coords_4 = 500.0;67.0
Type_5 = MEMO
Coords_5 = 50.0;212.0

40
checks/quicken_wallet.chk Normal file
View File

@ -0,0 +1,40 @@
[Top]
Title = Quicken(tm) Wallet Checks w/ side stub
Rotation = 0.0
Translation = 0.0;4.0
Show_Grid = 0
Show_Boxes = 0
[Check Positions]
Height = 204.0
Name_1 = Top
Name_2 = Middle
Name_3 = Bottom
[Check Items]
Type_1 = PAYEE
Coords_1 = 231.0;64.0
Type_2 = AMOUNT_WORDS
Coords_2 = 195.0;79.0
Type_3 = AMOUNT_NUMBER
Coords_3 = 518.0;67.0
Type_4 = DATE
Coords_4 = 504.0;53.0
Type_5 = MEMO
Coords_5 = 216.0;167.0
Type_6 = DATE
Coords_6 = 36.0;53.0
Type_7 = PAYEE
Coords_7 = 26.0;78.0
Type_8 = AMOUNT_NUMBER
Coords_8 = 50.0;114.0
Type_9 = MEMO
Coords_9 = 28.0;139.0

4
configure.in
View File

@ -572,11 +572,13 @@ GNC_SHAREDIR='${pkgdatadir}'
GNC_LIBEXECDIR='${libexecdir}/gnucash'
GNC_ACCOUNTS_DIR='${GNC_SHAREDIR}/accounts'
GNC_CHECKS_DIR='${GNC_SHAREDIR}/checks'
GNC_GLADE_DIR='${GNC_SHAREDIR}/glade'
GNC_UI_DIR='${GNC_SHAREDIR}/ui'
GNC_PIXMAP_DIR='${GNC_SHAREDIR}/pixmaps'
AC_SUBST(GNC_ACCOUNTS_DIR)
AC_SUBST(GNC_CHECKS_DIR)
AC_SUBST(GNC_CONFIGDIR)
AC_SUBST(GNC_DOC_INSTALL_DIR)
AC_SUBST(GNC_GLADE_DIR)
@ -1401,6 +1403,7 @@ AC_CONFIG_FILES(po/Makefile.in
accounts/pt_PT/Makefile
accounts/sk/Makefile
accounts/tr_TR/Makefile
checks/Makefile
doc/Makefile
doc/examples/Makefile
intl-scm/Makefile
@ -1497,7 +1500,6 @@ AC_CONFIG_FILES(po/Makefile.in
src/report/utility-reports/test/Makefile
src/scm/Makefile
src/scm/gnumeric/Makefile
src/scm/printing/Makefile
src/tax/Makefile
src/tax/us/Makefile
src/tax/us/test/Makefile

3
src/app-utils/app-utils.i
View File

@ -70,6 +70,9 @@ GNCPrintAmountInfo gnc_commodity_print_info (const gnc_commodity *commodity,
GNCPrintAmountInfo gnc_share_print_info_places (int decplaces);
const char * xaccPrintAmount (gnc_numeric val, GNCPrintAmountInfo info);
gchar *number_to_words(gdouble val, gint64 denom);
const gchar *printable_value (gdouble val, gint denom);
gboolean gnc_reverse_balance (const Account *account);
gboolean gnc_is_euro_currency(const gnc_commodity * currency);

107
src/app-utils/gnc-ui-util.c
View File

@ -1568,6 +1568,113 @@ xaccPrintAmount (gnc_numeric val, GNCPrintAmountInfo info)
}
/********************************************************************\
********************************************************************/
#define FUDGE .00001
static gchar *small_numbers[] = {
N_("Zero"), N_("One"), N_("Two"), N_("Three"), N_("Four"),
N_("Five"), N_("Six"), N_("Seven"), N_("Eight"), N_("Nine"),
N_("Ten"), N_("Eleven"), N_("Twelve"), N_("Thirteen"), N_("Fourteen"),
N_("Fifteen"), N_("Sixteen"), N_("Seventeen"), N_("Eighteen"), N_("Nineteen"),
N_("Twenty")};
static gchar *medium_numbers[] = {
N_("Zero"), N_("Ten"), N_("Twenty"), N_("Thirty"), N_("Forty"),
N_("Fifty"), N_("Sixty"), N_("Seventy"), N_("Eighty"), N_("Ninety")};
static gchar *big_numbers[] = {
N_("Hundred"), N_("Thousand"), N_("Million"), N_("Billion"),
N_("Trillion"), N_("Quadrillion"), N_("Quintillion")};
static gchar *
integer_to_words(gint64 val)
{
gint64 log_val, pow_val, this_part;
GString *result;
gchar *tmp;
if (val == 0)
return g_strdup("zero");
if (val < 0)
val = -val;
result = g_string_sized_new(100);
while (val >= 1000) {
log_val = log10(val) / 3 + FUDGE;
pow_val = exp10(log_val * 3) + FUDGE;
this_part = val / pow_val;
val -= this_part * pow_val;
tmp = integer_to_words(this_part);
g_string_append_printf(result, "%s %s ", tmp,
gettext(big_numbers[log_val]));
g_free(tmp);
}
if (val >= 100) {
this_part = val / 100;
val -= this_part * 100;
g_string_append_printf(result, "%s %s ",
gettext(small_numbers[this_part]),
gettext(big_numbers[0]));
}
if (val > 20) {
this_part = val / 10;
val -= this_part * 10;
g_string_append(result, gettext(medium_numbers[this_part]));
g_string_append_c(result, ' ');
}
if (val > 0) {
this_part = val;
val -= this_part;
g_string_append(result, gettext(small_numbers[this_part]));
g_string_append_c(result, ' ');
}
result = g_string_truncate(result, result->len - 1);
return g_string_free(result, FALSE);
}
gchar *
number_to_words(gdouble val, gint64 denom)
{
gint64 int_part, frac_part;
gchar *int_string, *full_string;
if (val < 0) val = -val;
if (denom < 0) denom = -denom;
int_part = trunc(val);
frac_part = round((val - int_part) * denom);
int_string = integer_to_words(int_part);
full_string =
g_strdup_printf(_("%s and %lld/%lld"), int_string, frac_part, denom);
g_free(int_string);
return full_string;
}
gchar *
numeric_to_words(gnc_numeric val)
{
return number_to_words(gnc_numeric_to_double(val),
gnc_numeric_denom(val));
}
const gchar *
printable_value (gdouble val, gint denom)
{
GNCPrintAmountInfo info;
gnc_numeric num;
num = gnc_numeric_create(round(val * denom), denom);
info = gnc_share_print_info_places(log10(denom));
return xaccPrintAmount (num, info);
}
/********************************************************************\
* xaccParseAmount *
* parses amount strings using locale data *

3
src/app-utils/gnc-ui-util.h
View File

@ -275,6 +275,9 @@ GNCPrintAmountInfo gnc_integral_print_info (void);
const char * xaccPrintAmount (gnc_numeric val, GNCPrintAmountInfo info);
int xaccSPrintAmount (char *buf, gnc_numeric val, GNCPrintAmountInfo info);
const gchar *printable_value(gdouble val, gint denom);
gchar *number_to_words(gdouble val, gint64 denom);
gchar *numeric_to_words(gnc_numeric val);
/* xaccParseAmount parses in_str to obtain a numeric result. The
* routine will parse as much of in_str as it can to obtain a single

1425
src/gnome/dialog-print-check.c
View File

File diff suppressed because it is too large Load Diff

91
src/gnome/glade/print.glade
View File

@ -193,7 +193,7 @@ Quicken(tm) Wallet Checks w/ side stub
Custom</property>
<property name="add_tearoffs">False</property>
<property name="focus_on_click">True</property>
<signal name="changed" handler="gnc_print_check_combobox_changed" last_modification_time="Sat, 28 Jan 2006 04:19:16 GMT"/>
<signal name="changed" handler="gnc_print_check_format_changed" last_modification_time="Sat, 03 Mar 2007 22:06:00 GMT"/>
</widget>
<packing>
<property name="left_attach">1</property>
@ -213,7 +213,7 @@ Bottom
Custom</property>
<property name="add_tearoffs">False</property>
<property name="focus_on_click">True</property>
<signal name="changed" handler="gnc_print_check_combobox_changed" last_modification_time="Sat, 28 Jan 2006 04:19:41 GMT"/>
<signal name="changed" handler="gnc_print_check_position_changed" last_modification_time="Sat, 03 Mar 2007 22:06:12 GMT"/>
</widget>
<packing>
<property name="left_attach">1</property>
@ -257,7 +257,7 @@ Custom</property>
<child>
<widget class="GtkTable" id="custom_table">
<property name="visible">True</property>
<property name="n_rows">9</property>
<property name="n_rows">11</property>
<property name="n_columns">3</property>
<property name="homogeneous">False</property>
<property name="row_spacing">0</property>
@ -853,6 +853,91 @@ Points</property>
<property name="y_options"></property>
</packing>
</child>
<child>
<widget class="GtkLabel" id="upper_left">
<property name="visible">True</property>
<property name="label" translatable="yes">The origin point is the upper left-hand corner of the page.</property>
<property name="use_underline">False</property>
<property name="use_markup">False</property>
<property name="justify">GTK_JUSTIFY_LEFT</property>
<property name="wrap">False</property>
<property name="selectable">False</property>
<property name="xalign">0</property>
<property name="yalign">0.5</property>
<property name="xpad">0</property>
<property name="ypad">0</property>
<property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
<property name="width_chars">-1</property>
<property name="single_line_mode">False</property>
<property name="angle">0</property>
</widget>
<packing>
<property name="left_attach">0</property>
<property name="right_attach">3</property>
<property name="top_attach">9</property>
<property name="bottom_attach">10</property>
<property name="x_options">fill</property>
<property name="y_options"></property>
</packing>
</child>
<child>
<widget class="GtkLabel" id="lower_left">
<property name="visible">True</property>
<property name="label" translatable="yes">The origin point is the lower left-hand corner of the page.</property>
<property name="use_underline">False</property>
<property name="use_markup">False</property>
<property name="justify">GTK_JUSTIFY_LEFT</property>
<property name="wrap">False</property>
<property name="selectable">False</property>
<property name="xalign">0</property>
<property name="yalign">0.5</property>
<property name="xpad">0</property>
<property name="ypad">0</property>
<property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
<property name="width_chars">-1</property>
<property name="single_line_mode">False</property>
<property name="angle">0</property>
</widget>
<packing>
<property name="left_attach">0</property>
<property name="right_attach">3</property>
<property name="top_attach">10</property>
<property name="bottom_attach">11</property>
<property name="x_options">fill</property>
<property name="y_options"></property>
</packing>
</child>
<child>
<widget class="GtkLabel" id="rotation_units">
<property name="visible">True</property>
<property name="label" translatable="yes">Degrees</property>
<property name="use_underline">False</property>
<property name="use_markup">False</property>
<property name="justify">GTK_JUSTIFY_LEFT</property>
<property name="wrap">False</property>
<property name="selectable">False</property>
<property name="xalign">0</property>
<property name="yalign">0.5</property>
<property name="xpad">0</property>
<property name="ypad">0</property>
<property name="ellipsize">PANGO_ELLIPSIZE_NONE</property>
<property name="width_chars">-1</property>
<property name="single_line_mode">False</property>
<property name="angle">0</property>
</widget>
<packing>
<property name="left_attach">2</property>
<property name="right_attach">3</property>
<property name="top_attach">7</property>
<property name="bottom_attach">8</property>
<property name="x_padding">6</property>
<property name="x_options">fill</property>
<property name="y_options"></property>
</packing>
</child>
</widget>
<packing>
<property name="tab_expand">False</property>

2
src/scm/Makefile.am
View File

@ -1,5 +1,5 @@
SUBDIRS = gnumeric printing
SUBDIRS = gnumeric
gncscmdir = ${GNC_SCM_INSTALL_DIR}
gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash

5
src/scm/main.scm
View File

@ -67,10 +67,6 @@
;; from main-window.scm
(export gnc:main-window-properties-cb)
;; from printing/print-check.scm
(export make-print-check-format)
(export gnc:print-check)
;; Get the Makefile.am/configure.in generated variables.
(load-from-path "build-config.scm")
@ -220,7 +216,6 @@
;; Now we can load a bunch of files.
(load-from-path "command-line.scm") ;; depends on app-utils (N_, etc.)...
(load-from-path "printing/print-check.scm") ;; depends on simple-obj...
(gnc:initialize-config-vars) ;; in command-line.scm
;; handle unrecognized command line args

25
src/scm/printing/Makefile.am
View File

@ -1,25 +0,0 @@
gncscmdir = ${GNC_SCM_INSTALL_DIR}/printing
gncscm_DATA = print-check.scm
gncscmmoddir = ${GNC_SHAREDIR}/guile-modules/gnucash/printing
gncscmmod_DATA = number-to-words.scm
if GNUCASH_SEPARATE_BUILDDIR
SCM_FILE_LINKS = \
${gncscmmod_DATA} \
${gncscm_DATA}
endif
.scm-links:
if GNUCASH_SEPARATE_BUILDDIR
for X in ${SCM_FILE_LINKS} ; do \
$(LN_S) -f ${srcdir}/$$X . ; \
done
endif
touch .scm-links
noinst_DATA = .scm-links
EXTRA_DIST = ${gncscmmod_DATA} ${gncscm_DATA}
CLEANFILES = .scm-links
DISTCLEANFILES = ${SCM_FILE_LINKS}

113
src/scm/printing/number-to-words.scm
View File

@ -1,113 +0,0 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; number-to-words.scm
;;; convert a number into a sentence for check printing
;;;
;;; Copyright 2000 Bill Gribble <grib@billgribble.com>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-module (gnucash printing number-to-words))
(export integer-to-words)
(export printable-value)
(export number-to-words)
(define (integer-to-words val)
(let ((current-string "")
(small-numbers
#("zero" "one" "two" "three" "four" "five"
"six" "seven" "eight" "nine" "ten"
"eleven" "twelve" "thirteen" "fourteen" "fifteen"
"sixteen" "seventeen" "eighteen" "nineteen" "twenty"))
(medium-numbers
#("zero" "ten" "twenty" "thirty" "forty" "fifty"
"sixty" "seventy" "eighty" "ninety"))
(big-numbers
#("hundred" "thousand" "million" "billion" "trillion"
"quadrillion" "quintillion")))
(cond
((< val 20)
(vector-ref small-numbers val))
((< val 100)
(let ((this-part (quotient val 10))
(that-part (remainder val 10)))
(set! current-string (vector-ref medium-numbers this-part))
(if (> that-part 0)
(set! current-string
(string-append current-string "-"
(vector-ref small-numbers that-part))))
current-string))
((< val 1000)
(let ((this-part (quotient val 100))
(that-part (remainder val 100)))
(set! current-string
(string-append current-string
(vector-ref small-numbers this-part) " "
(vector-ref big-numbers 0)))
(if (> that-part 0)
(set! current-string
(string-append current-string
" " (integer-to-words that-part))))
current-string))
(#t
(let* ((log-val (inexact->exact
(truncate (+ .00001 (/ (log10 val) 3)))))
(this-part (quotient val
(inexact->exact
(truncate
(+ .00001 (expt 10 (* 3 log-val)))))))
(that-part (remainder val
(inexact->exact
(truncate
(+ .00001 (expt 10 (* 3 log-val))))))))
(if (> this-part 0)
(set! current-string
(string-append (integer-to-words this-part)
" " (vector-ref big-numbers log-val))))
(if (> that-part 0)
(set! current-string
(string-append current-string
" " (integer-to-words that-part))))
current-string)))))
;; return a string with the number properly truncated and zero padded
;; for check printing
(define (printable-value val frac-denom)
(let* ((int-part (inexact->exact (truncate val)))
(frac-part (inexact->exact
(truncate
(+ (/ .5 frac-denom) (* frac-denom
(- val int-part)))))))
(with-output-to-string
(lambda ()
(write int-part) (display ".")
(if (< frac-part 10) (display "0"))
(write frac-part)))))
(define (number-to-words val frac-denom)
(let* ((negative?
(if (< val 0)
(begin (set! val (- val))
#t)
#f))
(int-part (inexact->exact (truncate val)))
(frac-part (inexact->exact
(truncate
(+ (/ .5 frac-denom) (* frac-denom (- val int-part))))))
(result-string ""))
(set! result-string
(string-append (integer-to-words int-part) " and "
(with-output-to-string
(lambda ()
(write frac-part)
(display "/")
(write frac-denom)))))
(string-set! result-string 0
(char-upcase (string-ref result-string 0)))
result-string))

216
src/scm/printing/print-check.scm
View File

@ -1,216 +0,0 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; print-check.scm
;;; print a check from a transaction.
;;;
;;; Copyright 2000 Bill Gribble <grib@billgribble.com>
;;; June 2004 - D. Reiser - added capability to print wallet checks
;;; with left-side stubs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(use-modules (gnucash printing number-to-words))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <print-check-format> class
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define <print-check-format>
(make-simple-class
'print-check-format
'(format
position
date-format
custom-info)))
(define print-check-format?
(record-predicate <print-check-format>))
(define print-check-format:format
(simple-obj-getter <print-check-format> 'format))
(define print-check-format:set-format!
(simple-obj-setter <print-check-format> 'format))
(define print-check-format:position
(simple-obj-getter <print-check-format> 'position))
(define print-check-format:set-position!
(simple-obj-setter <print-check-format> 'position))
(define print-check-format:date-format
(simple-obj-getter <print-check-format> 'date-format))
(define print-check-format:set-date-format!
(simple-obj-setter <print-check-format> 'date-format))
(define print-check-format:custom-info
(simple-obj-getter <print-check-format> 'custom-info))
(define print-check-format:set-custom-info!
(simple-obj-setter <print-check-format> 'custom-info))
(define (make-print-check-format fmt pos dateformat cust)
(let ((retval (make-simple-obj <print-check-format>)))
(print-check-format:set-format! retval fmt)
(print-check-format:set-position! retval pos)
(print-check-format:set-date-format! retval dateformat)
(print-check-format:set-custom-info! retval cust)
retval))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; stock formats
;; units for stock formats and positions are points (72/inch)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define gnc:*stock-check-formats*
'((deluxe . ((payee . (126.0 147.0))
(amount-words . (90.0 125.0))
(amount-number . (395.0 147.0))
(date . (343.0 178.0))
(memo . (100.0 73.0))
(rotate . 90.0)
(translate . (232.0 300.0))
(offset . 0.0))) ;;declaration of offset preempts top/middle/bottom dialog choice
(quicken . ((payee . (90.0 150.0))
(amount-words . (90.0 120.0))
(amount-number . (500.0 150.0))
(date . (500.0 185.0))
(memo . (50.0 40.0))
(top . 540.0)
(middle . 288.0)
(bottom . 36.0)))
(wallet . ((payee . (231.0 140.0)) ;;these coord. for placement above amount-word line
;;use 202.0 94.0 for placement in address area
(amount-words . (195.0 125.0))
(amount-number . (518.0 137.0))
(date . (504.0 151.0))
(memo . (216.0 37.0))
(date-stub . (36.0 151.0))
(payee-stub . (28.0 126.0))
(amount-stub . (50.0 90.0))
(memo-stub . (28.0 65.0))
(top . 588.0)
(middle . 384.0)
(bottom . 180.0)))
(custom . ((top . 540.0) ;;set default perforation location for custom print layout
(middle . 288.0)
(bottom . 36.0)))
))
(define (gnc:print-check format-info payee amount date memo)
(let* ((int-part (inexact->exact (truncate amount)))
(frac-part (inexact->exact
(truncate
(+ (/ .5 100) (* 100 (- amount int-part))))))
(ps (gnc-print-session-create #t))
(format #f)
(offset #f)
(date-string "")
(payee-stub-text "")
(memo-stub-text ""))
(if (not (null? ps))
(begin
(if (not (eq? (print-check-format:format format-info) 'custom))
(begin
(set! format (assq (print-check-format:format format-info)
gnc:*stock-check-formats*))
(if (pair? format)
(begin
(set! format (cdr format))
(let ((off (assq 'offset format)))
(if off (set! offset (cdr off)))))))
(set! format (print-check-format:custom-info format-info)))
(if (not (eq? (print-check-format:format format-info) 'custom))
(begin
(if (not (or offset (eq? (print-check-format:position format-info) 'custom)))
(begin
(set! offset
(cdr (assq (print-check-format:position format-info)
(cdr (assq (print-check-format:format format-info)
gnc:*stock-check-formats*)))))
(if (pair? offset)
(set! offset (cdr offset))))
(set! offset
(caddr (assq 'translate
(print-check-format:custom-info format-info))))))
(set! offset 0.0))
(let ((fmt (print-check-format:date-format format-info)))
(begin
(set! date-string (strftime fmt (localtime date)))))
(display "offset is ") (display offset) (newline)
(let ((translate-pos (assq 'translate format)))
(if translate-pos
(begin
(display "translate by ") (display (cadr translate-pos))
(display " ") (display (caddr translate-pos)) (newline)
(gnc-print-session-translate ps (cadr translate-pos)
(caddr translate-pos)))))
(let ((rotate-angle (assq 'rotate format)))
(if rotate-angle (gnc-print-session-rotate ps (cdr rotate-angle))))
(let ((date-pos (assq 'date format)))
(gnc-print-session-moveto ps (cadr date-pos)
(+ offset (caddr date-pos)))
(gnc-print-session-text ps date-string))
(let ((payee-pos (assq 'payee format)))
(gnc-print-session-moveto ps (cadr payee-pos)
(+ offset (caddr payee-pos)))
(gnc-print-session-text ps payee))
(let ((number-pos (assq 'amount-number format)))
(gnc-print-session-moveto ps (cadr number-pos)
(+ offset (caddr number-pos)))
(gnc-print-session-text ps (printable-value amount 100)))
(let ((words-pos (assq 'amount-words format)))
(gnc-print-session-moveto ps (cadr words-pos)
(+ offset (caddr words-pos)))
(gnc-print-session-text ps (number-to-words amount 100)))
(if (not (eq? (print-check-format:format format-info) 'wallet))
(let ((memo-pos (assq 'memo format)))
(gnc-print-session-moveto ps (cadr memo-pos)
(+ offset (caddr memo-pos)))
(gnc-print-session-text ps memo)))
(if (eq? (print-check-format:format format-info) 'wallet)
(begin
(let ((memo-pos (assq 'memo format)))
(gnc-print-session-moveto ps (cadr memo-pos)
(+ offset (caddr memo-pos)))
(if (< (string-length memo) 28)
(gnc-print-session-text ps memo)
(gnc-print-session-text ps (substring memo 0 27))))
(let ((memostub-pos (assq 'memo-stub format)))
(gnc-print-session-moveto ps (cadr memostub-pos)
(+ offset (caddr memostub-pos)))
(if (< (string-length memo) 22)
(set! memo-stub-text memo)
(set! memo-stub-text (substring memo 0 20)))
(gnc-print-session-text ps memo-stub-text))
(let ((datestub-pos (assq 'date-stub format)))
(gnc-print-session-moveto ps (cadr datestub-pos)
(+ offset (caddr datestub-pos)))
(gnc-print-session-text ps date-string))
(let ((payeestub-pos (assq 'payee-stub format)))
(gnc-print-session-moveto ps (cadr payeestub-pos)
(+ offset (caddr payeestub-pos)))
(if (< (string-length payee) 22)
(set! payee-stub-text payee)
(set! payee-stub-text (substring payee 0 20)))
(gnc-print-session-text ps payee-stub-text))
(let ((amountstub-pos (assq 'amount-stub format)))
(gnc-print-session-moveto ps (cadr amountstub-pos)
(+ offset (caddr amountstub-pos)))
(gnc-print-session-text ps (printable-value amount 100)))))
(gnc-print-session-done ps)))))