Re: [Dmug] Lineismus - Tubismus

[Susanne & Udo Krause via demug <demug@XXXXXXX.ch>]

auch Tubismus


Clear[tubyKostabi]
(* lateral co-ordination is missing *)
tubyKostabi[nx_Integer?Positive,(* abscissa length *)
  ny_Integer?Positive, (* ordinate hight *)
  dx_Real?Positive, (* abscissa stepping *)
  dy_Real?Positive ,(* ordinate deviation *)
  dr_Real?Positive ,(* radius deviation *)
  spec_Integer : 83, (* Specularity *)
  opac_Real : 0.7 (* Opacity *)] :=
 Block[{xl = Table[Accumulate[RandomReal[dx {1/2, 1}, nx - 1]], ny],
    yl = Accumulate[RandomReal[dy {1, 2}, ny]],
    xyl = RandomReal[dy {-1, 1}, {ny, nx}],
    rl = RandomReal[dr {1/2, 2 }, {ny, nx}], mx,
    cl = Table[RGBColor[RandomReal[1, {3}]], ny]},
   (* equal length {0, Max[mx]} *)
   mx = Max /@ xl;
   xl = ArrayPad[MapThread[Times, {xl, Max[mx]/mx}], {{0}, {1, 0}}];
   Graphics3D[{
     CapForm[None], Specularity[White, spec], Opacity[opac],
     Transpose[{cl,
       MapThread[Tube[BSplineCurve[#1], #2] &, {ArrayPad[
          Transpose[Transpose[{xl, yl + xyl}, {3, 2, 1}]], {{0}, {0}, 
{0, 1}}],
          rl}]}
      ]
     },
    ViewPoint -> {0, 0, Infinity}, Boxed -> False, Background -> Black
    ]
   ] /; nx > 2




Am 29.11.2020 um 11:47 schrieb Susanne & Udo Krause via demug:
> Liebe Freundinnen und Freunde der Abschweifung,
>
>
> der Künstler An Idiot (no joke) hat den Lineismus (no joke) 
> entwickelt, bei dem er mittels der von ihm erfundenen digital - 
> analogen „Nail Lacquer "-Technik die Linien zieht, Details und der 
> Beweis der no-joke-Behauptung finden sich unter dem Link
>
> https://oiobooks.com/buecher/lines-colors/
>
>
> Die kostbare "Nail Lacqer"-Technik hat man digital nicht zur Hand, 
> deshalb wurde der Lineismus zum Tubismus - nicht zu verwechseln mit 
> dem Kubismus (ab 1906) - geformt, folgendermassen
>
>
> Clear[tubyStraight]
> tubyStraight[nx_Integer,(* abscissa length *)
>   nr_Integer?Positive, (* number of tubes *)
>   dr0_Real?NonNegative, (* tube radii: lower bound*)
>   dr1_Real?Positive, (* tube radii: upper bound *)
>   spec_Integer : 83, (* Specularity *)
>   opac_Real : 0.7 (* Opacity *)] :=
>  Block[{rl = RandomReal[{dr0, dr1}, nr],
>     cl = Table[RGBColor[RandomReal[1, {3}]], nr],
>     ar0 = ConstantArray[0, nr], ar1 = ConstantArray[nx, nr], yl},
>    yl = Most[FoldList[(#1 + Apply[Plus, #2]) &, rl[[1]], 
> Rest[Partition[{0, Splice [rl], 0}, 2, 1]]]];
>    Graphics3D[{
>      CapForm[None], Specularity[White, spec], Opacity[opac],
>      Transpose[{cl,
>        MapThread[Tube, {Transpose[{
>            Transpose[{ar0, yl, ar0}],
>            Transpose[{ar1, yl, ar0}]}, {2, 1, 3}
>           ], Transpose[{rl, rl}]}
>         ]
>        }
>       ]
>      },
>     ViewPoint -> Above, Boxed -> False, Background -> Black
>     ]
>    ] /; 0 <= dr0 < dr1
>
>
> und
>
>
> With[{n = 173},
>  tubyStraight[IntegerPart[n GoldenRatio], n, 0.07, 1.37, 93, 1.]
>  ]
>
> ergibt das Bild im Anhang.
>
>
> Schönen Sonnatag & Exp[0]. Advent!
> Udo.
>
>
>
>
>
>
>
> _______________________________________________
> DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
> http://www.mathematica.ch/mailman/listinfo/demug
> Archiv: http://www.mathematica.ch/archiv.html

tubismus.png
Description: PNG image

_______________________________________________
DMUG Deutschsprachiges Mathematica-Forum demug@XXXXXXX.ch
http://www.mathematica.ch/mailman/listinfo/demug
Archiv: http://www.mathematica.ch/archiv.html