Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

RE: Defining and Programming Graphical Directives

• To: mathgroup at smc.vnet.net
• Subject: [mg39243] RE: [mg39232] Defining and Programming Graphical Directives
• From: "David Park" <djmp at earthlink.net>
• Date: Wed, 5 Feb 2003 00:11:37 -0500 (EST)
• Sender: owner-wri-mathgroup at wolfram.com

Thanks Andrzej! That put me onto the right track.

I made a number of changes. I believe the programmed directives now behave
exactly like regular graphics directives. Here is a toy example.

Needs["Graphics`Colors`"]

currentcolor = Black;
currentwidth = 1;

ColoredLine[start_, end_] := {currentcolor, AbsoluteThickness[currentwidth],
    Line[{start, end}]}

LineColor[color_] := (currentcolor = color; {});
LineThickness[width_] := (currentwidth = width; {});

Attributes[PlottingLines] = {HoldFirst};
PlottingLines[primitives_List, opts___?OptionQ] :=
  Module[{blockprimitives = Hold[primitives], STOP},

    blockprimitives =
      blockprimitives //.
        HoldPattern[p : {s_, x___}] /;
            s =!= STOP \[And]
              ¬ FreeQ[Hold[p], LineColor | LineThickness, {3}] :>
Block[{currentcolor = currentcolor, currentwidth = currentwidth}, {STOP, s,
              x}];
    blockprimitives = blockprimitives /. STOP -> Sequence[];

    currentcolor = Black;
    currentwidth = 1;
    Show[Graphics[
        Sequence @@ blockprimitives], opts]]

1) We have to reset the current directives after making the Block
substitutions because they get evaluated somewhere along the line.
2) We need ReplaceRepeated to get all levels. A STOP argument is added at
the head of the list to prevent repeated Blocks of the same list.
3) We keep the directives in the primitives list.
4) We set the primitive values to the current values when entering the
Block.

Here are several examples. The lines are stacked vertically in order of
drawing.

PlottingLines[
     {ColoredLine[{0, 0}, {1, 0}],
       LineColor[Red],
       ColoredLine[{0, 1}, {1, 1}],
       LineColor[Blue], LineThickness[2],
       ColoredLine[{0, 2}, {1, 2}]},
    Background -> Linen];

PlottingLines[
     {ColoredLine[{0, 0}, {1, 0}],
       {LineColor[Red],
         ColoredLine[{0, 1}, {1, 1}],
        {LineColor[Blue], ColoredLine[{0, 1.1}, {1, 1.1}],
          LineColor[Green], LineThickness[2],
          ColoredLine[{0, 1.2}, {1, 1.2}]},
         ColoredLine[{0, 1.4}, {1, 1.4}]},
       ColoredLine[{0, 2}, {1, 2}],
      LineColor[DarkSeaGreen],
      ColoredLine[{0, 2.5}, {1, 2.5}]}];

David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/



From: Andrzej Kozlowski [mailto:andrzej at platon.c.u-tokyo.ac.jp]
To: mathgroup at smc.vnet.net

Here is one approach, which is far form perfect, but probably could be
developed to do what you want.

The idea is basically to parse your expression before applying plotting
lines and replace things like

{LineColor[Red],
         ColoredLine[{0, 1}, {1, 1}]}

by

Block[{currentcolor=Red}, ColoredLine[{0, 1}, {1, 1}]


Here is a function that will do this, at least in simple cases:



SetAttributes[ff,HoldAll]


ff[expr_]:=Hold[expr]/.HoldPattern[{y___,LineColor[c_],x___}]:>
Block[{currentcolor=c},{y,x}]/;FreeQ[HoldPattern[{x,y}],LineColor]


Using your definitions both:


PlottingLines@@ff[
     {ColoredLine[{0, 0}, {1, 0}],
       LineColor[Red],
       ColoredLine[{0, 1}, {1, 1}],
       LineColor[Blue],
       ColoredLine[{0, 2}, {1, 2}]}]
and

PlottingLines@@ff[
     {ColoredLine[{0, 0}, {1, 0}],
       {LineColor[Red],
         ColoredLine[{0, 1}, {1, 1}]},
       ColoredLine[{0, 2}, {1, 2}]}]

seem now to work correctly.

Andrzej Kozlowski
Yokohama, Japan
http://www.mimuw.edu.pl/~akoz/
http://platon.c.u-tokyo.ac.jp/andrzej/