10
20
30
40
50
60
70
80
90
100
110
120
130 :
140 DIM ctrl% 31,name% 79,zp% 5,palette%(15):X%=ctrl%:Y%=X%DIV256
150 mem%=0:blk%=0:IF HIMEM-LOMEM>&5500:DIM mem% &4FFF ELSE DIM blk% &27F
160 :
170 ON ERROR REPORT:PROCClose_All:PRINTLEFT$(" at line "+STR$ERL,ERR<>17 AND ERR<128):PROCexit(ERR)
180 A$=FNOS_GetEnv:d$=".":s$="/":IFos%=32:PROCWin_TextIO:d$="\":s$="."
190 IFA$="":INPUT"BBC Screen image: "in$:INPUT"BBC Screen mode: "mode$:INPUT"Output bitmap: "out$
200 IFA$="":INPUT"Options: "opt$:A$=in$+" "+out$+" "+mode$+" "+opt$+" "
210 quit$=FNcl(" -q",1):sm%=FNcl("-s",0):rle%=NOTFNcl("-u",0)ORFNcl("-c",0):vb%=FNcl("-v",0):mode$=FNcl("-m",1)
220 cpr%=NOT(FNcl("-r",0)ORNOTFNcl("-l",0)):brd%=FNcl("-b",0)AND1:IFFNcl("-?",0):PROCsyntax:PROCexit(0)
230 in$=FNcl("",0):out$=FNcl("",0):IFmode$="":mode$=FNcl("",0)
240 IFin$="" OR out$="":PROCsyntax:PROCexit(220)
250 mode%=VALmode$AND7:IFmode$="":mode%=-1
260 IFos%=32:IFINSTR(in$,".")=0:in$=in$+"."
270 :
280
290
300 X%!2=0:X%!6=0:IFFNfile(in$,5)<>1:PRINT"File '"in$"' not found":PROCexit(214)
310 scr%=0:fsize%=X%!10:IFX%!2=0:IFX%!6=0:PROCrdInf
320 IFcpr%=0:scr%=(X%?5=&FF AND X%!2<>X%!6 AND (X%?9=0 OR X%?9=&FF))
330 IFscr%:cpr%=(X%?5=&FF AND X%?9=0)AND(X%?8+1):IFmode%<0:mode%=X%?7DIV16
340 :
350
360
370 PROCload:IFcpr%:IFmem%=0:PRINT"No memory for decompression":PROCexit(128-2)
380 IFmode%AND-8:PRINT"Unknown MODE":PROCexit(128-1)
390 :
400
410
420 IFmode%=0:ColoursUsed%=2 :BitCount%=1:sz%=8:px%=8:xs%=1:ys%=2:zebra%=0:cols%=80
430 IFmode%=1:ColoursUsed%=4 :BitCount%=4:sz%=2:px%=4:xs%=2:ys%=2:zebra%=0:cols%=80:IFsm%:xs%=1:ys%=1
440 IFmode%=2:ColoursUsed%=16:BitCount%=4:sz%=2:px%=2:xs%=4:ys%=2:zebra%=0:cols%=80:IFsm%:xs%=2:ys%=1
450 IFmode%=3:ColoursUsed%=2 :BitCount%=1:sz%=8:px%=8:xs%=1:ys%=2:zebra%=2:cols%=80
460 IFmode%=4:ColoursUsed%=2 :BitCount%=1:sz%=8:px%=8:xs%=2:ys%=2:zebra%=0:cols%=40:IFsm%:xs%=1:ys%=1
470 IFmode%=5:ColoursUsed%=4 :BitCount%=4:sz%=2:px%=4:xs%=4:ys%=2:zebra%=0:cols%=40:IFsm%:xs%=2:ys%=1
480 IFmode%=6:ColoursUsed%=2 :BitCount%=1:sz%=8:px%=8:xs%=2:ys%=2:zebra%=2:cols%=40:IFsm%:xs%=1:ys%=1
490 IFmode%=7:ColoursUsed%=8 :BitCount%=4:PRINT"MODE 7 not supported":PROCClose_All:PROCexit(128-1)
500 :
510
520
530 IFscr%ORcpr%=0:FORA%=0TO15:palette%(A%)=FNrgb(A%AND7):NEXT
540 IFscr%ORcpr%=0:IFColoursUsed%=4:palette%(1)=FNrgb(1):palette%(2)=FNrgb(3):palette%(3)=FNrgb(7)
550 IFscr%ORcpr%=0:IFColoursUsed%=2:palette%(1)=FNrgb(7)
560 IFscr%:col%=X%!6 AND &FFF:FORA%=0TO3:palette%(A%)=FNrgb(col%AND7):col%=col%DIV8:NEXT
570 IFscr%:col%=X%!2 AND &FFF:FORA%=4TO7:palette%(A%)=FNrgb(col%AND7):col%=col%DIV8:NEXT
580 IFscr%:IFmode%=2:IFmem%:FORA%=0TO3:palette%(A%*2+8)=FNrgb((mem%?A%)AND7):palette%(A%*2+9)=FNrgb((mem%?A%)DIV16):NEXT:!mem%=mem%!4
590 :
600
610
620 xsz%=cols%DIV40
630 rows%=(fsize%DIVcols%)AND-8
640 Width% =(cols%+2*xsz%*brd%)*xs%*px%
650 Height%=(rows%+16*brd%)*ys%+zebra%*ys%*28
660 :
670 REPEAT
680
690
700 out%=OPENOUT(out$):IFout%=0:PRINT"Can't open '"out$"'":PROCClose_All:PROCexit(192)
710 :
720
730
740 Bits%=BitCount%:IF ColoursUsed%<4:IFrle%:BitCount%=4:
750 NumColours%=2^BitCount%
760 DataOffset%=14+40+4*NumColours%
770 FileSize%=DataOffset%+(Width%*Height%)/sz%
780 :
790 PROCwr16(out%,ASC"B"+ASC"M"*256)
800 PROCwr32(out%,FileSize%)
810 PROCwr32(out%,0)
820 PROCwr32(out%,DataOffset%)
830 :
840
850
860 PROCwr32(out%,40)
870 PROCwr32(out%,Width%)
880 PROCwr32(out%,Height%)
890 PROCwr16(out%,1) :
900 PROCwr16(out%,BitCount%)
910 PROCwr32(out%,0) :
920 PROCwr32(out%,0) :
930 PROCwr32(out%,0) :
940 PROCwr32(out%,0) :
950 PROCwr32(out%,ColoursUsed%):
960 PROCwr32(out%,0) :
970 :
980
990
1000 FOR colour%=0 TO NumColours%-1
1010 PROCwr32(out%,palette%(colour%))
1020 NEXT colour%
1030 :
1040
1050
1060 cnt%=0:last%=-1
1070 IF brd%:PROCblank(8) :
1080 IF zebra%:PROCblank(6) :
1090 FOR row%=rows%-1 TO 0 STEP -1:IFvb%:PRINTCHR$13;row%;" ";
1100 IF (row%AND7)=7:PROCline:IF zebra%:PROCblank(2) :
1110 FOR sq%=1 TO ys%
1120 IF brd%:FOR N%=1 TO xsz%:PROCbyte(0):NEXT :
1130 FOR col%=0 TO cols%-1
1140 ptr%=blk%+col%*8+(row%AND7):IF blk%=0:ptr%=mem%+ptr%+(row%DIV8)*cols%*8
1150 IF mem%+blk%:PROCbyte(?ptr%) ELSE PTR#in%=ptr%+(row%DIV8)*cols%*8:PROCbyte(BGET#in%)
1160 NEXT col%
1170 IF brd%:FOR N%=1 TO xsz%:PROCbyte(0):NEXT :
1180 PROCeol
1190 NEXT sq%
1200 NEXT row%
1210 IF brd%:PROCblank(8) :
1220 IF rle%:IF EXT#out%>FileSize%:CLOSE#out%:out%=0:BitCount%=Bits%:rle%=FALSE:
1230 UNTIL out%<>0
1240 IF rle%:BPUT#out%,0:BPUT#out%,1:FileSize%=EXT#out%
1250 IF rle%:PTR#out%=2:PROCwr32(out%,FileSize%):PTR#out%=30:PROCwr32(out%,2):PROCwr32(out%,FileSize%-DataOffset%)
1260 IFvb%:PRINTCHR$13;" ";CHR$13;
1270 :
1280
1290
1300 PROCClose_All:ON ERROR PROCexit(0)
1310 IFos%<32:OSCLI"SetType "+out$+" 69C":OSCLI"Stamp "+out$
1320 PROCexit(0):END
1330 :
1340 DEFFNrgb(A%)=(A%AND1)*&FF0000+(A%AND2)*&7F80+(A%DIV4)*&FF
1350 :
1360 DEFPROCblank(N%):N%=N%*ys%
1370 REPEAT
1380 FOR col%=1 TO (cols%+2*xsz%*brd%):PROCbyte(0):NEXT:PROCeol
1390 N%=N%-1:UNTILN%<1
1400 ENDPROC
1410 :
1420 DEFPROCeol
1430 IF rle%:PROCout(-1):PROCwr16(out%,0):cnt%=0:ENDPROC
1440 IF rle%=0:B%=(Width%DIVpx%)MOD4:IF B%:FOR B%=B% TO 3:PROCbyte(0):NEXT
1450 ENDPROC
1460 :
1470 DEFPROCbyte(B%)
1480 IF ColoursUsed%=2 :PROCmode0:ENDPROC
1490 IF ColoursUsed%=4 :PROCmode1:ENDPROC
1500 IF ColoursUsed%=16:PROCmode2:ENDPROC
1510 ENDPROC
1520 :
1530 DEFPROCmode0
1540 IFBitCount%=1:IFxs%=1:BPUT#out%,B%:ENDPROC ELSE IFBitCount%=1:BPUT#out%,FNl(B%):BPUT#out%,FNr(B%):ENDPROC
1550 A0%=B%AND15:B%=B%DIV16:PROCmode1:B%=A0%:PROCmode1
1560 ENDPROC
1570 DEFFNl(A%)=(A%AND&80)OR((A%DIV2)AND&40)OR((A%DIV2)AND&20)OR((A%DIV4)AND&10)OR((A%DIV4)AND8)OR((A%DIV8)AND4)OR((A%DIV8)AND2)OR((A%DIV16)AND1)
1580 DEFFNr(A%)=((A%AND8)*16)OR((A%AND8)*8)OR((A%AND4)*8)OR((A%AND4)*4)OR((A%AND2)*4)OR((A%AND2)*2)OR((A%AND1)*2)OR(A%AND1)
1590 :
1600 DEFPROCmode1
1610 A1%=((B%AND&80)DIV4)OR((B%AND&08)*2) :IFxs%>1:PROCout(A1%OR(A1%DIV16)):IFxs%=4:PROCout(A1%OR(A1%DIV16))
1620 A2%=((B%AND&40)DIV2)OR((B%AND&04)*4) :IFxs%=1:PROCout(A1%OR(A2%DIV16)) ELSE PROCout(A2%OR(A2%DIV16)):IFxs%=4:PROCout(A2%OR(A2%DIV16))
1630 A3%= (B%AND&20)OR((B%AND&02)*8) :IFxs%>1:PROCout(A3%OR(A3%DIV16)):IFxs%=4:PROCout(A3%OR(A3%DIV16))
1640 A4%= ((B%AND&10)*2)OR((B%AND&01)*16):IFxs%=1:PROCout(A3%OR(A4%DIV16)) ELSE PROCout(A4%OR(A4%DIV16)):IFxs%=4:PROCout(A4%OR(A4%DIV16))
1650 ENDPROC
1660 :
1670 DEFPROCmode2
1680 A1%=(B%AND&80)OR((B%AND&20)*2)OR((B%AND&08)*4)OR((B%AND&02)*8)
1690 IFxs%=4:A%=A1%OR(A1%DIV16):PROCout(A%):PROCout(A%)
1700 A2%=((B%AND&40)*2)OR((B%AND&10)*4)OR((B%AND&04)*8)OR((B%AND&01)*16)
1710 IFxs%=4:A%=A2%OR(A2%DIV16):PROCout(A%):PROCout(A%) ELSE PROCout(A1%OR(A1%DIV16)):PROCout(A2%OR(A2%DIV16))
1720 ENDPROC
1730 :
1740 DEFPROCout(A%)
1750 IFrle%=FALSE:BPUT#out%,A%:ENDPROC
1760 IFlast%=-1:last%=A%
1770 IFA%=last%:cnt%=cnt%+1:IFcnt%<127:ENDPROC
1780 IFcnt%:BPUT#out%,cnt%*2:BPUT#out%,last%
1790 IFA%=last%:cnt%=0 ELSE last%=A%:cnt%=1
1800 ENDPROC
1810 :
1820
1830
1840 DEFPROCline
1850 IF cpr%=0:IF blk%:PROCgbpb(3,in%,blk%,cols%*8,(row%AND7)+(row%DIV8)*cols%*8-7):ENDPROC
1860 ENDPROC
1870 :
1880
1890
1900 DEFPROCload
1910 IFcpr%=0:IFmem%:OSCLI"Load "+in$+" "+STR$~mem%:ENDPROC
1920 in%=OPENIN(in$):IFcpr%=0:ENDPROC
1930 IFscr%:PROCscrload ELSE PROCldpic
1940 ENDPROC
1950 :
1960
1970
1980 DEFPROCscrload
1990 ptr%=0:REPEAT:B%=BGET#in%:N%=BGET#in%:IFN%=0:N%=256
2000 REPEATmem%?ptr%=B%:ptr%=ptr%+cpr%:N%=N%-1:IFptr%>&4FFF:IF(ptr%AND3)<>cpr%-1:ptr%=ptr%-&4FFF
2010 UNTILN%=0:UNTILEOF#in%:CLOSE#in%:in%=0
2020 fsize%=ptr%+1-cpr%:ENDPROC
2030 :
2040
2050
2060 DEFPROCldpic
2070 IFmem%=0:ENDPROC
2080 bits%=0:dw%=FNget(8):mode%=FNget(8)AND7
2090 FOR colour%=15 TO 0 STEP -1:ctrl%?colour%=FNget(4):NEXT colour%
2100 stp%=FNget(8):cw%=FNget(8)
2110 fsize%=256*EVAL("&"+MID$("5050504028282004",mode%*2+1,2))
2120 off%=stp%-1:addr%=mem%+off%
2130 REPEAT
2140 cnt%=1:IFFNget(1):cnt%=FNget(cw%)
2150 byt%=FNget(dw%)
2160 FOR A%=1 TO cnt%:?addr%=byt%:addr%=addr%+stp%
2170 IF addr%>=mem%+fsize%:off%=off%-1:addr%=mem%+off%
2180 NEXT
2190 UNTIL off%<0 OR EOF#in%:bits%=0
2200 IF addr%>mem%:fsize%=addr%-mem%
2210 IF PTR#in%+24>EXT#in%:FORA%=0TO15:palette%(A%)=FNrgb(ctrl%?A%):NEXTA%:CLOSE#in%:in%=0:ENDPROC
2220 FOR colour%=15 TO 0 STEP -1
2230 name%?(colour%*4+3)=0
2240 name%?(colour%*4+2)=FNget(4):
2250 name%?(colour%*4+1)=FNget(4):
2260 name%?(colour%*4+0)=FNget(4):
2270 NEXT colour%
2280
2290 FOR colour%=15 TO 0 STEP -1
2300 num%=ctrl%?colour%
2310 palette%(colour%)=name%!(num%*4) OR (name%!(num%*4)*16)
2320 NEXT colour%
2330 CLOSE#in%:in%=0
2340 ENDPROC
2350 :
2360 DEFFNbit:IFbits%=0:byte%=BGET#in%:bits%=8
2370 byte%=byte%*2:bits%=bits%-1:=byte%AND256
2380 DEFFNget(N%):LOCALA%,B%:FORB%=1TON%:A%=(A%DIV2)ORFNbit:NEXT
2390 REPEATA%=A%DIV2:N%=N%+1:UNTILN%>8:=A%
2400 :
2410
2420
2430 DEFPROCrdInf:in%=OPENIN(FNfn_noext(in$)+s$+"inf"):IFin%=0:ENDPROC
2440 A%=0:REPEATB%=BGET#in%:IFB%=10:B%=13
2450 name%?A%=B%:A%=A%+1:UNTILEOF#in% OR A%>78 OR B%=13:name%?A%=13:CLOSE#in%:in%=0
2460 A$=$name%:X%!2=VALFNcl("",0):X%!2=EVAL("&"+FNcl("",0)):X%!6=EVAL("&"+FNcl("",0))
2470 ENDPROC
2480 :
2490 DEFPROCsyntax:PRINT"Syntax: BBCtoBMP <infile> <outfile> -mode <mode> -border -ldpic -raw -scr -small -uncomp -verbose":ENDPROC
2500 DEFPROCwr32(O%,A%):!zp%=A%:FORA%=0TO3:BPUT#O%,zp%?A%:NEXT:ENDPROC
2510 DEFPROCwr16(O%,A%):!zp%=A%:FORA%=0TO1:BPUT#O%,zp%?A%:NEXT:ENDPROC
2520 DEFPROCwr(A%):ENDPROC
2530 :
2540 DEFFNfn_noext(A$):IFINSTR(A$,s$)=0:=A$
2550 LOCAL A%:A%=LENA$+1:REPEATA%=A%-1:UNTILINSTR(":"+s$+d$,MID$(A$,A%,1))
2560 IFMID$(A$,A%,1)=s$:=LEFT$(A$,A%-1) ELSE =A$
2570 :
2580
2590 DEFPROCClose_All:*EXEC
2600 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%
2610 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
2620 ENDPROC
2630 :
2640 DEFPROCgbpb(A%,chn%,addr%,num%,ptr%)
2650 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFPAGE<&FFFFF:CALL&FFD1:ENDPROC
2660 IFA%=1ORA%=3:PTR#?X%=X%!9
2670 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%
2680 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC
2690 :
2700
2710 DEFFNOS_GetEnv:LOCALA$,A%,X%,Y%:X%=1:os%=((USR&FFF4)AND&FF00)DIV256
2720 IFos%>31:IFPAGE>&FFFFF:DIMX%LOCAL256:SYS"GetModuleFileName",0,X%,255:run$=$$X%:=@cmd$
2730 A%=&600-&7B00*(PAGE>&8000)-&3F00*(PAGE>&C000):IF!(PAGE-&100)=@%:A%=PAGE-&300
2740 IF?(TOP-3)=0:A%=&100:IFHIMEM<&FFFF:A%=PAGE-&300:IF!(HIMEM+512)=@%:A%=HIMEM
2750 A$=$A%:IFPAGE=&8F00:run$=A$:SYS16TOA$,,A%:SYS72,"",A%:A$=MID$(A$,1+INSTR(A$+" "," ",1+INSTR(A$," "))):IFLENA$=0:A$=run$
2760 FORY%=-1TO0:A$=" "+A$:REPEATA$=MID$(A$,2):UNTILASCA$<>32:IFASCA$=34:A%=INSTR(A$,"""",2)+1 ELSE A%=INSTR(A$+" "," ")
2770 IFY%:run$=MID$(A$,1-(ASCA$=34),A%-1+2*(ASCA$=34)):A$=MID$(A$,A%+1)
2780 NEXT:=A$
2790 DEFPROCos(A$):IFASCA$=42:OSCLIA$ ELSE IFLENA$:CHAINA$
2800 ENDPROC
2810 DEFPROCexit(A%):OSCLI"FX1,"+STR$(A%AND255):quit$=quit$:A$=quit$:quit$="":PROCos(A$)
2820 IFPAGE>&FFFFF:QUIT A% ELSE END
2830 ENDPROC
2840 :
2850
2860 DEFFNcl(l$,n%):IFl$="":A$=FNs(A$):IFASCA$=34:A%=INSTR(A$+" "" ",""" ",2):l$=MID$(A$,2,A%-2):A$=FNs(MID$(A$,A%+1)):=l$
2870 IFl$="":A%=INSTR(A$+" "," "):l$=LEFT$(A$,A%-1):A$=FNs(MID$(A$,A%+1)):=l$
2880 IFn%=0:IFl$<>"":A%=INSTR(A$,l$):IFA%:A$=FNs(LEFT$(A$,A%-1)+MID$(A$,INSTR(A$," ",A%)+1))+" ":=TRUE
2890 IFn%=0:IFl$<>"":=FALSE
2900 A%=INSTR(LEFT$(" ",ASCl$=32)+A$,l$):IFA%=0:=""
2910 A$=LEFT$(A$,A%-1)+FNs(MID$(A$,INSTR(A$," ",A%)+1))
2920 IFASCl$=32:l$=MID$(A$,A%):A$=LEFT$(A$,A%-1):=MID$(l$,1-(ASCl$=34),LENl$+2*(ASCl$=34))
2930 IFASCMID$(A$,A%,1)<>34:l$=MID$(A$,A%,INSTR(A$+" "," ",A%)-A%):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+1):=l$
2940 l$=MID$(A$,A%+1,INSTR(A$+" ",""" ",A%+1)-A%-1):A$=LEFT$(A$,A%-1)+MID$(A$,A%+LENl$+3):=l$
2950 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
2960 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
2970 =A$
2980 :
2990
3000 DEFPROCWin_TextIO
3010 SYS"GetStdHandle",-10 TO @hfile%(1):*INPUT 13
3020 SYS"GetStdHandle",-11 TO @hfile%(2):*OUTPUT 14
3030 SYS"SetConsoleMode",@hfile%(1),0:ENDPROC
3040 :
3050
3060 DEFFNfile(A$,A%):IFPAGE<&FFFF:$name%=A$:?X%=name%:X%?1=name%DIV256:=(USR&FFDD)AND&FF
3070 IFINSTR(A$,".")=0:A$=A$+"."
3080 IFA%=255 OR A%=5:X%!14=OPENIN(A$):IFX%!14:X%!10=EXT#X%!14:CLOSE#X%!14:X%!14=&33
3090 IFA%=255:IFX%?6=0:OSCLI"LOAD """+A$+""" "+STR$~X%!2:=1
3100 IFA%=5:IFX%!14:=1 ELSE IFA%=5:=0
3110 IFA%=0:OSCLI"SAVE """+A$+""" "+STR$~X%!10+" "+STR$~X%!14:X%!10=X%!14-X%!10:=1
3120 IFA%=7:OSCLI"SAVE """+A$+""" "+STR$~PAGE+"+"+STR$~X%!10:X%!10=X%!14-X%!10:=1
3130 IFA%=8 THEN
3140 LOCAL ERROR:ON ERROR LOCAL:=2
3150 OSCLI"mkdir "+A$:=2
3160 ENDIF
3170 =0