Some Fun Stuff

Balls in a Box

DynamicModule[{contents = {}, n = 0, t, v1, v2, v = 0, style = {}}, 
 Framed[EventHandler[
   Dynamic[contents = 
     Map[If[0 <= #[[1, 1]] <= 1 , 
        If[0 <= #[[1, 2]] <= 
          1, {#[[1]] + #[[2]], #[[2]] - {0, 0}}, {{#[[1, 1]], 
           If[#[[1, 2]] > 1, 1, 0]}, {1, -1} #[[
            2]]}], {{If[#[[1, 1]] > 1, 1, 0], #[[1, 2]]}, {-1, 1} #[[
           2]]}] &, contents];
    contents = 
     Map[ If[Length@contents < 2, {#[[1]] + #[[2]], #[[2]]}, 
        If[(contents[[1, 1, 1]] - 
              contents[[2, 1, 1]])^2 + (contents[[1, 1, 2]] - 
              contents[[2, 1, 2]])^2 >= 0.08^2 , #, 
         n++; {(#[[1]] - (contents[[1, 1]] + contents[[2, 1]])/
               2) 0.041/
             Norm[(#[[1]] - (contents[[1, 1]] + contents[[2, 1]])/
                 2)] + (contents[[1, 1]] + contents[[2, 1]])/2, #[[
            2]] - ((2 #[[2]] - contents[[1, 2]] - 
                 contents[[2, 2]]).(contents[[1, 1]] - 
                 contents[[2, 1]]))/
             Norm[(contents[[1, 1]] - contents[[2, 1]])]^2 (contents[[
               1, 1]] - contents[[2, 1]])}]] &, contents];
    Graphics[
     Prepend[Riffle[style, Point /@ Map[First, contents]], 
       PointSize[0.08]]~
      Join~{Black, 
       Inset[Framed[
         Dynamic[If[Length@contents < 2, 
           Row[{Text["N= "], Length@contents}], 
           Row[{Text["E="], 
             10000 (Norm[contents[[1, 2]]]^2 + 
                Norm[contents[[2, 2]]]^2 + 
                0.0000* (contents[[1, 1, 2]] + contents[[2, 1, 2]])), 
             Text[", t="], Floor[(SessionTime[] - t)], Text[", n="], 
             n/2}]] ], Background -> LightBlue, ImageSize -> 120], 
        Scaled[{0.5, 0.95}]]}, 
     PlotRange -> {{-0.05, 1.05}, {-0.05, 1.05}}, ImageSize -> 400]], 
   "MouseDown" :> (If[Length@contents < 2, 
      AppendTo[style, RandomChoice[ColorData[10, "ColorList"]]]; 
      AppendTo[
       contents, {MousePosition["Graphics"], {v1, v2} = 
         RandomReal[{-0.01, 0.01}, 2]}]; t = SessionTime[]; 
      v += Norm[{v1, v2}], style = {}; contents = {}; 
      t = SessionTime[]; n = 0;])], FrameMargins -> 0]]
	  

Five-Star Red Flag

(* a five-pointed star at (x, y) with radius r, orientation theta*)
FivePointedStar[x_, y_, r_, \[Theta]_] := 
 Polygon[Flatten[
   Table[{{x + r Cos[\[Theta] + Pi/2 + 2 (n Pi)/5], 
      y + r Sin[\[Theta] + Pi/2 + 2 (n Pi)/5]}, {x + 
       r Sin[Pi/10]/
         Sin[(7 Pi)/10] Cos[\[Theta] + Pi/2 + Pi/5 + 2 (n Pi)/5], 
      y + r Sin[Pi/10]/
         Sin[(7 Pi)/10] Sin[\[Theta] + Pi/2 + Pi/5 + 
          2 (n Pi)/5]}}, {n, 0, 4}], 1]]
(* the flag *)
flag = Graphics[{Red, Rectangle[{0, 0}, {3, 2}], Yellow, 
  FivePointedStar[0.5, 1.5, 0.3, 0], 
  FivePointedStar[1.0, 1.8, 0.1, 
   ArcTan[(1.5 - 1.8)/(0.5 - 1.0)] + Pi/2], 
  FivePointedStar[1.2, 1.6, 0.1, 
   ArcTan[(1.5 - 1.6)/(0.5 - 1.2)] + Pi/2], 
  FivePointedStar[1.2, 1.3, 0.1, 
   ArcTan[(1.5 - 1.3)/(0.5 - 1.2)] + Pi/2], 
  FivePointedStar[1.0, 1.1, 0.1, 
   ArcTan[(1.5 - 1.1)/(0.5 - 1.0)] + Pi/2]}, ImageSize -> {600, 400}, 
 PlotRangePadding -> None]

(* animation *)
img = Reverse[ImageData[flag]];
h = img // Length;
w = img[[1]] // Length;
hrate = 2; wrate = 2; rate=5; frequency = 0.03; amplitude = 1;
Export["fivestarflag.gif", 
 Table[
   ListPlot3D[
    Table[amplitude * Sin[frequency (x + 0.2 y) - phase], {y, 1, h/hrate, 1}, {x, 1, 
      w/wrate, 1}], BoxRatios -> {3, 2, .5}, Mesh -> None, 
    VertexColors -> {img[[1 ;; h ;; hrate, 1 ;; w ;; wrate]]}, 
    Lighting -> "Neutral", Boxed -> False, Axes -> None, 
    ViewPoint -> Top, BoundaryStyle -> None], {phase, (2 Pi)/rate, 2 Pi, (2 Pi)/rate}]]

< !DOCTYPE html>
< html >
    SyntaxHighlighter
< /html >