From helens!relgyro!shelby!decwrl!ucbvax!ucsd!usc!zaphod.mps.ohio-state.edu!rpi!uupsi!sunic!kth.se!draken!d88-jwa Wed Jun 20 17:34:43 PDT 1990
Status: RO
Article 1976 of comp.sys.handhelds:
Path: helens!relgyro!shelby!decwrl!ucbvax!ucsd!usc!zaphod.mps.ohio-state.edu!rpi!uupsi!sunic!kth.se!draken!d88-jwa
>From: d88-jwa@nada.kth.se (Jon W{tte)
Newsgroups: comp.sys.handhelds
Subject: CASH.01B - cash management application directory
Keywords: cash management, application, CASH, HP 48SX
Message-ID: <1990Jun20.203235.14807@nada.kth.se>
Date: 20 Jun 90 20:32:35 GMT
Reply-To: d88-jwa@nada.kth.se (Jon W{tte)
Organization: Royal Institute of Technology, Stockholm, Sweden
Lines: 260
Here you are. BE SURE to read the copyright notice
included in the file CASH.01B.TXT distributed together
with this file. In short, you may use and distribute this
application as much as you want, as long as you always
include the documentation file, and do not change neither
the application nor the documentation.
Enjoy !
h+@nada.kth.se
--- Start file CASH.01B ---
@ This is copyrighted software
@ Be sure not to distribute it
@ without the documentation.
@ Copyright 1990 Jon Watte
%%HP: T(3)A(R)F(.);
DIR
VER
\<< 1000 .1 BEEP
CLLCD
"
CASH by Jon W\228tte
h+@nada.kth.se
Version 0.1b"
1 DISP -1 WAIT DROP
CST TMENU
\<< CLLCD 1
DISP KOF
\>> \-> X
\<<
"Reset data ?"
IF X EVAL
THEN { }
'KBEL' STO CBEL DUP
SIZE
DO SWAP
OVER 0 PUT SWAP 2 -
UNTIL DUP
2 <
END DROP
'CBEL' STO
END
"Reset archive ?"
IF X EVAL
THEN { ARCH
} EVAL VARS PURGE
UPDIR
END
"Reset setup ?"
IF X EVAL
THEN { }
'CBEL' STO { }
'KBEL' STO { }
'CST' STO
END
\>>
\>>
KADD
\<< \-> I S
\<< CBEL S + 0
+ 'CBEL' STO CST 0
+ "{ " 34 CHR + S +
34 CHR + " { \<< " 34
CHR + + I + 34 CHR
+ " TRANS \>> \<< " 34
CHR + + I + 34 CHR
+ " KORR\>> \<< CBEL "
34 CHR + + I + 34
CHR +
"POS CBEL SWAP 1 +
GET\>> }"
+ STR\-> OVER SIZE
SWAP PUT 'CST' STO
\>>
\>>
BOOK
\<< CBEL KBEL {
ARCH } EVAL CDATE
"'A" SWAP + "'" +
OBJ\-> STO CDATE "'B"
SWAP + "'" + OBJ\->
STO UPDIR CBEL KBEL
{ } 'KBEL' STO CBEL
DUP SIZE
DO SWAP OVER
0 PUT SWAP 2 -
UNTIL DUP 2 <
END 'CBEL'
STO SUMUP
\>>
CDATE
\<< DATE DUP IP
SWAP FP DUP 100 *
IP 100 * SWAP 10000
* FP 1000000 * + +
\>>
SUMUP
\<< DUP SIZE \-> C
K S
\<< {
"Sum of period" } K
1 GET 1 GET \->STR
" - " + K S GET 1
GET \->STR + + C SIZE
\-> Z
\<< 1
DO C OVER
GET " " + SWAP 1 +
C OVER GET ROT SWAP
+ ROT SWAP + SWAP 1
+
UNTIL DUP
Z >
END DROP
DUP { ARCH } EVAL
"'C" CDATE + "'" +
OBJ\-> STO UPDIR LESS
\>>
\>>
\>>
LESS
\<< DUP SIZE \-> P
S
\<< 1
DO 0
WHILE DUP
7 <
REPEAT
DUP2 +
IF DUP
S \<=
THEN P
SWAP GET
ELSE
DROP ""
END
SWAP 1 + SWAP OVER
DISP
END DROP
3 FREEZE 0
DO DROP
-1 WAIT IP
UNTIL DUP
{ 25 34 35 36 51 85
95 } SWAP POS
END { 25
34 35 36 51 85 95 }
SWAP POS {
\<<
IF DUP
1 >
THEN 1
-
END
\>>
\<< DROP 1
\>>
\<<
IF DUP
S <
THEN 1
+
END
\>>
\<< DROP S
\>>
\<< DROP -1
\>>
\<< 5 -
IF DUP
1 <
THEN
DROP 1
END
\>>
\<< 5 +
IF DUP
S >
THEN
DROP S
END
\>> } SWAP
GET EVAL
UNTIL DUP
-1 ==
END DROP
\>>
\>>
CST { }
KOF
\<< { "YES" "" ""
"" "" "NO" } TMENU
0
DO 500 .1
BEEP DROP -1 WAIT
IP
UNTIL DUP 11
== OVER 16 == +
END 11 == CST
TMENU
\>>
CKORR
\<< \-> P S
\<< KBEL S 1
GET S 3 GET CLLCD
"Delete transaction ?"
1 DISP S 2 GET ": "
+ SWAP + 2 DISP 3
DISP
IF KOF
THEN DUP
DUP 1 P 1 - SUB
SWAP SIZE ROT P 1 +
ROT SUB + 'KBEL'
STO CBEL S 2 GET
POS 1 + CBEL SWAP
DUP2 GET S 3 GET -
PUT 'CBEL' STO
ELSE DROP
END
\>>
\>>
KORR
\<< KBEL CBEL \-> S
K C
\<< K SIZE
WHILE DUP
REPEAT K
OVER GET
IF DUP S
POS
THEN
CKORR 1 0
END DROP
1 -
END DROP
\>>
\>>
CBEL { }
KBEL { }
TRANS
\<< \-> A S
\<< A S { }
CDATE + SWAP + SWAP
+ KBEL 0 + SWAP
OVER SIZE SWAP PUT
'KBEL' STO CBEL DUP
S POS 1 + DUP2 GET
A + PUT 'CBEL' STO
\>>
\>>
ARCH
DIR
END
END
--
Jon W{tte, Stockholm, Sweden, h+@nada.kth.se
