diff options
Diffstat (limited to 'include/diagf.etc')
-rw-r--r-- | include/diagf.etc | 627 |
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 + } +} |