Výpočet a zobrazení amplitudové obálky
Vztahová mapa | ↑ ↓ |
Příznivci telenovel to jistě znají - mapa vztahů je klíčovou záležitostí pro orientaci ve vztazích mezi jednotlivými figurami. Divák musí mít perfektní přehled o tom kdo s kým proti komu, kdo co od koho a za kolik, kdo na koho co ví a jak ho přitlačit ke zdi a zcela výjimečně také kdo pro koho úplně nezištně. Nejinak je tomu v případě výpočtu a zobrazení amplitudové obálky. Níže vyobrazená mapa ukazuje vztahy všech zainteresovaných.
Světle modré obdélníky (postavy zde popisovaného dramatu) zcela vlevo jsou programy, které mají své zastoupení v podobě položek Soft MENU. To je také zdůrazněno svislými nápisy s pozadím v barvě displeje kalkulátoru a texty, které se skutečně zobrazují. Spojnice mezi obdélníky znázorňují hierarchii ve volání jednotlivých funkcí (někdo je zvyklý na termín procedura, jinému vyhovuje název podprogram, ale je to stále totéž). Směr šipek na spojnicích značí směr programového toku: VolajícíProgram → VolanáProcedura.
Jeden by očekával, že hierarchie volání by měla být zřetelná i topologicky. Možností je řada: zleva doprava, shora dolů, je-li to ovlivněno národními zvyklostmi, tak i zprava doleva. Snahy o takové uspořádání však zcela selhaly. Aby ne! Např. program ENVCALC je položkou Soft MENU ENVEL (F5) (v místních intencích vrchol potravinového řetězce). Zároveň je i posledním článkem v řetězci zpracování. Je proto evidentní, že snahy o "topologizaci" jsou naprosto pošetilé. Jediné hledisko, které mělo alespoň nějakou váhu při návrhu vztahové mapy, je hledisko výtvarné.
Provozní záležitosti | ↑ ↓ |
{ { "FORM" ENVFORM }
{ "CHOOS"
«
IF ENVSAMP
THEN
IF
DUP TYPE 8. ==
THEN
ENVDFLT
END
ENVPLOT
END
» }
{ }
{ }
{ }
{ "CLEAN" « { EQ PPAR VPAR TPAR ZPAR ARGUMS WAVEFORM RESULT } PURGE » }
{ }
{ "CHOOS" « ENVSAMP DROP 1.02 MENU » }
{ }
{ "GENER" ENVGNRT }
{ "ENVEL" ENVCALC } }
@ @ @ KONTROLA ARGUMENTU @ Real List|String ENVACHK(Prog function); @ Real List|String ENVACHK(List args); « @ @ @ KONTROLA TYPU FUNKCE @ Real Prog ckftype(Prog function); @ Real Prog ckftype(Name globalname); « IF { 5. 6.} OVER TYPE POS THEN RCL END 8. OVER TYPE ≠ @ 0.|1. obj » "Function" @ "Funct « » → ckftype errftxt « @ obj @ Je zadany objekt typu List? IF DUP @ obj obj TYPE @ type obj 5. @ 5. type obj == @ 1.|0. obj THEN @ { {args} @ Ma seznam argumentu 4 polozky? IF DUP @ {args} {args} SIZE @ size {args} 4. @ 4. size {args} == @ 1.|0. {args} THEN @ { {args} DUP @ {args} {args} 1. @ ifnc {args} {args} GET @ func {args} @ Ma zadana funkce spravny typ? IF ckftype EVAL @ 0.|1. func {args} THEN @ { func {args} DROP2 errftxt 1. @ RTN(1) errtext ELSE @ }{ « » {args} 1. @ ifnc « » {args} SWAP @ « » ifnc {args} PUT @ {args} @ Maji zadane pocty spravny typ? DUP @ {args} {args} 2. @ iper {args} {args} 3. @ irep iper {args} {args} SUB @ {nums} {args} DUP @ {nums} {nums} {args} « TYPE » @ « » {nums} {nums} {args} MAP @ {types} {nums} {args} IF ∑LIST @ 0.|N {nums} {args} THEN @ { {nums} {args} DROP2 "Numbers type" 1. @ RTN(1) errtext ELSE @ }{ {nums} {args} @ Nejsou zadane pocty <= 0? « 0. ≤ » @ « » {nums} {args} MAP @ {errf} {args} IF ∑LIST @ 0.|N {args} THEN @ { {args} DROP "Numbers ≤ 0" 1. @ RTN(1) errtext ELSE @ }{ @ Maji options spravny typ? DUP @ {args} {args} 4. @ iopt {args} {args} GET @ options {args} { 2. 6. } @ {2. 6.} options {args} SWAP @ options {2. 6.} {args} TYPE @ topt {2. 6.} {args} IF POS @ 0.|.2 {args} THEN @ { {args} 0. @ RTN(0) {args} ELSE @ }{ options {args} DROP "Options type" 1. @ RTN(1) errtext END @ } END @ } END @ } END @ } ELSE @ }{ {args} DROP "Arguments count" 1. @ RTN(1) errtext END @ } ELSE @ }{ func IF ckftype EVAL @ 0.|1. « » THEN @ { « » DROP errftxt 1. @ RTN(1) errtext ELSE @ }{ « » @ K samotne funkci pridat default hodnoty ENVDFLT @ {args} 0. @ RTN(0) {args} END @ } END @ } » »
@ @ @ VYPOCET AMPLITUDOVE OBALKY @ List ENVCALC(List waveform); « AXL @ [wave] FFT @ [spec] AXL @ {spec} DUP @ {spec} {spec} SIZE @ size {spec} DUP @ size size {spec} 2. @ 2. size size {spec} / @ half size {spec} → size half « DUP @ {spec} {spec} 1. @ 1. {spec} {spec} GET @ s[1] {spec} SWAP @ {spec} s[1] half @ half {spec} s[1] 1. @ 1. half {spec} s[1] + @ beg {spec} s[1] size @ end beg {spec} s[1] SUB @ {hi} s[1] REVLIST @ {hi} s[1] 2. @ 2. {hi} s[1] * @ 2*{hi} s[1] SWAP @ s[1] 2*{hi} 0. @ 0. s[1] 2*{hi} half @ half 0. s[1] 2*{hi} 1. @ 1. half 0. s[1] 2*{hi} - @ count 0. s[1] 2*{hi} NDUPN @ count 0. 0. ... 0. s[1] 2*{hi} 1. @ 1. count 0. 0. ... 0. s[1] 2*{hi} + @ half 0. 0. ... 0. s[1] 2*{hi} →LIST @ {lo} 2*{hi} SWAP @ 2*{hi} {lo} + @ {hilb} AXL @ [hilb] FFT @ [cmplx] AXL @ {cmplx} ABS @ {abs} size @ size {abs} / @ {envel} » »
@ @ @ DOPLNENI DEFAULT HODNOT K ZADANEMU PROGRAMU @ List ENVDFLT(Prog function); « @ « » 64. 2. "W" @ "W" 2. 64. « » 4. @ 4. "W" 2. 64. « » →LIST @ {args} »
@ @ @ ZOBRAZENI FORMULARE PRO ZADANI ARGUMENTU @ void ENVFORM(); « "Waveform Envelope" { { "Function" "Program" 5 6 8 } { "Period" "Number of samples in one period" 0 } { "Repeat" "Number of periods" 0 } { "Options" "Paste No_rads Waveform Envelope" 2 6 } } { } « DUP 2. / SIN SWAP 5. * COS * » ENVDFLT @ {args} { } {{}} "Wavef 'ARGUMS' @ 'ARGUM {args} { } {{}} "Wavef @ Pokud nejsou zadne minule argumenty... IF DUP @ 'ARGUM 'ARGUM {args} { } {{}} "Wavef VTYPE @ -1. 'ARGUM {args} { } {{}} "Wavef 0. @ 0. -1. 'ARGUM {args} { } {{}} "Wavef < @ 1. 'ARGUM {args} { } {{}} "Wavef THEN @ 'ARGUM {args} { } {{}} "Wavef @ ...jsou nahrazeny default hodnotami DROP @ {args} { } {{}} "Wavef DUP @ {args} {args} { } {{}} "Wavef ELSE @ 'ARGUM {args} { } {{}} "Wavef @ Minule argumenty byly k mani RCL @ {args} {args} { } {{}} "Wavef END IF INFORM @ 1. {args} THEN @ {args} ENVPLOT END »
@ @ @ GENERATOR SIGNALU @ List ENVGNRT(Prog function); @ List ENVGNRT(List args); « ENVNORM @ {args} OBJ→ @ 4. "WE" 2. 64. « » DROP @ "WE" 2. 64. « » @ Priznak "N" IF DUP @ "WE" "WE" 2. 64. « » "N" @ "N" "WE" "WE" 2. 64. « » POS @ 0.|1. "WE" 2. 64. « » THEN @ "WE" 2. 64. « » @ Bez prepoctu nezavisle promenne na radiany 1. @ 1. "WE" 2. 64. « » ELSE @ "WE" 2. 64. « » @ S prepoctem PICK3 @ 64. "WE" 2. 64. « » π @ π 64. "WE" 2. 64. « » / @ 64/π "WE" 2. 64. « » 2. @ 2. 64/π "WE" 2. 64. « » / @ 64/2π "WE" 2. 64. « » INV @ 2π/64 "WE" 2. 64. « » →NUM @ 10.1859 "WE" 2. 64. « » END @ Priznak "P" SWAP @ "WE" 10.1859 2. 64. « » "P" @ "P" "WE" 10.1859 2. 64. « » POS @ paste 10.1859 2. 64. « » 0. @ vidx paste factor repeat period func → func period repeat factor paste vidx « period @ 64. 'repeat' @ 'repe 64. STO* 0. @ 0. repeat @ 128. 0. 1. @ 1. 128. 0. - @ 127. 0. @ Vypoctene vzorky signalu jsou ponechavany na stacku... START factor @ 10.1859 vidx @ 0. 10.1859 * @ xval func EVAL @ yval 'vidx' @ 'vidx' yval INCR @ 1. yval IF paste @ 1. 1. yval THEN @ 1. yval IF period @ 64. 1. yval ≥ @ 0. yval THEN @ yval 0. @ 0. yval 'vidx' @ 'vidx' 0. yval STO @ yval END ELSE DROP @ yval END NEXT @ y[128] y[127] ... y[1] @ ...jsou-li vsechny, ulozi se do objektu List repeat @ 128. y[128] y[127] ... y[1] →LIST @ {yval} » »
@ @ @ KONTROLA A NORMALIZACE ARGUMENTU @ List ENVNORM(List args); « @ Jsou argumenty vsechny a maji spravne typy? IF ENVACHK @ 0.|1. {a}|errt THEN @ errtext "ERROR: " @ "ERROR errtext SWAP @ errtext "ERROR + @ report DOERR END @ {args} @ Pocty museji byt mocninami cisla 2 DUP @ {args} {args} 2. @ iper {args} {args} 3. @ irep iper {args} {args} SUB @ {nums} {args} « ABS LN 2. LN / CEIL 2. SWAP ^ » @ « » {nums} {args} MAP @ {nums} {args} @ Z options odstranit nezname znaky OVER @ {args} {nums} {args} 4. @ iopt {args} {nums} {args} GET @ options {nums} {args} ENVOPTS @ # 4h options {nums} {args} DROP @ options {nums} {args} @ Pocty a options ulozit zpet + @ {n+o} {args} 2. @ index {n+o} {args} SWAP @ {n+o} index {args} REPL @ {args} »
@ @ @ V RETEZCI OPTIONS PONECHANY PLATNE ZNAKY @ Binary String ENVOPTS(String options); @ Binary String ENVOPTS(Gobname options); « @ 'WE' →STR @ "'WE'" "PNWE" @ "PNWE" "'WE'" → optchrs « @ "'WE'" @ Zatim prazdny seznam indexu platnych znaku { } @ { } "'WE'" SWAP @ "'WE'" { } WHILE DUP @ "'WE'" "'WE'" { } SIZE @ 4. "'WE'" { } REPEAT @ "'WE'" { } optchrs @ "PNWE" "'WE'" { } OVER @ "'WE'" "PNWE" "'WE'" { } HEAD @ "'" "PNWE" "'WE'" { } POS @ 0.|3. "'WE'" { } @ Aktualni znak nalezen ve vzorovem retezci? IF DUP @ 0.|3. 0.|3. "'WE'" { } THEN @ 3. "'WE'" { } ROT @ { } 3. "'WE'" SWAP @ 3. { } "'WE'" + @ { 3. } "'WE'" SWAP @ "'WE'" {3.} ELSE @ 3. "'WE'" { } DROP @ "'WE'" { } END TAIL @ "E'" {3.} END @ Nasbiraly se nejake indexy znaku? IF OVER @ {3. 4.} "" {3. 4.} SIZE @ 1. "" {3. 4.} THEN @ "" {3. 4.} @ Ano, sestavi se retezec... OVER @ {3. 4.} "" {3. 4.} 1. @ 1. {3. 4.} "" {3. 4.} « optchrs SWAP DUP SUB + » @ « » 1. {3.} "" {3. 4.} DOLIST @ "WE" {3. 4.} @ ...a pole bitovych priznaku SWAP @ {3. 4.} "WE" # 0h @ # 0h {3. 4.} "WE" SWAP @ {3. 4.} # 0h "WE" 1. @ 1. {3. 4.} # 0h "WE" « 2. SWAP ^ R→B SR OR » @ « » 1. {3. 4.} # 0h "WE" DOLIST @ # Ch "WE" ELSE @ "" {3. 4.} @ Nebyly platne znaky NIP @ "" # 0h @ # 0h "" END » »
@ @ @ VYPOCTY HODNOT A VYKRESLENI GRAFU @ void ENVPLOT(List args); « ENVNORM @ {args} @ Je zmena v zadanych argumentech? IF ENVXCHG @ 1. {args} #4h THEN @ {args} #4h @ Signal je generova vzdy CLLCD " Waveform generating" 5. @ 5. "Wavef {args} #4h DISP @ {args} #4h ENVGNRT @ {wave} #4h 'WAVEFORM' @ 'WAVEF {wave} #4h STO @ #4h WAVEFORM @ {wave} #4h ENVPPAR @ #4h @ Je pozadovan vypocet obalky? IF DUP @ #4h #4h # 8h @ #8h #4h #4h AND @ #0h #4h B→R @ 0. #4h THEN CLLCD " Envelope calculation" 5. @ 5. "Envel #4h DISP @ #4h WAVEFORM @ {wave} #4h ENVCALC @ {envl} #4h 'RESULT' @ 'RESUL {envl} #4h STO @ #4h END END @ Podle pole bitovych priznaku options sestavit promennou EQ { } @ { } #4h @ Je treba kreslit vstupni signal? IF OVER @ #4h { } #4h # 4h @ #4h #4h { } #4h AND @ #4h { } #4h B→R @ 4. { } #4h THEN @ { } #4h « WAVEFORM X GET » @ « » { } #4h + @ {w} #4h END @ Je treba kreslit obalku? IF SWAP @ #4h {w} # 8h @ #8h #4h {w} AND @ #0h {w} B→R @ 0. {w} THEN @ {w} « RESULT X GET » @ « » {w} + @ {w e} END STEQ @ Vykreslit... ERASE DRAX DRAW @ ...pockat na klavesu... 0 @ 0 IFERR WAIT @ 105.1 THEN END @ ...a je hotovo! DROP »
@ @ @ NASTAVENI HODNOT PROMENNE PPAR @ void ENVPPAR(List waveform); « DUP @ {wave} {wave} SIZE @ lastidx {wave} @ @ @ USEKY DELENI OBOU OS @ Real axetick(Real range); « DUP MANT 0. RND 2. - 3. / IF DUP 0. ≥ THEN IP 2. SWAP ^ .5 * ELSE DROP .2 END SWAP XPON ALOG * » @ « » lastidx {wave} → lastidx axetick « @ {wave} @ Mezni hodnoty SORT @ {swav} DUP @ {swav} {swav} lastidx @ lastidx {swav} {swav} GET @ Wmax {swav} SWAP @ {swav} Wmax HEAD @ Wmin Wmax DUP2 @ Wmin Wmax Wmin Wmax - @ Yrange Wmin Wmax 2. @ 2. Yrange Wmin Wmax / @ Yrange Wmin Wmax axetick EVAL @ Ytick Wmin Wmax @ Zaokrouhleni podle useku deleni osy @ Real axelimit(Real tick, Real minmax); « OVER / 0.5 + FLOOR * » @ « » Ytick Wmin Wmax → ytick axelimit « @ Wmin Wmax ytick @ Ytick Wmin Wmax PICK3 @ Wmax Ytick Wmin Wmax axelimit EVAL @ Ymax Wmin Wmax ytick @ Ytick Ymax Wmin Wmax PICK3 @ Wmin Ytick Ymax Wmin Wmax axelimit EVAL @ Ymin Ymax Wmin Wmax ROT @ Wmin Ymin Ymax Wmax OVER @ Ymin Wmin Ymin Ymax Wmax IF < @ 0.|1. Ymin Ymax Wmax THEN @ Ymin Ymax Wmax ytick @ Ytick Ymin Ymax Wmax - @ Ymin Ymax Wmax END UNROT @ Ymax Wmax Ymin SWAP @ Wmax Ymax Ymin OVER @ Ymax Wmax Ymax Ymin IF > @ 0.|1. Ymax Ymin THEN @ Ymax Ymin ytick @ Ytick Ymax Ymin + @ Ymax Ymin END ytick @ Ytick Ymax Ymin » @ Nastaveni rozsahu v ose X 1. @ Xmin Ytick Ymax Ymin lastidx @ Xmax Xmin Ytick Ymax Ymin XRNG @ Ytick Ymax Ymin @ Useky deleni os lastidx @ Xrange Ytick Ymax Ymin axetick EVAL @ Xtick Ytick Ymax Ymin » SWAP @ Ytick Xtick Ymax Ymin 2. @ 2. Xtick Ytick Ymax Ymin →LIST @ {atick} Ymax Ymin @ Bod krizeni os PICK3 @ Ymin {atick} Ymax Ymin PICK3 @ Ymax Ymin {atick} Ymax Ymin CASE 0. @ 0. Ymax Ymin {atick} Ymax Ymin < @ 0.|1. Ymin {atick} Ymax Ymin THEN @ Ymin {atick} Ymax Ymin DROP @ {atick} Ymax Ymin OVER @ Ymax {atick} Ymax Ymin END 0. @ 0. Ymin {atick} Ymax Ymin > @ 0.|1. {atick} Ymax Ymin THEN @ {atick} Ymax Ymin PICK3 @ Ymin {atick} Ymax Ymin END 0. @ 0. {atick} Ymax Ymin END @ Yorig {atick} Ymax Ymin 1. @ Xorig Yorig {atick} Ymax Ymin SWAP @ Yorig Xorig {atick} Ymax Ymin R→C @ (x,y) {atick} Ymax Ymin @ Kompletni nastaveni os SWAP @ {atick} (x,y) Ymax Ymin 2. @ 2. {atick} (x,y) Ymax Ymin →LIST @ {axes} Ymax Ymin AXES @ Ymax Ymin @ Nastaveni rozsahu v ose Y YRNG »
@ @ @ VYBER Z INSTATNI NABIDKY ARGUMENTU @ Prog ENVSAMP(); @ List ENVSAMP(); « SAMPLES VARS @ {list} 1. @ 1. {list} @ Z adresare SAMPLES je sestaven seznam vhodny promennych « DUP @ 'name' 'name' RCL @ obj 'name' IF UPDIR ENVACHK @ 0.|1. {args} 'name' SAMPLES NIP @ 0.|1. 'name' THEN @ 'name' DROP END @ 'name' » @ « » 1. {list} DOLIST @ {list} @ Neni-li seznam prazdny, zobrazi se menu pro vyber IF DUP @ {list} {list} SIZE @ 0.|1. {list} NOT @ 1.|0. {list} THEN @ {list} DROP UPDIR "Empty list" DOERR END @ {list} "Choose any sample" @ "Choose {list} SWAP @ {list} "Choose 0 @ 0 {list} "Choose CHOOSE @ 0.|1. |'name' IF DUP @ 0.|1. 0.|1. |'name' THEN @ 1. 'name' SWAP @ 'name' 1. RCL @ obj 1. SWAP @ 1. obj END @ 0.|1. |obj UPDIR »
@ @ @ DETEKCE ZMEN V ZADANI @ Real [List] Binary ENVXCHG(List args); « DUP @ {args} {args} SIZE @ oidx {args} # 0h @ #0h oidx {args} → optidx optbit « DUP @ {args} {args} optidx @ oidx {args} {args} GET @ 'W' {args} →STR @ "W" {args} ENVOPTS @ #4h "W" {args} UNROT @ "W" {args} #4h optidx @ oidx "W" {args} #4h SWAP @ "W" oidx {args} #4h PUT @ {args} #4h 'ARGUMS' @ 'ARGUM {args} #4h DUP @ 'ARGUM 'ARGUM {args} #4h @ Pokud jsou zadne minule argumenty... IF VTYPE @ 5. 'ARGUM {args} #4h 5. @ 5. 5. 'ARGUM {args} #4h == @ 1. 'ARGUM {args} #4h THEN @ 'ARGUM {args} #4h @ ...jsou nacteny a zpracovany DUP @ 'ARGUM 'ARGUM {args} #4h RCL @ {oval} 'ARGUM {args} #4h optidx @ oidx {oval} 'ARGUM {args} #4h DUP2 @ oidx {oval} oidx {oval} 'ARGUM {args} #4h GET @ "WE oidx {oval} 'ARGUM {args} #4h ENVOPTS @ #Ch "WE" oidx {oval} 'VALU {args} #4h NIP @ #Ch oidx {oval} 'VALU {args} #4h DUP @ #Ch #Ch oidx {oval} 'VALU {args} #4h # Ch @ #Ch #Ch #Ch oidx {oval} 'VALU {args} #4h AND @ #Ch #Ch oidx {oval} 'VALU {args} #4h 'optbit' @ 'optbi #Ch #Ch oidx {oval} 'VALU {args} #4h STO @ #Ch oidx {oval} 'VALU {args} #4h @ Kontrolni soucet pouze pro options "P" a "N" # 3h @ #3h #Ch oidx {oval} 'VALU {args} #4h AND @ #0h oidx {oval} 'VALU {args} #4h PUT @ {oval} 'VALU {args} #4h BYTES @ 123. #E12Dh 'ARGUM {args} #4h 2. @ 2. 123. #E12Dh 'ARGUM {args} #4h →LIST @ {ockv} 'ARGUM {args} #4h ELSE @ Nejsou zadne minule argumenty { } @ {ockv} 'ARGUM {args} #4h END PICK3 @ {args} {ockv} 'ARGUM {args} #4h ROT @ 'ARGUM {args} {ockv} {args} #4h STO @ {ockv} {args} #4h @ Zpracovani aktualnich argimentu UNROT @ {args} #4h {ockv} optidx @ oidx {args} #4h {ockv} PICK3 @ #4h oidx {args} #4h {ockv} @ Kontrolni soucet pouze pro options "P" a "N" # 3h @ #3h #4h oidx {args} #4h {ockv} AND @ #0h oidx {args} #4h {ockv} PUT @ {nval} #4h {ockv} BYTES @ 123. #E12Dh #4h {ockv} 2. @ 2. 123. #E12Dh #4h {ockv} →LIST @ {nckv} #4h {ockv} ROT @ {ockv} {nckv} #4h SAME NOT @ 1.|0. #4h @ Kontrolni soucty porovnany, jeste priznaky "W" a "E" OVER @ #4h 1.|0. #4h # Ch @ #Ch #4h 1.|0. #4h AND @ #0h 1.|0. #4h optbit @ #Ch #0h 1.|0. #4h » OVER @ #0h #Ch #0h 1.|0. #4h XOR @ #Ch #0h 1.|0. #4h AND @ #0h 1.|0. #4h B→R @ 0. 1.|0. #4h @ Zmenilo se neco? IF OR @ 1.|0. #4h THEN @ #4h ARGUMS @ {args} #4h 1. @ 1. {args} #4h ELSE @ #4h 0. @ 0. #4h END »
Příklady a náměty pro vyzkoušení | ↑ ↓ |
{ { } { } UPDIR }
« DUP SIN 1.75 * OVER 3. * SIN .48 * + SWAP 5. * SIN .25 * + »
{
« 1.1 * SIN .96 *
» 64. 2. "PW" }
« → α '(1.5*SIN(α/2.)+.95*COS(1.5*α))*SIN(6.*α)' »
{ { SAMPLES S1RPL } 64. 2. "WE" }
« DUP 2. / SIN 1.5 * OVER 1.5 * COS .95 * + SWAP 6. * SIN * »
{
« 2. / 32. -
» 64. 2. "NPW" }