!! File: TrochoidCurves !! May 26, 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 backclr,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 LET toolHgt= 560 LET toolWid= 780 LET window$= "The d'Arbeloff Interactive Math Project" LET colorscheme= 0 LET title$ = "Trochoid Curves" SUB ThisProgram CALL TrochoidCurves 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 --- !library "HHLib.unix" !LET UnixFlag= 1 !ASK PIXELS winWid,winHgt !LET winLft= 0 !LET winTop= 0 !LET winRgt= winWid-1 !LET winBas= winHgt-1 !SET WINDOW 0,winRgt,winBas,0 !CALL Palette ! !CALL ToolPanel !CALL ThisProgram ! !END !EXTERNAL ! !MODULE UnixParts ! SHARE CharWidth ! ! SUB SetTextFont(font,size,style$) ! LET font$= "-adobe-courier-" ! IF style$= "normal" then ! LET style$= "medium-r-normal--" ! ELSE ! LET style$= "bold-r-normal--" ! END IF ! IF size=9 then ! LET size$= str$(10) ! ELSE ! LET size$= str$(size) ! END IF ! LET test= SetFont(font$&style$&size$&"*") ! ! IF size=9 then ! LET CharWidth= 6 ! ELSE IF size=12 then ! numeric output - axis labels ! LET CharWidth= 7 ! ELSE IF size=14 then ! rare ! LET CharWidth= 8 ! ELSE IF size=18 then ! rare ! LET CharWidth= 10 ! END IF ! END SUB ! ! SUB StringWidth(sw$,sl) ! string width in pixels ! ! LET sl= StrWidth(sw$) ! LET chars= len(sw$) ! LET sl = chars*CharWidth ! END SUB ! ! SUB SetLineWeight(wgt) ! ! CALL PenSize(wgt,wgt) ! END SUB ! ! SUB BoxDisk(Lft,Rgt,Bas,Top) ! CALL Fill_Circle(Lft,Rgt,Bas,Top) ! END SUB !END MODULE !! ------ End of TB Unix Header and Subs ------ ! ----------------------------------------------------------- ! *** SUB TrochoidCurves 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 slideclr,axisclr,axislabelclr,true,false DECLARE DEF InfoWithin,QuitWithin ! LET axisclr= drkmid ! --- help screen array --- DIM info$(1:16) MAT READ info$ DATA "Trochoid Curves" DATA "Trochoids are curves drawn by a point at a distance, b, from the center of circle of radius, a, that is rolling along a straight line. A reflector on a spoke of a bicycle wheel draws a trochoid." DATA "If b=a the trochoid is a cycloid." DATA "If b>a the trochoid is an extended, or prolate, cycloid." DATA "If br then LET txt$= "Prolate Cycloid" ELSE IF b2 then ! mouse state down? CALL CopyCoords(-999,-999,oxc,oyc) DO GET MOUSE: mx,my,ms CALL w1RollOver LOOP until ms=2 CALL w1ClearRollOver END IF ! mouse down events IF w1Within(mx,my)=true then ! drag circle in plane LET oldmx= 9999 DO GET MOUSE: mx,my,ms CALL w1MouseDrag LOOP until ms=3 ELSE IF h1Within(mx,my)=true then ! h1 radial trochoid point CALL ResetTrace IF my=clLft and mx<=clRgt and my>=clTop and my<=clBas then ! reset CALL MouseButtonUp(clLft,clRgt,clBas,clTop,ms) CALL w1ShowGridLayer CALL w1KeepGraphLayer CALL ResetVars CALL Position(theta) CALL h2Action ELSE IF cb1Within(mx,my)=true then CALL cb1MouseUp(ms) LET traceState= cb1State ELSE IF cb2Within(mx,my)=true then CALL cb2MouseUp(ms) LET velocityState= cb2State CALL w1ShowGridLayer CALL Position(theta) ELSE IF InfoWithin(mx,my,ms)=true then ! help page CALL InfoButtonUp(ms) CALL InfoPage(Info$()) CALL InitScreen ELSE IF QuitWithin(mx,my,ms)=true then ! Quit CALL QuitButtonUp(ms) EXIT SUB ELSE CALL MouseUp(mx,my,ms) END IF LOOP SUB ResetTrace CALL w1ShowGridLayer CALL w1KeepGraphLayer LET traceState,cb1State= 0 CALL cb1SetState CALL Position(0) CALL t3Set END SUB ! --- SUB w1RollOver IF w1wWithin(mx,my)=true then ! rollover in plane CALL w1PixelsToMath(mx,my,xc,yc) IF xc<>oxc or yc<>oyc then CALL SetCoords CALL CopyCoords(xc,yc,oxc,oyc) LET clearflag= 1 END IF ELSE IF clearflag=1 then CALL w1ClearRollOver END IF END SUB SUB w1ClearRollOver CALL CopyCoords(oldxc,oldyc,xc,yc) CALL SetCoords LET clearflag= 0 END SUB SUB w1MouseDrag LET mx= Clamp(mx,w1x0,w6pi) IF mx<>oldmx then LET xc = w1Fncx(mx) LET xc = min(xc,maxdist) LET theta= ang(xc,r) LET oldmx= mx CALL h2Action END IF END SUB ! --- SUB h1MouseClick CALL h1GetClickVal(ms,h1Click,b) CALL h1Action END SUB SUB h1MouseDrag DO CALL h1GetDragVal(ms,h1Places,b) CALL h1Action LOOP until ms=3 END SUB SUB h1Action ! b IF b<>oldb then CALL Position(0) CALL t3Set LET oldb= b END IF END SUB ! --- SUB h2MouseClick CALL h2GetClickVal(ms,h2Click,theta) CALL h2Action END SUB SUB h2MouseDrag DO CALL h2GetDragVal(ms,h2Places,theta) CALL h2Action LOOP until ms=3 END SUB SUB h2Action ! theta LET theta= Clamp(theta,0,maxtheta) IF theta<>oldth then CALL h2mark(theta) ! needed for adjusted theta CALL Position(theta) CALL SetCoords LET oldth= theta END IF END SUB ! --- SUB h3MouseClick CALL h3GetClickVal(ms,h3Click,r) CALL h3Action END SUB SUB h3MouseDrag DO CALL h3GetDragVal(ms,h3Places,r) CALL h3Action LOOP until ms=3 END SUB SUB h3Action ! r IF r<>oldr then LET crcTop= w1Wndy(2*r) ! circle Top CALL Position(0) CALL t3Set LET oldr= r END IF END SUB SUB h1h3Reset CALL ResetVars CALL SetMax END SUB ! --- SUB SetVars(theta) LET oldwxc= wxc LET oldwyc= wyc LET oldwxt= wxt LET oldwyt= wyt LET xt = fxt(r,b,theta) ! trochoid coords LET yt = fyt(r,b,theta) CALL w1MathToPixels(xt,yt,wxt,wyt) LET xc = dst(theta,r) CALL w1MathToPixels(xc,r,wxc,wyc) LET crcLft= round(w1Wndx(xc-r)) ! circle edges LET crcRgt= round(w1Wndx(xc+r)) END SUB SUB SetMax ! when r changes LET maxdist = sixPi*r LET maxdist = min(maxdist,sixPi) LET wmax = w1Wndx(maxdist) LET maxtheta= min(sixPi,sixPi/r) END SUB SUB ResetVars LET theta= 0 LET oldth= -99999 LET xc = 0 LET yc = r LET oldr = -9999 LET oldb = -9999 CALL h2mark(theta) END SUB SUB Position(theta) IF traceState=0 then CALL w1ShowGridLayer CALL SetVars(theta) CALL DrawCircle ELSE CALL w1ShowGraphLayer CALL SetVars(theta) LET wxt= w1Wndx(xt) LET wyt= w1Wndy(yt) SET COLOR yellow PLOT wxt,wyt CALL w1KeepGraphLayer CALL DrawCircle END IF END SUB SUB DrawCircle SET COLOR crcClr BOX CIRCLE crcLft,crcRgt,crcBas,crcTop BOX CIRCLE crcLft+1,crcRgt-1,crcBas-1,crcTop+1 CALL PlotLine(wxc,wyc, wxt,wyt, cyan) CALL PlotDiamondClr(wxt,wyt,yellow) IF velocityState=1 then LET vx = dxt(r,b,theta) LET vy = dyt(r,b,theta) SET COLOR red LET wvxt= w1Wndx(xt+vx) LET wvyt= w1Wndy(yt+vy) PLOT wxt,wyt; wvxt,wvyt END IF END SUB SUB Cycle(trace) CALL w1ShowGridLayer CALL w1KeepGraphLayer CALL SetVars(theta) CALL DrawCircle LET exit= 0 IF trace=1 then ! trace = 1 FOR wx= wxc to wmax+1 step 2 ! roll from current position LET xc= w1Fncx(wx) IF xc>maxdist then LET xc = maxdist LET exit= 1 END IF LET theta= ang(xc,r) CALL SetVars(theta) CALL w1ShowGraphLayer CALL PlotLine(oldwxc,oldwyc, wxc,wyc, litmid) CALL PlotLine(oldwxt,oldwyt, wxt,wyt, troClr) CALL w1KeepGraphLayer CALL DrawCircle CALL h2mark(theta) GET MOUSE: mx,my,ms IF ms=2 then CALL h2AnimStopButtonUp(ms) EXIT FOR END IF IF exit=1 then EXIT FOR CALL Delay(1/60) NEXT wx ELSE ! trace = 0 FOR wx= wxc to wmax+1 step 2 ! roll from current position LET xc= w1Fncx(wx) IF xc>maxdist then LET xc = maxdist LET exit= 1 END IF LET theta= ang(xc,r) CALL SetVars(theta) CALL w1ShowGraphLayer CALL DrawCircle CALL h2mark(theta) GET MOUSE: mx,my,ms IF ms=2 then CALL h2AnimStopButtonUp(ms) EXIT FOR END IF IF exit=1 then EXIT FOR CALL Delay(1/30) NEXT wx END IF CALL h2StopButtonClear END SUB END SUB ! -------- end of trochoid curves code ---------