A Collaboration: Mechanical Odometer algorithm

[OldMoses]

Are we going to meet YoungMoses sometime soon?  Tell them to stop by and visit with us.  We'll be nice and hide Pete from him for at least a few days, so he won't be chased off immediately. 

I'll plant the suggestion. The family used to call me "the wizard" around these parts. I think it's safe to say he's assumed that mantle while I'm just an aged conjuror now. He recently conceived, designed and built a ladder logic control box to automate manual switching procedures at our grain elevator system. No microprocessors involved, just interlocking 3 form C relays to keep maintenance cheap and easy. Testing of the control promises to vastly streamline our harvest efficiency with limited manpower. We can't wait for the real world test in June.

He likes old world solutions to problems and doesn't care for computers in vehicles or equipment, but has a good head for coding all the same. When I'm describing algorithms to him, he grasps the concepts faster than I can relate them. You'll be hard pressed to find anyone with a better head for mechanics, hydraulics, electric circuits and probably a dozen things he has yet to put his mind to.

On topic, I made a few changes to make the counter a little more portable. This is serious gas guzzler...

Code: (Select All)

'Odometer.bas  Richard & Erik Wessel
$COLOR:32
OPTION _EXPLICIT
SCREEN _NEWIMAGE(256, 216, 32)

DIM SHARED AS LONG slot, slot2, wheel, wheel10th
DIM AS DOUBLE miles, gals

slot = _NEWIMAGE(56, 16, 32) '                                  numeral display window/limits
slot2 = _COPYIMAGE(slot, 32)
wheel = _NEWIMAGE(8, 176, 32) '                                 whole number counter wheels
wheel10th = _COPYIMAGE(wheel, 32) '                             1/10th counter wheel

makewheel Black, Bisque, wheel10th
makewheel Bisque, Black, wheel
DO
    CLS
    miles = miles + .002
    gals = gals + .006
    LINE (50, 50)-(206, 166), &HFF909090, BF
    Odometer miles, slot, 100, 100
    Odometer gals, slot2, 100, 132
    _LIMIT 30
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END


SUB Odometer (m AS DOUBLE, ds AS LONG, ulx AS INTEGER, uly AS INTEGER)
    DIM AS STRING mile_str
    DIM AS SINGLE mile_dec
    DIM AS INTEGER dot_pos, overnine, dec_pos, dec_val, xpos, ypos, break, roll
    DIM AS LONG backimg
    mile_str = _TRIM$(STR$(m)) '
    IF INSTR(mile_str, "D") THEN '                              trap for early exponents here
        dot_pos = 1 '                                           give a non-zero value for computing mile_dec
    ELSE
        dot_pos = INSTR(mile_str, ".") '                        get decimal position if not an exponential
    END IF
    mile_dec = -(m - INT(m)) * (dot_pos <> 0) '                 get the decimal portion of the number
    roll = INT((mile_dec * 160) * (dot_pos <> 0)) '             roll factor of 1/10ths wheel mapped to number wheel
    overnine = ((mile_dec - .9) * -160) * (mile_dec > .9) '     get amount of roll past .9 if any
    overnine = overnine * (overnine < 17)
    backimg = _DEST
    _DEST ds '                                                  draw to numeral display window
    _PUTIMAGE (_WIDTH(ds) - 8, roll), wheel10th '             set the 1/10ths wheel position & place in slot image
    FOR dec_pos = 1 TO INT(_WIDTH(ds) / 8) '                  iterate through whole number decimal places
        xpos = _WIDTH(ds) - 1 - 8 * (dec_pos + 1) '           get number wheel x position
        dec_val = VAL(MID$(mile_str, dot_pos - dec_pos, 1)) '   get decimal place value
        ypos = -16 * dec_val '                                  get whole number rotation position
        IF overnine AND NOT break THEN '                        if 1/10th wheel past .9 and no non-nine numbers previous
            ypos = ypos + overnine '                            add 9 to 0 rotation to decimal place
            IF dec_val <> 9 THEN break = -1 '                   if the number is not a 9 break from advancing the rest
        END IF
        _PUTIMAGE (xpos, ypos), wheel '                         set number wheel in slot window
    NEXT dec_pos
    _DEST backimg '                                             done with slot image, return to screen
    _PUTIMAGE (ulx, uly), ds '                                  place counter to calling destination
END SUB 'Odometer


SUB makewheel (letter AS _UNSIGNED LONG, back AS _UNSIGNED LONG, dst AS LONG)
    DIM x%
    _DEST dst
    CLS , back
    COLOR letter
    _PRINTMODE _KEEPBACKGROUND
    FOR x% = 0 TO 9
        _PRINTSTRING (-8, x% * 16), STR$(x%)
    NEXT x%
    _PRINTSTRING (0, x% * 16), "0"
    _DEST 0
END SUB