p = x^3 + a*x + b;

Solve[{p == 0, D[p, x] == 0}, {a, b}]

i = 0; m = 0; 
    bifcurve = 
      ParametricPlot[{-3*e^2, 2*e^3}, {e, -2, 2}, 
        AspectRatio -> Automatic, Ticks -> None, 
        AxesLabel -> {"a", "b"}];

\(While[i == 0; 
	
	
      For[a\  = \ \(-0.5\), \ a\  <= \ \(- .485\), \ a\  = \ a + 0.005, \ 

        			\ \ \ b\  = \ Sqrt[\(-a^2\)\  + \ 0.25]; \ 
        rts\  = \ Solve[\ x^3\  + \ a*x\  + \ b\  == \ 0, \ x]; 
			\ \ \ 
        r1\  = \ x\  /. \ rts[\([1]\)]; \ a1\  = \ \(-3\)*r1^2; \ 
        b1\  = \ 2*r1^3; 
			\ \ \ r2\  = \ x\  /. \ rts[\([2]\)]; \ 
        a2\  = \ \(-3\)*r2^2; \ b2\  = \ 2*r2^3; 
			\ \ \ 
        r3\  = \ x\  /. \ rts[\([3]\)]; \ a3\  = \ \(-3\)*r3^2; \ 
        b3\  = \ 2*r3^3; 
			\ \ \ 
        pic[m]\  = \ \ \ \ 
				\ \ \ \ \ \ \ \ 
          GraphicsArray[{
              Show[bifcurve, \ Graphics[Line[{{a, b}, {a1, b1}}]], \ 

                						\ \ \ Graphics[Line[{{a, b}, {a2, b2}}]], 
                Graphics[Line[{{a, b}, {a3, b3}}]], \ 
							\ 
                Graphics[Circle[{0, 0}, 0.5]], \ 
                PlotRange -> {{\(-1.75\),  .6}, {\(- .6\),  .6}}, 

                						\ \ \ \ \ \ \ AspectRatio -> Automatic], 

              						\ \ \ 
              Show[Graphics[
                  Plot[\ w^3 + a*w + b, {w, \(-2\), 2}, 

                    							\ \ \ \ AspectRatio -> Automatic, 
                    Ticks -> None, AxesLabel -> {x, "p(x)"}, 
                    PlotRange -> {{\(-2\), 2}, {\(-3\), 3}}]]]}]; \ \ \ \ \ \ 
        
				m\  = \ m\  + \ 1]; 

		
      For[a\  = \ \(-0.48\), \ a < 0.5, \ a\  = \ a\  + \ 0.05, \ 

        		\ \ \ \ \ \ \ \ b\  = \ Sqrt[\(-a^2\)\  + \ 0.25]; \ 

        		\ \ \ \ \ \ \ \ 
        rts\  = \ Solve[x^3\  + \ a*x\  + \ b\  == \ 0, \ x]; 

        		\ \ \ \ \ \ \ \ 
        For[n\  = \ 1, \ n\  <= \ 3, \ n\  = \ n\  + \ 1, \ 

          			\ \ \ \ \ \ \ \ \ \ \ \ \ r\  = \ x\  /. \ rts[\([n]\)]; \ 

          			\ \ \ \ \ \ \ \ \ \ \ \ \ 
          If[Head[r]\  == \ Real, \ 
				\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
            a1\  = \ \(-3\)*r^2; 
				\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
            b1\  = \ 2*r^3; 
				\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
            pic[m]\  = \ 

              					\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
              GraphicsArray[{
                  Show[\ bifcurve, {Graphics[\ Line[{{a, b}, {a1, b1}}]], 

                      									\ \ \ \ \ \ \ \ \ \ \ \ 
                      Graphics[Circle[{0, 0}, 0.5]]}, \ 
                    PlotRange -> {{\(-1.75\),  .6}, {\(- .6\),  .6}}, 

                    									\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
                    AspectRatio -> Automatic], \ \ \ 

                  							\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
                  Show[Graphics[\ 
                      Plot[\ w^3 + a*w + b, \ {w, \(-2\), 2}, 
                        AspectRatio -> Automatic, 
                        AxesLabel -> {x, "p(x)"}, Ticks -> None, \ 

                        										\ \ \ \ \ \ \ \ \ \ \ \ \ \ 
                        PlotRange -> {{\(-2\), 2}, {\(-3\), 3}}]]]}]; \ 

            					\ \ \ \ \ \ \ \ \ \ \ \ \ m\  = \ m\  + \ 1; ]]]; 

	
      For[a\  = \ 0.5, a\  > \ \(-0.48\), \ a\  = \ a\  - \ 0.05, \ 

        			\ \ \ b\  = \ \(-Sqrt[\(-a^2\)\  + \ 0.25]\); 
			\ \ \ 
        rts\  = \ Solve[\ x^3\  + \ a*x\  + \ b\  == \ 0, \ x]; 
			\ \ \ 
        For[n\  = \ 1, \ n\  <= \ 3, \ n\  = \ n\  + \ 1, 

          		\ \ \ \ \ \ \ \ \ \ \ \ r\  = \ x\  /. \ rts[\([n]\)]; 

          				\ \ \ \ \ \ \ 
          If[Head[r]\  == \ Real, \ 
					\ \ \ \ \ \ \ \ \ \ 
            a1\  = \ \(-3\)*r^2; \ 
					\ \ \ \ \ \ \ \ \ \ 
            b1\  = \ 2*r^3; 
	\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ 
            pic[m]\  = \ 
						\ \ \ \ \ \ \ \ \ \ \ \ \ \ 
              GraphicsArray[{
                  Show[bifcurve, 
                    \ {Graphics[\ Line[{{a, b}, {a1, b1}}]], 

                      										\ \ \ \ 
                      Graphics[\ Circle[{0, 0}, 0.5]]}, \ 
                    PlotRange -> {{\(-1.75\),  .6}, {\(- .6\),  .6}}, 

                    									\ \ \ \ \ \ \ \ \ \ 
                    AspectRatio -> Automatic], \ 

                  								\ \ \ \ \ \ \ \ \ 
                  Show[\ Graphics[\ 
                      Plot[\ w^3 + a*w + b, {w, \(-2\), 2}, \ 
                        AspectRatio -> Automatic, 
                        AxesLabel -> {x, "p(x)"}, Ticks -> None, 

                        											\ \ \ \ \ 
                        PlotRange -> {{\(-2\), 2}, {\(-3\), 3}}]]]}]; 

            					\ \ \ \ \ \ \ \ \ \ m = m + 1; ]]]; 
	
	
      For[\ a\  = \ \(-0.485\), \ a\  >= \ \(- .5\), \ a\  = \ a\  - \ 0.005, 
        \ 
			\ \ \ b\  = \ \(-Sqrt[\(-a^2\)\  + \ 0.25]\); \ 

        			\ \ \ rts\  = \ Solve[\ x^3\  + \ a*x\  + \ b\  == \ 0, \ x]; 

        		\ \ \ \ \ r1\  = \ x\  /. \ rts[\([1]\)]; \ a1\  = \ \(-3\)*r1^2; 
        \ b1\  = \ 2*r1^3; 	\ 
			\ \ \ r2\  = \ x\  /. \ rts[\([2]\)]; 
        \ a2\  = \ \(-3\)*r2^2; \ b2\  = \ 2*r2^3; 
			\ \ \ 
        r3\  = \ x\  /. \ rts[\([3]\)]; \ a3\  = \ \(-3\)*r3^2; \ 
        b3\  = \ 2*r3^3; 
				\ 
        pic[m]\  = \ 
				\ \ \ \ \ \ \ \ \ 
          GraphicsArray[{
              Show[bifcurve, \ Graphics[Line[{{a, b}, {a1, b1}}]], 

                								Graphics[Line[{{a, b}, {a2, b2}}]], 
                Graphics[\ Line[{{a, b}, {a3, b3}}]], 
								
                Graphics[Circle[{0, 0}, 0.5]], \ 
                PlotRange -> {{\(-1.75\),  .6}, {\(- .6\),  .6}}, 

                							\ \ \ \ \ \ AspectRatio -> Automatic], 

              						\ \ \ \ \ 
              Show[Graphics[\ 
                  Plot[\ w^3 + a*w + b, {w, \(-2\), 2}, \ 
                    AspectRatio -> Automatic, AxesLabel -> {x, "p(x)"}, 
                    Ticks -> None, 
								\ \ \ 
                    PlotRange -> {{\(-2\), 2}, {\(-3\), 3}}]]]}]; 
			
        m = m + 1; ]; 
		
i = 1; ]\)

Do[Show[pic[m]], {m, 1, 48}]

m = 1; 
    Do[Display[StringJoin["pic.", ToString[10 + m]], pic[m], "GIF", 
        ImageSize -> {500, 238}], {m, 1, 47}];