PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

BCD 7 segments display

https://www.purebasic.fr/english/viewtopic.php?t=79459

Page 1 of 1

BCD 7 segments display

Posted: Sun Jul 10, 2022 4:29 pm
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()

Re: BCD 7 segments display

Posted: Sun Jul 10, 2022 6:02 pm
by jacdelad
That's a lot of swaps.
What is

Code: Select all

Swap b(96), b(96)
for?

Re: BCD 7 segments display

Posted: Sun Jul 10, 2022 9:09 pm
by Mijikai
Hard to understand what exactly is going on but its pretty cool (and small) i like it :)

Re: BCD 7 segments display

Posted: Sun Jul 10, 2022 11:52 pm
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.

Re: BCD 7 segments display

Posted: Thu Jul 21, 2022 12:24 pm
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...

Re: BCD 7 segments display

Posted: Tue Aug 02, 2022 12:19 pm
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)

Re: BCD 7 segments display

Posted: Wed Aug 10, 2022 7:45 am
by Ziltch
It creates a retro tech look. Very cool !
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited