!The useful examples in my mind are: !x-dot = x, !x-dot = -tx, !x-dot = y^2-t, !x-dot = t, !x-dot = x(1-x), !x-dot = -t/x, !x-dot = t/x, and !x-dot = x^2 -1. !(use this list in modified BU Euler for example) !EulersMethod: ! !You seem to scale the vector by delta t as it rolls over the !plane. I wanted the scaling to happen when the mouse was clicked. This !is not a big deal, but I'd like to fix this in subsequent !versions. Compare with EulersMethodForSystems below. ! !*Somebody asked me to use the full vector length for step size 1 !at some point so I changed it. ! ! !When I click in the plane with RK4 everything happens as !expected. However, if I use the solve button and RK4, I get a large !delta t as opposed to 0.125 as advertised. ! !*Will check this. ! !If it's easy to change, let max y be 3.1 for dy/dt=sin(y). The last !data point is y=3.03, and I can't get it with the current window. ! !*If I have adjustable boundary logic in this one already it is easy. !If not it is an hour or so. !! File: EulerDemo !! November 10, 2001 Hubert Hohn PUBLIC PCflag,Mac5flag,M68Kflag,Unixflag,xmax,ymax,WinID 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,headerclr,btnclr PUBLIC largefonts PUBLIC title$,SLUmode,chspc LET toolHgt= 540 LET toolWid= 780 LET SLUmode= 0 IF SLUmode=1 then LET colorscheme=0 LET title$ = "Euler's Method" LET window$= "St. Louis University" ELSE LET colorscheme= 0 LET title$ = "Euler's Method" LET window$= "Differential Equations by Blanchard, Devaney, and Hall" END IF SUB ThisProgram CALL EulersMethod 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+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) b0,.3,.5 ! Back 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,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) b4,b3,b5 ! blue SET COLOR MIX(12) b5,b0,b5 ! magenta 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 12 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 = litmid LET axisclr = litgry 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 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= abs(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= abs(round(fHgt/ystp)) IF fHgt<0 then LET first= fTop else LET first= fBas FOR i= 0 to lines LET n = first + 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,dir,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 IF dir=1 then PLOT wx0,wBas; wx0,wTop-3 DRAW arrow3 with rotate(-pi/2) * shift(wx0,wTop-3) ELSE PLOT wx0,wBas+3; wx0,wTop DRAW arrow3 with rotate(pi/2) * shift(wx0,wBas+3) END IF END IF END SUB SUB EdgesVrt(wAxis,wBas,wTop,fBas,fTop,first,stp1,stp2,nstp,dir) 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,dir) CALL VNumberLineLabels(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,dir) END SUB SUB EdgesVrtPi(wAxis,wBas,wTop,fBas,fTop,first,stp1,stp2,nstp,dir) 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,dir) CALL VNumberLineLabelsPi(wBas,wTop,wAxis,fBas,fTop,first,stp1,stp2,nstp,dir) END SUB SUB EdgesHrz(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,dir) IF dir=1 then BOX CLEAR wLft,wRgt,wBas+1,wBas+4 BOX CLEAR wLft-15,wRgt+20,wBas+4,wBas+15 END IF CALL HNumberLineTiks(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,dir) CALL HNumberLineLabels(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,dir) END SUB SUB EdgesHrzPi(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,dir) 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,dir) CALL HNumberLineLabelsPi(wLft,wRgt,wBas,fLft,fRgt,first,stp1,stp2,nstp,dir) 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 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= abs(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 ! long ticks LET ticks= abs(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= abs(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 pi$= "w" 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= abs(int(fHgt/nstp)) FOR i= 0 to ticks LET n = first + i*nstp LET n = round(n,5) LET wy = wndy(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= rgtln - sl LET p= pos(n$,pi$) LET l= len(n$) LET basln= wy+3 IF p=0 then CALL PlotTextRJ(rgtln,basln,n$,numberlineclr) ELSE IF p=1 then LET n$= n$(2:l) DRAW pi9 with shift(left,basln) CALL PlotTextRJ(rgtln,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 i END IF END SUB 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= abs(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= abs(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 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-5 ELSE LET basln= wBas-7 END IF ELSE IF ndir=1 then IF stp1=0 and stp2=0 then LET basln= wBas+11 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= abs(int(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" !CALL SetTextFont(1,9,"bold") ELSE LET n$= trim$(using$(form$,abs(n))) !CALL SetTextFont(1,9,"normal") 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= abs(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 else 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 h1slider PUBLIC h1axis,h1wLft,h1wRgt,h1wBas,h1wTop,h1wWid,h1sLft,h1sRgt PUBLIC h1fLft,h1fRgt,h1fWid,h1First,h1STik,h1LTik,h1Label ! h1xf,h1x2,h1x4,h1xl 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 hSlider2 PUBLIC h2axis,h2wLft,h2wRgt,h2wBas,h2wTop,h2wWid,h2sLft,h2sRgt PUBLIC h2fLft,h2fRgt,h2First,h2STik,h2LTik,h2Label,h2fWid,h2xf,h2x2,h2x4,h2xl PUBLIC h2fratio,h2wratio,h2name$,h2m,h2form$,h2clr PUBLIC hslot2$ DEF h2Fncx(wx)= h2fLft + h2fratio*(wx-h2wLft) ! window to function DEF h2Wndx(fx)= h2wLft + h2wratio*(fx-h2fLft) ! function to window SUB hSlider2Variables 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 hSlot2$ CALL PlotSliderName(h2wLft,h2wBas,h2name$,h2clr) CALL h2Mark(n) END SUB SUB h2Mark(n) LET wx= h2wLft + h2wratio*(n-h2fLft) BOX SHOW hSlot2$ at h2sLft,h2wBas CALL SliderKnob(wx,h2wBas-5) CALL PlotSliderValue(h2wRgt,h2wBas,using$(h2form$,n*h2m),h2clr) END SUB END MODULE MODULE hSlider3 PUBLIC h3axis,h3wLft,h3wRgt,h3wBas,h3wTop,h3wWid,h3sLft,h3sRgt PUBLIC h3fLft,h3fRgt,h3First,h3STik,h3LTik,h3Label,h3fWid,h3xf,h3x2,h3x4,h3xl PUBLIC h3fratio,h3wratio,h3name$,h3m,h3form$,h3clr PUBLIC hslot3$ DEF h3Fncx(wx)= h3fLft + h3fratio*(wx-h3wLft) ! window to function DEF h3Wndx(fx)= h3wLft + h3wratio*(fx-h3fLft) ! function to window SUB hSlider3Variables 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 hSlot3$ CALL PlotSliderName(h3wLft,h3wBas,h3name$,h3clr) CALL h3Mark(n) END SUB SUB h3Mark(n) LET wx= h3wLft + h3wratio*(n-h3fLft) BOX SHOW hSlot3$ at h3sLft,h3wBas CALL SliderKnob(wx,h3wBas-5) CALL PlotSliderValue(h3wRgt,h3wBas,using$(h3form$,n*h3m),h3clr) END SUB END MODULE MODULE hSlider4 PUBLIC h4axis,h4wLft,h4wRgt,h4wBas,h4wTop,h4wWid,h4sLft,h4sRgt PUBLIC h4fLft,h4fRgt,h4First,h4STik,h4LTik,h4Label,h4fWid,h4xf,h4x2,h4x4,h4xl PUBLIC h4fratio,h4wratio,h4name$,h4m,h4form$,h4clr PUBLIC hSlot4$ DEF h4Fncx(wx)= h4fLft + h4fratio*(wx-h4wLft) ! window to function DEF h4Wndx(fx)= h4wLft + h4wratio*(fx-h4fLft) ! function to window SUB hSlider4Variables 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+45,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 hSlot4$ CALL PlotSliderName(h4wLft,h4wBas,h4name$,h4clr) CALL h4Mark(n) END SUB SUB h4Mark(n) LET wx= h4wLft + h4wratio*(n-h4fLft) BOX SHOW hSlot4$ at h4sLft,h4wBas CALL SliderKnob(wx,h4wBas-5) CALL PlotSliderValue(h4wRgt,h4wBas,using$(h4form$,n*h4m),h4clr) END SUB END MODULE MODULE hSlider5 PUBLIC h5axis,h5wLft,h5wRgt,h5wBas,h5wTop,h5wWid,h5sLft,h5sRgt PUBLIC h5fLft,h5fRgt,h5First,h5STik,h5LTik,h5Label,h5fWid,h5xf,h5x2,h5x5,h5xl PUBLIC h5fratio,h5wratio,h5name$,h5m,h5form$,h5clr PUBLIC hSlot5$ DEF h5Fncx(wx)= h5fLft + h5fratio*(wx-h5wLft) ! window to function DEF hwndx5(fx)= h5wLft + h5wratio*(fx-h5fLft) ! function to window SUB hSlider5Variables 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+45,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 hSlot5$ CALL PlotSliderName(h5wLft,h5wBas,h5name$,h5clr) CALL h5Mark(n) END SUB SUB h5Mark(n) LET wx= h5wLft + h5wratio*(n-h5fLft) BOX SHOW hSlot5$ at h5sLft,h5wBas CALL SliderKnob(wx,h5wBas-5) CALL PlotSliderValue(h5wRgt,h5wBas,using$(h5form$,n*h5m),h5clr) END SUB END MODULE MODULE hSlider6 PUBLIC h6axis,h6wLft,h6wRgt,h6wBas,h6wTop,h6wWid,h6sLft,h6sRgt PUBLIC h6fLft,h6fRgt,h6First,h6STik,h6LTik,h6Label,h6fWid,h6xf,h6x2,h6x6,h6xl PUBLIC h6fratio,h6wratio,h6name$,h6m,h6form$,h6clr PUBLIC hSlot6$ DEF h6Fncx(wx)= h6fLft + h6fratio*(wx-h6wLft) ! window to function DEF hwndx6(fx)= h6wLft + h6wratio*(fx-h6fLft) ! function to window SUB hSlider6Variables 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+46,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 hSlot6$ CALL PlotSliderName(h6wLft,h6wBas,h6name$,h6clr) CALL h6Mark(n) END SUB SUB h6Mark(n) LET wx= h6wLft + h6wratio*(n-h6fLft) BOX SHOW hSlot6$ at h6sLft,h6wBas CALL SliderKnob(wx,h6wBas-5) CALL PlotSliderValue(h6wRgt,h6wBas,using$(h6form$,n*h6m),h6clr) 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 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 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 SuperSubScript9(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,9,"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,7,"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,9,"bold") IF Rgt$<>"" then CALL SuperSubScript9(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 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 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 InitMenu(mlft,mtop,eq,eqcnt,names$(,),yax$) LET mrgt= mlft+16 LET mbas= mtop+16 CALL ShowEquation(eq,names$,yax$) CALL PopUpTab(mlft,mrgt,mbas,mtop) CALL DrawPopUp(names$(,),eqcnt,eq,yax$) END SUB SUB PopUpTab(mlft,mrgt,mbas,mtop) CALL DrawButton(mlft,mrgt,mbas,mtop,0,"") LET sx = mlft+8 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 DrawPopUp(names$(,),eqcnt,eq,yax$) LOCAL temp$,oldenum,mx,my,ms,et,eb,clearflag,ty CALL SetTextFont(1,12,"bold") LET eqspc = 21 LET pophgt= eqcnt*eqspc + 26 IF pophgt>workbas- mtop then LET popbas= workbas ELSE LET popbas= mtop+pophgt END IF LET poptop= popbas-pophgt LET poplft= mrgt+2 LET poprgt= poplft+165 LET listlft= poplft+ 5 LET listrgt= poprgt- 5 LET listtop= poptop+22 LET listbas= listtop + eqcnt*eqspc LET eqlft = poplft+80 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= 1 to eqcnt LET et= listtop + (i-1)*eqspc LET eb= et+eqspc-1 CALL DrawButton(poplft+5,poprgt-5,eb,et,0,"") CALL SetTextFont(1,12,"bold") CALL DiffEq(eqlft,eb-6,white,yax$,names$(i,0)) 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 1 BOX SHOW temp$ at poplft,popbas LET temp$= "" END SUB SUB ShowEquation(eq,names$(,),yax$) CALL SetTextFont(1,12,"bold") BOX CLEAR mrgt+2,mrgt+120,mbas,mtop CALL DiffEq(mrgt+65,mbas-4,white,yax$,names$(eq,0)) END SUB SUB DiffEq(dex,dey,clr,x$,eq$) ! CALL VarDot(dex,dey,x$,clr) LET lft$= "d" & x$ & "/dt = " ! 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 PlotTextRJ(dex,dey,lft$,clr) CALL SuperSubScriptLJ(dex,dey,eq$ ,clr) 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 my"" 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 Clipping SUB Clip(w1fLft,w1fRgt,w1fBas,w1fTop,x1,y1,x2,y2) ! (x1,y1) is within LET yd= y2-y1 LET xd= x2-x1 IF xd<>0 and yd<>0 then LET ym= yd/xd LET xm= xd/yd IF x2w1fRgt then ! clip right LET y2= y1 + ym*(w1fRgt-x1) LET x2= w1fRgt END IF IF y2w1fTop then ! clip top LET x2= x1 + xm*(w1fTop-y1) LET y2= w1fTop END IF ELSE IF yd=0 then IF x2w1fRgt then ! clip right LET y2= y1 + ym*(w1fRgt-x1) LET x2= w1fRgt END IF END IF END SUB END MODULE ! *** MODULE NumericInputEditor DECLARE PUBLIC black,drkgry,midgry,litgry,white DECLARE PUBLIC PCflag,Mac5flag,M68Kflag,xmax,ymax ! ---- keyboard input editor ---- SUB BoxEditN(editlft,editrgt,editbas,edittop,line$,number,exit,mx,my,basline,clr) DECLARE PUBLIC chspc LOCAL bakclr,txtlft,chrlft,txttop,sl,inpnt LOCAL k,i,s,p,n,length,xpos,xline DO while key input GET KEY k LOOP LET length = len(line$) ! Find length LET width = editrgt-editlft LET maxchar= 6 !int(width/chspc)-1 LET bakclr = 0 LET exit = 0 LET txtlft = editlft+4 LET chrlft = txtlft LET txttop = edittop+3 SET COLOR bakclr BOX AREA editlft,editrgt,editbas,edittop BOX KEEP editlft,editrgt,editbas,edittop in clear$ LET pi$= chr$(185) LET negflag= 0 LET p= pos(line$,"-") IF p<>0 then LET negflag= 1 LET dotflag= 0 LET p= pos(line$,".") IF p<>0 then LET dotflag= 1 LET piflag = 0 LET p= pos(line$,pi$) IF p<>0 then LET piflag= 1 SET COLOR clr CALL PlaceCursor DO GET MOUSE: mx,my,s ! mouse input? IF key input then ! Keyboard input? GET KEY k ! Get a keystroke DO while key input ! clear the buffer GET KEY i LOOP CALL keyinput ! evaluate keystroke END IF IF s=2 then ! mouseup? IF mxeditrgt+2 or myeditbas+2 then LET exit= 2 ! mouse exit ELSE DO GET MOUSE: mx,my,s ! mouse input? LOOP until s=3 CALL PlaceCursor ! mouse in text string END IF END IF LOOP until exit>0 CALL TidyUp(line$) CALL EvalN(line$,number) SUB KeyInput SELECT CASE k CASE 48 to 57 ! digits IF inpnt>1 or (inpnt=1 and negflag=0) then LET line$(inpnt:inpnt-1)= chr$(k) CALL WriteLine( 1) END IF CASE 46 ! period IF inpnt>1 or (inpnt=1 and negflag=0) then IF dotflag= 0 then LET dotflag= 1 LET line$(inpnt:inpnt-1)= chr$(k) CALL WriteLine( 1) END IF END IF CASE 185,112,80 ! p or pi character IF inpnt>1 or (inpnt=1 and negflag=0) then IF piflag= 0 then LET piflag= 1 LET line$(inpnt:inpnt-1)= str$(pi) !pi$ CALL WriteLine( 1) END IF END IF CASE 45 ! minus sign IF inpnt>1 or (inpnt=1 and negflag=0) then IF inpnt=1 and negflag=0 then LET negflag= 1 LET line$(inpnt:inpnt-1)= chr$(k) CALL WriteLine( 1) END IF END IF CASE 8 ! Delete key (left delete) LET line$(inpnt-1:inpnt-1)= "" CALL WriteLine(-1) CALL CheckFlags CASE 127 ! Delete right key LET inpnt= inpnt+1 LET line$(inpnt-1:inpnt-1)= "" CALL WriteLine(-1) CALL CheckFlags CASE 24,27 ! Command x, clear (kill line) LET line$= "" LET inpnt= 1 CALL WriteLine( 0) CALL CheckFlags CASE 28, 304 ! Move left arrow CALL ShiftCursor(-1) CASE 29, 303 ! Move right arrow CALL ShiftCursor( 1) CASE 13,9,30,31,302,301 ! return,tab,up,down keys LET exit= k CASE else END SELECT END SUB SUB CheckFlags LET p= pos(line$,pi$) IF p=0 then LET piflag=0 LET p= pos(line$,".") IF p=0 then LET dotflag=0 LET p= pos(line$,"-") IF p=0 then LET negflag=0 END SUB SUB TidyUp(line$) LET line$ = trim$(ucase$(line$)) LET chrcnt= len(line$) IF chrcnt>0 then ! hanging period? IF line$(chrcnt:chrcnt)= "." then LET line$ = line$(1:chrcnt-1) LET chrcnt= len(line$) END IF END IF IF negflag=1 then LET p=2 else LET p=1 ! 1st or 2nd char? IF piflag=0 then ! leading zeros? DO while line$(p:p)="0" and len(line$)>p LET chrcnt= len(line$) LET line$(p:p)= "" LOOP END IF LET chrcnt= len(line$) IF line$(1:1)= "." then LET line$="0" & line$ IF line$(1:2)= "-." then LET line$="-0" & line$(2:chrcnt) END SUB SUB EvalN(line$,n) LET chrcnt= len(line$) IF line$= "" then LET line$,n1$= "0" LET n= 0 ELSE IF line$="-" then LET line$= "-1" LET n= -1 ELSE LET n1$= line$ LET p = pos(n1$,pi$) IF p<>0 then IF p=1 then IF len(n1$)>1 then LET n1$= n1$(2:chrcnt) IF val(n1$)<>0 then LET line$= n1$ & pi$ ELSE LET line$= "0" & pi$ END IF END IF ELSE IF p=chrcnt then LET n1$= n1$(1:p-1) ELSE LET v1 = val(n1$(1:p-1)) LET v2 = val(n1$(p+1:chrcnt)) LET v = v1*v2 LET n1$= str$(v) IF v<>1 then LET line$= n1$ & pi$ ELSE LET line$= pi$ END IF END IF IF n1$= "-" then LET n= -1 ELSE IF n1$= "" then LET n= 1 ELSE WHEN error in LET n= val(n1$) USE LET n= 1 END WHEN END IF LET n= n*pi ELSE LET n= val(line$) END IF END IF ! IF n>nmax or n=chrlft+length*chspc then LET inpnt= len(line$)+1 ELSE LET inpnt= round((mx-chrlft)/chspc)+1 END IF CALL WriteLine(0) END SUB SUB WriteLine(move) LET line$ = line$(1:maxchar) ! clip to box LET length= len(line$) ! Find length LET cline = max(chrlft + (inpnt-2)*chspc,editlft) ! Find pointer x BOX SHOW clear$ at editlft,editbas !print chspc,line$,clr,chrlft,basline CALL MonoStringN(chrlft,basline,chspc,line$,clr) LET inpnt= min(max(inpnt+move,1),length+1) LET xline= chrlft + (inpnt-1)*chspc - 1 ! Find pointer x BOX AREA xline,xline+1,edittop+2,editbas-2 END SUB SUB ShiftCursor(move) BOX CLEAR xline,xline+1,edittop+2,editbas-2 LET inpnt= min(max(inpnt+move,1),length+1) LET xline= chrlft + (inpnt-1)*chspc - 1 ! Find pointer x BOX AREA xline,xline+1,edittop+2,editbas-2 END SUB END SUB SUB MonoStringN(tx,ty,chspc,m$,clr) CALL SetTextFont(1,12,"bold") LET cx= tx+chspc/2 FOR i= 1 to len(m$) LET char$= m$(i:i) CALL PlotTextCJ(cx,ty,char$,clr) LET cx= cx+chspc NEXT i END SUB ! --- numeric formatter SUB FormatNum(n,n$) IF n<>0 then LET l= int(log10(abs(n))) SELECT CASE l CASE -6 to 0 LET format$= "-%.######" & repeat$("#",abs(l)) CASE 1 to 6 LET format$= repeat$("-",abs(l)) & "--%.#####" CASE else LET format$= "-%.##^^^^" END SELECT LET n$= trim$(using$(format$,n)) CALL ClipSpcAndZeros(n$) ELSE LET n$= "0" END IF IF len(n$)>6 then LET n$= n$(1:6) END SUB SUB FormatNum4(n,n$) IF n<>0 then LET l= int(log10(abs(n))) SELECT CASE l CASE -6 to 0 LET format$= "-%.#" & repeat$("#",abs(l)) CASE 1 to 6 LET format$= repeat$("-",abs(l)) & "--%.#####" CASE else LET format$= "-%.##^^^^" END SELECT LET n$= trim$(using$(format$,n)) CALL ClipSpcAndZeros(n$) ELSE LET n$= "0" END IF END SUB SUB FormatNum8(n,n$) IF n<>0 then LET l= int(log10(abs(n))) SELECT CASE l CASE -6 to 0 LET format$= "-%.######" & repeat$("#",abs(l)) CASE 1 to 6 LET format$= repeat$("-",abs(l)) & "--%.#####" CASE else LET format$= "-%.##^^^" END SELECT LET n$= trim$(using$(format$,n)) CALL ClipSpcAndZeros(n$) ELSE LET n$= "0" END IF END SUB SUB ClipSpcAndZeros(n$) DO LET l= len(n$) IF n$(l:l)= "0" then LET l = len(n$) LET n$= n$(1:l-1) ELSE IF n$(l:l)= "." then LET l = len(n$) LET n$= n$(1:l-1) EXIT DO ELSE EXIT DO END IF LOOP IF len(n$)>8 then LET n$= n$(1:8) IF n$(l:l)= "." then LET l = len(n$) LET n$= n$(1:l-1) END IF END IF END SUB ! --- editor subs --- SUB EditBounds(l,r,b,t,elft,ergt,ebas,etop) LET elft= l LET ergt= r LET ebas= b LET etop= t END SUB SUB CheckErr(line$,err) WHEN error in LET v = val(line$) LET err= 0 USE LET err= 1 END WHEN END SUB END MODULE ! *** SUB EulersMethod DECLARE PUBLIC PCflag,M68kflag,Mac5flag,SLUmode,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 mlft,mrgt,mbas,mtop DECLARE PUBLIC poplft,poprgt,popbas,poptop,pophgt,PopUp$ DECLARE PUBLIC listlft,listrgt,listbas,listtop,eqspc,eqlft,chspc ! --- info page --- DIM Info$(1:13) MAT READ Info$ DATA "Euler's Method" DATA "" DATA "Click the pop-up menu button [v] to open the list of equations. Click an equation to select it." DATA "Click [Draw Field] to toggle the field on or off." DATA "Click one of the numerical methods to draw vectors or a solution on the plane." DATA "-Selecting an Euler method allows you to build a solution by hand by setting a sequence of vectors. Click the plane to set a vector, then click near the head of the vector to build the Euler solution." DATA "-Selecting the Runge Kutta method allows you do draw an RK4 solution for comparison." DATA "Click [Compare Methods] and then click the plane to compare all methods." DATA "To enter initial conditions from the keyboard:" DATA "-Click the input box for y0, type the value, and press [return]." DATA "-Click the input box for t0, type the value, and press [return]." DATA "-When the values are right, click [Iterate]." DATA "Click [Clear] to remove vectors and solutions from the plane." ! DATA "Purpose: Use this demo to display how Euler's method works and to compare approximate solutions with actual solutions." ! DATA "" ! DATA "To Begin: Enter the initial condition using either the y0 and t0 boxes or by clicking in the ty-plane. If you use the boxes, you need to click solve to get started. Now move the cursor to a point near the head of the arrow to place a new slope line at the end of the previous line. Continue in this fashion to produce an approximate solution given by Euler's method. The table generated by the method is displayed at the left. Click the RK4 box and then the initial condition to view the actual solution (plotted in violet) through (t0, y0)." ! DATA "" ! DATA "Further Options: A pop-up menu lets you select any of several differential equations to which you can apply Euler's method. You can change the time scale (delta t) on the slope lines by checking the appropriate box. Click in the Compare All box to see solutions generated by Euler's method for all of the different step sizes." ! --- axis choices --- IF SLUmode=1 then LET xax$= "t" LET yax$= "x" ELSE LET xax$= "t" LET yax$= "y" END IF ! --- utility functions --- DEF clamp(n,lo,hi)= min(max(n,lo),hi) DEF SetColor(n) = red + n ! --- Functions --- ! DATA "2y + 1","1" ! t 0-2 y 0-60 ! DATA "t - y^[2]","1" ! t 0-1 y 0- 1 ! DATA "y^[2] - 2y + 1","1" ! t 0-2 y 0-30 ! DATA "sin(y)","1" ! t 0-1 y 0- 1 ! ! DATA "y","1" ! DATA "sin(t)","1" ! DATA "y sin(t)","1" ! DATA "y - t","1" ! DATA "y^[2] - t","1" ! DATA "-ty","1" LET eqcnt= 10 LET eq = 1 DEF dydt1(t,x) = 2*x + 1 ! unstable node DEF dxdt1(t,x) = 1 DEF dydt2(t,x) = t - x*x ! unstable node DEF dxdt2(t,x) = 1 DEF dydt3(t,x) = x*x - 2*x + 1 ! unstable node DEF dxdt3(t,x) = 1 DEF dydt4(t,x) = sin(x) ! unstable node DEF dxdt4(t,x) = 1 DEF dydt5(t,x) = x ! unstable node DEF dxdt5(t,x) = 1 DEF dydt6(t,x) = sin(t) ! unstable improper node DEF dxdt6(t,x) = 1 DEF dydt7(t,x) = x*sin(t) ! unstable improper node DEF dxdt7(t,x) = 1 DEF dydt8(t,x) = x-t ! stable star DEF dxdt8(t,x) = 1 DEF dydt9(t,x) = x*x - t ! saddle DEF dxdt9(t,x) = 1 DEF dydt10(t,x) = -t*x ! unstable node DEF dxdt10(t,x) = 1 SUB FetchEq(eq,x,y,dx,dy) SELECT CASE eq CASE 1 LET dx= dxdt1(x,y) LET dy= dydt1(x,y) CASE 2 LET dx= dxdt2(x,y) LET dy= dydt2(x,y) CASE 3 LET dx= dxdt3(x,y) LET dy= dydt3(x,y) CASE 4 LET dx= dxdt4(x,y) LET dy= dydt4(x,y) CASE 5 LET dx= dxdt5(x,y) LET dy= dydt5(x,y) CASE 6 LET dx= dxdt6(x,y) LET dy= dydt6(x,y) CASE 7 LET dx= dxdt7(x,y) LET dy= dydt7(x,y) CASE 8 LET dx= dxdt8(x,y) LET dy= dydt8(x,y) CASE 9 LET dx= dxdt9(x,y) LET dy= dydt9(x,y) CASE 10 LET dx= dxdt10(x,y) LET dy= dydt10(x,y) ! CASE 11 ! LET dx= dxdt11(x,y) ! LET dy= dydt11(x,y) ! CASE 12 ! LET dx= dxdt12(x,y) ! LET dy= dydt12(x,y) END SELECT END SUB ! Graphing window ! --- plane 1 data --- DECLARE PUBLIC w1Lft, w1Rgt, w1Bas, w1Top, w1Midx, w1Midy DECLARE PUBLIC w1fLft, w1fRgt, w1fBas, w1fTop, w1x0, w1y0 DECLARE PUBLIC w1Firstx, w1SxTik, w1LxTik, w1xLabel, w1xGridstep DECLARE PUBLIC w1Firsty, w1SyTik, w1LyTik, w1yLabel, w1yGridstep DECLARE PUBLIC w1xPiFlag, w1wHgt, w1fHgt, w1wWid, w1fWid LET w1Flag = 1 LET w1xPiFlag= 0 LET w1Lft= workLft+215 ! pixel bounds LET w1Rgt= w1Lft + 400 LET w1Top= workTop+ 35 LET w1Bas= w1Top + 300 LET w1fLft= -4 ! function bounds LET w1fRgt= 4 LET w1fTop= 3 LET w1fBas= -3 LET w1Xax$= xax$ ! axis labels LET w1Yax$= yax$ LET w1xGridstep= 0 ! horizontal grid intervals LET w1yGridstep= 0 ! vertical grid intervals LET w1SxTik = .5 ! horizontal axis Tik marks LET w1LxTik = 1 LET w1xLabel= 1 LET w1Firstx= w1fLft LET w1SyTik = .5 ! vertical axis Tik marks LET w1LyTik = 1 LET w1yLabel= 1 LET w1Firsty= w1fBas ! --- Plane 1 methods --- DECLARE DEF w1fncx,w1fncy,w1wndx,w1wndy ! window/function transforms SUB w1SetBounds(eq) SELECT CASE eq CASE 1 LET w1fLft= 0 LET w1fRgt= 2 LET w1fBas= 0 LET w1fTop= 60 LET w1SxTik = .5 ! horizontal axis Tik marks LET w1LxTik = 1 LET w1xLabel= 1 LET w1SyTik = 0 ! vertical axis Tik marks LET w1LyTik = 5 LET w1yLabel= 5 CASE 2 LET w1fLft= 0 LET w1fRgt= 1 LET w1fBas= 0 LET w1fTop= 1 LET w1SxTik = .1 ! horizontal axis Tik marks LET w1LxTik = .5 LET w1xLabel= .5 LET w1SyTik = .1 ! vertical axis Tik marks LET w1LyTik = .5 LET w1yLabel= .5 CASE 3 LET w1fLft= 0 LET w1fRgt= 2 LET w1fBas= 0 LET w1fTop= 30 LET w1SxTik = .5 ! horizontal axis Tik marks LET w1LxTik = 1 LET w1xLabel= 1 LET w1SyTik = 0 ! vertical axis Tik marks LET w1LyTik = 5 LET w1yLabel= 5 CASE 4 LET w1fLft= 0 LET w1fRgt= 6 LET w1fBas= 0 LET w1fTop= 4 LET w1SxTik = .1 ! horizontal axis Tik marks LET w1LxTik = .5 LET w1xLabel= .5 LET w1SyTik = .1 ! vertical axis Tik marks LET w1LyTik = .5 LET w1yLabel= .5 CASE else LET w1fLft= -4 LET w1fRgt= 4 LET w1fBas= -3 LET w1fTop= 3 LET w1SxTik = .5 ! horizontal axis Tik marks LET w1LxTik = 1 LET w1xLabel= 1 LET w1SyTik = .5 ! vertical axis Tik marks LET w1LyTik = 1 LET w1yLabel= 1 END SELECT LET w1Firstx= w1fLft LET w1Firsty= w1fBas CALL Plane1Variables END SUB !CALL Plane1Variables SUB Plane1Clear BOX CLEAR w1Lft-20,w1Rgt+20,workBas-5,w1Top-20 END SUB SUB Plane1Redraw ! CALL Plane1Init ! CALL Plane1Update ! CALL t1Init ! CALL t2Init ! ! CALL t5Set ! ! CALL h1DrawSlider(h1a) ! CALL h2DrawSlider(h2b) END SUB SUB Plane1Init CALL DrawPlane1(0,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$ BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in w1graphLayer$ END SUB SUB Plane1Refresh BOX SHOW w1gridLayer$ at w1Lft-5,w1Bas+5 END SUB SUB Plane1Graph BOX SHOW w1graphLayer$ at w1Lft-5,w1Bas+5 END SUB ! --- Dynamic output --- LET lnspc= 14 LET ivlft= w1Rgt + 20 ! w1Midx-35 LET ivrgt= ivlft+70 LET ivtop= w1Midy+45 ! w1Bas+64 LET ivbas= ivtop + 6*lnspc LET iveqx= ivlft+27 LET ivdot= ivlft+48 LET ivf$ = "--%.##" LET ivtbas1= ivtop + 1*lnspc LET ivtbas2= ivtop + 2*lnspc LET ivtbas4= ivtop + 4*lnspc LET ivtbas5= ivtop + 5*lnspc SUB ClearInit BOX CLEAR ivlft-10,ivrgt+15,ivbas,ivtop-20 ! LET initx,inity = 0 ! LET initmx,initmy= 0 END SUB ! SUB ShowInit(x0,y0) ! CALL clearinit ! SET COLOR white ! PLOT ivlft,ivtop-2; ivrgt,ivtop-2 ! CALL SetTextFont(1,9,"bold") ! CALL PlotTextLJ(ivlft,ivtop-7,"Initial Values",white) ! ! CALL SetTextFont(1,12,"bold") ! CALL PlotTextRJ(iveqx,ivtbas1,xax$ & " = ",white) ! CALL PlotTextRJ(iveqx,ivtbas2,yax$ & " = ",white) ! CALL AlignDot(ivdot,ivtbas1,using$(ivf$,x0),white) ! CALL AlignDot(ivdot,ivtbas2,using$(ivf$,y0),white) ! ! CALL FetchEq(eq,x0,y0,dx,dy) ! CALL VarDot(ivlft,ivtbas4,yax$,white) ! ! CALL VarDot(ivlft,ivtbas5,"t",white) ! CALL PlotTextRJ(iveqx,ivtbas4,"= ",white) ! ! CALL PlotTextRJ(iveqx,ivtbas5,"= ",white) ! ! CALL AlignDot(ivdot,ivtbas4,using$(ivf$,dx),white) ! CALL AlignDot(ivdot,ivtbas4,using$(ivf$,dy),white) ! END SUB SUB ShowInit(x,y) CALL FormatNum(y,n$) BOX CLEAR x0blft+1,x0brgt-1,x0bbas-1,x0btop+1 CALL MonoStringN(x0blft+5,x0bbas-bbshft,chspc,n$,white) CALL FormatNum(x,n$) BOX CLEAR t0blft+1,t0brgt-1,t0bbas-1,t0btop+1 CALL MonoStringN(t0blft+5,t0bbas-bbshft,chspc,n$,white) END SUB ! --- LET tlft = w1Rgt+55 LET trgt = tlft+80 LET ttop = w1Top LET tbas = ttop + 6*lnspc LET teqx = tlft+27 LET tdot = tlft+60 LET tbas1= ttop + 1*lnspc LET tbas2= ttop + 2*lnspc LET tbas4= ttop + 4*lnspc LET tbas5= ttop + 5*lnspc SUB ClearOutput BOX CLEAR teqx,trgt,tbas,ttop+5 END SUB SUB OutputLabels CALL SetTextFont(1,12,"bold") CALL PlotTextRJ(teqx,tbas1,xax$ & " = ",white) CALL PlotTextRJ(teqx,tbas2,yax$ & " = ",white) !CALL VarDot(tlft,tbas4,"t",white) !CALL VarDot(tlft,tbas4,yax$,white) CALL PlotTextRJ(teqx,tbas4,"dy/dt = ",white) !CALL PlotTextRJ(teqx,tbas5,"= ",white) !CALL PlotTextRJ(teqx,y2,"x' = ",white) CALL CursorValues(x1,y1,dx,dy,dt) END SUB SUB CursorValues(x1,y1,dx,dy,dt) CALL ClearOutput CALL SetTextFont(1,12,"bold") LET f$= "---%.##" CALL AlignDot(tdot,tbas1,using$(f$,x1),white) CALL AlignDot(tdot,tbas2,using$(f$,y1),white) !CALL AlignDot(tdot,tbas4,using$(f$,dx),white) CALL AlignDot(tdot,tbas4,using$(f$,dy),white) END SUB ! ---------- Orbit List ---------- DIM table(0:28,0:1) LET tblSpc = 15 LET tblCnt = 28 ! w1fWid*2 + 1 LET tblLft = worklft+ 30 LET tblRgt = tblLft + 120 LET tblTop = w1top LET tblBas = tblTop + tblcnt*tblspc + 4 LET tblCol1 = tblLft + 60 LET tblCol2 = tblCol1 + 60 LET tblCol3 = tblRgt LET tblFirst= tbltop+tblSpc-2 SUB TableClear BOX CLEAR tblLft,tblRgt,tblBas,tblTop END SUB SUB DrawTable SET COLOR planeclr BOX AREA tblLft,tblRgt,tblBas,tblTop SET COLOR rimclr BOX LINES tblLft,tblRgt,tblBas,tblTop PLOT tblCol1,tblTop; tblCol1,tblBas ! PLOT tblCol2,tblTop; tblCol2,tblBas CALL SetTextFont(1,12,"bold") LET bas = tblTop-5 CALL PlotTextCJ((tblLft +tblCol1)/2,bas,xax$,white) CALL PlotTextCJ((tblCol1+tblCol2)/2,bas,yax$,white) ! CALL PlotTextCJ((tblCol2+ tblRgt)/2,bas,"dx/dt",trajclr) END SUB SUB TableRefresh CALL DrawTable END SUB ! --- popup menu --- LET mlft = w1Rgt - 30 LET mrgt = mlft+16 LET mtop = w1Bas + 50 LET mbas = mtop+16 LET eqcnt= 10 DIM SLUnames$(1:10,0:1) MAT READ SLUnames$ DATA "x","1" DATA "cos(t)","1" DATA "cos(x)","1" DATA "x cos(t)","1" DATA "cos(tx)","1" DATA "x + t","1" DATA "x - t","1" DATA "x^[2] - t","1" DATA "x^[2] - t^[2]","1" DATA "x^[2] + t^[2]","1" ! DATA "cos(x^[2]+t^[2])","1" ! DATA "-tx","1" DIM BUnames$(1:10,0:1) MAT READ BUnames$ DATA "2y + 1","1" ! t 0-2 y 0-60 DATA "t - y^[2]","1" ! t 0-1 y 0- 1 DATA "y^[2] - 2y + 1","1" ! t 0-2 y 0-30 DATA "sin(y)","1" ! t 0-1 y 0- 1 DATA "y","1" DATA "sin(t)","1" DATA "y sin(t)","1" DATA "y - t","1" DATA "y^[2] - t","1" DATA "-ty","1" DIM eqnames$(1:10,0:1) IF SLUmode=1 then MAT eqnames$= SLUnames$ ELSE MAT eqnames$= BUnames$ END IF ! --- time steps --- DIM Tstep(0:4),Tstep$(0:4) MAT READ Tstep,Tstep$ LET eStps= 4 DATA 1,.5,.25,.125,.125 DATA "Ęt = 1.0","Ęt = 0.50","Ęt = 0.25","Ęt = 0.125","Ęt = 0.125" LET tbtn= 1 SUB ButtonY(btn,hhgt,t,b) LET t= htop + btn*hhgt LET b= bt+11 END SUB SUB ResetTstep(oldtbtn,tbtn) CALL SetTextFont(1,9,"bold") CALL ButtonY(oldtbtn,hhgt,bt,bb) CALL SetCheckBox(bb,0) CALL SetTextFont(1,9,"bold") CALL ButtonY(tbtn,hhgt,bt,bb) CALL SetCheckBox(bb,1) IF tbtn2 then LET trajclr= tbtn+red IF tbtn>eStps then LET trajclr= white IF tbtnw1Lft-3 and mxw1Top-3 and myoldx or my<>oldy then BOX SHOW w1graphLayer$ at w1Lft-5,w1Bas+5 ! field vector LET oldx= mx LET oldy= my LET x1 = w1Fncx(mx) LET y1 = w1Fncy(my) CALL SetVector(x1,y1,x2,y2,1) CALL CursorValues(x1,y1,dx,dy,dt) LET clearflag= 1 END IF ELSE IF clearflag=1 then BOX SHOW w1graphLayer$ at w1Lft-5,w1Bas+5 CALL ClearOutput LET clearflag= 0 END IF END IF LOOP until s=2 END IF BOX SHOW w1graphLayer$ at w1Lft-5,w1Bas+5 IF mx>w1Lft-3 and mxw1Top-3 and myw1Lft-3 and mxw1Top-3 and my=t0blft and mx<=t0brgt and my>t0btop and myt0 then LET number= min(max(number,w1fLft),w1fRgt) LET t0= number CALL ShowInit(t0,x0) CALL DrawTable END IF IF exit=2 then LET edit= 1 ELSE IF mx>=x0blft and mx<=x0brgt and my>x0btop and myx0 then LET number= min(max(number,w1fBas),w1fTop) LET x0= number CALL ShowInit(t0,x0) CALL DrawTable END IF IF exit=2 then LET edit= 1 ELSE IF mx>clft and mxctop and mysllft and mxsltop and myrslft and mxrstop and mygLft and mxgTop and myhlft and mxhtop and myhlft and mxhtop and mymlft and mxmtop and myinflft and mxinftop then CALL MouseButtonUp(inflft,infrgt,infbas,inftop,ms) CALL InfoPage(Info$()) CALL InitScreen ELSE IF mx>qlft and mxqtop then CALL MouseButtonUp(qlft,qrgt,qbas,qtop,ms) EXIT SUB ELSE CALL MouseUp(mx,my,ms) END IF LOOP SUB StoreValues(x,y) LET tblPntr= tblPntr+1 IF tblPntr<=tblCnt then LET table(tblPntr,0)= x LET table(tblPntr,1)= y LET t$= using$("--%.##",x) LET x$= using$("--%.##",y) LET ty= tblFirst + (tblPntr-1)*tblSpc CALL PlotTextRJ(tblCol1-10,ty,t$,trajclr) CALL PlotTextRJ(tblCol2-10,ty,x$,trajclr) ! LET dx$ = using$("-%.##",dxdt(x)) ! CALL PlotTextRJ(tblCol3-10,ty,dx$,trajclr) END IF END SUB SUB SolutionVector(x1,y1) CALL SetVector(x1,y1,x2,y2,dt) LET headmx= wx2 LET headmy= wy2 END SUB SUB SetVector(x1,y1,x2,y2,tmstp) CALL FetchEq(eq,x1,y1,dx,dy) LET aspect= (w1wwid/w1fwid)/(w1whgt/w1fhgt) LET x2 = x1 + dx*tmstp LET y2 = y1 + dy*tmstp LET head= 0 IF x2>w1fLft and x2w1fBas and y20 or dy<>0) then DRAW VectPnt with rotate(angle(dx*aspect,-dy))*shift(wx2,wy2) END IF END SUB SUB Trajectory(x0,y0,mx,my,tstp,clr) LOCAL x,y SET COLOR clr LET x = x0 LET y = y0 LET wx = mx LET wy = my LET circtest= tstp PLOT wx,wy; LET oldwy= 999 FOR i= 0 to 5000 ! draw trajectory LET starttime= time LET oldx = x LET oldy = y LET oldwx= wx LET oldwy= wy LET olddy= dy LET test= mod(i,2) IF test=0 then CALL StoreValues(x,y) END IF CALL RungeKutta4(x,y,dx,dy) IF abs(x-x0)10 then LET circflag= 1 EXIT FOR END IF LET wx= w1Wndx(x) LET wy= w1Wndy(y) IF wx>w1Lft and wxw1Top and wyw1Lft and oldwxw1Top and oldwyw1Lft and oldwxw1Top and oldwyw1fRgt or abs(y)>w1fTop or ms=2 then EXIT FOR END IF DO LOOP until time-starttime>1/60 NEXT i PLOT END SUB SUB ETrajectory(x0,y0,mx,my,tstp,clr) LOCAL x,y SET COLOR clr LET x = x0 LET y = y0 LET wx = w1Wndx(x) LET wy = w1Wndy(y) LET circtest= tstp PLOT wx,wy; LET oldwy= 999 FOR i= 1 to 5000 ! draw trajectory LET starttime= time LET oldx = x LET oldy = y LET oldwx= wx LET oldwy= wy LET olddy= dy CALL Euler(x,y,dx,dy) ! IF mod(t,.5)=0 and t1Flag=1 then ! CALL StoreValues(x,y) ! END IF ! IF abs(x-x0)10 then ! LET circflag= 1 ! EXIT FOR ! END IF LET wx= w1Wndx(x) LET wy= w1Wndy(y) IF wx>w1Lft and wxw1Top and wyw1Lft and oldwxw1Top and oldwyw1Lft and oldwxw1Top and oldwyw1fRgt or abs(y)>w1fTop or ms=2 then EXIT FOR END IF DO LOOP until time-starttime>1/60 NEXT i PLOT END SUB SUB RungeKutta4(x,y,dx,dy) CALL FetchEq(eq,x,y,dx,dy) LET dx1= dx LET dy1= dy LET x1 = x + .5*dx1*tstp LET y1 = y + .5*dy1*tstp CALL FetchEq(eq,x1,y1,dx,dy) LET dx2= dx LET dy2= dy LET x2 = x + .5*dx2*tstp LET y2 = y + .5*dy2*tstp CALL FetchEq(eq,x2,y2,dx,dy) LET dx3= dx LET dy3= dy LET x3 = x + dx3*tstp LET y3 = y + dy3*tstp CALL FetchEq(eq,x3,y3,dx,dy) LET dx4= dx LET dy4= dy LET dy = (dy1 + 2*dy2 + 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 SUB Euler(x,y,dx,dy) CALL FetchEq(eq,x,y,dx,dy) LET x= x + dx*tstp LET y= y + dy*tstp END SUB SUB SlopeField CALL Plane1Refresh LET aspect = (w1wwid/w1fwid)/(w1whgt/w1fhgt) IF fieldState=1 then SET COLOR fieldclr ! vector field !LET dx= 1 ! aspect FOR wy= w1top+10 to w1bas-10 step 20 FOR wx= w1Lft+10 to w1Rgt-10 step 20 LET x= w1Fncx(wx) LET y= w1Fncy(wy) IF round(y,2)<>0 then CALL FetchEq(eq,x,y,dx,dy) LET dx = dx*aspect LET ang= angle(dx,-dy) LET sa = 4*sin(ang) LET wy1= wy+sa LET wy2= wy-sa LET ca = 4*cos(ang) PLOT wx-ca,wy2; wx+ca,wy1 END IF NEXT wx NEXT wy BOX KEEP w1lft-5,w1rgt+5,w1bas+5,w1top-5 in w1GraphLayer$ ELSE LET w1GraphLayer$= w1GridLayer$ END IF END SUB ! SUB VectorField ! CALL Plane1Refresh ! IF fieldState=1 then ! SET COLOR fieldclr ! vector field ! FOR wy= w1Top+10 to w1Bas-10 step 20 ! FOR wx= w1Lft+10 to w1Rgt-10 step 20 ! LET x= w1Fncx(wx) ! LET y= w1Fncy(wy) ! CALL FetchEq(eq,x,y,dx,dy) ! IF dx<>0 or dy<>0 then ! DRAW vpointer with rotate(angle(1,-dy))*shift(wx,wy) ! ELSE ! PLOT wx,wy ! END IF ! NEXT wx ! NEXT wy ! BOX KEEP w1Lft-5,w1Rgt+5,w1Bas+5,w1Top-5 in w1graphLayer$ ! ELSE ! LET w1graphLayer$= w1GridLayer$ ! END IF ! END SUB PICTURE vpointer PLOT -4, 0; 4,0 END PICTURE SUB IVButtons(t0,x0) LET bbsize= 70 LET bbhgt = 18 LET bbshft= 6 LET chspc = 10 LET x0blft= hRgt+65 LET x0brgt= x0blft+bbsize LET x0btop= ctop LET x0bbas= x0btop+bbhgt CALL SetTextFont(1,12,"bold") LET b$= yax$ & "_[0] =" CALL SuperSubScriptRJ(x0blft-5,x0bbas-bbshft,b$,white) CALL Panel(x0blft,x0brgt,x0bbas,x0btop,0) CALL FormatNum(x0,n$) CALL MonoStringN(x0blft+5,x0bbas-bbshft,chspc,n$,white) LET t0blft= x0blft LET t0brgt= t0blft+bbsize LET t0btop= x0bbas+6 LET t0bbas= t0btop+bbhgt LET b$= xax$ & "_[0] =" CALL SuperSubScriptRJ(t0blft-5,t0bbas-bbshft,b$,white) CALL Panel(t0blft,t0brgt,t0bbas,t0btop,0) CALL FormatNum(t0,n$) CALL MonoStringN(t0blft+5,t0bbas-bbshft,chspc,n$,white) LET rslft= t0blft ! wrgt-95 LET rsrgt= t0brgt ! rslft+80 LET rstop= t0bbas + 6 LET rsbas= rstop+17 CALL SetTextFont(1,9,"bold") !LET txt$ = "Solve (" & xax$ & "0," & yax$ & "0)" LET txt$ = "Iterate" CALL DrawButton(rslft,rsrgt,rsbas,rstop,5,txt$) END SUB SUB Buttons CALL SetTextFont(1,9,"bold") LET ccnt= 2 ! field controls LET cwid= 70 LET chgt= 17 LET clft= w1Lft LET crgt= clft + 68 LET ctop= w1Bas + 50 LET cbas= ctop + 17 CALL DrawButton(clft,crgt,cbas,ctop,5,"Clear") LET sllft= clft LET slrgt= crgt LET sltop= cbas+2 LET slbas= sltop + 17 CALL DrawButton(sllft,slrgt,slbas,sltop,5,"Draw Field") LET glft= sllft LET grgt= slrgt LET gtop= slBas+2 LET gbas= gTop+chgt/2 LET gcnt= 4 LET gwid= round((slRgt-slLft)/4) FOR btn= 0 to gcnt-1 LET l= glft + btn*gwid LET r= l + gwid-2 CALL DrawButton(l,r,gbas,gtop,0,"") SET COLOR btn+2 BOX AREA l+1,r-1,gbas-1,gtop+1 NEXT btn ! --- numerical methods --- CALL SetTextFont(1,9,"bold") LET hcnt= 6 ! time step LET hsiz= 11 LET hwid= 95 LET hhgt= 18 LET hlft= slrgt+30 LET hrgt= hlft + hwid LET htop= cbas - 17 LET hbas= htop + hcnt*hhgt ! CALL PlotTextLJ(hlft,htop-13,"Numerical Method",litgry) ! SET COLOR litgry ! PLOT hlft,htop-8; hrgt,htop-8 FOR btn= 0 to hcnt-1 ! time buttons CALL ButtonY(btn,hhgt,bt,bb) LET clr= SetColor(btn) IF btn