spinning digital (led dots) odometer

[tsh73]

Looks really cool


Try buttons increase / decrease, may be several time
check / uncheck Fluctuate

It does create digits.bmp first time, next time it will skip BMP creation.
In uses Courier 8 (NOT truetype Courier New!) to get pixels for 5x9 font
It works on my machine
Just in case it does not work on yours - I'll attach picture
Save it with a folder with a program

'tsh73 Oct 2023
'interesting visualisation
'from Boeing tachimeter
'(from random hardware thread)
'it did have circular dial with a handle, scaled 0..1.2 (120%)
'and this indicator above.
'there is 3 places for integer indicator
'   should be filled with gray dots then off
'   pre-flushed bg?
'3 big dots apart
'then decimal dot, always on
'then place for spinning decimals, 2 digits hight
'so it needs 2 graphic boxes
'(sc+1)*  3* (5+3) x (sc+1)* 11
'   96x44
'(sc+1)*  5 x (sc+1)* 21
'   20x84
'(alas in JB we have borders)
'may be common outer graphibox?
'last touch - then bitmap exists, use it instead of creating
nomainwin
dim info$(10, 10)

on$="228 255 32"  'bright
off$="104 94  102" 'gray
bg$="36 36 36"    'dark bg

w=5
h=10
sc=3    'scale (size of light dot, +1 pixel for border)


if fileExists(DefaultDir$, "digits.bmp") then
   loadbmp "digits", "digits.bmp"
   goto [startGUI]
end if

WindowHeight = 640
open "test" for graphics_nsb_nf as #gr
#gr "home; down; posxy cx cy"
#gr "trapclose [quit]"

'#gr "circle 30"
'#gr "go 20"

#gr "home"
#gr "font courier 8"    'fits 5x9 matrix
#gr "\01234567890"

xs=0
for i = 0 to 10
   y0=cy
   x0=2+cx+i*(w+3)
   #gr "getbmp tmp ";x0;" ";y0-h;" ";w;" ";h
   ys=h*i
   'xs=w*(i mod 2)
   #gr "drawbmp  tmp ";xs;" ";ys
next

#gr "color ";bg$
#gr "backcolor ";bg$
#gr "place 100 0"
#gr "boxfilled 150 600"

for y = 0 to h*11
   for x = 0 to w-1

       y0=y
       x0=x
       'print GetPixelValue$(x, y, "#gr");":";
       if GetPixelValue$(x, y, "#gr")="0 0 0" then
           #gr "color ";on$
           #gr "backcolor ";on$
       else
           #gr "color ";off$
           #gr "backcolor ";off$
       end if
       xs=100+x*(sc+1)
       ys=y*(sc+1)
       #gr "place ";xs;" ";ys
       #gr "boxfilled ";xs+sc;" ";ys+sc
   next
next

#gr "getbmp digits ";100;" ";0;" ";w*(sc+1);" ";h*11*(sc+1)
bmpsave "digits", "digits.bmp"
#gr "drawbmp  digits ";200;" ";10

close #gr

[startGUI]
'now actual GUI

'   Form created with the help of Freeform-J v.261006
'   Generated on Oct 15, 2023 at 21:51:01

   nomainwin

   WindowWidth = 472
   WindowHeight = 150

   UpperLeftX=int((DisplayWidth-WindowWidth)/2)
   UpperLeftY=int((DisplayHeight-WindowHeight)/2)

   graphicbox #main.int, 16, 36, 96, 44
   graphicbox #main.frac, 112, 16, 21, 84
   graphicbox #main.bg, 10, 10, 128, 95

   button #main.btnSet, "Set", [SetClick], UL, 318, 46, 122, 25
   button #main.btnInc, "increase", [IncClick], UL, 318, 11, 122, 25
   button #main.btnDec, "Decrease", [DecClick], UL, 318, 81, 122, 25

   statictext #main.lblRate, "0", 206, 5, 104, 20
   statictext #main.lblCur, "100", 206, 25, 104, 20
   textbox #main.tb1, 206, 46, 100, 25
   checkbox #main.chkFlu, "fluctuate", [FluSet], [FluReset], 206, 86, 88, 20

   open "Odometer demo" for window_nf as #main
   print #main.int,"down; fill black; flush"
   print #main.frac,"down; fill black; flush"
   print #main.bg,"down; fill darkgray; flush"
   'for decimal dot
   #main.int "color ";on$
   #main.int "backcolor ";on$

   print #main, "trapclose [quit.main]"

   curVal=100
   curRate = 0

   #main.tb1 curVal

   print #main, "font ms_sans_serif 10"
   timer 100, [tick]

   wait

[quit.main]
   Close #main
   END

[tick]
    #main.int "discard"
    #main.frac "discard"
   curVal = curVal+ curRate+fluOn*cos((time$("ms")-t0)/1000)/20
   #main.lblCur curVal
   's$=using(curVal,"###")
   s$=mid$(str$(curVal+1000),2)    'cut first 1
   for i = 0 to 2
       n = val(mid$(s$,i+1,1))
       xs=(sc+1)*(5+3)*i
       ys=0-n*(sc+1)*10
       #main.int "drawbmp digits ";xs;" ";ys
   next
   'decimal dot
    xs=(sc+1)*((5+3)*2+6)
       ys=8*(sc+1)
       #main.int "place ";xs;" ";ys
       #main.int "boxfilled ";xs+sc;" ";ys+sc
       ys=7*(sc+1)
       #main.int "place ";xs;" ";ys
       #main.int "boxfilled ";xs+sc;" ";ys+sc

   f=curVal-int(curVal)
   'f=0.3
   ys=0-(sc+1)*10*(f*10-0.5)
   #main.frac "drawbmp digits ";0;" ";ys

wait


[SetClick]    'Perform action for the button named 'btnSet'
   #main.tb1 "!contents? curV"
   #main.lblRate curRate
   if curV<>0 then curVal=curV
   curRate = 0
   wait


[IncClick]    'Perform action for the button named 'btnInc'
   curRate=curRate+0.01
   #main.lblRate curRate
   wait


[DecClick]    'Perform action for the button named 'btnDec'
   curRate=curRate-0.01
   #main.lblRate curRate
   wait


[FluSet]    'Perform action for the checkbox named 'chkFlu'
   fluOn=1
   t0 =time$("ms")
   wait


[FluReset]    'Perform reset for the checkbox named 'chkFlu'
   fluOn=0
   wait



'*****************************************************
'GetPixelValue$ returns a string with the RGB values of the pixel
'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph")
function GetPixelValue$(x, y, handle$)

'Grab a 1*1 bitmap
   #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1

'Save in a bmp file
   bmpsave "gpv", "getpvaluetemp.bmp"

'Open the file for string input and get it's full contents
   open "getpvaluetemp.bmp" for input as #gpv
   s$ = input$(#gpv, lof(#gpv))
   close #gpv

'Check if user's display is 32-bit, and read the red-green-blue values
'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0
'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment
'otherwise function returns nothing (support for other display types could be added (?))
   bpp =  asc(mid$(s$, 29, 1))
   select case bpp
   case 32
       red = asc(mid$(s$, 69, 1))
       green = asc(mid$(s$, 68, 1))
       blue = asc(mid$(s$, 67, 1))
   case 16
       bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
       red =  (bytes AND 63488) /256       '0xF800
       green =  (bytes AND 2016) / 32 * 4  '0x7E0
       blue =  (bytes AND 31) * 8          '0x1F
   end select


'concatenate the return value, delete temporary file and free memory
   GetPixelValue$ = str$(red)+" "+str$(green)+" "+str$(blue)
   kill "getpvaluetemp.bmp"
   unloadbmp "gpv"
end function

function fileExists(path$, filename$)
 'dimension the array info$( at the beginning of your program
 files path$, filename$, info$()
 fileExists = val(info$(0, 0)) 'non zero is true
end function


Attachments:

digits.bmp (34.43 KB)

[xxgeek]

Hello again Anatoly, just letting you know about one minor issue I had here, otherwise it's working fine as intended.

On first run it crashed "attempting to kill a non existing file"

Changing,
kill "getpvaluetemp.bmp"
to
if fileExists(DefaultDir$, "getpvaluetemp.bmp") then kill "getpvaluetemp.bmp"

[tsh73]

Some fixes

1) make it work under Win10
Program was developed under WinXP
It looks like there is no "Courier" in Win 10, it sets Courier New anyway
So font is different - I filled some numbers to get to 5x9 (actually got 5x8, but still looks good)

after setting ClearType off (in display parameters) I got font capturing to be working with checking against "0 0 0" color

(there is a way to go without it,
using r+g+b to check against threshold
c$=GetPixelValue$(x, y, "#gr")
       r=val(word$(c$,1)): g=val(word$(c$,1)): b=val(word$(c$,1))
       if r+g+b<500 then  '500 is trial-and-error threshold, white supposed to be 255*3

but I do not like characters I got
:((
)

Caution!
You probably should not fiddle with font smoothing if you already like that you got on your display *now*
Use attached BMP, that's all
New bitmap attached, save it to program if font capturing does not work for you.

2) cut number on the ">0" condition. It just does not work with negatives (probably could be fixed, and sign added)

3) added endmost digits around "0123456789" so rolling over '0' is smooth

4) do not display leading 0 in 100's and 10's

xxgeek: I do not get this error.
Actually considering this function is called in a loop - I'd rather removed that 'kill' altogeter
Having left single bitmap of a single pixel on a disk do not pose that big problem ;)


'tsh73 Oct 2023
'interesting visualisation
'from Boeing tachimeter
'(from random hardware thread)
'it did have circular dial with a handle, scaled 0..1.2 (120%)
'and this indicator above.
'there is 3 places for integer indicator
'   should be filled with gray dots then off
'   pre-flushed bg?
'3 big dots apart
'then decimal dot, always on
'then place for spinning decimals, 2 digits hight
'so it needs 2 graphic boxes
'(sc+1)*  3* (5+3) x (sc+1)* 11
'   96x44
'(sc+1)*  5 x (sc+1)* 21
'   20x84
'(alas in JB we have borders)
'may be common outer graphibox?
'last touch - then bitmap exists, use it instead of creating
'16 10 2023 fixes for Win 10 - Courier new

nomainwin
dim info$(10, 10)

on$="228 255 32"  'bright
off$="104 94  102" 'gray
bg$="36 36 36"    'dark bg

w=5
h=10
sc=3    'scale (size of light dot, +1 pixel for border)
dig$="9012345678901 "
spsPos=12

if fileExists(DefaultDir$, "digits2.bmp") then
   loadbmp "digits", "digits2.bmp"
   goto [startGUI]
end if

WindowHeight = 640
open "test" for graphics_nsb_nf as #gr
#gr "home; down; posxy cx cy"
#gr "trapclose [quit1]"

'#gr "circle 30"
'#gr "go 20"

#gr "home"
#gr "font courier_new 9"    'fits 5x8 matrix, better 0 characters, 4 is a bit wide (rightmost dot truncated)
'#gr "font courier_new 7 17" 'fits 5x9 matrix
#gr "\"+dig$

xs=0
for i = 0 to len(dig$)
   y0=cy
   'x0=2+cx+i*(w+3)
   x0=1+cx+i*(w+2)
   #gr "getbmp tmp ";x0;" ";y0-h;" ";w;" ";h
   ys=h*i
   'xs=w*(i mod 2)
   #gr "drawbmp  tmp ";xs;" ";ys
next

#gr "color ";bg$
#gr "backcolor ";bg$
#gr "place 100 0"
#gr "boxfilled 150 600"

for y = 0 to h*len(dig$)
   for x = 0 to w-1

       y0=y
       x0=x
       'print GetPixelValue$(x, y, "#gr");":";
       if GetPixelValue$(x, y, "#gr")="0 0 0" then    'works only if fomt smoothing is off
       'if GetPixelValue$(x, y, "#gr")<>"255 255 255" then
       'c$=GetPixelValue$(x, y, "#gr")
       'r=val(word$(c$,1)): g=val(word$(c$,1)): b=val(word$(c$,1))
       'if r+g+b<500 then
           #gr "color ";on$
           #gr "backcolor ";on$
       else
           #gr "color ";off$
           #gr "backcolor ";off$
       end if
       xs=100+x*(sc+1)
       ys=y*(sc+1)
       #gr "place ";xs;" ";ys
       #gr "boxfilled ";xs+sc;" ";ys+sc
   next
next

#gr "getbmp digits ";100;" ";0;" ";w*(sc+1);" ";h*len(dig$)*(sc+1)
bmpsave "digits", "digits2.bmp"
#gr "drawbmp  digits ";200;" ";10

wait
close #gr

[startGUI]
'now actual GUI

'   Form created with the help of Freeform-J v.261006
'   Generated on Oct 15, 2023 at 21:51:01

   nomainwin

   WindowWidth = 472
   WindowHeight = 150

   UpperLeftX=int((DisplayWidth-WindowWidth)/2)
   UpperLeftY=int((DisplayHeight-WindowHeight)/2)

   graphicbox #main.int, 16, 36, 96, 44
   graphicbox #main.frac, 112, 16, 21, 84
   graphicbox #main.bg, 10, 10, 128, 95

   button #main.btnSet, "Set", [SetClick], UL, 318, 46, 122, 25
   button #main.btnInc, "increase", [IncClick], UL, 318, 11, 122, 25
   button #main.btnDec, "Decrease", [DecClick], UL, 318, 81, 122, 25

   statictext #main.lblRate, "0", 206, 5, 104, 20
   statictext #main.lblCur, "100", 206, 25, 104, 20
   textbox #main.tb1, 206, 46, 100, 25
   checkbox #main.chkFlu, "fluctuate", [FluSet], [FluReset], 206, 86, 88, 20

   open "Odometer demo" for window_nf as #main
   print #main.int,"down; fill black; flush"
   print #main.frac,"down; fill black; flush"
   print #main.bg,"down; fill darkgray; flush"
   'for decimal dot
   #main.int "color ";on$
   #main.int "backcolor ";on$

   print #main, "trapclose [quit.main]"

   curVal=100
   curRate = 0

   #main.tb1 curVal

   print #main, "font ms_sans_serif 10"
   timer 100, [tick]

   wait

[quit.main]
   Close #main
   END

[tick]
    #main.int "discard"
    #main.frac "discard"
   curVal = curVal+ curRate+fluOn*cos((time$("ms")-t0)/1000)/20
   if curVal<0 then curVal=0  'cut it, graphic partr does not work any good with negatives
   #main.lblCur curVal
   's$=using(curVal,"###")
   s$=mid$(str$(curVal+1000),2)    'cut first 1
   firstZero=1
   for i = 0 to 2
       n = val(mid$(s$,i+1,1))
       if (n = 0) and (i<2) then
           if firstZero then n = spsPos    'do not draw first zeiro
       else
           firstZero=0
       end if
       xs=(sc+1)*(5+3)*i
       ys=0-(n+1)*(sc+1)*10
       #main.int "drawbmp digits ";xs;" ";ys
   next
   'decimal dot
    xs=(sc+1)*((5+3)*2+6)
       ys=8*(sc+1)
       #main.int "place ";xs;" ";ys
       #main.int "boxfilled ";xs+sc;" ";ys+sc
       ys=7*(sc+1)
       #main.int "place ";xs;" ";ys
       #main.int "boxfilled ";xs+sc;" ";ys+sc

   f=curVal-int(curVal)
   'f=0.3
   ys=0-(sc+1)*10*(f*10-0.5+1)
   #main.frac "drawbmp digits ";0;" ";ys

wait


[SetClick]    'Perform action for the button named 'btnSet'
   #main.tb1 "!contents? curV"
   #main.lblRate curRate
   if curV>=0 then curVal=curV
   curRate = 0
   wait


[IncClick]    'Perform action for the button named 'btnInc'
   curRate=curRate+0.01
   #main.lblRate curRate
   wait


[DecClick]    'Perform action for the button named 'btnDec'
   curRate=curRate-0.01
   #main.lblRate curRate
   wait


[FluSet]    'Perform action for the checkbox named 'chkFlu'
   fluOn=1
   t0 =time$("ms")
   wait


[FluReset]    'Perform reset for the checkbox named 'chkFlu'
   fluOn=0
   wait



'*****************************************************
'GetPixelValue$ returns a string with the RGB values of the pixel
'in coordinates x and y in window/graphicbox names handle$ (e.g, "#main.graph")
function GetPixelValue$(x, y, handle$)

'Grab a 1*1 bitmap
   #handle$, "getbmp gpv "; x; " "; y; " "; 1; " "; 1

'Save in a bmp file
   bmpsave "gpv", "getpvaluetemp.bmp"

'Open the file for string input and get it's full contents
   open "getpvaluetemp.bmp" for input as #gpv
   s$ = input$(#gpv, lof(#gpv))
   close #gpv

'Check if user's display is 32-bit, and read the red-green-blue values
'If display 16 bit, then colors are masked. So some last (3 for red, 2 for green, 3 for blue) bits always 0
'That means that you did not get 255 255 255 for white - (248 252 248) instead. You have to experiment
'otherwise function returns nothing (support for other display types could be added (?))
   bpp =  asc(mid$(s$, 29, 1))
   select case bpp
   case 32
       red = asc(mid$(s$, 69, 1))
       green = asc(mid$(s$, 68, 1))
       blue = asc(mid$(s$, 67, 1))
   case 16
       bytes = asc(mid$( s$, 67, 1)) + 256*asc(mid$( s$, 68, 1))
       red =  (bytes AND 63488) /256       '0xF800
       green =  (bytes AND 2016) / 32 * 4  '0x7E0
       blue =  (bytes AND 31) * 8          '0x1F
   end select


'concatenate the return value, delete temporary file and free memory
   GetPixelValue$ = str$(red)+" "+str$(green)+" "+str$(blue)
   kill "getpvaluetemp.bmp"
   unloadbmp "gpv"
end function

function fileExists(path$, filename$)
 'dimension the array info$( at the beginning of your program
 files path$, filename$, info$()
 fileExists = val(info$(0, 0)) 'non zero is true
end function

[quit1]
close #gr
goto [startGUI]


Attachments:

digits2.bmp (43.81 KB)