Screen 20 used (1024,768).
I've tried to make the theme compatible with different cpu speeds, although I think it is too fast for under 1000 Mhz and too slow for over 2000 Mhz.
Code: Select all
#Include once "fbgfx.bi"
'START OF ROTATOR
Sub mv(m1() As Double,m2() As Double,ans() As Double) 'MATRIX x VECTOR
Dim s As Double
For i As Integer=1 To 3
s=0
For k As Integer = 1 To 3
s=s+m1(i,k)*m2(k)
Next k
ans(i)=s
Next i
End Sub
Dim Shared np(1 To 6) As Double 'For a position rotation, no lines or circles
'np(1),np(2),np(3)-------np(4),np(5),np(6) for line ends
'np(4),np(5) for circle centres
' use linepointset,circlepointset to draw the pixels
Sub rotate(Byval pivot_x As Double,_ 'x pivot for rotation
Byval pivot_y As Double,_ 'y pivot for rotation
Byval pivot_z As Double,_ 'z pivot for rotation
Byval first_x As Double,_ 'x for line,or centre for circle
Byval first_y As Double,_ 'y for line,or centre for circle
Byval first_z As Double,_ 'z for line or circle
Byval second_x As Double, _'x for line,or radius for circle
Byval second_y As Double, _'y for line,or aspect for circle
Byval second_z As Double,_ 'z for line
Byval angleX As Double, _ 'angle to rotate round x axis
Byval angleY As Double,_ 'angle to rotate round y axis
Byval angleZ As Double,_ 'angle to rotate round z axis
Byval magnifier As Double,_ '1=no magnifacation
Byval dilator As Double,_ 'times distance from pivot(1=no dilation)
Byval colour As ulong,_ 'color for line or circle
Byval thickness As Double,_ 'thickness line or circle
Byref shape As String,_ 'line/circle/circlefill/box/boxfill/linepoint[set],circlepoint[set]"
Byref mode As String,_ '2d or 3d
Byval perspective As Double=0,_ 'add some 3d perspective 0 to 1 approx
image as any pointer=0) 'write to an image if required
shape=Lcase(shape)
mode=Lcase(mode)
Dim th As Double
th=thickness
Dim As Double zval,pp 'used in get_perspective
Dim sx As Double=second_x
Dim p As Double = 4*Atn(1) '(pi)
Dim angleX_degrees As Double
Dim angleY_degrees As Double
Dim angleZ_degrees As Double
#Macro thickline(t)
Dim As Double s,h,c
dim as ulong p
p=rgb(255,255,255)
h=Sqr(((np(1))-(np(4)))^2+((np(2))-(np(5)))^2)
s=((np(5))-np(2))/h
c=(np(1)-(np(4)))/h
line image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),p
line image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),p
line image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),p
line image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),p
paint image,((np(4)+np(1))/2, (np(5)+np(2))/2),p,p
line image, (np(4)+s*t/2,np(5)+c*t/2)-(np(1)+s*t/2,np(2)+c*t/2),colour
line image, (np(4)-s*t/2,np(5)-c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colour
line image, (np(4)+s*t/2,np(5)+c*t/2)-(np(4)-s*t/2,np(5)-c*t/2),colour
line image, (np(1)+s*t/2,np(2)+c*t/2)-(np(1)-s*t/2,np(2)-c*t/2),colour
paint image,((np(4)+np(1))/2, (np(5)+np(2))/2), colour, colour
#EndMacro
#macro thickcircle(t)
Dim As ulong p=rgb(255,255,255)
circle image,(first_x-xx,first_y-yy),sx,p,,,second_y
circle image,(first_x-xx,first_y-yy),sx-t,p,,,second_y
paint image,(first_x-xx,first_y-yy+sx-t/2),p,p
paint image,(first_x-xx+sx-t/2,first_y-yy),p,p
circle image,(first_x-xx,first_y-yy),sx,colour,,,second_y
circle image,(first_x-xx,first_y-yy),sx-t,colour,,,second_y
paint image,(first_x-xx,first_y-yy+sx-t/2),colour,colour
paint image,(first_x-xx+sx-t/2,first_y-yy),colour,colour
#endmacro
#macro get_perspective(np3,np6)
For n As Integer=3 To 6 Step 3
zval =np(n) 'for perspective
pp=perspective*((zval+1000)/1000-1)
pp=(1-pp)
If n=3 Then
np(n-2)=np(n-2)-pivot_x
np(n-1)=np(n-1)-pivot_y
np(n-2)=np(n-2)*pp
np(n-1)=np(n-1)*pp
np(n-2)=np(n-2)+pivot_x
np(n-1)=np(n-1)+pivot_y
Endif
If n=6 Then
np(n-2)=np(n-2)-pivot_x
np(n-1)=np(n-1)-pivot_y
np(n-2)=np(n-2)*pp
np(n-1)=np(n-1)*pp
np(n-2)=np(n-2)+pivot_x
np(n-1)=np(n-1)+pivot_y
Endif
Next n
sx=(pp)*sx
#endmacro
Dim pivot_vector(1 To 3) As Double
Dim line_vector(1 To 3) As Double
magnifier=dilator*magnifier
angleX_degrees=(2*p/360)*angleX 'change from radians to degrees
angleY_degrees=(2*p/360)*angleY
angleZ_degrees=(2*p/360)*angleZ
pivot_vector(1)=first_x-pivot_x
pivot_vector(2)=first_y-pivot_y
pivot_vector(3)=first_z-pivot_z
pivot_vector(1)=dilator*pivot_vector(1)
pivot_vector(2)=dilator*pivot_vector(2)
pivot_vector(3)=dilator*pivot_vector(3)
Dim Rx(1 To 3,1 To 3) As Double
Dim Ry(1 To 3,1 To 3) As Double
Dim Rz(1 To 3,1 To 3) As Double
'rotat1on matrices about the three axix
If mode="3d" Then
Rx(1,1)=1:Rx(1,2)=0:Rx(1,3)=0
Rx(2,1)=0:Rx(2,2)=Cos(angleX_degrees):Rx(2,3)=-Sin(angleX_degrees)
Rx(3,1)=0:Rx(3,2)=Sin(angleX_degrees):Rx(3,3)=Cos(angleX_degrees)
Ry(1,1)=Cos(angleY_degrees):Ry(1,2)=0:Ry(1,3)=Sin(angleY_degrees)
Ry(2,1)=0:Ry(2,2)=1:Ry(2,3)=0
Ry(3,1)=-Sin(angleY_degrees):Ry(3,2)=0:Ry(3,3)=Cos(angleY_degrees)
Endif
Rz(1,1)=Cos(angleZ_degrees):Rz(1,2)=-Sin(angleZ_degrees):Rz(1,3)=0
Rz(2,1)=Sin(angleZ_degrees):Rz(2,2)=Cos(angleZ_degrees):Rz(2,3)=0
Rz(3,1)=0:Rz(3,2)=0:Rz(3,3)=1
line_vector(1)=magnifier*(second_x-first_x)'*pp 'get the vector
line_vector(2)=magnifier*(second_y-first_y)'*pp 'get the vector
line_vector(3)=magnifier*(second_z-first_z)'*pp
Dim new_pos(1 To 3) As Double
Dim temp1(1 To 3) As Double
Dim temp2(1 To 3) As Double
If mode="3d" Then
mv Rx(),pivot_vector(),temp1()
mv Ry(),temp1(),temp2()
mv Rz(),temp2(),new_pos()
Endif
If mode="2d" Then
mv Rz(),pivot_vector(),new_pos()
Endif
new_pos(1)=new_pos(1)+pivot_x
new_pos(2)=new_pos(2)+pivot_y
new_pos(3)=new_pos(3)+pivot_z
Dim new_one(1 To 3) As Double 'To hold the turned value
If mode="3d" Then
mv Rx(),line_vector(),temp1() 'rotate
mv Ry(),temp1(),temp2()
mv Rz(),temp2(),new_one()
Endif
If mode="2d" Then
mv Rz(),line_vector(),new_one()
Endif
new_one(1)=new_one(1)+first_x 'translate
new_one(2)=new_one(2)+first_y
new_one(3)=new_one(3)+first_z
Dim xx As Double
Dim yy As Double
Dim zz As Double
xx=first_x-new_pos(1)
yy=first_y-new_pos(2)
zz=first_z-new_pos(3)
np(1)=new_one(1)-xx
np(2)=new_one(2)-yy
np(3)=new_one(3)-zz
np(4)=first_x-xx
np(5)=first_y-yy
np(6)= first_z-zz
If perspective <> 0 Then
get_perspective(np(3),np(6))
End If
Select Case shape
Case "line"
If th<2 Then
line image,(np(4),np(5))-(np(1),np(2)),colour
Else
thickline(th)
End If
Case "circle"
If th<=2 Then
circle image,(np(4),np(5)),magnifier*sx,colour,,,second_y
Else
thickcircle(th)
End If
Case "circlefill"
circle image,(first_x-xx,first_y-yy),magnifier*sx,colour,,,second_y,F
Case"box"
line image,(first_x-xx,first_y-yy)-(new_one(1)-xx,new_one(2)-yy),colour,b
Case "boxfill"
line image,(first_x-xx,first_y-yy)-(new_one(1)-xx,new_one(2)-yy),colour,bf
Case "linepoint","circlepoint"
'nothing drawn
Case "linepointset","circlepointset"
If shape="linepointset" Then
Pset image,(np(1),np(2))
Pset image,(np(4),np(5))
Endif
If shape="circlepointset" Then
Pset image,(np(4),np(5))
End If
Case Else
Print "unknown rotation shape"
End Select
End Sub
'END OF ROTATOR
'____________________________________________________________________
declare Function polygradient(coff() As double,number As double) As double
declare Function poly(coff() As double,number As double)As double
declare sub make_hills
declare Function rnd_range (first As Double, last As Double) As Double
declare sub make_sky
declare sub draw_sky
declare Sub cloud(x As Integer, y As Integer,length As Integer=100,alpha As Integer=105, Zoom As Single = 0)
declare function setcpu() as double
dim shared im as any pointer
dim shared as integer x,y
x=1024 'screens
y=768
screen 20,32,1,FB.GFX_ALPHA_PRIMITIVES,FB.GFX_FULLSCREEN
'If anyone reads this code, I can't get the fullscreen flag
Draw String (x/2-100,y/2),"Please wait--Loading ..."
draw string(250,500),"[",rgb(255,255,255)
draw string(810,500),"]",rgb(255,255,255)
im=imagecreate(x,y)
dim shared cl as long 'for progress line as loading stage
dim shared p8 as integer ' "
sub glide
dim as integer k 'for each panel
dim as byte destroy
dim as double px,py,pz 'pivot
dim as double xp,yp,zp 'point
px=x/2.4 'the pivots
py=y/2.4
pz=300
dim as double ax,ay,az,d,zz
dim dADJ as double 'adjust dilation
dim p as double 'perspective
dim di as double 'dilation
dim toad as double
dim axstep as double
dim aystep as double
dim azstep as double
dim dADJstep as double=1
dim as ulong nct 'panel colours
dim shader as integer=20 'shading constant
dim as double aspect
dim as double u1,u2,u3,v1,v2,v3,wx,wy,wz,nw 'stuff for cross products
dim as integer min,max,j 'for surface macro
Dim f As Integer=24 'number of faces
dim count as integer 'main counter for panels
dim as double cpu 'speed adjuster
Dim As Double cnp(1 To 8),cznp(1 To 4),cz(1 To f,1 To f) 'copy line end positions
Dim As Integer paint_order(0 To f)
dim as double crossX(1 to f) 'light and darker shading instructor
dim as string action(1 to f) 'line or linepoint in rotator
dim as integer p1,p2 'counters for macro zsort
For n As Integer=1 To f
paint_order(n)=n
action(n)="line"
next n
Dim As Double cx,cy 'centre of areas for painting
#macro surface(sign,start_paint)
if sign*wz>start_paint then
if action(k)="line" then paint(cx,cy),nct,nct
action(k)="line"
else
action(k)="linepoint"
end if
#endmacro
#macro zsort(n)
' a quick bubblesort on z axis to get new paint order
For p1 = 1 To n - 1
For p2 = p1 + 1 To n
If (cz(p1,p1)) <= (cz(p2,p2)) Then
Swap cz(p1,p1),cz(p2,p2)
Swap paint_order(p1),paint_order(p2)
Endif
Next p2
Next p1
#endmacro
#macro crossproduct(of_two_sides)
'get vectors to origin
u1=cnp(1)-cnp(3)
u2=cnp(2)-cnp(4)
u3=cznp(1)-cznp(2)
v1=cnp(5)-cnp(7)
v2=cnp(6)-cnp(8)
v3=cznp(3)-cznp(4)
'get the cross product
wx=(u2*v3-v2*u3)
wy=-(u1*v3-v1*u3)
wz=(u1*v2-v1*u2)
nw=sqr(wx^2+wy^2+wz^2)
'normalized cross product components
wx=wx/nw
wy=wy/nw
wz=wz/nw
#endmacro
#macro edge(number)
select case number
'define two edges for cross product
case 1
cnp(1)=np(1)
cnp(2)=np(2)
cnp(3)=np(4)
cnp(4)=np(5)
cznp(1)=np(3)
cznp(2)=np(6)
case 2
cnp(5)=np(1)
cnp(6)=np(2)
cnp(7)=np(4)
cnp(8)=np(5)
cznp(3)=np(3)
cznp(4)=np(6)
'get the centroids, painting depends on z centroid
cx=(cnp(1)+cnp(3)+cnp(5)+cnp(7))/4
cy=(cnp(2)+cnp(4)+cnp(6)+cnp(8))/4
cz(paint_order(count),paint_order(count))=(cznp(1)+cznp(2)+cznp(3)+cznp(4))/4
end select
#endmacro
'the main 3d rotator
#macro spin(xv1,yv1,zv1,xv2,yv2,zv2,minv,maxv,flagx,flagy,flagz,edge_plane,edge_number)
for j=minv to maxv
rotate(px,py,pz,xv1+j*flagx,yv1+j*flagy,zv1+j*flagz,xv2+j*flagx,yv2+j*flagy,zv2+j*flagz,ax,ay,az,1,di,nct,1,action(k),"3d",p)
if j=edge_plane then
edge(edge_number)
end if
next j
#endmacro
make_sky 'jhh
make_hills
cpu=setcpu() 'Try! to get a similar runner for different cpu speeds
do
count=1
axstep=1.00001*di*cpu
aystep=-.7*di*cpu
azstep=.5*di*cpu
ax=ax-axstep
ay=ay+aystep
az=az+azstep
dADJ=dADJ+dADJstep
if abs(ax)>=360 then ax=0
if abs(ay)>=360 then ay=0
if abs(az)>=360 then az=0
xp=x/2
yp=y/2
yp=yp+200
if destroy=0 then di=.3*((1+cos(dADJ*3.142/180))/2)+.35 'adjust dilation
zz=1100
'get aspect
rotate(px,py,pz,xp,yp,-200,xp,yp,200,ax,ay,az,1,1,rgb(0,0,0),1,"linepoint","3d",p)
aspect=np(6)-np(3)
edge(1)
rotate(px,py,pz,xp-200,yp,0,xp+200,yp,0,ax,ay,az,1,1,rgb(0,0,0),1,"linepoint","3d",p)
edge(2)
crossproduct(0)
if destroy=0 then
px=150*wx+x/2.4
py=50*wy+y/2.4+50
pz=-(zz-300)*(di-.65)/.3 +300+100*wz
end if
dadjstep=sgn(sin(dadj*3.142/180))*-(-2.8*(aspect+400)/800+1.4)*di*cpu
if dADJ>=360 then
dadj=0
end if
if dADJ<=0 then
dadj=360
end if
screenlock
cls
draw_sky 'jhh
p=di
For count =1 To f
k=paint_order(count)
shader=20
if destroy=1 then
py=py+.1
pz=pz-.1
px=px+.1
ax=30
ay=360
az=355
di=di+.00001
draw string(px,py),"E N D I N G",rgb(0,0,0)
if py>850 then
imagedestroy(im)
exit sub
end if
end if
'build the panels
Select Case k
case 1'_____________________________________________________________
'nose cone upper
min=-4
max=4
'top,front of window,base
shader=sgn(crossX(1))*shader
nct=rgb(230+shader,30+shader,30+shader)
spin(xp-20,yp-10,-100,xp+20,yp-10,-100,min,max,0,1,0,10,0)
'right
spin(xp,yp-10,-200,xp+20,yp-10,-100,min,max,0,1,0,0,1)
'left
spin(xp,yp-10,-200,xp-20,yp-10,-100,min,max,0,1,0,0,2)
crossproduct(0)
crossX(1)=wx
surface(-1,-.9)
'draw string(5,5),str(cpu),rgb(0,0,0)
case 2'______________________________________________________________
' nose cone lower
min=-4
max=4
'bottom
shader=sgn(crossX(2))*shader
nct=rgb(230+shader,31+shader,31+shader)
spin(xp-20,yp+20,-120,xp+20,yp+20,-120,min,max,0,1,0,10,0)
'left
spin(xp,yp-10,-200,xp-20,yp+20,-120,min,max,0,1,0,0,1)
'right
spin(xp,yp-10,-200,xp+20,yp+20,-120,min,max,0,1,0,0,2)
crossproduct(0)
crossX(2)=wx
surface(-1,-.9)
case 3'_______________________________________________________________
'nose cone side(left)
min=-4
max=4
'left vertical
shader=sgn(crossX(3))*shader
nct=rgb(230+shader,30+shader,31+shader)
spin(xp-20,yp-10,-100,xp-20,yp+20,-120,min,max,1,0,0,10,0)
'left side sloping up
spin(xp,yp-10,-200,xp-20,yp-10,-100,min,max,1,0,0,0,1)
'left side sloping down
spin(xp,yp-10,-200,xp-20,yp+20,-120,min,max,1,0,0,0,2)
crossproduct(0)
crossX(3)=wx
surface(-1,-.9)
case 4'______________________________________________________________
'nose cone side (right)
min=-4
max=4
'right vertical
shader=sgn(crossX(4))*shader
nct=rgb(230+shader,31+shader,30+shader)
spin(xp+20,yp-10,-100,xp+20,yp+20,-120,min,max,1,0,0,10,0)
'right side sloping down
spin(xp,yp-10,-200,xp+20,yp+20,-120,min,max,1,0,0,0,1)
'right side sloping up
spin(xp,yp-10,-200,xp+20,yp-10,-100,min,max,1,0,0,0,2)
crossproduct(0)
crossX(4)=wx
surface(-1,-.9)
case 5'______________________________________________________________
'fuselage top panel
min=-3
max=3
shader=sgn(crossX(5))*shader
nct=rgb(199+shader,100+shader,100+shader)
'top,front of fuselage top panel and top of window
spin(xp-20,yp-30,-90,xp+20,yp-30,-90,min,max,0,1,0,10,0)
'left to back and along fuselage left wings
spin(xp-20,yp-30,-90,xp-15,yp-30,10,min,max,0,1,0,0,1)
'right to back
spin(xp+20,yp-30,-90,xp+15,yp-30,10,min,max,0,1,0,0,2)
'back
spin(xp-15,yp-30,10,xp+15,yp-30,10,min,max,0,1,0,10,0)
crossproduct(0)
crossX(5)=wx
surface(-1,.02)
case 6'______________________________________________________________
'window
min=-2
max=2
shader=(sgn(crossX(6))*shader)
' top, and front of fuselage top panel
nct=rgb(50+shader,50+shader,50+shader)
spin(xp-20,yp-30,-90,xp+20,yp-30,-90,min,max,0,0,1,10,0)
'left side
spin(xp-20,yp-30,-90,xp-20,yp-10,-100,min,max,0,0,1,0,1)
'right side
spin(xp+20,yp-30,-90,xp+20,yp-10,-100,min,max,0,0,1,10,0)
'base
spin(xp-20,yp-10,-100,xp+20,yp-10,-100,min,max,0,0,1,0,2)
crossproduct(0)
crossX(6)=wx
if -1*wz>.05 then Paint (cx,cy),rgba(0,0,200,100),nct
action(k)="linepoint"
surface(-1,.02)
case 7'_____________________________________________________________
'fuselage bottom panel
min=-3
max=3
shader=sgn(crossX(7))*shader
nct=rgb(50+shader,50+shader,50+shader)
'front , same as nose bottom back
spin(xp-20,yp+20,-120,xp+20,yp+20,-120,min,max,0,1,0,10,0)
'back under top panel
spin(xp-15,yp+20,10,xp+15,yp+20,10,min,max,0,1,0,10,0)
'left to back
spin(xp-20,yp+20,-120,xp-15,yp+20,10,min,max,0,1,0,0,1)
'right to back
spin(xp+20,yp+20,-120,xp+15,yp+20,10,min,max,0,1,0,0,2)
crossproduct(0)
crossX(7)=-wx
surface(1,.02)
case 8'____________________________________________________________
'fuselage side panel left
min=-3
max=3
shader=sgn(crossX(8))*shader
nct=rgb(231+shader,130+shader,30+shader)
'top,same as bottom left wing along fuselage
spin(xp-20,yp-30,-75,xp-15,yp-30+2,10,min,max,1,0,0,10,0)
'front vertical,same as nose cone left vertical+window
spin(xp-20,yp+20,-120,xp-20,yp-10,-90,min,max,1,0,0,0,1)
'backvertical
spin(xp-15,yp+20,10,xp-15,yp-30,10,min,max,1,0,0,0,2)
'base back to front
spin(xp-15,yp+20,10,xp-20,yp+20,-120,min,max,1,0,0,10,0)
spin(xp-20,yp-30,-75,xp-20,yp-10,-90,min,max,1,0,0,10,0)
crossproduct(0)
crossX(8)=-wx
surface(1,.02)
'window edge
rotate(px,py,pz,xp-20,yp-30,-90,xp-20,yp-10,-100,ax,ay,az,1,di,rgb(0,0,0),1,"line","3d",p)
case 9'____________________________________________________________
'fuselage side panel right
min=-3
max=3
shader=sgn(crossX(9))*shader
nct=rgb(230+shader,130+shader,30+shader)
'top
spin(xp+20,yp-30,-75,xp+15,yp-30+2,10,min,max,1,0,0,10,0)
'front vertical
spin(xp+20,yp+20,-120,xp+20,yp-10,-90,min,max,1,0,0,0,1)
'back vertical
spin(xp+15,yp+20,10,xp+15,yp-30,10,min,max,1,0,0,0,2)
'base
spin(xp+15,yp+20,10,xp+20,yp+20,-120,min,max,1,0,0,10,0)
spin(xp+20,yp-30,-75,xp+20,yp-10,-90,min,max,1,0,0,10,0)
crossproduct(0)
crossX(9)=wx
surface(-1,.02)
'window edge
rotate(px,py,pz,xp+20,yp-30,-90,xp+20,yp-10,-100,ax,ay,az,1,di,rgb(0,0,0),1,"line","3d",p)
case 10'___________________________________________________________
'aft fuselage base panel
min=-5
max=5
shader=sgn(crossX(10))*shader
nct=rgb(210+shader,210+shader,100+shader)
'front
spin(xp-15,yp+20,10,xp+15,yp+20,10,min,max,0,1,0,10,0)
'left side
spin(xp-15,yp+20,10,xp-3,yp+10,250,min,max,0,1,0,0,1)
'right side
spin(xp+15,yp+20,10,xp+3,yp+10,250,min,max,0,1,0,0,2)
'back
spin(xp-3,yp+10,250,xp+3,yp+10,250,min,max,0,1,0,10,0)
crossproduct(0)
crossX(10)=-wx
rotate(px,py,pz,xp-15,yp+19,34,xp+15,yp+19,34,ax,ay,az,1,di,rgb(0,0,0),1,"linepoint","3d",p)
cx=(np(1)+np(4))/2:cy=(np(2)+np(5))/2
surface(1,.03)
case 11'__________________________________________________________
'left wing upper
min=-3
max=3
shader=sgn(crossX(11))*shader
nct=rgb(200+shader,100+shader,100+shader)
' front
spin(xp-300,yp-30,-90,xp-20,yp-30,-90,min,max,0,1,0,0,1)
'along fuselage
spin(xp-20,yp-30,-90,xp-15,yp-30,10,min,max,0,1,0,10,0)
'wing end
spin(xp-300,yp-30,-90,xp-295,yp-30,-10,min,max,0,1,0,10,0)
'wing rear
spin(xp-295,yp-30,-10,xp-15,yp-30,10,min,max,0,1,0,0,2)
crossproduct(0)
crossX(11)=wx
surface(-1,.01)
case 12'__________________________________________________________
'left wing lower
min=-3
max=3
shader=-sgn(crossX(12))*shader
nct=rgb(205+shader,205+shader,205+shader)
'front
spin(xp-300,yp-30+2,-90,xp-20,yp-30+2,-90,min,max,0,1,0,0,1)
'along fuselage
spin(xp-20,yp-30+2,-90,xp-15,yp-30+2,10,min,max,0,1,0,10,0)
'wing end
spin(xp-300,yp-30+2,-90,xp-295,yp-30+2,-10,min,max,0,1,0,10,0)
'wing rear
spin(xp-295,yp-30+2,-10,xp-15,yp-30+2,10,min,max,0,1,0,0,2)
crossproduct(0)
crossX(12)=wx
surface(1,.01)
case 13'____________________________________________________________
'right wing upper
min=-3
max=3
shader=-sgn(crossX(13))*shader
nct=rgb(201+shader,100+shader,100+shader)
' front
spin(xp+300,yp-30,-90,xp+20,yp-30,-90,min,max,0,1,0,0,1)
'along fuselage
spin(xp+20,yp-30,-90,xp+15,yp-30,10,min,max,0,1,0,10,0)
'wing end
spin(xp+300,yp-30,-90,xp+295,yp-30,-10,min,max,0,1,0,10,0)
'wing rear
spin(xp+295,yp-30,-10,xp+15,yp-30,10,min,max,0,1,0,0,2)
crossproduct(0)
crossX(13)=wx
surface(1,.01)
case 14'_____________________________________________________________
'right wing lower
min=-3
max=3
shader=sgn(crossX(14))*shader
nct=rgb(204+shader,205+shader,205+shader)
'front
spin(xp+300,yp-30+2,-90,xp+20,yp-30+2,-90,min,max,0,1,0,0,1)
'along fuselage
spin(xp+20,yp-30+2,-90,xp+15,yp-30+2,10,min,max,0,1,0,10,0)
'wing end
spin(xp+300,yp-30+2,-90,xp+295,yp-30+2,-10,min,max,0,1,0,10,0)
'wing rear
spin(xp+295,yp-30+2,-10,xp+15,yp-30+2,10,min,max,0,1,0,0,2)
crossproduct(0)
crossX(14)=wx
surface(-1,.01)
case 15'_____________________________________________________________
'tail wing left upper
min=-3
max=3
shader=-sgn(crossX(15))*shader
nct=rgb(201+shader,100+shader,100+shader)
'front
spin(xp+100,yp,250,xp+3,yp,250,min,max,0,1,0,0,1)
'along fuselage
spin(xp+3,yp,250,xp,yp,300,min,max,0,1,0,10,0)
'wing end
spin(xp+100,yp,250,xp+100,yp,290,min,max,0,1,0,10,0)
'wing rear
spin(xp+100,yp,290,xp,yp,300,min,max,0,1,0,0,2)
crossproduct(0)
crossX(15)=wx
surface(1,.02)
case 16'_________________________________________________________________
'tail wing left lower
min=-3
max=3
shader=sgn(crossX(16))*shader
nct=rgb(204+shader,205+shader,205+shader)
'front
spin(xp+100,yp+2,250,xp+3,yp+2,250,min,max,0,1,0,0,1)
'along fuselage
spin(xp+3,yp+2,250,xp,yp+2,300,min,max,0,1,0,10,0)
'wing end
spin(xp+100,yp+2,250,xp+100,yp+2,290,min,max,0,1,0,10,0)
'wing rear
spin(xp+100,yp+2,290,xp,yp+2,300,min,max,0,1,0,0,2)
crossproduct(0)
crossX(16)=wx
surface(-1,.02)
case 17'___________________________________________________________________
'tail wing right upper
min=-3
max=3
shader=sgn(crossX(17))*shader
nct=rgb(201+shader,100+shader,100+shader)
'front
spin(xp-100,yp,250,xp-3,yp,250,min,max,0,1,0,0,1)
'along fuselage
spin(xp-3,yp,250,xp,yp,300,min,max,0,1,0,10,0)
'wing end
spin(xp-100,yp,250,xp-100,yp,290,min,max,0,1,0,10,0)
'wing rear
spin(xp-100,yp,290,xp,yp,300,min,max,0,1,0,0,2)
'edge(2)
crossproduct(0)
crossX(17)=wx
surface(-1,.02)
case 18'______________________________________________________________
'tail wing right lower
min=-3
max=3
shader=sgn(crossX(18))*shader
nct=rgb(204+shader,205+shader,205+shader)
'front
spin(xp-100,yp+2,250,xp-3,yp+2,250,min,max,0,1,0,0,1)
'along fuselage
spin(xp-3,yp+2,250,xp,yp+2,300,min,max,0,1,0,10,0)
'wing end
spin(xp-100,yp+2,250,xp-100,yp+2,290,min,max,0,1,0,10,0)
'wing rear
spin(xp-100,yp+2,290,xp,yp+2,300,min,max,0,1,0,0,2)
crossproduct(0)
crossX(18)=-wx
surface(1,.02)
case 19'________________________________________________________________
'fin
min=-3
max=3
shader=sgn(crossX(19))*shader
nct=rgb(0,200+shader,0)
'along fuselage
spin(xp,yp-3,250,xp,yp,300,min,max,1,0,0,10,0)
'front
spin(xp,yp-3,250,xp,yp-60,270,min,max,1,0,0,0,1)
'top
spin(xp,yp-60,270,xp,yp-60,290,min,max,1,0,0,10,0)
'back
spin(xp,yp-60,290,xp,yp,300,min,max,1,0,0,0,2)
crossproduct(0)
crossX(19)=-wx*wz
action(k)="line"
surface(sgn(wz),0)
case 20'_________________________________________________________________
'aft fuselage left panel
min=-3
max=3
shader=-sgn(crossX(20))*shader
nct=rgb(64+shader,46+shader,220+shader)
'front vertical
spin(xp-15,yp+20,10,xp-15,yp-30,10,min,max,1,0,0,10,0)
'top
spin(xp-15,yp-30,10,xp-3,yp,250,min,max,1,0,0,0,1)
'bottom
spin(xp-15,yp+20,10,xp-3,yp+10,250,min,max,1,0,0,0,2)
'back edge
spin(xp-3,yp,250,xp-3,yp+10,250,min,max,1,0,0,10,0)
crossproduct(0)
crossX(20)=wx
rotate(px,py,pz,xp-13.8,yp-30,34,xp-13.8,yp+20,34,ax,ay,az,1,di,rgb(0,0,0),1,"linepoint","3d",p)
cx=(np(1)+np(4))/2:cy=(np(2)+np(5))/2
surface(1,.02)
case 21'________________________________________________________________
'aft fuselage right panel
shader=-sgn(crossX(21))*shader
nct=rgb(65+shader,46+shader,220+shader)
min=-3
max=3
'front vertical
spin(xp+15,yp+20,10,xp+15,yp-30,10,min,max,1,0,0,10,0)
'top
spin(xp+15,yp-30,10,xp+3,yp,250,min,max,1,0,0,0,1)
'edge(1)
'bottom
spin(xp+15,yp+20,10,xp+3,yp+10,250,min,max,1,0,0,0,2)
'back edge
spin(xp+3,yp,250,xp+3,yp+10,250,min,max,1,0,0,10,0)
crossproduct(0)
crossX(21)=-wx
rotate(px,py,pz,xp+13.8,yp-30,34,xp+13.8,yp+20,34,ax,ay,az,1,di,rgb(0,0,0),1,"linepoint","3d",p)
cx=(np(1)+np(4))/2:cy=(np(2)+np(5))/2
surface(-1,.02)
case 22'_________________________________________________________________
'aft fuselage top
min=-4
max=4
shader=-sgn(crossX(21))*shader
nct=rgb(176+shader,54+shader,176+shader)
'front
spin(xp-15,yp-30,10,xp+15,yp-30,10,min,max,0,1,0,10,0)
'aft fuselage top left front to back
spin(xp-15,yp-30,10,xp-3,yp,250,min,max,0,1,0,0,1)
'aft fuselage base right front to back
spin(xp+15,yp-30,10,xp+3,yp,250,min,max,0,1,0,0,2)
'back
spin(xp-3,yp,250,xp+3,yp,250,min,max,0,1,0,10,0)
crossproduct(0)
crossX(22)=wx
rotate(px,py,pz,xp-15,yp-27,34,xp+15,yp-27,34,ax,ay,az,1,di,rgb(0,0,0),1,"linepoint","3d",p)
cx=(np(1)+np(4))/2:cy=(np(2)+np(5))/2
surface(-1,.02)
case 23'________________________________________________________________
'fin under tail
min=-3
max=3
shader=sgn(crossX(23))*shader
nct=rgb(0,200+shader,0)
'front
spin(xp,yp,250,xp,yp+10,250,min,max,1,0,0,10,0)
'top
spin(xp,yp,250,xp,yp,300,min,max,1,0,0,0,1)
'back
spin(xp,yp,300,xp,yp+20,310,min,max,1,0,0,10,0)
'base
spin(xp,yp+20,310,xp,yp+10,250,min,max,1,0,0,0,2)
crossproduct(0)
crossX(23)=-wx*wz
action(k)="line"
surface(sgn(wz),0)
case 24
'toad
rotate(px,py,pz,xp-5,yp-15,-82,xp+5,yp-15,-82,ax,ay,az,1,di,rgb(255,0,0),1,"line","3d",p)
rotate(px,py,pz,xp-3,yp-20,-82,xp+3,yp-20,-82,ax,ay,az,1,di,rgb(255,0,255),1,"line","3d",p)
edge(1)
edge(2)
cz(k,k)=cz(k,k)+80
toad=3*(di-.65)/.3+3
circle(np(4),np(5)+5),toad,rgb(20,20,20),,,,F
circle(np(4),np(5)+3),toad,rgb(178,95,12),,,,F
end select
next count
screenunlock
sleep 1,1
For n As Integer=1 To f:paint_order(n)=n:Next n
zsort(f)
if inkey=chr(27) then
destroy=1
end if
loop
end sub 'glide
sub make_sky
dim as integer r,b,g,r1,b1,g1,r2,b2,g2,x2
x2=y-10
r1=99
g1=127
b1=192
r2=170
g2=201
b2=241
for row as double=0 to x2 step .5
r=(r2-r1)*row/x2+r1
b=(b2-b1)*row/x2+b1
g=(g2-g1)*row/x2+g1
line im,(0,row)-(x,row),rgb(r,g,b)
next row
cloud(700,500,20,Rnd*30,5)
cloud(800,500,20,Rnd*30,5)
cloud(900,500,20,Rnd*30,5)
cloud(1000,500,20,Rnd*30,5)
cloud(500,380,20,Rnd*30,5)
cloud(320,140,150,250,1)
end sub
sub draw_sky
put (0,0),im,pset
end sub
Sub cloud(x As Integer, y As Integer,length As Integer=100,alpha As Integer=105, Zoom As Single = 0)
dim as integer r=255
dim as integer b=255
dim as integer g=255
dim as double pi=3.14159
cl=cl+1
if cl mod 100000=0 then
p8=p8+1
draw string(250+8*p8,500),"*",rgb(0,0,255)
end if
If Length<=1 Or Alpha<=1 Then Exit Sub
dim as single rnded = -pi+Rnd*1*pi/2
dim as single rnded2 = -pi+Rnd*-3*pi
If alpha<25 Then
For i As Integer = 0 To 255-alpha Step 100
Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded*PI/3),y+Length/6+length*Sin(-pi/2+rnded*PI/3)),rgba(R,G,B,alpha)
Line im,(-(Zoom/2)+x-length/2,y)-((Zoom/2)+x+Length/6+length*Cos(-pi/2+rnded2*PI/3),y+Length/6+length*Sin(pi/2+rnded2*PI/3)),rgba(R,G,B,alpha)
Next
End If
cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded*PI/3),(Zoom/2)+y+length*Sin(-pi/2+rnded*PI/3),length/1.4,Alpha/1.2,Zoom)
cloud(-(Zoom/2)+x+length*Cos(-pi/2+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi/2+rnded2*PI/3),length/1.4,Alpha/1.2,Zoom)
cloud(-(Zoom/2)+x+length*Cos(pi/3+rnded2*PI/3),(Zoom/2)+y+length*Sin(pi+rnded2*PI/3),length/1.4,Alpha/2,Zoom)
End Sub
sub make_hills 'polynomials
dim as double pol(7),pol2(3)
dim as double g0
pol(0)=700
pol(1)=-0.361924603174595
pol(2)=1.795284391534293e-003
pol(3)=-1.579761904761521e-006
pol(4)= -2.092592592593197e-009
pol(5)=2.936507936508318e-012
pol(6)=-7.27513227513298e-016
pol2(0)= 1100
pol2(1)=-2.66428571428572
pol2(2)=4.523809523809536e-003
pol2(3)=-2.14285714285715e-006
dim peak as double=650
dim count as double
dim copyg0 as double
dim as integer r,b,g,r1,b1,g1,r2,b2,g2
r1=0
g1=149
b1=0
r2=186
g2=126
b2=5
for n as double=0 to 1026 step .5
g0=-70*polygradient(pol2(),n)
for m as double=y-count to poly(pol2(),n) step -1
count=count+1
r=(r2-r1)*(m-y)/(peak-y)+r1
g=(g2-g1)*(m-y)/(peak-y)+g1
b=(b2-b1)*(m-y)/(peak-y)+b1
if r>g0 then r=r-g0
if g>g0 then g=g-g0
if b>g0 then b=b-g0
line im,(n,m)-(n,poly(pol2(),n)),rgb(r,g,b)
next m
count=0
next n
for n as double=0 to 1026 step .5
g0=-180*polygradient(pol(),n)
line im,(n,y)-(n,poly(pol(),n)),rgb(0,149-g0,0)
next n
'trees
dim as ulong treecol
dim as double pivx,pivy,pivz,l,da,dif,k
dim shader as integer =50
'pines on far hill
for m as double=0 to 50 step 3
randomize m
for n as double=455-(m+rnd_range(2,20)) to 620-m step rnd_range(1,3)
randomize n^2
l=rnd_range(3,9)
k=rnd_range(1,5)
pivx=n
pivy=poly(pol2(),n)+k+m-8
pivz=0
g0=-80*polygradient(pol2(),n)
line im,(pivx,pivy)-(pivx+rnd_range(-2,2),pivy+8),rgb(44-g0,35-g0,37)
for a as double=75 to 105 step 5
r=80+shader:if r>20 then r=r-20
g=150-g0+shader:if g>40 then g=g-40
b=50+shader:if b>20 then b=b-20
treecol=rgb(r,g,b)
shader=20
rotate(pivx,pivy,pivz,pivx,pivy,pivz,pivx+l,pivy,pivz,0,0,a,1,1,treecol,1,"line","2d",0,im)
dif=np(1)-np(4)
shader=sgn(dif)*shader
next a
next n
next m
p8=p8+1
draw string(250+8*p8,500),"*",rgb(0,0,255)
'broadleaf right lower hill
for m as double=0 to 50 step 10
randomize m
for n as double=725-(m+rnd_range(2,20)) to 990+m step rnd_range(3,9)
randomize n^2
l=rnd_range(2,11)
k=rnd_range(1,5)
pivx=n
pivy=poly(pol(),n)+k+m
pivz=0
g0=-100*polygradient(pol(),n)
line im,(pivx,pivy)-(pivx+rnd_range(-2,2),pivy+8),rgb(144-g0,35-g0,37)
dim cc as double=rnd_range(1,40)
for a as double=90 to 450 step 7
randomize a
shader=-rnd_range(2,4)
r=20+shader+cc
g=130-g0+shader:if g>40 then g=g-40
b=20+shader:if b>20 then b=b-20
treecol=rgb(r,g,b)
for a2 as double=0 to l step .3
if a>270 then shader=-shader
treecol=rgb(r,g-a2*shader,b)
rotate(pivx,pivy,pivz,pivx-a2,pivy,pivz,pivx-l,pivy,pivz,0,0,a,1,1,treecol,1,"line","2d",0,im)
next a2
next a
next n
next m
p8=p8+1
draw string(250+8*p8,500),"*",rgb(0,0,255)
for m as double=0 to 50 step 10
randomize m
for n as double=70-(m+rnd_range(2,50)) to 385+m step rnd_range(3,9)
randomize n^2
l=rnd_range(3,13)
k=rnd_range(1,5)
pivx=n
pivy=poly(pol(),n)+k+m
pivz=0
g0=-90*polygradient(pol(),n)
line im, (pivx,pivy)-(pivx+rnd_range(-2,2),pivy+8),rgb(144-g0,35-g0,37)
dim cc as double=rnd_range(0,15)
for a as double=135 to 405 step 5
randomize a
shader=rnd_range(2,4)'2
r=20+shader+cc
g=90-g0+shader
b=20+shader:if b>20 then b=b-20
treecol=rgb(r,g,b)
for a2 as double=0 to l step .3
if a>270 then shader=-shader
treecol=rgb(r,g-a2*shader,b)
rotate(pivx,pivy,pivz,pivx+a2,pivy,pivz,pivx+l,pivy,pivz,0,0,a,1,1,treecol,1,"line","2d",0,im)
next a2
next a
next n
next m
p8=p8+1
draw string(250+8*p8,500),"*",rgb(0,0,255)
'pines
dim delta as double
for m as double=0 to 50 step 10
randomize m
delta=delta+.5
for n as double=455-(m+rnd_range(2,50)) to 620+m step rnd_range(3,6)+delta
randomize n^2
l=rnd_range(9,30)
k=rnd_range(1,5)
pivx=n
pivy=poly(pol(),n)+k+m-10
pivz=0
g0=-80*polygradient(pol(),n)
line im, (pivx,pivy)-(pivx+rnd_range(-2,2),pivy+20),rgb(44-g0,35-g0,37)
for a as double=75 to 105 step 5
r=60+shader:if r>20 then r=r-20
g=130-g0+shader:if g>40 then g=g-40
b=30+shader:if b>20 then b=b-20
treecol=rgb(r,g,b)
shader=20
rotate(pivx,pivy,pivz,pivx,pivy,pivz,pivx+l,pivy,pivz,0,0,a,1,1+delta,treecol,1,"line","2d",0,im)
dif=np(1)-np(4)
shader=sgn(dif)*shader
next a
next n
next m
p8=p8+1
draw string(250+8*p8,500),"*",rgb(0,0,255)
'broadwood on hilltop
for m as double=0 to 10 step 2
randomize m
for n as double=380+(m+rnd_range(2,20)) to 410-m step rnd_range(1,2)
randomize n^2
l=rnd_range(2,4)
k=rnd_range(1,2)
pivx=n
pivy=poly(pol2(),n)+k+m-5
pivz=0
g0=-50*polygradient(pol2(),n)
line im,(pivx,pivy)-(pivx+rnd_range(-2,2),pivy+4),rgb(144-g0,35-g0,37)
for a as double=-180 to 0 step 5
r=80+shader:if r>20 then r=r-20
g=150-g0+shader:if g>40 then g=g-40
b=50+shader:if b>20 then b=b-20
treecol=rgb(r,g,b)
shader=20
rotate(pivx,pivy,pivz,pivx,pivy,pivz,pivx+l,pivy,pivz,0,0,a,1,1,treecol,1,"line","2d",0,im)
dif=np(1)-np(4)
shader=sgn(dif)*shader
next a
next n
next m
p8=p8+1
draw string(250+8*p8,500),"*",rgb(0,0,255)
'pines on far left far hill
for m as double=0 to 50 step 3
randomize m
for n as double=263+(m+rnd_range(2,20)) to 350+m step rnd_range(1,3)
randomize n^2
l=rnd_range(3,9)
k=rnd_range(1,5)
pivx=n
pivy=poly(pol2(),n)+k+m-8
pivz=0
g0=-50*polygradient(pol2(),n)
line im,(pivx,pivy)-(pivx+rnd_range(-2,2),pivy+8),rgb(44-g0,35-g0,37)
for a as double=75 to 105 step 5
r=80+shader:if r>20 then r=r-20
g=150-g0+shader:if g>40 then g=g-40
b=50+shader:if b>20 then b=b-20
treecol=rgb(r,g,b)
shader=20
rotate(pivx,pivy,pivz,pivx,pivy,pivz,pivx+l,pivy,pivz,0,0,a,1,1,treecol,1,"line","2d",0,im)
dif=np(1)-np(4)
shader=sgn(dif)*shader
next a
next n
next m
p8=p8+1
draw string(250+8*p8,500),"*",rgb(0,0,255)
screenunlock
end sub
Function poly(coff() As double,number As double)As double
Dim count As Integer 'evaluates the polynomial
Dim pol As double
Dim deg As Integer=Ubound(coff)
pol = 0
For count = 1 To DEG + 1
pol = pol + coff(count-1) * ((number) ^ (count - 1))
Next count
poly = pol
End Function
Function polygradient(coff() As double,number As double) As double
Dim count As Integer 'evaluates dy/dx i.e. (gradient)
Dim pol As double
Dim standin As double
Dim deg2 As Integer=Ubound(coff)
pol = 0
For count = 1 To deg2
If count >= 1 Then
standin = number ^ (count-1 )
End If
pol = pol + (count ) * coff(count) * standin
Next count
polygradient = pol
End Function
Function rnd_range (first As Double, last As Double) As Double
Function = Rnd * (last - first) + first
End Function
function setcpu() as double
dim t1 as double=timer
dim a as double
dim s as double=5
do
screenlock
cls
a=a+s
rotate(x/2,y/2,0,x/2-100,y/2,0,x/2+100,y/2,0,a,a,a,1,1,rgb(200,200,200),10,"line","2d")
rotate(x/2,y/2,0,x/2,y/2,0,105,1,0,a,a,a,1,1,rgb(200,200,200),10,"circle","2d")
draw string(400,10),"Adjusting for cpu speed",rgb(255,0,0)
screenunlock
sleep 1,1
loop until a>720-s
dim t2 as double=timer
return (t2-t1)/2
end function
glide
end