10REM > SatShow  Weather satellite file header analyser
   20REM (C) BBC tv and Peter Vince  16/2/89
   30REM Suitable for Master, Archimedes, or 2nd Processor, but not Model A/B
   40 
   50*CAT
   60INPUT'"Enter name of file for analysis "filename$
   70IF LEFT$(filename$,1)<>"*" THEN 120
   80OSCLI(filename$)
   90PRINTTAB(0,24)"Press a key to continue...";
  100IF GET THEN 50
  110 
  120S%=OPENINfilename$
  130IF S%=0 THEN PRINTfilename$;" not found.";CHR$7:END
  140 
  150MODE 131
  160VDU 23,0,10,104,0;0;0; 23,0,11,72,0;0;0;
  170VDU 19,1,3;0;
  180PRINTTAB(13)"Analysis of header on Weather satellite file '";filename$;"'"
  190 
  200PTR#S%=2 : format%=BGET#S% : PTR#S%=0
  210IF format%<3 THEN length%=BGET#S%*256 + BGET#S% ELSE length%=BGET#S% + BGET#S%*256
  220IF format%<2 THEN length%=length%+2
  230PRINT'"Header size ..................... ";length%;" (&";~length%;")"
  240 
  250IF format%<2 THEN format%=BGET#S%*256 + BGET#S% ELSE format%=BGET#S%
  260IF format%=2 THEN PRINT'"Old Telesoftware format, no longer supported."':END
  270PRINT"Format .......................... ";
  280 
  290IF PTR#S%=3 THEN PROCtelesoft ELSE PROCmetoffice
  300 
  310IF PTR#S%>length% THEN PRINT" *** Pointer beyond supposed length of header! ***":GOTO390
  320PRINT"Filler bytes (Hex) .............. ";
  330IF PTR#S%=length% THEN PRINT"<none>":GOTO390
  340REPEAT
  350PRINT RIGHT$("0"+STR$~BGET#S%,2);", ";
  360UNTIL PTR#S%=length%
  370PRINT CHR$127;CHR$127
  380 
  390size%=EXT#S%
  400PRINT"File size ....................... ";size%;" (&";~size%;")"
  410CLOSE#S%
  420 
  430PRINT TAB(0,24)"Print screen? ";
  440IF (GET AND &DF)=ASC"Y" THEN PRINT"Yes ";:PROCscreenprint
  450PRINT TAB(0,24);SPC(30);CHR$13;
  460END
  470 
  480 
  490DEFPROCmetoffice
  500PRINT;format%;" - Met.Office format"
  510 
  520sat$=""
  530FOR I%=1 TO 5
  540sat$=sat$+CHR$(BGET#S%)
  550NEXT
  560IF sat$="METEO" THEN sat$="Meteosat"
  570IF sat$="NOAA7" THEN sat$="NOAA-7"
  580IF sat$="GOESE" THEN sat$="GOES-East"
  590PRINT"Satellite ....................... ";sat$
  600 
  610C%=BGET#S%
  620channel$="(Unknown - "+CHR$C%+")"
  630IF C%=ASC"I" THEN channel$="Infra Red"
  640IF C%=ASC"V" THEN channel$="Visible"
  650IF C%=ASC"W" THEN channel$="Water Vapour"
  660IF C%=ASC"D" THEN channel$="Digital"
  670IF C%=ASC"N" THEN channel$="Rainfall Radar"
  680PRINT"Channel ......................... ";channel$
  690 
  700date$=CHR$(BGET#S%)+CHR$(BGET#S%)
  710date$=CHR$(BGET#S%)+CHR$(BGET#S%)+"/"+date$
  720date$=CHR$(BGET#S%)+CHR$(BGET#S%)+"/"+date$
  730null2$=CHR$0+CHR$0
  740IF date$=null2$+"/"+null2$+"/"+null2$ THEN date$="<none>"
  750PRINT"Date ............................ ";date$
  760 
  770time$=""
  780FOR I%=1 TO 6
  790time$=time$+CHR$(BGET#S%)
  800IF I%=2 OR I%=4 THEN time$=time$+":"
  810NEXT
  820IF time$=null2$+":"+null2$+":"+null2$ THEN time$="<none>"
  830PRINT"Time ............................ ";time$
  840 
  850map%=BGET#S%*256+BGET#S%
  860map$="(Unknown - &"+STR$~map%+")"
  870IF map%=0 THEN map$="Space View"
  880IF map%=1 THEN map$="Stretched Space View"
  890IF map%=2 THEN map$="Polar Stereographic"
  900IF map%=3 THEN map$="Cartesian"
  910PRINT"Map projection .................. ";map$
  920 
  930PRINT"Mapping parameters .............. ";
  940FOR I%=1 TO 4
  950mapping=BGET#S%*256+BGET#S%
  960IF mapping>32767 THEN value$=STR$(mapping-65536) ELSE value$=" "+STR$(mapping)
  970PRINT value$;
  980IF I%<4 THEN PRINT",";TAB(I%*8+34); ELSE PRINT
  990NEXT
 1000 
 1010FOR J%=1 TO 2
 1020PRINT"Registration point ";J%;" parameters.. ";
 1030FOR I%=1 TO 4
 1040regpt=BGET#S%*256+BGET#S%
 1050IF regpt>32767 THEN value$=STR$(regpt-65536) ELSE value$=" "+STR$(regpt)
 1060PRINT value$;
 1070IF I%<4 THEN PRINT",";TAB(I%*8+34); ELSE PRINT
 1080NEXT
 1090NEXT
 1100 
 1110pixels=BGET#S%*256+BGET#S%
 1120IF pixels>32767 THEN pixels=pixels-65536
 1130PRINT"Number of pixels per raster ..... ";pixels
 1140 
 1150coding=BGET#S%*256+BGET#S%
 1160IF coding>32767 THEN coding=coding-65536
 1170PRINT"Data coding ..................... ";coding;
 1180code$="Unknown!"
 1190IF coding=1 THEN code$="One pixel per byte"
 1200IF coding=2 THEN code$="Two pixels per byte"
 1210IF coding=-1 THEN code$="Run Length, two bytes per run"
 1220IF coding=-2 THEN code$="Run Length, one byte per run"
 1230PRINT"  ";code$
 1240 
 1250bpp=BGET#S%*256+BGET#S%
 1260IF bpp>32767 THEN bpp=bpp-65536
 1270PRINT"Bits per pixel .................. ";bpp
 1280 
 1290record=BGET#S%*256+BGET#S%
 1300IF record>32767 THEN record=record-65536
 1310PRINT"Bytes per record ................ ";record
 1320 
 1330rasters=BGET#S%*256+BGET#S%
 1340PRINT"Rasters in this image ........... ";rasters
 1350 
 1360PRINT"Grey scale (hex)  ";
 1370FOR I%=1 TO 15
 1380PRINT RIGHT$("0"+STR$~(BGET#S%),2);", ";
 1390NEXT
 1400PRINTCHR$127;CHR$127
 1410 
 1420scan=BGET#S%
 1430PRINT"Scanning direction .............. ";
 1440PRINT"&";~scan;"  ";
 1450IF scan AND 4 THEN PRINT"Col by Col, "; ELSE PRINT"Row by Row, ";
 1460IF scan AND 2 THEN PRINT"Bottom to Top, "; ELSE PRINT"Top to Bottom, ";
 1470IF scan AND 1 THEN PRINT"Right to Left" ELSE PRINT"Left to Right"
 1480 
 1490aspect=BGET#S%*256+BGET#S%
 1500IF aspect>32767 THEN aspect=aspect-65536
 1510PRINT"Aspect ratio .................... ";aspect
 1520 
 1530ENDPROC
 1540 
 1550 
 1560DEFPROCtelesoft
 1570PRINT;~format%;" - Telesoftware format"
 1580 
 1590coding=BGET#S%
 1600PRINT"Data coding ..................... &";~coding;
 1610code$="Unknown!"
 1620IF coding=1 THEN code$=" One pixel per byte"
 1630IF coding=2 THEN code$=" Two pixels per byte"
 1640IF coding=&81 THEN code$="Run Length, two bytes per pixel"
 1650IF coding=&82 THEN code$="Run Length, one byte per pixel"
 1660IF coding=&83 THEN code$="Enhanced Run Length, two bytes per run"
 1670IF coding=&84 THEN code$="Enhanced Run Length, one byte per run"
 1680PRINT"  ";code$
 1690 
 1700grad=BGET#S%
 1710PRINT"Tonal Gradation ................. ";grad
 1720 
 1730PRINT"Image Definition ................ ";
 1740pixels=BGET#S%+BGET#S%*256
 1750PRINT;pixels;" pixels by ";
 1760 
 1770lines=BGET#S%+BGET#S%*256
 1780PRINT;lines;" lines"
 1790 
 1800xoffset=BGET#S%+BGET#S%*256 : IF xoffset>32767 THEN xoffset=xoffset-65536
 1810yoffset=BGET#S%+BGET#S%*256 : IF yoffset>32767 THEN yoffset=yoffset-65536
 1820PRINT"X & Y offsets from edge ......... x = ";xoffset;"   y = ";yoffset
 1830 
 1840PRINT"Border bytes .................... ";
 1850PRINT"Height &";RIGHT$("0"+STR$~(BGET#S%),2);
 1860PRINT", Colour &";RIGHT$("0"+STR$~(BGET#S%),2);
 1870PRINT", Width &";RIGHT$("0"+STR$~(BGET#S%),2);
 1880PRINT", Colour &";RIGHT$("0"+STR$~(BGET#S%),2)
 1890 
 1900scan=BGET#S%
 1910PRINT"Scanning direction .............. &";~scan;"  ";
 1920IF scan<16 THEN PRINT" ";
 1930IF scan AND 4 THEN PRINT"Col by Col, "; ELSE PRINT"Row by Row, ";
 1940IF scan AND 2 THEN PRINT"Bottom to Top, "; ELSE PRINT"Top to Bottom, ";
 1950IF scan AND 1 THEN PRINT"Right to Left" ELSE PRINT"Left to Right"
 1960 
 1970PRINT"Screen ident flag/message ....... ";
 1980identflag=BGET#S%
 1990PRINT"&";STR$~identflag;" -  ";
 2000IF (identflag AND 1) = 0 THEN PRINT"<no text>":GOTO 2070
 2010PRINTCHR$34;
 2020REPEAT C%=BGET#S% : IF C%=0 THEN 2040
 2030IF C%>31 AND C%<127 THEN PRINTCHR$C%; ELSE PRINT".";
 2040UNTIL C%=0
 2050PRINTCHR$34;:IF POS>36 THEN PRINT ELSE PRINTCHR$13;
 2060 
 2070PRINT"Source credit flag/message ...... ";
 2080sourceflag=BGET#S%
 2090PRINT"&";STR$~sourceflag;" -  ";
 2100IF (sourceflag AND 1) = 0 THEN PRINT"<no text>":GOTO 2170
 2110PRINTCHR$34;
 2120REPEAT C%=BGET#S% : IF C%=0 THEN 2140
 2130IF C%>31 AND C%<127 THEN PRINTCHR$C%; ELSE PRINT".";
 2140UNTIL C%=0
 2150PRINTCHR$34;:IF POS>36 THEN PRINT ELSE PRINTCHR$13;
 2160 
 2170sat$=""
 2180REPEAT
 2190C%=BGET#S%
 2200IF C%>31 AND C%<127 THEN sat$=sat$+CHR$(C%)
 2210UNTILC%=0
 2220PRINT"Satellite and Radiation type .... ";sat$;
 2230 
 2240radiation$="<Unknown>"
 2250C%=BGET#S%
 2260radiation$="&"+STR$~C%+" <Unknown>"
 2270IF C%=1 THEN radiation$="Infra Red"
 2280IF C%=2 THEN radiation$="Visible"
 2290IF C%=3 THEN radiation$="Water Vapour"
 2300IF C%=4 THEN radiation$="Rainfall Radar"
 2310IF C%=16 THEN radiation$="Digital"
 2320IF C%=255 THEN radiation$="Undefined"
 2330PRINT"  ";radiation$
 2340 
 2350PRINT"Date & Time ..................... ";
 2360date$=""
 2370REPEAT C%=BGET#S% : IF C%=0 THEN 2400
 2380IF C%<32 OR C%>126 THEN C%=ASC"."
 2390date$=date$+CHR$(C%)
 2400UNTIL C%=0
 2410IF date$="" THEN date$="<No Date>"
 2420 
 2430time$=""
 2440REPEAT C%=BGET#S% : IF C%=0 THEN 2470
 2450IF C%<32 OR C%>126 THEN C%=ASC"."
 2460time$=time$+CHR$(C%)
 2470UNTIL C%=0
 2480IF time$="" THEN time$="<No Time>"
 2490 
 2500IF date$="<No Date>" AND time$="<No Time>" THEN PRINT"<No Date or Time>" ELSE PRINT LEFT$(date$,2);"/";MID$(date$,3,2);"/";MID$(date$,5);"  ";LEFT$(time$,2);":";MID$(time$,3)
 2510 
 2520PRINT"Julian Day Number ............... ";
 2530jd$=""
 2540REPEAT C%=BGET#S% : IF C%=0 THEN 2570
 2550IF C%<32 OR C%>126 THEN C%=ASC"."
 2560jd$=jd$+CHR$(C%)
 2570UNTIL C%=0
 2580IF jd$<>"" THEN PRINT jd$;:PROCjulian ELSE PRINT"<none>"
 2590 
 2600C%=BGET#S%
 2610area$="(Unknown - &"+STR$~C%+")"
 2620IF (C%AND127)=1 THEN area$="World"
 2630IF (C%AND127)=2 THEN area$="North Atlantic"
 2640IF (C%AND127)=3 THEN area$="Europe"
 2650IF (C%AND127)=4 THEN area$="Britain"
 2660IF C%>127 THEN area$=area$+" (Overlay)"
 2670PRINT"Area depicted ................... ";area$
 2680 
 2690map%=BGET#S%
 2700map$="(Unknown - &"+STR$~map%+")"
 2710IF map%=1 THEN map$="Space View"
 2720IF map%=2 THEN map$="Polar Stereographic"
 2730IF map%=3 THEN map$="Cartesian"
 2740IF map%=4 THEN map$="Linear"
 2750PRINT"Map projection .................. ";map$
 2760 
 2770FOR J%=1 TO 2
 2780PRINT"Mapping co-ordinates - point ";J%;" .. ";
 2790FOR I%=1 TO 4
 2800coord=BGET#S%+BGET#S%*256
 2810IF coord>32767 THEN value$=STR$(coord-65536) ELSE value$=" "+STR$(coord)
 2820PRINT value$;
 2830IF I%<4 THEN PRINT",";TAB(I%*8+34); ELSE PRINT
 2840NEXT
 2850NEXT
 2860 
 2870PRINT"Grey scale (hex)  ";
 2880FOR I%=1 TO grad
 2890PRINT RIGHT$("0"+STR$~(BGET#S%),2);", ";
 2900NEXT
 2910PRINTCHR$127;CHR$127;CHR$8
 2920 
 2930PRINT"Display triplets  ";
 2940FOR I%=1 TO grad
 2950R%=BGET#S%:G%=BGET#S%:B%=BGET#S%
 2960PRINT RIGHT$("0"+STR$~G%,2);", ";
 2970NEXT
 2980PRINTCHR$127;CHR$127;CHR$8
 2990 
 3000annotate%=BGET#S%+BGET#S%*256
 3010PRINT"Number of post data-strings ..... ";annotate%
 3020 
 3030ENDPROC
 3040 
 3050 
 3060DEFPROCjulian
 3070REM Julian day number conversions, from "Astronomical Computing" by
 3080REM Roger W. Sinnott in the May 1984 Sky & Telescope magazine pp 454/5
 3090 
 3100J=VAL(LEFT$(jd$,7))
 3110F=VAL(RIGHT$(jd$,5))+.5
 3120IF F<1 THEN 3140
 3130F=F-1: J=J+1
 3140A1=INT((J/36524.25)-51.12264)
 3150A=J+1+A1-INT(A1/4)
 3160B=A+1524
 3170C=INT((B/365.25)-0.3343)
 3180D=INT(365.25*C)
 3190E=INT((B-D)/30.61)
 3200D=B-D-INT(30.61*E)+F
 3210M=E-1: Y=C-4716
 3220IF E>13.5 THEN M=M-12
 3230IF M<2.5 THEN Y=Y+1
 3240mins=INT(F*1440+.5)
 3250hrs=mins DIV60
 3260jdtim$=RIGHT$("0"+STR$hrs,2) + ":" + RIGHT$("0"+STR$(mins-hrs*60),2)
 3270RESTORE 3290 : FOR I%=0 TO J MOD7 : READ day$ : NEXT
 3280PRINT "   (";INT(D);"/";M;"/";Y MOD100;"  ";jdtim$;"  ";day$;"day)"
 3290DATA Mon,Tues,Wednes,Thurs,Fri,Satur,Sun
 3300ENDPROC
 3310 
 3320 
 3330DEFPROCscreenprint
 3340VDU 2
 3350*FX6
 3360 
 3370REM Check printer available
 3380VDU 1,0,1,0
 3390T%=TIME :REPEAT UNTIL TIME > T%+10
 3400IF ADVAL(-4)=63 THEN 3520
 3410 
 3420REM Not available, so display message, and return
 3430COLOUR 0 :COLOUR 129
 3440PRINT TAB(0,24)" Printer Off-Line ";CHR$7;CHR$3;
 3450COLOUR 1 :COLOUR 128
 3460C%=INKEY(500)
 3470REM Flush printer buffer...
 3480*FX21,3
 3490ENDPROC
 3500 
 3510 
 3520PRINT TAB(0,0);CHR$13;
 3530PRINT TAB(13)CHR$1;CHR$27;CHR$1;CHR$45;CHR$1;CHR$1;"Analysis of header on Weather satellite file '";filename$;CHR$1;CHR$27;CHR$1;CHR$45;CHR$1;CHR$0;"'"
 3540 
 3550A% = &87          :REM OSBYTE to find character at cursor
 3560 
 3570FOR Y% = 1 TO 23
 3580FOR X% = 0 TO 79
 3590 
 3600PRINT TAB(X%,Y%);
 3610C% = (USR(&FFF4) AND &FF00) DIV&100 :REM Read character at text cursor
 3620VDU 1,C%                            :REM and send it to the printer.
 3630 
 3640NEXT X%
 3650VDU 1,10 :REM Send Line Feed to printer (and hope it does a CR!)
 3660NEXT Y%
 3670 
 3680VDU 1,27,1,64,3 : REM Reset printer
 3690*FX21,0
 3700ENDPROC