!  Harmonic Frequency Response
!  
!  The harmonic oscillator with circular frequency omega is driven by 
!  a periodic signal of fixed period  2 pi.  This tool shows the periodic
!  system response. 
!  
!  The main graphing window shows the signal in blue and the periodic
!  system response in yellow. The cursor invokes crosshairs and a readout
!  of the values of  t  and  x. 
!  
!  A menu at bottom right selects the signal  f(t).  Each signal is
!  marked with a * when it has been invoked.
!  
!  A slider and < , > buttons at right control the natural circular frequency 
!  omega_n  of the harmonic oscillator. Above this slider is a graph of the
!  root mean square size of the system response, with the value corresponding
!  to the current value of omega marked by a yellow diamond and line segment.


! Harmonic Oscillator. Let's call this Harmonic Freqency Response.

! Our convention seems to be to use blue for
! the signal and yellow for the response. So I suggest making 
! what is now green in blue. The blue RMS and its indicator
! should be yellow, I think, despite the slightly different 
! significance (by sqrt(2)). Also: let's write omega_n in the 
! equation and at the slider and RMS graph, rather than merely omega.

! 1 / (2*sqr(2)) = sqr(2)/4

! So, we should multiply all those amplitude formulas, 
! in the harmonic response tool, by 
!
!   1/sqrt(2)
!
! This could be absorbed into some of the formulas, I guess. 
! The vertical axis should read  RMS,  for root mean square.

! OK, for the impulse train response try the EVEN function of period  2pi with
! x = ( (omega/2) / cos(pi omega/2) ) sin( omega ( t - (pi/2) ) )
! for  0 < t < pi.  (So  for  -pi < t < 0,  x(t) = x(-t) .)
! I'll compute the 'amplitude' when I have another minute to think about this.

!! File: HarmonicOscillator
!! June 27, 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 backclr,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$ = "Harmonic Frequency Response"

SUB ThisProgram
    CALL HarmonicOscillator
    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 ---

!LIBRARY "HHLib.trc"
!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 HarmonicOscillator
    DECLARE PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white
    DECLARE PUBLIC red,yellow,green,cyan,blue,magenta,colorscheme
    DECLARE PUBLIC axislabelclr,axisclr,slideclr,true,false
    DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx

    DECLARE DEF quitWithin, infoWithin


    ! --- help screen array ---

    DIM info$(1:10)
    MAT READ info$
    DATA "Harmonic Frequency Response"
    DATA ""
    DATA "This tool shows the periodic system response for a harmonic oscillator with circular frequency omega_n driven by a periodic signal of fixed period 2 pi."
    DATA ""
    DATA "The main graph plane shows the signal in blue and the periodic system response in yellow."
    DATA "When the mouse is rolled over the plane, cursor crosshairs and the values of  t  and  x are displayed."
    DATA "Click the [v] menu button in the lower right to display the signals  f(t). Click one of the signals to select it."
    DATA "Click or drag the omega_[n] slider at the right to set the natural circular frequency of the harmonic oscillator."
    DATA "Click the < or > buttons under the slider to step the value of omega_[n] by hundreths."
    DATA "Above the omega_[n] slider is a graph of the root mean square size of the system response. The RMS value corresponding to the current value of omega_[n] is marked by a yellow diamond."


    ! --- color variables ---

    LET ampClr = yellow
    LET frcClr = cyan
    LET sigClr = yellow


    ! --- Utility functions ---

    DECLARE DEF clamp,roundn,e
    DEF RadToDeg(rad)= rad*180/pi
    LET bignum= 987654321

    ! --- useful values ---

    DEF pi2  = 2*pi
    LET sqrt2= sqr(2)


    ! ------------ functions -----------
    ! ----- define forcing and DEs -----

    DEF f(t)                                     ! forcing
        SELECT CASE force
        CASE 1                                   ! sine
             LET f = sin(t)
        CASE 2                                   ! square
             LET f = sgn(pi-mod(t,pi2))          ! square wave: +1 or -1
        CASE 3                                   ! sawtooth
             LET f = (mod(t-pi,pi2)-pi)/2        ! sawtooth wave
        CASE 4                                   ! impulse
             ! drawing routine elsewhere
        END SELECT
    END DEF

    DEF dxdt(t,v) = v                            ! change in position

    DEF dvdt(t,x)                                ! change in velocity
        LET dvdt = -w^2*x + w^2*f(t)
    END DEF

    ! ----- define solution and solution parameter -----

    DEF fb(w)                                    ! solution constant
        SELECT CASE force
        CASE 1                                   ! sine
             IF w<>1 then
                LET fb= w^2/(1-w^2)
             ELSE
                LET fb= bignum
             END IF
        CASE 2,4                                 ! square
             LET w= round(w,8)
             IF w<>int(w) then                   ! integer?
                LET num= round(cos(pi*w)-1,8)
                LET den= round(sin(pi*w),8)
                LET fb = num / den
             ELSE IF mod(w,2)=0 then             ! even?
                LET fb = 0
             ELSE                                ! odd
                LET fb = bignum                  ! bignum
             END IF
        CASE 3                                   ! sawtooth
             LET w= round(w,8)
             IF w<>int(w) then                   ! integer?
                LET fb= pi / sin(pi*w)           ! integer multiples of pi = 0
             ELSE
                LET fb= bignum
             END IF
        END SELECT
    END DEF

    DEF g(t)                                     ! solution
        SELECT CASE force
        CASE 1                                   ! sine
             LET fg= b*sin(w*t)
        CASE 2                                   ! square
             LET mt= mod(t,pi2)                  ! modulo t is always 0 to 2pi

             IF mt>=0 and mt<pi then             !  g( t) for 0 to pi
                LET fg= 1 - cos(w*mt) + b*sin(w*mt)
             ELSE IF mt>=pi and mt<pi2 then      ! -g(-t) for pi to 2pi
                LET mt= mod(-t,pi2)
                LET fg= -(1 - cos(w*mt) + b*sin(w*mt))
             END IF
        CASE 3                                   ! sawtooth
             LET mt = mod(t-pi,pi2) - pi
             LET fg = (mt - b*sin(w*mt))/2
        CASE 4                                   ! impulse
             ! x(t) = ((w/2) / cos(pi*w/2)) * sin(w*(t - (pi/2)))   ! for  0<t<pi 
             ! x(t) = x(-t)   ! for  -pi<t<0

             LET mt = mod(t,pi2)                 ! modulo t is always 0 to 2pi

             IF mt<=pi then                      !  g( t) for 0 to pi
                LET fg=  ((w/2) / cos(pi*w/2)) * sin(w*(mt - (pi/2)))
             ELSE IF mt>pi then                  !  g(-t) for pi to 2pi
                LET mt=  mod(-t,pi2)
                LET fg=  ((w/2) / cos(pi*w/2)) * sin(w*(mt - (pi/2)))
             END IF
        END SELECT
        LET g= fg                                ! /sqrt2
    END DEF

    DEF a(w,b)
        LET w  = round(w,4)
        LET piw= pi*w
        SELECT CASE force
        CASE 1                                   ! sine
             LET am= b
        CASE 2                                   ! square
             IF w>0 then
                LET t1 =  (3 + b^2) * (pi/2)
                LET t2 = -(2/w) * sin(piw)
                LET t3 =  (2*b/w) * (1-cos(piw))
                LET t3 =  (1-b^2)/(4*w) * sin(2*piw)
                LET t5 =  -b/(2*w) * (1-cos(2*piw))
                LET am =   sqr( 2/pi * (t1+t2+t3+t3+t5) )
             ELSE
                LET am =  0
             END IF
        CASE 3                                   ! sawtooth
             IF w>0 then
                LET t1 =  pi^3/3 + b^2*pi/2
                LET t2 =  2*b*pi/w * cos(piw)
                LET t3 = -2*b/w^2 * sin(piw)
                LET t3 = -b^2/(4*w) * sin(2*piw)
                LET am = (sqr( 2/pi * (t1+t2+t3+t3) ))/2
             ELSE
                LET am =  0
             END IF
        CASE 4                                   ! impulse
             WHEN error in
                  LET am = sqr(1-sin(piw)/(piw)) * (w/(2*abs(cos(piw/2))))
             USE
                  LET am = 0
             END WHEN
        END SELECT
        LET a= abs(am/sqrt2)
    END DEF


    ! --- Design and layout ---

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

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

    LET w1Lft = workLft+60                       ! window bounds
    LET w1Rgt = w1Lft+400
    LET w1Top = workTop+85
    LET w1Bas = w1Top+300

    LET w1fLft= -2                               ! function bounds
    LET w1fRgt=  2
    LET w1fTop=  6
    LET w1fBas= -6

    LET w1xAx$= "t"                              ! axis labels
    LET w1yAx$= "x"

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

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

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


    ! --- w1 Plane methods ---

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

    CALL w1Variables

    SUB w1Init
        CALL w1DrawPlane(1,1,1)                  ! x axis, y axis, zeroaxes

        CALL SetTextFont(1,12,"bold")
        CALL PlotTextLJ(w1Rgt+8,w1y0+3,w1Xax$,litgry)      ! axis labels
        CALL PlotTextCJ(w1x0,w1Top-10,w1Yax$,yellow)
        CALL w1ForceGraph
        CALL w1KeepGridLayer
        CALL w1KeepGraphLayer
    END SUB

    SUB w1ShowTempLayer
        BOX SHOW w1TempLayer$ at w1Lft-5,w1Bas+5
    END SUB

    SUB w1KeepTempLayer
        BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in w1TempLayer$
    END SUB

    SUB w1ShowGraphLayer2
        BOX SHOW w1graphLayer2$ at w1Lft-5,w1Bas+5
    END SUB

    SUB w1KeepGraphLayer2
        BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in w1graphLayer2$
    END SUB


    ! ------------ w2 plane - omega/RMS graph ----------------

    ! ----- w2 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 w2xMult  = 1
    LET w2yPiFlag= 0
    LET w2yMult  = 1

    LET w2Lft = workrgt - 225                    ! pixel bounds
    LET w2Rgt = w2Lft + 150
    LET w2Top = w1Top
    LET w2Bas = w1Midy

    LET w2fLft= 0                                ! function bounds
    LET w2fRgt= 6
    LET w2fTop= 6
    LET w2fBas= 0

    LET w2xAx$= "w"                              ! axis labels
    LET w2yAx$= "RMS"

    LET w2xGridstep= 0                           ! grid line intervals
    LET w2yGridstep= 0

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

    LET w2ySTik = 0
    LET w2yLTik = 1
    LET w2yLabel= 1
    LET w2yFirst= w2fBas

    ! ----- w2 methods -----

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

    CALL w2Variables

    SUB w2Init
        CALL w2DrawPlane(1,1,1)                  ! x axis, y axis, zeroaxes

        CALL SetTextFont(1,12,"bold")
        CALL SuperSubScriptOmegaLJ(w2Rgt+8,w2y0+1,"w_[n]","w",litgry)

        CALL SuperSubScriptCJ(w2x0,w2Top-10,w2yAx$,ampclr)
        CALL w2KeepGridLayer
    END SUB

    SUB w2SetBounds(force)
        LET w2fTop= w1fTop
        CALL w2Variables
    END SUB

    SUB w2KeepTempLayer
        BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2TempLayer$
    END SUB

    SUB w2ShowTempLayer
        BOX SHOW w2TempLayer$ at w2Lft-5,w2Bas+5
    END SUB


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

    ! --- h1 slider - omega value ---

    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   = slideclr
    LET h1name$ = ""
    LET h1form$ = "%.##"
    LET h1Places= 2
    LET h1Click = 0.5

    LET h1axis  = w2Bas + 22
    LET h1wLft  = w2Lft
    LET h1wRgt  = w2Rgt

    LET h1fLft  = w2fLft
    LET h1fRgt  = w2fRgt

    LET h1STik  = 0.5
    LET h1LTik  = 1
    LET h1Label = 1
    LET h1First = h1fLft

    CALL h1SliderVariables

    DECLARE DEF h1AnimWithin, h1LStpWithin, h1RStpWithin
    DECLARE DEF h1AnimStopWithin

    LET h1AnimStep= 0.01                         ! two pixels

    SUB h1Init
        LET t= 0
        CALL h1DrawSlider(h1name$,w)
        CALL h1AnimMoveStep(0,0,1)               ! animstate,movestate,stepstate
    END SUB


    ! ----- menu 1 - parameters -----

    DECLARE PUBLIC m1Lft, m1Rgt, m1Bas, m1Top, m1Name$
    DECLARE PUBLIC m1Equation, m1Prefix$, m1tClr, m1Menu1$()
    DECLARE DEF m1Within

    LET m1Prefix$ = ""
    LET m1Lft     = w2Lft - 40
    LET m1Top     = w1Bas + 20
    LET m1tClr    = frcClr
    LET m1Equation= 1
    LET m1Prefix$ = "f(t) = "

    MAT redim m1Menu1$(1:4)
    MAT READ m1Menu1$

    DATA "sine wave"
    DATA "square wave"
    DATA "sawtooth wave"
    DATA "impulse train"


    ! --- text output boxes ---

    ! --- text rectangle 1 - period equation and value ---
    ! ----- Period = 2pi/omega -----

    LET t1BasLn = w1Top - 40
    LET t1Lft   = w1Lft
    LET t1Rgt   = w1Rgt
    LET t1Bas   = t1BasLn +  5
    LET t1Top   = t1BasLn - 15
    LET t1Label$= "x + w^[2] x = w^[2] f(t)"
    LET t1Width$= "x + w2 x = w2 f(t)"
    LET t1Clr   = yellow

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

    SUB t1Set
        CALL SetTextFont(1,12,"bold")
        CALL StringWidth(t1Width$,sw)
        LET lft = w1Midx - sw/2

        CALL SuperSubScriptOmegaLJ(lft,t1BasLn,"x + w_[n]","w",t1Clr)
        CALL PlotTextLJ(lft,t1BasLn - 10,"..",t1Clr)

        LET txt$= "x + w"
        CALL StringWidth(txt$,sw)
        LET lft = lft+sw+1
        CALL SetTextFont(1,9,"bold")
        LET txt$= "2"
        CALL PlotTextLJ(lft,t1BasLn-6,txt$,t1Clr)
        LET lft= lft+9

        CALL SetTextFont(1,12,"bold")
        CALL SuperSubScriptOmegaLJ(lft,t1BasLn,"x = w_[n]","w",t1Clr)
        LET txt$= "x = w"
        CALL StringWidth(txt$,sw)
        LET lft = lft+sw+1
        CALL SetTextFont(1,9,"bold")
        LET txt$= "2"
        CALL PlotTextLJ(lft,t1BasLn-6,txt$,t1Clr)
        CALL StringWidth(txt$,sw)
        LET lft = lft+sw

        CALL SetTextFont(1,12,"bold")
        LET txt$= " f(t)"
        CALL PlotTextLJ(lft,t1BasLn,txt$,t1Clr)
    END SUB

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

    SUB t1Init
        CALL t1Set
    END SUB


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

    LET t2BasLn = t1BasLn
    LET t2Lft   = w2Lft-5
    LET t2Rgt   = workRgt
    LET t2Bas   = t2BasLn +  5
    LET t2Top   = t2BasLn - 15
    LET t2Label$= "RMS = "
    CALL StringWidth(t2Label$,sw)
    LET t2Eqx   = t2Lft + sw

    SUB t2Init
        CALL t2Label
        CALL t2Value
    END SUB

    SUB t2Label
        CALL SetTextFont(1,12,"bold")
        CALL SuperSubScriptRJ(t2Eqx,t2BasLn,t2Label$,ampClr)
    END SUB

    SUB t2Value
        CALL t2ClearValue
        CALL SetTextFont(1,12,"bold")
        LET t$ = trim$(using$("--------%.##",amp))
        CALL PlotTextLJ(t2Eqx,t2BasLn,t$,ampClr)
    END SUB

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

    SUB t2ClearValue
        BOX CLEAR t2Eqx-2,t2Rgt,t2Bas,t2Top
    END SUB


    ! --- text rectangle 4 ---

    LET t3BasLn1= w1Bas - 60
    LET t3BasLn2= t3BasLn1 + 20
    LET t3Lft   = w2Lft
    LET t3Rgt   = t3Lft + 100
    LET t3Bas   = t3BasLn2 +  5
    LET t3Top   = t3BasLn1 - 15
    LET t3Clr   = litgry

    LET t3Label1$= "t = "
    LET t3Label2$= "x = "
    CALL StringWidth(t3Label2$,sw)
    LET t3Eqx= t3Lft + sw

    SUB t3Label
        CALL SuperSubScriptRJ(t3Eqx,t3BasLn1,t3Label1$,t3Clr)
        CALL SuperSubScriptRJ(t3Eqx,t3BasLn2,t3Label2$,t3Clr)
    END SUB

    SUB t3Set
        LET t = w1Fncx(mx)/pi
        LET x = w1Fncy(my)
        LET t$= trim$(using$("--%.##",t))
        LET x$= trim$(using$("--%.##",x))
        CALL t3Clear
        CALL StringWidth(t$,sw)
        LET px= t3Eqx + sw + 3
        CALL PlotTextLJ(t3Eqx,t3BasLn1,t$,t3Clr)
        CALL DrawPi12(px,t3BasLn1,t3Clr)
        CALL PlotTextLJ(t3Eqx,t3BasLn2,x$,t3Clr)
    END SUB

    SUB t3Clear
        BOX CLEAR t3Eqx-2,t3Rgt,t3Bas,t3Top
    END SUB

    SUB t3Init
        CALL t3Label
    END SUB

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


    ! --- initialize default parameters ---

    LET m1State    = 0
    LET force      = 1
    LET m1Equation = force
    LET w,oldw     = 3.5
    LET b          = fb(w)
    LET amp        = a(w,b)
    LET t,oldt     = 0

    ! --- Draw the screen ---

    CALL InitScreen
    CALL m1InitMenu1

    SUB InitScreen
        BOX CLEAR worklft,workrgt,workbas,worktop
        LET b  = fb(w)
        LET amp= a(w,b)

        CALL w1Init
        CALL w2Init                              ! Amplitude

        CALL h1Init
        CALL w1Graph

        CALL w2Graph
        CALL w2Value

        CALL t1Init
        CALL t3Init
        CALL m1ResetMenu(m1State)
    END SUB

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

    DO
       LET w1Clear= 0
       LET w2Clear= 0
       LET oldmx,oldmy= 99999
       CALL w1KeepTempLayer
       CALL w2KeepTempLayer
       DO
          GET MOUSE: mx,my,ms
          IF w1wWithin(mx,my)=true then
             IF w2Clear=1 then CALL w2RollOverClear
             CALL w1RollOver
          ELSE IF w2Within(mx,my)=true then
             IF w1Clear=1 then CALL w1RollOverClear
             IF w2Clear=0 then
                IF oldmx<>mx or oldmy<>my then

                   LET wa = w2Wndy(amp)
                   CALL t2Init
                   LET w2Clear= 1
                   LET oldmx  = mx
                   LET oldmy  = my
                END IF
             END IF
          ELSE IF w1Clear=1 then
             CALL w1RollOverClear
          ELSE IF w2Clear=1 then
             CALL w2RollOverClear
          END IF
       LOOP until ms=2

       IF w1wWithin(mx,my)=true then
          IF w2Clear=1 then CALL w2RollOverClear
          DO
             GET MOUSE: mx,my,ms
             IF w1wWithin(mx,my)=true then
                IF oldmx<>mx or oldmy<>my then
                   CALL w1RollOver
                END IF
             ELSE
                IF w1Clear=1 then
                   CALL w1ShowTempLayer
                   LET w1Clear= 0
                   CALL t3Clear
                END IF
             END IF
          LOOP until ms=3
          IF w1Clear=1 then CALL w1RollOverClear

       ELSE IF w2Within(mx,my)=true then
          IF w1Clear=1 then CALL w1RollOverClear
          DO
             GET MOUSE: mx,my,ms
             IF w2Within(mx,my)=true then
                IF oldmx<>mx or oldmy<>my then
                   LET wa = w2Wndy(amp)
                   SET COLOR cyan
                   CALL w1ShowTempLayer
                   CALL w2ShowTempLayer
                   PLOT w2Lft,wa; w2Rgt,wa
                   PLOT w1Lft,wa; w1Rgt,wa
                   LET w2Clear= 1
                   LET oldmx  = mx
                   LET oldmy  = my
                END IF
             ELSE
                IF w2Clear=1 then
                   CALL w2RollOverClear
                END IF
             END IF
          LOOP until ms=3
          IF w2Clear=1 then CALL w2RollOverClear

       ELSE IF h1Within(mx,my)=true then         ! omega
          IF my<h1axis then
             CALL h1MouseClick
          ELSE
             CALL h1MouseDrag
          END IF
       ELSE IF h1LstpWithin(mx,my)=true then
          CALL h1LstpButtonUp(ms)
          CALL h1LeftStep(w,h1AnimStep)
          CALL h1Action
       ELSE IF h1RstpWithin(mx,my)=true then
          CALL h1RstpButtonUp(ms)
          CALL h1RightStep(w,h1AnimStep)
          CALL h1Action

       ELSE IF m1Within(mx,my)=1 then            ! menu for data sets
          CALL m1ButtonUp(ms)
          CALL m1ReadMenu
          LET force = m1Equation
          CALL InitScreen

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

    ! --- rollover methods ---

    SUB w1RollOver
        IF oldmx<>mx or oldmy<>my then
           CALL w1ShowTempLayer
           SET COLOR drkmid
           PLOT mx,w1Top+1; mx,w1Bas-1
           PLOT w1Lft+1,my; w1Rgt-1,my
           CALL t3Set

           LET w1Clear= 1
           LET oldmx  = mx
           LET oldmy  = my
        END IF
    END SUB

    SUB w1AmplitudeRollover
        IF ClearFlag1=0 then                     ! don't flicker if on
           LET amp= a(w,b)
           LET ra = round(amp,5)
           LET wy = w1Wndy(ra)

           SET COLOR yellow
           IF w<>0 then
              PLOT w1Lft,wy; w1Rgt,wy
              PLOT w2Lft,wy; w2Rgt,wy
              CALL PlotTextLJ(w1Rgt+30,wy+4,using$("%.##",ra),yellow)
           END IF
           LET ClearFlag1= 1
        END IF
    END SUB

    SUB StoreGraphsForClear
        CALL w1KeepTempLayer
        CALL w2KeepTempLayer
    END SUB

    SUB ClearAmpRollover
        CALL w1ShowTempLayer
        BOX CLEAR w1Rgt+25,w1Rgt+75,w2Bas+5,w2Top-5
        CALL w2ShowTempLayer
        LET ClearFlag1= 0
    END SUB

    SUB w1RollOverClear
        CALL w1ShowTempLayer
        LET w1Clear= 0
        CALL t3Clear
    END SUB

    SUB w2RollOverClear
        CALL w1ShowTempLayer
        CALL w2ShowTempLayer
        CALL t2Clear
        LET w2Clear= 0
    END SUB


    ! --- mouse events ---

    ! --- h1 slider - w (omega) value ---

    SUB h1MouseClick
        CALL h1GetClickVal(ms,h1Click,w)
        CALL h1Action
    END SUB
    SUB h1MouseDrag
        DO
           CALL h1GetDragVal(ms,h1Places,w)
           CALL h1Action
        LOOP until ms=3
    END SUB

    SUB h1Action
        IF w<>oldw then
           LET b  = fb(w)
           LET amp= a(w,b)
           IF w>0 and amp<>bignum then
              CALL w2Value
              CALL w1Graph                       ! draw the bay height curve
           ELSE
              CALL w1ShowGridLayer
              CALL w2ShowGraphLayer
           END IF
           LET oldw= w
        END IF
    END SUB


    ! --- w1 plane graphing methods ---

    SUB w1Graph
        SET COLOR yellow
        CALL w1ShowGraphLayer
        LET wy= w1Wndy(g(-2*pi))

        FOR wx= w1Lft to w1Rgt
            LET t    = w1Fncx(wx)
            LET pos  = g(t)
            LET oldwy= wy
            LET wy   = w1Wndy(pos)
            IF (wy>=w1Top and wy<=w1Bas) and (oldwy>=w1Top and oldwy<=w1Bas) then
               PLOT wx,wy; wx-1,oldwy

            ELSE IF wy<w1Top and oldwy>w1Bas then
               PLOT wx,w1Top; wx-1,w1Bas
            ELSE IF oldwy<w1Top and wy>w1Bas then
               PLOT wx-1,w1Top; wx,w1Bas

            ELSE IF wy>=w1Top and oldwy<w1Top then
               PLOT wx,wy; wx-1,w1Top
            ELSE IF oldwy>=w1Top and wy<w1Top then
               PLOT wx,w1Top; wx-1,oldwy

            ELSE IF wy<=w1Bas and oldwy>w1Bas then
               PLOT wx,wy; wx-1,w1Bas
            ELSE IF oldwy<=w1Bas and wy>w1Bas then
               PLOT wx,w1Bas; wx-1,oldwy

            ELSE
               PLOT
            END IF
        NEXT wx
        PLOT
        CALL w1KeepGraphLayer2
    END SUB

    SUB w1ForceGraph
        SET COLOR frcClr
        LET tstp= .01

        SELECT CASE force
        CASE 1                                   ! sine
             FOR wx= w1Lft to w1Rgt
                 LET t = w1Fncx(wx)
                 LET y = f(t)
                 LET wy= w1Wndy(y)
                 IF wy>=w1Top and wy<=w1Bas then
                    PLOT wx,wy;
                 ELSE
                    PLOT
                 END IF
             NEXT wx
             PLOT
        CASE 2                                   ! square
             LET wp   = w1Wndy( 1)
             LET wm   = w1Wndy(-1)

             PLOT w1Lft,wp; w1Lft,wm
             FOR i= -2 to 1
                 LET lft= pi*i
                 LET rgt= lft + pi
                 LET wl = w1Wndx(lft)
                 LET wr = w1Wndx(rgt)
                 IF mod(i,2)=0 then
                    PLOT wl,wp; wr,wp
                 ELSE
                    PLOT wl,wm; wr,wm
                 END IF
                 IF i<2 then
                    PLOT wr,wp; wr,wm
                 END IF
             NEXT i
        CASE 3                                   ! sawtooth
             LET wpip = w1Wndy( pi/2)
             LET wpim = w1Wndy(-pi/2)

             LET y= 0
             FOR wx= w1Lft to w1Rgt
                 LET t   = w1Fncx(wx)
                 LET oldy= y
                 LET y   = f(t)
                 IF oldy>0 and y<0 then
                    PLOT
                    PLOT wx,wpim;
                 ELSE
                    LET wy= w1Wndy(y)
                    PLOT wx,wy;
                 END IF
             NEXT wx
             PLOT

             FOR x= -1 to 1 step 2
                 LET wx= w1Wndx(x*pi)
                 PLOT wx,wpim; wx,wpip
             NEXT x
        CASE 4                                   ! impulse
             LET whgtp= w1Wndy(w1fTop)+2
             LET whgtm= w1Wndy(w1fBas)-2

             PLOT w1Lft,w1y0; w1Rgt,w1y0
             FOR x= -2*pi to 2*pi step 2*pi
                 LET wx= w1Wndx(x)
                 PLOT wx,w1y0; wx,whgtp
                 CALL ArrowUp(wx,whgtp)
             NEXT x
             FOR x= -1*pi to 1*pi step 2*pi
                 LET wx= w1Wndx(x)
                 PLOT wx,w1y0; wx,whgtm
                 CALL ArrowDown(wx,whgtm)
             NEXT x
        END SELECT
    END SUB

    SUB arrowDown(ax,ay)
        LET size= 4
        PLOT ax-size,ay-size;   ax,ay;   ax+size,ay-size
        PLOT ax-size,ay-size+1; ax,ay+1; ax+size,ay-size+1
        PLOT ax-size,ay-size+2; ax,ay+2; ax+size,ay-size+2
    END SUB
    SUB arrowUp(ax,ay)
        LET size= 4
        PLOT ax-size,ay+size;   ax,ay;   ax+size,ay+size
        PLOT ax-size,ay+size-1; ax,ay-1; ax+size,ay+size-1
        PLOT ax-size,ay+size-2; ax,ay-2; ax+size,ay+size-2
    END SUB

    ! ---- w2 plane - amplitude graph ---

    SUB w2Graph
        SET COLOR litmid
        CALL w2ShowGridLayer
        LET wy= w2y0

        FOR wx= w2Lft to w2Rgt
            LET w2   = w2Fncx(wx)                ! omega
            LET b5   = fb(w2)
            LET y    = a(w2,b5)                  ! amplitude
            IF y<bignum then
               LET oldwy= wy
               LET wy   = w2Wndy(y)
               IF force=4 and mod(y,2)=1 then
               ELSE
                  IF wy>=w2Top and oldwy>=w2Top then
                     PLOT wx,wy; wx-1,oldwy
                  ELSE IF oldwy>=w1Top then
                     PLOT wx,oldwy; wx,w1Top
                  ELSE IF wy>=w1Top then
                     PLOT wx,w1Top; wx,wy
                  ELSE
                     PLOT
                  END IF
               END IF
            ELSE
               PLOT
            END IF
        NEXT wx
        PLOT
        CALL w2KeepGraphLayer
    END SUB

    SUB w2Value
        CALL w2ShowGraphLayer

        IF w>0 and amp<>0 then
           LET wx= round(w2Wndx(w))
           LET wy= w2Wndy(amp)
           IF wy>= w1Top and wy<=w1Bas then
              CALL PlotDiamondClr(wx,wy,ampclr)
              CALL PlotLine( wx,wy, wx,w2Bas-1, ampclr)
           END IF
        END IF
    END SUB

    SUB Amplitude
        SET COLOR ampClr
        LET wa = w1Wndy(amp)
        IF wa>=w1Top and wa<=w1Bas then
           PLOT w1Lft+1, wa; w1Rgt-1, wa
           PLOT w1Lft+1,-wa; w1Rgt-1,-wa
        END IF
    END SUB
END SUB

! --- end of Harmonic Oscillator code -------------------