%%HP: T(1)A(D)F(.);
@ RESISTOR by David J. Sprenkle
DIR
  START.1
    « RCLF ERASE
PICT { # 79d # 0d }
"VALUE" GO PICT RCL
{ # 79d # 12d } "±"
GO { # 75d # 25d }
"BY" GO { # 75d
# 31d }
"DAVID SPRENKLE" GO
{ # 24d # 2d }
"1ST STRIPE" GO {
# 24d # 10d }
"2ND STRIPE" GO {
# 24d # 18d }
"3RD STRIPE" GO {
# 24d # 26d }
"TOLERANCE" GO PICT
STO 0 FIX NUMDISP 0
STRIPEADJ MENUADJ {
# 0d # 0d } PVIEW
MLOOP DROP STOF
    »
  PPAR {
(-6.5,-3.1)
(6.5,3.2) X 0 (0,0)
FUNCTION Y }
  INPR
    « DUP 5 ‰
      « 11.1 + 2
      »
      « 5.1 + 3
      » IFTE 'MROW'
STO COLOR
    »
  ENTEV
    «
"Enter the resistor
value."
{ V } INPUT STRŤ 1
SCI ŤSTR STRŤ 0 FIX
DUP MANT DUP IP DUP 
'STRIPE(1)' STO 1
'RROW' STO INPR FP
10 * DUP 'STRIPE(2)
' STO 2 'RROW' STO
INPR XPON DUP '
STRIPE(3)' STO 1 -
3 'RROW' STO DUP -1
‰
      « ABS 9 +
      » IFT INPR 0
STRIPEADJ NUMDISP {
# 0d # 0d } PVIEW 1
'MROW' STO 1 'RROW'
STO 0 STRIPEADJ
    »
  COLOR
    «
      IF DUP 15.1 Š
RROW 3 Š MROW 3 ==
AND AND
      THEN
        IF 15.1 ==
        THEN {
# 88d # 17d } {
# 108d # 22d }
GROB 12 6 710014007200410074000000
COL1
        ELSE {
# 110d # 17d } {
# 129d # 22d }
GROB 12 6 321025402520251072400000
COL1
        END
      ELSE
        IF DUP 15.1
< MROW 2 == OR RROW
4 < AND
        THEN 10.1 -
Ť a
          «
MENUKEYS a 22 * -21
+ RŤB MROW 2 - 8 *
9 + RŤB 2 ŤLIST DUP
OBJŤ DROP 5 + SWAP
18 + SWAP 2 ŤLIST
SUB STRIPES # 1d
RROW 8 * 7 - RŤB 2
ŤLIST ROT REPL
'STRIPES' STO a
MROW 2 - 6 * + '
STRIPE(RROW)' STO
          »
        ELSE DROP
        END
      END
    »
  NUMDISP
    « 'STRIPE(1)' 1
- 10 * 'STRIPE(2)'
1 - + 10 'STRIPE(3)
' 1 - ^ * ŤNUM DUP
990 ‰
      « STD 1 ŤGROB
0 FIX
      »
      « 1 ŤGROB
      » IFTE PICT {
# 79d # 6d } # 52d
# 5d BLANK REPL
PICT { # 79d # 6d }
ROT REPL PICT {
# 84d # 12d } '
STRIPE(4)' EVAL
REPL
    »
  STRIPEADJ
    « 'RROW' STO+
      IF RROW 1 <
      THEN 4 'RROW'
STO
      END
      IF RROW 4 >
      THEN 1 'RROW'
STO
      END PICT {
# 0d # 0d } STRIPES
REPL PICT # 0d 8
RROW 1 - * RŤB 2
ŤLIST BLSTRIPE GXOR
    »
  BLSTRIPE
GROB 23 9 FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7FFFFF7
  STRIPES
GROB 23 33 FFFFF7100004DCC544555544DC4554555D64D4D544100004FFFFF71000049901349A8A04998B049A8A0499B234100004FFFFF710000416E6041A2A0416EA041A2A041AE604100004FFFFF7100004100004100004100004100004100004100004FFFFF7
  STRIPE { 2 1 3
GROB 12 6 721045407520151072400000
}
  MENUKEYS
GROB 131 25 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7010000000000000000000080000020000401E2DDD0CC9567730521578075D122D164012694414544125505515180159026511401EE9CD0CC9422530571578072902E5114012A9441450542550251518015902A511401E29C514DD4327502577780759022D16401000000000000000000008000002000040FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7010000200008000002000080000020000409901323371906E602732988AB802E6EE409A8A02555190A2A02555B88A88021A2240998B023355906EA02537F809B802D6EE409A8A02555B90A2A02555D80988029A224099B232357190AE6027559809BB32EAEE401000020000800000200008000002000040FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF701000020000800000200008000002000040998A325D5C98B192A8AABB077132CA82409A8A025554848AA2A8A2988051522A8240998A32555C94B931AAE29B8651524A82409A8A02255484AA21ADA2988451528A014099BB322DDD98BA21A8A29B0777326A31401000020000800000200008000002000040FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70
  MENUADJ
    «
      IF MROW 1 <
      THEN 3 'MROW'
STO
      END
      IF MROW 3 >
      THEN 1 'MROW'
STO
      END PICT {
# 0d # 39d }
MENUKEYS REPL PICT
# 0d MROW 8 * 31 +
RŤB 2 ŤLIST BLANK.1
GXOR
    »
  MLOOP
    «
      WHILE 0 WAIT
DUP 15.1 ‹ MROW 1 ‹
OR
      REPEAT
        IF DUP 20 Š
        THEN
          CASE DUP
25.1 ==
            THEN -1
STRIPEADJ
            END DUP
35.1 ==
            THEN 1
STRIPEADJ
            END DUP
26.1 ==
            THEN
'MROW' 1 STO-
MENUADJ
            END
          END DROP
        ELSE
          IF MROW 2
Š
          THEN
COLOR 1 STRIPEADJ
NUMDISP
          ELSE
            CASE
DUP 14.1 ‰
              THEN
ENTEV
              END
DUP 16.1 == RROW 4
== AND
              THEN
STRIPES { # 2d
# 25d } # 19d # 6d
BLANK REPL
'STRIPES' STO
GROB 12 6 721045407520151072400000 
'STRIPE(4)' STO 1
STRIPEADJ NUMDISP
              END
            END
DROP
          END
        END
      END
    »
  RROW 4
  MROW 1
  BLANK.1
GROB 131 8 FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF70
  GO
    « 1 ŤGROB REPL
    »
  COL1
    « Ť a b c
      « MENUKEYS a
b SUB STRIPES # 1d
RROW 8 * 7 - RŤB 2
ŤLIST ROT REPL
'STRIPES' STO RROW
4 == c 0 IFTE '
STRIPE(RROW)' STO
      »
    »
END