Revision 51 (Version 9.0)

1) New object Information

Declare AnObject Information
With AnObject,"IsServer" as IsServer, "CodepageOEM" as CodepageOEM$
Print IsServer
Print CodepageOEM$
Declare AnObject Nothing

 

code dor this object from Dragokas, vbforums.com
http://www.vbforums.com/showthread.php?846709-OS-Version-information-class

2) New object Math (for now only Vectors are useful)
Advanced Programming with M2000
Code for Math object by Elroy, from VbForums.com
http://www.vbforums.com/showthread.php?857373-Linear-Algebra-for-3D-Space

Video from an old  example: http://bit.ly/2oOf479
This example has an addition: When we click in user form 3D object blinks.

Title "3D Graphics", 0 ' 0  to hide console
Set FAST !
\\ by api
Structure VecType {
          x As Double
          y As Double
          z As Double
}
\\ Program
Structure Variables {
      vRot1 As VecType
      vRot2 As VecType
      vRot3 As VecType
      vRot4 As VecType
      vBase As VecType
      vAxis As VecType
}
Buffer Clear Var as Variables
\\ utility function
VecAdr=Lambda Var (a$) -> {
      =Var(0,a$)
}
VecOff=Lambda Var, VecType (a$, b$) -> {
      =Var(0, a$, VecType(b$)!)
}
Class cLine {
      X1, Y1, X2, Y2, color
      Module Render (z){
            If z>=0 then {
                  Move .X1, .Y1
                  Width 3 {Draw to .X2, .Y2, .color}
                  Circle Fill #aa33cc, z/40+200
            } else {
                  Move .X2, .Y2
                  Circle Fill #aa33cc, z/40+200
                  Width 3 {Draw to .X1, .Y1, .color}
            }
      }
Class:
      Module cLine (.color){
            If Match("NNNN") Then Read .X1, .Y1, .X2, .Y2
      }     
}

\\ find address
vBase=VecAdr("vBase")
vBase.x=VecOff("vBase","x")
vBase.y=VecOff("vBase","y")
vBase.z=VecOff("vBase","z")
vRot1=VecAdr("vRot1")
vRot1.x=VecOff("vRot1","x")
vRot1.y=VecOff("vRot1","y")
vRot1.z=VecOff("vRot1","z")
vRot2=VecAdr("vRot2")
vRot2.x=VecOff("vRot2","x")
vRot2.y=VecOff("vRot2","y")
vRot2.z=VecOff("vRot2","z")
vRot3=VecAdr("vRot3")
vRot3.x=VecOff("vRot3","x")
vRot3.y=VecOff("vRot3","y")
vRot3.z=VecOff("vRot3","z")
vRot4=VecAdr("vRot4")
vRot4.x=VecOff("vRot4","x")
vRot4.y=VecOff("vRot4","y")

vAxis=VecAdr("vAxis")

Form 80,40
Refresh 100
Declare Alfa Form
With Alfa, "Title", "Demo1"
\\ a string to hold static background
screen$=""
disp=false
Inventory Depth
aLine=Each(Depth)
Thread {
            Method Math, "RotVectMult", 4, vRot1, vAxis, vRot1, dAngle
            Push Eval(Var, vBase.y as double), Eval(Var, vBase.x as double)
            \\ x is in top, y is after x
            Over 2, 2 \\  copy two times from second, so double two top
            Push Eval(Var, vRot4.x as double)+Number : Over 1, 2 \\ copy 2 times top only
            Read Line1.X1, Line2.X1, Line3.X1
            Push Eval(Var, vRot4.y as double)+Number : Over 1, 2
            Read Line1.Y1, Line2.Y1, Line3.Y1
            Over 2, 4 \\ now original 2 values copied 4 times
            Line1.X2 = Eval(Var, vRot1.x as double)+Number
            Line1.Y2 = Eval(Var, vRot1.y as double)+Number
            Line2.X2 = Eval(Var, vRot2.x as double)+Number
            Line2.Y2 = Eval(Var, vRot2.y as double)+Number
            Line3.X2 = Eval(Var, vRot3.x as double)+Number
            Line3.Y2 = Eval(Var, vRot3.y as double)+Number
            Inventory Depth ' clear Depth, then make keys as numbers
            Append Depth, Eval(Var, vRot1.z as double):=1, Eval(Var, vRot2.z as double):=2, Eval(Var, vRot3.z as double):=3
            Sort Depth as number
} As Compute
Group All$ {
Private:
      Dim Base 1, A$(3)
Public:
      n=1
      Set (.n) {
            read .A$(.n)
      }
      Value {
            =.A$(.n)
      }
}
Layer Alfa {
      Window 12, 10000, 8000;
      \\Form 40, 20
      Line1=cline(#0000FF, scale.x/2, scale.y/2, scale.x/2, scale.y/2-2220 )
      Line2=cline(#FF0000, scale.x/2, scale.y/2, scale.x/2-2340, scale.y/2-60 )
      Line3=cline(#00FF00, scale.x/2, scale.y/2, scale.x/2-780, scale.y/2-1200 )
      All$(1)=Weak$(Line1.Render)
      All$(2)=Weak$(Line2.Render)
      All$(3)=Weak$(Line3.Render)
      Declare Math Math
      Method Math, "Vector", vBase,scale.x/2-1500, scale.y/2+1500, 1500 '  -1000
      Method Math, "Vector", vRot1, Line1.X2, Line1.Y2, -1000
      Method Math, "Vector", vRot2, Line2.X2, Line2.Y2, -1200
      Method Math, "Vector", vRot3, Line3.X2, Line3.Y2, 1700
      Method Math, "Vector", vRot4, Line1.X1, Line1.Y1, 0
      Method Math,  "VecDiffMult", 4, vRot1, vBase, vRot1
      Inventory Depth=Eval(Var, vRot1.z as double):=1, Eval(Var, vRot2.z as double):=2, Eval(Var, vRot3.z as double):=3
      Sort Depth as number
      Method Math, "Vector", vAxis, -.8, 1.6, .3
      Method Math, "UnitVect", vAxis
      Rad2Deg =Lambda pidivby180=pi/180 (RadAngle)->RadAngle / pidivby180
      dAngle =11
      Pen 0
      Cls 7
      Gradient 11, 13
      Move 0,0
      Cursor 0, Height-1
      Cls 7, Height-1
      Copy scale.x, scale.y to screen$
      Profiler
      Cursor 0,Height
      Thread {
            Refresh 0 ' reset internal counter
            Move 0,0
            Copy 0,0 use screen$
            Part {
            aLine=Each(Depth)
            while aline {
                        All.n=eval(aLine)
                        Call All$, Val(eval$(Depth, aLine^))
            }
            } As disp
            Print Over $(7), Str$(Now , "hh:mm:ss" )
            Refresh
      } As PlayThis
}
Thread {
            if state then {disp~} else disp=false
} as blink interval 1000/16
State=False
Function Alfa.Click {
                  State~
                  If State then {
                         Thread compute Hold
                  } else {
                        Thread compute Restart
                  }
}
Thread compute interval 50
Thread PlayThis interval 1000/60
Method Alfa, "Show", 1
Threads Erase
Declare Alfa Nothing
Declare Math Nothing





These are the functions of Math object:Methods

Vector *A_Vector, x As Double, y As Double, z As Double
MakeLineFrom2Vec *A_Vector, *B_Vector, *C_LineType
MakeQuaterion  *A_QuatType, w As Double, x As Double, y As Double, z As Double
VecString *A_Vector Return String

UnitVect *A_Vector
NegateQuat *A_Quat, *Result_Quat


DotProduct *A_Vector, *B_Vector Return Result_Double
XProduct *A_Vector, *B_Vector, *Result_Vector
VecMagnitude *A_Vector Return Result_Double
VecDiviNum *A_Vector, Num_double, *Result_Vector
VecAddiNum *A_Vector, Num_double, *Result_Vector
VecDiffNum *A_Vector, Num_double, *Result_Vector
VecMulNum *A_Vector, Num_double, *Result_Vector

VecAver *A_Vector, *B_Vector, *Result_Vector
VecDiff *A_Vector, *B_Vector, *Result_Vector
VecSumm *A_Vector, *B_Vector, *Result_Vector
RotVect *A_Vector, *B_Vector, *Result_Vector, Angle_double, Optional bDegrees_double=True
VectorRad2Deg *A_Vector, *Result_Vector
VectorDeg2Rad *A_Vector, *Result_Vector

UnitVectMult N_Double, *A_Vector
NegateQuatMult N_Double, *A_Quat, *Result_Quat
VecDiviNumMult N_Double, *A_Vector, Num_double_const, *Result_Vector
VecAddiNumMult N_Double, *A_Vector, Num_double_const, *Result_Vector
VecDiffNumMult N_Double, *A_Vector, Num_double_const, *Result_Vector
VecMulNumMult N_Double, *A_Vector, Num_double_const, *Result_Vector

VecAverMult N_Double, *A_Vector, *B_Vector, *Result_Vector
VecSummMult N_Double, *A_Vector, *B_Vector_const, *Result_Vector
VecDiffMult N_Double, *A_Vector, *B_Vector_const, *Result_Vector
RotVectMult N_Double, *A_Vector, *Axis_Vector_const, *Result_Vector, Angle_double, Optional bDegrees_double=True
VectorRad2DegMult N_Double, *A_Vector, *Result_Vector
VectorDeg2RadMult N_Double, *A_Vector, *Result_Vector

Rad2Deg RadAngle_double return double
Deg2Rad DegAngle_double return double
ACos d_radians_double return double
ASin d_radians_double return double
ATan2 y_double, x_double return double