Graphic effects

[Galileo]

I love computer generated graphic effects. Usually people get them using special programs, but they can also be achieved with imagination and a simple BASIC interpreter.

Code: [Select]

// Effect 1
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 480
sizeletter = 300 : t$ = "B"

open window width,height
backcolor 0,0,0
clear window
color 1,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"

for y = 0 to height step 5
for x = 0 to width step 5
cpixel$ = getbit$(x,y,x,y)
if cpixel$ = "rgb 1,1:010000" then
cx = x + (2 - int(ran(5))) : cy = y + (2 - int(ran(5)))
cb = 255
for n = 5 to 1 step -1
color cb,cb,cb
circle cx,cy,n
cb = cb / 2
next n
end if
next x
next y


[Galileo]

Another simple sample:

Code: [Select]

// Effect 2
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 480
sizeletter = 300 : t$ = "B"

open window width,height
backcolor 0,0,0
clear window
color 1,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"


for y = 0 to height step 15
for x = 1 to width
cpixel$ = getbit$(x,y,x,y)
if cpixel$ = "rgb 1,1:010000" then
color 255,0,0
dot x,y
else
color 255,255,255
dot x,y
end if
next x
next y


[Galileo]

And, with little change ...

Code: [Select]

// Effect 3
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 480
sizeletter = 300 : t$ = "B"

open window width,height
backcolor 0,0,0
clear window
color 1,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"

color 255,255,255

for y = 0 to height step 15
for x = 1 to width
cpixel$ = getbit$(x,y,x,y)
if cpixel$ = "rgb 1,1:010000" then
dot x,y-5
else
dot x,y
end if
next x
next y


[Galileo]

Code: [Select]

// Effect 4
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 480
ndrops = 500
sizeletter = 300 : t$ = "B"

DIM drop(ndrops, 3)

dcount = 0
for n = 1 to ndrops
newDrop(n)
next n

open window width,height
backcolor 0,0,0
clear window
color 1,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"

color 255,255,255

do
for n = 1 to ndrops
x = drop(n,1) : y = drop(n,2)
if drop(n,2) > height+2 newDrop(n)
cpixel$ = getbit$(x,y+2,x,y+2)
if cpixel$ <> "rgb 1,1:010000" then
clear fill circle drop(n,1),drop(n,2), 1
end if
drop(n,2) = drop(n,2) + drop(n,3)
fill circle drop(n,1),drop(n,2), 1
next n
loop


sub newDrop(n)
drop(n, 1) = ran(width)
drop(n, 2) = -ran(height)
drop(n, 3) = ran(4)+.5
end sub

[Galileo]

Code: [Select]

// Effect 5
// Developed in Yabasic 2.78.0 by Galileo, 3/2017
// Play with parameters

width = 250 : height = 250
sizeletter = 200 : t$ = "B"

open window width,height
backcolor 255,255,255
clear window
color 0,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"

dim p(width+1, height+1)

for x = 0 to width
for y = 0 to height
if getbit$(x,y,x,y) = "rgb 1,1:000000" then
p(x,y) = 0
else
p(x,y) = 255
end if
next y
next x

do
for x = 1 to width-1
for y = 1 to height-1
c = 0
c = c + p(x-1,y-1)
c = c + p(x,y-1)
c = c + p(x+1,y-1)
c = c + p(x-1,y)
c = c + p(x,y)
c = c + p(x+1,y)
c = c + p(x-1,y+1)
c = c + p(x,y+1)
c = c + p(x+1,y+1)
c = c/9
p(x,y)=c
color c,c,c
dot x,y
next y
next x
loop


[Galileo]

Code: [Select]

// Effect 7
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 512
sizeletter = 400 : t$ = "S"

open window width,height
backcolor 0,0,0
clear window
color 1,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"

dim p(width, height)

for x = 0 to width
for y = 0 to height
if (getbit$(x,y,x,y) = "rgb 1,1:010000") p(x,y) = 255
next y
next x

text 0,0,"","swiss12"

mx=50
my=42
dim scr(mx,my)
for y=0 to my
for x=0 to mx
scr(x,y)=int(ran(96)+33)
next x
next y
ms=75
dim sx(ms)
dim sy(ms)
for a=1 to ms
sx(a)=int(ran(mx))
sy(a)=int(ran(my))
next a

do
for s=1 to ms
x=sx(s)
y=sy(s)

letter(0,255,0)
y=y-1

letter(0,128,0)
y=y-1

letter(0,50,0)
y=y-24

color 0,0,0
fill rect x*12.8-1,y*12.8+4 to x*12.8+12,y*12.8-10
next s
for s=1 to ms
if int(ran(5)+1)=1 sy(s)=sy(s)+1
if sy(s)>my+25 then
sy(s)=0
sx(s)=int(ran(mx))
end if
next s
loop

sub letter(r,g,b)
local c,d

if y<0 or y>my return
c=scr(x,y)
d = p(x*12,y*12)
if d then
color d,d,d
else
color r,g,b
end if
text x*12.8,y*12.8,chr$(c)
end sub

[Galileo]

Code: [Select]

// Effect 8
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 480
sizeletter = 300 : t$ = "B"

open window width,height
backcolor 0,0,0
clear window
color 1,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"

do
color ran(255),ran(255),ran(255)
for y = 0 to height step 10
for x = 0 to width step 10
cpixel$ = getbit$(x,y,x,y)
if cpixel$ = "rgb 1,1:010000" then
text x,y,chr$(ran(32)+32),"swiss10"
end if
next x
next y
loop


[Galileo]

Code: [Select]

// Effect 10
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters
// Taking advantage of code get from the snowflakes program in SpecBAS

SCRw = 640 : SCRh = 480
sizeletter = 300 : t$ = "B"

OPEN WINDOW SCRw, SCRh
flakes=500
DEG = 0.0174532925
DIM a(flakes,2)
DIM w(flakes,2)
DIM p(flakes,7)
DIM s(SCRw, SCRh)

FOR f=1 TO flakes
genera()
p(f,2)=-RAN(SCRh)
NEXT f
BACKCOLOR 0,0,0
clear window

color 1,0,0
text SCRw/2,SCRh/2,t$,"swiss"+str$(sizeletter),"cc"
for x = 0 to SCRw
for y = 0 to SCRh
cpixel$ = getbit$(x,y,x,y)
if cpixel$ = "rgb 1,1:010000" then
s(x, y) = 1
end if
next y
next x

COLOR 255,255,255

do
FOR f=1 TO flakes
x = p(f,1) : y = p(f,2)
ink = p(f,6)
color ink,ink,ink
if (x > -1) and (y > -1) and (x <= SCRw) and (y <= SCRh) and not(s(x,y)) eraseSF()
p(f,2) = p(f,2) + p(f,3)
IF p(f,2)>SCRh genera()
a3=SIN(DEG * ((p(f,2)+p(f,5))/(w(f,2)/SCRh)))
p(f,1)=a3*a(f,1)*SIN(DEG * ((p(f,2)+p(f,5))/(w(f,1)/SCRw)))+p(f,4)
drawSF()
NEXT f
loop

REM New flake - call with f for the index
sub genera()
a(f,1)=(10+RAN(700))*(RAN(2)-1)
w(f,1)=3200+RAN(300)
a(f,2)=10+RAN(100)
w(f,2)=3200+RAN(300)
p(f,4)=RAN(SCRw+200)-100
p(f,2)=0
p(f,3)=.5+RAN(2)
p(f,1)=p(f,4)
p(f,5)=RAN(SCRh)
p(f,6)=RAN(16)+(255-16)
p(f,7)=INT(RAN(3))
end sub


sub eraseSF()
IF p(f,7)=1 THEN
clear DOT p(f,1),p(f,2)
ELSE
clear FILL CIRCLE p(f,1),p(f,2),p(f,7)
END IF
end sub


sub drawSF()
IF p(f,7)=1 THEN
DOT p(f,1),p(f,2)
ELSE
FILL CIRCLE p(f,1),p(f,2),p(f,7)
END IF
end sub

[Galileo]

Variation of the previous one.

Code: [Select]

// Effect 10B
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters
// Taking advantage of code get from the eponymous program in SpecBAS

SCRw = 640 : SCRh = 480
sizeletter = 300 : t$ = "U"

OPEN WINDOW SCRw, SCRh
flakes=500
DEG = 0.0174532925
DIM a(flakes,2)
DIM w(flakes,2)
DIM p(flakes,7)
DIM s(SCRw, SCRh)

print "Please, wait ..."

FOR f=1 TO flakes
genera()
p(f,2)=-RAN(SCRh)
NEXT f
BACKCOLOR 0,0,0
clear window

color 1,0,0
text SCRw/2,SCRh/2,t$,"swiss"+str$(sizeletter),"cc"
for x = 0 to SCRw
for y = 0 to SCRh
cpixel$ = getbit$(x,y,x,y)
if cpixel$ = "rgb 1,1:010000" then
s(x, y) = 1
end if
next y
next x

COLOR 255,255,255

clear screen

do
FOR f=1 TO flakes
x = p(f,1) : y = p(f,2)
ink = p(f,6)
color ink,ink,ink
if (x > -1) and (y > -1) and (x < SCRw+1) and (y <= SCRh) and not(s(x,y)) then
eraseSF()
else
genera()
end if
p(f,2) = p(f,2) + p(f,3)
IF p(f,2)>SCRh genera()
a3=SIN(DEG * ((p(f,2)+p(f,5))/(w(f,2)/SCRh)))
p(f,1)=a3*a(f,1)*SIN(DEG * ((p(f,2)+p(f,5))/(w(f,1)/SCRw)))+p(f,4)
drawSF()
NEXT f
loop

REM New flake - call with f for the index
sub genera()
a(f,1)=(10+RAN(700))*(RAN(2)-1)
w(f,1)=3200+RAN(300)
a(f,2)=10+RAN(100)
w(f,2)=3200+RAN(300)
p(f,4)=RAN(SCRw+200)-100
p(f,2)=0
p(f,3)=.5+RAN(2)
p(f,1)=p(f,4)
p(f,5)=RAN(SCRh)
p(f,6)=RAN(16)+(255-16)
p(f,7)=INT(RAN(3))
end sub


sub eraseSF()
IF p(f,7)=1 THEN
clear DOT p(f,1),p(f,2)
ELSE
clear FILL CIRCLE p(f,1),p(f,2),p(f,7)
END IF
end sub


sub drawSF()
IF p(f,7)=1 THEN
DOT p(f,1),p(f,2)
ELSE
FILL CIRCLE p(f,1),p(f,2),p(f,7)
END IF
end sub

[Galileo]

Code: [Select]

REM *** Original code by Xalthorn ***
REM Modified and adapted for Yabasic 2.768 by Galileo, 4/2015
REM Little addition for letter effect, 2/2017

gosub initialise
gosub main
exit

label main
 do
  backcolor fl,fl,fl
  pause 0
  clear window

  if fl > 0 then
  fl = max(0, fl - 10)
  text w/2,h/2,"B","swiss300","cc"
  end if
  if fl = 0 and int(ran(100)) = 1 fl = int(ran(100) + 155)

  gosub drawrain
  gosub drawsplashes
 loop
return

label drawsplashes
 for a = 1 to numsplash
  if splashy(a) <= h then
   color 200, 200, 200
   x = splashx(a) : y = splashy(a)
   fill circle x, y, 1

   splashy(a) = splashy(a) + splashyv(a)
   splashx(a) = splashx(a) + splashxv(a)

   splashyv(a) = splashyv(a) + 0.4
  end if
 next a
return

label addsplash
 found = 0 : b = 0
 repeat
  b = b + 1
  if splashy(b) > h found = 1
 until(found = 1 or b = numsplash)

 if found <> 0 then
splashy(b) = 510
splashyv(b) = -int(ran(4) + 3)
splashx(b) = x
 end if
return

label drawrain
 for a = 1 to numrain
  x = rainx(a) : y = rainy(a)
  s = rains(a)
  b1 = br1(s) : b2 = br2(s) : b3 = br3(s)
  s1 = s1(s)  : s2 = s2(s)  : s3 = s3(s)
  color b1, b1, b1 : line x, y - s1 to x, y + s1
  color b2, b2, b2 : line x, y - s2 to x, y + s2
  color b3, b3, b3 : line x, y - s3 to x, y + s3
  y = y + 6 * rains(a)
  if y >= 540 then
  rainx(a) = int(ran(640))
  y = -50
  gosub addsplash
  gosub addsplash
  end if
  rainy(a) = y
 next a
return

label initialise
 w = 640 : h = 512
 open window w, h

 dim co(360), si(360)
 for a = 0 to 360
  co(a) = cos(a * (pi / 180))
  si(a) = sin(a * (pi / 180))
 next a

 numrain = 50
 dim rainx(numrain), rainy(numrain), rains(numrain)
 for a = 1 to numrain
  rainx(a) = int(ran(w))
  rainy(a) = int(ran(h))
  rains(a) = mod(a, 3) + 2
 next a

 numsplash = 40
 dim splashx(numsplash), splashy(numsplash)
 dim splashxv(numsplash), splashyv(numsplash)
 for a = 1 to numsplash
  splashxv(a) = int(ran(6)) - 3
  splashy(a) = 520
 next a

 dim br1(4), br2(4), br3(4), s1(4), s2(4), s3(4)
 for a = 1 to 4
  br1(a) = a * 25
  br2(a) = a * 30
  br3(a) = a * 50
  s1(a) = a * 10
  s2(a) = a * 8
  s3(a) = a * 5
 next a

return


[Galileo]

Code: [Select]

//fire demo for smallbasic adapted to Yabasic 2.78.0 by Galileo 2/2017

print "Wait, please ..."

xmax=640:ymax=480

open window xmax,ymax
dim s(xmax, ymax)
BACKCOLOR 0,0,0
clear window

color 1,0,0
text xmax/2,ymax/2,"B","swiss300","cc"
for x = 0 to xmax
for y = 0 to ymax
if getbit$(x,y,x,y) = "rgb 1,1:010000" s(x, y) = 1
next y
next x

window origin "lt"

dim f(41,41)//fire
dim r(9999)//random table

//make random table
for i=0 to 9999
r(i)=int(ran(2240)-1000)
next i

a=xmax*1.03/41
b=ymax*1.08/41
n=340

//main loop
do
//scroll xpos message
n=mod((n+1), 800)

for i=1 to 40
x=i*a-a
s=1-s
s1=mod((i+n),400)
s2=mod((i+n+1),400)

//random fire seeds
f(i,41)=r(m)
m=mod((m+1),10000)

for j=40 to 0 step -1
//make fire
c=f(i-1,j)+f(i,j+1)+f(i+1,j+1)
c=abs(mod(c/3-1,255))
f(i,j)=c
if s(x+(a+1)/2,min(ymax,j*b+(b+2)/2)) then
color c+5,0,0
else
color c,0,0
end if
//draw rectangle with mixed palette
fill rectangle x,j*b, x+a+1,j*b+b+2
next j
next i
loop


[Galileo]

Code: [Select]

// Effect 3b
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 480
sizeletter = 300 : t$ = "B"

open window width,height
backcolor 0,0,0
clear window
color 1,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"

inix = width/2-sizeletter/2 : finx = inix+sizeletter
iniy = height/2-sizeletter/2 : finy = iniy+sizeletter

for x = inix to finx step 5
for y = iniy to finy step 5
col = int(ran(128))+64
cpixel$ = getbit$(x,y,x,y)
if cpixel$ = "rgb 1,1:010000" then
color col,col,col
fill box x,y to x+5,y+5
end if
next y
next x


[Galileo]

Code: [Select]

// Effect 13
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 480
sizeletter = 300 : t$ = "B"

open window width,height
backcolor 0,0,0
clear window
color 1,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"

inix = width/2-sizeletter/2 : finx = inix+sizeletter
iniy = height/2-sizeletter/2 : finy = iniy+sizeletter

for x = inix to finx
if not cw then col = int(ran(2)) : cw = int(ran(3))+2 : end if
if col then color 255,255,255 else color 0,0,0 end if
for y = iniy to finy
cpixel$ = getbit$(x,y,x,y)
if cpixel$ = "rgb 1,1:010000" then
dot x,y
end if
next y
cw = cw - 1
next x

[Galileo]

Code: [Select]

// Effect 14
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 480
sizeletter = 300 : t$ = "B"

open window width,height
clear window

scol = 255/height
col = 0

for y = height to 0 step -1
color col,col,col
line 0,y to width,y
col = col + scol
next y

color 100,100,100
text width/2+5,height/2+5,t$,"swiss"+str$(sizeletter),"cc"

color 1,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"

inix = width/2-sizeletter/2 : finx = inix+sizeletter
iniy = height/2-sizeletter/2 : finy = iniy+sizeletter

scol = 255/(finy-iniy)
col = 255

for y = iniy to finy
color col,col,col
for x = inix to finx
cpixel$ = getbit$(x,y,x,y)
if cpixel$ = "rgb 1,1:010000" then
dot x,y
end if
next x
col = col - scol
next y

[Galileo]

Code: [Select]

// Effect 5b
// Developed in Yabasic 2.78.0 by Galileo, 2/2017
// Play with parameters

width = 640 : height = 480
ndrops = 500
sizeletter = 300 : t$ = "B"

dim drop(ndrops, 6)
dim bg(width, height)

dcount = 0
for n = 1 to ndrops
newDrop(n)
next n

open window width,height
backcolor 255,255,255
clear window
color 1,0,0
text 10,15,"Please, wait ...","swiss12"
color 0,0,0
text width/2,height/2,t$,"swiss"+str$(sizeletter),"cc"
for x = 1 to width
for y = 1 to height
if getbit$(x,y,x,y) = "rgb 1,1:000000" bg(x, y) = 1
next y
next x
clear window

do
for n = 1 to ndrops
x = drop(n,1) : y = drop(n,2)
if drop(n,2) > height+3 newDrop(n)
clear fill circle drop(n,1),drop(n,2), 3
if (x > -1) and (x < width + 1) and (y > -1) and (y < height + 1) and bg(x, y) then
if drop(n,3)> .01 then
drop(n,3)=drop(n,3)-.01
else
drop(n,3)=0
end if
end if
drop(n,2) = drop(n,2) + drop(n,3)
color drop(n,4),drop(n,5),drop(n,6)
fill circle drop(n,1),drop(n,2), 3
next n
loop


sub newDrop(n)
drop(n, 1) = ran(width)
drop(n, 2) = -ran(height)
drop(n, 3) = ran(3)+.5
drop(n, 4) = ran(255)
drop(n, 5) = ran(255)
drop(n, 6) = ran(255)
end sub