10REM > ArcDisplay   Weather Satellite image display program for Archimedes
   20REM (C) BBC tv  and  Peter Vince  22/2/89
   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:GOTO670
   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;
  390 
  400REM Define colours for 'grey scale'
  410FOR I%=0 TO 15
  420C%=I%*16
  430COLOUR I%,C%,C%,C%
  440NEXT
  450COLOUR 12
  460 
  470COLOUR 132:CLS
  480IF (width=276 AND height=200) THEN window=TRUE ELSE window=FALSE : GOTO510
  490VDU 24,72;96;1207;927; :GCOL0,134:CLG
  500VDU 24,88;112;1191;911;:GCOL0,132:CLG:VDU26
  510PROCcaptions
  520PTR#S%=0 : PTR#S% = BGET#S% + BGET#S%*256
  530 
  540FOR V% = (0-window*112) TO (1020+window*112) STEP 4
  550MOVE (1280+window*88),V%
  560PROCfill
  570FOR I%=P% TO (360+window*80):Z%?I%=C%:NEXT
  580FOR P%=0 TO (319+window*44)
  590GCOL0,Z%?P%
  600PLOT65,-4,0
  610NEXT
  620NEXT
  630 
  640OSCLI("SCREENSAVE "+outfyl$)
  650PRINTTAB(1,30)" Saved as ";outfyl$;" "
  660IF window THEN PRINTTAB(39);
  670VDU23,1,1;0;0;0; 31,0,31
  680CLOSE#0
  690END
  700 
  710DEFPROCfill
  720B%=&FF:P%=0
  730REPEAT
  740O%=B%
  750B%=BGET#S%
  760C%=B%AND15
  770W%=B%DIV16
  780IF C%=O% THEN UNTIL TRUE : ENDPROC
  790IF W%=15 THEN W%=BGET#S%+15 : IF W%=270 THEN W%=BGET#S%+270
  800FOR P%=P% TO P%+W% : Z%?P%=C% : NEXT
  810UNTIL FALSE
  820 
  830DEFPROCcaptions
  840GCOL0,12:GCOL0,132
  850source$=FNgetstring
  860rad%=BGET#S%
  870date$=FNgetstring
  880time$=FNgetstring
  890 
  900IF (message%AND12)=0 THEN 1000
  910IF (message%AND3)<>3 THEN title$=source$ ELSE title$=ident$
  920IF message%AND2 THEN 970
  930 
  940IF rad%>0 AND rad%<5 THEN title$=title$+" "+MID$(" IRVZWVRD",rad%*2,2)
  950IF date$<>"" THEN title$=title$+"  "+LEFT$(date$,2)+"/"+MID$(date$,3,2)+"/"+MID$(date$,5)
  960IF time$<>"" THEN title$=title$+" "+LEFT$(time$,2)+":"+MID$(time$,3)
  970MOVE 640-LEN(title$)*16,924+window*864
  980VDU 5 : PRINT title$
  990 
 1000IF credit$="" OR (creditflag%AND7)<>7 THEN 1040
 1010MOVE 640-LEN(credit$)*16,988
 1020VDU 5 : PRINT credit$
 1030 
 1040jd$=FNgetstring
 1050IF jd$="" THEN outfyl$="NODATE" : GOTO1080
 1060outfyl$=LEFT$(jd$,7)+MID$(jd$,9,2)
 1070 
 1080area=BGET#S% AND &7F
 1090IF area>0 AND area<5 THEN prefix$=MID$("waeb",area,1) ELSE prefix$="?"
 1100outfyl$=prefix$+outfyl$
 1110 
 1120VDU 4, 23,1,0;0;0;0;
 1130ENDPROC
 1140 
 1150DEFFNgetstring
 1160new$=""
 1170REPEAT
 1180C%=BGET#S%
 1190IF C% THEN new$=new$+CHR$C%
 1200UNTIL C%=0
 1210=new$