!! File: ComplexRoots
!! December 8, 2002 Hubert Hohn

PUBLIC PCFlag,Mac5Flag,M68KFlag,UnixFlag,xmax,ymax
PUBLIC toolLft,toolRgt,toolBas,toolTop,toolhdr,toolHgt,toolWid  ! tool boundaries
PUBLIC winLft,winRgt,winBas,winTop,winHgt,winWid      ! window
PUBLIC workLft,workRgt,workBas,workTop,workMidx  ! work area
PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white
PUBLIC red,yellow,green,cyan,blue,magenta,pink,colorscheme
PUBLIC planeclr,gridclr,rimclr,axisclr,axislabelclr,titleclr,rightsclr
PUBLIC numberlineclr,slotdrkclr,slotlgtclr,slideclr
PUBLIC largefonts, title$, SLUmode

LET toolHgt= 560
LET toolWid= 780
LET window$= "The d'Arbeloff Interactive Math Project"
LET colorscheme= 0

LET title$ = "Complex Roots"

SUB ThisProgram
    CALL ComplexRoots
    CLEAR
END SUB


!! ---------------------------------------------------------
!! ------ Start TB4 Mac Header and Subs ------

!LET M68KFlag = 1
!LIBRARY "MacTools*", "HHLib.trc"
!ASK PIXELS winWid,winHgt
!LET winLft= 0
!LET winTop= 0
!LET winRgt= winWid-1
!LET winBas= winHgt-1
!SET WINDOW 0,winRgt,winBas,0
!CALL Palette
!CLEAR
!
!CALL ToolPanel
!CALL ThisProgram
!
!END
!EXTERNAL
!
!MODULE Mac4Parts
!    SUB SetTextFont(font,size,style$)
!        CALL MacTextFont(font)
!        CALL MacTextSize(size)
!        CALL MacTextFace(style$)
!    END SUB
!
!    SUB StringWidth(sw$,sl)
!        DECLARE DEF MacStringWidth
!        LET sl= MacStringWidth(sw$)
!    END SUB
!
!    SUB SetLineWeight(wgt)
!        CALL MacPenSize(wgt,wgt)
!    END SUB
!
!    SUB BoxDisk(Lft,Rgt,Bas,Top)
!        CALL MacPaintOval(Lft,Rgt,Bas,Top)
!    END SUB
!END MODULE

!! --- End TB4 Mac Header and Subs ---
!!---------------------------------------------------------
!!--- Start TB5 Cross-Platform header and subs ---

LIBRARY "c:\TB Gold 51a\TBLibs\TrueCtrl.trc"     ! windows
LIBRARY "c:\TB Gold 51a\TBLibs\HHLib.trc"

!LIBRARY ":TBLibs:TrueCtrl.trc"                   ! macintosh
!LIBRARY "HHLib.trc"

PUBLIC WinID
DECLARE PUBLIC OBJM_SET,OBJM_SYSINFO
LET winHgt= toolHgt
LET winWid= toolWid
DIM values(1)

CALL TC_Init

CALL Object(OBJM_SYSINFO,WinID,"MACHINE",system$,values())
IF system$="MAC" then
   LET Mac5Flag= 1
ELSE IF system$="WIN32" then
   LET PCFlag  = 1
END IF

CALL TC_SetUnitsToPixels                         ! 5.1 and up needs this
CALL TC_GetScreenSize(scrnLft,scrnRgt,scrnBas,scrnTop)
LET winLft= int((scrnRgt-scrnLft-winWid)/2)
LET winRgt= winLft+winWid-1
LET winTop= int((scrnBas-scrnTop-winHgt)/2) + 10
LET winBas= winTop+winHgt-1

CALL TC_Win_Create (WinID,"TITLE",winLft,winRgt,winBas,winTop)
LET values(1)= 2
CALL Object(OBJM_SET, WinID, "TYPE", "", values())

IF PCFlag=1 then                                 ! kill dithering
   LET  values(1)= 1
   CALL Object(OBJM_SET, WinID, "SOLID MIX", "", values())
END IF

LET  values(1)= 0
CALL TC_SetRect(WinID,winLft,winRgt,winBas,winTop)
CALL TC_Win_SetTitle(WinID,window$)
CALL TC_Show(WinID)

SET MODE "COLORSTANDARD"

ASK PIXELS winWid,winHgt                         ! must follow set mode
LET winLft= 0
LET winTop= 0
LET winRgt= winWid-1
LET winBas= winHgt-1
SET WINDOW 0,winRgt,winBas,0

CALL Palette

IF PCFlag=1 then
   LET  values(1)= 0                             ! now force solid colors
   CALL Object(OBJM_SET, WinID, "SOLID MIX", "", values())
   CALL TC_Win_RealizePalette(WinID)             ! some PCs need this

   CALL TC_Win_SetFont(WinID,"arial",9,"plain")
   CALL StringWidth("0",sw)
   IF sw>7 then LET largefonts=1 else LET largefonts=0
END IF

CALL TC_Win_Switch(WinID)

CALL ToolPanel
CALL ThisProgram

CALL SetTextFont(1,12,"bold")                    ! now shut down and clean up
LET quit$= "click the mouse or press a key to close..."
CALL PlotTextCJ(workmidx,(workbas+worktop)/2,quit$,yellow)
CALL TC_CleanUp

END
EXTERNAL

MODULE TB5Parts
    SUB StringWidth(sw$,sl)
        DECLARE PUBLIC WinID
        LET sl= StrWidth(WinID,sw$)
    END SUB

    SUB SetLineWeight(wgt)
        DECLARE PUBLIC OBJM_SET
        DECLARE PUBLIC WinID
        DIM values(1)
        LET values(1)= wgt
        CALL Object(OBJM_SET,WinID, "WIDTH", "", values())
    END SUB

    SUB SetTextFont(font,size,style$)
        DECLARE PUBLIC WinID,Mac5Flag,PCFlag,largefonts
        IF Mac5Flag=1 then
           SELECT CASE font
           CASE 4
                LET font$= "Courier"
           CASE 16
                LET font$= "Times"
           CASE else
                LET font$= "Geneva"
           END SELECT
        ELSE IF PCFlag=1 then
           IF largefonts=1 then
              IF size<12 then
                 LET size=  6
              ELSE IF size=14 then
                 LET size= 10
              ELSE IF size=18 then
                 LET size= 12
              ELSE IF size=24 then
                 LET size= 14
              ELSE IF size=12 then
                 LET size=  8
              ELSE
                 LET size= round(72/96 * size * .8)
              END IF
           ELSE
              IF size<12 then
                 LET size=  7
              ELSE IF size=14 then
                 LET size= 12
              ELSE IF size=12 then
                 LET size=  9
              ELSE IF size=18 then
                 LET size= 14
              ELSE IF size=24 then
                 LET size= 18
              ELSE
                 LET size= round(72/96 * size)
              END IF
           END IF
           SELECT CASE font
           CASE 4
                LET font$= "Courier New"
           CASE 16
                LET font$= "Times New Roman"
           CASE else
                LET font$= "Verdana"
           END SELECT
        END IF
        IF style$= "normal" then LET style$= "plain"
        CALL TC_Win_SetFont(WinID,font$,size,style$)
    END SUB

    SUB BoxDisk(Lft,Rgt,Bas,Top)
        BOX DISK Lft,Rgt,Bas,Top
    END SUB
END MODULE

!  --- End TB5 Cross-platform header and subs ---
!! ---------------------------------------------------------

!! --- Start Unix Header and Subs ---

!LET UnixFlag= 1
!ASK PIXELS winWid,winHgt
!LET winLft= 0
!LET winTop= 0
!LET winRgt= winWid-1
!LET winBas= winHgt-1
!SET WINDOW 0,winRgt,winBas,0
!CALL Palette
!
!CALL ToolPanel
!CALL ThisProgram
!
!END
!EXTERNAL
!
!MODULE UnixParts
!    SHARE CharWidth
!
!    SUB SetTextFont(font,size,style$)
!        LET font$= "-adobe-courier-"
!        IF style$= "normal" then
!           LET style$= "medium-r-normal--"
!        ELSE
!           LET style$= "bold-r-normal--"
!        END IF
!        IF size=9 then
!           LET size$= str$(10)
!        ELSE
!           LET size$= str$(size)
!        END IF
!        LET test= SetFont(font$&style$&size$&"*")
!
!        IF size=9 then
!           LET CharWidth=  6
!        ELSE IF size=12 then  ! numeric output - axis labels
!           LET CharWidth=  7
!        ELSE IF size=14 then  ! rare
!           LET CharWidth=  8
!        ELSE IF size=18 then  ! rare
!           LET CharWidth= 10
!        END IF
!    END SUB
!
!    SUB StringWidth(sw$,sl)                      ! string width in pixels
!        ! LET sl= StrWidth(sw$)
!        LET chars= len(sw$)
!        LET sl   = chars*CharWidth
!    END SUB
!
!    SUB SetLineWeight(wgt)
!        ! CALL PenSize(wgt,wgt)
!    END SUB
!
!    SUB BoxDisk(Lft,Rgt,Bas,Top)
!        CALL Fill_Circle(Lft,Rgt,Bas,Top)
!    END SUB
!END MODULE

!! ------ End of TB Unix Header and Subs ------
! -----------------------------------------------------------


! ***
SUB ComplexRoots
    DECLARE PUBLIC worklft,workrgt,workbas,worktop,workmid      ! work area
    DECLARE PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white
    DECLARE PUBLIC red,yellow,green,cyan,blue,magenta,colorscheme
    DECLARE PUBLIC slideclr,axislabelclr,true,false

    DECLARE DEF InfoWithin, QuitWithin

    ! --- help screen ---

    DIM Info$(1:13)
    MAT READ Info$
    DATA "Complex Roots"
    DATA ""
    DATA "This tool displays the derivation of nth roots on the complex plane."
    DATA "Given the modulus and argument for a complex point, the roots lie on the circle of radius modulus^(1/n), and the principle root is found at angle argument/n. The remaining roots lie on the circle at angular intervals of 2*pi/n from the first."
    DATA "The method derives from Abraham de Moivre's formula for powers of a complex number."
    DATA "Click one of the number buttons or press a number key to reset n."
    DATA "Click the [zoom] button to explore modulus lengths less than one."
    DATA ""
    DATA "Click or press and drag the mouse in the plane to change both the real value, Re, and the imaginary value, Im."
    DATA "Drag the Re slider handle to change the real value. Click among the Re slider tick marks to jump to the nearest whole value for Re."
    DATA "Drag the Im slider handle to change the imaginary value. Click among the Im slider tick marks to jump to the nearest whole value for Im."
    DATA "Drag the argument slider handle to change the angle. Click among the argument slider tick marks to jump to the nearest multiple of pi/4 for the angle."
    DATA "Drag the modulus slider handle to change the length. Click among the modulus slider tick marks to jump to the nearest whole value for the length."

    ! ---- Utility Functions ----

    DECLARE DEF badarg,roundn,clamp,modulus,rotation
    DEF twoPi= 2*pi

    ! --- functions ---

    DEF rootMod(m,n)= m^(1/n)                    ! root modulus
    DEF rootAng(c,n)= c/n                        ! root angle
    DEF rootStp(n)  = twoPi/n                    ! root angle interval

    SUB GetRootN(m,c,r,theta0,arc)
        ! find primary root and angle step
        IF n>0 then
           LET rm    = round(abs(m),8)
           LET r     = rootMod(rm,n)             ! get root modulus
           LET theta0= rootAng(c,n)              ! find first angle
           LET arc   = rootStp(n)                ! find arc step size
        END IF
    END SUB

    ! --- plane 1 data ---

    DECLARE PUBLIC w1Lft,w1Rgt,w1Bas,w1Top,w1Midx,w1Midy
    DECLARE PUBLIC w1fLft,w1fRgt,w1fBas,w1fTop,w1x0,w1y0
    DECLARE PUBLIC w1xFirst, w1xSTik, w1xLTik, w1xLabel, w1xGridstep
    DECLARE PUBLIC w1yFirst, w1ySTik, w1yLTik, w1yLabel, w1yGridstep
    DECLARE PUBLIC w1wWid,w1wHgt,w1fWid,w1fHgt
    DECLARE PUBLIC w1fxRatio,w1fyRatio,w1wxRatio,w1wyRatio,w1Aspect
    DECLARE PUBLIC w1xPiFlag, w1xMult, w1yPiFlag, w1yMult

    LET w1Flag   = 1

    LET w1xPiFlag= 0
    LET w1xMult  = 1

    LET w1yPiFlag= 0
    LET w1yMult  = 1

    LET wsize = 300                              ! Pixel bounds
    LET w1Top = worktop + 40
    LET w1Lft = worklft + 70
    LET w1Bas = w1Top + wsize
    LET w1Rgt = w1Lft + wsize
    LET vrule1= w1Rgt + 150

    LET w1xAx$= "Re"                             ! axis labels
    LET w1yAx$= "Im"

    LET w1xGridstep= 1                           ! horizontal grid intervals
    LET w1yGridstep= 1                           ! vertical grid intervals

    CALL w1Bounds(0)

    SUB w1Bounds(zoom)
        SELECT CASE zoom
        CASE 0
             LET fsize   = 10                    ! Function bounds
             LET w1xSTik =  0                    ! horizontal axis Tik marks
             LET w1xLTik =  1
             LET w1xLabel=  2
             LET w1ySTik =  0                    ! horizontal axis Tik marks
             LET w1yLTik =  1
             LET w1yLabel=  2
        CASE 1
             LET fsize   =  2                    ! Function bounds
             LET w1xSTik = .1                    ! horizontal axis Tik marks
             LET w1xLTik = .5
             LET w1xLabel= .5
             LET w1ySTik = .1                    ! horizontal axis Tik marks
             LET w1yLTik = .5
             LET w1yLabel= .5
        END SELECT
        LET w1fTop  =  fsize
        LET w1fBas  = -fsize
        LET w1fLft  = -fsize
        LET w1fRgt  =  fsize

        LET w1xFirst= w1fLft
        LET w1yFirst= w1fBas
        CALL w1Variables
        LET aspect  = w1Aspect                   ! (w1wwid/w1fwid)/(w1whgt/w1fhgt)
    END SUB

    ! --- Plane 1 methods ---

    DECLARE DEF w1fncx,w1fncy,w1wndx,w1wndy      ! window/function transforms
    DECLARE DEF w1Within,w1wWithin,w1fWithin

    SUB w1Init
        CALL w1DrawPlane(1,1,1)                  ! x axis, y axis, zeroaxes
        CALL BoxCircle(w1Wndx(-1),w1Wndx(1),w1Wndy(-1),w1Wndy(1),drkmid)
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextLJ(w1Rgt+8,w1y0+3,w1xAx$,axislabelclr)     ! axis labels
        CALL PlotTextCJ(w1x0,w1Top-10,w1yAx$,axislabelclr)
        CALL w1KeepGridLayer
    END SUB

    ! -------------- Sliders -------------

    ! --- slider 1 - angle ---

    DECLARE PUBLIC h1axis,h1wLft,h1wRgt,h1wBas,h1wTop,h1fLft,h1fRgt
    DECLARE PUBLIC h1name$,h1form$,h1clr,h1First,h1STik,h1LTik,h1Label
    DECLARE PUBLIC h1PiAxis,h1Mult,h1fMin,h1fMax

    LET h1PiAxis= 1
    LET h1Mult  = pi

    LET h1clr   = slideclr
    LET h1name$ = "argument"
    LET h1form$ = "-%.###"
    LET h1Places= 3

    LET h1axis  = w1Bas  + 100
    LET h1wLft  = w1Midx -  90
    LET h1wRgt  = h1wLft + 180

    LET h1fLft  = 0
    LET h1fRgt  = 2

    LET h1STik  = 0
    LET h1LTik  = 1/2
    LET h1Label = 1
    LET h1First = h1fLft
    LET h1Click = pi/4

    CALL h1SliderVariables

    ! --- h1 slider methods ---

    DECLARE DEF h1Within

    SUB h1Init
        CALL h1DrawSlider(h1name$,c)
    END SUB


    ! --- slider 2 - modulus ---

    DECLARE PUBLIC h2axis,h2wLft,h2wRgt,h2wBas,h2wTop,h2fLft,h2fRgt
    DECLARE PUBLIC h2name$,h2form$,h2clr,h2First,h2STik,h2LTik,h2Label
    DECLARE PUBLIC h2PiAxis,h2Mult,h2fMin,h2fMax

    LET h2PiAxis= 0
    LET h2Mult  = 1

    LET h2clr   = slideclr
    LET h2name$ = "modulus"
    LET h2form$ = "--%.##"
    LET h2Places= 2

    LET h2axis  = h1axis +  45
    LET h2wLft  = h1wLft
    LET h2wRgt  = h2wLft + 180

    LET h2fLft  =  0
    LET h2fRgt  = 15

    CALL h2Params(zoom)

    ! --- h2 slider methods ---

    DECLARE DEF h2Within                         ! window/function transforms

    SUB h2Init
        CALL h2Params(zoom)
        CALL h2DrawSlider(h2name$,m)
    END SUB

    SUB h2Params(zoom)
        LET h2fLft= 0
        LET h2fRgt= fsize
        SELECT CASE zoom
        CASE 0
             LET h2STik =  1
             LET h2LTik =  5
             LET h2Label=  5
             LET h2fRgt = 15
        CASE 1
             LET h2STik = 0.5
             LET h2LTik = 1
             LET h2Label= 1
             LET h2fRgt = 3
        END SELECT
        LET h2First= h2fLft
        LET h2Click= h2STik
        LET oldm   = -999
        CALL h2SliderVariables
    END SUB

    ! ------------ Text Output ----------

    ! ---- t1 - complex root name ----

    LET t1BasLn= w1Top - 7
    LET t1Bas  = t1BasLn +  5                    ! root name text
    LET t1Top  = t1BasLn - 12
    LET t1Lft  = vrule1 + 15
    LET t1Rgt  = t1Lft + 120

    DIM RootNames$(2:9)
    DATA "square","cube","fourth","fifth","sixth","seventh","eighth","ninth"
    MAT READ RootNames$

    SUB t1Clear
        BOX CLEAR t1Lft,t1Rgt,t1Bas,t1Top
    END SUB

    SUB t1SetName(n)
        LOCAL txt$
        CALL SetTextFont(1,12,"bold")
        LET  txt$= RootNames$(n) & " roots of"
        CALL t1Clear
        CALL PlotTextLJ(t1Lft,t1BasLn,txt$,white)
    END SUB


    ! ---- t2 - complex input value ----

    LET t2Eqx  = t1Lft + 27
    LET t2BasLn= t1BasLn + 20
    LET t2Lft  = t2Eqx - 50
    LET t2Rgt  = t2Lft + 160
    LET t2Top  = t2BasLn - 12
    LET t2Bas  = t2BasLn +  5

    SUB t2Init(rl,im)
        CALL t2Label
        CALL t2Value(rl,im)
    END SUB

    SUB t2Label
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextRJ(t2Eqx,t2BasLn,"z = ",modclr)
    END SUB

    SUB t2Value(rl,im)
        CALL SetTextFont(1,12,"bold")
        CALL t2ValueClear
        CALL ComplexTextN(t2Eqx,t2BasLn,rl,im,modclr)
    END SUB

    SUB t2ValueClear
        BOX CLEAR t2Eqx,t2Rgt,t2Bas,t2Top
    END SUB


    ! --- roots list ---

    LET RootsBasLn= w1Top + 88                   ! roots symbol list
    LET RootsLnSpc= 16
    LET RootsTop  = RootsBasLn - 12
    LET RootsBas  = RootsBasLn +  9*RootsLnSpc
    LET RootsLft  = t2Lft
    LET RootsRgt  = RootsLft + 180
    LET RootsEqx  = t2Eqx
    LET lnspc     = 16


    ! ---- Complex Values List (unused in MIT version) ----

    LET txLnSpc= 16
    LET txbas1 = w1Top+3*txLnSpc                 ! parameter values
    LET txbas2 = txbas1+txLnSpc
    LET txbas3 = txbas2+txLnSpc
    LET txbas4 = txbas3+txLnSpc
    LET txbas5 = txbas4+txLnSpc
    LET txbas6 = txbas5+txLnSpc
    LET txbas7 = txbas6+txLnSpc

    LET tform$ = "--%.###"
    LET txteq  = t2Eqx
    LET txtdot = txteq + 30

    SUB UpdateTextInit
        LOCAL txt$

        LET txt$  = "real = "
        CALL PlotTextRJ(txteq,txbas1,txt$,modclr)
        LET txt$  = "imaginary = "
        CALL PlotTextRJ(txteq,txbas2,txt$,modclr)
        LET txt$ = "modulus = "
        CALL PlotTextRJ(txteq,txbas3,txt$,modclr)
        LET txt$ = "argument = "
        CALL PlotTextRJ(txteq,txbas4,txt$,modclr)
        LET txt$ = "radius = "
        CALL PlotTextRJ(txteq,txbas6,txt$,radclr)
        LET txt$ = "theta = "
        CALL PlotTextRJ(txteq,txbas7,txt$,radclr)
    END SUB

    SUB UpdateTextValues(rl,im)
        LOCAL txtrl$,txtim$

        BOX CLEAR txteq,txteq+100,txbas7+5,txbas1-15
        LET txtrl$= trim$(using$(tform$,rl))
        CALL AlignDot(txtdot,txbas1,txtrl$,modclr)
        LET txtim$= trim$(using$(tform$,im))
        CALL AlignDot(txtdot,txbas2,txtim$,modclr)
        LET txt$ = trim$(using$(tform$,m))
        CALL AlignDot(txtdot,txbas3,txt$,modclr)
        LET txt$ = trim$(using$(tform$,c))
        CALL AlignDot(txtdot,txbas4,txt$,modclr)
        LET txt$ = trim$(using$(tform$,r))
        CALL AlignDot(txtdot,txbas6,txt$,radclr)
        LET txt$ = trim$(using$(tform$,theta0))
        CALL AlignDot(txtdot,txbas7,txt$,radclr)
    END SUB


    ! ----------- Buttons -----------
    ! ---- Root selector buttons ----

    LET bwid= 20
    LET bhgt= 18
    LET bcnt=  8
    LET rlft= w1Midx - bcnt*bwid/2 + 1
    LET rtop= w1Bas + 35
    LET rrgt= rlft + bcnt*bwid
    LET rbas= rtop + bhgt

    SUB DrawRootButtons                          ! 2 through 9
        LOCAL btn,lft,rgt,n$
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextRJ(rlft-5,rbas-5,"root",white)
        CALL SetTextFont(1,12,"bold")
        FOR btn= 0 to bcnt-1
            LET lft= rlft + btn*bwid
            LET rgt= lft + bwid - 2
            LET n$ = str$(btn+2)
            CALL DrawButton(lft,rgt,rbas,rtop,5,n$)
        NEXT btn
    END SUB

    SUB ReadRootButtons(mx,n)
        LOCAL btn,lft,rgt
        LET btn= int((mx-rlft)/bwid)
        LET lft= rlft + btn*bwid
        LET rgt= lft + bwid - 2
        CALL MouseButtonUp(lft,rgt,rbas,rtop,ms)
        LET n  = btn+2
        CALL t1SetName(n)
        IF mode=2 then CALL RootInit
        CALL ShowVector(a,b,mode)
        CALL t2Value(a,b)
        CALL DisplayMode(a,b,mode)
    END SUB

    ! --- Display selection buttons ---

    LET dwid= 58
    LET dcnt=  4
    LET dlft= vrule1
    LET dtop= rtop
    LET drgt= dlft + bcnt*dwid
    LET dbas= dtop + bhgt

    SUB DisplayDrawButtons                       ! show operations or values
        LOCAL lft,rgt,label$
        CALL SetTextFont(1,12,"bold")
        FOR btn= 0 to dcnt-1
            LET lft= dlft + btn*dwid
            LET rgt= lft + dwid - 2
            SELECT CASE btn
            CASE 0
                 LET label$= "radius"
            CASE 1
                 LET label$= "angle"
            CASE 2
                 LET label$= "values"
            CASE 3
                 LET label$= "none"
            END SELECT
            CALL DrawButton(lft,rgt,dbas,dtop,5,label$)
        NEXT btn
    END SUB

    SUB DisplaySelect(mx,mode)
        LOCAL btn,lft,rgt
        LET btn = int((mx-dlft)/dwid)
        LET lft = dlft + btn*dwid
        LET rgt = lft + dwid - 2
        CALL MouseButtonUp(lft,rgt,dbas,dtop,ms)
        LET mode= btn
        CALL DisplayInit
        CALL DisplayMode(a,b,mode)
    END SUB

    SUB DisplayMode(rl,im,mode)
        SELECT CASE mode
        CASE 0
             BOX SHOW ClearDisp$ at dispLft,dispBas
             CALL CompareLengths
        CASE 1
             BOX SHOW ClearDisp$ at dispLft,dispBas
             CALL CompareAngles
        CASE 2
             CALL RootValues
             IF TextSwitch=1 then CALL UpdateTextValues(rl,im)
        CASE 3
        END SELECT
    END SUB

    SUB DisplayInit
        LET dispLft= w1Rgt+50
        LET dispRgt= workrgt
        LET dispBas= w1Bas+20
        LET dispTop= w1Top+20
        BOX CLEAR displft,dispRgt,dispBas,dispTop
        SELECT CASE mode
        CASE 0
             CALL InitLengths
        CASE 1
             CALL InitAngles
        CASE 2
             CALL InitRoots
             IF TextSwitch=1 then CALL UpdateTextInit
        CASE 3
        END SELECT
        BOX KEEP dispLft,dispRgt,dispBas,dispTop in ClearDisp$
    END SUB

    ! --- Zoom Button ---

    LET zlft= w1Rgt - 48
    LET zrgt= zlft + 48
    LET ztop= rtop
    LET zbas= ztop + bhgt

    SUB ZoomSwitchDraw
        CALL SetTextFont(1,12,"bold")
        CALL DrawButton(zlft,zrgt,zbas,ztop,5,"Zoom")
    END SUB


    ! ---- colors ----

    LET modclr = cyan
    LET radclr = green
    LET rootclr= yellow


    ! --- set default parameters ---

    LET zoom  = 0
    LET n     = 3                                ! root
    LET mode  = 2                                ! display values
    LET a,olda= 4                                ! cartesian x
    LET b,oldb= 4                                ! cartesian y
    LET c,oldc= rotation(a,b)                    ! polar angle
    LET m,oldm= modulus(a,b)                     ! polar radius
    LET textSwitch= 0

    ! ---- Draw the Screen ----

    CALL InitScreen

    SUB InitScreen
        BOX CLEAR worklft,workrgt,workbas,worktop

        CALL w1Bounds(zoom)
        CALL w1Variables
        CALL w1Init

        CALL CartesianToPolarPi(a,b,m,c)

        CALL h1Init
        CALL h2Init

        CALL ShowVector(a,b,mode)

        CALL ZoomSwitchDraw
        CALL DrawRootButtons
        CALL DisplayDrawButtons

        CALL t1SetName(n)
        CALL t2Init(a,b)

        CALL DisplayInit
        CALL DisplayMode(a,b,mode)
    END SUB

    ! ----- main event loop -----

    DO
       DO
          IF UnixFlag=0 then
             IF key input then
                CALL ReadKey(n)
                IF mode=2 then CALL RootValues
             END IF
          END IF
          GET MOUSE: mx,my,ms
       LOOP until ms=2

       IF w1Within(mx,my)=true then
          CALL w1PlaneEvent(mx,my,a,b)

       ELSE IF h1Within(mx,my)=true then
          CALL h1SliderEvent(mx,my,c)
       ELSE IF h2Within(mx,my)=true then
          CALL h2SliderEvent(mx,my,m)

       ELSE IF mx>rlft and mx<rrgt and my>rtop and my<rbas then      ! set root
          CALL ReadRootButtons(mx,n)
       ELSE IF mx>dlft and mx<drgt and my>dtop and my<dbas then      ! set display
          CALL DisplaySelect(mx,mode)
       ELSE IF mx>zlft and mx<zrgt and my>ztop and my<zbas then      ! set zoom
          CALL MouseButtonUp(zlft,zrgt,zbas,ztop,ms)
          LET zoom= 1-zoom
          IF zoom=1 and m>2 then
             LET m= 2
             CALL PolarToCartesian(m,c,a,b)
          END IF
          CALL InitScreen

       ELSE IF infoWithin(mx,my,ms)=true then
          CALL infoButtonUp(ms)
          CALL InfoPage(Info$)
          CALL InitScreen
       ELSE IF quitWithin(mx,my,ms)=true then
          CALL quitButtonUp(ms)
          EXIT SUB
       ELSE
          CALL MouseUp(mx,my,ms)
       END IF
    LOOP

    ! --- Plane events ---

    SUB w1PlaneEvent(mx,my,a,b)
        ! drag input point
        DO
           CALL w1GetDragValues(mx,my,ms,2,2,a,b)
           IF (a<>olda or b<>oldb) then          ! redraw
              CALL ShowVector(a,b,mode)
              CALL t2Value(a,b)
              CALL DisplayMode(a,b,mode)

              IF a<>0 or b<>0 then               ! reset polar sliders
                 CALL CartesianToPolarPi(a,b,m,c)
                 IF c<0 then LET c= c + 2*pi
              ELSE
                 LET m= modulus(a,b)
                 LET c= 0
              END IF
              CALL h1Mark(c)
              CALL h2Mark(m)

              LET olda= a
              LET oldb= b
           END IF
        LOOP until ms=3
    END SUB

    ! --- Keyboard Events ---

    SUB ReadKey(n)
        LOCAL k
        GET KEY: k
        IF k>49 and k<58 then
           LET  n= k-48
           CALL t1SetName(n)
           CALL ShowVector(a,b,mode)
        END IF
    END SUB


    ! ---- Slider events ----
    ! --- slider 1 - angle ---

    SUB h1SliderEvent(mx,my,c)                   ! angle
        IF my<h1axis then
           CALL h1GetClickVal(ms,h1Click,c)
           CALL h1Action
        ELSE
           DO
              CALL h1GetDragVal(ms,h1Places,c)
              CALL h1Action
           LOOP until ms=3
        END IF
    END SUB

    SUB h1Action                                 ! angle
        LOCAL slope
        IF c<>oldc then
           ! reset modulus to stay on screen
           CALL PolarToCartesian(m,c,a,b)
           IF abs(a)>fsize then                  ! clip vertical
              LET slope= b/a
              LET a    = fsize
              LET b    = slope*a
           ELSE IF abs(b)>fsize then             ! clip horizontal
              LET slope= b/a
              LET b    = fsize
              LET a    = b/slope
           END IF
           LET m= modulus(a,b)                   ! adjust m
           IF m<>oldm then
              CALL h2Mark(m)
              LET oldm= m
           END IF
           CALL PolarToCartesian(m,c,a,b)

           ! redraw
           CALL ShowVector(a,b,mode)
           CALL t2Value(a,b)
           CALL DisplayMode(a,b,mode)

           LET oldc= c
        END IF
    END SUB

    ! --- slider 2 - modulus ---

    SUB h2SliderEvent(mx,my,m)                   ! modulus
        ! the value of m is tested and constrained in h2action
        IF my<h2axis then
           CALL MouseUp(mx,my,ms)
           CALL h2wClampfVal(mx,m)
           LET m= roundn(m,h2Click)
           CALL h2Action
        ELSE
           DO
              GET MOUSE: mx,my,s
              IF mx<>oldmx then
                 CALL h2wClampfVal(mx,m)
                 CALL h2Action
                 LET oldmx= mx
              END IF
           LOOP until s=3
        END IF
    END SUB

    SUB h2Action
        LOCAL slope,x,y

        ! test for boundaries and adjust
        CALL PolarToCartesian(m,c,x,y)
        IF x<>0 then                             ! off the vertical
           LET slope= y/x
           IF abs(x)>fsize then                  ! x off plane
              LET x    = fsize
              LET y    = slope*x
           END IF

           IF abs(y)>fsize then                  ! y off plane
              LET y    = fsize
              LET x    = y/slope
           END IF
        ELSE                                     ! vertical modulus
           IF abs(y)>fsize then LET y= fsize
        END IF

        LET m= round(modulus(x,y),4)             ! adjust m

        IF oldm<>m then
           CALL h2Mark(m)
           CALL PolarToCartesian(m,c,a,b)

           ! redraw
           CALL ShowVector(a,b,mode)
           CALL t2Value(a,b)
           IF mode<>1 then
              CALL DisplayMode(a,b,mode)
           END IF

           LET oldm= m
        END IF
    END SUB

    ! ---- real time drawing and typesetting ----

    ! --- graphic vector display ---

    SUB ShowVector(rl,im,mode)
        LOCAL i,ang,wx,wy
        CALL GetRootN(m,c,r,theta0,arc)
        CALL w1MathToPixels(rl,im,wrl,wim)
        LET wr= r * w1wxRatio

        ! update the graphics plane
        CALL w1ShowGridLayer
        CALL PlotLine(w1x0,w1y0, wrl,wim, modClr)
        CALL PlotDiamond(wrl,wim)

        IF r<>0 then                             ! plot roots
           CALL BoxCircle(w1x0-wr,w1x0+wr,w1y0+wr,w1y0-wr,blue)
           ! plot the set of complex roots
           FOR i= 0 to n-1
               LET ang= theta0 + i*arc
               CALL PolarToCartesian(r,ang,x,y)
               CALL w1MathToPixels(x,y,wx,wy)
               CALL PlotLine(w1x0,w1y0, wx,wy, radclr)
               SET COLOR rootclr
               CALL PlotDiamond(wx,wy)
           NEXT i
        ELSE
           SET COLOR blue
           PLOT w1x0,w1y0
        END IF
    END SUB

    ! ---- display mode routines ----
    ! ---- display roots list ---

    SUB RootValues                               ! no labels - just values
        LOCAL i,ang,bas
        CALL RootValuesClear
        FOR i= 0 to n-1
            LET bas = RootsBasln + i*lnspc
            LET ang = theta0 + i*arc
            CALL PolarToCartesian(r,ang,x,y)
            CALL ComplexTextN(RootsEqx,bas,x,y,rootclr)
        NEXT i
    END SUB

    SUB RootValuesClear
        BOX CLEAR RootsEqx,RootsRgt,RootsBas,RootsTop
    END SUB

    SUB RootLabels
        LOCAL i,bas,txt$
        CALL RootLabelsClear
        FOR i= 0 to n-1
            LET bas = rootsbasln + i*lnspc
            LET txt$= "w_[" & str$(i+1) & "] = "
            CALL SuperSubScriptRJ(RootsEqx,bas,txt$,rootclr)
        NEXT i
    END SUB

    SUB RootLabelsClear
        BOX CLEAR rootsLft,rootsRgt,rootsBas,rootsTop
    END SUB

    SUB InitRoots
        CALL RootLabels
    END SUB

    SUB RootInit
        CALL RootLabels
        CALL RootValues
    END SUB

    ! --- display modulus to radius ---

    SUB InitLengths
        LET modwx = dlft+10
        LET radwx = modwx+80
        LET lenbas= w1Bas - 30

        LET modratio= 150/fsize
        LET radratio= 150/fsize

        CALL PlotLine(modwx-10,lenbas,radwx+10,lenbas,white)
    END SUB

    SUB CompareLengths
        LET modpix= modratio * m
        LET radpix= radratio * r

        CALL PlotLine(modwx,lenbas,modwx,lenbas-modpix,modclr)
        CALL PlotLine(radwx,lenbas,radwx,lenbas-radpix,radclr)
        CALL PlotTextLJ(modwx+5,lenbas-modpix+15,"modulus",modclr)

        SET COLOR radclr
        DRAW Root(60) with shift(radwx+76,lenbas-radpix+15)
        CALL SetTextFont(1, 9,"bold")
        CALL PlotTextLJ(radwx+6,lenbas-radpix+8,str$(n),radclr)
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextLJ(radwx+18,lenbas-radpix+15,"modulus",modclr)
    END SUB

    ! --- display modulus angle to primary angle ---

    SUB InitAngles
        LET scale = 30
        LET wxor1 = dlft+scale
        LET wxor2 = wxor1+100
        LET wyor  = w1y0

        CALL PlotLine(wxor1-scale, wyor, wxor1+scale, wyor, white)
        CALL PlotLine(wxor2-scale, wyor, wxor2+scale, wyor, white)

        CALL PlotTextLJ(wxor1-scale,wyor+scale+20,"argument",white)
        CALL PlotTextLJ(wxor2-scale,wyor+scale+20,"argument/root",white)
    END SUB

    SUB CompareAngles
        ! --- root angle
        CALL DrawArc(wxor1,wyor,c,cyan)
        CALL DrawArc(wxor2,wyor,theta0,green)
    END SUB

    SUB DrawArc(wxor,wyor,radians,clr)
        LOCAL dtheta,a1,a2,ang,x,y
        OPTION ANGLE degrees

        LET a2= deg(radians)                     ! arc to input vector
        LET a1= 0
        IF a2>=0 then
           LET stp=  3
        ELSE
           LET stp= -3
        END IF

        SET COLOR clr
        FOR ang= a1 to a2 step stp
            LET x= wxor + scale*cos(ang)
            LET y= wyor - scale*sin(ang)
            PLOT x,y;
        NEXT ang
        PLOT wxor,wyor

        IF stp=3 then
           LET ang= a2-10
           LET x  = wxor + scale*cos(ang)
           LET y  = wyor - scale*sin(ang)
           DRAW arrow3 with rotate(-(a2+90)) * shift(x,y)
        ELSE
           LET ang= a2+10
           LET x  = wxor + scale*cos(ang)
           LET y  = wyor - scale*sin(ang)
           DRAW arrow3 with rotate(-(a2-90)) * shift(x,y)
        END IF

        OPTION ANGLE radians
    END SUB
END SUB

! --- end of complex roots ---