diff options
Diffstat (limited to 'include/include/coltex')
| -rw-r--r-- | include/include/coltex | 434 |
1 files changed, 0 insertions, 434 deletions
diff --git a/include/include/coltex b/include/include/coltex deleted file mode 100644 index 079b759..0000000 --- a/include/include/coltex +++ /dev/null @@ -1,434 +0,0 @@ - -########################################################################### -# # -# 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 <red> <blue> <green> "<red> <blue> <green> LoutSetRGBColor" # -# cmyk <c> <m> <y> <k> "<c> <m> <y> <k> 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 { } -} |