8-Bit Software Online Conversion

DFS/ADFS Menu System - Listing

1REM ex MENU15 - with references to drive$ removed 20REM P.GMENU REV 5.00 To read games menu for 'H' Leivers (Solinet Mar'93) 40REM assumptions: 1) all files that aren't directories, and don't have an 60REM uppercase lette r in their name, are to be ignored as 80REM a valid option in the menu 100REM 3) No more than 10 levels of directories - NOT tested for 120REM Modified with additional sugges tions by H.Leivers 140REM Now caters for: DFS/ADFS 180MODE 7 200CLEAR 220HIMEM=&7500:REM to leave space for machine code routine 240option$="ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstu" 260dir`level%=0 280DIM data 3000,block 20,title$(47),l oad$(47),exec$(47),length$(47),stsec$(47 ),seq$(47),lang$(47),xsec%(10) 300adfs%=FNwhat`system 320PROCinit`drive 340dir`level%=1:xsec%(dir`level%)=2 360IF adfs% OSCLI("FADFS"):OSCLI("MOUN T "+STR$(xdr%)) ELSE OSCLI("DISC"):OSCLI ("DRIVE "+STR$(xdr%)) 380IF adfs% PROCrw`adfs`sector(xdr%,"R ","Y",xsec%(dir`level%),1,5):REM cat = s ec2-6 400IF NOT adfs% PROCrw`DFS`sector(xdr% ,"R","Y",0,0,1,2) 420IF adfs% PROCprint`ADFS`cat ELSE PR OCprint`DFS`cat 440PROCmenu 460IF option%>=128 AND option%<=129 TH EN xdr%=option%-128:adfs%=TRUE:GOTO 340 480IF option%>=144 AND option%<=147 TH EN xdr%=option%-144:adfs%=FALSE:GOTO 340 500IF option%=136 THEN dir`level%=dir` level%-1:OSCLI("DIR ^"):GOTO 380:REM pro cess higher directory 520IF lang$(game%)="(dir)" THEN OSCLI( "*DIR "+title$(game%)):dir`level%=dir`le vel%+1:xsec%(dir`level%)=EVAL("&"+stsec$ (game%)):GOTO 380 540PROCwhat`next 560GOTO 420 580END 600: 620DEFFNwhat`system 640REM 0-9 = none,tape1200,tape300,rom ,dfs,nfs,teletext,ieee,adfs,anfs 660A%=0:Y%=0 680system%=USR(&FFDA)AND&F 700IF system%=8 =TRUE ELSE =FALSE 720: 740DEFPROCinit`drive 760block!1=data 780X%=block MOD 256 800Y%=block DIV 256 820A%=&05 840CALL &FFD1 860xdr%=data?(2+data?0) 880ENDPROC 900: 920DEFPROCrw`adfs`sector(drive%,func$, err$,absector%,size%,no`sec%) 940block?0=0 960block!1=data 980IF func$="W" block?5=&0A ELSE block ?5=&08 1000block?6=(drive%*32)+(absector%DIV&1 0000):REM top 5 bits 1020block?7=((absector%MOD&10000)DIV&10 0):REM middle 8 bits 1040block?8=absector%MOD&100:REM low 8 bits 1060block?9=no`sec% 1080block?10=0:REM UNUSED 1100IF func$="W" block!11=????:REM writ e length 1120X%=block MOD 256 1140Y%=block DIV 256 1160A%=&72 1180CALL &FFF1 1200IF block?0<>0 AND err$<>"N" PRINT " error &";÷block?0:STOP 1220ENDPROC 1240: 1260DEFPROCprint`ADFS`cat 1280LOCAL I%,J%,K%,col% 1300CLS 1320FOR K%=0 TO 1:PRINT CHR$(141)CHR$(1 31)CHR$(157)CHR$(132)"Games Menu Drive: ";xdr%:NEXT 1340J%=1 1380FOR I%=0 TO (47*26)-1 STEP 26 1400ignore%=TRUE 1420IF data?(I%+5)=&00 THEN I%=(47*26): GOTO 1700:REM no more dir entries 1440title$(J%) =FNstring(I%+5,I%+14) 1460load$(J%) =FNaddress(I%+15,I%+18) 1480exec$(J%) =FNaddress(I%+19,I%+22) 1500length$(J%)=FNaddress(I%+23,I%+26) 1520stsec$(J%) =FNaddress(I%+27,I%+29) 1540seq$(J%) =FNaddress(I%+30,I%+30) 1560lang$(J%) =FNlang(exec$(J%),I%+5+3 ) 1580IF ignore% THEN 1700 1600IF lang$(J%)="(dir)" THEN col%=129 ELSE col%=130 1620PRINT ;CHR$(135);MID$(option$,J%,1) ;CHR$(col%);title$(J%); 1640IF J%MOD3=0 PRINT;CHR$(130); 1660REM load$(J%),exec$(J%),length$(J% ),stsec$(J%),seq$(J%),lang$(J%);ignore% 1680J%=J%+1 1700NEXT 1720max`game%=J%-1 1760PRINTTAB(1,19);CHR$(131)CHR$(157)CH R$(132)" f0/1: ADFS drive,";:IF dir` level%>1 PRINT ;"f8: parent dir" 1780PRINTTAB(1,20);CHR$(131)CHR$(157)CH R$(132)"shft+f0/3: DFS drive," 1800IF max`game%>0 PRINTTAB(1,21);CHR$( 131)CHR$(157)CHR$(132)" else lett er for OPTION" 1820ENDPROC 1840: 1860DEFFNstring(a%,b%) 1880string$="" 1900LOCAL I%,len% 1920len%=(b%-a%)+1 1940FOR I%=a% TO b% 1960IF data?I% MOD &80=&0D THEN I%=b% E LSE string$=string$+CHR$(data?I% MOD &80 ) 1980IF (data?I% MOD &80) <= ASC("Z") AN D (data?I% MOD &80) >= ASC("A") THEN ign ore%=FALSE 2000NEXT 2020=LEFT$(string$+STRING$(len%," "),le n%) 2040: 2060DEFFNaddress(a%,b%) 2080address$="" 2100LOCAL I% 2120FOR I%=b% TO a% STEP -1 2140address$=address$+RIGHT$("0"+STR$÷d ata?I%,2) 2160NEXT 2180REM address%=address%+(&100000*data ?b%) 2200REM IF address% DIV &10000 =&10 THE N address%=&FFFF0000+(address% MOD &1000 0) 2220=address$ 2240: 2260DEFFNlang(address$,b%) 2280LOCAL language$ 2300language$="Machine code" 2320IF RIGHT$(address$,4)="802B" OR RIG HT$(address$,4)="8023" OR RIGHT$(address $,4)="801F" OR RIGHT$(address$,4)="B823" OR RIGHT$(address$,4)="B82B" THEN langu age$="Basic" 2340IF RIGHT$(address$,4)="0000" OR RIG HT$(address$,4)="FFFF" THEN language$="E xec" 2360IF RIGHT$(address$,4)="8000" THEN l anguage$="Rom" 2380IF adfs% AND data?b% > &7F THEN lan guage$="(dir)":ignore%=FALSE 2400=language$ 2420: 2440DEFPROCmenu 2460REM to be able to use f-keys (f0=12 8,f1=129...)&shift/f-keys (f0=144,f1=145 ...) 2480*FX225,128 2500*FX226,144 2520option%=GET 2540IF option%>=128 AND option%<=129 TH EN 2640 2560IF option%>=144 AND option%<=147 TH EN 2640 2580IF dir`level%>1 AND option%=136 THE N 2640 2600game%=INSTR(LEFT$(option$,max`game% ),CHR$(option%)):REM change GET value to subscript 2620IF game%=0 THEN VDU7:GOTO 2520 2640REM reset function keys 2660*FX225,0 2680*FX226,128 2700ENDPROC 2720: 2740DEFPROCwhat`next 2760REM BASIC 2780IF lang$(game%)<>"Basic" THEN 2840 2800PAGE=EVAL("&"+load$(game%)) 2820CHAIN title$(game%) 2840REM ROM 2860IF lang$(game%)<>"Rom" THEN 2940 2880INPUT "Which rom socket " socket$ 2900action$="SRLOAD "+title$(game%)+" 8 000 "+socket$ 2920OSCLI(action$) 2930GOTO 3200 2940REM Exec 2960IF lang$(game%)<>"Exec" THEN 3040 2980action$="EXEC "+title$(game%) 3000OSCLI(action$) 3020GOTO 3200 3040REM Machine code 3060IF EVAL("&"+RIGHT$(load$(game%),4)) < &0E00 THEN 3160 3080REM no download required, just *RUN it 3100action$="*RUN "+title$(game%) 3120OSCLI(action$) 3140GOTO 3200 3160REM download required 3180PROCdownload(title$(game%),load$(ga me%),exec$(game%),length$(game%)) 3200ENDPROC 3220: 3240DEFPROCdownload(title$,load$,exec$, length$) 3260REM to load supplied program at E00 , and shift 3280REM down to appropriate place(load$ ), before entering 3300REM at required execution address(e xec$) 3320P%=&7500 3340FOR I%=0 TO 2 STEP 2:REM USE 3 FOR ERRORS 3360[OPT I% 3380.GO LDX #load MOD 256 3400 LDY #load DIV 256 3420 JSR &FFF7 3440 LDX #tape MOD 256 3460 LDY #tape DIV 256 3480 JSR &FFF7 3500 LDY #0 3520 STY &70 3540 STY &72 3560 LDA move+1 ½ FINAL LOAD ADDR 3580 STA &71 ½ (IN &71 & &70) 3600 LDA #&0E ½ WHERE *LOADED 3620 STA &73 ½ (IN &73 & &72) 3640 LDX size ½ see if part page to be moved 3660 BNE LAB0 3680 INC size+1 ½ if so, up no of pages 3700.LAB0 LDX size+1 ½ No full pages to move 3720.LAB1 LDA (&72),Y ½(&72/&73)+Y 3740 STA (&70),Y ½(&70/&71)+Y 3760 DEY 3780 BNE LAB1 3800 INC &71 ½NEXT 'TO' P AGE 3820 INC &73 ½NEXT 'FROM' P AGE 3840 DEX 3860 BNE LAB1 3880 JMP (entry) 3900.load EQUS "LOAD " 3920.file EQUS "BLAGGER " 3940 EQUS " E00" ½address where to load 3960 EQUB &0D 3980.tape EQUS "TAPE" 4000 EQUB &0D 4020.entry EQUW &3000 4040.move EQUW &0400 4060.size EQUW &6500 4080] 4100NEXT 4120FOR I%=0 TO 10:?(file+I%)=ASC(MID$( title$,I%+1,1)):NEXT 4140!entry=EVAL("&"+exec$) 4160!move=EVAL("&"+load$) 4180!size=EVAL("&"+length$) 4200CALL GO 4220ENDPROC 4240: 4260DEFPROCrw`DFS`sector(drive%,func$,e rr$,track%,sector%,size%,no`sec%) 4280block?0=drive% 4300block!1=data 4320block?5=3:REM no. paras 4340IF func$="W" block?6=&4B ELSE block ?6=&53 4360block?7=track% 4380block?8=sector% 4400block?9=(size%*32)+no`sec%:REM usua lly &21 4420X%=block MOD 256 4440Y%=block DIV 256 4460A%=&7F 4480CALL &FFF1 4500IF block?10<>0 AND err$<>"N" PRINT "error &";÷block?10:STOP 4520ENDPROC 4540: 4560DEFPROCprint`DFS`cat 4580LOCAL I%,J%,K%,col% 4600CLS 4620FOR K%=0 TO 1:PRINT CHR$(141)CHR$(1 31)CHR$(157)CHR$(132)"Games Menu Drive: ";xdr%:NEXT 4640J%=1 4680FOR I%=0 TO data?(256+5)-1 STEP 8 4700ignore%=TRUE 4720REM IF data?(I%+5)=&00 THEN I%=(47* 26):GOTO 4960:REM no more dir entries 4740title$(J%) =FNstring(I%+15,I%+15)+" ."+FNstring(I%+8,I%+14) 4760load$(J%) =FNaddress(256+I%+8,256+ I%+9) 4780exec$(J%) =FNaddress(256+I%+10,256 +I%+11) 4800length$(J%)=FNaddress(256+I%+12,256 +I%+13) 4820stsec$(J%) =FNaddress(256+I%+15,256 +I%+15) 4822REM now decode byte14 - bits0/1=sec tor, 2/3=load, 4/5=length, 6/7=exec 4823byte%=data?(256+I%+14) 4824stsec$(J%)=STR$÷(byte%MOD4)+stsec$( J%):byte%=byte%DIV4 4825IF byte%MOD4=3 temp$="FF" ELSE temp $=STR$÷(byte%MOD4) 4826load$(J%)=temp$+load$(J%):byte%=byt e%DIV4 4827IF byte%MOD4=3 temp$="FF" ELSE temp $=STR$÷(byte%MOD4) 4828length$(J%)=temp$+length$(J%):byte% =byte%DIV4 4829IF byte%MOD4=3 temp$="FF" ELSE temp $=STR$÷(byte%MOD4) 4830exec$(J%)=temp$+exec$(J%) 4840lang$(J%) =FNlang(exec$(J%),0) 4860IF ignore% THEN 4980 4880col%=130 4900PRINT ;CHR$(135);MID$(option$,J%,1) ;CHR$(col%);title$(J%); 4920IF J%MOD3=0 PRINT 4940REM load$(J%),exec$(J%),length$(J%) ,stsec$(J%),lang$(J%);ignore% 4960J%=J%+1 4980NEXT 5000max`game%=J%-1 5040PRINTTAB(1,19);CHR$(131)CHR$(157)CH R$(132)" f0/1: ADFS drive,";:IF dir` level%>1 PRINT ;"f8: parent dir" 5060PRINTTAB(1,20);CHR$(131)CHR$(157)CH R$(132)"shft+f0/3: DFS drive," 5080IF max`game%>0 PRINTTAB(1,21);CHR$( 131)CHR$(157)CHR$(132)" else lett er for OPTION" 5100ENDPROC