Laser cut visual effect

[tsh73]

I happen to go by shop that has such effect on light emitter advertising screen.
So I start to think how to do it.
'Laser engraving (look-alike)
'tsh73
'Jan 2019. Feb 2019 - with GetPixelAPI for LB

nomainwin
open "Laser engraving" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
   handleg  =hwnd( #gr)
   calldll  #user32, "GetDC", handleg as ulong, hDC as ulong

#gr "down"
#gr "fill black; flush"

#gr "backcolor black"
#gr "color 1 1 1"    'almost black, but not exactly
'#gr "color white"
#gr "place 30 200"
#gr "font times_new_roman 60 bold"
#gr "font times_new_roman 0 90 bold"
#gr "\Laser"

#gr "color cyan"    'gives red on black after XOR. Don't ask.

n = 5
r = 20

x0=300
y0=150
x1=35
y1=y0

t0=time$("ms")
#gr "rule xor"

for x1 = 30 to 230
   for y = 145 to 200
       scan
       calldll #gdi32, "GetPixel", hDC as ulong, x1 as long, y as long, pixcol as ulong
       'print x1, y, pixcol      
               
       hasDot = (pixcol<>0)
       if not(hasDot) then goto [skip]
       y0=y:y1=y0
       'since last point on a line not drawn, we draw line from LAST point
       '#gr "line ";x0;" ";y0;" ";x1;" ";y1
       #gr "line ";x1;" ";y1;" ";x0;" ";y0
       'random sparkles
       for i = 1 to n
           a(i)=int(rnd(0)*360)
           r(i)=int(rnd(0)*r)
       next
       for i = 1 to n
           #gr "place ";x1;" ";y1
           #gr "north; turn ";a(i)
           #gr "go ";r(i)
       next
       'call pause 20'0'00
       '#gr "line ";x0;" ";y0;" ";x1+1;" ";y1   '+1 !!
       #gr "line ";x1+1;" ";y1;" ";x0;" ";y0
       for i = 1 to n
           #gr "place ";x1;" ";y1
           #gr "north; turn ";a(i)
           #gr "go ";r(i)
       next
[skip]
   next
   #gr "discard"
next
#gr "flush"
t1=time$("ms")

notice "That's all, folks ";t1-t0
wait

[quit]
   close #gr
end

sub pause mil
   t0=time$("ms")
   while time$("ms")<t0+mil
       scan
   wend
   exit sub
[quit]
   close #gr
   end
end sub



[alincon]

Pretty cool effect. What has to be changed to allow longer text?

r.m.

[tsh73]

Well, loop by x1 is along text length.
You can check text length with stringwidth graphic command.

[Brandon Parker]

This is fun....

You will also need to change the following:

1. Change Width of window accordingly

2. Starting point for the laser line.  Something like this will do after you have retrieved the width of your text.

x0=(300 + widthInPixels)

3. Change the lower bound for the Y; something like a lower case "g" gets cut off.  Changing the 200 to 250 worked for this font size.

for y = 145 to 200


{:0)

Brandon Parker

[Brandon Parker]

Haaaaa, now with some pizzazz....

'Laser engraving (look-alike)
'tsh73
'Jan 2019. Feb 2019 - with GetPixelAPI for LB

nomainwin
WindowWidth = 650
open "Laser engraving" for graphics_nsb_nf as #gr
#gr "trapclose [quit]"
   handleg  =hwnd( #gr)
   calldll  #user32, "GetDC", handleg as ulong, hDC as ulong

#gr "down"
#gr "fill black; flush"

#gr "backcolor black"
#gr "color 1 1 1"    'almost black, but not exactly
'#gr "color white"
#gr "place 30 200"
#gr "font times_new_roman 60 bold"
#gr "font times_new_roman 0 90 bold"
var$ = "Hello World!"
#gr "|";var$
#gr "StringWidth? var$ widthInPixels"

#gr "color blue"    'gives red on black after XOR. Don't ask.

n = 5
r = 20

x0=(300 + widthInPixels)
y0=150
x1=35
y1=y0

t0=time$("ms")
#gr "rule xor"

for x1 = 30 to (widthInPixels + 30)
   for y = 145 to 250
       scan
       #gr "color ";Int((rnd(1)*255)+0.5);" ";Int((rnd(1)*255)+0.5);" ";Int((rnd(1)*255)+0.5)
       calldll #gdi32, "GetPixel", hDC as ulong, x1 as long, y as long, pixcol as ulong
       'print x1, y, pixcol

       hasDot = (pixcol<>0)
       if not(hasDot) then goto [skip]
       y0=y:y1=y0
       'since last point on a line not drawn, we draw line from LAST point
       '#gr "line ";x0;" ";y0;" ";x1;" ";y1
       #gr "line ";x1;" ";y1;" ";x0;" ";y0
       'random sparkles
       for i = 1 to n
           a(i)=int(rnd(0)*360)
           r(i)=int(rnd(0)*r)
       next
       for i = 1 to n
           #gr "place ";x1;" ";y1
           #gr "north; turn ";a(i)
           #gr "go ";r(i)
       next
       'call pause 20'0'00
       '#gr "line ";x0;" ";y0;" ";x1+1;" ";y1   '+1 !!
       #gr "line ";x1+1;" ";y1;" ";x0;" ";y0
       for i = 1 to n
           #gr "place ";x1;" ";y1
           #gr "north; turn ";a(i)
           #gr "go ";r(i)
       next
[skip]
   next
   #gr "discard"
next
#gr "flush"
t1=time$("ms")

notice "That's all, folks ";t1-t0
wait

[quit]
   close #gr
end

sub pause mil
   t0=time$("ms")
   while time$("ms")<t0+mil
       scan
   wend
   exit sub
[quit]
   close #gr
   end
end sub


{:0)

Brandon Parker

[code]

Nice effect !