lout-common 3.39-1 / usr / share / lout / include / diagf.etc

###############################################################################
#                                                                             #
#  Lout @Geometry package for algebra and geometry in PostScript              #
#  Version 1.0 (June 1996)                                                    #
#  Jeffrey H. Kingston                                                        #
#                                                                             #
#  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.        #
#                                                                             #
###############################################################################

export

    i c p m s v f d "-0" "-1" "-2" "-3" "-4" "-5" "-6" "-7" "-8" "-9" "-."
    pi e sqrt abs ceiling floor truncate round cos sin atan
    exp log rand max min "*" "/" idiv mod "+" "-"
    xcoord ycoord distance angleto ":=" ":==" "::" ":<" prev "??" "?!?"
    boundaryatangle atangle
    "**" "++" "--" anglefix anydebug ","
    "=" "!=" "==" "!==" "<" "<=" ">" ">=" not and xor or
    if quadcase signcase xloop yloop zloop
    cabout aabout

def @Geometry
{
    def i
	precedence 100
	left x
    {
	x "in"
    }

    def c
	precedence 100
	left x
    {
	x "cm"
    }

    def p
	precedence 100
	left x
    {
	x "pt"
    }

    def m
	precedence 100
	left x
    {
	x "em"
    }

    def s
	precedence 100
	left x
    {
	x "sp"
    }

    def v
	precedence 100
	left x
    {
	x "vs"
    }

    def f
	precedence 100
	left x
    {
	x "ft"
    }

    def d
	precedence 100
	left x
    {
	x "dg"
    }

    def pi
    {
	"ldiagpi"
    }

    def e
    {
	"ldiage"
    }

    def sqrt
	precedence 99
	right y
    {
	y "sqrt"
    }

    def abs
	precedence 99
	right y
    {
	y "abs"
    }

    def anglefix
	precedence 99
	right y
    {
	y "ldiagfixangle"
    }

    def ceiling
	precedence 99
	right y
    {
	y "ceiling"
    }

    def floor
	precedence 99
	right y
    {
	y "floor"
    }

    def truncate
	precedence 99
	right y
    {
	y "truncate"
    }

    def round
	precedence 99
	right y
    {
	y "round"
    }

    def cos
	precedence 99
	right y
    {
	y "cos"
    }

    def sin
	precedence 99
	right y
    {
	y "sin"
    }

    def xcoord
	precedence 99
	right y
    {
	y "pop"
    }

    def ycoord
	precedence 99
	right y
    {
	y "exch pop"
    }

    def distance
	precedence 98
	left x
	right y
    {
	x y "ldiagdistance"
    }

    def angleto
	precedence 98
	left x
	right y
    {
	x y "ldiagangleto"
    }

    def atan
	precedence 98
	left x
	right y
    {
	x y "atan"
    }

    def exp
	precedence 98
	left x
	right y
    {
	x y "exp"
    }

    def log
	precedence 98
	left x
	right y
    {
	x y "ldiaglog"
    }

    def rand
	precedence 98
	left x
	right y
    {
	x y "dorand"
    }

    def max
	precedence 98
	left x
	right y
    {
	x y "ldiagmax"
    }

    def min
	precedence 98
	left x
	right y
    {
	x y "ldiagmin"
    }

    def "*"
	precedence 97
	left x
	right y
    {
	x y "mul"
    }

    def "/"
	precedence 96
	associativity left
	left x
	right y
    {
	x y "div"
    }

    def idiv
	precedence 96
	associativity left
	left x
	right y
    {
	x y "idiv"
    }

    def mod
	precedence 96
	left x
	right y
    {
	x "cvi" y "cvi mod"
    }

    def "+"
	precedence 95
	associativity left
	left x
	right y
    {
	x @Case {
	    ""   @Yield y
	    else @Yield { x y "add" }
	}
    }

    def "-"
	precedence 95
	associativity left
	left x
	right y
    {
	x @Case {
	    ""   @Yield { y "neg" }
	    else @Yield { x y "sub" }
	}
    }

    def "-0" { "-0" }
    def "-1" { "-1" }
    def "-2" { "-2" }
    def "-3" { "-3" }
    def "-4" { "-4" }
    def "-5" { "-5" }
    def "-6" { "-6" }
    def "-7" { "-7" }
    def "-8" { "-8" }
    def "-9" { "-9" }
    def "-." { "-." }

    def prev
    {
	"ldiagprevious"
    }

    def "??"
	precedence 99
	left x
	right y
    {
	"{" x "} ("y") ldiagdolabel"
    }

    def "?!?"
	precedence 99
	left x
	right y
    {
	"{" x "} "y" ldiagdolabel"
    }

    def boundaryatangle
	precedence 89
	left x
	right y
    {
	x??"CTR" y x??"CIRCUM" "ldiagpadd"
    }

    def atangle
	precedence 89
	left x
	right y
    {
	0 0 x y "ldiagatangle"
    }

    def "**"
	precedence 88
	left x
	right y
    {
	x y "ldiagpmul"
    }

    def "++"
	precedence 87
	associativity left
	left x
	right y
    {
	x y "ldiagpadd"
    }

    def "--"
	precedence 87
	associativity left
	left x
	right y
    {
	y x "ldiagpsub"
    }

    def "="
	precedence 79
	left x
	right y
    {
	x y "eq"
    }

    def "!="
	precedence 79
	left x
	right y
    {
	x y "ne"
    }

    def "=="
	precedence 79
	left x
	right y
    {
	x y "ldiagangleeq"
    }

    def "!=="
	precedence 79
	left x
	right y
    {
	x y "ldiaganglene"
    }

    def "<"
	precedence 79
	left x
	right y
    {
	x y "lt"
    }

    def "<="
	precedence 79
	left x
	right y
    {
	x y "le"
    }

    def ">"
	precedence 79
	left x
	right y
    {
	x y "gt"
    }

    def ">="
	precedence 79
	left x
	right y
    {
	x y "ge"
    }

    def not
	precedence 78
	right y
    {
	y "not"
    }

    def and
	precedence 77
	left x
	right y
    {
	x y "and"
    }

    def xor
	precedence 76
	left x
	right y
    {
	x y "xor"
    }

    def or
	precedence 76
	left x
	right y
    {
	x y "or"
    }

    def ","
	precedence 70
	left x
	right y
    {
	OOO ++ { OOX -- OOO }**x ++ { OOY -- OOO }**y
    }

    def ":="
	precedence 20
	left x
	right y
    {
	"/"x "[" y "] cvx def"
    }

    def ":=="
	precedence 20
	left x
	right y
    {
	"/"x "[" y "counttomark 2 add (assigning) exch ldiagdebugprint ] cvx def"
    }

    def "::"
	precedence 20
	left x
	right y
    {
	y "/"x "ldiagpointdef"
    }

    def ":<"
	precedence 20
	left x
	right y
    {
	y "/"x"@ANGLE ldiagangledef"
    }

    def if
	named cond {}
	named then {}
	named else {}
    {
	cond "{" then "} {" else "} ifelse"
    }

    def quadcase
	precedence 10
	left angle
	named "0"	{}
	named "0-90"	{}
	named "90"	{}
	named "90-180"	{}
	named "180"	{}
	named "180-270"	{}
	named "270"	{}
	named "270-360"	{}
    {
	"{" 0-90 "} {" 270 "} {" 180 "} {" 90 "}"
	"{" 0 "} {" 270-360 "} {" 180-270 "} {" 90-180 "}" angle "ldiagquadcase"
    }

    def signcase
	precedence 10
	left number
	named neg {}
	named zero {}
	named pos {}
    {
	"{" neg "} {" zero "} {" pos "}" number "ldiagsigncase"
    }

    def xloop
	named from { 0 }
	named to { 0 }
	named by { 1 }
	named do named x { "xval" } {}
    {
	from by to "{ /xval exch def" do "} for"
    }

    def yloop
	named from { 0 }
	named to { 0 }
	named by { 1 }
	named do named y { "yval" } {}
    {
	from by to "{ /yval exch def" do "} for"
    }

    def zloop
	named from { 0 }
	named to { 0 }
	named by { 1 }
	named do named z { "zval" } {}
    {
	from by to "{ /zval exch def" do "} for"
    }

    def anydebug
	right tag
    {
	"[" tag "counttomark ("tag") exch ldiagdebugprint cleartomark"
    }

    def aabout
	named circum {}
	named extra {}
	named centre {}
    {
	"{" circum "} cvlit" extra "[" centre "] cvx ldiagaabout"
	# ZXCTR	:= centre
	# ZFCTR	:= circum??CTR
	# ZAREF	:= ZFCTR angleto ZXCTR
	# ZAMIN	:= 0d
	# ZPMIN	:= circum boundaryatangle { ZAREF - ZAMIN }
	# 		 ++ extra atangle { ZAREF - ZAMIN }
	# ZAMAX	:= 90d
	# ZPMAX	:= circum boundaryatangle { ZAREF - ZAMAX }
	# 		 ++ extra atangle { ZAREF - ZAMAX }
	# xloop from { 1 } to { 12 } by { 1 } do {
	#   ZAMID	:= { ZAMIN + ZAMAX } * 0.5
	#   ZPMID	:= circum boundaryatangle { ZAREF - ZAMID }
	# 		 ++ extra atangle { ZAREF - ZAMID }
	#   if cond { {ZPMID distance ZXCTR} > {ZFCTR distance ZXCTR} } then {
	#     ZAMAX := ZAMID
	#     ZPMAX := ZPMID
	#   }
	#   else {
	#     ZAMIN := ZAMID
	#     ZPMIN := ZPMID
	#   }
	# }
	# ZPMID
    }

    def cabout
	named circum {}
	named extra {}
	named centre {}
    {
       "{" circum "} cvlit" extra "[" centre "] cvx ldiagcabout"
       # ZXCTR	:= centre
       # ZFCTR	:= circum??CTR
       # ZAREF	:= ZFCTR angleto ZXCTR
       # ZAMIN	:= 0d
       # ZPMIN	:= circum boundaryatangle { ZAREF + ZAMIN }
       # 		 ++ extra atangle { ZAREF + ZAMIN }
       # ZAMAX	:= 90d
       # ZPMAX	:= circum boundaryatangle { ZAREF + ZAMAX }
       # 		 ++ extra atangle { ZAREF + ZAMAX }
       # xloop from { 1 } to { 12 } by { 1 } do {
       #   ZAMID	:= { ZAMIN + ZAMAX } * 0.5
       #   ZPMID	:= circum boundaryatangle { ZAREF + ZAMID }
       # 		 ++ extra atangle { ZAREF + ZAMID }
       #   if cond { {ZPMID distance ZXCTR} > {ZFCTR distance ZXCTR} } then {
       #     ZAMAX := ZAMID
       #     ZPMAX := ZPMID
       #   }
       #   else {
       #     ZAMIN := ZAMID
       #     ZPMIN := ZPMID
       #   }
       # }
       # ZPMID
    }
}