!! File: TrigIdentity !! January 7, 2003, Hubert Hohn for Haynes Miller, MIT PUBLIC PCFlag,Mac5Flag,M68KFlag,UnixFlag,xmax,ymax PUBLIC toolLft,toolRgt,toolBas,toolTop,toolhdr,toolHgt,toolWid ! tool boundaries PUBLIC winLft,winRgt,winBas,winTop,winHgt,winWid ! window PUBLIC workLft,workRgt,workBas,workTop,workMidx ! work area PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white PUBLIC red,yellow,green,cyan,blue,magenta,pink,colorscheme PUBLIC planeclr,gridclr,rimclr,axisclr,axislabelclr,titleclr,rightsclr PUBLIC numberlineclr,slotdrkclr,slotlgtclr,slideclr PUBLIC largefonts, title$, SLUmode DECLARE DEF QuitWithin, InfoWithin LET toolHgt= 560 LET toolWid= 780 LET window$= "The d'Arbeloff Interactive Math Project" LET colorscheme= 0 LET title$ = "Trigonometric Identity" SUB ThisProgram CALL TrigIdentity CLEAR END SUB !! ---------------------------------------------------------- !! ------ Start TB4 Mac Header and Subs ------ !LET M68KFlag = 1 !LIBRARY "MacTools*", "HHLib.trc" !ASK PIXELS winWid,winHgt !LET winLft= 0 !LET winTop= 0 !LET winRgt= winWid-1 !LET winBas= winHgt-1 !SET WINDOW 0,winRgt,winBas,0 !CALL Palette !CLEAR ! !CALL ToolPanel !CALL ThisProgram ! !END !EXTERNAL ! !MODULE Mac4Parts ! SUB SetTextFont(font,size,style$) ! CALL MacTextFont(font) ! CALL MacTextSize(size) ! CALL MacTextFace(style$) ! END SUB ! ! SUB StringWidth(sw$,sl) ! DECLARE DEF MacStringWidth ! LET sl= MacStringWidth(sw$) ! END SUB ! ! SUB SetLineWeight(wgt) ! CALL MacPenSize(wgt,wgt) ! END SUB ! ! SUB BoxDisk(Lft,Rgt,Bas,Top) ! CALL MacPaintOval(Lft,Rgt,Bas,Top) ! END SUB !END MODULE !! --- End TB4 Mac Header and Subs --- !!--- Start TB5 Cross-Platform header and subs --- LIBRARY "c:\TB Gold 51a\TBLibs\TrueCtrl.trc" ! windows LIBRARY "c:\TB Gold 51a\TBLibs\HHLib.trc" !LIBRARY ":TBLibs:TrueCtrl.trc" ! macintosh !LIBRARY "HHLib.trc" PUBLIC WinID DECLARE PUBLIC OBJM_SET,OBJM_SYSINFO LET winHgt= toolHgt LET winWid= toolWid DIM values(1) CALL TC_Init CALL Object(OBJM_SYSINFO,WinID,"MACHINE",system$,values()) IF system$="MAC" then LET Mac5Flag= 1 ELSE IF system$="WIN32" then LET PCFlag = 1 END IF CALL TC_SetUnitsToPixels ! 5.1 and up needs this CALL TC_GetScreenSize(scrnLft,scrnRgt,scrnBas,scrnTop) LET winLft= int((scrnRgt-scrnLft-winWid)/2) LET winRgt= winLft+winWid-1 LET winTop= int((scrnBas-scrnTop-winHgt)/2) + 10 LET winBas= winTop+winHgt-1 CALL TC_Win_Create (WinID,"TITLE",winLft,winRgt,winBas,winTop) LET values(1)= 2 CALL Object(OBJM_SET, WinID, "TYPE", "", values()) IF PCFlag=1 then ! kill dithering LET values(1)= 1 CALL Object(OBJM_SET, WinID, "SOLID MIX", "", values()) END IF LET values(1)= 0 CALL TC_SetRect(WinID,winLft,winRgt,winBas,winTop) CALL TC_Win_SetTitle(WinID,window$) CALL TC_Show(WinID) SET MODE "COLORSTANDARD" ASK PIXELS winWid,winHgt ! must follow set mode LET winLft= 0 LET winTop= 0 LET winRgt= winWid-1 LET winBas= winHgt-1 SET WINDOW 0,winRgt,winBas,0 CALL Palette IF PCFlag=1 then LET values(1)= 0 ! now force solid colors CALL Object(OBJM_SET, WinID, "SOLID MIX", "", values()) CALL TC_Win_RealizePalette(WinID) ! some PCs need this CALL TC_Win_SetFont(WinID,"arial",9,"plain") CALL StringWidth("0",sw) IF sw>7 then LET largefonts=1 else LET largefonts=0 END IF CALL TC_Win_Switch(WinID) CALL ToolPanel CALL ThisProgram CALL SetTextFont(1,12,"bold") ! now shut down and clean up LET quit$= "click the mouse or press a key to close..." CALL PlotTextCJ(workmidx,(workbas+worktop)/2,quit$,yellow) CALL TC_CleanUp END EXTERNAL MODULE TB5Parts SUB StringWidth(sw$,sl) DECLARE PUBLIC WinID LET sl= StrWidth(WinID,sw$) END SUB SUB SetLineWeight(wgt) DECLARE PUBLIC OBJM_SET DECLARE PUBLIC WinID DIM values(1) LET values(1)= wgt CALL Object(OBJM_SET,WinID, "WIDTH", "", values()) END SUB SUB SetTextFont(font,size,style$) DECLARE PUBLIC WinID,Mac5Flag,PCFlag,largefonts IF Mac5Flag=1 then SELECT CASE font CASE 4 LET font$= "Courier" CASE 16 LET font$= "Times" CASE else LET font$= "Geneva" END SELECT ELSE IF PCFlag=1 then IF largefonts=1 then IF size<12 then LET size= 6 ELSE IF size=14 then LET size= 10 ELSE IF size=18 then LET size= 12 ELSE IF size=24 then LET size= 14 ELSE IF size=12 then LET size= 8 ELSE LET size= round(72/96 * size * .8) END IF ELSE IF size<12 then LET size= 7 ELSE IF size=14 then LET size= 12 ELSE IF size=12 then LET size= 9 ELSE IF size=18 then LET size= 14 ELSE IF size=24 then LET size= 18 ELSE LET size= round(72/96 * size) END IF END IF SELECT CASE font CASE 4 LET font$= "Courier New" CASE 16 LET font$= "Times New Roman" CASE else LET font$= "Verdana" END SELECT END IF IF style$= "normal" then LET style$= "plain" CALL TC_Win_SetFont(WinID,font$,size,style$) END SUB SUB BoxDisk(Lft,Rgt,Bas,Top) BOX DISK Lft,Rgt,Bas,Top END SUB END MODULE ! --- End TB5 Cross-platform header and subs --- !! --------------------------------------------------------- !! --- Start Unix Header and Subs --- !LET UnixFlag= 1 !ASK PIXELS winWid,winHgt !LET winLft= 0 !LET winTop= 0 !LET winRgt= winWid-1 !LET winBas= winHgt-1 !SET WINDOW 0,winRgt,winBas,0 !CALL Palette ! !CALL ToolPanel !CALL ThisProgram ! !END !EXTERNAL ! !MODULE UnixParts ! SHARE CharWidth ! ! SUB SetTextFont(font,size,style$) ! LET font$= "-adobe-courier-" ! IF style$= "normal" then ! LET style$= "medium-r-normal--" ! ELSE ! LET style$= "bold-r-normal--" ! END IF ! IF size=9 then ! LET size$= str$(10) ! ELSE ! LET size$= str$(size) ! END IF ! LET test= SetFont(font$&style$&size$&"*") ! ! IF size=9 then ! LET CharWidth= 6 ! ELSE IF size=12 then ! numeric output - axis labels ! LET CharWidth= 7 ! ELSE IF size=14 then ! rare ! LET CharWidth= 8 ! ELSE IF size=18 then ! rare ! LET CharWidth= 10 ! END IF ! END SUB ! ! SUB StringWidth(sw$,sl) ! string width in pixels ! ! LET sl= StrWidth(sw$) ! LET chars= len(sw$) ! LET sl = chars*CharWidth ! END SUB ! ! SUB SetLineWeight(wgt) ! ! CALL PenSize(wgt,wgt) ! END SUB ! ! SUB BoxDisk(Lft,Rgt,Bas,Top) ! CALL Fill_Circle(Lft,Rgt,Bas,Top) ! END SUB !END MODULE !! ------ End of TB Unix Header and Subs ------ !! --------------------------------------------------------- ! *** SUB TrigIdentity DECLARE PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white DECLARE PUBLIC red,yellow,green,cyan,blue,magenta,colorscheme DECLARE PUBLIC slideclr,axisclr,axisLabelClr,true,false DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx DECLARE DEF quitWithin,infoWithin ! --- help screen array --- DIM info$(1:20) MAT READ info$ DATA "identity: cos(phi) cos(w) + sin(phi) sin(w) = cos(phi-w)" DATA "identity: cos(phi-w) = cos(w-phi)" DATA "" DATA "x = a cos(wt)" DATA "y = b sin(wt)" DATA "x+y = a cos(wt) + b sin(wt)" DATA "for some A and phi" DATA "-a = A cos(phi)" DATA "-b = A sin(phi)" DATA "so" DATA "x+y = A cos(phi) cos(wt) + A sin(phi) sin(wt)" DATA "x+y = A (cos(phi) cos(wt) + sin(phi) sin(wt))" DATA "since" DATA "-cos(phi) cos(wt) + sin(phi) sin(wt) = cos(phi-wt) = cos(wt-phi)" DATA "the sum becomes" DATA "x+y = A cos(phi-wt) = A cos(wt-phi)" DATA "and" DATA "x+y = a cos(wt) + b sin(wt) = A cos(wt-phi)" DATA "-if a = A cos(phi) and b = A sin(phi)" DATA "-or A = sqrt(a^2 + b^2) and phi = atan(b/a)" ! --- color definition --- LET axisclr= drkmid SET COLOR MIX(red) 1,.4,0 LET aclr = yellow LET bclr = cyan LET cclr = magenta LET sumclr= green LET idclr = red ! ---------- Utility functions --- DECLARE DEF clamp,roundn,e DEF RadToDeg(rad)= rad*180/pi ! --- functions and parameters OPTION ANGLE radians DEF hyp(a,b)= sqr(a*a+b*b) DEF phi(a,b) IF a<>0 or b<>0 then LET phi= angle(a,b) ELSE LET phi= 0 END IF END DEF DEF f1(x)= a*cos(omega*x) DEF f2(x)= b*sin(omega*x) DEF f3(x)= f1(x)+f2(x) DEF f4(x)= alpha*cos(omega*x-ph) LET f1$ = "a cos(wt)" LET f2$ = "b sin(wt)" LET f4$ = "a cos(wt) + b sin(wt)" LET f3$ = "A cos(wt-phi)" ! --- Graphing plane parameters and methods LET wwid = 256 ! 280 LET whgt = 192 ! 210 ! --- 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 w1yPiFlag= 0 LET w1xMult = 1 LET w1yMult = 1 LET w1Lft= workLft + 35 ! pixel bounds LET w1Rgt= w1Lft + wwid LET w1Top= workTop + 40 LET w1Bas= w1Top + whgt LET w1fLft= -4 ! function bounds LET w1fRgt= 4 LET w1fTop= 3 LET w1fBas= -3 LET w1xAx$= "t" ! axis labels LET w1yAx$= "x" LET w1xGridstep= 0 ! horizontal grid intervals LET w1yGridstep= 0 ! vertical grid intervals LET w1xSTik = 0 ! horizontal axis Tik marks LET w1xLTik = 1 LET w1xLabel= 1 LET w1xFirst= w1fLft LET w1ySTik = 0 ! 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 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$,5) ! axis labels CALL PlotTextCJ(w1x0,w1Top-10,w1yAx$,5) CALL w1KeepGridLayer END SUB ! ------------------------------------------ ! --- plane 2 data --- DECLARE PUBLIC w2Lft,w2Rgt,w2Bas,w2Top,w2Midx,w2Midy DECLARE PUBLIC w2fLft,w2fRgt,w2fBas,w2fTop,w2x0,w2y0 DECLARE PUBLIC w2xFirst, w2xSTik, w2xLTik, w2xLabel, w2xGridstep DECLARE PUBLIC w2yFirst, w2ySTik, w2yLTik, w2yLabel, w2yGridstep DECLARE PUBLIC w2wWid,w2wHgt,w2fWid,w2fHgt DECLARE PUBLIC w2fxRatio,w2fyRatio,w2wxRatio,w2wyRatio,w2Aspect DECLARE PUBLIC w2xPiFlag, w2xMult, w2yPiFlag, w2yMult LET w2Flag = 1 LET w2xPiFlag= 0 LET w2yPiFlag= 0 LET w2xMult = 1 LET w2yMult = 1 LET w2Lft = w1Lft ! pixel bounds LET w2Rgt = w1Rgt LET w2Top = w1Bas+ 60 LET w2Bas = w2Top+whgt LET w2fLft= w1fLft ! function bounds * pi LET w2fRgt= w1fRgt LET w2fTop= 3 LET w2fBas= -3 LET w2xGridstep= 0 ! horizontal grid intervals LET w2yGridstep= 0 ! vertical grid intervals LET w2xAx$= "t" ! axis labels LET w2yAx$= "x" LET w2xSTik = 0 ! horizontal axis Tik marks LET w2xLTik = 1 LET w2xLabel = 1 LET w2xFirst = w2fLft LET w2ySTik = 0 ! vertical axis Tik marks LET w2yLTik = 1 LET w2yLabel= 1 LET w2yFirst= w2fBas ! --- plane 2 methods --- DECLARE DEF w2Fncx, w2Fncy, w2Wndx, w2Wndy ! window/function transforms DECLARE DEF w2wWithin CALL w2Variables SUB w2Init CALL w2DrawPlane(1,1,1) ! x axis, y axis, zeroaxes CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(w2Rgt+8,w2y0+3,w2xAx$,5) CALL PlotTextCJ(w2x0,w2Top-10,w2yAx$,5) CALL w2KeepGridLayer END SUB ! ------------------------------------------ ! --- plane 3 data --- DECLARE PUBLIC w3Lft,w3Rgt,w3Bas,w3Top,w3Midx,w3Midy DECLARE PUBLIC w3fLft,w3fRgt,w3fBas,w3fTop,w3x0,w3y0 DECLARE PUBLIC w3xFirst, w3xSTik, w3xLTik, w3xLabel, w3xGridstep DECLARE PUBLIC w3yFirst, w3ySTik, w3yLTik, w3yLabel, w3yGridstep DECLARE PUBLIC w3wWid,w3wHgt,w3fWid,w3fHgt DECLARE PUBLIC w3fxRatio,w3fyRatio,w3wxRatio,w3wyRatio,w3Aspect DECLARE PUBLIC w3xPiFlag, w3xMult, w3yPiFlag, w3yMult LET w3Flag = 1 LET w3xPiFlag= 0 LET w3yPiFlag= 0 LET w3xMult = 1 LET w3yMult = 1 LET w3Lft = workrgt - 180 ! pixel bounds LET w3Rgt = w3Lft + 150 LET w3Top = (w1Bas+w2Top)/2 - 75 LET w3Bas = w3Top + 150 LET w3fLft = -3 ! function bounds * pi LET w3fRgt = 3 LET w3fTop = 3 LET w3fBas = -3 LET w3xGridstep= 0 ! horizontal grid intervals LET w3yGridstep= 0 ! vertical grid intervals LET w3xAx$ = "a" ! axis labels LET w3yAx$ = "b" LET w3xSTik = 0 ! horizontal axis Tik marks LET w3xLTik = 1 LET w3xLabel= 1 LET w3xFirst= w3fLft LET w3ySTik = 0 ! vertical axis Tik marks LET w3yLTik = 1 LET w3yLabel= 1 LET w3yFirst= w3fBas ! --- plane 3 methods --- DECLARE DEF w3Fncx, w3Fncy, w3Wndx, w3Wndy ! window/function transforms DECLARE DEF w3wWithin CALL w3Variables SUB w3Init CALL w3DrawPlane(1,1,1) ! x axis, y axis, zeroaxes CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(w3Rgt+8,w3y0+3,w3xAx$,aclr) CALL PlotTextCJ(w3x0,w3Top-10,w3yAx$,bclr) CALL w3KeepGridLayer END SUB ! ----- Slider parameters and methods ----- LET hswid = 120 LET vrule1 = w1Rgt + 90 ! --- h1 A --- 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 = idclr LET h1name$ = "A" LET h1form$ = "-%.##" LET h1Places= 2 LET h1axis = w1Midy LET h1wLft = vrule1 LET h1wRgt = h1wLft+hswid LET h1fLft = 0 LET h1fRgt = 3 LET h1STik = 0.5 ! short tick marks LET h1LTik = 1 ! long tick marks LET h1Label = 1 ! labels LET h1First = h1fLft ! first tick mark LET h1click = 0.5 CALL h1SliderVariables SUB h1Init CALL h1DrawSlider(h1name$,alpha) END SUB ! --- h2 phi --- DECLARE PUBLIC h2axis,h2wLft,h2wRgt,h2wBas,h2wTop,h2fLft,h2fRgt DECLARE PUBLIC h2name$,h2form$,h2clr,h2First,h2STik,h2LTik,h2Label DECLARE PUBLIC h2PiAxis,h2Mult,h2fMin,h2fMax,h2slot$,h2sLft DECLARE DEF h2Within, h2Wndx, h2Fncx ! window/function transforms LET h2PiAxis= 1 LET h2Mult = pi LET h2clr = idclr LET h2name$ = "" LET h2form$ = "---%.##" LET h2Places= 2 LET h2axis = h1axis+50 LET h2wLft = h1wLft LET h2wRgt = h1wRgt LET h2fLft = -1 LET h2fRgt = 1 LET h2STik = 1/4 ! short tick marks LET h2LTik = 1/2 ! long tick marks LET h2Label = 1/2 ! 1/2 ! labels LET h2First = h2fLft ! first tick mark LET h2Click = pi/4 CALL h2SliderVariables SUB h2Init CALL h2DrawSlider(h2name$,ph) CALL h2Mark(ph) CALL SwapPhi(h2wLft-18,h2wBas-3,"p","p",red) END SUB ! --- h3 a --- DECLARE PUBLIC h3axis,h3wLft,h3wRgt,h3wBas,h3wTop,h3fLft,h3fRgt DECLARE PUBLIC h3name$,h3form$,h3clr,h3First,h3STik,h3LTik,h3Label DECLARE PUBLIC h3PiAxis,h3Mult,h3fMin,h3fMax DECLARE DEF h3Within ! window/function transforms LET h3PiAxis= 0 LET h3Mult = 1 LET h3clr = aclr LET h3name$ = "a" LET h3form$ = "-%.##" LET h3Places= 2 LET h3axis = w2Midy LET h3wLft = h1wLft LET h3wRgt = h1wRgt LET h3fLft = -2 LET h3fRgt = 2 LET h3STik = 0.5 ! short tick marks LET h3LTik = 1 ! long tick marks LET h3Label = 1 ! labels LET h3First = h3fLft ! first tick mark LET h3Click = 0.5 CALL h3SliderVariables SUB h3Init CALL h3DrawSlider(h3name$,a) END SUB ! --- h4 b --- DECLARE PUBLIC h4axis,h4wLft,h4wRgt,h4wBas,h4wTop,h4fLft,h4fRgt DECLARE PUBLIC h4name$,h4form$,h4clr,h4First,h4STik,h4LTik,h4Label DECLARE PUBLIC h4PiAxis,h4Mult,h4fMin,h4fMax DECLARE DEF h4Within ! window/function transforms LET h4PiAxis= 0 LET h4Mult = 1 LET h4clr = bclr LET h4name$ = "b" LET h4form$ = "-%.##" LET h4Places= 2 LET h4axis = h3axis+50 LET h4wLft = h3wLft LET h4wRgt = h3wRgt LET h4fLft = h3fLft LET h4fRgt = h3fRgt LET h4STik = 0.5 ! short tick marks LET h4LTik = 1 ! long tick marks LET h4Label = 1 ! labels LET h4First = h4fLft ! first tick mark LET h4Click = 0.5 CALL h4SliderVariables SUB h4Init CALL h4DrawSlider(h4name$,b) END SUB ! --- h5 omega --- DECLARE PUBLIC h5axis,h5wLft,h5wRgt,h5wBas,h5wTop,h5fLft,h5fRgt DECLARE PUBLIC h5name$,h5form$,h5clr,h5First,h5STik,h5LTik,h5Label DECLARE PUBLIC h5PiAxis,h5Mult,h5fMin,h5fMax DECLARE DEF h5Within ! window/function transforms LET h5PiAxis= 0 LET h5Mult = 1 LET h5clr = slideclr LET h5name$ = "" LET h5form$ = "-%.##" LET h5Places= 2 LET h5axis = h4axis+50 ! w1Bas + 30 LET h5wLft = w3Lft ! h1wLft LET h5wRgt = h5wLft+60 ! h1wRgt LET h5fLft = 0 LET h5fRgt = 3 LET h5STik = 0.5 ! short tick marks LET h5LTik = 1 ! long tick marks LET h5Label = 1 ! labels LET h5First = h5fLft ! first tick mark LET h5Click = 0.5 CALL h5SliderVariables SUB h5Init CALL h5DrawSlider(h5name$,omega) CALL SwapOmega(h5wLft-18,h5wBas-3,"w","w",white) END SUB ! --- t1 text - upper graph - separate sum and identity --- LET t1BasLn = w1Top + 30 LET t1Lft = vrule1 - 5 LET t1Rgt = t1Lft + 120 LET t1Bas = t1BasLn + 5 LET t1Top = t1BasLn - 15 LET t1Label$= "" SUB t1Label CALL SetTextFont(1,12,"bold") CALL SuperSubScriptRJ(t1Lft,t1BasLn,t1Label$,white) END SUB SUB t1Set CALL SetTextFont(1,12,"bold") LET f3a$= "A cos(wt" CALL StringWidth(f3a$,sw) CALL SwapOmega(t1Lft,t1BasLn,f3a$,"w",idclr) LET f3b$= " - p)" CALL SwapPhi(t1Lft+sw,t1BasLn,f3b$,"p",idclr) CALL PlotTextLJ(t1Lft,t1BasLn+20,f4$,sumclr) END SUB SUB t1Clear BOX CLEAR t1Lft-2,t1Rgt,t1Bas,t1Top END SUB SUB t1Init CALL t1Label CALL t1Set END SUB ! --- t2 text - lower graph - individual trig equations --- LET t2BasLn = w2Top + 30 LET t2Lft = t1Lft LET t2Rgt = t2Lft + 120 LET t2Bas = t2BasLn + 5 LET t2Top = t2BasLn - 15 LET t2Label$= "" SUB t2Label CALL SetTextFont(1,12,"bold") CALL SuperSubScriptRJ(t2Lft,t2BasLn,t2Label$,white) END SUB SUB t2Set CALL SetTextFont(1,12,"bold") CALL SwapOmega(t2Lft,t2BasLn ,f1$,"w",aclr) CALL SwapOmega(t2Lft,t2BasLn+20,f2$,"w",bclr) END SUB SUB t2Clear BOX CLEAR t2Lft-2,t2Rgt,t2Bas,t2Top END SUB SUB t2Init CALL t2Label CALL t2Set END SUB ! --- t3 text identity equation --- LET t3BasLn = w1Top - 10 LET t3Lft = t1Lft LET t3Rgt = workrgt LET t3Bas = t3BasLn + 5 LET t3Top = t3BasLn - 15 LET t3Label$= "" SUB t3Label CALL SetTextFont(1,12,"bold") CALL SuperSubScriptRJ(t3Lft,t3BasLn,t3Label$,white) END SUB SUB t3Set CALL SetTextFont(1,12,"bold") LET t$ = "a cos(wt) + b sin(wt) = A cos(wt - p)" CALL SwapOmegaAndPhi(t3lft,t3BasLn,t$,"w","p",white) END SUB SUB t3Clear BOX CLEAR t3Lft-2,t3Rgt,t3Bas,t3Top END SUB SUB t3Init !CALL t3Label CALL t3Set END SUB ! --- plane 3 radio switches --- DECLARE PUBLIC r1cnt,r1stp,r1siz DECLARE PUBLIC r1lft,r1rgt,r1bas,r1top,r1Name$,r1NameClr DECLARE PUBLIC r1NameList$(),r1ColorList() MAT redim r1NameList$(1:4) MAT READ r1NameList$ DATA "","","","" MAT redim r1ColorList(1:4) MAT READ r1ColorList DATA 5,5,5,5 LET r1Cnt = 4 LET r1Lft = w3Rgt - 55 LET r1Top = w3Bas + 38 LET r1Name$ = "" LET r1NameClr= 0 DECLARE DEF r1Within CALL r1SetVars ! --- r1 typesetting is done here for color coding --- LET r1txtLft= r1Rgt + 8 LET r1BasLn0= r1Top + 0*r1Stp + r1Siz-2 LET r1BasLn1= r1Top + 1*r1Stp + r1Siz-2 LET r1BasLn2= r1Top + 2*r1Stp + r1Siz-2 LET r1BasLn3= r1Top + 3*r1Stp + r1Siz-2 SUB r1Init CALL r1DrawCheckBoxes CALL r1SetCheckBox(r1num) CALL PlotTextLJ(r1txtLft,r1BasLn0,"None",litgry) CALL PlotTextLJ(r1txtLft,r1BasLn1,"a",yellow) CALL PlotTextCJ(r1txtLft+13,r1BasLn1,",",white) CALL PlotTextLJ(r1txtLft+18,r1BasLn1,"b",cyan) CALL PlotTextLJ(r1txtLft,r1BasLn2,"A",red) CALL PlotTextCJ(r1txtLft+13,r1BasLn2,",",white) CALL SwapPhi(r1txtLft+17,r1BasLn2,"p","p",red) CALL PlotTextLJ(r1txtLft,r1BasLn3,"All",litgry) END SUB ! --- graphical rollover sum --- LET rsumLft = w1Rgt+30 LET rsumRgt = rsumLft+15 LET rsumBas = w1Bas LET rsumTop = w1Top SUB RollSumClear BOX CLEAR rsumLft,rsumRgt,rsumBas,rsumTop END SUB ! --- end of design and layout ! --- default parameters --- LET alpha,oldalpha= sqr(2) LET ph,oldph = pi/2 LET a,olda = 1 LET b,oldb = 1 LET omega,oldomega= 1 LET r1num = 1 LET APhiFlag = 0 LET abFlag = 0 LET w3circleFlag = 0 ! --- Draw screen --- CALL InitScreen SUB InitScreen BOX CLEAR worklft,workrgt,workbas,worktop CALL w1Init CALL w2Init CALL w3Init CALL h1Init CALL h2Init CALL h3Init CALL h4Init CALL h5Init CALL t1Init CALL t2Init CALL t3Set CALL r1Init CALL DrawGraphs CALL w3Update12 CALL w3Update34 END SUB ! --- Event manager ------------------------------ DO CALL w1KeepGraphLayer CALL w2KeepGraphLayer DO GET MOUSE: mx,my,ms IF w1wWithin(mx,my)=true then CALL w1Rollover ELSE CALL RolloverClear END IF LOOP until ms=2 ! mouse down? CALL RolloverClear ! slider events IF h1Within(mx,my)=true then IF myoldx then ! vertical rules on planes 1 and 2 CALL w1ShowGraphLayer CALL w2ShowGraphLayer CALL PlotLine(mx,w1y0, mx,w1y0-cpix, green) CALL PlotLine(mx,w2Bas, mx,w2Top, litmid) ! visually compares sum and identity LET a1 = f2(x) LET b1 = f1(x) ! LET sum = a1+b1 LET apix= a1 * w1wyRatio ! pixel height LET bpix= b1 * w1wyRatio ! pixel height LET cpix= apix + bpix ! pixel height sum CALL RollSumClear IF apix<>0 then CALL BoxArea(rsumLft,rsumLft+2,w1Midy,w1Midy-apix,bclr) END IF IF bpix<>0 then CALL BoxArea(rsumLft+3,rsumLft+5,w1Midy-apix,w1Midy-apix-bpix,aclr) END IF IF cpix<>0 then CALL BoxArea(rsumLft+12,rsumLft+14,w1Midy,w1Midy-cpix,sumclr) END IF LET oldx = x LET w1ClearFlag= 1 END IF END SUB ! ------ Slider Mouse events ------ ! --- h1 Alpha --- SUB h1ClickMouse CALL h1GetClickVal(ms,h1Click,alpha) CALL w1ShowGridLayer CALL w1DrawGraphSum IF APhiFlag=1 then CALL w3ShowGridLayer ! clear plane 3 IF abFlag=1 then CALL abGraph ! a,b point CALL w3KeepGraphLayer ! buffer for refresh END IF END IF CALL h1Action END SUB SUB h1DragMouse LET oldalpha= -99 CALL w1ShowGridLayer ! clear CALL w1DrawGraphSum ! sum curve CALL w1KeepGraphLayer ! buffer for refresh IF APhiFlag=1 then CALL w3KeepGraphLayer12 ! A,Phi on? DO CALL h1GetDragVal(ms,h1Places,alpha) IF alpha<>oldalpha then CALL w1ShowGraphLayer ! show buffer CALL h1Action END IF LOOP until ms= 3 END SUB SUB h1Action CALL w1DrawGraphID IF APhiFlag=1 then CALL w3Update12 LET oldalpha= alpha END SUB ! --- h2 Phi --- SUB h2ClickMouse CALL MouseUp(mx,my,ms) LET mx= clamp(mx,h2wLft,h2wRgt) LET ph= h2Fncx(mx) LET ph= roundn(ph,h2Click) CALL w1ShowGridLayer CALL w1DrawGraphSum IF APhiFlag=1 then CALL w3ShowGridLayer ! clear plane 3 IF abFlag=1 then CALL abGraph ! a,b point CALL w3KeepGraphLayer12 ! buffer for refresh END IF END IF CALL h2Action END SUB SUB h2DragMouse LET oldph= -99 CALL w1ShowGridLayer ! clear CALL w1DrawGraphSum ! sum curve CALL w1KeepGraphLayer ! buffer for refresh IF APhiFlag=1 then CALL w3KeepGraphLayer12 ! A,Phi on? DO GET MOUSE: mx,my,ms LET mx= clamp(mx,h2wLft,h2wRgt) LET ph= h2Fncx(mx) IF ph<>oldph then CALL w1ShowGraphLayer ! show buffer CALL h2Action END IF LOOP until ms=3 END SUB SUB h2Action CALL h2Mark(ph) CALL w1DrawGraphID IF APhiFlag=1 then CALL w3Update12 LET oldph = ph END SUB SUB h2Mark(n) LET wx= h2Wndx(n) BOX SHOW h2slot$ at h2sLft,h2wBas CALL SliderKnob(wx,h2wBas-5) LET degrees= round(RadToDeg(n)) CALL PlotDegreesLJ(h2wRgt+8,h2wBas-3,degrees,h2clr) END SUB ! --- h3 a --- SUB h3ClickMouse CALL h3GetClickVal(ms,h3Click,a) CALL w2ShowGridLayer CALL w2DrawGraphB CALL w1ShowGridLayer CALL w1DrawGraphID IF abFlag=1 then ! plane 3 parameters CALL w3ShowGridLayer IF APhiFlag=1 then ! draw A,phi ? CALL APhiGraph CALL w3KeepGraphLayer34 END IF END IF CALL h3Action END SUB SUB h3DragMouse LET olda= -99 CALL w2ShowGridLayer ! refresh a,b plane CALL w2DrawGraphB ! buffer the b curve CALL w2KeepGraphLayer CALL w1ShowGridLayer ! refresh A,phi plane CALL w1DrawGraphID ! buffer the identity curve CALL w1KeepGraphLayer IF abFlag=1 then CALL w3KeepGraphLayer34 ! a,b on? DO CALL h3GetDragVal(ms,h3Places,a) IF a<>olda then CALL w1ShowGraphLayer CALL w2ShowGraphLayer CALL h3Action END IF LOOP until ms=3 END SUB SUB h3Action CALL w1DrawGraphSum ! draw sum curve CALL w2DrawGraphA ! draw the a curve IF abFlag=1 then CALL w3Update34 ! a,b on? LET olda= a END SUB ! --- h4 b --- SUB h4ClickMouse LET oldb= -99 CALL h4GetClickVal(ms,h4Click,b) CALL w2ShowGridLayer CALL w2DrawGraphA CALL w1ShowGridLayer CALL w1DrawGraphID IF abFlag=1 then ! plane 3 parameters CALL w3ShowGridLayer IF APhiFlag=1 then ! draw A,phi? CALL APhiGraph CALL w3KeepGraphLayer34 END IF END IF CALL h4Action END SUB SUB h4DragMouse CALL w2ShowGridLayer ! refresh ab plane CALL w2DrawGraphA ! draw the a curve CALL w2KeepGraphLayer ! buffer the a curve CALL w1ShowGridLayer ! refresh ab plane CALL w1DrawGraphID ! draw the identity curve CALL w1KeepGraphLayer ! buffer the identity curve IF abFlag=1 then CALL w3KeepGraphLayer34 ! a,b on? DO CALL h4GetDragVal(ms,h4Places,b) IF b<>oldb then CALL w1ShowGraphLayer CALL w2ShowGraphLayer CALL h4Action END IF LOOP until ms=3 END SUB SUB h4Action CALL w1DrawGraphSum ! draw sum curve CALL w2DrawGraphB ! draw the b curve IF abFlag=1 then CALL w3Update34 ! a,b on? LET oldb= b END SUB ! --- omega (frequency) --- SUB h5ClickMouse CALL h5GetClickVal(ms,h5Click,omega) CALL h5Action END SUB SUB h5DragMouse DO CALL h5GetDragVal(ms,h5Places,omega) CALL h5Action LOOP until ms=3 END SUB SUB h5Action IF oldomega<>omega then CALL DrawGraphs LET oldomega= omega END IF END SUB ! --- Tool specific drawing and typesetting routines ! --- Plane 3 parameters a,b and A,Phi --- ! There's still some odd control bug in Trig Id. ! I choose "All," then change a, then choose "a,b" ! and get not a,b but still All. SUB w3Reset CALL w3ShowGridLayer CALL w3KeepGraphLayer SELECT CASE r1num CASE 1 ! none LET abFlag = 0 LET APhiFlag= 0 CASE 2 ! a,b LET abFlag = 1 LET APhiFlag= 0 CALL w3Update34 CASE 3 ! A,phi LET abFlag = 0 LET APhiFlag= 1 CALL w3Update12 CASE 4 ! both LET abFlag = 1 LET APhiFlag= 1 CALL w3Init1234 END SELECT END SUB SUB w3Init1234 ! all CALL w3ShowGridLayer CALL w3KeepGraphLayer CALL APhiGraph CALL abGraph END SUB SUB w3Update12 ! A,phi CALL w3ShowGraphLayer CALL APhiGraph END SUB SUB w3Update34 ! a,b CALL w3ShowGraphLayer CALL abGraph END SUB SUB w3KeepGraphLayer12 ! buffer a,b CALL w3ShowGridLayer CALL abGraph CALL w3KeepGraphLayer END SUB SUB w3KeepGraphLayer34 ! buffer A,Phi CALL w3ShowGridLayer CALL APhiGraph CALL w3KeepGraphLayer END SUB ! --- plane 1: a,b and plane 2: A,Phi & sum --- SUB DrawGraphs CALL w1ShowGridLayer CALL w2ShowGridLayer CALL w2DrawGraphA CALL w2DrawGraphB CALL w1DrawGraphSum CALL w1DrawGraphID END SUB ! --- Plane 1 - sum and identity graphs --- SUB w1DrawGraphSum ! trig sum: a + b SET COLOR Sumclr FOR wx= w1Lft to w1Rgt LET x = w1Fncx(wx) LET y = f3(x) LET wy= w1Wndy(y) IF wy>w1Top and wyw1Top and wyw2Top and wyw2Top and wy