A Collaboration: Mechanical Odometer algorithm

[OldMoses]

My son's coding of a locomotive powertrain modeling ap gave me the inspiration to try this one. A mechanical multi-wheel style counter. It's something of a father/son collaboration and was a fun head scratcher. I was pleased to see it would run in reverse too, except that it didn't like going below zero much. That would have to be trapped outside the SUB. Enjoy.

Code: (Select All)

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

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

slot = _NEWIMAGE(56, 16, 32) '                                  numeral display window/limits
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
miles = 0
DO
    CLS
    miles = miles + .002
    LINE (50, 50)-(206, 166), &HFF909090, BF
    Odometer miles
    _PUTIMAGE (100, 100), slot
    _LIMIT 30
    _DISPLAY
LOOP UNTIL _KEYDOWN(27)
END


SUB Odometer (m AS DOUBLE)
    DIM AS STRING mile_str
    DIM AS SINGLE mile_dec, roll
    DIM AS INTEGER dot_pos, overnine, dec_pos, dec_val, xpos, ypos, break
    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 = (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)
    _DEST slot '                                                draw to numeral display window
    _PUTIMAGE (_WIDTH(slot) - 8, INT(roll)), wheel10th '        set the 1/10ths wheel position & place in slot image
    FOR dec_pos = 1 TO INT(_WIDTH(slot) / 8) '                  iterate through whole number decimal places
        xpos = _WIDTH(slot) - 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 0 '                                                   done with slot image, return to screen
END SUB 'OdometerII


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