« previous next »
Pages: 1 [2]   Go Down

Author Topic: Crop Circles  (Read 5502 times)

0 Members and 1 Guest are viewing this topic.

Offline johnno56

  • Forum Resident
  • Posts: 1270
  • Live long and prosper.
    • View Profile
Re: Crop Circles
« Reply #15 on: January 26, 2021, 01:59:01 pm »
Dav,

Mr. Warhol would be jealous...

J
Logged
Logic is the beginning of wisdom.

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Crop Circles
« Reply #16 on: January 26, 2021, 03:19:01 pm »
Nice, bplus, it looks very much like Romanesco broccoli
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Crop Circles
« Reply #17 on: January 26, 2021, 03:57:05 pm »
Quote from: _vince on January 26, 2021, 03:19:01 pm
Nice, bplus, it looks very much like Romanesco broccoli


Stop encouraging him, Vince.Now he'll code it with cheese saucers.

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Crop Circles
« Reply #18 on: January 26, 2021, 05:13:49 pm »
Thanks @vince, I had to remind myself that fractal veggie.

@Pete well cheese doesn't fly but flying cups, bowls, pans, egg timers or blenders, hmm... ;-)

Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Crop Circles
« Reply #19 on: January 26, 2021, 05:18:02 pm »
Flying blenders? Well, like the priest said, who visited Steve's farm... Holy Crop!

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/
Marked as best answer by bplus on January 26, 2021, 03:18:06 pm

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Crop Circles
« Reply #20 on: January 26, 2021, 06:37:50 pm »
Oh look what the blender dragged in:
Code: QB64: [Select]
  1. _TITLE "Crop Circles #3 Mod 2 Blender" 'b+ trans and mod to QB64 2021-01-25
  2.  
  3. CONST Xmax = 1024, Ymax = 730, Cx = Xmax / 2, Cy = Ymax / 2, nCrops = 4
  5. SCREEN _NEWIMAGE(Xmax, Ymax, 32)
  6. _DELAY .25
  8. REDIM SHARED LowColr AS _UNSIGNED LONG, HighColr AS _UNSIGNED LONG, cNum AS LONG
  9. HighColr = _RGB32(240, 220, 80): LowColr = _RGB32(100, 50, 10)
  10. crop0
  12.     _PUTIMAGE , CCircle, 0
  13.     WHILE _MOUSEINPUT: WEND 'aim with mouse
  14.     mx = _MOUSEX: my = _MOUSEY: mb = _MOUSEBUTTON(1)
  15.     drawShip mx, my, LowColr
  16.     IF mb THEN
  17.         PLC mx, my, Cx, Cy, 360
  18.         _DISPLAY
  19.         _DELAY .2
  20.         FlagChange = -1
  21.     END IF
  22.     IF FlagChange THEN
  23.         IF RND < .5 THEN
  24.             crop3
  25.         ELSE
  26.             cNum = (cNum + 1) MOD nCrops
  27.             SELECT CASE cNum
  28.                 CASE 0: crop0
  29.                 CASE 1: crop1
  30.                 CASE 2: crop2
  31.                 CASE 3: crop3
  32.             END SELECT
  33.         END IF
  34.         FlagChange = 0
  35.     END IF
  36.     _DISPLAY
  38.  
  39. 'crop0 uses this
  40. SUB drawc (mx, my)
  42.     cr = .5 * SQR((Cx - mx) ^ 2 + (Cy - my) ^ 2): m = .5 * cr
  43.     dx = (mx - Cx) / m: dy = (my - Cy) / m: dr = cr / m
  44.     FOR i = m TO 0 STEP -1
  45.         IF i MOD 2 = 0 THEN cc = HighColr ELSE cc = LowColr
  46.         x = Cx + dx * (m - i): y = Cy + dy * (m - i): r = dr * i
  47.         fcirc x, y, r, cc
  48.     NEXT
  50.  
  51. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG)
  52.     DIM Radius AS LONG, RadiusError AS LONG
  53.     DIM X AS LONG, Y AS LONG
  54.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  55.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  56.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  57.     WHILE X > Y
  58.         RadiusError = RadiusError + Y * 2 + 1
  59.         IF RadiusError >= 0 THEN
  60.             IF X <> Y + 1 THEN
  61.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  62.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  63.             END IF
  64.             X = X - 1
  65.             RadiusError = RadiusError - X * 2
  66.         END IF
  67.         Y = Y + 1
  68.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  69.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  70.     WEND
  72.  
  73. SUB PLC (baseX, baseY, targetX, targetY, targetR) ' PLC for PlasmaLaserCannon
  74.     r = RND ^ 2 * RND: g = RND ^ 2 * RND: b = RND ^ 2 * RND: hp = _PI(.5) ' red, green, blue, half pi
  75.     ta = _ATAN2(targetY - baseY, targetX - baseX) ' angle of target to cannon base
  76.     dist = _HYPOT(targetY - baseY, targetX - baseX) ' distance cannon to target
  77.     dr = targetR / dist
  78.     FOR r = 0 TO dist STEP .25
  79.         x = baseX + r * COS(ta)
  80.         y = baseY + r * SIN(ta)
  81.         c = c + .3
  82.         fcirc x, y, dr * r, _RGB32(128 + 127 * SIN(r * c), 128 + 127 * SIN(g * c), 128 + 127 * SIN(b * c))
  83.     NEXT
  84.     FOR rr = dr * r TO 0 STEP -.5
  85.         c = c + 1
  86.         LowColr = _RGB32(128 + 127 * SIN(r * c), 128 + 127 * SIN(g * c), 128 + 127 * SIN(b * c))
  87.         fcirc x, y, rr, LowColr
  88.     NEXT
  89.     cAnalysis LowColr, rr, gg, bb, aa
  90.     HighColr = _RGB32(255 - rr, 255 - gg, 255 - bb)
  92.  
  93. ' PLC uses this
  94. SUB cAnalysis (c AS _UNSIGNED LONG, outRed, outGrn, outBlu, outAlp)
  95.     outRed = _RED32(c): outGrn = _GREEN32(c): outBlu = _BLUE32(c): outAlp = _ALPHA32(c)
  97.  
  98. SUB drawShip (x, y, colr AS _UNSIGNED LONG) 'shipType     collisions same as circle x, y radius = 30
  99.     STATIC ls
  100.     DIM light AS LONG, r AS LONG, g AS LONG, b AS LONG
  101.     r = _RED32(colr): g = _GREEN32(colr): b = _BLUE32(colr)
  102.     fellipse x, y, 6, 15, _RGB32(r, g - 120, b - 100)
  103.     fellipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
  104.     fellipse x, y, 30, 7, _RGB32(r, g, b)
  105.     FOR light = 0 TO 5
  106.         fcirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
  107.     NEXT
  108.     ls = ls + 1
  109.     IF ls > 5 THEN ls = 0
  111.  
  112. ' drawShip needs
  113. SUB fellipse (CX AS LONG, CY AS LONG, xr AS LONG, yr AS LONG, C AS _UNSIGNED LONG)
  114.     IF xr = 0 OR yr = 0 THEN EXIT SUB
  116.     DIM x AS LONG, y AS LONG
  117.     w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
  118.     LINE (CX - xr, CY)-(CX + xr, CY), C, BF
  119.     DO WHILE y < yr
  120.         y = y + 1
  121.         x = SQR((h2w2 - y * y * w2) \ h2)
  122.         LINE (CX - x, CY + y)-(CX + x, CY + y), C, BF
  123.         LINE (CX - x, CY - y)-(CX + x, CY - y), C, BF
  124.     LOOP
  126.  
  127. FUNCTION rand (low, high)
  128.     rand = RND * (high - low) + low
  130.  
  131.  
  132. SUB crop0
  133.     IF CCircle THEN _FREEIMAGE CCircle
  134.     CCircle = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
  135.     _DEST CCircle
  136.     COLOR , HighColr
  137.     CLS
  138.     n = 12: stp = -40
  139.     FOR br = 360 TO 0 STEP stp
  140.         shft = shft + 720 / (n * n)
  141.         FOR i = 1 TO n
  142.             x = Cx + br * COS(_D2R(i * 360 / n + shft))
  143.             y = Cy + br * SIN(_D2R(i * 360 / n + shft))
  144.             drawc x, y
  145.         NEXT
  146.     NEXT
  147.     _DEST 0
  149.  
  150. SUB crop1
  151.     IF CCircle THEN _FREEIMAGE CCircle
  152.     CCircle = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
  153.     _DEST CCircle
  154.     COLOR , HighColr
  155.     CLS
  156.     ga = 137.5: bn = 800
  157.     br = 9.5: lr = .5: r = br: dr = (br - lr) / bn
  158.     hc = 180: lc = 120: cr = (hc - lc) / bn
  159.     FOR n = 1 TO bn
  160.         x = Cx + 10 * SQR(n) * COS(_D2R(n * ga))
  161.         y = Cy + 10 * SQR(n) * SIN(_D2R(n * ga))
  162.         r = r - dr
  163.         fcirc x, y, r, LowColr
  164.     NEXT
  165.     _DEST 0
  167.  
  168. SUB crop2
  169.     IF CCircle THEN _FREEIMAGE CCircle
  170.     CCircle = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
  171.     _DEST CCircle
  172.     'this needs big constrast of color
  173.     HighColr = _RGB32(RND * 80, RND * 80, RND * 80) ' field
  174.     LowColr = _RGB32(175 + RND * 80, 175 + RND * 80, 175 + RND * 80)
  175.     COLOR , HighColr
  176.     CLS
  177.     FOR i = 45 TO Xmax STEP 50
  178.         LINE (i, 0)-(i + 10, Ymax), LowColr, BF
  179.         LINE (0, i)-(Xmax, i + 10), LowColr, BF
  180.     NEXT
  181.     FOR y = 50 TO 650 STEP 50
  182.         FOR x = 50 TO Xmax STEP 50
  183.             fcirc x, y, 10, LowColr
  184.         NEXT
  185.     NEXT
  186.     _DEST 0
  188.  
  189. SUB crop3
  190.     IF CCircle THEN _FREEIMAGE CCircle
  191.     CCircle = _NEWIMAGE(_WIDTH, _HEIGHT, 32)
  192.     _DEST CCircle
  193.     COLOR , HighColr
  194.     CLS
  195.  
  196.     r0 = rand(1, 5) / 5: r1 = rand(1, 5) / 10: r2 = rand(1, 5) / 10
  197.     fc = rand(1, 200) / 10: st = rand(10, 500) / 1000
  198.     xol = 0
  199.     yol = 0
  200.     mol = 0
  201.     FOR i = 0 TO 120 STEP st
  202.         a0 = (i / r0) * (2 * _PI)
  203.         a1 = ((i / r1) * (2 * _PI)) * -1
  204.         x1 = Cx + (SIN(a0) * ((r0 - r1) * fc)) * 30
  205.         y1 = Cy + (COS(a0) * ((r0 - r1) * fc)) * 30
  206.         x2 = x1 + (SIN(a1) * ((r2) * fc)) * 30
  207.         y2 = y1 + (COS(a1) * ((r2) * fc)) * 30
  208.         IF mol = 0 THEN
  209.             mol = 1
  210.             xol = x2
  211.             yol = y2
  212.         ELSE
  213.             LINE (xol, yol)-(x2, y2), LowColr
  214.             xol = x2
  215.             yol = y2
  216.         END IF
  217.     NEXT
  218.  
  219.  
  220.     _DEST 0
  222.  
  223.  
Logged

Offline _vince

  • Seasoned Forum Regular
  • Posts: 422
    • View Profile
Re: Crop Circles
« Reply #21 on: January 26, 2021, 07:28:18 pm »
I remember seeing one of these fresh at a local farmer's market and I had to buy it.  It was the most beautiful thing ever.  Screw gifting flowers, imagine receiving one of these for a change.

I ate it raw like broccoli and it tasted like crap, compared to broccoli it's very hard and is relatively tasteless but whatever taste there is it's not very good, I ate the entire thing anyway (not at once).  Maybe it's better cooked?
20170923_180342.jpg
* 20170923_180342.jpg (Filesize: 511.59 KB, Dimensions: 857x711, Views: 172)
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Crop Circles
« Reply #22 on: January 26, 2021, 08:15:24 pm »
Quote
Screw gifting flowers, imagine receiving one of these for a change.

Sure and Valentine's Day is coming soon!
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Crop Circles
« Reply #23 on: January 26, 2021, 08:19:53 pm »
It was all fun and games, until I had to stop to count Steve's damn dots!

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Crop Circles
« Reply #24 on: January 26, 2021, 08:54:30 pm »
Quote from: Pete on January 26, 2021, 08:19:53 pm
It was all fun and games, until I had to stop to count Steve's damn dots!

Pete

I know just what you mean!

Code: QB64: [Select]
  5. SCREEN _NEWIMAGE(xmax, ymax, 32)
  6. _DELAY .25
  9.     _PUTIMAGE , sc&, 0
  10.     FOR y = 50 TO ymax - 50 STEP 50
  11.         FOR x = 50 TO xmax - 50 STEP 50
  12.             fcirc x, y, 10, _RGB32(RND * 40, RND * 40, RND * 40, RND * 40)
  13.         NEXT
  14.     NEXT
  15.     _DISPLAY
  16.     _LIMIT 10
  20.  
  21.  
  22. SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
  23.     DIM Radius AS INTEGER, RadiusError AS INTEGER
  24.     DIM X AS INTEGER, Y AS INTEGER
  25.     Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
  26.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
  27.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  28.     WHILE X > Y
  29.         RadiusError = RadiusError + Y * 2 + 1
  30.         IF RadiusError >= 0 THEN
  31.             IF X <> Y + 1 THEN
  32.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  33.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  34.             END IF
  35.             X = X - 1
  36.             RadiusError = RadiusError - X * 2
  37.         END IF
  38.         Y = Y + 1
  39.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  40.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  41.     WEND
  43.  

Edit: new and maybe improved

« Last Edit: January 26, 2021, 09:00:17 pm by bplus »
Logged

Offline SierraKen

  • Forum Resident
  • Posts: 1454
    • View Profile
Re: Crop Circles
« Reply #25 on: January 26, 2021, 11:14:54 pm »
Soon someone is going to write a book about this thread.... and it will be in the paranormal section. o_o
Logged

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
Re: Crop Circles
« Reply #26 on: January 26, 2021, 11:17:16 pm »
It'll be the Librarian who writes about this. Are crop circles pure art? ... or are they ... simulation of a real thing?! OOooOOOOo

I don't buy what the BBC documentary says, there's something real about crop circles.
Logged
You're not done when it works, you're done when it's right.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Crop Circles
« Reply #27 on: January 27, 2021, 01:52:36 am »
Yeah I only know some of those designs have captured my imagination.
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Crop Circles
« Reply #28 on: January 27, 2021, 11:27:44 am »
I had something that captured my imagination once, but my wife refused to pay the ransom to get it back. Hey, two dollars is two dollars.

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/
Pages: 1 [2]   Go Up
« previous next »