Write with line light

[bplus]

Code: QB64: [Select]

1. _Title "Write with light line" 'b+ 2021-05-04
2. ' from "Random light line" 'b+ 2020-01-28
3.  
4. Const xmax = 1200, ymax = 700
5. Screen _NewImage(xmax, ymax, 32)
6. _ScreenMove 80, 10
7. Randomize Timer
8.  
9. wandsi 0, 0, 0, 0, 1, 0
10. While _KeyDown(27) = 0
11.     If InKey$ = " " Then Cls
12.     While _MouseInput: Wend
13.     mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
14.     If mb Then
15.         a = a + _Pi(1 / 45)
16.         wandsi mx, my, a, 20, 0, i
17.     End If
18.     lastmx = mx: lastmy = my
19.     i = i + 1
20.     _Display
21.     _Limit 3000
22. Wend
23.  
24. 'draw a colorful line from point x, y, at radianAngle for a distance and use new <> 0 to reset colors
25. Sub wandsi (x1 As Single, y1 As Single, radianAngle As Single, distance As Single, new As Integer, startIdx As Integer)
26.     Static r As Single, g As Single, b As Single 'hold present color settings until
27.     If new <> 0 Then r = Rnd * Rnd * .5: g = Rnd * Rnd * .5: b = Rnd * Rnd * .5 'new is true
28.     Dim dx As Single, dy As Single, i As Integer, x As Single, y As Single
29.     dx = Cos(radianAngle): dy = Sin(radianAngle)
30.     For i = 0 To distance
31.         x = x1 + i * dx: y = y1 + i * dy
32.         Line (x, y)-Step(0, 0), _RGB32(127 + 127 * Sin(r * (i + startIdx)), 127 + 127 * Sin(g * (i + startIdx)), 127 + 127 * Sin(b * (i + startIdx)), 50), BF
33.     Next
34. End Sub
35.  
36.  
37.  

[SierraKen]

Pretty cool B+. :)

[Ashish]

 

[_vince]

Nice, but Ashishh wins:  https://www.qb64.org/forum/index.php?topic=3266.0

[bplus]

Nice, but Ashishh wins:  https://www.qb64.org/forum/index.php?topic=3266.0

Ha! I'll try harder next time, actually I was just going for a new way to note the day!

Thanks Ken and Ashish.

[Dav]

Neat one, @bplus!  I sure like playing around with unique drawing tools.  Thanks for sharing.

- Dav

 

[bplus]

Hey Dav's back! :)