S BASIC DEMO

[DrChip]

rem S BASIC demo
rem i was too lazy to spell smart
rem if you like to clean the code and
rem finish the logo. cool!
rem enjoy...
rem iPhone 6 Plus / iOS 8.3 b2

pi=3.1415
dim trix(4),triy(4)
sw=screen_width()
sh=screen_height()

gosub setup
gosub intro_text
gosub loop


intro_text:
graphics
do
refresh off
mm=mm+.01
red=100*sin(mm)
grn=100*sin(mm/2)
blu=100*sin(mm/3)
fill color red/255,grn/255,blu/255

'triangle
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
'triangle
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=sw
triy(2)=0
fill poly trix,triy count 3
rem red*2,grn*3,blu*2
gosub waitback
draw color 1,1,1
draw text "S B-A-S-I-C" at 5-5+rnd(5),5-2+rnd(4)
draw text "======================" at 5-5,220-2+rnd(4)
draw text "Coded by Dr. Chip" at 5-5,250-2+rnd(4)
draw text "PRESS TO START" at 5-5,290-2+rnd(4)
draw text "================" at 5-5,310-2+rnd(4)
fill color 1,2,1
draw LINE x1,y1 to x2,y2
fill CIRCLE x1,y1 size 5
fill CIRCLE x2,y2 size 5

draw LINE x3,y3 to x4,y4
fill CIRCLE x3,y3 size 5
fill CIRCLE x4,y4 size 5
refresh on
until touch_x(0)<> -1
return

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> SETUP VARIABLES AND ARRAYS >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
setup:
dx1=2
dx2=1
dy1=2
dy2=1
dx3=RND(2)+1
dx3=RND(2)+1
dy4=RND(2)+1
dy4=RND(2)+1
x1=RND(sw)
x2=RND(sw)
y1=RND(sh)
y2=RND(sh)

x3=RND(sw)
x4=RND(sw)
y3=RND(sh)
y4=RND(sh)
nstar=80 ' Number of stars to draw.
sncnt=5 ' Changes shape of snake.
bobs=70 ' Number of bits in snake.
dim aa(nstar+1) ' Star X co-ordinate storage.
dim ab(nstar+1) ' Star Y Co-ordinate storage.
dim ac(nstar+1) ' Star Z Co-ordinate storage.
mm=0.1 ' This variable is used throughout.
for i=1 to nstar
aa(i)=-25+rnd(50) ' Make X star positions.
ab(i)=-25+rnd(50) ' Make Y star positions.
ac(i)=mm ' Make Z position.
mm=mm+100/nstar ' Space stars evenly.
next i
size=8 ' size of cube
polys=8
dim x(polys+1)
dim y(polys+1)
dim z(polys+1)
dim tx(polys+1)
dim ty(polys+1)
dim tz(polys+1)

REM SIN/COS LOOK UP TABLES
dim cs(721)
dim sn(721)
for ang=0 to 720
cs(ang)=cos(ang*(pi/360))
sn(ang)=sin(ang*(pi/360))
next ang

for i = 1 to polys
read x(i),y(i),z(i)
next i

REM DATA FOR CUBE
data -10,10,10,10,10,10,10,-10,10,-10,-10,10
data -10,10,-10,10,10,-10,10,-10,-10,-10,-10,-10

dem=1 ' start with demo 1
timer=350 ' When timer = 0 demos change
REM SCROLL TEXT
s$=" "
s$=s$&"......The demo consists of a 3D starfield, a "
s$=s$&"zooming logo, two snake effects and a nice "
s$=s$&"3D cube. "

p=0
sxc=0
ox=sw/2 ' The X offset for the logo
oy=sh/2 ' The Y offset for the logo
poly=11 ' Amount of triangles in the logo
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> Define storage for logo data >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
dim lx(poly*3+1),ly(poly*3+1)
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> Define Storage for transformed logo data >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
dim lxt(poly*3+1),lyt(poly*3+1)
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> Read logo in from data statements >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
for i=1 to poly*3
read lx(i),ly(i)
next i
return

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> MAIN DEMO LOOP >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
loop:
graphics
do
refresh off
graphics clear 0,0,0
gosub n
gosub dispstars
gosub bk
gosub select
gosub scroller
refresh on
until 1=2
return

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> SWITCH BETWEEN DEMOS >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
select:
timer=timer-1
if timer=0 then
timer=350
dem=dem+1
end if
if timer=1 then
if dem=4 then
sncnt=sncnt+5
end if
end if
if dem>4 then dem=1
if dem=1 then
gosub drawlogo
end if
if dem=2 then
gosub snake1
end if
if dem=3 then
gosub rotate
gosub set
end if
if dem=4 then
gosub snake2
end if
return

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> EFFECTS IN EVERY DEMO >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

REM BACKGROUND COLORS
n:
ran_num=rnd(1000)
if ran_num<10 then
rad=250
gad=250
bad=250
end if
if rad>0 then
rad=rad-10
gad=gad-10
bad=bad-10
end if
if rad<0 then rad=0
if gad<0 then gad=0
if bad<0 then bad=0
red=100*sin(mm)
grn=100*sin(mm/2)
blu=100*sin(mm/3)
fill color (red+rad)/255,0,0
' 2,0,grn+gad,0
' 3,0,0,blu+bad
'gtriangle 0,0 to 640,512 to 0,512
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=0
triy(2)=sh
fill poly trix,triy count 3
'gtriangle 0,0 to 640,512 to 640,0
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=sh
trix(2)=sw
triy(2)=0
fill poly trix,triy count 3

return

REM FLASH FOR BETWEEN DEMOS
bk:
lad=lad-10
if lad<0 then lad=0
if timer=1 then
lad=100
end if
if lad=100 then
nx=1+rnd(sw)
nx2=1+rnd(sw)
end if
xx=nx
x2=nx2
if lad>60 then
fill color 1,1,1
for yi=-40 to sh step 20
fill rect 0,0 to sw,sh
xx=x2
x2=x2-40+rnd(80)
next yi
end if
return

REM STARFIELD
dispstars:
'#########################
'## Draws the starfield ##
'#########################
for i=1 to nstar
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> Perspective calculation and centre screen position >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
xx=((aa(i)*25)/ac(i)*25)+sw/2
yy=((ab(i)*25)/ac(i)*25)+sh/2
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> Colour and draw the star >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
fill color 0,0,120-ac(i)/255
fill rect xx-2,yy-2 to xx+6,yy+6
fill color 0,110-ac(i)/255,130-ac(i)/255
fill rect xx,yy to xx+4,yy+4
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> Move Star Reset And generate new point if needed >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
ac(i)=ac(i)-1
if ac(i)<0 then
aa(i)=-25+rnd(50)
ab(i)=-25+rnd(50)
ac(i)=ac(i)+100
end if
next i
return

REM SET UP SCROLL TEXT
scroller:
mm=mm+0.1
draw color 1,1,0
draw text mid$(s$,p,67) at scx,scy
if dem=3 then
scx=scx-0.5
scy=480+(25*sin(mm/2))
else
scx=scx-2
scy=480+(25*sin(mm))
end if
if scx<-10 then
scx=scx+10
p=p+1
if p>len(s$)-1 then p=0
end if
return

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> EFFECTS IN DEMO 1 >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
drawlogo:
'###########################
'## Draw the Zooming logo ##
'###########################
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> Set colour of logo according to size >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
siz=(6*sin(mm/2))+6
fill color 10/255,10/255,((10*siz)+100)/255

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> Scale the logo according to size and centralise it >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
for i=1 to poly*3
lxt(i)=(lx(i)*(siz/1.5))+ox
lyt(i)=(ly(i)*(siz/1.5))+oy
next i
'>>>>>>>>>>>>>>>>>>>
'>> Draw the logo >>
'>>>>>>>>>>>>>>>>>>>
for i=1 to poly*3 step 3
'Gtriangle lxt(i),lyt(i) to lxt(i+1),lyt(i+1) to lxt(i+2),lyt(i+2)
trix(0)=lxt(i)
triy(0)=lyt(i)
trix(1)=lxt(i+1)
triy(1)=lyt(i+1)
trix(2)=lxt(i+2)
triy(2)=lyt(i+2)
fill poly trix,triy count 3
next i
return



REM S
DATA -20,-20,-5,-25,-5,-20
DATA -20,-20,-5,-10,-3,-5
DATA -3,-12,-3,-8,-18,-5


REM B
DATA -25,10,-25,0,-18,5
DATA -25,20,-25,10,-18,15

REM A
DATA -15,9,-12, 20,-18,20

REM S
DATA -10,5,-5, 5,-5,10
DATA -10,5,-5,15,-3,15
DATA -10,15,-3,15,-10,20

REM I
DATA -1,5,-2,20,0,20

REM C
DATA 8,5,2,12,8,20


'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> EFFECTS IN DEMO 2 >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

REM SNAKE EFFECT
snake1:
if sncnt>15 then sncnt=5
l=200*sin(b/8)
m=200*cos(b/7)
for i = 1 to bobs
s=(sw/2)+l*sin((b+i)/sncnt)
t=(sh+m)*sin((b+i)/20)
fill color 0,0,55/255
fill rect s,t to s+40,t+40
fill color 75/255,55/255,1
fill rect s+4,t+4 to s+36,t+36
fill color 0,0,0
fill rect s+8,t+8 to s+32,t+32
next i
b=b+.5
return

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> EFFECTS IN DEMO 3 >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

REM SET UP FACES AND COLOURS
set:
r=0 ! g=0 ! b=200*sin(mm/6)
f1=1 ! f2=2 ! f3=3 ! f4=4
gosub draw

r=0 ! g=200*sin(mm/4) ! b=0
f1=5 ! f2=8 ! f3=7 ! f4=6
gosub draw

r=200*sin(mm/2) ! g=0 ! b=0
f1=6 ! f2=2 ! f3=1 ! f4=5
gosub draw

r=0 ! g=200*sin(mm/4) ! b=200*sin(mm/6)
f1=8 ! f2=4 ! f3=3 ! f4=7
gosub draw

r=200*sin(mm/2) ! g=200*sin(mm/4) ! b=0
f1=2 ! f2=6 ! f3=7 ! f4=3
gosub draw

r=200*sin(mm/2) ! g=200*sin(mm/4) ! b=200*sin(mm/6)
f1=8 ! f2=5 ! f3=1 ! f4=4
gosub draw
return

REM DRAW FACES
draw:
vx1=tx(f1)-tx(f2)
vy1=ty(f1)-ty(f2)
vx2=tx(f3)-tx(f2)
vy2=ty(f3)-ty(f2)

if (vx1*vy2-vx2*vy1)<0 then
fill color r+rad/255,g+gad/255,b+bad/255
'gtriangle tx(f1),ty(f1) to tx(f2),ty(f2) to tx(f3),ty(f3)
trix(0)=tx(f1)
triy(0)=ty(f1)
trix(1)=tx(f2)
triy(1)=ty(f2)
trix(2)=tx(f3)
triy(2)=ty(f3)
fill poly trix,triy count 3
'gtriangle tx(f1),ty(f1) to tx(f4),ty(f4) to tx(f3),ty(f3)
trix(0)=tx(f1)
triy(0)=ty(f1)
trix(1)=tx(f4)
triy(1)=ty(f4)
trix(2)=tx(f3)
triy(2)=ty(f3)
fill poly trix,triy count 3
end if
return

REM ROTATE CUBE
rotate:
for a = 1 to polys
x1=x(a)
y1=y(a)
z1=z(a)

xx=x1
yy=y1*cs(xr)+z1*sn(xr)
zz=z1*cs(xr)-y1*sn(xr)

y1=yy
x1=xx*cs(yr)-zz*sn(yr)
z1=xx*sn(yr)+zz*cs(yr)

zz=z1
xx=x1*cs(zr)-y1*sn(zr)
yy=x1*sn(zr)+y1*cs(zr)

xx=size*(xx/((zz/50)+1))+sw/2
yy=size*(yy/((zz/50)+1))+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
next a

xr=xr+3
yr=yr+2
zr=zr+5
if xr>720 then xr=xr-720
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
return

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>> EFFECTS IN DEMO 4 >>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

snake2:
if sncnt>15 then sncnt=5
l=200*sin(b/8)
m=200*cos(b/7)
for a = 1 to bobs
s=sw/2+l*sin((b+a)/20)
t=250+m*sin((b+a)/sncnt)
fill color 0,0,55/255
fill rect s,t to s+40,t+40
fill color 75/255,55/255,1
fill rect s+4,t+4 to s+36,t+36
fill color rnd(200)/255,rnd(200)/255,rnd(200)/255
fill rect s+8,t+8 to s+32,t+32
next a
b=b+.5
return

waitback:
IF x1 <0 OR x1 >sw THEN
dx1=-dx1
END IF
IF x2 <0 OR x2 >sw THEN
dx2=-dx2
END IF
IF y2 <0 OR y2 >sh THEN
dy2=-dy2
END IF
IF y1 <0 OR y1 >sh THEN
dy1=-dy1
END IF

IF x3 <0 OR x3 >sw THEN
dx3=-dx3
END IF
IF x4 <0 OR x4 >sw THEN
dx4=-dx4
END IF
IF y4 <0 OR y4 >sh THEN
dy4=-dy4
END IF
IF y3 <0 OR y3 >sh THEN
dy3=-dy3
END IF
'COLOR x1,y1,x2,y2
'COLOR 255,255,255
x1=x1+dx1
x2=x2+dx2
y1=y1+dy1
y2=y2+dy2

x3=x3+dx3
x4=x4+dx4
y3=y3+dy3
y4=y4+dy4
draw LINE x1,y1 to x2,y2
RETURN