global height as integer
global weight as integer
height=desktop WIDTH()
weight=desktop HEIGHT()
bit=SCREEN DEPTH()
height2=height/2:weight2=weight/2: SET DISPLAY MODE height,weight,bit
POSITION MOUSE height2,weight2:`HIDE MOUSE
backdrop on
SET TEXT FONT "ms serif"
SET TEXT SIZE 12
`--------------------------------------------------------------------------------------------------------------------
`--------------------------------------------------------------------------------------------------------------------
`--------------------------------------------------------------------------------------------------------------------
D3D_Init

D3D_Font 2,"Arial",11,0,0,1
D3D_Color 255,255,255,255
set camera range 1,52000

`*************************************************************


Type Point1
    Name As String
    X As float
    Y As float
    Z As float
EndType

Type Edge
    Pt1 As Integer
    Pt2 As Integer
EndType

Type Face
    Pt1 As Integer
    Pt2 As Integer
    Pt3 As Integer
EndType

Type Triangle
    Pt1 As Integer
    Pt2 As Integer
    Pt3 As Integer
EndType

global Dim m_Points() As Point1
global Dim m_Edges() As Edge
global Dim m_Faces() As Face
global Dim m_Triangles() As Triangle


`**************************************************************

global S as double float


global t1 As float
global t2 As float
global t3 As float
global t4 As float
global R As double float
global H As float
global Cx As float
global Cy As float
global H1 As float
global H2 As float
global Z1 As float
global Z2 As float

i As Integer
global rad as float


global x as float
global y as float
global z as float


global num_faces As Integer
global num_points As Integer
global dist As float

global Pi1 as double float
`**************************************************
LineColor=D3D_RGBA(255,0,0,255) `ÒÎ×ÊÈ

sync on:sync rate 100

` print
` print
 
` paste image 1,450,0

S = 100.0
 
` Pi1=3.14159265
 rad=57.295`53.6
` print pi1/5
` print sin(pi1/5)
` print s/2.0
` print (s/2.0)/sin((pi1/5)*57.3)

    ` Calculate intermediate values.
    t1 = 2.0 * Pi() / 5.0:                       `print "1 ";t1
    t2 = Pi() / 10.0:                          `print "2 ";t2
    t4 = (Pi() / 5.0):                          ` print "3 ";t4    
    t3 = (-3.0 * Pi()) / 10.0:                  ` print "4 ";t3   
     
`    R = (((S / 2.0))) / (Sin(t4)):                  print "5 ";R    
    R = (((S / 2.0))) / (Sin(t4)*rad):                `  print "5 ";R
    
    H = Cos(t4*rad) * R:                       ` print "6 ";H
    Cx = R * Cos(t2*rad):                      ` print "7 ";Cx
    Cy = R * Sin(t2*rad):                     `  print "8 ";Cy    
    Z2 = 1.0

    H1 = Sqrt(S * S - R * R):          ` print "9 ";H1
    H2 = Sqrt((H + R) * (H + R) - H * H):  ` print "10 ";H2    
    Z2 = (H2 - H1) / 2.0:                  `   print "11 ";Z2    
    Z1 = Z2 + H1:                          ` print "12 ";Z1    
   ` print

    ` Create the points.
    `Ôóíêöèè
` print  "POINT"    
    MakePoint("a", 0, 0, Z1)
    MakePoint("b", 0.0, R, Z2)
    MakePoint("c", Cx, Cy, Z2)
    MakePoint("d", S / 2.0, -H, Z2)
    MakePoint("e", -S / 2.0, -H, Z2)
    MakePoint("f", -Cx, Cy, Z2)
    MakePoint("g", 0.0, -R, -Z2)
    MakePoint("h", -Cx, -Cy, -Z2)
    MakePoint("i", -S / 2.0, H, -Z2)
    MakePoint("j", S / 2.0, H, -Z2)
    MakePoint("k", Cx, -Cy, -Z2)
    MakePoint("l", 0.0, 0.0, -Z1)
 `print  "FACE"
    ` Make the outwardly-oriented faces.
    MakeFace("a", "c", "b")
    MakeFace("a", "b", "f")
    MakeFace("a", "f", "e")
    MakeFace("a", "e", "d")
    MakeFace("a", "d", "c")
    MakeFace("c", "d", "k")
    MakeFace("c", "k", "j")
    MakeFace("c", "j", "b")
    MakeFace("b", "j", "i")
    MakeFace("b", "i", "f")
    MakeFace("f", "i", "h")
    MakeFace("f", "h", "e")
    MakeFace("e", "h", "g")
    MakeFace("e", "g", "d")
    MakeFace("d", "g", "k")
    MakeFace("l", "j", "k")
    MakeFace("l", "k", "g")
    MakeFace("l", "g", "h")
    MakeFace("l", "h", "i")
    MakeFace("l", "i", "j")
`print "End_face"

    For i = 1 To ARRAY COUNT(m_Faces())
 TileFace(i)
    Next i
`sync
` goto n1

`  print  "-----"
` print ARRAY COUNT(f()) `êîëè÷åñòâî ýëåìåíòîâ â ìàññèâå



`remstart
``hide light 0:set ambient light 0
`make light 1:position light 1,100,0,0:color light 1,rgb(0,255,0)
`make light 2:position light 2,-100,-100,0:color light 2,rgb(0,255,255)
`make light 3:position light 3,50,100,0:color light 3,rgb(255,0,0)

    For i = 1 To ARRAY COUNT(m_Triangles())
`    make object triangle i,m_Points(m_Triangles(i).Pt1).X,m_Points(m_Triangles(i).Pt1).Y,m_Points(m_Triangles(i).Pt1).Z,m_Points(m_Triangles(i).Pt2).X,m_Points(m_Triangles(i).Pt2).Y,m_Points(m_Triangles(i).Pt2).Z,m_Points(m_Triangles(i).Pt3).X,m_Points(m_Triangles(i).Pt3).Y,m_Points(m_Triangles(i).Pt3).Z
    make object triangle i,m_Points(m_Triangles(i).Pt2).X,m_Points(m_Triangles(i).Pt2).Y,m_Points(m_Triangles(i).Pt2).Z,m_Points(m_Triangles(i).Pt1).X,m_Points(m_Triangles(i).Pt1).Y,m_Points(m_Triangles(i).Pt1).Z,m_Points(m_Triangles(i).Pt3).X,m_Points(m_Triangles(i).Pt3).Y,m_Points(m_Triangles(i).Pt3).Z
    set object normals i
    next i

mesh=0
    make object box 1000,0,0,0:position object 1000,50,0,0
    For i = 1 To ARRAY COUNT(m_Triangles())
      inc mesh
      make mesh from object mesh,i
      add limb 1000,mesh,mesh
      COLOR LIMB 1000, mesh, rgb(rnd(255),rnd(255),rnd(255))

    next
    
    
    position camera 0,0,0
move camera -500
point camera 0,0,0

    
`remend

do
    ` Make faces for the triangles.
    For i = 1 To ARRAY COUNT(m_Triangles())
      `    D3D_Line3D mx1#,my1#,mz1#,mx2#,my2#,mz2#,LineColor,LineColor, 0
      
        D3D_Line3d m_Points(m_Triangles(i).Pt1).X, m_Points(m_Triangles(i).Pt1).Y,m_Points(m_Triangles(i).Pt1).Z,m_Points(m_Triangles(i).Pt2).X, m_Points(m_Triangles(i).Pt2).Y,m_Points(m_Triangles(i).Pt2).z,LineColor,LineColor,1
        D3D_Line3d m_Points(m_Triangles(i).Pt2).X, m_Points(m_Triangles(i).Pt2).Y,m_Points(m_Triangles(i).Pt2).z,m_Points(m_Triangles(i).Pt3).X, m_Points(m_Triangles(i).Pt3).Y,m_Points(m_Triangles(i).Pt3).z,LineColor,LineColor,1
        D3D_Line3d m_Points(m_Triangles(i).Pt1).X, m_Points(m_Triangles(i).Pt1).Y,m_Points(m_Triangles(i).Pt1).z,m_Points(m_Triangles(i).Pt3).X, m_Points(m_Triangles(i).Pt3).Y,m_Points(m_Triangles(i).Pt3).z,LineColor,LineColor,1
`      print i;"=";m_Points(m_Triangles(i).Pt1).X;"--";m_Points(m_Triangles(i).Pt1).Y
`per=640
`        d3d_Line per + m_Points(m_Triangles(i).Pt1).X, per + m_Points(m_Triangles(i).Pt1).Y,per + m_Points(m_Triangles(i).Pt2).X, per + m_Points(m_Triangles(i).Pt2).Y
`        d3d_Line per + m_Points(m_Triangles(i).Pt2).X, per + m_Points(m_Triangles(i).Pt2).Y,per + m_Points(m_Triangles(i).Pt3).X, per + m_Points(m_Triangles(i).Pt3).Y
`        d3d_Line per + m_Points(m_Triangles(i).Pt1).X, per + m_Points(m_Triangles(i).Pt1).Y,per + m_Points(m_Triangles(i).Pt3).X, per + m_Points(m_Triangles(i).Pt3).Y
`        Print i; " 1="; m_Points(m_Triangles(i).Pt1).X; "-"; m_Points(m_Triangles(i).Pt1).Y; "    2="; m_Points(m_Triangles(i).Pt2).X; "-"; m_Points(m_Triangles(i).Pt2).Y; "   3="; m_Points(m_Triangles(i).Pt3).X; "-"; m_Points(m_Triangles(i).Pt3).Y
`        sync
    Next i

n1:

 set cursor 0,0
 print screen fps()
 gosub camera
 
sync

loop
`wait key
end




` Add an Face to the m_Faces array.
function MakeFace(name1$,name2$,name3$)

num_faces=0
    num_faces = ARRAY COUNT(m_Faces())
    if num_faces=-1 then num_faces=1: goto nn2
    num_faces = num_faces + 1
nn2:
    Dim m_Faces(num_faces)

        m_Faces(num_faces).Pt1 = FindPointByName(name1$)
        m_Faces(num_faces).Pt2 = FindPointByName(name2$)
        m_Faces(num_faces).Pt3 = FindPointByName(name3$)
Endfunction




`ÒÎ×ÍÎ ÔÓÍÊÖÈß
` Add a point to the m_Points array.
Function MakePoint(new_name$,X,Y,Z)
num_points=0
    num_points = ARRAY COUNT(m_Points())
`    if ARRAY COUNT(m_Points())>71 then num_points=0

    if num_points=-1 then num_points=1: goto nn3
    num_points = num_points + 1
nn3:   
    Dim m_Points(num_points)

   i As Integer

`    print new_name$;
        m_Points(num_points).Name = new_name$
        m_Points(num_points).X = X
        m_Points(num_points).Y = Y
        m_Points(num_points).Z = Z

`Print ARRAY COUNT(m_Points()); "____";new_name$;"_";X;"_";Y;"_";Z

EndFunction num_points


remstart
`ÒÎ×ÍÎ ÔÓÍÊÖÈß
` Add a point to the m_Points array.
Function MakePoint(new_name$,X,Y,Z)
num_points=0
    ` Make room.
 `   On Error Resume Next
    num_points = ARRAY COUNT(m_Points())
`    if num_points<0 then num_points=1
    `Print ARRAY COUNT(m_Points());
    if ARRAY COUNT(m_Points())>71 then num_points=0
`    if ARRAY COUNT(m_Points())=0  then num_points=1 
 
   


   i As Integer
    `For i = 1 To 20
    print new_name$;
        m_Points(num_points).Name = new_name$
        m_Points(num_points).X = X
        m_Points(num_points).Y = Y
        m_Points(num_points).Z = Z
    `Next i
Print ARRAY COUNT(m_Points())
 num_points = num_points + 1
    Dim m_Points(num_points)
    
`    MakePoint = num_points
EndFunction num_points
remend

` Create a geodesic tiling for this face.
function TileFace(ii)
`TileFace:

LEVEL = 3`.0

x0 As float
y0 As float
z0 As float
v1x As float
v1y As float
v1z As float
v2x As float
v2y As float
v2z As float
base_name As String
p10 As Integer
p01 As Integer
p11 As Integer
i As Integer
    ` Get the Face's origin.
    
    For i = 1 To 12
        x0 = m_Points(m_Faces(ii).Pt1).X
        y0 = m_Points(m_Faces(ii).Pt1).Y
        z0 = m_Points(m_Faces(ii).Pt1).Z
    Next i


    ` Get the tiling's generating vectors.
    v1x = (m_Points(m_Faces(ii).Pt2).X - m_Points(m_Faces(ii).Pt1).X) / LEVEL
    v1y = (m_Points(m_Faces(ii).Pt2).Y - m_Points(m_Faces(ii).Pt1).Y) / LEVEL
    v1z = (m_Points(m_Faces(ii).Pt2).Z - m_Points(m_Faces(ii).Pt1).Z) / LEVEL
    v2x = (m_Points(m_Faces(ii).Pt3).X - m_Points(m_Faces(ii).Pt1).X) / LEVEL
    v2y = (m_Points(m_Faces(ii).Pt3).Y - m_Points(m_Faces(ii).Pt1).Y) / LEVEL
    v2z = (m_Points(m_Faces(ii).Pt3).Z - m_Points(m_Faces(ii).Pt1).Z) / LEVEL

    ` Generate the points.
    base_name = str$(m_Faces(ii).Pt1) + "-" + str$(m_Faces(ii).Pt2) + "-" + str$(m_Faces(ii).Pt1) + ":"
    p10 = MakeNormalizedPoint(base_name + "1,0", x0 + v1x, y0 + v1y, z0 + v1z)
    p01 = MakeNormalizedPoint(base_name + "0,1", x0 + v2x, y0 + v2y, z0 + v2z)
    p11 = MakeNormalizedPoint(base_name + "1,1", x0 + v1x + v2x, y0 + v1y + v2y, z0 + v1z + v2z)

    ` Make the triangles.
    MakeTriangle(m_Faces(ii).Pt1, p10, p01)
    MakeTriangle(p10, p11, p01)
    MakeTriangle(p10, m_Faces(ii).Pt2, p11)
    MakeTriangle(p01, p11, m_Faces(ii).Pt3)
`return
endfunction

` Add a Triangle to the m_Triangles array.
function MakeTriangle(Pt1,Pt2,Pt3)

num_triangles As Integer

    num_triangles = ARRAY COUNT(m_Triangles())

    if num_triangles=-1 then num_triangles=1: goto nn4
    num_triangles = num_triangles + 1
nn4:   

    Dim m_Triangles(num_triangles)

    i As Integer

        m_Triangles(num_triangles).Pt1 = Pt1
        m_Triangles(num_triangles).Pt2 = Pt2
        m_Triangles(num_triangles).Pt3 = Pt3
    
Endfunction





` Add a point to the m_Points array.
Function MakeNormalizedPoint(new_name$,X,Y,Z)
dist=0

    dist = Sqrt(X * X + Y * Y + Z * Z)
    X = X / dist * Z1
    Y = Y / dist * Z1
    Z = Z / dist * Z1

    MakeNormalizedPoint = MakePoint(new_name$, X, Y, Z)
EndFunction MakeNormalizedPoint






`*******************************************




























Function FindPointByName(point_name$)

i As Integer

    For i = 1 To ARRAY COUNT(m_Points())
        If m_Points(i).Name = point_name$` Then
            FindPointByName1 = i
            goto ex1
        EndIf
    Next i
ex1:    
EndFunction FindPointByName1






` Add an edge to the m_Edges array.
function MakeEdge(name1$, name2$)
`exitfunction
num_edges As Integer
    num_edges = ARRAY COUNT(m_Edges())


    if num_edges=-1 then num_edges=1: goto nn5
    num_edges = num_edges + 1
nn5:  

   Dim m_Edges(num_edges)
 
        m_Edges(num_edges).Pt1 = FindPointByName(name1$)
        m_Edges(num_edges).Pt2 = FindPointByName(name2$)
    
Endfunction




















































`--------------------------------------------------------------------------------------------------------------------
`--------------------------------------------------------------------------------------------------------------------
`--------------------------------------------------------------------------------------------------------------------
`========================================================================================
CAMERA:
`if shiftkey()=1
    Mx1=(MOUSEX()-(height/2))
    My1=(MOUSEY()-(weight/2))
    nn#=180
    if Mx1<-12 then TURN CAMERA LEFT 0,-Mx1/nn#
    if Mx1>12 then TURN CAMERA RIGHT 0,Mx1/nn#
    if My1<-12 then PITCH CAMERA UP 0,-My1/nn#
    if My1>12 then PITCH CAMERA DOWN 0,My1/nn#
    
    if mousecLick()=1 then move camera 10
    if mousecLick()=2 then move camera -10

`endif
return
`========================================================================================