Clone of old TI Programmer's calculator. Written in XB with TiCodEd. Codex helped too.

Available in the downloads section!

  ! TI-PROG - TI PROGRAMMER FOR TI-99/4A EXTENDED BASIC
  ! KEYBOARD-DRIVEN LED PROGRAMMER CALCULATOR, 2026
  ! ORIGINAL TI PROGRAMMER FUNCTIONS: DEC/OCT/HEX, MEM,
  ! CONSTANT, PARENTHESES, 1'S COMPLEMENT, SHF, OR, AND, XOR.
  ! BY BRAD SNYDER AND CODEX 8/26/26
  DIM V(15):: DIM O$(15)::VR$="V1.02"
  ON BREAK NEXT
  B=10 :: GOSUB SET_BASE_PARAMS
  ANS=0 :: MEM=0 :: MH=0 :: E$="" :: NE=0 :: ER=0 :: BAD=0
  VT=-1 :: OT=-1 :: AFTER=0 :: LAST$="" :: LVAL=0
  KRDY=0 :: KOP$="" :: KVAL=0 :: KP=0 :: MSG$="READY"
  SDIRTY=0 :: MBAD=-1 :: BFLAG=0
  KSND=1 :: DBEEP=1 :: GOSUB CONFIG_MENU
  GOSUB DRAW_CALC
  GOSUB DRAW_LED_AND_STATUS

KEY_LOOP:
  CALL KEY(3,KEY,ST)
  IF ST<>1 THEN KEY_LOOP
  GOSUB MAIN_ENTRY
  GOTO KEY_LOOP

  ! ----- KEY DISPATCH -----
  ! 0-9
KEY_DISPATCH:
  IF KEY<48 THEN DISPATCH_HEX_DIGIT
  IF KEY>57 THEN DISPATCH_HEX_DIGIT
  D$=CHR$(KEY):: GOSUB ADD_DIGIT :: RETURN 

  ! A-F, UPPER CASE (CALL KEY(3,...) RETURNS UPPER CASE)
DISPATCH_HEX_DIGIT:
  IF KEY<65 THEN DISPATCH_COMMAND
  IF KEY>70 THEN DISPATCH_COMMAND
  D$=CHR$(KEY):: GOSUB ADD_DIGIT :: RETURN 

  ! OPERATORS AND PUNCTUATION
DISPATCH_COMMAND:
  IF KEY=43 THEN P$="+" :: GOSUB ACCEPT_OPERATOR :: RETURN 
  IF KEY=45 THEN P$="-" :: GOSUB ACCEPT_OPERATOR :: RETURN 
  IF KEY=42 THEN P$="*" :: GOSUB ACCEPT_OPERATOR :: RETURN 
  IF KEY=47 THEN P$="/" :: GOSUB ACCEPT_OPERATOR :: RETURN 
  IF KEY=61 THEN GOSUB EQUALS :: RETURN 
  IF KEY=13 THEN GOSUB EQUALS :: RETURN 
  IF KEY=40 THEN GOSUB OPEN_PAREN :: RETURN 
  IF KEY=41 THEN GOSUB CLOSE_PAREN :: RETURN 
  IF KEY=46 THEN GOSUB DECIMAL_POINT :: RETURN 
  IF KEY=8 THEN GOSUB CLEAR_ENTRY :: RETURN 
  IF KEY=15 THEN CALL CLEAR ::PRINT "* TI PROGRAMMER ";VR$;" *":: STOP
  ! Z=DEC, H=HEX, O=OCT, L=CLEAR
  IF KEY=90 THEN NB=10 :: GOSUB CHANGE_BASE :: RETURN 
  IF KEY=72 THEN NB=16 :: GOSUB CHANGE_BASE :: RETURN 
  IF KEY=79 THEN NB=8 :: GOSUB CHANGE_BASE :: RETURN 
  IF KEY=76 THEN GOSUB ALL_CLEAR :: RETURN 
  ! S=STO, R=RCL, U=SUM, K=CONSTANT
  IF KEY=83 THEN GOSUB STORE_MEMORY :: RETURN 
  IF KEY=82 THEN GOSUB RECALL_MEMORY :: RETURN 
  IF KEY=85 THEN GOSUB SUM_MEMORY :: RETURN 
  IF KEY=75 THEN GOSUB SET_CONSTANT :: RETURN 
  ! Q=SHF, W=OR, I=AND, Y=XOR, V=1'S C, T=+/-
  IF KEY=81 THEN P$="S" :: GOSUB ACCEPT_OPERATOR :: RETURN 
  IF KEY=87 THEN P$="O" :: GOSUB ACCEPT_OPERATOR :: RETURN 
  IF KEY=73 THEN P$="A" :: GOSUB ACCEPT_OPERATOR :: RETURN 
  IF KEY=89 THEN P$="X" :: GOSUB ACCEPT_OPERATOR :: RETURN 
  IF KEY=86 THEN GOSUB ONES_COMPLEMENT :: RETURN 
  IF KEY=84 THEN GOSUB TOGGLE_SIGN :: RETURN 
  BAD=1 :: MSG$="KEY?" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ENTRY POINT USED BY THE MAIN LOOP
  ! SHORT KEYPRESS CLICK
MAIN_ENTRY:
  IF KSND=0 THEN SKIP_KEY_SOUND
  CALL SOUND(40,-7,10)

SKIP_KEY_SOUND:
  BAD=0::GOTO KEY_DISPATCH

  ! ----- ADD ONE DIGIT IN D$ -----
ADD_DIGIT:

  IF ER=0 THEN CHECK_DEC_DIGIT
  GOSUB ALL_CLEAR
  ER=0

CHECK_DEC_DIGIT:
  IF B=16 THEN CHECK_OCT_DIGIT
  IF ASC(D$)<58 THEN CHECK_OCT_DIGIT
  BAD=1 :: MSG$="DEC ONLY" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

CHECK_OCT_DIGIT:
  IF B<>8 THEN PREPARE_ENTRY
  IF ASC(D$)<56 THEN PREPARE_ENTRY
  BAD=1 :: MSG$="OCT 0-7" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

PREPARE_ENTRY:
  IF NE=1 THEN CHECK_DIGIT_LENGTH
  IF AFTER=0 THEN INIT_ENTRY
  VT=-1 :: OT=-1 :: AFTER=0
  LAST$=""

INIT_ENTRY:
  E$="" :: NE=1 :: SDIRTY=1

CHECK_DIGIT_LENGTH:
  IF LEN(E$)<8 THEN APPEND_DIGIT
  BAD=1 :: MSG$="8 DIGITS" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

APPEND_DIGIT:
  E$=E$&D$ :: MSG$="ENTRY"
  IF OT<0 THEN REDRAW_DIGIT
  IF O$(OT)="S" THEN MSG$="SHF: T=RIGHT"

REDRAW_DIGIT:
  IF MBAD<>0 THEN REDRAW_DIGIT_STATUS
  IF SDIRTY=0 THEN REDRAW_DIGIT_FAST

REDRAW_DIGIT_STATUS:
  BFLAG=1 :: GOSUB DRAW_LED_AND_STATUS :: BFLAG=0 :: SDIRTY=0 :: RETURN

REDRAW_DIGIT_FAST:
  BFLAG=1 :: GOSUB DRAW_LED_VALUE :: BFLAG=0 :: RETURN

  ! ----- ACCEPT A BINARY OPERATOR IN P$ -----
ACCEPT_OPERATOR:
  IF ER=0 THEN CHECK_OPERATOR_MODE
  GOSUB ALL_CLEAR
  ER=0

CHECK_OPERATOR_MODE:
  IF B<>10 THEN PREPARE_OPERATOR
  IF P$="S" THEN BAD=1 :: MSG$="SHF OCT/HEX" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 
  IF P$="O" THEN BAD=1 :: MSG$="OR OCT/HEX" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 
  IF P$="A" THEN BAD=1 :: MSG$="AND OCT/HEX" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 
  IF P$="X" THEN BAD=1 :: MSG$="XOR OCT/HEX" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

PREPARE_OPERATOR:
  IF NE=0 THEN CHECK_OPERATOR_REPLACE

PREPARE_OPERATOR_VALUE:
  IF NE=1 THEN GOSUB PUSH_ENTRY_VALUE
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  IF VT>-1 THEN SET_PENDING_PRECEDENCE
  VT=0 :: V(VT)=ANS
  KP=AFTER
  AFTER=0
  GOTO SET_PENDING_PRECEDENCE

  ! REPLACE AN OPERATOR WHEN ITS RIGHT-HAND VALUE HAS NOT BEEN ENTERED
CHECK_OPERATOR_REPLACE:
  IF OT<0 THEN PREPARE_OPERATOR_VALUE
  IF O$(OT)="(" THEN PREPARE_OPERATOR_VALUE
  O$(OT)=P$ :: GOSUB SET_OPERATOR_STATUS :: AFTER=0
  GOSUB DRAW_LED_AND_STATUS :: RETURN

  ! REDUCE HIGHER-OR-EQUAL PRIORITY OPERATORS
SET_PENDING_PRECEDENCE:
  NP$=P$ :: GOSUB GET_OPERATOR_PRECEDENCE :: NPR=PR

REDUCE_PRECEDENCE:
  IF OT<0 THEN PUSH_OPERATOR
  IF O$(OT)="(" THEN PUSH_OPERATOR
  P$=O$(OT):: GOSUB GET_OPERATOR_PRECEDENCE
  IF PR<NPR THEN PUSH_OPERATOR
  GOSUB APPLY_TOP_OPERATOR
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  GOTO REDUCE_PRECEDENCE

PUSH_OPERATOR:
  OT=OT+1 :: O$(OT)=NP$ :: P$=NP$ :: GOSUB SET_OPERATOR_STATUS :: AFTER=0
  GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! COMMIT E$ AS A VALUE ONTO THE VALUE STACK
PUSH_ENTRY_VALUE:
  GOSUB PARSE_ENTRY
  IF ER=1 THEN RETURN 
  VT=VT+1 :: V(VT)=X :: ANS=X :: NE=0
RETURN

  ! APPLY THE TOP STACK OPERATOR
APPLY_TOP_OPERATOR:
  IF VT>0 THEN POP_OPERATOR_VALUES
  ER=1 :: MSG$="SYNTAX ERR" :: RETURN 

POP_OPERATOR_VALUES:
  AA=V(VT-1):: BB=V(VT):: P$=O$(OT)
  VT=VT-2 :: OT=OT-1
  GOSUB EXECUTE_OPERATOR
  IF ER=1 THEN RETURN 
  VT=VT+1 :: V(VT)=R :: ANS=R
  EXOP$=P$ :: EXVAL=BB
RETURN

  ! OPERATOR PRECEDENCE: OR, XOR, AND, ARITHMETIC, SHIFT
GET_OPERATOR_PRECEDENCE:
  PR=1
  IF P$="O" THEN RETURN 
  IF P$="X" THEN PR=2 :: RETURN 
  IF P$="A" THEN PR=3 :: RETURN 
  IF P$="+" THEN PR=4 :: RETURN 
  IF P$="-" THEN PR=4 :: RETURN 
  IF P$="*" THEN PR=5 :: RETURN 
  IF P$="/" THEN PR=5 :: RETURN 
  PR=6 :: RETURN 

  ! EXECUTE P$ WITH AA (LEFT) AND BB (RIGHT)
EXECUTE_OPERATOR:
  IF P$="+" THEN R=AA+BB :: GOTO NORMALIZE_RESULT
  IF P$="-" THEN R=AA-BB :: GOTO NORMALIZE_RESULT
  IF P$="*" THEN R=AA*BB :: GOTO NORMALIZE_RESULT
  IF P$="/" THEN DIVIDE_VALUES
  GOTO EXECUTE_LOGICAL

DIVIDE_VALUES:
  IF BB<>0 THEN R=AA/BB :: GOTO NORMALIZE_RESULT
  ER=1 :: MSG$="DIV BY 0" :: RETURN 

NORMALIZE_RESULT:
  GOSUB NORMALIZE_RANGE :: RETURN 

  ! LOGICAL AND SHIFT OPERATIONS REQUIRE OCT OR HEX
EXECUTE_LOGICAL:
  IF B<>10 THEN PREPARE_LOGICAL_VALUES
  ER=1 :: MSG$="OCT/HEX" :: RETURN 

PREPARE_LOGICAL_VALUES:
  U=AA :: IF U<0 THEN U=U+W
  Z=BB :: IF Z<0 THEN Z=Z+W
  IF P$="S" THEN EXECUTE_SHIFT
  R=0 :: PW=1
  FOR J=1 TO NBITS
  DA=U-2*INT(U/2):: DB=Z-2*INT(Z/2)
  IF P$="A" THEN DC=DA*DB
  IF P$="O" THEN DC=DA+DB-DA*DB
  IF P$="X" THEN DC=DA+DB-2*DA*DB
  R=R+DC*PW :: U=INT(U/2):: Z=INT(Z/2):: PW=PW*2
  NEXT J
  GOTO CONVERT_RESULT_SIGN

EXECUTE_SHIFT:
  IF BB=INT(BB)THEN CHECK_SHIFT_RANGE
  ER=1 :: MSG$="SHIFT COUNT" :: RETURN 

CHECK_SHIFT_RANGE:
  N=ABS(BB)
  IF N<NBITS+1 THEN EXECUTE_SHIFT_COUNT
  ER=1 :: MSG$="SHIFT RANGE" :: RETURN 

EXECUTE_SHIFT_COUNT:
  R=U :: IF BB<0 THEN SHIFT_RIGHT
  FOR J=1 TO N :: R=R*2-W*INT(R/W):: NEXT J :: GOTO CONVERT_RESULT_SIGN

SHIFT_RIGHT:
  FOR J=1 TO N :: R=INT(R/2):: NEXT J

CONVERT_RESULT_SIGN:
  IF R<W/2 THEN OPERATOR_DONE
  R=R-W

OPERATOR_DONE:
RETURN

  ! ----- EQUALS -----
EQUALS:
  IF ER=0 THEN CHECK_CONSTANT_MODE
  GOSUB DRAW_LED_AND_STATUS :: RETURN 

CHECK_CONSTANT_MODE:
  IF KRDY=0 THEN EVALUATE_EXPRESSION
  IF OT<0 THEN APPLY_CONSTANT
  GOTO EVALUATE_EXPRESSION

APPLY_CONSTANT:
  IF NE=1 THEN GOSUB PARSE_ENTRY ELSE X=ANS
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  AA=X :: BB=KVAL :: P$=KOP$ :: GOSUB EXECUTE_OPERATOR
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  ANS=R :: NE=0 :: VT=-1 :: OT=-1 :: AFTER=1
  LAST$=KOP$ :: LVAL=KVAL :: MSG$="K "&KOP$ :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

EVALUATE_EXPRESSION:
  IF NE=1 THEN GOSUB PUSH_ENTRY_VALUE
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  IF VT>-1 THEN REDUCE_EQUALS
  IF LAST$="" THEN FINISH_RESULT_ONLY
  AA=ANS :: BB=LVAL :: P$=LAST$ :: GOSUB EXECUTE_OPERATOR
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  ANS=R :: MSG$="REPEAT" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

REDUCE_EQUALS:
  IF OT<0 THEN FINISH_EQUALS
  IF O$(OT)<>"(" THEN APPLY_EQUALS_OPERATOR
  ER=1 :: MSG$="MISSING )" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

APPLY_EQUALS_OPERATOR:
  GOSUB APPLY_TOP_OPERATOR :: IF ER=0 THEN REDUCE_EQUALS
  GOSUB DRAW_LED_AND_STATUS :: RETURN 

FINISH_EQUALS:
  ANS=V(VT):: VT=-1 :: OT=-1 :: NE=0 :: AFTER=1
  LAST$=EXOP$ :: LVAL=EXVAL :: MSG$="RESULT" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

FINISH_RESULT_ONLY:
  AFTER=1 :: MSG$="RESULT" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ----- OPEN PARENTHESIS -----
OPEN_PAREN:
  IF NE=0 THEN CHECK_PAREN_SPACE
  ER=1 :: MSG$="OP BEFORE (" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

CHECK_PAREN_SPACE:
  IF OT<15 THEN PUSH_OPEN_PAREN
  ER=1 :: MSG$="PAREN LIMIT" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

PUSH_OPEN_PAREN:
  OT=OT+1 :: O$(OT)="(" :: AFTER=0 :: MSG$="OPEN PAREN" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ----- CLOSE PARENTHESIS -----
CLOSE_PAREN:
  IF NE=1 THEN GOSUB PUSH_ENTRY_VALUE
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 

CLOSE_PAREN_LOOP:
  IF OT>-1 THEN FIND_OPEN_PAREN
  ER=1 :: MSG$="UNMATCHED )" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

FIND_OPEN_PAREN:
  IF O$(OT)="(" THEN FINISH_CLOSE_PAREN
  GOSUB APPLY_TOP_OPERATOR :: IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  GOTO CLOSE_PAREN_LOOP

FINISH_CLOSE_PAREN:
  OT=OT-1 :: NE=0 :: AFTER=0 :: MSG$="CLOSE PAREN" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ----- DECIMAL POINT -----
DECIMAL_POINT:
  IF B=10 THEN START_DECIMAL_ENTRY
  BAD=1 :: MSG$="DEC ONLY" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

START_DECIMAL_ENTRY:
  IF NE=1 THEN CHECK_POINT
  IF AFTER=1 THEN VT=-1 :: OT=-1 :: AFTER=0
  E$="0" :: NE=1

CHECK_POINT:
  IF POS(E$,".",1)=0 THEN CHECK_POINT_LENGTH
  BAD=1 :: MSG$="ONE POINT" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

CHECK_POINT_LENGTH:
  IF LEN(E$)<8 THEN APPEND_POINT
  BAD=1 :: MSG$="8 DIGITS" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

APPEND_POINT:
  E$=E$&"." :: MSG$="DECIMAL" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ----- CHANGE BASE TO NB -----
CHANGE_BASE:
  IF NB<>B THEN CONVERT_BASE
  GOSUB SET_MODE_STATUS :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

CONVERT_BASE:
  IF NE=1 THEN GOSUB PARSE_ENTRY
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  HOLD=X :: B=NB :: GOSUB SET_BASE_PARAMS
  IF NE=0 THEN FINISH_BASE_CHANGE
  X=HOLD :: GOSUB FORMAT_NUMBER
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  E$=D$

FINISH_BASE_CHANGE:
  GOSUB SET_MODE_STATUS :: MSG$=MSG$&" CONVERTED" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ----- CLEAR ENTRY (BACKSPACE) -----
CLEAR_ENTRY:
  E$="" :: NE=0 :: MSG$="CE" :: GOSUB DRAW_LED_AND_STATUS :: RETURN

  ! ----- ALL CLEAR -----
ALL_CLEAR:
  ANS=0 :: E$="" :: NE=0 :: ER=0 :: VT=-1 :: OT=-1
  AFTER=0 :: LAST$="" :: KRDY=0 :: KP=0 :: MSG$="CLEAR"
  GOSUB DRAW_LED_AND_STATUS :: RETURN 

! ----- STORE MEM -----
STORE_MEMORY:
  IF NE=1 THEN GOSUB PARSE_ENTRY ELSE X=ANS
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  MEM=X :: MH=1 :: MSG$="STO" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

! ----- RECALL MEM -----
RECALL_MEMORY:
  IF MH=1 THEN LOAD_MEMORY
  BAD=1 :: MSG$="MEM EMPTY" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

LOAD_MEMORY:
  X=MEM :: GOSUB FORMAT_NUMBER
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  E$=D$ :: NE=1 :: AFTER=0 :: MSG$="RCL" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

! ----- SUM INTO MEM -----
SUM_MEMORY:
  IF NE=1 THEN GOSUB PARSE_ENTRY ELSE X=ANS
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  MEM=MEM+X :: MH=1 :: MSG$="SUM" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ----- STORE THE PENDING OPERATOR AND VALUE AS CONSTANT -----
SET_CONSTANT:
  IF OT<0 THEN CONSTANT_NEEDS_OPERATOR
  IF O$(OT)<>"(" THEN SELECT_CONSTANT_VALUE

CONSTANT_NEEDS_OPERATOR:
  BAD=1 :: MSG$="K NEEDS OP" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

SELECT_CONSTANT_VALUE:
  IF NE=1 THEN PARSE_CONSTANT_VALUE
  KVAL=V(VT):: IF KP=0 THEN STORE_CONSTANT
  IF LAST$<>O$(OT)THEN STORE_CONSTANT
  KVAL=LVAL :: GOTO STORE_CONSTANT

PARSE_CONSTANT_VALUE:
  GOSUB PARSE_ENTRY :: IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  KVAL=X

STORE_CONSTANT:
  KOP$=O$(OT):: KRDY=1 :: NE=0 :: VT=-1 :: OT=-1 :: AFTER=0 :: KP=0 :: MSG$="K SET" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ----- ONE'S COMPLEMENT -----
ONES_COMPLEMENT:
  IF B<>10 THEN APPLY_ONES_COMPLEMENT
  BAD=1 :: MSG$="1C OCT/HEX" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

APPLY_ONES_COMPLEMENT:
  IF NE=1 THEN GOSUB PARSE_ENTRY ELSE X=ANS
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  U=X :: IF U<0 THEN U=U+W
  R=W-1-U :: IF R>=W/2 THEN R=R-W
  IF NE=0 THEN  ANS=R :: IF VT>-1 THEN V(VT)=R :: GOTO FINISH_ONES_COMPLEMENT
  X=R :: GOSUB FORMAT_NUMBER :: E$=D$

FINISH_ONES_COMPLEMENT:
  MSG$="1'S C" :: GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ----- +/- IN DEC, TWO'S COMPLEMENT IN OCT/HEX -----
TOGGLE_SIGN:
  IF NE=1 THEN GOSUB PARSE_ENTRY ELSE X=ANS
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  R=-X :: GOSUB NORMALIZE_RANGE
  IF ER=1 THEN GOSUB DRAW_LED_AND_STATUS :: RETURN 
  IF NE=0 THEN  ANS=R :: IF VT>-1 THEN V(VT)=R :: GOTO SET_SIGN_STATUS
  X=R :: GOSUB FORMAT_NUMBER :: E$=D$

SET_SIGN_STATUS:
  IF B=10 THEN SET_NEGATIVE_STATUS
  IF OT<0 THEN SET_TWOS_STATUS
  IF O$(OT)="S" THEN MSG$="SHF RIGHT" :: GOTO REDRAW_SIGN

SET_TWOS_STATUS:
  MSG$="2'S C" :: GOTO REDRAW_SIGN

SET_NEGATIVE_STATUS:
  MSG$="NEGATIVE"

REDRAW_SIGN:
  GOSUB DRAW_LED_AND_STATUS :: RETURN 

  ! ----- CONVERT CURRENT ENTRY E$ TO X -----
PARSE_ENTRY:
  IF B<>10 THEN PARSE_NONDEC_ENTRY
  X=VAL(E$)
  R=X :: GOSUB NORMALIZE_RANGE :: RETURN 

PARSE_NONDEC_ENTRY:
  X=0
  FOR J=1 TO LEN(E$)
  C$=SEG$(E$,J,1):: D=ASC(C$)
  IF D<58 THEN D=D-48 ELSE D=D-55
  X=X*B+D
  NEXT J
  IF X<W/2 THEN NORMALIZE_PARSED_VALUE
  X=X-W

NORMALIZE_PARSED_VALUE:
  R=X :: GOSUB NORMALIZE_RANGE :: RETURN 

  ! ----- STATUS LABEL FOR THE CURRENT BASE -----
SET_MODE_STATUS:
  MSG$="MODE DEC"
  IF B=8 THEN MSG$="MODE OCT"
  IF B=16 THEN MSG$="MODE HEX"
RETURN

  ! ----- STATUS LABEL FOR A PENDING OPERATOR -----
SET_OPERATOR_STATUS:
  MSG$="OP"
  IF P$="+" THEN MSG$="ADD"
  IF P$="-" THEN MSG$="SUBTRACT"
  IF P$="*" THEN MSG$="MULTIPLY"
  IF P$="/" THEN MSG$="DIVIDE"
  IF P$="O" THEN MSG$="OR"
  IF P$="X" THEN MSG$="XOR"
  IF P$="A" THEN MSG$="AND"
  IF P$="S" THEN MSG$="SHF: T=RIGHT"
RETURN

  ! ----- PARAMETERS FOR THE SELECTED BASE -----
SET_BASE_PARAMS:
  IF B=10 THEN W=0 :: P=99999999 :: NBITS=0 :: RETURN
  IF B=8 THEN W=16777216 :: P=8388607 :: NBITS=24 :: RETURN 
  W=4294967296 :: P=2147483647 :: NBITS=32 :: RETURN 

  ! ----- FORMAT X AS D$ IN THE SELECTED BASE -----
FORMAT_NUMBER:
  IF B<>10 THEN FORMAT_NONDEC_NUMBER
  GOSUB FORMAT_DECIMAL_NUMBER
  IF LEN(D$)<9 THEN RETURN 
  ER=1 :: MSG$="OVERFLOW" :: RETURN 

  ! ROUND DECIMAL RESULTS TO THE AVAILABLE LED DISPLAY POSITIONS
FORMAT_DECIMAL_NUMBER:
  S$="" :: U=X
  IF U<0 THEN S$="-" :: U=-U
  I=INT(U) :: I$=STR$(I)
  IF SEG$(I$,1,1)=" " THEN I$=SEG$(I$,2,LEN(I$)-1)
  ND=7-LEN(I$)-LEN(S$)
  IF ND>0 THEN FORMAT_DECIMAL_FRACTION
  IF U=I THEN FORMAT_DECIMAL_INTEGER
  ER=1 :: MSG$="OVERFLOW" :: RETURN

FORMAT_DECIMAL_FRACTION:
  SC=1
  FOR J=1 TO ND :: SC=SC*10 :: NEXT J
  R=INT(U*SC+.5) :: I=INT(R/SC) :: F=R-I*SC
  I$=STR$(I)
  IF SEG$(I$,1,1)=" " THEN I$=SEG$(I$,2,LEN(I$)-1)
  IF F=0 THEN FORMAT_DECIMAL_INTEGER_TEXT
  F$=STR$(F)
  IF SEG$(F$,1,1)=" " THEN F$=SEG$(F$,2,LEN(F$)-1)
  IF LEN(F$)<ND THEN F$=RPT$("0",ND-LEN(F$))&F$

STRIP_DECIMAL_ZEROES:
  IF SEG$(F$,LEN(F$),1)<>"0" THEN BUILD_DECIMAL_TEXT
  F$=SEG$(F$,1,LEN(F$)-1):: GOTO STRIP_DECIMAL_ZEROES

BUILD_DECIMAL_TEXT:
  D$=S$&I$&"."&F$ :: RETURN

FORMAT_DECIMAL_INTEGER:
  I=INT(U)

FORMAT_DECIMAL_INTEGER_TEXT:
  IF I=0 THEN S$=""
  I$=STR$(I)
  IF SEG$(I$,1,1)=" " THEN I$=SEG$(I$,2,LEN(I$)-1)
  D$=S$&I$ :: RETURN

FORMAT_NONDEC_NUMBER:
  U=X :: IF U<0 THEN U=U+W
  D$=""
  FOR J=1 TO 8
  Q=INT(U/B):: D=U-B*Q
  IF D<10 THEN C$=CHR$(48+D)ELSE C$=CHR$(55+D)
  D$=C$&D$ :: U=Q
  NEXT J
  IF U=0 THEN STRIP_LEADING_ZERO
  ER=1 :: MSG$="OVERFLOW" :: RETURN 

STRIP_LEADING_ZERO:
  IF LEN(D$)=1 THEN RETURN 
  IF SEG$(D$,1,1)<>"0" THEN RETURN 
  D$=SEG$(D$,2,LEN(D$)-1):: GOTO STRIP_LEADING_ZERO

  ! ----- RANGE / TWO'S-COMPLEMENT WRAP -----
NORMALIZE_RANGE:
  IF B<>10 THEN WRAP_WORD
  IF ABS(R)<100000000 THEN RETURN 
  ER=1 :: MSG$="OVERFLOW" :: RETURN 

WRAP_WORD:
  R=R-W*INT((R+W/2)/W)
RETURN

  ! ----- DRAW THE CALCULATOR FACE -----
DRAW_CALC:
  CALL SCREEN(15):: CALL CLEAR
  FOR J=1 TO 14 :: CALL COLOR(J,2,15):: NEXT J
  CALL COLOR(9,10,7):: CALL COLOR(10,10,7):: CALL COLOR(11,10,7)
  CALL CHAR(96,"0000000000000000")
  CALL CHAR(97,"3C666E7666663C00")  // 0
  CALL CHAR(98,"1838181818187E00")  // 1
  CALL CHAR(99,"3C66060C30607E00")  // 2
  CALL CHAR(100,"3C66061C06663C00") // 3
  CALL CHAR(101,"0C1C3C6C7E0C0C00") // 4
  CALL CHAR(102,"7E607C0606663C00") // 5
  CALL CHAR(103,"1C30607C66663C00") // 6
  CALL CHAR(104,"7E060C1830303000") // 7
  CALL CHAR(105,"3C66663C66663C00") // 8
  CALL CHAR(106,"3C66663E060C3800") // 9
  CALL CHAR(107,"183C66667E666600") // A
  CALL CHAR(108,"7C66667C66667C00") // B
  CALL CHAR(109,"3C66606060663C00") // C
  CALL CHAR(110,"786C6666666C7800") // D
  CALL CHAR(111,"7E60607C60607E00") // E
  CALL CHAR(112,"7E60607C60606000") // F
  CALL CHAR(113,"0000007E00000000") // -
  CALL CHAR(114,"0000000000001838") // .
  CALL CHAR(136,"000000FFFF000000") // horizontal line
  CALL CHAR(137,"1818181818181818") // vertical line
  CALL CHAR(138,"000000FFFF181818") // upper corner
  CALL CHAR(139,"181818FFFF000000") // lower corner
  // Define TI Logo (Brad Snyder)
  CALL CHAR(140,"0F0F0F0F0F0FFFFF7F1F0F05000000000000208EAE26AEAFAFAF86F8F0703010")
  CALL CHAR(95,"FFFFFFFFFFFFFFFF") // status block
  H$=RPT$(CHR$(136),26):: V$=CHR$(137)
  TL$=CHR$(138):: TR$=CHR$(138):: BL$=CHR$(139):: BR$=CHR$(139)
  DISPLAY AT(1,1)SIZE(28):TL$&H$&TR$
  DISPLAY AT(2,1)SIZE(28):V$&TL$&RPT$(CHR$(136),24)&TR$&V$
  DISPLAY AT(3,1)SIZE(28):V$&V$&RPT$(CHR$(96),24)&V$&V$
  DISPLAY AT(4,1)SIZE(28):V$&BL$&RPT$(CHR$(136),24)&BR$&V$
  DISPLAY AT(5,1)SIZE(28):V$&"  TEXAS INSTRUMENTS  "&VR$&V$
  DISPLAY AT(6,1)SIZE(28):V$&"             TI PROGRAMMER"&V$
  // Print TI Logo
  CALL HCHAR(5,4,140)::CALL HCHAR(5,5,142)::CALL HCHAR(6,4,141)::CALL HCHAR(6,5,143)
  DISPLAY AT(7,1)SIZE(28):V$&H$&V$
  DISPLAY AT(8,1)SIZE(28):V$&"[DEC][HEX][OCT][OFF][C/ON]"&V$
  DISPLAY AT(9,1)SIZE(28):V$&"[STO][RCL][SUM][ ( ][ ) ] "&V$
  DISPLAY AT(10,1)SIZE(28):V$&"[SHF][ D ][ E ][ F ][ K ] "&V$
  DISPLAY AT(11,1)SIZE(28):V$&"[1SC][ A ][ B ][ C ][ / ] "&V$
  DISPLAY AT(12,1)SIZE(28):V$&"[ OR][ 7 ][ 8 ][ 9 ][ * ] "&V$
  DISPLAY AT(13,1)SIZE(28):V$&"[AND][ 4 ][ 5 ][ 6 ][ - ] "&V$
  DISPLAY AT(14,1)SIZE(28):V$&"[XOR][ 1 ][ 2 ][ 3 ][ + ] "&V$
  DISPLAY AT(15,1)SIZE(28):V$&"[CE ][ 0 ][ . ][+/-][ = ] "&V$
  DISPLAY AT(16,1)SIZE(28):V$&H$&V$
  DISPLAY AT(18,1)SIZE(28):V$&"Z-DEC H-HEX O-OCT L-CLEAR "&V$
  DISPLAY AT(19,1)SIZE(28):V$&"S-STO R-RCL U-SUM K-CONST "&V$
  DISPLAY AT(20,1)SIZE(28):V$&"Q-SHF V-1SC W-OR I-AND    "&V$
  DISPLAY AT(21,1)SIZE(28):V$&"Y-XOR T-(+/-); RIGHT SHF  "&V$
  DISPLAY AT(22,1)SIZE(28):V$&"ENTER-= BKSP-CE BACK-EXIT "&V$
  DISPLAY AT(23,1)SIZE(28):V$&"K: M OP K; THEN N =       "&V$
  DISPLAY AT(24,1)SIZE(28):BL$&H$&BR$
  // Status Line Markers
  CALL SPRITE(#1,95,5,16*8+1,8)::CALL SPRITE(#2,95,5,16*8+1,241)
RETURN

  ! ----- REDRAW LED DISPLAY AND STATUS -----
DRAW_LED_AND_STATUS:
  IF ER=1 THEN BAD=1
  IF BAD=MBAD THEN DRAW_LED_AND_STATUS_BODY
  IF BAD=0 THEN SET_MARKER_BLUE
  CALL COLOR(#1,10)::CALL COLOR(#2,10)::CALL SOUND(200,110,12)::MBAD=1::GOTO DRAW_LED_AND_STATUS_BODY

SET_MARKER_BLUE:
  CALL COLOR(#1,5)::CALL COLOR(#2,5)::MBAD=0

DRAW_LED_AND_STATUS_BODY:
  GOSUB DRAW_LED_VALUE
  GOSUB DRAW_STATUS
RETURN

DRAW_LED_VALUE:
  LED$=""
  IF ER=0 THEN GET_LED_VALUE
  D$="EEEEEEEE" :: GOTO CHECK_LED_LENGTH

GET_LED_VALUE:
  IF NE=1 THEN D$=E$ ELSE X=ANS :: GOSUB FORMAT_NUMBER
  IF ER=0 THEN CHECK_LED_LENGTH
  D$="EEEEEEEE"

CHECK_LED_LENGTH:
  IF LEN(D$)<9 THEN BUILD_LED_DIGITS
  ER=1 :: MSG$="OVERFLOW" :: D$="EEEEEEEE"

BUILD_LED_DIGITS:
  FOR J=1 TO 8
  C=96
  IF J>8-LEN(D$)THEN C$=SEG$(D$,J-8+LEN(D$),1):: GOSUB MAP_LED_GLYPH
  LED$=LED$&CHR$(C)
  NEXT J :: DISPLAY AT(3,19)SIZE(8):LED$
  IF BFLAG=0 THEN DRAW_LED_DONE
  IF DBEEP=0 THEN DRAW_LED_DONE
  CALL SOUND(40,988,10)

DRAW_LED_DONE:
RETURN

DRAW_STATUS:
  IF B=10 THEN MS$="DEC"
  IF B=8 THEN MS$="OCT"
  IF B=16 THEN MS$="HEX"
  IF MH=0 THEN MM$="---" ELSE MM$="SET"
  IF MEM=0 THEN MM$="---"
  SS$="MODE "&MS$&" MEM "&MM$&" "&MSG$
  IF LEN(SS$)<27 THEN FIT_STATUS
  SS$=MS$&" "&MM$&" "&MSG$

FIT_STATUS:
  IF LEN(SS$)<26 THEN PAD_STATUS
  IF LEN(SS$)=26 THEN DRAW_STATUS_LINE
  SS$=SEG$(SS$,1,26)

PAD_STATUS:
  SS$=SS$&RPT$(" ",26-LEN(SS$))

DRAW_STATUS_LINE:
  DISPLAY AT(17,1)SIZE(28):V$&SS$&V$
RETURN

  ! MAP ONE DISPLAY CHARACTER C$ TO A CUSTOM LED GLYPH C
MAP_LED_GLYPH:
  D=ASC(C$)
  IF D<45 THEN C=D :: RETURN 
  IF D=45 THEN C=113 :: RETURN 
  IF D=46 THEN C=114 :: RETURN 
  IF D<58 THEN C=97+D-48 :: RETURN 
  IF D<71 THEN C=107+D-65 :: RETURN 
  C=D :: RETURN 

  ! ----- STARTUP SOUND CONFIGURATION -----
CONFIG_MENU:
  CALL SCREEN(15):: CALL CLEAR
  FOR J=1 TO 14 :: CALL COLOR(J,2,15):: NEXT J
  DISPLAY AT(4,2):"TI PROGRAMMER ";VR$;" SETUP"
  DISPLAY AT(6,3):"(C) 2026 - BRAD SNYDER"
  DISPLAY AT(7,9):"AND CODEX"
  DISPLAY AT(10,4):"K   KEY CLICK:"
  DISPLAY AT(12,4):"D   DIGIT BEEP:"
  DISPLAY AT(14,4):"PRESS K OR D TO TOGGLE"
  DISPLAY AT(17,4):"ENTER OR = TO START"
  GOSUB DRAW_CONFIG_OPTIONS

CONFIG_KEY_LOOP:
  CALL KEY(3,CKEY,CST)
  IF CST<>1 THEN CONFIG_KEY_LOOP
  IF CKEY=75 THEN TOGGLE_KEY_CLICK
  IF CKEY=68 THEN TOGGLE_DIGIT_BEEP
  IF CKEY=13 THEN RETURN
  IF CKEY=61 THEN RETURN
  GOTO CONFIG_KEY_LOOP

TOGGLE_KEY_CLICK:
  KSND=1-KSND :: GOSUB DRAW_CONFIG_OPTIONS :: GOTO CONFIG_KEY_LOOP

TOGGLE_DIGIT_BEEP:
  DBEEP=1-DBEEP :: GOSUB DRAW_CONFIG_OPTIONS :: GOTO CONFIG_KEY_LOOP

DRAW_CONFIG_OPTIONS:
  IF KSND=1 THEN KCFG$="ON " ELSE KCFG$="OFF"
  IF DBEEP=1 THEN DCFG$="ON " ELSE DCFG$="OFF"
  DISPLAY AT(10,26)SIZE(3):KCFG$
  DISPLAY AT(12,26)SIZE(3):DCFG$
RETURN