!! File: Matrix Draw !! January 3, 2003 Hubert Hohn PUBLIC PCFlag,Mac5Flag,M68KFlag,UnixFlag,xmax,ymax PUBLIC toolLft,toolRgt,toolBas,toolTop,toolhdr,toolHgt,toolWid ! tool boundaries PUBLIC winLft,winRgt,winBas,winTop,winHgt,winWid ! window PUBLIC workLft,workRgt,workBas,workTop,workMidx ! work area PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white PUBLIC red,yellow,green,cyan,blue,magenta,pink,colorscheme PUBLIC planeclr,gridclr,rimclr,axisclr,axislabelclr,titleclr,rightsclr PUBLIC numberlineclr,slotdrkclr,slotlgtclr,slideclr PUBLIC largefonts, title$, SLUmode DECLARE DEF QuitWithin, InfoWithin LET toolHgt= 560 LET toolWid= 780 LET window$= "The d'Arbeloff Interactive Math Project" LET colorscheme= 0 LET title$ = "Transform Matrix Drawing" SUB ThisProgram CALL MatrixDraw CLEAR END SUB !! ---------------------------------------------------------- !! ------ Start TB4 Mac Header and Subs ------ !LET M68KFlag = 1 !LIBRARY "MacTools*", "HHLib.trc" !ASK PIXELS winWid,winHgt !LET winLft= 0 !LET winTop= 0 !LET winRgt= winWid-1 !LET winBas= winHgt-1 !SET WINDOW 0,winRgt,winBas,0 !CALL Palette !CLEAR ! !CALL ToolPanel !CALL ThisProgram ! !END !EXTERNAL ! !MODULE Mac4Parts ! SUB SetTextFont(font,size,style$) ! CALL MacTextFont(font) ! CALL MacTextSize(size) ! CALL MacTextFace(style$) ! END SUB ! ! SUB StringWidth(sw$,sl) ! DECLARE DEF MacStringWidth ! LET sl= MacStringWidth(sw$) ! END SUB ! ! SUB SetLineWeight(wgt) ! CALL MacPenSize(wgt,wgt) ! END SUB ! ! SUB BoxDisk(Lft,Rgt,Bas,Top) ! CALL MacPaintOval(Lft,Rgt,Bas,Top) ! END SUB !END MODULE !! --- End TB4 Mac Header and Subs --- !!--- Start TB5 Cross-Platform header and subs --- LIBRARY "c:\TB Gold 51a\TBLibs\TrueCtrl.trc" ! windows LIBRARY "c:\TB Gold 51a\TBLibs\HHLib.trc" !LIBRARY ":TBLibs:TrueCtrl.trc" ! macintosh !LIBRARY "HHLib.trc" PUBLIC WinID DECLARE PUBLIC OBJM_SET,OBJM_SYSINFO LET winHgt= toolHgt LET winWid= toolWid DIM values(1) CALL TC_Init CALL Object(OBJM_SYSINFO,WinID,"MACHINE",system$,values()) IF system$="MAC" then LET Mac5Flag= 1 ELSE IF system$="WIN32" then LET PCFlag = 1 END IF CALL TC_SetUnitsToPixels ! 5.1 and up needs this CALL TC_GetScreenSize(scrnLft,scrnRgt,scrnBas,scrnTop) LET winLft= int((scrnRgt-scrnLft-winWid)/2) LET winRgt= winLft+winWid-1 LET winTop= int((scrnBas-scrnTop-winHgt)/2) + 10 LET winBas= winTop+winHgt-1 CALL TC_Win_Create (WinID,"TITLE",winLft,winRgt,winBas,winTop) LET values(1)= 2 CALL Object(OBJM_SET, WinID, "TYPE", "", values()) IF PCFlag=1 then ! kill dithering LET values(1)= 1 CALL Object(OBJM_SET, WinID, "SOLID MIX", "", values()) END IF LET values(1)= 0 CALL TC_SetRect(WinID,winLft,winRgt,winBas,winTop) CALL TC_Win_SetTitle(WinID,window$) CALL TC_Show(WinID) SET MODE "COLORSTANDARD" ASK PIXELS winWid,winHgt ! must follow set mode LET winLft= 0 LET winTop= 0 LET winRgt= winWid-1 LET winBas= winHgt-1 SET WINDOW 0,winRgt,winBas,0 CALL Palette IF PCFlag=1 then LET values(1)= 0 ! now force solid colors CALL Object(OBJM_SET, WinID, "SOLID MIX", "", values()) CALL TC_Win_RealizePalette(WinID) ! some PCs need this CALL TC_Win_SetFont(WinID,"arial",9,"plain") CALL StringWidth("0",sw) IF sw>7 then LET largefonts=1 else LET largefonts=0 END IF CALL TC_Win_Switch(WinID) CALL ToolPanel CALL ThisProgram CALL SetTextFont(1,12,"bold") ! now shut down and clean up LET quit$= "click the mouse or press a key to close..." CALL PlotTextCJ(workmidx,(workbas+worktop)/2,quit$,yellow) CALL TC_CleanUp END EXTERNAL MODULE TB5Parts SUB StringWidth(sw$,sl) DECLARE PUBLIC WinID LET sl= StrWidth(WinID,sw$) END SUB SUB SetLineWeight(wgt) DECLARE PUBLIC OBJM_SET DECLARE PUBLIC WinID DIM values(1) LET values(1)= wgt CALL Object(OBJM_SET,WinID, "WIDTH", "", values()) END SUB SUB SetTextFont(font,size,style$) DECLARE PUBLIC WinID,Mac5Flag,PCFlag,largefonts IF Mac5Flag=1 then SELECT CASE font CASE 4 LET font$= "Courier" CASE 16 LET font$= "Times" CASE else LET font$= "Geneva" END SELECT ELSE IF PCFlag=1 then IF largefonts=1 then IF size<12 then LET size= 6 ELSE IF size=14 then LET size= 10 ELSE IF size=18 then LET size= 12 ELSE IF size=24 then LET size= 14 ELSE IF size=12 then LET size= 8 ELSE LET size= round(72/96 * size * .8) END IF ELSE IF size<12 then LET size= 7 ELSE IF size=14 then LET size= 12 ELSE IF size=12 then LET size= 9 ELSE IF size=18 then LET size= 14 ELSE IF size=24 then LET size= 18 ELSE LET size= round(72/96 * size) END IF END IF SELECT CASE font CASE 4 LET font$= "Courier New" CASE 16 LET font$= "Times New Roman" CASE else LET font$= "Verdana" END SELECT END IF IF style$= "normal" then LET style$= "plain" CALL TC_Win_SetFont(WinID,font$,size,style$) END SUB SUB BoxDisk(Lft,Rgt,Bas,Top) BOX DISK Lft,Rgt,Bas,Top END SUB END MODULE ! --- End TB5 Cross-platform header and subs --- !! --------------------------------------------------------- !! --- Start Unix Header and Subs --- !LET UnixFlag= 1 !ASK PIXELS winWid,winHgt !LET winLft= 0 !LET winTop= 0 !LET winRgt= winWid-1 !LET winBas= winHgt-1 !SET WINDOW 0,winRgt,winBas,0 !CALL Palette ! !CALL ToolPanel !CALL ThisProgram ! !END !EXTERNAL ! !MODULE UnixParts ! SHARE CharWidth ! ! SUB SetTextFont(font,size,style$) ! LET font$= "-adobe-courier-" ! IF style$= "normal" then ! LET style$= "medium-r-normal--" ! ELSE ! LET style$= "bold-r-normal--" ! END IF ! IF size=9 then ! LET size$= str$(10) ! ELSE ! LET size$= str$(size) ! END IF ! LET test= SetFont(font$&style$&size$&"*") ! ! IF size=9 then ! LET CharWidth= 6 ! ELSE IF size=12 then ! numeric output - axis labels ! LET CharWidth= 7 ! ELSE IF size=14 then ! rare ! LET CharWidth= 8 ! ELSE IF size=18 then ! rare ! LET CharWidth= 10 ! END IF ! END SUB ! ! SUB StringWidth(sw$,sl) ! string width in pixels ! ! LET sl= StrWidth(sw$) ! LET chars= len(sw$) ! LET sl = chars*CharWidth ! END SUB ! ! SUB SetLineWeight(wgt) ! ! CALL PenSize(wgt,wgt) ! END SUB ! ! SUB BoxDisk(Lft,Rgt,Bas,Top) ! CALL Fill_Circle(Lft,Rgt,Bas,Top) ! END SUB !END MODULE !! ------ End of TB Unix Header and Subs ------ !! --------------------------------------------------------- ! *** !Linear Parameter Trace: This is a cool tool, which I hope the linear !algebra people pick up on. We may want to play with the game of interpolating !the curves, except maybe when the input vector is being controlled on the !window itself. But it's very cool as it is. The display could be made !slightly cleaner by dropping the letters a,b,c,d. And by the way, !on my monitor those letters, those sliders, and the setting dial to !their right, are all faint, shadowed, much fainter than the trace = ... !and so on below. Similarly, the markings on all the sliders are faint. !But the dial on top and the "y" on the bottom of the y-slider, !and the "theta" on the left and dial on the right of the theta slider, !are both intense. Also the x and y on the axes are faint. We've had !this problem before on other tools. SUB MatrixDraw DECLARE PUBLIC black,drkgry,drkmid,midgry,litmid,litgry,white DECLARE PUBLIC red,yellow,green,cyan,blue,magenta,colorscheme DECLARE PUBLIC axislabelclr,slideclr DECLARE PUBLIC workLft,workRgt,workBas,workTop,workMidx DECLARE DEF quitWithin,infoWithin ! --- help screen array --- DIM info$(1:1) MAT READ info$ DATA "Information on linear transformation" ! ---------- Utility functions --- DECLARE DEF clamp,roundn,e,modulus ! ---------- Graphing plane parameters and methods ---------- ! --- plane 1 data --- DECLARE PUBLIC w1Lft,w1Rgt,w1Bas,w1Top,w1Midx,w1Midy DECLARE PUBLIC w1fLft,w1fRgt,w1fBas,w1fTop,w1x0,w1y0 DECLARE PUBLIC w1xFirst, w1xSTik, w1xLTik, w1xLabel, w1xGridstep DECLARE PUBLIC w1yFirst, w1ySTik, w1yLTik, w1yLabel, w1yGridstep DECLARE PUBLIC w1wWid,w1wHgt,w1fWid,w1fHgt DECLARE PUBLIC w1fxRatio,w1fyRatio,w1wxRatio,w1wyRatio,w1Aspect DECLARE PUBLIC w1xPiFlag, w1xMult, w1yPiFlag, w1yMult LET w1Flag = 1 LET w1xPiFlag= 0 LET w1yPiFlag= 0 LET w1xMult = 1 LET w1yMult = 1 LET w1Lft= worklft + 90 ! pixel bounds LET w1Rgt= w1Lft+300 LET w1Top= worktop + 35 LET w1Bas= w1Top+300 LET w1fLft= -6 ! function bounds LET w1fRgt= 6 LET w1fTop= 6 LET w1fBas= -6 LET w1xAx$= "x" ! axis labels LET w1yAx$= "y" LET w1xGridstep= 1 ! horizontal grid intervals LET w1yGridstep= 1 ! vertical grid intervals LET w1xSTik = 0 ! horizontal axis Tik marks LET w1xLTik = 1 LET w1xLabel= 1 LET w1xFirst= w1fLft LET w1ySTik = 0 ! vertical axis Tik marks LET w1yLTik = 1 LET w1yLabel= 1 LET w1yFirst= w1fBas ! --- Plane 1 methods --- DECLARE DEF w1Fncx,w1Fncy,w1Wndx,w1Wndy,w1wWithin ! window/function transforms CALL w1Variables SUB w1Init CALL w1DrawPlane(0,0,1) ! grid, axes, zeroaxes CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(w1Rgt+8,w1y0+3,w1xAx$,litgry) ! axis labels CALL PlotTextCJ(w1x0,w1Top-10,w1yAx$,litgry) CALL w1KeepGridLayer CALL w1KeepGraphLayer END SUB ! SUB PolarGrid ! FOR n= 1 to w1fRgt ! CALL BoxCircle(w1Wndx(-n),w1Wndx(n),w1Wndy(-n),w1Wndy(n),3) ! NEXT n ! END SUB ! ---------- Slider parameters and methods ---------- ! ----------- vertical sliders ------------ ! --- vertical slider 1 --- DECLARE DEF v1Fncy,v1Wndy,v1Within ! window/function transforms DECLARE PUBLIC v1axis,v1wLft,v1wRgt,v1wBas,v1wTop,v1sBas,v1sTop DECLARE PUBLIC v1fBas,v1fTop,v1First,v1STik,v1LTik,v1Label DECLARE PUBLIC v1name$,v1Mult,v1form$,v1clr,v1PiAxis LET v1PiAxis= 0 LET v1Mult = 1 LET v1clr = yellow !slideclr LET v1name$= "y" LET v1form$= "-%.##" LET v1Places= 2 LET v1axis = w1Lft - 30 LET v1wBas = w1Bas LET v1wTop = w1Top LET v1fBas = w1fBas LET v1fTop = w1fTop LET v1STik = 0 LET v1LTik = 1 LET v1Label= 1 LET v1First= v1fBas LET v1Click= 1 CALL v1SliderVariables ! ----------- horizontal sliders ------------ LET slideWidth= 96 ! --- horizontal slider 1 --- DECLARE DEF h1Fncx,h1Within ! window/function transforms DECLARE PUBLIC h1axis,h1wLft,h1wRgt,h1wBas,h1wTop,h1fLft,h1fRgt DECLARE PUBLIC h1name$,h1form$,h1clr,h1First,h1STik,h1LTik,h1Label DECLARE PUBLIC h1PiAxis,h1Mult,h1fMin,h1fMax LET h1PiAxis= 0 LET h1Mult = 1 LET h1clr = yellow ! slideclr LET h1name$ = "x" LET h1form$ = "-%.##" LET h1Places= 2 LET h1axis = w1Bas + 30 LET h1wLft = w1Lft LET h1wRgt = w1Rgt LET h1fLft = w1fLft LET h1fRgt = w1fRgt LET h1STik = 0 ! short tick marks LET h1LTik = 1 ! long tick marks LET h1Label= 1 ! labels LET h1First= h1fLft ! first tick mark LET h1Click= 1 CALL h1SliderVariables ! --- matrix Sliders 2-5 --- ! --- Slider 2 --- DECLARE PUBLIC h2axis,h2wLft,h2wRgt,h2wBas,h2wTop,h2fLft,h2fRgt DECLARE PUBLIC h2name$,h2form$,h2clr,h2First,h2STik,h2LTik,h2Label DECLARE PUBLIC h2PiAxis,h2Mult,h2fMin,h2fMax LET h2PiAxis= 0 LET h2Mult = 1 LET h2clr = cyan !slideclr LET h2name$ = "a" LET h2form$ = "--%.#" LET h2Places= 1 LET h2axis = w1Bas - 70 LET h2wLft = w1Rgt + 90 LET h2wRgt = h2wLft + 60 LET h2fLft = -6 LET h2fRgt = 6 LET h2STik = 1 LET h2LTik = 3 LET h2Label= 3 LET h2First= h2fLft LET h2Click= 1 CALL h2SliderVariables DECLARE DEF h2Within ! window/function transforms ! --- slider 3 --- DECLARE PUBLIC h3axis,h3wLft,h3wRgt,h3wBas,h3wTop,h3fLft,h3fRgt DECLARE PUBLIC h3name$,h3form$,h3clr,h3First,h3STik,h3LTik,h3Label DECLARE PUBLIC h3PiAxis,h3Mult,h3fMin,h3fMax LET h3PiAxis= 0 LET h3Mult = 1 LET h3clr = cyan !slideclr LET h3name$ = "b" LET h3form$ = "-%.#" LET h3Places = 1 LET h3axis = h2axis LET h3wLft = h2wRgt + 80 LET h3wRgt = h3wLft + 60 LET h3fLft = -6 LET h3fRgt = 6 LET h3STik = 1 LET h3LTik = 3 LET h3Label= 3 LET h3First= h3fLft LET h3Click= 1 CALL h3SliderVariables DECLARE DEF h3Within ! window/function transforms ! --- slider 4 --- DECLARE PUBLIC h4axis,h4wLft,h4wRgt,h4wBas,h4wTop,h4fLft,h4fRgt DECLARE PUBLIC h4name$,h4form$,h4clr,h4First,h4STik,h4LTik,h4Label DECLARE PUBLIC h4PiAxis,h4Mult,h4fMin,h4fMax LET h4PiAxis= 0 LET h4Mult = 1 LET h4clr = cyan !slideclr LET h4name$ = "c" LET h4form$ = "--%.#" LET h4Places= 1 LET h4axis = h2axis + 45 LET h4wLft = h2wLft LET h4wRgt = h2wRgt LET h4fLft = -6 LET h4fRgt = 6 LET h4STik = 1 LET h4LTik = 3 LET h4Label= 3 LET h4First= h4fLft LET h4Click= 1 CALL h4SliderVariables DECLARE DEF h4Within ! window/function transforms ! --- slider 5 --- DECLARE PUBLIC h5axis,h5wLft,h5wRgt,h5wBas,h5wTop,h5fLft,h5fRgt DECLARE PUBLIC h5name$,h5form$,h5clr,h5First,h5STik,h5LTik,h5Label DECLARE PUBLIC h5PiAxis,h5Mult,h5fMin,h5fMax LET h5PiAxis= 0 LET h5Mult = 1 LET h5clr = cyan !slideclr LET h5name$ = "d" LET h5form$ = "--%.#" LET h5Places= 1 LET h5axis = h4axis LET h5wLft = h3wLft LET h5wRgt = h3wRgt LET h5fLft = -6 LET h5fRgt = 6 LET h5STik = 1 LET h5LTik = 3 LET h5Label= 3 LET h5First= h5fLft LET h5Click= 1 CALL h5SliderVariables DECLARE DEF h5Within ! window/function transforms ! --- transformation matrix --- LET mtop = h2wtop - 10 !+20 ! matrix LET mbas = h4wbas + 10 LET mlft = h2wLft - 35 LET mrgt = h3wRgt + 55 LET lnspc = 18 LET bas0 = mbas+40 LET bas1 = bas0+lnspc LET bas2 = bas1+lnspc + 5 LET bas3 = bas2+lnspc LET tdlft = workrgt-160 - 55 LET gw1Lft= tdlft+53 LET bas2a = bas2+15 SUB DrawMatrix SET COLOR cyan PLOT mlft+6,mtop; mlft,mtop; mlft,mbas; mlft+6,mbas PLOT mlft+6,mtop+1; mlft+1,mtop+1; mlft+1,mbas-1; mlft+6,mbas-1 PLOT mrgt-6,mtop; mrgt,mtop; mrgt,mbas; mrgt-6,mbas PLOT mrgt-6,mtop+1; mrgt-1,mtop+1; mrgt-1,mbas-1; mrgt-6,mbas-1 LET mida= int((mtop+mbas)/2) CALL SetTextFont(1,12,"bold") CALL PlotTextRJ(mlft-5,mida+3,"A =",cyan) END SUB ! --- polar coordinate sliders --- ! -------- slider 6 -------- DECLARE DEF h6Within ! window/function transforms DECLARE PUBLIC h6axis,h6wLft,h6wRgt,h6wBas,h6wTop,h6fLft,h6fRgt DECLARE PUBLIC h6name$,h6form$,h6clr,h6First,h6STik,h6LTik,h6Label DECLARE PUBLIC h6PiAxis,h6Mult,h6fMin,h6fMax LET h6PiAxis= 0 LET h6Mult = 1 LET h6clr = yellow !slideclr LET h6name$ = "r" LET h6form$ = "--%.##" LET h6Places = 2 LET h6axis = h1axis+75 LET h6wLft = h1wLft LET h6wRgt = h6wLft+160 LET h6fLft = 0 LET h6fRgt = 8 LET h6STik = 0 LET h6LTik = 1 LET h6Label= 1 LET h6First= h6fLft LET h6Click= 1 DECLARE DEF h6Fncx CALL h6SliderVariables ! --- slider 7 --- DECLARE PUBLIC h7axis,h7wLft,h7wRgt,h7wBas,h7wTop,h7fLft,h7fRgt DECLARE PUBLIC h7name$,h7form$,h7clr,h7First,h7STik,h7LTik,h7Label DECLARE PUBLIC h7PiAxis,h7Mult,h7fMin,h7fMax DECLARE DEF h7Within ! window/function transforms LET h7PiAxis= 1 LET h7Mult = pi LET h7clr = yellow !slideclr LET h7name$ = "" LET h7form$ = "-%.###" LET h7Places= 3 LET h7axis = h6axis+45 LET h7wLft = h6wLft LET h7wRgt = h7wLft+400 LET h7fLft = 0 LET h7fRgt = 2 LET h7STik = 0.25 LET h7LTik = 0.5 LET h7Label= 0.5 LET h7First= h7fLft LET h7Click= 1/4 CALL h7SliderVariables SUB h7Init CALL h7DrawSlider(h7name$,ang) CALL DrawPhi12(h7wLft-15,h7wBas-1,yellow) END SUB ! ---------- Text Output Rects ---------- ! --- text rectangle 1 --- LET t1BasLn1= w1Midy + 10 LET t1BasLn2= t1BasLn1 + 20 LET t1Lft = workrgt-160 LET t1Rgt = workrgt LET t1Bas = t1BasLn2 + 5 LET t1Top = t1BasLn1 - 15 SUB t1Set LOCAL r$,i$,z$ CALL t1Clear LET fnc1$= "x_[o] = ax_[i] + by_[i]" LET fnc2$= "y_[o] = cx_[i] + dy_[i]" CALL SetTextFont(1,12,"bold") CALL SuperSubScriptLJ(t1Lft,t1BasLn1,fnc1$,white) CALL SuperSubScriptLJ(t1Lft,t1BasLn2,fnc2$,white) END SUB SUB t1Clear BOX CLEAR t1Lft-2,t1Rgt,t1Bas,t1Top END SUB ! --- text rectangle 2 --- LET t2BasLn= t1BasLn LET t2Lft = h3wLft + 23 LET t2Rgt = h3wRgt + 30 LET t2Bas = t2BasLn + 5 LET t2Top = t2BasLn - 15 SUB t2Label CALL SuperSubScriptRJ(t2Lft,t2BasLn,"w = ",cclr) END SUB SUB t2Set LOCAL r$,i$,z$ CALL t2Clear LET r$ = trim$(using$("--%.##",h3c)) LET i$ = trim$(using$("--%.##i",abs(h4d))) CALL StringWidth(r$,rw) LET pmx= t2lft + rw + 10 LET ix = pmx + 6 + 3 CALL PlotTextLJ(t2Lft,t2BasLn,r$,cclr) DRAW PlusMinus(cclr) with shift(pmx,t2BasLn) CALL PlotTextLJ(ix,t2BasLn,i$,cclr) END SUB SUB t2Clear BOX CLEAR t2Lft-2,t2Rgt,t2Bas,t2Top END SUB SUB t2Init CALL t2Label CALL t2Set END SUB ! ! --- reset pairs --- ! ! SUB ts12 ! CALL t1Set ! !CALL t2Set ! END SUB ! ! SUB ts34 ! CALL t2Set ! !CALL t4Set ! END SUB ! ! ! --- text rectangle 5 --- ! ! LET t5BasLn= w2Bas + 43 ! LET t5Lft = w2Lft ! LET t5Lfte = w2Lft + 240 ! LET t5Rgt = w2Rgt - 150 ! LET t5Bas = t5BasLn + 5 ! LET t5Top = t5BasLn - 15 ! ---- input and output matrices ---- LET intxty = w1Top + 10 LET outtxty= intxty + 70 LET intxtx = w1Rgt + 60 LET outtxtx= intxtx LET olft= outtxtx + 25 ! output panel LET orgt= olft + 60 LET otop= outtxty + 10 LET obas= otop + 30 LET mido= (olft+orgt)/2 LET ilft= intxtx + 25 ! input panel LET irgt= ilft + 60 LET itop= intxty + 10 LET ibas= itop+30 LET midi= (ilft+irgt)/2 ! ----- text output - trace and determinant ----- ! LET chspc= 8 SUB ShowParam(trace,dterm) CALL LoadMat LET trace= ma+md LET dterm= ma*md - mb*mc CALL GetLamda(trace,dterm,cmplx,l1$,l2$) LET tclr = white CALL SetTextFont(1,12,"bold") BOX CLEAR tdlft,tdlft+200,bas3+5,bas0-12 SET COLOR tclr LET t$= "trace = " & trim$(using$("---%.##",trace)) CALL AlignEqual(tdlft+84,bas0,t$,tclr) LET d$= "determinant = " & trim$(using$("---%.##",dterm)) CALL AlignEqual(tdlft+84,bas1,d$,tclr) IF l2$="" then CALL DrawLam(gw1Lft+8,bas2,tclr) CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(gw1Lft+18,bas2," = " & l1$,tclr) ELSE CALL DrawLam(gw1Lft,bas2,tclr) CALL SetTextFont(1,9,"bold") CALL PlotTextLJ(gw1Lft+11,bas2+3,"1",tclr) CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(gw1Lft+18,bas2," = " & l1$,tclr) CALL DrawLam(gw1Lft,bas3,tclr) CALL SetTextFont(1,9,"bold") CALL PlotTextLJ(gw1Lft+11,bas3+3,"2",tclr) CALL SetTextFont(1,12,"bold") CALL PlotTextLJ(gw1Lft+18,bas3," = " & l2$,tclr) END IF END SUB SUB GetLamda(trace,det,cmplx,l1$,l2$) ! | a b | | lam 0 | | a-lam b | ! A - lam*I = | | - | | = | | ! | c d | | 0 lam | | c d-lam | ! |A - lam*I| = (a-lam)*(d-lam) - b*c ! p(lam) = ad - lam*a - lam*d + lam^2 - bc ! p(lam) = lam^2 - lam*a - lam*d + ad - bc ! p(lam) = lam^2 - lam*(a+d) + ad - bc ! trace = a+d ! det = ad - bc ! p(lam) = lam^2 - trace*lam + det = 0 ! quadratic solution ! a = 1 ! b = trace ! c = det ! dscrm= b^2 - 4ac ! lam = (b+sqr(dscrm)) / 2a ! lam = (b-sqr(dscrm)) / 2a LET dscrm= trace*trace - 4*det ! find discriminant LET cmplx= 0 SELECT CASE dscrm CASE 0 ! one real root LET lam1,lam2= trace/2 LET l1$= trim$(using$("-%.##",lam1)) LET l2$= "" CASE is > 0 ! two real roots LET lam1= (trace+sqr(dscrm))/2 LET lam2= (trace-sqr(dscrm))/2 LET l1$ = trim$(using$("-%.##",lam1)) LET l2$ = trim$(using$("-%.##",lam2)) CASE is < 0 ! complex roots LET lam1= trace/2 LET lam2= sqr(-dscrm)/2 LET r$ = trim$(using$("-%.##",lam1)) LET i$ = trim$(using$("-%.##i",abs(lam2))) LET l1$ = r$ & " - " & i$ LET l2$ = r$ & " + " & i$ LET cmplx= 1 END SELECT END SUB ! --- arrays and functions --- DIM A(0:1,0:1),V1(0:1),V2(0:1) DEF dxdt(x,y)= ma*x + mb*y DEF dydt(x,y)= mc*x + md*y ! --- default parameters --- LET x1,oldx1 = 1 LET y1,oldy1 = 1 LET ang,oldang= atn(y1/x1) LET rad,oldrad= sqr(x1*x1 + y1*y1) LET ma,oldma = 1 LET mb,oldmb = -2 LET mc,oldmc = 0 LET md,oldmd = 2 LET omx,omy= 999 LET eqx = 30 LET btr = 8 ! LET f$ = "---%.##" ! -------- initialize screen --------- CALL InitScreen SUB InitScreen BOX CLEAR worklft,workrgt,workbas,worktop CALL w1Init CALL v1DrawSlider(v1name$,y1) CALL h1DrawSlider(h1name$,x1) CALL h2DrawSlider(h2name$,ma) CALL h3DrawSlider(h3name$,mb) CALL h4DrawSlider(h4name$,mc) CALL h5DrawSlider(h5name$,md) CALL h6DrawSlider(h6name$,rad) CALL h7Init CALL DrawMatrix LET inclr = yellow LET outclr= cyan CALL PlotTextLJ(intxtx,intxty ,"Input Vector",inclr) CALL PlotTextLJ(outtxtx,outtxty,"Output Vector",outclr) CALL Buttons ! CALL t1Set CALL LoadMat CALL ShowParam(trace,dterm) LET x1= 1 LET y1= 1 CALL DrawVectors(x1,y1) END SUB ! ----------------- Event manager ----------------- DO LET start= 1 DO GET MOUSE: mx,my,s LOOP until s=2 IF w1wWithin(mx,my)=1 then DO GET MOUSE: mx,my,ms CALL w1wClamp(mx,my) CALL w1PixelsToMath(mx,my,x1,y1) CALL CartesianToPolar(x1,y1,rad,ang) IF rad>8 then LET rad= 8 CALL PolarToCartesian(rad,ang,x1,y1) END IF IF x1<>oldx or y1<>oldy then ! mouse motion? ! LET ox= mx ! LET oy= my ! CALL w1PixelsToMath(mx,my,x1,y1) CALL DrawVectors(x1,y1) CALL v1Mark(y1) CALL h1Mark(x1) CALL CartesianToPolar(x1,y1,rad,ang) CALL h6Mark(rad) CALL h7Mark(ang) LET oldrad= rad LET oldang= ang LET oldx = x1 LET oldy = y1 END IF LOOP until ms=3 ! cartesian input coordinates ELSE IF v1Within(mx,my)=1 then IF mxcLft and mxcTop and myoldy1 then CALL DrawVectors(x1,y1) CALL CartesianToPolar(x1,y1,rad,ang) CALL h6Mark(rad) CALL h7Mark(ang) LET oldy1= y1 END IF END SUB ! --- SUB h1MouseClick CALL h1GetClickVal(ms,h1Click,x1) CALL h1Action END SUB SUB h1MouseDrag DO CALL h1GetDragVal(ms,h1Places,x1) CALL h1Action LOOP until ms=3 END SUB SUB h1Action IF x1<>oldx1 then CALL DrawVectors(x1,y1) CALL CartesianToPolar(x1,y1,rad,ang) CALL h6Mark(rad) CALL h7Mark(ang) LET oldx1= x1 END IF END SUB ! --- matrix output --- ! ------ h1 ma ------ SUB h2MouseClick CALL h2GetClickVal(ms,h2Click,ma) CALL h2Action END SUB SUB h2MouseDrag DO CALL h2GetDragVal(ms,h2Places,ma) CALL h2Action LOOP until ms=3 END SUB SUB h2Action IF ma<>oldma then CALL ShowParam(trace,dterm) CALL DrawOutVector LET oldma= ma END IF END SUB ! ------ h3 mb ------ SUB h3MouseClick CALL h3GetClickVal(ms,h3Click,mb) CALL h3Action END SUB SUB h3MouseDrag DO CALL h3GetDragVal(ms,h3Places,mb) CALL h3Action LOOP until ms=3 END SUB SUB h3Action IF mb<>oldmb then CALL ShowParam(trace,dterm) CALL DrawOutVector LET oldmb= mb END IF END SUB ! ------ h4 mc ------ SUB h4MouseClick CALL h4GetClickVal(ms,h4Click,mc) CALL h4Action END SUB SUB h4MouseDrag DO CALL h4GetDragVal(ms,h4Places,mc) CALL h4Action LOOP until ms=3 END SUB SUB h4Action IF mc<>oldmc then CALL ShowParam(trace,dterm) CALL DrawOutVector LET oldmc= mc END IF END SUB ! ------ h5 md ------ SUB h5MouseClick CALL h5GetClickVal(ms,h5Click,md) CALL h5Action END SUB SUB h5MouseDrag DO CALL h5GetDragVal(ms,h5Places,md) CALL h5Action LOOP until ms=3 END SUB SUB h5Action IF md<>oldmd then CALL ShowParam(trace,dterm) CALL DrawOutVector LET oldmd= md END IF END SUB ! --- polar input --- ! ----- h6 rad ----- SUB h6MouseClick CALL h6GetClickVal(ms,h6Click,rad) CALL h6Action END SUB SUB h6MouseDrag DO ! CALL h6GetDragVal(ms,h6Places,rad) GET MOUSE: mx,my,ms LET mx = min(max(mx,h6wLft),h6wRgt) LET rad= h6Fncx(mx) LET rad= round(rad,h6Places) CALL h6Action LOOP until ms=3 END SUB SUB h6Action CALL ClipRad(6) IF rad<>oldrad then ! CALL PolarToCartesian(rad,ang,x1,y1) CALL DrawVectors(x1,y1) CALL v1Mark(y1) CALL h1Mark(x1) ! CALL h6Mark(rad) LET oldrad= rad END IF END SUB ! ----- h7 ang ----- SUB h7MouseClick CALL h7GetClickVal(ms,h7Click,ang) CALL h7Action END SUB SUB h7MouseDrag DO CALL h7GetDragVal(ms,h7Places,ang) CALL h7Action LOOP until ms=3 END SUB SUB h7Action IF ang<>oldang then CALL ClipRad(6) LET oldrad= rad CALL PolarToCartesian(rad,ang,x1,y1) CALL DrawVectors(x1,y1) CALL v1Mark(y1) CALL h1Mark(x1) LET oldang= ang END IF END SUB ! ------------ graphing routines ------------- SUB ClipRad(size) ! This code clips the radius ! reset modulus to stay on screen CALL PolarToCartesian(rad,ang,x1,y1) IF abs(x1)>size then ! clip vertical LET slope = y1/x1 LET x1 = size LET y1 = slope*x1 ELSE IF abs(y1)>size then ! clip horizontal LET slope = y1/x1 LET y1 = size LET x1 = y1/slope END IF LET rad= modulus(x1,y1) ! adjust rad IF rad<>oldrad then CALL h6Mark(rad) END IF CALL PolarToCartesian(rad,ang,x1,y1) END SUB ! --- vector drawing methods --- SUB DrawVectors(x1,y1) !IF x1<>0 or y1<>0 then ! not the origin? BOX CLEAR olft+5,orgt-5,obas-5,otop+5 ! clear text panel CALL w1ShowGraphLayer CALL OutputVector(x1,x2,y1,y2,A) ! set the output points ! this leaves a trace of input and output ! IF x1>w1fLft and x1w1fBas then ! SET COLOR yellow ! PLOT w1Wndx(x1),w1Wndy(y1) ! END IF ! IF x2>w1fLft and x2w1fBas then ! SET COLOR cyan ! PLOT w1Wndx(x2),w1Wndy(y2) ! END IF ! CALL w1KeepGraphLayer CALL VectorData ! typesetting CALL DisplayEVect(x1,y1,x2,y2,2,0) END SUB SUB DrawOutVector BOX CLEAR olft+5,orgt-5,obas-5,otop+5 ! clear text panel CALL w1ShowGraphLayer CALL OutputVector(x1,x2,y1,y2,A) IF x1>w1fLft and x1w1fBas then SET COLOR yellow PLOT w1Wndx(x1),w1Wndy(y1) END IF IF x2>w1fLft and x2w1fBas then SET COLOR cyan PLOT w1Wndx(x2),w1Wndy(y2) END IF CALL w1KeepGraphLayer CALL VectorData CALL DisplayEVect(x1,y1,x2,y2,2,0) END SUB SUB OutputVector(x1,x2,y1,y2,A(,)) LET V1(0)= x1 ! load input LET V1(1)= y1 MAT V2 = A*V1 ! get output LET x2 = V2(0) LET y2 = V2(1) END SUB SUB VectorData BOX CLEAR olft+1,orgt-1,obas-1,otop+1 CALL SetVect(olft,orgt,obas,otop,outclr,"Av = ",V2(0),V2(1)) BOX CLEAR ilft+1,irgt-1,ibas-1,itop+1 CALL SetVect(ilft,irgt,ibas,itop,inclr ,"v = ",V1(0),V1(1)) END SUB SUB SetVect(l,r,b,t,clr,name$,e1,e2) CALL SetTextFont(1,12,"bold") CALL PlotTextRJ(l-5,(b+t)/2+3,name$,clr) CALL SetTextFont(1,12,"bold") LET e1= round(e1,12) LET e2= round(e2,12) LET x$= using$("--%.##",e1) LET y$= using$("--%.##",e2) CALL PlotTextRJ(r-6,b-20,x$,clr) CALL PlotTextRJ(r-6,b- 3,y$,clr) CALL Bracket(l,b,t, 1,clr) CALL Bracket(r,b,t,-1,clr) END SUB SUB Bracket(lx,by,ty,dir,bclr) SET COLOR bclr IF dir= 1 then PLOT lx+3,by+2; lx,by+2; lx,ty-2; lx+3,ty-2 ELSE IF dir= -1 then PLOT lx-3,by+2; lx,by+2; lx,ty-2; lx-3,ty-2 ELSE PLOT lx,by+2; lx,ty-2 END IF END SUB ! --- SUB DisplayEVect(x1,y1,x2,y2,eFlag,aFlag) IF x1<>0 or y1<>0 then ! CALL VectorClip(x1,y1,inclr) SET COLOR inclr LET w1x1= w1Wndx(x1) LET w1y1= w1Wndy(y1) PLOT w1x0,w1y0; w1x1,w1y1 DRAW VectPnt with rotate(angle(x1,-y1))*shift(w1x1,w1y1) END IF IF round(x2,3)=0 and round(y2,3)=0 then SET COLOR outclr CALL BoxDisk(w1Wndx(0)-3,w1Wndx(0)+3,w1Wndy(0)+3,w1Wndy(0)-3) ELSE ! output is a vector CALL VectorClip(x2,y2,outclr) END IF ! IF aFlag=1 then ! CALL ShowAlgebra ! DO ! GET MOUSE: xx,yy,s ! LOOP until s=2 ! LET start= 1 ! END IF END SUB ! SUB ShowAlgebra ! BOX CLEAR olft+5,orgt-5,obas-5,otop+5 ! CALL VectorData ! CALL SetScalar(tlft+ 0,ttop2,1,1,"lambda= ",lam) ! LET l$= trim$(using$("--%.##",lam)) ! ! CALL SetVect(tlft+ 0,ttop2+30,1,inclr,l$,x1,y1) ! ! CALL SetVect(tlft+71,ttop2+30,1,outclr,"= ",x2,y2) ! ! CALL SetVect(tlft+ 0,ttop2+65,1,inclr,"A ",x1,y1) ! ! CALL SetVect(tlft+71,ttop2+65,1,outclr,"= ",x2,y2) ! END SUB SUB LoadMat LET A(0,0)= ma LET A(0,1)= mb LET A(1,0)= mc LET A(1,1)= md END SUB ! --- SUB SetScalar(vx,vy,nclr,vclr,name$,e1) CALL SetTextFont(1,12,"bold") CALL StringWidth(name$,sl) CALL PlotTextLJ(vx-sl,vy,name$,nclr) CALL SetTextFont(1,12,"bold") LET x$= using$("-%.##",e1) CALL PlotTextLJ(vx+8,vy,x$,vclr) END SUB SUB ResetPointer(mx,mid,pnt,list(),listpnt) LET pnt= list(listpnt) IF mxhi then LET pnt= lo IF pnt