|
|
Post by ukdave74 on Mar 13, 2024 12:50:10 GMT
I wanted a 7 segment display that didn't rely on pre-rendered images.
*Updated* Had a code tidy session and renamed variables to be meaningful
' 16X16 Pixel 7 Segment Display
'
' Created by: Dave Mayes
' Date: 2024-03-13
'
' Feel free to use and adapt.
Declare Sub DrawSeg (SSD_X as long, SSD_Y as long, _
SSD_Value as long,SSD_Digits as long, _
SSD_ForeGround as long, SSD_BackGround as long, _
SSD_ZeroFlag as long)
' SSD_X X position in pixels
' SSD_Y Y Position in pixels
' SSD_Value Integer value to display
' SSD_Digits Number of digits or 0 to show as many and needed
' SSD_ForeGround Colour for lit segments
' SSD_BackGround Colour for unlit segments
' SSD_ZeroFlag Leading zeros flag: 0 = unlit, non zero value for lit
' Create array to hold segment bit data
Dim Shared SSD_Byte%%(11)
' Segment data is represented as the decimal of a 7 bit number
' 1
' --
' 32 | | 2
' |64|
' --
' 16 | | 4
' | |
' --
' 8
' 0 1 2 3 4 5 6 7 8 9 0 -
Data 63,6,91,79,102,109,125,7,127,103,0,64
' Populate the array
For a = 0 To 11
Read SSD_Byte%%(a)
Next a
'start of the demo
Screen _NewImage(800, 600, 32)
_Title "7 Segment Display"
'Set demo colours
BG& = _RGB(50, 50, 50) ' Segment Off
FG1& = _RGB(250, 50, 50) ' Segment On
FG2& = _RGB(250, 250, 250) ' Segment On
FG3& = _RGB(50, 250, 50) ' Segemnt On
' Demo random numbers until a key is pressed
Do Until InKey$ <> ""
_Limit 2
Cls
' 8 digit fixed length leading zeros unlit
DrawSeg 160, 150, Int(Rnd * 999999) - 500000, 8, FG1&, BG&, 1
' 6 digit fixed length leading zeros lit
FG2& = _RGB(250, 250 - (Count& And 15) * 8, 250) ' Segment On
DrawSeg 160, 200, Count&, 6, FG2&, BG&, 0
' random length
DrawSeg 160, 250, Int(Rnd * 99999) - 50000, 0, FG3&, GB&, 0
Count& = Count& + 1
Loop
End
' Draw Number X pos, Y pos, Value, Digits, Lit Colour, Unlit Colour, Leading zeros lit
Sub DrawSeg (SSD_X, SSD_Y, SSD_Value, SSD_Digits, SSD_ForeGround, SSD_BackGround, SSD_ZeroFlag)
' print SSD_Value
Dim SSD_Colour(1) As Long, SSD_Bits As _Byte
SSD_Colour(0) = SSD_BackGround
SSD_Colour(1) = SSD_ForeGround
' Random Length
If SSD_Digits < 1 Then
' Use full string for negative numbers, or trim leading space for >= 0
If SSD_Value < 0 Then
SSD_StringValue$ = Str$(SSD_Value)
' print SSD_StringValue$, SSD_Digits
Else
SSD_StringValue$ = Mid$(Str$(SSD_Value), 2)
End If
SSD_Digits = Len(SSD_StringValue$)
' print SSD_StringValue$, SSD_Digits
Else
' Fixed length convert to padded string
SSD_StringValue$ = Right$(Space$(SSD_Digits) + Mid$(Str$(SSD_Value), 2), SSD_Digits)
' Handle negative number
If SSD_Value < 0 Then SSD_StringValue$ = "-" + Mid$(SSD_StringValue$, 2)
' print SSD_StringValue$, SSD_Digits
End If
' print SSD_StringValue$
' Loop through each digit
For SSD_Loop = 1 To SSD_Digits
' Get current digit
SSD_Digit$ = Mid$(SSD_StringValue$, SSD_Loop, 1)
' Turn leading spaces into 0's if flag set
If (SSD_ZeroFlag <> 0) And (SSD_Digit$ = " ") Then SSD_Digit$ = "10"
' Handle negative
If SSD_Digit$ = "-" Then SSD_Digit$ = "11"
SSD_Bits = Val(SSD_Digit$)
' print SSD_Bits, SSD_Byte%%(SSD_Bits) And 2 ' Debug segment
' Top Bar
Line (SSD_X + 3, SSD_Y + 1)-Step(9, 0), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 1))
Line (SSD_X + 4, SSD_Y + 2)-Step(7, 0), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 1))
' Top Right
Line (SSD_X + 14, SSD_Y + 2)-Step(0, 5), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 2))
Line (SSD_X + 13, SSD_Y + 3)-Step(0, 3), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 2))
' Bottom Right
Line (SSD_X + 14, SSD_Y + 9)-Step(0, 5), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 4))
Line (SSD_X + 13, SSD_Y + 10)-Step(0, 3), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 4))
' Bottom Bar
Line (SSD_X + 3, SSD_Y + 15)-Step(9, 0), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 8))
Line (SSD_X + 4, SSD_Y + 14)-Step(7, 0), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 8))
' Bottom Left
Line (SSD_X + 1, SSD_Y + 9)-Step(0, 5), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 16))
Line (SSD_X + 2, SSD_Y + 10)-Step(0, 3), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 16))
' Top Left
Line (SSD_X + 1, SSD_Y + 2)-Step(0, 5), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 32))
Line (SSD_X + 2, SSD_Y + 3)-Step(0, 3), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 32))
' Middle Bar
Line (SSD_X + 3, SSD_Y + 7)-Step(9, 0), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 64))
Line (SSD_X + 2, SSD_Y + 8)-Step(11, 0), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 64))
Line (SSD_X + 3, SSD_Y + 9)-Step(9, 0), SSD_Colour(Sgn(SSD_Byte%%(SSD_Bits) And 64))
' Next Digit
SSD_X = SSD_X + 16
Next SSD_Loop
End Sub
|
|
|
|
Post by bplus on Mar 13, 2024 14:26:49 GMT
Yes very nice thanks for sharing! ukdave74I think I will share back, you might like ;-))
_Title "Digital Plasmatic Clock press spacebar for new coloring set" ' b+ 2020-01-20 translated and modified from SmallBASIC
'Plasma Magnifico - updated 2015-11-26 for Android
'This program creates a plasma surface, which looks oily or silky.
Const xmax = 850, ymax = 200, sq = 25
Const dat = "1110111000001101111100011111100101110111011101101001001111111111011011"
Type xy
x As Single
y As Single
dx As Single
dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40
Dim c(360) As _Unsigned Long, p(6) As xy, f(6)
restart:
r = Rnd: g = Rnd: b = Rnd: i = 0
For n = 1 To 5
r1 = r: g1 = g: b1 = b
Do: r = Rnd: Loop Until Abs(r - r1) > .2
Do: g = Rnd: Loop Until Abs(g - g1) > .2
Do: b = Rnd: Loop Until Abs(g - g1) > .2
For m = 0 To 17: m1 = 17 - m
f1 = (m * r) / 18: f2 = (m * g) / 18: f3 = (m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
Next
For m = 0 To 17: m1 = 17 - m
f1 = (m + m1 * r) / 18: f2 = (m + m1 * g) / 18: f3 = (m + m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
Next
For m = 0 To 17: m1 = 17 - m
f1 = (m1 + m * r) / 18: f2 = (m1 + m * g) / 18: f3 = (m1 + m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
Next
For m = 0 To 17: m1 = 17 - m
f1 = (m1 * r) / 18: f2 = (m1 * g) / 18: f3 = (m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
Next
Next
For n = 0 To 5
p(n).x = Rnd * xmax: p(n).y = Rnd * ymax: p(n).dx = Rnd * 2 - 1: p(n).dy = Rnd * 2 - 1
f(n) = Rnd * .1
Next
While _KeyDown(27) = 0
If InKey$ = " " Then GoTo restart
For i = 0 To 5
p(i).x = p(i).x + p(i).dx
If p(i).x > xmax Or p(i).x < 0 Then p(i).dx = -p(i).dx
p(i).y = p(i).y + p(i).dy
If p(i).y > ymax Or p(i).y < 0 Then p(i).dy = -p(i).dy
Next
For y = 0 To ymax - 1 Step 2
For x = 0 To xmax - 1 Step 2
d = 0
For n = 0 To 5
dx = x - p(n).x: dy = y - p(n).y
k = Sqr(dx * dx + dy * dy)
d = d + (Sin(k * f(n)) + 1) / 2
Next n: d = d * 60
Line (x, y)-Step(2, 2), c(d), BF
Next
Next
For j = 1 To 3
If j = 1 Then
c~& = &HFFFFFFFF: offset = -2
ElseIf j = 2 Then
c~& = &HFF555555: offset = 2
Else
c~& = &HFFAAAAAA: offset = 0
End If
For n = 1 To 8 'clock digits over background
If Mid$(Time$, n, 1) = ":" Then
Line ((n - 1) * 4 * sq + 2 * sq + offset, sq + sq + offset)-Step(sq, sq), c~&, BF
Line ((n - 1) * 4 * sq + 2 * sq + offset, sq + 4 * sq + offset)-Step(sq, sq), c~&, BF
Else
drawC (n - 1) * 4 * sq + sq + offset, sq + offset, Mid$(dat$, Val(Mid$(Time$, n, 1)) * 7 + 1, 7), c~&
End If
Next
Next
_Display
Wend
Function rgbf~& (n1, n2, n3)
rgbf~& = _RGB32(n1 * 255, n2 * 255, n3 * 255)
End Function
Sub drawC (x, y, c$, c As _Unsigned Long)
For m = 1 To 7
If Val(Mid$(c$, m, 1)) Then
Select Case m
Case 1: Line (x, y)-Step(sq, 3 * sq), c, BF
Case 2: Line (x, y + 2 * sq)-Step(sq, 4 * sq), c, BF
Case 3: Line (x, y)-Step(3 * sq, sq), c, BF
Case 4: Line (x, y + 2 * sq)-Step(3 * sq, sq), c, BF
Case 5: Line (x, y + 5 * sq)-Step(3 * sq, sq), c, BF
Case 6: Line (x + 2 * sq, y)-Step(sq, 3 * sq), c, BF
Case 7: Line (x + 2 * sq, y + 2 * sq)-Step(sq, 4 * sq), c, BF
End Select
End If
Next
End Sub
It contains another way to do numbers without font. |
|
|
|
Post by ukdave74 on Mar 13, 2024 15:34:49 GMT
Thanks for that bplus, trying to get my head around it.
|
|
|
|
Post by bplus on Mar 13, 2024 17:49:28 GMT
Here it is for just doing the digits of time (once), white on black background:
_Title "Digital Plasmatic Clock press spacebar for new coloring set" ' b+ 2020-01-20 translated and modified from SmallBASIC
'Plasma Magnifico - updated 2015-11-26 for Android
'This program creates a plasma surface, which looks oily or silky.
Const xmax = 850, ymax = 200, sq = 25
Const dat = "1110111000001101111100011111100101110111011101101001001111111111011011"
Type xy
x As Single
y As Single
dx As Single
dy As Single
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 300, 40
Dim c(360) As _Unsigned Long, p(6) As xy, f(6)
restart:
'r = Rnd: g = Rnd: b = Rnd: i = 0
'For n = 1 To 5
' r1 = r: g1 = g: b1 = b
' Do: r = Rnd: Loop Until Abs(r - r1) > .2
' Do: g = Rnd: Loop Until Abs(g - g1) > .2
' Do: b = Rnd: Loop Until Abs(g - g1) > .2
' For m = 0 To 17: m1 = 17 - m
' f1 = (m * r) / 18: f2 = (m * g) / 18: f3 = (m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
' Next
' For m = 0 To 17: m1 = 17 - m
' f1 = (m + m1 * r) / 18: f2 = (m + m1 * g) / 18: f3 = (m + m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
' Next
' For m = 0 To 17: m1 = 17 - m
' f1 = (m1 + m * r) / 18: f2 = (m1 + m * g) / 18: f3 = (m1 + m * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
' Next
' For m = 0 To 17: m1 = 17 - m
' f1 = (m1 * r) / 18: f2 = (m1 * g) / 18: f3 = (m1 * b) / 18: c(i) = rgbf(f1, f2, f3): i = i + 1
' Next
'Next
'For n = 0 To 5
' p(n).x = Rnd * xmax: p(n).y = Rnd * ymax: p(n).dx = Rnd * 2 - 1: p(n).dy = Rnd * 2 - 1
' f(n) = Rnd * .1
'Next
While _KeyDown(27) = 0
'If InKey$ = " " Then GoTo restart
'For i = 0 To 5
' p(i).x = p(i).x + p(i).dx
' If p(i).x > xmax Or p(i).x < 0 Then p(i).dx = -p(i).dx
' p(i).y = p(i).y + p(i).dy
' If p(i).y > ymax Or p(i).y < 0 Then p(i).dy = -p(i).dy
'Next
'For y = 0 To ymax - 1 Step 2
' For x = 0 To xmax - 1 Step 2
' d = 0
' For n = 0 To 5
' dx = x - p(n).x: dy = y - p(n).y
' k = Sqr(dx * dx + dy * dy)
' d = d + (Sin(k * f(n)) + 1) / 2
' Next n: d = d * 60
' Line (x, y)-Step(2, 2), c(d), BF
' Next
'Next
'For j = 1 To 3
' If j = 1 Then
' c~& = &HFFFFFFFF: offset = -2
' ElseIf j = 2 Then
' c~& = &HFF555555: offset = 2
' Else
' c~& = &HFFAAAAAA: offset = 0
' End If
c~& = &HFFFFFFFF
For n = 1 To 8 'clock digits over background
If Mid$(Time$, n, 1) = ":" Then
Line ((n - 1) * 4 * sq + 2 * sq + offset, sq + sq + offset)-Step(sq, sq), c~&, BF
Line ((n - 1) * 4 * sq + 2 * sq + offset, sq + 4 * sq + offset)-Step(sq, sq), c~&, BF
Else
drawC (n - 1) * 4 * sq + sq + offset, sq + offset, Mid$(dat$, Val(Mid$(Time$, n, 1)) * 7 + 1, 7), c~&
End If
Next
'Next
_Display
Wend
Function rgbf~& (n1, n2, n3)
rgbf~& = _RGB32(n1 * 255, n2 * 255, n3 * 255)
End Function
Sub drawC (x, y, c$, c As _Unsigned Long)
For m = 1 To 7
If Val(Mid$(c$, m, 1)) Then
Select Case m
Case 1: Line (x, y)-Step(sq, 3 * sq), c, BF
Case 2: Line (x, y + 2 * sq)-Step(sq, 4 * sq), c, BF
Case 3: Line (x, y)-Step(3 * sq, sq), c, BF
Case 4: Line (x, y + 2 * sq)-Step(3 * sq, sq), c, BF
Case 5: Line (x, y + 5 * sq)-Step(3 * sq, sq), c, BF
Case 6: Line (x + 2 * sq, y)-Step(sq, 3 * sq), c, BF
Case 7: Line (x + 2 * sq, y + 2 * sq)-Step(sq, 4 * sq), c, BF
End Select
End If
Next
End Sub
|
|
