Code: Select all
REM morphing dot demo
REM sB 6.0 / ioS 10.1 beta 3 / iPhone 6+
REM enjoy...
GOSUB initialize
main_loop:
REFRESH OFF
GRAPHICS CLEAR 0,0,0
GOSUB process_input
GOSUB draw_stars
GOSUB display_name
GOSUB display_scroller
GOSUB morph
GOSUB rotchange
GOSUB cycle_color
REFRESH
GOTO main_loop
display_scroller:
DRAW COLOR 1,1,1
mx=mx-2
IF mx<=0 THEN
mx=mx+10
mpos=mpos+1
IF mpos>LEN(m$)-1 THEN
mpos=0
END IF
END IF
DRAW TEXT MID$(m$,mpos,64) AT mx,sh-20
FILL COLOR 0,0,0
FILL RECT 0,490 TO 10,512
RETURN
display_name:
IF textlife<=0 THEN RETURN
textlife=textlife-5
DRAW COLOR textlife/255,textlife/255,textlife/255
DRAW TEXT NAME$ AT 0,20
RETURN
cycle_color:
IF red=tred AND green=tgreen AND blue=tblue THEN
tred=INT(RND(100))/100
tblue=INT(RND(100))/100
tgreen=INT(RND(100))/100
RETURN
END IF
IF red<tred THEN
red=red+0.01
IF red>tred THEN
red=tred
END IF
END IF
IF red>tred THEN
red=red-0.01
IF red<tred THEN
red=tred
END IF
END IF
IF green<tgreen THEN
green=green+0.01
IF green>tgreen THEN
green=tgreen
END IF
END IF
IF green>tgreen THEN
green=green-0.01
IF green<tgreen THEN
green=tgreen
END IF
END IF
IF blue<tblue THEN
blue=blue+0.01
IF blue>tblue THEN
blue=tblue
END IF
END IF
IF blue>tblue THEN
blue=blue-0.01
IF blue<tblue THEN
blue=tblue
END IF
END IF
RETURN
rotchange:
xrot=xrot+xroto
IF xrot<0 THEN xrot=xrot+360
IF xrot>360 THEN xrot=xrot-360
yrot=yrot+yroto
IF yrot<0 THEN yrot=yrot+360
IF yrot>360 THEN yrot=yrot-360
zrot=zrot+zroto
IF zrot<0 THEN zrot=zrot+360
IF zrot>360 THEN zrot=zrot-360
RETURN
process_input:
IF BUTTON_PRESSED("press") THEN
xroto=0!yroto=0!zroto=0
END IF
IF BUTTON_PRESSED("up") THEN
yroto=yroto-1
END IF
IF BUTTON_PRESSED("down") THEN
yroto=yroto+1
END IF
IF BUTTON_PRESSED("left") THEN
xroto=xroto-1
END IF
IF BUTTON_PRESSED("right") THEN
xroto=xroto+1
END IF
IF BUTTON_PRESSED("in") AND zroto>-offmax THEN
zroto=zroto-1
END IF
IF BUTTON_PRESSED("out") AND zroto<offmax THEN
zroto=zroto+1
END IF
RETURN
draw_stars:
focus=2000
FOR star=1 TO numstars
x=starx(star)
y=stary(star)
z=starz(star)
REM x rotation
xx=x
yy=y*cosines(xrot)+z*sines(xrot)
zz=z*cosines(xrot)-y*sines(xrot)
REM y rotation
x=xx*cosines(yrot)-zz*sines(yrot)
y=yy
z=xx*sines(yrot)+zz*cosines(yrot)
REM z rotation
xx=x*cosines(zrot)-y*sines(zrot)
yy=x*sines(zrot)+y*cosines(zrot)
zz=z
REM perspective transformation
xx=xx/((zz/focus)+1)
yy=yy/((zz/focus)+1)
brightnesss=128-(zz/2)
sizes=brightnesss/20
FILL COLOR red*brightnesss/255,green*brightnesss/255,blue*brightnesss/255
FILL RECT ox+xx,oy+yy TO ox+xx+sizes,oy+yy+sizes
NEXT star
RETURN
setup_shapes:
DIM shapes(numshapes+1,numstars+1,4)
DIM shapename$(numshapes+1)
shapename$(1)="Pyramids"
FOR a=1 TO 20
shapes(1,a,1)=(a*10)-100
shapes(1,a,2)=-100
shapes(1,a,3)=-100
shapes(1,a+20,1)=(a*5)-100
shapes(1,a+20,2)=-100
shapes(1,a+20,3)=(a*10)-100
shapes(1,a+40,1)=(a*5)
shapes(1,a+40,2)=-100
shapes(1,a+40,3)=((10-a)*10)
shapes(1,a+60,1)=(a*5)-100
shapes(1,a+60,2)=(a*10)-100
shapes(1,a+60,3)=(a*5)-100
shapes(1,a+80,1)=(a*5)
shapes(1,a+80,2)=((10-a)*10)
shapes(1,a+80,3)=((10-a)*5)-50
shapes(1,a+100,1)=0
shapes(1,a+100,2)=((10-a)*10)
shapes(1,a+100,3)=(a*5)
NEXT a
FOR a=1 TO 5
shapes(1,a+120,1)=(a*10)-25
shapes(1,a+120,2)=-25
shapes(1,a+120,3)=-25
shapes(1,a+125,1)=(a*5)-25
shapes(1,a+125,2)=-25
shapes(1,a+125,3)=(a*10)-25
shapes(1,a+130,1)=(a*5)
shapes(1,a+130,2)=-25
shapes(1,a+130,3)=((6-a)*10)-25
shapes(1,a+135,1)=(a*5)-25
shapes(1,a+135,2)=(a*10)-25
shapes(1,a+135,3)=(a*5)-25
shapes(1,a+140,1)=(a*5)
shapes(1,a+140,2)=((6-a)*10)-25
shapes(1,a+140,3)=((6-a)*5)-25
shapes(1,a+145,1)=0
shapes(1,a+145,2)=((6-a)*10)-25
shapes(1,a+145,3)=(a*5)
NEXT a
shapename$(2)="Coiled spring"
FOR a=1 TO numstars
shapes(2,a,1)=INT(SIN((a*14)*(pi/180))*200)
shapes(2,a,2)=INT(COS((a*14)*(pi/180))*200)
shapes(2,a,3)=INT(COS((a)*(pi/180))*200)
NEXT a
shapename$(3)="Bendy strip"
FOR a=1 TO numstars
shapes(3,a,1)=INT(SIN((a)*(pi/180))*SIN((a)*(pi/180))*200)
shapes(3,a,2)=INT(SIN((a)*(pi/180))*COS((a)*(pi/180))*200)
shapes(3,a,3)=INT(COS((a)*(pi/180))*200)
NEXT a
shapename$(4)="Bent infinity"
FOR a=1 TO numstars
shapes(4,a,1)=INT(SIN((a*2.5)*(pi/180))*SIN((a*2.5)*(pi/180))*200)
shapes(4,a,2)=INT(SIN((a*2.5)*(pi/180))*COS((a*2.5)*(pi/180))*200)
shapes(4,a,3)=INT(COS((a*2.5)*(pi/180))*200)
NEXT a
shapename$(5)="Ring sphere"
long=0
latt=0
FOR a=1 TO numstars
IF long>360 THEN
long=long-360
latt=latt+15
END IF
shapes(5,a,1)=INT(SIN(long*(pi/180))*SIN(latt*(pi/180))*200)
shapes(5,a,2)=INT(SIN(long*(pi/180))*COS(latt*(pi/180))*200)
shapes(5,a,3)=INT(COS(long*(pi/180))*200)
long=long+30
NEXT a
shapename$(6)="One ring to show them all"
FOR a=1 TO numstars
shapes(6,a,1)=INT(SIN((a*2.5)*(pi/180))*200)
shapes(6,a,2)=INT(COS((a*2.5)*(pi/180))*200)
shapes(6,a,3)=0
NEXT a
shapename$(7)="Random sphere"
FOR a=1 TO numstars
long=INT(RND(360))
latt=INT(RND(360))
shapes(7,a,1)=INT(SIN(long*(pi/180))*SIN(latt*(pi/180))*200)
shapes(7,a,2)=INT(SIN(long*(pi/180))*COS(latt*(pi/180))*200)
shapes(7,a,3)=INT(COS(long*(pi/180))*200)
NEXT a
shapename$(8)="Rod"
FOR a=1 TO numstars
shapes(8,a,1)=INT(SIN((a*2)*(pi/180))*200)
shapes(8,a,2)=INT(SIN((a*2)*(pi/180))*200)
shapes(8,a,3)=0
NEXT a
shapename$(9)="Big box"
FOR a=1 TO numstars
x=INT(a%5)
y=INT(a/5%5)
z=INT(a/25%5)
shapes(9,a,1)=x*80-160
shapes(9,a,2)=y*80-160
shapes(9,a,3)=z*80-160
NEXT a
shapename$(10)="The sun"
FOR a=1 TO numstars
r=200-((a%5)*20)
shapes(10,a,1)=INT(SIN((a*2.5)*(pi/180))*r)
shapes(10,a,2)=INT(COS((a*2.5)*(pi/180))*r)
shapes(10,a,3)=0
NEXT a
shapename$(11)="Crop circles"
FOR a=1 TO numstars
r=200-((a%5)*40)
shapes(11,a,1)=INT(SIN((a*2.5)*(pi/180))*r)
shapes(11,a,2)=INT(COS((a*2.5)*(pi/180))*r)
shapes(11,a,3)=0
NEXT a
shapename$(12)="Clover"
FOR a=1 TO numstars
r=COS((a*5)*(pi/180))*200
shapes(12,a,1)=INT(SIN((a*2.5)*(pi/180))*r)
shapes(12,a,2)=INT(COS((a*2.5)*(pi/180))*r)
shapes(12,a,3)=0
NEXT a
shapename$(13)="Flower"
FOR a=1 TO numstars
r=COS((a*10)*(pi/180))*200
shapes(13,a,1)=INT(SIN((a*2.5)*(pi/180))*r)
shapes(13,a,2)=INT(COS((a*2.5)*(pi/180))*r)
shapes(13,a,3)=0
NEXT a
shapename$(14)="Double headed flower"
FOR a=1 TO numstars
r=COS((a*10)*(pi/180))*200
shapes(14,a,1)=INT(SIN((a*2.5)*(pi/180))*r)
shapes(14,a,2)=INT(COS((a*2.5)*(pi/180))*r)
shapes(14,a,3)=r
NEXT a
shapename$(15)="Double twist loop"
FOR a=1 TO numstars
r=COS((a*5)*(pi/180))*200
shapes(15,a,1)=INT(SIN((a*2.5)*(pi/180))*r)
shapes(15,a,2)=INT(COS((a*2.5)*(pi/180))*r)
shapes(15,a,3)=r
NEXT a
shapename$(16)="Folded circle"
FOR a=1 TO numstars
z=INT(COS((a*5)*(pi/180))*200)
IF z>0 THEN z=0
shapes(16,a,1)=INT(SIN((a*5)*(pi/180))*200)
shapes(16,a,2)=INT(COS((a*5)*(pi/180))*200)
shapes(16,a,3)=z
NEXT a
shapename$(17)="Clamshell"
FOR a=1 TO numstars
z=INT(COS((a*2.5)*(pi/180))*200)
IF z>0 THEN z=0
shapes(17,a,1)=INT(SIN((a*5)*(pi/180))*200)
shapes(17,a,2)=INT(COS((a*5)*(pi/180))*200)
shapes(17,a,3)=z
NEXT a
shapename$(18)="Table (or upside down crown)"
FOR a=1 TO numstars
z=INT(COS((a*20)*(pi/180))*200)
IF z>0 THEN z=0
shapes(18,a,1)=INT(SIN((a*5)*(pi/180))*200)
shapes(18,a,2)=INT(COS((a*5)*(pi/180))*200)
shapes(18,a,3)=z
NEXT a
RETURN
'Details : This routine sets the target x,y,z
'coords for each star based on the
'target shape.
set_target:
FOR a=1 TO numstars
startx(a)=shapes(targetshape,a,1)
starty(a)=shapes(targetshape,a,2)
startz(a)=shapes(targetshape,a,3)
NEXT a
RETURN
'Details : This routine does the actual
' morphing of the shape. It's very
' simple really. It just looks at
' each star and works out if it needs
' moving. When none need moving, it
' counts down a simple counter and
' then picks a new shape to morph to.
morph:
change=0
FOR a=1 TO numstars
x=starx(a)!tx=startx(a)
y=stary(a)!ty=starty(a)
z=starz(a)!tz=startz(a)
IF x<tx THEN
x=x+changespeed
IF x>tx THEN x=tx
change=1
END IF
IF x>tx THEN
x=x-changespeed
IF x<tx THEN x=tx
change=1
END IF
IF y<ty THEN
y=y+changespeed
IF y>ty THEN y=ty
change=1
END IF
IF y>ty THEN
y=y-changespeed
IF y<ty THEN y=ty
change=1
END IF
IF z<tz THEN
z=z+changespeed
IF z>tz THEN z=tz
change=1
END IF
IF z>tz THEN
z=z-changespeed
IF z<tz THEN z=tz
change=1
END IF
starx(a)=x
stary(a)=y
starz(a)=z
NEXT a
IF change=0 THEN
IF NAME$="" THEN
NAME$=shapename$(targetshape)
textlife=500
END IF
changewait=changewait-1
IF changewait<=0 THEN
NAME$=""
changewait=changedelay
targetshape=targetshape+1
IF targetshape>numshapes THEN
targetshape=1
END IF
GOSUB set_target
END IF
END IF
RETURN
setup_message:
m$=" "
m$=m$&" "
m$=m$&"Welcome to the DrChip's morphing dot demo. You can rotate "
m$=m$&"the shapes by using the joypad on the screen Press "
m$=m$&"left and right to rotate the shape around the Y "
m$=m$&"axis, press up and down to rotate the shape "
m$=m$&"around the X axis, and use < and > to rotate "
m$=m$&"the shape around the Z axis. "
m$=m$&"You can stop the rotation by pressing the square "
m$=m$&" center button. "
m$=m$&"demo. "
m$=m$&"The shape morphs between "&STR$(numshapes)
m$=m$&" preset shapes. "
m$=m$&"You can add your own shapes by increasing the "
m$=m$&"numshapes variable in the initialise routine ("
m$=m$&"at the end of the code) and by adding your own "
m$=m$&"bit of code in the setup_shapes routine. Oh, "
m$=m$&"and don't forget to give your shape a name. "
m$=m$&"You may have noticed that this demo doesn't run "
m$=m$&"at full speed. This is hardly surprising. "
m$=m$&"There are "&STR$(numstars)&" dots in the demo. "
RETURN
initialize:
GRAPHICS
sw=SCREEN_WIDTH()
sh=SCREEN_HEIGHT()
ox=sw/2
oy=sh/2
curbuf=0
pi=3.1415
numstars=150
numshapes=18
targetshape=1
changespeed=3
changedelay=200
changewait=changedelay
NAME$=""
textlife=0
mx=10
mpos=0
red=1!blue=1!green=1
tred=1!tblue=0!tgreen=0
GOSUB drawpad
GOSUB setup_message
DIM starx(numstars+5)
DIM stary(numstars+5)
DIM starz(numstars+5)
DIM startx(numstars+5)
DIM starty(numstars+5)
DIM startz(numstars+5)
DIM cosines(361)
DIM sines(361)
FOR ANGLE=0 TO 360
cosines(ANGLE)=COS(ANGLE*(pi/180))
sines(ANGLE)=SIN(ANGLE*(pi/180))
NEXT ANGLE
GOSUB setup_shapes
FOR a=1 TO numstars
starx(a)=0
stary(a)=0
starz(a)=0
NEXT a
GOSUB set_target
xrot=0!xroto=0
yrot=0!yroto=0
zrot=0!zroto=0
offmax=4
RETURN
REM buttons
' ⬆️
'⬅️•➡️
' ⬇️
drawpad:
BUTTON "up" TEXT "⬆️" AT 45+ox,15+oy
BUTTON "press" TEXT "•" AT 45+ox,50+oy
BUTTON "down" TEXT "⬇️" AT 45+ox,85+oy
BUTTON "left" TEXT "⬅️" AT 0+ox,50+oy
BUTTON "right" TEXT "➡️" AT 90+ox,50+oy
BUTTON "in" TEXT "<" AT 0+ox,90+oy
BUTTON "out" TEXT ">" AT 90+ox,90+oy
RETURN
