program SPEFO; {JK 2.63 11.12.08} {************} { SpCommon: zpresnena rychlost svetla SpRadVel: rvresults : v RVR soub. na 4 des mista lab. a measured lambda, mean RV a jeho rms SpSynt : CompareSpectra : "RV of synt. spectrum" vystupuje na 4 des. mista 3.2.06 : SpRadVel - Oscar: V grafickem rezimu se misto write,writeln,read,readln uzivaji funkce ReadStringXY, ReadIntegerStringXY,ReadIntegerValueXY a procedury EmptyXY,WriteTextXY (spcommon) 16.2.06 - Oscar: Pridany dalsi funkce ReadRealStringXY a ReadRealValueXY 28.2.06 : - Oscar: Vystupy pod vyrezem pro mereni car obarveny na zluto 3.3.06 : Compare - RV a factor - default hodnoty pro prazdne retezce 13.3.06 - Pracuje spravne, ale po Plus (x zoom) text dole zmizi. - Objevi se opet po shozeni zoomu. 15.3.06 - Opraveno mizeni textu dole. 12.4.06 : V prim.zprac. pro RETICON je dotaz a cteni disperze po druhem Ins na prvni care provaden v grafice 9.5.06 : FitsToSpefo (unit SpFile) - z FIT soub. se prebira korekce RV 12.5.06 : Pridana fce ReadStr pro text. rezim (obecny string) 15.5.06 : - " - ReadName - " - (DOS jmeno bez extenze) FitsToSpefo - odstraneni dvoji aplikace hel. korekce 17.5.06 : - Posledni verze graf. procedur XY: Empty, WriteText, ReadString, ReadIntegerString, ReadRealString, ReadIntegerValue, ReadRealValue vyrazeny z units Sp: CCD, Filter, RadVel, Synt a File a zacleneny do SpCommon 22.5.06 : Zobecnena proc. EmptyXY - zjistuje si aktualni velikost fontu 30.5.06 : FitsToSpefo - upravena specialne pro Ondrejov CCD 700 31.5.06 : - z radku VHELIO ve FITS (a dalsich) se cte jen 20 bytu! 5.6.06 : - blok pro cteni hlavicky FITS zmensen z 2880 b (36 radku) na 80 b - zavada trva !! 6.6.06 : - blok zmensen na 1 byte, kazdy radek FITS se pak sestavuje z 80 nactenych bloku - O.K. !!! 20.6.06 : - odstranen RTError 004 - too many open files 17.7.06 : SpRect : zavedena proc. RangeX - rozsah lambda na obrazovce 16.8.06 : Do Rectification a Editfile zavedena ScaleX 4.9.06 : DatToSpefo blbla pro rektifikovany DAT: RTE 202 - Stack overflow ! Upraveny velikosti pameti pomoci direktivy $M ve spefo.pas 6.9.06 : ScaleX zavedeno do RadVel 7.9.06 : Zmena cervenych textu v Eqw 8.9.06 : Filtering - zavedena ScaleX 11.9.06 : EditFile - zaveden switch Tab - kontinuum ano/ne 21.12.06: FitsToSpefo - delka exposice se prebirana z FIT souboru (radek EXPTIME) 22.12.06: - pri zadani, ze file je rektif. a nevypada to tak (test max. intensity!), pokracuje se jako by nebyl rektif., tj. vytvori se pouze UUI 8.01.07: - zadany LST soubor existuje - moznost Esc (konec proc.) - hlidan nazev objektu (pro LST) na max. 25 znaku 24.04.07: - moznost automatickeho zpracovani vsech FIT v dir 25.04.07: - kosmeticke upravy 26.04.07: SpfToAscii - moznost automaticke transf. SPEFO->ASCII - nechodi! 31.05.07: - chodi poloautomaticky - u kazdeho soub. chce meze (starting a ending lambda) a jmeno ASC soub. - v ASC soub. za "Add. corr" vystupuje nejaky balast 7.06.07: - zpracovava hromadne cely adresar, zatim necte soubor korekci .AC 11.06.07: - soubor korekci RV (max. 7000) 12.06.07: - nekolik oprav Fitstospefo - hlavicka FIT soub. muze byt kratsi nez 144 radku (tj. nez 4 bloky po 36 radku) 11.07.07: EditFile - skala y ! 12.07.07: SpfToAscii - opraveno zadavani uvodnich udaju spcommon - pridana graf. proc. ScaleY a func. ReadNameXY (DOS jmeno bez ext.) 11.09.07: FitsToSpefo - hlavicka FIT soub. muze mit lib. pocet standardnich bloku po 36 radcich 4.10.07: Ve volbe File/Hel corr RV zprovozneno hromadne zpracovani souboru RV podle souboru LST. 5.10.07: Konecna kosmeticka uprava Hel corr RV (RVCORR). 23.10.07: Unit SpCorDer prejmenovana na Programs - zaclenen jeste RETRVRES 25.10.07: Do unit programs pridan RETRVRES JK 2 - volba Vel v hl. nabidce 26.10.07: Prejmenovani retrvres na RVRESULT 29.10.07: Do unit programs pridan AC 29.11.07: AC zacleneno jako procedura do RVRESULT 10.12.07: - RVRESULT: druha cast (AC) upravena na pripad, ze jsou mereny pouze atm. cary - Unit PROCEDS prejmenovana na SPPROCED 21.12.07: Pokus o skalu Y pri mereni RV 22.01.08: ScaleX upravena pro rozsah na obr. < 10 A 31.01.08: Dokoncena ScaleY pro Edit,Eqw,RV,Rect 20.02.08: Do "Compare spectra" zavedena skala X (odstraneny nerovnomernosti u meziznacek) 10.04.08: ScaleX - (spcommon - Varianta z "Compare": lepe urcuje polohy znacek a meziznacek na krajich vyrezu 14.04.08: - opraveno doplneni krajnich znacek 26.05.08: V RVCorr z SpProced provedeny zmeny v nekterych textech 27.05.08: RadVel - opraveno EqW (aby mizela predchozi poloha znacky) 28.05.08: - kontinuum pri mereni u EqW a RV podle skaly Y 29.05.08: - pri "...further measurements" Yes zprovoznen Esc 30.05.08 SPRADVEL - Pri "...further measurements" Yes zprovoznen Esc 2.06.08: SPPROCED - RVCORR: v INF file se nyni oznamuje, ktere soubory UUI nejsou v aktualni dir, ackoli jsou v LST 4.06.08: RV, EqW - pri zmene sirky cary (Del) hlidano, zda kraje preklope- neho profilu nejsou mimo okno 9.06.08: SPFILE - FitsToSpefo - prevadi se max. 20000 bodu 10.06.08: - zohledneno cislo prvniho pixelu <>1 30.06.08: SPSYNT - CompareSpectra - zavedena specialni ScaleXcomp 1.07.08: SPRADVEL - Pro posuzovani viditelnosti cary zavedena konst. criticvisib (eOscar, Oscar) 4.07.08: SPFILE - FitsToSpefo - zpracovani souboru s jinymi klicovymi slovy nez je ve Spefu pomoci souboru KEYWORDS 23.07.08: - v LST zaokrouhleni HJD a RVcorr na 4 des. mista (ne pouhe odrezavani) 29.07.08: SPPROCED - pridana procedura FITS2RET 1.08.08: Novy system menu - zmena nekterych hotkeys: ================ Rect Synt Edit rVel eWic filT Ccd File -------- ------- ---- ---------- --------- ---- ----------- ------------ Rectif Rotate radial Vel eq. Width Reticon ond change Dir Derectif Compare Rv corr Moments Other equip Fit->spefo Subtract Spefo->fit Add sp. spefO->ascii dAt->spefo radial Vel Reticon ond ............. ........... Measure lines Flat select Re-calc rv's Derive disp re-view Pos. Star reduce Other equip ............. navic fit->Cml, sta 1.08.08: Edit - pokyny nahore v radce (ne pod sebou) 15.08.08: MainMenu - do commonu 1.09.08: SelectFileSort prevedena do spcommon - nedokonala ! (vyvoj pokracuje v SPRADVEL jako SSeleFileSort) 15.09.08: - FitsToSpefo: keyword ITIME funkcne zruseno - nahrazeno nefunkcnim "slovem" XXXXXXXX - Soubor aliasu (KEYWORDS) prejmenovan na ALIASES 19.09.08: Do SpCommon prevedena fce SelectFileSort ! 23.09.08: SelectFileSort - dokonceno trideni adresaru 14.10.08: - opraveno 17.10.08: - zmensena dimenze fname (kvuli RTE 202) 21.10.08: - dalsi oprava 24.10.08: DatToSpefo - zavedeno hromadne zprac. (zlobi u rekt. soub.) 31.10.08: - opraveno - indiv. zprac. - po 10. soub. RTE 004 (Too many open) 4.11.08: - opraveno 5.11.08: Rectification - po ukonceni prace s jednim souborem se zustava v aktualnim adr. 6.11.08: - max. pocet bodu kontinua zvetsen na 200 !!! 10.11.08: - Havaruje pri otevirani souboru rektifikovaneho drivejsimi verzemi (RTE 100 - Disk read error). Soubor CON ma prostor pro 100 bodu, verze 2.6 predp. prostor pro 200 bodu! 1.12.08: Soub. CON pro vice nez 100 bodu - na zacatek pridano 16 bytu, tj. 8 bloku: blok 1 ... char. 254 (plny ctverecek) - je to 200 bodovy soubor 2 ... max. pocet bodu kontinua, pro ktery byl vytvoren (dimenze poli rectx a recty) zbytek ... mezery 3.12.08: CON - pro max. 100 bodu se vytvari jako drive, podle 1.12.08 jen pro vice nez 100 bodu 5.12.08: FitsToSpefo: Osetren pripad DATE_OBS rrrr-mm-ddThh:mm:ss Urcuje se date (pred T) a UT (za T) FitsToLst Totez 8.12.08: SPPROCED: RVRESULT - druha cast: moznost zprac. obou pripadu (COR i AC) - soub. INF - 2x seznam spekter bez telur. car 11.12.08: - jiz O.K. - v soub. COR nejsou spektra bez telur. car } {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@} {$N+} {$E-} {$O+} {$F+} {$M 65520,100000,100000} uses Overlay,Crt,Printer,Dos,Graph,spcommon,spdata,RTPunit, sprect,spfilter,spradvel,speqmom,spsynt,spccd,spfile,spproced; {$O sprect} {$O spfilter} {$O spradvel} {$O speqmom} {$O spsynt} {$O spccd} {$O spfile} {$O spproced} {-------------------------------------------------------------------------} label 1; { kvuli moznosti zrusit zalozeni nove subdir. } { po Esc na uvodni obraz. } const txtspf:array[1..9] of string[6]= (' ',' Rect ',' Synt ',' Edit ',' rVel ',' eWic ',' filT ', ' Ccd ',' File '); ts:string[40]=' Version JK 2.63 Dec 11, 2008'; var sr:searchrec; ch:char; np,np1,npn:integer; { np - poradi v hlavnim menu } { - 0 ... byl stisknut Esc } { npn - uvodni obrazovka 0 ... dosud nebyla } { 1 ... jiz tady byla } { np1 - uprava volby v hlavnim menu } {----------------------------------------------------------------------------} begin GetDir(0,spefodir);spefodir:=FExpand(spefodir); OvrInit('SPEFO.OVR'); if OvrResult<0 then begin Alarm;ClrScr;gotoXY(1,10); writeln(' OvrInit ERROR : file SPEFO.OVR'); writeln(' probably not present in SPEFO-directory !'); writeln; write (' Press any key ... '); ch:=readkey;exit; end; (* if RegisterBGIdriver(@CGADriverProc)<0 then writeln('InitGraph error'); if RegisterBGIdriver(@EGAVGADriverProc)<0 then writeln('InitGraph error'); if RegisterBGIdriver(@ATTDriverProc)<0 then writeln('InitGraph error'); if RegisterBGIdriver(@PC3270DriverProc)<0 then writeln('InitGraph error'); *) grd:=Detect;InitGraph(grd,grm,''); if GraphResult<0 then begin Alarm;ClrScr;gotoXY(1,10); writeln(' InitGraph ERROR : graphic driver (e.g. file EGAVGA.BGI)'); writeln(' probably not present in SPEFO-directory !'); writeln; write (' Press any key ... '); ch:=readkey;exit; end; if grd=VGA then grm:=VGAmed; np:=2;np1:=2; npn:=0;readval:=0;nrectw:=0; 1: {======================================================= hlavni cykl =======\} repeat CrtMode;Window(1,1,80,25);TextBackGround(tbc1);ClrScr; if npn<>0 then MainMenu(np); if npn=0 then begin Head(2,5,46,20,tbc3,txtc,2);window(4,6,45,19); GotoXY(15,2);writeln('S P E F O'); GoToXY(4,4); writeln(ts); GotoXY(1,6); write(' To exit SPEFO now:'); TextColor(11); {LightCyan} writeln(' Enter, then Esc'); gotoxy(1,9);TextColor(txtc); writeln(' To start, select directory where ------>'); writeln(' all saved files will be directed ------>'); gotoxy(1,12);TextColor(txtc); writeln(' Capital characters '); write (' in items of all menus: '); TextColor(11); {LightCyan} writeln('HOTKEYS'); DirName:=SelectFileSort(48,5,80,20,'\'); if DirName='' then {Esc - new dir.} begin Head(2,21,79,24,tbc2,txtc,1); GotoXY(2,2); write( ' Name of a new sub-directory of current dir (will be created) '); GoToXY(2,3); write( ' or Enter (cancel) : '); repeat readln(DirName); if DirName='' then goto 1; {Enter, goto 1 pouze zde} FindFirst(DirName,Directory,sr); if DosError=0 then {sub-dir jiz existuje} begin for i:=1 to 3 do begin write(#7);Delay(1000);end; GoToXY(2,2); write(' '+Space(60)); GoToXY(2,2); write(' Directory '); TextColor(15); {text bily} write(Dirname); TextColor(142); {text zluty (14)+blikajici(128)} write(' already exists !!'); TextColor(yellow); GoToXY(46,2);write('Choose another name '); GoToXy(2,3); write(' '+Space(60)); GoToXY(46,3);write('or Enter (cancel) : '); end; until DosError<>0; MkDir(DirName); ChDir(DirName); end; Window(1,1,80,3);MainMenu(np); GetDir(0,DirName);Dirname:=Fexpand(dirname); Window(1,4,80,25);TextBackground(tbc1);ClrScr; npn:=1;readval:=KeyRead;TextColor(txtc);TextBackground(tbc1); ClrScr;Window(1,1,80,3);TextBackground(tbc2); end; {if npn=0} {---------------------------------------------- hledani v hlavnim menu -----\} repeat if readval=0 then readval:=KeyRead; case readval of {ovladaci klavesy} Left : begin Dec(np);if np=1 then np:=mainmax;readval:=0; end; Right : begin Inc(np);if np>mainmax then np:=2;readval:=0; end; {left, right - cyklicky pohyb} KeyR : begin np:=2;readval:=Enter; end; KeyS : begin np:=3;readval:=Enter; end; KeyE : begin np:=4;readval:=Enter; end; KeyV : begin np:=5;readval:=Enter; end; KeyW : begin np:=6;readval:=Enter; end; KeyT : begin np:=7;readval:=Enter; end; KeyC : begin np:=8;readval:=Enter; end; KeyF : begin np:=9;readval:=Enter; end; Esc : begin np:=0;readval:=Enter; end; Enter : readval:=Enter; else readval:=0; {neovladaci klavesa} end; { case readval } if np>1 then {nebyl Esc} begin LoText(8*np1-2,2,txtspf[np1]); HiText(8*np-2,2,txtspf[np]);np1:=np; end; until readval=Enter; {----------- konec hledani v hlavnim menu -----/} readval:=0; Window(1,4,80,25);TextBackground(tbc1);ClrScr; {------------------------------------------ akce pro volbu v hl. menu ------\} case np of 2 : Rectification; 3 : SyntheticSpectrum; 4 : EditFile; 5 : begin endprog:=false; RadVel(1); if endprog then begin CloseGraph;ClrScr;exit; end; end; 6 : EqWidthMoments; 7 : Filter(1); 8 : reticon; 9 : fileservices; 0 : begin {Esc} Alarm; Head(19,12,60,15,magenta,yellow,2);np:=0; GoToXY(11,2);write('Are you sure you want'); GotoXY(11,3);write('to exit SPEFO ? (Y/N)'); repeat readchar:=UpCase(readKey); until readchar in [Yes,No]; if readchar=No then begin TextBackGround(tbc1);ClrScr;np:=np1; end; end; end; {--------------------------------------- case np -----/} until np=0; {================================================ hlavni cykl - konec ======/} ChDir(spefodir); Window(1,1,80,25);TextBackground(black);TextColor(white);ClrScr; end.