10 REM >AddSyst - Add system files to Flex disk image

   20 :

   30 debug%=0

   40 A%=0:X%=1:os%=((USR&FFF4)AND&FF00)DIV256

   50 DIM ctrl% 31:X%=ctrl%:Y%=X%DIV256

   60 DIM mem% &1FF,dmp% 15,d_path$(3):d_drv%=-1:d_chn%=0:in%=0

   70 ON ERROR PRINT:REPORT:PROCClose_All:PRINT" at line ";ERL:END

   80 :

   90 CONS$="Console.bin"

  100 DISK$="DiskIO.bin"

  110 BOOT$="Boot.bin"

  120 PRINT "Add FLEX.SYS file to disk image"

  130 REPEAT:INPUT "Disk image file: "in$:UNTILin$<>""

  140 d_path$(0)=in$:drv%=0

  150 IF FNfdc_disk(&53,mem%,drv%,0,0,0,0):PRINT "Not a FLEX image":PROCend

  160 ptr%=FNf_find("FLEX.SYS"):IF ptr%=0:PRINT"FLEX.SYS not found":PROCend

  170 size%=mem%?(ptr%+18)+256*(mem%?(ptr%+17))

  180 mem%?0=mem%?(ptr%+13):mem%?1=mem%?(ptr%+14):ptr%=0

  190 REPEAT

  200   REPEAT:A%=FNgetbyte:UNTIL A%=2 OR A%=22

  210   addr%=256*FNgetbyte+FNgetbyte

  220   IF A%=2:leng%=FNgetbyte ELSE leng%=0

  230   IF addr%<>&DE00:IF leng%:REPEAT:A%=FNgetbyte:leng%=leng%-1:UNTILleng%=0

  240 UNTIL addr%=&DE00 OR size%<2

  250 IF size%<2:PRINT"No room in FLEX.SYS":PROCend

  260 ptr%=ptr%-4:IF ptr%<4:PRINT"Can't backtrack to previous sector":PROCend

  270 PRINT"Inserting ";DISK$;

  280 in%=OPENIN(DISK$):IF in%=0:PRINT" - not found":PROCend

  290 PROCwrfile(2,in%,&DE00,EXT#in%):CLOSE#in%:in%=0:PRINT

  300 PRINT"Inserting ";CONS$;

  310 in%=OPENIN(CONS$):IF in%=0:PRINT" - not found":PROCend

  320 PROCwrfile(2,in%,&D370,EXT#in%):CLOSE#in%:in%=0:PRINT

  330 PRINT"Flushing file buffer";

  340 PROCwrfile(22,0,&CD00,0):PROCwrfile(2,0,0,0)

  350 REPEAT:PROCputbyte(0):UNTIL ptr%>255 AND mem%?0=0 AND mem%?1=0:PROCputbyte(0):PRINT

  360 PRINT"Inserting ";BOOT$;

  370 in%=OPENIN(BOOT$):IF in%=0:PRINT" - not found":PROCend

  380 PROCgbpb(4,in%,mem%,256,0  ):err%=FNfdc_disk(&4B,mem%,drv%,0,0,1,1)

  390 PROCgbpb(4,in%,mem%,256,256):err%=FNfdc_disk(&4B,mem%,drv%,0,0,2,1)

  400 CLOSE#in%:in%=0:PRINT

  410 CLOSE#d_chn%

  420 END

  430 :

  440 DEFPROCwrfile(stx%,in%,addr%,len%)

  450 REPEAT

  460   num%=len%:IF num%>255:num%=255

  470   PROCputbyte(stx%):PROCputbyte(addr% DIV 256):PROCputbyte(addr% AND 255):PROCputbyte(num%)

  480   len%=len%-num%:addr%=addr%+num%

  490   IF num%:REPEAT:PROCputbyte(BGET#in%):num%=num%-1:UNTIL num%<1

  500 UNTIL len%<1

  510 ENDPROC

  520 :

  530 DEFFNgetbyte

  540 IF (ptr%AND255)=0:IF(!mem%)AND&FFFF:trk%=mem%?0:sec%=mem%?1:err%=FNfdc_disk(&53,mem%,drv%,trk%,0,sec%,1):ptr%=4:size%=size%-1

  550 ptr%=ptr%+1:=mem%?(ptr%-1)

  560 :

  570 DEFPROCputbyte(byte%)

  580 IF (ptr%AND255)=0:err%=FNfdc_disk(&4B,mem%,drv%,trk%,0,sec%,1):IF(!mem%)AND&FFFF:trk%=mem%?0:sec%=mem%?1:err%=FNfdc_disk(&53,mem%,drv%,trk%,0,sec%,1):ptr%=4

  590 mem%?ptr%=byte%:ptr%=ptr%+1

  600 ENDPROC

  610 :

  620 DEFFNf_find(fn$)

  630 LOCAL A%,A$,dir%,trk%,sec%,ptr%

  640 A%=INSTR(fn$,"."):IFA%:IFA%<9:fn$=LEFT$(LEFT$(fn$,A%-1)+STRING$(9-A%,CHR$0)+MID$(fn$,A%+1,3),11)

  650 dir%=&0500:REPEAT

  660   sec%=dir% DIV 256:trk%=dir% AND 255

  670   A%=FNfdc_disk(&53,mem%,drv%,trk%,0,sec%,1)

  680   ptr%=16:REPEAT

  690     A%=mem%?(ptr%+11):mem%?(ptr%+11)=13:A$=FNuc($(mem%+ptr%)):mem%?(ptr%+11)=A%

  700   ptr%=ptr%+24:UNTILptr%>255 OR fn$=A$

  710   dir%=!mem% AND &FFFF

  720 UNTIL dir%=0 OR fn$=A$

  730 IF fn$=A$:=ptr%-24

  740 =0

  750 :

  760 DEFFNd(A%,N%)=RIGHT$("        "+STR$A%,N%)

  770 DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)

  780 DEFFNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)

  790 DEFFNc(A%):A%=A%AND127:IF A%<32 OR A%=127:="." ELSE =CHR$A%

  800 DEFFNb(A%):A%=A%AND127:IF A%<32 OR A%=127:=" " ELSE =CHR$A%

  810 DEFFNuc(A$)=A$

  820 :

  830 DEFPROCend:PROCClose_All:END:ENDPROC

  840 DEFPROCClose_All:in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%

  850 d_chn%=d_chn%:IFd_chn%:A%=d_chn%:d_chn%=0:CLOSE#A%

  860 ENDPROC

  870 :

  880 DEFFNfdc_disk(cmd%,add%,drv%,trk%,sid%,sec%,num%):LOCAL ptr%

  890 IF drv%>3:drv%=(drv%DIV2)+(drv%AND1)

  900 IF(debug%AND8):IFPOS:PRINT

  910 IF(debug%AND8):PRINT"cmd:";FNh0(cmd%,2);" add:";~add%-mem%;" ";

  920 IF(debug%AND8):PRINT"drv:";drv%;" trk:";trk%;" sid:";sid%;" sec:";sec%;" num:";num%;" ";

  930 IF drv%<>d_drv%:IF d_chn%:CLOSE#d_chn%:d_chn%=0        :REM Different drive, close current drive

  940 IF d_chn%=0:IF d_path$(drv%)="":=&1E                   :REM If no mount path, return Drive not present

  950 IF d_chn%=0:d_chn%=OPENUPd_path$(drv%):IF d_chn%=0:=&1E:REM No drive, return Drive not present

  960 IF drv%<>d_drv%:d_drv%=-1:IF FNfdc_exam(drv%):=&1E     :REM No info, return Drive not present

  970 d_drv%=drv%:IF num%=0:=0                               :REM Just refresh disk info

  980 IF d_chn%=0:=&1E

  990 sec%=sec%-d_sec0%

 1000 IF d_sid%=1:ptr%=((sid%*80+trk%)*d_num%+sec%)*d_bps%+d_off%

 1010 IF d_sid%=2:ptr%=((trk%*2 +sid%)*d_num%+sec%)*d_bps%+d_off%

 1020 IF(debug%AND8):PRINT"ptr:&";FNh0(ptr%,6)

 1030 IF cmd%=&4B:cmd%=1

 1040 IF cmd%=&53:cmd%=3

 1050 IF cmd%=&57:cmd%=3

 1060 IF cmd%=&5B:FOR A%=0 TO d_num%+2:add%!(A%*4)=(A%MODd_num%)*65536:NEXT:=0

 1070 IF cmd%<5:PROCgbpb(cmd%,d_chn%,add%,num%*d_bps%,ptr%)

 1080 =0

 1090 :

 1100 DEFFNfdc_exam(drv%)

 1110 PTR#d_chn%=0:d_off%=0:d_trk%=EXT#d_chn% DIV 2560:d_sid%=1:d_sec%=10

 1120 IF BGET#d_chn%+256*BGET#d_chn%=&6B64:d_off%=BGET#d_chn%+256*BGET#d_chn%:PTR#d_chn%=8:d_trk%=BGET#d_chn%:d_sid%=BGET#d_chn%:d_sec%=(EXT#d_chn%-d_off%) DIV (d_trk%*d_sid%*256)

 1130 d_num%=d_sec%:d_bps%=256:d_sec0%=1

 1140 PTR#d_chn%=&221:d_free%=256*BGET#d_chn%+BGET#d_chn%

 1150 PTR#d_chn%=&226:d_trk%=BGET#d_chn%:d_sec%=BGET#d_chn%

 1160 IF d_sec%>19:d_sid%=2 ELSE d_sid%=1

 1170 d_num% =d_sec% DIV d_sid%

 1180 d_size%=(d_trk%+1)*d_sec%

 1190 d_used%=d_size%-d_free%

 1200 PTR#d_chn%=&210:d_title$=""

 1210 REPEAT:A%=BGET#d_chn%:IF A%:d_title$=d_title$+CHR$A%

 1220 UNTILA%=0 OR LENd_title$=12

 1230 =0

 1240 :

 1250 DEFPROCgbpb(A%,chn%,addr%,num%,ptr%)

 1260 ?X%=chn%:X%!1=addr%:X%!5=num%:X%!9=ptr%:IFos%<32:CALL&FFD1:ENDPROC

 1270 IFA%=1ORA%=3:PTR#?X%=X%!9

 1280 REPEAT:IFA%=1ORA%=2:BPUT#?X%,?X%!1 ELSE IFA%=3ORA%=4:?X%!1=BGET#?X%

 1290 X%!1=X%!1+1:X%!5=X%!5-1:UNTIL(EOF#?X% AND A%>2)OR X%!5<1:ENDPROC