%%HP: T(3)A(D)F(.);
@ SEG Program - Segment of a circle.  
@   Given any 2 of the 5 dimensions, solve for all of the others
@   SEG is actually a directory with several functions and 
@       variables.  This creates the various objects in a sequence
@       that makes the VAR menu do the job.
@   RBJ 3/22/90 Initial efforts
@       3/23/90 Case logic for function execution, empty stack logic
@       3/24/90 Finish iterative cases, use Flag 6
@       5/05/90 Shortened variable names, inline code, decimal code
@               Print if flag 9 is set (Highest 2.5 byte flag)
DIR
  Arc    \<< 'Ar' "Arc"   16 iF \>>
  Rise   \<< 'Ri' "Rise"   8 iF \>>
  Chord  \<< 'Ch' "Chord"  4 iF \>>
  Radiu  \<< 'Ra' "Radius" 2 iF \>>
  Angl   \<< 'An' "Angle"  1 iF \>>
  Disp   \<< 
    iC CASE
      DUP 24 == THEN ArRi END
      DUP 20 == THEN ArCh END
      DUP 18 == THEN ArRa END
      DUP 17 == THEN ArAn END
      DUP 12 == THEN RiCh END
      DUP 10 == THEN RiRa END
      DUP  9 == THEN RiAn END
      DUP  6 == THEN ChRa END
      DUP  5 == THEN ChAn END
      DUP  3 == THEN RaAn END
    END
    CLLCD                                   @ Clear Screen
    IF                                      @ Test iC code left on stack
      THEN "New" ELSE "Prev"
    END  
    " Results" +
    IF 9 FS? THEN CR PR1 END                @ Print control on FLAG 9
    1 DISP
    2 Ar "Arc"    rD
    3 Ri "Rise"   rD
    4 Ch "Chord"  rD
    5 Ra "Radius" rD
    6 An "Angle"  rD
    3 FREEZE 
    0 'iC' STO 6 CF
  \>>

  Ar 0  Ri 0  Ch 0  An 0  Ra 0              @ Main variables
  fW 12                                     @ Numeric Field Width
  iC 0                                      @ Current sum of input flags

  iF  \<<                                   @ Common Input function
    \-> var lab code \<<                    @ Create local variables
      IF DEPTH 0 == THEN var RCL END        @ If nothing on stack use prev
      DUP var STO                           @ Store
      lab ": " + SWAP + "\010" +            @ "Tagged" display on line 1
      1 DISP 1 FREEZE 
      code 'iC' STO+                        @ Add Input flag code
      IF 6 FS?C                             @ Flag 6 flags 1st data item IN
        THEN Disp ELSE 6 SF                 @ If set, Clear and solve    
      END 
    \>>             
  \>>

  rD \<<                                    @ line value label -> [display]
    SWAP fW                                 @ value fieldWidth for right just
    SWAP \->STR DUP SIZE                    @ Convert value to string, get len
    ROT - NEG                               @ Number of blanks to prepend
    "            " 1 ROT SUB                @ Get Blanks
    SWAP + " " + SWAP +                     @ Pad, Add Label
    IF 9 FS? THEN PR1 END                   @ Print control on FLAG 9
    SWAP DISP \>>                           @ Display on specified line

  @ *** Actual Computation Routines ***

  Iter \<<
   'Ra' Ar ROOT                           @ Find Ra (guess = Ar  )
   'Ra' STO DEG ArRa \>>

  ArRi \<< RAD                              @ Arc / Rise (Solver for Ra)
    \<< Ar Ra / 2 /                         @ Angle given arc, trial rad
        COS NEG 1 + Ra * Ri - \>>           @ computed - actual rise
    Iter \>>                                @ Solve for Ra, etc
  ArCh \<< RAD                              @ Arc / Chord (Solver for Ra)
    \<< Ar Ra / 2 /                         @ Angle given arc, trial rad
        SIN Ra * 2 * Ch - \>>               @ Computed - Actual chord
    Iter \>>                                @ Solve for Ra, etc
  ArRa \<<                                  @ Arc / Radius
    Ar Ra / R\->D 'An' STO                  @ Compute Angle
    RaAn \>>
  ArAn \<<                                  @ Arc / Angle
    Ar An D\->R / 'Ra' STO                  @ Compute radius
    RaAn \>>

  RiCh \<<                                  @ Rise / Chord (see AISC)
    4 Ri SQ * Ch SQ + 8 Ri * /              @ Find radius
    'Ra' STO ChRa \>>
  RiRa \<<                                  @ Given Radius, Rise
    Ra Ri - Ra / ACOS 2 * 'An' STO          @ Compute Angle
    RaAn \>>
  RiAn \<<                                  @ Rise / Angle
    Ri An 2 / COS NEG 1 + / 'Ra' STO        @ Compute radius
    RaAn \>>

  ChRa \<<                                  @ Chord / Radius
    Ch 2 / Ra / ASIN 2 * 'An' STO           @ Compute angle
    RaAn \>>
  ChAn \<<                                  @ Chord / Angle
    Ch 2 / An 2 / SIN / 'Ra' STO            @ Compute radius
    RaAn \>>

                                            @ MAIN COMPUTE FUNCTION
  RaAn \<<                                  @ Radius / Angle
    An D\->R Ra * 'Ar' STO                  @ Compute Arc Length
    An 2 / DUP SIN Ra * 2 * 'Ch' STO        @ Compute Chord
    COS NEG 1 + Ra * 'Ri' STO  \>>          @ Compute Rise

END

