########################################################################### # # # coltex # # # # Jeffrey H. Kingston # # 30 October 2002 # # # # Include file providing @ColourCommand and @TextureCommand symbols. # # # # This program is free software; you can redistribute it and/or modify # # it under the terms of the GNU General Public License as published by # # the Free Software Foundation; either Version 3, or (at your option) # # any later version. # # # # This program is distributed in the hope that it will be useful, # # but WITHOUT ANY WARRANTY; without even the implied warranty of # # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # # GNU General Public License for more details. # # # # You should have received a copy of the GNU General Public License # # along with this program; if not, write to the Free Software # # Foundation, Inc., 59 Temple Place, Suite 330, Boston MA 02111-1307 USA # # # # As a special exception, when this file is read by Lout when processing # # a Lout source document, you may use the result without restriction. # # # ########################################################################### @SysInclude { lengths } # @PSLengths (needed for @TextureCommand) ########################################################################### # # # @ColourCommand # # # # Jeff Kingston # # 19 October 2001 # # Updated for compatibility with textures 28 October 2002. # # # # @ColourCommand converts a colour expressed in a manner that the # # ordinary user can comprehend into the PostScript or PDF command # # needed to obtain that colour, suitable for passing to @SetColour # # or including in the left parameter of @Graphic. # # # # This symbol is needed in various places so I've taken the coward's # # way out and @SysIncluded it at those places. # # # # Examples of behaviour for the PostScript back end: # # # # Parameter Result # # ------------------------------------------------------------ # # black "0.0 0.0 0.0 LoutSetRGBColor" # # darkblue "0.0 0.0 0.5 LoutSetRGBColor" # # white "1.0 1.0 1.0 LoutSetRGBColor" # # none "" # # nochange "" # # "" "" # # rgb " LoutSetRGBColor" # # cmyk " LoutSetCMYKColor" # # ------------------------------------------------------------ # # # # See the Expert's Guide for the use of LoutSetRGBColor and # # LoutSetCMYKColor rather than setrgbcolor and setcmykcolor. # # # # @ColourCommand also does the right thing for the PDF back end; # # its result is always empty for the PlainText back end. # # # ########################################################################### def @ColourCommand right @Body { def @RGB right coords { @BackEnd @Case { PostScript @Yield { coords "LoutSetRGBColor" } PDF @Yield { coords "rg" coords "RG" } PlainText @Yield "" } } def @CMYK right coords { @BackEnd @Case { PostScript @Yield { coords "LoutSetCMYKColor" } PDF @Yield { coords "k" coords "K" } PlainText @Yield "" } } def @RGBElse right alt { { "rgb" @Common @Body } @Case { "rgb" @Yield @RGB { "rgb" @Rump @Body } else @Yield alt } } def @CMYKElse right alt { { "cmyk" @Common @Body } @Case { "cmyk" @Yield @CMYK { "cmyk" @Rump @Body } else @Yield alt } } def @NoChangeElse right alt { @Body @Case { { "nochange" "none" "" } @Yield "" else @Yield alt } } def @RGBCoords { @Body @Case { black @Yield { 0.0 0.0 0.0 } darkblue @Yield { 0.0 0.0 0.5 } blue @Yield { 0.0 0.0 1.0 } lightblue @Yield { 0.5 0.5 1.0 } darkgreen @Yield { 0.0 0.5 0.0 } green @Yield { 0.0 1.0 0.0 } lightgreen @Yield { 0.5 1.0 0.5 } darkred @Yield { 0.5 0.0 0.0 } red @Yield { 1.0 0.0 0.0 } lightred @Yield { 1.0 0.5 0.5 } darkcyan @Yield { 0.0 0.5 0.5 } cyan @Yield { 0.0 1.0 1.0 } lightcyan @Yield { 0.5 1.0 1.0 } darkmagenta @Yield { 0.5 0.0 0.5 } magenta @Yield { 1.0 0.0 1.0 } lightmagenta @Yield { 1.0 0.5 1.0 } darkyellow @Yield { 0.5 0.5 0.0 } yellow @Yield { 1.0 1.0 0.0 } lightyellow @Yield { 1.0 1.0 0.5 } darkgray @Yield { 0.2 0.2 0.2 } gray @Yield { 0.5 0.5 0.5 } lightgray @Yield { 0.8 0.8 0.8 } darkgrey @Yield { 0.2 0.2 0.2 } grey @Yield { 0.5 0.5 0.5 } lightgrey @Yield { 0.8 0.8 0.8 } white @Yield { 1.0 1.0 1.0 } } } @RGBElse @CMYKElse @NoChangeElse @RGB @RGBCoords } ########################################################################### # # # @TextureCommand # # # # @TextureCommand converts a texture expressed in a manner that the # # ordinary user can comprehend into the PostScript texture dictionary # # needed to obtain that texture, suitable for passing to @SetTexture # # or including in the left parameter of @Graphic. # # # ########################################################################### def @TextureCommand left type named scale { 1 } named hscale { 1 } named vscale { 1 } import @PSLengths named angle { 0d } import @PSLengths named hshift { 0i } import @PSLengths named vshift { 0i } import @PSLengths named width { "dft" } import @PSLengths named height { "dft" } import @PSLengths named gap { "dft" } import @PSLengths named radius { "dft" } import @PSLengths named linewidth { "dft" } named font { "dft" } import @PSLengths named size { "dft" } named value { "dft" } { def @Dft left x right y { y @Case { "dft" @Yield x else @Yield y } } def @SolidTexture { "null LoutSetTexture" } def @StripedTexture { def @Width { "1 pt" @Dft width } def @Gap { "1 pt" @Dft gap } scale hscale vscale angle hshift vshift "2" "[ 0 0" @Width @Gap "add dup ]" @Width @Gap "add dup" "{" "pop 0 0 moveto" @Width @Gap "add 0 lineto" "0" @Width "rlineto" "0" @Width "lineto" "closepath fill" "}" "LoutMakeTexture LoutSetTexture" } def @GridTexture { def @Width { "1 pt" @Dft width } def @Gap { "1 pt" @Dft gap } scale hscale vscale angle hshift vshift "2" "[ 0 0" @Width @Gap "add dup ]" @Width @Gap "add dup" "{" "pop 0 0 moveto" @Width @Gap "add 0 lineto" "0" @Width "rlineto" @Gap "neg 0 rlineto" "0" @Gap "rlineto" @Width "neg 0 rlineto" "closepath fill" "}" "LoutMakeTexture LoutSetTexture" } def @DottedTexture { def @Radius { "0.5 pt" @Dft radius } def @Gap { "2 pt" @Dft gap } scale hscale vscale angle hshift vshift "2" "[ 0 0" @Gap "dup ]" @Gap "dup" "{" "pop" @Gap "2 div dup" @Radius "0 360 arc fill" "}" "LoutMakeTexture LoutSetTexture" } def @ChessboardTexture { def @Width { "2 pt" @Dft width } scale hscale vscale angle hshift vshift "2" "[ 0 0" @Width "2 mul dup ]" @Width "2 mul dup" "{" "pop 0 0 moveto" @Width "0 rlineto" "0" @Width "rlineto" @Width "neg 0 rlineto" closepath @Width @Width "moveto" @Width "0 rlineto" "0" @Width "rlineto" @Width "neg 0 rlineto" "closepath fill" "}" "LoutMakeTexture LoutSetTexture" } def @BrickworkTexture { def @Width { "6 pt" @Dft width } def @Height { "2 pt" @Dft height } def @Linewidth { "0.5 pt" @Dft linewidth } scale hscale vscale angle hshift vshift "2" "[ 0 0" @Width @Height "2 mul ]" @Width @Height "2 mul" "{" "pop 0 0 moveto" @Width "0 rlineto" "0" @Height "moveto" @Width "0 rlineto" "0" @Height "2 mul moveto" @Width "0 rlineto" "0 0 moveto 0" @Height "rlineto" @Width "0 moveto 0" @Height "rlineto" @Width "2 div" @Height "moveto 0" @Height "rlineto" "[] 0 setdash" @Linewidth "setlinewidth stroke" "}" "LoutMakeTexture LoutSetTexture" } def @HoneycombTexture { def @R { "2.0 pt" @Dft radius } def @Linewidth { "0.5 pt" @Dft linewidth } def @X { @R "0.5 mul" } def @Y { @R "0.886 mul" } def @NegX { @X "neg" } def @NegY { @Y "neg" } def @NegR { @R "neg" } def @BoxWidth { @R @X "add 2 mul" } def @BoxHeight { @Y "2 mul" } scale hscale vscale angle hshift vshift "2" "[ 0 0" @BoxWidth @BoxHeight "]" @BoxWidth @BoxHeight "{" "pop" @X "0 moveto" @R "0 rlineto" @X @Y "rlineto" @R "0 rlineto" @NegR "0 rlineto" @NegX @Y "rlineto" @NegR "0 rlineto" @NegX @NegY "rlineto" "closepath" "[] 0 setdash" @Linewidth "setlinewidth stroke" "}" "LoutMakeTexture LoutSetTexture" } def @TriangularTexture { def @R { "4.0 pt" @Dft radius } def @Linewidth { "0.5 pt" @Dft linewidth } def @X { @R "0.5 mul" } def @Y { @R "0.886 mul" } def @BoxWidth { @R } def @BoxHeight { @Y "2 mul" } scale hscale vscale angle hshift vshift "2" "[ 0 0" @BoxWidth @BoxHeight "]" @BoxWidth @BoxHeight "{" "pop" "0 0 moveto" @R "0 lineto" "0" @Y "2 mul lineto" @R "0 rlineto" "closepath" "0" @Y "moveto" @R "0 rlineto" "[] 0 setdash" @Linewidth "setlinewidth stroke" "}" "LoutMakeTexture LoutSetTexture" } def @StringTexture { def @Width { "12 pt" @Dft width } def @Height { "12 pt" @Dft height } def @Font { "Times-Roman" @Dft font } def @Size { "10 pt" @Dft size } def @Value { "*" @Dft value } scale hscale vscale angle hshift vshift "2" "[ 0 0" @Width @Height "]" @Width @Height "{" "pop /"@Font "findfont" @Size "scalefont setfont" "("@Value") dup false 0 0 moveto charpath flattenpath" "pathbbox pop pop neg exch neg exch moveto show" "}" "LoutMakeTexture LoutSetTexture" } type @Case { "solid" @Yield @SolidTexture "striped" @Yield @StripedTexture "grid" @Yield @GridTexture "dotted" @Yield @DottedTexture "chessboard" @Yield @ChessboardTexture "brickwork" @Yield @BrickworkTexture "honeycomb" @Yield @HoneycombTexture "triangular" @Yield @TriangularTexture "string" @Yield @StringTexture else @Yield type } } ########################################################################### # # # @TextureImport # # # # Used as an import for texture options. # # # # We cleverly replace @Texture by nothing inside those options, # # and replace the known types by themselves plus @TextureCommand. # # This allows the user to type # # # # texture { striped } # # texture { striped @Texture } # # texture { striped angle { 45d } } # # texture { striped @Texture angle { 45d } } # # # # and it all winds up being a call to @TextureCommand. # # # ########################################################################### export solid striped grid dotted chessboard brickwork honeycomb triangular string @Texture def @TextureImport { macro solid { "solid" @TextureCommand } macro striped { "striped" @TextureCommand } macro grid { "grid" @TextureCommand } macro dotted { "dotted" @TextureCommand } macro chessboard { "chessboard" @TextureCommand } macro brickwork { "brickwork" @TextureCommand } macro honeycomb { "honeycomb" @TextureCommand } macro triangular { "triangular" @TextureCommand } macro string { "string" @TextureCommand } macro @Texture { } }