﻿ Crop Circles

 Crop Circles
09-12-2017, 12:55 AM
Post: #1
(Print Post)
 bplus Posting Freak Posts: 1,127 Likes Given: 329 Likes Received: 192 in 164 posts Joined: Apr 2017 Country of Origin::
Code Snippet: [Select]
```'crop circles 1.bas SmallBASIC 2015-09-19 MGA/B+ cx=xmax/2:cy=ymax/2:cr=cy-60:m=20:OK=1 pen on rect 0,0,xmax,ymax,rgb(0,128,0) filled while OK    k=inkey    if len(k)=1 and asc(k)=27 then OK=0    if k="c" then rect 0,0,xmax,ymax,rgb(0,128,0) filled    mx=pen(4):my=pen(5)    dx=(mx-cx)/m:dy=(my-cy)/m:dr=cr/m    for i=m to 0 step -1       if i mod 2 then cc=rgb(0,160,0) else cc=rgb(0,128,0)       x=cx+dx*(m-i):y=cy+dy*(m-i):r=dr*i       circle x,y,r,1,cc filled    next    delay 200 wend pen off```

Attached File(s) Image(s)

http://www.laughfactory.com/jokes/joke-of-the-day
worse than Pete's
09-12-2017, 12:57 AM (This post was last modified: 09-12-2017 12:59 AM by bplus.)
Post: #2
(Print Post)
 bplus Posting Freak Posts: 1,127 Likes Given: 329 Likes Received: 192 in 164 posts Joined: Apr 2017 Country of Origin::
Coming soon...

Attached File(s) Image(s)

http://www.laughfactory.com/jokes/joke-of-the-day
worse than Pete's
09-14-2017, 11:37 AM
Post: #3
(Print Post)
 Waltersmind (Admin) Library Director / Administrator Posts: 877 Likes Given: 163 Likes Received: 188 in 160 posts Joined: Jun 2014
Where's the source code to the second set of graphics?

Dedicated to working with computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
09-14-2017, 01:26 PM
Post: #4
(Print Post)
 bplus Posting Freak Posts: 1,127 Likes Given: 329 Likes Received: 192 in 164 posts Joined: Apr 2017 Country of Origin::
Of course these are cherry picked!

Attached File(s) Image(s)

http://www.laughfactory.com/jokes/joke-of-the-day
worse than Pete's
09-14-2017, 05:08 PM
Post: #5
(Print Post)
 bplus Posting Freak Posts: 1,127 Likes Given: 329 Likes Received: 192 in 164 posts Joined: Apr 2017 Country of Origin::
Such variety from so little code:
Code Snippet: [Select]
```' crop circles update.bas SmallBASIC 0.12.9 (B+=MGA) 2017-09-14 ' from: crop circle #5.bas for SmallBASIC old FTLK 11.5 2015-11-01 MGA/B+ ' 2017-09-14 mod for spacebar key SmallBASIC 0.12.9 definekey 32, cc const x0 = xmax / 2 : const y0 = ymax/2 cc sub cc  color 15, rgb(0, 128, 0) : cls  print "Crop Circles,   press spacebar for next field."  r0 = Rand(1, 5) / 10 : r1 = Rand(1, 5) / 10: r2 = Rand(1, 5) / 10  fc = Rand(1, 200) / 10 : st = Rand(10, 500) / 1000  xol = 0 : yol = 0 : mol = 0  for i = 0 to 120 step st    a0 = (i / r0) * (2 * pi)    a1 = ((i / r1) * (2 * pi)) * -1    x1 = x0 + (sin(a0) * ((r0 - r1) * fc)) * 30    y1 = y0 + (cos(a0) * ((r0 - r1) * fc)) * 30    x2 = x1 + (sin(a1) * ((r2) * fc)) * 30    y2 = y1 + (cos(a1) * ((r2) * fc)) * 30    if mol = 0 then      mol = 1: xol = x2: yol = y2    else      line xol, yol, x2, y2, rgb(0,194,0)      xol = x2 : yol = y2    end if  next  while inkey = 0 : delay 40: wend   end func Rand(low, high)   Rand = rnd * (high - low) + low end  ```

Attached File(s) Image(s)

http://www.laughfactory.com/jokes/joke-of-the-day
worse than Pete's
09-14-2017, 06:09 PM
Post: #6
(Print Post)
 johnno56 Member Posts: 151 Likes Given: 4 Likes Received: 26 in 24 posts Joined: Apr 2017 Country of Origin::
So much variety from such little code!

Back in the mid 80's, running on a 4mhz box, it could take upward of about 2 minutes to draw just one pattern. Now, by just holding down space, several patterns are drawn per second... the mind boggles... at least 'mine' does... and that's not hard to do... lol

Great job!

J

May your journey be free of incident.

Live long and prosper.
 « Next Oldest | Next Newest »

Forum Jump:

User(s) browsing this thread: 1 Guest(s)