Page 1 of 1

Cool Rings

Posted: Thu Feb 19, 2015 9:19 pm
by DrChip
REM Cool Rings v.1
REM I have some bugs im working out.
REM iPhone 6 plus / 8.3 b1

pi=3.1415
GOSUB setup

loop:
refresh off
graphics clear 0,0,0
GOSUB rotate
GOSUB stars
GOSUB drawcircle
GOSUB msg
refresh on
GOTO loop

rotate:
xr1=xr1+1
yr1=yr1+1
IF xr1>360 THEN
xr1=xr1-360
END IF
IF yr1>360 THEN
yr1=yr1-360
END IF

FOR b=1 TO 2
IF b=1 THEN
xr=xr1
END IF
IF b=2 THEN
xr=1
END IF
IF b=1 THEN
yr=1
END IF
IF b=2 THEN
yr=yr1
END IF

FOR a=0 TO pts
x1=x(a,b)
y1=y(a,b)
z1=z(a,b)
xx1=x1
yy1=y1*cosi(xr)+z1*sine(xr)
zz1=z1*cosi(xr)-y1*sine(xr)
y1=yy1
x1=xx1*cosi(yr)-zz1*sine(yr)
z1=xx1*sine(yr)+zz1*cosi(yr)
zz1=z1
xx1=x1*cosi(zr)-y1*sine(zr)
yy1=x1*sine(zr)+y1*cosi(zr)

dx(a,b)=xx1
dy(a,b)=yy1
dz(a,b)=zz1
xx(a,b)=dx(a,b)/((dz(a,b)/focus)+1)+sw/2
yy(a,b)=dy(a,b)/((dz(a,b)/focus)+1)+sh/2
NEXT a
NEXT b
RETURN

stars:
FOR a=0 TO s
sxx(a)=sx(a)/((sz(a)/focus))+sw/2
syy(a)=sy(a)/((sz(a)/focus))+sh/2
col=((500-sz(a))/4)
fill COLOR col/255,col/255,col/255
fill RECT sxx(a),syy(a) to sxx(a)+3,syy(a)+3
sz(a)=sz(a)-15
IF sz(a)<-500 THEN
sz(a)=500
END IF
NEXT a
RETURN

drawcircle:
FOR b=0 TO 1
'new curve
FOR a=0 TO pts-1
c=(dz(a,b)+size)
IF b=1 THEN
draw COLOR 8*c/255,4*c/255,1.3*c/255
END IF
IF b=2 THEN
draw COLOR 6*c/255,1.2*c/255,1.4*c/255
END IF

draw LINE xx(a,b),yy(a,b) to xx(a+1,b),yy(a+1,b)

NEXT a
draw LINE xx(a,b),yy(a,b) to xx(1,b),yy(1,b)
NEXT b
RETURN

msg:
mc=mc-1
IF mc<20 THEN
mc= 200
m = m+1
END IF

IF m>(dp-1) THEN
m=1
END IF

draw COLOR 4*mc/255,95*mc/255,1.50*mc/255
lx=LEN(m$(m))
DRAW TEXT m$(m) at (sw/2)-lx*5,75
RETURN

setup:
graphics
sw=Screen_Width()
sh=Screen_Height()
pi=3.1415
mc=200
pts=24
focus=500
size=100
s=30
m=1
xr=1
yr=2
zr=3
READ dp
DIM sx(s+1),sy(s+1),sz(s+1),sxx(s+1),syy(s+1)
DIM x(pts+2,3),y(pts+2,3),z(pts+2,3),xx(pts+2,3),yy(pts+2,3)
DIM dx(pts+1,3),dy(pts+1,3),dz(pts+1,3),ang(pts+1,3)
DIM sine(362),cosi(362)
DIM m$(dp+1)

FOR a=0 TO s
sx(a)=-sw/2+RND(sw)
sy(a)=-sh/2+RND(sh)
sz(a)=-500+INT(RND(1000))
NEXT a

FOR a=0 TO dp-1
READ m$(a)
NEXT a

FOR a=0 TO 360
cosi(a)=COS(a*(PI/180))
sine(a)=SIN(a*(PI/180))
NEXT a

FOR b=0 TO 1
FOR a=0 TO pts
ang(a,b)=(360/pts)*a
x(a,b)=(COS(ang(a,b)*(PI/180))*size)
y(a,b)=(SIN(ang(a,b)*(PI/180))*size)
NEXT a
NEXT b
RETURN

DATA 6,"WELCOME","THIS IS"
DATA "COOL RINGS","BY DIGIT"
DATA "DO YOU LIKE THE SPINNING RINGS?"
DATA "I THINK THEY ARE COOL"

Re: Cool Rings

Posted: Thu Feb 19, 2015 9:39 pm
by DrChip
Oops, my fault!

Replace:
drawcircle:
FOR b=0 TO 1

With:
drawcircle:
FOR b=1 TO 2

Re: Cool Rings

Posted: Thu Feb 19, 2015 11:18 pm
by DrChip
REM Cool Rings v.1
REM I have some bugs im working out.
REM iPhone 6 plus / 8.3 b1

GOSUB setup

loop:
refresh off
graphics clear 0,0,0
GOSUB rotate
GOSUB stars
GOSUB drawcircle
GOSUB msg
refresh on
GOTO loop

rotate:
xr1=xr1+1
yr1=yr1+1
IF xr1>360 THEN
xr1=xr1-360
END IF
IF yr1>360 THEN
yr1=yr1-360
END IF

FOR b=1 TO 2
IF b=1 THEN
xr=xr1
END IF
IF b=2 THEN
xr=1
END IF
IF b=1 THEN
yr=1
END IF
IF b=2 THEN
yr=yr1
END IF

FOR a=0 TO pts
x1=x(a,b)
y1=y(a,b)
z1=z(a,b)
xx1=x1
yy1=y1*cosi(xr)+z1*sine(xr)
zz1=z1*cosi(xr)-y1*sine(xr)
y1=yy1
x1=xx1*cosi(yr)-zz1*sine(yr)
z1=xx1*sine(yr)+zz1*cosi(yr)
zz1=z1
xx1=x1*cosi(zr)-y1*sine(zr)
yy1=x1*sine(zr)+y1*cosi(zr)

dx(a,b)=xx1
dy(a,b)=yy1
dz(a,b)=zz1
xx(a,b)=dx(a,b)/((dz(a,b)/focus)+1)+sw/2
yy(a,b)=dy(a,b)/((dz(a,b)/focus)+1)+sh/2
NEXT a
NEXT b
RETURN

stars:
FOR a=0 TO s
sxx(a)=sx(a)/((sz(a)/focus))+sw/2
syy(a)=sy(a)/((sz(a)/focus))+sh/2
col=((500-sz(a))/4)
fill COLOR col/255,col/255,col/255
fill RECT sxx(a),syy(a) to sxx(a)+3,syy(a)+3
sz(a)=sz(a)-15
IF sz(a)<-500 THEN
sz(a)=500
END IF
NEXT a
RETURN

drawcircle:
FOR b=1 TO 2
'new curve
FOR a=1 TO pts-1
c=(dz(a,b)+size)
IF b=1 THEN
draw COLOR 8*c/255,4*c/255,1.3*c/255
end if
IF b=2 THEN
draw COLOR 6*c/255,1.2*c/255,1.4*c/255
end if
draw LINE xx(a,b),yy(a,b) to xx(a+1,b),yy(a+1,b)
NEXT a
draw LINE xx(a,b),yy(a,b) to xx(1,b),yy(1,b)
NEXT b
RETURN

msg:
mc=mc-1
IF mc<20 THEN
mc= 200
m = m+1
END IF

IF m>(dp-1) THEN
m=1
END IF

draw COLOR 4*mc/255,95*mc/255,1.50*mc/255
lx=LEN(m$(m))
DRAW TEXT m$(m) at (sw/2)-lx*5,75
RETURN

setup:
graphics
sw=Screen_Width()
sh=Screen_Height()
pi=3.1415
mc=200
pts=24
focus=500
size=100
s=30
m=1
xr=1
yr=2
zr=3
READ dp
DIM sx(s+1),sy(s+1),sz(s+1),sxx(s+1),syy(s+1)
DIM x(pts+2,3),y(pts+2,3),z(pts+2,3),xx(pts+2,3),yy(pts+2,3)
DIM dx(pts+1,3),dy(pts+1,3),dz(pts+1,3),ang(pts+1,3)
DIM sine(362),cosi(362)
DIM m$(dp+1)

FOR a=0 TO s
sx(a)=-sw/2+RND(sw)
sy(a)=-sh/2+RND(sh)
sz(a)=-500+INT(RND(1000))
NEXT a

FOR a=0 TO dp-1
READ m$(a)
NEXT a

FOR a=0 TO 360
cosi(a)=COS(a*(PI/180))
sine(a)=SIN(a*(PI/180))
NEXT a

FOR b=1 TO 2
FOR a=0 TO pts
ang(a,b)=(360/pts)*a
x(a,b)=(COS(ang(a,b)*(PI/180))*size)
y(a,b)=(SIN(ang(a,b)*(PI/180))*size)
NEXT a
NEXT b
RETURN

DATA 6,"WELCOME","THIS IS"
DATA "COOL RINGS","BY DIGIT"
DATA "DO YOU LIKE THE SPINNING RINGS?"
DATA "I THINK THEY ARE COOL"

Re: Cool Rings

Posted: Sat Feb 21, 2015 10:15 am
by dE.niz
exellent nice, really cool.

dE.niz