!   Euler's Method: The t_0, y_0 readout doesn't update properly when
!   the initial value is reset. While we're at it, let's change the
!   response to selecting "actual" or "All Euler" when an initial
!   value is selected, to make it the same as the response of
!   the various Euler options, namely, do nothing and wait for
!   the user to press "Start."

! I find the t = , y =  readout confusing: what I would expect to see
! is the point at which the cursor is placed, but what shows up is the
! cooridinates of the head of the arrow instead. 


!! File: Eulers Method
!! August 25, 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

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

LET title$ = "Euler's Method"

SUB ThisProgram
    CALL EulersMethod
    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\TBLibs\TrueCtrl.trc"         ! windows
LIBRARY "c:\TB Gold\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.unix"
!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 EulersMethod
    DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx     ! 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 PUBLIC inpChrSpc, chspc

    DECLARE DEF InfoWithin,QuitWithin

    ! --- info page ---

    DIM Info$(1:16)
    MAT READ Info$

    DATA "Euler's Method"
    DATA ""
    DATA "This tool supports visual exploration of Euler's method of approximating solutions to the first order ODE,  dy/dt = f(t,y)."
    ! DATA "To the left is a column of values of  (t,y) , starting with the selected initial condition and continuing with the verticies of the Euler polygon."

    DATA "Roll the mouse cursor over the main window to display the direction vector determined by f(t,y), the coordinates (t,y), and the slope f(t,y)."

    ! DATA "This tool supports comparison of the graphs of approximate solutions of differential equations using Euler's numerical method with several different timestep sizes."

    DATA ""
    DATA "Click the pop-up menu button [v] to open the list of equations. Click an equation to select it."
    DATA "Click the 'Slope Field' checkbox to toggle the slope field on or off."
    DATA "Click the mouse on the (t,y) plane to set initial values for numerical solutions on the graph plane and in the coordinate list."
    DATA "Click one of the numerical methods to select Euler step sizes or the solution."
    DATA "-Selecting an Euler method allows you to build a solution by hand by setting a sequence of vectors. Click the plane to set a vector, then click near the head of the vector to build the Euler solution."
    DATA "-You can also build a solution by clicking [Start]; or by clicking the plane, clicking [Start], and then clicking [Next Step] over and over."
    DATA "-Selecting the 'Actual' checkbox, then [Start] allows you do draw a solution for comparison."
    DATA "Click [All Euler] and then click [Start] or click the plane to compare the four Euler approximations."
    DATA "Click [Clear] to remove vectors and solutions from the plane."
    DATA "Click [Start] to set a vector or start a solution from the current initial values."
    DATA "Click [Next Step] to set the next Euler vector in a numerical solution you have started."


    !A function  f(t,y)  is chosen from a menu at lower right.
    !
    !A toggle permits the display of the corresponding direction field in the main window. 
    ! The stepsize is chosen by means of buttons, and the corresponding Euler polygons are displayed in corresponding colors. 
    !It is also possible to cause all these stepsizes to be used simultaneously, or the "actual" solution curve (computed in fact using RK4).
    !
    !The initial condition is selected by clicking on the main window. A click sets the value of (t_0,y_0) and leaves a white diamond on the screen. The polygon is begun by clicking the "Start" button, and continued by clicking the "Next step" button. If "All Euler" has been selected, then "Start" will cause all four forward time Euler polygons to appear. The screen may be cleared of graphics, leaving only the currently active initial value, by means of the "Clear" button.
    !
    !Rolling the cursor over the main window causes the display of a direction vector  i + f(t,y) j  at position  (t,y),  and the coordinates  (t,y) and the value of  f(t,y)  are read out at upper right.
    !
    !To the left is a column of values of  (t,y) , starting with the selected initial condition and continuing with the verticies of the Euler polygon.

    ! --- palette ---

    LET b0= 0
    LET b1= 0.2
    LET b2= 0.4
    LET b3= 0.6
    LET b4= 0.8
    LET b5= 1

    SET COLOR MIX(27)  b2,b3,b5                  ! blue

    ! --- axis choices ---

    IF SLUmode=1 then
       LET xax$= "t"
       LET yax$= "x"
    ELSE
       LET xax$= "t"
       LET yax$= "y"
    END IF

    ! --- utility functions ---

    DECLARE DEF clamp,roundn,e
    DEF SetColor(n)= red + n

    ! --- Functions ---

    !    DATA "2y + 1","1"                            !  t 0-2  y 0-60
    !    DATA "t - y^[2]","1"                         !  t 0-1  y 0- 1
    !    DATA "y^[2] - 2y + 1","1"                    !  t 0-2  y 0-30
    !    DATA "sin(y)","1"                            !  t 0-1  y 0- 1
    !
    !    DATA "y","1"
    !    DATA "sin(t)","1"
    !    DATA "y sin(t)","1"
    !    DATA "y - t","1"
    !    DATA "y^[2] - t","1"
    !    DATA "-ty","1"

    DEF dydt1(t,x)  = 2*x + 1                    ! unstable node
    DEF dxdt1(t,x)  = 1
    DEF dydt2(t,x)  = t - x*x                    ! unstable node
    DEF dxdt2(t,x)  = 1
    DEF dydt3(t,x)  = x*x - 2*x + 1              ! unstable node
    DEF dxdt3(t,x)  = 1
    DEF dydt4(t,x)  = sin(x)                     ! unstable node
    DEF dxdt4(t,x)  = 1
    DEF dydt5(t,x)  = x                          ! unstable node
    DEF dxdt5(t,x)  = 1

    DEF dydt6(t,x)  = sin(t)                     ! unstable improper node
    DEF dxdt6(t,x)  = 1
    DEF dydt7(t,x)  = x*sin(t)                   ! unstable improper node
    DEF dxdt7(t,x)  = 1
    DEF dydt8(t,x)  = x-t                        ! stable star
    DEF dxdt8(t,x)  = 1
    DEF dydt9(t,x)  = x*x - t                    ! saddle
    DEF dxdt9(t,x)  = 1
    DEF dydt10(t,x) = -t*x                       ! unstable node
    DEF dxdt10(t,x) = 1

    SUB FetchEq(eq,x,y,dx,dy)
        SELECT CASE eq
        CASE 1
             LET dx= dxdt1(x,y)
             LET dy= dydt1(x,y)
        CASE 2
             LET dx= dxdt2(x,y)
             LET dy= dydt2(x,y)
        CASE 3
             LET dx= dxdt3(x,y)
             LET dy= dydt3(x,y)
        CASE 4
             LET dx= dxdt4(x,y)
             LET dy= dydt4(x,y)
        CASE 5
             LET dx= dxdt5(x,y)
             LET dy= dydt5(x,y)
        CASE 6
             LET dx= dxdt6(x,y)
             LET dy= dydt6(x,y)
        CASE 7
             LET dx= dxdt7(x,y)
             LET dy= dydt7(x,y)
        CASE 8
             LET dx= dxdt8(x,y)
             LET dy= dydt8(x,y)
        CASE 9
             LET dx= dxdt9(x,y)
             LET dy= dydt9(x,y)
        CASE 10
             LET dx= dxdt10(x,y)
             LET dy= dydt10(x,y)
        END SELECT
    END SUB


    ! Graphing window

    ! --- 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 w1Lft = workLft+200                      ! pixel bounds
    LET w1Rgt = w1Lft + 400
    LET w1Top = workTop+ 30
    LET w1Bas = w1Top + 300

    LET w1fLft= -4                               ! function bounds
    LET w1fRgt=  4
    LET w1fTop=  3
    LET w1fBas= -3

    LET w1Xax$= xax$                             ! axis labels
    LET w1Yax$= yax$

    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= 1
    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,w1fWithin

    SUB w1SetBounds(eq)
        SELECT CASE eq
        CASE 1
             LET w1fLft  =  0
             LET w1fRgt  =  2
             LET w1fBas  =  0
             LET w1fTop  = 60
             LET w1xSTik =  0.5                  ! horizontal axis Tik marks
             LET w1xLTik =  1
             LET w1xLabel=  1
             LET w1ySTik =  0                    ! vertical axis Tik marks
             LET w1yLTik =  5
             LET w1yLabel=  5
        CASE 2
             LET w1fLft  =  0
             LET w1fRgt  =  1
             LET w1fBas  =  0
             LET w1fTop  =  1
             LET w1xSTik =  0.1                  ! horizontal axis Tik marks
             LET w1xLTik =  0.5
             LET w1xLabel=  0.5
             LET w1ySTik =  0.1                  ! vertical axis Tik marks
             LET w1yLTik =  0.5
             LET w1yLabel=  0.5
        CASE 3
             LET w1fLft  =  0
             LET w1fRgt  =  2
             LET w1fBas  =  0
             LET w1fTop  = 30
             LET w1xSTik =  0.5                  ! horizontal axis Tik marks
             LET w1xLTik =  1
             LET w1xLabel=  1
             LET w1ySTik =  0                    ! vertical axis Tik marks
             LET w1yLTik =  5
             LET w1yLabel=  5
        CASE 4
             LET w1fLft  =  0
             LET w1fRgt  =  6
             LET w1fBas  =  0
             LET w1fTop  =  4
             LET w1xSTik =  0.1                  ! horizontal axis Tik marks
             LET w1xLTik =  0.5
             LET w1xLabel=  0.5
             LET w1ySTik =  0.1                  ! vertical axis Tik marks
             LET w1yLTik =  0.5
             LET w1yLabel=  0.5
        CASE else
             LET w1fLft  = -4
             LET w1fRgt  =  4
             LET w1fBas  = -3
             LET w1fTop  =  3
             LET w1xSTik =  0.5                  ! horizontal axis Tik marks
             LET w1xLTik =  1
             LET w1xLabel=  1
             LET w1ySTik =  0.5                  ! vertical axis Tik marks
             LET w1yLTik =  1
             LET w1yLabel=  1
        END SELECT
        LET w1xFirst= w1fLft
        LET w1yFirst= w1fBas
        CALL w1Variables
    END SUB

    SUB w1Init
        CALL w1SetBounds(eq)
        CALL w1DrawPlane(1,1,1)                  ! x axis, y axis, zeroaxes
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextLJ(w1Rgt+8,w1y0+3,w1Xax$,axislabelclr)     ! axis labels
        CALL PlotTextCJ(w1x0,w1Top-10,w1Yax$,axislabelclr)
        CALL w1KeepGridLayer
        CALL w1KeepGraphLayer
    END SUB

    SUB w1KeepFieldLayer
        BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in w1graphLayer$
    END SUB

    SUB w1ShowFieldLayer
        BOX SHOW w1graphLayer$ at w1Lft-5,w1Bas+5
    END SUB


    ! ---------- Data Table: Orbit List ----------

    DECLARE PUBLIC tb1Lft,tb1Rgt,tb1Bas,tb1Top,tb1Form$
    DECLARE PUBLIC tb1RowCnt,tb1RowStp,tb1ColCnt,tb1ColStp,tb1Pntr
    DECLARE PUBLIC tb1(,),tb1ColLabels$(),tb1ColColors()

    LET tb1RowStp= 15
    LET tb1RowCnt= 32                            ! w1fWid*2 + 1
    LET tb1ColStp= 62
    LET tb1ColCnt=  2
    LET tb1Lft   = worklft + 20
    LET tb1Top   = w1top
    LET tb1Form$ = "---%.##"

    CALL tb1Variables

    MAT READ tb1ColLabels$
    DATA "t","y"
    MAT READ tb1ColColors
    DATA 22,22                                   ! 6,6

    SUB table1Init
        CALL tb1Init
        BOX KEEP tb1Lft,tb1Rgt,tb1Bas,tb1Top in tb1$
    END SUB

    SUB tb1Refresh
        BOX SHOW tb1$ at tb1Lft,tb1Bas
        LET tb1Pntr= 0
    END SUB

    SUB tb1Store(x,y)
        LET tb1Pntr= tb1Pntr+1
        IF tb1Pntr<=tb1RowCnt then
           LET tb1(tb1Pntr,1)= x
           LET tb1(tb1Pntr,2)= y
           CALL tb1Values(tb1,tb1Pntr)
        END IF
    END SUB


    ! ----- menu 1 - equations -----

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

    DECLARE DEF m1Within

    LET m1Prefix$ = "f(t,y) = "
    LET m1Lft     = w1Rgt - 20
    LET m1Top     = w1Bas + 50
    LET m1tClr    = white
    LET m1Equation= 1

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

    DATA "2y + 1"                                ! unstable node
    DATA "t - y^[2]"                             ! unstable node
    DATA "y^[2] - 2y + 1"                        ! unstable node
    DATA "sin(y)"                                ! unstable node
    DATA "y"                                     ! unstable node

    DATA "sin(t)"                                ! unstable improper node
    DATA "y sin(t)"                              ! unstable improper node
    DATA "y - t"                                 ! stable star
    DATA "y^[2] - t"                             ! saddle
    DATA "-ty"                                   ! unstable node

    !    DATA "x"
    !    DATA "cos(t)"
    !    DATA "cos(x)"
    !    DATA "x cos(t)"
    !    DATA "cos(tx)"
    !    DATA "x + t"
    !    DATA "x - t"
    !    DATA "x^[2] - t"
    !    DATA "x^[2] - t^[2]"
    !    DATA "x^[2] + t^[2]"

    !The useful examples in my mind are:
    ! x-dot = x,
    ! x-dot = -tx,
    ! x-dot = y^2-t,
    ! x-dot = t,
    ! x-dot = x(1-x),
    ! x-dot = -t/x,
    ! x-dot = t/x,  and
    ! x-dot = x^2 -1.

    !    DIM SLUnames$(1:10,0:1)
    !    MAT READ SLUnames$
    !    DATA "x","1"
    !    DATA "cos(t)","1"
    !    DATA "cos(x)","1"
    !    DATA "x cos(t)","1"
    !    DATA "cos(tx)","1"
    !    DATA "x + t","1"
    !    DATA "x - t","1"
    !    DATA "x^[2] - t","1"
    !    DATA "x^[2] - t^[2]","1"
    !    DATA "x^[2] + t^[2]","1"
    !    !    DATA "cos(x^[2]+t^[2])","1"
    !    !    DATA "-tx","1"


    ! --- checkbox - slopefield switch ---

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

    LET cb1Lft = w1Lft + 120
    LET cb1Bas = w1Bas +  42
    LET cb1Txt$= "Slope Field"
    LET cb1Clr = litgry

    CALL cb1Variables


    ! --- radio check boxes ---
    ! --- r1 - select method and time step ---

    DECLARE PUBLIC r1cnt, r1stp, r1siz
    DECLARE PUBLIC r1Lft, r1Rgt, r1Bas, r1Top, r1Name$, r1NameClr
    DECLARE PUBLIC r1NameList$(),r1ColorList()

    DECLARE DEF r1Within

    LET r1cnt=  6                                ! box count
    LET r1stp= 18                                ! box interval
    LET r1siz= 12                                ! box size
    LET r1top= w1Bas + 85
    LET r1bas= r1top + (r1cnt-1)*r1stp + r1siz
    LET r1lft= cb1Lft
    LET r1rgt= r1lft + r1siz

    LET r1Name$  = "Method and Step"
    LET r1NameClr= litgry

    MAT redim r1NameList$(1:r1cnt)
    DATA "Euler: 1.00","Euler: 0.50","Euler: 0.25"
    DATA "Euler: 0.125","Actual","All Euler"
    MAT READ r1NameList$

    MAT redim r1ColorList(1:r1cnt)
    DATA 23,24,25,26,27,21                       ! 7,8,9,10,11,6
    MAT READ r1ColorList

    DIM Tstep(1:6)
    MAT READ Tstep
    LET RK4Pntr= 5
    DATA 1,.5,.25,.125,.03125,.5

    SUB r1Init
        CALL r1DrawCheckBoxes
        CALL r1SetCheckBox(r1num)
    END SUB

    SUB ResetTstep(r1num)
        LET trajclr = r1ColorList(r1num)         !(tbtn-1)+red
        IF r1num<5 then
           LET dt,tstp = Tstep(r1num)
           LET solState= 0
        ELSE IF r1num= 5 then
           LET solState= 1
        ELSE
           LET solState= 2
           LET trajclr = blue
        END IF
        LET tb1ColColors(1)= trajclr
        LET tb1ColColors(2)= trajclr
    END SUB


    ! ----- text Boxes -----
    ! --- initial values ---

    LET inpSize  = 90
    LET inpHgt   = 18
    LET inpShift =  6
    LET inpChrSpc=  9

    LET t0Lft= w1Rgt +  55                       ! m1Lft - inpSize - 25
    LET t0Top= w1Top + 100                       ! m1Top + 25
    LET t0Rgt= t0Lft + inpSize
    LET t0Bas= t0Top + inpHgt
    LET inpt0Func$= xax$ & "_[0] = "

    LET x0Lft= t0Lft
    LET x0Top= t0Bas + 1
    LET x0Rgt= x0Lft + inpSize
    LET x0Bas= x0Top + inpHgt
    LET inpX0Func$= yax$ & "_[0] = "

    LET inpclr= litgry
    LET ivEqx = t0Lft + 27

    SUB KeyInputInit(t0,x0)
        CALL SetTextFont(1,12,"bold")
        CALL SuperSubScriptRJ(ivEqx,x0Bas-inpShift,inpX0Func$,inpClr)
        LET n$= trim$(using$("--%.##",x0))
        CALL MonoStringN(ivEqx+5,x0Bas-inpShift,inpChrSpc,n$,inpClr)

        CALL SuperSubScriptRJ(ivEqx,t0Bas-inpShift,inpt0Func$,inpClr)
        LET n$= trim$(using$("--%.##",t0))
        CALL MonoStringN(ivEqx+5,t0Bas-inpShift,inpChrSpc,n$,inpClr)
    END SUB

    SUB SetInitialValues(x,y)
        CALL SetTextFont(1,12,"bold")
        LET n$= trim$(using$("--%.##",y))
        BOX CLEAR ivEqx+1,x0Rgt-1,x0Bas-1,x0Top+1
        CALL MonoStringN(ivEqx+5,x0Bas-inpShift,inpChrSpc,n$,inpClr)

        CALL FormatNum(x,n$)
        LET n$= trim$(using$("--%.##",x))
        BOX CLEAR ivEqx+1,t0Rgt-1,t0Bas-1,t0Top+1
        CALL MonoStringN(ivEqx+5,t0Bas-inpShift,inpChrSpc,n$,inpClr)
    END SUB

    ! --- Real Time text display of Mouse Coords ---

    LET mcLnspc = 14
    LET mcLft   = t0Lft
    LET mcRgt   = mcLft + 80
    LET mcTop   = w1Top
    LET mcBas   = mcTop + 6*mcLnspc
    LET mcEqx   = mcLft + 27
    LET mcDotx  = mcLft + 55
    LET mcBasln1= mcTop + 1*mcLnspc
    LET mcBasln2= mcTop + 2*mcLnspc
    LET mcBasln3= mcTop + 4*mcLnspc
    LET mcClr   = litgry

    SUB MouseCoordClear
        BOX CLEAR mcEqx,mcRgt,mcBas,mcTop+5
    END SUB

    SUB MouseCoordInit(x,y)
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextRJ(mcEqx,mcBasln1,xax$ & " = ",litgry)
        CALL PlotTextRJ(mcEqx,mcBasln2,yax$ & " = ",litgry)

        CALL StringWidth(" = ",sw)
        CALL PlotTextRJ(mcEqx,mcBasln3," = ",litgry)
        LET txtx= mcEqx - sw
        !        CALL StringWidth("dy/dt",sw)
        !        CALL SwapDelta(txtx-sw,mcBasln3,"dy/dt","d",litgry)
        CALL StringWidth("f(t,y)",sw)
        CALL PlotTextLJ(txtx-sw,mcBasln3,"f(t,y)",litgry)
        CALL MouseCoordValues(x,y,dx,dy,dt)
    END SUB

    SUB MouseCoordValues(x,y,dx,dy,dt)
        CALL SetTextFont(1,12,"bold")
        LET f$= "---%.##"
        CALL MouseCoordClear
        CALL AlignDot(mcDotx,mcBasln1,using$(f$,x ),litgry)
        CALL AlignDot(mcDotx,mcBasln2,using$(f$,y ),litgry)
        CALL AlignDot(mcDotx,mcBasln3,using$(f$,dy),litgry)
    END SUB

    SUB Delta(dwx,dwy,dclr)
        SET COLOR dclr
        PLOT dwx,dwy; dwx+3,dwy-6; dwx+6,dwy; dwx,dwy
    END SUB

    SUB SwapDelta(dx,dy,d$,ch$,dclr)
        LET l= len(d$)
        FOR i= 1 to l
            LET char$= d$(i:i)
            IF char$ = ch$ then
               CALL Delta(dx,dy,dclr)
               LET sw= 7
            ELSE
               CALL PlotTextLJ(dx,dy,char$,dclr)
               CALL StringWidth(char$,sw)
            END IF
            LET dx= dx+sw
        NEXT i
    END SUB

    ! ---- other buttons ----

    LET btnwid= 78
    LET btnhgt= 19

    LET clft = w1Lft                             ! clear
    LET crgt = clft  + btnwid
    LET ctop = w1Bas + 25
    LET cbas = ctop  + btnhgt

    LET ivLft= clft                              ! start
    LET ivRgt= ivLft + btnwid
    LET ivTop= cbas + 2
    LET ivBas= ivTop + btnhgt

    LET itLft= clft                              ! iterate 
    LET itRgt= itLft + btnwid
    LET itTop= ivBas + 2
    LET itBas= itTop + btnhgt

    SUB Buttons
        CALL SetTextFont(1,12,"bold")
        CALL DrawButton(clft,crgt,cbas,ctop,5,"Clear")
        CALL DrawButton(ivLft,ivRgt,ivBas,ivTop,5,"Start")
    END SUB

    SUB StepButton
        CALL DrawButton(ivLft,ivRgt,ivBas,ivTop,5,"Next Step")
        LET stepFlag = 1
    END SUB

    SUB StepButtonClear
        CALL DrawButton(ivLft,ivRgt,ivBas,ivTop,5,"Start")
        LET stepFlag = 0
    END SUB


    ! ------ init ------

    LET fieldclr     = drkmid
    LET solState     = 0
    LET cb1State     = 1
    LET fieldState   = 1
    LET m1State      = 0
    LET t1Flag       = 1
    LET eq           = 1
    LET r1num        = 1
    LET initmx,initmy= 0
    LET headmx,headmy= 0
    LET t0,x0,x,y    = 0
    LET stepFlag     = 0

    CALL InitScreen
    CALL m1InitMenu1
    CALL SetTimer

    SUB InitScreen
        BOX CLEAR worklft,workrgt,workbas,worktop
        CALL w1Init
        CALL Buttons
        CALL m1ResetMenu(m1State)
        CALL table1Init
        CALL ResetTstep(r1num)
        CALL MouseCoordInit(t0,x0)
        CALL SlopeField
        CALL r1Init
        CALL KeyInputInit(t0,x0)
        CALL cb1Init
        CALL PlotDiamondClr(w1Wndx(t0),w1Wndy(x0),white)
        CALL w1KeepGraphLayer
    END SUB

    ! ---- event manager ----

    DO
       LET clearFlag= 0
       IF ms<>2 then
          LET trajclr= r1ColorList(r1num)
          LET dt,tstp= Tstep(r1num)
          DO
             GET MOUSE: mx,my,ms
             IF w1Within(mx,my)=true then
                CALL w1wClamp(mx,my)
                IF mx<>oldx or my<>oldy then
                   CALL w1RollOver
                END IF
             ELSE
                IF clearFlag=1 then
                   CALL w1ShowGraphLayer
                   CALL MouseCoordClear
                   LET  clearFlag= 0
                END IF
             END IF
          LOOP until ms=2
       END IF
       IF clearFlag=1 then
          CALL w1ShowGraphLayer
          LET  clearFlag= 0
       END IF

       IF w1Within(mx,my)=true then              ! set initial values
          CALL MouseUp(mx,my,ms)
          CALL w1MouseClick
          CALL w1KeepGraphLayer

       ELSE IF mx>clft and mx<crgt and my>ctop and my<cbas then      ! clear
          CALL MouseButtonUp(clft,crgt,cbas,ctop,ms)
          CALL SlopeField

          CALL tb1Refresh
          CALL tb1Store(t0,x0)
          CALL CopyCoords(t0,x0,x,y)

          CALL StepButtonClear

          CALL w1MathToPixels(x,y,wx,wy)
          CALL PlotDiamondClr(wx,wy,white)
          CALL w1KeepGraphLayer

       ELSE IF mx>ivLft and mx<ivRgt and my>ivTop and my<ivBas then  ! start and step
          CALL MouseButtonUp(ivLft,ivRgt,ivBas,ivTop,ms)
          IF stepFlag=0 then
             CALL tb1Refresh
             CALL tb1Store(t0,x0)
             CALL CopyCoords(t0,x0,x,y)

             CALL w1MathToPixels(x,y,wx,wy)
             CALL PlotDiamondClr(wx,wy,white)
             CALL FetchEq(eq,x,y,dx,dy)

             IF solstate=0 then                  ! Euler - one at a time
                CALL StepButton
                CALL SolutionVector(x,y)
                CALL tb1Store(x,y)
             ELSE IF solstate=1 then             ! RK4 to plane edge
                CALL Trajectory(method,x,y,tstp,blue)
             ELSE IF solstate=2 then             ! compare
                FOR method= 1 to 4               ! RK4Pntr
                    CALL Trajectory(method,t0,x0,tstp,trajclr)
                NEXT method
             END IF
          ELSE
             IF solstate=0 then                  ! Euler - one at a time
                CALL SetVector(x,y,x2,y2,tstp)
                CALL CopyCoords(x2,y2,x,y)
                IF head=1 then CALL tb1Store(x,y)     ! head on plane?
             END IF
          END IF
          CALL w1KeepGraphLayer

       ELSE IF cb1Within(mx,my)=true then        ! slopefield
          CALL cb1MouseUp(ms)
          LET fieldState= cb1State
          CALL SlopeField

       ELSE IF r1Within(mx,my)=true then         ! choose method
          CALL MouseUp(mx,my,ms)
          LET r1num = int((my-r1top)/r1stp)+1
          CALL r1SetCheckBox(r1num)
          LET method= r1num
          CALL ResetTstep(method)

          CALL tb1Refresh
          CALL tb1Store(t0,x0)
          CALL StepButtonClear
          CALL CopyCoords(t0,x0,x,y)
          CALL w1MathToPixels(x,y,wx,wy)
          CALL PlotDiamondClr(wx,wy,white)

       ELSE IF m1Within(mx,my)=true then         ! read menu
          CALL m1ButtonUp(ms)
          CALL m1ReadMenu
          LET eq= m1Equation
          CALL w1Init
          LET t0= 0
          LET x0= 0
          CALL tb1Refresh
          CALL StepButtonClear

          CALL SlopeField

          CALL CopyCoords(t0,x0,x,y)
          CALL w1MathToPixels(x,y,wx,wy)
          CALL PlotDiamondClr(wx,wy,white)
          CALL w1KeepGraphLayer

       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


    ! --- Mouse Events ---

    SUB w1RollOver
        CALL w1ShowGraphLayer
        CALL SetVars(mx,my,oldx,oldy)
        CALL w1PixelsToMath(mx,my,x1,y1)
        CALL MouseCoordValues(x1,y1,dx,dy,dt)
        CALL SetVector(x1,y1,x2,y2,1)
        LET  clearFlag= 1
    END SUB

    SUB w1MouseClick
        CALL w1wClamp(mx,my)
        SELECT CASE solState
        CASE 0                                   ! Euler vectors
             CALL Pythagoras(mx,my,initmx,initmy,td)
             CALL Pythagoras(mx,my,headmx,headmy,hd)
             IF hd<10 then                       ! close to head
                CALL w1PixelsToMath(headmx,headmy,x,y)
             ELSE IF td<6 then                   ! close to initial value
                CALL w1PixelsToMath(initmx,initmy,x,y)
                CALL tb1Refresh
                CALL SetInitialValues(x,y)
                CALL ResetICs
             ELSE                                ! new solution
                CALL StepButtonClear
                CALL w1PixelsToMath(mx,my,x,y)
                CALL SetVars(mx,my,initmx,initmy)
                CALL FetchEq(eq,x,y,dx,dy)
                CALL SetInitialValues(x,y)
                CALL ResetICs
             END IF
             ! CALL PlotDiamondClr(w1Wndx(x),w1Wndy(y),white)
             !             CALL SolutionVector(x,y)
             !             CALL tb1Store(x,y)
        CASE 1                                   ! RK4 solutions
             CALL Pythagoras(mx,my,initmx,initmy,td)
             IF td<6 then                        ! close to initial value
                CALL w1PixelsToMath(initmx,initmy,x,y)
                CALL SetVars(initmx,initmy,mx,my)
             ELSE                                ! new solution
                CALL w1PixelsToMath(mx,my,x,y)
                CALL SetVars(mx,my,initmx,initmy)
                CALL FetchEq(eq,x,y,dx,dy)
             END IF
             CALL SetInitialValues(x,y)
             CALL ResetICs
             LET headmx,headmy= 0
        CASE 2                                   ! compare all
             CALL w1PixelsToMath(mx,my,x,y)
             CALL SetVars(mx,my,initmx,initmy)
             CALL SetInitialValues(t0,x0)
             CALL ResetICs
        CASE else

        END SELECT
    END SUB

    SUB ResetICs
        CALL tb1Refresh
        CALL PlotDiamondClr(w1Wndx(t0),w1Wndy(x0),drkmid)
        CALL SetVars(x,y,t0,x0)
        CALL tb1Store(x,y)
        CALL PlotDiamondClr(w1Wndx(t0),w1Wndy(x0),white)
    END SUB

    ! ---- Euler Vectors ----

    SUB DrawVector(wx1,wy1,wx2,wy2,dx,dy,head,trajclr)
        CALL PlotLine(wx1,wy1,wx2,wy2,trajclr)
        IF head=1 and (dx<>0 or dy<>0) then
           LET ang= angle(dx*w1aspect,-dy)
           DRAW VectPnt with rotate(ang)*shift(wx2,wy2)
        END IF
    END SUB

    SUB SolutionVector(x1,y1)
        CALL SetVector(x1,y1,x2,y2,dt)
        CALL SetVars(wx2,wy2,headmx,headmy)
        CALL CopyCoords(x2,y2,x,y)
    END SUB

    SUB SetVector(x1,y1,x2,y2,tmstp)
        CALL FetchEq(eq,x1,y1,dx,dy)
        LET x2= x1 + dx*tmstp
        LET y2= y1 + dy*tmstp
        CALL CopyCoords(x1,y1,xa,ya)
        CALL CopyCoords(x2,y2,xb,yb)

        IF w1fWithin(x2,y2)=1 and w1fWithin(x2,y2)=1 then
           LET head= 1
        ELSE
           LET head= 0
           CALL Clip(w1fLft,w1fRgt,w1fBas,w1fTop,xa,ya,xb,yb)   ! (x1,y1) is within
        END IF

        IF w1fWithin(xa,ya)=1 and w1fWithin(xa,ya)=1 then
           CALL w1MathToPixels(xa,ya,wx1,wy1)
           CALL w1MathToPixels(xb,yb,wx2,wy2)
           CALL DrawVector(wx1,wy1,wx2,wy2,dx,dy,head,trajclr)
        END IF
        ! CALL CopyCoords(x2,y2,x1,y1)
    END SUB

    ! ---- RK4 and Euler Trajectories ----

    SUB Trajectory(method,x0,y0,tstp,clr)
        LOCAL x,y,oldx,oldy,wx,wy,oldwx,oldwy,wx2,wy2,dx,dy
        LET trajclr= r1ColorList(method)
        SET COLOR trajclr
        CALL SetVars(x0,y0,x,y)
        CALL w1MathToPixels(x,y,wx,wy)
        PLOT wx,wy;
        LET tstp= Tstep(method)

        FOR i= 0 to 5000                         ! draw trajectory
            CALL SetVars(x,y,oldx,oldy)
            CALL SetVars(wx,wy,oldwx,oldwy)

            IF method= RK4Pntr then
               IF mod(i,2)=0 and i>0 then        ! text for alternate steps
                  CALL tb1Store(oldx,y)
               END IF
               CALL RungeKutta4(x,y,dx,dy,tstp)
            ELSE
               CALL Euler(x,y,dx,dy,tstp)
            END IF

            CALL w1MathToPixels(x,y,wx,wy)
            IF w1wWithin(wx,wy)=1 then
               IF w1wWithin(oldwx,oldwy)=1 then
                  PLOT wx,wy;
               ELSE                              ! old is out
                  CALL Clip(w1fLft,w1fRgt,w1fBas,w1fTop,x,y,oldx,oldy)
                  CALL w1MathToPixels(oldx,oldy,wx2,wy2)
                  PLOT wx2,wy2; wx,wy;
               END IF
            ELSE                                 ! new is out
               IF w1wWithin(oldwx,oldwy)=1 then
                  CALL Clip(w1fLft,w1fRgt,w1fBas,w1fTop,oldx,oldy,x,y)
                  CALL w1MathToPixels(x,y,wx,wy)
                  PLOT wx,wy
               ELSE                              ! old is out
                  PLOT
               END IF
            END IF

            GET MOUSE: xx,yy,ms
            LET eps= .0005
            IF (abs(dx)<eps and abs(dy)<eps) or abs(x)>=w1fRgt or abs(y)>=w1fTop or ms=2 then
               EXIT FOR
            END IF
            CALL Delay(1/64)
        NEXT i
        PLOT
    END SUB

    SUB Euler(x,y,dx,dy,tstp)
        CALL FetchEq(eq,x,y,dx,dy)
        LET x= x + dx*tstp
        LET y= y + dy*tstp
    END SUB

    SUB RungeKutta4(x,y,dx,dy,tstp)
        LOCAL dx1,dy1,dx2,dy2,dx3,dy3,dx4,dy4
        LOCAL x1,y1,x2,y2,x3,y3,hstp
        LET hstp= tstp/2

        CALL FetchEq(eq,x,y,dx,dy)
        LET dx1= dx
        LET dy1= dy
        LET x1 = x + dx1*hstp
        LET y1 = y + dy1*hstp

        CALL FetchEq(eq,x1,y1,dx,dy)
        LET dx2= dx
        LET dy2= dy
        LET x2 = x + dx2*hstp
        LET y2 = y + dy2*hstp

        CALL FetchEq(eq,x2,y2,dx,dy)
        LET dx3= dx
        LET dy3= dy
        LET x3 = x + dx3*tstp
        LET y3 = y + dy3*tstp

        CALL FetchEq(eq,x3,y3,dx,dy)
        LET dx4= dx
        LET dy4= dy

        LET dy = (dy1 + 2*(dy2 + dy3) + dy4) / 6
        LET dx = (dx1 + 2*(dx2 + dx3) + dx4) / 6
        LET y  = y + tstp*dy
        LET x  = x + tstp                        !*dx
    END SUB


    ! --- slope field ---

    SUB SlopeField
        LOCAL wx,wy,x,y,dx,dy,length,ang,ca,sa,wx1,wy1,wx2,wy2
        LET length= 4                            ! length of slope mark
        CALL SetVars(20,20,xstp,ystp)
        CALL SetVars(xstp/2,ystp/2,hxstp,hystp)
        CALL w1ShowGridLayer

        IF fieldState=1 then
           SET COLOR fieldclr                    ! vector field
           FOR wy= w1top+hystp to w1bas-hystp step ystp
               FOR wx= w1Lft+hxstp to w1Rgt-hxstp step xstp
                   CALL w1PixelsToMath(wx,wy,x,y)
                   IF round(y,2)<>0 then
                      CALL FetchEq(eq,x,y,dx,dy)
                      LET ang= angle(dx*w1aspect,-dy)
                      CALL PolarToCartesian(length,ang,ca,sa)
                      LET wx1= wx+ca
                      LET wy1= wy+sa
                      LET wx2= wx-ca
                      LET wy2= wy-sa
                      PLOT wx1,wy1; wx2,wy2
                   END IF
               NEXT wx
           NEXT wy
           CALL w1KeepGraphLayer
        ELSE
           CALL w1KeepGraphLayer
        END IF
    END SUB
END SUB

! ----- end of Eulers method code -----