WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy , pi
winx = WindowWidth
winy = WindowHeight
global black , red , green , yellow
global blue , magenta , cyan , white
global pink , purple , gray , orange
dim m( 26 * 4 * 4 ) , pnt( 256 , 2 ) , tri( 1000 , 13 ) , ry( 1000 )
for i = 1 to 1000
  ry( i ) = i
next i
global t.x1,t.y1,t.z1,t.x2,t.y2,t.z2,t.x3,t.y3,t.z3,t.kl
global t.lx,t.ly,t.lz
global tritel
t.x1 = 0
t.y1 = 1
t.z1 = 2
t.x2 = 3
t.y2 = 4
t.z2 = 5
t.x3 = 6
t.y3 = 7
t.z3 = 8
t.kl = 9
t.lx = 10
t.ly = 11
t.lz = 12

pi = atn( 1 ) * 4
black   = rgb(   0 ,   0 ,   0 )
red     = rgb( 255 ,   0 ,   0 )
green   = rgb(   0 , 255 ,   0 )
yellow  = rgb( 255 , 255 ,   0 )
blue    = rgb(   0 ,   0 , 255 )
magenta = rgb( 255 ,   0 , 255 )
cyan    = rgb(   0 , 255 , 255 )
white   = rgb( 255 , 255 , 255 )
pink    = rgb( 255 , 127 , 127 )
orange  = rgb( 255 , 127 ,   0 )
gray    = rgb( 127 , 127 , 127 )
purple  = rgb( 127 ,   0 , 127 )
nomainwin
global frame
open "triangle" for graphics as #m
  #m "trapclose [quit]"
  timer 250 , [tmr]
wait
[tmr]
  scan
  #m "fill black"
  tritel = 0
  call link 1 , 0,0,0 , frame,frame,0 , 0 , 0
  call setpoint 0 , -100 , -100 , -100
  call setpoint 1 , -100 , -100 , -100
  call setpoint 2 , -100 , -100 , -100
  call setpoint 3 , -100 , -100 , -100
  call d3 0 , 1 , 2 , red
  call d3 0 , 1 , 3 , blue
  call d3 0 , 2 , 3 , green
  call d3 1 , 2 , 3 , yellow
  call drawall
wait

''                                                 graphics

sub drawall
  for h = 1 to tritel - 1
    for l = 0 to h
      if tri( ry( h ) , t.lz ) < tri( ry( l ) , t.lz ) then
        q = ry( h )
        ry( h ) = ry( l )
        ry( l ) = q
      end if
    next l
  next h
  for i = 0 to tritel - 1
    x1 = tri( ry( i ) , t.x1 )
    y1 = tri( ry( i ) , t.y1 )
    z1 = tri( ry( i ) , t.z1 )
    x2 = tri( ry( i ) , t.x2 )
    y2 = tri( ry( i ) , t.y2 )
    z2 = tri( ry( i ) , t.z2 )
    x3 = tri( ry( i ) , t.x3 )
    y3 = tri( ry( i ) , t.y3 )
    z3 = tri( ry( i ) , t.z3 )
    kl = tri( ry( i ) , t.kl )
    lx = tri( ry( i ) , t.lx )
    ly = tri( ry( i ) , t.ly )
    lz = tri( ry( i ) , t.lz )
    a1 = winx / 2 + x1 / ( z1 + 1000 ) * 1000
    b1 = winy / 2 - y1 / ( z1 + 1000 ) * 1000
    a2 = winx / 2 + x2 / ( z2 + 1000 ) * 1000
    b2 = winy / 2 - y2 / ( z2 + 1000 ) * 1000
    a3 = winx / 2 + x3 / ( z3 + 1000 ) * 1000
    b3 = winy / 2 - y3 / ( z3 + 1000 ) * 1000
    call triangle a1 , b1 , a2 , b2 , a3 , b3 , kl
  next i
  #m "flush"
end sub

sub setpoint no , x , y , z
  if no < 0 or no > 255 then exit sub
  call spot x , y , z
  pnt( no , 0 ) = x
  pnt( no , 1 ) = y
  pnt( no , 2 ) = z
end sub

sub d3 p1 , p2 , p3 , kl

  if tritel >= 1000 then exit sub

  tri( tritel , t.x1 ) = pnt( p1 , 0 )
  tri( tritel , t.y1 ) = pnt( p1 , 1 )
  tri( tritel , t.z1 ) = pnt( p1 , 2 )
  tri( tritel , t.x2 ) = pnt( p2 , 0 )
  tri( tritel , t.y2 ) = pnt( p2 , 1 )
  tri( tritel , t.z2 ) = pnt( p2 , 2 )
  tri( tritel , t.x3 ) = pnt( p3 , 0 )
  tri( tritel , t.y3 ) = pnt( p3 , 1 )
  tri( tritel , t.z3 ) = pnt( p3 , 2 )
  tri( tritel , t.kl ) = kl
  z = ( pnt( p1, 2 ) + pnt( p2 , 2 ) + pnt( p3 , 2 ) ) / 3
  tri( tritel , t.led.z ) = z
  tritel = tritel + 1

end sub

sub triangle x1 , y1 , x2 , y2 , x3 , y3 , clr
  call setcolor clr
  if y1 = y2 then y1 = y1 - 1e-10
  if y2 = y3 then y3 = y3 + 1e-10
  if y1 > y3 then
    call swap y1 , y3
    call swap x1 , x3
  end if
  if y1 > y2 then
    call swap y1 , y2
    call swap x1 , x2
  end if
  if y2 > y3 then
    call swap y2 , y3
    call swap x2 , x3
  end if
  for i = y1 to y3
    a = x1 + ( x3 - x1 ) * (i-y1) / ( y3 - y1 )
    if i < y2 then
      b = x1 + ( x2 - x1 ) * (i-y1) / ( y2 - y1 )
    else
      b = x2 + ( x3 - x2 ) * (i-y2) / ( y3 - y2 )
    end if
    #m "down"
    #m "line " ; a ; " " ; i ; " " ; b ; " " ; i
    #m "up"
  next i
end sub

sub swap byref a , byref b
  h = a : a = b : b = h
end sub

[quit]
  close #m
end

''                                                    color

sub setcolor clr
  r = clr and 255
  g = int( clr / 256 ) and 255
  b = int( clr / 256 ^ 2 ) and 255
  #m "color " ; r ; " " ; g ; " " ; b
  #m "backcolor " ; r ; " " ; g ; " " ; b
end sub

function rainbow( deg )
  rainbow = rgb( sin( rad( deg ) ) * 127 + 128 _
               , sin( rad( deg - 120 ) ) * 127 + 128 _
               , sin( rad( deg + 120 ) ) * 127 + 128 )
end function

function rgb( r , g , b )
  rgb = ( r and 255 ) _
  + ( g and 255 ) * 256 _
  + ( b and 255 ) * 256 * 256
end function

function mix( kl1 , f , kl2 )
  r1 = int( kl1 and 255 )
  g1 = int( kl1 / 256 ) and 255
  b1 = int( kl1 / 256 / 256 ) and 255
  r2 = int( kl2 and 255 )
  g2 = int( kl2 / 256 ) and 255
  b2 = int( kl2 / 256 / 256 ) and 255
  r = r1 + ( r2 - r1 ) * f
  g = g1 + ( g2 - g1 ) * f
  b = b1 + ( b2 - b1 ) * f
  mix = rgb( r , g , b )
end function

''                                                math

function rad( deg )
  rad = deg * pi / 180
end function

function lenght( x , y , z )
  lenght = sqr( x^2 + y^2 + z^2 )
end function

function dot( x1 , y1 , z1 , x2 , y2 , z2 )
  dot = x1 * x2 + y1 * y2 + z1 * z2
end function

function angle( x , y , z , a , b , c )
  l1 = lenght( x , y , z )
  l2 = lenght( a , b , c )
  d = dot( x , y , z , a , b , c )
  angle = acs( d / ( l1 * l2 ) )
end function

''                                                3D engine

sub link no , x , y , z , xz , yz , xy , ax , p
  if no < 1 or no > 20 then exit sub
  if p < 0 or p > 20 then exit sub
  if no = p then exit sub

  call copy 0 , rotx
  call copy 0 , roty
  call copy 0 , rotz
  call copy 0 , trans

  m( in( rotx , 1 , 1 ) ) = cos( rad( yz ) )
  m( in( rotx , 1 , 2 ) ) = 0-sin( rad( yz ) )
  m( in( rotx , 2 , 1 ) ) = sin( rad( yz ) )
  m( in( rotx , 2 , 2 ) ) = cos( rad( yz ) )

  m( in( roty , 0 , 0 ) ) = cos( rad( xz ) )
  m( in( roty , 0 , 2 ) ) = 0-sin( rad( xz ) )
  m( in( roty , 2 , 0 ) ) = sin( rad( xz ) )
  m( in( roty , 2 , 2 ) ) = cos( rad( xz ) )

  m( in( rotz , 0 , 0 ) ) = cos( rad( xy ) )
  m( in( rotz , 0 , 1 ) ) = 0-sin( rad( xy ) )
  m( in( rotz , 1 , 0 ) ) = sin( rad( xy ) )
  m( in( rotz , 1 , 1 ) ) = cos( rad( xy ) )

  m( in( trans , 3 , 0 ) ) = x
  m( in( trans , 3 , 1 ) ) = y
  m( in( trans , 3 , 2 ) ) = z

  select case ax
    case xyz
      call keer rotx , roty , rotz , no
    case xzy
      call keer rotx , rotz , roty , no
    case yxz
      call keer roty , rotx , rotz , no
    case yzx
      call keer roty , rotz , rotx , no
    case zxy
      call keer rotz , rotx , roty , no
    case zyx
      call keer rotz , roty , rotx , no
    case else
      call keer rotx , roty , rorz , no
  end select

  number = no
end sub

sub keer a , b , c , no
  call maal a , b , temp
  call maal temp , c , no
  call maal no , trans , temp
  call maal temp , p , no
end sub

function in( no , x , y )
  in = no * 16 + x * 4 + y
end function

sub copy a , uit
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = m( in( a , i , j ) )
    next j
  next i
end sub

sub maal a , b , uit
  for i = 0 to 3
    for j = 0 to 3
      m( in( uit , i , j ) ) = 0
      for k = 0 to 3
        m( in( uit , i , j ) ) = m( in( uit , i , j ) ) _
        + m( in( a , i , k ) ) * m( in( b , k , j ) )
      next k
    next j
  next i
end sub

sub spot byref x , byref y , byref z
  no = number
  hx = m( in( no , 0 , 0 ) ) * x _
     + m( in( no , 1 , 0 ) ) * y _
     + m( in( no , 2 , 0 ) ) * z _
     + m( in( no , 3 , 0 ) )
  hy = m( in( no , 0 , 1 ) ) * x _
     + m( in( no , 1 , 1 ) ) * y _
     + m( in( no , 2 , 1 ) ) * z _
     + m( in( no , 3 , 1 ) )
  hz = m( in( no , 0 , 2 ) ) * x _
     + m( in( no , 1 , 2 ) ) * y _
     + m( in( no , 2 , 2 ) ) * z _
     + m( in( no , 3 , 2 ) )
  x = hx
  y = hy
  z = hz
end sub