From 3a815dbc6fc9d8c06ff04967c5585a81b30c3559 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Mon, 9 Apr 2018 13:55:45 +0900 Subject: update ketpic --- .../support/ketcindy/ketmanual/CindyJS/Cindy.js | 781 + .../support/ketcindy/ketmanual/CindyJS/CindyJS.css | 121 + .../ketcindy/ketmanual/CindyJS/ketcindylib.txt | 6419 ++++++++ .../s06animation(Scilab)/CindyScriptset.txt | 24 - .../s06animation(Scilab)/s0601cycloid.cdy | Bin 4455 -> 0 bytes .../s06animation(Scilab)/s0602diffeq.cdy | Bin 4985 -> 0 bytes .../s06animation(Scilab)/s0603envelope.cdy | Bin 4355 -> 0 bytes .../s06animation(Scilab)/s0604diffeq2.cdy | Bin 4606 -> 0 bytes .../s06animation(Scilab)/s0605cycloid2.cdy | Bin 4832 -> 0 bytes .../s06animation(Scilab)/s0606epitrochoid.cdy | Bin 4983 -> 0 bytes .../s06animation(Scilab)/s0607hypotrochoid.cdy | Bin 4991 -> 0 bytes .../s06animation(Scilab)/s0608cycloid3.cdy | Bin 4889 -> 0 bytes .../ketsample/samples/s07slides/fig/slide0.tex | 11 + .../ketsample/samples/s07slides/fig/wallpaper.tex | 12 + .../ketsample/samples/s07slides/howtouseslideE.txt | 209 +- .../ketsample/samples/s07slides/howtouseslideJ.txt | 170 +- .../ketsample/samples/s07slides/s0701basic.cdy | Bin 5455 -> 5454 bytes .../ketsample/samples/s07slides/s0701basic.txt | 4 +- .../ketsample/samples/s07slides/s0701basicE.cdy | Bin 5460 -> 5464 bytes .../ketsample/samples/s07slides/s0701basicE.txt | 3 +- .../ketsample/samples/s07slides/s0702graph.cdy | Bin 5687 -> 5695 bytes .../ketsample/samples/s07slides/s0702graph.txt | 20 - .../ketsample/samples/s07slides/s0702graphE.cdy | Bin 5460 -> 5463 bytes .../ketsample/samples/s07slides/s0702graphE.txt | 5 +- .../ketsample/samples/s07slides/s0703repeat.cdy | Bin 5631 -> 5634 bytes .../ketsample/samples/s07slides/s0703repeat.txt | 4 +- .../ketsample/samples/s07slides/s0703repeatE.cdy | Bin 5532 -> 5535 bytes .../ketsample/samples/s07slides/s0703repeatE.txt | 3 +- .../ketsample/samples/s07slides/s0704thin.cdy | Bin 4857 -> 4857 bytes .../ketsample/samples/s07slides/s0704thin.txt | 3 +- .../ketsample/samples/s07slides/s0705para.cdy | Bin 5791 -> 5782 bytes .../ketsample/samples/s07slides/s0705para.txt | 10 - .../ketsample/samples/s07slides/s0705paraE.cdy | Bin 5701 -> 5714 bytes .../ketsample/samples/s07slides/s0705paraE.txt | 3 +- .../ketsample/samples/s07slides/s0706animate.cdy | Bin 5854 -> 5856 bytes .../ketsample/samples/s07slides/s0706animate.txt | 3 +- .../ketsample/samples/s07slides/s0706animateE.cdy | Bin 5794 -> 5801 bytes .../ketsample/samples/s07slides/s0706animateE.txt | 3 +- .../ketcindy/ketsample/samples/s08R/s0801plotR.cdy | Bin 3924 -> 3926 bytes .../ketsample/samples/s08R/s0802plotR2.cdy | Bin 5237 -> 5238 bytes .../ketsample/samples/s08R/s0803boxplot.cdy | Bin 4118 -> 4120 bytes .../ketsample/samples/s08R/s0804histplot.cdy | Bin 4201 -> 4203 bytes .../ketsample/samples/s08R/s0805random.cdy | Bin 3786 -> 3804 bytes .../ketsample/samples/s08R/s0806dataframe.cdy | Bin 3912 -> 3915 bytes .../ketsample/samples/s08R/s0807timecount.cdy | Bin 3900 -> 3906 bytes .../ketcindy/ketsample/samples/s08R/s0808ttest.cdy | Bin 3893 -> 3859 bytes .../samples/s09surface(Scilab)/s0901parabolic.cdy | Bin 5250 -> 0 bytes .../samples/s09surface(Scilab)/s0902cone.cdy | Bin 5279 -> 0 bytes .../samples/s09surface(Scilab)/s0903saddle.cdy | Bin 5211 -> 0 bytes .../samples/s09surface(Scilab)/s0904sphere.cdy | Bin 5237 -> 0 bytes .../samples/s09surface(Scilab)/s0905wireframe.cdy | Bin 5264 -> 0 bytes .../s09surface(Scilab)/s0906intersectcrvsf.cdy | Bin 5325 -> 0 bytes .../s09surface(Scilab)/s0907multisurfaces.cdy | Bin 5313 -> 0 bytes .../samples/s09surface(Scilab)/s0908conecut.cdy | Bin 7551 -> 0 bytes .../samples/s09surface(Scilab)/s0909totaldiff.cdy | Bin 6128 -> 0 bytes .../samples/s09surface/s0901paraboloid.cdy | Bin 0 -> 5474 bytes .../ketsample/samples/s09surface/s0902cone.cdy | Bin 0 -> 5302 bytes .../ketsample/samples/s09surface/s0903saddle.cdy | Bin 0 -> 5204 bytes .../ketsample/samples/s09surface/s0904mant.cdy | Bin 0 -> 5246 bytes .../ketsample/samples/s09surface/s0905sphere.cdy | Bin 0 -> 5208 bytes .../samples/s09surface/s0906curveonsurf.cdy | Bin 0 -> 5299 bytes .../samples/s09surface/s0907intersectcrvsf.cdy | Bin 0 -> 5469 bytes .../samples/s09surface/s0908multisurfaces.cdy | Bin 0 -> 5256 bytes .../ketsample/samples/s09surface/s0909wiredata.cdy | Bin 0 -> 5259 bytes .../ketsample/samples/s09surface/s0910conecut.cdy | Bin 0 -> 5253 bytes .../samples/s09surface/s0921totaldiffskeleton.cdy | Bin 0 -> 6136 bytes .../samples/s09surface/s0922conecutmaxima.cdy | Bin 0 -> 7534 bytes .../ketsample/samples/s10maxima/s1010fourier3.cdy | Bin 4489 -> 4750 bytes .../s13meshlab/Meshlab(Scilab)/s1301basic.cdy | Bin 5377 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1303objparts.cdy | Bin 5558 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1304symbol.cdy | Bin 5412 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1305hyperpara.cdy | Bin 5449 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1306poly.cdy | Bin 6991 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1307poly2.cdy | Bin 8262 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1308discont.cdy | Bin 5827 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1309discont2.cdy | Bin 5990 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1310totaldiff.cdy | Bin 4645 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1311plate.cdy | Bin 6716 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1312plane.cdy | Bin 7368 -> 0 bytes .../Meshlab(Scilab)/s1313changescale.cdy | Bin 8226 -> 0 bytes .../s13meshlab/Meshlab(Scilab)/s1314knot.cdy | Bin 28351 -> 0 bytes .../ketsample/samples/s14dataprocessing/kc.sh | 0 .../ketcindy/ketsample/samples/s15C/s1501mant.cdy | Bin 5596 -> 5558 bytes .../ketcindy/ketsample/samples/s15C/s1502torus.cdy | Bin 5574 -> 5598 bytes .../ketsample/samples/s15C/s1503parabola.cdy | Bin 5734 -> 5700 bytes .../ketsample/samples/s15C/s1504conecut.cdy | Bin 5695 -> 5667 bytes .../ketsample/samples/s15C/s1505skeleton.cdy | Bin 5672 -> 5654 bytes .../ketcindy/ketsample/samplesJS/js01basic.cdy | Bin .../ketcindy/ketsample/samplesJS/js03gamow.cdy | Bin .../ketcindy/source/ketjava/KetCindyPlugin.java | 72 +- texmf-dist/scripts/ketcindy/LICENSE.txt | 14 + texmf-dist/scripts/ketcindy/dirhead.txt | 7 + .../scripts/ketcindy/ketjava/KetCindyPlugin.jar | Bin 156234 -> 156844 bytes .../scripts/ketcindy/ketlib/ketcindylib3dlogr.txt | 22 + .../scripts/ketcindy/ketlib/ketcindylib3dr.cs | 1110 +- .../ketcindy/ketlib/ketcindylibbasic1logr.txt | 18 + .../scripts/ketcindy/ketlib/ketcindylibbasic1r.cs | 481 +- .../ketcindy/ketlib/ketcindylibbasic2logr.txt | 17 + .../scripts/ketcindy/ketlib/ketcindylibbasic2r.cs | 10059 ++++++------- .../scripts/ketcindy/ketlib/ketcindylibhelpE.txt | 7 +- .../scripts/ketcindy/ketlib/ketcindylibhelpJ.txt | 5 +- .../scripts/ketcindy/ketlib/ketcindylibmvr.cs | 16 +- .../scripts/ketcindy/ketlib/ketcindyliboutlogr.txt | 21 + .../scripts/ketcindy/ketlib/ketcindyliboutr.cs | 919 +- texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3.r | 12660 ---------------- .../scripts/ketcindy/ketlib/ketpic5_2_3_rep2e.r | 580 - .../scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r | 14413 ++++++++++++++++++ .../ketcindy/ketlib/ketpicR/ketpic5_2_4_rep2e.r | 580 + texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r | 14614 +++++++++++++++++++ .../scripts/ketcindy/ketlib/ketpiccurrent_rep2e.r | 580 + texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h | 788 +- .../scripts/ketcindy/ketlibC/ketcommonhead.h | 97 + texmf-dist/scripts/ketcindy/ketlibC/surflib.h | 600 +- texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h | 37 +- texmf-dist/scripts/ketcindy/ketoutset.txt | 12 - texmf-dist/scripts/ketcindy/setketcindy.txt | 5 +- texmf-dist/scripts/ketcindy/template1basic.cdy | Bin 4197 -> 4302 bytes texmf-dist/scripts/ketcindy/template2advanced.cdy | Bin 4846 -> 5778 bytes texmf-dist/tex/latex/ketcindy/ketlayer.sty | 0 texmf-dist/tex/latex/ketcindy/ketmedia.sty | 111 +- 120 files changed, 46095 insertions(+), 19558 deletions(-) create mode 100644 texmf-dist/doc/support/ketcindy/ketmanual/CindyJS/Cindy.js create mode 100644 texmf-dist/doc/support/ketcindy/ketmanual/CindyJS/CindyJS.css create mode 100644 texmf-dist/doc/support/ketcindy/ketmanual/CindyJS/ketcindylib.txt delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/CindyScriptset.txt delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0601cycloid.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0602diffeq.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0603envelope.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0604diffeq2.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0605cycloid2.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0606epitrochoid.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0607hypotrochoid.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0608cycloid3.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/fig/slide0.tex create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/fig/wallpaper.tex delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graph.txt delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705para.txt delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0901parabolic.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0902cone.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0903saddle.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0904sphere.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0905wireframe.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0906intersectcrvsf.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0907multisurfaces.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0908conecut.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0909totaldiff.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0901paraboloid.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0902cone.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0903saddle.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0904mant.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0905sphere.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0906curveonsurf.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0907intersectcrvsf.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0908multisurfaces.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0909wiredata.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0910conecut.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0921totaldiffskeleton.cdy create mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0922conecutmaxima.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1301basic.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1303objparts.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1304symbol.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1305hyperpara.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1306poly.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1307poly2.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1308discont.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1309discont2.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1310totaldiff.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1311plate.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1312plane.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1313changescale.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1314knot.cdy delete mode 100644 texmf-dist/doc/support/ketcindy/ketsample/samples/s14dataprocessing/kc.sh mode change 100644 => 100755 texmf-dist/doc/support/ketcindy/ketsample/samplesJS/js01basic.cdy mode change 100644 => 100755 texmf-dist/doc/support/ketcindy/ketsample/samplesJS/js03gamow.cdy create mode 100644 texmf-dist/scripts/ketcindy/LICENSE.txt create mode 100644 texmf-dist/scripts/ketcindy/dirhead.txt delete mode 100644 texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3.r delete mode 100644 texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3_rep2e.r create mode 100644 texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r create mode 100644 texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4_rep2e.r create mode 100644 texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r create mode 100644 texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent_rep2e.r create mode 100644 texmf-dist/scripts/ketcindy/ketlibC/ketcommonhead.h mode change 100644 => 100755 texmf-dist/scripts/ketcindy/setketcindy.txt mode change 100644 => 100755 texmf-dist/scripts/ketcindy/template2advanced.cdy mode change 100644 => 100755 texmf-dist/tex/latex/ketcindy/ketlayer.sty diff --git a/texmf-dist/doc/support/ketcindy/ketmanual/CindyJS/Cindy.js b/texmf-dist/doc/support/ketcindy/ketmanual/CindyJS/Cindy.js new file mode 100644 index 00000000..04aa2fd9 --- /dev/null +++ b/texmf-dist/doc/support/ketcindy/ketmanual/CindyJS/Cindy.js @@ -0,0 +1,781 @@ +/* CindyJS - (C) 2014-2016 The CindyJS Project + * Mostly licensed under the Apache License 2.0, but subprojects may use different licensing. + * See https://github.com/CindyJS/CindyJS/tree/bb244cab7fdc8d4ea030751ec40c6d384c09f464 + * for corresponding sources and their respective licensing conditions. + */ +var enableInlineVideo=function(){function p(f,k,p,F){function E(p){ea=k(E,F);f(p-(K||p));K=p}var ea,K;return{start:function(){ea||E(0)},stop:function(){p(ea);ea=null;K=0}}}function E(f,k,p,F){function E(k){!!f[p]===!!F&&k.stopImmediatePropagation();delete f[p]}return f.addEventListener(k,E,!1),E}function ja(f,k,p,F){function E(f){p[k]=f}F&&E(f[k]);Object.defineProperty(f,k,{get:function(){return p[k]},set:E})}function Ca(f,k,p){p.addEventListener(k,function(){return f.dispatchEvent(new Event(k))})} +function pa(f,k){Promise.resolve().then(function(){f.dispatchEvent(new Event(k))})}function Da(f){var k=new Audio;return Ca(f,"play",k),Ca(f,"playing",k),Ca(f,"pause",k),k.crossOrigin=f.crossOrigin,k.src=f.src||f.currentSrc||"data:",k}function aa(k,p,F){(K||0)+200=this.video.HAVE_FUTURE_DATA?(this.hasAudio||(this.driver.currentTime=this.video.currentTime+f*this.video.playbackRate/1E3,this.video.loop&& +this.driver.currentTime>=this.video.duration&&(this.driver.currentTime=0)),aa(this.video,this.driver.currentTime)):this.video.networkState===this.video.NETWORK_IDLE&&0===this.video.buffered.length&&this.video.load();this.video.ended&&(delete this.video[Ea],this.video.pause(!0))}function Oa(){var f=this[W];return this.webkitDisplayingFullscreen?void this[ob]():("data:"!==f.driver.src&&f.driver.src!==this.src&&(aa(this,0,!0),f.driver.src=this.src),void(this.paused&&(f.paused=!1,0===this.buffered.length&& +this.load(),f.driver.play(),f.updater.start(),f.hasAudio||(pa(this,"play"),f.video.readyState>=f.video.HAVE_ENOUGH_DATA&&pa(this,"playing")))))}function F(f){var k=this[W];k.driver.pause();k.updater.stop();this.webkitDisplayingFullscreen&&this[sa]();k.paused&&!f||(k.paused=!0,k.hasAudio||pa(this,"pause"),this.ended&&(this[Ea]=!0,pa(this,"ended")))}function ea(F,E){var I=F[W]={};I.paused=!0;I.hasAudio=E;I.video=F;I.updater=p(k.bind(I),requestAnimationFrame,cancelAnimationFrame);E?I.driver=Da(F):(F.addEventListener("canplay", +function(){F.paused||pa(F,"playing")}),I.driver={src:F.src||F.currentSrc||"data:",muted:!0,paused:!0,pause:function(){I.driver.paused=!0},play:function(){I.driver.paused=!1;I.driver.currentTime>=I.video.duration&&aa(F,0)},get ended(){return I.driver.currentTime>=I.video.duration}});F.addEventListener("emptied",function(){var f=!I.driver.src||"data:"===I.driver.src;I.driver.src&&I.driver.src!==F.src&&(aa(F,0,!0),I.driver.src=F.src,f?I.driver.play():I.updater.stop())},!1);F.addEventListener("webkitbeginfullscreen", +function(){F.paused?E&&0===I.driver.buffered.length&&I.driver.load():(F.pause(),F[ob]())});E&&(F.addEventListener("webkitendfullscreen",function(){I.driver.currentTime=F.currentTime}),F.addEventListener("seeking",function(){0>f.indexOf(100*F.currentTime|0)&&(I.driver.currentTime=F.currentTime)}))}var K,U="object"==typeof document&&"object-fit"in document.head.style&&!matchMedia("(-webkit-video-playable-inline)").matches,W="bfred-it:iphone-inline-video",Ea="bfred-it:iphone-inline-video:event",ob="bfred-it:iphone-inline-video:nativeplay", +sa="bfred-it:iphone-inline-video:nativepause",f=[],nb=0;return function(f,k){if(void 0===k&&(k={}),!f[W])if(k.everywhere||U&&(k.iPad||k.ipad?/iPhone|iPod|iPad/:/iPhone|iPod/).test(navigator.userAgent)){!f.paused&&f.webkitDisplayingFullscreen&&f.pause();ea(f,!f.muted);var p=f[W];f[ob]=f.play;f[sa]=f.pause;f.play=Oa;f.pause=F;ja(f,"paused",p.driver);ja(f,"muted",p.driver,!0);ja(f,"playbackRate",p.driver,!0);ja(f,"ended",p.driver);ja(f,"loop",p.driver,!0);E(f,"seeking");E(f,"seeked");E(f,"timeupdate", +Ea,!1);E(f,"ended",Ea,!1);f.classList.add("IIV");f.muted&&f.autoplay&&f.play();/iPhone|iPod|iPad/.test(navigator.platform)||console.warn("iphone-inline-video is not guaranteed to work in emulated environments")}}}(); +(function(){function p(b,d,e){f.biginteger_used=1;null!=b&&("number"==typeof b&&"undefined"==typeof d?this.fromInt(b):"number"==typeof b?this.fromNumber(b,d,e):null==d&&"string"!=typeof b?this.fromString(b,256):this.fromString(b,d))}function E(){return new p(null,void 0,void 0)}function ja(b,d,e,q,f,k){for(;0<=--k;){var v=d*this[b++]+e[q]+f;f=Math.floor(v/67108864);e[q++]=v&67108863}return f}function Ca(b,d,e,q,f,k){var v=d&32767;for(d>>=15;0<=--k;){var C=this[b]&32767,p=this[b++]>>15,F=d*C+p*v,C= +v*C+((F&32767)<<15)+e[q]+(f&1073741823);f=(C>>>30)+(F>>>15)+d*p+(f>>>30);e[q++]=C&1073741823}return f}function pa(b,d,e,q,f,k){var v=d&16383;for(d>>=14;0<=--k;){var C=this[b]&16383,p=this[b++]>>14,F=d*C+p*v,C=v*C+((F&16383)<<14)+e[q]+f;f=(C>>28)+(F>>14)+d*p;e[q++]=C&268435455}return f}function Da(b,d){var e=cb[b.charCodeAt(d)];return null==e?-1:e}function aa(b){var d=E();d.fromInt(b);return d}function k(b){var d=1,e;0!=(e=b>>>16)&&(b=e,d+=16);0!=(e=b>>8)&&(b=e,d+=8);0!=(e=b>>4)&&(b=e,d+=4);0!=(e= +b>>2)&&(b=e,d+=2);0!=b>>1&&(d+=1);return d}function Oa(b){this.m=b}function F(b){this.m=b;this.mp=b.invDigit();this.mpl=this.mp&32767;this.mph=this.mp>>15;this.um=(1<=qa;++qa)cb[V++]=qa;V=97;for(qa= +10;36>qa;++qa)cb[V++]=qa;V=65;for(qa=10;36>qa;++qa)cb[V++]=qa;Oa.prototype.convert=function(b){return 0>b.s||0<=b.compareTo(this.m)?b.mod(this.m):b};Oa.prototype.revert=function(b){return b};Oa.prototype.reduce=function(b){b.divRemTo(this.m,null,b)};Oa.prototype.mulTo=function(b,d,e){b.multiplyTo(d,e);this.reduce(e)};Oa.prototype.sqrTo=function(b,d){b.squareTo(d);this.reduce(d)};F.prototype.convert=function(b){var d=E();b.abs().dlShiftTo(this.m.t,d);d.divRemTo(this.m,null,d);0>b.s&&0>15)*this.mpl&this.um)<<15)&b.DM,e=d+this.m.t;for(b[e]+=this.m.am(0,q,b,d,0,this.m.t);b[e]>=b.DV;)b[e]-=b.DV,b[++e]++}b.clamp();b.drShiftTo(this.m.t,b);0<=b.compareTo(this.m)&&b.subTo(this.m,b)};F.prototype.mulTo=function(b,d,e){b.multiplyTo(d,e);this.reduce(e)}; +F.prototype.sqrTo=function(b,d){b.squareTo(d);this.reduce(d)};p.prototype.copyTo=function(b){for(var d=this.t-1;0<=d;--d)b[d]=this[d];b.t=this.t;b.s=this.s};p.prototype.fromInt=function(b){this.t=1;this.s=0>b?-1:0;0b?this[0]=b+this.DV:this.t=0};p.prototype.fromString=function(b,d){var e;if(16==d)e=4;else if(8==d)e=3;else if(256==d)e=8;else if(2==d)e=1;else if(32==d)e=5;else if(4==d)e=2;else{this.fromRadix(b,d);return}this.s=this.t=0;for(var q=b.length,f=!1,k=0;0<=--q;){var v=8==e? +b[q]&255:Da(b,q);0>v?"-"==b.charAt(q)&&(f=!0):(f=!1,0==k?this[this.t++]=v:k+e>this.DB?(this[this.t-1]|=(v&(1<>this.DB-k):this[this.t-1]|=v<=this.DB&&(k-=this.DB))}8==e&&0!=(b[0]&128)&&(this.s=-1,0>q|v,v=(this[C]&f)<=this.t)d.t= +0;else{var q=b%this.DB,f=this.DB-q,k=(1<>q;for(var v=e+1;v>q;0>=this.DB;if(b.t>=this.DB;f+=this.s}else{for(f+=this.s;e>=this.DB;f-=b.s}d.s=0>f?-1:0;-1>f?d[e++]=this.DV+ +f:0=d.DV&&(b[e+d.t]-=d.DV,b[e+d.t+1]=1)}0=f.t)){var n=this.abs();if(n.t>this.F2:0),bb=this.FV/F,F=(1<v&&p.ZERO.subTo(e,e)}}}};p.prototype.invDigit=function(){if(1>this.t)return 0;var b=this[0];if(0==(b&1))return 0;var d=b&3,d=d*(2-(b&15)*d)&15,d=d*(2-(b&255)*d)&255,d=d*(2-((b&65535)*d&65535))&65535,d=d*(2-b*d%this.DV)% +this.DV;return 0b)return p.ONE;var e=E(),f=E(),n=d.convert(this),N=k(b)-1;for(n.copyTo(e);0<=--N;)if(d.sqrTo(e,f),0<(b&1<this.s)return"-"+this.negate().toString(b);if(16==b)b=4;else if(8==b)b=3;else if(2==b)b=1;else if(32==b)b=5;else if(4==b)b=2;else return this.toRadix(b); +var d=(1<>v)&&(f=!0,n="0123456789abcdefghijklmnopqrstuvwxyz".charAt(e));0<=k;)v>(v+=this.DB-b)):(e=this[k]>>(v-=b)&d,0>=v&&(v+=this.DB,--k)),0this.s?this.negate():this};p.prototype.compareTo= +function(b){var d=this.s-b.s;if(0!=d)return d;var e=this.t,d=e-b.t;if(0!=d)return 0>this.s?-d:d;for(;0<=--e;)if(0!=(d=this[e]-b[e]))return d;return 0};p.prototype.bitLength=function(){return 0>=this.t?0:this.DB*(this.t-1)+k(this[this.t-1]^this.s&this.DM)};p.prototype.mod=function(b){var d=E();this.abs().divRemTo(b,null,d);0>this.s&&0b||d.isEven()?new Oa(d):new F(d);return this.exp(b,e)};p.ZERO=aa(0);p.ONE= +aa(1);Ea.prototype.convert=ob;Ea.prototype.revert=ob;Ea.prototype.mulTo=function(b,d,e){b.multiplyTo(d,e)};Ea.prototype.sqrTo=function(b,d){b.squareTo(d)};sa.prototype.convert=function(b){if(0>b.s||b.t>2*this.m.t)return b.mod(this.m);if(0>b.compareTo(this.m))return b;var d=E();b.copyTo(d);this.reduce(d);return d};sa.prototype.revert=function(b){return b};sa.prototype.reduce=function(b){b.drShiftTo(this.m.t-1,this.r2);b.t>this.m.t+1&&(b.t=this.m.t+1,b.clamp());this.mu.multiplyUpperTo(this.r2,this.m.t+ +1,this.q3);for(this.m.multiplyLowerTo(this.q3,this.m.t+1,this.r2);0>b.compareTo(this.r2);)b.dAddOffset(1,this.m.t+1);for(b.subTo(this.r2,b);0<=b.compareTo(this.m);)b.subTo(this.m,b)};sa.prototype.mulTo=function(b,d,e){b.multiplyTo(d,e);this.reduce(e)};sa.prototype.sqrTo=function(b,d){b.squareTo(d);this.reduce(d)};var H=[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,233,239, +241,251,257,263,269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457,461,463,467,479,487,491,499,503,509,521,523,541,547,557,563,569,571,577,587,593,599,601,607,613,617,619,631,641,643,647,653,659,661,673,677,683,691,701,709,719,727,733,739,743,751,757,761,769,773,787,797,809,811,821,823,827,829,839,853,857,859,863,877,881,883,887,907,911,919,929,937,941,947,953,967,971,977,983,991,997],Zb=67108864/H[H.length-1];p.prototype.chunkSize= +function(b){return Math.floor(Math.LN2*this.DB/Math.log(b))};p.prototype.toRadix=function(b){null==b&&(b=10);if(0==this.signum()||2>b||36F?"-"==b.charAt(C)&&0==this.signum()&&(n=!0):(v=d*v+F,++k>=e&&(this.dMultiply(f),this.dAddOffset(v,0),v=k=0))}0b)this.fromInt(1);else for(this.fromNumber(b,e),this.testBit(b-1)||this.bitwiseTo(p.ONE.shiftLeft(b-1),K,this),this.isEven()&&this.dAddOffset(1,0);!this.isProbablePrime(d);)this.dAddOffset(2,0),this.bitLength()>b&&this.subTo(p.ONE.shiftLeft(b- +1),this);else{e=[];var f=b&7;e.length=(b>>3)+1;d.nextBytes(e);e[0]=0>=this.DB;if(b.t>=this.DB;f+=this.s}else{for(f+=this.s;e>=this.DB;f+=b.s}d.s=0>f?-1:0;0f&&(d[e++]=this.DV+f);d.t=e;d.clamp()};p.prototype.dMultiply=function(b){this[this.t]=this.am(0,b-1,this,0,0,this.t);++this.t;this.clamp()};p.prototype.dAddOffset=function(b,d){if(0!=b){for(;this.t<=d;)this[this.t++]=0;for(this[d]+= +b;this[d]>=this.DV;)this[d]-=this.DV,++d>=this.t&&(this[this.t++]=0),++this[d]}};p.prototype.multiplyLowerTo=function(b,d,e){var f=Math.min(this.t+b.t,d);e.s=0;for(e.t=f;0=b)return 0;var d=this.DV%b,e=0>this.s?b-1:0;if(0=e)return!1;var f=d.shiftRight(e);b=b+1>>1;b>H.length&&(b=H.length);for(var n=E(),k=0;kthis.s){if(1==this.t)return this[0]-this.DV;if(0==this.t)return-1}else{if(1==this.t)return this[0];if(0==this.t)return 0}return(this[1]&(1<<32-this.DB)-1)<>24};p.prototype.shortValue=function(){return 0== +this.t?this.s:this[0]<<16>>16};p.prototype.signum=function(){return 0>this.s?-1:0>=this.t||1==this.t&&0>=this[0]?0:1};p.prototype.toByteArray=function(){var b=this.t,d=[];d[0]=this.s;var e=this.DB-b*this.DB%8,f,n=0;if(0>e)!=(this.s&this.DM)>>e&&(d[n++]=f|this.s<e?(f=(this[b]&(1<>(e+=this.DB-8)):(f=this[b]>>(e-=8)&255,0>=e&&(e+=this.DB,--b)),0!=(f&128)&&(f|=-256),0==n&&(this.s&128)!=(f&128)&&++n,0this.compareTo(b)?this:b};p.prototype.max=function(b){return 0b?this.rShiftTo(-b,d):this.lShiftTo(b,d);return d};p.prototype.shiftRight=function(b){var d=E();0>b?this.lShiftTo(-b,d):this.rShiftTo(b,d);return d};p.prototype.getLowestSetBit=function(){for(var b=0;b>=16,e+=16);0==(b&255)&&(b>>=8,e+=8);0==(b&15)&&(b>>=4,e+=4);0==(b&3)&&(b>>=2,e+=2); +0==(b&1)&&++e;b=e}return d+b}return 0>this.s?this.t*this.DB:-1};p.prototype.bitCount=function(){for(var b=0,d=this.s&this.DM,e=0;e=this.t?0!=this.s:0!=(this[d]&1<=e)return n;f=18>e?1:48>e?3:144>e?4:768>e?5:6;N=8>e?new Oa(d):d.isEven()?new sa(d):new F(d);var v=[],C=3,p=f-1,bb=(1<=p?K=b[H]>>e-p&bb:(K=(b[H]&(1<>this.DB+e-p));for(C=f;0==(K&1);)K>>=1,--C;0>(e-=C)&&(e+=this.DB,--H);if(ea)v[K].copyTo(n),ea=!1;else{for(;1--e&&(e=this.DB-1,--H)}return N.revert(n)};p.prototype.modInverse=function(b){var d=b.isEven();if(this.isEven()&&d||0==b.signum())return p.ZERO;for(var e=b.clone(),f=this.clone(),n=aa(1),k=aa(0),v=aa(0),C=aa(1);0!=e.signum();){for(;e.isEven();)e.rShiftTo(1,e),d?(n.isEven()&&k.isEven()||(n.addTo(this,n),k.subTo(b,k)),n.rShiftTo(1,n)):k.isEven()||k.subTo(b,k),k.rShiftTo(1,k);for(;f.isEven();)f.rShiftTo(1,f),d?(v.isEven()&& +C.isEven()||(v.addTo(this,v),C.subTo(b,C)),v.rShiftTo(1,v)):C.isEven()||C.subTo(b,C),C.rShiftTo(1,C);0<=e.compareTo(f)?(e.subTo(f,e),d&&n.subTo(v,n),k.subTo(C,k)):(f.subTo(e,f),d&&v.subTo(n,v),C.subTo(k,C))}if(0!=f.compareTo(p.ONE))return p.ZERO;if(0<=C.compareTo(b))return C.subtract(b);if(0>C.signum())C.addTo(b,C);else return C;return 0>C.signum()?C.add(b):C};p.prototype.pow=function(b){return this.exp(b,new Ea)};p.prototype.gcd=function(b){var d=0>this.s?this.negate():this.clone();b=0>b.s?b.negate(): +b.clone();if(0>d.compareTo(b)){var e=d,d=b;b=e}var e=d.getLowestSetBit(),f=b.getLowestSetBit();if(0>f)return d;eb.compareTo(d)?!0:!1};p.op_Addition=function(b,d){return(new p(b)).add(new p(d))};p.op_Subtraction=function(b,d){return(new p(b)).subtract(new p(d))};p.Int128Mul=function(b,d){return(new p(b)).multiply(new p(d))};p.op_Division=function(b,d){return b.divide(d)};p.prototype.ToDouble=function(){return parseFloat(this.toString())};V=function(b,d){var e;if("undefined"==typeof Object.getOwnPropertyNames)for(e in d.prototype){if("undefined"==typeof b.prototype[e]||b.prototype[e]== +Object.prototype[e])b.prototype[e]=d.prototype[e]}else for(var f=Object.getOwnPropertyNames(d.prototype),n=0;nb||2147483647b?Math.ceil(b):Math.floor(b):~~b}:Jb&&"function"==typeof Number.toInteger?function(b){return Number.toInteger(b)}:xb||ab? +function(b){return parseInt(b,10)}:Y?function(b){return-2147483648>b||2147483647b?Math.ceil(b):Math.floor(b):b|0}:function(b){return 0>b?Math.ceil(b):Math.floor(b)};f.Clear=function(b){b.length=0};f.PI=3.141592653589793;f.PI2=6.283185307179586;f.IntPoint=function(){var b=arguments,d=b.length;this.Y=this.X=0;f.use_xyz?(this.Z=0,3==d?(this.X=b[0],this.Y=b[1],this.Z=b[2]):2==d?(this.X=b[0],this.Y=b[1],this.Z=0):1==d?b[0]instanceof f.DoublePoint?(b=b[0],this.X=f.Clipper.Round(b.X),this.Y=f.Clipper.Round(b.Y), +this.Z=0):(b=b[0],"undefined"==typeof b.Z&&(b.Z=0),this.X=b.X,this.Y=b.Y,this.Z=b.Z):this.Z=this.Y=this.X=0):2==d?(this.X=b[0],this.Y=b[1]):1==d?b[0]instanceof f.DoublePoint?(b=b[0],this.X=f.Clipper.Round(b.X),this.Y=f.Clipper.Round(b.Y)):(b=b[0],this.X=b.X,this.Y=b.Y):this.Y=this.X=0};f.IntPoint.op_Equality=function(b,d){return b.X==d.X&&b.Y==d.Y};f.IntPoint.op_Inequality=function(b,d){return b.X!=d.X||b.Y!=d.Y};f.use_xyz?(f.IntPoint0=function(){this.Z=this.Y=this.X=0},f.IntPoint1=function(b){this.X= +b.X;this.Y=b.Y;this.Z=b.Z},f.IntPoint1dp=function(b){this.X=f.Clipper.Round(b.X);this.Y=f.Clipper.Round(b.Y);this.Z=0},f.IntPoint2=function(b,d){this.X=b;this.Y=d;this.Z=0},f.IntPoint3=function(b,d,e){this.X=b;this.Y=d;this.Z=e}):(f.IntPoint0=function(){this.Y=this.X=0},f.IntPoint1=function(b){this.X=b.X;this.Y=b.Y},f.IntPoint1dp=function(b){this.X=f.Clipper.Round(b.X);this.Y=f.Clipper.Round(b.Y)},f.IntPoint2=function(b,d){this.X=b;this.Y=d});f.IntRect=function(){var b=arguments,d=b.length;4==d?(this.left= +b[0],this.top=b[1],this.right=b[2],this.bottom=b[3]):1==d?(this.left=b[0].left,this.top=b[0].top,this.right=b[0].right,this.bottom=b[0].bottom):this.bottom=this.right=this.top=this.left=0};f.IntRect0=function(){this.bottom=this.right=this.top=this.left=0};f.IntRect1=function(b){this.left=b.left;this.top=b.top;this.right=b.right;this.bottom=b.bottom};f.IntRect4=function(b,d,e,f){this.left=b;this.top=d;this.right=e;this.bottom=f};f.ClipType={ctIntersection:0,ctUnion:1,ctDifference:2,ctXor:3};f.PolyType= +{ptSubject:0,ptClip:1};f.PolyFillType={pftEvenOdd:0,pftNonZero:1,pftPositive:2,pftNegative:3};f.JoinType={jtSquare:0,jtRound:1,jtMiter:2};f.EndType={etOpenSquare:0,etOpenRound:1,etOpenButt:2,etClosedLine:3,etClosedPolygon:4};f.EdgeSide={esLeft:0,esRight:1};f.Direction={dRightToLeft:0,dLeftToRight:1};f.TEdge=function(){this.Bot=new f.IntPoint;this.Curr=new f.IntPoint;this.Top=new f.IntPoint;this.Delta=new f.IntPoint;this.Dx=0;this.PolyTyp=f.PolyType.ptSubject;this.Side=f.EdgeSide.esLeft;this.OutIdx= +this.WindCnt2=this.WindCnt=this.WindDelta=0;this.PrevInSEL=this.NextInSEL=this.PrevInAEL=this.NextInAEL=this.NextInLML=this.Prev=this.Next=null};f.IntersectNode=function(){this.Edge2=this.Edge1=null;this.Pt=new f.IntPoint};f.MyIntersectNodeSort=function(){};f.MyIntersectNodeSort.Compare=function(b,d){var e=d.Pt.Y-b.Pt.Y;return 0e?-1:0};f.LocalMinima=function(){this.Y=0;this.Next=this.RightBound=this.LeftBound=null};f.Scanbeam=function(){this.Y=0;this.Next=null};f.OutRec=function(){this.Idx= +0;this.IsOpen=this.IsHole=!1;this.PolyNode=this.BottomPt=this.Pts=this.FirstLeft=null};f.OutPt=function(){this.Idx=0;this.Pt=new f.IntPoint;this.Prev=this.Next=null};f.Join=function(){this.OutPt2=this.OutPt1=null;this.OffPt=new f.IntPoint};f.ClipperBase=function(){this.m_CurrentLM=this.m_MinimaList=null;this.m_edges=[];this.PreserveCollinear=this.m_HasOpenPaths=this.m_UseFullRange=!1;this.m_CurrentLM=this.m_MinimaList=null;this.m_HasOpenPaths=this.m_UseFullRange=!1};f.ClipperBase.horizontal=-9007199254740992; +f.ClipperBase.Skip=-2;f.ClipperBase.Unassigned=-1;f.ClipperBase.tolerance=1E-20;f.ClipperBase.loRange=47453132;f.ClipperBase.hiRange=0xfffffffffffff;f.ClipperBase.near_zero=function(b){return b>-f.ClipperBase.tolerance&&bd.X==b.Xd.Y==b.Yd.X==b.Xd.Y==b.Yf.ClipperBase.hiRange||b.Y>f.ClipperBase.hiRange||-b.X>f.ClipperBase.hiRange||-b.Y>f.ClipperBase.hiRange)&&f.Error("Coordinate outside allowed range in RangeTest().");else if(b.X>f.ClipperBase.loRange||b.Y>f.ClipperBase.loRange||-b.X>f.ClipperBase.loRange||-b.Y>f.ClipperBase.loRange)d.Value=!0,this.RangeTest(b,d)};f.ClipperBase.prototype.InitEdge= +function(b,d,e,q){b.Next=d;b.Prev=e;b.Curr.X=q.X;b.Curr.Y=q.Y;f.use_xyz&&(b.Curr.Z=q.Z);b.OutIdx=-1};f.ClipperBase.prototype.InitEdge2=function(b,d){b.Curr.Y>=b.Next.Curr.Y?(b.Bot.X=b.Curr.X,b.Bot.Y=b.Curr.Y,f.use_xyz&&(b.Bot.Z=b.Curr.Z),b.Top.X=b.Next.Curr.X,b.Top.Y=b.Next.Curr.Y,f.use_xyz&&(b.Top.Z=b.Next.Curr.Z)):(b.Top.X=b.Curr.X,b.Top.Y=b.Curr.Y,f.use_xyz&&(b.Top.Z=b.Curr.Z),b.Bot.X=b.Next.Curr.X,b.Bot.Y=b.Next.Curr.Y,f.use_xyz&&(b.Bot.Z=b.Next.Curr.Z));this.SetDx(b);b.PolyTyp=d};f.ClipperBase.prototype.FindNextLocMin= +function(b){for(var d;;){for(;f.IntPoint.op_Inequality(b.Bot,b.Prev.Bot)||f.IntPoint.op_Equality(b.Curr,b.Top);)b=b.Next;if(b.Dx!=f.ClipperBase.horizontal&&b.Prev.Dx!=f.ClipperBase.horizontal)break;for(;b.Prev.Dx==f.ClipperBase.horizontal;)b=b.Prev;for(d=b;b.Dx==f.ClipperBase.horizontal;)b=b.Next;if(b.Top.Y!=b.Prev.Bot.Y){d.Prev.Bot.Xq.Next.Top.X&&(q=n.Prev)}for(;b!=q;)b.NextInLML=b.Next,b.Dx==f.ClipperBase.horizontal&&b!=e&&b.Bot.X!=b.Prev.Top.X&&this.ReverseHorizontal(b),b=b.Next;b.Dx==f.ClipperBase.horizontal&&b!=e&&b.Bot.X!= +b.Prev.Top.X&&this.ReverseHorizontal(b);q=q.Next}else{for(;q.Top.Y==q.Prev.Bot.Y&&q.Prev.OutIdx!=f.ClipperBase.Skip;)q=q.Prev;if(q.Dx==f.ClipperBase.horizontal&&q.Prev.OutIdx!=f.ClipperBase.Skip){for(n=q;n.Next.Dx==f.ClipperBase.horizontal;)n=n.Next;n.Next.Top.X==q.Prev.Top.X?d||(q=n.Next):n.Next.Top.X>q.Prev.Top.X&&(q=n.Next)}for(;b!=q;)b.NextInLML=b.Prev,b.Dx==f.ClipperBase.horizontal&&b!=e&&b.Bot.X!=b.Next.Top.X&&this.ReverseHorizontal(b),b=b.Prev;b.Dx==f.ClipperBase.horizontal&&b!=e&&b.Bot.X!= +b.Next.Top.X&&this.ReverseHorizontal(b);q=q.Prev}return q};f.ClipperBase.prototype.AddPath=function(b,d,e){f.use_lines?e||d!=f.PolyType.ptClip||f.Error("AddPath: Open paths must be subject."):e||f.Error("AddPath: Open paths have been disabled.");var q=b.length-1;if(e)for(;0q||!e&&1>q)return!1;for(var n=[],k=0;k<=q;k++)n.push(new f.TEdge);var v=!0;n[1].Curr.X=b[1].X;n[1].Curr.Y=b[1].Y;f.use_xyz&&(n[1].Curr.Z= +b[1].Z);var C={Value:this.m_UseFullRange};this.RangeTest(b[0],C);this.m_UseFullRange=C.Value;C.Value=this.m_UseFullRange;this.RangeTest(b[q],C);this.m_UseFullRange=C.Value;this.InitEdge(n[0],n[1],n[q],b[0]);this.InitEdge(n[q],n[0],n[q-1],b[q]);for(k=q-1;1<=k;--k)C.Value=this.m_UseFullRange,this.RangeTest(b[k],C),this.m_UseFullRange=C.Value,this.InitEdge(n[k],n[k+1],n[k-1],b[k]);for(k=b=q=n[0];;)if(b.Curr!=b.Next.Curr||!e&&b.Next==q){if(b.Prev==b.Next)break;else if(e&&f.ClipperBase.SlopesEqual(b.Prev.Curr, +b.Curr,b.Next.Curr,this.m_UseFullRange)&&(!this.PreserveCollinear||!this.Pt2IsBetweenPt1AndPt3(b.Prev.Curr,b.Curr,b.Next.Curr))){b==q&&(q=b.Next);b=this.RemoveEdge(b);k=b=b.Prev;continue}b=b.Next;if(b==k||!e&&b.Next==q)break}else{if(b==b.Next)break;b==q&&(q=b.Next);k=b=this.RemoveEdge(b)}if(!e&&b==b.Next||e&&b.Prev==b.Next)return!1;e||(this.m_HasOpenPaths=!0,q.Prev.OutIdx=f.ClipperBase.Skip);b=q;do this.InitEdge2(b,d),b=b.Next,v&&b.Curr.Y!=q.Curr.Y&&(v=!1);while(b!=q);if(v){if(e)return!1;b.Prev.OutIdx= +f.ClipperBase.Skip;b.Prev.Bot.Xb.X==d.X +b.Y==d.Y=this.m_MinimaList.Y)b.Next=this.m_MinimaList,this.m_MinimaList=b;else{for(var d=this.m_MinimaList;null!== +d.Next&&b.Ythis.m_Scanbeam.Y){var d=new f.Scanbeam;d.Y=b;d.Next=this.m_Scanbeam;this.m_Scanbeam=d}else{for(var e=this.m_Scanbeam;null!==e.Next&&b<=e.Next.Y;)e=e.Next;b!=e.Y&&(d=new f.Scanbeam,d.Y=b,d.Next=e.Next,e.Next=d)}};f.Clipper.prototype.Execute= +function(){var b=arguments,d=b.length,e=b[1]instanceof f.PolyTree;if(4!=d||e){if(4==d&&e){var d=b[0],q=b[1],e=b[2],b=b[3];if(this.m_ExecuteLocked)return!1;this.m_ExecuteLocked=!0;this.m_SubjFillType=e;this.m_ClipFillType=b;this.m_ClipType=d;this.m_UsingPolyTree=!0;try{(n=this.ExecuteInternal())&&this.BuildResult2(q)}finally{this.DisposeAllPolyPts(),this.m_ExecuteLocked=!1}return n}if(2==d&&!e||2==d&&e)return d=b[0],q=b[1],this.Execute(d,q,f.PolyFillType.pftEvenOdd,f.PolyFillType.pftEvenOdd)}else{d= +b[0];q=b[1];e=b[2];b=b[3];if(this.m_ExecuteLocked)return!1;this.m_HasOpenPaths&&f.Error("Error: PolyTree struct is need for open path clipping.");this.m_ExecuteLocked=!0;f.Clear(q);this.m_SubjFillType=e;this.m_ClipFillType=b;this.m_ClipType=d;this.m_UsingPolyTree=!1;try{var n=this.ExecuteInternal();n&&this.BuildResult(q)}finally{this.DisposeAllPolyPts(),this.m_ExecuteLocked=!1}return n}};f.Clipper.prototype.FixHoleLinkage=function(b){if(null!==b.FirstLeft&&(b.IsHole==b.FirstLeft.IsHole||null===b.FirstLeft.Pts)){for(var d= +b.FirstLeft;null!==d&&(d.IsHole==b.IsHole||null===d.Pts);)d=d.FirstLeft;b.FirstLeft=d}};f.Clipper.prototype.ExecuteInternal=function(){try{this.Reset();if(null===this.m_CurrentLM)return!1;var b=this.PopScanbeam();do{this.InsertLocalMinimaIntoAEL(b);f.Clear(this.m_GhostJoins);this.ProcessHorizontals(!1);if(null===this.m_Scanbeam)break;var d=this.PopScanbeam();if(!this.ProcessIntersections(d))return!1;this.ProcessEdgesAtTopOfScanbeam(d);b=d}while(null!==this.m_Scanbeam||null!==this.m_CurrentLM);for(var b= +0,e=this.m_PolyOuts.length;bb.Top.Y?d.Top.Xf.Clipper.TopX(d,b.Top.Y):d.Curr.Xb.WindCnt2}case f.ClipType.ctUnion:switch(e){case f.PolyFillType.pftEvenOdd:case f.PolyFillType.pftNonZero:return 0===b.WindCnt2;case f.PolyFillType.pftPositive:return 0>=b.WindCnt2;default:return 0<=b.WindCnt2}case f.ClipType.ctDifference:if(b.PolyTyp==f.PolyType.ptSubject)switch(e){case f.PolyFillType.pftEvenOdd:case f.PolyFillType.pftNonZero:return 0===b.WindCnt2;case f.PolyFillType.pftPositive:return 0>=b.WindCnt2; +default:return 0<=b.WindCnt2}else switch(e){case f.PolyFillType.pftEvenOdd:case f.PolyFillType.pftNonZero:return 0!==b.WindCnt2;case f.PolyFillType.pftPositive:return 0b.WindCnt2}case f.ClipType.ctXor:if(0===b.WindDelta)switch(e){case f.PolyFillType.pftEvenOdd:case f.PolyFillType.pftNonZero:return 0===b.WindCnt2;case f.PolyFillType.pftPositive:return 0>=b.WindCnt2;default:return 0<=b.WindCnt2}}return!0};f.Clipper.prototype.SetWindingCount=function(b){for(var d=b.PrevInAEL;null!== +d&&(d.PolyTyp!=b.PolyTyp||0===d.WindDelta);)d=d.PrevInAEL;if(null===d)b.WindCnt=0===b.WindDelta?1:b.WindDelta,b.WindCnt2=0,d=this.m_ActiveEdges;else{if(0===b.WindDelta&&this.m_ClipType!=f.ClipType.ctUnion)b.WindCnt=1;else if(this.IsEvenOddFillType(b))if(0===b.WindDelta){for(var e=!0,q=d.PrevInAEL;null!==q;)q.PolyTyp==d.PolyTyp&&0!==q.WindDelta&&(e=!e),q=q.PrevInAEL;b.WindCnt=e?0:1}else b.WindCnt=b.WindDelta;else b.WindCnt=0>d.WindCnt*d.WindDelta?1d.WindDelta*b.WindDelta?d.WindCnt: +d.WindCnt+b.WindDelta:0===b.WindDelta?1:b.WindDelta:0===b.WindDelta?0>d.WindCnt?d.WindCnt-1:d.WindCnt+1:0>d.WindDelta*b.WindDelta?d.WindCnt:d.WindCnt+b.WindDelta;b.WindCnt2=d.WindCnt2;d=d.NextInAEL}if(this.IsEvenOddAltFillType(b))for(;d!=b;)0!==d.WindDelta&&(b.WindCnt2=0===b.WindCnt2?1:0),d=d.NextInAEL;else for(;d!=b;)b.WindCnt2+=d.WindDelta,d=d.NextInAEL};f.Clipper.prototype.AddEdgeToSEL=function(b){null===this.m_SortedEdges?(this.m_SortedEdges=b,b.PrevInSEL=null,b.NextInSEL=null):(b.NextInSEL=this.m_SortedEdges, +b.PrevInSEL=null,this.m_SortedEdges=this.m_SortedEdges.PrevInSEL=b)};f.Clipper.prototype.CopyAELToSEL=function(){var b=this.m_ActiveEdges;for(this.m_SortedEdges=b;null!==b;)b.PrevInSEL=b.PrevInAEL,b=b.NextInSEL=b.NextInAEL};f.Clipper.prototype.SwapPositionsInAEL=function(b,d){if(b.NextInAEL!=b.PrevInAEL&&d.NextInAEL!=d.PrevInAEL){if(b.NextInAEL==d){var e=d.NextInAEL;null!==e&&(e.PrevInAEL=b);var f=b.PrevInAEL;null!==f&&(f.NextInAEL=d);d.PrevInAEL=f;d.NextInAEL=b;b.PrevInAEL=d;b.NextInAEL=e}else d.NextInAEL== +b?(e=b.NextInAEL,null!==e&&(e.PrevInAEL=d),f=d.PrevInAEL,null!==f&&(f.NextInAEL=b),b.PrevInAEL=f,b.NextInAEL=d,d.PrevInAEL=b,d.NextInAEL=e):(e=b.NextInAEL,f=b.PrevInAEL,b.NextInAEL=d.NextInAEL,null!==b.NextInAEL&&(b.NextInAEL.PrevInAEL=b),b.PrevInAEL=d.PrevInAEL,null!==b.PrevInAEL&&(b.PrevInAEL.NextInAEL=b),d.NextInAEL=e,null!==d.NextInAEL&&(d.NextInAEL.PrevInAEL=d),d.PrevInAEL=f,null!==d.PrevInAEL&&(d.PrevInAEL.NextInAEL=d));null===b.PrevInAEL?this.m_ActiveEdges=b:null===d.PrevInAEL&&(this.m_ActiveEdges= +d)}};f.Clipper.prototype.SwapPositionsInSEL=function(b,d){if(null!==b.NextInSEL||null!==b.PrevInSEL)if(null!==d.NextInSEL||null!==d.PrevInSEL){if(b.NextInSEL==d){var e=d.NextInSEL;null!==e&&(e.PrevInSEL=b);var f=b.PrevInSEL;null!==f&&(f.NextInSEL=d);d.PrevInSEL=f;d.NextInSEL=b;b.PrevInSEL=d;b.NextInSEL=e}else d.NextInSEL==b?(e=b.NextInSEL,null!==e&&(e.PrevInSEL=d),f=d.PrevInSEL,null!==f&&(f.NextInSEL=b),b.PrevInSEL=f,b.NextInSEL=d,d.PrevInSEL=b,d.NextInSEL=e):(e=b.NextInSEL,f=b.PrevInSEL,b.NextInSEL= +d.NextInSEL,null!==b.NextInSEL&&(b.NextInSEL.PrevInSEL=b),b.PrevInSEL=d.PrevInSEL,null!==b.PrevInSEL&&(b.PrevInSEL.NextInSEL=b),d.NextInSEL=e,null!==d.NextInSEL&&(d.NextInSEL.PrevInSEL=d),d.PrevInSEL=f,null!==d.PrevInSEL&&(d.PrevInSEL.NextInSEL=d));null===b.PrevInSEL?this.m_SortedEdges=b:null===d.PrevInSEL&&(this.m_SortedEdges=d)}};f.Clipper.prototype.AddLocalMaxPoly=function(b,d,e){this.AddOutPt(b,e);0==d.WindDelta&&this.AddOutPt(d,e);b.OutIdx==d.OutIdx?(b.OutIdx=-1,d.OutIdx=-1):b.OutIdxd.Dx?(q=this.AddOutPt(b,e),d.OutIdx=b.OutIdx,b.Side=f.EdgeSide.esLeft,d.Side=f.EdgeSide.esRight,n=b,b=n.PrevInAEL==d?d.PrevInAEL:n.PrevInAEL):(q=this.AddOutPt(d,e),b.OutIdx=d.OutIdx,b.Side=f.EdgeSide.esRight,d.Side=f.EdgeSide.esLeft,n=d,b=n.PrevInAEL==b?b.PrevInAEL:n.PrevInAEL);null!==b&&0<=b.OutIdx&&f.Clipper.TopX(b,e.Y)==f.Clipper.TopX(n,e.Y)&&f.ClipperBase.SlopesEqual(n, +b,this.m_UseFullRange)&&0!==n.WindDelta&&0!==b.WindDelta&&(e=this.AddOutPt(b,e),this.AddJoin(q,e,n.Top));return q};f.Clipper.prototype.CreateOutRec=function(){var b=new f.OutRec;b.Idx=-1;b.IsHole=!1;b.IsOpen=!1;b.FirstLeft=null;b.Pts=null;b.BottomPt=null;b.PolyNode=null;this.m_PolyOuts.push(b);b.Idx=this.m_PolyOuts.length-1;return b};f.Clipper.prototype.AddOutPt=function(b,d){var e=b.Side==f.EdgeSide.esLeft;if(0>b.OutIdx){var q=this.CreateOutRec();q.IsOpen=0===b.WindDelta;var n=new f.OutPt;q.Pts= +n;n.Idx=q.Idx;n.Pt.X=d.X;n.Pt.Y=d.Y;f.use_xyz&&(n.Pt.Z=d.Z);n.Next=n;n.Prev=n;q.IsOpen||this.SetHoleState(b,q);b.OutIdx=q.Idx}else{var q=this.m_PolyOuts[b.OutIdx],k=q.Pts;if(e&&f.IntPoint.op_Equality(d,k.Pt))return k;if(!e&&f.IntPoint.op_Equality(d,k.Prev.Pt))return k.Prev;n=new f.OutPt;n.Idx=q.Idx;n.Pt.X=d.X;n.Pt.Y=d.Y;f.use_xyz&&(n.Pt.Z=d.Z);n.Next=k;n.Prev=k.Prev;n.Prev.Next=n;k.Prev=n;e&&(q.Pts=n)}return n};f.Clipper.prototype.SwapPoints=function(b,d){var e=new f.IntPoint(b.Value);b.Value.X=d.Value.X; +b.Value.Y=d.Value.Y;f.use_xyz&&(b.Value.Z=d.Value.Z);d.Value.X=e.X;d.Value.Y=e.Y;f.use_xyz&&(d.Value.Z=e.Z)};f.Clipper.prototype.HorzSegmentsOverlap=function(b,d,e,f){var n;b>d&&(n=b,b=d,d=n);e>f&&(n=e,e=f,f=n);return b=k&&q>=e||n>=k&&n>= +e};f.Clipper.prototype.GetBottomPt=function(b){for(var d=null,e=b.Next;e!=b;)e.Pt.Y>b.Pt.Y?(b=e,d=null):e.Pt.Y==b.Pt.Y&&e.Pt.X<=b.Pt.X&&(e.Pt.Xf.Pt.Y?b:e.Pt.Yf.Pt.X?d:e.Next==e?d:f.Next==f?b:this.FirstIsBottomPt(e,f)?b:d};f.Clipper.prototype.Param1RightOfParam2=function(b,d){do if(b=b.FirstLeft,b==d)return!0;while(null!==b);return!1};f.Clipper.prototype.GetOutRec=function(b){for(b=this.m_PolyOuts[b];b!=this.m_PolyOuts[b.Idx];)b=this.m_PolyOuts[b.Idx];return b};f.Clipper.prototype.AppendPolygon=function(b,d){var e=this.m_PolyOuts[b.OutIdx],q=this.m_PolyOuts[d.OutIdx],n;n=this.Param1RightOfParam2(e, +q)?q:this.Param1RightOfParam2(q,e)?e:this.GetLowermostRec(e,q);var k=e.Pts,v=k.Prev,C=q.Pts,p=C.Prev;b.Side==f.EdgeSide.esLeft?(d.Side==f.EdgeSide.esLeft?(this.ReversePolyPtLinks(C),C.Next=k,k.Prev=C,v.Next=p,p.Prev=v,e.Pts=p):(p.Next=k,k.Prev=p,C.Prev=v,v.Next=C,e.Pts=C),k=f.EdgeSide.esLeft):(d.Side==f.EdgeSide.esRight?(this.ReversePolyPtLinks(C),v.Next=p,p.Prev=v,C.Next=k,k.Prev=C):(v.Next=C,C.Prev=v,k.Prev=p,p.Next=k),k=f.EdgeSide.esRight);e.BottomPt=null;n==q&&(q.FirstLeft!=e&&(e.FirstLeft=q.FirstLeft), +e.IsHole=q.IsHole);q.Pts=null;q.BottomPt=null;q.FirstLeft=e;n=b.OutIdx;v=d.OutIdx;b.OutIdx=-1;d.OutIdx=-1;for(C=this.m_ActiveEdges;null!==C;){if(C.OutIdx==v){C.OutIdx=n;C.Side=k;break}C=C.NextInAEL}q.Idx=e.Idx};f.Clipper.prototype.ReversePolyPtLinks=function(b){if(null!==b){var d,e;d=b;do e=d.Next,d.Next=d.Prev,d=d.Prev=e;while(d!=b)}};f.Clipper.SwapSides=function(b,d){var e=b.Side;b.Side=d.Side;d.Side=e};f.Clipper.SwapPolyIndexes=function(b,d){var e=b.OutIdx;b.OutIdx=d.OutIdx;d.OutIdx=e};f.Clipper.prototype.IntersectEdges= +function(b,d,e){var q=0<=b.OutIdx,n=0<=d.OutIdx;f.use_xyz&&this.SetZ(e,b,d);if(!f.use_lines||0!==b.WindDelta&&0!==d.WindDelta){if(b.PolyTyp==d.PolyTyp)if(this.IsEvenOddFillType(b)){var k=b.WindCnt;b.WindCnt=d.WindCnt;d.WindCnt=k}else b.WindCnt=0===b.WindCnt+d.WindDelta?-b.WindCnt:b.WindCnt+d.WindDelta,d.WindCnt=0===d.WindCnt-b.WindDelta?-d.WindCnt:d.WindCnt-b.WindDelta;else this.IsEvenOddFillType(d)?b.WindCnt2=0===b.WindCnt2?1:0:b.WindCnt2+=d.WindDelta,this.IsEvenOddFillType(b)?d.WindCnt2=0===d.WindCnt2? +1:0:d.WindCnt2-=b.WindDelta;var v,C,p;b.PolyTyp==f.PolyType.ptSubject?(v=this.m_SubjFillType,p=this.m_ClipFillType):(v=this.m_ClipFillType,p=this.m_SubjFillType);d.PolyTyp==f.PolyType.ptSubject?(C=this.m_SubjFillType,k=this.m_ClipFillType):(C=this.m_ClipFillType,k=this.m_SubjFillType);switch(v){case f.PolyFillType.pftPositive:v=b.WindCnt;break;case f.PolyFillType.pftNegative:v=-b.WindCnt;break;default:v=Math.abs(b.WindCnt)}switch(C){case f.PolyFillType.pftPositive:C=d.WindCnt;break;case f.PolyFillType.pftNegative:C= +-d.WindCnt;break;default:C=Math.abs(d.WindCnt)}if(q&&n)0!=v&&1!=v||0!=C&&1!=C||b.PolyTyp!=d.PolyTyp&&this.m_ClipType!=f.ClipType.ctXor?this.AddLocalMaxPoly(b,d,e):(this.AddOutPt(b,e),this.AddOutPt(d,e),f.Clipper.SwapSides(b,d),f.Clipper.SwapPolyIndexes(b,d));else if(q){if(0===C||1==C)this.AddOutPt(b,e),f.Clipper.SwapSides(b,d),f.Clipper.SwapPolyIndexes(b,d)}else if(n){if(0===v||1==v)this.AddOutPt(d,e),f.Clipper.SwapSides(b,d),f.Clipper.SwapPolyIndexes(b,d)}else if(!(0!=v&&1!=v||0!=C&&1!=C)){switch(p){case f.PolyFillType.pftPositive:q= +b.WindCnt2;break;case f.PolyFillType.pftNegative:q=-b.WindCnt2;break;default:q=Math.abs(b.WindCnt2)}switch(k){case f.PolyFillType.pftPositive:n=d.WindCnt2;break;case f.PolyFillType.pftNegative:n=-d.WindCnt2;break;default:n=Math.abs(d.WindCnt2)}if(b.PolyTyp!=d.PolyTyp)this.AddLocalMinPoly(b,d,e);else if(1==v&&1==C)switch(this.m_ClipType){case f.ClipType.ctIntersection:0=q&&0>=n&&this.AddLocalMinPoly(b,d,e);break;case f.ClipType.ctDifference:(b.PolyTyp== +f.PolyType.ptClip&&0=q&&0>=n)&&this.AddLocalMinPoly(b,d,e);break;case f.ClipType.ctXor:this.AddLocalMinPoly(b,d,e)}else f.Clipper.SwapSides(b,d)}}else if(0!=b.WindDelta||0!=d.WindDelta)b.PolyTyp==d.PolyTyp&&b.WindDelta!=d.WindDelta&&this.m_ClipType==f.ClipType.ctUnion?0===b.WindDelta?n&&(this.AddOutPt(b,e),q&&(b.OutIdx=-1)):q&&(this.AddOutPt(d,e),n&&(d.OutIdx=-1)):b.PolyTyp!=d.PolyTyp&&(0!==b.WindDelta||1!=Math.abs(d.WindCnt)||this.m_ClipType==f.ClipType.ctUnion&& +0!==d.WindCnt2?0!==d.WindDelta||1!=Math.abs(b.WindCnt)||this.m_ClipType==f.ClipType.ctUnion&&0!==b.WindCnt2||(this.AddOutPt(d,e),n&&(d.OutIdx=-1)):(this.AddOutPt(b,e),q&&(b.OutIdx=-1)))};f.Clipper.prototype.DeleteFromAEL=function(b){var d=b.PrevInAEL,e=b.NextInAEL;if(null!==d||null!==e||b==this.m_ActiveEdges)null!==d?d.NextInAEL=e:this.m_ActiveEdges=e,null!==e&&(e.PrevInAEL=d),b.NextInAEL=null,b.PrevInAEL=null};f.Clipper.prototype.DeleteFromSEL=function(b){var d=b.PrevInSEL,e=b.NextInSEL;if(null!== +d||null!==e||b==this.m_SortedEdges)null!==d?d.NextInSEL=e:this.m_SortedEdges=e,null!==e&&(e.PrevInSEL=d),b.NextInSEL=null,b.PrevInSEL=null};f.Clipper.prototype.UpdateEdgeIntoAEL=function(b){null===b.NextInLML&&f.Error("UpdateEdgeIntoAEL: invalid call");var d=b.PrevInAEL,e=b.NextInAEL;b.NextInLML.OutIdx=b.OutIdx;null!==d?d.NextInAEL=b.NextInLML:this.m_ActiveEdges=b.NextInLML;null!==e&&(e.PrevInAEL=b.NextInLML);b.NextInLML.Side=b.Side;b.NextInLML.WindDelta=b.WindDelta;b.NextInLML.WindCnt=b.WindCnt; +b.NextInLML.WindCnt2=b.WindCnt2;b=b.NextInLML;b.Curr.X=b.Bot.X;b.Curr.Y=b.Bot.Y;f.use_xyz&&(b.Curr.Z=b.Bot.Z);b.PrevInAEL=d;b.NextInAEL=e;f.ClipperBase.IsHorizontal(b)||this.InsertScanbeam(b.Top.Y);return b};f.Clipper.prototype.ProcessHorizontals=function(b){for(var d=this.m_SortedEdges;null!==d;)this.DeleteFromSEL(d),this.ProcessHorizontal(d,b),d=this.m_SortedEdges};f.Clipper.prototype.GetHorzDirection=function(b,d){b.Bot.X=n){if(F==C&&p){if(0<=b.OutIdx){q=this.AddOutPt(b,b.Top);for(e=this.m_SortedEdges;null!==e;)0<=e.OutIdx&&this.HorzSegmentsOverlap(b.Bot.X,b.Top.X,e.Bot.X,e.Top.X)&&(n=this.AddOutPt(e,e.Bot),this.AddJoin(n,q,e.Top)),e=e.NextInSEL;this.AddGhostJoin(q,b.Bot);this.AddLocalMaxPoly(b,C,b.Top)}this.DeleteFromAEL(b);this.DeleteFromAEL(C);return}if(q==f.Direction.dLeftToRight){var E=new f.IntPoint(F.Curr.X,b.Curr.Y);this.IntersectEdges(b, +F,E)}else E=new f.IntPoint(F.Curr.X,b.Curr.Y),this.IntersectEdges(F,b,E);this.SwapPositionsInAEL(b,F)}else if(q==f.Direction.dLeftToRight&&F.Curr.X>=k||q==f.Direction.dRightToLeft&&F.Curr.X<=n)break;F=e}if(null!==b.NextInLML&&f.ClipperBase.IsHorizontal(b.NextInLML))b=this.UpdateEdgeIntoAEL(b),0<=b.OutIdx&&this.AddOutPt(b,b.Bot),e={Dir:q,Left:n,Right:k},this.GetHorzDirection(b,e),q=e.Dir,n=e.Left,k=e.Right;else break}null!==b.NextInLML?0<=b.OutIdx?(q=this.AddOutPt(b,b.Top),d&&this.AddGhostJoin(q,b.Bot), +b=this.UpdateEdgeIntoAEL(b),0!==b.WindDelta&&(C=b.PrevInAEL,e=b.NextInAEL,null!==C&&C.Curr.X==b.Bot.X&&C.Curr.Y==b.Bot.Y&&0!==C.WindDelta&&0<=C.OutIdx&&C.Curr.Y>C.Top.Y&&f.ClipperBase.SlopesEqual(b,C,this.m_UseFullRange)?(n=this.AddOutPt(C,b.Bot),this.AddJoin(q,n,b.Top)):null!==e&&e.Curr.X==b.Bot.X&&e.Curr.Y==b.Bot.Y&&0!==e.WindDelta&&0<=e.OutIdx&&e.Curr.Y>e.Top.Y&&f.ClipperBase.SlopesEqual(b,e,this.m_UseFullRange)&&(n=this.AddOutPt(e,b.Bot),this.AddJoin(q,n,b.Top)))):this.UpdateEdgeIntoAEL(b):(0<= +b.OutIdx&&this.AddOutPt(b,b.Top),this.DeleteFromAEL(b))};f.Clipper.prototype.GetNextInAEL=function(b,d){return d==f.Direction.dLeftToRight?b.NextInAEL:b.PrevInAEL};f.Clipper.prototype.IsMinima=function(b){return null!==b&&b.Prev.NextInLML!=b&&b.Next.NextInLML!=b};f.Clipper.prototype.IsMaxima=function(b,d){return null!==b&&b.Top.Y==d&&null===b.NextInLML};f.Clipper.prototype.IsIntermediate=function(b,d){return b.Top.Y==d&&null!==b.NextInLML};f.Clipper.prototype.GetMaximaPair=function(b){var d=null; +f.IntPoint.op_Equality(b.Next.Top,b.Top)&&null===b.Next.NextInLML?d=b.Next:f.IntPoint.op_Equality(b.Prev.Top,b.Top)&&null===b.Prev.NextInLML&&(d=b.Prev);return null===d||-2!=d.OutIdx&&(d.NextInAEL!=d.PrevInAEL||f.ClipperBase.IsHorizontal(d))?d:null};f.Clipper.prototype.ProcessIntersections=function(b){if(null==this.m_ActiveEdges)return!0;try{this.BuildIntersectList(b);if(0==this.m_IntersectList.length)return!0;if(1==this.m_IntersectList.length||this.FixupIntersectionOrder())this.ProcessIntersectList(); +else return!1}catch(d){this.m_SortedEdges=null,this.m_IntersectList.length=0,f.Error("ProcessIntersections error")}this.m_SortedEdges=null;return!0};f.Clipper.prototype.BuildIntersectList=function(b){if(null!==this.m_ActiveEdges){var d=this.m_ActiveEdges;for(this.m_SortedEdges=d;null!==d;)d.PrevInSEL=d.PrevInAEL,d.NextInSEL=d.NextInAEL,d.Curr.X=f.Clipper.TopX(d,b),d=d.NextInAEL;for(var e=!0;e&&null!==this.m_SortedEdges;){e=!1;for(d=this.m_SortedEdges;null!==d.NextInSEL;){b=d.NextInSEL;var q=new f.IntPoint; +d.Curr.X>b.Curr.X?(this.IntersectPoint(d,b,q),e=new f.IntersectNode,e.Edge1=d,e.Edge2=b,e.Pt.X=q.X,e.Pt.Y=q.Y,f.use_xyz&&(e.Pt.Z=q.Z),this.m_IntersectList.push(e),this.SwapPositionsInSEL(d,b),e=!0):d=b}if(null!==d.PrevInSEL)d.PrevInSEL.NextInSEL=null;else break}this.m_SortedEdges=null}};f.Clipper.prototype.EdgesAdjacent=function(b){return b.Edge1.NextInSEL==b.Edge2||b.Edge1.PrevInSEL==b.Edge2};f.Clipper.IntersectNodeSort=function(b,d){return d.Pt.Y-b.Pt.Y};f.Clipper.prototype.FixupIntersectionOrder= +function(){this.m_IntersectList.sort(this.m_IntersectNodeComparer);this.CopyAELToSEL();for(var b=this.m_IntersectList.length,d=0;db?Math.ceil(b-.5):Math.round(b)};Jb=function(b){return 0>b?Math.ceil(b-.5):Math.floor(b+.5)};Qa=function(b){return 0>b?-Math.round(Math.abs(b)):Math.round(b)};ab=function(b){if(0>b)return b-=.5,-2147483648>b?Math.ceil(b):b|0;b+=.5;return 2147483647d.Top.Y)return e.Y=b.Top.Y,e.X=f.Clipper.TopX(d,b.Top.Y),e.Xb.Curr.Y&&(e.Y=b.Curr.Y,e.X=Math.abs(b.Dx)>Math.abs(d.Dx)?f.Clipper.TopX(d,e.Y):f.Clipper.TopX(b,e.Y))}};f.Clipper.prototype.ProcessEdgesAtTopOfScanbeam= +function(b){for(var d=this.m_ActiveEdges;null!==d;){var e=this.IsMaxima(d,b);e&&(e=this.GetMaximaPair(d),e=null===e||!f.ClipperBase.IsHorizontal(e));if(e){var q=d.PrevInAEL;this.DoMaxima(d);d=null===q?this.m_ActiveEdges:q.NextInAEL}else{this.IsIntermediate(d,b)&&f.ClipperBase.IsHorizontal(d.NextInLML)?(d=this.UpdateEdgeIntoAEL(d),0<=d.OutIdx&&this.AddOutPt(d,d.Bot),this.AddEdgeToSEL(d)):(d.Curr.X=f.Clipper.TopX(d,b),d.Curr.Y=b);if(this.StrictlySimple&&(q=d.PrevInAEL,0<=d.OutIdx&&0!==d.WindDelta&& +null!==q&&0<=q.OutIdx&&q.Curr.X==d.Curr.X&&0!==q.WindDelta)){var n=new f.IntPoint(d.Curr);f.use_xyz&&this.SetZ(n,q,d);e=this.AddOutPt(q,n);q=this.AddOutPt(d,n);this.AddJoin(e,q,n)}d=d.NextInAEL}}this.ProcessHorizontals(!0);for(d=this.m_ActiveEdges;null!==d;)this.IsIntermediate(d,b)&&(e=null,0<=d.OutIdx&&(e=this.AddOutPt(d,d.Top)),d=this.UpdateEdgeIntoAEL(d),q=d.PrevInAEL,n=d.NextInAEL,null!==q&&q.Curr.X==d.Bot.X&&q.Curr.Y==d.Bot.Y&&null!==e&&0<=q.OutIdx&&q.Curr.Y>q.Top.Y&&f.ClipperBase.SlopesEqual(d, +q,this.m_UseFullRange)&&0!==d.WindDelta&&0!==q.WindDelta?(q=this.AddOutPt(q,d.Bot),this.AddJoin(e,q,d.Top)):null!==n&&n.Curr.X==d.Bot.X&&n.Curr.Y==d.Bot.Y&&null!==e&&0<=n.OutIdx&&n.Curr.Y>n.Top.Y&&f.ClipperBase.SlopesEqual(d,n,this.m_UseFullRange)&&0!==d.WindDelta&&0!==n.WindDelta&&(q=this.AddOutPt(n,d.Bot),this.AddJoin(e,q,d.Top))),d=d.NextInAEL};f.Clipper.prototype.DoMaxima=function(b){var d=this.GetMaximaPair(b);if(null===d)0<=b.OutIdx&&this.AddOutPt(b,b.Top),this.DeleteFromAEL(b);else{for(var e= +b.NextInAEL;null!==e&&e!=d;)this.IntersectEdges(b,e,b.Top),this.SwapPositionsInAEL(b,e),e=b.NextInAEL;-1==b.OutIdx&&-1==d.OutIdx?(this.DeleteFromAEL(b),this.DeleteFromAEL(d)):0<=b.OutIdx&&0<=d.OutIdx?(0<=b.OutIdx&&this.AddLocalMaxPoly(b,d,b.Top),this.DeleteFromAEL(b),this.DeleteFromAEL(d)):f.use_lines&&0===b.WindDelta?(0<=b.OutIdx&&(this.AddOutPt(b,b.Top),b.OutIdx=-1),this.DeleteFromAEL(b),0<=d.OutIdx&&(this.AddOutPt(d,b.Top),d.OutIdx=-1),this.DeleteFromAEL(d)):f.Error("DoMaxima error")}};f.Clipper.ReversePaths= +function(b){for(var d=0,e=b.length;dn)){for(var k=Array(n),v=0;vn||!q.IsOpen&&3>n)){this.FixHoleLinkage(q);var k=new f.PolyNode;b.m_AllPolys.push(k);q.PolyNode=k;k.m_polygon.length=n;for(var q=q.Pts.Prev,v=0;vd.Pt.X?f.Direction.dRightToLeft:f.Direction.dLeftToRight;q=e.Pt.X>q.Pt.X?f.Direction.dRightToLeft:f.Direction.dLeftToRight;if(v==q)return!1;if(v==f.Direction.dLeftToRight){for(;b.Next.Pt.X<=n.X&&b.Next.Pt.X>=b.Pt.X&&b.Next.Pt.Y==n.Y;)b=b.Next;k&&b.Pt.X!=n.X&&(b=b.Next);d=this.DupOutPt(b,!k);f.IntPoint.op_Inequality(d.Pt,n)&&(b=d,b.Pt.X=n.X,b.Pt.Y=n.Y,f.use_xyz&&(b.Pt.Z=n.Z),d=this.DupOutPt(b, +!k))}else{for(;b.Next.Pt.X>=n.X&&b.Next.Pt.X<=b.Pt.X&&b.Next.Pt.Y==n.Y;)b=b.Next;k||b.Pt.X==n.X||(b=b.Next);d=this.DupOutPt(b,k);f.IntPoint.op_Inequality(d.Pt,n)&&(b=d,b.Pt.X=n.X,b.Pt.Y=n.Y,f.use_xyz&&(b.Pt.Z=n.Z),d=this.DupOutPt(b,k))}if(q==f.Direction.dLeftToRight){for(;e.Next.Pt.X<=n.X&&e.Next.Pt.X>=e.Pt.X&&e.Next.Pt.Y==n.Y;)e=e.Next;k&&e.Pt.X!=n.X&&(e=e.Next);q=this.DupOutPt(e,!k);f.IntPoint.op_Inequality(q.Pt,n)&&(e=q,e.Pt.X=n.X,e.Pt.Y=n.Y,f.use_xyz&&(e.Pt.Z=n.Z),q=this.DupOutPt(e,!k))}else{for(;e.Next.Pt.X>= +n.X&&e.Next.Pt.X<=e.Pt.X&&e.Next.Pt.Y==n.Y;)e=e.Next;k||e.Pt.X==n.X||(e=e.Next);q=this.DupOutPt(e,k);f.IntPoint.op_Inequality(q.Pt,n)&&(e=q,e.Pt.X=n.X,e.Pt.Y=n.Y,f.use_xyz&&(e.Pt.Z=n.Z),q=this.DupOutPt(e,k))}v==f.Direction.dLeftToRight==k?(b.Prev=e,e.Next=b,d.Next=q,q.Prev=d):(b.Next=e,e.Prev=b,d.Prev=q,q.Next=d);return!0};f.Clipper.prototype.JoinPoints=function(b,d,e){var q=b.OutPt1,n;new f.OutPt;var k=b.OutPt2,v;new f.OutPt;if((v=b.OutPt1.Pt.Y==b.OffPt.Y)&&f.IntPoint.op_Equality(b.OffPt,b.OutPt1.Pt)&& +f.IntPoint.op_Equality(b.OffPt,b.OutPt2.Pt)){if(d!=e)return!1;for(n=b.OutPt1.Next;n!=q&&f.IntPoint.op_Equality(n.Pt,b.OffPt);)n=n.Next;n=n.Pt.Y>b.OffPt.Y;for(v=b.OutPt2.Next;v!=k&&f.IntPoint.op_Equality(v.Pt,b.OffPt);)v=v.Next;if(n==v.Pt.Y>b.OffPt.Y)return!1;n?(n=this.DupOutPt(q,!1),v=this.DupOutPt(k,!0),q.Prev=k,k.Next=q,n.Next=v,v.Prev=n):(n=this.DupOutPt(q,!0),v=this.DupOutPt(k,!1),q.Next=k,k.Prev=q,n.Prev=v,v.Next=n);b.OutPt1=q;b.OutPt2=n;return!0}if(v){for(n=q;q.Prev.Pt.Y==q.Pt.Y&&q.Prev!=n&& +q.Prev!=k;)q=q.Prev;for(;n.Next.Pt.Y==n.Pt.Y&&n.Next!=q&&n.Next!=k;)n=n.Next;if(n.Next==q||n.Next==k)return!1;for(v=k;k.Prev.Pt.Y==k.Pt.Y&&k.Prev!=v&&k.Prev!=n;)k=k.Prev;for(;v.Next.Pt.Y==v.Pt.Y&&v.Next!=k&&v.Next!=q;)v=v.Next;if(v.Next==k||v.Next==q)return!1;e={Left:null,Right:null};if(!this.GetOverlap(q.Pt.X,n.Pt.X,k.Pt.X,v.Pt.X,e))return!1;d=e.Left;var C=e.Right;e=new f.IntPoint;q.Pt.X>=d&&q.Pt.X<=C?(e.X=q.Pt.X,e.Y=q.Pt.Y,f.use_xyz&&(e.Z=q.Pt.Z),d=q.Pt.X>n.Pt.X):k.Pt.X>=d&&k.Pt.X<=C?(e.X=k.Pt.X, +e.Y=k.Pt.Y,f.use_xyz&&(e.Z=k.Pt.Z),d=k.Pt.X>v.Pt.X):n.Pt.X>=d&&n.Pt.X<=C?(e.X=n.Pt.X,e.Y=n.Pt.Y,f.use_xyz&&(e.Z=n.Pt.Z),d=n.Pt.X>q.Pt.X):(e.X=v.Pt.X,e.Y=v.Pt.Y,f.use_xyz&&(e.Z=v.Pt.Z),d=v.Pt.X>k.Pt.X);b.OutPt1=q;b.OutPt2=k;return this.JoinHorz(q,n,k,v,e,d)}for(n=q.Next;f.IntPoint.op_Equality(n.Pt,q.Pt)&&n!=q;)n=n.Next;if(C=n.Pt.Y>q.Pt.Y||!f.ClipperBase.SlopesEqual(q.Pt,n.Pt,b.OffPt,this.m_UseFullRange)){for(n=q.Prev;f.IntPoint.op_Equality(n.Pt,q.Pt)&&n!=q;)n=n.Prev;if(n.Pt.Y>q.Pt.Y||!f.ClipperBase.SlopesEqual(q.Pt, +n.Pt,b.OffPt,this.m_UseFullRange))return!1}for(v=k.Next;f.IntPoint.op_Equality(v.Pt,k.Pt)&&v!=k;)v=v.Next;var p=v.Pt.Y>k.Pt.Y||!f.ClipperBase.SlopesEqual(k.Pt,v.Pt,b.OffPt,this.m_UseFullRange);if(p){for(v=k.Prev;f.IntPoint.op_Equality(v.Pt,k.Pt)&&v!=k;)v=v.Prev;if(v.Pt.Y>k.Pt.Y||!f.ClipperBase.SlopesEqual(k.Pt,v.Pt,b.OffPt,this.m_UseFullRange))return!1}if(n==q||v==k||n==v||d==e&&C==p)return!1;C?(n=this.DupOutPt(q,!1),v=this.DupOutPt(k,!0),q.Prev=k,k.Next=q,n.Next=v,v.Prev=n):(n=this.DupOutPt(q,!0), +v=this.DupOutPt(k,!1),q.Next=k,k.Prev=q,n.Prev=v,v.Next=n);b.OutPt1=q;b.OutPt2=n;return!0};f.Clipper.GetBounds=function(b){for(var d=0,e=b.length;dq.right&&(q.right=b[d][k].X),b[d][k].Yq.bottom&&(q.bottom=b[d][k].Y);return q};f.Clipper.prototype.GetBounds2= +function(b){var d=b,e=new f.IntRect;e.left=b.Pt.X;e.right=b.Pt.X;e.top=b.Pt.Y;e.bottom=b.Pt.Y;for(b=b.Next;b!=d;)b.Pt.Xe.right&&(e.right=b.Pt.X),b.Pt.Ye.bottom&&(e.bottom=b.Pt.Y),b=b.Next;return e};f.Clipper.PointInPolygon=function(b,d){var e=0,f=d.length;if(3>f)return 0;for(var k=d[0],N=1;N<=f;++N){var v=N==f?d[0]:d[N];if(v.Y==b.Y&&(v.X==b.X||k.Y==b.Y&&v.X>b.X==k.X=b.X)if(v.X>b.X)e=1-e;else{var C= +(k.X-b.X)*(v.Y-b.Y)-(v.X-b.X)*(k.Y-b.Y);if(0==C)return-1;0k.Y&&(e=1-e)}else if(v.X>b.X){C=(k.X-b.X)*(v.Y-b.Y)-(v.X-b.X)*(k.Y-b.Y);if(0==C)return-1;0k.Y&&(e=1-e)}k=v}return e};f.Clipper.prototype.PointInPolygon=function(b,d){var e=0,f=d,k=b.X,N=b.Y,v=d.Pt.X,C=d.Pt.Y;do{d=d.Next;var p=d.Pt.X,F=d.Pt.Y;if(F==N&&(p==k||C==N&&p>k==v=k)if(p>k)e=1-e;else{v=(v-k)*(F-N)-(p-k)*(C-N);if(0==v)return-1;0C&&(e=1-e)}else if(p>k){v=(v-k)*(F-N)-(p-k)*(C-N);if(0== +v)return-1;0C&&(e=1-e)}v=p;C=F}while(f!=d);return e};f.Clipper.prototype.Poly2ContainsPoly1=function(b,d){var e=b;do{var f=this.PointInPolygon(e.Pt,d);if(0<=f)return 0d)return 0;for(var e=0,f=0,k=d-1;fMath.abs(b.Y-d.Y)?b.X>d.X==b.Xb.X==d.Xd.Y== +b.Yb.Y==d.Ye&&(e=0);for(var p=Array(e),n=0;nk)){var n= +new f.PolyNode;n.m_jointype=d;n.m_endtype=e;if(e==f.EndType.etClosedLine||e==f.EndType.etClosedPolygon)for(;0n.m_polygon[d].Y||b[v].Y==n.m_polygon[d].Y&&b[v].Xp)&&(this.m_polyNodes.AddChild(n),e==f.EndType.etClosedPolygon))if(0>this.m_lowest.X)this.m_lowest= +new f.IntPoint(this.m_polyNodes.ChildCount()-1,d);else if(b=this.m_polyNodes.Childs()[this.m_lowest.X].m_polygon[this.m_lowest.Y],n.m_polygon[d].Y>b.Y||n.m_polygon[d].Y==b.Y&&n.m_polygon[d].X=this.ArcTolerance?f.ClipperOffset.def_arc_tolerance:this.ArcTolerance> +Math.abs(b)*f.ClipperOffset.def_arc_tolerance?Math.abs(b)*f.ClipperOffset.def_arc_tolerance:this.ArcTolerance)/Math.abs(b));this.m_sin=Math.sin(f.ClipperOffset.two_pi/k);this.m_cos=Math.cos(f.ClipperOffset.two_pi/k);this.m_StepsPerRad=k/f.ClipperOffset.two_pi;0>b&&(this.m_sin=-this.m_sin);for(d=0;d=b&&(3>n||e.m_endtype!=f.EndType.etClosedPolygon))){this.m_destPoly= +[];if(1==n)if(e.m_jointype==f.JoinType.jtRound)for(var e=1,n=0,p=1;p<=k;p++){this.m_destPoly.push(new f.IntPoint(f.ClipperOffset.Round(this.m_srcPoly[0].X+e*b),f.ClipperOffset.Round(this.m_srcPoly[0].Y+n*b)));var v=e,e=e*this.m_cos-this.m_sin*n,n=v*this.m_sin+n*this.m_cos}else for(n=e=-1,p=0;4>p;++p)this.m_destPoly.push(new f.IntPoint(f.ClipperOffset.Round(this.m_srcPoly[0].X+e*b),f.ClipperOffset.Round(this.m_srcPoly[0].Y+n*b))),0>e?e=1:0>n?n=1:e=-1;else{for(p=this.m_normals.length=0;pMath.abs(this.m_sinA*this.m_delta)){if(0this.m_sinA&&(this.m_sinA=-1);if(0>this.m_sinA*this.m_delta)this.m_destPoly.push(new f.IntPoint(f.ClipperOffset.Round(this.m_srcPoly[b].X+this.m_normals[d].X*this.m_delta),f.ClipperOffset.Round(this.m_srcPoly[b].Y+this.m_normals[d].Y*this.m_delta))),this.m_destPoly.push(new f.IntPoint(this.m_srcPoly[b])),this.m_destPoly.push(new f.IntPoint(f.ClipperOffset.Round(this.m_srcPoly[b].X+this.m_normals[b].X* +this.m_delta),f.ClipperOffset.Round(this.m_srcPoly[b].Y+this.m_normals[b].Y*this.m_delta)));else switch(e){case f.JoinType.jtMiter:e=1+(this.m_normals[b].X*this.m_normals[d].X+this.m_normals[b].Y*this.m_normals[d].Y);e>=this.m_miterLim?this.DoMiter(b,d,e):this.DoSquare(b,d);break;case f.JoinType.jtSquare:this.DoSquare(b,d);break;case f.JoinType.jtRound:this.DoRound(b,d)}return b};f.ClipperOffset.prototype.DoSquare=function(b,d){var e=Math.tan(Math.atan2(this.m_sinA,this.m_normals[d].X*this.m_normals[b].X+ +this.m_normals[d].Y*this.m_normals[b].Y)/4);this.m_destPoly.push(new f.IntPoint(f.ClipperOffset.Round(this.m_srcPoly[b].X+this.m_delta*(this.m_normals[d].X-this.m_normals[d].Y*e)),f.ClipperOffset.Round(this.m_srcPoly[b].Y+this.m_delta*(this.m_normals[d].Y+this.m_normals[d].X*e))));this.m_destPoly.push(new f.IntPoint(f.ClipperOffset.Round(this.m_srcPoly[b].X+this.m_delta*(this.m_normals[b].X+this.m_normals[b].Y*e)),f.ClipperOffset.Round(this.m_srcPoly[b].Y+this.m_delta*(this.m_normals[b].Y-this.m_normals[b].X* +e))))};f.ClipperOffset.prototype.DoMiter=function(b,d,e){e=this.m_delta/e;this.m_destPoly.push(new f.IntPoint(f.ClipperOffset.Round(this.m_srcPoly[b].X+(this.m_normals[d].X+this.m_normals[b].X)*e),f.ClipperOffset.Round(this.m_srcPoly[b].Y+(this.m_normals[d].Y+this.m_normals[b].Y)*e)))};f.ClipperOffset.prototype.DoRound=function(b,d){for(var e=Math.max(f.Cast_Int32(f.ClipperOffset.Round(this.m_StepsPerRad*Math.abs(Math.atan2(this.m_sinA,this.m_normals[d].X*this.m_normals[b].X+this.m_normals[d].Y*this.m_normals[b].Y)))), +1),k=this.m_normals[d].X,n=this.m_normals[d].Y,p,v=0;vd)return b;e||(b=[b]);for(var k=b.length,n,p,v,F,E,H,K,I=[],ea=0;ean)v=p,I.push(v);else{v=p;F=d*d;E=p[0];for(K=H=1;Kd)return f.JS.Clone(b);b[0]instanceof Array||(b=[b]);var e,k,n,p,v,F,E,H,K,I,ea,U,W,V,Y,Ea=b.length,ja=d*d,aa=[];for(e=0;ep;p++){v=[];F=n.length;n[F-1].X!=n[0].X||n[F-1].Y!=n[0].Y?(ea=1,n.push({X:n[0].X,Y:n[0].Y}),F=n.length):ea=0;I=[];for(k=0;kH)return 0;for(d&&(b[H]=b[0], +H++);--H;)p=b[H],F=p.X,p=p.Y,v=b[H-1],E=v.X,v=v.Y,k+=f((F-E)*(F-E)+(p-v)*(p-v));d&&b.pop();return k/e};f.JS.PerimeterOfPaths=function(b,d,e){e||(e=1);for(var k=0,n=0;nja&&(ja=0);++ja;return function(){--ja;0>ja&&console.error("Wait count mismatch: "+k);if(0===ja)for(var p=0,E=Ca.length;p=ja?p.startup():!1!==k.autostart&&Ca.push(p);return p}var ja=-1,Ca=[];"undefined"===typeof document||"undefined"===typeof window||"undefined"===typeof document.addEventListener||"undefined"!== +typeof window.cindyDontWait&&!0===window.cindyDontWait||document.addEventListener("DOMContentLoaded",p("DOMContentLoaded"));var pa=null,Da=null,aa={};E.getBaseDir=function(){if(null!==pa)return pa;for(var k=document.getElementsByTagName("script"),p=0;p tag for Cindy.js");return pa=Da=!1};E.addNewScript=function(k, +p){p||console.error.bind(console);var K=E.getBaseDir();if(!1===K)return!1;var U=document.createElement("script");U.src=K+k;var K=Da.nextSibling,W=Da.parentElement;K?W.insertBefore(U,K):W.appendChild(U);return U};E.loadScript=function(k,p,K,U){if(window[k])return K(),!0;U||(U=console.error.bind(console));var W=aa[k];if(!W){W=E.addNewScript(p,U);if(!1===W)return U("Can't load additional components."),!1;aa[k]=W}W.addEventListener("load",K);W.addEventListener("error",U);return null};E._autoLoadingPlugin= +{};E.autoLoadPlugin=function(k,p,K){if(E._pluginRegistry[k])return K(),!0;var U=E._autoLoadingPlugin[k];if(!U){p||(p=k+"-plugin.js");U=E._autoLoadingPlugin[k]=[];k=E.addNewScript(p);if(!1===k)return!1;k.addEventListener("error",console.error.bind(console))}U.push(K);return null};var k={ctype:"undefined"};E.waitFor=p;E._pluginRegistry={};E.instances=[];E.registerPlugin=function(k,p,K){if(1!==k)return console.error("Plugin API version "+k+" not supported"),!1;E._pluginRegistry[p]=K;(E._autoLoadingPlugin[p]|| +[]).forEach(function(k){k()})};var Oa=0;E.dumpState=function(k){k=E.instances[k||0].saveState();console.log(JSON.stringify(k))};E.debugState=function(k){E.instances.map(function(k){var p=k.config,p=JSON.parse(JSON.stringify(p)),F=k.saveState();console.log(JSON.stringify(F));for(var E in F)p[E]=F[E];k.shutdown();return p}).forEach(function(k){E(k)})};E.newInstance=function(p){function E(){ka.width=da=ka.clientWidth;ka.height=ca=ka.clientHeight;y.setTransform(1,0,0,1,0,0);z.setMat(25,0,0,25,250.5,250.5); +if(yb)for(var a=0;a=c.HAVE_METADATA?(r.width=c.videoWidth,r.height=c.videoHeight):(r.ready=!1,c.addEventListener("loadedmetadata",function(){r.width=c.videoWidth;r.height=c.videoHeight;r.ready=!0;r.whenReady=f;d.forEach(f);e()}),r.whenReady=d.push.bind(d));else if("canvas"===b)r.width=c.width,r.height=c.height;else return console.error("Not a valid image element",b,c),k;return{ctype:"image", +value:r}}function ja(a){function h(a,c){var h=document.createElement("button"),r=document.createElement("img");h.appendChild(r);l.appendChild(h);Ab(r,a);h.addEventListener("click",c);Sa[a]=function(a){a?h.classList.add("CindyJS-active"):h.classList.remove("CindyJS-active")}}function c(a){if(k){var c=e.getBoundingClientRect();sa(g*(a.clientX-c.left-e.clientLeft+.5)/c.width+b)}}var r=document.createElement("div");r.className="CindyJS-animcontrols";ka.parentNode.appendChild(r);var b=0,d=1,g=1;a.animation&& +a.animation.speedRange&&Fa(a.animation.speedRange[0])&&Fa(a.animation.speedRange[1])&&(b=a.animation.speedRange[0],d=a.animation.speedRange[1],g=d-b);var e=document.createElement("div");e.className="CindyJS-animspeed";r.appendChild(e);var f=document.createElement("div");e.appendChild(f);H(e,"mousedown",function(a){k=!0;c(a)});H(e,"mousemove",c);H(ka.parentNode,"mouseup",function(a){k=!1},!0);var l=document.createElement("div");l.className="CindyJS-animbuttons";r.appendChild(l);h("play",I);h("pause", +Ca);h("stop",Da);Sa.stop(!0);gc=function(a){a=(a-b)/g;a=Math.max(0,Math.min(1,a));a=.1*Math.round(1E3*a);f.style.width=a+"%"};var k=!1}function sa(a){Oc=a;gc&&gc(a)}function f(a){return a()}function pa(a,h){var c=null;p.plugins&&(c=p.plugins[a]);c||(c=wa._pluginRegistry[a]);c?t.use$1([w.wrap(a)],{}):(++Pc,wa.autoLoadPlugin(a,h,function(){t.use$1([w.wrap(a)],{});V()}))}function V(){0===--Pc&&(A(S.init),(p.animation||p).autoplay&&I(),oa.canvas&&Zb(oa.canvas,p))}function Y(){null!==Bb&&(ma.set(Bb.state), +Object.keys(Bb.speeds).forEach(function(a){var h=u.csnames[a];"undefined"!==typeof h.behavior&&(a=Bb.speeds[a],h.behavior.vx=a[0],h.behavior.vy=a[1],h.behavior.vz=a[2],h.behavior.fx=0,h.behavior.fy=0,h.behavior.fz=0)}),Nd())}function I(){if(!Ya){if(Ob){var a=db.backup;a.set(ma);for(var h={},c=0;c
';document.body.appendChild(c);h=document.getElementById("cmd");r=document.getElementById("log");h.onkeydown=function(c){13===c.keyCode&&""!==h.value&&(a["in"](h.value),c= +t.parse$1([w.wrap(h.value)],[]),c=A(c),console.log(ba(c)),"undefined"!==c.ctype&&ia.out(ba(c)),h.value="",r.scrollTop=r.scrollHeight)};this.append=function(a){r.appendChild(a)};this.clear=function(){r.innerHTML=""}}function cb(a){var h=a;"string"===typeof a&&(h=document.getElementById(a));this.append=function(a){h.appendChild(a)};this.clear=function(){h.innerHTML=""}}function qa(){this.append=function(a){};this.clear=function(){}}function H(a,h,c,r){void 0===r&&(r=!1);jb.push(function(){a.removeEventListener(h, +c,r)});a.addEventListener(h,c,r)}function Zb(a,h){function c(c){var h=a.getBoundingClientRect();c=z.to(c.clientX-h.left-a.clientLeft+.5,c.clientY-h.top-a.clientTop+.5);X.prevx=X.x;X.prevy=X.y;X.x=c[0];X.y=c[1];ta[0]=X.x;ta[1]=X.y;e()}function r(a){for(var c=a.changedTouches,h=!1,r=0;r +c[0]&&(c=[k.value.real,f]),m.value.realr[0]&&(r=[m.value.real,f])))}c[0]-b[0]>r[0]-d[0]?(b=b[1],c=c[1]):(b=d[1],c=r[1]);if(b!==c){t.draw$2([b,c],{dashtype:h.dashtype,size:h.size,color:h.color,alpha:h.alpha,overhang:h.overhang});break a}}t.draw$1([h.homog],{dashtype:h.dashtype,size:h.size,color:h.color,alpha:h.alpha})}for(a=0;a"+ba(a.value):"shape"===a.ctype?a.type:"error"===a.ctype?"Error: "+a.message:"variable"===a.ctype?ba(J.getvar(a.name)):"geo"===a.ctype?a.value.name: +"image"===a.ctype?"IMAGE":"_?_"}function bb(a,h){var c="undefined"===a[0].ctype,r="undefined"===a[1].ctype,b=A(a[1]);if(c||r)return k;"variable"===a[0].ctype?J.setvar(a[0].name,b):"infix"===a[0].ctype?"_"===a[0].oper?D.assigntake(a[0],b):console.error("Can't use infix expression as lvalue"):"field"===a[0].ctype?D.assigndot(a[0],b):"function"===a[0].ctype&&"genList"===a[0].oper?"list"===b.ctype?D.assignlist(a[0].args,b.value):console.error("Expected list in rhs of assignment"):console.error("Left hand side of assignment is not a recognized lvalue"); +return b}function pb(a,h){var c=A(a[0]),r=A(a[1]);if(c.ctype===r.ctype){if("number"===c.ctype)return w.bool(c.value.real===r.value.real&&c.value.imag===r.value.imag);if("string"===c.ctype||"boolean"===c.ctype)return w.bool(c.value===r.value);if("list"===c.ctype)return g.equals(c,r);if("geo"===c.ctype)return w.bool(c.value===r.value)}return{ctype:"boolean",value:!1}}function Gc(a,h){return w.not(pb(a,h))}function Yb(a,h){var c=B(a[0]),r=B(a[1]);return"number"===c.ctype&&"number"===r.ctype?{ctype:"boolean", +value:l._helper.isAlmostEqual(c,r)}:"string"===c.ctype&&"string"===r.ctype||"boolean"===c.ctype&&"boolean"===r.ctype?{ctype:"boolean",value:c.value===r.value}:"list"===c.ctype&&"list"===r.ctype?g.almostequals(c,r):{ctype:"boolean",value:!1}}function Hc(a,h){var c=B(a[0]),r=B(a[1]);return"boolean"===c.ctype&&"boolean"===r.ctype?{ctype:"boolean",value:c.value&&r.value}:k}function Ic(a,h){var c=B(a[0]),r=B(a[1]);return"boolean"===c.ctype&&"boolean"===r.ctype?{ctype:"boolean",value:c.value||r.value}: +k}function Jc(a,h){var c=a[0];"void"!==c.ctype&&(c=B(c));var r=B(a[1]),b=w.add(c,r);"Angle"===c.usage&&"Angle"===r.usage&&(b=w.withUsage(b,"Angle"));return b}function $b(a,h){var c=a[0];"void"!==c.ctype&&(c=B(c));var r=B(a[1]),b=w.sub(c,r);"Angle"===c.usage&&"Angle"===r.usage&&(b=w.withUsage(b,"Angle"));return b}function Kc(a,h){var c=B(a[0]),r=B(a[1]),b=w.mult(c,r);"Angle"!==c.usage||r.usage?"Angle"!==r.usage||c.usage||(b=w.withUsage(b,"Angle")):b=w.withUsage(b,"Angle");return b}function Lc(a,h){var c= +B(a[0]),r=B(a[1]);"number"===r.ctype&&l._helper.isZero(r)&&ia.err("WARNING: Division by zero!");var b=w.div(c,r);"Angle"!==c.usage||r.usage?"Angle"!==r.usage||c.usage||(b=w.withUsage(b,"Angle")):b=w.withUsage(b,"Angle");return b}function Mc(a,h){var c=B(a[0]),r=B(a[1]);return"number"===c.ctype&&"number"===r.ctype?l.pow(c,r):k}function Sc(a,h){var c=M(a[0]),r=M(a[1]);if(c!==k&&r!==k){var b=g.cross(c,r);"Point"===c.usage&&"Point"===r.usage&&(b=w.withUsage(b,"Line"));"Line"===c.usage&&"Line"===r.usage&& +(b=w.withUsage(b,"Point"));return b}return k}function nc(a){var h=a.length;if(0===h)return[];if(1===h)return[0];if(2===h)return a[0][0]+a[1][1]<=a[0][1]+a[1][0]?[0,1]:[1,0];if(4a[g][e]&&(f[g].cost=a[g][e]);for(;;){for(g=0;gk[g][e]&&(m=k[g][e]);for(g=0;gr&&(r=c.value.length+r+1);if(0h.left&&(e=h.left); +fh.top&&(l=h.top);k"===f.oper){var l=f.args[0];if("variable"!==l.ctype)throw ha("Modifier name must be an identifier",f.start);g[l.name]=f.args[1]}else r.push(f)}d.oper=d.name.toLowerCase()+"$"+ +d.args.length}else if("||"===g)if(1===b.length)c.push({ctype:"function",oper:"abs_infix",args:b,modifs:{}});else if(2===b.length)c.push({ctype:"function",oper:"dist_infix",args:b,modifs:{}});else throw ha("Don't support |\u2026| with "+b.length+" arguments",r.start);else{if("{}"===g)throw ha("{\u2026} reserved for future use",r.start);"[]"!==g&&1===b.length?c.push({ctype:"paren",args:b}):0===b.length?c.push({ctype:"list",value:[]}):c.push({ctype:"function",oper:"genList",args:b,modifs:{}})}break; +case "EOF":break a}for(c.length&1||c.push(null);3<=c.length;)Qb(c);return{expr:c[0],closedBy:r}}function Eb(a){this.usedFunctions={};this.usedVariables={}}function A(a){if(void 0===a)return k;if("infix"===a.ctype)return a.impl(a.args,{},a);if("variable"===a.ctype)return A(J.getvar(a.name));if("function"===a.ctype)return D.evaluate(a.oper,a.args,a.modifs);if("void"===a.ctype)return k;if("field"===a.ctype){var h=A(a.obj);return"geo"===h.ctype?ya.getField(h.value,a.key):"list"===h.ctype?g.getField(h, +a.key):k}return a}function B(a){a=A(a);if("geo"===a.ctype){var h=a.value;if("P"===h.kind)return ya.getField(h,"xy");if("V"===h.kind)return h.value}return a}function M(a){a=A(a);if("geo"===a.ctype){var h=a.value;if("P"===h.kind||"L"===h.kind)return ya.getField(h,"homog")}return g._helper.isNumberVecN(a,3)?a:g._helper.isNumberVecN(a,2)?(h=g.turnIntoCSList([a.value[0],a.value[1],l.real(1)]),a.usage&&(h=w.withUsage(h,a.usage)),h):k}function Ra(a){var h=new Eb;h.usedFunctions=Nc;h.infixmap=R;a=h.parse(a); +for(var c in h.usedVariables)J.create(c);return a}function dd(){this._path=[];this._defs=[""];this._imgcache=[];this._body=[];this._saveStack=[""];this._clipIndex=0;this._stroke=this._fill="#000";this._strokeOpacity=this._fillOpacity=null;this.height=this.width=0;this.lineWidth=1;this.lineCap="butt";this.lineJoin="miter";this.miterLimit=10;this.globalAlpha=1}function ed(){this._body=[];this._yPos=this._xPos=NaN;this._extGState={Af255:"<< /ca 1 >>",As255:"<< /CA 1 >>"};this._objects=[["%PDF-1.4\n"]]; +this._offset=this._objects[0][0].length;this._nextIndex=5;this._imgcache=[];this._xobjects={};this._pathUsed=-1;this._fillAlpha=this._strokeAlpha=this._globalAlpha=1;this.height=this.width=0;this.lineWidth=1;this.lineCap="butt";this.lineJoin="miter";this.miterLimit=10}function fd(a,h){var c=a.width,r=a.height,b=document.createElement("canvas");b.setAttribute("width",c);b.setAttribute("height",r);b.setAttribute("style","display:none;");var d=oa.canvas;d.parentNode.insertBefore(b,d.nextSibling);try{return b.getContext("2d").drawImage(a, +0,0,c,r),b.toDataURL(h||"image/png")}finally{b.parentNode.removeChild(b)}}function Wd(a){a=a.replace(RegExp("[^ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/]+","g"),"");var h=new Uint8Array(3*a.length>>2),c,r,b,d,g,e;for(r=c=0;c+3>4,h[r++]=d<<4|g>>2,h[r++]=g<<6|e;switch(a.length-c){case 0:break;case 2:b="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".indexOf(a.charAt(c));d="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".indexOf(a.charAt(c+1));h[r++]=b<<2|d>>4;break;case 3:b="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".indexOf(a.charAt(c));d="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".indexOf(a.charAt(c+ +1));g="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/".indexOf(a.charAt(c+2));h[r++]=b<<2|d>>4;h[r++]=d<<4|g>>2;break;default:throw Error("Malformed Base64 input: "+(a.length-c)+" chars left: "+a.substr(c));}if(r!==h.length)throw Error("Failed assertion: "+r+" should be "+h.length);return h}function Xd(a){function h(c){return(a[c]<<24|a[c+1]<<16|a[c+2]<<8|a[c+3])>>>0}if(57>a.length)throw Error("Too short to be a PNG file");if(2303741511!==h(0)||218765834!==h(4))throw Error("PNG signature missing"); +for(var c=[],r=8;ra.length)throw Error("Incomplete chunk at offset 0x"+r.toString(16));var b=h(r);if(2147483648<=b)throw Error("Chunk too long");var d=r+12+b;if(d>a.length)throw Error("Incomplete chunk at offset 0x"+r.toString(16));var g=a.subarray(r+4,r+8),g=String.fromCharCode.apply(String,g);c.push({len:b,type:g,data:a.subarray(r+8,r+8+b),crc:h(r+8+b)});r=d}return c}function Rb(a,h){var c;if(c=/^rgba\(([0-9]+), *([0-9]+), *([0-9]+), *([0-9]+)\)$/.exec(a))h(+c[1],+c[2],+c[3], ++c[4]);else if(c=/^rgb\(([0-9]+), *([0-9]+), *([0-9]+)\)$/.exec(a))h(+c[1],+c[2],+c[3],1);else throw Error("Can't handle color style "+a);}function Yd(a){var h=1;Object.keys(Xa).forEach(function(c){var r=Xa[c].value.img;if(void 0===r.cachedDataURL&&r.src)if("data:"===r.src.substr(0,5))r.cachedDataURL=r.src;else{++h;r.cachedDataURL=null;var b=new XMLHttpRequest;b.responseType="blob";b.onreadystatechange=function(){if(b.readyState===XMLHttpRequest.DONE)if(200===b.status){var c=new FileReader;c.onloadend= +function(){r.cachedDataURL=c.result;console.log("Cached data for image "+r.src);0===--h&&a()};c.readAsDataURL(b.response)}else console.error("Failed to load "+r.src+": "+b.statusText),0===--h&&a()};b.open("GET",r.src,!0);b.send()}});0===--h&&a()}function lb(a,h,c){for(c||(c="0");a.length20/m&&(k=1E4)}else if("C"===d.kind)f=u.csnames[d.args[0]],k=0,"undefined"!==typeof d.radius&&(k=d.radius.value.real),e=l.div(f.homog.value[0], +f.homog.value[2]).value.real,f=l.div(f.homog.value[1],f.homog.value[2]).value.real,e-=a.x,f-=a.y,k=Math.sqrt(e*e+f*f)-k,f=e=0,0>k&&(k=-k),k+=30/m;else if("L"===d.kind||"S"===d.kind)e=d.homog,k=l,f=k.add(k.mult(e.value[0],k.conjugate(e.value[0])),k.mult(e.value[1],k.conjugate(e.value[1]))),f=g.scaldiv(k.sqrt(f),e),k=f.value[0].value.real*a.x+f.value[1].value.real*a.y+f.value[2].value.real,e=f.value[0].value.real*k,f=f.value[1].value.real*k,0>k&&(k=-k),k+=1;kMath.abs(a.offset.x)&&.5>Math.abs(a.offset.y)&&!a.mover.tmp}function jd(a){return rc(a)&&"P"===a.mover.kind}function kd(a){return rc(a)&&("L"===a.mover.kind||"S"===a.mover.kind)}function sc(a){fa={mover:a,offset:{x:0,y:0},prev:{x:X.x,y:X.y}}}function mb(){var a=Gb(X);jd(a)?ua[Ua]=a.mover: +(ua[Ua]={type:"Free",name:Ta(),labeled:!0,pos:[ta[0],ta[1],1]},Ha(ua[Ua]));Ua++}function ld(){var a=Gb(X);return kd(a)?(ua[Ua]=a.mover,Ua++,!0):!1}function md(){var a=Gb(X),h;(h=kd(a))||(h=rc(a)&&"C"===a.mover.kind);return h?(ua[Ua]=a.mover,Ua++,!0):!1}function tb(){var a=Gb(X);if(jd(a))for(Hb.args[1]=a.mover.name,a=0;ad*d):!1}function uc(a,h){a.isshowing=!0;if(a.args)for(var c=0;c1E12*h(za[c+1])&&(za[c+1]=0)}function Vb(){if(vb)Ja=!0;else throw wd;}function xd(a,h, +c,r,b){return w.add(r,w.mult(c,w.sub(b,r)))}function Qd(){L&&(L.currentMouseAndScripts=[]);wc=!0;if(fa){var a=fa.mover,h=g.realVector([X.x+fa.offset.x,X.y+fa.offset.y,1]);yd(a,h,"mouse");fa.prev.x=X.x;fa.prev.y=X.y}A(S.move);A(S.draw);Ja||ub();wc=!1;L&&(L.fullLog.push(g.turnIntoCSList([g.turnIntoCSList(L.currentMouseAndScripts)])),L.length>L.logLength&&L.splice(0,L.length-L.logLength),L.currentMouseAndScripts=null,L.postMouseHooks.forEach(function(a){a()}))}function Ia(a,h,c){yd(a,h,c);wc||Ja||ub()} +function yd(a,h,c){L&&L.currentMouseAndScripts&&(L.currentMover=[]);a===zd?(ma.set(za),Ja=!1):(zd=a,ub());Ma.set(ma);var r=1E4,b;b=Ub[a.name];if(!b){var d={},e=0;b=[];d[a.name]=a;for(var f=u.gslp,k=0;kp?(q=[h,a],n=p):q=[a,h];p=function(){};if(L&&L.currentStep){var t=[L.labelTracing2,w.wrap(L.currentElement.name),g.turnIntoCSList(q),g.turnIntoCSList([c,r]),g.realMatrix([[b,d],[e,f]]),w.wrap(n),w.wrap(l),w.wrap(m),k];L.currentStep.push(g.turnIntoCSList(t)); +p=function(a){L.hasOwnProperty(a)||(L[a]=w.wrap(a));t[t.length-1]=L[a]}}g._helper.isNaN(a)||g._helper.isNaN(h)?(p("Tracing failed due to NaNs."),Ja=!0):l>3*n&&m>3*n?p("Normal case, everything all right."):1E-5>m?1E-5>l?p("Staying inside singularity."):(p("Moved into singularity."),Ja=!0):1E-5>l?p("Moved out of singularity."):(vb?p("Reached refinement limit, giving up."):p("Need to refine."),Vb());return q}function xc(a,h,c,r){var b=Z(3),d=Z(3),e=Z(3),f=Z(3);a=he(a,h,c,r,b,d,e,f);T(a[0]);T(a[1]);T(a[2]); +T(a[3]);return g.turnIntoCSList(a)}function he(a,h,c,r,b,d,e,f){var l=function(){};b=[b,d,e,f];a=[a,h,c,r];if(fb)return a;d=0;r=Array(4);for(c=0;4>c;c++)for(r[c]=Array(4),f=0;4>f;f++)e=g.projectiveDistMinScal(b[c],a[f]),r[c][f]=e;e=nc(r);h=Array(4);for(c=0;4>c;++c)h[c]=a[e[c]],d+=r[c][e[c]];var m=1*d,n=Infinity,p=Infinity;for(c=0;4>c;c++){if(g._helper.isNaN(a[c]))return l("Tracing failed due to NaNs."),Ja=!0,h;for(f=c+1;4>f;f++)e=g.projectiveDistMinScal(b[c],b[f]),n>e&&(n=e),e=g.projectiveDistMinScal(h[c], +h[f]),p>e&&(p=e)}if(L&&L.currentStep){var q=[L.labelTracing4,w.wrap(L.currentElement.name),g.turnIntoCSList(h),g.turnIntoCSList(b),g.realMatrix(r),w.wrap(d),w.wrap(n),w.wrap(p),k];L.currentStep.push(g.turnIntoCSList(q));l=function(a){L.hasOwnProperty(a)||(L[a]=w.wrap(a));q[q.length-1]=L[a]}}n>m&&p>m||(1E-5>p?1E-5>n?l("Staying inside singularity."):(l("Moved into singularity."),Ja=!0):1E-5>n?l("Moved out of singularity."):(vb?l("Reached refinement limit, giving up."):l("Need to refine."),Vb()));return h} +function Bd(a){var h=a.length,c,r;if(fb){for(c=0;c1-n&&(f=1-n),n=g.sesquilinearproduct(a[c],a[r]).value,n=(n.real*n.real+n.imag*n.imag)/(e[c]*e[r]),l>1-n&&(l=1-n)}n=nc(m);r=Array(h);d=0;e=!1;for(c=0;c3*d&&l>3*d?a("Normal case, everything all right."):1E-5>l?1E-5>f?a("Staying inside singularity."):(a("Moved into singularity."),Ja=!0):1E-5>f?a("Moved out of singularity."):(vb?a("Reached refinement limit, giving up."):a("Need to refine."),Vb());return r}function gb(a){if(gb.hasOwnProperty(a.kind))gb[a.kind](a)}function Cd(a,h){return function(){a.incidences.push(h.name);h.incidences.push(a.name)}}function Dd(a,h){return{toString:function(){return"point "+ +a.name+" incident line "+h.name},apply:Cd(a,h),holds:function(){var c=g.scaldiv(g.abs(a.homog),a.homog),r=g.scaldiv(g.abs(h.homog),h.homog);return 1E-13>l.abs(g.scalproduct(c,r)).value.real}}}function Ed(a,h){return{toString:function(){return"point "+a.name+" incident conic "+h.name},apply:Cd(a,h),holds:function(){var c=w.mult(h.matrix,a.homog),c=w.mult(a.homog,c),c=l.abs(c);1E-13>c.value.real&&(a.incidences.push(h.name),h.incidences.push(a.name))}}}function pd(){if(0!==ib.length){for(var a=0;aa&&(r+=2*Math.PI);0===a&&0>h&&(r=Math.PI);r>Math.PI&&(r-=2*Math.PI);return l.snap({ctype:"number",value:{real:Math.log(c),imag:r}})};l.pow= +function(a,h){return l._helper.isZero(h)?l.one:l._helper.isZero(a)?l.zero:l._helper.isReal(h)?l.powRealExponent(a,h.value.real):l.exp(l.mult(l.log(a),h))};l.mod=function(a,h){var c=a.value.real,r=h.value.real,b=a.value.imag,d=h.value.imag,c=c-Math.floor(c/r)*r,b=b-Math.floor(b/d)*d;0===r&&(c=0);0===d&&(b=0);return l.snap({ctype:"number",value:{real:c,imag:b}})};l._helper.seed="NO";l._helper.seedrandom=function(a){a-=Math.floor(a);l._helper.seed=.8*a+.1};l._helper.rand=function(){if("NO"===l._helper.seed)return Math.random(); +var a=l._helper.seed,a=1E3*Math.sin(1E3*a),a=a-Math.floor(a);return l._helper.seed=a};l._helper.randnormal=function(){var a=l._helper.rand(),h=l._helper.rand();return Math.sqrt(-2*Math.log(a))*Math.cos(2*Math.PI*h)};l._helper.isEqual=function(a,h){return a.value.real===h.value.real&&a.value.imag===h.value.imag};l._helper.isLessThan=function(a,h){return a.value.real-r&&a-r};l._helper.isZero=function(a){return 0===a.value.real&&0===a.value.imag};l._helper.isAlmostZero=function(a){var h=a.value.real;a=a.value.imag;return h-l.eps&&a-l.eps};l._helper.isReal=function(a){return 0===a.value.imag};l._helper.isAlmostReal=function(a){a=a.value.imag;return a-l.epsbig};l._helper.isNaN=function(a){return isNaN(a.value.real)||isNaN(a.value.imag)};l._helper.isFinite=function(a){return isFinite(a.value.real)&&isFinite(a.value.imag)};l._helper.isAlmostImag=function(a){a=a.value.real;return a-l.epsbig};l._helper.z3a=l.complex(-.5,.5*Math.sqrt(3));l._helper.z3b=l.complex(-.5,-.5*Math.sqrt(3));l._helper.cub1={ctype:"list",value:[l.one,l.one,l.one]};l._helper.cub2={ctype:"list",value:[l._helper.z3a,l.one,l._helper.z3b]};l._helper.cub3={ctype:"list", +value:[l._helper.z3b,l.one,l._helper.z3a]};l.solveCubic=function(a,h,c,r){a=l._helper.solveCubicHelper(a,h,c,r);return[g.scalproduct(l._helper.cub1,a),g.scalproduct(l._helper.cub2,a),g.scalproduct(l._helper.cub3,a)]};l._helper.solveCubicHelper=function(a,h,c,r){var b=a.value.real;a=a.value.imag;var d=h.value.real;h=h.value.imag;var e=c.value.real,f=c.value.imag,k=r.value.real,m=r.value.imag,n=b*e-a*f;c=b*f+a*e;r=4*n-(d*d-h*h);var p=4*c-2*d*h,q=b*d-a*h,t=b*h+a*d,v=r*e-p*f-18*(q*k-t*m),p=r*f+p*e-18* +(q*m+t*k);r=27*(b*b-a*a);var u=54*a*b,w=r*k-u*m,x=r*m+u*k,z=d*d-h*h,y=2*d*h,A=z*d-y*h,B=z*h+y*d,C=w+4*A,u=x+4*B;r=27*(v*e-p*f+C*k-u*m);p=27*(v*f+p*e+C*m+u*k);C=Math.sqrt(Math.sqrt(r*r+p*p));u=Math.atan2(p,r);p=C*Math.sin(u/2);r=C*Math.cos(u/2);A=-2*A+9*(q*e-t*f)-w+(r*b-p*a);B=-2*B+9*(q*f+t*e)-x+(r*a+p*b);r=Math.exp(Math.log(Math.sqrt(A*A+B*B))/3);e=Math.atan2(B,A);u=r*Math.sin(e/3);p=r*Math.cos(e/3);r*=r;e*=2;n=2*z-6*n;c=2*y-6*c;y=-1.5874010519681996*(d*p-h*u);d=-1.5874010519681996*(d*u+h*p);h=1.2599210498948732* +r*Math.cos(e/3);e=1.2599210498948732*r*Math.sin(e/3);r=4.762203155904599*(p*b-u*a);p=4.762203155904599*(p*a+u*b);b=r*r+p*p;u=(-n*p+c*r)/b;n=(n*r+c*p)/b;c=u;u=(-y*p+d*r)/b;y=(y*r+d*p)/b;d=u;u=(-h*p+e*r)/b;h=(h*r+e*p)/b;e=u;return g.turnIntoCSList([l.complex(n,c),l.complex(y,d),l.complex(h,e)])};var g={_helper:{},turnIntoCSList:function(a){return{ctype:"list",value:a}}};g.EMPTY=g.turnIntoCSList([]);g.asList=function(a){return"list"===a.ctype?a:"number"===a.ctype||"boolean"===a.ctype||"geo"===a.ctype? +g.turnIntoCSList([a]):g.EMPTY};g.realVector=function(a){for(var h=[],c=0;c=c||b>=r)&&w.isEqual(a.value[b],h.value[b]);)b++;return b===c&&bb&&(c=r,b=d)}return c};g.normalizeMax=function(a){var h=l.inv(g.maxval(a));return l._helper.isFinite(h)?g.scalmult(h,a):a};g.normalizeZ=function(a){var h=l.inv(a.value[2]);return g.scalmult(h,a)};g.dehom=function(a){a=a.value.slice();var h=a.length-1,c=l.inv(a[h]);a.length=h;for(var r=0;rh&&(c=a.value[r],h=b.value.real)}return g.scaldiv(c,a)};g.recursive=function(a,h){for(var c=[],r=0;rg.abs(m).value.real&&0===p&&(m=g._helper.inverseIteration(a, +b.value[c])),f.value[c]=g._helper.isAlmostZeroVec(m)?m:g.scaldiv(g.abs(m),m),cl.abs(l.sub(b.value[c],b.value[c+1])).value.real)?p++:p=0);f=g.transpose(f)}return g.turnIntoCSList([b,f])};g._helper.isNormalMatrix=function(a){return 1E-10>g.abs(g.sub(a,g.transjugate(a))).value.real};g._helper.QRIteration=function(a,h){var c,b=a;c=l.real(b.value.length);var d=c.value.real,e=c.value.real;l.real(0);var f;g.idMatrix(c,c);var k=g.zeromatrix(c,c),m=g.idMatrix(c,c),n=h?h:2500,p,q,t,u=0,v=Array(e); +for(c=0;cl.abs2(b.value[b.value.length-1].value[b.value[0].value.length-2]).value.real&&1e;e++)b=g.scaldiv(g.abs(b),b),b=g.LUsolve(g.sub(a,g.scalmult(d,c)),JSON.parse(JSON.stringify(b)));return g.scaldiv(g.abs(b),b)};g._helper.toHessenberg=function(a){var h=JSON.parse(JSON.stringify(a)),c=h.value.length,b=l.real(c-1),d=l.real(c); +l.real(1);if(g._helper.isUpperTriangular(h))return[g.idMatrix(b,b),a];var e;a=g.idMatrix(d,d);for(var f,d=1;dc&&u++;break}e=l.sub(e,f);k.value=k.value.splice(0,k.value.length-1)}return{Q:m,R:n,P:g.turnIntoCSList(p),rank:l.real(u)}};g._helper.getHouseHolder= +function(a){var h=l.real(a.value.length);if(1E-16>g.abs2(a))return g.idMatrix(h,h);var c,b=l.real(1),d=g._helper.unitvector(l.real(a.value.length),b);c=g._helper.QRgetAlpha(a,0);c=g.sub(a,g.scalmult(c,d));c=g.scaldiv(g.abs(c),c);a=l.div(g.sesquilinearproduct(a,c),g.sesquilinearproduct(c,a));h=g.idMatrix(h,h);return h=g.sub(h,g.scalmult(l.add(b,a),g._helper.transposeMult(c,g.conjugate(c))))};g._helper.reOrderbyPivots=function(a,h){for(var c=a.value.length.length,b=g.transpose(a),c=Array(c),d=0;da.value[h].value.real?g.abs(a):l.neg(g.abs(a))}; +g.LUdecomp=function(a){a=JSON.parse(JSON.stringify(a));var h,c,b,d,g,e=0,f,k=a.value.length,m=k-1,n=Array(k);for(b=0;b=m&&console.log("CG did not converge");return e};g.det=function(a){if(1===a.value.length)return a.value[0].value[0];if(2===a.value.length)return g.det2(a.value[0],a.value[1]);if(3===a.value.length)return g.det3(a.value[0],a.value[1],a.value[2]);if(4===a.value.length)return g.det4m(a); +var h=a.value.length,c=l.real(1),b,d,e=JSON.parse(JSON.stringify(a)),f,k,m,n;for(a=0;al.abs(e.value[d].value[a]).value.real&&(d=b);d!==a&&(b=e.value[d],e.value[d]=e.value[a],e.value[a]=b,c=l.neg(c));f=e.value[a];for(b=a+1;b"]=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===c.ctype&&"number"===b.ctype&&l._helper.isAlmostReal(c)&&l._helper.isAlmostReal(b)?{ctype:"boolean",value:c.value.real-b.value.real>=l.eps}:k};R["=:="]=C("=:=");R[">="]=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===c.ctype&&"number"===b.ctype&&l._helper.isAlmostReal(c)&&l._helper.isAlmostReal(b)?{ctype:"boolean",value:c.value.real>=b.value.real}:"string"===c.ctype&&"string"=== +b.ctype?{ctype:"boolean",value:c.value>=b.value}:k};R["<="]=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===c.ctype&&"number"===b.ctype&&l._helper.isAlmostReal(c)&&l._helper.isAlmostReal(b)?{ctype:"boolean",value:c.value.real<=b.value.real}:"string"===c.ctype&&"string"===b.ctype?{ctype:"boolean",value:c.value<=b.value}:k};R["~>="]=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===c.ctype&&"number"===b.ctype&&l._helper.isAlmostReal(c)&&l._helper.isAlmostReal(b)?{ctype:"boolean",value:c.value.real- +b.value.real>-l.eps}:k};R["~<="]=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===c.ctype&&"number"===b.ctype&&l._helper.isAlmostReal(c)&&l._helper.isAlmostReal(b)?{ctype:"boolean",value:c.value.real-b.value.real"]=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===c.ctype&&"number"===b.ctype&&l._helper.isAlmostReal(c)&&l._helper.isAlmostReal(b)?{ctype:"boolean",value:c.value.real>b.value.real}:"string"===c.ctype&&"string"===b.ctype?{ctype:"boolean",value:c.value>b.value}: +k};R["<"]=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===c.ctype&&"number"===b.ctype&&l._helper.isAlmostReal(c)&&l._helper.isAlmostReal(b)?{ctype:"boolean",value:c.value.real"]=Gc;R["\u2208"]=function(a,h){var c=A(a[0]),b=A(a[1]);return"list"===b.ctype?g.contains(b,c):k};R["\u2209"]=function(a,h){var c=A(a[0]),b=A(a[1]);return"list"===b.ctype?w.not(g.contains(b,c)):k};R["&"]=Hc;R["%"]=Ic; +R["!="]=Gc;R["~!="]=function(a,h){return w.not(Yb(a,h))};R[".."]=function(a,h){var c=A(a[0]),b=A(a[1]);return"number"===c.ctype&&"number"===b.ctype?g.sequence(c,b):k};R["++"]=Tc;R["--"]=Vc;R["~~"]=Uc;R[":>"]=Wc;R["<:"]=Xc;R["="]=bb;R[":="]=function(a,h,c){h="undefined"===a[1].ctype;if("undefined"===a[0].ctype||h)return k;if("function"===a[0].ctype){h=a[0].oper;var b=a[0].args,d=a[1],g=1;if(Za.hasOwnProperty(h)){g=Za[h];if(g.definer===c)return k;g=g.generation+1}Za[h]={oper:h,body:d,arglist:b,definer:c, +generation:g}}"variable"===a[0].ctype&&J.setvar(a[0].name,a[1]);return k};R[":=_"]=function(a,h){if("void"!==a[1].ctype)return k;"function"===a[0].ctype&&delete Za[a[0].oper];return k};R["::="]=C("::=");R[";"]=function(a,h){var c="void"===a[0].ctype,b="void"===a[1].ctype;if(c&&b)return k;if(!c&&b)return A(a[0]);c||b||A(a[0]);return b?k:A(a[1])};var t={},D={evaluate:function(a,h,c){if(Za.hasOwnProperty(a)){a=Za[a];if(void 0===a)h=k;else{var b=[];for(c=0;c "+ba(h[a]))};J.vstack=[];J.pushVstack=function(a){this.vstack.push(a)};J.popVstack=function(){this.vstack.pop()};J.cleanVstack=function(){for(var a=this.vstack;0 "+ba(A(b));ia.err(b);return k};t.errc$1=function(a,h){var c;"variable"===a[0].ctype?(c=A(J.getvar(a[0].name)),console.log(a[0].name+" ===> "+ba(c))):(c=A(a[0]),console.log(" ===> "+ +ba(c)));return k};t.print$1=function(a,h){ia.out(ba(A(a[0])),!0);return k};t.println$1=function(a,h){ia.out(ba(A(a[0])));return k};t.assert$2=function(a,h){var c=A(a[0]);if("boolean"===c.ctype){if(!1===c.value)return t.println$1([a[1]],h)}else ia.err("Condition for assert is not boolean");return k};t.dump$1=function(a,h){console.log(JSON.stringify(a[0]));return k};t.repeat$2=function(a,h){return t.repeat$3([a[0],null,a[1]],h)};t.repeat$3=function(a,h){var c=B(a[0]),b="#";null!==a[1]&&"variable"=== +a[1].ctype&&(b=a[1].name);if("number"!==c.ctype)return k;var c=Math.round(c.value.real),d=1,g=1,e=c+1,f=!1,l=!1,m=!1,n;void 0!==h.start&&(n=A(h.start),"number"===n.ctype&&(f=!0,g=n.value.real));void 0!==h.step&&(n=A(h.step),"number"===n.ctype&&(m=!0,d=n.value.real));void 0!==h.stop&&(n=A(h.stop),"number"===n.ctype&&(l=!0,e=n.value.real));!f||l||m||(e=d*c+g);f||!l||m||(g=-d*(c-1)+e,e+=d);f||l||!m||(e=d*c+g);f&&l&&!m&&(d=(e-g)/(c-1),e+=d);f&&!l&&m&&(e=d*c+g);!f&&l&&m&&(g=-d*(c-1)+e,e+=d);f&&l&&m&&(e+= +d);(g<=e&&0=e&&0>d)&&f&&l&&m&&(c=Math.floor((e-g)/d));J.newvar(b);e=k;for(f=0;fd&&(d=b.value.length+d+1),0=b)return g.turnIntoCSList([]);if(l._helper.isZero(a.value[b]))return h=D.roots(g.turnIntoCSList(a.value.slice(0, +b))),g.append(h,l.infinity);if(1===b)h[0]=l.neg(l.div(a.value[0],a.value[1]));else if(2===b)h=D.quadratic_roots(a);else{for(var d=0;de.value.real)return console.log("grade cant be < 1"),k;e=l.add(e,l.real(1));return P.autodiff(b,c,d,e)};t.cos$1=function(a,h){var c=B(a[0]);return"number"===c.ctype?l.cos(c):k};t.tan$1=function(a,h){var c= +B(a[0]);return"number"===c.ctype?l.tan(c):k};t.arccos$1=function(a,h){var c=B(a[0]);return"number"===c.ctype?l.arccos(c):k};t.arcsin$1=function(a,h){var c=B(a[0]);return"number"===c.ctype?l.arcsin(c):k};t.arctan$1=function(a,h){var c=B(a[0]);return"number"===c.ctype?l.arctan(c):k};t.arctan2$2=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===c.ctype&&"number"===b.ctype?l.arctan2(c,b):k};t.arctan2$1=function(a,h){var c=B(a[0]);if("list"===c.ctype&&2===c.value.length){if(c=c.value,"number"===c[0].ctype&& +"number"===c[1].ctype)return t.arctan2$2(c,h)}else if("number"===c.ctype)return l.arctan2(c);return k};t.log$1=function(a,h){var c=B(a[0]);return"number"===c.ctype?l.log(c):k};D.recursiveGen=function(a){var h=l[a],c=g[a];t[a+"$1"]=function(a,b){var d=B(a[0]);return"number"===d.ctype?h(d):"list"===d.ctype?c(d):k}};D.recursiveGen("im");D.recursiveGen("re");D.recursiveGen("conjugate");D.recursiveGen("round");D.recursiveGen("ceil");D.recursiveGen("floor");D.recursiveGen("abs");t.abs_infix=t.abs$1;t.random$0= +function(a,h){return l.real(l._helper.rand())};t.random$1=function(a,h){var c=B(a[0]);return"number"===c.ctype?l.complex(c.value.real*l._helper.rand(),c.value.imag*l._helper.rand()):k};t.seedrandom$1=function(a,h){var c=B(a[0]);"number"===c.ctype&&l._helper.seedrandom(c.value.real);return k};t.randomnormal$0=function(a,h){return l.real(l._helper.randnormal())};t.randominteger$1=function(a,h){var c=B(a[0]);if("number"===c.ctype){var b=c.value.real|0,c=c.value.imag|0,b=b*l._helper.rand()|0,c=c*l._helper.rand()| +0;return l.complex(b,c)}return k};t.randomint$1=t.randominteger$1;t.randombool$0=function(a,h){return.5f)return l.real(0);if(0===f)return l.real(1);if(1===f)return b;for(var p=d=1,q=1;q<=f;++q)var t=e-f+q|0,v=q|0,u=pc(t,v)|0,t=t/u|0,v=v/u|0,u=pc(d,v)|0,d=d/u|0,v=v/u|0,u=pc(t,p)|0,t=t/u|0,p=p/u|0,d=d*t|0,p=p*v|0;return l.real(d/p)}if("list"===b.ctype){e=b.value.length;if(0>f||f>e)return g.turnIntoCSList([]);if(0===f)return g.turnIntoCSList([g.turnIntoCSList([])]); +if(f===e)return g.turnIntoCSList([b]);n=[];m=Array(f);c(0,0);return g.turnIntoCSList(n)}}return k};t.zeromatrix$2=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===c.ctype&&"number"===b.ctype?g.zeromatrix(c,b):k};t.zerovector$1=function(a,h){var c=B(a[0]);return"number"===c.ctype?g.zerovector(c):k};t.transpose$1=function(a,h){var c=B(a[0]);return"list"===c.ctype&&-1!==g._helper.colNumb(c)?g.transpose(c):k};t.row$2=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===b.ctype&&"list"===c.ctype&& +-1!==g._helper.colNumb(c)?g.row(c,b):k};t.column$2=function(a,h){var c=B(a[0]),b=B(a[1]);return"number"===b.ctype&&"list"===c.ctype&&-1!==g._helper.colNumb(c)?g.column(c,b):k};t.dict$0=function(a,h){var c=Ka.create(),b;for(b in h)h.hasOwnProperty(b)&&Ka.put(c,w.string(b),A(h[b]));return c};t.put$3=function(a,h){var c=A(a[0]),b=A(a[1]),d=A(a[2]);return"dict"===c.ctype?(c=Ka.clone(c),Ka.put(c,b,d),c):k};t.get$2=function(a,h){var c=A(a[0]),b=A(a[1]);return"dict"===c.ctype?Ka.get(c,b,k):k};t.red$1=function(a, +h){var c=A(a[0]);return"number"===c.ctype?g.realVector([Math.min(1,Math.max(0,c.value.real)),0,0]):k};t.green$1=function(a,h){var c=A(a[0]);return"number"===c.ctype?g.realVector([0,Math.min(1,Math.max(0,c.value.real)),0]):k};t.blue$1=function(a,h){var c=A(a[0]);return"number"===c.ctype?g.realVector([0,0,Math.min(1,Math.max(0,c.value.real))]):k};t.gray$1=function(a,h){var c=A(a[0]);return"number"===c.ctype?(c=Math.min(1,Math.max(0,c.value.real)),g.realVector([c,c,c])):k};t.grey$1=t.gray$1;D.HSVtoRGB= +function(a,h,c){var b,d,e,f,k,l;a&&void 0===h&&void 0===c&&(h=a.s,c=a.v,a=a.h);f=Math.floor(6*a);k=6*a-f;a=c*(1-h);l=c*(1-k*h);h=c*(1-(1-k)*h);switch(f%6){case 0:b=c;d=h;e=a;break;case 1:b=l;d=c;e=a;break;case 2:b=a;d=c;e=h;break;case 3:b=a;d=l;e=c;break;case 4:b=h;d=a;e=c;break;case 5:b=c,d=a,e=l}return g.realVector([b,d,e])};t.hue$1=function(a,h){var c=A(a[0]);return"number"===c.ctype?(c=c.value.real,c-=Math.floor(c),D.HSVtoRGB(c,1,1)):k};D.shapeconvert=function(a){var h,c;if("circle"===a.type){h= +a.value.value[0];h=w.div(h,h.value[2]);var b=h.value[0].value.real,d=h.value[1].value.real;a=a.value.value[1].value.real;c=Array(125);var e=2*Math.PI/125;for(h=0;125>h;h++)c[h]={X:b+Math.cos(h*e)*a,Y:d+Math.sin(h*e)*a};return[c]}if("polygon"===a.type){b=[];for(h=0;h=c?c=String.fromCharCode(c):(c-=65536,c=String.fromCharCode((c>>10)+55296,(c&1023)+56320));return w.string(c)};t.international$1=function(a,h){return t.international$2([a[0],null],h)};t.international$2=function(a,h){var c=A(a[0]);if("string"!==c.ctype)return k;var b=(p.translations||{})[p.language||"en"]||{};if(!b.hasOwnProperty(c.value))return c;var d=b[c.value];if("string"===typeof d)return w.string(d);if(null===a[1])return c; +var e=A(a[1]),e="number"===e.ctype?e.value.real:0,b=(b._pluralFormFunction||Vd)(e);return bm&&(m=a.length)});for(var n=[],p=0;pe.length)for(p=e.length;p(c.x-b.x)*(c.x-b.x)+(c.y-b.y)*(c.y-b.y)||1E-12>p||1E-12>f)return k;0>g.crossratio3(d,a,e,g.cross(g.cross(d,e),g.linfty),g.ii).value.real?x.drawsegcore(c, +n):x.drawRaySegment(d,a)}return k};D.drawcircle=function(a,b,c){var d=B(a[0]);a=B(a[1]);var e=D.extractPoint(d);if(!e.ok||"number"!==a.ctype||!l._helper.isAlmostReal(a))return k;var d=z.drawingstate.matrix,g=e.x*d.a-e.y*d.b+d.tx,e=e.x*d.c-e.y*d.d-d.ty;x.handleModifs(b,x.conicModifs);x.preDrawCurve();y.lineJoin="miter";y.beginPath();y.arc(g,e,Math.abs(a.value.real)*d.sdet,0,2*Math.PI);y.closePath();"D"===c&&y.stroke();"F"===c&&(y.fillStyle=x.lineColor,y.fill());"C"===c&&y.clip();return k};t.drawconic$1= +function(a,b){var c;c=B(a[0]);if("list"!==c.ctype||3!==c.value.length&&6!==c.value.length)return console.error("could not parse conic"),k;if(6===c.value.length){for(var d=0;6>d;d++)if("number"!==c.value[d].ctype)return console.error("could not parse conic"),k;var e=l.real(.5),d=c.value[0],f=c.value[2],f=l.mult(f,e),m=c.value[1],n=c.value[3],n=l.mult(n,e),p=c.value[4],p=l.mult(p,e);c=c.value[5];c=g.turnIntoCSList([g.turnIntoCSList([d,f,n]),g.turnIntoCSList([f,m,p]),g.turnIntoCSList([n,p,c])])}else{for(d= +0;3>d;d++)for(f=0;3>f;f++)if("number"!==c.value[d].value[f].ctype)return console.error("could not parse conic"),k;g.equals(c,g.transpose(c)).value||(d=w.mult(c,l.real(.5)),c=w.mult(g.transpose(c),l.real(.5)),c=g.add(d,c))}c=g.normalizeMax(c);return D.drawconic(c,b)};D.drawconic=function(a,b){x.handleModifs(b,x.conicModifs);if(0!==x.lsize){x.preDrawCurve();for(var c=g.normalizeMax(a),d=c,e=0;2>e;e++)for(var f=0;2>f;f++)if(Math.abs(c.value[e].value[f].value.imag)>l.eps)return;e=g.turnIntoCSList([g.realVector([-1, +-1,1]),g.realVector([1,0,0]),g.realVector([0,1,0])]);f=z.from(0,0,1);f[2]=1;var n=z.from(1,0,1);n[2]=1;var p=z.from(0,1,1);p[2]=1;var f=g.turnIntoCSList([g.realVector(f),g.realVector(n),g.realVector(p)]),f=g.transpose(f),e=w.mult(f,e),e=g.inverse(e),c=w.mult(g.transpose(e),c),c=w.mult(c,e),e=c.value[0].value[0].value.real,f=c.value[1].value[0].value.real,n=c.value[1].value[1].value.real,p=c.value[2].value[0].value.real,q=c.value[2].value[1].value.real,v=c.value[2].value[2].value.real,c=[[e,f,p],[f, +n,q],[p,q,v]],u=1E-14>Math.abs(e*n*v-e*q*q-f*f*v+2*f*p*q-n*p*p);if(u&&"Circle"===a.usage){var A=w.mult(g.adjoint3(d),g.linfty);l.abs(A.value[2]).value.real>l.eps&&(u=!1)}var A=da>ca?da:ca,B=-1.5*A,C=1.5*A,D=-1.5*A,E=1.5*A,F=1;u&&(F=0);if(F)var p=0,p=1E-14Math.abs(a)?"parabola":1E-14na||100>Math.abs(b-c)?.5:0>Q||Q>ca?10:3;d=-f*k*Q*Q-2*f*m*Q-f*a+r*r*Q*Q+2*r*l*Q+l*l;d=Math.sqrt(d); +h=1/f*(-r*Q-l+d);d=-1/f*(r*Q+l+d);var q,Ga;F?(q=[h,Q,1],Ga=[d,Q,1],q=w.mult(G,g.realVector(q)),Ga=w.mult(G,g.realVector(Ga)),h=q.value[0].value.real,d=Ga.value[0].value.real,q=q.value[1].value.real,Ga=Ga.value[1].value.real):Ga=q=Q;isNaN(h)||"ellipsoid"!==e?!isNaN(h)&&h>=B&&h<=C&&(J.push(h),K.push(q)):(J.push(h),K.push(q));isNaN(d)||"ellipsoid"!==e?!isNaN(d)&&d>=B&&d<=C&&(I.push(d),M.push(Ga)):(I.push(d),M.push(Ga))}}},f=function(a){var c,b,h;H(a);if(6!==a.length)console.error("Conic needs 6 Parameters"); +else{h=a[0];var d=a[1],e=a[2],f=a[3],g=a[4],r=a[5];c=-h*g+d*f;b=Math.sqrt(h*(-h*e*r+h*Math.pow(g,2)+Math.pow(d,2)*r-2*d*f*g+e*Math.pow(f,2)));e=h*e-Math.pow(d,2);1E-14D&&hD&&bb?h:b;S(a,D,c);N=J.concat(I.reverse());O=K.concat(M.reverse());R(N,O);P();S(a,b,E);R(J,K);if(L(J[0],K[1])||L(I[0],M[0]))y.beginPath(),y.moveTo(J[0],K[0]),y.lineTo(I[0],M[0]),y.stroke();R(I,M);P();S(a,c, +b);R(J,K);y.beginPath();y.moveTo(J[0],K[0]);y.lineTo(I[0],M[0]);y.stroke();y.beginPath();y.moveTo(J[J.length-1],K[K.length-1]);y.lineTo(I[I.length-1],M[M.length-1]);y.stroke();R(I,M);P()}};u?e():f(c)}};t.drawall$1=function(a,b){var c=A(a[0]);if("list"===c.ctype){x.handleModifs(b,x.pointAndLineModifs);for(var d=0;df&&(f=d[l].value.length);-1===f?(d=d.map(function(a){return[a]}),f=1):d=d.map(function(a){return g.asList(a).value});var m=100,n=null,p=!0,q=z.drawingstate.textcolor;x.handleModifs(b, +{size:!0,color:function(a){g._helper.isNumberVecN(a,3)&&(q=x.makeColor([a.value[0].value.real,a.value[1].value.real,a.value[2].value.real]))},alpha:!0,bold:!0,italics:!0,family:!0,align:!0,x_offset:!0,y_offset:!0,offset:!0,width:function(a){"number"===a.ctype&&(m=a.value.real)},height:function(a){"number"===a.ctype&&(n=a.value.real)},border:function(a){"boolean"===a.ctype&&(p=a.value)}});var t=z.drawingstate.textsize;null===t&&(t=la.textsize);null!==x.size&&(t=x.size);null===n&&(n=1.6*t);y.font=x.bold+ +x.italics+Math.round(10*t)/10+"px "+x.family;l=z.drawingstate.matrix;var v=f*m,u=c*n,t=e.x*l.a-e.y*l.b+l.tx+x.xOffset,w=e.x*l.c-e.y*l.d-l.ty-x.yOffset-u;if(p){x.preDrawCurve();y.strokeStyle=x.lineColor;y.beginPath();for(l=1;lk)!f&&p&&(y.stroke(),p=!1);else if(n||q){var t=l.real((a.value.real+b.value.real)/2);J.setvar(B,t);var v=A(w),u=c(v);if(n&&q&&u){var Nb=h.value.real,q=v.value.real,u=g.value.real;if(n=1>Math.abs(Nb+u-2*q)/m){var x=l.real((a.value.real+t.value.real)/2);J.setvar(B,x);var x=A(w),fc=l.real((t.value.real+b.value.real)/2);J.setvar(B,fc);fc=A(w);Nb=Math.abs(Nb+ +q-2*x.value.real)/m;q=Math.abs(q+u-2*fc.value.real)/m;n=n&&1>Nb&&1>q}n?(d(a,t,h,v,k/2),d(t,b,v,g,k/2)):(e(a,t,h,v,k/2),e(t,b,v,g,k/2))}else e(a,t,h,v,k/2),e(t,b,v,g,k/2)}}var f=!1,m=.2/Kb,n=0,p=!1,q=-10,t=10,v=.1,u=1E3,w=a[0],B;if(null!==a[1]&&"variable"===a[1].ctype)B=a[1].name;else{var C=D.plotvars(w);B="#";-1!==C.indexOf("t")&&(B="t");-1!==C.indexOf("z")&&(B="z");-1!==C.indexOf("y")&&(B="y");-1!==C.indexOf("x")&&(B="x")}J.newvar(B);var E=z.drawingstate.matrix;x.handleModifs(b,{color:!0,alpha:!0, +size:!0,dashpattern:!0,dashtype:!0,dashing:!0,lineCap:!0,lineJoin:!0,miterLimit:!0,connect:function(a){"boolean"===a.ctype&&(f=a.value)},start:function(a){"number"===a.ctype&&(q=a.value.real)},stop:function(a){"number"===a.ctype&&(t=a.value.real)},steps:function(a){"number"===a.ctype&&(u=a.value.real)}});y.strokeStyle=x.lineColor;y.lineWidth=x.lsize;var F,G,H,I,p=!1,C=l.real(14.32);J.setvar(B,C);H=A(w);if("number"!==H.ctype){if(g.isNumberVector(H).value&&2===H.value.length){p=!1;v=(t-q)/u;for(C=q;C< +t;C+=v)J.setvar(B,l.real(C)),I=A(w),g.isNumberVector(I).value&&2===I.value.length&&(F=+I.value[0].value.real,G=+I.value[1].value.real,I=F*E.a-G*E.b+E.tx,F=F*E.c-G*E.d-E.ty,p?y.lineTo(I,F):(y.beginPath(),y.moveTo(I,F),p=!0));y.stroke();J.removevar(B)}return k}for(I=q;Iq&&e(F,C,G,H,v),F=C,G=H;J.removevar(B);p&&y.stroke();return k};t.plotX$1=function(a,b){var c=a[0],d=D.plotvars(c),e="#";-1!==d.indexOf("t")&&(e="t");-1!==d.indexOf("z")&&(e="z"); +-1!==d.indexOf("y")&&(e="y");-1!==d.indexOf("x")&&(e="x");J.newvar(e);d=z.drawingstate.matrix;y.fillStyle=z.drawingstate.linecolor;y.lineWidth=1;y.lineCap=x.lineCap;y.lineJoin=x.lineJoin;y.miterLimit=x.miterLimit;for(var f=!1,g=-10;10>g;g+=.01){J.setvar(e,l.real(g));var m=A(c);if("number"===m.ctype){var n=+m.value.real,m=g*d.a-n*d.b+d.tx,n=g*d.c-n*d.d-d.ty;f?y.lineTo(m,n):(y.beginPath(),y.moveTo(m,n),f=!0)}}y.stroke();J.removevar(e);return k};D.plotvars=function(a){function b(a,c){var h={},d;for(d= +a.length-1;0<=d;--d)h[a[d]]=a[d];for(d=c.length-1;0<=d;--d)h[c[d]]=c[d];d=[];for(var e in h)h.hasOwnProperty(e)&&d.push(h[e]);return d}function c(a,c){for(var b=0;bf||!Number.isInteger(f)?(e.video.aspectRatio=f,e.video.advanced[0].aspectRatio={min:f,max:f}, +e.video.advanced[1].aspectRatio={ideal:f}):(e.video.height=f,e.video.advanced[0].height={min:f,max:f},e.video.advanced[1].height={ideal:f}))}d&&(e=[320,640,1024,1280,1920,2560],e=e.map(function(a){return{width:{min:a}}}),e={video:{width:16E3,height:9E3,advanced:e},audio:!1});var d=null,l=navigator.mediaDevices&&navigator.mediaDevices.getUserMedia;l?d=function(a,c){navigator.mediaDevices.getUserMedia(e).then(a,c)}:(l=navigator.getUserMedia||navigator.webkitGetUserMedia||navigator.mozGetUserMedia|| +navigator.msGetUserMedia)&&(d=function(a,c){l.call(navigator,e,a,c)});if(!d)return console.warn("getUserMedia call not supported"),k;var m=document.createElement("video");m.autoplay=!0;f=aa(m,!0);console.log("Opening stream.");d(function(a){a=window.URL.createObjectURL(a);m.src=a;m.addEventListener("loadeddata",I)},function(a){console.error("Could not get user video:",String(a),a)});return f};t.playvideo$1=function(a,b){var c=La(B(a[0]));c.live&&c.img.play&&c.img.play();return k};t.pausevideo$1=function(a, +b){var c=La(B(a[0]));c.live&&c.img.pause&&c.img.pause();return k};var Db;t.imagergba$3=function(a,b){var c=La(B(a[0])),d=B(a[1]),e=B(a[2]);if(!c||"number"!==d.ctype||"number"!==e.ctype||!c.ready)return k;d=Math.round(d.value.real);e=Math.round(e.value.real);if(!Fa(d)||!Fa(e))return k;c=rb(c,d,e,1,1);return g.realVector([255*c[0],255*c[1],255*c[2],c[3]])};t.imagergb$3=t.imagergba$3;t.imagergba$4=function(a,b){var c=La(B(a[2]));if(!c||!c.ready)return k;var d=c.width,e=c.height,f=M(a[0]),l=M(a[1]),m= +M(g.realVector([0,e,1])),d=M(g.realVector([d,e,1]));if(f===k||l===k||n===k)return k;var n=g.ii,e=g.jj,m=D.basismap(m,d,n,e),f=D.basismap(f,l,e,n),n=M(a[3]);var p=D.extractPoint(w.mult(m,w.mult(g.adjoint3(f),n)));if(p.ok){var l=c.width,m=c.height,n=!0,q=!1;void 0!==b.interpolate&&(f=A(b.interpolate),"boolean"===f.ctype&&(n=f.value));void 0!==b.repeat&&(f=A(b.repeat),"boolean"===f.ctype&&(q=f.value));n&&(p.x-=.5,p.y-=.5);q&&(p.x=(p.x%l+l)%l,p.y=(p.y%m+m)%m);d=Math.floor(p.x);e=Math.floor(p.y);if(Fa(d)&& +Fa(e)){f=[0,0,0,0];if(n){var n=p.x-d,p=p.y-e,t=rb(c,d,e,2,2);if(q){if(d===l-1||e===m-1)var q=rb(c,(d+1)%l,e,1,1),u=rb(c,d,(e+1)%m,1,1),c=rb(c,(d+1)%l,(e+1)%m,1,1),t=t.slice(0,4).concat(q,u,c)}else{if(-1===d||d===l-1)n=Math.round(n);if(-1===e||e===m-1)p=Math.round(p)}for(c=0;4>c;c++)f[c]=(1-p)*((1-n)*t[c]+n*t[c+4])+p*((1-n)*t[c+8]+n*t[c+12])}else f=rb(c,d,e,1,1);c=g.realVector(f)}else c=k}else c=k;return c};t.imagergb$4=function(a,b){var c=t.imagergba$4(a,b);return c===k?k:g.turnIntoCSList(c.value.slice(0, +3))};"use strict";var re=[{key:[":"],field:["."],deg:["\u00b0"],take:["_"]},{functionCall:!0},{rassoc:!0,pow:["^"],sqrt:["\u221a"]},{mul:["*","\u2062","\u22c5","\u00b7"],cross:["\u00d7"],div:["/","\u00f7","\u2215","\u2236"]},{add:["+"],sub:["-","\u2212"],neg:["!","\u00ac"]},{seq:[".."]},{eq:["==","\u225f"],ne:["!=","<>","\u2260"],lt:["<"],gt:[">"],le:["<=","\u2264","\u2266"],ge:[">=","\u2265","\u2267"],aeq:["~=","\u2248"],ane:["~!=","\u2249"],alt:["~<","\u2a89"],agt:["~>","\u2a8a"],ale:["~<=","\u2a85"], +age:["~>=","\u2a86"],"in":["\u2208"],nin:["\u2209"]},{and:["&","\u2227"],or:["%","\u2228"]},{rassoc:!0,prepend:["<:"]},{concat:["++","\u222a"],remove:["--","\u2216"],common:["~~","\u2229"],append:[":>"]},{rassoc:!0,assign:["="],define:[":="],undefine:[":=_"],bdefine:["::="]},{seq:[";"]},{modif:["->","\u2192"]},{rassoc:!0,list:[","]}],se=["+","-"],te=["!","\u221a"],ue=["\u00b0",":=_"],ve=[";",","],Cc=[],xa={},cd;(function(){var a=0;re.forEach(function(b){a+=2;var c=!!b.rassoc;b.functionCall&&(cd=a); +for(var d in b){var e=b[d];if("boolean"!==typeof e)for(var f={name:d,sym:e[0],symbols:e,rassoc:c,precedence:a,prefix:!1,postfix:!1,infix:!0,bare:!1},g=0;g &%C( / . $$!L! %5%;( D#!*!* 4'&*$W + !#&]F %6&]% !#% !#!(# & ! !#% # %1!#$ !/#L!S( @?$\u00817-!*''#$!$%+ ',6!:= !&!#7 \u0090 ##& ! ##D ##B ##& ! ##9 K ##^Y2*V#'$\u009d#5 4&p((+, #2*2*2, 5OC!'!Uy.D !&_)0J<#$,E'4Q/1Pv!|8:&K<9%)E>@7 )@\u0080# #$%1gT\u008e#'#=#'#( ! ! ! 0#P & !$ &$##'',& &d!9!*,b!'!#. !$$(! ! ! # 1##&$'!G%\u00a58 8 \u0084(#$%6= !&!#Q+!*/1& & & & & & & &t!\u0097%E$&%'V( z #&D${:Aj2\u0099\u00a6q\u00a9E\u00a4UZ#\u008d$2)%-8*0#_J+#b#M#(S1 # /0O2[R'$! !6>)/A?+8?G)-):9*\ud803!`KJ9J\ud804#PriL3>@7M$!6F2#/! !C* 3V& ! # 9 .+8N(#%#- & % $$!;!6$\ud805eF-% !\u008987#=F-!k7x4\ud806\u0087RB!\u0095K\ud808!\u00a2\ud809e\u008a\ud80d!8\ud811!\u009c\ud81a!\u009b+0c<;F*#BH&:\ud81b\u00a0U,!l,\ud82c!%\ud82f!\"&,$++.\ud835!w m %#!#%## ) ! & S ##( & > # $ !$& \u0091#3 3 0 3 0 3 0 3 0 3 (\ud83a!\u008b\ud83b\u0098# A % !#! . # ! !(!'! ! ! % !#! ! ! ! ! % !## & # # ! . 5& $ 5\ud869!\u009f7\u008c\ud86d!\u00a1,g\ud86e!<#\u00a3\ud873!\u009e\ud87e!\u009a", +"\ud80c\ud840-\ud868\ud86a-\ud86c\ud86f-\ud872"),ze=("#(?: [1-9])?|(?:'|"+Dc+")(?: (?:[0-9']|"+Dc+"))*").replace(/ /g,"[ \t]*"),$c=["([ \t\n]+)|(//.*)|(/\\*)","("+we+")","("+Cc.map(Zc).join("|")+")","("+"[](){}||".split("").map(Zc).join("|")+")","("+ye+")","("+xe+")","("+ze+")",'("[^"]*")|($)'].join("|"),Ae=new RegExp("[ \t]*".replace(/\*$/,"+"),"g"),Ec="ANY WS COMMENT START_COMMENT NUM OP BRA SUB SUP ID STR EOF".split(" ");(function(){var a=(new RegExp($c,"g")).exec("");if(a.hasOwnProperty(Ec.length))throw Error("RE has more groups than expected"); +if(!a.hasOwnProperty(Ec.length-1))throw Error("RE has fewer groups than expected");})();kb.prototype.advanceBy=function(a){this.advanceTo(this.pos+a)};kb.prototype.advanceTo=function(a){for(this.pos=a;this.bols[0]<=a;)this.bol=this.bols.shift(),this.line++};kb.prototype.curPos=function(){return{row:this.line,col:this.pos-this.bol,pos:this.pos}};kb.prototype.nextInternal=function(){var a=this.re.exec(this.input);if(a.index!==this.pos)throw ha("Invalid token",this.curPos(),this.input.substring(this.pos, +a.index));var b=this.curPos();this.advanceBy(a[0].length);var c=this.curPos(),d;for(d=1;null==a[d];++d);return{start:b,end:c,raw:a[0],text:a[0].replace(Ae,""),toktype:Ec[d]}};kb.prototype.next=function(){var a;do if(a=this.nextInternal(),"START_COMMENT"===a.toktype){var b=/\*\/|\/\*/g;b.lastIndex=a.start.pos+2;for(var c=1,d;0d&&(d=0),10b.value.real||b.value.real!==Math.floor(b.value.real))return P.root(a,b);for(var c=a,d=1;d=x.psize&&(x.psize=0);0>=x.lsize&&(x.lsize=0);x.overhang=1;x.dashing=!1;x.isArrow=!1;x.arrowSides="==>";x.arrowposition= +1;x.headlen=10;x.arrowShape=x.arrowShapes.line;x.alpha=z.drawingstate.alpha;x.fillalpha=0;x.bold="";x.italics="";x.family="sans-serif";x.align=0;x.xOffset=0;x.yOffset=0;x.lineCap="round";x.lineJoin="round";x.miterLimit=10;var c,d;for(c in a){var e=a[c];e&&((d=b[c])?(!0===d&&(d=x.modifHandlers[c]),d(A(e))):console.log("Modifier not supported: "+c))}null!==x.size?x.psize=x.lsize=x.size:(x.psize=z.drawingstate.pointsize,x.lsize=z.drawingstate.linesize);x.dashing&&x.dashing(x.lsize);null!==x.colorraw? +x.pointColor=x.lineColor=x.textColor=x.makeColor(x.colorraw):1===x.alpha?(x.pointColor=z.drawingstate.pointcolor,x.lineColor=z.drawingstate.linecolor,x.textColor=z.drawingstate.textcolor):(x.pointColor=x.makeColor(z.drawingstate.pointcolorraw),x.lineColor=x.makeColor(z.drawingstate.linecolorraw),x.textColor=x.makeColor(z.drawingstate.textcolorraw));x.black=1===x.alpha?"rgb(0,0,0)":"rgba(0,0,0,"+x.alpha+")";x.fillColor=x.fillcolorraw&&0x.size&&(x.size=0),1E3"!==a.value&&"<==>"!==a.value&&"<=="!==a.value?console.error("arrowsides is unknows"):(x.arrowSides=a.value,x.isArrow=!0)},arrowposition:function(a){"number"!==a.ctype?console.error("arrowposition is not of type number"):0>a.value.real?console.error("arrowposition has to be positive"):1a.value.real?console.error("arrowsize has to be positive"):x.headlen*=a.value.real},bold:function(a){"boolean"===a.ctype&&a.value&&(x.bold="bold ")},italics:function(a){"boolean"===a.ctype&&a.value&&(x.italics="italic ")},family:function(a){"string"===a.ctype&&(x.family=a.value)},align:function(a){"string"=== +a.ctype&&(a=a.value,"left"===a&&(x.align=0),"right"===a&&(x.align=1),"mid"===a&&(x.align=.5))},x_offset:function(a){"number"===a.ctype&&(x.xOffset=a.value.real)},y_offset:function(a){"number"===a.ctype&&(x.yOffset=a.value.real)},offset:function(a){"list"===a.ctype&&2===a.value.length&&"number"===a.value[0].ctype&&"number"===a.value[1].ctype&&(x.xOffset=a.value[0].value.real,x.yOffset=a.value[1].value.real)},lineCap:function(a){"string"!==a.ctype||"round"!==a.value&&"square"!==a.value&&"butt"!==a.value|| +(x.lineCap=a.value)},lineJoin:function(a){"string"!==a.ctype||"round"!==a.value&&"bevel"!==a.value&&"miter"!==a.value||(x.lineJoin=a.value)},fillrule:function(a){"string"!==a.ctype||"nonzero"!==a.value&&"evenodd"!==a.value||(x.fillrule=a.value)},miterLimit:function(a){"number"===a.ctype&&0l&&(f=a);1c&&(e=a);1d||d>da||0>n||n>ca||0>p||p>da||0>k||k>ca){k=x.clipSegment({x:d,y:n},{x:p,y:k});if(2!==k.length||.01>x.lsize)return;d=k[0].x;n=k[0].y;p=k[1].x;k=k[1].y}x.preDrawCurve();if(!x.isArrow||e===f&&g===l).01>x.lsize||(y.beginPath(),y.moveTo(d,n),y.lineTo(p,k), +y.stroke());else{var e=g-e,f=l-f,g=x.headlen/Math.sqrt(e*e+f*f),q=e*g,t=f*g,l=x.arrowposition,m=1-l,f=l*d+m*p,e=l*n+m*k,g=l*p+m*d,l=l*k+m*n,m=x.arrowSides;y.beginPath();x.arrowShape.close?("<==>"===m||"<=="===m?(1>x.arrowposition&&(y.moveTo(d,n),y.lineTo(f,e)),y.moveTo(f+q,e+t)):y.moveTo(d,n),"==>"===m||"<==>"===m?(y.lineTo(g-q,l-t),1>x.arrowposition&&(y.moveTo(g,l),y.lineTo(p,k))):y.lineTo(p,k)):(y.moveTo(d,n),y.lineTo(p,k));y.stroke();"==>"!==m&&"<==>"!==m||c(g,l,1,x.arrowShape.ratio);"<=="!==m&& +"<==>"!==m||c(f,e,-1,-x.arrowShape.ratio)}};x.drawpoint=function(a){var b=z.drawingstate.matrix,c=a.x*b.a-a.y*b.b+b.tx;a=a.x*b.c-a.y*b.d-b.ty;y.lineWidth=.3*x.psize;y.beginPath();y.arc(c,a,x.psize,0,2*Math.PI);y.fillStyle=x.pointColor;y.fill();y.beginPath();y.arc(c,a,1.15*x.psize,0,2*Math.PI);y.fillStyle=x.black;y.strokeStyle=x.black;y.stroke()};x.clipLineCore=function(a,b,c){var d=Math.SQRT1_2*x.lsize,e=0-d,f=da+d,g=0-d,d=ca+d,l=0>e*a+g*b+c,k=0>f*a+g*b+c,m=0>e*a+d*b+c,n=0>f*a+d*b+c,p=[];l!==k&&p.push({x:(-c- +b*g)/a,y:g});k!==n&&p.push({x:f,y:(-c-a*f)/b});m!==n&&p.push({x:(-c-b*d)/a,y:d});l!==m&&p.push({x:e,y:(-c-a*e)/b});return p};x.clipLine=function(a){a=g.normalizeMax(g.productVM(a,z.toMat()));return x.clipLineCore(a.value[0].value.real,a.value[1].value.real,a.value[2].value.real)};x.drawline=function(a){g._helper.isAlmostReal(a)&&(a=x.clipLine(a),2===a.length&&.01<=x.lsize&&(x.preDrawCurve(),y.beginPath(),y.moveTo(a[0].x,a[0].y),y.lineTo(a[1].x,a[1].y),y.stroke()))};x.drawRaySegment=function(a,b){var c= +D.extractPoint(a),d=D.extractPoint(b);if(c.ok&&d.ok){var e=c.x-d.x,f=c.y-d.y,g=25E3/z.drawingstate.matrix.sdet/Math.sqrt(e*e+f*f),e=e*g,f=f*g;x.drawsegcore(c,{x:c.x+e,y:c.y+f});x.drawsegcore(d,{x:d.x-e,y:d.y-f})}};x.dashTypes={solid:[],dashed:[10,10],tightdash:[10,4],dotted:[1,3],dashdot:[10,5,1,5],"dashvalue.solid":[],"dashvalue.dashed":[10,10],"dashvalue.tightdash":[10,4],"dashvalue.dotted":[1,3],"dashvalue.dashdot":[10,5,1,5],0:[],1:[10,10],2:[10,4],3:[1,3],4:[10,5,1,5]};x.setDash=function(a,b){var c= +Math.sqrt(b);a=a.slice();for(var d=0;d=2*Math.PI?this._pathcmd(this._path.length?"L":"M",g,l,"A",c,c,0,0,f?1:0,a-c*Math.cos(d),b-c*Math.sin(d),"A",c,c,0,0,f?1:0,g,l):this._pathcmd(this._path.length?"L":"M",g,l,"A",c,c,0,e>Math.PI?1:0,f?1:0,k,m)},rect:function(a,b,c,d){this._pathcmd("M",a,b,"h",c,"v",d,"h",-c,"z")},_cmd:function(a){1!==this.globalAlpha?(this._body.push(''),this._body.push(a),this._body.push("")):this._body.push(a)},_attrs:function(a){var b="",c;for(c in a)null!==a[c]&& +(b+=" "+c+'="'+a[c]+'"');return b},fill:function(){this._cmd("")},stroke:function(){this._cmd("")},clip:function(){++this._clipIndex;this._body.push('','');this._saveStack[this._saveStack.length-1]+=""},save:function(){this._saveStack.push("")},restore:function(){this._body.push(this._saveStack.pop());0===this._saveStack.length&&this._saveStack.push("")},_transform:function(a){this._body.push('');this._saveStack[this._saveStack.length-1]+=""},translate:function(a,b){this._transform("translate("+a+" "+b+")")}, +rotate:function(a){this._transform("rotate("+Math.PI/180*a+")")},scale:function(a,b){this._transform("scale("+a+" "+b+")")},transform:function(a,b,c,d,e,f){this._transform("matrix("+[a,b,c,d,e,f].join(" ")+")")},drawImage:function(a,b,c){if(3!==arguments.length)throw Error("SvgWriterContext only supports 3-argument version of drawImage");var d=this._imgcache.indexOf(a);if(-1===d){var d=this._imgcache.length,e;e=a.cachedDataURL?a.cachedDataURL:fd(a);this._defs.push('');this._imgcache.push(a)}this._cmd('')},toBlob:function(){for(;1\n'+this._defs.join("\n")+'\n\n\n'+ +this._body.join("\n")+"\n\n\n";return new Blob([a],{type:"image/svg+xml"})}};ed.prototype={_cmd:function(){this._body.push(Array.prototype.join.call(arguments," "))},_setAlpha:function(a,b,c){var d=Math.round(255*a*this._globalAlpha);b+=d;this._extGState[b]="<< /"+c+" "+d/255+" >>";this._cmd("/"+b,"gs");return a},set globalAlpha(a){this._globalAlpha=a;this._setAlpha(this._strokeAlpha,"As","CA");this._setAlpha(this._fillAlpha,"Af","ca")},set fillStyle(a){var b=this;Rb(a,function(a,d,e,f){b._cmd(a/ +255,d/255,e/255,"rg");b._setAlpha(b._fillAlpha=f,"Af","ca")})},set strokeStyle(a){var b=this;Rb(a,function(a,d,e,f){b._cmd(a/255,d/255,e/255,"RG");b._setAlpha(b._strokeAlpha=f,"As","CA")})},set lineWidth(a){this._cmd(a,"w")},set lineCap(a){this._cmd({butt:0,round:1,square:2}[a],"J")},set lineJoin(a){this._cmd({miter:0,round:1,bevel:2}[a],"j")},set miterLimit(a){this._cmd(a,"M")},clearRect:function(){},beginPath:function(){this._pathUsed=!1},closePath:function(){this._cmd("h")},moveTo:function(a,b){this._cmd(this._xPos= +a,this._yPos=-b,"m")},lineTo:function(a,b){this._cmd(this._xPos=a,this._yPos=-b,"l")},bezierCurveTo:function(a,b,c,d,e,f){this._cmd(a,-b,c,-d,this._xPos=e,this._yPos=-f,"c")},quadraticCurveTo:function(a,b,c,d){this.bezierCurveTo((2*a+this._xPos)/3,(2*b-this._yPos)/3,(c+2*a)/3,(d+2*b)/3,c,d)},_kappa:.5522847498307935,arc:function(a,b,c,d,e,f){if(0===d&&e===2*Math.PI)d=this._kappa*c,this.moveTo(a+c,b),this.bezierCurveTo(a+c,b+d,a+d,b+c,a,b+c),this.bezierCurveTo(a-d,b+c,a-c,b+d,a-c,b),this.bezierCurveTo(a- +c,b-d,a-d,b-c,a,b-c),this.bezierCurveTo(a+d,b-c,a+c,b-d,a+c,b);else throw Error("PdfWriterContext.arc only supports full circles");},rect:function(a,b,c,d){this._cmd(a,-b,c,-d,"re")},_usePath:function(a){if(this._pathUsed){var b=this._body[this._pathUsed],c={"S + f":"B","f + S":"B","W n + S":"W S","W n + f":"W f","S + W n":"W S","f + W n":"W f","B + W n":"W B","W S + f":"W B","W f + S":"W B"}[b+" + "+a];if(!c)throw Error("Don't know how to combine '"+b+"' and '"+a+"'");this._body.splice(this._pathUsed, +1);a=c}this._pathUsed=this._body.length;this._cmd(a)},fill:function(){this._usePath("f")},stroke:function(){this._usePath("S")},clip:function(){this._usePath("W n")},save:function(){this._cmd("q")},restore:function(){this._cmd("Q")},translate:function(a,b){this.transform(1,0,0,1,a,b)},rotate:function(a){var b=Math.cos(a);a=Math.sin(a);this.transform(b,a,-a,b,0,0)},scale:function(a,b){this.transform(a,0,0,b,0,0)},transform:function(a,b,c,d,e,f){this._cmd(a,-b,-c,d,e,-f,"cm")},_png:function(a){if("data:image/png;base64,"!== +a.substr(0,22))return{error:"Not a base64-encoded PNG file"};a=Wd(a.substr(22));var b=Xd(a);console.log("PNG chunks:",b.map(function(a){return a.type}));if("IHDR"!==b[0].type)throw Error("Image does not start with an IHDR");var c=b[0].data;a=(c[0]<<24|c[1]<<16|c[2]<<8|c[3])>>>0;var d=(c[4]<<24|c[5]<<16|c[6]<<8|c[7])>>>0,e=c[8],f=c[9],g=0===(f&2),l=0!==(f&4),k=c[10],m=c[11],c=c[12];if(0!==k)throw Error("Unsupported PNG compression method: "+k);if(0!==m)throw Error("Unsupported PNG filter method: "+ +m);if(0!==c)return{error:"Interlaced image not supported"};if(0!==(f&1))return{error:"Indexed PNG image not supported"};m=null;f=g?1:3;k=b.filter(function(a){return"IDAT"===a.type}).map(function(a){return a.data});if(l){l=window.pako;m=new l.Inflate;for(b=0;b>>3;if(m.length!==d*(a*(f+1)*c+1))throw Error("Data length mismatch");for(var n=f*c,k=new Uint8Array(d*(a*n+1)),p=new Uint8Array(d*(a*c+1)),q=0,t=0,u=0,v=0;v< +d;++v){k[t++]=p[u++]=m[q++];for(var w=0;w>"},_obj:function(a,b){b||(b=this._nextIndex++);Array.isArray(a)||(a=[this._dict(a)]); +a.index=b;a.ref=b+" 0 R";a.offset=this._offset;var c=0;a.unshift(b+" 0 obj\n");a.push("\nendobj\n");for(var d=0;d("number"===typeof f.narrow?f.narrow:20)/p)continue}else if("C"===f.kind)m=u.csnames[f.args[0]],n=f.radius,k=l.div(m.homog.value[0],m.homog.value[2]).value.real, +m=l.div(m.homog.value[1],m.homog.value[2]).value.real,k-=a.x,m-=a.y,n=Math.sqrt(k*k+m*m)-n.value.real,m=k=0,0>n&&(n=-n),n+=30/p;else if("L"===f.kind)k=f.homog,n=l,m=n.add(n.mult(k.value[0],n.conjugate(k.value[0])),n.mult(k.value[1],n.conjugate(k.value[1]))),m=g.scaldiv(n.sqrt(m),k),n=m.value[0].value.real*a.x+m.value[1].value.real*a.y+m.value[2].value.real,k=-m.value[0].value.real*n,m=-m.value[1].value.real*n,0>n&&(n=-n),n+=25/p;else if("Text"===f.kind){if(!f.homog||f.dock||!f._bbox)continue;m=z.from(a.x, +a.y,1);k=Math.max(0,m[0]-f._bbox.right,f._bbox.left-m[0]);m=Math.max(0,m[1]-f._bbox.bottom,f._bbox.top-m[1]);n=Math.sqrt(k*k+m*m);if(20Math.abs(d-a)&&.2>Math.abs(e-c)&&(b=g.realVector([d,e,1]))}return g.normalizeMax(b)};m.Free.getParamFromState=function(a){return Z(3)};m.Free.putParamToState=function(a,b){T(b)};m.Free.updatePosition=function(a){var b=Z(3);T(b);a.homog=w.withUsage(b, +"Point")};m.Free.stateSize=6;m._helper.projectPointToLine=function(a,b){var c=g.turnIntoCSList([b.value[0],b.value[1],l.zero]),c=g.cross(c,a);return g.normalizeMax(g.cross(c,b))};m.PointOnLine={};m.PointOnLine.kind="P";m.PointOnLine.signature=["L"];m.PointOnLine.isMovable=!0;m.PointOnLine.initialize=function(a){var b=m._helper.initializePoint(a);a=u.csnames[a.args[0]].homog;var b=m._helper.projectPointToLine(b,a),b=g.normalizeMax(b),c=g.cross(g.linfty,b);g.normalizeMax(c);T(b);T(a);fb=!1};m.PointOnLine.updatePosition= +function(a,b){var c,d=u.csnames[a.args[0]].homog;c=Z(3);Z(3);if(!b){va=a.stateIdx;var e=ma;ma=za;var f=Z(3),l=Z(3);ma=e;e=g.cross(l,d);g._helper.isAlmostZero(e)&&(e=g.cross(g.linfty,d));f=m._helper.CircleMP(e,f);f=m._helper.IntersectLC(d,f);e=m._helper.pointReflection(e,c);c=Ad(f[0],f[1],c,e)[0]}c=g.normalizeMax(c);T(c);T(d);a.homog=w.withUsage(c,"Point")};m.PointOnLine.getParamForInput=function(a,b,c){return b=m._helper.projectPointToLine(b,u.csnames[a.args[0]].homog)};m.PointOnLine.getParamFromState= +function(a){return Z(3)};m.PointOnLine.putParamToState=function(a,b){return T(b)};m.PointOnLine.stateSize=12;m.PointOnCircle={};m.PointOnCircle.kind="P";m.PointOnCircle.signature=["C"];m.PointOnCircle.isMovable=!0;m.PointOnCircle.initialize=function(a){var b=u.csnames[a.args[0]];a=g.normalizeZ(m._helper.initializePoint(a));var c=g.normalizeZ(m._helper.CenterOfCircle(b.matrix)),d=g.sub(a,c),d=g.turnIntoCSList([d.value[1],l.neg(d.value[0]),l.zero]),c=g.cross(a,c),b=m._helper.IntersectLC(c,b.matrix), +c=g.projectiveDistMinScal(a,b[0]);g.projectiveDistMinScal(a,b[1])l.sub(l.mult(a.value[0],c.value[1]),l.mult(a.value[1],c.value[0])).value.real&& +(b=g.neg(b));return g.turnIntoCSList([b.value[1],l.neg(b.value[0]),l.zero])};m.PointOnCircle.parameterPath=function(a,b,c,d,e){d=g.normalizeAbs(d);e=g.normalizeAbs(e);var f=g.scalproduct(d,e);if(0<=f.value.real)return xd(a,b,c,d,e);a=g.turnIntoCSList([l.sub(d.value[1],e.value[1]),l.sub(e.value[0],d.value[0]),l.zero]);f=g.scalproduct(d,a);0>f.value.real&&(a=g.neg(a));0>b?(b=2*b+1,c=b*b,f=.25/(1+c),c=l.complex(2*b*f+.25,(1-c)*f)):(b=2*b-1,c=b*b,f=.25/(1+c),c=l.complex(2*b*f+.75,(1-c)*f));var k=l.sub(l.real(1), +c);b=l.mult(c,c);f=l.mult(k,k);c=l.mult(c,k);d=g.scalmult(f,d);d=g.add(d,g.scalmult(c,a));return d=g.add(d,g.scalmult(b,e))};m.PointOnCircle.updatePosition=function(a){var b=Z(3);T(b);var c=u.csnames[a.args[0]],b=g.productMV(c.matrix,b),c=m._helper.IntersectLC(b,c.matrix),c=Na(c[0],c[1]),b=g.normalizeMax(c.value[0]);a.homog=w.withUsage(b,"Point");a.antipodalPoint=c.value[1]};m.PointOnCircle.stateSize=6+Na.stateSize;m.OtherPointOnCircle={};m.OtherPointOnCircle.kind="P";m.OtherPointOnCircle.signature= +["P"];m.OtherPointOnCircle.signatureConstraints=function(a){return"PointOnCircle"===u.csnames[a.args[0]].type};m.OtherPointOnCircle.updatePosition=function(a){var b=u.csnames[a.args[0]].antipodalPoint,b=g.normalizeMax(b);a.homog=w.withUsage(b,"Point")};m.PointOnSegment={};m.PointOnSegment.kind="P";m.PointOnSegment.signature=["S"];m.PointOnSegment.isMovable=!0;m.PointOnSegment.initialize=function(a){var b=m._helper.initializePoint(a);a=m.PointOnSegment.getParamForInput(a,b);Va(a)};m.PointOnSegment.getParamForInput= +function(a,b){var c=u.csnames[a.args[0]],d=c.homog,d=g.turnIntoCSList([d.value[0],d.value[1],l.zero]),e=g.sub(c.startpos,c.endpos),c=g.crossratio3(e,c.startpos,c.endpos,b,d);0>c.value.real&&(c=l.complex(0,c.value.imag));1d.value.real&&(c=-1>d.value.real?g.realVector([1,0]):g.realVector([0,1]));return c};m.PointOnArc.getParamFromState=function(a){return Z(2)}; +m.PointOnArc.putParamToState=function(a,b){T(b)};m.PointOnArc.updatePosition=function(a){var b=u.csnames[a.args[0]],c=b.startPoint,d=b.viaPoint,e=b.endPoint,f=g.ii,k=g.cross(c,f),d=g.cross(d,f),n=g.cross(e,f),n=g.turnIntoCSList([k,n]),k=g.transpose(n),n=g.conjugate(n),k=g.productMM(n,k),d=g.productMV(n,d),k=g.productMV(g.adjoint2(k),d),d=k.value[0],k=k.value[1],n=Z(2);T(n);c=g.normalizeMax(g.add(g.scalmult(l.mult(d,n.value[0]),c),g.scalmult(l.mult(k,n.value[1]),e)));b=m._helper.conicOtherIntersection(b.matrix, +f,c);a.homog=w.withUsage(b,"Point")};m.PointOnArc.stateSize=4;m._helper.CenterOfCircle=function(a){return g.turnIntoCSList([a.value[2].value[0],a.value[2].value[1],l.neg(a.value[0].value[0])])};m._helper.CenterOfConic=function(a){a=g.adjoint3(a);return{ctype:"list",value:[a.value[2].value[0],a.value[2].value[1],a.value[2].value[2]]}};m.CenterOfConic={};m.CenterOfConic.kind="P";m.CenterOfConic.signature=["C"];m.CenterOfConic.updatePosition=function(a){var b=m._helper.CenterOfConic(u.csnames[a.args[0]].matrix); +a.homog=b;a.homog=g.normalizeMax(a.homog);a.homog=w.withUsage(a.homog,"Point")};m._helper.CircleMP=function(a,b){var c=a.value[0],d=a.value[1],e=l.neg(a.value[2]),f=l.zero,c=g.turnIntoCSList([g.turnIntoCSList([e,f,c]),g.turnIntoCSList([f,e,d]),g.turnIntoCSList([c,d,f])]),e=w.mult(w.mult(b,c),b),d=w.mult(w.mult(b,g.fund),b),e=w.mult(e,g.fund),c=w.mult(d,c);return g.sub(e,c)};m.CircleMP={};m.CircleMP.kind="C";m.CircleMP.signature=["P","P"];m.CircleMP.updatePosition=function(a){a.matrix=m._helper.CircleMP(u.csnames[a.args[0]].homog, +u.csnames[a.args[1]].homog);a.matrix=g.normalizeMax(a.matrix);a.matrix=w.withUsage(a.matrix,"Circle")};m.CircleMr={};m.CircleMr.kind="C";m.CircleMr.signature=["P"];m.CircleMr.isMovable=!0;m.CircleMr.initialize=function(a){Va(l.real(a.radius))};m.CircleMr.getParamForInput=function(a,b,c){if("radius"===c)return b;a=u.csnames[a.args[0]].homog;a=g.normalizeZ(a);b=g.normalizeZ(b);b=g.sub(a,b);return b=g.abs(b)};m.CircleMr.getParamFromState=function(a){return wb()};m.CircleMr.putParamToState=function(a, +b){Va(b)};m.CircleMr.updatePosition=function(a){var b=wb();Va(b);var c=u.csnames[a.args[0]].homog,d=l.mult(c.value[2],b),d=l.mult(d,d);if(!l._helper.isFinite(d)&&!l._helper.isNaN(d))return g.fund;c=m._helper.ScaledCircleMrr(c,d);a.matrix=w.withUsage(c,"Circle");a.radius=b};m.CircleMr.stateSize=2;m.CircleMr.set_radius=function(a,b){"number"===b.ctype&&Ia(a,b,"radius")};m._helper.ScaledCircleMrr=function(a,b){var c=a.value[0],d=a.value[1],e=l.neg(a.value[2]),e=g.scalmult(e,g.turnIntoCSList([c,d,e])).value, +c=g.turnIntoCSList([c,d]),c=l.sub(g.scalproduct(c,c),b),e=m._helper.buildConicMatrix([e[2],l.zero,e[2],e[0],e[1],c]);return g.normalizeMax(e)};m.Compass={};m.Compass.kind="C";m.Compass.signature=["P","P","P"];m.Compass.updatePosition=function(a){var b=u.csnames[a.args[0]].homog,c=u.csnames[a.args[1]].homog,d=u.csnames[a.args[2]].homog,e=b.value[2],f=c.value[2],k=d.value[2],b=g.scalmult(l.mult(f,k),b),c=g.scalmult(l.mult(e,k),c),d=g.scalmult(l.mult(e,f),d),b=g.sub(c,b),d=m._helper.ScaledCircleMrr(d, +g.scalproduct(b,b));a.matrix=w.withUsage(d,"Circle")};m._helper.getConicType=function(a){if(1E-16>l.abs(g.det(a)).value.real)return"degenerate";var b=l.mult(a.value[0].value[0],a.value[1].value[1]),b=l.sub(b,l.pow(a.value[0].value[1],l.real(2))),b=b.value.real;return 1E-16>Math.abs(b)?"parabola":1E-16c;++c)for(var d=0;d<=c;++d)Va(b.value[c].value[d])};m.FreeConic.updatePosition=function(a){var b=Z(6);T(b);a.matrix=m._helper.buildConicMatrix(b.value);a.matrix=g.normalizeMax(a.matrix);a.matrix=w.withUsage(a.matrix,"Conic")};m.FreeConic.set_matrix=function(a,b){g._helper.isNumberMatrixMN(b,3,3)&&Ia(a,g.add(b,g.transpose(b)),"matrix")};m.FreeConic.stateSize=12;m._helper.buildConicMatrix=function(a){var b=a[1],c=a[2],d=a[3],e=a[4],f=a[5];return g.turnIntoCSList([g.turnIntoCSList([a[0], +b,d]),g.turnIntoCSList([b,c,e]),g.turnIntoCSList([d,e,f])])};m._helper.splitDegenConic=function(a){var b=g.adjoint3(a),c=0,d,e,f=l.abs2(b.value[0].value[0]).value.real;for(d=1;3>d;d++)e=l.abs2(b.value[d].value[d]).value.real,e>f&&(c=d,f=e);d=l.sqrt(l.mult(l.real(-1),b.value[c].value[c]));if(1E-16>l.abs2(d).value.real)return a=g.turnIntoCSList([l.zero,l.zero,l.zero]),[a,a];c=l.real(c+1);e=g.column(b,c);e=g.scaldiv(d,e);d=e.value[0];f=e.value[1];e=e.value[2];d=g.turnIntoCSList([g.turnIntoCSList([l.real(0), +e,l.mult(l.real(-1),f)]),g.turnIntoCSList([l.mult(l.real(-1),e),l.real(0),d]),g.turnIntoCSList([f,l.mult(l.real(-1),d),l.real(0)])]);a=g.add(a,d);var k=0;for(d=f=b=0;3>d;d++)for(c=0;3>c;c++)e=l.abs2(a.value[d].value[c]).value.real,e>f&&(k=d,b=c,f=e);d=a.value[k];a=g.transpose(a);a=a.value[b];d=g.normalizeMax(d);a=g.normalizeMax(a);d=w.withUsage(d,"Line");a=w.withUsage(a,"Line");return[d,a]};m._helper.inputConic=function(a){var b="xx xy yy xz yz zz".split(" ").map(function(b){var d=l._helper.input(a[b]); +b[0]!==b[1]&&(d=l.realmult(.5,d));return d});return m._helper.buildConicMatrix(b)};m.SelectConic={};m.SelectConic.kind="C";m.SelectConic.signature=["Cs"];m.SelectConic.initialize=function(a){if(void 0!==a.index)return a.index-1;var b=m._helper.inputConic(a.pos);a=u.csnames[a.args[0]].results;for(var c=g.conicDist(b,a[0]),d=0,e=1;eq;++q){var u=(q&2)-1,v=d(l.real(((q&1)<<1)-1),n),w=d(l.real(u),p),x=f(e,v,k,w),y=f(b,w,a, +v),u=f(a,e,b,k),z=l.add(l.add(f(b,k,a,e),f(k,w,e,v)),f(w,b,v,a)),v=d(x,x),w=d(y,y),A=d(z,z),B=d(x,y),x=d(x,z),y=d(y,z),B=l.sub(B,d(l.real(.5),d(u,u))),u=g.turnIntoCSList([g.turnIntoCSList([v,B,x]),g.turnIntoCSList([B,w,y]),g.turnIntoCSList([x,y,A])]),u=g.productMM(m,g.productMM(u,c)),u=g.turnIntoCSList([u.value[0].value[0],u.value[0].value[1],u.value[0].value[2],u.value[1].value[1],u.value[1].value[2],u.value[2].value[2]]);t[q]=u}return t};m.ConicBy3p2l={};m.ConicBy3p2l.kind="Cs";m.ConicBy3p2l.signature= +["P","P","P","L","L"];m.ConicBy3p2l.updatePosition=function(a){for(var b=m._helper.ConicBy3p2l(u.csnames[a.args[0]].homog,u.csnames[a.args[1]].homog,u.csnames[a.args[2]].homog,u.csnames[a.args[3]].homog,u.csnames[a.args[4]].homog),b=Bd(b),c=Array(4),d=0;4>d;++d){var e=b[d].value;c[d]=g.turnIntoCSList([g.turnIntoCSList([e[0],e[1],e[2]]),g.turnIntoCSList([e[1],e[3],e[4]]),g.turnIntoCSList([e[2],e[4],e[5]])])}a.results=c};m.ConicBy3p2l.stateSize=48;m.ConicBy2p3l={};m.ConicBy2p3l.kind="Cs";m.ConicBy2p3l.signature= +["P","P","L","L","L"];m.ConicBy2p3l.updatePosition=function(a){for(var b=m._helper.ConicBy3p2l(u.csnames[a.args[2]].homog,u.csnames[a.args[3]].homog,u.csnames[a.args[4]].homog,u.csnames[a.args[0]].homog,u.csnames[a.args[1]].homog),b=Bd(b),c=Array(4),d=0;4>d;++d){var e=b[d].value,e=g.turnIntoCSList([g.turnIntoCSList([e[0],e[1],e[2]]),g.turnIntoCSList([e[1],e[3],e[4]]),g.turnIntoCSList([e[2],e[4],e[5]])]);c[d]=g.normalizeMax(g.adjoint3(e))}a.results=c};m.ConicBy2p3l.stateSize=48;m.ConicBy1p4l={};m.ConicBy1p4l.kind= +"Cs";m.ConicBy1p4l.signature=["P","L","L","L","L"];m.ConicBy1p4l.updatePosition=function(a){var b=m._helper.ConicBy4p1l(a,u.csnames[a.args[1]].homog,u.csnames[a.args[2]].homog,u.csnames[a.args[3]].homog,u.csnames[a.args[4]].homog,u.csnames[a.args[0]].homog),c=b[0],b=b[1],c=g.adjoint3(c),b=g.adjoint3(b),b=[c,b];a.results=b};m.ConicBy1p4l.stateSize=Na.stateSize;m.ConicParabolaPL={};m.ConicParabolaPL.kind="C";m.ConicParabolaPL.signature=["P","L"];m.ConicParabolaPL.updatePosition=function(a){var b=u.csnames[a.args[0]].homog.value, +c=u.csnames[a.args[1]].homog.value,d=l.mult,e=l.neg,f=l.add,k=l.sub,n=b[0],p=b[1],q=b[2],t=c[0],b=c[1],c=c[2],v=d(q,q),x=d(t,t),y=d(b,b),z=d(q,c),A=e(q),q=f(x,y),y=d(v,y),x=d(v,x),e=d(e(v),d(t,b)),t=d(A,f(d(n,q),d(z,t))),b=d(A,f(d(p,q),d(z,b))),d=k(d(f(d(n,n),d(p,p)),q),d(v,d(c,c))),d=m._helper.buildConicMatrix([y,e,x,t,b,d]),d=g.normalizeMax(d);a.matrix=w.withUsage(d,"Conic")};m.ConicBy2Foci1P={};m.ConicBy2Foci1P.kind="Cs";m.ConicBy2Foci1P.signature=["P","P","P"];m.ConicBy2Foci1P.updatePosition= +function(a){var b=u.csnames[a.args[0]].homog,c=u.csnames[a.args[1]].homog,d=u.csnames[a.args[2]].homog,e=g.ii,f=g.jj,k=g.normalizeMax(g.cross(b,d)),n=g.normalizeMax(g.cross(c,d)),p=g.normalizeMax(g.cross(d,e)),d=g.normalizeMax(g.cross(d,f)),n=m._helper.coHarmonic(p,d,k,n),k=g.normalizeMax(n[0]),n=g.normalizeMax(n[1]),e=g.turnIntoCSList([e]),p=g.turnIntoCSList([f]),d=g.turnIntoCSList([b]),q=g.turnIntoCSList([c]),f=m._helper.conicFromTwoDegenerates(e,p,d,q,k),f=g.normalizeMax(f),e=m._helper.conicFromTwoDegenerates(e, +p,d,q,n),e=g.normalizeMax(e),f=g.normalizeMax(g.adjoint3(f)),e=g.normalizeMax(g.adjoint3(e));"ellipsoid"!==m._helper.getConicType(f)&&(k=f,f=e,e=k);g.almostequals(b,c).value&&(b=l.real(3),e=g.zeromatrix(b,b));a.results=[f,e]};m.ConicBy2Pol1P={};m.ConicBy2Pol1P.kind="C";m.ConicBy2Pol1P.signature=["P","L","P","L","P"];m.ConicBy2Pol1P.updatePosition=function(a){var b=u.csnames[a.args[0]].homog,c=u.csnames[a.args[1]].homog,d=u.csnames[a.args[2]].homog,e=u.csnames[a.args[3]].homog,f=u.csnames[a.args[4]].homog, +k=g.scalproduct,m=g.scalmult,n=g.sub,p=g.productMM,q=l.realmult,t=g.transpose,v=g.turnIntoCSList,x=n(m(k(c,b),f),m(q(2,k(c,f)),b)),y=n(m(k(e,d),f),m(q(2,k(e,f)),d)),z=v([g.cross(b,f)]),f=v([g.cross(d,f)]),y=p(t(z),v([g.cross(b,y)])),v=p(t(f),v([g.cross(d,x)])),p=p(t(z),f),b=k(b,e),c=k(d,c),d=g.add(m(c,y),m(b,v)),d=n(d,m(q(2,l.mult(b,c)),p)),d=g.add(d,t(d)),d=g.normalizeMax(d),d=w.withUsage(d,"Conic");a.matrix=d};m.ConicBy2Pol1L={};m.ConicBy2Pol1L.kind="C";m.ConicBy2Pol1L.signature=["P","L","P","L", +"L"];m.ConicBy2Pol1L.updatePosition=function(a){var b=u.csnames[a.args[0]].homog,c=u.csnames[a.args[1]].homog,d=u.csnames[a.args[2]].homog,e=u.csnames[a.args[3]].homog,f=u.csnames[a.args[4]].homog,k=g.scalproduct,m=g.scalmult,n=g.productMM,p=l.mult,q=g.transpose,t=g.turnIntoCSList,v=k(c,b),x=k(c,d),y=k(e,b),z=k(e,d),A=k(f,b),k=k(f,d),B=t([g.sub(m(p(y,k),c),m(p(x,A),e))]),b=g.add(n(q(t([m(p(y,x),f)])),t([g.sub(g.add(m(l.sub(p(v,k),p(x,A)),e),m(l.sub(p(z,A),p(y,k)),c)),m(g.det3(c,e,f),g.cross(b,d)))])), +n(q(B),B)),b=g.add(b,q(b)),b=g.normalizeMax(b),b=w.withUsage(b,"Conic");a.matrix=b};m._helper.conic1Pol3Inc=function(a,b,c,d,e){var f=g.scalproduct,k=g.scalmult,m=g.productMM,n=g.cross,p=l.realmult,q=l.mult,t=g.transpose,u=g.turnIntoCSList,v=g.det3,w=v(a,c,d),x=u([n(c,e)]),y=u([n(a,e)]),z=u([n(c,d)]),A=f(b,a),B=f(b,c);b=f(b,e);n=u([n(d,g.sub(k(A,e),k(p(2,b),a)))]);x=k(w,m(t(x),n));a=p(2,l.add(q(v(a,d,e),B),q(w,b)));a=l.sub(q(v(c,d,e),A),a);x=g.add(x,k(a,m(t(y),z)));x=g.add(x,t(x));return x=g.normalizeMax(x)}; +m.ConicBy1Pol3P={};m.ConicBy1Pol3P.kind="C";m.ConicBy1Pol3P.signature=["P","L","P","P","P"];m.ConicBy1Pol3P.updatePosition=function(a){var b=m._helper.conic1Pol3Inc(u.csnames[a.args[0]].homog,u.csnames[a.args[1]].homog,u.csnames[a.args[2]].homog,u.csnames[a.args[3]].homog,u.csnames[a.args[4]].homog),b=w.withUsage(b,"Conic");a.matrix=b};m.ConicBy1Pol3L={};m.ConicBy1Pol3L.kind="C";m.ConicBy1Pol3L.signature=["P","L","L","L","L"];m.ConicBy1Pol3L.updatePosition=function(a){var b=m._helper.conic1Pol3Inc(u.csnames[a.args[1]].homog, +u.csnames[a.args[0]].homog,u.csnames[a.args[2]].homog,u.csnames[a.args[3]].homog,u.csnames[a.args[4]].homog),b=g.normalizeMax(g.adjoint3(b)),b=w.withUsage(b,"Conic");a.matrix=b};m._helper.coHarmonic=function(a,b,c,d){var e=g.realVector([100*Math.random(),100*Math.random(),1]),f=g.det3(e,c,a),k=g.det3(e,c,b);c=g.det3(e,d,a);d=g.det3(e,d,b);d=l.sqrt(l.mult(d,k));f=l.sqrt(l.mult(c,f));a=w.mult(a,d);f=w.mult(b,f);b=g.add(a,f);a=g.sub(a,f);return[b,a]};m.ConicInSquare={};m.ConicInSquare.kind="C";m.ConicInSquare.signature= +["P","P","P","P"];m.ConicInSquare.updatePosition=function(a){var b=D.basismap(u.csnames[a.args[0]].homog,u.csnames[a.args[1]].homog,u.csnames[a.args[2]].homog,u.csnames[a.args[3]].homog),c=l.one,c=m._helper.buildConicMatrix([c,c,c,l.real(-3),c,c]),b=g.adjoint3(b),b=g.productMM(g.productMM(g.transpose(b),c),b),b=g.normalizeMax(b);a.matrix=w.withUsage(b,"Conic")};m.ConicBy5lines={};m.ConicBy5lines.kind="C";m.ConicBy5lines.signature=["L","L","L","L","L"];m.ConicBy5lines.updatePosition=function(a){var b= +m._helper.ConicBy5(a,u.csnames[a.args[0]].homog,u.csnames[a.args[1]].homog,u.csnames[a.args[2]].homog,u.csnames[a.args[3]].homog,u.csnames[a.args[4]].homog),b=g.adjoint3(b);a.matrix=b;a.matrix=g.normalizeMax(a.matrix);a.matrix=w.withUsage(a.matrix,"Conic")};m.ConicFromPrincipalDirections={};m.ConicFromPrincipalDirections.kind="C";m.ConicFromPrincipalDirections.signature=["P","P","P"];m.ConicFromPrincipalDirections.updatePosition=function(a){var b=u.csnames[a.args[0]].homog,c=u.csnames[a.args[1]].homog, +d=u.csnames[a.args[2]].homog,e=m._helper.pointReflection(b,c),f=g.cross(c,b),b=g.turnIntoCSList([f.value[0],f.value[1],l.zero]),f=g.turnIntoCSList([f]),c=g.turnIntoCSList([g.cross(c,b)]),e=g.turnIntoCSList([g.cross(e,b)]);a.matrix=m._helper.conicFromTwoDegenerates(f,f,c,e,d);a.matrix=g.normalizeMax(a.matrix);a.matrix=w.withUsage(a.matrix,"Conic")};m.CircleBy3={};m.CircleBy3.kind="C";m.CircleBy3.signature=["P","P","P"];m.CircleBy3.updatePosition=function(a){var b=m._helper.ConicBy5(a,u.csnames[a.args[0]].homog, +u.csnames[a.args[1]].homog,g.ii,g.jj,u.csnames[a.args[2]].homog);a.matrix=g.normalizeMax(b);a.matrix=w.withUsage(a.matrix,"Circle")};m.ArcBy3={};m.ArcBy3.kind="C";m.ArcBy3.signature=["P","P","P"];m.ArcBy3.updatePosition=function(a){m.CircleBy3.updatePosition(a);a.startPoint=u.csnames[a.args[0]].homog;a.viaPoint=u.csnames[a.args[1]].homog;a.endPoint=u.csnames[a.args[2]].homog};m.ArcBy3.initialize=function(a){a.startPoint=u.csnames[a.args[0]].homog;a.viaPoint=u.csnames[a.args[1]].homog;a.endPoint=u.csnames[a.args[2]].homog; +a.isArc=!0};m.PolarOfPoint={};m.PolarOfPoint.kind="L";m.PolarOfPoint.signature=["P","C"];m.PolarOfPoint.updatePosition=function(a){var b=w.mult(u.csnames[a.args[1]].matrix,u.csnames[a.args[0]].homog),b=g.normalizeMax(b);a.homog=w.withUsage(b,"Line")};m.PolarOfLine={};m.PolarOfLine.kind="P";m.PolarOfLine.signature=["L","C"];m.PolarOfLine.updatePosition=function(a){var b=u.csnames[a.args[0]],c=g.adjoint3(u.csnames[a.args[1]].matrix),b=w.mult(c,b.homog),b=g.normalizeMax(b);a.homog=w.withUsage(b,"Point")}; +m.AngleBisector={};m.AngleBisector.kind="Ls";m.AngleBisector.signature=["L","L","P"];m.AngleBisector.updatePosition=function(a){var b=u.csnames[a.args[0]].homog,c=u.csnames[a.args[1]].homog,d=u.csnames[a.args[2]].homog,e=g.add,f=g.sub,k=g.abs,l=g.cross,m=g.scalmult,n=g.normalizeMax,p=g._helper.isAlmostZero,q=g.linfty,t=m(k(l(l(q,c),q)),b),b=m(k(l(l(q,b),q)),c),f=f(t,b),e=e(t,b);p(f)&&(f=l(l(l(q,e),q),d));p(e)&&(e=l(l(l(q,f),q),d));a.results=Na(n(f),n(e))};m.AngleBisector.stateSize=Na.stateSize;m._helper.IntersectLC= +function(a,b){var c=l,d=g.crossOperator(a),e=g.transpose(d),e=w.mult(e,w.mult(b,d)),f=g.maxIndex(a,l.abs2),k,m,n,p;0===f?(f=e.value[1].value[1],k=e.value[1].value[2],m=e.value[2].value[1],n=e.value[2].value[2],p=a.value[0]):1===f?(f=e.value[0].value[0],k=e.value[0].value[2],m=e.value[2].value[0],n=e.value[2].value[2],p=a.value[1]):(f=e.value[0].value[0],k=e.value[0].value[1],m=e.value[1].value[0],n=e.value[1].value[1],p=a.value[2]);c=c.div(c.sqrt(c.sub(c.mult(k,m),c.mult(f,n))),p);c=g.add(e,g.scalmult(c, +d));f=g.maxIndex(c,g.abs2);d=c.value[f];d=g.normalizeMax(d);d=w.withUsage(d,"Point");c=g.transpose(c);f=g.maxIndex(c,g.abs2);c=c.value[f];c=g.normalizeMax(c);c=w.withUsage(c,"Point");return[d,c]};m.IntersectLC={};m.IntersectLC.kind="Ps";m.IntersectLC.signature=["L","C"];m.IntersectLC.updatePosition=function(a){var b=m._helper.IntersectLC(u.csnames[a.args[0]].homog,u.csnames[a.args[1]].matrix);a.results=Na(b[0],b[1])};m.IntersectLC.stateSize=Na.stateSize;m.OtherIntersectionCL={};m.OtherIntersectionCL.kind= +"P";m.OtherIntersectionCL.signature=["C","L","P"];m.OtherIntersectionCL.updatePosition=function(a){var b=u.csnames[a.args[2]].homog,c=m._helper.IntersectLC(u.csnames[a.args[1]].homog,u.csnames[a.args[0]].matrix),d=c[0],c=c[1],e=g.projectiveDistMinScal(d,b),b=g.projectiveDistMinScal(c,b);a.homog=en?(p=a,c=b):(q=l.solveCubic(p,q,c,f),c=l.abs2(l.sub(q[0],q[1])).value.real,f=l.abs2(l.sub(q[0],q[2])).value.real,k=l.abs2(l.sub(q[1],q[2])).value.real,c>f?(p= +q[1],q=c>k?q[0]:q[2]):(p=q[2],q=f>k?q[0]:q[1]),p=g.add(g.scalmult(p,a),b),c=g.add(g.scalmult(q,a),b));q=m._helper.splitDegenConic(p);p=q[0];q=q[1];c=m._helper.splitDegenConic(c);k=c[0];f=c[1];c=g.cross(p,k);k=g.cross(q,k);p=g.cross(p,f);q=g.cross(q,f);c=g.normalizeMax(c);k=g.normalizeMax(k);p=g.normalizeMax(p);q=g.normalizeMax(q);c=w.withUsage(c,"Point");k=w.withUsage(k,"Point");p=w.withUsage(p,"Point");q=w.withUsage(q,"Point");return[c,k,p,q]};m.IntersectConicConic={};m.IntersectConicConic.kind= +"Ps";m.IntersectConicConic.signature=["C","C"];m.IntersectConicConic.updatePosition=function(a){var b=m._helper.IntersectConicConic(u.csnames[a.args[0]].matrix,u.csnames[a.args[1]].matrix),b=xc(b[0],b[1],b[2],b[3]);a.results=b};m.IntersectConicConic.stateSize=xc.stateSize;m.SelectP={};m.SelectP.kind="P";m.SelectP.signature=["Ps"];m.SelectP.initialize=function(a){if(void 0!==a.index)return a.index-1;var b=u.csnames[a.args[0]].results.value;a=m._helper.initializePoint(a);for(var c=g.projectiveDistMinScal(a, +b[0]),d=0,e=1;ea&&c>.999*a;)b=ra.oneRKStep(b),c+=b,b=Math.min(2*b,a-c),b=Math.max(b,1E-16),ra.restorePosition(),ra.doCollisions(),ra.calculateForces(),ra.moveToFinalPos();return!0};ra.restorePosition=function(){Ba.forEach(function(a){O[a.type].restorePos(a,9)})};ra.doCollisions=function(){Ba.forEach(function(a){O[a.type].doCollisions(a)})};ra.calculateForces=function(){Ba.forEach(function(a){O[a.type].calculateForces(a)})};ra.moveToFinalPos=function(){Ba.forEach(function(a){O[a.type].move(a)})};ra.oneRKStep= +function(a){for(var b=function(a){Ba.forEach(function(b){O[b.type].initRK(b,a);O[b.type].storePosition(b)})},c=function(a){Ba.forEach(function(b){O[b.type].setToTimestep(b,Ib[a])})},d=function(a){Ba.forEach(function(b){O[b.type].proceedMotion(b,Ib[a],a,Jd[a])})},e=function(){Ba.forEach(function(a){O[a.type].resetForces(a)})},f=function(a){Ba.forEach(function(b){O[b.type].calculateDelta(b,a)})},g=function(b){var c=0;Ba.forEach(function(a){O[a.type].proceedMotion(a,Ib[6],7,Kd);O[a.type].savePos(a,8); +O[a.type].proceedMotion(a,Ib[6],7,Ld);O[a.type].savePos(a,9);c+=O[a.type].sqDist(a,8,9)});return c=Math.sqrt(c)/a},k=function(a){Ba.forEach(function(a){O[a.type].recallPosition(a)})},l=!1;!l;){b(a);for(var m=0;7>m;m++)c(m),d(m),e(),ra.calculateForces(),f(m);g(a)>O.env.errorbound&&a>O.env.lowestdeltat?(a/=O.env.slowdownfactor,k()):l=!0}return a};var O={Mass:{reset:function(a,b){a.vel=[0,0,0];a.pos=[0,0,0,0];a.el=b;"undefined"===typeof a.mass&&(a.mass=1);"undefined"===typeof a.charge&&(a.charge=0); +"undefined"===typeof a.friction&&(a.friction=0);a.lnfrict=0;"undefined"===typeof a.limitspeed&&(a.limitspeed=!1);"undefined"===typeof a.fixed&&(a.fixed=!1);"undefined"===typeof a.radius&&(a.radius=1);a.internalmove=!1;a.fx=0;a.fy=0;a.fz=0;a.vx=a.vx||0;a.vy=a.vy||0;a.vz=a.vz||0;a.mtype=0;a.env=O.env;a.deltat=0;a.mx=0;a.my=0;a.mz=0;a.mvx=0;a.mvy=0;a.mvz=0;a.dx=[0,0,0,0,0,0,0,0,0,0];a.dy=[0,0,0,0,0,0,0,0,0,0];a.dz=[0,0,0,0,0,0,0,0,0,0];a.dvx=[0,0,0,0,0,0,0,0,0,0];a.dvy=[0,0,0,0,0,0,0,0,0,0];a.dvz=[0, +0,0,0,0,0,0,0,0,0];a.midx=0;a.midy=0;a.midz=0;a.lx=0;a.ly=0;a.lz=0},resetForces:function(a){a.fx=0;a.fy=0;a.fz=0},getBlock:!1,setToTimestep:function(a,b,c){},initRK:function(a,b){var c=D.extractPoint(a.el.homog);a.x=c.x;a.y=c.y;a.z=0;a.xo=a.x;a.yo=a.y;a.zo=a.z;a.vxo=a.vx;a.vyo=a.vy;a.vzo=a.vz;a.deltat=b;a.fx=0;a.fy=0;a.fz=0},setVelocity:function(a,b,c,d){d||(d=0);a.vx=b;a.vy=c;a.vz=d},move:function(a){a.pos=[a.x,a.y,1];a.internalmove=!0;fa&&X.down&&a.el===fa.mover||Ia(a.el,g.realVector(a.pos),"homog"); +a.el.sx=a.x;a.el.sy=a.y;a.internalmove=!1},proceedMotion:function(a,b,c,d){if(!a.fixed)for(a.x=a.mx,a.y=a.my,a.z=a.mz,a.vx=a.mvx,a.vy=a.mvy,a.vz=a.mvz,b=0;bO.det(d,b,e,c,w,x)*O.det(d,b,e,c,y.value.real,y.value.imag)&&0>O.det(d,b,w,x,y.value.real,y.value.imag)*O.det(e,c,w,x,y.value.real,y.value.imag)&&(v=t.behavior.mvx+a.deltat*(-y.value.real+ +t.behavior.xo),w=t.behavior.mvy+a.deltat*(-y.value.imag+t.behavior.yo),u=p*v+n*w,v=n*v-p*w,t.behavior.x=y.value.real,t.behavior.y=y.value.imag,t.behavior.vx=p*u*(1-a.xdamp),t.behavior.vy=n*u*(1-a.xdamp),t.behavior.vx+=-n*v*(1-a.ydamp),t.behavior.vy+=p*v*(1-a.ydamp))}a.x1o=d;a.y1o=b;a.x2o=e;a.y2o=c}},Environment:{init:function(a){"undefined"===typeof a.gravity&&(a.gravity=0);"undefined"===typeof a.friction&&(a.friction=0);"undefined"===typeof a.springstrength&&(a.springstrength=1);"undefined"!==typeof a.accuracy&& +(Mb=a.accuracy);"undefined"!==typeof a.deltat&&sa(a.deltat/.6);"undefined"===typeof a.charges&&(a.charges=!1);"undefined"===typeof a.balls&&(a.balls=!1);"undefined"===typeof a.newton&&(a.newton=!1);"undefined"===typeof a.ballInteractionBoosting&&(a.ballInteractionBoosting=1);O.env=a;a.errorbound=.001;a.lowestdeltat=1E-7;a.slowdownfactor=2},reset:function(a){},resetForces:function(a){},getBlock:!1,setToTimestep:function(a,b,c){},initRK:function(a,b){},setVelocity:function(a,b,c,d){},move:function(a){}, +proceedMotion:function(a,b,c,d){},calculateForces:function(a){var b,c,d,e,f,g,k,l,m,n;if(a.newton)for(b=0;bm?0:(n-m)*(n-m)),l=(e-l)/(n*n*n)*(n>m?0:(n-m)*(n-m))):1===a.ballInteractionBoosting?(k=(d-k)/(n*n*n*n)*(n>m?0:(n-m)*(n-m)),l=(e-l)/(n*n*n*n)*(n>m?0:(n-m)*(n-m))):(k=(d-k)/(n*n*n*n*n)*(n>m?0:(n-m)*(n-m)),l=(e-l)/(n*n*n*n*n)*(n>m?0:(n-m)*(n-m))),c.behavior.fx+=k,c.behavior.fy+=l,g.behavior.fx-=k,g.behavior.fy-=l);for(b=0;b img { + margin: 0px; + padding: 0px; + border: none; + display: inline; + position: static; + vertical-align: baseline; + visibility: hidden; + margin-right: -1px; } + .CindyJS-widget .CindyJS-baseline .CindyJS-button { + display: inline-block; } + .CindyJS-widget .CindyJS-button { + position: relative; + z-index: 2; } + .CindyJS-widget .CindyJS-toolbar, .CindyJS-widget .CindyJS-animbuttons { + position: absolute; } + .CindyJS-widget .CindyJS-toolbar button, .CindyJS-widget .CindyJS-animbuttons button { + position: relative; + z-index: 3; } + .CindyJS-widget .CindyJS-animspeed { + position: relative; + z-index: 3; } + .CindyJS-widget .CindyJS-animcontrols { + bottom: 5px; + left: 5px; } + +.CindyJS-button input[type=checkbox] { + position: absolute; + left: -10000px; } + +.CindyJS-button button, .CindyJS-button label { + margin: -6px -7px; + padding: 5px 6px; + border-radius: 4px; } + +.CindyJS-button button:focus, .CindyJS-button input[type=checkbox]:focus + label { + box-shadow: 0px 0px 3px #06f, inset 1px 1px 2px #fff, inset -1px -1px 2px #aaa; } + +.CindyJS-button button:focus:active, .CindyJS-button input[type=checkbox]:focus:checked + label { + background-color: #aaafbb; + box-shadow: 0px 0px 3px #06f, inset 1px 1px 2px #999, inset -1px -1px 2px #ccc; } + +.CindyJS-editabletext { + border: 1px solid #000; + margin: -4px -4px -1px; + padding: 4px 4px 1px; } + .CindyJS-editabletext:focus { + box-shadow: 0px 0px 3px #06f; } + +.CindyJS-toolbar div { + line-height: 0px; } + +.CindyJS-toolbar span.CindyJS-spacer { + display: inline-block; + margin: 0px; + padding: 1px; + width: 32px; + height: 24px; } + +.CindyJS-animcontrols { + position: absolute; + background-color: #00f; + height: 36px; + width: 102px; } + .CindyJS-animcontrols .CindyJS-animspeed { + height: 10px; + width: 100%; + border-radius: 4px; + background-color: #ff7f7f; + box-shadow: inset 1px 1px 2px #999, inset -1px -1px 2px #ccc; } + .CindyJS-animcontrols .CindyJS-animspeed div { + width: 50%; + height: 100%; + border-radius: 4px; + background-color: #cc0000; + box-shadow: inset 1px 1px 2px #fff, inset -1px -1px 2px #aaa; } + .CindyJS-animcontrols .CindyJS-animbuttons { + white-space: nowrap; } + +.CindyJS-animbuttons button { + border-radius: 4px; + width: 34px; + height: 26px; + box-sizing: border-box; } + +/*# sourceMappingURL=CindyJS.css.map */ \ No newline at end of file diff --git a/texmf-dist/doc/support/ketcindy/ketmanual/CindyJS/ketcindylib.txt b/texmf-dist/doc/support/ketcindy/ketmanual/CindyJS/ketcindylib.txt new file mode 100644 index 00000000..72469da8 --- /dev/null +++ b/texmf-dist/doc/support/ketcindy/ketmanual/CindyJS/ketcindylib.txt @@ -0,0 +1,6419 @@ +// 17.08.26 Slider +// 16.11.27 +Ketinit():=Ketinit(1); +Ketinit(sy):=Ketinit(sy,[-5,5],[-5,5]); +Ketinit(sy,rangex,rangey):=( + regional(pt,tmp,tmp1,tmp2); + PenThickInit=8; + ULEN="1cm"; + KETPICLAYER=20; + MilliIn=1/2.54*1000; + PenThick=round(MilliIn*0.02); + PenThickInit=PenThick; + TenSizeInit=0.02; + TenSize=TenSizeInit; + YaSize=1; YaAngle=18; YaPosition=1; + YaThick=1; YaStyle='tf'; + KETPICCOUNT=1; + KCOLOR=[0,0,0]; + GLIST=[]; + GCLIST=[]; +// GDATALIST=[]; + GOUTLIST=[]; + POUTLIST=[]; + VLIST=[]; + FUNLIST=[]; + LETTERlist=[]; + COM0thlist=[]; + COM1stlist=[]; + COM2ndlist=[]; + SCIWRLIST=[]; + SCIRELIST=[]; + ADDAXES="1"; + LFmark=unicode("000a"); + Dq=unicode("0022"); + WaitUnit=10; + CONTINUED=0; + OutComList=[]; + OutFileLIst=[]; // 15.10.22 + FigPdfList=[]; // 16.04.08 + ADDPACK=[]; // 16.05.16 + ErrFlag=0; + setdirectory(Dirwork); + if(isstring(Fhead), // 15.04.06 + Fnametex=Fhead+".tex"; + Fnamesci=Fhead+".sce"; + Fnamescibody=Fhead+"body.sce"; + Fnameout=Fhead+".txt"; + ); + if(!isstring(Mackc),// 16.06.07 + Mackc="sh"; + ); + ArrowlineNumber=1; // 15.01.05 + ArrowheadNumber=1; + BezierNumber=1; //15.01.03 + SCALEX=1; + SCALEY=sy; +// Setscaling(sy); + XMIN=rangex_1/SCALEX; + XMAX=rangex_2/SCALEX; + YMIN=rangey_1/SCALEY; + YMAX=rangey_2/SCALEY; + Setwindow("Msg=n"); // 16.05.31 +); + +DqDq(str):=unicode("0022")+str+unicode("0022"); + +Tab2list(dtstr):=Tab2list(dtstr,[]); +Tab2list(dtstr,options):=( +//help:Tab2list(datastr); +//help:Tab2list(options=[0]); + regional(dtall,dt,rep,out,crm,lfm,htm,first,tmp,tmp1,tmp2); + crm=unicode("000d"); + lfm=unicode("000a"); + htm=unicode("0009"); + rep=0; + if(length(options)>0,rep=options_1); + first=lfm; // 16.09.05from + if(indexof(dtstr,crm)>0, + first=crm; + if(indexof(dtstr,crm+lfm)>0, + first=first+lfm; + ); // 16.09.05upto + ); + tmp1=Indexall(dtstr,first); + tmp1=prepend(0,tmp1); + tmp1=append(tmp1,length(dtstr)); + dtall=[]; + forall(1..(length(tmp1)-1), + tmp=substring(dtstr,tmp1_#,tmp1_(#+1)-1); + if(length(tmp)>0, + dtall=append(dtall,tmp); + ); + ); + out=[]; + forall(dtall,dt, + tmp1=tokenize(dt,unicode("0009")); + tmp2=[]; + forall(tmp1, + if(isstring(#),tmp=parse(#),tmp=#); + if(!isreal(tmp), + if(length(#)>0,tmp=#,tmp=rep); + ); + tmp2=append(tmp2,tmp); + ); + out=append(out,tmp2); + ); + out; +); + +Columnlist(dt,list):=( // 16.09.04 +//help:Columnlist(dt,1..3); + apply(dt,#_list); +); + +Dispmat(dt):=( // 16.09.16 +//help:Dispmat(dt); + regional(htm,crm,lfm,row,tmp,tmp1,tmp2); + htm=unicode("0009"); + crm=unicode("000d"); + lfm=unicode("000a"); + tmp2=""; + forall(dt,row, + tmp1=""; + forall(row, + if(isstring(#), + tmp1=tmp1+#+htm; + , + tmp1=tmp1+text(#)+htm; + ); + ); + tmp1=substring(tmp1,0,length(tmp1)-1); + tmp1=tmp1+lfm; + tmp2=tmp2+tmp1; + ); + print(tmp2); + println(); +); + +norm(v1):=( // 16.09.01 +//help:norm([2,1,3]); + regional(out,tmp,tmp1,tmp2); + out=0; + forall(1..length(v1), + out=out+(v1_#)^2; + ); + out=sqrt(out); + out; +); +norm(v1,v2):=( + norm(v2-v1); +); + +// 16.03.28 +Removespace(str):=( +//help:Removespace(" a b c "); + regional(tmp,flg,out); + tmp=length(str)+1; + flg=0; + forall(1..length(str), + if(flg==0, + if((str_#)!=" ", + tmp=#; + flg=1; + ); + ); + ); + out=substring(str,tmp-1,length(str)); + flg=0; + tmp=0; + forall(reverse(1..length(out)), + if(flg==0, + if((out_#)!=" ", + tmp=#; + flg=1; + ); + ); + ); + out=substring(out,0,tmp); +); + +Indexall(str,key):=( + regional(rest,out,flg,tmp,tmp1,); + out=[]; + rest=str; + flg=0; + forall(1..length(str), + if(flg==0, + tmp=indexof(rest,key); + if(tmp>0, + tmp1=tmp+length(str)-length(rest); + out=append(out,tmp1); + rest=substring(rest,tmp,length(rest)); + , + flg=1; + ); + ); + ); + out; +); + +Changestyle(nameL,style):=( +//help:Changestyle(["sgAB"],["da"]); + regional(nmL,name,Ltype,Ltypeorg,Noflg,opcindy,tmp); + tmp=Divoptions(style); + Ltypeorg=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + if(islist(nameL),nmL=nameL,nmL=[nameL]); + forall(nmL,name, + Ltype=Ltypeorg; + GCLIST=select(GCLIST,#_1!=name); + COM2ndlist=select(COM2ndlist,indexof(#,"("+name)==0); // 15.05.23 + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + ); +); + +Op(n,object):=( // 16.05.25 +//help:Op(4,[1,2,3,4]); +//help:Op(3,"abcd"); + regional(out); + if(islist(object), + out=object_n; + , + if(isstring(object), + out=substring(object,n-1,n); + ); + ); + out; +); + +Toupper(str):=( + regional(alphabet,out,tmp,tmp1); + alphabet="abcdefghijklmnopqrstuvwxyz"; + out=""; + forall(1..length(str), + tmp=substring(str,#-1,#); + tmp1=indexof(alphabet,tmp); + if(tmp1>0, + out=out+unicode(text(tmp1+64),base->10); + , + out=out+tmp; + ); + ); + out; +); + +Textformat(value,dig):=( +//help:Textformat(2/3,4); +//help:Textformat([gr1,gr2],5); + regional(vv,tmp,tmp1); + if(islist(value), + tmp1="["; + forall(value, + tmp1=tmp1+Textformat(#,dig)+","; + ); + tmp1=substring(tmp1,0,length(tmp1)-1)+"]"; + , + if(ispoint(value) % isstring(value), +// vv=Lcrd(value); +// tmp1=Textformat(vv,dig); +// tmp1=text(value); // 15.04.07 + if(isstring(value),tmp1=Dq+value+Dq,tmp1=text(value)); // 15.10.02 + , + tmp1=format(value,dig); + ); + ); + tmp1; +); + +Sprintf(value,dig):=( +//help:Sprintf(5.1,4); + regional(vv,tmp,tmp1); + if(!islist(value), + vv=Textformat(value,dig); + if(indexof(vv,".")==0,vv=vv+"."); + vv=vv+"0000000000000000"; + tmp=indexof(vv,".")+dig; + vv=substring(vv,0,tmp); + , + vv=apply(value,Sprintf(#,dig)); + ); + vv; +); + +Assign(funstr,vrL):=( + regional(nn,out,tmp,tmp1); + nn=length(vrL)/2; + out=funstr; + forall(1..nn, + out=Assign(out,vrL_(2*#-1),vrL_(2*#)); + ); + out; +); + +Assign(funstr,varname,rep):=( +//help:Assign("x^2+a*x","a",1.3); +//help:Assign("a*x^2+b*x",["a",1,"b",2]); + regional(repstr,ii,jj,tmp,tmp1,tmp2,Notvar,Flg); + if(isstring(rep),repstr=rep,repstr="("+Textformat(rep,5)+")"); // 15.02.09, 07.06 + tmp=[46]; // 12.20 + tmp=concat(tmp,48..57); + tmp=concat(tmp,65..90); + tmp=concat(tmp,97..122); + Notvar=apply(tmp,unicode(text(#),base->10)); + tmp2=""; + forall(1..100, + ii=indexof(funstr,varname); + if(ii>0, + Flg=0; + if(ii>1, + tmp=substring(funstr,ii-2,ii-1); + if(contains(Notvar,tmp), + tmp2=tmp2+substring(funstr,0,ii); + funstr=substring(funstr,ii,length(funstr)); + Flg=1; + ); + ); + if(Flg==0, + jj=ii-1+length(varname); + if(jj0, + if(indexof(#,"tex")>0,Noflg=1); + if(indexof(#,"disp")>0,Noflg=2); + if(indexof(#,"data")>0,Noflg=3); + flg=1; + ); + ); + if(flg==0, + if(indexof(#,"->")>0, + opcindy=opcindy+","+#; + flg=1; + ); + ); + if(flg==0, + if(indexof(#,"out")+indexof(#,"Out")>0, + if(indexof(#,"-")==0, + Outflg=1; + , + Outflg=2; + ); + flg=1; + ); + ); + if(flg==0, + if(indexof(#,"in")+indexof(#,"In")>0, + if(indexof(#,"-")==0, + Inflg=1; + , + Inflg=2; + ); + flg=1; + ); + ); + if(flg==0, + tmp=substring(#,0,2); + tmp1=indexof(tmp,"dr")+indexof(tmp,"Dr"); + tmp1=tmp1+indexof(tmp,"da")+indexof(tmp,"Da"); + tmp1=tmp1+indexof(tmp,"id")+indexof(tmp,"Id"); + tmp1=tmp1+indexof(tmp,"do")+indexof(tmp,"Do"); + tmp1=tmp1+indexof(tmp,"dp")+indexof(tmp,"Dp"); + if(tmp1>0, + Ltype=#; + flg=1; + ); + if(flg==0, + strL=append(strL,#); + opstr=opstr+","+Dq+#+Dq; + ); + ); + ); + if(indexof(opcindy,"color->")==0,// 16.10.07from + opcindy=opcindy+",color->[0,0,0]"; + ); + [Ltype,Noflg,Inflg,Outflg,eqL,realL,strL,opstr,opcindy]; +); + +Dotprod(vec1,vec2):=( +//help:Dotprod(vec1,vec2); + regional(v1,v2,tmp); + if(ispoint(vec1),v1=vec1.xy,v1=vec1); + if(ispoint(vec2),v2=vec2.xy,v2=vec2); + v1*v2; +); + +Crossprod(a,b):=( +//help:Crossprod(vec1,vec2); + regional(tmp1,tmp2,tmp3,Out); + if(length(a)==3, + tmp1=a_2*b_3-a_3*b_2; + tmp2=a_3*b_1-a_1*b_3; + tmp3=a_1*b_2-a_2*b_1; + Out=[tmp1,tmp2,tmp3]; + , + Out=a_1*b_2-a_2*b_1; + ); + Out; +); + +Ptstart(Fig):=( +//help:Ptstart("gr1"); + regional(tmp); + if(isstring(Fig),tmp=parse(Fig),tmp=Fig); // 16.01.21 + tmp_1; +); + +Ptend(Fig):=( +//help:Ptend("gr1"); + regional(tmp); + if(isstring(Fig),tmp=parse(Fig),tmp=Fig); + tmp_(length(tmp)); // 15.04.12 +); + +Numptcrv(Fig):=( +//help:Numptcrv("gr1"); + regional(tmp); + if(isstring(Fig),tmp=parse(Fig),tmp=Fig); // 15.12.23 + length(tmp); +); + +Ptcrv(Num,Fig):=( +//help:Ptcrv(10,"gr1"); + regional(tmp); + if(isstring(Fig),tmp=parse(Fig),tmp=Fig); + tmp_Num; +); + +Invert(Fig):=( +//help:Invert("gr1"); + regional(tmp); + if(isstring(Fig),tmp=parse(Fig),tmp=Fig); // 16.01.27 + reverse(tmp); +); +Invert(nm,Fig):=Invert(nm,Fig,["nodisp"]); // from 16.01.27 +Invert(nm,Fig,options):=( +//help:Invert("1","gr1"); + regional(name,tmp); + name="-inv"+nm; + tmp=Invert(Fig); + Listplot(name,tmp,options); +);// upto 16.01.27 + +Paramoncrv(pP,Gdata):=( + regional(Tmp,PtL); +// Eps=10^(-8); + if(isstring(Gdata),PtL=parse(Gdata),PtL=Gdata); + Tmp=Nearestpt(pP,PtL); + Tmp_2; +); + +ParamonCurve(pP,nN,plist):=( +//help:ParamonCurve(A,10,"gr1"); + regional(PtL,Out,Pa,Pb,vV,vW,sS); + if(isstring(plist),PtL=parse(plist),PtL=plist); + PtL=apply(PtL,LLcrd(#));//16.10.16 + if(nN==length(PtL), + Out=nN; + , + Pa=PtL_nN; + Pb=PtL_(nN+1); + vV=Pb-Pa; + vW=pP-Pa; + sS=vV*vW/|vV|^2; + sS=min([max([sS,0]),1]); + Out=nN+sS; + ); + Out; +); + +Pointoncrv(tT,PtL):=PointonCurve(tT,PtL); +PointonCurve(tT,Gdata):=( +//help:PointonCurve(20.5,"gr1"); + regional(Out,Eps,nN,sS,Pa,Pb,PtL); + if(isstring(Gdata),PtL=parse(Gdata),PtL=Gdata); + if(length(PtL)==1,PtL=PtL_1); + Eps=10^(-4); + nN=floor(tT+Eps); + sS=max([tT-nN,0]); + if(nN==length(PtL), + Out=PtL_nN; + , + Pa=PtL_nN; + Pb=PtL_(nN+1); + Out=(1-sS)*Pa+sS*Pb; + ); + Out; +); + +Koutenseg(pA,pB,pC,pD):=Koutenseg(pA,pB,pC,pD,[]); +Koutenseg(pA,pB,pC,pD,options):=( + regional(Eps0,Eps,Eps2,pV,Sv2,Out,pP,pQ,Flg,p1,p2,q1,q2, + em1,eM1,em2,eM2,rT,Tmp1,Tmp2); + Eps0=10^(-4); + pV=pB-pA; + Sv2=|pV|; + pP=pC-pA; pQ=pD-pA; + Eps=10^(-3); + Eps2=0.2; + Tmp1=0; + forall(options, + if(Tmp1==0, + Eps=#; + Tmp1=1; + , + Eps2=#; + ); + ); + Flg=0; + if(Sv2<10^(-3), + Out=["inf","inf"]; + Flg=1; + ); + if(Flg==0, + Eps=min([Eps2,Eps/Sv2]); + p1=pP*pV/Sv2^2; + p2=[pP_2,-pP_1]*pV/Sv2^2; + q1=pQ*pV/Sv2^2; + q2=[pQ_2,-pQ_1]*pV/Sv2^2; + em1=-Eps; eM1=1+Eps; + em2=-Eps; eM2=Eps; + if(max([p1,q1])eM1, + Out=["inf","inf"]; + Flg=1; + ); + if(max([p2,q2])eM2, + Out=["inf","inf"]; + Flg=1; + ); + ); + if(Flg==0 & p2*q2<0, + rT=p1-(q1-p1)/(q2-p2)*p2; + if(rT>em1 & rT-Eps0 & rT<1+Eps0, + Tmp1=pA+rT*pV; + Tmp2=min([max([rT,0]),1]); + Out=[Tmp1,Tmp2,0]; + , + Tmp1=pA+rT*pV; + Tmp2=min([max([rT,0]),1]); + Out=[Tmp1,Tmp2,1]; + ); + Flg=1; + ); + if(Flg==0 & (p1eM1 % p2eM2), + if(q1eM1 % q2eM2, + Out=["inf","inf"]; + Flg=1; + ); + if(Flg==0, + rT=min([max([p1,0]),1]); + Tmp1=pA+rT*pV; + Out=[Tmp1,rT,1]; + Flg=1; + ); + ); + ); + if(Flg==0 & (p1 > -Eps0 & p1 < 1 + Eps0 & p2 > -Eps0 & p2 < Eps0), + rT= p1; + Tmp1=pA+rT*pV; + Out= [Tmp1, rT, 0]; + Flg=1; + ); + if(Flg==0 & (q1 > -Eps0 & q1 < 1 + Eps0 & q2 > -Eps0 & q2 < Eps0), + rT= q1; + Tmp1=pA+rT*pV; + Out=[Tmp1,rT,0]; + Flg=1; + ); + if(Flg==0 & (p1eM1 % p2eM2), + if(q1eM1 % q2eM2, + Out=["inf","inf"]; + Flg=1; + ); + if(Flg==0, + rT=min([max([q1,0]),1]); + Tmp1=pA+rT*pV; + Out=[Tmp1,rT,1]; + Flg=1; + ); + ); + if(Flg==0 & (q1eM1% q2eM2), + rT=min([max([p1,0]),1]); + Tmp1=pA+rT*pV; + Out=[Tmp1,rT,1]; + Flg=1; + ); + if(Flg==0, + if(abs(p2)0, + Eps=realL_1; + if(Tmp1>1, + Eps2=realL_2; + ); + ); + Flg=0; + if(isstring(Gr1),Data1=parse(Gr1),Data1=Gr1); + if(isstring(Gr2),Data2=parse(Gr2),Data2=Gr2); + if(MeasureDepth(Data1)==2,Data1=Data1_1); + if(MeasureDepth(Data2)==2,Data2=Data2_1); + Data1=apply(Data1,LLcrd(#)); + Data2=apply(Data2,LLcrd(#)); + if(length(Data1)==length(Data2), + Tmp1=Reverse(Data2); + Eps0=10^(-6); + Tmp2=0; + forall(1..length(Data1), + Tmp2=Tmp2+abs(Data1_#-Data2_#); + ); + Tmp3=0; + forall(1..length(Data1), + Tmp3=Tmp3+abs(Data1_#-Tmp1_#); + ); + if(Tmp20, + Tmp=KL1_1; + pP=Tmp_1; + rT=Tmp_2; + Ni=Tmp_3; + Nj=Tmp_4; + Tmp=[pP,Ni+rT,Nj]; + Out=[Tmp]; + ); + forall(2..length(KL1),Ni, + Tmp=KL1_Ni; + pP=Tmp_1; + Tmp2=0; + Flg=0; + forall(1..length(Out),Nj, + if(Flg==0, + Tmp=Out_Nj; + if(|pP-Tmp_1|Eps, + rT=(-a2*v2-v1*a1+v1*x1+x2*v2)/Tmp; + if(rT<-Eps, + pP=[a1,a2]; + , + if(rT>1+Eps, + pP=[b1,b2]; + , + pP=[a1+rT*v1,a2+rT*v2]; + ); + ); + sS=|pP-pA|; + if(sSrange_1 & #_1range_1 & #_10) & (list_1_1>list_(length(list))_1), + list=reverse(list); +// pmflg=pmflg*(-1); + ); + list=apply(list,LLcrd(#)); + list=concat([va1],list); + list=concat(list,[va2]); + Sm=0; + forall(1..(length(list)-1), + p1=list_#; + p2=list_(#+1); + if(#==1 % #==length(list)-1, + tmp1=(p1_2+p2_2)*(p2_1-p1_1)/2; + Sm=Sm+tmp1; + , + p0=list_(#-1); + p3=list_(#+2); + tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2); + cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp; + pQ=p1+cc*(p2-p0); + pR=p2+cc*(p1-p3); + p01=p1_1; p02=p1_2; + p31=p2_1; p32=p2_2; + p11=pQ_1; p12=pQ_2; + p21=pR_1; p22=pR_2; + tmp1=-6*p12*p01+3*p12*p21+3*p12*p31+6*p02*p11- + 10*p02*p01+3*p02*p21+p02*p31-3*p22*p11- + 3*p22*p01+6*p22*p31-3*p32*p11-p32*p01- + 6*p32*p21+10*p32*p31; + tmp1=tmp1/20; + Sm=Sm+tmp1; + ); + ); + if(pmflg==-1, + Sm=-Sm; + ); + Sm; +); + +Findarea(pdstr):=( +//help:Findarea("sgABCA"); + regional(pd,p1,p2,s,tmp); + if(isstring(pdstr),pd=parse(pdstr),pd=pdstr); + s=0; + forall(1..(length(pd)-1), + p1=Lcrd(pd_#); + p2=Lcrd(pd_(#+1)); + tmp=(p1_2+p2_2)*(p2_1-p1_1)/2; + s=s+tmp; + ); + if(s<0,s=-s); + s; +); + +Findarea(pdstr):=( // 15.11.27 +//help:Findarea("cr1"); + regional(pd,p0,p1,p2,p3,s,tmp); + if(isstring(pdstr),pd=parse(pdstr),pd=pdstr); + s=0; + forall(1..(length(pd)-1), + p1=pd_#; + p2=pd_(#+1); + if(#==1,p0=pd_(length(pd)-1),p0=pd_(#-1)); + if(#==length(pd)-1,p3=pd_2,p3=pd_(#+2)); + tmp=IntegrateO(p0,p1,p2,p3); + s=s+tmp; + ); + if(s<0,s=-s); + s; +); + +Findlength(pdstr):=( +//help:Findlength("gr1"); + regional(pd,p1,p2,s,tmp); + if(isstring(pdstr),pd=parse(pdstr),pd=pdstr); + s=0; + forall(1..(length(pd)-1), + p1=Lcrd(pd_#); + p2=Lcrd(pd_(#+1)); + tmp=|p2-p1|; + s=s+tmp; + ); + s; +); + +Inversefun(fnstr,rngstr,value):=( + regional(tmp,varstr,range,x1,x2,x3,va1,va2); + tmp=indexof(rngstr,"="); + varstr=substring(rngstr,0,tmp-1); + range=parse(substring(rngstr,tmp,length(rngstr))); + x1=range_1; x2=range_2; + repeat(15, + x3=(x1+x2)/2; + va1=parse(replace(fnstr,varstr,textformat(x1,5))); + va2=parse(replace(fnstr,varstr,textformat(x3,5))); + if((va1>value & va2>value) % (va13,type="cmyk",type="rgb"); + tmp=text(data); + tmp=substring(tmp,1,length(tmp)-1); + tmp="\definecolor{"+name+"}{"+type+"}{"+tmp+"}"; + Texcom(tmp); +); + +Setcolor(Par):=( +//help:Setcolor([1,0,0,1]); +//help:Setcolor([1,1,0]); + if(islist(Par), + if(length(Par)==3, + Setcolorrgb(Par); // 2015.04.28 +// KCOLOR=Par; + ); + if(length(Par)==4, + Setcolor(Par,[]); + ); + , + Setcolor(Par,[]); + ); +); + +Setcolor(colorname,options):=( +//help:Setcolor("greenyellow",0.3); + regional(tmp); + if(isstring(colorname), + tmp="Setcolor("+Dq+colorname+Dq; + if(length(options)>0, + tmp=tmp+","+text(options_1); + ); + Com2nd(tmp+")"); + ); + if(islist(colorname), + tmp=text(colorname); + tmp=substring(tmp,1,length(tmp)-1); + tmp="Texcom("+Dq+"\color[cmyk]{"+tmp+"}"+Dq+")"; + Com2nd(tmp); + ); +); + +Setcolorrgb(colorlist):=( +// help:Setcolorrgb([0.5,0.3,0.4]); + regional(tmp); + tmp=text(colorlist); + tmp=substring(tmp,1,length(tmp)-1); + tmp="Texcom("+Dq+"\color[rgb]{"+tmp+"}"+Dq+")"; + Com2nd(tmp); +); + +ColorRgb2Cmyk(clr):=( +// help:ColorRgb([0.2,0.5,0.1]); + regional(clrnew,tmp,black); + tmp=apply(clr,1-#); + black=min(tmp); + tmp=apply(clr,(1-#-black)/(1-black)); + clrnew=append(tmp,black); + clrnew; +); + +ColorCmyk2Rgb(clr):=( +// help:ColorRgb([0.2,0.5,0.1,0.2]); + regional(clrnew,tmp,black); + black=clr_4; + tmp=apply(clr,1-min(1,#*(1-black)+black)); + clrnew=tmp_(1..3); + clrnew; +); + +Colorrgbhsv(rgb):=( + regional(varR,varG,varB,varMin,varMax,delMax,hh,ss,vv,delR,delG,delB); + varR = rgb_1; + varG = rgb_2; + varB = rgb_3; + varMin = min( [varR, varG, varB] ); + varMax = max( [varR, varG, varB] ); + delMax = varMax - varMin ; + vv = varMax; + if ( delMax == 0 , + hh = 0 ; + ss = 0 ; + , + ss = delMax / varMax; + delR = ( ( ( varMax - varR ) / 6 ) + ( delMax / 2 ) ) / delMax; + delG = ( ( ( varMax - varG ) / 6 ) + ( delMax / 2 ) ) / delMax; + delB = ( ( ( varMax - varB ) / 6 ) + ( delMax / 2 ) ) / delMax; + if( varR == varMax , + hh = delB - delG; + , + if ( varG == varMax, + hh = ( 1 / 3 ) + delR - delB; + , + if ( varB == varMax , + hh = ( 2 / 3 ) + delG - delR; + ); + ); + ); + if ( hh < 0 ,hh = hh+1); + if ( hh > 1 ,hh = hh-1); + ); + [hh*360,ss,vv]; +); + +Colorhsvrgb(sL):=( + regional(tmp,tmp1,tmp2,tmp3,hi,ff,dL); + tmp=[sL_1/60,sL_2,sL_3]; + hi=mod(floor(tmp_1),6); + ff=tmp_1-floor(tmp_1); + tmp2=tmp_3*[1-tmp_2,1-tmp_2*ff,1-tmp_2*(1-ff)]; + tmp2=append(tmp2,tmp_3); + if(hi==0,dL=tmp2_[4,3,1]); + if(hi==1,dL=tmp2_[2,4,1]); + if(hi==2,dL=tmp2_[1,4,3]); + if(hi==3,dL=tmp2_[1,2,4]); + if(hi==4,dL=tmp2_[3,1,4]); + if(hi==5,dL=tmp2_[4,1,2]); + dL; +); + +Colorrgbhsl(rgb):=( + regional(rr,gg,bb,mn,mx,delta,deltaR,deltaG,deltaB,hh,ss,ll); + rr = rgb_1 ; + gg = rgb_2 ; + bb = rgb_3 ; + mn = min([rr, gg, bb]); + mx = max([rr, gg, bb]); + delta = mx - mn; + ll = (mx + mn) / 2; + if (delta == 0, + hh=0; + ss=0; + , + if (ll < 0.5, + ss = delta/ (mx + mn); + , + ss = delta / (2 - mx - mn); + ); + deltaR = (((mx - rr) / 6) + (delta / 2)) / delta; + deltaG = (((mx - gg) / 6) + (delta / 2)) / delta; + deltaB = (((mx - bb) / 6) + (delta / 2)) / delta; + if (rr == mx, + hh = deltaB - deltaG; + , + if (gg == mx, + hh = (1 / 3) + deltaR - deltaB; + , + if (bb == mx, + hh = (2 / 3) + deltaG - deltaR; + ); + ); + ); + if ( hh < 0, hh = hh+1); + if ( hh > 1, hh = hh-1); + ); + [hh*360,ss,ll]; +); + +Colorhslrgb(hsl):=( + regional(hh,ss,ll,rr,gg,bb,var1,var2); + hh=hsl_1/360; + ss=hsl_2; + ll=hsl_3; + if ( ss == 0.0, + rr = ll ; + gg = ll ; + bb = ll ; + , + if ( ll < 0.5 , + var2 = ll * ( 1.0 + ss ); + , + var2 = ( ll + ss ) - ( ss * ll ); + ); + var1 = 2.0 * ll - var2; + rr = hue2rgb( var1, var2, hh + ( 1.0 / 3.0 ) ); + gg = hue2rgb( var1, var2, hh ); + bb = hue2rgb( var1, var2, hh - ( 1.0 / 3.0 ) ); + ); + [rr,gg,bb]; +); + +hue2rgb(vv1,vv2,vh):=( + regional(out); + if ( vh < 0.0 ,vh =vh+1); + if ( vh > 1.0 ,vh =vh-1); + if ( 6.0*vh < 1.0 , + out = vv1 + ( vv2 - vv1 ) * 6.0 * vh ; + , + if( 2.0*vh < 1.0 , + out = vv2; + , + if ( 3.0*vh < 2.0 , + out = vv1 + ( vv2 - vv1 ) * ( ( 2.0 / 3.0 ) - vh ) * 6.0 ; + , + out= vv1 ; + ); + ); + ); + out; +); + +Colorrgbhwb(sL):=( + regional(dl1,dl2,dl3); + dl1 = Colorrgbhsl(sL)_1;//Colorcode("rgb","hsl",sL)_1; + dl2 = min(sL); + dl3 = 1 - max(sL); + dL= [dl1, dl2 , dl3 ]; +); + +Colorhwbrgb(sLorg):=( + regional(sL,tmp,tmp1,tmp2,tmp3,ratio,ff,ii,vv,nn,dL,flg); + sL=sLorg; + sL=[sL_1/360,sL_2,sL_3]; + ratio = sL_2 + sL_3; + // sL_2 + sL_3 cant be > 1 + if (ratio > 1., + sL_2 =sL_2 / ratio; + sL_3 = sL_3 / ratio; + ); + ii = floor(6 * sL_1); + vv = 1 - sL_3; + ff = 6 * sL_1 - ii; + if(mod(ii,2)==1,ff = 1 - ff); + nn = sL_2 + ff * (vv - sL_2); // linear interpolation + tmp=[[vv,nn,sL_2],[nn,vv,sL_2],[sL_2,vv,nn], + [sL_2,nn,vv],[nn,sL_2,vv],[vv,sL_2,nn],[vv,nn,sL_2]]; + flg=0; + forall(0..6, + if(flg==0 & ii == # , + dL=tmp_(#+1); + flg=1; + ); + ); + dL; +); + +Colorhslhsv(sL):=( + regional(dl1,dl2,dl3,dL); + dl1=sL_1; + if(sL_3 == 0, + // no need to do calc on black + // also avoids divide by 0 error + dL= [0, 0, 0]; + , + sL_3 = sL_3 * 2; + if(sL_3 <= 1,sL_2 = sL_2 * sL_3,sL_2 = sL_2 * (2 - sL_3)); + dl3 = (sL_3 + sL_2) / 2; + dl2 = (2 * sL_2) / (sL_3 + sL_2); + dL = [dl1, dl2, dl3]; + ); + dL; +); + +Colorcode(src,dest,sL):=( +//help:Colorcode("rgb","cmyk",[1,0.5,0]); + regional(tmp,tmp1,tmp2,tmp3,mn,mx,delta,black,dL,flg); + regional(dl1,dl2,dl3); + if(src=="rgb" & dest=="hsv", dL=Colorrgbhsv(sL)); + if(src=="hsv" & dest=="rgb", dL=Colorhsvrgb(sL)); + if(src=="rgb" & dest=="hsl", dL=Colorrgbhsl(sL)); + if(src=="hsl" & dest=="rgb", dL=Colorhslrgb(sL)); + if(src=="rgb" & dest=="hwb", dL=Colorrgbhwb(sL)); + if(src=="hwb" & dest=="rgb", dL=Colorhwbrgb(sL)); + if(src=="hsl" & dest=="hsv", dL=Colorhslhsv(sL)); + if(src=="hsv" & dest=="hsl", + dl1 = sL_1; + dl3 = (2 - sL_2) * sL_3; + dl2 = sL_2 * sL_3; + if(dl3 <= 1,dl2 = dl2/dl3,dl2=dl2/(2 - dl3)); + dl3 =d l3/ 2; + dL = [dl1, dl2 , dl3 ]; + ); + + if(src=="rgb" & dest=="cmyk", + tmp=apply(sL,1-#); + black=min(tmp); + tmp=apply(sL,(1-#-black)/(1-black)); + dL=append(tmp,black); + ); + if(src=="cmyk" & dest=="rgb", + black=sL_4; + tmp=apply(sL,1-min(1,#*(1-black)+black)); + dL=tmp_(1..3); + ); + if(src=="hsv" & dest=="cmyk", + tmp=Colorcode("hsv","rgb",sL); + dL=Colorcode("rgb","cmyk",tmp); + ); + if(src=="cmyk" & dest=="hsv", + tmp=Colorcode("cmyk","rgb",sL); + dL=Colorcode("rgb","hsv",tmp); + ); + + if(src=="hsv" & dest=="hwb", + tmp = Colorcode("hsv","rgb",sL); + dL = Colorcode("rgb","hwb",tmp); + ); + if(src=="hwb" & dest=="hsv", + tmp = Colorcode("hwb","rgb",sL); + dL = Colorcode("rgb","hsv",tmp); + ); + if(src=="hsl" & dest=="hwb", + tmp = Colorcode("hsl","rgb",sL); + dL = Colorcode("rgb","hwb",tmp); + ); + if(src=="hwb" & dest=="hsl", + tmp = Colorcode("hwb","rgb",sL); + dL = Colorcode("rgb","hsl",tmp); + ); + if(src=="hsl" & dest=="cmyk", + tmp = Colorcode("hsl","rgb",sL); + dL = Colorcode("rgb","cmyk",tmp); + ); + if(src=="hwb" & dest=="cmyk", + tmp = Colorcode("hwb","rgb",sL); + dL = Colorcode("rgb","cmyk",tmp); + ); + if(src=="cmyk" & dest=="hsl", + tmp = Colorcode("cmyk","rgb",sL); + dL = Colorcode("rgb","hsl",tmp); + ); + if(src=="cmyk" & dest=="hwb", + tmp = Colorcode("cmyk","rgb",sL); + dL = Colorcode("rgb","hwb",tmp); + ); + if(src=="hsb" & dest=="rgb",dL=Colorcode("hsv","rgb",sL)); + if(src=="rgb" & dest=="hsb",dL=Colorcode("rgb","hsv",sL)); + + if(src=="hsb" & dest=="hsl",dL=Colorcode("hsv","hsl",sL)); + if(src=="hsl" & dest=="hsb",dL=Colorcode("hsl","hsv",sL)); + + if(src=="hsb" & dest=="hwb",dL=Colorcode("hsv","hwb",sL)); + if(src=="hwb" & dest=="hsb",dL=Colorcode("hwb","hsv",sL)); + + if(src=="hsb" & dest=="cmyk",dL=Colorcode("hsv","cmyk",sL)); + if(src=="cmyk" & dest=="hsb",dL=Colorcode("cmyk","hsv",sL)); + + dL; +); + +Addcolor(cmdorg,list):=( +//help:Addcolor("Plotdata('1','x^2','x',[])",[1,1,0]); + regional(rgb,cmyk,cmd,tmp,tmp1,tmp2,tmp3,tmp4); + cmd=replace(cmdorg,"'",Dq); + if(length(list)==3, + rgb=list; + cmyk=Colorcode("rgb","cmyk",list); + , + cmyk=list; + rgb=Colorcode("cmyk","rgb",list); + ); + tmp1="color->"+text(rgb); + tmp2="Setcolor("+text(cmyk)+");"; + tmp3=substring(cmd,0,length(cmd)-2); + tmp=substring(tmp3,length(tmp3)-1,length(tmp3)); + if(tmp!="[", + tmp3=tmp3+","; + ); + tmp3=tmp3+Dq+tmp1+Dq+"])"; + parse(tmp2); + parse(tmp3); + Setcolor("black"); +); + +Colorinfile(filename,clrf,clrt):=( + regional(tmp,tmp1,tmp2,head,cstrL,chstrL,head,body); + if(length(clrf_1)==3, + head="[rgb]{"; + , + head="[cmyk]{"; + ); + tmp=apply(clrf,text(#)); + cstrL=apply(tmp,head+substring(#,1,length(#)-1)+"}"); + if(length(clrt_1)==3, + head="[rgb]{"; + , + head="[cmyk]{"; + ); + tmp=apply(clrt,text(#)); + chstrL=apply(tmp,head+substring(#,1,length(#)-1)+"}"); + tmp1=load(filename); + tmp=tokenize(tmp1,"{\unitlength"); + head=tokenize(tmp_1,"%%%"); + head=head_(2..length(head)); + head=apply(head,"%%%"+#); + tmp2=tmp_2; + forall(1..5, + tmp2=replace(tmp2,cstrL_#,chstrL_#); + ); + body=tokenize(tmp2,"%"); + body_1="{\unitlength"+body_1; + body=apply(body,#+"%"); + body=body_(1..(length(body)-1)); + tmp=replace(filename,".tex","new.tex"); + SCEOUT=openfile(tmp); + forall(head, + println(SCEOUT,#); + ); + forall(1..length(body), + tmp=body_#; + if(#0, + Dop=","+substring(str,tmp1,length(str)); + ); + noflg=parse(substring(str,0,1)); + if(substring(name,0,3)=="sub",subflg=1,subflg=0); // 16.02.29 + tmp1=substring(str,1,3); + if(tmp1=="dr" % tmp1=="Dr", + Ltype=0; + if(noflg==0 & subflg==0, // 16.02.29 + Drwline(name+Dop); + ); + ); + if(tmp1=="da" % tmp1=="Da", + Ltype=1; + if(noflg==0 & subflg==0, // 16.02.29 + Dashline(name+Dop); + ); + ); + if(tmp1=="id" % tmp1=="Id", + Ltype=2; // 15.11.09 + if(noflg==0 & subflg==0, // 16.02.29 + Invdashline(name+Dop); + ); + ); + if(tmp1=="do" % tmp1=="Do", + Ltype=3; + if(noflg==0 & subflg==0, // 16.02.29 + Dottedline(name+Dop); + ); + ); + if(tmp1=="dp" % tmp1=="Dp", + Ltype=0; + tmp1=parse(name); + tmp2=""; + forall(tmp1, + tmp2=tmp2+textformat(#_1,5)+","; + ); + tmp2=substring(tmp2,0,length(tmp2)-1); + if(noflg==0, + Drwpt(tmp2+Dop); + ); + ); + if(tmp1=="no" % tmp1=="No", + Ltype=10; + ); + Ltype; +); + +Chunderscore(str):=( + regional(flg,tmp,tmp1,tmp2,tmp3); + if(indexof(str,"]")>0, + tmp1=replace(str,"]",",]"); + , + tmp1=str+","; + ); + flg=0; + tmp2=[]; + tmp3=0; + forall(1..length(tmp1), + if(flg==0, + tmp=substring(tmp1,tmp3,length(tmp1)); + tmp=indexof(tmp,"_"); + if(tmp==0, + flg=1; + , + tmp3=tmp3+tmp; + tmp=substring(tmp1,tmp3,length(tmp1)); + tmp=indexof(tmp,",")-1; + tmp=substring(tmp1,tmp3,tmp3+tmp); + tmp2=append(tmp2,tmp); + ); + ); + ); + forall(tmp2, + tmp1=replace(tmp1,"_"+#,"("+#+")"); + ); + if(indexof(str,"]")>0, + tmp1=replace(tmp1,",]",")"); + tmp1=replace(tmp1,"[","list("); + , + tmp1=substring(tmp1,0,length(tmp1)-1); + ); + tmp1; +); + +//AddGraph(pltdata):=AddGraph("-"+pltdata,pltdata,[]); +AddGraph(nm,pltdata):=AddGraph(nm,pltdata,[]); +// if(isstring(Arg2), +// AddGraph(Arg1,Arg2,[]); +// , +// if(MeasureDepth(Arg2)>0, +// Addgraph(Arg1,Arg2,[]); +// , +// Addgraph("-"+Arg1,Arg1,Arg2); +// ); +// ); +//); +AddGraph(nm,pltdata,options):=( +//help:AddGraph("1","imp1"); // 16.04.04 +//help:Addgraph("1",["[pt1]","gr1"],["nodisp"]); + regional(name,Ltype,Noflg,opcindy,pdata,fname,flg, + tmp,tmp1,tmp2,tmp3); + if(substring(nm,0,1)=="-", + name=substring(nm,1,length(nm)); + , + name="ad"+nm; + ); + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_9; + if(isstring(pltdata), + pdata=parse(pltdata) + , + if(!islist(pltdata),pdata=[pltdata],pdata=pltdata); + pdata=apply(pdata,parse(#)); + ); // 15.01.22 + pdata=Flattenlist(pdata); + tmp1=[]; + forall(pdata,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + if(length(tmp1)==1,tmp1=tmp1_1); + pdata=tmp1; + if(Noflg<3, + println("generate addgraph "+name); + tmp=name+"="+textformat(pdata,5); + parse(tmp); + if(isstring(pltdata), // 16.04.04 from + if(indexof(pltdata,"]")>0, + tmp1="list(Listplot("+substring(pltdata,1,length(pltdata)); + tmp1=replace(tmp1,"]",",]"); + , + tmp1="Listplot("+substring(pltdata,0,length(pltdata))+",]"; + ); + flg=0; + tmp2=[]; + tmp3=0; + forall(1..length(tmp1), + if(flg==0, + tmp=indexof(substring(tmp1,tmp3,length(tmp1)),"_"); + if(tmp==0, + flg=1; + , + tmp3=tmp3+tmp; + tmp=indexof(substring(tmp1,tmp3,length(tmp1)),",")-1; + tmp=substring(tmp1,tmp3,tmp3+tmp); + tmp2=append(tmp2,tmp); + ); + ); + ); + forall(tmp2, + tmp1=replace(tmp1,"_"+#,"("+#+")"); + ); + tmp1=replace(tmp1,",]",")"); + tmp1=replace(tmp1,",","),Listplot("); + if(indexof(pltdata,"[")>0, + tmp1=tmp1+")"; + ); + GLIST=append(GLIST,name+"="+tmp1); + , + if(MeasureDepth(pdata)==1, + tmp1=name+"=Listplot("+textformat(pdata,5)+")"; + , + tmp1="list("; + forall(1..length(pdata), + tmp=name+"p"+textformat(#,5)+"="; + if(length(pdata_#)>1, // 15.01.22 + tmp=tmp+"Listplot("+textformat(pdata_#,5)+")"; + , + tmp=tmp+"Pointdata("+textformat(pdata_#_1,5)+")"; + ); + GLIST=append(GLIST,tmp); + tmp1=tmp1+name+"p"+textformat(#,5)+","; + ); + tmp1=name+"="+substring(tmp1,0,length(tmp1)-1)+")"; + ); + GLIST=append(GLIST,tmp1); + ); + ); // 16.04.04 upto + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); +); + +Joincrvs(nm,plotstrL):=Joincrvs(nm,plotstrL,[]); +Joincrvs(nm,plotstrL,options):=( +//help:Joincrvs("1",["sgAB","sgDCB"]); + regional(plotlist,PtL,Eps,QdL,Flg,Ni,Qd,pP,pS,pQ,pR,rMN, + opcindy,tmp,tmp1,tmp2,str,name,Ltype,Noflg); + name="join"+nm; + plotlist=[]; + forall(plotstrL,str, + if(isstring(str), + tmp=parse(str); + tmp=apply(tmp,LLcrd(#)); + , + tmp=str; + ); + plotlist=append(plotlist,tmp); + ); + Eps=10^(-4); + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + tmp1=tmp_6; + if(length(tmp1)>0,Eps=tmp1_1); + QdL=[]; + forall(plotlist,Qd, + if(ispoint(Qd_1) % !islist(Qd_1_1), + QdL=concat(QdL,[Qd]); + , + forall(Qd, + QdL=concat(QdL,[#]); + ); + ); + ); + Flg=0; + if(length(QdL)==0, + PtL=[]; + Flg=1; + ); + if(Flg==0, + PtL=QdL_1; + forall(2..length(QdL),Ni, + Qd=QdL_Ni; + if(Numptcrv(Qd)>1, + pP=Ptend(PtL); + pS=Ptstart(PtL); + pQ=Ptstart(Qd); + pR=Ptend(Qd); + rMN=min([|pP-pQ|,|pP-pR|,|pS-pQ|,|pS-pR|]); + if(rMN==|pP-pR|, + Qd=reverse(Qd); + , + if(rMN==|pS-pQ|, + PtL=reverse(PtL); + , + if(rMN==|pS-pR|, + PtL=reverse(PtL); + Qd=reverse(Qd); + ); + ); + ); + ); + if(rMN>Eps, + PtL=concat(PtL,Qd); + , + PtL=concat(PtL,Qd_(2..length(Qd))); + ); + ); + ); + if(Noflg<3, + println("generate joincurve "+name); + tmp1=apply(PtL,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp1=""; + forall(plotstrL, + tmp1=tmp1+#+","; + ); + tmp1=substring(tmp1,0,length(tmp1)-1); + GLIST=append(GLIST,name+"=Joincrvs("+tmp1+")"); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + PtL; +); + +Partcrv(nm,pA,pB,PkLstr):=Partcrv(nm,pA,pB,PkLstr,[]); +Partcrv(nm,pA,pB,PkLstr,options):=( +//help:Partcrv("1",A,B,"sgABC"); +//help:Partcrv("1",1.3,2.5,"sgABC"); + regional(PkL,Ans,Eps,Npt,Out1,Out2,tmp,tmp1,Flg,nS,nE,PPL,pP, + opcindy,Ta,Tb,name,Ltype,Noflg,DepthFlg); + name="part"+nm; + if(isstring(PkLstr),PkL=parse(PkLstr),PkL=PkLstr); + DepthFlg=0; + if(MeasureDepth(PkL)==2, + PkL=PkL_1; + DepthFlg=1; + ); + PkL=apply(PkL,LLcrd(#)); + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + Eps=10^(-3); + Flg=0; + if(isreal(pA), + if(pA>pB+Eps, + Npt=Numptcrv(PkL); + Out1=Partcrv("",pA,Npt,PkLstr,["nodata"]); + Out2=Partcrv("",1,pB,PkLstr,["nodata"]); + tmp=Ptstart(PkL)-Ptend(PkL); + if(|tmp|nE+Eps, + pP=(1-pB+nE)*PkL_nE+(pB-nE)*PkL_(nE+1); + PPL=concat(PPL,[pP]); + ); + Ans=PPL; + Flg=1; + ); + ); + if(Flg==0, + tmp=Nearestpt(LLcrd(Pcrd(pA)),PkL); + Ta=tmp_2; + tmp=Nearestpt(LLcrd(Pcrd(pB)),PkL); // 15.09.12 + Tb=tmp_2; + Ans=Partcrv("",Ta,Tb,PkL,["nodata"] ); + Ans=apply(Ans,Pcrd(#)); + ); + if(Noflg<3, + println("generate partcrv "+name); + tmp1=apply(Ans,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); +// GLIST=append(GLIST, // 16.04.03 + if(DepthFlg==0, + tmp=PkLstr; + , + tmp=PkLstr+"(1)"; + ); + tmp1=name+"=Partcrv("+textformat(Lcrd(pA),5) + +","+textformat(Lcrd(pB),5)+","+tmp+")"; // 16.04.03 + GLIST=append(GLIST,tmp1); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + Ans; +); + +Opcrvs(num,Fig):=Opcrvs(num,Fig,["nodisp"]); +Opcrvs(num,Fig,options):=( + //help:Subgraph(2,"grfs"); + regional(name,tmp,tmp1); + name="-"+Fig+text(num); + tmp=Fig+"_"+text(num); + tmp1=parse(tmp); + Listplot(name,tmp1,options); +); + + +Pointdata(nm,list):=Pointdata(nm,list,[]); +Pointdata(nm,list,options):=( +//help:Pointdata("1",[2,4],["Size=5"]); +//help:Pointdata("2",[[2,3],[4,1]]); + regional(name,nameL,ptlist,opstr,opcindy, + eqL,size,thick,tmp,tmp1,tmp2,tmp3,Ltype,Noflg); + name="pt"+nm; + nameL=name+"L"; + println("generate pointdata "+name); + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + opstr=tmp_(length(tmp)-1); + size=""; + eqL=tmp_5; + if(length(eqL)>0, + forall(eqL, + tmp=substring(#,0,1); + if(tmp=="s" % tmp=="S", + tmp=indexof(#,"="); + size=substring(#,tmp,length(#)); + ); + ); + ); + tmp=MeasureDepth(list); + if(tmp>0, // 2015.02.21 + if(tmp==1,ptlist=list,ptlist=list_1); + tmp=apply(ptlist,[textformat(Pcrd(#),5)]); + tmp1=text(tmp); + tmp2=substring(tmp1,1,length(tmp1)-1); + tmp3=tmp1; + , + ptlist=list; + tmp1=textformat(Pcrd(ptlist),5); + tmp2=tmp1; + tmp3="["+tmp1+"]"; + ); + tmp=name+"="+tmp1; + parse(tmp); + tmp=nameL+"="+tmp3; + parse(tmp); + if(Noflg<3, + GLIST=append(GLIST,name+"=Pointdata("+tmp2+")"); + ); + if(Noflg<2, + tmp=[nameL,0,opcindy]; + GCLIST=append(GCLIST,tmp); + if(Noflg==0, + if(length(size)>0, + Com2nd("Setpt("+size+")"); + ); + thick=PenThick/PenThickInit; // 16.04.09 from + if(length(size)>0,tmp1=parse(size),tmp1=1); + tmp1=max(tmp1,1)/8; + Setpen(tmp1); // 16.04.09 upto + Com2nd("Drwpt(list("+name+")"+opstr+")"); + Setpen(thick); // 16.04.09 + if(length(size)>0, + Com2nd("Setpt("+textformat(TenSize/TenSizeInit,1)+")"); + ); + ); + ); + ptlist; +); + +Listplot(nm,list,options):=( +//help:Listplot([A,B]); +// help:Listplot(["A","B"]); +//help:Listplot("1",[[2,1],[3,3]]); +//help:Listplot(options2=["Msg=yes"]); + regional(name,tmp,tmp1,ptlist,Ltype,opcindy,Noflg,eqL,Msg); + if(substring(nm,0,1)=="-", // 16.01.27 from + name=substring(nm,1,length(nm)); + , + name="sg"+nm; + ); // upto + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + eqL=tmp_5; + opcindy=tmp_(length(tmp)); + Msg=1; // 15.09.17 + forall(eqL, + tmp=substring(#,0,1); + if(Toupper(tmp)=="M", + tmp=indexof(#,"="); + tmp1=substring(#,tmp,tmp+1); // 16.06.28 + if(Toupper(tmp1)=="N", // 16.06.28 + Msg=0; + ); + ); + ); + if(Noflg<3, + if(Msg==1, + println("generate Listplot "+name); + ); + if(isstring(list_1),tmp=apply(list,parse(#)),tmp=list); // 15.03.24 + ptlist=apply(tmp,Pcrd(#)); + tmp=name+"="+textformat(ptlist,5); + parse(tmp); + GLIST=append(GLIST,name+"=Listplot("+textformat(list,5)+")"); // 15.12.23 + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + tmp1=apply(list,Lcrd(#)); + tmp1; +); +Listplot(Arg1,Arg2):=( + regional(name,list,options,str); + if(isstring(Arg1), + name=Arg1; + list=Arg2; + Listplot(name,list,[]); + , + list=Arg1; + options=Arg2; + name=""; + forall(list, // 16.10.07from + name=name+#.name; + );// 16.10.07upto + Listplot(name,list,options); + ); +); +Listplot(list):=Listplot(list,[]); + +Lineplot(nm,list,options):=( +//help:Lineplot([A,B]); +//help:Lineplot("1",[[2,1],[3,3]]); + regional(name,Out,tmp,tmp1,opstr,opcindy,Mag,Semi, + Vec,pA,pB,Ltype,Noflg); + name="ln"+nm; + Mag=100; + Semi=""; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + opstr=tmp_(length(tmp)-1); + tmp1=tmp_6; + if(length(tmp1)>0,Mag=tmp1_1); + tmp1=tmp_7; + if(length(tmp1)>0,Semi=tmp1_1); + pA=Lcrd(list_1); pB=Lcrd(list_2); + Vec= Mag/dist(pA,pB)*(pB-pA); + if(length(Semi)==0, + Out=[pA-Vec,pA+Vec]; + , + if(Semi=="+", + Out=[pA,pA+Vec]; + , + Out=[pA-Vec,pA]; + ); + ); + if(Noflg<3, + println("generate Lineplot "+name); + tmp1=apply(Out,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + GLIST=append(GLIST,name+"=Lineplot("+textformat(list,5)+opstr+")"); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + Out; +); +Lineplot(Arg1,Arg2):=( + regional(name,list,options,str); + if(isstring(Arg1), + name=Arg1; + list=Arg2; + Lineplot(name,list,[]); + , + list=Arg1; + options=Arg2; + name=""; + forall(list, // 16.10.07from + name=name+#.name; + );// 16.10.07upto + Lineplot(name,list,options); + ); +); +Lineplot(list):=Lineplot(list,[]); + +Plotdata(name1,func,variable):=Plotdata(name1,func,variable,[]); +Plotdata(name1,func,variable,options):=( +//help:Plotdata("1","sin(x)","x",["Num=100"]); +//help:Plotdata("2","x^2","x=[-1,1]"); +//help:Plotdata("3","Fout(x)","x",["out"]); + regional(Fn,Va,tmp,tmp1,tmp2,eqL,name,Vname,x1,x2,dx, + PdL,QdL,Num,Ec,Dc,Fun,Exfun,x,Ke,Eps,Pa, + Ltype,Noflg,Inflg,Outflg,opstr,opcindy); + name="gr"+name1; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + Inflg=tmp_3; + Outflg=tmp_4; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + eqL=tmp_5; + Num=50; + Ec=[]; + Exfun=""; + Dc=1000; + forall(eqL, + tmp=indexof(#,"="); + tmp1=substring(#,tmp,length(#)); + opstr=opstr+",'"+#+"'"; + if(substring(#,0,1)=="N", + Num=parse(tmp1); + ); + if(substring(#,0,1)=="E", + if(substring(tmp1,0,1)=="[", + Ec=parse(tmp1); + , + Exfun=tmp1; + ); + ); + if(substring(#,0,1)=="D", + Dc=parse(tmp1); + ); + ); + if(Inflg==0 & Outflg==0, + Eps=10^(-3); + tmp=replace(func,LFmark,""); + tmp=tokenize(variable,"="); + Vname=tmp_1; + if(length(tmp)>1, + tmp=tmp_2; + tmp=parse(tmp); + x1=tmp_1; + x2=tmp_2; + , + x1=XMIN; + x2=XMAX; + ); + // dx=(x2-x2)/Num; + Ec=append(sort(Ec),10000); + Fun=Assign(func,Vname, "xx"); + Exfun=Assign(Exfun,Vname, "xx"); + PdL=[]; + Ke=1; + forall(0..Num, + xx=x1+#*(x2-x1)/Num; // differs from Scilab ( / Num-1) + if(length(Exfun)>0, + tmp=parse(Exfun); + if(abs(tmp)0, + PdL=concat(PdL,["inf"]); + ); + ); + , + Pa=[]; + if(xx-Ec_Ke<-Eps, + Pa=[xx,parse(Fun)]; + ); + if(abs(xx-Ec_Ke)<=Eps, + if(length(PdL)>0, + if(PdL_(length(PdL))_1!="inf", + Pa=["inf"]; + ); + ); + ); + if(xx-Ec_Ke>Eps, + Pa=[xx,parse(Fun)]; + Ke=Ke+1; + ); + if(length(Pa)>0, + if(Pa_1=="inf", + PdL=concat(PdL,[Pa]); + , + if(length(PdL)==0, + PdL=[Pa]; + , + tmp=PdL_(length(PdL)); + if(tmp_1=="inf", + PdL=concat(PdL,[Pa]); + , + if(dist(tmp,Pa)tmp, + tmp1=concat(tmp1,[PdL_(tmp..(#-1))]) + ); + tmp=#+1; + ); + if(tmp0 15.05.15 + if(Noflg<3, + if(Outflg==1, + println("Output Plotdata "+name); + tmp=name+"=Plotdata('"+func+"','"+variable+"'"+opstr+")"; + GLIST=append(GLIST,tmp); + SCIWRLIST=append(SCIWRLIST,name); + if(Inflg==0,Inflg=1); // 15.05.17 + ); + if(Inflg==1, + println("Input Plotdata "+name); + if(length(SCIRELIST)==0, + ReadOutData(Fnameout); + ); + tmp=parse(name); + if(islist(tmp), + Extractdata(name,["nodisp"]); // 12.19 + ); + tmp="// "+name+"=Plotdata('"+func+"','"+variable+"'"+opstr+")"; + Com1st(tmp); + SCIRELIST=append(SCIRELIST,name); + ); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + if(Inflg==1, + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + ); + ); +); + +Paramplot(name1,funstr,variable):=Paramplot(name1,funstr,variable,[]); +Paramplot(name1,funstr,variable,options):=( +//help:Paramplot("1","[2*cos(t),sin(t)]","t=[0,2*pi]"); + regional(name,Out,tmp,tmp1,tmp2,vname,func,str,Rng,Num, + Ec,Exfun,Dc,eqL,Fntmp,Vatmp,t1,t2,dt,tt,pa,ke, + Ltype,Noflg,Inflg,Outflg,opstr,opcindy); + name="gp"+name1; + Eps=10^(-4); + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + Inflg=tmp_3; + Outflg=tmp_4; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + eqL=tmp_5; + Num=50; + Ec=[]; + Exfun=""; + Dc=1000; + forall(eqL, + tmp=indexof(#,"="); + tmp1=substring(#,tmp,length(#)); + opstr=opstr+",'"+#+"'"; + if(substring(#,0,1)=="N", + Num=parse(tmp1); + ); + if(substring(#,0,1)=="E", + if(substring(tmp1,0,1)=="[", + Ec=parse(tmp1); + , + Exfun=tmp1; + ); + ); + if(substring(#,0,1)=="D", + Dc=parse(tmp1); + ); + ); + if(Inflg==0 & Outflg==0, + tmp=indexof(variable,"="); + vname=substring(variable,0,tmp-1); + str=substring(variable,tmp,length(variable)); + Rng=parse(str); + t1=Rng_1; t2=Rng_2; + dt=(t2-t1)/Num;// differs from Scilab ( / Num-1) + func=Assign(funstr,vname,"tt"); + Out=[]; + Ec=append(sort(Ec),10000); + ke=1; + forall(0..Num, + pt=[]; + tt=Rng_1+#*dt; + if(tt-Ec_ke<-Eps, + pa=parse(func); + ); + if(abs(tt-Ec_ke)<=Eps, + if(length(Out)>0, + if(Out_(length(Out))_1!="inf", + pa=["inf"]; + ); + ); + ); + if(tt-Ec_ke>Eps, + pa=parse(func); + ke=ke+1; + ); + if(length(pa)>0, + if(pa_1=="inf", + Out=append(Out,pa); + , + if(length(Out)==0, + Out=[pa]; + , + tmp=Out_(length(Out)); + if(tmp_1=="inf", + Out=append(Out,pa); + , + if(|tmp-pa|tmp, + tmp1=concat(tmp1,[Out_(tmp..(#-1))]) + ); + tmp=#+1; + ); + if(tmp0 15.05.15 + if(Noflg<3, + if(Outflg==1, + println("Output Paramplot "+name); + tmp=name+"=Paramplot('"+funstr+"','"+variable+"'"+opstr+")"; + GLIST=append(GLIST,tmp); + SCIWRLIST=append(SCIWRLIST,name); + if(Inflg==0,Inflg=1); // 15.05.17 + ); + if(Inflg==1, + println("Input Paramplotdata "+name); + if(length(SCIRELIST)==0, + ReadOutData(Fnameout); + ); + tmp=parse(name); + if(islist(tmp), + Extractdata(name,["nodisp"]); // 12.19 + ); + tmp="// "+name+"=Paramplot('"+func+"','"+variable+"'"+opstr+")"; + Com1st(tmp); + SCIRELIST=append(SCIRELIST,name); + ); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + if(Inflg==1, + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + ); + ); +); + +Circledata(cenrad):=Circledata(cenrad,[]); +Circledata(para1,para2):=( +//help:Circledata([A,B],["Rng=[0,pi/2]"]); +//help:Circledata([A,B,C]); + regional(name,cenrad,options,str,n); + if(isstring(para1), + name=para1; + cenrad=para2; + options=[]; + , + cenrad=para1; + options=para2; + name="";// 16.10.07from + forall(cenrad, + name=name+#.name; + );// 16.10.07upto + ); + Circledata(name,cenrad,options); +); +Circledata(nm,cenrad,options):=( + regional(name,Out,Ctr,Ptcir,ra,Num,Rg,opstr,opcindy, + tmp,tmp1,tmp1,Th,Ltype,Noflg,eqL,pA,pB,pC,d1,d2,Eps); + name="cr"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + eqL=tmp_5; + Num=50; + Rg=[0,2*pi]; + forall(eqL, + tmp=indexof(#,"="); + tmp1=substring(#,tmp,length(#)); + opstr=opstr+",'"+#+"'"; + if(substring(#,0,1)=="N", + Num=parse(tmp1); + ); + if(substring(#,0,1)=="R", + Rg=parse(tmp1); + ); + ); + if(length(cenrad)==2, + Ctr=Lcrd(cenrad_1); + Ptcir=Lcrd(cenrad_2); + ra=dist(Ctr,Ptcir); + , + Eps=10^(-1); + pA=Lcrd(cenrad_1); + pB=Lcrd(cenrad_2); + pC=Lcrd(cenrad_3); + tmp=pB-pA; + tmp1=(tmp_2,-tmp_1); + tmp=pC-pB; + tmp2=(tmp_2,-tmp_1); + d1=det([tmp1,tmp2]); + d2=det([pC-pA,tmp2]); + if(abs(d1)10*Eps, + println("points are in a line"); + ra=0; + , + Ctr=1/2*(pA+pB)+1/2*d2/d1*tmp1; + ra=|pA-Ctr|; + tmp=name+"center="+Ctr; + parse(tmp); + Defvar(name+"center",Ctr); + ); + ); + if(ra>0, + Out=[]; + forall(0..Num, + Th=Rg_1+#*(Rg_2-Rg_1)/Num; + Out=append(Out,Ctr+ra*[cos(Th),sin(Th)]); + ); + , + Out=Lineplot("1",[pA,pB],["nodata"]); + ); + if(Noflg<3, + println("generate Circledata "+name); + tmp1=apply(Out,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + if(length(cenrad)==2, + tmp=name+"=Circledata("+cenrad+opstr+")"; + , + if(ra>0, + tmp=name+"=Circledata(["+Ctr+","+cenrad_1+"]"+opstr+")"; + , + tmp=name+"=Lineplot("+cenrad_1+","+cenrad_2+")"; + ); + ); + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + Out; +); + +Framedata():=( + regional(pA,pB); + pA=LLcrd((SW+NE)/2); // 15.09.17 + pB=LLcrd(NE); + Framedata("win",[pA,pB]); +); +Framedata(list):=Framedata(list,[]); +Framedata(Arg1,Arg2):=( + regional(name,list,options,str); + if(isstring(Arg1), + name=Arg1; + list=Arg2; + Framedata(name,list,[]); + , + list=Arg1; + options=Arg2; + name="";// 16.10.07from + forall(list, + name=name+#.name; + );// 16.10.07upto + Framedata(name,list,options); + ); +); + +Framedata(nm,list,options):=( +//help:Framedata(); +//help:Framedata([A,B]); +//help:Framedata("1",[A,B]); +//help:Framedata("1",[C,dx,dy]); + regional(name,Out,tmp,tmp1,pB,x1,x2,y1,y2,dx,dy, + opcindy,Ltype,Noflg,cent,dx,dy); + name="fr"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + if(length(list)==2, // 15.05.12 + pA=Lcrd(list_1); pB=Lcrd(list_2); + dx=abs(pB_1-pA_1); dy=abs(pB_2-pA_2); + , + pA=Lcrd(list_1); + dx=list_2; dy=list_3; + ); + x1=pA_1-dx; x2=pA_1+dx; + y1=pA_2-dy; y2=pA_2+dy; + Out=[[x1,y1],[x2,y1],[x2,y2],[x1,y2],[x1,y1]]; + if(Noflg<3, + println("generate Framedata "+name); + tmp1=apply(Out,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + GLIST=append(GLIST,name+"=Framedata("+pA+","+dx+","+dy+")"); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + Out; +); +Framedata(nm,cent,dx,dy):=Framedata(nm,cent,dx,dy,[]); +Framedata(nm,cent,dx,dy,options):=( + regional(name,Out,tmp,tmp1,x1,y1,x2,y2,Ltype,opcindy,Noflg); + name="fr"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + x1=cent.x-dx; x2=cent.x+dx; + y1=cent.y-dy; y2=cent.y+dy; + Out=[[x1,y1],[x2,y1],[x2,y2],[x1,y2],[x1,y1]]; + if(Noflg<3, + println("generate Framedata "+name); + tmp1=apply(Out,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + GLIST=append(GLIST,name+"=Framedata("+cent.xy+","+dx+","+dy+")"); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + Out; +); + +Framedata2(nm,list):=Framedata2(nm,list,[]); +Framedata2(nm,list,options):=( +//help:Framedata2("1",[A,B]); + regional(tmp,tmp1,pC,pB); + pC=(Lcrd(list_1)+Lcrd(list_2))/2; + pB=Lcrd(list_2); + Framedata(nm,[pC,pB],options); +); + +Ovaldata(nm,Pdata):=Ovaldata(nm,Pdata,[]); +Ovaldata(nm,Pdata,options):=( +//help:Ovaldata("1",[A,B]); +//help:Ovaldata(optios=[size]); + regional(name,Graph,Ctr,Dx,Dy,Rc,Out,Point,Graph, + opstr,opcindy,tmp,tmp1,tmp2,tmp3,Ltype,Noflg); + name="ov"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + opstr=tmp_(length(tmp)-1); + Rc=0.2; + tmp1=tmp_6; + if(length(tmp1)>0,Rc=tmp1_1*Rc); +// if(length(tmp1)>0,Rc=tmp1_1); //15.11.15 + Ctr=Lcrd(Pdata_1); + if(ispoint(Pdata_2) % islist(Pdata_2), + tmp1=Lcrd(Pdata_2); + Dx=abs(tmp1_1-Ctr_1); + Dy=abs(tmp1_2-Ctr_2); + , + Dx=Pdata_2; + Dy=Pdata_3; + ); + Point=Ctr+[Dx-Rc,Dy-Rc]; + tmp1=Circledata("1",[Point,Point+[Rc,0]], + ["Rng=[0,pi/2]","Num=10","nodata"]); + tmp2=Listplot("1",[Ctr+[Dx-Rc,Dy],Ctr+[0,Dy]], + ["nodata"]); + tmp3=Listplot("2",[Ctr+[Dx,0],Ctr+[Dx,Dy-Rc]], + ["nodata"]); + Graph=Joincrvs("1",[tmp3,tmp1,tmp2],["nodata"]); + tmp1=Reflectdata("1",[Graph],[Ctr,Ctr+[0,1]],["nodata"]); + Graph=Joincrvs("1",[Graph,tmp1],["nodata"]); + tmp2=Reflectdata("2",[Graph],[Ctr,Ctr+[1,0]], + ["nodata"]); + Graph=Joincrvs("2",[Graph,tmp2],["nodata"]); + if(Noflg<3, + println("generate Ovaldata "+name); + tmp1=apply(Graph,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + GLIST=append(GLIST, + name+"=Ovaldata("+Ctr+","+Dx+","+Dy+opstr+")");//16.01.30 + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + tmp1=apply(Graph,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp=textformat(Ctr,5)+","+textformat(Dx,5)+","+textformat(Dy,5); + GLIST=append(GLIST, + name+"=Ovaldata("+tmp+opstr+")"); + ); + Graph; +); + +Segmark(nm,ptlist):=Segmark(nm,ptlist,[]); +Segmark(nm,ptlist,options):=Drawsegmark(nm,ptlist,options); +Drawsegmark(nm,ptlist):=Drawsegmark(nm,ptlist,[]); +Drawsegmark(nm,ptlist,options):=( +//help:Segmark("1",[A,B]); +//help:Segmark(options=["Type=1","Width=1","Size=1"]); + regional(name,pA,pB,wid,mid,size,tp,dir,nor,eqL, + tmp,tmp1,tmp2); + name="mrk"+nm; + pA=ptlist_1; + pB=ptlist_2; + size=0.15; + wid=0.05; + tp=1; + tmp1=Divoptions(options); + eqL=tmp1_5; + forall(eqL, + tmp=indexof(#,"="); + tmp1=substring(#,tmp,length(#)); + tmp1=parse(tmp1); + tmp=substring(#,0,1); + if(tmp=="S" % tmp=="s", + size=size*tmp1; + ); + if(tmp=="W" % tmp=="w", + wid=wid*tmp1; + ); + if(tmp=="T" % tmp=="t", + tp=tmp1; + ); + ); + mid=(pA+pB)/2; + dir=(pB-pA)/|pB-pA|; + nor=[-dir_2,dir_1]; +// nor=nor/|nor|; + if(tp==1, + tmp1=mid+size*nor; + tmp2=mid-size*nor; + Listplot(name,[tmp1,tmp2]); + ); + if(tp==2, + tmp1=mid+wid*dir+size*nor; + tmp2=mid+wid*dir-size*nor; + Listplot(name+"r",[tmp1,tmp2]); + tmp1=mid-wid*dir+size*nor; + tmp2=mid-wid*dir-size*nor; + Listplot(name+"l",[tmp1,tmp2]); + ); + if(tp==3, + tmp1=mid; + tmp2=mid+size*dir; + Circledata(name,[tmp1,tmp2]); + ); + if(tp==4, + tmp=mid+size*2/sqrt(3)*nor; + tmp1=mid+size*dir-size/sqrt(3)*nor; + tmp2=mid-size*dir-size/sqrt(3)*nor; + Listplot(name,[tmp,tmp1,tmp2,tmp]); + ); +); + +Parabolaplot(nm,ptlist):=Parabolaplot(nm,ptlist,"[-5,5]",[]); +Parabolaplot(nm,ptlist,Arg):=( + regional(rng,options); + if(isstring(Arg), + rng=Arg; + options=[]; + , + rng="[-5,5]"; + options=Arg; + ); + Parabolaplot(nm,ptlist,rng,options); +); +Parabolaplot(nm,ptlist,rng,options):=( +//help:Parabolaplot("1",[A,B,C]): +//help:Parabolaplot("1",[A,B,C],"[-5,5]"); + regional(pA,pB,pC,angle,tmp,tmp1,tmp2); + tmp1=Lcrd(ptlist_1); + tmp2=Lcrd(ptlist_3); + pB=Lcrd(ptlist_2); + tmp=(tmp2-pB)/|tmp2-pB|; + if(tmp_2>=0, + angle=arccos(tmp_1); + , + if(tmp_1>=0, + angle=arcsin(tmp_2); + , + angle=-arccos(tmp_1); + ); + ); + pA=Rotatepoint(tmp1,-angle,pB); + pC=Rotatepoint(tmp2,-angle,pB); + tmp1=1/(2*(pA_2-pB_2)); + tmp2=1/2*(pA_2+pB_2); + tmp="("+format(tmp1,5)+")*(x-("+format(pA_1,5)+"))^2"; + tmp=tmp+"+("+format(tmp2,5)+")"; + tmp1=parse(rng); + tmp1=[pA_1-(tmp1_2-tmp1_1)/2,pA_1+(tmp1_2-tmp1_1)/2]; + tmp2="x="+textformat(tmp1,5); + Plotdata(nm+"para",tmp,tmp2,append(options,"nodisp")); + Rotatedata(nm+"para","gr"+nm+"para",angle,append(options,pB)); +); + +Ellipseplot(nm,ptlist):=Ellipseplot(nm,ptlist,"[0,2*pi]",[]); +Ellipseplot(nm,ptlist,Arg):=( + regional(rng,options); + if(isstring(Arg), + rng=Arg; + options=[]; + , + rng="[0,2*pi]"; + options=Arg; + ); + Ellipseplot(nm,ptlist,rng,options); +); +Ellipseplot(nm,ptlist,rng,options):=( +//help:Ellipseplot("1",[A,B,3]); +//help:Ellipseplot("1",[A,B,C],"[0,pi]",[options]); + regional(pA,pB,d,angle,f,a,b,pM,tmp,tmp1,tmp2); + pA=Lcrd(ptlist_1); + tmp1=Lcrd(ptlist_2); + if(ispoint(ptlist_3), + tmp2=Lcrd(ptlist_3); + d=|tmp2-pA|+|tmp2-tmp1|; + , + d=ptlist_3; + ); + tmp=(tmp1-pA)/|tmp1-pA|; + if(tmp_2>=0, + angle=arccos(tmp_1); + , + if(tmp_1>=0, + angle=arcsin(tmp_2); + , + angle=-arccos(tmp_1); + ); + ); + pB=Rotatepoint(tmp1,-angle,pA); + f=|pB_1-pA_1|/2; + a=d/2; + b=sqrt(d^2/4-f^2); + pM=(pA+pB)/2; + tmp="["+format(pM_1,5)+","+format(pM_2,5)+"]"; + tmp=tmp+"+["+format(a,5)+"*cos(t),"+format(b,5)+"*sin(t)]"; + Paramplot(nm+"elp",tmp,"t="+rng,append(options,"nodisp")); + Rotatedata(nm+"elp","gp"+nm+"elp",angle,append(options,pA)); +); + +Hyperbolaplot(nm,ptlist):=Hyperbolaplot(nm,ptlist,"[-5/2,5/2]",[]); +Hyperbolaplot(nm,ptlist,Arg):=( + regional(rng,options); + if(isstring(Arg), + rng=Arg; + options=[]; + , + rng="[-5/2,5/2]"; + options=Arg; + ); + Hyperbolaplot(nm,ptlist,rng,options); +); +Hyperbolaplot(nm,ptlist,rng,optionsorg):=( +//help:Hyperbolaplot("1",[A,B,C],["Num=200"]): +//help:Hyperbolaplot("1",[A,B,C],"[-5,5]",["Asy=do"]); + regional(pA,pB,d,angle,f,a,b,pM,eqL,options,opasy,tmp,tmp1,tmp2); + tmp=Divoptions(optionsorg); + eqL=tmp_5; + options=optionsorg; + opasy=[]; + forall(eqL, + if(Toupper(substring(#,0,1))=="A", + tmp=indexof(#,"="); + opasy=[substring(#,tmp,length(#))]; + options=remove(options,[#]); + ); + ); + pA=Lcrd(ptlist_1); + tmp1=Lcrd(ptlist_2); + if(ispoint(ptlist_3), + tmp2=Lcrd(ptlist_3); + d=abs(|tmp2-pA|-|tmp2-tmp1|); + , + d=ptlist_3; + ); + tmp=(tmp1-pA)/|tmp1-pA|; + if(tmp_2>=0, + angle=arccos(tmp_1); + , + if(tmp_1>=0, + angle=arcsin(tmp_2); + , + angle=-arccos(tmp_1); + ); + ); + pB=Rotatepoint(tmp1,-angle,pA); + f=|pB_1-pA_1|/2; + a=d/2; + b=sqrt(f^2-d^2/4); + pM=(pA+pB)/2; + tmp="["+format(pM_1,5)+"+"+format(a,5)+"*(exp(t)+exp(-t))/2,"; + tmp=tmp+format(pM_2,5)+"+"+format(b,5)+"*(exp(t)-exp(-t))/2]"; + Paramplot(nm+"hyp1",tmp,"t="+rng,append(options,"nodisp")); + tmp="["+format(pM_1,5)+"-"+format(a,5)+"*(exp(t)+exp(-t))/2,"; + tmp=tmp+format(pM_2,5)+"+"+format(b,5)+"*(exp(t)-exp(-t))/2]"; + Paramplot(nm+"hyp2",tmp,"t="+rng,append(options,"nodisp")); + tmp=["gp"+nm+"hyp1","gp"+nm+"hyp2"]; + Rotatedata(nm+"hyp",tmp,angle,append(options,pA)); + if(length(opasy)>0, + Lineplot(nm+"asy1",[pM+[a,b],pM+[-a,-b]],["nodisp"]); + Lineplot(nm+"asy2",[pM+[-a,b],pM+[a,-b]],["nodisp"]); + tmp=["ln"+nm+"asy1","ln"+nm+"asy2"]; + Rotatedata(nm+"asy",tmp,angle,append(opasy,pA)); + ); +); + +Polygonplot(nm,ptlist,number):=Polygonplot(nm,ptlist,number,[]); +Polygonplot(nm,ptlist,number,options):=( +//help:Polygonplot("1",[A,B],12); + regional(rr,pA,pB,ptL,angle,tmp,tmp1,tmp2); + pA=Lcrd(ptlist_1); + pB=Lcrd(ptlist_2); + rr=|pB-pA|; + tmp=(pB-pA)/rr; + if(tmp_2>=0, + angle=arccos(tmp_1); + , + if(tmp_1>=0, + angle=arcsin(tmp_2); + , + angle=-arccos(tmp_1); + ); + ); + ptL=[]; + forall(0..number, + tmp=angle+#*2*pi/number; + tmp1=pA+rr*[cos(tmp),sin(tmp)]; + if(#>0 & #0, + Putpoint(nm,tmp_ptno); + , + err("No intersect point"); + ); +); + +Arrowheaddata(point,direction):=Arrowheaddata(point,direction,[]); +Arrowheaddata(point,direction,options):=( +//help:Arrowheaddata(A,B); + regional(list,Ookisa,Hiraki,Futosa,Houkou,Str,Flg,tmp,Ev,Nv,pA,pB, + pP,rF,gG,Flg,Nj,Eps,tmp1,scx,scy); + Eps=10^(-3); + pP=point; + Ookisa=0.2*YaSize; + Hiraki=YaAngle; + Futosa=0; + Str=YaStyle; + tmp=Divoptions(options); + tmp1=tmp_6; + if(length(tmp1)>0,Ookisa=Ookisa*tmp1_1); + if(length(tmp1)>1, + tmp=tmp1_2; + if(tmp<5, + Hiraki=Hiraki*tmp; + , + Hiraki=tmp; + ); + ); + Flg=0; + Hiraki=Hiraki*pi/180; + if(isstring(direction),Houkou=parse(direction),Houkou=direction); + if(MeasureDepth(Houkou)==2,Houkou=Houkou_1); + if(islist(Houkou_1), +// pP=Lcrd(pP); +// pP=Doscaling(pP); +// Houkou=Dosscaling(Houkou); + pP=Pcrd(pP); + scy=SCALEY; + SCALEY=1; + tmp=Nearestpt(pP,Houkou); + pA=tmp_1; + rF=floor(tmp_2); + if(rF==1, + if(|Ptend(Houkou)-Ptstart(Houkou)|0, + Houkou=pP-tmp_1_1; + Flg=1; + ); + pA=pB; + ); + ); + SCALEY=scy; + if(Flg==0, + println("Arrowhead may be too large (no intersect)"); + Flg=2; + ); + if(Flg==1, + Houkou=Unscaling(Houkou); + pP=Unscaling(pP); + ); + ); + if(Flg<2, +// pP=Doscaling(pP); +// Houkou=Doscaling(Houkou); + pP=Pcrd(pP); + if(!ispoint(point), + Houkou=Pcrd(Houkou); + ); +// if(MeasureDepth(Houkou)==0,Houkou=Pcrd(Houkou)); + Ev=-1/|Houkou|*Houkou; + Ev=Lcrd(Ev); + Nv=[-Ev_2, Ev_1]; + if(indexof(Str,"c")>0, + pP=pP-0.5*Ookisa*cos(Hiraki)*Ev; + ); + if(indexof(Str,"b")>0, + pP=pP-Ookisa*cos(Hiraki)*Ev; + ); + pA=pP+Ookisa*cos(Hiraki)*Ev+Ookisa*sin(Hiraki)*Nv; + pB=pP+Ookisa*cos(Hiraki)*Ev-Ookisa*sin(Hiraki)*Nv; + list=[pA,pP,pB]; + list=apply(list,LLcrd(#)); +// Out=Unscaling(Out); + list; + ); +); + +Arrowhead(point,Houkou):=Arrowhead(point,Houkou,[]); +Arrowhead(point,Houkou,options):=( +//help:Arrowhead(B,B-A,[1.5,30]); +//help:Arrowhead(A,"gr1"); + // global ArrowheadNumber + regional(name,Ltype,Noflg,reL,opstr,opcindy,ptstr,hostr,tmp,tmp1,list); + name="arh"+text(ArrowheadNumber); + ArrowheadNumber=ArrowheadNumber+1; + ptstr=textformat(point,5); + if(isstring(Houkou), // 15.01.11 + tmp=parse(Houkou); + if(MeasureDepth(tmp)<2, + hostr=Houkou; + , + hostr=Houkou+"(1)"; + ); + , + if(ispoint(point), + hostr=textformat(LLcrd(Houkou),5); + , + hostr=textformat(Houkou,5); + ); + ); + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + reL=tmp_6; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + list=Arrowheaddata(point,Houkou,options); + if(Noflg<3, +// println("generate Arrowhead "+name); + tmp1=apply(list,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); +// GLIST=append(GLIST,name+"=Listplot("+list+")"); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(1)+Ltype,name); + , +// if(Noflg==1,Ltype=0); + Ltype=0; + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + if(Noflg==0, + if(length(reL)<3, // 16.04.09 from + forall(1..(2-length(reL)), + opstr=opstr+",1"; + ); + tmp=PenThick/PenThickInit; + opstr=opstr+","+text(tmp); + ); // 16.04.09 upto + Com2nd("Arrowhead("+ptstr+","+hostr+opstr+")"); + ); +); + +Arrowdata(ptlist):=Arrowdata(ptlist,[]); +Arrowdata(Arg1,Arg2):=( + regional(tmp,nm,ptlist,flg,pA,pB,options); + flg=0; + if(isstring(Arg1), + nm=Arg1; + ptlist=Arg2; + Arrowdata(nm,ptlist,[]); + flg=1; + ); + if(flg==0, + tmp=MeasureDepth(Arg1); + if(tmp==0, + pA=Arg1; + pB=Arg2; + Arrowdata(pA,pB,[]); + , + ptlist=Arg1; + options=Arg2; + nm=text(ArrowlineNumber); + ArrowlineNumber=ArrowlineNumber+1; + Arrowdata(nm,ptlist,options); + ); + ); +); +Arrowdata(Arg1,Arg2,options):=( +//help:Arrowdata([A,B],[2,10]); + regional(Retflg,nm,ptlist,name,opstr,opcindy,realL,strL,size, + flg,Ltype,Noflg,lineflg,tmp,tmp1,tmp2,pA,pB,segpos); + Retflg=0; + Noflg=0; + Ltype=0; + if(!isstring(Arg1), + pA=Arg1; + pB=Arg2; + Arrowdata(pA,pB,options,"old"); + Retflg=1; + ptlist=[pA,pB]; + ); + if(Retflg==0, + nm=Arg1; + ptlist=Arg2; + name="ar"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + realL=tmp_6; + strL=tmp_7; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + size=1; // 15.06.11 + if(length(realL)>0, + size=realL_1; + ); + tmp2=select(strL,indexof(#,"l")>0); // 16.04.09 + if(length(tmp2)>0,lineflg=1,lineflg=0); // 16.04.09 + segpos=1; + tmp1=tmp_5; + if(length(tmp1)>2, + segpos=tmp1_3; + ); + if(Noflg<3, +// println("generate Arrowdata "+name); + tmp1=apply(ptlist,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp1=Pcrd(ptlist_1);//16.10.20 + tmp2=Pcrd(ptlist_2);//16.10.20 + if(lineflg==0, // 16.04.09 from + tmp=tmp2-0.2*size/2*(tmp2-tmp1)/|tmp2-tmp1|; // 15.06.11 + , + tmp=tmp2; + ); // 16.04.09 upto + tmp=[LLcrd(tmp1),LLcrd(tmp)];//16.10.20 + GLIST=append(GLIST,name+"=Listplot("+textformat(tmp,5)+")"); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + tmp=textformat(ptlist,5); + tmp=substring(tmp,1,length(tmp)-1); + tmp1=indexof(tmp,"],["); + if(tmp1>0, + pA=substring(tmp,0,tmp1); + pB=substring(tmp,tmp1+1,length(tmp)); + , + tmp1=indexof(tmp,","); + pA=substring(tmp,0,tmp1-1); + pB=substring(tmp,tmp1,length(tmp)); + ); + tmp1="Lcrd("+pA+")+" + +textformat(segpos,5)+"*(Lcrd("+pB+")-"+"Lcrd("+pA+"))"; + tmp1=parse(tmp1); + tmp2="Lcrd("+pB+")-Lcrd("+pA+")"; + tmp2=parse(tmp2); + Arrowhead(tmp1,tmp2,options); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + ); + ptlist; +); +Arrowdata(pA,pB,options,str):=( + regional(ptA,ptB,opstr,Astr,Bstr,name,tmp,opcindy); + Astr=textformat(pA,5); + Bstr=textformat(pB,5); + name="ar"+pA.name+pB.name; + println("generate Arrow "+name); + opstr=""; + opcindy=""; + forall(options, + if(isstring(#), + if(indexof(#,"->")>0, + opcindy=opcindy+","+#; + , + tmp="'"+#+"'"; + ); + , + tmp=text(#); + ); + opstr=opstr+","+tmp; + ); + ptA=Lcrd(pA); + ptB=Lcrd(pB); + Arrowheaddata(ptB,ptB-ptA,options); + tmp="connect("+textformat([ptA,ptB],5) + +",linecolor->"+text(KCOLOR)+opcindy+");"; + parse(tmp); // 14.11.17 + Com2nd("Arrowline("+Astr+","+Bstr+opstr+")"); // 14.10.04 +); + +Anglemark(plist):=Anglemark(plist,[]); +Anglemark(Arg1,Arg2):=( // 2015.04.28 from + regional(nm,plist,options,tmp); + if(isstring(Arg1), + nm=Arg1; + plist=Arg2; + Anglemark(nm,plist,[]); + , + plist=Arg1; + options=Arg2; + tmp=textformat(plist,5); + tmp=replace(tmp,",",""); + nm=substring(tmp,1,length(tmp)-1); + Anglemark(nm,plist,options); + ); +); // upto +Anglemark(nm,plist,options):=( +//help:Anglemark([A,B,C],["E=\theta",2]); +//help:Anglemark("1",[A,B,C],["E=1.2,\theta",2]); +//help:Anglemark(options=["E/L=(sep,)letter",size]); + regional(name,Out,pB,pA,pC,Ctr,ra,sab,sac,ratio,opstr,Bname,Bpos, + Brat,tmp,tmp1,tmp2,Num,opcindy,Ltype,eqL,realL,Rg,Th,Noflg); + name="ag"+nm; + ra=0.5; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + eqL=tmp_5; + realL=tmp_6; + Bname=""; + Brat=1.5; + Num=20; + if(length(realL)>0, + ra=realL_1*ra; + opstr=opstr+","+text(realL_1); + ); + forall(eqL, + if(substring(#,0,1)=="L",Bname="Letter("); + if(substring(#,0,1)=="E",Bname="Expr("); + Bpos="md"+name; + Bname=Bname+Bpos+","+Dq+"c"+Dq+","+Dq;//16.10.29 + tmp=substring(#,indexof(#,"="),length(#)); + tmp1=indexof(tmp,","); + Bname=Bname+substring(tmp,tmp1,length(tmp))+Dq+")"; + if(tmp1>0, + Brat=parse(substring(tmp,0,tmp1-1)); + ); + ); + pB=Lcrd(plist_1); pA=Lcrd(plist_2); pC=Lcrd(plist_3); + Ctr=Lcrd(pA); + sab=pB-pA; + sac=pC-pA; + Rg=[arctan2(sab)+0,arctan2(sac)+0]; + if(Rg_20, + Th=(Rg_1+Rg_2)/2; + tmp1=Ctr+Brat*ra*[cos(Th),sin(Th)]; + tmp="Defvar("+Dq+Bpos+"="; + tmp=tmp+textformat(tmp1,5)+Dq+");"; + parse(tmp); + parse(Bname); + ); + if(Noflg<3, + println("generate anglemark "+name); + tmp1=apply(Out,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp=textformat(plist,5); + tmp1=substring(tmp,1,length(tmp)-1); + tmp=name+"=Anglemark("+tmp1+opstr+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + Out; +); + +Paramark(plist):=Paramark(plist,[]); +Paramark(plist,options):=( +//help:Paramark([A,B,C],["E=\theta"]); + regional(name,Out,pB,pA,pC,ra,sab,sac,ratio,opstr,Bname,Bpos, + Brat,tmp,tmp1,tmp2,Ltype,Noflg,eqL,realL,opcindy); + tmp=textformat(plist,5); + tmp=replace(tmp,",",""); + tmp=substring(tmp,1,length(tmp)-1); + name="pm"+tmp; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + eqL=tmp_5; + realL=tmp_6; + ra=0.5; + Bname=""; + Brat=1.2; + if(length(realL)>0, + tmp=realL_1; + ra=tmp*ra; + opstr=opstr+","+text(tmp); + ); + forall(eqL, + if(substring(#,0,1)=="L",Bname="Letter("); + if(substring(#,0,1)=="E",Bname="Expr("); + Bpos="md"+name; + Bname=Bname+Dq+Bpos+Dq+","+Dq+"c"+Dq+","+Dq; + tmp=substring(#,indexof(#,"="),length(#)); + tmp1=indexof(tmp,","); + Bname=Bname+substring(tmp,tmp1,length(tmp))+Dq+")"; + if(tmp1>0, + Brat=parse(substring(tmp,0,tmp1-1)); + ); + ); + pB=Lcrd(plist_1); pA=Lcrd(plist_2); pC=Lcrd(plist_3); + Ctr=Lcrd(pA); + Out=[]; + Out=append(Out,pA+ra*(pB-pA)/|pB-pA|); + Out=append(Out,pA+ra*(pB-pA)/|pB-pA|+ra*(pC-pA)/|pC-pA|); + Out=append(Out,pA+ra*(pC-pA)/|pC-pA|); + if(length(Bname)>0, + tmp1=pA+Brat*ra*(pB-pA)/|pB-pA|+Brat*ra*(pC-pA)/|pC-pA|; + tmp="Defvar("+Dq+Bpos+"="+textformat(tmp1,5)+Dq+");"; + parse(tmp); + parse(Bname); + ); + if(Noflg<3, + println("generate paramark "+name); + tmp1=apply(Out,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp1=substring(textformat(plist,5),1,length(textformat(plist,5))-1); + tmp=name+"=Paramark("+tmp1+opstr+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + Out; +); + +MakeBowdata(pA,pB,Hgt):=( + regional(angle,pB2,pH2,pC2,pC,tmp,Th1,Th2,ra,dMA); + angle=arctan2(pB-pA)+0; + pB2=Rotatepoint(pB,-angle,pA); + tmp=Lcrd(pA); + pH2=[(tmp_1+pB2_1)/2,tmp_2-Hgt]; + dMA=|tmp-pB2|/2; + ra=(dMA^2+Hgt^2)/(2*Hgt); + pC2=[pH2_1,pB2_2+(ra-Hgt)]; + pC=Rotatepoint(pC2,angle,pA); + Th1=arctan2(pA-pC2)+angle; + Th2=arctan2(pB2-pC2)+angle; + [pC,ra,Th1,Th2]; +); + +Bowdata(nm,plist,options):=( +//help:Bowdata([C,A],[2,1.2,"Expr=10","da"]); +//help:Bowdata([A,B],["Expr=t0n3,a"]); +//help:Bowdata([A,B],["Exprrot=t0n2r,a"]); + regional(name,Out,pB,pA,pC,ra,tmp,tmp1,tmp2,Ltype,eqL,realL, + Bname,Bpos,Th,Cut,Num,Hgt,opstr,opcindy,Ydata,pC, + Th1,Th2,Noflg,Bops,Bmov,Tmov,Nmov,rev); + name="bw"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + eqL=tmp_5; + realL=tmp_6; + pA=Lcrd(plist_1); pB=Lcrd(plist_2); + Hgt=1/2*|pB-pA|*0.2; + Cut=0; + Num=24; + Bname=""; + Tmov=0;//16.11.01from + Nmov=0; + Bmov=""; + rev=0;//16.11.01upto + if(length(realL)>0, + Hgt=realL_1*Hgt; // 15.04.12 + if(length(realL)>1,Cut=realL_2); + ); + forall(eqL, + tmp=substring(#,0,1); + if(tmp=="L" % tmp=="l", + if(indexof(#,"rot")>0, + Bname="Letterrot("; + , + Bname="Letter("; + ); + ); + if(tmp=="E" % tmp=="e", + if(indexof(#,"rot")>0, + Bname="Exprrot("; + , + Bname="Expr("; + ); + ); + tmp=indexof(#,"="); + Bops=substring(#,tmp,length(#)); // 16.11.01 + ); + Ydata=MakeBowdata(pA,pB,Hgt); + pC=Ydata_1; + ra=Ydata_2; + Th=(Ydata_3+Ydata_4)*0.5; + BOWMIDDLE=[pC_1+ra*cos(Th),pC_2+ra*sin(Th)]; + Bpos="md"+name; // 16.10.31from(moved) + tmp="Defvar("+Dq+Bpos+"="+textformat(BOWMIDDLE,5)+Dq+");"; + parse(tmp);// 16.10.31upto(moved) + if(length(Bname)>0, //16.11.01from + tmp=indexof(Bops,","); + if(tmp>0, + tmp1=substring(Bops,0,tmp-1); + if(length(tmp1)>=4 & substring(tmp1,0,1)=="t" & indexof(tmp1,"n")>0, + Bmov=tmp1; + Bops=substring(Bops,tmp,length(Bops)); + ); + ); + if(length(Bmov)>0, + tmp=indexof(Bmov,"t"); + if(tmp>0, + tmp1=indexof(Bmov,"n"); + Tmov=parse(substring(Bmov,tmp,tmp1-1)); + tmp=indexof(Bmov,"r"); + if(tmp>0, + Nmov=parse(substring(Bmov,tmp1,tmp-1)); + rev=1; + , + Nmov=parse(substring(Bmov,tmp1,length(Bmov))); + ); + ); + ); + Bname=Bname+Bpos;//16.11.01 + if(abs(Tmov)+abs(Nmov)>0, + tmp=Pcrd(pA)-Pcrd(pB); + tmp1=1/norm(tmp)*tmp; + tmp2=[-tmp1_2,tmp1_1]; + tmp=MARKLEN*(Tmov*tmp1+Nmov*tmp2); + tmp=LLcrd(tmp); + Bname=Bname+"+"+text(tmp); + ); + Bname=Bname+","; + if(indexof(Bname,"rot")>0, + if(rev==1,tmp=pB-pA,tmp=pA-pB); + Bname=Bname+textformat(tmp,5)+","; + , + Bname=Bname+Dq+"c"+Dq+","; + ); + Bname=Bname+Dq+Bops+Dq+")"; + parse(Bname); + );//16.11.01upto + if(Cut==0, + Th1=Ydata_3; + Th2=Ydata_4; + Out=[]; + forall(0..Num, + tmp=Th1+#*(Th2-Th1)/Num; + Out=append(Out,pC+ra*[cos(tmp),sin(tmp)]); + ); + , + Th1=Ydata_3; + Th2=Th-Cut/(2*ra); + tmp1=[]; + forall(0..Num/2, + tmp=Th1+#*(Th2-Th1)/(Num/2); + tmp1=append(tmp1,pC+ra*[cos(tmp),sin(tmp)]); + ); + Th1=Th+Cut/(2*ra); + Th2=Ydata_4; + tmp2=[]; + forall(0..Num/2, + tmp=Th1+#*(Th2-Th1)/(Num/2); + tmp2=append(tmp2,pC+ra*[cos(tmp),sin(tmp)]); + ); + Out=[tmp1,tmp2]; + ); + if(Noflg<3, + println("generate bowdata "+name+" and "+Bpos);//16.10.31 + if(MeasureDepth(Out)==1,Out=[Out]); + tmp1=[]; + forall(Out,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp1=substring(textformat(plist,5),1,length(textformat(plist,5))-1); + tmp=name+"=Bowdata("+tmp1+opstr+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); +); + +Deqplot(nm,deq,rng,initf):=Deqplot(nm,deq,rng,Lcrd(initf)_1,initf,[]); +Deqplot(nm,deq,rng,Arg1,Arg2):=( + regional(initt,initf,options); + if(isreal(Arg1) & length(Arg1)==1, + initt=Arg1; + initf=Arg2; + options=[]; + , + initf=Lcrd(Arg1); + initt=initf_1; + options=Arg2; + ); + Deqplot(nm,deq,rng,initt,initf,options); +); +Deqplot(nm,deq,rng,initt,initf,options):=( + regional(name,Noflg,Ltype,eqL,opstr,opcindy,pdL,var2,deq2,rng2,initt2,initf2, + tmp,tmp1,tmp2,tmp3,tmp4); + tmp=tokenize(deq,"="); + tmp1=tmp_1; + tmp2=tmp_2; + tmp3=tokenize(tmp1,"`"); + if(length(tmp3)==2, + if(indexof(tmp1,"[")>0, + Deqplot(nm,deq,rng,initt,initf,options,[2,3]); + , + if(indexof(rng,"=")>0,rng2=rng,rng2=rng+"=[XMIN,XMAX]"); + tmp=tokenize(rng2,"="); + deq2="["+tmp_1+","+replace(tmp1,"`","]")+"`=[1,"+tmp2+"]"; + rng2="t="+tmp_2; + if(isreal(initf) & length(initf)==1, + initf2=[initt,initf]; + initt2=initt; + , + initf2=Lcrd(initf)); + initt2=initf2_1; + Deqplot(nm,deq2,rng2,initt2,initf2,options,[2,3]); + ); + , + name="de"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + eqL=tmp_5; + opcindy=tmp_9; + opstr=""; + forall(eqL, + if(Toupper(substring(#,0,1))=="N", + tmp=indexof(#,"="); + tmp1="N="+substring(#,tmp,length(#)); + opstr=opstr+",'"+tmp1+"'"; + ); + ); + if(Noflg<1, + if(indexof(rng,"=")>0,rng2=rng,rng2=rng+"=[XMIN,XMAX]"); + var2="d"+tmp3_1; + deq2="["+tmp3_1+","+var2+"]`=["; + tmp=replace(tmp2,tmp3_1+"`",var2); + deq2=deq2+var2+","+tmp+"]"; + Deqplot(nm,deq2,rng2,initt,initf,append(options,"nodisp"),[1,2]); + parse(tmp); + tmp=name+"=Deqplot(Assign("+Dq+deq+Dq+"),'"+rng+"',"; + tmp=tmp+initt+","+initf+opstr+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + parse("de"+nm); + ); + ); +); +Deqplot(nm,deq,rng,initt,initf,options,Sel):=( +//help:Deqplot("2","y`=y*(1-y)","x",0, 0.5,["Num=100"]); +//help:Deqplot("1","y``=-y","x",0, [1,0]); +//help:Deqplot("3","[x,y]`=[x*(1-y),0.3*y*(x-1)]","t=[0,20]",[1,0.5]); + regional(Ltype,Noflg,Inflg,Outflg,strL,opstr,opcindy,Num, + outstr,name,func,xf,yf,pdL,Eps,Inf,t1,t2,tt,Vname,dt,funP,funN,flg, + kl1,kl2,kl3,kl4,x0,y0,x1,y1,tmp,tmp1,tmp2); + name="de"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + Inflg=tmp_3; + Outflg=tmp_4; + eqL=tmp_5; + strL=tmp_7; +// opstr=tmp_(length(tmp)-1); + opstr=""; + opcindy=tmp_(length(tmp)); + outstr=""; + forall(strL, + tmp=Toupper(substring(#,0,1)); + if(tmp=="S", + outstr="Sci"; + ); + ); + Num=50; + forall(eqL, + tmp=indexof(#,"="); + tmp2=substring(#,0,1); + tmp2=Toupper(tmp2); + tmp1=substring(#,tmp,length(#)); + opstr=opstr+",'"+tmp2+"="+tmp1+"'"; + if(Toupper(substring(#,0,1))=="N", + Num=parse(tmp1); + ); + ); + if(outstr=="Sci", + if(Inflg==0 & Outflg==0,Outflg=1;Inflg=1); + ); + if(Noflg<3, + if(outstr=="Sci", + if(Outflg==1, + println("Output Deqplot "+name); + SCIWRLIST=append(SCIWRLIST,name); + ); + if(Inflg==1, + println("Input Deqplot "+name); + if(length(SCIRELIST)==0, + ReadOutData(Fnameout); + ); + tmp=parse(name); + if(islist(tmp), + Extractdata(name,["nodisp"]); // 12.19 + ); + SCIRELIST=append(SCIRELIST,name); + ); + , + Eps=10^(-3); + Inf=10^3; + tmp=tokenize(deq,"="); + tmp1=tmp_1; + func=tmp_2; + tmp=indexof(tmp1,","); + xf=substring(tmp1,1,tmp-1); + yf=substring(tmp1,tmp,length(tmp1)); + tmp=indexof(yf,"]"); + yf=substring(yf,0,tmp-1); + tmp=tokenize(rng,"="); + Vname=tmp_1; + tmp=parse(tmp_2); + t1=tmp_1; + t2=tmp_2; + tmp="funP("+Vname+","+xf+","+yf+"):="+func+";"; + parse(tmp); + tmp=tokenize(func,","); + tmp1="-("+substring(tmp_1,1,length(tmp_1))+")"; + tmp2="-("+substring(tmp_2,0,length(tmp_2)-1)+")"; + tmp="funN("+Vname+","+xf+","+yf+"):=["+tmp1+","+tmp2+"];"; + parse(tmp); + dt=(t2-t1)/Num; + tt=initt; + tmp=Lcrd(initf); + x0=tmp_1; + y0=tmp_2; + pdL=[[tt,x0,y0]]; + flg=0; + forall(1..floor((t2-initt)/dt), + if(flg==0, + kl1=dt*funP(tt,x0,y0); + kl2=dt*funP(tt+dt/2,x0+kl1_1/2,y0+kl1_2/2); + kl3=dt*funP(tt+dt/2,x0+kl2_1/2,y0+kl2_2/2); + kl4=dt*funP(tt+dt,x0+kl3_1,y0+kl3_2);//16.10.14 + tmp1=[x0,y0]+(kl1+2*kl2+2*kl3+kl4)/6; + x0=tmp1_1; + y0=tmp1_2; + tt=initt+#*dt; + pdL=append(pdL,[tt,x0,y0]); + if(|tmp1|>Inf,flg=1); + ); + ); + tt=initt; + tmp=Lcrd(initf); + x0=tmp_1; + y0=tmp_2; + flg=0; + forall(1..floor((initt-t1)/dt), + if(flg==0, + kl1=dt*funN(tt,x0,y0); + kl2=dt*funN(tt+dt/2,x0+kl1_1/2,y0+kl1_2/2); + kl3=dt*funN(tt+dt/2,x0+kl2_1/2,y0+kl2_2/2); + kl4=dt*funN(tt+dt/2,x0+kl3_1/2,y0+kl3_2/2); + tmp1=[x0,y0]+(kl1+2*kl2+2*kl3+kl4)/6; + x0=tmp1_1; + y0=tmp1_2; + tt=initt-#*dt; + pdL=prepend([tt,x0,y0],pdL); + if(|tmp1|>Inf,flg=1); + ); + ); + println("Generate Deqplot "+name); + pdL=apply(pdL,#_Sel); + tmp1=apply(pdL,Pcrd(#)); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + ); + if(Noflg<1, + tmp=name+"=Deqplot(Assign("+Dq+deq+Dq+"),'"+rng+"',"; + tmp=tmp+initt+","+initf+opstr+")"; + GLIST=append(GLIST,tmp); + ); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + if(outstr=="Sci", + if(Inflg==1, + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + , + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + pdL; + ); + ); +); + +Enclosing(nm,plist):=EnclosingS(nm,plist); +Enclosing(nm,plist,options):=EnclosingS(nm,plist,options); +EnclosingS(nm,plist):=EnclosingS(nm,plist,[]); +EnclosingS(nm,plist,options):=( +//help:Enclosing("1",["sc2","crAB","sc2","Invert(sc1)"],[pt,"dr"]); + regional(name,AnsL,Start,Eps,EEps,S,Flg,Fdata,Gdata,KL,pt,qt, + t1,t2,t3,ii,nn,tmp,tmp1,tmp2,Ltype,Noflg,realL,eqL,opstr,opcindy); + name="en"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + eqL=tmp_5; + realL=tmp_6; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + Eps=10^(-3); + EEps=0.1; + Start=[]; + Flg=0; + forall(realL, + if(isList(#) % ispoint(#), + Start=Lcrd(#); // 15.09.12 + , + Flg=Flg+1; + if(Flg==1,Eps=#); + if(Flg==2,EEps=#); + ); + ); +// tmp1=concat([Eps,EEps],eqL); // 15.04.06 + Fdata=plist_1; + Gdata=plist_(length(plist)); + KL=IntersectcrvsPp(Fdata,Gdata); + if(length(KL)==1, + pt=KL_1_1; + t1=KL_1_2; + ); + if(length(KL)==0, + if(Numptcrv(Fdata)>Numptcrv(Gdata), + tmp=Nearestpt(Fdata,Gdata); + pt=tmp_1; + t1=tmp_2; + , + tmp=Nearestpt(Gdata,Fdata); + pt=tmp_3; + t1=tmp_4; + ); + ); + if(length(KL)>1, + if(Start==[], + err("No Start Point"); + , + pt=KL_1_1; + t1=KL_1_2; + tmp=|pt-Start|; + forall(2..length(KL),ii, // 15.04.20 + tmp1=KL_ii_1; + tmp2=|tmp1-Start|; // 15.04.20 + if(tmp21, pt=qt); + if(nn==length(plist), + qt=Start; + , + Flg=0; + Gdata=plist_(nn+1); +// tmp1=concat([Eps,EEps],eqL); // 15.04.06 + KL=IntersectcrvsPp(Gdata,Fdata); + if(length(KL)==1, + tmp=KL_1; + qt=KL_1_1; + t3=KL_1_2; + Flg=10; + ); + if(length(KL)==0,Flg=1); + if(length(KL)>1, + tmp1=KL_1_1; + tmp2=KL_2_1; + tmp=|tmp1-tmp2|; + if(tmpNumptcrv(Gdata), + tmp=Nearestpt(Fdata,Gdata); + qt=tmp_1; + t3=tmp_4; + Flg=10; + , + tmp=Nearestpt(Gdata,Fdata); + qt=tmp_3; + t3=tmp_2; + Flg=10; + ); + ); + if(Flg<10, + t2=10^6; //%inf; + forall(1..length(KL),ii, + tmp1=KL_ii_1; + tmp=KL_ii_3; + tmp2=ParamonCurve(tmp1,tmp,Fdata); + tmp3=KL_ii_2; + if(tmp2>t1+Eps & tmp21, + tmp1=tmp1+#+","; + , + tmp1=tmp1+Dq+#+Dq+","; + ); + , + tmp1=tmp1+"Listplot("+textformat(#,5)+"),"; + ); // upto 16.01.24 + ); + Str=Str+substring(tmp1,0,length(tmp1)-1)+")"+opstr+")"; + Com2nd(Str); +); + + +//help:start(); + +Rotatepoint(point,Theta,ctr):=( +//help:Rotatepoint(A,2*pi/3,B); + regional(X1,X2,Y1,Y2,Cx,Cy,tmp); + tmp=Lcrd(point); + X1=tmp_1; Y1=tmp_2; + tmp=Lcrd(ctr); + Cx=tmp_1; Cy=tmp_2; + X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta); + Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta); + [X2,Y2]; +); + +Translatepoint(point,mov):=( +//help:Translatepoint(A,[2,3]); + regional(X1,X2,Y1,Y2,Cx,Cy,tmp); + tmp=Lcrd(point); + X1=tmp_1; Y1=tmp_2; + tmp=Lcrd(mov); + Cx=tmp_1; Cy=tmp_2; + X2=X1+Cx; + Y2=Y1+Cy; + [X2,Y2]; +); + +Scalepoint(point,ratio,center):=( +//help:Scalepoint(A,[3,2],[0,0]); + regional(X1,X2,Y1,Y2,Cx,Cy,tmp); + tmp=Lcrd(point); + X1=tmp_1; Y1=tmp_2; + tmp=Lcrd(center); + Cx=tmp_1; Cy=tmp_2; + X2=Cx+ratio_1*(X1-Cx); + Y2=Cy+ratio_2*(Y1-Cy); + [X2,Y2]; +); + +Reflectpoint(point,symL):=( +//help:Reflectpoint(A,B); +//help:Reflectpoint(A,[[2,3]]); +//help:Reflectpoint(A,[C,E]);\\ + regional(X1,X2,Y1,Y2,Us,Vs,Pt1,Pt2,Cx,Cy,tmp); + tmp=Lcrd(point); + X1=tmp_1; Y1=tmp_2; + Pt1=Lcrd(symL_1); + if(length(symL)==1, + Pt2=Pt1; + , + Pt2=Lcrd(symL_2); + ); + Us=Pt2_1-Pt1_1; + Vs=Pt2_2-Pt1_2; + if(Pt1==Pt2, + X2=2*Pt1_1-X1; + Y2=2*Pt1_2-Y1; + , + X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1 + -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); + Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1 + +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); + ); + [X2,Y2]; +); + +Rotatedata(nm,plist,Theta):=Rotatedata(nm,plist,Theta,[]); +Rotatedata(nm,plist,angle,options):=( +//help:Rotatedata("1","crAB",pi/3,[[1,5],"dr,2"]); + regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdLL,PdL, + opcindy,Nj,Njj,Kj,Mj,X1,Y1,X2,Y2,Ltype,Noflg,name); + name="rt"+nm; + Pt=[0,0]; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + tmp1=tmp_6; + if(length(tmp1)>0,Pt=Lcrd(tmp1_1)); + pdata=plist; + if(isstring(pdata),pdata=[pdata]); + if(!isstring(pdata_1) & MeasureDepth(pdata)==1, + pdata=[pdata]; + ); + if(isstring(angle),Theta=parse(angle),Theta=angle); + Cx=Pt_1; Cy=Pt_2; + PdL=[]; + forall(pdata,Njj, + if(isstring(Njj),Kj=parse(Njj),Kj=Njj); + if(MeasureDepth(Kj)==1,Kj=[Kj]); + tmp2=[]; + forall(Kj,Nj, + tmp1=[]; + forall(Nj, + tmp=LLcrd(#); + X1=tmp_1; + Y1=tmp_2; + X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta); + Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta); + tmp1=concat(tmp1,[[X2,Y2]]); + ); + tmp2=concat(tmp2,[tmp1]); + ); + PdL=concat(PdL,tmp2); + ); + if(Noflg<3, + println("generate Rotatedata "+name); + tmp1=[]; + forall(PdL,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + if(length(tmp1)==1,tmp1=tmp1_1); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); +// tmp1=textformat(plist,5); + tmp1=text(plist); // 15.10.15 + tmp1=replace(tmp1,"[","list("); + tmp1=replace(tmp1,"]",")"); + tmp=name+"=Rotatedata("+tmp1+"," + +textformat(angle,5)+","+textformat(Pt,5)+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + PdL; +); + +translatedata(nm,plist,mov):=translatedata(nm,plist,mov,[]); +translatedata(nm,plist,mov,options):=( +//help:translatedata("1",["gr1"],[1,2]); + regional(tmp,tmp1,tmp2,pdata,Cx,Cy,PdL,Nj,Njj,Kj, + opcindy,X2,Y2,Ltype,Noflg,name); + name="tr"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + pdata=plist; + if(isstring(pdata),pdata=[pdata]); + if(!isstring(pdata_1) & MeasureDepth(pdata)==1, + pdata=[pdata]; + ); + tmp=Lcrd(mov); + Cx=tmp_1; Cy=tmp_2; + PdL=[]; + forall(pdata,Njj, + if(isstring(Njj),Kj=parse(Njj),Kj=Njj); + if(MeasureDepth(Kj)==1,Kj=[Kj]); + tmp2=[]; + forall(Kj,Nj, + tmp1=[]; + forall(Nj, + tmp=LLcrd(#); + X2=tmp_1+Cx; + Y2=tmp_2+Cy; + tmp1=concat(tmp1,[[X2,Y2]]); + ); + tmp2=concat(tmp2,[tmp1]); + ); + PdL=concat(PdL,tmp2); + ); + if(Noflg<3, + println("generate translatedata "+name); + tmp1=[]; + forall(PdL,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + if(length(tmp1)==1,tmp1=tmp1_1); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); +// tmp1=textformat(plist,5); + tmp1=text(plist); // 15.10.15 + tmp1=replace(tmp1,"[","list("); + tmp1=replace(tmp1,"]",")"); + tmp=name+"=translatedata("+tmp1+","+textformat(mov,5)+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + PdL; +); + +Scaledata(nm,plist,ratioV):=( + regional(tmp); + tmp=Lcrd(ratioV); + Scaledata(nm,plist,tmp_1,tmp_2,[]); +); +Scaledata(nm,plist,Arg1,Arg2):=( +//help:Scaledata("1","crAB",3,2,[[0,0]]); + regional(tmp,options); + if(islist(Arg2), + tmp=Lcrd(Arg1); + options=Arg2; + Scaledata(nm,plist,tmp_1,tmp_2,options); + , + Scaledata(nm,plist,Arg1,Arg2,[]); + ); +); +Scaledata(nm,plist,rx,ry,options):=( + regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdL, + opcindy,Nj,Njj,Kj,X2,Y2,Ltype,Noflg,name); + name="sc"+nm; + Pt=[0,0]; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + tmp1=tmp_6; + if(length(tmp1)>0, + Pt=Lcrd(tmp1_1); + ); + pdata=plist; + if(isstring(pdata),pdata=[pdata]); + if(!isstring(pdata_1) & MeasureDepth(pdata)==1, + pdata=[pdata]; + ); + Cx=Pt_1; Cy=Pt_2; + PdL=[]; + forall(pdata,Njj, + if(isstring(Njj),Kj=parse(Njj),Kj=Njj); + if(MeasureDepth(Kj)==1,Kj=[Kj]); + tmp2=[]; + forall(Kj,Nj, + tmp1=[]; + forall(Nj, + tmp=LLcrd(#); + X2=Cx+rx*(tmp_1-Cx); + Y2=Cy+ry*(tmp_2-Cy); + tmp1=concat(tmp1,[[X2,Y2]]); + ); + tmp2=concat(tmp2,[tmp1]); + ); + PdL=concat(PdL,tmp2); + ); + if(Noflg<3, + println("generate Scaledata "+name); + tmp1=[]; + forall(PdL,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + if(length(tmp1)==1,tmp1=tmp1_1); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp1=text(plist); // 15.10.15 + tmp1=replace(tmp1,"[","list("); + tmp1=replace(tmp1,"]",")"); + tmp=name+"=Scaledata("+tmp1+"," + +textformat(rx,5)+","+textformat(ry,5)+","+textformat(Pt,5)+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + PdL; +); + +Reflectdata(nm,plist,symL):=Reflectdata(nm,plist,symL,[]); +Reflectdata(nm,plist,symL,options):=( +//help:Reflectdata("1","crAB",[C]); + regional(tmp,tmp1,tmp2,pdata,Us,Vs,Pt1,Pt2,Cx,Cy,PdL, + opcindy,Nj,Njj,Kj,X1,Y1,X2,Y2,Ltype,Noflg,name); + name="re"+nm; + Pt=[0,0]; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + pdata=plist; + if(isstring(pdata),pdata=[pdata]); + if(!isstring(pdata_1) & MeasureDepth(pdata)==1, + pdata=[pdata]; + ); + Pt1=Lcrd(symL_1); + if(length(symL)==1, + Pt2=Pt1; + , + Pt2=Lcrd(symL_2); + ); + Us=Pt2_1-Pt1_1; + Vs=Pt2_2-Pt1_2; + PdL=[]; + forall(pdata,Njj, + if(isstring(Njj),Kj=parse(Njj),Kj=Njj); + if(MeasureDepth(Kj)==1,Kj=[Kj]); + tmp2=[]; + forall(Kj,Nj, + tmp1=[]; + forall(Nj, + tmp=LLcrd(#); + X1=tmp_1; + Y1=tmp_2; + if(Pt1==Pt2, + X2=2*Pt1_1-X1; + Y2=2*Pt1_2-Y1; + , + X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1 + -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); + Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1 + +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); + ); + tmp1=concat(tmp1,[[X2,Y2]]); + ); + tmp2=concat(tmp2,[tmp1]); + ); + PdL=concat(PdL,tmp2); + ); + if(Noflg<3, + println("generate Reflectdata "+name); + tmp1=[]; + forall(PdL,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + if(length(tmp1)==1,tmp1=tmp1_1); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); +// tmp1=textformat(plist,5); + tmp1=text(plist); // 15.10.15 + tmp1=replace(tmp1,"[","list("); + tmp1=replace(tmp1,"]",")"); + tmp=name+"=Reflectdata("+tmp1+","+textformat(symL,5)+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + PdL; +); + +Mksegments():=Mksegments([]); +Mksegments(options):=( +//help:Mksegments(); + regional(segstr,p,q,r,tmp1,tmp2,tmp3); + forall(allsegments(),seg, + str=text(inspect(seg,"definition")); + tmp1=indexof(str,"("); + tmp2=indexof(str,";"); + tmp3=indexof(str,")"); + p=substring(str,tmp1,tmp2-1); + q=substring(str,tmp2,tmp3-1); + Listplot([parse(p),parse(q)]); + ); +); + +Mkcircles():=Mkcircles([]); +Mkcircles(options):=( +//help:Mkcircles(): + regional(seg,cir,str,p,q,r,tmp1,tmp2,tmp3,tmp4); + forall(allcircles(),cir, + str=text(inspect(cir,"definition")); + tmp1=indexof(str,"("); + tmp2=indexof(str,";"); + tmp3=indexof(str,")"); + tmp4=indexof(str,";",tmp2+1); + if(tmp4==0, + p=substring(str,tmp1,tmp2-1); + q=substring(str,tmp2,tmp3-1); + Circledata([parse(p),parse(q)]); + , + p=substring(str,tmp1,tmp2-1); + q=substring(str,tmp2,tmp4-1); + r=substring(str,tmp4,tmp3-1); + Circledata([parse(p),parse(q),parse(r)]); + ); + ); +); + +Makesciarg(arglist):=( + regional(str,tmpstr); + str=""; + forall(arglist, + if(isstring(#), + tmpstr=Dq+#+Dq; + , + tmpstr=textformat(#,5); + ); + str=str+tmpstr+","; + ); + str=substring(str,0,length(str)-1); + str; +); + +Setax(arglist):=( +//help:Setax(["l","x","e","y","n","O","sw"]); +//help:Setax([7,"nw"]); + regional(tmp); + tmp=Makesciarg(arglist); + Com1st("Setax("+tmp+")"); +); + +Htickmark(arglist):=( +//help:Htickmark([1,"1",2,"sw","2"]); + regional(tmp); + tmp=""; + tmp=Makesciarg(arglist); + Com2nd("Htickmark("+tmp+")"); +); + +Vtickmark(arglist):=( +//help:Vtickmark([1,"1",2,"sw","2"]); + regional(tmp); + tmp=Makesciarg(arglist); + Com2nd("Vtickmark("+tmp+")"); +); + +Drwxy():=( +//help:Drwxy(); + Com2nd("Drwxy()"); + Addax(0); // 16.01.21 +); + +Drwpt(pstr):=Drawpoint(pstr); +Drwpt(ptlist,nn):=( // 16.03.05 from +//help:Drwpt(A); +//help:Drwpt("[1,1],0"); +//help:Drwpt(A,0); +//help:Drwpt([1,2],0); + Drawpoint(ptlist,nn); +); +Drawpoint(pstr):=( + if(isstring(pstr), + println("Drwpt : "+pstr); + Com2nd("Drwpt("+pstr+")"); + , + Drawpoint(pstr,1); + ); +); +Drawpoint(ptlistorg,nn):=( + regional(ptlist,thick,tmp,tmp1); + println("Drwpt : "+text(ptlistorg)); + if(islist(ptlistorg), + if(MeasureDepth(ptlistorg)==1, + ptlist=ptlistorg + , + ptlist=[ptlistorg] + ); + , + ptlist=[ptlistorg] + ); + thick=PenThick/PenThickInit;// 16.04.09 from + tmp1=max(TenSize/TenSizeInit,1)/8; + Setpen(tmp1); // 16.04.09 upto + forall(ptlist, + tmp=textformat(#,5)+","+text(nn); + Com2nd("Drwpt("+tmp+")"); // 16.04.09 + ); + Setpen(thick); // 16.04.09 +);// 16.03.05 upto + +Addax(param):=( +//help:Addax(0); + ADDAXES=text(param); +); + +Expr(Pt,Dr,St):=Expr([Pt,Dr,St]); +Expr(list):=Expr(list,[]); +Expr(listorg,options):=( //16.10.09 +//help:Expr([A,"e","f(x)=x^2"]); + regional(list,str,tmp,tmp1,tmp2); + list=listorg; + forall(1..round(length(list)/3), + str=list_(3*#); + if(!isstring(str),str=format(str,5)); + str="$"+str+"$"; + list_(3*#)=str; + ); + Letter(list,options); +); + +Letter(Pt,Dr,St):=Letter([Pt,Dr,St]); +Letter(list):=Letter(list,[]); +Letter(list,options):=( +//help:Letter([C,"c","Graph of f(x)"]); + regional(Nj,Pos,Dir,Str,Off,Dmv,Xmv,Ymv,Noflg,opcindy, + opL,aln,sz,clr,bld,ita,tmp,tmp1,tmp2); + tmp=Divoptions(options); + Noflg=tmp_2; + opL=select(options,indexof(#,"->")>0); //16.10.09from + tmp=select(opL,indexof(#,"color")); + size=12; + clr=[0,0,0]; + bld=false; + ita=false; + aln="left"; + forall(opL, + tmp=indexof(#,"->"); + tmp1=removespace(substring(#,0,tmp-1)); + tmp2=substring(#,tmp+1,length(#)); + if(tmp1=="size",sz=parse(tmp2)); + if(tmp1=="color",clr=parse(tmp2)); + if(tmp1=="bold",bld=parse(tmp2)); + if(tmp1=="ita",ita=parse(tmp2)); + );//16.10.09upto + Off=-4; + Dmv=8; + Nj=1; + while(Nj+2<=length(list), +// Pos=textformat(list_Nj,5); + Pos=list_Nj; + Dir=list_(Nj+1); + tmp=indexof(Dir,"s")+indexof(Dir,"n");//16.10.19from + if(tmp>0, + tmp=indexof(Dir,"w")+indexof(Dir,"e"); + if(tmp==0, + Dir="c"+Dir;//16.10.08 + ); + );//16.10.19upto + Str=list_(Nj+2); + if(!isstring(Str),Str=format(Str,5)); // 16.09.30,10.09 + tmp=replace(Str,".xy",""); + tmp=replace(tmp,".x","(1)"); + Str=replace(tmp,".y","(2)"); + if(indexof(Str,"`")>0, +// tmp=Dq+",Assign('"+Str+"','`',Prime()))"; + tmp=Dq+",Assign('"+Str+"'))"; // 15.02.22 + , + tmp=Dq+","+Dq+Str+Dq+")"; + ); + if(Noflg==0, + Com2nd("Letter("+Lcrd(Pos)+","+Dq+Dir+tmp);//16.10.10 + ); + if(Noflg<2, + Xmv=0;//16.10.13 + Ymv=-4; + if(indexof(Dir,"n")>0, + Ymv=Dmv/2; + ); + if(indexof(Dir,"s")>0, + Ymv=-Dmv*3/2;//16.10.13 + ); + if(indexof(Dir,"e")>0, + Xmv=Dmv/2; + Off=0; + aln="left"; + ); + if(indexof(Dir,"w")>0, + Xmv=-Dmv/2; + Off=0; // 16.09.30from + aln="right"; + ); + if(indexof(Dir,"c")>0, + Xmv=0;//16.10.13 + Off=0; + if(Ymv==0,Ymv=-4);//16.10.08 + aln="mid"; // 16.09.30upto + ); + drawtext(Pcrd(Pos),Str,offset->[Off+Xmv,Off+Ymv], + size->sz,color->clr,align->aln,bold->bld,italics->ita);//16.10.09 + ); + Nj=Nj+3; + ); +); + +Letterrot(pt,dir,str):=Letterrot(pt,dir,0,0,str); +Letterrot(pt,dir,movstr,str):=( +//help:Letterrot(C,B-A,"AB"): +//help:Letterrot(C,B-A,0,5,"AB"): +//help:Letterrot(C,B-A,"t0n5","AB"): + regional(tmov,nmov,tmp,tmp1,tmp2); + tmp1=indexof(movstr,"t"); + tmp2=indexof(movstr,"n"); + if(tmp1>0, + if(tmp2>0,tmp=tmp2-1,tmp=length(movstr)); + tmov=parse(substring(movstr,tmp1,tmp)); + , + tmov=0; + ); + if(tmp2>0, + nmov=parse(substring(movstr,tmp2,length(movstr))); + , + nmov=0; + ); + Letterrot(pt,dir,tmov,nmov,str); +); +Letterrot(pt,dir,tmov,nmov,str):=( + Letter([pt,"c",str],["notex"]); + Com2nd("Letterrot("+pt+","+dir+","+tmov+","+nmov+",'"+str+"')"); +); + +Exprrot(pt,dir,str):=Exprrot(pt,dir,0,0,str); +Exprrot(pt,dir,movstr,str):=( +//help:Exprrot(C,B-A,"d"): +//help:Exprrot(C,B-A,0,5,"d"): +//help:Exprrot(C,B-A,"t0n5","d"): + regional(tmov,nmov,tmp,tmp1,tmp2); + tmp1=indexof(movstr,"t"); + tmp2=indexof(movstr,"n"); + if(tmp1>0, + if(tmp2>0,tmp=tmp2-1,tmp=length(movstr)); + tmov=parse(substring(movstr,tmp1,tmp)); + , + tmov=0; + ); + if(tmp2>0, + nmov=parse(substring(movstr,tmp2,length(movstr))); + , + nmov=0; + ); + Exprrot(pt,dir,tmov,nmov,str); +); +Exprrot(pt,dir,tmov,nmov,str):=( + Expr([pt,"c",str],["notex"]); + Com2nd("Exprrot("+pt+","+dir+","+tmov+","+nmov+",'"+str+"')"); +); + +Slider(ptstr,p1,p2):=( //17.04.11 +//help:Slider("A-C-B",[-3,0],[3,0]); + regional(pA,pB,pC,seg,sname,Alpha,tmp,tmp1); + tmp=indexall(ptstr,"-"); + pA=substring(ptstr,0,tmp_1-1); + pC=substring(ptstr,tmp_1,tmp_2-1); + pB=substring(ptstr,tmp_2,length(ptstr)); + seg=pA+pB; + Alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + sname=""; + forall(1..(length(seg)), + tmp=substring(seg,#-1,#); + tmp1=indexof(Alpha,tmp); + if(tmp1>0, + sname=sname+unicode(text(tmp1+96),base->10); + , + sname=sname+tmp; + ); + ); + Putpoint(pA,p1); + Putpoint(pB,p2); + Listplot([parse(pA),parse(pB)],["notex","color->[0,0.4,0.4]","size->2"]); +// create([sname],"Segment",[parse(pA),parse(pB)]); +// tmp2=Listplot("",[p1,p2],["nodata"]); + Putonseg(pC,parse("sg"+pA+pB)); +// create([pC],"PointOn",[parse(sname),0.5]); +); + +Putpoint(name,Pt):=Putpoint(name,Pt,Pt); +Putpoint(name,Ptinit,Pt):=( +//help:Putpoint("A",[1,2],[1,A.y]); + regional(ptstr); + ptstr=apply(allpoints(),#.name); + if(!contains(ptstr,name), + createpoint(name,Pcrd([Ptinit_1,Ptinit_2])); + , + ptstr=name+".xy="+textformat(Pcrd(Pt),5); + parse(ptstr); + ); +); + +Bezierpt(t,ptlist,ctrlist):=( + regional(flg3,p0,p1,p2,p3,p4,p5,p6,p7,p8,p9); + p0=ptlist_1; + p3=ptlist_2; + p1=ctrlist_1; + if(length(ctrlist)==1, + p2=p3; + flg3=0; + , + p2=ctrlist_2; + flg3=1; + ); + if(length(p0)<3, // 15.02.08 + p0=Lcrd(p0); + p3=Lcrd(p3); + p1=Lcrd(p1); + p2=Lcrd(p2); + ); + p4=(1-t)*p0+t*p1; + p5=(1-t)*p1+t*p2; + p6=(1-t)*p2+t*p3; + p7=(1-t)*p4+t*p5; + p8=(1-t)*p5+t*p6; + p9=(1-t)*p7+t*p8; + if(flg3==0,p7,p9); +); + +Bezier(ptctrlist):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,[]); +Bezier(ptctrlist,options):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,options); +Bezier(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]); +Bezier(nm,ptlist,ctrlist,options):=BezierCurve(nm,ptlist,ctrlist,options); +BezierCurve(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]); +BezierCurve(nm,ptlistorg,ctrlistorg,options):=( +//help:Bezier("1",[A,D],[B,C]); +//help:Bezier(options=["Num=10"]); + regional(name,Ltype,Noflg,opstr,opcindy,Num, + ptlist,ctrlist,tmp,tmp1,tmp2,ii,st,out,list); + name="bz"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + Num=10; + tmp1=tmp_5; + forall(tmp1, // 14.12.31 + if(substring(#,0,1)=="N", + tmp2=indexof(#,"="); + Num=parse(substring(#,tmp2,length(#))); + opstr=opstr+","+Dq+#+Dq; + ); + ); + ptlist=apply(ptlistorg,Lcrd(#)); // 16.08.16 + ctrlist=[]; // 14.12.31 + if(length(ctrlistorg)==length(ptlist)-1, + forall(ctrlistorg,tmp1, + if(MeasureDepth(tmp1)==0,tmp=[tmp1],tmp=tmp1); + tmp=apply(tmp,Lcrd(#)); // 16.08.16 + ctrlist=append(ctrlist,tmp); + ); + , + forall(1..(length(ptlist)-1),ii, + tmp=ctrlistorg_((2*ii-1)..(2*ii)); + tmp=apply(tmp,Lcrd(#)); // 16.08.16 + ctrlist=append(ctrlist,tmp); + ); + ); + if(!islist(Num), + Num=apply(ctrlist,Num); + ); + list=[]; + forall(1..(length(ptlist)-1),ii, + tmp1=ptlist_(ii..(ii+1)); + tmp2=ctrlist_ii; + if(ii==1,st=0,st=1); + forall(st..Num_ii, + tmp=Bezierpt(#/Num_ii,tmp1,tmp2); + list=append(list,tmp); + ); + ); + if(Noflg<3, + println("generate Bezier "+name); + out=apply(list,Pcrd(#)); + tmp=name+"="+textformat(out,5); + parse(tmp); + tmp1=textformat(ptlist,5); + tmp1="list("+substring(tmp1,1,length(tmp1)-1)+")"; + tmp2=textformat(ctrlist,5); + tmp2="list("+substring(tmp2,1,length(tmp2)-1)+")"; + GLIST=append(GLIST,name+"=Bezier("+tmp1+","+tmp2+opstr+")"); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + list; +); + +Readcsvsla(fname):=Readplotdigdata(fname,[]); +Readcsvsla(fname,options):=Readplotdigdata(fname,options); +Readplotdigdata(fname):=Readplotdigdata(fname,[]); +Readplotdigdata(fname,options):=( + regional(fsc,mv,cmdall,dataL,nd,npt,ptdata,ii,tmp,tmp1,tmp2,tmp3); + tmp=Divoptions(options); + tmp1=tmp_6; + sc=1;//10; + mv=[0,0];//[5,5]; + forall(tmp1, + if(!islist(#),sc=#,mv=#); + ); + if(indexof(fname,".")>0, + tmp=load(fname); + , + tmp=load(fname+".txt"); + ); + cmdall=tokenize(tmp,"//"); + dataL=[]; + forall(2..length(cmdall),ii, + tmp1=parse("["+cmdall_ii+"]"); + dataL=append(dataL,tmp1); + ); + if(length(dataL_(length(dataL)))<2, + dataL=dataL_(1..(length(dataL)-1)); + ); + nd=length(dataL_1)/2; + npt=length(dataL); + ptdata=[]; + forall(1..nd,ii, + tmp3=[]; + forall(1..npt, + tmp1=dataL_#_(2*ii-1); + tmp2=dataL_#_(2*ii); + if(isreal(tmp1), + tmp3=append(tmp3,[tmp1,tmp2]); + ); + ); + ptdata=append(ptdata,tmp3); + ); + tmp1=[]; + forall(ptdata, + tmp=#/sc; + tmp=translatedata("1",[tmp],-mv,["nodata"]); + tmp1=append(tmp1,tmp); + ); + ptdata=tmp1; + ptdata; +); + +Putbezierdata(name,ptL):=Putbezierdata(name,ptL,[]); +Putbezierdata(name,ptL,options):=( + regional(psize,Deg,tmp,tmp1,tmp2,p1,p2,pts,ctrs); + tmp=Divoptions(options); + psize=3; + Deg=3; + tmp1=tmp_5; + forall(tmp1, + if(substring(#,0,1)=="D", + tmp=indexof(#,"="); + Deg=parse(substring(#,tmp,length(#))); + ); + if(substring(#,0,1)=="S", + tmp=indexof(#,"="); + psize=parse(substring(#,tmp,length(#))); + ); + ); + pts=[]; + ctrs=[]; + forall(1..length(ptL), + p2=ptL_#; // 16.08.16 + if(ispoint(p2), + tmp1=text(p2); + , + tmp1=name+text(#); + Putpoint(tmp1,p2,Lcrd(parse(tmp1))); // 16.08.16 + ); + inspect(parse(tmp1),"ptsize",psize); + pts=append(pts,parse(tmp1)); + inspect(parse(tmp1),"color",4); + if(#>1, + p1=Lcrd(ptL_(#-1)); // 16.08.16 + p2=Lcrd(ptL_#); // 16.08.16 + if(Deg==3, + tmp=(2*p1+p2)/3; + tmp1=name+"p"+text(#-1); + Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16 + inspect(parse(tmp1),"labeled",false); //15.01.22 + Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22 + inspect(parse(tmp1),"ptsize",psize); + inspect(parse(tmp1),"color",3); + tmp=(p1+2*p2)/3; + tmp2=name+"q"+text(#-1); + Putpoint(tmp2,tmp,Lcrd(parse(tmp2))); // 16.08.16 + inspect(parse(tmp2),"labeled",false); //15.01.22 + Letter([parse(tmp2),"ne",tmp2],["notex"]); //15.01.22 + inspect(parse(tmp2),"ptsize",psize); + inspect(parse(tmp2),"color",3); + ctrs=append(ctrs,[parse(tmp1),parse(tmp2)]); + , + tmp=(p1+p2)/2; + tmp1=name+"p"+text(#-1); + Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16 + inspect(parse(tmp1),"labeled",false); //15.01.22 + Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22 + inspect(parse(tmp1),"ptsize",psize); + inspect(parse(tmp1),"color",3); + ctrs=append(ctrs,[parse(tmp1)]); + ); + ); + ); + [pts,ctrs,name]; +); + +Bezierstart(n):=( // 2016.02.26 + BezierNumber=n; +); + +Mkbezierptcrv(ptdata):=Mkbezierptcrv(ptdata,[]); +Mkbezierptcrv(ptdata,options):=( + //help:Mkbezierptcrv([A,B,C,D]); + //help:Mkbezierptcrv([[A,B],[C,D]]); + //help:Mkbezierptcrv(options=["Num=10"]); + // global BezierNumber + regional(ptlist,Out,tmp,tmp1,tmp2); + if(isstring(ptdata), + ptlist=Readcsvsla(ptdata,options); + , + ptlist=ptdata; + ); + if(MeasureDepth(ptlist)==1,ptlist=[ptlist]); + Out=[]; + forall(1..length(ptlist), + tmp=floor((BezierNumber-1)/26);// 15.02.23 + if(tmp==0,tmp="",tmp=text(tmp)); + tmp2=mod(BezierNumber,26); + if(tmp2==0,tmp2=26); + tmp1=unicode(text(96+tmp2),base->10)+tmp;// 15.03.11 + tmp2=Putbezierdata(tmp1,ptlist_#,options); + Bezier(tmp2,options); + BezierNumber=BezierNumber+1; + Out=append(Out,tmp2_(1..2)); + ); + Out; +); + +Mkbeziercrv(nm,ptctrL):=Mkbeziercrv(nm,ptctrL,[]); +Mkbeziercrv(nm,ptctrL,options):=( + //help:Mkbeziercrv("1",[[A,B,C,D],[[P,Q],[R,S],T]]); + regional(ptctrLL,name,ptlist,ctrlist,tmp,tmp1,tmp2); + if(MeasureDepth(ptctrL)==2,ptctrLL=[ptctrL],ptctrLL=ptctrL); + forall(1..length(ptctrLL), + name=nm+text(#); + ptlist=ptctrLL_#_1; + ctrlist=ptctrLL_#_2; + Bezier(name,ptlist,ctrlist,options); + ); +); + +Writebezier():=Writebezier(Fhead,"all"); +Writebezier(head):=Writebezier(head,"all"); +Writebezier(head,seL):=( +//help:Writebezier(file); +//help:Writebezier(file,"acd"); + regional(bz,dt,name,tmp,tmp1,tmp2); + bz=select(GLIST,indexof(#,"=Bezier")>0); + tmp1=[]; // 16.04.22from + if(seL!="all", + forall(1..length(seL), + tmp=substring(seL,#-1,#); + tmp=select(bz,indexof(#,"bz"+tmp)>0); + tmp1=concat(tmp1,tmp); + ); + bz=tmp1;// 16.04.22upto + ); + dt=[head+"n",[[length(bz),0]]]; + forall(1..length(bz), + tmp=indexof(bz_#,"="); + name=substring(bz_#,0,tmp-1); + tmp=indexof(bz_#,","+Dq); + if(tmp>0, + tmp1=substring(bz_#,0,tmp-1)+")"; + , + tmp1=bz_#; + ); + tmp1=replace(tmp1,"Bezier(","["); + tmp1=replace(tmp1,"list(","["); + tmp1=replace(tmp1,")","]"); + tmp1=replace(tmp1,",",".xy,"); + tmp1=replace(tmp1,"]",".xy]"); + tmp1=replace(tmp1,".xy,[",",["); + tmp1=replace(tmp1,"].xy","]"); + tmp1=replace(tmp1,name,head+text(#)); + parse(tmp1); + tmp=parse(head+text(#)+"_1"); + dt=concat(dt,[head+text(#)+"k",tmp]); + tmp=parse(head+text(#)+"_2"); + dt=concat(dt,[head+text(#)+"c",tmp]); + ); + WriteOutData(head+".txt",dt); + dt; +); + +Readbezier(file):=Readbezier(file,[]); +Readbezier(file,optionorg):=( +//help:Readbezier("xsr"); +//help:Readbezier(options=["Num=10","nogeo"]); + regional(nn,options,stL,geo,nc,alpha,out,tmp,tmp1,tmp2,tmp3); + options=optionorg; + tmp=Divoptions(options); + stL=tmp_7; + geo=0; + forall(stL, + tmp=Toupper(substring(#,0,1)); + if(tmp=="G",geo=1); + options=remove(options,[#]); + ); + ReadOutData(file); + tmp=file+"n_1_1"; + nn=parse(tmp); + out=[]; + forall(1..nn,nc, + tmp=file+text(nc); + tmp1=parse(tmp+"k"); + tmp2=parse(tmp+"c"); + if(MeasureDepth(tmp2)==1,tmp2=[tmp2]); // 16.04.22from + if(geo==1, + alpha="abcdefghijklmnopqrstuvwxyz"; + forall(1..length(tmp1), + tmp="k"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#); + Putpoint(tmp,tmp1_#,parse(tmp+".xy")); + inspect(parse(tmp),"labeled",false); + inspect(parse(tmp),"ptsize",3); + tmp1_#=parse(tmp+".xy"); + ); + forall(1..length(tmp2), + tmp="c"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#)+"1"; + Putpoint(tmp,tmp2_#_1,parse(tmp+".xy")); + inspect(parse(tmp),"labeled",false); + inspect(parse(tmp),"color",4); + inspect(parse(tmp),"ptsize",3); + tmp2_#_1=parse(tmp+".xy"); + tmp="c"+BezierNumber+"no"+text(nc)+substring(alpha,#-1,#)+"2"; + Putpoint(tmp,tmp2_#_2,parse(tmp+".xy")); + inspect(parse(tmp),"labeled",false); + inspect(parse(tmp),"color",4); + inspect(parse(tmp),"ptsize",3); + tmp2_#_2=parse(tmp+".xy"); + ); + BezierNumber=BezierNumber+1; + ); + Bezier(file+text(nc),tmp1,tmp2,options);// 16.04.22upto + out=append(out,"bz"+tmp); + ); + out; +); + +Ospline(nm,ptlist):=Ospline(nm,ptlist,[]); +Ospline(nm,ptlist,options):=( +//help:Ospline("1",ptlist,[options]); + regional(tmp,tmp1,tmp2,list,ptL,ctrL,name,closed,flg, + p0,p1,p2,p3,pQ,pR,cc,p01,p02,p11,p12,p21,p22,p31,p32); + name="o"+nm; + if(isstring(ptlist),list=parse(ptlist),list=ptlist); + if(|list_1-list_(length(list))|<10^(-6),closed=1,closed=0); +// list=apply(list,LLcrd(#)); + ctrL=[]; + forall(1..(length(list)-1), + flg=0; + p1=Lcrd(list_#); // 16.08.16 + p2=Lcrd(list_(#+1)); // 16.08.16 + if(#==1 % #==length(list)-1, + flg=1; + if(closed==0, + pQ=(p1+2*p2)/3; // 15.09.21 // 16.08.16 + pR=(2*p1+p2)/3; // 16.08.16 + ctrL=append(ctrL,[pQ,pR]); + flg=2; + , + if(#==1, + p0=Lcrd(list_(length(list)-1)); // 16.08.16 + p3=Lcrd(list_(#+2)); // 16.08.16 + , + p0=Lcrd(list_(#-1)); // 16.08.16 + p3=Lcrd(list_2); // 16.08.16 + ); + ); + ); + if(flg<=1, + if(flg==0, + p0=Lcrd(list_(#-1)); // 16.08.16 + p3=Lcrd(list_(#+2)); // 16.08.16 + ); + tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2); + cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp; + pQ=p1+cc*(p2-p0); // 15.09.21 // 16.08.16 + pR=p2+cc*(p1-p3); // 16.08.16 + ctrL=append(ctrL,[pQ,pR]); + ); + ); +// list=apply(list,LLcrd(#)); // 16.08.16 +// ctrL=apply(ctrL,LLcrd(#)); + if(closed==0, // 15.09.21 + p1=ctrL_2_1; + p2=Lcrd(list_2); // 16.08.16 + pQ=p2+(p2-p1); + ctrL_1=[pQ]; + tmp=length(ctrL); + tmp1=ctrL_(tmp-1); + p1=ctrL_(tmp-1)_2; + p2=Lcrd(list_(tmp)); // 16.08.16 + pQ=p2+(p2-p1); + ctrL_tmp=[pQ]; + ); + Bezier("o"+nm,list,ctrL,options); +); + +CRspline(nm,ptL):=CRspline(nm,ptL,[]); +CRspline(nm,ptL,options):=( + // Catmull-Rom spline +//help:CRspline("1",[A,B,C,A]); + regional(name,ptlist,ctrpts,eqL,opcindy,c,v,tmp,tmp1,tmp2,ctrlist,cflg); + name="crsp"+nm; + if(MeasureDepth(ptL)==1,tmp=[ptL],tmp=ptL); + ptlist=tmp_1; + if(length(tmp)==1, + cflg=1; + , + cflg=0; + ctrpts=tmp_2; + ); + c=1/6; + tmp=Divoptions(options); + eqL=tmp_5; + opcindy=tmp_(length(tmp)); // 15.03.05 + forall(eqL, + if(substring(#,0,1)=="R", + tmp2=indexof(#,"="); + c=parse(substring(#,tmp2,length(#))); + ); + ); + ptlist=apply(ptlist,Lcrd(#)); // 16.08.16 + ctrlist=[]; + forall(1..(length(ptlist)-1), + if(#==1, + if(cflg==0, + tmp1=ctrpts_1; + , + v=ptlist_2-ptlist_(length(ptlist)-1); + tmp1=ptlist_#+c*v; + ); + , + v=ptlist_(#+1)-ptlist_(#-1); + tmp1=ptlist_#+c*v; + ); + if(#==length(ptlist)-1, + if(cflg==0, + tmp2=ctrpts_2; + , + v=ptlist_2-ptlist_#; + tmp2=ptlist_(#+1)-c*v; + ); + , + v=ptlist_(#+2)-ptlist_#; + tmp2=ptlist_(#+1)-c*v; + ); + tmp=select(options,indexof(text(#),"->")>0); + tmp=append(tmp,"notex"); //15.03.05 + Pointdata(name+text(#),[tmp1,tmp2],tmp); + ctrlist=append(ctrlist,[tmp1,tmp2]); + ); + Bezier(nm,ptlist,ctrlist,options); +); + +Beziersmooth(nm,ptL):=Bzspline(nm,ptL,[]); +//help:Beziersmooth("1",[A,B,C,A]); +Beziersmooth(nm,ptL,options):=Bzspline(nm,ptL,options); +Bzspline(nm,ptL):=Bzspline(nm,ptL,[]); +Bzspline(nm,ptLorg,options):=( + // smooth bezier + regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr, + tmp,tmp1,tmp2,cflg,ctrlist); + name="bzsp"+nm; + Eps=10^(-3); + ptL=apply(ptLorg,Lcrd(#)); // 16.08.16 + if(|ptL_1-ptL_(length(ptL))|1 % cflg==1, + tmp1="c"+text(#); + inspect(parse(tmp1),"alpha",0.3); + ); + tmp1="C"+text(#)+"p"; + tmp2="C"+text(#)+"q"; + inspect(parse(tmp1),"ptsize",3); + inspect(parse(tmp1),"color",3); + inspect(parse(tmp2),"ptsize",3); + inspect(parse(tmp2),"color",3); + tmp=[parse(tmp1),parse(tmp2)]; + ctrlist=append(ctrlist,tmp); + ); + Bezier(nm,ptL,ctrlist,options); + [ptL,ctrlist]; +); + +Beziersym(nm,ptL):=Bzsspline(nm,ptL,[]); +Beziersym(nm,ptL,options):=Bzsspline(nm,ptL,options); +Bzsspline(nm,ptL):=Bzsspline(nm,ptL,[]); +Bzsspline(nm,ptLorg,options):=( + // smooth bezier with symmetric control points + regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr, + tmp,tmp1,tmp2,cflg,ctrlist); + name="bzssp"+nm; + Eps=10^(-3); + ptL=apply(ptLorg,Lcrd(#)); // 16.08.16 + if(|ptL_1-ptL_(length(ptL))|Eps, + pcl=list; + pcl_1=2*list_1-list_2; + pcl_k=2*list_k-list_(k-1); + , + pcl=concat(list,[list_2]); + ); + ctrl=apply(2..(length(pcl)-1),[pcl_#]); + ptl=apply(1..(length(pcl)-1),(pcl_#+pcl_(#+1))/2); + [ptl,ctrl]; +); + +Bspline(nm,ctrL):=Bspline(nm,ctrL,[]); +Bspline(nm,ctrL,options):=( +//help:Bspline("",[A,B,C]); + regional(list,tmp); + list=Listbspline2bz(ctrL); + tmp=BezierCurve("b"+nm,list_1,list_2,options); + tmp; +); + +MeetCurve(Crv,Xorg,Yorg):=( + regional(Cv,tmp,tmp1,tmp2,X0,Y0,x1,x2,y1,y2,Ylist,Ban,Tate); + if(isstring(Crv),Cv=parse(Crv),Cv=Crv); + if(MeasureDepth(Cv)==2,Cv=Cv_1); + Cv=apply(Cv,LLcrd(#)); // 14.12.18 + while(length(Cv)==1, + Cv=Cv_1; + ); + Cv=apply(Cv,Lcrd(#)); + tmp1=min(apply(Cv,#_1)); + tmp2=max(apply(Cv,#_1)); + if(isstring(Xorg),X0=parse(Xorg),X0=Xorg); + if(isstring(Yorg),Y0=parse(Yorg),Y0=Yorg); + if(X0tmp2, + X0=tmp2; + ); + ); + tmp1=select( + 1..(length(Cv)-1),Cv_#_1<=X0 & X0<=Cv_(#+1)_1); + tmp2=select( + 1..(length(Cv)-1),Cv_#_1>=X0 & X0>=Cv_(#+1)_1); + tmp2=remove(tmp2,common(tmp2,tmp1)); + Ban=concat(tmp1,tmp2); + Tate=select(Ban, + abs(Cv_#_1-Cv_(#+1)_1)<= + 10^(-2)*abs(Cv_#_2-Cv_(#+1)_2) + ); + Ban=remove(Ban,Tate); + Ylist=[]; + forall(Ban, + tmp=Cv_#; + x1=tmp_1; y1=tmp_2; + tmp=Cv_(#+1); + x2=tmp_1; y2=tmp_2; + tmp=((x2-X0)*y1+(X0-x1)*y2)/(x2-x1); + Ylist=append(Ylist,tmp); + ); + forall(Tate, + tmp=Cv_#; + x1=tmp_1; y1=tmp_2; + tmp=Cv_(#+1); + x2=tmp_1; y2=tmp_2; + tmp1=min([y1,y2]); + tmp2=max([y1,y2]); + if(Y0tmp2, + tmp=tmp2; + , + tmp=Y0; + ); + ); + Ylist=append(Ylist,tmp); + ); + tmp=sort(Ylist,abs(#_1-Y0)); + [X0,tmp_1]; +); + +PutonLine(name,p1,p2):=PutonLine(name,p1,p2,[]); +PutonLine(name,p1org,p2org,options):=( +//help:PutonLine("C","sgAB"); +//help:PutonLine("C",pA,pB); + regional(par,p1,p2,dx,dy,tmp,tmp1,tmp2); + par=0.5; + tmp=Divoptions(options); + if(length(tmp_6)>0, + par=tmp_6_1; + ); + p1=Lcrd(p1org);//16.10.11from + p2=Lcrd(p2org); + dx=p2_1-p1_1; + dy=p2_2-p1_2; + tmp1=(1-par)*p1+par*p2; + if(abs(dx)>abs(dy), + tmp=name+".x"; + tmp2="["+tmp+",dy/dx*("+tmp+"-p1_1)+p1_2]";//16.10.11upto + Putpoint(name,tmp1,parse(tmp2)); + , + if(abs(dy)>0, + tmp=name+".y"; + tmp2="[dx/dy*("+tmp+"-p1.y)+p1_1,"+tmp+"]"; + Putpoint(name,tmp1,parse(tmp2)); + , + tmp2=p1;//16.10.11 + Putpoint(name,tmp1,tmp2); + ); + ); +); + +PutonSeg(name,sgstr):=( + regional(seg,p1,p2); + if(isstring(sgstr),seg=parse(sgstr),seg=sgstr); + PutonSeg(name,LLcrd(seg_1),LLcrd(seg_2)); +); +PutonSeg(name,p1,p2):=PutonSeg(name,p1,p2,[]); +PutonSeg(name,p1org,p2org,options):=( +//help:PutonSeg("C","sgAB"); +//help:PutonSeg("C",pA,pB); + regional(par,dx,dy,p,tmp,tmp1,tmp2); + par=0.5; + tmp=Divoptions(options); + if(length(tmp_6)>0, + par=tmp_6_1; + ); + p1=Lcrd(p1org);//16.10.11from + p2=Lcrd(p2org); + PutonLine(name,p1,p2,[par]); + dx=p2_1-p1_1; + dy=p2_2-p1_2; + p=parse(name+".xy"); + p=LLcrd(p); + if(abs(dx)>abs(dy) & (p_1-p1_1)*(p_1-p2_1)>0, + if(|p-p1|<|p-p2|, + parse(name+".xy=Pcrd(p1)"); + , + parse(name+".xy=Pcrd(p2)"); + ); + ); + if(abs(dx)0, + if(|p-p1|<|p-p2|, + parse(name+".xy=Pcrd(p1)"); + , + parse(name+".xy=Pcrd(p2)");//16.10.11upto + ); + ); +); + +PutonCurve(pn,crv):=PutonCurve(pn,crv,[]); +PutonCurve(pn,crv,options):=( +//help:PutonCurve("A","gr1"); + regional(Pmt,pstr,optionL,leftlim,rightlim,tmp,tmp1,Flg,Msg); + if(!islist(options),optionL=[options],optionL=options); + leftlim=XMIN; + rightlim=XMAX; + Flg=0; + Msg="y"; + forall(optionL, + if(isstring(#), // 16.02.10 from + tmp=indexof(#,"="); + tmp1=Toupper(substring(#,tmp,tmp+1)); + if(tmp1=="N", Msg="n"); // 16.02.10 upto + , + if(Flg==0, + leftlim=#; + Flg=Flg+1; + , + rightlim=#; + ); + ); + ); + Pmt=MeetCurve(crv,leftlim,0); + pstr=apply(allpoints(),textformat(#,5)); // 15.04.07 + if(!contains(pstr,pn), + createpoint(pn,Pcrd(Pmt)); + , + tmp1=parse(pn+".x"); + if(tmp1< leftlim % tmp1>rightlim, + if(tmp1< leftlim,tmp= leftlim, tmp=rightlim); + Pmt=MeetCurve(crv,textformat(tmp,5),pn+".y"); + , + Pmt=MeetCurve(crv,pn+".x",pn+".y"); + ); + ptstr=pn+".xy="+textformat(Pcrd(Pmt),5)+";"; + parse(ptstr); + ); + if(Msg=="y", + println("Put "+pn+" on Curve "+text(crv)); + ); +); + +CrossPoint(name,Crv1,Crv2,range):=( + regional(Mx1,Mx2,Mx3,tmp,Crs1,Crs2,Crs3,Crs4,df1,df2); + Mx1=range_1; Mx2=range_2; + repeat(15, + Mx3=(Mx1+Mx2)/2; + Crs1=MeetCurve(Crv1,Mx1,0); + Crs2=MeetCurve(Crv2,Mx1,0); + Crs3=MeetCurve(Crv1,Mx3,0); + Crs4=MeetCurve(Crv2,Mx3,0); + df1=Crs1_2-Crs2_2; + df2=Crs3_2-Crs4_2; + if((df1>0 & df2>0) % (df1<0 & df2<0), + Mx1=Mx3; + , + Mx2=Mx3; + ); + ); + Putpoint(name,Crs1); +); + +Setscaling(sc):=( +//help:Setscaling(3); + SCALEX=1; + SCALEY=sc; + Com0th("Setscaling("+sc+")"); + Setwindow("Msg=no"); +); + +Tabledatalight(nm,xLst,yLst,rmvL):=Tabledatalight(nm,xLst,yLst,rmvL,[]); +Tabledatalight(nm,xLst,yLst,rmvL,options):=( +//help:Tabledatalight("",xLst,yLst,rmvL,[2]); + regional(name,upleft,ul,flg,tick,n,m,xsize,ysize,rlist,clist,Tb, + tmp,tmp1,tmp2,tmp3,Eps); +// name="tb"+nm; + name="tb"; + println("Tabledatalight "+name+" generated"); + tmp=sum(yLst); + upleft=[0,tmp]; + tick=1; + tmp=Divoptions(options); + flg=0; + forall(tmp_6, + if(flg==0, + tick=#; + flg=flg+1; + , + upleft=tmp_6_1; + ); + ); + ul=upleft/10; + m=length(xLst); + n=length(yLst); + xsize=sum(xLst); + ysize=sum(yLst); + clist=[ul]; + rlist=[ul]; + forall(1..m, + tmp1=clist_(#)_1+xLst_#/10; + clist=append(clist,[tmp1,clist_1_2]); + ); + forall(1..n, + tmp1=rlist_(#)_2-yLst_#/10; + rlist=append(rlist,[0,tmp1]); + ); + Tb=[clist,rlist]; + tmp=name+"="+Tb; + parse(tmp); + forall(0..m, + tmp1="c"+text(#)+"r0"; + tmp2="c"+text(#)+"r"+text(n); + Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options); + if(mod(#,tick)==0 % #==m, + tmp=clist_(#+1); + drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#)); + ); + ); + forall(0..n, + tmp1="c0r"+text(#); + tmp2="c"+text(m)+"r"+text(#); + Tlistplot("r"+text(#)+"c0c"+text(m),[tmp1,tmp2],options); + if(mod(#,tick)==0 % #==n, + tmp=rlist_(#+1); + drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#)); + ); + ); + Tsegrmv(rmvL,options); + Addax(0); + Eps=10^(-3); + tmp1=clist_(length(clist)); + tmp2=rlist_1; + tmp3=rlist_(length(rlist)); + Setwindow([0-Eps,tmp1_1+Eps],[tmp3_2-Eps,tmp2_2+Eps]); + Tb; +); + +Tabledata(nm,n,m,xsize,ysize,rmvL):= + Tabledata(nm,n,m,xsize,ysize,rmvL,[]); +Tabledata(nm,n,m,xsize,ysize,rmvL,options):=( + regional(Tb,name,tmp,xLst,yLst); + name="tb"+nm; + xLst=apply(1..n,xsize/n); + yLst=apply(1..m,ysize/m); + Tabledata(nm,xLst,yLst,rmvL,options) +); +Tabledata(nm,xLst,yLst,rmvL):=Tabledata(nm,xLst,yLst,rmvL,[]); +Tabledata(nm,xLst,yLst,rmvL,options):=( +//help:Tabledata("",xLst,yLst,rmvL,[2]); + regional(name,upleft,ul,flg,tick,n,m,xsize,ysize,rlist,clist,Tb, + tmp,tmp1,tmp2,tmp3,Eps); +// name="tb"+nm; + name="tb"; + println("Tabledata "+name+" generated"); + tmp=sum(yLst); + upleft=[0,tmp]; + tick=1; + tmp=Divoptions(options); + flg=0; + forall(tmp_6, + if(flg==0, + tick=#; + flg=flg+1; + , + upleft=tmp_6_1; + ); + ); + ul=upleft/10; + m=length(xLst); + n=length(yLst); + xsize=sum(xLst); + ysize=sum(yLst); + clist=[ul]; + rlist=[ul]; + forall(1..m, + tmp1=clist_(#)_1+xLst_#/10; + clist=append(clist,[tmp1,clist_1_2]); + ); + forall(1..n, + tmp1=rlist_(#)_2-yLst_#/10; + rlist=append(rlist,[0,tmp1]); + ); + Tb=[clist,rlist]; + tmp=name+"="+Tb; + parse(tmp); + forall(0..m, + tmp="C"+text(#); + tmp1="c"+text(#)+"r0"; + if(#==0, + Putpoint(tmp,Tgrid(tmp1)); + , + Putpoint(tmp,Tgrid(tmp1),[parse(tmp+".x"),C0.y]); + clist_(#+1)=parse(tmp+".xy"); + ); + inspect(parse(tmp),"ptsize",3); + inspect(parse(tmp),"labeled",false); + if(mod(#,tick)==0 % #==m, + tmp=clist_(#+1); + drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#)); + ); + ); + forall(0..n, + tmp="R"+text(#); + tmp1="c0r"+text(#); + if(#==0, + Putpoint(tmp,Tgrid(tmp1)); + , + Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]); + rlist_(#+1)=parse(tmp+".xy"); + ); + Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]); + inspect(parse(tmp),"ptsize",3); + inspect(parse(tmp),"labeled",false); + if(mod(#,tick)==0 % #==n, + tmp=rlist_(#+1); + drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#)); + ); + ); + Tb=[clist,rlist]; + tmp=name+"="+Tb; + parse(tmp); + forall(0..m, + tmp1="c"+text(#)+"r0"; + tmp2="c"+text(#)+"r"+text(n); + Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options); + if(#=n1 & m2<=n2, + gc=#; + flg=1; + ); + ); + ); + if(flg==1, + Changestyle([gc_1],["nodisp"]); + tail=""; + if(indexof(hd,"r")>0, + tail=hd; hd=""; + ); + if(n10, + posdir_2=posdir_2-dy; + posstr=replace(posstr,"b","n"); + ); + if(indexof(dir,"t")>0, + posdir_2=posdir_2+dy; + posstr=replace(posstr,"t","s"); + ); + if(indexof(dir,"l")>0, + posdir_1=posdir_1-dx; + posstr=replace(posstr,"l","e"); + ); + if(indexof(dir,"r")>0, + posdir_1=posdir_1+dx; + posstr=replace(posstr,"r","w"); + ); + Letter(posdir,posstr,text(lttr)); +); + +Putcellexpr(pos1,pos2,dir,ex):=Putcellexpr("",pos1,pos2,dir,ex); +Putcellexpr(Tbdata,pos1,pos2,dir,ex):=( +//help:Putcellexpr("c0r0","c2r1","lt","abc"); +//help:Putcellexpr(2,3,"c","\sin x"); + Putcell(Tbdata,pos1,pos2,dir,"$"+text(ex)+"$"); +); + +Putrow(nrow,dir,lttrL):=Putrow("",nrow,dir,lttrL); +Putrow(Tbdata,nrow,dir,lttrL):=( +//help:Putrow(1,"c",["x","y","z"]); + regional(tmp,tmp1,mcol); + mcol=length(lttrL); + forall(1..mcol, + Putcell(Tbdata,#,nrow,dir,lttrL_#); + ); +); + +Putrowexpr(nrow,dir,exL):=Putrowexpr("",nrow,dir,exL); +Putrowexpr(Tbdata,nrow,dir,exL):=( +//help:Putrowexpr(2,"r",["x","y","z"]); + regional(lttrL); + lttrL=apply(exL,"$"+#+"$"); + Putrow(Tbdata,nrow,dir,lttrL); +); + +PutcoL(mcol,dir,lttrL):=PutcoL("",mcol,dir,lttrL); +PutcoL(Tbdata,mcol,dir,lttrL):=( +//help:PutcoL(1,"c",["x","y","z"]); + regional(tmp,tmp1,nrow); + nrow=length(lttrL); + forall(1..nrow, + Putcell(Tbdata,mcol,#,dir,lttrL_#); + ); +); +PutcoLexpr(mcol,dir,exL):=PutcoLexpr("",mcol,dir,exL); +PutcoLexpr(Tbdata,mcol,dir,exL):=( +//help:PutcoLexpr(2,"r",["x","y","z"]); + regional(lttrL); + lttrL=apply(exL,"$"+#+"$"); + PutcoL(Tbdata,mcol,dir,lttrL); +); + +Setwindow():=Setwindow("Msg=yes"); +Setwindow(str):=( + regional(tmp,tmp1,tmp2,msg); + msg="y"; + tmp=indexof(str,"="); // 16.02.10 + tmp1=Toupper(substring(str,tmp,tmp+1)); + if(tmp1=="N",msg="n"); + if((ispoint(SW) & ispoint(NE)), + tmp1=Lcrd(SW); + tmp2=Lcrd(NE); + XMIN=tmp1_1; XMAX=tmp2_1; + YMIN=tmp1_2; YMAX=tmp2_2; + , +// XMIN=-5; XMAX=5; +// YMIN=Lcrdy(-5); YMAX=Lcrdy(5); + createpoint("SW",Pcrd([XMIN,YMIN])); + createpoint("NE", Pcrd([XMAX,YMAX])); + ); + if(msg=="y", + println("Setwindow(["+XMIN+","+XMAX+"],["+YMIN+","+YMAX+"])"); + ); + layer(KETPICLAYER); + autoclearlayer(KETPICLAYER,true); + drawpoly([Pcrd([XMIN,YMIN]), Pcrd([XMAX,YMIN]), + Pcrd([XMAX,YMAX]),Pcrd([XMIN,YMAX])],color->[1,1,1]); +); +Setwindow(xrange,yrange):=( +//help:Setwindow([2,3],[-1,1]); + XMIN=xrange_1; + XMAX=xrange_2; + YMIN=yrange_1; + YMAX=yrange_2; +// Setwindow(); +); + +Sciform(list):=( + regional(plotlist,comp,pos,out,out2,nn,strL,flg, + tmp,tmp1,tmp2,tmp3,Nj); + plotlist=Flatten([list]); + out=replace(plotlist_1,".xy",""); + out=replace(out,".x","(1)"); + out=replace(out,".y","(2)"); + if(length(plotlist)==1, + comp=[]; + forall(1..length(out), + comp=append(comp,substring(out,#-1,#)); + ); + out=""; + pos=0; + forall(comp, + if(#!="'", + out=out+#; + , + if(pos==0, + tmp=indexof(out,"Assign("); + if(substring(out,length(out)-7,length(out))=="Assign(", + out=out+"'"; + pos=1; + , + out=out+"Assign('"; + pos=2; + ); + , + if(pos==2, + out=out+"')"; + , + out=out+"'"; + ); + pos=0; + ); + ); + ); + , + forall(2..length(plotlist), + comp=plotlist_#; + if(isstring(comp), + pos=indexof(comp,"Assign("); + if(pos>0, + comp=substring(comp,6,length(comp)); + ); + out=out+"Assign("; + comp=replace(comp,".xy",""); + comp=replace(comp,".x","(1)"); + comp=replace(comp,".y","(2)"); + out=out+"'"+comp+"'"; + out=out+"),"; + ); + if(islist(comp), + forall(comp, + out=out+"'"+#+"',"; + ); + ); + ); + if(length(plotlist)>1, + out=substring(out,0,length(out)-1); + out=out+");"; + ); + ); + pos=[]; + forall(1..length(out), + tmp=indexof(substring(out,#-1,length(out)),"Assign"); + if(tmp>0, + tmp1=#-1+tmp; + if(length(pos)==0, + pos=[tmp1]; + , + if(pos_(length(pos))0, + strL=[]; + Nj=0; + forall(pos, + tmp=substring(out,Nj,#-1); + strL=append(strL,tmp); + Nj=#-1; + ); + strL=append(strL,substring(out,Nj,length(out))); + out=""; + forall(strL, + if(indexof(#,"Assign")==0, + out=out+#; + , + tmp=indexof(#,"('"); + tmp1=indexof(#,"')"); + tmp2=substring(#,tmp+1,tmp1-2); + tmp3=substring(#,tmp1-2,length(#)); + if(indexof(tmp2,"=")==0, + out=out+#; + , + tmp=substring(tmp2,0,indexof(tmp2,"=")); + out=out+"'"+tmp+"'+"+"Assign('"; + tmp=substring(tmp2,indexof(tmp2,"="),length(tmp2)); + out=out+tmp+tmp3; + ); + ); + ); + ); + out2=""; // patched 16.01.21 from + nn=length(out); + flg=0; + forall(1..nn, + if(flg==0, + tmp=indexof(out,"='+Assign('"); + if(tmp==0, + out2=out2+out; + flg=1; + , + out2=out2+substring(out,0,tmp); + out=substring(out,tmp+10,length(out)); + tmp=indexof(out,"'"); // 16.04.19 from + tmp1=substring(out,0,tmp-1); + tmp2="1234567890"; + tmp=apply(1..length(tmp1), + indexof(tmp2,substring(tmp1,#-1,#))); + tmp=min(tmp); + if(tmp==0, // 16.04.19 upto + out2=out2+"'+Assign('"; + , + tmp=indexof(out,"'"); + out=substring(out,0,tmp)+substring(out,tmp+1,length(out)); // 16.04.18 upto + ); + ); + ); + ); + out2=replace(out2,"Dist=","D="); + out2=replace(out2,"Dis=","D="); + out2; +); + + +Rform(list):=( + regional(plotlist,comp,pos,out,strL,tmp,tmp1,tmp2,tmp3,Nj); + out=list; + out=replace(out,"[[[","list([["); + out=replace(out,"[","c("); + out=replace(out,"]",")"); + out=replace(out,".xy",""); + out=replace(out,".x","[1]"); + out=replace(out,".y","[2]"); + out; +); + +Defvar(varstr):=( + regional(name,value,tmp,tmp1); + parse(varstr); + tmp=indexof(varstr,"="); + name=substring(varstr,0,tmp-1); + value=substring(varstr,tmp,length(varstr)); + value=parse(value); + tmp1=select(1..length(VLIST),VLIST_#_1==name+"="); + if(length(tmp1)>0, + tmp=tmp1_1; + VLIST_tmp=[name+"=",value]; + , + VLIST=prepend([name+"=",value],VLIST); + ); +); + +Defvar(name,value):=( +//help:Defvar("a",0.3); + regional(tmp,tmp1); + if(islist(value), + tmp1="["; + forall(value, + tmp1=tmp1+format(#,5)+","; + ); + tmp1=substring(tmp1,0,length(tmp1)-1)+"]"; + , + tmp1=format(value,5); + ); + tmp=name+"="+tmp1; // 15.02.06 + parse(tmp); + VLIST=select(VLIST,#_1!=name+"="); // 15.02.08 + VLIST=prepend([name+"=",value],VLIST); +); + +Iftosci(strorg):=( // 16.06.10 + regional(str,ifL,ppL,cpL,kk,sL, + tmp,tmp1,tmp2,tmp3,tmp4); + str=replace(strorg,LFmark,""); + ifL=Indexall(str,"if("); + ppL=Bracket(str,"()"); + cpL=Indexall(str,","); + tmp1=Bracket(str,"[]"); + forall(1..(length(tmp1)/2),kk, + cpL=select(cpL,#tmp1_(2*kk)_1); + ); + forall(1..length(ifL),kk, + tmp=select(ppL,#_1>ifL_kk); + tmp1=tmp_1; + tmp2=select(tmp,#_2==-tmp1_2); + tmp2=tmp2_1; + tmp3=select(cpL,#>tmp1_1 & #1, + sL_(tmp3_2)=";else,"; + ); + ); + tmp=sum(sL); +); + +Fortosci(strorg):=( + regional(str,jj,var,tmp,tmp1,tmp2,tmp3,tmp4, + Out,repL,Pflg,Iflg,Cflg); + str=strorg; + repL=[]; + tmp1=Indexall(str,"forall"); + tmp2=Indexall(str,","); + forall(1..length(tmp1),jj, + tmp=select(tmp2,#>tmp1_jj); + var=substring(str,tmp_1,tmp_2-1); + tmp3=substring(str,tmp1_jj-1,tmp_2-1); + tmp=indexof(tmp3,"("); + tmp4=substring(tmp3,tmp,length(tmp3)); + tmp=indexof(tmp4,","); + tmp4=substring(tmp4,0,tmp-1); + tmp4="for "+var+"="+tmp4; + tmp4=replace(tmp4,"..",":"); + repL=concat(repL,[tmp3,tmp4]); + ); + forall(1..length(repL)/2, + str=replace(str,repL_(2*#-1),repL_(2*#)); + ); + tmp=Bracket(str); + tmp=select(tmp,#_2==0); + tmp=tmp_1_1; + tmp1=substring(str,tmp-1,length(str)); + tmp1=replace(tmp1,")",";end"); + str=substring(str,0,tmp-1)+tmp1; + str=replace(str,";;",";"); + str; +); + +Deffun(name,bodylist):=( +//help:Deffun("f(x)",["regional(y)","y=x^2*(x-3)","y"]); // 16.02.18 + regional(funstr,tmp,tmp1,str,Pos); + funstr=name+":=("; + forall(bodylist, + funstr=funstr+#+";"; + ); + funstr=funstr+");"; + parse(funstr); + tmp=bodylist_(length(bodylist)); + str="function "+tmp+"="+name+","; + forall(1..(length(bodylist)-1), + tmp1=bodylist_#; + tmp1=replace(tmp1,LFmark,"");// 16.05.26 + tmp1=replace(tmp1," ","");// 16.05.26 + Pos=indexof(tmp1,"regional")+indexof(tmp1,"local"); + if(Pos==0, + tmp=replace(tmp1,".xy",""); + tmp=replace(tmp,".x","(1)"); + tmp=replace(tmp,".y","(2)"); + if(indexof(tmp,"if(")>0, + tmp=iftosci(tmp); + ); + if(indexof(tmp,"forall(")>0, // 16.05.26from + tmp=Fortosci(tmp); + ); // 16.05.26upto + str=str+tmp+","; + ); + ); + str=str+"endfunction;"; + FUNLIST=append(FUNLIST,str); +); + +Windispg():=( + regional(Nj,Nk,Dt,Vj,tmp,tmp1,tmp2,tmp3,opcindy); + gsave(); + layer(KETPIClayer); + forall(GCLIST,Nj, + if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17 + if(islist(Dt) & length(Dt)>0, // 12.19,12.22 + tmp=MeasureDepth(Dt); + if(tmp==1,Dt=[Dt]); + opcindy=Nj_3; + if(Nj_2<0,tmp1=0,tmp1=Nj_2); + if(tmp1<10, + forall(Dt,Nk, +// tmp2=apply(Nk,if(ispoint(#),Lcrd(#),#)); +// tmp2=apply(tmp2,Pcrd(#)); + tmp2=Nk; // 14.12.04 + if(length(Nk)>1, + forall(2..length(Nk), + tmp3=textformat(Nk_[#-1,#],5); + tmp3=substring(tmp3,1,length(tmp3)-1); + if(tmp1==1,opcindy=opcindy+",dashpattern->[2,2]"); + tmp="draw("+tmp3+ + ",dashtype->"+text(tmp1)+",linecolor->"+KCOLOR+opcindy+")"; + parse(tmp); + ); + , + if(length(Nk)==1, + tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31 + parse(tmp); + ); + ); + ); + ); + ); + ); +// if(ADDAXES=="1", // 16.10.08from +// draw([XMIN,0],[XMAX,0],color->[0,0.2,0]); +// draw([0,YMIIN],[0,YMAX],color->[0,0.2,0]); +// Letter([[XMAX,0],"e","x",[0,YMAX],"n","y"]); +// Letter([[0,0],"sw","O"]); +// ); // 16.10.08upto + grestore(); + layer(0); +); diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/CindyScriptset.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/CindyScriptset.txt deleted file mode 100644 index 7bbd6f0f..00000000 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/CindyScriptset.txt +++ /dev/null @@ -1,24 +0,0 @@ -use("KetCindyPlugin"); -Sciver="5.5.2"; -if(iswindows(), - Pathhead="C:\kettex\texlive"; - Dirhead=Pathhead+"\texmf-dist\scripts\ketcindy"; - PathThead=Pathhead+"\bin\win32\"; - Homehead="C:\Users"; - Dirfile=Homehead+"\"+getname()+"\ketcindy"; -); -if(ismacosx(), - Pathhead="/Applications/kettex/texlive"; - Dirhead=Pathhead+"/texmf-dist/scripts/ketcindy"; - PathThead=Pathhead+"/bin/x86_64-darwin/"; - Homehead="/Users"; - Dirfile=gethome()+"/ketcindy"; -); -setdirectory(Dirfile); -import("setketcindysci.txt"); -import("ketoutsetsci.txt"); -Mackc="open"; -setdirectory(Dirwork); -Helplist(["+","+3d","+mv"],"helpJ"); - -Pathpdf=PathAd; diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0601cycloid.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0601cycloid.cdy deleted file mode 100644 index ba340f66..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0601cycloid.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0602diffeq.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0602diffeq.cdy deleted file mode 100644 index e2298ba3..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0602diffeq.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0603envelope.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0603envelope.cdy deleted file mode 100644 index d790c529..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0603envelope.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0604diffeq2.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0604diffeq2.cdy deleted file mode 100644 index 85ee5df7..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0604diffeq2.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0605cycloid2.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0605cycloid2.cdy deleted file mode 100644 index 984566e9..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0605cycloid2.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0606epitrochoid.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0606epitrochoid.cdy deleted file mode 100644 index c1d8f2a7..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0606epitrochoid.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0607hypotrochoid.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0607hypotrochoid.cdy deleted file mode 100644 index 5f3e5438..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0607hypotrochoid.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0608cycloid3.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0608cycloid3.cdy deleted file mode 100644 index 1cb5266a..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s06animation/s06animation(Scilab)/s0608cycloid3.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/fig/slide0.tex b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/fig/slide0.tex new file mode 100644 index 00000000..3ff43765 --- /dev/null +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/fig/slide0.tex @@ -0,0 +1,11 @@ +{\Large\bf +\color[cmyk]{1,1,0,0} + +\begin{layer}{120}{0} +{\Huge \putnotes{60}{20}{メインタイトル}} +\putnotes{60}{50}{名前} +\putnotes{60}{60}{所属} +\putnotes{60}{70}{情報} +\end{layer} + +} diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/fig/wallpaper.tex b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/fig/wallpaper.tex new file mode 100644 index 00000000..5c08113b --- /dev/null +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/fig/wallpaper.tex @@ -0,0 +1,12 @@ +{\color[cmyk]{0.6,0.2,0.8,0}\huge\rm\normalsize + +\newpage + +\begin{layer}{120}{0} +\lineseg{0}{2}{125}{0} +\lineseg{0}{88}{125}{0} +\putnotese{0}{90}{\ketcindy} +\putnotesw{115}{90}{Mar. 31 2018} +\end{layer} + +} diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/howtouseslideE.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/howtouseslideE.txt index 6bd6ec5c..b7fc171b 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/howtouseslideE.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/howtouseslideE.txt @@ -1,146 +1,79 @@ -Presentation with ketslide 2017.09.28 +Presentation with ketslide 2018.03.30 -0. Making a file for slides. +0. Flow of making slides. 1) Copy ketsample/s07slideのs0701basic.cdy to your work directory and rename it. - Here, assume the file copied to Userhome/Desktop/work and renamed to sample.cdy. - 2) Copy s0701basic.txt and rename it with the same head, too. - 3) Double clicsample.cdy, modify Cindyscript/figures as follows. - Line 5 : Slidework(gethome()+"/Desktop/work"); - Line11: Edit the title. - 4) Press Gear mark on the top. - -1. Modify sample.txt. - - 0) The first line should be : - title::slide0// - 注1)バックグラウンド(例えばkabegamiとする)を入れるとき - ・kabegami.texを作成してfigフォルダに入れる. - ・sample.txtの指定は - タイトル::slide0::kabegami// - 注2)タイトル画面が不要の場合は, - タイトル(またはtitle)::// - - 1)すべての行の最後は必ず // をつける. - 注)urlの指定で//を用いるとき,||||とすると//に変換される. - 2)各ブロックの引数の区切りは :: - 3)コマンド - ・タイトル::読込ファイル名(::壁紙ファイル)// - 最初のタイトルページ - 注)スライドに置く文字はslide0.cdyで作成 - 注)壁紙をつけるときは,もう1つ :: で区切ってファイル名を書く - 注)preambleに追加するとき,::区切りで書き加え,最後に//をおく. - ・new(::行下げ)::タイトル((::位置)::読み込みファイル)// - mainslide - 例)new::[10]::最初に::{50}{20}::figure// - 注)読み込みファイルのサイズ変更するとき - new::[10]::最初に::{50}{20}::figure,0.8// - 他も同様 - ・same(::行下げ)((::位置)::読込ファイル)// - sameslide - ・enumerate(::書式)// - enumerate環境の始まり - ・itemize// - itemize環境の始まり - ・layer(::範囲)// - layer環境の始まり - ・item::文// - itemを追加 - ・putnote::方向と位置::読み込みファイル// - layer環境の中に図を入れる - 例)putonote::se{30}{10}::figure( , 倍率)//(inputのとき) - 例)putonote::se{30}{10}::include[width=5cm]::figure.pdf// - (includegraphicsのとき) - ・end// - enumerate,itemize,layer環境の終わり - ・上記以外// - そのままTeXに書き出す. - - 4)空白行を入れたいときは,...// とする. - - 5)必要な図はすべてfigに入れる. - - 6)newの後,複数のスライドを同時に作り順に表示するとき, - ・newの次の行に - %repeat=(newを含むスライドの枚数),para// - ・表示したいページは - %[2,-]::本文// - のように書く. - 注)[2,- ]は2ページ以降全部 - [-, 2,- ]は2ページまで表示 - [1..3,5 ]は1ページから3ページと5ページ - ・repeat=...の後に「,para」を追加するとリンクを作成 - ・他のページで薄文字にしたいときは %thin[2]::本文 - 注1)薄文字の濃さのデフォルトは0.1だが,Setslidebodyで変更可能 - 注2)また,sample.txtに以下を記述すれば,その後が変わる. - \setthin{濃さ}// - - 7)figの中にあるサブフォルダ(例えばsubfig)の図ファイルすべてを順に表示するとき - ・newの次の行に + Ex) s0701basic.cdy , s0701basic.txt + Rem) Rename both files. + Here, let files sample.cdy and sample.txt. + 2) Double-click sample.cdy, edit Settitle. + 3) Press Gear mark on the top. + 4) Press button "Title" on the screen. + 5) Press button "Slide". + +1. Editing the .txt file. + + 1) Put // at the last of every lines. + Rm) Use |||| for //. + http::||||.... // + 2) Use :: for separators of each command. + 3) Commands + title::titleslidename(::wallpaper)// + Rm) Put the first line. + main::mainttitlename// + new::pagetitlename// + enumerate// + =\begin{enumerate} + itemize// + =\begin{itemize} + layer::{xsize}{ysize}// + =\begin{layer}{xsize}{ysize} + item::sentence// + =\item sentence + putnote::dir{xpos}{ypos}::filename(,scale)// + =putnotedir{xpos}{ypos}{\input{fig/filename}} + end// + =\end{itemize,enumerate,layer} + Rm) Any other TeX command is available. + 4) Use ...// for inserting a blank line. + 5) To display a page step by step + Put just after new, + %repeat=number of steps// + Put at the head of each line as + %[2,-]::sentence + display at all steps from 2 + %[-,2]::sentence + display at all steps until 2 + %[1..3,5]::sentence + display at steps of 1,2,3 and 5 + Use %thin to display with thin letters. + %thin::[2,-]::sentence + Rm) the dencity can be changed with Setslidebody. + 6) To display all figures in the sub folder in folder "fig" %repeat=// - %para=subfig:{0}:s{60}{10}:input(:倍率)// - => layer{120}{0}, \putnotes{60}{10}{\input...} - 注)%repeat=,para=...と続けて書いてもよい. - -2. スライドの作成 - - 1)sample.cdyのスクリーンにTitle, Para, Slide のボタンがある. - - 2)Fheadは,図を作成するときのファイル名 + %para=subfig:{0}:s{60}{10}:input(:scale)// - 3)Slidenameは,スライドのファイル名 - .txt(内容),.tex , .pdf +2. Setting commands described in the cdy file. + Setslidemain([letterc,boxc,boxd,framec,xpos,size]); + Setslidepage([letterc,boxc,boxd,framec,shadowc,shadowd,xpos,size]); + Setslidebody(bodycolor,bodystyle,density); + Setslidehyper("dvipdfmx",["cl=true,lc=blue,fc=blue",90,70,1]); - 4)Slideworkで,作業フォルダを指定 - 注1)作業フォルダの中に自動的にfigというサブフォルダを作る. (新規の場合) - 注2)Dirworkはfigに設定されるので,図はfigの中に作られる. - 注3)slideボタンを押すと,Dirworkは一時的にworkになる. +3. Making flip animation - 5)タイトルの編集 - Settitle(name,cmdL,options); - options=["Layery=0","Color=blue"] - nameは省略可(デフォルトは "slide0") - - ・maintitleはcmdLの最初に書く(文字サイズ\Huge,他は\large) - - ・Titleボタンを押すとタイトル画面を作成して表示する. - - 6)各種設定 - Setslidemain([letterc,boxc,boxd,framec,xpos,size]); - メイン(章に該当)の設定 - 注)一部をデフォルト値とする場合は [,,]などとする. 以下同様 - Setslidepage([letterc,boxc,boxd,framec,shadowc,shadowd,xpos,size]); - ページの設定 - Setslidebody(bodycolor,bodystyle,density); - 全体の文字色と薄文字の濃さ(0-1)の設定 - bodystyleのデフォルトは "\Large\bf\boldmath" - Setslidehyper("dvipdfmx",["cl=true,lc=blue,fc=blue",90,70,1]); - hyperrefを利用する, - 注)Setslidehyper();とすると,hyperref.styを読み込み, - かつ,上のデフォルト値が与えられる. - 注)数字は,ページ移動ボタン列について,右端の水平位置,垂直サイズ,倍率 - - 7)パラパラ動画の作成 - ・mf(s)にパラメータ値sのときの図を記述する. - - ・パラパラの設定 + 1) Define Mf(s) the state at s. + 2) Add Setpara as Setpara(foldername,funcitonstr,range,options); - options=["m/r", "Div=25"]; - 注)rangeの記述 - i) "s=[0,1]" 区間をDivで分割 - ii) [0.2, 0.6] リストの要素をsに代入 - - ・ParaFボタンを押すと,フォルダ及びパラパラの図(複数)が生成される. - ・templateslide.txtに,1(7)のように記述する. - ・Slideボタンを押す. - - 8)animateを使うとき - (1)ParaFを作った後,Shift+"A"を押すとfigにanim+フォルダ名のファイルができる. - (2)Apppackage(["[dvipdfmx]{animate}"]を追加する. - (3)読み込み場所に,\inputを使って入れる. (layerは使えない) - (4)Setparaのオプション - "Frate="(1秒間のフレーム数), "Scale="(スケール倍率), "OpA=[loop]" - - 9)Slideボタンを押すと,スライド(PDF)が作成される. - - 10)Sum ボタンを押すと,概要PDF(各ページの最終ページのみ)が作成される. + options=["m/r", "Div=25"]; + 3) Press button Flip + 4) Describe in the .txt file as 1. 6). + 5) Press button Slide. + +4. Making animation. + + 1) Add in the .cdy file + Addpackage(["[dvipdfmx]{animate}"]); + 2) Add in the option of Setpara, + "Frate=num of frame in the second, "Scale=scale, "OpA=optin of animation" + 3) Define mf(s), Press button Anime. + 4) Use \input, not layer. diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/howtouseslideJ.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/howtouseslideJ.txt index 4a769848..440fefea 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/howtouseslideJ.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/howtouseslideJ.txt @@ -1,45 +1,48 @@ -ketslideによるプレゼンテーション  2017.09.28 +ketslideによるプレゼンテーション  2018.03.30 -0.スライドファイルの指定 +0.作成の流れ - 1)ketsample/s07slideのs0701basic.cdyを作業ディレクトリにコピーして名前を変更する. -    ここでは,作業ディレクトリ/ファイルを,ユーザホーム/Desktop/workにsample.cdyとする. - 2)s0701basic.txtも同様にコピして同名に変更する(sample.txt) - 3)sample.cdyをダブルクリックで立ち上げ,Cindyscript/figuresを以下のように修正する. -    2行目 Slidename=Fhead; -    5行目 Slidework(gethome()+"/Desktop/work"); -   11行目 タイトルに表示されるテキスト(自由に直してよい) - 4)右上の歯車マークを押す. + 1)ketsample/s07slideの中の2つのファイルを作業ディレクトリにコピーして名称変更 +    例)s0701basic.cdy , s0701basic.txt +    注)名称変更するときは,cdyとtxtを同名にする. +   ここでは,ファイル名をsample.cdyとsample.txtとする. + 2)sample.cdyをダブルクリックで立ち上げ,1を参考にSettitleの中身を修正する. +    注)Settitleのオプション(=の右はデフォルト値) +         ["Title=slide0","Layery=0","Color=blue"] + 3)右上の歯車マークを押す. + 4)画面上のTitleボタンを押す. +    タイトルスライドが作成され,画面が表示される. +    必要なら,Settitleを修正する. + 5)Slideボタンを押すと,sample.pdfが作成される. -1.sample.txtをテキストエディタで開き,修正する. - - 0)1行目(%のない最初の行)の基本形は -      タイトル(またはtitle)::slide0// -    注1)バックグラウンド(例えばkabegamiとする)を入れるとき -        ・kabegami.texを作成してfigフォルダに入れる. -        ・sample.txtの指定は -           タイトル::slide0::kabegami// -    注2)タイトル画面が不要の場合は, -        タイトル(またはtitle)::// +1.txtファイルの編集  1)すべての行の最後は必ず // をつける.     注)urlの指定で//を用いるとき,||||とすると//に変換される.  2)各ブロックの引数の区切りは ::  3)コマンド     ・タイトル::読込ファイル名(::壁紙ファイル)// -      最初のタイトルページ -       注)スライドに置く文字はslide0.cdyで作成 -       注)壁紙をつけるときは,もう1つ :: で区切ってファイル名を書く -       注)preambleに追加するとき,::区切りで書き加え,最後に//をおく. +       タイトルページを作成(1行目におく) +      注)壁紙(例えばwallpaperとする)を背景に入れるとき +        ・例えばwallpaper.texを作成してfigフォルダに入れる. +          (figにあるサンプルwallpaper.texを参照) +        ・sample.txtでの指定は +           タイトル::slide0::wallpaper// +        ・壁紙を一時的に外すときは +           タイトル::slide0::%wallpaper// +      注)preambleに追加するとき +         1行目の//を外す. +         次の行から,::区切りで書き加え,最後に//をおく. +      注)タイトル画面が不要の場合は, +         タイトル(またはtitle)::notitle// +    ・main::段落タイトル名//     ・new(::行下げ)::タイトル((::位置)::読み込みファイル)//       mainslide       例)new::[10]::最初に::{50}{20}::figure//       注)読み込みファイルのサイズ変更するとき          new::[10]::最初に::{50}{20}::figure,0.8//         他も同様 -    ・same(::行下げ)((::位置)::読込ファイル)// -      sameslide -    ・enumerate(::書式)// +    ・enumerate/       enumerate環境の始まり     ・itemize//       itemize環境の始まり @@ -50,8 +53,10 @@ ketslideによるプレゼンテーション  2017.09.28     ・putnote::方向と位置::読み込みファイル//       layer環境の中に図を入れる       例)putonote::se{30}{10}::figure( , 倍率)//(inputのとき) +          figの中のfigure.texを表示       例)putonote::se{30}{10}::include[width=5cm]::figure.pdf// -           (includegraphicsのとき) +          (includegraphicsのとき) +      注)図はすべてfigに入れる.     ・end//       enumerate,itemize,layer環境の終わり     ・上記以外// @@ -60,89 +65,68 @@ ketslideによるプレゼンテーション  2017.09.28  4)空白行を入れたいときは,...// とする. - 5)必要な図はすべてfigに入れる. - - 6)newの後,複数のスライドを同時に作り順に表示するとき, + 5)newの後,ページを段階的に表示するとき,    ・newの次の行に      %repeat=(newを含むスライドの枚数),para//    ・表示したいページは       %[2,-]::本文//     のように書く.      注)[2,- ]は2ページ以降全部 -       [-, 2,- ]は2ページまで表示 +       [-, 2]は2ページまで表示        [1..3,5 ]は1ページから3ページと5ページ    ・repeat=...の後に「,para」を追加するとリンクを作成 -   ・他のページで薄文字にしたいときは %thin[2]::本文 -     注1)薄文字の濃さのデフォルトは0.1だが,Setslidebodyで変更可能 -     注2)また,sample.txtに以下を記述すれば,その後が変わる. -         \setthin{濃さ}// +   ・指定以外のページで薄文字にしたいときは %thin[2]::本文 +     注)薄文字の濃さのデフォルトは0.1だが,Setslidebodyで変更可能 +     注)txtファイルに以下を記述すれば,以降の濃さが変わる. +          \setthin{濃さ}// - 7)figの中にあるサブフォルダ(例えばsubfig)の図ファイルすべてを順に表示するとき + 6)figの中にあるサブフォルダ(例えばsubfig)の図ファイルすべてを順に表示するとき    ・newの次の行に      %repeat=//      %para=subfig:{0}:s{60}{10}:input(:倍率)//        => layer{120}{0}, \putnotes{60}{10}{\input...}     注)%repeat=,para=...と続けて書いてもよい. +    注)一時的に無効にするときは,%%とする. -2.スライドの作成 - - 1)sample.cdyのスクリーンにTitle, Para, Slide のボタンがある. - - 2)Fheadは,図を作成するときのファイル名 - - 3)Slidenameは,スライドのファイル名 -     .txt(内容),.tex , .pdf - - 4)Slideworkで,作業フォルダを指定 -    注1)作業フォルダの中に自動的にfigというサブフォルダを作る.(新規の場合) -    注2)Dirworkはfigに設定されるので,図はfigの中に作られる. -    注3)slideボタンを押すと,Dirworkは一時的にworkになる. - - 5)タイトルの編集 -    Settitle(name,cmdL,options); -      options=["Layery=0","Color=blue"] -      nameは省略可(デフォルトは "slide0") +2.スライドの設定 -   ・maintitleはcmdLの最初に書く(文字サイズ\Huge,他は\large) - -   ・Titleボタンを押すとタイトル画面を作成して表示する. - - 6)各種設定 -    Setslidemain([letterc,boxc,boxd,framec,xpos,size]); -      メイン(章に該当)の設定 + 1)cdyのfigureに記述する. + 2)コマンド +   ・Setslidemain([letterc,boxc,boxd,framec,xpos,size]); +     メイン(段落区切り)の設定      注)一部をデフォルト値とする場合は [,,]などとする.以下同様 -    Setslidepage([letterc,boxc,boxd,framec,shadowc,shadowd,xpos,size]); -      ページの設定 -    Setslidebody(bodycolor,bodystyle,density); -      全体の文字色と薄文字の濃さ(0-1)の設定 -      bodystyleのデフォルトは "\Large\bf\boldmath" -    Setslidehyper("dvipdfmx",["cl=true,lc=blue,fc=blue",90,70,1]); -      hyperrefを利用する, +   ・Setslidepage([letterc,boxc,boxd,framec,shadowc,shadowd,xpos,size]); +     ページの設定 +   ・Setslidebody(bodycolor,bodystyle,density); +     全体の文字色と薄文字の濃さ(0-1)の設定 +     bodystyleのデフォルトは "\Large\bf\boldmath" +   ・Setslidehyper("dvipdfmx",["cl=true,lc=blue,fc=blue",90,70,1]); +     hyperrefを利用する,      注)Setslidehyper();とすると,hyperref.styを読み込み,       かつ,上のデフォルト値が与えられる.      注)数字は,ページ移動ボタン列について,右端の水平位置,垂直サイズ,倍率 - 7)パラパラ動画の作成 -   ・mf(s)にパラメータ値sのときの図を記述する. - -   ・パラパラの設定 -     Setpara(foldername,funcitonstr,range,options); -        options=["m/r", "Div=25"]; -     注)rangeの記述 -      i) "s=[0,1]" 区間をDivで分割 -      ii) [0.2, 0.6] リストの要素をsに代入 - -   ・ParaFボタンを押すと,フォルダ及びパラパラの図(複数)が生成される. -   ・templateslide.txtに,1(7)のように記述する. -   ・Slideボタンを押す. - - 8)animateを使うとき -    (1)ParaFを作った後,Shift+"A"を押すとfigにanim+フォルダ名のファイルができる. -    (2)Apppackage(["[dvipdfmx]{animate}"]を追加する. -    (3)読み込み場所に,\inputを使って入れる.(layerは使えない) -    (4)Setparaのオプション -        "Frate="(1秒間のフレーム数), "Scale="(スケール倍率), "OpA=[loop]" - - 9)Slideボタンを押すと,スライド(PDF)が作成される. - - 10)Sum ボタンを押すと,概要PDF(各ページの最終ページのみ)が作成される. +3.パラパラ動画の作成 + +  (1)mf(s)にパラメータ値sのときの図を記述する. +  (2)パラパラの設定 +    Setpara(foldername,funcitonstr,range,options); +       options=["m/r", "Div=25"]; +    注)rangeの記述 +     i) "s=[0,1]" 区間をDivで分割 +     ii) [0.2, 0.6] リストの各値をsに代入 +  (3)ParaFボタンを押すと,foldernameの中にパラパラの図が生成される. +  (4)txtファイルに,1の6)のように記述する. +  (5)Slideボタンを押す. + +4.animationの作成 + +   注)PathAdにAdobeReaderのデフォルトのパスが設定されている. +      println(PathAd)により,パスが確認できる. +     変更するときは,changesetting.txtにパスを記述する. +        PathAd="...."; +  (1)Addpackage(["[dvipdfmx]{animate}"]);を追加する. +  (2)Setparaのオプション +      "Frate="(1秒間のフレーム数), "Scale="(スケール倍率), "OpA=[loop]" +  (3)mf(s)を定義して,Animeボタンを押す. +  (4)読み込み場所に,\inputを使って入れる.(layerは使えない) diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basic.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basic.cdy index a4ea6af9..886b5bc0 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basic.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basic.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basic.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basic.txt index 6df4207e..9650b53c 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basic.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basic.txt @@ -1,6 +1,4 @@ -タイトル::slide0// -%%タイトル::slide0::kabegami// -%%title::// +タイトル::slide0::%wallpaper// %%%%%%%%%%%%%%%%// main::メインスライド1// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basicE.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basicE.cdy index 7a8d2b34..0025ed37 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basicE.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basicE.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basicE.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basicE.txt index f7f66133..a6c607e7 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basicE.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0701basicE.txt @@ -1,5 +1,4 @@ -title::slideE// -%%title::slide0::kabegami// +title::slide0::%wallpaper// %%%%%%%%%%%%%%%%// main::Main Slide// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graph.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graph.cdy index f7c1132a..6ce49ec7 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graph.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graph.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graph.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graph.txt deleted file mode 100644 index 577cf19f..00000000 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graph.txt +++ /dev/null @@ -1,20 +0,0 @@ -タイトル::slide0// -%%タイトル::slide0::kabegami// - -%%%%%%%%%%%%%%%%// -main::メインスライド1// - -%%%%%%%%%%%%%%%%// -new::inputとlayer// - -layer::{100}{0}// -putnote::se{10}{15}::figsin,0.8// -end// - -%%%%%%%%%%%%%%%%// -new::includegrpahicsとlayer// - -layer::{100}{0}// -putnote::s{60}{5} -::include[bb=0.00 0.00 803.00 285.00,width=100mm]::cindyscreen.pdf// -end// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graphE.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graphE.cdy index 7ce74d04..4b59de6c 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graphE.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graphE.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graphE.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graphE.txt index 95eeee29..295050c5 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graphE.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0702graphE.txt @@ -1,5 +1,4 @@ -title::slideE// -%%title::slideE::kabegami// +title::slideE::%wallpaper// %%%%%%%%%%%%%%%%// main::Main Slide// @@ -8,7 +7,7 @@ main::Main Slide// new::input and layer// layer::{100}{0}// -putnote::se{10}{15}::figsin,0.8// +putnote::s{65}{10}::figsin,1.2// end// %%%%%%%%%%%%%%%%// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeat.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeat.cdy index 63810d68..fa509952 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeat.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeat.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeat.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeat.txt index ad97f61e..3f29c04c 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeat.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeat.txt @@ -1,5 +1,5 @@ -%タイトル::slide0::kabegami// -タイトル::slide0// +タイトル::slide0::%wallpaper// + %%%%%%%%%%%%%%%%// main::メインスライド1// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeatE.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeatE.cdy index 942cc94e..1da10768 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeatE.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeatE.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeatE.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeatE.txt index 725cfc64..6ae811a1 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeatE.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0703repeatE.txt @@ -1,5 +1,4 @@ -%%title::slide0::kabegami// -title::slideE// +title::slideE::%wallpaper// %%%%%%%%%%%%%%%%// main::Main Slide// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0704thin.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0704thin.cdy index 722a7701..012e8971 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0704thin.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0704thin.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0704thin.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0704thin.txt index 254508a4..7c97865e 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0704thin.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0704thin.txt @@ -1,5 +1,4 @@ -%%タイトル::slide0::kabegami// -タイトル::slide0// +タイトル::slide0::%wallpaper/ %%%%%%%%%%%%%%%%// main::メインスライド1// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705para.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705para.cdy index c95af46c..ffc2f5de 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705para.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705para.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705para.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705para.txt deleted file mode 100644 index 0ecb2e6a..00000000 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705para.txt +++ /dev/null @@ -1,10 +0,0 @@ -%%タイトル::slide0::kabegami// -タイトル::slide0// - -%%%%%%%%%%%%%%%%// -new::parapara// -%repeat=,para=sinemove:{0}:s{65}{10}:input:1.2// - -%%%%%%%%%%%%%%%%// -%new::parapara2// -%%repeat=,para=sinemove2:{0}:s{65}{10}:input:1.2// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705paraE.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705paraE.cdy index 921f176b..2b898539 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705paraE.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705paraE.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705paraE.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705paraE.txt index 78a3017b..b3ff212a 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705paraE.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0705paraE.txt @@ -1,5 +1,4 @@ -%%title::slideE::kabegami// -title::slideE// +title::slideE::%wallpaperi// %%%%%%%%%%%%%%%%// new::parapara// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animate.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animate.cdy index 9121ad59..d87de868 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animate.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animate.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animate.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animate.txt index 7e23f324..3793cad5 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animate.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animate.txt @@ -1,5 +1,4 @@ -%%タイトル::slide0::kabegami// -タイトル::slide0// +タイトル::slide0::%wallpaper// %%%%%%%%%%%%%%%%// main::メインスライド1// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animateE.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animateE.cdy index b6b4a741..5cb1238a 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animateE.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animateE.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animateE.txt b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animateE.txt index f51f07c4..c0c98564 100644 --- a/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animateE.txt +++ b/texmf-dist/doc/support/ketcindy/ketsample/samples/s07slides/s0706animateE.txt @@ -1,5 +1,4 @@ -%%タイトル::slideE::kabegami// -タイトル::slideE// +Title::slideE::%wallpaper// %%%%%%%%%%%%%%%%// main::Main Slide// diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0801plotR.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0801plotR.cdy index 5bb212a8..b0040070 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0801plotR.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0801plotR.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0802plotR2.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0802plotR2.cdy index f1a84f15..54148975 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0802plotR2.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0802plotR2.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0803boxplot.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0803boxplot.cdy index d5bb0ff9..cc97d6e8 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0803boxplot.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0803boxplot.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0804histplot.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0804histplot.cdy index e67e8645..06eb56d7 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0804histplot.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0804histplot.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0805random.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0805random.cdy index 35aec7d3..b6b70134 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0805random.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0805random.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0806dataframe.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0806dataframe.cdy index 94755621..70cc8213 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0806dataframe.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0806dataframe.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0807timecount.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0807timecount.cdy index a73a3ac9..88f2cc3b 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0807timecount.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0807timecount.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0808ttest.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0808ttest.cdy index 1d9dfdbe..c6260d13 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0808ttest.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s08R/s0808ttest.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0901parabolic.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0901parabolic.cdy deleted file mode 100644 index bda83e0a..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0901parabolic.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0902cone.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0902cone.cdy deleted file mode 100644 index 6052150b..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0902cone.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0903saddle.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0903saddle.cdy deleted file mode 100644 index b29bc733..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0903saddle.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0904sphere.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0904sphere.cdy deleted file mode 100644 index 37267bcb..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0904sphere.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0905wireframe.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0905wireframe.cdy deleted file mode 100644 index e74d0a5a..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0905wireframe.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0906intersectcrvsf.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0906intersectcrvsf.cdy deleted file mode 100644 index d912d2cb..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0906intersectcrvsf.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0907multisurfaces.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0907multisurfaces.cdy deleted file mode 100644 index 31484243..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0907multisurfaces.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0908conecut.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0908conecut.cdy deleted file mode 100644 index f4428884..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0908conecut.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0909totaldiff.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0909totaldiff.cdy deleted file mode 100644 index 9c8e7c27..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface(Scilab)/s0909totaldiff.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0901paraboloid.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0901paraboloid.cdy new file mode 100644 index 00000000..88fdaf1c Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0901paraboloid.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0902cone.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0902cone.cdy new file mode 100644 index 00000000..17f96400 Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0902cone.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0903saddle.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0903saddle.cdy new file mode 100644 index 00000000..6279bf88 Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0903saddle.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0904mant.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0904mant.cdy new file mode 100644 index 00000000..e209bfa5 Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0904mant.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0905sphere.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0905sphere.cdy new file mode 100644 index 00000000..3f4d4ca4 Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0905sphere.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0906curveonsurf.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0906curveonsurf.cdy new file mode 100644 index 00000000..16a413ca Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0906curveonsurf.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0907intersectcrvsf.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0907intersectcrvsf.cdy new file mode 100644 index 00000000..40b54a57 Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0907intersectcrvsf.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0908multisurfaces.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0908multisurfaces.cdy new file mode 100644 index 00000000..d078a6d8 Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0908multisurfaces.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0909wiredata.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0909wiredata.cdy new file mode 100644 index 00000000..f412eadc Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0909wiredata.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0910conecut.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0910conecut.cdy new file mode 100644 index 00000000..275819e9 Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0910conecut.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0921totaldiffskeleton.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0921totaldiffskeleton.cdy new file mode 100644 index 00000000..f45a3fbc Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0921totaldiffskeleton.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0922conecutmaxima.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0922conecutmaxima.cdy new file mode 100644 index 00000000..43140179 Binary files /dev/null and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s09surface/s0922conecutmaxima.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s10maxima/s1010fourier3.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s10maxima/s1010fourier3.cdy index 60cda41e..f096d6ed 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s10maxima/s1010fourier3.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s10maxima/s1010fourier3.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1301basic.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1301basic.cdy deleted file mode 100644 index d5920bfb..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1301basic.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1303objparts.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1303objparts.cdy deleted file mode 100644 index 8e814c19..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1303objparts.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1304symbol.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1304symbol.cdy deleted file mode 100644 index 2a35c863..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1304symbol.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1305hyperpara.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1305hyperpara.cdy deleted file mode 100644 index 1c083c57..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1305hyperpara.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1306poly.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1306poly.cdy deleted file mode 100644 index 38116f6e..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1306poly.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1307poly2.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1307poly2.cdy deleted file mode 100644 index 6d9e518f..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1307poly2.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1308discont.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1308discont.cdy deleted file mode 100644 index 06e7b27c..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1308discont.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1309discont2.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1309discont2.cdy deleted file mode 100644 index b70e5ed4..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1309discont2.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1310totaldiff.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1310totaldiff.cdy deleted file mode 100644 index ef05f3fb..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1310totaldiff.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1311plate.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1311plate.cdy deleted file mode 100644 index 2b8d3b44..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1311plate.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1312plane.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1312plane.cdy deleted file mode 100644 index 4fa2eaff..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1312plane.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1313changescale.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1313changescale.cdy deleted file mode 100644 index 3f2e4da3..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1313changescale.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1314knot.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1314knot.cdy deleted file mode 100644 index 7822bcaf..00000000 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s13meshlab/Meshlab(Scilab)/s1314knot.cdy and /dev/null differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s14dataprocessing/kc.sh b/texmf-dist/doc/support/ketcindy/ketsample/samples/s14dataprocessing/kc.sh deleted file mode 100644 index e69de29b..00000000 diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1501mant.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1501mant.cdy index 11ca4df6..59bfc5cf 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1501mant.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1501mant.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1502torus.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1502torus.cdy index 0722cc97..ec9a5966 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1502torus.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1502torus.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1503parabola.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1503parabola.cdy index 0b0c75aa..5b45f933 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1503parabola.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1503parabola.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1504conecut.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1504conecut.cdy index 86e422aa..43fe8655 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1504conecut.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1504conecut.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1505skeleton.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1505skeleton.cdy index 09cea9cf..0497a177 100644 Binary files a/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1505skeleton.cdy and b/texmf-dist/doc/support/ketcindy/ketsample/samples/s15C/s1505skeleton.cdy differ diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samplesJS/js01basic.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samplesJS/js01basic.cdy old mode 100644 new mode 100755 diff --git a/texmf-dist/doc/support/ketcindy/ketsample/samplesJS/js03gamow.cdy b/texmf-dist/doc/support/ketcindy/ketsample/samplesJS/js03gamow.cdy old mode 100644 new mode 100755 diff --git a/texmf-dist/doc/support/ketcindy/source/ketjava/KetCindyPlugin.java b/texmf-dist/doc/support/ketcindy/source/ketjava/KetCindyPlugin.java index 3e7d6312..6f4389a2 100644 --- a/texmf-dist/doc/support/ketcindy/source/ketjava/KetCindyPlugin.java +++ b/texmf-dist/doc/support/ketcindy/source/ketjava/KetCindyPlugin.java @@ -13,7 +13,7 @@ public class KetCindyPlugin extends CindyScriptPlugin { @CindyScript("ketjavaversion") public String ketjavaversion() { - return "Ketjava 2017.11.08"; + return "Ketjava 20180405"; } public String getName() { @@ -39,9 +39,15 @@ public class KetCindyPlugin extends CindyScriptPlugin { return (c.getBlue() + c.getRed() + c.getGreen()) / 3.; } - @CindyScript("testarray") - public String writeArray(ArrayList al) { - return Arrays.toString(al.toArray()); + @CindyScript("isincludefull")//180331 + public static boolean isincludefull(String str){ + char[] chars = str.toCharArray(); + for (int i = 0; i < chars.length; i++) { + if (String.valueOf(chars[i]).getBytes().length==2) { + return true; + } + } + return false; } @CindyScript("getdir") @@ -61,7 +67,7 @@ public class KetCindyPlugin extends CindyScriptPlugin { } @CindyScript("iswindows") - static public boolean iswindows(){ + public static boolean iswindows(){ String os=System.getProperty("os.name").toLowerCase(); if(os!=null && os.startsWith("windows")){ return true; @@ -70,6 +76,7 @@ public class KetCindyPlugin extends CindyScriptPlugin { return false; } } + @CindyScript("ismacosx") public static boolean ismacosx(){ String os=System.getProperty("os.name").toLowerCase(); @@ -102,6 +109,46 @@ public class KetCindyPlugin extends CindyScriptPlugin { return "Improper call"; } + @CindyScript("nkfwin") //180401 + public static int nkfwin(String dir,String fname,String ext) throws IOException { + String src=dir+File.separator+fname+"."+ext; + String out=dir+File.separator+fname+".out"; + ProcessBuilder pb = new ProcessBuilder(); + pb.command("cmd","/c",File.separator+"nkf32","<"+src,">"+out); + Process process = pb.start(); + return 0; + } + + @CindyScript("nkfcpdel") //180401 + public static int nkfcpdel(String dir,String fname,String ext) throws IOException { + String src=dir+File.separator+fname+"."+ext; + String out=dir+File.separator+fname+".out"; + ProcessBuilder pb = new ProcessBuilder(); + pb.command("cmd","/c","copy","/Y",out,src,"|","del",out); + Process process = pb.start(); + return 0; + } + + @CindyScript("nkfdelout") //180401 + public static int nkfdelout(String dir,String fname) throws IOException { + String out=dir+File.separator+fname+".out"; + ProcessBuilder pb = new ProcessBuilder(); + pb.command("cmd","/c","del",out); + Process process = pb.start(); + return 0; + } + + @CindyScript("nkfren") //180401 + public static int nkfren(String dir,String fname,String ext) throws IOException { + String src=fname+"."+ext; + String out=dir+File.separator+fname+".out"; + ProcessBuilder pb = new ProcessBuilder(); + pb.command("cmd","/c","ren",out,src); + Process process = pb.start(); +// int ret = process.waitFor(); + return 0; + } + @CindyScript("kc") public static String kc(String args,String args2,String args3) throws IOException { ProcessBuilder pb = new ProcessBuilder(); @@ -200,7 +247,12 @@ public class KetCindyPlugin extends CindyScriptPlugin { } if(flg==0){ if(iswindows()){ - pb.command("cmd.exe","/c","start",args); + if((args.indexOf(" ")==-1)&&(args.indexOf("-")==-1) + &&(args.indexOf(" ")==-1)){ //180405 + pb.command("cmd.exe","/c","start",args); + }else{ + pb.command("cmd.exe","/c","","\""+args+"\"");//180331to + } } else{ if(ismacosx()){ @@ -314,6 +366,14 @@ public class KetCindyPlugin extends CindyScriptPlugin { return false; } } + + @CindyScript("filepath") + // 18.03.29 + public static String isexists(String fname){ + File file = new File(fname); + String path = file.getAbsolutePath(); + return path; + } @CindyScript("makedir") // 17.09.06 diff --git a/texmf-dist/scripts/ketcindy/LICENSE.txt b/texmf-dist/scripts/ketcindy/LICENSE.txt new file mode 100644 index 00000000..505587ff --- /dev/null +++ b/texmf-dist/scripts/ketcindy/LICENSE.txt @@ -0,0 +1,14 @@ +// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team +// +//This program is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation; either version 3 of the License, or +// (at your option) any later version. +// +// This program is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see diff --git a/texmf-dist/scripts/ketcindy/dirhead.txt b/texmf-dist/scripts/ketcindy/dirhead.txt new file mode 100644 index 00000000..e87a8005 --- /dev/null +++ b/texmf-dist/scripts/ketcindy/dirhead.txt @@ -0,0 +1,7 @@ +Dirhead=Dircdy; +Dirwork=gethome()+pathsep()+"ketcindy"; +Dircdy=Dirwork; +setdirectory(Dirhead); +import("setketcindy.txt"); +import("ketoutset.txt"); +setdirectory(Dirwork); diff --git a/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar b/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar index ad013a20..044a36a7 100644 Binary files a/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar and b/texmf-dist/scripts/ketcindy/ketjava/KetCindyPlugin.jar differ diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt index 5afce0d3..55b2fc71 100644 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt +++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dlogr.txt @@ -1,3 +1,25 @@ +// 2018.03.27 +// Start3d changed (for C) +// 2018.02.27 +// Sfbdpara,... changed ("Res=" made from fname) +// 2018.02.26 +// Sfcutparadata (renamed from Sfcutdata) changed +// 2018.02.24 +// Sfcutdata added +// 2018.02.23 +// Crvonsfparadata added +// Wireparadata added +// Skeletonparadata rechanged to old version +// 2018.02.22 +// Intersectcrvsf added (changed to R) +// Sdbdpradata,Crvsfparadata,Intersectcrvsf changed (title printing) +// 2018.02.20 +// Addpoints added +// PthiddenQ,Meetpoints debugged +// 2018.02.18 +// Sfbdparadata debuggded (OTHERPARTITION ) +// 2018.02.11 +// Sfbdparadata added // 2018.01.04 // Skeletonparadata(Skeletondatacindy) majorly changed // 2017.10.23 diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs index 1b6f69e1..ce7a65f1 100644 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs +++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylib3dr.cs @@ -14,7 +14,7 @@ // along with this program. If not, see // -println("ketcindylib3d(2018.01.05) loaded"); +println("ketcindylib3d(20180327) loaded"); //help:start(); @@ -79,12 +79,15 @@ Ketinit3d(subflg,position):=( ErrFlg=0; ); -Start3d():=Start3d([]); //16.11.12 -Start3d(ptexception):=( //16.11.12 +Start3d():=Start3d([]); +Start3d(ptexception):=( //help:Start3d(); //help:Start3d(execptionptlist); regional(xmn,xMx,ymn,yMx,pt,pt3,pt2, xPos,yTh,yPh,Eps,tmp,tmp1,tmp2,tmp3,tmp4); + ConstantListC=[[50,50],[5000,1500,500,200],[0.00001,0.01,0.1]]; + FuncListC=[]; + CommandListC=[]; GCLIST=[]; GLIST=[]; FUNLIST=[]; @@ -97,7 +100,7 @@ Start3d(ptexception):=( //16.11.12 ErrFlag=0; OBJCMD=[]; // 16.11.29from OCNAME=Fhead; - OCOPTION=["m","v"];// 16.11.29upto + OCOPTION=["m","v"];// 16.11.29until ArrowlineNumber=1; // 16.01.31 ArrowheadNumber=1; BezierNumber=1; //16.01.31 @@ -124,7 +127,7 @@ Start3d(ptexception):=( //16.11.12 +format((FI.x-xPos)*40,5)+")"; GLIST=append(GLIST,tmp); THETA=(TH.x-xPos)*20*pi/180; - PHI=(FI.x-xPos)*40*pi/180; // 16.06.20upto + PHI=(FI.x-xPos)*40*pi/180; // 16.06.20until if(isselected(TH) % isselected(FI), // 17.05.18from if(length(Ch)>0, ChNum=Ch_(length(Ch)); @@ -133,7 +136,7 @@ Start3d(ptexception):=( //16.11.12 ChNum=1; ); Ch=[0]; - );// 17.05.18upto + );// 17.05.18until if(length(VLIST)==0, // 16.06.20 tmp=remove(allpoints(),[NE,SW,TH,FI,O,X,Y,Z]);//17.06.02 tmp4=remove(tmp,ptexception); @@ -145,7 +148,7 @@ Start3d(ptexception):=( //16.11.12 pt3=Xyzcoord(pt.x,pt.y,tmp); Defvar(tmp1+"3d",pt3); pt2=Parapt(pt3); // 16.05.28from - Defvar(tmp1+"2d",pt2); // 16.05.28upto + Defvar(tmp1+"2d",pt2); // 16.05.28until ); ); , @@ -199,7 +202,7 @@ Start3d(ptexception):=( //16.11.12 shadowc=[0,0,0,0.5]; mboxc="yellow"; //17.03.02 regional debugged SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, letterc,mboxc,mboxc,mboxc,62,2,letterc]; - ThinDense=0.1; //17.07.01upto + ThinDense=0.1; //17.07.01until Ptseg3data(ptexception); //16.08.23 ); @@ -231,7 +234,7 @@ Setangle(theta,phi):=( //16.12.24 pt3=Xyzcoord(pt.x,pt.y,tmp); Defvar(tmp1+"3d",pt3); pt2=Parapt(pt3); // 16.05.28from - Defvar(tmp1+"2d",pt2); // 16.05.28upto + Defvar(tmp1+"2d",pt2); // 16.05.28until ); ); , @@ -554,7 +557,7 @@ Spaceline(Arg1,Arg2):=( name="-"+replace(tmp,",",""); Spaceline(name,Arg1,Arg2); ); -); // 16.02.22 upto +); // 16.02.22 until Spaceline(nm,ptlistorg,optionorg):=( //help:Spaceline("1",[[2,5,1],[4,2,3]]); //help:Spaceline([A,B]); @@ -609,7 +612,7 @@ Spaceline(nm,ptlistorg,optionorg):=( ); ); tmp=substring(tmp,0,length(tmp)-1)+"]"; - tmp=name3+"=Spaceline("+tmp+")"; //17.07.13upto + tmp=name3+"=Spaceline("+tmp+")"; //17.07.13until // tmp=name3+"=Spaceline("+textformat(ptlist,5)+")"; //17.05.24 GLIST=append(GLIST,tmp); tmp=name2+"=Projpara("+name3+")"; @@ -962,7 +965,7 @@ Xyzax3data(nm,Xrange,Yrange,Zrange,options):=( ); ); ); - ); // 16.08.14upto + ); // 16.08.14until tmp1=indexof(Xrange,"="); tmp=parse(substring(Xrange,tmp1,length(Xrange))); Px=[tmp_1,0,0]; Qx=[tmp_2,0,0]; @@ -1008,7 +1011,7 @@ Xyzax3data(nm,Xrange,Yrange,Zrange,options):=( if(length(Origin)>0, Letter([Parapt([0,0,0]),Origin,"O"]); ); - ); // 16.08.14upto + ); // 16.08.14until if(SUBSCR==1, // 15.02.11 Subgraph(name3,opcindy); ); @@ -1722,11 +1725,11 @@ Putpoint3d(Arg1,Arg2,Arg3):=( ptslist=Arg1; fixstr=Arg2; ); - if(islist(fixstr),fixstr=fixstr_1);// 16.03.02 upto + if(islist(fixstr),fixstr=fixstr_1);// 16.03.02 until nn=length(ptslist)/2; forall(1..nn,kk, // 16.08.19from tmp1=ptslist_(2*kk-1); - pt3=ptslist_(2*kk); // 16.08.19upto + pt3=ptslist_(2*kk); // 16.08.19until VLIST=select(VLIST,#_1!=tmp1+"3d"); tmp2=parse(tmp1); if(ispoint(tmp2), // 16.05.26from @@ -1740,7 +1743,7 @@ Putpoint3d(Arg1,Arg2,Arg3):=( Defvar(tmp1+"3d",tmp); , Defvar(tmp1+"3d",pt3); - ); // 16.05.26upto + ); // 16.05.26until Defvar(tmp1+"fix",0); pt=Parapt(pt3); Putpoint(tmp1,pt,parse(tmp1+".xy")); @@ -1898,7 +1901,7 @@ Putaxes3d(size):=( Putpoint3d(["Y",[0,sL_2,0]],"fix"); Putpoint3d(["Z",[0,0,sL_3]],"fix"); // Fixpoint3d(["O",[0,0,0]]); -// Fixpoint3d(["X",[sL_1,0,0],"Y",[0,sL_2,0],"Z",[0,0,sL_3]]);//17.06.02fupto +// Fixpoint3d(["X",[sL_1,0,0],"Y",[0,sL_2,0],"Z",[0,0,sL_3]]);//17.06.02funtil ); IntersectsgpL(name,sgstr,pLstr):= @@ -2103,7 +2106,7 @@ Putbezier3data(name,pt3Lorg,options):=( // 17.10.08 greatly changed , tmp1=name+numstr+"p"; tmp2=(pt3L_(nn-1)+pt3L_nn)/2; - VLIST=select(VLIST,#_1!=tmp1+"3d"); // 16.08.19upto + VLIST=select(VLIST,#_1!=tmp1+"3d"); // 16.08.19until Putpoint3d([tmp1,tmp2]); ctrpts=append(ctrpts,tmp1); ); @@ -2329,7 +2332,7 @@ Concatobj(objL,options):=( ); ); vL=concat(vL,vadd); - fL=concat(fL,fnew); // 16.02.11 upto + fL=concat(fL,fnew); // 16.02.11 until ); tmp2=apply(1..length(fL),1); if(rmf=="y", @@ -2397,7 +2400,7 @@ VertexEdgeFace(nm,vfnLorg,optionorg):=( ); if(length(vfnL)==1, vfnL=[vfnL_1,[1..length(vfnL_1)]]; - ); // 16.06.19upto + ); // 16.06.19until tmp=Divoptions(options); Noflg=tmp_2; eqL=tmp_5; @@ -2439,7 +2442,7 @@ VertexEdgeFace(nm,vfnLorg,optionorg):=( Putpoint3d(["v"+text(#),vtx],"fix"); ); ); - vL=append(vL,vname); // 16.02.10 upto + vL=append(vL,vname); // 16.02.10 until ); eL=[]; forall(vfnL_2,face, @@ -2590,7 +2593,7 @@ Phparadata(nm,nmvf,vfL,options):=( tmp2=tmp2+text(#)+","; ); tmp2=substring(tmp2,0,length(tmp2)-1)+")"; - ); // 2015.05.27 upto + ); // 2015.05.27 until tmp=name3+"=Phparadata("+tmp1+","+tmp2+opstr+")"; GLIST=append(GLIST,tmp); tmp=name2+"=Projpara("+name3+")"; @@ -2844,7 +2847,7 @@ Nohiddenbyfaces(nm,segstr,facestr,optionorg,optionsh):=( ); ); segL=tmp2; - Changestyle3d(segL,["nodisp"]); // 16.02.29 upto + Changestyle3d(segL,["nodisp"]); // 16.02.29 until if(islist(segL), if(isstring(segL_1), segL=apply(segL,parse(#)); @@ -2857,14 +2860,14 @@ Nohiddenbyfaces(nm,segstr,facestr,optionorg,optionsh):=( faceL=parse(facestr); tmp=replace(facestr,"phf","phv"); // 16.02.10 from tmp=parse(tmp); - vtxL=apply(tmp,replace(#,"3d","")); // 16.02.10 upto + vtxL=apply(tmp,replace(#,"3d","")); // 16.02.10 until flg=1; , faceL=parse(facestr); ); ); if(flg==0, - if(length(faceL)==2, // 16.08.19upto + if(length(faceL)==2, // 16.08.19until vtxL=facestr_1; faceL=facestr_2; , @@ -3220,22 +3223,23 @@ Sfbdparadata(nm,fd,options):= Sfbdparadata(nm,fd,options,["nodisp"]); Sfbdparadata(nm,fdorg,optionorg,optionsh):=( //help:Sfbdparadata("1",Fd); -//help:Sfbdparadata(options2=["Wait=30",limit1([0.05,1], limit2(0.2)]); +//help:Sfbdparadata(options2=["Wait=60",division(c(50,50)),Eps1(c(0.01,1)), Eps2(0.05)]); regional(fd,options,name2,name3,name2h,name3h,waiting, - eqL,reL,strL,fname,outreg,tmp,tmp1,tmp2,flg,wflg); + eqL,reL,strL,fname,tmp,tmp1,tmp2,flg,wflg); name2="sfbd2d"+nm; name3="sfbd3d"+nm; name2h="sfbdh2d"+nm; name3h="sfbdh3d"+nm; fname=Fhead+"sfbd"+nm+".txt"; - fd=apply(fdorg,if(isstring(#),"'"+#+"'",#)); + tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#)); + tmp=text(tmp); + fd=RSform(tmp,2); options=optionorg; tmp=Divoptions(options); eqL=tmp_5; reL=tmp_6; strL=tmp_7; - waiting=30; - outreg=0; // 16.08.20 + waiting=120; forall(eqL, tmp=indexof(#,"="); tmp1=Toupper(substring(#,0,1)); @@ -3244,11 +3248,6 @@ Sfbdparadata(nm,fdorg,optionorg,optionsh):=( waiting=parse(tmp2); options=remove(options,[#]); ); -// if(tmp1=="O", // 16.08.20 -// tmp=Toupper(substring(tmp2,0,1)); -// if(tmp=="T" % tmp=="Y", outreg=1,outreg=0); -// options=remove(options,[#]); -// ); ); options=remove(options,reL); wflg=0; @@ -3263,55 +3262,38 @@ Sfbdparadata(nm,fdorg,optionorg,optionsh):=( options=remove(options,[#]); ); ); - cmdL=MkprecommandS(5); // 16.02.01 - tmp=[ - Dq+fname+Dq, - Dq+name3+Dq,name3, - Dq+name2+Dq,name2, - Dq+name3h+Dq,name3h, - Dq+name2h+Dq,name2h, - Dq+"HIDDENDATA"+Dq,"HIDDENDATA", // 16.08.20from - Dq+"PARTITIONPT"+Dq,"PARTITIONPT", - Dq+"OTHERPARTITION"+Dq,"OTHERPARTITION" // 16.08.20upto - ]; - fd=apply(fd,replace(#,"_1","(1)")); // 16.05.25from - fd=apply(fd,replace(#,"_2","(2)")); - fd=apply(fd,replace(#,"_3","(3)")); // 16.05.25upto - cmdL=concat(cmdL,[ - name3+"=Sfbdparadata",concat([fd,"Error"],reL), + tmp=["fd"+nm]; + if(length(reL)>0, + reL=textformat(reL,4); + reL=substring(reL,1,length(reL)-1); + reL=Rsform(reL); + tmp=append(tmp,reL); + ); + tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2]; + tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]); +// tmp1=concat(tmp1,[Dqq("CUSPPT"),"CUSPPT"]); +// tmp1=concat(tmp1,[Dqq("OTHERPARTITION"),"OTHERPARTITION"]); + tmp2=replace(fname,".txt",".dat"); //18.02.18 + cmdL=[ + "print",[Dqq("fd"+nm)], //18.02.22 + "fd"+nm+"="+fd,[], + name3+"=Sfbdparadata",tmp, name2+"=Projpara",[name3], - name3h+"=BorderHiddenData()",[], + name3h+"=HIDDENDATA",[], name2h+"=Projpara",[name3h], - "function Ot=Hiddend(),global HIDDENDATA,Ot=HIDDENDATA,endfunction)" - ,[], // 16.08.20from - "function Ot=Otherp(),global OTHERPARTITION,Ot=OTHERPARTITION,endfunction)" - ,[], - "HIDDENDATA=Hiddend()",[], - "PARTITIONPT=PartitionPt()",[], - "OTHERPARTITION=Otherp()",[], - "for J=1:length(OTHERPARTITION)",[], - " Tmp1=OTHERPARTITION(J)",[], - " Tmp2=[]",[], - " for K=1:length(Tmp1)",[], - " Tmp2=[Tmp2;Tmp1(K),1000]",[], - " end",[], - " OTHERPARTITION(J)=Tmp2",[], - "end",[], - "WriteOutData",tmp - ]); - options=append(options,"Wait="+text(waiting)); - if(wflg==1,options=concat(options,["m"])); // 16.08.20 - if(wflg==-1,options=concat(options,["r"])); + "WriteOutData",tmp1, + "save",["CUSPPT","OTHERPARTITION","file='"+tmp2+"'"] + ]; + tmp=replace(fname,".txt","end.txt"); + options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); + if(wflg==1,options=append(options,"m")); + if(wflg==-1,options=append(options,"r")); if(ErrFlag==0, - CalcbyS("sfbd"+nm,cmdL,options); + CalcbyR("sfbd"+nm,cmdL,options); ); if(ErrFlag==1, err("Sfbdparadata not completed"); , - if(outreg==1, - OutFileList=remove(OutFileList,[fname]); - OutFileList=append(OutFileList,fname); - ); ReadOutData(fname); if(islist(parse(name2)), Extractdata(name2,options); @@ -3323,32 +3305,48 @@ Sfbdparadata(nm,fdorg,optionorg,optionsh):=( ); ); -Wireparadata(nm,out,wr1,wr2,fd):= - Wireparadata(nm,out,fd,wr1,wr2,[],["nodisp"]); -Wireparadata(nm,out,fd,wr1,wr2,options):= - Wireparadata(nm,out,fd,wr1,wr2,options,["nodisp"]); -Wireparadata(nm,outstr,fdorg,wr1,wr2,optionorg,optionsh):=( +Addpoints():=(//18.02.20 + if(isstring(ADDPOINT), + ADDPOINT; + , + "list()"; + ); +); +Addpoints(ptlist):=( +//help:Addpoints(list of 3d points); + if(length(ptlist)==0, + ADDPOINT="list()"; + , + ADDPOINT=Rsform(textformat(ptlist,6),2); + ); + ADDPOINT; +); + +Wireparadata(nm,sf,wr1,wr2,fd):= + Wireparadata(nm,sf,fd,wr1,wr2,[],["nodisp"]); +Wireparadata(nm,sf,fd,wr1,wr2,options):= + Wireparadata(nm,sf,fd,wr1,wr2,options,["nodisp"]); +Wireparadata(nm,sfstr,fdorg,wr1,wr2,optionorg,optionsh):=( //help:Wireparadata("1","sfbd3d1",fd,5,5); -//help:Wireparadata(options2=["Wait=40"]); - regional(out,fd,options,name2,name3,name2h,name3h,outreg, - eqL,reL,strL,fname,outfname,waiting,tmp,tmp1,tmp2,flg,wflg); +//help:Wireparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]); + regional(fd,options,name2,name3,name2h,name3h,outreg, + eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,flg,wflg); name2="wire2d"+nm; name3="wiref3d"+nm; name2h="wireh2d"+nm; name3h="wireh3d"+nm; fname=Fhead+"wire"+nm+".txt"; - tmp=replace(outstr,"3d",""); - outfname=Fhead+tmp+".txt"; // 16.08.20 - out=parse(outstr); - if(!islist(out), ErrFlag=1); - fd=apply(fdorg,if(isstring(#),"'"+#+"'",#)); + rfname=Fhead+sfstr+".txt"; + rfname=replace(rfname,"3d",""); + tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#)); + tmp=text(tmp); + fd=RSform(tmp,2); options=optionorg; tmp=Divoptions(options); eqL=tmp_5; reL=tmp_6; strL=tmp_7; - waiting=40; - outreg=0; + waiting=600; forall(eqL, tmp=indexof(#,"="); tmp1=Toupper(substring(#,0,1)); @@ -3357,11 +3355,6 @@ Wireparadata(nm,outstr,fdorg,wr1,wr2,optionorg,optionsh):=( waiting=parse(tmp2); options=remove(options,[#]); ); -// if(tmp1=="O", // 16.08.20from -// tmp=Toupper(substring(tmp2,0,1)); -// if(tmp=="T" % tmp=="Y", outreg=1,outreg=0); -// options=remove(options,[#]); -// );// 16.08.20upto ); options=remove(options,reL); wflg=0; @@ -3376,117 +3369,82 @@ Wireparadata(nm,outstr,fdorg,wr1,wr2,optionorg,optionsh):=( options=remove(options,[#]); ); ); - flg=0; - tmp1=floor(5*1000/WaitUnit); - repeat(tmp1, - if(flg==0, - tmp=load(Fhead+replace(outstr,"3d","")+".txt"); - if(length(tmp)>=4, - tmp2=substring(tmp,length(tmp)-4,length(tmp)); - if(tmp2=="////", - flg=1; - ); - , - wait(WaitUnit); - ); - ); - ); - if(flg==0, - Err(outstr+" file not copleted"); - ErrFlag=1; - ); - if(ErrFlag==0, -// Writeoutdata(outfname,["Out",out]); - ); - cmdL=MkprecommandS(5); // 16.02.01 - tmp=[ - Dq+fname+Dq, - Dq+name3+Dq,name3, - Dq+name2+Dq,name2, - Dq+name3h+Dq,name3h, - Dq+name2h+Dq,name2h - ]; - fd=apply(fd,if(isstring(#),replace(#,"_1","(1)"),#)); // 16.05.25 08.17from - fd=apply(fd,if(isstring(#),replace(#,"_2","(2)"),#)); - fd=apply(fd,if(isstring(#),replace(#,"_3","(3)"),#)); // 16.05.25 08.17upto - cmdL=concat(cmdL,[ - "disp('Running Wireparadata')",[], - "tmp=ReadOutData",[Dq+outfname+Dq], - "execstr(tmp)",[], - "function SetHidd(Dt),global HIDDENDATA,HIDDENDATA=Dt,endfunction)", - [], // 16.08.20from - "function SetPart(Dt),global PARTITIONPT,PARTITIONPT=Dt,endfunction)", - [], - "function SetOther(Dt),global OTHERPARTITION,OTHERPARTITION=Dt,endfunction)", - [], - "if type(HIDDENDATA)~=15,HIDDENDATA=list(HIDDENDATA),end",[], - "if type(PARTITIONPT)~=15,PARTITIONPT=list(PARTITIONPT),end",[], - "if type(OTHERPARTITION)~=15,OTHERPARTITION=list(OTHERPARTITION),end",[], - "for J=1:length(OTHERPARTITION)",[], - " Tmp=OTHERPARTITION(J)",[], - " OTHERPARTITION(J)=Tmp(:,1)",[], - "end",[], - "SetHidd(HIDDENDATA)",[], - "SetPart(PARTITIONPT)",[], - "SetOther(OTHERPARTITION)",[], - "if type("+outstr+")~=15,"+outstr+"=list("+outstr+"),end",[], // 16.08.20upto - name3+"=Wireparadata",concat([outstr,fd,wr1,wr2,"Error"],reL), + tmp1=textformat(wr1,6); + tmp1=Rsform(tmp1,1); + tmp2=textformat(wr2,6); + tmp2=Rsform(tmp2,1); + tmp=[sfstr,"fd"+nm,tmp1,tmp2]; + reL=RSform(text(reL),2); + reL=substring(reL,5,length(reL)-1); + if(length(reL)>0, + reL=textformat(reL,4); + reL=substring(reL,1,length(reL)-1); + reL=Rsform(reL); + tmp=append(tmp,reL); + ); + tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2]; + tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]); + tmp2=replace(rfname,".txt",".dat"); + cmdL=[ + "print",[Dqq("wire"+nm)], //18.02.22 + "fd"+nm+"="+fd,[], + "ReadOutData",[Dqq(rfname)], + "load",[Dqq(tmp2)], + "Addpoints",[Addpoints()], + name3+"=Wireparadata",tmp, name2+"=Projpara",[name3], - name3h+"=WireHiddenData()",[], + name3h+"=WIREHIDDENDATA",[], name2h+"=Projpara",[name3h], - "WriteOutData",tmp - ]); - options=append(options,"Wait="+text(waiting)); + "WriteOutData",tmp1 + ]; + tmp=replace(fname,".txt","end.txt"); + options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); if(wflg==1,options=concat(options,["m"])); if(wflg==-1,options=concat(options,["r"])); if(ErrFlag==0, - CalcbyS("wire"+nm,cmdL,options); + CalcbyR("wire"+nm,cmdL,options); ); if(ErrFlag==1, err("Wireparadata not completed"); , - if(outreg==1, -// OutFileList=remove(OutFileList,[fname]); -// OutFileList=append(OutFileList,fname); - ); ReadOutData(fname); - if(!islist(parse(name2)), ErrFlag=1); - if(ErrFlag==0, + if(islist(parse(name2)), Extractdata(name2,options); if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); Extractdata(name2h,tmp); + , + ErrFlag=1; ); ); ); -Crvsfparadata(nm,gd,out,fd):= - Crvsfparadata(nm,gd,out,fd,[],["nodisp"]); -Crvsfparadata(nm,gd,out,fd,options):= - Crvsfparadata(nm,gd,out,fd,options,["nodisp"]); -Crvsfparadata(nm,gdstr,outstr,fdorg,optionorg,optionsh):=( +Crvsfparadata(nm,crv,sf,fd):= + Crvsfparadata(nm,crv,sf,fd,[],["nodisp"]); +Crvsfparadata(nm,crv,sf,fd,options):= + Crvsfparadata(nm,crv,sf,fd,options,["nodisp"]); +Crvsfparadata(nm,crvstr,sfstr,fdorg,optionorg,optionsh):=( //help:Crvsfparadata("1","ax3d","sfbd3d1",fd); -//help:Crvsfparadata(options2=["Wait=20"]); - regional(gd,out,fd,options,name2,name3,name2h,name3h,outreg, - eqL,reL,strL,fname,gdfname,outfname,waiting,tmp,tmp1,tmp2,flg,wflg); +//help:Crvsfparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]); + regional(gd,out,fd,options,name2,name3,name2h,name3h, + eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,tmp3,flg,wflg); + tmp=replace(crvstr,"3d","2d"); + Changestyle(tmp,["nodisp"]); name2="crvsf2d"+nm; name3="crvsf3d"+nm; name2h="crvsfh2d"+nm; name3h="crvsfh3d"+nm; fname=Fhead+"crvsf"+nm+".txt"; - gdfname=Fhead+"crv"+nm+".txt"; - tmp=replace(outstr,"3d",""); - outfname=Fhead+tmp+".txt"; // 16.08.20 - gd=parse(gdstr); - out=parse(outstr); - if(!islist(out), ErrFlag=1); - fd=apply(fdorg,if(isstring(#),"'"+#+"'",#)); + rfname=Fhead+sfstr+".txt"; + rfname=replace(rfname,"3d",""); + tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#)); + tmp=text(tmp); + fd=RSform(tmp,2); options=optionorg; tmp=Divoptions(options); eqL=tmp_5; reL=tmp_6; strL=tmp_7; - waiting=20; - outreg=1; + waiting=120; forall(eqL, tmp=indexof(#,"="); tmp1=Toupper(substring(#,0,1)); @@ -3495,11 +3453,6 @@ Crvsfparadata(nm,gdstr,outstr,fdorg,optionorg,optionsh):=( waiting=parse(tmp2); options=remove(options,[#]); ); -// if(tmp1=="O", -// tmp=Toupper(substring(tmp2,0,1)); -// if(tmp=="T" % tmp=="Y", outreg=1,outreg=0); -// options=remove(options,[#]); -// ); ); options=remove(options,reL); wflg=0; @@ -3514,111 +3467,188 @@ Crvsfparadata(nm,gdstr,outstr,fdorg,optionorg,optionsh):=( options=remove(options,[#]); ); ); - flg=0; - tmp1=floor(5*1000/WaitUnit); - repeat(tmp1, - if(flg==0, - tmp=load(Fhead+replace(outstr,"3d","")+".txt"); - if(length(tmp)>=4, - tmp2=substring(tmp,length(tmp)-4,length(tmp)); - if(tmp2=="////", - flg=1; - ); - , - wait(WaitUnit); - ); - ); - ); - if(flg==0, - Err(outstr+" file not copleted"); - ErrFlag=1; - ); - if(wflg==0, - tmp=load(fname); - if(length(tmp)==0,wflg=1); - ); - if(ErrFlag==0, -// Writeoutdata(outfname,["Gc",gd,"Out",out]); -// wait(WaitUnit); - ); - cmdL=MkprecommandS(5); // 16.02.01 - tmp=[ - Dq+fname+Dq, - Dq+name3+Dq,name3, - Dq+name2+Dq,name2, - Dq+name3h+Dq,name3h, - Dq+name2h+Dq,name2h + reL=RSform(text(reL),2); + reL=substring(reL,5,length(reL)-1); + tmp=[crvstr,sfstr,"fd"+nm]; + if(length(reL)>0, + reL=textformat(reL,4); + reL=substring(reL,1,length(reL)-1); + reL=Rsform(reL); + tmp=append(tmp,reL); + ); + tmp1=[DqDq(fname),DqDq(name3),name3,DqDq(name2),name2]; + tmp1=concat(tmp1,[DqDq(name3h),name3h,DqDq(name2h),name2h]); + tmp2=replace(rfname,".txt",".dat"); + cmdL=[ + "print",[Dqq("crv"+nm)], //18.02.22 + "fd"+nm+"="+fd,[], + "ReadOutData",[Dqq(rfname)], + "load",[Dqq(tmp2)], + "Addpoints",[Addpoints()] ]; - fd=apply(fd,if(isstring(#),replace(#,"_1","(1)"),#)); // 16.05.25 08.17from - fd=apply(fd,if(isstring(#),replace(#,"_2","(2)"),#)); - fd=apply(fd,if(isstring(#),replace(#,"_3","(3)"),#)); // 16.05.25 08.17upto + tmp3=select(GLIST,indexof(#,crvstr+"=")>0); //18.02.22from + if(length(tmp3)==0, + tmp3=Fhead+crvstr+".txt"; + tmp3=replace(tmp3,"3d",""); + cmdL=concat(cmdL,[ + "ReadOutData",[Dqq(tmp3)] + ]); + ); //18.02.22until cmdL=concat(cmdL,[ - "disp('Running Crvsfparadata')",[], - "tmp=ReadOutData",[Dq+outfname+Dq], - "execstr(tmp)",[], - "function SetHidd(Dt),global HIDDENDATA,HIDDENDATA=Dt,endfunction)", - [], // 16.08.20from - "function SetPart(Dt),global PARTITIONPT,PARTITIONPT=Dt,endfunction)", - [], - "function SetOther(Dt),global OTHERPARTITION,OTHERPARTITION=Dt,endfunction)", - [], - "if type(HIDDENDATA)~=15,HIDDENDATA=list(HIDDENDATA),end",[], - "if type(PARTITIONPT)~=15,PARTITIONPT=list(PARTITIONPT),end",[], - "if type(OTHERPARTITION)~=15,OTHERPARTITION=list(OTHERPARTITION),end",[], - "for J=1:length(OTHERPARTITION)",[], - " Tmp=OTHERPARTITION(J)",[], - " OTHERPARTITION(J)=Tmp(:,1)",[], - "end",[], - "SetHidd(HIDDENDATA)",[], - "SetPart(PARTITIONPT)",[], - "SetOther(OTHERPARTITION)",[], - "if type("+outstr+")~=15,"+outstr+"=list("+outstr+"),end",[], // 16.08.20upto - name3+"=Crvsfparadata",concat([gdstr,outstr,fd,"Error"],reL), + name3+"=Crvsfparadata",tmp, name2+"=Projpara",[name3], - name3h+"=CrvsfHiddenData()",[], + name3h+"=CRVSFHIDDENDATA",[], name2h+"=Projpara",[name3h], - "WriteOutData",tmp + "WriteOutData",tmp1 ]); - options=append(options,"Wait="+text(waiting)); - if(wflg==1,options=concat(options,["m"])); - if(wflg==-1,options=concat(options,["r"])); + tmp=replace(fname,".txt","end.txt"); + options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); + if(wflg==1,options=append(options,"m")); + if(wflg==-1,options=append(options,"r")); if(ErrFlag==0, - CalcbyS("crvsf"+nm,cmdL,options); + CalcbyR("crvsf"+nm,cmdL,options); ); if(ErrFlag==1, err("Crvsfparadata not completed"); , - if(outreg==1, - OutFileList=remove(OutFileList,[fname]); - OutFileList=append(OutFileList,fname); + ReadOutData(fname); + if(islist(parse(name2)), + Extractdata(name2,options); + if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); + Extractdata(name2h,tmp); + , + ErrFlag=1; ); + ); +); + +Crvonsfparadata(nm,crv2d,sf,fd):= + Crvsonfparadata(nm,crv2d,sf,fd,[],["nodisp"]); +Crvonsfparadata(nm,crv2d,sf,fd,options):= + Crvonsfparadata(nm,crv2d,sf,fd,options,["nodisp"]); +Crvonsfparadata(nm,crv2dstr,sfstr,fdorg,optionorg,optionsh):=( +//help:Crvonsfparadata("1",["[1,t]","t=[0,2*pi]","Num=50"],"sfbd3d1",fd); +//help:Crvonsfparadata(options2=[division(c(50,50)),Eps1(0.01), Eps2(0.05)]); + regional(gd,out,fd,options,name2,name3,name2h,name3h, + eqL,reL,strL,fname,rfname,waiting,tmp,tmp1,tmp2,tmp3,flg,wflg); + name2="crvonsf2d"+nm; + name3="crvonsf3d"+nm; + name2h="crvonsfh2d"+nm; + name3h="crvonsfh3d"+nm; + fname=Fhead+"crvonsf"+nm+".txt"; + rfname=Fhead+sfstr+".txt"; + rfname=replace(rfname,"3d",""); + tmp=apply(fdorg,if(isstring(#),Dqq(#),#)); + tmp=text(tmp); + fd=RSform(tmp,2); + options=optionorg; + tmp=Divoptions(options); + eqL=tmp_5; + reL=tmp_6; + strL=tmp_7; + waiting=120; + forall(eqL, + tmp=indexof(#,"="); + tmp1=Toupper(substring(#,0,1)); + tmp2=substring(#,tmp,length(#)); + if(tmp1=="W", + waiting=parse(tmp2); + options=remove(options,[#]); + ); + ); + options=remove(options,reL); + wflg=0; + forall(strL, + tmp=Toupper(substring(#,0,1)); + if(tmp=="M", + wflg=1; + options=remove(options,[#]); + ); + if(tmp=="R", + wflg=-1; + options=remove(options,[#]); + ); + ); + if(isstring(crv2dstr), + crv=Rsform(crv2dstr); + , + crv=apply(crv2dstr,Dqq(#)); + crv=Rsform(text(crv)); + crv="Paramplot"+substring(crv,1,length(crv)); + ); + reL=RSform(text(reL),2); + reL=substring(reL,5,length(reL)-1); + tmp=["crv",sfstr,"fd"+nm]; + if(length(reL)>0, + reL=textformat(reL,4); + reL=substring(reL,1,length(reL)-1); + reL=Rsform(reL); + tmp=append(tmp,reL); + ); + tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2]; + tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]); + tmp2=replace(rfname,".txt",".dat"); + cmdL=[ + "print",[Dqq("crvonsf"+nm)], //18.02.22 + "fd"+nm+"="+fd,[], + "ReadOutData",[Dqq(rfname)], + "load",[Dqq(tmp2)], + "Addpoints",[Addpoints()], + "crv="+crv,[], + name3+"=Crvonsfparadata",tmp, + name2+"=Projpara",[name3], + name3h+"=HIDDENDATA",[], + name2h+"=Projpara",[name3h], + "WriteOutData",tmp1 + ]; + tmp=replace(fname,".txt","end.txt"); + options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); + if(wflg==1,options=append(options,"m")); + if(wflg==-1,options=append(options,"r")); + if(ErrFlag==0, + CalcbyR("crvonsf"+nm,cmdL,options); + ); + if(ErrFlag==1, + err("Crvonsfparadata not completed"); + , ReadOutData(fname); - tmp=replace(gdstr,"3d","2d"); - Changestyle([tmp],["nodisp"]); - Extractdata(name2,options); - if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); - Extractdata(name2h,tmp); - ); -); - -Intersectcrvsf(nm,gd,fd):= - Intersectcrvsf(nm,gd,fd,[]); -Intersectcrvsf(nm,gdstr,fdorg,optionorg):=( -//help:Intersectcrvsf("1",ax3d_1,fd); -//help:Intersectcrvsf(options=["Wait=10",50,0.05]); - regional(name,gd,fd,options,reL,fname,gdfname, - waiting,tmp,tmp1,tmp2,flg,wflg,pts); - name="intpts"+nm; + if(islist(parse(name2)), + Extractdata(name2,options); + if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); + Extractdata(name2h,tmp); + , + ErrFlag=1; + ); + ); +); + +Intersectcrvsf(nm,crv,fd):=Intersectcrvsf(nm,crv,fd,"",[]); +Intersectcrvsf(nm,crv,fd,Arg):=( + if(isstring(Arg), + Intersectcrvsf(nm,crv,fd,Arg,[]); + , + Intersectcrvsf(nm,crv,fd,"",Arg); + ); +); +Intersectcrvsf(nm,crvstr,fdorg,bdyeq,optionorg):=( +//help:Intersectcrvsf("1",curve,fd); +//help:Intersectcrvsf("1",curve,fd,curveequation); +//help:Intersectcrvsf(options=[Np([50,50]),Eps(0.01)]); + regional(name,crv,fd,options,reL,fname,crvfname,argR, + waiting,tmp,tmp1,tmp2,flg,wflg,pts); name="crvsf"+nm; + name="crvsf"+nm; fname=Fhead+name+".txt"; - gdfname=Fhead+"crv"+nm+".txt"; - gd=parse(gdstr); - fd=apply(fdorg,if(isstring(#),"'"+#+"'",#)); + crvfname=Fhead+"crv"+nm+".txt"; +// crv=parse(crvstr); +// crv=textformat(crv,6); +// crv=Rsform(crv,2); + fd=apply(fdorg,if(isstring(#),Dqq(#),#)); options=optionorg; tmp=Divoptions(options); eqL=tmp_5; reL=tmp_6; strL=tmp_7; - waiting=10; + waiting=120; forall(eqL, tmp=indexof(#,"="); tmp1=Toupper(substring(#,0,1)); @@ -3641,68 +3671,149 @@ Intersectcrvsf(nm,gdstr,fdorg,optionorg):=( options=remove(options,[#]); ); ); - if(wflg>-1, - Writeoutdata(gdfname,["Gd",gd]); -// wait(WaitUnit); + tmp=apply(fdorg,if(isstring(#),"'"+#+"'",#)); + tmp=text(tmp); + fd=RSform(tmp,2); + tmp=textformat(reL,4); + tmp=substring(tmp,1,length(tmp)-1); + tmp=Rsform(tmp); + if(length(bdyeq)>0, + argR=","+Dqq(bdyeq); + , + argR=""; + ); + if(length(tmp)>0, + argR=argR+","+tmp; ); - fd=apply(fd,replace(#,"_1","(1)")); // 16.05.25from - fd=apply(fd,replace(#,"_2","(2)")); - fd=apply(fd,replace(#,"_3","(3)")); // 16.05.25upto + tmp1=[Dqq(fname),Dqq(name),"tmp"]; cmdL=[ - "disp('Finding Intersectcrvsf')",[], - "Setangle",[THETA,PHI]*180/pi, - "tmp=ReadOutData",[Dq+gdfname+Dq], - "execstr(tmp)",[], - "Intpts=Intersectcrvsf",concat(["Gd",fd,"Error"],reL), - "tmp1='['",[], - "for J=1:length(Intpts)",[], - " tmp2=Intpts(J)",[], - " for K=1:length(tmp2)",[], - " if K==1",[], - " tmp1=tmp1+'['",[], - " end",[], - " tmp1=tmp1+string(tmp2(K))",[], - " if K0, + reL=textformat(reL,4); + reL=substring(reL,1,length(reL)-1); + reL=Rsform(reL); + tmp=append(tmp,reL); + ); + tmp1=[DqDq(fname),DqDq(name3),name3,DqDq(name2),name2]; + tmp1=concat(tmp1,[DqDq(name3h),name3h,DqDq(name2h),name2h]); + tmp2=replace(rfname,".txt",".dat"); + cmdL=[ + "print",[Dqq("sfcut"+nm)], //18.02.22 + "fd"+nm+"="+fd,[], + "ReadOutData",[Dqq(rfname)], + "load",[Dqq(tmp2)], + name3+"=Sfcutparadata",tmp, + name2+"=Projpara",[name3], + name3h+"=CRVONSFHIDDENDATA",[], + name2h+"=Projpara",[name3h], + "WriteOutData",tmp1 + ]; + tmp=replace(fname,".txt","end.txt"); + options=concat(options,["Out=no","Wait="+text(waiting),"Res="+tmp]); + if(wflg==1,options=append(options,"m")); + if(wflg==-1,options=append(options,"r")); if(ErrFlag==0, - CalcbyS(name,cmdL,options); // 16.08.14 + CalcbyR("sfcut"+nm,cmdL,options); ); if(ErrFlag==1, - err("Intersectcrvsf not completed"); + err("Sfcutparadata not completed"); , - println(name+" obtained"); //16.08.14from - pts=load(fname); - pts=replace(pts,"||||",""); - tmp=name+"="+pts; - parse(tmp); - parse(pts); //16.08.14upto + ReadOutData(fname); + if(islist(parse(name2)), + Extractdata(name2,options); + if(length(optionsh)>0,tmp=optionsh,tmp=["nodisp"]); + Extractdata(name2h,tmp); + , + ErrFlag=1; + ); ); ); -////////////// new skeleton 2018.01.04from //////////////// - Skeletonparadata(nm):=Skeletondatacindy(nm,[]); Skeletonparadata(nm,options):=Skeletondatacindy(nm,options); Skeletonparadata(nm,pltdata1,pltdata2):=Skeletondatacindy(nm,pltdata1,pltdata2); Skeletonparadata(nm,pltdata1org,pltdata2org,options):= Skeletondatacindy(nm,pltdata1org,pltdata2org,options); + + +////////////// new skeleton 2018.01.04 not completed and slow//////////////// + Skeletondatacindy(nm):=Skeletondatacindy(nm,[]); Skeletondatacindy(nm,options):=( regional(tmp); @@ -3791,10 +3902,9 @@ Makeskeletondata(ObjL,PltL,R0):=( remov=[]; obj2=Projcurve(obj); forall(1..(length(PltL)),nn, - plt=PltL_nn; tmp=Projcurve(plt); - koc=Intersectcurves(obj2,tmp); + koc=IntersectcurvesPp(obj2,tmp); forall(1..(length(koc)),kk, ptk=koc_kk; tmp=PointonCurve(ptk_2,obj); @@ -3894,7 +4004,363 @@ Makeskeletondata(ObjL,PltL,R0):=( Allres; ); -////////////// new skeleton 2018.01.04upto //////////////// +////////////// current skeleton 2018.01.04 //////////////// + +Skeletondatacindy(nm):=Skeletondatacindy(nm,[]); +Skeletondatacindy(nm,options):=( + regional(tmp); + tmp=Datalist3d(); + Skeletondatacindy(nm,tmp,tmp,options); +); +Skeletondatacindy(nm,pltdata1,pltdata2):= + Skeletondatacindy(nm,pltdata1,pltdata2,[]); +Skeletondatacindy(nm,pltdata1org,pltdata2org,options):=( +//help:Skeletondatacindy("1"); +//help:Skeletondatacindy("1",[pdata1,pdata2],[pdata3]); +//help:Skeletondatacindy(options2=[1(width)]); + regional(Eps,Eps2,name2,name3,Ltype,Noflg,reL,opcindy, + Out,ObjL,Plt3L,Rr,pltdata1,pltdata2,Plt2L,ObjL,ii,Data, + Obj3,jj,Gd,PtD,size,tmp,tmp1,tmp2); + name2="sk2d"+nm; + name3="sk3d"+nm; + pltdata1=[];// 16.01.31 + forall(pltdata1org,tmp1, + tmp=parse(tmp1); + pltdata1=append(pltdata1,tmp); + ); + pltdata2=[];// 16.01.31 + forall(pltdata2org,tmp1, + tmp=parse(tmp1); + pltdata2=append(pltdata2,tmp); + ); + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + reL=tmp_6; //16.02.28 + opcindy=tmp_9; + Rr=0.075*1000/2.54/MilliIn; + size=1; + Eps2=0.05; + if(length(reL)>0, //16.02.28 + size=reL_1; + Rr=size*Rr; + if(length(reL)>1,Eps2=reL_2); + ); + Eps=10^(-4); + ObjL=Flattenlist(pltdata1); + Plt3L=Flattenlist(pltdata2); + tmp=apply(Plt3L,ProjcoordCurve(#)); + Plt2L=Flattenlist(tmp); +/////////// tmp=apply(pltdata1,replace(#,"3d","2d")); + Out=[]; + forall(1..(length(ObjL)),ii, + Obj3=ObjL_ii; + tmp=ProjcoordCurve(Obj3); + Data=Makeskeletondata([tmp],Plt2L,Rr,Eps2); + forall(1..(length(Data)),jj, + Gd=Data_jj; + if((length(Gd)>1) + & (norm(Ptcrv(1,Gd)-Ptcrv(2,Gd))>Eps), + PtD=[]; + forall(1..(length(Gd)), + tmp=Gd_#; + tmp1=Invparapt(tmp,Obj3); + PtD=append(PtD,tmp1); + ); + Out=append(Out,PtD); + ); + ); + ); + Out=select(Out,length(Projcurve(#))>0); // 16.12.19 + tmp1=apply(Out,textformat(#,5)); + tmp=name3+"="+tmp1; + parse(tmp); + tmp=name2+"=Projcurve("+tmp1+");"; + parse(tmp); + Changestyle3d(pltdata1org,["nodisp"]); + if(Noflg<3, + println("generate skeleton :"+name3); + tmp1=text(pltdata1org); + tmp1="list("+substring(tmp1,1,length(tmp1)-1)+")"; + tmp2=text(pltdata2org); + tmp2="list("+substring(tmp2,1,length(tmp2)-1)+")"; + tmp=name3+"=Skeletonpara3data("+tmp1+","+tmp2+","; + tmp=tmp+text(size)+")"; + GLIST=append(GLIST,tmp); + tmp=name2+"=Projpara("+name3+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name2); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name2,Ltype,opcindy]); + if(SUBSCR==1, + Subgraph(name3,opcindy); + ); + ); + Out; +); + +Makeskeletondata(Obj2L,Plt2L,R0,Eps2):=( + regional(Allres,Eps,Dmat,Dind,ii,Dt,nn1,nn2,Nind,Nobj, + Plt2,PhL,ClipL,ns,pt1,pt2,pt,pta,ptb,za,zb,z1,z2,t1,t2,te, + koc,KukanL,nn,tt,Rr,Flg,ii,jj,ptq,hh,Ku,Res,contflg,breakflg); + Eps=10.0^(-4); + Dmat=[]; + Dind=[]; + forall(1..(length(Plt2L)),ii, + Dt=Plt2L_ii; + nn1=length(Dmat)+1; + Dmat=concat(Dmat,Dt); + nn2=length(Dmat); + Dind=append(Dind,[nn1,nn2]); + ); + Nind=length(Dind); + Allres=[]; + forall(1..(length(Obj2L)),Nobj, + Plt2=Obj2L_Nobj; + PhL=Columnlist(Plt2,1..2); + ClipL=[]; + forall(1..(length(PhL)-1),ns, + pt1=PhL_(ns..(ns+1)); + forall(1..(length(Dind)),ii, + tmp=Dind_ii; + tmp=Dmat_(Dind_ii_1..Dind_ii_2); + pt2=Columnlist(tmp,1..2); + koc=IntersectcrvsPp(pt1,pt2,[Eps]); + if(length(koc)>0, + breakflg=0; + forall(1..(length(koc)),jj, + contflg=0; + if(breakflg==0, + pt=Op(1,Op(jj,koc)); + tmp=Op(2,Op(jj,koc)); + if((tmp<1+Eps) & (ns==1), + contflg=1; + ); + if(contflg==0, + if((tmp>length(pt1)-Eps) + & (ns==length(PhL)-1), + contflg=1; + ); + ); + if(contflg==0, + nn1=ns; + nn2=Op(3,Op(jj,koc)); + tmp=Plt2_nn1; + pta=tmp_(1..2); + za=tmp_3; + tmp=Plt2_(nn1+1); + ptb=tmp_(1..2); + zb=tmp_3; + if(norm(pta-ptb)Eps^2, + tmp1=pt1_2-pt1_1; + tmp2=ptb-pta; + tmp3=Dotprod(tmp1,tmp2); + tmp3=tmp3/norm(tmp1)/norm(tmp2); + tmp=1-0.5*tmp3^2; + tmp1=concat(pt,[nn1,t1,R0/tmp]); + ClipL=append(ClipL,tmp1); + ); + ); + ); + ); + ); + ); + ); + ); + te=length(Plt2); + KukanL=[[1.0,te]]; + pt1=PhL; + if(length(ClipL)>0, + forall(1..(length(ClipL)),ii, + tmp=ClipL_ii; + pt=tmp_(1..2); + nn=tmp_3; + tt=nn+tmp_4; + Rr=tmp_5; + Flg=0; + breakflg=0; + forall(reverse(1..nn),jj, + contflg=0; + if(breakflg==0, + ptq=PointonCurve(jj,pt1); + if(norm(pt-ptq)Eps, + tmp=PointonCurve(t2,pt1); + PtL=append(PtL,tmp); + ); + tmp=Listplot("",PtL,["nodata"]); + Res=append(Res,tmp); + ); + Allres=concat(Allres,Res); + ); + Allres; +); + +Kukannozoku(Jokyo,KukanL):=( + regional(Res,Eps,nn,ii,t1,t2,Ku,Flg,contflg,tmp,tmp1); + Eps=10^(-6); + nn=length(KukanL); + t1=Jokyo_1; t2=Jokyo_2; + tmp=KukanL_1; + t1=max(t1,tmp_1); + tmp=KukanL_nn; + t2=min(t2,tmp_2); + Res=[]; + Flg=0; + contflg=0; + forall(1..nn,ii, + if(contflg==0, + Ku=KukanL_ii; + if(Flg==0, + if(Ku_2t2+Eps, + tmp=[t2,Ku_2]; + Res=append(Res,tmp); + ); + ); + , + if(Flg==1, + if(Ku_2 // -println("KETCindy V.3.1.5(2018.02.02"); +println("KETCindy V.3.2.0(20180405"); println(ketjavaversion());//17.06.05 -println("ketcindylibbasic1(2018.02.02) loaded"); +println("ketcindylibbasic1(20180402) loaded"); //help:start(); @@ -50,7 +50,7 @@ Ketinit(sy,rangex,rangey):=( MARKLEN=0.05; MARKLENInit=MARKLEN: MARKLENNow= MARKLEN; - GENTEN=[0,0];//18.01.15upto + GENTEN=[0,0];//18.01.15until KETPICLAYER=20; MilliIn=1/2.54*1000; PenThick=round(MilliIn*0.02); @@ -89,16 +89,32 @@ Ketinit(sy,rangex,rangey):=( Fhead=replace(Fhead,".cdy",""); Slidename=Fhead; //17.10.24 );//17.11.12 - if(isstring(Dircdy) & iswindows(), //17.12.01 + Dircdy=replace(Dircdy,"%E3%80%80"," ");//180405 + tmp1=Indexall(Dircdy,"%"); //180329from + if(length(tmp1)>0, + tmp1=append(tmp1,length(Dircdy)); + tmp2=substring(Dircdy,0,tmp1_1-1); + forall(1..(length(tmp1)-1), + tmp=substring(Dircdy,tmp1_#,tmp1_#+2); + tmp2=tmp2+unicode(tmp); + tmp2=tmp2+substring(Dircdy,tmp1_#+2,tmp1_(#+1)-1); + ); + Dircdy=tmp2; + ); //180329to + if(iswindows(), //17.12.01 Dircdy=replace(Dircdy,"/",pathsep()); if(substring(Dircdy,0,1)==pathsep(), Dircdy=substring(Dircdy,1,length(Dircdy)); ); + Changesetting([gethome(), gethome()+"\Desktop","C:"]); //180405 + , + Changesetting([gethome(),gethome(),gethome()+"/Desktop"]); ); + Changework(Dircdy+pathsep()+"fig"); //180329to Fnametex=Fhead+".tex"; FnameR=Fhead+".r"; FnamebodyR=Fhead+"body.r"; - Fnameout=Fhead+".txt"; // 17.10.13upto + Fnameout=Fhead+".txt"; // 17.10.13until if(!isstring(Mackc),// 16.06.07 Mackc="sh"; ); @@ -107,7 +123,7 @@ Ketinit(sy,rangex,rangey):=( , Shellparent="/kc.sh"; if(!isexists(Dirwork,""), - println(Dirwork+" not exist"); + println(Dirwork+" not exists"); , if(!iskcexists(Dirwork), setdirectory(Dirwork); @@ -142,9 +158,32 @@ Ketinit(sy,rangex,rangey):=( ); if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")>0, LibnameS=replace(LibnameS,"ketpic","ketpic2e"); - );//17.12.03upto + );//17.12.03until ); +Changesetting(dirL):=( //180329 + regional(fname,tmp1,flg); + fname="changesetting.txt"; + tmp1=apply(dirL,#+pathsep()+"ketcindy"); + tmp1=prepend(Dircdy,tmp1); + flg=0; + forall(tmp1, + if(flg==0, + if(isexists(#,fname), + setdirectory(#); + import(fname); + println(fname+" imported from "+#); + flg=1; + ); + ); + ); + if(flg==0, + println(fname+" not exists in "+text(tmp1)); + println(" Put "+fname+" in one of folders above"); + ); +); + +Cindyname():=Getcdyname(); Cdyname():=Getcdyname(); Getcdyname():=( //17.12.27 //help:Cdyname(); @@ -206,62 +245,12 @@ Setparent(file):=( // 17.11.27 Texparent=file; ); -Setcindyname():=Setcindyname("");//16.12.25 -Setcindyname(file):=( -//help:Setcindyname("Fhead"); -//help:Setcindyname(); - regional(tmp,tmp1,tmp2); - setdirectory(Dirhead); - CindyPathName=""; - CindyFileName=""; - CindyPathName=load("cindypath.txt"); - tmp2=load("cindyfile.txt"); - tmp2=replace(tmp2,".cdy",""); - if(length(tmp2)>0, - CindyFileName=tmp2; - if(length(file)>0, - tmp=file+"="+DqDq(tmp2); - parse(tmp); - println(file+" set to "+DqDq(tmp2)); - ); - , - println("set "+file+" manually"); - ); - setdirectory(Dirwork); - CindyFileName; -); - -Cindypath():=( // 16.12.26 -//help:Cindypath(); - regional(out); - CindyPathName=""; - setdirectory(Dirhead); - CindyPathName=load("cindypath.txt"); - setdirectory(Dirwork); - if(length(CindyPathName)==0, - out=Dirwork; - , - out=CindyPathName; - ); - println(" path name="+out); - out; +Dqq(str):=DqDq(str); //18.02.11 +DqDq(str):=( +//help(Dqq("ab"); => Dq+"ab"+Dq) + unicode("0022")+str+unicode("0022"); ); -Cindyfile():=( // 16.12.26 -//help:Cindyfile(); - regional(out); - CindyFileName=""; - setdirectory(Dirhead); - out=load("cindyfile.txt"); - out=replace(out,".cdy",""); - setdirectory(Dirwork); - CindyFileName=out; - println(" file name="+out); - out; -); - -DqDq(str):=unicode("0022")+str+unicode("0022"); - Tab2list(dtstr):=Tab2list(dtstr,[]); Tab2list(dtstrorg,options):=( //help:Tab2list(datastr); @@ -282,7 +271,7 @@ Tab2list(dtstrorg,options):=( if(tmp1=="B", tmp1="0123456789+-."; // 16.09.28from tmp=substring(tmp2,0,1); - if(indexof(tmp1,tmp)>0,rep=parse(tmp2),rep=tmp2); // 16.09.28upto + if(indexof(tmp1,tmp)>0,rep=parse(tmp2),rep=tmp2); // 16.09.28until ); if(tmp1=="S", // 16.12.04 if(tmp2!="tab",sep=tmp2); @@ -293,13 +282,13 @@ Tab2list(dtstrorg,options):=( first=crm; if(indexof(dtstr,crm+lfm)>0, first=first+lfm; - ); // 16.09.05upto + ); // 16.09.05until ); dtstr=dtstrorg;// 16.09.19from tmp=substring(dtstr,length( dtstr)-1,length(dtstr)); if(tmp!=lfm, dtstr=dtstr+first; - );// 16.09.19upto + );// 16.09.19until tmp1=Indexall(dtstr,first); tmp1=prepend(0,tmp1); tmp1=append(tmp1,length(dtstr)); @@ -455,7 +444,7 @@ Bracket(str,br):=( ph=substring(br,0,1); pt=substring(br,1,2); noL=Indexall(str,ph); - ncL=Indexall(str,pt); // 16.05.22upto + ncL=Indexall(str,pt); // 16.05.22until nall=sort(concat(noL,ncL)); level=0; out=[]; @@ -570,13 +559,6 @@ Pardiagram(str,options):=( out; ); -Changelib(path):=( - Dirlib=path; - setdirectory(Dirlib); - import("ketcindyset.txt"); - setdirectory(Dirwork); // 16.04.23 -); - Changework(dirorg):=( //16.10.21 //help:Changework(directory); regional(dir,subdir,tmp); @@ -586,14 +568,14 @@ Changework(dirorg):=( //16.10.21 tmp=length(dir); if(substring(dir,tmp-1,tmp)==pathsep(), dir=substring(dir,0,tmp-1); - );//17.11.20upto + );//17.11.20until tmp=Indexall(dir,pathsep()); //17.11.24from subdir=""; if(length(tmp)>0, tmp=tmp_(length(tmp)); subdir=substring(dir,tmp,length(dir)); dir=substring(dir,0,tmp-1); - ); //17.11.24upto + ); //17.11.24until if(dir=="" % !isexists(dir,""), println("Directory "+dir+" not exist, so set to "+Dirwork); ErrFlag=-1; @@ -603,7 +585,7 @@ Changework(dirorg):=( //16.10.21 Dirwork=dir+pathsep()+subdir; , Dirwork=dir; - ); //17.11.24upto + ); //17.11.24until setdirectory(Dirwork); if(!iswindows(), //17.04.11 if(!iskcexists(Dirwork), @@ -818,7 +800,7 @@ Textformat(value,dig):=( if(length(tmp1)>1, //18.01.29from tmp1=substring(tmp1,0,length(tmp1)-1); ); - tmp1=tmp1+"]"; //18.01.29upto + tmp1=tmp1+"]"; //18.01.29until , if(ispoint(value) % isstring(value), // vv=Lcrd(value); @@ -924,7 +906,7 @@ MeasureDepth(list):=( Flg=1; , tmp1=select(1..(length(list)),length(list_#)>0);//17.05.21from - tmp=list_(tmp1_1);//17.05.21upto + tmp=list_(tmp1_1);//17.05.21until ); repeat(4, if(Flg==0, @@ -1109,7 +1091,7 @@ Invert(nm,Fig,options):=( name="-inv"+nm; tmp=Invert(Fig); Listplot(name,tmp,options); -);// upto 16.01.27 +);// until 16.01.27 Paramoncrv(pP,Gdata):=( regional(Tmp,PtL); @@ -1412,7 +1394,7 @@ IntersectcrvsPp(Gr1,Gr2,options):=( Out_#_1=(Out_#_1+Tmp2_1)/2;//17.04.14 ); ); - ); // 15.04.06 upto + ); // 15.04.06 until Out; ); @@ -1468,6 +1450,7 @@ Intersectseg(seg1org,seg2org,Eps1):=( out=[-1]; , tmp=Intersectline(p1,q1-p1,p2,q2-p2); +println([1475,textformat(tmp,6)]); if(islist(tmp_1), pt=tmp_1; t=tmp_2; s=tmp_3; if((t*(t-1)1), //18.02.06 if(tmp_1s1)&(tmp1s2)&(tmp2Eps, crv2=append(crv2,#); ); - );//18.01.05upto + );//18.01.05until if(crv1==crv2, self=1; , @@ -1778,7 +1809,7 @@ IntersectcurvesPp(crv1org,crv2org,options):=( flg=0; forall(1..(length(tmp2)), if(flg==0, - tmp=Collectnear(tmp1,Eps2); + tmp=Collectsameseg(tmp1); out=append(out,tmp_1); if(length(tmp_2)==0, flg=1; @@ -1796,7 +1827,7 @@ IntersectcurvesPp(crv1org,crv2org,options):=( dst=min(tmp); tmp1=select(tmp1,#_40,tmp1=parse(size),tmp1=1); tmp1=max(tmp1,1)/8; - Setpen(tmp1); // 16.04.09 upto + Setpen(tmp1); // 16.04.09 until Com2nd("Drwpt(list("+name+")"+opstr+")"); Setpen(thick); // 16.04.09 if(length(size)>0, @@ -3294,7 +3349,7 @@ Listplot(nm,list,options):=( name=substring(nm,1,length(nm)); , name="sg"+nm; - ); // upto + ); // until tmp=Divoptions(options); Ltype=tmp_1; Noflg=tmp_2; @@ -3344,7 +3399,7 @@ Listplot(Arg1,Arg2):=( name=""; forall(list, // 16.10.07from name=name+#.name; - );// 16.10.07upto + );// 16.10.07until Listplot(name,list,options); ); ); @@ -3407,7 +3462,7 @@ Lineplot(Arg1,Arg2):=( name=""; forall(list, // 16.10.07from name=name+#.name; - );// 16.10.07upto + );// 16.10.07until Lineplot(name,list,options); ); ); @@ -3718,6 +3773,195 @@ Paramplot(name1,funstr,variable,options):=( ); ); +Connectseg(Pdata):=( + regional(Eps,PlotL,vL,ctr,qd,ah,ao,flg,jj, + pp,qq,tmp,tmp1,tmp2); + Eps=10^(-4); + PlotL=[Pdata_1]; + vL=2..(length(Pdata)); + ctr=0; + while((length(vL)>0)&(ctr<1000), + ctr=ctr+1; + qd=PlotL_(length(PlotL)); + ah=qd_1; ao=qd_(length(qd)); + flg=0; + forall(1..(length(vL)),jj, + if(flg==0, + tmp1=Pdata_(vL_jj); + pp=tmp1_1; qq=tmp1_(length(tmp1)); + if(Norm(pp-ao)0, + qd=concat(qd,tmp); + ); + PlotL_(length(PlotL))=qd; + vL=remove(vL,[vL_jj]); + flg=1; + ); + ); + if(flg==0, + if(Norm(qq-ao)0, parse(Bname); ); @@ -4652,7 +4897,7 @@ Paramark(Arg1,Arg2):=( // 17.03.27 from nm=substring(tmp,1,length(tmp)-1); Paramark(nm,plist,options); ); -);// upto +);// until Paramark(nm,plist,options):=( //help:Paramark([A,B,C],["E=\theta"]); //help:Paramark("1",[p1,p2,p3],["E=\theta"]); @@ -4745,7 +4990,7 @@ Bowdata(plist,options):=( nm=plist; tmp=options; Bowdata(nm,tmp,[]); - ); // 16.12.04upto + ); // 16.12.04until ); Bowdata(nm,plist,options):=( //help:Bowdata([C,A],[2,1.2,"Expr=10","da"]); @@ -4770,7 +5015,7 @@ Bowdata(nm,plist,options):=( Tmov=0;//16.11.01from Nmov=0; Bmov=""; - rev=0;//16.11.01upto + rev=0;//16.11.01until if(length(realL)>0, Hgt=realL_1*Hgt; // 15.04.12 if(length(realL)>1,Cut=realL_2); @@ -4801,7 +5046,7 @@ Bowdata(nm,plist,options):=( BOWMIDDLE=[pC_1+ra*cos(Th),pC_2+ra*sin(Th)]; Bpos="md"+name; // 16.10.31from(moved) tmp="Defvar("+Dq+Bpos+"="+textformat(BOWMIDDLE,5)+Dq+");"; - parse(tmp);// 16.10.31upto(moved) + parse(tmp);// 16.10.31until(moved) if(length(Bname)>0, //16.11.01from tmp=indexof(Bops,","); if(tmp>0, @@ -4843,7 +5088,7 @@ Bowdata(nm,plist,options):=( ); Bname=Bname+Dq+Bops+Dq+")"; parse(Bname); - );//16.11.01upto + );//16.11.01until if(Cut==0, Th1=Ydata_3; Th2=Ydata_4; @@ -5234,7 +5479,7 @@ EnclosingS(nm,plist,options):=( tmp1=tmp1+#+","; ); tmp=tmp+substring(tmp1,0,length(tmp1)-1)+")"+opstr+")"; - GLIST=append(GLIST,tmp);//16.11.07upto + GLIST=append(GLIST,tmp);//16.11.07until // GLIST=append(GLIST,"Tmp=[]"); // 16.11.05from // nn=floor(length(AnsL)/20); // forall(1..nn,ii, @@ -5249,7 +5494,7 @@ EnclosingS(nm,plist,options):=( // tmp="Tmp=[Tmp,"+textformat(tmp,5)+"]"; // GLIST=append(GLIST,tmp); // ); -// GLIST=append(GLIST,name+"=Listplot(Tmp)"); // 16.11.05upto +// GLIST=append(GLIST,name+"=Listplot(Tmp)"); // 16.11.05until ); if(Noflg<2, if(isstring(Ltype), @@ -5320,7 +5565,7 @@ Enclosing2(nm,plistorg,options):=( tmp=Listplot(name,[tmp1,tmp2],["nodisp"]); plist=append(plist,"sg"+name); Start=tmp2; - tst=1; //18.02.02upto + tst=1; //18.02.02until , if(length(KL)==1, tst=KL_1_2; @@ -5359,7 +5604,7 @@ Enclosing2(nm,plistorg,options):=( parse(tmp); plist_nxtno=Gdata; t2=Length(tmp1); - ss=1; //18.02.02upto + ss=1; //18.02.02until , t2=KL_1_2; ss=KL_1_3; @@ -5397,7 +5642,7 @@ Enclosing2(nm,plistorg,options):=( tmp1=tmp1+#+","; ); tmp=tmp+substring(tmp1,0,length(tmp1)-1)+"))";//18.02.02 - GLIST=append(GLIST,tmp);//16.11.07upto + GLIST=append(GLIST,tmp);//16.11.07until ); if(Noflg<2, if(isstring(Ltype), @@ -5647,7 +5892,7 @@ Shade(plist,options):=( forall(plist, if(flg==0, if(isstring(#),tmp=parse(#),tmp=#); // from 16.01.24 - if(!islist(tmp),flg=1); upto + if(!islist(tmp),flg=1); until ); ); if(flg==1, @@ -5669,7 +5914,7 @@ Shade(plist,options):=( ); , tmp1=tmp1+"Listplot("+textformat(#,5)+"),"; - ); // upto 16.01.24 + ); // until 16.01.24 ); Str=Str+substring(tmp1,0,length(tmp1)-1)+")"+opstr+")"; Com2nd(Str); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt index 428c5b30..3bdf66fc 100644 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt +++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2logr.txt @@ -1,3 +1,20 @@ +//20180405 +// Makebat debugged +//20180404 +// Tlistplot changed ("Msg"); +// WritetoRS debugged ( openfie(..,Cdy= )) +//20180403 +// WritetoRS, Makebat changed (for Zenkaku) +// Convsjiswin removed +// Mkslidesummary debugged +//20180401 +// Convsjiswin added +// Makebat changed (for convsjis ) +//20180330 +// Presentation changed (for wallpaper ) +// Settitle changed (Title option ) +//20180303 +// Letter debugged (for ` ) //2017.12.24 // IftoR, FortoR,Deffun rewritten //2017.12.23 diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs index 5c8381af..1b9311bd 100644 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs +++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibbasic2r.cs @@ -1,5011 +1,5048 @@ -// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -// -//This program is free software: you can redistribute it and/or modify -// it under the terms of the GNU General Public License as published by -// the Free Software Foundation; either version 3 of the License, or -// (at your option) any later version. -// -// This program is distributed in the hope that it will be useful, -// but WITHOUT ANY WARRANTY; without even the implied warranty of -// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -// GNU General Public License for more details. -// -// You should have received a copy of the GNU General Public License -// along with this program. If not, see -// - -println("ketcindybasic2(2017.12.24) loaded"); - -//help:start(); - -Dispchoice():=( - if(islist(Ch), - if(!isreal(ChNum),ChNum=1); - drawtext(mouse().xy,"Ch="+text(Ch)+" N="+text(ChNum),size->24,color->[0,0,1]); - ); -); - -Datetime():=( -//help:Datetime(); - regional(names,dt,tmp); - tmp=getdatetime(); - dt=tokenize(tmp," "); - dt=apply(dt,if(!isstring(#),text(#),#)); - names=["Jan","Feb","Mar","Apr","May","Jun", - "Jul","Aug","Sep","Oct","Nov","Dec"]; - tmp=select(1..12,names_#==dt_2); - tmp=text(tmp_1); - tmp=[dt_6+"/"+tmp+"/"+dt_3,dt_4]; -); - -Rotatepoint(point,Theta,ctr):=( -//help:Rotatepoint(A,2*pi/3,B); - regional(X1,X2,Y1,Y2,Cx,Cy,tmp); - tmp=Lcrd(point); - X1=tmp_1; Y1=tmp_2; - tmp=Lcrd(ctr); - Cx=tmp_1; Cy=tmp_2; - X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta); - Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta); - [X2,Y2]; -); - -Translatepoint(point,mov):=( -//help:Translatepoint(A,[2,3]); - regional(X1,X2,Y1,Y2,Cx,Cy,tmp); - tmp=Lcrd(point); - X1=tmp_1; Y1=tmp_2; - tmp=Lcrd(mov); - Cx=tmp_1; Cy=tmp_2; - X2=X1+Cx; - Y2=Y1+Cy; - [X2,Y2]; -); - -Scalepoint(point,ratio,center):=( -//help:Scalepoint(A,[3,2],[0,0]); - regional(X1,X2,Y1,Y2,Cx,Cy,tmp); - tmp=Lcrd(point); - X1=tmp_1; Y1=tmp_2; - tmp=Lcrd(center); - Cx=tmp_1; Cy=tmp_2; - X2=Cx+ratio_1*(X1-Cx); - Y2=Cy+ratio_2*(Y1-Cy); - [X2,Y2]; -); - -Reflectpoint(point,symL):=( -//help:Reflectpoint(A,B); -//help:Reflectpoint(A,[[2,3]]); -//help:Reflectpoint(A,[C,E]); - regional(X1,X2,Y1,Y2,Us,Vs,Pt1,Pt2,Cx,Cy,tmp); - tmp=Lcrd(point); - X1=tmp_1; Y1=tmp_2; - Pt1=Lcrd(symL_1); - if(length(symL)==1, - Pt2=Pt1; - , - Pt2=Lcrd(symL_2); - ); - Us=Pt2_1-Pt1_1; - Vs=Pt2_2-Pt1_2; - if(Pt1==Pt2, - X2=2*Pt1_1-X1; - Y2=2*Pt1_2-Y1; - , - X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1 - -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); - Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1 - +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); - ); - [X2,Y2]; -); - -Rotatedata(nm,plist,Theta):=Rotatedata(nm,plist,Theta,[]); -Rotatedata(nm,plist,angle,options):=( -//help:Rotatedata("1","crAB",pi/3,[[1,5],"dr,2"]); - regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdLL,PdL, - opcindy,Nj,Njj,Kj,Mj,X1,Y1,X2,Y2,Ltype,Noflg,name); - name="rt"+nm; - Pt=[0,0]; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - tmp1=tmp_6; - if(length(tmp1)>0,Pt=Lcrd(tmp1_1)); - pdata=plist; - if(isstring(pdata),pdata=[pdata]); - if(!isstring(pdata_1) & MeasureDepth(pdata)==1, - pdata=[pdata]; - ); - if(isstring(angle),Theta=parse(angle),Theta=angle); - Cx=Pt_1; Cy=Pt_2; - PdL=[]; - forall(pdata,Njj, - if(isstring(Njj),Kj=parse(Njj),Kj=Njj); - if(MeasureDepth(Kj)==0,Kj=[Kj]); //17.11.24 - if(MeasureDepth(Kj)==1,Kj=[Kj]); - tmp2=[]; - forall(Kj,Nj, - tmp1=[]; - forall(Nj, - tmp=LLcrd(#); - X1=tmp_1; - Y1=tmp_2; - X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta); - Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta); - tmp1=concat(tmp1,[[X2,Y2]]); - ); - tmp2=concat(tmp2,[tmp1]); - ); - PdL=concat(PdL,tmp2); - ); - if(Noflg<3, - println("generate Rotatedata "+name); - tmp1=[]; - forall(PdL,tmp2, - tmp=apply(tmp2,Pcrd(#)); - tmp1=append(tmp1,tmp); - ); - if(length(tmp1)==1,tmp1=tmp1_1); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=text(plist); - tmp1=RSform(tmp1);// 17.12.23(2lines) - tmp=name+"=Rotatedata("+tmp1+"," - +textformat(angle,5)+","+RSform(textformat(Pt,5))+")"; //17.12.23 - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - PdL; -); - -Translatedata(nm,plist,mov):=Translatedata(nm,plist,mov,[]); -Translatedata(nm,plist,mov,options):=( -//help:Translatedata("1",["gr1"],[1,2]); - regional(tmp,tmp1,tmp2,pdata,Cx,Cy,PdL,Nj,Njj,Kj, - opcindy,X2,Y2,Ltype,Noflg,name); - name="tr"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - pdata=plist; - if(isstring(pdata),pdata=[pdata]); - if(!isstring(pdata_1) & MeasureDepth(pdata)==1, - pdata=[pdata]; - ); - tmp=Lcrd(mov); - Cx=tmp_1; Cy=tmp_2; - PdL=[]; - forall(pdata,Njj, - if(isstring(Njj),Kj=parse(Njj),Kj=Njj); - if(MeasureDepth(Kj)==1,Kj=[Kj]); - tmp2=[]; - forall(Kj,Nj, - tmp1=[]; - forall(Nj, - tmp=LLcrd(#); - X2=tmp_1+Cx; - Y2=tmp_2+Cy; - tmp1=concat(tmp1,[[X2,Y2]]); - ); - tmp2=concat(tmp2,[tmp1]); - ); - PdL=concat(PdL,tmp2); - ); - if(Noflg<3, - println("generate Translatedata "+name); - tmp1=[]; - forall(PdL,tmp2, - tmp=apply(tmp2,Pcrd(#)); - tmp1=append(tmp1,tmp); - ); - if(length(tmp1)==1,tmp1=tmp1_1); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=text(plist); - tmp1=RSform(tmp1);// 17.12.23 - tmp=name+"=Translatedata("+tmp1+","+RSform(textformat(mov,5))+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - PdL; -); - -Scaledata(nm,plist,ratioV):=( - regional(tmp); - tmp=Lcrd(ratioV); - Scaledata(nm,plist,tmp_1,tmp_2,[]); -); -Scaledata(nm,plist,Arg1,Arg2):=( -//help:Scaledata("1","crAB",3,2,[[0,0]]); - regional(tmp,options); - if(islist(Arg2), - tmp=Lcrd(Arg1); - options=Arg2; - Scaledata(nm,plist,tmp_1,tmp_2,options); - , - Scaledata(nm,plist,Arg1,Arg2,[]); - ); -); -Scaledata(nm,plist,rx,ry,options):=( - regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdL, - opcindy,Nj,Njj,Kj,X2,Y2,Ltype,Noflg,name); - name="sc"+nm; - Pt=[0,0]; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - tmp1=tmp_6; - if(length(tmp1)>0, - Pt=Lcrd(tmp1_1); - ); - pdata=plist; - if(isstring(pdata),pdata=[pdata]); - if(!isstring(pdata_1) & MeasureDepth(pdata)==1, - pdata=[pdata]; - ); - Cx=Pt_1; Cy=Pt_2; - PdL=[]; - forall(pdata,Njj, - if(isstring(Njj),Kj=parse(Njj),Kj=Njj); - if(MeasureDepth(Kj)==1,Kj=[Kj]); - tmp2=[]; - forall(Kj,Nj, - tmp1=[]; - forall(Nj, - tmp=LLcrd(#); - X2=Cx+rx*(tmp_1-Cx); - Y2=Cy+ry*(tmp_2-Cy); - tmp1=concat(tmp1,[[X2,Y2]]); - ); - tmp2=concat(tmp2,[tmp1]); - ); - PdL=concat(PdL,tmp2); - ); - if(Noflg<3, - println("generate Scaledata "+name); - tmp1=[]; - forall(PdL,tmp2, - tmp=apply(tmp2,Pcrd(#)); - tmp1=append(tmp1,tmp); - ); - if(length(tmp1)==1,tmp1=tmp1_1); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=text(plist); - tmp1=RSform(tmp1); // 17.12.23 - tmp=name+"=Scaledata("+tmp1+"," - +textformat(rx,5)+","+textformat(ry,5)+","+RSform(textformat(Pt,5))+")"; - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - PdL; -); - -Reflectdata(nm,plist,symL):=Reflectdata(nm,plist,symL,[]); -Reflectdata(nm,plist,symL,options):=( -//help:Reflectdata("1","crAB",[C]); - regional(tmp,tmp1,tmp2,pdata,Us,Vs,Pt1,Pt2,Cx,Cy,PdL, - opcindy,Nj,Njj,Kj,X1,Y1,X2,Y2,Ltype,Noflg,name); - name="re"+nm; - Pt=[0,0]; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opcindy=tmp_(length(tmp)); - pdata=plist; - if(isstring(pdata),pdata=[pdata]); - if(!isstring(pdata_1) & MeasureDepth(pdata)==1, - pdata=[pdata]; - ); - Pt1=Lcrd(symL_1); - if(length(symL)==1, - Pt2=Pt1; - , - Pt2=Lcrd(symL_2); - ); - Us=Pt2_1-Pt1_1; - Vs=Pt2_2-Pt1_2; - PdL=[]; - forall(pdata,Njj, - if(isstring(Njj),Kj=parse(Njj),Kj=Njj); - if(MeasureDepth(Kj)==1,Kj=[Kj]); - tmp2=[]; - forall(Kj,Nj, - tmp1=[]; - forall(Nj, - tmp=LLcrd(#); - X1=tmp_1; - Y1=tmp_2; - if(Pt1==Pt2, - X2=2*Pt1_1-X1; - Y2=2*Pt1_2-Y1; - , - X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1 - -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); - Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1 - +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); - ); - tmp1=concat(tmp1,[[X2,Y2]]); - ); - tmp2=concat(tmp2,[tmp1]); - ); - PdL=concat(PdL,tmp2); - ); - if(Noflg<3, - println("generate Reflectdata "+name); - tmp1=[]; - forall(PdL,tmp2, - tmp=apply(tmp2,Pcrd(#)); - tmp1=append(tmp1,tmp); - ); - if(length(tmp1)==1,tmp1=tmp1_1); - tmp=name+"="+textformat(tmp1,5); - parse(tmp); - tmp1=text(plist); - tmp1=RSform(tmp1);// 17.12.23 - tmp=name+"=Reflectdata("+tmp1+","+RSform(textformat(symL,5))+")";//17.12.23 - GLIST=append(GLIST,tmp); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - PdL; -); - -Mksegments():=Mksegments([]); -Mksegments(options):=( -//help:Mksegments(); - regional(segstr,p,q,r,tmp1,tmp2,tmp3); - forall(allsegments(),seg, - str=text(inspect(seg,"definition")); - tmp1=indexof(str,"("); - tmp2=indexof(str,";"); - tmp3=indexof(str,")"); - p=substring(str,tmp1,tmp2-1); - q=substring(str,tmp2,tmp3-1); - Listplot([parse(p),parse(q)]); - ); -); - -Mkcircles():=Mkcircles([]); -Mkcircles(options):=( -//help:Mkcircles(): - regional(seg,cir,str,p,q,r,tmp1,tmp2,tmp3,tmp4); - forall(allcircles(),cir, - str=text(inspect(cir,"definition")); - tmp1=indexof(str,"("); - tmp2=indexof(str,";"); - tmp3=indexof(str,")"); - tmp4=indexof(str,";",tmp2+1); - if(tmp4==0, - p=substring(str,tmp1,tmp2-1); - q=substring(str,tmp2,tmp3-1); - Circledata([parse(p),parse(q)]); - , - p=substring(str,tmp1,tmp2-1); - q=substring(str,tmp2,tmp4-1); - r=substring(str,tmp4,tmp3-1); - Circledata([parse(p),parse(q),parse(r)]); - ); - ); -); - -MakeRarg(arglist):=( - regional(str,tmpstr); - str=""; - forall(arglist, - if(isstring(#), - tmpstr=Dq+RSslash(#)+Dq; - , - tmpstr=textformat(#,6); - ); - str=str+tmpstr+","; - ); - str=substring(str,0,length(str)-1); - str; -); - -Setax(arglist):=( -//help:Setax(["l","x","e","y","n","O","sw"]); -//help:Setax([7,"nw"]); - regional(tmp); - tmp=MakeRarg(arglist); - Com1st("Setax("+tmp+")"); -); - -Htickmark(arglist):=( -//help:Htickmark([1,"1",2,"sw","2"]); - regional(tmp); - tmp=""; - tmp=MakeRarg(arglist); - Com2nd("Htickmark("+tmp+")"); -); - -Vtickmark(arglist):=( -//help:Vtickmark([1,"1",2,"sw","2"]); - regional(tmp); - tmp=MakeRarg(arglist); - Com2nd("Vtickmark("+tmp+")"); -); - -Vtick(py):=Vtick(py,MARKLEN,[]); -Vtick(py,len):=Vtick(py,len,[]); -Vtick(py,len,options):=( -//help:Vtick(1,0.1,options); - regional(tmp,tmp1,tmp2); - tmp="v"+text(round(py*100)); - tmp=replace(tmp,"-","m"); - tmp1=[0-len/2,py]; - tmp2=[0+len/2,py]; - Listplot(tmp,[tmp1,tmp2],options); -); - -Htick(px):=Htick(px,MARKLEN,[]); -Htick(px,len):=Htick(px,len,[]); -Htick(px,lenorg,options):=( -//help:Htick(-1,0.1,options); - regional(len,tmp,tmp1,tmp2); - tmp=LLcrd([0,lenorg]); - len=tmp_2; - tmp="h"+text(round(px*100)); - tmp=replace(tmp,"-","m"); - tmp1=[px,0-len/2]; - tmp2=[px,0+len/2]; - Listplot(tmp,[tmp1,tmp2],options); -); - -Drwxy():=( -//help:Drwxy(); - Com2nd("Drwxy()"); - Addax(0); // 16.01.21 -); - -Drwpt(pstr):=Drawpoint(pstr); -Drwpt(ptlist,nn):=( // 16.03.05 from -//help:Drwpt(A); -//help:Drwpt("[1,1],0"); -//help:Drwpt(A,0); -//help:Drwpt([1,2],0); - Drawpoint(ptlist,nn); -); -Drawpoint(pstr):=( - if(isstring(pstr), - println("Drwpt : "+pstr); - Com2nd("Drwpt("+pstr+")"); - , - Drawpoint(pstr,1); - ); -); -Drawpoint(ptlistorg,nn):=( - regional(ptlist,thick,tmp,tmp1); - println("Drwpt : "+text(ptlistorg)); - if(islist(ptlistorg), - if(MeasureDepth(ptlistorg)==1, - ptlist=ptlistorg - , - ptlist=[ptlistorg] - ); - , - ptlist=[ptlistorg] - ); - thick=PenThick/PenThickInit;// 16.04.09 from - tmp1=max(TenSize/TenSizeInit,1)/8; - Setpen(tmp1); // 16.04.09 upto - forall(ptlist, - tmp=textformat(#,5)+","+text(nn); - Com2nd("Drwpt("+tmp+")"); // 16.04.09 - ); - Setpen(thick); // 16.04.09 -);// 16.03.05 upto - -Addax(param):=( -//help:Addax(0); - ADDAXES=textformat(param,5); -); - -Expr(Pt,Dr,St):=Expr([Pt,Dr,St]); -Expr(list):=Expr(list,[]); -Expr(listorg,options):=( //16.10.09 -//help:Expr([A,"e","f(x)=x^2"]); - regional(list,str,tmp,tmp1,tmp2); - list=listorg; - forall(1..round(length(list)/3), - str=list_(3*#); - if(!isstring(str),str=format(str,5)); - str="$"+str+"$"; - list_(3*#)=str; - ); - Letter(list,options); -); - -Letter(Pt,Dr,St):=Letter([Pt,Dr,St]); -Letter(list):=Letter(list,[]); -Letter(list,options):=( -//help:Letter([C,"c","Graph of f(x)"]); - regional(Nj,Pos,Dir,Str,Off,Dmv,Xmv,Ymv,Noflg,opcindy, - opL,aln,sz,clr,bld,ita,tmp,tmp1,tmp2); - tmp=Divoptions(options); - Noflg=tmp_2; - opL=select(options,indexof(#,"->")>0); //16.10.09from - tmp=select(opL,indexof(#,"color")); - size=12; - clr=[0,0,0]; - bld=false; - ita=false; - aln="left"; - forall(opL, - tmp=indexof(#,"->"); - tmp1=removespace(substring(#,0,tmp-1)); - tmp2=substring(#,tmp+1,length(#)); - if(tmp1=="size",sz=parse(tmp2)); - if(tmp1=="color",clr=parse(tmp2)); - if(tmp1=="bold",bld=parse(tmp2)); - if(tmp1=="ita",ita=parse(tmp2)); - );//16.10.09upto - Off=-4; - Dmv=8; - Nj=1; - while(Nj+2<=length(list), -// Pos=textformat(list_Nj,5); - Pos=list_Nj; - Dir=list_(Nj+1); - tmp=indexof(Dir,"s")+indexof(Dir,"n");//16.10.19from - if(tmp>0, - tmp=indexof(Dir,"w")+indexof(Dir,"e"); - if(tmp==0, - Dir="c"+Dir;//16.10.08 - ); - );//16.10.19upto - Str=list_(Nj+2); - if(!isstring(Str),Str=format(Str,5)); // 16.09.30,10.09 - tmp=replace(Str,".xy",""); - tmp=replace(tmp,".x","(1)"); - Str=replace(tmp,".y","(2)"); - Str=RSslash(Str); // 17.09.24 - if(indexof(Str,"`")>0, -// tmp=Dq+",Assign('"+Str+"','`',Prime()))"; - tmp=Dq+",Assign('"+Str+"'))"; // 15.02.22 - , - tmp=Dq+","+Dq+Str+Dq+")"; - ); - if(Noflg==0, - Com2nd("Letter("+Lcrd(Pos)+","+Dq+Dir+tmp);//16.10.10 - ); - if(Noflg<2, - Xmv=0;//16.10.13 - Ymv=-4; - if(indexof(Dir,"n")>0, - Ymv=Dmv/2; - ); - if(indexof(Dir,"s")>0, - Ymv=-Dmv*3/2;//16.10.13 - ); - if(indexof(Dir,"e")>0, - Xmv=Dmv/2; - Off=0; - aln="left"; - ); - if(indexof(Dir,"w")>0, - Xmv=-Dmv/2; - Off=0; // 16.09.30from - aln="right"; - ); - if(indexof(Dir,"c")>0, - Xmv=0;//16.10.13 - Off=0; - if(Ymv==0,Ymv=-4);//16.10.08 - aln="mid"; // 16.09.30upto - ); - Str=list_(Nj+2); //17.10.17 - drawtext(Pcrd(Pos),Str,offset->[Off+Xmv,Off+Ymv], - size->sz,color->clr,align->aln,bold->bld,italics->ita);//16.10.09 - ); - Nj=Nj+3; - ); -); - -Letterrot(pt,dir,str):=Letterrot(pt,dir,0,0,str); -Letterrot(pt,dir,movstr,str):=( -//help:Letterrot(C,B-A,"AB"): -//help:Letterrot(C,B-A,0,5,"AB"): -//help:Letterrot(C,B-A,"t0n5","AB"): - regional(tmov,nmov,tmp,tmp1,tmp2); - tmp1=indexof(movstr,"t"); - tmp2=indexof(movstr,"n"); - if(tmp1>0, - if(tmp2>0,tmp=tmp2-1,tmp=length(movstr)); - tmov=parse(substring(movstr,tmp1,tmp)); - , - tmov=0; - ); - if(tmp2>0, - nmov=parse(substring(movstr,tmp2,length(movstr))); - , - nmov=0; - ); - Letterrot(pt,dir,tmov,nmov,str); -); -Letterrot(pt,dir,tmov,nmov,str):=( - regional(tmp); - Letter([pt,"c",str],["notex"]); - tmp=replace(str,"\","\\"); //17.10.18 - Com2nd("Letterrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')"); -); - -Exprrot(pt,dir,str):=Exprrot(pt,dir,0,0,str); -Exprrot(pt,dir,movstr,str):=( -//help:Exprrot(C,B-A,"d"): -//help:Exprrot(C,B-A,0,5,"d"): -//help:Exprrot(C,B-A,"t0n5","d"): - regional(tmov,nmov,tmp,tmp1,tmp2); - tmp1=indexof(movstr,"t"); - tmp2=indexof(movstr,"n"); - if(tmp1>0, - if(tmp2>0,tmp=tmp2-1,tmp=length(movstr)); - tmov=parse(substring(movstr,tmp1,tmp)); - , - tmov=0; - ); - if(tmp2>0, - nmov=parse(substring(movstr,tmp2,length(movstr))); - , - nmov=0; - ); - Exprrot(pt,dir,tmov,nmov,str); -); -Exprrot(pt,dir,tmov,nmov,str):=( - regional(tmp); - Expr([pt,"c",str],["notex"]); - tmp=replace(str,"\","\\"); //17.10.18 - Com2nd("Exprrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')"); -); - -Putslider(ptstr,p1,p2):=Slider(ptstr,p1,p2); -Slider(ptstr,p1,p2):=( //17.04.11 -//help:Slider("A-C-B",[-3,0],[3,0]); - regional(pA,pB,pC,seg,sname,Alpha,tmp,tmp1); - tmp=indexall(ptstr,"-"); - pA=substring(ptstr,0,tmp_1-1); - pC=substring(ptstr,tmp_1,tmp_2-1); - pB=substring(ptstr,tmp_2,length(ptstr)); - seg=pA+pB; - Alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZ"; - sname=""; - forall(1..(length(seg)), - tmp=substring(seg,#-1,#); - tmp1=indexof(Alpha,tmp); - if(tmp1>0, - sname=sname+unicode(text(tmp1+96),base->10); - , - sname=sname+tmp; - ); - ); - Putpoint(pA,p1); - Putpoint(pB,p2); - Listplot([parse(pA),parse(pB)],["notex","color->[0,0.4,0.4]","size->2"]); -// create([sname],"Segment",[parse(pA),parse(pB)]); -// tmp2=Listplot("",[p1,p2],["nodata"]); - Putonseg(pC,parse("sg"+pA+pB)); -// create([pC],"PointOn",[parse(sname),0.5]); -); - -Putpoint(name,Pt):=Putpoint(name,Pt,Pt); -Putpoint(name,Ptinit,Pt):=( -//help:Putpoint("A",[1,2],[1,A.y]); - regional(ptstr); - ptstr=apply(allpoints(),#.name);//16.10.06 - if(!contains(ptstr,name), - createpoint(name,Pcrd([Ptinit_1,Ptinit_2])); - , - ptstr=name+".xy="+textformat(Pcrd(Pt),5); - parse(ptstr); - ); -); - -Bezierpt(t,ptlist,ctrlist):=( - regional(flg3,p0,p1,p2,p3,p4,p5,p6,p7,p8,p9); - p0=ptlist_1; - p3=ptlist_2; - p1=ctrlist_1; - if(length(ctrlist)==1, - p2=p3; - flg3=0; - , - p2=ctrlist_2; - flg3=1; - ); - if(length(p0)<3, // 15.02.08 - p0=Lcrd(p0); - p3=Lcrd(p3); - p1=Lcrd(p1); - p2=Lcrd(p2); - ); - p4=(1-t)*p0+t*p1; - p5=(1-t)*p1+t*p2; - p6=(1-t)*p2+t*p3; - p7=(1-t)*p4+t*p5; - p8=(1-t)*p5+t*p6; - p9=(1-t)*p7+t*p8; - if(flg3==0,p7,p9); -); - -Bezier(ptctrlist):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,[]); -Bezier(ptctrlist,options):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,options); -Bezier(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]); -Bezier(nm,ptlist,ctrlist,options):=BezierCurve(nm,ptlist,ctrlist,options); -BezierCurve(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]); -BezierCurve(nm,ptlistorg,ctrlistorg,options):=( -//help:Bezier("1",[A,D],[B,C]); -//help:Bezier(options=["Num=10"]); - regional(name,Ltype,Noflg,opstr,opcindy,Num, - ptlist,ctrlist,tmp,tmp1,tmp2,ii,st,out,list); - name="bz"+nm; - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - Num=10; - tmp1=tmp_5; - forall(tmp1, // 14.12.31 - if(substring(#,0,1)=="N", - tmp2=indexof(#,"="); - Num=parse(substring(#,tmp2,length(#))); - opstr=opstr+","+Dq+#+Dq; - ); - ); - ptlist=apply(ptlistorg,Lcrd(#)); // 16.08.16 - ctrlist=[]; // 14.12.31 - if(length(ctrlistorg)==length(ptlist)-1, - forall(ctrlistorg,tmp1, - if(MeasureDepth(tmp1)==0,tmp=[tmp1],tmp=tmp1); - tmp=apply(tmp,Lcrd(#)); // 16.08.16 - ctrlist=append(ctrlist,tmp); - ); - , - forall(1..(length(ptlist)-1),ii, - tmp=ctrlistorg_((2*ii-1)..(2*ii)); - tmp=apply(tmp,Lcrd(#)); // 16.08.16 - ctrlist=append(ctrlist,tmp); - ); - ); - if(!islist(Num), - Num=apply(ctrlist,Num); - ); - list=[]; - forall(1..(length(ptlist)-1),ii, - tmp1=ptlist_(ii..(ii+1)); - tmp2=ctrlist_ii; - if(ii==1,st=0,st=1); - forall(st..Num_ii, - tmp=Bezierpt(#/Num_ii,tmp1,tmp2); - list=append(list,tmp); - ); - ); - if(Noflg<3, - println("generate Bezier "+name); - out=apply(list,Pcrd(#)); - tmp=name+"="+textformat(out,5); - parse(tmp); - tmp1=textformat(ptlist,5); - tmp1=RSform(tmp1,2); //17.12.23 - tmp2=textformat(ctrlist,5); - tmp2=RSform(tmp2,3); //17.12.23 - GLIST=append(GLIST,name+"=Bezier("+tmp1+","+tmp2+opstr+")"); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - list; -); - -Readcsvsla(fname):=Readplotdigdata(fname,[]); -Readcsvsla(fname,options):=Readplotdigdata(fname,options); -Readplotdigdata(fname):=Readplotdigdata(fname,[]); -Readplotdigdata(fname,options):=( - regional(fsc,mv,cmdall,dataL,nd,npt,ptdata,ii,tmp,tmp1,tmp2,tmp3); - tmp=Divoptions(options); - tmp1=tmp_6; - sc=1;//10; - mv=[0,0];//[5,5]; - forall(tmp1, - if(!islist(#),sc=#,mv=#); - ); - if(indexof(fname,".")>0, - tmp=load(fname); - , - tmp=load(fname+".txt"); - ); - cmdall=tokenize(tmp,"//"); - dataL=[]; - forall(2..length(cmdall),ii, - tmp1=parse("["+cmdall_ii+"]"); - dataL=append(dataL,tmp1); - ); - if(length(dataL_(length(dataL)))<2, - dataL=dataL_(1..(length(dataL)-1)); - ); - nd=length(dataL_1)/2; - npt=length(dataL); - ptdata=[]; - forall(1..nd,ii, - tmp3=[]; - forall(1..npt, - tmp1=dataL_#_(2*ii-1); - tmp2=dataL_#_(2*ii); - if(isreal(tmp1), - tmp3=append(tmp3,[tmp1,tmp2]); - ); - ); - ptdata=append(ptdata,tmp3); - ); - tmp1=[]; - forall(ptdata, - tmp=#/sc; - tmp=Translatedata("1",[tmp],-mv,["nodata"]); - tmp1=append(tmp1,tmp); - ); - ptdata=tmp1; - ptdata; -); - -Putbezierdata(name,ptL):=Putbezierdata(name,ptL,[]); -Putbezierdata(name,ptL,options):=( - regional(psize,Deg,tmp,tmp1,tmp2,p1,p2,pts,ctrs); - tmp=Divoptions(options); - psize=3; - Deg=3; - tmp1=tmp_5; - forall(tmp1, - if(substring(#,0,1)=="D", - tmp=indexof(#,"="); - Deg=parse(substring(#,tmp,length(#))); - ); - if(substring(#,0,1)=="S", - tmp=indexof(#,"="); - psize=parse(substring(#,tmp,length(#))); - ); - ); - pts=[]; - ctrs=[]; - forall(1..length(ptL), - p2=ptL_#; // 16.08.16 - if(ispoint(p2), - tmp1=text(p2); - , - tmp1=name+text(#); - Putpoint(tmp1,p2,Lcrd(parse(tmp1))); // 16.08.16 - ); - inspect(parse(tmp1),"ptsize",psize); - pts=append(pts,parse(tmp1)); - inspect(parse(tmp1),"color",4); - if(#>1, - p1=Lcrd(ptL_(#-1)); // 16.08.16 - p2=Lcrd(ptL_#); // 16.08.16 - if(Deg==3, - tmp=(2*p1+p2)/3; - tmp1=name+"p"+text(#-1); - Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16 - inspect(parse(tmp1),"labeled",false); //15.01.22 - Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22 - inspect(parse(tmp1),"ptsize",psize); - inspect(parse(tmp1),"color",3); - tmp=(p1+2*p2)/3; - tmp2=name+"q"+text(#-1); - Putpoint(tmp2,tmp,Lcrd(parse(tmp2))); // 16.08.16 - inspect(parse(tmp2),"labeled",false); //15.01.22 - Letter([parse(tmp2),"ne",tmp2],["notex"]); //15.01.22 - inspect(parse(tmp2),"ptsize",psize); - inspect(parse(tmp2),"color",3); - ctrs=append(ctrs,[parse(tmp1),parse(tmp2)]); - , - tmp=(p1+p2)/2; - tmp1=name+"p"+text(#-1); - Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16 - inspect(parse(tmp1),"labeled",false); //15.01.22 - Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22 - inspect(parse(tmp1),"ptsize",psize); - inspect(parse(tmp1),"color",3); - ctrs=append(ctrs,[parse(tmp1)]); - ); - ); - ); - [pts,ctrs,name]; -); - -Bezierstart(n):=( // 2016.02.26 - BezierNumber=n; -); - -Mkbezierptcrv(ptdata):=Mkbezierptcrv(ptdata,[]); -Mkbezierptcrv(ptdata,options):=( - //help:Mkbezierptcrv([A,B,C,D]); - //help:Mkbezierptcrv([[A,B],[C,D]]); - //help:Mkbezierptcrv(options=["Num=10"]); - // global BezierNumber - regional(ptlist,Out,tmp,tmp1,tmp2); - if(isstring(ptdata), - ptlist=Readcsvsla(ptdata,options); - , - ptlist=ptdata; - ); - if(MeasureDepth(ptlist)==1,ptlist=[ptlist]); - Out=[]; - forall(1..length(ptlist), - tmp=floor((BezierNumber-1)/26);// 15.02.23 - if(tmp==0,tmp="",tmp=text(tmp)); - tmp2=mod(BezierNumber,26); - if(tmp2==0,tmp2=26); - tmp1=unicode(text(96+tmp2),base->10)+tmp;// 15.03.11 - tmp2=Putbezierdata(tmp1,ptlist_#,options); - Bezier(tmp2,options); - BezierNumber=BezierNumber+1; - Out=append(Out,tmp2_(1..2)); - ); - Out; -); - -Mkbeziercrv(nm,ptctrL):=Mkbeziercrv(nm,ptctrL,[]); -Mkbeziercrv(nm,ptctrL,options):=( - //help:Mkbeziercrv("1",[[A,B,C,D],[[P,Q],[R,S],T]]); - regional(ptctrLL,name,ptlist,ctrlist,tmp,tmp1,tmp2); - if(MeasureDepth(ptctrL)==2,ptctrLL=[ptctrL],ptctrLL=ptctrL); - forall(1..length(ptctrLL), - name=nm+text(#); - ptlist=ptctrLL_#_1; - ctrlist=ptctrLL_#_2; - Bezier(nm,ptlist,ctrlist,options); // 17.01.06 - ); -); - -Writebezier():=Writebezier(Fhead,"all"); -Writebezier(head):=Writebezier(head,"all"); -Writebezier(head,seL):=( -//help:Writebezier(file); -//help:Writebezier(file,"acd"); - regional(bz,dt,name,tmp,tmp1,tmp2); - bz=select(GLIST,indexof(#,"=Bezier")>0); - tmp1=[]; // 16.04.22from - if(seL!="all", - forall(1..length(seL), - tmp=substring(seL,#-1,#); - tmp=select(bz,indexof(#,"bz"+tmp)>0); - tmp1=concat(tmp1,tmp); - ); - bz=tmp1;// 16.04.22upto - ); - dt=[head+"n",[[length(bz),0]]]; - forall(1..length(bz), - tmp=indexof(bz_#,"="); - name=substring(bz_#,0,tmp-1); - tmp=indexof(bz_#,","+Dq); - if(tmp>0, - tmp1=substring(bz_#,0,tmp-1)+")"; - , - tmp1=bz_#; - ); - tmp1=replace(tmp1,"Bezier(","["); - tmp1=replace(tmp1,"list(","["); - tmp1=replace(tmp1,")","]"); - tmp1=replace(tmp1,",",".xy,"); - tmp1=replace(tmp1,"]",".xy]"); - tmp1=replace(tmp1,".xy,[",",["); - tmp1=replace(tmp1,"].xy","]"); - tmp1=replace(tmp1,name,head+text(#)); - parse(tmp1); - tmp=parse(head+text(#)+"_1"); - dt=concat(dt,[head+text(#)+"k",tmp]); - tmp=parse(head+text(#)+"_2"); - dt=concat(dt,[head+text(#)+"c",tmp]); - ); - WriteOutData(head+".txt",dt); - dt; -); - -Readbezier(file):=Readbezier(file,[]); -Readbezier(file,optionorg):=( -//help:Readbezier("xsr"); -//help:Readbezier(options=["Num=10","nogeo"]); - regional(nn,options,stL,geo,nc,alpha,out,tmp,tmp1,tmp2,tmp3); - options=optionorg; - tmp=Divoptions(options); - stL=tmp_7; - geo=0; - forall(stL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="G",geo=1); - options=remove(options,[#]); - ); - ReadOutData(file); - tmp=file+"n_1_1"; - nn=parse(tmp); - out=[]; - forall(1..nn,nc, - tmp=file+text(nc); - tmp1=parse(tmp+"k"); - tmp2=parse(tmp+"c"); - if(MeasureDepth(tmp2)==1,tmp2=[tmp2]); // 16.04.22from - if(geo==1, - alpha="abcdefghijklmnopqrstuvwxyz"; - forall(1..length(tmp1), - tmp="k"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#); - Putpoint(tmp,tmp1_#,parse(tmp+".xy")); - inspect(parse(tmp),"labeled",false); - inspect(parse(tmp),"ptsize",3); - tmp1_#=parse(tmp+".xy"); - ); - forall(1..length(tmp2), - tmp="c"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#)+"1"; - Putpoint(tmp,tmp2_#_1,parse(tmp+".xy")); - inspect(parse(tmp),"labeled",false); - inspect(parse(tmp),"color",4); - inspect(parse(tmp),"ptsize",3); - tmp2_#_1=parse(tmp+".xy"); - tmp="c"+BezierNumber+"no"+text(nc)+substring(alpha,#-1,#)+"2"; - Putpoint(tmp,tmp2_#_2,parse(tmp+".xy")); - inspect(parse(tmp),"labeled",false); - inspect(parse(tmp),"color",4); - inspect(parse(tmp),"ptsize",3); - tmp2_#_2=parse(tmp+".xy"); - ); - BezierNumber=BezierNumber+1; - ); - Bezier(file+text(nc),tmp1,tmp2,options);// 16.04.22upto - out=append(out,"bz"+tmp); - ); - out; -); - -Ospline(nm,ptlist):=Ospline(nm,ptlist,[]); -Ospline(nm,ptlist,options):=( -//help:Ospline("1",ptlist,[options]); - regional(tmp,tmp1,tmp2,list,ptL,ctrL,name,closed,flg, - p0,p1,p2,p3,pQ,pR,cc,p01,p02,p11,p12,p21,p22,p31,p32); - name="o"+nm; - if(isstring(ptlist),list=parse(ptlist),list=ptlist); - if(|list_1-list_(length(list))|<10^(-6),closed=1,closed=0); -// list=apply(list,LLcrd(#)); - ctrL=[]; - forall(1..(length(list)-1), - flg=0; - p1=Lcrd(list_#); // 16.08.16 - p2=Lcrd(list_(#+1)); // 16.08.16 - if(#==1 % #==length(list)-1, - flg=1; - if(closed==0, - pQ=(p1+2*p2)/3; // 15.09.21 // 16.08.16 - pR=(2*p1+p2)/3; // 16.08.16 - ctrL=append(ctrL,[pQ,pR]); - flg=2; - , - if(#==1, - p0=Lcrd(list_(length(list)-1)); // 16.08.16 - p3=Lcrd(list_(#+2)); // 16.08.16 - , - p0=Lcrd(list_(#-1)); // 16.08.16 - p3=Lcrd(list_2); // 16.08.16 - ); - ); - ); - if(flg<=1, - if(flg==0, - p0=Lcrd(list_(#-1)); // 16.08.16 - p3=Lcrd(list_(#+2)); // 16.08.16 - ); - tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2); - cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp; - pQ=p1+cc*(p2-p0); // 15.09.21 // 16.08.16 - pR=p2+cc*(p1-p3); // 16.08.16 - ctrL=append(ctrL,[pQ,pR]); - ); - ); -// list=apply(list,LLcrd(#)); // 16.08.16 -// ctrL=apply(ctrL,LLcrd(#)); - if(closed==0, // 15.09.21 - p1=ctrL_2_1; - p2=Lcrd(list_2); // 16.08.16 - pQ=p2+(p2-p1); - ctrL_1=[pQ]; - tmp=length(ctrL); - tmp1=ctrL_(tmp-1); - p1=ctrL_(tmp-1)_2; - p2=Lcrd(list_(tmp)); // 16.08.16 - pQ=p2+(p2-p1); - ctrL_tmp=[pQ]; - ); - Bezier("o"+nm,list,ctrL,options); -); - -CRspline(nm,ptL):=CRspline(nm,ptL,[]); -CRspline(nm,ptL,options):=( - // Catmull-Rom spline -//help:CRspline("1",[A,B,C,A]); - regional(name,ptlist,ctrpts,eqL,opcindy,c,v,tmp,tmp1,tmp2,ctrlist,cflg); - name="crsp"+nm; - if(MeasureDepth(ptL)==1,tmp=[ptL],tmp=ptL); - ptlist=tmp_1; - if(length(tmp)==1, - cflg=1; - , - cflg=0; - ctrpts=tmp_2; - ); - c=1/6; - tmp=Divoptions(options); - eqL=tmp_5; - opcindy=tmp_(length(tmp)); // 15.03.05 - forall(eqL, - if(substring(#,0,1)=="R", - tmp2=indexof(#,"="); - c=parse(substring(#,tmp2,length(#))); - ); - ); - ptlist=apply(ptlist,Lcrd(#)); // 16.08.16 - ctrlist=[]; - forall(1..(length(ptlist)-1), - if(#==1, - if(cflg==0, - tmp1=ctrpts_1; - , - v=ptlist_2-ptlist_(length(ptlist)-1); - tmp1=ptlist_#+c*v; - ); - , - v=ptlist_(#+1)-ptlist_(#-1); - tmp1=ptlist_#+c*v; - ); - if(#==length(ptlist)-1, - if(cflg==0, - tmp2=ctrpts_2; - , - v=ptlist_2-ptlist_#; - tmp2=ptlist_(#+1)-c*v; - ); - , - v=ptlist_(#+2)-ptlist_#; - tmp2=ptlist_(#+1)-c*v; - ); - tmp=select(options,indexof(text(#),"->")>0); - tmp=append(tmp,"notex"); //15.03.05 - Pointdata(name+text(#),[tmp1,tmp2],tmp); - ctrlist=append(ctrlist,[tmp1,tmp2]); - ); - Bezier(nm,ptlist,ctrlist,options); -); - -Beziersmooth(nm,ptL):=Bzspline(nm,ptL,[]); -//help:Beziersmooth("1",[A,B,C,A]); -Beziersmooth(nm,ptL,options):=Bzspline(nm,ptL,options); -Bzspline(nm,ptL):=Bzspline(nm,ptL,[]); -Bzspline(nm,ptLorg,options):=( - // smooth bezier - regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr, - tmp,tmp1,tmp2,cflg,ctrlist); - name="bzsp"+nm; - Eps=10^(-3); - ptL=apply(ptLorg,Lcrd(#)); // 16.08.16 - if(|ptL_1-ptL_(length(ptL))|1 % cflg==1, - tmp1="c"+text(#); - inspect(parse(tmp1),"alpha",0.3); - ); - tmp1="C"+text(#)+"p"; - tmp2="C"+text(#)+"q"; - inspect(parse(tmp1),"ptsize",3); - inspect(parse(tmp1),"color",3); - inspect(parse(tmp2),"ptsize",3); - inspect(parse(tmp2),"color",3); - tmp=[parse(tmp1),parse(tmp2)]; - ctrlist=append(ctrlist,tmp); - ); - Bezier(nm,ptL,ctrlist,options); - [ptL,ctrlist]; -); - -Beziersym(nm,ptL):=Bzsspline(nm,ptL,[]); -Beziersym(nm,ptL,options):=Bzsspline(nm,ptL,options); -Bzsspline(nm,ptL):=Bzsspline(nm,ptL,[]); -Bzsspline(nm,ptLorg,options):=( - // smooth bezier with symmetric control points - regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr, - tmp,tmp1,tmp2,cflg,ctrlist); - name="bzssp"+nm; - Eps=10^(-3); - ptL=apply(ptLorg,Lcrd(#)); // 16.08.16 - if(|ptL_1-ptL_(length(ptL))|Eps, - pcl=list; - pcl_1=2*list_1-list_2; - pcl_k=2*list_k-list_(k-1); - , - pcl=concat(list,[list_2]); - ); - ctrl=apply(2..(length(pcl)-1),[pcl_#]); - ptl=apply(1..(length(pcl)-1),(pcl_#+pcl_(#+1))/2); - [ptl,ctrl]; -); - -Bspline(nm,ctrL):=Bspline(nm,ctrL,[]); -Bspline(nm,ctrL,options):=( -//help:Bspline("",[A,B,C]); - regional(list,tmp); - list=Listbspline2bz(ctrL); - tmp=BezierCurve("b"+nm,list_1,list_2,options); - tmp; -); - -MeetCurve(Crv,Xorg,Yorg):=( - regional(Cv,tmp,tmp1,tmp2,X0,Y0,x1,x2,y1,y2,Ylist,Ban,Tate); - if(isstring(Crv),Cv=parse(Crv),Cv=Crv); - if(MeasureDepth(Cv)==2,Cv=Cv_1); - Cv=apply(Cv,LLcrd(#)); // 14.12.18 - while(length(Cv)==1, - Cv=Cv_1; - ); - Cv=apply(Cv,Lcrd(#)); - tmp1=min(apply(Cv,#_1)); - tmp2=max(apply(Cv,#_1)); - if(isstring(Xorg),X0=parse(Xorg),X0=Xorg); - if(isstring(Yorg),Y0=parse(Yorg),Y0=Yorg); - if(X0tmp2, - X0=tmp2; - ); - ); - tmp1=select( - 1..(length(Cv)-1),Cv_#_1<=X0 & X0<=Cv_(#+1)_1); - tmp2=select( - 1..(length(Cv)-1),Cv_#_1>=X0 & X0>=Cv_(#+1)_1); - tmp2=remove(tmp2,common(tmp2,tmp1)); - Ban=concat(tmp1,tmp2); - Tate=select(Ban, - abs(Cv_#_1-Cv_(#+1)_1)<= - 10^(-2)*abs(Cv_#_2-Cv_(#+1)_2) - ); - Ban=remove(Ban,Tate); - Ylist=[]; - forall(Ban, - tmp=Cv_#; - x1=tmp_1; y1=tmp_2; - tmp=Cv_(#+1); - x2=tmp_1; y2=tmp_2; - tmp=((x2-X0)*y1+(X0-x1)*y2)/(x2-x1); - Ylist=append(Ylist,tmp); - ); - forall(Tate, - tmp=Cv_#; - x1=tmp_1; y1=tmp_2; - tmp=Cv_(#+1); - x2=tmp_1; y2=tmp_2; - tmp1=min([y1,y2]); - tmp2=max([y1,y2]); - if(Y0tmp2, - tmp=tmp2; - , - tmp=Y0; - ); - ); - Ylist=append(Ylist,tmp); - ); - tmp=sort(Ylist,abs(#_1-Y0)); - [X0,tmp_1]; -); - -PutonLine(name,p1,p2):=PutonLine(name,p1,p2,[]); -PutonLine(name,p1org,p2org,options):=( -//help:PutonLine("C","sgAB"); -//help:PutonLine("C",pA,pB); - regional(par,p1,p2,dx,dy,tmp,tmp1,tmp2); - par=0.5; - tmp=Divoptions(options); - if(length(tmp_6)>0, - par=tmp_6_1; - ); - p1=Lcrd(p1org);//16.10.11from - p2=Lcrd(p2org); - dx=p2_1-p1_1; - dy=p2_2-p1_2; - tmp1=(1-par)*p1+par*p2; - if(abs(dx)>abs(dy), - tmp=name+".x"; - tmp2="["+tmp+",dy/dx*("+tmp+"-p1_1)+p1_2]";//16.10.11upto - Putpoint(name,tmp1,parse(tmp2)); - , - if(abs(dy)>0, - tmp=name+".y"; - tmp2="[dx/dy*("+tmp+"-p1.y)+p1_1,"+tmp+"]"; - Putpoint(name,tmp1,parse(tmp2)); - , - tmp2=p1;//16.10.11 - Putpoint(name,tmp1,tmp2); - ); - ); -); - -PutonSeg(name,sgstr):=( - regional(seg,p1,p2); - if(isstring(sgstr),seg=parse(sgstr),seg=sgstr); - PutonSeg(name,LLcrd(seg_1),LLcrd(seg_2)); -); -PutonSeg(name,p1,p2):=PutonSeg(name,p1,p2,[]); -PutonSeg(name,p1org,p2org,options):=( -//help:PutonSeg("C","sgAB"); -//help:PutonSeg("C",pA,pB); - regional(par,dx,dy,p,tmp,tmp1,tmp2); - par=0.5; - tmp=Divoptions(options); - if(length(tmp_6)>0, - par=tmp_6_1; - ); - p1=Lcrd(p1org);//16.10.11from - p2=Lcrd(p2org); - PutonLine(name,p1,p2,[par]); - dx=p2_1-p1_1; - dy=p2_2-p1_2; - p=parse(name+".xy"); - p=LLcrd(p); - if(abs(dx)>abs(dy) & (p_1-p1_1)*(p_1-p2_1)>0, - if(|p-p1|<|p-p2|, - parse(name+".xy=Pcrd(p1)"); - , - parse(name+".xy=Pcrd(p2)"); - ); - ); - if(abs(dx)0, - if(|p-p1|<|p-p2|, - parse(name+".xy=Pcrd(p1)"); - , - parse(name+".xy=Pcrd(p2)");//16.10.11upto - ); - ); -); - -PutonCurve(pn,crv):=PutonCurve(pn,crv,[]); -PutonCurve(pn,crv,options):=( -//help:PutonCurve("A","gr1"); - regional(Pmt,pstr,optionL,leftlim,rightlim,tmp,tmp1,Flg,Msg); - if(!islist(options),optionL=[options],optionL=options); - leftlim=XMIN; - rightlim=XMAX; - Flg=0; - Msg="y"; - forall(optionL, - if(isstring(#), // 16.02.10 from - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,tmp,tmp+1)); - if(tmp1=="N", Msg="n"); // 16.02.10 upto - , - if(Flg==0, - leftlim=#; - Flg=Flg+1; - , - rightlim=#; - ); - ); - ); - Pmt=MeetCurve(crv,leftlim,0); - pstr=apply(allpoints(),textformat(#,5)); // 15.04.07 - if(!contains(pstr,pn), - createpoint(pn,Pcrd(Pmt)); - , - tmp1=parse(pn+".x"); - if(tmp1< leftlim % tmp1>rightlim, - if(tmp1< leftlim,tmp= leftlim, tmp=rightlim); - Pmt=MeetCurve(crv,textformat(tmp,5),pn+".y"); - , - Pmt=MeetCurve(crv,pn+".x",pn+".y"); - ); - ptstr=pn+".xy="+textformat(Pcrd(Pmt),5)+";"; - parse(ptstr); - ); - if(Msg=="y", - println("Put "+pn+" on Curve "+text(crv)); - ); -); - -CrossPoint(name,Crv1,Crv2,range):=( - regional(Mx1,Mx2,Mx3,tmp,Crs1,Crs2,Crs3,Crs4,df1,df2); - Mx1=range_1; Mx2=range_2; - repeat(15, - Mx3=(Mx1+Mx2)/2; - Crs1=MeetCurve(Crv1,Mx1,0); - Crs2=MeetCurve(Crv2,Mx1,0); - Crs3=MeetCurve(Crv1,Mx3,0); - Crs4=MeetCurve(Crv2,Mx3,0); - df1=Crs1_2-Crs2_2; - df2=Crs3_2-Crs4_2; - if((df1>0 & df2>0) % (df1<0 & df2<0), - Mx1=Mx3; - , - Mx2=Mx3; - ); - ); - Putpoint(name,Crs1); -); - -Setscaling(sc):=( -//help:Setscaling(3); - SCALEX=1; - SCALEY=sc; - Com0th("Setscaling("+sc+")"); - Setwindow("Msg=no"); -); - -Periodfun(defL,rep):=Periodfun(defL,rep,[]); -Periodfun(defL,rep,optionorg):=( // 16.11.24 -//help:Periodfun(["0",[-1,0],"1",1,[0,1],1],2(num of repetition),options); -//help:Periodfun(options=["Con=y"]); -//help:Periodfun(defL=[function string, range, devision number,...]); - regional(nn,fun,range,num,options,nr,maxfun, - tmp,tmp1,tmp2,eqL,connect,minx,maxx,pdata,Eps,prept); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - connect="Y"; - forall(eqL, - tmp=indexof(#,"="); - tmp2=substring(#,tmp,tmp+1); - tmp=substring(#,0,3); - if(Toupper(tmp)=="CON", - connect=Toupper(tmp2); - options=remove(options,[#]); - ); - ); - minx=10000; - maxx=-10000; - mxfun=""; - pdata=[]; - forall(1..(length(defL)/3),nn, - fun=defL_(3*nn-2); - range=defL_(3*nn-1); - tmp1=if(isstring(range_1),parse(range_1),range_1); //17.06.11(2lines) - tmp2=if(isstring(range_2),parse(range_2),range_2); - minx=min(minx,tmp1); - maxx=max(maxx,tmp2); - num=defL_(3*nn); - options=append(options,"Num="+text(num)); - Plotdata("pe"+text(nn),fun, - "x="+textformat([tmp1,tmp2],5),options); - pdata=append(pdata,"grpe"+text(nn)); - tmp1=range_1; //17.06.11(4lines) - if(isstring(tmp1),tmp1=replace(tmp1,"pi","%pi"),tmp1=format(tmp1,5)); - tmp2=range_2; - if(isstring(tmp2),tmp2=replace(tmp2,"pi","%pi"),tmp2=format(tmp2,5)); - mxfun=mxfun+"elseif ("+tmp1+ - "<=x and x<"+tmp2+") then "+fun+" "; - ); - per=maxx-minx; - forall(1..rep,nr, - tmp1=[]; - forall(pdata, - Translatedata("p"+#+text(nr),#,[per*nr,0],options); - Translatedata("m"+#+text(nr),#,[-per*nr,0],options); - tmp1=concat(tmp1,["trp"+#+text(nr),"trm"+#+text(nr)]); - ); - ); - pdata=concat(pdata,tmp1); - if(connect=="Y", - Eps=10^(-5); - pdata=sort(pdata,[parse(#)_1_1]); - prept=parse(pdata_1)_1; - forall(1..(length(pdata)), - tmp=parse(pdata_#); - tmp1=tmp_1; - tmp2=tmp_(length(tmp)); - if(|prept-tmp1|>Eps, - Listplot("con"+text(#),[prept,tmp1],append(options,"da")); - ); - prept=tmp_(length(tmp)); - ); - ); - mxfun=substring(mxfun,4,length(mxfun)-1); - [mxfun,per]; -); - -Fourierseries(nm,coeff,per,nterm):= - Fourierseries(nm,coeff,per,nterm,[]); // 16.11.24 -Fourierseries(nm,coeff,per,nterm,options):=( -//help:Fourierseries("1",[c0,cn,sn],period,numterm,options); - regional(c0,cn,sn,fs,tmp,tmp1,tmp2); - c0=coeff_1; - if(!isstring(c0),c0=format(c0,5)); - c0=replace(c0,"%pi","pi"); - cn=coeff_2; - if(!isstring(cn),cn=format(cn,5)); - cn=replace(cn,"%pi","pi"); - sn=coeff_3; - if(!isstring(sn),sn=format(sn,5)); - sn=replace(sn,"%pi","pi"); - fs=c0; - forall(1..nterm, - tmp=parse(Assign(cn,["n",#])); - tmp1=Assign("("+format(tmp,5)+")*cos(n*2*pi/per*x)", - ["n",#,"per",per]); - tmp=parse(Assign(sn,["n",#])); - tmp2=Assign("("+format(tmp,5)+")*sin(n*2*pi/per*x)", - ["n",#,"per",per]); - fs=fs+"+"+tmp1+"+"+tmp2; - ); - Plotdata("four"+nm,fs,"x",options); -); - -Tabledatalight(nm,xLst,yLst,rmvL):=Tabledatalight(nm,xLst,yLst,rmvL,[]); -Tabledatalight(nm,xLst,yLst,rmvL,optionorg):=( -//help:Tabledatalight("",xLst,yLst,rmvL,[2,"Rng=y"]); - regional(options,rng,name,upleft,ul,flg,tick,eqL,reL,n,m,xsize,ysize, - rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps); -// name="tb"+nm; - name="tb"; - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; //16.12.16from - reL=tmp_6; - rng="Y"; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,2)); - tmp2=Toupper(substring(#,tmp,tmp+1)); - if(tmp1=="RN", - rng=tmp2; - options=remove(options,[#]); - ); - );//16.12.16upto - tick=1; - flg=0; - forall(reL, - if(flg==0, - tick=#; - flg=flg+1; - , - upleft=tmp_6_1; - ); - ); - tmp=sum(yLst); - upleft=[0,tmp]; - TableOptions=options; // 16.11.28 - println("Tabledatalight "+name+" generated"); - ul=upleft/10; - m=length(xLst); - n=length(yLst); - xsize=sum(xLst); - ysize=sum(yLst); - clist=[ul]; - rlist=[ul]; - forall(1..m, - tmp1=clist_(#)_1+xLst_#/10; - clist=append(clist,[tmp1,clist_1_2]); - ); - forall(1..n, - tmp1=rlist_(#)_2-yLst_#/10; - rlist=append(rlist,[0,tmp1]); - ); - Tb=[clist,rlist]; - tmp=name+"="+Tb; - parse(tmp); - forall(0..m, - tmp1="c"+text(#)+"r0"; - tmp2="c"+text(#)+"r"+text(n); - Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options); - if(mod(#,tick)==0 % #==m, - tmp=clist_(#+1); - drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#)); - ); - ); - forall(0..n, - tmp1="c0r"+text(#); - tmp2="c"+text(m)+"r"+text(#); - Tlistplot("r"+text(#)+"c0c"+text(m),[tmp1,tmp2],options); - if(mod(#,tick)==0 % #==n, - tmp=rlist_(#+1); - drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#)); - ); - ); - Tsegrmv(rmvL,options); - Addax(0); - Eps=10^(-3); - tmp1=clist_(length(clist)); - tmp2=rlist_1; - tmp3=rlist_(length(rlist)); - if(rng=="Y", // 16.12.16 - Setwindow([0-Eps,tmp1_1+Eps],[tmp3_2-Eps,tmp2_2+Eps]); - ); - Tb; -); - -Tabledata(nm,n,m,xsize,ysize,rmvL):= - Tabledata(nm,n,m,xsize,ysize,rmvL,[]); -Tabledata(nm,n,m,xsize,ysize,rmvL,options):=( -//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]); - regional(Tb,name,tmp,xLst,yLst); - name="tb"+nm; - xLst=apply(1..n,xsize/n); - yLst=apply(1..m,ysize/m); - Tabledata(nm,xLst,yLst,rmvL,options) -); -Tabledata(nm,xLst,yLst,rmvL):=Tabledata(nm,xLst,yLst,rmvL,[]); -Tabledata(nm,xLst,yLst,rmvL,optionorg):=( -//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]); - regional(name,options,eqL,reL,rng,upleft,ul,flg,tick,n,m,xsize,ysize, - rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps); -// name="tb"+nm; - name="tb"; - tmp=sum(yLst); - upleft=[0,tmp]; - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; //16.12.16from - reL=tmp_6; - rng="Y"; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,2)); - tmp2=Toupper(substring(#,tmp,tmp+1)); - if(tmp1=="RN", - rng=tmp2; - options=remove(options,[#]); - ); - );//16.12.16upto - tick=1; - flg=0; - forall(reL, - if(flg==0, - tick=#; - flg=flg+1; - , - upleft=tmp_6_1; - ); - ); - TableOptions=options; // 16.11.28 - println("Tabledata "+name+" generated"); - ul=upleft/10; - m=length(xLst); - n=length(yLst); - xsize=sum(xLst); - ysize=sum(yLst); - clist=[ul]; - rlist=[ul]; - forall(1..m, - tmp1=clist_(#)_1+xLst_#/10; - clist=append(clist,[tmp1,clist_1_2]); - ); - forall(1..n, - tmp1=rlist_(#)_2-yLst_#/10; - rlist=append(rlist,[0,tmp1]); - ); - Tb=[clist,rlist]; - tmp=name+"="+Tb; - parse(tmp); - forall(0..m, - tmp="C"+text(#); - tmp1="c"+text(#)+"r0"; - if(#==0, - Putpoint(tmp,Tgrid(tmp1)); - , - Putpoint(tmp,Tgrid(tmp1),[parse(tmp+".x"),C0.y]); - clist_(#+1)=parse(tmp+".xy"); - ); - inspect(parse(tmp),"ptsize",3); - inspect(parse(tmp),"labeled",false); - if(mod(#,tick)==0 % #==m, - tmp=clist_(#+1); - drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#)); - ); - ); - forall(0..n, - tmp="R"+text(#); - tmp1="c0r"+text(#); - if(#==0, - Putpoint(tmp,Tgrid(tmp1)); - , - Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]); - rlist_(#+1)=parse(tmp+".xy"); - ); - Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]); - inspect(parse(tmp),"ptsize",3); - inspect(parse(tmp),"labeled",false); - if(mod(#,tick)==0 % #==n, - tmp=rlist_(#+1); - drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#)); - ); - ); - Tb=[clist,rlist]; - tmp=name+"="+Tb; - parse(tmp); - forall(0..m, - tmp1="c"+text(#)+"r0"; - tmp2="c"+text(#)+"r"+text(n); - Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options); - if(#=n1 & m2<=n2, - gc=#; - flg=1; - ); - ); - ); - if(flg==1, - Changestyle([gc_1],["nodisp"]); - tail=""; - if(indexof(hd,"r")>0, - tail=hd; hd=""; - ); - if(n1=tmp_1) & (tsg_2<=tmp_2), - sg=tmp; - Changestyle(#,["nodisp"]); - ); - ); - if(length(sg)==0, - println("No segment includes "+grid); - , - if(sb=="c",str=sb+"no"+head,str=head+sb+"no"); - if(sg_10, - posdir_2=posdir_2-dy; - posstr=replace(posstr,"b","n"); - ); - if(indexof(dir,"t")>0, - posdir_2=posdir_2+dy; - posstr=replace(posstr,"t","s"); - ); - if(indexof(dir,"l")>0, - posdir_1=posdir_1-dx; - posstr=replace(posstr,"l","e"); - ); - if(indexof(dir,"r")>0, - posdir_1=posdir_1+dx; - posstr=replace(posstr,"r","w"); - ); - Letter(posdir,posstr,text(lttr)); -); - -Putcellexpr(pos1,pos2,dir,ex):=Putcellexpr("",pos1,pos2,dir,ex); -Putcellexpr(Tbdata,pos1,pos2,dir,ex):=( -//help:Putcellexpr("c0r0","c2r1","lt","abc"); -//help:Putcellexpr(2,3,"c","\sin x"); - Putcell(Tbdata,pos1,pos2,dir,"$"+text(ex)+"$"); -); - -Putrow(nrow,dir,lttrL):=Putrow("",nrow,dir,lttrL); -Putrow(Tbdata,nrow,dir,lttrL):=( -//help:Putrow(1,"c",["x","y","z"]); - regional(tmp,tmp1,mcol); - mcol=length(lttrL); - forall(1..mcol, - Putcell(Tbdata,#,nrow,dir,lttrL_#); - ); -); - -Putrowexpr(nrow,dir,exL):=Putrowexpr("",nrow,dir,exL); -Putrowexpr(Tbdata,nrow,dir,exL):=( -//help:Putrowexpr(2,"r",["x","y","z"]); - regional(lttrL); - lttrL=apply(exL,"$"+#+"$"); - Putrow(Tbdata,nrow,dir,lttrL); -); - -PutcoL(mcol,dir,lttrL):=PutcoL("",mcol,dir,lttrL); -PutcoL(Tbdata,mcol,dir,lttrL):=( -//help:PutcoL(1,"c",["x","y","z"]); - regional(tmp,tmp1,nrow); - nrow=length(lttrL); - forall(1..nrow, - Putcell(Tbdata,mcol,#,dir,lttrL_#); - ); -); -PutcoLexpr(mcol,dir,exL):=PutcoLexpr("",mcol,dir,exL); -PutcoLexpr(Tbdata,mcol,dir,exL):=( -//help:PutcoLexpr(2,"r",["x","y","z"]); - regional(lttrL); - lttrL=apply(exL,"$"+#+"$"); - PutcoL(Tbdata,mcol,dir,lttrL); -); - -Setrange():=( -//help:Setrange(); - SW.xy=Pcrd([XMIN,YMIN]); - NE.xy=Pcrd([XMAX,YMAX]); - drawpoly([Pcrd([XMIN,YMIN]), Pcrd([XMAX,YMIN]), - Pcrd([XMAX,YMAX]),Pcrd([XMIN,YMAX])],color->[1,1,1]); -); - -Sciform(list):=( - regional(plotlist,comp,pos,out,out2,nn,strL,flg, - tmp,tmp1,tmp2,tmp3,Nj); - plotlist=Flatten([list]); - out=replace(plotlist_1,".xy",""); - out=replace(out,".x","(1)"); - out=replace(out,".y","(2)"); - if(length(plotlist)==1, - comp=[]; - forall(1..length(out), - comp=append(comp,substring(out,#-1,#)); - ); - out=""; - pos=0; - forall(comp, - if(#!="'", - out=out+#; - , - if(pos==0, - tmp=indexof(out,"Assign("); - if(substring(out,length(out)-7,length(out))=="Assign(", - out=out+"'"; - pos=1; - , - out=out+"Assign('"; - pos=2; - ); - , - if(pos==2, - out=out+"')"; - , - out=out+"'"; - ); - pos=0; - ); - ); - ); - , - forall(2..length(plotlist), - comp=plotlist_#; - if(isstring(comp), - pos=indexof(comp,"Assign("); - if(pos>0, - comp=substring(comp,6,length(comp)); - ); - out=out+"Assign("; - comp=replace(comp,".xy",""); - comp=replace(comp,".x","(1)"); - comp=replace(comp,".y","(2)"); - out=out+"'"+comp+"'"; - out=out+"),"; - ); - if(islist(comp), - forall(comp, - out=out+"'"+#+"',"; - ); - ); - ); - if(length(plotlist)>1, - out=substring(out,0,length(out)-1); - out=out+");"; - ); - ); - pos=[]; - forall(1..length(out), - tmp=indexof(substring(out,#-1,length(out)),"Assign"); - if(tmp>0, - tmp1=#-1+tmp; - if(length(pos)==0, - pos=[tmp1]; - , - if(pos_(length(pos))0, - strL=[]; - Nj=0; - forall(pos, - tmp=substring(out,Nj,#-1); - strL=append(strL,tmp); - Nj=#-1; - ); - strL=append(strL,substring(out,Nj,length(out))); - out=""; - forall(strL, - if(indexof(#,"Assign")==0, - out=out+#; - , - tmp=indexof(#,"('"); - tmp1=indexof(#,"')"); - tmp2=substring(#,tmp+1,tmp1-2); - tmp3=substring(#,tmp1-2,length(#)); - if(indexof(tmp2,"=")==0, - out=out+#; - , - tmp=substring(tmp2,0,indexof(tmp2,"=")); - out=out+"'"+tmp+"'+"+"Assign('"; - tmp=substring(tmp2,indexof(tmp2,"="),length(tmp2)); - out=out+tmp+tmp3; - ); - ); - ); - ); - out2=""; // patched 16.01.21 from - nn=length(out); - flg=0; - forall(1..nn, - if(flg==0, - tmp=indexof(out,"='+Assign('"); - if(tmp==0, - out2=out2+out; - flg=1; - , - out2=out2+substring(out,0,tmp); - out=substring(out,tmp+10,length(out)); - tmp=indexof(out,"'"); // 16.04.19 from - tmp1=substring(out,0,tmp-1); - tmp2="1234567890"; - tmp=apply(1..length(tmp1), - indexof(tmp2,substring(tmp1,#-1,#))); - tmp=min(tmp); - if(tmp==0, // 16.04.19 upto - out2=out2+"'+Assign('"; - , - tmp=indexof(out,"'"); - out=substring(out,0,tmp)+substring(out,tmp+1,length(out)); - // 16.04.18 upto - ); - ); - ); - ); - out2=replace(out2,"Dist=","D="); - out2=replace(out2,"Dis=","D="); - out2; -); - -RSform(str):=RSform(str,3); -RSform(str,listfrom):=( -//help:RSform(string,listfrom); - regional(posL,mxlv,rep1,rep2,rep3,prev,out, - tmp,tmp1,tmp2); - rep1="c("; rep2="c("; rep3="list("; - if(listfrom<3,rep2="list("); - if(listfrom==1,rep1="list("); - posL=Bracket(str,"[]"); - tmp=apply(posL,#_2); - mxlv=max(tmp); - out=""; - prev=0; - forall(posL, - out=out+substring(str,prev,#_1-1); - prev=#_1; - if(#_2>0, - tmp1=select(posL,tmp,(tmp_2<0)&(tmp_1>#_1)); - tmp1=tmp1_1_1; - tmp=substring(str,#_1,tmp1); - if(#_2==mxlv,out=out+rep1); - if(#_2==mxlv-1,out=out+rep2); - if(#_2<=mxlv-2,out=out+rep3); - , - out=out+")"; - ); - ); - out=out+substring(str,prev,length(str)); - out=replace(out,".xy",""); - out=replace(out,".x","[1]"); - out=replace(out,".y","[2]"); - out=replace(out,"c(1)","[1]");//17.10.06(2lines) - out=replace(out,"c(2)","[2]"); - out; -); - -RSslash(str):=( //17.09.24 - regional(tmp); - tmp=replace(str,"\","\\"); -// tmp=replace(tmp,"\\\\","\\"); - tmp; -); - -Rform(list):=( - regional(plotlist,comp,pos,out,strL,tmp,tmp1,tmp2,tmp3,Nj); - out=list; - out=replace(out,"[[[","list([["); - out=replace(out,"[","c("); - out=replace(out,"]",")"); - out=replace(out,".xy",""); - out=replace(out,".x","[1]"); - out=replace(out,".y","[2]"); - out; -); - -Defvar(varstr):=( - regional(name,value,tmp,tmp1); - if(isstring(varstr), - parse(varstr); - tmp=indexof(varstr,"="); - name=substring(varstr,0,tmp-1); - value=substring(varstr,tmp,length(varstr)); - value=parse(value); - tmp1=select(1..length(VLIST),VLIST_#_1==name); - if(length(tmp1)>0, - tmp=tmp1_1; - VLIST_tmp=[name,value]; - , - VLIST=prepend([name,value],VLIST); - ); - , - forall(1..(length(varstr)/2), // 16.11.16from - name=varstr_(2*#-1); - value=varstr_(2*#); - Defvar(name,value); - ); // 16.11.16upto - ); -); - -Defvar(name,value):=( -//help:Defvar("a",0.3); -//help:Defvar(["a",0.3,"b",2]); - regional(tmp,tmp1); - if(islist(value), - tmp1="["; - forall(value, - if(isstring(#), // 16.11.14 - tmp1=tmp1+Dq+#+Dq+","; // 16.11.14 - , - tmp1=tmp1+format(#,5)+","; - ); - ); - tmp1=substring(tmp1,0,length(tmp1)-1)+"]"; - , - tmp1=format(value,5); - ); - tmp=name+"="+tmp1; // 15.02.06 - parse(tmp); - VLIST=select(VLIST,#_1!=name); // 15.02.08 - VLIST=prepend([name,value],VLIST); -); - -IftoR(strorg):=( - regional(str,pre,post,sub,ppL,ifstr,out,tmp,tmp1,tmp2); - str=strorg; - ifstr=indexof(str,"if("); - if(ifstr==0, - out=replace(str,",","}else{"); - , - pre=substring(str,0,ifstr-1)+"if("; - ppL=Bracket(str,"()"); - tmp1=ifstr+2; - tmp=select(ppL,#_1==tmp1); - tmp=select(ppL,#_2==-tmp_1_2); - tmp2=tmp_1_1; - sub=substring(str,tmp1,tmp2-1); - post="}"+substring(str,tmp2,length(str)); - tmp=indexof(sub,","); - tmp1=substring(sub,0,tmp-1); - tmp2=substring(sub,tmp,length(sub)); - sub=tmp1+"){"+tmp2; - tmp=IftoR(sub); - out=pre+tmp+"}"; - ); - out; -); - -FortoR(strorg):=( - regional(str,pre,post,sub,ppL,forstr,out,tmp,tmp1,tmp2); - str=strorg; - forstr=indexof(str,"forall("); - if(forstr==0, - out=str; - , - pre=substring(str,0,forstr-1)+"for("; - ppL=Bracket(str,"()"); - tmp1=forstr+6; - tmp=select(ppL,#_1==tmp1); - tmp=select(ppL,#_2==-tmp_1_2); - tmp2=tmp_1_1; - sub=substring(str,tmp1,tmp2-1); - post="}"+substring(str,tmp2,length(str)); - tmp=indexof(sub,","); - tmp1=substring(sub,0,tmp-1); - tmp2=substring(sub,tmp,length(sub)); - sub=tmp1+"){"+tmp2; - tmp1=indexof(sub,"{"); - tmp2=indexof(sub,","); - tmp=substring(sub,tmp1,tmp2-1); - pre=pre+tmp+" in "+substring(sub,0,tmp1-1)+"{"; - sub=substring(sub,tmp2,length(sub)); - tmp=FortoR(sub); - out=pre+tmp+"}"; - ); - out=replace(out,"..",":"); - out; -); - -Deffun(name,bodylist):=( -//help:Deffun("f(x)",["regional(y)","y=x^2*(x-3)","y"]); - regional(funstr,str,Pos,nbody,bdy,ppL,bpL,excma,tmp,tmp1,tmp2); - funstr=name+":=("; - forall(bodylist, - funstr=funstr+#+";"; - ); - funstr=funstr+");"; - parse(funstr); - tmp=indexof(name,"("); - str=substring(name,0,tmp-1)+"<-function("; - str=str+substring(name,tmp,length(name))+"{"; - forall(1..(length(bodylist)-1),nbody, - bdy=bodylist_nbody; - Pos=indexof(bdy,"regional")+indexof(bdy,"local"); - if(Pos==0, - bdy=replace(bdy,LFmark,""); - bdy=replace(bdy," ",""); - ppL=Bracket(bdy,"()"); - bpL=Bracket(bdy,"[]"); - tmp1=select(bpL,#_2==1); - tmp2=select(bpL,#_2==-1); - excma=[]; - forall(1..(length(tmp1)), - excma=append(excma,[tmp1_#_1,tmp2_#_1]); - ); - tmp1=Indexall(bdy,","); - forall(tmp1,cma, - tmp=select(excma,(#_10, - bdy=substring(bdy,0,cma-1)+"'"+substring(bdy,cma,length(bdy)); - ); - ); - tmp=indexof(bdy,"forall"); - if(tmp>0, - bdy=FortoR(bdy); - ); - tmp=indexof(bdy,"if("); - if(tmp>0, - bdy=IftoR(bdy); - ); - bdy=RSform(replace(bdy,"'",",")); - str=str+bdy+";"; - ); - ); - str=str+"return("+bodylist_(length(bodylist))+")}"; - FUNLIST=append(FUNLIST,str); -); - -Windispg():=( - regional(Nj,Nk,Dt,Vj,tmp,tmp1,tmp2,opcindy); - gsave(); - layer(KETPIClayer); - forall(GCLIST,Nj, - if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17 - if(islist(Dt) & length(Dt)>0, // 12.19,12.22 - tmp=MeasureDepth(Dt); - if(tmp==1,Dt=[Dt]); - opcindy=Nj_3; - if(Nj_2<0,tmp1=0,tmp1=Nj_2); - if(tmp1<10, - forall(Dt,Nk, -// tmp2=apply(Nk,if(ispoint(#),Lcrd(#),#)); -// tmp2=apply(tmp2,Pcrd(#)); - tmp2=Nk; // 14.12.04 - if(length(Nk)>1, - tmp="connect("+textformat(tmp2,5)+ - ",dashtype->"+text(tmp1)+",linecolor->"+KCOLOR+opcindy+")"; - parse(tmp); - , - if(length(Nk)==1, - tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31 - parse(tmp); - ); - ); - ); - ); - ); - ); -// if(ADDAXES=="1", // 16.10.08from -// draw([XMIN,0],[XMAX,0],color->[0,0.2,0]); -// draw([0,YMIIN],[0,YMAX],color->[0,0.2,0]); -// Letter([[XMAX,0],"e","x",[0,YMAX],"n","y"]); -// Letter([[0,0],"sw","O"]); -// ); // 16.10.08upto - grestore(); - layer(0); -); - -Windispg(pltdata):=( - regional(pdata,Nj,Nk,Dt,tmp,tmp1,tmp2,opcindy); - gsave(); - layer(KETPIClayer); - if(!islist(pltdata),tmp=[pltdata],tmp=pltdata); - pdata=select(GCLIST,contains(tmp,#_1)); - forall(pdata,Nj, - if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17 - if(islist(Dt) & length(Dt)>0, // 12.19,12.22 - tmp=MeasureDepth(Dt); - if(tmp==1,Dt=[Dt]); - opcindy=Nj_3; - if(Nj_2<0,tmp1=0,tmp1=Nj_2); - if(tmp1<10, - forall(Dt,Nk, - tmp2=Nk; // 14.12.04 - if(length(Nk)>1, - tmp="connect("+textformat(tmp2,5)+ // 15.05.11 - ",dashtype->"+text(tmp1)+ - ",linecolor->"+KCOLOR+opcindy+")"; - parse(tmp); - , - if(length(Nk)==1, - tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31 - parse(tmp); - ); - ); - ); - ); - ); - ); - grestore(); - layer(0); -); - -WritetoSci():=WritetoRS(); //17.12.19 -WritetoRS():=WritetoRS(FnameR);// 17.09.17from -WritetoRS(Arg):=( - regional(string,filename,shch,tmp1,tmp2); - if(isstring(Arg), - string=Arg; - if(indexof(string,".r")>0, - filename=string; - shch=""; - , - filename=FnameR; - shch=string; - ); - WritetoRS(filename,shch); - , - if(Arg<=1,WritetoRS(FnameR,"all")); - if(Arg==2,WritetoRS(FnameR,"sh")); - ); -); -WritetoRS(filename,shchoice):=( - regional(Plist,Pos,GrL,str,tmp,tmp1,tmp2,cmd); - println("Write to R "+filename); - Plist=[]; - Pnamelist=[]; - forall(remove(allpoints(),[SW,NE]), - tmp=Lcrd(#); - tmp1=format(re(tmp_1),6);// 15.02.05 - tmp2=format(re(tmp_2),6); - tmp=#.name+"="+"c("+tmp1+","+tmp2+");"; - tmp=tmp+"Assignadd('"+#.name+"',"+#.name+")"; - Plist=append(Plist,tmp); - ); - SCEOUTPUT = openfile(filename); - tmp=Datetime(); - println(SCEOUTPUT,"# date time="+tmp_1+" "+tmp_2); - if(isstring(CindyPathName), // 16.12.25from - if(length(CindyPathName)>0, - println(SCEOUTPUT, - "# path file="+CindyPathName+" "+CindyFileName+".cdy"); - , - println(SCEOUTPUT,""); - ); - , - println(SCEOUTPUT,""); - ); - tmp=replace(Dirwork,"\","/"); //17.09.24 - println(SCEOUTPUT,"setwd('"+tmp+"')"); //17.09.24 -// if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0), -// Libname=Libname+"2e"; -// ); // 17.10.07removed - tmp=replace(Libname,"\","/"); //17.09.24from -// println(SCEOUTPUT,"load('"+tmp+".Rdata')"); //17.10.11 - println(SCEOUTPUT,"source('"+tmp+".r')");//temporary - if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0), - // 17.10.07added - tmp=replace(tmp+"_rep2e","\","/"); - println(SCEOUTPUT,"source('"+tmp+".r')"); - ); - println(SCEOUTPUT,"Ketinit()"); - println(SCEOUTPUT,"cat(ThisVersion,'\n')"); - println(SCEOUTPUT,"Fnametex='"+Fnametex+"'"); - println(SCEOUTPUT,"FnameR='"+FnameR+"'"); - println(SCEOUTPUT,"Fnameout='"+Fnameout+"'"); - println(SCEOUTPUT,"arccos=acos; arcsin=asin; arctan=atan"); - println(SCEOUTPUT,""); - forall(COM0thlist, - if(indexof(#,"Texcom")==0, //17.09.22 - println(SCEOUTPUT,RSform(#)); - , - println(SCEOUTPUT,#); - ); - ); - println(SCEOUTPUT, - "Setwindow(c("+XMIN+","+XMAX+"), c("+YMIN+","+YMAX+"))"); - forall(Plist, - println(SCEOUTPUT,#); - ); - forall(VLIST, - tmp=#_1; - tmp1=#_2; - if(!isstring(tmp1), - if(islist(tmp1), - tmp2="["; - forall(tmp1, - tmp2=tmp2+textformat(#,6)+","; - ); - tmp1=substring(tmp2,0,length(tmp2)-1)+"]"; - , - tmp1=format(tmp1,6); - ); - ); - tmp1=RSform(tmp1); - print(SCEOUTPUT,tmp+"="+tmp1+";"); //17.09.22 -// tmp=substring(tmp,0,length(tmp)-1); - println(SCEOUTPUT,"Assignadd('"+tmp+"',"+tmp+")"); - ); - forall(FUNLIST, - println(SCEOUTPUT,#); - ); - forall(GLIST, - println(SCEOUTPUT,RSform(#)); - ); - tmp=text(Pnamelist); - tmp=replace(tmp,"[","list("); - Pnamelist=replace(tmp,"]",")"); - println(SCEOUTPUT,"PtL="+Pnamelist+";"); - tmp=select(GCLIST,#_2==-1); - GrL=apply(tmp,#_1); - tmp=text(GrL); - tmp=replace(tmp,"[","list("); - tmp=replace(tmp,"]",")"); - println(SCEOUTPUT,"GrL="+tmp); - tmp1=""; - if(length(tmp1)>0, - tmp1="WriteOutData(Fnameout"+tmp1+");"; - println(SCEOUTPUT,tmp1); - ); - forall(COM1stlist, - if(indexof(#,"Texcom")==0, //17.09.22 - println(SCEOUTPUT,RSform(#)); - , - println(SCEOUTPUT,#); - ); - ); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"# Windisp(GrL)"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"if(1==1){"); - println(SCEOUTPUT,""); - tmp=replace(Dirwork,"\","/"); //17.10.28(3lines) - tmp="Openfile('"+tmp+pathsep()+Fnametex+"','"+ULEN+"'"; - tmp=tmp+",'Cdy="+loaddirectory+text(curkernel()); - tmp=replace(tmp,"\","\\"); - println(SCEOUTPUT,tmp+"')"); - forall(COM2ndlist, - if(indexof(#,"Texcom")==0, //17.09.22 - println(SCEOUTPUT,RSform(#)); - , - println(SCEOUTPUT,#); - ); - ); - if(length(GrL)>0, - println(SCEOUTPUT," Drwline(GrL)"); - ); - println(SCEOUTPUT,"Closefile('"+ADDAXES+"')"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"}"); - if(shchoice=="sh", - println(SCEOUTPUT,""); - println(SCEOUTPUT,"quit()"); - , - println(SCEOUTPUT,""); - println(SCEOUTPUT,"#quit()"); - ); - closefile(SCEOUTPUT); -); //17.09.17upto - -Extractdata(name):=Extractdata(1,name,[]); -Extractdata(Arg1,Arg2):=( - if(isstring(Arg1), - Extractdata(1,Arg1,Arg2); - , - Extractdata(Arg1,Arg2,[]); - ); -); -Extractdata(number,name,options):=( -//help:ExtractData("ha1"); -//help:ExtractData(1,"ha1"); - regional(dlist,tmp,tmp1,tmp2,tmp3,File,Ltype,Noflg,opstr,opcindy); - tmp=Divoptions(options); - Ltype=tmp_1; - Noflg=tmp_2; - opstr=tmp_(length(tmp)-1); - opcindy=tmp_(length(tmp)); - tmp1=[]; - forall(1..length(GOUTLIST), - if(contains(GOUTLIST_#_2,name), - tmp1=append(tmp1,#); - ); - ); - if(length(tmp1)==0, - println(varname+" not found"); - , - tmp1=tmp1_number; - tmp2=GOUTLIST_tmp1; - tmp=remove(tmp2_2,[name]); - GOUTLIST_tmp1=[tmp2_1,tmp]; - File=tmp2_1; - ); - if(Noflg<3, - println("extract outdata "+name); - tmp1=parse(name); - tmp3=[ //17.09.18 - "Tmpout=ReadOutData("+Dq+File+Dq+")" - ]; - GLIST=concat(GLIST,tmp3); - ); - if(Noflg<2, - if(isstring(Ltype), - Ltype=GetLinestyle(text(Noflg)+Ltype,name); - , - if(Noflg==1,Ltype=0); - ); - GCLIST=append(GCLIST,[name,Ltype,opcindy]); - ); - tmp2; -); - -RemoveOut(pltlist):=( - regional(name,tmp,tmp1,tmp2); - forall(pltlist,name, - tmp1=[]; - forall(GOUTLIST, - tmp=remove(#_2,[name]); - tmp1=append(tmp1,[#_1,tmp]); - ); - GOUTLIST=tmp1; - ); -); - -ReadOutData():=ReadOutData(Fnameout); -ReadOutData(filename):=ReadOutData("",filename); //16.03.07 -ReadOutData(pathorg,filenameorg):=( -//help:ReadOutData(); -//help:Readoutdata(); -//help:ReadOutData("file.txt"); -//help:Readoutdata("file.txt"); -//help:ReadOutData("/datafolder","file.txt"); -//help:Readoutdata("/datafolder","file.txt"); - regional(path,filename,varname,varL,ptL,pts,tmp,tmp1,tmp2,tmp3,tmp4, - nmbr,cmdall,cmd,cmdorg,outdt,goutdt); - path=pathorg; //16.03.07 from - if(length(path)>0, - setdirectory(path); - if(indexof(path,"\")>0,tmp1="\",tmp1="/"); - tmp=substring(path,length(path)-1,length(path)); - if(tmp!=tmp1,path=path+tmp1); - ); //16.03.07 upto - filename=filenameorg; // 16.04.17 - if(indexof(filename,".")==0,filename=filename+".txt"); - tmp=load(filename); - cmdall=tokenize(tmp,"//"); - varname=cmdall_1; - cmdall=cmdall_(2..length(cmdall)); - outdt=[]; - varL=[varname]; - ptL=[]; - forall(cmdall,cmdorg, - cmd=replace(cmdorg,LFmark,""); - if(length(cmd)>0, - if(cmd=="start" % cmd=="end" % substring(cmd,0,1)=="[", - if(cmd=="start", - pts=[]; - ); - if(cmd=="end", - ptL=append(ptL,pts); - ); - if(substring(cmd,0,1)=="[", - tmp1=parse(cmd); - if(length(tmp1_1)==2, - tmp1=apply(tmp1,Pcrd(#)); - ); - pts=concat(pts,tmp1); - ); - , - if(length(ptL)>0, - if(length(ptL)==1, - ptL=ptL_1; - tmp=apply(ptL,textformat(#,6)); - , - tmp="["; - forall(ptL,tmp1, - tmp=tmp+apply(tmp1,textformat(#,6))+","; - ); - tmp=substring(tmp,0,length(tmp)-1)+"]"; - ); - , - tmp="[]"; - ); - parse(varname+"="+tmp); - outdt=append(outdt,ptL); - ptL=[]; - varname=cmd; - varL=append(varL,varname); - ); - ); - ); - if(length(ptL)>0, - if(length(ptL)==1, - ptL=ptL_1; - tmp=apply(ptL,textformat(#,6)); - , - tmp="["; - forall(ptL,tmp1, - tmp=tmp+apply(tmp1,textformat(#,6))+","; - ); - tmp=substring(tmp,0,length(tmp)-1)+"]"; - ); - , - tmp="[]"; - ); - parse(varname+"="+tmp); - outdt=append(outdt,ptL); - if(path=="",tmp=filename,tmp=path+filename); //16.03.07 - GOUTLIST=append(GOUTLIST,[tmp,varL]); - if(length(path)>0, // 16.03.09 - setdirectory(Dirwork); // 16.03.07 - ); - print("readoutdata from "+tmp+" : "); - println(varL); - varL; -); - -WriteOutData(filename,ptlist):=( -//help:WriteOutData("file.txt",["g1",gr1,"sg",sgAB]); -//help:Writeoutdata("file.txt",["g1",gr1,"sg",sgAB]); - regional(nn,Gname,Gdata,Str,Gstr,Gj,Pt,Flg,tmp,tmp1,loopend); - Flg=0; - if(isstring(ptlist_(length(ptlist))), - Flg=1; - ); - SCEOUTPUT = openfile(filename); - if(Flg==0, - loopend=length(ptlist)/2; - , - loopend=length(ptlist); - ); - Gstr="["; - forall(1..loopend,nn, - if(Flg==0, - Gname=ptlist_(2*nn-1); - , - Gname=ptlist_nn; - ); - Gstr=Gstr+Gname+","; - println(SCEOUTPUT,Gname+"//"); - if(Flg==0, - Gdata=ptlist_(2*nn); - , - Gdata=parse(Gname); - ); - Gdata=Flattenlist(Gdata); - if(MeasureDepth(Gdata)==1,Gdata=[Gdata]); - forall(Gdata,Gj, - println(SCEOUTPUT,"start//"); - Str=""; - forall(Gj,Pt, - if(length(Str)>0, - Str=Str+"," - ); - Str=Str+"["+format(Pt_1,5)+","; - Str=Str+format(Pt_2,5); - if(length(Pt)<3, - Str=Str+"]"; - , - Str=Str+","+format(Pt_3,5)+"]"; - ); - if(length(Str)>80, - println(SCEOUTPUT,"["+Str+"]//"); - Str=""; - ); - ); - if(length(Str)>0, - println(SCEOUTPUT,"["+Str+"]//"); - ); - if((nn==loopend) & (Gj==Gdata_(length(Gdata))), - println(SCEOUTPUT,"end////"); - , - println(SCEOUTPUT,"end//"); - ); - ); - ); - closefile(SCEOUTPUT); - Gstr=substring(Gstr,0,length(Gstr)-1)+"]"; - println("writeoutdata "+filename+":"+Gstr); -); - -Makeshell():=( - if(length(Texmain)>0, - Texparent=Texmain; - ); - if(length(Texparent)>0, - Makeshell(Texparent); - if(length(FigPdfList)>0, - SCEOUTPUT=openfile(Texparent+".tex"); - forall(FigPdfList,println(SCEOUTPUT,#)); - closefile(SCEOUTPUT); - ); - , - Makeshell(Fhead+"main"); - ); -); -Makeshell(texmainfile):=Makeshell(texmainfile,"rtv"); -Makeshell(texmainfile,flow):=( - regional(parent,tmp,tmp1,tmp2,tmp3,flg,tex,path,shnm); - parent=Dirwork+Shellparent; // 16.05.29 - kc():=( - println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04,06.07 - ); - tmp1=""; -// tmp2=parent; - flg=0; - forall(reverse(1..length(parent)), - if(flg==0, - tmp=substring(parent,#-1,#); - if(tmp=="/" % tmp=="\", // 14.01.15 - tmp1=substring(parent,0,#-1); - tmp2=substring(parent,#,length(parent)); - flg=1; - ); - ); - ); - if(length(tmp1)>0, - setdirectory(tmp1); - ); - SCEOUTPUT = openfile(tmp2); - println(SCEOUTPUT,"#!/bin/sh"); - println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); // 15.07.16 - tmp1=" "+Dq+Fhead+Dq+" "+Dq+texmainfile+Dq; // 15.12.11 - flg=0; - forall(reverse(1..length(PathT)), - if(flg==0, - if(substring(PathT,#-1,#)=="/", - tex=substring(PathT,#,length(PathT)); - path=substring(PathT,0,#-1); - flg=1; - ); - ); - ); - if(flg==0, // 17.10.13(Norbert) - tex=PathT; - path=""; - ); - if(indexof(flow,"r")>0, - tmp=Dq+PathR+Dq+" --vanilla --slave < "+Fhead+".r"; - // 17.09.14 - println(SCEOUTPUT,tmp); - ); - if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13 - tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; - println(SCEOUTPUT,tmp); - if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 - tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi"; - println(SCEOUTPUT,tmp); - tmp="rm "+texmainfile+".dvi"; - println(SCEOUTPUT,tmp); - ); - if(tex=="xelatex", - tmp="export PATH="+path+":${PATH}"; - println(SCEOUTPUT,tmp); - tmp="xelatex"+" "+texmainfile+".tex"; - println(SCEOUTPUT,tmp); - if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 - tmp="rm "+texmainfile+".dvi"; - println(SCEOUTPUT,tmp); - ); - if(tex=="pdflatex" % tex=="pdftex",//16.11.22from - tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; - println(SCEOUTPUT,tmp); - if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 - );//16.11.22upto - if(tex=="lualatex",//16.12.16 - tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; - println(SCEOUTPUT,tmp); - if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 - );//16.12.16 - if(!isstring(Pathpdf), - tmp="preview"; - , - tmp=Pathpdf; - ); - if(tmp=="preview" % tmp=="skim", // 16.09.09from,16.10.20 - tmp="open -a "+Dq+tmp+Dq+" "+texmainfile+".pdf"; - , - tmp=Dq+tmp+Dq+" "+texmainfile+".pdf"; - );// 16.09.09upto - println(SCEOUTPUT,tmp); // 16.07.21upto - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - setdirectory(Dirwork); -); - -Makebat():=( - if(length(Texmain)>0, - Texparent=Texmain; - ); - if(length(Texparent)>0, - Makebat(Texparent); - if(length(FigPdfList)>0, - SCEOUTPUT=openfile(Texparent+".tex"); - forall(FigPdfList,println(SCEOUTPUT,#)); - closefile(SCEOUTPUT); - ); - , - Makebat(Fhead+"main"); - ); -); -Makebat(texmainfile):=Makebat(texmainfile,"rtv"); -Makebat(texmainfile,flow):=( - regional(drive,fname,tmp,tmp1,tmp2,tmp3,flg,tex,path,batnm); - drive="C:"; - fname=Dirwork+Batparent; - kc():=( - println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04 - ); - tmp=indexof(fname,":"); - if(tmp>0, - drive=substring(fname,0,tmp); - fname=substring(fname,tmp,length(fname)); - ); - tmp1=""; - tmp2=fname; - flg=0; - forall(reverse(1..length(fname)), - if(flg==0, - tmp=substring(fname,#-1,#); - if(tmp=="/" % tmp=="\" % tmp=="\", // 14.01.15 - tmp1=substring(fname,0,#-1); - tmp2=substring(fname,#,length(fname)); - flg=1; - ); - ); - ); - if(length(tmp1)>0, - setdirectory(drive+tmp1); - ); - SCEOUTPUT = openfile(tmp2); - fname=Dirwork; - tmp=indexof(fname,":"); - if(tmp>0, - drive=substring(Dirwork,0,tmp); - fname=substring(Dirwork,tmp,length(Dirwork)); - println(SCEOUTPUT,drive); - ); - println(SCEOUTPUT,"cd "+Dq+fname+Dq);// 15.07.16 - flg=0; - tmp=replace(PathT,"\","/"); - forall(reverse(1..length(PathT)), - if(flg==0, - if(substring(tmp,#-1,#)=="/", - tex=substring(PathT,#,length(PathT)); - path=substring(PathT,0,#-1); - flg=1; - ); - ); - ); - if(flg==0, // 17.10.13(Norbert) - tex=PathT; - path=""; - ); - if(indexof(flow,"r")>0, - tmp=Dq+PathR+"\R"+Dq+" --vanilla --slave < "+Fhead+".r"; - // 17.09.14 - println(SCEOUTPUT,tmp); - ); - if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13 - tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; - println(SCEOUTPUT,tmp); - if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 - tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi"; - println(SCEOUTPUT,tmp); - tmp="del "+texmainfile+".dvi"; - println(SCEOUTPUT,tmp); - ); - if(tex=="xelatex", - tmp="set Path = %Path%;"+Dq+path+Dq; - println(SCEOUTPUT,tmp); - if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 - tmp="xelatex"+" "+texmainfile+".tex"; - println(SCEOUTPUT,tmp); - tmp="del "+texmainfile+".dvi"; - println(SCEOUTPUT,tmp); - ); - if(tex=="pdflatex" % tex=="pdftex",//16.11.22from - tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; - println(SCEOUTPUT,tmp); - if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 - );//16.11.22upto - if(tex=="lualatex",//16.12.16 - tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; - println(SCEOUTPUT,tmp); - if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 - );//16.12.16 - if(!isstring(Pathpdf), - tmp=indexof(PathS,"\scilab");// 15.12.12 - tmp=substring(PathS,0,tmp-1)+"\SumatraPDF\SumatraPDF.exe"; - , - tmp=Pathpdf; - ); - tmp=Dq+tmp+Dq+" "+texmainfile+".pdf"; - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - if(indexof(Dirwork,":")==0, // 14.01.15 - drive="C:"; - , - drive=""; - ); - setdirectory(drive+Dirwork); -); - -Addpackage(packorg):=( -//help:Addpackage("bm"); -//help:Addpackage(["bm","enumerate"]); -//help:Addpackage(["bm","[c]{somepackage}"]); - regional(packL,tmp); - packL=packorg; //17.06.25from - if(!islist(packL),packL=[packL]); - packL=apply(packL,replace(#,"\","/")); - forall(1..(length(packL)), - tmp=packL_#; - if(substring(tmp,0,11)=="ketpicstyle", - tmp=replace(Dirhead+"/"+tmp,"\","/"); - ); - if(indexof(tmp,"[")==0, - packL_#="{"+tmp+"}"; - ); - ); - ADDPACK=concat(ADDPACK,packL); //17.06.25upto -); - -Viewtex():=( - regional(texfile,tmp,tmp1,sep); - texfile=Fhead+"main"; -// if(iswindows(),sep="\",sep="/"); // 17.04.07 -// sep="/"; - SCEOUTPUT=openfile(texfile+".tex"); - tmp="\documentclass{article}"; // 16.06.09from - if(indexof(PathT,"platex")>0, - tmp=replace(tmp,"article","jarticle"); - if(indexof(PathT,"uplatex")>0, //17.08.13from - tmp=replace(tmp,"jarticle","ujarticle"); - );//17.08.13upto - ); // 16.06.09upto - println(SCEOUTPUT,tmp); - if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0) , - //16.11.23,12.16 - if(indexof(PathT,"pdflatex")>0, - println(SCEOUTPUT,"\usepackage[pdftex]{pict2e}");//16.11.24 - , - println(SCEOUTPUT,"\usepackage{pict2e}");//16.12.16 - println(SCEOUTPUT,"\usepackage{luatexja}");//16.12.18 - ); - tmp=replace(Dirhead,"\","/"); //17.10.30from - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic2e}"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer2e}"); - ); - , - tmp=replace(Dirhead,"\","/"); - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}"); - ); - );//17.10.30upto - println(SCEOUTPUT,"\usepackage{amsmath,amssymb}"); - println(SCEOUTPUT,"\usepackage{graphicx}"); - println(SCEOUTPUT,"\usepackage{color}"); - forall(ADDPACK, // 16.05.16from - println(SCEOUTPUT,"\usepackage"+#); //17.05.25 - );// 16.05.16upto - println(SCEOUTPUT,""); -// println(SCEOUTPUT,"\def\ketcindy{{K\kern-.20em%"); // deleted 16.11.27,recovered11.29 redeleted17.04.07 -// println(SCEOUTPUT,"\lower.5ex\hbox{E}\kern-.125em{TCindy}}}"); -// println(SCEOUTPUT,""); - println(SCEOUTPUT,"\setmargin{20}{20}{20}{20}"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\begin{document}"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\verb|"+Fhead+"| by \ketcindy");// 16.01.12, 18, 16.04.08 -// println(SCEOUTPUT,"\verb|"+Fhead+"| by KeTCindy");// 16.11.29 temporarily - println(SCEOUTPUT,"\vspace{5mm}"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\input{"+Fhead+".tex}"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\end{document}"); - closefile(SCEOUTPUT); - if(iswindows(), - kc():=( - println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04 - ); - Makebat(texfile); - , - kc():=( - println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04 - ); - Makeshell(texfile); - ); - WritetoRS(2); //17.09.19 -); - -Viewparent():=( //17.04.13 - if(!isexists(Dirwork,Texparent+".tex"), - if(isstring(Texparent), - drawtext(mouse().xy,Texparent+".tex not exist", - size->24,color->[1,0,0]); - , - drawtext(mouse().xy,"Texparent not defined", - size->24,color->[1,0,0]); - ); - , - if(iswindows(), - Makebat(); - , - Makeshell(); - ); - WritetoRS(2); //17.09.29 - kc(); - ); -); - -Makecmdlist(libname):=( -//help:Makecmdlist("ketcindylib"); - regional(cmdall,cmd,flg,tmp,tmp1,tmp2,out); - setdirectory(Dirlib); - tmp=load(libname+".cs"); - cmdall=tokenize(tmp,":="); - out=[]; - forall(cmdall,cmd, - tmp=max([0,length(cmd)-50]); - tmp1=";"+substring(cmd,tmp,length(cmd)); - flg=0; - forall(reverse(1..length(tmp1)), - if(flg==0, - if(substring(tmp1,#-1,#)==";", - tmp=substring(tmp1,#,length(tmp1)); - tmp2=substring(tmp,0,1); - if(length(tmp)>0, - if(!contains([" ","/"],tmp2), - out=append(out,tmp); - flg=1; - ); - ); - ); - ); - ); - ); - setdirectory(Dirwork); - tmp=length(out)-1; - out=out_(2..tmp); - out=sort(out); -); - -Savecmdlist(cmdlist,cmdfile):=( - SCEOUTPUT=openfile(cmdfile+".cs"); - forall(cmdlist, - println(SCEOUTPUT,#); - ); - closefile(SCEOUTPUT); -); - -Quicksort(seq):=( - regional(pivot,left,right,out); - if(length(seq)<2, - out=seq; - , - pivot = max(seq_1,seq_2); - left = []; - right = []; - forall(seq, - if(#< pivot, - left=append(left,#); - , - right=append(right,#); - ); - ); - left = Quicksort(left); - right = Quicksort(right); - out=concat(left,right); - ); - out; -); - -Lessstr(st1,st2):=( - regional(tmp,tmp1,tmp2,out); - tmp=min(length(st1),length(st2)); - flg=0; - forall(1..tmp, - if(flg==0, - tmp1=substring(st1,#-1,#); - tmp2=substring(st2,#-1,#); - if(tmp1tmp2, - out=(1>2); - flg=1; - ); - ); - ); - ); - if(flg==0, - if(length(st1)2); - ); - ); - out; -); - -Figpdf():=Figpdf(Texparent,[]); -Figpdf(Arg1):=( - if(isstring(Arg1), - Figpdf(Arg1,[]); - , - Figpdf(Texparent,Arg1); - ); -); -Figpdf(fnameorg,optionorg):=( -//help:Figpdf(); -//help:Figpdf([10,,10,,[0,2] ]);(margin(4),move) -//help:Figpdf([[0,0]]);(move) -//help:Figpdf(options=[5,5,5,5,[0,0]]]); - regional(options,fname,mar,pos,dp,sc,tmp,tmp1,tmp2,sep); - fname=fnameorg; - if(indexof(fnameorg,".")==0, - fname=fnameorg+".tex"; - ); - tmp=apply(optionorg,if(isstring(#),parse("["+#+"]"),#)); // 16.04.07 - tmp=select(tmp,#!=[]); - options=optionorg;//16.11.08from -// mar=[5,5,5,5]; - dp=[0,-3]; - tmp=select(options,islist(#)); - if(length(tmp)>0, - dp=tmp_1; - options=remove(options,tmp); - ); - tmp=4-length(options); - tmp1=apply(1..tmp,5); - mar=concat(options,tmp1); - mar=apply(mar,if(length(#)==0,5,#));//16.11.08upto - pos=[mar_1+dp_1,mar_3+dp_2]; - sc=10; - tmp=indexof(ULEN,"cm"); - if(tmp>0, - tmp1=Removespace(substring(ULEN,0,tmp-1)); - sc=parse(tmp1)*10; - ); - tmp=indexof(ULEN,"mm"); - if(tmp>0, - tmp1=Removespace(substring(ULEN,0,tmp-1)); - sc=parse(tmp1); - ); - tmp="\documentclass{article}"; // 16.06.09from - if(indexof(PathT,"platex")>0, - tmp=replace(tmp,"article","jarticle"); - if(indexof(PathT,"uplatex")>0, //17.08.13from - tmp=replace(tmp,"jarticle","ujarticle"); - );//17.08.13upto - ); - FigPdfList=append(FigPdfList,tmp); // 16.06.09upto - tmp1="\special{papersize=W mm,H mm}"; - tmp=(XMAX-XMIN)*sc+(mar_1+mar_2); - tmp1=replace(tmp1,"W",text(tmp)); - tmp=(YMAX-YMIN)*sc+(mar_3+mar_4); - tmp1=replace(tmp1,"H",text(tmp)); -// if(iswindows(),sep="\",sep="/");//17.04.08 -// sep="/"; - FigPdfList=append(FigPdfList,tmp1); - if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")>0, //17.11.05from - FigPdfList=append(FigPdfList, - "\usepackage{pict2e}"); - tmp=replace(Dirhead,"\","/"); - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - FigPdfList=append(FigPdfList, - "\usepackage{ketpic2e,ketlayer2e}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - FigPdfList=concat(FigPdfList, - ["\usepackage{"+tmp+"/ketpic2e}", - "\usepackage{"+tmp+"/ketlayer2e}"]); - ); - , - tmp=replace(Dirhead,"\","/"); - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - FigPdfList=append(FigPdfList, - "\usepackage{ketpic,ketlayer}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - FigPdfList=concat(FigPdfList, - ["\usepackage{"+tmp+"/ketpic}", - "\usepackage{"+tmp+"/ketlayer}"]); - ); - );//17.11.05upto - FigPdfList=append(FigPdfList, - "\usepackage{amsmath,amssymb}"); - FigPdfList=append(FigPdfList, - "\usepackage{graphicx,color}"); - forall(ADDPACK, // 16.05.16from - tmp1="\usepackage"+#; //17.07.10 - FigPdfList=append(FigPdfList,tmp1); // 16.09.05upto - ); - FigPdfList=append(FigPdfList,""); - FigPdfList=append(FigPdfList, - "\setmargin{0}{0}{0}{0}"); - FigPdfList=append(FigPdfList,""); - FigPdfList=append(FigPdfList,"\begin{document}"); - FigPdfList=append(FigPdfList,""); - FigPdfList=append(FigPdfList, - "\begin{layer}{50}{0}"); - tmp1="\putnotese{X}{Y}{\input{"; - tmp1=replace(tmp1,"X",text(pos_1)); - tmp1=replace(tmp1,"Y",text(pos_2)); - FigPdfList=append(FigPdfList,tmp1+Fhead+".tex}}"); - FigPdfList=append(FigPdfList,""); - FigPdfList=append(FigPdfList,"\end{layer}"); - FigPdfList=append(FigPdfList,""); - FigPdfList=append(FigPdfList,"\end{document}"); - if(fnameorg!=Texparent, - SCEOUTPUT=openfile(fname); - forall(FigPdfList,println(SCEOUTPUT,#)); - closefile(SCEOUTPUT); - ); - FigPdfList; -); - -Makehelplist(libname):=( - regional(cmdall,cmd,flg,lev,tmp,tmp1,out); - tmp=load(libname); - cmdall=tokenize(tmp,"//help:"); - cmdall=select(cmdall,substring(#,1,3)!=");"); - flg=0; - forall(1..3, - if(flg==0, - if(substring(cmdall_#,0,7)=="start()", - cmdall=cmdall_((#+1)..length(cmdall)); - flg=1; - ); - ); - ); - flg=0; - tmp=length(cmdall); - forall(0..2, - if(flg==0, - if(substring(cmdall_(tmp-#),0,5)=="end()", - cmdall=cmdall_(1..(tmp-#-1)); - flg=1; - ); - ); - ); - out=[]; - forall(cmdall,cmd, - tmp1=indexof(cmd,"("); - lev=1; - flg=0; - forall((tmp1+1)..length(cmd), - if(flg==0, - tmp=substring(cmd,#-1,#); - if(tmp=="(",lev=lev+1); - if(tmp==")", - lev=lev-1; - if(lev==0, - flg=1; - out=append(out,substring(cmd,0,#)+";"); - ); - ); - ); - ); - ); - sort(out); -); - -Helplist():=Helplist(Dirlib,["+","+3d"],"helpJ"); -// 15.05.22 -Helplist(Arg):=( - if(islist(Arg), - Helplist(Dirlib,Arg,"helpJ"); // 15.06.20 - , - if(indexof(Arg,"help")>0, - Helplist(Dirlib,["+","+3d"],Arg); - , - Helplist(Arg,["+","+3d"],"helpJ"); - ); - ); -); -Helplist(Arg1,Arg2):=( - if(islist(Arg1), - Helplist(Dirlib,Arg1,Arg2); - , - if(indexof(Arg2,"help")>0, - Helplist(Dirlib,Arg1,Arg2); - , - Helplist(Arg,["+","+3d"],Arg2); - ); - ); -); -Helplist(dir,files,help):=( -//help:Helplist(); -//help:Helplist("helpE"); - regional(ketfiles,tmp,tmp1,tmp2); - setdirectory(dir); - if(contains(files,"+"), - tmp=remove(files,["+"]); - ketfiles=concat(["+basic1","+basic2","+out"],tmp); - , - ketfiles=files; - ); - ketfiles=apply(ketfiles,replace(#,"+","ketcindylib")); - ketfiles=apply(ketfiles,#+"r.cs"); // 15.11.05 from - tmp=apply(files,replace(#,"+","ketcindylib")); -// tmp=apply(files,replace(#,"r.cs","")); -// tmp=remove(tmp,["ketcindylibout"]); -// tmp=apply(tmp,replace(#,"basic","")); - tmp=apply(tmp,#+help+".txt"); - ketfiles=concat(ketfiles,tmp);// 15.11.05 upto - tmp1=[]; - forall(ketfiles, - tmp=Makehelplist(#); - tmp1=concat(tmp1,tmp); - ); - if(!islist(HLIST), // 16.12.31from - HLIST=sort(tmp1); - , - HLIST=sort(concat(HLIST,tmp1)); - ); // 16.12.31upto - setdirectory(Dirwork); -); - - -Help():=( - forall(HLIST, - println(#); - ); -); -Help(strorg):=( -//help:Help("Plot"); -//help:Help("*"); - regional(str,sel,tmp,tmp1,tmp2,flg,Endflg); - if(length(HLIST)>0,flg=0,flg=-1); - str=replace(strorg,"'",Dq); // 15.11.25 - if(length(str)==0, - forall(HLIST, - if(indexof(#,"*")>0, - println(#); - ); - flg=1; - ); - , - if(str=="*", - sel=HLIST; - , - sel=select(HLIST,substring(#,0,length(str))==str); - ); - if(length(sel)>0,flg=1); - forall(sel, - tmp=indexof(#,"("); - if(substring(#,tmp-2,tmp-1)!="*", - println(#); - , -// println(substring(#,0,tmp-1)); - tmp1=substring(#,tmp,length(#)-2); - tmp2=indexof(tmp1,"//"); - Endflg=0; - forall(1..4, - if(Endflg==0, - tmp2=indexof(tmp1,"//"); - if(tmp2==0, - println(" "+tmp1); - Endflg=1; - , - println(" "+substring(tmp1,0,tmp2-1)); - tmp1=substring(tmp1,tmp2+1,length(tmp1)); - ); - ); - ); - ); - ); - ); - if(flg==-1,println(" Help not read in")); - if(flg==0,println(" no example")); -); - -Helpkey(str):=( - regional(tmp,tmp1,tmp2); - tmp1=select(HLIST,indexof(#,str)>0); - forall(tmp1, - tmp=substring(#,0,indexof(#,"*")-1); - Help(tmp); - ); -); -Helpkey(str1,str2):=( -//help:Helpkey(keyword); -//help:Helpkey(keyword1,keyword2); - regional(tmp,tmp1,tmp2); - tmp1=select(HLIST,indexof(#,str1)>0); - tmp1=select(tmp1,indexof(#,str2)>0); - forall(tmp1, - tmp=substring(#,0,indexof(#,"*")-1); - Help(tmp); - ); -); - -Slidework():=Slidework(Dirwork); // 16.06.10 -Slidework(dirorg):=( -//help:Slidework(directory); - regional(dir,tmp); // 16.06.25 - dir=replace(dirorg,unicode("000a"),""); // 16.06.25 - dir=replace(dir,"/",pathsep());//17.11.20from - dir=replace(dir,"\",pathsep()); - tmp=length(dir); - if(substring(dir,tmp-1,tmp)==pathsep(), - dir=substring(dir,0,tmp-1); - );//17.11.20upto - if(isexists(dir,""), // 16.12.20 - Changework(dir); - println(makedir(dir,"fig"));//17.11.23 - tmp=dir+pathsep()+"fig"; //17.04.16from - Changework(tmp);// 17.02.19upto - , - println(dir+ " not exists"); - ); -); - -Setslidepage():=( // 17.03.05 - regional(tmp1,tmp2,tmp3); - tmp1=["letterc","boxc","framec","shadowc","xpos","size"]; - tmp2=apply([1,2,4,5,7,8],SlideColorList_#); - tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#); - println(tmp3); -); -Setslidepage(list):=( // 16.12.22 -//help:Setslidepage([letterc,boxc,framec,shadowc,xpos,size]); - regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc); - letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; - shadowc=[0,0,0,0.5]; mboxc="yellow"; - if(!islist(SlideColorList), - SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, - letterc,mboxc,mboxc,mboxc,62,2,letterc]; - ); - numlist=[1,2,4,5,7,8]; - forall(1..(length(list)), - if(length(list_#)>0, - tmp=numlist_#; - SlideColorList_tmp=list_#; - ); - ); - SlideColorList_3=SlideColorList_2; - SlideColorList_6=SlideColorList_5; -); - -Setslidemain():=( // 17.03.05 - regional(tmp1,tmp2,tmp3); - tmp1=["letterc","boxc","framec","xpos","size"]; - tmp2=apply([9,10,12,13,14],SlideColorList_#); - tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#); - println(tmp3); -); -Setslidemain(list):=( // 16.12.22 -//help:Setslidemain([letterc,boxc,framec,xpos,size]); - regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc); - letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; - shadowc=[0,0,0,0.5]; mboxc="yellow"; - if(!islist(SlideColorList), - SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, - letterc,mboxc,mboxc,mboxc,62,2,letterc]; - ); - numlist=[9,10,12,13,14]; - forall(1..(length(list)), - if(length(list_#)>0, //17.01.04 - tmp=numlist_#; - SlideColorList_tmp=list_#; - ); - ); - SlideColorList_11=SlideColorList_10; -); - -Setslidebody():=( // 17.03.05 - regional(tmp1,tmp2,tmp3); - tmp1=["letterc","style","thindense"]; - tmp2=[SlideColorList_(15),BodyStyle,ThinDense]; - tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#); - println(tmp3); -); -Setslidebody(str):=( - regional(clr,style,thin); - if(isstring(str), - Setslidebody(str,"\Large\bf\boldmath",0.1); - , - if(length(str)==1,Setslidebody(str_1)); - if(length(str)==2,Setslidebody(str_1,str_2)); - if(length(str)==3,Setslidebody(str_1,str_2,str_3)); - ); -); -Setslidebody(str,Arg):=( //17.01.08 - if(isstring(Arg), - Setslidebody(str,Arg,0.1); - , - Setslidebody(str,"\Large\bf\boldmath",Arg); - ); -); -Setslidebody(str,style,density):=( // 16.12.22,17.01.06,01.08 -//help:Setslidebody(["black",,0]); -//help:Setslidebody(["blue","\Large\bf\boldmath",0.1]); - regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc); - letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; - shadowc=[0,0,0,0.5]; mboxc="yellow"; - if(!islist(SlideColorList), - SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, - letterc,mboxc,mboxc,mboxc,62,2,letterc]; - ); - if(length(str)>0,SlideColorList_(15)=str); - if(length(style)>0,BodyStyle=style); - ThinDense=density;//17.01.08 -); - -Setslidehyper():=( 17.12.16from - Setslidehyper(["cl=true,lc=blue,fc=blue",125,70,1]); -); -Setslidehyper(Arg):=( - if(isstring(Arg), - Setslidehyper(Arg,["cl=true,lc=blue,fc=blue",125,70,1]); - , - Setslidehyper("",Arg); - ); -); -Setslidehyper(driverorg,options):=( -//help:Setslidehyper(); -//help:Setslidehyper("dvipdfmx",["cl=true,lc=blue,fc=blue","Pos=[125,70]","Size=1"]); - regional(driver,eqL,reL,stL,,str,tmp,tmp1,tmp2); - driver=driverorg; - if(length(driver)==0, - if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")==0, - driver="dvipdfmx"; - ); - ); - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - stL=tmp_7; - if(length(stL)>0, - str=stL_1; - , - str=""; - ); - if(length(str)==0, - str="cl=true,lc=blue,fc=blue"; - ); - if(length(driver)==0, - tmp1="["+str+"]"; - , - tmp1="["+driver+","+str+"]"; - ); - tmp1=replace(tmp1,"cl=","colorlinks="); - tmp1=replace(tmp1,"lc=","linkcolor="); - tmp1=replace(tmp1,"fc=","filecolor="); - tmp1=replace(tmp1,"uc=","urlcolor="); - ADDPACK=select(ADDPACK,indexof(#,"hyperref")==0); - Addpackage(tmp1+"{hyperref}"); - LinkPosH=125; - LinkPosV=70; - LinkSize=1; - if(length(reL)>0, - LinkPosH=reL_1; - if(length(reL)>1,LinkPosV=reL_2); - if(length(reL)>2,LinkSize=max(reL_3,0.1)); - ); - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,1)); - tmp2=substring(#,tmp,length(#)); - tmp2=parse(tmp2); - if(tmp1=="P", - LinkPosH=tmp2_1; - LinkPosV=tmp2_2; - ); - if(tmp1=="S", - LinkSize=max(tmp2,0.1); - ); - ); -); //17.12.16upto - -Settitle(cmdL):=Settitle("slide0",cmdL,[]); -Settitle(Arg1,Arg2):=( - if(isstring(Arg1), - Settitle(Arg1,Arg2,[]); - , - Settitle("slide0",Arg1,Arg2); - ); -); -Settitle(name,cmdL,options):=( -//help:Settitle(cmdL); -//help:Settitle(name,cmdL); -//help:Settitle(options=["Layery=0","Color=blue"]); - regional(tmp,tmp1,tmp2,eqL,layery,color,size,font); - TitleName=name; - layery="0"; - color="blue"; - size="\Large"; - font="\bf"; - tmp=Divoptions(options); - eqL=tmp_5; - forall(eqL, - tmp1=Toupper(substring(#,0,1)); - tmp=indexof(#,"="); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="L", - layery=tmp2; - ); - if(tmp1=="C", - color=tmp2; - ); - if(tmp1=="S", - size=tmp2; - if(substring(size,0,1)!="\",size="\"+size); - ); - if(tmp1=="F", - font=tmp2; - if(substring(font,0,1)!="\",font="\"+font); - ); - ); - TitleCmdL=["{"+size+font]; - if(indexof(color,"[")>0, - tmp=replace(color,"[","{"); - tmp=replace(tmp,"]","}"); - tmp1=Indexall(tmp,","); - if(length(tmp1)>=3, - tmp="\color[cmyk]"+tmp; - , - tmp="\color[rgb]"+tmp; - ); - , - tmp="\color{"+color+"}"; - ); - TitleCmdL=append(TitleCmdL,tmp); - TitleCmdL=concat(TitleCmdL,["","\begin{layer}{120}{"+layery+"}"]); - forall(1..(length(cmdL)), - tmp=cmdL_#; - if(length(tmp)>0, - if(#==1, - tmp="{\Huge \putnote"+tmp+"}" - , - tmp="\putnote"+tmp; - ); - TitleCmdL=append(TitleCmdL,tmp); - ); - ); - TitleCmdL=concat(TitleCmdL,["\end{layer}","","}"]); -); - -Maketitle():=( - if(!isstring(TitleName), //17.04.13from - drawtext(mouse().xy,"Settitle not defined", - size->24,color->[1,0,0]); - , //17.04.13upto - Maketitle(TitleName); - ); -); -Maketitle(name):=( -//help:Maketitle(); - regional(texfile,texmain,tmp,tmp1,sep); - texfile=name; - texmain=name+"main"; - SCEOUTPUT=openfile(texfile+".tex"); - forall(TitleCmdL, - println(SCEOUTPUT,#); - ); - closefile(SCEOUTPUT); - SCEOUTPUT=openfile(texmain+".tex"); - tmp="\documentclass[landscape,10pt]{article}"; - if(indexof(PathT,"platex")>0, - tmp=replace(tmp,"article","jarticle"); - if(indexof(PathT,"uplatex")>0, //17.08.13from - tmp=replace(tmp,"jarticle","ujarticle"); - );//17.08.13upto - ); - println(SCEOUTPUT,tmp); - tmp="\special{papersize=\the\paperwidth,\the\paperheight}"; - println(SCEOUTPUT,tmp); - tmp=replace(Dirhead,"\","/");//17.11.01from - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketpic,ketlayer,ketslide}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}"); - );//17.11.01upto - println(SCEOUTPUT,"\usepackage{amsmath,amssymb}"); - println(SCEOUTPUT,"\usepackage{bm,enumerate}"); - if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0), - println(SCEOUTPUT,"\usepackage{graphicx}"); - , - println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}"); - ); - println(SCEOUTPUT,"\usepackage[usenames]{xcolor}"); - forall(ADDPACK, -// if(indexof(#,"[")==0, -// println(SCEOUTPUT,"\usepackage{"+#+"}"); -// , - println(SCEOUTPUT,"\usepackage"+#); // 17.07.10 -// ); - ); - if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE"); - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"\ketslideinit"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\begin{document}"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\input{"+texfile+".tex}"); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\end{document}"); - closefile(SCEOUTPUT); - if(iswindows(), - Makebat(texmain,"tv"); - , - Makeshell(texmain,"tv"); - ); - kc(); -); - -Repeatsameslide(repeatflg,sestr,addedL):=( - regional(seL,flg1,ss,nn,nrep,tmp,tmp1,tmp2,tmp3,str,j,k); - // global RepeatList, SCEOUTPUT - nrep=length(RepeatList); - flg1=0; - forall(addedL,ss, - if(repeatflg==0, - if(substring(ss,0,1)!="%", //16.01.04 - println(SCEOUTPUT,ss); - );//16.01.04 - , - forall(1..nrep,nn, - if(sestr=="", - RepeatList_nn=append(RepeatList_nn,ss); - ); - ); - if(sestr=="", - seL=[1]; - , - tmp1=substring(sestr,1,length(sestr)-1); - tmp1=replace(tmp1,",-",".."+text(nrep)); - tmp1=replace(tmp1,"-,","1.."); - tmp1="["+tmp1+"]"; //17.01.03 - seL=flatten(parse(tmp1)); //17.01.03 - ); - if(contains(seL,1), - if(substring(ss,0,1)!="%", //16.01.04 - println(SCEOUTPUT,ss); - ); - seL=remove(seL,[1]); - flg1=1; - ); - forall(1..(length(seL)),nn, - tmp=seL_nn; - if(tmp<=length(RepeatList), //17.01.12from - RepeatList_tmp=append( RepeatList_tmp,ss); - , - println(" "+sestr+" : "+text(tmp)+" > "+text(length(RepeatList))); - ); - ); - if(ThinFlg==1,//16.01.05from - if(flg1==1,seL=append(seL,1)); - seL=remove(1..nrep,seL); - str=ss; // 17.05.28from - repeat(10, - tmp1=Indexall(str,"{\color"); - if(length(tmp1)>0, - tmp2=Indexall(str,"}"); - tmp=select(tmp2,tmp1_1<#); - tmp=substring(str,tmp1_1,tmp_1); - str=replace(str,tmp+" ",""); - str=replace(str,tmp,""); - ); - );//17.05.28upto - if(contains(seL,1), - if(substring(str,0,1)!="%", - if(NonThinFlg==0, - if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15 - println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23 - println(SCEOUTPUT,str); - println(SCEOUTPUT,"}%"); - , - println(SCEOUTPUT,str); - ); - ); - if(NonThinFlg==1, - if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15 - println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23 - ); - println(SCEOUTPUT,str); - ); - if(NonThinFlg==2, - println(SCEOUTPUT,str); - if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15 - println(SCEOUTPUT,"}%"); - ); - ); - seL=remove(seL,[1]); - ); - ); - if(substring(ss,0,1)!="%", //16.01.04 - forall(1..(length(seL)),nn, - tmp=seL_nn; - if(NonThinFlg==0, - tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23 - tmp1=[tmp1,str,"}%"]; - ); - if(NonThinFlg==1, - tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23 - tmp1=[tmp1,str];//17.01.08upto - ); - if(NonThinFlg==2, - tmp1=[str,"}%"]; - ); - RepeatList_tmp=concat( RepeatList_tmp,tmp1); - ); - ); - );//16.01.05upto - ); - );//16.12.05upto -); - -Presentation(texfile):=Presentation(texfile,texfile); -Presentation(texfile,txtfile):=( -//help:Presentation(texfile,txtfile); - regional(file,flgL,flg,verbflg,slideL,ns,slideorgL,wall,sld,slidecmd,tmp,tmp0,tmp1, - tmp2,tmp3,tmp4,tmp5,newoption,top,repeatflg,nrep,nrepprev,,repstr, - sestr,npara,paradt,parafiles,hyperflg,paractr, - letterc,boxc,shadowc,mboxc,sep); - slidecmd=["\ketcletter","\ketcbox","\ketdbox","\ketcframe", - "\ketcshadow","\ketdshadow","\slidetitlex","\slidetitlesize", - "\mketcletter","\mketcbox","\mketdbox","\mketcframe", - "\mslidetitlex","\mslidetitlesize"]; - if(!isstring(BodyStyle),//17.01.06 - BodyStyle="\Large\bf\boldmath"; - ); - repeatflg=0; - RepeatList=[]; - paractr=0; //16.12.31 - if(indexof(texfile,".")==0,file=texfile+".tex",file=texfile); - if(indexof(txtfile,".")==0,tmp1=txtfile+".txt",tmp1=txtfile); - tmp=load(tmp1); - tmp=replace(tmp,"////","||||");// 16.05.11, 06.24(reactivated) - slideL=tokenize(tmp,"//"); - slideorgL=slideL; // 16.07.11 - slideL=apply(slideL,Removespace(#)); - tmp=select(1..length(slideL),length(slideL_#)>0); // 16.07.11from - slideL=apply(tmp,slideL_#); - slideorgL=apply(tmp,slideorgL_#); -// slideL=select(slideL,length(#)>0); // 16.07.11upto - flg=0; // 16.06.09from - forall(1..10, - if(flg==0, - if(substring(slideL_1,0,1)!="%", - flg=1; - , - slideL=slideL_(2..length(slideL)); - slideorgL=slideorgL_(2..length(slideorgL)); - ); - ); - ); // 16.06.09upto - flgL=[]; - SCEOUTPUT = openfile(file); - tmp=tokenize(slideL_1,"::"); - tmp1=tmp_1; - if(length(tmp)>1, - tmp2=tmp_2; - tmp3=tmp_(3..length(tmp));//16.06.25 - , - tmp2=""; - tmp3=tmp_(2..length(tmp));//16.06.25 - ); - wall=""; // 16.06.10 - if(length(tmp3)>0,//16.06.25from - if(substring(tmp3_1,0,1)!="\" & indexof(tmp3_1,"=")==0, - wall=tmp3_1; - tmp3=tmp3_(2..length(tmp3)); - ); - );//16.06.25upto - tmp="%%% "+tmp1+" "+txtfile;// 16.06.09from - println(SCEOUTPUT,tmp); - tmp="\documentclass[landscape,10pt]{article}"; - if(indexof(PathT,"platex")>0, - tmp=replace(tmp,"article","jarticle"); - if(indexof(PathT,"uplatex")>0, //17.08.13from - tmp=replace(tmp,"jarticle","ujarticle"); - );//17.08.13upto - ); - println(SCEOUTPUT,tmp);// 16.06.09from - tmp=select(1..(length(tmp3)),indexof(tmp3_#,"\usepackage")>0);//17.06.18from - forall(tmp, - println(SCEOUTPUT,tmp3_#); - ); - tmp=remove(1..(length(tmp3)),tmp); - tmp3=tmp3_tmp;//17.06.18upto -// if(iswindows(),sep="\",sep="/"); // 17.04.08 -// sep="/"; - if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0), - if(indexof(PathT,"lualatex")>0, - println(SCEOUTPUT,"\usepackage{luatexja}"); - ); - println(SCEOUTPUT,"\usepackage{pict2e}"); - println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}");// 17.04.08from - , - println(SCEOUTPUT,"\special{papersize=\the\paperwidth,\the\paperheight}"); - );// 17.04.08upto - tmp=replace(Dirhead,"\","/");//17.11.01from - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}"); - ); - if(length(wall)==0, - tmp=replace(Dirhead,"\","/");//17.11.01from - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketslide}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}"); - ); - , - tmp=replace(Dirhead,"\","/"); - tmp=replace(tmp,"scripts","tex/latex"); - if(isexists(tmp,""), - println(SCEOUTPUT,"\usepackage{ketslide2}"); - , - tmp=replace(Dirhead+"/ketpicstyle","\","/"); - println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide2}"); - ); - );//17.04.08upto - println(SCEOUTPUT,"\usepackage{amsmath,amssymb}"); - println(SCEOUTPUT,"\usepackage{bm,enumerate}"); - if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0), - println(SCEOUTPUT,"\usepackage{graphicx}"); - , - println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}"); - ); -// println(SCEOUTPUT,"\usepackage[usenames]{color}"); -// println(SCEOUTPUT,"\usepackage{color}");//17.06.14 - println(SCEOUTPUT,"\usepackage{xcolor}");//17.07.31 - letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; - shadowc=[0,0,0,0.5]; mboxc="yellow"; -// if(!islist(SlideColorList), //17.03.02from -// SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, -// letterc,mboxc,mboxc,mboxc,62,2,letterc]; -// , //17.03.02upto - tmp4="abcdefghijklmno"; - forall(1..15, - tmp=SlideColorList_#; - if(islist(tmp), - tmp=text(tmp); - tmp=substring(tmp,1,length(tmp)-1); - if(length(SlideColorList_#)==4,//17.01.07from - println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{cmyk}{"+tmp+"}"); - ); - if(length(SlideColorList_#)==3, - println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{rgb}{"+tmp+"}"); - );//17.01.07upto - SlideColorList_#="slidecolor"+tmp4_#; - ); - ); -// ); //17.03.02 - println(SCEOUTPUT,"\def\setthin#1{\def\thin{#1}}");//17.08.23 - println(SCEOUTPUT,"\setthin{"+text(ThinDense)+"}");//17.08.23 - forall(ADDPACK,// 16.06.09from -// if(indexof(#,"[")==0, // 16.09.05from -// println(SCEOUTPUT,"\usepackage{"+#+"}"); -// , - println(SCEOUTPUT,"\usepackage"+#); //17.07.10 -// ); - );// 16.06.09upto - tmp=select(ADDPACK,indexof(#,"{hyperref}")>0);//16.12.31from - if(length(tmp)>0, - hyperflg=1; - , - hyperflg=0; //16.12.31upto - ); - forall(tmp3, - println(SCEOUTPUT,#); - ); - if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE"); // 16.06.09 - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"\ketslideinit"); - println(SCEOUTPUT,""); - forall(tmp, // 15.07.21 - if(substring(#,0,1)=="\", println(SCEOUTPUT,#)); - ); - if(!isstring(PageStyle),PageStyle="headings");//17.04.09 - println(SCEOUTPUT,"\pagestyle{"+PageStyle+"}");//17.04.09 - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\begin{document}"); - println(SCEOUTPUT,""); - if(length(wall)>0, - println(SCEOUTPUT,"\input{fig/"+wall+".tex}"); - println(SCEOUTPUT,""); - ); - if(length(tmp2)>0, - if(indexof(tmp2," no")==0, // 16.11.11from - println(SCEOUTPUT,"\begin{layer}{120}{0}"); - if(substring(tmp2,0,1)!="\", - tmp2="\putnotese{0}{0}{\input{fig/"+tmp2+".tex}}";//16.12.27 - ); - println(SCEOUTPUT,tmp2); - println(SCEOUTPUT,"\end{layer}"); - println(SCEOUTPUT,""); - , - tmp=indexof(tmp2,"="); - if(tmp==0, - top="10mm"; - , - top=substring(tmp2,tmp,length(tmp2)); - ); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\vspace*{"+top+"}"); - println(SCEOUTPUT,""); - ); // 16.11.11upto - ); - println(SCEOUTPUT,"\def\mainslidetitley{22}"); - forall(1..14, //16.12.22from - tmp=SlideColorList_#; - if(!isstring(tmp),tmp=text(tmp)); - if(length(tmp)>0, - tmp="\def"+slidecmd_#+"{"+tmp+"}"; - println(SCEOUTPUT,tmp); - ); - );//16.12.22upto - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\color{"+SlideColorList_(15)+"}"); - println(SCEOUTPUT,BodyStyle);//17.01.07 - println(SCEOUTPUT,"\thispagestyle{empty}");//17.01.29 - println(SCEOUTPUT,"\addtocounter{page}{-1}");//17.01.29 - println(SCEOUTPUT,""); - verbflg=0; //16.06.28 - repeatflg=0;//16.12.02 - nrep=0;//16.12.27 - nrepprev=0;//17.01.03 - npara=0;//16.12.27 - forall(2..length(slideL),ns, - ThinFlg=0; - NonThinFlg=0; - flg=0; - tmp1=""; - tmp2=""; - tmp3=""; - sld=removespace(slideL_ns); // 16.06.28 - sestr=""; - if((substring(sld,0,1)=="%") & (substring(sld,0,2)!="%%"), // 17.06.23 - Repeatsameslide(repeatflg,"",[slideL_ns]); - if(repeatflg>0, - tmp=indexof(sld,"]::"); - if(tmp>0, - if(substring(sld,1,2)!="%",//17.05.31 - if(substring(sld,1,5)=="thin", ThinFlg=1); // 17.05.28 - sestr=substring(sld,1,tmp); - sld=substring(sld,tmp+2,length(sld)); - tmp=indexof(sestr,"["); - sestr=substring(sestr,tmp-1,length(sestr));//17.01.05 - ); - ); - ); - if(substring(sld,1,7)=="repeat", // 16.12.09from - tmp=indexof(sld,"="); - tmp5=substring(sld,tmp,length(sld)); - tmp=indexof(tmp5,","); - if(tmp>0,//17.01.03from - tmp5=substring(tmp5,0,tmp-1); - );//17.01.03upto - repeatflg=1; - if(length(tmp5)>0, - nrep=parse(tmp5); - tmp=[]; - if(length(wall)>0, - tmp=["","\input{fig/"+wall+".tex}"]; - ); - tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]); - RepeatList=apply(1..nrep,if(#==1,[],tmp)); - ); - if(sestr=="",flg=1); - tmp=indexof(sld,",");//17.01.03from - if(tmp>0, - sld="%"+substring(sld,tmp,length(sld)); - if(indexof(sld,"=")==0,sld=sld+"="); - );//17.01.03upto - ); - if(substring(sld,1,5)=="para", - paractr=paractr+1; - repeatflg=1; - tmp=indexof(sld,"="); - tmp=substring(sld,tmp,length(sld)); - if(length(tmp)==0, //17.01.03 - npara=0; - , - paradt=tokenize(tmp,":"); - tmp=fileslist(Dirwork+"/fig/"+paradt_1); - if(length(tmp)>0, - parafiles=tokenize(tmp,","); - if(indexof(paradt_4,"input")>0, - tmp0=indexof(paradt_4,",");//17.01.29from - if(tmp0>0, - paradt=append(paradt,substring(paradt_4,tmp0,length(paradt_4))); - paradt_4=substring(paradt_4,0,tmp0-1); - );//17.01.29upto - parafiles=select(parafiles,indexof(#,".tex")>0); - if(indexof(paradt_4,"\input")==0,paradt_4="\"+paradt_4);//16.12.17 - ); - if(indexof(paradt_4,"include")>0, - parafiles=select(parafiles,indexof(#,".pdf")>0); - ); - npara=length(parafiles); - , - println(Dirwork+"/fig/"+paradt_1+" not found"); - parafiles=[]; - npara=0; - ); - if(nrep==0, - nrep=npara; - if(length(wall)>0, - tmp=["","\input{fig/"+wall+".tex}"]; - ); - tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]); - RepeatList=apply(1..nrep,if(#==1,[],tmp)); - ); - ); - forall(1..nrep, //16.12.28 - tmp4=[]; //16.12.31from - if(hyperflg>0, - tmp4=["\hypertarget{para"+text(paractr)+"pg"+text(#)+"}{}"]; - );//16.12.31upto - if(npara>0, //17.01.03 - tmp4=concat(tmp4,["","\begin{layer}{120}"+paradt_2]); - if(#<=npara, //16.12.28from - tmp=parafiles_#; - , - tmp=parafiles_npara; - ); - tmp="{"+paradt_4+"{fig/"+paradt_1+"/"+tmp+"}}"; - if(length(paradt)>=5, - tmp="{\scalebox{"+text(paradt_5)+"}"+tmp+"}"; - ); - if(substring(paradt_3,0,1)=="\", - tmp=paradt_3+tmp; - , - tmp="\putnote"+paradt_3+tmp; - ); - tmp4=concat(tmp4,[tmp]);//16.12.31 - , - tmp4=concat(tmp4,["","\begin{layer}{120}{0}"]); - ); - if((hyperflg>0) & (LinkSize>0.15), - tmp="{"+text(LinkPosV)+"}{\hyperlink{para"; // 17.01.12from - tmp1=tmp+text(paractr)+"pg"; - tmp2=tmp+text(paractr-1)+"pg"+text(nrepprev); - if(#>1,tmp=tmp1+text(1),tmp=tmp2); - tmp3=[text(LinkPosH-29*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{" - +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize) - +"}{\scriptsize $\mathstrut|\!\lhd$}}}}}"]; - if(#>1,tmp=tmp1+text(max(#-3,1)),tmp=tmp2); - tmp3=append(tmp3, - text(LinkPosH-24*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{" - +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize) - +"}{\scriptsize $\mathstrut\!\! \lhd\!\!\lhd\!$}}}}}"); - if(#>1,tmp=tmp1+text(#-1),tmp=tmp2); - tmp3=append(tmp3, - text(LinkPosH-17*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{" - +text(4.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize) - +"}{\scriptsize $\mathstrut\!\!\lhd\!\!$}}}}}"); - tmp="{"+text(LinkPosV)+"}{\hyperlink{para"; - tmp2=tmp+text(paractr+1)+"pg"+text(1); - if(#1,tmp2=tmp_2,tmp2=""); - if(length(tmp)>2,tmp3=tmp_3,tmp3=""); - if(length(tmp)>3,tmp4=tmp_4,tmp4=""); - if(length(tmp)>4,tmp5=tmp_5,tmp5=""); - if(contains(["main","new","same"],tmp1), - if(tmp1=="new", // 16.11.09from - newoption=""; - if(substring(tmp2,0,1)=="[",newoption=tmp2); - ); - if(tmp1=="same", - if(length(tmp2)==0,tmp2=newoption); - );// 16.11.09upto - println(SCEOUTPUT,""); - println(SCEOUTPUT,"%%%%%%%%%%%%%%%%%%%%"); - println(SCEOUTPUT,""); - ); - ); - if(flg==0&tmp1=="main", - if(repeatflg==1, - forall(2..(length(RepeatList)),nrep, - tmp=RepeatList_nrep; - forall(tmp, - if(substring(#,0,1)!="%", //16.01.04 - println(SCEOUTPUT,#); - ); - ); - ); - println(SCEOUTPUT,""); - repeatflg=0;RepeatList=[]; - nrepprev=nrep;//17.01.03 - nrep=0;//16.12.27 - npara=0;//16.12.27 - ); - if(length(wall)>0, - println(SCEOUTPUT,"\input{fig/"+wall+".tex}"); - ); - println(SCEOUTPUT,"\mainslide{"+tmp2+"}"); - println(SCEOUTPUT,""); - tmp2=""; - flg=1; - ); - if(flg==0&tmp1=="new", - if(repeatflg==1, - forall(2..(length(RepeatList)),nrep, - tmp=RepeatList_nrep; - forall(tmp, - if(substring(#,0,1)!="%", //16.01.04 - println(SCEOUTPUT,#); - ); - ); - ); - println(SCEOUTPUT,""); - repeatflg=0;RepeatList=[]; - nrepprev=nrep;//17.01.03 - nrep=0; - npara=0; - ); - if(length(wall)>0, - Repeatsameslide(repeatflg,sestr,["\input{fig/"+wall+".tex}"]); - ); - tmp="\newslide"; - NewSlideOption=""; //17.01.04 - if(substring(tmp2,0,1)=="[", - NewSlideOption=tmp2; //17.01.04 - tmp=tmp+tmp2; - tmp2=tmp3; - tmp3=tmp4; - tmp4=tmp5; - ); - tmp=tmp+"{"+tmp2+"}"; - Repeatsameslide(repeatflg,sestr,[tmp,"","\vspace*{18mm}",""]); - tmp2=""; - flg=1; - ); - if(flg==0&tmp1=="same", - if(repeatflg==1, - forall(2..(length(RepeatList)),nrep, - tmp=RepeatList_nrep; - forall(tmp, - if(substring(#,0,1)!="%", //16.01.04 - println(SCEOUTPUT,#); - ); - ); - ); - println(SCEOUTPUT,""); - repeatflg=0;RepeatList=[]; - nrepprev=nrep;//17.01.03 - nrep=0; - npara=0; - ); - if(length(wall)>0, - println(SCEOUTPUT,"\input{fig/"+wall+".tex}"); - ); - tmp="\sameslide"+NewSlideOption; //17.01.04; -// if(substring(tmp2,0,1)=="[", -// tmp=tmp+tmp2; -// tmp2=tmp3; -// tmp3=tmp4; -// ); - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\vspace*{18mm}"); - println(SCEOUTPUT,""); - tmp4=tmp3; - tmp3=tmp2; - tmp2=""; - flg=1; - ); - if(flg==0&tmp1=="itemize", - Repeatsameslide(repeatflg,sestr,["\begin{itemize}"]); - flgL=append(flgL,"i"); - tmp2=""; - tmp3=""; - flg=1; - ); - if(flg==0&tmp1=="enumerate", - Repeatsameslide(repeatflg,sestr,["\begin{enumerate}"+tmp2]); - flgL=append(flgL,"e"); - tmp2=""; - tmp3=""; - flg=1; - ); - if(flg==0&tmp1=="verbatim", //16.06.28from - Repeatsameslide(repeatflg,sestr,["\begin{verbatim}"]); - flgL=append(flgL,"v"); - tmp1=""; - tmp2=""; - tmp3=""; - verbflg=1; - flg=1; - ); //16.06.28upto - if(flg==0&tmp1=="layer", - Repeatsameslide(repeatflg,sestr,[""]); - tmp="\begin{layer}"; - if(length(tmp2)>0, - tmp=tmp+tmp2; - , - tmp=tmp+"{120}{0}"; - ); - Repeatsameslide(repeatflg,sestr,[tmp]); - flgL=append(flgL,"l"); - tmp2=""; - tmp3=""; - flg=1; - ); - if(flg==0&tmp1=="putnote", - tmp="\putnote"+tmp2+"{"; - if(indexof(tmp3,"include")==0, - tmp1=indexof(tmp3,","); - if(tmp1==0, - tmp=tmp+"\input{fig/"+tmp3+".tex}}"; - , - tmp2=substring(tmp3,tmp1,length(tmp3)); - tmp3=substring(tmp3,0,tmp1-1); - tmp=tmp+"\scalebox{"+tmp2+"}{\input{fig/"+tmp3+".tex}}}"; - ); - , - tmp2=indexof(tmp3,"["); - tmp3=substring(tmp3,tmp2-1,length(tmp3)); - tmp=tmp+"\includegraphics"+tmp3+"{fig/"+tmp4+"}}"; - ); - Repeatsameslide(repeatflg,sestr,[tmp]); - tmp2=""; - tmp3=""; - flg=1; - ); - if(flg==0&tmp1=="item", - NonThinFlg=1; - Repeatsameslide(repeatflg,sestr,["\item"]); - tmp3=""; - flg=1; - ); - if(flg==0&tmp1=="end", - tmp=flgL_(length(flgL)); - if(tmp=="i", - Repeatsameslide(repeatflg,sestr,["\end{itemize}"]); - ); - if(tmp=="e", - Repeatsameslide(repeatflg,sestr,["\end{enumerate}"]); - ); - if(tmp=="l", - Repeatsameslide(repeatflg,sestr,["\end{layer}",""]); - ); - if(tmp=="v", // 16.06.28from - Repeatsameslide(repeatflg,sestr,["\end{verbatim}",""]); - verbflg=0; - ); // 16.06.28upto - flgL=flgL_(1..(length(flgL)-1)); - tmp2=""; - tmp3=""; - flg=1; - ); - if(flg==0, // 16.06.28from - if(verbflg==0, - tmp2=tmp1; - , - tmp2=slideorgL_ns; // 16.07.11 - tmp2=replace(tmp2,"||","//"); // 16.07.10 - tmp3=""; - ); - ); // 16.06.28upto - if(length(tmp2)>0, - if(tmp2=="...", tmp2=""); - if(NonThinFlg==1,NonThinFlg=2); - Repeatsameslide(repeatflg,sestr,[tmp2]); - ); - if(length(tmp3)>0, - Repeatsameslide(repeatflg,sestr,["\begin{layer}{120}{0}"]); - if(substring(tmp3,0,1)=="{", - tmp=tmp3; - tmp3=tmp4; - , - tmp="{60}{0}"; - ); - tmp1=indexof(tmp3,","); - if(tmp1==0, - tmp3="\putnotes"+tmp+"{\input{fig/"+tmp3+".tex}}"; - , - tmp2=substring(tmp3,tmp1,length(tmp3)); - tmp3=substring(tmp3,0,tmp1-1); - tmp3="\putnotes"+tmp+"{\scalebox{"+tmp2+"} - {\input{fig/"+tmp3+".tex}}}"; - ); - Repeatsameslide(repeatflg,sestr,[tmp3,"\end{layer}",""]); - ); - ); - ); - if(repeatflg==1, - forall(2..(length(RepeatList)),nrep, - tmp=RepeatList_nrep; - forall(tmp, - if(substring(#,0,1)!="%", //16.01.04 - println(SCEOUTPUT,#); - ); - ); - ); - println(SCEOUTPUT,""); - ); - println(SCEOUTPUT,""); - println(SCEOUTPUT,"\end{document}"); - closefile(SCEOUTPUT); -); - -Mkslides():=( - regional(sep,parent,texparentorg,tmp,tmp1,tmp2,tmp3,tmp4,flg); - tmp4=Fhead; - Fhead=""; - if(!iswindows(), //17.10.13 - Dirwork=replace(Dirwork,"\",pathsep()); - parent=replace(Dirwork+Shellparent,"\",pathsep()); - , - Dirwork=replace(Dirwork,"/",pathsep()); - parent=replace(Dirwork+Batparent,"/",pathsep());// 16.05.29 - ); - Dirwork=replace(Dirwork,pathsep()+"fig",""); - Setdirectory(Dirwork); - if(length(Texmain)>0, // 15.08.14 from - Texparent=Texmain; - ); - texparentorg=Texparent; //17.04.10from - if(isstring(Slidename), // 15.08.14 from - Texparent=Slidename; - );//17.04.10upto - if(!isexists(Dirwork,Texparent+".txt"), // 17.04.12from - drawtext(mouse().xy,Texparent+".txt not exist in "+Dirwork, - size->24,color->[1,0,0]); - , // 17.04.12upto - Presentation(Texparent); // 15.08.14 upto - if(iswindows(), - tmp2=Batparent; - parent=replace(Dirwork+Batparent,sep+"fig","");// 16.05.29 - if(indexof(Pathpdf,"Adobe")>0, //17.12.09from - Makebat(Texparent,"ttv"); - , - Makebat(Texparent,"tv"); - ); //17.12.09upto - kc():=( - println("kc : "+kc(parent,Dirlib,Fnametex)); // 16.06.10, 17.02.19 - ); - kc(); - Batparent=tmp2; - , - tmp2=Shellparent; - parent=replace(Dirwork+Shellparent,sep+"fig","");// 16.05.29 - Shellparent=replace(Shellparent,sep+"fig",""); - if(indexof(Pathpdf,"Adobe")>0, //17.12.09from - Makeshell(Texparent,"ttv"); - , - Makeshell(Texparent,"tv"); - ); //17.12.09upto - kc():=( - println("kc : "+kc(parent,Mackc+Dirlib,Fnametex)); // 16.06.10 - ); - kc(); - Shellparent=tmp2; - ); - ); - Dirwork=Dirwork+pathsep()+"fig"; //17.10.16 - setdirectory(Dirwork); - Fhead=tmp4; - Texparent=texparentorg;//17.04.10 -); - -Mkslidesummary():=( // 17.10.26 for R - regional(texparentorg); - texparentorg=Texparent; - if(isstring(Slidename), - Texparent=Slidename; - ); - Mkslidesummary(Texparent,Texparent+"digest",["m","Wait=3"]); - Texparent=texparentorg; -); -Mkslidesummary(fin,fout):= - Mkslidesummary(fin,fout,["m","Wait=3"]); -Mkslidesummary(inputfile,outputfile,options):=( -//help:Mkslidesummary(fin,fout,options); - regional(fin,fout,out,figflg,dirworkorg,dirtop,tmp); - dirworkorg=Dirwork;//17.04.10from - dirtop=replace(Dirwork,pathsep()+"fig",""); - Changework(dirtop);//17.04.10uptp - fin=inputfile; - if(indexof(fin,".")==0,fin=fin+".tex"); - fout=outputfile; - if(indexof(fout,".")==0,fout=fout+".tex"); - cmdL=[ - "Dt=readLines('"+fin+"')",[], - "num=grep('\\hypertarget',Dt,fixed=TRUE)",[], - "Dt=Dt[setdiff(1:length(Dt),num)]",[], - "Smain=c();Snew=c();Ssame=c()",[], - "for(J in 1:length(Dt)){",[], - " Tmp=length(grep('\\mainslide',Dt[J],fixed=TRUE))",[], - " if(Tmp>0){Smain=c(Smain,1)}else{Smain=c(Smain,0)}",[], - " Tmp=length(grep('\\newslide',Dt[J],fixed=TRUE))",[], - " if(Tmp>0){Snew=c(Snew,1)}else{Snew=c(Snew,0)}",[], - " Tmp=length(grep('\\sameslide',Dt[J],fixed=TRUE))",[], - " if(Tmp>0){Ssame=c(Ssame,1)}else{Ssame=c(Ssame,0)}",[], - "}",[], - "Nnew=c();Nsame=c()",[], - "for(J in 1:length(Dt)){",[], - " if((Snew[J]==1)|(Smain[J]==1)){Nnew=c(Nnew,J)}",[], - " if(Ssame[J]==1){Nsame=c(Nsame,J)}",[], - "}",[], - "Out=Dt[1:Nnew[1]]",[], - "for(J in 2:length(Nnew)){",[], - " Tmp=max(Nsame[Nsame0, - tmp1=select(tmp1,indexof(#,sub)>0); - ); - forall(tmp1, - if((indexof(#,"##")>0) % (indexof(#,"~#")>0), - tmp=indexof(#,","); - println(substring(#,tmp,length(#))); - , - println(#); - ); - ); -); - -BBdata():=Bbdata(BBTarget,0); -BBdata(fname):=Bbdata(fname,0); // 16.04.09 -BBdata(fname,optionorg):=( -//help:BBdata(filename); -//help:BBdata(options=0(automatic),1(make),"w=","h="); - regional(fout,flg,path,file,kcfile,options,eqL,reL,stL, - waiting,addop,tmp,tmp1,tmp2); - path=""; - file=fname; - flg=0; - waiting=2; - forall(reverse(1..length(fname)), - if(flg==0, - tmp=substring(fname,#-1,#); - if(tmp=="/" % tmp=="\", // 14.01.15 - path=substring(fname,0,#-1); - file=substring(fname,#,length(fname)); - flg=1; - ); - ); - ); - if(path=="",path=Dirwork);//16.10.05 - if(indexof(file,".")==0,file=file+".pdf"); - if(islist(optionorg),options=optionorg,options=[optionorg]); - tmp=divoptions(options); - eqL=tmp_5; - reL=tmp_6; - stL=tmp_7; - flg=0; - addop=""; - if(length(reL)>0, - tmp=reL_1; - if(tmp==1,flg=1); - ); - forall(stL, - tmp=Toupper(substring(#,0,1)); - if(tmp=="M",flg=1); - ); - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,2)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="W=", - addop=addop+",width="+tmp2; - options=remove(options,[#]); - ); - if(tmp1=="H=", - addop=addop+",height="+tmp2; - options=remove(options,[#]); - ); - ); - tmp=indexof(file,"."); - tmp1=substring(file,0,tmp-1); - fout=tmp1+".txt"; - if(iswindows(), - kcfile="kc.bat"; - , - kcfile="kc.sh"; - ); - if(flg==0, - tmp=load(fout); // - if(length(tmp)==0, - flg=1; - , - tmp=tokenize(tmp,"%%"); - tmp=tmp_2; - tmp1=indexof(tmp,":"); - tmp=substring(tmp,tmp1,length(tmp)); - tmp=Removespace(tmp); - if(tmp!=file,flg=1); - ); - ); - if(length(path)==0, - path=Dirwork; - ); - if(flg==1, - setdirectory(path); - tmp=load(file); - setdirectory(Dirwork); - if(length(tmp)==0, - println(" => "+file+" not exists"); - flg=-1; - ); - ); - if(flg==1, - SCEOUTPUT = openfile(kcfile); - if(!iswindows(), - println(SCEOUTPUT,"#!/bin/sh"); - ); - println(SCEOUTPUT,"cd "+Dq+path+Dq); - tmp=replace(PathT,"pdflatex","extractbb"); //16.11.22 - tmp=replace(tmp,"pdftex","extractbb"); //16.11.22 - tmp=replace(tmp,"xelatex","extractbb"); - tmp=replace(tmp,"uplatex","extractbb"); //17.09.20 - tmp=replace(tmp,"platex","extractbb"); - tmp=replace(tmp,"latex","extractbb"); - tmp=tmp+" -O "+file; - if(iswindows(), - tmp=tmp+" > "+Dirwork+"\"+fout; - , - tmp=tmp+" > "+Dirwork+"/"+fout; - ); - println(SCEOUTPUT,tmp); - println(SCEOUTPUT,"exit 0"); - closefile(SCEOUTPUT); - kc(Dirwork+"/"+kcfile,Mackc+Dirlib,Fnametex); // 16.06.07 - ); - if(flg>=0, - tmp1=0; - repeat(floor(waiting*1000/WaitUnit), - if(tmp1==0, - wait(10); - tmp=load(fout); - if(indexof(tmp,"CreationDate")>0, - tmp1=1; - ); - ); - ); - if(length(tmp)==0, - println(fout+" not generated. Maybe "+kcfile+" not run."); - , - tmp=tokenize(tmp,"%%"); - tmp=select(tmp,indexof(#,"Bounding")>0); - tmp=tmp_2; // - tmp1=indexof(tmp,":"); - tmp=substring(tmp,tmp1,length(tmp)); - tmp=removespace(tmp); - tmp=tokenize(tmp," "); - tmp1=""; - forall(tmp, - tmp1=tmp1+Sprintf(#,2)+" "; - ); - tmp1=removespace(tmp1)+addop; - tmp2="\includegraphics[bb="+tmp1+"]{"+file+"}"; - println(tmp2); - ); - ); -// setdirectory(Dirwork); - tmp2; // 16.04.25 -); - -//help:end(); - +// Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team +// +//This program is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation; either version 3 of the License, or +// (at your option) any later version. +// +// This program is distributed in the hope that it will be useful, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with this program. If not, see +// + +println("ketcindybasic2(20180405) loaded"); + +//help:start(); + +Dispchoice():=( + if(islist(Ch), + if(!isreal(ChNum),ChNum=1); + drawtext(mouse().xy,"Ch="+text(Ch)+" N="+text(ChNum),size->24,color->[0,0,1]); + ); +); + +Datetime():=( +//help:Datetime(); + regional(names,dt,tmp); + tmp=getdatetime(); + dt=tokenize(tmp," "); + dt=apply(dt,if(!isstring(#),text(#),#)); + names=["Jan","Feb","Mar","Apr","May","Jun", + "Jul","Aug","Sep","Oct","Nov","Dec"]; + tmp=select(1..12,names_#==dt_2); + tmp=text(tmp_1); + tmp=[dt_6+"/"+tmp+"/"+dt_3,dt_4]; +); + +Rotatepoint(point,Theta,ctr):=( +//help:Rotatepoint(A,2*pi/3,B); + regional(X1,X2,Y1,Y2,Cx,Cy,tmp); + tmp=Lcrd(point); + X1=tmp_1; Y1=tmp_2; + tmp=Lcrd(ctr); + Cx=tmp_1; Cy=tmp_2; + X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta); + Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta); + [X2,Y2]; +); + +Translatepoint(point,mov):=( +//help:Translatepoint(A,[2,3]); + regional(X1,X2,Y1,Y2,Cx,Cy,tmp); + tmp=Lcrd(point); + X1=tmp_1; Y1=tmp_2; + tmp=Lcrd(mov); + Cx=tmp_1; Cy=tmp_2; + X2=X1+Cx; + Y2=Y1+Cy; + [X2,Y2]; +); + +Scalepoint(point,ratio,center):=( +//help:Scalepoint(A,[3,2],[0,0]); + regional(X1,X2,Y1,Y2,Cx,Cy,tmp); + tmp=Lcrd(point); + X1=tmp_1; Y1=tmp_2; + tmp=Lcrd(center); + Cx=tmp_1; Cy=tmp_2; + X2=Cx+ratio_1*(X1-Cx); + Y2=Cy+ratio_2*(Y1-Cy); + [X2,Y2]; +); + +Reflectpoint(point,symL):=( +//help:Reflectpoint(A,B); +//help:Reflectpoint(A,[[2,3]]); +//help:Reflectpoint(A,[C,E]); + regional(X1,X2,Y1,Y2,Us,Vs,Pt1,Pt2,Cx,Cy,tmp); + tmp=Lcrd(point); + X1=tmp_1; Y1=tmp_2; + Pt1=Lcrd(symL_1); + if(length(symL)==1, + Pt2=Pt1; + , + Pt2=Lcrd(symL_2); + ); + Us=Pt2_1-Pt1_1; + Vs=Pt2_2-Pt1_2; + if(Pt1==Pt2, + X2=2*Pt1_1-X1; + Y2=2*Pt1_2-Y1; + , + X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1 + -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); + Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1 + +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); + ); + [X2,Y2]; +); + +Rotatedata(nm,plist,Theta):=Rotatedata(nm,plist,Theta,[]); +Rotatedata(nm,plist,angle,options):=( +//help:Rotatedata("1","crAB",pi/3,[[1,5],"dr,2"]); + regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdLL,PdL, + opcindy,Nj,Njj,Kj,Mj,X1,Y1,X2,Y2,Ltype,Noflg,name); + name="rt"+nm; + Pt=[0,0]; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + tmp1=tmp_6; + if(length(tmp1)>0,Pt=Lcrd(tmp1_1)); + pdata=plist; + if(isstring(pdata),pdata=[pdata]); + if(!isstring(pdata_1) & MeasureDepth(pdata)==1, + pdata=[pdata]; + ); + if(isstring(angle),Theta=parse(angle),Theta=angle); + Cx=Pt_1; Cy=Pt_2; + PdL=[]; + forall(pdata,Njj, + if(isstring(Njj),Kj=parse(Njj),Kj=Njj); + if(MeasureDepth(Kj)==0,Kj=[Kj]); //17.11.24 + if(MeasureDepth(Kj)==1,Kj=[Kj]); + tmp2=[]; + forall(Kj,Nj, + tmp1=[]; + forall(Nj, + tmp=LLcrd(#); + X1=tmp_1; + Y1=tmp_2; + X2=Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta); + Y2=Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta); + tmp1=concat(tmp1,[[X2,Y2]]); + ); + tmp2=concat(tmp2,[tmp1]); + ); + PdL=concat(PdL,tmp2); + ); + if(Noflg<3, + println("generate Rotatedata "+name); + tmp1=[]; + forall(PdL,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + if(length(tmp1)==1,tmp1=tmp1_1); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp1=text(plist); + tmp1=RSform(tmp1);// 17.12.23(2lines) + tmp=name+"=Rotatedata("+tmp1+"," + +textformat(angle,5)+","+RSform(textformat(Pt,5))+")"; //17.12.23 + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + PdL; +); + +Translatedata(nm,plist,mov):=Translatedata(nm,plist,mov,[]); +Translatedata(nm,plist,mov,options):=( +//help:Translatedata("1",["gr1"],[1,2]); + regional(tmp,tmp1,tmp2,pdata,Cx,Cy,PdL,Nj,Njj,Kj, + opcindy,X2,Y2,Ltype,Noflg,name); + name="tr"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + pdata=plist; + if(isstring(pdata),pdata=[pdata]); + if(!isstring(pdata_1) & MeasureDepth(pdata)==1, + pdata=[pdata]; + ); + tmp=Lcrd(mov); + Cx=tmp_1; Cy=tmp_2; + PdL=[]; + forall(pdata,Njj, + if(isstring(Njj),Kj=parse(Njj),Kj=Njj); + if(MeasureDepth(Kj)==1,Kj=[Kj]); + tmp2=[]; + forall(Kj,Nj, + tmp1=[]; + forall(Nj, + tmp=LLcrd(#); + X2=tmp_1+Cx; + Y2=tmp_2+Cy; + tmp1=concat(tmp1,[[X2,Y2]]); + ); + tmp2=concat(tmp2,[tmp1]); + ); + PdL=concat(PdL,tmp2); + ); + if(Noflg<3, + println("generate Translatedata "+name); + tmp1=[]; + forall(PdL,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + if(length(tmp1)==1,tmp1=tmp1_1); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp1=text(plist); + tmp1=RSform(tmp1);// 17.12.23 + tmp=name+"=Translatedata("+tmp1+","+RSform(textformat(mov,5))+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + PdL; +); + +Scaledata(nm,plist,ratioV):=( + regional(tmp); + tmp=Lcrd(ratioV); + Scaledata(nm,plist,tmp_1,tmp_2,[]); +); +Scaledata(nm,plist,Arg1,Arg2):=( +//help:Scaledata("1","crAB",3,2,[[0,0]]); + regional(tmp,options); + if(islist(Arg2), + tmp=Lcrd(Arg1); + options=Arg2; + Scaledata(nm,plist,tmp_1,tmp_2,options); + , + Scaledata(nm,plist,Arg1,Arg2,[]); + ); +); +Scaledata(nm,plist,rx,ry,options):=( + regional(tmp,tmp1,tmp2,pdata,Theta,Pt,Cx,Cy,PdL, + opcindy,Nj,Njj,Kj,X2,Y2,Ltype,Noflg,name); + name="sc"+nm; + Pt=[0,0]; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + tmp1=tmp_6; + if(length(tmp1)>0, + Pt=Lcrd(tmp1_1); + ); + pdata=plist; + if(isstring(pdata),pdata=[pdata]); + if(!isstring(pdata_1) & MeasureDepth(pdata)==1, + pdata=[pdata]; + ); + Cx=Pt_1; Cy=Pt_2; + PdL=[]; + forall(pdata,Njj, + if(isstring(Njj),Kj=parse(Njj),Kj=Njj); + if(MeasureDepth(Kj)==1,Kj=[Kj]); + tmp2=[]; + forall(Kj,Nj, + tmp1=[]; + forall(Nj, + tmp=LLcrd(#); + X2=Cx+rx*(tmp_1-Cx); + Y2=Cy+ry*(tmp_2-Cy); + tmp1=concat(tmp1,[[X2,Y2]]); + ); + tmp2=concat(tmp2,[tmp1]); + ); + PdL=concat(PdL,tmp2); + ); + if(Noflg<3, + println("generate Scaledata "+name); + tmp1=[]; + forall(PdL,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + if(length(tmp1)==1,tmp1=tmp1_1); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp1=text(plist); + tmp1=RSform(tmp1); // 17.12.23 + tmp=name+"=Scaledata("+tmp1+"," + +textformat(rx,5)+","+textformat(ry,5)+","+RSform(textformat(Pt,5))+")"; + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + PdL; +); + +Reflectdata(nm,plist,symL):=Reflectdata(nm,plist,symL,[]); +Reflectdata(nm,plist,symL,options):=( +//help:Reflectdata("1","crAB",[C]); + regional(tmp,tmp1,tmp2,pdata,Us,Vs,Pt1,Pt2,Cx,Cy,PdL, + opcindy,Nj,Njj,Kj,X1,Y1,X2,Y2,Ltype,Noflg,name); + name="re"+nm; + Pt=[0,0]; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opcindy=tmp_(length(tmp)); + pdata=plist; + if(isstring(pdata),pdata=[pdata]); + if(!isstring(pdata_1) & MeasureDepth(pdata)==1, + pdata=[pdata]; + ); + Pt1=Lcrd(symL_1); + if(length(symL)==1, + Pt2=Pt1; + , + Pt2=Lcrd(symL_2); + ); + Us=Pt2_1-Pt1_1; + Vs=Pt2_2-Pt1_2; + PdL=[]; + forall(pdata,Njj, + if(isstring(Njj),Kj=parse(Njj),Kj=Njj); + if(MeasureDepth(Kj)==1,Kj=[Kj]); + tmp2=[]; + forall(Kj,Nj, + tmp1=[]; + forall(Nj, + tmp=LLcrd(#); + X1=tmp_1; + Y1=tmp_2; + if(Pt1==Pt2, + X2=2*Pt1_1-X1; + Y2=2*Pt1_2-Y1; + , + X2=(Us^2-Vs^2)/(Us^2+Vs^2)*X1+2*Us*Vs/(Us^2+Vs^2)*Y1 + -2*Vs*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); + Y2=2*Us*Vs/(Us^2+Vs^2)*X1-(Us^2-Vs^2)/(Us^2+Vs^2)*Y1 + +2*Us*(Us*Pt1_2-Vs*Pt1_1)/(Us^2+Vs^2); + ); + tmp1=concat(tmp1,[[X2,Y2]]); + ); + tmp2=concat(tmp2,[tmp1]); + ); + PdL=concat(PdL,tmp2); + ); + if(Noflg<3, + println("generate Reflectdata "+name); + tmp1=[]; + forall(PdL,tmp2, + tmp=apply(tmp2,Pcrd(#)); + tmp1=append(tmp1,tmp); + ); + if(length(tmp1)==1,tmp1=tmp1_1); + tmp=name+"="+textformat(tmp1,5); + parse(tmp); + tmp1=text(plist); + tmp1=RSform(tmp1);// 17.12.23 + tmp=name+"=Reflectdata("+tmp1+","+RSform(textformat(symL,5))+")";//17.12.23 + GLIST=append(GLIST,tmp); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + PdL; +); + +Mksegments():=Mksegments([]); +Mksegments(options):=( +//help:Mksegments(); + regional(segstr,p,q,r,tmp1,tmp2,tmp3); + forall(allsegments(),seg, + str=text(inspect(seg,"definition")); + tmp1=indexof(str,"("); + tmp2=indexof(str,";"); + tmp3=indexof(str,")"); + p=substring(str,tmp1,tmp2-1); + q=substring(str,tmp2,tmp3-1); + Listplot([parse(p),parse(q)]); + ); +); + +Mkcircles():=Mkcircles([]); +Mkcircles(options):=( +//help:Mkcircles(): + regional(seg,cir,str,p,q,r,tmp1,tmp2,tmp3,tmp4); + forall(allcircles(),cir, + str=text(inspect(cir,"definition")); + tmp1=indexof(str,"("); + tmp2=indexof(str,";"); + tmp3=indexof(str,")"); + tmp4=indexof(str,";",tmp2+1); + if(tmp4==0, + p=substring(str,tmp1,tmp2-1); + q=substring(str,tmp2,tmp3-1); + Circledata([parse(p),parse(q)]); + , + p=substring(str,tmp1,tmp2-1); + q=substring(str,tmp2,tmp4-1); + r=substring(str,tmp4,tmp3-1); + Circledata([parse(p),parse(q),parse(r)]); + ); + ); +); + +MakeRarg(arglist):=( + regional(str,tmpstr); + str=""; + forall(arglist, + if(isstring(#), + tmpstr=Dq+RSslash(#)+Dq; + , + tmpstr=textformat(#,6); + ); + str=str+tmpstr+","; + ); + str=substring(str,0,length(str)-1); + str; +); + +Setax(arglist):=( +//help:Setax(["l","x","e","y","n","O","sw"]); +//help:Setax([7,"nw"]); + regional(tmp); + tmp=MakeRarg(arglist); + Com1st("Setax("+tmp+")"); +); + +Htickmark(arglist):=( +//help:Htickmark([1,"1",2,"sw","2"]); + regional(tmp); + tmp=""; + tmp=MakeRarg(arglist); + Com2nd("Htickmark("+tmp+")"); +); + +Vtickmark(arglist):=( +//help:Vtickmark([1,"1",2,"sw","2"]); + regional(tmp); + tmp=MakeRarg(arglist); + Com2nd("Vtickmark("+tmp+")"); +); + +Vtick(py):=Vtick(py,MARKLEN,[]); +Vtick(py,len):=Vtick(py,len,[]); +Vtick(py,len,options):=( +//help:Vtick(1,0.1,options); + regional(tmp,tmp1,tmp2); + tmp="v"+text(round(py*100)); + tmp=replace(tmp,"-","m"); + tmp1=[0-len/2,py]; + tmp2=[0+len/2,py]; + Listplot(tmp,[tmp1,tmp2],options); +); + +Htick(px):=Htick(px,MARKLEN,[]); +Htick(px,len):=Htick(px,len,[]); +Htick(px,lenorg,options):=( +//help:Htick(-1,0.1,options); + regional(len,tmp,tmp1,tmp2); + tmp=LLcrd([0,lenorg]); + len=tmp_2; + tmp="h"+text(round(px*100)); + tmp=replace(tmp,"-","m"); + tmp1=[px,0-len/2]; + tmp2=[px,0+len/2]; + Listplot(tmp,[tmp1,tmp2],options); +); + +Drwxy():=( +//help:Drwxy(); + Com2nd("Drwxy()"); + Addax(0); // 16.01.21 +); + +Drwpt(pstr):=Drawpoint(pstr); +Drwpt(ptlist,nn):=( // 16.03.05 from +//help:Drwpt(A); +//help:Drwpt("[1,1],0"); +//help:Drwpt(A,0); +//help:Drwpt([1,2],0); + Drawpoint(ptlist,nn); +); +Drawpoint(pstr):=( + if(isstring(pstr), + println("Drwpt : "+pstr); + Com2nd("Drwpt("+pstr+")"); + , + Drawpoint(pstr,1); + ); +); +Drawpoint(ptlistorg,nn):=( + regional(ptlist,thick,tmp,tmp1); + println("Drwpt : "+text(ptlistorg)); + if(islist(ptlistorg), + if(MeasureDepth(ptlistorg)==1, + ptlist=ptlistorg + , + ptlist=[ptlistorg] + ); + , + ptlist=[ptlistorg] + ); + thick=PenThick/PenThickInit;// 16.04.09 from + tmp1=max(TenSize/TenSizeInit,1)/8; + Setpen(tmp1); // 16.04.09 until + forall(ptlist, + tmp=textformat(#,5)+","+text(nn); + Com2nd("Drwpt("+tmp+")"); // 16.04.09 + ); + Setpen(thick); // 16.04.09 +);// 16.03.05 until + +Addax(param):=( +//help:Addax(0); + ADDAXES=textformat(param,5); +); + +Expr(Pt,Dr,St):=Expr([Pt,Dr,St]); +Expr(list):=Expr(list,[]); +Expr(listorg,options):=( //16.10.09 +//help:Expr([A,"e","f(x)=x^2"]); + regional(list,str,tmp,tmp1,tmp2); + list=listorg; + forall(1..round(length(list)/3), + str=list_(3*#); + if(!isstring(str),str=format(str,5)); + str="$"+str+"$"; + list_(3*#)=str; + ); + Letter(list,options); +); + +Letter(Pt,Dr,St):=Letter([Pt,Dr,St]); +Letter(list):=Letter(list,[]); +Letter(list,options):=( +//help:Letter([C,"c","Graph of f(x)"]); + regional(Nj,Pos,Dir,Str,Off,Dmv,Xmv,Ymv,Noflg,opcindy, + opL,aln,sz,clr,bld,ita,tmp,tmp1,tmp2); + tmp=Divoptions(options); + Noflg=tmp_2; + opL=select(options,indexof(#,"->")>0); //16.10.09from + tmp=select(opL,indexof(#,"color")); + size=12; + clr=[0,0,0]; + bld=false; + ita=false; + aln="left"; + forall(opL, + tmp=indexof(#,"->"); + tmp1=removespace(substring(#,0,tmp-1)); + tmp2=substring(#,tmp+1,length(#)); + if(tmp1=="size",sz=parse(tmp2)); + if(tmp1=="color",clr=parse(tmp2)); + if(tmp1=="bold",bld=parse(tmp2)); + if(tmp1=="ita",ita=parse(tmp2)); + );//16.10.09until + Off=-4; + Dmv=8; + Nj=1; + while(Nj+2<=length(list), +// Pos=textformat(list_Nj,5); + Pos=list_Nj; + Dir=list_(Nj+1); + tmp=indexof(Dir,"s")+indexof(Dir,"n");//16.10.19from + if(tmp>0, + tmp=indexof(Dir,"w")+indexof(Dir,"e"); + if(tmp==0, + Dir="c"+Dir;//16.10.08 + ); + );//16.10.19until + Str=list_(Nj+2); + if(!isstring(Str),Str=format(Str,5)); // 16.09.30,10.09 + tmp=replace(Str,".xy",""); + tmp=replace(tmp,".x","(1)"); + Str=replace(tmp,".y","(2)"); + Str=RSslash(Str); // 17.09.24 + Str=replace(Str,"`","'");//180303 + tmp=Dq+","+Dq+Str+Dq+")"; + if(Noflg==0, + Com2nd("Letter("+Lcrd(Pos)+","+Dq+Dir+tmp);//16.10.10 + ); + if(Noflg<2, + Xmv=0;//16.10.13 + Ymv=-4; + if(indexof(Dir,"n")>0, + Ymv=Dmv/2; + ); + if(indexof(Dir,"s")>0, + Ymv=-Dmv*3/2;//16.10.13 + ); + if(indexof(Dir,"e")>0, + Xmv=Dmv/2; + Off=0; + aln="left"; + ); + if(indexof(Dir,"w")>0, + Xmv=-Dmv/2; + Off=0; // 16.09.30from + aln="right"; + ); + if(indexof(Dir,"c")>0, + Xmv=0;//16.10.13 + Off=0; + if(Ymv==0,Ymv=-4);//16.10.08 + aln="mid"; // 16.09.30until + ); + Str=list_(Nj+2); //17.10.17 + drawtext(Pcrd(Pos),Str,offset->[Off+Xmv,Off+Ymv], + size->sz,color->clr,align->aln,bold->bld,italics->ita);//16.10.09 + ); + Nj=Nj+3; + ); +); + +Letterrot(pt,dir,str):=Letterrot(pt,dir,0,0,str); +Letterrot(pt,dir,movstr,str):=( +//help:Letterrot(C,B-A,"AB"): +//help:Letterrot(C,B-A,0,5,"AB"): +//help:Letterrot(C,B-A,"t0n5","AB"): + regional(tmov,nmov,tmp,tmp1,tmp2); + tmp1=indexof(movstr,"t"); + tmp2=indexof(movstr,"n"); + if(tmp1>0, + if(tmp2>0,tmp=tmp2-1,tmp=length(movstr)); + tmov=parse(substring(movstr,tmp1,tmp)); + , + tmov=0; + ); + if(tmp2>0, + nmov=parse(substring(movstr,tmp2,length(movstr))); + , + nmov=0; + ); + Letterrot(pt,dir,tmov,nmov,str); +); +Letterrot(pt,dir,tmov,nmov,str):=( + regional(tmp); + Letter([pt,"c",str],["notex"]); + tmp=replace(str,"\","\\"); //17.10.18 + Com2nd("Letterrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')"); +); + +Exprrot(pt,dir,str):=Exprrot(pt,dir,0,0,str); +Exprrot(pt,dir,movstr,str):=( +//help:Exprrot(C,B-A,"d"): +//help:Exprrot(C,B-A,0,5,"d"): +//help:Exprrot(C,B-A,"t0n5","d"): + regional(tmov,nmov,tmp,tmp1,tmp2); + tmp1=indexof(movstr,"t"); + tmp2=indexof(movstr,"n"); + if(tmp1>0, + if(tmp2>0,tmp=tmp2-1,tmp=length(movstr)); + tmov=parse(substring(movstr,tmp1,tmp)); + , + tmov=0; + ); + if(tmp2>0, + nmov=parse(substring(movstr,tmp2,length(movstr))); + , + nmov=0; + ); + Exprrot(pt,dir,tmov,nmov,str); +); +Exprrot(pt,dir,tmov,nmov,str):=( + regional(tmp); + Expr([pt,"c",str],["notex"]); + tmp=replace(str,"\","\\"); //17.10.18 + Com2nd("Exprrot("+pt+","+dir+","+tmov+","+nmov+",'"+tmp+"')"); +); + +Putslider(ptstr,p1,p2):=Slider(ptstr,p1,p2); +Slider(ptstr,p1,p2):=( //17.04.11 +//help:Slider("A-C-B",[-3,0],[3,0]); + regional(pA,pB,pC,seg,sname,Alpha,tmp,tmp1); + tmp=indexall(ptstr,"-"); + pA=substring(ptstr,0,tmp_1-1); + pC=substring(ptstr,tmp_1,tmp_2-1); + pB=substring(ptstr,tmp_2,length(ptstr)); + seg=pA+pB; + Alpha="ABCDEFGHIJKLMNOPQRSTUVWXYZ"; + sname=""; + forall(1..(length(seg)), + tmp=substring(seg,#-1,#); + tmp1=indexof(Alpha,tmp); + if(tmp1>0, + sname=sname+unicode(text(tmp1+96),base->10); + , + sname=sname+tmp; + ); + ); + Putpoint(pA,p1); + Putpoint(pB,p2); + Listplot([parse(pA),parse(pB)],["notex","color->[0,0.4,0.4]","size->2"]); +// create([sname],"Segment",[parse(pA),parse(pB)]); +// tmp2=Listplot("",[p1,p2],["nodata"]); + Putonseg(pC,parse("sg"+pA+pB)); +// create([pC],"PointOn",[parse(sname),0.5]); +); + +Putpoint(name,Pt):=Putpoint(name,Pt,Pt); +Putpoint(name,Ptinit,Pt):=( +//help:Putpoint("A",[1,2],[1,A.y]); + regional(ptstr); + ptstr=apply(allpoints(),#.name);//16.10.06 + if(!contains(ptstr,name), + createpoint(name,Pcrd([Ptinit_1,Ptinit_2])); + , + ptstr=name+".xy="+textformat(Pcrd(Pt),5); + parse(ptstr); + ); +); + +Bezierpt(t,ptlist,ctrlist):=( + regional(flg3,p0,p1,p2,p3,p4,p5,p6,p7,p8,p9); + p0=ptlist_1; + p3=ptlist_2; + p1=ctrlist_1; + if(length(ctrlist)==1, + p2=p3; + flg3=0; + , + p2=ctrlist_2; + flg3=1; + ); + if(length(p0)<3, // 15.02.08 + p0=Lcrd(p0); + p3=Lcrd(p3); + p1=Lcrd(p1); + p2=Lcrd(p2); + ); + p4=(1-t)*p0+t*p1; + p5=(1-t)*p1+t*p2; + p6=(1-t)*p2+t*p3; + p7=(1-t)*p4+t*p5; + p8=(1-t)*p5+t*p6; + p9=(1-t)*p7+t*p8; + if(flg3==0,p7,p9); +); + +Bezier(ptctrlist):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,[]); +Bezier(ptctrlist,options):=BezierCurve(ptctrlist_3,ptctrlist_1,ptctrlist_2,options); +Bezier(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]); +Bezier(nm,ptlist,ctrlist,options):=BezierCurve(nm,ptlist,ctrlist,options); +BezierCurve(nm,ptlist,ctrlist):=BezierCurve(nm,ptlist,ctrlist,[]); +BezierCurve(nm,ptlistorg,ctrlistorg,options):=( +//help:Bezier("1",[A,D],[B,C]); +//help:Bezier(options=["Num=10"]); + regional(name,Ltype,Noflg,opstr,opcindy,Num, + ptlist,ctrlist,tmp,tmp1,tmp2,ii,st,out,list); + name="bz"+nm; + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + Num=10; + tmp1=tmp_5; + forall(tmp1, // 14.12.31 + if(substring(#,0,1)=="N", + tmp2=indexof(#,"="); + Num=parse(substring(#,tmp2,length(#))); + opstr=opstr+","+Dq+#+Dq; + ); + ); + ptlist=apply(ptlistorg,Lcrd(#)); // 16.08.16 + ctrlist=[]; // 14.12.31 + if(length(ctrlistorg)==length(ptlist)-1, + forall(ctrlistorg,tmp1, + if(MeasureDepth(tmp1)==0,tmp=[tmp1],tmp=tmp1); + tmp=apply(tmp,Lcrd(#)); // 16.08.16 + ctrlist=append(ctrlist,tmp); + ); + , + forall(1..(length(ptlist)-1),ii, + tmp=ctrlistorg_((2*ii-1)..(2*ii)); + tmp=apply(tmp,Lcrd(#)); // 16.08.16 + ctrlist=append(ctrlist,tmp); + ); + ); + if(!islist(Num), + Num=apply(ctrlist,Num); + ); + list=[]; + forall(1..(length(ptlist)-1),ii, + tmp1=ptlist_(ii..(ii+1)); + tmp2=ctrlist_ii; + if(ii==1,st=0,st=1); + forall(st..Num_ii, + tmp=Bezierpt(#/Num_ii,tmp1,tmp2); + list=append(list,tmp); + ); + ); + if(Noflg<3, + println("generate Bezier "+name); + out=apply(list,Pcrd(#)); + tmp=name+"="+textformat(out,5); + parse(tmp); + tmp1=textformat(ptlist,5); + tmp1=RSform(tmp1,2); //17.12.23 + tmp2=textformat(ctrlist,5); + tmp2=RSform(tmp2,3); //17.12.23 + GLIST=append(GLIST,name+"=Bezier("+tmp1+","+tmp2+opstr+")"); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + list; +); + +Readcsvsla(fname):=Readplotdigdata(fname,[]); +Readcsvsla(fname,options):=Readplotdigdata(fname,options); +Readplotdigdata(fname):=Readplotdigdata(fname,[]); +Readplotdigdata(fname,options):=( + regional(fsc,mv,cmdall,dataL,nd,npt,ptdata,ii,tmp,tmp1,tmp2,tmp3); + tmp=Divoptions(options); + tmp1=tmp_6; + sc=1;//10; + mv=[0,0];//[5,5]; + forall(tmp1, + if(!islist(#),sc=#,mv=#); + ); + if(indexof(fname,".")>0, + tmp=load(fname); + , + tmp=load(fname+".txt"); + ); + cmdall=tokenize(tmp,"//"); + dataL=[]; + forall(2..length(cmdall),ii, + tmp1=parse("["+cmdall_ii+"]"); + dataL=append(dataL,tmp1); + ); + if(length(dataL_(length(dataL)))<2, + dataL=dataL_(1..(length(dataL)-1)); + ); + nd=length(dataL_1)/2; + npt=length(dataL); + ptdata=[]; + forall(1..nd,ii, + tmp3=[]; + forall(1..npt, + tmp1=dataL_#_(2*ii-1); + tmp2=dataL_#_(2*ii); + if(isreal(tmp1), + tmp3=append(tmp3,[tmp1,tmp2]); + ); + ); + ptdata=append(ptdata,tmp3); + ); + tmp1=[]; + forall(ptdata, + tmp=#/sc; + tmp=Translatedata("1",[tmp],-mv,["nodata"]); + tmp1=append(tmp1,tmp); + ); + ptdata=tmp1; + ptdata; +); + +Putbezierdata(name,ptL):=Putbezierdata(name,ptL,[]); +Putbezierdata(name,ptL,options):=( + regional(psize,Deg,tmp,tmp1,tmp2,p1,p2,pts,ctrs); + tmp=Divoptions(options); + psize=3; + Deg=3; + tmp1=tmp_5; + forall(tmp1, + if(substring(#,0,1)=="D", + tmp=indexof(#,"="); + Deg=parse(substring(#,tmp,length(#))); + ); + if(substring(#,0,1)=="S", + tmp=indexof(#,"="); + psize=parse(substring(#,tmp,length(#))); + ); + ); + pts=[]; + ctrs=[]; + forall(1..length(ptL), + p2=ptL_#; // 16.08.16 + if(ispoint(p2), + tmp1=text(p2); + , + tmp1=name+text(#); + Putpoint(tmp1,p2,Lcrd(parse(tmp1))); // 16.08.16 + ); + inspect(parse(tmp1),"ptsize",psize); + pts=append(pts,parse(tmp1)); + inspect(parse(tmp1),"color",4); + if(#>1, + p1=Lcrd(ptL_(#-1)); // 16.08.16 + p2=Lcrd(ptL_#); // 16.08.16 + if(Deg==3, + tmp=(2*p1+p2)/3; + tmp1=name+"p"+text(#-1); + Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16 + inspect(parse(tmp1),"labeled",false); //15.01.22 + Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22 + inspect(parse(tmp1),"ptsize",psize); + inspect(parse(tmp1),"color",3); + tmp=(p1+2*p2)/3; + tmp2=name+"q"+text(#-1); + Putpoint(tmp2,tmp,Lcrd(parse(tmp2))); // 16.08.16 + inspect(parse(tmp2),"labeled",false); //15.01.22 + Letter([parse(tmp2),"ne",tmp2],["notex"]); //15.01.22 + inspect(parse(tmp2),"ptsize",psize); + inspect(parse(tmp2),"color",3); + ctrs=append(ctrs,[parse(tmp1),parse(tmp2)]); + , + tmp=(p1+p2)/2; + tmp1=name+"p"+text(#-1); + Putpoint(tmp1,tmp,Lcrd(parse(tmp1))); // 16.08.16 + inspect(parse(tmp1),"labeled",false); //15.01.22 + Letter([parse(tmp1),"ne",tmp1],["notex"]); //15.01.22 + inspect(parse(tmp1),"ptsize",psize); + inspect(parse(tmp1),"color",3); + ctrs=append(ctrs,[parse(tmp1)]); + ); + ); + ); + [pts,ctrs,name]; +); + +Bezierstart(n):=( // 2016.02.26 + BezierNumber=n; +); + +Mkbezierptcrv(ptdata):=Mkbezierptcrv(ptdata,[]); +Mkbezierptcrv(ptdata,options):=( + //help:Mkbezierptcrv([A,B,C,D]); + //help:Mkbezierptcrv([[A,B],[C,D]]); + //help:Mkbezierptcrv(options=["Num=10"]); + // global BezierNumber + regional(ptlist,Out,tmp,tmp1,tmp2); + if(isstring(ptdata), + ptlist=Readcsvsla(ptdata,options); + , + ptlist=ptdata; + ); + if(MeasureDepth(ptlist)==1,ptlist=[ptlist]); + Out=[]; + forall(1..length(ptlist), + tmp=floor((BezierNumber-1)/26);// 15.02.23 + if(tmp==0,tmp="",tmp=text(tmp)); + tmp2=mod(BezierNumber,26); + if(tmp2==0,tmp2=26); + tmp1=unicode(text(96+tmp2),base->10)+tmp;// 15.03.11 + tmp2=Putbezierdata(tmp1,ptlist_#,options); + Bezier(tmp2,options); + BezierNumber=BezierNumber+1; + Out=append(Out,tmp2_(1..2)); + ); + Out; +); + +Mkbeziercrv(nm,ptctrL):=Mkbeziercrv(nm,ptctrL,[]); +Mkbeziercrv(nm,ptctrL,options):=( + //help:Mkbeziercrv("1",[[A,B,C,D],[[P,Q],[R,S],T]]); + regional(ptctrLL,name,ptlist,ctrlist,tmp,tmp1,tmp2); + if(MeasureDepth(ptctrL)==2,ptctrLL=[ptctrL],ptctrLL=ptctrL); + forall(1..length(ptctrLL), + name=nm+text(#); + ptlist=ptctrLL_#_1; + ctrlist=ptctrLL_#_2; + Bezier(nm,ptlist,ctrlist,options); // 17.01.06 + ); +); + +Writebezier():=Writebezier(Fhead,"all"); +Writebezier(head):=Writebezier(head,"all"); +Writebezier(head,seL):=( +//help:Writebezier(file); +//help:Writebezier(file,"acd"); + regional(bz,dt,name,tmp,tmp1,tmp2); + bz=select(GLIST,indexof(#,"=Bezier")>0); + tmp1=[]; // 16.04.22from + if(seL!="all", + forall(1..length(seL), + tmp=substring(seL,#-1,#); + tmp=select(bz,indexof(#,"bz"+tmp)>0); + tmp1=concat(tmp1,tmp); + ); + bz=tmp1;// 16.04.22until + ); + dt=[head+"n",[[length(bz),0]]]; + forall(1..length(bz), + tmp=indexof(bz_#,"="); + name=substring(bz_#,0,tmp-1); + tmp=indexof(bz_#,","+Dq); + if(tmp>0, + tmp1=substring(bz_#,0,tmp-1)+")"; + , + tmp1=bz_#; + ); + tmp1=replace(tmp1,"Bezier(","["); + tmp1=replace(tmp1,"list(","["); + tmp1=replace(tmp1,")","]"); + tmp1=replace(tmp1,",",".xy,"); + tmp1=replace(tmp1,"]",".xy]"); + tmp1=replace(tmp1,".xy,[",",["); + tmp1=replace(tmp1,"].xy","]"); + tmp1=replace(tmp1,name,head+text(#)); + parse(tmp1); + tmp=parse(head+text(#)+"_1"); + dt=concat(dt,[head+text(#)+"k",tmp]); + tmp=parse(head+text(#)+"_2"); + dt=concat(dt,[head+text(#)+"c",tmp]); + ); + WriteOutData(head+".txt",dt); + dt; +); + +Readbezier(file):=Readbezier(file,[]); +Readbezier(file,optionorg):=( +//help:Readbezier("xsr"); +//help:Readbezier(options=["Num=10","nogeo"]); + regional(nn,options,stL,geo,nc,alpha,out,tmp,tmp1,tmp2,tmp3); + options=optionorg; + tmp=Divoptions(options); + stL=tmp_7; + geo=0; + forall(stL, + tmp=Toupper(substring(#,0,1)); + if(tmp=="G",geo=1); + options=remove(options,[#]); + ); + ReadOutData(file); + tmp=file+"n_1_1"; + nn=parse(tmp); + out=[]; + forall(1..nn,nc, + tmp=file+text(nc); + tmp1=parse(tmp+"k"); + tmp2=parse(tmp+"c"); + if(MeasureDepth(tmp2)==1,tmp2=[tmp2]); // 16.04.22from + if(geo==1, + alpha="abcdefghijklmnopqrstuvwxyz"; + forall(1..length(tmp1), + tmp="k"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#); + Putpoint(tmp,tmp1_#,parse(tmp+".xy")); + inspect(parse(tmp),"labeled",false); + inspect(parse(tmp),"ptsize",3); + tmp1_#=parse(tmp+".xy"); + ); + forall(1..length(tmp2), + tmp="c"+BezierNumber+"n"+text(nc)+substring(alpha,#-1,#)+"1"; + Putpoint(tmp,tmp2_#_1,parse(tmp+".xy")); + inspect(parse(tmp),"labeled",false); + inspect(parse(tmp),"color",4); + inspect(parse(tmp),"ptsize",3); + tmp2_#_1=parse(tmp+".xy"); + tmp="c"+BezierNumber+"no"+text(nc)+substring(alpha,#-1,#)+"2"; + Putpoint(tmp,tmp2_#_2,parse(tmp+".xy")); + inspect(parse(tmp),"labeled",false); + inspect(parse(tmp),"color",4); + inspect(parse(tmp),"ptsize",3); + tmp2_#_2=parse(tmp+".xy"); + ); + BezierNumber=BezierNumber+1; + ); + Bezier(file+text(nc),tmp1,tmp2,options);// 16.04.22until + out=append(out,"bz"+tmp); + ); + out; +); + +Ospline(nm,ptlist):=Ospline(nm,ptlist,[]); +Ospline(nm,ptlist,options):=( +//help:Ospline("1",ptlist,[options]); + regional(tmp,tmp1,tmp2,list,ptL,ctrL,name,closed,flg, + p0,p1,p2,p3,pQ,pR,cc,p01,p02,p11,p12,p21,p22,p31,p32); + name="o"+nm; + if(isstring(ptlist),list=parse(ptlist),list=ptlist); + if(|list_1-list_(length(list))|<10^(-6),closed=1,closed=0); +// list=apply(list,LLcrd(#)); + ctrL=[]; + forall(1..(length(list)-1), + flg=0; + p1=Lcrd(list_#); // 16.08.16 + p2=Lcrd(list_(#+1)); // 16.08.16 + if(#==1 % #==length(list)-1, + flg=1; + if(closed==0, + pQ=(p1+2*p2)/3; // 15.09.21 // 16.08.16 + pR=(2*p1+p2)/3; // 16.08.16 + ctrL=append(ctrL,[pQ,pR]); + flg=2; + , + if(#==1, + p0=Lcrd(list_(length(list)-1)); // 16.08.16 + p3=Lcrd(list_(#+2)); // 16.08.16 + , + p0=Lcrd(list_(#-1)); // 16.08.16 + p3=Lcrd(list_2); // 16.08.16 + ); + ); + ); + if(flg<=1, + if(flg==0, + p0=Lcrd(list_(#-1)); // 16.08.16 + p3=Lcrd(list_(#+2)); // 16.08.16 + ); + tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/|p2-p0|/|p3-p1|)/2); + cc=4*|p2-p1|/3/(|p2-p0|+|p3-p1|)/tmp; + pQ=p1+cc*(p2-p0); // 15.09.21 // 16.08.16 + pR=p2+cc*(p1-p3); // 16.08.16 + ctrL=append(ctrL,[pQ,pR]); + ); + ); +// list=apply(list,LLcrd(#)); // 16.08.16 +// ctrL=apply(ctrL,LLcrd(#)); + if(closed==0, // 15.09.21 + p1=ctrL_2_1; + p2=Lcrd(list_2); // 16.08.16 + pQ=p2+(p2-p1); + ctrL_1=[pQ]; + tmp=length(ctrL); + tmp1=ctrL_(tmp-1); + p1=ctrL_(tmp-1)_2; + p2=Lcrd(list_(tmp)); // 16.08.16 + pQ=p2+(p2-p1); + ctrL_tmp=[pQ]; + ); + Bezier("o"+nm,list,ctrL,options); +); + +CRspline(nm,ptL):=CRspline(nm,ptL,[]); +CRspline(nm,ptL,options):=( + // Catmull-Rom spline +//help:CRspline("1",[A,B,C,A]); + regional(name,ptlist,ctrpts,eqL,opcindy,c,v,tmp,tmp1,tmp2,ctrlist,cflg); + name="crsp"+nm; + if(MeasureDepth(ptL)==1,tmp=[ptL],tmp=ptL); + ptlist=tmp_1; + if(length(tmp)==1, + cflg=1; + , + cflg=0; + ctrpts=tmp_2; + ); + c=1/6; + tmp=Divoptions(options); + eqL=tmp_5; + opcindy=tmp_(length(tmp)); // 15.03.05 + forall(eqL, + if(substring(#,0,1)=="R", + tmp2=indexof(#,"="); + c=parse(substring(#,tmp2,length(#))); + ); + ); + ptlist=apply(ptlist,Lcrd(#)); // 16.08.16 + ctrlist=[]; + forall(1..(length(ptlist)-1), + if(#==1, + if(cflg==0, + tmp1=ctrpts_1; + , + v=ptlist_2-ptlist_(length(ptlist)-1); + tmp1=ptlist_#+c*v; + ); + , + v=ptlist_(#+1)-ptlist_(#-1); + tmp1=ptlist_#+c*v; + ); + if(#==length(ptlist)-1, + if(cflg==0, + tmp2=ctrpts_2; + , + v=ptlist_2-ptlist_#; + tmp2=ptlist_(#+1)-c*v; + ); + , + v=ptlist_(#+2)-ptlist_#; + tmp2=ptlist_(#+1)-c*v; + ); + tmp=select(options,indexof(text(#),"->")>0); + tmp=append(tmp,"notex"); //15.03.05 + Pointdata(name+text(#),[tmp1,tmp2],tmp); + ctrlist=append(ctrlist,[tmp1,tmp2]); + ); + Bezier(nm,ptlist,ctrlist,options); +); + +Beziersmooth(nm,ptL):=Bzspline(nm,ptL,[]); +//help:Beziersmooth("1",[A,B,C,A]); +Beziersmooth(nm,ptL,options):=Bzspline(nm,ptL,options); +Bzspline(nm,ptL):=Bzspline(nm,ptL,[]); +Bzspline(nm,ptLorg,options):=( + // smooth bezier + regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr, + tmp,tmp1,tmp2,cflg,ctrlist); + name="bzsp"+nm; + Eps=10^(-3); + ptL=apply(ptLorg,Lcrd(#)); // 16.08.16 + if(|ptL_1-ptL_(length(ptL))|1 % cflg==1, + tmp1="c"+text(#); + inspect(parse(tmp1),"alpha",0.3); + ); + tmp1="C"+text(#)+"p"; + tmp2="C"+text(#)+"q"; + inspect(parse(tmp1),"ptsize",3); + inspect(parse(tmp1),"color",3); + inspect(parse(tmp2),"ptsize",3); + inspect(parse(tmp2),"color",3); + tmp=[parse(tmp1),parse(tmp2)]; + ctrlist=append(ctrlist,tmp); + ); + Bezier(nm,ptL,ctrlist,options); + [ptL,ctrlist]; +); + +Beziersym(nm,ptL):=Bzsspline(nm,ptL,[]); +Beziersym(nm,ptL,options):=Bzsspline(nm,ptL,options); +Bzsspline(nm,ptL):=Bzsspline(nm,ptL,[]); +Bzsspline(nm,ptLorg,options):=( + // smooth bezier with symmetric control points + regional(name,Eps,ptL,pt,pt1,pt2,pt3,npt,lstr, + tmp,tmp1,tmp2,cflg,ctrlist); + name="bzssp"+nm; + Eps=10^(-3); + ptL=apply(ptLorg,Lcrd(#)); // 16.08.16 + if(|ptL_1-ptL_(length(ptL))|Eps, + pcl=list; + pcl_1=2*list_1-list_2; + pcl_k=2*list_k-list_(k-1); + , + pcl=concat(list,[list_2]); + ); + ctrl=apply(2..(length(pcl)-1),[pcl_#]); + ptl=apply(1..(length(pcl)-1),(pcl_#+pcl_(#+1))/2); + [ptl,ctrl]; +); + +Bspline(nm,ctrL):=Bspline(nm,ctrL,[]); +Bspline(nm,ctrL,options):=( +//help:Bspline("",[A,B,C]); + regional(list,tmp); + list=Listbspline2bz(ctrL); + tmp=BezierCurve("b"+nm,list_1,list_2,options); + tmp; +); + +MeetCurve(Crv,Xorg,Yorg):=( + regional(Cv,tmp,tmp1,tmp2,X0,Y0,x1,x2,y1,y2,Ylist,Ban,Tate); + if(isstring(Crv),Cv=parse(Crv),Cv=Crv); + if(MeasureDepth(Cv)==2,Cv=Cv_1); + Cv=apply(Cv,LLcrd(#)); // 14.12.18 + while(length(Cv)==1, + Cv=Cv_1; + ); + Cv=apply(Cv,Lcrd(#)); + tmp1=min(apply(Cv,#_1)); + tmp2=max(apply(Cv,#_1)); + if(isstring(Xorg),X0=parse(Xorg),X0=Xorg); + if(isstring(Yorg),Y0=parse(Yorg),Y0=Yorg); + if(X0tmp2, + X0=tmp2; + ); + ); + tmp1=select( + 1..(length(Cv)-1),Cv_#_1<=X0 & X0<=Cv_(#+1)_1); + tmp2=select( + 1..(length(Cv)-1),Cv_#_1>=X0 & X0>=Cv_(#+1)_1); + tmp2=remove(tmp2,common(tmp2,tmp1)); + Ban=concat(tmp1,tmp2); + Tate=select(Ban, + abs(Cv_#_1-Cv_(#+1)_1)<= + 10^(-2)*abs(Cv_#_2-Cv_(#+1)_2) + ); + Ban=remove(Ban,Tate); + Ylist=[]; + forall(Ban, + tmp=Cv_#; + x1=tmp_1; y1=tmp_2; + tmp=Cv_(#+1); + x2=tmp_1; y2=tmp_2; + tmp=((x2-X0)*y1+(X0-x1)*y2)/(x2-x1); + Ylist=append(Ylist,tmp); + ); + forall(Tate, + tmp=Cv_#; + x1=tmp_1; y1=tmp_2; + tmp=Cv_(#+1); + x2=tmp_1; y2=tmp_2; + tmp1=min([y1,y2]); + tmp2=max([y1,y2]); + if(Y0tmp2, + tmp=tmp2; + , + tmp=Y0; + ); + ); + Ylist=append(Ylist,tmp); + ); + tmp=sort(Ylist,abs(#_1-Y0)); + [X0,tmp_1]; +); + +PutonLine(name,p1,p2):=PutonLine(name,p1,p2,[]); +PutonLine(name,p1org,p2org,options):=( +//help:PutonLine("C","sgAB"); +//help:PutonLine("C",pA,pB); + regional(par,p1,p2,dx,dy,tmp,tmp1,tmp2); + par=0.5; + tmp=Divoptions(options); + if(length(tmp_6)>0, + par=tmp_6_1; + ); + p1=Lcrd(p1org);//16.10.11from + p2=Lcrd(p2org); + dx=p2_1-p1_1; + dy=p2_2-p1_2; + tmp1=(1-par)*p1+par*p2; + if(abs(dx)>abs(dy), + tmp=name+".x"; + tmp2="["+tmp+",dy/dx*("+tmp+"-p1_1)+p1_2]";//16.10.11until + Putpoint(name,tmp1,parse(tmp2)); + , + if(abs(dy)>0, + tmp=name+".y"; + tmp2="[dx/dy*("+tmp+"-p1.y)+p1_1,"+tmp+"]"; + Putpoint(name,tmp1,parse(tmp2)); + , + tmp2=p1;//16.10.11 + Putpoint(name,tmp1,tmp2); + ); + ); +); + +PutonSeg(name,sgstr):=( + regional(seg,p1,p2); + if(isstring(sgstr),seg=parse(sgstr),seg=sgstr); + PutonSeg(name,LLcrd(seg_1),LLcrd(seg_2)); +); +PutonSeg(name,p1,p2):=PutonSeg(name,p1,p2,[]); +PutonSeg(name,p1org,p2org,options):=( +//help:PutonSeg("C","sgAB"); +//help:PutonSeg("C",pA,pB); + regional(par,dx,dy,p,tmp,tmp1,tmp2); + par=0.5; + tmp=Divoptions(options); + if(length(tmp_6)>0, + par=tmp_6_1; + ); + p1=Lcrd(p1org);//16.10.11from + p2=Lcrd(p2org); + PutonLine(name,p1,p2,[par]); + dx=p2_1-p1_1; + dy=p2_2-p1_2; + p=parse(name+".xy"); + p=LLcrd(p); + if(abs(dx)>abs(dy) & (p_1-p1_1)*(p_1-p2_1)>0, + if(|p-p1|<|p-p2|, + parse(name+".xy=Pcrd(p1)"); + , + parse(name+".xy=Pcrd(p2)"); + ); + ); + if(abs(dx)0, + if(|p-p1|<|p-p2|, + parse(name+".xy=Pcrd(p1)"); + , + parse(name+".xy=Pcrd(p2)");//16.10.11until + ); + ); +); + +PutonCurve(pn,crv):=PutonCurve(pn,crv,[]); +PutonCurve(pn,crv,options):=( +//help:PutonCurve("A","gr1"); + regional(Pmt,pstr,optionL,leftlim,rightlim,tmp,tmp1,Flg,Msg); + if(!islist(options),optionL=[options],optionL=options); + leftlim=XMIN; + rightlim=XMAX; + Flg=0; + Msg="y"; + forall(optionL, + if(isstring(#), // 16.02.10 from + tmp=indexof(#,"="); + tmp1=Toupper(substring(#,tmp,tmp+1)); + if(tmp1=="N", Msg="n"); // 16.02.10 until + , + if(Flg==0, + leftlim=#; + Flg=Flg+1; + , + rightlim=#; + ); + ); + ); + Pmt=MeetCurve(crv,leftlim,0); + pstr=apply(allpoints(),textformat(#,5)); // 15.04.07 + if(!contains(pstr,pn), + createpoint(pn,Pcrd(Pmt)); + , + tmp1=parse(pn+".x"); + if(tmp1< leftlim % tmp1>rightlim, + if(tmp1< leftlim,tmp= leftlim, tmp=rightlim); + Pmt=MeetCurve(crv,textformat(tmp,5),pn+".y"); + , + Pmt=MeetCurve(crv,pn+".x",pn+".y"); + ); + ptstr=pn+".xy="+textformat(Pcrd(Pmt),5)+";"; + parse(ptstr); + ); + if(Msg=="y", + println("Put "+pn+" on Curve "+text(crv)); + ); +); + +CrossPoint(name,Crv1,Crv2,range):=( + regional(Mx1,Mx2,Mx3,tmp,Crs1,Crs2,Crs3,Crs4,df1,df2); + Mx1=range_1; Mx2=range_2; + repeat(15, + Mx3=(Mx1+Mx2)/2; + Crs1=MeetCurve(Crv1,Mx1,0); + Crs2=MeetCurve(Crv2,Mx1,0); + Crs3=MeetCurve(Crv1,Mx3,0); + Crs4=MeetCurve(Crv2,Mx3,0); + df1=Crs1_2-Crs2_2; + df2=Crs3_2-Crs4_2; + if((df1>0 & df2>0) % (df1<0 & df2<0), + Mx1=Mx3; + , + Mx2=Mx3; + ); + ); + Putpoint(name,Crs1); +); + +Setscaling(sc):=( +//help:Setscaling(3); + SCALEX=1; + SCALEY=sc; + Com0th("Setscaling("+sc+")"); + Setwindow("Msg=no"); +); + +Periodfun(defL,rep):=Periodfun(defL,rep,[]); +Periodfun(defL,rep,optionorg):=( // 16.11.24 +//help:Periodfun(["0",[-1,0],"1",1,[0,1],1],2(num of repetition),options); +//help:Periodfun(options=["Con=y"]); +//help:Periodfun(defL=[function string, range, devision number,...]); + regional(nn,fun,range,num,options,nr,maxfun, + tmp,tmp1,tmp2,eqL,connect,minx,maxx,pdata,Eps,prept); + options=optionorg; + tmp=Divoptions(options); + eqL=tmp_5; + connect="Y"; + forall(eqL, + tmp=indexof(#,"="); + tmp2=substring(#,tmp,tmp+1); + tmp=substring(#,0,3); + if(Toupper(tmp)=="CON", + connect=Toupper(tmp2); + options=remove(options,[#]); + ); + ); + minx=10000; + maxx=-10000; + mxfun=""; + pdata=[]; + forall(1..(length(defL)/3),nn, + fun=defL_(3*nn-2); + range=defL_(3*nn-1); + tmp1=if(isstring(range_1),parse(range_1),range_1); //17.06.11(2lines) + tmp2=if(isstring(range_2),parse(range_2),range_2); + minx=min(minx,tmp1); + maxx=max(maxx,tmp2); + num=defL_(3*nn); + options=append(options,"Num="+text(num)); + Plotdata("pe"+text(nn),fun, + "x="+textformat([tmp1,tmp2],5),options); + pdata=append(pdata,"grpe"+text(nn)); + tmp1=range_1; //17.06.11(4lines) + if(isstring(tmp1),tmp1=replace(tmp1,"pi","%pi"),tmp1=format(tmp1,5)); + tmp2=range_2; + if(isstring(tmp2),tmp2=replace(tmp2,"pi","%pi"),tmp2=format(tmp2,5)); + mxfun=mxfun+"elseif ("+tmp1+ + "<=x and x<"+tmp2+") then "+fun+" "; + ); + per=maxx-minx; + forall(1..rep,nr, + tmp1=[]; + forall(pdata, + Translatedata("p"+#+text(nr),#,[per*nr,0],options); + Translatedata("m"+#+text(nr),#,[-per*nr,0],options); + tmp1=concat(tmp1,["trp"+#+text(nr),"trm"+#+text(nr)]); + ); + ); + pdata=concat(pdata,tmp1); + if(connect=="Y", + Eps=10^(-5); + pdata=sort(pdata,[parse(#)_1_1]); + prept=parse(pdata_1)_1; + forall(1..(length(pdata)), + tmp=parse(pdata_#); + tmp1=tmp_1; + tmp2=tmp_(length(tmp)); + if(|prept-tmp1|>Eps, + Listplot("con"+text(#),[prept,tmp1],append(options,"da")); + ); + prept=tmp_(length(tmp)); + ); + ); + mxfun=substring(mxfun,4,length(mxfun)-1); + [mxfun,per]; +); + +Fourierseries(nm,coeff,per,nterm):= + Fourierseries(nm,coeff,per,nterm,[]); // 16.11.24 +Fourierseries(nm,coeff,per,nterm,options):=( +//help:Fourierseries("1",[c0,cn,sn],period,numterm,options); + regional(c0,cn,sn,fs,tmp,tmp1,tmp2); + c0=coeff_1; + if(!isstring(c0),c0=format(c0,5)); + c0=replace(c0,"%pi","pi"); + cn=coeff_2; + if(!isstring(cn),cn=format(cn,5)); + cn=replace(cn,"%pi","pi"); + sn=coeff_3; + if(!isstring(sn),sn=format(sn,5)); + sn=replace(sn,"%pi","pi"); + fs=c0; + forall(1..nterm, + tmp=parse(Assign(cn,["n",#])); + tmp1=Assign("("+format(tmp,5)+")*cos(n*2*pi/per*x)", + ["n",#,"per",per]); + tmp=parse(Assign(sn,["n",#])); + tmp2=Assign("("+format(tmp,5)+")*sin(n*2*pi/per*x)", + ["n",#,"per",per]); + fs=fs+"+"+tmp1+"+"+tmp2; + ); + Plotdata("four"+nm,fs,"x",options); +); + +Tabledatalight(nm,xLst,yLst,rmvL):=Tabledatalight(nm,xLst,yLst,rmvL,[]); +Tabledatalight(nm,xLst,yLst,rmvL,optionorg):=( +//help:Tabledatalight("",xLst,yLst,rmvL,[2,"Rng=y"]); + regional(options,rng,name,upleft,ul,flg,tick,eqL,reL,n,m,xsize,ysize, + rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps); +// name="tb"+nm; + name="tb"; + options=optionorg; + tmp=Divoptions(options); + eqL=tmp_5; //16.12.16from + reL=tmp_6; + rng="Y"; + forall(eqL, + tmp=indexof(#,"="); + tmp1=Toupper(substring(#,0,2)); + tmp2=Toupper(substring(#,tmp,tmp+1)); + if(tmp1=="RN", + rng=tmp2; + options=remove(options,[#]); + ); + );//16.12.16until + tick=1; + flg=0; + forall(reL, + if(flg==0, + tick=#; + flg=flg+1; + , + upleft=tmp_6_1; + ); + ); + tmp=sum(yLst); + upleft=[0,tmp]; + TableOptions=options; // 16.11.28 + println("Tabledatalight "+name+" generated"); + ul=upleft/10; + m=length(xLst); + n=length(yLst); + xsize=sum(xLst); + ysize=sum(yLst); + clist=[ul]; + rlist=[ul]; + forall(1..m, + tmp1=clist_(#)_1+xLst_#/10; + clist=append(clist,[tmp1,clist_1_2]); + ); + forall(1..n, + tmp1=rlist_(#)_2-yLst_#/10; + rlist=append(rlist,[0,tmp1]); + ); + Tb=[clist,rlist]; + tmp=name+"="+Tb; + parse(tmp); + forall(0..m, + tmp1="c"+text(#)+"r0"; + tmp2="c"+text(#)+"r"+text(n); + Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options); + if(mod(#,tick)==0 % #==m, + tmp=clist_(#+1); + drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#)); + ); + ); + forall(0..n, + tmp1="c0r"+text(#); + tmp2="c"+text(m)+"r"+text(#); + Tlistplot("r"+text(#)+"c0c"+text(m),[tmp1,tmp2],options); + if(mod(#,tick)==0 % #==n, + tmp=rlist_(#+1); + drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#)); + ); + ); + Tsegrmv(rmvL,options); + Addax(0); + Eps=10^(-3); + tmp1=clist_(length(clist)); + tmp2=rlist_1; + tmp3=rlist_(length(rlist)); + if(rng=="Y", // 16.12.16 + Setwindow([0-Eps,tmp1_1+Eps],[tmp3_2-Eps,tmp2_2+Eps]); + ); + Tb; +); + +Tabledata(nm,n,m,xsize,ysize,rmvL):= + Tabledata(nm,n,m,xsize,ysize,rmvL,[]); +Tabledata(nm,n,m,xsize,ysize,rmvL,options):=( +//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]); + regional(Tb,name,tmp,xLst,yLst); + name="tb"+nm; + xLst=apply(1..n,xsize/n); + yLst=apply(1..m,ysize/m); + Tabledata(nm,xLst,yLst,rmvL,options) +); +Tabledata(nm,xLst,yLst,rmvL):=Tabledata(nm,xLst,yLst,rmvL,[]); +Tabledata(nm,xLst,yLst,rmvL,optionorg):=( +//help:Tabledata("",xLst,yLst,rmvL,[2,"Rng=y"]); + regional(name,options,eqL,reL,rng,upleft,ul,flg,tick,n,m,xsize,ysize, + rlist,clist,Tb,tmp,tmp1,tmp2,tmp3,Eps); +// name="tb"+nm; + name="tb"; + tmp=sum(yLst); + upleft=[0,tmp]; + options=optionorg; + tmp=Divoptions(options); + eqL=tmp_5; //16.12.16from + reL=tmp_6; + rng="Y"; + forall(eqL, + tmp=indexof(#,"="); + tmp1=Toupper(substring(#,0,2)); + tmp2=Toupper(substring(#,tmp,tmp+1)); + if(tmp1=="RN", + rng=tmp2; + options=remove(options,[#]); + ); + );//16.12.16until + tick=1; + flg=0; + forall(reL, + if(flg==0, + tick=#; + flg=flg+1; + , + upleft=tmp_6_1; + ); + ); + TableOptions=options; // 16.11.28 + println("Tabledata "+name+" generated"); + ul=upleft/10; + m=length(xLst); + n=length(yLst); + xsize=sum(xLst); + ysize=sum(yLst); + clist=[ul]; + rlist=[ul]; + forall(1..m, + tmp1=clist_(#)_1+xLst_#/10; + clist=append(clist,[tmp1,clist_1_2]); + ); + forall(1..n, + tmp1=rlist_(#)_2-yLst_#/10; + rlist=append(rlist,[0,tmp1]); + ); + Tb=[clist,rlist]; + tmp=name+"="+Tb; + parse(tmp); + forall(0..m, + tmp="C"+text(#); + tmp1="c"+text(#)+"r0"; + if(#==0, + Putpoint(tmp,Tgrid(tmp1)); + , + Putpoint(tmp,Tgrid(tmp1),[parse(tmp+".x"),C0.y]); + clist_(#+1)=parse(tmp+".xy"); + ); + inspect(parse(tmp),"ptsize",3); + inspect(parse(tmp),"labeled",false); + if(mod(#,tick)==0 % #==m, + tmp=clist_(#+1); + drawtext(clist_(#+1)-[0.04,-0.1],"c"+text(#)); + ); + ); + forall(0..n, + tmp="R"+text(#); + tmp1="c0r"+text(#); + if(#==0, + Putpoint(tmp,Tgrid(tmp1)); + , + Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]); + rlist_(#+1)=parse(tmp+".xy"); + ); + Putpoint(tmp,Tgrid(tmp1),[R0.x,parse(tmp+".y")]); + inspect(parse(tmp),"ptsize",3); + inspect(parse(tmp),"labeled",false); + if(mod(#,tick)==0 % #==n, + tmp=rlist_(#+1); + drawtext(rlist_(#+1)-[0.4,0.1],"r"+text(#)); + ); + ); + Tb=[clist,rlist]; + tmp=name+"="+Tb; + parse(tmp); + forall(0..m, + tmp1="c"+text(#)+"r0"; + tmp2="c"+text(#)+"r"+text(n); + Tlistplot("c"+text(#)+"r0r"+text(n),[tmp1,tmp2],options); + if(#=n1 & m2<=n2, + gc=#; + flg=1; + ); + ); + ); + if(flg==1, + Changestyle([gc_1],["nodisp"]); + tail=""; + if(indexof(hd,"r")>0, + tail=hd; hd=""; + ); + if(n1=tmp_1) & (tsg_2<=tmp_2), + sg=tmp; + Changestyle(#,["nodisp"]); + ); + ); + if(length(sg)==0, + println("No segment includes "+grid); + , + if(sb=="c",str=sb+"no"+head,str=head+sb+"no"); + if(sg_10, + posdir_2=posdir_2-dy; + posstr=replace(posstr,"b","n"); + ); + if(indexof(dir,"t")>0, + posdir_2=posdir_2+dy; + posstr=replace(posstr,"t","s"); + ); + if(indexof(dir,"l")>0, + posdir_1=posdir_1-dx; + posstr=replace(posstr,"l","e"); + ); + if(indexof(dir,"r")>0, + posdir_1=posdir_1+dx; + posstr=replace(posstr,"r","w"); + ); + Letter(posdir,posstr,text(lttr)); +); + +Putcellexpr(pos1,pos2,dir,ex):=Putcellexpr("",pos1,pos2,dir,ex); +Putcellexpr(Tbdata,pos1,pos2,dir,ex):=( +//help:Putcellexpr("c0r0","c2r1","lt","abc"); +//help:Putcellexpr(2,3,"c","\sin x"); + Putcell(Tbdata,pos1,pos2,dir,"$"+text(ex)+"$"); +); + +Putrow(nrow,dir,lttrL):=Putrow("",nrow,dir,lttrL); +Putrow(Tbdata,nrow,dir,lttrL):=( +//help:Putrow(1,"c",["x","y","z"]); + regional(tmp,tmp1,mcol); + mcol=length(lttrL); + forall(1..mcol, + Putcell(Tbdata,#,nrow,dir,lttrL_#); + ); +); + +Putrowexpr(nrow,dir,exL):=Putrowexpr("",nrow,dir,exL); +Putrowexpr(Tbdata,nrow,dir,exL):=( +//help:Putrowexpr(2,"r",["x","y","z"]); + regional(lttrL); + lttrL=apply(exL,"$"+#+"$"); + Putrow(Tbdata,nrow,dir,lttrL); +); + +PutcoL(mcol,dir,lttrL):=PutcoL("",mcol,dir,lttrL); +PutcoL(Tbdata,mcol,dir,lttrL):=( +//help:PutcoL(1,"c",["x","y","z"]); + regional(tmp,tmp1,nrow); + nrow=length(lttrL); + forall(1..nrow, + Putcell(Tbdata,mcol,#,dir,lttrL_#); + ); +); +PutcoLexpr(mcol,dir,exL):=PutcoLexpr("",mcol,dir,exL); +PutcoLexpr(Tbdata,mcol,dir,exL):=( +//help:PutcoLexpr(2,"r",["x","y","z"]); + regional(lttrL); + lttrL=apply(exL,"$"+#+"$"); + PutcoL(Tbdata,mcol,dir,lttrL); +); + +Setrange():=( +//help:Setrange(); + SW.xy=Pcrd([XMIN,YMIN]); + NE.xy=Pcrd([XMAX,YMAX]); + drawpoly([Pcrd([XMIN,YMIN]), Pcrd([XMAX,YMIN]), + Pcrd([XMAX,YMAX]),Pcrd([XMIN,YMAX])],color->[1,1,1]); +); + +Sciform(list):=( + regional(plotlist,comp,pos,out,out2,nn,strL,flg, + tmp,tmp1,tmp2,tmp3,Nj); + plotlist=Flatten([list]); + out=replace(plotlist_1,".xy",""); + out=replace(out,".x","(1)"); + out=replace(out,".y","(2)"); + if(length(plotlist)==1, + comp=[]; + forall(1..length(out), + comp=append(comp,substring(out,#-1,#)); + ); + out=""; + pos=0; + forall(comp, + if(#!="'", + out=out+#; + , + if(pos==0, + tmp=indexof(out,"Assign("); + if(substring(out,length(out)-7,length(out))=="Assign(", + out=out+"'"; + pos=1; + , + out=out+"Assign('"; + pos=2; + ); + , + if(pos==2, + out=out+"')"; + , + out=out+"'"; + ); + pos=0; + ); + ); + ); + , + forall(2..length(plotlist), + comp=plotlist_#; + if(isstring(comp), + pos=indexof(comp,"Assign("); + if(pos>0, + comp=substring(comp,6,length(comp)); + ); + out=out+"Assign("; + comp=replace(comp,".xy",""); + comp=replace(comp,".x","(1)"); + comp=replace(comp,".y","(2)"); + out=out+"'"+comp+"'"; + out=out+"),"; + ); + if(islist(comp), + forall(comp, + out=out+"'"+#+"',"; + ); + ); + ); + if(length(plotlist)>1, + out=substring(out,0,length(out)-1); + out=out+");"; + ); + ); + pos=[]; + forall(1..length(out), + tmp=indexof(substring(out,#-1,length(out)),"Assign"); + if(tmp>0, + tmp1=#-1+tmp; + if(length(pos)==0, + pos=[tmp1]; + , + if(pos_(length(pos))0, + strL=[]; + Nj=0; + forall(pos, + tmp=substring(out,Nj,#-1); + strL=append(strL,tmp); + Nj=#-1; + ); + strL=append(strL,substring(out,Nj,length(out))); + out=""; + forall(strL, + if(indexof(#,"Assign")==0, + out=out+#; + , + tmp=indexof(#,"('"); + tmp1=indexof(#,"')"); + tmp2=substring(#,tmp+1,tmp1-2); + tmp3=substring(#,tmp1-2,length(#)); + if(indexof(tmp2,"=")==0, + out=out+#; + , + tmp=substring(tmp2,0,indexof(tmp2,"=")); + out=out+"'"+tmp+"'+"+"Assign('"; + tmp=substring(tmp2,indexof(tmp2,"="),length(tmp2)); + out=out+tmp+tmp3; + ); + ); + ); + ); + out2=""; // patched 16.01.21 from + nn=length(out); + flg=0; + forall(1..nn, + if(flg==0, + tmp=indexof(out,"='+Assign('"); + if(tmp==0, + out2=out2+out; + flg=1; + , + out2=out2+substring(out,0,tmp); + out=substring(out,tmp+10,length(out)); + tmp=indexof(out,"'"); // 16.04.19 from + tmp1=substring(out,0,tmp-1); + tmp2="1234567890"; + tmp=apply(1..length(tmp1), + indexof(tmp2,substring(tmp1,#-1,#))); + tmp=min(tmp); + if(tmp==0, // 16.04.19 until + out2=out2+"'+Assign('"; + , + tmp=indexof(out,"'"); + out=substring(out,0,tmp)+substring(out,tmp+1,length(out)); + // 16.04.18 until + ); + ); + ); + ); + out2=replace(out2,"Dist=","D="); + out2=replace(out2,"Dis=","D="); + out2; +); + +RSform(str):=RSform(str,3); +RSform(str,listfrom):=( +//help:RSform(string,listfrom); + regional(posL,mxlv,rep1,rep2,rep3,prev,out, + tmp,tmp1,tmp2); + rep1="c("; rep2="c("; rep3="list("; + if(listfrom<3,rep2="list("); + if(listfrom==1,rep1="list("); + posL=Bracket(str,"[]"); + tmp=apply(posL,#_2); + mxlv=max(tmp); + out=""; + prev=0; + forall(posL, + out=out+substring(str,prev,#_1-1); + prev=#_1; + if(#_2>0, + tmp1=select(posL,tmp,(tmp_2<0)&(tmp_1>#_1)); + tmp1=tmp1_1_1; + tmp=substring(str,#_1,tmp1); + if(#_2==mxlv,out=out+rep1); + if(#_2==mxlv-1,out=out+rep2); + if(#_2<=mxlv-2,out=out+rep3); + , + out=out+")"; + ); + ); + out=out+substring(str,prev,length(str)); + out=replace(out,".xy",""); + out=replace(out,".x","[1]"); + out=replace(out,".y","[2]"); + out=replace(out,"c(1)","[1]");//17.10.06(2lines) + out=replace(out,"c(2)","[2]"); + out; +); + +RSslash(str):=( //17.09.24 + regional(tmp); + tmp=replace(str,"\","\\"); +// tmp=replace(tmp,"\\\\","\\"); + tmp; +); + +Rform(list):=( + regional(plotlist,comp,pos,out,strL,tmp,tmp1,tmp2,tmp3,Nj); + out=list; + out=replace(out,"[[[","list([["); + out=replace(out,"[","c("); + out=replace(out,"]",")"); + out=replace(out,".xy",""); + out=replace(out,".x","[1]"); + out=replace(out,".y","[2]"); + out; +); + +Defvar(varstr):=( + regional(name,value,tmp,tmp1); + if(isstring(varstr), + parse(varstr); + tmp=indexof(varstr,"="); + name=substring(varstr,0,tmp-1); + value=substring(varstr,tmp,length(varstr)); + value=parse(value); + tmp1=select(1..length(VLIST),VLIST_#_1==name); + if(length(tmp1)>0, + tmp=tmp1_1; + VLIST_tmp=[name,value]; + , + VLIST=prepend([name,value],VLIST); + ); + , + forall(1..(length(varstr)/2), // 16.11.16from + name=varstr_(2*#-1); + value=varstr_(2*#); + Defvar(name,value); + ); // 16.11.16until + ); +); + +Defvar(name,value):=( +//help:Defvar("a",0.3); +//help:Defvar(["a",0.3,"b",2]); + regional(tmp,tmp1); + if(islist(value), + tmp1="["; + forall(value, + if(isstring(#), // 16.11.14 + tmp1=tmp1+Dq+#+Dq+","; // 16.11.14 + , + tmp1=tmp1+format(#,5)+","; + ); + ); + tmp1=substring(tmp1,0,length(tmp1)-1)+"]"; + , + tmp1=format(value,5); + ); + tmp=name+"="+tmp1; // 15.02.06 + parse(tmp); + VLIST=select(VLIST,#_1!=name); // 15.02.08 + VLIST=prepend([name,value],VLIST); +); + +IftoR(strorg):=( + regional(str,pre,post,sub,ppL,ifstr,out,tmp,tmp1,tmp2); + str=strorg; + ifstr=indexof(str,"if("); + if(ifstr==0, + out=replace(str,",","}else{"); + , + pre=substring(str,0,ifstr-1)+"if("; + ppL=Bracket(str,"()"); + tmp1=ifstr+2; + tmp=select(ppL,#_1==tmp1); + tmp=select(ppL,#_2==-tmp_1_2); + tmp2=tmp_1_1; + sub=substring(str,tmp1,tmp2-1); + post="}"+substring(str,tmp2,length(str)); + tmp=indexof(sub,","); + tmp1=substring(sub,0,tmp-1); + tmp2=substring(sub,tmp,length(sub)); + sub=tmp1+"){"+tmp2; + tmp=IftoR(sub); + out=pre+tmp+"}"; + ); + out; +); + +FortoR(strorg):=( + regional(str,pre,post,sub,ppL,forstr,out,tmp,tmp1,tmp2); + str=strorg; + forstr=indexof(str,"forall("); + if(forstr==0, + out=str; + , + pre=substring(str,0,forstr-1)+"for("; + ppL=Bracket(str,"()"); + tmp1=forstr+6; + tmp=select(ppL,#_1==tmp1); + tmp=select(ppL,#_2==-tmp_1_2); + tmp2=tmp_1_1; + sub=substring(str,tmp1,tmp2-1); + post="}"+substring(str,tmp2,length(str)); + tmp=indexof(sub,","); + tmp1=substring(sub,0,tmp-1); + tmp2=substring(sub,tmp,length(sub)); + sub=tmp1+"){"+tmp2; + tmp1=indexof(sub,"{"); + tmp2=indexof(sub,","); + tmp=substring(sub,tmp1,tmp2-1); + pre=pre+tmp+" in "+substring(sub,0,tmp1-1)+"{"; + sub=substring(sub,tmp2,length(sub)); + tmp=FortoR(sub); + out=pre+tmp+"}"; + ); + out=replace(out,"..",":"); + out; +); + +Deffun(name,bodylist):=( +//help:Deffun("f(x)",["regional(y)","y=x^2*(x-3)","y"]); + regional(funstr,str,Pos,nbody,bdy,ppL,bpL,excma,tmp,tmp1,tmp2); + funstr=name+":=("; + forall(bodylist, + funstr=funstr+#+";"; + ); + funstr=funstr+");"; + parse(funstr); + tmp=indexof(name,"("); + str=substring(name,0,tmp-1)+"<-function("; + str=str+substring(name,tmp,length(name))+"{"; + forall(1..(length(bodylist)-1),nbody, + bdy=bodylist_nbody; + Pos=indexof(bdy,"regional")+indexof(bdy,"local"); + if(Pos==0, + bdy=replace(bdy,LFmark,""); + bdy=replace(bdy," ",""); + ppL=Bracket(bdy,"()"); + bpL=Bracket(bdy,"[]"); + tmp1=select(bpL,#_2==1); + tmp2=select(bpL,#_2==-1); + excma=[]; + forall(1..(length(tmp1)), + excma=append(excma,[tmp1_#_1,tmp2_#_1]); + ); + tmp1=Indexall(bdy,","); + forall(tmp1,cma, + tmp=select(excma,(#_10, + bdy=substring(bdy,0,cma-1)+"'"+substring(bdy,cma,length(bdy)); + ); + ); + tmp=indexof(bdy,"forall"); + if(tmp>0, + bdy=FortoR(bdy); + ); + tmp=indexof(bdy,"if("); + if(tmp>0, + bdy=IftoR(bdy); + ); + bdy=RSform(replace(bdy,"'",",")); + str=str+bdy+";"; + ); + ); + str=str+"return("+bodylist_(length(bodylist))+")}"; + FUNLIST=append(FUNLIST,str); +); + +Windispg():=( + regional(Nj,Nk,Dt,Vj,tmp,tmp1,tmp2,opcindy); + gsave(); + layer(KETPIClayer); + forall(GCLIST,Nj, + if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17 + if(islist(Dt) & length(Dt)>0, // 12.19,12.22 + tmp=MeasureDepth(Dt); + if(tmp==1,Dt=[Dt]); + opcindy=Nj_3; + if(Nj_2<0,tmp1=0,tmp1=Nj_2); + if(tmp1<10, + forall(Dt,Nk, +// tmp2=apply(Nk,if(ispoint(#),Lcrd(#),#)); +// tmp2=apply(tmp2,Pcrd(#)); + tmp2=Nk; // 14.12.04 + if(length(Nk)>1, + tmp="connect("+textformat(tmp2,5)+ + ",dashtype->"+text(tmp1)+",linecolor->"+KCOLOR+opcindy+")"; + parse(tmp); + , + if(length(Nk)==1, + tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31 + parse(tmp); + ); + ); + ); + ); + ); + ); +// if(ADDAXES=="1", // 16.10.08from +// draw([XMIN,0],[XMAX,0],color->[0,0.2,0]); +// draw([0,YMIIN],[0,YMAX],color->[0,0.2,0]); +// Letter([[XMAX,0],"e","x",[0,YMAX],"n","y"]); +// Letter([[0,0],"sw","O"]); +// ); // 16.10.08until + grestore(); + layer(0); +); + +Windispg(pltdata):=( + regional(pdata,Nj,Nk,Dt,tmp,tmp1,tmp2,opcindy); + gsave(); + layer(KETPIClayer); + if(!islist(pltdata),tmp=[pltdata],tmp=pltdata); + pdata=select(GCLIST,contains(tmp,#_1)); + forall(pdata,Nj, + if(isstring(Nj_1),Dt=parse(Nj_1),Dt=Nj_1); // 11.17 + if(islist(Dt) & length(Dt)>0, // 12.19,12.22 + tmp=MeasureDepth(Dt); + if(tmp==1,Dt=[Dt]); + opcindy=Nj_3; + if(Nj_2<0,tmp1=0,tmp1=Nj_2); + if(tmp1<10, + forall(Dt,Nk, + tmp2=Nk; // 14.12.04 + if(length(Nk)>1, + tmp="connect("+textformat(tmp2,5)+ // 15.05.11 + ",dashtype->"+text(tmp1)+ + ",linecolor->"+KCOLOR+opcindy+")"; + parse(tmp); + , + if(length(Nk)==1, + tmp="draw("+text(tmp2_1)+opcindy+")"; // 14.12.31 + parse(tmp); + ); + ); + ); + ); + ); + ); + grestore(); + layer(0); +); + +WritetoSci():=WritetoRS(); //17.12.19 +WritetoRS():=WritetoRS(FnameR);// 17.09.17from +WritetoRS(Arg):=( + regional(string,filename,shch,tmp1,tmp2); + if(isstring(Arg), + string=Arg; + if(indexof(string,".r")>0, + filename=string; + shch=""; + , + filename=FnameR; + shch=string; + ); + WritetoRS(filename,shch); + , + if(Arg<=1,WritetoRS(FnameR,"all")); + if(Arg==2,WritetoRS(FnameR,"sh")); + ); +); +WritetoRS(filename,shchoice):=( + regional(Plist,Pos,GrL,str,tmp,tmp1,tmp2,cmd); + println("Write to R "+filename); + Plist=[]; + Pnamelist=[]; + forall(remove(allpoints(),[SW,NE]), + tmp=Lcrd(#); + tmp1=format(re(tmp_1),6);// 15.02.05 + tmp2=format(re(tmp_2),6); + tmp=#.name+"="+"c("+tmp1+","+tmp2+");"; + tmp=tmp+"Assignadd('"+#.name+"',"+#.name+")"; + Plist=append(Plist,tmp); + ); + SCEOUTPUT = openfile(filename); + tmp=Datetime(); + println(SCEOUTPUT,"# date time="+tmp_1+" "+tmp_2); + if(isstring(CindyPathName), // 16.12.25from + if(length(CindyPathName)>0, + println(SCEOUTPUT, + "# path file="+CindyPathName+" "+CindyFileName+".cdy"); + , + println(SCEOUTPUT,""); + ); + , + println(SCEOUTPUT,""); + ); +// tmp1=replace(Dirwork,"\","/");//180403(2lines removed) +// println(SCEOUTPUT,"setwd('"+tmp1+"')"); + tmp=replace(Libname,"\","/"); //17.09.24from + println(SCEOUTPUT,"source('"+tmp+".r')");//temporary + if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0), + // 17.10.07added + tmp=replace(tmp+"_rep2e","\","/"); + println(SCEOUTPUT,"source('"+tmp+".r')"); + ); + println(SCEOUTPUT,"Ketinit()"); + println(SCEOUTPUT,"cat(ThisVersion,'\n')"); + println(SCEOUTPUT,"Fnametex='"+Fnametex+"'"); + println(SCEOUTPUT,"FnameR='"+FnameR+"'"); + println(SCEOUTPUT,"Fnameout='"+Fnameout+"'"); + println(SCEOUTPUT,"arccos=acos; arcsin=asin; arctan=atan"); + println(SCEOUTPUT,""); + forall(COM0thlist, + if(indexof(#,"Texcom")==0, //17.09.22 + println(SCEOUTPUT,RSform(#)); + , + println(SCEOUTPUT,#); + ); + ); + println(SCEOUTPUT, + "Setwindow(c("+XMIN+","+XMAX+"), c("+YMIN+","+YMAX+"))"); + forall(Plist, + println(SCEOUTPUT,#); + ); + forall(VLIST, + tmp=#_1; + tmp1=#_2; + if(!isstring(tmp1), + if(islist(tmp1), + tmp2="["; + forall(tmp1, + tmp2=tmp2+textformat(#,6)+","; + ); + tmp1=substring(tmp2,0,length(tmp2)-1)+"]"; + , + tmp1=format(tmp1,6); + ); + ); + tmp1=RSform(tmp1); + print(SCEOUTPUT,tmp+"="+tmp1+";"); //17.09.22 +// tmp=substring(tmp,0,length(tmp)-1); + println(SCEOUTPUT,"Assignadd('"+tmp+"',"+tmp+")"); + ); + forall(FUNLIST, + println(SCEOUTPUT,#); + ); + forall(GLIST, + println(SCEOUTPUT,RSform(#)); + ); + tmp=text(Pnamelist); + tmp=replace(tmp,"[","list("); + Pnamelist=replace(tmp,"]",")"); + println(SCEOUTPUT,"PtL="+Pnamelist+";"); + tmp=select(GCLIST,#_2==-1); + GrL=apply(tmp,#_1); + tmp=text(GrL); + tmp=replace(tmp,"[","list("); + tmp=replace(tmp,"]",")"); + println(SCEOUTPUT,"GrL="+tmp); + tmp1=""; + if(length(tmp1)>0, + tmp1="WriteOutData(Fnameout"+tmp1+");"; + println(SCEOUTPUT,tmp1); + ); + forall(COM1stlist, + if(indexof(#,"Texcom")==0, //17.09.22 + println(SCEOUTPUT,RSform(#)); + , + println(SCEOUTPUT,#); + ); + ); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"# Windisp(GrL)"); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"if(1==1){"); + println(SCEOUTPUT,""); +// tmp=replace(Dirwork,"\","/"); //180403from +// tmp="Openfile('"+tmp+pathsep()+Fnametex+"','"+ULEN+"'"; + tmp="Openfile('"+Fnametex+"','"+ULEN+"'"; //180403to + tmp=tmp+",'Cdy="+text(curkernel()); //180404 + tmp=replace(tmp,"\","\\"); + println(SCEOUTPUT,tmp+"')"); + forall(COM2ndlist, + if(indexof(#,"Texcom")==0, //17.09.22 + println(SCEOUTPUT,RSform(#)); + , + println(SCEOUTPUT,#); + ); + ); + if(length(GrL)>0, + println(SCEOUTPUT," Drwline(GrL)"); + ); + println(SCEOUTPUT,"Closefile('"+ADDAXES+"')"); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"}"); + if(shchoice=="sh", + println(SCEOUTPUT,""); + println(SCEOUTPUT,"quit()"); + , + println(SCEOUTPUT,""); + println(SCEOUTPUT,"#quit()"); + ); + closefile(SCEOUTPUT); +); //17.09.17to + +Extractdata(name):=Extractdata(1,name,[]); +Extractdata(Arg1,Arg2):=( + if(isstring(Arg1), + Extractdata(1,Arg1,Arg2); + , + Extractdata(Arg1,Arg2,[]); + ); +); +Extractdata(number,name,options):=( +//help:ExtractData("ha1"); +//help:ExtractData(1,"ha1"); + regional(dlist,tmp,tmp1,tmp2,tmp3,File,Ltype,Noflg,opstr,opcindy); + tmp=Divoptions(options); + Ltype=tmp_1; + Noflg=tmp_2; + opstr=tmp_(length(tmp)-1); + opcindy=tmp_(length(tmp)); + tmp1=[]; + forall(1..length(GOUTLIST), + if(contains(GOUTLIST_#_2,name), + tmp1=append(tmp1,#); + ); + ); + if(length(tmp1)==0, + println(name+" not found"); + , + tmp1=tmp1_number; + tmp2=GOUTLIST_tmp1; + tmp=remove(tmp2_2,[name]); + GOUTLIST_tmp1=[tmp2_1,tmp]; + File=tmp2_1; + ); + if(Noflg<3, + println("extract outdata "+name); + tmp1=parse(name); + tmp3=[ //17.09.18 + "Tmpout=ReadOutData("+Dq+File+Dq+")" + ]; + GLIST=concat(GLIST,tmp3); + ); + if(Noflg<2, + if(isstring(Ltype), + Ltype=GetLinestyle(text(Noflg)+Ltype,name); + , + if(Noflg==1,Ltype=0); + ); + GCLIST=append(GCLIST,[name,Ltype,opcindy]); + ); + tmp2; +); + +RemoveOut(pltlist):=( + regional(name,tmp,tmp1,tmp2); + forall(pltlist,name, + tmp1=[]; + forall(GOUTLIST, + tmp=remove(#_2,[name]); + tmp1=append(tmp1,[#_1,tmp]); + ); + GOUTLIST=tmp1; + ); +); + +ReadOutData():=ReadOutData(Fnameout); +ReadOutData(filename):=ReadOutData("",filename); //16.03.07 +ReadOutData(pathorg,filenameorg):=( +//help:ReadOutData(); +//help:Readoutdata(); +//help:ReadOutData("file.txt"); +//help:Readoutdata("file.txt"); +//help:ReadOutData("/datafolder","file.txt"); +//help:Readoutdata("/datafolder","file.txt"); + regional(path,filename,varname,varL,ptL,pts,tmp,tmp1,tmp2,tmp3,tmp4, + nmbr,cmdall,cmd,cmdorg,outdt,goutdt); + path=pathorg; //16.03.07 from + if(length(path)>0, + setdirectory(path); + if(indexof(path,"\")>0,tmp1="\",tmp1="/"); + tmp=substring(path,length(path)-1,length(path)); + if(tmp!=tmp1,path=path+tmp1); + ); //16.03.07 until + filename=filenameorg; // 16.04.17 + if(indexof(filename,".")==0,filename=filename+".txt"); + tmp=load(filename); + cmdall=tokenize(tmp,"//"); + varname=cmdall_1; + cmdall=cmdall_(2..length(cmdall)); + outdt=[]; + varL=[varname]; + ptL=[]; + forall(cmdall,cmdorg, + cmd=replace(cmdorg,LFmark,""); + if(length(cmd)>0, + if(cmd=="start" % cmd=="end" % substring(cmd,0,1)=="[", + if(cmd=="start", + pts=[]; + ); + if(cmd=="end", + ptL=append(ptL,pts); + ); + if(substring(cmd,0,1)=="[", + tmp1=parse(cmd); + if(length(tmp1_1)==2, + tmp1=apply(tmp1,Pcrd(#)); + ); + pts=concat(pts,tmp1); + ); + , + if(length(ptL)>0, + if(length(ptL)==1, + ptL=ptL_1; + tmp=apply(ptL,textformat(#,6)); + , + tmp="["; + forall(ptL,tmp1, + tmp=tmp+apply(tmp1,textformat(#,6))+","; + ); + tmp=substring(tmp,0,length(tmp)-1)+"]"; + ); + , + tmp="[]"; + ); + parse(varname+"="+tmp); + outdt=append(outdt,ptL); + ptL=[]; + varname=cmd; + varL=append(varL,varname); + ); + ); + ); + if(length(ptL)>0, + if(length(ptL)==1, + ptL=ptL_1; + tmp=apply(ptL,textformat(#,6)); + , + tmp="["; + forall(ptL,tmp1, + tmp=tmp+apply(tmp1,textformat(#,6))+","; + ); + tmp=substring(tmp,0,length(tmp)-1)+"]"; + ); + , + tmp="[]"; + ); + parse(varname+"="+tmp); + outdt=append(outdt,ptL); + if(path=="",tmp=filename,tmp=path+filename); //16.03.07 + GOUTLIST=append(GOUTLIST,[tmp,varL]); + if(length(path)>0, // 16.03.09 + setdirectory(Dirwork); // 16.03.07 + ); + print("readoutdata from "+tmp+" : "); + println(varL); + varL; +); + +WriteOutData(filename,ptlist):=( +//help:WriteOutData("file.txt",["g1",gr1,"sg",sgAB]); +//help:Writeoutdata("file.txt",["g1",gr1,"sg",sgAB]); + regional(nn,Gname,Gdata,Str,Gstr,Gj,Pt,Flg,tmp,tmp1,loopend); + Flg=0; + if(isstring(ptlist_(length(ptlist))), + Flg=1; + ); + SCEOUTPUT = openfile(filename); + if(Flg==0, + loopend=length(ptlist)/2; + , + loopend=length(ptlist); + ); + Gstr="["; + forall(1..loopend,nn, + if(Flg==0, + Gname=ptlist_(2*nn-1); + , + Gname=ptlist_nn; + ); + Gstr=Gstr+Gname+","; + println(SCEOUTPUT,Gname+"//"); + if(Flg==0, + Gdata=ptlist_(2*nn); + , + Gdata=parse(Gname); + ); + Gdata=Flattenlist(Gdata); + if(MeasureDepth(Gdata)==1,Gdata=[Gdata]); + forall(Gdata,Gj, + println(SCEOUTPUT,"start//"); + Str=""; + forall(Gj,Pt, + if(length(Str)>0, + Str=Str+"," + ); + Str=Str+"["+format(Pt_1,5)+","; + Str=Str+format(Pt_2,5); + if(length(Pt)<3, + Str=Str+"]"; + , + Str=Str+","+format(Pt_3,5)+"]"; + ); + if(length(Str)>80, + println(SCEOUTPUT,"["+Str+"]//"); + Str=""; + ); + ); + if(length(Str)>0, + println(SCEOUTPUT,"["+Str+"]//"); + ); + if((nn==loopend) & (Gj==Gdata_(length(Gdata))), + println(SCEOUTPUT,"end////"); + , + println(SCEOUTPUT,"end//"); + ); + ); + ); + closefile(SCEOUTPUT); + Gstr=substring(Gstr,0,length(Gstr)-1)+"]"; + println("writeoutdata "+filename+":"+Gstr); +); + +Makeshell():=( + if(length(Texmain)>0, + Texparent=Texmain; + ); + if(length(Texparent)>0, + Makeshell(Texparent); + if(length(FigPdfList)>0, + SCEOUTPUT=openfile(Texparent+".tex"); + forall(FigPdfList,println(SCEOUTPUT,#)); + closefile(SCEOUTPUT); + ); + , + Makeshell(Fhead+"main"); + ); +); +Makeshell(texmainfile):=Makeshell(texmainfile,"rtv"); +Makeshell(texmainfile,flow):=( + regional(parent,tmp,tmp1,tmp2,tmp3,flg,tex,path,shnm); + parent=Dirwork+Shellparent; // 16.05.29 + kc():=( + println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04,06.07 + ); + tmp1=""; +// tmp2=parent; + flg=0; + forall(reverse(1..length(parent)), + if(flg==0, + tmp=substring(parent,#-1,#); + if(tmp=="/" % tmp=="\", // 14.01.15 + tmp1=substring(parent,0,#-1); + tmp2=substring(parent,#,length(parent)); + flg=1; + ); + ); + ); + if(length(tmp1)>0, + setdirectory(tmp1); + ); + SCEOUTPUT = openfile(tmp2); + println(SCEOUTPUT,"#!/bin/sh"); + println(SCEOUTPUT,"cd "+Dq+Dirwork+Dq); // 15.07.16 + tmp1=" "+Dq+Fhead+Dq+" "+Dq+texmainfile+Dq; // 15.12.11 + flg=0; + forall(reverse(1..length(PathT)), + if(flg==0, + if(substring(PathT,#-1,#)=="/", + tex=substring(PathT,#,length(PathT)); + path=substring(PathT,0,#-1); + flg=1; + ); + ); + ); + if(flg==0, // 17.10.13(Norbert) + tex=PathT; + path=""; + ); + if(indexof(flow,"r")>0, + tmp=Dq+PathR+Dq+" --vanilla --slave < "+Fhead+".r"; + // 17.09.14 + println(SCEOUTPUT,tmp); + ); + if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13 + tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; + println(SCEOUTPUT,tmp); + if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 + tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi"; + println(SCEOUTPUT,tmp); + tmp="rm "+texmainfile+".dvi"; + println(SCEOUTPUT,tmp); + ); + if(tex=="xelatex", + tmp="export PATH="+path+":${PATH}"; + println(SCEOUTPUT,tmp); + tmp="xelatex"+" "+texmainfile+".tex"; + println(SCEOUTPUT,tmp); + if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 + tmp="rm "+texmainfile+".dvi"; + println(SCEOUTPUT,tmp); + ); + if(tex=="pdflatex" % tex=="pdftex",//16.11.22from + tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; + println(SCEOUTPUT,tmp); + if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 + );//16.11.22until + if(tex=="lualatex",//16.12.16 + tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; + println(SCEOUTPUT,tmp); + if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 + );//16.12.16 + if(!isstring(Pathpdf), + tmp="preview"; + , + tmp=Pathpdf; + ); + if(tmp=="preview" % tmp=="skim", // 16.09.09from,16.10.20 + tmp="open -a "+Dq+tmp+Dq+" "+texmainfile+".pdf"; + , + tmp=Dq+tmp+Dq+" "+texmainfile+".pdf"; + );// 16.09.09until + println(SCEOUTPUT,tmp); // 16.07.21until + println(SCEOUTPUT,"exit 0"); + closefile(SCEOUTPUT); + setdirectory(Dirwork); +); + +Convsjiswin(dir,fname,ext):=( //180401 + regional(ctr,flg,mx,tmp); + mx=200; + ctr=0;flg=0; + nkfwin(dir,fname,ext); + while((!isexists(dir,fname+".out"))&(ctr0, + Texparent=Texmain; + ); + if(length(Texparent)>0, + Makebat(Texparent); + if(length(FigPdfList)>0, + SCEOUTPUT=openfile(Texparent+".tex"); + forall(FigPdfList,println(SCEOUTPUT,#)); + closefile(SCEOUTPUT); + ); + , + Makebat(Fhead+"main"); + ); +); +Makebat(texmainfile):=Makebat(texmainfile,"rtv"); +Makebat(texmainfile,flow):=( + regional(drive,fname,tmp,tmp1,tmp2,tmp3,flg,tex,path,batnm); + drive="C:"; + fname=Dirwork+Batparent; + kc():=( + println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04 + ); + tmp=indexof(fname,":"); + if(tmp>0, + drive=substring(fname,0,tmp); + fname=substring(fname,tmp,length(fname)); + ); + tmp1=""; + tmp2=fname; + flg=0; + forall(reverse(1..length(fname)), + if(flg==0, + tmp=substring(fname,#-1,#); + if(tmp=="/" % tmp=="\" % tmp=="\", // 14.01.15 + tmp1=substring(fname,0,#-1); + tmp2=substring(fname,#,length(fname)); + flg=1; + ); + ); + ); + if(length(tmp1)>0, + setdirectory(drive+tmp1); + ); + SCEOUTPUT = openfile(tmp2); + fname=replace(Dirwork,"/","\"); + tmp=indexof(fname,":"); + if(tmp>0, + drive=substring(Dirwork,0,tmp); + fname=substring(Dirwork,tmp,length(Dirwork)); + println(SCEOUTPUT,drive); + ); + tmp1=indexof(fname,"Users");//180405 + tmp2=indexof(fname,Homehead);//180403from + if((tmp1>0)%(tmp2>0), + if(tmp1>0, + fname=substring(fname,tmp1+length("Users")-1,length(fname)); + , + fname=substring(fname,tmp2+length(Homehead)-1,length(fname)); + ); + tmp=Indexall(fname,"\");//180403from + fname=substring(fname,tmp_2,length(fname)); + fname="%HOMEPATH%\"+fname; + );//180403to + println(SCEOUTPUT,"cd "+Dq+fname+Dq);// 150716 + flg=0; + tmp=replace(PathT,"\","/"); + forall(reverse(1..length(PathT)), + if(flg==0, + if(substring(tmp,#-1,#)=="/", + tex=substring(PathT,#,length(PathT)); + path=substring(PathT,0,#-1); + flg=1; + ); + ); + ); + if(flg==0, // 17.10.13(Norbert) + tex=PathT; + path=""; + ); + if(indexof(flow,"r")>0, + tmp=Dq+PathR+"\R"+Dq+" --vanilla --slave < "+Fhead+".r"; + // 17.09.14 + println(SCEOUTPUT,tmp); + ); + if(tex=="latex" % tex=="platex" % tex=="uplatex", //17.08.13 + tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; + println(SCEOUTPUT,tmp); + if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 + tmp=replace(Dq+PathT+Dq,tex,"dvipdfmx")+" "+texmainfile+".dvi"; + println(SCEOUTPUT,tmp); + tmp="del "+texmainfile+".dvi"; + println(SCEOUTPUT,tmp); + ); + if(tex=="xelatex", + tmp="set Path = %Path%;"+Dq+path+Dq; + println(SCEOUTPUT,tmp); + if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 + tmp="xelatex"+" "+texmainfile+".tex"; + println(SCEOUTPUT,tmp); + tmp="del "+texmainfile+".dvi"; + println(SCEOUTPUT,tmp); + ); + if(tex=="pdflatex" % tex=="pdftex",//16.11.22from + tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; + println(SCEOUTPUT,tmp); + if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 + );//16.11.22until + if(tex=="lualatex",//16.12.16 + tmp=Dq+PathT+Dq+" "+texmainfile+".tex"; + println(SCEOUTPUT,tmp); + if(indexof(flow,"tt")>0,println(SCEOUTPUT,tmp)); //17.10.14 + );//16.12.16 + if(!isstring(Pathpdf), + tmp=indexof(PathS,"\scilab");// 15.12.12 + tmp=substring(PathS,0,tmp-1)+"\SumatraPDF\SumatraPDF.exe"; + , + tmp=Pathpdf; + ); + tmp=Dq+tmp+Dq+" "+texmainfile+".pdf"; + println(SCEOUTPUT,tmp); + println(SCEOUTPUT,"exit 0"); + closefile(SCEOUTPUT); + if(indexof(Dirwork,":")==0, // 14.01.15 + drive="C:"; + , + drive=""; + ); + setdirectory(drive+Dirwork); +); + +Addpackage(packorg):=( +//help:Addpackage("bm"); +//help:Addpackage(["bm","enumerate"]); +//help:Addpackage(["bm","[c]{somepackage}"]); + regional(packL,tmp); + packL=packorg; //17.06.25from + if(!islist(packL),packL=[packL]); + packL=apply(packL,replace(#,"\","/")); + forall(1..(length(packL)), + tmp=packL_#; + if(substring(tmp,0,11)=="ketpicstyle", + tmp=replace(Dirhead+"/"+tmp,"\","/"); + ); + if(indexof(tmp,"[")==0, + packL_#="{"+tmp+"}"; + ); + ); + ADDPACK=concat(ADDPACK,packL); //17.06.25until +); + +Viewtex():=( + regional(texfile,tmp,tmp1,sep); + texfile=Fhead+"main"; +// if(iswindows(),sep="\",sep="/"); // 17.04.07 +// sep="/"; + SCEOUTPUT=openfile(texfile+".tex"); + tmp="\documentclass{article}"; // 16.06.09from + if(indexof(PathT,"platex")>0, + tmp=replace(tmp,"article","jarticle"); + if(indexof(PathT,"uplatex")>0, //17.08.13from + tmp=replace(tmp,"jarticle","ujarticle"); + );//17.08.13until + ); // 16.06.09until + println(SCEOUTPUT,tmp); + if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0) , + //16.11.23,12.16 + if(indexof(PathT,"pdflatex")>0, + println(SCEOUTPUT,"\usepackage[pdftex]{pict2e}");//16.11.24 + , + println(SCEOUTPUT,"\usepackage{pict2e}");//16.12.16 + println(SCEOUTPUT,"\usepackage{luatexja}");//16.12.18 + ); + tmp=replace(Dirhead,"\","/"); //17.10.30from + tmp=replace(tmp,"scripts","tex/latex"); + if(isexists(tmp,""), + println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}"); + , + tmp=replace(Dirhead+"/ketpicstyle","\","/"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic2e}"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer2e}"); + ); + , + tmp=replace(Dirhead,"\","/"); + tmp=replace(tmp,"scripts","tex/latex"); + if(isexists(tmp,""), + println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}"); + , + tmp=replace(Dirhead+"/ketpicstyle","\","/"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}"); + ); + );//17.10.30until + println(SCEOUTPUT,"\usepackage{amsmath,amssymb}"); + println(SCEOUTPUT,"\usepackage{graphicx}"); + println(SCEOUTPUT,"\usepackage{color}"); + forall(ADDPACK, // 16.05.16from + println(SCEOUTPUT,"\usepackage"+#); //17.05.25 + );// 16.05.16until + println(SCEOUTPUT,""); +// println(SCEOUTPUT,"\def\ketcindy{{K\kern-.20em%"); // deleted 16.11.27,recovered11.29 redeleted17.04.07 +// println(SCEOUTPUT,"\lower.5ex\hbox{E}\kern-.125em{TCindy}}}"); +// println(SCEOUTPUT,""); + println(SCEOUTPUT,"\setmargin{20}{20}{20}{20}"); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\begin{document}"); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\verb|"+Fhead+"| by \ketcindy");// 16.01.12, 18, 16.04.08 +// println(SCEOUTPUT,"\verb|"+Fhead+"| by KeTCindy");// 16.11.29 temporarily + println(SCEOUTPUT,"\vspace{5mm}"); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\input{"+Fhead+".tex}"); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\end{document}"); + closefile(SCEOUTPUT); + if(iswindows(), + kc():=( + println("kc : "+kc(Dirwork+Batparent,Dirlib,Fnametex)); // 16.06.04 + ); + Makebat(texfile); + , + kc():=( + println("kc : "+kc(Dirwork+Shellparent,Mackc+Dirlib,Fnametex)); // 16.06.04 + ); + Makeshell(texfile); + ); + WritetoRS(2); //17.09.19 +); + +Viewparent():=( //17.04.13 + if(!isexists(Dirwork,Texparent+".tex"), + if(isstring(Texparent), + drawtext(mouse().xy,Texparent+".tex not exist", + size->24,color->[1,0,0]); + , + drawtext(mouse().xy,"Texparent not defined", + size->24,color->[1,0,0]); + ); + , + if(iswindows(), + Makebat(); + , + Makeshell(); + ); + WritetoRS(2); //17.09.29 + kc(); + ); +); + +Makecmdlist(libname):=( +//help:Makecmdlist("ketcindylib"); + regional(cmdall,cmd,flg,tmp,tmp1,tmp2,out); + setdirectory(Dirlib); + tmp=load(libname+".cs"); + cmdall=tokenize(tmp,":="); + out=[]; + forall(cmdall,cmd, + tmp=max([0,length(cmd)-50]); + tmp1=";"+substring(cmd,tmp,length(cmd)); + flg=0; + forall(reverse(1..length(tmp1)), + if(flg==0, + if(substring(tmp1,#-1,#)==";", + tmp=substring(tmp1,#,length(tmp1)); + tmp2=substring(tmp,0,1); + if(length(tmp)>0, + if(!contains([" ","/"],tmp2), + out=append(out,tmp); + flg=1; + ); + ); + ); + ); + ); + ); + setdirectory(Dirwork); + tmp=length(out)-1; + out=out_(2..tmp); + out=sort(out); +); + +Savecmdlist(cmdlist,cmdfile):=( + SCEOUTPUT=openfile(cmdfile+".cs"); + forall(cmdlist, + println(SCEOUTPUT,#); + ); + closefile(SCEOUTPUT); +); + +Quicksort(seq):=( + regional(pivot,left,right,out); + if(length(seq)<2, + out=seq; + , + pivot = max(seq_1,seq_2); + left = []; + right = []; + forall(seq, + if(#< pivot, + left=append(left,#); + , + right=append(right,#); + ); + ); + left = Quicksort(left); + right = Quicksort(right); + out=concat(left,right); + ); + out; +); + +Lessstr(st1,st2):=( + regional(tmp,tmp1,tmp2,out); + tmp=min(length(st1),length(st2)); + flg=0; + forall(1..tmp, + if(flg==0, + tmp1=substring(st1,#-1,#); + tmp2=substring(st2,#-1,#); + if(tmp1tmp2, + out=(1>2); + flg=1; + ); + ); + ); + ); + if(flg==0, + if(length(st1)2); + ); + ); + out; +); + +Figpdf():=Figpdf(Texparent,[]); +Figpdf(Arg1):=( + if(isstring(Arg1), + Figpdf(Arg1,[]); + , + Figpdf(Texparent,Arg1); + ); +); +Figpdf(fnameorg,optionorg):=( +//help:Figpdf(); +//help:Figpdf([10,,10,,[0,2] ]);(margin(4),move) +//help:Figpdf([[0,0]]);(move) +//help:Figpdf(options=[5,5,5,5,[0,0]]]); + regional(options,fname,mar,pos,dp,sc,tmp,tmp1,tmp2,sep); + fname=fnameorg; + if(indexof(fnameorg,".")==0, + fname=fnameorg+".tex"; + ); + tmp=apply(optionorg,if(isstring(#),parse("["+#+"]"),#)); // 16.04.07 + tmp=select(tmp,#!=[]); + options=optionorg;//16.11.08from +// mar=[5,5,5,5]; + dp=[0,-3]; + tmp=select(options,islist(#)); + if(length(tmp)>0, + dp=tmp_1; + options=remove(options,tmp); + ); + tmp=4-length(options); + tmp1=apply(1..tmp,5); + mar=concat(options,tmp1); + mar=apply(mar,if(length(#)==0,5,#));//16.11.08until + pos=[mar_1+dp_1,mar_3+dp_2]; + sc=10; + tmp=indexof(ULEN,"cm"); + if(tmp>0, + tmp1=Removespace(substring(ULEN,0,tmp-1)); + sc=parse(tmp1)*10; + ); + tmp=indexof(ULEN,"mm"); + if(tmp>0, + tmp1=Removespace(substring(ULEN,0,tmp-1)); + sc=parse(tmp1); + ); + tmp="\documentclass{article}"; // 16.06.09from + if(indexof(PathT,"platex")>0, + tmp=replace(tmp,"article","jarticle"); + if(indexof(PathT,"uplatex")>0, //17.08.13from + tmp=replace(tmp,"jarticle","ujarticle"); + );//17.08.13until + ); + FigPdfList=append(FigPdfList,tmp); // 16.06.09until + tmp1="\special{papersize=W mm,H mm}"; + tmp=(XMAX-XMIN)*sc+(mar_1+mar_2); + tmp1=replace(tmp1,"W",text(tmp)); + tmp=(YMAX-YMIN)*sc+(mar_3+mar_4); + tmp1=replace(tmp1,"H",text(tmp)); +// if(iswindows(),sep="\",sep="/");//17.04.08 +// sep="/"; + FigPdfList=append(FigPdfList,tmp1); + if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")>0, //17.11.05from + FigPdfList=append(FigPdfList, + "\usepackage{pict2e}"); + tmp=replace(Dirhead,"\","/"); + tmp=replace(tmp,"scripts","tex/latex"); + if(isexists(tmp,""), + FigPdfList=append(FigPdfList, + "\usepackage{ketpic2e,ketlayer2e}"); + , + tmp=replace(Dirhead+"/ketpicstyle","\","/"); + FigPdfList=concat(FigPdfList, + ["\usepackage{"+tmp+"/ketpic2e}", + "\usepackage{"+tmp+"/ketlayer2e}"]); + ); + , + tmp=replace(Dirhead,"\","/"); + tmp=replace(tmp,"scripts","tex/latex"); + if(isexists(tmp,""), + FigPdfList=append(FigPdfList, + "\usepackage{ketpic,ketlayer}"); + , + tmp=replace(Dirhead+"/ketpicstyle","\","/"); + FigPdfList=concat(FigPdfList, + ["\usepackage{"+tmp+"/ketpic}", + "\usepackage{"+tmp+"/ketlayer}"]); + ); + );//17.11.05until + FigPdfList=append(FigPdfList, + "\usepackage{amsmath,amssymb}"); + FigPdfList=append(FigPdfList, + "\usepackage{graphicx,color}"); + forall(ADDPACK, // 16.05.16from + tmp1="\usepackage"+#; //17.07.10 + FigPdfList=append(FigPdfList,tmp1); // 16.09.05until + ); + FigPdfList=append(FigPdfList,""); + FigPdfList=append(FigPdfList, + "\setmargin{0}{0}{0}{0}"); + FigPdfList=append(FigPdfList,""); + FigPdfList=append(FigPdfList,"\begin{document}"); + FigPdfList=append(FigPdfList,""); + FigPdfList=append(FigPdfList, + "\begin{layer}{50}{0}"); + tmp1="\putnotese{X}{Y}{\input{"; + tmp1=replace(tmp1,"X",text(pos_1)); + tmp1=replace(tmp1,"Y",text(pos_2)); + FigPdfList=append(FigPdfList,tmp1+Fhead+".tex}}"); + FigPdfList=append(FigPdfList,""); + FigPdfList=append(FigPdfList,"\end{layer}"); + FigPdfList=append(FigPdfList,""); + FigPdfList=append(FigPdfList,"\end{document}"); + if(fnameorg!=Texparent, + SCEOUTPUT=openfile(fname); + forall(FigPdfList,println(SCEOUTPUT,#)); + closefile(SCEOUTPUT); + ); + FigPdfList; +); + +Makehelplist(libname):=( + regional(cmdall,cmd,flg,lev,tmp,tmp1,out); + tmp=load(libname); + cmdall=tokenize(tmp,"//help:"); + cmdall=select(cmdall,substring(#,1,3)!=");"); + flg=0; + forall(1..3, + if(flg==0, + if(substring(cmdall_#,0,7)=="start()", + cmdall=cmdall_((#+1)..length(cmdall)); + flg=1; + ); + ); + ); + flg=0; + tmp=length(cmdall); + forall(0..2, + if(flg==0, + if(substring(cmdall_(tmp-#),0,5)=="end()", + cmdall=cmdall_(1..(tmp-#-1)); + flg=1; + ); + ); + ); + out=[]; + forall(cmdall,cmd, + tmp1=indexof(cmd,"("); + lev=1; + flg=0; + forall((tmp1+1)..length(cmd), + if(flg==0, + tmp=substring(cmd,#-1,#); + if(tmp=="(",lev=lev+1); + if(tmp==")", + lev=lev-1; + if(lev==0, + flg=1; + out=append(out,substring(cmd,0,#)+";"); + ); + ); + ); + ); + ); + sort(out); +); + +Helplist():=Helplist(Dirlib,["+","+3d"],"helpJ"); +// 15.05.22 +Helplist(Arg):=( + if(islist(Arg), + Helplist(Dirlib,Arg,"helpJ"); // 15.06.20 + , + if(indexof(Arg,"help")>0, + Helplist(Dirlib,["+","+3d"],Arg); + , + Helplist(Arg,["+","+3d"],"helpJ"); + ); + ); +); +Helplist(Arg1,Arg2):=( + if(islist(Arg1), + Helplist(Dirlib,Arg1,Arg2); + , + if(indexof(Arg2,"help")>0, + Helplist(Dirlib,Arg1,Arg2); + , + Helplist(Arg,["+","+3d"],Arg2); + ); + ); +); +Helplist(dir,files,help):=( +//help:Helplist(); +//help:Helplist("helpE"); + regional(ketfiles,tmp,tmp1,tmp2); + setdirectory(dir); + if(contains(files,"+"), + tmp=remove(files,["+"]); + ketfiles=concat(["+basic1","+basic2","+out"],tmp); + , + ketfiles=files; + ); + ketfiles=apply(ketfiles,replace(#,"+","ketcindylib")); + ketfiles=apply(ketfiles,#+"r.cs"); // 15.11.05 from + tmp=apply(files,replace(#,"+","ketcindylib")); +// tmp=apply(files,replace(#,"r.cs","")); +// tmp=remove(tmp,["ketcindylibout"]); +// tmp=apply(tmp,replace(#,"basic","")); + tmp=apply(tmp,#+help+".txt"); + ketfiles=concat(ketfiles,tmp);// 15.11.05 until + tmp1=[]; + forall(ketfiles, + tmp=Makehelplist(#); + tmp1=concat(tmp1,tmp); + ); + if(!islist(HLIST), // 16.12.31from + HLIST=sort(tmp1); + , + HLIST=sort(concat(HLIST,tmp1)); + ); // 16.12.31until + setdirectory(Dirwork); +); + + +Help():=( + forall(HLIST, + println(#); + ); +); +Help(strorg):=( +//help:Help("Plot"); +//help:Help("*"); + regional(str,sel,tmp,tmp1,tmp2,flg,Endflg); + if(length(HLIST)>0,flg=0,flg=-1); + str=replace(strorg,"'",Dq); // 15.11.25 + if(length(str)==0, + forall(HLIST, + if(indexof(#,"*")>0, + println(#); + ); + flg=1; + ); + , + if(str=="*", + sel=HLIST; + , + sel=select(HLIST,substring(#,0,length(str))==str); + ); + if(length(sel)>0,flg=1); + forall(sel, + tmp=indexof(#,"("); + if(substring(#,tmp-2,tmp-1)!="*", + println(#); + , +// println(substring(#,0,tmp-1)); + tmp1=substring(#,tmp,length(#)-2); + tmp2=indexof(tmp1,"//"); + Endflg=0; + forall(1..4, + if(Endflg==0, + tmp2=indexof(tmp1,"//"); + if(tmp2==0, + println(" "+tmp1); + Endflg=1; + , + println(" "+substring(tmp1,0,tmp2-1)); + tmp1=substring(tmp1,tmp2+1,length(tmp1)); + ); + ); + ); + ); + ); + ); + if(flg==-1,println(" Help not read in")); + if(flg==0,println(" no example")); +); + +Helpkey(str):=( + regional(tmp,tmp1,tmp2); + tmp1=select(HLIST,indexof(#,str)>0); + forall(tmp1, + tmp=substring(#,0,indexof(#,"*")-1); + Help(tmp); + ); +); +Helpkey(str1,str2):=( +//help:Helpkey(keyword); +//help:Helpkey(keyword1,keyword2); + regional(tmp,tmp1,tmp2); + tmp1=select(HLIST,indexof(#,str1)>0); + tmp1=select(tmp1,indexof(#,str2)>0); + forall(tmp1, + tmp=substring(#,0,indexof(#,"*")-1); + Help(tmp); + ); +); + +Slidework():=Slidework(Dirwork); // 16.06.10 +Slidework(dirorg):=( +//help:Slidework(directory); + regional(dir,tmp); // 16.06.25 + dir=replace(dirorg,unicode("000a"),""); // 16.06.25 + dir=replace(dir,"/",pathsep());//17.11.20from + dir=replace(dir,"\",pathsep()); + tmp=length(dir); + if(substring(dir,tmp-1,tmp)==pathsep(), + dir=substring(dir,0,tmp-1); + );//17.11.20until + if(isexists(dir,""), // 16.12.20 + Changework(dir); + println(makedir(dir,"fig"));//17.11.23 + tmp=dir+pathsep()+"fig"; //17.04.16from + Changework(tmp);// 17.02.19until + , + println(dir+ " not exists"); + ); +); + +Setslidepage():=( // 17.03.05 + regional(tmp1,tmp2,tmp3); + tmp1=["letterc","boxc","framec","shadowc","xpos","size"]; + tmp2=apply([1,2,4,5,7,8],SlideColorList_#); + tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#); + println(tmp3); +); +Setslidepage(list):=( // 16.12.22 +//help:Setslidepage([letterc,boxc,framec,shadowc,xpos,size]); + regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc); + letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; + shadowc=[0,0,0,0.5]; mboxc="yellow"; + if(!islist(SlideColorList), + SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, + letterc,mboxc,mboxc,mboxc,62,2,letterc]; + ); + numlist=[1,2,4,5,7,8]; + forall(1..(length(list)), + if(length(list_#)>0, + tmp=numlist_#; + SlideColorList_tmp=list_#; + ); + ); + SlideColorList_3=SlideColorList_2; + SlideColorList_6=SlideColorList_5; +); + +Setslidemain():=( // 17.03.05 + regional(tmp1,tmp2,tmp3); + tmp1=["letterc","boxc","framec","xpos","size"]; + tmp2=apply([9,10,12,13,14],SlideColorList_#); + tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#); + println(tmp3); +); +Setslidemain(list):=( // 16.12.22 +//help:Setslidemain([letterc,boxc,framec,xpos,size]); + regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc); + letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; + shadowc=[0,0,0,0.5]; mboxc="yellow"; + if(!islist(SlideColorList), + SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, + letterc,mboxc,mboxc,mboxc,62,2,letterc]; + ); + numlist=[9,10,12,13,14]; + forall(1..(length(list)), + if(length(list_#)>0, //17.01.04 + tmp=numlist_#; + SlideColorList_tmp=list_#; + ); + ); + SlideColorList_11=SlideColorList_10; +); + +Setslidebody():=( // 17.03.05 + regional(tmp1,tmp2,tmp3); + tmp1=["letterc","style","thindense"]; + tmp2=[SlideColorList_(15),BodyStyle,ThinDense]; + tmp3=apply(1..(length(tmp1)),tmp1_#+"="+tmp2_#); + println(tmp3); +); +Setslidebody(str):=( + regional(clr,style,thin); + if(isstring(str), + Setslidebody(str,"\Large\bf\boldmath",0.1); + , + if(length(str)==1,Setslidebody(str_1)); + if(length(str)==2,Setslidebody(str_1,str_2)); + if(length(str)==3,Setslidebody(str_1,str_2,str_3)); + ); +); +Setslidebody(str,Arg):=( //17.01.08 + if(isstring(Arg), + Setslidebody(str,Arg,0.1); + , + Setslidebody(str,"\Large\bf\boldmath",Arg); + ); +); +Setslidebody(str,style,density):=( // 16.12.22,17.01.06,01.08 +//help:Setslidebody(["black",,0]); +//help:Setslidebody(["blue","\Large\bf\boldmath",0.1]); + regional(numlist,tmp,tmp1,letterc,boxc,shadowc,mboxc); + letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; + shadowc=[0,0,0,0.5]; mboxc="yellow"; + if(!islist(SlideColorList), + SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, + letterc,mboxc,mboxc,mboxc,62,2,letterc]; + ); + if(length(str)>0,SlideColorList_(15)=str); + if(length(style)>0,BodyStyle=style); + ThinDense=density;//17.01.08 +); + +Setslidehyper():=( 17.12.16from + Setslidehyper(["cl=true,lc=blue,fc=blue",125,70,1]); +); +Setslidehyper(Arg):=( + if(isstring(Arg), + Setslidehyper(Arg,["cl=true,lc=blue,fc=blue",125,70,1]); + , + Setslidehyper("",Arg); + ); +); +Setslidehyper(driverorg,options):=( +//help:Setslidehyper(); +//help:Setslidehyper("dvipdfmx",["cl=true,lc=blue,fc=blue","Pos=[125,70]","Size=1"]); + regional(driver,eqL,reL,stL,,str,tmp,tmp1,tmp2); + driver=driverorg; + if(length(driver)==0, + if(indexof(PathT,"pdflatex")+indexof(PathT,"lualatex")==0, + driver="dvipdfmx"; + ); + ); + tmp=Divoptions(options); + eqL=tmp_5; + reL=tmp_6; + stL=tmp_7; + if(length(stL)>0, + str=stL_1; + , + str=""; + ); + if(length(str)==0, + str="cl=true,lc=blue,fc=blue"; + ); + if(length(driver)==0, + tmp1="["+str+"]"; + , + tmp1="["+driver+","+str+"]"; + ); + tmp1=replace(tmp1,"cl=","colorlinks="); + tmp1=replace(tmp1,"lc=","linkcolor="); + tmp1=replace(tmp1,"fc=","filecolor="); + tmp1=replace(tmp1,"uc=","urlcolor="); + ADDPACK=select(ADDPACK,indexof(#,"hyperref")==0); + Addpackage(tmp1+"{hyperref}"); + LinkPosH=125; + LinkPosV=70; + LinkSize=1; + if(length(reL)>0, + LinkPosH=reL_1; + if(length(reL)>1,LinkPosV=reL_2); + if(length(reL)>2,LinkSize=max(reL_3,0.1)); + ); + forall(eqL, + tmp=indexof(#,"="); + tmp1=Toupper(substring(#,0,1)); + tmp2=substring(#,tmp,length(#)); + tmp2=parse(tmp2); + if(tmp1=="P", + LinkPosH=tmp2_1; + LinkPosV=tmp2_2; + ); + if(tmp1=="S", + LinkSize=max(tmp2,0.1); + ); + ); +); //17.12.16until + +Settitle(cmdL):=Settitle(cmdL,[]); // 180330changed +Settitle(cmdL,options):=( +//help:Settitle(cmdL); +//help:Settitle(name,cmdL); +//help:Settitle(options=["Title=slide0","Layery=0","Color=blue"]); + regional(tmp,tmp1,tmp2,eqL,layery,color,size,font); + TitleName="slide0"; //180330 + layery="0"; + color="blue"; + size="\Large"; + font="\bf"; + tmp=Divoptions(options); + eqL=tmp_5; + forall(eqL, + tmp1=Toupper(substring(#,0,1)); + tmp=indexof(#,"="); + tmp2=substring(#,tmp,length(#)); + if(tmp1=="L", + layery=tmp2; + ); + if(tmp1=="C", + color=tmp2; + ); + if(tmp1=="S", + size=tmp2; + if(substring(size,0,1)!="\",size="\"+size); + ); + if(tmp1=="F", + font=tmp2; + if(substring(font,0,1)!="\",font="\"+font); + ); + if(tmp1=="T", //180330 + TitleName=tmp2; + ); + ); + TitleCmdL=["{"+size+font]; + if(indexof(color,"[")>0, + tmp=replace(color,"[","{"); + tmp=replace(tmp,"]","}"); + tmp1=Indexall(tmp,","); + if(length(tmp1)>=3, + tmp="\color[cmyk]"+tmp; + , + tmp="\color[rgb]"+tmp; + ); + , + tmp="\color{"+color+"}"; + ); + TitleCmdL=append(TitleCmdL,tmp); + TitleCmdL=concat(TitleCmdL,["","\begin{layer}{120}{"+layery+"}"]); + forall(1..(length(cmdL)), + tmp=cmdL_#; + if(length(tmp)>0, + if(#==1, + tmp="{\Huge \putnote"+tmp+"}" + , + tmp="\putnote"+tmp; + ); + TitleCmdL=append(TitleCmdL,tmp); + ); + ); + TitleCmdL=concat(TitleCmdL,["\end{layer}","","}"]); +); + +Maketitle():=( + if(!isstring(TitleName), //17.04.13from + drawtext(mouse().xy,"Settitle not defined", + size->24,color->[1,0,0]); + , //17.04.13until + Maketitle(TitleName); + ); +); +Maketitle(name):=( +//help:Maketitle(); + regional(texfile,texmain,tmp,tmp1,sep); + texfile=name; + texmain=name+"main"; + SCEOUTPUT=openfile(texfile+".tex"); + forall(TitleCmdL, + println(SCEOUTPUT,#); + ); + closefile(SCEOUTPUT); + SCEOUTPUT=openfile(texmain+".tex"); + tmp="\documentclass[landscape,10pt]{article}"; + if(indexof(PathT,"platex")>0, + tmp=replace(tmp,"article","jarticle"); + if(indexof(PathT,"uplatex")>0, //17.08.13from + tmp=replace(tmp,"jarticle","ujarticle"); + );//17.08.13until + ); + println(SCEOUTPUT,tmp); + tmp="\special{papersize=\the\paperwidth,\the\paperheight}"; + println(SCEOUTPUT,tmp); + tmp=replace(Dirhead,"\","/");//17.11.01from + tmp=replace(tmp,"scripts","tex/latex"); + if(isexists(tmp,""), + println(SCEOUTPUT,"\usepackage{ketpic,ketlayer,ketslide}"); + , + tmp=replace(Dirhead+"/ketpicstyle","\","/"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}"); + );//17.11.01until + println(SCEOUTPUT,"\usepackage{amsmath,amssymb}"); + println(SCEOUTPUT,"\usepackage{bm,enumerate}"); + if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0), + println(SCEOUTPUT,"\usepackage{graphicx}"); + , + println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}"); + ); + println(SCEOUTPUT,"\usepackage[usenames]{xcolor}"); + forall(ADDPACK, +// if(indexof(#,"[")==0, +// println(SCEOUTPUT,"\usepackage{"+#+"}"); +// , + println(SCEOUTPUT,"\usepackage"+#); // 17.07.10 +// ); + ); + if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE"); + println(SCEOUTPUT,tmp); + println(SCEOUTPUT,"\ketslideinit"); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\begin{document}"); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\input{"+texfile+".tex}"); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\end{document}"); + closefile(SCEOUTPUT); + if(iswindows(), + Makebat(texmain,"tv"); + , + Makeshell(texmain,"tv"); + ); + kc(); +); + +Repeatsameslide(repeatflg,sestr,addedL):=( + regional(seL,flg1,ss,nn,nrep,tmp,tmp1,tmp2,tmp3,str,j,k); + // global RepeatList, SCEOUTPUT + nrep=length(RepeatList); + flg1=0; + forall(addedL,ss, + if(repeatflg==0, + if(substring(ss,0,1)!="%", //16.01.04 + println(SCEOUTPUT,ss); + );//16.01.04 + , + forall(1..nrep,nn, + if(sestr=="", + RepeatList_nn=append(RepeatList_nn,ss); + ); + ); + if(sestr=="", + seL=[1]; + , + tmp1=substring(sestr,1,length(sestr)-1); + tmp1=replace(tmp1,",-",".."+text(nrep)); + tmp1=replace(tmp1,"-,","1.."); + tmp1="["+tmp1+"]"; //17.01.03 + seL=flatten(parse(tmp1)); //17.01.03 + ); + if(contains(seL,1), + if(substring(ss,0,1)!="%", //16.01.04 + println(SCEOUTPUT,ss); + ); + seL=remove(seL,[1]); + flg1=1; + ); + forall(1..(length(seL)),nn, + tmp=seL_nn; + if(tmp<=length(RepeatList), //17.01.12from + RepeatList_tmp=append( RepeatList_tmp,ss); + , + println(" "+sestr+" : "+text(tmp)+" > "+text(length(RepeatList))); + ); + ); + if(ThinFlg==1,//16.01.05from + if(flg1==1,seL=append(seL,1)); + seL=remove(1..nrep,seL); + str=ss; // 17.05.28from + repeat(10, + tmp1=Indexall(str,"{\color"); + if(length(tmp1)>0, + tmp2=Indexall(str,"}"); + tmp=select(tmp2,tmp1_1<#); + tmp=substring(str,tmp1_1,tmp_1); + str=replace(str,tmp+" ",""); + str=replace(str,tmp,""); + ); + );//17.05.28until + if(contains(seL,1), + if(substring(str,0,1)!="%", + if(NonThinFlg==0, + if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15 + println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23 + println(SCEOUTPUT,str); + println(SCEOUTPUT,"}%"); + , + println(SCEOUTPUT,str); + ); + ); + if(NonThinFlg==1, + if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15 + println(SCEOUTPUT,"{\color[cmyk]{\thin,\thin,\thin,\thin}");//17.08.23 + ); + println(SCEOUTPUT,str); + ); + if(NonThinFlg==2, + println(SCEOUTPUT,str); + if(!contains(["\begi","\end{"],substring(str,0,5)),//17.01.15 + println(SCEOUTPUT,"}%"); + ); + ); + seL=remove(seL,[1]); + ); + ); + if(substring(ss,0,1)!="%", //16.01.04 + forall(1..(length(seL)),nn, + tmp=seL_nn; + if(NonThinFlg==0, + tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23 + tmp1=[tmp1,str,"}%"]; + ); + if(NonThinFlg==1, + tmp1="{\color[cmyk]{\thin,\thin,\thin,\thin}";//17.08.23 + tmp1=[tmp1,str];//17.01.08until + ); + if(NonThinFlg==2, + tmp1=[str,"}%"]; + ); + RepeatList_tmp=concat( RepeatList_tmp,tmp1); + ); + ); + );//16.01.05until + ); + );//16.12.05until +); + +Presentation(texfile):=Presentation(texfile,texfile); +Presentation(texfile,txtfile):=( +//help:Presentation(texfile,txtfile); + regional(file,flgL,flg,verbflg,slideL,ns,slideorgL,wall,sld,slidecmd,tmp,tmp0,tmp1, + tmp2,tmp3,tmp4,tmp5,newoption,top,repeatflg,nrep,nrepprev,,repstr, + sestr,npara,paradt,parafiles,hyperflg,paractr, + letterc,boxc,shadowc,mboxc,sep); + slidecmd=["\ketcletter","\ketcbox","\ketdbox","\ketcframe", + "\ketcshadow","\ketdshadow","\slidetitlex","\slidetitlesize", + "\mketcletter","\mketcbox","\mketdbox","\mketcframe", + "\mslidetitlex","\mslidetitlesize"]; + if(!isstring(BodyStyle),//17.01.06 + BodyStyle="\Large\bf\boldmath"; + ); + repeatflg=0; + RepeatList=[]; + paractr=0; //16.12.31 + if(indexof(texfile,".")==0,file=texfile+".tex",file=texfile); + if(indexof(txtfile,".")==0,tmp1=txtfile+".txt",tmp1=txtfile); + tmp=load(tmp1); + tmp=replace(tmp,"////","||||");// 16.05.11, 06.24(reactivated) + slideL=tokenize(tmp,"//"); + slideorgL=slideL; // 16.07.11 + slideL=apply(slideL,Removespace(#)); + tmp=select(1..length(slideL),length(slideL_#)>0); // 16.07.11from + slideL=apply(tmp,slideL_#); + slideorgL=apply(tmp,slideorgL_#); +// slideL=select(slideL,length(#)>0); // 16.07.11until + flg=0; // 16.06.09from + forall(1..10, + if(flg==0, + if(substring(slideL_1,0,1)!="%", + flg=1; + , + slideL=slideL_(2..length(slideL)); + slideorgL=slideorgL_(2..length(slideorgL)); + ); + ); + ); // 16.06.09until + flgL=[]; + SCEOUTPUT = openfile(file); + tmp=tokenize(slideL_1,"::"); + tmp1=tmp_1; + if(length(tmp)>1, + tmp2=tmp_2; + tmp3=tmp_(3..length(tmp));//16.06.25 + , + tmp2=""; + tmp3=tmp_(2..length(tmp));//16.06.25 + ); + wall=""; // 16.06.10 + if(length(tmp3)>0,//16.06.25from + tmp=substring(tmp3_1,0,1);//180330 + if((tmp!="\")&(tmp!="%")&(indexof(tmp3_1,"=")==0), //180330 + wall=tmp3_1; + tmp3=tmp3_(2..length(tmp3)); + ); + );//16.06.25until + tmp="%%% "+tmp1+" "+txtfile;// 16.06.09from + println(SCEOUTPUT,tmp); + tmp="\documentclass[landscape,10pt]{article}"; + if(indexof(PathT,"platex")>0, + tmp=replace(tmp,"article","jarticle"); + if(indexof(PathT,"uplatex")>0, //17.08.13from + tmp=replace(tmp,"jarticle","ujarticle"); + );//17.08.13until + ); + println(SCEOUTPUT,tmp);// 16.06.09from + tmp=select(1..(length(tmp3)),indexof(tmp3_#,"\usepackage")>0);//17.06.18from + forall(tmp, + println(SCEOUTPUT,tmp3_#); + ); + tmp=remove(1..(length(tmp3)),tmp); + tmp3=tmp3_tmp;//17.06.18until +// if(iswindows(),sep="\",sep="/"); // 17.04.08 +// sep="/"; + if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0), + if(indexof(PathT,"lualatex")>0, + println(SCEOUTPUT,"\usepackage{luatexja}"); + ); + println(SCEOUTPUT,"\usepackage{pict2e}"); + println(SCEOUTPUT,"\usepackage{ketpic2e,ketlayer2e}");// 17.04.08from + , + println(SCEOUTPUT,"\special{papersize=\the\paperwidth,\the\paperheight}"); + );// 17.04.08until + tmp=replace(Dirhead,"\","/");//17.11.01from + tmp=replace(tmp,"scripts","tex/latex"); + if(isexists(tmp,""), + println(SCEOUTPUT,"\usepackage{ketpic,ketlayer}"); + , + tmp=replace(Dirhead+"/ketpicstyle","\","/"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketpic}"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketlayer}"); + ); + if(length(wall)==0, + tmp=replace(Dirhead,"\","/");//17.11.01from + tmp=replace(tmp,"scripts","tex/latex"); + if(isexists(tmp,""), + println(SCEOUTPUT,"\usepackage{ketslide}"); + , + tmp=replace(Dirhead+"/ketpicstyle","\","/"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide}"); + ); + , + tmp=replace(Dirhead,"\","/"); + tmp=replace(tmp,"scripts","tex/latex"); + if(isexists(tmp,""), + println(SCEOUTPUT,"\usepackage{ketslide2}"); + , + tmp=replace(Dirhead+"/ketpicstyle","\","/"); + println(SCEOUTPUT,"\usepackage{"+tmp+"/ketslide2}"); + ); + );//17.04.08until + println(SCEOUTPUT,"\usepackage{amsmath,amssymb}"); + println(SCEOUTPUT,"\usepackage{bm,enumerate}"); + if((indexof(PathT,"pdflatex")>0)%(indexof(PathT,"lualatex")>0), + println(SCEOUTPUT,"\usepackage{graphicx}"); + , + println(SCEOUTPUT,"\usepackage[dvipdfmx]{graphicx}"); + ); +// println(SCEOUTPUT,"\usepackage[usenames]{color}"); +// println(SCEOUTPUT,"\usepackage{color}");//17.06.14 + println(SCEOUTPUT,"\usepackage{xcolor}");//17.07.31 + letterc=[0.98,0.13,0,0.43]; boxc=[0,0.32,0.52,0]; + shadowc=[0,0,0,0.5]; mboxc="yellow"; +// if(!islist(SlideColorList), //17.03.02from +// SlideColorList=[letterc,boxc,boxc,boxc,shadowc,shadowc,6,1.3, +// letterc,mboxc,mboxc,mboxc,62,2,letterc]; +// , //17.03.02until + tmp4="abcdefghijklmno"; + forall(1..15, + tmp=SlideColorList_#; + if(islist(tmp), + tmp=text(tmp); + tmp=substring(tmp,1,length(tmp)-1); + if(length(SlideColorList_#)==4,//17.01.07from + println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{cmyk}{"+tmp+"}"); + ); + if(length(SlideColorList_#)==3, + println(SCEOUTPUT,"\definecolor{slidecolor"+tmp4_#+"}{rgb}{"+tmp+"}"); + );//17.01.07until + SlideColorList_#="slidecolor"+tmp4_#; + ); + ); +// ); //17.03.02 + println(SCEOUTPUT,"\def\setthin#1{\def\thin{#1}}");//17.08.23 + println(SCEOUTPUT,"\setthin{"+text(ThinDense)+"}");//17.08.23 + forall(ADDPACK,// 16.06.09from +// if(indexof(#,"[")==0, // 16.09.05from +// println(SCEOUTPUT,"\usepackage{"+#+"}"); +// , + println(SCEOUTPUT,"\usepackage"+#); //17.07.10 +// ); + );// 16.06.09until + tmp=select(ADDPACK,indexof(#,"{hyperref}")>0);//16.12.31from + if(length(tmp)>0, + hyperflg=1; + , + hyperflg=0; //16.12.31until + ); + forall(tmp3, + println(SCEOUTPUT,#); + ); + if(indexof(PathT,"platex")>0,tmp="\ketmarginJ",tmp="\ketmarginE"); // 16.06.09 + println(SCEOUTPUT,tmp); + println(SCEOUTPUT,"\ketslideinit"); + println(SCEOUTPUT,""); + forall(tmp, // 15.07.21 + if(substring(#,0,1)=="\", println(SCEOUTPUT,#)); + ); + if(!isstring(PageStyle),PageStyle="headings");//17.04.09 + println(SCEOUTPUT,"\pagestyle{"+PageStyle+"}");//17.04.09 + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\begin{document}"); + println(SCEOUTPUT,""); + if(length(wall)>0, + println(SCEOUTPUT,"\input{fig/"+wall+".tex}"); + println(SCEOUTPUT,""); + ); + if(length(tmp2)>0, + if(indexof(tmp2," no")==0, // 16.11.11from + println(SCEOUTPUT,"\begin{layer}{120}{0}"); + if(substring(tmp2,0,1)!="\", + tmp2="\putnotese{0}{0}{\input{fig/"+tmp2+".tex}}";//16.12.27 + ); + println(SCEOUTPUT,tmp2); + println(SCEOUTPUT,"\end{layer}"); + println(SCEOUTPUT,""); + , + tmp=indexof(tmp2,"="); + if(tmp==0, + top="10mm"; + , + top=substring(tmp2,tmp,length(tmp2)); + ); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\vspace*{"+top+"}"); + println(SCEOUTPUT,""); + ); // 16.11.11until + ); + println(SCEOUTPUT,"\def\mainslidetitley{22}"); + forall(1..14, //16.12.22from + tmp=SlideColorList_#; + if(!isstring(tmp),tmp=text(tmp)); + if(length(tmp)>0, + tmp="\def"+slidecmd_#+"{"+tmp+"}"; + println(SCEOUTPUT,tmp); + ); + );//16.12.22until + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\color{"+SlideColorList_(15)+"}"); + println(SCEOUTPUT,BodyStyle);//17.01.07 + println(SCEOUTPUT,"\thispagestyle{empty}");//17.01.29 + println(SCEOUTPUT,"\addtocounter{page}{-1}");//17.01.29 + println(SCEOUTPUT,""); + verbflg=0; //16.06.28 + repeatflg=0;//16.12.02 + nrep=0;//16.12.27 + nrepprev=0;//17.01.03 + npara=0;//16.12.27 + forall(2..length(slideL),ns, + ThinFlg=0; + NonThinFlg=0; + flg=0; + tmp1=""; + tmp2=""; + tmp3=""; + sld=removespace(slideL_ns); // 16.06.28 + sestr=""; + if((substring(sld,0,1)=="%") & (substring(sld,0,2)!="%%"), // 17.06.23 + Repeatsameslide(repeatflg,"",[slideL_ns]); + if(repeatflg>0, + tmp=indexof(sld,"]::"); + if(tmp>0, + if(substring(sld,1,2)!="%",//17.05.31 + if(substring(sld,1,5)=="thin", ThinFlg=1); // 17.05.28 + sestr=substring(sld,1,tmp); + sld=substring(sld,tmp+2,length(sld)); + tmp=indexof(sestr,"["); + sestr=substring(sestr,tmp-1,length(sestr));//17.01.05 + ); + ); + ); + if(substring(sld,1,7)=="repeat", // 16.12.09from + tmp=indexof(sld,"="); + tmp5=substring(sld,tmp,length(sld)); + tmp=indexof(tmp5,","); + if(tmp>0,//17.01.03from + tmp5=substring(tmp5,0,tmp-1); + );//17.01.03until + repeatflg=1; + if(length(tmp5)>0, + nrep=parse(tmp5); + tmp=[]; + if(length(wall)>0, + tmp=["","\input{fig/"+wall+".tex}"]; + ); + tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]); + RepeatList=apply(1..nrep,if(#==1,[],tmp)); + ); + if(sestr=="",flg=1); + tmp=indexof(sld,",");//17.01.03from + if(tmp>0, + sld="%"+substring(sld,tmp,length(sld)); + if(indexof(sld,"=")==0,sld=sld+"="); + );//17.01.03until + ); + if(substring(sld,1,5)=="para", + paractr=paractr+1; + repeatflg=1; + tmp=indexof(sld,"="); + tmp=substring(sld,tmp,length(sld)); + if(length(tmp)==0, //17.01.03 + npara=0; + , + paradt=tokenize(tmp,":"); + tmp=fileslist(Dirwork+"/fig/"+paradt_1); + if(length(tmp)>0, + parafiles=tokenize(tmp,","); + if(indexof(paradt_4,"input")>0, + tmp0=indexof(paradt_4,",");//17.01.29from + if(tmp0>0, + paradt=append(paradt,substring(paradt_4,tmp0,length(paradt_4))); + paradt_4=substring(paradt_4,0,tmp0-1); + );//17.01.29until + parafiles=select(parafiles,indexof(#,".tex")>0); + if(indexof(paradt_4,"\input")==0,paradt_4="\"+paradt_4);//16.12.17 + ); + if(indexof(paradt_4,"include")>0, + parafiles=select(parafiles,indexof(#,".pdf")>0); + ); + npara=length(parafiles); + , + println(Dirwork+"/fig/"+paradt_1+" not found"); + parafiles=[]; + npara=0; + ); + if(nrep==0, + nrep=npara; + if(length(wall)>0, + tmp=["","\input{fig/"+wall+".tex}"]; + ); + tmp=concat(tmp,["","\sameslide"+NewSlideOption,"","\vspace*{18mm}",""]); + RepeatList=apply(1..nrep,if(#==1,[],tmp)); + ); + ); + forall(1..nrep, //16.12.28 + tmp4=[]; //16.12.31from + if(hyperflg>0, + tmp4=["\hypertarget{para"+text(paractr)+"pg"+text(#)+"}{}"]; + );//16.12.31until + if(npara>0, //17.01.03 + tmp4=concat(tmp4,["","\begin{layer}{120}"+paradt_2]); + if(#<=npara, //16.12.28from + tmp=parafiles_#; + , + tmp=parafiles_npara; + ); + tmp="{"+paradt_4+"{fig/"+paradt_1+"/"+tmp+"}}"; + if(length(paradt)>=5, + tmp="{\scalebox{"+text(paradt_5)+"}"+tmp+"}"; + ); + if(substring(paradt_3,0,1)=="\", + tmp=paradt_3+tmp; + , + tmp="\putnote"+paradt_3+tmp; + ); + tmp4=concat(tmp4,[tmp]);//16.12.31 + , + tmp4=concat(tmp4,["","\begin{layer}{120}{0}"]); + ); + if((hyperflg>0) & (LinkSize>0.15), + tmp="{"+text(LinkPosV)+"}{\hyperlink{para"; // 17.01.12from + tmp1=tmp+text(paractr)+"pg"; + tmp2=tmp+text(paractr-1)+"pg"+text(nrepprev); + if(#>1,tmp=tmp1+text(1),tmp=tmp2); + tmp3=[text(LinkPosH-29*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{" + +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize) + +"}{\scriptsize $\mathstrut|\!\lhd$}}}}}"]; + if(#>1,tmp=tmp1+text(max(#-3,1)),tmp=tmp2); + tmp3=append(tmp3, + text(LinkPosH-24*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{" + +text(2.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize) + +"}{\scriptsize $\mathstrut\!\! \lhd\!\!\lhd\!$}}}}}"); + if(#>1,tmp=tmp1+text(#-1),tmp=tmp2); + tmp3=append(tmp3, + text(LinkPosH-17*LinkSize)+"}"+tmp+"}{\fbox{\Ctab{" + +text(4.5*LinkSize)+"mm}{\scalebox{"+text(LinkSize) + +"}{\scriptsize $\mathstrut\!\!\lhd\!\!$}}}}}"); + tmp="{"+text(LinkPosV)+"}{\hyperlink{para"; + tmp2=tmp+text(paractr+1)+"pg"+text(1); + if(#1,tmp2=tmp_2,tmp2=""); + if(length(tmp)>2,tmp3=tmp_3,tmp3=""); + if(length(tmp)>3,tmp4=tmp_4,tmp4=""); + if(length(tmp)>4,tmp5=tmp_5,tmp5=""); + if(contains(["main","new","same"],tmp1), + if(tmp1=="new", // 16.11.09from + newoption=""; + if(substring(tmp2,0,1)=="[",newoption=tmp2); + ); + if(tmp1=="same", + if(length(tmp2)==0,tmp2=newoption); + );// 16.11.09until + println(SCEOUTPUT,""); + println(SCEOUTPUT,"%%%%%%%%%%%%%%%%%%%%"); + println(SCEOUTPUT,""); + ); + ); + if(flg==0&tmp1=="main", + if(repeatflg==1, + forall(2..(length(RepeatList)),nrep, + tmp=RepeatList_nrep; + forall(tmp, + if(substring(#,0,1)!="%", //16.01.04 + println(SCEOUTPUT,#); + ); + ); + ); + println(SCEOUTPUT,""); + repeatflg=0;RepeatList=[]; + nrepprev=nrep;//17.01.03 + nrep=0;//16.12.27 + npara=0;//16.12.27 + ); + if(length(wall)>0, + println(SCEOUTPUT,"\input{fig/"+wall+".tex}"); + ); + println(SCEOUTPUT,"\mainslide{"+tmp2+"}"); + println(SCEOUTPUT,""); + tmp2=""; + flg=1; + ); + if(flg==0&tmp1=="new", + if(repeatflg==1, + forall(2..(length(RepeatList)),nrep, + tmp=RepeatList_nrep; + forall(tmp, + if(substring(#,0,1)!="%", //16.01.04 + println(SCEOUTPUT,#); + ); + ); + ); + println(SCEOUTPUT,""); + repeatflg=0;RepeatList=[]; + nrepprev=nrep;//17.01.03 + nrep=0; + npara=0; + ); + if(length(wall)>0, + Repeatsameslide(repeatflg,sestr,["\input{fig/"+wall+".tex}"]); + ); + tmp="\newslide"; + NewSlideOption=""; //17.01.04 + if(substring(tmp2,0,1)=="[", + NewSlideOption=tmp2; //17.01.04 + tmp=tmp+tmp2; + tmp2=tmp3; + tmp3=tmp4; + tmp4=tmp5; + ); + tmp=tmp+"{"+tmp2+"}"; + Repeatsameslide(repeatflg,sestr,[tmp,"","\vspace*{18mm}",""]); + tmp2=""; + flg=1; + ); + if(flg==0&tmp1=="same", + if(repeatflg==1, + forall(2..(length(RepeatList)),nrep, + tmp=RepeatList_nrep; + forall(tmp, + if(substring(#,0,1)!="%", //16.01.04 + println(SCEOUTPUT,#); + ); + ); + ); + println(SCEOUTPUT,""); + repeatflg=0;RepeatList=[]; + nrepprev=nrep;//17.01.03 + nrep=0; + npara=0; + ); + if(length(wall)>0, + println(SCEOUTPUT,"\input{fig/"+wall+".tex}"); + ); + tmp="\sameslide"+NewSlideOption; //17.01.04; +// if(substring(tmp2,0,1)=="[", +// tmp=tmp+tmp2; +// tmp2=tmp3; +// tmp3=tmp4; +// ); + println(SCEOUTPUT,tmp); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\vspace*{18mm}"); + println(SCEOUTPUT,""); + tmp4=tmp3; + tmp3=tmp2; + tmp2=""; + flg=1; + ); + if(flg==0&tmp1=="itemize", + Repeatsameslide(repeatflg,sestr,["\begin{itemize}"]); + flgL=append(flgL,"i"); + tmp2=""; + tmp3=""; + flg=1; + ); + if(flg==0&tmp1=="enumerate", + Repeatsameslide(repeatflg,sestr,["\begin{enumerate}"+tmp2]); + flgL=append(flgL,"e"); + tmp2=""; + tmp3=""; + flg=1; + ); + if(flg==0&tmp1=="verbatim", //16.06.28from + Repeatsameslide(repeatflg,sestr,["\begin{verbatim}"]); + flgL=append(flgL,"v"); + tmp1=""; + tmp2=""; + tmp3=""; + verbflg=1; + flg=1; + ); //16.06.28until + if(flg==0&tmp1=="layer", + Repeatsameslide(repeatflg,sestr,[""]); + tmp="\begin{layer}"; + if(length(tmp2)>0, + tmp=tmp+tmp2; + , + tmp=tmp+"{120}{0}"; + ); + Repeatsameslide(repeatflg,sestr,[tmp]); + flgL=append(flgL,"l"); + tmp2=""; + tmp3=""; + flg=1; + ); + if(flg==0&tmp1=="putnote", + tmp="\putnote"+tmp2+"{"; + if(indexof(tmp3,"include")==0, + tmp1=indexof(tmp3,","); + if(tmp1==0, + tmp=tmp+"\input{fig/"+tmp3+".tex}}"; + , + tmp2=substring(tmp3,tmp1,length(tmp3)); + tmp3=substring(tmp3,0,tmp1-1); + tmp=tmp+"\scalebox{"+tmp2+"}{\input{fig/"+tmp3+".tex}}}"; + ); + , + tmp2=indexof(tmp3,"["); + tmp3=substring(tmp3,tmp2-1,length(tmp3)); + tmp=tmp+"\includegraphics"+tmp3+"{fig/"+tmp4+"}}"; + ); + Repeatsameslide(repeatflg,sestr,[tmp]); + tmp2=""; + tmp3=""; + flg=1; + ); + if(flg==0&tmp1=="item", + NonThinFlg=1; + Repeatsameslide(repeatflg,sestr,["\item"]); + tmp3=""; + flg=1; + ); + if(flg==0&tmp1=="end", + tmp=flgL_(length(flgL)); + if(tmp=="i", + Repeatsameslide(repeatflg,sestr,["\end{itemize}"]); + ); + if(tmp=="e", + Repeatsameslide(repeatflg,sestr,["\end{enumerate}"]); + ); + if(tmp=="l", + Repeatsameslide(repeatflg,sestr,["\end{layer}",""]); + ); + if(tmp=="v", // 16.06.28from + Repeatsameslide(repeatflg,sestr,["\end{verbatim}",""]); + verbflg=0; + ); // 16.06.28until + flgL=flgL_(1..(length(flgL)-1)); + tmp2=""; + tmp3=""; + flg=1; + ); + if(flg==0, // 16.06.28from + if(verbflg==0, + tmp2=tmp1; + , + tmp2=slideorgL_ns; // 16.07.11 + tmp2=replace(tmp2,"||","//"); // 16.07.10 + tmp3=""; + ); + ); // 16.06.28until + if(length(tmp2)>0, + if(tmp2=="...", tmp2=""); + if(NonThinFlg==1,NonThinFlg=2); + Repeatsameslide(repeatflg,sestr,[tmp2]); + ); + if(length(tmp3)>0, + Repeatsameslide(repeatflg,sestr,["\begin{layer}{120}{0}"]); + if(substring(tmp3,0,1)=="{", + tmp=tmp3; + tmp3=tmp4; + , + tmp="{60}{0}"; + ); + tmp1=indexof(tmp3,","); + if(tmp1==0, + tmp3="\putnotes"+tmp+"{\input{fig/"+tmp3+".tex}}"; + , + tmp2=substring(tmp3,tmp1,length(tmp3)); + tmp3=substring(tmp3,0,tmp1-1); + tmp3="\putnotes"+tmp+"{\scalebox{"+tmp2+"} + {\input{fig/"+tmp3+".tex}}}"; + ); + Repeatsameslide(repeatflg,sestr,[tmp3,"\end{layer}",""]); + ); + ); + ); + if(repeatflg==1, + forall(2..(length(RepeatList)),nrep, + tmp=RepeatList_nrep; + forall(tmp, + if(substring(#,0,1)!="%", //16.01.04 + println(SCEOUTPUT,#); + ); + ); + ); + println(SCEOUTPUT,""); + ); + println(SCEOUTPUT,""); + println(SCEOUTPUT,"\end{document}"); + closefile(SCEOUTPUT); +); + +Mkslides():=( + regional(sep,parent,texparentorg,tmp,tmp1,tmp2,tmp3,tmp4,flg); + tmp4=Fhead; + Fhead=""; + if(!iswindows(), //17.10.13 + Dirwork=replace(Dirwork,"\",pathsep()); + parent=replace(Dirwork+Shellparent,"\",pathsep()); + , + Dirwork=replace(Dirwork,"/",pathsep()); + parent=replace(Dirwork+Batparent,"/",pathsep());// 16.05.29 + ); + Dirwork=replace(Dirwork,pathsep()+"fig",""); + Setdirectory(Dirwork); + if(length(Texmain)>0, // 15.08.14 from + Texparent=Texmain; + ); + texparentorg=Texparent; //17.04.10from + if(isstring(Slidename), // 15.08.14 from + Texparent=Slidename; + );//17.04.10until + if(!isexists(Dirwork,Texparent+".txt"), // 17.04.12from + drawtext(mouse().xy,Texparent+".txt not exist in "+Dirwork, + size->24,color->[1,0,0]); + , // 17.04.12until + Presentation(Texparent); // 15.08.14 until + if(iswindows(), + tmp2=Batparent; + parent=replace(Dirwork+Batparent,sep+"fig","");// 16.05.29 + if(indexof(Pathpdf,"Adobe")>0, //17.12.09from + Makebat(Texparent,"ttv"); + , + Makebat(Texparent,"tv"); + ); //17.12.09until + kc():=( + println("kc : "+kc(parent,Dirlib,Fnametex)); // 16.06.10, 17.02.19 + ); + kc(); + Batparent=tmp2; + , + tmp2=Shellparent; + parent=replace(Dirwork+Shellparent,sep+"fig","");// 16.05.29 + Shellparent=replace(Shellparent,sep+"fig",""); + if(indexof(Pathpdf,"Adobe")>0, //17.12.09from + Makeshell(Texparent,"ttv"); + , + Makeshell(Texparent,"tv"); + ); //17.12.09until + kc():=( + println("kc : "+kc(parent,Mackc+Dirlib,Fnametex)); // 16.06.10 + ); + kc(); + Shellparent=tmp2; + ); + ); + Dirwork=Dirwork+pathsep()+"fig"; //17.10.16 + setdirectory(Dirwork); + Fhead=tmp4; + Texparent=texparentorg;//17.04.10 +); + +Mkslidesummary():=( // 17.10.26 for R + regional(texparentorg); + texparentorg=Texparent; + if(isstring(Slidename), + Texparent=Slidename; + ); + Mkslidesummary(Texparent,Texparent+"digest",["m","Wait=3"]); + Texparent=texparentorg; +); +Mkslidesummary(fin,fout):= + Mkslidesummary(fin,fout,["m","Wait=3"]); +Mkslidesummary(inputfile,outputfile,options):=( +//help:Mkslidesummary(fin,fout,options); + regional(fin,fout,out,figflg,dirworkorg,dirtop,tmp); + dirworkorg=Dirwork;//17.04.10from + dirtop=replace(Dirwork,pathsep()+"fig",""); + Changework(dirtop);//17.04.10uptp + fin=inputfile; + if(indexof(fin,".")==0,fin=fin+".tex"); + fout=outputfile; + if(indexof(fout,".")==0,fout=fout+".tex"); + cmdL=[ + "Dt=readLines('"+fin+"')",[], + "num=grep('\\hypertarget',Dt,fixed=TRUE)",[], + "Dt=Dt[setdiff(1:length(Dt),num)]",[], + "Smain=c();Snew=c();Ssame=c()",[], + "for(J in 1:length(Dt)){",[], + " Tmp=length(grep('\\mainslide{',Dt[J],fixed=TRUE))",[], + " if(Tmp>0){Smain=c(Smain,1)}else{Smain=c(Smain,0)}",[], + " Tmp=length(grep('\\newslide{',Dt[J],fixed=TRUE))",[], + " if(Tmp>0){Snew=c(Snew,1)}else{Snew=c(Snew,0)}",[], + " Tmp=length(grep('\\sameslide',Dt[J],fixed=TRUE))",[], + " if(Tmp>0){Ssame=c(Ssame,1)}else{Ssame=c(Ssame,0)}",[], + "}",[], + "Nnew=c();Nsame=c()",[], + "for(J in 1:length(Dt)){",[], + " if((Snew[J]==1)|(Smain[J]==1)){Nnew=c(Nnew,J)}",[], + " if(Ssame[J]==1){Nsame=c(Nsame,J)}",[], + "}",[], + "Out=Dt[1:Nnew[1]]",[], + "for(J in Looprange(2,length(Nnew))){",[], + " Tmp=max(c(1,Nsame[Nsame0, + tmp1=select(tmp1,indexof(#,sub)>0); + ); + forall(tmp1, + if((indexof(#,"##")>0) % (indexof(#,"~#")>0), + tmp=indexof(#,","); + println(substring(#,tmp,length(#))); + , + println(#); + ); + ); +); + +BBdata():=Bbdata(BBTarget,0); +BBdata(fname):=Bbdata(fname,0); // 16.04.09 +BBdata(fname,optionorg):=( +//help:BBdata(filename); +//help:BBdata(options=0(automatic),1(make),"w=","h="); + regional(fout,flg,path,file,kcfile,options,eqL,reL,stL, + waiting,addop,tmp,tmp1,tmp2); + path=""; + file=fname; + flg=0; + waiting=2; + forall(reverse(1..length(fname)), + if(flg==0, + tmp=substring(fname,#-1,#); + if(tmp=="/" % tmp=="\", // 14.01.15 + path=substring(fname,0,#-1); + file=substring(fname,#,length(fname)); + flg=1; + ); + ); + ); + if(path=="",path=Dirwork);//16.10.05 + if(indexof(file,".")==0,file=file+".pdf"); + if(islist(optionorg),options=optionorg,options=[optionorg]); + tmp=divoptions(options); + eqL=tmp_5; + reL=tmp_6; + stL=tmp_7; + flg=0; + addop=""; + if(length(reL)>0, + tmp=reL_1; + if(tmp==1,flg=1); + ); + forall(stL, + tmp=Toupper(substring(#,0,1)); + if(tmp=="M",flg=1); + ); + forall(eqL, + tmp=indexof(#,"="); + tmp1=Toupper(substring(#,0,2)); + tmp2=substring(#,tmp,length(#)); + if(tmp1=="W=", + addop=addop+",width="+tmp2; + options=remove(options,[#]); + ); + if(tmp1=="H=", + addop=addop+",height="+tmp2; + options=remove(options,[#]); + ); + ); + tmp=indexof(file,"."); + tmp1=substring(file,0,tmp-1); + fout=tmp1+".txt"; + if(iswindows(), + kcfile="kc.bat"; + , + kcfile="kc.sh"; + ); + if(flg==0, + tmp=load(fout); // + if(length(tmp)==0, + flg=1; + , + tmp=tokenize(tmp,"%%"); + tmp=tmp_2; + tmp1=indexof(tmp,":"); + tmp=substring(tmp,tmp1,length(tmp)); + tmp=Removespace(tmp); + if(tmp!=file,flg=1); + ); + ); + if(length(path)==0, + path=Dirwork; + ); + if(flg==1, + setdirectory(path); + tmp=load(file); + setdirectory(Dirwork); + if(length(tmp)==0, + println(" => "+file+" not exists"); + flg=-1; + ); + ); + if(flg==1, + SCEOUTPUT = openfile(kcfile); + if(!iswindows(), + println(SCEOUTPUT,"#!/bin/sh"); + ); + println(SCEOUTPUT,"cd "+Dq+path+Dq); + tmp=replace(PathT,"pdflatex","extractbb"); //16.11.22 + tmp=replace(tmp,"pdftex","extractbb"); //16.11.22 + tmp=replace(tmp,"xelatex","extractbb"); + tmp=replace(tmp,"uplatex","extractbb"); //17.09.20 + tmp=replace(tmp,"platex","extractbb"); + tmp=replace(tmp,"latex","extractbb"); + tmp=tmp+" -O "+file; + if(iswindows(), + tmp=tmp+" > "+Dirwork+"\"+fout; + , + tmp=tmp+" > "+Dirwork+"/"+fout; + ); + println(SCEOUTPUT,tmp); + println(SCEOUTPUT,"exit 0"); + closefile(SCEOUTPUT); + kc(Dirwork+"/"+kcfile,Mackc+Dirlib,Fnametex); // 16.06.07 + ); + if(flg>=0, + tmp1=0; + repeat(floor(waiting*1000/WaitUnit), + if(tmp1==0, + wait(10); + tmp=load(fout); + if(indexof(tmp,"CreationDate")>0, + tmp1=1; + ); + ); + ); + if(length(tmp)==0, + println(fout+" not generated. Maybe "+kcfile+" not run."); + , + tmp=tokenize(tmp,"%%"); + tmp=select(tmp,indexof(#,"Bounding")>0); + tmp=tmp_2; // + tmp1=indexof(tmp,":"); + tmp=substring(tmp,tmp1,length(tmp)); + tmp=removespace(tmp); + tmp=tokenize(tmp," "); + tmp1=""; + forall(tmp, + tmp1=tmp1+Sprintf(#,2)+" "; + ); + tmp1=removespace(tmp1)+addop; + tmp2="\includegraphics[bb="+tmp1+"]{"+file+"}"; + println(tmp2); + ); + ); +// setdirectory(Dirwork); + tmp2; // 16.04.25 +); + +//help:end(); + diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt index 437bdefd..0c89e3e7 100644 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt +++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpE.txt @@ -24,9 +24,8 @@ //help:Integrate*(numerical integration); //help:Findarea*(calculate the area of the region surrounded by a closed curve); //help:Findlength*(calculate the length of curve); -//help:Com2nd*(add the Scilab command to write out plot data into TeX); +//help:Com2nd*(add the R command to write out plot data into TeX); //help:Texcom*(write command into TeX output exactly as written here); -//help:SetEnglish*(display Scilab messages in English language); //help:Setunitlen*(specify the unit length); //help:Setmarklen*(specify the unit length of the tickmarks on coordinate axis); //help:Setorigin*(specify the position the origin); @@ -107,8 +106,8 @@ //help:PutcoL*(write letters in a specific column of the table)); //help:PutcoLexpr*(write mathematical expressions in a specific column of the table)); //help:Setwindow*(specify the area of drawing); -//help:Defvar*(the definition of a variable is called by Scilab); -//help:Deffun*(the definition of a function is called by Scilab); +//help:Defvar*(the definition of a variable is called by R); +//help:Deffun*(the definition of a function is called by R); //help:Extractdata*(endow attribute to the imported plot data); //help:ReadOutData*(import the plot data); //help:WriteOutData*(export the plot data); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt index 330a47c4..93e5e323 100644 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt +++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibhelpJ.txt @@ -26,7 +26,6 @@ //help:Findlength*(曲線の長さ); //help:Com2nd*(TeXの書き出しコマンドを入れる); //help:Texcom*(TeXのコマンドを直接記述); -//help:SetEnglish*(Scilabのメッセージを英語にする); //help:Setunitlen*(単位長を指定); //help:Setmarklen*(微小単位長を指定); //help:Setorigin*(原点の位置を指定); @@ -107,8 +106,8 @@ //help:PutcoL*(表の列に文字を書き入れる)); //help:PutcoLexpr*(表の列に数式を書き入れる)); //help:Setwindow*(描画領域を指定); -//help:Defvar*(変数をScilabに渡す); -//help:Deffun*(関数をScilabに渡す); +//help:Defvar*(変数をRに渡す); +//help:Deffun*(関数をRに渡す); //help:Extractdata*(読み込んだデータに属性を与える); //help:ReadOutData*(データを読み込む); //help:WriteOutData*(データを書き出す); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs index 5cc91de2..e9978e7b 100644 --- a/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs +++ b/texmf-dist/scripts/ketcindy/ketlib/ketcindylibmvr.cs @@ -14,7 +14,7 @@ // along with this program. If not, see // -println("ketcindymv(2017.11.24) loaded"); +println("ketcindymv(20171124) loaded"); //help:start(); @@ -132,7 +132,7 @@ Parafolder(path,fstr,sLorg,optionorg):=( repeat(1..30, if(length(fileslist(tmp))>0,wait(10)); ); - );//17.02.20upto + );//17.02.20until ); sfL=[]; forall(1..(length(sL)),nn, @@ -255,7 +255,7 @@ Animatefile(path,folder):=( , tmp="\scalebox{\figsize}{\input{\parapath/";//17.12.07 tmp=tmp+folder+"/"+tmp1_#+"}}%"; - ); // 17.08.30upto + ); // 17.08.30until println(SCEOUTPUT,tmp); // println(SCEOUTPUT,""); //17.06.25 if(# // -println("ketcindyout(2018.02.01) loaded"); +println("ketcindyout(20180327) loaded"); //help:start(); @@ -36,10 +36,10 @@ WritetoS(fname,cmdL):=( println(SCEOUTPUT,tmp); tmp="Setwindow([XMIN,XMAX],[YMIN,YMAX]);"; // 16.06.26from tmp=Assign(tmp,["XMIN",XMIN,"XMAX",XMAX,"YMIN",YMIN,"YMAX",YMAX]); - println(SCEOUTPUT,tmp); // 16.06.26upto + println(SCEOUTPUT,tmp); // 16.06.26until if(iswindows(), // 17.01.11from println(SCEOUTPUT,"setlanguage('en')"); - ); // 17.01.11upto + ); // 17.01.11until tmp="pi=%pi;////"; println(SCEOUTPUT,tmp); forall(cmdL, @@ -234,7 +234,7 @@ CalcbyS(name,path,cmd,optionorg):=( if(tmp1=="FI", // 16.06.26from wfile=tmp2; options=remove(options,[#]); - ); // 16.06.26upto + ); // 16.06.26until ); if(wfile=="", if(cat=="Y", @@ -245,7 +245,7 @@ CalcbyS(name,path,cmd,optionorg):=( ); if(indexof(wfile,".")==0,// 16.06.26from wfile=wfile+ext; - ); // 16.06.26upto + ); // 16.06.26until wflg=0; forall(strL, tmp=Toupper(substring(#,0,1)); @@ -310,7 +310,7 @@ CalcbyS(name,path,cmd,optionorg):=( tmp=textformat(#,dig); tmp=replace(tmp,"],[","];["); tmp3=tmp3+tmp+","; - ); // 15.11.01 upto + ); // 15.11.01 until ); ); tmp3=substring(tmp3,0,length(tmp3)-1)+tmp4+","; @@ -343,10 +343,10 @@ CalcbyS(name,path,cmd,optionorg):=( tmp=append(tmp,"mclose(Fd);"); cmdlist=concat(cmdlist,tmp); // tmp="fprintfMat("+Dq+file+".txt"+Dq+","+name+")"; -// cmdlist=append(cmdlist,tmp); // 16.03.11 upto +// cmdlist=append(cmdlist,tmp); // 16.03.11 until , // tmp="mputl(['????'],"+Dq+file+".txt"+Dq+");"; // 16.06.2 from -// cmdlist=concat(cmdlist,[tmp]); // 16.06.2 upto +// cmdlist=concat(cmdlist,[tmp]); // 16.06.2 until ); if(cat!="Y", // 16.12.18 cmdlist=append(cmdlist,"mputl('||||','"+wfile+"')"); @@ -656,7 +656,7 @@ CalcbyR(name,Arg1,Arg2):=( ); CalcbyR(name,path,cmd,optionorg):=( //help:CalcbyR(name,cmd); -//help:CalcbyR(options=["m/r","Wait=2","Out=yes","Pre=yes","File=result" ]); +//help:CalcbyR(options=["m/r","Wait=2","Out=yes","Pre=yes","Res=" ]); regional(options,tmp,tmp1,tmp2,tmp3,realL,strL,eqL, cat,dig,preflg,flg,wflg,file,nc,arg,cmdR,cmdlist,wfile,waiting); options=optionorg; @@ -692,7 +692,11 @@ CalcbyR(name,path,cmd,optionorg):=( options=remove(options,[#]); ); if(tmp1=="F", - wfile=tmp2; + wfile=tmp2; //18.02.27 + options=remove(options,[#]); + ); + if(tmp1=="R", + wfile=tmp2; //180227 options=remove(options,[#]); ); ); @@ -700,7 +704,7 @@ CalcbyR(name,path,cmd,optionorg):=( if(cat=="Y", wfile=Fhead+name+".txt"; , - wfile="resultR.txt"; + wfile="result.txt"; ); ); wflg=0; @@ -726,11 +730,11 @@ CalcbyR(name,path,cmd,optionorg):=( if(preflg==1, //18.01.27from cmdR=MkprecommandR(); ); - cmdR=concat(cmdR,cmd); //18.01.27upto + cmdR=concat(cmdR,cmd); //18.01.27until cmdlist=[]; if(dig>5, //16.10.28from cmdlist=append(cmdlist,"options(digits="+text(dig+2)+");"); - ); //16.10.28upto + ); //16.10.28until forall(1..floor(length(cmdR)/2),nc, //17.05.18 tmp1=cmdR_(2*nc-1); tmp1=replace(tmp1,LFmark,""); // 16.06.12 @@ -790,10 +794,10 @@ CalcbyR(name,path,cmd,optionorg):=( cmdlist=append(cmdlist,"if(is.matrix("+name+")){"); cmdlist=append(cmdlist," tmp=list()");//18.02.01from cmdlist=append(cmdlist," for(ii in 1:Length("+name+")){"); - cmdlist=append(cmdlist," tmp=c(tmp,list(Op(ii,ans)))"); + cmdlist=append(cmdlist," tmp=c(tmp,list(Op(ii,"+name+")))"); cmdlist=append(cmdlist," }"); - cmdlist=append(cmdlist," ans=tmp"); - cmdlist=append(cmdlist,"}");//18.02.01upto + cmdlist=append(cmdlist," "+name+"=tmp"); + cmdlist=append(cmdlist,"}");//18.02.01until cmdlist=append(cmdlist,"if(is.list("+name+")){"); // tmp=" cat(names("+name+"),file='"+wfile+"',sep=',')"; //18.01.27deleted // cmdlist=append(cmdlist,tmp); @@ -805,7 +809,7 @@ CalcbyR(name,path,cmd,optionorg):=( cmdlist=append(cmdlist,tmp); tmp=" cat(sharps,file='"+wfile+"',sep='',append=TRUE)"; cmdlist=append(cmdlist,tmp); - tmp=" for(jj in Looprange(1,length(ans[[ii]]))){"; + tmp=" for(jj in Looprange(1,length("+name+"[[ii]]))){"; cmdlist=append(cmdlist,tmp); tmp=" cat("+name+"[[ii]][[jj]],file='"+wfile+"',sep=',',append=TRUE)"; cmdlist=append(cmdlist,tmp); @@ -833,7 +837,7 @@ CalcbyR(name,path,cmd,optionorg):=( cmdlist=append(cmdlist,"}"); tmp="cat('////',file='"+wfile+"',sep=',',append=TRUE)"; cmdlist=append(cmdlist,tmp); - ); //16.10.23upto + ); //16.10.23until if(cat!="Y", // 16.12.18 cmdlist=append(cmdlist,"cat('////',file='"+wfile+"',sep='')"); ); @@ -862,6 +866,9 @@ CalcbyR(name,path,cmd,optionorg):=( closefile(SCEOUTPUT); ); WritetoR(file+".r",cmdlist); //17.10.08 + SCEOUTPUT=openfile("errormessageR.txt");//18.02.20from + println(SCEOUTPUT,""); + closefile(SCEOUTPUT);//18.02.20until kcR(PathR,file,concat(options,["m"])); // 15.09.25 ); flg=0; @@ -881,6 +888,11 @@ CalcbyR(name,path,cmd,optionorg):=( flg=-1; , wait(WaitUnit); + tmp=load("errormessageR.txt");//18.02.20 + if(length(tmp)>1, + println(tmp); + flg=-2; + );//18.02.20 ); ); ); @@ -890,10 +902,10 @@ CalcbyR(name,path,cmd,optionorg):=( if(flg==-1, println(wfile+" does not exist"); , - tmp="("+text(waiting)+" s )"; - println(wfile+" not generated "+tmp); - tmp=load("errormessageR.txt");//16.10.22 - if(length(tmp)>1,println(tmp));//16.10.22 + if(flg==0, + tmp="("+text(waiting)+" s )"; + println(wfile+" not generated "+tmp); + ); ); , println(" CalcbyR succeeded "+name+" ("+text(tmp2)+" sec)"); @@ -906,9 +918,13 @@ CalcbyR(name,path,cmd,optionorg):=( tmp=format(tmp3,dig); , if(indexof(tmp3,",")==0, - tmp=tmp3; + tmp=Dqq(tmp3); //180227 , - tmp=tokenize(tmp3,","); + tmp=tmp3; + if(substring(tmp3,0,2)=="c(", + tmp=substring(tmp3,2,length(tmp3)-1); + ); + tmp=tokenize(tmp,","); tmp=textformat(tmp,dig); ); ); @@ -918,9 +934,10 @@ CalcbyR(name,path,cmd,optionorg):=( tmp2=tmp2_1; if(length(tmp2)==1,tmp2=tmp2_1); if(isstring(tmp2), - if(indexof(tmp2,"nodata")>0,tmp2=[]); + if(indexof(tmp2,"nodata")>0,tmp2="[]"); //180227from + tmp2=parse(tmp2); ); - tmp=name+"="+textformat(tmp2,dig); + tmp3=textformat(tmp2,dig);//180227until , tmp3=""; forall(tmp2, @@ -934,7 +951,7 @@ CalcbyR(name,path,cmd,optionorg):=( tmp3=replace(tmp3,"[,","["); tmp3=replace(tmp3,",]","]"); ); - tmp=name+"="+tmp3; + tmp=name+"="+tmp3;//180227 parse(tmp); ); ); @@ -970,7 +987,7 @@ Rfun(name,fun,argL,optionorg):=( ); cmdL=[]; cmdL=concat(cmdL,[ - nm+"="+fun,argL + nm+"="+fun,argL, ]); options=concat(options,["Wait=2"]); CalcbyR(nm,cmdL,options); @@ -1077,7 +1094,7 @@ Readcsv(pathorg,file,optionorg):=( "writeLines",["tmp2",Dq+fout+Dq] ]; CalcbyR("sep",cmdL,concat(options,["Cat=n"])); - ); // 16.12.20upto + ); // 16.12.20until if(ErrFlag==1, println("Readcsv not completed"); , @@ -1088,7 +1105,7 @@ Readcsv(pathorg,file,optionorg):=( if(indexof(dt_1,",")==0,csv="N"); , csv="N"; - );// 17.02.10upto + );// 17.02.10until if(csv=="Y", dt=apply(dt,tokenize(#,",")); , @@ -1136,7 +1153,7 @@ Writecsv(nmL,dataorg,file,optionorg):=( if(islist(data_1), ncol=length(data_1); data=flatten(data); - ); // 17.02.09upto + ); // 17.02.09until options=optionorg; tmp=divoptions(options); eqL=tmp_5; @@ -1434,7 +1451,7 @@ Boxplot(nm,dataorg,ypos,dy,optionorg):=( ); setdirectory(tmp3); tmp=load(tmp4); - if(length(tmp)==0, ErrFlag=2); // 15.11.07 upto + if(length(tmp)==0, ErrFlag=2); // 15.11.07 until setdirectory(Dirwork); , file=Fhead+name+".dat"; @@ -1617,7 +1634,7 @@ Histplot(nm,dataorg,optionorg):=( ); setdirectory(tmp3); tmp=load(tmp4); - if(length(tmp)==0, ErrFlag=2); // 15.11.07 upto + if(length(tmp)==0, ErrFlag=2); // 15.11.07 until setdirectory(Dirwork); , file=Fhead+name+".dat"; @@ -1897,6 +1914,8 @@ MkprecommandR(prec):=( cmdL=concat(cmdL,[Plist_#,[]]); ); tmp2=sort(apply(VLIST,#_1)); // 16.02.03 from + tmp=apply(allpoints(),text(#));//18.02.11 + tmp2=remove(tmp2,tmp); tmp1=[]; forall(tmp2,tmp, tmp1=concat(tmp1,select(VLIST,#_1==tmp)); @@ -1919,7 +1938,7 @@ MkprecommandR(prec):=( tmp1=RSform(tmp1); tmp1=tmp+"="+tmp1+";"; tmp1=tmp1+"Assignadd('"+tmp+"',"+tmp+")"; - cmdL=concat(cmdL,[tmp1,[]]);//17.09.24upto + cmdL=concat(cmdL,[tmp1,[]]);//17.09.24until ); forall(OutFileList, cmdL=concat(cmdL,["tmp=ReadOutData",[Dq+#+Dq]]); @@ -1928,12 +1947,15 @@ MkprecommandR(prec):=( cmdL=concat(cmdL,[#,[]]); ); forall(GLIST, - tmp1=Rform(#); - cmdL=concat(cmdL,[tmp1,[]]); + if(indexof(#,"ReadOutData")==0, //18.02.12 + tmp1=Rform(#); + cmdL=concat(cmdL,[tmp1,[]]); + ); ); cmdL; ); + MkprecommandS():=MkprecommandS(6); MkprecommandS(prec):=( regional(cmdL,Plist,Pnamelist,Pvaluelist,tmp,tmp1,tmp2); @@ -1959,7 +1981,7 @@ MkprecommandS(prec):=( forall(tmp2,tmp, tmp1=concat(tmp1,select(VLIST,#_1==tmp)); ); - VLIST=tmp1;// 16.02.03 upto + VLIST=tmp1;// 16.02.03 until forall(VLIST, tmp=Sciform(#_1); tmp1=#_2; // 15.02.06 @@ -1981,7 +2003,7 @@ MkprecommandS(prec):=( tmp2=tmp2+#+","; ); tmp1=substring(tmp2,0,length(tmp2)-1)+")"; - ); // 16.11.14upto + ); // 16.11.14until , tmp1=format(tmp1,prec); ); @@ -1997,7 +2019,7 @@ MkprecommandS(prec):=( ); forall(FUNLIST, // 16.02.17 from cmdL=concat(cmdL,[#,[]]); - ); // 16.02.17 upto + ); // 16.02.17 until forall(GLIST, tmp1=Sciform(#); cmdL=concat(cmdL,[tmp1,[]]); @@ -2079,7 +2101,7 @@ PlotdataS(nm,fun,variable,optionorg):=( ); options=append(options,"Wait="+text(waiting)); if(wflg==1,options=append(options,"m")); - if(wflg==-1,options=append(options,"r"));// 16.03.02 upto + if(wflg==-1,options=append(options,"r"));// 16.03.02 until if(ErrFlag==0, CalcbyS(name,cmdL,concat(options,["cat=middle","Wait="+text(waiting)])); ); @@ -2101,96 +2123,6 @@ PlotdataS(nm,fun,variable,optionorg):=( ); ); -Implicitplot(nm,fun,varx,vary):= - Implicitplot(nm,fun,varx,vary,[]); -Implicitplot(nm,fnorg,varx,vary,optionorg):=( -//help:Implicitplot("1","3*x^2+y^2=1","x=[-3,3]","y=[-3,3]"); -//help:Implicitplot(options2=["Wait=10","Out=no","Mx=no"]); - regional(options,name,fun,waiting,mxcheck,outreg, - eqL,reL,strL,fname,var,rng,val,tmp,tmp1,tmp2,cmdL,flg,wflg); - name="imp"+nm; - fname=Fhead+name+".txt"; - fun=fnorg; - tmp=indexof(fun,"="); - if(tmp>0, - tmp1=substring(fun,0,tmp-1); - tmp2=substring(fun,tmp,length(fun)); - fun=tmp1+"-("+tmp2+")"; - ); - options=optionorg; - tmp=Divoptions(options); - eqL=tmp_5; - reL=tmp_6; - strL=tmp_7; - waiting=5; // 16.02.29 - mxcheck=0; // 16.02.29 - outreg=0; - forall(eqL, - tmp=indexof(#,"="); - tmp1=Toupper(substring(#,0,2)); - tmp2=substring(#,tmp,length(#)); - if(tmp1=="WA", - waiting=parse(tmp2); - options=remove(options,[#]); - ); - if(tmp1=="OU", - tmp=Toupper(substring(tmp2,0,1)); - if(tmp=="T" % tmp=="Y", outreg=1); - options=remove(options,[#]); - ); - if(tmp1=="MX", - tmp=Toupper(substring(tmp2,0,1)); - if(tmp=="T" % tmp=="Y", mxcheck=1); - options=remove(options,[#]); - ); - ); - wflg=0; - forall(strL, - tmp=Toupper(substring(#,0,1)); - if(length(#)==0, - options=remove(options,[#]); - ); - if(tmp=="M", - wflg=1; - options=remove(options,[#]); - ); - if(tmp=="R", - wflg=-1; - options=remove(options,[#]); - ); - ); - tmp1=Testfunstr(fun,varx,vary); - tmp=apply([fun,varx,vary],Dq+Rsform(#)+Dq); //17.09.30 -// tmp_1=RSform(tmp_1); - tmp=concat(tmp,reL); -// tmp=append(tmp,"Error"); // 16.02.29 - cmdL=MkprecommandR();//17.09.30 - cmdL=concat(cmdL,[ -// "evstr",[tmp1,"Error"], - name+"=Implicitplot",tmp, // 16.03.15 - "WriteOutData",[Dq+fname+Dq,Dq+name+Dq,name] - ]); - options=concat(options,["Wait="+text(waiting),"Cat=n"]); - if(wflg==1,options=append(options,"m")); - if(wflg==-1,options=append(options,"r")); - CalcbyR(name,cmdL,options); - if(ErrFlag==1, - println(" Implicitplot not completed"); - , - if(outreg==1, - OutFileList=remove(OutFileList,[fname]); - OutFileList=append(OutFileList,fname); - ); - ReadOutData(fname); - Extractdata(name,options); - tmp=parse(name); - tmp1=name+"="+textformat(tmp,5); - parse(tmp1); - tmp2=apply(tmp,Lcrd(#)); - tmp2; - ); -); - Dotfilldata(nm,iostr,pltlist):= Dotfilldata(nm,iostr,pltlist,[]); Dotfilldata(nm,iostr,pltlist,optionorg):=( @@ -2320,12 +2252,12 @@ WritetoA(fname,cmdL):=( tmp="/*####*/"; // 16.03.11 println(SCEOUTPUT,tmp); tmp="output("+Dq+wfilename+Dq+")$/*##*/"; // 16.05.18from - println(SCEOUTPUT,tmp); // 16.05.18upto + println(SCEOUTPUT,tmp); // 16.05.18until forall(1..(length(cmdL)), tmp1=cmdL_#; tmp=indexof(tmp1,";"); // 16.05.18from if(tmp>0,endmark=";",endmark="$"); - tmp1=replace(tmp1,";",""); // 16.05.18upto + tmp1=replace(tmp1,";",""); // 16.05.18until if(#==length(cmdL)-1, println(SCEOUTPUT,tmp1+";/*##*/"); , @@ -2576,7 +2508,7 @@ CalcbyA(name,cmd,optionorg):=( ); tmp=Indexof(tmp1,"/start/,"); // 16.05.18from tmp1="["+Dq+substring(tmp1,tmp+7,length(tmp1)-1)+"]"; - // 16.05.18upto + // 16.05.18until // tmp1=substring(tmp1,0,length(tmp1)-1)+"]"; parse(name+"="+tmp1); tmp=parse(name); @@ -2634,7 +2566,7 @@ AsirfunO(name,fun,argLorg,options):=( ); ); ); - ); // 16.05.26upto + ); // 16.05.26until Asirfun(name,"os_md."+fun,argL,options); ); Asirfun(name,fun,argL):=Asirfun(name,fun,argL,[]); @@ -2727,7 +2659,7 @@ Asirfun(name,fun,argL,optionorg):=( println(parse(nm)); ); ); - out; //16.05.26upto + out; //16.05.26until ); WritetoM(fname,cmdL,allflg):=( @@ -3051,7 +2983,7 @@ CalcbyM(name,cmd,optionorg):=( if(tmp>0, println("Some error(s) occurred"); //2016.02.24 from tmp2=tokenize(tmp1,"(%"); - forall(4..length(tmp2),println(tmp2_#)); //2016.02.24 upto + forall(4..length(tmp2),println(tmp2_#)); //2016.02.24 until flg=2; //2016.02.23 , if(indexof(tmp1,"closefile()")>0, // 15.11.24 @@ -3071,7 +3003,7 @@ CalcbyM(name,cmd,optionorg):=( tmp4=append(tmp4,tmp3); tmp0=1; ); - );// 16.04.26upto + );// 16.04.26until ); ); num="1234567890+-."; @@ -3481,7 +3413,7 @@ Mkviewobj(Arg1,Arg2,Arg3):=( if(!isstring(OCNAME), //17.04.13from drawtext(mouse().xy,"Mkobjcmd not defined", size->24,color->[1,0,0]); - , //17.04.13upto + , //17.04.13until if(islist(Arg2), Mkviewobj(Dirwork,Arg1,Arg2,Arg3); , @@ -3529,7 +3461,7 @@ Mkviewobj(pathorg,fnameorg,cmdLorg,optionorg):=( if(tmp1=="U", // 16.06.30from unit=tmp2; options=remove(options,[#]); - ); // 16.06.30upto + ); // 16.06.30until ); forall(strL, tmp=Toupper(substring(#,0,1)); @@ -3573,7 +3505,7 @@ Mkviewobj(pathorg,fnameorg,cmdLorg,optionorg):=( tmp1=select(tmp1,#=="W"); if(length(tmp1)==0, tmp=append(tmp,"Wait=5"); - );// 16.04.23upto + );// 16.04.23until CalcbyR("ans",cmdlist,tmp); wait(WaitUnit*100); // 16.03.18 , @@ -3603,7 +3535,7 @@ Mkviewobj(pathorg,fnameorg,cmdLorg,optionorg):=( ); if(length(unit)>0, // 16.06.30from Changeobjscale(fname,["Unit="+unit]);//16.10.04 - ); // 16.06.30upto + ); // 16.06.30until if(view==1, flg=0; // 16.03.14 from if(isstring(ViewFile), @@ -3612,7 +3544,7 @@ Mkviewobj(pathorg,fnameorg,cmdLorg,optionorg):=( if(flg==0, kcV3(path,fname); ViewFile=fname; - ); // 16.03.14 upto + ); // 16.03.14 until ); ); @@ -3634,7 +3566,7 @@ Objname(str,optionsorg):=( OCOPTION=options; , OCOPTION=["m","v"]; - ); //17.12.23upto + ); //17.12.23until println([OCNAME,OCOPTION]); ); @@ -3685,7 +3617,7 @@ Mkobjcmd(nm,fd,options):=( tmp2=append(tmp2,tmp); ); parse("oc"+nm+"="+tmp2); - println("cmd seq oc"+nm+" generated"); // 16.06.10upto + println("cmd seq oc"+nm+" generated"); // 16.06.10until OBJCMD=concat(OBJCMD,out);//16.11.29 out; ); @@ -3752,7 +3684,7 @@ Mkobjnrm(nm,fd,optionorg):=( "n:[nx,ny,nz]",[], // 16.04.21from "n:ratsimp(n)",[], "n:trigsimp(n)",[], - "n:factor(n)",[], // 16.04.21upto + "n:factor(n)",[], // 16.04.21until "n",[] ]); CalcbyM(name,cmdL,options); // 16.05.12 @@ -3780,7 +3712,7 @@ Mkobjnrm(nm,fd,optionorg):=( if(disp=="Y", // 16.05.02 println(out); // println(out_2); - ); // 16.05.02upto + ); // 16.05.02until out; ); @@ -3829,7 +3761,7 @@ Mkobjthickcmd(nm,fd,fnrm,optionorg):=( ); tmp2=tmp2+1; ); - ); // 16.04.21upto + ); // 16.04.21until options=remove(options,reL); forall(stL, if(length(#)>0, @@ -3868,7 +3800,7 @@ Mkobjthickcmd(nm,fd,fnrm,optionorg):=( tmp1=RSform(fnrm); // if(indexof(tmp1,"Out=")==0, // 16.05.09from // tmp1="Out="+tmp1; -// ); // 16.05.09upto +// ); // 16.05.09until ); out=concat(out,[tmp1,[]]); out=concat(out,["}",[]]); @@ -3885,7 +3817,7 @@ Mkobjthickcmd(nm,fd,fnrm,optionorg):=( tmp2=append(tmp2,tmp); ); parse("oc"+nm+"="+tmp2); - println("cmd seq oc"+nm+" generated"); // 16.06.10upto + println("cmd seq oc"+nm+" generated"); // 16.06.10until OBJCMD=concat(OBJCMD,out);//16.11.29 out; ); @@ -3944,7 +3876,7 @@ Mkobjpolycmd(nm,pd,optionorg):=( ); tmp1=RSform(textformat(vtx,5),2);//17.12.24from tmp2=RSform(textformat(face,5),2); - out=["Objpolyhedron",[tmp1,tmp2]];//17.12.24upto + out=["Objpolyhedron",[tmp1,tmp2]];//17.12.24until tmp2=[]; // 16.06.10from forall(out,tmp1, if(islist(tmp1), @@ -3955,7 +3887,7 @@ Mkobjpolycmd(nm,pd,optionorg):=( tmp2=append(tmp2,tmp); ); parse("oc"+nm+"="+tmp2); - println("cmd seq oc"+nm+" generated"); // 16.06.10upto + println("cmd seq oc"+nm+" generated"); // 16.06.10until OBJCMD=concat(OBJCMD,out);//16.11.29 out; ); @@ -3976,8 +3908,8 @@ Mkobjplatecmd(nm,pdorg,optionorg):=( // 16.06.18 if(length(pdn)==1,face=[1..(length(vtx))],face=pdn_2); vtx=apply(vtx,if(isstring(#),parse(#),#)); vtx=apply(vtx,if(ispoint(#),parse(text(#)+"3d"),#)); - pd_nn=[vtx,face];//16.10.04upto - ); // 16.06.19upto + pd_nn=[vtx,face];//16.10.04until + ); // 16.06.19until thick1=0.05; thick2=-0.05; options=select(optionorg,length(#)>0); @@ -4016,7 +3948,7 @@ Mkobjplatecmd(nm,pdorg,optionorg):=( // 16.06.18 tmp2=append(tmp2,tmp); tmp3=RSform(textformat(vtx,5),2);//17.12.24from tmp4=RSform(textformat(tmp2,5),2); - out=concat(out,["Objpolyhedron",[tmp3,tmp4]]);//17.12.24upto + out=concat(out,["Objpolyhedron",[tmp3,tmp4]]);//17.12.24until ); ); tmp3="["; // 16.06.10from @@ -4077,7 +4009,7 @@ Mkobjcrvcmd(nm,pstorg,options):=( if(MeasureDepth(tmp1)==0, if(islist(tmp1),flg=1); ); - if(flg==1, // 16.04.23upto + if(flg==1, // 16.04.23until if(!isstring(tmp1_1), forall(1..length(tmp1), tmp=["Objcurve",[pst+"[["+text(#)+"]]",thick,poly,dir]];//17.12.22 @@ -4087,7 +4019,7 @@ Mkobjcrvcmd(nm,pstorg,options):=( forall(1..length(tmp1), // 16.11.14from tmp=["Objcurve",[tmp1_#,thick,poly,dir]]; out=concat(out,tmp); - );// 16.11.14upto + );// 16.11.14until ); , tmp1=Chunderscore(pst); @@ -4104,7 +4036,7 @@ Mkobjcrvcmd(nm,pstorg,options):=( tmp2=append(tmp2,tmp); ); parse("oc"+nm+"="+tmp2); - println("cmd seq oc"+nm+" generated"); // 16.06.10upto + println("cmd seq oc"+nm+" generated"); // 16.06.10until OBJCMD=concat(OBJCMD,out);//16.11.29 out; ); @@ -4152,7 +4084,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=( dtL=[symb]; , dtL=symb; - ); //17.12.24upto + ); //17.12.24until , tmp=substring(symb,0,1); if(tmp>="a" & tmp<="z",tmp1=tmp+"s"); @@ -4174,7 +4106,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=( , tmp=Dirhead+"/data/fontF"; // 16.05.10 setdirectory(tmp); - ); // 16.04.23upto + ); // 16.04.23until dtL=Readbezier(symb,opbez); dtLstr=dtL; //17.12.23 setdirectory(Dirwork); @@ -4184,7 +4116,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=( if(length(tmp1)>0,//17.12.23from tmp1=tmp1_1; out=concat(out,[tmp1,[]]); - ); //17.12.23upto + ); //17.12.23until ); mx=100;Mx=-100;my=100;My=-100; forall(dtL,dt, @@ -4209,7 +4141,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=( if(length(tmp1)>0, //17.12.23from tmp1=tmp1_1; out=concat(out,[tmp1,[]]); - ); //17.12.23upto + ); //17.12.23until ); ); tmp1=text(options); @@ -4218,7 +4150,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=( forall(dtL, tmp2=tmp2+","+#; ); - tmp2="list("+substring(tmp2,1,length(tmp2))+")"; //17.12.23upto + tmp2="list("+substring(tmp2,1,length(tmp2))+")"; //17.12.23until out=concat(out,[ "Sd=Symb3data",[tmp2,size,0,dir,pos], //17.12.23 "Objsymb(Sd,"+tmp1+")",[] @@ -4233,7 +4165,7 @@ Mkobjsymbcmd(path,symborg,size,rot,dir,pos,optionorg):=( tmp2=append(tmp2,tmp); ); parse("oc"+symborg+"="+tmp2); - println("cmd seq oc"+symborg+" generated"); // 16.06.10upto + println("cmd seq oc"+symborg+" generated"); // 16.06.10until OBJCMD=concat(OBJCMD,out);//16.11.29 out; ); @@ -4723,6 +4655,148 @@ Mkketcindyjs(libname,options):=( //17.11.18 ); ); +///////////////// C function ////////////////// + +Cform(strorg):=( +//help:Cform(str) + regional(str,ter,out,hat,ns,ne,nn,jj,flg, + lv,str1,str2,tmp,tmp1,tmp2); + ter=["+","-","*","/","(",")"]; + str=replace(strorg,"pi","M_PI"); + hat=Indexall(str,"^"); + out=""; + ns=0; + forall(hat,nn, + tmp=substring(str,nn-2,nn-1); + if(tmp==")", + tmp1=substring(str,ns,nn-1); + tmp2=Parlevel(tmp1); + tmp=tmp2_(length(tmp2))_2; + lv=select(tmp2,#_2==-tmp); + tmp=lv_1_1; + out=out+substring(str,ns,ns+tmp-1); + str1=substring(str,ns+tmp,nn-2); + , + flg=0; + tmp2=reverse(ns..(nn-1)); + forall(tmp2,jj, + if(flg==0, + tmp1=substring(str,jj-1,jj); + if(contains(ter,tmp1), + tmp=jj; + flg=1; + ); + ); + ); + tmp1=substring(str,ns,tmp); + out=out+tmp1; + str1=substring(str,tmp,nn-1); + ); + tmp=substring(str,nn,nn+1); + if(tmp=="(", + tmp1=substring(str,nn,length(str)); + tmp2=Parlevel(tmp1); + lv=select(tmp2,#_2==-1); + tmp=lv_1_1; + str2=substring(tmp1,1,tmp-1); + ns=nn+tmp; + , + flg=0;tmp=0; + forall(nn..(length(str)),jj, + if(flg==0, + tmp1=substring(str,jj,jj+1); + if((length(tmp1)==0)%(contains(ter,tmp1)), + tmp=jj; + flg=1; + ); + ); + ); + str2=substring(str,nn,tmp); + ns=nn+1; + ); + out=out+"pow("+str1+","+str2+")"; + ); + str=out+substring(str,ns,length(str)); + str=str+"#"; + ter=apply(0..9,text(#)); + ter=append(ter,"."); + out=""; + tmp=substring(str,0,1); + if(contains(ter,tmp), + flg=1;out="";tmp1=tmp; + , + flg=0;out=tmp;tmp1=""; + ); + forall(2..(length(str)), + tmp=substring(str,#-1,#); + if(contains(ter,tmp), + if(flg==1, + tmp1=tmp1+tmp; + , + tmp1=tmp; + ); + flg=1; + , + if(flg==1, + if(indexof(tmp1,".")==0, + tmp1=tmp1+".0"; + ); + out=out+tmp1+tmp; + , + out=out+tmp; + ); + tmp1="";flg=0; + ); + ); + out=substring(out,0,length(out)-1); + out; +); + +ConvertFdtoC(Fd):=ConvertFdtoC(Fd,["x","y","z"]); +ConvertFdtoC(Fd,name):=( +//help:ConvertFd(Fd); + regional(FdL,FdC,uvar,vvar,tmp,tmp1); + FdL=Fullformfunc(Fd); + tmp=indexof(FdL_5,"="); //180303from + uvar=substring(FdL_5,0,tmp-1); + tmp=indexof(FdL_6,"="); + vvar=substring(FdL_6,0,tmp-1); + tmp1=apply(2..6,Assign(FdL_#,uvar,"u")); + tmp1=apply(tmp1,Assign(#,vvar,"v")); + tmp1=concat(tmp1,FdL_(7..8)); + FdC=apply(1..3,name_#+"="+Cform(tmp1_#)); + FdC=concat(FdC,[Cform(tmp1_4),Cform(tmp1_5)]); + FdC=concat(FdC,[tmp1_6]); +); + +ConstC(setlist):=( //180323 + regional(divL,sizeL,epsL); + //Mdv=50; Ndv=50; + //DsizeLL=5000; DsizeL=1500; DsizeM=500; DsizeS=200; + //Eps=0.00001; Eps1=0.01; Eps2=0.1; + forall(setlist, + if((#_1>1)&(#_1<=200), + divL=#; + if(length(divL)==0,divL=[50]); + if(length(divL)==1,divL=append(divL,divL_1)); + , + if(#_1>=100, + sizeL=#; + if(length(sizeL)==0,sizeL=[5000]); + if(length(sizeL)==1,sizeL=append(sizeL,1500)); + if(length(sizeL)==2,sizeL=append(sizeL,500)); + if(length(sizeL)==3,sizeL=append(sizeL,200)); + , + epsL=#; + if(length(epsL)==0,epsL=[0.01]); + if(length(epsL)==1,epsL=append(epsL,0.1)); + epsL=prepend(0.00001,epsL); + ); + ); + ); + ConstantListC=[divL,sizeL,epsL]; +); + Cheader():=Cheader(FdC,FheadC+"header.h"); Cheader(fdc,fname):=( regional(tmp,tmp1,tmp2,j, dW,dE,dS,dN,dstr, @@ -4766,7 +4840,7 @@ Cheader(fdc,fname):=( , if(length(tmp_1)>0, Eps1=tmp_1); if(length(tmp_1)>0, Eps2=tmp_2); - ); //17.05.24upto + ); //17.05.24until ); if(length(tmp)==3, if(length(tmp_1)>0, DsizeLL=tmp_1);//17.06.09(3lines) @@ -4785,7 +4859,7 @@ Cheader(fdc,fname):=( if(length(tmp_3)>0, DsizeM=tmp_3); if(length(tmp_4)>0, DsizeS=tmp_4); ) - );//17.05.21upto + );//17.05.21until ); tmp1=text(fdc_5_1); tmp2=text(fdc_5_2); @@ -5049,7 +5123,7 @@ Cmain(fname,cmdLorg):=( tmp3=cmdL_((nL_#+2)..(length(cmdL))); cmdL=concat(cmd,tmp3); ); - );// 17.05.29upto + );// 17.05.29until nL=select(1..(length(cmdL)),cmdL_#=="skeleton");// 17.06.05from cmd=[]; if(length(nL)>0, @@ -5103,8 +5177,8 @@ Cmain(fname,cmdLorg):=( , tmp3=cmdL_((nL_nn+2)..(length(cmdL))); cmdL=concat(cmd,tmp3); - );//17.06.08upto - );// 17.06.05upto + );//17.06.08until + );// 17.06.05until path=DirlibC+"/"; path=replace(path,"\","/"); cmd=[ @@ -5122,7 +5196,7 @@ Cmain(fname,cmdLorg):=( if(cutctr==0, //17.06.02 cmdL=prepend(["1"],cmdL); cmdL=prepend("cutfun",cmdL); - );// 17.05.26upto + );// 17.05.26until cutctr=0; forall(1..(floor(length(cmdL))/2),nn, tmp1=cmdL_(2*nn-1); tmp2=cmdL_(2*nn); @@ -5196,7 +5270,7 @@ Cmain(fname,cmdLorg):=( ); ); ); - cmd=append(cmd, tmp);// 17.05.26upto + cmd=append(cmd, tmp);// 17.05.26until ); ); tmp=select(1..(length(cmd)), indexof(cmd_#,"main")>0);//17.06.02from @@ -5209,7 +5283,7 @@ Cmain(fname,cmdLorg):=( cmd=append(cmd," if(ch=="+tmp+"){val=cutfun"+tmp+"(u,v);}"); ); cmd=concat(cmd,[" return val;", "}"]); - cmd=concat(cmd, tmp3);//17.06.02upto + cmd=concat(cmd, tmp3);//17.06.02until cmd=concat(cmd, [" return 0;", "}"]); SCEOUTPUT = openfile(fname); forall(cmd, @@ -5224,12 +5298,13 @@ Cmain(fname,cmdLorg):=( SCEOUTPUT = openfile(#); println(SCEOUTPUT,""); closefile(SCEOUTPUT); - ); // 17.05.20upto + ); // 17.05.20until ); kcC():=kcC(FheadC); kcC(cname):=( - regional(tmp, tmp1, flg); + regional(tmp, tmp1,flg,rfile); + rfile="resultC"+cname+".txt"; if(iswindows(), SCEOUTPUT = openfile("kc.bat"); println(SCEOUTPUT,"set path="+Dirwork); @@ -5241,7 +5316,7 @@ kcC(cname):=( tmp=tmp+" -o %path%\main.exe"; println(SCEOUTPUT,tmp); println(SCEOUTPUT,"%path%\main.exe"); - println(SCEOUTPUT,"echo //// > %path%\resultC.txt"); + println(SCEOUTPUT,"echo //// > %path%\"+rfile); println(SCEOUTPUT,"exit"); closefile(SCEOUTPUT); tmp=cname+".txt"; @@ -5253,19 +5328,19 @@ kcC(cname):=( tmp=PathC+" "+cname+".c -o main.out"; println(SCEOUTPUT,tmp); println(SCEOUTPUT,"./main.out"); - println(SCEOUTPUT,"echo //// > resultC.txt"); + println(SCEOUTPUT,"echo //// >"+rfile); println(SCEOUTPUT,"exit 0"); closefile(SCEOUTPUT); tmp=cname+".txt"; println(kc(Dirwork+Shellparent,Mackc+Dirlib,tmp)); ); - SCEOUTPUT=openfile("resultC.txt"); + SCEOUTPUT=openfile(wfile); println(SCEOUTPUT,""); closefile(SCEOUTPUT); flg=0; repeat(floor(10*1000/WaitUnit), if(flg==0, - tmp1=load("resultC.txt"); + tmp1=load(wfile); if(substring(tmp1,0,4)=="////", flg=1; ); @@ -5279,7 +5354,7 @@ kcC(cname):=( ); ); -ReadCdata(var, fname):=ReadCdata(var, fname,[]); +ReadCdataold(var, fname):=ReadCdata(var, fname,[]); ReadCdata(var, fname,options):=( regional(file,dt,name,str,tmp,tmp1,opstr,gout, out3,out2); if(indexof(fname,".")==0, @@ -5302,7 +5377,30 @@ ReadCdata(var, fname,options):=( if(length(parse(gout_2))>0, Projpara(var+"3d",options); ); - );//17.06.16upto + );//17.06.16until +); + +ReadCdata(fnameorg):=( + regional(tmp,tmp1,fname,data,out); + fname=fnameorg; + if(indexof(fname,".")==0, fname=fname+".txt"); + data=load(fname); + data=tokenize(data," -99999"); + out=[]; + tmp1=[]; + forall(1..(length(data)-1), + tmp=replace(data_#," ",","); + if(indexof(tmp,"99999.")==0, + tmp="["+replace(data_#," ",",")+"]"; + tmp=parse(tmp); + tmp1=append(tmp1,tmp); + , + out=append(out,tmp1); + tmp1=[]; + ); + ); + if(length(tmp1)>0,out=append(out,tmp1)); + out; ); WriteCdata(fnameorg,dataorg):=( @@ -5317,11 +5415,11 @@ WriteCdata(fnameorg,dataorg):=( forall(1..(length(data)),kk, forall(1..(length(data_kk)),nn, pt=apply(1..3,Sprintf(data_kk_nn_#,5)); - tmp=pt_1+" "+pt_2+" "+pt_3; + tmp=pt_1+" "+pt_2+" "+pt_3+" -99999"; println(SCEOUTPUT,tmp); ); if(kk0,tmp2=tmp2+"1;",tmp2=tmp2+"0;"); + tmp2=tmp2+"DrawW="; + if(indexof(tmp,"w")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;"); + tmp2=tmp2+"DrawS="; + if(indexof(tmp,"s")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;"); + tmp2=tmp2+"DrawN="; + if(indexof(tmp,"n")>0,tmp2=tmp2+"1;",tmp2=tmp2+"0;"); + cmd=append(cmd,tmp2); + ); + cmd=append(cmd," }"); + cmd=append(cmd,"}"); + tmp="void surffun(short ch,double u, double v, double p[3]){"; + cmd=append(cmd,tmp); + cmd=append(cmd," switch(ch){"); + forall(1..(length(FuncListC)),nf, + tmp2=" case "+text(nf)+" : "; + forall(1..3, + tmp1=FuncListC_nf_#; tmp=indexof(tmp1,"="); + tmp1=substring(tmp1,tmp,length(tmp1)); + tmp2=tmp2+"p["+text(#-1)+"]="+tmp1+";"; + ); + cmd=append(cmd,tmp2); + ); + cmd=append(cmd," }"); + cmd=append(cmd,"}"); + cmd; +); + +Ctopsurf(name):=Ctopsurf(name,[]); +Ctopsurf(name,cmdadd):=( + regional(path,cmd); + path=DirlibC+"/"; + path=replace(path,"\","/"); + cmd=[ + "#include ", "#include ", + "#include "+Dqq(Fhead+name+"header.h"), + "#include "+Dqq(path+"ketcommonhead.h"), + "#include "+Dqq(path+"ketcommon.h"), + "#include "+Dq+path+"surflibhead.h"+Dq, + "#include "+Dq+path+"surflib.h"+Dq, + "double cutfun1(short ch,double u, double v){", + " double p[3],val;", + " surffun(ch,u,v,p);", + " val=1;", + " return val;", + "}", + "double cutfun(short ch, int chcut, double u, double v){", + " double p[3],val;", + " switch(chcut){", + " case 1: val=cutfun1(ch,u,v);", + " }", + " return val;", + "}", + "int main(void){", + " double out[DsizeL][3], data[DsizeLL][3];", + " int i, j, nall, din[DsizeS][2];", + " char dirfname[256] = {'\0'};" + ]; + cmd; +); + +WritetoC(nm,header,main):=( + regional(hfile,mfile,top,body,tmp,tmp1,tmp2); + hfile=Fhead+nm+"header.h"; + mfile=Fhead+nm+".c"; + top=main_1; + body=main_2; + SCEOUTPUT=openfile(hfile); + forall(header, + println(SCEOUTPUT,#+"/**/"); + ); + closefile(SCEOUTPUT); + SCEOUTPUT=openfile(mfile); + forall(top, + println(SCEOUTPUT,#); + ); + println(SCEOUTPUT,"/**/"); + forall(body, + println(SCEOUTPUT,#+"/**/"); + ); + println(SCEOUTPUT," return 0;"); + println(SCEOUTPUT,"}"); + closefile(SCEOUTPUT); +); + +CalcbyC(name,cmd):=CalcbyC(name,PathC,cmd,[]); +CalcbyC(name,Arg1,Arg2):=( + if(isstring(Arg1), + CalcbyC(name,Arg1,Arg2,[]); + , + CalcbyC(name,PathC,Arg1,Arg2); + ); +); +CalcbyC(name,path,cmd,optionorg):=( + regional(options,eqL,strL,waiting,wflg,header,top,body, + wfile,hfile,mfile,flg,tmp,tmp1,tmp2,tmp3); + header=cmd_1; + top=cmd_2; + body=cmd_3; + options=optionorg; + tmp=divoptions(options); +// eqL=tmp_5; + strL=tmp_7; + waiting=30; + wfile="resultC"+Fhead+name+".txt"; + hfile=Fhead+name+"header.h"; + println(Dirwork); + println(hfile); + mfile=Fhead+name+".c"; + wflg=0; + forall(strL, + tmp=Toupper(substring(#,0,1)); + if(tmp=="M", + wflg=1; + options=remove(options,[#]); + ); + if(tmp=="R", + wflg=-1; + options=remove(options,[#]); + ); + ); + if(wflg==0, + tmp1=header; + if(!isexists(Dirwork,hfile),wflg=1); + if(wflg==0, + tmp2=load(hfile); + tmp2=tokenize(tmp2,"/**/"); + tmp2=tmp2_(1..(length(tmp2)-1)); + if(length(tmp1)!=length(tmp2),wflg=1); + ); + if(wflg==0, + forall(1..(length(tmp1)), + if(tmp1_#!=tmp2_#,wflg=1); + ); + ); + if(wflg==0, + tmp1=body; + if(!isexists(Dirwork+"/",mfile),wflg=1); + if(wflg==0, + tmp2=load(mfile); + tmp2=tokenize(tmp2,"/**/"); + tmp2=tmp2_(2..(length(tmp2)-1)); + if(length(tmp1)!=length(tmp2),wflg=1); + ); + if(wflg==0, + forall(1..(length(tmp1)), + if(tmp1_#!=tmp2_#,wflg=1); + ); + ); + ); + if(wflg==0,wflg=-1); + ); + if(wflg==1, + WritetoC(name,header,[top,body]); + SCEOUTPUT=openfile(wfile); + println(SCEOUTPUT,""); + closefile(SCEOUTPUT); + kcC(Fhead+name); + ); + flg=0; + tmp1=floor(waiting*1000/WaitUnit); + repeat(tmp1, + if(flg==0, + tmp=load(wfile); + if(length(tmp)>=4, + tmp2=substring(tmp,length(tmp)-4,length(tmp)); + if(tmp2=="////", + tmp=substring(tmp,0,length(tmp)-4); + flg=1; + tmp2=#*WaitUnit/1000; + ); + , + if(wflg==-1, + flg=-1; + , + wait(WaitUnit); + ); + ); + ); + if(flg<=0, + ErrFlag=1; + if(flg==-1, + println(wfile+" does not exist"); + , + if(flg==0, + tmp="("+text(waiting)+" s )"; + println(wfile+" not generated "+tmp); + ); + ); + ); + ); +); + +SfbdparadataC(nm,fd):= + SfbdparadataC(nm,fd,[],["nodisp"]); +SfbdparadataC(nm,fd,options):= + SfbdparadataC(nm,fd,options,["nodisp"]); +SfbdparadataC(nm,fdorg,optionorg,optionsh):=( +//help:SfbdparadataC("1",Fd); +//help:SfbdparadataC(options2=["r/m"]); + regional(funnm,fd,options,name2,name3,name2h,name3h,waiting, + eqL,reL,strL,fname,tmp,tmp1,tmp2,flg,wflg); + if(ChNumber==0,ChNumber=Ch); + fd=ConvertFdtoC(fdorg); + FuncListC=append(FuncListC,fd); + funnm=text(length(FuncListC)); + name2="sfbd2d"+nm; + name3="sfbd3d"+nm; + name2h="sfbdh2d"+nm; + name3h="sfbdh3d"+nm; + fname=Fhead+"sfbd"+nm+".txt"; + options=optionorg; + tmp=Divoptions(options); + eqL=tmp_5; + reL=tmp_6; + strL=tmp_7; + waiting=120; + wflg=0; + forall(strL, + tmp=Toupper(substring(#,0,1)); + if(tmp=="M", + wflg=1; + options=remove(options,[#]); + ); + if(tmp=="R", + wflg=-1; + options=remove(options,[#]); + ); + ); + options=remove(options,eqL); + options=remove(options,reL); + options=select(options,length(#)>0); + cmdL=[ + " double sfbd"+funnm+"[DsizeL][3];", + " char fname"+funnm+"[]="+Dqq(fname)+";", + " rangeUV("+funnm+");", + " boundary("+funnm+");", + " sfbdparadata("+funnm+",sfbd"+funnm+");", + " sprintf(dirfname,"+Dqq("%s%s")+",dirname,fname"+funnm+");", + " output3h("+Dqq("sfbd3d"+nm)+","+Dqq("sfbdh3d"+nm)+",dirfname,sfbd"+funnm+");"; + ]; + if(wflg==1,tmp1=append(options,"m")); + if(wflg==-1,tmp1=append(options,"r")); + if(ErrFlag==0, + tmp="sfbd"+nm; + CalcbyC(tmp,[Cheadsurf(),Ctopsurf(tmp),cmdL],tmp1); + ); + if(ErrFlag==1, + err("Sfbdparadata not completed"); + , + ReadOutData(fname); + GLIST=append(GLIST,"ReadOutData("+Dqq(fname)+")"); + if(islist(parse(name3)), + tmp1=name2+"=Projpara("+Dqq(name3)+",["; + tmp2=""; + if(length(options)>0, + forall(options, + tmp2=tmp2+Dqq(#)+","; + ); + tmp2=substring(tmp2,0,length(tmp2)-1); + ); + tmp1=tmp1+tmp2+"]);"; + parse(tmp1); + if(length(optionsh)==0,tmp2=["nodisp"],tmp2=optionsh); + tmp1=name2h+"=Projpara("+Dqq(name3h)+",["; + forall(tmp2, + tmp1=tmp1+Dqq(#)+","; + ); + tmp1=substring(tmp1,0,length(tmp1)-1)+"]);"; + parse(tmp1); + , + ErrFlag=1; + ); + ); +); + +CrvsfparadataC(nm,fk,fbdy,fd):= + CrvsfparadataC(nm,fk,fbdy,fd,[],["nodisp"]); +CrvsfparadataC(nm,fk,fbdy,fd,options):= + SfbdparadataC(nm,fk,fbdy,fd,options,["nodisp"]); +CrvsfparadataC(nm,Fk,Fbdy,fdorg,optionorg,optionsh):=( +//help:CrvsfparadataC("1","ax3d","sfbd3d1",Fd); +//help:CrvsfparadataC(options2=["r/m"]); +//help:CrvsfparadataC(optionsh=["nodisp"]); + regional(funnm,fd,options,name2,name3,name2h,name3h,waiting, + eqL,reL,strL,fname,tmp,tmp1,tmp2,flg,wflg,flg,ii,jj,eps); + eps=10^(-5); + fd=ConvertFdtoC(fdorg); + tmp=select(1..(length(FuncListC)),FuncListC_#==fd); + funcnum=tmp_1; + name2="crvsf2d"+nm; + name3="crvsf3d"+nm; + name2h="crvsfh2d"+nm; + name3h="crvsfh3d"+nm; + fname=Fhead+"crvsf"+nm+".txt"; + options=optionorg; + tmp=Divoptions(options); + eqL=tmp_5; + reL=tmp_6; + strL=tmp_7; + waiting=120; + wflg=0; + forall(strL, + tmp=Toupper(substring(#,0,1)); + if(tmp=="M", + wflg=1; + options=remove(options,[#]); + ); + if(tmp=="R", + wflg=-1; + options=remove(options,[#]); + ); + ); + options=remove(options,eqL); + options=remove(options,reL); + options=select(options,length(#)>0); +// tmp1=[Dqq(fname),Dqq(name3),name3,Dqq(name2),name2]; +// tmp1=concat(tmp1,[Dqq(name3h),name3h,Dqq(name2h),name2h]); + tmp2=parse(Fbdy); + flg=0; + tmp=Fhead+Fbdy+".dat"; + if(!isexists(Dirwork,tmp),flg=1); + if(flg==0, + tmp1=ReadCdata(tmp); + if(length(tmp1)!=length(tmp2),flg=1); + if(flg==0, + forall(1..(length(tmp1)),ii, + if(length(tmp1_ii)!=length(tmp2_ii),flg=1); + forall(1..(length(tmp1_ii)),jj, + if(flg==0, + if(Norm(tmp1_ii_jj-tmp2_ii_jj)>eps,flg=1); + ); + ); + ); + ); + ); + if(flg==1,WriteCdata(tmp,Fbdy)); + tmp2=parse(Fk); + flg=0; + tmp=Fhead+Fk+".dat"; + if(!isexists(Dirwork,tmp),flg=1); + if(flg==0, + tmp1=ReadCdata(tmp); + if(length(tmp1)!=length(tmp2),flg=1); + if(flg==0, + forall(1..(length(tmp1)),ii, + if(length(tmp1_ii)!=length(tmp2_ii),flg=1); + forall(1..(length(tmp1_ii)),jj, + if(flg==0, + if(Norm(tmp1_ii_jj-tmp2_ii_jj)>eps,flg=1); + ); + ); + ); + ); + ); + if(flg==1,WriteCdata(tmp,Fk)); + cmdL=[ + " double fbdy[DsizeL][3],fk[DsizeL][3];", + " char fname"+nm+"[]="+Dqq(fname)+";", + " rangeUV("+funnm+");", + " boundary("+funnm+");", + " readdata3("+Dqq(Fhead+Fbdy+".dat")+",fbdy);", + " readdata3("+Dqq(Fhead+Fk+".dat")+",fk);", + " crvsfparadata(fk,fbdy, 0, out);", + " sprintf(dirfname,"+Dqq("%s%s")+",dirname,fname"+nm+");", + " output3h("+Dqq("crvsf3d"+nm)+","+Dqq("crvsfh3d"+nm)+",dirfname,out);" + ]; + if(wflg==1,tmp1=append(options,"m")); + if(wflg==-1,tmp1=append(options,"r")); + if(ErrFlag==0, + tmp="crvsf"+nm; + CalcbyC(tmp,[Cheadsurf(),Ctopsurf(tmp),cmdL],tmp1); + ); + if(ErrFlag==1, + err("Crvsfparadata not completed"); + , + ReadOutData(fname); + GLIST=append(GLIST,"ReadOutData("+Dqq(fname)+")"); + if(islist(parse(name3)), + tmp1=name2+"=Projpara("+Dqq(name3)+",["; + tmp2=""; + if(length(options)>0, + forall(options, + tmp2=tmp2+Dqq(#)+","; + ); + tmp2=substring(tmp2,0,length(tmp2)-1); + ); + tmp1=tmp1+tmp2+"]);"; + parse(tmp1); + if(length(optionsh)==0,tmp2=["nodisp"],tmp2=optionsh); + tmp1=name2h+"=Projpara("+Dqq(name3h)+",["; + forall(tmp2, + tmp1=tmp1+Dqq(#)+","; + ); + tmp1=substring(tmp1,0,length(tmp1)-1)+"]);"; + parse(tmp1); + , + ErrFlag=1; + ); + ); +); + //help:end(); diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3.r b/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3.r deleted file mode 100644 index 2478a8fb..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3.r +++ /dev/null @@ -1,12660 +0,0 @@ -# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -# -#This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see - - -######################################### - -ThisVersion<- "KeTpic for R v5_2_3(18.02.02)" - -# 2018.02.02 -# Enclosing2 changed ( for distant curves, startpt option removed ) -# 2018.02.01 -# Intersectline,Intersectseg,...,Intersectcuves added -# Quicksort added -# Enclosing2 added (incomplete) -# 2018.01.29 -# Length added -# 2017.12.24 -# Objpolyhedron added -# 2017.12.23 -# Objsymb, symb3data added -# Objrecs, Objpolygon debugged -# Objthicksurf added -# 2017.12.22 -# Openobj,Closeobj,Writeobjpoint,Printobjstr,Objname,Objsurf added -# Crossprod added -# Objjoin, Objcurve, Objrecs, Objpolygon, Objsymb added -# Spacecurve debugged -# 2017.12.17 -# Setunitlen debugged ( MEMORI ) -# 2017.12.13 -# ReadOutData debugged -# 2017.12.11 -# Enclosing debugged ( appendrow -> Appendrow ) -# 2017.11.29 -# Anglemark, Arrowhead, Ovaldata debugged ( Circldeta included ) -# 2017.11.27 -# Anglemark changed ( Scilab 16.12.29) -# Plotdata,Paramplot,Spacecurve changed ( Scilab 16.12.13) -# Enclosing changed ( Scilab 16.10.09) -# Arrowhead,Arrowline changed ( Scilab 15.06.11) -# Definecolor added ( Scilab 15.05.04) -# 2017.11.26 -# Exprrot, Letterrot debugged ( `) -# 2017.11.24 -# Deqplot debugged (Looprange) -# 2017.11.20 -# InWindow debugged (for length=1) -# 2017.10.28 -# Openfile changed (Creator) -# 2017.10.23 -# ReadOutData greatly changed -# 2017.10.11 -# Drwpt debugged (Flattenlist ) -# 2017.10.08 -# Bezier debugged ( Num ) -# 2017.10.07 -# ReadOutData debugged ( for null data ) -# 2017.10.06 -# Deqdata, Deqplot added -# Connectseg remade(bug) -# 2017.09.30 -# Bezierpt, Bezier added -# 2017.09.29 -# Ptcrv debugged -# 2017.09.28 -# Openfile changed -# 2017.09.24 -# Circledata debugged -# Kyoukai changed (Eps) -# Shade updated -# 2017.09.22 -# Setcolor changed -# Plotdata,Paramplot,Spacecurve changed (N-1 -> N) -# 2017.09.21 -# Shade changed (Sci 17.01.09) -# 2017.09.17 -# Ovaldata,Assignadd changed -# Dist added -# Cicledata changed -# Bowdata debugged (Circledata,etc) - -# 2015.11.05 -# WriteOutData changed - -# 2015.10.29 -# WriteOutData changed ( endmark //// ) - -# 2015.10.24 -# ReadOutData changed ( in case of listlength=1 ) - -# 2014.12.23 -# ReadOutData added - -# 2014.12.17 -# WriteOutData added - -# 2014.0905 -# Unscaling debugged MARKLENI => MARKLEN -# 2014.03.31 -# PhHiddenData added -# 2014.03.30 -# Facesdata changed ( for Hiddendata ) -# 2014.03.23 -# MARKLEN separated, Rotate3data debugged - -# 2013.12.19 -# Openfile, Closefile, Bowname, Bownamerot - -# 2013.11.13 -# Arrowhead, Arrowheaddata - -# 2013.08.07 -# Cancoordpara added - -# 2013.08.07 -# Integrate added - -# 2013.05.20 -# Openfile changed - -# 2013.05.03 -# Tabledata, Pointdata changed -# Dividetable, Partframe added - -# 2013.02.10 -# Ketinit added - -# 2012.01.07 -# Arrowline, Arrowhead ( Cut implemented ) - -# 2011.12.18 -# Framedata ( compliant for list ) - -# 2011.12.12 -# Skeletonparadata... ( Flattellist used) - -# 2011.11.27 -# drwboxframe - -# 2011.11.07 -# metacommands added - -# 2011.11.02 -# Joingraphics ( for list structure ) - -# 2011.08.24 -# Setcolor ( c(1,0,0,0.5) etc ) -# Rotate3data ( Point is available ) - -# 2011.07.19 -# Drwline, Letter, Expr -# Drwboxplot( etc ) min,max => outliners -# Drwline ( unfinished in the case of "integer" ) - -# 2011.06.25 -# joincrvs debugged - -# synchro with ketpict2e - -# 2011.06.01 -# Bowdata debugged - -#2011.05.28 -# Ratiocmyk, Setcolor ( new ) - -#2011.04.28 -# Htickmark, Vtickmark debugged - -#2011.03.08 -# Drwboxframe debugged -# Putrow, Putrowexpr debugged (Dpos ) - -#2011.03.02 -# Tabledata ( index of hline ), PutcoL, PutcoLexpr ( "r",...) debugged -# Texcom changed ( // => backslash ) - -#2011.01.07 -# Dividegraphics, Splinedat are changed significantly -# Readtextdata is changed - -#2011.01.04 -# Derivative, Integrate are added - -#2010.12.07 -# Translatedata, Scaledata, Reflectdata changed ( efficient for vector ) -# Rotatedata changed ( deg : logical ) -# HIstplotdata, Drwhistplot ( type => freq , fpplot (added) ) - -# 2010.12.04 -# WindispT changed ( tickmark ) -# Lineplot changed ( mag=> length ) -# Plotdata debugged ( 'E=fun', 'D=') -# Enclosing changed (return PD) - -# 2010.12.02 -# WindispT changed -# Makecurves debugged - -# 2010.11.27 -# Pointdata changed ( efficient for matrix and data.frame ) -# WindispT -# Setwindow ( decide from data ) -# Assign debugged ( strsplit => gsub(fixed=T)) - -# 2010.11.20 -# Flattenlist, WindispT -# Splinedata changed( efficient for data.frame ) - -#2010.08.19 ( Maybe not finished ) -# Stripblanks -# Fullformfunc, Sf3data - -#2010.08.17 -# Phparadata, Phpersdata, Phspersdata, Phsparadata -# Facesdata, MakeveLfaceL, Menkakusi2 -# Rotate3data -# Skeletonpersdata, Skeletonpers3data, Makeskeletonpersdata -# Embed - -#2010.08.16 -# Spacecurve changed -# CameracoordCurve, Partcrv3, Projpers, CameraCurve, -# Perspt, Xyzaxpersname, Invperspt, Zparapt, Zperspt - -# 2010.08.15 -# Phcutoffdata added - -# 2010.08.13 -# Phcutdata, Spacecurve debugged -# Setangle changed - -# 2010.08.09 -# Spacecurve -# Rotate3data, Rotate3pt -# Phcutdata - -# 2010.08.08 -# Implementing 3d -# Initangle, Setangle, Setpers, SetstereoL, SetstereoR -# Mixlength -# Spaceline, Projpara, ProjCurve, Parapt -# Xyzax3data, Xyzaxparaname -# Cancoordpers, Invparapt, ProjcoordCurve -# Skeletonparadata, Skeletonpara3data, Makeskeletondata, Kukannozoki - -# 2010.07.25 -# Rotatedata changed -# Drwline changed (list of list) - -# 2010.04.09 -# Stat package added - -# 2010.04.02 -# Putcolexpr, Putrowexpr - -# 2010.04.02 - -# Windisp, Op changed -# Execmd added -# Texnewcmd, Texrenewcmd, Texend, -# Texctr, Texnewctr, Texsetctr -# Kyoukai debugged - -# 2010.01.20 -# Partcrv, Makeshasen : debugged - -# 2010.01.23 -# Ovaldata, Ovalbox added - -# 2010.01.27 -# Readtextdata changed -# Putrow, PutcoL debugged ( Putcol is OK) - -# 2010.01.31 -# Writetextdata added - -# 2010.02.12 -# Texvalctr, Texthectr added - -# 2010.02.22 -# Execmd changed - -# 2010.02.23 -# Op, Windisp changed - -# 2010.02.24 -# Execmd changed - -# 2010.03.07 -# Dotfilldata (Kosa>1) - -# 2010.03.21 -# Mixjoin -# Koutenlist (bug) - - -# 2010.03.24 -# Arrowhead ( bug in the case of "l" ) - -# 2010.03.28 -# Tabledata -# Diagcelldata ( New ) - -# 2010.03.30 -# Tabledata - -########################################### - -XMIN<- -5 -XMAX<- 5 -YMIN<- -5 ; YMAX<- 5 -ZIKU<- "line" -ARROWSIZE<- 1 -XNAME<- "$x$" -XPOS<- "e" -YNAME<- "$y$" -YPOS<- "n" -ONAME<- "O" -OPOS<- "sw" -ULEN<- "1cm" -MilliIn<- 1/2.54*1000 -PenThick<- round(MilliIn*0.02) -PenThickInit<- PenThick -TenSizeInit<<- 0.02*2 #17.10.07 -TenSize<- TenSizeInit -Wfile<-"" -MEMORI<- 0.05 -MEMORIInit<- MEMORI -MEMORINow<- MEMORI -MARKLEN<- 0.05 -MARKLENInit<- MARKLEN -MARKLENNow<- MARKLEN -GENTEN<- c(0,0) -YaSize<- 1 -YaAngle<- 18 -YaPosition<- 1 -YaThick<- 1 -YaStyle<- "tf" -PHI<- 30*pi/180 -THETA<- 60*pi/180 -FocusPoint<- c(0,0,0) -EyePoint<- c(5,5,5) -ASSIGNLIST<- list("`","'") - -SCALEX<- 1 -SCALEY<- 1 -LOGX<- 0 -LOGY<- 0 - -TEXFORLEVEL<- 0 -TEXFORLAST<- list() - -####################### - -Ketinit<- function(){ -XMIN<<- -5 -XMAX<<- 5 -YMIN<<- -5 ; YMAX<<- 5 -ZIKU<<- "line" -ARROWSIZE<<- 1 -XNAME<<- "$x$" -XPOS<<- "e" -YNAME<<- "$y$" -YPOS<<- "n" -ONAME<<- "O" -OPOS<<- "sw" -ULEN<<- "1cm" -MilliIn<<- 1/2.54*1000 -PenThick<<- round(MilliIn*0.02) -PenThickInit<<- PenThick -TenSizeInit<<- 0.02*2 #17.10.07 -TenSize<<- TenSizeInit -Wfile<<-"" -MEMORI<<- 0.05 -MEMORIInit<<- MEMORI -MEMORINow<<- MEMORI -MARKLEN<<- 0.05 -MARKLENInit<<- MARKLEN -MARKLENNow<<- MARKLEN -GENTEN<<- c(0,0) -YaSize<<- 1 -YaAngle<<- 18 -YaPosition<<- 1 -YaThick<<- 1 -YaStyle<<- "tf" -PHI<<- 30*pi/180 -THETA<<- 60*pi/180 -FocusPoint<<- c(0,0,0) -EyePoint<<- c(5,5,5) -ASSIGNLIST<<- list("`","'") - -SCALEX<<- 1 -SCALEY<<- 1 -LOGX<<- 0 -LOGY<<- 0 - -TEXFORLEVEL<<- 0 -TEXFORLAST<<- list() -} - -#------------------------------------------------------- - -Appendrow<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Out<-c() - Nc<- 0 - for (I in 1:Nargs) - { - Dt<- varargin[[I]] - Nc<- max(Nc,Ncol(Dt)) - if (class(Dt)=="matrix") Dt<-as.numeric(t(Dt)) - Out<- c(Out,Dt) - } - if (Nc>0) - { - Out<-matrix(Out, nrow=Nc) - Out<-t(Out) - } - else - { - Out<-c() - } - return(Out) -} - -Crossprod<-function(a,b) -{ - if (length(a)==3) - { - Tmp1<-a[2]*b[3]-a[3]*b[2] - Tmp2=a[3]*b[1]-a[1]*b[3] - Tmp3=a[1]*b[2]-a[2]*b[1] - Out=c(Tmp1,Tmp2,Tmp3) - } - else - { - Out=a[1]*b[2]-a[2]*b[1] - } - return(Out) -} - -Datalength<-function(Data) -{ - if (length(Data)==0) return(0) - if (mode(Data)=="numeric") return(Nrow(Data)) - if (mode(Data)=="character") return(nchar(Data)) - if (mode(Data)=="list") return(length(Data)) -} - -Crossprod<- function (a,b){ # 17.12.22 - if(length(a)==3){ - Tmp1=a[2]*b[3]-a[3]*b[2] - Tmp2=a[3]*b[1]-a[1]*b[3] - Tmp3=a[1]*b[2]-a[2]*b[1] - Out=c(Tmp1,Tmp2,Tmp3) - }else{ - Out=a[1]*b[2]-a[2]*b[1] - } -} - -Dotprod<-function(a,b) -{ - Tmp=crossprod(a,b) - return(Tmp) -} - -Dist<- function(...) # 17.09.17 -{ - varargin<- list(...) - a=varargin[[1]] - if(length(varargin)==1){ - tmp=sqrt(Dotprod(a,a)) - return(as.vector(tmp)) - } - else{ - b=varargin[[2]] - tmp=sqrt(Dotprod(b-a,b-a)) - retun(as.vector(tmp)) - } -} - -Member<-function(A,L) -{ - N<-length(L); - if (length(N)==0) return(FALSE) - for (I in 1:N) - { - if (class(L)=="list") - { - Tmp<-L[[I]] - } - else - { - Tmp<-L[I] - } - if (mode(A)=="numeric") - { - if (Norm(A-Tmp)==0) return(TRUE) - } - else - { - if (A==Tmp) return(TRUE) - } - } - return(FALSE) -} - -Norm<-function(V) -{ - Tmp<-as.vector(V); - Tmp<-crossprod(Tmp,Tmp); - Tmp<-sqrt(Tmp); - as.numeric(Tmp) -} - -Ncol<-function(P) -{ - if (class(P)=="matrix") return(ncol(P)) - else return(length(P)) -} - -Nrow<-function(P) -{ - if (length(P)==0) return(0) - if (class(P)=="matrix") return(nrow(P)) - else return(1) -} - -Looprange<- function(a,b) -{ -if (a<=b) return(a:b) -return(c()) -} - -Stripblanks<- function(Ch){ - Tmp<- gsub(" ","",Ch,fixed=TRUE) - return(Tmp) -} - -Quicksort<- function(seqL,key){ #18.02.01 - if(length(seqL)<2){ - out=seqL - }else{ - tmp1=Op(1,seqL) - tmp2=Op(2,seqL) - if(Op(key,tmp1)>=Op(key,tmp2)){ - pivot = tmp1 - }else{ - pivot=tmp2 - } - left = list() - right = list() - for(ii in 1:length(seqL)){ - tmp=Op(ii,seqL) - if(Op(key,tmp)< Op(key,pivot)){ - left=c(left,list(tmp)) - }else{ - right=c(right,list(tmp)) - } - } - left = Quicksort(left,key) - right = Quicksort(right,key) - out=c(left,right) - } - return(out) -} - -Derivative<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Fstr<- varargin[[1]] - Vstr<- varargin[[2]] - NvaL<- length(Vstr) - Flg<- 0 - if(Nargs>=3){ - VaL<- varargin[[3]] - Flg<- 1 - } - Str<- paste("deriv(~",Fstr,",c('",Vstr[1],"'",sep="") - for(J in Looprange(2,NvaL)){ - Str<- paste(Str,",'",Vstr[J],"'",sep="") - } - Str<- paste(Str,")",sep="") - if(NvaL<=3){ - Str<- paste(Str,",func=TRUE)",sep="") - } - else{ - Str<- paste(Str,")",sep="") - } - f<- eval(parse(text=Str)) - if(Flg==1){ - if (NvaL<=3){ - if(NvaL==1){V<- f(VaL[1])} - if(NvaL==2){V<- f(VaL[1],VaL[2])} - if(NvaL==3){V<- f(VaL[1],VaL[2],VaL[3])} - } - else{ - for(J in 1:NvaL){ - Tmp<- paste(Vstr[J],'<-',as.character(VaL[J])) - eval(parse(text=Tmp)) - } - V<- eval(f) - } - Out<- attr(V,'gradient') - Out<- Out[1,] - } - else{ - Out<- f - } - return(Out) -} - -Integrate<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Fstr<- varargin[[1]] - Vstr<- varargin[[2]] - IntvL<- varargin[[3]] - Str<- 'Tmpfun<- function(' - Str<- paste(Str,Vstr,'){',sep='') - Str<- paste(Str,Fstr,'}',sep='') - eval(parse(text=Str)) - Tmpfunv<- function(x){sapply(x,Tmpfun)} - Out<- 0 - for (J in 1:(length(IntvL)-1)){ - Tmp<- integrate(Tmpfunv,IntvL[J],IntvL[J+1]) - Out<- Out+Tmp[[1]] - } - return(Out) -} - -#-------------------------------------- - -######################### - -Anglemark<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-3) - PA<- varargin[[1]] - PB<- varargin[[2]] - PC=varargin[[3]] - r <- 0.5 - if (Nargs>=4){ - r<- varargin[[4]]*r - } - Out=c() - if(r>min(Norm(PA-PB),Norm(PC-PB))){ - return(Out) - } - Cir<- Circledata(c(PB,r)) #17.11.29 - Tmp<- IntersectcrvsPp(Cir,Listplot(PA,PB)) - P1<- Op(2,Op(1,Tmp)) - Tmp<- IntersectcrvsPp(Cir,Listplot(PC,PB)) - P2<- Op(2,Op(1,Tmp)) - if (abs(P1-P2)1){ - R<- Tmp - } - else{ - if (Flg==0){ - Ookisa<- Ookisa*Tmp - } - if (Flg==1){ - if (Tmp<5){ - Hiraki<- Tmp*Hiraki - } - else{ - Hiraki<- Tmp - } - } - if (Flg==2){ - R<- P+Tmp*(Q-P) - } - else{ - R<- P+Yapos*(Q-P) - } - if (Flg==3){ - Futosa<- Tmp - } - Flg<- Flg+1 - } - } - if (mode(Tmp)=="character"){ - Tmp<- grep("=", Tmp) - if (length(Tmp)>0){ - eval(parse(text=Tmp)) - Futosa<- Futosa*Thickness - R<- P+Position*(Q-P) - } - else{ - Str<- Tmp - } - } - } - Tmp1<- Listplot(c(P,Q)) - Tmp2<- Arrowheaddata(R,Q-P,Ookisa,Hiraki,Futosa,Str) - Out<- Joingraphics(Tmp1,Tmp2) -} - -###################################### - -# 2013.11.13 No Intersect debugged - -Arrowhead<-function(...) -{ ## Scaling is implemented - ## 12.01.08 Kirikomi - varargin<-list(...) - Nargs<-length(varargin) - P<-varargin[[1]] - Houkou<-varargin[[2]] - Ookisa<-0.2*YaSize - Hiraki<-YaAngle - Futosa<-0.5*YaThick - Cut<- 0 - Str<-YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<-varargin[[I]] - if (is.character(Tmp)){ - Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from - if(length(Equal)>0){ - Tmp1<- strsplit(Tmp,"=",fixed=TRUE) - Tmp2<- Tmp1[[1]] - if (Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ - Tmp<- paste("Cut=",Tmp2[2],sep="") - eval(parse(text=Tmp)) - } - }else{ - Str<- Tmp - } # 12.01.07 upto - } - if (is.numeric(Tmp) && length(Tmp)==1){ - if (Flg==0) Ookisa<-Ookisa*Tmp - if (Flg==1){ - if (Tmp<5) Hiraki<-Tmp*Hiraki - else Hiraki<-Tmp - } - if (Flg==2) Futosa<-Tmp - Flg<-Flg+1 - } - } - Ookisa<-1000/2.54/MilliIn*Ookisa - Theta<-Hiraki*pi/180 - if (Nrow(Houkou)>1){ - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Tmp<-Nearestpt(P,Houkou) - A<-Tmp[[1]] - I<-floor(Tmp[[2]]) - G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 - Flg<- 0 # 13.11.13 - JL<-seq(I,1,by=-1) - for (J in JL){ - B<-Ptcrv(J,Houkou) - Tmp<-IntersectcrvsPp(Listplot(list(A,B)),G) - if (length(Tmp)>0){ - Flg<- 1 - break - } - A<-B - } - if (Flg==0){ # 13.11.13 - print("Arrowhead may be too large (no intersect)") - return(P) - } - Houkou<-P-Op(1,Tmp[[1]]) - Houkou<- Unscaling(Houkou) - P<- Unscaling(P) - } - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Ev<--1/Norm(Houkou)*Houkou - Nv<-c(-Ev[2],Ev[1]) - if (length(grep("c",Str))>0){ - P<-P-0.5*Ookisa*cos(Theta)*Ev - } - if (length(grep("b",Str))>0){ - P<-P-Ookisa*cos(Theta)*Ev - } - A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv - B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv - if (length(grep("l",Str))>0){ - Tmp<-Listplot(list(A,P,B)) - Tmp1<- Unscaling(Tmp) - Drwline(Tmp1,Futosa) - } - else{ - C<- P+(1-Cut)*((A+B)/2-P) # 12.01.07 - Tmp<- Listplot(list(A,P,B,C,A)) # 12.01.07 - Tmp1<- Unscaling(Tmp) - Shade(Tmp1) - Tmp=Listplot(c(A,P,B,C,A,P)) # 15.6.20 - Tmp1=Unscaling(Tmp) - Drwline(Tmp1,0.1) # 15.06.11, 15.06.14 - } -} - -############################################ - -# 2013.11.13 No intersect debugged - -Arrowheaddata<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - Houkou<- varargin[[2]] - Ookisa<- 0.2*YaSize - Hiraki<- YaAngle - Futosa<- 0 - Thickness<- 1 - Str<- YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<-varargin[[I]] - if (mode(Tmp)=="character"){ - Tmp1<-grep("=",Tmp) - if (length(Tmp1)>0){ - eval(parse(text=Tmp)) - Futosa<- Thickness - } - else{ - Str<- Tmp - } - } - if (mode(Tmp)=="numeric" && length(Tmp)==1){ - if (Flg==0) Ookisa<-Ookisa*Tmp - if (Flg==1){ - if (Tmp<5) Hiraki<-Tmp*Hiraki - else Hiraki<-Tmp - } - if (Flg==2) Futosa<-Tmp - Flg<-Flg+1 - } - } - Theta<- Hiraki*pi/180 - if (Nrow(Houkou)>1){ - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Tmp<-Nearestpt(P,Houkou) - A<-Tmp[[1]] - I<-floor(Tmp[[2]]) - G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 - Flg<- 0 # 13.11.13 - JL<-seq(I,1,by=-1) - for (J in JL){ - B<- Ptcrv(J,Houkou) - Tmp<- IntersectcrvsPp(Listplot(list(A,B)),G) - if (length(Tmp)>0){ - Flg<- 1 - break - } - A<-B - } - if (Flg==0){ # 13.11.13 - print("Arrowhead may be too large (no intersect)") - return(P) - } - Houkou<-P-Op(1,Tmp[[1]]) - Houkou<- Unscaling(Houkou) - P<- Unscaling(P) - } - P<- Doscaling(P) - Houkou<- Doscaling(Houkou) - Ev<- -1/Norm(Houkou)*Houkou - Nv<- c(-Ev[2],Ev[1]) - if (length(grep("c",Str))>0){ - P<-P-0.5*Ookisa*cos(Theta)*Ev - } - if (length(grep("b",Str))>0){ - P<-P-Ookisa*cos(Theta)*Ev - } - A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv - B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv - Tmp<- Listplot(A,P,B) - Out<- Unscaling(Tmp) - return(Out) -} - -########################################## - -Arrowline<- function(...) -{ # 12.01.07 kirikomi - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - Q<- varargin[[2]] - Futosa<- YaThick - Ookisa<- YaSize - Hiraki<- YaAngle - Yapos<- YaPosition - Cutstr<- "Cut=0" - Str<- YaStyle - Flg<- 0 - for (I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - if (is.character(Tmp)){ - Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from - if(length(Equal)>0){ - Tmp1<- strsplit(Tmp,"=") - Tmp2<- Tmp1[[1]] - if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ - Tmp<- paste("Cut=", Tmp2[2],sep="") - Cutstr<- Tmp - } - } - else{ - Str<- Tmp - } # 12.01.07 upto - } - if (is.numeric(Tmp) && length(Tmp)==1){ - if (Flg==0) Ookisa<- Ookisa*Tmp - if (Flg==1){ - if (Tmp<5) Hiraki<- Tmp*Hiraki - else Hiraki<- Tmp - } - if (Flg==2) Yapos<- Tmp - if (Flg==3) Futosa<- Tmp - Flg<- Flg+1 - } - } - R<- P+Yapos*(Q-P) - Tmp=Q-Unscaling(0.2*Ookisa/2*(Q-P)/Norm(Q-P)) # 15.10.24 - Drwline(Listplot(c(P,Tmp)),Futosa) - Arrowhead(R,Q-P,Ookisa,Hiraki,Futosa,Cutstr,Str) -} - -######################################### - -Assign<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if (Nargs==0){ - ASSIGNLIST<<- list("`",Prime()) - Out<- ASSIGNLIST - return() -# return("Assign reset done"); - } - L<- list("`","'") - if (Nargs%%2==0){ - L<- Mixjoin(L,varargin) - ASSIGNLIST<<- L - Out<- L - return() -# return("Assign set done"); - } - if (Nargs==1){ - Fnstr<- varargin[[1]] - if (nchar(Fnstr)==0){ # case of "" - L<- ASSIGNLIST - Out<- c() - for (I in seq(1,length(L),by=2)){ - Tmp1<- L[[I]] - Tmp2<- L[[I+1]] - if (length(Tmp2)==1){ - Tmp3<- as.character(Tmp2) - } - else{ - if (mode(Tmp2)=="character"){ - Tmp3<- Tmp2 - } - else if (mode(Tmp2)=="list"){ - Tmp3<- makeliststr(Tmp2) - } - else if (mode(Tmp2)=="numeric"){ - Tmp3<- "c(" - for (J in Looprange(1,length(Tmp2))){ - Tmp3<- paste(Tmp3,as.character(Tmp2[J]),sep="") - if (J0){ - if (length(grep(C,OL))>0){ - Tmp<-substring(Ucode,Is,I-1); - Str<-paste(VL,Tmp,C,sep="") - VL<-Str - Is<-I+1; - } - } - else{ - Unit<-substring(Ucode,I,I+1) - Str<-substring(Ucode,Is,I-1) - VL<-paste(VL,Str,sep="") - break; - } - } - Valu<-eval(parse(text=VL)) - Str<-as.character(Valu); - ULEN<<- paste(Str,Unit,sep="") - if (Unit=="cm") MilliIn<<-1000/2.54*Valu - if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10 - if (Unit=="in") MilliIn<<-1000*Valu - if (Unit=="pt") MilliIn<<-1000/72.27*Valu - if (Unit=="pc") MilliIn<<-1000/6.022*Valu - if (Unit=="bp") MilliIn<<-1000/72*Valu - if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu - if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; - if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 - MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; - Str<-paste("{\\unitlength=",ULEN,"%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("\\begin{picture}%\n",file=Wfile,append=TRUE) - Str<-"(" - Tmp<-as.character(round(Dx,digits=6)) - Str<-paste(Str,Tmp,",",sep="") - Tmp<-as.character(round(Dy,digits=6)) - Str<-paste(Str,Tmp,")(",sep="") - Tmp<-as.character(round(Xm,digits=6)) - Str<-paste(Str,Tmp,",",sep="") - Tmp<-as.character(round(Ym,digits=6)) - Str<-paste(Str,Tmp,")%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - Str<-paste("\\special{pn ",as.character(PenThickInit),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -################################################# - -Bowdata<- function(...) #17.09.17 -{ - varargin <- list(...) - Nargs <- length(varargin) - PA <- varargin[[1]] - PB <- varargin[[2]] - Cut <- 0 - D <- 1/2*Norm(PB-PA) - if (Nargs>=3) { - H <- varargin[[3]]*D*0.2 - } - else { - H <- D*0.2 - } - H <- min(H,D) - if (Nargs>=4){ - Cut <- varargin[[4]] - } - Ydata <- MakeBowdata(PA,PB,H) - C <- Op(1,Ydata) - r <- Op(2,Ydata) - R1 <- Op(3,Ydata) - R2 <- Op(4,Ydata) - Rng <- paste("R=c(",as.character(R1),",",as.character(R2),")",sep="") - Theta <- (R1+R2)*0.5 - BOWMIDDLE <<- list(c(C[1]+r*cos(Theta),C[2]+r*sin(Theta)),Theta) - M <- Op(1,BOWMIDDLE) - ThetaM <- Op(2,BOWMIDDLE) - BOWSTART <<- PA - BOWEND <<- PB - if (Cut==0){ - Pd<- Circledata(c(C,r),Rng) - } - else{ - Alpha <- R1; Beta <- ThetaM-Cut/(2*r) - Rng <- paste("Rng=c(",as.character(Alpha),",",as.character(Beta),")",sep="") - Pd <- Circledata(c(C,r),Rng) - Alpha <- ThetaM+Cut/(2*r); Beta <- R2 - Rng <- paste("R=c(",as.character(Alpha),",",as.character(Beta),")",sep="") - Tmp <- Circledata(c(C,r),Rng) - Pd <- Appendrow(Pd,c(Inf,Inf),Tmp) - } -} - -Bowmiddle <- function(...) -{ - varargin <- list(...) - Nargs <- length(varargin) - if( Nargs==0) { - M <- BOWMIDDLE - return(M) - } - if (Nargs==1) { - Bdata <- varargin[[1]] - A <- Bdata[1,] - Dind <- Dataindex(Bdata) - Dc <- Nrow(Dind) - Tmp <- Dind[Dc,2] - B <- Bdata[Tmp,] - if (Dc==1) { - Tmp1 <- round(Tmp/2) - } - else { - Tmp1 <- Dind[1,2] - } - D <- Bdata[Tmp1,] - B <- B-A - D <- D-A - Tmp1 <- B[1]*D[2]-D[1]*B[2] - Tmp2 <- (Norm(B)^2*D[2]-B[2]*Norm(D)^2)/2 - Tmp3 <- -(Norm(B)^2*D[1]-B[1]*Norm(D)^2)/2 - C <- c(Tmp2,Tmp3)/Tmp1+A - R <- Norm(C-A) - B <- B+A - V <- (A+B)/2-C - V <- V/Norm(V) - M <- C+R*V - } - else { - A <- varargin[[1]]; B <- varargin[[2]] - D <- 1/2*Norm(B-A) - H <- 0.2*D; - if (length(varargin)>=3) { - Tmp <- varargin[[3]] - H <- Tmp*D*0.2 - } - H <- min(H,D) - Ydata <- MakeBowdata(A,B,H) - C <- Op(1,Ydata) - R <- Op(2,Ydata) - T <- (Op(3,Ydata)+Op(4,Ydata))/2 - P <- C+R*c(cos(T),sin(T)) - #M <- list(P,T) - M <- P - } - return(M) -} - -########################## -# 13.12.19 small movement supported - -Bowname<- function(...) -{ - varargin <- list(...) - Nargs <- length(varargin) - Siki <- varargin[[Nargs]] - Nargs<- Nargs-1 - Dr<- "c" - if(Nargs>=1){ - Tmp<- varargin[[Nargs]] - if(is.character(Tmp)){ - Dr<- Tmp - Nargs<- Nargs-1 - } - } - if (Nargs==0){ - Siki <- varargin[[1]] - P <- Op(1,BOWMIDDLE) - } - else if (Nargs==1){ - Bdata <- varargin[[1]] - P <- Bowmiddle(Bdata) - } - else{ - A <- varargin[[1]]; B <- varargin[[2]] - D <- 1/2*Norm(B-A) - Tmp <- varargin[[3]] - if (is.character(Tmp)){ - H <- D*0.2 - } - else { - H <- Tmp*D*0.2 - } - H <- min(H,D) - Ydata <- MakeBowdata(A,B,H) - Tmp <- Bowmiddle(Ydata) - P <- Op(1,Tmp) - } - Expr(P,Dr,Siki) -} - -########################## -# 13.12.19 small movement supported -# A,B, ... no longer supported - -Bownamerot <- function(...) -{ - varargin <- list(...) - Nargs <- length(varargin) - Eps <- 10^(-6) - Flg <- 1 - Tmp <- varargin[[Nargs]] - if (is.numeric(Tmp) && length(Tmp)==1 && Tmp<0){ - Flg <- Tmp - Nargs <- Nargs-1 - } - Siki <- varargin[[Nargs]] - Nargs<- Nargs-1 - Dr<- "c" - if(Nargs>=1){ - Tmp<- varargin[[Nargs]] - if(is.character(Tmp)){ - Dr<- Tmp - Nargs<- Nargs-1 - } - } - if (Nargs==0) { - P <- Op(1,BOWMIDDLE) - A <- BOWSTART - B <- BOWEND - } - else{ - Bdata<- varargin[[1]] - P<- Bowmiddle(Bdata) - A=Bdata[1,] - B=Bdata[nrow(Bdata),] - Tm<- 0; Tv<- 0 - if(Nargs>1){ - Tm<- varargin[[2]] - if(Nargs>2){ - Tv<- varargin[[3]] - } - } - } -# else if (Nargs==2) { -# Bdata <- varargin[[1]] -# P <- Bowmiddle(Bdata) -# A <- Bdata[1,] -# B <- Bdata[Nrow(Bdata),] -# Siki <- varargin[[2]] -# } -# else { -# A <- varargin[[1]]; B <- varargin[[2]] -# D <- 1/2*Norm(B-A) -# Tmp <- varargin[[3]] -# if (mode(Tmp)=="character") { -# H <- 0.2*D; Siki <- Tmp -# } -# else { -# H <- Tmp*D*0.2; Siki <- varargin[[4]] -# } -# H <- min(H,D) -# Ydata <- MakeBowdata(A,B,H) -# C <- Op(1,Ydata) -# R <- Op(2,Ydata) -# T <- (Op(3,Ydata)+Op(4,Ydata))/2 -# P <- C+R*c(cos(T),sin(T)) -# } - if (A[1]>B[1]+Eps){ - Tmp <- A - A <- B - B <- Tmp - } - if (Flg>0) { - Tmp <- B-A - } - else{ - Tmp <- A-B - } - Exprrot(P,Tmp,Tm,Tv,Siki) -} - -CalcHeight<-function(Hoko,Moji) -{ - D<-0 - H<-substring(Hoko,1,1) - Tmp<-paste("\\settoheight{\\Height}{",Moji,"}",sep="") - Str<-c(Tmp) - Tmp=paste("\\settodepth{\\Depth}{",Moji,"}",sep="") - Str<-c(Str,Tmp) - if (H=="n") Str<-c(Str,"\\setlength{\\Height}{\\Depth}") - if (H=="s") Str<-c(Str,"\\setlength{\\Height}{-\\Height}") - if (H=="c") - { - Str<-c(Str,"\\setlength{\\Height}{-0.5\\Height}") - Str<-c(Str,"\\setlength{\\Depth}{0.5\\Depth}") - Str<-c(Str,"\\addtolength{\\Height}{\\Depth}") - } - for (I in 1:length(Str)) cat(Str[I],file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################### - -CalcWidth<-function(Hoko,Moji) -{ - D<-0; - H<-substring(Hoko,2,2) - if (H=="e") D<-0 - if (H=="w") D<--1.0 - if (H=="c") D<--0.5 - Str1<-paste("\\settowidth{\\Width}{",Moji,"}",sep="") - Tmp<-as.character(D) - Str2<-paste("\\setlength{\\Width}{",Tmp,"\\Width}",sep="") - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################### -# 17.09.17 -# 17.09.24 - -Circledata<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Cr<- varargin[[1]] - C=Cr[1:2] - if(length(Cr)==4){ - ra=Norm(C-Cr[3:4]) - Nop=2 - } - else{ - ra=Cr[3] - Nop=2 - } - R=c(0,2*pi) - N=50 - for (I in Looprange(Nop,Nargs)){ - Tmp<- varargin[[I]] - if(is.character(Tmp)){ - Tmp1=regexpr("=",Tmp) #17.09.24from - Tmp2=substring(Tmp,Tmp1+1,nchar(Tmp)) - Tmp1=substring(Tmp,1,Tmp1) - Tmp1=gsub("NUM", "N", toupper(Tmp1)) - Tmp1=gsub("RNG", "R", Tmp1) - Tmp=paste(Tmp1,Tmp2,sep="") #17.09.24upto - eval(parse(text=Tmp)) - } - } - Dt<- (R[2]-R[1])/N - T <- seq(R[1],R[2],by=Dt) - X <- C[1]+ra*cos(T) - Y <- C[2]+ra*sin(T) - XY<- c(X,Y) - P<- matrix(XY,ncol=2) - return(P) -} - -######################### -# 13.12.19 - -Closefile<-function(...) -{ - varargin<- list(...) - if(length(varargin)>=1){ - Pa<- varargin[[1]] - if(is.character(Pa)){ - if(Pa=="1") Endpicture(1) - if(Pa=="0") Endpicture(0) - } - } - Wfile<<-"" -} - -######################### - -Closepar<- function() -{ - S<- "%\n\\end{minipage}" - cat(S,file=Wfile,append=TRUE) - Closephr() -} - - -#################################### - -Closephr<- function() -{ - cat("%\n}%\n",file=Wfile,append=TRUE) -} - -##################################### - -Dataindex<-function(P) -{ - # Inf;Inf : Terminator - Ndm<-c() - if (length(P)==0) return(Ndm) - N1<-1 - Flg<-0 - for (J in 1:Nrow(P)) - { - if (P[J,1]==Inf) - { - Ndm<-Appendrow(Ndm,c(N1,J-1)) - N1<-J+1; - if (P[N1,1]==Inf) - { - Flg<-1; - break; - } - } - } - if (Flg==0) - { - Ndm<-Appendrow(Ndm,c(N1,Nrow(P))) - } - if (class(Ndm)=="numeric") - { - Tmp<-matrix(Ndm,nrow=1) - Ndm<- Tmp - } - return(Ndm) -} - -################################ - -Dashline<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Nall<- Nargs; Sen<- 1 ; Gap<- 1 - Tmp<- varargin[[Nall]] - if (mode(Tmp)=="numeric" && length(Tmp)==1 && Tmp>0){ - Tmp1<- varargin[[Nall-1]] - if (mode(Tmp1)=="numeric" && length(Tmp1)==1 && Tmp1>0){ - Sen<- Tmp1; Gap<- Tmp - Nall<- Nall-2 - } - else{ - Sen<- Tmp; Gap<- Sen - Nall<- Nall-1 - } - } - Sen<- 1000/2.54/MilliIn*Sen - Gap<- 1000/2.54/MilliIn*Gap - for (N in Looprange(1,Nall)){ - Pdata<- varargin[[N]] - if (Mixtype(Pdata)==1){ - Pdata<- list(Pdata) - } - for (II in 1:length(Pdata)){ - Figdata<- Op(II,Pdata) - Makehasen(Figdata,Sen,Gap,0) - } - } -} - -############################################## -# 17.11.27 - -Definecolor<- function(Name,Data){ - Tmp1=length(Data) - if((Tmp1<3) || (Tmp1>4)){ - cat("Size of data should be 3 or 4.") - return() - } - if(Tmp1==4){ - Tp="cmyk" - }else{ - Tp="rgb" - } - Tmp="" - for(J in 1:Tmp1){ - Tmp=paste(Tmp, as.character(Data[J]),sep="") - if(J0){ - for (J in Looprange(1,length(Sha))){ - Tmp<- Op(J,Sha) - Q<- Tmp[1,] - R<- Tmp[2,] - Tmp<- Dotprod(Q-P,V)/Kankaku - K1<- ceiling(Tmp) - if (abs(K1-Tmp)0){ - for (J in 1:length(Sha)){ - Tmp<- Op(J,Sha) - Q<- Tmp[1,] - R<- Tmp[2,] - Tmp<- Dotprod(Q-P,V)/Kankaku - K1<- ceiling(Tmp) - if (abs(K1-Tmp)0){ - for (J in 1:length(Sha)){ - Tmp<- Op(J,Sha) - Q<- Tmp[1,] - R<- Tmp[2,] - Tmp<- Dotprod(Q-P,V)/Kankaku - K1<- ceiling(Tmp) - if (abs(K1-Tmp) 1) { - Seg <- Lenall/(Nten-1) - } - else { - Seg <- Lenall - } - Eps <- 10^(-6)*Seg - PPd<-c() - Hajime <- 1 - for (I in Looprange(0,Nten-1)) { - Len <- Seg*I - if (I>0) { - J <- Hajime - while( Len>=Lenlist[J]+Eps) { - J <- J+1 - } - Hajime <- J-1 - } - T <- (Len-Lenlist[Hajime])/ - (Lenlist[Hajime+1]-Lenlist[Hajime]) - P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - PPd<-Appendrow(PPd,P) - if (I==Nten-1) { - if (Norm(P-Data[1,])80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<-0 - } - } - if (Mojisu!=0){ - cat("%\n",file=Wfile,append=TRUE) - } - cat("\\special{fp}%\n",file=Wfile,append=TRUE) - } - } - } - Str<-"%" - if (Thick>0){ - Tmp<-PenThick/PenThickInit - Setpen(Tmp) - } -} - -########################################### - -Drwpt<-function(...) -{ ## Scaling is implemented - varargin<-list(...) - Nargs<-length(varargin) - if (TenSize>TenSizeInit){ - N<- round(6*sqrt(TenSize/TenSizeInit)) - } - else{ - N<-4 - } - Tmp<- varargin[[Nargs]] - if (mode(Tmp)=="numeric"){ - if (length(Tmp)>1){ - Kosa<- 1; All<- Nargs - } - else{ - Kosa<- Tmp; All<- Nargs-1 - } - } - else if (mode(Tmp)=="list"){ - Kosa<- 1; All<- Nargs - } - CL<-c() - for (J in 0:N){ - Tmp<- TenSize*0.5*1000/2.54/MilliIn - Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) - CL<- append(CL,Tmp) - } - CL<- matrix(CL,nrow=2) - CL<- t(CL) - for (II in Looprange(1,All)){ - MS<- varargin[[II]] - MS=Flattenlist(MS) #17.10.11 - if (mode(MS)=="numeric"){ - MS<- list(MS) - } - for (I in Looprange(1,length(MS))){ - P<- MS[[I]] - if (InWindow(P)!="i") next - P<- Doscaling(P) - PL<-c() - for (J in 0:N){ - PL<- c(PL,P+CL[J+1,]) - } - PL<-matrix(PL,nrow=2) - PL<-t(PL) - Mojisu<-0 - for (J in 1:Nrow(PL)){ - Q<- PL[J,] - X<- as.character(round(MilliIn*Q[1])) - Y<- as.character(-round(MilliIn*Q[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if (Mojisu>80){ - cat("#\n",file=Wfile,append=TRUE) - } - Mojisu=0 - } - Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") - Str2<- "\\special{fp}%\n" - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - } - } -} - -###################################################### - -Drwxy<-function(...) -{ - varargin<-list(...) - Nargs <- length(varargin) - Tmp<-grep("arrow", ZIKU) - if (length(Tmp)>0) - { - Arrowline(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]),ARROWSIZE) - Arrowline(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX),ARROWSIZE) - } - else - { - Drwline(Listplot(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]))) - Drwline(Listplot(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX))) - } - Letter(c(XMAX,GENTEN[2]),XPOS,XNAME) - Letter(c(GENTEN[1],YMAX),YPOS,YNAME) - Letter(GENTEN,OPOS,ONAME); -} - -########################################## -# 10.12.04 - -Enclosing<- function(...) -{ - Eps=10^(-7) # Scilab 16.12.05 - varargin<- list(...) - Nargs<- length(varargin) - P<- varargin[[1]] - if (Mixtype(P)==2){ - Tmp<- Op(1,P) - if (mode(Tmp)!="numeric" || length(Tmp)>1){ - AnsL<- EnclosingS(...) - AnsL<- Joincrvs(AnsL) # 10.12.04 - } - } - Tmp1=Op(1,AnsL) # Scilab 16.12.05from - Tmp2=Op(nrow(AnsL),AnsL) - if(Norm(Tmp2-Tmp1)>Eps){ - AnsL=Appendrow(AnsL,Tmp1) - } - return(AnsL) -} - -######################################### - -EnclosingS<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - AnsL<- list() - PdataL<- varargin[[1]] - Nall<-length(PdataL) - Eps<- 10^(-3) - EEps<- 0.1 - S<- c() - Flg<- 0 - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if (mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ - S<- Tmp - } - if (mode(Tmp)=="numeric" && length(Tmp)==1){ - if (Flg==0){ - Eps<- Tmp - Flg=Flg+1 - } - else{ - EEps<- Tmp - } - } - } - F<- Op(1,PdataL); G<- Op(Nall,PdataL) - KL<- IntersectcrvsPp(F,G) - if (length(KL)==1){ - Tmp<- Op(1,KL) - P<- Op(1,Tmp) - T1<- Op(2,Tmp) - } - if (length(KL)==0){ - if (Numptcrv(F)>Numptcrv(G)){ - Tmp<- Nearestpt(F,G) - P<- Op(1,Tmp) - T1=Op(2,Tmp) - } - else{ - Tmp<- Nearestpt(G,F) - P<- Op(3,Tmp) - T1<- Op(4,Tmp) - } - } - if (length(KL)>=2){ - if (length(S)==0){ - return("No Start Point") - } - Tmp<- Op(1,KL) - P<- Op(1,Tmp) - T1<- Op(2,Tmp) - Tmp<- Norm(P-S) - for (I in Looprange(2,length(KL))){ - Tmp1<- Op(1,Op(I,KL)) - Tmp2<- Norm(Tmp1-S) - if (Tmp21) P<- Q - if (N==Nall){ - Q=S - } - else{ - Flg<- 0 - G<- Op(N+1,PdataL) - KL<- IntersectcrvsPp(G,F) - if (length(KL)==1){ - Tmp<- Op(1,KL) - Q<- Op(1,Tmp) - T3<- Op(2,Tmp) - Flg<- 10 - } - if (length(KL)==0) Flg<- 1 - if (length(KL)>=2){ # Maple bug? - Tmp1<- Op(1,Op(1,KL)) - Tmp2<- Op(1,Op(2,KL)) - Tmp<- Norm(Tmp1-Tmp2) - if (TmpNumptcrv(G)){ - Tmp<- Nearestpt(F,G) - Q<- Op(1,Tmp) - T3<- Op(4,Tmp) - Flg<- 10 - } - else{ - Tmp<- Nearestpt(G,F) - Q<- Op(3,Tmp) - T3<- Op(2,Tmp) - Flg<- 10 - } - } - if (Flg<10){ - T2<- Inf - for (I in Looprange(1,length(KL))){ - Dt<- Op(I,KL) - Tmp1<- Op(1,Dt) - Tmp<- Op(3,Dt) - Tmp2<- Paramoncrv(Tmp1,Tmp,F) - Tmp3<- Op(2,Dt) - if (Tmp2>T1+Eps && Tmp20){ - eval(parse(text=Op(I,StrL))) - } - } -} - -######################################### - -Expr<-function(...) -{ ## Scaling is implemented - varargin<-list(...) - Nargs<-length(varargin) - Irng<-c(seq(from=1,to=Nargs,by=3)) - for (I in Irng) - { - Tmp<-varargin[[I]] - P<- Doscaling(Tmp) - X<-P[1] - Y<-P[2] - Houkou<-varargin[[I+1]] - Mojiretu<-paste("$",varargin[[I+2]],"$",sep="") - Hset<-Houkou - Vhoko<-"c" - if (length(grep("n",Hset))>0) - { - Vhoko<-"n"; Y<-Y+MEMORI - } - if (length(grep("s",Hset))>0) - { - Vhoko<-"s"; Y<-Y-MEMORI - } - Hhoko<-"c" - if (length(grep("e",Hset))>0) - { - Hhoko<-"e"; X<-X+MEMORI - } - if (length(grep("w",Hset))>0) - { - Hhoko<-"w"; X<-X-MEMORI - } - Hoko<-paste(Vhoko,Hhoko,sep="") - Suu<-"+-.0123456789" - SuuL<-Suu - J<-1; Dstr<-"" - while (J<=nchar(Houkou)) - { - Tmp<-substring(Houkou,J,J) - if (length(grep(Tmp,Suu))>0) - { - if (Dstr=="") Hk<-substring(Houkou,J-1,J-1) - Dstr<-paste(Dstr,Tmp,sep="") - } - else - { - if (Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI - if (Hk=="n") Y<-Y+D - if (Hk=="s") Y<-Y-D - if (Hk=="e") X<-X+D - if (Hk=="w") X<-X-D - Dstr<-"" - } - } - J<-J+1 - } - if (Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI; - if (Hk=="n") Y<-Y+D - if (Hk=="s") Y<-Y-D - if (Hk=="e") X<-X+D - if (Hk=="w") X<-X-D - } - CalcWidth(Hoko,Mojiretu) - CalcHeight(Hoko,Mojiretu) - cat("\\put(",file=Wfile,append=TRUE) - Tmp1<- sprintf("%7.7f",X) # 11.07.19 - Tmp2<- sprintf("%7.7f",Y) # 11.07.19 - Str<-paste(Tmp1,",",Tmp2,sep="") - cat(Str,file=Wfile,append=TRUE) - Tmp<-"){\\hspace*{\\Width}" - Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) - } -} - -########################################## - -Exprrot<- function(...) -{ - varargin<- list(...) - P<- varargin[[1]] - V<- varargin[[2]]; N<- 3 - P<- Doscaling(P) - V<- Doscaling(V) - Tmov<- 0 - Tmp<- varargin[[N]] - if (mode(Tmp)=="numeric"){ - Tmov<- Tmp; N<- N+1 - } - Nmov<- 0 - Tmp<- varargin[[N]] - if (mode(Tmp)=="numeric"){ - Nmov<- Tmp; N<- N+1 - } - Mojiretu<- paste("$",Assign(varargin[[N]]),"$",sep="") # 2017.11.26 - Tv<- 1/Norm(V)*V - Nv<- c(-Tv[2],Tv[1]) - P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv - Tmp<- acos(V[1]/Norm(V)) - Theta<- round(Tmp*180/pi) - if (V[2]>=0){ - Units<- "" - } - else{ - Units<- "units=-360," - } - Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") - Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") - Letter(P,"c",Tmp) -} - -###################################################### - -Findcell<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - Ag<- varargin[[2]] - Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" - if (mode(Ag)=="character"){ - Clm<- c() - Rstr<- "" - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,I,I) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - Tmp1<- nchar(Tmp[1]) - Clm<- c(Clm,Tmp1) - } - else{ - Rstr<- paste(Rstr,C,sep="") - } - } - Nrg<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length(Clm)-I - Nrg<- Nrg+Tmp*26^Tmp1 - } - Mrg<- eval(parse(text=Rstr)) - if (Nargs>=3){ - Ag<- varargin[[3]] - Clm<- c() - Rstr<- "" - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,1,1) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - if (length(Tmp)>1){ - Clm<- c(Clm,Tmp+1) - } - else{ - Rstr<- paste(Rstr,C,sep="") - } - } - Nrg2<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length[Clm]-I - Nrg2<- Nrg2+Tmp*26^Tmp1 - } - Nrg<- c(Nrg,Nrg2) - Tmp=eval(parse(text=Rstr)) - Mrg<- c(Mrg,Tmp) - } - } - else{ - Nrg<- varargin[[2]] - Mrg<- varargin[[3]] - } - if (length(Mrg)==1){ - m1<- Mrg; m2<- m1+1 - } - else{ - m1<- Mrg[1]; m2<- Mrg[2] # 10.12.12 - } - if (length(Nrg)==1){ - n1<- Nrg; n2<- n1+1 - } - else{ - n1<- Nrg[1]; n2<- Nrg[2] - } - n1<- n1+1; n2<- n2+1 - m1<- m1+1; m2<- m2+1 - Hind<- TbL[[2]] - Vind<- TbL[[3]] - Tmp<- TbL[[1]] - HL<- Tmp[Hind] - Tmp1<- Op(1,TbL[[4]]) - Tmp2<- Op(2,TbL[[4]]) - HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) - VL<- Tmp[Vind] - Tmp1<- Op(1,TbL[[5]]) - Tmp2<- Op(2,TbL[[5]]) - VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) - Tmp<- TbL[[6]] - Tmp1<- Listplot(c(Ptsw(Tmp),Ptnw(Tmp))) - Tmp2<- Listplot(c(Ptse(Tmp),Ptne(Tmp))) - HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) - Tmp1<- Listplot(c(Ptnw(Tmp),Ptne(Tmp))) - Tmp2<- Listplot(c(Ptsw(Tmp),Ptse(Tmp))) - VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) - Tmp<- HL[[n1]] - if (mode(Tmp)=="numeric"){ - H1<- Tmp[1,1] - } - else{ - Tmp1<- Tmp[[1]] - H1<- Tmp1[1,1] - } - Tmp<- HL[[n2]] - if (mode(Tmp)=="numeric"){ - H2<- Tmp[1,1] - } - else{ - Tmp1<- Tmp[[1]] - H2<- Tmp1[1,1] - } - Tmp<- VL[[m1]] - if (mode(Tmp)=="numeric"){ - V1<- Tmp[1,2] - } - else{ - Tmp1<- Tmp[[1]] - V1<- Tmp1[1,2] - } - Tmp<- VL[[m2]] - if (mode(Tmp)=="numeric"){ - V2<- Tmp[1,2] - } - else{ - Tmp1<- Tmp[[1]] - V2<- Tmp1[1,2] - } - Pt<- c((H1+H2)/2,(V1+V2)/2) - High<- (V1-V2)/2 - Wide<- (H2-H1)/2 - Out<- list(Pt,Wide,High) - return(Out) -} - -############################################ - -Flattenlist<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Out<- list() - for(N in Looprange(1,Nargs)){ - D<- varargin[[N]] - if(is.data.frame(D) || !is.list(D)){ # modify - Out<- c(Out,list(D)) - } - else{ - for(I in Looprange(1,length(D))){ - Ds<- D[[I]] - Tmp<- Flattenlist(Ds) - Out<- c(Out,Tmp) - } - } - } - return(Out) -} - -############################################ - -Fontsize<- function(Ookisa) -{ - Str<- "%" - S<- substr(Ookisa,1,1) - if (S=="n"){ - Str<- "\\normalsize%" - } - if (S=="s"){ - if (nchar(Ookisa)==1){ - Tmp<- "n" - } - else{ - Tmp<- substr(Ookisa,2,2) - } - if (Tmp=="s"){ - Str<- "\\scriptsize%" - } - else{ - Str<- "\\small%" - } - } - if (S=="f"){ - Str<- "\\footnotesize%" - } - if (S=="t"){ - Str<- "\\tiny%" - } - if (S=="l"){ - Str<- "\\large%" - } - if (S=="L"){ - if (nchar(Ookisa)==1){ - Tmp<- "a" - } - else{ - Tmp<- substr(Ookisa,2,2) - } - if (Tmp=="a"){ - Str<- "\\Large%" - } - else{ - Str<- "\\LARGE%" - } - } - if (S=="h"){ - Str<- "\\huge%" - } - if (S=="H"){ - Str<- "\\Huge%" - } - cat(Str,file=Wfile,append=TRUE) - cat("\n",file=Wfile,append=TRUE) -} - -########################################## - -Fracform<- function(...) -{ - varargin<- list(...) - Eps<- 10^(-10) - Nmax<- 1/Eps - Nargs<- length(varargin) - X<- varargin[[1]] - Nr<- Nrow(X) - X<- as.matrix(X,nrow=Nr) - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if (mode(Tmp)!="numeric"){ - next - } - if (Tmp>1){ - Nmax<- Tmp - } - else if (Tmp>0){ - Eps<- Tmp - } - } - Tmp<- rep("",length(X)) - Out<- matrix(Tmp,nrow=nrow(X)) - for (I in Looprange(1,nrow(X))){ - for (J in Looprange(1,ncol(X))){ - Dt<- X[I,J] - if (mode(Dt)=="character"){ - Dt<- eval(parse(text=Dt)) - } - R<- 1 - N<- 0 - Rmin<- R - Nr<- N - while (R>Eps && N0) - { - Tmp<- Mixjoin(ShaL, list(Sha)) - ShaL <- Tmp - Sha<- Makeshasen(PtnL,PA+I*Kankaku*Vm,V,Bdy) - I <- I+1 - } - Sha<- Makeshasen(PtnL,PA-Kankaku*Vm,V,Bdy) - I<- 2 - while (length(Sha)>0) - { - for (J in 1:length(Sha)) - { - Tmp<- Mixjoin(ShaL,list(Sha[[J]])) - ShaL<- Tmp - } - Sha<- Makeshasen(PtnL,PA-I*Kankaku*Vm,V,Bdy) - I<- I+1 - } - } - else - { - Delta<- c(Xmn,Ymn)-StartP - K1<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymn)-StartP - K2<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmx,Ymx)-StartP - K3<- trunc(Dotprod(Delta,Vm)/Kankaku) - Delta<- c(Xmn,Ymx)-StartP - K4<- trunc(Dotprod(Delta,Vm)/Kankaku) - IM<- max(K1,K2,K3,K4) - Im<- min(K1,K2,K3,K4) - for (I in Im:IM) - { - Sha<- Makeshasen(PtnL,StartP+I*Kankaku*Vm,V,Bdy) - for (J in Looprange(1,length(Sha))) - { - Tmp<- Mixjoin(ShaL, list(Sha[[J]])) - ShaL<- Tmp - } - } - } - ShaLs<-list() - for (I in Looprange(1,length(ShaL))) - { - Tmp<- ShaL[[I]] - Tmp1<- Unscaling(Tmp) - Tmp2<- Mixjoin(ShaLs, list(Tmp1)) - ShaLs<- Tmp2 - } - ShaL<- ShaLs - return(ShaL) -} - -###################################### - -Htickmark<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if (mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if (K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if (is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if (J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if (is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if (is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if (I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if (I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if (mode(Dt)=="numeric" && length(Dt)>1){ - if (length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt[1],Dt[2]) - next - } - if (mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if (length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt,GENTEN[2]) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X,Y+MARKLEN)) - Tmp2<- Unscaling(c(X,Y-MARKLEN)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if (Ndt==3){ - Tmp<-Unscaling(c(X,Y-MARKLEN)) - Expr(Tmp,"s",Moji) - } - if (Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("s",Houkou) - if (length(Tmp)>0){ - Tmp<-Unscaling(c(X,Y-MARKLEN)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X,Y+MARKLEN)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -############################################# -# 2013.08.07 - -Integrate<- function(Fs,Vs, Intv){ - if(is.function(Fs)){ - Fn<- Fs - } - else{ - Str<- paste("Fn<- function(",Vs, ") ", Fs, sep="") - eval(parse(text=Str)) - } - Tmp<- integrate(Fn, Intv[[1]], Intv[[2]]) - Out<- Tmp[[1]] - return(Out) -} - -############################################# - -Intersectcrvs<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - Eps<-10^(-4) - Tmp<-varargin[[Nargs]] - if (mode(Tmp)=="numeric" && length(Tmp)==1) - { - Eps<-Tmp - } - G1<-varargin[[1]] - if (mode(G1)=="numeric") - { - G1<-list(G1) - } - G2<-varargin[[2]] - if (mode(G2)=="numeric") - { - G2<-list(G2) - } - PL<-list() - for (N in 1:length(G1)) - { - for (M in 1:length(G2)) - { - KL<-IntersectcrvsPp(G1[[N]],G2[[M]],Eps) - for (I in Looprange(1,length(KL))) - { - Tmp<-KL[[I]] - P<-Tmp[1] - PL<-append(PL,P) - } - } - } - return(PL) -} - -########################################### - -IntersectcrvsPp<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - G1<-varargin[[1]]; G2<-varargin[[2]] - Eps<- 10.0^(-4) - if (Nargs>2) Eps<-varargin[[3]] - SqEps<- 10.0^(-10) - Eps2<- 0.1 - if (Nargs>3) Eps2<-varargin[[4]] - Data1<-G1 - Data2<-G2 - if (Nrow(Data1)==Nrow(Data2)) - { - Tmp<-seq(Nrow(Data2),1, by=-1) - Tmp1<-Data2[Tmp,] - Eps0<-10^(-6) - Tmp2<-Norm(Data1-Data2) - Tmp3<-Norm(Data1-Tmp1) - if (Tmp20) - { - Tmp<-KL1[[1]] - P<-Tmp[[1]] - T<-Tmp[[2]] - I<-Tmp[[3]] - J<-Tmp[[4]] - Tmp<-list(P,I+T,J) - KL<-list(Tmp) - } - for (N in Looprange(2,length(KL1))) - { - Tmp<-KL1[[N]] - P<-Tmp[[1]] - Flg<-0 - for (K in 1:length(KL)) - { - if (1>length(KL)) break - Tmp<-KL[[K]] - if (Norm(P-Tmp[[1]])^20){ # 13.12.20 - Tmp1<- varargin[[Nall-1]] - if (is.numeric(Tmp1) && length(Tmp1)==1 && Tmp1>0){ # 13.12.20 - Sen<- Tmp1; Gap<- Tmp - Nall<- Nall-2 - } - else{ - Sen<- Tmp; Gap<- Sen - Nall<- Nall-1 - } - } - Sen<- 1000/2.54/MilliIn*Sen - Gap<- 1000/2.54/MilliIn*Gap - for (N in Looprange(1,Nall)){ - Figdata<- varargin[[N]] - Makehasen(Figdata,Sen,Gap,1) - } -} - -######################################### - -Invert<- function(Pd) -{ - OutL=Pd[nrow(Pd):1,] - return(OutL) -} - -############################################ - -InWindow<-function(PA) -{ - Eps<-10.0^(-6); - if((length(PA)==2)&(is.numeric(PA))){ # 17.11.20 - X<-PA[1]; Y<-PA[2]; - if (X>XMIN-Eps && XYMIN-Eps && YEps){ - PtL<- Appendrow(PtL,Qd) - } - else{ - if(is.null(nrow(Qd))){ Qd<- as.matrix(Qd,nrow=1)} - PtL<- Appendrow(PtL,Qd[2:nrow(Qd),]) # 11.06.25 - } - } - return(PtL) -} - -######################################## -# 2011.11.02 - -Joingraphics<- function(...) -{ - varargin<- list(...) - Ls<- Flattenlist(varargin) - N<- length(Ls) - Tp<- Ls[[N]] - Listflg<- 0 - if ( is.character(Tp)){ - Tmp<- toupper(substr(Tp,1,1)) - if(Tmp=="L"){ - Listflg<- 1 - } - N<- N-1 - Ls<- Ls[1:N] - } - if(Listflg==1){ - P<- Ls - } - else{ - P<- c() - for (I in 1:N){ - Tmp<- Ls[[I]] - P<- Appendrow(P,c(Inf,Inf)) - P<- Appendrow(P,Tmp) - } - P<- P[2:nrow(P),] - } - return(P) -} - -######################################## - -Kouten<- function(PA,V,P,Q) -{ - Eps<- 10.0^(-6) - A1<- PA[1]; A2<- PA[2] - V1<- V[1]; V2<- V[2] - P1<- P[1]; P2<- P[2] - U1<- Q[1]-P1; U2<- Q[2]-P2 - Tmp<- Norm(P-Q)*Norm(V) - if (Tmp==0) - { - Out<- list(Inf,-Inf) - return(Out) - } - D<- U1*V2-U2*V1 - if (abs(D)/Tmp1+Eps || S=5) - { - Eps<-varargin[[5]] - } - Eps2 <- 0.2 - if (Nargs>=6) - { - Eps2<-varargin[[6]] - } - Eps<-min(Eps2,Eps/sqrt(Sv2)) - P1<-(P[1]*V[1]+P[2]*V[2])/Sv2 - P2<-(-P[1]*V[2]+P[2]*V[1])/Sv2 - Q1<-(Q[1]*V[1]+Q[2]*V[2])/Sv2 - Q2<-(-Q[1]*V[2]+Q[2]*V[1])/Sv2 - m1 <- -Eps; M1 <- 1+Eps - m2 <- -Eps; M2 <- Eps - if (max(P1,Q1)M1) - { - Out<-Inf - return(Out) - } - if (max(P2,Q2)M2) - { - Out<-Inf - return(Out) - } - if (P2*Q2<0) - { - T<- P1-(Q1-P1)/(Q2-P2)*P2 - if (T>m1 && T -Eps0 && T<1+Eps0) - { - Tmp1<-A+T*V - Tmp2<-min(max(T,0),1) - Out<-list(Tmp1,Tmp2,0) - } - else - { - Tmp1<-A+T*V - Tmp2<-min(max(T,0),1) - Out<-list(Tmp1,Tmp2,1) - } - return(Out) - } - if (P1M1 || P2M2) - { - if (Q1M1 || Q2M2) - { - Out<-Inf - return(Out) - } - T<-min(max(Q1,0),1) - Tmp=A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - T<-min(max(P1,0),1) - Tmp<-A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - if (P1> -Eps0 && P1<1+Eps0 && P2> -Eps0 && P2 < Eps0) - { - T<- P1 - Tmp<- A+T*V - Out<- list(Tmp, T, 0) - return(Out) - } - if (Q1> -Eps0 && Q1<1+Eps0 && Q2> -Eps0 && Q2M1 || P2M2) - { - if (Q1M1 || Q2M2) - { - Out<-Inf - return(Out) - } - T<-min(max(Q1,0),1) - Tmp<-A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - if (Q1M1 || Q2M2) - { - T<-min(max(P1,0),1) - Tmp<-A+T*V - Out<-list(Tmp,T,1) - return(Out) - } - if (abs(P2)Eps) - { - QL<-Pt1 - } - Tmp<-Appendrow(QL,PL[(N1+1):N2,]) - QL<- Tmp - if (Norm(Pt2-Op(N2,PL))>Eps) - { - Tmp<-Appendrow(QL,Pt2) - QL<- Tmp - } - HidariL<- QL - Ms<- M2+1; Me<- M1 - if (T1Eps) - { - Tmp<-Append(HidariL,P) - HidariL<-Tmp - } - } - Tmp<- Op(Nrow(HidariL),HidariL) - if (Norm(Tmp-Pt1)>Eps) - { - Tmp<-Append(HidariL,Pt1) - HidariL<-Tmp - } - MigiL<- QL - Ms<- M2; Me<- M1+1 - if (T1>T2-Eps) Me<- Me-4 - for (Mm in Looprange(Me,Ms)) - { - M<- Me+Ms-Mm - Tmp<- Op(Nrow(MigiL),MigiL) - P<- Op(((M-1) %% 4)+1,Sikaku) - if (Norm(Tmp-P)>Eps) - { - Tmp<-Appendrow(MigiL,P) - MigiL<-Tmp - } - } - Tmp<- Op(Nrow(MigiL),MigiL) - if (Norm(Tmp-Pt1)>Eps) - { - Tmp<-Appendrow(MigiL,Pt1) - MigiL<-Tmp - } - Out<- list(HidariL,MigiL) - return(Out) -} - -################################### -# 17.09.24 Eps - -Kyoukai<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps0<- 10^(-7) - DataL<-list() - for (I in 1:Nargs){ - Tmp<- varargin[[I]] - if (mode(Tmp)=="numeric"){ - DataL<- Mixjoin(DataL,list(list(Tmp))) - } - if (mode(Tmp)=="list"){ - if (mode(Tmp[[1]])!="list"){ - DataL<- Mixjoin(DataL, list(Tmp)) - } - else{ - DataL<-Mixjoin(DataL,Tmp) - } - } - } - Eps<- 10.0^(-4) #17.09.24 - PLall<- list() - Sflg<- 0 - N<- length(DataL) - for (I in 1:N){ - Data<- Op(I, DataL) - Tmp<- Op(length(Data),Data) - if (mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ - Rg<-Tmp ; Nd<-length(Data)-1 - } - else{ - if (mode(Tmp)=="character"){ - Rg<- Tmp ; Nd<-length(Data)-1 - } - else{ - Rg<- "c" ; Nd<-length(Data) - } - } - for (J in Looprange(1,Nd)){ - Tmp<- Op(J,Data) - if (mode(Tmp)=="character"){ - Rg<- Tmp - next - } - Points<- Tmp - P1<- Ptstart(Points) - P2<- Ptend(Points) - if (J==1){ - PL<- Points - Pfirst<- P1 - Plast<- P2 - if (Nd>=2){ - Tmp<- Data[[2]] - P<- Ptstart(Tmp) - Q<- Ptend(Tmp) - if (Norm(P2-P)>Eps && Norm(P2-Q)>Eps){ - Tmp< Nrow(PL) - PL<-PL[Tmp:1,] - Pfirst<- Ptstart(PL) - Plast<- Ptend(PL) - } - } - } - else{ - if (Norm(P1-Plast)Eps){ - Np<- Nrow(PL) - if (Rg=="c"){ - Tmp<- Appendrow(PL,Pfirst) - PL<- Tmp - } - else if (Rg=="s"){ - Tmp<- c(PL[1:Np,2],YMIN) - Y<- min(Tmp)-1 - P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) - Tmp<- Appendrow(PL,P,Q,Pfirst) - PL<- Tmp - } - else if (Rg=="n"){ - Tmp<- c(PL[1:Np,2],YMAX) - Y<-max(Tmp)+1 - P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) - Tmp<- Appendrow(PL,P,Q,Pfirst) - PL<- Tmp - } - else if (Rg=="w"){ - Tmp<- c(PL[1:Np,1],XMIN) - X<- min(Tmp)-1 - P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) - Tmp<- Appendrow(PL,P,Q,Pfirst) - PL<- Tmp - } - else if (Rg=="e"){ - Tmp<- c(PL[1:Np,1],XMAX) - X<- max(Tmp)+1 - P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) - Tmp<- Appendrow(PL,P,Q,Pfirst) - PL<- Tmp - } - else if (mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){ - Tmp<- Kukeiwake(PL) - Tmp1<- Op(1,Tmp) - Tmp2<- Naigai(Rg,list(Tmp1)) - if (Tmp2==c(1)){ - PL<-Op(1,Tmp) - } - else{ - PL<- Op(2,Tmp) - } - } - } - Tmp<- Ptstart(PL) - for (J in 2:Nrow(PL)){ - P<- Op(J,PL) - Q<- Op(Nrow(Tmp),Tmp) - if (Norm(P-Q)>Eps){ - Tmp1<-Appendrow(Tmp,P) - Tmp<-Tmp1 - } - } - PL<-Tmp - PLall<-Mixjoin(PLall,list(PL)) - } - if (length(PLall)==1 && Sflg==0){ - Tmp<- Op(1,PLall) -# Tmp<- Op(1,Tmp) - if (Norm(Ptstart(Tmp)-Ptend(Tmp))>Eps0){ - Tmp1<- Appendrow(Tmp,Ptstart(Tmp)) - PLall<- list(Tmp1) - } - } - return(PLall) -} - -###################################### - -Letter<-function(...) -{ ## Scaling is implemented - varargin<-list(...) - Nargs<-length(varargin) - Irng<-c(seq(from=1,to=Nargs,by=3)) - for (I in Irng) - { - Tmp<-varargin[[I]] - P<- Doscaling(Tmp) - X<-P[1] - Y<-P[2] - Houkou<-varargin[[I+1]] - Mojiretu<-varargin[[I+2]] - Hset<-Houkou - Vhoko<-"c" - if (length(grep("n",Hset))>0) - { - Vhoko<-"n"; Y<-Y+MEMORI - } - if (length(grep("s",Hset))>0) - { - Vhoko<-"s"; Y<-Y-MEMORI - } - Hhoko<-"c" - if (length(grep("e",Hset))>0) - { - Hhoko<-"e"; X<-X+MEMORI - } - if (length(grep("w",Hset))>0) - { - Hhoko<-"w"; X<-X-MEMORI - } - Hoko<-paste(Vhoko,Hhoko,sep="") - Suu<-"+-.0123456789" - SuuL<-Suu - J<-1; Dstr<-"" - while (J<=nchar(Houkou)) - { - Tmp<-substring(Houkou,J,J) - if (length(grep(Tmp,SuuL))>0) - { - if (Dstr=="") Hk<-substring(Houkou,J-1,J-1) - Dstr<-paste(Dstr,Tmp,sep="") - } - else - { - if (Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI - if (Hk=="n") Y<-Y+D - if (Hk=="s") Y<-Y-D - if (Hk=="e") X<-X+D - if (Hk=="w") X<-X-D - Dstr<-"" - } - } - J<-J+1 - } - if (Dstr!="") - { - Nmbr<-as.numeric(Dstr) - D<-Nmbr*MEMORI; - if (Hk=="n") Y<-Y+D - if (Hk=="s") Y<-Y-D - if (Hk=="e") X<-X+D - if (Hk=="w") X<-X-D - } - CalcWidth(Hoko,Mojiretu) - CalcHeight(Hoko,Mojiretu) - cat("\\put(",file=Wfile,append=TRUE) - Tmp1<- sprintf("%7.7f",X) # 11.07.19 - Tmp2<- sprintf("%7.7f",Y) # 11.07.19 - Str<-paste(Tmp1,",",Tmp2,sep="") - cat(Str,file=Wfile,append=TRUE) - Tmp<-"){\\hspace*{\\Width}" - Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) - } -} - -###################################################### - -Letterrot<- function(...) -{ - varargin<- list(...) - P<- varargin[[1]] - V<- varargin[[2]]; N<- 3 - P<- Doscaling(P) - V<- Doscaling(V) - Tmov<- 0 - Tmp<- varargin[[N]] - if (mode(Tmp)=="numeric"){ - Tmov<- Tmp; N<- N+1 - } - Nmov<- 0 - Tmp<- varargin[[N]] - if (mode(Tmp)=="numeric"){ - Nmov<- Tmp; N<- N+1 - } - Mojiretu<- Assign(varargin[[N]]) #2017.11.26 - Tv<- 1/Norm(V)*V - Nv<- c(-Tv[2],Tv[1]) - P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv - Tmp<- acos(V[1]/Norm(V)) - Theta<- round(Tmp*180/pi) - if (V[2]>=0){ - Units<- "" - } - else{ - Units<- "units=-360," - } - Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") - Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") - Letter(P,"c",Tmp) -} - -################################### -# 10.12.04 - -Lineplot<-function(...) -{ - varargin <- list(...) - Nargs<-length(varargin) - A<-varargin[[1]] - if (is.numeric(A)) { - Tmp<-length(A) - if (Tmp>3) { - B <- A[(Tmp/2+1):Tmp] - A <- A[1:(Tmp/2)] - Is <- 2 - } - else { - B<-varargin[[2]] - Is <- 3 - } - } - else { - B<-A[[2]] - A<-A[[1]] - Is <- 2 - } - Mag <- 100 ; Semi <- "" ## 10.12.04 - for (I in Looprange(Is,Nargs)) { - Tmp <- varargin[[I]] - switch ( mode(Tmp), - "numeric"= Mag <- Tmp, - "character"= Semi <- Tmp - ) - } -V<- Mag/Norm(B-A)*(B-A) ## 10.12.04 from here - if (Semi=="") { - Out<- Listplot(c(A-V,A+V)) - } - else if (Semi=="+") { - Out<- Listplot(c(A,A+V)) - } - else { - Out<- Listplot(c(A-V,A)) - } ## 10.12.04 to here - return(Out) -} - -################################ - -Listplot<-function(...) -{ - varargin<-list(...); - Z<-c(); - for (I in 1:length(varargin)) - { - Data<-varargin[[I]]; - if (mode(Data)=="numeric") - { - if (class(Data)=="numeric") - { - Tmp<-matrix(Data,nrow=2); - Tmp<-t(Tmp); - Z<-Appendrow(Z,Tmp) - } - else - Z<-Appendrow(Z,Data) - } - else - { - for (J in 1:length(Data)) - { - Tmp<-Data[[J]]; - Z<-Appendrow(Z,Tmp) - } - } - } - return(Z) -} - -############################## - -MakeBowdata <- function(PA,PB,H) -{ - Eps <- 10^(-5) - BOWSTART <<- PA - BOWEND <<- PB - D <- 1/2*Norm(PB-PA) - R <- (H^2+D^2)/(2*H) - A1 <- PA[1]; A2<-PA[2] - B1 <- PB[1]; B2<-PB[2] - if (abs(A2-B2)>Eps){ -# x <- poly(0,"X") -# y <- -(A1-B1)*x/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) -# Eq1 <- (A1-x)^2+(A2-y)^2-R^2 -# Tmp <- coeff(Eq1) -# C0 <- Tmp[1]; C1<-Tm[2]; C2<-Tmp[3] - C0<- A1^2+(A2-(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2))^2-R^2 - C1<- -(A1+B1)*(A2^2+B2^2-2*A2*B2-2*A1*B1+A1^2+B1^2)/(A2-B2)^2 - C2<- 1+(A1-B1)^2/(A2-B2)^2 - Det <- sqrt(C1^2-4*C0*C2) - Ansx1 <- (-C1+Det)/(2*C2) - Ansx2 <- (-C1-Det)/(2*C2) - Tmp <- -(A1-B1)*Ansx1/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) - PC <- c(Ansx1,Tmp) - Tmp <--(A1-B1)*Ansx2/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) - PC2 <- c(Ansx2,Tmp) - } - else{ - Tmp <- 0.5*(PA+PB) - PC <- Tmp+c(0,R-H) # 11.06.02 - PC2 <- Tmp-c(0,R-H) - } - VA <- PA-PC - VB <- PB-PC - if (VA[1]*VB[2]-VA[2]*VB[1]<0) { - PC <- PC2 - } - AngA <- acos((PA[1]-PC[1])/R) - if (PA[2]-PC[2]<0){ - AngA <- -AngA - } - AngB <- acos((PB[1]-PC[1])/R) - if (PB[2]-PC[2]<0){ - AngB <- -AngB - } - if (AngA>AngB) { - AngB <- AngB+2*pi - } - Out <- list(PC,R,AngA,AngB) - return(Out) -} - -#################################################### - -MakeCurves<-function(...){ ## Scaling is implemented - varargin<-list(...) - Figdata<-varargin[[1]] - if (class(Figdata)=="numeric"){ - Figdata<-matrix(Figdata,nrow=1) - } - Ptout<-1 - if (length(varargin)>=2) Ptout<-varargin[[2]] - Eps<-10.0^(-6) - IndM<-Dataindex(Figdata) - Atos<-c() - for (Nd in 1:Nrow(IndM)){ - Tmp<-IndM[Nd,] - Motos<-Figdata[Tmp[1]:Tmp[2],] - All<-Nrow(Motos) - if (Nrow(Motos)==1){ - if (InWindow(Motos)=="o"){ - next - } - Tmp1<- as.numeric(Motos) - if (Ptout==1){ - Drwpt(Tmp1) - } - else{ - Tmp1<- Doscaling(Tmp1) - Atos<-Appendrow(Atos,c(Inf,Inf),Tmp1) - next - } - } - Crv<-c() - for (I in Looprange(2,All)){ - P<- Op(I-1,Motos) - Q<- Op(I,Motos) - Snbn<-MeetWindow(P,Q) - if (length(Snbn)==0){ - if (length(Crv)>0){ - Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) - Crv<-c() - } - } - else{ - if(Norm(Snbn[1,]-Snbn[2,])=2) - { - Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) - } - } - Outdata<-Atos[2:Nrow(Atos),] - if (class(Outdata)=="numeric") - { - Outdata<-matrix(Outdata,nrow=1) - } - return(Outdata) -} - -###################################### - -Makehasen<- function(Figdata,Sen,Gap,Ptn) -{ - Eps<- 10.0^(-6) - Clist<- MakeCurves(Figdata) - DinM<- Dataindex(Clist) - for (N in Looprange(1,Nrow(DinM))){ - Tmp<- DinM[N,] - Data<- Clist[Tmp[1]:Tmp[2],] - Dtall<- Nrow(Data) - Len<- 0 - Lenlist<- c(0) - for (I in Looprange(2,Dtall)){ - Len<- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist<- c(Lenlist,Len) - } - Lenall<- Lenlist[Dtall] - if (Lenall==0){ - next - } - Kari<- (Sen+Gap)*0.1 - Naga<- Sen*0.1 - Tobi<- Gap*0.1 - if (Norm(Data[1,]-Data[Dtall,])=Lenlist[J]-Eps){ - if (J==Dtall){ - break - } - J<- J+1 - } - Hajime<- J-1 - J<- Hajime - while (Len+Naga>Lenlist[J]-Eps){ - if (J==Dtall){ - break - } - J<- J+1 - } - Owari<- J-1 - T<- (Len-Lenlist[Hajime]) - T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) - P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - for (J in Looprange(Hajime+1,Owari)){ - P<- Data[J,] - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str<- paste("\\special{pa ",X," ",Y,"}",sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - } - T<- (Len+Naga-Lenlist[Owari]) - T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) - P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) - X<- as.character(round(MilliIn*P[1])) - Y<- as.character(-round(MilliIn*P[2])) - Str1<- paste("\\special{pa ",X," ",Y,"}",sep="") - Str2<- "\\special{fp}" - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str1)+nchar(Str2) - if (Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - } - cat("%\n%\n",file=Wfile,append=TRUE); -} - -###################################### - -Makeliststr<- function(L) -{ - Out="list(" - for (I in 1:length(L)){ - Dt<- L[[I]] - if (mode(Dt)=="numeric"){ - if (length(Dt)==1){ - Dts<- as.character(Dt) - } - else{ - Dts<- "c(" - for (J in Looprange(1,Nrow(Dt))){ - for (K in 1:ncol(Dt)){ - Dts<- paste(Dts,as.character(Dt[J,K]),sep="") - if (K< ncol(Dt)){ - Dts<- paste(Dts,",",sep="") - } - } - if (JEps){ - if (Member(Ptn,PtnL)){ - if (abs(Te-Ts)>Eps){ - if (Nrow(GL)>0){ - Tmp<- Mixjoin(Out, list(GL)) - Out<- Tmp - } - GL<- Listplot(P,Q) - } - else{ - Tmp <- Appendrow(GL, Q) - GL<- Tmp - } - Te<- Op(1,TenQ) - } - } - } - if (Nrow(GL)>0){ - Tmp<- Mixjoin(Out, list(GL)) - Out<- Tmp - } - return(Out) -} - -############################################# - -Mawarikomi<- function(...) -{ - varargin<- list(...) - haba<- "10cm" - Nargs<- length(varargin) - if (Nargs>0){ - haba<- varargin[[1]] - } - cat("\\begin{mawarikomi}%\n",file="",append=TRUE) - cat("%<1>[5](0,0)%\n",file="",append=TRUE) - Str<- paste("{",haba,"}{%\n",sep="") - cat(Str,file="",append=TRUE) - cat("}%\n",file="",append=TRUE) - cat("\\end{mawarikomi}",file="",append=TRUE) -} - -############################################## - -MeetWindow<-function(PA,PB) -{ - if (InWindow(PA)=="i" && InWindow(PB)=="i") - { - R<-Appendrow(PA,PB) - return(R) - }; - Horner<-function(n,t) - { - PT<-(1-t)*PA+t*PB; - return(PT[n]) - } - Eps<-10.0^(-6); - Txm<-(-1); TxM<-(-1); Tym<-(-1); TyM<-(-1); - if (PA[1]!=PB[1]) - { - Txm<-(XMIN-PA[1])/(PB[1]-PA[1]); - TxM<-(XMAX-PA[1])/(PB[1]-PA[1]); - } - if (PA[2]!=PB[2]) - { - Tym<-(YMIN-PA[2])/(PB[2]-PA[2]); - TyM<-(YMAX-PA[2])/(PB[2]-PA[2]); - } - Tmp<-Horner(2,Txm); - if (TmpYMAX+Eps) - { - Txm<-(-1); - } - Tmp<-Horner(2,TxM); - if (TmpYMAX+Eps) - { - TxM<-(-1) - } - Tmp<-Horner(1,Tym); - if (TmpXMAX+Eps) - { - Tym<--1 - } - Tmp<-Horner(1,TyM); - if (TmpXMAX+Eps) - { - TyM<--1 - } - Tans<-sort(c(Txm,TxM,Tym,TyM)); - Tmp<-c(); - for (I in 1:length(Tans)) - { - Tmp1<-Tans[I]; - if (Tmp1>-Eps && Tmp1<1+Eps) - { - if (length(Tmp)==0) - { - Tmp<-c(Tmp1); - } - else - { - if (abs(Tmp[length(Tmp)]-Tmp1)>Eps) - { - Tmp<-c(Tmp,Tmp1) - } - } - } - } - Tans<-Tmp; - if (length(Tans)==0) - { - R<-c(); - return(R); - } - if (length(Tans)==1) - { - Ten1<-Horner(1:2,Tans[1]); - if (InWindow(PA)=="i") - { - R<-Appendrow(PA,Ten1) - return(R) - } - else - { - R<-Appendrow(Ten1,PB) - return(R) - } - } - Ten1<-Horner(1:2,Tans[1]) - Ten2<-Horner(1:2,Tans[2]) - R<-Appendrow(Ten1,Ten2) - return(R) -} - -######################################### - -# New 10.03.21 - -Mixjoin<-function(...) -{ - varargin<-list(...) - Nargs<- length(varargin) - M<- list() - for (I in 1:Nargs) - { - Tmp<-varargin[[I]] - if (length(Tmp)==0) next - if (Mixtype(Tmp)==1) - { - Tmp<-list(Tmp) - } - if (length(M)==0){ - M <- Tmp - } - else{ - M<- c(M,Tmp) - } - } - return(M) -} - -################################# - -Mixlength<- function(PL){ - if (length(PL)==0){ - return(0) - } - if (Mixtype(PL)==1){ - Out<- Nrow(PL) - } - else{ - Out<- length(PL) - } - return(Out) -} - -########################################### - -Mixtype<- function(D) -{ - if (mode(D)!="list") return(1) - for (I in 1:length(D)) - { - Tmp<- D[[I]] - if (mode(Tmp)=="list") return(3) - } - return(2) -} - -########################################### - -Naigai<- function(A,Bdy) -{ - V<- c(1,1) - Call<-length(Bdy) - KL<- KoutenList(A,V,Bdy) - Ptn<- seq(1,1,length=Call) - for (K in Looprange(1,length(KL))) - { - Ten<- Op(K,KL) - T<- Op(1,Ten); NC<- Op(4,Ten) - if (T<0) - { - Tmp<- (Ptn[NC]+1) %% 2 - Ptn[NC]<- Tmp - } - } - return(Ptn) -} - -######################################## - -Nearestpt<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - PL1<- varargin[[1]] - if (!is.matrix(PL1)){ - Tmp<- matrix(PL1); - PL1<- t(Tmp) - } - if (Nrow(PL1)==1) Flg=0 - else Flg=1 - Eps<- 10.0^(-6) - PL<- varargin[[2]] - Ans<- list(PL1[1,],1,PL[1,],1,Norm(PL1[1,]-PL[1,])) - for(N in Looprange(1,Nrow(PL1))){ - PA<- PL1[N,] - Pm<- PL[1,] - Im<- 1 - Sm<- Norm(Pm-PA) - for(I in Looprange(1,Nrow(PL)-1)){ - A1<- PL[I,1]; A2<-PL[I,2] - B1<- PL[I+1,1]; B2<-PL[I+1,2] - V1<- B1-A1; V2<-B2-A2 - X1<- PA[1]; X2<-PA[2] - Tmp<-V2^2+V1^2 - if (abs(Tmp)1+Eps){ - P<- c(B1,B2) - }else{ - P<- c(A1+T*V1,A2+T*V2) - } - } - S<- Norm(P-PA) - if (SN){ - Posstr<- paste("[",varargin[[N+1]],"]",sep="") - } - else{ - Posstr<- "[c]" - } - Openphr(Namestr) - S<- paste("\\begin{minipage}",Posstr,"{",Habastr,"}%\n",sep="") - cat(S,file=Wfile,append=TRUE) -} - -################################### - -Openphr<- function(Str) -{ - S<- paste("\\def",Str,"{%\n",sep="") - cat(S,file=Wfile,append=TRUE) -} - -##################################### - -Ovalbox<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Pos<- varargin[[1]] - Dr<- varargin[[2]] - StrV<- varargin[[3]] - R<- 0.2 - NDflg<- 0 - for (I in Looprange(4,Nargs)){ - Tmp<- varargin[[I]] - if (mode(Tmp)=="numeric"){ - R<- Tmp - } - else{ - if (substr(Tmp,1,1)=="-"){ - NDflg<- 1 - Tmp1<- substr(Tmp,2,nchar(Tmp)) - Cmdstr<- chartr("*","G",Tmp1) - } - } - } - Xr<- c(XMIN,XMAX) - Yr<- c(YMIN,YMAX) - Uv<- 0.6; Uh<- 0.8 - N<- nchar(StrV) - W<- Uh;H<- Uv*N - Setwindow(c(-W/2,W/2),c(-H,0)) - G<- Ovaldata(c(0,-H/2),W/2,H/2,R) - Openphr("\\ketpictmp") - Beginpicture("1cm") - if (NDflg==0){ - Drwline(G) - } - else{ - eval(parse(text=Cmdstr)) - } - for (I in Looprange(1,N)){ - Letter(c(0,Uv/2-Uv*I),"c",Op(I,StrV)) - } - Endpicture(0) - Closephr() - Setwindow(Xr,Yr) - Letter(Pos,Dr,"\\ketpictmp") -} - -########################################## - -Ovaldata<- function(...) #17.09.11 -{ - varargin<- list(...) - Nargs<- length(varargin) - if (Nargs==1){ - Eps<- 1.0*10^(-4) - C<- c((XMIN+XMAX)/2,(YMIN+YMAX)/2) - Dx<- XMAX-C(1)-Eps - Dy<- YMAX-C(2)-Eps - N<- 1 - } - else{ - C<- varargin[[1]] - Dx<- varargin[[2]] - Dy<- varargin[[3]] - N<- 4 - } - Rc<- 0.2 - if (N<=Nargs){ #15.11.15 - Rc<- varargin[[N]]*Rc #15.11.15 - } - Out<- c() - P<- C+c(Dx-Rc,Dy-Rc) - Tmp1<- Circledata(c(P,Rc),"R=c(0,pi/2)","N=10") #17.11.29 - Tmp2<- Listplot(C+c(Dx-Rc,Dy),C+c(0,Dy)) - Tmp3<- Listplot(C+c(Dx,0),C+c(Dx,Dy-Rc)) - G<- Joincrvs(Tmp3,Tmp1,Tmp2) - Tmp<- Reflectdata(G,c(C,C+c(0,1))) - G<- Joincrvs(G,Tmp) - Tmp<- Reflectdata(G,c(C,C+c(1,0))) - Out<- Joincrvs(G,Tmp) -} - -######################################### - -Paramark<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - PA<- varargin[[1]] - PB<- varargin[[2]] - PC<- varargin[[3]] - R<- 0.5 - if (Nargs>=4){ - R<- varargin[[4]]*R - } - U<- R*(PA-PB)/Norm(PA-PB) - V<- R*(PC-PB)/Norm(PC-PB) - if (Crossprod(PA-PB,PC-PB)!=0){ - P<- Listplot(c(PB+U,PB+U+V,PB+V)) - } - else{ - P<- c() - } -} - -########################################### - -Paramoncrv<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - Eps<-10^(-8) - P<-varargin[[1]] - Gdata<-varargin[[Nargs]] - if (Nrow(P)>1) - { - Tmp<-P; P<-Gdata; Gdata<-Tmp - } - if (Nargs==2) - { - Tmp<-Nearestpt(P,Gdata) - Out<-Tmp[[2]] - return(Out) - } - N<-varargin[[2]] - PtL<-Gdata - if (N==Nrow(PtL)) - { - Out<-N - } - else - { - Pa<-Ptcrv(N,PtL) - Pb<-Ptcrv(N+1,PtL) - V<-Pb-Pa - W<-P-Pa - D2<-Norm(V)^2 - if (D20) - { - E<-sort(E) - E0 && Op(Nrow(P),P)!=c(Inf,Inf)) - { - Pa<- c(Inf,Inf) - } - } - if (t-E[Ke]>Eps) - { - if (Fnflg==0) - { - Tmp<- eval(parse(text=Str)) - Pa<- Tmp - } - else - { - } - Ke<-Ke+1 - } - if (length(Pa)>0) - { - if (Pa[1]==Inf) - { - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else - { - if (Nrow(P)==0) - { - Tmp<- Appendrow(P,Pa) - P<-Tmp - } - else - { - Tmp<- Op(Nrow(P),P) - if (Tmp[1]==Inf) - { - Tmp<- Appendrow(P,Pa) - P<- Tmp - } - else - { - if (Norm(Tmp-Pa)B+Eps){ - Npt<- Numptcrv(PkL) - Out1<- Partcrv(A,Npt,PkL) - Out2<- Partcrv(1,B,PkL) - Tmp<- Ptstart(PkL)-Ptend(PkL) - if (Norm(Tmp)Ie+Eps){ - P<- (1-B+Ie)*PkL[Ie,]+(B-Ie)*PkL[Ie+1,] - PL<- Appendrow(PL,P) - } - Ans<- PL - return(Ans) - } - Tmp<- Nearestpt(A,PkL) - Ta<- Op(2,Tmp) - Tmp<- Nearestpt(B,PkL) - Tb<- Op(2,Tmp) - Ans<- Partcrv(Ta,Tb,PkL) -} - -########################################## -# 13.05.03 - -Partframe<- function(Tb,St,Ed) -{ - G<- Dividetable(Tb) - Gw<- G[[1]] - Gt<- G[[2]] - Gy<- G[[3]] - Gwt<- Tb[[4]] - Gwy<- Tb[[5]] - Gat<- c(list(Gwt[[1]]),Gt,list(Gwt[[2]])) - Gay<- c(list(Gwy[[1]]),Gy,list(Gwy[[2]])) - Tmp1<- Ptstart(Gat[[St[1]]]) - Tmp2<- Ptstart(Gay[[St[2]]]) - Ps<- c(Tmp1[1],Tmp2[2]) - Tmp1<- Ptstart(Gat[[Ed[1]]]) - Tmp2<- Ptstart(Gay[[Ed[2]]]) - Pe<- c(Tmp1[1],Tmp2[2]) - Pars<- Paramoncrv(Ps,Gw) - Pare<- Paramoncrv(Pe,Gw) - if(Pars0){ - E<-sort(E) - E0){ - Tmp<-eval(parse(text=Exfun)) - if (abs(Tmp)0 && P[Nrow(P),]!=c(Inf,Inf)){ - Pa<- c(Inf,Inf) - } - } - if (x-E[Ke]>Eps){ - Tmp<- eval(parse(text=Str)) - Pa<- c(x,Tmp) - Ke<-Ke+1 - } - if (length(Pa)>0){ - if (Pa[1]==Inf){ - Tmp<-Appendrow(P,Pa) - P<-Tmp - } - else{ - if (Nrow(P)==0){ - Tmp<- Appendrow(P,Pa) - P<-Tmp - } - else{ - Tmp<- P[Nrow(P),] - if (Tmp[1]==Inf){ - Tmp<- Appendrow(P,Pa) - P<- Tmp - } - else{ - if (Norm(Tmp-Pa)1) - { - Tmp<-T; T<-Gdata; Gdata<-Tmp - } - PtL<-Gdata - N<-trunc(T+Eps); - S<-max(T-N,0); - if (N==Nrow(PtL)) - { - Out<-PtL[N,] - } - else - { - Pa<-PtL[N,] - Pb<-PtL[N+1,] - Out<-(1-S)*Pa+S*Pb - } - return(Out) -} - -############################################## -# 10.11.20 -# 13.05.03 Inf - -Pointdata<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - PL<- list() - for (I in Looprange(1,Nargs)){ # 10.11.20 - DL<-varargin[[I]] - DL<- Flattenlist(DL) # 10.11.20 from here - for (J in Looprange(1,length(DL))){ - Dt<- DL[[J]] - if(is.matrix(Dt)|| is.data.frame(Dt)){ - for (K in 1:nrow(Dt)){ - Tmp<- as.numeric(Dt[K,]) - if(Tmp[1]1){ - Tmp1<- nchar(Tmp[1]) - Clm<- c(Clm,Tmp1) - } - } - Nrg<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length(Clm)-I - Nrg<- Nrg+Tmp*26^Tmp1 - } - CoL<- Nrg - } - Nc<- length(TbL[[3]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if (I-3>Nc){ - break - } - Dt<- varargin[[I]] - if (mode(Dt)!="list"){ - Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- Dt[[N]] - Rrng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if (mode(Tmp)=="numeric"){ - Rrng<- c(K,K+Tmp) - } - if (mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,CoL,Rrng,Pos,Str) - K<- Crng[2] - } - } -} - -Putcol<- function(...) -{ - PutcoL(...) -} - -PutcoLexpr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if (mode(TbL)!="list"){ - return("Tabledata missing") - } - Ag<- varargin[[2]] - if (mode(Ag)=="numeric"){ - CoL<- Ag - } - else{ - Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" - Clm<- c() - for (I in Looprange(1,nchar(Ag))){ - C<- substr(Ag,I,I) - C<- toupper(C) - Tmp<- strsplit(Alpha,C) - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - Tmp1<- nchar(Tmp[1]) - Clm<- c(Clm,Tmp1) - } - } - Nrg<- 0 - for (I in seq(length(Clm),1,by=-1)){ - Tmp<- Clm[I] - Tmp1<- length(Clm)-I - Nrg<- Nrg+Tmp*26^Tmp1 - } - CoL<- Nrg - } - Nc<- length(TbL[[3]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if (I-3>Nc){ - break - } - Dt<- varargin[[I]] - if (mode(Dt)!="list"){ - Dt<- paste("$",Dt,"$",sep="") - Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- paste("$",Dt[[N]],"$",sep="") - Rrng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if (mode(Tmp)=="numeric"){ - Rrng<- c(K,K+Tmp) - } - if (mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,CoL,Rrng,Pos,Str) - K<- Crng[2] - } - } -} - -Putcolexpr<- function(...) -{ - PutcoLexpr(...) -} - -##################################################### - -PutcoLstr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Tb<- varargin[[1]] - Nr<- varargin[[2]] - Pos<- varargin[[3]] - Str<- varargin[[4]] - Sep<- "" - if (Nargs>4){ - Sep<- varargin[[5]] - } - if (nchar(Sep)==0){ - for (I in Looprange(1,nchar(Str))){ - Tmp<- substr(Str,I,I) - Putcell(Tb,Nr,I,Pos,Tmp) - } - } - else{ - Ltr<- "" - K<- 1 - for (I in Looprange(1,length(Str))){ - Tmp<- substr(Str,I,I) - if (Tmp==Sep){ - Putcell(Tb,Nr,K,Pos,Ltr) - K<- K+1 - Ltr<- "" - } - else{ - Ltr<- paste(Ltr,Tmp,sep="") - } - } - if (nchar(Ltr)>0){ - Putcell(Tb,Nr,K,Pos,Ltr) - } - } -} - -############################################# - -Putrow<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if (mode(TbL)!="list"){ - return("Tabledata missing") - } - Row<- varargin[[2]] - Nr<- length(TbL[[2]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if (I-3>Nr){ - break; - } - Dt<- varargin[[I]] - if (mode(Dt)!="list"){ - Putcell(TbL,K,Row,Dpos,Dt) # 110308 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- Dt[[N]] - Crng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if (mode(Tmp)=="numeric"){ - Crng<- c(K,K+Tmp) - } - if (mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,Crng,Row,Pos,Str) - K<- Crng[2] - } - } -} - -Putrowexpr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - TbL<- varargin[[1]] - if (mode(TbL)!="list"){ - return("Tabledata missing") - } - Row<- varargin[[2]] - Nr<- length(TbL[[2]])+1 - K<- 1 - Dpos<- varargin[[3]] - for (I in Looprange(4,Nargs)){ - if (I-3>Nr){ - break; - } - Dt<- varargin[[I]] - if (mode(Dt)!="list"){ - Dt<- paste("$",Dt,"$",sep="") - Putcell(TbL,K,Row,Dpos,Dt) #110308 - K<- K+1 - } - else{ - N<- length(Dt) - Str<- paste("$",Dt[[N]],"$",sep="") - Crng<- c(K,K+1) - Pos<- Dpos - for (J in Looprange(1,N-1)){ - Tmp<- Dt[[J]] - if (mode(Tmp)=="numeric"){ - Crng<- c(K,K+Tmp) - } - if (mode(Tmp)=="character"){ - Pos<- Tmp - } - } - Putcell(TbL,Crng,Row,Pos,Str) - K<- Crng[2] - } - } -} - -#################################################### - -Putrowstr<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Tb<- varargin[[1]] - Nr<- varargin[[2]] - Pos<- varargin[[3]] - Str<- varargin[[4]] - Sep<- "" - if (Nargs>4){ - Sep<- varargin[[5]] - } - if (nchar(Sep)==0){ - for (I in Looprange(1,nchar(Str))){ - Tmp<- substr(Str,I,I) - Putcell(Tb,I,Nr,Pos,Tmp) - } - } - else{ - Ltr<- "" - K<- 1 - for (I in Looprange(1,length(Str))){ - Tmp<- substr(Str,I,I) - if (Tmp==Sep){ - Putcell(Tb,K,Nr,Pos,Ltr) - K<- K+1 - Ltr<- "" - } - else{ - Ltr<- paste(Ltr,Tmp,sep="") - } - } - if (nchar(Ltr)>0){ - Putcell(Tb,K,Nr,Pos,Ltr) - } - } -} - -############################################ -# 11.05.28 - -Ratiocmyk<- function(Color) -{ - if(is.numeric(Color)){ - return(Color) - } - R<- - switch(Color, - greenyellow=c(0.15,0,0.69,0), - yellow=c(0,0,1,0), - goldenrod=c(0,0.1,0.84,0), - dandelion=c(0,0.29,0.84,0), - apricot=c(0,0.32,0.52,0), - peach=c(0,0.5,0.7,0), - melon=c(0,0.46,0.5,0), - yelloworange=c(0,0.42,1,0), - orange=c(0,0.61,0.87,0), - burntorange=c(0,0.51,1,0), - bittersweet=c(0,0.75,1,0.24), - redorange=c(0,0.77,0.87,0), - mahogany=c(0,0.85,0.87,0.35), - maroon=c(0,0.87,0.68,0.32), - brickred=c(0,0.89,0.94,0.28), - red=c(0,1,1,0), - orangered=c(0,1,0.5,0), - rubinered=c(0,1,0.13,0), - wildstrawberry=c(0,0.96,0.39,0), - salmon=c(0,0.53,0.38,0), - carnationpink=c(0,0.63,0,0), - magenta=c(0,1,0,0), - violetred=c(0,0.81,0,0), - rhodamine=c(0,0.82,0,0), - mulberry=c(0.34,0.9,0,0.02), - redviolet=c(0.07,0.9,0,0.34), - fuchsia=c(0.47,0.91,0,0.08), - lavender=c(0,0.48,0,0), - thistle=c(0.12,0.59,0,0), - orchid=c(0.32,0.64,0,0), - darkorchid=c(0.4,0.8,0.2,0), - purple=c(0.45,0.86,0,0), - plum=c(0.5,1,0,0), - violet=c(0.79,0.88,0,0), - royalpurple=c(0.75,0.9,0,0), - blueviolet=c(0.86,0.91,0,0.04), - periwinkle=c(0.57,0.55,0,0), - cadetblue=c(0.62,0.57,0.23,0), - cornflowerblue=c(0.65,0.13,0,0), - midnightblue=c(0.98,0.13,0,0.43), - navyblue=c(0.94,0.54,0,0), - royalblue=c(1,0.5,0,0), - blue=c(1,1,0,0), - cerulean=c(0.94,0.11,0,0), - cyan=c(1,0,0,0), - processblue=c(0.96,0,0,0), - skyblue=c(0.62,0,0.12,0), - turquoise=c(0.85,0,0.2,0), - tealblue=c(0.86,0,0.34,0.02), - aquamarine=c(0.82,0,0.3,0), - bluegreen=c(0.85,0,0.33,0), - emerald=c(1,0,0.5,0), - junglegreen=c(0.99,0,0.52,0), - seagreen=c(0.69,0,0.5,0), - green=c(1,0,1,0), - forestgreen=c(0.91,0,0.88,0.12), - pinegreen=c(0.92,0,0.59,0.25), - limegreen=c(0.5,0,1,0), - yellowgreen=c(0.44,0,0.74,0), - springgreen=c(0.26,0,0.76,0), - olivegreen=c(0.64,0,0.95,0.4), - rawsienna=c(0,0.72,1,0.45), - sepia=c(0,0.83,1,0.7), - brown=c(0,0.81,1,0.6), - tan=c(0.14,0.42,0.56,0), - gray=c(0,0,0,0.5), - black=c(0,0,0,1), - white=c(0,0,0,0) - ) - if(length(R)<4){ - print("No color") - return(c()) - } - return(R) -} - -############################################ -# 11.01.07 - -Readtextdata<- function(...) -{ - varargin<- list(...) - OutL<- list() - Nargs<- length(varargin) - Fname<- varargin[[1]] - Tmp<- readLines(Fname,n=1) - if (length(grep("\t",Tmp))>0){ - Sep<- "\t" - } - else if (length(grep(",",Tmp))>0){ - Sep<- "," - } - else{ - Sep<- " " - } - Hajime<- c(1,1) - Owari<- c(Inf,Inf) - C<- Inf - R<- Inf - Rna<- FALSE - Cna<- TRUE - Mat<- FALSE - Num<- TRUE - D<- -Inf - Flg<- 0 - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if (mode(Tmp)=="numeric"){ - if (Flg==0){ - Hajime<- Tmp - Flg<- 1 - } - else{ - Owari<- Tmp - } - } - else{ - eval(parse(text=Tmp)) - } - } - Tmp<- Hajime+c(R-1,C-1) - Owari<- c(min(Owari[1],Tmp[1]),min(Owari[2],Tmp[2])) - if (Cna){ - Df<- read.table(Fname,sep=Sep,header=TRUE,,stringsAsFactors=FALSE) - } - else{ - Df<- read.table(Fname,sep=Sep,header=FALSE,,stringsAsFactors=FALSE) - Nv<- c(1:ncol(Df)) - colnames(Df)<- Nv - } - if (Rna){ - rownames(Df)<-Df[,1] - Hajime<- Hajime+c(0,1) - } - if (Mat){ - M<- as.matrix(Df) - Tmp1<- min(Owari[1],nrow(M)) - Tmp2<- min(Owari[2],ncol(M)) - Out<- as.matrix(M[Hajime[1]:Tmp1,Hajime[2]:Tmp2]) - if (Num){ - Tmp1<- as.numeric(Out) - Out<- matrix(Tmp1,nrow=nrow(Out)) - } - } - else{ - Tmp1<- min(Owari[1],nrow(Df)) - Tmp2<- min(Owari[2],ncol(Df)) - Out<- Df[Hajime[1]:Tmp1,Hajime[2]:Tmp2] - } - if (D!=-Inf){ # 11.01.20 v2 - Tmp<- ncol(Out) # 11.01.07 - Tmp1<- rep(Inf,Tmp) - Out[Out[,1]<=D,]<- Tmp1 # 11.01.07 - } - return(Out) -} - -################################## - -Reflectdata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if (Mixtype(ML)==1){ - ML<- list(ML) - } - if (Nargs==1){ - PtA<- c(0,0); PtB<- PtA - } - else{ - Pts<- varargin[[2]] - if (length(Pts)==2){ - PtA<- Pts; PtB<- PtA - } - else{ - PtA<- Pts[1:2]; PtB<- Pts[3:4] - } - } - OutL<- list() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ # 10.12.07 - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if (X1==Inf){ - X2<- X1 - Y2<- Y1 - } - else{ - if (Norm(PtA-PtB)0){ - Str=paste(Str,",",sep="") - } - if(length(Pt)<3){ - Str=paste(Str,sprintf("[%5.4f,%5.4f]",Pt[1],Pt[2]),sep="") - } - else{ - Str=paste(Str,sprintf("[%5.4f,%5.4f,%5.4f]",Pt[1],Pt[2],Pt[3]),sep="") - } - if(nchar(Str)>80){ - cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) - Str="" - } - } - if(nchar(Str)>0){ - cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) - } - if((N==Nargs-1) & (K==length(Gdata)) & (J==length(GL))){ -# cat("end////","\n",sep="",file=Fname,append=TRUE) - cat("end//","\n",sep="",file=Fname,append=TRUE) - } - else{ - cat("end//","\n",sep="",file=Fname,append=TRUE) - } - } - } - } - cat("//","\n",sep="",file=Fname,append=TRUE) # 15.11.05 -} - -###### Old #################################### -# 2015.10.23 -ReadOutData<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Fname=varargin[[1]] - cmdall=readLines(Fname) - cmdall=gsub("//","",cmdall,fixed=TRUE) - varname=cmdall[1] - outdt=list() - varL=c() - ptL=list() - flg=0 - for(cmd in cmdall){ - if(nchar(cmd)>0){ - if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ - if(cmd=="start"){ - pts=c() - } - if(cmd=="end"){ - ptL=c(ptL,list(pts)) - } - if(substring(cmd,1,1)=="["){ - tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") - tmp1=strsplit(tmp1,"]",fixed=TRUE) - tmp1=tmp1[[1]] - tmp1=gsub(",[","c(",tmp1,fixed=TRUE) - for(st in tmp1){ - tmp=eval(parse(text=paste(st,")",sep=""))) - pts=rbind(pts,tmp) - } - row.names(pts)=1:nrow(pts) - } - } - else{ - varname=cmd - varL=c(varL,varname) - if(flg==0){ # 17.10.07from - flg=1 - }else{ - outdt=c(outdt,list(ptL)) - } # 17.10.07upto - ptL=c() - } - } - } - outdt=c(outdt,list(ptL)) # 17.10.07 - names(outdt)=varL - for(var in varL){ - tmp=paste(var,"<<- outdt$",var,sep="") - eval(parse(text=tmp)) - } -# print(varL) - outdt -} - -#################################################### - -ReadOutData<- function(...){ #2017.10.23 - varargin<- list(...) - Nargs<- length(varargin) - Fname=varargin[[1]] - cmdall=readLines(Fname) - cmdall=gsub("//","",cmdall,fixed=TRUE) - varname=""#17.12.13 cmdall[1] - outdt=list() - varL=c() - ptL=list() - flg=0 - for(cmd in cmdall){ - if(nchar(cmd)>0){ - if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ - if(cmd=="start"){ - tmp=paste(varname,"<<- c(",varname,",list(c()))",sep="") - eval(parse(text=tmp)) - Ctr=Ctr+1 - } - if(cmd=="end"){ - } - if(substring(cmd,1,1)=="["){ - tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") - tmp1=strsplit(tmp1,"]",fixed=TRUE) - tmp1=tmp1[[1]] - tmp1=gsub(",[","c(",tmp1,fixed=TRUE) - for(st in tmp1){ - tmp=paste(varname,"[[",as.character(Ctr),"]]",sep="") - tmp=paste(tmp,"<<- rbind(",tmp,",",st,"))",sep="")# - eval(parse(text=tmp)) - } - } - } - else{ - # 17.12.13from - if(nchar(varname)>0){ - tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") - eval(parse(text=tmp)) - } - # 17.12.13upto - varname=cmd - tmp=paste(varname,"<<- list()",sep="") - eval(parse(text=tmp)) - Ctr=0 - if(flg==0){ # 17.10.07from - flg=1 - }else{ - } # 17.10.07upto - } - } - } - # 17.12.13from - tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") - eval(parse(text=tmp)) - # 17.12.13upto -} - -#################################################### - -Rotatedata<- function(..., deg=FALSE) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if (Mixtype(ML)==1){ - ML<- list(ML) - } - Theta<- varargin[[2]] - if (deg) Theta<- Theta*pi/180 # 10.12.07 - if (Nargs==2){ - Pt<- c(0,0) - } - else{ - Pt<- varargin[[3]] - } - Cx<- Pt[1]; Cy<- Pt[2] - OutL<- c() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if (X1==Inf){ - X2<- X1 - Y2<- Y1 - } - else{ - X2<- Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta) - Y2<- Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta) - } - Out<- Appendrow(Out,c(X2,Y2)) - } - if(nrow(Out)==1){ - Out<- Out[1,] - } - OutL<- Mixjoin(OutL,list(Out)) - } - if (length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -############################################### - -Scaledata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if (Mixtype(ML)==1){ - ML<- list(ML) - } - A<- varargin[[2]] - B<- varargin[[3]] - if (Nargs==3){ - Pt<- c(0,0) - } - else{ - Pt<- varargin[[4]] - } - OutL<- list() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ # 10.12.07 - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if (X1==Inf){ - X2<- X1 - Y2<-Y1 - } - else{ - X2<- Pt[1]+A*(X1-Pt[1]) - Y2<- Pt[2]+B*(Y1-Pt[2]) - } - Out<- Appendrow(Out,c(X2,Y2)) - } - OutL<- Mixjoin(OutL,list(Out)) - } - if (length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -################################ - -Setarrow<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if (Nargs==0){ - Str<- paste("Size=",YaSize,",","Angle=",YaAngle,",",sep="") - Str<- paste(Str,"Position=",YaThick,",","Style=",YaStyle,sep="") - return(Str) - } - Flg<- 0 - for (I in 1:Nargs){ - Tmp<- varargin[[I]] - if (mode(Tmp)=="numeric"){ - Flg<- Flg+1 - if (Flg==1) YaSize<<-Tmp - if (Flg==2){ - if (Tmp<5){ - YaAngle<<- 18*Tmp - } - else{ - YaAngle<<- Tmp - } - } - if (Flg==3) YaPosition<<- Tmp - if (Flg==4) YaThick<<- Tmp - } - if (mode(Tmp)=="character"){ - YaStyle<<- Tmp - } - } -} - -#################################### - -Setax<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if (Nargs==0){ - if (ZIKU=="line"){ - Tmp<- "," - } - else{ - Tmp<- paste("(Arrowsize=", as.character(ARROWSIZE),"),",sep="") - } - Str<- paste(ZIKU,Tmp,XNAME,",",XPOS,",",sep="") - Str<- paste(Str,YNAME,",",YPOS,",",ONAME,",",OPOS,sep="") - return(Str) - } - ArgL<- c() - Is<- 1 - Tmp<- varargin[[1]] - if (mode(Tmp)=="numeric" && length(Tmp)==1){ - Is<- varargin[[1]] - ArgL<- c() - for (I in Looprange(1,Is-1)){ - ArgL<- c(ArgL,"") - } - for (I in Looprange(2,Nargs)){ - ArgL<- c(ArgL,varargin[[I]]) - } - } - else{ - if (Nargs==1){ - ArgL<- c(varargin[[1]]) - } - else{ - Tmp<- varargin[[2]] - if (mode(Tmp)=="numeric" && length(Tmp)==1){ - ARROWSIZE<<-Tmp - ArgL<- c(varargin[[1]]) - for (I in Looprange(3,Nargs)){ - ArgL<- c(ArgL,varargin[[I]]) - } - } - else{ - ArgL<- c() - for (I in 1:Nargs){ - ArgL<- c(ArgL,varargin[[I]]) - } - } - } - } - for (I in Looprange(length(ArgL)+1,7)){ - ArgL<- c(ArgL,"") - } - Zk<- ArgL[1] - if (nchar(Zk)>0){ - ZL<-substr(Zk,2,nchar(Zk)) - Zk<-substr(Zk,1,1) - if (nchar(ZL)>0){ - ARROWSIZE<<- as.numeric(ZL) - } - } - Xn<- ArgL[2]; Xp<- ArgL[3] - Yn<- ArgL[4]; Yp<- ArgL[5] - Genn<- ArgL[6]; Genp<- ArgL[7] - if (nchar(Zk)>0){ - C<- Zk - if (C=="a"){ - ZIKU<<- "arrow" - } - else{ - ZIKU<<- "line" - } - } - if (nchar(Xn)>0){ - XNAME<<- paste("$",Xn,"$",sep="") - } - if (nchar(Xp)>0){ - XPOS<<- Xp - } - if (nchar(Yn)>0){ - YNAME<<- paste("$",Yn,"$",sep="") - } - if (nchar(Yp)>0){ - YPOS<<-Yp - } - if (nchar(Genn)>0){ - ONAME<<- Genn - } - if (nchar(Genp)>0){ - OPOS<<- Genp - } - Out<- ""; -} - -################################# -# 11.08.24 - -Setcolor<- function(...){ - varargin<- list(...) - Color<- 'black' - Kosa<- 1 - for(J in Looprange(1,length(varargin))){ - Tmp<- varargin[[J]] - if(is.character(Tmp)) Color<- Tmp - if(is.numeric(Tmp)){ - if(length(Tmp)==1){# 11.08.24 - Kosa<- Tmp - } - else{ - Color<- Tmp - } - }# 11.08.24 - } - Iro<- Ratiocmyk(Color) - if(length(Iro)==0) return(c()) - Str<- "\\color[cmyk]{" #17.09.22 - for(J in 1:4){ - Str<- paste(Str,as.character(Kosa*Iro[J]),sep="") - if(J<4){ - Str<- paste(Str,",",sep="") - } - } - Str<- paste(Str,"}",sep="") - Texcom(Str) -} - -################################## - -Setmarklen<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if (Nargs==0){ - Tmp<- MARKLENNow/MARKLENInit - Tmp=round(Tmp*100)/100 - return(Tmp) - } - Size<- varargin[[1]] - MARKLENNow<<- MARKLENInit*Size - MARKLEN<<- MARKLENNow*1000/2.54/MilliIn -} - -############################### - -Setorigin<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if (Nargs==0){ - return(GENTEN) - } - Pt<- varargin[[1]] - GENTEN<<- Pt; -} - -################################ - -Setscaling<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if (Nargs==0) - { - return(c(SCALEY,LOGX,LOGY)) - } - for (I in 1:Nargs) - { - Tmp<- varargin[[I]] - if (mode(Tmp)=="numeric") - { - SCALEY<<- Tmp - } - if (mode(Tmp)=="character") - { - if (Tmp=="l") - { - LOGX<<- 0 - LOGY<<- 1 - } - else if (Tmp=="ll") - { - LOGX<<- 1 - LOGY<<- 1 - } - else - { - LOGX<<- 0 - LOGY<<- 0 - } - } - } - Tmp<- c(SCALEY,LOGX,LOGY); -} - -######################################### - -Setpen<-function(Width) -{ - PenThick<<-round(PenThickInit*Width) - Str=paste("\\special{pn ", as.character(PenThick),"}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) -} - -############################################## - -Setpt<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - if (Nargs==0) - { - Tmp<- TenSize/TenSizeInit - Tmp<- round(Tmp*100)/100 - return(Tmp) - } - Size<- varargin[[1]] - TenSize<<- TenSizeInit*Size; -} - -############################################## - -Setunitlen<-function(...) -{ - varargin<-list(...) - if (length(varargin)==0){ - return(ULEN) - } - Ul=varargin[[1]] - Dx<-XMAX-XMIN - Dy<-YMAX-YMIN - Sym<-".0123456789 +-*/" - SL<-Sym - OL<-"+-*/" - if (nchar(Ul)>0){ - ULEN<<-Ul - } - Is<-1 - VL<-"" - Ucode<-ULEN - for (I in 1:nchar(Ucode)){ - C<-substring(Ucode,I,I) - if (length(grep(C,SL))>0){ - if (length(grep(C,OL))>0){ - Tmp<-substring(Ucode,Is,I-1) - Str<-paste(VL,Tmp,C,sep="") - VL<-Str - Is<-I+1 - } - } - else{ - Unit<-substring(Ucode,I,I+1) - Str<-substring(Ucode,Is,I-1) - VL<-paste(VL,Str,sep="") - break; - } - } - Valu<-eval(parse(text=VL)) - Str<-as.character(Valu) - ULEN<<-paste(Str,Unit,sep=""); - if (Unit=="cm") MilliIn<<-1000/2.54*Valu - if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10 - if (Unit=="in") MilliIn<<-1000*Valu - if (Unit=="pt") MilliIn<<-1000/72.27*Valu - if (Unit=="pc") MilliIn<<-1000/6.022*Valu - if (Unit=="bp") MilliIn<<-1000/72*Valu - if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu - if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu - if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 - MARKLEN<<-MARKLENNow*1000/2.54/MilliIn - MEMORI<<-MEMORINow*1000/2.54/MilliIn #17.12.17 -} - -######################################### -# 10.11.20 - -Setwindow<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - if (Nargs==0){ - Out<-c(XMIN,XMAX,YMIN,YMAX) - return(Out) - } - if (Nargs==1){ - Dt<- varargin[[1]] - if(is.list(Dt) && !is.data.frame(Dt)){ - Tmp<- as.data.frame(Dt) - Dt<- t(Tmp) - } - Xm<- min(Dt[,1]) - XM<- max(Dt[,1]) - Ym<- min(Dt[,2]) - YM<- max(Dt[,2]) - Str<- "Setwindow(" - Str<- paste(Str,"c(",as.character(Xm),",",as.character(XM),"),c(",sep="") - Str<- paste(Str,as.character(Ym),",",as.character(YM),")",sep="") - Str<- paste(Str,")",sep="") - print(Str) - } - if (Nargs==2){ - RgX<-varargin[[1]] - RgY<-varargin[[2]] - XMIN<<-RgX[1]; XMAX<<-RgX[2] - YMIN<<-RgY[1]; YMAX<<-RgY[2] - } - if (Nargs==4){ - XMIN<<-varargin[[1]]; XMAX<<-varargin[[2]] - YMIN<<-varargin[[3]]; YMAX<<-varargin[[4]] - } - Out<- c(XMIN,XMAX,YMIN,YMAX); -} - -######################################### - -Shade<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - Iroflg=0 - Kosa=1 - if(Nargs>1){ - Iro=varargin[[Nargs]] - if(is.character(Iro)){ - Iroflg=1 - if(length(grep("{",Iro))>0){ - Str=paste("{\\color",Iro,sep="") - } - else{ - Str=paste("{\\color{",Iro,"}",sep="") - } - } - else{ - if(length(Iro)==1){ - Kosa=Iro - } - else{ - Iroflg=1 - if(length(Iro)==4){ - Str="{\\color[cmyk]{" - } - else{ - if(length(Iro)==3){ - Str="{\\color[rgb]{" - } - } - for(J in 1:length(Iro)){ - Str=paste(Str,as.character(Iro[J]),sep="") - if(J80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") - Str2<- paste("\\special{ip}%\n",sep="") - cat(Str1,file=Wfile,append=TRUE) - cat(Str2,file=Wfile,append=TRUE) - } - if(Iroflg==1){ - cat("}%\n",file=Wfile,append=TRUE) - } -} - -####### Shade new 17.09.24############ - -Shade<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - Iroflg<- 0 - Kosa<- 1 - if (Nargs>1){ - Iro<- varargin[[Nargs]] - if (mode(Iro)=="character"){ - Iroflg<- 1 - if (length(grep(Iro,"{"))>0) - Str<- paste("{\\color",Iro,sep="") - else - Str<- paste("{\\color{",Iro,"}",sep="") - } - else{ - if (length(Iro)==1) - Kosa<- Iro - else{ - Iroflg<- 1 - if (length(Iro)==4) - Str<- paste("{\\color[cmyk]{",sep="") - else - if (length(Iro)==3) - Str<- paste("{\\color[rgb]{",sep="") - for (J in Looprange(1,length(Iro))){ - Str<- paste(Str,as.character(Iro[J]),sep="") - if (J80){ - if (Wfile=="default") - cat("%\n",file="",append=TRUE,sep="") - else - cat("%\n",file=Wfile,append=TRUE,sep="") - Mojisu<- 0 - } - } - Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") - Str2<- paste("\\special{ip}%\n",sep="") - if (Wfile=="default"){ - cat(Str1,file="",append=TRUE,sep="") - cat(Str2,file="",append=TRUE,sep="") - } - else{ - cat(Str1,file=Wfile,append=TRUE,sep="") - cat(Str2,file=Wfile,append=TRUE,sep="") - } - } - if (Iroflg==1){ - if (Wfile=="default") - cat("}%\n",file="",append=TRUE,sep="") - else - cat("}%\n",file=Wfile,append=TRUE,sep="") - } -} - -############################################## -# 11.01.07 - -Splinedata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-3) - PL<- varargin[[1]] - if (mode(PL)=="character"){ - Fname<- PL - PL<- Readtextdata(Fname) - } - else{ - PL<- as.matrix(PL) - if (Nrow(PL)==1){ - PL<- matrix(PL, nrow=length(PL)/2) - PL<- t(PL) - } - } - if (ncol(PL)==3){ - Flg3<- 1 - } - else{ - Flg3<- 0 - } - PLL<- Dividegraphics(PL) - N<- 50 - C<- c() - for (I in Looprange(2,Nargs)){ - Tmp<- varargin[[I]] - if (mode(Tmp)!="character") next - if (length(grep("=",Tmp,fixed=TRUE))>0){ - eval(parse(text=Tmp)) - } - else{ - Tmp1<- substr(Tmp,1,1) - if (toupper(Tmp1)=="C"){ - C<- 1:length(PLL) - } - } - } - Cflg<- rep(0,length(PLL)) - for(J in Looprange(1,length(C))){ - K<- C[J] - Cflg[K]<- 1 - } - if (length(N)>1){ - Nj<- as.numeric(N) - } - else{ - Tmp<- lapply(PLL,nrow) - Tmp1<- as.numeric(Tmp) - MxP<- max(Tmp1) - Nj<- c() - for (J in 1:length(PLL)){ - Tmp<- nrow(PLL[[J]]) - Tmp1<- round(N/MxP*(Tmp-1)) - Nj<- c(Nj,Tmp1) - } - } - OutL<- list() - for(J in 1:length(PLL)){ - PL<- PLL[[J]] - if (Cflg[J]==1){ - if (Norm(PL[1,]-PL[Nrow(PL),])>Eps){ - PL<-Appendrow(PL,PL[1,]) - Nj[J]=round(N/MxP*nrow(PL)) - } - else{ - PL[Nrow(PL),]<- PL[1,] - } - } - Tn<- 1:Nrow(PL) - Xn<- PL[,1] - Yn<- PL[,2] - if (Flg3==1) Zn<- PL[,3] - if (Cflg[J]==0){ - Dxn<- spline(Tn,Xn,n=Nj[J]) - Dyn<- spline(Tn,Yn,n=Nj[J]) - if (Flg3==1) Dzn<- spline(Tn,Zn,n=Nj[J]) - } - else{ - Dxn<- spline(Tn,Xn,method="periodic") - Dyn<- spline(Tn,Yn,method="periodic") - if (Flg3==1) Dzn<- spline(Tn,Zn,method="periodic") - } - Tmp1<- Dxn$y - Tmp2<- Dyn$y - Tmp3<-c() - if (Flg3==1) Tmp3<- Dzn$y - Out<- matrix(c(Tmp1,Tmp2,Tmp3),nrow=length(Tmp1)) - OutL<- c(OutL,list(Out)) - } - return(OutL) -} - -############################################ -# 2013.05.03 Domain is optional - -Tabledata<- function(...){ - varargin<- list(...) - Eps<- 0.001 - Tmp<- varargin[[1]] # 130503 from - if(is.numeric(Tmp)){ - Domain<- varargin[[1]] - VL<- varargin[[2]] - HL<- varargin[[3]] - } - else{ - Domain<- c(-1,-1) - VL<- varargin[[1]] - HL<- varargin[[2]] - } # 130503 upto - Hsize<- Domain[1] - SvL<- list(0) - S<- 0 - for (I in Looprange(1,length(VL))){ - Tmp<- VL[[I]] - S<- S+Tmp[1] - Tmp[1]<- S - SvL<- c(SvL,list(Tmp)) - } - if (Hsize>S){ - SvL<- c(SvL,list(Hsize)) - } - Hsize<- Op(1,SvL[[length(SvL)]]) - Vsize<- Domain[2] - ShL<- list(0) - S<- 0 - for (I in Looprange(1,length(HL))){ - Tmp<- HL[[I]] - S<- S+Tmp[1] - Tmp[1]<- S - ShL<- c(ShL,list(Tmp)) - } - if (Vsize>S){ - ShL<- c(ShL,list(Vsize)) - } - Vsize<- Op(1,ShL[[length(ShL)]]) - Marw<- 0; Mare<- 0; Mars<- 0; Marn<- 0 - if (length(Domain)>2){ - Marw<- Domain[3] - Mare<- Domain[4] - } - if (length(Domain)>4){ - Marn<- Domain[5] - Mars<- Domain[6] - } - Setwindow(c(-Marw,Hsize+Mare),c(-Mars,Vsize+Marn)) - Tmp<- Framedata(c(Eps,Hsize-Eps),c(Eps,Vsize-Eps)) - Gdata<- list(Tmp) - Tmp<- -Marw - Hdata<- list(Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn)))) - for (I in Looprange(1,length(SvL))){ - Data<- SvL[[I]] - X<- Data[1] - if (length(Data)==1){ - Y1<- 0 - Y2<- Vsize - G<- Listplot(c(X,Y1),c(X,Y2)) - } - else{ - G<- c() - for (J in seq(2,length(Data),by=2)){ - Y1<- Vsize-Op(1,ShL[[Data[J]]]) - Y2<- Vsize-Op(1,ShL[[Data[J+1]]]) - Tmp<- Listplot(c(c(X,Y1),c(X,Y2))) - Tmp1<- Appendrow(G,c(Inf,Inf)) - G<- Appendrow(Tmp1,Tmp) - } - G<- G[2:nrow(G),] - } - Hdata<- c(Hdata,list(G)) - } - Tmp<- Hsize+Mare - Tmp1<- Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn))) - Hdata<- c(Hdata,list(Tmp1)) - Tmp<- Vsize+Marn - Vdata<- list(Listplot(c(c(-Marw,Tmp),c(Hsize+Mare,Tmp)))) - for (I in Looprange(1,length(ShL))){ - Data<- ShL[[I]] - Y<- Vsize-Data[1] - if (length(Data)==1){ - X1<- 0 - X2<- Hsize - G<- Listplot(c(X1,Y),c(X2,Y)) - } - else{ - G<- c() - for (J in seq(2,length(Data),by=2)){ - X1<- Op(1,SvL[[Data[J]]]) - X2<- Op(1,SvL[[Data[J+1]]]) - Tmp<- Listplot(c(X1,Y),c(X2,Y)) - G<- Appendrow(G,c(Inf,Inf)) - G<- Appendrow(G,Tmp) - } - G<-G[2:nrow(G),] - } - Vdata<- c(Vdata,list(G)) - } -# Tmp<- Listplot(c(c(0,0),c(Hsize,0))) # 2011.03.02 -# Vdata<- Mixjoin(Vdata,list(Tmp)) - Tmp<- Listplot(c(c(-Marw,-Mars),c(Hsize+Mare,-Mars))) - Vdata<- Mixjoin(Vdata,list(Tmp)) - Tmp1<- Hdata[Looprange(3,length(Hdata)-2)] - Tmp2<- Vdata[Looprange(3,length(Vdata)-2)] - Gdata<- Mixjoin(Gdata,Tmp1,Tmp2) - Hind<- Looprange(2,1+length(Tmp1)) - Vind<- Looprange(2+length(Tmp1),1+length(Tmp1)+length(Tmp2)) - G=Gdata[[1]] - P1<- Ptsw(G); P2<- Ptnw(G) - Q1<- Ptse(G); Q2<- Ptne(G) - Tmp1<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) - P1<- Ptnw(G); P2<- Ptne(G) - Q1<- Ptsw(G); Q2<- Ptse(G) - Tmp2<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) - Tmp3<- Framedata() - Out<- list(Gdata,Hind,Vind,Tmp1,Tmp2,Tmp3) - return(Out) -} - -################################ - -Texcom<- function(Meirei) -{ - if (Meirei=="\\thinlines"){ - Setpen(1); - return(); - } - if (Meirei=="\\thicklines"){ - Setpen(2); - return() - } - if (Meirei=="\\Thicklines"){ - Setpen(3); - return() - } - if (length(Meirei)==0){ # 09.12.07 - Tmp<- c() - } - else{ - Tmp<- grep("newline",Meirei) - } - if (length(Tmp)>0){ - cat("\n",file=Wfile,append=TRUE); - } - else{ - Tmp<- paste(Meirei,"%\n",sep="") - Tmp<- gsub("//","\\",Tmp,fixed=TRUE) # 11.03.02 - cat(Tmp,file=Wfile,append=TRUE); - } -} - -############################################### - -Texctr<- function(N){ - if (is.numeric(N)){ - Alpha<- "abcdefghijklmnopqrstuvwxyz" - Out<- paste("ketpicctr",substr(Alpha,N,N),sep="") - } - else{ - if(grep("\\",N,fixed=TRUE)>0){ - Out<- substr(N,2,nchar(N)) - } - else{ - Out<- N - } - } - return(Out) -} - -############################################### - -Texelse<- function (){ - Texcom(""); - Texcom("\\else") -} - -############################################### - -Texend<- function() -{ - Texcom("%\n}") -} - -############################################### - -Texendfor<- function(I){ - Last<- TEXFORLAST[[TEXFORLEVEL]] - Texcom("") - Tmp<- paste("\\ifnum",Texthectr(I),"<",Last,sep="") - Texcom(Tmp) - Texcom("\\repeat") - Texcom("}") - TEXFORLEVEL<<- TEXFORLEVEL-1 - TEXFORLAST<<- TEXFORLAST[1:(length(TEXFORLAST)-1)] -} - -############################################### - -Texendif<- function(){ - Texcom("") - Texcom("\\fi") - Texcom("}") -} - -############################################### - -Texfor<- function(I,First,Last){ - TEXFORLEVEL<<- TEXFORLEVEL+1; - Texsetctr(I,"0") - Texsetctr(I,paste(as.character(First),"-1",sep="")) - Texcom("") - Texcom("{") - Texcom("\\loop") - Texsetctr(I,"+1") - TEXFORLAST<<- c(TEXFORLAST,as.character(Last)) -} - -############################################### - -Texforinit<- function(){ - TEXFORLEVEL<<- 0 - TEXFORLAST<<- list() -} - -############################################### - -Texif<- function(...){ - varargin<- list(...) - Condstr<- varargin[[1]] - Tp<- 0 - if(length(varargin)>1){ - Tp<- varargin[[2]] - } - Texcom("") - Texcom("{") - if(Tp==0){ - Texcom("\\ifnum") - } - else{ - Texcom("\\ifdim ") - } - Texcom(paste(Condstr," ",sep="")) -} - -###################################### - -Texletter<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - for (I in seq(1,Nargs,by=3)){ - P<- varargin[[I]] - X<- P[1] - if (mode(X)=="numeric"){ - X<- as.character(X) - } - Y<- P[2] - if (mode(Y)=="numeric"){ - Y<- as.character(Y) - } - Houkou<- varargin[[I+1]] - Mojiretu<- varargin[[I+2]] - Hset<- Houkou - Vhoko<- "c" - if (length(grep("n",Hset))>0){ - Vhoko<- "n" - } - if (length(grep("s",Hset))>0){ - Vhoko<- "s" - } - Hhoko<- "c"; - if (length(grep("e",Hset))>0){ - Hhoko<- "e" - } - if (length(grep("w",Hset))>0){ - Hhoko<- "w" - } - Hoko<- paste(Vhoko,Hhoko,sep="") - CalcWidth(Hoko,Mojiretu) - CalcHeight(Hoko,Mojiretu) - Tmp<- paste("\\put(",X,",",Y,"){\\hspace*{\\Width}",sep="") - Str<- paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") - cat(Str,file=Wfile,append=TRUE) - } -} - -################################################## - -Texnewcmd<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Str<- varargin[[1]] - S<- paste("\\newcommand{",Str,"}",sep="") - if (Nargs>1){ - Tmp<- as.character(varargin[[2]]) - S<- paste(S,"[",Tmp,"]",sep="") - } - if (Nargs>2){ - Tmp<- varargin[[3]] - if (mode(Tmp)=="numeric"){ - Tmp<- as.character(Tmp) - } - S<- paste(S,"[",Tmp,"]",sep="") - } - S<- paste(S,"{",sep="") - Texcom(S) -} - -############################################### - -Texnewctr<- function(N) -{ - if (mode(N)=="character"){ - Str<- paste("\\newcounter{",N,"}",sep="") - Texcom(Str) - } - else{ - for (I in N){ - Str<- paste("\\newcounter{",Texctr(I),"}",sep="") - Texcom(Str) - } - } -} -############################################### - -Texrenewcmd<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Str<- varargin[[1]] - S<- paste("\\renewcommand{",Str,"}",sep="") - if (Nargs>1){ - Tmp<- as.character(varargin[[2]]) - S<- paste(S,"[",Tmp,"]",sep="") - } - if (Nargs>2){ - Tmp<- varargin[[3]] - if (mode(Tmp)=="numeric"){ - Tmp<- as.character(Tmp) - } - S<- paste(S,"[",Tmp,"]",sep="") - } - S<- paste(S,"{",sep="") - Texcom(S) -} - -############################################### - -Texsetctr<- function(Nctr,Opstr) -{ - Ctr<- Texctr(Nctr) - Opstr<- paste(Opstr,"%",sep="") - OperL<- "+-*/%" - Oper<- "" - Va<- "" - Evflg<- 0 - Paflg<- 0 - for (I in Looprange(1,nchar(Opstr))){ - Tmp<- substring(Opstr,I,I) - if (Tmp=="("){ - Paflg<- 1 - if (nchar(Va)>0){ - Evflg<- 1 - Va<- paste(Va,Tmp,sep="") - } - next - } - if (Tmp==")"){ - Paflg<- 0 - if (Evflg>0){ - Va<- paste(Va,Tmp,sep="") - } - next - } - if (Paflg>0){ - Va<- paste(Va,Tmp,sep="") - next - } - if (length(grep(Tmp,OperL))==0){ - Va<- paste(Va,Tmp,sep="") - } - else{ - if (Evflg>0){ - Tmp1<- eval(parse(text=Va)) - Va<- paste("\\value{",Tmp1,"}",sep="") - Evflg<- 0 - } - if (Oper==""){ - if(nchar(Va)>0){ - Str<- paste("\\setcounter{",Ctr,"}{",Va,"}",sep="") - Texcom(Str) - } - Oper<- Tmp - Va<-"" - } - else if(Oper=="+"){ - Str<- paste("\\addtocounter{",Ctr,"}{",Va,"}",sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - else if(Oper=="-"){ - Str<- paste("\\addtocounter{",Ctr,"}{-",Va,"}",sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - else if(Oper=="*"){ - Str<- paste("\\multiply\\value{",Ctr,"} by ",Va,sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - else if(Oper=="/"){ - Str<- paste("\\divide\\value{",Ctr,"} by ",Va,sep="") - Texcom(Str) - Oper<- Tmp - Va<-"" - } - } - } -} - -############################################### - -Texthectr<- function(N) -{ - Out<- paste("\\the",Texctr(N),sep="") - return(Out) -} - -############################################### - -Texvalctr<- function(N){ - Out<- paste("\\value{",Texctr(N),"}",sep="") - return(Out) -} - -############################################### - -Texvctr<- function(N) -{ - Out<- paste("\\value{",Texctr(N),"}",sep="") - return(Out) -} - -############################################### - -Tonumeric <- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Data<- varargin[[1]] - Sp<- c(1,1) - Ep<- c(Inf,Inf) - if (Nargs>1){ - Sp<- varargin[[2]] - } - if (Nargs>2){ - Ep<- varargin[[3]] - } - Nrs<- Sp[1] - Nre<- min(nrow(Data),Ep[1]) - Ncs<- Sp[2] - Nce<- min(ncol(Data),Ep[2]) - Tmp1<- Data[Nrs:Nre, Ncs:Nce] - Tmp2 <- as.numeric(Tmp1) - Out <- matrix(Tmp2,nrow=nrow(Tmp1)) - Sp<- c() - for (I in 1:nrow(Out)){ - for (J in 1:ncol(Out)){ - Tmp<- Out[I,J] - if (!is.na(Tmp)){ - Sp<- c(I,J) - break; - } - } - if (length(Sp)>0) break - } - if (length(Sp)==0){ - return("Numeric data not found") - } - Ep<- c(nrow(Out),ncol(Out)) - for (I in Sp[1]:nrow(Out)){ - Tmp<- Out[I,Sp[2]] - if (is.na(Tmp)){ - Ep[1]<- I-1 - break - } - } - for (J in Sp[2]:ncol(Out)){ - Tmp<- Out[Sp[1],J] - if (is.na(Tmp)){ - Ep[2]<- J-1 - break - } - } - Out<- Out[Sp[1]:Ep[1], Sp[2]:Ep[2]] - return(Out) -} - -################################################## - -Translatedata<- function(...) -{ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10^(-8) - ML<- varargin[[1]] - if (Mixtype(ML)==1){ - ML<- list(ML) - } - Tmp=varargin[[2]] - if (mode(Tmp)=="numeric" && length(Tmp)>1){ - A<- Tmp[1]; B<- Tmp[2] - } - else{ - A<- Tmp - if (Nargs>=3){ - B<- varargin[[3]] - } - else{ - B<- 0 - } - } - OutL<- list() - for (N in Looprange(1,length(ML))){ - GL<- Op(N,ML) - Out<- c() - for (I in Looprange(1,Nrow(GL))){ - if(is.matrix(GL)){ # 10.12.07 - Tmp<- GL[I,] - } - else{ - Tmp<- GL - } - X1<- Tmp[1] - Y1<- Tmp[2] - if (X1==Inf){ - X2<- X1 - Y2<-Y1 - } - else{ - X2<- X1+A - Y2<- Y1+B - } - Out<- Appendrow(Out,c(X2,Y2)) - } - OutL<- Mixjoin(OutL,list(Out)) - } - if (length(OutL)==1){ - OutL<- Op(1,OutL) - } - return(OutL) -} - -####################################### - -Unscaling<- function(G) -{ - GLg<- G - if (class(GLg)=="numeric"){ - GLg<-c(G[1]/SCALEX, G[2]/SCALEY) - Tmp<-GLg - if (LOGX==1) Tmp[1]<- 10^(GLg[1]) - if (LOGY==1) Tmp[2]<- 10^(GLg[2]) - return(Tmp) - } - else{ - Tmp1<-matrix(c(1/SCALEX,0,0,1/SCALEY),nrow=2) - GLg<-G %*% Tmp1 - Tmp<-GLg - if (LOGX==1) Tmp[,1]<- 10^(G[,1]) - if (LOGY==1) Tmp[,2]<- 10^(G[,2]) - return(Tmp) - } -} - -############################################# - -Vtickmark<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if (mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if (K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if (is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if (J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if (is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if (is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if (I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if (I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if (mode(Dt)=="numeric" && length(Dt)>1){ - if (length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt[1],Dt[2]) - next - } - if (mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if (length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(GENTEN[1],Dt) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X+MARKLEN,Y)) - Tmp2<- Unscaling(c(X-MARKLEN,Y)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if (Ndt==3){ - Tmp<-Unscaling(c(X-MARKLEN,Y)) - Expr(Tmp,"w",Moji) - } - if (Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("w",Houkou) - if (length(Tmp)>0){ - Tmp<-Unscaling(c(X-MARKLEN,Y)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X+MARKLEN,Y)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -############################################ - -Windisp<-function(...){ - varargin<-list(...) - Nargs<-length(varargin) - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") - Tmp<- Doscaling(Listplot(c(0,YMIN),c(0,YMAX))) - axis(2,at=as.numeric(Tmp[,2]), labels=round(c(YMIN,YMAX),2)) - Tmp<- Doscaling(Listplot(c(XMIN,0),c(XMAX,0))) - axis(1,at=as.numeric(Tmp[,1]), labels=round(c(XMIN,XMAX),2)) - Tmp1<- c(XMIN,GENTEN[2]) - Tmp2<- c(XMAX,GENTEN[2]) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if (Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp1<- c(GENTEN[1],YMAX) - Tmp2<- c(GENTEN[1],YMIN) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if (Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp<-Doscaling(Framedata()) - lines(Tmp[,1],Tmp[,2]) - for (I in Looprange(1,Nargs)){ - Pdata<-varargin[[I]] - if (mode(Pdata)=="numeric"){ - Pdata<-list(Pdata) - } - while(Mixtype(Pdata)==3){ # 10.02.23 - Tmp1<- list() - for(II in Looprange(1,length(Pdata))){ - Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) - } - Pdata<- Tmp1 - } # 10.02.23 - for (II in Looprange(1,length(Pdata))){ - Tmp<-Pdata[[II]] - P<-MakeCurves(Tmp,0) - Ndm<-Dataindex(P) - for (J in Looprange(1,Nrow(Ndm))){ - Q<-P[Ndm[J,1]:Ndm[J,2],] - if (Nrow(Q)==1){ - Tmp<-seq(1,Ncol(Q),by=2) - for (K in Tmp){ - Pt<-Q[K:(K+1)] - points(Pt[1],Pt[2]) - } - } - else{ - lines(Q[,1],Q[,2]) - } - } - } - } -} - -############################################ - -WindispT<-function(..., color="black",width=1,new=FALSE,htick=c(),vtick=c()){ # 10.12.04 - par(new=new) - varargin<-list(...) - Nargs<-length(varargin) - if(!new) # 10.12.04 - { - Tmp<- Doscaling(c(XMIN,YMIN)) - Xmn<- Tmp[1]; Ymn<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - Xmx<- Tmp[1]; Ymx<- Tmp[2] - plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") - Tick<- sort(c(YMIN,YMAX,vtick)) #### 10.12.04 from here - Tmp1<- matrix(c(rep(0,length(Tick)),Tick),ncol=2) - Tmp<- Doscaling(Tmp1) - axis(2,at=as.numeric(Tmp[,2]), labels=round(Tick,2)) - Tick<- sort(c(XMIN,XMAX,htick)) - Tmp1<- matrix(c(Tick,rep(0,length(Tick))),ncol=2) - Tmp<- Doscaling(Tmp1) - axis(1,at=as.numeric(Tmp[,1]), labels=round(Tick,2)) #### 10.12.04 to here - Tmp1<- c(XMIN,GENTEN[2]) - Tmp2<- c(XMAX,GENTEN[2]) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if (Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp1<- c(GENTEN[1],YMAX) - Tmp2<- c(GENTEN[1],YMIN) - Tmp3<- Listplot(Tmp1,Tmp2) - Tmp<- MakeCurves(Tmp3,0) - if (Datalength(Tmp)>0){ - lines(Tmp[,1],Tmp[,2],col="green") - } - Tmp<-Doscaling(Framedata()) - lines(Tmp[,1],Tmp[,2]) - } - for (I in Looprange(1,Nargs)){ - Pdata<-Flattenlist(varargin[[I]]) # 101129 from here - Cmd<- list() - for (II in Looprange(1,length(Pdata))){ - Tmp<-Pdata[[II]] - if(length(Tmp)==1){ - Cmd<- c(Cmd,list(Tmp)) - next - } - - P<-MakeCurves(Tmp,0) - - if(length(Cmd)>0){ - if(length(Cmd)>=3){ - polygon(P,col=Cmd[[1]],border=Cmd[[2]],density=Cmd[[3]]) - } - else{ - polygon(P,col=Cmd[[1]],border=Cmd[[2]]) - } - next - } # 101129 to here - Ndm<-Dataindex(P) - for (J in Looprange(1,Nrow(Ndm))){ - Q<-P[Ndm[J,1]:Ndm[J,2],] - if (Nrow(Q)==1){ - Tmp<-seq(1,Ncol(Q),by=2) - for (K in Tmp){ - Pt<-Q[K:(K+1)] - points(Pt[1],Pt[2],col=color)#taka101111 - } - } - else{ - lines(Q[,1],Q[,2],col=color,lwd=width)#taka101111 - } - } - } - } - par(new=FALSE) -} - -###################################### - -# 3D - -################################# - -# 10.08.16 -CameracoordCurve<- function(Curve){ - Out<- c() - for(J in Looprange(1,Nrow(Curve))){ - P<- Ptcrv(J,Curve) #P=Curve(J,:); - Tmp<- P-FocusPoint - X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb - E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb - Xz<- X3 - Yz<- E3/(E3-X3)*Y3 - Zz<- E3/(E3-X3)*Z3 - Out<- rbind(Out,c(Yz,Zz,Xz)) - } - rownames(Out)<- 1:Nrow(Out) - return(Out) -} - -######################################### - -#100815 -CameraCurve<- function(Curve){ - Eps<- 10^(-6) - for (I in Looprange(1,Nrow(Curve))){ - P<- Curve[I,] - x<- P[1]; y<- P[2]; z<- P[3] - if (x!=Inf){ - Tmp<- Perspt(P) - if (I==1){ - AnsL<- rbind(c(),Tmp) - }else{ - Tmp1<- AnsL[Nrow(AnsL),] - if (Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){ - AnsL<- rbind(AnsL,Tmp) - } - } - }else{ - AnsL<- rbind(AnsL,c(Inf,Inf)) - } - } - rownames(AnsL)<- 1:Nrow(AnsL) - return(AnsL) -} - -###################################### - -Cancoordpara<- function(P){ # 13.10.06 - Xz<- P[1] - Yz<- P[2] - Zz<- P[3] - X<- Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA) - Y<- Xz*cos(PHI)-Yz*sin(PHI)*cos(THETA)+Zz*sin(PHI)*sin(THETA) - Z<- Yz*sin(THETA)+Zz*cos(THETA) - Out<- c(X,Y,Z) - return(Out) -} - -###################################### - -Cancoordpers<- function(P){ - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb - Xz<- P[3]; Yz<- P[1]; Zz<- P[2] - X3<- Xz; Y3<- Yz*(E3-Xz)/E3; Z3<- Zz*(E3-Xz)/E3 - X2<- X3*Cb-Sb*Z3; Y2<- Y3; Z2<- Cb*Z3+Sb*X3 - X1<- X2*Ca-Sa*Y2; Y1<- Ca*Y2+Sa*X2; Z1<- Z2 - X<- X1+FocusPoint[1] - Y<- Y1+FocusPoint[2] - Z<- Z1+FocusPoint[3] - Out<- c(X,Y,Z) - return(Out) -} - -####################################### - -Embed<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Pd3<- varargin[[1]] - if(Mixtype(Pd3)==1){ - Pd3<- list(Pd3) - } - else if(Mixtype(Pd3)==3){ - Tmp<- list(); - for(I in Looprange(1,length(Pd3))){ - Tmp<- c(Tmp,Pd3[[I]]) - } - Pd3<- Tmp - } - Tmpf=varargin[[2]] - if(mode(Tmpf)=="character"){ - Tmp<- varargin[[3]] - Tmp1<- gsub("c(","(",Tmp,fixed=TRUE) - Vstr<- gsub(")",")",Tmp1,fixed=TRUE) - Str<- paste("Tmpfn<- function",Vstr,"{",Tmpf,"}",sep="") - eval(parse(text=Str)) - } - else{ - Tmpfn<- Tmpf - } - Out<- list() - for(I in Looprange(1,length(Pd3))){ - PD<- Pd3[[I]] - Ans<- c() - for(J in Looprange(1,Nrow(PD))){ - P<- PD[J,] - Tmp<- Tmpfn(P[1],P[2]) - Ans<- rbind(Ans,Tmp) - } - Out<- c(Out, list(Ans)) - } - if(length(Out)==1){ - Out<- Out[[1]] - } - return(Out) -} - -####################### -# 10.08.17 -# 14.03.30 -Facesdata<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - FL<- varargin[[1]] - PT<- varargin[[length(varargin)]] - Tmp<-grep("para",PT,fixed=TRUE) - if (length(Tmp)>0){ - Ptype<- 1 - }else{ - Ptype<- -1 - } - if (Nargs==2){ - CLadd<- list() - }else{ - CLadd<- varargin[[2]] - } - NohiddenL<- list() - HiddenL<- list() - Eps<- 10^(-4) - if (length(CLadd)>0){ - if (mode(CLadd)=="numeric"){ - C<- list() - if (Nrow(CLadd)>1){ - for (I in Looprange(1,Nrow(CLadd))){ - C<- c(C,list(CLadd[I,])) - } - }else{ - I<- 1 - while (I<=Ncol(CLadd)){ - C<- c(C,list(CLadd[1,I:(I+2)])) - I<- I+3 - } - } - CrvL<- list(C) - }else if (mode(CLadd[[1]])=="numeric"){ - CrvL<- list() - for (J in Looprange(1,length(CL))){ - Ctmp<- CLadd[[J]] - C<- list() - if (Nrow(Ctmp)>1){ - for (I in Looprange(1,Nrow(Ctmp))){ - C<- c(C,list(Ctmp[I,])) - } - }else{ - I<- 1 - while(I<=Ncol(Ctmp)){ - C<- c(C,list(Ctmp[1,I:(I+2)])) - I<- I+3 - } - } - CrvL<- c(CrvL,list(C)) - } - }else{ - CrvL<- CLadd - } - }else{ - CrvL<- list() - } - Out<- MakeveLfaceL(FL) - VELNO<<- Out[[1]] - VELHI<<- list() - for (I in Looprange(1,length(CrvL))){ - Tmp<- CrvL[[I]] - for (J in Looprange(1,length(Tmp)-1)){ - Edge<- list(Tmp[J],Tmp[J+1]) - Ntmp<- length(VELNO) - VELNO(Ntmp+1)<<- list(Edge,0,Ntmp+1) - } - } - FaceL<- Out[[2]] - Tmp<- grep("raw",PT,fixed=TRUE) - if (length(Tmp)==0){ - for (Nf in Looprange(1,length(FaceL))){ - Face<- FaceL[[Nf]] - Menkakusi2(Face,Nf,Ptype) - } - } - for (I in Looprange(1,length(VELNO))){ - Edge<- Op(1,VELNO[[I]]) - if (Norm(Edge[[1]]-Edge[[2]])>Eps){ - NohiddenL<- c(NohiddenL,list(Spaceline(Edge))) - } - } - EdgeL<- list() # from 13.03.30 - for(K in Looprange(1,length(VELHI))){ - Edge<- Op(1,VELHI[[K]]) - P<- Edge[[1]]; Q<- Edge[[2]] - if(Norm(P-Q)>Eps){ - EdgeL<- c(EdgeL,list(Edge)) - } - } - for(K in Looprange(1,length(EdgeL))){ - Edge<- EdgeL[[K]] - P<- Edge[[1]]; Q<- Edge[[2]] - Cflg<- 0 - for(J in Looprange(K+1,length(EdgeL))){ - Ej<- EdgeL[[J]] - Pj<- Ej[[1]]; Qj<- Ej[[2]] - if(Norm(Crossprod(Q-P,Qj-Pj))>Eps){ - next - } - if(Norm(Q-Pj)0){ - break - } - } - Urg<- Stripblanks(Op(Jrg,FdL)) - StrV<- strsplit(Urg,"=",fixed=TRUE)[[1]] - Uname<-StrV[1] - Vrg<- Stripblanks(Op(Jrg+1,FdL)) - StrV<- strsplit(Vrg,"=",fixed=TRUE)[[1]] - Vname<- StrV[1] - if (Jrg==2){ - Tmp<- Stripblanks(Op(1,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Zf<- StrV[2] - Tmp<- list(Uname,Vname,Zf,Urg,Vrg) - Out<- c(Out,Tmp) - }else if (Jrg==4){ - Tmp<- Stripblanks(Op(1,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Zf<- StrV[2] - Tmp<- Stripblanks(Op(2,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Xname<- StrV[1] - Xf<- StrV[2] - Tmp<- Stripblanks(Op(3,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Yname<- StrV[1] - Yf<- StrV[2] - Tmp<- gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE) - Zf<- gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE) - Tmp<- list(Xf,Yf,Zf,Urg,Vrg) - Out<- c(Out,Tmp) - }else{ - Tmp<- Stripblanks(Op(2,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Xf<- StrV[2] - Tmp<- Stripblanks(Op(3,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Yf<- StrV[2] - Tmp<- Stripblanks(Op(4,FdL)) - StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] - Zf<- StrV[2] - Tmp<- list(Xf,Yf,Zf,Urg,Vrg) - Out<- c(Out,Tmp) - } - DrwS<- "enws" - BdyL<- c() - for (I in Looprange(Jrg+2,Mixlength(FdL))){ - Tmp<- Op(I,FdL) - if (mode(Tmp)=="character"){ - if (length(Tmp)==0){ - Tmp<- " " - } - DrwS<- Tmp - } - if (mode(Tmp)=="numeric" && Ncol(Tmp)>1){ - BdyL<- Tmp - } - } - Tmp<- list(DrwS,BdyL) - Out<- c(Out,Tmp) - return(Out) -} - -#################################### - -Initangle<- function (){ - PHI<<- 30*pi/180 - THETA<<- 60*pi/180 -} - -########################## - -Invparapt<- function(...){ - varargin<- list(...) - Eps<- 10^(-4) - Fk<- varargin[[length(varargin)]] - NFk<- Numptcrv(Fk) - Tmp<- varargin[[1]] - if (mode(Tmp)=="numeric" && length(Tmp)==1){ # debug - Ph<- Tmp - Fh<- varargin[[2]] - }else{ - Fh<- Projpara(Fk) - if (NFk>2){ - Tmp1<- Nearestpt(Tmp,Fh) - Ph<- Tmp1[[2]] - }else{ - Ah<- Ptcrv(1,Fh); Bh=Ptcrv(2,Fh) - V1<- Tmp-Ah; V2<- Bh-Ah - Tmp1<- Crossprod(V1,V2) - if (abs(Tmp1)>Eps){ - print("Not on the line") - return(c()) - }else{ - Ph<- Dotprod(V1,V2)/Norm(V2)^2+1 - } - } - } - if (NFk>2){ - N<- trunc(Ph) - S0<- Ph-N - if (Ph>Numptcrv(Fh)-Eps){ - Out<- list(Ptend(Fk),Numptcrv(Fh)) - return(Out) - } - }else{ - N<- 1 - S0<- Ph-1 - } - Ak<- Ptcrv(N,Fk); Bk=Ptcrv(N+1,Fk) - Ah<- Ptcrv(N,Fh); Bh=Ptcrv(N+1,Fh) - Ph<- (1-S0)*Ah+S0*Bh - T2<- S0 - Pk<- (1-T2)*Ak+T2*Bk - Out<- list(Pk,N+T2) - return(Out) -} - -################################# - -#100815 -Invperspt<- function(...){ - varargin<-list(...) - Eps<- 10^(-4) - Fk<- varargin[[length(varargin)]] - NFk<- Numptcrv(Fk) - Tmp<- varargin[[1]] - if (mode(Tmp)=="numeric" && length(Tmp)==1){ - Ph<- varargin[[1]] - Fh<- varargin[[2]] - }else{ - Fh<- Projpers(Fk) - if (NFk>2){ - Tmp1<- Nearestpt(Tmp,Fh) - Ph<- Tmp1[[2]] - }else{ - Ah<- Ptcrv(1,Fh); Bh<- Ptcrv(2,Fh) - V1<- Tmp-Ah; V2<- Bh-Ah - Tmp1<- Crossprod(V1,V2) - if (abs(Tmp1)>Eps){ - print("Not on the line") - Out<- c() - return(Out) - }else{ - Ph<- Dotprod(V1,V2)/Norm(V2)^2+1# 09.11.12 - } - } - } - if (NFk>2){ - N<- trunc(Ph) - S0<- Ph-N - if (Ph>Numptcrv(Fh)-Eps){ - Out<- list(Ptend(Fk),Numptcrv(Fh)) - return(Out) - } - }else{ - N<- 1 - S0<- Ph-1 # 09.11.12 - } - Ak<- Ptcrv(N,Fk); Bk<- Ptcrv(N+1,Fk) - Ah<- Ptcrv(N,Fh); Bh<- Ptcrv(N+1,Fh) - Ph<- (1-S0)*Ah+S0*Bh - Phc<- Cancoordpers(c(Ph,0)) - Ahc<- Cancoordpers(c(Ah,0)) - Bhc<- Cancoordpers(c(Bh,0)) - Vp<- Phc-EyePoint - Va<- Ak-EyePoint - AB<- Bk-Ak - Cp<- Crossprod(Vp,AB) - Nmr<- Crossprod(Va,Vp) - Mx<- max(abs(Cp)) - if (abs(Cp[1])==Mx){ - T2<- Nmr[1]/Cp[1] - }else if (abs(Cp[2])==Mx){ - T2<- Nmr[2]/Cp[2] - }else{ - T2<- Nmr[3]/Cp[3] - } - Pk<- (1-T2)*Ak+T2*Bk - Out<- list(Pk,N+T2) - return(Out) -} - -######################### - -Kukannozoku<- function(Jokyo,KukanL){ - Eps<- 10^(-6) - N<- Nrow(KukanL) - T1<- Jokyo[1]; T2<- Jokyo[2] - Tmp<- KukanL[1,] - T1<- max(T1,Tmp[1]) - Tmp<- KukanL[N,] - T2<- min(T2,Tmp[2]) - Res<- c() - Flg<- 0 - for (I in Looprange(1,N)){ - Ku<- KukanL[I,] - if (Flg==0){ - if (Ku[2]T2+Eps){ - Tmp<- c(T2,Ku[2]) - Res<- rbind(Res,Tmp) - } - } - }else if (Flg==1){ - if (Ku[2]0){ - for (J in 1:Mixlength(KC)){ - P<- Op(1,Op(J,KC)) - Tmp<- Op(2,Op(J,KC)) - if (Tmp<1+Eps && Ns==1){ - next - } - if (Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ - next - } - N1<- Ns - N2<- Op(3,Op(J,KC)) - Pa<- Plt2[N1,1:2] - Za<- Plt2[N1,3] - Pb<- Plt2[N1+1,1:2] - Zb<- Plt2[N1+1,3] - if (Norm(Pa-Pb)Eps^2){ - Tmp1<- P1[2,]-P1[1,] - Tmp2<- Pb-Pa - Tmp3<- Dotprod(Tmp1,Tmp2) - Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) - Tmp<- 1-0.5*Tmp3^2 - ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) - } - } - } - } - } - } - Te<- Nrow(Plt2) - KukanL<- rbind(c(),c(1.0,Te)) - P1<- PhL - if (Nrow(ClipL)>0){ - for (I in 1:Nrow(ClipL)){ - P<- ClipL[I,1:2] - NN<- ClipL[I,3] - T<- NN+ClipL[I,4] - R<- ClipL[I,5] - Flg<- 0 - for (J in NN:1){ - Q<- Pointoncrv(J,P1) - if (Norm(P-Q)Eps){ - Tmp<- Pointoncrv(T2,P1) - PtL<- c(PtL,list(Tmp)) - } - Res<- c(Res,list(Listplot(PtL))) - } - Allres<- c(Allres,Res) - } - return(Allres) -} - -######################### - -#100815 -Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){ - Eps<- 10.0^(-3) - Dmat<- c() - Dind<- c() - for (I in Looprange(1,Mixlength(Plt2L))){ - Dt<- Op(I,Plt2L) - N1<- Nrow(Dmat)+1 - Dmat<- rbind(Dmat,Dt) - N2<- Nrow(Dmat) - Dind<- rbind(Dind,c(N1,N2)) - } - Nind<- Nrow(Dind) - Allres<- list() - for (Nobj in Looprange(1,Mixlength(Obj2L))){ - Plt2<- Op(Nobj,Obj2L) - PhL<- Plt2[,1:2] - ClipL<- c() - for (Ns in Looprange(1,Nrow(PhL)-1)){ - P1<- PhL[Ns:(Ns+1),] - for (I in Looprange(1,Nrow(Dind))){ - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - P2<- Tmp[,1:2] - KC<- IntersectcrvsPp(P1,P2,Eps) - if (Mixlength(KC)>0){ - for (J in Looprange(1,Mixlength(KC))){# - P<- Op(1,Op(J,KC)) - Tmp<- Op(2,Op(J,KC)) - if (Tmp<(1+Eps) && Ns==1){ - next - } - if (Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ - next - } - N1<- Ns - N2<- Op(3,Op(J,KC)) - Pa<- Plt2[N1,1:2] - Za<- Plt2[N1,3] - Pb<- Plt2[N1+1,1:2] - Zb<- Plt2[N1+1,3] - if (Norm(Pa-Pb)1-Eps){ - Pk<- Pkb - }else{ - Tmp1<- Listplot(c(Pa,Pb)) - Tmp2<- Spaceline(c(Pka,Pkb)) - Tmp<- Invperspt(1+T1,Tmp1,Tmp2) - Pk<- Op(1,Tmp) - } - Z1<- Zperspt(Pk) - Tmp<- Dmat[Dind[I,1]:Dind[I,2],] - Pa<- Tmp[N2,1:2] - Za<- Tmp[N2,3] - Pb<- Tmp[N2+1,1:2] - Zb<- Tmp[N2+1,3] - if (Norm(Pa-Pb)(1-Eps)){ - Pk<- Pkb - }else{ - Tmp1<- Listplot(c(Pa,Pb)) - Tmp2<- Spaceline(c(Pka,Pkb)) - Tmp<- Invperspt(1+T2,Tmp1,Tmp2) - Pk<- Op(1,Tmp) - } - Z2<- Zperspt(Pk) - if (Z1<(Z2-Eps2)){ - if (length(ClipL)==0){ - Tmp<- 1 - }else{ - Tmp1<- ClipL[,1]-P[1] - Tmp2<- ClipL[,2]-P[2] - Tmp3<- Tmp1^2+Tmp2^2 - Tmp<- min(Tmp3) - } - if (Tmp>Eps^2){ - Tmp1<- P1[2,]-P1[1,] - Tmp2<- Pb-Pa - Tmp3<- Dotprod(Tmp1,Tmp2) - Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) - Tmp<- 1-0.5*Tmp3^2 - ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) - } - } - } - } - } - } - Te<- Nrow(Plt2) - KukanL<- rbind(c(),c(1.0,Te)) - P1<- PhL - if (Nrow(ClipL)>0){ - for (I in Looprange(1,Nrow(ClipL))){ - P<- ClipL[I,1:2] - NN<- ClipL[I,3] - T<- NN+ClipL[I,4] - R<- ClipL[I,5] #added 10.08.17 - Flg<- 0 - for (J in NN:1){ - Q<- Pointoncrv(J,P1) - if (Norm(P-Q)Eps){ - Tmp<- Pointoncrv(T2,P1) - PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp) - } - Res<- c(Res,list(Listplot(PtL)))#Res<- Mixadd(Res,Listplot(PtL)) - } - Allres<- c(Allres,Res)#Allres<- Mixjoin(Allres,Res) - } - return(Allres) -} - -##############################3 - -MakeveLfaceL<- function(VfL){ -# // Out format -# // VeL Edge, Face num(as numlist), VeL num -# // FL Face (Vertexs) - Eps<- 10^(-4) - Tmp<- VfL[[length(VfL)]] - Tmp1<- Tmp[[1]] - if (mode(Tmp1)=="numeric"){ - FvL<- list(VfL) - }else{ - FvL<- VfL - } - EL<- list(); FL<- list() - for (Nn in Looprange(1,length(FvL))){ - Tmp<- FvL[[Nn]] - VL<- Tmp[[1]] - if (length(VL)>0){ - FnL<- Tmp[[2]] - FaceL<- list() - for (I in Looprange(1,length(FnL))){ - Tmp1<- FnL[[I]] - PtL<- list() - for (J in Looprange(1,length(Tmp1))){ - Tmp2<- Tmp1[[J]] - PtL[[J]]<- VL[[Tmp2]] - } - FaceL[[I]]<- PtL - } - }else{ - FaceL<- list(Tmp[[2]]) - } - for (I in Looprange(1,length(FaceL))){ - Face<- FaceL[[I]] - Face<- c(Face,list(Face[[1]])) - FL<- c(FL,list(Face)) - for (J in Looprange(1,length(Face)-1)){ - Edge<- list(Face[[J]],Face[[J+1]]) - Flg<- 0 - for (K in Looprange(1,length(EL))){ - Tmp<- EL[[K]] - Tmp1<- Tmp[[1]] - Tmp2<- Norm(Edge[[1]]-Tmp1[[1]])+Norm(Edge[[2]]-Tmp1[[2]]) - Tmp3<- Norm(Edge[[1]]-Tmp1[[2]])+Norm(Edge[[2]]-Tmp1[[1]]) - if (Tmp21-Eps){# // P3, Q3 are necessary - Flg<- I - break - } - if (abs(Te-Ts)>Eps0){ - if ((I%%2)==1){ - Out1<- c(Out1,list(list(Pe3,P3))) - }else{ - if (length(Qe3)==0){ - Tmp<- Op(2,TenL[[I-1]]) - if (Ptype==-1){ - Tmp1<- Invperspt(Tmp,Spaceline(Face)) - }else{ - Tmp1<- Invparapt(Tmp,Spaceline(Face)) - } - Qe3<- Tmp1[[1]] - } - PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) - if (Ptype==-1){ - Z1<- Zperspt(PM); Z2<- Zperspt(QM) - }else{ - Z1<- Zparapt(PM); Z2<- Zparapt(QM) - } - if (Z1>Z2){ - Out1<- c(Out1, list(list(Pe3,P3))) - }else{ - Out2<- c(Out2, list(list(Pe3,P3))) - }## - } - } - Te<- Ts; Pe3<- P3; Qe3<- Q3 - } - if (Flg==0){ - if (Norm(Pe3-Edge[[2]])>Eps0){ - Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) - } - }else{ - if ((Flg%%2)==1){ - Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) - }else{ - PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) - if (Ptype==-1){ - Z1<- Zperspt(PM); Z2<- Zperspt(QM) - }else{ - Z1<- Zparapt(PM); Z2<- Zparapt(QM) - } - if (Z1>Z2){ - Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) - }else{ - Out2<- c(Out2, list(list(Pe3,Edge[[2]]))) - } - } - } - for (I in Looprange(1,length(Out1))){ - Tmp<- Out1[[I]] - if (I==1){ - SeL<- Tmp - }else{ - if (Norm(SeL[[2]]-Tmp[[1]])0){ - Out1L<- c(Out1L, list(list(SeL,Ne,NNe))) - } - for (I in Looprange(1,length(Out2))){ - Tmp<- Out2[[I]] - if (I==1){ - SeL<- Tmp - }else{ - if (Norm(SeL[[2]]-Tmp[[1]])0){ - Out2L<- c(Out2L, list(list(SeL,Ne,NNe))) - } - } - VELNO<<- Out1L - VELHI<<- Out2L -} - -################################### - -Parapt<- function(P){ - x<- P[1] - y<- P[2] - z<- P[3] - Xz<- -x*sin(PHI)+y*cos(PHI) - Yz<- -x*cos(PHI)*cos(THETA)-y*sin(PHI)*cos(THETA)+z*sin(THETA) - Out<- c(Xz,Yz) - return(Out) -} - -################################### - -#100815 -Partcrv3<- function(T1,T2,Fk){ - Eps=10^(-4) -#// Tmp=Mixop(1,Fk) -#// new part from - if (T1>(T2+Eps)){ - Npt<- Nrow(Fk) - Out1<- Partcrv3(T1,Npt,Fk) - Out2<- Partcrv3(1,T2,Fk) - Tmp<- Fk[1,]-Fk[Npt,] - if (Norm(Tmp)(Ie+Eps)){ - P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,] - PL<- rbind(PL,P) - } - rownames(PL)<- 1:Nrow(PL) - return(PL) -} - -################################### - -#100815 -Partcrv3<- function(T1,T2,Fk){ - Eps=10^(-4) -#// Tmp=Mixop(1,Fk) -#// new part from - if (T1>(T2+Eps)){ - Npt<- Nrow(Fk) - Out1<- Partcrv3(T1,Npt,Fk) - Out2<- Partcrv3(1,T2,Fk) - Tmp<- Fk[1,]-Fk[Npt,] - if (Norm(Tmp)(Ie+Eps)){ - P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,] - PL<- rbind(PL,P) - } - rownames(PL)<- 1:Nrow(PL) - return(PL) -} - -################################### - -#100815 -Perspt<- function(P){ - Tmp<- P-FocusPoint - X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1];F1<- Tmp[2];G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb - E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb - Yz<- E3/(E3-X3)*Y3 - Zz<- E3/(E3-X3)*Z3 - Out<- c(Yz,Zz) - return(Out) -} - - -################################# - -Phcutdata<- function(VL,FaceL,PlaneD){ - Out<- list() - EL<- list() - Eps<- 10^(-4) - for (I in Looprange(1,Mixlength(FaceL))){ - Face<- Op(I,FaceL) - for (J in Looprange(1,length(Face))){ - Nj<- J+1 - if (J==length(Face)){ - Nj<- 1 - } - N1<- Face[J]; N2<- Face[Nj] - Tmp<- c(N1,N2) - Flg<- 0 - for (K in Looprange(1,Mixlength(EL))){ - Tmp1<- Op(K,EL) - Tmp2<- Tmp1[2:1] - if (all(Tmp==Tmp1) || all(Tmp==Tmp2)){ - Flg<- 1 - break - } - } - if (Flg==0){ - EL<- c(EL,list(Tmp)) - } - } - } - Out0<- list() - for (I in Looprange(1,Mixlength(EL))){ - Tmp<- Op(I,EL) - Tmp1<- Op(Tmp[1],VL) - Tmp2<- Op(Tmp[2],VL) - Out0<- c(Out0, list(Spaceline(Tmp1,Tmp2))) - } - if (Mixtype(PlaneD)!=1){ - V1<- Op(1,PlaneD) - Tmp<- Op(2,PlaneD) - if (length(Tmp)>1){ - d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] - }else{ - d<- Tmp - } - }else if (mode(PlaneD)=="numeric"){ - V1<- PlaneD[1:3] - d<- PlaneD[4] - }else{ - StrV<- strsplit(PlaneD,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Tmp1<- StrV[1] - Tmp2<- StrV[2] - PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") - } - x<- 0; y<- 0; z<- 0 - d<- -eval(parse(text=PlaneD)) - x<- 1; y<- 0; z<- 0; - Tmp1<- eval(parse(text=PlaneD))+d - x<- 0; y<- 1; z<- 0 - Tmp2<- eval(parse(text=PlaneD))+d - x<- 0; y<- 0; z<- 1 - Tmp3<- eval(parse(text=PlaneD))+d - V1<- c(Tmp1,Tmp2,Tmp3) - } - if (all(V1==c(0,0,0))){ - return(Out0) - } - V3<- c(1,0,0) - Out1<- Rotate3data(Out0,V1,V3) - Tmp2<- Rotate3pt(c(1,0,0),V3,V1) - Tmp<- V1[1]*Tmp2[1]+V1[2]*Tmp2[2]+V1[3]*Tmp2[3] - x0<- d/Tmp - PtL<- list() - for (I in Looprange(1,Mixlength(Out1))){ - Tmp<- Op(I,Out1) - Tmp1<- Tmp[1,]; Tmp2<- Tmp[2,] - P<- list(Tmp1,Tmp2-Tmp1) - Tmp<- list(Tmp1[1],Tmp2[1]-Tmp1[1]) - if (abs(Tmp[[2]]) < Eps){ - Tmp<- c() - }else{ - Tmp1<- Tmp[[2]] - Tmp2<- x0-Tmp[[1]] - Tmp<- c(Tmp2/Tmp1) - } - if (length(Tmp)>0){ - Tmp<- Tmp[1] - if (Tmp>-Eps && Tmp<(1+Eps)){ - Tmp3<- P[[1]]+Tmp*P[[2]] - Tmp3<- Rotate3pt(Tmp3,V3,V1) - if (Tmp1-Eps){ - Tmp1<- Op(I,EL) - Tmp1<- Tmp1[2] - Tmp4<- list(c(Tmp1,Tmp1),Tmp3) - }else{ - Tmp4<- list(Op(I,EL),Tmp3) - } - } - Flg<- 0 - for (J in Looprange(1,Mixlength(PtL))){ - Tmp<- Op(J,PtL) - Tmp<- Op(2,Tmp) - if (Norm(Tmp3-Tmp)1){ - d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] - }else{ - d<- Tmp - } - }else if (mode(PlaneD)=="numeric"){ - V1<- PlaneD[1:3] - d<- PlaneD[4] - }else{ - StrV<- strsplit(PlaneD,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Tmp1<- StrV[1] - Tmp2<- StrV[2] - PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") - } - x<- 0; y<- 0; z<- 0 - d<- -eval(parse(text=PlaneD)) - x<- 1; y<- 0; z<- 0 - Tmp1<- eval(parse(text=PlaneD))+d - x<- 0; y<- 1; z<- 0 - Tmp2<- eval(parse(text=PlaneD))+d - x<- 0; y<- 0; z<- 1 - Tmp3<- eval(parse(text=PlaneD))+d - V1<- c(Tmp1,Tmp2,Tmp3) - } - for (I in Looprange(1,Mixlength(FaceL))){ - Face<- Op(I,FaceL) - TmpL<- list() - for (J in Looprange(1,length(Face))){ - N1<- Face[J] - if (J==length(Face)){ - N2<- Face[1] - }else{ - N2<- Face[J+1] - } - for (K in Looprange(1,Mixlength(PtL))){ - Pd<- Op(K,PtL) - Tmp<- Op(1,Pd) - if (Tmp[1]==Tmp[2]){ - if (Tmp[1]==N1){ - TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) - } - }else{ - if (all(Tmp==c(N1,N2)) || all(Tmp==c(N2,N1))){ - TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) - } - } - } - } - if (Mixlength(TmpL)<2){ - Flg<- 0 - for (J in Looprange(1,length(Face))){ - Tmp<- Op(Face[J],VL) - Tmp1<- Fugou*(Dotprod(V1,Tmp)-d) - if (Tmp1< -Eps){ - Flg<- 1 - break - } - } - if (Flg==0){ - OutfL<- c(OutfL,list(Face)) - } - next - } - Pd<- Op(1,TmpL) - Qd<- Op(2,TmpL) - Outf1<- c(Op(3,Pd)) - Nf<- Op(1,Pd)+1 - Tmp<- Op(2,Pd) - JJ<- 0 - while (!all(Tmp==Op(2,Qd))){ - JJ<- JJ+1 - if (JJ>20){ - print("bug") - return() - } - Tmp1<- Tmp[2] - if (Outf1[length(Outf1)]!=Tmp1){ - Outf1<- c(Outf1,Tmp1) - } - Tmp<- c(Face[Nf]) - Nf<- Nf+1 - if (Nf>length(Face)){ - Nf<- 1 - } - Tmp<- c(Tmp,Face[Nf]) - } - Tmp1<- Op(3,Qd) - if (Outf1[length(Outf1)]!=Tmp1){ - Outf1<- c(Outf1,Tmp1) - } - Outf2<- c(Op(3,Pd)) - Nf<- Op(1,Pd) - Tmp<- Op(2,Pd) - JJ<- 0 - while (!all(Tmp==Op(2,Qd))){ - JJ<- JJ+1 - if (JJ>20){ - print("bug") - return() - } - Tmp1<- Tmp[1] - if (Outf2[length(Outf2)]!=Tmp1){ - Outf2<- c(Outf2,Tmp1) - } - Tmp<- c(Face[Nf]) - Nf<- Nf-1 - if (Nf<1){ - Nf<- length(Face) - } - Tmp<- c(Face[Nf],Tmp) - } - Tmp1<- Op(3,Qd) - if (Outf2[length(Outf2)]!=Tmp1){ - Outf2<- c(Outf2,Tmp1) - } - if (length(Outf1)<3 || length(Outf2)<3){ - Face<- Outf1 - if (length(Outf1)Eps){ - AnsL<- c(AnsL,Tmp) - } - } - } - else{ - AnsL<- c(AnsL,c(Inf,Inf)) - } - } - AnsL<- matrix(AnsL,ncol=2,byrow=TRUE) - return(AnsL) -} - -#################################### - -Projpara<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Flg<- 0 - if (Nargs==1 && Mixtype(varargin[[1]])==1){ - Flg<- 1 - } - CL<- list() - for (N in Looprange(1,Nargs)){ - Crv<- varargin[[N]] - if (Mixtype(Crv)==1){ - Tmp<- ProjCurve(Crv) - CL<- c(CL,list(Tmp)) - } - else{ - if (Mixtype(Crv)==3){ - ObjL<- list() - for (I in Looprange(1,Mixlength(Crv))){ - Tmp1<- Op(I,Crv) - if (Mixtype(Tmp1)==1){ - ObjL<- c(ObjL,list(Tmp1)) - } - else{ - ObjL<- c(ObjL,Tmp1) - } - } - Crv<- ObjL - } - for (J in Looprange(1,Mixlength(Crv))){ - Tmp<- ProjCurve(Op(J,Crv)) - CL<- c(CL,list(Tmp)) - } - } - } - if (Mixlength(CL)==1 && Flg==1){ - CL<- Op(1,CL) - } - return(CL) -} - -######################### - -#100816 -Projpers<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Flg<- 0 - if (Nargs==1 && Mixtype(varargin[[1]])==1){ - Flg<- 1 - } - CL<- list() - for (N in Looprange(1,Nargs)){ - Crv<- varargin[[N]] - if (Mixtype(Crv)==1){ - Tmp<- CameraCurve(Crv) - CL<- c(CL,list(Tmp)) - }else{ - if (Mixtype(Crv)==3){ - ObjL<- list() - for (I in Looprange(1,Mixlength(Crv))){ - Tmp1<- Op(I,Crv) - if (Mixtype(Tmp1)==1){ - ObjL<- c(ObjL,list(Tmp1)) - }else{ - ObjL<- c(ObjL,Tmp1) - } - } - Crv<- ObjL - } - for (J in Looprange(1,Mixlength(Crv))){ - Tmp<- CameraCurve(Op(J,Crv)) - CL<- c(CL,list(Tmp)) - } - } - } - if (Mixlength(CL)==1 && Flg==1){ - CL<- Op(1,CL) - } - return(CL) -} - -######################################### -# 11.08.27 -# 14.03.23 Debugged "center" - -Rotate3data<- function(...){ -#Eps=10^(-4) - varargin<-list(...) - Nargs<- length(varargin) - Pd3<- varargin[[1]] - W1<- varargin[[2]] - W2<- varargin[[3]] - C<- c(0,0,0) - if (Nargs>=4){ - C<- varargin[[4]] - } - if (Mixtype(Pd3)==1){ - Pd3<- list(Pd3) - } else if (Mixtype(Pd3)==3){ - Tmp<- list() - for (I in Looprange(1,Mixlength(Pd3))){ - Tmp<- c(Tmp,Op(I,Pd3)) - } - Pd3<- Tmp - } - Out<- list() - for (I in Looprange(1,Mixlength(Pd3))){ - PD<- Op(I,Pd3) - Ans<- c() - for (J in Looprange(1,Nrow(PD))){ - if(is.matrix(PD)){ # 11.08.27 - P<- PD[J,] - } - else{ - P<- PD - } - Tmp<- Rotate3pt(P,W1,W2,C) # 14.03.23 - Ans<- rbind(Ans,Tmp) - } # 11.08.27 - rownames(Ans)<- 1:Nrow(Ans) #10.08.16 - Out<- c(Out,list(Ans)) - } - if (Mixlength(Out)==1){ - Out<- Op(1,Out) - } - return(Out) -} - -####################################### - -Rotate3pt<- function(...){ - varargin<-list(...) - Eps<-10^(-4) - Nargs<-length(varargin) - P<- varargin[[1]] - W1<- varargin[[2]] - W2<- varargin[[3]] - C<- c(0,0,0) - if (Nargs>=4){ - C<- varargin[[4]] - } - if (mode(W2)=="numeric" && length(W2)==1){ - Ct<- cos(W2) - St<- sin(W2) - V3<- 1/Norm(W1)*W1 - if (V3[1]==0){ - Tmp<- c(1,0,0) - }else{ - Tmp<- c(0,1,0) - } - W1<- c(Tmp[2]*V3[3]-Tmp[3]*V3[2], - Tmp[3]*V3[1]-Tmp[1]*V3[3], - Tmp[1]*V3[2]-Tmp[2]*V3[1]) - V1<- 1/Norm(W1)*W1 - V2<- c(V3[2]*V1[3]-V3[3]*V1[2], - V3[3]*V1[1]-V3[1]*V1[3], - V3[1]*V1[2]-V3[2]*V1[1]) - }else{ - Tmp<- c(W1[2]*W2[3]-W1[3]*W2[2], - W1[3]*W2[1]-W1[1]*W2[3], - W1[1]*W2[2]-W1[2]*W2[1]) - if (Norm(Tmp)=3){ - Ndu<- varargin[[2]] - Ndv<- varargin[[3]] - } - if (Nargs>=4){ - Np<- varargin[[4]] - if (mode(Np)=="numeric" && length(Np)==1){ - Np<- c(Np,Np) - } - } - Du<- (Umax-Umin)/Ndu - Dv<- (Vmax-Vmin)/Ndv - PL <- c()#PL <- [] - Assign("Vmin",Vmin,"Vmax",Vmax) - Trgstr<- Assign("t=c(Vmin,Vmax)") - PL <- list() - for (I in Looprange(0,Ndu)){ - U0 <- paste("(",as.character(Umin+I*Du),")",sep="") - Tmp<- gsub(U,U0,Xf,fixed=TRUE) - Tmp1<- gsub(V,"t",Tmp,fixed=TRUE) - Tmp<- gsub(U,U0,Yf,fixed=TRUE) - Tmp2<- gsub(V,"t",Tmp,fixed=TRUE) - Tmp<- gsub(U,U0,Zf,fixed=TRUE) - Tmp3<- gsub(V,"t",Tmp,fixed=TRUE) - Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")",sep="") - PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[2]))) - PL<- c(PL,list(PD)) - } - Assign("Umin",Umin,"Umax",Umax) - Trgstr<- Assign("t=c(Umin,Umax)") - for (J in Looprange(0,Ndv)){ - V0<- paste("(",as.character(Vmin+J*Dv),")",sep="") - Tmp<- gsub(V,V0,Xf,fixed=TRUE) - Tmp1<- gsub(U,"t",Tmp,fixed=TRUE) - Tmp<- gsub(V,V0,Yf,fixed=TRUE) - Tmp2<- gsub(U,"t",Tmp,fixed=TRUE) - Tmp<- gsub(V,V0,Zf,fixed=TRUE) - Tmp3<- gsub(U,"t",Tmp,fixed=TRUE) - Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")") - PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[1]))) - PL<- c(PL,list(PD)) - } - return(PL) -} - -################################### - -Skeletonparadata<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Out<- list() - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if (Nargs>2){ - R<- R*varargin[[3]] - } - Eps2<- 0.05 - if (Nargs>3){ - Eps2<- varargin[[4]] - } - Obj2L<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Tmp<- ProjcoordCurve(Op(I,ObjL)) - Obj2L<- c(Obj2L,list(Tmp)) - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- ProjcoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- Makeskeletondata(Obj2L,Plt2L,R,Eps2) - return(Out) -} - -################################ - -Skeletonpara3data<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if (Nargs>2){ - R=R*varargin[[3]] - } - Eps2<- 0.05 - if (Nargs>3){ - Eps2<- varargin[[4]] - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- ProjcoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Obj3<- Op(I,ObjL) - Tmp<- ProjcoordCurve(Obj3) - Data<- Makeskeletondata(list(Tmp),Plt2L,R,Eps2) - for (J in Looprange(1,Mixlength(Data))){ - Gd<- Op(J,Data) - PtD<- c() - for (J in Looprange(1,Nrow(Gd))){ - Tmp<- Ptcrv(J,Gd) - Tmp1<- Invparapt(Tmp,Obj3) - Tmp1<- Op(1,Tmp1) - PtD<- c(PtD,Tmp1) - } - PtD<- matrix(PtD,ncol=3,byrow=TRUE) - Out<- c(Out,list(PtD)) - } - } - return(Out) -} - -################################# - -#100815 -Skeletonpersdata<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Out<- list() - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if (Nargs>2){ - R<- R*varargin[[3]] - } - Eps2<- 0.05 - if (Nargs>3){ - Eps2<- varargin[[4]] - } - Obj2L<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Tmp<- CameracoordCurve(Op(I,ObjL)) - Obj2L<- c(Obj2L,list(Tmp)) - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- CameracoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- Makeskeletonpersdata(Obj2L,Plt2L,R,Eps2) - return(Out) -} - -##################### -#100815 -Skeletonpers3data<- function(...){ - varargin<-list(...) - Nargs<- length(varargin) - Out<- list() - ObjL<- Flattenlist(varargin[[1]]) - Plt3L<- Flattenlist(varargin[[2]]) - R<- 0.075*1000/2.54/MilliIn - if (Nargs>2){ - R<- R*varargin[[3]] - } - Eps2<- 0.05 - if (Nargs>3){ - Eps2<- varargin[[4]] - } - Plt2L<- list() - for (I in Looprange(1,Mixlength(Plt3L))){ - Tmp<- CameracoordCurve(Op(I,Plt3L)) - Plt2L<- c(Plt2L,list(Tmp)) - } - Out<- list() - for (I in Looprange(1,Mixlength(ObjL))){ - Obj3<- Op(I,ObjL) - Tmp<- CameracoordCurve(Obj3) - Data<- Makeskeletonpersdata(list(Tmp),Plt2L,R,Eps2) - for (J in Looprange(1,Mixlength(Data))){ - Gd<- Op(J,Data) - PtD<- c() - for (J in Looprange(1,Nrow(Gd))){ - Tmp<- Gd[J,] - Tmp1<- Invperspt(Tmp,Obj3) - Tmp1<- Op(1,Tmp1) - PtD<- rbind(PtD,Tmp1) - } - Out<- c(Out,list(PtD)) - } - } - return(Out) -} - -################################# - -Spacecurve<- function(...){ - Eps<- 10^(-5) - varargin<-list(...) - Nargs<- length(varargin) - Fnstr<- varargin[[1]] - Rgstr<- varargin[[2]] - Range<- c(0,2*pi) - N<- 50 #Numpoints - E<- c() #Exclusions - D<- Inf #Discont (Changed) - for(I in Looprange(3,Nargs)){ - Tmp<- varargin[[I]] - StrV<- strsplit(Tmp,"=",fixed=TRUE) - StrV<- StrV[[1]] - Tmp1<- toupper(StrV[1]) - Lhs<- substr(Tmp1,1,1) - Str<- paste(Lhs,"=",StrV[2],sep="") - eval(parse(text=Str)) - } - StrV<- strsplit(Rgstr,"=",fixed=TRUE) - StrV<- StrV[[1]] - if (length(StrV)>1){ - Vname<- StrV[1] - Rng<- eval(parse(text=StrV[2])) - } - else{ - Vname<- Rgstr - Rng<- c(XMIN,XMAX) - } - T1<- Rng[1]; T2<- Rng[2] - Dt<- (T2-T1)/N #17.09.22 - Str<- gsub(Vname,"t",Fnstr) - Str=gsub("[","c(",Str,fixed=TRUE) #17.12.22(2lines) - Str=gsub("]",")",Str,fixed=TRUE) - if(abs(Dt)0 && P[Nrow(P),1]!=Inf){ - Pa<- c(Inf,Inf,Inf) - } - } - if (t-E[Ke]>Eps){ - Pa<- eval(parse(text=Str)) - Ke<- Ke+1 - } - if (length(Pa)>0){ - if (Pa[1]==Inf){ - P<- rbind(P,Pa) - }else if (length(P)==0){ - P<- rbind(c(),c(Pa)) - } - else{ - Tmp<- P[Nrow(P),] - if (Tmp[1]==Inf){ - P<- rbind(P,Pa) - } - else if( Norm(Tmp-Pa)1) StrV<- StrV[2] - Tmp<- eval(parse(text=StrV)) - Py<- c(0,Tmp[1],0) - Qy<- c(0,Tmp[2],0) - StrV<-strsplit(Zrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1) StrV<- StrV[2] - Tmp<- eval(parse(text=StrV)) - Pz<- c(0,0,Tmp[1]) - Qz<- c(0,0,Tmp[2]) - Out<- list(Spaceline(Px,Qx),Spaceline(Py,Qy),Spaceline(Pz,Qz)) - return(Out) -} - -################################### - -Xyzaxparaname<- function(...){ - varargin<- list(...) - Nargs<- length(varargin) - Eps<- 10.0^(-6) - Dr<- 0.19*1000/2.54/MilliIn - Tmp<- varargin[[Nargs]] - if (Nargs>1 && is.numeric(Tmp)){ - Dr<- Dr*Tmp - Nargs<- Nargs-1 - } - if (mode(varargin[[1]])=="character"){ - Xname<- "x" - Yname<- "y" - Zname<- "z" - Xrange<- varargin[[1]] - Yrange<- varargin[[2]] - Zrange<- varargin[[3]] - StrV<-strsplit(Xrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Xname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Px<- c(Tmp[1],0,0) - Qx<- c(Tmp[2],0,0) - StrV<-strsplit(Yrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Yname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Py<- c(0,Tmp[1],0) - Qy<- c(0,Tmp[2],0) - StrV<-strsplit(Zrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Zname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Pz<- c(0,0,Tmp[1]) - Qz<- c(0,0,Tmp[2]) - }else{ - Data<- varargin[[1]] - Xname<- "x"; Yname<- "y"; Zname<- "z" - if (Nargs>1){ - if (varargin[[2]]!=""){ - Xname<- varargin[[2]] - } - if (varargin[[3]]!=""){ - Yname<- varargin[[3]] - } - if (varargin[[4]]!=""){ - Zname<- varargin[[4]] - } - } - Tmp<- Op(1,Data) - Px<- Tmp[1,]; Qx<- Tmp[2,] - Tmp<- Op(2,Data) - Py<- Tmp[1,] - Qy<- Tmp[2,] - Tmp<- Op(3,Data) - Pz<- Tmp[1,] - Qz<- Tmp[2,] - } - Ph<- Parapt(Px); Qh<- Parapt(Qx); R<-Norm(Ph-Qh) - Kekka<- list() - if (R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Xname) - } - Ph<- Parapt(Py); Qh<- Parapt(Qy); R<- Norm(Ph-Qh) - if (R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Yname) - } - Ph<- Parapt(Pz); Qh<- Parapt(Qz); R<- Norm(Ph-Qh) - if (R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Zname) - } -# return(Kekka) -} - -################################### - -Xyzaxpersname<- function(...){ - varargin<- list(...) - Eps<- 10.0^(-6) - Nargs<- length(varargin) - Dr<- 0.19*1000/2.54/MilliIn - Tmp<- varargin[[Nargs]] - if (Nargs>1 && mode(Tmp)=="numeric"){ - Dr<- Dr*Tmp - Nargs<- Nargs-1 - } - if (mode(varargin[[1]])=="character"){ - Xname<- "x" - Yname<- "y" - Zname<- "z" - Xrange<- varargin[[1]] - Yrange<- varargin[[2]] - Zrange<- varargin[[3]] - StrV<-strsplit(Xrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Xname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Px<- c(Tmp[1],0,0) - Qx<- c(Tmp[2],0,0) - StrV<-strsplit(Yrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Yname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Py<- c(0,Tmp[1],0) - Qy<- c(0,Tmp[2],0) - StrV<-strsplit(Zrange,"=",fixed=TRUE) - StrV<- StrV[[1]] - if(length(StrV)>1){ - Zname<- StrV[1] - StrV<- StrV[2] - } - Tmp<- eval(parse(text=StrV)) - Pz<- c(0,0,Tmp[1]) - Qz<- c(0,0,Tmp[2]) - }else{ - Data<- varargin[[1]] - Xname<- "x"; Yname<- "y"; Zname<- "z" - if (Nargs>1){ - if (varargin[[2]]!=""){ - Xname<- varargin[[2]] - } - if (varargin[[3]]!=""){ - Yname<- varargin[[3]] - } - if (varargin[[4]]!=""){ - Zname<- varargin[[4]] - } - } - Tmp<- Op(1,Data) - Px<- Tmp[1,]; Qx<- Tmp[2,] - Tmp<- Op(2,Data) - Py<- Tmp[1,] - Qy<- Tmp[2,] - Tmp<- Op(3,Data) - Pz<- Tmp[1,] - Qz<- Tmp[2,] - } - Ph<- Perspt(Px) - Qh<- Perspt(Qx) - R<- Norm(Ph-Qh) - Kekka<- list() - if (R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Xname) - } - Ph<- Perspt(Py) - Qh<- Perspt(Qy) - R<- Norm(Ph-Qh) - if (R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Yname) - } - Ph<- Perspt(Pz) - Qh<- Perspt(Qz) - R<- Norm(Ph-Qh) - if (R>Eps){ - Ch<- Qh+Dr/R*(Qh-Ph) - Kekka<- c(Kekka,list(Pointdata(Ch))) - Expr(Ch,"c",Zname) - } -# return(Kekka) -} - -######################### -#100815 -Zparapt<- function(P){#function Out=Zparapt(P) - x<- P[1]; y<- P[2]; z<- P[3] - Out<- x*cos(PHI)*sin(THETA)+y*sin(PHI)*sin(THETA)+z*cos(THETA) - return(Out) -} - -######################### -#100815 -Zperspt<- function(P){ - Tmp<- P-FocusPoint - X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] - Tmp<- EyePoint-FocusPoint - E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] - Ca<- E1/sqrt(E1^2+F1^2) - Sa<- F1/sqrt(E1^2+F1^2) - X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 - E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 - Cb<- E2/sqrt(E2^2+G2^2) - Sb<- G2/sqrt(E2^2+G2^2) - X3<- X2*Cb+Z2*Sb - return(X3) -} - -########################################## - - - -########################################## - -# Stat Package - -########################################## - -# 2010.04.12 - -# new - -# Htickmarklower, Vtickmarkleft, HtickmarklowerV -# VtickmarkleftV, Insertcom, Replacecom -# Maketexfile, Formatting -# Drwhistframe, Histplotdata, Drwhistplot - -Htickmarklower<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if (mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if (K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if (is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if (J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if (is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if (is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if (I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if (I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if (mode(Dt)=="numeric" && length(Dt)>1){ - if (length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt) - next - } - if (mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if (length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt,GENTEN[2]) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X,Y)) - Tmp2<- Unscaling(c(X,Y-2*MARKLEN)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if (Ndt==3){ - Tmp<-Unscaling(c(X,Y-2*MARKLEN)) - Expr(Tmp,"s",Moji) - } - if (Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("s",Houkou) - if (length(Tmp)>0){ - Tmp<-Unscaling(c(X,Y-2*MARKLEN)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X,Y)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -Vtickmarkleft<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - ArgsL<- varargin - if (mode(ArgsL[[1]])=="character"){ - Str<- ArgsL[[1]] - Tmp<- strsplit(Str,"m") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - I<- nchar(Tmp[1])+1 - } - else{ - I<- 0 - } - Tmp<- strsplit(Str,"n") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - J<- nchar(Tmp[1])+1 - } - else{ - J<- 0 - } - Tmp<- strsplit(Str,"r") - Tmp<- Tmp[[1]] - if (length(Tmp)>1){ - K=nchar(Tmp[1])+1 - } - else{ - K<- 0 - } - if (K>0){ - S<- substr(Str,K+1,nchar(Str)) - R<- as.numeric(S) - if (is.na(R)){ - R<- 1 - } - } - else{ - R<- 1 - K<- nchar(Str)+1 - } - if (J>0){ - S<- substr(Str,J+1,K-1) - Dn<- as.numeric(S) - if (is.na(Dn)){ - Dn<- 1 - } - } - else{ - Dn<- 1000 - J<- nchar(Str)+1 - } - S<- substr(Str,I+1,J-1) - Dm<- as.numeric(S) - if (is.na(Dm)){ - Dm<- 1 - } - ArgsL<- list() - for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if (I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ - ArgsL<- Mixjoin(ArgsL,I*Dm) - if (I-floor(I/Dn)*Dn==0){ - Str<- as.character(I*Dm*R) - ArgsL<- Mixjoin(ArgsL,Str) - } - } - } - MemoriList<- list() - Memori<- list() - for (N in 1:length(ArgsL)){ - Dt<- ArgsL[[N]] - if (mode(Dt)=="numeric" && length(Dt)>1){ - if (length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(Dt) - next - } - if (mode(Dt)=="character"){ - Memori<- Mixjoin(Memori,Dt) - } - else{ - if (length(Memori)>0){ - MemoriList<- Mixjoin(MemoriList,list(Memori)) - } - Memori<- list(GENTEN[1],Dt) - } - } - MemoriList<- Mixjoin(MemoriList,list(Memori)) - for (N in 1:length(MemoriList)){ - Dt<- MemoriList[[N]] - Ndt<- length(Dt) - X=Op(1,Dt) - Y=Op(2,Dt) - Tmp<-Doscaling(c(X,Y)) - X<- Tmp[1] - Y<- Tmp[2] - Moji<- Op(Ndt,Dt) - Tmp1<- Unscaling(c(X,Y)) - Tmp2<- Unscaling(c(X-2*MARKLEN,Y)) - Fd<- Listplot(c(Tmp1,Tmp2)) - Drwline(Fd) - if (Ndt==3){ - Tmp<-Unscaling(c(X-2*MARKLEN,Y)) - Expr(Tmp,"w",Moji) - } - if (Ndt==4){ - Houkou<- Op(3,Dt) - Tmp<-grep("w",Houkou) - if (length(Tmp)>0){ - Tmp<-Unscaling(c(X-2*MARKLEN,Y)) - Expr(Tmp,Houkou,Moji) - } - else{ - Tmp<- Unscaling(c(X,Y)) - Expr(Tmp,Houkou,Moji) - } - } - cat("%\n",file=Wfile,append=TRUE) - } -} - -HtickmarklowerV<- function(Vec,digits=2,nsmall=2) -{ - for (I in 1:length(Vec)){ - Tmp<- Vec[I] - Htickmarklower(Tmp, Formatting(Tmp,digits,nsmall)) - } -} - -HtickLV<- function(...) -{ - HtickmarklowerV(...) -} - -VtickmarkleftV<- function(Vec,digits=2,nsmall=2) -{ - for (I in 1:length(Vec)){ - Tmp<- Vec[I] - Vtickmarkleft(Tmp, Formatting(Tmp,digits,nsmall)) - } -} - -VtickLV<- function(...) -{ - VtickmarkleftV(...) -} - -Insertcom<- function(CmdM,Npos,Str) -{ - if (is.matrix(CmdM)){ - Cmd<- CmdM - } - else{ - C<- paste("Cmd<- ",CmdM) - eval(parse(text=C)) - } - Out<- Cmd[Looprange(1,Npos-1),] - Out<- c(Out,Str) - Tmp<- Cmd[Looprange(Npos,nrow(Cmd)),] - Out<- c(Out,Tmp) - Out<- matrix(Out) - if (!is.matrix(CmdM)){ - C<- paste(CmdM,"<<- Out") - eval(parse(text=C)) - } - return(Out) -} - -Replacecom<- function(CmdM,Npos,Str) -{ - if (is.matrix(CmdM)){ - Cmd<- CmdM - } - else{ - C<- paste("Cmd<- ",CmdM) - eval(parse(text=C)) - } - Out<- Cmd[Looprange(1,Npos-1),] - Out<- c(Out,Str) - Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] - Out<- c(Out,Tmp) - Out<- matrix(Out) - if (!is.matrix(CmdM)){ - C<- paste(CmdM,"<<- Out") - eval(parse(text=C)) - } - return(Out) -} - -Deletecom<- function(CmdM,Npos) -{ - if (is.matrix(CmdM)){ - Cmd<- CmdM - } - else{ - C<- paste("Cmd<- ",CmdM) - eval(parse(text=C)) - } - Out<- Cmd[Looprange(1,Npos-1),] - Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] - Out<- c(Out,Tmp) - Out<- matrix(Out) - if (!is.matrix(CmdM)){ - C<- paste(CmdM,"<<- Out") - eval(parse(text=C)) - } - return(Out) -} - -Maketexfile<- function(commands="",texfile="") -{ - Openfile(texfile) - Execmd(commands) - Closefile() -} - -Formatting<- function(X,D=2,N=2) -{ - if (D>0){ - Xs <- format(X,digits=D,nsmall=N) - } - else{ - Xs<- as.character(X) - } - return(Xs) -} - -################################ - -Boxplotdata1 <-function(DataF1,CenterX,Width,...) -{ - Xr <- Width - Temp <- boxplot(DataF1[1],plot=FALSE) - Stats <- Temp$stats - rownames(Stats) <- c("Lhige","Q1","Q2","Q3","Uhige") - Out <- Temp$out - Lhige <- Stats["Lhige",1] - Uhige <- Stats["Uhige",1] - Q1 <- Stats["Q1",1] - Q2 <- Stats["Q2",1] - Q3 <- Stats["Q3",1] - CenterY <- (Q1+Q3)/2 - C <- c(CenterX,CenterY) - V <- c(0,(Q3-Q1)/2) - G1 <- Framedata(C,Xr/2,V[2]) # box - Temp1 <- c(0,Q1-Lhige) - Temp2 <- c(0,Uhige-Q3) - G2 <- Listplot(C-V,C-V-Temp1) # - G3 <- Listplot(C+V,C+V+Temp2) # - Temp3 <- c(Xr/4,0) - G4 <- Listplot(C-V-Temp1-Temp3,C-V-Temp1+Temp3) # - G5 <- Listplot(C+V+Temp2-Temp3,C+V+Temp2+Temp3) # - Temp4 <- c(0,Q3-Q2) - Temp5 <- c(Xr/2,0) - G6 <- Listplot(C+V-Temp4-Temp5,C+V-Temp4+Temp5) # - G7 <- list() - for(j in Looprange(1,length(Out))){ - G7 <- c(G7,list(c(CenterX, Out[j]))) - } - G7 <- G7[order(Out,decreasing=TRUE)] - list(median=G6,box=G1,uwhisker=G2,lwhisker=G3,lwp=G4,uwp=G5,outliers=G7) -} - -Boxplotdata2 <- function(Data,Ratio, ...) -{ - DataF<- Flattenlist(Data) # 11.07.21(from) - ymin<- Inf - ymax<- -Inf - for(J in 1:length(DataF)){ - Tmp<- DataF[[J]] - ymin<- min(ymin, min(Tmp)) - ymax<- max(ymax,max(Tmp)) - } # 11.07.21(upto) - dy <- ymax-ymin - Setwindow(c(0,XMAX-XMIN),c(ymin-0.1*dy,ymax+0.1*dy)) - R1<- (YMAX-YMIN)/(XMAX-XMIN) - R<- Ratio/R1 - Setscaling(R) - Delta <- XMAX/length(DataF) - W <- 0.6*Delta - PdL <- list() - for(i in 1:length(DataF)){ # 11.07.21 - X <- (0.5+i-1)*Delta - G <- Boxplotdata1(DataF[i],X,W,...) - PdL <- c(PdL,list(G)) - } - G <- Framedata() - Tmp<- list(frame=G) - PdL <-c(PdL,list(Tmp)) - Epsi <-0 - Setwindow(c(XMIN-Epsi,XMAX+Epsi),c(YMIN-Epsi,YMAX+Epsi)) - return(PdL) -} - -Drwboxframe<-function(BoxDataL) -{ - Setorigin(c(XMIN,YMIN)) - Tmp<- Unscaling(c(0.2,0.2)) - Setwindow(c(XMIN-0.2,XMAX),c(YMIN-Tmp[2],YMAX)) - Hako<- BoxDataL$plotdata - title<- BoxDataL$title - cap<- BoxDataL$cap - ylab<- BoxDataL$ylab - if(mode(title)!="list") title<- list(title) - if(mode(cap)!="list") cap<- list(cap) - if(mode(ylab)!="list") ylab<- list(ylab) - if(length(title)==0) title<- list("") - if(length(title)==1) title<- c(title, list("n")) - if(length(title)==2) title<- c(title, list("")) - if(length(cap)==0) cap<- list("") - if(length(cap)==1) cap<- c(cap, list("n"),0) # 11.11.27 - if(length(cap)==2) cap<- c(cap, 0) # 11.11.27 - if(length(ylab)==0) ylab<- list("") - if(length(ylab)==1) ylab <- c(ylab, list("n")) - if(length(ylab)==2) ylab<- c(ylab, list("")) - Temp <- Hako[[length(Hako)]] - Drwline(Temp$frame) - Fontsize(cap[[2]]) - for(i in Looprange(1,length(Hako)-1)){ - Temp <- Hako[[i]] - attach(Temp) - Dashline(uwhisker,lwhisker) - Drwline(median,2) - Drwline(box,lwp,uwp) - Drwpt(outliers,0) - X <- uwhisker[1,1] - detach(Temp) - Htickmarklower(X) - if(nchar(cap[[1]])<1) next # 2011.03.08 - if(length(cap)==2 || cap[[3]]==0){ - pos<- 1 - if(length(cap)>=4) pos<- cap[[4]] - Tmp<- paste("s",as.character(pos),sep="") - Letter(c(X,YMIN),Tmp, Op(i,cap[[1]])) - } - else{ - rotate<- cap[[3]] - if(length(cap)==3){ - pos<- 0 - } - else{ - pos<- cap[[4]] - } - Temp1 <- rotate*pi/180 - Temp <- c(cos(Temp1),sin(Temp1)) - Letterrot(c(X,YMIN-pos),Temp,Op(i,cap[[1]])) - } - } - if(nchar(ylab[[1]])>0){ - Fontsize(ylab[[2]]) - Tmp1<- ylab[[1]] - Tmp3<- ylab[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Letter(c(XMIN, YMAX),"n2",Tmp1) - Fontsize("n") - } - if(nchar(title[[1]])>0){ - Fontsize(title[[2]]) - Tmp1<- title[[1]] - Tmp3<- title[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) - } - Fontsize("n") -} - -Drwboxplot<- function(dataf,var,size, - title=list(""), cap=list(colnames(dataf)), - ylab=list(""), ptsize=5,plot=TRUE,...) - #Return : title,cap,ylab,commands,plotdata,info -{ - Tmp <- boxplot(dataf, plot=FALSE, ...) - Stats <- Tmp$stats - DataF<- Flattenlist(dataf) # 11.07.21(from) - ymin<- Inf - ymax<- -Inf - for(J in 1:length(DataF)){ - Tmp<- DataF[[J]] - ymin<- min(ymin, min(Tmp)) - ymax<- max(ymax,max(Tmp)) - } # 11.07.21(upto) - Hako<- Boxplotdata2(dataf, size[2]/size[1], ...) - if(plot){ - Windisp(Hako) - } - Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) - unit<- paste(Tmp,"cm",sep="") - Setunitlen(unit) - Exstr<- c( - "","", - paste("Beginpicture(","'",unit,"')",sep=""), - paste("Setpt(",as.character(ptsize),")",sep=""), - "","", - paste("Drwboxframe(",var,")",sep=""), - paste("VtickLV(c(",as.character(ymin),",", as.character(ymax),"),0,0)",sep=""), - "","","","", - "Setpt(1)", - "Endpicture(0)" - ) - Exstr<- matrix(Exstr) - Xpos<- c() - for(i in Looprange(1,length(Hako)-1)){ - Temp <- Hako[[i]] - Temp1 <- Temp[[5]] - Xpos <- c(Xpos,Temp1[1,1]) - } - Info<- list(stats=Stats,window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2),xpos=Xpos) - Tmp<- paste(var,"<<- ", - "list(title=title,cap=cap,ylab=ylab,", - "commands=Exstr,plotdata=Hako,info=Info)",sep="") - eval(parse(text=Tmp)) -} - - -########################################### - -Histplotdata <- function(DataV,Ratio,freq=TRUE,densplot=FALSE,...) -# 10.12.07 freq -{ - Temp <- hist(DataV,plot=FALSE,...) - Breaks <- Temp$breaks - Counts <- Temp$counts - Density <- Temp$density - Mids <- Temp$mids - if (!freq){ - Data<- Density - } - else{ - Data<- Counts - } - Ghist <- list() - for(i in Looprange(1,length(Breaks)-1)){ - Tmp1 <- c(Breaks[i],Breaks[i+1]) - Tmp2 <- c(0,Data[i]) - G1 <- Framedata(Tmp1,Tmp2) #bar - Ghist <- c(Ghist,list(G1)) - } - Bin <- Breaks[2]-Breaks[1] - Eps <- 0.7*Bin # 0.7 times Bin - Temp1 <- c(min(Breaks)-Eps,max(Breaks)+Eps) # Put Eps at both sides - Temp2 <- c(0,max(Data)*1.02) - Setwindow(Temp1,Temp2) - Setorigin(c(Temp1[1],0)) - R1<- (YMAX-YMIN)/(XMAX-XMIN) - R<- Ratio/R1 - Setscaling(R) - VEps <- 0.05*(XMAX-XMIN)/5 - Temp1<- Temp1-c(VEps,0) - Temp2<- Temp2-1/R*c(VEps,0) - Setwindow(Temp1,Temp2) - Fpt <- c(Mids[1]-Bin,0) - Lpt <- c(Mids[length(Mids)]+Bin,0) - Fp <- matrix(Fpt,nrow=1) - for(i in Looprange(1,length(Mids))){ - Tmp <- c(Mids[i],Data[i]) - Fp <- rbind(Fp,Tmp) - } - Fp <- rbind(Fp,Lpt) - rownames(Fp)<- c(1:nrow(Fp)) - if(densplot){ - Temp <- density(DataV) - X <- matrix(Temp$x) - Y <- matrix(Temp$y) - Gdens <- cbind(X,Y) - } - else{ - Gdens <- list() - } - list(plotdata=list(histplot=Ghist,fpplot=list(Fp),densityplot=list(Gdens)), - breaks=Breaks,counts=Counts,density=Density,mids=Mids) -} - -Drwhistframe<-function(HistDataL) -{ - title<- HistDataL$title - xlab<- HistDataL$xlab - ylab<- HistDataL$ylab - if(mode(title)!="list") title<- list(title) - if(mode(xlab)!="list") cap<- list(xlab) - if(mode(ylab)!="list") cap<- list(ylab) - if(length(title)==0) title<- list("") - if(length(title)==1) title<- c(title, list("n")) - if(length(title)==2) title<- c(title, list("")) - if(length(xlab)==0) xlab<- list("") - if(length(xlab)==1) xlab<- c(xlab, list("n")) - if(length(xlab)==2) xlab<- c(xlab, list("")) - if(length(xlab)==3) xlab<- c(xlab, list(8)) - if(length(ylab)==0) ylab<- list("") - if(length(ylab)==1) ylab<- c(ylab, list("n")) - if(length(ylab)==2) ylab<- c(ylab, list("")) - if(nchar(title[[1]])>0){ - Fontsize(title[[2]]) - Tmp1<- title[[1]] - Tmp3<- title[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) - Fontsize("n") - } - if(nchar(xlab[[1]])>0){ - Fontsize(xlab[[2]]) - Tmp1<- xlab[[1]] - Tmp3<- xlab[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Tmp4<- paste("s",as.character(xlab[[4]]),sep="") - Letter(c((XMIN+XMAX)/2,YMIN),Tmp4,Tmp1) - Fontsize("n") - } - if(nchar(ylab[[1]])>0){ - Fontsize(ylab[[2]]) - Tmp1<- ylab[[1]] - Tmp3<- ylab[[3]] - if(nchar(Tmp3)>0){ - Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") - } - Tmp<- Setorigin() - Letter(c(Tmp[1], YMAX),"n2",Tmp1) - Fontsize("n") - } - - Setax(2," ") - Setax(4," ") - Setax(6," ") -} - -Drwhistplot<- function(datav,var,size,freq=TRUE, - title=list(""), xlab=list(""), ylab=list(""), - plot=TRUE,densplot=FALSE,fpplot=TRUE,...) - #Output : title,xlab,ylab,commands,plotdata,info -{ - H <- Histplotdata(datav, size[2]/size[1], freq=freq,densplot=densplot,...) - Pd<- H$plotdata - Ghist <- list(histplot=Pd$histplot,densityplot=Pd$densityplot) # 10.12.07 - if(fpplot){ - Ghist<- c(Ghist,list(fpplot=Pd$fpplot)) - } - if(plot){ - Windisp(Ghist) - } - Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) - unit<- paste(Tmp,"cm",sep="") - Setunitlen(unit) - Infostr<- paste(var,"$info",sep="") - Brkstr<- paste(Infostr,"$breaks",sep="") - Midstr<- paste(Infostr,"$mids",sep="") - if (!freq){ - Digits<- ",2,2" - Denstr<- paste(Infostr,"$density",sep="") - } - else{ - Digits<- ",0,0" - Denstr<- paste(Infostr,"$counts",sep="") - } - - if (fpplot) Prefp<- "" else Prefp<- "#" - Exstr<- c( - "","", - paste("Beginpicture(","'",unit,"')",sep=""), - "","", - paste("Drwhistframe(",var,")",sep=""), - paste("HtickLV(",Midstr,",1,1)",sep=""), - paste("VtickLV(max(",Denstr,")",Digits,")",sep=""), - paste("Drwline(",var,"[['plotdata']]","$histplot)",sep=""), - paste(Prefp,"Dashline(",var,"[['plotdata']]","$fpplot)",sep=""), - paste("#Drwline(",var,"[['plotdata']]","$densityplot,2)",sep=""), - "","","","", - "Endpicture(1)" - ) - Exstr<- matrix(Exstr) - Info<- list(breaks=H$breaks,counts=H$counts,density=H$density,mids=H$mids, - window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2)) - Tmp<- paste(var,"<<- ", - "list(title=title,xlab=xlab,ylab=ylab,", - "commands=Exstr,plotdata=Ghist,info=Info)",sep="") - eval(parse(text=Tmp)) -} - -########################## -#17.09.30 - -Bezierpt<- function(t,Ptlist,Ctrlist){ - if(length(Ptlist)==6){ - P0=Ptlist[1:3] - P3=Ptlist[4:6] - P1=Ctrlist[1:3] - if(length(Ctrlist)==3){ - P2=P3 - flg3=0 - }else{ - P2=Ctrlist[4:6] - flg3=1 - } - }else{ - P0=Ptlist[1:2] - P3=Ptlist[3:4] - P1=Ctrlist[1:2] - if(length(Ctrlist)==2){ - P2=P3 - flg3=0 - }else{ - P2=Ctrlist[3:4] - flg3=1 - } - } - P4=(1-t)*P0+t*P1 - P5=(1-t)*P1+t*P2 - P6=(1-t)*P2+t*P3 - P7=(1-t)*P4+t*P5 - P8=(1-t)*P5+t*P6 - P9=(1-t)*P7+t*P8 - if(flg3==0){ - Out=P7 - }else{ - Out=P9 - } - return(Out) -} - -Bezier<- function(...){ - varargin<- list(...) - Nargs=length(varargin) - Ptlist=varargin[[1]] - Ctrlist=varargin[[2]] - Num=10 - for(J in Looprange(3,Nargs)){ - Tmp=varargin[[J]] - K=strsplit(Tmp,'=',fixe=TRUE) - K=K[[1]] - Tmp1=substring(K[1],1,1) - Lhs=toupper(Tmp1) - if(Lhs=="N"){ - Num=eval(parse(text=K[2])) - } - } - if(length(Num)==1){ - Num=rep(Num,length(Ctrlist)) #17.10.08 - } - Out=c() - for(ii in Looprange(1,length(Ctrlist))){ - Tmp1=c(Ptlist[[ii]],Ptlist[[ii+1]]) - Tmp2=Ctrlist[[ii]] - if(ii==1){ - St=0 - }else{ - St=1 - } - for(J in Looprange(St,Num[ii])){ - Tmp=Bezierpt(J/Num[ii],Tmp1,Tmp2) - Out=Appendrow(Out,Tmp) - } - } - return(Out) -} - -####################### -# 17.10.02 - -Connectseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Pdata=varargin[[1]] - Eps=10^(-5) - if(Nargs>=2){ - Eps=varargin[[2]] - } - if(is.matrix(Pdata)){ - Din=Dataindex(Pdata) - tmp1=list() - for(J in 1:nrow(Din)){ - tmp=Pdata[Din[J,1]:Din[J,2],] - tmp1=c(tmp1,list(tmp)) - } - Pdata=tmp1 - } - PlotL=Pdata[1] - VI=2:length(Pdata) - while(length(VI)>0){ - Qd=PlotL[[length(PlotL)]] - Ah=Qd[1,]; Ao=Qd[nrow(Qd),] - Flg=0 - for(J in 1:length(VI)){ - Tmp1=Pdata[[VI[J]]] - P=Tmp1[1,]; Q=Tmp1[nrow(Tmp1),] - if(Norm(P-Ao)=4){ - Tmp=Op(4,MS) - if(nrow(Tmp)>1){ - Mdv=Tmp[1,1] - Ndv=Tmp[1,2] - }else{ - Mdv=Tmp - if(Nargs==4){ - Ndv=Mdv - }else{ - Tmp1=Op(5,MS) - if((is.numeric(Tmp1))&&(length(Tmp1)==1)){ - Ndv=Tmp1 - }else{ - Ndv=Mdv - } - } - } - } - X1=Xrange[1]; X2=Xrange[2] - Y1=Yrange[1]; Y2=Yrange[2] - Dx=(X2-X1)/Mdv - Dy=(Y2-Y1)/Ndv - Xval=c() - Tmp=X1 - while(TmpEps){ - if(VL[K+1]< -Eps){ - Tmp=1/(VL[K]-VL[K+1])*(-VL[K+1]*PL[K,]+VL[K]*PL[K+1,]) - QL=Appendrow(QL,Tmp) - } - }else{ - if(VL[K+1]>Eps){ - Tmp=1/(-VL[K]+VL[K+1])*(VL[K+1]*PL[K,]-VL[K]*PL[K+1,]) - QL=Appendrow(QL,Tmp) - } - } - } - if(length(QL)==4){ - Out=Appendrow(Out,c(Inf,Inf)) - Out=Appendrow(Out,QL) - } - } - } - Out=Out[2:nrow(Out),] - if(length(Out)>0){ - Out=Connectseg(Out) - }else{ - Out=c() - } - return(Out) -} - -######################### -# 17.10.06 - -Deqdata=function(deq,rng,initt,initf,Num){ - Eps=10^(-3) - inf=10^3 - tmp=strsplit(deq,"=")[[1]] - tmp1=gsub("`","",tmp[1],fixed=TRUE) - tmp1=substring(tmp1,3,nchar(tmp1)-1) - Xname=strsplit(tmp1,",")[[1]] - func=tmp[2] - for(J in 1:(length(Xname))){ - tmp1=paste("X[",as.character(J),"]",sep="") - func=gsub(Xname[J],tmp1,func,fixed=TRUE) - } - tmp=strsplit(rng,"=")[[1]] - tname=tmp[1] - tmp=eval(parse(text=tmp[2])) - t1=tmp[1] - t2=tmp[2] - tmp=paste("function(",tname,",X){",func,"}",sep="") - funP=eval(parse(text=tmp)) - tmp=paste("function(",tname,",X){-",func,"}",sep="") - funN=eval(parse(text=tmp)) - dt=(t2-t1)/Num - tt=initt - X0=initf - pdL=c(tt,X0) - for(J in Looprange(1,floor((t2-initt)/dt))){ - kl1=dt*funP(tt,X0) - kl2=dt*funP(tt+dt/2,X0+kl1/2) - kl3=dt*funP(tt+dt/2,X0+kl2/2) - kl4=dt*funP(tt+dt,X0+kl3) - X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 - tt=initt+J*dt - tmp=c(tt,X0) - if(Norm(tmp)>inf){break} - pdL=Appendrow(pdL,tmp) - } - tt=initt - X0=initf - for(J in Looprange(1,floor((initt-t1)/dt))){ - kl1=dt*funN(tt,X0) - kl2=dt*funN(tt+dt/2,X0+kl1/2) - kl3=dt*funN(tt+dt/2,X0+kl2/2) - kl4=dt*funN(tt+dt,X0+kl3) - X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 - tt=initt-J*dt - tmp=c(tt,X0) - if(Norm(tmp)>inf){break} - pdL=Appendrow(tmp,pdL) - } - pdL -} - -Deqplot=function(...){ - varargin=list(...) - deq=varargin[[1]] - rng=varargin[[2]] - initt=varargin[[3]] - initf=varargin[[4]] - Num=50 - Sel=c(1,2) - for(J in Looprange(5,length(varargin))){ - tmp1=varargin[[J]] - if(is.character(tmp1)){ - tmp=strsplit(tmp1,"=")[[1]] - Num=eval(parse(text=tmp[2])) - }else{ - SeL=tmp1 - } - } - pdL=Deqdata(deq,rng,initt,initf,Num) - pdL=pdL[,SeL] -} - - -############## obj ############### - -Openobj<- function(Fnm){ - OBJFMT<<- "%7.4f" - NPOINT<<- 0 - NNORM<<- 0 - OBJSCALE<<- 1 - OBJFIGNO<<- 0 - OBJJOIN<<- 0 - Wfile<<- Fnm - Tmp=grep(".obj",Fnm,fixed=TRUE) - if(length(Tmp)==0){ - if(nchar(Fnm)>0){ - Wfile<<- paste(Fnm,".obj",sep="") - } - } - cat("",file=Wfile,sep="") - Wfile -} - -Closeobj<- function(){ - Wfile="" -} - -Writeobjpoint<- function(P){ - X=sprintf(OBJFMT,P[1]*OBJSCALE) - Y=sprintf(OBJFMT,P[2]*OBJSCALE) - Z=sprintf(OBJFMT,P[3]*OBJSCALE) - Str=paste("v",X,Y,Z,sep=" ") - Printobjstr(Str) - NPOINT<<- NPOINT+1 - return(NPOINT) -} - -Printobjstr<- function(Str){ - cat(Str,"\n",sep="",file=Wfile,append=TRUE) -} - -Objname<- function(){ - if(OBJJOIN==0){ - OBJFIGNO<<- OBJFIGNO+1 - Gname=paste("ketfig",as.character(OBJFIGNO),sep="") - Printobjstr(paste("# ",Gname,sep="")) - Printobjstr(paste("g ",Gname,sep="")) - } -} - -Objjoin<- function(...){ - varargin=list() - if(length(varargin)>0){ - OBJJOIN<<- abs(sign(varargin[[1]])) - } - OBJJOIN -} - -Objsurf<- function(...){ #17.12.18 - Args<- list(...) - Nargs<- length(Args) - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Rf=Args[[1]] - N=2 - Mg=0; Ng=0 - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - U=Args[[N]] - Mg=length(U)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - }else{ - Ag=Args[N]; Bg=Args[N+1] - N=N+2 - } - }else{ - Tmp0=Args[[N]] - Tmp=grep("=",Tmp0,fixed=TRUE) - if(length(Tmp)>0){ - Tmp1=strsplit(Tmp0,"=") - Tmp0=Tmp1[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - } - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - V=Args[[N]] - Ng=length(V)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - }else{ - Cg=Args[[N]]; Dg=Args[[N+1]] - N=N+2 - } - }else{ # the case of is.character(Args[[N]]) - Tmp0=Args[[N]] - Tmp=grep("=",Tmp0,fixed=TRUE) - if(length(Tmp)>0){ - Tmp2=strsplit(Tmp0,"=") - Tmp0=Tmp2[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - } - if(Mg==0){ - Mg=Args[[N]] - N=N+1 - U=c() - for(J in Looprange(1,Mg+1)){ - U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) - } - } - if(Ng==0){ - Ng=Args[[N]] - V=c() - for(K in Looprange(1,Ng+1)){ - V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) - } - } - Objname() - PL=list() - for(J in Looprange(1,Mg+1)){ - for(K in Looprange(1,Ng+1)){ - P=Rf(U[J],V[K]) - Np=Writeobjpoint(P) - PL=c(PL,list(c(P,Np))) - } - } - Idx=1+(Ng+1)*(0:Mg) - Pus=PL[Idx] - Idx=(Ng+1)*(1:(Mg+1)) - Pue=PL[Idx] - Idx=1:(Ng+1) - Pvs=PL[Idx] - Idx=((Ng+1)*Mg+1):((Ng+1)*(Mg+1)) - Pve=PL[Idx] - Printobjstr("vt 0 0") - Printobjstr("vt 1 0") - Printobjstr("vt 1 1") - Printobjstr("vt 0 1") - for(J in Looprange(1,Mg)){ - for(K in Looprange(1,Ng)){ - P1=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K]])) - P2=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K]])) - P3=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K+1]])) - P4=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K+1]])) - N1=""; N2=""; N3=""; N4="" - if(Sel=="+"){ - Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") - }else{ - Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") - } - Printobjstr(Str) - } - } - list(U,V,Pus,Pue,Pvs,Pve) -} - -Objthicksurf<- function(...){ - Args=list(...) - Nargs=length(Args) - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Selsurf=substring(Sel,1,1) - Selside=c("0","0","0","0") - Tmp=grep("w",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[1]="w" - } - Tmp=grep("e",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[2]="e" - } - Tmp=grep("s",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[3]="s" - } - Tmp=grep("n",Sel,fixed=TRUE) - if(length(Tmp)>0){ - Selside[4]="n" - } - Nfth=Args[[Nargs-2]] - Thick1=Args[[Nargs-1]] - Thick2=Args[[Nargs]] - Nargs=Nargs-3 - Rfth=Args[[1]] - N=2 - Mg=0; Ng=0 - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - U=Args[[N]] - Mg=length(U)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - }else{ - Ag=Args[[N]]; Bg=Args[[N+1]] - N=N+2 - } - }else{ - Tmp0=Args[[N]] - Tmp=strsplit(Tmp0,"=",fixe=TRUE) - if(length(Tmp)>0){ - Tmp0=Tmp[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Ag=Intab[1]; Bg=Intab[2] - N=N+1 - } - if(is.numeric(Args[[N]])){ - if(length(Args[[N]])>2){ - V=Args[[N]] - Ng=length(V)-1 - N=N+1 - }else if(length(Args[[N]])==2){ - Intab=Args[[N]] - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - }else{ - Cg=Args[[N]]; Dg=Args[[N+1]] - N=N+2 - } - }else{ - Tmp0=Args[[N]] - Tmp=strsplit(Tmp0,"=",fixed=TRUE) - if(length(Tmp)>0){ - Tmp0=Tmp[[1]][2] - } - Intab=eval(parse(text=Tmp0)) - Cg=Intab[1]; Dg=Intab[2] - N=N+1 - } - if(Mg==0){ - Mg=Args[[N]] - N=N+1 - U=c() - for(J in Looprange(1,Mg+1)){ - U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) - } - } - if(Ng==0){ - Ng=Args[[N]] - V=c() - for(K in Looprange(1,Ng+1)){ - V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) - } - } - Objname() - Join=OBJJOIN - OBJJOIN<<- 1 - F1=function(u,v){ - Rfth(u,v)+Thick1*Nfth(u,v) - } - F2=function(u,v){ - Rfth(u,v)+Thick2*Nfth(u,v) - } - Dt1=Objsurf(F1,U,V,Selsurf) - if(Selsurf=="+"){ - Tmp="-" - }else{ - Tmp="+" - } - Dt2=Objsurf(F2,U,V,Tmp); - Out=list(Dt1,Dt2); - - if(Selside[1]!="0"){ - Dt=Objrecs(Op(3,Dt1),Op(3,Dt2),Selside[1]) - Out=c(Out,list(Dt)) - } - if(Selside[2]!="0"){ - Dt=Objrecs(Op(4,Dt1),Op(4,Dt2),Selside[2]) - Out=c(Out,list(Dt)) - } - if(Selside[3]!="0"){ - Dt=Objrecs(Op(5,Dt1),Op(5,Dt2),Selside[3]) - Out=c(Out,list(Dt)) - } - if(Selside[4]!="0"){ - Dt=Objrecs(Op(6,Dt1),Op(6,Dt2),Selside[4]) - Out=c(Out,list(Dt)) - } - OBJJOIN<<- Join -} - -Objrecs<- function(...){ - Eps=10^(-6) - Args=list(...) - Nargs=length(Args) - Tmp=Args[[1]] - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23upto - PL1=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL1=c(PL1,list(Tmp[K,])) - } - } - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Objname() - for(J in Looprange(1,length(PL1))){ - P=PL1[[J]] - if((length(P)<4) || (P[4]==0)){ - Np=Writeobjpoint(P) - PL1[[J]]=c(P[1:3],Np) - } - } - Tmp=Args[[2]] - if((is.numeric(Tmp)) && (length(Tmp)==1)){ - Drv=Tmp - Len=Norm(Drv) - PL2=list() - for(J in Looprange(1,length(PL1))){ - Tmp=PL1[[J]] - P=Tmp[1:3]+Drv - Np=Writeobjpoint(P) - PL2=c(PL2,list(c(P[1:3],Np))) - if(JEps){ - Tmp1=Crossprod(Drv,Vec) - Tmp2=Crossprod(Tmp1,Vec) - Tmp3=Dotprod(Tmp2,Drv) - if(Tmp3<-Eps){ - Tmp2=-Tmp2 - } - Drv=Len/Norm(Tmp2)*Tmp2 - } - } - } - }else{ - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23upto - PL2=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL2=c(PL2,list(Tmp[K,])) - } - } - for(J in Looprange(1,length(PL2))){ - P=PL2[[J]] - if((length(P)<4) || (P[4]==0)){ - Np=Writeobjpoint(P) - PL2[[J]]=c(P[1:3],Np) - } - } - } - Printobjstr("vt 0 0") - Printobjstr("vt 1 0") - Printobjstr("vt 1 1") - Printobjstr("vt 0 1") - for(J in Looprange(2,length(PL1))){ - P1=sprintf("%1d",Op(4,PL1[[J-1]])) - P2=sprintf("%1d",Op(4,PL2[[J-1]])) - P3=sprintf("%1d",Op(4,PL2[[J]])) - P4=sprintf("%1d",Op(4,PL1[[J]])) - N1=""; N2=""; N3=""; N4="" - if(Sel=="+"){ - Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") - }else{ - Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") - Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") - } - Printobjstr(Str) - } - list(PL1,PL2) -} - -Objpolygon<- function(...){ - Eps=10^(-6) - Args=list(...) - Nargs=length(Args) - Tmp=Args[[1]] - PtL=Flattenlist(Tmp) - for(J in Looprange(1,length(PtL))){ #17.12.23from - Tmp=PtL[[J]] - if(!is.matrix(Tmp)){ - PtL[[J]]=matrix(Tmp,nrow=1) - } - } #17.12.23upto - PL=list() - for(J in Looprange(1,length(PtL))){ - Tmp=PtL[[J]] - for(K in Looprange(1,nrow(Tmp))){ - PL=c(PL,list(Tmp[K,])) - } - } - Sel=Args[[Nargs]]; Nargs=Nargs-1 - Objname() - for(J in Looprange(1,length(PL))){ - P=PL[[J]] - if((length(P)<4) || (P(4)==0)){ - Np=Writeobjpoint(P) - PL[[J]]=c(P[1:3],Np) - } - } - if(Nargs==1){ - Tmp=PL[[1]] - Cen=Tmp[1:3] - Nc=Tmp[4] - }else{ - Tmp=Args[[2]] - if(length(Tmp)==1){ - Tmp1=PL[[Tmp]] - Cen=Tmp1[1:3] - Nc=Tmp[4] - }else{ - Cen=Tmp - Nc=Writeobjpoint(Cen) - } - } - for(J in Looprange(1,length(PL))){ - if(J=2){ - Sz=Args[[2]] - } - if(Nargs>=3){ - Np=Args[[3]] - } - Assign("Sz",Sz) - if(Pstr=="xy"){ - Vz=c(0,0,1) - Fs=Assign("c(Sz*cos(t),Sz*sin(t),0)") - } - if(Pstr=="yz"){ - Vz=c(1,0,0) - Fs=Assign("c(0,Sz*cos(t),Sz*sin(t))") - } - if(Pstr=="zx"){ - Vz=c(0,1,0) - Fs=Assign("c(Sz*sin(t),0,Sz*cos(t))") - } - Gc0=Spacecurve(Fs,"t=c(0,2*pi)",paste("Num=",as.character(Np),sep="")) - P=PL[[1]]; Q=PL[[2]]; R=PL[[length(PL)-1]] - PQ1=Q-P - if(!Closed){ - PQ2=PQ1 - }else{ - PQ2=P-R - } - Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2) - Vp1=Vp/Norm(Vp) - Theta=acos(min(Dotprod(Vz,Vp1),1)); - Vj=Crossprod(Vz,Vp1) - if(Norm(Vj)Eps){ - dt=Crossprod(tmp3,tmp2) - ds=Crossprod(tmp1,tmp3) - t=dt/d - s=ds/d - pt=p1+v1*t - out=list(pt,t,s) - }else{ - tmp1=Crossprod(p2-p1,v1)/Norm(v1) - out=list(abs(tmp1)) - } - return(out) -} - -Intersectseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps=10^(-4) - Eps1=0.01 - seg1=varargin[[1]] - seg2=varargin[[2]] - if(Nargs>2){Eps1=varargin[[3]]} - p1=Op(1,seg1); q1=Op(2,seg1) - p2=Op(1,seg2); q2=Op(2,seg2) - if((Norm(q1-p1)1){ - pt=Op(1,tmp); t=Op(2,tmp); s=Op(3,tmp) - if((t*(t-1)1){ - if(Op(3,tmp)*(Op(3,tmp)-1)1){ - if(Op(3,tmp)*(Op(3,tmp)-1)1){ - if(Op(3,tmp)*(Op(3,tmp)-1)1){ - if(Op(3,tmp)*(Op(3,tmp)-1)Eps1){ - out=list(dist) - }else{ - tmp=c(); - for(j in 1:length(pts)){ - tmp=Appendrow(tmp,Op(1,pts[[j]])) - } - tmp1=sum(tmp[,1])/(length(pts)) - tmp2=sum(tmp[,2])/(length(pts)) - tmp3=c(tmp1,tmp2) - tmp=Nearestpt(tmp3,seg1) - tmp1=tmp[[2]] - tmp=Nearestpt(tmp3,seg2) - tmp2=tmp[[2]] - out=list(dist,tmp3,tmp1,tmp2) - } - } - } - } - return(out) -} - -Osplineseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - Eps=10^(-2) - Eps0=10^(-6) - list=varargin[[1]] - Numstr="Num=20" - if(Nargs>1){ - Numstr=varargin[[2]] - } - p0=Op(1,list); p1=Op(2,list); p2=Op(3,list); p3=Op(4,list) - tmp=Norm(p2-p0)*Norm(p3-p1) - tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/tmp)/2) - cc=4*Norm(p2-p1)/3/(Norm(p2-p0)+Norm(p3-p1))/tmp - pQ=p1+cc*(p2-p0) - pR=p2+cc*(p1-p3) - ctrL=list(c(pQ,pR)) - out=Bezier(list(p1,p2),ctrL,Numstr) - return(out) -} - -Intersectpartseg<- function(...){ - varargin=list(...) - Nargs=length(varargin) - crv1=varargin[[1]] - crv2=varargin[[2]] - ii=varargin[[3]] - jj=varargin[[4]] - Eps1=varargin[[5]] - Eps2=varargin[[6]] - Dist=10*Eps2 - if(Nargs>6){Dist=varargin[[7]]} - Eps=10^(-4) - out=list() - seg1=Listplot(Op(ii,crv1),Op(ii+1,crv1)) - seg2=Listplot(Op(jj,crv2),Op(jj+1,crv2)) - tmp1=Op(2,seg1)-Op(1,seg1) - tmp2=Op(2,seg2)-Op(1,seg2) - snang=abs(Crossprod(tmp1,tmp2))/(Norm(tmp1)*Norm(tmp2)) - tmp=Intersectseg(seg1,seg2,Eps1) - dst=Op(1,tmp) - if(dstDist-Eps)){ - os1=seg1 - }else{ - p1=Op(1,seg1); p2=Op(2,seg1) - if(ii==1){ - p3=Op(3,crv1) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p0=Reflectdata(p3,c((p1+p2)/2,tmp)) - }else{ - if(ii==Length(crv1)-1){ - p0=Op(ii-1,crv1) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p3=Reflectdata(p0,c((p1+p2)/2,tmp)) - }else{ - p0=Op(ii-1,crv1); p3=Op(ii+2,crv1) - } - } - os1=Osplineseg(list(p0,p1,p2,p3)) - } - if((Length(crv2)==2)||(Norm(Op(2,seg2)-Op(1,seg2))>Dist-Eps)){ - os2=seg2 - }else{ - p1=Op(1,seg2); p2=Op(2,seg2) - if(jj==1){ - p3=Op(3,crv2) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p0=Reflectdata(p3,c((p1+p2)/2,tmp)) - }else{ - if(jj==Length(crv2)-1){ - p0=Op(jj-1,crv2) - tmp=p2-p1 - tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) - p3=Reflectdata(p0,c((p1+p2)/2,tmp)) - }else{ - p0=Op(jj-1,crv2); p3=Op(jj+2,crv2) - } - } - os2=Osplineseg(list(p0,p1,p2,p3)) - } - tmp2=list() - for(kk in Looprange(1,Length(os1)-1)){ - for(II in Looprange(1,Length(os2)-1)){ - seg1=Listplot(Op(kk,os1),Op(kk+1,os1)) - seg2=Listplot(Op(II,os2),Op(II+1,os2)) - tmp=Intersectseg(seg1,seg2,Eps1) - if(Op(1,tmp)0){ - tmp1=c() - for(nn in Looprange(1,length(tmp2))){ - tmp1=Appendrow(tmp1,Op(2,tmp2[[nn]])) - } - tmp=sum(tmp1[,1])/length(tmp2) - tmp=c(tmp,sum(tmp1[,2])/length(tmp2)) - out=list(tmp) - p1=Op(ii,crv1); p2=Op(ii+1,crv1) - tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) - tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) - tmp=min(max(Op(3,tmp),0),1) - out=list(tmp1,ii+tmp) - p1=Op(jj,crv2); p2=Op(jj+1,crv2) - tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) - tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) - tmp=min(max(Op(3,tmp),0),1) - out=c(out,list(jj+tmp,dst,snang)) - } - } - } - return(out) -} - -Collectnear<- function(ptdL,Eps2){ - Eps=10^(-4); - gL=list(Op(1,ptdL)) - rL=ptdL[2:(length(ptdL))] - flg=0 - for( ii in Looprange(1,length(ptdL)-1)){ - if(flg==0){ - numL=c() - for(jj in Looprange(1,length(rL))){ - tmp1=100 - for(kk in Looprange(1,length(gL))){ - tmp=Norm(Op(1,gL[[kk]])-Op(1,rL[[jj]])) - if(tmp2){Eps1=varargin[[3]]} - if(Nargs>3){Eps2=varargin[[4]]} - if(Nargs>4){Dist=varargin[[5]]} - tmp1=varargin[[1]] - crv1=matrix(Op(1,tmp1),nrow=1) - for(ii in Looprange(2,Length(tmp1))){ - tmp=Op(Length(crv1),crv1) - if(Norm(tmp-Op(ii,tmp1))>Eps){ - crv1=Appendrow(crv1,Op(ii,tmp1)) - } - } - tmp2=varargin[[2]] - crv2=matrix(Op(1,tmp2),nrow=1) - for(ii in Looprange(2,Length(tmp2))){ - tmp=Op(Length(crv2),crv2) - if(Norm(tmp-Op(ii,tmp2))>Eps){ - crv2=Appendrow(crv2,Op(ii,tmp2)) - } - } - if(Length(crv1)!=Length(crv2)){ - self=0 - }else{ - self=1 - for(ii in Looprange(1,Length(crv1))){ - if(Norm(Op(ii,crv1)-Op(ii,crv2))>0){ - self=0 - break - } - } - } - out=list() - for(ii in Looprange(1,Length(crv1)-1)){ - if(self==0){ - loopL=Looprange(1,Length(crv2)-1) - }else{ - loopL=Looprange(ii+2,Length(crv2)-1) - } - for(jj in loopL){ - tmp=Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,Dist) - if(length(tmp)>0){ - if(length(out)==0){ - out=list(tmp) - }else{ - tmp1=Op(length(out),out) - if(Norm(Op(1,tmp1)-Op(1,tmp))>Eps1){ - out=c(out,list(tmp)) - } - } - if(self==1){ - tmp=list(Op(1,tmp),Op(3,tmp),Op(2,tmp),Op(4,tmp),Op(5,tmp)) - out=c(out,list(tmp)) - } - } - } - } - tmp2=out - out=list() - tmp1=tmp2 - flg=0 - for(ii in Looprange(1,length(tmp2))){ - if(flg==0){ - tmp=Collectnear(tmp1,Eps2) - out=c(out,list(Op(1,tmp))) - if(length(Op(2,tmp))==0){ - flg=1 - }else{ - tmp1=Op(2,tmp) - } - } - } - for(ii in Looprange(1,length(out))){ - tmp1=Op(ii,out) - if(length(tmp1)==1){ - out[[ii]]=Op(1,tmp1) - }else{ - tmp=c() - for(jj in Looprange(1,length(tmp1))){ - tmp=c(tmp,Op(4,tmp1[[jj]])) - } - dst=min(tmp) - tmp=list() - for(jj in Looprange(1,length(tmp1))){ - if(Op(4,tmp1[[jj]])1){ -# Start=tmp - }else{ - if(flg==0){Eps1=tmp} - if(flg==1){Eps2=tmp} - flg=flg+1 - } - } - flg=0 - AnsL=c() - if(length(plist)==1){ - Fdata=plist[[1]] - tmp1=Op(1,Fdata) - tmp2=Op(Length(Fdata),Fdata) - if(Norm(tmp1-tmp2)1){ - KL=Quicksort(KL,2) - if(length(Start)==0){ - tmp=Op(1,KL) - tst=Op(2,tmp) - Start=Pointoncrv(tst,Fdata) - }else{ - tmp=c() - for(ii in Looprange(1,length(KL))){ - tmp=c(tmp,Norm(Op(1,KL[[ii]]-Start))) - } - tmp=min(tmp) - tmp1=list() - for(ii in Looprange(1,length(KL))){ - tmp2=Op(1,KL[[ii]]) - if(Norm(tmp2-Start)==tmp){ - tmp1=c(tmp1,list(tmp2)) - } - } - tmp=Op(1,tmp1) - tst=Op(2,tmp) - Start=Pointoncrv(tst,Fdata) - } - } - } - } - if(flg==0){ - t1=tst - for(nn in Looprange(1,length(plist))){ - Fdata=Op(nn,plist) - if(nn==length(plist)){ - nxtno=1 - }else{ - nxtno=nn+1 - } - Gdata=Op(nxtno,plist) - KL=IntersectcurvesPp(Fdata,Gdata) - if(length(KL)==0){ - tmp=matrix(Op(Length(Fdata),Fdata),nrow=1) #18.02.02from - Gdata=Appendrow(tmp,Gdata) - plist[[nxtno]]=Gdata - t2=Length(Fdata) - ss=1 #18.02.02upto - }else{ - tmp=Op(1,KL) - t2=Op(2,tmp) - ss=Op(3,tmp) - if(abs(t2-t1)1){ - tmp=Op(2,KL) - t2=Op(2,tmp) - ss=Op(3,tmp) - }else{ -# println(text(nn)+" and "+text(nn+1)+" not intersect"); -# flg=1 - } - } - } - if(flg==0){ - tmp=Partcrv(t1,t2,Fdata) - if(nn==1){ - AnsL=tmp - }else{ - tmp=tmp[2:Length(tmp),] - AnsL=Appendrow(AnsL,tmp) - } - t1=ss - } - } - } - return(AnsL) -} - -############## end of Enclosing2 ############# diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3_rep2e.r b/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3_rep2e.r deleted file mode 100644 index 37033948..00000000 --- a/texmf-dist/scripts/ketcindy/ketlib/ketpic5_2_3_rep2e.r +++ /dev/null @@ -1,580 +0,0 @@ -# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team -# -#This program is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program. If not, see - - -######################################### - -ThisVersion<- "2ev5_2_3(17.10.28)" - -# 2017.10.28 -# Drwpt debugged ( Flattenlist ) -# 2017.10.07 -# - -############################################# - -Dottedline<- function(...) -{ - varargin <- list(...) - Nall <- length(varargin) - Nagasa <- 0.1 - Ookisa <- PenThick*2 #17.10.07 - I <- Nall - Tmp <- varargin[[I]] - while (mode(Tmp)=="numeric" && length(Tmp)==1 ) { - I <- I-1 - Tmp <- varargin[[I]] - } - if (I==Nall-1) { - Nagasa<-Nagasa*varargin[[Nall]] - Nall <- Nall-1 - } - if (I==Nall-2) { - Nagasa <- Nagasa*varargin[[Nall-1]] - Ookisa <- round(Ookisa*varargin[[Nall]]) - Nall <- Nall-2 - } - Nagasa <- 1000/2.54/MilliIn*Nagasa - Ra=Ookisa/MilliIn - for (N in 1:Nall) { - Pdata <- varargin[[N]] - if (mode(Pdata)=="numeric") { - Pdata <- list(Pdata) - } - for (II in 1:length(Pdata)) { - Clist <- MakeCurves(Op(II,Pdata)) - DinM <- Dataindex(Clist) - Mojisu=0 - for (n in Looprange(1,Nrow(DinM))) { - Tmp <- DinM[n,] - Data <- Clist[Tmp[1]:Tmp[2],] - Len <- 0 - Lenlist <- c(0) - for (I in Looprange(2,Nrow(Data))) { - Len <- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist <- c(Lenlist,Len) - } - Lenall <- Lenlist[length(Lenlist)] - if (Lenall==0) { - next - } - Naga <- Nagasa - Nten <- round(Lenall/Naga)+1 - if (Nten > 1) { - Seg <- Lenall/(Nten-1) - } - else { - Seg <- Lenall - } - Eps <- 10^(-6)*Seg - PPd<-c() - Hajime <- 1 - for (I in Looprange(0,Nten-1)) { - Len <- Seg*I - if (I>0) { - J <- Hajime - while( Len>=Lenlist[J]+Eps) { - J <- J+1 - } - Hajime <- J-1 - } - T <- (Len-Lenlist[Hajime])/ - (Lenlist[Hajime+1]-Lenlist[Hajime]) - P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - PPd<-Appendrow(PPd,P) - if (I==Nten-1) { - if (Norm(P-Data[1,])80){ - cat("\n",file=Wfile,append=TRUE) - Mojisu=0 - } - } - } - } - if(Mojisu>0){ - cat("\n",file=Wfile,append=TRUE) - } - } - Tmp<-PenThick/PenThickInit - Setpen(Tmp) -} - - -########################################### - -Drwline<-function(...) -{ - varargin<-list(...) - Nall<-length(varargin) - Thick<-0 - Tmp<-varargin[[Nall]] - if (mode(Tmp)=="numeric" && length(Tmp)==1){ - Setpen(Tmp) - Nall<-Nall-1 - } - for (N in 1:Nall){ - Pdata<-varargin[[N]] - if (length(Pdata)==0) next - if (mode(Pdata)!="list") Pdata<-list(Pdata) - while(Mixtype(Pdata)==3){ - Tmp1<- list() - for(II in Looprange(1,length(Pdata))){ - Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) - } - Pdata<- Tmp1 - } - for (II in Looprange(1,length(Pdata))){ - Clist<-MakeCurves(Pdata[[II]]) - DinM<-Dataindex(Clist) - for (n in Looprange(1,Nrow(DinM))){ - Tmp<-DinM[n,] - Data<-Clist[Tmp[1]:Tmp[2],] - Mojisu<-0 - for (I in Looprange(1,Nrow(Data))){ - Tmp<-Data[I,] - X=sprintf('%5.5f',Tmp[1]) - Y=sprintf('%5.5f',Tmp[2]) - Pt=paste('(',X,',',Y,')',sep="") - if(I==1){ - Str=paste('\\polyline',Pt,sep="") - }else{ - Str=Pt - } - cat(Str,file=Wfile,append=TRUE) - Mojisu<-Mojisu+nchar(Str) - if (Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<-0 - } - } - if (Mojisu!=0){ - cat("%\n",file=Wfile,append=TRUE) - } - cat("%\n",file=Wfile,append=TRUE) - } - } - } - if (Thick>0){ - Tmp<-PenThick/PenThickInit - Setpen(Tmp) - } -} - -########################################### - -Drwpt<-function(...) -{ - varargin<-list(...) - Nargs<-length(varargin) - All=Nargs - if (TenSize>TenSizeInit){ - N<- round(6*sqrt(TenSize/TenSizeInit)) - } - else{ - N<-4 - } - Tmp<- varargin[[All]] - Iro=c(0,0,0,1) - Iroflg=0 - if(is.character(Tmp)){ - Iro=Ratiocmyk(Tmp) - Iroflg=1 - All=All-1 - } - Tmp<- varargin[[All]] - if (mode(Tmp)=="numeric"){ - if (length(Tmp)>1){ - Kosa<- 1; All<- Nargs - } - else{ - Kosa<- Tmp; All<- All-1 - } - } - else if (mode(Tmp)=="list"){ - Kosa<- 1; All<- Nargs - } - Ra=TenSize*1000/2.54/MilliIn - if(Iroflg>0){ - Str='{\\color[cmyk]{' - for(J in 1:4){ - Str=paste(Str,as.character(Kosa*Iro[J]),sep="") - if(J<4){ - Str=paste(Str,',',sep="") - } - } - Str=paste(Str,'}%',sep="") - cat(Str,file=Wfile,append=TRUE) - } - -# CL<-c() -# for (J in 0:N){ -# Tmp<- TenSize*0.5*1000/2.54/MilliIn -# Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) -# CL<- append(CL,Tmp) -# } -# CL<- matrix(CL,nrow=2) -# CL<- t(CL) - Mojisu=0 - for (II in Looprange(1,All)){ - MS<- varargin[[II]] - MS=Flattenlist(MS) #17.10.28 - if (mode(MS)=="numeric"){ - MS<- list(MS) - } - for (I in Looprange(1,length(MS))){ - P<- MS[[I]] - if (InWindow(P)!="i") next - P<- Doscaling(P) - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Str=paste('\\put(',X,',',Y,'){\\circle*{',sprintf('%6.6f',Ra),'}}',sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu=Mojisu+nchar(Str) - if(Mojisu>80){ - cat("\n",file=Wfile,append=TRUE) - Mojisu=0 - } - } - } - Str="%" - if(Iroflg>0){ - Str='}%' - } - if(Mojisu>0){ - Str=paste('\n',Str,'\n',sep="") - }else{ - Fmt=paste(Str,'\n',sep="") - } - cat(Str,file=Wfile,append=TRUE) -} - -# PL<-c() -# for (J in 0:N){ -# PL<- c(PL,P+CL[J+1,]) -# } -# PL<-matrix(PL,nrow=2) -# PL<-t(PL) -# Mojisu<-0 -# for (J in 1:Nrow(PL)){ -# Q<- PL[J,] -# X<- as.character(round(MilliIn*Q[1])) -# Y<- as.character(-round(MilliIn*Q[2])) -# Str<- paste("\\special{pa ",X," ",Y,"}",sep="") -# cat(Str,file=Wfile,append=TRUE) -# Mojisu<- Mojisu+nchar(Str) -# if (Mojisu>80){ -# cat("#\n",file=Wfile,append=TRUE) -# } -# Mojisu=0 -# } -# Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") -# Str2<- "\\special{fp}%\n" -# cat(Str1,file=Wfile,append=TRUE) -# cat(Str2,file=Wfile,append=TRUE) -# } -# } -#} - -###################################### - -Makehasen<- function(Figdata,Sen,Gap,Ptn) -{ - Eps<- 10.0^(-6) - Clist<- MakeCurves(Figdata) - DinM<- Dataindex(Clist) - for (N in Looprange(1,Nrow(DinM))){ - Tmp<- DinM[N,] - Data<- Clist[Tmp[1]:Tmp[2],] - Dtall<- Nrow(Data) - Len<- 0 - Lenlist<- c(0) - for (I in Looprange(2,Dtall)){ - Len<- Len+Norm(Data[I,]-Data[I-1,]) - Lenlist<- c(Lenlist,Len) - } - Lenall<- Lenlist[Dtall] - if (Lenall==0){ - next - } - Kari<- (Sen+Gap)*0.1 - Naga<- Sen*0.1 - Tobi<- Gap*0.1 - if (Norm(Data[1,]-Data[Dtall,])=Lenlist[J]-Eps){ - if (J==Dtall){ - break - } - J<- J+1 - } - Hajime<- J-1 - J<- Hajime - while (Len+Naga>Lenlist[J]-Eps){ - if (J==Dtall){ - break - } - J<- J+1 - } - Owari<- J-1 - T<- (Len-Lenlist[Hajime]) - T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) - P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) - X0=sprintf('%5.5f',P[1]) - Y0=sprintf('%5.5f',P[2]) - Pt0=paste('(',X0,',',Y0,')',sep="") - Str=paste('\\polyline',Pt0,sep="") - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - for (J in Looprange(Hajime+1,Owari)){ - P=Data[J,] - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Pt=paste('(',X,',',Y,')',sep="") - Str=Pt - cat(Str,file=Wfile,append=TRUE) - Pt0=Pt - Mojisu=Mojisu+nchar(Str) - } - T<- (Len+Naga-Lenlist[Owari]) - T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) - P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) - X=sprintf('%5.5f',P[1]) - Y=sprintf('%5.5f',P[2]) - Pt=paste('(',X,',',Y,')',sep="") - Str=Pt - cat(Str,file=Wfile,append=TRUE) - Mojisu<- Mojisu+nchar(Str) - if (Mojisu>80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - } - cat("%\n%\n",file=Wfile,append=TRUE); -} - -######################################### - -Beginpicture<-function(ul) -{ ## Scaling is implemented - Tmp<- Doscaling(c(XMIN,YMIN)) - Xm<- Tmp[1] - Ym<- Tmp[2] - Tmp<- Doscaling(c(XMAX,YMAX)) - XM<- Tmp[1] - YM<- Tmp[2] - Dx<- XM-Xm - Dy<- YM-Ym - Sym<-".0123456789 +-*/" - SL<-Sym - OL<-"+-*/" - if (ul!=""){ - ULEN<<-ul; - } - Is<-1; - VL<-""; - Ucode<-ULEN - for (I in Looprange(1,nchar(Ucode))){ - C<-substring(Ucode,I,I); - if (length(grep(C,SL,fixed=TRUE))>0){ - if (length(grep(C,OL,fixed=TRUE))>0){ - Tmp<-substring(Ucode,Is,I-1); - Str<-paste(VL,Tmp,C,sep="") - VL<-Str - Is<-I+1; - } - } - else{ - Unit<-substring(Ucode,I,I+1); - Str<-substring(Ucode,Is,I-1); - VL<-paste(VL,Str,sep="") - break; - } - } - Valu<-eval(parse(text=VL)); - Str<-as.character(Valu); - ULEN<<- paste(Str,Unit,sep=""); - if (Unit=="cm") MilliIn<<-1000/2.54*Valu - if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10 - if (Unit=="in") MilliIn<<-1000*Valu - if (Unit=="pt") MilliIn<<-1000/72.27*Valu - if (Unit=="pc") MilliIn<<-1000/6.022*Valu - if (Unit=="bp") MilliIn<<-1000/72*Valu - if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu - if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; - if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 - MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; - Str<-paste("{\\unitlength=",ULEN,"%\n",sep=""); - cat(Str,file=Wfile,append=TRUE); - cat("\\begin{picture}%\n",file=Wfile,append=TRUE); - Str<-"("; - Tmp<-as.character(round(Dx,digits=6)); - Str<-paste(Str,Tmp,",",sep=""); - Tmp<-as.character(round(Dy,digits=6)); - Str<-paste(Str,Tmp,")(",sep=""); - Tmp<-as.character(round(Xm,digits=6)); - Str<-paste(Str,Tmp,",",sep=""); - Tmp<-as.character(round(Ym,digits=6)); - Str<-paste(Str,Tmp,")%\n",sep=""); - cat(Str,file=Wfile,append=TRUE); - Str=paste('\\linethickness{',as.character(PenThickInit/1000),'in}%',sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################################### - -Setpen<-function(Width) -{ - PenThick<<-round(PenThickInit*Width) - Str=paste('\\linethickness{',as.character(PenThick/1000),'in}%',sep="") - cat(Str,file=Wfile,append=TRUE) - cat("%\n",file=Wfile,append=TRUE) -} - -######################################### - -Shade<- function(...) -{ ## Scaling is implemented - varargin<- list(...) - Nargs<- length(varargin) - Iroflg=0 - if(Nargs>1){ - Iro=varargin[[Nargs]] - if(is.character(Iro)){ - Iroflg=1 - if(length(grep("{",Iro,fixed=TRUE))>0){ - Str=paste("{\\color",Iro,sep="") - } - else{ - Str=paste("{\\color{",Iro,"}",sep="") - } - } - else{ - if(length(Iro)==1){ - Kosa=Iro - } - else{ - Iroflg=1 - if(length(Iro)==4){ - Str="{\\color[cmyk]{" - } - else{ - if(length(Iro)==3){ - Str="{\\color[rgb]{" - } - } - for(J in 1:length(Iro)){ - Str=paste(Str,as.character(Iro[J]),sep="") - if(J80){ - cat("%\n",file=Wfile,append=TRUE) - Mojisu<- 0 - } - } - } - if(Iroflg==1){ - Str='}%' - if(Mojisu>0){ - Str=paste('\n',Str,'\n',sep="") - }else{ - Str=paste(Str,'\n') - } - cat(Str,file=Wfile,append=TRUE) - } -} diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r b/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r new file mode 100644 index 00000000..a53dd021 --- /dev/null +++ b/texmf-dist/scripts/ketcindy/ketlib/ketpicR/ketpic5_2_4.r @@ -0,0 +1,14413 @@ +# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team +# +#This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see + + +######################################### + +ThisVersion<- "KeTpic for R v5_2_4(18.02.26)" + +print(ThisVersion) + +# 2018.02.26 +# Sfcutparadata changed +# Partcrv3 debugged +# Projcurve rewritten +# Nohiddenparadata debugged +# PthiddenQ debugged +# 2018.02.24 +# Sfcutdata added ( for functions ) +# Meetpoints debugged (case Norm(PtB-PtA) Paramoncrv ) +# 2018.02.05 +# Dotprod changed ( crossprod not used ) +# Intersectpartseg changed ( case of length of result =1) +# 2018.02.04 +# Diff added ( func, withvar, (varnamevalue1,... )) +# Funvalue added ( for an expression ) +# 2018.02.02 +# Enclosing2 changed ( for distant curves, startpt option removed ) +# 2018.02.01 +# Intersectline,Intersectseg,...,Intersectcuves added +# Quicksort added +# Enclosing2 added (incomplete) +# 2018.01.29 +# Length added +# 2017.12.24 +# Objpolyhedron added +# 2017.12.23 +# Objsymb, symb3data added +# Objrecs, Objpolygon debugged +# Objthicksurf added +# 2017.12.22 +# Openobj,Closeobj,Writeobjpoint,Printobjstr,Objname,Objsurf added +# Crossprod added +# Objjoin, Objcurve, Objrecs, Objpolygon, Objsymb added +# Spacecurve debugged +# 2017.12.17 +# Setunitlen debugged ( MEMORI ) +# 2017.12.13 +# ReadOutData debugged +# 2017.12.11 +# Enclosing debugged ( appendrow -> Appendrow ) +# 2017.11.29 +# Anglemark, Arrowhead, Ovaldata debugged ( Circldeta included ) +# 2017.11.27 +# Anglemark changed ( Scilab 16.12.29) +# Plotdata,Paramplot,Spacecurve changed ( Scilab 16.12.13) +# Enclosing changed ( Scilab 16.10.09) +# Arrowhead,Arrowline changed ( Scilab 15.06.11) +# Definecolor added ( Scilab 15.05.04) +# 2017.11.26 +# Exprrot, Letterrot debugged ( `) +# 2017.11.24 +# Deqplot debugged (Looprange) +# 2017.11.20 +# InWindow debugged (for length=1) +# 2017.10.28 +# Openfile changed (Creator) +# 2017.10.23 +# ReadOutData greatly changed +# 2017.10.11 +# Drwpt debugged (Flattenlist ) +# 2017.10.08 +# Bezier debugged ( Num ) +# 2017.10.07 +# ReadOutData debugged ( for null data ) +# 2017.10.06 +# Deqdata, Deqplot added +# Connectseg remade(bug) +# 2017.09.30 +# Bezierpt, Bezier added +# 2017.09.29 +# Ptcrv debugged +# 2017.09.28 +# Openfile changed +# 2017.09.24 +# Circledata debugged +# Kyoukai changed (Eps) +# Shade updated +# 2017.09.22 +# Setcolor changed +# Plotdata,Paramplot,Spacecurve changed (N-1 -> N) +# 2017.09.21 +# Shade changed (Sci 17.01.09) +# 2017.09.17 +# Ovaldata,Assignadd changed +# Dist added +# Cicledata changed +# Bowdata debugged (Circledata,etc) + +# 2015.11.05 +# WriteOutData changed + +# 2015.10.29 +# WriteOutData changed ( endmark //// ) + +# 2015.10.24 +# ReadOutData changed ( in case of listlength=1 ) + +# 2014.12.23 +# ReadOutData added + +# 2014.12.17 +# WriteOutData added + +# 2014.0905 +# Unscaling debugged MARKLENI => MARKLEN +# 2014.03.31 +# PhHiddenData added +# 2014.03.30 +# Facesdata changed ( for Hiddendata ) +# 2014.03.23 +# MARKLEN separated, Rotate3data debugged + +# 2013.12.19 +# Openfile, Closefile, Bowname, Bownamerot + +# 2013.11.13 +# Arrowhead, Arrowheaddata + +# 2013.08.07 +# Cancoordpara added + +# 2013.08.07 +# Integrate added + +# 2013.05.20 +# Openfile changed + +# 2013.05.03 +# Tabledata, Pointdata changed +# Dividetable, Partframe added + +# 2013.02.10 +# Ketinit added + +# 2012.01.07 +# Arrowline, Arrowhead ( Cut implemented ) + +# 2011.12.18 +# Framedata ( compliant for list ) + +# 2011.12.12 +# Skeletonparadata... ( Flattellist used) + +# 2011.11.27 +# drwboxframe + +# 2011.11.07 +# metacommands added + +# 2011.11.02 +# Joingraphics ( for list structure ) + +# 2011.08.24 +# Setcolor ( c(1,0,0,0.5) etc ) +# Rotate3data ( Point is available ) + +# 2011.07.19 +# Drwline, Letter, Expr +# Drwboxplot( etc ) min,max => outliners +# Drwline ( unfinished in the case of "integer" ) + +# 2011.06.25 +# joincrvs debugged + +# synchro with ketpict2e + +# 2011.06.01 +# Bowdata debugged + +#2011.05.28 +# Ratiocmyk, Setcolor ( new ) + +#2011.04.28 +# Htickmark, Vtickmark debugged + +#2011.03.08 +# Drwboxframe debugged +# Putrow, Putrowexpr debugged (Dpos ) + +#2011.03.02 +# Tabledata ( index of hline ), PutcoL, PutcoLexpr ( "r",...) debugged +# Texcom changed ( // => backslash ) + +#2011.01.07 +# Dividegraphics, Splinedat are changed significantly +# Readtextdata is changed + +#2011.01.04 +# Derivative, Integrate are added + +#2010.12.07 +# Translatedata, Scaledata, Reflectdata changed ( efficient for vector ) +# Rotatedata changed ( deg : logical ) +# HIstplotdata, Drwhistplot ( type => freq , fpplot (added) ) + +# 2010.12.04 +# WindispT changed ( tickmark ) +# Lineplot changed ( mag=> length ) +# Plotdata debugged ( 'E=fun', 'D=') +# Enclosing changed (return PD) + +# 2010.12.02 +# WindispT changed +# Makecurves debugged + +# 2010.11.27 +# Pointdata changed ( efficient for matrix and data.frame ) +# WindispT +# Setwindow ( decide from data ) +# Assign debugged ( strsplit => gsub(fixed=T)) + +# 2010.11.20 +# Flattenlist, WindispT +# Splinedata changed( efficient for data.frame ) + +#2010.08.19 ( Maybe not finished ) +# Stripblanks +# Fullformfunc, Sf3data + +#2010.08.17 +# Phparadata, Phpersdata, Phspersdata, Phsparadata +# Facesdata, MakeveLfaceL, Menkakusi2 +# Rotate3data +# Skeletonpersdata, Skeletonpers3data, Makeskeletonpersdata +# Embed + +#2010.08.16 +# Spacecurve changed +# CameracoordCurve, Partcrv3, Projpers, CameraCurve, +# Perspt, Xyzaxpersname, Invperspt, Zparapt, Zperspt + +# 2010.08.15 +# Phcutoffdata added + +# 2010.08.13 +# Phcutdata, Spacecurve debugged +# Setangle changed + +# 2010.08.09 +# Spacecurve +# Rotate3data, Rotate3pt +# Phcutdata + +# 2010.08.08 +# Implementing 3d +# Initangle, Setangle, Setpers, SetstereoL, SetstereoR +# Mixlength +# Spaceline, Projpara, ProjCurve, Parapt +# Xyzax3data, Xyzaxparaname +# Cancoordpers, Invparapt, ProjcoordCurve +# Skeletonparadata, Skeletonpara3data, Makeskeletondata, Kukannozoki + +# 2010.07.25 +# Rotatedata changed +# Drwline changed (list of list) + +# 2010.04.09 +# Stat package added + +# 2010.04.02 +# Putcolexpr, Putrowexpr + +# 2010.04.02 + +# Windisp, Op changed +# Execmd added +# Texnewcmd, Texrenewcmd, Texend, +# Texctr, Texnewctr, Texsetctr +# Kyoukai debugged + +# 2010.01.20 +# Partcrv, Makeshasen : debugged + +# 2010.01.23 +# Ovaldata, Ovalbox added + +# 2010.01.27 +# Readtextdata changed +# Putrow, PutcoL debugged ( Putcol is OK) + +# 2010.01.31 +# Writetextdata added + +# 2010.02.12 +# Texvalctr, Texthectr added + +# 2010.02.22 +# Execmd changed + +# 2010.02.23 +# Op, Windisp changed + +# 2010.02.24 +# Execmd changed + +# 2010.03.07 +# Dotfilldata (Kosa>1) + +# 2010.03.21 +# Mixjoin +# Koutenlist (bug) + + +# 2010.03.24 +# Arrowhead ( bug in the case of "l" ) + +# 2010.03.28 +# Tabledata +# Diagcelldata ( New ) + +# 2010.03.30 +# Tabledata + +########################################### + +XMIN<- -5 +XMAX<- 5 +YMIN<- -5 ; YMAX<- 5 +ZIKU<- "line" +ARROWSIZE<- 1 +XNAME<- "$x$" +XPOS<- "e" +YNAME<- "$y$" +YPOS<- "n" +ONAME<- "O" +OPOS<- "sw" +ULEN<- "1cm" +MilliIn<- 1/2.54*1000 +PenThick<- round(MilliIn*0.02) +PenThickInit<- PenThick +TenSizeInit<<- 0.02*2 #17.10.07 +TenSize<- TenSizeInit +Wfile<-"" +MEMORI<- 0.05 +MEMORIInit<- MEMORI +MEMORINow<- MEMORI +MARKLEN<- 0.05 +MARKLENInit<- MARKLEN +MARKLENNow<- MARKLEN +GENTEN<- c(0,0) +YaSize<- 1 +YaAngle<- 18 +YaPosition<- 1 +YaThick<- 1 +YaStyle<- "tf" +PHI<- 30*pi/180 +THETA<- 60*pi/180 +FocusPoint<- c(0,0,0) +EyePoint<- c(5,5,5) +ASSIGNLIST<- list("`","'") + +SCALEX<- 1 +SCALEY<- 1 +LOGX<- 0 +LOGY<- 0 + +TEXFORLEVEL<- 0 +TEXFORLAST<- list() + +####################### + +Ketinit<- function(){ +XMIN<<- -5 +XMAX<<- 5 +YMIN<<- -5 ; YMAX<<- 5 +ZIKU<<- "line" +ARROWSIZE<<- 1 +XNAME<<- "$x$" +XPOS<<- "e" +YNAME<<- "$y$" +YPOS<<- "n" +ONAME<<- "O" +OPOS<<- "sw" +ULEN<<- "1cm" +MilliIn<<- 1/2.54*1000 +PenThick<<- round(MilliIn*0.02) +PenThickInit<<- PenThick +TenSizeInit<<- 0.02*2 #17.10.07 +TenSize<<- TenSizeInit +Wfile<<-"" +MEMORI<<- 0.05 +MEMORIInit<<- MEMORI +MEMORINow<<- MEMORI +MARKLEN<<- 0.05 +MARKLENInit<<- MARKLEN +MARKLENNow<<- MARKLEN +GENTEN<<- c(0,0) +YaSize<<- 1 +YaAngle<<- 18 +YaPosition<<- 1 +YaThick<<- 1 +YaStyle<<- "tf" +PHI<<- 30*pi/180 +THETA<<- 60*pi/180 +FocusPoint<<- c(0,0,0) +EyePoint<<- c(5,5,5) +ASSIGNLIST<<- list("`","'") + +SCALEX<<- 1 +SCALEY<<- 1 +LOGX<<- 0 +LOGY<<- 0 + +TEXFORLEVEL<<- 0 +TEXFORLAST<<- list() +} + +#------------------------------------------------------- + +Appendrow<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Out<-c() + Nc<- 0 + for (I in 1:Nargs) + { + Dt<- varargin[[I]] + Nc<- max(Nc,Ncol(Dt)) + if(class(Dt)=="matrix") Dt<-as.numeric(t(Dt)) + Out<- c(Out,Dt) + } + if(Nc>0) + { + Out<-matrix(Out, nrow=Nc) + Out<-t(Out) + } + else + { + Out<-c() + } + return(Out) +} + +Crossprod<-function(a,b) +{ + if(length(a)==3) + { + Tmp1<-a[2]*b[3]-a[3]*b[2] + Tmp2=a[3]*b[1]-a[1]*b[3] + Tmp3=a[1]*b[2]-a[2]*b[1] + Out=c(Tmp1,Tmp2,Tmp3) + } + else + { + Out=a[1]*b[2]-a[2]*b[1] + } + return(Out) +} + +Datalength<-function(Data) +{ + if(length(Data)==0) return(0) + if(mode(Data)=="numeric") return(Nrow(Data)) + if(mode(Data)=="character") return(nchar(Data)) + if(mode(Data)=="list") return(length(Data)) +} + +Crossprod<- function (a,b){ # 17.12.22 + if(length(a)==3){ + Tmp1=a[2]*b[3]-a[3]*b[2] + Tmp2=a[3]*b[1]-a[1]*b[3] + Tmp3=a[1]*b[2]-a[2]*b[1] + Out=c(Tmp1,Tmp2,Tmp3) + }else{ + Out=a[1]*b[2]-a[2]*b[1] + } +} + +Dotprod<-function(a,b){ # 18.02.05 + nn=min(length(a),length(b)) + out=0 + for(jj in Looprange(1,nn)){ + out=out+a[jj]*b[jj] + } + return(out) +} + +Dist<- function(...) # 17.09.17 +{ + varargin<- list(...) + a=varargin[[1]] + if(length(varargin)==1){ + tmp=sqrt(Dotprod(a,a)) + return(as.vector(tmp)) + } + else{ + b=varargin[[2]] + tmp=sqrt(Dotprod(b-a,b-a)) + retun(as.vector(tmp)) + } +} + +Member<-function(A,L) +{ + N<-length(L); + if(length(N)==0) return(FALSE) + for (I in 1:N) + { + if(class(L)=="list") + { + Tmp<-L[[I]] + } + else + { + Tmp<-L[I] + } + if(mode(A)=="numeric") + { + if(Norm(A-Tmp)==0) return(TRUE) + } + else + { + if(A==Tmp) return(TRUE) + } + } + return(FALSE) +} + +Norm<-function(V) +{ + Tmp=Dotprod(V,V) #18.02.09 +# Tmp<-as.vector(V); +# Tmp<-crossprod(Tmp,Tmp) + Tmp<-sqrt(Tmp) +# as.numeric(Tmp) +} + +Ncol<-function(P) +{ + if(class(P)=="matrix") return(ncol(P)) + else return(length(P)) +} + +Nrow<-function(P) +{ + if(length(P)==0) return(0) + if(class(P)=="matrix") return(nrow(P)) + else return(1) +} + +Looprange<- function(a,b) +{ +if(a<=b) return(a:b) +return(c()) +} + +Stripblanks<- function(Ch){ + Tmp<- gsub(" ","",Ch,fixed=TRUE) + return(Tmp) +} + +Quicksort<- function(seqL,key){ #18.02.01 + if(length(seqL)<2){ + out=seqL + }else{ + tmp1=Op(1,seqL) + tmp2=Op(2,seqL) + if(Op(key,tmp1)>=Op(key,tmp2)){ + pivot = tmp1 + }else{ + pivot=tmp2 + } + left = list() + right = list() + for(ii in 1:length(seqL)){ + tmp=Op(ii,seqL) + if(Op(key,tmp)< Op(key,pivot)){ + left=c(left,list(tmp)) + }else{ + right=c(right,list(tmp)) + } + } + left = Quicksort(left,key) + right = Quicksort(right,key) + out=c(left,right) + } + return(out) +} + +Derivative<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Fstr<- varargin[[1]] + Vstr<- varargin[[2]] + NvaL<- length(Vstr) + Flg<- 0 + if(Nargs>=3){ + VaL<- varargin[[3]] + Flg<- 1 + } + Str<- paste("deriv(~",Fstr,",c('",Vstr[1],"'",sep="") + for(J in Looprange(2,NvaL)){ + Str<- paste(Str,",'",Vstr[J],"'",sep="") + } + Str<- paste(Str,")",sep="") + if(NvaL<=3){ + Str<- paste(Str,",func=TRUE)",sep="") + } + else{ + Str<- paste(Str,")",sep="") + } + f<- eval(parse(text=Str)) + if(Flg==1){ + if(NvaL<=3){ + if(NvaL==1){V<- f(VaL[1])} + if(NvaL==2){V<- f(VaL[1],VaL[2])} + if(NvaL==3){V<- f(VaL[1],VaL[2],VaL[3])} + } + else{ + for(J in 1:NvaL){ + Tmp<- paste(Vstr[J],'<-',as.character(VaL[J])) + eval(parse(text=Tmp)) + } + V<- eval(f) + } + Out<- attr(V,'gradient') + Out<- Out[1,] + } + else{ + Out<- f + } + return(Out) +} + +Diff<- function(...){ #18.02.04 + varargin=list(...) + Nargs=length(varargin) + fun=varargin[[1]] + withvar=varargin[[2]] + tmp=paste("f<- expression(",fun,")",sep="") + eval(parse(text=tmp)) + nn=nchar(withvar) + for(jj in Looprange(1,nn)){ + tmp=substring(withvar,jj,jj) + f=D(f,tmp) + } + var=c() + val="" + for(jj in Looprange(3,Nargs)){ + tmp=strsplit(varargin[[jj]],"=") + var=c(var,tmp[[1]][1]) + val=paste(val,tmp[[1]][2],",",sep="") + } + if(Length(val)>1){ + val=substring(val,1,Length(val)-1) + f=deriv(f,var,func=TRUE) + tmp=paste("out=f(",val,")",sep="") + out=eval(parse(text=tmp)) + return(out[1]) + }else{ + return(f) + } +} + +Funvalue<- function(...){ + varargin=list(...) + Nargs=length(varargin) + df=varargin[[1]] + var=c() + val="" + for(jj in Looprange(2,Nargs)){ + tmp=strsplit(varargin[[jj]],"=") + var=c(var,tmp[[1]][1]) + val=paste(val,tmp[[1]][2],",",sep="") + } + val=substring(val,1,Length(val)-1) + dfun=deriv(df,var,func=TRUE) + tmp=paste("out=dfun(",val,")",sep="") + eval(parse(text=tmp)) + return(out[1]) +} + +Integrate<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Fstr<- varargin[[1]] + Vstr<- varargin[[2]] + IntvL<- varargin[[3]] + Str<- 'Tmpfun<- function(' + Str<- paste(Str,Vstr,'){',sep='') + Str<- paste(Str,Fstr,'}',sep='') + eval(parse(text=Str)) + Tmpfunv<- function(x){sapply(x,Tmpfun)} + Out<- 0 + for (J in 1:(length(IntvL)-1)){ + Tmp<- integrate(Tmpfunv,IntvL[J],IntvL[J+1]) + Out<- Out+Tmp[[1]] + } + return(Out) +} + +#-------------------------------------- + +######################### + +Anglemark<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-3) + PA<- varargin[[1]] + PB<- varargin[[2]] + PC=varargin[[3]] + r <- 0.5 + if(Nargs>=4){ + r<- varargin[[4]]*r + } + Out=c() + if(r>min(Norm(PA-PB),Norm(PC-PB))){ + return(Out) + } + Cir<- Circledata(c(PB,r)) #17.11.29 + Tmp<- IntersectcrvsPp(Cir,Listplot(PA,PB)) + P1<- Op(2,Op(1,Tmp)) + Tmp<- IntersectcrvsPp(Cir,Listplot(PC,PB)) + P2<- Op(2,Op(1,Tmp)) + if(abs(P1-P2)1){ + R<- Tmp + } + else{ + if(Flg==0){ + Ookisa<- Ookisa*Tmp + } + if(Flg==1){ + if(Tmp<5){ + Hiraki<- Tmp*Hiraki + } + else{ + Hiraki<- Tmp + } + } + if(Flg==2){ + R<- P+Tmp*(Q-P) + } + else{ + R<- P+Yapos*(Q-P) + } + if(Flg==3){ + Futosa<- Tmp + } + Flg<- Flg+1 + } + } + if(mode(Tmp)=="character"){ + Tmp<- grep("=", Tmp) + if(length(Tmp)>0){ + eval(parse(text=Tmp)) + Futosa<- Futosa*Thickness + R<- P+Position*(Q-P) + } + else{ + Str<- Tmp + } + } + } + Tmp1<- Listplot(c(P,Q)) + Tmp2<- Arrowheaddata(R,Q-P,Ookisa,Hiraki,Futosa,Str) + Out<- Joingraphics(Tmp1,Tmp2) +} + +###################################### + +# 2013.11.13 No Intersect debugged + +Arrowhead<-function(...) +{ ## Scaling is implemented + ## 12.01.08 Kirikomi + varargin<-list(...) + Nargs<-length(varargin) + P<-varargin[[1]] + Houkou<-varargin[[2]] + Ookisa<-0.2*YaSize + Hiraki<-YaAngle + Futosa<-0.5*YaThick + Cut<- 0 + Str<-YaStyle + Flg<- 0 + for (I in Looprange(3,Nargs)){ + Tmp<-varargin[[I]] + if(is.character(Tmp)){ + Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from + if(length(Equal)>0){ + Tmp1<- strsplit(Tmp,"=",fixed=TRUE) + Tmp2<- Tmp1[[1]] + if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ + Tmp<- paste("Cut=",Tmp2[2],sep="") + eval(parse(text=Tmp)) + } + }else{ + Str<- Tmp + } # 12.01.07 upto + } + if(is.numeric(Tmp) && length(Tmp)==1){ + if(Flg==0) Ookisa<-Ookisa*Tmp + if(Flg==1){ + if(Tmp<5) Hiraki<-Tmp*Hiraki + else Hiraki<-Tmp + } + if(Flg==2) Futosa<-Tmp + Flg<-Flg+1 + } + } + Ookisa<-1000/2.54/MilliIn*Ookisa + Theta<-Hiraki*pi/180 + if(Nrow(Houkou)>1){ + P<- Doscaling(P) + Houkou<- Doscaling(Houkou) + Tmp<-Nearestpt(P,Houkou) + A<-Tmp[[1]] + I<-floor(Tmp[[2]]) + G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 + Flg<- 0 # 13.11.13 + JL<-seq(I,1,by=-1) + for (J in JL){ + B<-Ptcrv(J,Houkou) + Tmp<-IntersectcrvsPp(Listplot(list(A,B)),G) + if(length(Tmp)>0){ + Flg<- 1 + break + } + A<-B + } + if(Flg==0){ # 13.11.13 + print("Arrowhead may be too large (no intersect)") + return(P) + } + Houkou<-P-Op(1,Tmp[[1]]) + Houkou<- Unscaling(Houkou) + P<- Unscaling(P) + } + P<- Doscaling(P) + Houkou<- Doscaling(Houkou) + Ev<--1/Norm(Houkou)*Houkou + Nv<-c(-Ev[2],Ev[1]) + if(length(grep("c",Str))>0){ + P<-P-0.5*Ookisa*cos(Theta)*Ev + } + if(length(grep("b",Str))>0){ + P<-P-Ookisa*cos(Theta)*Ev + } + A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv + B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv + if(length(grep("l",Str))>0){ + Tmp<-Listplot(list(A,P,B)) + Tmp1<- Unscaling(Tmp) + Drwline(Tmp1,Futosa) + } + else{ + C<- P+(1-Cut)*((A+B)/2-P) # 12.01.07 + Tmp<- Listplot(list(A,P,B,C,A)) # 12.01.07 + Tmp1<- Unscaling(Tmp) + Shade(Tmp1) + Tmp=Listplot(c(A,P,B,C,A,P)) # 15.6.20 + Tmp1=Unscaling(Tmp) + Drwline(Tmp1,0.1) # 15.06.11, 15.06.14 + } +} + +############################################ + +# 2013.11.13 No intersect debugged + +Arrowheaddata<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + P<- varargin[[1]] + Houkou<- varargin[[2]] + Ookisa<- 0.2*YaSize + Hiraki<- YaAngle + Futosa<- 0 + Thickness<- 1 + Str<- YaStyle + Flg<- 0 + for (I in Looprange(3,Nargs)){ + Tmp<-varargin[[I]] + if(mode(Tmp)=="character"){ + Tmp1<-grep("=",Tmp) + if(length(Tmp1)>0){ + eval(parse(text=Tmp)) + Futosa<- Thickness + } + else{ + Str<- Tmp + } + } + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + if(Flg==0) Ookisa<-Ookisa*Tmp + if(Flg==1){ + if(Tmp<5) Hiraki<-Tmp*Hiraki + else Hiraki<-Tmp + } + if(Flg==2) Futosa<-Tmp + Flg<-Flg+1 + } + } + Theta<- Hiraki*pi/180 + if(Nrow(Houkou)>1){ + P<- Doscaling(P) + Houkou<- Doscaling(Houkou) + Tmp<-Nearestpt(P,Houkou) + A<-Tmp[[1]] + I<-floor(Tmp[[2]]) + G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 + Flg<- 0 # 13.11.13 + JL<-seq(I,1,by=-1) + for (J in JL){ + B<- Ptcrv(J,Houkou) + Tmp<- IntersectcrvsPp(Listplot(list(A,B)),G) + if(length(Tmp)>0){ + Flg<- 1 + break + } + A<-B + } + if(Flg==0){ # 13.11.13 + print("Arrowhead may be too large (no intersect)") + return(P) + } + Houkou<-P-Op(1,Tmp[[1]]) + Houkou<- Unscaling(Houkou) + P<- Unscaling(P) + } + P<- Doscaling(P) + Houkou<- Doscaling(Houkou) + Ev<- -1/Norm(Houkou)*Houkou + Nv<- c(-Ev[2],Ev[1]) + if(length(grep("c",Str))>0){ + P<-P-0.5*Ookisa*cos(Theta)*Ev + } + if(length(grep("b",Str))>0){ + P<-P-Ookisa*cos(Theta)*Ev + } + A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv + B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv + Tmp<- Listplot(A,P,B) + Out<- Unscaling(Tmp) + return(Out) +} + +########################################## + +Arrowline<- function(...) +{ # 12.01.07 kirikomi + varargin<- list(...) + Nargs<- length(varargin) + P<- varargin[[1]] + Q<- varargin[[2]] + Futosa<- YaThick + Ookisa<- YaSize + Hiraki<- YaAngle + Yapos<- YaPosition + Cutstr<- "Cut=0" + Str<- YaStyle + Flg<- 0 + for (I in Looprange(3,Nargs)){ + Tmp<- varargin[[I]] + if(is.character(Tmp)){ + Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from + if(length(Equal)>0){ + Tmp1<- strsplit(Tmp,"=") + Tmp2<- Tmp1[[1]] + if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ + Tmp<- paste("Cut=", Tmp2[2],sep="") + Cutstr<- Tmp + } + } + else{ + Str<- Tmp + } # 12.01.07 upto + } + if(is.numeric(Tmp) && length(Tmp)==1){ + if(Flg==0) Ookisa<- Ookisa*Tmp + if(Flg==1){ + if(Tmp<5) Hiraki<- Tmp*Hiraki + else Hiraki<- Tmp + } + if(Flg==2) Yapos<- Tmp + if(Flg==3) Futosa<- Tmp + Flg<- Flg+1 + } + } + R<- P+Yapos*(Q-P) + Tmp=Q-Unscaling(0.2*Ookisa/2*(Q-P)/Norm(Q-P)) # 15.10.24 + Drwline(Listplot(c(P,Tmp)),Futosa) + Arrowhead(R,Q-P,Ookisa,Hiraki,Futosa,Cutstr,Str) +} + +######################################### + +Assign<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + ASSIGNLIST<<- list("`",Prime()) + Out<- ASSIGNLIST + return() +# return("Assign reset done"); + } + L<- list("`","'") + if(Nargs%%2==0){ + L<- Mixjoin(L,varargin) + ASSIGNLIST<<- L + Out<- L + return() +# return("Assign set done"); + } + if(Nargs==1){ + Fnstr<- varargin[[1]] + if(nchar(Fnstr)==0){ # case of "" + L<- ASSIGNLIST + Out<- c() + for (I in seq(1,length(L),by=2)){ + Tmp1<- L[[I]] + Tmp2<- L[[I+1]] + if(length(Tmp2)==1){ + Tmp3<- as.character(Tmp2) + } + else{ + if(mode(Tmp2)=="character"){ + Tmp3<- Tmp2 + } + else if(mode(Tmp2)=="list"){ + Tmp3<- makeliststr(Tmp2) + } + else if(mode(Tmp2)=="numeric"){ + Tmp3<- "c(" + for (J in Looprange(1,length(Tmp2))){ + Tmp3<- paste(Tmp3,as.character(Tmp2[J]),sep="") + if(J0){ + if(length(grep(C,OL))>0){ + Tmp<-substring(Ucode,Is,I-1); + Str<-paste(VL,Tmp,C,sep="") + VL<-Str + Is<-I+1; + } + } + else{ + Unit<-substring(Ucode,I,I+1) + Str<-substring(Ucode,Is,I-1) + VL<-paste(VL,Str,sep="") + break; + } + } + Valu<-eval(parse(text=VL)) + Str<-as.character(Valu); + ULEN<<- paste(Str,Unit,sep="") + if(Unit=="cm") MilliIn<<-1000/2.54*Valu + if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10 + if(Unit=="in") MilliIn<<-1000*Valu + if(Unit=="pt") MilliIn<<-1000/72.27*Valu + if(Unit=="pc") MilliIn<<-1000/6.022*Valu + if(Unit=="bp") MilliIn<<-1000/72*Valu + if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu + if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; + if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 + MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; + Str<-paste("{\\unitlength=",ULEN,"%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + cat("\\begin{picture}%\n",file=Wfile,append=TRUE) + Str<-"(" + Tmp<-as.character(round(Dx,digits=6)) + Str<-paste(Str,Tmp,",",sep="") + Tmp<-as.character(round(Dy,digits=6)) + Str<-paste(Str,Tmp,")(",sep="") + Tmp<-as.character(round(Xm,digits=6)) + Str<-paste(Str,Tmp,",",sep="") + Tmp<-as.character(round(Ym,digits=6)) + Str<-paste(Str,Tmp,")%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + Str<-paste("\\special{pn ",as.character(PenThickInit),"}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +################################################# + +Bowdata<- function(...) #17.09.17 +{ + varargin <- list(...) + Nargs <- length(varargin) + PA <- varargin[[1]] + PB <- varargin[[2]] + Cut <- 0 + D <- 1/2*Norm(PB-PA) + if(Nargs>=3) { + H <- varargin[[3]]*D*0.2 + } + else { + H <- D*0.2 + } + H <- min(H,D) + if(Nargs>=4){ + Cut <- varargin[[4]] + } + Ydata <- MakeBowdata(PA,PB,H) + C <- Op(1,Ydata) + r <- Op(2,Ydata) + R1 <- Op(3,Ydata) + R2 <- Op(4,Ydata) + Rng <- paste("R=c(",as.character(R1),",",as.character(R2),")",sep="") + Theta <- (R1+R2)*0.5 + BOWMIDDLE <<- list(c(C[1]+r*cos(Theta),C[2]+r*sin(Theta)),Theta) + M <- Op(1,BOWMIDDLE) + ThetaM <- Op(2,BOWMIDDLE) + BOWSTART <<- PA + BOWEND <<- PB + if(Cut==0){ + Pd<- Circledata(c(C,r),Rng) + } + else{ + Alpha <- R1; Beta <- ThetaM-Cut/(2*r) + Rng <- paste("Rng=c(",as.character(Alpha),",",as.character(Beta),")",sep="") + Pd <- Circledata(c(C,r),Rng) + Alpha <- ThetaM+Cut/(2*r); Beta <- R2 + Rng <- paste("R=c(",as.character(Alpha),",",as.character(Beta),")",sep="") + Tmp <- Circledata(c(C,r),Rng) + Pd <- Appendrow(Pd,c(Inf,Inf),Tmp) + } +} + +Bowmiddle <- function(...) +{ + varargin <- list(...) + Nargs <- length(varargin) + if( Nargs==0) { + M <- BOWMIDDLE + return(M) + } + if(Nargs==1) { + Bdata <- varargin[[1]] + A <- Bdata[1,] + Dind <- Dataindex(Bdata) + Dc <- Nrow(Dind) + Tmp <- Dind[Dc,2] + B <- Bdata[Tmp,] + if(Dc==1) { + Tmp1 <- round(Tmp/2) + } + else { + Tmp1 <- Dind[1,2] + } + D <- Bdata[Tmp1,] + B <- B-A + D <- D-A + Tmp1 <- B[1]*D[2]-D[1]*B[2] + Tmp2 <- (Norm(B)^2*D[2]-B[2]*Norm(D)^2)/2 + Tmp3 <- -(Norm(B)^2*D[1]-B[1]*Norm(D)^2)/2 + C <- c(Tmp2,Tmp3)/Tmp1+A + R <- Norm(C-A) + B <- B+A + V <- (A+B)/2-C + V <- V/Norm(V) + M <- C+R*V + } + else { + A <- varargin[[1]]; B <- varargin[[2]] + D <- 1/2*Norm(B-A) + H <- 0.2*D; + if(length(varargin)>=3) { + Tmp <- varargin[[3]] + H <- Tmp*D*0.2 + } + H <- min(H,D) + Ydata <- MakeBowdata(A,B,H) + C <- Op(1,Ydata) + R <- Op(2,Ydata) + T <- (Op(3,Ydata)+Op(4,Ydata))/2 + P <- C+R*c(cos(T),sin(T)) + #M <- list(P,T) + M <- P + } + return(M) +} + +########################## +# 13.12.19 small movement supported + +Bowname<- function(...) +{ + varargin <- list(...) + Nargs <- length(varargin) + Siki <- varargin[[Nargs]] + Nargs<- Nargs-1 + Dr<- "c" + if(Nargs>=1){ + Tmp<- varargin[[Nargs]] + if(is.character(Tmp)){ + Dr<- Tmp + Nargs<- Nargs-1 + } + } + if(Nargs==0){ + Siki <- varargin[[1]] + P <- Op(1,BOWMIDDLE) + } + else if(Nargs==1){ + Bdata <- varargin[[1]] + P <- Bowmiddle(Bdata) + } + else{ + A <- varargin[[1]]; B <- varargin[[2]] + D <- 1/2*Norm(B-A) + Tmp <- varargin[[3]] + if(is.character(Tmp)){ + H <- D*0.2 + } + else { + H <- Tmp*D*0.2 + } + H <- min(H,D) + Ydata <- MakeBowdata(A,B,H) + Tmp <- Bowmiddle(Ydata) + P <- Op(1,Tmp) + } + Expr(P,Dr,Siki) +} + +########################## +# 13.12.19 small movement supported +# A,B, ... no longer supported + +Bownamerot <- function(...) +{ + varargin <- list(...) + Nargs <- length(varargin) + Eps <- 10^(-6) + Flg <- 1 + Tmp <- varargin[[Nargs]] + if(is.numeric(Tmp) && length(Tmp)==1 && Tmp<0){ + Flg <- Tmp + Nargs <- Nargs-1 + } + Siki <- varargin[[Nargs]] + Nargs<- Nargs-1 + Dr<- "c" + if(Nargs>=1){ + Tmp<- varargin[[Nargs]] + if(is.character(Tmp)){ + Dr<- Tmp + Nargs<- Nargs-1 + } + } + if(Nargs==0) { + P <- Op(1,BOWMIDDLE) + A <- BOWSTART + B <- BOWEND + } + else{ + Bdata<- varargin[[1]] + P<- Bowmiddle(Bdata) + A=Bdata[1,] + B=Bdata[nrow(Bdata),] + Tm<- 0; Tv<- 0 + if(Nargs>1){ + Tm<- varargin[[2]] + if(Nargs>2){ + Tv<- varargin[[3]] + } + } + } +# else if(Nargs==2) { +# Bdata <- varargin[[1]] +# P <- Bowmiddle(Bdata) +# A <- Bdata[1,] +# B <- Bdata[Nrow(Bdata),] +# Siki <- varargin[[2]] +# } +# else { +# A <- varargin[[1]]; B <- varargin[[2]] +# D <- 1/2*Norm(B-A) +# Tmp <- varargin[[3]] +# if(mode(Tmp)=="character") { +# H <- 0.2*D; Siki <- Tmp +# } +# else { +# H <- Tmp*D*0.2; Siki <- varargin[[4]] +# } +# H <- min(H,D) +# Ydata <- MakeBowdata(A,B,H) +# C <- Op(1,Ydata) +# R <- Op(2,Ydata) +# T <- (Op(3,Ydata)+Op(4,Ydata))/2 +# P <- C+R*c(cos(T),sin(T)) +# } + if(A[1]>B[1]+Eps){ + Tmp <- A + A <- B + B <- Tmp + } + if(Flg>0) { + Tmp <- B-A + } + else{ + Tmp <- A-B + } + Exprrot(P,Tmp,Tm,Tv,Siki) +} + +CalcHeight<-function(Hoko,Moji) +{ + D<-0 + H<-substring(Hoko,1,1) + Tmp<-paste("\\settoheight{\\Height}{",Moji,"}",sep="") + Str<-c(Tmp) + Tmp=paste("\\settodepth{\\Depth}{",Moji,"}",sep="") + Str<-c(Str,Tmp) + if(H=="n") Str<-c(Str,"\\setlength{\\Height}{\\Depth}") + if(H=="s") Str<-c(Str,"\\setlength{\\Height}{-\\Height}") + if(H=="c") + { + Str<-c(Str,"\\setlength{\\Height}{-0.5\\Height}") + Str<-c(Str,"\\setlength{\\Depth}{0.5\\Depth}") + Str<-c(Str,"\\addtolength{\\Height}{\\Depth}") + } + for (I in 1:length(Str)) cat(Str[I],file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +######################### + +CalcWidth<-function(Hoko,Moji) +{ + D<-0; + H<-substring(Hoko,2,2) + if(H=="e") D<-0 + if(H=="w") D<--1.0 + if(H=="c") D<--0.5 + Str1<-paste("\\settowidth{\\Width}{",Moji,"}",sep="") + Tmp<-as.character(D) + Str2<-paste("\\setlength{\\Width}{",Tmp,"\\Width}",sep="") + cat(Str1,file=Wfile,append=TRUE) + cat(Str2,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +######################### +# 17.09.17 +# 17.09.24 + +Circledata<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Cr<- varargin[[1]] + C=Cr[1:2] + if(length(Cr)==4){ + ra=Norm(C-Cr[3:4]) + Nop=2 + } + else{ + ra=Cr[3] + Nop=2 + } + R=c(0,2*pi) + N=50 + for (I in Looprange(Nop,Nargs)){ + Tmp<- varargin[[I]] + if(is.character(Tmp)){ + Tmp1=regexpr("=",Tmp) #17.09.24from + Tmp2=substring(Tmp,Tmp1+1,nchar(Tmp)) + Tmp1=substring(Tmp,1,Tmp1) + Tmp1=gsub("NUM", "N", toupper(Tmp1)) + Tmp1=gsub("RNG", "R", Tmp1) + Tmp=paste(Tmp1,Tmp2,sep="") #17.09.24upto + eval(parse(text=Tmp)) + } + } + Dt<- (R[2]-R[1])/N + T <- seq(R[1],R[2],by=Dt) + X <- C[1]+ra*cos(T) + Y <- C[2]+ra*sin(T) + XY<- c(X,Y) + P<- matrix(XY,ncol=2) + return(P) +} + +######################### +# 13.12.19 + +Closefile<-function(...) +{ + varargin<- list(...) + if(length(varargin)>=1){ + Pa<- varargin[[1]] + if(is.character(Pa)){ + if(Pa=="1") Endpicture(1) + if(Pa=="0") Endpicture(0) + } + } + Wfile<<-"" +} + +######################### + +Closepar<- function() +{ + S<- "%\n\\end{minipage}" + cat(S,file=Wfile,append=TRUE) + Closephr() +} + + +#################################### + +Closephr<- function() +{ + cat("%\n}%\n",file=Wfile,append=TRUE) +} + +##################################### + +Dataindex<-function(P) +{ + # Inf;Inf : Terminator + Ndm<-c() + if(length(P)==0) return(Ndm) + N1<-1 + Flg<-0 + for (J in 1:Nrow(P)) + { + if(P[J,1]==Inf) + { + Ndm<-Appendrow(Ndm,c(N1,J-1)) + N1<-J+1; + if(P[N1,1]==Inf) + { + Flg<-1; + break; + } + } + } + if(Flg==0) + { + Ndm<-Appendrow(Ndm,c(N1,Nrow(P))) + } + if(class(Ndm)=="numeric") + { + Tmp<-matrix(Ndm,nrow=1) + Ndm<- Tmp + } + return(Ndm) +} + +################################ + +Dashline<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Nall<- Nargs; Sen<- 1 ; Gap<- 1 + Tmp<- varargin[[Nall]] + if(mode(Tmp)=="numeric" && length(Tmp)==1 && Tmp>0){ + Tmp1<- varargin[[Nall-1]] + if(mode(Tmp1)=="numeric" && length(Tmp1)==1 && Tmp1>0){ + Sen<- Tmp1; Gap<- Tmp + Nall<- Nall-2 + } + else{ + Sen<- Tmp; Gap<- Sen + Nall<- Nall-1 + } + } + Sen<- 1000/2.54/MilliIn*Sen + Gap<- 1000/2.54/MilliIn*Gap + for (N in Looprange(1,Nall)){ + Pdata<- varargin[[N]] + if(is.numeric(Pdata)==1){ + Pdata<- list(Pdata) + } + for (II in 1:length(Pdata)){ + Figdata<- Op(II,Pdata) + Makehasen(Figdata,Sen,Gap,0) + } + } +} + +############################################## +# 17.11.27 + +Definecolor<- function(Name,Data){ + Tmp1=length(Data) + if((Tmp1<3) || (Tmp1>4)){ + cat("Size of data should be 3 or 4.") + return() + } + if(Tmp1==4){ + Tp="cmyk" + }else{ + Tp="rgb" + } + Tmp="" + for(J in 1:Tmp1){ + Tmp=paste(Tmp, as.character(Data[J]),sep="") + if(J0){ + for (J in Looprange(1,length(Sha))){ + Tmp<- Op(J,Sha) + Q<- Tmp[1,] + R<- Tmp[2,] + Tmp<- Dotprod(Q-P,V)/Kankaku + K1<- ceiling(Tmp) + if(abs(K1-Tmp)0){ + for (J in 1:length(Sha)){ + Tmp<- Op(J,Sha) + Q<- Tmp[1,] + R<- Tmp[2,] + Tmp<- Dotprod(Q-P,V)/Kankaku + K1<- ceiling(Tmp) + if(abs(K1-Tmp)0){ + for (J in 1:length(Sha)){ + Tmp<- Op(J,Sha) + Q<- Tmp[1,] + R<- Tmp[2,] + Tmp<- Dotprod(Q-P,V)/Kankaku + K1<- ceiling(Tmp) + if(abs(K1-Tmp) 1) { + Seg <- Lenall/(Nten-1) + } + else { + Seg <- Lenall + } + Eps <- 10^(-6)*Seg + PPd<-c() + Hajime <- 1 + for (I in Looprange(0,Nten-1)) { + Len <- Seg*I + if(I>0) { + J <- Hajime + while( Len>=Lenlist[J]+Eps) { + J <- J+1 + } + Hajime <- J-1 + } + T <- (Len-Lenlist[Hajime])/ + (Lenlist[Hajime+1]-Lenlist[Hajime]) + P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) + PPd<-Appendrow(PPd,P) + if(I==Nten-1) { + if(Norm(P-Data[1,])80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<-0 + } + } + if(Mojisu!=0){ + cat("%\n",file=Wfile,append=TRUE) + } + cat("\\special{fp}%\n",file=Wfile,append=TRUE) + } + } + } + Str<-"%" + if(Thick>0){ + Tmp<-PenThick/PenThickInit + Setpen(Tmp) + } +} + +########################################### + +Drwpt<-function(...) +{ ## Scaling is implemented + varargin<-list(...) + Nargs<-length(varargin) + if(TenSize>TenSizeInit){ + N<- round(6*sqrt(TenSize/TenSizeInit)) + } + else{ + N<-4 + } + Tmp<- varargin[[Nargs]] + if(mode(Tmp)=="numeric"){ + if(length(Tmp)>1){ + Kosa<- 1; All<- Nargs + } + else{ + Kosa<- Tmp; All<- Nargs-1 + } + } + else if(mode(Tmp)=="list"){ + Kosa<- 1; All<- Nargs + } + CL<-c() + for (J in 0:N){ + Tmp<- TenSize*0.5*1000/2.54/MilliIn + Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) + CL<- append(CL,Tmp) + } + CL<- matrix(CL,nrow=2) + CL<- t(CL) + for (II in Looprange(1,All)){ + MS<- varargin[[II]] + MS=Flattenlist(MS) #17.10.11 + if(mode(MS)=="numeric"){ + MS<- list(MS) + } + for (I in Looprange(1,length(MS))){ + P<- MS[[I]] + if(InWindow(P)!="i") next + P<- Doscaling(P) + PL<-c() + for (J in 0:N){ + PL<- c(PL,P+CL[J+1,]) + } + PL<-matrix(PL,nrow=2) + PL<-t(PL) + Mojisu<-0 + for (J in 1:Nrow(PL)){ + Q<- PL[J,] + X<- as.character(round(MilliIn*Q[1])) + Y<- as.character(-round(MilliIn*Q[2])) + Str<- paste("\\special{pa ",X," ",Y,"}",sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + if(Mojisu>80){ + cat("#\n",file=Wfile,append=TRUE) + } + Mojisu=0 + } + Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") + Str2<- "\\special{fp}%\n" + cat(Str1,file=Wfile,append=TRUE) + cat(Str2,file=Wfile,append=TRUE) + } + } +} + +###################################################### + +Drwxy<-function(...) +{ + varargin<-list(...) + Nargs <- length(varargin) + Tmp<-grep("arrow", ZIKU) + if(length(Tmp)>0) + { + Arrowline(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]),ARROWSIZE) + Arrowline(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX),ARROWSIZE) + } + else + { + Drwline(Listplot(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]))) + Drwline(Listplot(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX))) + } + Letter(c(XMAX,GENTEN[2]),XPOS,XNAME) + Letter(c(GENTEN[1],YMAX),YPOS,YNAME) + Letter(GENTEN,OPOS,ONAME); +} + +########################################## +# 10.12.04 + +Enclosing<- function(...) +{ + Eps=10^(-7) # Scilab 16.12.05 + varargin<- list(...) + Nargs<- length(varargin) + P<- varargin[[1]] + if(Mixtype(P)==2){ + Tmp<- Op(1,P) + if(mode(Tmp)!="numeric" || length(Tmp)>1){ + AnsL<- EnclosingS(...) + AnsL<- Joincrvs(AnsL) # 10.12.04 + } + } + Tmp1=Op(1,AnsL) # Scilab 16.12.05from + Tmp2=Op(nrow(AnsL),AnsL) + if(Norm(Tmp2-Tmp1)>Eps){ + AnsL=Appendrow(AnsL,Tmp1) + } + return(AnsL) +} + +######################################### + +EnclosingS<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + AnsL<- list() + PdataL<- varargin[[1]] + Nall<-length(PdataL) + Eps<- 10^(-3) + EEps<- 0.1 + S<- c() + Flg<- 0 + for (I in Looprange(2,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ + S<- Tmp + } + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + if(Flg==0){ + Eps<- Tmp + Flg=Flg+1 + } + else{ + EEps<- Tmp + } + } + } + F<- Op(1,PdataL); G<- Op(Nall,PdataL) + KL<- IntersectcrvsPp(F,G) + if(length(KL)==1){ + Tmp<- Op(1,KL) + P<- Op(1,Tmp) + T1<- Op(2,Tmp) + } + if(length(KL)==0){ + if(Numptcrv(F)>Numptcrv(G)){ + Tmp<- Nearestpt(F,G) + P<- Op(1,Tmp) + T1=Op(2,Tmp) + } + else{ + Tmp<- Nearestpt(G,F) + P<- Op(3,Tmp) + T1<- Op(4,Tmp) + } + } + if(length(KL)>=2){ + if(length(S)==0){ + return("No Start Point") + } + Tmp<- Op(1,KL) + P<- Op(1,Tmp) + T1<- Op(2,Tmp) + Tmp<- Norm(P-S) + for (I in Looprange(2,length(KL))){ + Tmp1<- Op(1,Op(I,KL)) + Tmp2<- Norm(Tmp1-S) + if(Tmp21) P<- Q + if(N==Nall){ + Q=S + } + else{ + Flg<- 0 + G<- Op(N+1,PdataL) + KL<- IntersectcrvsPp(G,F) + if(length(KL)==1){ + Tmp<- Op(1,KL) + Q<- Op(1,Tmp) + T3<- Op(2,Tmp) + Flg<- 10 + } + if(length(KL)==0) Flg<- 1 + if(length(KL)>=2){ # Maple bug? + Tmp1<- Op(1,Op(1,KL)) + Tmp2<- Op(1,Op(2,KL)) + Tmp<- Norm(Tmp1-Tmp2) + if(TmpNumptcrv(G)){ + Tmp<- Nearestpt(F,G) + Q<- Op(1,Tmp) + T3<- Op(4,Tmp) + Flg<- 10 + } + else{ + Tmp<- Nearestpt(G,F) + Q<- Op(3,Tmp) + T3<- Op(2,Tmp) + Flg<- 10 + } + } + if(Flg<10){ + T2<- Inf + for (I in Looprange(1,length(KL))){ + Dt<- Op(I,KL) + Tmp1<- Op(1,Dt) + Tmp<- Op(3,Dt) + Tmp2<- Paramoncurve(Tmp1,Tmp,F) + Tmp3<- Op(2,Dt) + if(Tmp2>T1+Eps && Tmp20){ + eval(parse(text=Op(I,StrL))) + } + } +} + +######################################### + +Expr<-function(...) +{ ## Scaling is implemented + varargin<-list(...) + Nargs<-length(varargin) + Irng<-c(seq(from=1,to=Nargs,by=3)) + for (I in Irng) + { + Tmp<-varargin[[I]] + P<- Doscaling(Tmp) + X<-P[1] + Y<-P[2] + Houkou<-varargin[[I+1]] + Mojiretu<-paste("$",varargin[[I+2]],"$",sep="") + Hset<-Houkou + Vhoko<-"c" + if(length(grep("n",Hset))>0) + { + Vhoko<-"n"; Y<-Y+MEMORI + } + if(length(grep("s",Hset))>0) + { + Vhoko<-"s"; Y<-Y-MEMORI + } + Hhoko<-"c" + if(length(grep("e",Hset))>0) + { + Hhoko<-"e"; X<-X+MEMORI + } + if(length(grep("w",Hset))>0) + { + Hhoko<-"w"; X<-X-MEMORI + } + Hoko<-paste(Vhoko,Hhoko,sep="") + Suu<-"+-.0123456789" + SuuL<-Suu + J<-1; Dstr<-"" + while (J<=nchar(Houkou)) + { + Tmp<-substring(Houkou,J,J) + if(length(grep(Tmp,Suu))>0) + { + if(Dstr=="") Hk<-substring(Houkou,J-1,J-1) + Dstr<-paste(Dstr,Tmp,sep="") + } + else + { + if(Dstr!="") + { + Nmbr<-as.numeric(Dstr) + D<-Nmbr*MEMORI + if(Hk=="n") Y<-Y+D + if(Hk=="s") Y<-Y-D + if(Hk=="e") X<-X+D + if(Hk=="w") X<-X-D + Dstr<-"" + } + } + J<-J+1 + } + if(Dstr!="") + { + Nmbr<-as.numeric(Dstr) + D<-Nmbr*MEMORI; + if(Hk=="n") Y<-Y+D + if(Hk=="s") Y<-Y-D + if(Hk=="e") X<-X+D + if(Hk=="w") X<-X-D + } + CalcWidth(Hoko,Mojiretu) + CalcHeight(Hoko,Mojiretu) + cat("\\put(",file=Wfile,append=TRUE) + Tmp1<- sprintf("%7.7f",X) # 11.07.19 + Tmp2<- sprintf("%7.7f",Y) # 11.07.19 + Str<-paste(Tmp1,",",Tmp2,sep="") + cat(Str,file=Wfile,append=TRUE) + Tmp<-"){\\hspace*{\\Width}" + Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) + } +} + +########################################## + +Exprrot<- function(...) +{ + varargin<- list(...) + P<- varargin[[1]] + V<- varargin[[2]]; N<- 3 + P<- Doscaling(P) + V<- Doscaling(V) + Tmov<- 0 + Tmp<- varargin[[N]] + if(mode(Tmp)=="numeric"){ + Tmov<- Tmp; N<- N+1 + } + Nmov<- 0 + Tmp<- varargin[[N]] + if(mode(Tmp)=="numeric"){ + Nmov<- Tmp; N<- N+1 + } + Mojiretu<- paste("$",Assign(varargin[[N]]),"$",sep="") # 2017.11.26 + Tv<- 1/Norm(V)*V + Nv<- c(-Tv[2],Tv[1]) + P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv + Tmp<- acos(V[1]/Norm(V)) + Theta<- round(Tmp*180/pi) + if(V[2]>=0){ + Units<- "" + } + else{ + Units<- "units=-360," + } + Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") + Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") + Letter(P,"c",Tmp) +} + +###################################################### + +Findcell<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + Ag<- varargin[[2]] + Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" + if(mode(Ag)=="character"){ + Clm<- c() + Rstr<- "" + for (I in Looprange(1,nchar(Ag))){ + C<- substr(Ag,I,I) + C<- toupper(C) + Tmp<- strsplit(Alpha,C) + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + Tmp1<- nchar(Tmp[1]) + Clm<- c(Clm,Tmp1) + } + else{ + Rstr<- paste(Rstr,C,sep="") + } + } + Nrg<- 0 + for (I in seq(length(Clm),1,by=-1)){ + Tmp<- Clm[I] + Tmp1<- length(Clm)-I + Nrg<- Nrg+Tmp*26^Tmp1 + } + Mrg<- eval(parse(text=Rstr)) + if(Nargs>=3){ + Ag<- varargin[[3]] + Clm<- c() + Rstr<- "" + for (I in Looprange(1,nchar(Ag))){ + C<- substr(Ag,1,1) + C<- toupper(C) + Tmp<- strsplit(Alpha,C) + if(length(Tmp)>1){ + Clm<- c(Clm,Tmp+1) + } + else{ + Rstr<- paste(Rstr,C,sep="") + } + } + Nrg2<- 0 + for (I in seq(length(Clm),1,by=-1)){ + Tmp<- Clm[I] + Tmp1<- length[Clm]-I + Nrg2<- Nrg2+Tmp*26^Tmp1 + } + Nrg<- c(Nrg,Nrg2) + Tmp=eval(parse(text=Rstr)) + Mrg<- c(Mrg,Tmp) + } + } + else{ + Nrg<- varargin[[2]] + Mrg<- varargin[[3]] + } + if(length(Mrg)==1){ + m1<- Mrg; m2<- m1+1 + } + else{ + m1<- Mrg[1]; m2<- Mrg[2] # 10.12.12 + } + if(length(Nrg)==1){ + n1<- Nrg; n2<- n1+1 + } + else{ + n1<- Nrg[1]; n2<- Nrg[2] + } + n1<- n1+1; n2<- n2+1 + m1<- m1+1; m2<- m2+1 + Hind<- TbL[[2]] + Vind<- TbL[[3]] + Tmp<- TbL[[1]] + HL<- Tmp[Hind] + Tmp1<- Op(1,TbL[[4]]) + Tmp2<- Op(2,TbL[[4]]) + HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) + VL<- Tmp[Vind] + Tmp1<- Op(1,TbL[[5]]) + Tmp2<- Op(2,TbL[[5]]) + VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) + Tmp<- TbL[[6]] + Tmp1<- Listplot(c(Ptsw(Tmp),Ptnw(Tmp))) + Tmp2<- Listplot(c(Ptse(Tmp),Ptne(Tmp))) + HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) + Tmp1<- Listplot(c(Ptnw(Tmp),Ptne(Tmp))) + Tmp2<- Listplot(c(Ptsw(Tmp),Ptse(Tmp))) + VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) + Tmp<- HL[[n1]] + if(mode(Tmp)=="numeric"){ + H1<- Tmp[1,1] + } + else{ + Tmp1<- Tmp[[1]] + H1<- Tmp1[1,1] + } + Tmp<- HL[[n2]] + if(mode(Tmp)=="numeric"){ + H2<- Tmp[1,1] + } + else{ + Tmp1<- Tmp[[1]] + H2<- Tmp1[1,1] + } + Tmp<- VL[[m1]] + if(mode(Tmp)=="numeric"){ + V1<- Tmp[1,2] + } + else{ + Tmp1<- Tmp[[1]] + V1<- Tmp1[1,2] + } + Tmp<- VL[[m2]] + if(mode(Tmp)=="numeric"){ + V2<- Tmp[1,2] + } + else{ + Tmp1<- Tmp[[1]] + V2<- Tmp1[1,2] + } + Pt<- c((H1+H2)/2,(V1+V2)/2) + High<- (V1-V2)/2 + Wide<- (H2-H1)/2 + Out<- list(Pt,Wide,High) + return(Out) +} + +############################################ + +Flattenlist<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Out<- list() + for(N in Looprange(1,Nargs)){ + D<- varargin[[N]] + if(is.data.frame(D) || !is.list(D)){ # modify + Out<- c(Out,list(D)) + } + else{ + for(I in Looprange(1,length(D))){ + Ds<- D[[I]] + Tmp<- Flattenlist(Ds) + Out<- c(Out,Tmp) + } + } + } + return(Out) +} + +############################################ + +Fontsize<- function(Ookisa) +{ + Str<- "%" + S<- substr(Ookisa,1,1) + if(S=="n"){ + Str<- "\\normalsize%" + } + if(S=="s"){ + if(nchar(Ookisa)==1){ + Tmp<- "n" + } + else{ + Tmp<- substr(Ookisa,2,2) + } + if(Tmp=="s"){ + Str<- "\\scriptsize%" + } + else{ + Str<- "\\small%" + } + } + if(S=="f"){ + Str<- "\\footnotesize%" + } + if(S=="t"){ + Str<- "\\tiny%" + } + if(S=="l"){ + Str<- "\\large%" + } + if(S=="L"){ + if(nchar(Ookisa)==1){ + Tmp<- "a" + } + else{ + Tmp<- substr(Ookisa,2,2) + } + if(Tmp=="a"){ + Str<- "\\Large%" + } + else{ + Str<- "\\LARGE%" + } + } + if(S=="h"){ + Str<- "\\huge%" + } + if(S=="H"){ + Str<- "\\Huge%" + } + cat(Str,file=Wfile,append=TRUE) + cat("\n",file=Wfile,append=TRUE) +} + +########################################## + +Fracform<- function(...) +{ + varargin<- list(...) + Eps<- 10^(-10) + Nmax<- 1/Eps + Nargs<- length(varargin) + X<- varargin[[1]] + Nr<- Nrow(X) + X<- as.matrix(X,nrow=Nr) + for (I in Looprange(2,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)!="numeric"){ + next + } + if(Tmp>1){ + Nmax<- Tmp + } + else if(Tmp>0){ + Eps<- Tmp + } + } + Tmp<- rep("",length(X)) + Out<- matrix(Tmp,nrow=nrow(X)) + for (I in Looprange(1,nrow(X))){ + for (J in Looprange(1,ncol(X))){ + Dt<- X[I,J] + if(mode(Dt)=="character"){ + Dt<- eval(parse(text=Dt)) + } + R<- 1 + N<- 0 + Rmin<- R + Nr<- N + while (R>Eps && N0) + { + Tmp<- Mixjoin(ShaL, list(Sha)) + ShaL <- Tmp + Sha<- Makeshasen(PtnL,PA+I*Kankaku*Vm,V,Bdy) + I <- I+1 + } + Sha<- Makeshasen(PtnL,PA-Kankaku*Vm,V,Bdy) + I<- 2 + while (length(Sha)>0) + { + for (J in 1:length(Sha)) + { + Tmp<- Mixjoin(ShaL,list(Sha[[J]])) + ShaL<- Tmp + } + Sha<- Makeshasen(PtnL,PA-I*Kankaku*Vm,V,Bdy) + I<- I+1 + } + } + else + { + Delta<- c(Xmn,Ymn)-StartP + K1<- trunc(Dotprod(Delta,Vm)/Kankaku) + Delta<- c(Xmx,Ymn)-StartP + K2<- trunc(Dotprod(Delta,Vm)/Kankaku) + Delta<- c(Xmx,Ymx)-StartP + K3<- trunc(Dotprod(Delta,Vm)/Kankaku) + Delta<- c(Xmn,Ymx)-StartP + K4<- trunc(Dotprod(Delta,Vm)/Kankaku) + IM<- max(K1,K2,K3,K4) + Im<- min(K1,K2,K3,K4) + for (I in Im:IM) + { + Sha<- Makeshasen(PtnL,StartP+I*Kankaku*Vm,V,Bdy) + for (J in Looprange(1,length(Sha))) + { + Tmp<- Mixjoin(ShaL, list(Sha[[J]])) + ShaL<- Tmp + } + } + } + ShaLs<-list() + for (I in Looprange(1,length(ShaL))) + { + Tmp<- ShaL[[I]] + Tmp1<- Unscaling(Tmp) + Tmp2<- Mixjoin(ShaLs, list(Tmp1)) + ShaLs<- Tmp2 + } + ShaL<- ShaLs + return(ShaL) +} + +###################################### + +Htickmark<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + ArgsL<- varargin + if(mode(ArgsL[[1]])=="character"){ + Str<- ArgsL[[1]] + Tmp<- strsplit(Str,"m") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + I<- nchar(Tmp[1])+1 + } + else{ + I<- 0 + } + Tmp<- strsplit(Str,"n") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + J<- nchar(Tmp[1])+1 + } + else{ + J<- 0 + } + Tmp<- strsplit(Str,"r") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + K=nchar(Tmp[1])+1 + } + else{ + K<- 0 + } + if(K>0){ + S<- substr(Str,K+1,nchar(Str)) + R<- as.numeric(S) + if(is.na(R)){ + R<- 1 + } + } + else{ + R<- 1 + K<- nchar(Str)+1 + } + if(J>0){ + S<- substr(Str,J+1,K-1) + Dn<- as.numeric(S) + if(is.na(Dn)){ + Dn<- 1 + } + } + else{ + Dn<- 1000 + J<- nchar(Str)+1 + } + S<- substr(Str,I+1,J-1) + Dm<- as.numeric(S) + if(is.na(Dm)){ + Dm<- 1 + } + ArgsL<- list() + for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + } + MemoriList<- list() + Memori<- list() + for (N in 1:length(ArgsL)){ + Dt<- ArgsL[[N]] + if(mode(Dt)=="numeric" && length(Dt)>1){ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt[1],Dt[2]) + next + } + if(mode(Dt)=="character"){ + Memori<- Mixjoin(Memori,Dt) + } + else{ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt,GENTEN[2]) + } + } + MemoriList<- Mixjoin(MemoriList,list(Memori)) + for (N in 1:length(MemoriList)){ + Dt<- MemoriList[[N]] + Ndt<- length(Dt) + X=Op(1,Dt) + Y=Op(2,Dt) + Tmp<-Doscaling(c(X,Y)) + X<- Tmp[1] + Y<- Tmp[2] + Moji<- Op(Ndt,Dt) + Tmp1<- Unscaling(c(X,Y+MARKLEN)) + Tmp2<- Unscaling(c(X,Y-MARKLEN)) + Fd<- Listplot(c(Tmp1,Tmp2)) + Drwline(Fd) + if(Ndt==3){ + Tmp<-Unscaling(c(X,Y-MARKLEN)) + Expr(Tmp,"s",Moji) + } + if(Ndt==4){ + Houkou<- Op(3,Dt) + Tmp<-grep("s",Houkou) + if(length(Tmp)>0){ + Tmp<-Unscaling(c(X,Y-MARKLEN)) + Expr(Tmp,Houkou,Moji) + } + else{ + Tmp<- Unscaling(c(X,Y+MARKLEN)) + Expr(Tmp,Houkou,Moji) + } + } + cat("%\n",file=Wfile,append=TRUE) + } +} + +############################################# +# 2013.08.07 + +Integrate<- function(Fs,Vs, Intv){ + if(is.function(Fs)){ + Fn<- Fs + } + else{ + Str<- paste("Fn<- function(",Vs, ") ", Fs, sep="") + eval(parse(text=Str)) + } + Tmp<- integrate(Fn, Intv[[1]], Intv[[2]]) + Out<- Tmp[[1]] + return(Out) +} + +############################################# + +Intersectcrvs<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + Eps<-10^(-4) + Tmp<-varargin[[Nargs]] + if(mode(Tmp)=="numeric" && length(Tmp)==1) + { + Eps<-Tmp + } + G1<-varargin[[1]] + if(mode(G1)=="numeric") + { + G1<-list(G1) + } + G2<-varargin[[2]] + if(mode(G2)=="numeric") + { + G2<-list(G2) + } + PL<-list() + for (N in 1:length(G1)) + { + for (M in 1:length(G2)) + { + KL<-IntersectcrvsPp(G1[[N]],G2[[M]],Eps) + for (I in Looprange(1,length(KL))) + { + Tmp<-KL[[I]] + P<-Tmp[1] + PL<-append(PL,P) + } + } + } + return(PL) +} + +########################################### + +IntersectcrvsPp<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + G1<-varargin[[1]]; G2<-varargin[[2]] + Eps<- 10.0^(-4) + if(Nargs>2) Eps<-varargin[[3]] + SqEps<- 10.0^(-10) + Eps2<- 0.1 + if(Nargs>3) Eps2<-varargin[[4]] + Data1<-G1 + Data2<-G2 + if(Nrow(Data1)==Nrow(Data2)) + { + Tmp<-seq(Nrow(Data2),1, by=-1) + Tmp1<-Data2[Tmp,] + Eps0<-10^(-6) + Tmp2<-Norm(Data1-Data2) + Tmp3<-Norm(Data1-Tmp1) + if(Tmp20) + { + Tmp<-KL1[[1]] + P<-Tmp[[1]] + T<-Tmp[[2]] + I<-Tmp[[3]] + J<-Tmp[[4]] + Tmp<-list(P,I+T,J) + KL<-list(Tmp) + } + for (N in Looprange(2,length(KL1))) + { + Tmp<-KL1[[N]] + P<-Tmp[[1]] + Flg<-0 + for (K in 1:length(KL)) + { + if(1>length(KL)) break + Tmp<-KL[[K]] + if(Norm(P-Tmp[[1]])^20){ # 13.12.20 + Tmp1<- varargin[[Nall-1]] + if(is.numeric(Tmp1) && length(Tmp1)==1 && Tmp1>0){ # 13.12.20 + Sen<- Tmp1; Gap<- Tmp + Nall<- Nall-2 + } + else{ + Sen<- Tmp; Gap<- Sen + Nall<- Nall-1 + } + } + Sen<- 1000/2.54/MilliIn*Sen + Gap<- 1000/2.54/MilliIn*Gap + for (N in Looprange(1,Nall)){ + Figdata<- varargin[[N]] + Makehasen(Figdata,Sen,Gap,1) + } +} + +######################################### + +Invert<- function(Pd) +{ + OutL=Pd[nrow(Pd):1,] + return(OutL) +} + +############################################ + +InWindow<-function(PA) +{ + Eps<-10.0^(-6); + if((length(PA)==2)&(is.numeric(PA))){ # 17.11.20 + X<-PA[1]; Y<-PA[2]; + if(X>XMIN-Eps && XYMIN-Eps && YEps){ + PtL<- Appendrow(PtL,Qd) + } + else{ + if(is.null(nrow(Qd))){ Qd<- as.matrix(Qd,nrow=1)} + PtL<- Appendrow(PtL,Qd[2:nrow(Qd),]) # 11.06.25 + } + } + return(PtL) +} + +######################################## +# 2011.11.02 + +Joingraphics<- function(...) +{ + varargin<- list(...) + Ls<- Flattenlist(varargin) + N<- length(Ls) + Tp<- Ls[[N]] + Listflg<- 0 + if( is.character(Tp)){ + Tmp<- toupper(substr(Tp,1,1)) + if(Tmp=="L"){ + Listflg<- 1 + } + N<- N-1 + Ls<- Ls[1:N] + } + if(Listflg==1){ + P<- Ls + } + else{ + P<- c() + for (I in 1:N){ + Tmp<- Ls[[I]] + P<- Appendrow(P,c(Inf,Inf)) + P<- Appendrow(P,Tmp) + } + P<- P[2:nrow(P),] + } + return(P) +} + +######################################## + +Kouten<- function(PA,V,P,Q) +{ + Eps<- 10.0^(-6) + A1<- PA[1]; A2<- PA[2] + V1<- V[1]; V2<- V[2] + P1<- P[1]; P2<- P[2] + U1<- Q[1]-P1; U2<- Q[2]-P2 + Tmp<- Norm(P-Q)*Norm(V) + if(Tmp==0) + { + Out<- list(Inf,-Inf) + return(Out) + } + D<- U1*V2-U2*V1 + if(abs(D)/Tmp1+Eps || S=5) + { + Eps<-varargin[[5]] + } + Eps2 <- 0.2 + if(Nargs>=6) + { + Eps2<-varargin[[6]] + } + Eps<-min(Eps2,Eps/sqrt(Sv2)) + P1<-(P[1]*V[1]+P[2]*V[2])/Sv2 + P2<-(-P[1]*V[2]+P[2]*V[1])/Sv2 + Q1<-(Q[1]*V[1]+Q[2]*V[2])/Sv2 + Q2<-(-Q[1]*V[2]+Q[2]*V[1])/Sv2 + m1 <- -Eps; M1 <- 1+Eps + m2 <- -Eps; M2 <- Eps + if(max(P1,Q1)M1) + { + Out<-Inf + return(Out) + } + if(max(P2,Q2)M2) + { + Out<-Inf + return(Out) + } + if(P2*Q2<0) + { + T<- P1-(Q1-P1)/(Q2-P2)*P2 + if(T>m1 && T -Eps0 && T<1+Eps0) + { + Tmp1<-A+T*V + Tmp2<-min(max(T,0),1) + Out<-list(Tmp1,Tmp2,0) + } + else + { + Tmp1<-A+T*V + Tmp2<-min(max(T,0),1) + Out<-list(Tmp1,Tmp2,1) + } + return(Out) + } + if(P1M1 || P2M2) + { + if(Q1M1 || Q2M2) + { + Out<-Inf + return(Out) + } + T<-min(max(Q1,0),1) + Tmp=A+T*V + Out<-list(Tmp,T,1) + return(Out) + } + T<-min(max(P1,0),1) + Tmp<-A+T*V + Out<-list(Tmp,T,1) + return(Out) + } + if(P1> -Eps0 && P1<1+Eps0 && P2> -Eps0 && P2 < Eps0) + { + T<- P1 + Tmp<- A+T*V + Out<- list(Tmp, T, 0) + return(Out) + } + if(Q1> -Eps0 && Q1<1+Eps0 && Q2> -Eps0 && Q2M1 || P2M2) + { + if(Q1M1 || Q2M2) + { + Out<-Inf + return(Out) + } + T<-min(max(Q1,0),1) + Tmp<-A+T*V + Out<-list(Tmp,T,1) + return(Out) + } + if(Q1M1 || Q2M2) + { + T<-min(max(P1,0),1) + Tmp<-A+T*V + Out<-list(Tmp,T,1) + return(Out) + } + if(abs(P2)Eps) + { + QL<-Pt1 + } + Tmp<-Appendrow(QL,PL[(N1+1):N2,]) + QL<- Tmp + if(Norm(Pt2-Op(N2,PL))>Eps) + { + Tmp<-Appendrow(QL,Pt2) + QL<- Tmp + } + HidariL<- QL + Ms<- M2+1; Me<- M1 + if(T1Eps) + { + Tmp<-Append(HidariL,P) + HidariL<-Tmp + } + } + Tmp<- Op(Nrow(HidariL),HidariL) + if(Norm(Tmp-Pt1)>Eps) + { + Tmp<-Append(HidariL,Pt1) + HidariL<-Tmp + } + MigiL<- QL + Ms<- M2; Me<- M1+1 + if(T1>T2-Eps) Me<- Me-4 + for (Mm in Looprange(Me,Ms)) + { + M<- Me+Ms-Mm + Tmp<- Op(Nrow(MigiL),MigiL) + P<- Op(((M-1) %% 4)+1,Sikaku) + if(Norm(Tmp-P)>Eps) + { + Tmp<-Appendrow(MigiL,P) + MigiL<-Tmp + } + } + Tmp<- Op(Nrow(MigiL),MigiL) + if(Norm(Tmp-Pt1)>Eps) + { + Tmp<-Appendrow(MigiL,Pt1) + MigiL<-Tmp + } + Out<- list(HidariL,MigiL) + return(Out) +} + +################################### +# 17.09.24 Eps + +Kyoukai<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps0<- 10^(-7) + DataL<-list() + for (I in 1:Nargs){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric"){ + DataL<- Mixjoin(DataL,list(list(Tmp))) + } + if(mode(Tmp)=="list"){ + if(mode(Tmp[[1]])!="list"){ + DataL<- Mixjoin(DataL, list(Tmp)) + } + else{ + DataL<-Mixjoin(DataL,Tmp) + } + } + } + Eps<- 10.0^(-4) #17.09.24 + PLall<- list() + Sflg<- 0 + N<- length(DataL) + for (I in 1:N){ + Data<- Op(I, DataL) + Tmp<- Op(length(Data),Data) + if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ + Rg<-Tmp ; Nd<-length(Data)-1 + } + else{ + if(mode(Tmp)=="character"){ + Rg<- Tmp ; Nd<-length(Data)-1 + } + else{ + Rg<- "c" ; Nd<-length(Data) + } + } + for (J in Looprange(1,Nd)){ + Tmp<- Op(J,Data) + if(mode(Tmp)=="character"){ + Rg<- Tmp + next + } + Points<- Tmp + P1<- Ptstart(Points) + P2<- Ptend(Points) + if(J==1){ + PL<- Points + Pfirst<- P1 + Plast<- P2 + if(Nd>=2){ + Tmp<- Data[[2]] + P<- Ptstart(Tmp) + Q<- Ptend(Tmp) + if(Norm(P2-P)>Eps && Norm(P2-Q)>Eps){ + Tmp< Nrow(PL) + PL<-PL[Tmp:1,] + Pfirst<- Ptstart(PL) + Plast<- Ptend(PL) + } + } + } + else{ + if(Norm(P1-Plast)Eps){ + Np<- Nrow(PL) + if(Rg=="c"){ + Tmp<- Appendrow(PL,Pfirst) + PL<- Tmp + } + else if(Rg=="s"){ + Tmp<- c(PL[1:Np,2],YMIN) + Y<- min(Tmp)-1 + P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) + Tmp<- Appendrow(PL,P,Q,Pfirst) + PL<- Tmp + } + else if(Rg=="n"){ + Tmp<- c(PL[1:Np,2],YMAX) + Y<-max(Tmp)+1 + P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) + Tmp<- Appendrow(PL,P,Q,Pfirst) + PL<- Tmp + } + else if(Rg=="w"){ + Tmp<- c(PL[1:Np,1],XMIN) + X<- min(Tmp)-1 + P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) + Tmp<- Appendrow(PL,P,Q,Pfirst) + PL<- Tmp + } + else if(Rg=="e"){ + Tmp<- c(PL[1:Np,1],XMAX) + X<- max(Tmp)+1 + P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) + Tmp<- Appendrow(PL,P,Q,Pfirst) + PL<- Tmp + } + else if(mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){ + Tmp<- Kukeiwake(PL) + Tmp1<- Op(1,Tmp) + Tmp2<- Naigai(Rg,list(Tmp1)) + if(Tmp2==c(1)){ + PL<-Op(1,Tmp) + } + else{ + PL<- Op(2,Tmp) + } + } + } + Tmp<- Ptstart(PL) + for (J in 2:Nrow(PL)){ + P<- Op(J,PL) + Q<- Op(Nrow(Tmp),Tmp) + if(Norm(P-Q)>Eps){ + Tmp1<-Appendrow(Tmp,P) + Tmp<-Tmp1 + } + } + PL<-Tmp + PLall<-Mixjoin(PLall,list(PL)) + } + if(length(PLall)==1 && Sflg==0){ + Tmp<- Op(1,PLall) +# Tmp<- Op(1,Tmp) + if(Norm(Ptstart(Tmp)-Ptend(Tmp))>Eps0){ + Tmp1<- Appendrow(Tmp,Ptstart(Tmp)) + PLall<- list(Tmp1) + } + } + return(PLall) +} + +###################################### + +Letter<-function(...) +{ ## Scaling is implemented + varargin<-list(...) + Nargs<-length(varargin) + Irng<-c(seq(from=1,to=Nargs,by=3)) + for (I in Irng) + { + Tmp<-varargin[[I]] + P<- Doscaling(Tmp) + X<-P[1] + Y<-P[2] + Houkou<-varargin[[I+1]] + Mojiretu<-varargin[[I+2]] + Hset<-Houkou + Vhoko<-"c" + if(length(grep("n",Hset))>0) + { + Vhoko<-"n"; Y<-Y+MEMORI + } + if(length(grep("s",Hset))>0) + { + Vhoko<-"s"; Y<-Y-MEMORI + } + Hhoko<-"c" + if(length(grep("e",Hset))>0) + { + Hhoko<-"e"; X<-X+MEMORI + } + if(length(grep("w",Hset))>0) + { + Hhoko<-"w"; X<-X-MEMORI + } + Hoko<-paste(Vhoko,Hhoko,sep="") + Suu<-"+-.0123456789" + SuuL<-Suu + J<-1; Dstr<-"" + while (J<=nchar(Houkou)) + { + Tmp<-substring(Houkou,J,J) + if(length(grep(Tmp,SuuL))>0) + { + if(Dstr=="") Hk<-substring(Houkou,J-1,J-1) + Dstr<-paste(Dstr,Tmp,sep="") + } + else + { + if(Dstr!="") + { + Nmbr<-as.numeric(Dstr) + D<-Nmbr*MEMORI + if(Hk=="n") Y<-Y+D + if(Hk=="s") Y<-Y-D + if(Hk=="e") X<-X+D + if(Hk=="w") X<-X-D + Dstr<-"" + } + } + J<-J+1 + } + if(Dstr!="") + { + Nmbr<-as.numeric(Dstr) + D<-Nmbr*MEMORI; + if(Hk=="n") Y<-Y+D + if(Hk=="s") Y<-Y-D + if(Hk=="e") X<-X+D + if(Hk=="w") X<-X-D + } + CalcWidth(Hoko,Mojiretu) + CalcHeight(Hoko,Mojiretu) + cat("\\put(",file=Wfile,append=TRUE) + Tmp1<- sprintf("%7.7f",X) # 11.07.19 + Tmp2<- sprintf("%7.7f",Y) # 11.07.19 + Str<-paste(Tmp1,",",Tmp2,sep="") + cat(Str,file=Wfile,append=TRUE) + Tmp<-"){\\hspace*{\\Width}" + Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) + } +} + +###################################################### + +Letterrot<- function(...) +{ + varargin<- list(...) + P<- varargin[[1]] + V<- varargin[[2]]; N<- 3 + P<- Doscaling(P) + V<- Doscaling(V) + Tmov<- 0 + Tmp<- varargin[[N]] + if(mode(Tmp)=="numeric"){ + Tmov<- Tmp; N<- N+1 + } + Nmov<- 0 + Tmp<- varargin[[N]] + if(mode(Tmp)=="numeric"){ + Nmov<- Tmp; N<- N+1 + } + Mojiretu<- Assign(varargin[[N]]) #2017.11.26 + Tv<- 1/Norm(V)*V + Nv<- c(-Tv[2],Tv[1]) + P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv + Tmp<- acos(V[1]/Norm(V)) + Theta<- round(Tmp*180/pi) + if(V[2]>=0){ + Units<- "" + } + else{ + Units<- "units=-360," + } + Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") + Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") + Letter(P,"c",Tmp) +} + +################################### +# 10.12.04 + +Lineplot<-function(...) +{ + varargin <- list(...) + Nargs<-length(varargin) + A<-varargin[[1]] + if(is.numeric(A)) { + Tmp<-length(A) + if(Tmp>3) { + B <- A[(Tmp/2+1):Tmp] + A <- A[1:(Tmp/2)] + Is <- 2 + } + else { + B<-varargin[[2]] + Is <- 3 + } + } + else { + B<-A[[2]] + A<-A[[1]] + Is <- 2 + } + Mag <- 100 ; Semi <- "" ## 10.12.04 + for (I in Looprange(Is,Nargs)) { + Tmp <- varargin[[I]] + switch ( mode(Tmp), + "numeric"= Mag <- Tmp, + "character"= Semi <- Tmp + ) + } +V<- Mag/Norm(B-A)*(B-A) ## 10.12.04 from here + if(Semi=="") { + Out<- Listplot(c(A-V,A+V)) + } + else if(Semi=="+") { + Out<- Listplot(c(A,A+V)) + } + else { + Out<- Listplot(c(A-V,A)) + } ## 10.12.04 to here + return(Out) +} + +################################ + +Listplot<-function(...) +{ + varargin<-list(...); + Z<-c(); + for (I in 1:length(varargin)) + { + Data<-varargin[[I]]; + if(mode(Data)=="numeric") + { + if(class(Data)=="numeric") + { + Tmp<-matrix(Data,nrow=2); + Tmp<-t(Tmp); + Z<-Appendrow(Z,Tmp) + } + else + Z<-Appendrow(Z,Data) + } + else + { + for (J in 1:length(Data)) + { + Tmp<-Data[[J]]; + Z<-Appendrow(Z,Tmp) + } + } + } + return(Z) +} + +############################## + +MakeBowdata <- function(PA,PB,H) +{ + Eps <- 10^(-5) + BOWSTART <<- PA + BOWEND <<- PB + D <- 1/2*Norm(PB-PA) + R <- (H^2+D^2)/(2*H) + A1 <- PA[1]; A2<-PA[2] + B1 <- PB[1]; B2<-PB[2] + if(abs(A2-B2)>Eps){ +# x <- poly(0,"X") +# y <- -(A1-B1)*x/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) +# Eq1 <- (A1-x)^2+(A2-y)^2-R^2 +# Tmp <- coeff(Eq1) +# C0 <- Tmp[1]; C1<-Tm[2]; C2<-Tmp[3] + C0<- A1^2+(A2-(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2))^2-R^2 + C1<- -(A1+B1)*(A2^2+B2^2-2*A2*B2-2*A1*B1+A1^2+B1^2)/(A2-B2)^2 + C2<- 1+(A1-B1)^2/(A2-B2)^2 + Det <- sqrt(C1^2-4*C0*C2) + Ansx1 <- (-C1+Det)/(2*C2) + Ansx2 <- (-C1-Det)/(2*C2) + Tmp <- -(A1-B1)*Ansx1/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) + PC <- c(Ansx1,Tmp) + Tmp <--(A1-B1)*Ansx2/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) + PC2 <- c(Ansx2,Tmp) + } + else{ + Tmp <- 0.5*(PA+PB) + PC <- Tmp+c(0,R-H) # 11.06.02 + PC2 <- Tmp-c(0,R-H) + } + VA <- PA-PC + VB <- PB-PC + if(VA[1]*VB[2]-VA[2]*VB[1]<0) { + PC <- PC2 + } + AngA <- acos((PA[1]-PC[1])/R) + if(PA[2]-PC[2]<0){ + AngA <- -AngA + } + AngB <- acos((PB[1]-PC[1])/R) + if(PB[2]-PC[2]<0){ + AngB <- -AngB + } + if(AngA>AngB) { + AngB <- AngB+2*pi + } + Out <- list(PC,R,AngA,AngB) + return(Out) +} + +#################################################### + +MakeCurves<-function(...){ ## Scaling is implemented + varargin<-list(...) + Figdata<-varargin[[1]] + if(class(Figdata)=="numeric"){ + Figdata<-matrix(Figdata,nrow=1) + } + Ptout<-1 + if(length(varargin)>=2) Ptout<-varargin[[2]] + Eps<-10.0^(-6) + IndM<-Dataindex(Figdata) + Atos<-c() + for (Nd in 1:Nrow(IndM)){ + Tmp<-IndM[Nd,] + Motos<-Figdata[Tmp[1]:Tmp[2],] + All<-Nrow(Motos) + if(Nrow(Motos)==1){ + if(InWindow(Motos)=="o"){ + next + } + Tmp1<- as.numeric(Motos) + if(Ptout==1){ + Drwpt(Tmp1) + } + else{ + Tmp1<- Doscaling(Tmp1) + Atos<-Appendrow(Atos,c(Inf,Inf),Tmp1) + next + } + } + Crv<-c() + for (I in Looprange(2,All)){ + P<- Op(I-1,Motos) + Q<- Op(I,Motos) + Snbn<-MeetWindow(P,Q) + if(length(Snbn)==0){ + if(length(Crv)>0){ + Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) + Crv<-c() + } + } + else{ + if(Norm(Snbn[1,]-Snbn[2,])=2) + { + Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) + } + } + Outdata<-Atos[2:Nrow(Atos),] + if(class(Outdata)=="numeric") + { + Outdata<-matrix(Outdata,nrow=1) + } + return(Outdata) +} + +###################################### + +Makehasen<- function(Figdata,Sen,Gap,Ptn) +{ + Eps<- 10.0^(-6) + Clist<- MakeCurves(Figdata) + DinM<- Dataindex(Clist) + for (N in Looprange(1,Nrow(DinM))){ + Tmp<- DinM[N,] + Data<- Clist[Tmp[1]:Tmp[2],] + Dtall<- Nrow(Data) + Len<- 0 + Lenlist<- c(0) + for (I in Looprange(2,Dtall)){ + Len<- Len+Norm(Data[I,]-Data[I-1,]) + Lenlist<- c(Lenlist,Len) + } + Lenall<- Lenlist[Dtall] + if(Lenall==0){ + next + } + Kari<- (Sen+Gap)*0.1 + Naga<- Sen*0.1 + Tobi<- Gap*0.1 + if(Norm(Data[1,]-Data[Dtall,])=Lenlist[J]-Eps){ + if(J==Dtall){ + break + } + J<- J+1 + } + Hajime<- J-1 + J<- Hajime + while (Len+Naga>Lenlist[J]-Eps){ + if(J==Dtall){ + break + } + J<- J+1 + } + Owari<- J-1 + T<- (Len-Lenlist[Hajime]) + T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) + P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) + X<- as.character(round(MilliIn*P[1])) + Y<- as.character(-round(MilliIn*P[2])) + Str<- paste("\\special{pa ",X," ",Y,"}",sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + for (J in Looprange(Hajime+1,Owari)){ + P<- Data[J,] + X<- as.character(round(MilliIn*P[1])) + Y<- as.character(-round(MilliIn*P[2])) + Str<- paste("\\special{pa ",X," ",Y,"}",sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + } + T<- (Len+Naga-Lenlist[Owari]) + T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) + P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) + X<- as.character(round(MilliIn*P[1])) + Y<- as.character(-round(MilliIn*P[2])) + Str1<- paste("\\special{pa ",X," ",Y,"}",sep="") + Str2<- "\\special{fp}" + cat(Str1,file=Wfile,append=TRUE) + cat(Str2,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str1)+nchar(Str2) + if(Mojisu>80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<- 0 + } + } + } + cat("%\n%\n",file=Wfile,append=TRUE); +} + +###################################### + +Makeliststr<- function(L) +{ + Out="list(" + for (I in 1:length(L)){ + Dt<- L[[I]] + if(mode(Dt)=="numeric"){ + if(length(Dt)==1){ + Dts<- as.character(Dt) + } + else{ + Dts<- "c(" + for (J in Looprange(1,Nrow(Dt))){ + for (K in 1:ncol(Dt)){ + Dts<- paste(Dts,as.character(Dt[J,K]),sep="") + if(K< ncol(Dt)){ + Dts<- paste(Dts,",",sep="") + } + } + if(JEps){ + if(Member(Ptn,PtnL)){ + if(abs(Te-Ts)>Eps){ + if(Nrow(GL)>0){ + Tmp<- Mixjoin(Out, list(GL)) + Out<- Tmp + } + GL<- Listplot(P,Q) + } + else{ + Tmp <- Appendrow(GL, Q) + GL<- Tmp + } + Te<- Op(1,TenQ) + } + } + } + if(Nrow(GL)>0){ + Tmp<- Mixjoin(Out, list(GL)) + Out<- Tmp + } + return(Out) +} + +############################################# + +Mawarikomi<- function(...) +{ + varargin<- list(...) + haba<- "10cm" + Nargs<- length(varargin) + if(Nargs>0){ + haba<- varargin[[1]] + } + cat("\\begin{mawarikomi}%\n",file="",append=TRUE) + cat("%<1>[5](0,0)%\n",file="",append=TRUE) + Str<- paste("{",haba,"}{%\n",sep="") + cat(Str,file="",append=TRUE) + cat("}%\n",file="",append=TRUE) + cat("\\end{mawarikomi}",file="",append=TRUE) +} + +############################################## + +MeetWindow<-function(PA,PB) +{ + if(InWindow(PA)=="i" && InWindow(PB)=="i") + { + R<-Appendrow(PA,PB) + return(R) + }; + Horner<-function(n,t) + { + PT<-(1-t)*PA+t*PB; + return(PT[n]) + } + Eps<-10.0^(-6); + Txm<-(-1); TxM<-(-1); Tym<-(-1); TyM<-(-1); + if(PA[1]!=PB[1]) + { + Txm<-(XMIN-PA[1])/(PB[1]-PA[1]); + TxM<-(XMAX-PA[1])/(PB[1]-PA[1]); + } + if(PA[2]!=PB[2]) + { + Tym<-(YMIN-PA[2])/(PB[2]-PA[2]); + TyM<-(YMAX-PA[2])/(PB[2]-PA[2]); + } + Tmp<-Horner(2,Txm); + if(TmpYMAX+Eps) + { + Txm<-(-1); + } + Tmp<-Horner(2,TxM); + if(TmpYMAX+Eps) + { + TxM<-(-1) + } + Tmp<-Horner(1,Tym); + if(TmpXMAX+Eps) + { + Tym<--1 + } + Tmp<-Horner(1,TyM); + if(TmpXMAX+Eps) + { + TyM<--1 + } + Tans<-sort(c(Txm,TxM,Tym,TyM)); + Tmp<-c(); + for (I in 1:length(Tans)) + { + Tmp1<-Tans[I]; + if(Tmp1>-Eps && Tmp1<1+Eps) + { + if(length(Tmp)==0) + { + Tmp<-c(Tmp1); + } + else + { + if(abs(Tmp[length(Tmp)]-Tmp1)>Eps) + { + Tmp<-c(Tmp,Tmp1) + } + } + } + } + Tans<-Tmp; + if(length(Tans)==0) + { + R<-c(); + return(R); + } + if(length(Tans)==1) + { + Ten1<-Horner(1:2,Tans[1]); + if(InWindow(PA)=="i") + { + R<-Appendrow(PA,Ten1) + return(R) + } + else + { + R<-Appendrow(Ten1,PB) + return(R) + } + } + Ten1<-Horner(1:2,Tans[1]) + Ten2<-Horner(1:2,Tans[2]) + R<-Appendrow(Ten1,Ten2) + return(R) +} + +######################################### + +# New 10.03.21 + +Mixjoin<-function(...) +{ + varargin<-list(...) + Nargs<- length(varargin) + M<- list() + for (I in 1:Nargs) + { + Tmp<-varargin[[I]] + if(length(Tmp)==0) next + if(Mixtype(Tmp)==1) + { + Tmp<-list(Tmp) + } + if(length(M)==0){ + M <- Tmp + } + else{ + M<- c(M,Tmp) + } + } + return(M) +} + +################################# + +Mixlength<- function(PL){ + if(length(PL)==0){ + return(0) + } + if(Mixtype(PL)==1){ + Out<- Nrow(PL) + } + else{ + Out<- length(PL) + } + return(Out) +} + +########################################### + +Mixtype<- function(D) +{ + if(mode(D)!="list") return(1) + for (I in 1:length(D)) + { + Tmp<- D[[I]] + if(mode(Tmp)=="list") return(3) + } + return(2) +} + +########################################### + +Naigai<- function(A,Bdy) +{ + V<- c(1,1) + Call<-length(Bdy) + KL<- KoutenList(A,V,Bdy) + Ptn<- seq(1,1,length=Call) + for (K in Looprange(1,length(KL))) + { + Ten<- Op(K,KL) + T<- Op(1,Ten); NC<- Op(4,Ten) + if(T<0) + { + Tmp<- (Ptn[NC]+1) %% 2 + Ptn[NC]<- Tmp + } + } + return(Ptn) +} + +######################################## + +Nearestpt<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + PL1<- varargin[[1]] + if(!is.matrix(PL1)){ + Tmp<- matrix(PL1); + PL1<- t(Tmp) + } + if(Nrow(PL1)==1) Flg=0 + else Flg=1 + Eps<- 10.0^(-6) + PL<- varargin[[2]] + Ans<- list(PL1[1,],1,PL[1,],1,Norm(PL1[1,]-PL[1,])) + for(N in Looprange(1,Nrow(PL1))){ + PA<- PL1[N,] + Pm<- PL[1,] + Im<- 1 + Sm<- Norm(Pm-PA) + for(I in Looprange(1,Nrow(PL)-1)){ + A1<- PL[I,1]; A2<-PL[I,2] + B1<- PL[I+1,1]; B2<-PL[I+1,2] + V1<- B1-A1; V2<-B2-A2 + X1<- PA[1]; X2<-PA[2] + Tmp<-V2^2+V1^2 + if(abs(Tmp)1+Eps){ + P<- c(B1,B2) + }else{ + P<- c(A1+T*V1,A2+T*V2) + } + } + S<- Norm(P-PA) + if(SN){ + Posstr<- paste("[",varargin[[N+1]],"]",sep="") + } + else{ + Posstr<- "[c]" + } + Openphr(Namestr) + S<- paste("\\begin{minipage}",Posstr,"{",Habastr,"}%\n",sep="") + cat(S,file=Wfile,append=TRUE) +} + +################################### + +Openphr<- function(Str) +{ + S<- paste("\\def",Str,"{%\n",sep="") + cat(S,file=Wfile,append=TRUE) +} + +##################################### + +Ovalbox<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Pos<- varargin[[1]] + Dr<- varargin[[2]] + StrV<- varargin[[3]] + R<- 0.2 + NDflg<- 0 + for (I in Looprange(4,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric"){ + R<- Tmp + } + else{ + if(substr(Tmp,1,1)=="-"){ + NDflg<- 1 + Tmp1<- substr(Tmp,2,nchar(Tmp)) + Cmdstr<- chartr("*","G",Tmp1) + } + } + } + Xr<- c(XMIN,XMAX) + Yr<- c(YMIN,YMAX) + Uv<- 0.6; Uh<- 0.8 + N<- nchar(StrV) + W<- Uh;H<- Uv*N + Setwindow(c(-W/2,W/2),c(-H,0)) + G<- Ovaldata(c(0,-H/2),W/2,H/2,R) + Openphr("\\ketpictmp") + Beginpicture("1cm") + if(NDflg==0){ + Drwline(G) + } + else{ + eval(parse(text=Cmdstr)) + } + for (I in Looprange(1,N)){ + Letter(c(0,Uv/2-Uv*I),"c",Op(I,StrV)) + } + Endpicture(0) + Closephr() + Setwindow(Xr,Yr) + Letter(Pos,Dr,"\\ketpictmp") +} + +########################################## + +Ovaldata<- function(...) #17.09.11 +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==1){ + Eps<- 1.0*10^(-4) + C<- c((XMIN+XMAX)/2,(YMIN+YMAX)/2) + Dx<- XMAX-C(1)-Eps + Dy<- YMAX-C(2)-Eps + N<- 1 + } + else{ + C<- varargin[[1]] + Dx<- varargin[[2]] + Dy<- varargin[[3]] + N<- 4 + } + Rc<- 0.2 + if(N<=Nargs){ #15.11.15 + Rc<- varargin[[N]]*Rc #15.11.15 + } + Out<- c() + P<- C+c(Dx-Rc,Dy-Rc) + Tmp1<- Circledata(c(P,Rc),"R=c(0,pi/2)","N=10") #17.11.29 + Tmp2<- Listplot(C+c(Dx-Rc,Dy),C+c(0,Dy)) + Tmp3<- Listplot(C+c(Dx,0),C+c(Dx,Dy-Rc)) + G<- Joincrvs(Tmp3,Tmp1,Tmp2) + Tmp<- Reflectdata(G,c(C,C+c(0,1))) + G<- Joincrvs(G,Tmp) + Tmp<- Reflectdata(G,c(C,C+c(1,0))) + Out<- Joincrvs(G,Tmp) +} + +######################################### + +Paramark<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + PA<- varargin[[1]] + PB<- varargin[[2]] + PC<- varargin[[3]] + R<- 0.5 + if(Nargs>=4){ + R<- varargin[[4]]*R + } + U<- R*(PA-PB)/Norm(PA-PB) + V<- R*(PC-PB)/Norm(PC-PB) + if(Crossprod(PA-PB,PC-PB)!=0){ + P<- Listplot(c(PB+U,PB+U+V,PB+V)) + } + else{ + P<- c() + } +} + +########################################### + +Paramoncurve<-function(...){ + varargin<-list(...) + Nargs<-length(varargin) + Eps<-10^(-8) + P<-varargin[[1]] + Gdata<-varargin[[Nargs]] + if(Nrow(P)>1){ + Tmp<-P; P<-Gdata; Gdata<-Tmp + } + if(Nargs==2){ + Tmp<-Nearestpt(P,Gdata) + Out<-Tmp[[2]] + return(Out) + } + N<-varargin[[2]] + PtL<-Gdata + N=min(N,Length(PtL)-1) #18.02.11from + Pa<-Ptcrv(N,PtL) + Pb<-Ptcrv(N+1,PtL) + V<-Pb-Pa + W<-P-Pa + D2<-Norm(V)^2 + if(D20) + { + E<-sort(E) + E0 && Op(Nrow(P),P)!=c(Inf,Inf)) + { + Pa<- c(Inf,Inf) + } + } + if(t-E[Ke]>Eps) + { + if(Fnflg==0) + { + Tmp<- eval(parse(text=Str)) + Pa<- Tmp + } + else + { + } + Ke<-Ke+1 + } + if(length(Pa)>0) + { + if(Pa[1]==Inf) + { + Tmp<-Appendrow(P,Pa) + P<-Tmp + } + else + { + if(Nrow(P)==0) + { + Tmp<- Appendrow(P,Pa) + P<-Tmp + } + else + { + Tmp<- Op(Nrow(P),P) + if(Tmp[1]==Inf) + { + Tmp<- Appendrow(P,Pa) + P<- Tmp + } + else + { + if(Norm(Tmp-Pa)B+Eps){ + Npt<- Numptcrv(PkL) + Out1<- Partcrv(A,Npt,PkL) + Out2<- Partcrv(1,B,PkL) + Tmp<- Ptstart(PkL)-Ptend(PkL) + if(Norm(Tmp)Ie+Eps){ + P<- (1-B+Ie)*PkL[Ie,]+(B-Ie)*PkL[Ie+1,] + PL<- Appendrow(PL,P) + } + Ans<- PL + return(Ans) + } + Tmp<- Nearestpt(A,PkL) + Ta<- Op(2,Tmp) + Tmp<- Nearestpt(B,PkL) + Tb<- Op(2,Tmp) + Ans<- Partcrv(Ta,Tb,PkL) +} + +########################################## +# 13.05.03 + +Partframe<- function(Tb,St,Ed) +{ + G<- Dividetable(Tb) + Gw<- G[[1]] + Gt<- G[[2]] + Gy<- G[[3]] + Gwt<- Tb[[4]] + Gwy<- Tb[[5]] + Gat<- c(list(Gwt[[1]]),Gt,list(Gwt[[2]])) + Gay<- c(list(Gwy[[1]]),Gy,list(Gwy[[2]])) + Tmp1<- Ptstart(Gat[[St[1]]]) + Tmp2<- Ptstart(Gay[[St[2]]]) + Ps<- c(Tmp1[1],Tmp2[2]) + Tmp1<- Ptstart(Gat[[Ed[1]]]) + Tmp2<- Ptstart(Gay[[Ed[2]]]) + Pe<- c(Tmp1[1],Tmp2[2]) + Pars<- Paramoncurve(Ps,Gw) + Pare<- Paramoncurve(Pe,Gw) + if(Pars0){ + E<-sort(E) + E0){ + Tmp<-eval(parse(text=Exfun)) + if(abs(Tmp)0 && P[Nrow(P),]!=c(Inf,Inf)){ + Pa<- c(Inf,Inf) + } + } + if(x-E[Ke]>Eps){ + Tmp<- eval(parse(text=Str)) + Pa<- c(x,Tmp) + Ke<-Ke+1 + } + if(length(Pa)>0){ + if(Pa[1]==Inf){ + Tmp<-Appendrow(P,Pa) + P<-Tmp + } + else{ + if(Nrow(P)==0){ + Tmp<- Appendrow(P,Pa) + P<-Tmp + } + else{ + Tmp<- P[Nrow(P),] + if(Tmp[1]==Inf){ + Tmp<- Appendrow(P,Pa) + P<- Tmp + } + else{ + if(Norm(Tmp-Pa)1) + { + Tmp<-T; T<-Gdata; Gdata<-Tmp + } + PtL<-Gdata + N<-trunc(T+Eps); + S<-max(T-N,0); + if(N==Nrow(PtL)) + { + Out<-PtL[N,] + } + else + { + Pa<-PtL[N,] + Pb<-PtL[N+1,] + Out<-(1-S)*Pa+S*Pb + } + return(Out) +} + +############################################## +# 10.11.20 +# 13.05.03 Inf + +Pointdata<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + PL<- list() + for (I in Looprange(1,Nargs)){ # 10.11.20 + DL<-varargin[[I]] + DL<- Flattenlist(DL) # 10.11.20 from here + for (J in Looprange(1,length(DL))){ + Dt<- DL[[J]] + if(is.matrix(Dt)|| is.data.frame(Dt)){ + for (K in 1:nrow(Dt)){ + Tmp<- as.numeric(Dt[K,]) + if(Tmp[1]0){ #18.02.09 + return(Op(Length(Fig),Fig)) + }else{ + return(c()) + } +} + +######################################### + +Ptne<-function(...) +{ + varargin<- list(...) + if(length(varargin)==0){ + Out<- c(XMAX,YMAX) + } + else{ + G<- varargin[[1]] + XM<- max(G[,1]) + YM<- max(G[,2]) + Out<- c(XM,YM) + } + return(Out) +} + +######################################### + +Ptnw<-function(...) +{ + varargin<- list(...) + if(length(varargin)==0){ + Out<- c(XMIN,YMAX) + } + else{ + G<- varargin[[1]] + Xm<- min(G[,1]) + YM<- max(G[,2]) + Out<- c(Xm,YM) + } + return(Out) +} + +######################################### + +Ptse<-function(...) +{ + varargin<- list(...) + if(length(varargin)==0){ + Out<- c(XMAX,YMIN) + } + else{ + G<- varargin[[1]] + XM<- max(G[,1]) + Ym<- min(G[,2]) + Out<- c(XM,Ym) + } + return(Out) +} + +############################################# + +Ptstart<-function(Fig) +{ + if(Length(Fig)>0){ #18.02.09 + return(Op(1,Fig)) + }else{ + return(c()) + } +} + +######################################### + +Ptsw<-function(...) +{ + varargin<- list(...) + if(length(varargin)==0){ + Out<- c(XMIN,YMAX) + } + else{ + G<- varargin[[1]] + Xm<- min(G[,1]) + Ym<- min(G[,2]) + Out<- c(Xm,Ym) + } + return(Out) +} + +############################################## + +Putcell<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + Str<- varargin[[Nargs]] + if(mode(Str)=="numeric"){ + Str<- as.character(Str) + } + Pos<- varargin[[Nargs-1]] + Nrg<- varargin[[2]] + if(mode(Nrg)=="character"){ + if(Nargs==4){ + Cell<- Findcell(TbL,Nrg) + } + else{ + Mrg<- varargin[[3]] + Cell<- Findcell(TbL,Nrg,Mrg) + } + } + else{ + Mrg<- varargin[[3]] + Cell<- Findcell(TbL,Nrg,Mrg) + } + Pt<- Cell[[1]]; Dr<- "c" + Posh<- substr(Pos,1,1) + Post<- substr(Pos,2,nchar(Pos)) + if(toupper(Posh)=="R"){ + Pt<- Pt+c(Cell[[2]],0) + if(nchar(Post)==0){ + Dr<- "w1" + } + else{ + Dr<- paste("w",Post,sep="") + } + } + if(toupper(Posh)=="L"){ + Pt=Pt-c(Cell[[2]],0) + if(nchar(Post)==0){ + Dr<- "e1" + } + else{ + Dr<- paste("e",Post,sep="") + } + } + if(toupper(Posh)=="U"){ + Pt<- Pt+c(0,Cell[[3]]) + if(nchar(Post)==0){ + Dr<- "s1" + } + else{ + Dr<- paste("s",Post,sep="") + } + } + if(toupper(Posh)=="D"){ + Pt<- Pt-c(0,Cell[[3]]) + if(nchar(Post)==0){ + Dr<- "n1" + } + else{ + Dr<- paste("n",Post,sep="") + } + } + if(toupper(Posh)=="B"){ + Pt<- Pt-c(0,Cell[[3]]) + if(nchar(Post)==0){ + Dr<- "n1" + } + else{ + Dr<- paste("n",Post,sep="") + } + Str<- paste("$\\mathstrut$",Str,sep="") + } + Letter(Pt,Dr,Str) +} + +############################################# + +PutcoL<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + if(mode(TbL)!="list"){ + return("Tabledata missing") + } + Ag<- varargin[[2]] + if(mode(Ag)=="numeric"){ + CoL<- Ag + } + else{ + Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Clm<- c() + for (I in Looprange(1,nchar(Ag))){ + C<- substr(Ag,I,I) + C<- toupper(C) + Tmp<- strsplit(Alpha,C) + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + Tmp1<- nchar(Tmp[1]) + Clm<- c(Clm,Tmp1) + } + } + Nrg<- 0 + for (I in seq(length(Clm),1,by=-1)){ + Tmp<- Clm[I] + Tmp1<- length(Clm)-I + Nrg<- Nrg+Tmp*26^Tmp1 + } + CoL<- Nrg + } + Nc<- length(TbL[[3]])+1 + K<- 1 + Dpos<- varargin[[3]] + for (I in Looprange(4,Nargs)){ + if(I-3>Nc){ + break + } + Dt<- varargin[[I]] + if(mode(Dt)!="list"){ + Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 + K<- K+1 + } + else{ + N<- length(Dt) + Str<- Dt[[N]] + Rrng<- c(K,K+1) + Pos<- Dpos + for (J in Looprange(1,N-1)){ + Tmp<- Dt[[J]] + if(mode(Tmp)=="numeric"){ + Rrng<- c(K,K+Tmp) + } + if(mode(Tmp)=="character"){ + Pos<- Tmp + } + } + Putcell(TbL,CoL,Rrng,Pos,Str) + K<- Crng[2] + } + } +} + +Putcol<- function(...) +{ + PutcoL(...) +} + +PutcoLexpr<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + if(mode(TbL)!="list"){ + return("Tabledata missing") + } + Ag<- varargin[[2]] + if(mode(Ag)=="numeric"){ + CoL<- Ag + } + else{ + Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Clm<- c() + for (I in Looprange(1,nchar(Ag))){ + C<- substr(Ag,I,I) + C<- toupper(C) + Tmp<- strsplit(Alpha,C) + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + Tmp1<- nchar(Tmp[1]) + Clm<- c(Clm,Tmp1) + } + } + Nrg<- 0 + for (I in seq(length(Clm),1,by=-1)){ + Tmp<- Clm[I] + Tmp1<- length(Clm)-I + Nrg<- Nrg+Tmp*26^Tmp1 + } + CoL<- Nrg + } + Nc<- length(TbL[[3]])+1 + K<- 1 + Dpos<- varargin[[3]] + for (I in Looprange(4,Nargs)){ + if(I-3>Nc){ + break + } + Dt<- varargin[[I]] + if(mode(Dt)!="list"){ + Dt<- paste("$",Dt,"$",sep="") + Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 + K<- K+1 + } + else{ + N<- length(Dt) + Str<- paste("$",Dt[[N]],"$",sep="") + Rrng<- c(K,K+1) + Pos<- Dpos + for (J in Looprange(1,N-1)){ + Tmp<- Dt[[J]] + if(mode(Tmp)=="numeric"){ + Rrng<- c(K,K+Tmp) + } + if(mode(Tmp)=="character"){ + Pos<- Tmp + } + } + Putcell(TbL,CoL,Rrng,Pos,Str) + K<- Crng[2] + } + } +} + +Putcolexpr<- function(...) +{ + PutcoLexpr(...) +} + +##################################################### + +PutcoLstr<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Tb<- varargin[[1]] + Nr<- varargin[[2]] + Pos<- varargin[[3]] + Str<- varargin[[4]] + Sep<- "" + if(Nargs>4){ + Sep<- varargin[[5]] + } + if(nchar(Sep)==0){ + for (I in Looprange(1,nchar(Str))){ + Tmp<- substr(Str,I,I) + Putcell(Tb,Nr,I,Pos,Tmp) + } + } + else{ + Ltr<- "" + K<- 1 + for (I in Looprange(1,length(Str))){ + Tmp<- substr(Str,I,I) + if(Tmp==Sep){ + Putcell(Tb,Nr,K,Pos,Ltr) + K<- K+1 + Ltr<- "" + } + else{ + Ltr<- paste(Ltr,Tmp,sep="") + } + } + if(nchar(Ltr)>0){ + Putcell(Tb,Nr,K,Pos,Ltr) + } + } +} + +############################################# + +Putrow<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + if(mode(TbL)!="list"){ + return("Tabledata missing") + } + Row<- varargin[[2]] + Nr<- length(TbL[[2]])+1 + K<- 1 + Dpos<- varargin[[3]] + for (I in Looprange(4,Nargs)){ + if(I-3>Nr){ + break; + } + Dt<- varargin[[I]] + if(mode(Dt)!="list"){ + Putcell(TbL,K,Row,Dpos,Dt) # 110308 + K<- K+1 + } + else{ + N<- length(Dt) + Str<- Dt[[N]] + Crng<- c(K,K+1) + Pos<- Dpos + for (J in Looprange(1,N-1)){ + Tmp<- Dt[[J]] + if(mode(Tmp)=="numeric"){ + Crng<- c(K,K+Tmp) + } + if(mode(Tmp)=="character"){ + Pos<- Tmp + } + } + Putcell(TbL,Crng,Row,Pos,Str) + K<- Crng[2] + } + } +} + +Putrowexpr<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + if(mode(TbL)!="list"){ + return("Tabledata missing") + } + Row<- varargin[[2]] + Nr<- length(TbL[[2]])+1 + K<- 1 + Dpos<- varargin[[3]] + for (I in Looprange(4,Nargs)){ + if(I-3>Nr){ + break; + } + Dt<- varargin[[I]] + if(mode(Dt)!="list"){ + Dt<- paste("$",Dt,"$",sep="") + Putcell(TbL,K,Row,Dpos,Dt) #110308 + K<- K+1 + } + else{ + N<- length(Dt) + Str<- paste("$",Dt[[N]],"$",sep="") + Crng<- c(K,K+1) + Pos<- Dpos + for (J in Looprange(1,N-1)){ + Tmp<- Dt[[J]] + if(mode(Tmp)=="numeric"){ + Crng<- c(K,K+Tmp) + } + if(mode(Tmp)=="character"){ + Pos<- Tmp + } + } + Putcell(TbL,Crng,Row,Pos,Str) + K<- Crng[2] + } + } +} + +#################################################### + +Putrowstr<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Tb<- varargin[[1]] + Nr<- varargin[[2]] + Pos<- varargin[[3]] + Str<- varargin[[4]] + Sep<- "" + if(Nargs>4){ + Sep<- varargin[[5]] + } + if(nchar(Sep)==0){ + for (I in Looprange(1,nchar(Str))){ + Tmp<- substr(Str,I,I) + Putcell(Tb,I,Nr,Pos,Tmp) + } + } + else{ + Ltr<- "" + K<- 1 + for (I in Looprange(1,length(Str))){ + Tmp<- substr(Str,I,I) + if(Tmp==Sep){ + Putcell(Tb,K,Nr,Pos,Ltr) + K<- K+1 + Ltr<- "" + } + else{ + Ltr<- paste(Ltr,Tmp,sep="") + } + } + if(nchar(Ltr)>0){ + Putcell(Tb,K,Nr,Pos,Ltr) + } + } +} + +############################################ +# 11.05.28 + +Ratiocmyk<- function(Color) +{ + if(is.numeric(Color)){ + return(Color) + } + R<- + switch(Color, + greenyellow=c(0.15,0,0.69,0), + yellow=c(0,0,1,0), + goldenrod=c(0,0.1,0.84,0), + dandelion=c(0,0.29,0.84,0), + apricot=c(0,0.32,0.52,0), + peach=c(0,0.5,0.7,0), + melon=c(0,0.46,0.5,0), + yelloworange=c(0,0.42,1,0), + orange=c(0,0.61,0.87,0), + burntorange=c(0,0.51,1,0), + bittersweet=c(0,0.75,1,0.24), + redorange=c(0,0.77,0.87,0), + mahogany=c(0,0.85,0.87,0.35), + maroon=c(0,0.87,0.68,0.32), + brickred=c(0,0.89,0.94,0.28), + red=c(0,1,1,0), + orangered=c(0,1,0.5,0), + rubinered=c(0,1,0.13,0), + wildstrawberry=c(0,0.96,0.39,0), + salmon=c(0,0.53,0.38,0), + carnationpink=c(0,0.63,0,0), + magenta=c(0,1,0,0), + violetred=c(0,0.81,0,0), + rhodamine=c(0,0.82,0,0), + mulberry=c(0.34,0.9,0,0.02), + redviolet=c(0.07,0.9,0,0.34), + fuchsia=c(0.47,0.91,0,0.08), + lavender=c(0,0.48,0,0), + thistle=c(0.12,0.59,0,0), + orchid=c(0.32,0.64,0,0), + darkorchid=c(0.4,0.8,0.2,0), + purple=c(0.45,0.86,0,0), + plum=c(0.5,1,0,0), + violet=c(0.79,0.88,0,0), + royalpurple=c(0.75,0.9,0,0), + blueviolet=c(0.86,0.91,0,0.04), + periwinkle=c(0.57,0.55,0,0), + cadetblue=c(0.62,0.57,0.23,0), + cornflowerblue=c(0.65,0.13,0,0), + midnightblue=c(0.98,0.13,0,0.43), + navyblue=c(0.94,0.54,0,0), + royalblue=c(1,0.5,0,0), + blue=c(1,1,0,0), + cerulean=c(0.94,0.11,0,0), + cyan=c(1,0,0,0), + processblue=c(0.96,0,0,0), + skyblue=c(0.62,0,0.12,0), + turquoise=c(0.85,0,0.2,0), + tealblue=c(0.86,0,0.34,0.02), + aquamarine=c(0.82,0,0.3,0), + bluegreen=c(0.85,0,0.33,0), + emerald=c(1,0,0.5,0), + junglegreen=c(0.99,0,0.52,0), + seagreen=c(0.69,0,0.5,0), + green=c(1,0,1,0), + forestgreen=c(0.91,0,0.88,0.12), + pinegreen=c(0.92,0,0.59,0.25), + limegreen=c(0.5,0,1,0), + yellowgreen=c(0.44,0,0.74,0), + springgreen=c(0.26,0,0.76,0), + olivegreen=c(0.64,0,0.95,0.4), + rawsienna=c(0,0.72,1,0.45), + sepia=c(0,0.83,1,0.7), + brown=c(0,0.81,1,0.6), + tan=c(0.14,0.42,0.56,0), + gray=c(0,0,0,0.5), + black=c(0,0,0,1), + white=c(0,0,0,0) + ) + if(length(R)<4){ + print("No color") + return(c()) + } + return(R) +} + +############################################ +# 11.01.07 + +Readtextdata<- function(...) +{ + varargin<- list(...) + OutL<- list() + Nargs<- length(varargin) + Fname<- varargin[[1]] + Tmp<- readLines(Fname,n=1) + if(length(grep("\t",Tmp))>0){ + Sep<- "\t" + } + else if(length(grep(",",Tmp))>0){ + Sep<- "," + } + else{ + Sep<- " " + } + Hajime<- c(1,1) + Owari<- c(Inf,Inf) + C<- Inf + R<- Inf + Rna<- FALSE + Cna<- TRUE + Mat<- FALSE + Num<- TRUE + D<- -Inf + Flg<- 0 + for (I in Looprange(2,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric"){ + if (Flg==0){ + Hajime<- Tmp + Flg<- 1 + } + else{ + Owari<- Tmp + } + } + else{ + eval(parse(text=Tmp)) + } + } + Tmp<- Hajime+c(R-1,C-1) + Owari<- c(min(Owari[1],Tmp[1]),min(Owari[2],Tmp[2])) + if(Cna){ + Df<- read.table(Fname,sep=Sep,header=TRUE,,stringsAsFactors=FALSE) + } + else{ + Df<- read.table(Fname,sep=Sep,header=FALSE,,stringsAsFactors=FALSE) + Nv<- c(1:ncol(Df)) + colnames(Df)<- Nv + } + if(Rna){ + rownames(Df)<-Df[,1] + Hajime<- Hajime+c(0,1) + } + if(Mat){ + M<- as.matrix(Df) + Tmp1<- min(Owari[1],nrow(M)) + Tmp2<- min(Owari[2],ncol(M)) + Out<- as.matrix(M[Hajime[1]:Tmp1,Hajime[2]:Tmp2]) + if(Num){ + Tmp1<- as.numeric(Out) + Out<- matrix(Tmp1,nrow=nrow(Out)) + } + } + else{ + Tmp1<- min(Owari[1],nrow(Df)) + Tmp2<- min(Owari[2],ncol(Df)) + Out<- Df[Hajime[1]:Tmp1,Hajime[2]:Tmp2] + } + if(D!=-Inf){ # 11.01.20 v2 + Tmp<- ncol(Out) # 11.01.07 + Tmp1<- rep(Inf,Tmp) + Out[Out[,1]<=D,]<- Tmp1 # 11.01.07 + } + return(Out) +} + +################################## + +Reflectdata<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-8) + ML<- varargin[[1]] + if(Mixtype(ML)==1){ + ML<- list(ML) + } + if(Nargs==1){ + PtA<- c(0,0); PtB<- PtA + } + else{ + Pts<- varargin[[2]] + if(length(Pts)==2){ + PtA<- Pts; PtB<- PtA + } + else{ + PtA<- Pts[1:2]; PtB<- Pts[3:4] + } + } + OutL<- list() + for (N in Looprange(1,length(ML))){ + GL<- Op(N,ML) + Out<- c() + for (I in Looprange(1,Nrow(GL))){ + if(is.matrix(GL)){ # 10.12.07 + Tmp<- GL[I,] + } + else{ + Tmp<- GL + } + X1<- Tmp[1] + Y1<- Tmp[2] + if(X1==Inf){ + X2<- X1 + Y2<- Y1 + } + else{ + if(Norm(PtA-PtB)0){ + Str=paste(Str,",",sep="") + } + if(length(Pt)<3){ + Str=paste(Str,sprintf("[%5.5f,%5.5f]",Pt[1],Pt[2]),sep="") + } + else{ + Str=paste(Str,sprintf("[%5.5f,%5.5f,%5.5f]",Pt[1],Pt[2],Pt[3]),sep="") + } + if(nchar(Str)>80){ + cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) + Str="" + } + } + if(nchar(Str)>0){ + cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) + } + if((N==Nargs-1) & (K==length(Gdata)) & (J==length(GL))){ +# cat("end////","\n",sep="",file=Fname,append=TRUE) + cat("end//","\n",sep="",file=Fname,append=TRUE) + } + else{ + cat("end//","\n",sep="",file=Fname,append=TRUE) + } + } + } + } + cat("//","\n",sep="",file=Fname,append=TRUE) # 15.11.05 +} + +###### Old #################################### +# 2015.10.23 +ReadOutData<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Fname=varargin[[1]] + cmdall=readLines(Fname) + cmdall=gsub("//","",cmdall,fixed=TRUE) + varname=cmdall[1] + outdt=list() + varL=c() + ptL=list() + flg=0 + for(cmd in cmdall){ + if(nchar(cmd)>0){ + if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ + if(cmd=="start"){ + pts=c() + } + if(cmd=="end"){ + ptL=c(ptL,list(pts)) + } + if(substring(cmd,1,1)=="["){ + tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") + tmp1=strsplit(tmp1,"]",fixed=TRUE) + tmp1=tmp1[[1]] + tmp1=gsub(",[","c(",tmp1,fixed=TRUE) + for(st in tmp1){ + tmp=eval(parse(text=paste(st,")",sep=""))) + pts=rbind(pts,tmp) + } + row.names(pts)=1:nrow(pts) + } + } + else{ + varname=cmd + varL=c(varL,varname) + if(flg==0){ # 17.10.07from + flg=1 + }else{ + outdt=c(outdt,list(ptL)) + } # 17.10.07upto + ptL=c() + } + } + } + outdt=c(outdt,list(ptL)) # 17.10.07 + names(outdt)=varL + for(var in varL){ + tmp=paste(var,"<<- outdt$",var,sep="") + eval(parse(text=tmp)) + } +# print(varL) + outdt +} + +#################################################### + +ReadOutData<- function(...){ #2017.10.23 + varargin<- list(...) + Nargs<- length(varargin) + Fname=varargin[[1]] + cmdall=readLines(Fname) + cmdall=gsub("//","",cmdall,fixed=TRUE) + varname=""#17.12.13 cmdall[1] + outdt=list() + varL=c() + ptL=list() + flg=0 + for(cmd in cmdall){ + if(nchar(cmd)>0){ + if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ + if(cmd=="start"){ + tmp=paste(varname,"<<- c(",varname,",list(c()))",sep="") + eval(parse(text=tmp)) + Ctr=Ctr+1 + } + if(cmd=="end"){ + } + if(substring(cmd,1,1)=="["){ + tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") + tmp1=strsplit(tmp1,"]",fixed=TRUE) + tmp1=tmp1[[1]] + tmp1=gsub(",[","c(",tmp1,fixed=TRUE) + for(st in tmp1){ + tmp=paste(varname,"[[",as.character(Ctr),"]]",sep="") + tmp=paste(tmp,"<<- rbind(",tmp,",",st,"))",sep="")# + eval(parse(text=tmp)) + } + } + } + else{ + # 17.12.13from + if(nchar(varname)>0){ + tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") + eval(parse(text=tmp)) + } + # 17.12.13upto + varname=cmd + tmp=paste(varname,"<<- list()",sep="") + eval(parse(text=tmp)) + Ctr=0 + if(flg==0){ # 17.10.07from + flg=1 + }else{ + } # 17.10.07upto + } + } + } + # 17.12.13from + tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") + eval(parse(text=tmp)) + # 17.12.13upto +} + +#################################################### + +Rotatedata<- function(..., deg=FALSE) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-8) + ML<- varargin[[1]] + if(Mixtype(ML)==1){ + ML<- list(ML) + } + Theta<- varargin[[2]] + if(deg) Theta<- Theta*pi/180 # 10.12.07 + if(Nargs==2){ + Pt<- c(0,0) + } + else{ + Pt<- varargin[[3]] + } + Cx<- Pt[1]; Cy<- Pt[2] + OutL<- c() + for (N in Looprange(1,length(ML))){ + GL<- Op(N,ML) + Out<- c() + for (I in Looprange(1,Nrow(GL))){ + if(is.matrix(GL)){ + Tmp<- GL[I,] + } + else{ + Tmp<- GL + } + X1<- Tmp[1] + Y1<- Tmp[2] + if(X1==Inf){ + X2<- X1 + Y2<- Y1 + } + else{ + X2<- Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta) + Y2<- Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta) + } + Out<- Appendrow(Out,c(X2,Y2)) + } + if(nrow(Out)==1){ + Out<- Out[1,] + } + OutL<- Mixjoin(OutL,list(Out)) + } + if(length(OutL)==1){ + OutL<- Op(1,OutL) + } + return(OutL) +} + +############################################### + +Scaledata<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-8) + ML<- varargin[[1]] + if(Mixtype(ML)==1){ + ML<- list(ML) + } + A<- varargin[[2]] + B<- varargin[[3]] + if(Nargs==3){ + Pt<- c(0,0) + } + else{ + Pt<- varargin[[4]] + } + OutL<- list() + for (N in Looprange(1,length(ML))){ + GL<- Op(N,ML) + Out<- c() + for (I in Looprange(1,Nrow(GL))){ + if(is.matrix(GL)){ # 10.12.07 + Tmp<- GL[I,] + } + else{ + Tmp<- GL + } + X1<- Tmp[1] + Y1<- Tmp[2] + if(X1==Inf){ + X2<- X1 + Y2<-Y1 + } + else{ + X2<- Pt[1]+A*(X1-Pt[1]) + Y2<- Pt[2]+B*(Y1-Pt[2]) + } + Out<- Appendrow(Out,c(X2,Y2)) + } + OutL<- Mixjoin(OutL,list(Out)) + } + if(length(OutL)==1){ + OutL<- Op(1,OutL) + } + return(OutL) +} + +################################ + +Setarrow<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + Str<- paste("Size=",YaSize,",","Angle=",YaAngle,",",sep="") + Str<- paste(Str,"Position=",YaThick,",","Style=",YaStyle,sep="") + return(Str) + } + Flg<- 0 + for (I in 1:Nargs){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric"){ + Flg<- Flg+1 + if(Flg==1) YaSize<<-Tmp + if(Flg==2){ + if(Tmp<5){ + YaAngle<<- 18*Tmp + } + else{ + YaAngle<<- Tmp + } + } + if(Flg==3) YaPosition<<- Tmp + if(Flg==4) YaThick<<- Tmp + } + if(mode(Tmp)=="character"){ + YaStyle<<- Tmp + } + } +} + +#################################### + +Setax<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + if(ZIKU=="line"){ + Tmp<- "," + } + else{ + Tmp<- paste("(Arrowsize=", as.character(ARROWSIZE),"),",sep="") + } + Str<- paste(ZIKU,Tmp,XNAME,",",XPOS,",",sep="") + Str<- paste(Str,YNAME,",",YPOS,",",ONAME,",",OPOS,sep="") + return(Str) + } + ArgL<- c() + Is<- 1 + Tmp<- varargin[[1]] + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + Is<- varargin[[1]] + ArgL<- c() + for (I in Looprange(1,Is-1)){ + ArgL<- c(ArgL,"") + } + for (I in Looprange(2,Nargs)){ + ArgL<- c(ArgL,varargin[[I]]) + } + } + else{ + if(Nargs==1){ + ArgL<- c(varargin[[1]]) + } + else{ + Tmp<- varargin[[2]] + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + ARROWSIZE<<-Tmp + ArgL<- c(varargin[[1]]) + for (I in Looprange(3,Nargs)){ + ArgL<- c(ArgL,varargin[[I]]) + } + } + else{ + ArgL<- c() + for (I in 1:Nargs){ + ArgL<- c(ArgL,varargin[[I]]) + } + } + } + } + for (I in Looprange(length(ArgL)+1,7)){ + ArgL<- c(ArgL,"") + } + Zk<- ArgL[1] + if(nchar(Zk)>0){ + ZL<-substr(Zk,2,nchar(Zk)) + Zk<-substr(Zk,1,1) + if(nchar(ZL)>0){ + ARROWSIZE<<- as.numeric(ZL) + } + } + Xn<- ArgL[2]; Xp<- ArgL[3] + Yn<- ArgL[4]; Yp<- ArgL[5] + Genn<- ArgL[6]; Genp<- ArgL[7] + if(nchar(Zk)>0){ + C<- Zk + if(C=="a"){ + ZIKU<<- "arrow" + } + else{ + ZIKU<<- "line" + } + } + if(nchar(Xn)>0){ + XNAME<<- paste("$",Xn,"$",sep="") + } + if(nchar(Xp)>0){ + XPOS<<- Xp + } + if(nchar(Yn)>0){ + YNAME<<- paste("$",Yn,"$",sep="") + } + if(nchar(Yp)>0){ + YPOS<<-Yp + } + if(nchar(Genn)>0){ + ONAME<<- Genn + } + if(nchar(Genp)>0){ + OPOS<<- Genp + } + Out<- ""; +} + +################################# +# 11.08.24 + +Setcolor<- function(...){ + varargin<- list(...) + Color<- 'black' + Kosa<- 1 + for(J in Looprange(1,length(varargin))){ + Tmp<- varargin[[J]] + if(is.character(Tmp)) Color<- Tmp + if(is.numeric(Tmp)){ + if(length(Tmp)==1){# 11.08.24 + Kosa<- Tmp + } + else{ + Color<- Tmp + } + }# 11.08.24 + } + Iro<- Ratiocmyk(Color) + if(length(Iro)==0) return(c()) + Str<- "\\color[cmyk]{" #17.09.22 + for(J in 1:4){ + Str<- paste(Str,as.character(Kosa*Iro[J]),sep="") + if(J<4){ + Str<- paste(Str,",",sep="") + } + } + Str<- paste(Str,"}",sep="") + Texcom(Str) +} + +################################## + +Setmarklen<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + Tmp<- MARKLENNow/MARKLENInit + Tmp=round(Tmp*100)/100 + return(Tmp) + } + Size<- varargin[[1]] + MARKLENNow<<- MARKLENInit*Size + MARKLEN<<- MARKLENNow*1000/2.54/MilliIn +} + +############################### + +Setorigin<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + return(GENTEN) + } + Pt<- varargin[[1]] + GENTEN<<- Pt; +} + +################################ + +Setscaling<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0) + { + return(c(SCALEY,LOGX,LOGY)) + } + for (I in 1:Nargs) + { + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric") + { + SCALEY<<- Tmp + } + if(mode(Tmp)=="character") + { + if(Tmp=="l") + { + LOGX<<- 0 + LOGY<<- 1 + } + else if(Tmp=="ll") + { + LOGX<<- 1 + LOGY<<- 1 + } + else + { + LOGX<<- 0 + LOGY<<- 0 + } + } + } + Tmp<- c(SCALEY,LOGX,LOGY); +} + +######################################### + +Setpen<-function(Width) +{ + PenThick<<-round(PenThickInit*Width) + Str=paste("\\special{pn ", as.character(PenThick),"}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) +} + +############################################## + +Setpt<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0) + { + Tmp<- TenSize/TenSizeInit + Tmp<- round(Tmp*100)/100 + return(Tmp) + } + Size<- varargin[[1]] + TenSize<<- TenSizeInit*Size; +} + +############################################## + +Setunitlen<-function(...) +{ + varargin<-list(...) + if(length(varargin)==0){ + return(ULEN) + } + Ul=varargin[[1]] + Dx<-XMAX-XMIN + Dy<-YMAX-YMIN + Sym<-".0123456789 +-*/" + SL<-Sym + OL<-"+-*/" + if(nchar(Ul)>0){ + ULEN<<-Ul + } + Is<-1 + VL<-"" + Ucode<-ULEN + for (I in 1:nchar(Ucode)){ + C<-substring(Ucode,I,I) + if(length(grep(C,SL))>0){ + if(length(grep(C,OL))>0){ + Tmp<-substring(Ucode,Is,I-1) + Str<-paste(VL,Tmp,C,sep="") + VL<-Str + Is<-I+1 + } + } + else{ + Unit<-substring(Ucode,I,I+1) + Str<-substring(Ucode,Is,I-1) + VL<-paste(VL,Str,sep="") + break; + } + } + Valu<-eval(parse(text=VL)) + Str<-as.character(Valu) + ULEN<<-paste(Str,Unit,sep=""); + if(Unit=="cm") MilliIn<<-1000/2.54*Valu + if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10 + if(Unit=="in") MilliIn<<-1000*Valu + if(Unit=="pt") MilliIn<<-1000/72.27*Valu + if(Unit=="pc") MilliIn<<-1000/6.022*Valu + if(Unit=="bp") MilliIn<<-1000/72*Valu + if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu + if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu + if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 + MARKLEN<<-MARKLENNow*1000/2.54/MilliIn + MEMORI<<-MEMORINow*1000/2.54/MilliIn #17.12.17 +} + +######################################### +# 10.11.20 + +Setwindow<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + if(Nargs==0){ + Out<-c(XMIN,XMAX,YMIN,YMAX) + return(Out) + } + if(Nargs==1){ + Dt<- varargin[[1]] + if(is.list(Dt) && !is.data.frame(Dt)){ + Tmp<- as.data.frame(Dt) + Dt<- t(Tmp) + } + Xm<- min(Dt[,1]) + XM<- max(Dt[,1]) + Ym<- min(Dt[,2]) + YM<- max(Dt[,2]) + Str<- "Setwindow(" + Str<- paste(Str,"c(",as.character(Xm),",",as.character(XM),"),c(",sep="") + Str<- paste(Str,as.character(Ym),",",as.character(YM),")",sep="") + Str<- paste(Str,")",sep="") + print(Str) + } + if(Nargs==2){ + RgX<-varargin[[1]] + RgY<-varargin[[2]] + XMIN<<-RgX[1]; XMAX<<-RgX[2] + YMIN<<-RgY[1]; YMAX<<-RgY[2] + } + if(Nargs==4){ + XMIN<<-varargin[[1]]; XMAX<<-varargin[[2]] + YMIN<<-varargin[[3]]; YMAX<<-varargin[[4]] + } + Out<- c(XMIN,XMAX,YMIN,YMAX); +} + +######################################### + +Shade<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + Iroflg=0 + Kosa=1 + if(Nargs>1){ + Iro=varargin[[Nargs]] + if(is.character(Iro)){ + Iroflg=1 + if(length(grep("{",Iro))>0){ + Str=paste("{\\color",Iro,sep="") + } + else{ + Str=paste("{\\color{",Iro,"}",sep="") + } + } + else{ + if(length(Iro)==1){ + Kosa=Iro + } + else{ + Iroflg=1 + if(length(Iro)==4){ + Str="{\\color[cmyk]{" + } + else{ + if(length(Iro)==3){ + Str="{\\color[rgb]{" + } + } + for(J in 1:length(Iro)){ + Str=paste(Str,as.character(Iro[J]),sep="") + if(J80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<- 0 + } + } + Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") + Str2<- paste("\\special{ip}%\n",sep="") + cat(Str1,file=Wfile,append=TRUE) + cat(Str2,file=Wfile,append=TRUE) + } + if(Iroflg==1){ + cat("}%\n",file=Wfile,append=TRUE) + } +} + +####### Shade new 17.09.24############ + +Shade<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + Iroflg<- 0 + Kosa<- 1 + if(Nargs>1){ + Iro<- varargin[[Nargs]] + if(mode(Iro)=="character"){ + Iroflg<- 1 + if(length(grep(Iro,"{"))>0) + Str<- paste("{\\color",Iro,sep="") + else + Str<- paste("{\\color{",Iro,"}",sep="") + } + else{ + if(length(Iro)==1) + Kosa<- Iro + else{ + Iroflg<- 1 + if(length(Iro)==4) + Str<- paste("{\\color[cmyk]{",sep="") + else + if(length(Iro)==3) + Str<- paste("{\\color[rgb]{",sep="") + for (J in Looprange(1,length(Iro))){ + Str<- paste(Str,as.character(Iro[J]),sep="") + if(J80){ + if(Wfile=="default") + cat("%\n",file="",append=TRUE,sep="") + else + cat("%\n",file=Wfile,append=TRUE,sep="") + Mojisu<- 0 + } + } + Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") + Str2<- paste("\\special{ip}%\n",sep="") + if(Wfile=="default"){ + cat(Str1,file="",append=TRUE,sep="") + cat(Str2,file="",append=TRUE,sep="") + } + else{ + cat(Str1,file=Wfile,append=TRUE,sep="") + cat(Str2,file=Wfile,append=TRUE,sep="") + } + } + if(Iroflg==1){ + if(Wfile=="default") + cat("}%\n",file="",append=TRUE,sep="") + else + cat("}%\n",file=Wfile,append=TRUE,sep="") + } +} + +############################################## +# 11.01.07 + +Splinedata<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-3) + PL<- varargin[[1]] + if(mode(PL)=="character"){ + Fname<- PL + PL<- Readtextdata(Fname) + } + else{ + PL<- as.matrix(PL) + if(Nrow(PL)==1){ + PL<- matrix(PL, nrow=length(PL)/2) + PL<- t(PL) + } + } + if(ncol(PL)==3){ + Flg3<- 1 + } + else{ + Flg3<- 0 + } + PLL<- Dividegraphics(PL) + N<- 50 + C<- c() + for (I in Looprange(2,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)!="character") next + if(length(grep("=",Tmp,fixed=TRUE))>0){ + eval(parse(text=Tmp)) + } + else{ + Tmp1<- substr(Tmp,1,1) + if(toupper(Tmp1)=="C"){ + C<- 1:length(PLL) + } + } + } + Cflg<- rep(0,length(PLL)) + for(J in Looprange(1,length(C))){ + K<- C[J] + Cflg[K]<- 1 + } + if(length(N)>1){ + Nj<- as.numeric(N) + } + else{ + Tmp<- lapply(PLL,nrow) + Tmp1<- as.numeric(Tmp) + MxP<- max(Tmp1) + Nj<- c() + for (J in 1:length(PLL)){ + Tmp<- nrow(PLL[[J]]) + Tmp1<- round(N/MxP*(Tmp-1)) + Nj<- c(Nj,Tmp1) + } + } + OutL<- list() + for(J in 1:length(PLL)){ + PL<- PLL[[J]] + if(Cflg[J]==1){ + if(Norm(PL[1,]-PL[Nrow(PL),])>Eps){ + PL<-Appendrow(PL,PL[1,]) + Nj[J]=round(N/MxP*nrow(PL)) + } + else{ + PL[Nrow(PL),]<- PL[1,] + } + } + Tn<- 1:Nrow(PL) + Xn<- PL[,1] + Yn<- PL[,2] + if(Flg3==1) Zn<- PL[,3] + if(Cflg[J]==0){ + Dxn<- spline(Tn,Xn,n=Nj[J]) + Dyn<- spline(Tn,Yn,n=Nj[J]) + if(Flg3==1) Dzn<- spline(Tn,Zn,n=Nj[J]) + } + else{ + Dxn<- spline(Tn,Xn,method="periodic") + Dyn<- spline(Tn,Yn,method="periodic") + if(Flg3==1) Dzn<- spline(Tn,Zn,method="periodic") + } + Tmp1<- Dxn$y + Tmp2<- Dyn$y + Tmp3<-c() + if(Flg3==1) Tmp3<- Dzn$y + Out<- matrix(c(Tmp1,Tmp2,Tmp3),nrow=length(Tmp1)) + OutL<- c(OutL,list(Out)) + } + return(OutL) +} + +############################################ +# 2013.05.03 Domain is optional + +Tabledata<- function(...){ + varargin<- list(...) + Eps<- 0.001 + Tmp<- varargin[[1]] # 130503 from + if(is.numeric(Tmp)){ + Domain<- varargin[[1]] + VL<- varargin[[2]] + HL<- varargin[[3]] + } + else{ + Domain<- c(-1,-1) + VL<- varargin[[1]] + HL<- varargin[[2]] + } # 130503 upto + Hsize<- Domain[1] + SvL<- list(0) + S<- 0 + for (I in Looprange(1,length(VL))){ + Tmp<- VL[[I]] + S<- S+Tmp[1] + Tmp[1]<- S + SvL<- c(SvL,list(Tmp)) + } + if(Hsize>S){ + SvL<- c(SvL,list(Hsize)) + } + Hsize<- Op(1,SvL[[length(SvL)]]) + Vsize<- Domain[2] + ShL<- list(0) + S<- 0 + for (I in Looprange(1,length(HL))){ + Tmp<- HL[[I]] + S<- S+Tmp[1] + Tmp[1]<- S + ShL<- c(ShL,list(Tmp)) + } + if(Vsize>S){ + ShL<- c(ShL,list(Vsize)) + } + Vsize<- Op(1,ShL[[length(ShL)]]) + Marw<- 0; Mare<- 0; Mars<- 0; Marn<- 0 + if(length(Domain)>2){ + Marw<- Domain[3] + Mare<- Domain[4] + } + if(length(Domain)>4){ + Marn<- Domain[5] + Mars<- Domain[6] + } + Setwindow(c(-Marw,Hsize+Mare),c(-Mars,Vsize+Marn)) + Tmp<- Framedata(c(Eps,Hsize-Eps),c(Eps,Vsize-Eps)) + Gdata<- list(Tmp) + Tmp<- -Marw + Hdata<- list(Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn)))) + for (I in Looprange(1,length(SvL))){ + Data<- SvL[[I]] + X<- Data[1] + if(length(Data)==1){ + Y1<- 0 + Y2<- Vsize + G<- Listplot(c(X,Y1),c(X,Y2)) + } + else{ + G<- c() + for (J in seq(2,length(Data),by=2)){ + Y1<- Vsize-Op(1,ShL[[Data[J]]]) + Y2<- Vsize-Op(1,ShL[[Data[J+1]]]) + Tmp<- Listplot(c(c(X,Y1),c(X,Y2))) + Tmp1<- Appendrow(G,c(Inf,Inf)) + G<- Appendrow(Tmp1,Tmp) + } + G<- G[2:nrow(G),] + } + Hdata<- c(Hdata,list(G)) + } + Tmp<- Hsize+Mare + Tmp1<- Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn))) + Hdata<- c(Hdata,list(Tmp1)) + Tmp<- Vsize+Marn + Vdata<- list(Listplot(c(c(-Marw,Tmp),c(Hsize+Mare,Tmp)))) + for (I in Looprange(1,length(ShL))){ + Data<- ShL[[I]] + Y<- Vsize-Data[1] + if(length(Data)==1){ + X1<- 0 + X2<- Hsize + G<- Listplot(c(X1,Y),c(X2,Y)) + } + else{ + G<- c() + for (J in seq(2,length(Data),by=2)){ + X1<- Op(1,SvL[[Data[J]]]) + X2<- Op(1,SvL[[Data[J+1]]]) + Tmp<- Listplot(c(X1,Y),c(X2,Y)) + G<- Appendrow(G,c(Inf,Inf)) + G<- Appendrow(G,Tmp) + } + G<-G[2:nrow(G),] + } + Vdata<- c(Vdata,list(G)) + } +# Tmp<- Listplot(c(c(0,0),c(Hsize,0))) # 2011.03.02 +# Vdata<- Mixjoin(Vdata,list(Tmp)) + Tmp<- Listplot(c(c(-Marw,-Mars),c(Hsize+Mare,-Mars))) + Vdata<- Mixjoin(Vdata,list(Tmp)) + Tmp1<- Hdata[Looprange(3,length(Hdata)-2)] + Tmp2<- Vdata[Looprange(3,length(Vdata)-2)] + Gdata<- Mixjoin(Gdata,Tmp1,Tmp2) + Hind<- Looprange(2,1+length(Tmp1)) + Vind<- Looprange(2+length(Tmp1),1+length(Tmp1)+length(Tmp2)) + G=Gdata[[1]] + P1<- Ptsw(G); P2<- Ptnw(G) + Q1<- Ptse(G); Q2<- Ptne(G) + Tmp1<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) + P1<- Ptnw(G); P2<- Ptne(G) + Q1<- Ptsw(G); Q2<- Ptse(G) + Tmp2<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) + Tmp3<- Framedata() + Out<- list(Gdata,Hind,Vind,Tmp1,Tmp2,Tmp3) + return(Out) +} + +################################ + +Texcom<- function(Meirei) +{ + if(Meirei=="\\thinlines"){ + Setpen(1); + return(); + } + if(Meirei=="\\thicklines"){ + Setpen(2); + return() + } + if(Meirei=="\\Thicklines"){ + Setpen(3); + return() + } + if(length(Meirei)==0){ # 09.12.07 + Tmp<- c() + } + else{ + Tmp<- grep("newline",Meirei) + } + if(length(Tmp)>0){ + cat("\n",file=Wfile,append=TRUE); + } + else{ + Tmp<- paste(Meirei,"%\n",sep="") + Tmp<- gsub("//","\\",Tmp,fixed=TRUE) # 11.03.02 + cat(Tmp,file=Wfile,append=TRUE); + } +} + +############################################### + +Texctr<- function(N){ + if(is.numeric(N)){ + Alpha<- "abcdefghijklmnopqrstuvwxyz" + Out<- paste("ketpicctr",substr(Alpha,N,N),sep="") + } + else{ + if(grep("\\",N,fixed=TRUE)>0){ + Out<- substr(N,2,nchar(N)) + } + else{ + Out<- N + } + } + return(Out) +} + +############################################### + +Texelse<- function (){ + Texcom(""); + Texcom("\\else") +} + +############################################### + +Texend<- function() +{ + Texcom("%\n}") +} + +############################################### + +Texendfor<- function(I){ + Last<- TEXFORLAST[[TEXFORLEVEL]] + Texcom("") + Tmp<- paste("\\ifnum",Texthectr(I),"<",Last,sep="") + Texcom(Tmp) + Texcom("\\repeat") + Texcom("}") + TEXFORLEVEL<<- TEXFORLEVEL-1 + TEXFORLAST<<- TEXFORLAST[1:(length(TEXFORLAST)-1)] +} + +############################################### + +Texendif<- function(){ + Texcom("") + Texcom("\\fi") + Texcom("}") +} + +############################################### + +Texfor<- function(I,First,Last){ + TEXFORLEVEL<<- TEXFORLEVEL+1; + Texsetctr(I,"0") + Texsetctr(I,paste(as.character(First),"-1",sep="")) + Texcom("") + Texcom("{") + Texcom("\\loop") + Texsetctr(I,"+1") + TEXFORLAST<<- c(TEXFORLAST,as.character(Last)) +} + +############################################### + +Texforinit<- function(){ + TEXFORLEVEL<<- 0 + TEXFORLAST<<- list() +} + +############################################### + +Texif<- function(...){ + varargin<- list(...) + Condstr<- varargin[[1]] + Tp<- 0 + if(length(varargin)>1){ + Tp<- varargin[[2]] + } + Texcom("") + Texcom("{") + if(Tp==0){ + Texcom("\\ifnum") + } + else{ + Texcom("\\ifdim ") + } + Texcom(paste(Condstr," ",sep="")) +} + +###################################### + +Texletter<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + for (I in seq(1,Nargs,by=3)){ + P<- varargin[[I]] + X<- P[1] + if(mode(X)=="numeric"){ + X<- as.character(X) + } + Y<- P[2] + if(mode(Y)=="numeric"){ + Y<- as.character(Y) + } + Houkou<- varargin[[I+1]] + Mojiretu<- varargin[[I+2]] + Hset<- Houkou + Vhoko<- "c" + if(length(grep("n",Hset))>0){ + Vhoko<- "n" + } + if(length(grep("s",Hset))>0){ + Vhoko<- "s" + } + Hhoko<- "c"; + if(length(grep("e",Hset))>0){ + Hhoko<- "e" + } + if(length(grep("w",Hset))>0){ + Hhoko<- "w" + } + Hoko<- paste(Vhoko,Hhoko,sep="") + CalcWidth(Hoko,Mojiretu) + CalcHeight(Hoko,Mojiretu) + Tmp<- paste("\\put(",X,",",Y,"){\\hspace*{\\Width}",sep="") + Str<- paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + } +} + +################################################## + +Texnewcmd<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Str<- varargin[[1]] + S<- paste("\\newcommand{",Str,"}",sep="") + if(Nargs>1){ + Tmp<- as.character(varargin[[2]]) + S<- paste(S,"[",Tmp,"]",sep="") + } + if(Nargs>2){ + Tmp<- varargin[[3]] + if(mode(Tmp)=="numeric"){ + Tmp<- as.character(Tmp) + } + S<- paste(S,"[",Tmp,"]",sep="") + } + S<- paste(S,"{",sep="") + Texcom(S) +} + +############################################### + +Texnewctr<- function(N) +{ + if(mode(N)=="character"){ + Str<- paste("\\newcounter{",N,"}",sep="") + Texcom(Str) + } + else{ + for (I in N){ + Str<- paste("\\newcounter{",Texctr(I),"}",sep="") + Texcom(Str) + } + } +} +############################################### + +Texrenewcmd<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Str<- varargin[[1]] + S<- paste("\\renewcommand{",Str,"}",sep="") + if(Nargs>1){ + Tmp<- as.character(varargin[[2]]) + S<- paste(S,"[",Tmp,"]",sep="") + } + if(Nargs>2){ + Tmp<- varargin[[3]] + if(mode(Tmp)=="numeric"){ + Tmp<- as.character(Tmp) + } + S<- paste(S,"[",Tmp,"]",sep="") + } + S<- paste(S,"{",sep="") + Texcom(S) +} + +############################################### + +Texsetctr<- function(Nctr,Opstr) +{ + Ctr<- Texctr(Nctr) + Opstr<- paste(Opstr,"%",sep="") + OperL<- "+-*/%" + Oper<- "" + Va<- "" + Evflg<- 0 + Paflg<- 0 + for (I in Looprange(1,nchar(Opstr))){ + Tmp<- substring(Opstr,I,I) + if(Tmp=="("){ + Paflg<- 1 + if(nchar(Va)>0){ + Evflg<- 1 + Va<- paste(Va,Tmp,sep="") + } + next + } + if(Tmp==")"){ + Paflg<- 0 + if(Evflg>0){ + Va<- paste(Va,Tmp,sep="") + } + next + } + if(Paflg>0){ + Va<- paste(Va,Tmp,sep="") + next + } + if(length(grep(Tmp,OperL))==0){ + Va<- paste(Va,Tmp,sep="") + } + else{ + if(Evflg>0){ + Tmp1<- eval(parse(text=Va)) + Va<- paste("\\value{",Tmp1,"}",sep="") + Evflg<- 0 + } + if(Oper==""){ + if(nchar(Va)>0){ + Str<- paste("\\setcounter{",Ctr,"}{",Va,"}",sep="") + Texcom(Str) + } + Oper<- Tmp + Va<-"" + } + else if(Oper=="+"){ + Str<- paste("\\addtocounter{",Ctr,"}{",Va,"}",sep="") + Texcom(Str) + Oper<- Tmp + Va<-"" + } + else if(Oper=="-"){ + Str<- paste("\\addtocounter{",Ctr,"}{-",Va,"}",sep="") + Texcom(Str) + Oper<- Tmp + Va<-"" + } + else if(Oper=="*"){ + Str<- paste("\\multiply\\value{",Ctr,"} by ",Va,sep="") + Texcom(Str) + Oper<- Tmp + Va<-"" + } + else if(Oper=="/"){ + Str<- paste("\\divide\\value{",Ctr,"} by ",Va,sep="") + Texcom(Str) + Oper<- Tmp + Va<-"" + } + } + } +} + +############################################### + +Texthectr<- function(N) +{ + Out<- paste("\\the",Texctr(N),sep="") + return(Out) +} + +############################################### + +Texvalctr<- function(N){ + Out<- paste("\\value{",Texctr(N),"}",sep="") + return(Out) +} + +############################################### + +Texvctr<- function(N) +{ + Out<- paste("\\value{",Texctr(N),"}",sep="") + return(Out) +} + +############################################### + +Tonumeric <- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Data<- varargin[[1]] + Sp<- c(1,1) + Ep<- c(Inf,Inf) + if(Nargs>1){ + Sp<- varargin[[2]] + } + if(Nargs>2){ + Ep<- varargin[[3]] + } + Nrs<- Sp[1] + Nre<- min(nrow(Data),Ep[1]) + Ncs<- Sp[2] + Nce<- min(ncol(Data),Ep[2]) + Tmp1<- Data[Nrs:Nre, Ncs:Nce] + Tmp2 <- as.numeric(Tmp1) + Out <- matrix(Tmp2,nrow=nrow(Tmp1)) + Sp<- c() + for (I in 1:nrow(Out)){ + for (J in 1:ncol(Out)){ + Tmp<- Out[I,J] + if(!is.na(Tmp)){ + Sp<- c(I,J) + break; + } + } + if(length(Sp)>0) break + } + if(length(Sp)==0){ + return("Numeric data not found") + } + Ep<- c(nrow(Out),ncol(Out)) + for (I in Sp[1]:nrow(Out)){ + Tmp<- Out[I,Sp[2]] + if(is.na(Tmp)){ + Ep[1]<- I-1 + break + } + } + for (J in Sp[2]:ncol(Out)){ + Tmp<- Out[Sp[1],J] + if(is.na(Tmp)){ + Ep[2]<- J-1 + break + } + } + Out<- Out[Sp[1]:Ep[1], Sp[2]:Ep[2]] + return(Out) +} + +################################################## + +Translatedata<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-8) + ML<- varargin[[1]] + if(Mixtype(ML)==1){ + ML<- list(ML) + } + Tmp=varargin[[2]] + if(mode(Tmp)=="numeric" && length(Tmp)>1){ + A<- Tmp[1]; B<- Tmp[2] + } + else{ + A<- Tmp + if(Nargs>=3){ + B<- varargin[[3]] + } + else{ + B<- 0 + } + } + OutL<- list() + for (N in Looprange(1,length(ML))){ + GL<- Op(N,ML) + Out<- c() + for (I in Looprange(1,Nrow(GL))){ + if(is.matrix(GL)){ # 10.12.07 + Tmp<- GL[I,] + } + else{ + Tmp<- GL + } + X1<- Tmp[1] + Y1<- Tmp[2] + if(X1==Inf){ + X2<- X1 + Y2<-Y1 + } + else{ + X2<- X1+A + Y2<- Y1+B + } + Out<- Appendrow(Out,c(X2,Y2)) + } + OutL<- Mixjoin(OutL,list(Out)) + } + if(length(OutL)==1){ + OutL<- Op(1,OutL) + } + return(OutL) +} + +####################################### + +Unscaling<- function(G) +{ + GLg<- G + if(class(GLg)=="numeric"){ + GLg<-c(G[1]/SCALEX, G[2]/SCALEY) + Tmp<-GLg + if(LOGX==1) Tmp[1]<- 10^(GLg[1]) + if(LOGY==1) Tmp[2]<- 10^(GLg[2]) + return(Tmp) + } + else{ + Tmp1<-matrix(c(1/SCALEX,0,0,1/SCALEY),nrow=2) + GLg<-G %*% Tmp1 + Tmp<-GLg + if(LOGX==1) Tmp[,1]<- 10^(G[,1]) + if(LOGY==1) Tmp[,2]<- 10^(G[,2]) + return(Tmp) + } +} + +############################################# + +Vtickmark<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + ArgsL<- varargin + if(mode(ArgsL[[1]])=="character"){ + Str<- ArgsL[[1]] + Tmp<- strsplit(Str,"m") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + I<- nchar(Tmp[1])+1 + } + else{ + I<- 0 + } + Tmp<- strsplit(Str,"n") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + J<- nchar(Tmp[1])+1 + } + else{ + J<- 0 + } + Tmp<- strsplit(Str,"r") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + K=nchar(Tmp[1])+1 + } + else{ + K<- 0 + } + if(K>0){ + S<- substr(Str,K+1,nchar(Str)) + R<- as.numeric(S) + if(is.na(R)){ + R<- 1 + } + } + else{ + R<- 1 + K<- nchar(Str)+1 + } + if(J>0){ + S<- substr(Str,J+1,K-1) + Dn<- as.numeric(S) + if(is.na(Dn)){ + Dn<- 1 + } + } + else{ + Dn<- 1000 + J<- nchar(Str)+1 + } + S<- substr(Str,I+1,J-1) + Dm<- as.numeric(S) + if(is.na(Dm)){ + Dm<- 1 + } + ArgsL<- list() + for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + } + MemoriList<- list() + Memori<- list() + for (N in 1:length(ArgsL)){ + Dt<- ArgsL[[N]] + if(mode(Dt)=="numeric" && length(Dt)>1){ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt[1],Dt[2]) + next + } + if(mode(Dt)=="character"){ + Memori<- Mixjoin(Memori,Dt) + } + else{ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(GENTEN[1],Dt) + } + } + MemoriList<- Mixjoin(MemoriList,list(Memori)) + for (N in 1:length(MemoriList)){ + Dt<- MemoriList[[N]] + Ndt<- length(Dt) + X=Op(1,Dt) + Y=Op(2,Dt) + Tmp<-Doscaling(c(X,Y)) + X<- Tmp[1] + Y<- Tmp[2] + Moji<- Op(Ndt,Dt) + Tmp1<- Unscaling(c(X+MARKLEN,Y)) + Tmp2<- Unscaling(c(X-MARKLEN,Y)) + Fd<- Listplot(c(Tmp1,Tmp2)) + Drwline(Fd) + if(Ndt==3){ + Tmp<-Unscaling(c(X-MARKLEN,Y)) + Expr(Tmp,"w",Moji) + } + if(Ndt==4){ + Houkou<- Op(3,Dt) + Tmp<-grep("w",Houkou) + if(length(Tmp)>0){ + Tmp<-Unscaling(c(X-MARKLEN,Y)) + Expr(Tmp,Houkou,Moji) + } + else{ + Tmp<- Unscaling(c(X+MARKLEN,Y)) + Expr(Tmp,Houkou,Moji) + } + } + cat("%\n",file=Wfile,append=TRUE) + } +} + +############################################ + +Windisp<-function(...){ + varargin<-list(...) + Nargs<-length(varargin) + Tmp<- Doscaling(c(XMIN,YMIN)) + Xmn<- Tmp[1]; Ymn<- Tmp[2] + Tmp<- Doscaling(c(XMAX,YMAX)) + Xmx<- Tmp[1]; Ymx<- Tmp[2] + plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") + Tmp<- Doscaling(Listplot(c(0,YMIN),c(0,YMAX))) + axis(2,at=as.numeric(Tmp[,2]), labels=round(c(YMIN,YMAX),2)) + Tmp<- Doscaling(Listplot(c(XMIN,0),c(XMAX,0))) + axis(1,at=as.numeric(Tmp[,1]), labels=round(c(XMIN,XMAX),2)) + Tmp1<- c(XMIN,GENTEN[2]) + Tmp2<- c(XMAX,GENTEN[2]) + Tmp3<- Listplot(Tmp1,Tmp2) + Tmp<- MakeCurves(Tmp3,0) + if(Datalength(Tmp)>0){ + lines(Tmp[,1],Tmp[,2],col="green") + } + Tmp1<- c(GENTEN[1],YMAX) + Tmp2<- c(GENTEN[1],YMIN) + Tmp3<- Listplot(Tmp1,Tmp2) + Tmp<- MakeCurves(Tmp3,0) + if(Datalength(Tmp)>0){ + lines(Tmp[,1],Tmp[,2],col="green") + } + Tmp<-Doscaling(Framedata()) + lines(Tmp[,1],Tmp[,2]) + for (I in Looprange(1,Nargs)){ + Pdata<-varargin[[I]] + if(mode(Pdata)=="numeric"){ + Pdata<-list(Pdata) + } + while(Mixtype(Pdata)==3){ # 10.02.23 + Tmp1<- list() + for(II in Looprange(1,length(Pdata))){ + Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) + } + Pdata<- Tmp1 + } # 10.02.23 + for (II in Looprange(1,length(Pdata))){ + Tmp<-Pdata[[II]] + P<-MakeCurves(Tmp,0) + Ndm<-Dataindex(P) + for (J in Looprange(1,Nrow(Ndm))){ + Q<-P[Ndm[J,1]:Ndm[J,2],] + if(Nrow(Q)==1){ + Tmp<-seq(1,Ncol(Q),by=2) + for (K in Tmp){ + Pt<-Q[K:(K+1)] + points(Pt[1],Pt[2]) + } + } + else{ + lines(Q[,1],Q[,2]) + } + } + } + } +} + +############################################ + +WindispT<-function(..., color="black",width=1,new=FALSE,htick=c(),vtick=c()){ # 10.12.04 + par(new=new) + varargin<-list(...) + Nargs<-length(varargin) + if(!new) # 10.12.04 + { + Tmp<- Doscaling(c(XMIN,YMIN)) + Xmn<- Tmp[1]; Ymn<- Tmp[2] + Tmp<- Doscaling(c(XMAX,YMAX)) + Xmx<- Tmp[1]; Ymx<- Tmp[2] + plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") + Tick<- sort(c(YMIN,YMAX,vtick)) #### 10.12.04 from here + Tmp1<- matrix(c(rep(0,length(Tick)),Tick),ncol=2) + Tmp<- Doscaling(Tmp1) + axis(2,at=as.numeric(Tmp[,2]), labels=round(Tick,2)) + Tick<- sort(c(XMIN,XMAX,htick)) + Tmp1<- matrix(c(Tick,rep(0,length(Tick))),ncol=2) + Tmp<- Doscaling(Tmp1) + axis(1,at=as.numeric(Tmp[,1]), labels=round(Tick,2)) #### 10.12.04 to here + Tmp1<- c(XMIN,GENTEN[2]) + Tmp2<- c(XMAX,GENTEN[2]) + Tmp3<- Listplot(Tmp1,Tmp2) + Tmp<- MakeCurves(Tmp3,0) + if(Datalength(Tmp)>0){ + lines(Tmp[,1],Tmp[,2],col="green") + } + Tmp1<- c(GENTEN[1],YMAX) + Tmp2<- c(GENTEN[1],YMIN) + Tmp3<- Listplot(Tmp1,Tmp2) + Tmp<- MakeCurves(Tmp3,0) + if(Datalength(Tmp)>0){ + lines(Tmp[,1],Tmp[,2],col="green") + } + Tmp<-Doscaling(Framedata()) + lines(Tmp[,1],Tmp[,2]) + } + for (I in Looprange(1,Nargs)){ + Pdata<-Flattenlist(varargin[[I]]) # 101129 from here + Cmd<- list() + for (II in Looprange(1,length(Pdata))){ + Tmp<-Pdata[[II]] + if(length(Tmp)==1){ + Cmd<- c(Cmd,list(Tmp)) + next + } + + P<-MakeCurves(Tmp,0) + + if(length(Cmd)>0){ + if(length(Cmd)>=3){ + polygon(P,col=Cmd[[1]],border=Cmd[[2]],density=Cmd[[3]]) + } + else{ + polygon(P,col=Cmd[[1]],border=Cmd[[2]]) + } + next + } # 101129 to here + Ndm<-Dataindex(P) + for (J in Looprange(1,Nrow(Ndm))){ + Q<-P[Ndm[J,1]:Ndm[J,2],] + if(Nrow(Q)==1){ + Tmp<-seq(1,Ncol(Q),by=2) + for (K in Tmp){ + Pt<-Q[K:(K+1)] + points(Pt[1],Pt[2],col=color)#taka101111 + } + } + else{ + lines(Q[,1],Q[,2],col=color,lwd=width)#taka101111 + } + } + } + } + par(new=FALSE) +} + +###################################### + +# 3D + +################################# + +# 10.08.16 +CameracoordCurve<- function(Curve){ + Out<- c() + for(J in Looprange(1,Nrow(Curve))){ + P<- Ptcrv(J,Curve) #P=Curve(J,:); + Tmp<- P-FocusPoint + X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] + Tmp<- EyePoint-FocusPoint + E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] + Ca<- E1/sqrt(E1^2+F1^2) + Sa<- F1/sqrt(E1^2+F1^2) + X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 + E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 + Cb<- E2/sqrt(E2^2+G2^2) + Sb<- G2/sqrt(E2^2+G2^2) + X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb + E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb + Xz<- X3 + Yz<- E3/(E3-X3)*Y3 + Zz<- E3/(E3-X3)*Z3 + Out<- rbind(Out,c(Yz,Zz,Xz)) + } + rownames(Out)<- 1:Nrow(Out) + return(Out) +} + +######################################### + +#100815 +CameraCurve<- function(Curve){ + Eps<- 10^(-6) + for (I in Looprange(1,Nrow(Curve))){ + P<- Curve[I,] + x<- P[1]; y<- P[2]; z<- P[3] + if(x!=Inf){ + Tmp<- Perspt(P) + if(I==1){ + AnsL<- rbind(c(),Tmp) + }else{ + Tmp1<- AnsL[Nrow(AnsL),] + if(Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){ + AnsL<- rbind(AnsL,Tmp) + } + } + }else{ + AnsL<- rbind(AnsL,c(Inf,Inf)) + } + } + rownames(AnsL)<- 1:Nrow(AnsL) + return(AnsL) +} + +###################################### + +Cancoordpara<- function(P){ # 18.02.15 + Xz<- P[1] + Yz<- P[2] + Zz<- P[3] + X<- -Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA) + Y<- Xz*cos(PHI)-Yz*sin(PHI)*cos(THETA)+Zz*sin(PHI)*sin(THETA) + Z<- Yz*sin(THETA)+Zz*cos(THETA) + Out<- c(X,Y,Z) + return(Out) +} + +###################################### + +Cancoordpers<- function(P){ + Tmp<- EyePoint-FocusPoint + E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] + Ca<- E1/sqrt(E1^2+F1^2) + Sa<- F1/sqrt(E1^2+F1^2) + E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 + Cb<- E2/sqrt(E2^2+G2^2) + Sb<- G2/sqrt(E2^2+G2^2) + E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb + Xz<- P[3]; Yz<- P[1]; Zz<- P[2] + X3<- Xz; Y3<- Yz*(E3-Xz)/E3; Z3<- Zz*(E3-Xz)/E3 + X2<- X3*Cb-Sb*Z3; Y2<- Y3; Z2<- Cb*Z3+Sb*X3 + X1<- X2*Ca-Sa*Y2; Y1<- Ca*Y2+Sa*X2; Z1<- Z2 + X<- X1+FocusPoint[1] + Y<- Y1+FocusPoint[2] + Z<- Z1+FocusPoint[3] + Out<- c(X,Y,Z) + return(Out) +} + +####################################### + +Embed<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Pd3<- varargin[[1]] + if(Mixtype(Pd3)==1){ + Pd3<- list(Pd3) + } + else if(Mixtype(Pd3)==3){ + Tmp<- list(); + for(I in Looprange(1,length(Pd3))){ + Tmp<- c(Tmp,Pd3[[I]]) + } + Pd3<- Tmp + } + Tmpf=varargin[[2]] + if(mode(Tmpf)=="character"){ + Tmp<- varargin[[3]] + Tmp1<- gsub("c(","(",Tmp,fixed=TRUE) + Vstr<- gsub(")",")",Tmp1,fixed=TRUE) + Str<- paste("Tmpfn<- function",Vstr,"{",Tmpf,"}",sep="") + eval(parse(text=Str)) + } + else{ + Tmpfn<- Tmpf + } + Out<- list() + for(I in Looprange(1,length(Pd3))){ + PD<- Pd3[[I]] + Ans<- c() + for(J in Looprange(1,Nrow(PD))){ + P<- PD[J,] + Tmp<- Tmpfn(P[1],P[2]) + Ans<- rbind(Ans,Tmp) + } + Out<- c(Out, list(Ans)) + } + if(length(Out)==1){ + Out<- Out[[1]] + } + return(Out) +} + +####################### +# 10.08.17 +# 14.03.30 +Facesdata<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + FL<- varargin[[1]] + PT<- varargin[[length(varargin)]] + Tmp<-grep("para",PT,fixed=TRUE) + if(length(Tmp)>0){ + Ptype<- 1 + }else{ + Ptype<- -1 + } + if(Nargs==2){ + CLadd<- list() + }else{ + CLadd<- varargin[[2]] + } + NohiddenL<- list() + HiddenL<- list() + Eps<- 10^(-4) + if(length(CLadd)>0){ + if(mode(CLadd)=="numeric"){ + C<- list() + if(Nrow(CLadd)>1){ + for (I in Looprange(1,Nrow(CLadd))){ + C<- c(C,list(CLadd[I,])) + } + }else{ + I<- 1 + while (I<=Ncol(CLadd)){ + C<- c(C,list(CLadd[1,I:(I+2)])) + I<- I+3 + } + } + CrvL<- list(C) + }else if(mode(CLadd[[1]])=="numeric"){ + CrvL<- list() + for (J in Looprange(1,length(CL))){ + Ctmp<- CLadd[[J]] + C<- list() + if(Nrow(Ctmp)>1){ + for (I in Looprange(1,Nrow(Ctmp))){ + C<- c(C,list(Ctmp[I,])) + } + }else{ + I<- 1 + while(I<=Ncol(Ctmp)){ + C<- c(C,list(Ctmp[1,I:(I+2)])) + I<- I+3 + } + } + CrvL<- c(CrvL,list(C)) + } + }else{ + CrvL<- CLadd + } + }else{ + CrvL<- list() + } + Out<- MakeveLfaceL(FL) + VELNO<<- Out[[1]] + VELHI<<- list() + for (I in Looprange(1,length(CrvL))){ + Tmp<- CrvL[[I]] + for (J in Looprange(1,length(Tmp)-1)){ + Edge<- list(Tmp[J],Tmp[J+1]) + Ntmp<- length(VELNO) + VELNO(Ntmp+1)<<- list(Edge,0,Ntmp+1) + } + } + FaceL<- Out[[2]] + Tmp<- grep("raw",PT,fixed=TRUE) + if(length(Tmp)==0){ + for (Nf in Looprange(1,length(FaceL))){ + Face<- FaceL[[Nf]] + Menkakusi2(Face,Nf,Ptype) + } + } + for (I in Looprange(1,length(VELNO))){ + Edge<- Op(1,VELNO[[I]]) + if(Norm(Edge[[1]]-Edge[[2]])>Eps){ + NohiddenL<- c(NohiddenL,list(Spaceline(Edge))) + } + } + EdgeL<- list() # from 13.03.30 + for(K in Looprange(1,length(VELHI))){ + Edge<- Op(1,VELHI[[K]]) + P<- Edge[[1]]; Q<- Edge[[2]] + if(Norm(P-Q)>Eps){ + EdgeL<- c(EdgeL,list(Edge)) + } + } + for(K in Looprange(1,length(EdgeL))){ + Edge<- EdgeL[[K]] + P<- Edge[[1]]; Q<- Edge[[2]] + Cflg<- 0 + for(J in Looprange(K+1,length(EdgeL))){ + Ej<- EdgeL[[J]] + Pj<- Ej[[1]]; Qj<- Ej[[2]] + if(Norm(Crossprod(Q-P,Qj-Pj))>Eps){ + next + } + if(Norm(Q-Pj)0){ + break + } + } + Urg<- Stripblanks(Op(Jrg,FdL)) + StrV<- strsplit(Urg,"=",fixed=TRUE)[[1]] + Uname<- StrV[1] + Vrg<- Stripblanks(Op(Jrg+1,FdL)) + StrV<- strsplit(Vrg,"=",fixed=TRUE)[[1]] + Vname<- StrV[1] + if(Jrg==2){ + Tmp<- Stripblanks(Op(1,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Zf<- StrV[2] + Tmp<- list(Uname,Vname,Zf,Urg,Vrg) + Out<- c(Out,Tmp) + }else if(Jrg==4){ + Tmp<- Stripblanks(Op(1,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Zf<- StrV[2] + Tmp<- Stripblanks(Op(2,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Xname<- StrV[1] + Xf<- StrV[2] + Tmp<- Stripblanks(Op(3,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Yname<- StrV[1] + Yf<- StrV[2] + Tmp<- gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE) + Zf<- gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE) + Tmp<- list(Xf,Yf,Zf,Urg,Vrg) + Out<- c(Out,Tmp) + }else{ + Tmp<- Stripblanks(Op(2,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Xf<- StrV[2] + Tmp<- Stripblanks(Op(3,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Yf<- StrV[2] + Tmp<- Stripblanks(Op(4,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Zf<- StrV[2] + Tmp<- list(Xf,Yf,Zf,Urg,Vrg) + Out<- c(Out,Tmp) + } + DrwS<- "enws" + BdyL<- c() + for (I in Looprange(Jrg+2,Mixlength(FdL))){ + Tmp<- Op(I,FdL) + if(mode(Tmp)=="character"){ + if(length(Tmp)==0){ + Tmp<- " " + } + DrwS<- Tmp + } + if(mode(Tmp)=="numeric" && Ncol(Tmp)>1){ + BdyL<- Tmp + } + } + Tmp<- list(DrwS,BdyL) + Out<- c(Out,Tmp) + return(Out) +} + +#################################### + +Initangle<- function (){ + PHI<<- 30*pi/180 + THETA<<- 60*pi/180 +} + +########################## + +Invparapt<- function(...){ + varargin<- list(...) + Eps<- 10^(-4) + Fk<- varargin[[length(varargin)]] + NFk<- Numptcrv(Fk) + Tmp<- varargin[[1]] + if(mode(Tmp)=="numeric" && length(Tmp)==1){ # debug + Ph<- Tmp + Fh<- varargin[[2]] + }else{ + Fh<- Projpara(Fk) + if(NFk>2){ + Tmp1<- Nearestpt(Tmp,Fh) + Ph<- Tmp1[[2]] + }else{ + Ah<- Ptcrv(1,Fh); Bh=Ptcrv(2,Fh) + V1<- Tmp-Ah; V2<- Bh-Ah + Tmp1<- Crossprod(V1,V2) + if(abs(Tmp1)>Eps){ + print("Not on the line") + return(c()) + }else{ + Ph<- Dotprod(V1,V2)/Norm(V2)^2+1 + } + } + } + if(NFk>2){ + N<- trunc(Ph) + S0<- Ph-N + if(Ph>Numptcrv(Fh)-Eps){ + Out<- list(Ptend(Fk),Numptcrv(Fh)) + return(Out) + } + }else{ + N<- 1 + S0<- Ph-1 + } + Ak<- Ptcrv(N,Fk); Bk=Ptcrv(N+1,Fk) + Ah<- Ptcrv(N,Fh); Bh=Ptcrv(N+1,Fh) + Ph<- (1-S0)*Ah+S0*Bh + T2<- S0 + Pk<- (1-T2)*Ak+T2*Bk + Out<- list(Pk,N+T2) + return(Out) +} + +################################# + +#100815 +Invperspt<- function(...){ + varargin<-list(...) + Eps<- 10^(-4) + Fk<- varargin[[length(varargin)]] + NFk<- Numptcrv(Fk) + Tmp<- varargin[[1]] + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + Ph<- varargin[[1]] + Fh<- varargin[[2]] + }else{ + Fh<- Projpers(Fk) + if(NFk>2){ + Tmp1<- Nearestpt(Tmp,Fh) + Ph<- Tmp1[[2]] + }else{ + Ah<- Ptcrv(1,Fh); Bh<- Ptcrv(2,Fh) + V1<- Tmp-Ah; V2<- Bh-Ah + Tmp1<- Crossprod(V1,V2) + if(abs(Tmp1)>Eps){ + print("Not on the line") + Out<- c() + return(Out) + }else{ + Ph<- Dotprod(V1,V2)/Norm(V2)^2+1# 09.11.12 + } + } + } + if(NFk>2){ + N<- trunc(Ph) + S0<- Ph-N + if(Ph>Numptcrv(Fh)-Eps){ + Out<- list(Ptend(Fk),Numptcrv(Fh)) + return(Out) + } + }else{ + N<- 1 + S0<- Ph-1 # 09.11.12 + } + Ak<- Ptcrv(N,Fk); Bk<- Ptcrv(N+1,Fk) + Ah<- Ptcrv(N,Fh); Bh<- Ptcrv(N+1,Fh) + Ph<- (1-S0)*Ah+S0*Bh + Phc<- Cancoordpers(c(Ph,0)) + Ahc<- Cancoordpers(c(Ah,0)) + Bhc<- Cancoordpers(c(Bh,0)) + Vp<- Phc-EyePoint + Va<- Ak-EyePoint + AB<- Bk-Ak + Cp<- Crossprod(Vp,AB) + Nmr<- Crossprod(Va,Vp) + Mx<- max(abs(Cp)) + if(abs(Cp[1])==Mx){ + T2<- Nmr[1]/Cp[1] + }else if(abs(Cp[2])==Mx){ + T2<- Nmr[2]/Cp[2] + }else{ + T2<- Nmr[3]/Cp[3] + } + Pk<- (1-T2)*Ak+T2*Bk + Out<- list(Pk,N+T2) + return(Out) +} + +######################### + +Kukannozoku<- function(Jokyo,KukanL){ + Eps<- 10^(-6) + N<- Nrow(KukanL) + T1<- Jokyo[1]; T2<- Jokyo[2] + Tmp<- KukanL[1,] + T1<- max(T1,Tmp[1]) + Tmp<- KukanL[N,] + T2<- min(T2,Tmp[2]) + Res<- c() + Flg<- 0 + for (I in Looprange(1,N)){ + Ku<- KukanL[I,] + if(Flg==0){ + if(Ku[2]T2+Eps){ + Tmp<- c(T2,Ku[2]) + Res<- rbind(Res,Tmp) + } + } + }else if(Flg==1){ + if(Ku[2]0){ + for (J in 1:Mixlength(KC)){ + P<- Op(1,Op(J,KC)) + Tmp<- Op(2,Op(J,KC)) + if(Tmp<1+Eps && Ns==1){ + next + } + if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ + next + } + N1<- Ns + N2<- Op(3,Op(J,KC)) + Pa<- Plt2[N1,1:2] + Za<- Plt2[N1,3] + Pb<- Plt2[N1+1,1:2] + Zb<- Plt2[N1+1,3] + if(Norm(Pa-Pb)Eps^2){ + Tmp1<- P1[2,]-P1[1,] + Tmp2<- Pb-Pa + Tmp3<- Dotprod(Tmp1,Tmp2) + Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) + Tmp<- 1-0.5*Tmp3^2 + ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) + } + } + } + } + } + } + Te<- Nrow(Plt2) + KukanL<- rbind(c(),c(1.0,Te)) + P1<- PhL + if(Nrow(ClipL)>0){ + for (I in 1:Nrow(ClipL)){ + P<- ClipL[I,1:2] + NN<- ClipL[I,3] + T<- NN+ClipL[I,4] + R<- ClipL[I,5] + Flg<- 0 + for (J in NN:1){ + Q<- Pointoncurve(J,P1) + if(Norm(P-Q)Eps){ + Tmp<- Pointoncurve(T2,P1) + PtL<- c(PtL,list(Tmp)) + } + Res<- c(Res,list(Listplot(PtL))) + } + Allres<- c(Allres,Res) + } + return(Allres) +} + +######################### + +#100815 +Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){ + Eps<- 10.0^(-3) + Dmat<- c() + Dind<- c() + for (I in Looprange(1,Mixlength(Plt2L))){ + Dt<- Op(I,Plt2L) + N1<- Nrow(Dmat)+1 + Dmat<- rbind(Dmat,Dt) + N2<- Nrow(Dmat) + Dind<- rbind(Dind,c(N1,N2)) + } + Nind<- Nrow(Dind) + Allres<- list() + for (Nobj in Looprange(1,Mixlength(Obj2L))){ + Plt2<- Op(Nobj,Obj2L) + PhL<- Plt2[,1:2] + ClipL<- c() + for (Ns in Looprange(1,Nrow(PhL)-1)){ + P1<- PhL[Ns:(Ns+1),] + for (I in Looprange(1,Nrow(Dind))){ + Tmp<- Dmat[Dind[I,1]:Dind[I,2],] + P2<- Tmp[,1:2] + KC<- IntersectcrvsPp(P1,P2,Eps) + if(Mixlength(KC)>0){ + for (J in Looprange(1,Mixlength(KC))){# + P<- Op(1,Op(J,KC)) + Tmp<- Op(2,Op(J,KC)) + if(Tmp<(1+Eps) && Ns==1){ + next + } + if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ + next + } + N1<- Ns + N2<- Op(3,Op(J,KC)) + Pa<- Plt2[N1,1:2] + Za<- Plt2[N1,3] + Pb<- Plt2[N1+1,1:2] + Zb<- Plt2[N1+1,3] + if(Norm(Pa-Pb)1-Eps){ + Pk<- Pkb + }else{ + Tmp1<- Listplot(c(Pa,Pb)) + Tmp2<- Spaceline(c(Pka,Pkb)) + Tmp<- Invperspt(1+T1,Tmp1,Tmp2) + Pk<- Op(1,Tmp) + } + Z1<- Zperspt(Pk) + Tmp<- Dmat[Dind[I,1]:Dind[I,2],] + Pa<- Tmp[N2,1:2] + Za<- Tmp[N2,3] + Pb<- Tmp[N2+1,1:2] + Zb<- Tmp[N2+1,3] + if(Norm(Pa-Pb)(1-Eps)){ + Pk<- Pkb + }else{ + Tmp1<- Listplot(c(Pa,Pb)) + Tmp2<- Spaceline(c(Pka,Pkb)) + Tmp<- Invperspt(1+T2,Tmp1,Tmp2) + Pk<- Op(1,Tmp) + } + Z2<- Zperspt(Pk) + if(Z1<(Z2-Eps2)){ + if(length(ClipL)==0){ + Tmp<- 1 + }else{ + Tmp1<- ClipL[,1]-P[1] + Tmp2<- ClipL[,2]-P[2] + Tmp3<- Tmp1^2+Tmp2^2 + Tmp<- min(Tmp3) + } + if(Tmp>Eps^2){ + Tmp1<- P1[2,]-P1[1,] + Tmp2<- Pb-Pa + Tmp3<- Dotprod(Tmp1,Tmp2) + Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) + Tmp<- 1-0.5*Tmp3^2 + ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) + } + } + } + } + } + } + Te<- Nrow(Plt2) + KukanL<- rbind(c(),c(1.0,Te)) + P1<- PhL + if(Nrow(ClipL)>0){ + for (I in Looprange(1,Nrow(ClipL))){ + P<- ClipL[I,1:2] + NN<- ClipL[I,3] + T<- NN+ClipL[I,4] + R<- ClipL[I,5] #added 10.08.17 + Flg<- 0 + for (J in NN:1){ + Q<- Pointoncurve(J,P1) + if(Norm(P-Q)Eps){ + Tmp<- Pointoncurve(T2,P1) + PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp) + } + Res<- c(Res,list(Listplot(PtL)))#Res<- Mixadd(Res,Listplot(PtL)) + } + Allres<- c(Allres,Res)#Allres<- Mixjoin(Allres,Res) + } + return(Allres) +} + +##############################3 + +MakeveLfaceL<- function(VfL){ +# // Out format +# // VeL Edge, Face num(as numlist), VeL num +# // FL Face (Vertexs) + Eps<- 10^(-4) + Tmp<- VfL[[length(VfL)]] + Tmp1<- Tmp[[1]] + if(mode(Tmp1)=="numeric"){ + FvL<- list(VfL) + }else{ + FvL<- VfL + } + EL<- list(); FL<- list() + for (Nn in Looprange(1,length(FvL))){ + Tmp<- FvL[[Nn]] + VL<- Tmp[[1]] + if(length(VL)>0){ + FnL<- Tmp[[2]] + FaceL<- list() + for (I in Looprange(1,length(FnL))){ + Tmp1<- FnL[[I]] + PtL<- list() + for (J in Looprange(1,length(Tmp1))){ + Tmp2<- Tmp1[[J]] + PtL[[J]]<- VL[[Tmp2]] + } + FaceL[[I]]<- PtL + } + }else{ + FaceL<- list(Tmp[[2]]) + } + for (I in Looprange(1,length(FaceL))){ + Face<- FaceL[[I]] + Face<- c(Face,list(Face[[1]])) + FL<- c(FL,list(Face)) + for (J in Looprange(1,length(Face)-1)){ + Edge<- list(Face[[J]],Face[[J+1]]) + Flg<- 0 + for (K in Looprange(1,length(EL))){ + Tmp<- EL[[K]] + Tmp1<- Tmp[[1]] + Tmp2<- Norm(Edge[[1]]-Tmp1[[1]])+Norm(Edge[[2]]-Tmp1[[2]]) + Tmp3<- Norm(Edge[[1]]-Tmp1[[2]])+Norm(Edge[[2]]-Tmp1[[1]]) + if(Tmp21-Eps){# // P3, Q3 are necessary + Flg<- I + break + } + if(abs(Te-Ts)>Eps0){ + if((I%%2)==1){ + Out1<- c(Out1,list(list(Pe3,P3))) + }else{ + if(length(Qe3)==0){ + Tmp<- Op(2,TenL[[I-1]]) + if(Ptype==-1){ + Tmp1<- Invperspt(Tmp,Spaceline(Face)) + }else{ + Tmp1<- Invparapt(Tmp,Spaceline(Face)) + } + Qe3<- Tmp1[[1]] + } + PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) + if(Ptype==-1){ + Z1<- Zperspt(PM); Z2<- Zperspt(QM) + }else{ + Z1<- Zparapt(PM); Z2<- Zparapt(QM) + } + if(Z1>Z2){ + Out1<- c(Out1, list(list(Pe3,P3))) + }else{ + Out2<- c(Out2, list(list(Pe3,P3))) + }## + } + } + Te<- Ts; Pe3<- P3; Qe3<- Q3 + } + if(Flg==0){ + if(Norm(Pe3-Edge[[2]])>Eps0){ + Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) + } + }else{ + if((Flg%%2)==1){ + Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) + }else{ + PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) + if(Ptype==-1){ + Z1<- Zperspt(PM); Z2<- Zperspt(QM) + }else{ + Z1<- Zparapt(PM); Z2<- Zparapt(QM) + } + if(Z1>Z2){ + Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) + }else{ + Out2<- c(Out2, list(list(Pe3,Edge[[2]]))) + } + } + } + for (I in Looprange(1,length(Out1))){ + Tmp<- Out1[[I]] + if(I==1){ + SeL<- Tmp + }else{ + if(Norm(SeL[[2]]-Tmp[[1]])0){ + Out1L<- c(Out1L, list(list(SeL,Ne,NNe))) + } + for (I in Looprange(1,length(Out2))){ + Tmp<- Out2[[I]] + if(I==1){ + SeL<- Tmp + }else{ + if(Norm(SeL[[2]]-Tmp[[1]])0){ + Out2L<- c(Out2L, list(list(SeL,Ne,NNe))) + } + } + VELNO<<- Out1L + VELHI<<- Out2L +} + +################################### + +Parapt<- function(Plist){ # 18.02.19 changed (for point list) + if(!is.list(Plist)){Plist=list(Plist)} + Out=list() + for(jj in 1:length(Plist)){ + P=Op(jj,Plist) + x<- P[1] + y<- P[2] + z<- P[3] + Xz<- -x*sin(PHI)+y*cos(PHI) + Yz<- -x*cos(PHI)*cos(THETA)-y*sin(PHI)*cos(THETA)+z*sin(THETA) + Out<- c(Out,list(c(Xz,Yz))) + } + if(length(Out)==1){Out=Op(1,Out)} + return(Out) +} + +################################### + +Partcrv3<- function(T1,T2,Fk){ + Eps0=10^(-4) +#// Tmp=Mixop(1,Fk) +#// new part from + if(T1>(T2+Eps0)){ + Npt<- Nrow(Fk) + Out1<- Partcrv3(T1,Npt,Fk) + Out2<- Partcrv3(1,T2,Fk) + Tmp<- Fk[1,]-Fk[Npt,] + if(Norm(Tmp)(Ie+Eps0)){ + P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,] + PL<- Appendrow(PL,P) + } + } + return(PL) +} + +################################### + +#100815 +Perspt<- function(P){ + Tmp<- P-FocusPoint + X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] + Tmp<- EyePoint-FocusPoint + E1<- Tmp[1];F1<- Tmp[2];G1<- Tmp[3] + Ca<- E1/sqrt(E1^2+F1^2) + Sa<- F1/sqrt(E1^2+F1^2) + X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 + E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 + Cb<- E2/sqrt(E2^2+G2^2) + Sb<- G2/sqrt(E2^2+G2^2) + X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb + E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb + Yz<- E3/(E3-X3)*Y3 + Zz<- E3/(E3-X3)*Z3 + Out<- c(Yz,Zz) + return(Out) +} + + +################################# + +Phcutdata<- function(VL,FaceL,PlaneD){ + Out<- list() + EL<- list() + Eps<- 10^(-4) + for (I in Looprange(1,Mixlength(FaceL))){ + Face<- Op(I,FaceL) + for (J in Looprange(1,length(Face))){ + Nj<- J+1 + if(J==length(Face)){ + Nj<- 1 + } + N1<- Face[J]; N2<- Face[Nj] + Tmp<- c(N1,N2) + Flg<- 0 + for (K in Looprange(1,Mixlength(EL))){ + Tmp1<- Op(K,EL) + Tmp2<- Tmp1[2:1] + if(all(Tmp==Tmp1) || all(Tmp==Tmp2)){ + Flg<- 1 + break + } + } + if(Flg==0){ + EL<- c(EL,list(Tmp)) + } + } + } + Out0<- list() + for (I in Looprange(1,Mixlength(EL))){ + Tmp<- Op(I,EL) + Tmp1<- Op(Tmp[1],VL) + Tmp2<- Op(Tmp[2],VL) + Out0<- c(Out0, list(Spaceline(Tmp1,Tmp2))) + } + if(Mixtype(PlaneD)!=1){ + V1<- Op(1,PlaneD) + Tmp<- Op(2,PlaneD) + if(length(Tmp)>1){ + d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] + }else{ + d<- Tmp + } + }else if(mode(PlaneD)=="numeric"){ + V1<- PlaneD[1:3] + d<- PlaneD[4] + }else{ + StrV<- strsplit(PlaneD,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Tmp1<- StrV[1] + Tmp2<- StrV[2] + PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") + } + x<- 0; y<- 0; z<- 0 + d<- -eval(parse(text=PlaneD)) + x<- 1; y<- 0; z<- 0; + Tmp1<- eval(parse(text=PlaneD))+d + x<- 0; y<- 1; z<- 0 + Tmp2<- eval(parse(text=PlaneD))+d + x<- 0; y<- 0; z<- 1 + Tmp3<- eval(parse(text=PlaneD))+d + V1<- c(Tmp1,Tmp2,Tmp3) + } + if(all(V1==c(0,0,0))){ + return(Out0) + } + V3<- c(1,0,0) + Out1<- Rotate3data(Out0,V1,V3) + Tmp2<- Rotate3pt(c(1,0,0),V3,V1) + Tmp<- V1[1]*Tmp2[1]+V1[2]*Tmp2[2]+V1[3]*Tmp2[3] + x0<- d/Tmp + PtL<- list() + for (I in Looprange(1,Mixlength(Out1))){ + Tmp<- Op(I,Out1) + Tmp1<- Tmp[1,]; Tmp2<- Tmp[2,] + P<- list(Tmp1,Tmp2-Tmp1) + Tmp<- list(Tmp1[1],Tmp2[1]-Tmp1[1]) + if(abs(Tmp[[2]]) < Eps){ + Tmp<- c() + }else{ + Tmp1<- Tmp[[2]] + Tmp2<- x0-Tmp[[1]] + Tmp<- c(Tmp2/Tmp1) + } + if(length(Tmp)>0){ + Tmp<- Tmp[1] + if(Tmp>-Eps && Tmp<(1+Eps)){ + Tmp3<- P[[1]]+Tmp*P[[2]] + Tmp3<- Rotate3pt(Tmp3,V3,V1) + if(Tmp1-Eps){ + Tmp1<- Op(I,EL) + Tmp1<- Tmp1[2] + Tmp4<- list(c(Tmp1,Tmp1),Tmp3) + }else{ + Tmp4<- list(Op(I,EL),Tmp3) + } + } + Flg<- 0 + for (J in Looprange(1,Mixlength(PtL))){ + Tmp<- Op(J,PtL) + Tmp<- Op(2,Tmp) + if(Norm(Tmp3-Tmp)1){ + d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] + }else{ + d<- Tmp + } + }else if(mode(PlaneD)=="numeric"){ + V1<- PlaneD[1:3] + d<- PlaneD[4] + }else{ + StrV<- strsplit(PlaneD,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Tmp1<- StrV[1] + Tmp2<- StrV[2] + PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") + } + x<- 0; y<- 0; z<- 0 + d<- -eval(parse(text=PlaneD)) + x<- 1; y<- 0; z<- 0 + Tmp1<- eval(parse(text=PlaneD))+d + x<- 0; y<- 1; z<- 0 + Tmp2<- eval(parse(text=PlaneD))+d + x<- 0; y<- 0; z<- 1 + Tmp3<- eval(parse(text=PlaneD))+d + V1<- c(Tmp1,Tmp2,Tmp3) + } + for (I in Looprange(1,Mixlength(FaceL))){ + Face<- Op(I,FaceL) + TmpL<- list() + for (J in Looprange(1,length(Face))){ + N1<- Face[J] + if(J==length(Face)){ + N2<- Face[1] + }else{ + N2<- Face[J+1] + } + for (K in Looprange(1,Mixlength(PtL))){ + Pd<- Op(K,PtL) + Tmp<- Op(1,Pd) + if(Tmp[1]==Tmp[2]){ + if(Tmp[1]==N1){ + TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) + } + }else{ + if(all(Tmp==c(N1,N2)) || all(Tmp==c(N2,N1))){ + TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) + } + } + } + } + if(Mixlength(TmpL)<2){ + Flg<- 0 + for (J in Looprange(1,length(Face))){ + Tmp<- Op(Face[J],VL) + Tmp1<- Fugou*(Dotprod(V1,Tmp)-d) + if(Tmp1< -Eps){ + Flg<- 1 + break + } + } + if(Flg==0){ + OutfL<- c(OutfL,list(Face)) + } + next + } + Pd<- Op(1,TmpL) + Qd<- Op(2,TmpL) + Outf1<- c(Op(3,Pd)) + Nf<- Op(1,Pd)+1 + Tmp<- Op(2,Pd) + JJ<- 0 + while (!all(Tmp==Op(2,Qd))){ + JJ<- JJ+1 + if(JJ>20){ + print("bug") + return() + } + Tmp1<- Tmp[2] + if(Outf1[length(Outf1)]!=Tmp1){ + Outf1<- c(Outf1,Tmp1) + } + Tmp<- c(Face[Nf]) + Nf<- Nf+1 + if(Nf>length(Face)){ + Nf<- 1 + } + Tmp<- c(Tmp,Face[Nf]) + } + Tmp1<- Op(3,Qd) + if(Outf1[length(Outf1)]!=Tmp1){ + Outf1<- c(Outf1,Tmp1) + } + Outf2<- c(Op(3,Pd)) + Nf<- Op(1,Pd) + Tmp<- Op(2,Pd) + JJ<- 0 + while (!all(Tmp==Op(2,Qd))){ + JJ<- JJ+1 + if(JJ>20){ + print("bug") + return() + } + Tmp1<- Tmp[1] + if(Outf2[length(Outf2)]!=Tmp1){ + Outf2<- c(Outf2,Tmp1) + } + Tmp<- c(Face[Nf]) + Nf<- Nf-1 + if(Nf<1){ + Nf<- length(Face) + } + Tmp<- c(Face[Nf],Tmp) + } + Tmp1<- Op(3,Qd) + if(Outf2[length(Outf2)]!=Tmp1){ + Outf2<- c(Outf2,Tmp1) + } + if(length(Outf1)<3 || length(Outf2)<3){ + Face<- Outf1 + if(length(Outf1)=4){ + C<- varargin[[4]] + } + if(Mixtype(Pd3)==1){ + Pd3<- list(Pd3) + } else if(Mixtype(Pd3)==3){ + Tmp<- list() + for (I in Looprange(1,Mixlength(Pd3))){ + Tmp<- c(Tmp,Op(I,Pd3)) + } + Pd3<- Tmp + } + Out<- list() + for (I in Looprange(1,Mixlength(Pd3))){ + PD<- Op(I,Pd3) + Ans<- c() + for (J in Looprange(1,Nrow(PD))){ + if(is.matrix(PD)){ # 11.08.27 + P<- PD[J,] + } + else{ + P<- PD + } + Tmp<- Rotate3pt(P,W1,W2,C) # 14.03.23 + Ans<- rbind(Ans,Tmp) + } # 11.08.27 + rownames(Ans)<- 1:Nrow(Ans) #10.08.16 + Out<- c(Out,list(Ans)) + } + if(Mixlength(Out)==1){ + Out<- Op(1,Out) + } + return(Out) +} + +####################################### + +Rotate3pt<- function(...){ + varargin<-list(...) + Eps<-10^(-4) + Nargs<-length(varargin) + P<- varargin[[1]] + W1<- varargin[[2]] + W2<- varargin[[3]] + C<- c(0,0,0) + if(Nargs>=4){ + C<- varargin[[4]] + } + if(mode(W2)=="numeric" && length(W2)==1){ + Ct<- cos(W2) + St<- sin(W2) + V3<- 1/Norm(W1)*W1 + if(V3[1]==0){ + Tmp<- c(1,0,0) + }else{ + Tmp<- c(0,1,0) + } + W1<- c(Tmp[2]*V3[3]-Tmp[3]*V3[2], + Tmp[3]*V3[1]-Tmp[1]*V3[3], + Tmp[1]*V3[2]-Tmp[2]*V3[1]) + V1<- 1/Norm(W1)*W1 + V2<- c(V3[2]*V1[3]-V3[3]*V1[2], + V3[3]*V1[1]-V3[1]*V1[3], + V3[1]*V1[2]-V3[2]*V1[1]) + }else{ + Tmp<- c(W1[2]*W2[3]-W1[3]*W2[2], + W1[3]*W2[1]-W1[1]*W2[3], + W1[1]*W2[2]-W1[2]*W2[1]) + if(Norm(Tmp)=3){ + Ndu<- varargin[[2]] + Ndv<- varargin[[3]] + } + if(Nargs>=4){ + Np<- varargin[[4]] + if(mode(Np)=="numeric" && length(Np)==1){ + Np<- c(Np,Np) + } + } + Du<- (Umax-Umin)/Ndu + Dv<- (Vmax-Vmin)/Ndv + PL <- c()#PL <- [] + Assign("Vmin",Vmin,"Vmax",Vmax) + Trgstr<- Assign("t=c(Vmin,Vmax)") + PL <- list() + for (I in Looprange(0,Ndu)){ + U0 <- paste("(",as.character(Umin+I*Du),")",sep="") + Tmp<- gsub(U,U0,Xf,fixed=TRUE) + Tmp1<- gsub(V,"t",Tmp,fixed=TRUE) + Tmp<- gsub(U,U0,Yf,fixed=TRUE) + Tmp2<- gsub(V,"t",Tmp,fixed=TRUE) + Tmp<- gsub(U,U0,Zf,fixed=TRUE) + Tmp3<- gsub(V,"t",Tmp,fixed=TRUE) + Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")",sep="") + PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[2]))) + PL<- c(PL,list(PD)) + } + Assign("Umin",Umin,"Umax",Umax) + Trgstr<- Assign("t=c(Umin,Umax)") + for (J in Looprange(0,Ndv)){ + V0<- paste("(",as.character(Vmin+J*Dv),")",sep="") + Tmp<- gsub(V,V0,Xf,fixed=TRUE) + Tmp1<- gsub(U,"t",Tmp,fixed=TRUE) + Tmp<- gsub(V,V0,Yf,fixed=TRUE) + Tmp2<- gsub(U,"t",Tmp,fixed=TRUE) + Tmp<- gsub(V,V0,Zf,fixed=TRUE) + Tmp3<- gsub(U,"t",Tmp,fixed=TRUE) + Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")") + PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[1]))) + PL<- c(PL,list(PD)) + } + return(PL) +} + +################################### + +Skeletonparadata<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + Out<- list() + ObjL<- Flattenlist(varargin[[1]]) + Plt3L<- Flattenlist(varargin[[2]]) + R<- 0.075*1000/2.54/MilliIn + if(Nargs>2){ + R<- R*varargin[[3]] + } + Eps2<- 0.05 + if(Nargs>3){ + Eps2<- varargin[[4]] + } + Obj2L<- list() + for (I in Looprange(1,Mixlength(ObjL))){ + Tmp<- ProjcoordCurve(Op(I,ObjL)) + Obj2L<- c(Obj2L,list(Tmp)) + } + Plt2L<- list() + for (I in Looprange(1,Mixlength(Plt3L))){ + Tmp<- ProjcoordCurve(Op(I,Plt3L)) + Plt2L<- c(Plt2L,list(Tmp)) + } + Out<- Makeskeletondata(Obj2L,Plt2L,R,Eps2) + return(Out) +} + +################################ + +Skeletonpara3data<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + ObjL<- Flattenlist(varargin[[1]]) + Plt3L<- Flattenlist(varargin[[2]]) + R<- 0.075*1000/2.54/MilliIn + if(Nargs>2){ + R=R*varargin[[3]] + } + Eps2<- 0.05 + if(Nargs>3){ + Eps2<- varargin[[4]] + } + Plt2L<- list() + for (I in Looprange(1,Mixlength(Plt3L))){ + Tmp<- ProjcoordCurve(Op(I,Plt3L)) + Plt2L<- c(Plt2L,list(Tmp)) + } + Out<- list() + for (I in Looprange(1,Mixlength(ObjL))){ + Obj3<- Op(I,ObjL) + Tmp<- ProjcoordCurve(Obj3) + Data<- Makeskeletondata(list(Tmp),Plt2L,R,Eps2) + for (J in Looprange(1,Mixlength(Data))){ + Gd<- Op(J,Data) + PtD<- c() + for (J in Looprange(1,Nrow(Gd))){ + Tmp<- Ptcrv(J,Gd) + Tmp1<- Invparapt(Tmp,Obj3) + Tmp1<- Op(1,Tmp1) + PtD<- c(PtD,Tmp1) + } + PtD<- matrix(PtD,ncol=3,byrow=TRUE) + Out<- c(Out,list(PtD)) + } + } + return(Out) +} + +################################# + +#100815 +Skeletonpersdata<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + Out<- list() + ObjL<- Flattenlist(varargin[[1]]) + Plt3L<- Flattenlist(varargin[[2]]) + R<- 0.075*1000/2.54/MilliIn + if(Nargs>2){ + R<- R*varargin[[3]] + } + Eps2<- 0.05 + if(Nargs>3){ + Eps2<- varargin[[4]] + } + Obj2L<- list() + for (I in Looprange(1,Mixlength(ObjL))){ + Tmp<- CameracoordCurve(Op(I,ObjL)) + Obj2L<- c(Obj2L,list(Tmp)) + } + Plt2L<- list() + for (I in Looprange(1,Mixlength(Plt3L))){ + Tmp<- CameracoordCurve(Op(I,Plt3L)) + Plt2L<- c(Plt2L,list(Tmp)) + } + Out<- Makeskeletonpersdata(Obj2L,Plt2L,R,Eps2) + return(Out) +} + +##################### +#100815 +Skeletonpers3data<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + Out<- list() + ObjL<- Flattenlist(varargin[[1]]) + Plt3L<- Flattenlist(varargin[[2]]) + R<- 0.075*1000/2.54/MilliIn + if(Nargs>2){ + R<- R*varargin[[3]] + } + Eps2<- 0.05 + if(Nargs>3){ + Eps2<- varargin[[4]] + } + Plt2L<- list() + for (I in Looprange(1,Mixlength(Plt3L))){ + Tmp<- CameracoordCurve(Op(I,Plt3L)) + Plt2L<- c(Plt2L,list(Tmp)) + } + Out<- list() + for (I in Looprange(1,Mixlength(ObjL))){ + Obj3<- Op(I,ObjL) + Tmp<- CameracoordCurve(Obj3) + Data<- Makeskeletonpersdata(list(Tmp),Plt2L,R,Eps2) + for (J in Looprange(1,Mixlength(Data))){ + Gd<- Op(J,Data) + PtD<- c() + for (J in Looprange(1,Nrow(Gd))){ + Tmp<- Gd[J,] + Tmp1<- Invperspt(Tmp,Obj3) + Tmp1<- Op(1,Tmp1) + PtD<- rbind(PtD,Tmp1) + } + Out<- c(Out,list(PtD)) + } + } + return(Out) +} + +################################# + +Spacecurve<- function(...){ + Eps<- 10^(-5) + varargin<-list(...) + Nargs<- length(varargin) + Fnstr<- varargin[[1]] + Rgstr<- varargin[[2]] + Range<- c(0,2*pi) + N<- 50 #Numpoints + E<- c() #Exclusions + D<- Inf #Discont (Changed) + for(I in Looprange(3,Nargs)){ + Tmp<- varargin[[I]] + StrV<- strsplit(Tmp,"=",fixed=TRUE) + StrV<- StrV[[1]] + Tmp1<- toupper(StrV[1]) + Lhs<- substr(Tmp1,1,1) + Str<- paste(Lhs,"=",StrV[2],sep="") + eval(parse(text=Str)) + } + StrV<- strsplit(Rgstr,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Vname<- StrV[1] + Rng<- eval(parse(text=StrV[2])) + } + else{ + Vname<- Rgstr + Rng<- c(XMIN,XMAX) + } + T1<- Rng[1]; T2<- Rng[2] + Dt<- (T2-T1)/N #17.09.22 + Str<- gsub(Vname,"t",Fnstr) + Str=gsub("[","c(",Str,fixed=TRUE) #17.12.22(2lines) + Str=gsub("]",")",Str,fixed=TRUE) + if(abs(Dt)0 && P[Nrow(P),1]!=Inf){ + Pa<- c(Inf,Inf,Inf) + } + } + if(t-E[Ke]>Eps){ + Pa<- eval(parse(text=Str)) + Ke<- Ke+1 + } + if(length(Pa)>0){ + if(Pa[1]==Inf){ + P<- rbind(P,Pa) + }else if(length(P)==0){ + P<- rbind(c(),c(Pa)) + } + else{ + Tmp<- P[Nrow(P),] + if(Tmp[1]==Inf){ + P<- rbind(P,Pa) + } + else if( Norm(Tmp-Pa)1) StrV<- StrV[2] + Tmp<- eval(parse(text=StrV)) + Py<- c(0,Tmp[1],0) + Qy<- c(0,Tmp[2],0) + StrV<-strsplit(Zrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1) StrV<- StrV[2] + Tmp<- eval(parse(text=StrV)) + Pz<- c(0,0,Tmp[1]) + Qz<- c(0,0,Tmp[2]) + Out<- list(Spaceline(Px,Qx),Spaceline(Py,Qy),Spaceline(Pz,Qz)) + return(Out) +} + +################################### + +Xyzaxparaname<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10.0^(-6) + Dr<- 0.19*1000/2.54/MilliIn + Tmp<- varargin[[Nargs]] + if(Nargs>1 && is.numeric(Tmp)){ + Dr<- Dr*Tmp + Nargs<- Nargs-1 + } + if(mode(varargin[[1]])=="character"){ + Xname<- "x" + Yname<- "y" + Zname<- "z" + Xrange<- varargin[[1]] + Yrange<- varargin[[2]] + Zrange<- varargin[[3]] + StrV<-strsplit(Xrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Xname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Px<- c(Tmp[1],0,0) + Qx<- c(Tmp[2],0,0) + StrV<-strsplit(Yrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Yname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Py<- c(0,Tmp[1],0) + Qy<- c(0,Tmp[2],0) + StrV<-strsplit(Zrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Zname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Pz<- c(0,0,Tmp[1]) + Qz<- c(0,0,Tmp[2]) + }else{ + Data<- varargin[[1]] + Xname<- "x"; Yname<- "y"; Zname<- "z" + if(Nargs>1){ + if(varargin[[2]]!=""){ + Xname<- varargin[[2]] + } + if(varargin[[3]]!=""){ + Yname<- varargin[[3]] + } + if(varargin[[4]]!=""){ + Zname<- varargin[[4]] + } + } + Tmp<- Op(1,Data) + Px<- Tmp[1,]; Qx<- Tmp[2,] + Tmp<- Op(2,Data) + Py<- Tmp[1,] + Qy<- Tmp[2,] + Tmp<- Op(3,Data) + Pz<- Tmp[1,] + Qz<- Tmp[2,] + } + Ph<- Parapt(Px); Qh<- Parapt(Qx); R<-Norm(Ph-Qh) + Kekka<- list() + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Xname) + } + Ph<- Parapt(Py); Qh<- Parapt(Qy); R<- Norm(Ph-Qh) + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Yname) + } + Ph<- Parapt(Pz); Qh<- Parapt(Qz); R<- Norm(Ph-Qh) + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Zname) + } +# return(Kekka) +} + +################################### + +Xyzaxpersname<- function(...){ + varargin<- list(...) + Eps<- 10.0^(-6) + Nargs<- length(varargin) + Dr<- 0.19*1000/2.54/MilliIn + Tmp<- varargin[[Nargs]] + if(Nargs>1 && mode(Tmp)=="numeric"){ + Dr<- Dr*Tmp + Nargs<- Nargs-1 + } + if(mode(varargin[[1]])=="character"){ + Xname<- "x" + Yname<- "y" + Zname<- "z" + Xrange<- varargin[[1]] + Yrange<- varargin[[2]] + Zrange<- varargin[[3]] + StrV<-strsplit(Xrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Xname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Px<- c(Tmp[1],0,0) + Qx<- c(Tmp[2],0,0) + StrV<-strsplit(Yrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Yname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Py<- c(0,Tmp[1],0) + Qy<- c(0,Tmp[2],0) + StrV<-strsplit(Zrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Zname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Pz<- c(0,0,Tmp[1]) + Qz<- c(0,0,Tmp[2]) + }else{ + Data<- varargin[[1]] + Xname<- "x"; Yname<- "y"; Zname<- "z" + if(Nargs>1){ + if(varargin[[2]]!=""){ + Xname<- varargin[[2]] + } + if(varargin[[3]]!=""){ + Yname<- varargin[[3]] + } + if(varargin[[4]]!=""){ + Zname<- varargin[[4]] + } + } + Tmp<- Op(1,Data) + Px<- Tmp[1,]; Qx<- Tmp[2,] + Tmp<- Op(2,Data) + Py<- Tmp[1,] + Qy<- Tmp[2,] + Tmp<- Op(3,Data) + Pz<- Tmp[1,] + Qz<- Tmp[2,] + } + Ph<- Perspt(Px) + Qh<- Perspt(Qx) + R<- Norm(Ph-Qh) + Kekka<- list() + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Xname) + } + Ph<- Perspt(Py) + Qh<- Perspt(Qy) + R<- Norm(Ph-Qh) + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Yname) + } + Ph<- Perspt(Pz) + Qh<- Perspt(Qz) + R<- Norm(Ph-Qh) + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Zname) + } +# return(Kekka) +} + +######################### +#100815 +Zparapt<- function(P){#function Out=Zparapt(P) + x<- P[1]; y<- P[2]; z<- P[3] + Out<- x*cos(PHI)*sin(THETA)+y*sin(PHI)*sin(THETA)+z*cos(THETA) + return(Out) +} + +######################### +#100815 +Zperspt<- function(P){ + Tmp<- P-FocusPoint + X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] + Tmp<- EyePoint-FocusPoint + E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] + Ca<- E1/sqrt(E1^2+F1^2) + Sa<- F1/sqrt(E1^2+F1^2) + X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 + E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 + Cb<- E2/sqrt(E2^2+G2^2) + Sb<- G2/sqrt(E2^2+G2^2) + X3<- X2*Cb+Z2*Sb + return(X3) +} + +########################################## + + + +########################################## + +# Stat Package + +########################################## + +# 2010.04.12 + +# new + +# Htickmarklower, Vtickmarkleft, HtickmarklowerV +# VtickmarkleftV, Insertcom, Replacecom +# Maketexfile, Formatting +# Drwhistframe, Histplotdata, Drwhistplot + +Htickmarklower<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + ArgsL<- varargin + if(mode(ArgsL[[1]])=="character"){ + Str<- ArgsL[[1]] + Tmp<- strsplit(Str,"m") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + I<- nchar(Tmp[1])+1 + } + else{ + I<- 0 + } + Tmp<- strsplit(Str,"n") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + J<- nchar(Tmp[1])+1 + } + else{ + J<- 0 + } + Tmp<- strsplit(Str,"r") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + K=nchar(Tmp[1])+1 + } + else{ + K<- 0 + } + if(K>0){ + S<- substr(Str,K+1,nchar(Str)) + R<- as.numeric(S) + if(is.na(R)){ + R<- 1 + } + } + else{ + R<- 1 + K<- nchar(Str)+1 + } + if(J>0){ + S<- substr(Str,J+1,K-1) + Dn<- as.numeric(S) + if(is.na(Dn)){ + Dn<- 1 + } + } + else{ + Dn<- 1000 + J<- nchar(Str)+1 + } + S<- substr(Str,I+1,J-1) + Dm<- as.numeric(S) + if(is.na(Dm)){ + Dm<- 1 + } + ArgsL<- list() + for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + } + MemoriList<- list() + Memori<- list() + for (N in 1:length(ArgsL)){ + Dt<- ArgsL[[N]] + if(mode(Dt)=="numeric" && length(Dt)>1){ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt) + next + } + if(mode(Dt)=="character"){ + Memori<- Mixjoin(Memori,Dt) + } + else{ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt,GENTEN[2]) + } + } + MemoriList<- Mixjoin(MemoriList,list(Memori)) + for (N in 1:length(MemoriList)){ + Dt<- MemoriList[[N]] + Ndt<- length(Dt) + X=Op(1,Dt) + Y=Op(2,Dt) + Tmp<-Doscaling(c(X,Y)) + X<- Tmp[1] + Y<- Tmp[2] + Moji<- Op(Ndt,Dt) + Tmp1<- Unscaling(c(X,Y)) + Tmp2<- Unscaling(c(X,Y-2*MARKLEN)) + Fd<- Listplot(c(Tmp1,Tmp2)) + Drwline(Fd) + if(Ndt==3){ + Tmp<-Unscaling(c(X,Y-2*MARKLEN)) + Expr(Tmp,"s",Moji) + } + if(Ndt==4){ + Houkou<- Op(3,Dt) + Tmp<-grep("s",Houkou) + if(length(Tmp)>0){ + Tmp<-Unscaling(c(X,Y-2*MARKLEN)) + Expr(Tmp,Houkou,Moji) + } + else{ + Tmp<- Unscaling(c(X,Y)) + Expr(Tmp,Houkou,Moji) + } + } + cat("%\n",file=Wfile,append=TRUE) + } +} + +Vtickmarkleft<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + ArgsL<- varargin + if(mode(ArgsL[[1]])=="character"){ + Str<- ArgsL[[1]] + Tmp<- strsplit(Str,"m") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + I<- nchar(Tmp[1])+1 + } + else{ + I<- 0 + } + Tmp<- strsplit(Str,"n") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + J<- nchar(Tmp[1])+1 + } + else{ + J<- 0 + } + Tmp<- strsplit(Str,"r") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + K=nchar(Tmp[1])+1 + } + else{ + K<- 0 + } + if(K>0){ + S<- substr(Str,K+1,nchar(Str)) + R<- as.numeric(S) + if(is.na(R)){ + R<- 1 + } + } + else{ + R<- 1 + K<- nchar(Str)+1 + } + if(J>0){ + S<- substr(Str,J+1,K-1) + Dn<- as.numeric(S) + if(is.na(Dn)){ + Dn<- 1 + } + } + else{ + Dn<- 1000 + J<- nchar(Str)+1 + } + S<- substr(Str,I+1,J-1) + Dm<- as.numeric(S) + if(is.na(Dm)){ + Dm<- 1 + } + ArgsL<- list() + for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + } + MemoriList<- list() + Memori<- list() + for (N in 1:length(ArgsL)){ + Dt<- ArgsL[[N]] + if(mode(Dt)=="numeric" && length(Dt)>1){ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt) + next + } + if(mode(Dt)=="character"){ + Memori<- Mixjoin(Memori,Dt) + } + else{ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(GENTEN[1],Dt) + } + } + MemoriList<- Mixjoin(MemoriList,list(Memori)) + for (N in 1:length(MemoriList)){ + Dt<- MemoriList[[N]] + Ndt<- length(Dt) + X=Op(1,Dt) + Y=Op(2,Dt) + Tmp<-Doscaling(c(X,Y)) + X<- Tmp[1] + Y<- Tmp[2] + Moji<- Op(Ndt,Dt) + Tmp1<- Unscaling(c(X,Y)) + Tmp2<- Unscaling(c(X-2*MARKLEN,Y)) + Fd<- Listplot(c(Tmp1,Tmp2)) + Drwline(Fd) + if(Ndt==3){ + Tmp<-Unscaling(c(X-2*MARKLEN,Y)) + Expr(Tmp,"w",Moji) + } + if(Ndt==4){ + Houkou<- Op(3,Dt) + Tmp<-grep("w",Houkou) + if(length(Tmp)>0){ + Tmp<-Unscaling(c(X-2*MARKLEN,Y)) + Expr(Tmp,Houkou,Moji) + } + else{ + Tmp<- Unscaling(c(X,Y)) + Expr(Tmp,Houkou,Moji) + } + } + cat("%\n",file=Wfile,append=TRUE) + } +} + +HtickmarklowerV<- function(Vec,digits=2,nsmall=2) +{ + for (I in 1:length(Vec)){ + Tmp<- Vec[I] + Htickmarklower(Tmp, Formatting(Tmp,digits,nsmall)) + } +} + +HtickLV<- function(...) +{ + HtickmarklowerV(...) +} + +VtickmarkleftV<- function(Vec,digits=2,nsmall=2) +{ + for (I in 1:length(Vec)){ + Tmp<- Vec[I] + Vtickmarkleft(Tmp, Formatting(Tmp,digits,nsmall)) + } +} + +VtickLV<- function(...) +{ + VtickmarkleftV(...) +} + +Insertcom<- function(CmdM,Npos,Str) +{ + if(is.matrix(CmdM)){ + Cmd<- CmdM + } + else{ + C<- paste("Cmd<- ",CmdM) + eval(parse(text=C)) + } + Out<- Cmd[Looprange(1,Npos-1),] + Out<- c(Out,Str) + Tmp<- Cmd[Looprange(Npos,nrow(Cmd)),] + Out<- c(Out,Tmp) + Out<- matrix(Out) + if(!is.matrix(CmdM)){ + C<- paste(CmdM,"<<- Out") + eval(parse(text=C)) + } + return(Out) +} + +Replacecom<- function(CmdM,Npos,Str) +{ + if(is.matrix(CmdM)){ + Cmd<- CmdM + } + else{ + C<- paste("Cmd<- ",CmdM) + eval(parse(text=C)) + } + Out<- Cmd[Looprange(1,Npos-1),] + Out<- c(Out,Str) + Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] + Out<- c(Out,Tmp) + Out<- matrix(Out) + if(!is.matrix(CmdM)){ + C<- paste(CmdM,"<<- Out") + eval(parse(text=C)) + } + return(Out) +} + +Deletecom<- function(CmdM,Npos) +{ + if(is.matrix(CmdM)){ + Cmd<- CmdM + } + else{ + C<- paste("Cmd<- ",CmdM) + eval(parse(text=C)) + } + Out<- Cmd[Looprange(1,Npos-1),] + Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] + Out<- c(Out,Tmp) + Out<- matrix(Out) + if(!is.matrix(CmdM)){ + C<- paste(CmdM,"<<- Out") + eval(parse(text=C)) + } + return(Out) +} + +Maketexfile<- function(commands="",texfile="") +{ + Openfile(texfile) + Execmd(commands) + Closefile() +} + +Formatting<- function(X,D=2,N=2) +{ + if(D>0){ + Xs <- format(X,digits=D,nsmall=N) + } + else{ + Xs<- as.character(X) + } + return(Xs) +} + +################################ + +Boxplotdata1 <-function(DataF1,CenterX,Width,...) +{ + Xr <- Width + Temp <- boxplot(DataF1[1],plot=FALSE) + Stats <- Temp$stats + rownames(Stats) <- c("Lhige","Q1","Q2","Q3","Uhige") + Out <- Temp$out + Lhige <- Stats["Lhige",1] + Uhige <- Stats["Uhige",1] + Q1 <- Stats["Q1",1] + Q2 <- Stats["Q2",1] + Q3 <- Stats["Q3",1] + CenterY <- (Q1+Q3)/2 + C <- c(CenterX,CenterY) + V <- c(0,(Q3-Q1)/2) + G1 <- Framedata(C,Xr/2,V[2]) # box + Temp1 <- c(0,Q1-Lhige) + Temp2 <- c(0,Uhige-Q3) + G2 <- Listplot(C-V,C-V-Temp1) # + G3 <- Listplot(C+V,C+V+Temp2) # + Temp3 <- c(Xr/4,0) + G4 <- Listplot(C-V-Temp1-Temp3,C-V-Temp1+Temp3) # + G5 <- Listplot(C+V+Temp2-Temp3,C+V+Temp2+Temp3) # + Temp4 <- c(0,Q3-Q2) + Temp5 <- c(Xr/2,0) + G6 <- Listplot(C+V-Temp4-Temp5,C+V-Temp4+Temp5) # + G7 <- list() + for(j in Looprange(1,length(Out))){ + G7 <- c(G7,list(c(CenterX, Out[j]))) + } + G7 <- G7[order(Out,decreasing=TRUE)] + list(median=G6,box=G1,uwhisker=G2,lwhisker=G3,lwp=G4,uwp=G5,outliers=G7) +} + +Boxplotdata2 <- function(Data,Ratio, ...) +{ + DataF<- Flattenlist(Data) # 11.07.21(from) + ymin<- Inf + ymax<- -Inf + for(J in 1:length(DataF)){ + Tmp<- DataF[[J]] + ymin<- min(ymin, min(Tmp)) + ymax<- max(ymax,max(Tmp)) + } # 11.07.21(upto) + dy <- ymax-ymin + Setwindow(c(0,XMAX-XMIN),c(ymin-0.1*dy,ymax+0.1*dy)) + R1<- (YMAX-YMIN)/(XMAX-XMIN) + R<- Ratio/R1 + Setscaling(R) + Delta <- XMAX/length(DataF) + W <- 0.6*Delta + PdL <- list() + for(i in 1:length(DataF)){ # 11.07.21 + X <- (0.5+i-1)*Delta + G <- Boxplotdata1(DataF[i],X,W,...) + PdL <- c(PdL,list(G)) + } + G <- Framedata() + Tmp<- list(frame=G) + PdL <-c(PdL,list(Tmp)) + Epsi <-0 + Setwindow(c(XMIN-Epsi,XMAX+Epsi),c(YMIN-Epsi,YMAX+Epsi)) + return(PdL) +} + +Drwboxframe<-function(BoxDataL) +{ + Setorigin(c(XMIN,YMIN)) + Tmp<- Unscaling(c(0.2,0.2)) + Setwindow(c(XMIN-0.2,XMAX),c(YMIN-Tmp[2],YMAX)) + Hako<- BoxDataL$plotdata + title<- BoxDataL$title + cap<- BoxDataL$cap + ylab<- BoxDataL$ylab + if(mode(title)!="list") title<- list(title) + if(mode(cap)!="list") cap<- list(cap) + if(mode(ylab)!="list") ylab<- list(ylab) + if(length(title)==0) title<- list("") + if(length(title)==1) title<- c(title, list("n")) + if(length(title)==2) title<- c(title, list("")) + if(length(cap)==0) cap<- list("") + if(length(cap)==1) cap<- c(cap, list("n"),0) # 11.11.27 + if(length(cap)==2) cap<- c(cap, 0) # 11.11.27 + if(length(ylab)==0) ylab<- list("") + if(length(ylab)==1) ylab <- c(ylab, list("n")) + if(length(ylab)==2) ylab<- c(ylab, list("")) + Temp <- Hako[[length(Hako)]] + Drwline(Temp$frame) + Fontsize(cap[[2]]) + for(i in Looprange(1,length(Hako)-1)){ + Temp <- Hako[[i]] + attach(Temp) + Dashline(uwhisker,lwhisker) + Drwline(median,2) + Drwline(box,lwp,uwp) + Drwpt(outliers,0) + X <- uwhisker[1,1] + detach(Temp) + Htickmarklower(X) + if(nchar(cap[[1]])<1) next # 2011.03.08 + if(length(cap)==2 || cap[[3]]==0){ + pos<- 1 + if(length(cap)>=4) pos<- cap[[4]] + Tmp<- paste("s",as.character(pos),sep="") + Letter(c(X,YMIN),Tmp, Op(i,cap[[1]])) + } + else{ + rotate<- cap[[3]] + if(length(cap)==3){ + pos<- 0 + } + else{ + pos<- cap[[4]] + } + Temp1 <- rotate*pi/180 + Temp <- c(cos(Temp1),sin(Temp1)) + Letterrot(c(X,YMIN-pos),Temp,Op(i,cap[[1]])) + } + } + if(nchar(ylab[[1]])>0){ + Fontsize(ylab[[2]]) + Tmp1<- ylab[[1]] + Tmp3<- ylab[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Letter(c(XMIN, YMAX),"n2",Tmp1) + Fontsize("n") + } + if(nchar(title[[1]])>0){ + Fontsize(title[[2]]) + Tmp1<- title[[1]] + Tmp3<- title[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) + } + Fontsize("n") +} + +Drwboxplot<- function(dataf,var,size, + title=list(""), cap=list(colnames(dataf)), + ylab=list(""), ptsize=5,plot=TRUE,...) + #Return : title,cap,ylab,commands,plotdata,info +{ + Tmp <- boxplot(dataf, plot=FALSE, ...) + Stats <- Tmp$stats + DataF<- Flattenlist(dataf) # 11.07.21(from) + ymin<- Inf + ymax<- -Inf + for(J in 1:length(DataF)){ + Tmp<- DataF[[J]] + ymin<- min(ymin, min(Tmp)) + ymax<- max(ymax,max(Tmp)) + } # 11.07.21(upto) + Hako<- Boxplotdata2(dataf, size[2]/size[1], ...) + if(plot){ + Windisp(Hako) + } + Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) + unit<- paste(Tmp,"cm",sep="") + Setunitlen(unit) + Exstr<- c( + "","", + paste("Beginpicture(","'",unit,"')",sep=""), + paste("Setpt(",as.character(ptsize),")",sep=""), + "","", + paste("Drwboxframe(",var,")",sep=""), + paste("VtickLV(c(",as.character(ymin),",", as.character(ymax),"),0,0)",sep=""), + "","","","", + "Setpt(1)", + "Endpicture(0)" + ) + Exstr<- matrix(Exstr) + Xpos<- c() + for(i in Looprange(1,length(Hako)-1)){ + Temp <- Hako[[i]] + Temp1 <- Temp[[5]] + Xpos <- c(Xpos,Temp1[1,1]) + } + Info<- list(stats=Stats,window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2),xpos=Xpos) + Tmp<- paste(var,"<<- ", + "list(title=title,cap=cap,ylab=ylab,", + "commands=Exstr,plotdata=Hako,info=Info)",sep="") + eval(parse(text=Tmp)) +} + + +########################################### + +Histplotdata <- function(DataV,Ratio,freq=TRUE,densplot=FALSE,...) +# 10.12.07 freq +{ + Temp <- hist(DataV,plot=FALSE,...) + Breaks <- Temp$breaks + Counts <- Temp$counts + Density <- Temp$density + Mids <- Temp$mids + if(!freq){ + Data<- Density + } + else{ + Data<- Counts + } + Ghist <- list() + for(i in Looprange(1,length(Breaks)-1)){ + Tmp1 <- c(Breaks[i],Breaks[i+1]) + Tmp2 <- c(0,Data[i]) + G1 <- Framedata(Tmp1,Tmp2) #bar + Ghist <- c(Ghist,list(G1)) + } + Bin <- Breaks[2]-Breaks[1] + Eps <- 0.7*Bin # 0.7 times Bin + Temp1 <- c(min(Breaks)-Eps,max(Breaks)+Eps) # Put Eps at both sides + Temp2 <- c(0,max(Data)*1.02) + Setwindow(Temp1,Temp2) + Setorigin(c(Temp1[1],0)) + R1<- (YMAX-YMIN)/(XMAX-XMIN) + R<- Ratio/R1 + Setscaling(R) + VEps <- 0.05*(XMAX-XMIN)/5 + Temp1<- Temp1-c(VEps,0) + Temp2<- Temp2-1/R*c(VEps,0) + Setwindow(Temp1,Temp2) + Fpt <- c(Mids[1]-Bin,0) + Lpt <- c(Mids[length(Mids)]+Bin,0) + Fp <- matrix(Fpt,nrow=1) + for(i in Looprange(1,length(Mids))){ + Tmp <- c(Mids[i],Data[i]) + Fp <- rbind(Fp,Tmp) + } + Fp <- rbind(Fp,Lpt) + rownames(Fp)<- c(1:nrow(Fp)) + if(densplot){ + Temp <- density(DataV) + X <- matrix(Temp$x) + Y <- matrix(Temp$y) + Gdens <- cbind(X,Y) + } + else{ + Gdens <- list() + } + list(plotdata=list(histplot=Ghist,fpplot=list(Fp),densityplot=list(Gdens)), + breaks=Breaks,counts=Counts,density=Density,mids=Mids) +} + +Drwhistframe<-function(HistDataL) +{ + title<- HistDataL$title + xlab<- HistDataL$xlab + ylab<- HistDataL$ylab + if(mode(title)!="list") title<- list(title) + if(mode(xlab)!="list") cap<- list(xlab) + if(mode(ylab)!="list") cap<- list(ylab) + if(length(title)==0) title<- list("") + if(length(title)==1) title<- c(title, list("n")) + if(length(title)==2) title<- c(title, list("")) + if(length(xlab)==0) xlab<- list("") + if(length(xlab)==1) xlab<- c(xlab, list("n")) + if(length(xlab)==2) xlab<- c(xlab, list("")) + if(length(xlab)==3) xlab<- c(xlab, list(8)) + if(length(ylab)==0) ylab<- list("") + if(length(ylab)==1) ylab<- c(ylab, list("n")) + if(length(ylab)==2) ylab<- c(ylab, list("")) + if(nchar(title[[1]])>0){ + Fontsize(title[[2]]) + Tmp1<- title[[1]] + Tmp3<- title[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) + Fontsize("n") + } + if(nchar(xlab[[1]])>0){ + Fontsize(xlab[[2]]) + Tmp1<- xlab[[1]] + Tmp3<- xlab[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Tmp4<- paste("s",as.character(xlab[[4]]),sep="") + Letter(c((XMIN+XMAX)/2,YMIN),Tmp4,Tmp1) + Fontsize("n") + } + if(nchar(ylab[[1]])>0){ + Fontsize(ylab[[2]]) + Tmp1<- ylab[[1]] + Tmp3<- ylab[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Tmp<- Setorigin() + Letter(c(Tmp[1], YMAX),"n2",Tmp1) + Fontsize("n") + } + + Setax(2," ") + Setax(4," ") + Setax(6," ") +} + +Drwhistplot<- function(datav,var,size,freq=TRUE, + title=list(""), xlab=list(""), ylab=list(""), + plot=TRUE,densplot=FALSE,fpplot=TRUE,...) + #Output : title,xlab,ylab,commands,plotdata,info +{ + H <- Histplotdata(datav, size[2]/size[1], freq=freq,densplot=densplot,...) + Pd<- H$plotdata + Ghist <- list(histplot=Pd$histplot,densityplot=Pd$densityplot) # 10.12.07 + if(fpplot){ + Ghist<- c(Ghist,list(fpplot=Pd$fpplot)) + } + if(plot){ + Windisp(Ghist) + } + Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) + unit<- paste(Tmp,"cm",sep="") + Setunitlen(unit) + Infostr<- paste(var,"$info",sep="") + Brkstr<- paste(Infostr,"$breaks",sep="") + Midstr<- paste(Infostr,"$mids",sep="") + if(!freq){ + Digits<- ",2,2" + Denstr<- paste(Infostr,"$density",sep="") + } + else{ + Digits<- ",0,0" + Denstr<- paste(Infostr,"$counts",sep="") + } + + if(fpplot) Prefp<- "" else Prefp<- "#" + Exstr<- c( + "","", + paste("Beginpicture(","'",unit,"')",sep=""), + "","", + paste("Drwhistframe(",var,")",sep=""), + paste("HtickLV(",Midstr,",1,1)",sep=""), + paste("VtickLV(max(",Denstr,")",Digits,")",sep=""), + paste("Drwline(",var,"[['plotdata']]","$histplot)",sep=""), + paste(Prefp,"Dashline(",var,"[['plotdata']]","$fpplot)",sep=""), + paste("#Drwline(",var,"[['plotdata']]","$densityplot,2)",sep=""), + "","","","", + "Endpicture(1)" + ) + Exstr<- matrix(Exstr) + Info<- list(breaks=H$breaks,counts=H$counts,density=H$density,mids=H$mids, + window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2)) + Tmp<- paste(var,"<<- ", + "list(title=title,xlab=xlab,ylab=ylab,", + "commands=Exstr,plotdata=Ghist,info=Info)",sep="") + eval(parse(text=Tmp)) +} + +########################## +#17.09.30 + +Bezierpt<- function(t,Ptlist,Ctrlist){ + if(length(Ptlist)==6){ + P0=Ptlist[1:3] + P3=Ptlist[4:6] + P1=Ctrlist[1:3] + if(length(Ctrlist)==3){ + P2=P3 + flg3=0 + }else{ + P2=Ctrlist[4:6] + flg3=1 + } + }else{ + P0=Ptlist[1:2] + P3=Ptlist[3:4] + P1=Ctrlist[1:2] + if(length(Ctrlist)==2){ + P2=P3 + flg3=0 + }else{ + P2=Ctrlist[3:4] + flg3=1 + } + } + P4=(1-t)*P0+t*P1 + P5=(1-t)*P1+t*P2 + P6=(1-t)*P2+t*P3 + P7=(1-t)*P4+t*P5 + P8=(1-t)*P5+t*P6 + P9=(1-t)*P7+t*P8 + if(flg3==0){ + Out=P7 + }else{ + Out=P9 + } + return(Out) +} + +Bezier<- function(...){ + varargin<- list(...) + Nargs=length(varargin) + Ptlist=varargin[[1]] + Ctrlist=varargin[[2]] + Num=10 + for(J in Looprange(3,Nargs)){ + Tmp=varargin[[J]] + K=strsplit(Tmp,'=',fixe=TRUE) + K=K[[1]] + Tmp1=substring(K[1],1,1) + Lhs=toupper(Tmp1) + if(Lhs=="N"){ + Num=eval(parse(text=K[2])) + } + } + if(length(Num)==1){ + Num=rep(Num,length(Ctrlist)) #17.10.08 + } + Out=c() + for(ii in Looprange(1,length(Ctrlist))){ + Tmp1=c(Ptlist[[ii]],Ptlist[[ii+1]]) + Tmp2=Ctrlist[[ii]] + if(ii==1){ + St=0 + }else{ + St=1 + } + for(J in Looprange(St,Num[ii])){ + Tmp=Bezierpt(J/Num[ii],Tmp1,Tmp2) + Out=Appendrow(Out,Tmp) + } + } + return(Out) +} + +####################### +# 17.10.02 + +Connectseg<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Pdata=varargin[[1]] + Eps=10^(-4) + if(Nargs>=2){ + Eps=varargin[[2]] + } + if(is.matrix(Pdata)){ + Din=Dataindex(Pdata) + tmp1=list() + for(J in 1:nrow(Din)){ + tmp=Pdata[Din[J,1]:Din[J,2],] + tmp1=c(tmp1,list(tmp)) + } + Pdata=tmp1 + } + PlotL=list(Op(1,Pdata)) + VI=Looprange(2,length(Pdata)) + while(length(VI)>0){ + Qd=Op(Length(PlotL),PlotL) + Ah=Op(1,Qd); Ao=Op(Length(Qd),Qd) + Flg=0 + for(J in 1:length(VI)){ + Tmp1=Op(VI[J],Pdata) + P=Op(1,Tmp1); Q=Op(Length(Tmp1),Tmp1) + if(Norm(P-Ao)0){ + Qd=Appendrow(Qd,Tmp) + } + PlotL[[length(PlotL)]]=Qd + VI=VI[-J] + Flg=1 + break + } + if(Norm(Q-Ao)=4){ + Tmp=Op(4,MS) + if(Length(Tmp)>1){ #18.02.09 + Mdv=Op(1,Tmp) + Ndv=Op(2,Tmp) + }else{ + Mdv=Tmp + if(Nargs==4){ + Ndv=Mdv + }else{ + Tmp1=Op(5,MS) + if((is.numeric(Tmp1))&&(length(Tmp1)==1)){ + Ndv=Tmp1 + }else{ + Ndv=Mdv + } + } + } + } + X1=Xrange[1]; X2=Xrange[2] + Y1=Yrange[1]; Y2=Yrange[2] + Dx=(X2-X1)/Mdv + Dy=(Y2-Y1)/Ndv + Xval=c() + Tmp=X1 + for(ii in 1:(Mdv+1)){ + Tmp=X1+(ii-1)*Dx + Xval=c(Xval,Tmp) + } + Yval=c() + Tmp=Y1 + for(jj in 1:(Ndv+1)){ + Tmp=Y1+(jj-1)*Dy + Yval=c(Yval,Tmp) + } + Zval=matrix(nrow=Ndv+1,ncol=Mdv+1) + I=1 + for(y in Yval){ + J=1 + for(x in Xval){ + Zval[I,J]=eval(parse(text=Fstr)) + J=J+1 + } + I=I+1 + } + return(list(Zval,Xval,Yval)) +} + +Implicitplot<- function(...){ + varargin=list(...) + Eps0=10^(-4) + Nargs=length(varargin) + Fstr=varargin[[1]] + if(is.list(Fstr)){ + MS=Fstr + Tmp=Makevaltable(MS) + Zval=Tmp[[1]]; Xval=Tmp[[2]]; Yval=Tmp[[3]] + }else if(is.character(Fstr)){ +# MS=list() +# for(I in 1:Nargs){ +# MS=c(MS,varargin[I]) +# } +# Tmp=Makevaltable(MS) + Tmp=Makevaltable(varargin) #18.02.24 + Zval=Tmp[[1]]; Xval=Tmp[[2]]; Yval=Tmp[[3]] + }else{ + Zval=varargin[[1]] + Xval=varargin[[2]] + Yval=varargin[[3]] + } + Out=c() + for(J in Looprange(1,length(Yval)-1)){ + for(I in Looprange(1,length(Xval)-1)){ + a1=Xval[I]; b1=Yval[J]; c1=Zval[J,I] + a2=Xval[I+1]; b2=Yval[J]; c2=Zval[J,I+1] + a3=Xval[I+1]; b3=Yval[J+1]; c3=Zval[J+1,I+1] + a4=Xval[I];b4=Yval[J+1];c4=Zval[J+1,I] + PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) + VL=c(c1,c2,c3,c4,c1) + QL=c() + for(K in 1:4){ + if(abs(VL[K])<=Eps0){ + QL=Appendrow(QL,PL[K,]) + }else if(VL[K]>Eps0){ + if(VL[K+1]< -Eps0){ + Tmp=1/(VL[K]-VL[K+1])*(-VL[K+1]*PL[K,]+VL[K]*PL[K+1,]) + QL=Appendrow(QL,Tmp) + } + }else{ + if(VL[K+1]>Eps0){ + Tmp=1/(-VL[K]+VL[K+1])*(VL[K+1]*PL[K,]-VL[K]*PL[K+1,]) + QL=Appendrow(QL,Tmp) + } + } + } + if(Length(QL)==2){ + Out=Appendrow(Out,c(Inf,Inf)) + Out=Appendrow(Out,QL) + } + } + } + Out=Out[2:nrow(Out),] + if(Length(Out)>0){ + Out=Connectseg(Out) + }else{ + Out=c() + } + return(Out) +} + +######################### +# 17.10.06 + +Deqdata=function(deq,rng,initt,initf,Num){ + Eps=10^(-3) + inf=10^3 + tmp=strsplit(deq,"=")[[1]] + tmp1=gsub("`","",tmp[1],fixed=TRUE) + tmp1=substring(tmp1,3,nchar(tmp1)-1) + Xname=strsplit(tmp1,",")[[1]] + func=tmp[2] + for(J in 1:(length(Xname))){ + tmp1=paste("X[",as.character(J),"]",sep="") + func=gsub(Xname[J],tmp1,func,fixed=TRUE) + } + tmp=strsplit(rng,"=")[[1]] + tname=tmp[1] + tmp=eval(parse(text=tmp[2])) + t1=tmp[1] + t2=tmp[2] + tmp=paste("function(",tname,",X){",func,"}",sep="") + funP=eval(parse(text=tmp)) + tmp=paste("function(",tname,",X){-",func,"}",sep="") + funN=eval(parse(text=tmp)) + dt=(t2-t1)/Num + tt=initt + X0=initf + pdL=c(tt,X0) + for(J in Looprange(1,floor((t2-initt)/dt))){ + kl1=dt*funP(tt,X0) + kl2=dt*funP(tt+dt/2,X0+kl1/2) + kl3=dt*funP(tt+dt/2,X0+kl2/2) + kl4=dt*funP(tt+dt,X0+kl3) + X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 + tt=initt+J*dt + tmp=c(tt,X0) + if(Norm(tmp)>inf){break} + pdL=Appendrow(pdL,tmp) + } + tt=initt + X0=initf + for(J in Looprange(1,floor((initt-t1)/dt))){ + kl1=dt*funN(tt,X0) + kl2=dt*funN(tt+dt/2,X0+kl1/2) + kl3=dt*funN(tt+dt/2,X0+kl2/2) + kl4=dt*funN(tt+dt,X0+kl3) + X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 + tt=initt-J*dt + tmp=c(tt,X0) + if(Norm(tmp)>inf){break} + pdL=Appendrow(tmp,pdL) + } + pdL +} + +Deqplot=function(...){ + varargin=list(...) + deq=varargin[[1]] + rng=varargin[[2]] + initt=varargin[[3]] + initf=varargin[[4]] + Num=50 + Sel=c(1,2) + for(J in Looprange(5,length(varargin))){ + tmp1=varargin[[J]] + if(is.character(tmp1)){ + tmp=strsplit(tmp1,"=")[[1]] + Num=eval(parse(text=tmp[2])) + }else{ + SeL=tmp1 + } + } + pdL=Deqdata(deq,rng,initt,initf,Num) + pdL=pdL[,SeL] +} + + +############## obj ############### + +Openobj<- function(Fnm){ + OBJFMT<<- "%7.4f" + NPOINT<<- 0 + NNORM<<- 0 + OBJSCALE<<- 1 + OBJFIGNO<<- 0 + OBJJOIN<<- 0 + Wfile<<- Fnm + Tmp=grep(".obj",Fnm,fixed=TRUE) + if(length(Tmp)==0){ + if(nchar(Fnm)>0){ + Wfile<<- paste(Fnm,".obj",sep="") + } + } + cat("",file=Wfile,sep="") + Wfile +} + +Closeobj<- function(){ + Wfile="" +} + +Writeobjpoint<- function(P){ + X=sprintf(OBJFMT,P[1]*OBJSCALE) + Y=sprintf(OBJFMT,P[2]*OBJSCALE) + Z=sprintf(OBJFMT,P[3]*OBJSCALE) + Str=paste("v",X,Y,Z,sep=" ") + Printobjstr(Str) + NPOINT<<- NPOINT+1 + return(NPOINT) +} + +Printobjstr<- function(Str){ + cat(Str,"\n",sep="",file=Wfile,append=TRUE) +} + +Objname<- function(){ + if(OBJJOIN==0){ + OBJFIGNO<<- OBJFIGNO+1 + Gname=paste("ketfig",as.character(OBJFIGNO),sep="") + Printobjstr(paste("# ",Gname,sep="")) + Printobjstr(paste("g ",Gname,sep="")) + } +} + +Objjoin<- function(...){ + varargin=list() + if(length(varargin)>0){ + OBJJOIN<<- abs(sign(varargin[[1]])) + } + OBJJOIN +} + +Objsurf<- function(...){ #17.12.18 + Args<- list(...) + Nargs<- length(Args) + Sel=Args[[Nargs]]; Nargs=Nargs-1 + Rf=Args[[1]] + N=2 + Mg=0; Ng=0 + if(is.numeric(Args[[N]])){ + if(length(Args[[N]])>2){ + U=Args[[N]] + Mg=length(U)-1 + N=N+1 + }else if(length(Args[[N]])==2){ + Intab=Args[[N]] + Ag=Intab[1]; Bg=Intab[2] + N=N+1 + }else{ + Ag=Args[N]; Bg=Args[N+1] + N=N+2 + } + }else{ + Tmp0=Args[[N]] + Tmp=grep("=",Tmp0,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1=strsplit(Tmp0,"=") + Tmp0=Tmp1[[1]][2] + } + Intab=eval(parse(text=Tmp0)) + Ag=Intab[1]; Bg=Intab[2] + N=N+1 + } + if(is.numeric(Args[[N]])){ + if(length(Args[[N]])>2){ + V=Args[[N]] + Ng=length(V)-1 + N=N+1 + }else if(length(Args[[N]])==2){ + Intab=Args[[N]] + Cg=Intab[1]; Dg=Intab[2] + N=N+1 + }else{ + Cg=Args[[N]]; Dg=Args[[N+1]] + N=N+2 + } + }else{ # the case of is.character(Args[[N]]) + Tmp0=Args[[N]] + Tmp=grep("=",Tmp0,fixed=TRUE) + if(length(Tmp)>0){ + Tmp2=strsplit(Tmp0,"=") + Tmp0=Tmp2[[1]][2] + } + Intab=eval(parse(text=Tmp0)) + Cg=Intab[1]; Dg=Intab[2] + N=N+1 + } + if(Mg==0){ + Mg=Args[[N]] + N=N+1 + U=c() + for(J in Looprange(1,Mg+1)){ + U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) + } + } + if(Ng==0){ + Ng=Args[[N]] + V=c() + for(K in Looprange(1,Ng+1)){ + V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) + } + } + Objname() + PL=list() + for(J in Looprange(1,Mg+1)){ + for(K in Looprange(1,Ng+1)){ + P=Rf(U[J],V[K]) + Np=Writeobjpoint(P) + PL=c(PL,list(c(P,Np))) + } + } + Idx=1+(Ng+1)*(0:Mg) + Pus=PL[Idx] + Idx=(Ng+1)*(1:(Mg+1)) + Pue=PL[Idx] + Idx=1:(Ng+1) + Pvs=PL[Idx] + Idx=((Ng+1)*Mg+1):((Ng+1)*(Mg+1)) + Pve=PL[Idx] + Printobjstr("vt 0 0") + Printobjstr("vt 1 0") + Printobjstr("vt 1 1") + Printobjstr("vt 0 1") + for(J in Looprange(1,Mg)){ + for(K in Looprange(1,Ng)){ + P1=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K]])) + P2=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K]])) + P3=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K+1]])) + P4=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K+1]])) + N1=""; N2=""; N3=""; N4="" + if(Sel=="+"){ + Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") + Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") + }else{ + Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") + Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") + } + Printobjstr(Str) + } + } + list(U,V,Pus,Pue,Pvs,Pve) +} + +Objthicksurf<- function(...){ + Args=list(...) + Nargs=length(Args) + Sel=Args[[Nargs]]; Nargs=Nargs-1 + Selsurf=substring(Sel,1,1) + Selside=c("0","0","0","0") + Tmp=grep("w",Sel,fixed=TRUE) + if(length(Tmp)>0){ + Selside[1]="w" + } + Tmp=grep("e",Sel,fixed=TRUE) + if(length(Tmp)>0){ + Selside[2]="e" + } + Tmp=grep("s",Sel,fixed=TRUE) + if(length(Tmp)>0){ + Selside[3]="s" + } + Tmp=grep("n",Sel,fixed=TRUE) + if(length(Tmp)>0){ + Selside[4]="n" + } + Nfth=Args[[Nargs-2]] + Thick1=Args[[Nargs-1]] + Thick2=Args[[Nargs]] + Nargs=Nargs-3 + Rfth=Args[[1]] + N=2 + Mg=0; Ng=0 + if(is.numeric(Args[[N]])){ + if(length(Args[[N]])>2){ + U=Args[[N]] + Mg=length(U)-1 + N=N+1 + }else if(length(Args[[N]])==2){ + Intab=Args[[N]] + Ag=Intab[1]; Bg=Intab[2] + N=N+1 + }else{ + Ag=Args[[N]]; Bg=Args[[N+1]] + N=N+2 + } + }else{ + Tmp0=Args[[N]] + Tmp=strsplit(Tmp0,"=",fixe=TRUE) + if(length(Tmp)>0){ + Tmp0=Tmp[[1]][2] + } + Intab=eval(parse(text=Tmp0)) + Ag=Intab[1]; Bg=Intab[2] + N=N+1 + } + if(is.numeric(Args[[N]])){ + if(length(Args[[N]])>2){ + V=Args[[N]] + Ng=length(V)-1 + N=N+1 + }else if(length(Args[[N]])==2){ + Intab=Args[[N]] + Cg=Intab[1]; Dg=Intab[2] + N=N+1 + }else{ + Cg=Args[[N]]; Dg=Args[[N+1]] + N=N+2 + } + }else{ + Tmp0=Args[[N]] + Tmp=strsplit(Tmp0,"=",fixed=TRUE) + if(length(Tmp)>0){ + Tmp0=Tmp[[1]][2] + } + Intab=eval(parse(text=Tmp0)) + Cg=Intab[1]; Dg=Intab[2] + N=N+1 + } + if(Mg==0){ + Mg=Args[[N]] + N=N+1 + U=c() + for(J in Looprange(1,Mg+1)){ + U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) + } + } + if(Ng==0){ + Ng=Args[[N]] + V=c() + for(K in Looprange(1,Ng+1)){ + V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) + } + } + Objname() + Join=OBJJOIN + OBJJOIN<<- 1 + F1=function(u,v){ + Rfth(u,v)+Thick1*Nfth(u,v) + } + F2=function(u,v){ + Rfth(u,v)+Thick2*Nfth(u,v) + } + Dt1=Objsurf(F1,U,V,Selsurf) + if(Selsurf=="+"){ + Tmp="-" + }else{ + Tmp="+" + } + Dt2=Objsurf(F2,U,V,Tmp); + Out=list(Dt1,Dt2); + + if(Selside[1]!="0"){ + Dt=Objrecs(Op(3,Dt1),Op(3,Dt2),Selside[1]) + Out=c(Out,list(Dt)) + } + if(Selside[2]!="0"){ + Dt=Objrecs(Op(4,Dt1),Op(4,Dt2),Selside[2]) + Out=c(Out,list(Dt)) + } + if(Selside[3]!="0"){ + Dt=Objrecs(Op(5,Dt1),Op(5,Dt2),Selside[3]) + Out=c(Out,list(Dt)) + } + if(Selside[4]!="0"){ + Dt=Objrecs(Op(6,Dt1),Op(6,Dt2),Selside[4]) + Out=c(Out,list(Dt)) + } + OBJJOIN<<- Join +} + +Objrecs<- function(...){ + Eps=10^(-6) + Args=list(...) + Nargs=length(Args) + Tmp=Args[[1]] + PtL=Flattenlist(Tmp) + for(J in Looprange(1,length(PtL))){ #17.12.23from + Tmp=PtL[[J]] + if(!is.matrix(Tmp)){ + PtL[[J]]=matrix(Tmp,nrow=1) + } + } #17.12.23upto + PL1=list() + for(J in Looprange(1,length(PtL))){ + Tmp=PtL[[J]] + for(K in Looprange(1,nrow(Tmp))){ + PL1=c(PL1,list(Tmp[K,])) + } + } + Sel=Args[[Nargs]]; Nargs=Nargs-1 + Objname() + for(J in Looprange(1,length(PL1))){ + P=PL1[[J]] + if((length(P)<4) || (P[4]==0)){ + Np=Writeobjpoint(P) + PL1[[J]]=c(P[1:3],Np) + } + } + Tmp=Args[[2]] + if((is.numeric(Tmp)) && (length(Tmp)==1)){ + Drv=Tmp + Len=Norm(Drv) + PL2=list() + for(J in Looprange(1,length(PL1))){ + Tmp=PL1[[J]] + P=Tmp[1:3]+Drv + Np=Writeobjpoint(P) + PL2=c(PL2,list(c(P[1:3],Np))) + if(JEps){ + Tmp1=Crossprod(Drv,Vec) + Tmp2=Crossprod(Tmp1,Vec) + Tmp3=Dotprod(Tmp2,Drv) + if(Tmp3<-Eps){ + Tmp2=-Tmp2 + } + Drv=Len/Norm(Tmp2)*Tmp2 + } + } + } + }else{ + PtL=Flattenlist(Tmp) + for(J in Looprange(1,length(PtL))){ #17.12.23from + Tmp=PtL[[J]] + if(!is.matrix(Tmp)){ + PtL[[J]]=matrix(Tmp,nrow=1) + } + } #17.12.23upto + PL2=list() + for(J in Looprange(1,length(PtL))){ + Tmp=PtL[[J]] + for(K in Looprange(1,nrow(Tmp))){ + PL2=c(PL2,list(Tmp[K,])) + } + } + for(J in Looprange(1,length(PL2))){ + P=PL2[[J]] + if((length(P)<4) || (P[4]==0)){ + Np=Writeobjpoint(P) + PL2[[J]]=c(P[1:3],Np) + } + } + } + Printobjstr("vt 0 0") + Printobjstr("vt 1 0") + Printobjstr("vt 1 1") + Printobjstr("vt 0 1") + for(J in Looprange(2,length(PL1))){ + P1=sprintf("%1d",Op(4,PL1[[J-1]])) + P2=sprintf("%1d",Op(4,PL2[[J-1]])) + P3=sprintf("%1d",Op(4,PL2[[J]])) + P4=sprintf("%1d",Op(4,PL1[[J]])) + N1=""; N2=""; N3=""; N4="" + if(Sel=="+"){ + Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") + Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") + }else{ + Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") + Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") + } + Printobjstr(Str) + } + list(PL1,PL2) +} + +Objpolygon<- function(...){ + Eps=10^(-6) + Args=list(...) + Nargs=length(Args) + Tmp=Args[[1]] + PtL=Flattenlist(Tmp) + for(J in Looprange(1,length(PtL))){ #17.12.23from + Tmp=PtL[[J]] + if(!is.matrix(Tmp)){ + PtL[[J]]=matrix(Tmp,nrow=1) + } + } #17.12.23upto + PL=list() + for(J in Looprange(1,length(PtL))){ + Tmp=PtL[[J]] + for(K in Looprange(1,nrow(Tmp))){ + PL=c(PL,list(Tmp[K,])) + } + } + Sel=Args[[Nargs]]; Nargs=Nargs-1 + Objname() + for(J in Looprange(1,length(PL))){ + P=PL[[J]] + if((length(P)<4) || (P(4)==0)){ + Np=Writeobjpoint(P) + PL[[J]]=c(P[1:3],Np) + } + } + if(Nargs==1){ + Tmp=PL[[1]] + Cen=Tmp[1:3] + Nc=Tmp[4] + }else{ + Tmp=Args[[2]] + if(length(Tmp)==1){ + Tmp1=PL[[Tmp]] + Cen=Tmp1[1:3] + Nc=Tmp[4] + }else{ + Cen=Tmp + Nc=Writeobjpoint(Cen) + } + } + for(J in Looprange(1,length(PL))){ + if(J=2){ + Sz=Args[[2]] + } + if(Nargs>=3){ + Np=Args[[3]] + } + Assign("Sz",Sz) + if(Pstr=="xy"){ + Vz=c(0,0,1) + Fs=Assign("c(Sz*cos(t),Sz*sin(t),0)") + } + if(Pstr=="yz"){ + Vz=c(1,0,0) + Fs=Assign("c(0,Sz*cos(t),Sz*sin(t))") + } + if(Pstr=="zx"){ + Vz=c(0,1,0) + Fs=Assign("c(Sz*sin(t),0,Sz*cos(t))") + } + Gc0=Spacecurve(Fs,"t=c(0,2*pi)",paste("Num=",as.character(Np),sep="")) + P=PL[[1]]; Q=PL[[2]]; R=PL[[length(PL)-1]] + PQ1=Q-P + if(!Closed){ + PQ2=PQ1 + }else{ + PQ2=P-R + } + Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2) + Vp1=Vp/Norm(Vp) + Theta=acos(min(Dotprod(Vz,Vp1),1)); + Vj=Crossprod(Vz,Vp1) + if(Norm(Vj)Eps0){ + dt=Crossprod(tmp3,tmp2) + ds=Crossprod(tmp1,tmp3) + t=dt/d + s=ds/d + pt=p1+v1*t + out=list(pt,t,s) + }else{ + tmp1=Crossprod(p2-p1,v1)/Norm(v1) + out=list(abs(tmp1)) + } + return(out) +} + +Intersectseg<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Eps0=10^(-4) + Eps1=0.01 + seg1=varargin[[1]] + seg2=varargin[[2]] + if(Nargs>2){Eps1=varargin[[3]]} + p1=Op(1,seg1); q1=Op(2,seg1) + p2=Op(1,seg2); q2=Op(2,seg2) + if((Norm(q1-p1)1){ + pt=Op(1,tmp); t=Op(2,tmp); s=Op(3,tmp) + if((t*(t-1)1){ + if(Op(3,tmp)*(Op(3,tmp)-1)1){ + if(Op(3,tmp)*(Op(3,tmp)-1)1){ + if(Op(3,tmp)*(Op(3,tmp)-1)1){ + if(Op(3,tmp)*(Op(3,tmp)-1)1)&&(tmp[[3]]*(tmp[[3]]-1)1)&&(tmp[[3]]*(tmp[[3]]-1)1)&&(tmp[[3]]*(tmp[[3]]-1)1)&&(tmp[[3]]*(tmp[[3]]-1)Eps1){ + out=list(dist) + }else{ + tmp=c(); + for(j in 1:length(pts)){ + tmp=Appendrow(tmp,Op(1,pts[[j]])) + } + tmp1=sum(tmp[,1])/(length(pts)) + tmp2=sum(tmp[,2])/(length(pts)) + tmp3=c(tmp1,tmp2) + tmp=Nearestpt(tmp3,seg1) + tmp1=tmp[[2]] + tmp=Nearestpt(tmp3,seg2) + tmp2=tmp[[2]] + out=list(dist,tmp3,tmp1,tmp2) + } + } + } + } + return(out) +} + +Osplineseg<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Eps=10^(-2) + Eps0=10^(-6) + Ptlist=varargin[[1]] + Numstr="Num=20" + if(Nargs>1){ + Numstr=varargin[[2]] + } + p0=Op(1,Ptlist); p1=Op(2,Ptlist); p2=Op(3,Ptlist); p3=Op(4,Ptlist) + tmp=Norm(p2-p0)*Norm(p3-p1) + tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/tmp)/2) + cc=4*Norm(p2-p1)/3/(Norm(p2-p0)+Norm(p3-p1))/tmp + pQ=p1+cc*(p2-p0) + pR=p2+cc*(p1-p3) + ctrL=list(c(pQ,pR)) + out=Bezier(list(p1,p2),ctrL,Numstr) + return(out) +} + +Intersectpartseg<- function(...){ + varargin=list(...) + Nargs=length(varargin) + crv1=varargin[[1]] + crv2=varargin[[2]] + ii=varargin[[3]] + jj=varargin[[4]] + Eps1=varargin[[5]] + Eps2=varargin[[6]] + Dist=10*Eps2 + if(Nargs>6){Dist=varargin[[7]]} + Eps0=10^(-4) + out=list() + seg1=Listplot(Op(ii,crv1),Op(ii+1,crv1)) + seg2=Listplot(Op(jj,crv2),Op(jj+1,crv2)) + tmp1=Op(2,seg1)-Op(1,seg1) + tmp2=Op(2,seg2)-Op(1,seg2) + snang=abs(Crossprod(tmp1,tmp2))/(Norm(tmp1)*Norm(tmp2)) + tmp=Intersectseg(seg1,seg2,Eps1) + dst=Op(1,tmp) + if(dstDist-Eps0)){ + os1=seg1 + }else{ + p1=Op(1,seg1); p2=Op(2,seg1) + if(ii==1){ + p3=Op(3,crv1) + tmp=p2-p1 + tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) + p0=Reflectdata(p3,c((p1+p2)/2,tmp)) + }else{ + if(ii==Length(crv1)-1){ + p0=Op(ii-1,crv1) + tmp=p2-p1 + tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) + p3=Reflectdata(p0,c((p1+p2)/2,tmp)) + }else{ + p0=Op(ii-1,crv1); p3=Op(ii+2,crv1) + } + } + os1=Osplineseg(list(p0,p1,p2,p3)) + } + if((Length(crv2)==2)||(Norm(Op(2,seg2)-Op(1,seg2))>Dist-Eps0)){ + os2=seg2 + }else{ + p1=Op(1,seg2); p2=Op(2,seg2) + if(jj==1){ + p3=Op(3,crv2) + tmp=p2-p1 + tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) + p0=Reflectdata(p3,c((p1+p2)/2,tmp)) + }else{ + if(jj==Length(crv2)-1){ + p0=Op(jj-1,crv2) + tmp=p2-p1 + tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) + p3=Reflectdata(p0,c((p1+p2)/2,tmp)) + }else{ + p0=Op(jj-1,crv2); p3=Op(jj+2,crv2) + } + } + os2=Osplineseg(list(p0,p1,p2,p3)) + } + tmp2=list() + for(kk in Looprange(1,Length(os1)-1)){ + for(ll in Looprange(1,Length(os2)-1)){ + seg1=Listplot(Op(kk,os1),Op(kk+1,os1)) + seg2=Listplot(Op(ll,os2),Op(ll+1,os2)) + tmp=Intersectseg(seg1,seg2,Eps1) + if((Op(1,tmp)1)){ #18.02.05 + if(Op(1,tmp)0){ + tmp1=c() + for(nn in Looprange(1,length(tmp2))){ + tmp1=Appendrow(tmp1,Op(2,tmp2[[nn]])) + } + tmp=sum(tmp1[,1])/length(tmp2) + tmp=c(tmp,sum(tmp1[,2])/length(tmp2)) + out=list(tmp) + p1=Op(ii,crv1); p2=Op(ii+1,crv1) + tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) + tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) + tmp=min(max(Op(3,tmp),0),1) + out=c(out,list(ii+tmp)) + p1=Op(jj,crv2); p2=Op(jj+1,crv2) + tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) + tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) + tmp=min(max(Op(3,tmp),0),1) + out=c(out,list(jj+tmp,dst,snang)) + } + } + } + return(out) +} + +Collectnear<- function(ptdL,Eps2){ + gL=list(Op(1,ptdL)) + rL=ptdL[Looprange(2,length(ptdL))] #18.02.07 + for( ii in Looprange(1,length(ptdL)-1)){ + numL=c() + for(jj in Looprange(1,length(rL))){ + tmp1=100 + for(kk in Looprange(1,length(gL))){ + tmp=Norm(Op(1,gL[[kk]])-Op(1,rL[[jj]])) + if(tmp2){Eps1=varargin[[3]]} + if(Nargs>3){Eps2=varargin[[4]]} + if(Nargs>4){Dist=varargin[[5]]} + tmp1=varargin[[1]] + crv1=matrix(Op(1,tmp1),nrow=1) + for(ii in Looprange(2,Length(tmp1))){ + tmp=Op(Length(crv1),crv1) + if(Norm(tmp-Op(ii,tmp1))>Eps0){ + crv1=Appendrow(crv1,Op(ii,tmp1)) + } + } + tmp2=varargin[[2]] + crv2=matrix(Op(1,tmp2),nrow=1) + for(ii in Looprange(2,Length(tmp2))){ + tmp=Op(Length(crv2),crv2) + if(Norm(tmp-Op(ii,tmp2))>Eps0){ + crv2=Appendrow(crv2,Op(ii,tmp2)) + } + } + if(Length(crv1)!=Length(crv2)){ + self=0 + }else{ + self=1 + for(ii in Looprange(1,Length(crv1))){ + if(Norm(Op(ii,crv1)-Op(ii,crv2))>0){ + self=0 + break + } + } + } + out=list() + for(ii in Looprange(1,Length(crv1)-1)){ + if(self==0){ + loopL=Looprange(1,Length(crv2)-1) + }else{ + loopL=Looprange(ii+2,Length(crv2)-1) + } + for(jj in loopL){ + tmp=Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,Dist) + if(length(tmp)>1){ #18.02.05 + if(length(out)==0){ + out=list(tmp) + }else{ + tmp1=Op(length(out),out) + if(Norm(Op(1,tmp1)-Op(1,tmp))>Eps1){ + out=c(out,list(tmp)) + } + } + if(self==1){ + tmp=list(Op(1,tmp),Op(3,tmp),Op(2,tmp),Op(4,tmp),Op(5,tmp)) + out=c(out,list(tmp)) + } + } + } + } + tmp2=out + out=list() + tmp1=tmp2 + for(ii in Looprange(1,length(tmp2))){ + tmp=Collectnear(tmp1,Eps2) + out=c(out,list(Op(1,tmp))) + if(length(Op(2,tmp))==0){ + break + }else{ + tmp1=Op(2,tmp) + } + } + for(ii in Looprange(1,length(out))){ + tmp1=Op(ii,out) + if(length(tmp1)==1){ + out[[ii]]=Op(1,tmp1) + }else{ + tmp=c() + for(jj in Looprange(1,length(tmp1))){ + tmp=c(tmp,Op(4,tmp1[[jj]])) + } + dst=min(tmp) + tmp=c() + for(jj in Looprange(1,length(tmp1))){ + if(Op(4,tmp1[[jj]])1){ +# Start=tmp + }else{ + if(flg==0){Eps1=tmp} + if(flg==1){Eps2=tmp} + flg=flg+1 + } + } + flg=0 + AnsL=c() + if(length(plist)==1){ + Fdata=plist[[1]] + tmp1=Op(1,Fdata) + tmp2=Op(Length(Fdata),Fdata) + if(Norm(tmp1-tmp2)1){ + KL=Quicksort(KL,2) + if(length(Start)==0){ + tmp=Op(1,KL) + tst=Op(2,tmp) + Start=Pointoncurve(tst,Fdata) + }else{ + tmp=c() + for(ii in Looprange(1,length(KL))){ + tmp=c(tmp,Norm(Op(1,KL[[ii]]-Start))) + } + tmp=min(tmp) + tmp1=list() + for(ii in Looprange(1,length(KL))){ + tmp2=Op(1,KL[[ii]]) + if(Norm(tmp2-Start)==tmp){ + tmp1=c(tmp1,list(tmp2)) + } + } + tmp=Op(1,tmp1) + tst=Op(2,tmp) + Start=Pointoncurve(tst,Fdata) + } + } + } + } + if(flg==0){ + t1=tst + for(nn in Looprange(1,length(plist))){ + Fdata=Op(nn,plist) + if(nn==length(plist)){ + nxtno=1 + }else{ + nxtno=nn+1 + } + Gdata=Op(nxtno,plist) + KL=IntersectcurvesPp(Fdata,Gdata) + if(length(KL)==0){ + tmp=matrix(Op(Length(Fdata),Fdata),nrow=1) #18.02.02from + Gdata=Appendrow(tmp,Gdata) + plist[[nxtno]]=Gdata + t2=Length(Fdata) + ss=1 #18.02.02upto + }else{ + tmp=Op(1,KL) + t2=Op(2,tmp) + ss=Op(3,tmp) + if(abs(t2-t1)1){ + tmp=Op(2,KL) + t2=Op(2,tmp) + ss=Op(3,tmp) + }else{ +# println(text(nn)+" and "+text(nn+1)+" not intersect"); +# flg=1 + } + } + } + if(flg==0){ + tmp=Partcrv(t1,t2,Fdata) + if(nn==1){ + AnsL=tmp + }else{ + tmp=tmp[2:Length(tmp),] + AnsL=Appendrow(AnsL,tmp) + } + t1=ss + } + } + } + return(AnsL) +} + +############## end of Enclosing2 ############# + +############## start of surface drawing ############# + +Fullformfunc<- function(FdL){ + ADDPOINT<<- list() #18.02.19 + Out=list(Op(1,FdL)) + N=length(FdL) + for(Jrg in Looprange(1,N)){ + Tmp=grep("c(",Op(Jrg,FdL),fixed=TRUE) + if(length(Tmp)>0){ + break + } + } + Urg=Stripblanks(Op(Jrg,FdL)) + Tmp=strsplit(Urg,"=",fixed=TRUE) + UNAME<<- Tmp[[1]][1] + URNG<<- eval(parse(text=Tmp[[1]][2])) + Urg=paste(UNAME,"=c(",sprintf("%6.7f",URNG[1]),",", + sprintf("%6.7f",URNG[2]),")",sep="") + Vrg=Stripblanks(Op(Jrg+1,FdL)) + Tmp=strsplit(Vrg,"=",fixed=TRUE) + VNAME<<- Tmp[[1]][1] + VRNG<<- eval(parse(text=Tmp[[1]][2])) + Vrg=paste(VNAME,"=c(",sprintf("%6.7f",VRNG[1]),",", + sprintf("%6.7f",VRNG[2]),")",sep="") + if(Jrg==2){ + Xf=UNAME + Yf=VNAME + Tmp=Stripblanks(Op(1,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Zf=Tmp[[1]][2] + Tmp=list(UNAME,VNAME,Zf,Urg,Vrg) + Out=c(Out,Tmp) + }else if(Jrg==4){ + Tmp=Stripblanks(Op(1,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Zf=Tmp[[1]][2] + Tmp=Stripblanks(Op(2,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Xname=Tmp[[1]][1] + Xf=Tmp[[1]][2] + Tmp=Stripblanks(Op(3,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Yname=Tmp[[1]][1] + Yf=Tmp[[1]][2] + Tmp=gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE) + Zf=gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE) + Tmp=list(Xf,Yf,Zf,Urg,Vrg) + Out=c(Out,Tmp) + }else{ + Tmp=Stripblanks(Op(2,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Xf=Tmp[[1]][2] + Tmp=Stripblanks(Op(3,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Yf=Tmp[[1]][2] + Tmp=Stripblanks(Op(4,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Zf=Tmp[[1]][2] + Tmp=list(Xf,Yf,Zf,Urg,Vrg) + Out=c(Out,Tmp) + } + tmp=paste("Xfunc<<- function(",UNAME,",",VNAME,"){",Xf,"}",sep='') + eval(parse(text=tmp)) + tmp=paste("Yfunc<<- function(",UNAME,",",VNAME,"){",Yf,"}",sep='') + eval(parse(text=tmp)) + tmp=paste("Zfunc<<- function(",UNAME,",",VNAME,"){",Zf,"}",sep='') + eval(parse(text=tmp)) + tmp=paste("XYZfunc<<- function(",UNAME,",",VNAME,"){",sep='') + tmp=paste(tmp,"c(",Xf,",",Yf,",",Zf,")}",sep='') + eval(parse(text=tmp)) + XYZstr<<- c(Xf,Yf,Zf) + DRWS<<- "enws" + BdyL=list() + for(I in Looprange(Jrg+2,length(FdL))){ + Tmp=Op(I,FdL) + if(is.character(Tmp)){ + if(nchar(Tmp)==0){ + Tmp=" " + } + DRWS<<- list(Tmp) + } + if((is.numeric(Tmp))&&(Length(Tmp)>1)){ + BdyL=list(Tmp) + } + } + BDYL<<- BdyL + Tmp=c(DRWS,BDYL) + Out=c(Out,Tmp) + return(Out) +} + +Addpoints<- function(ptlist){ + ADDPOINT<<- ptlist +} + +Makexybdy<- function(Np){ + Eps0=10^(-4) + Xystr=XYZstr[1:2] + Umin=URNG[1]; Umax=URNG[2] + Vmin=VRNG[1]; Vmax=VRNG[2] + Cflg=0 + EhL=list() + Tmp=grep("e",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:2){ + Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),Xystr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",VRNG) + Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[2])) + Tmp=Paramplot(Tmp1,Tmp2,Tmp3) + if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))0){ + Tmp1="c(" + for(jj in 1:2){ + Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),Xystr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",URNG) + Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[1])) + Tmp=Paramplot(Tmp1,Tmp2,Tmp3) + if(Cflg>0){ + Tmp1=Op(length(EhL),EhL) + Tmp=Joincrvs(Tmp1,Tmp) + if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))0){ + Tmp1="c(" + for(jj in 1:2){ + Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),Xystr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",VRNG) + Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[2])) + Tmp=Paramplot(Tmp1,Tmp2,Tmp3) + if(Cflg>0){ + Tmp1=Op(length(EhL),EhL) + Tmp=Joincrvs(Tmp1,Tmp) + if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))0){ + Tmp1="c(" + for(jj in 1:2){ + Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),Xystr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",URNG) + Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[1])) + Tmp=Paramplot(Tmp1,Tmp2,Tmp3) + if(Cflg>0){ + Tmp1=Op(length(EhL),EhL) + Tmp=Joincrvs(Tmp1,Tmp) + if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))2){ + Eps=varargin[[3]] + } + Eps2=0.1 + if(Nargs>3){ + Eps2=varargin[[4]] + } + if(Nargs>4){ + Ns=varargin[[5]] + if(Ns>0){#18.02.21from + Other=Op(Ns,OTHERPARTITION) + }else{ + Other=c() + }#18.02.21upto + }else{ + Ns=1 + Other=c() + } + Npt=Length(Fig) + ParL=c(1,Npt,Other) + for(N in Looprange(max(1,Ns),Length(GL))){ #18.02.21 + G=Op(N,GL) + KouL=IntersectcurvesPp(Fig,G,Eps,Eps2) + Tmp1=c(); Tmp2=c() + for(jj in Looprange(1,length(KouL))){ + tmp=Op(2,KouL[[jj]]) + if((tmp>1+Eps0)&&(tmp1+Eps0)&&(tmp0)&&(N>Ns)&&(length(Tmp2)>0)){ #18.02.21 + tmp=OTHERPARTITION[[N]] + OTHERPARTITION[[N]]<<- c(tmp,Tmp2) + } + } + tmp1=sort(ParL) + ParL=c() + tmp2=-1 + for(jj in Looprange(1,length(tmp1))){ + tmp=Op(jj,tmp1) + if(abs(tmp-tmp2)>Eps){ + ParL=c(ParL,tmp) + tmp2=tmp + } + } + return(ParL) +} + +Evlptablepara<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Tmp=varargin[[1]] + Mdv=50 + Ndv=50 + if(Nargs>=2){ + Tmp=varargin[[2]] + if(is.list(Tmp)){Tmp=Op(1,Tmp)} + if(length(Tmp)>1){ + Mdv=Tmp[1] + Ndv=Tmp[2] + }else{ + Mdv=Tmp + if(Nargs==2){ + Ndv=Mdv + }else{ + Tmp1=varargin[[3]] + if((is.numeric(Tmp1)) && (length(Tmp1)==1)){ + Ndv=Tmp1 + }else{ + Ndv=Mdv + } + } + } + } + U1=URNG[1]; U2=URNG[2] + V1=VRNG[1]; V2=VRNG[2] + Du=(U2-U1)/(Mdv) + Dv=(V2-V1)/(Ndv) + sph=sprintf("%7.7f",sin(PHI)) + cph=sprintf("%7.7f",cos(PHI)) + sth=sprintf("%7.7f",sin(THETA)) + cth=sprintf("%7.7f",cos(THETA)) + xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="") + tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="") + ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="") + dxu=Diff(xstr,UNAME) + dxv=Diff(xstr,VNAME) + dyu=Diff(ystr,UNAME) + dyv=Diff(ystr,VNAME) + I=1 + Zval=c() + for(jj in 1:(Ndv+1)){ + v=V1+(jj-1)*Dv + ZuL=c() + for(ii in 1:(Mdv+1)){ + u=U1+(ii-1)*Du + tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="") + tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="") + Dxu=Funvalue(dxu,tmp1,tmp2) + Dxv=Funvalue(dxv,tmp1,tmp2) + Dyu=Funvalue(dyu,tmp1,tmp2) + Dyv=Funvalue(dyv,tmp1,tmp2) + Tmp=Dxu*Dyv-Dxv*Dyu + ZuL=c(ZuL,Tmp) + } + Zval=Appendrow(Zval,ZuL) + } + Yval=c() + for(jj in 1:(Ndv+1)){ + v=V1+(jj-1)*Dv + Yval=c(Yval,v) + } + Xval=c() + for(ii in 1:(Mdv+1)){ + u=U1+(ii-1)*Du + Xval=c(Xval,u) + } + return(list(Zval,Xval,Yval)) +} + +Dropnumlistcrv<- function(QdL,Eps){ + Eps0=10^(-4) + if(!is.list(QdL)){ + PdL=list(QdL) + }else{ + PdL=QdL + } + OutL=list() + for(I in Looprange(1,length(PdL))){ + Pd=Op(I,PdL) + PtL=c(1) + P=Op(1,Pd) + for(K in Looprange(2,Length(Pd)-1)){ + if(Norm(P-Op(K,Pd))>Eps){ + PtL=c(PtL,K) + P=Op(K,Pd) + } + } + K=Length(Pd) + if(Norm(P-Op(K,Pd))>Eps){ #18.02.12 eps + PtL=c(PtL,K) + } + if(length(PtL)==1){ + PtL=c() + } + OutL=c(OutL,list(PtL)) + } + return(OutL) +} + +Cuspsplitpara<- function(...){ + varargin=list(...) + Nargs=length(varargin); + Gdxy=varargin[[1]] + if(!is.list(Gdxy)){ + Gdxy=list(Gdxy) + } + Eps0=10^(-4) + Eps=0.01 + if(Nargs>2){Eps=varargin[[2]]} + N=2 + CUSPSPLITPT<<- list() + OutkL=list() + for(Ng in Looprange(1,length(Gdxy))){ + PtxyL=Op(Ng,Gdxy) + PtkL=c() + PthL=c() + for(I in Looprange(1,Length(PtxyL))){ + Tmp=Op(I,PtxyL) + Tmp1=paste(UNAME,'=',sprintf("%7.7f",Tmp[1]),sep="") + eval(parse(text=Tmp1)) + Tmp1=paste(VNAME,'=',sprintf("%7.7f",Tmp[2]),sep="") + eval(parse(text=Tmp1)) + Tmp2=c(eval(parse(text=XYZstr[1]))) + Tmp2=c(Tmp2,eval(parse(text=XYZstr[2]))) + Tmp2=c(Tmp2,eval(parse(text=XYZstr[3]))) + Tmp3=Parapt(Tmp2) + if(I==1){ + PtkL=matrix(Tmp2,nrow=1) + PthL=matrix(Tmp3,nrow=1) + }else{ + Tmp4=Op(Length(PthL),PthL) + if(Norm(Tmp3-Tmp4)>Eps0){ + PtkL=Appendrow(PtkL,Tmp2) + PthL=Appendrow(PthL,Tmp3) + } + } + } + if(Length(PthL)==0){ + return(list()) + } + Ps=Op(1,PthL); Pe=Op(Length(PthL),PthL) + Cflg=0 + if(Norm(Ps-Pe)90){ + Cuspflg=1 + break + } + Q=Op(J,PthL) + if(Norm(P-Q)>Eps){ + break + } + V1=Q-Op(J-1,PthL) + V2=Op(J+1,PthL)-Q + Tmp3=Dotprod(V1,V2)/(norm(V1)*norm(V2)) + Tmp=acos(Tmp3)*180/pi + if(Crossprod(V1,V2)<0){ + Tmp=-Tmp + } + Kaku=Kaku+Tmp + } + if(Cuspflg==1){ + Tmp=trunc((I+J)*0.5) + I=J + if(length(CuspL)==0){ + CuspL=c(Tmp) + }else{ + CuspL=c(CuspL,Tmp) + } + } + } + } + if(Cflg==0){ + CuspL=c(1,CuspL,Length(PthL)) + }else if(length(CuspL)==0){ + CuspL=c(1,Length(PthL)) + }else if(Op(1,CuspL)==1){ + CuspL=c(CuspL,Length(PthL)) + }else{ + Tmp=Op(1,CuspL) + Tmp1=PthL[Tmp:Length(PthL),] + Tmp2=PthL[2:Tmp,] + PthL=Appendrow(Tmp1,Tmp2) + Tmp1=PtkL[Tmp:Length(PthL),] + Tmp2=PtkL[2:Tmp,] + PtkL=Appendrow(Tmp1,Tmp2) + CuspL=CuspL-Tmp+1 + CuspL=c(CuspL,Length(PthL)) + } + if(length(CuspL)==2){ + Tmp4=PthL[Length(PthL),] + if(Length(PtkL)>=2){ + CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4)) + OutkL=c(OutkL,list(PtkL)) + } + next + } + Outk=list() + Is=1 + for(I in Looprange(1,length(CuspL)-1)){ + Tmp1=CuspL[Is]; Tmp2=CuspL[I+1] + Tmp3=Op(Tmp1,PthL); Tmp4=Op(Tmp2,PthL) + if(Norm(Tmp3-Tmp4)>Eps){ + Tmpk=PtkL[Tmp1:Tmp2,] + Outk=c(Outk,list(Tmpk)) + CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4)) + Is=I+1 + } + } + OutkL=c(OutkL,Outk) + } + Tmp1=Dropnumlistcrv(Projpara(OutkL),Eps*0.5) + Tmp=list() + for(I in Looprange(1,length(OutkL))){ + Tmp2=Op(I,OutkL) + Tmp3=Op(I,Tmp1) + Tmp4=c() + for(J in Looprange(1,Length(Tmp3))){ + Tmp5=Op(Tmp3[J],Tmp2) + Tmp4=Appendrow(Tmp4,Tmp5) + } + if(Length(Tmp4)>0){ + Tmp=c(Tmp,list(Tmp4)) + } + } + return(Tmp) +} + +PthiddenQ<- function(PtA,Vec,Uveq,Np,Eps,Eps2){ + Eps0=10^(-4) + Out=c() + Vec=1/Norm(Vec)*Vec + if(length(Np)==1){ + Np=c(Np,Np) + } + Tmp=paste("Eqfun<- function(U,V){",sep='') + if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){ + Vstr=sprintf("%6.6f",Vec) + Pstr=sprintf("%6.6f",PtA) + Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='') + Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='') + }else{ + Tmp=paste(Tmp,"Xfunc(U,V)}",sep='') + } + eval(parse(text=Tmp)) + Dx=(URNG[2]-URNG[1])/Np[1] + Dy=(VRNG[2]-VRNG[1])/Np[2] + for(J in Looprange(1,Np[2])){ ##### + Vval1=VRNG[1]+(J-1)*Dy + Vval2=VRNG[1]+J*Dy + for(I in Looprange(1,Np[1])){ ##### + Uval1=URNG[1]+(I-1)*Dx + Uval2=URNG[1]+I*Dx + Eval11=Eqfun(Uval1,Vval1) + Eval12=Eqfun(Uval1,Vval2) + Eval21=Eqfun(Uval2,Vval1) + Eval22=Eqfun(Uval2,Vval2) + a1=Uval1;b1=Vval1;c1=Eval11 + a2=Uval2;b2=Vval1;c2=Eval21 + a3=Uval2;b3=Vval2;c3=Eval22 + a4=Uval1;b4=Vval2;c4=Eval12 + PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) + VL=c(c1,c2,c3,c4,c1) + QL=c() + for(K in 1:4){ + P1=Op(K,PL); P2=Op(K+1,PL) + M1=Op(K,VL); M2=Op(K+1,VL) + if(abs(M1) 0) && (M2> 0)){ + next + } + if((M1< 0) && (M2< 0)){ + next + } + Tmp=1/(M1-M2)*(-M2*P1+M1*P2) + QL=Appendrow(QL,Tmp) + } + if(Length(QL)==2){ + Puv1=Op(1,QL); Puv2=Op(2,QL) + Tmp1=Op(1,Puv1) + Tmp2=Op(2,Puv1) + Xv=Xfunc(Tmp1,Tmp2) + Yv=Yfunc(Tmp1,Tmp2) + Zv=Zfunc(Tmp1,Tmp2) + P1=c(Xv,Yv,Zv) + Tmp1=Op(1,Puv2) + Tmp2=Op(2,Puv2) + Xv=Xfunc(Tmp1,Tmp2) + Yv=Yfunc(Tmp1,Tmp2) + Zv=Zfunc(Tmp1,Tmp2) + P2=c(Xv,Yv,Zv) + V1=Vec[1]; V2=Vec[2]; V3=Vec[3] + if(abs(V1)>Eps0){ + M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3] + M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3] + }else if(abs(V2)>Eps0){ + M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3] + M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3] + }else{ + M1=PtA[2]-P1[2] + M2=PtA[2]-P2[2] + } + if(M1*M2>= 0){ + if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ + next + } + if(M1==0){ + Pt=P1; Ptuv=Puv1 + }else{ + Pt=P2; Ptuv=Puv2 + } + }else{ + Pt=1/(M1-M2)*(-M2*P1+M1*P2) + Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2) + } + if(is.character(Uveq)){ + Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='') + Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='') + Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE) + Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE) + Tmp=eval(parse(text=Tmp)) + if(Tmp< -Eps0){ + next + } + } + Tmp1=Crossprod(Pt-PtA,Vec) + if(Norm(Tmp1)Zparapt(PtA)+Eps2){ + return(list(1,Pt,Zparapt(Pt),Zparapt(PtA))) + }else{ + Out=Appendrow(Out,Pt) + } + } + } + } + } + if(Length(Out)==0){ + return(list(0,c())) + } + return(c(list(0,Out))) +} + +Nohiddenpara2<- function (Par,Fk,Uveq,Np,Eps,Eps2){ + Eps0=10^(-4) + Fh=Projpara(Fk) + P1=Ptstart(Fh) + P2=Ptend(Fh) + Csp=CUSPPT + if(!is.list(Csp)){Csp=list(Csp)} + Cspflg=1 + for(I in Looprange(1,length(Csp))){ + Tmp=Op(I,Csp) + if(Norm(Tmp-P1)Eps2){ + PaL=c(PaL,tmp1) + tmp2=tmp1 + } + } + tmp1=PaL[length(PaL)] #18.02.26from + tmp2=Par[length(Par)] + if(abs(tmp1-tmp2)0){ + if(Norm(P-Q)>Eps0){ #18.02.14 + FigL=c(FigL,list(Partcrv(P,Q,Fh))) + Tmp3=Invparapt(SP,Fh,Fk) + TP=Op(2,Tmp3) + Tmp3=Invparapt(SQ,Fh,Fk) + TQ=Op(2,Tmp3) + FigkL=c(FigkL,list(Partcrv3(TP,TQ,Fk))) + }else{ + FigL=c(FigL,list(Fh)) + FigkL=c(FigkL,list(Fk)) + } + } + Tmp=c() + for(I in Looprange(1,length(PaL)-1)){ + if(!Member(I,SeL)){ + Tmp=c(Tmp,I) + } + } + SeL=Tmp + HIDDENDATA<<- list() + for(I in Looprange(1,length(SeL))){ + Tmp=PaL[SeL[I]] + Tmp1=Pointoncurve(Tmp,Fh) + Tmp=PaL[SeL[I]+1] + Tmp2=Pointoncurve(Tmp,Fh) + if(I==1){ + P=Tmp1; SP=PaL[SeL[I]] + Q=Tmp2; SQ=PaL[SeL[I]+1] + }else{ + if(Member(SeL[I]-1,SeL)){ + Q=Tmp2; SQ=PaL[SeL[I]+1] + }else{ + Tmp=Invparapt(SP,Fh,Fk) + TP=Op(2,Tmp) + Tmp=Invparapt(SQ,Fh,Fk) + TQ=Op(2,Tmp) + HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk))) + P=Tmp1; SP=PaL[SeL[I]] + Q=Tmp2; SQ=PaL[SeL[I]+1] + } + } + } + if(length(SeL)>0){ + if(Norm(P-Q)>Eps0){ #18.02.14 + Tmp=Invparapt(SP,Fh,Fk) + TP=Op(2,Tmp) + Tmp=Invparapt(SQ,Fh,Fk) + TQ=Op(2,Tmp) + HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk))) + }else{ + HIDDENDATA<<- c(HIDDENDATA,list(Fk)) + } + } + return(FigkL) +} + +Borderparadata<- function(...){ + varargin=list(...) + Nargs=length(varargin) + FkL=varargin[[1]] + Np=c(50,50) + Eps=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(2,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps=tmp} + if(ctr==2){Eps2=tmp} + } + } + Umin=URNG[1]; Umax=URNG[2] + Vmin=VRNG[1]; Vmax=VRNG[2] + EkL=list() + Tmp=grep("e",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:3){ + Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),XYZstr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",VRNG) + Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[2]),sep="") + Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) + EkL=c(EkL,list(Tmp)) + } + Tmp=grep("n",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:3){ + Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),XYZstr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",URNG) + Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[1]),sep="") + Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) + EkL=c(EkL,list(Tmp)) + } + Tmp=grep("w",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:3){ + Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),XYZstr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",VRNG) + Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[2])) + Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) + EkL=c(EkL,list(Tmp)) + } + Tmp=grep("s",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:3){ + Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),XYZstr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",URNG) + Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[1])) + Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) + EkL=c(EkL,list(Tmp)) + } + if(length(EkL)>0){ + FkL=c(FkL,EkL) + } + Fall=Projpara(FkL) + if(is.numeric(Fall)){ + Fall=list(Fall) + } + Fbdxy=Makexybdy(Np) + BORDERPT<<- list() + Tmp1=list() + for(I in Looprange(1,length(Fall))){ + Tmp1=c(Tmp1,list(c())) + } + OTHERPARTITION<<- Tmp1 + FsL=list() + BORDERHIDDENDATA<<- list() + starttime=proc.time() + for(I in Looprange(1,length(FkL))){ + Tmp=Op(I,FkL) + Tmp=Projpara(Tmp) + Par=Partitionseg(Tmp,Fall,Eps,Eps2,I) + Tmp1=Op(I,FkL) + Tmp=Nohiddenpara2(Par,Tmp1,1,Np,Eps,Eps2) + if(length(HIDDENDATA)>0){ + BORDERHIDDENDATA<<- c(BORDERHIDDENDATA,HIDDENDATA) + } + if(length(Tmp)>0){ + FsL=c(FsL,Tmp) + } + Tmp=paste('Border',formatC(I,width=2,flag="0"),'/',sep='') + Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') + Tmp1=proc.time()-starttime + print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) + } + return(FsL) +} + +Sfbdparadata<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Fd=varargin[[1]] + FdL=Fullformfunc(Fd) + Np=c(50,50) + Eps=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(2,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps=tmp} + if(ctr==2){Eps2=tmp} + } + } + starttime=proc.time() + tmp=Evlptablepara(Np) + Zval=tmp[[1]]; Xval=tmp[[2]]; Yval=tmp[[3]] + Out3=Implicitplot(Zval,Xval,Yval) + tmp3=list() + for(jj in Looprange(1,length(Out3))){ + tmp1=Op(jj,Out3) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) + } + Nlist=Dropnumlistcrv(tmp2,Eps) + Nlist=Nlist[[1]] + tmp=c() + for(kk in Looprange(1,length(Nlist))){ + tmp=Appendrow(tmp,Op(Nlist[kk],tmp1)) #18.02.18 + } + if(Length(tmp)>0){ + tmp3=c(tmp3,list(tmp)) + } + } + Out3=tmp3 + IMPLICITDATA<<- Out3 + Tmp=proc.time()-starttime + print(paste('ImplicitData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep='')) + starttime=proc.time() + Out4=Cuspsplitpara(Out3,Eps) + CUSPDATA<<- Out4 + CUSPPT<<- CUSPSPLITPT + Tmp=proc.time()-starttime + print(paste('CuspData obtained : Time =',sprintf("%6.3f",Tmp[1]),sep='')) + Out5=Borderparadata(Out4,Np,Eps,Eps2) + return(Out5) +} + +Meetpoints<- function(PtA,PtB,Uveq,Np,Eps){ + Eps0=10^(-4) + Vec=PtB-PtA + if(Norm(Vec)Eps0) || (abs(Vec[1])>Eps0)){ + Vstr=sprintf("%6.6f",Vec) + Pstr=sprintf("%6.6f",PtA) + Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='') + Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='') + }else{ + Tmp=paste(Tmp,"Xfunc(U,V)}",sep='') + } + eval(parse(text=Tmp)) + Dx=(URNG[2]-URNG[1])/Np[1] + Dy=(VRNG[2]-VRNG[1])/Np[2] + for(J in Looprange(1,Np[2])){ ##### + Vval1=VRNG[1]+(J-1)*Dy + Vval2=VRNG[1]+J*Dy + for(I in Looprange(1,Np[1])){ ##### + Uval1=URNG[1]+(I-1)*Dx + Uval2=URNG[1]+I*Dx + Eval11=Eqfun(Uval1,Vval1) + Eval12=Eqfun(Uval1,Vval2) + Eval21=Eqfun(Uval2,Vval1) + Eval22=Eqfun(Uval2,Vval2) + a1=Uval1;b1=Vval1;c1=Eval11 + a2=Uval2;b2=Vval1;c2=Eval21 + a3=Uval2;b3=Vval2;c3=Eval22 + a4=Uval1;b4=Vval2;c4=Eval12 + PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) + VL=c(c1,c2,c3,c4,c1) + QL=c() + for(K in 1:4){ + P1=Op(K,PL); P2=Op(K+1,PL) + M1=Op(K,VL); M2=Op(K+1,VL) + if(abs(M1) 0) && (M2> 0)){ + next + } + if((M1< 0) && (M2< 0)){ + next + } + Tmp=1/(M1-M2)*(-M2*P1+M1*P2) + QL=Appendrow(QL,Tmp) + } + if(Length(QL)==2){ + Puv1=Op(1,QL); Puv2=Op(2,QL) + Tmp1=Op(1,Puv1) + Tmp2=Op(2,Puv1) + Xv=Xfunc(Tmp1,Tmp2) + Yv=Yfunc(Tmp1,Tmp2) + Zv=Zfunc(Tmp1,Tmp2) + P1=c(Xv,Yv,Zv) + Tmp1=Op(1,Puv2) + Tmp2=Op(2,Puv2) + Xv=Xfunc(Tmp1,Tmp2) + Yv=Yfunc(Tmp1,Tmp2) + Zv=Zfunc(Tmp1,Tmp2) + P2=c(Xv,Yv,Zv) + V1=Vec[1]; V2=Vec[2]; V3=Vec[3] + if(abs(V1)>Eps0){ + M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3] + M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3] + }else if(abs(V2)>Eps0){ + M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3] + M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3] + }else{ + M1=PtA[2]-P1[2] + M2=PtA[2]-P2[2] + } + if(M1*M2>= 0){ #18.02.21 + if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ + next + } + if(M1==0){ + Pt=P1; Ptuv=Puv1 + }else{ + Pt=P2; Ptuv=Puv2 + } + }else{ + Pt=1/(M1-M2)*(-M2*P1+M1*P2) + Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2) + } + if(is.character(Uveq)){ + Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='') + Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='') + Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE) + Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE) + Tmp=eval(parse(text=Tmp)) + if(Tmp< -Eps0){ + next + } + } + Tmp1=Crossprod(Pt-PtA,Vec) + if(Norm(Tmp1)-Eps0)&&(Tmp1=2){ + Fbdy=Joincrvs(FigL) + }else{ + Fbdy=Op(1,FigL) + } + if(!is.list(ObjL)){ + ObjL=list(ObjL) + } + if(!is.list(FigL)){ + FigL=list(FigL) + } + OutL=list() + for(Nobj in Looprange(1,length(ObjL))){ + Obj=Op(Nobj,ObjL) + ParL=c(1,Length(Obj)) + Tmp=IntersectcurvesPp(Obj,Fbdy,Eps1,Eps2) + for(J in Looprange(1,length(Tmp))){ + Tmp1=Op(J,Tmp) + ParL=c(ParL,Op(2,Tmp1)) + } + ParL=sort(ParL) + Tmp=c(1) + for(I in Looprange(1,length(ParL))){ + Tmp1=Op(length(Tmp),Tmp) + Tmp2=ParL[I] + if(Tmp2-Tmp1>Eps0){ + Tmp=c(Tmp,Tmp2) + } + } + ParL=Tmp + Tmp1=Op(length(ParL),ParL) + Tmp2=Length(Obj) + if(abs(Tmp1-Tmp2)1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps=tmp} + if(ctr==2){Eps2=tmp} + } + } + Out=list() + CRVSFHIDDENDATA<<- list() + for(Nn in Looprange(1,length(FkL))){ + Fk=Op(Nn,FkL) + Tmp=Projpara(Fk) + Par=Partitionseg(Tmp,Fbdy,Eps,Eps2,0) + if(Sepflg==0){ + for(I in Looprange(1,Length(Fk)-1)){ + Pa=Op(I,Fk) + Pb=Op(I+1,Fk) + PtL=Meetpoints(Pa,Pb,1,Np,Eps) + for(J in Looprange(1,Length(PtL))){ + Tmp=Op(J,PtL) + Tmp=Parapt(Tmp) + Tmp1=Paramoncurve(Tmp,I,Projpara(Fk)) + Tmp2=min(abs(Par-Tmp1)) + if(Tmp2*Norm(Parapt(Pb-Pa))>Eps) { + Par=c(Par,Tmp1) + } + } + Par=sort(Par) + } + } + for(jj in Looprange(1,length(ADDPOINT))){ #18.02.19from + tmp=Parapt(Op(jj,ADDPOINT)) + tmp=Nearestpt(tmp,Projpara(Fk)) + if(tmp[[3]]Eps){ + Par=c(Par,tmp) + tmp2=tmp + } + } + Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps,Eps2) + Out=c(Out,Tmp1) + CRVSFHIDDENDATA<<- c(CRVSFHIDDENDATA,HIDDENDATA) + Tmp=paste('Crvsfdata',formatC(Nn,width=2,flag="0"),'/',sep='') + Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') + Tmp1=proc.time()-starttime + print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) + } + return(Out) +} + +Crv3onsfparadata<- function(...){ + starttime=proc.time() + varargin=list(...) + Nargs=length(varargin) + Fk=varargin[[1]] + if(!is.list(Fk)){ + FkL=list(Fk) + }else{ + FkL=Fk + } + Fbdy=Projpara(varargin[[2]]) + Fd=varargin[[3]] + Fullformfunc(Fd) #18.02.17 + Np=c(50,50) + Eps=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(4,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps=tmp} + if(ctr==2){Eps2=tmp} + } + } + Out=list() + CRVONSFHIDDENDATA<<- list() + for(Nn in Looprange(1,length(FkL))){ + Fk=Op(Nn,FkL) + Tmp=Projpara(Fk) + Par=Partitionseg(Tmp,Fbdy,Eps,Eps2,0) + for(jj in Looprange(1,length(ADDPOINT))){ + tmp=Parapt(Op(jj,ADDPOINT)) + tmp=Nearestpt(tmp,Projpara(Fk)) + if(tmp[[3]]1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps=tmp} + if(ctr==2){Eps2=tmp} + } + } + Out=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2) + return(Out) +} + +Wireparadata<- function(...){ + starttime=proc.time() + varargin=list(...) + Nargs=length(varargin) + Fbdy3=varargin[[1]] + Fd=varargin[[2]] + FdL=Fullformfunc(Fd) + DuL=varargin[[3]] + DvL=varargin[[4]] + Np=c(50,50) + Eps=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(5,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps=tmp} + if(ctr==2){Eps2=tmp} + } + } + if(is.numeric(DuL)){ + tmp1=DuL + DuL=list() + for(jj in Looprange(1,tmp1)){ + tmp=jj*(URNG[2]-URNG[1])/(tmp1+1) + DuL=c(DuL,list(tmp)) + } + } + if(is.numeric(DvL)){ + tmp1=DvL + DvL=list() + for(jj in Looprange(1,tmp1)){ + tmp=jj*(VRNG[2]-VRNG[1])/(tmp1+1) + DvL=c(DvL,list(tmp)) + } + } + Fuv=list() + for(jj in Looprange(1,length(DuL))){ + tmp1=paste("c(",as.character(Op(jj,DuL)),",",VNAME,")",sep="") + tmp2=paste("N=",as.character(Np[2]),sep="") + tmp1=Paramplot(tmp1,Op(6,FdL),tmp2) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,tmp) + } + Fuv=c(Fuv,list(tmp2)) + } + FkL=list() + for(jj in Looprange(1,length(Fuv))){ + tmp1=Op(jj,Fuv) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) + } + FkL=c(FkL,list(tmp2)) + } + Tmp1=proc.time()-starttime + cat(UNAME,"direction started","\n") + Out1=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2) + WIREHIDDENDATA<<- CRVONSFHIDDENDATA + Fuv=list() + for(jj in Looprange(1,length(DvL))){ + tmp1=paste("c(",UNAME,",",as.character(Op(jj,DvL)),")",sep="") + tmp2=paste("N=",as.character(Np[2]),sep="") + tmp1=Paramplot(tmp1,Op(5,FdL),tmp2) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,tmp) + } + Fuv=c(Fuv,list(tmp2)) + } + FkL=list() + for(jj in Looprange(1,length(Fuv))){ + tmp1=Op(jj,Fuv) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) + } + FkL=c(FkL,list(tmp2)) + } + cat(VNAME,"direction started","\n") + Out2=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps,Eps2) + WIREHIDDENDATA<<- c(WIREHIDDENDATA, CRVONSFHIDDENDATA) + Out=c(Out1,Out2) + return(Out) +} + +Intersectcrvsf<- function(...){ + # bdyeq is the equation of boundary f(x,y,z) =0 + starttime=proc.time() + varargin=list(...) + Nargs=length(varargin) + crv=varargin[[1]] + Fd=varargin[[2]] + Fullformfunc(Fd) + bdyflg=0 + bdyeq=varargin[[Nargs]] + if(is.character(bdyeq)){ + Nargs=Nargs-1 + bdyflg=1 + tmp=strsplit(bdyeq,"=",fixed=TRUE) + tmp=tmp[[1]] + if(length(tmp)>1){ + bdyeq=paste("(",tmp[1],")-(",tmp[2],")",sep="") + } + tmp=paste("bdyeq<- function(P){x=P[1];y=P[2];z=P[3];",bdyeq,"}",sep="") + eval(parse(text=tmp)) + } + Eps0=10^(-4) + Np=c(50,50) + Eps=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(3,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps=tmp} + if(ctr==2){Eps2=tmp} + } + } + PtL=list() + for(I in Looprange(1,Length(crv)-1)){ + Pa=Op(I,crv) + Pb=Op(I+1,crv) + if(bdyflg==0){ + tmp=Meetpoints(Pa,Pb,1,Np,Eps) + }else{ + M1=bdyeq(Pa); M2=bdyeq(Pb) + if(M1*M2>= 0){ #18.02.21 + if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ + next + } + if(M1==0){ + tmp=list(Pa) + }else{ + tmp=list(Pb) + } + }else{ + while(Norm(Pb-Pa)>Eps0){ + if(bdyeq(Pa)==0){ + tmp=list(Pa) + break + } + if(bdyeq(Pa)*bdyeq((Pa+Pb)/2)>0){ + Pa=(Pa+Pb)/2 + }else{ + Pb=(Pa+Pb)/2 + } + } + tmp=list(1/(M1-M2)*(-M2*Pa+M1*Pb)) + } + } + PtL=c(PtL,tmp) + } + Tmp=paste('Intersectcrvsf obtained : Time =',sep='') + Tmp1=proc.time()-starttime + print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) + return(PtL) +} + +Sfcutparadata<- function(...){ + varargin=list(...) + Nargs=length(varargin) + CutD=varargin[[1]] + Fbdy3=varargin[[2]] + Fd=varargin[[3]] + FdL=Fullformfunc(Fd) + Np=c(50,50) + Eps0=10^(-4) + Eps=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(4,Nargs)){ + Tmp=varargin[[jj]] + if((length(Tmp)>1)||(Tmp>1)){ + Np=Tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps=Tmp} + if(ctr==2){Eps2=Tmp} + } + } + starttime=proc.time() + Tmp=strsplit(CutD,'=') + Tmp=Tmp[[1]] + if(length(Tmp)==1){ + Eq=CutD + }else{ + Eq=paste("(",Tmp[1],")-(",Tmp[2],")",sep="") + } + Eq=gsub("x","Xfunc(U,V)",Eq,fixed=TRUE) + Eq=gsub("y","Yfunc(U,V)",Eq,fixed=TRUE) + Eq=gsub("z","Zfunc(U,V)",Eq,fixed=TRUE) + Tmp=paste("Eqfun<<- function(U,V){",Eq,"}",sep="") ######## + eval(parse(text=Tmp)) + Du=(URNG[2]-URNG[1])/Np[1] + Dv=(VRNG[2]-VRNG[1])/Np[2] + Out=list();Out2=list() + for(J in Looprange(1,Np[2])){ ##### + Vval1=VRNG[1]+(J-1)*Dv + Vval2=VRNG[1]+J*Dv + for(I in Looprange(1,Np[1])){ ##### + Uval1=URNG[1]+(I-1)*Du + Uval2=URNG[1]+I*Du + Eval11=Eqfun(Uval1,Vval1) + Eval12=Eqfun(Uval1,Vval2) + Eval21=Eqfun(Uval2,Vval1) + Eval22=Eqfun(Uval2,Vval2) + a1=Uval1;b1=Vval1;c1=Eval11 + a2=Uval2;b2=Vval1;c2=Eval21 + a3=Uval2;b3=Vval2;c3=Eval22 + a4=Uval1;b4=Vval2;c4=Eval12 + PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) + VL=c(c1,c2,c3,c4,c1) + QL=c() + for(K in 1:4){ + P1=Op(K,PL); P2=Op(K+1,PL) + M1=Op(K,VL); M2=Op(K+1,VL) + if(abs(M1) 0) && (M2> 0)){ + next + } + if((M1< 0) && (M2< 0)){ + next + } + Tmp=1/(M1-M2)*(-M2*P1+M1*P2) + QL=Appendrow(QL,Tmp) + } + if(Length(QL)==2){ + q11=QL[1,1];q12=QL[1,2];q21=QL[2,1];q22=QL[2,2] + if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){ + if(((q21==b1)&&(q22==b1))||((q21==b3)&&(q22==b3))){ + Out2=c(Out2,list(QL)) + }else{ + Out=c(Out,list(QL)) + } + next + } + if(((q12==b1)&&(q22==b1))||((q12==b3)&&(q22==b3))){ + if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){ + Out2=c(Out2,list(QL)) + }else{ + Out=c(Out,list(QL)) + } + next + } + Out=c(Out,list(QL)) + } + } + } + while(length(Out2)>0){ + tmp1=Out2[[1]] + Out=c(Out,list(tmp1)) + Out2=Out2[-1] + rmv=c() + for(jj in Looprange(1,length(Out2))){ + tmp2=Out2[[jj]] + diff1=Norm(tmp2[1,]-tmp1[1,])+Norm(tmp2[2,]-tmp1[2,]) + diff2=Norm(tmp2[1,]-tmp1[2,])+Norm(tmp2[2,]-tmp1[1,]) + if((diff10){ + if(Norm(Op(Length(Tmp3),Tmp3)-Tmp) + + +######################################### + +ThisVersion<- "2ev5_2_3(17.10.28)" + +# 2017.10.28 +# Drwpt debugged ( Flattenlist ) +# 2017.10.07 +# + +############################################# + +Dottedline<- function(...) +{ + varargin <- list(...) + Nall <- length(varargin) + Nagasa <- 0.1 + Ookisa <- PenThick*2 #17.10.07 + I <- Nall + Tmp <- varargin[[I]] + while (mode(Tmp)=="numeric" && length(Tmp)==1 ) { + I <- I-1 + Tmp <- varargin[[I]] + } + if (I==Nall-1) { + Nagasa<-Nagasa*varargin[[Nall]] + Nall <- Nall-1 + } + if (I==Nall-2) { + Nagasa <- Nagasa*varargin[[Nall-1]] + Ookisa <- round(Ookisa*varargin[[Nall]]) + Nall <- Nall-2 + } + Nagasa <- 1000/2.54/MilliIn*Nagasa + Ra=Ookisa/MilliIn + for (N in 1:Nall) { + Pdata <- varargin[[N]] + if (mode(Pdata)=="numeric") { + Pdata <- list(Pdata) + } + for (II in 1:length(Pdata)) { + Clist <- MakeCurves(Op(II,Pdata)) + DinM <- Dataindex(Clist) + Mojisu=0 + for (n in Looprange(1,Nrow(DinM))) { + Tmp <- DinM[n,] + Data <- Clist[Tmp[1]:Tmp[2],] + Len <- 0 + Lenlist <- c(0) + for (I in Looprange(2,Nrow(Data))) { + Len <- Len+Norm(Data[I,]-Data[I-1,]) + Lenlist <- c(Lenlist,Len) + } + Lenall <- Lenlist[length(Lenlist)] + if (Lenall==0) { + next + } + Naga <- Nagasa + Nten <- round(Lenall/Naga)+1 + if (Nten > 1) { + Seg <- Lenall/(Nten-1) + } + else { + Seg <- Lenall + } + Eps <- 10^(-6)*Seg + PPd<-c() + Hajime <- 1 + for (I in Looprange(0,Nten-1)) { + Len <- Seg*I + if (I>0) { + J <- Hajime + while( Len>=Lenlist[J]+Eps) { + J <- J+1 + } + Hajime <- J-1 + } + T <- (Len-Lenlist[Hajime])/ + (Lenlist[Hajime+1]-Lenlist[Hajime]) + P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) + PPd<-Appendrow(PPd,P) + if (I==Nten-1) { + if (Norm(P-Data[1,])80){ + cat("\n",file=Wfile,append=TRUE) + Mojisu=0 + } + } + } + } + if(Mojisu>0){ + cat("\n",file=Wfile,append=TRUE) + } + } + Tmp<-PenThick/PenThickInit + Setpen(Tmp) +} + + +########################################### + +Drwline<-function(...) +{ + varargin<-list(...) + Nall<-length(varargin) + Thick<-0 + Tmp<-varargin[[Nall]] + if (mode(Tmp)=="numeric" && length(Tmp)==1){ + Setpen(Tmp) + Nall<-Nall-1 + } + for (N in 1:Nall){ + Pdata<-varargin[[N]] + if (length(Pdata)==0) next + if (mode(Pdata)!="list") Pdata<-list(Pdata) + while(Mixtype(Pdata)==3){ + Tmp1<- list() + for(II in Looprange(1,length(Pdata))){ + Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) + } + Pdata<- Tmp1 + } + for (II in Looprange(1,length(Pdata))){ + Clist<-MakeCurves(Pdata[[II]]) + DinM<-Dataindex(Clist) + for (n in Looprange(1,Nrow(DinM))){ + Tmp<-DinM[n,] + Data<-Clist[Tmp[1]:Tmp[2],] + Mojisu<-0 + for (I in Looprange(1,Nrow(Data))){ + Tmp<-Data[I,] + X=sprintf('%5.5f',Tmp[1]) + Y=sprintf('%5.5f',Tmp[2]) + Pt=paste('(',X,',',Y,')',sep="") + if(I==1){ + Str=paste('\\polyline',Pt,sep="") + }else{ + Str=Pt + } + cat(Str,file=Wfile,append=TRUE) + Mojisu<-Mojisu+nchar(Str) + if (Mojisu>80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<-0 + } + } + if (Mojisu!=0){ + cat("%\n",file=Wfile,append=TRUE) + } + cat("%\n",file=Wfile,append=TRUE) + } + } + } + if (Thick>0){ + Tmp<-PenThick/PenThickInit + Setpen(Tmp) + } +} + +########################################### + +Drwpt<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + All=Nargs + if (TenSize>TenSizeInit){ + N<- round(6*sqrt(TenSize/TenSizeInit)) + } + else{ + N<-4 + } + Tmp<- varargin[[All]] + Iro=c(0,0,0,1) + Iroflg=0 + if(is.character(Tmp)){ + Iro=Ratiocmyk(Tmp) + Iroflg=1 + All=All-1 + } + Tmp<- varargin[[All]] + if (mode(Tmp)=="numeric"){ + if (length(Tmp)>1){ + Kosa<- 1; All<- Nargs + } + else{ + Kosa<- Tmp; All<- All-1 + } + } + else if (mode(Tmp)=="list"){ + Kosa<- 1; All<- Nargs + } + Ra=TenSize*1000/2.54/MilliIn + if(Iroflg>0){ + Str='{\\color[cmyk]{' + for(J in 1:4){ + Str=paste(Str,as.character(Kosa*Iro[J]),sep="") + if(J<4){ + Str=paste(Str,',',sep="") + } + } + Str=paste(Str,'}%',sep="") + cat(Str,file=Wfile,append=TRUE) + } + +# CL<-c() +# for (J in 0:N){ +# Tmp<- TenSize*0.5*1000/2.54/MilliIn +# Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) +# CL<- append(CL,Tmp) +# } +# CL<- matrix(CL,nrow=2) +# CL<- t(CL) + Mojisu=0 + for (II in Looprange(1,All)){ + MS<- varargin[[II]] + MS=Flattenlist(MS) #17.10.28 + if (mode(MS)=="numeric"){ + MS<- list(MS) + } + for (I in Looprange(1,length(MS))){ + P<- MS[[I]] + if (InWindow(P)!="i") next + P<- Doscaling(P) + X=sprintf('%5.5f',P[1]) + Y=sprintf('%5.5f',P[2]) + Str=paste('\\put(',X,',',Y,'){\\circle*{',sprintf('%6.6f',Ra),'}}',sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu=Mojisu+nchar(Str) + if(Mojisu>80){ + cat("\n",file=Wfile,append=TRUE) + Mojisu=0 + } + } + } + Str="%" + if(Iroflg>0){ + Str='}%' + } + if(Mojisu>0){ + Str=paste('\n',Str,'\n',sep="") + }else{ + Fmt=paste(Str,'\n',sep="") + } + cat(Str,file=Wfile,append=TRUE) +} + +# PL<-c() +# for (J in 0:N){ +# PL<- c(PL,P+CL[J+1,]) +# } +# PL<-matrix(PL,nrow=2) +# PL<-t(PL) +# Mojisu<-0 +# for (J in 1:Nrow(PL)){ +# Q<- PL[J,] +# X<- as.character(round(MilliIn*Q[1])) +# Y<- as.character(-round(MilliIn*Q[2])) +# Str<- paste("\\special{pa ",X," ",Y,"}",sep="") +# cat(Str,file=Wfile,append=TRUE) +# Mojisu<- Mojisu+nchar(Str) +# if (Mojisu>80){ +# cat("#\n",file=Wfile,append=TRUE) +# } +# Mojisu=0 +# } +# Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") +# Str2<- "\\special{fp}%\n" +# cat(Str1,file=Wfile,append=TRUE) +# cat(Str2,file=Wfile,append=TRUE) +# } +# } +#} + +###################################### + +Makehasen<- function(Figdata,Sen,Gap,Ptn) +{ + Eps<- 10.0^(-6) + Clist<- MakeCurves(Figdata) + DinM<- Dataindex(Clist) + for (N in Looprange(1,Nrow(DinM))){ + Tmp<- DinM[N,] + Data<- Clist[Tmp[1]:Tmp[2],] + Dtall<- Nrow(Data) + Len<- 0 + Lenlist<- c(0) + for (I in Looprange(2,Dtall)){ + Len<- Len+Norm(Data[I,]-Data[I-1,]) + Lenlist<- c(Lenlist,Len) + } + Lenall<- Lenlist[Dtall] + if (Lenall==0){ + next + } + Kari<- (Sen+Gap)*0.1 + Naga<- Sen*0.1 + Tobi<- Gap*0.1 + if (Norm(Data[1,]-Data[Dtall,])=Lenlist[J]-Eps){ + if (J==Dtall){ + break + } + J<- J+1 + } + Hajime<- J-1 + J<- Hajime + while (Len+Naga>Lenlist[J]-Eps){ + if (J==Dtall){ + break + } + J<- J+1 + } + Owari<- J-1 + T<- (Len-Lenlist[Hajime]) + T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) + P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) + X0=sprintf('%5.5f',P[1]) + Y0=sprintf('%5.5f',P[2]) + Pt0=paste('(',X0,',',Y0,')',sep="") + Str=paste('\\polyline',Pt0,sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + for (J in Looprange(Hajime+1,Owari)){ + P=Data[J,] + X=sprintf('%5.5f',P[1]) + Y=sprintf('%5.5f',P[2]) + Pt=paste('(',X,',',Y,')',sep="") + Str=Pt + cat(Str,file=Wfile,append=TRUE) + Pt0=Pt + Mojisu=Mojisu+nchar(Str) + } + T<- (Len+Naga-Lenlist[Owari]) + T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) + P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) + X=sprintf('%5.5f',P[1]) + Y=sprintf('%5.5f',P[2]) + Pt=paste('(',X,',',Y,')',sep="") + Str=Pt + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + if (Mojisu>80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<- 0 + } + } + } + cat("%\n%\n",file=Wfile,append=TRUE); +} + +######################################### + +Beginpicture<-function(ul) +{ ## Scaling is implemented + Tmp<- Doscaling(c(XMIN,YMIN)) + Xm<- Tmp[1] + Ym<- Tmp[2] + Tmp<- Doscaling(c(XMAX,YMAX)) + XM<- Tmp[1] + YM<- Tmp[2] + Dx<- XM-Xm + Dy<- YM-Ym + Sym<-".0123456789 +-*/" + SL<-Sym + OL<-"+-*/" + if (ul!=""){ + ULEN<<-ul; + } + Is<-1; + VL<-""; + Ucode<-ULEN + for (I in Looprange(1,nchar(Ucode))){ + C<-substring(Ucode,I,I); + if (length(grep(C,SL,fixed=TRUE))>0){ + if (length(grep(C,OL,fixed=TRUE))>0){ + Tmp<-substring(Ucode,Is,I-1); + Str<-paste(VL,Tmp,C,sep="") + VL<-Str + Is<-I+1; + } + } + else{ + Unit<-substring(Ucode,I,I+1); + Str<-substring(Ucode,Is,I-1); + VL<-paste(VL,Str,sep="") + break; + } + } + Valu<-eval(parse(text=VL)); + Str<-as.character(Valu); + ULEN<<- paste(Str,Unit,sep=""); + if (Unit=="cm") MilliIn<<-1000/2.54*Valu + if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10 + if (Unit=="in") MilliIn<<-1000*Valu + if (Unit=="pt") MilliIn<<-1000/72.27*Valu + if (Unit=="pc") MilliIn<<-1000/6.022*Valu + if (Unit=="bp") MilliIn<<-1000/72*Valu + if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu + if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; + if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 + MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; + Str<-paste("{\\unitlength=",ULEN,"%\n",sep=""); + cat(Str,file=Wfile,append=TRUE); + cat("\\begin{picture}%\n",file=Wfile,append=TRUE); + Str<-"("; + Tmp<-as.character(round(Dx,digits=6)); + Str<-paste(Str,Tmp,",",sep=""); + Tmp<-as.character(round(Dy,digits=6)); + Str<-paste(Str,Tmp,")(",sep=""); + Tmp<-as.character(round(Xm,digits=6)); + Str<-paste(Str,Tmp,",",sep=""); + Tmp<-as.character(round(Ym,digits=6)); + Str<-paste(Str,Tmp,")%\n",sep=""); + cat(Str,file=Wfile,append=TRUE); + Str=paste('\\linethickness{',as.character(PenThickInit/1000),'in}%',sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +######################################### + +Setpen<-function(Width) +{ + PenThick<<-round(PenThickInit*Width) + Str=paste('\\linethickness{',as.character(PenThick/1000),'in}%',sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +######################################### + +Shade<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + Iroflg=0 + if(Nargs>1){ + Iro=varargin[[Nargs]] + if(is.character(Iro)){ + Iroflg=1 + if(length(grep("{",Iro,fixed=TRUE))>0){ + Str=paste("{\\color",Iro,sep="") + } + else{ + Str=paste("{\\color{",Iro,"}",sep="") + } + } + else{ + if(length(Iro)==1){ + Kosa=Iro + } + else{ + Iroflg=1 + if(length(Iro)==4){ + Str="{\\color[cmyk]{" + } + else{ + if(length(Iro)==3){ + Str="{\\color[rgb]{" + } + } + for(J in 1:length(Iro)){ + Str=paste(Str,as.character(Iro[J]),sep="") + if(J80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<- 0 + } + } + } + if(Iroflg==1){ + Str='}%' + if(Mojisu>0){ + Str=paste('\n',Str,'\n',sep="") + }else{ + Str=paste(Str,'\n') + } + cat(Str,file=Wfile,append=TRUE) + } +} diff --git a/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r b/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r new file mode 100644 index 00000000..dc54682b --- /dev/null +++ b/texmf-dist/scripts/ketcindy/ketlib/ketpiccurrent.r @@ -0,0 +1,14614 @@ +# Copyright (C) 2014 Setsuo Takato, KETCindy Japan project team +# +#This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see + + +######################################### + +ThisVersion<- "KeTpic for R v5_2_4(20180327)" + +print(ThisVersion) + +# 20180402 +# Implicitplot greatly changed +# 20180327 +# Kyoukai debugged +# 20180317 +# IntersectcurvesPp changed and debugged +# Intersectpartseg changed (Eps00 ) +# Collectsameseg added, Collectnear commented out +# 20180306 +# PthiddenQ,Meetpoints,Sfcutparadata changed (to avoid duplications ) +# Sfbdparadata changed ( for near points in Implicitdata ) +# Envelopedata, Evlpfun added +# 20180305 +# (for surface drwaings ) Eps => Eps1 +# 2018.02.27 +# Nohiddenpara2,Crvsfparadara debugged (Eps=>Eps0) +# 2018.02.26 +# Sfcutparadata changed +# Partcrv3 debugged +# Projcurve rewritten +# Nohiddenparadata debugged +# PthiddenQ debugged +# 2018.02.24 +# Sfcutdata added ( for functions ) +# Meetpoints debugged (case Norm(PtB-PtA) Paramoncrv ) +# 2018.02.05 +# Dotprod changed ( crossprod not used ) +# Intersectpartseg changed ( case of length of result =1) +# 2018.02.04 +# Diff added ( func, withvar, (varnamevalue1,... )) +# Funvalue added ( for an expression ) +# 2018.02.02 +# Enclosing2 changed ( for distant curves, startpt option removed ) +# 2018.02.01 +# Intersectline,Intersectseg,...,Intersectcuves added +# Quicksort added +# Enclosing2 added (incomplete) +# 2018.01.29 +# Length added +# 2017.12.24 +# Objpolyhedron added +# 2017.12.23 +# Objsymb, symb3data added +# Objrecs, Objpolygon debugged +# Objthicksurf added +# 2017.12.22 +# Openobj,Closeobj,Writeobjpoint,Printobjstr,Objname,Objsurf added +# Crossprod added +# Objjoin, Objcurve, Objrecs, Objpolygon, Objsymb added +# Spacecurve debugged +# 2017.12.17 +# Setunitlen debugged ( MEMORI ) +# 2017.12.13 +# ReadOutData debugged +# 2017.12.11 +# Enclosing debugged ( appendrow -> Appendrow ) +# 2017.11.29 +# Anglemark, Arrowhead, Ovaldata debugged ( Circldeta included ) +# 2017.11.27 +# Anglemark changed ( Scilab 16.12.29) +# Plotdata,Paramplot,Spacecurve changed ( Scilab 16.12.13) +# Enclosing changed ( Scilab 16.10.09) +# Arrowhead,Arrowline changed ( Scilab 15.06.11) +# Definecolor added ( Scilab 15.05.04) +# 2017.11.26 +# Exprrot, Letterrot debugged ( `) +# 2017.11.24 +# Deqplot debugged (Looprange) +# 2017.11.20 +# InWindow debugged (for length=1) +# 2017.10.28 +# Openfile changed (Creator) +# 2017.10.23 +# ReadOutData greatly changed +# 2017.10.11 +# Drwpt debugged (Flattenlist ) +# 2017.10.08 +# Bezier debugged ( Num ) +# 2017.10.07 +# ReadOutData debugged ( for null data ) +# 2017.10.06 +# Deqdata, Deqplot added +# Connectseg remade(bug) +# 2017.09.30 +# Bezierpt, Bezier added +# 2017.09.29 +# Ptcrv debugged +# 2017.09.28 +# Openfile changed +# 2017.09.24 +# Circledata debugged +# Kyoukai changed (Eps) +# Shade updated +# 2017.09.22 +# Setcolor changed +# Plotdata,Paramplot,Spacecurve changed (N-1 -> N) +# 2017.09.21 +# Shade changed (Sci 17.01.09) +# 2017.09.17 +# Ovaldata,Assignadd changed +# Dist added +# Cicledata changed +# Bowdata debugged (Circledata,etc) + +# 2015.11.05 +# WriteOutData changed + +# 2015.10.29 +# WriteOutData changed ( endmark //// ) + +# 2015.10.24 +# ReadOutData changed ( in case of listlength=1 ) + +# 2014.12.23 +# ReadOutData added + +# 2014.12.17 +# WriteOutData added + +# 2014.0905 +# Unscaling debugged MARKLENI => MARKLEN +# 2014.03.31 +# PhHiddenData added +# 2014.03.30 +# Facesdata changed ( for Hiddendata ) +# 2014.03.23 +# MARKLEN separated, Rotate3data debugged + +# 2013.12.19 +# Openfile, Closefile, Bowname, Bownamerot + +# 2013.11.13 +# Arrowhead, Arrowheaddata + +# 2013.08.07 +# Cancoordpara added + +# 2013.08.07 +# Integrate added + +# 2013.05.20 +# Openfile changed + +# 2013.05.03 +# Tabledata, Pointdata changed +# Dividetable, Partframe added + +# 2013.02.10 +# Ketinit added + +# 2012.01.07 +# Arrowline, Arrowhead ( Cut implemented ) + +# 2011.12.18 +# Framedata ( compliant for list ) + +# 2011.12.12 +# Skeletonparadata... ( Flattellist used) + +# 2011.11.27 +# drwboxframe + +# 2011.11.07 +# metacommands added + +# 2011.11.02 +# Joingraphics ( for list structure ) + +# 2011.08.24 +# Setcolor ( c(1,0,0,0.5) etc ) +# Rotate3data ( Point is available ) + +# 2011.07.19 +# Drwline, Letter, Expr +# Drwboxplot( etc ) min,max => outliners +# Drwline ( unfinished in the case of "integer" ) + +# 2011.06.25 +# joincrvs debugged + +# synchro with ketpict2e + +# 2011.06.01 +# Bowdata debugged + +#2011.05.28 +# Ratiocmyk, Setcolor ( new ) + +#2011.04.28 +# Htickmark, Vtickmark debugged + +#2011.03.08 +# Drwboxframe debugged +# Putrow, Putrowexpr debugged (Dpos ) + +#2011.03.02 +# Tabledata ( index of hline ), PutcoL, PutcoLexpr ( "r",...) debugged +# Texcom changed ( // => backslash ) + +#2011.01.07 +# Dividegraphics, Splinedat are changed significantly +# Readtextdata is changed + +#2011.01.04 +# Derivative, Integrate are added + +#2010.12.07 +# Translatedata, Scaledata, Reflectdata changed ( efficient for vector ) +# Rotatedata changed ( deg : logical ) +# HIstplotdata, Drwhistplot ( type => freq , fpplot (added) ) + +# 2010.12.04 +# WindispT changed ( tickmark ) +# Lineplot changed ( mag=> length ) +# Plotdata debugged ( 'E=fun', 'D=') +# Enclosing changed (return PD) + +# 2010.12.02 +# WindispT changed +# Makecurves debugged + +# 2010.11.27 +# Pointdata changed ( efficient for matrix and data.frame ) +# WindispT +# Setwindow ( decide from data ) +# Assign debugged ( strsplit => gsub(fixed=T)) + +# 2010.11.20 +# Flattenlist, WindispT +# Splinedata changed( efficient for data.frame ) + +#2010.08.19 ( Maybe not finished ) +# Stripblanks +# Fullformfunc, Sf3data + +#2010.08.17 +# Phparadata, Phpersdata, Phspersdata, Phsparadata +# Facesdata, MakeveLfaceL, Menkakusi2 +# Rotate3data +# Skeletonpersdata, Skeletonpers3data, Makeskeletonpersdata +# Embed + +#2010.08.16 +# Spacecurve changed +# CameracoordCurve, Partcrv3, Projpers, CameraCurve, +# Perspt, Xyzaxpersname, Invperspt, Zparapt, Zperspt + +# 2010.08.15 +# Phcutoffdata added + +# 2010.08.13 +# Phcutdata, Spacecurve debugged +# Setangle changed + +# 2010.08.09 +# Spacecurve +# Rotate3data, Rotate3pt +# Phcutdata + +# 2010.08.08 +# Implementing 3d +# Initangle, Setangle, Setpers, SetstereoL, SetstereoR +# Mixlength +# Spaceline, Projpara, ProjCurve, Parapt +# Xyzax3data, Xyzaxparaname +# Cancoordpers, Invparapt, ProjcoordCurve +# Skeletonparadata, Skeletonpara3data, Makeskeletondata, Kukannozoki + +# 2010.07.25 +# Rotatedata changed +# Drwline changed (list of list) + +# 2010.04.09 +# Stat package added + +# 2010.04.02 +# Putcolexpr, Putrowexpr + +# 2010.04.02 + +# Windisp, Op changed +# Execmd added +# Texnewcmd, Texrenewcmd, Texend, +# Texctr, Texnewctr, Texsetctr +# Kyoukai debugged + +# 2010.01.20 +# Partcrv, Makeshasen : debugged + +# 2010.01.23 +# Ovaldata, Ovalbox added + +# 2010.01.27 +# Readtextdata changed +# Putrow, PutcoL debugged ( Putcol is OK) + +# 2010.01.31 +# Writetextdata added + +# 2010.02.12 +# Texvalctr, Texthectr added + +# 2010.02.22 +# Execmd changed + +# 2010.02.23 +# Op, Windisp changed + +# 2010.02.24 +# Execmd changed + +# 2010.03.07 +# Dotfilldata (Kosa>1) + +# 2010.03.21 +# Mixjoin +# Koutenlist (bug) + + +# 2010.03.24 +# Arrowhead ( bug in the case of "l" ) + +# 2010.03.28 +# Tabledata +# Diagcelldata ( New ) + +# 2010.03.30 +# Tabledata + +########################################### + +XMIN<- -5 +XMAX<- 5 +YMIN<- -5 ; YMAX<- 5 +ZIKU<- "line" +ARROWSIZE<- 1 +XNAME<- "$x$" +XPOS<- "e" +YNAME<- "$y$" +YPOS<- "n" +ONAME<- "O" +OPOS<- "sw" +ULEN<- "1cm" +MilliIn<- 1/2.54*1000 +PenThick<- round(MilliIn*0.02) +PenThickInit<- PenThick +TenSizeInit<<- 0.02*2 #17.10.07 +TenSize<- TenSizeInit +Wfile<-"" +MEMORI<- 0.05 +MEMORIInit<- MEMORI +MEMORINow<- MEMORI +MARKLEN<- 0.05 +MARKLENInit<- MARKLEN +MARKLENNow<- MARKLEN +GENTEN<- c(0,0) +YaSize<- 1 +YaAngle<- 18 +YaPosition<- 1 +YaThick<- 1 +YaStyle<- "tf" +PHI<- 30*pi/180 +THETA<- 60*pi/180 +FocusPoint<- c(0,0,0) +EyePoint<- c(5,5,5) +ASSIGNLIST<- list("`","'") + +SCALEX<- 1 +SCALEY<- 1 +LOGX<- 0 +LOGY<- 0 + +TEXFORLEVEL<- 0 +TEXFORLAST<- list() + +####################### + +Ketinit<- function(){ +XMIN<<- -5 +XMAX<<- 5 +YMIN<<- -5 ; YMAX<<- 5 +ZIKU<<- "line" +ARROWSIZE<<- 1 +XNAME<<- "$x$" +XPOS<<- "e" +YNAME<<- "$y$" +YPOS<<- "n" +ONAME<<- "O" +OPOS<<- "sw" +ULEN<<- "1cm" +MilliIn<<- 1/2.54*1000 +PenThick<<- round(MilliIn*0.02) +PenThickInit<<- PenThick +TenSizeInit<<- 0.02*2 #17.10.07 +TenSize<<- TenSizeInit +Wfile<<-"" +MEMORI<<- 0.05 +MEMORIInit<<- MEMORI +MEMORINow<<- MEMORI +MARKLEN<<- 0.05 +MARKLENInit<<- MARKLEN +MARKLENNow<<- MARKLEN +GENTEN<<- c(0,0) +YaSize<<- 1 +YaAngle<<- 18 +YaPosition<<- 1 +YaThick<<- 1 +YaStyle<<- "tf" +PHI<<- 30*pi/180 +THETA<<- 60*pi/180 +FocusPoint<<- c(0,0,0) +EyePoint<<- c(5,5,5) +ASSIGNLIST<<- list("`","'") + +SCALEX<<- 1 +SCALEY<<- 1 +LOGX<<- 0 +LOGY<<- 0 + +TEXFORLEVEL<<- 0 +TEXFORLAST<<- list() +} + +#------------------------------------------------------- + +Appendrow<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Out<-c() + Nc<- 0 + for (I in 1:Nargs) + { + Dt<- varargin[[I]] + Nc<- max(Nc,Ncol(Dt)) + if(class(Dt)=="matrix") Dt<-as.numeric(t(Dt)) + Out<- c(Out,Dt) + } + if(Nc>0) + { + Out<-matrix(Out, nrow=Nc) + Out<-t(Out) + } + else + { + Out<-c() + } + return(Out) +} + +Datalength<-function(Data) +{ + if(length(Data)==0) return(0) + if(mode(Data)=="numeric") return(Nrow(Data)) + if(mode(Data)=="character") return(nchar(Data)) + if(mode(Data)=="list") return(length(Data)) +} + +Crossprod<- function (a,b){ # 17.12.22 + if(length(a)==3){ + Tmp1=a[2]*b[3]-a[3]*b[2] + Tmp2=a[3]*b[1]-a[1]*b[3] + Tmp3=a[1]*b[2]-a[2]*b[1] + Out=c(Tmp1,Tmp2,Tmp3) + }else{ + Out=a[1]*b[2]-a[2]*b[1] + } + return(Out) +} + +Dotprod<-function(a,b){ # 18.02.05 + nn=min(length(a),length(b)) + out=0 + for(jj in Looprange(1,nn)){ + out=out+a[jj]*b[jj] + } + return(out) +} + +Dist<- function(...) # 17.09.17 +{ + varargin<- list(...) + a=varargin[[1]] + if(length(varargin)==1){ + tmp=sqrt(Dotprod(a,a)) + return(as.vector(tmp)) + } + else{ + b=varargin[[2]] + tmp=sqrt(Dotprod(b-a,b-a)) + retun(as.vector(tmp)) + } +} + +Member<-function(A,L) +{ + N<-length(L); + if(length(N)==0) return(FALSE) + for (I in 1:N) + { + if(class(L)=="list") + { + Tmp<-L[[I]] + } + else + { + Tmp<-L[I] + } + if(mode(A)=="numeric") + { + if(Norm(A-Tmp)==0) return(TRUE) + } + else + { + if(A==Tmp) return(TRUE) + } + } + return(FALSE) +} + +Norm<-function(V) +{ + Tmp=Dotprod(V,V) #18.02.09 +# Tmp<-as.vector(V); +# Tmp<-crossprod(Tmp,Tmp) + Tmp<-sqrt(Tmp) +# as.numeric(Tmp) +} + +Ncol<-function(P) +{ + if(class(P)=="matrix") return(ncol(P)) + else return(length(P)) +} + +Nrow<-function(P) +{ + if(length(P)==0) return(0) + if(class(P)=="matrix") return(nrow(P)) + else return(1) +} + +Looprange<- function(a,b) +{ +if(a<=b) return(a:b) +return(c()) +} + +Stripblanks<- function(Ch){ + Tmp<- gsub(" ","",Ch,fixed=TRUE) + return(Tmp) +} + +Quicksort<- function(seqL,key){ #18.02.01 + if(length(seqL)<2){ + out=seqL + }else{ + tmp1=Op(1,seqL) + tmp2=Op(2,seqL) + if(Op(key,tmp1)>=Op(key,tmp2)){ + pivot = tmp1 + }else{ + pivot=tmp2 + } + left = list() + right = list() + for(ii in 1:length(seqL)){ + tmp=Op(ii,seqL) + if(Op(key,tmp)< Op(key,pivot)){ + left=c(left,list(tmp)) + }else{ + right=c(right,list(tmp)) + } + } + left = Quicksort(left,key) + right = Quicksort(right,key) + out=c(left,right) + } + return(out) +} + +Derivative<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Fstr<- varargin[[1]] + Vstr<- varargin[[2]] + NvaL<- length(Vstr) + Flg<- 0 + if(Nargs>=3){ + VaL<- varargin[[3]] + Flg<- 1 + } + Str<- paste("deriv(~",Fstr,",c('",Vstr[1],"'",sep="") + for(J in Looprange(2,NvaL)){ + Str<- paste(Str,",'",Vstr[J],"'",sep="") + } + Str<- paste(Str,")",sep="") + if(NvaL<=3){ + Str<- paste(Str,",func=TRUE)",sep="") + } + else{ + Str<- paste(Str,")",sep="") + } + f<- eval(parse(text=Str)) + if(Flg==1){ + if(NvaL<=3){ + if(NvaL==1){V<- f(VaL[1])} + if(NvaL==2){V<- f(VaL[1],VaL[2])} + if(NvaL==3){V<- f(VaL[1],VaL[2],VaL[3])} + } + else{ + for(J in 1:NvaL){ + Tmp<- paste(Vstr[J],'<-',as.character(VaL[J])) + eval(parse(text=Tmp)) + } + V<- eval(f) + } + Out<- attr(V,'gradient') + Out<- Out[1,] + } + else{ + Out<- f + } + return(Out) +} + +Diff<- function(...){ #18.02.04 + varargin=list(...) + Nargs=length(varargin) + fun=varargin[[1]] + withvar=varargin[[2]] + tmp=paste("f<- expression(",fun,")",sep="") + eval(parse(text=tmp)) + nn=nchar(withvar) + for(jj in Looprange(1,nn)){ + tmp=substring(withvar,jj,jj) + f=D(f,tmp) + } + var=c() + val="" + for(jj in Looprange(3,Nargs)){ + tmp=strsplit(varargin[[jj]],"=") + var=c(var,tmp[[1]][1]) + val=paste(val,tmp[[1]][2],",",sep="") + } + if(Length(val)>1){ + val=substring(val,1,Length(val)-1) + f=deriv(f,var,func=TRUE) + tmp=paste("out=f(",val,")",sep="") + out=eval(parse(text=tmp)) + return(out[1]) + }else{ + return(f) + } +} + +Funvalue<- function(...){ + varargin=list(...) + Nargs=length(varargin) + df=varargin[[1]] + var=c() + val="" + for(jj in Looprange(2,Nargs)){ + tmp=strsplit(varargin[[jj]],"=") + var=c(var,tmp[[1]][1]) + val=paste(val,tmp[[1]][2],",",sep="") + } + val=substring(val,1,Length(val)-1) + dfun=deriv(df,var,func=TRUE) + tmp=paste("out=dfun(",val,")",sep="") + eval(parse(text=tmp)) + return(out[1]) +} + +Integrate<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Fstr<- varargin[[1]] + Vstr<- varargin[[2]] + IntvL<- varargin[[3]] + Str<- 'Tmpfun<- function(' + Str<- paste(Str,Vstr,'){',sep='') + Str<- paste(Str,Fstr,'}',sep='') + eval(parse(text=Str)) + Tmpfunv<- function(x){sapply(x,Tmpfun)} + Out<- 0 + for (J in 1:(length(IntvL)-1)){ + Tmp<- integrate(Tmpfunv,IntvL[J],IntvL[J+1]) + Out<- Out+Tmp[[1]] + } + return(Out) +} + +#-------------------------------------- + +######################### + +Anglemark<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-3) + PA<- varargin[[1]] + PB<- varargin[[2]] + PC=varargin[[3]] + r <- 0.5 + if(Nargs>=4){ + r<- varargin[[4]]*r + } + Out=c() + if(r>min(Norm(PA-PB),Norm(PC-PB))){ + return(Out) + } + Cir<- Circledata(c(PB,r)) #17.11.29 + Tmp<- IntersectcrvsPp(Cir,Listplot(PA,PB)) + P1<- Op(2,Op(1,Tmp)) + Tmp<- IntersectcrvsPp(Cir,Listplot(PC,PB)) + P2<- Op(2,Op(1,Tmp)) + if(abs(P1-P2)1){ + R<- Tmp + } + else{ + if(Flg==0){ + Ookisa<- Ookisa*Tmp + } + if(Flg==1){ + if(Tmp<5){ + Hiraki<- Tmp*Hiraki + } + else{ + Hiraki<- Tmp + } + } + if(Flg==2){ + R<- P+Tmp*(Q-P) + } + else{ + R<- P+Yapos*(Q-P) + } + if(Flg==3){ + Futosa<- Tmp + } + Flg<- Flg+1 + } + } + if(mode(Tmp)=="character"){ + Tmp<- grep("=", Tmp) + if(length(Tmp)>0){ + eval(parse(text=Tmp)) + Futosa<- Futosa*Thickness + R<- P+Position*(Q-P) + } + else{ + Str<- Tmp + } + } + } + Tmp1<- Listplot(c(P,Q)) + Tmp2<- Arrowheaddata(R,Q-P,Ookisa,Hiraki,Futosa,Str) + Out<- Joingraphics(Tmp1,Tmp2) +} + +###################################### + +# 2013.11.13 No Intersect debugged + +Arrowhead<-function(...) +{ ## Scaling is implemented + ## 12.01.08 Kirikomi + varargin<-list(...) + Nargs<-length(varargin) + P<-varargin[[1]] + Houkou<-varargin[[2]] + Ookisa<-0.2*YaSize + Hiraki<-YaAngle + Futosa<-0.5*YaThick + Cut<- 0 + Str<-YaStyle + Flg<- 0 + for (I in Looprange(3,Nargs)){ + Tmp<-varargin[[I]] + if(is.character(Tmp)){ + Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from + if(length(Equal)>0){ + Tmp1<- strsplit(Tmp,"=",fixed=TRUE) + Tmp2<- Tmp1[[1]] + if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ + Tmp<- paste("Cut=",Tmp2[2],sep="") + eval(parse(text=Tmp)) + } + }else{ + Str<- Tmp + } # 12.01.07 until + } + if(is.numeric(Tmp) && length(Tmp)==1){ + if(Flg==0) Ookisa<-Ookisa*Tmp + if(Flg==1){ + if(Tmp<5) Hiraki<-Tmp*Hiraki + else Hiraki<-Tmp + } + if(Flg==2) Futosa<-Tmp + Flg<-Flg+1 + } + } + Ookisa<-1000/2.54/MilliIn*Ookisa + Theta<-Hiraki*pi/180 + if(Nrow(Houkou)>1){ + P<- Doscaling(P) + Houkou<- Doscaling(Houkou) + Tmp<-Nearestpt(P,Houkou) + A<-Tmp[[1]] + I<-floor(Tmp[[2]]) + G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 + Flg<- 0 # 13.11.13 + JL<-seq(I,1,by=-1) + for (J in JL){ + B<-Ptcrv(J,Houkou) + Tmp<-IntersectcrvsPp(Listplot(list(A,B)),G) + if(length(Tmp)>0){ + Flg<- 1 + break + } + A<-B + } + if(Flg==0){ # 13.11.13 + print("Arrowhead may be too large (no intersect)") + return(P) + } + Houkou<-P-Op(1,Tmp[[1]]) + Houkou<- Unscaling(Houkou) + P<- Unscaling(P) + } + P<- Doscaling(P) + Houkou<- Doscaling(Houkou) + Ev<--1/Norm(Houkou)*Houkou + Nv<-c(-Ev[2],Ev[1]) + if(length(grep("c",Str))>0){ + P<-P-0.5*Ookisa*cos(Theta)*Ev + } + if(length(grep("b",Str))>0){ + P<-P-Ookisa*cos(Theta)*Ev + } + A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv + B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv + if(length(grep("l",Str))>0){ + Tmp<-Listplot(list(A,P,B)) + Tmp1<- Unscaling(Tmp) + Drwline(Tmp1,Futosa) + } + else{ + C<- P+(1-Cut)*((A+B)/2-P) # 12.01.07 + Tmp<- Listplot(list(A,P,B,C,A)) # 12.01.07 + Tmp1<- Unscaling(Tmp) + Shade(Tmp1) + Tmp=Listplot(c(A,P,B,C,A,P)) # 15.6.20 + Tmp1=Unscaling(Tmp) + Drwline(Tmp1,0.1) # 15.06.11, 15.06.14 + } +} + +############################################ + +# 2013.11.13 No intersect debugged + +Arrowheaddata<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + P<- varargin[[1]] + Houkou<- varargin[[2]] + Ookisa<- 0.2*YaSize + Hiraki<- YaAngle + Futosa<- 0 + Thickness<- 1 + Str<- YaStyle + Flg<- 0 + for (I in Looprange(3,Nargs)){ + Tmp<-varargin[[I]] + if(mode(Tmp)=="character"){ + Tmp1<-grep("=",Tmp) + if(length(Tmp1)>0){ + eval(parse(text=Tmp)) + Futosa<- Thickness + } + else{ + Str<- Tmp + } + } + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + if(Flg==0) Ookisa<-Ookisa*Tmp + if(Flg==1){ + if(Tmp<5) Hiraki<-Tmp*Hiraki + else Hiraki<-Tmp + } + if(Flg==2) Futosa<-Tmp + Flg<-Flg+1 + } + } + Theta<- Hiraki*pi/180 + if(Nrow(Houkou)>1){ + P<- Doscaling(P) + Houkou<- Doscaling(Houkou) + Tmp<-Nearestpt(P,Houkou) + A<-Tmp[[1]] + I<-floor(Tmp[[2]]) + G<-Circledata(c(P,Ookisa*cos(Theta)),N=10) #17.11.29 + Flg<- 0 # 13.11.13 + JL<-seq(I,1,by=-1) + for (J in JL){ + B<- Ptcrv(J,Houkou) + Tmp<- IntersectcrvsPp(Listplot(list(A,B)),G) + if(length(Tmp)>0){ + Flg<- 1 + break + } + A<-B + } + if(Flg==0){ # 13.11.13 + print("Arrowhead may be too large (no intersect)") + return(P) + } + Houkou<-P-Op(1,Tmp[[1]]) + Houkou<- Unscaling(Houkou) + P<- Unscaling(P) + } + P<- Doscaling(P) + Houkou<- Doscaling(Houkou) + Ev<- -1/Norm(Houkou)*Houkou + Nv<- c(-Ev[2],Ev[1]) + if(length(grep("c",Str))>0){ + P<-P-0.5*Ookisa*cos(Theta)*Ev + } + if(length(grep("b",Str))>0){ + P<-P-Ookisa*cos(Theta)*Ev + } + A<-P+Ookisa*cos(Theta)*Ev+Ookisa*sin(Theta)*Nv + B<-P+Ookisa*cos(Theta)*Ev-Ookisa*sin(Theta)*Nv + Tmp<- Listplot(A,P,B) + Out<- Unscaling(Tmp) + return(Out) +} + +########################################## + +Arrowline<- function(...) +{ # 12.01.07 kirikomi + varargin<- list(...) + Nargs<- length(varargin) + P<- varargin[[1]] + Q<- varargin[[2]] + Futosa<- YaThick + Ookisa<- YaSize + Hiraki<- YaAngle + Yapos<- YaPosition + Cutstr<- "Cut=0" + Str<- YaStyle + Flg<- 0 + for (I in Looprange(3,Nargs)){ + Tmp<- varargin[[I]] + if(is.character(Tmp)){ + Equal<- grep("=",Tmp,fixed=TRUE) # 12.01.07 from + if(length(Equal)>0){ + Tmp1<- strsplit(Tmp,"=") + Tmp2<- Tmp1[[1]] + if(Tmp2[1]=="Cut" || Tmp2[1]=="cut"){ + Tmp<- paste("Cut=", Tmp2[2],sep="") + Cutstr<- Tmp + } + } + else{ + Str<- Tmp + } # 12.01.07 until + } + if(is.numeric(Tmp) && length(Tmp)==1){ + if(Flg==0) Ookisa<- Ookisa*Tmp + if(Flg==1){ + if(Tmp<5) Hiraki<- Tmp*Hiraki + else Hiraki<- Tmp + } + if(Flg==2) Yapos<- Tmp + if(Flg==3) Futosa<- Tmp + Flg<- Flg+1 + } + } + R<- P+Yapos*(Q-P) + Tmp=Q-Unscaling(0.2*Ookisa/2*(Q-P)/Norm(Q-P)) # 15.10.24 + Drwline(Listplot(c(P,Tmp)),Futosa) + Arrowhead(R,Q-P,Ookisa,Hiraki,Futosa,Cutstr,Str) +} + +######################################### + +Assign<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + ASSIGNLIST<<- list("`",Prime()) + Out<- ASSIGNLIST + return() +# return("Assign reset done"); + } + L<- list("`","'") + if(Nargs%%2==0){ + L<- Mixjoin(L,varargin) + ASSIGNLIST<<- L + Out<- L + return() +# return("Assign set done"); + } + if(Nargs==1){ + Fnstr<- varargin[[1]] + if(nchar(Fnstr)==0){ # case of "" + L<- ASSIGNLIST + Out<- c() + for (I in seq(1,length(L),by=2)){ + Tmp1<- L[[I]] + Tmp2<- L[[I+1]] + if(length(Tmp2)==1){ + Tmp3<- as.character(Tmp2) + } + else{ + if(mode(Tmp2)=="character"){ + Tmp3<- Tmp2 + } + else if(mode(Tmp2)=="list"){ + Tmp3<- makeliststr(Tmp2) + } + else if(mode(Tmp2)=="numeric"){ + Tmp3<- "c(" + for (J in Looprange(1,length(Tmp2))){ + Tmp3<- paste(Tmp3,as.character(Tmp2[J]),sep="") + if(J0){ + if(length(grep(C,OL))>0){ + Tmp<-substring(Ucode,Is,I-1); + Str<-paste(VL,Tmp,C,sep="") + VL<-Str + Is<-I+1; + } + } + else{ + Unit<-substring(Ucode,I,I+1) + Str<-substring(Ucode,Is,I-1) + VL<-paste(VL,Str,sep="") + break; + } + } + Valu<-eval(parse(text=VL)) + Str<-as.character(Valu); + ULEN<<- paste(Str,Unit,sep="") + if(Unit=="cm") MilliIn<<-1000/2.54*Valu + if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10 + if(Unit=="in") MilliIn<<-1000*Valu + if(Unit=="pt") MilliIn<<-1000/72.27*Valu + if(Unit=="pc") MilliIn<<-1000/6.022*Valu + if(Unit=="bp") MilliIn<<-1000/72*Valu + if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu + if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; + if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 + MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; + Str<-paste("{\\unitlength=",ULEN,"%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + cat("\\begin{picture}%\n",file=Wfile,append=TRUE) + Str<-"(" + Tmp<-as.character(round(Dx,digits=6)) + Str<-paste(Str,Tmp,",",sep="") + Tmp<-as.character(round(Dy,digits=6)) + Str<-paste(Str,Tmp,")(",sep="") + Tmp<-as.character(round(Xm,digits=6)) + Str<-paste(Str,Tmp,",",sep="") + Tmp<-as.character(round(Ym,digits=6)) + Str<-paste(Str,Tmp,")%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + Str<-paste("\\special{pn ",as.character(PenThickInit),"}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +################################################# + +Bowdata<- function(...) #17.09.17 +{ + varargin <- list(...) + Nargs <- length(varargin) + PA <- varargin[[1]] + PB <- varargin[[2]] + Cut <- 0 + D <- 1/2*Norm(PB-PA) + if(Nargs>=3) { + H <- varargin[[3]]*D*0.2 + } + else { + H <- D*0.2 + } + H <- min(H,D) + if(Nargs>=4){ + Cut <- varargin[[4]] + } + Ydata <- MakeBowdata(PA,PB,H) + C <- Op(1,Ydata) + r <- Op(2,Ydata) + R1 <- Op(3,Ydata) + R2 <- Op(4,Ydata) + Rng <- paste("R=c(",as.character(R1),",",as.character(R2),")",sep="") + Theta <- (R1+R2)*0.5 + BOWMIDDLE <<- list(c(C[1]+r*cos(Theta),C[2]+r*sin(Theta)),Theta) + M <- Op(1,BOWMIDDLE) + ThetaM <- Op(2,BOWMIDDLE) + BOWSTART <<- PA + BOWEND <<- PB + if(Cut==0){ + Pd<- Circledata(c(C,r),Rng) + } + else{ + Alpha <- R1; Beta <- ThetaM-Cut/(2*r) + Rng <- paste("Rng=c(",as.character(Alpha),",",as.character(Beta),")",sep="") + Pd <- Circledata(c(C,r),Rng) + Alpha <- ThetaM+Cut/(2*r); Beta <- R2 + Rng <- paste("R=c(",as.character(Alpha),",",as.character(Beta),")",sep="") + Tmp <- Circledata(c(C,r),Rng) + Pd <- Appendrow(Pd,c(Inf,Inf),Tmp) + } +} + +Bowmiddle <- function(...) +{ + varargin <- list(...) + Nargs <- length(varargin) + if( Nargs==0) { + M <- BOWMIDDLE + return(M) + } + if(Nargs==1) { + Bdata <- varargin[[1]] + A <- Bdata[1,] + Dind <- Dataindex(Bdata) + Dc <- Nrow(Dind) + Tmp <- Dind[Dc,2] + B <- Bdata[Tmp,] + if(Dc==1) { + Tmp1 <- round(Tmp/2) + } + else { + Tmp1 <- Dind[1,2] + } + D <- Bdata[Tmp1,] + B <- B-A + D <- D-A + Tmp1 <- B[1]*D[2]-D[1]*B[2] + Tmp2 <- (Norm(B)^2*D[2]-B[2]*Norm(D)^2)/2 + Tmp3 <- -(Norm(B)^2*D[1]-B[1]*Norm(D)^2)/2 + C <- c(Tmp2,Tmp3)/Tmp1+A + R <- Norm(C-A) + B <- B+A + V <- (A+B)/2-C + V <- V/Norm(V) + M <- C+R*V + } + else { + A <- varargin[[1]]; B <- varargin[[2]] + D <- 1/2*Norm(B-A) + H <- 0.2*D; + if(length(varargin)>=3) { + Tmp <- varargin[[3]] + H <- Tmp*D*0.2 + } + H <- min(H,D) + Ydata <- MakeBowdata(A,B,H) + C <- Op(1,Ydata) + R <- Op(2,Ydata) + T <- (Op(3,Ydata)+Op(4,Ydata))/2 + P <- C+R*c(cos(T),sin(T)) + #M <- list(P,T) + M <- P + } + return(M) +} + +########################## +# 13.12.19 small movement supported + +Bowname<- function(...) +{ + varargin <- list(...) + Nargs <- length(varargin) + Siki <- varargin[[Nargs]] + Nargs<- Nargs-1 + Dr<- "c" + if(Nargs>=1){ + Tmp<- varargin[[Nargs]] + if(is.character(Tmp)){ + Dr<- Tmp + Nargs<- Nargs-1 + } + } + if(Nargs==0){ + Siki <- varargin[[1]] + P <- Op(1,BOWMIDDLE) + } + else if(Nargs==1){ + Bdata <- varargin[[1]] + P <- Bowmiddle(Bdata) + } + else{ + A <- varargin[[1]]; B <- varargin[[2]] + D <- 1/2*Norm(B-A) + Tmp <- varargin[[3]] + if(is.character(Tmp)){ + H <- D*0.2 + } + else { + H <- Tmp*D*0.2 + } + H <- min(H,D) + Ydata <- MakeBowdata(A,B,H) + Tmp <- Bowmiddle(Ydata) + P <- Op(1,Tmp) + } + Expr(P,Dr,Siki) +} + +########################## +# 13.12.19 small movement supported +# A,B, ... no longer supported + +Bownamerot <- function(...) +{ + varargin <- list(...) + Nargs <- length(varargin) + Eps <- 10^(-6) + Flg <- 1 + Tmp <- varargin[[Nargs]] + if(is.numeric(Tmp) && length(Tmp)==1 && Tmp<0){ + Flg <- Tmp + Nargs <- Nargs-1 + } + Siki <- varargin[[Nargs]] + Nargs<- Nargs-1 + Dr<- "c" + if(Nargs>=1){ + Tmp<- varargin[[Nargs]] + if(is.character(Tmp)){ + Dr<- Tmp + Nargs<- Nargs-1 + } + } + if(Nargs==0) { + P <- Op(1,BOWMIDDLE) + A <- BOWSTART + B <- BOWEND + } + else{ + Bdata<- varargin[[1]] + P<- Bowmiddle(Bdata) + A=Bdata[1,] + B=Bdata[nrow(Bdata),] + Tm<- 0; Tv<- 0 + if(Nargs>1){ + Tm<- varargin[[2]] + if(Nargs>2){ + Tv<- varargin[[3]] + } + } + } +# else if(Nargs==2) { +# Bdata <- varargin[[1]] +# P <- Bowmiddle(Bdata) +# A <- Bdata[1,] +# B <- Bdata[Nrow(Bdata),] +# Siki <- varargin[[2]] +# } +# else { +# A <- varargin[[1]]; B <- varargin[[2]] +# D <- 1/2*Norm(B-A) +# Tmp <- varargin[[3]] +# if(mode(Tmp)=="character") { +# H <- 0.2*D; Siki <- Tmp +# } +# else { +# H <- Tmp*D*0.2; Siki <- varargin[[4]] +# } +# H <- min(H,D) +# Ydata <- MakeBowdata(A,B,H) +# C <- Op(1,Ydata) +# R <- Op(2,Ydata) +# T <- (Op(3,Ydata)+Op(4,Ydata))/2 +# P <- C+R*c(cos(T),sin(T)) +# } + if(A[1]>B[1]+Eps){ + Tmp <- A + A <- B + B <- Tmp + } + if(Flg>0) { + Tmp <- B-A + } + else{ + Tmp <- A-B + } + Exprrot(P,Tmp,Tm,Tv,Siki) +} + +CalcHeight<-function(Hoko,Moji) +{ + D<-0 + H<-substring(Hoko,1,1) + Tmp<-paste("\\settoheight{\\Height}{",Moji,"}",sep="") + Str<-c(Tmp) + Tmp=paste("\\settodepth{\\Depth}{",Moji,"}",sep="") + Str<-c(Str,Tmp) + if(H=="n") Str<-c(Str,"\\setlength{\\Height}{\\Depth}") + if(H=="s") Str<-c(Str,"\\setlength{\\Height}{-\\Height}") + if(H=="c") + { + Str<-c(Str,"\\setlength{\\Height}{-0.5\\Height}") + Str<-c(Str,"\\setlength{\\Depth}{0.5\\Depth}") + Str<-c(Str,"\\addtolength{\\Height}{\\Depth}") + } + for (I in 1:length(Str)) cat(Str[I],file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +######################### + +CalcWidth<-function(Hoko,Moji) +{ + D<-0; + H<-substring(Hoko,2,2) + if(H=="e") D<-0 + if(H=="w") D<--1.0 + if(H=="c") D<--0.5 + Str1<-paste("\\settowidth{\\Width}{",Moji,"}",sep="") + Tmp<-as.character(D) + Str2<-paste("\\setlength{\\Width}{",Tmp,"\\Width}",sep="") + cat(Str1,file=Wfile,append=TRUE) + cat(Str2,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +######################### +# 17.09.17 +# 17.09.24 + +Circledata<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Cr<- varargin[[1]] + C=Cr[1:2] + if(length(Cr)==4){ + ra=Norm(C-Cr[3:4]) + Nop=2 + } + else{ + ra=Cr[3] + Nop=2 + } + R=c(0,2*pi) + N=50 + for (I in Looprange(Nop,Nargs)){ + Tmp<- varargin[[I]] + if(is.character(Tmp)){ + Tmp1=regexpr("=",Tmp) #17.09.24from + Tmp2=substring(Tmp,Tmp1+1,nchar(Tmp)) + Tmp1=substring(Tmp,1,Tmp1) + Tmp1=gsub("NUM", "N", toupper(Tmp1)) + Tmp1=gsub("RNG", "R", Tmp1) + Tmp=paste(Tmp1,Tmp2,sep="") #17.09.24until + eval(parse(text=Tmp)) + } + } + Dt<- (R[2]-R[1])/N + T <- seq(R[1],R[2],by=Dt) + X <- C[1]+ra*cos(T) + Y <- C[2]+ra*sin(T) + XY<- c(X,Y) + P<- matrix(XY,ncol=2) + return(P) +} + +######################### +# 13.12.19 + +Closefile<-function(...) +{ + varargin<- list(...) + if(length(varargin)>=1){ + Pa<- varargin[[1]] + if(is.character(Pa)){ + if(Pa=="1") Endpicture(1) + if(Pa=="0") Endpicture(0) + } + } + Wfile<<-"" +} + +######################### + +Closepar<- function() +{ + S<- "%\n\\end{minipage}" + cat(S,file=Wfile,append=TRUE) + Closephr() +} + + +#################################### + +Closephr<- function() +{ + cat("%\n}%\n",file=Wfile,append=TRUE) +} + +##################################### + +Dataindex<-function(P) +{ + # Inf;Inf : Terminator + Ndm<-c() + if(length(P)==0) return(Ndm) + N1<-1 + Flg<-0 + for (J in 1:Nrow(P)) + { + if(P[J,1]==Inf) + { + Ndm<-Appendrow(Ndm,c(N1,J-1)) + N1<-J+1; + if(P[N1,1]==Inf) + { + Flg<-1; + break; + } + } + } + if(Flg==0) + { + Ndm<-Appendrow(Ndm,c(N1,Nrow(P))) + } + if(class(Ndm)=="numeric") + { + Tmp<-matrix(Ndm,nrow=1) + Ndm<- Tmp + } + return(Ndm) +} + +################################ + +Dashline<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Nall<- Nargs; Sen<- 1 ; Gap<- 1 + Tmp<- varargin[[Nall]] + if(mode(Tmp)=="numeric" && length(Tmp)==1 && Tmp>0){ + Tmp1<- varargin[[Nall-1]] + if(mode(Tmp1)=="numeric" && length(Tmp1)==1 && Tmp1>0){ + Sen<- Tmp1; Gap<- Tmp + Nall<- Nall-2 + } + else{ + Sen<- Tmp; Gap<- Sen + Nall<- Nall-1 + } + } + Sen<- 1000/2.54/MilliIn*Sen + Gap<- 1000/2.54/MilliIn*Gap + for (N in Looprange(1,Nall)){ + Pdata<- varargin[[N]] + if(is.numeric(Pdata)==1){ + Pdata<- list(Pdata) + } + for (II in 1:length(Pdata)){ + Figdata<- Op(II,Pdata) + Makehasen(Figdata,Sen,Gap,0) + } + } +} + +############################################## +# 17.11.27 + +Definecolor<- function(Name,Data){ + Tmp1=length(Data) + if((Tmp1<3) || (Tmp1>4)){ + cat("Size of data should be 3 or 4.") + return() + } + if(Tmp1==4){ + Tp="cmyk" + }else{ + Tp="rgb" + } + Tmp="" + for(J in 1:Tmp1){ + Tmp=paste(Tmp, as.character(Data[J]),sep="") + if(J0){ + for (J in Looprange(1,length(Sha))){ + Tmp<- Op(J,Sha) + Q<- Tmp[1,] + R<- Tmp[2,] + Tmp<- Dotprod(Q-P,V)/Kankaku + K1<- ceiling(Tmp) + if(abs(K1-Tmp)0){ + for (J in 1:length(Sha)){ + Tmp<- Op(J,Sha) + Q<- Tmp[1,] + R<- Tmp[2,] + Tmp<- Dotprod(Q-P,V)/Kankaku + K1<- ceiling(Tmp) + if(abs(K1-Tmp)0){ + for (J in 1:length(Sha)){ + Tmp<- Op(J,Sha) + Q<- Tmp[1,] + R<- Tmp[2,] + Tmp<- Dotprod(Q-P,V)/Kankaku + K1<- ceiling(Tmp) + if(abs(K1-Tmp) 1) { + Seg <- Lenall/(Nten-1) + } + else { + Seg <- Lenall + } + Eps <- 10^(-6)*Seg + PPd<-c() + Hajime <- 1 + for (I in Looprange(0,Nten-1)) { + Len <- Seg*I + if(I>0) { + J <- Hajime + while( Len>=Lenlist[J]+Eps) { + J <- J+1 + } + Hajime <- J-1 + } + T <- (Len-Lenlist[Hajime])/ + (Lenlist[Hajime+1]-Lenlist[Hajime]) + P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) + PPd<-Appendrow(PPd,P) + if(I==Nten-1) { + if(Norm(P-Data[1,])80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<-0 + } + } + if(Mojisu!=0){ + cat("%\n",file=Wfile,append=TRUE) + } + cat("\\special{fp}%\n",file=Wfile,append=TRUE) + } + } + } + Str<-"%" + if(Thick>0){ + Tmp<-PenThick/PenThickInit + Setpen(Tmp) + } +} + +########################################### + +Drwpt<-function(...) +{ ## Scaling is implemented + varargin<-list(...) + Nargs<-length(varargin) + if(TenSize>TenSizeInit){ + N<- round(6*sqrt(TenSize/TenSizeInit)) + } + else{ + N<-4 + } + Tmp<- varargin[[Nargs]] + if(mode(Tmp)=="numeric"){ + if(length(Tmp)>1){ + Kosa<- 1; All<- Nargs + } + else{ + Kosa<- Tmp; All<- Nargs-1 + } + } + else if(mode(Tmp)=="list"){ + Kosa<- 1; All<- Nargs + } + CL<-c() + for (J in 0:N){ + Tmp<- TenSize*0.5*1000/2.54/MilliIn + Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) + CL<- append(CL,Tmp) + } + CL<- matrix(CL,nrow=2) + CL<- t(CL) + for (II in Looprange(1,All)){ + MS<- varargin[[II]] + MS=Flattenlist(MS) #17.10.11 + if(mode(MS)=="numeric"){ + MS<- list(MS) + } + for (I in Looprange(1,length(MS))){ + P<- MS[[I]] + if(InWindow(P)!="i") next + P<- Doscaling(P) + PL<-c() + for (J in 0:N){ + PL<- c(PL,P+CL[J+1,]) + } + PL<-matrix(PL,nrow=2) + PL<-t(PL) + Mojisu<-0 + for (J in 1:Nrow(PL)){ + Q<- PL[J,] + X<- as.character(round(MilliIn*Q[1])) + Y<- as.character(-round(MilliIn*Q[2])) + Str<- paste("\\special{pa ",X," ",Y,"}",sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + if(Mojisu>80){ + cat("#\n",file=Wfile,append=TRUE) + } + Mojisu=0 + } + Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") + Str2<- "\\special{fp}%\n" + cat(Str1,file=Wfile,append=TRUE) + cat(Str2,file=Wfile,append=TRUE) + } + } +} + +###################################################### + +Drwxy<-function(...) +{ + varargin<-list(...) + Nargs <- length(varargin) + Tmp<-grep("arrow", ZIKU) + if(length(Tmp)>0) + { + Arrowline(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]),ARROWSIZE) + Arrowline(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX),ARROWSIZE) + } + else + { + Drwline(Listplot(c(XMIN,GENTEN[2]),c(XMAX,GENTEN[2]))) + Drwline(Listplot(c(GENTEN[1],YMIN),c(GENTEN[1],YMAX))) + } + Letter(c(XMAX,GENTEN[2]),XPOS,XNAME) + Letter(c(GENTEN[1],YMAX),YPOS,YNAME) + Letter(GENTEN,OPOS,ONAME); +} + +########################################## +# 10.12.04 + +Enclosing<- function(...) +{ + Eps=10^(-7) # Scilab 16.12.05 + varargin<- list(...) + Nargs<- length(varargin) + P<- varargin[[1]] + if(Mixtype(P)==2){ + Tmp<- Op(1,P) + if(mode(Tmp)!="numeric" || length(Tmp)>1){ + AnsL<- EnclosingS(...) + AnsL<- Joincrvs(AnsL) # 10.12.04 + } + } + Tmp1=Op(1,AnsL) # Scilab 16.12.05from + Tmp2=Op(nrow(AnsL),AnsL) + if(Norm(Tmp2-Tmp1)>Eps){ + AnsL=Appendrow(AnsL,Tmp1) + } + return(AnsL) +} + +######################################### + +EnclosingS<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + AnsL<- list() + PdataL<- varargin[[1]] + Nall<-length(PdataL) + Eps<- 10^(-3) + EEps<- 0.1 + S<- c() + Flg<- 0 + for (I in Looprange(2,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ + S<- Tmp + } + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + if(Flg==0){ + Eps<- Tmp + Flg=Flg+1 + } + else{ + EEps<- Tmp + } + } + } + F<- Op(1,PdataL); G<- Op(Nall,PdataL) + KL<- IntersectcrvsPp(F,G) + if(length(KL)==1){ + Tmp<- Op(1,KL) + P<- Op(1,Tmp) + T1<- Op(2,Tmp) + } + if(length(KL)==0){ + if(Numptcrv(F)>Numptcrv(G)){ + Tmp<- Nearestpt(F,G) + P<- Op(1,Tmp) + T1=Op(2,Tmp) + } + else{ + Tmp<- Nearestpt(G,F) + P<- Op(3,Tmp) + T1<- Op(4,Tmp) + } + } + if(length(KL)>=2){ + if(length(S)==0){ + return("No Start Point") + } + Tmp<- Op(1,KL) + P<- Op(1,Tmp) + T1<- Op(2,Tmp) + Tmp<- Norm(P-S) + for (I in Looprange(2,length(KL))){ + Tmp1<- Op(1,Op(I,KL)) + Tmp2<- Norm(Tmp1-S) + if(Tmp21) P<- Q + if(N==Nall){ + Q=S + } + else{ + Flg<- 0 + G<- Op(N+1,PdataL) + KL<- IntersectcrvsPp(G,F) + if(length(KL)==1){ + Tmp<- Op(1,KL) + Q<- Op(1,Tmp) + T3<- Op(2,Tmp) + Flg<- 10 + } + if(length(KL)==0) Flg<- 1 + if(length(KL)>=2){ # Maple bug? + Tmp1<- Op(1,Op(1,KL)) + Tmp2<- Op(1,Op(2,KL)) + Tmp<- Norm(Tmp1-Tmp2) + if(TmpNumptcrv(G)){ + Tmp<- Nearestpt(F,G) + Q<- Op(1,Tmp) + T3<- Op(4,Tmp) + Flg<- 10 + } + else{ + Tmp<- Nearestpt(G,F) + Q<- Op(3,Tmp) + T3<- Op(2,Tmp) + Flg<- 10 + } + } + if(Flg<10){ + T2<- Inf + for (I in Looprange(1,length(KL))){ + Dt<- Op(I,KL) + Tmp1<- Op(1,Dt) + Tmp<- Op(3,Dt) + Tmp2<- Paramoncurve(Tmp1,Tmp,F) + Tmp3<- Op(2,Dt) + if(Tmp2>T1+Eps && Tmp20){ + eval(parse(text=Op(I,StrL))) + } + } +} + +######################################### + +Expr<-function(...) +{ ## Scaling is implemented + varargin<-list(...) + Nargs<-length(varargin) + Irng<-c(seq(from=1,to=Nargs,by=3)) + for (I in Irng) + { + Tmp<-varargin[[I]] + P<- Doscaling(Tmp) + X<-P[1] + Y<-P[2] + Houkou<-varargin[[I+1]] + Mojiretu<-paste("$",varargin[[I+2]],"$",sep="") + Hset<-Houkou + Vhoko<-"c" + if(length(grep("n",Hset))>0) + { + Vhoko<-"n"; Y<-Y+MEMORI + } + if(length(grep("s",Hset))>0) + { + Vhoko<-"s"; Y<-Y-MEMORI + } + Hhoko<-"c" + if(length(grep("e",Hset))>0) + { + Hhoko<-"e"; X<-X+MEMORI + } + if(length(grep("w",Hset))>0) + { + Hhoko<-"w"; X<-X-MEMORI + } + Hoko<-paste(Vhoko,Hhoko,sep="") + Suu<-"+-.0123456789" + SuuL<-Suu + J<-1; Dstr<-"" + while (J<=nchar(Houkou)) + { + Tmp<-substring(Houkou,J,J) + if(length(grep(Tmp,Suu))>0) + { + if(Dstr=="") Hk<-substring(Houkou,J-1,J-1) + Dstr<-paste(Dstr,Tmp,sep="") + } + else + { + if(Dstr!="") + { + Nmbr<-as.numeric(Dstr) + D<-Nmbr*MEMORI + if(Hk=="n") Y<-Y+D + if(Hk=="s") Y<-Y-D + if(Hk=="e") X<-X+D + if(Hk=="w") X<-X-D + Dstr<-"" + } + } + J<-J+1 + } + if(Dstr!="") + { + Nmbr<-as.numeric(Dstr) + D<-Nmbr*MEMORI; + if(Hk=="n") Y<-Y+D + if(Hk=="s") Y<-Y-D + if(Hk=="e") X<-X+D + if(Hk=="w") X<-X-D + } + CalcWidth(Hoko,Mojiretu) + CalcHeight(Hoko,Mojiretu) + cat("\\put(",file=Wfile,append=TRUE) + Tmp1<- sprintf("%7.7f",X) # 11.07.19 + Tmp2<- sprintf("%7.7f",Y) # 11.07.19 + Str<-paste(Tmp1,",",Tmp2,sep="") + cat(Str,file=Wfile,append=TRUE) + Tmp<-"){\\hspace*{\\Width}" + Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) + } +} + +########################################## + +Exprrot<- function(...) +{ + varargin<- list(...) + P<- varargin[[1]] + V<- varargin[[2]]; N<- 3 + P<- Doscaling(P) + V<- Doscaling(V) + Tmov<- 0 + Tmp<- varargin[[N]] + if(mode(Tmp)=="numeric"){ + Tmov<- Tmp; N<- N+1 + } + Nmov<- 0 + Tmp<- varargin[[N]] + if(mode(Tmp)=="numeric"){ + Nmov<- Tmp; N<- N+1 + } + Mojiretu<- paste("$",Assign(varargin[[N]]),"$",sep="") # 2017.11.26 + Tv<- 1/Norm(V)*V + Nv<- c(-Tv[2],Tv[1]) + P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv + Tmp<- acos(V[1]/Norm(V)) + Theta<- round(Tmp*180/pi) + if(V[2]>=0){ + Units<- "" + } + else{ + Units<- "units=-360," + } + Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") + Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") + Letter(P,"c",Tmp) +} + +###################################################### + +Findcell<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + Ag<- varargin[[2]] + Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" + if(mode(Ag)=="character"){ + Clm<- c() + Rstr<- "" + for (I in Looprange(1,nchar(Ag))){ + C<- substr(Ag,I,I) + C<- toupper(C) + Tmp<- strsplit(Alpha,C) + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + Tmp1<- nchar(Tmp[1]) + Clm<- c(Clm,Tmp1) + } + else{ + Rstr<- paste(Rstr,C,sep="") + } + } + Nrg<- 0 + for (I in seq(length(Clm),1,by=-1)){ + Tmp<- Clm[I] + Tmp1<- length(Clm)-I + Nrg<- Nrg+Tmp*26^Tmp1 + } + Mrg<- eval(parse(text=Rstr)) + if(Nargs>=3){ + Ag<- varargin[[3]] + Clm<- c() + Rstr<- "" + for (I in Looprange(1,nchar(Ag))){ + C<- substr(Ag,1,1) + C<- toupper(C) + Tmp<- strsplit(Alpha,C) + if(length(Tmp)>1){ + Clm<- c(Clm,Tmp+1) + } + else{ + Rstr<- paste(Rstr,C,sep="") + } + } + Nrg2<- 0 + for (I in seq(length(Clm),1,by=-1)){ + Tmp<- Clm[I] + Tmp1<- length[Clm]-I + Nrg2<- Nrg2+Tmp*26^Tmp1 + } + Nrg<- c(Nrg,Nrg2) + Tmp=eval(parse(text=Rstr)) + Mrg<- c(Mrg,Tmp) + } + } + else{ + Nrg<- varargin[[2]] + Mrg<- varargin[[3]] + } + if(length(Mrg)==1){ + m1<- Mrg; m2<- m1+1 + } + else{ + m1<- Mrg[1]; m2<- Mrg[2] # 10.12.12 + } + if(length(Nrg)==1){ + n1<- Nrg; n2<- n1+1 + } + else{ + n1<- Nrg[1]; n2<- Nrg[2] + } + n1<- n1+1; n2<- n2+1 + m1<- m1+1; m2<- m2+1 + Hind<- TbL[[2]] + Vind<- TbL[[3]] + Tmp<- TbL[[1]] + HL<- Tmp[Hind] + Tmp1<- Op(1,TbL[[4]]) + Tmp2<- Op(2,TbL[[4]]) + HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) + VL<- Tmp[Vind] + Tmp1<- Op(1,TbL[[5]]) + Tmp2<- Op(2,TbL[[5]]) + VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) + Tmp<- TbL[[6]] + Tmp1<- Listplot(c(Ptsw(Tmp),Ptnw(Tmp))) + Tmp2<- Listplot(c(Ptse(Tmp),Ptne(Tmp))) + HL<- Mixjoin(list(Tmp1),HL,list(Tmp2)) + Tmp1<- Listplot(c(Ptnw(Tmp),Ptne(Tmp))) + Tmp2<- Listplot(c(Ptsw(Tmp),Ptse(Tmp))) + VL<- Mixjoin(list(Tmp1),VL,list(Tmp2)) + Tmp<- HL[[n1]] + if(mode(Tmp)=="numeric"){ + H1<- Tmp[1,1] + } + else{ + Tmp1<- Tmp[[1]] + H1<- Tmp1[1,1] + } + Tmp<- HL[[n2]] + if(mode(Tmp)=="numeric"){ + H2<- Tmp[1,1] + } + else{ + Tmp1<- Tmp[[1]] + H2<- Tmp1[1,1] + } + Tmp<- VL[[m1]] + if(mode(Tmp)=="numeric"){ + V1<- Tmp[1,2] + } + else{ + Tmp1<- Tmp[[1]] + V1<- Tmp1[1,2] + } + Tmp<- VL[[m2]] + if(mode(Tmp)=="numeric"){ + V2<- Tmp[1,2] + } + else{ + Tmp1<- Tmp[[1]] + V2<- Tmp1[1,2] + } + Pt<- c((H1+H2)/2,(V1+V2)/2) + High<- (V1-V2)/2 + Wide<- (H2-H1)/2 + Out<- list(Pt,Wide,High) + return(Out) +} + +############################################ + +Flattenlist<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Out<- list() + for(N in Looprange(1,Nargs)){ + D<- varargin[[N]] + if(is.data.frame(D) || !is.list(D)){ # modify + Out<- c(Out,list(D)) + } + else{ + for(I in Looprange(1,length(D))){ + Ds<- D[[I]] + Tmp<- Flattenlist(Ds) + Out<- c(Out,Tmp) + } + } + } + return(Out) +} + +############################################ + +Fontsize<- function(Ookisa) +{ + Str<- "%" + S<- substr(Ookisa,1,1) + if(S=="n"){ + Str<- "\\normalsize%" + } + if(S=="s"){ + if(nchar(Ookisa)==1){ + Tmp<- "n" + } + else{ + Tmp<- substr(Ookisa,2,2) + } + if(Tmp=="s"){ + Str<- "\\scriptsize%" + } + else{ + Str<- "\\small%" + } + } + if(S=="f"){ + Str<- "\\footnotesize%" + } + if(S=="t"){ + Str<- "\\tiny%" + } + if(S=="l"){ + Str<- "\\large%" + } + if(S=="L"){ + if(nchar(Ookisa)==1){ + Tmp<- "a" + } + else{ + Tmp<- substr(Ookisa,2,2) + } + if(Tmp=="a"){ + Str<- "\\Large%" + } + else{ + Str<- "\\LARGE%" + } + } + if(S=="h"){ + Str<- "\\huge%" + } + if(S=="H"){ + Str<- "\\Huge%" + } + cat(Str,file=Wfile,append=TRUE) + cat("\n",file=Wfile,append=TRUE) +} + +########################################## + +Fracform<- function(...) +{ + varargin<- list(...) + Eps<- 10^(-10) + Nmax<- 1/Eps + Nargs<- length(varargin) + X<- varargin[[1]] + Nr<- Nrow(X) + X<- as.matrix(X,nrow=Nr) + for (I in Looprange(2,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)!="numeric"){ + next + } + if(Tmp>1){ + Nmax<- Tmp + } + else if(Tmp>0){ + Eps<- Tmp + } + } + Tmp<- rep("",length(X)) + Out<- matrix(Tmp,nrow=nrow(X)) + for (I in Looprange(1,nrow(X))){ + for (J in Looprange(1,ncol(X))){ + Dt<- X[I,J] + if(mode(Dt)=="character"){ + Dt<- eval(parse(text=Dt)) + } + R<- 1 + N<- 0 + Rmin<- R + Nr<- N + while (R>Eps && N0) + { + Tmp<- Mixjoin(ShaL, list(Sha)) + ShaL <- Tmp + Sha<- Makeshasen(PtnL,PA+I*Kankaku*Vm,V,Bdy) + I <- I+1 + } + Sha<- Makeshasen(PtnL,PA-Kankaku*Vm,V,Bdy) + I<- 2 + while (length(Sha)>0) + { + for (J in 1:length(Sha)) + { + Tmp<- Mixjoin(ShaL,list(Sha[[J]])) + ShaL<- Tmp + } + Sha<- Makeshasen(PtnL,PA-I*Kankaku*Vm,V,Bdy) + I<- I+1 + } + } + else + { + Delta<- c(Xmn,Ymn)-StartP + K1<- trunc(Dotprod(Delta,Vm)/Kankaku) + Delta<- c(Xmx,Ymn)-StartP + K2<- trunc(Dotprod(Delta,Vm)/Kankaku) + Delta<- c(Xmx,Ymx)-StartP + K3<- trunc(Dotprod(Delta,Vm)/Kankaku) + Delta<- c(Xmn,Ymx)-StartP + K4<- trunc(Dotprod(Delta,Vm)/Kankaku) + IM<- max(K1,K2,K3,K4) + Im<- min(K1,K2,K3,K4) + for (I in Im:IM) + { + Sha<- Makeshasen(PtnL,StartP+I*Kankaku*Vm,V,Bdy) + for (J in Looprange(1,length(Sha))) + { + Tmp<- Mixjoin(ShaL, list(Sha[[J]])) + ShaL<- Tmp + } + } + } + ShaLs<-list() + for (I in Looprange(1,length(ShaL))) + { + Tmp<- ShaL[[I]] + Tmp1<- Unscaling(Tmp) + Tmp2<- Mixjoin(ShaLs, list(Tmp1)) + ShaLs<- Tmp2 + } + ShaL<- ShaLs + return(ShaL) +} + +###################################### + +Htickmark<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + ArgsL<- varargin + if(mode(ArgsL[[1]])=="character"){ + Str<- ArgsL[[1]] + Tmp<- strsplit(Str,"m") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + I<- nchar(Tmp[1])+1 + } + else{ + I<- 0 + } + Tmp<- strsplit(Str,"n") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + J<- nchar(Tmp[1])+1 + } + else{ + J<- 0 + } + Tmp<- strsplit(Str,"r") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + K=nchar(Tmp[1])+1 + } + else{ + K<- 0 + } + if(K>0){ + S<- substr(Str,K+1,nchar(Str)) + R<- as.numeric(S) + if(is.na(R)){ + R<- 1 + } + } + else{ + R<- 1 + K<- nchar(Str)+1 + } + if(J>0){ + S<- substr(Str,J+1,K-1) + Dn<- as.numeric(S) + if(is.na(Dn)){ + Dn<- 1 + } + } + else{ + Dn<- 1000 + J<- nchar(Str)+1 + } + S<- substr(Str,I+1,J-1) + Dm<- as.numeric(S) + if(is.na(Dm)){ + Dm<- 1 + } + ArgsL<- list() + for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + } + MemoriList<- list() + Memori<- list() + for (N in 1:length(ArgsL)){ + Dt<- ArgsL[[N]] + if(mode(Dt)=="numeric" && length(Dt)>1){ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt[1],Dt[2]) + next + } + if(mode(Dt)=="character"){ + Memori<- Mixjoin(Memori,Dt) + } + else{ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt,GENTEN[2]) + } + } + MemoriList<- Mixjoin(MemoriList,list(Memori)) + for (N in 1:length(MemoriList)){ + Dt<- MemoriList[[N]] + Ndt<- length(Dt) + X=Op(1,Dt) + Y=Op(2,Dt) + Tmp<-Doscaling(c(X,Y)) + X<- Tmp[1] + Y<- Tmp[2] + Moji<- Op(Ndt,Dt) + Tmp1<- Unscaling(c(X,Y+MARKLEN)) + Tmp2<- Unscaling(c(X,Y-MARKLEN)) + Fd<- Listplot(c(Tmp1,Tmp2)) + Drwline(Fd) + if(Ndt==3){ + Tmp<-Unscaling(c(X,Y-MARKLEN)) + Expr(Tmp,"s",Moji) + } + if(Ndt==4){ + Houkou<- Op(3,Dt) + Tmp<-grep("s",Houkou) + if(length(Tmp)>0){ + Tmp<-Unscaling(c(X,Y-MARKLEN)) + Expr(Tmp,Houkou,Moji) + } + else{ + Tmp<- Unscaling(c(X,Y+MARKLEN)) + Expr(Tmp,Houkou,Moji) + } + } + cat("%\n",file=Wfile,append=TRUE) + } +} + +############################################# +# 2013.08.07 + +Integrate<- function(Fs,Vs, Intv){ + if(is.function(Fs)){ + Fn<- Fs + } + else{ + Str<- paste("Fn<- function(",Vs, ") ", Fs, sep="") + eval(parse(text=Str)) + } + Tmp<- integrate(Fn, Intv[[1]], Intv[[2]]) + Out<- Tmp[[1]] + return(Out) +} + +############################################# + +Intersectcrvs<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + Eps<-10^(-4) + Tmp<-varargin[[Nargs]] + if(mode(Tmp)=="numeric" && length(Tmp)==1) + { + Eps<-Tmp + } + G1<-varargin[[1]] + if(mode(G1)=="numeric") + { + G1<-list(G1) + } + G2<-varargin[[2]] + if(mode(G2)=="numeric") + { + G2<-list(G2) + } + PL<-list() + for (N in 1:length(G1)) + { + for (M in 1:length(G2)) + { + KL<-IntersectcrvsPp(G1[[N]],G2[[M]],Eps) + for (I in Looprange(1,length(KL))) + { + Tmp<-KL[[I]] + P<-Tmp[1] + PL<-append(PL,P) + } + } + } + return(PL) +} + +########################################### + +IntersectcrvsPp<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + G1<-varargin[[1]]; G2<-varargin[[2]] + Eps<- 10.0^(-4) + if(Nargs>2) Eps<-varargin[[3]] + SqEps<- 10.0^(-10) + Eps2<- 0.1 + if(Nargs>3) Eps2<-varargin[[4]] + Data1<-G1 + Data2<-G2 + if(Nrow(Data1)==Nrow(Data2)) + { + Tmp<-seq(Nrow(Data2),1, by=-1) + Tmp1<-Data2[Tmp,] + Eps0<-10^(-6) + Tmp2<-Norm(Data1-Data2) + Tmp3<-Norm(Data1-Tmp1) + if(Tmp20) + { + Tmp<-KL1[[1]] + P<-Tmp[[1]] + T<-Tmp[[2]] + I<-Tmp[[3]] + J<-Tmp[[4]] + Tmp<-list(P,I+T,J) + KL<-list(Tmp) + } + for (N in Looprange(2,length(KL1))) + { + Tmp<-KL1[[N]] + P<-Tmp[[1]] + Flg<-0 + for (K in 1:length(KL)) + { + if(1>length(KL)) break + Tmp<-KL[[K]] + if(Norm(P-Tmp[[1]])^20){ # 13.12.20 + Tmp1<- varargin[[Nall-1]] + if(is.numeric(Tmp1) && length(Tmp1)==1 && Tmp1>0){ # 13.12.20 + Sen<- Tmp1; Gap<- Tmp + Nall<- Nall-2 + } + else{ + Sen<- Tmp; Gap<- Sen + Nall<- Nall-1 + } + } + Sen<- 1000/2.54/MilliIn*Sen + Gap<- 1000/2.54/MilliIn*Gap + for (N in Looprange(1,Nall)){ + Figdata<- varargin[[N]] + Makehasen(Figdata,Sen,Gap,1) + } +} + +######################################### + +Invert<- function(Pd) +{ + OutL=Pd[nrow(Pd):1,] + return(OutL) +} + +############################################ + +InWindow<-function(PA) +{ + Eps<-10.0^(-6); + if((length(PA)==2)&(is.numeric(PA))){ # 17.11.20 + X<-PA[1]; Y<-PA[2]; + if(X>XMIN-Eps && XYMIN-Eps && YEps){ + PtL<- Appendrow(PtL,Qd) + } + else{ + if(is.null(nrow(Qd))){ Qd<- as.matrix(Qd,nrow=1)} + PtL<- Appendrow(PtL,Qd[2:nrow(Qd),]) # 11.06.25 + } + } + return(PtL) +} + +######################################## +# 2011.11.02 + +Joingraphics<- function(...) +{ + varargin<- list(...) + Ls<- Flattenlist(varargin) + N<- length(Ls) + Tp<- Ls[[N]] + Listflg<- 0 + if( is.character(Tp)){ + Tmp<- toupper(substr(Tp,1,1)) + if(Tmp=="L"){ + Listflg<- 1 + } + N<- N-1 + Ls<- Ls[1:N] + } + if(Listflg==1){ + P<- Ls + } + else{ + P<- c() + for (I in 1:N){ + Tmp<- Ls[[I]] + P<- Appendrow(P,c(Inf,Inf)) + P<- Appendrow(P,Tmp) + } + P<- P[2:nrow(P),] + } + return(P) +} + +######################################## + +Kouten<- function(PA,V,P,Q) +{ + Eps<- 10.0^(-6) + A1<- PA[1]; A2<- PA[2] + V1<- V[1]; V2<- V[2] + P1<- P[1]; P2<- P[2] + U1<- Q[1]-P1; U2<- Q[2]-P2 + Tmp<- Norm(P-Q)*Norm(V) + if(Tmp==0) + { + Out<- list(Inf,-Inf) + return(Out) + } + D<- U1*V2-U2*V1 + if(abs(D)/Tmp1+Eps || S=5) + { + Eps<-varargin[[5]] + } + Eps2 <- 0.2 + if(Nargs>=6) + { + Eps2<-varargin[[6]] + } + Eps<-min(Eps2,Eps/sqrt(Sv2)) + P1<-(P[1]*V[1]+P[2]*V[2])/Sv2 + P2<-(-P[1]*V[2]+P[2]*V[1])/Sv2 + Q1<-(Q[1]*V[1]+Q[2]*V[2])/Sv2 + Q2<-(-Q[1]*V[2]+Q[2]*V[1])/Sv2 + m1 <- -Eps; M1 <- 1+Eps + m2 <- -Eps; M2 <- Eps + if(max(P1,Q1)M1) + { + Out<-Inf + return(Out) + } + if(max(P2,Q2)M2) + { + Out<-Inf + return(Out) + } + if(P2*Q2<0) + { + T<- P1-(Q1-P1)/(Q2-P2)*P2 + if(T>m1 && T -Eps0 && T<1+Eps0) + { + Tmp1<-A+T*V + Tmp2<-min(max(T,0),1) + Out<-list(Tmp1,Tmp2,0) + } + else + { + Tmp1<-A+T*V + Tmp2<-min(max(T,0),1) + Out<-list(Tmp1,Tmp2,1) + } + return(Out) + } + if(P1M1 || P2M2) + { + if(Q1M1 || Q2M2) + { + Out<-Inf + return(Out) + } + T<-min(max(Q1,0),1) + Tmp=A+T*V + Out<-list(Tmp,T,1) + return(Out) + } + T<-min(max(P1,0),1) + Tmp<-A+T*V + Out<-list(Tmp,T,1) + return(Out) + } + if(P1> -Eps0 && P1<1+Eps0 && P2> -Eps0 && P2 < Eps0) + { + T<- P1 + Tmp<- A+T*V + Out<- list(Tmp, T, 0) + return(Out) + } + if(Q1> -Eps0 && Q1<1+Eps0 && Q2> -Eps0 && Q2M1 || P2M2) + { + if(Q1M1 || Q2M2) + { + Out<-Inf + return(Out) + } + T<-min(max(Q1,0),1) + Tmp<-A+T*V + Out<-list(Tmp,T,1) + return(Out) + } + if(Q1M1 || Q2M2) + { + T<-min(max(P1,0),1) + Tmp<-A+T*V + Out<-list(Tmp,T,1) + return(Out) + } + if(abs(P2)Eps) + { + QL<-Pt1 + } + Tmp<-Appendrow(QL,PL[(N1+1):N2,]) + QL<- Tmp + if(Norm(Pt2-Op(N2,PL))>Eps) + { + Tmp<-Appendrow(QL,Pt2) + QL<- Tmp + } + HidariL<- QL + Ms<- M2+1; Me<- M1 + if(T1Eps) + { + Tmp<-Append(HidariL,P) + HidariL<-Tmp + } + } + Tmp<- Op(Nrow(HidariL),HidariL) + if(Norm(Tmp-Pt1)>Eps) + { + Tmp<-Append(HidariL,Pt1) + HidariL<-Tmp + } + MigiL<- QL + Ms<- M2; Me<- M1+1 + if(T1>T2-Eps) Me<- Me-4 + for (Mm in Looprange(Me,Ms)) + { + M<- Me+Ms-Mm + Tmp<- Op(Nrow(MigiL),MigiL) + P<- Op(((M-1) %% 4)+1,Sikaku) + if(Norm(Tmp-P)>Eps) + { + Tmp<-Appendrow(MigiL,P) + MigiL<-Tmp + } + } + Tmp<- Op(Nrow(MigiL),MigiL) + if(Norm(Tmp-Pt1)>Eps) + { + Tmp<-Appendrow(MigiL,Pt1) + MigiL<-Tmp + } + Out<- list(HidariL,MigiL) + return(Out) +} + +################################### +# 17.09.24 Eps + +Kyoukai<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps0<- 10^(-7) + DataL<-list() + for (I in 1:Nargs){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric"){ + DataL<- Mixjoin(DataL,list(list(Tmp))) + } + if(mode(Tmp)=="list"){ + if(mode(Tmp[[1]])!="list"){ + DataL<- Mixjoin(DataL, list(Tmp)) + } + else{ + DataL<-Mixjoin(DataL,Tmp) + } + } + } + Eps<- 10.0^(-4) #17.09.24 + PLall<- list() + Sflg<- 0 + N<- length(DataL) + for (I in Looprange(1,N)){ + Data<- Op(I, DataL) + Tmp<- Op(length(Data),Data) + if(mode(Tmp)=="numeric" && Nrow(Tmp)==1 && length(Tmp)>1){ + Rg<-Tmp ; Nd<-length(Data)-1 + } + else{ + if(mode(Tmp)=="character"){ + Rg<- Tmp ; Nd<-length(Data)-1 + } + else{ + Rg<- "c" ; Nd<-length(Data) + } + } + for (J in Looprange(1,Nd)){ + Tmp<- Op(J,Data) + if(mode(Tmp)=="character"){ + Rg<- Tmp + next + } + Points<- Tmp + P1<- Ptstart(Points) + P2<- Ptend(Points) + if(J==1){ + PL<- Points + Pfirst<- P1 + Plast<- P2 + if(Nd>=2){ + Tmp<- Op(2,Data) + P<- Ptstart(Tmp) + Q<- Ptend(Tmp) + if(Norm(P2-P)>Eps && Norm(P2-Q)>Eps){ + Tmp< Length(PL) + PL<-PL[Tmp:1,] + Pfirst<- Ptstart(PL) + Plast<- Ptend(PL) + } + } + } + else{ + if(Norm(P1-Plast)Eps){ + Np<- Length(PL) + if(Rg=="c"){ + Tmp<- Appendrow(PL,Pfirst) + PL<- Tmp + } + else if(Rg=="s"){ + Tmp<- c(PL[1:Np,2],YMIN) + Y<- min(Tmp)-1 + P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) + Tmp<- Appendrow(PL,P) + Tmp=Appendrow(Tmp,Q) + PL=Appendrow(Tmp,Pfirst) + } + else if(Rg=="n"){ + Tmp<- c(PL[1:Np,2],YMAX) + Y<-max(Tmp)+1 + P<- c(Plast[1],Y); Q<- c(Pfirst[1],Y) + Tmp<- Appendrow(PL,P) + Tmp<- Appendrow(Tmp,Q) + PL<- Appendrow(Tmp,Pfirst) + } + else if(Rg=="w"){ + Tmp<- c(PL[1:Np,1],XMIN) + X<- min(Tmp)-1 + P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) + Tmp<- Appendrow(PL,P) + Tmp<- Appendrow(Tmp,Q) + PL<- Appendrow(Tmp,Pfirst) + } + else if(Rg=="e"){ + Tmp<- c(PL[1:Np,1],XMAX) + X<- max(Tmp)+1 + P<- c(X,Plast[2]); Q<- c(X,Pfirst[2]) + Tmp<- Appendrow(PL,P) + Tmp<- Appendrow(Tmp,Q) + PL<- Appendrow(Tmp,Pfirst) + } + else if(mode(Rg)=="numeric" && Nrow(Rg)==1 && length(Rg)>1){ + Tmp<- Kukeiwake(PL) + Tmp1<- Op(1,Tmp) + Tmp2<- Naigai(Rg,list(Tmp1)) + if(Tmp2==c(1)){ + PL<-Op(1,Tmp) + } + else{ + PL<- Op(2,Tmp) + } + } + } + Tmp<- Ptstart(PL) + for (J in Looprange(2,Length(PL))){ + P<- Op(J,PL) + Q<- Op(Length(Tmp),Tmp) + if(Norm(P-Q)>Eps){ + Tmp1<-Appendrow(Tmp,P) + Tmp<-Tmp1 + } + } + PL<-Tmp + PLall<-c(PLall,list(PL)) + } + if(length(PLall)==1 && Sflg==0){ + Tmp<- Op(1,PLall) +# Tmp<- Op(1,Tmp) + if(Norm(Ptstart(Tmp)-Ptend(Tmp))>Eps0){ + Tmp1<- Appendrow(Tmp,Ptstart(Tmp)) + PLall<- list(Tmp1) + } + } + return(PLall) +} + +###################################### + +Letter<-function(...) +{ ## Scaling is implemented + varargin<-list(...) + Nargs<-length(varargin) + Irng<-c(seq(from=1,to=Nargs,by=3)) + for (I in Irng) + { + Tmp<-varargin[[I]] + P<- Doscaling(Tmp) + X<-P[1] + Y<-P[2] + Houkou<-varargin[[I+1]] + Mojiretu<-varargin[[I+2]] + Hset<-Houkou + Vhoko<-"c" + if(length(grep("n",Hset))>0) + { + Vhoko<-"n"; Y<-Y+MEMORI + } + if(length(grep("s",Hset))>0) + { + Vhoko<-"s"; Y<-Y-MEMORI + } + Hhoko<-"c" + if(length(grep("e",Hset))>0) + { + Hhoko<-"e"; X<-X+MEMORI + } + if(length(grep("w",Hset))>0) + { + Hhoko<-"w"; X<-X-MEMORI + } + Hoko<-paste(Vhoko,Hhoko,sep="") + Suu<-"+-.0123456789" + SuuL<-Suu + J<-1; Dstr<-"" + while (J<=nchar(Houkou)) + { + Tmp<-substring(Houkou,J,J) + if(length(grep(Tmp,SuuL))>0) + { + if(Dstr=="") Hk<-substring(Houkou,J-1,J-1) + Dstr<-paste(Dstr,Tmp,sep="") + } + else + { + if(Dstr!="") + { + Nmbr<-as.numeric(Dstr) + D<-Nmbr*MEMORI + if(Hk=="n") Y<-Y+D + if(Hk=="s") Y<-Y-D + if(Hk=="e") X<-X+D + if(Hk=="w") X<-X-D + Dstr<-"" + } + } + J<-J+1 + } + if(Dstr!="") + { + Nmbr<-as.numeric(Dstr) + D<-Nmbr*MEMORI; + if(Hk=="n") Y<-Y+D + if(Hk=="s") Y<-Y-D + if(Hk=="e") X<-X+D + if(Hk=="w") X<-X-D + } + CalcWidth(Hoko,Mojiretu) + CalcHeight(Hoko,Mojiretu) + cat("\\put(",file=Wfile,append=TRUE) + Tmp1<- sprintf("%7.7f",X) # 11.07.19 + Tmp2<- sprintf("%7.7f",Y) # 11.07.19 + Str<-paste(Tmp1,",",Tmp2,sep="") + cat(Str,file=Wfile,append=TRUE) + Tmp<-"){\\hspace*{\\Width}" + Str<-paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) + } +} + +###################################################### + +Letterrot<- function(...) +{ + varargin<- list(...) + P<- varargin[[1]] + V<- varargin[[2]]; N<- 3 + P<- Doscaling(P) + V<- Doscaling(V) + Tmov<- 0 + Tmp<- varargin[[N]] + if(mode(Tmp)=="numeric"){ + Tmov<- Tmp; N<- N+1 + } + Nmov<- 0 + Tmp<- varargin[[N]] + if(mode(Tmp)=="numeric"){ + Nmov<- Tmp; N<- N+1 + } + Mojiretu<- Assign(varargin[[N]]) #2017.11.26 + Tv<- 1/Norm(V)*V + Nv<- c(-Tv[2],Tv[1]) + P<- P+MEMORI*Tmov*Tv+MEMORI*Nmov*Nv + Tmp<- acos(V[1]/Norm(V)) + Theta<- round(Tmp*180/pi) + if(V[2]>=0){ + Units<- "" + } + else{ + Units<- "units=-360," + } + Tmp<- paste("\\rotatebox[",Units,"origin=c]{",as.character(Theta),sep="") + Tmp<- paste(Tmp,"}{",Mojiretu,"}",sep="") + Letter(P,"c",Tmp) +} + +################################### +# 10.12.04 + +Lineplot<-function(...) +{ + varargin <- list(...) + Nargs<-length(varargin) + A<-varargin[[1]] + if(is.numeric(A)) { + Tmp<-length(A) + if(Tmp>3) { + B <- A[(Tmp/2+1):Tmp] + A <- A[1:(Tmp/2)] + Is <- 2 + } + else { + B<-varargin[[2]] + Is <- 3 + } + } + else { + B<-A[[2]] + A<-A[[1]] + Is <- 2 + } + Mag <- 100 ; Semi <- "" ## 10.12.04 + for (I in Looprange(Is,Nargs)) { + Tmp <- varargin[[I]] + switch ( mode(Tmp), + "numeric"= Mag <- Tmp, + "character"= Semi <- Tmp + ) + } +V<- Mag/Norm(B-A)*(B-A) ## 10.12.04 from here + if(Semi=="") { + Out<- Listplot(c(A-V,A+V)) + } + else if(Semi=="+") { + Out<- Listplot(c(A,A+V)) + } + else { + Out<- Listplot(c(A-V,A)) + } ## 10.12.04 to here + return(Out) +} + +################################ + +Listplot<-function(...) +{ + varargin<-list(...); + Z<-c(); + for (I in 1:length(varargin)) + { + Data<-varargin[[I]]; + if(mode(Data)=="numeric") + { + if(class(Data)=="numeric") + { + Tmp<-matrix(Data,nrow=2); + Tmp<-t(Tmp); + Z<-Appendrow(Z,Tmp) + } + else + Z<-Appendrow(Z,Data) + } + else + { + for (J in 1:length(Data)) + { + Tmp<-Data[[J]]; + Z<-Appendrow(Z,Tmp) + } + } + } + return(Z) +} + +############################## + +MakeBowdata <- function(PA,PB,H) +{ + Eps <- 10^(-5) + BOWSTART <<- PA + BOWEND <<- PB + D <- 1/2*Norm(PB-PA) + R <- (H^2+D^2)/(2*H) + A1 <- PA[1]; A2<-PA[2] + B1 <- PB[1]; B2<-PB[2] + if(abs(A2-B2)>Eps){ +# x <- poly(0,"X") +# y <- -(A1-B1)*x/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) +# Eq1 <- (A1-x)^2+(A2-y)^2-R^2 +# Tmp <- coeff(Eq1) +# C0 <- Tmp[1]; C1<-Tm[2]; C2<-Tmp[3] + C0<- A1^2+(A2-(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2))^2-R^2 + C1<- -(A1+B1)*(A2^2+B2^2-2*A2*B2-2*A1*B1+A1^2+B1^2)/(A2-B2)^2 + C2<- 1+(A1-B1)^2/(A2-B2)^2 + Det <- sqrt(C1^2-4*C0*C2) + Ansx1 <- (-C1+Det)/(2*C2) + Ansx2 <- (-C1-Det)/(2*C2) + Tmp <- -(A1-B1)*Ansx1/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) + PC <- c(Ansx1,Tmp) + Tmp <--(A1-B1)*Ansx2/(A2-B2)+(1/2)*(A1^2+A2^2-B1^2-B2^2)/(A2-B2) + PC2 <- c(Ansx2,Tmp) + } + else{ + Tmp <- 0.5*(PA+PB) + PC <- Tmp+c(0,R-H) # 11.06.02 + PC2 <- Tmp-c(0,R-H) + } + VA <- PA-PC + VB <- PB-PC + if(VA[1]*VB[2]-VA[2]*VB[1]<0) { + PC <- PC2 + } + AngA <- acos((PA[1]-PC[1])/R) + if(PA[2]-PC[2]<0){ + AngA <- -AngA + } + AngB <- acos((PB[1]-PC[1])/R) + if(PB[2]-PC[2]<0){ + AngB <- -AngB + } + if(AngA>AngB) { + AngB <- AngB+2*pi + } + Out <- list(PC,R,AngA,AngB) + return(Out) +} + +#################################################### + +MakeCurves<-function(...){ ## Scaling is implemented + varargin<-list(...) + Figdata<-varargin[[1]] + if(class(Figdata)=="numeric"){ + Figdata<-matrix(Figdata,nrow=1) + } + Ptout<-1 + if(length(varargin)>=2) Ptout<-varargin[[2]] + Eps<-10.0^(-6) + IndM<-Dataindex(Figdata) + Atos<-c() + for (Nd in 1:Nrow(IndM)){ + Tmp<-IndM[Nd,] + Motos<-Figdata[Tmp[1]:Tmp[2],] + All<-Nrow(Motos) + if(Nrow(Motos)==1){ + if(InWindow(Motos)=="o"){ + next + } + Tmp1<- as.numeric(Motos) + if(Ptout==1){ + Drwpt(Tmp1) + } + else{ + Tmp1<- Doscaling(Tmp1) + Atos<-Appendrow(Atos,c(Inf,Inf),Tmp1) + next + } + } + Crv<-c() + for (I in Looprange(2,All)){ + P<- Op(I-1,Motos) + Q<- Op(I,Motos) + Snbn<-MeetWindow(P,Q) + if(length(Snbn)==0){ + if(length(Crv)>0){ + Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) + Crv<-c() + } + } + else{ + if(Norm(Snbn[1,]-Snbn[2,])=2) + { + Atos<-Appendrow(Atos,c(Inf,Inf),Doscaling(Crv)) + } + } + Outdata<-Atos[2:Nrow(Atos),] + if(class(Outdata)=="numeric") + { + Outdata<-matrix(Outdata,nrow=1) + } + return(Outdata) +} + +###################################### + +Makehasen<- function(Figdata,Sen,Gap,Ptn) +{ + Eps<- 10.0^(-6) + Clist<- MakeCurves(Figdata) + DinM<- Dataindex(Clist) + for (N in Looprange(1,Nrow(DinM))){ + Tmp<- DinM[N,] + Data<- Clist[Tmp[1]:Tmp[2],] + Dtall<- Nrow(Data) + Len<- 0 + Lenlist<- c(0) + for (I in Looprange(2,Dtall)){ + Len<- Len+Norm(Data[I,]-Data[I-1,]) + Lenlist<- c(Lenlist,Len) + } + Lenall<- Lenlist[Dtall] + if(Lenall==0){ + next + } + Kari<- (Sen+Gap)*0.1 + Naga<- Sen*0.1 + Tobi<- Gap*0.1 + if(Norm(Data[1,]-Data[Dtall,])=Lenlist[J]-Eps){ + if(J==Dtall){ + break + } + J<- J+1 + } + Hajime<- J-1 + J<- Hajime + while (Len+Naga>Lenlist[J]-Eps){ + if(J==Dtall){ + break + } + J<- J+1 + } + Owari<- J-1 + T<- (Len-Lenlist[Hajime]) + T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) + P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) + X<- as.character(round(MilliIn*P[1])) + Y<- as.character(-round(MilliIn*P[2])) + Str<- paste("\\special{pa ",X," ",Y,"}",sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + for (J in Looprange(Hajime+1,Owari)){ + P<- Data[J,] + X<- as.character(round(MilliIn*P[1])) + Y<- as.character(-round(MilliIn*P[2])) + Str<- paste("\\special{pa ",X," ",Y,"}",sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + } + T<- (Len+Naga-Lenlist[Owari]) + T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) + P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) + X<- as.character(round(MilliIn*P[1])) + Y<- as.character(-round(MilliIn*P[2])) + Str1<- paste("\\special{pa ",X," ",Y,"}",sep="") + Str2<- "\\special{fp}" + cat(Str1,file=Wfile,append=TRUE) + cat(Str2,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str1)+nchar(Str2) + if(Mojisu>80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<- 0 + } + } + } + cat("%\n%\n",file=Wfile,append=TRUE); +} + +###################################### + +Makeliststr<- function(L) +{ + Out="list(" + for (I in 1:length(L)){ + Dt<- L[[I]] + if(mode(Dt)=="numeric"){ + if(length(Dt)==1){ + Dts<- as.character(Dt) + } + else{ + Dts<- "c(" + for (J in Looprange(1,Nrow(Dt))){ + for (K in 1:ncol(Dt)){ + Dts<- paste(Dts,as.character(Dt[J,K]),sep="") + if(K< ncol(Dt)){ + Dts<- paste(Dts,",",sep="") + } + } + if(JEps){ + if(Member(Ptn,PtnL)){ + if(abs(Te-Ts)>Eps){ + if(Nrow(GL)>0){ + Tmp<- Mixjoin(Out, list(GL)) + Out<- Tmp + } + GL<- Listplot(P,Q) + } + else{ + Tmp <- Appendrow(GL, Q) + GL<- Tmp + } + Te<- Op(1,TenQ) + } + } + } + if(Nrow(GL)>0){ + Tmp<- Mixjoin(Out, list(GL)) + Out<- Tmp + } + return(Out) +} + +############################################# + +Mawarikomi<- function(...) +{ + varargin<- list(...) + haba<- "10cm" + Nargs<- length(varargin) + if(Nargs>0){ + haba<- varargin[[1]] + } + cat("\\begin{mawarikomi}%\n",file="",append=TRUE) + cat("%<1>[5](0,0)%\n",file="",append=TRUE) + Str<- paste("{",haba,"}{%\n",sep="") + cat(Str,file="",append=TRUE) + cat("}%\n",file="",append=TRUE) + cat("\\end{mawarikomi}",file="",append=TRUE) +} + +############################################## + +MeetWindow<-function(PA,PB) +{ + if(InWindow(PA)=="i" && InWindow(PB)=="i") + { + R<-Appendrow(PA,PB) + return(R) + }; + Horner<-function(n,t) + { + PT<-(1-t)*PA+t*PB; + return(PT[n]) + } + Eps<-10.0^(-6); + Txm<-(-1); TxM<-(-1); Tym<-(-1); TyM<-(-1); + if(PA[1]!=PB[1]) + { + Txm<-(XMIN-PA[1])/(PB[1]-PA[1]); + TxM<-(XMAX-PA[1])/(PB[1]-PA[1]); + } + if(PA[2]!=PB[2]) + { + Tym<-(YMIN-PA[2])/(PB[2]-PA[2]); + TyM<-(YMAX-PA[2])/(PB[2]-PA[2]); + } + Tmp<-Horner(2,Txm); + if(TmpYMAX+Eps) + { + Txm<-(-1); + } + Tmp<-Horner(2,TxM); + if(TmpYMAX+Eps) + { + TxM<-(-1) + } + Tmp<-Horner(1,Tym); + if(TmpXMAX+Eps) + { + Tym<--1 + } + Tmp<-Horner(1,TyM); + if(TmpXMAX+Eps) + { + TyM<--1 + } + Tans<-sort(c(Txm,TxM,Tym,TyM)); + Tmp<-c(); + for (I in 1:length(Tans)) + { + Tmp1<-Tans[I]; + if(Tmp1>-Eps && Tmp1<1+Eps) + { + if(length(Tmp)==0) + { + Tmp<-c(Tmp1); + } + else + { + if(abs(Tmp[length(Tmp)]-Tmp1)>Eps) + { + Tmp<-c(Tmp,Tmp1) + } + } + } + } + Tans<-Tmp; + if(length(Tans)==0) + { + R<-c(); + return(R); + } + if(length(Tans)==1) + { + Ten1<-Horner(1:2,Tans[1]); + if(InWindow(PA)=="i") + { + R<-Appendrow(PA,Ten1) + return(R) + } + else + { + R<-Appendrow(Ten1,PB) + return(R) + } + } + Ten1<-Horner(1:2,Tans[1]) + Ten2<-Horner(1:2,Tans[2]) + R<-Appendrow(Ten1,Ten2) + return(R) +} + +######################################### + +# New 10.03.21 + +Mixjoin<-function(...) +{ + varargin<-list(...) + Nargs<- length(varargin) + M<- list() + for (I in 1:Nargs) + { + Tmp<-varargin[[I]] + if(length(Tmp)==0) next + if(Mixtype(Tmp)==1) + { + Tmp<-list(Tmp) + } + if(length(M)==0){ + M <- Tmp + } + else{ + M<- c(M,Tmp) + } + } + return(M) +} + +################################# + +Mixlength<- function(PL){ + if(length(PL)==0){ + return(0) + } + if(Mixtype(PL)==1){ + Out<- Nrow(PL) + } + else{ + Out<- length(PL) + } + return(Out) +} + +########################################### + +Mixtype<- function(D) +{ + if(mode(D)!="list") return(1) + for (I in 1:length(D)) + { + Tmp<- D[[I]] + if(mode(Tmp)=="list") return(3) + } + return(2) +} + +########################################### + +Naigai<- function(A,Bdy) +{ + V<- c(1,1) + Call<-length(Bdy) + KL<- KoutenList(A,V,Bdy) + Ptn<- seq(1,1,length=Call) + for (K in Looprange(1,length(KL))) + { + Ten<- Op(K,KL) + T<- Op(1,Ten); NC<- Op(4,Ten) + if(T<0) + { + Tmp<- (Ptn[NC]+1) %% 2 + Ptn[NC]<- Tmp + } + } + return(Ptn) +} + +######################################## + +Nearestpt<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + PL1<- varargin[[1]] + if(!is.matrix(PL1)){ + Tmp<- matrix(PL1); + PL1<- t(Tmp) + } + if(Nrow(PL1)==1) Flg=0 + else Flg=1 + Eps<- 10.0^(-6) + PL<- varargin[[2]] + Ans<- list(PL1[1,],1,PL[1,],1,Norm(PL1[1,]-PL[1,])) + for(N in Looprange(1,Nrow(PL1))){ + PA<- PL1[N,] + Pm<- PL[1,] + Im<- 1 + Sm<- Norm(Pm-PA) + for(I in Looprange(1,Nrow(PL)-1)){ + A1<- PL[I,1]; A2<-PL[I,2] + B1<- PL[I+1,1]; B2<-PL[I+1,2] + V1<- B1-A1; V2<-B2-A2 + X1<- PA[1]; X2<-PA[2] + Tmp<-V2^2+V1^2 + if(abs(Tmp)1+Eps){ + P<- c(B1,B2) + }else{ + P<- c(A1+T*V1,A2+T*V2) + } + } + S<- Norm(P-PA) + if(SN){ + Posstr<- paste("[",varargin[[N+1]],"]",sep="") + } + else{ + Posstr<- "[c]" + } + Openphr(Namestr) + S<- paste("\\begin{minipage}",Posstr,"{",Habastr,"}%\n",sep="") + cat(S,file=Wfile,append=TRUE) +} + +################################### + +Openphr<- function(Str) +{ + S<- paste("\\def",Str,"{%\n",sep="") + cat(S,file=Wfile,append=TRUE) +} + +##################################### + +Ovalbox<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Pos<- varargin[[1]] + Dr<- varargin[[2]] + StrV<- varargin[[3]] + R<- 0.2 + NDflg<- 0 + for (I in Looprange(4,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric"){ + R<- Tmp + } + else{ + if(substr(Tmp,1,1)=="-"){ + NDflg<- 1 + Tmp1<- substr(Tmp,2,nchar(Tmp)) + Cmdstr<- chartr("*","G",Tmp1) + } + } + } + Xr<- c(XMIN,XMAX) + Yr<- c(YMIN,YMAX) + Uv<- 0.6; Uh<- 0.8 + N<- nchar(StrV) + W<- Uh;H<- Uv*N + Setwindow(c(-W/2,W/2),c(-H,0)) + G<- Ovaldata(c(0,-H/2),W/2,H/2,R) + Openphr("\\ketpictmp") + Beginpicture("1cm") + if(NDflg==0){ + Drwline(G) + } + else{ + eval(parse(text=Cmdstr)) + } + for (I in Looprange(1,N)){ + Letter(c(0,Uv/2-Uv*I),"c",Op(I,StrV)) + } + Endpicture(0) + Closephr() + Setwindow(Xr,Yr) + Letter(Pos,Dr,"\\ketpictmp") +} + +########################################## + +Ovaldata<- function(...) #17.09.11 +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==1){ + Eps<- 1.0*10^(-4) + C<- c((XMIN+XMAX)/2,(YMIN+YMAX)/2) + Dx<- XMAX-C(1)-Eps + Dy<- YMAX-C(2)-Eps + N<- 1 + } + else{ + C<- varargin[[1]] + Dx<- varargin[[2]] + Dy<- varargin[[3]] + N<- 4 + } + Rc<- 0.2 + if(N<=Nargs){ #15.11.15 + Rc<- varargin[[N]]*Rc #15.11.15 + } + Out<- c() + P<- C+c(Dx-Rc,Dy-Rc) + Tmp1<- Circledata(c(P,Rc),"R=c(0,pi/2)","N=10") #17.11.29 + Tmp2<- Listplot(C+c(Dx-Rc,Dy),C+c(0,Dy)) + Tmp3<- Listplot(C+c(Dx,0),C+c(Dx,Dy-Rc)) + G<- Joincrvs(Tmp3,Tmp1,Tmp2) + Tmp<- Reflectdata(G,c(C,C+c(0,1))) + G<- Joincrvs(G,Tmp) + Tmp<- Reflectdata(G,c(C,C+c(1,0))) + Out<- Joincrvs(G,Tmp) +} + +######################################### + +Paramark<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + PA<- varargin[[1]] + PB<- varargin[[2]] + PC<- varargin[[3]] + R<- 0.5 + if(Nargs>=4){ + R<- varargin[[4]]*R + } + U<- R*(PA-PB)/Norm(PA-PB) + V<- R*(PC-PB)/Norm(PC-PB) + if(Crossprod(PA-PB,PC-PB)!=0){ + P<- Listplot(c(PB+U,PB+U+V,PB+V)) + } + else{ + P<- c() + } +} + +########################################### + +Paramoncurve<-function(...){ + varargin<-list(...) + Nargs<-length(varargin) + Eps<-10^(-8) + P<-varargin[[1]] + Gdata<-varargin[[Nargs]] + if(Nrow(P)>1){ + Tmp<-P; P<-Gdata; Gdata<-Tmp + } + if(Nargs==2){ + Tmp<-Nearestpt(P,Gdata) + Out<-Tmp[[2]] + return(Out) + } + N<-varargin[[2]] + PtL<-Gdata + N=min(N,Length(PtL)-1) #18.02.11from + Pa<-Ptcrv(N,PtL) + Pb<-Ptcrv(N+1,PtL) + V<-Pb-Pa + W<-P-Pa + D2<-Norm(V)^2 + if(D20) + { + E<-sort(E) + E0 && Op(Nrow(P),P)!=c(Inf,Inf)) + { + Pa<- c(Inf,Inf) + } + } + if(t-E[Ke]>Eps) + { + if(Fnflg==0) + { + Tmp<- eval(parse(text=Str)) + Pa<- Tmp + } + else + { + } + Ke<-Ke+1 + } + if(length(Pa)>0) + { + if(Pa[1]==Inf) + { + Tmp<-Appendrow(P,Pa) + P<-Tmp + } + else + { + if(Nrow(P)==0) + { + Tmp<- Appendrow(P,Pa) + P<-Tmp + } + else + { + Tmp<- Op(Nrow(P),P) + if(Tmp[1]==Inf) + { + Tmp<- Appendrow(P,Pa) + P<- Tmp + } + else + { + if(Norm(Tmp-Pa)B+Eps){ + Npt<- Numptcrv(PkL) + Out1<- Partcrv(A,Npt,PkL) + Out2<- Partcrv(1,B,PkL) + Tmp<- Ptstart(PkL)-Ptend(PkL) + if(Norm(Tmp)Ie+Eps){ + P<- (1-B+Ie)*PkL[Ie,]+(B-Ie)*PkL[Ie+1,] + PL<- Appendrow(PL,P) + } + Ans<- PL + return(Ans) + } + Tmp<- Nearestpt(A,PkL) + Ta<- Op(2,Tmp) + Tmp<- Nearestpt(B,PkL) + Tb<- Op(2,Tmp) + Ans<- Partcrv(Ta,Tb,PkL) +} + +########################################## +# 13.05.03 + +Partframe<- function(Tb,St,Ed) +{ + G<- Dividetable(Tb) + Gw<- G[[1]] + Gt<- G[[2]] + Gy<- G[[3]] + Gwt<- Tb[[4]] + Gwy<- Tb[[5]] + Gat<- c(list(Gwt[[1]]),Gt,list(Gwt[[2]])) + Gay<- c(list(Gwy[[1]]),Gy,list(Gwy[[2]])) + Tmp1<- Ptstart(Gat[[St[1]]]) + Tmp2<- Ptstart(Gay[[St[2]]]) + Ps<- c(Tmp1[1],Tmp2[2]) + Tmp1<- Ptstart(Gat[[Ed[1]]]) + Tmp2<- Ptstart(Gay[[Ed[2]]]) + Pe<- c(Tmp1[1],Tmp2[2]) + Pars<- Paramoncurve(Ps,Gw) + Pare<- Paramoncurve(Pe,Gw) + if(Pars0){ + E<-sort(E) + E0){ + Tmp<-eval(parse(text=Exfun)) + if(abs(Tmp)0 && P[Nrow(P),]!=c(Inf,Inf)){ + Pa<- c(Inf,Inf) + } + } + if(x-E[Ke]>Eps){ + Tmp<- eval(parse(text=Str)) + Pa<- c(x,Tmp) + Ke<-Ke+1 + } + if(length(Pa)>0){ + if(Pa[1]==Inf){ + Tmp<-Appendrow(P,Pa) + P<-Tmp + } + else{ + if(Nrow(P)==0){ + Tmp<- Appendrow(P,Pa) + P<-Tmp + } + else{ + Tmp<- P[Nrow(P),] + if(Tmp[1]==Inf){ + Tmp<- Appendrow(P,Pa) + P<- Tmp + } + else{ + if(Norm(Tmp-Pa)1) + { + Tmp<-T; T<-Gdata; Gdata<-Tmp + } + PtL<-Gdata + N<-trunc(T+Eps); + S<-max(T-N,0); + if(N==Nrow(PtL)) + { + Out<-PtL[N,] + } + else + { + Pa<-PtL[N,] + Pb<-PtL[N+1,] + Out<-(1-S)*Pa+S*Pb + } + return(Out) +} + +############################################## +# 10.11.20 +# 13.05.03 Inf + +Pointdata<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + PL<- list() + for (I in Looprange(1,Nargs)){ # 10.11.20 + DL<-varargin[[I]] + DL<- Flattenlist(DL) # 10.11.20 from here + for (J in Looprange(1,length(DL))){ + Dt<- DL[[J]] + if(is.matrix(Dt)|| is.data.frame(Dt)){ + for (K in 1:nrow(Dt)){ + Tmp<- as.numeric(Dt[K,]) + if(Tmp[1]0){ #18.02.09 + return(Op(Length(Fig),Fig)) + }else{ + return(c()) + } +} + +######################################### + +Ptne<-function(...) +{ + varargin<- list(...) + if(length(varargin)==0){ + Out<- c(XMAX,YMAX) + } + else{ + G<- varargin[[1]] + XM<- max(G[,1]) + YM<- max(G[,2]) + Out<- c(XM,YM) + } + return(Out) +} + +######################################### + +Ptnw<-function(...) +{ + varargin<- list(...) + if(length(varargin)==0){ + Out<- c(XMIN,YMAX) + } + else{ + G<- varargin[[1]] + Xm<- min(G[,1]) + YM<- max(G[,2]) + Out<- c(Xm,YM) + } + return(Out) +} + +######################################### + +Ptse<-function(...) +{ + varargin<- list(...) + if(length(varargin)==0){ + Out<- c(XMAX,YMIN) + } + else{ + G<- varargin[[1]] + XM<- max(G[,1]) + Ym<- min(G[,2]) + Out<- c(XM,Ym) + } + return(Out) +} + +############################################# + +Ptstart<-function(Fig) +{ + if(Length(Fig)>0){ #18.02.09 + return(Op(1,Fig)) + }else{ + return(c()) + } +} + +######################################### + +Ptsw<-function(...) +{ + varargin<- list(...) + if(length(varargin)==0){ + Out<- c(XMIN,YMAX) + } + else{ + G<- varargin[[1]] + Xm<- min(G[,1]) + Ym<- min(G[,2]) + Out<- c(Xm,Ym) + } + return(Out) +} + +############################################## + +Putcell<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + Str<- varargin[[Nargs]] + if(mode(Str)=="numeric"){ + Str<- as.character(Str) + } + Pos<- varargin[[Nargs-1]] + Nrg<- varargin[[2]] + if(mode(Nrg)=="character"){ + if(Nargs==4){ + Cell<- Findcell(TbL,Nrg) + } + else{ + Mrg<- varargin[[3]] + Cell<- Findcell(TbL,Nrg,Mrg) + } + } + else{ + Mrg<- varargin[[3]] + Cell<- Findcell(TbL,Nrg,Mrg) + } + Pt<- Cell[[1]]; Dr<- "c" + Posh<- substr(Pos,1,1) + Post<- substr(Pos,2,nchar(Pos)) + if(toupper(Posh)=="R"){ + Pt<- Pt+c(Cell[[2]],0) + if(nchar(Post)==0){ + Dr<- "w1" + } + else{ + Dr<- paste("w",Post,sep="") + } + } + if(toupper(Posh)=="L"){ + Pt=Pt-c(Cell[[2]],0) + if(nchar(Post)==0){ + Dr<- "e1" + } + else{ + Dr<- paste("e",Post,sep="") + } + } + if(toupper(Posh)=="U"){ + Pt<- Pt+c(0,Cell[[3]]) + if(nchar(Post)==0){ + Dr<- "s1" + } + else{ + Dr<- paste("s",Post,sep="") + } + } + if(toupper(Posh)=="D"){ + Pt<- Pt-c(0,Cell[[3]]) + if(nchar(Post)==0){ + Dr<- "n1" + } + else{ + Dr<- paste("n",Post,sep="") + } + } + if(toupper(Posh)=="B"){ + Pt<- Pt-c(0,Cell[[3]]) + if(nchar(Post)==0){ + Dr<- "n1" + } + else{ + Dr<- paste("n",Post,sep="") + } + Str<- paste("$\\mathstrut$",Str,sep="") + } + Letter(Pt,Dr,Str) +} + +############################################# + +PutcoL<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + if(mode(TbL)!="list"){ + return("Tabledata missing") + } + Ag<- varargin[[2]] + if(mode(Ag)=="numeric"){ + CoL<- Ag + } + else{ + Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Clm<- c() + for (I in Looprange(1,nchar(Ag))){ + C<- substr(Ag,I,I) + C<- toupper(C) + Tmp<- strsplit(Alpha,C) + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + Tmp1<- nchar(Tmp[1]) + Clm<- c(Clm,Tmp1) + } + } + Nrg<- 0 + for (I in seq(length(Clm),1,by=-1)){ + Tmp<- Clm[I] + Tmp1<- length(Clm)-I + Nrg<- Nrg+Tmp*26^Tmp1 + } + CoL<- Nrg + } + Nc<- length(TbL[[3]])+1 + K<- 1 + Dpos<- varargin[[3]] + for (I in Looprange(4,Nargs)){ + if(I-3>Nc){ + break + } + Dt<- varargin[[I]] + if(mode(Dt)!="list"){ + Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 + K<- K+1 + } + else{ + N<- length(Dt) + Str<- Dt[[N]] + Rrng<- c(K,K+1) + Pos<- Dpos + for (J in Looprange(1,N-1)){ + Tmp<- Dt[[J]] + if(mode(Tmp)=="numeric"){ + Rrng<- c(K,K+Tmp) + } + if(mode(Tmp)=="character"){ + Pos<- Tmp + } + } + Putcell(TbL,CoL,Rrng,Pos,Str) + K<- Crng[2] + } + } +} + +Putcol<- function(...) +{ + PutcoL(...) +} + +PutcoLexpr<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + if(mode(TbL)!="list"){ + return("Tabledata missing") + } + Ag<- varargin[[2]] + if(mode(Ag)=="numeric"){ + CoL<- Ag + } + else{ + Alpha<- "-ABCDEFGHIJKLMNOPQRSTUVWXYZ" + Clm<- c() + for (I in Looprange(1,nchar(Ag))){ + C<- substr(Ag,I,I) + C<- toupper(C) + Tmp<- strsplit(Alpha,C) + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + Tmp1<- nchar(Tmp[1]) + Clm<- c(Clm,Tmp1) + } + } + Nrg<- 0 + for (I in seq(length(Clm),1,by=-1)){ + Tmp<- Clm[I] + Tmp1<- length(Clm)-I + Nrg<- Nrg+Tmp*26^Tmp1 + } + CoL<- Nrg + } + Nc<- length(TbL[[3]])+1 + K<- 1 + Dpos<- varargin[[3]] + for (I in Looprange(4,Nargs)){ + if(I-3>Nc){ + break + } + Dt<- varargin[[I]] + if(mode(Dt)!="list"){ + Dt<- paste("$",Dt,"$",sep="") + Putcell(TbL,CoL,K,Dpos,Dt) # 2011.03.02 + K<- K+1 + } + else{ + N<- length(Dt) + Str<- paste("$",Dt[[N]],"$",sep="") + Rrng<- c(K,K+1) + Pos<- Dpos + for (J in Looprange(1,N-1)){ + Tmp<- Dt[[J]] + if(mode(Tmp)=="numeric"){ + Rrng<- c(K,K+Tmp) + } + if(mode(Tmp)=="character"){ + Pos<- Tmp + } + } + Putcell(TbL,CoL,Rrng,Pos,Str) + K<- Crng[2] + } + } +} + +Putcolexpr<- function(...) +{ + PutcoLexpr(...) +} + +##################################################### + +PutcoLstr<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Tb<- varargin[[1]] + Nr<- varargin[[2]] + Pos<- varargin[[3]] + Str<- varargin[[4]] + Sep<- "" + if(Nargs>4){ + Sep<- varargin[[5]] + } + if(nchar(Sep)==0){ + for (I in Looprange(1,nchar(Str))){ + Tmp<- substr(Str,I,I) + Putcell(Tb,Nr,I,Pos,Tmp) + } + } + else{ + Ltr<- "" + K<- 1 + for (I in Looprange(1,length(Str))){ + Tmp<- substr(Str,I,I) + if(Tmp==Sep){ + Putcell(Tb,Nr,K,Pos,Ltr) + K<- K+1 + Ltr<- "" + } + else{ + Ltr<- paste(Ltr,Tmp,sep="") + } + } + if(nchar(Ltr)>0){ + Putcell(Tb,Nr,K,Pos,Ltr) + } + } +} + +############################################# + +Putrow<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + if(mode(TbL)!="list"){ + return("Tabledata missing") + } + Row<- varargin[[2]] + Nr<- length(TbL[[2]])+1 + K<- 1 + Dpos<- varargin[[3]] + for (I in Looprange(4,Nargs)){ + if(I-3>Nr){ + break; + } + Dt<- varargin[[I]] + if(mode(Dt)!="list"){ + Putcell(TbL,K,Row,Dpos,Dt) # 110308 + K<- K+1 + } + else{ + N<- length(Dt) + Str<- Dt[[N]] + Crng<- c(K,K+1) + Pos<- Dpos + for (J in Looprange(1,N-1)){ + Tmp<- Dt[[J]] + if(mode(Tmp)=="numeric"){ + Crng<- c(K,K+Tmp) + } + if(mode(Tmp)=="character"){ + Pos<- Tmp + } + } + Putcell(TbL,Crng,Row,Pos,Str) + K<- Crng[2] + } + } +} + +Putrowexpr<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + TbL<- varargin[[1]] + if(mode(TbL)!="list"){ + return("Tabledata missing") + } + Row<- varargin[[2]] + Nr<- length(TbL[[2]])+1 + K<- 1 + Dpos<- varargin[[3]] + for (I in Looprange(4,Nargs)){ + if(I-3>Nr){ + break; + } + Dt<- varargin[[I]] + if(mode(Dt)!="list"){ + Dt<- paste("$",Dt,"$",sep="") + Putcell(TbL,K,Row,Dpos,Dt) #110308 + K<- K+1 + } + else{ + N<- length(Dt) + Str<- paste("$",Dt[[N]],"$",sep="") + Crng<- c(K,K+1) + Pos<- Dpos + for (J in Looprange(1,N-1)){ + Tmp<- Dt[[J]] + if(mode(Tmp)=="numeric"){ + Crng<- c(K,K+Tmp) + } + if(mode(Tmp)=="character"){ + Pos<- Tmp + } + } + Putcell(TbL,Crng,Row,Pos,Str) + K<- Crng[2] + } + } +} + +#################################################### + +Putrowstr<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Tb<- varargin[[1]] + Nr<- varargin[[2]] + Pos<- varargin[[3]] + Str<- varargin[[4]] + Sep<- "" + if(Nargs>4){ + Sep<- varargin[[5]] + } + if(nchar(Sep)==0){ + for (I in Looprange(1,nchar(Str))){ + Tmp<- substr(Str,I,I) + Putcell(Tb,I,Nr,Pos,Tmp) + } + } + else{ + Ltr<- "" + K<- 1 + for (I in Looprange(1,length(Str))){ + Tmp<- substr(Str,I,I) + if(Tmp==Sep){ + Putcell(Tb,K,Nr,Pos,Ltr) + K<- K+1 + Ltr<- "" + } + else{ + Ltr<- paste(Ltr,Tmp,sep="") + } + } + if(nchar(Ltr)>0){ + Putcell(Tb,K,Nr,Pos,Ltr) + } + } +} + +############################################ +# 11.05.28 + +Ratiocmyk<- function(Color) +{ + if(is.numeric(Color)){ + return(Color) + } + R<- + switch(Color, + greenyellow=c(0.15,0,0.69,0), + yellow=c(0,0,1,0), + goldenrod=c(0,0.1,0.84,0), + dandelion=c(0,0.29,0.84,0), + apricot=c(0,0.32,0.52,0), + peach=c(0,0.5,0.7,0), + melon=c(0,0.46,0.5,0), + yelloworange=c(0,0.42,1,0), + orange=c(0,0.61,0.87,0), + burntorange=c(0,0.51,1,0), + bittersweet=c(0,0.75,1,0.24), + redorange=c(0,0.77,0.87,0), + mahogany=c(0,0.85,0.87,0.35), + maroon=c(0,0.87,0.68,0.32), + brickred=c(0,0.89,0.94,0.28), + red=c(0,1,1,0), + orangered=c(0,1,0.5,0), + rubinered=c(0,1,0.13,0), + wildstrawberry=c(0,0.96,0.39,0), + salmon=c(0,0.53,0.38,0), + carnationpink=c(0,0.63,0,0), + magenta=c(0,1,0,0), + violetred=c(0,0.81,0,0), + rhodamine=c(0,0.82,0,0), + mulberry=c(0.34,0.9,0,0.02), + redviolet=c(0.07,0.9,0,0.34), + fuchsia=c(0.47,0.91,0,0.08), + lavender=c(0,0.48,0,0), + thistle=c(0.12,0.59,0,0), + orchid=c(0.32,0.64,0,0), + darkorchid=c(0.4,0.8,0.2,0), + purple=c(0.45,0.86,0,0), + plum=c(0.5,1,0,0), + violet=c(0.79,0.88,0,0), + royalpurple=c(0.75,0.9,0,0), + blueviolet=c(0.86,0.91,0,0.04), + periwinkle=c(0.57,0.55,0,0), + cadetblue=c(0.62,0.57,0.23,0), + cornflowerblue=c(0.65,0.13,0,0), + midnightblue=c(0.98,0.13,0,0.43), + navyblue=c(0.94,0.54,0,0), + royalblue=c(1,0.5,0,0), + blue=c(1,1,0,0), + cerulean=c(0.94,0.11,0,0), + cyan=c(1,0,0,0), + processblue=c(0.96,0,0,0), + skyblue=c(0.62,0,0.12,0), + turquoise=c(0.85,0,0.2,0), + tealblue=c(0.86,0,0.34,0.02), + aquamarine=c(0.82,0,0.3,0), + bluegreen=c(0.85,0,0.33,0), + emerald=c(1,0,0.5,0), + junglegreen=c(0.99,0,0.52,0), + seagreen=c(0.69,0,0.5,0), + green=c(1,0,1,0), + forestgreen=c(0.91,0,0.88,0.12), + pinegreen=c(0.92,0,0.59,0.25), + limegreen=c(0.5,0,1,0), + yellowgreen=c(0.44,0,0.74,0), + springgreen=c(0.26,0,0.76,0), + olivegreen=c(0.64,0,0.95,0.4), + rawsienna=c(0,0.72,1,0.45), + sepia=c(0,0.83,1,0.7), + brown=c(0,0.81,1,0.6), + tan=c(0.14,0.42,0.56,0), + gray=c(0,0,0,0.5), + black=c(0,0,0,1), + white=c(0,0,0,0) + ) + if(length(R)<4){ + print("No color") + return(c()) + } + return(R) +} + +############################################ +# 11.01.07 + +Readtextdata<- function(...) +{ + varargin<- list(...) + OutL<- list() + Nargs<- length(varargin) + Fname<- varargin[[1]] + Tmp<- readLines(Fname,n=1) + if(length(grep("\t",Tmp))>0){ + Sep<- "\t" + } + else if(length(grep(",",Tmp))>0){ + Sep<- "," + } + else{ + Sep<- " " + } + Hajime<- c(1,1) + Owari<- c(Inf,Inf) + C<- Inf + R<- Inf + Rna<- FALSE + Cna<- TRUE + Mat<- FALSE + Num<- TRUE + D<- -Inf + Flg<- 0 + for (I in Looprange(2,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric"){ + if (Flg==0){ + Hajime<- Tmp + Flg<- 1 + } + else{ + Owari<- Tmp + } + } + else{ + eval(parse(text=Tmp)) + } + } + Tmp<- Hajime+c(R-1,C-1) + Owari<- c(min(Owari[1],Tmp[1]),min(Owari[2],Tmp[2])) + if(Cna){ + Df<- read.table(Fname,sep=Sep,header=TRUE,,stringsAsFactors=FALSE) + } + else{ + Df<- read.table(Fname,sep=Sep,header=FALSE,,stringsAsFactors=FALSE) + Nv<- c(1:ncol(Df)) + colnames(Df)<- Nv + } + if(Rna){ + rownames(Df)<-Df[,1] + Hajime<- Hajime+c(0,1) + } + if(Mat){ + M<- as.matrix(Df) + Tmp1<- min(Owari[1],nrow(M)) + Tmp2<- min(Owari[2],ncol(M)) + Out<- as.matrix(M[Hajime[1]:Tmp1,Hajime[2]:Tmp2]) + if(Num){ + Tmp1<- as.numeric(Out) + Out<- matrix(Tmp1,nrow=nrow(Out)) + } + } + else{ + Tmp1<- min(Owari[1],nrow(Df)) + Tmp2<- min(Owari[2],ncol(Df)) + Out<- Df[Hajime[1]:Tmp1,Hajime[2]:Tmp2] + } + if(D!=-Inf){ # 11.01.20 v2 + Tmp<- ncol(Out) # 11.01.07 + Tmp1<- rep(Inf,Tmp) + Out[Out[,1]<=D,]<- Tmp1 # 11.01.07 + } + return(Out) +} + +################################## + +Reflectdata<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-8) + ML<- varargin[[1]] + if(Mixtype(ML)==1){ + ML<- list(ML) + } + if(Nargs==1){ + PtA<- c(0,0); PtB<- PtA + } + else{ + Pts<- varargin[[2]] + if(length(Pts)==2){ + PtA<- Pts; PtB<- PtA + } + else{ + PtA<- Pts[1:2]; PtB<- Pts[3:4] + } + } + OutL<- list() + for (N in Looprange(1,length(ML))){ + GL<- Op(N,ML) + Out<- c() + for (I in Looprange(1,Nrow(GL))){ + if(is.matrix(GL)){ # 10.12.07 + Tmp<- GL[I,] + } + else{ + Tmp<- GL + } + X1<- Tmp[1] + Y1<- Tmp[2] + if(X1==Inf){ + X2<- X1 + Y2<- Y1 + } + else{ + if(Norm(PtA-PtB)0){ + Str=paste(Str,",",sep="") + } + if(length(Pt)<3){ + Str=paste(Str,sprintf("[%5.5f,%5.5f]",Pt[1],Pt[2]),sep="") + } + else{ + Str=paste(Str,sprintf("[%5.5f,%5.5f,%5.5f]",Pt[1],Pt[2],Pt[3]),sep="") + } + if(nchar(Str)>80){ + cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) + Str="" + } + } + if(nchar(Str)>0){ + cat("[",Str,"]//","\n",sep="",file=Fname,append=TRUE) + } + if((N==Nargs-1) & (K==length(Gdata)) & (J==length(GL))){ +# cat("end////","\n",sep="",file=Fname,append=TRUE) + cat("end//","\n",sep="",file=Fname,append=TRUE) + } + else{ + cat("end//","\n",sep="",file=Fname,append=TRUE) + } + } + } + } + cat("//","\n",sep="",file=Fname,append=TRUE) # 15.11.05 +} + +###### Old #################################### +# 2015.10.23 +ReadOutData<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Fname=varargin[[1]] + cmdall=readLines(Fname) + cmdall=gsub("//","",cmdall,fixed=TRUE) + varname=cmdall[1] + outdt=list() + varL=c() + ptL=list() + flg=0 + for(cmd in cmdall){ + if(nchar(cmd)>0){ + if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ + if(cmd=="start"){ + pts=c() + } + if(cmd=="end"){ + ptL=c(ptL,list(pts)) + } + if(substring(cmd,1,1)=="["){ + tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") + tmp1=strsplit(tmp1,"]",fixed=TRUE) + tmp1=tmp1[[1]] + tmp1=gsub(",[","c(",tmp1,fixed=TRUE) + for(st in tmp1){ + tmp=eval(parse(text=paste(st,")",sep=""))) + pts=rbind(pts,tmp) + } + row.names(pts)=1:nrow(pts) + } + } + else{ + varname=cmd + varL=c(varL,varname) + if(flg==0){ # 17.10.07from + flg=1 + }else{ + outdt=c(outdt,list(ptL)) + } # 17.10.07until + ptL=c() + } + } + } + outdt=c(outdt,list(ptL)) # 17.10.07 + names(outdt)=varL + for(var in varL){ + tmp=paste(var,"<<- outdt$",var,sep="") + eval(parse(text=tmp)) + } +# print(varL) + outdt +} + +#################################################### + +ReadOutData<- function(...){ #2017.10.23 + varargin<- list(...) + Nargs<- length(varargin) + Fname=varargin[[1]] + cmdall=readLines(Fname) + cmdall=gsub("//","",cmdall,fixed=TRUE) + varname=""#17.12.13 cmdall[1] + outdt=list() + varL=c() + ptL=list() + flg=0 + for(cmd in cmdall){ + if(nchar(cmd)>0){ + if((cmd=="start") | cmd=="end" | substring(cmd,1,1)=="["){ + if(cmd=="start"){ + tmp=paste(varname,"<<- c(",varname,",list(c()))",sep="") + eval(parse(text=tmp)) + Ctr=Ctr+1 + } + if(cmd=="end"){ + } + if(substring(cmd,1,1)=="["){ + tmp1=paste(",",substring(cmd,2,nchar(cmd)-1),sep="") + tmp1=strsplit(tmp1,"]",fixed=TRUE) + tmp1=tmp1[[1]] + tmp1=gsub(",[","c(",tmp1,fixed=TRUE) + for(st in tmp1){ + tmp=paste(varname,"[[",as.character(Ctr),"]]",sep="") + tmp=paste(tmp,"<<- rbind(",tmp,",",st,"))",sep="")# + eval(parse(text=tmp)) + } + } + } + else{ + # 17.12.13from + if(nchar(varname)>0){ + tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") + eval(parse(text=tmp)) + } + # 17.12.13until + varname=cmd + tmp=paste(varname,"<<- list()",sep="") + eval(parse(text=tmp)) + Ctr=0 + if(flg==0){ # 17.10.07from + flg=1 + }else{ + } # 17.10.07until + } + } + } + # 17.12.13from + tmp=paste("if(length(",varname,")==1){",varname,"<<- ",varname,"[[1]]}",sep="") + eval(parse(text=tmp)) + # 17.12.13until +} + +#################################################### + +Rotatedata<- function(..., deg=FALSE) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-8) + ML<- varargin[[1]] + if(Mixtype(ML)==1){ + ML<- list(ML) + } + Theta<- varargin[[2]] + if(deg) Theta<- Theta*pi/180 # 10.12.07 + if(Nargs==2){ + Pt<- c(0,0) + } + else{ + Pt<- varargin[[3]] + } + Cx<- Pt[1]; Cy<- Pt[2] + OutL<- c() + for (N in Looprange(1,length(ML))){ + GL<- Op(N,ML) + Out<- c() + for (I in Looprange(1,Nrow(GL))){ + if(is.matrix(GL)){ + Tmp<- GL[I,] + } + else{ + Tmp<- GL + } + X1<- Tmp[1] + Y1<- Tmp[2] + if(X1==Inf){ + X2<- X1 + Y2<- Y1 + } + else{ + X2<- Cx+(X1-Cx)*cos(Theta)-(Y1-Cy)*sin(Theta) + Y2<- Cy+(X1-Cx)*sin(Theta)+(Y1-Cy)*cos(Theta) + } + Out<- Appendrow(Out,c(X2,Y2)) + } + if(nrow(Out)==1){ + Out<- Out[1,] + } + OutL<- Mixjoin(OutL,list(Out)) + } + if(length(OutL)==1){ + OutL<- Op(1,OutL) + } + return(OutL) +} + +############################################### + +Scaledata<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-8) + ML<- varargin[[1]] + if(Mixtype(ML)==1){ + ML<- list(ML) + } + A<- varargin[[2]] + B<- varargin[[3]] + if(Nargs==3){ + Pt<- c(0,0) + } + else{ + Pt<- varargin[[4]] + } + OutL<- list() + for (N in Looprange(1,length(ML))){ + GL<- Op(N,ML) + Out<- c() + for (I in Looprange(1,Nrow(GL))){ + if(is.matrix(GL)){ # 10.12.07 + Tmp<- GL[I,] + } + else{ + Tmp<- GL + } + X1<- Tmp[1] + Y1<- Tmp[2] + if(X1==Inf){ + X2<- X1 + Y2<-Y1 + } + else{ + X2<- Pt[1]+A*(X1-Pt[1]) + Y2<- Pt[2]+B*(Y1-Pt[2]) + } + Out<- Appendrow(Out,c(X2,Y2)) + } + OutL<- Mixjoin(OutL,list(Out)) + } + if(length(OutL)==1){ + OutL<- Op(1,OutL) + } + return(OutL) +} + +################################ + +Setarrow<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + Str<- paste("Size=",YaSize,",","Angle=",YaAngle,",",sep="") + Str<- paste(Str,"Position=",YaThick,",","Style=",YaStyle,sep="") + return(Str) + } + Flg<- 0 + for (I in 1:Nargs){ + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric"){ + Flg<- Flg+1 + if(Flg==1) YaSize<<-Tmp + if(Flg==2){ + if(Tmp<5){ + YaAngle<<- 18*Tmp + } + else{ + YaAngle<<- Tmp + } + } + if(Flg==3) YaPosition<<- Tmp + if(Flg==4) YaThick<<- Tmp + } + if(mode(Tmp)=="character"){ + YaStyle<<- Tmp + } + } +} + +#################################### + +Setax<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + if(ZIKU=="line"){ + Tmp<- "," + } + else{ + Tmp<- paste("(Arrowsize=", as.character(ARROWSIZE),"),",sep="") + } + Str<- paste(ZIKU,Tmp,XNAME,",",XPOS,",",sep="") + Str<- paste(Str,YNAME,",",YPOS,",",ONAME,",",OPOS,sep="") + return(Str) + } + ArgL<- c() + Is<- 1 + Tmp<- varargin[[1]] + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + Is<- varargin[[1]] + ArgL<- c() + for (I in Looprange(1,Is-1)){ + ArgL<- c(ArgL,"") + } + for (I in Looprange(2,Nargs)){ + ArgL<- c(ArgL,varargin[[I]]) + } + } + else{ + if(Nargs==1){ + ArgL<- c(varargin[[1]]) + } + else{ + Tmp<- varargin[[2]] + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + ARROWSIZE<<-Tmp + ArgL<- c(varargin[[1]]) + for (I in Looprange(3,Nargs)){ + ArgL<- c(ArgL,varargin[[I]]) + } + } + else{ + ArgL<- c() + for (I in 1:Nargs){ + ArgL<- c(ArgL,varargin[[I]]) + } + } + } + } + for (I in Looprange(length(ArgL)+1,7)){ + ArgL<- c(ArgL,"") + } + Zk<- ArgL[1] + if(nchar(Zk)>0){ + ZL<-substr(Zk,2,nchar(Zk)) + Zk<-substr(Zk,1,1) + if(nchar(ZL)>0){ + ARROWSIZE<<- as.numeric(ZL) + } + } + Xn<- ArgL[2]; Xp<- ArgL[3] + Yn<- ArgL[4]; Yp<- ArgL[5] + Genn<- ArgL[6]; Genp<- ArgL[7] + if(nchar(Zk)>0){ + C<- Zk + if(C=="a"){ + ZIKU<<- "arrow" + } + else{ + ZIKU<<- "line" + } + } + if(nchar(Xn)>0){ + XNAME<<- paste("$",Xn,"$",sep="") + } + if(nchar(Xp)>0){ + XPOS<<- Xp + } + if(nchar(Yn)>0){ + YNAME<<- paste("$",Yn,"$",sep="") + } + if(nchar(Yp)>0){ + YPOS<<-Yp + } + if(nchar(Genn)>0){ + ONAME<<- Genn + } + if(nchar(Genp)>0){ + OPOS<<- Genp + } + Out<- ""; +} + +################################# +# 11.08.24 + +Setcolor<- function(...){ + varargin<- list(...) + Color<- 'black' + Kosa<- 1 + for(J in Looprange(1,length(varargin))){ + Tmp<- varargin[[J]] + if(is.character(Tmp)) Color<- Tmp + if(is.numeric(Tmp)){ + if(length(Tmp)==1){# 11.08.24 + Kosa<- Tmp + } + else{ + Color<- Tmp + } + }# 11.08.24 + } + Iro<- Ratiocmyk(Color) + if(length(Iro)==0) return(c()) + Str<- "\\color[cmyk]{" #17.09.22 + for(J in 1:4){ + Str<- paste(Str,as.character(Kosa*Iro[J]),sep="") + if(J<4){ + Str<- paste(Str,",",sep="") + } + } + Str<- paste(Str,"}",sep="") + Texcom(Str) +} + +################################## + +Setmarklen<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + Tmp<- MARKLENNow/MARKLENInit + Tmp=round(Tmp*100)/100 + return(Tmp) + } + Size<- varargin[[1]] + MARKLENNow<<- MARKLENInit*Size + MARKLEN<<- MARKLENNow*1000/2.54/MilliIn +} + +############################### + +Setorigin<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0){ + return(GENTEN) + } + Pt<- varargin[[1]] + GENTEN<<- Pt; +} + +################################ + +Setscaling<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0) + { + return(c(SCALEY,LOGX,LOGY)) + } + for (I in 1:Nargs) + { + Tmp<- varargin[[I]] + if(mode(Tmp)=="numeric") + { + SCALEY<<- Tmp + } + if(mode(Tmp)=="character") + { + if(Tmp=="l") + { + LOGX<<- 0 + LOGY<<- 1 + } + else if(Tmp=="ll") + { + LOGX<<- 1 + LOGY<<- 1 + } + else + { + LOGX<<- 0 + LOGY<<- 0 + } + } + } + Tmp<- c(SCALEY,LOGX,LOGY); +} + +######################################### + +Setpen<-function(Width) +{ + PenThick<<-round(PenThickInit*Width) + Str=paste("\\special{pn ", as.character(PenThick),"}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) +} + +############################################## + +Setpt<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + if(Nargs==0) + { + Tmp<- TenSize/TenSizeInit + Tmp<- round(Tmp*100)/100 + return(Tmp) + } + Size<- varargin[[1]] + TenSize<<- TenSizeInit*Size; +} + +############################################## + +Setunitlen<-function(...) +{ + varargin<-list(...) + if(length(varargin)==0){ + return(ULEN) + } + Ul=varargin[[1]] + Dx<-XMAX-XMIN + Dy<-YMAX-YMIN + Sym<-".0123456789 +-*/" + SL<-Sym + OL<-"+-*/" + if(nchar(Ul)>0){ + ULEN<<-Ul + } + Is<-1 + VL<-"" + Ucode<-ULEN + for (I in 1:nchar(Ucode)){ + C<-substring(Ucode,I,I) + if(length(grep(C,SL))>0){ + if(length(grep(C,OL))>0){ + Tmp<-substring(Ucode,Is,I-1) + Str<-paste(VL,Tmp,C,sep="") + VL<-Str + Is<-I+1 + } + } + else{ + Unit<-substring(Ucode,I,I+1) + Str<-substring(Ucode,Is,I-1) + VL<-paste(VL,Str,sep="") + break; + } + } + Valu<-eval(parse(text=VL)) + Str<-as.character(Valu) + ULEN<<-paste(Str,Unit,sep=""); + if(Unit=="cm") MilliIn<<-1000/2.54*Valu + if(Unit=="mm") MilliIn<<-1000/2.54*Valu/10 + if(Unit=="in") MilliIn<<-1000*Valu + if(Unit=="pt") MilliIn<<-1000/72.27*Valu + if(Unit=="pc") MilliIn<<-1000/6.022*Valu + if(Unit=="bp") MilliIn<<-1000/72*Valu + if(Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu + if(Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu + if(Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 + MARKLEN<<-MARKLENNow*1000/2.54/MilliIn + MEMORI<<-MEMORINow*1000/2.54/MilliIn #17.12.17 +} + +######################################### +# 10.11.20 + +Setwindow<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + if(Nargs==0){ + Out<-c(XMIN,XMAX,YMIN,YMAX) + return(Out) + } + if(Nargs==1){ + Dt<- varargin[[1]] + if(is.list(Dt) && !is.data.frame(Dt)){ + Tmp<- as.data.frame(Dt) + Dt<- t(Tmp) + } + Xm<- min(Dt[,1]) + XM<- max(Dt[,1]) + Ym<- min(Dt[,2]) + YM<- max(Dt[,2]) + Str<- "Setwindow(" + Str<- paste(Str,"c(",as.character(Xm),",",as.character(XM),"),c(",sep="") + Str<- paste(Str,as.character(Ym),",",as.character(YM),")",sep="") + Str<- paste(Str,")",sep="") + print(Str) + } + if(Nargs==2){ + RgX<-varargin[[1]] + RgY<-varargin[[2]] + XMIN<<-RgX[1]; XMAX<<-RgX[2] + YMIN<<-RgY[1]; YMAX<<-RgY[2] + } + if(Nargs==4){ + XMIN<<-varargin[[1]]; XMAX<<-varargin[[2]] + YMIN<<-varargin[[3]]; YMAX<<-varargin[[4]] + } + Out<- c(XMIN,XMAX,YMIN,YMAX); +} + +######################################### + +Shadeold<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + Iroflg=0 + Kosa=1 + if(Nargs>1){ + Iro=varargin[[Nargs]] + if(is.character(Iro)){ + Iroflg=1 + if(length(grep("{",Iro))>0){ + Str=paste("{\\color",Iro,sep="") + } + else{ + Str=paste("{\\color{",Iro,"}",sep="") + } + } + else{ + if(length(Iro)==1){ + Kosa=Iro + } + else{ + Iroflg=1 + if(length(Iro)==4){ + Str="{\\color[cmyk]{" + } + else{ + if(length(Iro)==3){ + Str="{\\color[rgb]{" + } + } + for(J in 1:length(Iro)){ + Str=paste(Str,as.character(Iro[J]),sep="") + if(J80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<- 0 + } + } + Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") + Str2<- paste("\\special{ip}%\n",sep="") + cat(Str1,file=Wfile,append=TRUE) + cat(Str2,file=Wfile,append=TRUE) + } + if(Iroflg==1){ + cat("}%\n",file=Wfile,append=TRUE) + } +} + +####### Shade new 17.09.24############ + +Shade<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + Iroflg<- 0 + Kosa<- 1 + if(Nargs>1){ + Iro<- varargin[[Nargs]] + if(mode(Iro)=="character"){ + Iroflg<- 1 + if(length(grep(Iro,"{"))>0) + Str<- paste("{\\color",Iro,sep="") + else + Str<- paste("{\\color{",Iro,"}",sep="") + } + else{ + if(length(Iro)==1) + Kosa<- Iro + else{ + Iroflg<- 1 + if(length(Iro)==4) + Str<- paste("{\\color[cmyk]{",sep="") + else + if(length(Iro)==3) + Str<- paste("{\\color[rgb]{",sep="") + for (J in Looprange(1,length(Iro))){ + Str<- paste(Str,as.character(Iro[J]),sep="") + if(J80){ + if(Wfile=="default") + cat("%\n",file="",append=TRUE,sep="") + else + cat("%\n",file=Wfile,append=TRUE,sep="") + Mojisu<- 0 + } + } + Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") + Str2<- paste("\\special{ip}%\n",sep="") + if(Wfile=="default"){ + cat(Str1,file="",append=TRUE,sep="") + cat(Str2,file="",append=TRUE,sep="") + } + else{ + cat(Str1,file=Wfile,append=TRUE,sep="") + cat(Str2,file=Wfile,append=TRUE,sep="") + } + } + if(Iroflg==1){ + if(Wfile=="default") + cat("}%\n",file="",append=TRUE,sep="") + else + cat("}%\n",file=Wfile,append=TRUE,sep="") + } +} + +############################################## +# 11.01.07 + +Splinedata<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-3) + PL<- varargin[[1]] + if(mode(PL)=="character"){ + Fname<- PL + PL<- Readtextdata(Fname) + } + else{ + PL<- as.matrix(PL) + if(Nrow(PL)==1){ + PL<- matrix(PL, nrow=length(PL)/2) + PL<- t(PL) + } + } + if(ncol(PL)==3){ + Flg3<- 1 + } + else{ + Flg3<- 0 + } + PLL<- Dividegraphics(PL) + N<- 50 + C<- c() + for (I in Looprange(2,Nargs)){ + Tmp<- varargin[[I]] + if(mode(Tmp)!="character") next + if(length(grep("=",Tmp,fixed=TRUE))>0){ + eval(parse(text=Tmp)) + } + else{ + Tmp1<- substr(Tmp,1,1) + if(toupper(Tmp1)=="C"){ + C<- 1:length(PLL) + } + } + } + Cflg<- rep(0,length(PLL)) + for(J in Looprange(1,length(C))){ + K<- C[J] + Cflg[K]<- 1 + } + if(length(N)>1){ + Nj<- as.numeric(N) + } + else{ + Tmp<- lapply(PLL,nrow) + Tmp1<- as.numeric(Tmp) + MxP<- max(Tmp1) + Nj<- c() + for (J in 1:length(PLL)){ + Tmp<- nrow(PLL[[J]]) + Tmp1<- round(N/MxP*(Tmp-1)) + Nj<- c(Nj,Tmp1) + } + } + OutL<- list() + for(J in 1:length(PLL)){ + PL<- PLL[[J]] + if(Cflg[J]==1){ + if(Norm(PL[1,]-PL[Nrow(PL),])>Eps){ + PL<-Appendrow(PL,PL[1,]) + Nj[J]=round(N/MxP*nrow(PL)) + } + else{ + PL[Nrow(PL),]<- PL[1,] + } + } + Tn<- 1:Nrow(PL) + Xn<- PL[,1] + Yn<- PL[,2] + if(Flg3==1) Zn<- PL[,3] + if(Cflg[J]==0){ + Dxn<- spline(Tn,Xn,n=Nj[J]) + Dyn<- spline(Tn,Yn,n=Nj[J]) + if(Flg3==1) Dzn<- spline(Tn,Zn,n=Nj[J]) + } + else{ + Dxn<- spline(Tn,Xn,method="periodic") + Dyn<- spline(Tn,Yn,method="periodic") + if(Flg3==1) Dzn<- spline(Tn,Zn,method="periodic") + } + Tmp1<- Dxn$y + Tmp2<- Dyn$y + Tmp3<-c() + if(Flg3==1) Tmp3<- Dzn$y + Out<- matrix(c(Tmp1,Tmp2,Tmp3),nrow=length(Tmp1)) + OutL<- c(OutL,list(Out)) + } + return(OutL) +} + +############################################ +# 2013.05.03 Domain is optional + +Tabledata<- function(...){ + varargin<- list(...) + Eps<- 0.001 + Tmp<- varargin[[1]] # 130503 from + if(is.numeric(Tmp)){ + Domain<- varargin[[1]] + VL<- varargin[[2]] + HL<- varargin[[3]] + } + else{ + Domain<- c(-1,-1) + VL<- varargin[[1]] + HL<- varargin[[2]] + } # 130503 until + Hsize<- Domain[1] + SvL<- list(0) + S<- 0 + for (I in Looprange(1,length(VL))){ + Tmp<- VL[[I]] + S<- S+Tmp[1] + Tmp[1]<- S + SvL<- c(SvL,list(Tmp)) + } + if(Hsize>S){ + SvL<- c(SvL,list(Hsize)) + } + Hsize<- Op(1,SvL[[length(SvL)]]) + Vsize<- Domain[2] + ShL<- list(0) + S<- 0 + for (I in Looprange(1,length(HL))){ + Tmp<- HL[[I]] + S<- S+Tmp[1] + Tmp[1]<- S + ShL<- c(ShL,list(Tmp)) + } + if(Vsize>S){ + ShL<- c(ShL,list(Vsize)) + } + Vsize<- Op(1,ShL[[length(ShL)]]) + Marw<- 0; Mare<- 0; Mars<- 0; Marn<- 0 + if(length(Domain)>2){ + Marw<- Domain[3] + Mare<- Domain[4] + } + if(length(Domain)>4){ + Marn<- Domain[5] + Mars<- Domain[6] + } + Setwindow(c(-Marw,Hsize+Mare),c(-Mars,Vsize+Marn)) + Tmp<- Framedata(c(Eps,Hsize-Eps),c(Eps,Vsize-Eps)) + Gdata<- list(Tmp) + Tmp<- -Marw + Hdata<- list(Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn)))) + for (I in Looprange(1,length(SvL))){ + Data<- SvL[[I]] + X<- Data[1] + if(length(Data)==1){ + Y1<- 0 + Y2<- Vsize + G<- Listplot(c(X,Y1),c(X,Y2)) + } + else{ + G<- c() + for (J in seq(2,length(Data),by=2)){ + Y1<- Vsize-Op(1,ShL[[Data[J]]]) + Y2<- Vsize-Op(1,ShL[[Data[J+1]]]) + Tmp<- Listplot(c(c(X,Y1),c(X,Y2))) + Tmp1<- Appendrow(G,c(Inf,Inf)) + G<- Appendrow(Tmp1,Tmp) + } + G<- G[2:nrow(G),] + } + Hdata<- c(Hdata,list(G)) + } + Tmp<- Hsize+Mare + Tmp1<- Listplot(c(c(Tmp,-Mars),c(Tmp,Vsize+Marn))) + Hdata<- c(Hdata,list(Tmp1)) + Tmp<- Vsize+Marn + Vdata<- list(Listplot(c(c(-Marw,Tmp),c(Hsize+Mare,Tmp)))) + for (I in Looprange(1,length(ShL))){ + Data<- ShL[[I]] + Y<- Vsize-Data[1] + if(length(Data)==1){ + X1<- 0 + X2<- Hsize + G<- Listplot(c(X1,Y),c(X2,Y)) + } + else{ + G<- c() + for (J in seq(2,length(Data),by=2)){ + X1<- Op(1,SvL[[Data[J]]]) + X2<- Op(1,SvL[[Data[J+1]]]) + Tmp<- Listplot(c(X1,Y),c(X2,Y)) + G<- Appendrow(G,c(Inf,Inf)) + G<- Appendrow(G,Tmp) + } + G<-G[2:nrow(G),] + } + Vdata<- c(Vdata,list(G)) + } +# Tmp<- Listplot(c(c(0,0),c(Hsize,0))) # 2011.03.02 +# Vdata<- Mixjoin(Vdata,list(Tmp)) + Tmp<- Listplot(c(c(-Marw,-Mars),c(Hsize+Mare,-Mars))) + Vdata<- Mixjoin(Vdata,list(Tmp)) + Tmp1<- Hdata[Looprange(3,length(Hdata)-2)] + Tmp2<- Vdata[Looprange(3,length(Vdata)-2)] + Gdata<- Mixjoin(Gdata,Tmp1,Tmp2) + Hind<- Looprange(2,1+length(Tmp1)) + Vind<- Looprange(2+length(Tmp1),1+length(Tmp1)+length(Tmp2)) + G=Gdata[[1]] + P1<- Ptsw(G); P2<- Ptnw(G) + Q1<- Ptse(G); Q2<- Ptne(G) + Tmp1<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) + P1<- Ptnw(G); P2<- Ptne(G) + Q1<- Ptsw(G); Q2<- Ptse(G) + Tmp2<- list(Listplot(c(P1,P2)),Listplot(c(Q1,Q2))) + Tmp3<- Framedata() + Out<- list(Gdata,Hind,Vind,Tmp1,Tmp2,Tmp3) + return(Out) +} + +################################ + +Texcom<- function(Meirei) +{ + if(Meirei=="\\thinlines"){ + Setpen(1); + return(); + } + if(Meirei=="\\thicklines"){ + Setpen(2); + return() + } + if(Meirei=="\\Thicklines"){ + Setpen(3); + return() + } + if(length(Meirei)==0){ # 09.12.07 + Tmp<- c() + } + else{ + Tmp<- grep("newline",Meirei) + } + if(length(Tmp)>0){ + cat("\n",file=Wfile,append=TRUE); + } + else{ + Tmp<- paste(Meirei,"%\n",sep="") + Tmp<- gsub("//","\\",Tmp,fixed=TRUE) # 11.03.02 + cat(Tmp,file=Wfile,append=TRUE); + } +} + +############################################### + +Texctr<- function(N){ + if(is.numeric(N)){ + Alpha<- "abcdefghijklmnopqrstuvwxyz" + Out<- paste("ketpicctr",substr(Alpha,N,N),sep="") + } + else{ + if(grep("\\",N,fixed=TRUE)>0){ + Out<- substr(N,2,nchar(N)) + } + else{ + Out<- N + } + } + return(Out) +} + +############################################### + +Texelse<- function (){ + Texcom(""); + Texcom("\\else") +} + +############################################### + +Texend<- function() +{ + Texcom("%\n}") +} + +############################################### + +Texendfor<- function(I){ + Last<- TEXFORLAST[[TEXFORLEVEL]] + Texcom("") + Tmp<- paste("\\ifnum",Texthectr(I),"<",Last,sep="") + Texcom(Tmp) + Texcom("\\repeat") + Texcom("}") + TEXFORLEVEL<<- TEXFORLEVEL-1 + TEXFORLAST<<- TEXFORLAST[1:(length(TEXFORLAST)-1)] +} + +############################################### + +Texendif<- function(){ + Texcom("") + Texcom("\\fi") + Texcom("}") +} + +############################################### + +Texfor<- function(I,First,Last){ + TEXFORLEVEL<<- TEXFORLEVEL+1; + Texsetctr(I,"0") + Texsetctr(I,paste(as.character(First),"-1",sep="")) + Texcom("") + Texcom("{") + Texcom("\\loop") + Texsetctr(I,"+1") + TEXFORLAST<<- c(TEXFORLAST,as.character(Last)) +} + +############################################### + +Texforinit<- function(){ + TEXFORLEVEL<<- 0 + TEXFORLAST<<- list() +} + +############################################### + +Texif<- function(...){ + varargin<- list(...) + Condstr<- varargin[[1]] + Tp<- 0 + if(length(varargin)>1){ + Tp<- varargin[[2]] + } + Texcom("") + Texcom("{") + if(Tp==0){ + Texcom("\\ifnum") + } + else{ + Texcom("\\ifdim ") + } + Texcom(paste(Condstr," ",sep="")) +} + +###################################### + +Texletter<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + for (I in seq(1,Nargs,by=3)){ + P<- varargin[[I]] + X<- P[1] + if(mode(X)=="numeric"){ + X<- as.character(X) + } + Y<- P[2] + if(mode(Y)=="numeric"){ + Y<- as.character(Y) + } + Houkou<- varargin[[I+1]] + Mojiretu<- varargin[[I+2]] + Hset<- Houkou + Vhoko<- "c" + if(length(grep("n",Hset))>0){ + Vhoko<- "n" + } + if(length(grep("s",Hset))>0){ + Vhoko<- "s" + } + Hhoko<- "c"; + if(length(grep("e",Hset))>0){ + Hhoko<- "e" + } + if(length(grep("w",Hset))>0){ + Hhoko<- "w" + } + Hoko<- paste(Vhoko,Hhoko,sep="") + CalcWidth(Hoko,Mojiretu) + CalcHeight(Hoko,Mojiretu) + Tmp<- paste("\\put(",X,",",Y,"){\\hspace*{\\Width}",sep="") + Str<- paste(Tmp,"\\raisebox{\\Height}{",Mojiretu,"}}%\n",sep="") + cat(Str,file=Wfile,append=TRUE) + } +} + +################################################## + +Texnewcmd<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Str<- varargin[[1]] + S<- paste("\\newcommand{",Str,"}",sep="") + if(Nargs>1){ + Tmp<- as.character(varargin[[2]]) + S<- paste(S,"[",Tmp,"]",sep="") + } + if(Nargs>2){ + Tmp<- varargin[[3]] + if(mode(Tmp)=="numeric"){ + Tmp<- as.character(Tmp) + } + S<- paste(S,"[",Tmp,"]",sep="") + } + S<- paste(S,"{",sep="") + Texcom(S) +} + +############################################### + +Texnewctr<- function(N) +{ + if(mode(N)=="character"){ + Str<- paste("\\newcounter{",N,"}",sep="") + Texcom(Str) + } + else{ + for (I in N){ + Str<- paste("\\newcounter{",Texctr(I),"}",sep="") + Texcom(Str) + } + } +} +############################################### + +Texrenewcmd<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Str<- varargin[[1]] + S<- paste("\\renewcommand{",Str,"}",sep="") + if(Nargs>1){ + Tmp<- as.character(varargin[[2]]) + S<- paste(S,"[",Tmp,"]",sep="") + } + if(Nargs>2){ + Tmp<- varargin[[3]] + if(mode(Tmp)=="numeric"){ + Tmp<- as.character(Tmp) + } + S<- paste(S,"[",Tmp,"]",sep="") + } + S<- paste(S,"{",sep="") + Texcom(S) +} + +############################################### + +Texsetctr<- function(Nctr,Opstr) +{ + Ctr<- Texctr(Nctr) + Opstr<- paste(Opstr,"%",sep="") + OperL<- "+-*/%" + Oper<- "" + Va<- "" + Evflg<- 0 + Paflg<- 0 + for (I in Looprange(1,nchar(Opstr))){ + Tmp<- substring(Opstr,I,I) + if(Tmp=="("){ + Paflg<- 1 + if(nchar(Va)>0){ + Evflg<- 1 + Va<- paste(Va,Tmp,sep="") + } + next + } + if(Tmp==")"){ + Paflg<- 0 + if(Evflg>0){ + Va<- paste(Va,Tmp,sep="") + } + next + } + if(Paflg>0){ + Va<- paste(Va,Tmp,sep="") + next + } + if(length(grep(Tmp,OperL))==0){ + Va<- paste(Va,Tmp,sep="") + } + else{ + if(Evflg>0){ + Tmp1<- eval(parse(text=Va)) + Va<- paste("\\value{",Tmp1,"}",sep="") + Evflg<- 0 + } + if(Oper==""){ + if(nchar(Va)>0){ + Str<- paste("\\setcounter{",Ctr,"}{",Va,"}",sep="") + Texcom(Str) + } + Oper<- Tmp + Va<-"" + } + else if(Oper=="+"){ + Str<- paste("\\addtocounter{",Ctr,"}{",Va,"}",sep="") + Texcom(Str) + Oper<- Tmp + Va<-"" + } + else if(Oper=="-"){ + Str<- paste("\\addtocounter{",Ctr,"}{-",Va,"}",sep="") + Texcom(Str) + Oper<- Tmp + Va<-"" + } + else if(Oper=="*"){ + Str<- paste("\\multiply\\value{",Ctr,"} by ",Va,sep="") + Texcom(Str) + Oper<- Tmp + Va<-"" + } + else if(Oper=="/"){ + Str<- paste("\\divide\\value{",Ctr,"} by ",Va,sep="") + Texcom(Str) + Oper<- Tmp + Va<-"" + } + } + } +} + +############################################### + +Texthectr<- function(N) +{ + Out<- paste("\\the",Texctr(N),sep="") + return(Out) +} + +############################################### + +Texvalctr<- function(N){ + Out<- paste("\\value{",Texctr(N),"}",sep="") + return(Out) +} + +############################################### + +Texvctr<- function(N) +{ + Out<- paste("\\value{",Texctr(N),"}",sep="") + return(Out) +} + +############################################### + +Tonumeric <- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Data<- varargin[[1]] + Sp<- c(1,1) + Ep<- c(Inf,Inf) + if(Nargs>1){ + Sp<- varargin[[2]] + } + if(Nargs>2){ + Ep<- varargin[[3]] + } + Nrs<- Sp[1] + Nre<- min(nrow(Data),Ep[1]) + Ncs<- Sp[2] + Nce<- min(ncol(Data),Ep[2]) + Tmp1<- Data[Nrs:Nre, Ncs:Nce] + Tmp2 <- as.numeric(Tmp1) + Out <- matrix(Tmp2,nrow=nrow(Tmp1)) + Sp<- c() + for (I in 1:nrow(Out)){ + for (J in 1:ncol(Out)){ + Tmp<- Out[I,J] + if(!is.na(Tmp)){ + Sp<- c(I,J) + break; + } + } + if(length(Sp)>0) break + } + if(length(Sp)==0){ + return("Numeric data not found") + } + Ep<- c(nrow(Out),ncol(Out)) + for (I in Sp[1]:nrow(Out)){ + Tmp<- Out[I,Sp[2]] + if(is.na(Tmp)){ + Ep[1]<- I-1 + break + } + } + for (J in Sp[2]:ncol(Out)){ + Tmp<- Out[Sp[1],J] + if(is.na(Tmp)){ + Ep[2]<- J-1 + break + } + } + Out<- Out[Sp[1]:Ep[1], Sp[2]:Ep[2]] + return(Out) +} + +################################################## + +Translatedata<- function(...) +{ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10^(-8) + ML<- varargin[[1]] + if(Mixtype(ML)==1){ + ML<- list(ML) + } + Tmp=varargin[[2]] + if(mode(Tmp)=="numeric" && length(Tmp)>1){ + A<- Tmp[1]; B<- Tmp[2] + } + else{ + A<- Tmp + if(Nargs>=3){ + B<- varargin[[3]] + } + else{ + B<- 0 + } + } + OutL<- list() + for (N in Looprange(1,length(ML))){ + GL<- Op(N,ML) + Out<- c() + for (I in Looprange(1,Nrow(GL))){ + if(is.matrix(GL)){ # 10.12.07 + Tmp<- GL[I,] + } + else{ + Tmp<- GL + } + X1<- Tmp[1] + Y1<- Tmp[2] + if(X1==Inf){ + X2<- X1 + Y2<-Y1 + } + else{ + X2<- X1+A + Y2<- Y1+B + } + Out<- Appendrow(Out,c(X2,Y2)) + } + OutL<- Mixjoin(OutL,list(Out)) + } + if(length(OutL)==1){ + OutL<- Op(1,OutL) + } + return(OutL) +} + +####################################### + +Unscaling<- function(G) +{ + GLg<- G + if(class(GLg)=="numeric"){ + GLg<-c(G[1]/SCALEX, G[2]/SCALEY) + Tmp<-GLg + if(LOGX==1) Tmp[1]<- 10^(GLg[1]) + if(LOGY==1) Tmp[2]<- 10^(GLg[2]) + return(Tmp) + } + else{ + Tmp1<-matrix(c(1/SCALEX,0,0,1/SCALEY),nrow=2) + GLg<-G %*% Tmp1 + Tmp<-GLg + if(LOGX==1) Tmp[,1]<- 10^(G[,1]) + if(LOGY==1) Tmp[,2]<- 10^(G[,2]) + return(Tmp) + } +} + +############################################# + +Vtickmark<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + ArgsL<- varargin + if(mode(ArgsL[[1]])=="character"){ + Str<- ArgsL[[1]] + Tmp<- strsplit(Str,"m") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + I<- nchar(Tmp[1])+1 + } + else{ + I<- 0 + } + Tmp<- strsplit(Str,"n") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + J<- nchar(Tmp[1])+1 + } + else{ + J<- 0 + } + Tmp<- strsplit(Str,"r") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + K=nchar(Tmp[1])+1 + } + else{ + K<- 0 + } + if(K>0){ + S<- substr(Str,K+1,nchar(Str)) + R<- as.numeric(S) + if(is.na(R)){ + R<- 1 + } + } + else{ + R<- 1 + K<- nchar(Str)+1 + } + if(J>0){ + S<- substr(Str,J+1,K-1) + Dn<- as.numeric(S) + if(is.na(Dn)){ + Dn<- 1 + } + } + else{ + Dn<- 1000 + J<- nchar(Str)+1 + } + S<- substr(Str,I+1,J-1) + Dm<- as.numeric(S) + if(is.na(Dm)){ + Dm<- 1 + } + ArgsL<- list() + for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + } + MemoriList<- list() + Memori<- list() + for (N in 1:length(ArgsL)){ + Dt<- ArgsL[[N]] + if(mode(Dt)=="numeric" && length(Dt)>1){ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt[1],Dt[2]) + next + } + if(mode(Dt)=="character"){ + Memori<- Mixjoin(Memori,Dt) + } + else{ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(GENTEN[1],Dt) + } + } + MemoriList<- Mixjoin(MemoriList,list(Memori)) + for (N in 1:length(MemoriList)){ + Dt<- MemoriList[[N]] + Ndt<- length(Dt) + X=Op(1,Dt) + Y=Op(2,Dt) + Tmp<-Doscaling(c(X,Y)) + X<- Tmp[1] + Y<- Tmp[2] + Moji<- Op(Ndt,Dt) + Tmp1<- Unscaling(c(X+MARKLEN,Y)) + Tmp2<- Unscaling(c(X-MARKLEN,Y)) + Fd<- Listplot(c(Tmp1,Tmp2)) + Drwline(Fd) + if(Ndt==3){ + Tmp<-Unscaling(c(X-MARKLEN,Y)) + Expr(Tmp,"w",Moji) + } + if(Ndt==4){ + Houkou<- Op(3,Dt) + Tmp<-grep("w",Houkou) + if(length(Tmp)>0){ + Tmp<-Unscaling(c(X-MARKLEN,Y)) + Expr(Tmp,Houkou,Moji) + } + else{ + Tmp<- Unscaling(c(X+MARKLEN,Y)) + Expr(Tmp,Houkou,Moji) + } + } + cat("%\n",file=Wfile,append=TRUE) + } +} + +############################################ + +Windisp<-function(...){ + varargin<-list(...) + Nargs<-length(varargin) + Tmp<- Doscaling(c(XMIN,YMIN)) + Xmn<- Tmp[1]; Ymn<- Tmp[2] + Tmp<- Doscaling(c(XMAX,YMAX)) + Xmx<- Tmp[1]; Ymx<- Tmp[2] + plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") + Tmp<- Doscaling(Listplot(c(0,YMIN),c(0,YMAX))) + axis(2,at=as.numeric(Tmp[,2]), labels=round(c(YMIN,YMAX),2)) + Tmp<- Doscaling(Listplot(c(XMIN,0),c(XMAX,0))) + axis(1,at=as.numeric(Tmp[,1]), labels=round(c(XMIN,XMAX),2)) + Tmp1<- c(XMIN,GENTEN[2]) + Tmp2<- c(XMAX,GENTEN[2]) + Tmp3<- Listplot(Tmp1,Tmp2) + Tmp<- MakeCurves(Tmp3,0) + if(Datalength(Tmp)>0){ + lines(Tmp[,1],Tmp[,2],col="green") + } + Tmp1<- c(GENTEN[1],YMAX) + Tmp2<- c(GENTEN[1],YMIN) + Tmp3<- Listplot(Tmp1,Tmp2) + Tmp<- MakeCurves(Tmp3,0) + if(Datalength(Tmp)>0){ + lines(Tmp[,1],Tmp[,2],col="green") + } + Tmp<-Doscaling(Framedata()) + lines(Tmp[,1],Tmp[,2]) + for (I in Looprange(1,Nargs)){ + Pdata<-varargin[[I]] + if(mode(Pdata)=="numeric"){ + Pdata<-list(Pdata) + } + while(Mixtype(Pdata)==3){ # 10.02.23 + Tmp1<- list() + for(II in Looprange(1,length(Pdata))){ + Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) + } + Pdata<- Tmp1 + } # 10.02.23 + for (II in Looprange(1,length(Pdata))){ + Tmp<-Pdata[[II]] + P<-MakeCurves(Tmp,0) + Ndm<-Dataindex(P) + for (J in Looprange(1,Nrow(Ndm))){ + Q<-P[Ndm[J,1]:Ndm[J,2],] + if(Nrow(Q)==1){ + Tmp<-seq(1,Ncol(Q),by=2) + for (K in Tmp){ + Pt<-Q[K:(K+1)] + points(Pt[1],Pt[2]) + } + } + else{ + lines(Q[,1],Q[,2]) + } + } + } + } +} + +############################################ + +WindispT<-function(..., color="black",width=1,new=FALSE,htick=c(),vtick=c()){ # 10.12.04 + par(new=new) + varargin<-list(...) + Nargs<-length(varargin) + if(!new) # 10.12.04 + { + Tmp<- Doscaling(c(XMIN,YMIN)) + Xmn<- Tmp[1]; Ymn<- Tmp[2] + Tmp<- Doscaling(c(XMAX,YMAX)) + Xmx<- Tmp[1]; Ymx<- Tmp[2] + plot(c(Xmn,Xmx),c(Ymn,Ymx),type="n",asp=1,axes=FALSE,xlab="",ylab="") + Tick<- sort(c(YMIN,YMAX,vtick)) #### 10.12.04 from here + Tmp1<- matrix(c(rep(0,length(Tick)),Tick),ncol=2) + Tmp<- Doscaling(Tmp1) + axis(2,at=as.numeric(Tmp[,2]), labels=round(Tick,2)) + Tick<- sort(c(XMIN,XMAX,htick)) + Tmp1<- matrix(c(Tick,rep(0,length(Tick))),ncol=2) + Tmp<- Doscaling(Tmp1) + axis(1,at=as.numeric(Tmp[,1]), labels=round(Tick,2)) #### 10.12.04 to here + Tmp1<- c(XMIN,GENTEN[2]) + Tmp2<- c(XMAX,GENTEN[2]) + Tmp3<- Listplot(Tmp1,Tmp2) + Tmp<- MakeCurves(Tmp3,0) + if(Datalength(Tmp)>0){ + lines(Tmp[,1],Tmp[,2],col="green") + } + Tmp1<- c(GENTEN[1],YMAX) + Tmp2<- c(GENTEN[1],YMIN) + Tmp3<- Listplot(Tmp1,Tmp2) + Tmp<- MakeCurves(Tmp3,0) + if(Datalength(Tmp)>0){ + lines(Tmp[,1],Tmp[,2],col="green") + } + Tmp<-Doscaling(Framedata()) + lines(Tmp[,1],Tmp[,2]) + } + for (I in Looprange(1,Nargs)){ + Pdata<-Flattenlist(varargin[[I]]) # 101129 from here + Cmd<- list() + for (II in Looprange(1,length(Pdata))){ + Tmp<-Pdata[[II]] + if(length(Tmp)==1){ + Cmd<- c(Cmd,list(Tmp)) + next + } + + P<-MakeCurves(Tmp,0) + + if(length(Cmd)>0){ + if(length(Cmd)>=3){ + polygon(P,col=Cmd[[1]],border=Cmd[[2]],density=Cmd[[3]]) + } + else{ + polygon(P,col=Cmd[[1]],border=Cmd[[2]]) + } + next + } # 101129 to here + Ndm<-Dataindex(P) + for (J in Looprange(1,Nrow(Ndm))){ + Q<-P[Ndm[J,1]:Ndm[J,2],] + if(Nrow(Q)==1){ + Tmp<-seq(1,Ncol(Q),by=2) + for (K in Tmp){ + Pt<-Q[K:(K+1)] + points(Pt[1],Pt[2],col=color)#taka101111 + } + } + else{ + lines(Q[,1],Q[,2],col=color,lwd=width)#taka101111 + } + } + } + } + par(new=FALSE) +} + +###################################### + +# 3D + +################################# + +# 10.08.16 +CameracoordCurve<- function(Curve){ + Out<- c() + for(J in Looprange(1,Nrow(Curve))){ + P<- Ptcrv(J,Curve) #P=Curve(J,:); + Tmp<- P-FocusPoint + X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] + Tmp<- EyePoint-FocusPoint + E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] + Ca<- E1/sqrt(E1^2+F1^2) + Sa<- F1/sqrt(E1^2+F1^2) + X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 + E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 + Cb<- E2/sqrt(E2^2+G2^2) + Sb<- G2/sqrt(E2^2+G2^2) + X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb + E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb + Xz<- X3 + Yz<- E3/(E3-X3)*Y3 + Zz<- E3/(E3-X3)*Z3 + Out<- rbind(Out,c(Yz,Zz,Xz)) + } + rownames(Out)<- 1:Nrow(Out) + return(Out) +} + +######################################### + +#100815 +CameraCurve<- function(Curve){ + Eps<- 10^(-6) + for (I in Looprange(1,Nrow(Curve))){ + P<- Curve[I,] + x<- P[1]; y<- P[2]; z<- P[3] + if(x!=Inf){ + Tmp<- Perspt(P) + if(I==1){ + AnsL<- rbind(c(),Tmp) + }else{ + Tmp1<- AnsL[Nrow(AnsL),] + if(Tmp1[1]==Inf || Norm(Tmp-Tmp1)>Eps){ + AnsL<- rbind(AnsL,Tmp) + } + } + }else{ + AnsL<- rbind(AnsL,c(Inf,Inf)) + } + } + rownames(AnsL)<- 1:Nrow(AnsL) + return(AnsL) +} + +###################################### + +Cancoordpara<- function(P){ # 18.02.15 + Xz<- P[1] + Yz<- P[2] + Zz<- P[3] + X<- -Xz*sin(PHI)-Yz*cos(PHI)*cos(THETA)+Zz*cos(PHI)*sin(THETA) + Y<- Xz*cos(PHI)-Yz*sin(PHI)*cos(THETA)+Zz*sin(PHI)*sin(THETA) + Z<- Yz*sin(THETA)+Zz*cos(THETA) + Out<- c(X,Y,Z) + return(Out) +} + +###################################### + +Cancoordpers<- function(P){ + Tmp<- EyePoint-FocusPoint + E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] + Ca<- E1/sqrt(E1^2+F1^2) + Sa<- F1/sqrt(E1^2+F1^2) + E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 + Cb<- E2/sqrt(E2^2+G2^2) + Sb<- G2/sqrt(E2^2+G2^2) + E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb + Xz<- P[3]; Yz<- P[1]; Zz<- P[2] + X3<- Xz; Y3<- Yz*(E3-Xz)/E3; Z3<- Zz*(E3-Xz)/E3 + X2<- X3*Cb-Sb*Z3; Y2<- Y3; Z2<- Cb*Z3+Sb*X3 + X1<- X2*Ca-Sa*Y2; Y1<- Ca*Y2+Sa*X2; Z1<- Z2 + X<- X1+FocusPoint[1] + Y<- Y1+FocusPoint[2] + Z<- Z1+FocusPoint[3] + Out<- c(X,Y,Z) + return(Out) +} + +####################################### + +Embed<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Pd3<- varargin[[1]] + if(Mixtype(Pd3)==1){ + Pd3<- list(Pd3) + } + else if(Mixtype(Pd3)==3){ + Tmp<- list(); + for(I in Looprange(1,length(Pd3))){ + Tmp<- c(Tmp,Pd3[[I]]) + } + Pd3<- Tmp + } + Tmpf=varargin[[2]] + if(mode(Tmpf)=="character"){ + Tmp<- varargin[[3]] + Tmp1<- gsub("c(","(",Tmp,fixed=TRUE) + Vstr<- gsub(")",")",Tmp1,fixed=TRUE) + Str<- paste("Tmpfn<- function",Vstr,"{",Tmpf,"}",sep="") + eval(parse(text=Str)) + } + else{ + Tmpfn<- Tmpf + } + Out<- list() + for(I in Looprange(1,length(Pd3))){ + PD<- Pd3[[I]] + Ans<- c() + for(J in Looprange(1,Nrow(PD))){ + P<- PD[J,] + Tmp<- Tmpfn(P[1],P[2]) + Ans<- rbind(Ans,Tmp) + } + Out<- c(Out, list(Ans)) + } + if(length(Out)==1){ + Out<- Out[[1]] + } + return(Out) +} + +####################### +# 10.08.17 +# 14.03.30 +Facesdata<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + FL<- varargin[[1]] + PT<- varargin[[length(varargin)]] + Tmp<-grep("para",PT,fixed=TRUE) + if(length(Tmp)>0){ + Ptype<- 1 + }else{ + Ptype<- -1 + } + if(Nargs==2){ + CLadd<- list() + }else{ + CLadd<- varargin[[2]] + } + NohiddenL<- list() + HiddenL<- list() + Eps<- 10^(-4) + if(length(CLadd)>0){ + if(mode(CLadd)=="numeric"){ + C<- list() + if(Nrow(CLadd)>1){ + for (I in Looprange(1,Nrow(CLadd))){ + C<- c(C,list(CLadd[I,])) + } + }else{ + I<- 1 + while (I<=Ncol(CLadd)){ + C<- c(C,list(CLadd[1,I:(I+2)])) + I<- I+3 + } + } + CrvL<- list(C) + }else if(mode(CLadd[[1]])=="numeric"){ + CrvL<- list() + for (J in Looprange(1,length(CL))){ + Ctmp<- CLadd[[J]] + C<- list() + if(Nrow(Ctmp)>1){ + for (I in Looprange(1,Nrow(Ctmp))){ + C<- c(C,list(Ctmp[I,])) + } + }else{ + I<- 1 + while(I<=Ncol(Ctmp)){ + C<- c(C,list(Ctmp[1,I:(I+2)])) + I<- I+3 + } + } + CrvL<- c(CrvL,list(C)) + } + }else{ + CrvL<- CLadd + } + }else{ + CrvL<- list() + } + Out<- MakeveLfaceL(FL) + VELNO<<- Out[[1]] + VELHI<<- list() + for (I in Looprange(1,length(CrvL))){ + Tmp<- CrvL[[I]] + for (J in Looprange(1,length(Tmp)-1)){ + Edge<- list(Tmp[J],Tmp[J+1]) + Ntmp<- length(VELNO) + VELNO(Ntmp+1)<<- list(Edge,0,Ntmp+1) + } + } + FaceL<- Out[[2]] + Tmp<- grep("raw",PT,fixed=TRUE) + if(length(Tmp)==0){ + for (Nf in Looprange(1,length(FaceL))){ + Face<- FaceL[[Nf]] + Menkakusi2(Face,Nf,Ptype) + } + } + for (I in Looprange(1,length(VELNO))){ + Edge<- Op(1,VELNO[[I]]) + if(Norm(Edge[[1]]-Edge[[2]])>Eps){ + NohiddenL<- c(NohiddenL,list(Spaceline(Edge))) + } + } + EdgeL<- list() # from 13.03.30 + for(K in Looprange(1,length(VELHI))){ + Edge<- Op(1,VELHI[[K]]) + P<- Edge[[1]]; Q<- Edge[[2]] + if(Norm(P-Q)>Eps){ + EdgeL<- c(EdgeL,list(Edge)) + } + } + for(K in Looprange(1,length(EdgeL))){ + Edge<- EdgeL[[K]] + P<- Edge[[1]]; Q<- Edge[[2]] + Cflg<- 0 + for(J in Looprange(K+1,length(EdgeL))){ + Ej<- EdgeL[[J]] + Pj<- Ej[[1]]; Qj<- Ej[[2]] + if(Norm(Crossprod(Q-P,Qj-Pj))>Eps){ + next + } + if(Norm(Q-Pj)0){ + break + } + } + Urg<- Stripblanks(Op(Jrg,FdL)) + StrV<- strsplit(Urg,"=",fixed=TRUE)[[1]] + Uname<- StrV[1] + Vrg<- Stripblanks(Op(Jrg+1,FdL)) + StrV<- strsplit(Vrg,"=",fixed=TRUE)[[1]] + Vname<- StrV[1] + if(Jrg==2){ + Tmp<- Stripblanks(Op(1,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Zf<- StrV[2] + Tmp<- list(Uname,Vname,Zf,Urg,Vrg) + Out<- c(Out,Tmp) + }else if(Jrg==4){ + Tmp<- Stripblanks(Op(1,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Zf<- StrV[2] + Tmp<- Stripblanks(Op(2,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Xname<- StrV[1] + Xf<- StrV[2] + Tmp<- Stripblanks(Op(3,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Yname<- StrV[1] + Yf<- StrV[2] + Tmp<- gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE) + Zf<- gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE) + Tmp<- list(Xf,Yf,Zf,Urg,Vrg) + Out<- c(Out,Tmp) + }else{ + Tmp<- Stripblanks(Op(2,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Xf<- StrV[2] + Tmp<- Stripblanks(Op(3,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Yf<- StrV[2] + Tmp<- Stripblanks(Op(4,FdL)) + StrV<- strsplit(Tmp,"=",fixed=TRUE)[[1]] + Zf<- StrV[2] + Tmp<- list(Xf,Yf,Zf,Urg,Vrg) + Out<- c(Out,Tmp) + } + DrwS<- "enws" + BdyL<- c() + for (I in Looprange(Jrg+2,Mixlength(FdL))){ + Tmp<- Op(I,FdL) + if(mode(Tmp)=="character"){ + if(length(Tmp)==0){ + Tmp<- " " + } + DrwS<- Tmp + } + if(mode(Tmp)=="numeric" && Ncol(Tmp)>1){ + BdyL<- Tmp + } + } + Tmp<- list(DrwS,BdyL) + Out<- c(Out,Tmp) + return(Out) +} + +#################################### + +Initangle<- function (){ + PHI<<- 30*pi/180 + THETA<<- 60*pi/180 +} + +########################## + +Invparapt<- function(...){ + varargin<- list(...) + Eps<- 10^(-4) + Fk<- varargin[[length(varargin)]] + NFk<- Numptcrv(Fk) + Tmp<- varargin[[1]] + if(mode(Tmp)=="numeric" && length(Tmp)==1){ # debug + Ph<- Tmp + Fh<- varargin[[2]] + }else{ + Fh<- Projpara(Fk) + if(NFk>2){ + Tmp1<- Nearestpt(Tmp,Fh) + Ph<- Tmp1[[2]] + }else{ + Ah<- Ptcrv(1,Fh); Bh=Ptcrv(2,Fh) + V1<- Tmp-Ah; V2<- Bh-Ah + Tmp1<- Crossprod(V1,V2) + if(abs(Tmp1)>Eps){ + print("Not on the line") + return(c()) + }else{ + Ph<- Dotprod(V1,V2)/Norm(V2)^2+1 + } + } + } + if(NFk>2){ + N<- trunc(Ph) + S0<- Ph-N + if(Ph>Numptcrv(Fh)-Eps){ + Out<- list(Ptend(Fk),Numptcrv(Fh)) + return(Out) + } + }else{ + N<- 1 + S0<- Ph-1 + } + Ak<- Ptcrv(N,Fk); Bk=Ptcrv(N+1,Fk) + Ah<- Ptcrv(N,Fh); Bh=Ptcrv(N+1,Fh) + Ph<- (1-S0)*Ah+S0*Bh + T2<- S0 + Pk<- (1-T2)*Ak+T2*Bk + Out<- list(Pk,N+T2) + return(Out) +} + +################################# + +#100815 +Invperspt<- function(...){ + varargin<-list(...) + Eps<- 10^(-4) + Fk<- varargin[[length(varargin)]] + NFk<- Numptcrv(Fk) + Tmp<- varargin[[1]] + if(mode(Tmp)=="numeric" && length(Tmp)==1){ + Ph<- varargin[[1]] + Fh<- varargin[[2]] + }else{ + Fh<- Projpers(Fk) + if(NFk>2){ + Tmp1<- Nearestpt(Tmp,Fh) + Ph<- Tmp1[[2]] + }else{ + Ah<- Ptcrv(1,Fh); Bh<- Ptcrv(2,Fh) + V1<- Tmp-Ah; V2<- Bh-Ah + Tmp1<- Crossprod(V1,V2) + if(abs(Tmp1)>Eps){ + print("Not on the line") + Out<- c() + return(Out) + }else{ + Ph<- Dotprod(V1,V2)/Norm(V2)^2+1# 09.11.12 + } + } + } + if(NFk>2){ + N<- trunc(Ph) + S0<- Ph-N + if(Ph>Numptcrv(Fh)-Eps){ + Out<- list(Ptend(Fk),Numptcrv(Fh)) + return(Out) + } + }else{ + N<- 1 + S0<- Ph-1 # 09.11.12 + } + Ak<- Ptcrv(N,Fk); Bk<- Ptcrv(N+1,Fk) + Ah<- Ptcrv(N,Fh); Bh<- Ptcrv(N+1,Fh) + Ph<- (1-S0)*Ah+S0*Bh + Phc<- Cancoordpers(c(Ph,0)) + Ahc<- Cancoordpers(c(Ah,0)) + Bhc<- Cancoordpers(c(Bh,0)) + Vp<- Phc-EyePoint + Va<- Ak-EyePoint + AB<- Bk-Ak + Cp<- Crossprod(Vp,AB) + Nmr<- Crossprod(Va,Vp) + Mx<- max(abs(Cp)) + if(abs(Cp[1])==Mx){ + T2<- Nmr[1]/Cp[1] + }else if(abs(Cp[2])==Mx){ + T2<- Nmr[2]/Cp[2] + }else{ + T2<- Nmr[3]/Cp[3] + } + Pk<- (1-T2)*Ak+T2*Bk + Out<- list(Pk,N+T2) + return(Out) +} + +######################### + +Kukannozoku<- function(Jokyo,KukanL){ + Eps<- 10^(-6) + N<- Nrow(KukanL) + T1<- Jokyo[1]; T2<- Jokyo[2] + Tmp<- KukanL[1,] + T1<- max(T1,Tmp[1]) + Tmp<- KukanL[N,] + T2<- min(T2,Tmp[2]) + Res<- c() + Flg<- 0 + for (I in Looprange(1,N)){ + Ku<- KukanL[I,] + if(Flg==0){ + if(Ku[2]T2+Eps){ + Tmp<- c(T2,Ku[2]) + Res<- rbind(Res,Tmp) + } + } + }else if(Flg==1){ + if(Ku[2]0){ + for (J in 1:Mixlength(KC)){ + P<- Op(1,Op(J,KC)) + Tmp<- Op(2,Op(J,KC)) + if(Tmp<1+Eps && Ns==1){ + next + } + if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ + next + } + N1<- Ns + N2<- Op(3,Op(J,KC)) + Pa<- Plt2[N1,1:2] + Za<- Plt2[N1,3] + Pb<- Plt2[N1+1,1:2] + Zb<- Plt2[N1+1,3] + if(Norm(Pa-Pb)Eps^2){ + Tmp1<- P1[2,]-P1[1,] + Tmp2<- Pb-Pa + Tmp3<- Dotprod(Tmp1,Tmp2) + Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) + Tmp<- 1-0.5*Tmp3^2 + ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) + } + } + } + } + } + } + Te<- Nrow(Plt2) + KukanL<- rbind(c(),c(1.0,Te)) + P1<- PhL + if(Nrow(ClipL)>0){ + for (I in 1:Nrow(ClipL)){ + P<- ClipL[I,1:2] + NN<- ClipL[I,3] + T<- NN+ClipL[I,4] + R<- ClipL[I,5] + Flg<- 0 + for (J in NN:1){ + Q<- Pointoncurve(J,P1) + if(Norm(P-Q)Eps){ + Tmp<- Pointoncurve(T2,P1) + PtL<- c(PtL,list(Tmp)) + } + Res<- c(Res,list(Listplot(PtL))) + } + Allres<- c(Allres,Res) + } + return(Allres) +} + +######################### + +#100815 +Makeskeletonpersdata<- function(Obj2L,Plt2L,R0,Eps2){ + Eps<- 10.0^(-3) + Dmat<- c() + Dind<- c() + for (I in Looprange(1,Mixlength(Plt2L))){ + Dt<- Op(I,Plt2L) + N1<- Nrow(Dmat)+1 + Dmat<- rbind(Dmat,Dt) + N2<- Nrow(Dmat) + Dind<- rbind(Dind,c(N1,N2)) + } + Nind<- Nrow(Dind) + Allres<- list() + for (Nobj in Looprange(1,Mixlength(Obj2L))){ + Plt2<- Op(Nobj,Obj2L) + PhL<- Plt2[,1:2] + ClipL<- c() + for (Ns in Looprange(1,Nrow(PhL)-1)){ + P1<- PhL[Ns:(Ns+1),] + for (I in Looprange(1,Nrow(Dind))){ + Tmp<- Dmat[Dind[I,1]:Dind[I,2],] + P2<- Tmp[,1:2] + KC<- IntersectcrvsPp(P1,P2,Eps) + if(Mixlength(KC)>0){ + for (J in Looprange(1,Mixlength(KC))){# + P<- Op(1,Op(J,KC)) + Tmp<- Op(2,Op(J,KC)) + if(Tmp<(1+Eps) && Ns==1){ + next + } + if(Tmp>Numptcrv(P1)-Eps && Ns==(Nrow(PhL)-1)){ + next + } + N1<- Ns + N2<- Op(3,Op(J,KC)) + Pa<- Plt2[N1,1:2] + Za<- Plt2[N1,3] + Pb<- Plt2[N1+1,1:2] + Zb<- Plt2[N1+1,3] + if(Norm(Pa-Pb)1-Eps){ + Pk<- Pkb + }else{ + Tmp1<- Listplot(c(Pa,Pb)) + Tmp2<- Spaceline(c(Pka,Pkb)) + Tmp<- Invperspt(1+T1,Tmp1,Tmp2) + Pk<- Op(1,Tmp) + } + Z1<- Zperspt(Pk) + Tmp<- Dmat[Dind[I,1]:Dind[I,2],] + Pa<- Tmp[N2,1:2] + Za<- Tmp[N2,3] + Pb<- Tmp[N2+1,1:2] + Zb<- Tmp[N2+1,3] + if(Norm(Pa-Pb)(1-Eps)){ + Pk<- Pkb + }else{ + Tmp1<- Listplot(c(Pa,Pb)) + Tmp2<- Spaceline(c(Pka,Pkb)) + Tmp<- Invperspt(1+T2,Tmp1,Tmp2) + Pk<- Op(1,Tmp) + } + Z2<- Zperspt(Pk) + if(Z1<(Z2-Eps2)){ + if(length(ClipL)==0){ + Tmp<- 1 + }else{ + Tmp1<- ClipL[,1]-P[1] + Tmp2<- ClipL[,2]-P[2] + Tmp3<- Tmp1^2+Tmp2^2 + Tmp<- min(Tmp3) + } + if(Tmp>Eps^2){ + Tmp1<- P1[2,]-P1[1,] + Tmp2<- Pb-Pa + Tmp3<- Dotprod(Tmp1,Tmp2) + Tmp3<- Tmp3/Norm(Tmp1)/Norm(Tmp2) + Tmp<- 1-0.5*Tmp3^2 + ClipL<- rbind(ClipL,c(P,N1,T1,R0/Tmp)) + } + } + } + } + } + } + Te<- Nrow(Plt2) + KukanL<- rbind(c(),c(1.0,Te)) + P1<- PhL + if(Nrow(ClipL)>0){ + for (I in Looprange(1,Nrow(ClipL))){ + P<- ClipL[I,1:2] + NN<- ClipL[I,3] + T<- NN+ClipL[I,4] + R<- ClipL[I,5] #added 10.08.17 + Flg<- 0 + for (J in NN:1){ + Q<- Pointoncurve(J,P1) + if(Norm(P-Q)Eps){ + Tmp<- Pointoncurve(T2,P1) + PtL<- c(PtL,list(Tmp))#Mixadd(PtL,Tmp) + } + Res<- c(Res,list(Listplot(PtL)))#Res<- Mixadd(Res,Listplot(PtL)) + } + Allres<- c(Allres,Res)#Allres<- Mixjoin(Allres,Res) + } + return(Allres) +} + +##############################3 + +MakeveLfaceL<- function(VfL){ +# // Out format +# // VeL Edge, Face num(as numlist), VeL num +# // FL Face (Vertexs) + Eps<- 10^(-4) + Tmp<- VfL[[length(VfL)]] + Tmp1<- Tmp[[1]] + if(mode(Tmp1)=="numeric"){ + FvL<- list(VfL) + }else{ + FvL<- VfL + } + EL<- list(); FL<- list() + for (Nn in Looprange(1,length(FvL))){ + Tmp<- FvL[[Nn]] + VL<- Tmp[[1]] + if(length(VL)>0){ + FnL<- Tmp[[2]] + FaceL<- list() + for (I in Looprange(1,length(FnL))){ + Tmp1<- FnL[[I]] + PtL<- list() + for (J in Looprange(1,length(Tmp1))){ + Tmp2<- Tmp1[[J]] + PtL[[J]]<- VL[[Tmp2]] + } + FaceL[[I]]<- PtL + } + }else{ + FaceL<- list(Tmp[[2]]) + } + for (I in Looprange(1,length(FaceL))){ + Face<- FaceL[[I]] + Face<- c(Face,list(Face[[1]])) + FL<- c(FL,list(Face)) + for (J in Looprange(1,length(Face)-1)){ + Edge<- list(Face[[J]],Face[[J+1]]) + Flg<- 0 + for (K in Looprange(1,length(EL))){ + Tmp<- EL[[K]] + Tmp1<- Tmp[[1]] + Tmp2<- Norm(Edge[[1]]-Tmp1[[1]])+Norm(Edge[[2]]-Tmp1[[2]]) + Tmp3<- Norm(Edge[[1]]-Tmp1[[2]])+Norm(Edge[[2]]-Tmp1[[1]]) + if(Tmp21-Eps){# // P3, Q3 are necessary + Flg<- I + break + } + if(abs(Te-Ts)>Eps0){ + if((I%%2)==1){ + Out1<- c(Out1,list(list(Pe3,P3))) + }else{ + if(length(Qe3)==0){ + Tmp<- Op(2,TenL[[I-1]]) + if(Ptype==-1){ + Tmp1<- Invperspt(Tmp,Spaceline(Face)) + }else{ + Tmp1<- Invparapt(Tmp,Spaceline(Face)) + } + Qe3<- Tmp1[[1]] + } + PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) + if(Ptype==-1){ + Z1<- Zperspt(PM); Z2<- Zperspt(QM) + }else{ + Z1<- Zparapt(PM); Z2<- Zparapt(QM) + } + if(Z1>Z2){ + Out1<- c(Out1, list(list(Pe3,P3))) + }else{ + Out2<- c(Out2, list(list(Pe3,P3))) + }## + } + } + Te<- Ts; Pe3<- P3; Qe3<- Q3 + } + if(Flg==0){ + if(Norm(Pe3-Edge[[2]])>Eps0){ + Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) + } + }else{ + if((Flg%%2)==1){ + Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) + }else{ + PM<- 0.5*(Pe3+P3); QM<- 0.5*(Qe3+Q3) + if(Ptype==-1){ + Z1<- Zperspt(PM); Z2<- Zperspt(QM) + }else{ + Z1<- Zparapt(PM); Z2<- Zparapt(QM) + } + if(Z1>Z2){ + Out1<- c(Out1, list(list(Pe3,Edge[[2]]))) + }else{ + Out2<- c(Out2, list(list(Pe3,Edge[[2]]))) + } + } + } + for (I in Looprange(1,length(Out1))){ + Tmp<- Out1[[I]] + if(I==1){ + SeL<- Tmp + }else{ + if(Norm(SeL[[2]]-Tmp[[1]])0){ + Out1L<- c(Out1L, list(list(SeL,Ne,NNe))) + } + for (I in Looprange(1,length(Out2))){ + Tmp<- Out2[[I]] + if(I==1){ + SeL<- Tmp + }else{ + if(Norm(SeL[[2]]-Tmp[[1]])0){ + Out2L<- c(Out2L, list(list(SeL,Ne,NNe))) + } + } + VELNO<<- Out1L + VELHI<<- Out2L +} + +################################### + +Parapt<- function(Plist){ # 18.02.19 changed (for point list) + if(!is.list(Plist)){Plist=list(Plist)} + Out=list() + for(jj in 1:length(Plist)){ + P=Op(jj,Plist) + x<- P[1] + y<- P[2] + z<- P[3] + Xz<- -x*sin(PHI)+y*cos(PHI) + Yz<- -x*cos(PHI)*cos(THETA)-y*sin(PHI)*cos(THETA)+z*sin(THETA) + Out<- c(Out,list(c(Xz,Yz))) + } + if(length(Out)==1){Out=Op(1,Out)} + return(Out) +} + +################################### + +Partcrv3<- function(T1,T2,Fk){ + Eps0=10^(-4) +#// Tmp=Mixop(1,Fk) +#// new part from + if(T1>(T2+Eps0)){ + Npt<- Nrow(Fk) + Out1<- Partcrv3(T1,Npt,Fk) + Out2<- Partcrv3(1,T2,Fk) + Tmp<- Fk[1,]-Fk[Npt,] + if(Norm(Tmp)(Ie+Eps0)){ + P<- (1-T2+Ie)*Fk[Ie,]+(T2-Ie)*Fk[Ie+1,] + PL<- Appendrow(PL,P) + } + } + return(PL) +} + +################################### + +#100815 +Perspt<- function(P){ + Tmp<- P-FocusPoint + X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] + Tmp<- EyePoint-FocusPoint + E1<- Tmp[1];F1<- Tmp[2];G1<- Tmp[3] + Ca<- E1/sqrt(E1^2+F1^2) + Sa<- F1/sqrt(E1^2+F1^2) + X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 + E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 + Cb<- E2/sqrt(E2^2+G2^2) + Sb<- G2/sqrt(E2^2+G2^2) + X3<- X2*Cb+Z2*Sb; Y3<- Y2; Z3<- -X2*Sb+Z2*Cb + E3<- E2*Cb+G2*Sb; F3<- F2; G3<- -E2*Sb+G2*Cb + Yz<- E3/(E3-X3)*Y3 + Zz<- E3/(E3-X3)*Z3 + Out<- c(Yz,Zz) + return(Out) +} + + +################################# + +Phcutdata<- function(VL,FaceL,PlaneD){ + Out<- list() + EL<- list() + Eps<- 10^(-4) + for (I in Looprange(1,Mixlength(FaceL))){ + Face<- Op(I,FaceL) + for (J in Looprange(1,length(Face))){ + Nj<- J+1 + if(J==length(Face)){ + Nj<- 1 + } + N1<- Face[J]; N2<- Face[Nj] + Tmp<- c(N1,N2) + Flg<- 0 + for (K in Looprange(1,Mixlength(EL))){ + Tmp1<- Op(K,EL) + Tmp2<- Tmp1[2:1] + if(all(Tmp==Tmp1) || all(Tmp==Tmp2)){ + Flg<- 1 + break + } + } + if(Flg==0){ + EL<- c(EL,list(Tmp)) + } + } + } + Out0<- list() + for (I in Looprange(1,Mixlength(EL))){ + Tmp<- Op(I,EL) + Tmp1<- Op(Tmp[1],VL) + Tmp2<- Op(Tmp[2],VL) + Out0<- c(Out0, list(Spaceline(Tmp1,Tmp2))) + } + if(Mixtype(PlaneD)!=1){ + V1<- Op(1,PlaneD) + Tmp<- Op(2,PlaneD) + if(length(Tmp)>1){ + d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] + }else{ + d<- Tmp + } + }else if(mode(PlaneD)=="numeric"){ + V1<- PlaneD[1:3] + d<- PlaneD[4] + }else{ + StrV<- strsplit(PlaneD,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Tmp1<- StrV[1] + Tmp2<- StrV[2] + PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") + } + x<- 0; y<- 0; z<- 0 + d<- -eval(parse(text=PlaneD)) + x<- 1; y<- 0; z<- 0; + Tmp1<- eval(parse(text=PlaneD))+d + x<- 0; y<- 1; z<- 0 + Tmp2<- eval(parse(text=PlaneD))+d + x<- 0; y<- 0; z<- 1 + Tmp3<- eval(parse(text=PlaneD))+d + V1<- c(Tmp1,Tmp2,Tmp3) + } + if(all(V1==c(0,0,0))){ + return(Out0) + } + V3<- c(1,0,0) + Out1<- Rotate3data(Out0,V1,V3) + Tmp2<- Rotate3pt(c(1,0,0),V3,V1) + Tmp<- V1[1]*Tmp2[1]+V1[2]*Tmp2[2]+V1[3]*Tmp2[3] + x0<- d/Tmp + PtL<- list() + for (I in Looprange(1,Mixlength(Out1))){ + Tmp<- Op(I,Out1) + Tmp1<- Tmp[1,]; Tmp2<- Tmp[2,] + P<- list(Tmp1,Tmp2-Tmp1) + Tmp<- list(Tmp1[1],Tmp2[1]-Tmp1[1]) + if(abs(Tmp[[2]]) < Eps){ + Tmp<- c() + }else{ + Tmp1<- Tmp[[2]] + Tmp2<- x0-Tmp[[1]] + Tmp<- c(Tmp2/Tmp1) + } + if(length(Tmp)>0){ + Tmp<- Tmp[1] + if(Tmp>-Eps && Tmp<(1+Eps)){ + Tmp3<- P[[1]]+Tmp*P[[2]] + Tmp3<- Rotate3pt(Tmp3,V3,V1) + if(Tmp1-Eps){ + Tmp1<- Op(I,EL) + Tmp1<- Tmp1[2] + Tmp4<- list(c(Tmp1,Tmp1),Tmp3) + }else{ + Tmp4<- list(Op(I,EL),Tmp3) + } + } + Flg<- 0 + for (J in Looprange(1,Mixlength(PtL))){ + Tmp<- Op(J,PtL) + Tmp<- Op(2,Tmp) + if(Norm(Tmp3-Tmp)1){ + d<- V1[1]*Tmp[1]+V1[2]*Tmp[2]+V1[3]*Tmp[3] + }else{ + d<- Tmp + } + }else if(mode(PlaneD)=="numeric"){ + V1<- PlaneD[1:3] + d<- PlaneD[4] + }else{ + StrV<- strsplit(PlaneD,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Tmp1<- StrV[1] + Tmp2<- StrV[2] + PlaneD<- paste(Tmp1,"-(",Tmp2,")",sep="") + } + x<- 0; y<- 0; z<- 0 + d<- -eval(parse(text=PlaneD)) + x<- 1; y<- 0; z<- 0 + Tmp1<- eval(parse(text=PlaneD))+d + x<- 0; y<- 1; z<- 0 + Tmp2<- eval(parse(text=PlaneD))+d + x<- 0; y<- 0; z<- 1 + Tmp3<- eval(parse(text=PlaneD))+d + V1<- c(Tmp1,Tmp2,Tmp3) + } + for (I in Looprange(1,Mixlength(FaceL))){ + Face<- Op(I,FaceL) + TmpL<- list() + for (J in Looprange(1,length(Face))){ + N1<- Face[J] + if(J==length(Face)){ + N2<- Face[1] + }else{ + N2<- Face[J+1] + } + for (K in Looprange(1,Mixlength(PtL))){ + Pd<- Op(K,PtL) + Tmp<- Op(1,Pd) + if(Tmp[1]==Tmp[2]){ + if(Tmp[1]==N1){ + TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) + } + }else{ + if(all(Tmp==c(N1,N2)) || all(Tmp==c(N2,N1))){ + TmpL<- c(TmpL,list(list(J,c(N1,N2),Op(2,Pd)))) + } + } + } + } + if(Mixlength(TmpL)<2){ + Flg<- 0 + for (J in Looprange(1,length(Face))){ + Tmp<- Op(Face[J],VL) + Tmp1<- Fugou*(Dotprod(V1,Tmp)-d) + if(Tmp1< -Eps){ + Flg<- 1 + break + } + } + if(Flg==0){ + OutfL<- c(OutfL,list(Face)) + } + next + } + Pd<- Op(1,TmpL) + Qd<- Op(2,TmpL) + Outf1<- c(Op(3,Pd)) + Nf<- Op(1,Pd)+1 + Tmp<- Op(2,Pd) + JJ<- 0 + while (!all(Tmp==Op(2,Qd))){ + JJ<- JJ+1 + if(JJ>20){ + print("bug") + return() + } + Tmp1<- Tmp[2] + if(Outf1[length(Outf1)]!=Tmp1){ + Outf1<- c(Outf1,Tmp1) + } + Tmp<- c(Face[Nf]) + Nf<- Nf+1 + if(Nf>length(Face)){ + Nf<- 1 + } + Tmp<- c(Tmp,Face[Nf]) + } + Tmp1<- Op(3,Qd) + if(Outf1[length(Outf1)]!=Tmp1){ + Outf1<- c(Outf1,Tmp1) + } + Outf2<- c(Op(3,Pd)) + Nf<- Op(1,Pd) + Tmp<- Op(2,Pd) + JJ<- 0 + while (!all(Tmp==Op(2,Qd))){ + JJ<- JJ+1 + if(JJ>20){ + print("bug") + return() + } + Tmp1<- Tmp[1] + if(Outf2[length(Outf2)]!=Tmp1){ + Outf2<- c(Outf2,Tmp1) + } + Tmp<- c(Face[Nf]) + Nf<- Nf-1 + if(Nf<1){ + Nf<- length(Face) + } + Tmp<- c(Face[Nf],Tmp) + } + Tmp1<- Op(3,Qd) + if(Outf2[length(Outf2)]!=Tmp1){ + Outf2<- c(Outf2,Tmp1) + } + if(length(Outf1)<3 || length(Outf2)<3){ + Face<- Outf1 + if(length(Outf1)=4){ + C<- varargin[[4]] + } + if(Mixtype(Pd3)==1){ + Pd3<- list(Pd3) + } else if(Mixtype(Pd3)==3){ + Tmp<- list() + for (I in Looprange(1,Mixlength(Pd3))){ + Tmp<- c(Tmp,Op(I,Pd3)) + } + Pd3<- Tmp + } + Out<- list() + for (I in Looprange(1,Mixlength(Pd3))){ + PD<- Op(I,Pd3) + Ans<- c() + for (J in Looprange(1,Nrow(PD))){ + if(is.matrix(PD)){ # 11.08.27 + P<- PD[J,] + } + else{ + P<- PD + } + Tmp<- Rotate3pt(P,W1,W2,C) # 14.03.23 + Ans<- rbind(Ans,Tmp) + } # 11.08.27 + rownames(Ans)<- 1:Nrow(Ans) #10.08.16 + Out<- c(Out,list(Ans)) + } + if(Mixlength(Out)==1){ + Out<- Op(1,Out) + } + return(Out) +} + +####################################### + +Rotate3pt<- function(...){ + varargin<-list(...) + Eps<-10^(-4) + Nargs<-length(varargin) + P<- varargin[[1]] + W1<- varargin[[2]] + W2<- varargin[[3]] + C<- c(0,0,0) + if(Nargs>=4){ + C<- varargin[[4]] + } + if(mode(W2)=="numeric" && length(W2)==1){ + Ct<- cos(W2) + St<- sin(W2) + V3<- 1/Norm(W1)*W1 + if(V3[1]==0){ + Tmp<- c(1,0,0) + }else{ + Tmp<- c(0,1,0) + } + W1<- c(Tmp[2]*V3[3]-Tmp[3]*V3[2], + Tmp[3]*V3[1]-Tmp[1]*V3[3], + Tmp[1]*V3[2]-Tmp[2]*V3[1]) + V1<- 1/Norm(W1)*W1 + V2<- c(V3[2]*V1[3]-V3[3]*V1[2], + V3[3]*V1[1]-V3[1]*V1[3], + V3[1]*V1[2]-V3[2]*V1[1]) + }else{ + Tmp<- c(W1[2]*W2[3]-W1[3]*W2[2], + W1[3]*W2[1]-W1[1]*W2[3], + W1[1]*W2[2]-W1[2]*W2[1]) + if(Norm(Tmp)=3){ + Ndu<- varargin[[2]] + Ndv<- varargin[[3]] + } + if(Nargs>=4){ + Np<- varargin[[4]] + if(mode(Np)=="numeric" && length(Np)==1){ + Np<- c(Np,Np) + } + } + Du<- (Umax-Umin)/Ndu + Dv<- (Vmax-Vmin)/Ndv + PL <- c()#PL <- [] + Assign("Vmin",Vmin,"Vmax",Vmax) + Trgstr<- Assign("t=c(Vmin,Vmax)") + PL <- list() + for (I in Looprange(0,Ndu)){ + U0 <- paste("(",as.character(Umin+I*Du),")",sep="") + Tmp<- gsub(U,U0,Xf,fixed=TRUE) + Tmp1<- gsub(V,"t",Tmp,fixed=TRUE) + Tmp<- gsub(U,U0,Yf,fixed=TRUE) + Tmp2<- gsub(V,"t",Tmp,fixed=TRUE) + Tmp<- gsub(U,U0,Zf,fixed=TRUE) + Tmp3<- gsub(V,"t",Tmp,fixed=TRUE) + Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")",sep="") + PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[2]))) + PL<- c(PL,list(PD)) + } + Assign("Umin",Umin,"Umax",Umax) + Trgstr<- Assign("t=c(Umin,Umax)") + for (J in Looprange(0,Ndv)){ + V0<- paste("(",as.character(Vmin+J*Dv),")",sep="") + Tmp<- gsub(V,V0,Xf,fixed=TRUE) + Tmp1<- gsub(U,"t",Tmp,fixed=TRUE) + Tmp<- gsub(V,V0,Yf,fixed=TRUE) + Tmp2<- gsub(U,"t",Tmp,fixed=TRUE) + Tmp<- gsub(V,V0,Zf,fixed=TRUE) + Tmp3<- gsub(U,"t",Tmp,fixed=TRUE) + Tmp<- paste("c(",Tmp1,",",Tmp2,",",Tmp3,")") + PD<- Spacecurve(Tmp,Trgstr,paste("N=",as.character(Np[1]))) + PL<- c(PL,list(PD)) + } + return(PL) +} + +################################### + +Skeletonparadata<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + Out<- list() + ObjL<- Flattenlist(varargin[[1]]) + Plt3L<- Flattenlist(varargin[[2]]) + R<- 0.075*1000/2.54/MilliIn + if(Nargs>2){ + R<- R*varargin[[3]] + } + Eps2<- 0.05 + if(Nargs>3){ + Eps2<- varargin[[4]] + } + Obj2L<- list() + for (I in Looprange(1,Mixlength(ObjL))){ + Tmp<- ProjcoordCurve(Op(I,ObjL)) + Obj2L<- c(Obj2L,list(Tmp)) + } + Plt2L<- list() + for (I in Looprange(1,Mixlength(Plt3L))){ + Tmp<- ProjcoordCurve(Op(I,Plt3L)) + Plt2L<- c(Plt2L,list(Tmp)) + } + Out<- Makeskeletondata(Obj2L,Plt2L,R,Eps2) + return(Out) +} + +################################ + +Skeletonpara3data<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + ObjL<- Flattenlist(varargin[[1]]) + Plt3L<- Flattenlist(varargin[[2]]) + R<- 0.075*1000/2.54/MilliIn + if(Nargs>2){ + R=R*varargin[[3]] + } + Eps2<- 0.05 + if(Nargs>3){ + Eps2<- varargin[[4]] + } + Plt2L<- list() + for (I in Looprange(1,Mixlength(Plt3L))){ + Tmp<- ProjcoordCurve(Op(I,Plt3L)) + Plt2L<- c(Plt2L,list(Tmp)) + } + Out<- list() + for (I in Looprange(1,Mixlength(ObjL))){ + Obj3<- Op(I,ObjL) + Tmp<- ProjcoordCurve(Obj3) + Data<- Makeskeletondata(list(Tmp),Plt2L,R,Eps2) + for (J in Looprange(1,Mixlength(Data))){ + Gd<- Op(J,Data) + PtD<- c() + for (J in Looprange(1,Nrow(Gd))){ + Tmp<- Ptcrv(J,Gd) + Tmp1<- Invparapt(Tmp,Obj3) + Tmp1<- Op(1,Tmp1) + PtD<- c(PtD,Tmp1) + } + PtD<- matrix(PtD,ncol=3,byrow=TRUE) + Out<- c(Out,list(PtD)) + } + } + return(Out) +} + +################################# + +#100815 +Skeletonpersdata<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + Out<- list() + ObjL<- Flattenlist(varargin[[1]]) + Plt3L<- Flattenlist(varargin[[2]]) + R<- 0.075*1000/2.54/MilliIn + if(Nargs>2){ + R<- R*varargin[[3]] + } + Eps2<- 0.05 + if(Nargs>3){ + Eps2<- varargin[[4]] + } + Obj2L<- list() + for (I in Looprange(1,Mixlength(ObjL))){ + Tmp<- CameracoordCurve(Op(I,ObjL)) + Obj2L<- c(Obj2L,list(Tmp)) + } + Plt2L<- list() + for (I in Looprange(1,Mixlength(Plt3L))){ + Tmp<- CameracoordCurve(Op(I,Plt3L)) + Plt2L<- c(Plt2L,list(Tmp)) + } + Out<- Makeskeletonpersdata(Obj2L,Plt2L,R,Eps2) + return(Out) +} + +##################### +#100815 +Skeletonpers3data<- function(...){ + varargin<-list(...) + Nargs<- length(varargin) + Out<- list() + ObjL<- Flattenlist(varargin[[1]]) + Plt3L<- Flattenlist(varargin[[2]]) + R<- 0.075*1000/2.54/MilliIn + if(Nargs>2){ + R<- R*varargin[[3]] + } + Eps2<- 0.05 + if(Nargs>3){ + Eps2<- varargin[[4]] + } + Plt2L<- list() + for (I in Looprange(1,Mixlength(Plt3L))){ + Tmp<- CameracoordCurve(Op(I,Plt3L)) + Plt2L<- c(Plt2L,list(Tmp)) + } + Out<- list() + for (I in Looprange(1,Mixlength(ObjL))){ + Obj3<- Op(I,ObjL) + Tmp<- CameracoordCurve(Obj3) + Data<- Makeskeletonpersdata(list(Tmp),Plt2L,R,Eps2) + for (J in Looprange(1,Mixlength(Data))){ + Gd<- Op(J,Data) + PtD<- c() + for (J in Looprange(1,Nrow(Gd))){ + Tmp<- Gd[J,] + Tmp1<- Invperspt(Tmp,Obj3) + Tmp1<- Op(1,Tmp1) + PtD<- rbind(PtD,Tmp1) + } + Out<- c(Out,list(PtD)) + } + } + return(Out) +} + +################################# + +Spacecurve<- function(...){ + Eps<- 10^(-5) + varargin<-list(...) + Nargs<- length(varargin) + Fnstr<- varargin[[1]] + Rgstr<- varargin[[2]] + Range<- c(0,2*pi) + N<- 50 #Numpoints + E<- c() #Exclusions + D<- Inf #Discont (Changed) + for(I in Looprange(3,Nargs)){ + Tmp<- varargin[[I]] + StrV<- strsplit(Tmp,"=",fixed=TRUE) + StrV<- StrV[[1]] + Tmp1<- toupper(StrV[1]) + Lhs<- substr(Tmp1,1,1) + Str<- paste(Lhs,"=",StrV[2],sep="") + eval(parse(text=Str)) + } + StrV<- strsplit(Rgstr,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Vname<- StrV[1] + Rng<- eval(parse(text=StrV[2])) + } + else{ + Vname<- Rgstr + Rng<- c(XMIN,XMAX) + } + T1<- Rng[1]; T2<- Rng[2] + Dt<- (T2-T1)/N #17.09.22 + Str<- gsub(Vname,"t",Fnstr) + Str=gsub("[","c(",Str,fixed=TRUE) #17.12.22(2lines) + Str=gsub("]",")",Str,fixed=TRUE) + if(abs(Dt)0 && P[Nrow(P),1]!=Inf){ + Pa<- c(Inf,Inf,Inf) + } + } + if(t-E[Ke]>Eps){ + Pa<- eval(parse(text=Str)) + Ke<- Ke+1 + } + if(length(Pa)>0){ + if(Pa[1]==Inf){ + P<- rbind(P,Pa) + }else if(length(P)==0){ + P<- rbind(c(),c(Pa)) + } + else{ + Tmp<- P[Nrow(P),] + if(Tmp[1]==Inf){ + P<- rbind(P,Pa) + } + else if( Norm(Tmp-Pa)1) StrV<- StrV[2] + Tmp<- eval(parse(text=StrV)) + Py<- c(0,Tmp[1],0) + Qy<- c(0,Tmp[2],0) + StrV<-strsplit(Zrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1) StrV<- StrV[2] + Tmp<- eval(parse(text=StrV)) + Pz<- c(0,0,Tmp[1]) + Qz<- c(0,0,Tmp[2]) + Out<- list(Spaceline(Px,Qx),Spaceline(Py,Qy),Spaceline(Pz,Qz)) + return(Out) +} + +################################### + +Xyzaxparaname<- function(...){ + varargin<- list(...) + Nargs<- length(varargin) + Eps<- 10.0^(-6) + Dr<- 0.19*1000/2.54/MilliIn + Tmp<- varargin[[Nargs]] + if(Nargs>1 && is.numeric(Tmp)){ + Dr<- Dr*Tmp + Nargs<- Nargs-1 + } + if(mode(varargin[[1]])=="character"){ + Xname<- "x" + Yname<- "y" + Zname<- "z" + Xrange<- varargin[[1]] + Yrange<- varargin[[2]] + Zrange<- varargin[[3]] + StrV<-strsplit(Xrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Xname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Px<- c(Tmp[1],0,0) + Qx<- c(Tmp[2],0,0) + StrV<-strsplit(Yrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Yname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Py<- c(0,Tmp[1],0) + Qy<- c(0,Tmp[2],0) + StrV<-strsplit(Zrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Zname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Pz<- c(0,0,Tmp[1]) + Qz<- c(0,0,Tmp[2]) + }else{ + Data<- varargin[[1]] + Xname<- "x"; Yname<- "y"; Zname<- "z" + if(Nargs>1){ + if(varargin[[2]]!=""){ + Xname<- varargin[[2]] + } + if(varargin[[3]]!=""){ + Yname<- varargin[[3]] + } + if(varargin[[4]]!=""){ + Zname<- varargin[[4]] + } + } + Tmp<- Op(1,Data) + Px<- Tmp[1,]; Qx<- Tmp[2,] + Tmp<- Op(2,Data) + Py<- Tmp[1,] + Qy<- Tmp[2,] + Tmp<- Op(3,Data) + Pz<- Tmp[1,] + Qz<- Tmp[2,] + } + Ph<- Parapt(Px); Qh<- Parapt(Qx); R<-Norm(Ph-Qh) + Kekka<- list() + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Xname) + } + Ph<- Parapt(Py); Qh<- Parapt(Qy); R<- Norm(Ph-Qh) + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Yname) + } + Ph<- Parapt(Pz); Qh<- Parapt(Qz); R<- Norm(Ph-Qh) + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Zname) + } +# return(Kekka) +} + +################################### + +Xyzaxpersname<- function(...){ + varargin<- list(...) + Eps<- 10.0^(-6) + Nargs<- length(varargin) + Dr<- 0.19*1000/2.54/MilliIn + Tmp<- varargin[[Nargs]] + if(Nargs>1 && mode(Tmp)=="numeric"){ + Dr<- Dr*Tmp + Nargs<- Nargs-1 + } + if(mode(varargin[[1]])=="character"){ + Xname<- "x" + Yname<- "y" + Zname<- "z" + Xrange<- varargin[[1]] + Yrange<- varargin[[2]] + Zrange<- varargin[[3]] + StrV<-strsplit(Xrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Xname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Px<- c(Tmp[1],0,0) + Qx<- c(Tmp[2],0,0) + StrV<-strsplit(Yrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Yname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Py<- c(0,Tmp[1],0) + Qy<- c(0,Tmp[2],0) + StrV<-strsplit(Zrange,"=",fixed=TRUE) + StrV<- StrV[[1]] + if(length(StrV)>1){ + Zname<- StrV[1] + StrV<- StrV[2] + } + Tmp<- eval(parse(text=StrV)) + Pz<- c(0,0,Tmp[1]) + Qz<- c(0,0,Tmp[2]) + }else{ + Data<- varargin[[1]] + Xname<- "x"; Yname<- "y"; Zname<- "z" + if(Nargs>1){ + if(varargin[[2]]!=""){ + Xname<- varargin[[2]] + } + if(varargin[[3]]!=""){ + Yname<- varargin[[3]] + } + if(varargin[[4]]!=""){ + Zname<- varargin[[4]] + } + } + Tmp<- Op(1,Data) + Px<- Tmp[1,]; Qx<- Tmp[2,] + Tmp<- Op(2,Data) + Py<- Tmp[1,] + Qy<- Tmp[2,] + Tmp<- Op(3,Data) + Pz<- Tmp[1,] + Qz<- Tmp[2,] + } + Ph<- Perspt(Px) + Qh<- Perspt(Qx) + R<- Norm(Ph-Qh) + Kekka<- list() + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Xname) + } + Ph<- Perspt(Py) + Qh<- Perspt(Qy) + R<- Norm(Ph-Qh) + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Yname) + } + Ph<- Perspt(Pz) + Qh<- Perspt(Qz) + R<- Norm(Ph-Qh) + if(R>Eps){ + Ch<- Qh+Dr/R*(Qh-Ph) + Kekka<- c(Kekka,list(Pointdata(Ch))) + Expr(Ch,"c",Zname) + } +# return(Kekka) +} + +######################### +#100815 +Zparapt<- function(P){#function Out=Zparapt(P) + x<- P[1]; y<- P[2]; z<- P[3] + Out<- x*cos(PHI)*sin(THETA)+y*sin(PHI)*sin(THETA)+z*cos(THETA) + return(Out) +} + +######################### +#100815 +Zperspt<- function(P){ + Tmp<- P-FocusPoint + X1<- Tmp[1]; Y1<- Tmp[2]; Z1<- Tmp[3] + Tmp<- EyePoint-FocusPoint + E1<- Tmp[1]; F1<- Tmp[2]; G1<- Tmp[3] + Ca<- E1/sqrt(E1^2+F1^2) + Sa<- F1/sqrt(E1^2+F1^2) + X2<- X1*Ca+Y1*Sa; Y2<- -X1*Sa+Y1*Ca; Z2<- Z1 + E2<- E1*Ca+F1*Sa; F2<- -E1*Sa+F1*Ca; G2<- G1 + Cb<- E2/sqrt(E2^2+G2^2) + Sb<- G2/sqrt(E2^2+G2^2) + X3<- X2*Cb+Z2*Sb + return(X3) +} + +########################################## + + + +########################################## + +# Stat Package + +########################################## + +# 2010.04.12 + +# new + +# Htickmarklower, Vtickmarkleft, HtickmarklowerV +# VtickmarkleftV, Insertcom, Replacecom +# Maketexfile, Formatting +# Drwhistframe, Histplotdata, Drwhistplot + +Htickmarklower<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + ArgsL<- varargin + if(mode(ArgsL[[1]])=="character"){ + Str<- ArgsL[[1]] + Tmp<- strsplit(Str,"m") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + I<- nchar(Tmp[1])+1 + } + else{ + I<- 0 + } + Tmp<- strsplit(Str,"n") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + J<- nchar(Tmp[1])+1 + } + else{ + J<- 0 + } + Tmp<- strsplit(Str,"r") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + K=nchar(Tmp[1])+1 + } + else{ + K<- 0 + } + if(K>0){ + S<- substr(Str,K+1,nchar(Str)) + R<- as.numeric(S) + if(is.na(R)){ + R<- 1 + } + } + else{ + R<- 1 + K<- nchar(Str)+1 + } + if(J>0){ + S<- substr(Str,J+1,K-1) + Dn<- as.numeric(S) + if(is.na(Dn)){ + Dn<- 1 + } + } + else{ + Dn<- 1000 + J<- nchar(Str)+1 + } + S<- substr(Str,I+1,J-1) + Dm<- as.numeric(S) + if(is.na(Dm)){ + Dm<- 1 + } + ArgsL<- list() + for (I in Looprange(1, floor((XMAX-GENTEN[1])/Dm))){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + for (I in seq(-1,ceiling((XMIN-GENTEN[1])/Dm),by=-1)){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + } + MemoriList<- list() + Memori<- list() + for (N in 1:length(ArgsL)){ + Dt<- ArgsL[[N]] + if(mode(Dt)=="numeric" && length(Dt)>1){ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt) + next + } + if(mode(Dt)=="character"){ + Memori<- Mixjoin(Memori,Dt) + } + else{ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt,GENTEN[2]) + } + } + MemoriList<- Mixjoin(MemoriList,list(Memori)) + for (N in 1:length(MemoriList)){ + Dt<- MemoriList[[N]] + Ndt<- length(Dt) + X=Op(1,Dt) + Y=Op(2,Dt) + Tmp<-Doscaling(c(X,Y)) + X<- Tmp[1] + Y<- Tmp[2] + Moji<- Op(Ndt,Dt) + Tmp1<- Unscaling(c(X,Y)) + Tmp2<- Unscaling(c(X,Y-2*MARKLEN)) + Fd<- Listplot(c(Tmp1,Tmp2)) + Drwline(Fd) + if(Ndt==3){ + Tmp<-Unscaling(c(X,Y-2*MARKLEN)) + Expr(Tmp,"s",Moji) + } + if(Ndt==4){ + Houkou<- Op(3,Dt) + Tmp<-grep("s",Houkou) + if(length(Tmp)>0){ + Tmp<-Unscaling(c(X,Y-2*MARKLEN)) + Expr(Tmp,Houkou,Moji) + } + else{ + Tmp<- Unscaling(c(X,Y)) + Expr(Tmp,Houkou,Moji) + } + } + cat("%\n",file=Wfile,append=TRUE) + } +} + +Vtickmarkleft<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + ArgsL<- varargin + if(mode(ArgsL[[1]])=="character"){ + Str<- ArgsL[[1]] + Tmp<- strsplit(Str,"m") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + I<- nchar(Tmp[1])+1 + } + else{ + I<- 0 + } + Tmp<- strsplit(Str,"n") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + J<- nchar(Tmp[1])+1 + } + else{ + J<- 0 + } + Tmp<- strsplit(Str,"r") + Tmp<- Tmp[[1]] + if(length(Tmp)>1){ + K=nchar(Tmp[1])+1 + } + else{ + K<- 0 + } + if(K>0){ + S<- substr(Str,K+1,nchar(Str)) + R<- as.numeric(S) + if(is.na(R)){ + R<- 1 + } + } + else{ + R<- 1 + K<- nchar(Str)+1 + } + if(J>0){ + S<- substr(Str,J+1,K-1) + Dn<- as.numeric(S) + if(is.na(Dn)){ + Dn<- 1 + } + } + else{ + Dn<- 1000 + J<- nchar(Str)+1 + } + S<- substr(Str,I+1,J-1) + Dm<- as.numeric(S) + if(is.na(Dm)){ + Dm<- 1 + } + ArgsL<- list() + for (I in 1:floor((YMAX-GENTEN[2])/Dm)){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + for (I in seq(-1,ceiling((YMIN-GENTEN[2])/Dm))){ + ArgsL<- Mixjoin(ArgsL,I*Dm) + if(I-floor(I/Dn)*Dn==0){ + Str<- as.character(I*Dm*R) + ArgsL<- Mixjoin(ArgsL,Str) + } + } + } + MemoriList<- list() + Memori<- list() + for (N in 1:length(ArgsL)){ + Dt<- ArgsL[[N]] + if(mode(Dt)=="numeric" && length(Dt)>1){ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(Dt) + next + } + if(mode(Dt)=="character"){ + Memori<- Mixjoin(Memori,Dt) + } + else{ + if(length(Memori)>0){ + MemoriList<- Mixjoin(MemoriList,list(Memori)) + } + Memori<- list(GENTEN[1],Dt) + } + } + MemoriList<- Mixjoin(MemoriList,list(Memori)) + for (N in 1:length(MemoriList)){ + Dt<- MemoriList[[N]] + Ndt<- length(Dt) + X=Op(1,Dt) + Y=Op(2,Dt) + Tmp<-Doscaling(c(X,Y)) + X<- Tmp[1] + Y<- Tmp[2] + Moji<- Op(Ndt,Dt) + Tmp1<- Unscaling(c(X,Y)) + Tmp2<- Unscaling(c(X-2*MARKLEN,Y)) + Fd<- Listplot(c(Tmp1,Tmp2)) + Drwline(Fd) + if(Ndt==3){ + Tmp<-Unscaling(c(X-2*MARKLEN,Y)) + Expr(Tmp,"w",Moji) + } + if(Ndt==4){ + Houkou<- Op(3,Dt) + Tmp<-grep("w",Houkou) + if(length(Tmp)>0){ + Tmp<-Unscaling(c(X-2*MARKLEN,Y)) + Expr(Tmp,Houkou,Moji) + } + else{ + Tmp<- Unscaling(c(X,Y)) + Expr(Tmp,Houkou,Moji) + } + } + cat("%\n",file=Wfile,append=TRUE) + } +} + +HtickmarklowerV<- function(Vec,digits=2,nsmall=2) +{ + for (I in 1:length(Vec)){ + Tmp<- Vec[I] + Htickmarklower(Tmp, Formatting(Tmp,digits,nsmall)) + } +} + +HtickLV<- function(...) +{ + HtickmarklowerV(...) +} + +VtickmarkleftV<- function(Vec,digits=2,nsmall=2) +{ + for (I in 1:length(Vec)){ + Tmp<- Vec[I] + Vtickmarkleft(Tmp, Formatting(Tmp,digits,nsmall)) + } +} + +VtickLV<- function(...) +{ + VtickmarkleftV(...) +} + +Insertcom<- function(CmdM,Npos,Str) +{ + if(is.matrix(CmdM)){ + Cmd<- CmdM + } + else{ + C<- paste("Cmd<- ",CmdM) + eval(parse(text=C)) + } + Out<- Cmd[Looprange(1,Npos-1),] + Out<- c(Out,Str) + Tmp<- Cmd[Looprange(Npos,nrow(Cmd)),] + Out<- c(Out,Tmp) + Out<- matrix(Out) + if(!is.matrix(CmdM)){ + C<- paste(CmdM,"<<- Out") + eval(parse(text=C)) + } + return(Out) +} + +Replacecom<- function(CmdM,Npos,Str) +{ + if(is.matrix(CmdM)){ + Cmd<- CmdM + } + else{ + C<- paste("Cmd<- ",CmdM) + eval(parse(text=C)) + } + Out<- Cmd[Looprange(1,Npos-1),] + Out<- c(Out,Str) + Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] + Out<- c(Out,Tmp) + Out<- matrix(Out) + if(!is.matrix(CmdM)){ + C<- paste(CmdM,"<<- Out") + eval(parse(text=C)) + } + return(Out) +} + +Deletecom<- function(CmdM,Npos) +{ + if(is.matrix(CmdM)){ + Cmd<- CmdM + } + else{ + C<- paste("Cmd<- ",CmdM) + eval(parse(text=C)) + } + Out<- Cmd[Looprange(1,Npos-1),] + Tmp<- Cmd[Looprange(Npos+1,nrow(Cmd)),] + Out<- c(Out,Tmp) + Out<- matrix(Out) + if(!is.matrix(CmdM)){ + C<- paste(CmdM,"<<- Out") + eval(parse(text=C)) + } + return(Out) +} + +Maketexfile<- function(commands="",texfile="") +{ + Openfile(texfile) + Execmd(commands) + Closefile() +} + +Formatting<- function(X,D=2,N=2) +{ + if(D>0){ + Xs <- format(X,digits=D,nsmall=N) + } + else{ + Xs<- as.character(X) + } + return(Xs) +} + +################################ + +Boxplotdata1 <-function(DataF1,CenterX,Width,...) +{ + Xr <- Width + Temp <- boxplot(DataF1[1],plot=FALSE) + Stats <- Temp$stats + rownames(Stats) <- c("Lhige","Q1","Q2","Q3","Uhige") + Out <- Temp$out + Lhige <- Stats["Lhige",1] + Uhige <- Stats["Uhige",1] + Q1 <- Stats["Q1",1] + Q2 <- Stats["Q2",1] + Q3 <- Stats["Q3",1] + CenterY <- (Q1+Q3)/2 + C <- c(CenterX,CenterY) + V <- c(0,(Q3-Q1)/2) + G1 <- Framedata(C,Xr/2,V[2]) # box + Temp1 <- c(0,Q1-Lhige) + Temp2 <- c(0,Uhige-Q3) + G2 <- Listplot(C-V,C-V-Temp1) # + G3 <- Listplot(C+V,C+V+Temp2) # + Temp3 <- c(Xr/4,0) + G4 <- Listplot(C-V-Temp1-Temp3,C-V-Temp1+Temp3) # + G5 <- Listplot(C+V+Temp2-Temp3,C+V+Temp2+Temp3) # + Temp4 <- c(0,Q3-Q2) + Temp5 <- c(Xr/2,0) + G6 <- Listplot(C+V-Temp4-Temp5,C+V-Temp4+Temp5) # + G7 <- list() + for(j in Looprange(1,length(Out))){ + G7 <- c(G7,list(c(CenterX, Out[j]))) + } + G7 <- G7[order(Out,decreasing=TRUE)] + list(median=G6,box=G1,uwhisker=G2,lwhisker=G3,lwp=G4,uwp=G5,outliers=G7) +} + +Boxplotdata2 <- function(Data,Ratio, ...) +{ + DataF<- Flattenlist(Data) # 11.07.21(from) + ymin<- Inf + ymax<- -Inf + for(J in 1:length(DataF)){ + Tmp<- DataF[[J]] + ymin<- min(ymin, min(Tmp)) + ymax<- max(ymax,max(Tmp)) + } # 11.07.21(until) + dy <- ymax-ymin + Setwindow(c(0,XMAX-XMIN),c(ymin-0.1*dy,ymax+0.1*dy)) + R1<- (YMAX-YMIN)/(XMAX-XMIN) + R<- Ratio/R1 + Setscaling(R) + Delta <- XMAX/length(DataF) + W <- 0.6*Delta + PdL <- list() + for(i in 1:length(DataF)){ # 11.07.21 + X <- (0.5+i-1)*Delta + G <- Boxplotdata1(DataF[i],X,W,...) + PdL <- c(PdL,list(G)) + } + G <- Framedata() + Tmp<- list(frame=G) + PdL <-c(PdL,list(Tmp)) + Epsi <-0 + Setwindow(c(XMIN-Epsi,XMAX+Epsi),c(YMIN-Epsi,YMAX+Epsi)) + return(PdL) +} + +Drwboxframe<-function(BoxDataL) +{ + Setorigin(c(XMIN,YMIN)) + Tmp<- Unscaling(c(0.2,0.2)) + Setwindow(c(XMIN-0.2,XMAX),c(YMIN-Tmp[2],YMAX)) + Hako<- BoxDataL$plotdata + title<- BoxDataL$title + cap<- BoxDataL$cap + ylab<- BoxDataL$ylab + if(mode(title)!="list") title<- list(title) + if(mode(cap)!="list") cap<- list(cap) + if(mode(ylab)!="list") ylab<- list(ylab) + if(length(title)==0) title<- list("") + if(length(title)==1) title<- c(title, list("n")) + if(length(title)==2) title<- c(title, list("")) + if(length(cap)==0) cap<- list("") + if(length(cap)==1) cap<- c(cap, list("n"),0) # 11.11.27 + if(length(cap)==2) cap<- c(cap, 0) # 11.11.27 + if(length(ylab)==0) ylab<- list("") + if(length(ylab)==1) ylab <- c(ylab, list("n")) + if(length(ylab)==2) ylab<- c(ylab, list("")) + Temp <- Hako[[length(Hako)]] + Drwline(Temp$frame) + Fontsize(cap[[2]]) + for(i in Looprange(1,length(Hako)-1)){ + Temp <- Hako[[i]] + attach(Temp) + Dashline(uwhisker,lwhisker) + Drwline(median,2) + Drwline(box,lwp,uwp) + Drwpt(outliers,0) + X <- uwhisker[1,1] + detach(Temp) + Htickmarklower(X) + if(nchar(cap[[1]])<1) next # 2011.03.08 + if(length(cap)==2 || cap[[3]]==0){ + pos<- 1 + if(length(cap)>=4) pos<- cap[[4]] + Tmp<- paste("s",as.character(pos),sep="") + Letter(c(X,YMIN),Tmp, Op(i,cap[[1]])) + } + else{ + rotate<- cap[[3]] + if(length(cap)==3){ + pos<- 0 + } + else{ + pos<- cap[[4]] + } + Temp1 <- rotate*pi/180 + Temp <- c(cos(Temp1),sin(Temp1)) + Letterrot(c(X,YMIN-pos),Temp,Op(i,cap[[1]])) + } + } + if(nchar(ylab[[1]])>0){ + Fontsize(ylab[[2]]) + Tmp1<- ylab[[1]] + Tmp3<- ylab[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Letter(c(XMIN, YMAX),"n2",Tmp1) + Fontsize("n") + } + if(nchar(title[[1]])>0){ + Fontsize(title[[2]]) + Tmp1<- title[[1]] + Tmp3<- title[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) + } + Fontsize("n") +} + +Drwboxplot<- function(dataf,var,size, + title=list(""), cap=list(colnames(dataf)), + ylab=list(""), ptsize=5,plot=TRUE,...) + #Return : title,cap,ylab,commands,plotdata,info +{ + Tmp <- boxplot(dataf, plot=FALSE, ...) + Stats <- Tmp$stats + DataF<- Flattenlist(dataf) # 11.07.21(from) + ymin<- Inf + ymax<- -Inf + for(J in 1:length(DataF)){ + Tmp<- DataF[[J]] + ymin<- min(ymin, min(Tmp)) + ymax<- max(ymax,max(Tmp)) + } # 11.07.21(until) + Hako<- Boxplotdata2(dataf, size[2]/size[1], ...) + if(plot){ + Windisp(Hako) + } + Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) + unit<- paste(Tmp,"cm",sep="") + Setunitlen(unit) + Exstr<- c( + "","", + paste("Beginpicture(","'",unit,"')",sep=""), + paste("Setpt(",as.character(ptsize),")",sep=""), + "","", + paste("Drwboxframe(",var,")",sep=""), + paste("VtickLV(c(",as.character(ymin),",", as.character(ymax),"),0,0)",sep=""), + "","","","", + "Setpt(1)", + "Endpicture(0)" + ) + Exstr<- matrix(Exstr) + Xpos<- c() + for(i in Looprange(1,length(Hako)-1)){ + Temp <- Hako[[i]] + Temp1 <- Temp[[5]] + Xpos <- c(Xpos,Temp1[1,1]) + } + Info<- list(stats=Stats,window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2),xpos=Xpos) + Tmp<- paste(var,"<<- ", + "list(title=title,cap=cap,ylab=ylab,", + "commands=Exstr,plotdata=Hako,info=Info)",sep="") + eval(parse(text=Tmp)) +} + + +########################################### + +Histplotdata <- function(DataV,Ratio,freq=TRUE,densplot=FALSE,...) +# 10.12.07 freq +{ + Temp <- hist(DataV,plot=FALSE,...) + Breaks <- Temp$breaks + Counts <- Temp$counts + Density <- Temp$density + Mids <- Temp$mids + if(!freq){ + Data<- Density + } + else{ + Data<- Counts + } + Ghist <- list() + for(i in Looprange(1,length(Breaks)-1)){ + Tmp1 <- c(Breaks[i],Breaks[i+1]) + Tmp2 <- c(0,Data[i]) + G1 <- Framedata(Tmp1,Tmp2) #bar + Ghist <- c(Ghist,list(G1)) + } + Bin <- Breaks[2]-Breaks[1] + Eps <- 0.7*Bin # 0.7 times Bin + Temp1 <- c(min(Breaks)-Eps,max(Breaks)+Eps) # Put Eps at both sides + Temp2 <- c(0,max(Data)*1.02) + Setwindow(Temp1,Temp2) + Setorigin(c(Temp1[1],0)) + R1<- (YMAX-YMIN)/(XMAX-XMIN) + R<- Ratio/R1 + Setscaling(R) + VEps <- 0.05*(XMAX-XMIN)/5 + Temp1<- Temp1-c(VEps,0) + Temp2<- Temp2-1/R*c(VEps,0) + Setwindow(Temp1,Temp2) + Fpt <- c(Mids[1]-Bin,0) + Lpt <- c(Mids[length(Mids)]+Bin,0) + Fp <- matrix(Fpt,nrow=1) + for(i in Looprange(1,length(Mids))){ + Tmp <- c(Mids[i],Data[i]) + Fp <- rbind(Fp,Tmp) + } + Fp <- rbind(Fp,Lpt) + rownames(Fp)<- c(1:nrow(Fp)) + if(densplot){ + Temp <- density(DataV) + X <- matrix(Temp$x) + Y <- matrix(Temp$y) + Gdens <- cbind(X,Y) + } + else{ + Gdens <- list() + } + list(plotdata=list(histplot=Ghist,fpplot=list(Fp),densityplot=list(Gdens)), + breaks=Breaks,counts=Counts,density=Density,mids=Mids) +} + +Drwhistframe<-function(HistDataL) +{ + title<- HistDataL$title + xlab<- HistDataL$xlab + ylab<- HistDataL$ylab + if(mode(title)!="list") title<- list(title) + if(mode(xlab)!="list") cap<- list(xlab) + if(mode(ylab)!="list") cap<- list(ylab) + if(length(title)==0) title<- list("") + if(length(title)==1) title<- c(title, list("n")) + if(length(title)==2) title<- c(title, list("")) + if(length(xlab)==0) xlab<- list("") + if(length(xlab)==1) xlab<- c(xlab, list("n")) + if(length(xlab)==2) xlab<- c(xlab, list("")) + if(length(xlab)==3) xlab<- c(xlab, list(8)) + if(length(ylab)==0) ylab<- list("") + if(length(ylab)==1) ylab<- c(ylab, list("n")) + if(length(ylab)==2) ylab<- c(ylab, list("")) + if(nchar(title[[1]])>0){ + Fontsize(title[[2]]) + Tmp1<- title[[1]] + Tmp3<- title[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Letter(c((XMIN+XMAX)/2,YMAX),"n2",Tmp1) + Fontsize("n") + } + if(nchar(xlab[[1]])>0){ + Fontsize(xlab[[2]]) + Tmp1<- xlab[[1]] + Tmp3<- xlab[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Tmp4<- paste("s",as.character(xlab[[4]]),sep="") + Letter(c((XMIN+XMAX)/2,YMIN),Tmp4,Tmp1) + Fontsize("n") + } + if(nchar(ylab[[1]])>0){ + Fontsize(ylab[[2]]) + Tmp1<- ylab[[1]] + Tmp3<- ylab[[3]] + if(nchar(Tmp3)>0){ + Tmp1<- paste("{\\",Tmp3," ",Tmp1,"}",sep="") + } + Tmp<- Setorigin() + Letter(c(Tmp[1], YMAX),"n2",Tmp1) + Fontsize("n") + } + + Setax(2," ") + Setax(4," ") + Setax(6," ") +} + +Drwhistplot<- function(datav,var,size,freq=TRUE, + title=list(""), xlab=list(""), ylab=list(""), + plot=TRUE,densplot=FALSE,fpplot=TRUE,...) + #Output : title,xlab,ylab,commands,plotdata,info +{ + H <- Histplotdata(datav, size[2]/size[1], freq=freq,densplot=densplot,...) + Pd<- H$plotdata + Ghist <- list(histplot=Pd$histplot,densityplot=Pd$densityplot) # 10.12.07 + if(fpplot){ + Ghist<- c(Ghist,list(fpplot=Pd$fpplot)) + } + if(plot){ + Windisp(Ghist) + } + Tmp<- Formatting(size[1]/(XMAX-XMIN),5,5) + unit<- paste(Tmp,"cm",sep="") + Setunitlen(unit) + Infostr<- paste(var,"$info",sep="") + Brkstr<- paste(Infostr,"$breaks",sep="") + Midstr<- paste(Infostr,"$mids",sep="") + if(!freq){ + Digits<- ",2,2" + Denstr<- paste(Infostr,"$density",sep="") + } + else{ + Digits<- ",0,0" + Denstr<- paste(Infostr,"$counts",sep="") + } + + if(fpplot) Prefp<- "" else Prefp<- "#" + Exstr<- c( + "","", + paste("Beginpicture(","'",unit,"')",sep=""), + "","", + paste("Drwhistframe(",var,")",sep=""), + paste("HtickLV(",Midstr,",1,1)",sep=""), + paste("VtickLV(max(",Denstr,")",Digits,")",sep=""), + paste("Drwline(",var,"[['plotdata']]","$histplot)",sep=""), + paste(Prefp,"Dashline(",var,"[['plotdata']]","$fpplot)",sep=""), + paste("#Drwline(",var,"[['plotdata']]","$densityplot,2)",sep=""), + "","","","", + "Endpicture(1)" + ) + Exstr<- matrix(Exstr) + Info<- list(breaks=H$breaks,counts=H$counts,density=H$density,mids=H$mids, + window=matrix(c(XMIN,XMAX,YMIN,YMAX),nrow=2)) + Tmp<- paste(var,"<<- ", + "list(title=title,xlab=xlab,ylab=ylab,", + "commands=Exstr,plotdata=Ghist,info=Info)",sep="") + eval(parse(text=Tmp)) +} + +########################## +#17.09.30 + +Bezierpt<- function(t,Ptlist,Ctrlist){ + if(length(Ptlist)==6){ + P0=Ptlist[1:3] + P3=Ptlist[4:6] + P1=Ctrlist[1:3] + if(length(Ctrlist)==3){ + P2=P3 + flg3=0 + }else{ + P2=Ctrlist[4:6] + flg3=1 + } + }else{ + P0=Ptlist[1:2] + P3=Ptlist[3:4] + P1=Ctrlist[1:2] + if(length(Ctrlist)==2){ + P2=P3 + flg3=0 + }else{ + P2=Ctrlist[3:4] + flg3=1 + } + } + P4=(1-t)*P0+t*P1 + P5=(1-t)*P1+t*P2 + P6=(1-t)*P2+t*P3 + P7=(1-t)*P4+t*P5 + P8=(1-t)*P5+t*P6 + P9=(1-t)*P7+t*P8 + if(flg3==0){ + Out=P7 + }else{ + Out=P9 + } + return(Out) +} + +Bezier<- function(...){ + varargin<- list(...) + Nargs=length(varargin) + Ptlist=varargin[[1]] + Ctrlist=varargin[[2]] + Num=10 + for(J in Looprange(3,Nargs)){ + Tmp=varargin[[J]] + K=strsplit(Tmp,'=',fixe=TRUE) + K=K[[1]] + Tmp1=substring(K[1],1,1) + Lhs=toupper(Tmp1) + if(Lhs=="N"){ + Num=eval(parse(text=K[2])) + } + } + if(length(Num)==1){ + Num=rep(Num,length(Ctrlist)) #17.10.08 + } + Out=c() + for(ii in Looprange(1,length(Ctrlist))){ + Tmp1=c(Ptlist[[ii]],Ptlist[[ii+1]]) + Tmp2=Ctrlist[[ii]] + if(ii==1){ + St=0 + }else{ + St=1 + } + for(J in Looprange(St,Num[ii])){ + Tmp=Bezierpt(J/Num[ii],Tmp1,Tmp2) + Out=Appendrow(Out,Tmp) + } + } + return(Out) +} + +####################### +# 17.10.02 + +Connectseg<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Pdata=varargin[[1]] + Eps=10^(-4) + if(Nargs>=2){ + Eps=varargin[[2]] + } + if(is.matrix(Pdata)){ + Din=Dataindex(Pdata) + tmp1=list() + for(J in 1:nrow(Din)){ + tmp=Pdata[Din[J,1]:Din[J,2],] + tmp1=c(tmp1,list(tmp)) + } + Pdata=tmp1 + } + PlotL=list(Op(1,Pdata)) + VI=Looprange(2,length(Pdata)) + while(length(VI)>0){ + Qd=Op(Length(PlotL),PlotL) + Ah=Op(1,Qd); Ao=Op(Length(Qd),Qd) + Flg=0 + for(J in 1:length(VI)){ + Tmp1=Op(VI[J],Pdata) + P=Op(1,Tmp1); Q=Op(Length(Tmp1),Tmp1) + if(Norm(P-Ao)0){ + Qd=Appendrow(Qd,Tmp) + } + PlotL[[length(PlotL)]]=Qd + VI=VI[-J] + Flg=1 + break + } + if(Norm(Q-Ao)Eps){ + if(vL[kk+1]< -Eps){ + tmp=1/(vL[kk]-vL[kk+1])* + (-vL[kk+1]*pL[[kk]]+vL[kk]*pL[[kk+1]]) + qL=Appendrow(qL,tmp) + } + }else{ + if(vL[kk+1]>Eps){ + tmp=1/(-vL[kk]+vL[kk+1])* + (vL[kk+1]*pL[[kk]]-vL[kk]*pL[[kk+1]]) + qL=Appendrow(qL,tmp) + } + } + } + } + xval1=xval2 + eval11=eval21 + eval12=eval22 + if(Length(qL)==2){ + out=c(out,list(qL)) + } + } + } + if(length(out)>0){ + out=Connectseg(out) + } + if(length(out)==1){ + out=out[[1]] + } + return(out) +} + +######################### +# 17.10.06 + +Deqdata=function(deq,rng,initt,initf,Num){ + Eps=10^(-3) + inf=10^3 + tmp=strsplit(deq,"=")[[1]] + tmp1=gsub("`","",tmp[1],fixed=TRUE) + tmp1=substring(tmp1,3,nchar(tmp1)-1) + Xname=strsplit(tmp1,",")[[1]] + func=tmp[2] + for(J in 1:(length(Xname))){ + tmp1=paste("X[",as.character(J),"]",sep="") + func=gsub(Xname[J],tmp1,func,fixed=TRUE) + } + tmp=strsplit(rng,"=")[[1]] + tname=tmp[1] + tmp=eval(parse(text=tmp[2])) + t1=tmp[1] + t2=tmp[2] + tmp=paste("function(",tname,",X){",func,"}",sep="") + funP=eval(parse(text=tmp)) + tmp=paste("function(",tname,",X){-",func,"}",sep="") + funN=eval(parse(text=tmp)) + dt=(t2-t1)/Num + tt=initt + X0=initf + pdL=c(tt,X0) + for(J in Looprange(1,floor((t2-initt)/dt))){ + kl1=dt*funP(tt,X0) + kl2=dt*funP(tt+dt/2,X0+kl1/2) + kl3=dt*funP(tt+dt/2,X0+kl2/2) + kl4=dt*funP(tt+dt,X0+kl3) + X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 + tt=initt+J*dt + tmp=c(tt,X0) + if(Norm(tmp)>inf){break} + pdL=Appendrow(pdL,tmp) + } + tt=initt + X0=initf + for(J in Looprange(1,floor((initt-t1)/dt))){ + kl1=dt*funN(tt,X0) + kl2=dt*funN(tt+dt/2,X0+kl1/2) + kl3=dt*funN(tt+dt/2,X0+kl2/2) + kl4=dt*funN(tt+dt,X0+kl3) + X0=X0+(kl1+2*kl2+2*kl3+kl4)/6 + tt=initt-J*dt + tmp=c(tt,X0) + if(Norm(tmp)>inf){break} + pdL=Appendrow(tmp,pdL) + } + pdL +} + +Deqplot=function(...){ + varargin=list(...) + deq=varargin[[1]] + rng=varargin[[2]] + initt=varargin[[3]] + initf=varargin[[4]] + Num=50 + Sel=c(1,2) + for(J in Looprange(5,length(varargin))){ + tmp1=varargin[[J]] + if(is.character(tmp1)){ + tmp=strsplit(tmp1,"=")[[1]] + Num=eval(parse(text=tmp[2])) + }else{ + SeL=tmp1 + } + } + pdL=Deqdata(deq,rng,initt,initf,Num) + pdL=pdL[,SeL] +} + + +############## obj ############### + +Openobj<- function(Fnm){ + OBJFMT<<- "%7.4f" + NPOINT<<- 0 + NNORM<<- 0 + OBJSCALE<<- 1 + OBJFIGNO<<- 0 + OBJJOIN<<- 0 + Wfile<<- Fnm + Tmp=grep(".obj",Fnm,fixed=TRUE) + if(length(Tmp)==0){ + if(nchar(Fnm)>0){ + Wfile<<- paste(Fnm,".obj",sep="") + } + } + cat("",file=Wfile,sep="") + Wfile +} + +Closeobj<- function(){ + Wfile="" +} + +Writeobjpoint<- function(P){ + X=sprintf(OBJFMT,P[1]*OBJSCALE) + Y=sprintf(OBJFMT,P[2]*OBJSCALE) + Z=sprintf(OBJFMT,P[3]*OBJSCALE) + Str=paste("v",X,Y,Z,sep=" ") + Printobjstr(Str) + NPOINT<<- NPOINT+1 + return(NPOINT) +} + +Printobjstr<- function(Str){ + cat(Str,"\n",sep="",file=Wfile,append=TRUE) +} + +Objname<- function(){ + if(OBJJOIN==0){ + OBJFIGNO<<- OBJFIGNO+1 + Gname=paste("ketfig",as.character(OBJFIGNO),sep="") + Printobjstr(paste("# ",Gname,sep="")) + Printobjstr(paste("g ",Gname,sep="")) + } +} + +Objjoin<- function(...){ + varargin=list() + if(length(varargin)>0){ + OBJJOIN<<- abs(sign(varargin[[1]])) + } + OBJJOIN +} + +Objsurf<- function(...){ #17.12.18 + Args<- list(...) + Nargs<- length(Args) + Sel=Args[[Nargs]]; Nargs=Nargs-1 + Rf=Args[[1]] + N=2 + Mg=0; Ng=0 + if(is.numeric(Args[[N]])){ + if(length(Args[[N]])>2){ + U=Args[[N]] + Mg=length(U)-1 + N=N+1 + }else if(length(Args[[N]])==2){ + Intab=Args[[N]] + Ag=Intab[1]; Bg=Intab[2] + N=N+1 + }else{ + Ag=Args[N]; Bg=Args[N+1] + N=N+2 + } + }else{ + Tmp0=Args[[N]] + Tmp=grep("=",Tmp0,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1=strsplit(Tmp0,"=") + Tmp0=Tmp1[[1]][2] + } + Intab=eval(parse(text=Tmp0)) + Ag=Intab[1]; Bg=Intab[2] + N=N+1 + } + if(is.numeric(Args[[N]])){ + if(length(Args[[N]])>2){ + V=Args[[N]] + Ng=length(V)-1 + N=N+1 + }else if(length(Args[[N]])==2){ + Intab=Args[[N]] + Cg=Intab[1]; Dg=Intab[2] + N=N+1 + }else{ + Cg=Args[[N]]; Dg=Args[[N+1]] + N=N+2 + } + }else{ # the case of is.character(Args[[N]]) + Tmp0=Args[[N]] + Tmp=grep("=",Tmp0,fixed=TRUE) + if(length(Tmp)>0){ + Tmp2=strsplit(Tmp0,"=") + Tmp0=Tmp2[[1]][2] + } + Intab=eval(parse(text=Tmp0)) + Cg=Intab[1]; Dg=Intab[2] + N=N+1 + } + if(Mg==0){ + Mg=Args[[N]] + N=N+1 + U=c() + for(J in Looprange(1,Mg+1)){ + U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) + } + } + if(Ng==0){ + Ng=Args[[N]] + V=c() + for(K in Looprange(1,Ng+1)){ + V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) + } + } + Objname() + PL=list() + for(J in Looprange(1,Mg+1)){ + for(K in Looprange(1,Ng+1)){ + P=Rf(U[J],V[K]) + Np=Writeobjpoint(P) + PL=c(PL,list(c(P,Np))) + } + } + Idx=1+(Ng+1)*(0:Mg) + Pus=PL[Idx] + Idx=(Ng+1)*(1:(Mg+1)) + Pue=PL[Idx] + Idx=1:(Ng+1) + Pvs=PL[Idx] + Idx=((Ng+1)*Mg+1):((Ng+1)*(Mg+1)) + Pve=PL[Idx] + Printobjstr("vt 0 0") + Printobjstr("vt 1 0") + Printobjstr("vt 1 1") + Printobjstr("vt 0 1") + for(J in Looprange(1,Mg)){ + for(K in Looprange(1,Ng)){ + P1=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K]])) + P2=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K]])) + P3=sprintf("%1d",Op(4,PL[[(Ng+1)*J+K+1]])) + P4=sprintf("%1d",Op(4,PL[[(Ng+1)*(J-1)+K+1]])) + N1=""; N2=""; N3=""; N4="" + if(Sel=="+"){ + Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") + Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") + }else{ + Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") + Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") + } + Printobjstr(Str) + } + } + list(U,V,Pus,Pue,Pvs,Pve) +} + +Objthicksurf<- function(...){ + Args=list(...) + Nargs=length(Args) + Sel=Args[[Nargs]]; Nargs=Nargs-1 + Selsurf=substring(Sel,1,1) + Selside=c("0","0","0","0") + Tmp=grep("w",Sel,fixed=TRUE) + if(length(Tmp)>0){ + Selside[1]="w" + } + Tmp=grep("e",Sel,fixed=TRUE) + if(length(Tmp)>0){ + Selside[2]="e" + } + Tmp=grep("s",Sel,fixed=TRUE) + if(length(Tmp)>0){ + Selside[3]="s" + } + Tmp=grep("n",Sel,fixed=TRUE) + if(length(Tmp)>0){ + Selside[4]="n" + } + Nfth=Args[[Nargs-2]] + Thick1=Args[[Nargs-1]] + Thick2=Args[[Nargs]] + Nargs=Nargs-3 + Rfth=Args[[1]] + N=2 + Mg=0; Ng=0 + if(is.numeric(Args[[N]])){ + if(length(Args[[N]])>2){ + U=Args[[N]] + Mg=length(U)-1 + N=N+1 + }else if(length(Args[[N]])==2){ + Intab=Args[[N]] + Ag=Intab[1]; Bg=Intab[2] + N=N+1 + }else{ + Ag=Args[[N]]; Bg=Args[[N+1]] + N=N+2 + } + }else{ + Tmp0=Args[[N]] + Tmp=strsplit(Tmp0,"=",fixe=TRUE) + if(length(Tmp)>0){ + Tmp0=Tmp[[1]][2] + } + Intab=eval(parse(text=Tmp0)) + Ag=Intab[1]; Bg=Intab[2] + N=N+1 + } + if(is.numeric(Args[[N]])){ + if(length(Args[[N]])>2){ + V=Args[[N]] + Ng=length(V)-1 + N=N+1 + }else if(length(Args[[N]])==2){ + Intab=Args[[N]] + Cg=Intab[1]; Dg=Intab[2] + N=N+1 + }else{ + Cg=Args[[N]]; Dg=Args[[N+1]] + N=N+2 + } + }else{ + Tmp0=Args[[N]] + Tmp=strsplit(Tmp0,"=",fixed=TRUE) + if(length(Tmp)>0){ + Tmp0=Tmp[[1]][2] + } + Intab=eval(parse(text=Tmp0)) + Cg=Intab[1]; Dg=Intab[2] + N=N+1 + } + if(Mg==0){ + Mg=Args[[N]] + N=N+1 + U=c() + for(J in Looprange(1,Mg+1)){ + U=c(U,Ag+(J-1)/Mg*(Bg-Ag)) + } + } + if(Ng==0){ + Ng=Args[[N]] + V=c() + for(K in Looprange(1,Ng+1)){ + V=c(V,Cg+(K-1)/Ng*(Dg-Cg)) + } + } + Objname() + Join=OBJJOIN + OBJJOIN<<- 1 + F1=function(u,v){ + Rfth(u,v)+Thick1*Nfth(u,v) + } + F2=function(u,v){ + Rfth(u,v)+Thick2*Nfth(u,v) + } + Dt1=Objsurf(F1,U,V,Selsurf) + if(Selsurf=="+"){ + Tmp="-" + }else{ + Tmp="+" + } + Dt2=Objsurf(F2,U,V,Tmp); + Out=list(Dt1,Dt2); + + if(Selside[1]!="0"){ + Dt=Objrecs(Op(3,Dt1),Op(3,Dt2),Selside[1]) + Out=c(Out,list(Dt)) + } + if(Selside[2]!="0"){ + Dt=Objrecs(Op(4,Dt1),Op(4,Dt2),Selside[2]) + Out=c(Out,list(Dt)) + } + if(Selside[3]!="0"){ + Dt=Objrecs(Op(5,Dt1),Op(5,Dt2),Selside[3]) + Out=c(Out,list(Dt)) + } + if(Selside[4]!="0"){ + Dt=Objrecs(Op(6,Dt1),Op(6,Dt2),Selside[4]) + Out=c(Out,list(Dt)) + } + OBJJOIN<<- Join +} + +Objrecs<- function(...){ + Eps=10^(-6) + Args=list(...) + Nargs=length(Args) + Tmp=Args[[1]] + PtL=Flattenlist(Tmp) + for(J in Looprange(1,length(PtL))){ #17.12.23from + Tmp=PtL[[J]] + if(!is.matrix(Tmp)){ + PtL[[J]]=matrix(Tmp,nrow=1) + } + } #17.12.23until + PL1=list() + for(J in Looprange(1,length(PtL))){ + Tmp=PtL[[J]] + for(K in Looprange(1,nrow(Tmp))){ + PL1=c(PL1,list(Tmp[K,])) + } + } + Sel=Args[[Nargs]]; Nargs=Nargs-1 + Objname() + for(J in Looprange(1,length(PL1))){ + P=PL1[[J]] + if((length(P)<4) || (P[4]==0)){ + Np=Writeobjpoint(P) + PL1[[J]]=c(P[1:3],Np) + } + } + Tmp=Args[[2]] + if((is.numeric(Tmp)) && (length(Tmp)==1)){ + Drv=Tmp + Len=Norm(Drv) + PL2=list() + for(J in Looprange(1,length(PL1))){ + Tmp=PL1[[J]] + P=Tmp[1:3]+Drv + Np=Writeobjpoint(P) + PL2=c(PL2,list(c(P[1:3],Np))) + if(JEps){ + Tmp1=Crossprod(Drv,Vec) + Tmp2=Crossprod(Tmp1,Vec) + Tmp3=Dotprod(Tmp2,Drv) + if(Tmp3<-Eps){ + Tmp2=-Tmp2 + } + Drv=Len/Norm(Tmp2)*Tmp2 + } + } + } + }else{ + PtL=Flattenlist(Tmp) + for(J in Looprange(1,length(PtL))){ #17.12.23from + Tmp=PtL[[J]] + if(!is.matrix(Tmp)){ + PtL[[J]]=matrix(Tmp,nrow=1) + } + } #17.12.23until + PL2=list() + for(J in Looprange(1,length(PtL))){ + Tmp=PtL[[J]] + for(K in Looprange(1,nrow(Tmp))){ + PL2=c(PL2,list(Tmp[K,])) + } + } + for(J in Looprange(1,length(PL2))){ + P=PL2[[J]] + if((length(P)<4) || (P[4]==0)){ + Np=Writeobjpoint(P) + PL2[[J]]=c(P[1:3],Np) + } + } + } + Printobjstr("vt 0 0") + Printobjstr("vt 1 0") + Printobjstr("vt 1 1") + Printobjstr("vt 0 1") + for(J in Looprange(2,length(PL1))){ + P1=sprintf("%1d",Op(4,PL1[[J-1]])) + P2=sprintf("%1d",Op(4,PL2[[J-1]])) + P3=sprintf("%1d",Op(4,PL2[[J]])) + P4=sprintf("%1d",Op(4,PL1[[J]])) + N1=""; N2=""; N3=""; N4="" + if(Sel=="+"){ + Str=paste("f ",P1,"/1/",N1," ",P2,"/2/",N2," ",sep="") + Str=paste(Str,P3,"/3/",N3," ",P4,"/4/",N4,sep="") + }else{ + Str=paste("f ",P1,"/1/",N1," ",P4,"/4/",N4," ",sep="") + Str=paste(Str,P3,"/3/",N3," ",P2,"/2/",N2,sep="") + } + Printobjstr(Str) + } + list(PL1,PL2) +} + +Objpolygon<- function(...){ + Eps=10^(-6) + Args=list(...) + Nargs=length(Args) + Tmp=Args[[1]] + PtL=Flattenlist(Tmp) + for(J in Looprange(1,length(PtL))){ #17.12.23from + Tmp=PtL[[J]] + if(!is.matrix(Tmp)){ + PtL[[J]]=matrix(Tmp,nrow=1) + } + } #17.12.23until + PL=list() + for(J in Looprange(1,length(PtL))){ + Tmp=PtL[[J]] + for(K in Looprange(1,nrow(Tmp))){ + PL=c(PL,list(Tmp[K,])) + } + } + Sel=Args[[Nargs]]; Nargs=Nargs-1 + Objname() + for(J in Looprange(1,length(PL))){ + P=PL[[J]] + if((length(P)<4) || (P(4)==0)){ + Np=Writeobjpoint(P) + PL[[J]]=c(P[1:3],Np) + } + } + if(Nargs==1){ + Tmp=PL[[1]] + Cen=Tmp[1:3] + Nc=Tmp[4] + }else{ + Tmp=Args[[2]] + if(length(Tmp)==1){ + Tmp1=PL[[Tmp]] + Cen=Tmp1[1:3] + Nc=Tmp[4] + }else{ + Cen=Tmp + Nc=Writeobjpoint(Cen) + } + } + for(J in Looprange(1,length(PL))){ + if(J=2){ + Sz=Args[[2]] + } + if(Nargs>=3){ + Np=Args[[3]] + } + Assign("Sz",Sz) + if(Pstr=="xy"){ + Vz=c(0,0,1) + Fs=Assign("c(Sz*cos(t),Sz*sin(t),0)") + } + if(Pstr=="yz"){ + Vz=c(1,0,0) + Fs=Assign("c(0,Sz*cos(t),Sz*sin(t))") + } + if(Pstr=="zx"){ + Vz=c(0,1,0) + Fs=Assign("c(Sz*sin(t),0,Sz*cos(t))") + } + Gc0=Spacecurve(Fs,"t=c(0,2*pi)",paste("Num=",as.character(Np),sep="")) + P=PL[[1]]; Q=PL[[2]]; R=PL[[length(PL)-1]] + PQ1=Q-P + if(!Closed){ + PQ2=PQ1 + }else{ + PQ2=P-R + } + Vp=PQ1/Norm(PQ1)+PQ2/Norm(PQ2) + Vp1=Vp/Norm(Vp) + Theta=acos(min(Dotprod(Vz,Vp1),1)); + Vj=Crossprod(Vz,Vp1) + if(Norm(Vj)Eps0){ + dt=Crossprod(tmp3,tmp2) + ds=Crossprod(tmp1,tmp3) + t=dt/d + s=ds/d + pt=p1+v1*t + out=list(pt,t,s) + }else{ + tmp1=Crossprod(p2-p1,v1)/Norm(v1) + out=list(abs(tmp1)) + } + return(out) +} + +Intersectseg<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Eps0=10^(-4) + Eps1=0.01 + seg1=varargin[[1]] + seg2=varargin[[2]] + if(Nargs>2){Eps1=varargin[[3]]} + p1=Op(1,seg1); q1=Op(2,seg1) + p2=Op(1,seg2); q2=Op(2,seg2) + if((Norm(q1-p1)1){ + pt=Op(1,tmp); t=Op(2,tmp); s=Op(3,tmp) + if((t*(t-1)1){ + if(Op(3,tmp)*(Op(3,tmp)-1)1){ + if(Op(3,tmp)*(Op(3,tmp)-1)1){ + if(Op(3,tmp)*(Op(3,tmp)-1)1){ + if(Op(3,tmp)*(Op(3,tmp)-1)1)&&(tmp[[3]]*(tmp[[3]]-1)1)&&(tmp[[3]]*(tmp[[3]]-1)1)&&(tmp[[3]]*(tmp[[3]]-1)1)&&(tmp[[3]]*(tmp[[3]]-1)Eps1){ + out=list(dist) + }else{ + tmp=c(); + for(j in 1:length(pts)){ + tmp=Appendrow(tmp,Op(1,pts[[j]])) + } + tmp1=sum(tmp[,1])/(length(pts)) + tmp2=sum(tmp[,2])/(length(pts)) + tmp3=c(tmp1,tmp2) + tmp=Nearestpt(tmp3,seg1) + tmp1=tmp[[2]] + tmp=Nearestpt(tmp3,seg2) + tmp2=tmp[[2]] + out=list(dist,tmp3,tmp1,tmp2) + } + } + } + } + return(out) +} + +Osplineseg<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Eps=10^(-2) + Eps0=10^(-6) + Ptlist=varargin[[1]] + Numstr="Num=20" + if(Nargs>1){ + Numstr=varargin[[2]] + } + p0=Op(1,Ptlist); p1=Op(2,Ptlist); p2=Op(3,Ptlist); p3=Op(4,Ptlist) + tmp=Norm(p2-p0)*Norm(p3-p1) + tmp=1+sqrt((1+Dotprod(p2-p0,p3-p1)/tmp)/2) + cc=4*Norm(p2-p1)/3/(Norm(p2-p0)+Norm(p3-p1))/tmp + pQ=p1+cc*(p2-p0) + pR=p2+cc*(p1-p3) + ctrL=list(c(pQ,pR)) + out=Bezier(list(p1,p2),ctrL,Numstr) + return(out) +} + +Intersectpartseg<- function(...){ + varargin=list(...) + Nargs=length(varargin) + crv1=varargin[[1]] + crv2=varargin[[2]] + ii=varargin[[3]] + jj=varargin[[4]] + Eps1=varargin[[5]] + Eps2=varargin[[6]] + Dist=10*Eps2 + if(Nargs>6){Dist=varargin[[7]]} + Eps00=10^(-8) + Eps0=10^(-4) + out=list() + seg1=Listplot(Op(ii,crv1),Op(ii+1,crv1)) + seg2=Listplot(Op(jj,crv2),Op(jj+1,crv2)) + tmp1=Op(2,seg1)-Op(1,seg1) + tmp2=Op(2,seg2)-Op(1,seg2) + snang=abs(Crossprod(tmp1,tmp2))/(Norm(tmp1)*Norm(tmp2)) + tmp=Intersectseg(seg1,seg2,Eps1) + dst=Op(1,tmp) + if(dstDist-Eps0)){ + os1=seg1 + }else{ + p1=Op(1,seg1); p2=Op(2,seg1) + if(ii==1){ + p3=Op(3,crv1) + tmp=p2-p1 + tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) + p0=Reflectdata(p3,c((p1+p2)/2,tmp)) + }else{ + if(ii==Length(crv1)-1){ + p0=Op(ii-1,crv1) + tmp=p2-p1 + tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) + p3=Reflectdata(p0,c((p1+p2)/2,tmp)) + }else{ + p0=Op(ii-1,crv1); p3=Op(ii+2,crv1) + } + } + os1=Osplineseg(list(p0,p1,p2,p3)) + } + if((Length(crv2)==2)||(Norm(Op(2,seg2)-Op(1,seg2))>Dist-Eps0)){ + os2=seg2 + }else{ + p1=Op(1,seg2); p2=Op(2,seg2) + if(jj==1){ + p3=Op(3,crv2) + tmp=p2-p1 + tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) + p0=Reflectdata(p3,c((p1+p2)/2,tmp)) + }else{ + if(jj==Length(crv2)-1){ + p0=Op(jj-1,crv2) + tmp=p2-p1 + tmp=(p1+p2)/2+c(Op(2,tmp),-Op(1,tmp)) + p3=Reflectdata(p0,c((p1+p2)/2,tmp)) + }else{ + p0=Op(jj-1,crv2); p3=Op(jj+2,crv2) + } + } + os2=Osplineseg(list(p0,p1,p2,p3)) + } + tmp2=list() + for(kk in Looprange(1,Length(os1)-1)){ + for(ll in Looprange(1,Length(os2)-1)){ + seg1=Listplot(Op(kk,os1),Op(kk+1,os1)) + seg2=Listplot(Op(ll,os2),Op(ll+1,os2)) + tmp=Intersectseg(seg1,seg2,Eps1) + if((Op(1,tmp)1)){ #18.02.05 + if(Op(1,tmp)0){ + tmp1=c() + for(nn in Looprange(1,length(tmp2))){ + tmp1=Appendrow(tmp1,Op(2,tmp2[[nn]])) + } + tmp=sum(tmp1[,1])/length(tmp2) + tmp=c(tmp,sum(tmp1[,2])/length(tmp2)) + out=list(tmp) + p1=Op(ii,crv1); p2=Op(ii+1,crv1) + tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) + tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) + tmp=min(max(Op(3,tmp),0),1) + out=c(out,list(ii+tmp)) + p1=Op(jj,crv2); p2=Op(jj+1,crv2) + tmp=c(Op(2,p2-p1),-Op(1,p2-p1)) + tmp=Intersectline(Op(1,out),tmp,p1,p2-p1) + tmp=min(max(Op(3,tmp),0),1) + out=c(out,list(jj+tmp,dst,snang)) + } + } + } + return(out) +} + +if(1==0){ #start of skip + +Collectnear<- function(ptdL,Eps2){ + gL=list(Op(1,ptdL)) + rL=ptdL[Looprange(2,length(ptdL))] #18.02.07 + for( ii in Looprange(1,length(ptdL)-1)){ + numL=c() + for(jj in Looprange(1,length(rL))){ + tmp1=100 + for(kk in Looprange(1,length(gL))){ + tmp=Norm(Op(1,gL[[kk]])-Op(1,rL[[jj]])) + if(tmps1)&&(tmp1s2)&&(tmp22){Eps1=varargin[[3]]} + if(Nargs>3){Eps2=varargin[[4]]} + if(Nargs>4){Dist=varargin[[5]]} + tmp1=varargin[[1]] + crv1=matrix(Op(1,tmp1),nrow=1) + for(ii in Looprange(2,Length(tmp1))){ + tmp=Op(Length(crv1),crv1) + if(Norm(tmp-Op(ii,tmp1))>Eps0){ + crv1=Appendrow(crv1,Op(ii,tmp1)) + } + } + tmp2=varargin[[2]] + crv2=matrix(Op(1,tmp2),nrow=1) + for(ii in Looprange(2,Length(tmp2))){ + tmp=Op(Length(crv2),crv2) + if(Norm(tmp-Op(ii,tmp2))>Eps0){ + crv2=Appendrow(crv2,Op(ii,tmp2)) + } + } + if(Length(crv1)!=Length(crv2)){ + self=0 + }else{ + self=1 + for(ii in Looprange(1,Length(crv1))){ + if(Norm(Op(ii,crv1)-Op(ii,crv2))>0){ + self=0 + break + } + } + } + out=list() + for(ii in Looprange(1,Length(crv1)-1)){ + if(self==0){ + loopL=Looprange(1,Length(crv2)-1) + }else{ + loopL=Looprange(ii+2,Length(crv2)-1) + } + for(jj in loopL){ + tmp=Intersectpartseg(crv1,crv2,ii,jj,Eps1,Eps2,Dist) + if(length(tmp)>1){ #18.02.05 + if(length(out)==0){ + out=list(tmp) + }else{ + tmp1=Op(length(out),out) + if(Norm(Op(1,tmp1)-Op(1,tmp))>Eps1){ + out=c(out,list(tmp)) + } + } + if(self==1){ + tmp=list(Op(1,tmp),Op(3,tmp),Op(2,tmp),Op(4,tmp),Op(5,tmp)) + out=c(out,list(tmp)) + } + } + } + } + tmp2=out + out=list() + tmp1=tmp2 + for(ii in Looprange(1,length(tmp2))){ + tmp=Collectsameseg(tmp1) + out=c(out,list(Op(1,tmp))) + if(length(Op(2,tmp))==0){ + break + }else{ + tmp1=Op(2,tmp) + } + } + for(ii in Looprange(1,length(out))){ + tmp1=Op(ii,out) + if(length(tmp1)==1){ + out[[ii]]=Op(1,tmp1) + }else{ + tmp=c() + for(jj in Looprange(1,length(tmp1))){ + tmp=c(tmp,Op(4,tmp1[[jj]])) + } + dst=min(tmp) + tmp=c() + for(jj in Looprange(1,length(tmp1))){ + if(Op(4,tmp1[[jj]])1){ +# Start=tmp + }else{ + if(flg==0){Eps1=tmp} + if(flg==1){Eps2=tmp} + flg=flg+1 + } + } + flg=0 + AnsL=c() + if(length(plist)==1){ + Fdata=plist[[1]] + tmp1=Op(1,Fdata) + tmp2=Op(Length(Fdata),Fdata) + if(Norm(tmp1-tmp2)1){ + KL=Quicksort(KL,2) + if(length(Start)==0){ + tmp=Op(1,KL) + tst=Op(2,tmp) + Start=Pointoncurve(tst,Fdata) + }else{ + tmp=c() + for(ii in Looprange(1,length(KL))){ + tmp=c(tmp,Norm(Op(1,KL[[ii]]-Start))) + } + tmp=min(tmp) + tmp1=list() + for(ii in Looprange(1,length(KL))){ + tmp2=Op(1,KL[[ii]]) + if(Norm(tmp2-Start)==tmp){ + tmp1=c(tmp1,list(tmp2)) + } + } + tmp=Op(1,tmp1) + tst=Op(2,tmp) + Start=Pointoncurve(tst,Fdata) + } + } + } + } + if(flg==0){ + t1=tst + for(nn in Looprange(1,length(plist))){ + Fdata=Op(nn,plist) + if(nn==length(plist)){ + nxtno=1 + }else{ + nxtno=nn+1 + } + Gdata=Op(nxtno,plist) + KL=IntersectcurvesPp(Fdata,Gdata) + if(length(KL)==0){ + tmp=matrix(Op(Length(Fdata),Fdata),nrow=1) #18.02.02from + Gdata=Appendrow(tmp,Gdata) + plist[[nxtno]]=Gdata + t2=Length(Fdata) + ss=1 #18.02.02until + }else{ + tmp=Op(1,KL) + t2=Op(2,tmp) + ss=Op(3,tmp) + if(abs(t2-t1)1){ + tmp=Op(2,KL) + t2=Op(2,tmp) + ss=Op(3,tmp) + }else{ +# println(text(nn)+" and "+text(nn+1)+" not intersect"); +# flg=1 + } + } + } + if(flg==0){ + tmp=Partcrv(t1,t2,Fdata) + if(nn==1){ + AnsL=tmp + }else{ + tmp=tmp[2:Length(tmp),] + AnsL=Appendrow(AnsL,tmp) + } + t1=ss + } + } + } + return(AnsL) +} + +############## end of Enclosing2 ############# + +############## start of surface drawing ############# + +Fullformfunc<- function(FdL){ + ADDPOINT<<- list() #18.02.19 + Out=list(Op(1,FdL)) + N=length(FdL) + for(Jrg in Looprange(1,N)){ + Tmp=grep("c(",Op(Jrg,FdL),fixed=TRUE) + if(length(Tmp)>0){ + break + } + } + Urg=Stripblanks(Op(Jrg,FdL)) + Tmp=strsplit(Urg,"=",fixed=TRUE) + UNAME<<- Tmp[[1]][1] + URNG<<- eval(parse(text=Tmp[[1]][2])) + Urg=paste(UNAME,"=c(",sprintf("%6.7f",URNG[1]),",", + sprintf("%6.7f",URNG[2]),")",sep="") + Vrg=Stripblanks(Op(Jrg+1,FdL)) + Tmp=strsplit(Vrg,"=",fixed=TRUE) + VNAME<<- Tmp[[1]][1] + VRNG<<- eval(parse(text=Tmp[[1]][2])) + Vrg=paste(VNAME,"=c(",sprintf("%6.7f",VRNG[1]),",", + sprintf("%6.7f",VRNG[2]),")",sep="") + if(Jrg==2){ + Xf=UNAME + Yf=VNAME + Tmp=Stripblanks(Op(1,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Zf=Tmp[[1]][2] + Tmp=list(UNAME,VNAME,Zf,Urg,Vrg) + Out=c(Out,Tmp) + }else if(Jrg==4){ + Tmp=Stripblanks(Op(1,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Zf=Tmp[[1]][2] + Tmp=Stripblanks(Op(2,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Xname=Tmp[[1]][1] + Xf=Tmp[[1]][2] + Tmp=Stripblanks(Op(3,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Yname=Tmp[[1]][1] + Yf=Tmp[[1]][2] + Tmp=gsub(Xname,paste("(",Xf,")",sep=""),Zf,fixed=TRUE) + Zf=gsub(Yname,paste("(",Yf,")",sep=""),Tmp,fixed=TRUE) + Tmp=list(Xf,Yf,Zf,Urg,Vrg) + Out=c(Out,Tmp) + }else{ + Tmp=Stripblanks(Op(2,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Xf=Tmp[[1]][2] + Tmp=Stripblanks(Op(3,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Yf=Tmp[[1]][2] + Tmp=Stripblanks(Op(4,FdL)) + Tmp=strsplit(Tmp,"=",fixed=TRUE) + Zf=Tmp[[1]][2] + Tmp=list(Xf,Yf,Zf,Urg,Vrg) + Out=c(Out,Tmp) + } + tmp=paste("Xfunc<<- function(",UNAME,",",VNAME,"){",Xf,"}",sep='') + eval(parse(text=tmp)) + tmp=paste("Yfunc<<- function(",UNAME,",",VNAME,"){",Yf,"}",sep='') + eval(parse(text=tmp)) + tmp=paste("Zfunc<<- function(",UNAME,",",VNAME,"){",Zf,"}",sep='') + eval(parse(text=tmp)) + tmp=paste("XYZfunc<<- function(",UNAME,",",VNAME,"){",sep='') + tmp=paste(tmp,"c(",Xf,",",Yf,",",Zf,")}",sep='') + eval(parse(text=tmp)) + XYZstr<<- c(Xf,Yf,Zf) + DRWS<<- "enws" + BdyL=list() + for(I in Looprange(Jrg+2,length(FdL))){ + Tmp=Op(I,FdL) + if(is.character(Tmp)){ + if(nchar(Tmp)==0){ + Tmp=" " + } + DRWS<<- list(Tmp) + } + if((is.numeric(Tmp))&&(Length(Tmp)>1)){ + BdyL=list(Tmp) + } + } + BDYL<<- BdyL + Tmp=c(DRWS,BDYL) + Out=c(Out,Tmp) + return(Out) +} + +Addpoints<- function(ptlist){ + ADDPOINT<<- ptlist +} + +Makexybdy<- function(Np){ + Eps0=10^(-4) + Xystr=XYZstr[1:2] + Umin=URNG[1]; Umax=URNG[2] + Vmin=VRNG[1]; Vmax=VRNG[2] + Cflg=0 + EhL=list() + Tmp=grep("e",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:2){ + Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),Xystr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",VRNG) + Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[2])) + Tmp=Paramplot(Tmp1,Tmp2,Tmp3) + if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))0){ + Tmp1="c(" + for(jj in 1:2){ + Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),Xystr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",URNG) + Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[1])) + Tmp=Paramplot(Tmp1,Tmp2,Tmp3) + if(Cflg>0){ + Tmp1=Op(length(EhL),EhL) + Tmp=Joincrvs(Tmp1,Tmp) + if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))0){ + Tmp1="c(" + for(jj in 1:2){ + Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),Xystr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",VRNG) + Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[2])) + Tmp=Paramplot(Tmp1,Tmp2,Tmp3) + if(Cflg>0){ + Tmp1=Op(length(EhL),EhL) + Tmp=Joincrvs(Tmp1,Tmp) + if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))0){ + Tmp1="c(" + for(jj in 1:2){ + Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),Xystr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",URNG) + Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[1])) + Tmp=Paramplot(Tmp1,Tmp2,Tmp3) + if(Cflg>0){ + Tmp1=Op(length(EhL),EhL) + Tmp=Joincrvs(Tmp1,Tmp) + if(Norm(Op(1,Tmp)-Op(Length(Tmp),Tmp))2){ + Eps1=varargin[[3]] + } + Eps2=0.1 + if(Nargs>3){ + Eps2=varargin[[4]] + } + if(Nargs>4){ + Ns=varargin[[5]] + if(Ns>0){#18.02.21from + Other=Op(Ns,OTHERPARTITION) + }else{ + Other=c() + }#18.02.21until + }else{ + Ns=1 + Other=c() + } + Npt=Length(Fig) + ParL=c(1,Npt,Other) + for(N in Looprange(max(1,Ns),Length(GL))){ #18.02.21 + G=Op(N,GL) + KouL=IntersectcurvesPp(Fig,G,Eps1,Eps2) + Tmp1=c(); Tmp2=c() + for(jj in Looprange(1,length(KouL))){ + tmp=Op(2,KouL[[jj]]) + if((tmp>1+Eps0)&&(tmp1+Eps0)&&(tmp0)&&(N>Ns)&&(length(Tmp2)>0)){ #18.02.21 + tmp=OTHERPARTITION[[N]] + OTHERPARTITION[[N]]<<- c(tmp,Tmp2) + } + } + tmp1=sort(ParL) + ParL=c() + tmp2=-1 + for(jj in Looprange(1,length(tmp1))){ + tmp=Op(jj,tmp1) + if(abs(tmp-tmp2)>Eps1){ + ParL=c(ParL,tmp) + tmp2=tmp + } + } + return(ParL) +} + +Evlptablepara<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Tmp=varargin[[1]] + Mdv=50 + Ndv=50 + if(Nargs>=2){ + Tmp=varargin[[2]] + if(is.list(Tmp)){Tmp=Op(1,Tmp)} + if(length(Tmp)>1){ + Mdv=Tmp[1] + Ndv=Tmp[2] + }else{ + Mdv=Tmp + if(Nargs==2){ + Ndv=Mdv + }else{ + Tmp1=varargin[[3]] + if((is.numeric(Tmp1)) && (length(Tmp1)==1)){ + Ndv=Tmp1 + }else{ + Ndv=Mdv + } + } + } + } + U1=URNG[1]; U2=URNG[2] + V1=VRNG[1]; V2=VRNG[2] + Du=(U2-U1)/(Mdv) + Dv=(V2-V1)/(Ndv) + sph=sprintf("%7.7f",sin(PHI)) + cph=sprintf("%7.7f",cos(PHI)) + sth=sprintf("%7.7f",sin(THETA)) + cth=sprintf("%7.7f",cos(THETA)) + xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="") + tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="") + ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="") + dxu=Diff(xstr,UNAME) + dxv=Diff(xstr,VNAME) + dyu=Diff(ystr,UNAME) + dyv=Diff(ystr,VNAME) + I=1 + Zval=c() + for(jj in 1:(Ndv+1)){ + v=V1+(jj-1)*Dv + ZuL=c() + for(ii in 1:(Mdv+1)){ + u=U1+(ii-1)*Du + tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="") + tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="") + Dxu=Funvalue(dxu,tmp1,tmp2) + Dxv=Funvalue(dxv,tmp1,tmp2) + Dyu=Funvalue(dyu,tmp1,tmp2) + Dyv=Funvalue(dyv,tmp1,tmp2) + Tmp=Dxu*Dyv-Dxv*Dyu + ZuL=c(ZuL,Tmp) + } + Zval=Appendrow(Zval,ZuL) + } + Yval=c() + for(jj in 1:(Ndv+1)){ + v=V1+(jj-1)*Dv + Yval=c(Yval,v) + } + Xval=c() + for(ii in 1:(Mdv+1)){ + u=U1+(ii-1)*Du + Xval=c(Xval,u) + } + return(list(Zval,Xval,Yval)) +} + +Evlpfun<- function(u,v){ + tmp1=paste(UNAME,"=(",sprintf("%7.7f",u),")",sep="") + tmp2=paste(VNAME,"=(",sprintf("%7.7f",v),")",sep="") + Dxu=Funvalue(dxu,tmp1,tmp2) + Dxv=Funvalue(dxv,tmp1,tmp2) + Dyu=Funvalue(dyu,tmp1,tmp2) + Dyv=Funvalue(dyv,tmp1,tmp2) + Tmp=Dxu*Dyv-Dxv*Dyu + return(Tmp) +} + +Envelopedata<- function(...){ + varargin=list(...) + Eps0=10^(-4) + Nargs=length(varargin) + Fd=varargin[[1]] + Fullformfunc(Fd) + Mdv=50 + Ndv=50 + if(Nargs>=2){ + Tmp=varargin[[2]] + if(is.list(Tmp)){Tmp=Op(1,Tmp)} + if(length(Tmp)>1){ + Mdv=Tmp[1] + Ndv=Tmp[2] + }else{ + Mdv=Tmp + if(Nargs==2){ + Ndv=Mdv + }else{ + Tmp1=varargin[[3]] + if((is.numeric(Tmp1)) && (length(Tmp1)==1)){ + Ndv=Tmp1 + }else{ + Ndv=Mdv + } + } + } + } + sph=sprintf("%7.7f",sin(PHI)) + cph=sprintf("%7.7f",cos(PHI)) + sth=sprintf("%7.7f",sin(THETA)) + cth=sprintf("%7.7f",cos(THETA)) + xstr=paste("-(",XYZstr[1],")*(",sph,")+(",XYZstr[2],")*(",cph,")",sep="") + tmp=paste("-(",XYZstr[1],")*(",cph,")*(",cth,")-(",XYZstr[2],")*(",sph,")*(",cth,")",sep="") + ystr=paste(tmp,"+(",XYZstr[3],")*(",sth,")",sep="") + dxu<<- Diff(xstr,UNAME) + dxv<<- Diff(xstr,VNAME) + dyu<<- Diff(ystr,UNAME) + dyv<<- Diff(ystr,VNAME) + U1=URNG[1]; U2=URNG[2] + V1=VRNG[1]; V2=VRNG[2] + Du=(U2-U1)/Mdv + Dv=(V2-V1)/Ndv + Out=c() + for(J in 1:(Ndv)){ + Vval1=VRNG[1]+(J-1)*Dv + Vval2=VRNG[1]+J*Dv + Uval1=URNG[1] + Eval11=Evlpfun(Uval1,Vval1) + Eval12=Evlpfun(Uval1,Vval2) + for(I in 1:(Mdv)){ +# Uval1=URNG[1]+(I-1)*Du + Uval2=URNG[1]+I*Du +# Eval11=Evlpfun(Uval1,Vval1) +# Eval12=Evlpfun(Uval1,Vval2) + Eval21=Evlpfun(Uval2,Vval1) + Eval22=Evlpfun(Uval2,Vval2) + a1=Uval1;b1=Vval1;c1=Eval11 + a2=Uval2;b2=Vval1;c2=Eval21 + a3=Uval2;b3=Vval2;c3=Eval22 + a4=Uval1;b4=Vval2;c4=Eval12 + PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) + VL=c(c1,c2,c3,c4,c1) + QL=c() + for(K in 1:4){ + if(abs(VL[K])<=Eps0){ + QL=Appendrow(QL,PL[K,]) + }else if(VL[K]>Eps0){ + if(VL[K+1]< -Eps0){ + Tmp=1/(VL[K]-VL[K+1])*(-VL[K+1]*PL[K,]+VL[K]*PL[K+1,]) + QL=Appendrow(QL,Tmp) + } + }else{ + if(VL[K+1]>Eps0){ + Tmp=1/(-VL[K]+VL[K+1])*(VL[K+1]*PL[K,]-VL[K]*PL[K+1,]) + QL=Appendrow(QL,Tmp) + } + } + } + Uval1=Uval2 + Eval11=Eval21 + Eval12=Eval22 + if(Length(QL)==2){ + Out=Appendrow(Out,c(Inf,Inf)) + Out=Appendrow(Out,QL) + } + } + } + Out=Out[2:nrow(Out),] + if(Length(Out)>0){ + Out=Connectseg(Out) + }else{ + Out=c() + } + return(Out) +} + +Dropnumlistcrv<- function(QdL,Eps1){ + Eps0=10^(-4) + if(!is.list(QdL)){ + PdL=list(QdL) + }else{ + PdL=QdL + } + OutL=list() + for(I in Looprange(1,length(PdL))){ + Pd=Op(I,PdL) + PtL=c(1) + P=Op(1,Pd) + for(K in Looprange(2,Length(Pd)-1)){ + if(Norm(P-Op(K,Pd))>Eps1){ + PtL=c(PtL,K) + P=Op(K,Pd) + } + } + K=Length(Pd) + if(Norm(P-Op(K,Pd))>Eps1){ #18.02.12 eps + PtL=c(PtL,K) + } +# if(length(PtL)==1){ #180306 +# } + OutL=c(OutL,list(PtL)) + } + return(OutL) +} + +Cuspsplitpara<- function(...){ + varargin=list(...) + Nargs=length(varargin); + Gdxy=varargin[[1]] + if(!is.list(Gdxy)){ + Gdxy=list(Gdxy) + } + Eps0=10^(-4) + Eps1=0.01 + if(Nargs>2){Eps1=varargin[[2]]} + N=2 + CUSPSPLITPT<<- list() + OutkL=list() + for(Ng in Looprange(1,length(Gdxy))){ + PtxyL=Op(Ng,Gdxy) + PtkL=c() + PthL=c() + for(I in Looprange(1,Length(PtxyL))){ + Tmp=Op(I,PtxyL) + Tmp1=paste(UNAME,'=',sprintf("%7.7f",Tmp[1]),sep="") + eval(parse(text=Tmp1)) + Tmp1=paste(VNAME,'=',sprintf("%7.7f",Tmp[2]),sep="") + eval(parse(text=Tmp1)) + Tmp2=c(eval(parse(text=XYZstr[1]))) + Tmp2=c(Tmp2,eval(parse(text=XYZstr[2]))) + Tmp2=c(Tmp2,eval(parse(text=XYZstr[3]))) + Tmp3=Parapt(Tmp2) + if(I==1){ + PtkL=matrix(Tmp2,nrow=1) + PthL=matrix(Tmp3,nrow=1) + }else{ + Tmp4=Op(Length(PthL),PthL) + if(Norm(Tmp3-Tmp4)>Eps0){ + PtkL=Appendrow(PtkL,Tmp2) + PthL=Appendrow(PthL,Tmp3) + } + } + } + if(Length(PthL)==0){ + return(list()) + } + Ps=Op(1,PthL); Pe=Op(Length(PthL),PthL) + Cflg=0 + if(Norm(Ps-Pe)90){ + Cuspflg=1 + break + } + Q=Op(J,PthL) + if(Norm(P-Q)>Eps1){ + break + } + V1=Q-Op(J-1,PthL) + V2=Op(J+1,PthL)-Q + Tmp3=Dotprod(V1,V2)/(norm(V1)*norm(V2)) + Tmp=acos(Tmp3)*180/pi + if(Crossprod(V1,V2)<0){ + Tmp=-Tmp + } + Kaku=Kaku+Tmp + } + if(Cuspflg==1){ + Tmp=trunc((I+J)*0.5) + I=J + if(length(CuspL)==0){ + CuspL=c(Tmp) + }else{ + CuspL=c(CuspL,Tmp) + } + } + } + } + if(Cflg==0){ + CuspL=c(1,CuspL,Length(PthL)) + }else if(length(CuspL)==0){ + CuspL=c(1,Length(PthL)) + }else if(Op(1,CuspL)==1){ + CuspL=c(CuspL,Length(PthL)) + }else{ + Tmp=Op(1,CuspL) + Tmp1=PthL[Tmp:Length(PthL),] + Tmp2=PthL[2:Tmp,] + PthL=Appendrow(Tmp1,Tmp2) + Tmp1=PtkL[Tmp:Length(PthL),] + Tmp2=PtkL[2:Tmp,] + PtkL=Appendrow(Tmp1,Tmp2) + CuspL=CuspL-Tmp+1 + CuspL=c(CuspL,Length(PthL)) + } + if(length(CuspL)==2){ + Tmp4=PthL[Length(PthL),] + if(Length(PtkL)>=2){ + CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4)) + OutkL=c(OutkL,list(PtkL)) + } + next + } + Outk=list() + Is=1 + for(I in Looprange(1,length(CuspL)-1)){ + Tmp1=CuspL[Is]; Tmp2=CuspL[I+1] + Tmp3=Op(Tmp1,PthL); Tmp4=Op(Tmp2,PthL) + if(Norm(Tmp3-Tmp4)>Eps1){ + Tmpk=PtkL[Tmp1:Tmp2,] + Outk=c(Outk,list(Tmpk)) + CUSPSPLITPT<<- c(CUSPSPLITPT,list(Tmp4)) + Is=I+1 + } + } + OutkL=c(OutkL,Outk) + } + Tmp1=Dropnumlistcrv(Projpara(OutkL),Eps1*0.5) + Tmp=list() + for(I in Looprange(1,length(OutkL))){ + Tmp2=Op(I,OutkL) + Tmp3=Op(I,Tmp1) + Tmp4=c() + for(J in Looprange(1,Length(Tmp3))){ + Tmp5=Op(Tmp3[J],Tmp2) + Tmp4=Appendrow(Tmp4,Tmp5) + } + if(Length(Tmp4)>0){ + Tmp=c(Tmp,list(Tmp4)) + } + } + return(Tmp) +} + +PthiddenQ<- function(PtA,Vec,Uveq,Np,Eps1,Eps2){ + Eps0=10^(-4) + Out=c() + Vec=1/Norm(Vec)*Vec + if(length(Np)==1){ + Np=c(Np,Np) + } + Tmp=paste("Eqfun<- function(U,V){",sep='') + if((abs(Vec[2])>Eps0) || (abs(Vec[1])>Eps0)){ + Vstr=sprintf("%6.6f",Vec) + Pstr=sprintf("%6.6f",PtA) + Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='') + Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='') + }else{ + Tmp=paste(Tmp,"Xfunc(U,V)}",sep='') + } + eval(parse(text=Tmp)) + Dx=(URNG[2]-URNG[1])/Np[1] + Dy=(VRNG[2]-VRNG[1])/Np[2] + for(J in Looprange(1,Np[2])){ #180227 + Vval1=VRNG[1]+(J-1)*Dy + Vval2=VRNG[1]+J*Dy + Uval1=URNG[1] #180306(3lines) + Eval11=Eqfun(Uval1,Vval1) + Eval12=Eqfun(Uval1,Vval2) + Uval1=URNG[1] #180305(3lines) + for(I in Looprange(1,Np[1])){ #180227 +# Uval1=URNG[1]+(I-1)*Dx + Uval2=URNG[1]+I*Dx +# Eval11=Eqfun(Uval1,Vval1) +# Eval12=Eqfun(Uval1,Vval2) + Eval21=Eqfun(Uval2,Vval1) + Eval22=Eqfun(Uval2,Vval2) + a1=Uval1;b1=Vval1;c1=Eval11 + a2=Uval2;b2=Vval1;c2=Eval21 + a3=Uval2;b3=Vval2;c3=Eval22 + a4=Uval1;b4=Vval2;c4=Eval12 + PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) + VL=c(c1,c2,c3,c4,c1) + QL=c() + for(K in 1:4){ + P1=Op(K,PL); P2=Op(K+1,PL) + M1=Op(K,VL); M2=Op(K+1,VL) + if(abs(M1) 0) && (M2> 0)){ + next + } + if((M1< 0) && (M2< 0)){ + next + } + Tmp=1/(M1-M2)*(-M2*P1+M1*P2) + QL=Appendrow(QL,Tmp) + } + Uval1=Uval2 #180306(3lines) + Eval11=Eval21 + Eval12=Eval22 + if(Length(QL)==2){ + Puv1=Op(1,QL); Puv2=Op(2,QL) + Tmp1=Op(1,Puv1) + Tmp2=Op(2,Puv1) + Xv=Xfunc(Tmp1,Tmp2) + Yv=Yfunc(Tmp1,Tmp2) + Zv=Zfunc(Tmp1,Tmp2) + P1=c(Xv,Yv,Zv) + Tmp1=Op(1,Puv2) + Tmp2=Op(2,Puv2) + Xv=Xfunc(Tmp1,Tmp2) + Yv=Yfunc(Tmp1,Tmp2) + Zv=Zfunc(Tmp1,Tmp2) + P2=c(Xv,Yv,Zv) + V1=Vec[1]; V2=Vec[2]; V3=Vec[3] + if(abs(V1)>Eps0){ + M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3] + M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3] + }else if(abs(V2)>Eps0){ + M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3] + M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3] + }else{ + M1=PtA[2]-P1[2] + M2=PtA[2]-P2[2] + } + if(M1*M2>= 0){ + if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ + next + } + if(M1==0){ + Pt=P1; Ptuv=Puv1 + }else{ + Pt=P2; Ptuv=Puv2 + } + }else{ + Pt=1/(M1-M2)*(-M2*P1+M1*P2) + Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2) + } + if(is.character(Uveq)){ + Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='') + Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='') + Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE) + Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE) + Tmp=eval(parse(text=Tmp)) + if(Tmp< -Eps0){ + next + } + } + Tmp1=Crossprod(Pt-PtA,Vec) + if(Norm(Tmp1)Zparapt(PtA)+Eps2){ + return(list(1,Pt,Zparapt(Pt),Zparapt(PtA))) + }else{ + Out=Appendrow(Out,Pt) + } + } + } + } + } + if(Length(Out)==0){ + return(list(0,c())) + } + return(c(list(0,Out))) +} + +Nohiddenpara2<- function (Par,Fk,Uveq,Np,Eps1,Eps2){ + Eps0=10^(-4) + Fh=Projpara(Fk) + P1=Ptstart(Fh) + P2=Ptend(Fh) + Csp=CUSPPT + if(!is.list(Csp)){Csp=list(Csp)} + Cspflg=1 + for(I in Looprange(1,length(Csp))){ + Tmp=Op(I,Csp) + if(Norm(Tmp-P1)Eps0){ #180227 + PaL=c(PaL,tmp1) + tmp2=tmp1 + } + } + tmp1=PaL[length(PaL)] #18.02.26from + tmp2=Par[length(Par)] + if(abs(tmp1-tmp2)0){ + if(Norm(P-Q)>Eps0){ #18.02.14 + FigL=c(FigL,list(Partcrv(P,Q,Fh))) + Tmp3=Invparapt(SP,Fh,Fk) + TP=Op(2,Tmp3) + Tmp3=Invparapt(SQ,Fh,Fk) + TQ=Op(2,Tmp3) + FigkL=c(FigkL,list(Partcrv3(TP,TQ,Fk))) + }else{ + FigL=c(FigL,list(Fh)) + FigkL=c(FigkL,list(Fk)) + } + } + Tmp=c() + for(I in Looprange(1,length(PaL)-1)){ + if(!Member(I,SeL)){ + Tmp=c(Tmp,I) + } + } + SeL=Tmp + HIDDENDATA<<- list() + for(I in Looprange(1,length(SeL))){ + Tmp=PaL[SeL[I]] + Tmp1=Pointoncurve(Tmp,Fh) + Tmp=PaL[SeL[I]+1] + Tmp2=Pointoncurve(Tmp,Fh) + if(I==1){ + P=Tmp1; SP=PaL[SeL[I]] + Q=Tmp2; SQ=PaL[SeL[I]+1] + }else{ + if(Member(SeL[I]-1,SeL)){ + Q=Tmp2; SQ=PaL[SeL[I]+1] + }else{ + Tmp=Invparapt(SP,Fh,Fk) + TP=Op(2,Tmp) + Tmp=Invparapt(SQ,Fh,Fk) + TQ=Op(2,Tmp) + HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk))) + P=Tmp1; SP=PaL[SeL[I]] + Q=Tmp2; SQ=PaL[SeL[I]+1] + } + } + } + if(length(SeL)>0){ + if(Norm(P-Q)>Eps0){ #18.02.14 + Tmp=Invparapt(SP,Fh,Fk) + TP=Op(2,Tmp) + Tmp=Invparapt(SQ,Fh,Fk) + TQ=Op(2,Tmp) + HIDDENDATA<<- c(HIDDENDATA,list(Partcrv3(TP,TQ,Fk))) + }else{ + HIDDENDATA<<- c(HIDDENDATA,list(Fk)) + } + } + return(FigkL) +} + +Borderparadata<- function(...){ + varargin=list(...) + Nargs=length(varargin) + FkL=varargin[[1]] + Np=c(50,50) + Eps1=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(2,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps1=tmp} + if(ctr==2){Eps2=tmp} + } + } + Umin=URNG[1]; Umax=URNG[2] + Vmin=VRNG[1]; Vmax=VRNG[2] + EkL=list() + Tmp=grep("e",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:3){ + Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umax),")",sep=""),XYZstr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",VRNG) + Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[2]),sep="") + Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) + EkL=c(EkL,list(Tmp)) + } + Tmp=grep("n",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:3){ + Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmax),")",sep=""),XYZstr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",URNG) + Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[1]),sep="") + Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) + EkL=c(EkL,list(Tmp)) + } + Tmp=grep("w",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:3){ + Tmp=gsub(UNAME,paste("(",sprintf("%7.7f",Umin),")",sep=""),XYZstr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",VRNG) + Tmp2=paste(VNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[2])) + Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) + EkL=c(EkL,list(Tmp)) + } + Tmp=grep("s",DRWS,fixed=TRUE) + if(length(Tmp)>0){ + Tmp1="c(" + for(jj in 1:3){ + Tmp=gsub(VNAME,paste("(",sprintf("%7.7f",Vmin),")",sep=""),XYZstr[jj]) + Tmp1=paste(Tmp1,Tmp,",",sep="") + } + Tmp=substring(Tmp1,1,Length(Tmp1)-1) + Tmp1=paste(Tmp,")",sep="") + Tmp=sprintf("%6.6f",URNG) + Tmp2=paste(UNAME,"=c(",Tmp[1],",",Tmp[2],")",sep='') + Tmp3=paste('N=',as.character(Np[1])) + Tmp=Spacecurve(Tmp1,Tmp2,Tmp3) + EkL=c(EkL,list(Tmp)) + } + if(length(EkL)>0){ + FkL=c(FkL,EkL) + } + Fall=Projpara(FkL) + if(is.numeric(Fall)){ + Fall=list(Fall) + } + Fbdxy=Makexybdy(Np) + BORDERPT<<- list() + Tmp1=list() + for(I in Looprange(1,length(Fall))){ + Tmp1=c(Tmp1,list(c())) + } + OTHERPARTITION<<- Tmp1 + FsL=list() + BORDERHIDDENDATA<<- list() + starttime=proc.time() + for(I in Looprange(1,length(FkL))){ + Tmp=Op(I,FkL) + Tmp=Projpara(Tmp) + Par=Partitionseg(Tmp,Fall,Eps1,Eps2,I) + Tmp1=Op(I,FkL) + Tmp=Nohiddenpara2(Par,Tmp1,1,Np,Eps1,Eps2) + if(length(HIDDENDATA)>0){ + BORDERHIDDENDATA<<- c(BORDERHIDDENDATA,HIDDENDATA) + } + if(length(Tmp)>0){ + FsL=c(FsL,Tmp) + } + Tmp=paste('Border',formatC(I,width=2,flag="0"),'/',sep='') + Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') + Tmp1=proc.time()-starttime + print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) + } + return(FsL) +} + +Sfbdparadata<- function(...){ + varargin=list(...) + Nargs=length(varargin) + Fd=varargin[[1]] + FdL=Fullformfunc(Fd) + Np=c(50,50) + Eps0=10^(-4) + Eps1=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(2,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps1=tmp} + if(ctr==2){Eps2=tmp} + } + } + starttime=proc.time() +# tmp=Evlptablepara(Np) +# Zval=tmp[[1]]; Xval=tmp[[2]]; Yval=tmp[[3]] +# Out3=Implicitplot(Zval,Xval,Yval) + Out3=Envelopedata(Fd) #180306 + tmp3=list() + pts=list() #180306 + for(jj in Looprange(1,length(Out3))){ + tmp1=Op(jj,Out3) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) + } + Nlist=Dropnumlistcrv(tmp2,Eps1) + Nlist=Nlist[[1]] + if(Length(Nlist)==1){ #180306from + tmp=Op(1,Nlist) + tmp=Op(tmp,tmp1) + pts=c(pts,list(tmp)) +# pts=c(pts,list(XYZfunc(tmp[1],tmp[2])))#180306until + }else{ + tmp=c() + for(kk in Looprange(1,length(Nlist))){ + tmp=Appendrow(tmp,Op(Nlist[kk],tmp1)) #18.02.18 + } + if(Length(tmp)>0){ + tmp3=c(tmp3,list(tmp)) + } + } + } + Out3=tmp3 + tmp3=pts #180306from + pts=list() + for(ii in Looprange(1,length(tmp3))){ + tmp=Op(ii,tmp3) + tmp1=XYZfunc(tmp[1],tmp2[]) + flg=0 + for(jj in Looprange(1,length(pts))){ + tmp=Op(jj,pts) + tmp2=XYZfunc(tmp[1],tmp2[]) + if(Norm(tmp1-tmp2)Eps0) || (abs(Vec[1])>Eps0)){ + Vstr=sprintf("%6.6f",Vec) + Pstr=sprintf("%6.6f",PtA) + Tmp=paste(Tmp,"(",Vstr[2],")*(Xfunc(U,V)-(",Pstr[1],"))",sep='') + Tmp=paste(Tmp,"-(",Vstr[1],")*(Yfunc(U,V)-(",Pstr[2],"))}",sep='') + }else{ + Tmp=paste(Tmp,"Xfunc(U,V)}",sep='') + } + eval(parse(text=Tmp)) + Dx=(URNG[2]-URNG[1])/Np[1] + Dy=(VRNG[2]-VRNG[1])/Np[2] + for(J in Looprange(1,Np[2])){ + Vval1=VRNG[1]+(J-1)*Dy + Vval2=VRNG[1]+J*Dy + Uval1=URNG[1] #180305(3lines) + Eval11=Eqfun(Uval1,Vval1) + Eval12=Eqfun(Uval1,Vval2) + for(I in Looprange(1,Np[1])){ +# Uval1=URNG[1]+(I-1)*Dx + Uval2=URNG[1]+I*Dx +# Eval11=Eqfun(Uval1,Vval1) +# Eval12=Eqfun(Uval1,Vval2) + Eval21=Eqfun(Uval2,Vval1) + Eval22=Eqfun(Uval2,Vval2) + a1=Uval1;b1=Vval1;c1=Eval11 + a2=Uval2;b2=Vval1;c2=Eval21 + a3=Uval2;b3=Vval2;c3=Eval22 + a4=Uval1;b4=Vval2;c4=Eval12 + PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) + VL=c(c1,c2,c3,c4,c1) + QL=c() + for(K in 1:4){ + P1=Op(K,PL); P2=Op(K+1,PL) + M1=Op(K,VL); M2=Op(K+1,VL) + if(abs(M1) 0) && (M2> 0)){ + next + } + if((M1< 0) && (M2< 0)){ + next + } + Tmp=1/(M1-M2)*(-M2*P1+M1*P2) + QL=Appendrow(QL,Tmp) + } + Uval1=Uval2 #180306(3lines) + Eval11=Eval21 + Eval12=Eval22 + if(Length(QL)==2){ + Puv1=Op(1,QL); Puv2=Op(2,QL) + Tmp1=Op(1,Puv1) + Tmp2=Op(2,Puv1) + Xv=Xfunc(Tmp1,Tmp2) + Yv=Yfunc(Tmp1,Tmp2) + Zv=Zfunc(Tmp1,Tmp2) + P1=c(Xv,Yv,Zv) + Tmp1=Op(1,Puv2) + Tmp2=Op(2,Puv2) + Xv=Xfunc(Tmp1,Tmp2) + Yv=Yfunc(Tmp1,Tmp2) + Zv=Zfunc(Tmp1,Tmp2) + P2=c(Xv,Yv,Zv) + V1=Vec[1]; V2=Vec[2]; V3=Vec[3] + if(abs(V1)>Eps0){ + M1=PtA[3]+V3/V1*(P1[1]-PtA[1])-P1[3] + M2=PtA[3]+V3/V1*(P2[1]-PtA[1])-P2[3] + }else if(abs(V2)>Eps0){ + M1=PtA[3]+V3/V2*(P1[2]-PtA[2])-P1[3] + M2=PtA[3]+V3/V2*(P2[2]-PtA[2])-P2[3] + }else{ + M1=PtA[2]-P1[2] + M2=PtA[2]-P2[2] + } + if(M1*M2>= 0){ #18.02.21 + if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ + next + } + if(M1==0){ + Pt=P1; Ptuv=Puv1 + }else{ + Pt=P2; Ptuv=Puv2 + } + }else{ + Pt=1/(M1-M2)*(-M2*P1+M1*P2) + Ptuv=1/(M1-M2)*(-M2*Puv1+M1*Puv2) + } + if(is.character(Uveq)){ + Tmp1=paste('(',sprintf("%6.6f",Ptuv[1]),')',sep='') + Tmp2=paste('('+sprintf("%6.6f",Ptuv[2]),')',sep='') + Tmp=gsub(UNAME,Tmp1,Uveq,fixed=TRUE) + Tmp=gsub(VNAME,Tmp2,Tmp,fixed=TRUE) + Tmp=eval(parse(text=Tmp)) + if(Tmp< -Eps0){ + next + } + } + Tmp1=Crossprod(Pt-PtA,Vec) + if(Norm(Tmp1)-Eps0)&&(Tmp1=2){ + Fbdy=Joincrvs(FigL) + }else{ + Fbdy=Op(1,FigL) + } + if(!is.list(ObjL)){ + ObjL=list(ObjL) + } + if(!is.list(FigL)){ + FigL=list(FigL) + } + OutL=list() + for(Nobj in Looprange(1,length(ObjL))){ + Obj=Op(Nobj,ObjL) + ParL=c(1,Length(Obj)) + Tmp=IntersectcurvesPp(Obj,Fbdy,Eps1,Eps2) + for(J in Looprange(1,length(Tmp))){ + Tmp1=Op(J,Tmp) + ParL=c(ParL,Op(2,Tmp1)) + } + ParL=sort(ParL) + Tmp=c(1) + for(I in Looprange(1,length(ParL))){ + Tmp1=Op(length(Tmp),Tmp) + Tmp2=ParL[I] + if(Tmp2-Tmp1>Eps0){ + Tmp=c(Tmp,Tmp2) + } + } + ParL=Tmp + Tmp1=Op(length(ParL),ParL) + Tmp2=Length(Obj) + if(abs(Tmp1-Tmp2)1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps1=tmp} + if(ctr==2){Eps2=tmp} + } + } + Out=list() + CRVSFHIDDENDATA<<- list() + for(Nn in Looprange(1,length(FkL))){ + Fk=Op(Nn,FkL) + Tmp=Projpara(Fk) + Par=Partitionseg(Tmp,Fbdy,Eps1,Eps2,0) + if(Sepflg==0){ + for(I in Looprange(1,Length(Fk)-1)){ + Pa=Op(I,Fk) + Pb=Op(I+1,Fk) + PtL=Meetpoints(Pa,Pb,1,Np,Eps1) + for(J in Looprange(1,Length(PtL))){ + Tmp=Op(J,PtL) + Tmp=Parapt(Tmp) + Tmp1=Paramoncurve(Tmp,I,Projpara(Fk)) + Tmp2=min(abs(Par-Tmp1)) + if(Tmp2*Norm(Parapt(Pb-Pa))>Eps0) { #180227 + Par=c(Par,Tmp1) + } + } + Par=sort(Par) + } + } + for(jj in Looprange(1,length(ADDPOINT))){ #18.02.19from + tmp=Parapt(Op(jj,ADDPOINT)) + tmp=Nearestpt(tmp,Projpara(Fk)) + if(tmp[[3]]Eps0){ #180227 + Par=c(Par,tmp) + tmp2=tmp + } + } + Tmp1=Nohiddenpara2(Par,Fk,1,Np,Eps1,Eps2) + Out=c(Out,Tmp1) + CRVSFHIDDENDATA<<- c(CRVSFHIDDENDATA,HIDDENDATA) + Tmp=paste('Crvsfdata',formatC(Nn,width=2,flag="0"),'/',sep='') + Tmp=paste(Tmp,as.character(length(FkL)),' obtained : Time =',sep='') + Tmp1=proc.time()-starttime + print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) + } + return(Out) +} + +Crv3onsfparadata<- function(...){ + starttime=proc.time() + varargin=list(...) + Nargs=length(varargin) + Fk=varargin[[1]] + if(!is.list(Fk)){ + FkL=list(Fk) + }else{ + FkL=Fk + } + Fbdy=Projpara(varargin[[2]]) + Fd=varargin[[3]] + Fullformfunc(Fd) #18.02.17 + Np=c(50,50) + Eps1=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(4,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps1=tmp} + if(ctr==2){Eps2=tmp} + } + } + Out=list() + CRVONSFHIDDENDATA<<- list() + for(Nn in Looprange(1,length(FkL))){ + Fk=Op(Nn,FkL) + Tmp=Projpara(Fk) + Par=Partitionseg(Tmp,Fbdy,Eps1,Eps2,0) + for(jj in Looprange(1,length(ADDPOINT))){ + tmp=Parapt(Op(jj,ADDPOINT)) + tmp=Nearestpt(tmp,Projpara(Fk)) + if(tmp[[3]]1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps1=tmp} + if(ctr==2){Eps2=tmp} + } + } + Out=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps1,Eps2) + return(Out) +} + +Wireparadata<- function(...){ + starttime=proc.time() + varargin=list(...) + Nargs=length(varargin) + Fbdy3=varargin[[1]] + Fd=varargin[[2]] + FdL=Fullformfunc(Fd) + DuL=varargin[[3]] + DvL=varargin[[4]] + Np=c(50,50) + Eps1=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(5,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps1=tmp} + if(ctr==2){Eps2=tmp} + } + } + if(is.numeric(DuL)){ + tmp1=DuL + DuL=list() + for(jj in Looprange(1,tmp1)){ + tmp=jj*(URNG[2]-URNG[1])/(tmp1+1) + DuL=c(DuL,list(tmp)) + } + } + if(is.numeric(DvL)){ + tmp1=DvL + DvL=list() + for(jj in Looprange(1,tmp1)){ + tmp=jj*(VRNG[2]-VRNG[1])/(tmp1+1) + DvL=c(DvL,list(tmp)) + } + } + Fuv=list() + for(jj in Looprange(1,length(DuL))){ + tmp1=paste("c(",as.character(Op(jj,DuL)),",",VNAME,")",sep="") + tmp2=paste("N=",as.character(Np[2]),sep="") + tmp1=Paramplot(tmp1,Op(6,FdL),tmp2) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,tmp) + } + Fuv=c(Fuv,list(tmp2)) + } + FkL=list() + for(jj in Looprange(1,length(Fuv))){ + tmp1=Op(jj,Fuv) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) + } + FkL=c(FkL,list(tmp2)) + } + Tmp1=proc.time()-starttime + cat(UNAME,"direction started","\n") + Out1=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps1,Eps2) + WIREHIDDENDATA<<- CRVONSFHIDDENDATA + Fuv=list() + for(jj in Looprange(1,length(DvL))){ + tmp1=paste("c(",UNAME,",",as.character(Op(jj,DvL)),")",sep="") + tmp2=paste("N=",as.character(Np[2]),sep="") + tmp1=Paramplot(tmp1,Op(5,FdL),tmp2) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,tmp) + } + Fuv=c(Fuv,list(tmp2)) + } + FkL=list() + for(jj in Looprange(1,length(Fuv))){ + tmp1=Op(jj,Fuv) + tmp2=c() + for(kk in Looprange(1,Length(tmp1))){ + tmp=Op(kk,tmp1) + tmp2=Appendrow(tmp2,XYZfunc(tmp[1],tmp[2])) + } + FkL=c(FkL,list(tmp2)) + } + cat(VNAME,"direction started","\n") + Out2=Crv3onsfparadata(FkL,Fbdy3,Fd,Np,Eps1,Eps2) + WIREHIDDENDATA<<- c(WIREHIDDENDATA, CRVONSFHIDDENDATA) + Out=c(Out1,Out2) + return(Out) +} + +Intersectcrvsf<- function(...){ + # bdyeq is the equation of boundary f(x,y,z) =0 + starttime=proc.time() + varargin=list(...) + Nargs=length(varargin) + crv=varargin[[1]] + Fd=varargin[[2]] + Fullformfunc(Fd) + bdyflg=0 + bdyeq=varargin[[Nargs]] + if(is.character(bdyeq)){ + Nargs=Nargs-1 + bdyflg=1 + tmp=strsplit(bdyeq,"=",fixed=TRUE) + tmp=tmp[[1]] + if(length(tmp)>1){ + bdyeq=paste("(",tmp[1],")-(",tmp[2],")",sep="") + } + tmp=paste("bdyeq<- function(P){x=P[1];y=P[2];z=P[3];",bdyeq,"}",sep="") + eval(parse(text=tmp)) + } + Eps0=10^(-4) + Np=c(50,50) + Eps1=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(3,Nargs)){ + tmp=varargin[[jj]] + if((length(tmp)>1)||(tmp>1)){ + Np=tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps1=tmp} + if(ctr==2){Eps2=tmp} + } + } + PtL=list() + for(I in Looprange(1,Length(crv)-1)){ + Pa=Op(I,crv) + Pb=Op(I+1,crv) + if(bdyflg==0){ + tmp=Meetpoints(Pa,Pb,1,Np,Eps1) + }else{ + M1=bdyeq(Pa); M2=bdyeq(Pb) + if(M1*M2>= 0){ #18.02.21 + if(((M1>0) && (M2>0)) || ((M1< 0) && (M2< 0))){ + next + } + if(M1==0){ + tmp=list(Pa) + }else{ + tmp=list(Pb) + } + }else{ + while(Norm(Pb-Pa)>Eps0){ + if(bdyeq(Pa)==0){ + tmp=list(Pa) + break + } + if(bdyeq(Pa)*bdyeq((Pa+Pb)/2)>0){ + Pa=(Pa+Pb)/2 + }else{ + Pb=(Pa+Pb)/2 + } + } + tmp=list(1/(M1-M2)*(-M2*Pa+M1*Pb)) + } + } + PtL=c(PtL,tmp) + } + Tmp=paste('Intersectcrvsf obtained : Time =',sep='') + Tmp1=proc.time()-starttime + print(paste(Tmp,sprintf("%6.3f",Tmp1[1]),sep='')) + return(PtL) +} + +Sfcutparadata<- function(...){ + varargin=list(...) + Nargs=length(varargin) + CutD=varargin[[1]] + Fbdy3=varargin[[2]] + Fd=varargin[[3]] + FdL=Fullformfunc(Fd) + Np=c(50,50) + Eps0=10^(-4) + Eps1=0.01 + Eps2=0.05 + ctr=0 + for(jj in Looprange(4,Nargs)){ + Tmp=varargin[[jj]] + if((length(Tmp)>1)||(Tmp>1)){ + Np=Tmp + if(length(Np)==1){ + Np=c(Np,Np) + } + }else{ + ctr=ctr+1 + if(ctr==1){Eps1=Tmp} + if(ctr==2){Eps2=Tmp} + } + } + starttime=proc.time() + Tmp=strsplit(CutD,'=') + Tmp=Tmp[[1]] + if(length(Tmp)==1){ + Eq=CutD + }else{ + Eq=paste("(",Tmp[1],")-(",Tmp[2],")",sep="") + } + Eq=gsub("x","Xfunc(U,V)",Eq,fixed=TRUE) + Eq=gsub("y","Yfunc(U,V)",Eq,fixed=TRUE) + Eq=gsub("z","Zfunc(U,V)",Eq,fixed=TRUE) + Tmp=paste("Eqfun<<- function(U,V){",Eq,"}",sep="") + eval(parse(text=Tmp)) + Du=(URNG[2]-URNG[1])/Np[1] + Dv=(VRNG[2]-VRNG[1])/Np[2] + Out=list();Out2=list() + for(J in Looprange(1,Np[2])){ + Vval1=VRNG[1]+(J-1)*Dv + Vval2=VRNG[1]+J*Dv + Uval1=URNG[1] #180305(3lines) + Eval11=Eqfun(Uval1,Vval1) + Eval12=Eqfun(Uval1,Vval2) + for(I in Looprange(1,Np[1])){ +# Uval1=URNG[1]+(I-1)*Du + Uval2=URNG[1]+I*Du +# Eval11=Eqfun(Uval1,Vval1) +# Eval12=Eqfun(Uval1,Vval2) + Eval21=Eqfun(Uval2,Vval1) + Eval22=Eqfun(Uval2,Vval2) + a1=Uval1;b1=Vval1;c1=Eval11 + a2=Uval2;b2=Vval1;c2=Eval21 + a3=Uval2;b3=Vval2;c3=Eval22 + a4=Uval1;b4=Vval2;c4=Eval12 + PL=matrix(c(a1,b1,a2,b2,a3,b3,a4,b4,a1,b1),ncol=2,byrow=TRUE) + VL=c(c1,c2,c3,c4,c1) + QL=c() + for(K in 1:4){ + P1=Op(K,PL); P2=Op(K+1,PL) + M1=Op(K,VL); M2=Op(K+1,VL) + if(abs(M1) 0) && (M2> 0)){ + next + } + if((M1< 0) && (M2< 0)){ + next + } + Tmp=1/(M1-M2)*(-M2*P1+M1*P2) + QL=Appendrow(QL,Tmp) + } + Uval1=Uval2 #180306(3lines) + Eval11=Eval21 + Eval12=Eval22 + if(Length(QL)==2){ + q11=QL[1,1];q12=QL[1,2];q21=QL[2,1];q22=QL[2,2] + if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){ + if(((q21==b1)&&(q22==b1))||((q21==b3)&&(q22==b3))){ + Out2=c(Out2,list(QL)) + }else{ + Out=c(Out,list(QL)) + } + next + } + if(((q12==b1)&&(q22==b1))||((q12==b3)&&(q22==b3))){ + if(((q11==a1)&&(q21==a1))||((q11==a3)&&(q21==a3))){ + Out2=c(Out2,list(QL)) + }else{ + Out=c(Out,list(QL)) + } + next + } + Out=c(Out,list(QL)) + } + } + } + while(length(Out2)>0){ + tmp1=Out2[[1]] + Out=c(Out,list(tmp1)) + Out2=Out2[-1] + rmv=c() + for(jj in Looprange(1,length(Out2))){ + tmp2=Out2[[jj]] + diff1=Norm(tmp2[1,]-tmp1[1,])+Norm(tmp2[2,]-tmp1[2,]) + diff2=Norm(tmp2[1,]-tmp1[2,])+Norm(tmp2[2,]-tmp1[1,]) + if((diff10){ + if(Norm(Op(Length(Tmp3),Tmp3)-Tmp) + + +######################################### + +ThisVersion<- "2ev5_2_3(17.10.28)" + +# 2017.10.28 +# Drwpt debugged ( Flattenlist ) +# 2017.10.07 +# + +############################################# + +Dottedline<- function(...) +{ + varargin <- list(...) + Nall <- length(varargin) + Nagasa <- 0.1 + Ookisa <- PenThick*2 #17.10.07 + I <- Nall + Tmp <- varargin[[I]] + while (mode(Tmp)=="numeric" && length(Tmp)==1 ) { + I <- I-1 + Tmp <- varargin[[I]] + } + if (I==Nall-1) { + Nagasa<-Nagasa*varargin[[Nall]] + Nall <- Nall-1 + } + if (I==Nall-2) { + Nagasa <- Nagasa*varargin[[Nall-1]] + Ookisa <- round(Ookisa*varargin[[Nall]]) + Nall <- Nall-2 + } + Nagasa <- 1000/2.54/MilliIn*Nagasa + Ra=Ookisa/MilliIn + for (N in 1:Nall) { + Pdata <- varargin[[N]] + if (mode(Pdata)=="numeric") { + Pdata <- list(Pdata) + } + for (II in 1:length(Pdata)) { + Clist <- MakeCurves(Op(II,Pdata)) + DinM <- Dataindex(Clist) + Mojisu=0 + for (n in Looprange(1,Nrow(DinM))) { + Tmp <- DinM[n,] + Data <- Clist[Tmp[1]:Tmp[2],] + Len <- 0 + Lenlist <- c(0) + for (I in Looprange(2,Nrow(Data))) { + Len <- Len+Norm(Data[I,]-Data[I-1,]) + Lenlist <- c(Lenlist,Len) + } + Lenall <- Lenlist[length(Lenlist)] + if (Lenall==0) { + next + } + Naga <- Nagasa + Nten <- round(Lenall/Naga)+1 + if (Nten > 1) { + Seg <- Lenall/(Nten-1) + } + else { + Seg <- Lenall + } + Eps <- 10^(-6)*Seg + PPd<-c() + Hajime <- 1 + for (I in Looprange(0,Nten-1)) { + Len <- Seg*I + if (I>0) { + J <- Hajime + while( Len>=Lenlist[J]+Eps) { + J <- J+1 + } + Hajime <- J-1 + } + T <- (Len-Lenlist[Hajime])/ + (Lenlist[Hajime+1]-Lenlist[Hajime]) + P <- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) + PPd<-Appendrow(PPd,P) + if (I==Nten-1) { + if (Norm(P-Data[1,])80){ + cat("\n",file=Wfile,append=TRUE) + Mojisu=0 + } + } + } + } + if(Mojisu>0){ + cat("\n",file=Wfile,append=TRUE) + } + } + Tmp<-PenThick/PenThickInit + Setpen(Tmp) +} + + +########################################### + +Drwline<-function(...) +{ + varargin<-list(...) + Nall<-length(varargin) + Thick<-0 + Tmp<-varargin[[Nall]] + if (mode(Tmp)=="numeric" && length(Tmp)==1){ + Setpen(Tmp) + Nall<-Nall-1 + } + for (N in 1:Nall){ + Pdata<-varargin[[N]] + if (length(Pdata)==0) next + if (mode(Pdata)!="list") Pdata<-list(Pdata) + while(Mixtype(Pdata)==3){ + Tmp1<- list() + for(II in Looprange(1,length(Pdata))){ + Tmp1<- Mixjoin(Tmp1,Pdata[[II]]) + } + Pdata<- Tmp1 + } + for (II in Looprange(1,length(Pdata))){ + Clist<-MakeCurves(Pdata[[II]]) + DinM<-Dataindex(Clist) + for (n in Looprange(1,Nrow(DinM))){ + Tmp<-DinM[n,] + Data<-Clist[Tmp[1]:Tmp[2],] + Mojisu<-0 + for (I in Looprange(1,Nrow(Data))){ + Tmp<-Data[I,] + X=sprintf('%5.5f',Tmp[1]) + Y=sprintf('%5.5f',Tmp[2]) + Pt=paste('(',X,',',Y,')',sep="") + if(I==1){ + Str=paste('\\polyline',Pt,sep="") + }else{ + Str=Pt + } + cat(Str,file=Wfile,append=TRUE) + Mojisu<-Mojisu+nchar(Str) + if (Mojisu>80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<-0 + } + } + if (Mojisu!=0){ + cat("%\n",file=Wfile,append=TRUE) + } + cat("%\n",file=Wfile,append=TRUE) + } + } + } + if (Thick>0){ + Tmp<-PenThick/PenThickInit + Setpen(Tmp) + } +} + +########################################### + +Drwpt<-function(...) +{ + varargin<-list(...) + Nargs<-length(varargin) + All=Nargs + if (TenSize>TenSizeInit){ + N<- round(6*sqrt(TenSize/TenSizeInit)) + } + else{ + N<-4 + } + Tmp<- varargin[[All]] + Iro=c(0,0,0,1) + Iroflg=0 + if(is.character(Tmp)){ + Iro=Ratiocmyk(Tmp) + Iroflg=1 + All=All-1 + } + Tmp<- varargin[[All]] + if (mode(Tmp)=="numeric"){ + if (length(Tmp)>1){ + Kosa<- 1; All<- Nargs + } + else{ + Kosa<- Tmp; All<- All-1 + } + } + else if (mode(Tmp)=="list"){ + Kosa<- 1; All<- Nargs + } + Ra=TenSize*1000/2.54/MilliIn + if(Iroflg>0){ + Str='{\\color[cmyk]{' + for(J in 1:4){ + Str=paste(Str,as.character(Kosa*Iro[J]),sep="") + if(J<4){ + Str=paste(Str,',',sep="") + } + } + Str=paste(Str,'}%',sep="") + cat(Str,file=Wfile,append=TRUE) + } + +# CL<-c() +# for (J in 0:N){ +# Tmp<- TenSize*0.5*1000/2.54/MilliIn +# Tmp<- Tmp*c(cos(pi/4+J*2*pi/N),sin(pi/4+J*2*pi/N)) +# CL<- append(CL,Tmp) +# } +# CL<- matrix(CL,nrow=2) +# CL<- t(CL) + Mojisu=0 + for (II in Looprange(1,All)){ + MS<- varargin[[II]] + MS=Flattenlist(MS) #17.10.28 + if (mode(MS)=="numeric"){ + MS<- list(MS) + } + for (I in Looprange(1,length(MS))){ + P<- MS[[I]] + if (InWindow(P)!="i") next + P<- Doscaling(P) + X=sprintf('%5.5f',P[1]) + Y=sprintf('%5.5f',P[2]) + Str=paste('\\put(',X,',',Y,'){\\circle*{',sprintf('%6.6f',Ra),'}}',sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu=Mojisu+nchar(Str) + if(Mojisu>80){ + cat("\n",file=Wfile,append=TRUE) + Mojisu=0 + } + } + } + Str="%" + if(Iroflg>0){ + Str='}%' + } + if(Mojisu>0){ + Str=paste('\n',Str,'\n',sep="") + }else{ + Fmt=paste(Str,'\n',sep="") + } + cat(Str,file=Wfile,append=TRUE) +} + +# PL<-c() +# for (J in 0:N){ +# PL<- c(PL,P+CL[J+1,]) +# } +# PL<-matrix(PL,nrow=2) +# PL<-t(PL) +# Mojisu<-0 +# for (J in 1:Nrow(PL)){ +# Q<- PL[J,] +# X<- as.character(round(MilliIn*Q[1])) +# Y<- as.character(-round(MilliIn*Q[2])) +# Str<- paste("\\special{pa ",X," ",Y,"}",sep="") +# cat(Str,file=Wfile,append=TRUE) +# Mojisu<- Mojisu+nchar(Str) +# if (Mojisu>80){ +# cat("#\n",file=Wfile,append=TRUE) +# } +# Mojisu=0 +# } +# Str1<- paste("\\special{sh ",as.character(Kosa),"}",sep="") +# Str2<- "\\special{fp}%\n" +# cat(Str1,file=Wfile,append=TRUE) +# cat(Str2,file=Wfile,append=TRUE) +# } +# } +#} + +###################################### + +Makehasen<- function(Figdata,Sen,Gap,Ptn) +{ + Eps<- 10.0^(-6) + Clist<- MakeCurves(Figdata) + DinM<- Dataindex(Clist) + for (N in Looprange(1,Nrow(DinM))){ + Tmp<- DinM[N,] + Data<- Clist[Tmp[1]:Tmp[2],] + Dtall<- Nrow(Data) + Len<- 0 + Lenlist<- c(0) + for (I in Looprange(2,Dtall)){ + Len<- Len+Norm(Data[I,]-Data[I-1,]) + Lenlist<- c(Lenlist,Len) + } + Lenall<- Lenlist[Dtall] + if (Lenall==0){ + next + } + Kari<- (Sen+Gap)*0.1 + Naga<- Sen*0.1 + Tobi<- Gap*0.1 + if (Norm(Data[1,]-Data[Dtall,])=Lenlist[J]-Eps){ + if (J==Dtall){ + break + } + J<- J+1 + } + Hajime<- J-1 + J<- Hajime + while (Len+Naga>Lenlist[J]-Eps){ + if (J==Dtall){ + break + } + J<- J+1 + } + Owari<- J-1 + T<- (Len-Lenlist[Hajime]) + T<- T/(Lenlist[Hajime+1]-Lenlist[Hajime]) + P<- Data[Hajime,]+T*(Data[Hajime+1,]-Data[Hajime,]) + X0=sprintf('%5.5f',P[1]) + Y0=sprintf('%5.5f',P[2]) + Pt0=paste('(',X0,',',Y0,')',sep="") + Str=paste('\\polyline',Pt0,sep="") + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + for (J in Looprange(Hajime+1,Owari)){ + P=Data[J,] + X=sprintf('%5.5f',P[1]) + Y=sprintf('%5.5f',P[2]) + Pt=paste('(',X,',',Y,')',sep="") + Str=Pt + cat(Str,file=Wfile,append=TRUE) + Pt0=Pt + Mojisu=Mojisu+nchar(Str) + } + T<- (Len+Naga-Lenlist[Owari]) + T<- T/(Lenlist[Owari+1]-Lenlist[Owari]) + P<- Data[Owari,]+T*(Data[Owari+1,]-Data[Owari,]) + X=sprintf('%5.5f',P[1]) + Y=sprintf('%5.5f',P[2]) + Pt=paste('(',X,',',Y,')',sep="") + Str=Pt + cat(Str,file=Wfile,append=TRUE) + Mojisu<- Mojisu+nchar(Str) + if (Mojisu>80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<- 0 + } + } + } + cat("%\n%\n",file=Wfile,append=TRUE); +} + +######################################### + +Beginpicture<-function(ul) +{ ## Scaling is implemented + Tmp<- Doscaling(c(XMIN,YMIN)) + Xm<- Tmp[1] + Ym<- Tmp[2] + Tmp<- Doscaling(c(XMAX,YMAX)) + XM<- Tmp[1] + YM<- Tmp[2] + Dx<- XM-Xm + Dy<- YM-Ym + Sym<-".0123456789 +-*/" + SL<-Sym + OL<-"+-*/" + if (ul!=""){ + ULEN<<-ul; + } + Is<-1; + VL<-""; + Ucode<-ULEN + for (I in Looprange(1,nchar(Ucode))){ + C<-substring(Ucode,I,I); + if (length(grep(C,SL,fixed=TRUE))>0){ + if (length(grep(C,OL,fixed=TRUE))>0){ + Tmp<-substring(Ucode,Is,I-1); + Str<-paste(VL,Tmp,C,sep="") + VL<-Str + Is<-I+1; + } + } + else{ + Unit<-substring(Ucode,I,I+1); + Str<-substring(Ucode,Is,I-1); + VL<-paste(VL,Str,sep="") + break; + } + } + Valu<-eval(parse(text=VL)); + Str<-as.character(Valu); + ULEN<<- paste(Str,Unit,sep=""); + if (Unit=="cm") MilliIn<<-1000/2.54*Valu + if (Unit=="mm") MilliIn<<-1000/2.54*Valu/10 + if (Unit=="in") MilliIn<<-1000*Valu + if (Unit=="pt") MilliIn<<-1000/72.27*Valu + if (Unit=="pc") MilliIn<<-1000/6.022*Valu + if (Unit=="bp") MilliIn<<-1000/72*Valu + if (Unit=="dd2") MilliIn<<-1000/1238/1157/72.27*Valu + if (Unit=="cc") MilliIn<<-1000/1238/1157/72.27*12*Valu; + if (Unit=="sp") MilliIn<<-1000/72.27/65536*Valu/10 + MARKLEN<<- MARKLENNow*1000/2.54/MilliIn; + Str<-paste("{\\unitlength=",ULEN,"%\n",sep=""); + cat(Str,file=Wfile,append=TRUE); + cat("\\begin{picture}%\n",file=Wfile,append=TRUE); + Str<-"("; + Tmp<-as.character(round(Dx,digits=6)); + Str<-paste(Str,Tmp,",",sep=""); + Tmp<-as.character(round(Dy,digits=6)); + Str<-paste(Str,Tmp,")(",sep=""); + Tmp<-as.character(round(Xm,digits=6)); + Str<-paste(Str,Tmp,",",sep=""); + Tmp<-as.character(round(Ym,digits=6)); + Str<-paste(Str,Tmp,")%\n",sep=""); + cat(Str,file=Wfile,append=TRUE); + Str=paste('\\linethickness{',as.character(PenThickInit/1000),'in}%',sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +######################################### + +Setpen<-function(Width) +{ + PenThick<<-round(PenThickInit*Width) + Str=paste('\\linethickness{',as.character(PenThick/1000),'in}%',sep="") + cat(Str,file=Wfile,append=TRUE) + cat("%\n",file=Wfile,append=TRUE) +} + +######################################### + +Shade<- function(...) +{ ## Scaling is implemented + varargin<- list(...) + Nargs<- length(varargin) + Iroflg=0 + if(Nargs>1){ + Iro=varargin[[Nargs]] + if(is.character(Iro)){ + Iroflg=1 + if(length(grep("{",Iro,fixed=TRUE))>0){ + Str=paste("{\\color",Iro,sep="") + } + else{ + Str=paste("{\\color{",Iro,"}",sep="") + } + } + else{ + if(length(Iro)==1){ + Kosa=Iro + } + else{ + Iroflg=1 + if(length(Iro)==4){ + Str="{\\color[cmyk]{" + } + else{ + if(length(Iro)==3){ + Str="{\\color[rgb]{" + } + } + for(J in 1:length(Iro)){ + Str=paste(Str,as.character(Iro[J]),sep="") + if(J80){ + cat("%\n",file=Wfile,append=TRUE) + Mojisu<- 0 + } + } + } + if(Iroflg==1){ + Str='}%' + if(Mojisu>0){ + Str=paste('\n',Str,'\n',sep="") + }else{ + Str=paste(Str,'\n') + } + cat(Str,file=Wfile,append=TRUE) + } +} diff --git a/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h b/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h index bfcbbf23..27a5434f 100644 --- a/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h +++ b/texmf-dist/scripts/ketcindy/ketlibC/ketcommon.h @@ -1,76 +1,8 @@ -int length2(double gdata[][2]); -int length3(double gdata[][3]); -int length4(double gdata[][4]); -int length5(double gdata[][5]); -int length2i(int gdata[][2]); -void copyd(int from, int upto, double q[], double p[]); -void copyi(int from, int upto, int q[], int p[]); -int addptd2(double gdata[][2], double pt[2]); -int addptd3(double gdata[][3], double pt[3]); -int addptd4(double gdata[][4], double pt[4]); -int addptd5(double gdata[][5], double pt[5]); -int add2(double gdata[][2], double x, double y); -int add3(double gdata[][3], double x, double y, double z); -int push2(double x, double y, double ptL[][2]); -int push3(double x, double y, double z, double ptL[][3]); -int push4(double x, double y, double z, double w, double ptL[][4]); -int push5(double x, double y, double z, double w, double u, double ptL[][5]); -void pull2(int num, double ptL[][2],double pt[2]); -void pull3(int num, double ptL[][3],double pt[3]); -void pull4(int num, double ptL[][4],double pt[4]); -void pull5(int num, double ptL[][5],double pt[5]); -int appendd2(int level, int from,int upto, double gdata[][2],double mat[][2]); -int appendd3(int level, int from,int upto, double gdata[][3],double mat[][3]); -int prependd2(int from,int upto, double gdata[][2],double mat[][2]); -int appendd1(double numvec[], double num); -int appendi1(int numvec[],int num); -int prependi1(int num, int numvec[]); -int removei2(int nrmv,int mat[][2]); -int dataindexi1(int out[],int din[][2]); -int dataindexd1(double out[],int din[][2]); -int dataindexd2(int level,double out[][2],int din[][2]); -int dataindexd3(int level, double out[][3],int din[][2]); -int dataindexd4(int level, double out[][4],int din[][2]); -void dispmatd1(int from, int upto, double mat[]); -void dispmatd2(int from, int upto, double mat[][2]); -void dispmatd3(int from, int upto, double mat[][3]); -void dispmatd4(int from, int upto, double mat[][4]); -void dispmatd5(int from, int upto, double mat[][5]); -void dispmatd6(int from, int upto, double mat[][6]); -void dispmati2(int from, int upto, int mat[][2]); -void dispmati1(int from, int upto, int mat[]); -int readdata3(const char *fname, double out[][3]); -int readdata2(const char *fname, double out[][2]); -int output2(const char *var, const char *fname, int level, double out[][2]); -void simplesort(double number[]); -int memberi(int a, int list[]); -double dotprod(int dim, double p[], double q[]); -double dist(int dim, double p[], double q[]); -void pointoncurve(double t, double gdata[][2], double eps, double pt[]); -int partcrv(double a,double b,double pkL[][2], double pL[][2]); -int partcrv3(double a,double b,double pkL[][3], double pL[][3]); -int connectseg(double pdata[][2], double eps, double out[][2]); -void koutenseg(double a[2], double b[2], double c[2], double d[2], - double eps, double eps2, double out[4]); -double paramoncurve(double p[2], int n, double ptL[][2]); -void nearestptpt(double pa[2], double pL[][2], double ans[4]); -int intersectselfPp(double data1[][2],double eps,double eps1s,double kL[][4]); -int intersectcrvsPp(double data1[][2], double data2[][2], - double eps,double eps1s, double kL[][4]); -int dropnumlistcrv(double qd[][2], double eps1, int out[]); -int increasept2(double ptL[][2], int nn, double out[][2]); -int increasept3(double ptL[][3], int nn, double out[][3]); -void bezierpt(double t, double p0[2], double p3[2], - double p1[2], double p2[2], double ptout[2]); -int bezier(double ptL[][2], double ctrL[][4], int num, double out[][2]); -int ospline(int level, double ptL[][2], int num, double out[][2]); -void bezierpt3(double t, double p0[3], double p3[3], - double p1[3], double p2[3], double ptout[3]); -int bezier3(double ptL[][3], double ctrL[][6], int num, double out[][3]); -int ospline3(int level, double ptL[][3], int num, double out[][3]); - -const double Inf=99999; -const int Infint=30000; +//20180308 norm added + +int length1(double gdata[]){ + return floor(gdata[0]+0.5); +} int length2(double gdata[][2]){ return floor(gdata[0][0]+0.5); @@ -88,6 +20,10 @@ int length5(double gdata[][5]){ return floor(gdata[0][0]+0.5); } +int length6(double gdata[][6]){ + return floor(gdata[0][0]+0.5); +} + int length2i(int gdata[][2]){ return gdata[0][0]; } @@ -140,6 +76,15 @@ int push5(double x, double y, double z, double w, double u, double ptL[][5]){ return nall; } +int push6(double x, double y, double z, double w, double u, double v,double ptL[][6]){ + int nall=ptL[0][0]; + nall++; + ptL[nall][0]=x; ptL[nall][1]=y;ptL[nall][2]=z; + ptL[nall][3]=w; ptL[nall][4]=u; ptL[nall][5]=v; + ptL[0][0]=nall; + return nall; +} + void pull3(int num, double ptL[][3],double pt[3]){ pt[0]=ptL[num][0]; pt[1]=ptL[num][1]; pt[2]=ptL[num][2]; } @@ -158,6 +103,11 @@ void pull5(int num, double ptL[][5],double pt[5]){ pt[2]=ptL[num][2]; pt[3]=ptL[num][3]; pt[4]=ptL[num][4]; } +void pull6(int num, double ptL[][6],double pt[6]){ + pt[0]=ptL[num][0]; pt[1]=ptL[num][1]; pt[2]=ptL[num][2]; + pt[3]=ptL[num][3]; pt[4]=ptL[num][4]; pt[5]=ptL[num][5]; +} + int add2(double gdata[][2], double x, double y){ int nall; nall=push2(x, y, gdata); @@ -194,6 +144,12 @@ int addptd5(double gdata[][5], double pt[5]){ return nall; } +int addptd6(double gdata[][6], double pt[6]){ + int nall; + nall=push6(pt[0],pt[1],pt[2],pt[3],pt[4],pt[5],gdata); + return nall; +} + int appendd2(int level, int from,int upto, double gdata[][2],double mat[][2]){ int j, np, nall=length2(mat); np=upto-from+1; @@ -423,11 +379,20 @@ int dataindexi1(int out[],int din[][2]){ return ctr; } -void dispmatd1(int from, int upto, double mat[]){ - int i; - for(i=from; iEps){ + crossprod(2,tmp3,tmp2,pt); dt=pt[0]; + crossprod(2,tmp1,tmp3,pt); ds=pt[0]; + t=dt/d; + s=ds/d; + pt[0]=p1[0]+v1[0]*t; pt[1]=p1[1]+v1[1]*t; + out[0]=pt[0];out[1]=pt[1];out[2]=t; out[3]=s; + }else{ + pt[0]=p2[0]-p1[0];pt[1]=p2[1]-p1[1]; + crossprod(2,pt,v1,tmp1); + tmp=tmp1[0]/norm(2,v1); + out[0]=fabs(tmp); out[1]=Inf; + } +} + +void intersectseg(double seg1[][2],double seg2[][2], double out[5]){ + double p1[2],q1[2],p2[2],q2[2],pt[2],pt1[2],nv[2],pts[DsizeS][4]; + double q1p1[2],q2p2[2],p1q2[2],q1p2[2],p1p2[2],q1q2[2]; + double tmp[2],tmp1[2],tmp2[2],tmp3[2],tmp4[2]; + double tmpd1,x,y,t,s,t1,s1,distance,tmpd[4],tmp3d[7]; + int ctr=0, i; + pull2(1,seg1,p1); pull2(2,seg1,q1); + pull2(1,seg2,p2); pull2(2,seg2,q2); + q1p1[0]=q1[0]-p1[0];q1p1[1]=q1[1]-p1[1]; + q2p2[0]=q2[0]-p2[0];q2p2[1]=q2[1]-p2[1]; + p1q2[0]=p1[0]-q2[0];p1q2[1]=p1[1]-q2[1]; + q1p2[0]=q1[0]-p2[0];q1p2[1]=q1[1]-p2[1]; + p1p2[0]=p1[0]-p2[0];p1p2[1]=p1[1]-p2[1]; + p1q2[0]=p1[0]-q2[0];p1q2[1]=p1[1]-q2[1]; + q1q2[0]=q1[0]-q2[0];q1q2[1]=q1[1]-q2[1]; + if((norm(2,q1p1)1){t=1;}; + if(s<0){s=0;}; if(s>1){s=1;}; + tmp3d[ctr]=norm(2,p1p2);ctr++; + tmp3d[ctr]=norm(2,p1q2);ctr++; + tmp3d[ctr]=norm(2,q1p2);ctr++; + tmp3d[ctr]=norm(2,q1q2);ctr++; + tmp1[0]=q2p2[1];tmp1[1]=-q2p2[0]; + intersectline(p1,tmp1,p2,q2p2,tmpd); + if(tmpd[1]!=Inf){ + pt1[0]=tmpd[0];pt1[1]=tmpd[1];s1=tmpd[3]; + if(s1*(s1-1)Eps1){ + out[0]=distance;out[1]=Inf; + }else{ + x=0; y=0; + for(i=1; i<=length4(pts); i++){ + x=x+pts[i][0]; + y=y+pts[i][1]; + } + tmp3[0]=x/length4(pts); tmp3[1]=y/length4(pts); + nearestptpt(tmp3,seg1,tmpd); + t=tmpd[2]; + nearestptpt(tmp3,seg2,tmpd); + s=tmpd[2]; + out[0]=distance; out[1]=tmp3[0]; out[2]=tmp3[1]; + out[3]=t;out[4]=s; + } + } + } + } +} + +int osplineseg(double ptlist[5][2],int num,double out[][2]){ + double p0[2],p1[2],p2[2],p3[2],p2p0[2],p3p1[2],p2p1[2]; + double tmp,cc,pq[2],pr[2],knots[3][2],ctrlist[2][4]; + pull2(1,ptlist,p0); pull2(2,ptlist,p1); + pull2(3,ptlist,p2); pull2(4,ptlist,p3); + p2p0[0]=p2[0]-p0[0];p2p0[1]=p2[1]-p0[1]; + p3p1[0]=p3[0]-p1[0];p3p1[1]=p3[1]-p1[1]; + p2p1[0]=p2[0]-p1[0];p2p1[1]=p2[1]-p1[1]; + tmp=norm(2,p2p0)*norm(2,p3p1); + tmp=1+sqrt((1+dotprod(2,p2p0,p3p1)/tmp)/2); + cc=4*norm(2,p2p1)/3/(norm(2,p2p0)+norm(2,p3p1))/tmp; + pq[0]=p1[0]+cc*p2p0[0]; pq[1]=p1[1]+cc*p2p0[1]; + pr[0]=p2[0]-cc*p3p1[0];pr[1]=p2[1]-cc*p3p1[1]; + ctrlist[0][0]=0; + push4(pq[0],pq[1],pr[0],pr[1],ctrlist); + knots[0][0]=0; + addptd2(knots,p1);addptd2(knots,p2); + bezier(knots,ctrlist,num,out); + return length2(out); +} + +void intersectpartseg(double crv1[][2],double crv2[][2],int ii, int jj,int num,double out[6]){ + double distance=10*Eps2,seg1[3][2],seg2[3][2],tmpd[2],tmp1d[2],tmp2d[2]; + double tmp,snang,dst,tmpd5[5],os1[DsizeS][2],os2[DsizeS][2]; + double p0[2],p1[2],p2[2],p3[2],ptlist[5][2],regard[3][2]; + double tmp1md[20][2],tmpd3[3],tmp3md3[20][3],tmp2md3[20][3]; + double tmpd4[4],Eps00=pow(10,-8.0); + double sx,sy; + int kk,ll,nn; + out[0]=Inf; + for(kk=1;kk<6;kk++){out[kk]=0;} + seg1[0][0]=0;seg2[0][0]=0; + appendd2(1,ii,ii+1,crv1,seg1); + appendd2(1,jj,jj+1,crv2,seg2); + pull2(2,seg1,tmp1d); + pull2(1,seg1,tmpd); + tmp1d[0]=tmp1d[0]-tmpd[0]; tmp1d[1]=tmp1d[1]-tmpd[1]; + pull2(2,seg2,tmp2d); + pull2(1,seg2,tmpd); + tmp2d[0]=tmp2d[0]-tmpd[0]; tmp2d[1]=tmp2d[1]-tmpd[1]; + crossprod(2,tmp1d,tmp2d,tmpd); + snang=fabs(tmpd[0])/(norm(2,tmp1d)*norm(2,tmp2d)); + intersectseg(seg1,seg2,tmpd5); + dst=tmpd5[0]; + if(dst-Eps){ + out[0]=tmpd5[1];out[1]=tmpd5[2];out[2]=ii+tmpd5[3]; + out[3]=jj+tmpd5[4];out[4]=dst;out[5]=snang; + } + }else{ + if(dstdistance-Eps)){ + appendd2(1,1,2,seg1,os1); + }else{ + pull2(1,seg1,p1);pull2(2,seg1,p2); + if(ii==1){ + pull2(3,crv1,p3); + tmpd[0]=p2[0]-p1[0];tmpd[1]=p2[1]-p1[1]; + tmp1d[0]=(p1[0]+p2[0])/2; + tmp1d[1]=(p1[1]+p2[1])/2; + tmp2d[0]=tmp1d[0]+tmpd[1]; + tmp2d[1]=tmp1d[1]-tmpd[0]; + regard[0][0]=0; + addptd2(regard,tmp1d); addptd2(regard,tmp2d); + reflectpoint(p3,regard,p0); + }else{ + if(ii==length2(crv1)-1){ + pull2(ii-1,crv1,p0); + tmpd[0]=p2[0]-p1[0]; tmpd[1]=p2[1]-p1[1]; + tmp1d[0]=(p1[0]+p2[0])/2; + tmp1d[1]=(p1[1]+p2[1])/2; + tmp2d[0]=tmp1d[0]+tmpd[1]; + tmp2d[1]=tmp1d[1]-tmpd[0]; + regard[0][0]=0; + addptd2(regard,tmp1d); addptd2(regard,tmp2d); + reflectpoint(p0,regard,p3); + }else{ + pull2(ii-1,crv1,p0);pull2(ii+2,crv1,p3); + } + } + ptlist[0][0]=0; + addptd2(ptlist,p0);addptd2(ptlist,p1); + addptd2(ptlist,p2);addptd2(ptlist,p3); + osplineseg(ptlist,num,os1); + } + pull2(1,seg2,tmp1d); + pull2(2,seg2,tmp2d); + if((length2(crv2)==2)||(dist(2,tmp2d,tmp1d)>distance-Eps)){ + appendd2(1,1,2,seg2,os2); + }else{ + pull2(1,seg2,p1);pull2(2,seg2,p2); + if(jj==1){ + pull2(3,crv2,p3); + tmpd[0]=p2[0]-p1[0];tmpd[1]=p2[1]-p1[1]; + tmp1d[0]=(p1[0]+p2[0])/2; + tmp1d[1]=(p1[1]+p2[1])/2; + tmp2d[0]=tmp1d[0]+tmpd[1]; + tmp2d[1]=tmp1d[1]-tmpd[0]; + regard[0][0]=0; + addptd2(regard,tmp1d); addptd2(regard,tmp2d); + reflectpoint(p3,regard,p0); + }else{ + if(jj==length2(crv2)-1){ + pull2(jj-1,crv2,p0); + tmpd[0]=p2[0]-p1[0]; tmpd[1]=p2[1]-p1[1]; + tmp1d[0]=(p1[0]+p2[0])/2; + tmp1d[1]=(p1[1]+p2[1])/2; + tmp2d[0]=tmp1d[0]+tmpd[1]; + tmp2d[1]=tmp1d[1]-tmpd[0]; + regard[0][0]=0; + addptd2(regard,tmp1d); addptd2(regard,tmp2d); + reflectpoint(p0,regard,p3); + }else{ + pull2(jj-1,crv2,p0);pull2(jj+2,crv2,p3); + } + } + ptlist[0][0]=0; + addptd2(ptlist,p0);addptd2(ptlist,p1); + addptd2(ptlist,p2);addptd2(ptlist,p3); + osplineseg(ptlist,num,os2); + } + tmp2md3[0][0]=0; + for(kk=1;kk0){ + tmp1md[0][0]=0; + sx=0; sy=0; + for(nn=1;nn<=length3(tmp2md3);nn++){ + pull3(nn,tmp2md3,tmpd3); + push2(tmpd3[1],tmpd3[2],tmp1md); + sx=sx+tmpd3[1]; + sy=sy+tmpd3[2]; + } + sx=sx/length3(tmp2md3); + sy=sy/length3(tmp2md3); + p0[0]=sx; p0[1]=sy; + pull2(ii,crv1,p1); pull2(ii+1,crv1,p2); + tmp1d[0]=p2[0]-p1[0];tmp1d[1]=p2[1]-p1[1]; + tmpd[0]=tmp1d[1];tmpd[1]=-tmp1d[0]; + intersectline(p0,tmpd,p1,tmp1d,tmpd4); + tmp=tmpd4[3]; + if(tmp<0){tmp=0;} + if(tmp>1){tmp=1;} + out[0]=sx;out[1]=sy;out[2]=ii+tmp; + pull2(jj,crv2,p1); pull2(jj+1,crv2,p2); + tmp1d[0]=p2[0]-p1[0];tmp1d[1]=p2[1]-p1[1]; + tmpd[0]=tmp1d[1];tmpd[1]=-tmp1d[0]; + intersectline(p0,tmpd,p1,tmp1d,tmpd4); + tmp=tmpd4[3]; + if(tmp<0){tmp=0;} + if(tmp>1){tmp=1;} + out[3]=jj+tmp;out[4]=dst;out[5]=snang; + } + } + } +} + +void collectsameseg(double ptdL[][6],double rL[][6]){ + double Eps00=pow(10,-8.0),tmp1d[2],tmp2d[2],tmp1d6[6],tmp2d6[6]; + int ii,jj,kk,nr,ctr,numL[40],diffL[40]; + double s1,e1,s2,e2,dst,tmp1,tmp2,tmp1md6[40][6]; + rL[0][0]=0; + if(length6(ptdL)==0){ + return; + } + for(ii=2;ii<=length6(ptdL);ii++){ + pull6(ii,ptdL,tmp1d6);addptd6(rL,tmp1d6); + } + tmp1md6[0][0]=0; + pull6(1,ptdL,tmp1d6); + addptd6(tmp1md6,tmp1d6); + kk=tmp1d6[2]; + if(tmp1d6[2]s1)&&(tmp1s2)&&(tmp2Eps){ + addptd2(crv1,tmp2d); + } + } + crv2[0][0]=0; + pull2(1,crv2s,tmpd); + addptd2(crv2,tmpd); + for(ii=2;ii<=length2(crv2s);ii++){ + pull2(length2(crv2),crv2,tmp1d); + pull2(ii,crv2s,tmp2d); + if(dist(2,tmp1d,tmp2d)>Eps){ + addptd2(crv2,tmp2d); + } + } + if(length2(crv1)!=length2(crv2)){ + self=0; + }else{ + self=1; + for(ii=1;ii<=length2(crv1);ii++){ + pull2(ii,crv1,tmp1d);pull2(ii,crv2,tmp2d); + if(dist(2,tmp1d,tmp2d)>0){ + self=0; + break; + } + } + } + tmp1md6[0][0]=0; + for(ii=1;ii<=length2(crv1)-1;ii++){ + if(self==0){ + js=1; je=length2(crv2)-1; + }else{ + js=ii+2; je=length2(crv2)-1; + } + for(jj=js;jj<=je;jj++){ + intersectpartseg(crv1,crv2,ii,jj,num,tmpd6); + if(tmpd6[0]Eps1){ + addptd6(tmp1md6,tmpd6); + } + } + if(self==1){ + push6(tmpd6[0],tmpd6[1],tmpd6[3],tmpd6[2],tmpd6[4],tmpd6[5],tmp1md6); + } + } + } + } + out[0][0]=0; + tmp2md6[0][0]=0; + while(length6(tmp1md6)>0){ + collectsameseg(tmp1md6,tmp2md6); + dst=100; + for(ii=1;ii<=length6(tmp1md6);ii++){ + pull6(ii,tmp1md6,tmpd6); + if(tmpd6[4]Urng[1]){u2=Urng[1];} + surffun(ch,u1,v,pt1); parapt(pt1,pt2d1); + surffun(ch,u2,v,pt2); parapt(pt2,pt2d2); + dxu=(pt2d2[0]-pt2d1[0])/(u2-u1); + dyu=(pt2d2[1]-pt2d1[1])/(u2-u1); + v1=v-eps/2; v2=v+eps/2; + if(v1Vrng[1]){v2=Vrng[1];} + surffun(ch,u,v1,pt1); parapt(pt1,pt2d1); + surffun(ch,u,v2,pt2); parapt(pt2,pt2d2); + dxv=(pt2d2[0]-pt2d1[0])/(v2-v1); + dyv=(pt2d2[1]-pt2d1[1])/(v2-v1); + return dxu*dyv-dxv*dyu; +}; + +int envelopedata(short ch, double out[][2]){ + int i, j, k, ctrq=0,ctr, nall; + double uval1,uval2,vval1,vval2,eval11,eval12,eval21,eval22; + double pl[5][2], vl[5], ql[11][2], out2[DsizeM][2]; + double du=(Urng[1]-Urng[0])/Mdv; + double dv=(Vrng[1]-Vrng[0])/Mdv; + ctr=0; + for (j = 0; j < Ndv; j++) { + vval1=Vrng[0]+j*dv; + vval2=Vrng[0]+(j+1)*dv; + uval1=Urng[0]; + eval11=evlpfun(ch,uval1,vval1); + eval12=evlpfun(ch,uval1,vval2); + for (i = 0; i < Mdv; i++) { + uval2=Urng[0]+(i+1)*du; + eval21=evlpfun(ch,uval2,vval1); + eval22=evlpfun(ch,uval2,vval2); + pl[0][0]=uval1; pl[0][1]=vval1; vl[0]=eval11; + pl[1][0]=uval2; pl[1][1]=vval1; vl[1]=eval21; + pl[2][0]=uval2; pl[2][1]=vval2; vl[2]=eval22; + pl[3][0]=uval1; pl[3][1]=vval2; vl[3]=eval12; + pl[4][0]=uval1; pl[4][1]=vval1; vl[4]=eval11; + ctrq=0; + for (k = 0; k < 4; k++) { + if(fabs(vl[k])<=Eps){ + ql[ctrq][0]=pl[k][0]; + ql[ctrq][1]=pl[k][1]; + ctrq++; + } + else if(vl[k]>Eps){ + if(vl[k+1]< -Eps){ + ql[ctrq][0]=1/(vl[k]-vl[k+1])*(-vl[k+1]*pl[k][0]+vl[k]*pl[k+1][0]); + ql[ctrq][1]=1/(vl[k]-vl[k+1])*(-vl[k+1]*pl[k][1]+vl[k]*pl[k+1][1]); + ctrq++; + } + } + else{ + if(vl[k+1]>Eps){ + ql[ctrq][0]=1/(-vl[k]+vl[k+1])*(vl[k+1]*pl[k][0]-vl[k]*pl[k+1][0]); + ql[ctrq][1]=1/(-vl[k]+vl[k+1])*(vl[k+1]*pl[k][1]-vl[k]*pl[k+1][1]); + ctrq++; + } + } + } + uval1=uval2; + eval11=eval21; + eval12=eval22; + if(ctrq==2){ + if(ctr>0){ + ctr++; + out[ctr][0]=Inf; + out[ctr][1]=2; // 2 <- 0 ? + } + ctr++; + out[ctr][0]=ql[0][0]; + out[ctr][1]=ql[0][1]; + ctr++; + out[ctr][0]=ql[1][0]; + out[ctr][1]=ql[1][1]; + } + } + } + out[0][0]=ctr; + if(ctr>0){ + nall=connectseg(out, Eps, out2); + out[0][0]=0; + nall=appendd2(2,1,nall,out2,out); + } + return nall; +} + +/* + int implicitplot(double out[][2]){ int i, j, k, ctrq=0,ctr, nall; double pl[5][2], vl[5], ql[11][2], out2[DsizeM][2]; @@ -291,7 +410,9 @@ int implicitplot(double out[][2]){ return nall; } -int cuspsplitpara(double pdata[][2], double outkL[][3]){ +*/ + +int cuspsplitpara(short ch,double pdata[][2], double outkL[][3]){ int i, j, ng, n, nd, ndd, ndrop, is, ncusp=0, ncusppt,st, en, npk,nph, cflg; int cusp[DsizeM], cuspflg; int ntmp,ntmp1,ntmp2, ntmpnum, noutkL=0, noutk=0, nout=0; @@ -314,7 +435,7 @@ int cuspsplitpara(double pdata[][2], double outkL[][3]){ npk=0; nph=0; for(i=1; i<=en-st+1; i++){ pull2(st+i-1,pdata,tmp); - surffun(tmp[0],tmp[1],pt3d); + surffun(ch,tmp[0],tmp[1],pt3d); parapt(pt3d,pt2d); if(i==1){ npk=addptd3(ptk,pt3d); @@ -476,7 +597,7 @@ int cuspsplitpara(double pdata[][2], double outkL[][3]){ return noutkL; } -int makexybdy(double ehL[][2]){ +int makexybdy(short ch,double ehL[][2]){ int i, nehL, ntmpd2; double ptd3[3],ptd2[2],tmpd2[DsizeM][2],du,dv; ehL[0][0]=0; nehL=0; @@ -485,7 +606,7 @@ int makexybdy(double ehL[][2]){ if(DrawE==1){ tmpd2[0][0]=0; ntmpd2=0; for(i=0; i<=Ndv; i++){ - surffun(Urng[1],Vrng[0]+i*dv,ptd3); + surffun(ch,Urng[1],Vrng[0]+i*dv,ptd3); ntmpd2=push2(ptd3[0],ptd3[1],tmpd2); } nehL=appendd2(2,1,ntmpd2,tmpd2,ehL); @@ -493,7 +614,7 @@ int makexybdy(double ehL[][2]){ if(DrawN==1){ tmpd2[0][0]=0; ntmpd2=0; for(i=0; i<=Mdv; i++){ - surffun(Urng[0]+i*du,Vrng[1],ptd3); + surffun(ch,Urng[0]+i*du,Vrng[1],ptd3); ntmpd2=push2(ptd3[0],ptd3[1],tmpd2); } nehL=appendd2(2,1,ntmpd2,tmpd2,ehL); @@ -501,7 +622,7 @@ int makexybdy(double ehL[][2]){ if(DrawW==1){ tmpd2[0][0]=0; ntmpd2=0; for(i=0; i<=Ndv; i++){ - surffun(Urng[0],Vrng[0]+i*dv,ptd3); + surffun(ch,Urng[0],Vrng[0]+i*dv,ptd3); ntmpd2=push2(ptd3[0],ptd3[1],tmpd2); } nehL=appendd2(2,1,ntmpd2,tmpd2,ehL); @@ -509,7 +630,7 @@ int makexybdy(double ehL[][2]){ if(DrawS==1){ tmpd2[0][0]=0; ntmpd2=0; for(i=0; i<=Mdv; i++){ - surffun(Urng[0]+i*du,Vrng[0],ptd3); + surffun(ch,Urng[0]+i*du,Vrng[0],ptd3); ntmpd2=push2(ptd3[0],ptd3[1],tmpd2); } nehL=appendd2(2,1,ntmpd2,tmpd2,ehL); @@ -517,142 +638,98 @@ int makexybdy(double ehL[][2]){ return nehL; } -int partitionseg(double fig[][2],double gL[][2], int ns, double out[]){ - int nother, ndin, din[DsizeM][2], ndin2, din2[DsizeM][2]; - int npar,nkouL, nout, ng; - int npt=length2(fig), ngL=length2(gL), npp; - int i, j, jj, n, k, ntmp1, ntmp2, ntmp3,tmp2i1[DsizeM], flg; - double eps0=pow(10,-5.0),tmp1d2[2], tmp2d2[2],tmpd4[4], dtmp, s; - double p[2], q[2], pd3[3], ans[4], tmp1d1[DsizeM], tmp2d1[DsizeM], tmp3d1[DsizeM]; - double other[DsizeM], parL[DsizeM], g[DsizeM][2], kouL[DsizeM][4]; +void partitionseg(double fig[][2],double gL[][2], int ns, double parL[]){ + int ii,jj,kk,n,din[DsizeM][2],din2[DsizeM][2]; + double eps0=pow(10,-5.0),tmpd4[4], tmpd6[6],tmp,tmp2; + double p[2], q[2], pd3[3], ans[4], tmp1d1[DsizeM], tmp2d1[DsizeM]; + double other[DsizeM], g[DsizeM][2], kouL[DsizeS][4],kouL6[DsizeS][6]; if(ns>1){ - ndin=dataindexd1(Otherpartition,din); - other[0]=0; nother=0; - for(i=din[ns][0]; i<=din[ns][1]; i++){ - dtmp=Otherpartition[i]; - nother++; - other[nother]=dtmp; + dataindexd1(Otherpartition,din); + other[0]=0; + for(ii=din[ns][0]; ii<=din[ns][1]; ii++){ + appendd1(other,Otherpartition[ii]); } + }else{ + other[0]=0; } - else{ - other[0]=0; nother=0; - Otherpartition[0]=0; - ndin=dataindexd2(2,gL,din); - for(i=1; i<=ndin-1; i++){ - Otherpartition[i]=Inf; Otherpartition[0]++; - } - } - parL[1]=1; parL[2]=npt; - parL[0]=2; npar=2; - if(nother>0){ - for(i=1; i<=nother; i++){ - npar=appendd1(parL,other[i]); + parL[0]=0; + appendd1(parL,1); + appendd1(parL,length2(fig)); + if(length1(other)>0){ + for(ii=1; ii<=length1(other); ii++){ + appendd1(parL,other[ii]); } } - ndin=dataindexd2(2,gL,din); - for(n=ns; n<=ndin; n++){ + dataindexd2(2,gL,din); + for(n=ns; n<=din[0][0]; n++){ g[0][0]=0; - ng=appendd2(0,din[n][0],din[n][1],gL,g); - flg=0; - for(i=1; i<=ng; i++){ - pull2(i,fig,tmp1d2); - pull2(i,g,tmp2d2); - if(dist(2,tmp1d2,tmp2d2)>Eps){ - flg=1; - break; - } - } - if(flg==0){ - nkouL=intersectselfPp(fig,Eps1, Eps2,kouL); - } - else{ - nkouL=intersectcrvsPp(fig, g, Eps1, Eps2, kouL); - pull2(1,fig,tmp1d2); - nearestptpt(tmp1d2,g,ans); - if((ans[3]>eps0)&&(ans[3]1+Eps)&&(tmpeps0)&&(tmpd4[3]1+Eps)&&(tmp0)&&(n>ns)&&(length1(tmp2d1)>0)){ + dataindexd1(Otherpartition,din); + tmp1d1[0]=0; + for(ii=1;ii<=length2i(din);ii++){ + if(ii==n){ + for(kk=1;kk<=length1(tmp2d1);kk++){ + appendd1(tmp1d1,tmp2d1[kk]); } } - else{ - for(jj=1; jj<=ntmp1; jj++){ - ntmp2=appendd1(tmp2d1,tmp1d1[jj]); - } + for(jj=din[ii][0]; jj<=din[ii][1];jj++){ + appendd1(tmp1d1,Otherpartition[jj]); + } + if(iiEps1){ - nout=appendd1(out,parL[i]); - npp=addptd2(Partitionpt,p); - } - } - if(out[nout]!=npt){ - out[nout]=npt; - } - if(nout==1){ - out[1]=1; out[2]=npt; - out[0]=2; nout=2; + tmp1d1[0]=0; + for(ii=1;ii<=length1(parL);ii++){ + appendd1(tmp1d1,parL[ii]); + } + parL[0]=0; + tmp2=-1; + for(jj=1;jj<=length1(tmp1d1);jj++){ + tmp=tmp1d1[jj]; + if(fabs(tmp-tmp2)>Eps1){ + appendd1(parL,tmp); + tmp2=tmp; + } } - return nout; } -double funpthiddenQ(double u, double v, double pa[3]){ +double funpthiddenQ(short ch,double u, double v, double pa[3]){ double Vec[3]={sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)}; double eps0=pow(10,-4.0)*(XMAX-XMIN)/10, pt[3], out; - surffun(u, v, pt); + surffun(ch,u, v, pt); if((fabs(Vec[1])>eps0)||(fabs(Vec[0])>eps0)){ out=(Vec[1]*(pt[0]-pa[0])-Vec[0]*(pt[1]-pa[1])); } @@ -671,7 +748,7 @@ void makevaltable(double pta[3]){ v=Vrng[0]+j*dv; for(i=0; i<=Mdv; i++){ u=Urng[0]+i*du; - Zval[j][i]=funpthiddenQ(u, v, pta); + Zval[j][i]=funpthiddenQ(Ch,u, v, pta); } } for(i=0; i<=Mdv; i++){ @@ -682,7 +759,7 @@ void makevaltable(double pta[3]){ } } -int pthiddenQ(double pta[3], int uveq, double eps[2]){ +int pthiddenQ(short ch,double pta[3], int uveq, double eps[2]){ int i, j, k, out, nqL, nsL, nptL, flg, nxt; double Vec[3]={sin(THETA)*cos(PHI),sin(THETA)*sin(PHI),cos(THETA)}; double eps0, epspt, vec1[3], po[3]={0,0,0}, tmpd1, tmp1d1, tmp2d1, m1, m2; @@ -737,8 +814,8 @@ int pthiddenQ(double pta[3], int uveq, double eps[2]){ if(nqL==2){ puv1[0]=qL[1][0]; puv1[1]=qL[1][1]; puv2[0]=qL[2][0]; puv2[1]=qL[2][1]; - surffun(puv1[0],puv1[1],p1d3); - surffun(puv2[0],puv2[1],p2d3); + surffun(ch,puv1[0],puv1[1],p1d3); + surffun(ch,puv2[0],puv2[1],p2d3); if(dist(2,p1d3,p2d3)0){ nfkL=appendd3(2,1,nekL,ekL,fkL); } nfall=projpara(fkL,fall); - nfbdxy=makexybdy(fbdxy); - Otherpartition[0]=0; + nfbdxy=makexybdy(ch,fbdxy); ndin=dataindexd2(2,fall,din); Borderpt[0][0]=0; + Otherpartition[0]=0; for(i=1; i<=ndin-1; i++){ Otherpartition[i]=Inf; Otherpartition[0]++; } Borderhiddendata[0][0]=0; - ndin=dataindexd2(2,fall,din); ndin2=dataindexd3(2,fkL,din2); for(i=1; i<= ndin2; i++){ tmpd3[0][0]=0; ntmpd3=appendd3(0,din2[i][0],din2[i][1],fkL,tmpd3); ntmpd2=projpara(tmpd3,tmpd2); - npar=partitionseg(tmpd2,fall, 1,par); - if(npar>2){ + partitionseg(tmpd2,fall, 1,par); + if(length1(par)>2){ ntmp=npar-1; tmpd2[0][0]=0; ntmpd2=0; for(j=2; j<=ntmp; j++){ @@ -1139,24 +1215,152 @@ int borderparadata(double fkL[][3], double fsL[][3]){ return nfsL; } -int sfbdparadata(double outd3[][3]){ - double pdata[DsizeL][2], pdatad3[DsizeL][3]; - int nall, n; - int cusp[DsizeM]; // remove? - evlptablepara(); - nall=implicitplot(pdata); - nall=cuspsplitpara(pdata, pdatad3); +int dropnumlistcrv3(double qd[][3], double eps1, int out[]){ + int i,j,k,nout,nall=length3(qd), nd, se, en, npd, nptL; + int din[DsizeM][2],ptL[DsizeL]; + double eps=pow(10.0,-6.0), pd[DsizeL][3], p[3], tmp2d[3]; + out[0]=0; nout=0; + nd=dataindexd3(2,qd,din); + for(j=1; j<=nd; j++){ + se=din[j][0]; en=din[j][1]; + pd[0][0]=0; npd=0; + npd=appendd3(0,se,en,qd,pd); + ptL[0]=0; nptL=0; + nptL=appendi1(ptL,1); + pull3(1,pd,p); + for(k=2; k<=npd-1; k++){ + pull3(k,pd,tmp2d); + if(dist(3,p,tmp2d)>eps1){ + nptL=appendi1(ptL,k); + pull3(k,pd,p); + } + } + pull3(npd-1,pd,p); + pull3(npd,pd,tmp2d); + if(dist(3,p,tmp2d)>eps){ // eps -> eps1 ? + nptL=appendi1(ptL,npd); + } +// if(nptL==1){ptL[0]=0; nptL=0;}//180318db + if(nout>0){ + nout=appendi1(out,Infint); + } + for(i=1; i<=nptL; i++){ + nout=appendi1(out,ptL[i]); + } + } + out[0]=nout; + return nout; +} + +int sfbdparadata(short ch,double outd3[][3]){ + double pdatad3[DsizeL][3]; + double pts[DsizeL][2],out3md[DsizeL][2],eps; + double tmpmd[DsizeL][2],tmp1md[DsizeL][2],tmp2md[DsizeL][2],tmp3md[DsizeL][2]; + double tmpd[2],tmp1d[2],tmpd3[3],tmp1d3[3],tmp2d3[3],tmp2md3[DsizeL][3]; + int din[DsizeS][2],nlist[DsizeL]; + int ii,jj,kk,n,nall,flg; + envelopedata(ch, tmp3md); + out3md[0][0]=0; + pts[0][0]=0; + dataindexd2(2,tmp3md,din); + for(jj=1;jj<=length2i(din);jj++){ + tmp1md[0][0]=0; + tmp2md3[0][0]=0; + for(kk=din[jj][0];kk<=din[jj][1];kk++){ + pull2(kk,tmp3md,tmpd); + addptd2(tmp1md,tmpd); + surffun(ch,tmpd[0],tmpd[1],tmpd3); + addptd3(tmp2md3,tmpd3); + } + dropnumlistcrv3(tmp2md3,Eps1,nlist); + if(nlist[0]==1){ + pull2(nlist[1],tmp1md,tmpd); + addptd2(pts,tmpd); + }else{ + tmpmd[0][0]=0; + for(kk=1;kk<=nlist[0];kk++){ + pull2(nlist[kk],tmp1md,tmpd); + addptd2(tmpmd,tmpd); + } + if(length2(tmpmd)>0){ + appendd2(2,1,length2(tmpmd),tmpmd,out3md); + } + } + } + tmp3md[0][0]=0; + appendd2(2,1,length2(pts),pts,tmp3md); + pts[0][0]=0; + for(ii=1;ii<=length2(tmp3md);ii++){ + pull2(ii,tmp3md,tmpd); + surffun(ch,tmpd[0],tmpd[1],tmp1d3); + flg=0; + for(jj=1;jj<=length2(pts);jj++){ + pull2(jj,pts,tmpd); + surffun(ch,tmpd[0],tmpd[1],tmp2d3); + if(dist(3,tmp1d3,tmp2d3)dist(3,tmp1d3,tmpd3)){ + eps=dist(3,tmp1d3,tmpd3); + } + } + pull2(1,tmp2md,tmpd); + surffun(ch,tmpd[0],tmpd[1],tmpd3); + if(dist(3,tmp1d3,tmpd3)eps0)||(fabs(vec[0])>eps0)){ Zval[j][i]=(vec[1]*(pt[0]-pa[0])-vec[0]*(pt[1]-pa[1])); } @@ -1182,7 +1386,7 @@ void makevaltablemeet(double pa[3], double vec[3], double eps0){ } } -int meetpoints(double pta[3], double ptb[3], double eps, double ptL[][3]){ +int meetpoints(short ch,double pta[3], double ptb[3], double eps, double ptL[][3]){ double eps0=pow(10,-4.0), vec[3], out[DsizeM], pL[5][2], vL[5]; double qL[DsizeM][2], p1d2[2], p2d2[2], tmpd2[2], puv1d2[2], puv2d2[2]; double m1,m2, p1d3[3], p2d3[3], v1, v2, v3, ptd3[3], ptuvd2[2], tmp1d1; @@ -1191,7 +1395,7 @@ int meetpoints(double pta[3], double ptb[3], double eps, double ptL[][3]){ vec[0]=ptb[0]-pta[0]; vec[1]=ptb[1]-pta[1]; vec[2]=ptb[2]-pta[2]; out[0]=0; nout=0; ptL[0][0]=0; nptL=0; - makevaltablemeet(pta,vec,eps0); + makevaltablemeet(Ch,pta,vec,eps0); for(j=0; j<=Ndv-2; j++){ for(i=0; i<=Mdv-2; i++){ pL[0][0]=Xval[i]; pL[0][1]=Yval[j]; vL[0]=Zval[j][i]; @@ -1225,8 +1429,8 @@ int meetpoints(double pta[3], double ptb[3], double eps, double ptL[][3]){ if(nqL==2){ pull2(1, qL, puv1d2); pull2(2, qL, puv2d2); - surffun(puv1d2[0], puv1d2[1], p1d3); - surffun(puv2d2[0], puv2d2[1], p2d3); + surffun(ch,puv1d2[0], puv1d2[1], p1d3); + surffun(ch,puv2d2[0], puv2d2[1], p2d3); v1=vec[0]; v2=vec[1]; v3=vec[2]; if(fabs(v1)>eps0){ m1=pta[2]+v3/v1*(p1d3[0]-pta[0])-p1d3[2]; @@ -1296,7 +1500,7 @@ int crvsfparadata(double fkL[][3], double fbdkL[][3], int sepflg, double out[][3 double fbdy[DsizeL][2], fk[DsizeM][3],fkp[DsizeM][3], outh[DsizeL][3]; double fh[DsizeM][2], parL[DsizeM], tmpmd3[DsizeM][3]; double ptL[DsizeM][3], tmpd2[2], tmpd3[3], tmp1d1, tmp2d1, dt; - double po[2]={0,0}, epsd2[2]={Eps1,Eps3}, pa[3], pb[3]; + double po[2]={0,0}, epsd2[2]={Eps1,1}, pa[3], pb[3]; int nbor=length3(Borderhiddendata), nfkL,nfbdkL, nfbdy, nfk, nall; int ncshidden, npar, ndin, din[DsizeM][2], ndin2,din2[DsizeS][2]; int nn, i, j, k, n, nptL, nout; @@ -1321,12 +1525,12 @@ int crvsfparadata(double fkL[][3], double fbdkL[][3], int sepflg, double out[][3 } nfk=appendd3(0,nfk,nfk,fkp,fk); nall=projpara(fk,fh); - npar=partitionseg(fh, fbdy,1, parL); + partitionseg(fh, fbdy,1, parL); if(sepflg>=0){ for(i=1; i<=nfk-1; i++){ pull3(i,fk,pa); pull3(i+1,fk,pb); - nptL=meetpoints(pa,pb, Eps2,ptL); + nptL=meetpoints(Ch,pa,pb, Eps2,ptL); for(j=1; j<=nptL; j++){ pull3(j,ptL,tmpd3); parapt(tmpd3,tmpd2); @@ -1394,7 +1598,7 @@ int wireparadata(double bdyk[][3], double udv[], double vdv[], int num, nv=appendd1(vdiv,vdv[i]); } } - nfbdxy=makexybdy(fbdxy); + nfbdxy=makexybdy(Ch,fbdxy); Wirept[0][0]=0; fsL[0][0]=0; nfsL=0; fsLh[0][0]=0; @@ -1407,13 +1611,13 @@ int wireparadata(double bdyk[][3], double udv[], double vdv[], int num, p[0]=u; p[1]=v; ntmp=addptd2(tmpmd2,p); } - nfkL=cuspsplitpara(tmpmd2, fkL); + nfkL=cuspsplitpara(Ch,tmpmd2, fkL); ndin=dataindexd3(2,fkL,din); for(j=1; j<=ndin; j++){ fk[0][0]=0; nfk=appendd3(0, din[j][0], din[j][1], fkL,fk); ntmp=projpara(fk,tmpmd2); - npar=partitionseg(tmpmd2, fbdy, 1, par); + partitionseg(tmpmd2, fbdy, 1, par); ntmp=length2(Partitionpt); if(ntmp>2){ for(k=2; k<=ntmp; k++){ @@ -1436,13 +1640,13 @@ int wireparadata(double bdyk[][3], double udv[], double vdv[], int num, p[0]=u; p[1]=v; ntmp=addptd2(tmpmd2,p); } - nfkL=cuspsplitpara(tmpmd2, fkL); + nfkL=cuspsplitpara(Ch,tmpmd2, fkL); ndin=dataindexd3(2,fkL,din); for(j=1; j<=ndin; j++){ fk[0][0]=0; nfk=appendd3(0, din[j][0], din[j][1], fkL,fk); ntmp=projpara(fk,tmpmd2); - npar=partitionseg(tmpmd2, fbdy, 1, par); + partitionseg(tmpmd2, fbdy, 1, par); ntmp=length2(Partitionpt); if(ntmp>2){ for(k=2; k<=ntmp; k++){ @@ -1464,13 +1668,13 @@ int wireparadata(double bdyk[][3], double udv[], double vdv[], int num, /* double cutfun(int ch, double u, double v){ double p[3],val ; - surffun(u,v,p); + surffun(ch,u,v,p); val=p[0]+p[1]-0.5; return val; } */ -void makevaltablecut(int ch){ +void makevaltablecut(int chcut){ double eps0=pow(10,-6.0), u, v, du, dv; int i, j, nx=0, ny=0; ; du=(Urng[1]-Urng[0])/Mdv; @@ -1479,7 +1683,7 @@ void makevaltablecut(int ch){ v=Vrng[0]+j*dv; for(i=0; i<=Mdv; i++){ u=Urng[0]+i*du; - Zval[j][i]=cutfun(ch, u,v); + Zval[j][i]=cutfun(Ch,chcut, u,v); } } for(i=0; i<=Mdv; i++){ @@ -1493,8 +1697,8 @@ void makevaltablecut(int ch){ int sfcutdata(int ch, double ekL[][3]){ double cutuvL[DsizeL][2], out1[DsizeM][2], out2[DsizeM][3], pt[3]; int i, j, nall, ndin, din[DsizeM][2], nekL,nout1,nout2; - makevaltablecut(ch); - nall=implicitplot(cutuvL); +// makevaltablecut(ch); //180320 +// nall=implicitplot(cutuvL); //180320 ekL[0][0]=0; nekL=0; ndin=dataindexd2(2,cutuvL,din); for(i=1; i<=ndin; i++){ @@ -1502,7 +1706,7 @@ int sfcutdata(int ch, double ekL[][3]){ nout1=appendd2(2,din[i][0],din[i][1],cutuvL,out1); out2[0][0]=0; for(j=1; j<=nout1; j++){ - surffun(out1[j][0], out1[j][1], pt); + surffun(ch,out1[j][0], out1[j][1], pt); nout2=addptd3(out2,pt); } nekL=appendd3(2,1,nout2,out2,ekL); @@ -1598,7 +1802,7 @@ int kukannozoku(double jokyo[2], double kukanL[][2], double res[][2]){ int skeletondata3(double data[][3], double r00, double eps1, double eps2, double allres[][3]){ double objL[DsizeLL][3], pltL[DsizeLL][3]; - double clipL[DsizeL][5]; + double clipL[DsizeL][5],koc2d6[DsizeM][6],tmpd6[6]; double pts1[DsizeL][2],koc[DsizeM][4], koc2[DsizeM][4], kukanL[DsizeL][2]; double r0, t1, t2, z1, z2, tt, rr, origin[2], te, hh, ku[2], za, zb, ds[DsizeM],dmin; double pt[2], pta[2], ptb[2], ptq[2]; @@ -1642,7 +1846,13 @@ int skeletondata3(double data[][3], double r00, for(j=1; j<=length3(pltp); j++){ push2(pltp[j][0],pltp[j][1],plt2d); } - nkoc2=intersectcrvsPp(obj2d,plt2d,eps1,eps2,koc2); + intersectcurvesPp(obj2d,plt2d,20,koc2d6); //180324from + nkoc2=length6(koc2d6); + koc2[0][0]=0; + for(ii=1;ii<=nkoc2;ii++){ + pull6(ii,koc2d6,tmpd6); + push4(tmpd6[0],tmpd6[1],tmpd6[2],tmpd6[3],koc2); + }//180324to if(nkoc2>0){ koc[0][0]=0; nkoc=0; pull2(1,plt2d,pta); diff --git a/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h b/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h index 49d2ed4c..df31a4d8 100644 --- a/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h +++ b/texmf-dist/scripts/ketcindy/ketlibC/surflibhead.h @@ -1,6 +1,10 @@ double Xval[DsizeS], Yval[DsizeS], Zval[DsizeS][DsizeS]; -double Implicitdata[DsizeL][2]; +////////////////////// +short Ch=1; +///////////////////// + +//double Implicitdata[DsizeL][2]; //180320 double Cuspsplitpt[DsizeL][2]; double Cusppt[DsizeM][2]; double Otherpartition [DsizeM]; @@ -21,21 +25,25 @@ int readdataC(const char *fname, double data[][3]); void parapt(double pt3[3],double pt2[2]); int projpara(double p3[][3], double p2[][2]); double invparapt(double ph, double fh[][2], double fk[][3],double out[3]); -int surfcurve(int level, double crv[][2], double pdata[][3]); +int surfcurve(short ch,int level, double crv[][2], double pdata[][3]); int xyzax3data(double x0, double x1, double y0, double y1, double z0, double z1, double out[][3]); -void evlptablepara(void); -int implicitplot(double out[][2]); -int cuspsplitpara(double pdata[][2], double outkL[][3]); -int makexybdy(double ehL[][2]); -int partitionseg(double fig[][2],double gL[][2], int ns, double out[]); -void makevaltablepth(double pta[3]); -int pthiddenQ(double pta[3], int uveq, double eps[2]); +double evlpfun(short ch, double u, double v); +int envelopedata(short ch, double out[][2]); +void evlptablepara(short ch); +//int implicitplot(double out[][2]); +int cuspsplitpara(short ch,double pdata[][2], double outkL[][3]); +double funpthiddenQ(short ch,double u, double v, double pa[3]); +int makexybdy(short ch,double ehL[][2]); +void partitionseg(double fig[][2],double gL[][2], int ns, double parL[]); +void makevaltablepth(short ch,double pta[3]); +int pthiddenQ(short ch,double pta[3], int uveq, double eps[2]); int nohiddenpara2(double paL[], double fk[][3], int uveq, double figkL[][3]); -int borderparadata(double fkL[][3], double fsL[][3]); -int sfbdparadata(double outd3[][3]); -void makevaltablemeet(double pa[3], double vec[3], double eps0); -int meetpoints(double pta[3], double ptb[3], double eps, double ptL[][3]); +int borderparadata(short ch,double fkL[][3], double fsL[][3]); +int dropnumlistcrv3(double qd[][3], double eps1, int out[]); +int sfbdparadata(short ch,double outd3[][3]); +void makevaltablemeet(short ch,double pa[3], double vec[3], double eps0); +int meetpoints(short ch,double pta[3], double ptb[3], double eps, double ptL[][3]); int crvsfparadata(double fkL[][3], double fbdkL[][3], int sepflg, double out[][3]); int sfcutdata(int ch, double ekL[][3]); int crv3onsfparadata(double fk[][3], double fbdyd3[][3], double out[][3]); @@ -46,4 +54,5 @@ int kukannozoku(double jokyo[2], double kukanL[][2], double res[][2]); int skeletondata3(double data[][3], double r00, double eps1, double eps2, double allres[][3]); -double cutfun(int ch,double u, double v); +double cutfun(short ch,int chcut,double u, double v); +void makevaltablecut(int chcut); diff --git a/texmf-dist/scripts/ketcindy/ketoutset.txt b/texmf-dist/scripts/ketcindy/ketoutset.txt index f5709f55..38381ef2 100644 --- a/texmf-dist/scripts/ketcindy/ketoutset.txt +++ b/texmf-dist/scripts/ketcindy/ketoutset.txt @@ -61,18 +61,6 @@ if(islinux(), PathAd=""; ); -if(isstring(Homehead), - setdirectory(Homehead+pathsep()+getname()); - import("ketcindyhead.txt"); -, - Dirfile=gethome()+pathsep()+"ketcindy"; -); -println(makedir(Dirfile,"ketwork")); -Dirwork=Dirfile+pathsep()+"ketwork"; -Dirwork=replace(Dirwork,pathsep()+pathsep(),pathsep()); - -setdirectory(Dirwork); - if(indexof(PathT,"platex")>0, Helplist(["+","+3d","+mv"],"helpJ"); , diff --git a/texmf-dist/scripts/ketcindy/setketcindy.txt b/texmf-dist/scripts/ketcindy/setketcindy.txt old mode 100644 new mode 100755 index a4c7fab2..39de2543 --- a/texmf-dist/scripts/ketcindy/setketcindy.txt +++ b/texmf-dist/scripts/ketcindy/setketcindy.txt @@ -1,7 +1,6 @@ -// e:2017.10.30 +// e:2018.02.26 Dirlib=Dirhead+pathsep()+"ketlib"; -Libname=Dirlib+pathsep()+"ketpic5_2_3"; -//LibnameS=Dirlib+pathsep()+"ketpicsciL6"; +Libname=Dirlib+pathsep()+"ketpiccurrent"; DirlibC=Dirhead+pathsep()+"ketlibC"; setdirectory(Dirlib); import("ketcindylibbasic1r.cs"); diff --git a/texmf-dist/scripts/ketcindy/template1basic.cdy b/texmf-dist/scripts/ketcindy/template1basic.cdy index e8bfa29a..806d69f2 100644 Binary files a/texmf-dist/scripts/ketcindy/template1basic.cdy and b/texmf-dist/scripts/ketcindy/template1basic.cdy differ diff --git a/texmf-dist/scripts/ketcindy/template2advanced.cdy b/texmf-dist/scripts/ketcindy/template2advanced.cdy old mode 100644 new mode 100755 index d7d6e55b..3fa2e25a Binary files a/texmf-dist/scripts/ketcindy/template2advanced.cdy and b/texmf-dist/scripts/ketcindy/template2advanced.cdy differ diff --git a/texmf-dist/tex/latex/ketcindy/ketlayer.sty b/texmf-dist/tex/latex/ketcindy/ketlayer.sty old mode 100644 new mode 100755 diff --git a/texmf-dist/tex/latex/ketcindy/ketmedia.sty b/texmf-dist/tex/latex/ketcindy/ketmedia.sty index 49d593b6..aa6eecac 100644 --- a/texmf-dist/tex/latex/ketcindy/ketmedia.sty +++ b/texmf-dist/tex/latex/ketcindy/ketmedia.sty @@ -1,14 +1,28 @@ -\newcommand{\inputsound}[3][90.1]{ -% #1:h-position(90), #2:dir(/), #3:file -%2017.12.25 main, \inputsound changed -\ifnum #1=90.1 -\vspace{-20mm} - -\vfill -\fi - -\noindent% -\hspace*{#1mm}% +\newcommand{\inputsound}[3][90]{ +% 20180305 changed +% 20180317 changed +\def\soundbuttona{\color{blue}\small\fbox{\strut$\oplus\triangleright$}} +\def\soundbuttonb{\color{blue}\small\fbox{\strut$\ll$}} +{\unitlength=1pt +\ketcalcwidth[0]{\soundbuttona} +\setcounter{ketpicctrb}{\theketpicctra} +\ketcalcwidth[0]{\soundbuttonb} +\addtocounter{ketpicctrb}{\theketpicctra} +\addtocounter{ketpicctrb}{20} + +\noindent +\hspace*{#1mm}\hspace{20pt}% +\mediabutton[ +mediacommand=#3:playPause, +overface={\soundbuttona}%, +%downface={\color{red}\strut Pause/Pause}% +]{\soundbuttona}% +\mediabutton[ +mediacommand=#3:rewind, +overface={\soundbuttonb} +%downface={\color{red}\strut Pause/Pause}% +]{\soundbuttonb}% +\hspace{-\theketpicctrb pt}% \includemedia[ label=#3, addresource=#2#3.mp3, @@ -17,33 +31,78 @@ source=#2#3.mp3 &autoPlay=true } -]{\color{blue}\fbox{ }}{APlayer.swf}% +% transparent, +% passcontext +]{\color{blue}\small\fbox{\Ctab{15pt}{\strut}}}{APlayer.swf} +}} + +\newcommand{\inputsoundclick}[3][90]{ +% 20180317 added +\def\soundbuttona{\color{blue}\small\fbox{\strut$\oplus\triangleright$}} +\def\soundbuttonb{\color{blue}\small\fbox{\strut$\ll$}} +{\unitlength=1pt +\ketcalcwidth[0]{\soundbuttona} +\setcounter{ketpicctrb}{\theketpicctra} +\ketcalcwidth[0]{\soundbuttonb} +\addtocounter{ketpicctrb}{\theketpicctra} +\addtocounter{ketpicctrb}{20} + +\noindent +\hspace*{#1mm}\hspace{20pt}% \mediabutton[ mediacommand=#3:playPause, -overface={\color{blue}\small \strut \fbox{$\oplus\triangleright$}}, -]{\small\strut \fbox{$\oplus\triangleright$}}% +overface={\soundbuttona}%, +%downface={\color{red}\strut Pause/Pause}% +]{\soundbuttona}% \mediabutton[ mediacommand=#3:rewind, -overface={\color{blue}\small \strut \fbox{$\ll$}} -%downface={\color{red}\small\strut Pause/Pause}% -]{\small\strut \fbox{$\ll$}}% -} +overface={\soundbuttonb} +%downface={\color{red}\strut Pause/Pause}% +]{\soundbuttonb}% +\hspace{-\theketpicctrb pt}% +\includemedia[ + label=#3, + addresource=#2#3.mp3, + activate=onclick, + flashvars={ + source=#2#3.mp3 + &autoPlay=true + } +% transparent, +% passcontext +]{\color{blue}\small\fbox{\Ctab{15pt}{\strut}}}{APlayer.swf} +}} + +\newcommand{\inputmovie}[5][90]{ +% 20180306 changed +% width,height,dir,name +\def\soundbuttona{\small\fbox{\strut$\oplus\triangleright$}} +\def\soundbuttonb{\small\fbox{\strut$\ll$}} + +\hspace*{#1 mm}\mediabutton[ + mediacommand=#5:playPause, + overface={\color{blue}\soundbuttona}, + downface={\color{red}\soundbuttona} +]{\fbox{\soundbuttona}} +\mediabutton[ + mediacommand=#5:rewind, + overface={\color{blue}\soundbuttonb}, + downface={\color{red}\soundbuttonb} +]{\fbox{\soundbuttonb}} -\newcommand{\inputmovie}[3][0.8]{ \includemedia[ - label=#3, - width=#1\linewidth,height=0.6\linewidth, -% width=60mm,height=45mm, - activate=pagevisible, - addresource=#2#3.mp4, + label=#5, + width=#2\linewidth,totalheight=#3\linewidth, + activate=pageopen, + addresource=#4#5.mp4, flashvars={ - source=#2#3.mp4 + source=#4#5.mp4 % &showloading=never % &autoRewind=true &autoplay=true % &loop=1 % &buffer=0.2 } -%]{}{player_flv_maxi.swf} ]{}{VPlayer.swf} + } \ No newline at end of file -- cgit v1.2.3