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
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
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.
04-16-2025, 11:39 AM (This post was last modified: 04-16-2025, 02:56 PM by OldMoses.)
(04-16-2025, 01:05 AM)SMcNeill Wrote: 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
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
04-16-2025, 03:06 PM (This post was last modified: 04-16-2025, 03:08 PM by TDarcos.)
(04-15-2025, 11:40 PM)OldMoses Wrote: 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.
I have made an adjustment to "fix" the rollover function so it handles rolling back below 0 or above 999999. These keys were added:
* Up - Odometer rolls forward (increment)
* End - Odometer stops
* Down - Odometer rolls backward (decrement)
* Insert - Reset odometer to 999999.5
* Delete - Reset odometer to 0.5
* Escape still quits
It is shown below and for easy downloading is attached to this message.
I wish I could take credit for the smooth rollover below 0 or above 999999, but that is thanks to OldMoses' great work!
Code: (Select All)
'Odometer.bas Richard & Erik Wessel
' Added up/down to change odometer direction and
' to adjust for rollover - Paul Robinson 2025-04-16
' Functions:
' Key UP - Odometer increases
' Key END - Odometer stops
' Key DOWN - Odometer decreases
' Insert - Reset odometer to 999999.5
' Delete - Reset odometer to 0.5
' Escape - quits
$Color:32
Option _Explicit
Screen _NewImage(256, 216, 32)
Dim Shared As Long slot, wheel, wheel10th
Dim As Double miles, advance
Const up = 18432, down = 20480, escape = 27
Const insert = 20992, delete = 21248
Const KeyEnd = 20224
Do
Cls
miles = miles + advance
If miles >= 1000000 Then miles = 0
If miles < 0 Then miles = 1000000.0!
Line (50, 50)-(206, 166), &HFF909090, BF
Odometer miles
_PutImage (100, 100), slot
_Limit 30
_Display
If _KeyDown(up) Then GoSub up
If _KeyDown(KeyEnd) Then advance = 0
If _KeyDown(down) Then GoSub down
If _KeyDown(insert) Then miles = 999999.5
If _KeyDown(delete) Then miles = 0.5
Loop Until _KeyDown(escape)
End
up:
advance = .002
Return
down:
advance = -.002
Return
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
While 1
Fix Bugs
report all bugs fixed
receive bug report
end while
04-16-2025, 04:00 PM (This post was last modified: 04-16-2025, 04:02 PM by TDarcos.)
(04-16-2025, 11:39 AM)OldMoses Wrote: 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:"
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)
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
While 1
Fix Bugs
report all bugs fixed
receive bug report
end while
