blob: c92a145e85604af847e52db5dc91efa6e087073d [file] [log] [blame]
###############################################################################
# #
# Lout @Geometry package for algebra and geometry in PostScript #
# Version 1.0 (June 1996) #
# Jeffrey H. Kingston #
# #
###############################################################################
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
}
}