!One could display trajectoires through the following points. !I'll take theta = 0; for other theta, apply R(theta) to what I say. ! !In real eigenvalue case, show the two eigenlines (which go through !a1 = (1/2,0) and a2 = (s/2, omega)), and the trajectories though the four vectors !a1+a2, a1-a2, -a1+a2, -a1-a2. ! !For the complex eigenvalue case use (1/2,0), (-1/2,0), and: !+-((s-1)/2,0) if s>0 !+-((s+1)/2,0) if s<0. ! !One could coompute one of each opposite pair using RK. !Hi Hu, !There are three cases. ! !Case 1) lam17 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+30,toolhdr-10,txt$,titleclr) END SUB SUB CopyRightHC(hp,yp,c) ! 142 pixels LET x= hp LET y= yp-7 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 black ! BOX AREA l,r,b,t ! SET COLOR litmid ! BOX LINES l,r,b,t ! END SUB SUB Panel(l,r,b,t,c) SET COLOR 0 BOX AREA l,r,b,t SET COLOR black PLOT l,b; l,t; r,t SET COLOR litgry PLOT l,b; r,b; r,t SET COLOR c BOX AREA l+1,r-1,b-1,t+1 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) 0,.2,.4 ! Back ELSE SET COLOR MIX(0) b4,b4,b4 ! Back ! SET COLOR MIX(0) .7,.7,.7 ! Back ! SET COLOR MIX(0) .7,.7,.8 ! 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 ! blue tool SET COLOR MIX( 7) b5,b3,b1 ! red SET COLOR MIX( 8) b5,b5,b0 ! yellow SET COLOR MIX( 9) b5,b2,b1 ! green SET COLOR MIX(10) b0,b4,b3 ! cyan SET COLOR MIX(11) b2,b3,b5 ! blue SET COLOR MIX(12) b0,b4,b1 ! magenta SET COLOR MIX(13) b5,b1,b5 ! pink ELSE ! white tool SET COLOR MIX( 7) b4,b1,b0 ! red SET COLOR MIX( 8) b4,b3,b0 ! yellow SET COLOR MIX( 9) b0,b3,b0 ! green SET COLOR MIX(10) b0,b3,b3 ! cyan SET COLOR MIX(11) b1,b0,b4 ! blue SET COLOR MIX(12) b3,b0,b3 ! 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 LET pink = 13 IF colorscheme=0 then LET planeclr= black LET gridclr = drkgry LET rimclr = litmid LET axisclr = litmid LET axislabelclr = white LET titleclr = white LET rightsclr = litgry LET numberlineclr= litgry LET slotdrkclr= black LET slotlgtclr= litmid LET headerclr = blue LET btnclr = drkgry ELSE LET planeclr= white LET gridclr = litgry LET rimclr = drkmid LET axisclr = drkgry LET axislabelclr= black LET titleclr= black LET rightsclr= drkgry LET numberlineclr= drkgry LET slotdrkclr= drkgry LET slotlgtclr= white LET headerclr= blue LET btnclr= drkmid 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 DECLARE PUBLIC SLUmode 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 IF SLUmode=0 then CALL CopyRightH(iLft+30,iBas-3,c) ELSE CALL CopyRightHC(iLft+30,iBas-3,c) END IF 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 SUB Equation(Bas) LET Midx= (iLft+iRgt)/2 CALL SetTextFont(1,12,"bold") LET length$= "A = k ert" CALL StringWidth(length$,sl) LET left= txtLft+30 LET nt$ = "A = k e^[rt]" CALL SuperSubScriptLJ(left,Bas,nt$,clr) END SUB END MODULE ! --- external support libraries --- ! ---- graphing methods ! --- GraphPlane objects MODULE GraphPlane1 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,btnclr PUBLIC w1Lft,w1Rgt,w1Bas,w1Top,w1Midx,w1Midy PUBLIC w1fLft,w1fRgt,w1fBas,w1fTop,w1x0,w1y0 PUBLIC w1Firstx, w1SxTik, w1LxTik, w1xLabel, w1xGridstep PUBLIC w1Firsty, w1SyTik, w1LyTik, w1yLabel, w1yGridstep PUBLIC w1wWid,w1wHgt,w1fWid,w1fHgt PUBLIC w1fxRatio,w1fyRatio,w1wxRatio,w1wyRatio PUBLIC PiAxis1 DEF w1fncx(wx)= w1fLft + w1fxRatio*(wx-w1Lft) ! window to function DEF w1fncy(wy)= w1fBas + w1fyRatio*(w1Bas-wy) DEF w1wndx(fx)= w1Lft + w1wxRatio*(fx-w1fLft) ! function to window DEF w1wndy(fy)= w1Bas - w1wyRatio*(fy-w1fBas) SUB Plane1Variables DECLARE DEF w1wndx,w1wndy CALL WndParams(w1Lft,w1Rgt,w1Bas,w1Top,w1wWid,w1wHgt,w1Midx,w1Midy) CALL FncParams(w1fLft,w1fRgt,w1fBas,w1fTop,w1fWid,w1fHgt,w1fMidx,w1fMidy) CALL PlaneRatios(w1fWid,w1fHgt,w1wWid,w1wHgt,w1fxRatio,w1fyRatio,w1wxRatio,w1wyRatio) LET w1x0= w1wndx(0) LET w1y0= w1wndy(0) END SUB SUB DrawPlane1(grid,axes,zeroFlag) CALL GraphPlane(w1Lft,w1Rgt,w1Bas,w1Top) IF grid=1 then CALL Grid1(w1xGridstep,w1yGridstep,gridclr) END IF IF axes=1 then CALL EdgesVrt(w1Lft,w1Bas,w1Top,w1fBas,w1fTop,w1Firsty,w1SyTik,w1LyTik,w1yLabel) IF PiAxis1=1 then CALL EdgesHrzPi(w1Lft,w1Rgt,w1Bas,w1fLft,w1fRgt,w1Firstx,w1SxTik,w1LxTik,w1xLabel) ELSE CALL EdgesHrz(w1Lft,w1Rgt,w1Bas,w1fLft,w1fRgt,w1Firstx,w1SxTik,w1LxTik,w1xLabel) END IF END IF IF zeroFlag=1 then CALL ZeroAxes(w1x0,w1y0,w1Lft,w1Rgt,w1Bas,w1Top,axisclr) END IF END SUB SUB Grid1(xstp,ystp,clr) CALL Grid(w1Lft,w1Rgt,w1Bas,w1Top,w1fLft,w1fRgt,w1fBas,w1fTop,xstp,ystp,clr) END SUB END MODULE MODULE GraphPlane2 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 PUBLIC w2Lft,w2Rgt,w2Bas,w2Top,w2Midx,w2Midy PUBLIC w2fLft,w2fRgt,w2fBas,w2fTop,w2x0,w2y0 PUBLIC w2Firstx, w2SxTik, w2LxTik, w2xLabel, hGridFirst2, w2xGridstep PUBLIC w2Firsty, w2SyTik, w2LyTik, w2yLabel, vGridFirst2, w2yGridstep PUBLIC w2wWid,w2wHgt,w2fWid,w2fHgt PUBLIC w2fxRatio,w2fyRatio,w2wxRatio,w2wyRatio PUBLIC w2xPiFlag DEF w2fncx(wx)= w2fLft + w2fxRatio*(wx-w2Lft) ! window to function DEF w2fncy(wy)= w2fBas + w2fyRatio*(w2Bas-wy) DEF w2wndx(fx)= w2Lft + w2wxRatio*(fx-w2fLft) ! function to window DEF w2wndy(fy)= w2Bas - w2wyRatio*(fy-w2fBas) SUB Plane2Variables DECLARE DEF w2wndx,w2wndy CALL WndParams(w2Lft,w2Rgt,w2Bas,w2Top,w2wWid,w2wHgt,w2Midx,w2Midy) CALL FncParams(w2fLft,w2fRgt,w2fBas,w2fTop,w2fWid,w2fHgt,w2fMidx,w2fMidy) CALL PlaneRatios(w2fWid,w2fHgt,w2wWid,w2wHgt,w2fxRatio,w2fyRatio,w2wxRatio,w2wyRatio) LET w2x0= w2wndx(0) LET w2y0= w2wndy(0) END SUB SUB DrawPlane2(grid,axes,zeroFlag) CALL GraphPlane(w2Lft,w2Rgt,w2Bas,w2Top) IF grid=1 then CALL Grid2(w2xGridstep,w2yGridstep,gridclr) IF axes=1 then CALL EdgesVrt(w2Lft,w2Bas,w2Top,w2fBas,w2fTop,w2Firsty,w2SyTik,w2LyTik,w2yLabel) IF w2xPiFlag=1 then CALL EdgesHrzPi(w2Lft,w2Rgt,w2Bas,w2fLft,w2fRgt,w2Firstx,w2SxTik,w2LxTik,w2xLabel) ELSE CALL EdgesHrz(w2Lft,w2Rgt,w2Bas,w2fLft,w2fRgt,w2Firstx,w2SxTik,w2LxTik,w2xLabel) END IF END IF IF zeroFlag=1 then CALL ZeroAxes(w2x0,w2y0,w2Lft,w2Rgt,w2Bas,w2Top,axisclr) END IF END SUB SUB Grid2(xstp,ystp,clr) CALL Grid(w2Lft,w2Rgt,w2Bas,w2Top,w2fLft,w2fRgt,w2fBas,w2fTop,xstp,ystp,clr) END SUB END MODULE MODULE GraphPlane3 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 PUBLIC w3Lft,w3Rgt,w3Bas,w3Top,w3Midx,w3Midy PUBLIC w3fLft,w3fRgt,w3fBas,w3fTop,w3x0,w3y0 PUBLIC w3Firstx, w3SxTik, w3LxTik, w3xLabel, w3xGridstep PUBLIC w3Firsty, w3SyTik, w3LyTik, w3yLabel, w3yGridstep PUBLIC w3wWid,w3wHgt,w3fWid,w3fHgt PUBLIC w3fxRatio,w3fyRatio,w3wxRatio,w3wyRatio PUBLIC w3PiAxis DEF w3fncx(wx)= w3fLft + w3fxRatio*(wx-w3Lft) ! window to function DEF w3fncy(wy)= w3fBas + w3fyRatio*(w3Bas-wy) DEF w3wndx(fx)= w3Lft + w3wxRatio*(fx-w3fLft) ! function to window DEF w3wndy(fy)= w3Bas - w3wyRatio*(fy-w3fBas) SUB Plane3Variables DECLARE DEF w3wndx,w3wndy CALL WndParams(w3Lft,w3Rgt,w3Bas,w3Top,w3wWid,w3wHgt,w3Midx,w3Midy) CALL FncParams(w3fLft,w3fRgt,w3fBas,w3fTop,w3fWid,w3fHgt,w3fMidx,w3fMidy) CALL PlaneRatios(w3fWid,w3fHgt,w3wWid,w3wHgt,w3fxRatio,w3fyRatio,w3wxRatio,w3wyRatio) LET w3x0= w3wndx(0) LET w3y0= w3wndy(0) END SUB SUB DrawPlane3(grid,axes,zeroFlag) CALL GraphPlane(w3Lft,w3Rgt,w3Bas,w3Top) IF grid=1 then CALL Grid3(w3xGridstep,w3yGridstep,gridclr) END IF IF axes=1 then CALL EdgesVrt(w3Lft,w3Bas,w3Top,w3fBas,w3fTop,w3Firsty,w3SyTik,w3LyTik,w3yLabel) IF w3PiAxis=1 then CALL EdgesHrzPi(w3Lft,w3Rgt,w3Bas,w3fLft,w3fRgt,w3Firstx,w3SxTik,w3LxTik,w3xLabel) ELSE CALL EdgesHrz(w3Lft,w3Rgt,w3Bas,w3fLft,w3fRgt,w3Firstx,w3SxTik,w3LxTik,w3xLabel) END IF END IF IF zeroFlag=1 then CALL ZeroAxes(w3x0,w3y0,w3Lft,w3Rgt,w3Bas,w3Top,axisclr) END IF END SUB SUB Grid3(xstp,ystp,clr) CALL Grid(w3Lft,w3Rgt,w3Bas,w3Top,w3fLft,w3fRgt,w3fBas,w3fTop,xstp,ystp,clr) END SUB END MODULE MODULE GraphPlane4 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 PUBLIC w4Lft,w4Rgt,w4Bas,w4Top,w4Midx,w4Midy PUBLIC w4fLft,w4fRgt,w4fBas,w4fTop,w4x0,w4y0 PUBLIC w4Firstx, w4SxTik, w4LxTik, w4xLabel, w4xGridstep PUBLIC w4Firsty, w4SyTik, w4LyTik, w4yLabel, w4yGridstep PUBLIC w4wWid,w4wHgt,w4fWid,w4fHgt PUBLIC w4fxRatio,w4fyRatio,w4wxRatio,w4wyRatio PUBLIC w4PiAxis DEF w4fncx(wx)= w4fLft + w4fxRatio*(wx-w4Lft) ! window to function DEF w4fncy(wy)= w4fBas + w4fyRatio*(w4Bas-wy) DEF w4wndx(fx)= w4Lft + w4wxRatio*(fx-w4fLft) ! function to window DEF w4wndy(fy)= w4Bas - w4wyRatio*(fy-w4fBas) SUB Plane4Variables DECLARE DEF w4wndx,w4wndy CALL WndParams(w4Lft,w4Rgt,w4Bas,w4Top,w4wWid,w4wHgt,w4Midx,w4Midy) CALL FncParams(w4fLft,w4fRgt,w4fBas,w4fTop,w4fWid,w4fHgt,w4fMidx,w4fMidy) CALL PlaneRatios(w4fWid,w4fHgt,w4wWid,w4wHgt,w4fxRatio,w4fyRatio,w4wxRatio,w4wyRatio) LET w4x0= w4wndx(0) LET w4y0= w4wndy(0) END SUB SUB DrawPlane4(grid,axes,zeroFlag) CALL GraphPlane(w4Lft,w4Rgt,w4Bas,w4Top) IF grid=1 then CALL Grid4(w4xGridstep,w4yGridstep,gridclr) END IF CALL EdgesVrt(w4Lft,w4Bas,w4Top,w4fBas,w4fTop,w4Firsty,w4SyTik,w4LyTik,w4yLabel) IF w4PiAxis=1 then CALL EdgesHrzPi(w4Lft,w4Rgt,w4Bas,w4fLft,w4fRgt,w4Firstx,w4SxTik,w4LxTik,w4xLabel) ELSE CALL EdgesHrz(w4Lft,w4Rgt,w4Bas,w4fLft,w4fRgt,w4Firstx,w4SxTik,w4LxTik,w4xLabel) END IF IF zeroFlag=1 then CALL ZeroAxes(w4x0,w4y0,w4Lft,w4Rgt,w4Bas,w4Top,axisclr) END IF END SUB SUB Grid4(xstp,ystp,clr) CALL Grid(w4Lft,w4Rgt,w4Bas,w4Top,w4fLft,w4fRgt,w4fBas,w4fTop,xstp,ystp,clr) END SUB END MODULE MODULE GraphingPlanes 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 DEF fncx(wx,wLft,fLft,wxratio)= fLft + fWid/wWid*(wx-wLft) ! window to function DEF fncy(wy,wBas,fBas,fxratio)= fBas + fHgt/wHgt*(wBas-wy) DEF wndx(fx,wLft,fLft,wyratio)= wLft + wWid/fWid*(fx-fLft) ! function to window DEF wndy(fy,wBas,fBas,fyratio)= wBas - wHgt/fHgt*(fy-fBas) ! ---- graphing plane subs ---- SUB WndParams(wLft,wRgt,wBas,wTop,wWid,wHgt,wMidx,wMidy) LET wWid = wRgt-wLft LET wHgt = wBas-wTop LET wMidy= int((wTop+wBas)/2) LET wMidx= int((wLft+wRgt)/2) END SUB SUB FncParams(fLft,fRgt,fBas,fTop,fWid,fHgt,fMidx,fMidy) LET fWid = fRgt-fLft LET fHgt = fTop-fBas LET fMidx= (fLft+fRgt)/2 LET fMidy= (fTop+fBas)/2 END SUB SUB PlaneRatios(fWid,fHgt,wWid,wHgt,fxratio,fyratio,wxratio,wyratio) LET fxratio= fWid/wWid LET fyratio= fHgt/wHgt LET wxratio= wWid/fWid LET wyratio= wHgt/fHgt END SUB SUB GraphPlane(wLft,wRgt,wBas,wTop) BOX CLEAR wLft-30,wRgt+20,wBas+15,wTop-20 SET COLOR planeclr BOX AREA wLft,wRgt,wBas,wTop SET COLOR rimclr BOX LINES wLft,wRgt,wBas,wTop END SUB SUB GridPlane(wLft,wRgt,wBas,wTop,fLft,fRgt,fBas,fTop,wxratio,wyratio,xstp,ystp,clr) CALL GraphPlane(wLft,wRgt,wBas,wTop) CALL Grid(wLft,wRgt,wBas,wTop,fLft,fRgt,fBas,fTop,xstp,ystp,clr) SET COLOR rimclr BOX LINES wLft,wRgt,wBas,wTop END SUB SUB Grid(wLft,wRgt,wBas,wTop,fLft,fRgt,fBas,fTop,xstp,ystp,clr) LET wWid= wRgt-wLft LET fWid= fRgt-fLft LET wHgt= wBas-wTop LET fHgt= fTop-fBas DEF wndx(fx)= wLft + wWid/fWid*(fx-fLft) ! function to window DEF wndy(fy)= wBas - wHgt/fHgt*(fy-fBas) SET COLOR clr IF xstp>0 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 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 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 form$ = "--%." & repeat$("#",places) !LET form$ = "-%.#" 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,5) 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= round(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 v2slider PUBLIC v2axis,v2wLft,v2wRgt,v2wBas,v2wTop,v2wHgt,v2sBas,v2sTop PUBLIC v2fBas,v2fTop,v2First,v2STik,v2LTik,v2Label,v2fHgt,v2yf,v2y2,v2y4,v2yl PUBLIC v2fRatio,v2wRatio,v2name$,v2m,v2form$,v2clr,v2slot$ DEF v2fncy(wy)= v2fBas + v2fRatio*(v2wBas-wy) ! window to function DEF v2wndy(fy)= v2wBas + v2wRatio*(fy-v2fBas) ! function to window SUB v2SliderVariables CALL vWnd(v2axis,v2wLft,v2wRgt,v2wBas,v2wTop,v2wHgt,v2sBas,v2sTop) CALL vFnc(v2fBas,v2fTop,v2fHgt) CALL vRatios(v2fHgt,v2wHgt,v2fRatio,v2wRatio) END SUB SUB v2DrawSlider(n) BOX CLEAR v2wLft,v2wRgt,v2wBas+15,v2wTop-20 CALL SliderSlotV(v2wBas,v2wTop,v2axis) CALL SliderAxisVrt(v2wBas,v2wTop,v2axis,v2fBas,v2fTop,v2first,v2STik,v2LTik,v2Label) BOX KEEP v2axis,v2wRgt,v2sBas,v2sTop in v2slot$ CALL PlotVSliderName(v2axis,v2wBas,v2name$,v2clr) CALL v2Mark(n) END SUB SUB v2Mark(n) LET wy= v2wBas - v2wRatio*(n-v2fBas) BOX SHOW v2slot$ at v2axis,v2sBas CALL SliderKnobV(v2wRgt-5,wy) CALL PlotVSliderValue(v2axis,v2wTop-5,using$(v2form$,n*v2m),v2clr) 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(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(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(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(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(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$ PUBLIC h6PiAxis 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(n) BOX CLEAR h6wLft-20,h6wRgt+35,h6wBas,h6wTop CALL SliderSlotH(h6wLft,h6wRgt,h6axis) ! CALL SliderAxisHrzPi(h6wLft,h6wRgt,h6axis,h6fLft,h6fRgt,h6First,h6STik,h6LTik,h6Label) ! 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$ 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+14,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 PlotTextRJ(Lft-5,Bas-3,name$,clr) END SUB SUB PlotSliderValue(Rgt,Bas,value$,clr) CALL SetTextFont(1,12,"bold") BOX CLEAR Rgt+3,Rgt+50,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 ! SUB hLine(name$,axy,wLft,wRgt,fLft,fRgt,xf,x2,x4,xl,pclr,slot$) ! CALL ClearSlider(wLft,wRgt,axy+15,axy-15) ! CALL SliderSlotH(wLft-3,wRgt+3,axy) ! CALL SliderAxisHrz(wLft,wRgt,axy,fLft,fRgt,xf,x2,x4,xl) ! CALL SetTextFont(1,12,"bold") ! CALL PlotTextRJ(wLft-5,axy+9,name$,pclr) ! END SUB ! ! SUB hLinePi(hname$,axy,wLft,wRgt,fLft,fRgt,xf,x2,x4,xl,pclr,slot$) ! CALL ClearSlider(wLft,wRgt,axy+15,axy-15) ! CALL SliderSlotH(wLft-3,wRgt+3,axy) ! CALL SliderAxisHrzPi(wLft,wRgt,axy,fLft,fRgt,xf,x2,x4,xl) ! CALL SetTextFont(1,12,"bold") ! CALL PlotTextRJ(wLft-5,axy+9,name$,pclr) ! END SUB ! SUB hMark(n,m,wLft,wRgt,wBas,fLft,ratio,form$,slot$,clr) ! LET wx= wLft + ratio*(n-fLft) ! BOX SHOW slot$ at wLft-3,wBas ! CALL SliderKnob(wx,wBas-5) ! BOX CLEAR wRgt+3,wRgt+50,wBas,wBas-12 ! CALL SetTextFont(1,12,"bold") ! CALL PlotTextLJ(wRgt+7,wBas-4,trim$(using$(form$,n*m)),clr) ! END SUB ! SUB ClearSlider(wLft,wRgt,wBas,wTop) ! BOX CLEAR wLft-20,wRgt+35,wBas,wTop ! 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 VarDot(lft,bas,v$,clr) SET COLOR clr IF v$="t" then PLOT TEXT, AT lft,bas: v$ CALL StringWidth(".",sl) PLOT TEXT, AT lft+3-sl/2,bas-10: "." ELSE PLOT TEXT, AT lft,bas: v$ CALL StringWidth(".",sl) PLOT TEXT, AT lft+4-sl/2,bas-9: "." END IF END SUB SUB AlignSuper(asx,ty,pnts,clr,txt$) LET chx= asx SET COLOR clr LET lft$,rgt$,exp$= "" LET l = len(txt$) LET p = pos(txt$,"^") IF p=0 then SET COLOR clr !PLOT TEXT, AT chx,ty: txt$ CALL PlotTextLJ(chx,ty,txt$,clr) ELSE LET lft$= txt$(1:p-1) LET rgt$= txt$(p+1:l) LET l = len(rgt$) IF rgt$(1:1)= "(" then LET p = pos(rgt$,")") LET exp$= rgt$(1:p) LET rgt$= rgt$(p+1:l) ELSE IF len(rgt$)=1 then LET exp$= rgt$ LET rgt$="" ELSE FOR i= 2 to l LET c$= rgt$(i:i) IF c$= " " or c$= "+" or c$= "-" or c$= "*" or c$= ")" then LET exp$= rgt$(1:i-1) LET rgt$= rgt$(i:l) EXIT FOR ELSE IF i=l then LET exp$= rgt$(1:l) LET rgt$= "" EXIT FOR END IF NEXT i END IF CALL SetTextFont(1,12,"bold") CALL StringWidth(lft$,ll) CALL PlotTextLJ(chx,ty,lft$,clr) CALL SetTextFont(1, 9,"bold") CALL StringWidth(exp$,el) CALL PlotTextLJ(chx+ll,ty-pnts,exp$,clr) LET chx= chx+ll+el LET txt$= rgt$ LET lft$,rgt$,exp$= "" LET l = len(txt$) LET p = pos(txt$,"^") IF p<>0 then LET lft$= txt$(1:p-1) LET rgt$= txt$(p+1:l) LET l = len(rgt$) IF rgt$(1:1)= "(" then LET p = pos(rgt$,")") LET exp$= rgt$(1:p) LET rgt$= rgt$(p+1:l) ELSE IF len(rgt$)=1 then LET exp$= rgt$ LET rgt$="" ELSE FOR i= 2 to l LET c$= rgt$(i:i) IF c$= " " or c$= "+" or c$= "-" or c$= "*" or c$= ")" then LET exp$= rgt$(1:i-1) LET rgt$= rgt$(i:l) EXIT FOR ELSE IF i=l then LET exp$= rgt$(1:l) LET rgt$= "" EXIT FOR END IF NEXT i END IF CALL SetTextFont(1,12,"bold") CALL StringWidth(lft$,ll) CALL PlotTextLJ(chx,ty,lft$,clr) CALL SetTextFont(1, 9,"bold") CALL StringWidth(exp$,el) CALL PlotTextLJ(chx+ll,ty-pnts,exp$,clr) CALL SetTextFont(1,12,"bold") PLOT TEXT, AT chx+ll+el,ty: rgt$ CALL PlotTextLJ(chx+ll+el,ty, rgt$,clr) ELSE CALL SetTextFont(1,12,"bold") PLOT TEXT, AT chx,ty: txt$ CALL PlotTextLJ(chx,ty, txt$,clr) END IF END IF 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 GraphParts 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 ! ---- 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 SUB EqPoint(eqx,eqy,fill,clr) LET sz= 4 SET COLOR planeclr CALL BoxDisk(eqx-sz,eqx+sz,eqy+sz,eqy-sz) SET COLOR clr IF fill=1 then CALL BoxDisk(eqx-sz,eqx+sz,eqy+sz,eqy-sz) BOX CIRCLE eqx-sz,eqx+sz,eqy+sz,eqy-sz ELSE IF fill=-1 then BOX CIRCLE eqx-sz,eqx+sz,eqy+sz,eqy-sz BOX CIRCLE eqx-(sz-1),eqx+(sz-1),eqy+(sz-1),eqy-(sz-1) ELSE IF fill= 0 then LET sz = 4 SET COLOR green ! PLOT w1lft,weq1; w1rgt,weq1 ! PLOT w2lft+1,weq1; w2rgt-1,weq1 BOX CIRCLE eqx-sz,eqx+sz,eqy+sz,eqy-sz BOX CIRCLE eqx-(sz-1),eqx+(sz-1),eqy+(sz-1),eqy-(sz-1) PLOT eqx-(sz-2),eqy-1; eqx+(sz-2),eqy-1 PLOT eqx-(sz-3),eqy-2; eqx+(sz-3),eqy-2 ELSE IF fill= -.5 then LET sz = 4 SET COLOR green ! PLOT w1lft,weq1; w1rgt,weq1 ! PLOT w2lft+1,weq1; w2rgt-1,weq1 BOX CIRCLE eqx-sz,eqx+sz,eqy+sz,eqy-sz BOX CIRCLE eqx-(sz-1),eqx+(sz-1),eqy+(sz-1),eqy-(sz-1) PLOT eqx-(sz-2),eqy+1; eqx+(sz-2),eqy+1 PLOT eqx-(sz-3),eqy+2; eqx+(sz-3),eqy+2 END IF END SUB ! PICTURE FlowPos ! PLOT LINES: -2,5; -2,0; -5,0; 0,-5; 5,0; 2,0; 2,5 ! PLOT -1,-4; -1,5 ! PLOT 1,-4; 1,5 ! PLOT -2,-3; -2,0 ! PLOT 2,-3; 2,0 ! PLOT -3,-2; -3,0 ! PLOT 3,-2; 3,0 ! END PICTURE ! ! PICTURE FlowNeg ! PLOT LINES: -2,-5; -2,0; -5,0; 0,5; 5,0; 2,0; 2,-5 ! PLOT -1,4; -1,-5 ! PLOT 1,4; 1,-5 ! PLOT -2,3; -2,-0 ! PLOT 2,3; 2,-0 ! PLOT -3,2; -3,-0 ! PLOT 3,2; 3,-0 ! END PICTURE PICTURE PhaseArrow PLOT -5,3; 0,-2; 5,3 PLOT -5,2; 0,-3; 5,2 END PICTURE ! PICTURE FlowPos4 ! PLOT -2,-1; 0, 1; 2,-1 ! END PICTURE ! ! PICTURE FlowNeg4 ! PLOT -2, 1; 0,-1; 2, 1 ! END PICTURE PICTURE FlowPos4 PLOT -4,-2; 0, 2; 4,-2 END PICTURE PICTURE FlowNeg4 PLOT -4, 2; 0,-2; 4, 2 END PICTURE SUB DrawLam(lft,bas,clr) DIM lambda(0:8,0: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 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 Theta SHARE theta(0:8,0:7) SHARE thetawid LET thetawid= 8 MAT READ theta DATA 0,0,1,1,1,1,0,0 DATA 0,1,1,0,0,1,1,0 DATA 1,1,0,0,0,0,1,1 DATA 1,1,0,0,0,0,1,1 DATA 1,1,1,1,1,1,1,1 DATA 1,1,0,0,0,0,1,1 DATA 1,1,0,0,0,0,1,1 DATA 0,1,1,0,0,1,1,0 DATA 0,0,1,1,1,1,0,0 SUB SwapTheta(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 DrawTheta12(x,bas,clr) LET x= x+thetawid ELSE CALL PlotTextLJ(x,bas,ch$,clr) CALL StringWidth(ch$,sw) LET x= x+sw END IF NEXT i END SUB SUB DrawTheta12(lft,bas,clr) SET COLOR clr LET top= bas-9 FOR row= 0 to 8 LET wy= top+row FOR col= 0 to 7 LET bit= theta(row,col) IF bit=1 then LET wx= lft+col PLOT wx,wy END IF NEXT col NEXT row END SUB 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,btnclr 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 btnclr 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 MODULE PopMenu PUBLIC mlft,mrgt,mbas,mtop PUBLIC poplft,poprgt,popbas,poptop,pophgt,PopUp$ PUBLIC listlft,listrgt,listbas,listtop,eqspc,eqlft DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx ! work area DECLARE PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white DECLARE PUBLIC red,yellow,green,cyan,blue,magenta,colorscheme DECLARE PUBLIC planeclr,gridclr,rimclr,axisclr,axislabelclr,titleclr,rightsclr DECLARE PUBLIC numberlineclr,slotdrkclr,slotlgtclr,slideclr,headerclr,btnclr SUB InitMenu1(mlft,mtop,eq,menu$(),clr) LET maxeq= ubound(menu$) LET mrgt = mlft+17 LET mbas = mtop+17 CALL ShowEquation1(eq,menu$,clr) CALL PopUpTab(mlft,mrgt,mbas,mtop) CALL DrawPopUp1(menu$,eq,maxeq) END SUB SUB InitMenu2(mlft,mtop,eq,menu$(,),clr) LET maxeq= ubound(menu$,1) LET mrgt = mlft+17 LET mbas = mtop+32 CALL ShowEquation2(eq,menu$,clr) CALL PopUpTab(mlft,mrgt,mbas,mtop) CALL DrawPopUp2(menu$,eq,maxeq) END SUB SUB PopUpTab(mlft,mrgt,mbas,mtop) CALL DrawButton(mlft,mrgt,mbas,mtop,0,"") LET sx = mlft+9 LET sy = mtop+9 LET syu= sy + 2 SET COLOR white FOR i= 0 to 5 PLOT sx-i,syu-i; sx+i,syu-i NEXT i END SUB SUB DrawPopUp1(menu$(),eq,maxeq) LOCAL temp$,oldenum,mx,my,ms,et,eb,clearflag,ty CALL SetTextFont(1,12,"bold") LET eqspc = 20 LET pophgt= (maxeq+1)*eqspc+26 IF pophgt>workbas- mtop then LET popbas= workbas ELSE LET popbas= mtop+pophgt END IF LET poptop= popbas-pophgt LET popwid= 0 FOR i= 0 to maxeq CALL StringWidth(menu$(i),sw) IF sw>popwid then LET popwid= sw NEXT i LET poplft = mrgt+2 LET poprgt = poplft+20+popwid+20 LET listlft= poplft+ 5 LET listrgt= poprgt- 5 LET listtop= poptop+22 LET listbas= listtop + (maxeq+1)*eqspc LET eqlft = poplft+22 BOX KEEP poplft,poprgt,popbas,poptop in temp$ CALL Rim(poplft,poprgt,popbas,poptop,0) CALL DrawButton(poplft+5,poplft+20,poptop+20,poptop+5,0,"") FOR i= 0 to maxeq LET et= listtop + (i)*eqspc LET eb= et+eqspc-1 CALL DrawButton(poplft+5,poprgt-5,eb,et,0,"") CALL SuperSubScriptLJ(eqlft,eb-5,menu$(i),white) !CALL DiffEq(eqlft,eb- 6,white,"y",menu$(i)) NEXT i CALL SetTextFont(1,12,"bold") LET ty= listtop + (eq)*eqspc+0.5*eqspc+5 CALL PlotTextLJ(listlft+4,ty,"*",red) BOX KEEP poplft,poprgt,popbas,poptop in PopUp$ PAUSE 1 BOX SHOW temp$ at poplft,popbas LET temp$= "" END SUB SUB DrawPopUp2(menu$(,),eq,maxeq) LOCAL temp$,oldenum,mx,my,ms,et,eb,clearflag,ty CALL SetTextFont(1,12,"bold") LET eqspc = 33 LET pophgt= maxeq*eqspc+26 IF pophgt>workbas- mtop then LET popbas= workbas ELSE LET popbas= mtop+pophgt END IF LET poptop= popbas-pophgt LET popwid= 0 FOR i= 0 to maxeq CALL StringWidth(menu$(i,0),sw) IF sw>popwid then LET popwid= sw CALL StringWidth(menu$(i,1),sw) IF sw>popwid then LET popwid= sw NEXT i LET poplft = mrgt+2 LET poprgt = poplft+20+popwid+20 LET listlft= poplft+ 5 LET listrgt= poprgt- 5 LET listtop= poptop+22 LET listbas= listtop + maxeq*eqspc LET eqlft = poplft+22 BOX KEEP poplft,poprgt,popbas,poptop in temp$ CALL Rim(poplft,poprgt,popbas,poptop,0) CALL DrawButton(poplft+5,poplft+20,poptop+20,poptop+5,0,"") FOR i= 0 to maxeq LET et= listtop + (i-1)*eqspc LET eb= et+eqspc-1 CALL DrawButton(poplft+5,poprgt-5,eb,et,0,"") CALL PlotTextLJ(eqlft,eb-19,menu$(i,0),white) CALL PlotTextLJ(eqlft,eb- 5,menu$(i,1),white) !CALL DiffEq(eqlft,eb- 6,white,"y",menu$(i,1)) NEXT i CALL SetTextFont(1,12,"bold") LET ty= listtop + (eq-1)*eqspc+0.5*eqspc+5 CALL PlotTextLJ(listlft+4,ty,"*",red) BOX KEEP poplft,poprgt,popbas,poptop in PopUp$ PAUSE 10 BOX SHOW temp$ at poplft,popbas LET temp$= "" END SUB SUB ShowEquation1(eq,menu$(),clr) CALL SetTextFont(1,12,"bold") BOX CLEAR mrgt+2,mrgt+150,mbas,mtop CALL SuperSubScriptLJ(mrgt+8,mbas-5,menu$(eq),clr) END SUB SUB ShowEquation2(eq,menu$(,),clr) CALL SetTextFont(1,12,"bold") BOX CLEAR mrgt+2,mrgt+150,mbas,mtop CALL PlotTextLJ(mrgt+8,mbas-19,menu$(eq,0),clr) CALL PlotTextLJ(mrgt+8,mbas- 5,menu$(eq,1),clr) !CALL DiffEq(mrgt+8,mbas- 6,clr,"y",menu$(eq,1)) END SUB SUB DiffEq(dex,dey,clr,x$,eq$) !CALL VarDot(dex,dey,x$,clr) LET e$= " = " & eq$ LET p = pos(e$,"^") CALL SetTextFont(1,12,"bold") IF p<>0 then LET e$= " = " & eq$ CALL AlignSuper(dex+8,dey,4,clr,e$) ELSE CALL PlotTextLJ(dex+8,dey,e$,clr) END IF END SUB SUB ReadPanel(eq) LOCAL temp$,oldenum,mx,my,ms,et,eb,clearflag,ty BOX KEEP poplft,poprgt,popbas,poptop in temp$ BOX SHOW PopUp$ at poplft,popbas LET oldenum= -99999 CALL MouseDown(mx,my,ms) DO GET MOUSE: mx,my,ms IF mx>listlft and mxlisttop and myoldenum then LET oldenum= enum LET et = listtop + eqspc*(enum-1) LET eb = et+eqspc-1 BOX SHOW PopUp$ at poplft,popbas CALL ButtonDown(listlft,listrgt,eb,et) LET clearflag= 1 END IF ELSE IF clearflag=1 then LET clearflag= 0 LET oldenum = -99999 BOX SHOW PopUp$ at poplft,popbas END IF END IF LOOP until ms=3 IF mx>listlft and mxlisttop and my0 and m<>maxnum then LET y1= ftop LET y2= fbas LET x1= (y1-b)/m LET x2= (y2-b)/m IF x1frgt then LET x1= frgt LET y1= m*x1 + b END IF IF x2frgt then LET x2= frgt LET y2= m*x2 + b END IF ELSE IF m=0 then LET y1= b LET y2= b LET x1= flft LET x2= frgt ELSE LET y1= ftop LET y2= fbas LET x1= x LET x2= x END IF IF x1>x2 then LET lx1= x2 LET lx2= x1 LET ly1= y2 LET ly2= y1 ELSE LET lx1= x1 LET lx2= x2 LET ly1= y1 LET ly2= y2 END IF END SUB 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 and yd<>0 then LET ym= yd/xd LET xm= xd/yd IF x2wfRgt then ! clip right LET y2= y1 + ym*(wfRgt-x1) LET x2= wfRgt END IF IF y2wfTop then ! clip top LET x2= x1 + xm*(wfTop-y1) LET y2= wfTop END IF ELSE IF yd=0 then IF x2wfRgt then ! clip right LET y2= y1 + ym*(wfRgt-x1) LET x2= wfRgt END IF ELSE IF xd=0 then IF y2>wfTop then LET y2= wfTop ELSE IF y2 trace^2/4 inside parab ! LET lam= trace/2 ! ! | lam s | ! ! H(s) = | | ! ! | (trace^2/4-dterm)/s lam | ! ! CASE 3 ! dterm < trace^2/2 outside parab ! LET lam= trace/2 - sqr(trace^2/4-dterm) ! ! | lam s | ! ! H(s) = | | ! ! | 0 trace-lam | ! ! ! ---- now multiply to make the A matrix ---- ! ! ! Now we have matrices R+, R- and H and we can define matrix A. ! ! Multiply mat R+ by mat H then multiply the result by mat R- ! ! A = {R(+theta) H(s)} R(-theta) ! ---------- Utility functions --- DEF clamp(n,lo,hi)= min(max(n,lo),hi) DEF roundn(n,step)= round(n/step)*step DEF e= exp(1) DEF notanum= 987656789 ! --- functions, parameters, equations, constants --- IF M68kFlag=1 then LET deltat= 1/32 ELSE LET deltat= 1/16 END IF ! ---------- Graphing plane parameters and methods ---------- ! --- plane 1 data t,x --- 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 w1fHgt, w1fWid, w1wHgt, w1wWid LET w1Flag= 1 LET w1Lft= workLft + 80 ! pixel bounds LET w1Rgt= w1Lft + 160 ! for 6 LET w1Top= workTop + 277 LET w1Bas= w1Top + 160 LET w1size= 4 LET w1fLft= -w1size ! function bounds LET w1fRgt= w1size LET w1fTop= w1size LET w1fBas= -w1size LET w1Xax$= "tr A" ! axis labels LET w1Yax$= "det A" LET w1xGridstep= 0 ! horizontal grid intervals LET w1yGridstep= 0 ! vertical grid intervals LET w1SxTik = 0 ! horizontal axis Tik marks LET w1LxTik = 1 LET w1xLabel= 2 LET w1Firstx= w1fLft LET w1SyTik = 0 ! vertical axis Tik marks LET w1LyTik = 1 LET w1yLabel= 2 LET w1Firsty= w1fBas ! --- Plane 1 methods --- DECLARE DEF w1fncx,w1fncy,w1wndx,w1wndy ! window/function transforms CALL Plane1Variables SUB Plane1Clear BOX CLEAR w1Lft-20,w1Rgt+20,workBas-5,w1Top-20 END SUB SUB Plane1Init LET aspect= (w1wwid/w1fwid)/(w1whgt/w1fhgt) CALL DrawPlane1(0,0,0) ! 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) CALL DrawTDPlane BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in w1GridLayer$ END SUB SUB Plane1Refresh BOX SHOW w1gridLayer$ at w1Lft-5,w1Bas+5 END SUB SUB Plane1GraphRefresh BOX SHOW w1graphLayer$ at w1Lft-5,w1Bas+5 END SUB ! ------------------------------------------ ! --- plane 2 data: phase line --- DECLARE PUBLIC w2Lft,w2Rgt,w2Bas,w2Top,w2Midx,w2Midy DECLARE PUBLIC w2fLft,w2fRgt,w2fBas,w2fTop,w2x0,w2y0 DECLARE PUBLIC w2Firstx, w2SxTik, w2LxTik, w2xLabel, w2xGridstep DECLARE PUBLIC w2Firsty, w2SyTik, w2LyTik, w2yLabel, w2yGridstep DECLARE PUBLIC w2xPiFlag LET w2Flag= 1 LET w2Lft = workrgt- 400 ! pixel bounds LET w2Rgt = w2Lft + 360 LET w2Top = worktop + 30 LET w2Bas = w2Top + 360 LET w2fLft= -4 ! function bounds * pi LET w2fRgt= 4 LET w2fTop= 4 LET w2fBas= -4 LET w2xGridstep= 0 ! horizontal grid intervals LET w2yGridstep= 0 ! vertical grid intervals LET w2xAx$= "x" ! axis labels LET w2yAx$= "y" LET w2SxTik = 1/2 ! horizontal axis Tik marks LET w2LxTik = 1 LET w2xLabel= 1 LET w2Firstx= w2fLft LET w2SyTik = 1/2 ! vertical axis Tik marks LET w2LyTik = 1 LET w2yLabel= 1 LET w2Firsty= w2fBas ! --- plane 2 methods --- DECLARE DEF w2fncx, w2fncy, w2wndx, w2wndy ! window/function transforms CALL Plane2Variables SUB Plane2Init CALL DrawPlane2(0,0,1) ! grid, axes, zeroaxes CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(w2Rgt+8,w2y0+3,w2xAx$,axislabelclr) ! axis labels CALL PlotTextCJ(w2x0,w2Top-10,w2yAx$,axislabelclr) BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2gridLayer$ BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2GraphLayer$ BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2FieldLayer$ END SUB SUB Plane2Clear BOX CLEAR w2Lft,w2Rgt,w2Bas,w2Top END SUB SUB Plane2Refresh BOX SHOW w2gridLayer$ at w2Lft-5,w2Bas+5 BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2GraphLayer$ BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2FieldLayer$ END SUB SUB Plane2Graph BOX SHOW w2GraphLayer$ at w2Lft-5,w2Bas+5 END SUB SUB Plane2Field BOX SHOW w2FieldLayer$ at w2Lft-5,w2Bas+5 BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2GraphLayer$ END SUB ! ------------------------------------------ ! --- plane 3 data: DE graph --- DECLARE PUBLIC w3Lft,w3Rgt,w3Bas,w3Top,w3Midx,w3Midy DECLARE PUBLIC w3fLft,w3fRgt,w3fBas,w3fTop,w3x0,w3y0 DECLARE PUBLIC w3Firstx, w3SxTik, w3LxTik, w3xLabel, w3xGridstep DECLARE PUBLIC w3Firsty, w3SyTik, w3LyTik, w3yLabel, w3yGridstep LET w3Flag= 1 ! plane is turned on or off LET w3Lft = w1Lft ! pixel bounds LET w3Rgt = w1Rgt LET w3Top = worktop+30 LET w3Bas = w3Top +160 LET w3fLft= 0 ! function bounds LET w3fRgt= pi LET w3fTop= 4 LET w3fBas= -4 LET w3xAx$= "theta" ! axis labels LET w3yAx$= "s" LET w3xGridstep= 0 ! grid line intervals LET w3yGridstep= 0 LET w3SxTik = 0 ! axis Tik marks LET w3LxTik = 1 LET w3xLabel= 1 LET w3Firstx= 0 LET w3SyTik = 1 LET w3LyTik = 2 LET w3yLabel= 2 LET w3Firsty= w3fBas ! --- plane 3 methods --- DECLARE DEF w3fncx,w3fncy,w3wndx,w3wndy ! window/function transforms CALL Plane3Variables SUB Plane3Clear BOX CLEAR w3Lft-20,w3Rgt+20,workBas-5,w3Top-20 END SUB SUB Plane3Init CALL DrawPlane3(0,0,0) ! grid, axes, zeroaxes ! CALL SetTextFont(1,12,"bold") ! CALL PlotTextLJ(w3Rgt+8,w3y0+3,w3xAx$,axislabelclr) ! axis labels ! CALL PlotTextCJ(w3x0,w3Top-10,w3yAx$,axislabelclr) ! LET dotx= w3x0-1 ! LET doty= w3Top-19 ! BOX AREA dotx,dotx+1,doty,doty-1 PLOT w3Lft,w3y0; w3Rgt,w3y0 BOX KEEP w3Lft-5,w3Rgt+5,w3Bas+5,w3Top-5 in w3gridLayer$ LET w3GraphLayer$= w3GridLayer$ END SUB SUB w3Refresh BOX SHOW w3gridLayer$ at w3Lft-5,w3Bas+5 END SUB SUB w3Graph BOX SHOW w3graphLayer$ at w3Lft-5,w3Bas+5 END SUB ! --- plane 4 data: bifurcation plane --- DECLARE PUBLIC w4Lft,w4Rgt,w4Bas,w4Top,w4Midx,w4Midy,w4wwid DECLARE PUBLIC w4fLft,w4fRgt,w4fBas,w4fTop,w4x0,w4y0 DECLARE PUBLIC w4Firstx, w4SxTik, w4LxTik, w4xLabel, w4xGridstep DECLARE PUBLIC w4Firsty, w4SyTik, w4LyTik, w4yLabel, w4yGridstep LET w4Flag= 1 ! plane is turned on or off LET w4Lft = w1lft ! pixel bounds LET w4Rgt = w4Lft + 80 LET w4Top = workbas - 140 LET w4Bas = w4Top + 80 LET w4fLft= -4 ! function bounds LET w4fRgt= 4 LET w4fTop= 4 LET w4fBas= -4 LET w4xAx$= "Re" ! axis labels LET w4yAx$= "Im" LET w4xGridstep= 0 ! grid line intervals LET w4yGridstep= 0 LET w4SxTik = 1 ! axis Tik marks LET w4LxTik = 2 LET w4xLabel= 2 LET w4Firstx= w4fLft LET w4SyTik = 1 LET w4LyTik = 2 LET w4yLabel= 2 LET w4Firsty= w4fBas ! --- plane 4 methods --- DECLARE DEF w4fncx,w4fncy,w4wndx,w4wndy ! window/function transforms CALL Plane4Variables SUB Plane4Clear BOX CLEAR w4Lft-20,w4Rgt+20,workBas-5,w4Top-20 END SUB SUB Plane4Init CALL DrawPlane4(1,1,1) ! grid, axes, zeroaxes CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(w4Rgt+8,w4y0+3,w4xAx$,axislabelclr) ! axis labels CALL PlotTextCJ(w4x0,w4Top-10,w4yAx$,axislabelclr) BOX KEEP w4Lft-5,w4Rgt+5,w4Bas+5,w4Top-5 in w4gridLayer$ END SUB SUB Plane4Refresh BOX SHOW w4gridLayer$ at w4Lft-5,w4Bas+5 END SUB ! ------ matrix ------ LET lnspc= 15 LET mtop = w2Bas + 65 LET mbas = mtop + 38 LET mlft = w2Lft + 30 LET mrgt = mlft + 115 LET mtxt0= mtop+14 LET mtxt1= mtop+33 LET mcol1= mlft+10 LET mcol2= mcol1+50 LET mmidx= int((mlft+mrgt)/2) ! ---- matrices ---- DIM Rm(1:2,1:2) DIM Rp(1:2,1:2) DIM Ht(1:2,1:2) DIM A1(1:2,1:2) DIM A2(1:2,1:2) SUB ShowMatrixValues CALL SetTextFont(1,12,"bold") LET matclr= white CALL ClearMatrixValues CALL PlotTextLJ(mcol1,mtxt0,using$("--%.##",ma),matclr) CALL PlotTextLJ(mcol2,mtxt0,using$("--%.##",mb),matclr) CALL PlotTextLJ(mcol1,mtxt1,using$("--%.##",mc),matclr) CALL PlotTextLJ(mcol2,mtxt1,using$("--%.##",md),matclr) END SUB SUB ClearMatrixValues BOX CLEAR mlft+3,mrgt-3,mtxt0+3,mtxt0-10 ! upper row BOX CLEAR mlft+3,mrgt-3,mtxt1+3,mtxt1-10 ! lower row END SUB SUB DrawMatrix CALL SetTextFont(1,12,"bold") LET midm= int((mtop+mbas)/2) CALL PlotTextRJ(mlft-5,midm+3,"A =",white) SET COLOR litmid ! matrix brackets CALL SetLineWeight(2) PLOT mlft+4,mtop; mlft,mtop; mlft,mbas; mlft+4,mbas PLOT mrgt-4,mtop; mrgt,mtop; mrgt,mbas; mrgt-4,mbas CALL SetLineWeight(1) END SUB ! ----------- vertical sliders ------------ ! --- 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 = white LET v1name$= "D" LET v1form$= "-%.##" LET v1m = 1 LET v1a = 0 LET v1olda = -999 LET v1axis = w1Lft - 30 LET v1wBas = w1Bas LET v1wTop = w1Top LET v1fBas = -4 LET v1fTop = 4 LET v1STik = 0 LET v1LTik = 1 LET v1Label= 1 LET v1First= v1fBas CALL v1SliderVariables ! --- vertical slider 2 --- DECLARE DEF v2Fncy,v2wndy ! window/function transforms DECLARE PUBLIC v2axis,v2wLft,v2wRgt,v2wBas,v2wTop,v2sBas,v2sTop DECLARE PUBLIC v2fBas,v2fTop,v2First,v2STik,v2LTik,v2Label DECLARE PUBLIC v2name$,v2m,v2form$,v2Clr LET v2Clr = white LET v2name$= "s" LET v2form$= "-%.##" LET v2m = 1 LET v2a = 0 LET v2olda = -999 LET v2axis = w3Lft - 30 LET v2wBas = w3Bas LET v2wTop = w3Top LET v2fTop = 4 LET v2fBas = -4 LET v2STik = 0 LET v2LTik = 1 LET v2Label= 1 LET v2First= v2fBas CALL v2SliderVariables ! ---- matrix sliders ---- LET matslidebound= 4 LET matslidewid = 80 ! ---- 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 = white LET h1name$= "a" LET h1form$= "-%.#" LET h1m = 1 LET h1a = 0 LET h1olda = -999 LET h1axis = workbas-70 LET h1wLft = w1Lft LET h1wRgt = h1wLft+matslidewid LET h1fLft = -matslidebound LET h1fRgt = matslidebound LET h1STik = 1 ! short tick marks LET h1LTik = matslidebound ! long tick marks LET h1Label= matslidebound ! labels LET h1First= h1fLft ! first tick mark 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 = white LET h2name$ = "b" LET h2form$ = "--%.#" LET h2m = 1 LET h2axis = h1axis LET h2wLft = h1wRgt + 80 LET h2wRgt = h2wLft + matslidewid LET h2fLft = -matslidebound LET h2fRgt = matslidebound LET h2STik = 1 LET h2LTik = matslidebound LET h2Label= matslidebound LET h2First= h2fLft 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 = white LET h3name$ = "c" LET h3form$ = "--%.#" LET h3m = 1 LET h3axis = h1axis + 40 LET h3wLft = h1wLft LET h3wRgt = h1wRgt LET h3fLft = -matslidebound LET h3fRgt = matslidebound LET h3STik = 1 LET h3LTik = matslidebound LET h3Label= matslidebound LET h3First= h3fLft 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 = white LET h4name$ = "d" LET h4form$ = "--%.#" LET h4m = 1 LET h4axis = h3axis LET h4wLft = h2wLft LET h4wRgt = h2wRgt LET h4fLft = -matslidebound LET h4fRgt = matslidebound LET h4STik = 1 LET h4LTik = matslidebound LET h4Label= matslidebound LET h4First= h4fLft CALL h4SliderVariables ! ---- s and theta sliders ---- ! --- 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 = white LET h5name$ = "T" LET h5form$ = "--%.##" LET h5m = 1 LET h5axis = w1Bas + 30 LET h5wLft = w1Lft LET h5wRgt = w1Rgt LET h5fLft = -4 LET h5fRgt = 4 LET h5STik = 0 LET h5LTik = 1 LET h5Label= 1 LET h5First= h5fLft 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 = white LET h6name$= "" LET h6form$= "--%.##" LET h6m = 1 LET h6axis = w3Bas + 30 LET h6wLft = w3Lft LET h6wRgt = w3Rgt LET h6fLft = 0 LET h6fRgt = pi LET h6STik = 0 LET h6LTik = 1 LET h6Label= 1 LET h6First= 0 CALL h6SliderVariables SUB h6Initialize CALL h6DrawSlider(theta) PLOT h6wLft,h6axis-1; h6wRgt,h6axis-1 ! slider axis CALL DrawTheta12(h6wlft-16,h6wbas-1,white) ! slider variable label CALL SetTextFont(1,9,"normal") ! label axis PLOT h6wLft,h6axis-1; h6wLft,h6axis-5 CALL PlotTextCJ(h6wLft+1,h6axis-7,"0",white) PLOT h6wRgt,h6axis-1; h6wRgt,h6axis-5 DRAW pi9 with shift(h6wRgt-3,h6axis-7) END SUB ! ---- end of slider parameters ---- ! ----- text locations ----- ! ---- initial values x and y ---- LET ivlft = w2Rgt - 100 LET ivrgt = w2Rgt LET ivbas1= w2Bas + 22 LET ivbas2= ivbas1+ 20 SUB SetIV(x0,y0) CALL SetTextFont(1,12,"bold") CALL ClearIV LET x$= "x(0) = " & using$("-%.##",x0) CALL PlotTextLJ(ivlft,ivbas1,x$,tclr) LET y$= "y(0) = " & using$("-%.##",y0) CALL PlotTextLJ(ivlft,ivbas2,y$,tclr) END SUB SUB ClearIV BOX CLEAR ivlft-2,ivrgt,ivbas2+5,ivbas1-15 END SUB ! ---- classification name ---- LET lclft = w2lft LET lcbas = ivbas2 SUB SetClassification(name$) BOX CLEAR lcLft,lcLft+170,lcbas+5,lcbas-15 ! name$ CALL SuperSubScriptLJ(lcLft,lcBas,name$,tclr) END SUB SUB ClearClassification BOX CLEAR lcLft,lcLft+170,lcbas+5,lcbas-15 ! name$ END SUB ! ---- trace and determinant ---- LET tdlft1= w1lft - 15 LET tdlft2= tdlft1 LET tdrgt = w1rgt + 15 LET tdbas1= w1bas + 40 LET tdbas2= tdbas1 + 20 LET tdeqx = tdlft1 + 60 SUB SetTDtext CALL ClearTDtext CALL SetTextFont( 1,12,"bold") CALL PlotTextRJ(tdeqx,tdbas1,"tr A = ",white) CALL PlotTextRJ(tdeqx,tdbas2,"det A = ",white) CALL PlotTextLJ(tdeqx,tdbas1,using$("--%.##",trace),white) CALL PlotTextLJ(tdeqx,tdbas2,using$("--%.##",dterm),white) END SUB SUB ClearTDtext BOX CLEAR tdlft1,tdrgt,tdbas2+5,tdbas1-15 END SUB ! --- theta and s --- LET stlft = w3Lft LET strgt = w3Rgt LET stbas1= w3Bas + 40 LET stbas2= stbas1 + 20 LET steqx = stlft + 60 SUB SetSTtext CALL ClearST LET x$= "s = " & using$("-%.##",s) CALL PlotTextLJ(stlft,stbas1,x$,white) LET y$= "t = " & using$("-%.##",theta) CALL PlotTextLJ(stlft,stbas2,y$,white) END SUB SUB ClearST BOX CLEAR stlft-2,strgt,stbas2+5,stbas1-15 END SUB ! ---- lam text --- LET lamlft = mrgt + 40 LET lamrgt = lamlft+120 LET lambas1= mtxt0 LET lambas2= mtxt1 SUB SetLamtext CALL FindLamdas CALL ClearLamdas CALL DrawLam(lamlft+12,lambas1,white) CALL DrawLam(lamlft+12,lambas2,white) CALL SetTextFont(1,9,"bold") CALL PlotTextLJ(lamlft+21,lambas1+4,"1",white) CALL PlotTextLJ(lamlft+21,lambas2+4,"2",white) CALL SetTextFont( 1,12,"bold") CALL PlotTextLJ(lamlft+32,lambas1,"=",white) CALL PlotTextLJ(lamlft+32,lambas2,"=",white) CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(lamlft+44,lambas1,l1$,white) CALL PlotTextLJ(lamlft+44,lambas2,l2$,white) END SUB SUB ClearLamdas BOX CLEAR lamlft-2,lamlft+155,lambas2+5,lambas1-15 END SUB ! ---- end of text locations ---- ! --- functions DEF dxdt(x,y)= ma*x + mb*y DEF dydt(x,y)= mc*x + md*y DEF fT(ma,mb,mc,md) = ma+md DEF fD(ma,mb,mc,md) = ma*md - mb*mc DEF fDsc(trace,dterm)= trace*trace - 4*dterm SUB MatToTD(ma,mb,mc,md,trace,dterm) LET trace= fT(ma,mb,mc,md) ! find trace LET dterm= fD(ma,mb,mc,md) ! find determinant !LET dscrm= fDsc(trace,dterm) ! find discriminant END SUB ! SUB TDtoMat(ma,mb,mc,md,trace,dterm) ! LET ma= 0 ! LET mb= 1 ! LET mc= -dterm ! LET md= trace ! END SUB SUB TDProximity ! close to zero? IF abs(dterm)<.12 then LET dterm= 0 IF abs(trace)<.12 then LET trace= 0 ! close to parabola? LET parab= trace^2/4 ! parab is on the parabola IF dterm>parab-0.12 and dtermw2Lft and mxw2Top and mymx or omy<>my then CALL w2RollOver(mx,my) LET clearflag2= 1 LET omx= mx LET omy= my END IF ELSE IF clearflag2=1 then CALL Plane2Graph CALL ClearIV LET clearflag2= 0 END IF LOOP until ms=2 IF mx>w1Lft and mxw1Top and myw1Lft and mxw1Top and mymx or omy<>my then LET trace= w1fncx(mx) LET dterm= w1fncy(my) CALL TDProximity CALL TDSliderAction CALL v1Mark(dterm) CALL h5Mark(trace) LET omx= mx LET omy= my END IF END IF LOOP until ms=3 ELSE IF mx>w2Lft and mxw2Top and myw2Lft and mxw2Top and mymx or omy<>my then LET x0 = w2fncx(mx) LET y0 = w2fncy(my) CALL Plane2Graph CALL SetVector(x0,y0,x2,y2,.2) CALL SetIV(x0,y0) LET omx= mx LET omy= my END IF END IF LOOP until ms=3 CALL Plane2Graph CALL Trajectory(x0,y0) BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2graphLayer$ ELSE IF mx>w3Lft and mxw3Top and myw3Lft and mxw3Top and myoldmx or my<>oldmy then LET s= w3Fncy(my) IF s>-.12 and s<.12 then LET s= 0 LET theta= w3Fncx(mx) CALL ParameterSliderAction CALL v2Mark(s) CALL h6Mark(theta) LET oldmy= my LET oldmx= mx END IF END IF LOOP until ms=3 ELSE IF mx>=v1wLft and mx<=v1wRgt and my>v1wTop-3 and my=v1wTop-3 and my<=v1wBas+3 then CALL v1Event(0) END IF LOOP until ms=3 END IF ELSE IF mx>=v2wLft and mx<=v2wRgt and my>v2wTop-3 and my=v2wTop-3 and my<=v2wBas+3 then CALL v2Event(0) END IF LOOP until ms=3 END IF ! ELSE IF mx>=h1wLft-2 and mx<=h1wRgt+2 and my>h1wTop and my=h1wLft-2 and mx<=h1wRgt+2 then ! CALL h1Event(0) ! END IF ! LOOP until ms=3 ! END IF ! ELSE IF mx>=h2wLft-2 and mx<=h2wRgt+2 and my>h2wTop and my=h2wLft-2 and mx<=h2wRgt+2 then ! CALL h2Event(0) ! END IF ! LOOP until ms=3 ! END IF ! ELSE IF mx>=h3wLft-2 and mx<=h3wRgt+2 and my>h3wTop and my=h3wLft-2 and mx<=h3wRgt+2 then ! CALL h3Event(0) ! END IF ! LOOP until ms=3 ! END IF ! ELSE IF mx>=h4wLft-2 and mx<=h4wRgt+2 and my>h4wTop and my=h4wLft-2 and mx<=h4wRgt+2 then ! CALL h4Event(0) ! END IF ! LOOP until ms=3 ! END IF ELSE IF mx>=h5wLft-2 and mx<=h5wRgt+2 and my>h5wTop and my=h5wLft-2 and mx<=h5wRgt+2 then CALL h5Event(0) END IF LOOP until ms=3 END IF ELSE IF mx>=h6wLft-2 and mx<=h6wRgt+2 and my>h6wTop and my=h6wLft-2 and mx<=h6wRgt+2 then CALL h6Event(0) END IF LOOP until ms=3 END IF ELSE IF mx>clft and mxctop and myinfLft and mxinfTop and myqLft and mxqTop and myoldx1 then LET oldx1= mx LET ma = h1fncx(mx) LET ma = min(max(ma,h1fLft),h1fRgt) IF action=1 then LET ma= roundn(ma,h1STik) ELSE LET ma= round(ma,2) ! needed to get ma clean zero END IF CALL h1mark(ma) CALL MatrixSliderAction END IF END SUB SUB h2Event(action) IF mx<>oldx2 then LET oldx2= mx LET mb = h2fncx(mx) LET mb = min(max(mb,h2fLft),h2fRgt) IF action=1 then LET mb= roundn(mb,h2STik) ELSE LET mb= round(mb,2) ! needed to get ma clean zero END IF CALL h2mark(mb) CALL MatrixSliderAction END IF END SUB SUB h3Event(action) IF mx<>oldx3 then LET oldx3= mx LET mc = h3fncx(mx) LET mc = min(max(mc,h3fLft),h3fRgt) IF action=1 then LET mc= roundn(mc,h3STik) ELSE LET mc= round(mc,2) ! needed to get ma clean zero END IF CALL h3mark(mc) CALL MatrixSliderAction END IF END SUB SUB h4Event(action) IF mx<>oldx4 then LET oldx4= mx LET md = h4fncx(mx) LET md = min(max(md,h4fLft),h4fRgt) IF action=1 then LET md= roundn(md,h4STik) ELSE LET md= round(md,2) ! needed to get ma clean zero END IF CALL h4mark(md) CALL MatrixSliderAction END IF END SUB SUB SetMatrixSliders(ma,mb,mc,md) ! CALL h1Mark(ma) ! CALL h2Mark(mb) ! CALL h3Mark(mc) ! CALL h4Mark(md) END SUB SUB MatrixSliderAction CALL MatToTD(ma,mb,mc,md,trace,dterm) CALL FindLamdas CALL Classification(trace,dterm,dscrm,cmplx,name$,tclr) CALL VectorField CALL FindEigenVectors(ma,mb,mc,md) CALL ShowMatrixValues CALL SetLamtext ! CALL SetTDtext CALL MarkTDCursor(trace,dterm) END SUB ! ----- trace and determinant sliders ----- SUB v1Event(action) IF my<>oldy1 then LET dterm= v1Fncy(my) LET dterm= min(max(dterm,v1fBas),v1fTop) IF action=1 then LET dterm= roundn(dterm,v1LTik) ELSE LET dterm= round(dterm,2) ! needed to get dterm clean zero END IF IF dterm>=0 then ! upper half plane? ! check for parabola LET signdt= sgn(dterm) LET y = trace^2/4 IF abs(abs(dterm)-abs(y))<.12 then LET dterm= signdt*y LET parab= dterm END IF END IF CALL v1mark(dterm) CALL TDSliderAction LET oldy1= my END IF END SUB SUB h5Event(action) IF mx<>oldx5 then LET trace= h5fncx(mx) LET trace= min(max(trace,h5fLft),h5fRgt) IF action=1 then LET trace= roundn(trace,h5LTik) ELSE LET trace= round(trace,2) ! needed to get a clean zero END IF IF dterm>=0 then ! upper half plane? ! check for parabola LET signtr= sgn(trace) LET x = abs(sqr(4*dterm)) IF abs(abs(trace)-x)<0.12 then LET trace= signtr*x LET dterm= trace^2/4 LET parab= dterm END IF END IF CALL h5mark(trace) CALL TDSliderAction LET oldx5= mx END IF END SUB SUB TDSliderAction CALL MarkTDCursor(trace,dterm) CALL TDSandThetaToMatrix(trace,dterm,theta,s) CALL ShowMatrixValues CALL SetLamtext CALL Classification(trace,dterm,dscrm,cmplx,name$,tclr) CALL DrawThetaPlane(trace,dterm) CALL VectorField CALL FindEigenVectors(ma,mb,mc,md) ! CALL SetMatrixSliders(ma,mb,mc,md) END SUB ! ----- s and theta plane ----- SUB v2Event(action) IF my<>oldy1 then LET s= v2fncy(my) LET s= min(max(s,v2fBas),v2fTop) IF action=1 then LET s= roundn(s,v2LTik) ELSE LET s= round(s,2) ! needed to get s clean zero END IF IF abs(s)>=omega then CALL v2mark(s) END IF CALL ParameterSliderAction LET oldy1= my END IF END SUB SUB h6Event(action) IF mx<>oldx6 then LET theta= h6fncx(mx) LET theta= min(max(theta,h6fLft),h6fRgt) IF action=1 then LET theta= roundn(theta,h6LTik) ELSE LET theta= round(theta,2) ! needed to get a clean zero END IF CALL h6mark(theta) CALL ParameterSliderAction LET oldx6= mx END IF END SUB SUB ParameterSliderAction IF thisCase<>2 or (thisCase=2 and abs(s)>omega) then CALL MarkTSCursor(theta,s) CALL TDSandThetaToMatrix(trace,dterm,theta,s) CALL VectorField CALL FindEigenVectors(ma,mb,mc,md) CALL ShowMatrixValues ! CALL SetMatrixSliders(ma,mb,mc,md) END IF END SUB ! ---- end of slider routines ---- ! ------ eigen values and directions ---- SUB SetCase(thisCase) LET parab= trace^2/4 IF dterm=parab then ! on the parabola - one real ! The plane is continous - the horizontal axis matters LET thisCase= 1 ELSE IF dterm>parab then ! inside the parabola - complex ! The plane has two active regions LET thisCase= 2 ELSE IF dterm 0 ! two real roots ! Case 1: dscrm>0 outside parabola - two roots - lam10 then ! two real roots IF mc=0 and md=0 then ! first row points needed? LET x= 2*mb LET y= md-ma-sqr(dscrm) CALL CheckEigenPoint(x,y) LET y= md-ma+sqr(dscrm) CALL CheckEigenPoint(x,y) ELSE ! otherwise second row points IF mc<>0 then LET y= 2*mc LET x= ma-md-sqr(dscrm) CALL CheckEigenPoint(x,y) LET x= ma-md+sqr(dscrm) CALL CheckEigenPoint(x,y) ELSE LET y= 0 LET x= 1 CALL CheckEigenPoint(x,y) IF mb=0 then LET x= 0 LET y= 1 CALL CheckEigenPoint(x,y) ELSE LET x= 1 LET y= (md-ma)/mb CALL CheckEigenPoint(x,y) END IF END IF END IF END IF BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2FieldLayer$ LET w2GraphLayer$= w2FieldLayer$ END SUB SUB CheckEigenPoint(x,y) LET w = w2fRgt LET ex= round(x,8) LET ey= round(y,8) IF ex=0 and ey=0 then ! vertical LET wy1= w2Top LET wx1= w2Wndx(0) LET wy2= w2Bas LET wx2= w2Wndx(0) SET COLOR tclr PLOT wx1,wy1; wx2,wy2 ELSE IF abs(ey)>=abs(ex) then ! tall - scale y to 4 LET scl= w/ey CALL DrawEDirection(ex,ey,scl) ELSE IF abs(ex)>abs(ey) then ! wide - scale x to 4 LET scl= w/ex CALL DrawEDirection(ex,ey,scl) END IF END SUB SUB DrawEDirection(ex,ey,scl) LET bx = ex*scl LET by = ey*scl LET wy1= w2Wndy( by) LET wx1= w2Wndx( bx) LET wy2= w2Wndy(-by) LET wx2= w2Wndx(-bx) SET COLOR tclr PLOT wx1,wy1; wx2,wy2 END SUB ! --- end of slider matrix routines --- SUB Classification(trace,dterm,dscrm,cmplx,name$,tclr) IF dterm=0 then ! horizontal axis of TD plane LET tclr = pink LET name$= "degenerate" ! trace= 0: points ! "origin" , "isolated fixed points" , "zero eigenvalues" ! trace<>0: parallel lines ! "nonisolated fixed points" , "multiple equilibrium points" , "zero eigenvalue" ELSE IF dterm<0 then ! saddle LET tclr = blue LET name$= "saddle" ELSE IF dterm>0 then ! upper half plane IF dscrm=0 then ! on the parabola LET tclr = yellow IF ma=md and mb=0 and mc=0 then ! star IF trace>0 then LET name$= "star source" ELSE IF trace<0 then LET name$= "star sink" END IF ELSE ! node LET name$= "improper node" END IF ! "tr^[2] = 4 det" , "repeated eigenvalue" ELSE IF trace<0 then ! left half - stable IF dscrm>0 then ! complex - within parab LET tclr = green LET name$= "nodal sink" ! "stable node" ELSE LET tclr = red LET name$= "spiral sink" ! "stable spiral" END IF ELSE IF trace>0 then ! right half - unstable IF dscrm>0 then ! complex LET tclr = magenta LET name$= "nodal source" ! "unstable node" ELSE LET tclr = cyan LET name$= "spiral source" ! "unstable spiral" END IF ELSE IF trace=0 then ! neutral center LET tclr = white LET name$= "center" END IF END IF CALL SetClassification(name$) END SUB SUB DrawThetaPlane(trace,dterm) ! D = T^2/4 ! on the parabola ! 4D = T^2 ! 0 = T^2 - 4D ! dscrm = T^2 - 4D ! discriminant ! CALL SetCase(thisCase) IF dscrm=0 then ! on the parabola ! The plane is continous but the horizontal axis is ! significant for defining radial symmetry. All the points ! along s=0 actually refer to the same "star" matrix, namely ! | T/2 0 | ! | | ! | 0 T/2 | SET COLOR yellow CALL w3Refresh PLOT w3Lft,w3y0; w3Rgt,w3y0 ELSE IF dscrm<0 then ! inside the parabola ! The plane has two active regions - the region from ! -omega to omega on the vertical is inactive. WHEN error in LET oldomega= omega LET omega = sqr(dterm - trace^2/4) ! omega measures distance from parabola ! like discriminant, but opposite sign and smaller USE LET omega= oldomega END WHEN IF omega<>0 and abs(s)0 then ! outside the parabola ! The plane is continous. CALL w3Refresh END IF BOX KEEP w3Lft-5,w3Rgt+5,w3Bas+5,w3Top-5 in w3GraphLayer$ CALL MarkTSCursor(theta,s) END SUB SUB TDSandThetaToMatrix(trace,dterm,theta,s) CALL SetCase(thisCase) IF thisCase=2 and s>-omega and s trace^2/4 inside parab ! | lam s | ! H(s) = | | ! | (trace^2/4-dterm)/s lam | LET lam= trace/2 IF s<>0 then LET Ht(1,1)= lam LET Ht(1,2)= s LET Ht(2,1)= (trace^2/4-dterm)/s LET Ht(2,2)= lam END IF CASE 3 ! dterm < trace^2/2 outside parab ! | lam s | ! H(s) = | | ! | 0 trace-lam | LET lam= trace/2 - sqr(trace^2/4-dterm) LET Ht(1,1)= lam LET Ht(1,2)= s LET Ht(2,1)= 0 LET Ht(2,2)= trace-lam CASE else END SELECT ! ---- now multiply to make the ma matrix ---- ! Now we have matrices R+, R- and H and we can define matrix ma. ! Multiply mat R+ by mat H then multiply the result by mat R- ! ma = {R(+theta) H(s)} R(-theta) MAT A1= Rp*Ht MAT A2= A1*Rm LET ma= round(A2(1,1),8) LET mb= round(A2(1,2),8) LET mc= round(A2(2,1),8) LET md= round(A2(2,2),8) IF thisCase=1 then ! reclassify? CALL Classification(trace,dterm,dscrm,cmplx,name$,tclr) END IF END SUB SUB DrawEValues(lam1,lam2) BOX SHOW w4GridLayer$ at w4lft-5,w4bas+5 IF cmplx=0 then LET wx= w4Wndx(lam1) IF wx>w4lft and wxlam1 then LET wx= w4Wndx(lam2) IF wx>w4lft and wxw4top and wy2w4lft and wxw2Lft and wx0w2Top and wy00 or dy<>0 then ! LET ang= angle(dx,-dy) ! LET sa = 10*sin(ang) ! LET ca = 10*cos(ang) ! LET wx0= wx+ca ! LET wy0= wy+sa ! PLOT wx,wy; wx0,wy0 ! CALL VectorHead(ang,wx,wy,wx0,wy0) ! ELSE ! PLOT wx,wy ! END IF NEXT wy NEXT wx BOX KEEP w2Lft-5,w2Rgt+5,w2Bas+5,w2Top-5 in w2FieldLayer$ LET w2GraphLayer$= w2FieldLayer$ END SUB SUB VectorHead(ang,wx,wy,wx0,wy0) CALL SetMat(ang) CALL Rotate(6, 2,x1,y1) CALL Rotate(6,-2,x2,y2) LET wx1= wx+x1 LET wy1= wy+y1 LET wx2= wx+x2 LET wy2= wy+y2 PLOT wx1,wy1; wx0,wy0; wx2,wy2 END SUB SUB Rotate(xin,yin,xout,yout) LET xout= xin*vma + yin*vmc LET yout= xin*vmb + yin*vmd END SUB SUB SetMat(ang) LET vma= cos(ang) LET vmb= sin(ang) LET vmc= -vmb LET vmd= vma END SUB ! ----- Rollover vector subs ----- SUB SetVector(x1,y1,x2,y2,tmstp) ! CALL FetchEq(eq,x1,y1,dx,dy) LET dx= dxdt(x1,y1) LET dy= dydt(x1,y1) LET x2 = x1 + dx*tmstp LET y2 = y1 + dy*tmstp LET head= 0 IF x2>w2fLft and x2w2fBas and y20 or dy<>0) then DRAW VectPnt with rotate(angle(dx,-dy))*shift(wx2,wy2) END IF END SUB ! ---- end of vector field routines --- ! ---- trajectory and RK4 ----- SUB Trajectory(x0,y0) SET COLOR tclr FOR n= 1 to -1 step -2 LET oldflag= 1 LET stp= n*tstep LET x = x0 LET y = y0 LET wx = w2Wndx(x) LET wy = w2Wndy(y) PLOT w2Wndx(x),w2Wndy(y) FOR i= 1 to 1000 ! draw trajectory LET starttime= time LET oldwx= wx LET oldwy= wy LET wx = w2Wndx(x) LET wy = w2Wndy(y) IF wx>w2Lft and wxw2Top and wy10 then IF trace=0 then PLOT EXIT SUB END IF END IF GET MOUSE: mx,my,ms IF ms=2 then EXIT SUB END IF IF (abs(dx)<.005 and abs(dy)<.005) or abs(x)>12 or abs(y)>12 then EXIT FOR END IF NEXT i PLOT IF trace=0 and dterm>0 then EXIT FOR DO LOOP until time-starttime>1/60 NEXT n END SUB SUB RungeKutta4(x,y,dx,dy,tstp) LET dx1= dxdt(x,y) LET dy1= dydt(x,y) LET x1 = x + .5*dx1*tstp LET y1 = y + .5*dy1*tstp LET dx2= dxdt(x1,y1) LET dy2= dydt(x1,y1) LET x2 = x + .5*dx2*tstp LET y2 = y + .5*dy2*tstp LET dx3= dxdt(x2,y2) LET dy3= dydt(x2,y2) LET x3 = x + dx3*tstp LET y3 = y + dy3*tstp LET dx4= dxdt(x3,y3) LET dy4= dydt(x3,y3) LET dy = (dy1 + 2*dy2 + 2*dy3 + dy4) / 6 LET dx = (dx1 + 2*dx2 + 2*dx3 + dx4) / 6 LET y = y + tstp*dy LET x = x + tstp*dx END SUB ! ---- draw the trace determinant plane ---- SUB DrawTDPlane SET COLOR blue BOX AREA w1Lft,w1Rgt,w1Bas-1,w1y0 SET COLOR green BOX AREA w1Lft,w1x0-1,w1y0-1,w1Top SET COLOR magenta BOX AREA w1x0+1,w1Rgt,w1y0,w1Top SET COLOR pink PLOT w1Lft,w1y0 ; w1Rgt,w1y0 PLOT w1Lft,w1y0+1; w1Rgt,w1y0+1 FOR wx= w1Lft to w1Rgt ! fill inside parabola LET fx= w1fncx(wx) LET fy= 0.25*fx*fx LET wy= w1Wndy(fy) IF fx<0 then SET COLOR red ELSE SET COLOR cyan END IF PLOT wx,wy; wx,w1Top NEXT wx CALL SetLineWeight(2) SET COLOR yellow ! parabola FOR wx= w1Lft to w1Rgt LET fx= w1fncx(wx) LET fy= 0.25*fx*fx LET wy= w1Wndy(fy) IF round(wy)=w1Wndy(0) then LET wy= wy-1 IF fx<0 then PLOT wx,wy; ELSE PLOT wx-1,wy; END IF NEXT wx PLOT CALL SetLineWeight(1) SET COLOR white ! axes PLOT w1x0,w1Top; w1x0,w1y0 END SUB ! ----- other drawing routines ----- SUB MarkTDCursor(trace,dterm) CALL Plane1Refresh LET wt= w1Wndx(trace) ! mark the spot LET wd= w1Wndy(dterm) IF wt>=w1Lft and wt<=w1Rgt and wd>=w1Top and wd<=w1Bas then CALL DrawCursor(wt,wd) END IF END SUB SUB MarkTSCursor(theta,s) CALL w3Graph IF thisCase=2 and s>-omega and s=w3Lft and wt<=w3Rgt and ws>=w3Top and ws<=w3Bas then CALL DrawCursor(wt,ws) END IF END SUB SUB DrawCursor(cx,cy) SET COLOR 0 BOX AREA cx-3,cx+3,cy+1,cy-1 BOX AREA cx-1,cx+1,cy+3,cy-3 SET COLOR white PLOT cx-3,cy; cx+3,cy PLOT cx,cy-3; cx,cy+3 END SUB ! ----- buttons ----- SUB Buttons CALL SetTextFont(1,9,"bold") LET bhgt= 15 LET ctop= w2Bas+10 !cas1+13 LET cbas= ctop + bhgt LET clft= w2lft LET crgt= clft+40 CALL DrawButton(clft,crgt,cbas,ctop,4,"clear") ! LET tdbtop= workbas-20 !tdbas1+13 ! LET tdbbas= tdbtop + bhgt ! LET tdblft= w4lft ! LET tdbrgt= tdblft+160 ! CALL DrawButton(tdblft,tdbrgt,tdbbas,tdbtop,5,"trace-determinant plane") ! ! LET evbtop= tdbtop !evbas1+13 ! LET evbbas= evbtop + bhgt ! LET evblft= tdbrgt + 2 ! LET evbrgt= evblft + 75 ! CALL DrawButton(evblft,evbrgt,evbbas,evbtop,5,"eigenvalues") END SUB END SUB