Another BCD-7 Rendering Example

Mijikai · Post by **Mijikai** » Sun Jul 10, 2022 9:12 pm

Have fun

EnableExplicit

;BCD-7 Example by Mijikai :D
;PB 6.0 LTS x64

UsePNGImageEncoder()
UsePNGImageDecoder()

Procedure.i bcd7Font();<- create bcd-7 texture charset
  Protected img.i,index.i,px.i,py.i
  Protected *draw.CLSID,*link.CLSID
  img = CreateImage(#PB_Any,16 << 3,8,32,#PB_Image_Transparent)
  If img
    If StartDrawing(ImageOutput(img))
      DrawingMode(#PB_2DDrawing_AllChannels)
      *draw = ?bcd7_matrix + 20
      *link = ?bcd7_matrix - 8
      For index = 0 To 15
        px = index << 3
        For py = 0 To 6
          LineXY(px + *link\Data4[0],*link\Data4[1],px + *link\Data4[2],*link\Data4[3],*draw\Data4[py] * $FFFFFFFF)
          *link + 4
        Next
        *link - 28
        *draw + 7
      Next
      StopDrawing()
      *draw = EncodeImage(img,#PB_ImagePlugin_PNG,#Null,32)
      FreeImage(img)
      ProcedureReturn *draw
    EndIf
    FreeImage(img)
  EndIf
  ProcedureReturn #Null
  bcd7_matrix:
  !db 2,0,6,0,1,1,1,2,7,1,7,2,2,3,6,3,1,4,1,5,7,4,7,5,2,6,6,6
  !db 1,1,1,0,1,1,1,0,0,1,0,0,1,0,1,0,1,1,1,0,1,1,0,1,1,0,1,1;<- lazy (should be bits)!
  !db 0,1,1,1,0,1,0,1,1,0,1,0,1,1,1,1,0,1,1,1,1,1,0,1,0,0,1,0
  !db 1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,0,1,0,1,1,1,1
  !db 0,0,0,1,1,0,1,0,0,1,1,1,1,1,1,1,0,1,1,0,1,1,1,0,1,1,0,0
EndProcedure

Procedure.i bcd7DrawText(Sprite.i,X.i,Y.i,Size.i,Text.s);<- map text to the bcd-7 sprite charset
  Protected *chr.Unicode,*Map.Unicode
  Protected index.i
  *chr = @Text
  While *chr\u
    *map = ?bcd7_decode
    For index = 0 To 15;<- lazy (slow way)!
      If *chr\u = *map\u
        ClipSprite(Sprite,index << 3,0,8,8)
        ZoomSprite(Sprite,Size,Size)
        DisplayTransparentSprite(Sprite,X,Y,255,#Red +index << 7)
        Break
      EndIf
      *map + 2
    Next
    X + Size
    *chr + 2
  Wend
  ClipSprite(Sprite,0,0,128,8)
  ProcedureReturn #Null
  bcd7_decode:
  !du '0123456789abcdef'
EndProcedure

Procedure.i Main()
  Protected exit.i,sprite.i
  Protected *font
  *font = bcd7Font()
  If *font
    If InitSprite()
      If OpenWindow(0,#Null,#Null,600,400,"BCD-7 Demo by Mijikai",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
        If OpenWindowedScreen(WindowID(0),#Null,#Null,600,400)
          SetFrameRate(60)
          sprite = CatchSprite(#PB_Any,*font,#PB_Sprite_AlphaBlending)
          If sprite
            Repeat
              Repeat
                Select WindowEvent()
                  Case #PB_Event_CloseWindow
                    exit = #True
                  Case #Null
                    Break
                EndSelect
              ForEver
              ClearScreen($0)
              ZoomSprite(sprite,580,50)
              RotateSprite(sprite,30,#PB_Absolute)
              DisplayTransparentSprite(sprite,0,180,30,#Red)
              RotateSprite(sprite,0,#PB_Absolute)
              bcd7DrawText(sprite,45,180,32,"abcdef0123456789")
              FlipBuffers()
            Until exit
            FreeSprite(sprite)
          EndIf
          CloseScreen()  
        EndIf
        CloseWindow(0)  
      EndIf
    EndIf
    FreeMemory(*font)
  EndIf
  ProcedureReturn #Null
EndProcedure

Main()

End

Olli · Post by **Olli** » Mon Jul 11, 2022 8:15 am

I can only read your listing and I am puzzled by the technic used here !

Post by **idle** » Mon Jul 11, 2022 8:37 am

That's very clever and it even got Olli stumped.

StarBootics · Post by **StarBootics** » Mon Jul 11, 2022 9:02 am

Hello everyone,

I would like to give the code a try but the CLSID appear to be Windows only.

Best regards
StarBootics

Post by **idle** » Mon Jul 11, 2022 9:22 am

try this

Code: Select all

Structure CLSID 
  StructureUnion 
  nData.q  
  EndStructureUnion
  Data4.a[0]
EndStructure

juergenkulow · Post by **juergenkulow** » Mon Jul 11, 2022 9:30 am

I try it under Linux with C Backend Optimizer:

Code: Select all

CompilerIf Not Defined(CLSID,#PB_Structure)
Structure CLSID
  Data1.l
  Data2.w
  Data3.w
  Data4.b[8]
EndStructure
CompilerEndIf

DataSection
    bcd7_matrix:
  Data.b 2,0,6,0,1,1,1,2,7,1,7,2,2,3,6,3,1,4,1,5,7,4,7,5,2,6,6,6
  Data.b 1,1,1,0,1,1,1,0,0,1,0,0,1,0,1,0,1,1,1,0,1,1,0,1,1,0,1,1;<- lazy (should be bits)!
  Data.b 0,1,1,1,0,1,0,1,1,0,1,0,1,1,1,1,0,1,1,1,1,1,0,1,0,0,1,0
  Data.b 1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,0,1,0,1,1,1,1
  Data.b 0,0,0,1,1,0,1,0,0,1,1,1,1,1,1,1,0,1,1,0,1,1,1,0,1,1,0,0
  bcd7_decode:
  Data.s "0123456789abcdef"
  EndDataSection

StarBootics · Post by **StarBootics** » Mon Jul 11, 2022 9:41 am

hello everyone,

The same code modified for Linux and the C backend :

Code: Select all

EnableExplicit

;BCD-7 Example by Mijikai :D
;PB 6.0 LTS x64

CompilerIf Not Defined(CLSID,#PB_Structure)
  Structure CLSID
    Data1.l
    Data2.w
    Data3.w
    Data4.b[8]
  EndStructure
CompilerEndIf

UsePNGImageEncoder()
UsePNGImageDecoder()

Procedure.i bcd7Font();<- create bcd-7 texture charset
  Protected img.i,index.i,px.i,py.i
  Protected *draw.CLSID,*link.CLSID
  img = CreateImage(#PB_Any,16 << 3,8,32,#PB_Image_Transparent)
  If img
    If StartDrawing(ImageOutput(img))
      DrawingMode(#PB_2DDrawing_AllChannels)
      *draw = ?bcd7_matrix + 20
      *link = ?bcd7_matrix - 8
      For index = 0 To 15
        px = index << 3
        For py = 0 To 6
          LineXY(px + *link\Data4[0],*link\Data4[1],px + *link\Data4[2],*link\Data4[3],*draw\Data4[py] * $FFFFFFFF)
          *link + 4
        Next
        *link - 28
        *draw + 7
      Next
      StopDrawing()
      *draw = EncodeImage(img,#PB_ImagePlugin_PNG,#Null,32)
      FreeImage(img)
      ProcedureReturn *draw
    EndIf
    FreeImage(img)
  EndIf
  ProcedureReturn #Null
;   bcd7_matrix:
;   !db 2,0,6,0,1,1,1,2,7,1,7,2,2,3,6,3,1,4,1,5,7,4,7,5,2,6,6,6
;   !db 1,1,1,0,1,1,1,0,0,1,0,0,1,0,1,0,1,1,1,0,1,1,0,1,1,0,1,1;<- lazy (should be bits)!
;   !db 0,1,1,1,0,1,0,1,1,0,1,0,1,1,1,1,0,1,1,1,1,1,0,1,0,0,1,0
;   !db 1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,0,1,0,1,1,1,1
;   !db 0,0,0,1,1,0,1,0,0,1,1,1,1,1,1,1,0,1,1,0,1,1,1,0,1,1,0,0
EndProcedure

Procedure.i bcd7DrawText(Sprite.i,X.i,Y.i,Size.i,Text.s);<- map text to the bcd-7 sprite charset
  Protected *chr.Unicode,*Map.Unicode
  Protected index.i
  *chr = @Text
  While *chr\u
    *map = ?bcd7_decode
    For index = 0 To 15;<- lazy (slow way)!
      If *chr\u = *map\u
        ClipSprite(Sprite,index << 3,0,8,8)
        ZoomSprite(Sprite,Size,Size)
        DisplayTransparentSprite(Sprite,X,Y,255,#Red +index << 7)
        Break
      EndIf
      *map + 2
    Next
    X + Size
    *chr + 2
  Wend
  ClipSprite(Sprite,0,0,128,8)
  ProcedureReturn #Null
;   bcd7_decode:
;   !du '0123456789abcdef'
EndProcedure

Procedure.i Main()
  Protected exit.i,sprite.i
  Protected *font
  *font = bcd7Font()
  If *font
    If InitSprite()
      If OpenWindow(0,#Null,#Null,600,400,"BCD-7 Demo by Mijikai",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
        If OpenWindowedScreen(WindowID(0),#Null,#Null,600,400)
          SetFrameRate(60)
          sprite = CatchSprite(#PB_Any,*font,#PB_Sprite_AlphaBlending)
          If sprite
            Repeat
              Repeat
                Select WindowEvent()
                  Case #PB_Event_CloseWindow
                    exit = #True
                  Case #Null
                    Break
                EndSelect
              ForEver
              ClearScreen($0)
              ZoomSprite(sprite,580,50)
              RotateSprite(sprite,30,#PB_Absolute)
              DisplayTransparentSprite(sprite,0,180,30,#Red)
              RotateSprite(sprite,0,#PB_Absolute)
              bcd7DrawText(sprite,45,180,32,"abcdef0123456789")
              FlipBuffers()
            Until exit
            FreeSprite(sprite)
          EndIf
          CloseScreen()  
        EndIf
        CloseWindow(0)  
      EndIf
    EndIf
    FreeMemory(*font)
  EndIf
  ProcedureReturn #Null
EndProcedure

Main()

End

DataSection
  bcd7_matrix:
  Data.b 2,0,6,0,1,1,1,2,7,1,7,2,2,3,6,3,1,4,1,5,7,4,7,5,2,6,6,6
  Data.b 1,1,1,0,1,1,1,0,0,1,0,0,1,0,1,0,1,1,1,0,1,1,0,1,1,0,1,1;<- lazy (should be bits)!
  Data.b 0,1,1,1,0,1,0,1,1,0,1,0,1,1,1,1,0,1,1,1,1,1,0,1,0,0,1,0
  Data.b 1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,0,1,0,1,1,1,1
  Data.b 0,0,0,1,1,0,1,0,0,1,1,1,1,1,1,1,0,1,1,0,1,1,1,0,1,1,0,0
  bcd7_decode:
  Data.s "0123456789abcdef"
EndDataSection

Nice little code by the way.
StarBootics

Olli · Post by **Olli** » Wed Jul 13, 2022 11:40 am

Very good factorization : its quality is so advanced that you got your datas in only one clsid code !

infratec · Post by **infratec** » Fri Jul 15, 2022 7:42 am

Without using something like CLSID and should be also cross platform

Code: Select all

Procedure.i bcd7Font();<- create bcd-7 texture charset
  
  Structure DataStructure
    dummy.q
    Byte.a[0]
  EndStructure
  
  Protected img.i,index.i,px.i,py.i
  Protected *draw.DataStructure,*link.DataStructure
  
  img = CreateImage(#PB_Any,16 << 3,8,32,#PB_Image_Transparent)
  If img
    If StartDrawing(ImageOutput(img))
      DrawingMode(#PB_2DDrawing_AllChannels)
      *draw = ?bcd7_matrix + 20
      *link = ?bcd7_matrix - 8
      For index = 0 To 15
        px = index << 3
        For py = 0 To 6
          LineXY(px + *link\Byte[0],*link\Byte[1],px + *link\Byte[2],*link\Byte[3],*draw\Byte[py] * $FFFFFFFF)
          *link + 4
        Next
        *link - 28
        *draw + 7
      Next
      StopDrawing()
      *draw = EncodeImage(img,#PB_ImagePlugin_PNG,#Null,32)
      FreeImage(img)
      ProcedureReturn *draw
    EndIf
    FreeImage(img)
  EndIf
  ProcedureReturn #Null
  
  DataSection
    bcd7_matrix:
    Data.a 2,0,6,0,1,1,1,2,7,1,7,2,2,3,6,3,1,4,1,5,7,4,7,5,2,6,6,6
    Data.a 1,1,1,0,1,1,1,0,0,1,0,0,1,0,1,0,1,1,1,0,1,1,0,1,1,0,1,1;<- lazy (should be bits)!
    Data.a 0,1,1,1,0,1,0,1,1,0,1,0,1,1,1,1,0,1,1,1,1,1,0,1,0,0,1,0
    Data.a 1,1,1,1,1,1,1,1,1,1,1,0,1,1,1,1,1,1,1,1,0,0,1,0,1,1,1,1
    Data.a 0,0,0,1,1,0,1,0,0,1,1,1,1,1,1,1,0,1,1,0,1,1,1,0,1,1,0,0
  EndDataSection
  
EndProcedure

Mijikai · Post by **Mijikai** » Fri Jul 15, 2022 10:12 am

I only used CLSID because i simply had not enough free time.
The bytes which should be bits (which represent the light states) are also different from the documentation.
I made up my own mapping (top - > bottom, left - > right) and the dot was omitted so i ended up with only 7 instead of 8 "bits".
In RL there might be additional ":" lights aswell (drawing dots was just not that interesting to me tbh.).
The code could be improved by using a fitting struct and the reordering of data.
The first row in the "matrix" currently holds all (line) offsets (into an 8 x 8 grid) to draw all the lights that can be illuminated.
The rest just encodes if the lights are on or off aka. 0 or 1.

Messed around a "bit":

Code: Select all

Procedure.i bcd7Font();<- create bcd-7 texture charset
  Protected img.i,index.i,px.i,py.i
  Protected *link.Word,*draw.Ascii
  img = CreateImage(#PB_Any,16 << 3,8,32,#PB_Image_Transparent)
  If img
    If StartDrawing(ImageOutput(img))
      DrawingMode(#PB_2DDrawing_AllChannels)
      *link = ?bcd7_matrix
      *draw = ?bcd7_matrix + $E
      For index = 0 To 15
        px = index << 3
        For py = 7 To 1 Step - 1;<- messed up when storing the bits - whatever all works in reverse!
          LineXY(px + ((*link\w & $FF) >> $4),((*link\w & $FF) & $F),px + ((*link\w >> $8) >> $4),((*link\w >> $8) & $F),((*draw\a >> (py)) & $1) * $FFFFFFFF)
          *link + 2
        Next
        *link - $E
        *draw + $1
      Next
      StopDrawing()
      *draw = EncodeImage(img,#PB_ImagePlugin_PNG,#Null,32)
      FreeImage(img)
      ProcedureReturn *draw
    EndIf
    FreeImage(img)
  EndIf
  ProcedureReturn #Null
  bcd7_matrix:
  !db 0x20,0x60,0x11,0x12,0x71,0x72
  !db 0x23,0x63,0x14,0x15,0x74,0x75
  !db 0x26,0x66,0xEE,0x24,0xBA,0xB6
  !db 0x74,0xD6,0xDE,0xA4,0xFE,0xF6
  !db 0xFC,0x5E,0x1A,0x3E,0xDA,0xD8
EndProcedure

Olli · Post by **Olli** » Thu Jul 21, 2022 11:55 am

Lazy ? So do I now !

Code: Select all

Define tempWin = OpenWindow(#PB_Any, ExamineDesktops(), 0, 0, 0, "", #PB_Window_Maximize | #PB_Window_BorderLess | #PB_Window_Invisible)
If DesktopWidth(0) <> WindowWidth(tempWin) * DesktopResolutionX()
    If #PB_Compiler_OS = #PB_OS_Windows And OSVersion() > 70
        MessageRequester("Don't forget to...", "switch the user option ! (menu Compiler)")
        End
    EndIf
    MessageRequester("Please switch...", "the dpi option on ! (menu Compiler)")
    End
EndIf
CloseWindow(tempWin)
Global Dim win.i(2047)
Global Dim hid.i(2047)
hid(3) = 1     
hid(7) = 1     
hid(8) = 1     
hid(10) = 1    
hid(11) = 1    
hid(13) = 1    
hid(15) = 1    
hid(19) = 1    
hid(22) = 1    
hid(25) = 1    
hid(28) = 1    
hid(32) = 1    
hid(34) = 1     
hid(37) = 1     
hid(39) = 1     
hid(44) = 1     
hid(50) = 1     
hid(52) = 1     
hid(53) = 1     
hid(55) = 1     
hid(67) = 1     
hid(76) = 1     
hid(77) = 1     
hid(79) = 1     
hid(84) = 1     
hid(85) = 1     
hid(86) = 1     
hid(89) = 1     
hid(91) = 1     
hid(92) = 1     
hid(100) = 1    
hid(103) = 1    
hid(107) = 1    
hid(110) = 1    
hid(111) = 1    

Procedure.i unscaX(x.i)
    ProcedureReturn DesktopUnscaledX(x)
EndProcedure

Procedure.i unscaY(y.i)
    ProcedureReturn DesktopUnscaledY(y)
EndProcedure

Global.I ctlWin = OpenWindow(#PB_Any, 16, 16, UnscaX(400), UnscaY(300), "", #PB_Window_SystemMenu | #PB_Window_Invisible ! #PB_Window_Invisible)

Procedure coloredBox(x, y, w, h, color)
    Define.i window
    window = OpenWindow(#PB_Any, UnscaX(x), UnscaY(y), unscax(w), UnscaY(h), "", #PB_Window_BorderLess | #PB_Window_NoGadgets | #PB_Window_NoActivate | #PB_Window_Invisible ! #PB_Window_Invisible, WindowID(ctlWin) )
    SetWindowColor(window, color)
    StickyWindow(window, 1)
    ProcedureReturn window
EndProcedure

ExamineDesktops()
Global dw = DesktopWidth(0)
Global dh = DesktopHeight(0)
Global gw = 16
Global gh = 9
Global cw = dw / gw
Global ch = dh / gh
Global Dim gx.d(2)
Global Dim gy.d(3)
Global Dim xx.d(2)
Global Dim yy.d(3)
 gx(0) = 1 / 8
 gy(0) = 1 / 10
 gx(1) = gx(0)
 gx(2) = 1 - gx(0)
 gy(1) = gy(0)
 gy(2) = 1 / 2
 gy(3) = 1 - gy(0)
Global Dim x.d(3)
Global Dim y.d(4)

Procedure bcd()
thi.d = 12
thi2.d = thi / 2
y = 4 * ch
id = 0
Repeat
    x = 0
    Repeat             
        For yy = 1 To 3
            For xx = 1 To 2                
                xx(xx) = x + cw * gx(xx)
                yy(yy) = y + ch * gy(yy)
            Next
        Next        
        cc = RGB((x * 255) / dw, ((dw - x) * 255) / dw, 0)
        For yy = 1 To 3
            For xx = 1 To 2                
                If xx < 2
                    If hid(id) = 0 And win(id) = 0
                        win(id) = coloredBox(xx(xx) + thi2, yy(yy) - thi2, xx(xx + 1) - xx(xx) - thi, thi, cc)
                    EndIf
                    If hid(id) And win(id)
                        CloseWindow(win(id) )
                        win(id) = 0
                    EndIf
                    id + 1
                EndIf
                If yy < 3
                    If hid(id) = 0 And win(id) = 0
                        win(id) = coloredBox(xx(xx) - thi2, yy(yy) + thi2, thi, yy(yy + 1) - yy(yy) - thi, cc)
                    EndIf
                    If hid(id) And win(id)
                        CloseWindow(win(id) )
                        win(id) = 0
                    EndIf
                    id + 1
                EndIf
            Next
        Next        
        x + cw
    Until x >= dw
    y + ch
Until y >= dh / 2
EndProcedure
dmx = DesktopMouseX()
Repeat
    t = ElapsedMilliseconds()
    If t > lap
        lap = t + 1000
        bcd()
        For i = 0 To 7
            hid(i + 16*7) = hid(i)
        Next
        For i = 0 To 16 * 7 - 1 Step 1
            hid(i) = hid((i + 7) )
        Next
    EndIf
    Delay(33)
    ev = WindowEvent()
    dmx0 = dmx
    dmx = DesktopMouseX()
Until ev = #PB_Event_CloseWindow ; dmx <> dmx0

Mijikai · Post by **Mijikai** » Thu Jul 21, 2022 12:16 pm

Thats flashy, nice scrolling effect i like it

So many windows...

Olli · Post by **Olli** » Thu Jul 21, 2022 12:29 pm

and, theorically, cross platform...
bcd() procedure prevent the program from making more windows than required.

Mijikai wrote:So many windows...

This allows us to observe Microsoft makes fun of their clients. I hope Linux is quicker...

Kwai chang caine · Post by **Kwai chang caine** » Sun Jul 31, 2022 8:06 pm

Hi Mijikaï and Olli

Very nice your two codes

For olli code, my eyes can't read all the screen in one shot

Thanks for sharing

PureBasic Forums - English

Another BCD-7 Rendering Example

Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example

Re: Another BCD-7 Rendering Example