!! File: VibeAmpPhase
!! January 7, 2003 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

DECLARE DEF QuitWithin, InfoWithin

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

LET title$ = "Vibration: Amplitude and Phase"

SUB ThisProgram
    CALL VibrationAmplitude
    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 VibrationAmplitude
    DECLARE PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white
    DECLARE PUBLIC red,yellow,green,cyan,blue,magenta,colorscheme
    DECLARE PUBLIC axislabelclr,slideclr,true,false
    DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx

    DECLARE DEF quitWithin, infoWithin

    ! --- help screen array ---

    DIM  info$(1:1)
    MAT READ info$
    DATA "Information on vibration amplitude and phase responses"


    ! --- define colors ---

    LET ampClr= yellow                           ! amplitude and mass
    LET posClr= ampClr
    LET phiClr= green
    LET frcClr= cyan
    LET sprClr= 4
    LET lagClr= red


    ! ---------- Utility functions ---

    DECLARE DEF clamp,roundn,e
    LET bignum= 10^10
    LET twoPi = 2*Pi
    DEF RadToDeg(rad)= rad*180/pi


    ! ---- Functions ----

    DEF fA(w,k,b)
        LET d = sqr((k-w*w)^2 + b*b*w*w)
        IF d<>0 and k<>0 then
           LET fa= k/d                           ! Amplitude
        ELSE
           LET fa= 0                             ! bignum
        END IF
    END DEF

    DEF fPhi(w,k,b)
        IF k<>0 or w<>0 then
           LET fPhi= angle(k-w*w,b*w)            ! Phase angle(x,y)
        ELSE
           LET fPhi= 0
        END IF
    END DEF

    DEF force(t)
        LET force= cos(w*t)
    END DEF

    DEF fT0(phi,w) =  phi/w                      ! phase lag
    DEF fP(w)      = twoPi/w

    DEF dxdt(pos,vel)=  vel                      ! position
    DEF dvdt(pos,vel)= -k*pos - b*vel + k*cos(w*t)    ! velocity

    DEF ss(t)
        ! LET phi= fphi(w,k,b)
        LET ss = A*cos(w*t - phi)                ! steady state 
    END DEF

    LET dt= 1/16

    SUB RungeKutta4(x,v)
        LET dx1= dxdt(x,v)
        LET dv1= dvdt(x,v)
        LET x1 = x + .5*dx1*dt
        LET v1 = v + .5*dv1*dt
        LET dx2= dxdt(x1,v1)
        LET dv2= dvdt(x1,v1)
        LET x2 = x + .5*dx2*dt
        LET v2 = v + .5*dv2*dt
        LET dx3= dxdt(x2,v2)
        LET dv3= dvdt(x2,v2)
        LET x3 = x + dx3*dt
        LET v3 = v + dv3*dt
        LET dx4= dxdt(x3,v3)
        LET dv4= dvdt(x3,v3)

        LET dv = (dv1 + 2*dv2 + 2*dv3 + dv4) / 6
        LET dx = (dx1 + 2*dx2 + 2*dx3 + dx4) / 6
        LET v  = v + dt*dv
        LET x  = x + dt*dx
    END SUB

    ! ---------- Graphing plane parameters and methods ----------

    !    LET wsize  = 160
    !    LET fsize  =   4
    !    LET pisize = 176
    !    LET whgt   = 160
    LET axisclr=   4

    ! --- 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= 1
    LET w1yPiFlag= 0
    LET w1xMult  = pi
    LET w1yMult  = 1

    LET w1Lft= workLft + 150                     ! pixel bounds
    LET w1Rgt= w1Lft + 400
    LET w1Top= workTop + 65
    LET w1Bas= w1Top + 160

    LET w1fLft=  0                               ! function bounds * pi
    LET w1fRgt=  8
    LET w1fTop=  4
    LET w1fBas= -4

    LET w1Xax$= "t"                              ! axis labels
    LET w1Yax$= "x"

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

    LET w1xSTik = 0.5                            ! horizontal axis Tik marks
    LET w1xLTik = 1
    LET w1xLabel= 2
    LET w1xFirst= w1fLft

    LET w1ySTik = 0.5                            ! vertical axis Tik marks
    LET w1yLTik = 1
    LET w1yLabel= 1
    LET w1yFirst= w1fBas

    ! --- Plane 1 methods ---

    DECLARE DEF w1Fncx,w1Fncy,w1Wndx,w1Wndy      ! window/function transforms
    DECLARE DEF w1wWithin,w1Within

    CALL w1Variables

    SUB w1Init
        CALL w1DrawPlane(1,1,1)                  ! grid, axes, zeroaxes
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextLJ(w1Rgt+8,w1y0+3,w1Xax$,axislabelclr)     ! axis labels
        CALL PlotTextCJ(w1x0,w1Top-10,w1Yax$,posclr)

        LET txt$= "x'' + bx' + kx = k cos(wt)"
        CALL StringWidth(txt$,sw)
        LET lft = w1Midx-sw/2
        LET txt$= "x'' + bx' + kx = k cos(wt)"
        CALL SwapOmega(lft,w1Top-10,txt$,"w",yellow)
        !        CALL StringWidth(txt$,sw)
        !        LET lft = lft+sw
        !        CALL SwapPhi(lft,w1Top-10,"p)","p",yellow)

        CALL w1KeepGridLayer
    END SUB


    ! ------------------- Plane 2 - mass and spring simulation -----------------------

    ! --- plane 2 data ---

    DECLARE PUBLIC w2Lft,w2Rgt,w2Bas,w2Top,w2Midx,w2Midy
    DECLARE PUBLIC w2fLft,w2fRgt,w2fBas,w2fTop,w2x0,w2y0
    DECLARE PUBLIC w2xFirst, w2xSTik, w2xLTik, w2xLabel, w2xGridstep
    DECLARE PUBLIC w2yFirst, w2ySTik, w2yLTik, w2yLabel, w2yGridstep
    DECLARE PUBLIC w2wWid,w2wHgt,w2fWid,w2fHgt
    DECLARE PUBLIC w2fxRatio,w2fyRatio,w2wxRatio,w2wyRatio,w2Aspect
    DECLARE PUBLIC w2xPiFlag, w2xMult, w2yPiFlag, w2yMult

    LET w2Flag   = 1
    LET w2xPiFlag= 0
    LET w2yPiFlag= 0
    LET w2xMult  = 1
    LET w2yMult  = 1

    LET w2Lft = worklft + 25                     ! pixel bounds
    LET w2Rgt = w2Lft + 50
    LET w2Top = w1Top - w1wHgt/4                 !- 15
    LET w2Bas = w1Bas + w1whgt + 35

    LET w2fLft=  0                               ! function bounds * pi
    LET w2fRgt= 40
    LET w2fTop=  9
    LET w2fBas= -4

    LET w2xGridstep= 0                           ! horizontal grid intervals
    LET w2yGridstep= 0                           ! vertical grid intervals

    LET w2xAx$= "t"                              ! axis labels
    LET w2yAx$= "I"

    LET w2xSTik = 0                              ! horizontal axis Tik marks
    LET w2xLTik = 0
    LET w2xLabel= 0
    LET w2xFirst= w2fLft

    LET w2ySTik = 0                              ! vertical axis Tik marks
    LET w2yLTik = 0
    LET w2yLabel= 0
    LET w2yFirst= w2fBas

    ! --- plane 2 methods ---

    DECLARE DEF w2Fncx, w2Fncy, w2Wndx, w2Wndy   ! window/function transforms
    DECLARE DEF w2wWithin,w2Within

    CALL w2Variables

    SUB w2Init
        CALL BoxArea(w2Lft,w2Rgt,w2Bas,w2Top,black)
        CALL SetTextFont(1,12,"bold")
        CALL w2KeepGridLayer
    END SUB


    ! --------------------------------------------------
    ! --- plane 3 data - upper right amplitude plane ---

    DECLARE PUBLIC w3Lft,w3Rgt,w3Bas,w3Top,w3Midx,w3Midy
    DECLARE PUBLIC w3fLft,w3fRgt,w3fBas,w3fTop,w3x0,w3y0
    DECLARE PUBLIC w3xFirst, w3xSTik, w3xLTik, w3xLabel, w3xGridstep
    DECLARE PUBLIC w3yFirst, w3ySTik, w3yLTik, w3yLabel, w3yGridstep
    DECLARE PUBLIC w3wWid,w3wHgt,w3fWid,w3fHgt
    DECLARE PUBLIC w3fxRatio,w3fyRatio,w3wxRatio,w3wyRatio,w3Aspect
    DECLARE PUBLIC w3xPiFlag, w3xMult, w3yPiFlag, w3yMult

    LET w3Flag   = 1                             ! plane is turned on or off
    LET w3xPiFlag= 0
    LET w3yPiFlag= 0
    LET w3xMult  = 1
    LET w3yMult  = 1

    LET w3Lft = w1Rgt + 80                       ! pixel bounds
    LET w3Rgt = w3Lft + w1wHgt/2
    LET w3Top = w1Top
    LET w3Bas = w1Top + w1wHgt/2

    LET w3fLft= 0                                ! function bounds
    LET w3fRgt= 4
    LET w3fTop= 4
    LET w3fBas= 0

    LET w3xAx$= "w"                              ! axis labels
    LET w3yAx$= "A"

    LET w3xGridstep= 0                           ! grid line intervals
    LET w3yGridstep= 0

    LET w3xSTik = 0.5                            ! axis Tik marks
    LET w3xLTik = 1
    LET w3xLabel= 1
    LET w3xFirst= w3fLft

    LET w3ySTik = 0.5
    LET w3yLTik = 1
    LET w3yLabel= 1
    LET w3yFirst= w3fBas

    ! --- plane 3 methods ---

    DECLARE DEF w3Fncx,w3Fncy,w3Wndx,w3Wndy      ! window/function transforms
    DECLARE DEF w3wWithin,w3Within

    CALL w3Variables

    SUB w3Init
        CALL w3DrawPlane(1,1,1)                  ! x axis, y axis, zeroaxes
        CALL SetTextFont(1,12,"bold")
        !CALL PlotTextLJ(w3Rgt+8,w3y0+3,w3xAx$,axislabelclr)     ! axis labels
        CALL SwapOmega(w3Rgt+8,w3y0+3,w3xAx$,"w",white)

        CALL PlotTextCJ(w3x0,w3Top-10,w3yAx$,ampclr)
        CALL w3KeepGridLayer
    END SUB


    ! --- plane 4 data ---

    DECLARE PUBLIC w4Lft,w4Rgt,w4Bas,w4Top,w4Midx,w4Midy
    DECLARE PUBLIC w4fLft,w4fRgt,w4fBas,w4fTop,w4x0,w4y0
    DECLARE PUBLIC w4xFirst, w4xSTik, w4xLTik, w4xLabel, w4xGridstep
    DECLARE PUBLIC w4yFirst, w4ySTik, w4yLTik, w4yLabel, w4yGridstep
    DECLARE PUBLIC w4wWid,w4wHgt,w4fWid,w4fHgt
    DECLARE PUBLIC w4fxRatio,w4fyRatio,w4wxRatio,w4wyRatio,w4Aspect
    DECLARE PUBLIC w4xPiFlag, w4xMult, w4yPiFlag, w4yMult

    LET w4Flag   = 0                             ! plane is turned on or off
    LET w4xPiFlag= 0
    LET w4xMult  = 1

    LET w4yPiFlag= 1
    LET w4yMult  = pi

    LET w4Lft = w3Lft                            ! pixel bounds
    LET w4Rgt = w4Lft + w1wHgt/2
    LET w4Top = w3Bas + 22
    LET w4Bas = w4Top + w1wHgt/2

    LET w4fLft=  0                               ! function bounds
    LET w4fRgt=  4
    LET w4fTop=  0
    LET w4fBas= -1

    LET w4xAx$= "w"                              ! axis labels
    LET w4yAx$= "phi"

    LET w4xGridstep= 0                           ! grid line intervals
    LET w4yGridstep= 0

    LET w4xSTik = 0                              ! axis Tik marks
    LET w4xLTik = 1
    LET w4xLabel= 1
    LET w4xFirst= w4fLft

    LET w4ySTik = 0
    LET w4yLTik = 0.25
    LET w4yLabel= 0.5
    LET w4yFirst= w4fBas

    ! --- plane 4 methods ---

    DECLARE DEF w4Fncx,w4Fncy,w4Wndx,w4Wndy      ! window/function transforms
    DECLARE DEF w4Within

    CALL w4Variables

    SUB w4Init
        CALL w4DrawPlane(-1,1,1)                 ! x axis, y axis, zeroaxes
        CALL SetTextFont(1,12,"bold")

        CALL SwapPhi(w4x0-14,w4Bas+15,"-p","p",phiclr)
        CALL SwapOmega(w4Rgt+9,w4y0+3,"w","w",white)
        CALL w4KeepGridLayer
    END SUB


    ! --- plane 5 data ---

    DECLARE PUBLIC w5Lft,w5Rgt,w5Bas,w5Top,w5Midx,w5Midy
    DECLARE PUBLIC w5fLft,w5fRgt,w5fBas,w5fTop,w5x0,w5y0
    DECLARE PUBLIC w5xFirst, w5xSTik, w5xLTik, w5xLabel, w5xGridstep
    DECLARE PUBLIC w5yFirst, w5ySTik, w5yLTik, w5yLabel, w5yGridstep
    DECLARE PUBLIC w5wWid,w5wHgt,w5fWid,w5fHgt
    DECLARE PUBLIC w5fxRatio,w5fyRatio,w5wxRatio,w5wyRatio,w5Aspect
    DECLARE PUBLIC w5xPiFlag, w5xMult, w5yPiFlag, w5yMult

    LET w5Flag   = 0                             ! plane is turned on or off
    LET w5xPiFlag= 0
    LET w5yPiFlag= 0
    LET w5xMult  = 1
    LET w5yMult  = 1

    LET w5Lft = w4Rgt - 120                      ! pixel bounds
    LET w5Rgt = w4Rgt
    LET w5Top = workBas - 175
    LET w5Bas = w5Top + 100

    LET w5fLft= -3                               ! function bounds
    LET w5fRgt=  3
    LET w5fTop=  1
    LET w5fBas= -4

    LET w5xAx$= "Re"                             ! axis labels
    LET w5yAx$= "Im"

    LET w5xGridstep= 0                           ! grid line intervals
    LET w5yGridstep= 0

    LET w5xSTik = 0                              ! axis Tik marks
    LET w5xLTik = 1
    LET w5xLabel= 1
    LET w5xFirst= w5fLft

    LET w5ySTik = 0
    LET w5yLTik = 1
    LET w5yLabel= 1
    LET w5yFirst= w5fBas

    ! --- plane 5 methods ---

    DECLARE DEF w5Fncx,w5Fncy,w5Wndx,w5Wndy      ! window/function transforms
    DECLARE DEF w5wWithin,w5Within

    CALL w5Variables

    SUB w5Init
        CALL w5DrawPlane(-1,1,1)                 ! x axis, y axis, zeroaxes
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextLJ(w5Rgt+8,w5y0+3,w5xAx$,axislabelclr)     ! axis labels
        CALL PlotTextCJ(w5x0,w5Top-17,w5yAx$,axislabelclr)

        LET bas= w5Bas+20
        LET txt$= "k / p(iw)"
        CALL StringWidth(txt$,sw)
        LET lft= w5Midx-sw/2

        CALL PlotTextLJ(lft,bas,"k ",white)
        CALL StringWidth("k ",kw)
        LET lft= lft+kw+4

        CALL DivSign(lft,bas,white)
        LET lft= lft+12

        CALL SwapOmega(lft,bas," p(iw)","w",white)

        LET txt$= "p(s) = s^[2] + bs + k"
        CALL SuperSubScriptCJ(w5Midx,w5Bas+40,txt$,white)

        CALL w5KeepGridLayer
    END SUB


    ! ---------- Slider parameters and methods ----------
    ! ----------- horizontal sliders ------------

    ! --- horizontal slider 1 ---

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

    DECLARE DEF h1Within                         ! window/function transforms

    LET h1PiAxis= 0
    LET h1Mult  = 1

    LET h1clr   = white
    LET h1name$ = "b"
    LET h1form$ = "%.##"
    LET h1Places= 2

    LET h1axis = w1Bas + 110
    LET h1wLft = w1Lft
    LET h1wRgt = h1wlft + 200

    LET h1fLft = 0.5
    LET h1fRgt = 1.5

    LET h1STik = 0.1                             ! short tick marks
    LET h1LTik = 0.50                            ! long tick marks
    LET h1Label= 0.50                            ! labels
    LET h1First= h1fLft                          ! first tick mark
    LET h1Click= 0.1

    CALL h1SliderVariables

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

    ! --- Slider 2 - omega under upper right plane ---

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

    DECLARE DEF h2Within                         ! window/function transforms

    LET h2PiAxis= 0
    LET h2Mult  = 1

    LET h2clr   = white
    LET h2name$ = ""                             ! omega
    LET h2form$ = "%.##"
    LET h2Places= 2

    LET h2axis = w1Bas + 65                      !h1Axis+45
    LET h2wLft = w3Lft
    LET h2wRgt = w3Rgt

    LET h2fLft = 0
    LET h2fRgt = 4

    LET h2STik = 0.5
    LET h2LTik = 1
    LET h2Label= 1
    LET h2First= h2fLft
    LET h2Click= 1

    CALL h2SliderVariables

    SUB h2Init
        CALL h2DrawSlider(h2name$,w)
        CALL SwapOmega(h2wLft-17,h2wBas-4,"w","w",white)
    END SUB

    ! --- horizontal slider 3 - time slider under graph axis ---

    DECLARE PUBLIC h3axis,h3wLft,h3wRgt,h3wBas,h3wTop,h3fLft,h3fRgt
    DECLARE PUBLIC h3name$,h3form$,h3clr,h3First,h3STik,h3LTik,h3Label
    DECLARE PUBLIC h3PiAxis,h3Mult,h3fMin,h3fMax

    DECLARE DEF h3Within                         ! window/function transforms

    LET h3PiAxis= 1
    LET h3Mult  = pi

    LET h3clr   = slideclr
    LET h3name$ = "t"
    LET h3form$ = "--%.#"
    LET h3Places= 1

    LET h3axis = w1Bas + 24
    LET h3wLft = w1Lft
    LET h3wRgt = w1Rgt

    LET h3fLft = 0
    LET h3fRgt = 8

    LET h3STik = 0.5                             ! short tick marks
    LET h3LTik = 1                               ! long tick marks
    LET h3Label= 2                               ! labels
    LET h3First= h3fLft                          ! first tick mark
    LET h3Click= pi/2

    CALL h3SliderVariables

    ! --- animation parts ---

    SUB h3SetZero
        LET t= 0
        CALL h3mark(t)
    END SUB

    DECLARE DEF h3AnimWithin, h3LStpWithin, h3RStpWithin, h3AnimStopWithin

    LET h3AnimStep= 0.2                          ! two pixels

    SUB h3Init
        LET t= 0
        CALL h3DrawSlider(h3name$,t)
        CALL h3AnimButtons
    END SUB


    ! --- slider 4 ---

    DECLARE PUBLIC h4axis,h4wLft,h4wRgt,h4wBas,h4wTop,h4fLft,h4fRgt
    DECLARE PUBLIC h4name$,h4form$,h4clr,h4First,h4STik,h4LTik,h4Label
    DECLARE PUBLIC h4PiAxis,h4Mult,h4fMin,h4fMax

    DECLARE DEF h4Within                         ! window/function transforms

    LET h4PiAxis= 0
    LET h4Mult  = 1

    LET h4clr   = white
    LET h4name$ = "k"
    LET h4form$ = "--%.##"
    LET h4Places= 2

    LET h4axis = h1axis+ 50
    LET h4wLft = h1wLft
    LET h4wRgt = h4wLft+200

    LET h4fLft = 0
    LET h4fRgt = 4

    LET h4STik = 0.5
    LET h4LTik = 1
    LET h4Label= 1
    LET h4First= h4fLft
    LET h4Click= 1

    CALL h4SliderVariables

    SUB h4Init
        CALL h4DrawSlider(h4name$,k)
    END SUB

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

    ! --- text rectangle 2 - t0 phase lag equation and value ---

    ! timelag = period*phi/(twoPi)

    LET t2BasLn = h4Axis + 60 + 24
    LET t2Lft   = w1Lft + 15
    LET t2Rgt   = t2Lft + 170
    LET t2Bas   = t2BasLn +  5
    LET t2Top   = t2BasLn - 15
    LET t2Label$= "t_[0] = "

    SUB t2Label
        CALL SetTextFont(1,12,"bold")
        CALL SuperSubScriptRJ(t2Lft,t2BasLn,t2Label$,red)
    END SUB

    SUB t2Init
        CALL t2Label
        CALL t2Set
        CALL t2Val
    END SUB

    SUB t2Set
        CALL SetTextFont(1,12,"bold")
        ! t_0 = (phi/2 pi)P = phi/omega =

        CALL StringWidth("(0",sw)
        CALL SwapPhi(t2Lft,t2BasLn,"(0","0",red)
        LET lft = t2Lft + sw + 4

        CALL DivSign(lft,t2BasLn,red)
        LET lft = lft + 8

        CALL SwapPi(lft,t2BasLn,"2p)P","p",red)
        CALL StringWidth("2p)P",sw)
        LET lft = lft + sw + 8

        CALL PlotTextLJ(lft,t2BasLn,"=",red)
        LET lft= lft + 12

        CALL SwapPhi(lft,t2BasLn,"0","0",red)
        CALL StringWidth("0",sw)
        LET lft= lft + sw + 4

        CALL DivSign(lft,t2BasLn,red)
        LET lft= lft + 8

        CALL SwapOmega(lft,t2BasLn,"w","w",red)
        LET lft= lft+16

        CALL PlotTextLJ(lft,t2BasLn,"=",red)

        LET t2vLft = lft + 12
        LET t2vRgt = t2vLft + 40
    END SUB


    SUB t2Val
        CALL t2ClearVal
        IF w>0 and k>0 then
           CALL SetTextFont(1,12,"bold")
           LET t$ = trim$(using$("---%.##",fT0(phi,w)))
           CALL PlotTextLJ(t2vLft,t2BasLn,t$,red)
        ELSE
           ! CALL DrawInf12(t2vLft,t2BasLn,red)
        END IF
    END SUB

    SUB t2Clear
        BOX CLEAR t2Lft,t2Rgt,t2Bas,t2Top
    END SUB

    SUB t2ClearVal
        BOX CLEAR t2vLft,t2Rgt,t2Bas,t2Top
    END SUB


    ! --- text rectangle 1 - P period equation and value ---

    LET t1BasLn = h4Axis + 60
    LET t1Lft   = w1Lft+15
    LET t1Rgt   = t1Lft + 150
    LET t1Bas   = t1BasLn +  5
    LET t1Top   = t1BasLn - 15
    LET t1Label$= "P = "
    LET t1Clr   = cyan

    SUB t1Label
        CALL SetTextFont(1,12,"bold")
        CALL SuperSubScriptRJ(t1Lft,t1BasLn,t1Label$,t1Clr)
    END SUB

    SUB t1Set
        CALL SetTextFont(1,12,"bold")
        LET lft= t1Lft

        CALL SwapPi(lft,t1BasLn,"2w","w",t1Clr)
        CALL StringWidth("2w",sw)
        LET lft = t1Lft + sw + 3

        CALL DivSign(lft,t1BasLn,t1Clr)
        LET lft = lft + 8

        CALL SwapOmega(lft,t1BasLn,"w","w",t1Clr)
        CALL StringWidth("w",sw)

        LET lft = lft + sw + 6
        CALL PlotTextLJ(lft,t1BasLn,"=",t1Clr)

        LET t1vLft = lft + 12
        LET t1vRgt = t1vLft + 100
    END SUB

    !                        t0     P          A       phi     H
    !
    !k = 0, omega = 0        u      inf        u       u       u
    !
    !k = 0, omega not 0      u      1/omega    0       u       0
    !
    !k not 0, omega = 0      u      inf        1       0       1

    SUB t1Val
        CALL t1ClearVal
        CALL SetTextFont(1,12,"bold")
        IF w>0 then
           LET t$ = trim$(using$("---%.##",fP(w)))
           CALL PlotTextLJ(t1vLft,t1BasLn,t$,t1Clr)
        ELSE
           CALL DrawInf12(t1vLft,t1BasLn,t1Clr)
        END IF
    END SUB

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

    SUB t1ClearVal
        BOX CLEAR t1vLft,t1vRgt,t1Bas,t1Top
    END SUB

    SUB t1Init
        CALL t1Label
        CALL t1Set
        CALL t1Val
    END SUB


    ! --- checkbox - Bode and Nyquist switch ---

    DECLARE PUBLIC cb1Lft,cb1Rgt,cb1Bas,cb1Top,cb1Txt$,cb1Clr,cb1State
    DECLARE DEF cb1Within

    LET cb1Lft = workRgt - 200
    LET cb1Bas = workBas - 3
    LET cb1Txt$= "Bode and Nyquist Plots"
    LET cb1Clr = litgry

    CALL cb1Variables

    ! --- end of design and layout ---


    ! --- initialize default parameters ---

    LET m,oldm  = 1                              ! mass
    LET k,oldk  = 1                              ! spring constant
    LET b,oldb  = 0.5                            ! damping
    LET w,oldw  = 1
    LET t,oldt  = 0
    LET cb1State= 0
    LET NyState = cb1State

    LET A,oldA    = fA(w,k,b)
    LET phi,oldphi= fphi(w,k,b)

    LET vfieldFlag= 0
    LET sfieldFlag= 0

    ! --- Draw the screen ---

    CALL InitScreen
    CALL SetTimer

    SUB InitScreen
        BOX CLEAR worklft,workrgt,workbas,worktop

        CALL w1Init
        CALL w2Init

        CALL t1Init
        CALL t2Init

        CALL h1Init
        CALL h2Init
        CALL h3Init
        CALL h4Init

        CALL DrawSpringStand
        LET pos,pos0= 0

        CALL ReDrawGraphs
        CALL DrawMass(0,w1y0)
        LET  t= 0
        CALL h3Action
        CALL cb1Init
        CALL InitBodeNyquist(NyState)
    END SUB

    SUB InitBodeNyquist(NyState)
        IF NyState=1 then
           CALL w3Init                           ! Phase
           CALL w4Init                           ! Nyquist
           CALL w5Init                           ! Amplitude
           CALL DrawBodeAndNyquist
        ELSE
           BOX CLEAR w3Lft-30,w3Rgt+24,w3Bas+18,w3Top-18
           BOX CLEAR w4Lft-35,w4Rgt+24,w4Bas+18,w4Top-18
           BOX CLEAR w5Lft-30,w5Rgt+24,w5Bas+45,w5Top-25
        END IF
    END SUB

    ! ----------------- Event manager -----------------

    DO
       LET ClearFlag1,ClearFlag4= 0
       IF ms<>2 then
          CALL StoreGraphsForClear
          DO
             GET MOUSE: mx,my,ms
             IF w1Within(mx,my)=true or w2Within(mx,my)=true or w3Within(mx,my)=true then
                CALL w1AmplitudeRollover
             ELSE IF w4Within(mx,my)=true and NyState=true then
                CALL w1PhiRollover
             ELSE IF ClearFlag1=true then
                CALL ClearAmpRollover
             ELSE IF ClearFlag4=true then
                CALL ClearPhiRollover
             END IF
          LOOP until ms=2
       END IF
       ! clean up as needed
       IF ClearFlag1=true then
          CALL ClearAmpRollover
       END IF
       IF ClearFlag4=true then
          CALL ClearPhiRollover
       END IF

       IF h1Within(mx,my)=true then              ! b slider
          CALL ForcingCurve(1)
          BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in temp$
          IF my<h1axis then
             CALL h1MouseClick
          ELSE
             CALL h1MouseDrag
          END IF
          CALL ReDrawGraphs
          CALL w1KeepGraphLayer

       ELSE IF h2Within(mx,my)=true then         ! w slider (omega)
          IF my<h2axis then
             CALL h2MouseClick
          ELSE
             CALL h2MouseDrag
          END IF
          CALL ForcingCurve(1)
          IF k>0 then CALL PositionCurve(1)
          CALL w1KeepGraphLayer

       ELSE IF h3Within(mx,my)=true then         ! t slider
          IF my<h3axis then
             CALL h3MouseClick
          ELSE
             CALL h3MouseDrag
          END IF
       ELSE IF h3AnimWithin(mx,my)=true then
          CALL h3AnimButtonUp(ms)
          CALL Orbit
       ELSE IF h3LstpWithin(mx,my)=true then
          CALL h3LstpButtonUp(ms)
          CALL h3LeftStep(t,h3AnimStep)
          CALL h3Action
       ELSE IF h3RstpWithin(mx,my)=true then
          CALL h3RstpButtonUp(ms)
          CALL h3RightStep(t,h3AnimStep)
          CALL h3Action

       ELSE IF h4Within(mx,my)=true then         ! k slider
          CALL ForcingCurve(1)
          BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in temp$
          IF my<h4axis then
             CALL h4MouseClick
          ELSE
             CALL h4MouseDrag
          END IF
          CALL w1KeepGraphLayer

       ELSE IF cb1Within(mx,my)=true then
          CALL cb1MouseUp(ms)
          LET NyState= cb1State
          CALL InitBodeNyquist(NyState)

       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

    ! --- rollover methods ---

    SUB StoreGraphsForClear
        BOX KEEP w1Lft,w1Rgt,w1Bas,w1Top in w1temp$
        BOX KEEP w2Lft,w2Rgt,w2Bas,w2Top in w2temp$
        IF NyState=1 then                        ! Bode and Nyquest on?
           BOX KEEP w3Lft,w3Rgt,w3Bas,w3Top in w3temp$
           BOX KEEP w4Lft,w4Rgt,w4Bas,w4Top in w4temp$
        END IF
    END SUB

    !                        t0     P          A       phi     H
    !
    !k = 0, omega = 0        u      inf        u       u       u
    !
    !k = 0, omega not 0      u      1/omega    0       u       0
    !
    !k not 0, omega = 0      u      inf        1       0       1


    ! ------- amplitude --------

    SUB w1AmplitudeRollover
        IF clearflag3=1 then CALL ClearPhiRollover
        IF ClearFlag1=0 then                     ! no redraw if on
           IF k>0 or w>0 then
              LET wy= w1Wndy(a)
              SET COLOR yellow
              PLOT w1Lft,wy; w1Rgt,wy
              PLOT w2Lft,wy; w2Rgt,wy
              IF NyState=1 then
                 PLOT w3Lft,wy; w3Rgt,wy
              END IF
              CALL PlotTextLJ(w2Rgt+10,wy+4,using$("%.##",a),yellow)
              LET ClearFlag1= 1
           END IF
        END IF
    END SUB

    SUB ClearAmpRollover
        BOX SHOW w1temp$ at w1Lft,w1Bas
        BOX SHOW w2temp$ at w2Lft,w2Bas
        BOX CLEAR w2Rgt+10,w2Rgt+45,w2Bas+5,w2Top-5
        IF NyState=1 then
           BOX SHOW w3temp$ at w3Lft,w3Bas
        END IF
        LET ClearFlag1= 0
    END SUB

    ! ------- phi -------

    SUB w1PhiRollover
        IF clearflag1=1 then CALL ClearAmpRollover
        IF k>0 then                              ! undefined for k=0
           IF ClearFlag4=0 then                  ! no redraw if on
              LET wy= w4Wndy(-phi)
              CALL PlotLine( w4Lft,wy, w4Rgt,wy, phiclr)
              LET n= round(RadToDeg(-phi))
              CALL PlotDegreesLJ(w4Rgt+10,w4Midy+4,n,phiclr)
              LET ClearFlag4= 1
           END IF
        ELSE
           CALL w4ShowGridLayer
        END IF
    END SUB

    SUB ClearPhiRollover
        BOX SHOW w4temp$ at w4Lft,w4Bas
        BOX CLEAR w4Rgt+10,workrgt,w4Midy+5,w4Midy-7
        LET ClearFlag4= 0
    END SUB

    ! --- slider 1 - b value ---

    SUB h1MouseClick                             ! b
        CALL h1GetClickVal(ms,h1Click,b)
        CALL h1Action(1)
        CALL SetMass
    END SUB
    SUB h1MouseDrag
        DO
           CALL h1GetDragVal(ms,h1Places,b)
           CALL h1Action(5)
        LOOP until ms=3
        BOX SHOW temp$ at w1Lft-5,w1Bas+5
    END SUB

    SUB h1Action(stp)
        IF b<>oldb then
           BOX SHOW temp$ at w1Lft-5,w1Bas+5
           LET A  = fA(w,k,b)
           LET phi= fPhi(w,k,b)
           CALL PositionCurve(stp)
           IF NyState=1 then CALL DrawBodeAndNyquist
           ! CALL h1Mark(b)
           CALL SetMass
           LET oldb= b
        END IF
    END SUB

    ! --- slider 2 - omega value ---

    SUB h2MouseClick
        CALL h2GetClickVal(ms,h2Click,w)
        CALL h2Action
        IF k>0 then CALL SetMass
    END SUB
    SUB h2MouseDrag
        DO
           CALL h2GetDragVal(ms,h2Places,w)
           CALL h2Action
        LOOP until ms=3
        IF k>0 then CALL SetMass
    END SUB

    SUB h2Action
        IF w<>oldw then
           LET A  = fA(w,k,b)
           LET phi= fPhi(w,k,b)

           IF Nystate=1 then
              CALL w3AmplitudeValue
              CALL w4PhiValue
              CALL w5NyquistValue
           END IF
           CALL w1FastGraphs(2)
           CALL h2Mark(w)
           CALL t1Val
           CALL t2Val
           IF k>0 then CALL SetMass
           ! IF w=0 then CALL w4ShowGridLayer
           LET oldw= w
        END IF
    END SUB

    SUB SetMass
        LET A  = fA(w,k,b)
        LET phi = fPhi(w,k,b)
        LET fy = cos(0)
        LET wfy= round(w1Wndy(fy))
        IF k<>0 then
           LET py= ss(0)
        ELSE
           LET py= 0                             ! -4.1
        END IF
        LET wpy= w1Wndy(py)
        CALL DrawMass(fy,wpy)                    ! update mass-spring picture
    END SUB

    ! --- slider 3 - t value ---

    SUB h3MouseClick
        CALL h3GetClickVal(ms,h3Click,t)
        CALL h3Action
    END SUB
    SUB h3MouseDrag
        DO
           CALL h3GetDragVal(ms,h3Places,t)
           CALL h3Action
        LOOP until ms=3
    END SUB

    SUB h3Action                                 ! t
        IF t<>oldt then
           CALL h3Mark(t)
           LET oldt= t

           LET wx  = w1Wndx(t)

           LET A   = fA(w,k,b)
           LET phi = fPhi(w,k,b)

           LET fy  = cos(w*t)
           LET wfy = round(w1Wndy(fy))
           LET py  = ss(t)
           LET wpy = w1Wndy(py)

           CALL w1ShowGraphLayer
           IF k<>0 or w<>0 then
              SET COLOR white
              PLOT wx,wpy; wx,wfy
              DRAW Diamond7(ampclr) with shift(wx,wpy)
              DRAW Diamond7(frcclr) with shift(wx,wfy)
              CALL DrawMass(fy,wpy)              ! update mass-spring picture
           END IF
        END IF
    END SUB

    ! --- slider 4 - k value ---

    SUB h4MouseClick
        CALL h4GetClickVal(ms,h4Click,k)
        CALL h4Action(1)
        CALL SetMass
    END SUB
    SUB h4MouseDrag
        DO
           CALL h4GetDragVal(ms,h4Places,k)
           CALL h4Action(4)
        LOOP until ms=3

        BOX SHOW temp$ at w1Lft-5,w1Bas+5
        IF k=0 and w=0 then
           CALL w1ShowGridLayer
        ELSE
           IF k>0 then CALL PositionCurve(1)
           CALL SetMass
        END IF
    END SUB

    SUB h4Action(stp)                            ! k
        IF k<>oldk then
           BOX SHOW temp$ at w1Lft-5,w1Bas+5
           IF k=0 then CALL t2ClearVal
           LET A  = fA(w,k,b)
           LET phi= fPhi(w,k,b)
           IF k>0 then
              CALL PositionCurve(stp)
           END IF
           IF NyState=1 then CALL DrawBodeAndNyquist
           CALL h4Mark(k)
           CALL SetMass

           LET oldk= k
        END IF
    END SUB

    ! ---

    SUB ReDrawGraphs
        IF NyState=1 then CALL DrawBodeAndNyquist
        CALL w1FastGraphs(2)
        CALL w1KeepGraphLayer
    END SUB

    SUB DrawBodeAndNyquist
        CALL w3AmplitudeGraph
        CALL w4PhiGraph
        CALL w5NyquistGraph

        CALL w3AmplitudeValue
        CALL w4PhiValue
        CALL w5NyquistValue
    END SUB


    ! ---- plane 3 - amplitude graph ---

    SUB w3AmplitudeGraph
        CALL w3ShowGridLayer
        SET COLOR 4
        FOR wx= w3Lft to w3Rgt
            LET w1= w3Fncx(wx)
            LET a1= fA(w1,k,b)
            LET wy= w3Wndy(a1)
            IF wy>=w3Top and wy<=w3Bas then
               PLOT wx,wy;
            ELSE
               PLOT
            END IF
        NEXT wx
        PLOT
        CALL w3KeepGraphLayer
    END SUB

    SUB w3AmplitudeValue
        CALL w3ShowGraphLayer

        IF w<>0 or k<>0 then
           LET a = fA(w,k,b)
           LET wy= w3Wndy(a)
           LET wx= w3Wndx(w)
           IF wy>=w3Top and wy<=w3Bas then
              CALL PlotLine(wx,wy, wx,w3Bas-1, ampclr)
              CALL PlotDiamond(wx,wy)
           END IF
        END IF
    END SUB

    ! ---- plane 4 - phi graph ---

    SUB w4PhiGraph
        CALL w4ShowGridLayer
        IF k<>0 then
           SET COLOR 4
           FOR wx= w4Lft to w4Rgt
               LET w1= w4Fncx(wx)
               IF w1>0 then
                  LET phi1= fphi(w1,k,b)
                  LET wy  = w4Wndy(-phi1)
               ELSE
                  LET phi1= 0
                  LET wy  = w4Wndy( phi1)
               END IF
               PLOT wx,wy;
           NEXT wx
           PLOT
        END IF
        CALL w4KeepGraphLayer
    END SUB

    SUB w4PhiValue
        CALL w4ShowGraphLayer
        IF k<>0 then
           LET phi= fphi(w,k,b)
           CALL w4MathToPixels(w,-phi,wx,wy)
           CALL PlotLine(wx,wy, wx,w4Top+1, phiclr)
           CALL PlotDiamond(wx,wy)
        END IF
    END SUB

    ! ---- plane 5 - complex Nyquist plot ---

    SUB w5NyquistGraph
        CALL w5ShowGridLayer
        IF k>0 then
           SET COLOR 4
           FOR w1= 0 to 4 step 1/32
               LET phi1= -fphi(w1,k,b)
               LET a1  =  fA(w1,k,b)
               CALL PolarToCartesian(a1,phi1,x,y)
               CALL w5MathToPixels(x,y,wx,wy)
               PLOT wx,wy;
           NEXT w1
           PLOT
        END IF
        CALL w5KeepGraphLayer
    END SUB

    SUB w5NyquistValue
        CALL w5ShowGraphLayer                    ! rotation

        IF k<>0 or (k=0 and w<>0) then
           ! draw the green arc

           SET COLOR phiClr
           LET arcrad= a/2
           FOR ang= 0 to phi step 1/16
               CALL PolarToCartesian(arcrad,ang,x,y)
               CALL w5MathToPixels(x,-y,wx,wy)
               PLOT wx,wy;
           NEXT ang
           PLOT

           ! set the line and point

           CALL PolarToCartesian(a,phi,x,y)      ! modulus
           CALL w5MathToPixels(x,-y,wx,wy)
           IF wy>=w5Top and wy<=w5Bas then
              CALL PlotLine(w5x0,w5y0, wx,wy, ampclr)
              CALL PlotDiamond(wx,wy)
           END IF
        END IF
    END SUB

    ! ---- plane 1 graphing methods ---

    SUB ShowLag                                  ! phase lag
        IF w>0 and k>0 then
           LET phi = fphi(w,k,b)
           LET lag = fT0(phi,w)
           LET wx  = w1Wndx(lag)
           LET tx  = w1Lft

           IF wx<w1Rgt then                      ! if lag is on the plane
              LET wy= phiwy
              CALL PlotLine(wx,w1Bas-1, wx,w1Wndy(A)+1, 3)
              LET wy= w1Bas-20
              CALL PlotLine(tx,wy, wx,wy ,lagclr)
           END IF

           CALL t2Val
        ELSE
           CALL t2ClearVal
        END IF
    END SUB

    SUB w1FastGraphs(stp)                        ! real time response to omega slider
        CALL w1ShowGridLayer

        IF w>0 then
           LET wpx= w1Wndx(twoPi/w)              ! show wavelength?
           IF wpx<w1Rgt then
              CALL PlotLine( wpx,w1Top+1, wpx,w1Bas-1, 3)
           END IF
        END IF

        SET COLOR frcClr                         ! forcing
        FOR wx= w1Lft to w1Rgt step stp
            LET t  = w1Fncx(wx)                  ! find time
            LET fy = cos(w*t)                    ! forcing value
            LET wfy= round(w1Wndy(fy))
            PLOT wx,wfy;
        NEXT wx
        PLOT

        IF k<>0 then
           LET A  = fA(w,k,b)                    ! amplitude
           LET phi= fPhi(w,k,b)                  ! phase angle
           CALL ShowLag

           SET COLOR posClr                      ! position
           FOR wx= w1Lft to w1Rgt step stp
               LET t  = w1Fncx(wx)
               LET py = ss(t)
               LET wpy= w1Wndy(py)
               PLOT wx,wpy;
           NEXT wx
           PLOT
        END IF
    END SUB

    SUB ForcingCurve(stp)
        CALL w1ShowGridLayer
        IF w>0 then
           LET period= twoPi/w
           LET wpx   = w1Wndx(period)
           IF wpx<w1Rgt then                     ! period on graph plane?
              CALL PlotLine( wpx,w1Top+1, wpx,w1Bas-1, 3)
           END IF
        END IF

        SET COLOR frcClr                         ! forcing
        FOR wx= w1Lft to w1Rgt step stp
            LET t  = w1Fncx(wx)                  ! find time
            LET fy = force(t)                    !cos(w*t)                    ! forcing value
            LET wfy= round(w1Wndy(fy))
            PLOT wx,wfy;
        NEXT wx
        PLOT
    END SUB

    SUB PositionCurve(stp)
        CALL ShowLag
        SET COLOR posClr                         ! position
        FOR wx= w1Lft to w1Rgt step stp
            LET t  = w1Fncx(wx)
            LET py = ss(t)
            LET wpy= w1Wndy(py)
            PLOT wx,wpy;
        NEXT wx
        PLOT
    END SUB

    SUB Orbit
        CALL w1ShowGraphLayer

        LET A   = fA(w,k,b)
        LET phi = fPhi(w,k,b)

        LET start= round(w1Wndx(t))
        IF start>=w1Rgt then LET start= w1Lft    ! restart at 0 if off plane

        FOR wx= start to w1Rgt
            LET t = w1Fncx(wx)
            CALL h3mark(t)

            IF k<>0 or w<>0 then
               LET py = ss(t)
               LET wpy= round(w1Wndy(py))
               LET fy = force(t)                 !cos(w*t)
               LET wfy= round(w1Wndy(fy))

               CALL DrawMass(fy,wpy)             ! update mass-spring picture

               CALL w1ShowGraphLayer
               CALL PlotLine( wx,wpy, wx,wfy, litgry)

               SET COLOR ampclr
               CALL PlotDiamond(wx,wpy)
               SET COLOR frcclr
               CALL PlotDiamond(wx,wfy)
            END IF

            GET MOUSE: mx,my,ms
            IF ms=2 then
               CALL h3AnimStopButtonUp(ms)
               CALL h3StopButtonClear
               EXIT SUB
            END IF
            CALL Delay(1/30)
        NEXT wx
        CALL h3StopButtonClear
    END SUB

    ! --- plane 2 mass and spring graphics ---

    SUB DrawMass(fy,wpy)
        LET fy   = force(t)
        LET stop = frcy + unit*(1 - fy) + 8      ! spring top
        LET sdst = wpy - stop                    ! when forced
        LET seg  = (sdst-shgt2)/segs
        LET seg14= 0.25*seg
        LET seg34= 0.75*seg
        LET sbas = stop+sdst - shgt2
        LET mtop = sbas
        LET mbas = sbas+shgt
        LET dbas = mbas+w1wHgt
        LET wmy  = (mtop+mbas)/2

        BOX SHOW symboxb1$ at slft,w2Bas

        SET COLOR sprClr                         ! draw spring
        FOR i= 0 to segs-1
            LET pnt= stop + i*seg - 1
            PLOT w2Midx,pnt; splft,pnt+seg14; sprgt,pnt+seg34; w2Midx,pnt+seg
        NEXT i

        CALL BoxArea(slft+8,srgt-8,stop-1,stop-8,frcClr)   ! forcing plunger
        CALL BoxArea(dlft+8,drgt-8,stop-7,ceiling,frcClr)

        BOX SHOW mass$ at slft+8,mbas
        BOX SHOW damp$ at dlft,dbas
    END SUB

    SUB DrawSpringStand
        LET slft= w2Midx-16                      ! mass
        LET srgt= w2Midx+16

        LET llft= slft+2                         ! force arrows
        LET lrgt= llft+2
        LET rlft= srgt-4
        LET rrgt= rlft+2

        LET dlft  = w2Midx-5                     ! dashpot
        LET drgt  = w2Midx+5
        LET dmplft= dlft+4
        LET dmprgt= drgt-4

        LET shgt   = 10
        LET ceiling= w2Top+10
        LET floor  = w2Bas-10

        LET shgt2= shgt/2
        LET shlft= w2Lft+10
        LET shrgt= w2Rgt-10
        LET shbas= w2Bas-10
        LET shtop= w2Top+22

        LET splft= slft+12                       ! spring bounds
        LET sprgt= srgt-12

        LET dbas = mbas+w1wHgt
        LET segs = 8
        LET unit = w1wHgt/w1fHgt - 8
        LET frcy = ceiling                       !+10
        LET stop = frcy

        CALL BoxArea(w2Lft,w2Rgt,w2Bas,w2Top,black)   ! draw the box
        CALL BoxLines(w2Lft,w2Rgt,w2Bas,w2Top,litmid)

        CALL BoxArea(w2Lft+1,w2Rgt-1,ceiling-1,w2Top+1,13)      ! draw the ceiling
        CALL BoxArea(w2Lft+1,w2Rgt-1,floor+1,w2Bas-1,13)   ! draw the floor

        CALL BoxArea(dlft-3,drgt+3,floor,w1Bas+8,13)  ! draw the dashpot
        CALL BoxArea(dlft,drgt,floor,w1Bas,black)

        BOX KEEP slft,srgt,w2Bas,w2Top in symboxb1$

        LET mbas= w1y0+5
        CALL BoxArea(slft+8,srgt-8,mbas,w1y0-5,posclr)     ! mass
        BOX KEEP slft+8,srgt-8,mbas,w1y0-5 in mass$

        LET dbas= mbas+w1wHgt
        CALL BoxArea(dmplft,dmprgt,dbas,mbas+1,litmid)     ! damper
        CALL BoxArea(dlft,drgt,dbas,dbas-2,litmid)
        BOX KEEP dlft,drgt,dbas,mbas+1 in damp$
    END SUB
END SUB

! --- end of Vibration Amplitude and Phase -------------------