(* simple tetrahedron *) 
 (* 
      applies angular velocity to object *) 
 (* applies w to rotation matrix *) 
 (* 
      doesn' t calculate any forces *) 

<< Calculus`VectorAnalysis`

<< Graphics`Shapes`

(* points of an object *) 
 (* 
      position,  
      mass *) 
qList = {
{{-1, 0, 0}, 1}, 
{{1, 0, 0}, 
            1}, 
{{0, 1, 0}, 
            1}, 
{{0, 0, 1}, 
            1}
};

(* 
      list of lines to display *) 
lineList  = {
{1, 2}, {2, 3}, {3, 4}, {4, 1}, {4, 2}, {3, 
            1}
};

x  =  {2, 0, 
          0};
v  =  {1, 1, 1};

rot = {{1, 0, 0}, {0, 1, 0}, {0, 0, 
            1}};

(* 
      center of mass *) 
For[i = 1; 
        com = {0, 0, 0}, 
        i <= Length[
            qList], i++, 
com +=  qList[[i]][[1]]*qList[[i]][[2]]];

w = {1, 1, 
          1};

(* 
      change in rotation matrix *) 
rotDot  =  {CrossProduct[
          w, {rot[[1]][[1]], rot[[2]][[1]], rot[[3]][[1]]}], 
CrossProduct[
          w, {rot[[1]][[2]], rot[[2]][[2]], rot[[3]][[2]]}], 
CrossProduct[
          w, {rot[[1]][[3]], rot[[2]][[3]], rot[[3]][[3]]}] }

For[i = 1; qDotList = {}, 
      i <= Length[
          qList], i++, 
tv = qList[[i]][[1]] - x; 
qDotList = 
        Append[qDotList, 
          CrossProduct[w, 
              rot[[1]]*tv + rot[[2]]*tv + rot[[3]]*tv] + 
            v]]

For[t = 1; alist = {}, 
      t < 10, t++, 
For[i = 1; glist = {}, 
        i <= Length[
            lList], i++, 
q = qList[[lineList[[i]][[1]]]][[1]]; 
q1 = 
          rot[[1]]*q + rot[[2]]*q + rot[[3]]*q + 
            x; 
q = qList[[lList[[i]][[2]]]][[1]]; 
q2 = 
          rot[[1]]*q + rot[[2]]*q + rot[[3]]*q + 
            x; 
glist = 
          Append[glist, 
            Line[{q1, 
                q2}]];]; 
update; 
alist = Append[alist, glist];]

Show[Graphics3D[alist], 
      PlotRange -> {{-5, 5}, {-5, 5}, {-5, 5}}]

update  :=  
        For[i = 1; 
          qListNew = {}, 
i <= 
            Length[qList], i++, 
qListNew = 
            Append[qListNew, {qList[[i]][[1]] + 
                  qDotList[[i]]*
                    dt, qList[[i]][[2]]}]];
qList = qListNew; 
x  =  x + v*dt;
mat = {};
For[i = 1, 
        i ≤ 
          3, i++, 
row = {}; 
For[
          j = 1, j ≤ 3, j++, 
value  = 
            0; 
For[k = 1, 
            k ≤ 
              3, k++, 
value  +=  rotDot[[i]][[k]]*rot[[k]][[j]]]; 
row = 
            Append[row, value];
]; 
mat = 
          Append[mat, row];
];
rot = mat;

rot

qDotList

qList

dt =  .3

qListNew

alist