Code: Select all
rem "Retro Style" demo
rem iPhone 6 plus / 8.3 b2
rem enjoy...
def reload
notes load "/Examples/10. Music & Sound/files/test6.mid"
notes play
enddef
reload
gosub setup ' SET UP ALL VARIABLES
do
if notes_time()>notes_length() then reload
refresh off
fd=fad/10
graphics clear 0,0,fd/255
fill color 0,0,fad/255 'BLUE BARS
'top bar
'triangle 0,0 to sw,0 to sw,50
trix(0)=0
triy(0)=0
trix(1)=sw
triy(1)=0
trix(2)=sw
triy(2)=50
fill poly trix, triy count 3
'triangle 0,sh to sw,sh to sw,462
trix(0)=0
triy(0)=sh
trix(1)=sw
triy(1)=sh
trix(2)=sw
triy(2)=462
fill poly trix, triy count 3
'bottom bar
'triangle 0,0 to 0,50 to sw,50
trix(0)=0
triy(0)=0
trix(1)=0
triy(1)=50
trix(2)=sw
triy(2)=50
fill poly trix, triy count 3
'triangle 0,sh to 0,462 to sw,462
trix(0)=0
triy(0)=sh
trix(1)=0
triy(1)=462
trix(2)=sw
triy(2)=462
fill poly trix, triy count 3
if fad<255 then fad=fad+.5
gosub stars 'DO 3D STARS
gosub rotate 'ROTATE OBJECT
gosub construct 'DRAW OBJECT
gosub logo1 'DRAW LOGO BACK LETTERS
gosub scroll 'DO SCROLLER
gosub logo2 'DRAW LOGO FRONT LETTERS
refresh on
until 1=2
'Scroller;
scroll:
yp=100*sin(mm/3)
draw color fad/255,fad/255,fad/255
draw text mid$(s$,p,67) at scx,256+yp
draw color 0,0,0
draw text mid$(s$,p,67) at scx+1,257+yp
scx=scx-1
if scx<-10 then 'RESET POS ADD NEW LETTER
scx=scx+10
p=p+1
if p>len(s$)-1 then p=0
end if
return
'Control sub to Draw The Object
construct:
for a=1 to faces 'DO EACH FACE IN TURN
gosub draw
next a
return
'Draw A Face Of The Object
draw: 'CROSS PRODUCT CALC \/
vx1 = tx(f1(a))-tx(f2(a))
vy1= ty(f1(a))-ty(f2(a))
vx2 = tx(f3(a))-tx(f2(a))
vy2= ty(f3(a))-ty(f2(a))
n = vx1*vy2-vx2*vy1
if n<0 then 'IF NEGATIVE SURVACE VISIBLE
n=-(n/200)
if n>220 then n=220 'LIMIT MAX COLOR
n=n-250+fad
fill color (r(a)+n)/255,(g(a)+n)/255,(b(a)+n)/255
'fill triangle tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
trix(0)=tx(f1(a))
triy(0)=ty(f1(a))
trix(1)=tx(f2(a))
triy(1)=ty(f2(a))
trix(2)=tx(f3(a))
triy(2)=ty(f3(a))
fill poly trix, triy count 3
if cls(a)=1 then 'DRAW BORDER IF CELL SHAD ON
draw color 0,0,0
draw line tx(f1(a)),ty(f1(a)) to tx(f2(a)),ty(f2(a))
draw line tx(f2(a)),ty(f2(a)) to tx(f3(a)),ty(f3(a))
draw line tx(f3(a)),ty(f3(a)) to tx(f4(a)),ty(f4(a))
draw line tx(f4(a)),ty(f4(a)) to tx(f1(a)),ty(f1(a))
end if
end if
return
'Object Rotation and offset
rotate:
mm=mm+.1
zo=11*sin(mm/2)
'Rotate And Scale Each Point Store Result
for a=1 to points
x1=x(a) ! y1=y(a)
z1=z(a)+zo
'X,Y,Z
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
dv=(zz/20)+1
xx=size*(xx/dv)+sw/2
yy=size*(yy/dv)+sh/2
tx(a)=xx
ty(a)=yy
tz(a)=zz
next a
xr=xr+3
yr=yr+2
zr=zr+3
if xr>720 then xr=xr-720
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
return
'Starfield
stars:
fill color (fad/2)/255,(fad/2)/255,(fad/2)/255
for a=1 to ns
fill rect ox(a),oy(a) to ox(a)+os(a),oy(a)+os(a)
next a
fill color fad/255,fad/255,fad/255
for a=1 to ns
itx=sw/2+(sx(a)/sz(a))
ity=sh/2+(sy(a)/sz(a))
s=6-sz(a)
sz(a)=sz(a)-.1
if itx<0 or itx>sw or ity<0 or ity>sh then
sx(a)=-2000+rnd(4000)
sy(a)=-2000+rnd(4000)
sz(a)=5
end if
ox(a)=itx
oy(a)=ity
os(a)=s
fill rect itx,ity to itx+s,ity+s
next a
return
'Logo Back Letters
logo1:
fill color 0,0,(fad/1.8)/255
'd
fill rect 10,210 to 60,220
fill rect 10,290 to 60,280
fill rect 10,210 to 20,280
fill rect 20,255 to 30,290
fill rect 70,220 to 60,280
'c
fill rect 140,210 to 185,220
fill rect 140,290 to 190,280
fill rect 140,210 to 150,290
fill rect 140,245 to 160,290
'i
fill rect 260,210 to 270,290
return
'Logo Front Letters
logo2:
fill color 0,0,fad/255
'r
fill rect 80,210 to 90,250
fill rect 130,210 to 80,220
fill rect 80,245 to 100,290
'h
fill rect 240,240 to 210,250
fill rect 200,210 to 210,290
fill rect 240,210 to 250,290
fill rect 200,245 to 220,290
'p
fill rect 280,210 to 290,290
fill rect 290,250 to 300,290
fill rect 290,210 to 310,220
fill rect 310,220 to 320,250
fill rect 300,250 to 310,260
'middle bar
'fill rect 5,204 to 635,296
return
setup:
graphics
pi=3.1415
sw=screen_width()
sh=screen_height()
'Scroller Definition
s$=" "
s$=s$&" RETRO STYLE BY DR. CHIP. "
s$=s$&"WELL, THIS ONE CERTAINLY DOESN'T DO ANYTHING NEW "
s$=s$&"BUT I TRIED TO MAKE THE DESIGN NICE! IT'S SORT "
s$=s$&"Of OLDSKOOL BUT NICE AND IT WAS WRITTEN FROM "
s$=s$&"MEMORY... IT PAYS HOMAGE TO THE GREAT AMIGA "
s$=s$&"DEMOS OF THE PAST... NOT TOO MANY YEARS AGO THIS "
s$=s$&"WOULD HAVE BEEN CONSIDERED GROUNDBREAKING STUFF. "
s$=s$&" OH WELL, NEVER MIND... "
scx=0!p=0
'Starfield
ns=44
dim ox(ns+1),oy(ns+1),os(ns+1),sx(ns+1),sy(ns+1),sz(ns+1)
for a=0 to ns
sx(a)=-2000+rnd(4000)+.1
sy(a)=-2000+rnd(4000)+.1
sz(a)=rnd(5)+.1
next a
'3D Object Variables
size=17 ' how big do you want it?
points=14 ' The amount of points in the object
faces=24 ' The Amount of faces in the object
dim x(points+1) ' Original X co-ordinate store
dim y(points+1) ' Original Y co-ordinate store
dim z(points+1) ' Original Z co-ordinate store
dim tx(points+1) ' Transformed X co-ordinate store
dim ty(points+1) ' Transformed Y co-ordinate store
dim tz(points+1) ' Transformed Z co-ordinate store
dim f1(faces+1) ' Connections definition
dim f2(faces+1) ' Connections definition
dim f3(faces+1) ' Connections definition
dim f4(faces+1) ' Connections definition
dim r(faces+1) ' Red Component
dim g(faces+1) ' Green Component
dim b(faces+1) ' Blue Component
dim cls(faces+1)' Cell Shade Face?
'Define Sine Tables for faster matrix calculations
dim cs(721),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's points
for a=1 to points
read x(a),y(a),z(a)
next a
'Read In Connections and face parameters;
for a=1 to faces
read f1(a),f2(a),f3(a),f4(a),r(a),g(a),b(a),cls(a)
next a
'The Object Description As Data!
data 5,-5,-5,5,5,-5,-5,5,-5,-5,-5,-5,0,0,-8,8,0,0,0
data 8,0,-8,0,0,0,-8,0,5,-5,5,5,5,5,-5,5,5,-5,-5,5,0,0,8
data 10,9,13,13,50,0,0,1
data 14,10,13,13,0,50,0,1
data 14,13,12,12,0,50,0,1
data 8,12,13,13,0,0,50,1
data 4,8,13,13,0,0,50,1
data 10,14,11,11,0,50,0,1
data 10,11,6,6,50,0,50,1
data 4,13,9,9,50,0,0,1
data 1,4,9,9,50,0,0,1
data 1,9,10,10,50,0,0,1
data 6,1,10,10,50,0,50,1
data 5,4,1,1,0,50,50,1
data 8,4,3,3,0,0,50,1
data 3,12,8,8,0,0,50,0
data 3,4,5,5,0,50,50,1
data 7,12,3,3,50,50,0,1
data 14,12,11,11,0,50,0,0
data 11,12,7,7,50,50,0,1
data 6,11,2,2,50,0,50,1
data 11,7,2,2,50,50,0,0
data 1,6,2,2,50,0,50,1
data 2,5,1,1,0,50,50,1
data 2,7,3,3,50,50,0,0
data 2,3,5,5,0,50,50,1
return
