A Collaboration: Mechanical Odometer algorithm

[TDarcos]

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

And I have a revised one, only running the odometer backwards adds fuel!

Code: (Select All)

'Odometer2.bas  Richard & Erik Wessel



' Shows 2 odometers; one for mileage (kilometers), one for fuel consumption in gallons (liters)

'  Added up/down to change odometers direction and

'  to adjust for rollover - Paul Robinson 2025-04-16



'  Functions:

''  Functions:

'   Key UP   - Odometer increase, as does fuel consumption

'   Key END  - Odometer stops

'   Key DOWN - Odometer decreases, as does fuel consumption

'   Insert - Reset odometer to 999999.5, fuel to about 999996.1

'   Delete - Reset odometer to 0.5, fuel to 1.5

'   Escape - quits



'  If you don't want fuel consumption to decrease on odometer rollback,

'  change that at label "down:"





$Color:32

Option _Explicit

Screen _NewImage(256, 216, 32)



Dim Shared As Long slot, slot2, wheel, wheel10th

Dim As Double miles, gals, advance, fuelconsumption

Const up = 18432, down = 20480, escape = 27

Const insert = 20992, delete = 21248

Const KeyEnd = 20224





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



GoSub up



Do

    Cls

    miles = miles + advance

    If miles >= 1000000 Then miles = 0

    If miles < 0 Then miles = 1000000.0!



    gals = gals + fuelconsumption

    If gals >= 1000000 Then gals = 0

    If gals < 0 Then gals = 1000000.0!



    Line (50, 50)-(206, 166), &HFF909090, BF

    Odometer miles, slot, 100, 100

    Odometer gals, slot2, 100, 132

    _Limit 30

    _Display

    If _KeyDown(up) Then GoSub up

    If _KeyDown(KeyEnd) Then GoSub halt

    If _KeyDown(down) Then GoSub down

    If _KeyDown(insert) Then GoSub maxmiles

    If _KeyDown(delete) Then GoSub minmiles

Loop Until _KeyDown(escape)



End

up:

advance = .002

fuelconsumption = .006

Return

down:

advance = -.002

fuelconsumption = -.006

Return

halt:

advance = 0

fuelconsumption = 0

Return

maxmiles:

miles = 999999.5

gals = 999996.1

Return

minmiles:

miles = 0.5

gals = 1.5

Return







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