RetroBASIC
Basicprogramming(.org) => Code and examples => Topic started by: B+ on May 04, 2017, 03:47:32 AM
-
Hungry for some sweet code? ;D
' 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
-
Oh! This works very well in JB, in fact an improvement!
'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
-
Here is SdlBasic version:
' 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)
-
Very well! Same for Yabasic.
// 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
-
Hi Galileo!
I have for a special treat for today! Update to SB code after cross pollinating with other dialects.
' 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
-
Wow!
Nice effect. You could do ads for breakfast foods.
-
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.