OHM.hp42s

@ Registers and flags used:
@ REG 01: value during input
@ REG 02: multiplier
@ REG 03: final resistor value
@ REG 04: temporary value storage
@ FLAG 01: multiplier color given flag
LBL "OHM"
0
STO 01			@ clear input value register
STO 02			@ clear multiplier register
STO 03			@ clear resistor value register
CF 01			@ no multiplier color is yet given
LBL A			@ first menu page
	"Blck"
	KEY 1 XEQ 01
	"Brwn"
	KEY 2 XEQ 02
	"Red"
	KEY 3 XEQ 03
	"Orng"
	KEY 4 XEQ 04
	"Yllw"
	KEY 5 XEQ 05
	"Grn"
	KEY 6 XEQ 06
	KEY 7 GTO B	@ up key
	KEY 8 GTO B	@ down key
	KEY 9 GTO 99	@ exit key
	CLA
	AVIEW
	XEQ 30		@ recover display string in ALPHA register
	MENU
LBL 20			@ keep the menu even if R/S is pressed
	STOP
	GTO 20
LBL B			@ second menu page
	"Blue"
	KEY 1 XEQ 07
	"Vlt"
	KEY 2 XEQ 08
	"Grey"
	KEY 3 XEQ 09
	"Wht"
	KEY 4 XEQ 10
	"Slvr"
	KEY 5 XEQ 11
	"Gold"
	KEY 6 XEQ 12
	KEY 7 GTO A	@ up key
	KEY 8 GTO A	@ down key
	KEY 9 GTO 99	@ exit key
	CLA
	AVIEW
	XEQ 30		@ recover display string in ALPHA register
	MENU
LBL 21			@ keep the menu even if R/S is pressed
	STOP
	GTO 21
LBL 01			@ Black -> 0
	10
	STO× 01
	0
	STO+ 01
	XEQ 30
	RTN
LBL 02			@ Brown -> 1
	10
	STO× 01
	1
	STO+ 01
	XEQ 30
	RTN
LBL 03			@ Red -> 2
	10
	STO× 01
	2
	STO+ 01
	XEQ 30
	RTN
LBL 04			@ Orange -> 3
	10
	STO× 01
	3
	STO+ 01
	XEQ 30
	RTN
LBL 05			@ Yellow -> 4
	10
	STO× 01
	4
	STO+ 01
	XEQ 30
	RTN
LBL 06			@ Green -> 5
	10
	STO× 01
	5
	STO+ 01
	XEQ 30
	RTN
LBL 07			@ Blue -> 6
	10
	STO× 01
	6
	STO+ 01
	XEQ 30
	RTN
LBL 08			@ Violet -> 7
	10
	STO× 01
	7
	STO+ 01
	XEQ 30
	RTN
LBL 09			@ Grey -> 8
	10
	STO× 01
	8
	STO+ 01
	XEQ 30
	RTN
LBL 10			@ White -> 9
	10
	STO× 01
	9
	STO+ 01
	XEQ 30
	RTN
LBL 11			@ Silver -> ×0.01
	0.01
	STO 02
	SF 01		@ set flag 1 to remember that multiplier is set
	XEQ 30
	RTN
LBL 12			@ Gold -> ×0.1
	0.1
	STO 02
	SF 01		@ set flag 1 to remember that multiplier is set
	XEQ 30
	RTN
LBL 30			@ assemble and display resistor value
	RCL 01		@ recall main value
	STO 03		@ tentatively store it as final value
	RCL 02		@ recall multiplier (important if FS? below is false)
	FS? 01		@ is a multiplier already defined?
		GTO 31	@ yes -> skip multiplier determination
	RCL 01		@ get main value
	10
	÷		@ multiplier is now in fractional part
	ENTER		@ duplicate value
	IP		@ get interger part -> resistor value
	STO 03		@ keep this part of the resistor value
	R↓		@ go back to copy of fractional number
	FP		@ get fractional part -> multiplier
	10
	×		@ recover multiplier as normal number
	10↑X		@ make it into the real multiplier
	STO 02		@ store multiplier for later pretty printing
	LBL 31		@ we now have the multiplier in ST X
	STO× 03		@ multiply the rest of the value to the multiplier -> complete resistor value in REG 03
	RCL 01		@ get color value for a moment
	X>0?		@ already some color selected?
		XEQ 40	@ yes -> reconstruct color string
	AVIEW		@ display what we have so far
	RCL 03		@ return to the actual complete resistor value
	X=0?		@ resistor value > 0 Ohm?
		RTN	@ no -> skip display of resistor value
	XEQ 40		@ reconstruct color string
	├"→ "
	XEQ 45		@ pretty print number with unit prefix
	├"Ohm"
	AVIEW		@ display ALPHA register
	RTN
LBL 40			@ build color string from input value number in REG 01
	CLA		@ clear ALPHA register
	RCL 01		@ put number into ST X
	ENTER
	LOG
	IP
	STO 04		@ remember order of magnitude of leftmost value (will cut initial black rings)
	R↓		@ back at REG 01 number
	ENTER		@ copy that is discarded at first LBL 41 function call
	XEQ 41		@ start recursive reconstruction
	FC? 01		@ additional multiplier color available
		RTN	@ no -> return 
	RCL 02		@ recall multiplier
	0.1
	X=Y?		@ equal 0.1?
		├"GD "	@ gold
	R↓
	0.01
	X=Y?		@ equal 0.01?
		├"SR "	@ siler
	RTN
LBL 41			@ recursively reconstruct color string bast on ST X value
	R↓		@ remove remnant from last LBL 41 function call in recursion
	ENTER		@ copy for next recursion step
	ENTER
	RCL 04		@ magnitude of leftmost value
	10↑X
	÷
	IP		@ have now leftmost value isolated
	XEQ 42		@ find and append name of this color (after RTN: ST X leftmost value, ST Y original value)
	RCL 04		
	10↑X		@ recover value with correct order of magnitude
	×
	-		@ have now leftmost number removed
	1
	STO- 04		@ go to next digit
	R↓		@ make the 1 from above go away
	RCL 04
	X>=0?		@ digits left to process?
		XEQ 41	@ recurse to next digit
	RTN
LBL 42			@ add color name corresponding to value in ST X to ALPHA register
	0
	X=Y?
		├"BK "
	R↓
	1
	X=Y?
		├"BN "
	R↓
	2
	X=Y?
		├"RD "
	R↓
	3
	X=Y?
		├"OG "
	R↓
	4
	X=Y?
		├"YE "
	R↓
	5
	X=Y?
		├"GN "
	R↓
	6
	X=Y?
		├"BU "
	R↓
	7
	X=Y?
		├"VT "
	R↓
	8
	X=Y?
		├"GY "
	R↓
	9
	X=Y?
		├"WH "
	R↓
	RTN
LBL 43			@ determine number of trailing zeros if ST X IP
	0
	STO 04		@ result will be in REG 04
	R↓
	XEQ 44		@ recurse through zeros found
	RCL 04		@ return numbers of zeros in ST X
	RTN		
LBL 44			@ recursively traverse number until no zero is left
	10
	÷
	ENTER		@ duplicate number
	FP
	X>0?		@ fractional part non-zero?
		RTN	@ yes -> done
	R↓		@ return to original number at this resursion level
	1
	STO+ 04		@ increase zero counter by one
	R↓		@ return to at this point integer part of remaining number
	XEQ 44		@ next recursion instance
	RTN		@ done
LBL 45			@ pretty print resistance value that is in REG 03
	RCL 03		@ recall resistance value
	XEQ 43		@ find number of trailing zeros
	3
	÷
	IP		@ exponential prefix number we can apply
	STO 04		@ remember this in REG 04
	3
	X<Y?		@ prefix > Giga?
		STO 04	@ limit prefix to 3
	RCL 03		@ recall resistance value
	RCL 04		@ get prefix number we decided upon
	3
	×
	10↑X
	÷		@ we now have the resistance without the prefix zeros
	AIP		@ put this value to the ALPHA register
	FP
	X=0?		@ do we have a fractional number left?
		GTO 46	@ no -> proceed directly to unit prefix	
	├"."		@ decimal point in case of fractional resistance
	10
	×
	IP
	AIP		@ add one additional digit to the resistance
	LBL 46
	RCL 04		@ get again the prefix number
	0
	X=Y?
		├" "
	R↓
	1
	X=Y?
		├" k"
	R↓
	2
	X=Y?
		├" M"
	R↓
	3
	X=Y?
		├" G"
	RTN
LBL 99			@ exit program cleanly
	CLMENU		@ clear menu definition
	CF 01		@ clear multiplier flag
	EXITALL		@ exit menu system
	CLST		@ the stack is ruined anyway
	RCL 03		@ put resistor value into ST X
	RTN		@ return in case this program was called from somewhere