Donut with Code Sprinkles looking for Coffee Maker

[bplus]

Code: QB64: [Select]

1. _TITLE "Donut with code sprinkles by bplus 2018-03-08"
2. CONST xmax = 700
3. CONST ymax = 700
4. SCREEN _NEWIMAGE(xmax, ymax, 32)
5. _SCREENMOVE 360, 0
6. CONST cx = xmax / 2
7. CONST cy = ymax / 2
8. CONST tw = 8
9. CONST th = 16
10. OPEN "donut code.bas" FOR INPUT AS #1
11. WHILE EOF(1) = 0
12.     LINE INPUT #1, fline$
13.     f$ = f$ + LTRIM$(fline$) + " : "
14. WEND
15. CLOSE #1
16. f$ = LEFT$(f$, LEN(f$) - 3)
17. lenF = LEN(f$)
18. tArea = tw * th * lenF / 2
19. r = SQR(9 / 4 * tArea / _PI)
20. FOR y = 0 TO ymax
21.     FOR x = 0 TO xmax
22.         d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^ .5
23.         IF r / 3 < d + 20 AND d - 20 < r THEN
24.             midInk 180, 90, 55, 80, 40, 20, 1 - ABS(2 / 3 * r - d) / (.335 * r), 0
25.             PSET (x + 5, y + 10)
26.         END IF
27.     NEXT
28. NEXT
29. idx = 0
30. FOR y = 0 TO ymax STEP th
31.     FOR x = 0 TO xmax STEP tw
32.         d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^ .5
33.         IF r / 3 < d AND d < r THEN
34.             idx = idx + 1
35.             midInk 180, 90, 55, 80, 40, 20, ABS(2 / 3 * r - d) / (.335 * r), 1
36.             IF idx <= lenF THEN this$ = MID$(f$, idx, 1) ELSE this$ = " "
37.             COLOR , 0   '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< EDIT: thanks Fellippe!
38.             _PRINTSTRING (x, y), this$
39.         END IF
40.     NEXT
41. NEXT
42. PRINT
43. SLEEP
44. FUNCTION rand% (lo%, hi%)
45.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
46. END FUNCTION
47. FUNCTION rclr&&
48.     rclr&& = _RGB32(rand%(64, 255), rand%(64, 255), rand%(64, 255))
49. END FUNCTION
50. SUB midInk (r1, g1, b1, r2, g2, b2, fr, tf)
51.     IF tf THEN
52.         fc&& = rclr&&
53.     ELSE
54.         fc&& = _RGB32(r1 + (r2 - r1) * (1 - fr), g1 + (g2 - g1) * (1 - fr), b1 + (b2 - b1) * (1 - fr))
55.     END IF
56.     bc&& = _RGB32(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
57.     COLOR fc&&, bc&&
58. END SUB
59. 'XOXOXOXO
60.  

EDIT: 2018-03-09 as per Fellippe's suggestion in reply below, noted in code and screen shot updated.
EDIT: OK now maybe COLOR , 0 shows up in donut forgot to save before run and screenshot.

[Pete]

WARNING: Do not run B+'s program. Side effects include a "coded " tongue!

Pete :D

[bplus]

WARNING: Do not run B+'s program. Side effects include a "coded " tongue!

Pete :D

Which is why I am looking for coffee maker.   J'ava seen any?

Well maybe STxAxTIC can sprezzo an idea.

[Pete]

Bill? Maybe later. He's been off his bean lately.

Until then, have you tried?

Code: QB64: [Select]

1. SHELL _DONTWAIT "firefox http://javajenius.com/wp-content/uploads/2008/04/hamiltonbeach4cup1.jpg"

Pete :D

PS: The 3-D shading effects you created really make it look like a real donut, which reminds me. You owe me for a new monitor. I dunked mine. :(

 

[FellippeHeitor]

The idea is so random that it becomes unique. Great faux-3d on this one. Looks yummy!

I added COLOR , 0 right before the _PRINTSTRING statement, because your smooth donut was getting all full of semitransparent rectangles.

PS: Unless you'll _SCREENMOVE _MIDDLE, just let the OS place the window where it wants. Why bother?

[bplus]

The idea is so random that it becomes unique. Great faux-3d on this one. Looks yummy!

I added COLOR , 0 right before the _PRINTSTRING statement, because your smooth donut was getting all full of semitransparent rectangles.

PS: Unless you'll _SCREENMOVE _MIDDLE, just let the OS place the window where it wants. Why bother?

Thanks Fellippe, the COLOR , 0 works great!

I have to move my screens because I keep my tool bar on the left and QB64 never puts screen where I like it.
I have wondered how others find my settings on their screens? (But they can always comment the line out.)

[FellippeHeitor]

QB64 never puts screen where I like it

That's cause QB64 doesn't put it anywhere, it just asks the operating system to create a window. Where it'll show, is the OS's business alone.

[bplus]

QB64 never puts screen where I like it

That's cause QB64 doesn't put it anywhere, it just asks the operating system to create a window. Where it'll show, is the OS's business alone.

Ah, MS strikes again! "Where it'll show,.."
hmm... It usually shows title bar near middle of screen and typically a good portion goes past the bottom of the screen and the left side overlapping my tool bar.

BTW I edited the Original Post code with Fellippe's suggestion and updated the screen shot with that code change now showing.

[codeguy]

i WANTED TO SEE THAT DONUT SPIN. My specialized Ellipse/circle rotation algo is PERFECT for this :). Follows the mouse too.

Code: [Select]

'* cgEllipseMapImage
wiley& = _LOADIMAGE("DONUT WITH CODE SPRINKLES.PNG", 32)
h& = _NEWIMAGE(_WIDTH(wiley&), _HEIGHT(wiley&), 32)
SCREEN h&
_SCREENMOVE _MIDDLE
pi# = 3.1415926535897932386#

wwiley% = _WIDTH(wiley&)
hwiley% = _HEIGHT(wiley&)
'* plots to circle if xmag! = ymag!, otherwise an ellipse
xmag! = 1
ymag! = 1
_SOURCE wiley&
_DEST h&
DO
    rot! = rot! + (2 * pi#) / 20
    CLS
    IF wwiley% < hwiley% THEN
        radius% = wwiley% / 2
    ELSE
        radius% = hwiley% / 2
    END IF
    rlimit% = radius% / 4
    gx% = radius% + (wwiley% - radius% * 2)
    gy% = radius% + (hwiley% - radius% * 2)
    DO WHILE _MOUSEINPUT
        offsetx% = _MOUSEX
        offsety% = _MOUSEY
    LOOP
    'offsetx% = xmag! * radius% + (_WIDTH(h&) - 2 * xmag! * radius%)
    'offsety% = ymag! * radius% + (_HEIGHT(h&) - 2 * ymag! * radius%)
    DO
        circloop& = 0
        circ! = 2 * pi# * radius%
        DO
            xscan! = gx% + radius% * COS(2 * pi# * (circloop& / circ!))
            yscan! = gy% + radius% * SIN(2 * pi# * (circloop& / circ!))
            x& = POINT(xscan!, yscan!)

            plotx! = gx% + radius% * COS(rot! + 2 * pi# * (circloop& / circ!))
            ploty! = gy% + radius% * SIN(rot! + 2 * pi# * (circloop& / circ!))

            PSET (offsetx% + (plotx! - gx%) * xmag!, offsety% + (ploty! - gy%) * ymag!), x&
            circloop& = circloop& + 1
        LOOP UNTIL circloop& > circ!
        radius% = radius% - 1
    LOOP UNTIL radius% < rlimit%
    _DISPLAY
    _LIMIT 10
LOOP UNTIL INKEY$ > ""
SCREEN 0
_FREEIMAGE h&
_FREEIMAGE wiley&
SYSTEM


[Pete]

Sorry, we're fresh out of donuts. You didn't include the ping file! I grabbed it from the .net site.

Neat effect. What part of the code makes the two small white streak lines seen just outside the perimeter? I'd nix those. Other than that, wow, that's a lot accomplished for such a small amount of code. t makes me want to png a Ferrari with spinning tires!

Pete :D

[codeguy]

My guess is that the image is not centered, also that it may be rotating parts of the picture that are not actually the doughnut. There is a colored title bar at the top of this picture. With proper clipping, this artifact would not show up. My code only accounts for images that are centered and borderless. Here's another cool effect using the very same PNG. Again, no OpenGL, just plain old-skool rotations and translations.

Code: QB64: [Select]

1. '* perspectiverotate.bas
2. '* a flippin' special by codeguy
3. '* this version does not use a temporary drawing surface, so it saves memory and perhaps time.
4. DEFINT A-Z
5. TYPE Point3d
6.     x AS INTEGER
7.     y AS INTEGER
8.     z AS INTEGER
9. END TYPE
10.  
11. TYPE AccumInteger
12.     x AS INTEGER
13.     y AS INTEGER
14.     z AS INTEGER
15. END TYPE
16.  
17. TYPE CurrentRotations
18.     rx AS DOUBLE
19.     ry AS DOUBLE
20.     rz AS DOUBLE
21. END TYPE
22.  
23. TYPE RotateRec
24.     SumRotxyz AS CurrentRotations
25.     AddRotxyz AS CurrentRotations
26.     Origins AS Point3d
27.     AddDstXYZ AS AccumInteger
28. END TYPE
29.  
30. TYPE ImageRec
31.     Filename AS STRING * 32
32.     handle AS LONG
33.     starts AS Point3d
34.     Ends AS Point3d
35.     scale AS DOUBLE
36.     intensity AS INTEGER
37.     transparentcolor AS LONG
38.     CurrentFrame AS INTEGER
39.     NumFramesX AS INTEGER
40.     NumFramesY AS INTEGER
41.     NumFramesZ AS INTEGER
42. END TYPE
43.  
44. DIM IRec AS ImageRec
45. IRec.Filename = "donut with code sprinkles.png" '"c:\gaia.jpg" '* "e:\qb64\test.jpg" '*"c:\qb64\v091\qb64\test.jpg" '*
46. IRec.handle = _LOADIMAGE(Clean$(IRec.Filename), 32)
47. IRec.Ends.x = _WIDTH(IRec.handle)
48. IRec.Ends.y = _HEIGHT(IRec.handle)
49. IRec.Ends.z = _HEIGHT(IRec.handle)
50. IRec.starts.x = 1
51. IRec.starts.y = 1
52. IRec.starts.z = 1
53. IRec.scale = 1
54. IRec.intensity = 1
55. IRec.transparentcolor = _RGB(0, 128, 129)
56. IRec.CurrentFrame = 0
57. IRec.NumFramesX = 1
58. IRec.NumFramesY = 1
59. IRec.NumFramesZ = 1
60.  
61. DIM Scrn AS ImageRec
62. Scrn.Filename = ":video_output"
63. Scrn.handle = _SCREENIMAGE
64. Scrn.Ends.x = _WIDTH(Scrn.handle)
65. Scrn.Ends.y = _HEIGHT(Scrn.handle)
66. Scrn.Ends.z = _HEIGHT(Scrn.handle)
67. Scrn.starts.x = 1
68. Scrn.starts.y = 1
69. Scrn.starts.z = 1
70. Scrn.transparentcolor = -1
71. Scrn.CurrentFrame = 0
72. Scrn.NumFramesX = 1
73. Scrn.NumFramesY = 1
74. Scrn.NumFramesZ = 1
75. SCREEN Scrn.handle
76.  
77. DIM Rxyz AS RotateRec
78. Rxyz.AddRotxyz.rx = 3.1415926535 / 17
79. Rxyz.SumRotxyz.rx = 0
80. Rxyz.AddRotxyz.ry = 3.1415926535 / 37
81. Rxyz.SumRotxyz.ry = 0
82. Rxyz.AddRotxyz.rz = 3.1415926535 / 47
83. Rxyz.SumRotxyz.rz = 0
84. Rxyz.Origins.x = _WIDTH(Scrn.handle) / 2
85. Rxyz.AddDstXYZ.x = 7
86. Rxyz.Origins.y = _HEIGHT(Scrn.handle) / 2
87. Rxyz.AddDstXYZ.y = 7
88. Rxyz.Origins.z = IRec.Ends.z
89. Rxyz.AddDstXYZ.z = 7
90.  
91. CONST holybejeezusthisisgonnabecomplex% = -1
92. CONST darthwho% = 1
93. CONST clearscreen% = 0
94. imageclearmethod% = darthwho%
95.  
96. stime# = TIMER(.001)
97. DIM FrameCount AS _UNSIGNED _BYTE
98. FrameCount = 0
99. DIM LastRotateRec AS RotateRec
100. DIM LastPicRec AS ImageRec
101. DIM LastScrn AS ImageRec
102. DIM last
103. DO
104.     IF FrameCount < 255 THEN
105.         FrameCount = FrameCount + 1
106.     ELSE
107.         etime# = TIMER(.001)
108.         _TITLE Clean$(IRec.Filename) + STR$(FrameCount \ (etime# - stime#)) + STR$(FrameCount * IRec.Ends.y * IRec.Ends.x \ (etime# - stime#))
109.         FrameCount = 0
110.         stime# = etime#
111.     END IF
112.     SELECT CASE imageclearmethod%
113.         CASE darthwho%
114.             LINE (Scrn.starts.x, Scrn.starts.y)-(Scrn.Ends.x, Scrn.Ends.y), _RGBA(127, 129, 131, 127), BF '*effect courtesy of darthwho
115.         CASE holybejeezusthisisgonnabecomplex%
116.             LastRotateRec = Rxyz
117.             LastPicRec = IRec
118.             LastScrn = Scrn
119.             LastPicRec.intensity = NOT (IRec.intensity) AND 1
120.             PerspectiveRotate LastPicRec, LastScrn, LastRotateRec.Origins, LastRotateRec.SumRotxyz
121.         CASE clearscreen%
122.             CLS
123.         CASE ELSE
124.     END SELECT
125.     PerspectiveRotate IRec, Scrn, Rxyz.Origins, Rxyz.SumRotxyz
126.     'IRec.intensity = (IRec.intensity + 1) MOD 2
127.  
128.     IF IRec.intensity THEN
129.  
130.         Rxyz.SumRotxyz.rx = Rxyz.SumRotxyz.rx + Rxyz.AddRotxyz.rx
131.         IF Rxyz.Origins.x < Scrn.starts.x THEN
132.             Rxyz.AddDstXYZ.x = -Rxyz.AddDstXYZ.x
133.         ELSEIF Rxyz.Origins.x > Scrn.Ends.x THEN
134.             Rxyz.AddDstXYZ.x = -Rxyz.AddDstXYZ.x
135.         END IF
136.         Rxyz.Origins.x = Rxyz.Origins.x + Rxyz.AddDstXYZ.x
137.  
138.         Rxyz.SumRotxyz.ry = Rxyz.SumRotxyz.ry + Rxyz.AddRotxyz.ry
139.         IF Rxyz.Origins.y < Scrn.starts.y THEN
140.             Rxyz.AddDstXYZ.y = -Rxyz.AddDstXYZ.y
141.         ELSEIF Rxyz.Origins.y > Scrn.Ends.y THEN
142.             Rxyz.AddDstXYZ.y = -Rxyz.AddDstXYZ.y
143.         END IF
144.         Rxyz.Origins.y = Rxyz.Origins.y + Rxyz.AddDstXYZ.y
145.  
146.         Rxyz.SumRotxyz.rz = Rxyz.SumRotxyz.rz + Rxyz.AddRotxyz.rz
147.         IF Rxyz.Origins.z < Scrn.starts.z THEN
148.             Rxyz.AddDstXYZ.z = -Rxyz.AddDstXYZ.z
149.         ELSEIF Rxyz.Origins.z > Scrn.Ends.z THEN
150.             Rxyz.AddDstXYZ.z = -Rxyz.AddDstXYZ.z
151.         END IF
152.         Rxyz.Origins.z = Rxyz.Origins.z + Rxyz.AddDstXYZ.z
153.     END IF
154.     _DISPLAY
155. LOOP UNTIL INKEY$ > ""
156. SCREEN 0
157. _FREEIMAGE IRec.handle
158. _FREEIMAGE Scrn.handle
159. SYSTEM
160.  
161. SUB PerspectiveRotate (irec AS ImageRec, scrn AS ImageRec, Oxyz AS Point3d, rxyz AS CurrentRotations)
162.     $CHECKING:OFF
163.     tdest& = _DEST
164.     tsource& = _SOURCE
165.     _SOURCE irec.handle
166.     _DEST scrn.handle
167.     srz# = SIN(rxyz.rz)
168.     zscale! = Oxyz.z / (scrn.Ends.z - scrn.starts.z + 1)
169.  
170.     FOR i% = irec.starts.y TO irec.Ends.y
171.         newx# = (i% * srz#)
172.         FOR j% = irec.starts.x TO irec.Ends.x
173.             IF irec.scale = 1 THEN
174.                 IF irec.intensity THEN
175.                     p& = POINT(j%, i%)
176.                     IF p& <> irec.transparentcolor THEN
177.                         PSET (COS(rxyz.rx) * (newx#) * zscale! + Oxyz.x, SIN(rxyz.rx) * (j% * srz# + i%) * zscale! + Oxyz.y), p&
178.                     END IF
179.                 ELSE
180.                     PSET (COS(rxyz.rx) * (newx#) * zscale! + Oxyz.x, SIN(rxyz.rx) * (j% * srz# + i%) * zscale! + Oxyz.y), 0
181.                 END IF
182.             ELSE
183.                 IF irec.intensity THEN
184.                     p& = POINT(j%, i%)
185.                     IF p& <> irec.transparentcolor THEN
186.                         PSET (COS(rxyz.rx) * (newx# * irec.scale) * zscale! + Oxyz.x, SIN(rxyz.rx) * ((j% * srz# + i%) * irec.scale) * zscale! + Oxyz.y), p&
187.                     END IF
188.                 ELSE
189.                     PSET (COS(rxyz.rx) * (newx# * irec.scale) * zscale! + Oxyz.x, SIN(rxyz.rx) * ((j% * srz# + i%) * irec.scale) * zscale! + Oxyz.y), 0
190.                 END IF
191.             END IF
192.         NEXT
193.     NEXT
194.     _SOURCE tsource&
195.     _DEST tdest&
196.     $CHECKING:ON
197. END SUB
198.  
199. FUNCTION Clean$ (x$) 'sorta like ltrim$(rtrim$(x$))
200.     a% = 1: b% = LEN(x$)
201.     DO
202.         IF a% > b% THEN
203.             EXIT DO
204.         ELSE
205.             IF MID$(x$, a%, 1) > " " THEN
206.                 IF MID$(x$, b%, 1) > " " THEN
207.                     EXIT DO
208.                 ELSE
209.                     b% = b% - 1
210.                 END IF
211.             ELSE
212.                 a% = a% + 1
213.             END IF
214.         END IF
215.     LOOP
216.     Clean$ = MID$(x$, a%, b% - a% + 1)
217. END FUNCTION
218.  

[Pete]

My graphics card is not fast enough to appreciate that one. It would make a nice 3-D card dealing effect though.

Pete :)

[codeguy]

It's the size of the image, at 700 * 700, that's a LOT of CPU horsepower. Try a smaller image and it will be fast enough. Maybe the qb64 Bee logo or something 1/2-1/3 the 700 pixel size. Here's one. Cute too :).

[bplus]

OK does she make coffee?

[bplus]

OK a new spin on the donut code:

Code: QB64: [Select]

1. _TITLE "Donut code spiral by bplus 2018-03-11"
2. CONST xmax = 700
3. CONST ymax = 700
4. SCREEN _NEWIMAGE(xmax, ymax, 32)
5. _SCREENMOVE 360, 0
6. CONST cx = xmax / 2
7. CONST cy = ymax / 2
8. CONST tw = 8
9. CONST th = 16
10. OPEN "donut code spiral.bas" FOR INPUT AS #1
11. WHILE EOF(1) = 0
12.     LINE INPUT #1, fline$
13.     f$ = f$ + LTRIM$(fline$) + " : "
14. WEND
15. CLOSE #1
16. f$ = LEFT$(f$, LEN(f$) - 3)
17. lenF = LEN(f$)
18. tArea = tw * th * lenF / 2
19. r = SQR(9 / 4 * tArea / _PI)
20. FOR y = 0 TO ymax
21.     FOR x = 0 TO xmax
22.         d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^ .5
23.         IF r / 3 < d + 20 AND d - 20 < r THEN
24.             midInk 180, 90, 55, 80, 40, 20, 1 - ABS(2 / 3 * r - d) / (.335 * r), 0
25.             PSET (x + 5, y + 10)
26.         END IF
27.     NEXT
28. NEXT
29. idx = 0: rr = r / 3
30. WHILE idx < lenF
31.     idx = idx + 1
32.     rr = r / 3.6 + idx / (rr ^ .4) + 32
33.     a = a + 12 / rr
34.     x = cx + rr * COS(a)
35.     y = cy + rr * SIN(a)
36.     midInk 180, 90, 55, 80, 40, 20, ABS(2 / 3 * r - d) / (.335 * r), 1
37.     COLOR , 0
38.     _PRINTSTRING (x, y), MID$(f$, lenF - idx + 1, 1)
39. WEND
40. PRINT
41. SLEEP
42. FUNCTION rand% (lo%, hi%)
43.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
44. END FUNCTION
45. FUNCTION rclr&&
46.     rclr&& = _RGB32(rand%(64, 255), rand%(64, 255), rand%(64, 255))
47. END FUNCTION
48. SUB midInk (r1, g1, b1, r2, g2, b2, fr, tf)
49.     IF tf THEN
50.         fc&& = rclr&&
51.     ELSE
52.         fc&& = _RGB32(r1 + (r2 - r1) * (1 - fr), g1 + (g2 - g1) * (1 - fr), b1 + (b2 - b1) * (1 - fr))
53.     END IF
54.     bc&& = _RGB32(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
55.     COLOR fc&&, bc&&
56. END SUB
57. 'XOXOXOXO
58.  

EDIT: oops forgot to change filename, screen shot updated too.