Support Forum / Форум поддержки

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