### Author Topic: In a doNUT SHELL  (Read 265 times)

#### B+

• Sr. Member
• Posts: 458
##### In a doNUT SHELL
« on: 04. May 2017, 05:47:32 »
Hungry for some sweet code?

Code: [Select]
`' In a doNUT SHELL.bas SmallBASIC 0.12.9 (B+=MGA) 2017-05-03const cx = xmax/2  'center screenconst cy = ymax/2const tw = txtw("W") 'text char widthconst th = txth("Q") 'text char heightsub midInk(r1, g1, b1, r2, g2, b2, fr)  color rgb(r1+(r2-r1)*fr, g1+(g2-g1)*fr, b1+(b2-b1)*fr)endtload("In a doNUT SHELL.bas", f, 1)lenF = len(f)'lenF = 800  'don't want to get much more than 800 charstArea = tw * th * lenF / 1.95  'text area in pixels'had to divide by 2 for some reason then fudge'tArea = pi * (2/3 * r)^2'9/4 * tArea/pi = r^2r = sqr(9/4 * tArea/pi)'divide screen into character cells and see if in or out of donut' if in, print a character from this source code until run out ' then send XO'sidx = 0for y = 0 to ymax step th  for x = 0 to xmax step tw    d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^.5    if r/3 < d and d < r then      idx +=1      at x, y       midink(255, 255, 255, 80, 40, 20, abs(2/3*r - d)/(.335*r))      if idx < lenF then         ? mid(f, idx, 1);       else         this = iff(idx mod 2, "X", "O") : ? this;      fi    fi  nextnextprintpause   `

#### B+

• Sr. Member
• Posts: 458
##### Re: In a doNUT SHELL
« Reply #1 on: 04. May 2017, 18:11:58 »
Oh! This works very well in JB, in fact an improvement!

Code: [Select]
`'In a doNUT SHELL.txt for JB [B+=MGA]'translated from SmallBASIC 2017-05-04global H\$, XMAX, YMAX, piH\$ = "#gr"XMAX = 780YMAX = 740pi = acs(-1)nomainwinWindowWidth = XMAX + 8WindowHeight = YMAX + 32UpperLeftX = (1200 - XMAX) / 2UpperLeftY = (700 - YMAX) / 2open "In a doNUT SHELL, code for this!" for graphics_nsb_nf as #gr#gr "setfocus"#gr "trapclose quit"#gr "font dejavu_sans_mono 10 20"#gr "down"#gr "fill black"cx = XMAX/2  'center screency = YMAX/2tw = 10th = 20open "In a doNUT SHELL.txt" for input as #1while eof(#1) = 0    input #1, fline\$    f\$ = f\$;fline\$;":"wendclose #1lenF = len(f\$)'lenF = 800  'don't want to get much more than 800 charstArea = tw * th * lenF / 1.95  'text area in pixels'had to divide by 2 for some reason then fudge'tArea = pi * (2/3 * r)^2'9/4 * tArea/pi = r^2r = sqr(9/4 * tArea/pi)'divide screen into character cells and see if in or out of donut' if in, print a character from this source code until run out' then send XO'sidx = 0for y = 0 to YMAX step th  for x = 0 to XMAX step tw    d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^.5    if r/3 < d and d < r then      idx = idx + 1      call midInk 255, 255, 255, 80, 40, 20, abs(2/3*r - d)/(.335*r)      if idx <= lenF then        call at x, y, mid\$(f\$, idx, 1)      else        if idx mod 2 then call at x, y, "O" else call at x, y, "X"      end if    end if  nextnext#gr "flush"waitsub midInk r1, g1, b1, r2, g2, b2, percent    dr = (r2 - r1) : dg = (g2 - g1) : db = (b2 - b1)    #H\$ "color ";r1 + dr * (1 - percent);" ";g1 + dg * (1 - percent);" ";b1 + db * (1 - percent)    #H\$ "backcolor ";r1 + dr * percent;" ";g1 + dg * percent;" ";b1 + db * percentend subsub at xPix, yPix, char\$  'print a string at pixel x, y This pin point locating.    #gr "place ";xPix;" ";yPix    #gr "|";char\$ end subsub quit H\$    close #H\$    endend sub`

#### B+

• Sr. Member
• Posts: 458
##### Re: In a doNUT SHELL
« Reply #2 on: 04. May 2017, 20:16:50 »
Here is SdlBasic version:
Code: [Select]
`'  In a doNUT SHELL.sdlbas (B+=MGA) 2017-05-04' from: In a doNUT SHELL.bas SmallBASIC 0.12.9 (B+=MGA) 2017-05-04' translating to JB, I discovered an improvemnet!const xmax = 720const ymax = 720const cx = xmax/2  'center screenconst cy = ymax/2const tw = 10const th = 18const pi = acos(-1)setdisplay(xmax, ymax, 32, 1)setcaption("In a doNUT SHELL, this code! For SdlBasic")sub midInk(r1, g1, b1, r2, g2, b2, fr) ink(rgb(r1+(r2-r1)*fr, g1+(g2-g1)*fr, b1+(b2-b1)*fr))end subopen "donut.sdlbas" for input as #1f = ""while not eof(1)    file input #1, fline    f = f + fline + ":"wendclose(1)lenF = len(f)'lenF = 800  'don't want to get much more than 800 charstArea = tw * th * lenF / 1.95  'text area in pixels'had to divide by 2 for some reason then fudge'tArea = pi * (2/3 * r)^2'9/4 * tArea/pi = r^2r = sqr(9/4 * tArea/pi)'back color the donutfor y = 0 to ymax for x = 0 to xmax d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^.5 if r/3 < d and d < r then midink(255, 255, 255, 80, 40, 20, abs(2/3*r - d)/(.335*r)) dot(x, y) end if nextnext'divide screen into character cells and see if in or out of donut' if in, print a character from this source code until run out' then send XO'sidx = 0for y = 0 to ymax step th for x = 0 to xmax step tw d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^.5 if r/3 < d and d < r then idx +=1 midink(255, 255, 255, 80, 40, 20, 1 - abs(2/3*r - d)/(.335*r)) if idx < lenF then t = mid(f, idx, 1) if asc(t) < 32 or asc(t) >= 128 then : t = " " : end if text(x-5, y-10, 14, t) else if idx mod 2 then t = "O" else t = "X" end if text(x-5, y-10, 14, t) end if end if nextnextwaitkey(32)`

#### Galileo

• Jr. Member
• Posts: 53
##### Re: In a doNUT SHELL
« Reply #3 on: 04. May 2017, 20:43:17 »
Very well! Same for Yabasic.

Code: [Select]
`// In a doNUT SHELL.bas SmallBASIC 0.12.9 (B+=MGA) 2017-05-03// Adapted to Yabasic 2.78.0 by Galileo, 2017/05xmax = 800ymax = 800cx = xmax/2  // center screency = ymax/2open window xmax, ymax, "swiss14"backcolor 0,0,0clear windowth = peek("fontheight")*1.5 // text char heighttw = th/2 // text char widthsub midInk(r1, g1, b1, r2, g2, b2, fr)  color r1+(r2-r1)*fr, g1+(g2-g1)*fr, b1+(b2-b1)*frend subopen "DonutSHELL.yab" for reading as #1while(not eof(1))   line input #1 a\$  f\$=f\$+" "+a\$wendlenF = len(f\$)// lenF = 800  // don't want to get much more than 800 charstArea = tw * th * lenF / 1.95  // text area in pixels// had to divide by 2 for some reason then fudge// tArea = pi * (2/3 * r)^2// 9/4 * tArea/pi = r^2r = sqrt(9/4 * tArea/pi)// divide screen into character cells and see if in or out of donut// if in, print a character from this source code until run out // then send XO'sidx = 0for y = 0 to ymax step th  for x = 0 to xmax step tw    d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^.5    if r/3 < d and d < r then      idx = idx + 1      midInk(255, 255, 255, 80, 40, 20, abs(2/3*r - d)/(.335*r))      if idx < lenF then         text x, y, mid\$(f\$, idx, 1)       else       if mod(idx, 2) then      text x, y, "X"      else      text x, y, "O"      end if      end if    end if  next xnext y`

#### B+

• Sr. Member
• Posts: 458
##### Re: In a doNUT SHELL
« Reply #4 on: 04. May 2017, 22:31:37 »
Hi Galileo!

I have for a special treat for today! Update to SB code after cross pollinating with other dialects.

Code: [Select]
`' In a doNUT SHELL.bas SmallBASIC 0.12.9 (B+=MGA) 2017-05-04' translating to JB, I discovered an improvement!' now with candy sprinkles!const cx = xmax/2  const cy = ymax/2const tw = txtw("W") const th = txth("Q")def rand(lo, hi) = (rnd * (hi - lo + 1)) \ 1 + lo def rclr = rgb(rand(64, 255), rand(64, 255), rand(64, 255)) sub midInk(r1, g1, b1, r2, g2, b2, fr, tf)  if tf then    fc = rClr()  else    fc = rgb(r1+(r2-r1)*(1-fr), g1+(g2-g1)*(1-fr), b1+(b2-b1)*(1-fr))  fi   bc = rgb(r1+(r2-r1)*fr, g1+(g2-g1)*fr, b1+(b2-b1)*fr)  color fc, bcendopen "In a doNUT SHELL.bas" for input as #1while eof(1) = 0    input #1, fline    f = f + fline + ":"wendclose #1lenF = len(f)tArea = tw * th * lenF / 2  r = sqr(9/4 * tArea/pi)for y = 0 to ymax  for x = 0 to xmax    d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^.5    if r/3 < d +20 and d - 20< r then      midink(180, 90, 55, 80, 40, 20, 1 - abs(2/3*r - d)/(.335*r), 0)      pset x+5, y+10    fi  nextnextidx = 0for y = 0 to ymax step th  for x = 0 to xmax step tw    d = ((x - cx) ^ 2 + (y - cy) ^ 2) ^.5    if r/3 < d and d < r then      idx +=1      at x, y       midink(180, 90, 55, 80, 40, 20, abs(2/3*r - d)/(.335*r), 1)      if idx < lenF then         ? mid(f, idx, 1);       else         this = iff(idx mod 2, "X", "O") : ? this;      fi    fi  nextnextprintpause  `

#### Rick3137

• Full Member
• Posts: 110
##### Re: In a doNUT SHELL
« Reply #5 on: 05. May 2017, 16:58:23 »
Wow!

Nice effect. You could do ads for breakfast foods.
http://rb23.yolasite.com  Ricks Programs
http://rb27.synthasite.com   Sight and Sound

#### B+

• Sr. Member
• Posts: 458
##### Re: In a doNUT SHELL
« Reply #6 on: 05. May 2017, 17:09:57 »
Hi Rick,

What we really, (I mean: STRING("Really, ", 1000000)), need is code for a coffee machine.

I think Johnno56 would agree.

I think we aren't the only two coffee lovers who also code.

Wouldn't that be cool! ?

Imagine coming to this forum and getting free coffee and donuts! WOW

We wouldn't have to worry about police protection.