BCD 7 segments display

Share your advanced PureBasic knowledge/code with the community.
Olli
Addict
Addict
Posts: 1071
Joined: Wed May 27, 2020 12:26 pm

BCD 7 segments display

Post by Olli »

Code: Select all

;***********************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************************
InitSprite()
InitKeyboard()
InitMouse()

ExamineDesktops()
dw = DesktopWidth(0)
dh = DesktopHeight(0)
dd = DesktopDepth(0)

Dim b(255)
Dim c(255)
a$ = "0123456789abcdefLa relativite n'est pas qu'une  chose simple.   mov ah,02       mov dl,'A'      Set / Reset     Video   AUXc    mes grelots     Load  a         Store a         C'est la vie    alarme 1845     production      acquittement    and or xor nand "
For i = 1 To Len(a$)
        c(i - 1) = Asc(UCase(Mid(a$, i, 1) ) )
Next

For i = 0 To 255
        b(i) = i
Next
Swap b(32), b(0)
Swap b(33), b(130)
Swap b(34), b(34)
Swap b(39), b(0)
Swap b(43), b(70)
Swap b(44), b(12)
Swap b(45), b(64)
Swap b(46), b(128)
Swap b(47), b(82)
Swap b(48), b(63)
Swap b(49), b(6)
Swap b(50), b(91)
Swap b(51), b(79)
Swap b(52), b(102)
Swap b(53), b(109)
Swap b(54), b(125)
Swap b(55), b(0)
Swap b(56), b(127)
Swap b(57), b(111)
Swap b(61), b(72)
Swap b(63), b(131)
Swap b(64), b(59)
Swap b(65), b(119)
Swap b(66), b(124)
Swap b(67), b(88)
Swap b(68), b(94)
Swap b(69), b(121)
Swap b(70), b(113)
Swap b(71), b(72)
Swap b(72), b(118)
Swap b(73), b(4)
Swap b(74), b(30)
Swap b(75), b(112)
Swap b(76), b(127)
Swap b(77), b(0)
Swap b(78), b(84)
Swap b(79), b(92)
Swap b(80), b(115)
Swap b(81), b(103)
Swap b(82), b(115)
Swap b(83), b(59)
Swap b(84), b(120)
Swap b(85), b(28)
Swap b(86), b(62)
Swap b(87), b(126)
Swap b(88), b(127)
Swap b(89), b(110)
Swap b(90), b(27)
Swap b(91), b(111)
Swap b(92), b(100)
Swap b(93), b(15)
Swap b(94), b(35)
Swap b(95), b(8)
Swap b(96), b(96)

OpenScreen(dw, dh, dd, "")

CreateSprite(0, 512, 512)
If StartDrawing(SpriteOutput(0) )
        DrawingMode(#PB_2DDrawing_AllChannels)
        c = RGBA(0, 255, 0, 255)
        n = 0
        For Y = 0 To 15
                For X = 0 To 15
                        x0 = x
                        y0 = y
                        x0 * 18
                        y0 * 30
                        q = b(c(n) )
                        If q & 1: Line(x0 + 1, y0, 11, 1, c): Line(x0 + 2, y0 + 1, 9, 1, c): Line(x0 + 3, y0 + 2, 7, 1, c): EndIf
                        If q & 32: Line(x0, y0 + 1, 1, 11, c): Line(x0 + 1, y0 + 2, 1, 9, c): Line(x0 + 2, y0 + 3, 1, 7, c): EndIf
                        If q & 2: Line(x0 + 12, y0 + 1, 1, 11, c): Line(x0 + 11, y0 + 2, 1, 9, c): Line(x0 + 10, y0 + 3, 1, 7, c): EndIf
                        If q & 64: Line(x0 + 1, y0 + 12, 11, 1, c): Line(x0 + 2, y0 + 11, 9, 1, c): Line(x0 + 2, y0 + 13, 9, 1, c): EndIf
                        If q & 16: Line(x0, y0 + 13, 1, 11, c): Line(x0 + 1, y0 + 14, 1, 9, c): Line(x0 + 2, y0 + 15, 1, 7, c): EndIf
                        If q & 4: Line(x0 + 12, y0 + 13, 1, 11, c): Line(x0 + 11, y0 + 14, 1, 9, c): Line(x0 + 10, y0 + 15, 1, 7, c): EndIf
                        If q & 8: Line(x0 + 1, y0 + 24, 11, 1, c): Line(x0 + 2, y0 + 23, 9, 1, c): Line(x0 + 3, y0 + 22, 7, 1, c): EndIf
                        If q & 128: Box(x0 + 14, y0 + 22, 3, 3, c): EndIf
                        n + 1
                Next
        Next
        
        StopDrawing()
EndIf

Repeat
        Delay(16)
        ClearScreen(0)
        ExamineKeyboard()
        DisplaySprite(0, 0, 0)
        FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

CloseScreen()
User avatar
jacdelad
Addict
Addict
Posts: 1418
Joined: Wed Feb 03, 2021 12:46 pm
Location: Planet Riesa
Contact:

Re: BCD 7 segments display

Post by jacdelad »

That's a lot of swaps.
What is

Code: Select all

Swap b(96), b(96)
for?
PureBasic 6.04/XProfan X4a/Embarcadero RAD Studio 11/Perl 5.2/Python 3.10
Windows 11/Ryzen 5800X/32GB RAM/Radeon 7770 OC/3TB SSD/11TB HDD
Synology DS1821+/36GB RAM/130TB
Synology DS920+/20GB RAM/54TB
Synology DS916+ii/8GB RAM/12TB
User avatar
Mijikai
Addict
Addict
Posts: 1360
Joined: Sun Sep 11, 2016 2:17 pm

Re: BCD 7 segments display

Post by Mijikai »

Hard to understand what exactly is going on but its pretty cool (and small) i like it :)
Olli
Addict
Addict
Posts: 1071
Joined: Wed May 27, 2020 12:26 pm

Re: BCD 7 segments display

Post by Olli »

@jacDeLad

In fact, this is the way to build the table. 7 segments is 7 bits, so we have a table of 2^7 symbols, or 128 symbols (characters). The swaps make it possible to render the usual symbols with the ASCII table (except completely denatured case). And useless swaps are hesitations, the result is so ugly. But, I remember a VCR in 1989 that displayed words with BCD so ugly things have their heyday.

@mijikai

Yes it may be very difficult for you, I imagine. Any characters which are fully diskorted. Plus, there is absolutely no compatibility, excepted change the string a$ and synchronize again. To be continued, and I see you created a better way to display this more easily. Thank you.
Olli
Addict
Addict
Posts: 1071
Joined: Wed May 27, 2020 12:26 pm

Re: BCD 7 segments display

Post by Olli »

Now, to get all the upper and lower letters, and have the maximum of ASCII characters between code 0 and code 127, I will be inspired by a display which seems like the device of Texas Instrument : the "Speak n spell" device. TI made this last one in 1978 through a BCD 14 segments.
14 segments BCD Display example
I prefer the BCD 16 segments. Normally, the program should not change a lot. A little bit more of 'swap's than the initial code, to get several characters as ( ) { } % etc...

It won't be very beautiful...
Olli
Addict
Addict
Posts: 1071
Joined: Wed May 27, 2020 12:26 pm

Re: BCD 7 segments display

Post by Olli »

16-segments "BCD" done (I can't imagine, however, the positivity of the commercial aspect...)

Code: Select all

ExamineDesktops()                ;   -5- -3-
dw = DesktopWidth(0)             ;  |\  |  /|
dh = DesktopHeight(0)            ;  7 6 4 2 1
InitSprite()                     ;  |  \|/  |
OpenScreen(dw, dh, 32, "")       ;   -8- -0-
InitKeyboard()                   ;  |  /|\  |
Define.d a1, a2                  ;  9 a c e f
Define.d x0, y0, x1, y1, x2, y2  ;  |/  |  \|
Define.d r1, r2                  ;   -b- -d- 
Define.d dsX, dsY
Define.d dsvX, dsvY
r1 = 5 * 2
r2 = 7 * 2
Global.d cw = r1 * 1.5
Global.d ch = r2 * 2.1
x0 = dw / 2
y0 = dh / 2
CreateSprite(1, dw / 2, dh * 4)
c = RGB(0, 255, 0)
Global Dim cd(127)
Global unZi = 32
Procedure unZ(a)
    For c = 0 To 48 Step 16
        cd(unZi) = (a >> c) & $FFFF
        unZi + 1
    Next
EndProcedure
unZ($3B910090286C0000)
unZ($0010EC1C8484B9B9)
unZ($111145451C70701C)
unZ($0404080001010700)
unZ($A82B2B2B8006EAEA)
unZ($802AABA9A9A98183)
unZ($07200900A9ABABAB)
unZ($082B044029014004)
unZ($2AA8B83B83ABBB2A)
unZ($AAA903A82BA8B83A)
unZ($4384AA0238388383)
unZ($AAAAC2C282C62A80)
unZ($6A6A43ABEAAA03AB)
unZ($C6820684AA821038)
unZ($0AA02C2C10444444)
unZ($2800000AA00A4040)
unZ($2B01AB813B000070)
unZ($2DB811192F00AB03)
unZ($5011AA0A39208381)
unZ($AB01830193013830)
unZ($6001030111B003B0)
unZ($BA000600AA003111)
unZ($31180D00A8133901)
unZ($6C0000B318311010)
Procedure seg(x0.d, y0.d, x1.d, y1.d, c)
    Define.d xa, ya, xb, yb
    xa = (x1 + 9 * x0) / 10
    ya = (y1 + 9 * y0) / 10
    xb = (x0 + 9 * x1) / 10
    yb = (y0 + 9 * y1) / 10
    LineXY(xa, ya, xb, yb, c)
EndProcedure
Procedure char(cd, x0.d, y0.d, c, r1.d, r2.d)
    If cd > 31 And cd < 128
        Define.d a1 = 0.0, a2, x1, y1, x2, y2
        Define cd0 = 0
        Repeat
            a2 = a1 + (#PI / 4)
            x1 = x0 + Cos(a1) * r1 * 0.5
            y1 = y0 - Sin(a1) * r1
            x2 = x0 + Cos(a2) * r2 * 0.5
            y2 = y0 - Sin(a2) * r2
            If cd(cd) & (1 << cd0)
                seg(x0, y0, x1, y1, c)
            EndIf
            If cd(cd) & (2 << cd0)
                seg(x1, y1, x2, y2, c)
            EndIf
            a1 + (#PI / 4)
            Swap r1, r2           
            cd0 + 2
        Until a1 => (2 * #PI)  
    EndIf          
EndProcedure
Procedure text(a$, x0.d, y0.d, c, r1.d, r2.d)
    For i = 1 To Len(a$)
        char(Asc(Mid(a$, i, 1) ), x0, y0, c, r1, r2)
        x0 + cw
    Next
EndProcedure
cd = 0
StartDrawing(SpriteOutput(1) )
y0 = ch
ReadFile(10, #PB_Compiler_File, #PB_File_SharedRead) ; windows only
ReadStringFormat(10)
While Not Eof(10)
    x0 = cw        
    a$ = ReadString(10)
    text(a$, x0, y0, c, r1, r2)
    y0 + ch
Wend
CloseFile(10)
StopDrawing()
Repeat
    ExamineKeyboard()
    Delay(1)
    ClearScreen(0)
    DisplaySprite(1, dsX, dsY)
    dsvY - (Bool(KeyboardPushed(#PB_Key_Down) ) - Bool(KeyboardPushed(#PB_Key_Up) ) )
    dsY + dsvY
    dsvY * 0.9
    FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
Ziltch
User
User
Posts: 52
Joined: Sun Aug 03, 2003 12:05 am
Location: Australia

Re: BCD 7 segments display

Post by Ziltch »

It creates a retro tech look. Very cool !
Post Reply