[comp.sys.handhelds] HP48SX Program Examples

jimd@hpcvra.CV.HP.COM (Jim Donnelly) (03/09/90)

The programs in Chapter 31 of the HP48SX Owner's Manual
are presented below in ascii down-loadable form.  Each program
should be placed in a unique file, without the comment
line that contains the title.

Jim Donnelly
Hewlett-Packard
jimd@cv.hp.com

# FIB1
%%HP: T(3)A(D)F(.);
\<< \-> n 'IFTE(n\<=1,n,FIB1(n-1)+FIB1(n-2))' \>>

# FIB2
%%HP: T(3)A(D)F(.);
\<< \-> n
\<<
  IF n 1 \<= THEN n ELSE 0 1 2 n START DUP ROT + NEXT SWAP DROP END
\>>
\>>

# FIBT
%%HP: T(3)A(D)F(.);
\<<
DUP TICKS SWAP FIB1 SWAP TICKS SWAP - B\->R
8192 / "FIB1 TIME" \->TAG ROT TICKS SWAP FIB2 TICKS SWAP
DROP SWAP - B\->R 8192 / "FIB2 TIME" \->TAG
\>>

# PAD
%%HP: T(3)A(D)F(.);
\<<
\->STR WHILE DUP SIZE 22 < REPEAT " " SWAP + END
\>>

# PRESERVE
%%HP: T(3)A(D)F(.);
\<< RCLF \-> f
\<< EVAL f STOF \>>
\>>

# BDISP
%%HP: T(3)A(D)F(.);
\<< \<< DUP -55 CF IFERR R\->B THEN END \-> n
\<< CLLCD \<< BIN \>> \<< OCT \>> \<< DEC \>> \<< HEX \>>
1 4 FOR j EVAL n \->STR PAD j DISP NEXT \>> 3 FREEZE \>> PRESERVE \>>

# SORT
%%HP: T(3)A(D)F(.);
\<< DUP SIZE 1 - 1 FOR j 1 j FOR k k GETI \-> n1
\<< GETI \-> n2
\<< DROP IF n1 n2 > THEN k n2 PUTI n1 PUT END \>> \>> NEXT -1 STEP \>>

# LMED
%%HP: T(3)A(D)F(.);
\<< DUP SIZE 1 + 2 / \-> p \<< DUP p FLOOR GET SWAP p CEIL
GET + 2 / \>> \>>

# MEDIAN
%%HP: T(3)A(D)F(.);
\<< RCL\GS DUP SIZE OBJ\-> DROP \-> n m
\<< '\GSDAT' TRN 1 m FOR j \GS- OBJ\-> DROP
n \->LIST SORT LMED j ROLLD NEXT m \->ARRY \>> SWAP STO\GS \>>

# MULTI
%%HP: T(3)A(D)F(.);
\<< \-> p \<< DO DUP p EVAL DUP ROT UNTIL SAME END \>> \>>

# EXCO
%%HP: T(3)A(D)F(.);
\<< \<< EXPAN \>> MULTI \<< COLCT \>> MULTI \>>

# MNX
%%HP: T(3)A(D)F(.);
\<< { { "MAX" \<< 10 SF CONT \>> }
{ "MIN" \<< 10 CF CONT \>> } }
TMENU "Sort for MAX or MIN?"
PROMPT 1 GETI DO ROT ROT GETI 4 ROLL DUP2 IF > 10 FS? XOR THEN
SWAP END DROP UNTIL -64 FS? END SWAP DROP 0 MENU \>>

# MNX2
%%HP: T(3)A(D)F(.);
\<< { { "MAX" \<< 10 SF CONT \>> } { "MIN" \<< 10 CF CONT \>> } }
TMENU "Sort for MAX or MIN?" PROMPT DUP OBJ\-> 1 SWAP OBJ\->
DROP * 1 - FOR n DUP2 IF > 10 FS? XOR THEN SWAP END DROP NEXT 0 MENU \>>

# NAMES
%%HP: T(3)A(D)F(.);
\<< IF OBJ\-> DUP 2 SAME THEN DROP IF TYPE 6 SAME SWAP TYPE 6 SAME
AND NOT THEN "List needs two names" DOERR END ELSE DROPN
"Illegal list size" DOERR END \>>

# VFY
%%HP: T(3)A(D)F(.);
\<< DUP DTAG \-> arg \<< CASE arg TYPE 5 SAME THEN arg NAMES END
arg TYPE 6 SAME NOT THEN "Not name or list" DOERR END END \>> \>>

# BER
%%HP: T(3)A(D)F(.);
\<< \-> x \<< 1 2 9.E499 FOR j DUP
'(-1)^(j/2)*(x/2)^(2*j)/SQ(j!)' EVAL + IF DUP ROT \=/ THEN 2 ELSE 9.1E499 END
STEP \>> \>>

# SINTP
%%HP: T(3)A(D)F(.);
\<< 'X' PURGE 'SIN(X)' STEQ -2 2 YRNG ERASE DRAW
PICT RCL 'SINT' STO \>>
%%HP: T(3)A(D)F(.);
\<< TSL OBJ\-> 1 SWAP FOR s ERASE \->LCD 1 WAIT NEXT \>>

# SETTS
%%HP: T(3)A(D)F(.);
\<< SINTP 17 1 FOR x x 'X' DUP SIN SWAP ROT TAYLR STEQ ERASE DRAW
PICT RCL SINT + -2 STEP SINT 10 \->LIST 'TSL' STO \>>

# TSA
%%HP: T(3)A(D)F(.);
\<< TSL OBJ\-> 1 SWAP FOR s ERASE \->LCD 1 WAIT NEXT \>>

# PIE
%%HP: T(3)A(R)F(.);
\<< RCLF \-> flags \<< RAD { { "SLICE" \GS+ } { }
{ "CLEAR" CL\GS } { } { } { "DRAW" CONT } } TMENU
"Key values into SLICE,
DRAW restarts program."
PROMPT ERASE 1 131 XRNG 1 64 YRNG CLLCD
"Please wait.....
Drawing Pie Chart"
1 DISP (66,32) 20 0 6.28 ARC PICT RCL \->LCD RCL\GS TOT / DUP
100 * \-> prcnts \<< 2 \pi \->NUM * * 0 \-> prop angle
      \<< prop SIZE OBJ\-> DROP SWAP FOR x
(66,32) prop x GET 'angle' STO+ angle COS LASTARG SIN R\->C
20 * OVER + LINE PICT RCL angle prop x GET 2 / - DUP COS
LASTARG SIN R\->C 26 * (66,32) + SWAP DUP CASE 1.5 \<= THEN DROP END DUP
4.4 \<= THEN DROP 15 - END 5 < THEN (3,2) + END END
prcnts x GET 1 RND \->STR "%" + 1 \->GROB GOR DUP PICT STO
\->LCD NEXT { } PVIEW \>> \>> flags STOF \>> 2 MENU \>>

# WALK
%%HP: T(3)A(D)F(.);
\<< GROB 9 15 E300140015001C001400E3008000C110AA00940090004100220014102800
\-> man \<<
ERASE { # 0d # 0d } PVIEW { # 0d # 25d } PICT OVER man GXOR 5 MAXR
FOR i i 131 MOD R\->B # 25d 2 \->LIST PICT OVER man GXOR
PICT ROT man GXOR 5 STEP \>> \>>