10REM Observe - A program to record
20REM - astronomical
30REM - observations
40REM Author - Steven Flintham
50REM - March 1989
60REM Version - 1.00 (Public Domain)
70MODE 7:VDU 23;8202;0;0;0;
80PROCdisable:PROCinit
90ON ERROR MODE 7:CLOSE #0:REPORT:PRI
NT" at line ";ERL:PROCenable:END
100REPEAT
110choice%=FNmenu
120IF choice%=0 THEN PROCnew`file
130IF choice%=1 THEN PROCold`file
140IF choice%=2 THEN PROCenter`obs
150IF choice%=3 THEN PROCview`obs
160IF choice%=4 THEN PROCamend`obs
170IF choice%=5 THEN PROCclose`file
180UNTIL FALSE
190END
200DEF PROCdisable
210*FX229,1
220*FX4,2
230ENDPROC
240DEF PROCenable
250*FX229,0
260*FX4,0
270ENDPROC
280DEF PROCinit
290T%=FALSE:REM SET TO TRUE IF TELETEX
T ADAPTER AND ATS CONNECTED AND TUNED IN
300IF T% THEN PROCsetup
310name%=30:object%=30:date%=10:time%=
5:vis%=1:inst%=39:notes%=255:extra%=5:rs
ize%=FNrec`size
320name$="Steven Flintham":instrument$
="8x40 Miranda binoculars"
330mfsize%=10240:mrec%=(mfsize%-extra%
)/rsize%
340file$="None!":rec%=0
350CLOSE #0
360ENDPROC
370DEF FNdate
380LOCAL A%,X%,Y%,block%
390*TTXON
400block%=&0A00
410A%=&7A:X%=block% MOD 256
420Y%=block% DIV 256:?block%=22
430CALL &FFF1
440*TTXOFF
450IF block%?10=&FF THEN ="NO DATE! "
460block%?11=13
470REPEAT
480UNTIL FNdate`ok($(block%+1))
490=$(block%+1)
500DEF PROCoscli($&700)
510X%=0:Y%=7:CALL &FFF7
520ENDPROC
530DEF PROCsetup
540*HOFF
550*BBC1
560REPEAT
570*PAGE 100
580*TRANSFER 7800
590UNTIL FNdate<>"NO DATE! "
600ENDPROC
610DEF FNGMT
620LOCAL A%,X%,Y%,block%,time$
630REPEAT
640*TTXON
650block%=&A00
660A%=&7A:X%=block% MOD 256
670Y%=block% DIV 256:?block%=15
680CALL &FFF1
690*TTXOFF
700time$=FNpad(2,block%?11)+":"
710time$=time$+FNpad(2,block%?12)+":"
720time$=time$+FNpad(2,block%?13)
730UNTIL FNtime`ok(time$)
740=time$
750DEF FNpad(pad%,num%)
760LOCAL text$
770text$=STR$÷(num%)
780REPEAT
790IF LEN(text$)<pad% THEN text$="0"+t
ext$
800UNTIL LEN(text$)=pad%
810=text$
820DEF FNtime`ok(t$)
830LOCAL ok%,pos%
840ok%=TRUE
850FOR pos%=1 TO LEN(t$)
860IF ASC(MID$(t$,pos%,1))<>ASC":" AND
ASC(MID$(t$,pos%,1))<ASC"0" AND ASC(MID
$(t$,pos%,1))>ASC"9" THEN ok%=FALSE
870NEXT
880=ok%
890DEF FNrec`size
900=name%+2+object%+2+date%+2+time%+2+
vis%+2+inst%+2+notes%+2
910DEF FNmenu
920PROCtitle
930PRINT CHR$129;"0)";CHR$131;"Open a
new file of observations"
940PRINT CHR$129;"1)";CHR$131;"Open an
old file of observations"
950PRINT CHR$129;"2)";CHR$131;"Enter s
ome new observations"
960PRINT CHR$129;"3)";CHR$131;"View th
e stored observations"
970PRINT CHR$129;"4)";CHR$131;"Amend t
he stored observations"
980PRINT CHR$129;"5)";CHR$131;"Close t
he current file"
990PRINT'CHR$131;"Which option do you
require?";CHR$129;
1000REPEAT
1010*FX21,0
1020key%=GET-48
1030UNTIL key%>=0 AND key%<=5
1040PRINT STR$(key%);
1050=key%
1060DEF PROCtitle
1070IF file$="None!" THEN rec%=0
1080VDU 26,12
1090PRINTTAB(0,0);CHR$129;CHR$157;CHR$1
31;CHR$141;"Astronomical Observations Da
tabase";
1100PRINTTAB(0,1);CHR$129;CHR$157;CHR$1
31;CHR$141;"Astronomical Observations Da
tabase";
1110PRINTTAB(0,2);CHR$131;CHR$157;CHR$1
29;"by Steven Flintham";TAB(24,2);"File:
";file$;SPC(9-LEN(file$));
1120PRINTTAB(0,23);CHR$129;CHR$157;CHR$
131;:IF T% THEN PRINT "G.M.T. : ";FNGMT;
" Date : ";FNdate;:PRINTTAB(0,22);CHR$1
31;CHR$157;CHR$129;
1130PRINT "Observations in file : ";STR
$(rec%);" / ";STR$(mrec%);" ";
1140VDU 28,0,20,39,4
1150ENDPROC
1160DEF PROCnew`file
1170IF file$<>"None!" THEN PRINT''CHR$1
31;"A file is already open. Press SPACE.
":PROCoscli("FX21,0"):REPEAT UNTIL GET=3
2:ENDPROC
1180PRINT''CHR$131;"Press RETURN on its
own to quit."
1190PRINT'CHR$131;"Please enter the dir
ectory for the new ";CHR$131;"file. The
directory is ";
1200file$=FNinput2(1)+"."
1210IF file$="." THEN file$="None!":END
PROC
1220PRINT'CHR$131;"Please enter the fil
ename for the new ";CHR$131;"file. The
filename is ";
1230file$=file$+FNinput2(7)
1240IF LEN(file$)=2 THEN file$="None!":
ENDPROC
1250file%=OPENIN(file$)
1260IF file%<>0 THEN IF NOT FNsure THEN
CLOSE #file%:file$="None!":ENDPROC
1270CLOSE #file%
1280PRINT'CHR$131;"Please wait whilst I
create the file...";
1290PROCoscli("SAVE "+file$+" 0000 + "+
STR$÷((mrec%*rsize%)+extra%))
1300rec%=0
1310file%=OPENUP(file$)
1320PRINT'CHR$131;"File created. Press
SPACE."
1330*FX21,0
1340REPEAT UNTIL GET=32
1350ENDPROC
1360DEF FNinput(len%):=FNinput3(len%,FA
LSE)
1370DEF FNinput2(len%):=FNinput3(len%,T
RUE)
1380DEF FNinput3(length%,blank%)
1390LOCAL pos%,vpos%
1400pos%=POS:vpos%=VPOS
1410?&C00=&30
1420?&C01=&0C
1430?&C02=length%
1440?&C03=32
1450?&C04=127
1460A%=0:X%=&00:Y%=&0C:CALL &FFF1
1470IF LEN($&C30)=0 AND NOT blank% THEN
PRINTTAB(pos%,vpos%);:GOTO 1410
1480=$&C30
1490DEF FNsure
1500PRINT:=FNyesno("Are you sure?")
1510DEF FNyesno(text$)
1520PRINT CHR$131;text$;" (Y/N) ";
1530REPEAT
1540key$=CHR$((GET AND &DF))
1550UNTIL key$="Y" OR key$="N"
1560IF key$="Y" THEN PRINT "Yes" ELSE P
RINT "No"
1570=(key$="Y")
1580DEF PROCclose`file
1590IF file$="None!" THEN PRINT''CHR$13
1;"No file is open. Press SPACE.":PROCos
cli("FX21,0"):REPEAT UNTIL GET=32:ENDPRO
C
1600PRINT:IF NOT FNsure THEN ENDPROC
1610PRINT'CHR$131;"I am closing the fil
e..."
1620PTR #file%=0
1630PRINT #file%,rec%
1640CLOSE #file%
1650file$="None!"
1660PRINT'CHR$131;"The file is now clos
ed. Press SPACE."
1670*FX21,0
1680REPEAT UNTIL GET=32
1690ENDPROC
1700DEF PROCold`file
1710IF file$<>"None!" THEN PRINT''CHR$1
31;"A file is already open. Press SPACE.
":PROCoscli("FX21,0"):REPEAT UNTIL GET=3
2:ENDPROC
1720PRINT''CHR$131;"Press RETURN on its
own to quit."
1730PRINT'CHR$131;"Please enter the dir
ectory of the old ";CHR$131;"file. The
directory is ";
1740file$=FNinput2(1)+"."
1750IF file$="." THEN file$="None!":END
PROC
1760PRINT'CHR$131;"Please enter the fil
ename of the old ";CHR$131;"file. The
filename is ";
1770file$=file$+FNinput2(7)
1780IF LEN(file$)=2 THEN file$="None!":
ENDPROC
1790file%=OPENIN(file$)
1800IF file%=0 THEN file$="None!":CLOSE
#file%:PRINT'CHR$131;"This file does no
t exist. Press SPACE.";:PROCoscli("FX21,
0"):REPEAT UNTIL GET=32:ENDPROC
1810CLOSE #file%:file%=OPENUP(file$)
1820INPUT #file%,rec%
1830PRINT'CHR$131;"File re-opened. Pres
s SPACE."
1840*FX21,0
1850REPEAT UNTIL GET=32
1860ENDPROC
1870DEF PROCplace`head(at%)
1880PTR #file%=extra%+(rsize%*at%)
1890ENDPROC
1900DEF PROCenter`obs
1910IF file$="None!" THEN PRINT''CHR$13
1;"No file is open. Press SPACE.":PROCos
cli("FX21,0"):REPEAT UNTIL GET=32:ENDPRO
C
1920IF rec%=mrec% THEN PRINT''CHR$131;"
The file is full. Press SPACE.":PROCoscl
i("FX21,0"):REPEAT UNTIL GET=32:ENDPROC
1930PROCtitle
1940PROCplace`head(rec%)
1950PRINT CHR$131;"Press RETURN for the
default which is ";CHR$131;"shown in";
CHR$129;"red";CHR$131;"if available."
1960PRINT'CHR$131;"Press ESCAPE to retu
rn to the menu."
1970ON ERROR IF ERR=17 THEN PROCdisable
:GOTO 90 ELSE MODE 7:CLOSE #0:REPORT:PRI
NT" at line ";ERL:PROCenable:END
1980*FX229,0
1990PRINT'CHR$129;"Observer:";name$
2000PRINT CHR$131;"Observer:";:P%=POS:V
%=VPOS:obs$=FNinput2(name%)
2010IF obs$="" THEN obs$=name$:PRINTTAB
(P%,V%);name$
2020PRINTTAB(0,V%+2);CHR$131;"Object:";
:obj$=FNinput(object%)
2030IF T% THEN D$=FNdate
2040REPEAT
2050PROCtitle
2060satis%=TRUE
2070PRINT:IF T% THEN PRINT CHR$129;"Dat
e:";D$
2080PRINT CHR$131;"Date:";:P%=POS:V%=VP
OS
2090IF T% THEN date$=FNinput2(date%) EL
SE date$=FNinput(date%)
2100IF date$="" THEN PRINTTAB(P%,V%);D$
:date$=D$ ELSE I$=date$:date$=FNconvert(
date$):IF I$<>date$ THEN PRINT CHR$131;"
Date:";date$'';:satis%=FNyesno("Is this
alright?")
2110UNTIL FNdate`ok(date$) AND satis%
2120REPEAT
2130PROCtitle
2140satis%=TRUE
2150PRINT'CHR$131;"Time:";:time$=FNinpu
t(time%)
2160T$=time$:time$=FNt`conv(time$):IF T
$<>time$ THEN PRINT CHR$131;"Time:";time
$'';:satis%=FNyesno("Is this alright?")
2170UNTIL satis%
2180PRINT'CHR$131;"Visibility? (1) Exce
llent to"'CHR$131;"(5) Very poor"
2190REPEAT:PRINT CHR$131;"Visibility:";
:vis$=FNinput(vis%)
2200UNTIL VAL(vis$)>=1 AND VAL(vis$)<=5
2210PRINT'CHR$129;"Instrument:"'CHR$129
;instrument$
2220PRINT CHR$131;"Instrument:"'CHR$131
;:P%=POS:V%=VPOS:inst$=FNinput2(inst%)
2230IF inst$="" THEN inst$=instrument$:
PRINTTAB(P%,V%);inst$
2240PROCtitle
2250VDU 26:FOR line%=3 TO 20:PRINTTAB(0
,line%);CHR$131;:NEXT:VDU 28,1,20,39,4,3
0
2260PRINT "Notes:";:notes$=FNinput(note
s%)
2270PRINT'"Storing observation..."
2280*FX229,1
2290ON ERROR MODE 7:CLOSE #0:REPORT:PRI
NT" at line ";ERL:PROCenable:END
2300PROCwrite`data
2310PRINT'"Observation stored. Press SP
ACE."
2320*FX21,0
2330REPEAT UNTIL GET=32
2340rec%=rec%+1
2350ENDPROC
2360DEF PROCwrite`data
2370PRINT #file%,obs$:PRINT #file%,obj$
2380PRINT #file%,date$:PRINT #file%,tim
e$
2390PRINT #file%,vis$:PRINT #file%,inst
$
2400PRINT #file%,notes$
2410ENDPROC
2420DEF PROCread`data
2430INPUT #file%,obs$:INPUT #file%,obj$
2440INPUT #file%,date$:INPUT #file%,tim
e$
2450INPUT #file%,vis$:INPUT #file%,inst
$
2460INPUT #file%,notes$
2470ENDPROC
2480DEF FNconvert(conv$)
2490LOCAL new$,pos%,char$,pos1%,pos2%,d
ay$,month$,year$,div%
2500new$=""
2510FOR pos%=1 TO LEN(conv$)
2520char$=MID$(conv$,pos%,1)
2530IF char$="/" THEN new$=new$+"/"
2540IF char$=":" THEN new$=new$+"/"
2550IF char$="." THEN new$=new$+"/"
2560IF char$<>"/" AND char$<>":" AND ch
ar$<>"." THEN new$=new$+char$ ELSE div%=
div%+1
2570NEXT
2580IF div%<>2 THEN ="01/01/1989"
2590pos1%=INSTR(new$,"/")
2600pos2%=INSTR(new$,"/",pos1%+1)
2610day$=LEFT$(new$,pos1%-1)
2620month$=MID$(new$,pos1%+1,pos2%-pos1
%-1)
2630year$=MID$(new$,pos2%+1)
2640IF LEN(day$)>2 THEN day$=RIGHT$(day
$,2)
2650IF LEN(day$)=0 THEN day$="01"
2660IF LEN(day$)=1 THEN day$="0"+day$
2670IF LEN(month$)=0 THEN month$="01"
2680IF LEN(month$)=1 THEN month$="0"+mo
nth$
2690IF LEN(month$)>2 THEN month$=RIGHT$
(month$,2)
2700IF LEN(year$)>4 THEN year$=RIGHT$(y
ear$,4)
2710IF LEN(year$)=2 THEN year$="19"+yea
r$
2720IF LEN(year$)<4 THEN year$="1989"
2730=day$+"/"+month$+"/"+year$
2740DEF FNdate`ok(check$)
2750IF LEN(check$)<>10 THEN =FALSE
2760pos1%=INSTR(check$,"/")
2770pos2%=INSTR(check$,"/",pos1%+1)
2780IF pos1%<>3 THEN =FALSE
2790IF pos2%<>6 THEN =FALSE
2800day%=VAL(LEFT$(check$,2))
2810month%=VAL(MID$(check$,4,2))
2820year%=VAL(RIGHT$(check$,4))
2830IF year%<1989 THEN =FALSE
2840IF month%<1 OR month%>12 THEN =FALS
E
2850dim%=FNd`i`m(month%)
2860IF month%=2 THEN =FNfeb`ok(day%,yea
r%)
2870IF day%<1 OR day%>dim% THEN =FALSE
2880=TRUE
2890DEF FNfeb`ok(d%,y%)
2900dim%=28
2910IF y%/4=INT(y%/4) AND y%/100<>INT(y
%/100) THEN dim%=29
2920IF y%/4=INT(y%/4) AND y%/400=INT(y%
/400) THEN dim%=29
2930IF d%<1 OR d%>dim% THEN =FALSE
2940=TRUE
2950DEF FNd`i`m(mon%)
2960RESTORE
2970FOR read%=1 TO mon%:READ d%:NEXT
2980=d%
2990DATA 31,28,31,30,31,30,31,31,30,31,
30,31
3000DEF FNt`conv(t$)
3010new$=""
3020FOR pos%=1 TO LEN(t$)
3030char$=MID$(t$,pos%,1)
3040IF char$="/" OR char$="." OR char$=
":" THEN new$=new$+":" ELSE new$=new$+ch
ar$
3050NEXT
3060pos%=INSTR(new$,":")
3070hour%=VAL(LEFT$(new$,pos%-1))
3080min%=VAL(MID$(new$,pos%+1))
3090IF hour%<0 THEN hour%=0
3100IF hour%>23 THEN hour%=23
3110IF min%<0 THEN min%=0
3120IF min%>59 THEN min%=59
3130hour$=STR$(hour%):min$=STR$(min%)
3140IF LEN(hour$)=1 THEN hour$="0"+hour
$
3150IF LEN(min$)=1 THEN min$="0"+min$
3160=hour$+":"+min$
3170DEF PROCview`obs
3180IF file$="None!" THEN PRINT''CHR$13
1;"No file is open. Press SPACE.":PROCos
cli("FX21,0"):REPEAT UNTIL GET=32:ENDPRO
C
3190IF rec%=0 THEN PRINT''CHR$131;"Ther
e are no stored observations."'CHR$131;"
Press SPACE.":PROCoscli("FX21,0"):REPEAT
UNTIL GET=32:ENDPROC
3200view%=0
3210REPEAT
3220PROCplace`head(view%)
3230PROCread`data
3240PROCtitle
3250PRINTTAB(0,0);CHR$131;"Observation:
";STR$(view%+1)
3260PRINTTAB(0,1);CHR$131;"Observer:";o
bs$
3270PRINTTAB(0,2);CHR$131;"Object:";obj
$
3280PRINTTAB(0,3);CHR$131;"Date:";date$
3290PRINTTAB(0,4);CHR$131;"Time:";time$
3300PRINTTAB(0,5);CHR$131;"Visibility (
1=Excellent,5=Very poor):";vis$
3310PRINTTAB(0,6);:PROCprint("Instrumen
t:"+inst$,131)
3320PRINTTAB(0,8);CHR$131;"Notes:";:PRO
Cprint(notes$,131)
3330PRINTTAB(0,16);CHR$131;"(N)ext reco
rd,(L)ast record,(M)enu";
3340REPEAT
3350*FX21,0
3360key$=CHR$((GET AND &DF))
3370UNTIL key$="N" OR key$="L" OR key$=
"M"
3380IF key$="N" AND view%<rec%-1 THEN v
iew%=view%+1
3390IF key$="L" AND view%>0 THEN view%=
view%-1
3400UNTIL key$="M"
3410ENDPROC
3420DEF PROCprint(p$,C%)
3430LOCAL W%,K%,L%,P%,r$,w$
3440W%=39:VDU C%
3450REPEAT K%=INSTR(p$," ")
3460IF K%=0 K%=LEN(p$)
3470w$=LEFT$(p$,K%):P%=POS
3480p$=RIGHT$(p$,LENp$-K%)
3490IF P%+K%>W% OR P%>W% PRINT:VDU C%:P
%=0
3500FOR L%=1 TO LEN w$
3510VDU ASC(MID$(w$,L%)):NEXT
3520UNTIL p$="":ENDPROC
3530DEF PROCamend`obs
3540IF file$="None!" THEN PRINT''CHR$13
1;"No file is open. Press SPACE.":PROCos
cli("FX21,0"):REPEAT UNTIL GET=32:ENDPRO
C
3550IF rec%=0 THEN PRINT''CHR$131;"Ther
e are no stored observations."'CHR$131;"
Press SPACE.":PROCoscli("FX21,0"):REPEAT
UNTIL GET=32:ENDPROC
3560PROCtitle
3570PRINT CHR$131;"Press RETURN to quit
."
3580PRINT'CHR$131;"Which record do you
want to amend?"
3590REPEAT
3600PRINT'CHR$131;"Amend record ";:amen
d$=FNinput2(LEN(STR$(rec%)))
3610UNTIL amend$="" OR (VAL(amend$)>=1
AND VAL(amend$)<=rec%)
3620IF amend$="" THEN ENDPROC
3630amend%=VAL(amend$)-1
3640PROCtitle
3650PROCplace`head(amend%)
3660PROCread`data
3670PRINT CHR$131;"Press RETURN to leav
e item alone."
3680PRINT'CHR$131;"Observer:";obs$
3690PRINT CHR$131;"Observer:";:P%=POS:V
%=VPOS:o$=FNinput2(name%)
3700IF o$<>"" THEN obs$=o$ ELSE PRINTTA
B(P%,V%);obs$
3710PRINT'CHR$131;"Object:";obj$
3720PRINT CHR$131;"Object:";:P%=POS:V%=
VPOS:o$=FNinput2(object%)
3730IF o$<>"" THEN obj$=o$ ELSE PRINTTA
B(P%,V%);obj$
3740REPEAT
3750satis%=TRUE
3760PROCtitle
3770PRINT CHR$131;"Date:";date$
3780PRINT CHR$131;"Date:";:P%=POS:V%=VP
OS:d2$=FNinput2(date%)
3790IF d2$="" THEN PRINTTAB(P%,V%);date
$:d2$=date$
3800d3$=FNconvert(d2$)
3810IF d2$<>d3$ THEN PRINT CHR$131;"Dat
e:";d3$'';:satis%=FNyesno("Is this alrig
ht?")
3820UNTIL satis% AND FNdate`ok(d3$)
3830date$=d3$
3840REPEAT
3850PROCtitle
3860satis%=TRUE
3870PRINT CHR$131;"Time:";time$
3880PRINT CHR$131;"Time:";:P%=POS:V%=VP
OS:t2$=FNinput2(time%)
3890IF t2$="" THEN PRINTTAB(P%,V%);time
$:t2$=time$
3900t3$=FNt`conv(t2$)
3910IF t3$<>t2$ THEN PRINT CHR$131;"Tim
e:";t3$'';:satis%=FNyesno("Is this alrig
ht?")
3920UNTIL satis%
3930time$=t3$
3940PRINT'CHR$131;"Visibility (1=Excell
ent,5=Very poor):";vis$
3950REPEAT
3960PRINT CHR$131;"Visibility:";:P%=POS
:V%=VPOS:v$=FNinput2(vis%)
3970UNTIL (VAL(v$)>=1 AND VAL(v$)<=5) O
R v$=""
3980IF v$="" THEN PRINTTAB(P%,V%);vis$
ELSE vis$=v$
3990PRINT'CHR$131;"Instrument:"'CHR$131
;inst$
4000PRINT CHR$131;"Instrument:"'CHR$131
;:P%=POS:V%=VPOS:in$=FNinput2(inst%)
4010IF in$="" THEN PRINTTAB(P%,V%);inst
$ ELSE inst$=in$
4020PROCtitle
4030VDU 26:FOR line%=3 TO 20:PRINTTAB(0
,line%);CHR$131;:NEXT:VDU 28,1,20,39,4,3
0
4040PRINT "Notes:";notes$
4050PRINT'"Notes:";:P%=POS:V%=VPOS:n$=F
Ninput2(notes%)
4060IF n$="" THEN PRINTTAB(P%,V%);notes
$ ELSE notes$=n$
4070PRINT'"Storing observation..."
4080PROCplace`head(amend%)
4090PROCwrite`data
4100PRINT'"Observation stored. Press SP
ACE."
4110*FX21,0
4120REPEAT UNTIL GET=32
4130ENDPROC