%%HP: T(3)A(D)F(.);
@ Digi24 by Rodger Rosenbaum
DIR
  PeVAL
    \<< \-> c x
      \<< 'c(1)' EVAL 0 c SIZE OBJ\-> DROP 2 SWAP
        FOR i x 0 MUL2 'c(i)' EVAL 0 ADD2
        NEXT +
      \>>
    \>>
  GAUS
    \<< AUGM ELIM BACK
    \>>
  AUGM
    \<< TRN \->STR
      1 OVER SIZE 1 - SUB SWAP TRN \->STR
      2 OVER SIZE SUB + STR\-> TRN MAKE
    \>>
  LOOK
    \<< DEPTH 1 + 2 / DUP ROT - SWAP \-> a b
      \<< a PCK b GET SWAP b GET SWAP SHO2
      \>>
    \>>
  QAD
    \<< SWAP 2 / NEG \-> a c b
      \<< b 0 DUP2 MUL2 a 0 c 0 MUL2 SUB2 SQR2 +
        b SIGN DUP 0 == + * b + DUP a /
        IF DUP TYPE 1 \=/
        THEN c ROT
          IF DUP 0 ==
          THEN SWAP DROP
          ELSE /
          END
        ELSE SWAP DROP DUP CONJ
        END
      \>>
    \>>
  BACK
    \<< DEPTH 2 / \-> s
      \<< s 2
        FOR x x UNIT x 1 - 1
          FOR y x y RED -1
          STEP -1
        STEP
      \>> 2000 .25 BEEP
    \>>
  ELIM
    \<< DEPTH 2 / DUP 1 + 'SIZ' STO \-> s
      \<< 1 s 1 -
        FOR x SIZ x - PIVX x UNIT s x 1 +
          FOR y x y RED -1
          STEP
        NEXT
      \>> 2000 .25 BEEP
    \>>
  MAKE
    \<< \->STR 2 OVER SIZE 1 - SUB STR\-> DEPTH 1 SWAP
      START DEPTH ROLL DUP 0 *
      NEXT
    \>>
  UNIT
    \<< DUP SIZ SWAP - 2 * \-> s r
      \<< r ROLL r ROLL DUP2 s GET SWAP s GET SWAP DIV2 r ROLLD r ROLLD
      \>>
    \>>
  RED
    \<< \-> r s
      \<< SIZ s - PCK r GET SWAP r GET SIZ r - SIZ s - 2 *
      \>> \-> b a r s
      \<< r PCK s 2 + ROLL s 2 + ROLL SWP2 a b MUL2 SUB2 s ROLLD s ROLLD
      \>>
    \>>
  PIV
    \<< DUP 2 * SIZ ROT - \-> q s
      \<< q 2 - 1
        FOR r q PICK s GET ABS r 1 + PICK s GET ABS
          IF <
          THEN r q EXG
          END -2
        STEP
      \>>
    \>>
  PIVX
    \<< DUP 2 * SIZ ROT - \-> q s
      \<< q DUP 1 + PICK s GET ABS q 2 - 1
        FOR r r 2 + PICK s GET ABS DUP2
          IF <
          THEN ROT ROT DROP2 r SWAP
          ELSE DROP
          END -2
        STEP DROP q DUP2
        IF \=/
        THEN EXG 1000 .1 BEEP
        ELSE DROP2
        END
      \>>
    \>>
  EXG
    \<< DUP2
      IF >
      THEN SWAP
      END \-> u v
      \<< u ROLL u ROLL v ROLL v ROLL SWP2 v ROLLD v ROLLD u ROLLD u ROLLD
      \>>
    \>>
  SUB2
    \<< \-> x x1 y y1
      \<< x y - DUP x OVER - DUP y - x 4 ROLL 4 ROLL + - + x1 + y1
        -
        SWAP DUP2 + DUP 4 ROLLD - +
      \>>
    \>>
  ADD2
    \<< \-> x x1 y y1
      \<< x y + DUP x OVER - DUP y + x 4 ROLL 4 ROLL + - + x1 + y1
        +
        SWAP DUP2 + DUP 4 ROLLD - +
      \>>
    \>>
  DIV2
    \<< \-> x x1 y y1
      \<< x y / DUP DUP y MUL x ROT - SWAP - x1 + SWAP y1 * - y
        /
        SWAP DUP2 + DUP 4 ROLLD - +
      \>>
    \>>
  MUL2
    \<< \-> x x1 y y1
      \<< x y MUL x y1 * x1 y * + + SWAP DUP2 + DUP 4 ROLLD - +
      \>>
    \>>
  SQR2
    \<< OVER
      IF DUP ABS 0 \=/
      THEN \v/ DUP DUP MUL 5 ROLL ROT - SWAP - ROT + .5 *
        OVER / DUP 3 PICK + DUP 4 ROLL SWAP - ROT +
      ELSE SWAP DROP
      END
    \>>
  SHO2
    \<< DUP2
      IF DUP 0 \=/
      THEN SIGN DUP 0 == + SWAP SIGN DUP 0 == +
        IF \=/
        THEN OVER XPON 11 - ALOG 3 PICK SIGN * DUP 4 ROLL SWAP - 3 ROLLD +
          IF DUP2 XPON SWAP XPON SWAP - 12 \=/
          THEN DUP DUP XPON ALOG SWAP OVER / IP * ROT OVER + ROT ROT -
          END
        END
      ELSE DROP2
      END RCLF 11 SCI ROT ROT
      IF DUP 0 \=/
      THEN OVER XPON OVER XPON - 11 - "0000000000000" 1 ROT SUB
      ELSE "0"
      END 3 ROLLD SWAP \->STR SWAP ABS \->STR DUP 1 1 SUB SWAP 3 20 SUB + 1
        OVER "E" POS 1 - SUB ROT SWAP + 2 13 SUB ROT STOF
    \>>
  Dup2
    \<< DUP2
    \>>
  PCK
    \<< 2 * DUP 1 + PICK SWAP PICK
    \>>
  OVR2
    \<< 4 PICK 4 PICK
    \>>
  SWP2
    \<< 4 ROLL 4 ROLL
    \>>
  MUL
    \<< DUP2 * ROT ROT SPLT ROT SPLT \-> h1 t1 h2 t2
      \<< h1 h2 * OVER - h1 t2 * + h2 t1 * + t1 t2 * +
      \>>
    \>>
  SPLT
    \<< DUP DUP 1000001 * DUP ROT - - SWAP OVER -
    \>>
  SIZ 6
END