Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on March 08, 2018, 08:40:30 pm

Title: Donut with Code Sprinkles looking for Coffee Maker
Post by: bplus on March 08, 2018, 08:40:30 pm
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)
  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$) + " : "
  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
  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
  44. FUNCTION rand% (lo%, hi%)
  45.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  47. FUNCTION rclr&&
  48.     rclr&& = _RGB32(rand%(64, 255), rand%(64, 255), rand%(64, 255))
  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&&
  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.
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: Pete on March 08, 2018, 09:21:22 pm
WARNING: Do not run B+'s program. Side effects include a "coded " tongue!

Pete :D
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: bplus on March 09, 2018, 09:09:19 am
Quote from: Pete on March 08, 2018, 09:21:22 pm
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.
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: Pete on March 09, 2018, 11:22:24 am
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. :(

 
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: FellippeHeitor on March 09, 2018, 01:28:20 pm
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?
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: bplus on March 09, 2018, 07:27:29 pm
Quote from: FellippeHeitor on March 09, 2018, 01:28:20 pm
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.)
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: FellippeHeitor on March 09, 2018, 07:53:55 pm
Quote
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.
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: bplus on March 09, 2018, 10:07:41 pm
Quote from: FellippeHeitor on March 09, 2018, 07:53:55 pm
Quote
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.
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: codeguy on March 10, 2018, 01:41:18 am
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
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: Pete on March 10, 2018, 03:51:47 pm
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
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: codeguy on March 10, 2018, 11:55:27 pm
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
  10.  
  11. TYPE AccumInteger
  12.     x AS INTEGER
  13.     y AS INTEGER
  14.     z AS INTEGER
  16.  
  17. TYPE CurrentRotations
  18.     rx AS DOUBLE
  19.     ry AS DOUBLE
  20.     rz AS DOUBLE
  22.  
  23. TYPE RotateRec
  24.     SumRotxyz AS CurrentRotations
  25.     AddRotxyz AS CurrentRotations
  26.     Origins AS Point3d
  27.     AddDstXYZ AS AccumInteger
  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
  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
  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
  157. _FREEIMAGE IRec.handle
  158. _FREEIMAGE Scrn.handle
  160.  
  161. SUB PerspectiveRotate (irec AS ImageRec, scrn AS ImageRec, Oxyz AS Point3d, rxyz AS CurrentRotations)
  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&
  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)
  218.  
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: Pete on March 11, 2018, 12:36:51 am
My graphics card is not fast enough to appreciate that one. It would make a nice 3-D card dealing effect though.

Pete :)
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: codeguy on March 11, 2018, 04:53:20 am
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 :).
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: bplus on March 11, 2018, 11:02:33 am
OK does she make coffee?
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: bplus on March 11, 2018, 11:30:04 am
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)
  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$) + " : "
  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
  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)
  42. FUNCTION rand% (lo%, hi%)
  43.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  45. FUNCTION rclr&&
  46.     rclr&& = _RGB32(rand%(64, 255), rand%(64, 255), rand%(64, 255))
  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&&
  57. 'XOXOXOXO
  58.  

EDIT: oops forgot to change filename, screen shot updated too.
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: Ashish on March 11, 2018, 01:00:12 pm
Cool! ;D
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: bplus on March 20, 2018, 08:59:09 am
[banned user], looks like someone ate too many spiral sprinkled donuts!

Here is donut sprinkled with deliciousness not using file:
Code: QB64: [Select]
  1. _TITLE "Donut code spiral by bplus mod by bplus 2018-03-20"
  2. CONST xmax = 700
  3. CONST ymax = 700
  4. SCREEN _NEWIMAGE(xmax, ymax, 32)
  6. CONST cx = xmax / 2
  7. CONST cy = ymax / 2
  8. CONST tw = 8
  9. CONST th = 16
  10. sprinkle$ = "bplus "
  11. lenF = 1240
  12. tArea = tw * th * lenF / 2
  13. r = SQR(10 / 4 * tArea / _PI)
  14. FOR y = 0 TO ymax
  15.     FOR x = 0 TO xmax
  16.         d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^ .5
  17.         IF r / 3 < d + 20 AND d - 20 < r THEN
  18.             midInk 180, 90, 55, 80, 40, 20, 1 - ABS(2 / 3 * r - d) / (.335 * r), 0
  19.             PSET (x + 5, y + 10)
  20.         END IF
  21.     NEXT
  23. idx = 0: rr = r / 3
  24. WHILE idx < lenF
  25.     idx = idx + 1
  26.     rr = r / 3.6 + idx / (rr ^ .4) + 32
  27.     a = a + 12 / rr
  28.     x = cx + rr * COS(a)
  29.     y = cy + rr * SIN(a)
  30.     midInk 180, 90, 55, 80, 40, 20, ABS(2 / 3 * r - d) / (.335 * r), 1
  31.     COLOR , 0
  32.     _PRINTSTRING (x, y), MID$(sprinkle$, idx MOD 6 + 1, 1)
  36. FUNCTION rand% (lo%, hi%)
  37.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  39. FUNCTION rclr&&
  40.     rclr&& = _RGB32(rand%(64, 255), rand%(64, 255), rand%(64, 255))
  42. SUB midInk (r1, g1, b1, r2, g2, b2, fr, tf)
  43.     IF tf THEN
  44.         fc&& = rclr&&
  45.     ELSE
  46.         fc&& = _RGB32(r1 + (r2 - r1) * (1 - fr), g1 + (g2 - g1) * (1 - fr), b1 + (b2 - b1) * (1 - fr))
  47.     END IF
  48.     bc&& = _RGB32(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
  49.     COLOR fc&&, bc&&
  51. 'XOXOXOXO
  52.  
  53.  
Title: Re: Donut with Code Sprinkles looking for Coffee Maker
Post by: bplus on March 20, 2018, 10:23:17 am
Here it is with lettering reversed so it will play right on record player with needle at edge of donut.

Code: QB64: [Select]
  1. _TITLE "Donut code spiral by bplus mod by bplus 2018-03-20"
  2. CONST xmax = 700
  3. CONST ymax = 700
  4. SCREEN _NEWIMAGE(xmax, ymax, 32)
  6. CONST cx = xmax / 2
  7. CONST cy = ymax / 2
  8. CONST tw = 8
  9. CONST th = 16
  10. sprinkle$ = "bplus "
  11. lenF = 1240
  12. tArea = tw * th * lenF / 2
  13. r = SQR(10 / 4 * tArea / _PI)
  14. FOR y = 0 TO ymax
  15.     FOR x = 0 TO xmax
  16.         d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^ .5
  17.         IF r / 3 < d + 20 AND d - 20 < r THEN
  18.             midInk 180, 90, 55, 80, 40, 20, 1 - ABS(2 / 3 * r - d) / (.335 * r), 0
  19.             PSET (x + 5, y + 10)
  20.         END IF
  21.     NEXT
  23. idx = 0: rr = r / 3
  24. WHILE idx < lenF
  25.     idx = idx + 1
  26.     rr = r / 3.6 + idx / (rr ^ .4) + 32
  27.     a = a + 12 / rr
  28.     x = cx + rr * COS(a)
  29.     y = cy + rr * SIN(a)
  30.     midInk 180, 90, 55, 80, 40, 20, ABS(2 / 3 * r - d) / (.335 * r), 1
  31.     COLOR , 0
  32.     _PRINTSTRING (x, y), MID$(sprinkle$, idx MOD 6 + 1, 1)
  36. FUNCTION rand% (lo%, hi%)
  37.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  39. FUNCTION rclr&&
  40.     rclr&& = _RGB32(rand%(64, 255), rand%(64, 255), rand%(64, 255))
  42. SUB midInk (r1, g1, b1, r2, g2, b2, fr, tf)
  43.     IF tf THEN
  44.         fc&& = rclr&&
  45.     ELSE
  46.         fc&& = _RGB32(r1 + (r2 - r1) * (1 - fr), g1 + (g2 - g1) * (1 - fr), b1 + (b2 - b1) * (1 - fr))
  47.     END IF
  48.     bc&& = _RGB32(r1 + (r2 - r1) * fr, g1 + (g2 - g1) * fr, b1 + (b2 - b1) * fr)
  49.     COLOR fc&&, bc&&
  51. 'XOXOXOXO
  52.  
  53.  

Might be a bit hypnotic because doing it with code file WAS much more interesting.
Text Only | Text with Attachments