%%HP: T(3)A(D)F(.);
DIR
  CPOLY
  \<< { } 'POLYGON' STO
  \>>
  KOOIN
  \<< \->V2 POLYGON SWAP
+ 'POLYGON' STO
  \>>
  AREA
  \<< 'POLYGON' VTYPE
    IF -1. ==
    THEN 3000. .1
BEEP 2000. .1 BEEP
3000. .1 BEEP CLLCD
"POLYGON
  nicht
   gefunden!"
MSGBOX
    ELSE POLYGON
BYTES SWAP DROP
      IF 90. <
      THEN 3000. .1
BEEP 2000. .1 BEEP
3000. .1 BEEP CLLCD
"POLYGON Fehler!"
MSGBOX
      ELSE POLYGON
DUP HEAD + 2.
        \<< CROSS 2. /
        \>> DOSUBS
        \<< +
        \>> STREAM V\-> +
+
      END
    END
  \>>
  CALC
  \<< RCLF { -20. -20.
-21. -31. -95. } CF {
-2. -3. -22. -90.
-103. -105. } SF DEG
RECT DEC 'POLYGON'
VTYPE
    IF -1. ==
    THEN 3000. .1
BEEP 2000. .1 BEEP
3000. .1 BEEP CLLCD
" POLYGON
  nicht 
   gefunden!"
MSGBOX
    ELSE POLYGON
BYTES SWAP DROP
      IF 90. <
      THEN 3000. .1
BEEP 2000. .1 BEEP
3000. .1 BEEP CLLCD
"POLYGON Fehler!"
MSGBOX
      ELSE POLYGON
DUP HEAD + DUP DUP
DUP 2.
        \<< CROSS 2. /
        \>> DOSUBS 1.
        \<< V\-> + +
        \>> DOLIST DUP
        \<< +
        \>> STREAM 'A'
STO
        IF A 0. ==
        THEN 2000. .1
BEEP 1000. .1 BEEP
2000. .1 BEEP
"      A=0!
 Keine 
  Berechnung!"
MSGBOX DROP DROP DROP
DROP 'A' PURGE
        ELSE A
          IF 0. <
          THEN 2000.
.1 BEEP 1000. .1 BEEP
2000. .1 BEEP
"Umlaufsinn
 nicht positiv!
Werte negativ!"
MSGBOX
          END SWAP 2.
          \<< + 3. /
          \>> DOSUBS
          \<< *
          \>> DOLIST
          \<< +
          \>> STREAM A
/ V\-> 'ys' STO 'xs'
STO 2.
          \<< V\-> ROT V\->
\-> x2 y2 x1 y1
            \<< y1 y2 +
SQ y1 y2 * - x1 y2 *
x2 y1 * - *
            \>>
          \>> DOSUBS
          \<< +
          \>> STREAM
12. / DUP 'Ix' STO A
ys SQ * - 'Ixs' STO
DUP 2.
          \<< V\-> ROT V\->
\-> x2 y2 x1 y1
            \<< x1 x2 +
SQ x1 x2 * - x1 y2 *
x2 y1 * - *
            \>>
          \>> DOSUBS
          \<< +
          \>> STREAM
12. / DUP 'Iy' STO A
xs SQ * - 'Iys' STO
2.
          \<< V\-> ROT V\->
\-> x2 y2 x1 y1
            \<< x1 x2 +
y1 y2 + * x1 y2 * x2
y1 * + 2. / - x1 y2 *
x2 y1 * - *
            \>>
          \>> DOSUBS
          \<< +
          \>> STREAM
12. / DUP 'Ixy' STO A
xs ys * * - 'Ixys'
STO
          IF Ixys 0.
==
          THEN 0.
          ELSE 2.
Ixys * Iys Ixs - /
ATAN 2. /
          END '\Gb\^o'
STO Ixs Iys - 2. / \Gb\^o
2. * COS * Ixys \Gb\^o 2.
* SIN * - DUP Ixs Iys
+ 2. / + 'Iu' STO Ixs
Iys + 2. / SWAP -
'Iv' STO Iv ABS Iu
ABS
          IF <
          THEN Iv ABS
A ABS / \v/
          ELSE Iu ABS
A ABS / \v/
          END 'imin'
STO
          \<< { DEL A
xs ys Ix Iy Ixy Ixs
Iys Ixys Iv Iu \Gb\^o
imin } PURGE
          \>> 'DEL' STO
{ DEL A xs ys Ix Iy
Ixy Ixs Iys Ixys Iu
Iv \Gb\^o imin } ORDER
        END
      END
    END STOF
  \>>
  RESULTS
  \<< RCLF 'Flagsave'
STO { -20. -20. -21.
-31. -95. } CF { -2.
-3. -22. -90. -103.
-105. } SF DEG RECT
DEC
    \<< { POLYGON A xs
ys Ix Iy Ixy Ixs Iys
Ixys Iu Iv \Gb\^o imin }
DUP VTYPE SORT HEAD
      IF -1. ==
      THEN CLLCD
1000. .1 BEEP
"Keine 
  Variablen!"
MSGBOX
"    Keine Werte!"
      ELSE
"       Resultate"
      END
    \>> EVAL CLLCD SWAP
DUP
    \<< EVAL
    \>> DOLIST SWAP
    \<< \->TAG
    \>> DOLIST 1.
CHOOSE DROP Flagsave
STOF 'Flagsave' PURGE
  \>>
  QPLOT
  \<< 'POLYGON' VTYPE
    IF -1. ==
    THEN 3000. .1
BEEP 2000. .1 BEEP
3000. .1 BEEP CLLCD
"POLYGON
  nicht
   gefunden!"
MSGBOX
    ELSE POLYGON
BYTES SWAP DROP
      IF 62. <
      THEN 3000. .1
BEEP 2000. .1 BEEP
3000. .1 BEEP CLLCD
"POLYGON Fehler!"
MSGBOX
      ELSE POLYGON 1.
        \<< V\-> DROP
        \>> DOSUBS SORT
DUP HEAD SWAP REVLIST
HEAD POLYGON 1.
        \<< V\-> SWAP
DROP
        \>> DOSUBS SORT
DUP HEAD SWAP REVLIST
HEAD ROT SWAP \->V2
'Vmax' STO \->V2 'Vmin'
STO Vmax Vmin - ABS
        IF 0. ==
        THEN 3000. .1
BEEP 2000. .1 BEEP
3000. .1 BEEP
"Plotten des
 POLYGONs
  nicht 
   m\246glich!"
CLLCD MSGBOX { Vmin
Vmax } PURGE
        ELSE Vmax
Vmin - V\-> \-> xd yd
          \<< xd yd /
ABS 122. 55. /
            IF >
            THEN xd
ABS 12.2 /
            ELSE yd
ABS 5.5 /
            END
          \>> Vmax Vmin
+ 2. / POLYGON SWAP -
SWAP / ERASE { # 0d
# 0d } PVIEW { # 0d
# 0d } { # 130d # 63d
} BOX PICT { # 0d
# 0d } "QSW" 1. \->GROB
REPL DUP HEAD + 2.
          \<< V\-> R\->C
SWAP V\-> R\->C SWAP LINE
          \>> DOSUBS 7.
FREEZE { PPAR Vmin
Vmax } PURGE
        END
      END
    END
  \>>
END