Easter Egg Decorating

[bplus]

Both @CharlieJV and @dbox if you want to be rid of those dots try changing this:

Code: QB64: [Select]

1. PSet (int(xc + d * Cos(a + radianAngle)), int(yc + d * Sin(a + radianAngle))), thisColor
2.  

to

Code: QB64: [Select]

1. line (int(xc + d * Cos(a + radianAngle)), int(yc + d * Sin(a + radianAngle)))- step(1,1), thisColor, BF

So instead of a pixel it is a box fill a bit larger than a pixel. But some of those dot patterns are kinda cool.

[CharlieJV]

Both @CharlieJV and @dbox if you want to be rid of those dots try changing this:

Code: QB64: [Select]

1. PSet (int(xc + d * Cos(a + radianAngle)), int(yc + d * Sin(a + radianAngle))), thisColor
2.  

to

Code: QB64: [Select]

1. line (int(xc + d * Cos(a + radianAngle)), int(yc + d * Sin(a + radianAngle)))- step(1,1), thisColor, BF

So instead of a pixel it is a box fill a bit larger than a pixel. But some of those dot patterns are kinda cool.

It is pretty neat how much of a difference it makes.  I like both equally for different reasons.  The smooth eggs are really nice, the other ones look textured, which is pretty cool.

The first one with pset: view source code, run program

The alternative one with line: view source code, run program

[bplus]

Yeah here are some cherry picked Textured Eggs:

Code: QB64: [Select]

1. _Title "drawEasterEgg Textured" 'b+ 2022-03-30 mod 2022-04-01 add r,g,b parameter
2. Randomize Timer
3. Const Xmax = 500, Ymax = 500, Pi = _Pi
4. Screen _NewImage(Xmax, Ymax, 32)
5. _ScreenMove 100, 100
6. scale = 100
7. Do
8.     Cls
9.     drawEasterEgg 250, 250, Rnd * scale + scale, Rnd * 2 * Pi, Rnd, Rnd, Rnd
10.     Sleep
11. Loop Until _KeyDown(27)
12.  
13.  
14. Sub drawEasterEgg (xc, yc, scale, radianAngle, r, g, b) ' add rgb so can draw the same
15.     For x = -1 To 1 Step .01
16.         For y = -1 To 1 Step .01
17.             If x < 0 Then c = c + .0005 Else c = c - .0005
18.             If (x * x + (1.4 ^ x * 1.6 * y) ^ 2 - 1) <= .01 Then ' 1.6 * y orig
19.                 If y > 0 Then
20.                     Color _RGB32(128 * (1 - y) + 128 * (1 - y) * Sin(c * r), 128 * (1 - y) + 128 * (1 - y) * Sin(c * g), 127 * (1 - y) + 127 * (1 - y) * Sin(c * b))
21.                 Else
22.                     Color _RGB32(128 + 128 * Sin(c * r), 128 + 128 * Sin(c * g), 127 + 127 * Sin(c * b))
23.                 End If
24.                 a = _Atan2(y, x)
25.                 d = scale * Sqr(x * x + y * y)
26.                 PSet (xc + d * Cos(a + radianAngle), yc + d * Sin(a + radianAngle))
27.             End If
28.         Next
29.     Next
30. End Sub
31.  
32.  

 

 

 

[SierraKen]

Dang B+, you surprise me all the time. I wasted a couple hours trying to figure out how to make the Matrix symbols flow over a map of the world, but the map always disappears because of the LINE command. LOL I think it's impossible, even with the BLEND command. I tried DEST and SOURCE in different places, etc, no luck. The best I could do is show the map and make the symbols go over it but without deleting anything, so eventually the symbols fill up the screen.

[bplus]

Ah but did you try with Rotozoom?

Code: QB64: [Select]

1. _Title "Matrix Rain 4" 'B+ started 2019-03-16
2. ' from Matrix Rain 2019-03-14
3. ' or QB64 Purple Rain!
4.  
5. '>>> Save this file as: Matrix Rain 4.bas, so the program can load the strings from it.  <<<
6.  
7. '2019-03-15 This will attempt to spin the drops as they fall
8. '2019-03-16  Don't need no damn Character Set.DAT file!!!
9. '2019-03-16 Ijust want to see the vertical code strings dangle and twist.
10.  
11. '2019-03-19 Matrix Rain 4
12. ' + added randWeight to weight the random sizes chosen so many more on small side than large
13. ' + draw letters on a transparent background so the background of the letter does not cover
14. '   the drops behind it.
15.  
16.  
17. Randomize Timer
18. Const xmax = 1280
19. Const ymax = 740
20. Const nDrops = 500
21. Type dropType
22.     x As Single
23.     sz As Single
24.     curY As Integer
25.     dxs As Single 'direction and change of spin some small fraction of 1, +-1/3, +-1/4, +-1/5...
26. End Type
27.  
28. Screen _NewImage(xmax, ymax, 32)
29. _ScreenMove 80, 0 'for snap shot
30. '_FULLSCREEN 'as screen saver
31.  
32. ReDim Shared fileStrings$(1000) 'container for these program lines that will be dangling
33. Open "Matrix Rain 4.bas" For Input As #1
34. While Not EOF(1)
35.     Line Input #1, fs$
36.     If Len(LTrim$(fs$)) <> 0 Then 'less empty spaces
37.         fileStrings$(i) = LTrim$(fs$)
38.         i = i + 1
39.     End If
40. Wend
41. Close #1
42. ReDim _Preserve fileStrings$(i - 1)
43. ' check loading
44. 'FOR i = 0 TO UBOUND(fileStrings$)
45. '    PRINT i, fileStrings$(i)
46. 'NEXT
47. 'END
48.  
49. 'setup drops
50. Dim Shared drop(nDrops) As dropType
51. Dim Shared s$(nDrops)
52.  
53. For i = 0 To nDrops
54.     newDrop i, 1
55. Next
56.  
57. While _KeyDown(27) = 0
58.     Cls
59.     For i = 0 To nDrops
60.         drawDrop (i)
61.         drop(i).curY = drop(i).curY + 1
62.         If drop(i).curY > Len(s$(i)) Then newDrop i, 0
63.     Next
64.     _Display
65.     _Limit 25
66. Wend
67.  
68. Sub newDrop (i, start)
69.     drop(i).x = Rnd * xmax 'set location
70.     drop(i).sz = randWeight(.3, 5, 3) 'set size  weighted on small sizes
71.     'length of text string can fit on screen
72.     charLength = ymax \ (drop(i).sz * 16) + 1 'from size determine how many chars fit on screen
73.     randLine = Int(Rnd * UBound(fileStrings$)) 'pick a random program line
74.     s$(i) = Mid$(fileStrings$(randLine), 1, charLength) 'here is text string to dangle
75.     While Len(s$(i)) < charLength
76.         If randLine + 1 > UBound(fileStrings$) Then randLine = 0 Else randLine = randLine + 1
77.         s$(i) = Mid$(s$(i) + " : " + fileStrings$(randLine), 1, charLength)
78.     Wend
79.     If start <> 0 Then drop(i).curY = Int(Rnd * (charLength)) + 1 Else drop(i).curY = 1 'flat and readable at curY
80.     drop(i).dxs = 1 / (Int(Rnd * 7) + 3) 'change of spin rate +-1/3, +-1/4, ... +-1/9
81.     If Rnd < .5 Then drop(i).dxs = -drop(i).dxs
82. End Sub
83.  
84. Sub drawDrop (i)
85.     For j = 1 To drop(i).curY
86.         d = drop(i).curY - j
87.         If d = 0 Then
88.             c~& = _RGBA32(255, 100, 255, 225)
89.         ElseIf d = 1 Then
90.             c~& = _RGBA32(255, 50, 255, 205)
91.         ElseIf d = 2 Then
92.             c~& = _RGBA32(255, 25, 255, 180)
93.         ElseIf d >= 3 Then
94.             c~& = _RGBA32(255, 0, 255, 190 - d * 5)
95.         End If
96.         rot = 1: dir = -1
97.         For k = 0 To d
98.             rot = rot + drop(i).dxs * dir
99.             If rot > 1 Then dir = -1 * dir: rot = 1 + drop(i).dxs * dir
100.             If rot < -1 Then dir = dir * -1: rot = -1 + drop(i).dxs * dir
101.         Next
102.         drwChar Mid$(s$(i), j, 1), c~&, drop(i).x + 4 * drop(i).sz, drop(i).sz * 16 * (j - 1) + 8 * drop(i).sz, rot * drop(i).sz, drop(i).sz, 0
103.     Next
104. End Sub
105.  
106. Sub drwChar (char$, c As _Unsigned Long, midX, midY, xScale, yScale, Rotation) 'what ever the present color is set at
107.     I& = _NewImage(8, 16, 32)
108.     _Dest I&
109.     Color c, _RGBA32(0, 0, 0, 0)
110.     _PrintString (0, 0), char$
111.     _Dest 0
112.     RotoZoom2 midX, midY, I&, xScale, yScale, Rotation
113.     _FreeImage I&
114. End Sub
115.  
116. Sub RotoZoom2 (X As Long, Y As Long, Image As Long, xScale As Single, yScale As Single, Rotation As Single)
117.     Dim px(3) As Single: Dim py(3) As Single
118.     W& = _Width(Image&): H& = _Height(Image&)
119.     px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
120.     px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
121.     sinr! = Sin(-Rotation): cosr! = Cos(-Rotation)
122.     For i& = 0 To 3
123.         x2& = (px(i&) * cosr! + sinr! * py(i&)) * xScale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * yScale + Y
124.         px(i&) = x2&: py(i&) = y2&
125.     Next
126.     _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
127.     _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
128. End Sub
129.  
130. Function randWeight (manyValue, fewValue, power)
131.     randWeight = manyValue + Rnd ^ power * (fewValue - manyValue)
132. End Function
133.  
134.  

BTW the letters, digits and symbols are the from the source QB64 code.

[dbox]

Yeah here are some cherry picked Textured Eggs:

B+ Textured Egg Slideshow

[SierraKen]

Awesome stuff B+. Way beyond what I know. I'm still learning the basics of the Matrix example Steve posted.