! Parametric-Cycloid

!! September 12, 2003 Hubert Hohn for David Jerison

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
DECLARE PUBLIC qlft,qrgt,qbas,qtop

LET toolHgt= 440
LET toolWid= 920
LET window$= "D'Arbeloff Interactive Math Project"
LET colorscheme= 0

LET title$ = "Parametric Equations: Cycloid Curves"

SUB ThisProgram
    CALL Cycloid
    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 Cycloid
    DECLARE PUBLIC PCFlag,M68kFlag,Mac5Flag,UnixFlag,SLUmode,xmax,ymax
    DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx     ! work area
    DECLARE PUBLIC qLft,qRgt,qBas,qTop
    DECLARE PUBLIC infLft,infRgt,infBas,infTop
    DECLARE PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white
    DECLARE PUBLIC red,yellow,green,cyan,blue,magenta,colorscheme
    DECLARE PUBLIC planeclr,gridclr,rimclr,axisclr,axislabelclr,titleclr,rightsclr
    DECLARE PUBLIC numberlineclr,slotdrkclr,slotlgtclr,slideclr,headerclr,btnclr

    DECLARE DEF InfoWithin,QuitWithin

    ! --- help screen array ---

    DIM  info$(1:9)
    MAT READ info$

    DATA "Cycloid Curves"
    DATA ""
    DATA "You can move the circle by dragging the mouse on the xy graph plane."
    DATA ""
    DATA "Click or drag the  a  slider to set the distance of the yellow point from the center of the circle."
    DATA ""
    DATA "Click the [Reset] button to clear the plane and move the circle center to (0,1)."
    DATA "Click the [Roll] button to roll the circle."
    DATA "Click the [Trace] button to roll the circle and draw the cycloid curve."

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

    DECLARE DEF clamp,roundn
    DECLARE PUBLIC true,false

    ! ---- Trochoid Functions ----

    !    U. North Dakota - works if b is expansion or contraction of r
    !    DEF fxt(r,b,theta)= r*(theta - b*sin(theta))
    !    DEF fyt(r,b,theta)= r*(1 - b*cos(theta))

    !    Mathematica - mathworld.wolfram.com - b is an independent parameter

    DEF fxt(r,b,theta)= r*theta - b*sin(theta)   ! trochoid points
    DEF fyt(r,b,theta)= r - b*cos(theta)

    DEF dst(theta,r)= theta*r                    ! convert rotation angle to horizontal distance
    DEF ang(xc,r)   = xc/r                       ! convert horizontal distance to rotation angle

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

    ! --- 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 w1Top = workTop+40                       ! window bounds
    LET w1Bas = w1Top+200
    LET w1Lft = workLft+55
    LET w1Rgt = w1Lft+800

    LET w1fTop=  3                               ! window bounds
    LET w1fBas= -1
    LET w1fLft= -2
    LET w1fRgt= 14

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

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

    CALL w1Variables

    SUB w1Init
        CALL w1DrawPlane(1,1,1)                  ! grid, axes, zeroaxes
        CALL SetTextFont(1,12,"bold")

        SET COLOR 19                             ! pi grid
        FOR i= 0 to 4 step 1
            PLOT w1Wndx(i*pi),w1Bas-1; w1Wndx(i*pi),w1Top+1
        NEXT i
        PLOT w1Lft+1,w1y0; w1Rgt-1,w1y0

        CALL PlotTextLJ(w1Rgt+8,w1y0+3,w1Xax$,axislabelclr)     ! axis labels
        CALL PlotTextCJ(w1x0,w1Top-11,w1Yax$,axislabelclr)
        CALL w1KeepGridLayer
        CALL w1KeepGraphLayer
    END SUB

    SUB w1KeepGridLayer
        BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in w1gridLayer$
    END SUB

    SUB w1ShowGridLayer
        BOX SHOW w1gridLayer$ at w1Lft-5,w1Bas+5
    END SUB

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

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


    ! ----------- horizontal sliders ------------

    ! --- horizontal slider 1 ---

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

    LET h1PiAxis= 0
    LET h1Mult  = 1

    LET h1clr  = cyan
    LET h1name$= "a"
    LET h1form$= "-%.##"

    LET h1axis = w1Bas + 90
    LET h1wLft = w1Lft
    LET h1wRgt = h1wLft + 100

    LET h1fLft = 0.5
    LET h1fRgt = 1.5

    LET h1STik = 0.25                            ! short tick marks
    LET h1LTik = 0.50                            ! long tick marks
    LET h1Label= 0.5                             ! labels
    LET h1First= 0.5                             ! first tick mark
    LET h1Click= 0.25                            ! click steps

    DECLARE DEF h1Fncx                           ! window/function transforms
    DECLARE DEF h1Within, h1fWithin

    CALL h1SliderVariables

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


    ! --- horizontal slider 2 ---

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

    LET h2PiAxis= 1
    LET h2Mult  = pi

    LET h2clr  = slideclr
    LET h2name$= ""                              ! will be theta
    LET h2form$= "--%.##"

    LET h2axis = h1axis
    LET h2wLft = h1wRgt + 100
    LET h2wRgt = h2wLft + 150

    LET h2fLft = 0
    LET h2fRgt = 6

    LET h2STik = 0.5                             ! short tick marks
    LET h2LTik = 1                               ! long tick marks
    LET h2Label= 1                               ! labels
    LET h2First= h2fLft                          ! first tick mark
    LET h2Click= 0.5*pi                          ! click steps

    DECLARE DEF h2Fncx                           ! window/function transforms
    DECLARE DEF h2wWithin,h2sWithin,h2fWithin

    CALL h2SliderVariables

    SUB h2Init
        CALL h2DrawSlider(h2name$,theta)
        CALL DrawTheta12(h2wLft-14,h2wBas-2,h2clr)
    END SUB


    ! --- horizontal slider 3 ---

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

    LET h3PiAxis= 0
    LET h3Mult  = 1

    LET h3clr  = slideclr
    LET h3name$= "a"
    LET h3form$= "--%.##"

    LET h3axis = w1Bas+40
    LET h3wLft = w1wLft
    LET h3wRgt = h3wLft + 150
    LET h3fLft = 0.5
    LET h3fRgt = 2

    LET h3STik = 0.25                            ! short tick marks
    LET h3LTik = 0.5                             ! long tick marks
    LET h3Label= 0.5                             ! labels
    LET h3First= h3fLft                          ! first tick mark
    LET h3Click= 0.25                            ! click steps

    DECLARE DEF h3Fncx                           ! window/function transforms
    DECLARE DEF h3wWithin,h3sWithin,h3fWithin

    CALL h3SliderVariables

    SUB h3Init
        CALL h3DrawSlider(h3name$,r)
    END SUB


    ! --- Text Output Rects ----------
    ! --- text rectangle 1 ---

    LET t1BasLn = w1Bas +  40
    LET t1Lft   = w1Rgt - 125
    LET t1Rgt   = t1Lft + 130
    LET t1Bas   = t1BasLn +  5
    LET t1Top   = t1BasLn - 15
    LET t1Label$= ""

    SUB t1Label
        CALL SuperSubScriptRJ(t1Lft,t1BasLn,t1Label$,troClr)
    END SUB

    SUB t1Set
        CALL SetTextFont(1,12,"bold")
        CALL t1Clear
        LET txt$ = "x = t - a sin(t)"
        CALL SwapTheta(t1Lft,t1BasLn,txt$,"t",troClr)
    END SUB

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

    SUB t1Init
        CALL t1Label
        CALL t1Set
    END SUB


    ! --- text rectangle 2 ---

    LET t2BasLn = t1BasLn + 20
    LET t2Lft   = t1Lft
    LET t2Rgt   = t1Rgt
    LET t2Bas   = t2BasLn +  5
    LET t2Top   = t2BasLn - 15
    LET t2Label$= ""

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

    SUB t2Set
        CALL t2Clear
        CALL SetTextFont(1,12,"bold")
        LET txt$ = "y = 1 - a cos(t)"
        CALL SwapTheta(t2Lft,t2BasLn,txt$,"t",troClr)
    END SUB

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

    SUB t2Init
        CALL t2Label
        CALL t2Set
    END SUB


    ! --- text rectangle 3 ---

    LET t3BasLn = w1Bas +  40
    LET t3Lft   = w1Lft
    LET t3Rgt   = t3Lft + 150
    LET t3Bas   = t3BasLn +  5
    LET t3Top   = t3BasLn - 15
    LET t3Label$= ""

    SUB t3Label
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextRJ(t3Lft,t3BasLn,t3Label$,white)
    END SUB

    SUB t3Set
        CALL t3Clear
        CALL SetTextFont(1,12,"bold")
        IF b>r then
           LET txt$= "Prolate Cycloid"
        ELSE IF b<r then
           LET txt$= "Curtate Cycloid"
        ELSE
           LET txt$= "Cycloid"
        END IF
        CALL PlotTextLJ(t3Lft,t3BasLn,txt$,troClr)
    END SUB

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

    SUB t3Init
        !CALL t3Label
        CALL t3Set
    END SUB


    ! --- text rectangle 4 ---

    LET t4BasLn = w1Bas + 40
    LET t4Lft   = h2wLft + 20
    LET t4Rgt   = t4Lft + 100
    LET t4Bas   = t4BasLn +  5
    LET t4Top   = t4BasLn - 15
    LET t4Label$= "x ="

    SUB t4Label
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextRJ(t4Lft,t4BasLn,t4Label$,circlr)
    END SUB

    SUB t4Set
        CALL t4Clear
        CALL SetTextFont(1,12,"bold")
        LET txt$ = trim$(using$("--%.##",xc))
        CALL PlotTextRJ(t4Lft+45,t4BasLn,txt$,circlr)
    END SUB

    SUB t4Clear
        BOX CLEAR t4Lft-2,t4Rgt,t4Bas,t4Top
    END SUB

    SUB t4Init
        CALL t4Label
        CALL t4Set
    END SUB


    ! --- text rectangle 5 ---

    LET t5BasLn = t4BasLn + 20
    LET t5Lft   = t4Lft
    LET t5Rgt   = t4Rgt
    LET t5Bas   = t5BasLn +  5
    LET t5Top   = t5BasLn - 15
    LET t5Label$= "y ="

    SUB t5Label
        CALL SetTextFont(1,12,"bold")
        CALL PlotTextRJ(t5Lft,t5BasLn,t5Label$,circlr)
    END SUB

    SUB t5Set
        CALL t5Clear
        CALL SetTextFont(1,12,"bold")
        LET txt$ = trim$(using$("--%.##",yc))
        CALL PlotTextRJ(t5Lft+45,t5BasLn,txt$,circlr)
    END SUB

    SUB t5Clear
        BOX CLEAR t5Lft-2,t5Rgt,t5Bas,t5Top
    END SUB

    SUB t5Init
        CALL t5Label
        CALL t5Set
    END SUB


    ! ---

    SUB SetCoords
        CALL t4Set
        CALL t5Set
    END SUB

    SUB ClearCoords
        CALL t4Clear
        CALL t5Clear
    END SUB


    ! --- user interface buttons ---

    LET btnhgt= 18
    LET btnwid= 50
    LET clLft = w1Lft
    LET clRgt = clLft +  btnwid
    LET clTop = h1wBas + 20
    LET clBas = clTop+btnhgt

    LET rLft  = clRgt +  2
    LET rRgt  = rLft  + btnwid
    LET rTop  = clTop
    LET rBas  = clBas

    LET trLft = rRgt  +  2
    LET trRgt = trLft + btnwid
    LET trTop = clTop
    LET trBas = clBas

    LET stLft = trRgt +  2
    LET stRgt = stLft + btnwid
    LET stTop = clTop
    LET stBas = clBas

    SUB Buttons
        CALL SetTextFont(1,12,"bold")
        CALL drawbutton(clLft,clRgt,clBas,clTop,5,"reset")
        CALL drawbutton(rLft,rRgt,rBas,rTop,5,"roll")
        CALL drawbutton(trLft,trRgt,trBas,trTop,5,"trace")
    END SUB

    SUB StopButton(StopState)
        CALL SetTextFont(1,12,"bold")
        IF StopState=1 then
           CALL drawbutton(stLft,stRgt,stBas,stTop,5,"stop")
        ELSE
           BOX CLEAR stLft,stRgt,stBas,stTop
        END IF
    END SUB


    ! --- Initialize parameters ---

    LET fmax= 4*pi

    LET troClr = yellow                          ! cycloid trace
    LET crcClr = green                           ! circle
    LET cirClr = green

    LET r    =  1                                ! radius
    LET b    =  r                                ! inside or outside circumference
    LET oldr = -9999
    LET oldb = -9999

    LET crcBas= w1y0                             ! circle Base
    LET crcTop= w1Wndy(2*r)                      ! circle Top
    LET w6pi  = round(w1Wndx(fmax)+.49999)

    ! --- Draw the screen ---

    CALL InitScreen
    CALL SetTimer

    SUB InitScreen
        BOX CLEAR workLft,workRgt,workBas,workTop
        CALL ResetVars

        CALL w1Init
        !        CALL t1Init
        !        CALL t2Init
        !        CALL t3Init
        !        CALL t4Init
        !        CALL t5Init

        CALL h1Init
        !CALL h2Init
        !CALL h3Init

        CALL SetMax
        CALL Buttons
        CALL h1Action
    END SUB


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

    DO
       !CALL SetCoords
       CALL CopyCoords(xc,yc,oldxc,oldyc)

       IF ms<>2 then                             ! mouse state down?
          CALL CopyCoords(-999,-999,oxc,oyc)
          DO
             GET MOUSE: mx,my,ms
             CALL w1RollOver
          LOOP until ms=2
          CALL w1ClearRollOver
       END IF

       IF w1wWithin(mx,my)=true then             ! drag circle in plane
          LET oldmx= 9999
          DO
             GET MOUSE: mx,my,ms
             CALL w1MouseDrag
          LOOP until ms=3

       ELSE IF h1Within(mx,my)=true then         ! radial trochoid point
          IF my<h1axis then
             CALL MouseUp(mx,my,ms)
             LET b = h1fncx(mx)
             LET b = roundn(b,h1Click)
             CALL h1Action
          ELSE
             DO
                GET MOUSE: mx,my,ms
                LET b = h1fncx(mx)
                CALL h1Action
             LOOP until ms=3
          END IF
          CALL h1h3Reset
          !       ELSE IF h2sWithin(mx,my)=true then        ! theta
          !          IF my<h2axis then
          !             CALL MouseUp(mx,my,ms)
          !             LET theta = h2Fncx(mx)
          !             LET theta = roundn(theta,h2Click)
          !             CALL h2Action
          !          ELSE
          !             DO
          !                GET MOUSE: mx,my,ms
          !                LET theta = h2Fncx(mx)
          !                CALL h2Action
          !             LOOP until ms=3
          !          END IF
          !       ELSE IF h3sWithin(mx,my)=true then        ! r
          !          IF my<h3axis then
          !             CALL MouseUp(mx,my,ms)
          !             LET r = h3Fncx(mx)
          !             LET r = roundn(r,h3Click)
          !             CALL h3Action
          !          ELSE
          !             DO
          !                GET MOUSE: mx,my,ms
          !                LET r = h3Fncx(mx)
          !                CALL h3Action
          !             LOOP until ms=3
          !          END IF
          !          CALL h1h3Reset

       ELSE IF mx>=clLft and mx<=clRgt and my>=clTop and my<=clBas then   ! reset
          CALL MouseButtonUp(clLft,clRgt,clBas,clTop,ms)
          CALL ResetVars
          CALL Position(theta)
          !CALL h2Action
       ELSE IF mx>=rLft and mx<=rRgt and my>=rTop and my<=rBas then  ! roll
          CALL MouseButtonUp(rLft,rRgt,rBas,rTop,ms)
          IF xc=maxdist then
             CALL ResetVars
             CALL Position(theta)
             !CALL h2Action
          END IF
          CALL cycle(0)
       ELSE IF mx>=trLft and mx<=trRgt and my>=trTop and my<=trBas then   ! trace
          CALL MouseButtonUp(trLft,trRgt,trBas,trTop,ms)
          IF xc=maxdist then
             CALL ResetVars
             CALL Position(theta)
             !CALL h2Action
          END IF
          CALL cycle(1)

       ELSE IF InfoWithin(mx,my,ms)=true then    ! help page
          CALL InfoButtonUp(ms)
          CALL InfoPage(Info$())
          CALL InitScreen
       ELSE IF QuitWithin(mx,my,ms)=true then    ! Quit
          CALL QuitButtonUp(ms)
          EXIT SUB
       ELSE
          CALL MouseUp(mx,my,ms)
       END IF
    LOOP

    ! ---

    SUB w1RollOver
        IF w1wWithin(mx,my)=true then            ! rollover in plane
           CALL w1PixelsToMath(mx,my,xc,yc)
           IF xc<>oxc or yc<>oyc then
              !CALL SetCoords
              CALL CopyCoords(xc,yc,oxc,oyc)
              LET clearflag= 1
           END IF
        ELSE IF clearflag=1 then
           CALL w1ClearRollOver
        END IF
    END SUB

    SUB w1ClearRollOver
        CALL CopyCoords(oldxc,oldyc,xc,yc)
        !CALL SetCoords
        LET clearflag= 0
    END SUB

    SUB w1MouseDrag
        LET mx= Clamp(mx,w1x0,w6pi)
        IF mx<>oldmx then
           LET xc   = w1Fncx(mx)
           LET xc   = min(xc,maxdist)
           LET theta= ang(xc,r)
           LET oldmx= mx
           CALL h2Action
        END IF
    END SUB

    ! ---

    SUB h1Action                                 ! b
        LET b= clamp(b,h1fLft,h1fRgt)
        LET b= round(b,2)
        IF b<>oldb then
           CALL h1mark(b)
           CALL Position(0)
           CALL t3Set
           LET oldb= b
        END IF
    END SUB

    SUB h2Action                                 ! theta
        LET theta= Clamp(theta,0,maxtheta)
        IF theta<>oldth then
           !CALL h2mark(theta)
           CALL Position(theta)
           !CALL SetCoords
           LET oldth= theta
        END IF
    END SUB

    SUB h3Action                                 ! r
        LET r= clamp(r,h1fLft,h1fRgt)
        LET r= round(r,2)
        IF r<>oldr then
           CALL h3mark(r)
           LET crcTop= w1Wndy(2*r)               ! circle Top
           CALL Position(0)
           CALL t3Set
           LET oldr= r
        END IF
    END SUB

    SUB h1h3Reset
        CALL ResetVars
        CALL SetMax
    END SUB

    ! ---

    SUB SetVars(theta)
        LET oldwxc= wxc
        LET oldwyc= wyc
        LET oldwxt= wxt
        LET oldwyt= wyt

        LET xt    = fxt(r,b,theta)               ! trochoid coords
        LET yt    = fyt(r,b,theta)
        LET xc    = dst(theta,r)

        LET wxt   = round(w1Wndx(xt))
        LET wyt   = round(w1Wndy(yt))

        LET wxc   = round(w1Wndx(xc))            ! circle center
        LET wyc   = round(w1Wndy(r))

        LET crcLft= round(w1Wndx(xc-r))          ! circle edges
        LET crcRgt= round(w1Wndx(xc+r))
    END SUB

    SUB SetMax                                   ! when r changes
        LET maxdist = fmax*r
        LET maxdist = min(maxdist,fmax)
        LET wmax    = w1Wndx(maxdist)
        LET maxtheta= min(fmax,fmax/r)
    END SUB

    SUB ResetVars
        LET theta=  0
        LET oldth= -99999
        LET xc   =  0
        LET yc   =  r
        LET oldr = -9999
        LET oldb = -9999
        !CALL h2mark(theta)
    END SUB

    SUB Position(theta)
        CALL w1ShowGridLayer
        CALL SetVars(theta)
        CALL DrawCircle
    END SUB

    SUB DrawCircle
        SET COLOR  crcClr
        BOX CIRCLE crcLft,crcRgt,crcBas,crcTop
        !BOX CIRCLE crcLft+1,crcRgt-1,crcBas-1,crcTop+1
        CALL PlotLine(wxc,wyc, wxt,wyt, cyan)
        CALL DrawDiamond(wxt,wyt)
        ! DRAW diamond5(yellow) with shift(wxt,wyt)
    END SUB

    SUB DrawDiamond(wx,wy)
        SET COLOR yellow
        PLOT wx-2,wy
        PLOT wx-1,wy+1; wx-1,wy-1
        PLOT wx  ,wy+2; wx  ,wy-2
        PLOT wx+1,wy+1; wx+1,wy-1
        PLOT wx+2,wy
    END SUB

    SUB Cycle(trace)
        CALL w1ShowGridLayer
        CALL w1KeepGraphLayer
        CALL SetVars(theta)
        CALL DrawCircle
        CALL StopButton(1)

        LET exit= 0
        IF trace=1 then                          ! trace = 1
           FOR wx= wxc to wmax+2 step 2          ! roll from current position
               LET xc   = w1Fncx(wx)
               LET theta= ang(xc,r)
               IF xc>=maxdist then
                  LET xc   = maxdist
                  LET theta= fmax
                  LET exit = 1
               END IF
               CALL SetVars(theta)
               CALL w1ShowGraphLayer
               CALL PlotLine(oldwxt,oldwyt, wxt,wyt, troClr)
               CALL w1KeepGraphLayer
               CALL DrawCircle

               GET MOUSE: mx,my,ms
               IF ms=2 or exit=1 then EXIT FOR
               CALL Delay(1/50)
           NEXT wx
        ELSE                                     ! trace = 0
           FOR wx= wxc to wmax+2 step 2          ! roll from current position
               LET xc   = w1Fncx(wx)
               LET theta= ang(xc,r)
               IF xc>=maxdist then
                  LET xc   = maxdist
                  LET theta= fmax
                  LET exit = 1
               END IF
               CALL SetVars(theta)
               CALL w1ShowGraphLayer
               CALL DrawCircle

               GET MOUSE: mx,my,ms
               IF ms=2 or exit=1 then EXIT FOR
               CALL Delay(1/50)
           NEXT wx
        END IF
        CALL StopButton(0)
    END SUB
END SUB

! -------- end of tool code ---------