In a doNUT SHELL

[B+]

Hungry for some sweet code? 

Code: [Select]

' In a doNUT SHELL.bas SmallBASIC 0.12.9 (B+=MGA) 2017-05-03

const cx = xmax/2  'center screen
const cy = ymax/2
const tw = txtw("W") 'text char width
const th = txth("Q") 'text char height

sub midInk(r1, g1, b1, r2, g2, b2, fr)
  color rgb(r1+(r2-r1)*fr, g1+(g2-g1)*fr, b1+(b2-b1)*fr)
end

tload("In a doNUT SHELL.bas", f, 1)
lenF = len(f)
'lenF = 800  'don't want to get much more than 800 chars

tArea = 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^2
r = 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's
idx = 0
for 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
  next
next
print
pause   


[B+]

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-04

global H$, XMAX, YMAX, pi
H$ = "#gr"
XMAX = 780
YMAX = 740
pi = acs(-1)
nomainwin

WindowWidth = XMAX + 8
WindowHeight = YMAX + 32
UpperLeftX = (1200 - XMAX) / 2
UpperLeftY = (700 - YMAX) / 2

open "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 screen
cy = YMAX/2
tw = 10
th = 20

open "In a doNUT SHELL.txt" for input as #1
while eof(#1) = 0
    input #1, fline$
    f$ = f$;fline$;":"
wend
close #1
lenF = len(f$)
'lenF = 800  'don't want to get much more than 800 chars

tArea = 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^2
r = 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's
idx = 0
for 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
  next
next
#gr "flush"
wait

sub 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 * percent
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
    #gr "place ";xPix;" ";yPix
    #gr "|";char$
end sub

sub quit H$
    close #H$
    end
end sub


[B+]

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 = 720
const ymax = 720
const cx = xmax/2  'center screen
const cy = ymax/2
const tw = 10
const th = 18
const 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 sub

open "donut.sdlbas" for input as #1
f = ""
while not eof(1)
    file input #1, fline
    f = f + fline + ":"
wend
close(1)

lenF = len(f)
'lenF = 800  'don't want to get much more than 800 chars

tArea = 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^2
r = sqr(9/4 * tArea/pi)

'back color the donut
for 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
next
next

'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's
idx = 0
for 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
next
next

waitkey(32)


[Galileo]

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/05

xmax = 800
ymax = 800

cx = xmax/2  // center screen
cy = ymax/2

open window xmax, ymax, "swiss14"
backcolor 0,0,0
clear window

th = peek("fontheight")*1.5 // text char height
tw = th/2 // text char width

sub midInk(r1, g1, b1, r2, g2, b2, fr)
  color r1+(r2-r1)*fr, g1+(g2-g1)*fr, b1+(b2-b1)*fr
end sub

open "DonutSHELL.yab" for reading as #1
while(not eof(1))
  line input #1 a$
  f$=f$+" "+a$
wend

lenF = len(f$)
// lenF = 800  // don't want to get much more than 800 chars

tArea = 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^2
r = 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's
idx = 0
for 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 x
next y


[B+]

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/2
const 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, bc
end
open "In a doNUT SHELL.bas" for input as #1
while eof(1) = 0
    input #1, fline
    f = f + fline + ":"
wend
close #1
lenF = 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
  next
next
idx = 0
for 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
  next
next
print
pause 

[Rick3137]

   Wow!
 
   Nice effect. You could do ads for breakfast foods.

[B+]

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.