rtsi.com/2014.01.www.rtsi.com.tar/www.rtsi.com/OS9/OSK/APPS/lout2.lzh/LOUT2/LIB/include/fig

Text File | 1994-02-26 | 16KB | 715 lines

###############################################################################
#                                                                             #
#  Lout @Fig package for drawing figures (Version 2.0)                        #
#                                                                             #
#  Version 1.0 by Jeffrey H. Kingston, October 1991.                          #
#  Version 2.0 by Jeffrey H. Kingston, 22 December 1992.                      #
#  Symbol names changed by JHK 5 March 1993 to avoid clashes with EPS files.  #
#                                                                             #
#  See "Fig - a Lout package for drawing figures" for user information.       #
#                                                                             #
###############################################################################

@SysPrependGraphic { "fig_prepend" }

export in cm pt em sp vs ft dg
       "<<" "**" "++" "--" @Max @Min
       @Distance @XDistance @YDistance @Angle
       @Prev "::" @Label @BaseOf @MarkOf @ShowLabels
       @Colour @Color @RGBColour @RGBColor @HSBColour @HSBColor
       @Figure @Frame @Box @Square @Diamond @Polygon @Ellipse
       @Circle @HLine @VLine @Line @HArrow @VArrow @Arrow @Arc

def @Fig
    named maxlabels  { 200     }
    named linestyle  { solid   }
    named linewidth  { 0.5 pt  }
    named linecap    { round   }
    named dashlength { 0.15 cm }
    named paint      { nopaint }
    named margin     { 0.4c    }
    named arrow      { noarrow }
    named headstyle  { open    }
    named headwidth  { 0.05 cm }
    named headlength { 0.15 cm }
    body @Body
@Begin

    # Like @Graphic, but affects the graphics state of right parameter
    def @InnerGraphic
    left ps
    right x
    {
    { ps gsave // grestore } @Graphic x
    }

    def in precedence 39 left x { x "in" }
    def cm precedence 39 left x { x "cm" }
    def pt precedence 39 left x { x "pt" }
    def em precedence 39 left x { x "em" }
    def sp precedence 39 left x { x "sp" }
    def vs precedence 39 left x { x "vs" }
    def ft precedence 39 left x { x "ft" }
    def dg precedence 39 left x { x "dg" }

    def "<<"
    precedence 38
    left length
    right angle
    {
    0 0 length angle "lfigatangle"
    }

    def "**"
    precedence 37
    left point
    right length
    {
    point length "lfigpmul"
    }

    def "++"
    precedence 36
    associativity left
    left x
    right y
    {
    x y "lfigpadd"
    }

    def "--"
    precedence 36
    associativity left
    left x
    right y
    {
    y x "lfigpsub"
    }

    def @Max
    precedence 36
    left x
    right y
    {
    x y "lfigpmax"
    }

    def @Min
    precedence 36
    left x
    right y
    {
    x y "lfigpmin"
    }

    def @Distance
    precedence 35
    left x
    right y
    {
    x y "lfigdistance"
    }

    def @XDistance
    precedence 35
    left x
    right y
    {
    x y "lfigxdistance"
    }

    def @YDistance
    precedence 35
    left x
    right y
    {
    x y "lfigydistance"
    }

    def @Angle
    precedence 35
    left x
    right y
    {
    x y "lfigangle"
    }

    def @Prev
    {
    "lfigprevious"
    }

    def "::"
    precedence 33
    left name
    right x
    {
    { "currentdict end" maxlabels "dict begin begin"
      // "("name") lfigpromotelabels" } @Graphic x
    }

    def @Label
    right name
    {
    "/"name "lfigpointdef"
    }

    def @MarkOf
    precedence 32
    left point
    right x
    {
    { point "translate" } @InnerGraphic
    {
        /0io |0io @OneCol @OneRow x |0io /0io
    }
    }

    def @BaseOf
    precedence 32
    left point
    right x
    {
    { point "translate" } @InnerGraphic
    {
        /0io |0io @OneRow @OneCol {
        | @OneCol @OneRow x ^/
        } |0io /0io
    }
    }

    def @ShowLabels
    {
    "lfigshowlabels" @Graphic
    }

    def @Colour
    left col
    right x
    {
    {
        col @Case
        {
        black @Yield "0.00 0.0 0.0"
        grey  @Yield "0.00 0.0 0.9"
        white @Yield "0.00 0.0 1.0"
        red   @Yield "0.00 1.0 1.0"
        green @Yield "0.33 1.0 1.0"
        blue  @Yield "0.66 1.0 1.0"
        } sethsbcolor
    } @InnerGraphic x
    }

    def @Color
    left col
    right x
    {
    col @Colour x
    }

    def @RGBColour
    left col
    right x
    {
    { col setrgbcolor } @InnerGraphic x
    }

    def @RGBColor
    left col
    right x
    {
    col @RGBColour x
    }

    def @HSBColour
    left col
    right x
    {
    { col sethsbcolor } @InnerGraphic x
    }

    def @HSBColor
    left col
    right x
    {
    col @HSBColour x
    }

    def @Figure
    named shape      {            }
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named arrow      { arrow      }
    named headstyle  { headstyle  }
    named headwidth  { headwidth  }
    named headlength { headlength }
    named paint      { paint      }
    named margin     { 0c         }
    right x
    {
    @HContract @VContract
    {
        #fill the shape
        paint @Case
        {
        nopaint @Yield {}

        { white light grey gray dark black } @Yield
        { "/lfig"paint "[" shape "] gsave lfigpaintpath grestore" }
        }

        # stroke the path and add any arrowheads
        linestyle @Case
        {
        { solid dashed cdashed dotted noline } @Yield
        {
            linewidth "setlinewidth" "lfig"linecap "setlinecap"
            dashlength "/lfig"linestyle "[" shape "] lfigdopath"
            arrow @Case
            {
            noarrow @Yield { pop pop }
            { forward back both } @Yield
            {  dashlength "/lfig"linestyle "/"lfigblack
               headstyle @Case
               { { open halfopen closed } @Yield "lfig"headstyle }
               headlength headwidth "lfig"arrow
            }
            }
        }
        }
    }
    @Graphic
    {
        ^/margin ^|margin @OneCol @OneRow x |margin
         /margin
    }
    }

    def @Frame
    right x
    {
    @Figure
        shape {xsize 0 @Label X 0 ysize @Label Y}
    { x }
    }

    def @Box
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { margin     }
    right x
    {
    @Figure
        shape {
        # 0     0      @Label SW
        # xsize 0      @Label SE
        # xsize ysize  @Label NE
        # 0     ysize  @Label NW
        # SE ** 0.5    @Label S
        # NW ** 0.5    @Label W
        # W ++ SE      @Label E
        # S ++ NW      @Label N
        # NE ** 0.5    @Label CTR
        # SW SE NE NW SW
        lfigbox
        }
        linestyle  { linestyle }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
    x
    }

    def @Square
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { margin     }
    right x
    {
    @Figure
        shape {
        # {xsize ysize} ** 0.5                           @Label CTR
        # CTR ++ {{xsize xsize} @Max {ysize ysize}}**0.5 @Label NE
        # CTR ++ { {CTR @Distance NE} << 135 }           @Label NW
        # CTR ++ { {CTR @Distance NE} << 225 }           @Label SW
        # CTR ++ { {CTR @Distance NE} << 315 }           @Label SE
        # SW ** 0.5 ++ SE ** 0.5                         @Label S
        # NW ** 0.5 ++ NE ** 0.5                         @Label N
        # SW ** 0.5 ++ NW ** 0.5                         @Label W
        # SE ** 0.5 ++ NE ** 0.5                         @Label E
        # SW SE NE NW SW
        lfigsquare
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
    x
    }

    def @Diamond
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { margin     }
    right x
    {
    @Figure
        shape {
        # {xsize 0} ** 0.5  @Label S
        # {0 ysize} ** 0.5  @Label W
        # S ++ W            @Label CTR
        # CTR ++ W          @Label N
        # CTR ++ S          @Label E
        # S E N W S
        lfigdiamond
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
    x
    }

    def @Polygon
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { margin     }
    named sides      { 3          }
    named angle      { "dup 180 exch div" }
    right x
    {
    @Figure
        shape      { sides angle lfigpolygon }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
    x
    }

    def @Ellipse
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { margin     }
    right x
    {
    @Figure
        shape {
        # {xsize 0} ** 0.5  @Label S
        # {0 ysize} ** 0.5  @Label W
        # S ++ W            @Label CTR
        # CTR ++ W          @Label N
        # CTR ++ S          @Label E
        # CTR ++ {xsize 0} ** 0.3536 ++ {0 ysize} ** 0.3536  @Label NE
        # CTR ++ {xsize 0} ** 0.3536 -- {0 ysize} ** 0.3536  @Label SE
        # CTR -- {xsize 0} ** 0.3536 ++ {0 ysize} ** 0.3536  @Label NW
        # CTR -- {xsize 0} ** 0.3536 -- {0 ysize} ** 0.3536  @Label SW
        # S [ CTR ] E [ CTR ] N [ CTR ] W [ CTR ] S
        lfigellipse
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
    x
    }

    def @Circle
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { margin     }
    right x
    {
    @Figure
        shape {
        # {xsize ysize} **0.5                    @Label CTR
        # CTR ++ {{xsize 0} @Max {ysize 0}}**0.5 @Label E
        # CTR ++ { {CTR @Distance E} << 45  }    @Label NE
        # CTR ++ { {CTR @Distance E} << 90  }    @Label N
        # CTR ++ { {CTR @Distance E} << 135 }    @Label NW
        # CTR ++ { {CTR @Distance E} << 180 }    @Label W
        # CTR ++ { {CTR @Distance E} << 225 }    @Label SW
        # CTR ++ { {CTR @Distance E} << 270 }    @Label S
        # CTR ++ { {CTR @Distance E} << 315 }    @Label SE
        # S [ CTR ] E [ CTR ] N [ CTR ] W [ CTR ] S
        lfigcircle
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
    x
    }

    def @HLine
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { 0c         }
    named arrow      { arrow      }
    named headstyle  { headstyle  }
    named headwidth  { headwidth  }
    named headlength { headlength }
    right x
    {
    @Figure
        shape {
        # 0     ymark @Prev @Label FROM
        # xsize ymark @Prev @Label TO
        lfighline
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
        arrow      { arrow      }
        headstyle  { headstyle  }
        headwidth  { headwidth  }
        headlength { headlength }
    x
    }

    def @VLine
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { 0c         }
    named arrow      { arrow      }
    named headstyle  { headstyle  }
    named headwidth  { headwidth  }
    named headlength { headlength }
    right x
    {
    @Figure
        shape {
        # xmark ysize @Prev @Label FROM
        # xmark 0     @Prev @Label TO
        lfigvline
        }
        linestyle  { linestyle }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
        arrow      { arrow      }
        headstyle  { headstyle  }
        headwidth  { headwidth  }
        headlength { headlength }
    x
    }

    def @HArrow
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { 0c         }
    named arrow      { forward    }
    named headstyle  { headstyle  }
    named headwidth  { headwidth  }
    named headlength { headlength }
    right x
    {
    @Figure
        shape {
        # 0     ymark @Prev @Label FROM
        # xsize ymark @Prev @Label TO
        lfighline
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
        arrow      { arrow      }
        headstyle  { headstyle  }
        headwidth  { headwidth  }
        headlength { headlength }
    x
    }

    def @VArrow
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { 0c         }
    named arrow      { forward    }
    named headstyle  { headstyle  }
    named headwidth  { headwidth  }
    named headlength { headlength }
    right x
    {
    @Figure
        shape {
        # xmark ysize @Prev @Label FROM
        # xmark 0     @Prev @Label TO
        lfigvline
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
        arrow      { arrow      }
        headstyle  { headstyle  }
        headwidth  { headwidth  }
        headlength { headlength }
    x
    }

    def @Line
    named from       { 0 ysize    }
    named to         { xsize 0    }
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { 0c         }
    named arrow      { arrow      }
    named headstyle  { headstyle  }
    named headwidth  { headwidth  }
    named headlength { headlength }
    right x
    {
    @Figure
        shape {
        from @Prev @Label FROM
        to   @Prev @Label TO
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
        arrow      { arrow      }
        headstyle  { headstyle  }
        headwidth  { headwidth  }
        headlength { headlength }
    x
    }

    def @Arrow
    named from       { 0 ysize    }
    named to         { xsize 0    }
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { 0c         }
    named arrow      { forward    }
    named headstyle  { headstyle  }
    named headwidth  { headwidth  }
    named headlength { headlength }
    right x
    {
    @Figure
        shape {
        from @Prev @Label FROM
        to   @Prev @Label TO
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
        arrow      { arrow      }
        headstyle  { headstyle  }
        headwidth  { headwidth  }
        headlength { headlength }
    x
    }

    def @Arc
    named from       { 0 ysize    }
    named to         { xsize 0    }
    named ctr        { 0 0        }
    named direction  { clockwise  }
    named linestyle  { linestyle  }
    named linewidth  { linewidth  }
    named linecap    { linecap    }
    named dashlength { dashlength }
    named paint      { paint      }
    named margin     { 0c         }
    named arrow      { noarrow    }
    named headstyle  { headstyle  }
    named headwidth  { headwidth  }
    named headlength { headlength }
    right x
    {
    @Figure
        shape {
        from @Label FROM
        to   @Label TO
        ctr  @Label CTR
        FROM [ CTR
        direction @Case { {clockwise anticlockwise} @Yield direction }
        ] TO
        }
        linestyle  { linestyle  }
        linewidth  { linewidth  }
        linecap    { linecap    }
        dashlength { dashlength }
        paint      { paint      }
        margin     { margin     }
        arrow      { arrow      }
        headstyle  { headstyle  }
        headwidth  { headwidth  }
        headlength { headlength }
    x
    }

    { "grestore save gsave" maxlabels "dict begin lfigdict begin"
      // "end end restore"
    } @Graphic @Body

@End @Fig