Digital Orgasm

[DrChip]

rem -=DIGITAL ORGASM=-
rem oOoOoOoOoOoOoOoOoOo
rem still working on it....
rem iPhone 6 Plus / iOS 8.3 b2

def reload
notes load "/Examples/10. Music & Sound/files/test5.mid"
notes play
enddef

reload

gosub initialize

off=0
coff=1
for aa=1 to 721
gosub rotate
gosub sort
gosub store
next aa
off=0
coff=1


loop:
if notes_time()>notes_length() then reload
refresh off
mm=mm+.01
gosub static
gosub viewport
gosub starfield
gosub window
gosub draw
gosub scroll
refresh on
goto loop

scroll:
draw color 155/255,155/255,1
draw text mid$(s$,p,44) at scx,sh-18
draw color 1,1,1
draw text mid$(s$,p,44) at scx-1,sh-19
draw color 0,0,0
draw text mid$(s$,p,44) at scx-2,sh-20

scx=scx-1
if scx<1 then
scx=scx+10
p=p+1
if p>len(s$)-1 then p=1
end if
return

starfield:
for a=1 to stars
sxx=((asx(a)*25)/asz(a)*25)+sw/2
syy=((asy(a)*25)/asz(a)*25)+sh/2
If sxx>10 and sxx<sw-10 and syy>10 and syy<sh-10 then
fill color 110-asz(a)/255,110-asz(a)/255,110-asz(a)/255
fill rect sxx,syy to sxx+10-(asz(a)/10),syy+10-(asz(a)/10)
end if
asz(a)=asz(a)-1
if asz(a)<0 then asz(a)=asz(a)+100
next a
return

window:
fill color 30/255,30/255,30/255
'fill triangle 49,266 to 49,246 to 70,256
trix(0)=0
triy(0)=sh/2 '266
trix(1)=0
triy(1)=sh/2 '246
trix(2)=70
triy(2)=sh/2 '256
fill poly trix,triy count 3
'fill triangle 500,266 to 500,246 to 479,256
trix(0)=sw-10
triy(0)=sh/2 '266
trix(1)=sw-10
triy(1)=sh/2 '246
trix(2)=479
triy(2)=sh/2 '256
fill poly trix,triy count 3
return

viewport:
'star view port
fill color (20+20*sin(mm))/255,(10+10*sin(mm))/255,(20+20*sin(mm))/255

'triangle
trix(0)=10
triy(0)=20
trix(1)=sw-10
triy(1)=sh-20
trix(2)=10
triy(2)=sh-20
fill poly trix,triy count 3
'triangle
trix(0)=10
triy(0)=20
trix(1)=sw-10
triy(1)=sh-20
trix(2)=sw-10
triy(2)=20
fill poly trix,triy count 3
return

static:

' Draw All Static Graphics Now So We Can Have More Detail.


fill color 80/255,30/255,30/255
fill color 1,1,1
fill rect 0,0 to sw,sh
draw color 155/255,155/255,155/255
draw text "-=DIGITAL ORGASM=-" at sw/6,0
draw color .9,.9,.9
draw text "-=DIGITAL ORGASM=-" at sw/6+1,1
draw text "-=DIGITAL ORGASM=-" at sw/6+2,2
return


sort:
for fk=1 to polys
b=1
for a=1 to polys -1
if tz(b)+tz(b+1)+tz(b+2) < tz(b+3)+tz(b+4)+tz(b+5) then
for inner=0 to 2
sz=tz(b+inner)
sy=ty(b+inner)
sx=tx(b+inner)
tz(b+inner)=tz(b+inner+3)
ty(b+inner)=ty(b+inner+3)
tx(b+inner)=tx(b+inner+3)
tz(inner+b+3)=sz
ty(inner+b+3)=sy
tx(inner+b+3)=sx
next inner
sr=tr(a+1)
sg=tg(a+1)
sb=tb(a+1)
tr(a+1)=tr(a)
tg(a+1)=tg(a)
tb(a+1)=tb(a)
tr(a)=sr
tg(a)=sg
tb(a)=sb
end if
b=b+3
next a
next fk
return

store:

'Store The object

for a=1 to polys-1
str(coff)=tr(a+1)
stg(coff)=tg(a+1)
stb(coff)=tb(a+1)
coff=coff+1
next a

for a=1 to polys *3
stx(off)=tx(a)
sty(off)=ty(a)
ltz(off)=tz(a)
off=off+1
next a
return


draw:

'Draw The object
size=2+1.2*sin(mm/3)
for a=1 to polys

sa=(ltz(off)+ltz(off+1)+ltz(off+2))*20

fill color (str(coff)-sa)/255,(stg(coff)-sa)/255,(stb(coff)-sa)/255

'gtriangle 275+(stx(off)/size),256+(sty(off)/size) to 275+(stx(off+1)/size),256+(sty(off+1)/size) to 275+(stx(off+2)/size),256+(sty(off+2)/size)
trix(0)=sw/2+(stx(off)/size)
triy(0)=sh/2+(sty(off)/size)
trix(1)=sw/2+(stx(off+1)/size)
triy(1)=sh/2+(sty(off+1)/size)
trix(2)=sw/2+(stx(off+2)/size)
triy(2)=sh/2+(sty(off+2)/size)
fill poly trix,triy count 3
off=off+3
coff=coff+1

next a

if off>17300 then
coff=1
off=0
end if
return

rotate:
'Rotate And Scale Each Point Store Result

for a=1 to polys*3
x1=x(a)
y1=y(a)
z1=z(a)

'X,Y,Z rotations

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)

'Apply Perspective

xx=size*(xx/((zz/70)+1))
yy=size*(yy/((zz/70)+1))
tx(a)=xx
ty(a)=yy
tz(a)=zz
tr(a)=cr(a)
tg(a)=cg(a)
tb(a)=cb(a)
next a
xr=xr+rrx
yr=yr+rry
zr=zr+rrz
if xr>720 then xr=xr-720
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
return


initialize:

sw=screen_width()
sh=screen_height()
pi=3.1415
dim trix(4),triy(4)
' This Sub-Routine Initialises The Program.
graphics
graphics clear 0,0,0


size=16 ' how big do you want it?
rrx=1
rry=2
rrz=3

polys=8 'The amount of polygons in the object
dim x(polys*4) 'Original X co-ordinate store
dim y(polys*4) 'Original Y co-ordinate store
dim z(polys*4) 'Original Z co-ordinate store
dim cr(polys*4) 'Original Red component store
dim cg(polys*4) 'Original Green component store
dim cb(polys*4) 'Original Blue Component store
dim tx(polys*4) ' Transformed X co-ordinate store
dim ty(polys*4) ' Transformed Y co-ordinate store
dim tz(polys*4) ' Transformed Z co-ordinate store
dim tr(polys*4) ' Transformed Red component store
dim tg(polys*4) ' Transformed Green component store
dim tb(polys*4) ' Transformed Blue Component store

dim stx((polys*4)*722)
dim sty((polys*4)*722)
dim str((polys*4)*722)
dim stg((polys*4)*722)
dim stb((polys*4)*722)
dim ltz((polys*4)*722)

'Define Sine 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

'Read in the object
a=1
for b=1 to polys
read x(a),y(a),z(a)
read x(a+1),y(a+1),z(a+1)
read x(a+2),y(a+2),z(a+2)
read cr(b),cg(b),cb(b)
a=a+3
next b


'Starfield Definition
stars=79
dim asx(stars+2),asy(stars+2),asz(stars+2)
b=0
for a=1 to stars
asx(a)=-20+rnd(40)+.1
asy(a)=-20+rnd(40)+.1
asz(a)=b+.1
b=b+100/stars
next a

'Scrolling Message:
s$=" "
s$=s$&"A different sort of a name for a demo I know but "
s$=s$&"look at it... What else could I call it?? Heh! "
s$=s$&"I Really like this one and I hope that you do too."
scx=60
return

' The Object Description As Data
' (uses 3 points per polygon)
data -5,-1,5,5,-1,5,0,-6,0,0,155,0
data 5,-1,5,5,-1,-5,0,-6,0,155,0,0
data 5,-1,-5,-5,-1,-5,0,-6,0,0,155,0
data -5,-1,-5,-5,-1,5,0,-6,0,155,0,0
data -5,1,5,5,1,5,0,6,0,0,155,0
data 5,1,5,5,1,-5,0,6,0,0,0,155
data 5,1,-5,-5,1,-5,0,6,0,0,155,0
data -5,1,-5,-5,1,5,0,6,0,0,0,155