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

Code: Select all

rem The Ship Demo
rem iPhone 6 plus / iOS 9 b1 / 4.9
rem Enjoy...
'3D Routine... 
'This one uses a hidden line algorithm
'to take away the need for depth sorting... 
'It's much quicker than other methods but 
'less flexible.


gosub initialize
debug=-1
loop:
refresh off
   fill color 20/255,10/255,10/255
    fill tri 0,0 , sw,sh , 0,sh
    fill tri 0,0 , sw,sh , sw,0
   fill color 0,0,10/255
    fill tri 0,sh-140 , sw,sh , 0,sh
    fill tri 0,sh-140 , sw,sh , sw,sh-140 

    gosub cobra

draw color 0,0,0
draw text "SHIP DEMO" at 0,4
draw rect 3,3 to sw-3,23
draw text mid$(s$,p,67) at scx+3,sh/2+3
draw color 1,1,1
draw text "SHIP DEMO" at 0,0
draw rect 0,0 to sw,20
draw text mid$(s$,p,67) at scx,sh/2

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


if debug>0 then
draw color 250/255,250/255,250/255
for a=1 to polys
draw text str$(a) at tx(a),ty(a)
next a
end if
refresh on
goto loop


cobra:
    gosub rotate
    r=80 ! g=20 ! b=20
    f1=1 ! f2=3 ! f3=2 
    gosub draw
    gosub draw2

    r=90 ! g=30 ! b=30
    f1=2 ! f2=3 ! f3=4 
    gosub draw
    gosub draw2

    r=100 ! g=100 ! b=200
    f1=3 ! f2=5 ! f3=4 
    gosub draw
    gosub draw2

    r=90 ! g=30 ! b=30
    f1=4 ! f2=5 ! f3=6
    gosub draw
    gosub draw2

    r=80 ! g=20 ! b=20
    f1=5 ! f2=7 ! f3=6
    gosub draw
    gosub draw2

    r=10 ! g=40 ! b=10
    f1=9 ! f2=3 ! f3=1
    gosub draw
    gosub draw2

    r=10 ! g=40 ! b=10
    f1=5 ! f2=10 ! f3=8
    gosub draw
    gosub draw2

    r=10 ! g=40 ! b=10
    f1=9 ! f2=10 ! f3=3
    gosub draw
    gosub draw2

    r=10 ! g=20 ! b=10
    f1=10 ! f2=5 ! f3=3
    gosub draw
    gosub draw2

    r=10 ! g=20 ! b=10
    f1=7 ! f2=5 ! f3=8
    gosub draw
    gosub draw2

    r=100 ! g=0 ! b=0
    f1=1 ! f2=2 ! f3=9
    gosub draw
    gosub draw2

    r=100 ! g=0 ! b=0
    f1=7 ! f2=8 ! f3=6
    gosub draw
    gosub draw2

    r=40 ! g=40 ! b=40
    f1=2 ! f2=4 ! f3=9
    gosub draw
    gosub draw2

    r=40 ! g=40 ! b=40
    f1=4 ! f2=6 ! f3=8
    gosub draw
    gosub draw2

    r=60 !g=65 ! b=60
    f1=9 ! f2=4 ! f3=8
    gosub draw
    gosub draw2
return
draw:
'Draw A Face Of The Ship
  vx1= tx(f1)-tx(f2)
  vy1= ty(f1)-ty(f2)
  vx2= tx(f3)-tx(f2)
  vy2= ty(f3)-ty(f2)
  if  (vx1*vy2-vx2*vy1)<0 then
light=-(tz(f1)+tz(f2)+tz(f3))*4
fill color (r+light)/255,(g+light)/255,(b+light)/255
fill tri tx(f1),ty(f1) , tx(f2),ty(f2) , tx(f3),ty(f3)
end if
return

draw2:
'Draw inverted Face Of The Ship
  vx1= tx(f1)-tx(f2)
  vy1= ty(f1)-ty(f2)
  vx2= tx(f3)-tx(f2)
  vy2= ty(f3)-ty(f2)
  if  (vx1*vy2-vx2*vy1)<0 then
light=-(tz(f1)+tz(f2)+tz(f3))*3
fill color (r+light)/255,(g+light)/255,(b+light+20)/255
fill tri tx(f1),ry(f1) , tx(f2),ry(f2) , tx(f3),ry(f3)
end if
return


rotate:
'Rotate And Scale Each Point Store Result
 for a=1 to polys
  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/50)+1))+sw/2
  yy=size*(yy/((zz/50)+1))+sh/2-80
  tx(a)=xx
  ty(a)=yy
  ry(a)=(-(yy/3))+sh 
  tz(a)=zz
 next a
xr=xr+4
yr=yr+2
zr=zr+2
if xr>720 then xr=xr-720
if yr>720 then yr=yr-720
if zr>720 then zr=zr-720
return

initialize:
'This Sub-Routine Initializes The Program.
'Open Gfx Screen
graphics
sw=screen_width()
sh=screen_height()
s$="                                                                    "
s$=s$&"THIS SPACESHIP SHOULD BE INSTANTLY FAMILIAR TO "
s$=s$&"ANYONE WHO PLAYED THE CLASSIC GAME 'ELITE' BY "
s$=s$&"THE GENIUS DAVID BRABEN... I REMEMBER THIS GAME "
s$=s$&"FROM THE BBC AND COMMODORE 64, A REAL CLASSIC... "
s$=s$&"I WANTED A DIFFERENT OBJECT TO SHOWCASE MY NEWEST "
s$=s$&"3D ROUTINE, WHICH IS BLINDINGLY QUICK... I WAS A " 
s$=s$&"BIT BORED WITH CUBE DERIVATIVES SO I THOUGHT "
s$=s$&"I'D MODEL AN ELITE SPACESHIP, I ALSO ADDED "
s$=s$&"THE REFLECTION AND SCROLL AND IT'S STILL ZIPPING "
s$=s$&"ALONG AT FULL FRAME RATE, FULLY LIGHTSOURCED WITH "
s$=s$&"INDEPENDANTLEY COLORED FACES, THERE'S SO MUCH "
s$=s$&"SPARE PROCESOR TIME THAT I LEFT MY DEBUG MODE IN "
s$=s$&"HERE, TO TOGGLE THE DEBUG JUST ADJUST "
s$=s$&"THE DEBUG VAR... I USE THIS WHEN I'M CONNECTING UP "
s$=s$&"THE VERTICES OF THE OBJECT DURING ITS' CREATION.. "
s$=s$&"EVERYONE ELSE WHO KNOWS ME   " 
s$=s$&"SEE YOU ALL NEXT TIME, BYE......       "
scx=0
p=0
'Define the necessary variables
size=13.5 ' how big do you want it?
pi=3.1415 '            Double buffering Variable
polys=10 '        The amount of points in the object
dim x(polys+1) '  Original X co-ordinate store
dim y(polys+1) '  Original Y co-ordinate store
dim z(polys+1) '  Original Z co-ordinate store
dim tx(polys+1) ' Transformed  X co-ordinate store
dim ty(polys+1) ' Transformed Y co-ordinate store
dim tz(polys+1) ' Transformed Z co-ordinate store
dim ry(polys+1) ' Inverted Y co-ord store (reflection).
'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
for a=1 to polys
 read x(a),y(a),z(a)
next a
'The Object Description As Data
'The Data Below Describes the Ship.
data -15,-10,0,-5,-10,5,-5,10,0
data 0,-10,5,7,10,0,5,-10,5
data 15,-10,0
data 5,-10,-5,-5,-10,-5,0,-10,-5
return