| Latest and best revision of LED program.September 17 2005 at 2:38 PM | Solitaire (Login Solitaire1)
S |
Response to Greatly modified and improved version of LED program. |
| I added several more features, fixed a couple of hidden bugs, tweaked the code to remove unneeded variables and INKEY$s, added lots of comments.
I spent many long hours on this program, neglecting other work that needed to be done. Thanks again to Michael Calkins for suggestions, some of which I used in the Binshow and Counter subs, although I had already revised most of the code before I saw his comments. I hope this version is good to go so I can get back to my other chores.
==========================================================
' by Solitaire (c) 2005
DECLARE SUB Binshow ()
DECLARE SUB Counter ()
DECLARE SUB Decshow ()
DECLARE SUB Display ()
DECLARE SUB Eraser ()
DECLARE SUB Finish (B AS STRING, col AS INTEGER)
DECLARE SUB Hexshow ()
DECLARE SUB Hextog ()
DECLARE SUB LEDtint ()
DECLARE SUB ResetLED (dec AS INTEGER)
DECLARE SUB Setup ()
DECLARE SUB ShowVal (dec AS INTEGER, bin AS STRING, bas AS STRING)
DECLARE FUNCTION BINTODEC% (bin AS STRING)
DECLARE FUNCTION DECTOBIN$ (dec AS INTEGER)
DECLARE FUNCTION HEXTODEC% (hux AS STRING)
DIM SHARED Tabset(1 TO 12) AS INTEGER
DIM SHARED Fkey(1 TO 12) AS INTEGER
DIM SHARED binval(1 TO 12) AS INTEGER
DIM SHARED hx AS INTEGER, tint AS INTEGER, H AS STRING
DIM dec AS INTEGER, fin AS INTEGER
DIM E AS STRING, B AS STRING
CALL Setup 'initializes Tabset and Fkey arrays
tint = 9 'default LED color is Blue
hx = 0: H$ = "ON" 'default Hex display is on
CALL Finish(B$, 26) 'opening screen
DO
CALL Display 'prints LED bulbs and place values
DO
fin = 0
VIEW PRINT 1 TO 10
CLS : PRINT TAB(10); "BINARY LED COUNTER AND CONVERTER ---- ";
PRINT "Enter your choice:"
PRINT : PRINT TAB(20); "C = Binary Counter"
PRINT TAB(20); "D = Decimal to Binary Converter"
PRINT TAB(20); "B = Binary to Decimal Converter"
PRINT TAB(20); "H = Hexadecimal to Binary Converter"
PRINT TAB(20); "L = Change LED Color ";
COLOR tint: PRINT CHR$(176): COLOR 7
PRINT TAB(20); "X = Toggle Hexadecimal Display ";
COLOR 8: PRINT "["; H$; "]": COLOR 7
PRINT TAB(20); "E = Exit ";
COLOR 8: PRINT "(or press Esc)": COLOR 7
E$ = INPUT$(1)
SELECT CASE UCASE$(E$)
CASE "C"
CALL Counter
CASE "D"
CALL Decshow
CASE "B"
CALL Binshow
CASE "H"
CALL Hexshow
CASE "L"
CALL LEDtint
CASE "X"
CALL Hextog
CASE "E", CHR$(27)
CALL Finish(B$, 12)
fin = 1
CASE ELSE
END SELECT
CALL ResetLED(dec) 'turns off LED lights
LOOP UNTIL fin = 1
CLS 'clears only top 10 lines
VIEW PRINT
LOOP WHILE B$ = CHR$(8)
SYSTEM
SUB Binshow
DIM x AS INTEGER, y AS INTEGER, dec AS INTEGER, auto AS INTEGER, cl AS INTEGER
DIM bin AS STRING, C AS STRING
DIM recall(1 TO 12) AS INTEGER
DIM previous(1 TO 12) AS INTEGER
CLS
VIEW PRINT 1 TO 10
PRINT TAB(25); "BINARY TO DECIMAL CONVERTER"
PRINT
PRINT "Use the F keys across the top of your keyboard to toggle LED lights on or off."
PRINT TAB(5); "Press Enter to display results when done, or A for auto keypress."
PRINT TAB(5); "Press spacebar to clear and reset to 0."
PRINT TAB(5); "Press R to recall the last non-zero number entered."
PRINT TAB(5); "Press L to change LED color."
PRINT TAB(5); "Press X to toggle Hex display."
PRINT TAB(5); "Press M or Esc to return to the menu."
VIEW PRINT
auto = 0 'default Enter to display results; toggle -1 for instant display
LOCATE 14
y = 0
FOR x = 1 TO 12 'print the F-key keypress display
IF x >= 10 THEN y = 1
PRINT TAB(Tabset(x) - y); "F" + LTRIM$(STR$(x));
NEXT x
DO
DO
C$ = UCASE$(INKEY$)
LOOP UNTIL C$ <> ""
ent = 0
IF C$ <> "L" THEN cl = 0
SELECT CASE C$
CASE "M", CHR$(27) 'Escape to menu
EXIT DO
CASE " " 'clears display
FOR x = 1 TO 12
binval(x) = 0
NEXT x
ent = -1
cl = 1
IF auto = -1 THEN
LOCATE 5, 46: COLOR 8
PRINT "Enter to display.": COLOR 7
END IF
CASE "X" 'toggles hex display
CALL Hextog
LOCATE 22, 1
PRINT SPACE$(80)
PRINT SPACE$(20)
ent = -1
CASE "L" 'changes LED color
CALL LEDtint
IF cl = 1 THEN 'will not display if spacebar was just pressed
ent = 0
ELSE
ent = -1
END IF
CASE "R" 'recalls previous number from array
FOR x = 1 TO 12
LOCATE 18, Tabset(x)
binval(x) = recall(x)
IF binval(x) = 0 THEN
COLOR 7: PRINT CHR$(176) 'hollow gray - light off
ELSE
COLOR tint: PRINT CHR$(219) 'solid color - light on
END IF
NEXT x
COLOR 7
ent = -1
CASE "A" 'display F-key presses either instantly or after Enter
auto = NOT auto 'toggle between 0 and -1
ent = auto
IF auto = 0 THEN
LOCATE 4, 5
PRINT "Press Enter to display results when done, or A for auto keypress."
LOCATE 12, 1: PRINT SPACE$(80)
LOCATE 22: PRINT SPACE$(80)
PRINT SPACE$(20)
LOCATE 12, 20: COLOR 8
PRINT "Press Enter to refresh display"
LOCATE 5, 46: PRINT SPACE$(30)
COLOR 7
ELSE
LOCATE 4, 1: PRINT SPACE$(80)
LOCATE 4, 5: PRINT "Auto keypress is on. Press A to turn it off."
END IF
COLOR 7
CASE CHR$(13) 'Enter to display when auto is off
ent = -1
LOCATE 5, 46: PRINT SPACE$(30)
CASE ELSE 'user presses F-keys to toggle LED on or off
IF LEN(C$) = 2 THEN
FOR x = 1 TO 12
IF C$ = CHR$(0) + CHR$(Fkey(x)) THEN
binval(x) = NOT binval(x) 'toggle between 0 and -1
IF binval(x) <> previous(x) THEN 'user changes LED values
LOCATE 12, 1: PRINT SPACE$(80)
LOCATE 22: PRINT SPACE$(80)
PRINT SPACE$(20)
END IF
LOCATE 18, Tabset(x)
IF binval(x) = 0 THEN
COLOR 7: PRINT CHR$(176) 'hollow gray - light off
ELSE
COLOR tint: PRINT CHR$(219) 'solid color - light on
END IF
IF auto = 0 THEN
LOCATE 12, 1: PRINT SPACE$(80)
LOCATE 12, 20: COLOR 8
PRINT "Press Enter to display when done."
END IF
COLOR 7
ent = auto
END IF
NEXT x
END IF
LOCATE 5, 46: PRINT SPACE$(30)
END SELECT
IF ent THEN
FOR x = 1 TO 12 'concatenate binary digits
bin$ = bin$ + LTRIM$(STR$(ABS(binval(x))))
previous(x) = binval(x) 'save previous number to local array
NEXT x
CALL ShowVal(dec, bin$, "bin")
IF C$ = " " THEN CALL Eraser
bin$ = ""
IF dec > 0 THEN
FOR x = 1 TO 12 'saves previous non-0 number to array
recall(x) = binval(x)
NEXT x
END IF
END IF
LOOP
LOCATE 14, 1: PRINT SPACE$(80)
CALL Eraser
END SUB
FUNCTION BINTODEC% (bin AS STRING)
DIM p AS INTEGER, x AS INTEGER, B AS INTEGER, d AS INTEGER, dig AS STRING
p = 0
FOR x = 12 TO 1 STEP -1
dig$ = MID$(bin$, x, 1)
B = VAL(dig$)
d = B * (2 ^ p)
dec = dec + d
p = p + 1
NEXT x
BINTODEC% = dec
END FUNCTION
SUB Counter
DIM dec AS INTEGER, cnum AS INTEGER, start AS INTEGER, sp AS INTEGER
DIM rate AS SINGLE, pres AS SINGLE, t AS LONG, dnum AS DOUBLE
DIM C AS STRING, K AS STRING, snum AS STRING, st1 AS STRING, st2 AS STRING
CLS
VIEW PRINT 1 TO 10
PRINT TAB(30); "BINARY COUNTER"
PRINT
PRINT "Press Enter to begin after starting number. After count begins:"
PRINT TAB(5); "Press Enter or spacebar to clear and stop."
PRINT TAB(5); "Press 1-9 to adjust speed (fast-slow). ";
COLOR 8: PRINT "[5]"
COLOR 7
PRINT TAB(5); "Press 0 to freeze counter, any key to continue."
PRINT TAB(5); "R = reset counter to starting number: ";
COLOR 8: PRINT "0 ": COLOR 7
PRINT TAB(5); "Press L to change LED color; X to toggle Hex display."
PRINT TAB(5); "Press M or Esc to return to the menu. ";
COLOR 8: PRINT "Counter will recycle to 0 after 4095."
COLOR 7
VIEW PRINT
rate = 1.5 'default speed (about 5)
DO
K$ = INKEY$
IF cnum > 0 THEN
st1$ = ", C to continue at"
st2$ = STR$(cnum) + ","
ELSE
LOCATE 7, 50: PRINT SPACE$(81 - POS(0))
END IF
LOCATE 12, 1: PRINT SPACE$(80)
LOCATE 12, 1
PRINT "Enter a starting number"; st1$;
COLOR 8: PRINT st2$;
COLOR 7: PRINT " or nothing to begin with 0";
INPUT ": ", snum$
snum$ = UCASE$(snum$)
dnum = ABS(INT(VAL(snum$)))
IF dnum > 4095 THEN dnum = 4095
IF snum$ = "M" THEN EXIT DO
IF snum$ = "R" THEN dnum = start 'resets counter to starting number
IF snum$ = "C" THEN
dnum = cnum 'saves last number before Enter or spacebar was pressed
IF dnum > 0 THEN
LOCATE 7, 50
PRINT "T = reset to last number:";
COLOR 8: PRINT dnum: COLOR 7
ELSE
LOCATE 7, 50: PRINT SPACE$(81 - POS(0))
END IF
ELSE
start = dnum 'saves new number input or 0 to start
END IF
IF dnum = 0 THEN LOCATE 7, 50: PRINT SPACE$(81 - POS(0))
sp = 5 - LEN(STR$(start))
LOCATE 7, 42: COLOR 8
PRINT start; SPACE$(sp): COLOR 7
dec = dnum
DO
C$ = UCASE$(INKEY$) 'options while counter is changing
SELECT CASE C$
CASE CHR$(27), CHR$(13), "M", " " 'Escape to menu
EXIT DO
CASE "L" 'change LED color
CALL LEDtint
dec = dec - 1 'save number in display
CASE "X" 'toggle hex display
CALL Hextog
CASE "R" 'restart counter from first input
dec = start
CASE "T" 'restart counter from last input
dec = dnum
CASE "0"
C$ = INPUT$(1) 'freeze counter
dec = dec - 1
CASE ELSE
pres = VAL(C$)
IF pres <> 0 THEN 'change speed 1-9
rate = ((pres + 1) * 2) / 6
LOCATE 5, 46: COLOR 8
PRINT C$: COLOR 7
END IF
END SELECT
CALL ShowVal(dec, bin$, "dec") 'show decimal and LED
t = TIMER 'speed of counter
DO WHILE t + rate >= TIMER: LOOP
dec = dec + 1 'increment counter
IF dec = 4096 THEN dec = 0 'recycle counter
cnum = dec - 1 'save last number in count
LOOP UNTIL C$ = CHR$(13) OR C$ = " " OR C$ = CHR$(27)
LOCATE 7, 50: PRINT SPACE$(81 - POS(0))
CALL ResetLED(dec) 'clear and reset to 0
LOOP UNTIL C$ = "M" OR C$ = CHR$(27) OR K$ = CHR$(27)
LOCATE 12, 1: PRINT SPACE$(80)
END SUB
SUB Decshow
DIM dec AS INTEGER, C AS STRING, K AS STRING, snum AS STRING
DIM previous AS INTEGER, dnum AS DOUBLE
CLS
VIEW PRINT 1 TO 10
PRINT TAB(25); "DECIMAL TO BINARY CONVERTER"
PRINT
PRINT "Input a number or R to recall previous non-zero number. Press Enter to begin."
PRINT TAB(10); "After display shows:"
PRINT TAB(5); "Press Enter (or any key) to clear for a new number."
PRINT TAB(5); "Press L to change LED color."
PRINT TAB(5); "Press X to toggle Hex display."
PRINT TAB(5); "Press M or Esc to return to the menu."
VIEW PRINT
DO
LOCATE 12, 1: PRINT SPACE$(80)
LOCATE 12, 6
INPUT "Enter a positive decimal integer up to 4095: ", snum$
snum$ = UCASE$(snum$)
IF snum$ = "M" THEN EXIT DO
dnum = ABS(INT(VAL(snum$)))
IF dnum > 4095 THEN dec = 4095 ELSE dec = dnum
IF snum$ = "R" THEN dec = previous
CALL ShowVal(dec, bin$, "dec") 'show decimal value
IF dec > 0 THEN previous = dec
DO
C$ = UCASE$(INPUT$(1))
IF C$ = CHR$(27) THEN EXIT DO
IF C$ = "L" THEN CALL LEDtint
IF C$ = "X" THEN CALL Hextog
IF C$ = "L" OR C$ = "X" THEN
CALL ShowVal(dec, bin$, "dec")
ELSE
CALL ResetLED(dec)
END IF
LOOP WHILE C$ = "L" OR C$ = "X"
LOOP UNTIL C$ = "M" OR C$ = CHR$(27)
CALL Eraser
END SUB
FUNCTION DECTOBIN$ (dec AS INTEGER)
DIM p AS INTEGER, x AS INTEGER, bin AS STRING
p = 1 'place value
FOR x = 1 TO 12
IF (dec AND p) = 0 THEN
bin$ = "0" + bin$ 'concatenate the string
ELSE
bin$ = "1" + bin$
END IF
p = p + p 'double the place value
NEXT x
DECTOBIN$ = bin$
END FUNCTION
SUB Display
DIM x AS INTEGER
LOCATE 11, 1: COLOR 8 'print gray line separating instructions from display
PRINT STRING$(80, CHR$(196)): COLOR 7
LOCATE 16
FOR x = 1 TO 12 'print the place values
PRINT TAB(Tabset(x) - 1); 2 ^ (12 - x);
NEXT x
LOCATE 17
FOR x = 1 TO 12 'print the hollow LED (off) light bulbs
PRINT TAB(Tabset(x)); CHR$(176);
NEXT x
END SUB
SUB Eraser
LOCATE 12, 1: PRINT SPACE$(80) 'clear decimal display
LOCATE 22: PRINT SPACE$(80) 'clear hex display
PRINT SPACE$(20)
END SUB
SUB Finish (B AS STRING, col AS INTEGER)
VIEW PRINT
CLS : LOCATE 2, 22
PRINT "BINARY LED COUNTER AND CONVERTER"
LOCATE 10, 28: PRINT "-- by Solitaire --"
LOCATE 19, 32: PRINT "(c) 2005)"
COLOR 8
LOCATE 25, col
IF col = 12 THEN
PRINT "Press any key to end or Backspace to return to program";
ELSE
PRINT "Press any key to begin";
END IF
COLOR 7
B$ = INPUT$(1)
CLS
END SUB
SUB Hexshow
DIM dec AS INTEGER, previous AS INTEGER, dnum AS DOUBLE
DIM C AS STRING, snum AS STRING, ch AS STRING, hux AS STRING
DIM N AS INTEGER, wrong AS INTEGER
CLS
hx = 0: H$ = "ON"
VIEW PRINT 1 TO 10
PRINT TAB(25); "HEXADECIMAL TO BINARY CONVERTER"
PRINT
PRINT "Input a hexadecimal number or R to recall previous non-zero number. "
COLOR 8: PRINT TAB(5); "Digits include numerals 0-9 and A-F. ";
COLOR 7: PRINT "Press Enter to begin."
PRINT TAB(10); "After display shows:"
PRINT TAB(5); "Press Enter (or any key) to clear for a new number."
PRINT TAB(5); "Press L to change LED color."
PRINT TAB(5); "Press M or Esc to return to the menu."
VIEW PRINT
DO
DO
wrong = 0
LOCATE 12, 1: PRINT SPACE$(80)
LOCATE 12, 6
INPUT "Enter a hexadecimal number up to 3 hex digits: ", hux$
hux$ = UCASE$(hux$)
IF hux$ = "M" THEN EXIT DO
N = LEN(hux$)
IF N < 1 THEN hux$ = "0" 'nothing input
IF N > 3 THEN wrong = 1
FOR x = 1 TO N 'test each character for hex digit
ch$ = MID$(hux$, x, 1)
IF (ch$ < "0" OR ch$ > "F") OR (ch$ > "9" AND ch$ < "A") THEN wrong = 1
NEXT x
IF hux$ = "R" THEN wrong = 0 'input to recall previous number is ok
IF wrong = 1 THEN
LOCATE 12, 6: COLOR 8
PRINT SPACE$(6);
PRINT "Wrong input. Try again or press M to return to menu.";
PRINT SPACE$(81 - POS(0))
PRINT SPACE$(80)
SLEEP 2
COLOR 7
END IF
LOOP UNTIL wrong = 0
IF hux$ = "M" THEN EXIT DO
IF hux$ = "R" THEN
dec = previous 'recalls previous number
ELSE
dec = HEXTODEC(hux$)
END IF
CALL ShowVal(dec, bin$, "dec") 'show decimal & binary value
DO
C$ = UCASE$(INPUT$(1))
IF C$ = CHR$(27) THEN EXIT DO
IF C$ = "L" THEN
CALL LEDtint
CALL ShowVal(dec, bin$, "dec")
ELSE
IF dec > 0 THEN previous = dec 'saves last non-0 number
CALL ResetLED(dec)
END IF
LOOP WHILE C$ = "L"
LOOP UNTIL C$ = "M" OR C$ = CHR$(27)
CALL Eraser
END SUB
FUNCTION HEXTODEC% (hux AS STRING)
DIM dec AS INTEGER, N AS INTEGER, x AS INTEGER, y AS INTEGER, ch AS STRING
N = LEN(hux$)
y = 0
FOR x = N TO 1 STEP -1
ch$ = MID$(hux$, x, 1)
IF ch$ >= "0" AND ch$ <= "9" THEN
dec = dec + VAL(ch$) * 16 ^ y
ELSE
dec = dec + (ASC(ch$) - 55) * 16 ^ y
END IF
y = y + 1
NEXT x
HEXTODEC% = dec
END FUNCTION
SUB Hextog
hx = NOT hx
IF hx = 0 THEN H$ = "ON" ELSE H$ = "OFF"
END SUB
SUB LEDtint
DIM L AS STRING
VIEW PRINT
LOCATE 12, 1: PRINT SPACE$(80)
LOCATE 12, 15: PRINT "Select R ";
COLOR 12: PRINT CHR$(219);
COLOR 7: PRINT " (Red), G ";
COLOR 10: PRINT CHR$(219);
COLOR 7: PRINT " (Green), or B ";
COLOR 9: PRINT CHR$(219);
COLOR 7: PRINT " (Blue)"
L$ = UCASE$(INPUT$(1))
IF L$ = "R" THEN
tint = 12 'Red
ELSEIF L$ = "G" THEN
tint = 10 'Green
ELSE
tint = 9 'Blue is the default color
END IF
LOCATE 12, 1: PRINT SPACE$(80)
END SUB
SUB ResetLED (dec AS INTEGER)
DIM x AS INTEGER
VIEW PRINT
FOR x = 1 TO 12 'set all binary values to 0
binval(x) = 0
LOCATE 18, Tabset(x) 'turn off all the LED lights
PRINT CHR$(176)
NEXT x
CALL Eraser
END SUB
SUB Setup
FOR x = 1 TO 10 'set the scan values for the F keys
Fkey(x) = x + 58
NEXT x
Fkey(11) = 133
Fkey(12) = 134
y = 0
FOR x = 6 TO 72 STEP 6 'locations for the LED lights
y = y + 1
Tabset(y) = x
NEXT x
END SUB
SUB ShowVal (dec AS INTEGER, bin AS STRING, bas$)
DIM shownum AS STRING, ch AS STRING, hux AS STRING, x AS INTEGER
IF bas$ = "bin" THEN
dec = BINTODEC(bin$) 'convert binary number to decimal
ELSEIF bas$ = "dec" THEN
bin$ = DECTOBIN(dec) 'convert decimal number to binary
END IF
shownum$ = LEFT$(bin$, 4) + " " + MID$(bin$, 5, 4) + " " + RIGHT$(bin$, 4)
LOCATE 12, 1: PRINT SPACE$(14); "The binary value of decimal";
COLOR 15: PRINT dec; 'displays binary number in groups of 4
COLOR 7: PRINT "is "; shownum$; SPACE$(81 - POS(0))
PRINT SPACE$(80)
FOR x = 1 TO 12
ch$ = MID$(bin$, x, 1)
LOCATE 18, Tabset(x)
IF ch$ = "1" THEN
COLOR tint: PRINT CHR$(219) 'turn solid light on
ELSE
COLOR 7: PRINT CHR$(176) 'turn hollow light off
END IF
NEXT x
COLOR 7
IF hx = 0 THEN 'display hex value
hux$ = HEX$(dec)
hux$ = STRING$(3 - LEN(hux$), "0") + hux$
LOCATE 22
PRINT "Hexadecimal:"; TAB(Tabset(4)); LEFT$(hux$, 1);
PRINT TAB(Tabset(8)); MID$(hux$, 2, 1); TAB(Tabset(12)); RIGHT$(hux$, 1)
PRINT TAB(5); HEX$(dec); " "
ELSE 'clear hex display
LOCATE 22: PRINT SPACE$(80)
PRINT SPACE$(20)
END IF
END SUB
This message has been edited by Solitaire1 on Sep 18, 2005 5:49 PM
This message has been edited by Solitaire1 on Sep 18, 2005 9:47 AM
This message has been edited by Solitaire1 on Sep 18, 2005 9:01 AM
This message has been edited by Solitaire1 on Sep 18, 2005 8:05 AM
|
| |
| | Responses |
|
|