aboutsummaryrefslogtreecommitdiffstats
path: root/include/diagf.etc
diff options
context:
space:
mode:
Diffstat (limited to 'include/diagf.etc')
-rw-r--r--include/diagf.etc627
1 files changed, 627 insertions, 0 deletions
diff --git a/include/diagf.etc b/include/diagf.etc
new file mode 100644
index 0000000..c92a145
--- /dev/null
+++ b/include/diagf.etc
@@ -0,0 +1,627 @@
+
+###############################################################################
+# #
+# 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
+ }
+}