Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Simple text pixel data to array demo
#1
Could be used for scrolling LED style things and more....

Code: (Select All)
SCREEN _NEWIMAGE(1024, 600, 32)
COLOR _RGB32(255, 255, 255)
_SCREENMOVE 0, 0

'////////////////////////////////////\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\//////////////////////

MainText$ = " Unseen Machine "

DIM TxtData((LEN(MainText$) * _FONTWIDTH) - 1, 16) AS _BIT

PRINT MainText$
_DISPLAY
_SOURCE 0
FOR y% = 0 TO 16
  FOR x% = 0 TO (LEN(MainText$) * _FONTWIDTH) - 1
    pval& = POINT(x%, y%)
    IF pval& = _RGB32(255, 255, 255) THEN TxtData(x%, y%) = 1
  NEXT
NEXT

'////////////////////////////////////////////////////////////////////////////////////////////////////
CLS
bsx% = 8
FOR y% = 0 TO 16
  FOR x% = 0 TO (LEN(MainText$) * _FONTWIDTH) - 1
    xp% = (x% * bsx%)
    yp% = (y% * bsx%)
    IF TxtData(x%, y%) THEN
      LINE (xp%, yp%)-(xp% + 8, yp% + 8), _RGB32(235, 160, 190), BF
    ELSE
      LINE (xp%, yp%)-(xp% + 8, yp% + 8), _RGB32(135, 60, 90), BF
    END IF
  NEXT
NEXT

_DISPLAY

SLEEP
SYSTEM
'////////////////////////////////////////////////////////////////////////////////////////////////////

Unseen
Reply
#2
Quote:Could be used for scrolling LED style things and more....


Yes! I did a Basic lecture on that back in 2021! Smile
Code: (Select All)
_Title "Building a Scrolling LED Screen" ' b+ 2021-05-08
Screen _NewImage(1200, 160, 32)
_Delay .25 'give screen time to load
_ScreenMove _Middle 'and center screen

'scroll some text
Text$ = "Try scrolling me for awhile until you got it, then press a key...   "
lenText = Len(Text$)
startTextPos = 1
'put text in sign 15 chars wide in middle of screen print the message moving down 1 character evey frame
_Title "Building a Scrolling LED Screen:  Step 1 get some code to scroll your message in middle of screen."
Do
    k$ = InKey$
    Cls
    ' two pieces of text?  when get to end of text will have less than 15 chars to fill sign so get remainder from front
    len1 = lenText - startTextPos
    If len1 < 15 Then len2 = 15 - len1 Else len1 = 15: len2 = 0
    ' locate at middle of screen for 15 char long sign
    _PrintString ((1200 - 15 * 8) / 2, (160 / 2) - 8), Mid$(Text$, startTextPos, len1) + Mid$(Text$, 1, len2)
    startTextPos = startTextPos + 1
    If startTextPos > lenText Then startTextPos = 1
    _Display ' no blinking when clear screen so often
    _Limit 5 ' slow down to see scroll
Loop Until Len(k$)

' OK   now for the enLARGE M E N T   using _PutImage
' our little sign is 16 pixels high and 8 * 15 chars pixels wide = 120
Dim sign As Long
sign = _NewImage(120, 16, 32) ' we will store the print image here

'  _PUTIMAGE [STEP] [(dx1, dy1)-[STEP][(dx2, dy2)]][, sourceHandle&][, destHandle&][, ][STEP][(sx1, sy1)[-STEP][(sx2, sy2)]][_SMOOTH]
'  use same pixel location to _printString as for _PutImage Source rectangle ie (sx1, sy1), -step( sign width and height)

' test screen capture with _putimage and then blowup with _putimage
'_PutImage , 0, sign, ((1200 - 15 * 8) / 2, (160 / 2) - 8)-Step(119, 15)
'Cls
'_PutImage , sign, 0 ' stretch to whole screen
'_Display

'now that that works  do it on the move

' about here I resized the screen to 1200 x 160 to make the text scalable X's 10 ie 120 x 10 wide and 16 x 10 high
_Title "Building a Scrolling LED Screen:  Step 2 Blow it up by using _PutImage twice once to capture, then to expand"
k$ = ""
Do
    k$ = InKey$
    Cls
    ' two pieces of text?  when get to end of text will have less than 15 chars to fill sign so get remainder from front
    len1 = lenText - startTextPos
    If len1 < 15 Then len2 = 15 - len1 Else len1 = 15: len2 = 0
    ' locate at middle of screen for 15 char long sign
    _PrintString ((1200 - 15 * 8) / 2, (160 / 2) - 8), Mid$(Text$, startTextPos, len1) + Mid$(Text$, 1, len2)
    _PutImage , 0, sign, ((1200 - 15 * 8) / 2, (160 / 2) - 8)-Step(119, 15)

    Cls
    _PutImage , sign, 0 ' stretch to whole screen
    _Display ' no blinking when clear screen so often
    _Limit 5 ' slow down to see scroll
    startTextPos = startTextPos + 1
    If startTextPos > lenText Then startTextPos = 1
Loop Until Len(k$)



' now for a mask just draw a grid  test grid draw here
'For x = 0 To _Width Step 10 ' verticals
'    Line (x, 0)-(x + 3, _Height), &HFF000000, BF
'Next
'For y = 0 To _Height Step 10
'    Line (0, y)-(_Width, y + 3), &HFF000000, BF
'Next

_Title "Building a Scrolling LED Screen:  Step 3 Mask or Cover the thing with a grid or grate."
' here is the whole code with all setup variables
k$ = ""
Do
    k$ = InKey$
    Cls
    ' two pieces of text?  when get to end of text will have less than 15 chars to fill sign so get remainder from front
    len1 = lenText - startTextPos
    If len1 < 15 Then len2 = 15 - len1 Else len1 = 15: len2 = 0
    ' locate at middle of screen for 15 char long sign
    _PrintString ((1200 - 15 * 8) / 2, (160 / 2) - 8), Mid$(Text$, startTextPos, len1) + Mid$(Text$, 1, len2)
    _PutImage , 0, sign, ((1200 - 15 * 8) / 2, (160 / 2) - 8)-Step(119, 15)

    Cls
    _PutImage , sign, 0 ' stretch to whole screen

    ' now for a mask just draw a grid  best to draw this and copy and layover screen as another layer
    ' here QB64 is fast evough to redarw each time
    For x = 0 To _Width Step 10 ' verticals
        Line (x, 0)-(x + 3, _Height), &HFF000000, BF
    Next
    For y = 0 To _Height Step 10
        Line (0, y)-(_Width, y + 3), &HFF000000, BF
    Next

    _Display ' no blinking when clear screen so often
    _Limit 5 ' slow down to see scroll
    startTextPos = startTextPos + 1
    If startTextPos > lenText Then startTextPos = 1
Loop Until Len(k$)
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Reply
#3
OK that was done using _PutImage, many ways to skin a cat!

Here is what can be done by saving pixels to an array:
Code: (Select All)
_Title "WELCOME"
Randomize Timer
Const xmax = 1200
Const ymax = 600

_Define A-Z As INTEGER
Common Shared cN, pR!, pG!, pB!

Screen _NewImage(xmax, ymax, 32)
mess$ = " Amazing.bas how sweet thou art... "
Print mess$
w = 8 * Len(mess$): h = 16
Dim p(w, h)
black&& = Point(0, 10)
For y = 0 To h
    For x = 0 To w
        If Point(x, y) <> black&& Then
            p(x, y) = 1
        End If
    Next
Next

Cls
xo = 5: yo = 235: m = 4
resetPlasma
While 1
    For y = 0 To h - 1
        For x = 0 To w - 1
            If p(x, y) Then
                changePlasma
            Else
                Color 0
            End If
            Line (xo + x * m, yo + y * m)-(xo + x * m + m, yo + y * m + m), , BF
        Next
    Next
    _Limit 10
    lc = lc + 1
    If lc Mod 30 = 0 Then resetPlasma
Wend

Sub changePlasma ()
    cN = cN + 1
    Color _RGB(127 + 127 * Sin(pR! * .3 * cN), 127 + 127 * Sin(pG! * .3 * cN), 127 + 127 * Sin(pB! * .3 * cN))
End Sub

Sub resetPlasma ()
    pR! = Rnd ^ 2: pG! = Rnd ^ 2: pB! = Rnd ^ 2
End Sub

   

Once again QBJS fails to run a simple peice of code. @dbox I find you more to fix Smile QBJS can do POINT stuff I think. Did not like Common, God how old is this code? I was still using Common, replace with DIM Shared. DefInt was a problem too, commented out and just the plasma works but no points loaded in array???
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Reply
#4
Yep @dbox something wrong with QBJS reading Black~& that sets all points to 1
Code: (Select All)
_Title "WELCOME"
Randomize Timer
Const xmax = 1200
Const ymax = 600

Dim Shared cN, pR!, pG!, pB!

Screen _NewImage(xmax, ymax, 32)
mess$ = " Amazing.bas how sweet thou art... "
Print mess$
w = 8 * Len(mess$): h = 16
Dim p(w, h) As Integer
black~& = Point(0, 10)
For y = 0 To h
    For x = 0 To w
        If Point(x, y) <> black~& Then
            p(x, y) = 1
        End If
    Next
Next
For y = 0 To h
    For x = 0 To w
        Print p(x, y);
    Next
Next
Print
Sleep
Cls
xo = 5: yo = 235: m = 4
resetPlasma
While 1
    For y = 0 To h - 1
        For x = 0 To w - 1
            If p(x, y) Then
                changePlasma
            Else
                Color 0
            End If
            Line (xo + x * m, yo + y * m)-(xo + x * m + m, yo + y * m + m), , BF
        Next
    Next
    _Limit 5
    lc = lc + 1
    If lc Mod 30 = 0 Then resetPlasma
Wend

Sub changePlasma ()
    cN = cN + 1
    Color _RGB(127 + 127 * Sin(pR! * .3 * cN), 127 + 127 * Sin(pG! * .3 * cN), 127 + 127 * Sin(pB! * .3 * cN))
End Sub

Sub resetPlasma ()
    pR! = Rnd ^ 2: pG! = Rnd ^ 2: pB! = Rnd ^ 2
End Sub
Again this test code works fine in QB64pe, modified to see what QBJS is doing with the p() array (nothing good) Smile

   
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Reply
#5
Hey @bplus, this ended up being an interesting example to research.  Here is a version that will work in both QB64 and QBJS:


The only difference here is that rather than comparing each pixel to the black pixel as in your original, I'm checking to see if the _Red component is over a certain threshold.  This is necessary because QBJS uses the native HTML 2D canvas methods for drawing text and these methods apply anti-aliasing by default.  

Here's another example that illustrates this.  Using a slightly modified version of your zoom logic, you can see that we detected gray pixels around the edges of the text:


This is where compatibility questions can get a bit tricky.  The anti-aliasing is a pretty nice feature that we get by default in QBJS.  It makes text and drawing elements like lines and circles appear nice and smooth.  Perhaps, the answer is to create some sort of strict graphics compatibility mode.  (Unfortunately, that would mean needing to re-implement all of the low-level drawing methods as there is not a way to turn this off in the out-of-the-box canvas methods.)

As you can see in the example above, I'm also breaking some screen mode rules by allowing either indexed colors or RGB color definitions regardless of screen type which I find pretty handy.  I'm always trying to find the balance between compatibility and enhanced functionality and performance.  Screen modes aren't really necessary anymore except for backwards compatibility.

You may be asking, ok, well why didn't the original implementation work comparing against a sampled black pixel?  Well, in short, this is a case where I was focusing on performance vs compatibility.  Essentially, in QBJS colors are represented as an object with red, green, blue and alpha components.  Methods that use colors can convert to and from unsigned long representations of the color.  In an effort to reduce the amount of conversions that would be necessary, the Point method (and other methods that return color data return the underlying color object).  This prevents having to parse the color data from the numeric representation when that color is passed to a drawing method.  If you try to print the color it will convert it on the fly to its numeric representation.  So, you could change the comparison in your original code to the following:
Code: (Select All)
If Str$(Point(x, y)) <> Str$(black~&) Then
This would work... however, because of the antialiasing it would detect all of the gray pixels as well and the output would lose definition.  Plus, it looks weird and is not intuitive.

I'll look at this further and see about having Point return the expected numeric representation.  I think this may be a case where any potential performance issues might be negligible compared to the improved compatibility.

I appreciate you and @Pete making me aware of examples like this.  Unless someone reports it, I'm not aware of what challenges people might be running into.
Reply
#6
+1 @dbox thanks again for looking into this, always interesting these explainations. I wish I could remember them all. Smile
  724  855  599  923  575  468  400  206  147  564  878  823  652  556 bxor cross forever
Reply


Possibly Related Threads…
Thread Author Replies Views Last Post
  WinAPI Mouse Demo Pete 0 181 12-20-2025, 06:40 PM
Last Post: Pete
  Hyperlink Demo in SCREEN 0 Pete 2 353 11-02-2025, 07:13 PM
Last Post: madscijr
  Text Effects 2 2112 6 644 10-30-2025, 11:13 PM
Last Post: Unseen Machine
  Text Encryption-Decryption 2112 6 709 10-21-2025, 11:51 AM
Last Post: euklides
  Unique Random Array Program eoredson 5 812 07-10-2025, 10:29 AM
Last Post: DANILIN

Forum Jump:


Users browsing this thread: 1 Guest(s)