10REM > ArcOverlay  (C) BBC tv and Peter Vince  14/4/89
   20REM Weather Satellite image display and overlay program for Archimedes
   30 
   40REM Ensure there is room on disc for final image
   50*CREATE"a" A0B8
   60*DELETE"a"
   70 
   80ON ERROR ON ERROR OFF:PRINTTAB(0,28);:REPORT:GOTO570
   90DIM Z% 360
  100 
  110MODE 14
  120*CAT
  130INPUT'"Enter name of file to be drawn ";infyl$
  140S%=OPENINinfyl$
  150IF S%=0 THEN PRINT"Data file """;infyl$;""" not found.";CHR$7:END
  160 
  170PTR#S%=2
  180IF BGET#S%<3 OR BGET#S%-&84 OR BGET#S%-16 THEN format=FALSE ELSE format=TRUE
  190width=BGET#S% + BGET#S%*256
  200height=BGET#S% + BGET#S%*256
  210IF (width=276 AND height=200) OR (width=320 AND height=256) OR (width=360 AND height=288) THEN size=TRUE ELSE size=FALSE
  220PTR#S%=17
  230IF format=FALSE OR size=FALSE OR (BGET#S%AND7)-3 THEN PRINT'"Data using incompatible format -"'"cannot decode."';CHR$7:CLOSE#S%:END
  240 
  250message%=BGET#S%
  260IF message% AND 1 THEN ident$=FNgetstring  ELSE GOTO290
  270IF message% AND 16 THEN PRINT'new$
  280 
  290creditflag%=BGET#S%
  300IF creditflag% AND 1 THEN credit$=FNgetstring  ELSE credit$="" : GOTO330
  310IF creditflag% AND 16 THEN PRINT'new$
  320 
  330IF ((message% OR creditflag%) AND 16) = 0 THEN 370
  340PRINT'"Press the Space-Bar to continue...";
  350REPEAT UNTIL GET=32
  360 
  370MODE9
  380VDU23,1,0;0;0;0;
  390COLOUR 132:CLS
  400IF (width=276 AND height=200) THEN window=TRUE ELSE window=FALSE : GOTO430
  410VDU 24,72;96;1207;927; :GCOL0,140:CLG
  420VDU 24,88;112;1191;911;:GCOL0,132:CLG:VDU26
  430PROCheader
  440PTR#S%=0 : PTR#S% = BGET#S% + BGET#S%*256
  450 
  460FOR V% = (0-window*112) TO (1020+window*112) STEP 4
  470MOVE (1280+window*88),V%
  480PROCfill
  490FOR I%=P% TO (360+window*80):Z%?I%=C%:NEXT
  500IF L% THEN PROClineover ELSE PROClinegrey
  510NEXT
  520 
  530OSCLI("SCREENSAVE "+outfyl$)
  540COLOUR 12
  550PRINTTAB(1,30)" Saved as ";outfyl$;TAB(39);
  560IF window THEN PRINTTAB(39);
  570VDU23,1,1;0;0;0; 31,0,31
  580CLOSE#0
  590END
  600 
  610DEFPROClineover
  620FOR P%=0 TO (319+window*44)
  630C%=Z%?P%
  640IF C%<2 THEN PLOT64,-4,0 ELSE GCOL0,17-C% : PLOT65,-4,0
  650NEXT
  660ENDPROC
  670 
  680DEFPROClinegrey
  690FOR P%=0 TO (319+window*44)
  700GCOL0,Z%?P%
  710PLOT65,-4,0
  720NEXT
  730ENDPROC
  740 
  750DEFPROCfill
  760B%=&FF:P%=0
  770REPEAT
  780O%=B%
  790B%=BGET#S%
  800C%=B%AND15
  810W%=B%DIV16
  820IF C%=O% THEN UNTIL TRUE : ENDPROC
  830IF W%=15 THEN W%=BGET#S%+15 : IF W%=270 THEN W%=BGET#S%+270
  840FOR P%=P% TO P%+W% : Z%?P%=C% : NEXT
  850UNTIL FALSE
  860 
  870DEFPROCheader
  880GCOL0,12:GCOL0,132
  890source$=FNgetstring
  900rad%=BGET#S%
  910date$=FNgetstring
  920time$=FNgetstring
  930jd$=FNgetstring
  940B%=BGET#S% : area=B% AND &7F : overlay=B% AND &80
  950 
  960IF jd$="" THEN outfyl$="NODATE" ELSE outfyl$=LEFT$(jd$,7)+MID$(jd$,9,2)
  970IF area>0 AND area<5 THEN prefix$=MID$("waeb",area,1) ELSE prefix$="?"
  980outfyl$=prefix$+outfyl$
  990 
 1000IF overlay THEN outfyl$="LandMas"+LEFT$(infyl$,3) : L%=0 : GOTO 1050
 1010 
 1020L%=OPENIN("LandMas"+MID$(infyl$,4,3))
 1030IF L% THEN CLOSE#L% : OSCLI("SCREENLOAD LandMas"+MID$(infyl$,4,3)) : IF window THEN COLOUR 132 : PRINTTAB(0,30);SPC(40);
 1040 
 1050IF (message%AND12)=0 THEN 1150
 1060IF (message%AND3)<>3 THEN title$=source$ ELSE title$=ident$
 1070IF message%AND2 THEN 1120
 1080 
 1090IF rad%>0 AND rad%<5 THEN title$=title$+" "+MID$(" IRVZWVRD",rad%*2,2)
 1100IF date$<>"" THEN title$=title$+"  "+LEFT$(date$,2)+"/"+MID$(date$,3,2)+"/"+MID$(date$,5)
 1110IF time$<>"" THEN title$=title$+" "+LEFT$(time$,2)+":"+MID$(time$,3)
 1120MOVE 640-LEN(title$)*16,924+window*864
 1130VDU 5 : PRINT title$
 1140 
 1150IF credit$="" OR (creditflag%AND7)<>7 THEN 1190
 1160MOVE 640-LEN(credit$)*16,988
 1170VDU 5 : PRINT credit$
 1180 
 1190PTR#S%=PTR#S%+33 : REM Skip projection, mapping, and source grey scale
 1200IF L% THEN PTR#S%=PTR#S%+6 : FOR I%=2 TO 15 : ELSE FOR I%=0 TO 15
 1210COLOUR I%,BGET#S%,BGET#S%,BGET#S%
 1220NEXT
 1230VDU 4, 23,1,0;0;0;0;
 1240ENDPROC
 1250 
 1260DEFFNgetstring
 1270new$=""
 1280REPEAT
 1290C%=BGET#S%
 1300IF C% THEN new$=new$+CHR$C%
 1310UNTIL C%=0
 1320=new$