!In the Fourier series there are two kinds of behavior. ! !-If the function is continuous (e.g. the two triangle waves), then ! the covergence is uniform. Practically, this means that very ! quickly the sum becomes indistinguishable from the limit. ! Haynes' distance value would really be the only way to distinguish. ! !-If the function is not continuous (e.g. the two sawtooth waves ! and the two square waves), you have the Gibbs effect. Haynes' ! distance value would be greater in these cases. !We need an option not to show the distance panel if we don't want it !visible. !If it is toggled on, the distance display should not vanish when !the reset button is hit. ! ! !I suggest having no target chosen when the tool opens. ! ! !Changing the target should not reset the guessed fourier series. ! ! !a0 is not an odd cosine coefficient. !We need a0 to do the fit in C - is it called something else? ! !I guess having the scale go twice as high for a0 as for the other !coefficients is reasonable. Another choice would be to display a_0/2. !Can't we return to the range from -1.5 to +1.5 (with a0 ranging between !-3 and 3)? ! !The coefficients for the sixth target must be wrong; the optimum seems to !head for the function C instead. Remember, we decided that the coefficients !were ! !a0 = pi^2/8 a2 = - 1 a4 = 0 a6 = - 1/9 !a8 = 0 a10 = - 1/25 a12 = 0. ! A - sine, odd, alternate ! B - cosine, odd ! C - cosine, odd ! D - sine, all ! E - sine, all, alternate ! F - cosine, even, alternate ! is cosine, all a cycloid? !! File: FourierCoefficients !! January 12, 2002 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 qLft,qRgt,qBas,qTop PUBLIC infLft,infRgt,infBas,infTop PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white PUBLIC red,yellow,green,cyan,blue,magenta,colorscheme PUBLIC planeClr,gridClr,rimClr,axisClr,axislabelClr,titleClr,rightsClr PUBLIC numberlineClr,slotdrkClr,slotlgtClr,slideClr PUBLIC largefonts PUBLIC title$ LET toolHgt= 540 LET toolWid= 780 LET window$= "MIT Visual Math Project" LET colorscheme= 0 LET title$ = "Fourier Coefficients" SUB ThisProgram CALL FourierCoefficients END SUB !! ---------------------------------------------------------- !! --- 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 !CLEAR ! !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 ! --------------------------------------------------------- !! --- Start Mac TB4 Header and Subs --- !LET M68Kflag = 1 !LIBRARY "MacTools*" !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 !CLEAR ! !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 Mac4 Header and Subs --- ! --------------------------------------------------------- ! ! --- Start Cross-Platform TB5 header and subs --- ! LIBRARY "c:\TB Silver\TBLibs\TrueCtrl.trc" ! windows !LIBRARY "c:\TBGold\TBLibs\TrueCtrl.trc" ! windows !LIBRARY "c:\program files\TB Gold\TBLIbs\TrueCtrl.trc" ! windows !LIBRARY ":TBLibs:TrueCtrl.trc" ! macintosh PUBLIC old_priority LET new_priority= 19200 ! 9600 is default CALL Priority(new_priority,old_priority) PUBLIC WinID DECLARE PUBLIC OBJM_SET,OBJM_SYSINFO LET winHgt= toolHgt LET winWid= toolWid LET WinID = 0 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 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 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 CALL Object(OBJM_SET, WinID, "SOLID MIX", "", values()) CALL TC_Win_RealizePalette(WinID) ! PC needs this in 5.1 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 CLEAR 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= 7 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= 8 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$= "Arial" 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 header and subs --- !! --------------------------------------------------------- MODULE Interface DECLARE PUBLIC PCflag,M68kflag,Mac5flag,Unixflag,xmax,ymax DECLARE PUBLIC toolLft,toolRgt,toolBas,toolTop,toolhdr,toolHgt,toolWid ! tool boundaries DECLARE PUBLIC winLft,winRgt,winBas,winTop,winHgt,winWid ! window DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx ! work area DECLARE PUBLIC qLft,qRgt,qBas,qTop DECLARE PUBLIC infLft,infRgt,infBas,infTop DECLARE PUBLIC iLft,iRgt,iBas,iTop 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 PUBLIC largefonts DECLARE PUBLIC title$ SUB ToolPanel LET toolLft= int((winWid-toolWid)/2) LET toolRgt= toolLft+toolWid-1 LET toolTop= int((winHgt-toolHgt)/2) LET toolBas= toolTop+toolHgt-1 LET toolhdr= toolTop+27 LET toolmid= int((toolLft+toolRgt)/2) IF M68kFlag=1 or Unixflag=1 then ASK PIXELS xpix,ypix LET xmax= xpix-1 LET ymax= ypix-1 SET COLOR drkgry BOX AREA 0,xmax,ymax,0 CALL Rim(toolLft,toolRgt,toolBas,toolTop,0) ELSE SET COLOR white BOX LINES toollft,toolrgt,toolbas,tooltop END IF CALL HRule(toollft+4,toolrgt-4,toolhdr,3,0) LET workLft = toolLft+ 5 LET workRgt = toolRgt- 5 LET workTop = toolhdr+ 2 LET workBas = toolBas- 5 LET workMidx= int((workLft+workRgt)/2) CALL SetTextFont(1,9,"bold") LET qLft= toolRgt-40 LET qTop= toolTop+5 LET qRgt= qLft+35 LET qBas= qTop+17 CALL DrawButton(qLft,qRgt,qBas,qTop,5,"Quit") LET infLft= qLft - 40 ! info button LET infTop= qTop LET infRgt= infLft + 35 LET infBas= qBas CALL DrawButton(infLft,infRgt,infBas,infTop,5,"Help") CALL SetToolTitle(title$) ! LET cl= toolLft + 30 ! LET cr= toolRgt - 30 ! LET cy= workBas+2 ! SET COLOR white ! PLOT cl,cy-1; cr,cy-1 ! SET COLOR black ! PLOT cl+1,cy; cr+1,cy !CALL CopyRight(workLft+30,cy+9,rightsclr) END SUB SUB SetToolTitle(txt$) !BOX CLEAR qRgt+5,infLft-5,toolhdr-5,toolTop+5 CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(workLft+20,toolhdr-10,txt$,titleClr) END SUB SUB CopyRightHC(hp,yp,c) ! 142 pixels LET x= hp LET y= yp-7 SET COLOR c FOR v= 0 to 7 READ data$ FOR h= 0 to 30 LET n$= data$(h:h) IF n$= "1" then PLOT x+h,y+v END IF NEXT h NEXT v DATA 00111100000000000000000000000 DATA 01000010000110001100011000100 DATA 10011001001001010010100101100 DATA 10100001000001010010100100100 DATA 10100001000010010010100100100 DATA 10011001000100010010100100100 DATA 01000010001111001100011001110 DATA 00111100000000000000000000000 LET x= x+35 SET COLOR c FOR v= 1 to 7 READ data$ FOR h= 1 to 107 LET n$= data$(h:h) IF n$= "1" then PLOT x+h,y+v-1 END IF NEXT h NEXT v DATA 100001000010001000000010000000000000000000000000000001000000001000001110000000000000000100000000000000010010 DATA 100001000010001000000010000000000000000000000000000001000000001000010001000000000000000100000000000000010010 DATA 100001000010001001110010110010110000000111010110001111000000001000010000000111010110011111010001001110010010 DATA 111111000011111010001011001011001000001001011001010001000000001000010000001001011001000100010001010001010010 DATA 100001000010001010001010001010001000010001010001010001000000001000010000010001010001000100010101011110010010 DATA 100001000010001010001010001010001000010011010001010001000010001000010001010011010001000100011011010000010010 DATA 100001010010001001110010001010001000001101010001001111000001110010001110001101010001000010010001001111010010 END SUB SUB CopyRightH(hp,yp,c) ! Width = 87 pixels ! Width = 131 pixels LET x= hp LET y= yp-7 SET COLOR c FOR v= 0 to 7 READ data$ FOR h= 0 to 30 LET n$= data$(h:h) IF n$= "1" then PLOT x+h,y+v END IF NEXT h NEXT v DATA 00111100000000000000000000000 DATA 01000010000110001100011000100 DATA 10011001001001010010100101100 DATA 10100001000001010010100100100 DATA 10100001000010010010100100100 DATA 10011001000100010010100100100 DATA 01000010001111001100011001110 DATA 00111100000000000000000000000 LET x= x+35 FOR v= 1 to 7 READ data$ FOR h= 1 to 33 LET n$= data$(h:h) IF n$= "1" then PLOT x+h,y+v-1 END IF NEXT h NEXT v ! midpoint - 34 DATA 10001000010001000000010000000000 DATA 10001000010001000000010000000000 DATA 10001000010001001110010110010110 DATA 11111000011111010001011001011001 DATA 10001000010001010001010001010001 DATA 10001000010001010001010001010001 DATA 10001010010001001110010001010001 END SUB SUB CopyRightHM(hp,yp,c) ! Width = 87 pixels ! Width = 131 pixels LET x= hp LET y= yp-7 LET x= x+36 FOR v= 1 to 7 READ data$ FOR h= 1 to 68 LET n$= data$(h:h) IF n$= "1" then PLOT x+h,y+v-1 END IF NEXT h NEXT v DATA 00000000000000001000010001000010001001001001000000000000 DATA 00000000000000001000010001000011011000001001000000000000 DATA 00111010110001111000010001000010101001001001000111001011 DATA 01001011001010001000011111000010101001001001001000101100 DATA 10001010001010001000010001000010001001001001001111101000 DATA 10011010001010001000010001000010001001001001001000001000 DATA 01101010001001111000010001010010001001001001000111001000 END SUB SUB Rim(l,r,b,t,c) SET COLOR 0 BOX AREA l,r,b,t SET COLOR black PLOT l+3,b-3; l+3,t+3; r-3,t+3 PLOT l+1,b; r,b; r,t+1 SET COLOR white PLOT l+4,b-3; r-3,b-3; r-3,t+4 PLOT l,b-1; l,t; r-1,t SET COLOR c BOX AREA l+5,r-5,b-5,t+5 END SUB SUB HRule(l,r,b,h,c) LET t= b-h SET COLOR c BOX AREA l,r,b,t SET COLOR black PLOT l,b; r,b SET COLOR white PLOT l,t; r,t END SUB SUB Panel(l,r,b,t,c) SET COLOR 0 BOX AREA l,r,b,t SET COLOR white PLOT l+1,b; r,b; r,t+1 PLOT l+3,b-3; l+3,t+3; r-3,t+3 SET COLOR black PLOT l+4,b-3; r-3,b-3; r-3,t+4 PLOT l,b-1; l,t; r-1,t SET COLOR c BOX AREA l+5,r-5,b-5,t+5 END SUB ! ---- Color Subs ----- SUB Palette ! LET b0= 0 ! LET b1= 0.30 ! LET b2= 0.40 ! LET b3= 0.60 ! LET b4= 0.70 ! LET b5= 1.00 LET b0= 0 LET b1= 0.20 LET b2= 0.40 LET b3= 0.60 LET b4= 0.80 LET b5= 1.00 IF colorscheme=0 then SET COLOR MIX(0) b0,.2,.4 ! Back ELSE SET COLOR MIX(0) b4,b4,b4 ! Back SET COLOR MIX(0) .7,.7,.7 ! Back END IF SET BACK 0 SET COLOR 0 CLEAR SET COLOR MIX( 1) b0,b0,b0 ! black SET COLOR MIX( 2) b1,b1,b1 ! dark gray SET COLOR MIX( 3) b2,b2,b2 ! dark mid SET COLOR MIX( 4) b3,b3,b3 ! lite mid SET COLOR MIX( 5) b4,b4,b4 ! lite gray SET COLOR MIX( 6) b5,b5,b5 ! white IF colorscheme=0 then SET COLOR MIX( 7) b5,b2,b0 ! red SET COLOR MIX( 8) b5,b5,b0 ! yellow SET COLOR MIX( 9) b1,b5,b0 ! green SET COLOR MIX(10) b0,b5,b5 ! cyan SET COLOR MIX(11) b2,b2,b5 ! blue SET COLOR MIX(12) b5,b0,b5 ! magenta SET COLOR MIX(13) b5,b3,b0 ! magenta ELSE SET COLOR MIX( 7) b3,b1,b0 ! red SET COLOR MIX( 8) b4,b3,b0 ! yellow SET COLOR MIX( 9) b0,b2,b0 ! green SET COLOR MIX(10) b0,b3,b3 ! cyan SET COLOR MIX(11) b2,b0,b4 ! blue SET COLOR MIX(12) b3,b0,b3 ! magenta SET COLOR MIX(13) b5,b3,b0 ! magenta END IF FOR i= 1 to 13 SET COLOR i NEXT i LET black = 1 LET drkgry = 2 LET drkmid = 3 LET midgry = 3 LET litmid = 4 LET litgry = 5 LET white = 6 LET red = 7 LET yellow = 8 LET green = 9 LET cyan = 10 LET blue = 11 LET magenta= 12 IF colorscheme=0 then LET planeClr= black LET gridClr = drkgry LET rimClr = drkmid LET axisClr = litgry LET axislabelClr= white LET titleClr = litgry LET rightsClr = litmif LET numberlineClr= 4 LET slotdrkClr= black LET slotlgtClr= litmid ELSE LET planeClr= white LET gridClr = litgry LET rimClr = drkmid LET axisClr = drkgry LET axislabelClr= black LET titleClr= drkgry LET rightsClr= drkgry LET numberlineClr= drkgry LET slotdrkClr= drkgry LET slotlgtClr= white END IF END SUB SUB PaletteTest ASK PIXELS xpix,ypix LET xmax= xpix-1 LET ymax= ypix-1 FOR i= 1 to 12 SET COLOR i LET x= workLft + 100 + i*40 BOX AREA x,x+19,workBas,workTop NEXT i GET POINT: mx,my DATA 0,.35,.40,.54,.67,.80,1 END SUB END MODULE MODULE Help 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 DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx ! work area DECLARE PUBLIC M68kFlag DECLARE PUBLIC toolLft,toolRgt,toolBas,toolTop,toolhdr SUB InfoPage(Info$()) LET iLft= workLft LET iRgt= workRgt-1 LET iBas= workBas-2 LET iTop= workTop SET COLOR white BOX AREA iLft,iRgt,iBas,iTop SET COLOR 2 CALL CopyRightHC(iLft+20,iBas-3,rightsClr) LET marg1 = iLft+30 LET marg2 = marg1+24 LET txtLft= marg1 LET txtRgt= iRgt-30 LET Basln = iTop+50 LET lnspc = 15 LET hlfspc= 8 LET Clr = black SET COLOR Clr CALL SetTextFont(1,12,"bold") LET linecount= ubound(Info$) FOR i= 1 to linecount LET txt$ = Info$(i) LET first$= txt$(1:1) IF first$= "x" or first$= "y" then LET txtLft= marg2 CALL SuperSubScriptLJ(txtLft,Basln,txt$,Clr) LET Basln = Basln+lnspc ELSE IF first$= "-" then LET txtLft= marg2 LET txt$(1:1)= "" ELSE LET txtLft= marg1 END IF CALL Paragraph(txtLft,txtRgt,Basln,lnspc,txt$) END IF LET Basln= Basln+hlfspc NEXT i LET midpage= int((iLft+iRgt)/2) CALL SetTextFont(1,9,"bold") LET cbtnLft= midpage-35 LET cbtnRgt= midpage+35 LET cbtnBas= iBas-10 LET cbtnTop= cbtnBas-17 CALL DrawButton(cbtnLft,cbtnRgt,cbtnBas,cbtnTop,5,"Continue") CALL MouseDown(mx,my,ms) IF mx>cbtnLft and mxcbtnTop and myWidth or Rgtpnt=endofpar LET line$ = trim$(para$(Lftpnt:Rgtpnt)) CALL PlotTextLJ(txtLft,Basln,line$,Clr) LET Basln = Basln + lnspc LET Lftpnt= min(Rgtpnt+1,endofpar) LOOP until Lftpnt=endofpar END SUB END SUB END MODULE ! --- external support libraries --- ! ---- graphing methods SUB ClipVert(Bas,Top,x1,y1,x2,y2) ! this handles vertical clipping for pixel values LOCAL xd,yd,xm LET yd= y2-y1 LET xd= x2-x1 LET m = xd/yd IF y1>Bas then ! Clip Bas LET x1= x2 + m*(Bas-y2) LET y1= Bas ELSE IF y1Bas then ! Clip Bas LET x2= x1 + m*(Bas-y1) LET y2= Bas ELSE IF y20 then LET lines= round(fWid/xstp) FOR i= 0 to lines LET n = fLft + i*xstp LET wx= Wndx(n) PLOT wx,wTop+1; wx,wBas-1 NEXT i END IF IF ystp>0 then LET lines= round(fHgt/ystp) FOR i= 0 to lines LET n = fBas + i*ystp LET wy= wndy(n) PLOT wLft+1,wy; wRgt-1,wy NEXT i END IF SET COLOR rimClr BOX LINES wLft,wRgt,wBas,wTop END SUB SUB ZeroAxes(wx0,wy0,wLft,wRgt,wBas,wTop,aClr) IF wy0>=wTop and wy0<=wBas then SET COLOR aClr PLOT wLft,wy0; wRgt+3,wy0 DRAW arrow3 with rotate(0) * shift(wRgt+3,wy0) END IF IF wx0>=wLft and wx0<=wRgt then SET COLOR aClr PLOT wx0,wBas; wx0,wTop-3 DRAW arrow3 with rotate(-pi/2) * shift(wx0,wTop-3) END IF END SUB SUB EdgesVrt(wAxis,wBas,wTop,fBas,fTop,first,stp1,stp2,nstp) BOX CLEAR wAxis-35,wAxis-5,wBas+4,wTop-4 BOX CLEAR wAxis- 4,wAxis ,wBas ,wTop CALL VNumberLineTiks(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,-1) CALL VNumberLineLabels(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,-1) END SUB SUB EdgesVrtPi(wAxis,wBas,wTop,fBas,fTop,first,stp1,stp2,nstp) BOX CLEAR wAxis-35,wAxis-5,wBas+4,wTop-4 BOX CLEAR wAxis- 4,wAxis ,wBas ,wTop CALL VNumberLineTiks(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,-1) CALL VNumberLineLabelsPi(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,-1) END SUB SUB EdgesHrz(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp) BOX CLEAR wLft,wRgt,wBas+1,wBas+4 BOX CLEAR wLft-15,wRgt+20,wBas+4,wBas+15 CALL HNumberLineTiks(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,1) CALL HNumberLineLabels(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,1) END SUB SUB EdgesHrzPi(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp) BOX CLEAR wLft,wRgt,wBas+1,wBas+4 BOX CLEAR wLft-15,wRgt+20,wBas+4,wBas+15 CALL HNumberLineTiks(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,1) CALL HNumberLineLabelsPi(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,1) END SUB END MODULE MODULE MathGraphs 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 DECLARE PUBLIC numberlineClr,slotdrkClr,slotlgtClr,slideClr SUB HNumberLineTiks(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,ndir) LOCAL wWid,fWid,ticks,i,n,wx DEF Wndx(fx)= wLft + wWid/fWid*(fx-fLft) ! function to window LET wWid= wRgt-wLft LET fWid= fRgt-fLft SET COLOR numberlineClr IF stp1<>0 or stp2<>0 then PLOT wLft,wBas; wRgt,wBas ! axis line if ticks are on END IF IF stp1>0 then ! short ticks LET ticks= int(fWid/stp1) FOR i= 0 to ticks LET n = first + i*stp1 LET wx= Wndx(n) IF ndir=-1 then PLOT wx,wBas; wx,wBas-2 ELSE IF ndir=1 then PLOT wx,wBas; wx,wBas+2 END IF NEXT i END IF IF stp2>0 then ! long ticks LET ticks= int(fWid/stp2) FOR i= 0 to ticks LET n = first + i*stp2 LET wx= Wndx(n) IF ndir=-1 then PLOT wx,wBas; wx,wBas-4 ELSE IF ndir=1 then PLOT wx,wBas; wx,wBas+4 END IF NEXT i END IF END SUB SUB VNumberLineTiks(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,ndir) LOCAL fy,wHgt,fHgt,ticks,i,n,wy,s,n$,sl,form$,places DEF wndy(fy)= wBas - wHgt/fHgt*(fy-fBas) LET wHgt= wBas-wTop LET fHgt= fTop-fBas SET COLOR numberlineClr IF stp1>0 or stp2>0 then PLOT wAxis,wBas; wAxis,wTop ! Y boundary axis END IF IF stp1>0 then ! short ticks LET ticks= int(fHgt/stp1) FOR i= 0 to ticks LET n = first + i*stp1 LET wy= wndy(n) IF ndir=-1 then PLOT wAxis,wy; wAxis-2,wy ELSE IF ndir=1 then PLOT wAxis,wy; wAxis+2,wy END IF NEXT i END IF IF stp2>0 then ! short ticks LET ticks= int(fHgt/stp2) FOR i= 0 to ticks LET n = first + i*stp2 LET wy= wndy(n) IF ndir=-1 then PLOT wAxis,wy; wAxis-4,wy ELSE IF ndir=1 then PLOT wAxis,wy; wAxis+4,wy END IF NEXT i END IF END SUB SUB VNumberLineLabels(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,ndir) LOCAL fx,wHgt,fHgt,ticks,i,n,wy,s,n$,sl,form$,places DEF wndy(fy)= wBas - wHgt/fHgt*(fy-fBas) LET wHgt= wBas-wTop LET fHgt= fTop-fBas IF ndir=-1 then IF stp1=0 and stp2=0 then LET rgtln= wAxis-3 ELSE LET rgtln= wAxis-6 END IF ELSE IF ndir=1 then IF stp1=0 and stp2=0 then LET rgtln= wAxis+7 ELSE LET rgtln= wAxis+11 END IF END IF SET COLOR numberlineClr IF stp1>0 or stp2>0 then PLOT wAxis,wBas; wAxis,wTop ! Y boundary axis END IF IF nstp>0 then ! labels IF int(nstp)= nstp then ! build format LET form$= "------#" ELSE LET places= abs(int(log10(nstp))) LET form$ = "--%." & repeat$("#",places) END IF CALL SetTextFont(1,9,"normal") LET ticks= int(fHgt/nstp) FOR i= 0 to ticks LET n = first + i*nstp LET n = round(n,7) LET wy= wndy(n) LET s = sgn(n) IF s=0 then LET n$= "0" ! CALL SetTextFont(1,9,"bold") ELSE LET n$= trim$(using$(form$,n)) ! CALL SetTextFont(1,9,"normal") END IF CALL PlotTextRJ(rgtln,wy+3,n$,numberlineClr) NEXT i END IF END SUB SUB VNumberLineLabelsPi(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,ndir) LOCAL fx,wHgt,fHgt,ticks,i,n,wy,s,n$,sl,form$,places DEF wndy(fy)= wBas - wHgt/fHgt*(fy-fBas) LET wHgt= wBas-wTop LET fHgt= fTop-fBas IF ndir=-1 then IF stp1=0 and stp2=0 then LET rgtln= wAxis-3 ELSE LET rgtln= wAxis-6 END IF ELSE IF ndir=1 then IF stp1=0 and stp2=0 then LET rgtln= wAxis+7 ELSE LET rgtln= wAxis+11 END IF END IF SET COLOR numberlineClr IF stp1>0 or stp2>0 then PLOT wAxis,wBas; wAxis,wTop ! Y boundary axis END IF IF nstp>0 then ! labels IF int(nstp)= nstp then ! build format LET form$= "------#" ELSE LET places= abs(int(log10(nstp))) LET form$ = "--%." & repeat$("#",places) END IF CALL SetTextFont(1,9,"normal") LET ticks= int(fHgt/nstp) FOR i= 0 to ticks LET n = first + i*nstp LET n = round(n,7) LET wy= wndy(n) LET s = sgn(n) IF s=0 then LET n$= "0" !CALL SetTextFont(1,9,"bold") ELSE LET n$= trim$(using$(form$,n)) !CALL SetTextFont(1,9,"normal") END IF CALL PlotTextRJ(rgtln,wy+3,n$,numberlineClr) NEXT i END IF END SUB SUB HNumberLineLabels(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,ndir) LOCAL wWid,fWid,places,form$,ticks,i,n,wx,s,n$,sl,left,basln DEF Wndx(fx)= wLft + wWid/fWid*(fx-fLft) ! function to window LET wWid= wRgt-wLft LET fWid= fRgt-fLft IF ndir=-1 then IF stp1=0 and stp2=0 then LET basln= wBas-3 ELSE LET basln= wBas-7 END IF ELSE IF ndir=1 then IF stp1=0 and stp2=0 then LET basln= wBas+10 ELSE LET basln= wBas+14 END IF END IF SET COLOR numberlineClr IF stp1<>0 or stp2<>0 then PLOT wLft,wBas; wRgt,wBas ! axis line if ticks are on END IF IF nstp>0 then ! labels IF int(nstp)= nstp then ! build format LET form$ = "----#" ELSE LET places = abs(int(log10(nstp))) LET nstp$= str$(nstp) LET p = pos(nstp$,".") IF p>0 then LET l = len(nstp$) LET dec$ = nstp$(p+1:l) LET places= len(dec$) LET form$ = "--%." & repeat$("#",places) ELSE LET form$ = "---%" END IF END IF CALL SetTextFont(1,9,"normal") LET ticks= round(fWid/nstp) FOR i= 0 to ticks LET n = first + i*nstp LET n = round(n,6) LET wx= Wndx(n) LET s = sgn(n) IF s=0 then LET n$= "0" ELSE LET n$= trim$(using$(form$,abs(n))) END IF CALL StringWidth(n$,sl) LET left= round(wx - sl/2) + 1 CALL PlotTextLJ(left,basln,n$,numberlineClr) IF s=-1 then CALL PlotTextRJ(left-1,basln,"-",numberlineClr) NEXT i END IF END SUB SUB HNumberLineLabelsPi(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,ndir) LOCAL wWid,fWid,places,form$,ticks,i,n,wx,abn,s,n$,sl,lft$,rgt$,left,basln DEF pi$= "w" DEF Wndx(fx)= wLft + wWid/fWid*(fx-fLft) ! function to window LET wWid= wRgt-wLft LET fWid= fRgt-fLft IF ndir=-1 then IF stp1=0 and stp2=0 then LET basln= wBas-3 ELSE LET basln= wBas-7 END IF ELSE IF ndir=1 then IF stp1=0 and stp2=0 then LET basln= wBas+10 ELSE LET basln= wBas+14 END IF END IF SET COLOR numberlineClr IF stp1<>0 or stp2<>0 then PLOT wLft,wBas; wRgt,wBas ! axis line if ticks are on END IF IF nstp>0 then ! labels IF int(nstp)= nstp then ! build format LET form$ = "----#" ELSE LET places= abs(int(log10(nstp))) LET form$ = "--%." & repeat$("#",places) END IF CALL SetTextFont(1,9,"normal") LET ticks= int(fWid/nstp) FOR n= fLft to fRgt step nstp LET n = round(n,5) LET wx = Wndx(n) LET abn= abs(n) LET s = sgn(n) CALL SetTextFont(1,9,"normal") SELECT CASE abn CASE 0 LET n$= "0" !CALL SetTextFont(1,9,"bold") CASE 0.5 LET n$= pi$ & "/2" CASE 1 LET n$= pi$ CASE 1.5 LET n$= "3" & pi$ & "/2" CASE 2.5 LET n$= "5" & pi$ & "/2" CASE 3.5 LET n$= "7" & pi$ & "/2" CASE 2,3,4,5,6,7,8,9,10,11,12 LET n$= trim$(str$(abn)) & pi$ CASE else END SELECT CALL StringWidth(n$,sl) LET left= wx - sl/2 + 1 LET p= pos(n$,pi$) LET l= len(n$) IF p=0 then CALL PlotTextLJ(left,basln,n$,numberlineClr) ELSE IF p=1 then LET n$= n$(2:l) DRAW pi9 with shift(left,basln) CALL PlotTextLJ(left+8,basln,n$,numberlineClr) ELSE IF p=l then LET n$= n$(1:l-1) CALL PlotTextLJ(left,basln,n$,numberlineClr) CALL StringWidth(n$,sw) DRAW pi9 with shift(left+sw,basln) ELSE LET Lft$= n$(1:p-1) LET Rgt$= n$(p+1:l) CALL PlotTextLJ(left,basln,Lft$,numberlineClr) CALL StringWidth(Lft$,sw) DRAW pi9 with shift(left+sw,basln) CALL PlotTextLJ(left+sw+8,basln,Rgt$,numberlineClr) END IF IF s=-1 then CALL PlotTextRJ(left-1,basln,"-",numberlineClr) NEXT n END IF END SUB END MODULE ! ----- library slider subs MODULE v1slider PUBLIC v1axis,v1wLft,v1wRgt,v1wBas,v1wTop,v1wHgt,v1sBas,v1sTop PUBLIC v1fBas,v1fTop,v1First,v1STik,v1LTik,v1Label,v1fHgt,v1yf,v1y2,v1y4,v1yl PUBLIC v1fRatio,v1wRatio,v1name$,v1m,v1form$,v1Clr,v1slot$ DEF v1fncy(wy)= v1fBas + v1fRatio*(v1wBas-wy) ! window to function DEF v1wndy(fy)= v1wBas + v1wRatio*(fy-v1fBas) ! function to window SUB v1SliderVariables CALL vWnd(v1axis,v1wLft,v1wRgt,v1wBas,v1wTop,v1wHgt,v1sBas,v1sTop) CALL vFnc(v1fBas,v1fTop,v1fHgt) CALL vRatios(v1fHgt,v1wHgt,v1fRatio,v1wRatio) END SUB SUB v1DrawSlider(n) BOX CLEAR v1wLft,v1wRgt,v1wBas+15,v1wTop-20 CALL SliderSlotV(v1wBas,v1wTop,v1axis) CALL SliderAxisVrt(v1wBas,v1wTop,v1axis,v1fBas,v1fTop,v1first,v1STik,v1LTik,v1Label) BOX KEEP v1axis,v1wRgt,v1sBas,v1sTop in v1slot$ CALL PlotVSliderName(v1axis,v1wBas,v1name$,v1Clr) CALL v1Mark(n) END SUB SUB v1Mark(n) LET wy= v1wBas - v1wRatio*(n-v1fBas) BOX SHOW v1slot$ at v1axis,v1sBas CALL SliderKnobV(v1wRgt-5,wy) CALL PlotVSliderValue(v1axis,v1wTop-5,using$(v1form$,n*v1m),v1Clr) END SUB END MODULE MODULE h0slider PUBLIC h0axis,h0wLft,h0wRgt,h0wBas,h0wTop,h0wWid,h0sLft,h0sRgt PUBLIC h0fLft,h0fRgt,h0fWid,h0First,h0STik,h0LTik,h0Label PUBLIC h0fRatio,h0wRatio,h0name$,h0m,h0form$,h0Clr,h0slot$ DECLARE PUBLIC worklft,workrgt DEF h0Fncx(wx)= h0fLft + h0fRatio*(wx-h0wLft) ! window to function DEF h0Wndx(fx)= h0wLft + h0wRatio*(fx-h0fLft) ! function to window SUB h0SliderVariables CALL hWnd(h0axis,h0wLft,h0wRgt,h0wBas,h0wTop,h0wWid,h0sLft,h0sRgt) CALL hFnc(h0fLft,h0fRgt,h0fWid) CALL hRatios(h0fWid,h0wWid,h0fRatio,h0wRatio) END SUB SUB h0DrawSlider(h0name$,n) BOX CLEAR h0wLft-20,h0wRgt+35,h0wBas,h0wTop CALL SliderSlotH(h0wLft,h0wRgt,h0axis) CALL SliderAxisHrz(h0wLft,h0wRgt,h0axis,h0fLft,h0fRgt,h0First,h0STik,h0LTik,h0Label) BOX KEEP h0sLft,h0sRgt,h0wBas,h0axis in h0slot$ CALL PlotSliderName(h0wLft,h0wBas,h0name$,h0Clr) CALL h0Mark(n) END SUB SUB h0Mark(n) LET wx= h0wLft + h0wRatio*(n-h0fLft) BOX SHOW h0slot$ at h0sLft,h0wBas CALL SliderKnob(wx,h0wBas-5) CALL PlotSliderValue(h0wRgt,h0wBas,using$(h0form$,n*h0m),h0Clr) END SUB END MODULE MODULE h1slider PUBLIC h1axis,h1wLft,h1wRgt,h1wBas,h1wTop,h1wWid,h1sLft,h1sRgt PUBLIC h1fLft,h1fRgt,h1fWid,h1First,h1STik,h1LTik,h1Label PUBLIC h1fRatio,h1wRatio,h1name$,h1m,h1form$,h1Clr,h1slot$ DEF h1Fncx(wx)= h1fLft + h1fRatio*(wx-h1wLft) ! window to function DEF h1Wndx(fx)= h1wLft + h1wRatio*(fx-h1fLft) ! function to window SUB h1SliderVariables CALL hWnd(h1axis,h1wLft,h1wRgt,h1wBas,h1wTop,h1wWid,h1sLft,h1sRgt) CALL hFnc(h1fLft,h1fRgt,h1fWid) CALL hRatios(h1fWid,h1wWid,h1fRatio,h1wRatio) END SUB SUB h1DrawSlider(h1name$,n) BOX CLEAR h1wLft-20,h1wRgt+35,h1wBas,h1wTop CALL SliderSlotH(h1wLft,h1wRgt,h1axis) CALL SliderAxisHrz(h1wLft,h1wRgt,h1axis,h1fLft,h1fRgt,h1First,h1STik,h1LTik,h1Label) BOX KEEP h1sLft,h1sRgt,h1wBas,h1axis in h1slot$ CALL PlotSliderName(h1wLft,h1wBas,h1name$,h1Clr) CALL h1Mark(n) END SUB SUB h1Mark(n) LET wx= h1wLft + h1wRatio*(n-h1fLft) BOX SHOW h1slot$ at h1sLft,h1wBas CALL SliderKnob(wx,h1wBas-5) CALL PlotSliderValue(h1wRgt,h1wBas,using$(h1form$,n*h1m),h1Clr) END SUB END MODULE MODULE h2slider PUBLIC h2axis,h2wLft,h2wRgt,h2wBas,h2wTop,h2wWid,h2sLft,h2sRgt PUBLIC h2fLft,h2fRgt,h2fWid,h2First,h2STik,h2LTik,h2Label PUBLIC h2fRatio,h2wRatio,h2name$,h2m,h2form$,h2Clr,h2slot$ DEF h2Fncx(wx)= h2fLft + h2fRatio*(wx-h2wLft) ! window to function DEF h2Wndx(fx)= h2wLft + h2wRatio*(fx-h2fLft) ! function to window SUB h2SliderVariables CALL hWnd(h2axis,h2wLft,h2wRgt,h2wBas,h2wTop,h2wWid,h2sLft,h2sRgt) CALL hFnc(h2fLft,h2fRgt,h2fWid) CALL hRatios(h2fWid,h2wWid,h2fRatio,h2wRatio) END SUB SUB h2DrawSlider(h2name$,n) BOX CLEAR h2wLft-20,h2wRgt+35,h2wBas,h2wTop CALL SliderSlotH(h2wLft,h2wRgt,h2axis) CALL SliderAxisHrz(h2wLft,h2wRgt,h2axis,h2fLft,h2fRgt,h2First,h2STik,h2LTik,h2Label) BOX KEEP h2sLft,h2sRgt,h2wBas,h2axis in h2slot$ CALL PlotSliderName(h2wLft,h2wBas,h2name$,h2Clr) CALL h2Mark(n) END SUB SUB h2Mark(n) LET wx= h2wLft + h2wRatio*(n-h2fLft) BOX SHOW h2slot$ at h2sLft,h2wBas CALL SliderKnob(wx,h2wBas-5) CALL PlotSliderValue(h2wRgt,h2wBas,using$(h2form$,n*h2m),h2Clr) END SUB END MODULE MODULE h3slider PUBLIC h3axis,h3wLft,h3wRgt,h3wBas,h3wTop,h3wWid,h3sLft,h3sRgt PUBLIC h3fLft,h3fRgt,h3fWid,h3First,h3STik,h3LTik,h3Label PUBLIC h3fRatio,h3wRatio,h3name$,h3m,h3form$,h3Clr,h3slot$ DEF h3Fncx(wx)= h3fLft + h3fRatio*(wx-h3wLft) ! window to function DEF h3Wndx(fx)= h3wLft + h3wRatio*(fx-h3fLft) ! function to window SUB h3SliderVariables CALL hWnd(h3axis,h3wLft,h3wRgt,h3wBas,h3wTop,h3wWid,h3sLft,h3sRgt) CALL hFnc(h3fLft,h3fRgt,h3fWid) CALL hRatios(h3fWid,h3wWid,h3fRatio,h3wRatio) END SUB SUB h3DrawSlider(h3name$,n) BOX CLEAR h3wLft-20,h3wRgt+35,h3wBas,h3wTop CALL SliderSlotH(h3wLft,h3wRgt,h3axis) CALL SliderAxisHrz(h3wLft,h3wRgt,h3axis,h3fLft,h3fRgt,h3First,h3STik,h3LTik,h3Label) BOX KEEP h3sLft,h3sRgt,h3wBas,h3axis in h3slot$ CALL PlotSliderName(h3wLft,h3wBas,h3name$,h3Clr) CALL h3Mark(n) END SUB SUB h3Mark(n) LET wx= h3wLft + h3wRatio*(n-h3fLft) BOX SHOW h3slot$ at h3sLft,h3wBas CALL SliderKnob(wx,h3wBas-5) CALL PlotSliderValue(h3wRgt,h3wBas,using$(h3form$,n*h3m),h3Clr) END SUB END MODULE MODULE h4slider PUBLIC h4axis,h4wLft,h4wRgt,h4wBas,h4wTop,h4wWid,h4sLft,h4sRgt PUBLIC h4fLft,h4fRgt,h4fWid,h4First,h4STik,h4LTik,h4Label PUBLIC h4fRatio,h4wRatio,h4name$,h4m,h4form$,h4Clr,h4slot$ DEF h4Fncx(wx)= h4fLft + h4fRatio*(wx-h4wLft) ! window to function DEF h4Wndx(fx)= h4wLft + h4wRatio*(fx-h4fLft) ! function to window SUB h4SliderVariables CALL hWnd(h4axis,h4wLft,h4wRgt,h4wBas,h4wTop,h4wWid,h4sLft,h4sRgt) CALL hFnc(h4fLft,h4fRgt,h4fWid) CALL hRatios(h4fWid,h4wWid,h4fRatio,h4wRatio) END SUB SUB h4DrawSlider(h4name$,n) BOX CLEAR h4wLft-20,h4wRgt+35,h4wBas,h4wTop CALL SliderSlotH(h4wLft,h4wRgt,h4axis) CALL SliderAxisHrz(h4wLft,h4wRgt,h4axis,h4fLft,h4fRgt,h4First,h4STik,h4LTik,h4Label) BOX KEEP h4sLft,h4sRgt,h4wBas,h4axis in h4slot$ CALL PlotSliderName(h4wLft,h4wBas,h4name$,h4Clr) CALL h4Mark(n) END SUB SUB h4Mark(n) LET wx= h4wLft + h4wRatio*(n-h4fLft) BOX SHOW h4slot$ at h4sLft,h4wBas CALL SliderKnob(wx,h4wBas-5) CALL PlotSliderValue(h4wRgt,h4wBas,using$(h4form$,n*h4m),h4Clr) END SUB END MODULE MODULE h5slider PUBLIC h5axis,h5wLft,h5wRgt,h5wBas,h5wTop,h5wWid,h5sLft,h5sRgt PUBLIC h5fLft,h5fRgt,h5fWid,h5First,h5STik,h5LTik,h5Label PUBLIC h5fRatio,h5wRatio,h5name$,h5m,h5form$,h5Clr,h5slot$ DEF h5Fncx(wx)= h5fLft + h5fRatio*(wx-h5wLft) ! window to function DEF h5Wndx(fx)= h5wLft + h5wRatio*(fx-h5fLft) ! function to window SUB h5SliderVariables CALL hWnd(h5axis,h5wLft,h5wRgt,h5wBas,h5wTop,h5wWid,h5sLft,h5sRgt) CALL hFnc(h5fLft,h5fRgt,h5fWid) CALL hRatios(h5fWid,h5wWid,h5fRatio,h5wRatio) END SUB SUB h5DrawSlider(h5name$,n) BOX CLEAR h5wLft-20,h5wRgt+35,h5wBas,h5wTop CALL SliderSlotH(h5wLft,h5wRgt,h5axis) CALL SliderAxisHrz(h5wLft,h5wRgt,h5axis,h5fLft,h5fRgt,h5First,h5STik,h5LTik,h5Label) BOX KEEP h5sLft,h5sRgt,h5wBas,h5axis in h5slot$ CALL PlotSliderName(h5wLft,h5wBas,h5name$,h5Clr) CALL h5Mark(n) END SUB SUB h5Mark(n) LET wx= h5wLft + h5wRatio*(n-h5fLft) BOX SHOW h5slot$ at h5sLft,h5wBas CALL SliderKnob(wx,h5wBas-5) CALL PlotSliderValue(h5wRgt,h5wBas,using$(h5form$,n*h5m),h5Clr) END SUB END MODULE MODULE h6slider PUBLIC h6axis,h6wLft,h6wRgt,h6wBas,h6wTop,h6wWid,h6sLft,h6sRgt PUBLIC h6fLft,h6fRgt,h6fWid,h6First,h6STik,h6LTik,h6Label PUBLIC h6fRatio,h6wRatio,h6name$,h6m,h6form$,h6Clr,h6slot$ DEF h6Fncx(wx)= h6fLft + h6fRatio*(wx-h6wLft) ! window to function DEF h6Wndx(fx)= h6wLft + h6wRatio*(fx-h6fLft) ! function to window SUB h6SliderVariables CALL hWnd(h6axis,h6wLft,h6wRgt,h6wBas,h6wTop,h6wWid,h6sLft,h6sRgt) CALL hFnc(h6fLft,h6fRgt,h6fWid) CALL hRatios(h6fWid,h6wWid,h6fRatio,h6wRatio) END SUB SUB h6DrawSlider(h6name$,n) BOX CLEAR h6wLft-20,h6wRgt+35,h6wBas,h6wTop CALL SliderSlotH(h6wLft,h6wRgt,h6axis) CALL SliderAxisHrz(h6wLft,h6wRgt,h6axis,h6fLft,h6fRgt,h6First,h6STik,h6LTik,h6Label) BOX KEEP h6sLft,h6sRgt,h6wBas,h6axis in h6slot$ CALL PlotSliderName(h6wLft,h6wBas,h6name$,h6Clr) CALL h6Mark(n) END SUB SUB h6Mark(n) LET wx= h6wLft + h6wRatio*(n-h6fLft) BOX SHOW h6slot$ at h6sLft,h6wBas CALL SliderKnob(wx,h6wBas-5) CALL PlotSliderValue(h6wRgt,h6wBas,using$(h6form$,n*h6m),h6Clr) END SUB END MODULE MODULE h7slider PUBLIC h7axis,h7wLft,h7wRgt,h7wBas,h7wTop,h7wWid,h7sLft,h7sRgt PUBLIC h7fLft,h7fRgt,h7fWid,h7First,h7STik,h7LTik,h7Label PUBLIC h7fRatio,h7wRatio,h7name$,h7m,h7form$,h7Clr,h7slot$ DECLARE PUBLIC worklft,workrgt DEF h7Fncx(wx)= h7fLft + h7fRatio*(wx-h7wLft) ! window to function DEF h7Wndx(fx)= h7wLft + h7wRatio*(fx-h7fLft) ! function to window SUB h7SliderVariables CALL hWnd(h7axis,h7wLft,h7wRgt,h7wBas,h7wTop,h7wWid,h7sLft,h7sRgt) CALL hFnc(h7fLft,h7fRgt,h7fWid) CALL hRatios(h7fWid,h7wWid,h7fRatio,h7wRatio) END SUB SUB h7DrawSlider(h7name$,n) BOX CLEAR h7wLft-20,h7wRgt+35,h7wBas,h7wTop CALL SliderSlotH(h7wLft,h7wRgt,h7axis) CALL SliderAxisHrz(h7wLft,h7wRgt,h7axis,h7fLft,h7fRgt,h7First,h7STik,h7LTik,h7Label) BOX KEEP h7sLft,h7sRgt,h7wBas,h7axis in h7slot$ CALL PlotSliderName(h7wLft,h7wBas,h7name$,h7Clr) CALL h7Mark(n) END SUB SUB h7Mark(n) LET wx= h7wLft + h7wRatio*(n-h7fLft) BOX SHOW h7slot$ at h7sLft,h7wBas CALL SliderKnob(wx,h7wBas-5) CALL PlotSliderValue(h7wRgt,h7wBas,using$(h7form$,n*h7m),h7Clr) END SUB END MODULE MODULE SliderParts 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 DECLARE PUBLIC numberlineClr,slotdrkClr,slotlgtClr,slideClr ! ------------- SUB vWnd(axx,wLft,wRgt,wBas,wTop,wHgt,sBas,sTop) LET wHgt = wBas-wTop LET wLft = axx-13 LET wRgt = axx+13 LET sBas = wBas+5 LET sTop = wTop-5 END SUB SUB vFnc(fBas,fTop,fHgt) LET fHgt = fTop-fBas END SUB SUB vRatios(vfHgt,vwHgt,vfRatio,vwRatio) LET vfRatio= vfHgt/vwHgt LET vwRatio= vwHgt/vfHgt END SUB SUB PlotVSliderName(Mid,Bas,name$,Clr) CALL SetTextFont(1,12,"bold") CALL PlotTextCJ(Mid,Bas+13,name$,Clr) END SUB SUB PlotVSliderValue(Mid,Bas,value$,Clr) CALL SetTextFont(1,12,"bold") BOX CLEAR mid-20,mid+20,Bas,Bas-13 CALL PlotTextCJ(Mid,Bas-3,trim$(value$),Clr) END SUB SUB SliderslotV(wb,wt,axis) LET sx= axis+7 BOX CLEAR axis+1,axis+14,wb+4,wt-4 SET COLOR slotdrkClr BOX AREA sx,sx-1,wb+1,wt-1 SET COLOR slotlgtClr PLOT sx+1,wb+1; sx+1,wt-1 END SUB SUB PhaseSlotV(sLft,sRgt,syb,syt,sx,sliderV$) BOX CLEAR sLft,sRgt,syb,syt SET COLOR white PLOT sx+1,syb-4; sx+1,syt+4 BOX KEEP sLft,sRgt,syb,syt in sliderV$ END SUB SUB SliderAxisVrt(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp) CALL VNumberLineTiks(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,-1) CALL VNumberLineLabels(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,-1) END SUB SUB SliderKnobV(kx,ky) SET COLOR black BOX AREA kx-3,kx+4,ky+3,ky-2 BOX AREA kx-4,kx+5,ky+2,ky-1 SET COLOR litmid BOX AREA kx-3,kx+3,ky+2,ky-2 BOX AREA kx-4,kx+4,ky+1,ky-1 SET COLOR white PLOT kx-4,ky; kx-6,ky SET COLOR litgry PLOT kx-3,ky-2; kx+2,ky-2 PLOT kx-3,ky+2; kx+2,ky+2 PLOT kx-4,ky-1; kx-4,ky+1 SET COLOR white PLOT kx-2,ky; kx+2,ky END SUB ! ------------- SUB hWnd(axy,wLft,wRgt,wBas,wTop,wWid,sLft,sRgt) LET wWid = wRgt-wLft LET wTop = axy-13 LET wBas = axy+13 LET sLft = wLft-5 LET sRgt = wRgt+5 END SUB SUB hFnc(fLft,fRgt,fWid) LET fWid = fRgt-fLft END SUB SUB hRatios(hfWid,hwWid,hfRatio,hwRatio) LET hfRatio= hfWid/hwWid LET hwRatio= hwWid/hfWid END SUB SUB PlotSliderName(Lft,Bas,name$,Clr) CALL SetTextFont(1,12,"bold") CALL SuperSubScriptRJ(Lft-5,Bas-3,name$,Clr) END SUB SUB PlotSliderValue(Rgt,Bas,value$,Clr) CALL SetTextFont(1,12,"bold") BOX CLEAR Rgt+3,Rgt+80,Bas,Bas-13 CALL PlotTextLJ(Rgt+7,Bas-3,trim$(value$),Clr) END SUB SUB SliderSlotH(wl,wr,axis) LET sy= axis+7 BOX CLEAR wl-4,wr+4,axis+14,axis+1 SET COLOR slotdrkClr BOX AREA wl-1,wr+1,sy,sy-1 SET COLOR slotlgtClr PLOT wl-1,sy+1; wr+1,sy+1 END SUB SUB SliderAxisHrz(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp) CALL HNumberLineTiks(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,-1) CALL HNumberLineLabels(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,-1) END SUB SUB SliderAxisHrzPi(wLft,wRgt,axy,fLft,fRgt,first,stp1,stp2,nstp) LOCAL wWid,fWid,n,n$,left,sl,places,form$ DEF pi$= "w" DEF Fncx(wx)= fLft + fWid*(wx-wLft)/wWid ! win to func DEF Wndx(fx)= round(wLft + wWid*(fx-fLft)/fWid) ! func to win LET wWid= wRgt-wLft LET fWid= fRgt-fLft CALL HNumberLineTiks(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,-1) CALL HNumberLineLabelsPi(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,-1) END SUB SUB SliderKnob(kx,ky) IF colorscheme=1 then SET COLOR black BOX AREA kx-2,kx+3,ky+4,ky-3 BOX AREA kx-1,kx+2,ky+5,ky-3 SET COLOR drkmid BOX AREA kx-2,kx+2,ky+2,ky-3 BOX AREA kx-1,kx+1,ky+4,ky-4 SET COLOR litgry PLOT kx-2,ky-3; kx-2,ky+2 PLOT kx+2,ky-3; kx+2,ky+2 PLOT kx-1,ky-4; kx+1,ky-4 SET COLOR black PLOT kx,ky-4; kx,ky-6 SET COLOR white PLOT kx,ky+3; kx,ky-2 ELSE SET COLOR black BOX AREA kx-2,kx+3,ky+4,ky-3 BOX AREA kx-1,kx+2,ky+5,ky-4 SET COLOR litmid BOX AREA kx-2,kx+2,ky+2,ky-3 BOX AREA kx-1,kx+1,ky+4,ky-4 SET COLOR litgry PLOT kx-2,ky-3; kx-2,ky+2 PLOT kx+2,ky-3; kx+2,ky+2 PLOT kx-1,ky-4; kx+1,ky-4 SET COLOR white PLOT kx,ky-4; kx,ky-6 PLOT kx,ky+3; kx,ky-2 END IF END SUB ! PICTURE KnobH(Clr) ! SET COLOR drkgry ! PLOT -2,-2; -2,3 ! PLOT -1,-3; -1,4 ! PLOT 0,-5; 0,4 ! PLOT 1,-3; 1,4 ! PLOT 2,-2; 2,3 ! SET COLOR white ! PLOT 0,-5; 0,2 ! END PICTURE ! PICTURE PhaseMark(Clr) ! SET COLOR Clr ! PLOT -2,-2; -2,2 ! PLOT -1,-3; -1,3 ! PLOT 0,-5; 0,5 ! PLOT 1,-3; 1,3 ! PLOT 2,-2; 2,2 ! END PICTURE END MODULE MODULE TypeSetting 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 ! ---- type subs ---- SUB PlotTextLJ(tx,ty,t$,Clr) DECLARE PUBLIC M68kFlag SET COLOR Clr IF M68kFlag=1 then PLOT TEXT, AT tx,ty: t$ ! 4.04 ELSE PLOT TEXT, AT tx,ty+1: t$ ! TB5 END IF END SUB SUB PlotTextCJ(midb,ty,t$,Clr) CALL StringWidth(t$,sl) LET Lft= midb - int(sl/2) CALL PlotTextLJ(Lft,ty,t$,Clr) END SUB SUB PlotTextRJ(Rgt,ty,t$,Clr) CALL StringWidth(t$,sl) LET Lft= Rgt - sl CALL PlotTextLJ(Lft,ty,t$,Clr) END SUB SUB DropTextLJ(tx,ty,t$,Clr) CALL PlotTextLJ(tx+1,ty+1,t$,black) CALL PlotTextLJ(tx,ty,t$,Clr) END SUB SUB DropTextCJ(midb,ty,t$,Clr) CALL StringWidth(t$,sl) LET Lft= midb - int(sl/2) CALL DropTextLJ(Lft,ty,t$,Clr) END SUB SUB DropTextRJ(Rgt,ty,t$,Clr) CALL StringWidth(t$,sl) LET Lft= Rgt - sl CALL DropTextLJ(Lft,ty,t$,Clr) END SUB SUB AlignEqual(ex,ey,eq$,ec) LET e = pos(eq$,"=") LET Lft$= eq$(1:e) CALL StringWidth(Lft$,sl) CALL PlotTextLJ(ex-sl,ey,eq$,ec) END SUB SUB AlignDot(dx,dy,n$,dc) LET d = pos(n$,".") LET Lft$= n$(1:d) CALL StringWidth(Lft$,sl) CALL PlotTextLJ(dx-sl,dy,n$,dc) END SUB SUB MeasureSuperSub(in$,pix) LET out$= in$ LET l = len(out$) LET extra$= "" FOR i= 1 to l LET chr$= out$(i:i) IF chr$="^" or chr$="_" or chr$="[" or chr$="]" then LET extra$= extra$ & chr$ !LET out$(i:i)= "" END IF NEXT i CALL SetTextFont(1,12,"bold") CALL StringWidth(in$,sl) CALL StringWidth(extra$,el) LET pix= sl-el END SUB SUB SuperSubScriptLJ(sx,sy,super$,sClr) CALL SuperSubScript(sx,sy,super$,sClr) END SUB SUB SuperSubScriptRJ(sx,sy,super$,sClr) CALL MeasureSuperSub(super$,sl) LET Lft= sx - sl CALL SuperSubScript(Lft,sy,super$,sClr) END SUB SUB SuperSubScriptCJ(sx,sy,super$,sClr) CALL MeasureSuperSub(super$,sl) LET Lft= sx - int(sl/2) CALL SuperSubScript(Lft,sy,super$,sClr) END SUB SUB SuperSubScript(sx,sy,super$,sClr) LOCAL p,last,p0,p1,p2,ll,el,rl LOCAL Lft$,exp$,Rgt$ LET Lft$,exp$,Rgt$= "" LET p0 = pos(super$,"^") LET p1 = pos(super$,"_") LET last= len(super$) CALL SetTextFont(1,12,"bold") IF p0=0 and p1=0 then CALL PlotTextLJ(sx,sy,super$,sClr) ELSE IF p0=0 then LET p= p1 ELSE IF p1=0 then LET p= p0 ELSE LET p= min(p1,p0) END IF LET Lft$= super$(1:p-1) LET p2 = pos(super$,"]") IF p2=0 then EXIT SUB LET exp$= super$(p+2:p2-1) LET Rgt$= super$(p2+1:last) CALL StringWidth(Lft$,ll) CALL PlotTextLJ(sx,sy,Lft$,sClr) CALL SetTextFont(1,9,"bold") CALL StringWidth(exp$,el) IF p0=p then CALL PlotTextLJ(sx+ll,sy-5,exp$,sClr) ELSE IF p1=p then CALL PlotTextLJ(sx+ll,sy+3,exp$,sClr) END IF CALL SetTextFont(1,12,"bold") IF Rgt$<>"" then CALL SuperSubScriptLJ(sx+ll+el,sy,Rgt$,sClr) END IF END IF END SUB SUB CmplxStr(cmplx$,real,imag) ! Numeric to text LET x$= using$("-%.##",round(real,2)) LET y$= using$("%.##",abs(round(imag,2))) IF imag<0 then LET sign$= " - " else LET sign$= " + " LET cmplx$= "( " & x$ & sign$ & y$ & " i )" END SUB SUB CmplxText(Lft,Bas,rl,im,Clr) LET rldot = Lft+35 LET imdot = rldot+50 LET ix = imdot+20 LET txtrl$= trim$(using$("--%.##",rl)) LET txtim$= trim$(using$("++%.##",im)) CALL PlotTextLJ(Lft,Bas,"(",Clr) CALL AlignDot(rldot,Bas,txtrl$,Clr) CALL AlignDot(imdot,Bas,txtim$,Clr) CALL PlotTextLJ(ix,Bas,"i )",Clr) END SUB END MODULE MODULE gPi SHARE gPi(0:7,0:9) SHARE piwid,pihgt LET piwid= 10 LET pihgt= 7 MAT READ gPi DATA 0,0,0,0,0,0,0,1,1,0 DATA 0,1,1,1,1,1,1,1,0,0 DATA 1,1,1,1,0,0,1,1,0,0 DATA 0,0,1,1,0,0,1,1,0,0 DATA 0,0,1,1,0,0,1,1,0,0 DATA 0,0,1,1,0,0,1,1,0,0 DATA 0,0,1,1,0,0,1,1,0,1 DATA 0,1,1,0,0,0,0,1,1,0 SUB SwapPi(lft,bas,t$,c$,Clr) LET l= len(t$) LET x= lft FOR i= 1 to l LET ch$= t$(i:i) IF ch$=c$ then CALL DrawPi12(x,bas,Clr) LET x= x+piwid ELSE CALL PlotTextLJ(x,bas,ch$,Clr) CALL StringWidth(ch$,sw) LET x= x+sw END IF NEXT i END SUB SUB DrawPi12(lft,bas,Clr) SET COLOR Clr LET top= bas-pihgt FOR row= 0 to 7 LET wy= top+row FOR col= 0 to 9 LET bit= gPi(row,col) IF bit=1 then LET wx= lft+col PLOT wx,wy END IF NEXT col NEXT row END SUB END MODULE MODULE Lambda SHARE lambda(0:8,0:8) SHARE lamdawid,lamdahgt LET lamdawid= 8 LET lamdahgt= 8 MAT READ lambda DATA 0,1,1,0,0,0,0,0,0 DATA 1,0,1,1,0,0,0,0,0 DATA 0,0,0,1,1,0,0,0,0 DATA 0,0,0,1,1,0,0,0,0 DATA 0,0,0,1,1,1,0,0,0 DATA 0,0,1,1,1,1,0,0,0 DATA 0,1,1,0,0,1,1,0,0 DATA 1,1,0,0,0,1,1,0,1 DATA 1,0,0,0,0,0,1,1,0 SUB DrawLam(lft,bas,Clr) SET COLOR Clr LET top= bas-8 FOR row= 0 to 8 LET wy= top+row FOR col= 0 to 8 LET bit= lambda(row,col) IF bit=1 then LET wx= lft+col PLOT wx,wy END IF NEXT col NEXT row END SUB END MODULE MODULE Omega SHARE omega(0:6,0:9) SHARE omegawid,omegahgt LET omegawid= 10 LET omegahgt= 6 MAT READ omega DATA 0,1,1,0,0,0,0,1,1,0 DATA 1,1,0,0,0,0,0,0,1,1 DATA 1,1,0,0,1,1,0,0,1,1 DATA 1,1,0,0,1,1,0,0,1,1 DATA 1,1,0,0,1,1,0,0,1,1 DATA 0,1,1,1,1,1,1,1,1,0 DATA 0,0,1,1,0,0,1,1,0,0 SUB SwapOmega(lft,bas,t$,c$,Clr) LET l= len(t$) LET x= lft FOR i= 1 to l LET ch$= t$(i:i) IF ch$=c$ then CALL DrawOmega12(x,bas,Clr) LET x= x+omegawid ELSE CALL PlotTextLJ(x,bas,ch$,Clr) CALL StringWidth(ch$,sw) LET x= x+sw END IF NEXT i END SUB SUB DrawOmega12(lft,bas,Clr) SET COLOR Clr LET top= bas-omegahgt FOR row= 0 to 6 LET wy= top+row FOR col= 0 to 9 LET bit= omega(row,col) IF bit=1 then LET wx= lft+col PLOT wx,wy END IF NEXT col NEXT row END SUB END MODULE MODULE phi SHARE phi(0:10,0:6) SHARE phiwid LET phiwid= 7 MAT READ phi DATA 0,0,0,1,0,0,0 DATA 0,0,0,1,0,0,0 DATA 0,1,1,1,1,1,0 DATA 1,1,0,1,0,1,1 DATA 1,1,0,1,0,1,1 DATA 1,1,0,1,0,1,1 DATA 1,1,0,1,0,1,1 DATA 1,1,0,1,0,1,1 DATA 0,1,1,1,1,1,0 DATA 0,0,0,1,0,0,0 DATA 0,0,0,1,0,0,0 SUB SwapPhi(lft,bas,t$,c$,Clr) LET l= len(t$) LET x= lft FOR i= 1 to l LET ch$= t$(i:i) IF ch$=c$ then CALL DrawPhi12(x,bas,Clr) LET x= x+phiwid ELSE CALL PlotTextLJ(x,bas,ch$,Clr) CALL StringWidth(ch$,sw) LET x= x+sw END IF NEXT i END SUB SUB DrawPhi12(lft,bas,Clr) SET COLOR Clr LET top= bas-9 FOR row= 0 to 10 LET wy= top+row FOR col= 0 to 6 LET bit= phi(row,col) IF bit=1 then LET wx= lft+col PLOT wx,wy END IF NEXT col NEXT row END SUB END MODULE MODULE GraphParts ! ---- visual parts PICTURE arrow2 PLOT 2,0; 0, 2; 0,-2; 2,0 PLOT 0,2; 0,-2 PLOT 1,1; 1,-1 END PICTURE PICTURE arrow3 PLOT 3, 0; 0,-3; 0,3; 3,0 PLOT 1,-2; 1, 2 PLOT 2,-1; 2, 1 END PICTURE PICTURE arrow4 PLOT -2,-2; -2,2; 0,0; -2,-2 PLOT -3,-3; -3,3; 0,0; -3,-3 PLOT -4,-4; -4,4; 0,0; -4,-4 END PICTURE PICTURE pi9 PLOT 0,-4; 1,-5; 5,-5; 6,-6 PLOT 1, 0; 2,-1; 2,-5 PLOT 4, 0; 5,-1; 5,-5 END PICTURE PICTURE Diamond PLOT 0,2; 0,-2 PLOT -1,1; -1,-1 PLOT -2,0 PLOT 1,1; 1,-1 PLOT 2,0 END PICTURE PICTURE diamond5(Clr) SET COLOR Clr PLOT -2, 0 PLOT -1,-1; -1,1 PLOT -0,-2; -0,2 PLOT 1,-1; 1,1 PLOT 2, 0 SET COLOR black PLOT -3,0; 0,3; 3,0; 0,-3; -3,0 END PICTURE PICTURE diamond7(Clr) SET COLOR Clr PLOT -3, 0 PLOT -2,-1; -2,1 PLOT -1,-2; -1,2 PLOT 0,-3; 0,3 PLOT 1,-2; 1,2 PLOT 2,-1; 2,1 PLOT 3, 0 ! SET COLOR black ! PLOT -4,0; 0,4; 4,0; 0,-4; -4,0 END PICTURE PICTURE Root(rWid) LET Lft= -rWid PLOT Lft+1,-12; 0,-12 PLOT Lft ,-11; 0,-11 PLOT Lft+1,-12; Lft-5,0; Lft-7,-4 PLOT Lft+2,-12; Lft-4,0; Lft-6,-4 END PICTURE PICTURE IntegralSign(Clr) SET COLOR Clr PLOT 0, -9; 0, 2 PLOT 1, -9; 1, 2 PLOT 1,-10; 2,-10 PLOT -1, 3; 0, 3 END PICTURE PICTURE Summation(Clr) SET COLOR Clr PLOT 0, 2; 7, 2 PLOT 0, 2; 6, -4; 0,-10 PLOT 1, 2; 7, -4; 1,-10 PLOT 0,-10; 7,-10 END PICTURE PICTURE PlusMinus(Clr) SET COLOR Clr PLOT -3, 0; 3, 0 PLOT -3,-6; 3,-6 PLOT 0,-9; 0,-3 END PICTURE END MODULE MODULE InterAction 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 SUB DrawButton(l,r,b,t,tBas,t$) SET COLOR white BOX LINES l,r-1,b-1,t SET COLOR black BOX LINES l+1,r,b,t+1 SET COLOR drkgry BOX AREA l+1,r-1,b-1,t+1 IF t$<>"" then LET midb= int((l+r)/2) + 1 CALL PlotTextCJ(midb,b-tBas,t$,white) END IF END SUB ! ---- Mouse Button Action ---- SUB ButtonDown(l,r,b,t) SET COLOR black PLOT l,b; l,t; r,t SET COLOR white PLOT l+1,b; r,b; r,t+1 END SUB SUB ButtonUp(l,r,b,t) SET COLOR white PLOT l,b; l,t; r,t SET COLOR 1 PLOT l+1,b; r,b; r,t+1 END SUB SUB MouseButtonUp(Lft,Rgt,Bas,Top,ms) CALL ButtonDown(Lft,Rgt,Bas,Top) DO GET MOUSE: mx,my,ms LOOP until ms=3 CALL ButtonUp(Lft,Rgt,Bas,Top) END SUB SUB MouseUp(mx,my,ms) DO GET MOUSE: mx,my,ms LOOP until ms=3 END SUB SUB MouseDown(mx,my,ms) DO GET MOUSE: mx,my,ms LOOP until ms=2 END SUB END MODULE ! *** SUB FourierCoefficients 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,slideClr DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx DECLARE PUBLIC qLft,qRgt,qBas,qTop DECLARE PUBLIC infLft,infRgt,infBas,infTop PUBLIC h1a,h2b,h1olda,h2oldb PUBLIC h3c,h4d,h3oldc,h4oldd PUBLIC h6j,h5k,h6oldj,h5oldk ! --- help screen array --- DIM info$(1:1) MAT READ info$ DATA "Information on Fourier Series" ! ---------- Utility functions --- DEF clamp(n,lo,hi)= min(max(n,lo),hi) DEF roundn(n,step)= round(n/step)*step DEF e= exp(1) ! --- colors --- LET abClr= green LET cdClr= red ! ---------- 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 w1Firstx, w1SxTik, w1LxTik, w1xLabel, w1xGridstep DECLARE PUBLIC w1Firsty, w1SyTik, w1LyTik, w1yLabel, w1yGridstep DECLARE PUBLIC w1aspect, w1xPiAxis, w1yPiAxis LET w1Lft = worklft + 70 ! pixel bounds LET w1Rgt = w1Lft + 280 LET w1Top = worktop + 65 LET w1Bas = w1Top + 264 LET w1fLft= -1 ! function bounds LET w1fRgt= 1 LET w1fBas= -3 LET w1fTop= 3 LET w1Xax$= "t" ! axis labels LET w1Yax$= "x" LET w1xGridstep= 0.5 ! horizontal grid intervals LET w1yGridstep= 1.0 ! vertical grid intervals LET w1SxTik = 0.5 ! horizontal axis Tik marks LET w1LxTik = 1 LET w1xLabel = 1 LET w1Firstx = w1fLft LET w1xPiAxis= 1 LET w1SyTik = 0.5 ! vertical axis Tik marks LET w1LyTik = 1 LET w1yLabel = 1 LET w1Firsty = w1fBas LET w1yPiAxis= 0 ! --- Plane 1 methods --- DECLARE DEF w1Fncx,w1fncy,w1Wndx,w1wndy ! window/function transforms CALL w1PlaneVariables SUB w1Clear BOX CLEAR w1Lft-20,w1Rgt+20,workBas-5,w1Top-20 END SUB SUB w1Initialize CALL w1DrawPlane(1,1,1,1) ! grid, axes, zeroaxes CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(w1Rgt+8,w1y0+3,w1Xax$,axislabelClr) ! axis labels CALL PlotTextCJ(w1x0,w1Top-10,w1Yax$,axislabelClr) BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in w1gridLayer$ END SUB SUB w1Refresh BOX SHOW w1gridLayer$ at w1Lft-5,w1Bas+5 END SUB SUB w1PutBuffer(buf$) BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in buf$ END SUB SUB w1GetBuffer(buf$) BOX SHOW buf$ at w1Lft-5,w1Bas+5 END SUB ! ---------- Slider parameters and methods ---------- ! ----------- vertical sliders ------------ LET slideHeight= 96 LET c1$= "A" LET c2$= "B" ! --- vertical slider 1 --- DECLARE DEF v1Fncy,v1wndy ! window/function transforms DECLARE PUBLIC v1axis,v1wLft,v1wRgt,v1wBas,v1wTop,v1sBas,v1sTop DECLARE PUBLIC v1fBas,v1fTop,v1First,v1STik,v1LTik,v1Label DECLARE PUBLIC v1name$,v1m,v1form$,v1Clr LET v1Clr = slideClr LET v1name$= "" LET v1form$= "-%.##" LET v1m = 1 LET v1a = 0 LET v1olda = -999 LET v1axis = w1Lft - 36 LET v1wBas = w1Bas LET v1wTop = v1wBas - slideHeight LET v1fBas = -0.4 LET v1fTop = 0.4 LET v1STik = 0.1 LET v1LTik = 0.2 LET v1Label= 0.2 LET v1First= v1fBas CALL v1SliderVariables ! ----------- horizontal sliders ------------ ! LET slideWidth= 200 ! LET slidelft = -2 ! LET slidergt = 2 ! LET Stik = .5 ! LET Ltik = 1 ! LET Label = 1 ! LET First = -2 LET slideWidth= 150 LET slidelft = -1.5 LET slidergt = 1.5 LET Stik = 0.5 LET Ltik = 0.5 LET Label = 1.5 LET First = -1.5 LET hstep = 45 LET hlft = round(w1Rgt+65) LET slideClr = white ! --- slider 0 --- DECLARE DEF h0Fncx ! window/function transforms DECLARE PUBLIC h0axis,h0wLft,h0wRgt,h0wBas,h0wTop,h0sLft,h0sRgt DECLARE PUBLIC h0fLft,h0fRgt,h0First,h0STik,h0LTik,h0Label DECLARE PUBLIC h0name$,h0m,h0form$,h0Clr LET h0Clr = slideClr LET h0name$ = "k" LET h0form$ = "-%.####" LET h0m = 1 LET h0axis = w1Top LET h0wLft = w1Rgt+130 LET h0wRgt = h0wLft+SlideWidth LET h0fLft = slidelft LET h0fRgt = slidergt LET h0STik = 0 LET h0LTik = 0.5 LET h0Label= 2 LET h0First= h0fLft LET h0Click= h0Ltik CALL h0SliderVariables ! --- horizontal slider 1 --- DECLARE DEF h1Fncx ! window/function transforms DECLARE PUBLIC h1axis,h1wLft,h1wRgt,h1wBas,h1wTop,h1sLft,h1sRgt DECLARE PUBLIC h1fLft,h1fRgt,h1First,h1STik,h1LTik,h1Label DECLARE PUBLIC h1name$,h1m,h1form$,h1Clr LET h1Clr = slideClr LET h1name$= "" LET h1form$= "-%.####" LET h1m = 1 LET h1axis = w1Top - 15 LET h1wLft = h0wLft LET h1wRgt = h1wLft+slideWidth LET h1fLft = -3 !h0flft LET h1fRgt = 3 !h0frgt LET h1STik = Stik ! short tick marks LET h1LTik = 1 ! long tick marks LET h1Label= 1 ! labels LET h1First= -3 ! first tick mark LET h1Click= h1Ltik CALL h1SliderVariables ! --- Slider 2 --- DECLARE DEF h2Fncx ! window/function transforms DECLARE PUBLIC h2axis,h2wLft,h2wRgt,h2wBas,h2wTop,h2sLft,h2sRgt DECLARE PUBLIC h2fLft,h2fRgt,h2First,h2STik,h2LTik,h2Label DECLARE PUBLIC h2name$,h2m,h2form$,h2Clr LET h2Clr = slideClr LET h2name$ = "" LET h2form$ = "-%.####" LET h2m = 1 LET h2axis = h1axis+hstep LET h2wLft = h1wLft LET h2wRgt = h2wLft+slidewidth LET h2fLft = slidelft LET h2fRgt = slidergt LET h2STik = Stik LET h2LTik = Ltik LET h2Label= Label LET h2First= First LET h2Click= h2Ltik CALL h2SliderVariables ! --- slider 3 --- DECLARE DEF h3Fncx ! window/function transforms DECLARE PUBLIC h3axis,h3wLft,h3wRgt,h3wBas,h3wTop,h3sLft,h3sRgt DECLARE PUBLIC h3fLft,h3fRgt,h3First,h3STik,h3LTik,h3Label DECLARE PUBLIC h3name$,h3m,h3form$,h3Clr LET h3Clr = slideClr LET h3name$ = "" LET h3form$ = "-%.####" LET h3m = 1 LET h3axis = h2axis+hstep LET h3wLft = h1wLft LET h3wRgt = h3wLft+slideWidth LET h3fLft = slidelft LET h3fRgt = slidergt LET h3STik = Stik LET h3LTik = Ltik LET h3Label= Label LET h3First= First LET h3Click= h3Ltik CALL h3SliderVariables ! --- slider 4 --- DECLARE DEF h4Fncx ! window/function transforms DECLARE PUBLIC h4axis,h4wLft,h4wRgt,h4wBas,h4wTop,h4sLft,h4sRgt DECLARE PUBLIC h4fLft,h4fRgt,h4First,h4STik,h4LTik,h4Label DECLARE PUBLIC h4name$,h4m,h4form$,h4Clr LET h4Clr = slideClr LET h4name$ = "" LET h4form$ = "-%.####" LET h4m = 1 LET h4axis = h3axis+hstep LET h4wLft = h1wLft LET h4wRgt = h4wLft+slideWidth LET h4fLft = slidelft LET h4fRgt = slidergt LET h4STik = Stik LET h4LTik = Ltik LET h4Label= Label LET h4First= First LET h4Click= h4Ltik CALL h4SliderVariables ! --- slider 5 --- DECLARE DEF h5Fncx ! window/function transforms DECLARE PUBLIC h5axis,h5wLft,h5wRgt,h5wBas,h5wTop,h5sLft,h5sRgt DECLARE PUBLIC h5fLft,h5fRgt,h5First,h5STik,h5LTik,h5Label DECLARE PUBLIC h5name$,h5m,h5form$,h5Clr LET h5Clr = slideClr LET h5name$ = "" LET h5form$ = "-%.####" LET h5m = 1 LET h5axis = h4axis+hstep LET h5wLft = h1wLft LET h5wRgt = h5wLft+SlideWidth LET h5fLft = slidelft LET h5fRgt = slidergt LET h5STik = Stik LET h5LTik = Ltik LET h5Label= Label LET h5First= First LET h5Click= h5Ltik CALL h5SliderVariables ! --- slider 6 --- DECLARE DEF h6Fncx ! window/function transforms DECLARE PUBLIC h6axis,h6wLft,h6wRgt,h6wBas,h6wTop,h6sLft,h6sRgt DECLARE PUBLIC h6fLft,h6fRgt,h6First,h6STik,h6LTik,h6Label DECLARE PUBLIC h6name$,h6m,h6form$,h6Clr LET h6Clr = slideClr LET h6name$ = "" LET h6form$ = "-%.####" LET h6m = 1 LET h6axis = h5axis+hstep LET h6wLft = h1wLft LET h6wRgt = h6wLft+SlideWidth LET h6fLft = slidelft LET h6fRgt = slidergt LET h6STik = Stik LET h6LTik = Ltik LET h6Label= Label LET h6First= First LET h6Click= h6Ltik CALL h6SliderVariables ! --- slider 7 --- DECLARE DEF h7Fncx ! window/function transforms DECLARE PUBLIC h7axis,h7wLft,h7wRgt,h7wBas,h7wTop,h7sLft,h7sRgt DECLARE PUBLIC h7fLft,h7fRgt,h7First,h7STik,h7LTik,h7Label DECLARE PUBLIC h7name$,h7m,h7form$,h7Clr,h7wWid,h7fWid LET h7Clr = slideClr LET h7name$ = "" LET h7form$ = "-%.####" LET h7m = 1 LET h7axis = h6axis+hstep LET h7wLft = h1wLft LET h7wRgt = h7wLft+SlideWidth LET h7fLft = h0flft LET h7fRgt = h0frgt LET h7STik = Stik LET h7LTik = Ltik LET h7Label= Label LET h7First= First LET h7Click= h7Ltik CALL h7SliderVariables ! ----- function window ----- ! LET fstop= worktop+10 ! LET fsbas= fstop+24 ! LET fslft= worklft+20 ! LET fsrgt= workrgt-20 LET fstop= workBas-25 LET fsbas= fstop+20 LET fslft= worklft LET fsrgt= workrgt SUB SetFunction ! CALL SetButton1(cslft,csrgt,cstop,cshgt,fncFlag,1-fncFlag) ! CALL SetButton1(allft,alrgt,altop,alhgt,oldterm,trmFlag) IF frmFlag=1 then CALL SetTextFont(1,12,"bold") ! LET txt$ = "x(t) = k {" LET txt$ = "x(t) = " SELECT CASE fncFlag CASE 0 SELECT CASE trmFlag CASE 0 LET txt1$= "b_[1]sin(t) + b_[2]sin(2t) + b_[3]sin(3t) + b_[4]sin(4t) + b_[5]sin(5t) + b_[6]sin(6t) + ..." CASE 1 LET txt1$= "b_[1]sin(t) + b_[3]sin(3t) + b_[5]sin(5t) + b_[7]sin(7t) + b_[9]sin(9t) + b_[11]sin(11t) + ..." CASE 2 LET txt1$= "b_[2]sin(2t) + b_[4]sin(4t) + b_[6]sin(6t) + b_[8]sin(8t) + b_[10]sin(10t) + b_[12]sin(12t) + ..." END SELECT CASE 1 SELECT CASE trmFlag CASE 0 LET txt1$= "a_[0](0.5) + a_[1]cos(t) + a_[2]cos(2t) + a_[3]cos(3t) + a_[4]cos(4t) + a_[5]cos(5t) + a_[6]cos(6t) + ..." CASE 1 LET txt1$= "a_[1]cos(t) + a_[3]cos(3t) + a_[5]cos(5t) + a_[7]cos(7t) + a_[9]cos(9t) + a_[11]cos(11t) + ..." CASE 2 LET txt1$= "a_[0](0.5) + a_[2]cos(2t) + a_[4]cos(4t) + a_[6]cos(6t) + a_[8]cos(8t) + a_[10]cos(10t) + a_[12]cos(12t) + ..." END SELECT END SELECT ! SET COLOR black ! BOX AREA fslft+1,fsrgt-1,fsbas-1,fstop+1 ! SET COLOR blue ! BOX LINES fslft,fsrgt,fsbas,fstop CALL ClearFunction CALL SuperSubScriptCJ(workmidx,fsbas-8,txt$&txt1$,white) END IF END SUB SUB ClearFunction BOX CLEAR fslft,fsrgt,fsbas,fstop END SUB ! ---------- Text Output Rects ---------- ! --- text rectangle 1 --- LET t1BasLn= h1wTop - 30 LET t1Lft = h1wLft + 23 LET t1Rgt = h1wRgt + 30 LET t1Bas = t1BasLn + 5 LET t1Top = t1BasLn - 15 SUB t1Label CALL SuperSubScriptRJ(t1Lft,t1BasLn,"z = ",abClr) END SUB SUB t1Set LOCAL r$,i$,z$ CALL t1Clear LET r$ = trim$(using$("--%.##",h1a)) LET i$ = trim$(using$("--%.##i",abs(h2b))) CALL StringWidth(r$,rw) LET pmx= t1lft + rw + 10 LET ix = pmx + 3 + 6 CALL PlotTextLJ(t1Lft,t1BasLn,r$,abClr) DRAW PlusMinus(abClr) with shift(pmx,t2BasLn) CALL PlotTextLJ(ix,t1BasLn,i$,abClr) ! LET z$ = r$ & " +- " & i$ ! CALL PlotTextLJ(t1Lft,t1BasLn,z$,abClr) 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 LET t2Lft = h3wLft + 23 LET t2Rgt = h3wRgt + 30 LET t2Bas = t2BasLn + 5 LET t2Top = t2BasLn - 15 SUB t2Label CALL SuperSubScriptRJ(t2Lft,t2BasLn,"w = ",cdClr) END SUB SUB t2Set LOCAL r$,i$,z$ CALL t2Clear LET r$ = trim$(using$("--%.##",h3c)) LET i$ = trim$(using$("--%.##i",abs(h4d))) CALL StringWidth(r$,rw) LET pmx= t2lft + rw + 10 LET ix = pmx + 6 + 3 CALL PlotTextLJ(t2Lft,t2BasLn,r$,cdClr) DRAW PlusMinus(cdClr) with shift(pmx,t2BasLn) CALL PlotTextLJ(ix,t2BasLn,i$,cdClr) END SUB SUB t2Clear BOX CLEAR t2Lft-2,t2Rgt,t2Bas,t2Top END SUB SUB t2Init CALL t2Label CALL t2Set END SUB ! --- radio boxes --- DIM r1Box$(0:1) MAT READ r1Box$ DATA "Sine Series", "Cosine Series" LET r1siz= 10 LET r1cnt= 2 LET r1stp= 16 LET r1top= w1Bas + 35 LET r1bas= r1top + r1stp*r1cnt LET r1lft= w1Rgt-120 LET r1rgt= r1lft + r1siz LET r1title$= "" DIM r2Box$(0:2) MAT READ r2Box$ DATA "All terms", "Odd terms", "Even terms" LET r2siz= 10 LET r2cnt= 3 LET r2stp= 16 LET r2top= r1bas + r2stp LET r2bas= r2top + r2stp*r2cnt LET r2lft= r1Lft LET r2rgt= r2lft + r2siz LET r2title$= "" DIM r3Box$(0:5) MAT READ r3Box$ DATA "A", "B", "C", "D", "E", "F" LET r3siz= 10 LET r3cnt= 6 LET r3stp= 16 LET r3top= r1top LET r3bas= r3top + r3stp*r3cnt LET r3lft= r1Lft - 80 LET r3rgt= r3lft + r3siz LET r3title$= "" ! ----- DIM targetValues(0:5,0:6) MAT READ targetValues DATA 0, 1, 0.333333, 0.200000, 0.142857, 0.111111, 0.090909 DATA 0, 1,-0.333333, 0.200000,-0.142857, 0.111111,-0.090909 DATA 2.467401,-1, 0 ,-0.111111, 0 ,-0.040000, 0 !,-0.020408,-0.012346,-0.008264 DATA 0, 1,-0.500000, 0.333333,-0.250000, 0.200000,-0.166667 DATA 0, 0, 1 , 0 ,-0.500000, 0, 0.333333 !, 0 !-0.250000, 0.200000,-0.166667 DATA 2.467401,-1, 0 ,-0.111111, 0 ,-0.040000, 0 !,-0.020408,0,-0.012346,0,-0.008264 ! ----- distance output ----- LET dlft = w1Lft+30 LET drgt = w1Rgt-30 LET dtop = worktop+10 LET dbas = dtop+20 LET dbasln= dbas-3 SUB ClearDistance BOX CLEAR dlft,drgt,dbas,dtop END SUB SUB SetDistance IF dstFlag=1 then CALL SetTextFont(1,18,"bold") LET n$= using$("-%.####",D) CALL ClearDistance FOR i= 1 to 8 LET ch$= n$(i:i) LET tx = dlft + (i-1)*30 + 5 CALL PlotTextCJ(tx,dbasln,ch$,white) NEXT i END IF ! BOX CLEAR 0,300,50,0 ! SET CURSOR 2,1 ! PRINT using$("--%.####",sqr(D1)),using$("--%.####",D) END SUB ! --- Draw the screen --- DIM At(0:12),Bt(0:12) ! dimension the target vector DIM As(0:12),Bs(0:12) ! dimension the slider vector LET fncFlag= 0 LET trmFlag= 0 LET dstFlag= 0 LET frmFlag= 0 LET chkFlag= 0 LET target = -1 LET k= 1 LET c0,c1,c2,c3,c4,c5,c6,c7= 0 CALL InitScreen SUB InitScreen BOX CLEAR worklft,workrgt,workbas,worktop IF colorscheme=1 then LET aClr= red ! envelope LET bClr= blue ! wave LET cClr= green ! complex points LET slideClr= drkgry ! slider names ELSE LET aClr= yellow ! envelope LET bClr= cyan ! wave LET cClr= green ! complex points LET slideClr= white ! slider names END IF CALL w1Initialize CALL DrawModel(target) CALL Buttons CALL r1DrawBoxes CALL r1SetBox(fncFlag) CALL r2DrawBoxes CALL r2SetBox(trmFlag) CALL r3DrawBoxes CALL r3SetBox(target) CALL SetFunction CALL DrawSliders(0) CALL ResetDistance CALL DrawGraph(1,1) CALL dstButton(target) END SUB ! ----------------- Event manager ----------------- ! --- Graph drawing methods --- DO CALL MouseDown(mx,my,ms) LET oldx= -99999 IF h1Flag=1 and mx>=h1wLft-2 and mx<=h1wRgt+2 and my>h1wTop and myoldx then LET c0 = h1Fncx(mx) LET c0 = min(max(c0,h1flft),h1frgt) LET c0 = roundn(c0,h1Click) CALL h1Mark(c0) CALL DrawGraph(1,1) CALL ResetDistance LET oldx= mx END IF ELSE DO GET MOUSE: mx,my,s IF mx<>oldx then LET c0 = h1Fncx(mx) LET c0 = min(max(c0,h1fLft),h1fRgt) LET c0 = round(c0,2) CALL DrawTerm(3,1) CALL h1Mark(c0) CALL DrawGraph(3,0) CALL ResetDistance LET oldx= mx END IF LOOP until s=3 CALL DrawGraph(1,1) END IF ELSE IF mx>=h2wLft-2 and mx<=h2wRgt+2 and my>h2wTop and myoldx then LET oldx= mx LET c1 = h2Fncx(mx) LET c1 = min(max(c1,h2flft),h2frgt) LET c1 = roundn(c1,h2Click) CALL h2Mark(c1) CALL DrawGraph(1,1) CALL ResetDistance END IF ELSE DO GET MOUSE: mx,my,s IF mx<>oldx then LET oldx= mx LET c1 = h2Fncx(mx) LET c1 = min(max(c1,h2fLft),h2fRgt) LET c1 = round(c1,2) CALL h2Mark(c1) CALL DrawTerm(3,2) CALL DrawGraph(3,0) CALL ResetDistance END IF LOOP until s=3 CALL DrawGraph(1,1) END IF ELSE IF mx>=h3wLft-2 and mx<=h3wRgt+2 and my>h3wTop and myoldx then LET oldx= mx LET c2 = h3Fncx(mx) LET c2 = min(max(c2,h3flft),h3frgt) LET c2 = roundn(c2,h3Click) CALL h3Mark(c2) CALL DrawGraph(1,1) CALL ResetDistance END IF ELSE DO GET MOUSE: mx,my,s IF mx<>oldx then LET oldx= mx LET c2 = h3Fncx(mx) LET c2 = min(max(c2,h3fLft),h3fRgt) LET c2 = round(c2,2) CALL h3Mark(c2) CALL DrawTerm(3,3) CALL DrawGraph(3,0) CALL ResetDistance END IF LOOP until s=3 CALL DrawGraph(1,1) END IF ELSE IF mx>=h4wLft-2 and mx<=h4wRgt+2 and my>h4wTop and myoldx then LET oldx= mx LET c3 = h4Fncx(mx) LET c3 = min(max(c3,h4flft),h4frgt) LET c3 = roundn(c3,h4Click) CALL h4Mark(c3) CALL DrawGraph(1,1) CALL ResetDistance END IF ELSE DO GET MOUSE: mx,my,s IF mx<>oldx then LET oldx= mx LET c3 = h4Fncx(mx) LET c3 = min(max(c3,h4fLft),h4fRgt) LET c3 = round(c3,2) CALL h4Mark(c3) CALL DrawTerm(3,4) CALL DrawGraph(3,0) CALL ResetDistance END IF LOOP until s=3 CALL DrawGraph(1,1) END IF ELSE IF mx>=h5wLft-2 and mx<=h5wRgt+2 and my>h5wTop and myoldx then LET oldx= mx LET c4 = h5Fncx(mx) LET c4 = min(max(c4,h5flft),h5frgt) LET c4 = roundn(c4,h5Click) CALL h5Mark(c4) CALL DrawGraph(1,1) CALL ResetDistance END IF ELSE DO GET MOUSE: mx,my,s IF mx<>oldx then LET oldx= mx LET c4 = h5Fncx(mx) LET c4 = min(max(c4,h5fLft),h5fRgt) LET c4 = round(c4,2) CALL h5Mark(c4) CALL DrawTerm(3,5) CALL DrawGraph(3,0) CALL ResetDistance END IF LOOP until s=3 CALL DrawGraph(1,1) END IF ELSE IF mx>=h6wLft-2 and mx<=h6wRgt+2 and my>h6wTop and myoldx then LET oldx= mx LET c5 = h6Fncx(mx) LET c5 = min(max(c5,h6flft),h6frgt) LET c5 = roundn(c5,h6Click) CALL h6Mark(c5) CALL DrawGraph(1,1) CALL ResetDistance END IF ELSE DO GET MOUSE: mx,my,s IF mx<>oldx then LET oldx= mx LET c5 = h6Fncx(mx) LET c5 = min(max(c5,h6fLft),h6fRgt) LET c5 = round(c5,2) CALL h6Mark(c5) CALL DrawTerm(3,6) CALL DrawGraph(3,0) CALL ResetDistance END IF LOOP until s=3 CALL DrawGraph(1,1) END IF ELSE IF mx>=h7wlft-2 and mx<=h7wrgt+2 and my>h7wtop and myoldx then LET oldx= mx LET c6 = h7Fncx(mx) LET c6 = min(max(c6,h7flft),h7frgt) LET c6 = roundn(c6,h7Click) CALL h7Mark(c6) CALL DrawGraph(1,1) CALL ResetDistance END IF ELSE DO GET MOUSE: mx,my,s IF mx<>oldx then LET oldx= mx LET c6 = h7Fncx(mx) LET c6 = min(max(c6,h7flft),h7frgt) LET c6 = round(c6,2) CALL h7Mark(c6) CALL DrawTerm(3,7) CALL DrawGraph(3,0) CALL ResetDistance END IF LOOP until s=3 CALL DrawGraph(1,1) END IF ELSE IF chkFlag=1 and mx>hboxlft and mxh1wtop and myh1wTop and myh2wTop and myh3wTop and myh4wTop and myh5wTop and myh6wTop and myh7wtop and myckLft and mxckTop and my=r1lft and mx<=r1rgt and my>r1top and my=r2lft and mx<=r2rgt and my>r2top and my=r3lft and mx<=r3rgt and my>r3top and myzLft and mxzTop and my-1 and mx>dstLft and mxdstTop and myfrmLft and mxfrmTop and mycLft and mxcTop and myinfLft and mxinfTop and myqLft and mxqTop and my-1 and dstFlag=1 then CALL GetDistance(target,D) CALL SetDistance END IF END SUB ! --- Mouse Event Methods --- SUB DrawGraph(stp,refresh) IF refresh=1 then CALL w1GetBuffer(w1GraphLayer$) SET COLOR yellow SELECT CASE fncFlag CASE 0 ! sine FOR wx= w1Lft to w1Rgt step stp LET t= w1Fncx(wx) * pi SELECT CASE trmFlag CASE 0 ! all LET t1= c1*(sin( 1*t)) LET t2= c2*(sin( 2*t)) LET t3= c3*(sin( 3*t)) LET t4= c4*(sin( 4*t)) LET t5= c5*(sin( 5*t)) LET t6= c6*(sin( 6*t)) CASE 1 ! odd LET t1= c1*(sin( 1*t)) LET t2= c2*(sin( 3*t)) LET t3= c3*(sin( 5*t)) LET t4= c4*(sin( 7*t)) LET t5= c5*(sin( 9*t)) LET t6= c6*(sin(11*t)) CASE 2 ! even LET t1= c1*(sin( 2*t)) LET t2= c2*(sin( 4*t)) LET t3= c3*(sin( 6*t)) LET t4= c4*(sin( 8*t)) LET t5= c5*(sin(10*t)) LET t6= c6*(sin(12*t)) END SELECT LET x = k * [ t1 + t2 + t3 + t4 + t5 + t6 ] LET wy= w1Wndy(x) IF wy>w1Top and wyw1Top and wyw1Top and wy1 then CALL h1Mark(c0) END IF CALL h2Mark(c1) CALL h3Mark(c2) CALL h4Mark(c3) CALL h5Mark(c4) CALL h6Mark(c5) CALL h7Mark(c6) END SUB SUB StripZeros LET p= pos(n$,".") LET p= pos(n$,"0",p) LET next$= n$(p+1:p+1) IF next$<>"6" then LET n$= n$(1:p-1) END IF LET l= len(n$) IF n$(l:l)= "." then LET n$= n$(1:l-1) END SUB ! --- Radio Boxes --- SUB r1SetBox(n) FOR i= 0 to r1cnt-1 LET top= r1top + i*r1stp LET bas= top+r1siz IF i=n then SET COLOR white ELSE SET COLOR black END IF BOX AREA r1lft+2,r1rgt-2,bas-2,top+2 NEXT i END SUB SUB r1DrawBoxes FOR btn= 0 to r1cnt-1 LET top = r1top + btn*r1stp LET bas = top + r1siz CALL SetTextFont(1,12,"bold") LET txt$= r1box$(btn) CALL PlotTextLJ(r1rgt+6,bas-1,txt$,white) CALL RadioBox(r1lft,r1rgt,bas,top) NEXT btn CALL RadioTitle(r1lft,r1top,r1title$) END SUB SUB r2SetBox(n) FOR i= 0 to r2cnt-1 LET top= r2top + i*r2stp LET bas= top+r2siz IF i=n then SET COLOR white ELSE SET COLOR black END IF BOX AREA r2lft+2,r2rgt-2,bas-2,top+2 NEXT i END SUB SUB r2DrawBoxes FOR btn= 0 to r2cnt-1 LET top = r2top + btn*r2stp LET bas = top + r2siz CALL SetTextFont(1,12,"bold") LET txt$= r2box$(btn) CALL PlotTextLJ(r2rgt+6,bas-1,txt$,white) CALL RadioBox(r2lft,r2rgt,bas,top) NEXT btn CALL RadioTitle(r2lft,r2top,r2title$) END SUB SUB r3SetBox(n) FOR i= 0 to r3cnt-1 LET top= r3top + i*r3stp LET bas= top+r3siz IF i=n then SET COLOR green ELSE SET COLOR black END IF BOX AREA r3lft+2,r3rgt-2,bas-2,top+2 NEXT i END SUB SUB r3DrawBoxes FOR btn= 0 to r3cnt-1 LET top = r3top + btn*r3stp LET bas = top + r3siz CALL SetTextFont(1,12,"bold") LET txt$= r3box$(btn) CALL PlotTextLJ(r3rgt+6,bas-1,txt$,green) CALL RadioBox(r3lft,r3rgt,bas,top) NEXT btn CALL RadioTitle(r3lft,r3top,r3title$) END SUB ! --- SUB RadioBox(lft,rgt,bas,top) SET COLOR 4 BOX AREA lft-1,rgt+1,bas+1,top-1 SET COLOR 1 BOX AREA lft,rgt,bas,top END SUB SUB RadioTitle(lft,top,title$) IF title$<>"" then CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(lft,top-8,title$,white) CALL StringWidth(title$,txtwid) END IF END SUB ! --- Draw Model --- ! SUB DrawModel(target) ! CALL w1Refresh ! IF target>=0 then ! LET wyn1= w1Wndy(-1) ! negative 1 ! LET wyp1= w1Wndy( 1) ! positive 1 ! LET wxnh= w1Wndx(-0.5) ! negative half pi ! LET wxph= w1Wndx( 0.5) ! positive half pi ! ! SET COLOR green ! SELECT CASE target ! CASE 0 ! square - odd sine ! PLOT w1Lft,wyn1; w1x0,wyn1; w1x0,wyp1; w1Rgt,wyp1 ! CASE 1 ! square - odd cosine ! PLOT w1Lft,wyn1; wxnh,wyn1; wxnh,wyp1; wxph,wyp1; wxph,wyn1; w1Rgt,wyn1 ! CASE 2 ! v - inverse cosine ! PLOT w1Lft,wyp1; w1x0,w1y0; w1Rgt,wyp1 ! CASE 3 ! sawtooth? - all sine ! PLOT w1Lft,wyn1; w1Rgt,wyp1 ! CASE 4 ! ! PLOT w1Lft,w1y0; wxnh,wyp1; wxnh,wyn1; wxph,wyp1; wxph,wyn1; w1Rgt,w1y0 ! CASE 5 ! PLOT w1Lft,w1y0; wxnh,wyp1; w1x0,w1y0; wxph,wyp1; w1Rgt,w1y0 ! END SELECT ! END IF ! CALL w1PutBuffer(w1GraphLayer$) ! END SUB SUB DrawModel(target) CALL w1Refresh IF target>=0 then ! LET wyn1= w1Wndy(-pi/4) ! negative 1 ! LET wyp1= w1Wndy( pi/4) ! positive 1 LET wxnh= w1Wndx(-0.5) ! negative half pi LET wxph= w1Wndx( 0.5) ! positive half pi SET COLOR green SELECT CASE target CASE 0 ! square - odd sine LET wyn1= w1Wndy(-pi/4) ! negative 1 LET wyp1= w1Wndy( pi/4) ! positive 1 PLOT w1Lft,wyn1; w1x0,wyn1; w1x0,wyp1; w1Rgt,wyp1 CASE 1 ! square - odd cosine LET wyn1= w1Wndy(-pi/4) ! negative 1 LET wyp1= w1Wndy( pi/4) ! positive 1 PLOT w1Lft,wyn1; wxnh,wyn1; wxnh,wyp1; wxph,wyp1; wxph,wyn1; w1Rgt,wyn1 CASE 2 ! v - inverse cosine LET wyn1= w1Wndy(-pi^2/4) ! negative 1 LET wyp1= w1Wndy( pi^2/4) ! positive 1 PLOT w1Lft,wyp1; w1x0,w1y0; w1Rgt,wyp1 CASE 3 ! sawtooth? - all sine LET wyn1= w1Wndy(-pi/2) ! negative 1 LET wyp1= w1Wndy( pi/2) ! positive 1 PLOT w1Lft,wyn1; w1Rgt,wyp1 CASE 4 ! LET wyn1= w1Wndy(-pi/2) ! negative 1 LET wyp1= w1Wndy( pi/2) ! positive 1 PLOT w1Lft,w1y0; wxnh,wyp1; wxnh,wyn1; wxph,wyp1; wxph,wyn1; w1Rgt,w1y0 CASE 5 LET wyn1= w1Wndy(-pi^2/4) ! negative 1 LET wyp1= w1Wndy( pi^2/4) ! positive 1 PLOT w1Lft,w1y0; wxnh,wyp1; w1x0,w1y0; wxph,wyp1; w1Rgt,w1y0 END SELECT END IF CALL w1PutBuffer(w1GraphLayer$) END SUB SUB Buttons CALL SetTextFont(1,9,"bold") LET clft= w1Lft LET crgt= clft+40 LET ctop= w1Bas+40 LET cbas= ctop+17 CALL DrawButton(clft,crgt,cbas,ctop,6,"Clear") LET cklft= h0wLft-80 LET ckrgt= cklft+40 LET cktop= ctop LET ckbas= cktop+17 ! IF chkFlag=1 then ! CALL DrawButton(cklft,ckrgt,ckbas,cktop,6,"Check") ! END IF LET hboxlft= cklft+14 LET hboxrgt= ckrgt-14 LET zlft= h7wLft LET zrgt= zlft+40 LET ztop= ctop LET zbas= ztop+17 CALL DrawButton(zlft,zrgt,zbas,ztop,6,"Reset") LET frmlft= zrgt+20 LET frmrgt= frmlft+55 LET frmtop= ctop LET frmbas= frmtop+17 CALL DrawButton(frmlft,frmrgt,frmbas,frmtop,6,"Formula") END SUB SUB dstButton(target) CALL SetTextFont(1,9,"bold") IF target>-1 then LET dstlft= frmrgt+20 LET dstrgt= dstlft+65 LET dsttop= ctop LET dstbas= dsttop+17 CALL DrawButton(dstlft,dstrgt,dstbas,dsttop,6,"Distance") LET cklft= h0wLft-80 LET ckrgt= cklft+40 LET cktop= ctop LET ckbas= cktop+17 IF chkFlag=1 then CALL DrawButton(cklft,ckrgt,ckbas,cktop,6,"Check") END IF ELSE BOX CLEAR dstlft,dstrgt,dstbas,dsttop BOX CLEAR cklft,ckrgt,ckbas,cktop END IF END SUB END SUB ! ----- end of tool code -----