1 REM ex MENU15 - with references to drive$ removed
   20 REM P.GMENU REV 5.00 To read games menu for 'H' Leivers (Solinet Mar'93)
   40 REM assumptions: 1) all files that aren't directories, and don't have an
   60 REM                 uppercase letter in their name, are to be ignored as
   80 REM                 a valid option in the menu
  100 REM              3) No more than 10 levels of directories - NOT tested for
  120 REM Modified with additional suggestions by H.Leivers
  140 REM Now caters for:  DFS/ADFS
  180 MODE 7
  200 CLEAR
  220 HIMEM=&7500:REM to leave space for machine code routine
  240 option$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstu"
  260 dir_level%=0
  280 DIM data 3000,block 20,title$(47),load$(47),exec$(47),length$(47),stsec$(47),seq$(47),lang$(47),xsec%(10)
  300 adfs%=FNwhat_system
  320 PROCinit_drive
  340 dir_level%=1:xsec%(dir_level%)=2
  360 IF adfs% OSCLI("FADFS"):OSCLI("MOUNT "+STR$(xdr%)) ELSE OSCLI("DISC"):OSCLI("DRIVE "+STR$(xdr%))
  380 IF adfs% PROCrw_adfs_sector(xdr%,"R","Y",xsec%(dir_level%),1,5):REM cat = sec2-6
  400 IF NOT adfs% PROCrw_DFS_sector(xdr%,"R","Y",0,0,1,2)
  420 IF adfs% PROCprint_ADFS_cat ELSE PROCprint_DFS_cat
  440 PROCmenu
  460 IF option%>=128 AND option%<=129 THEN xdr%=option%-128:adfs%=TRUE:GOTO 340
  480 IF option%>=144 AND option%<=147 THEN xdr%=option%-144:adfs%=FALSE:GOTO 340
  500 IF option%=136 THEN dir_level%=dir_level%-1:OSCLI("DIR ^"):GOTO 380:REM process higher directory
  520 IF lang$(game%)="(dir)" THEN OSCLI("*DIR "+title$(game%)):dir_level%=dir_level%+1:xsec%(dir_level%)=EVAL("&"+stsec$(game%)):GOTO 380
  540 PROCwhat_next
  560 GOTO 420
  580 END
  600 :
  620 DEFFNwhat_system
  640 REM 0-9 = none,tape1200,tape300,rom,dfs,nfs,teletext,ieee,adfs,anfs
  660 A%=0:Y%=0
  680 system%=USR(&FFDA)AND&F
  700 IF system%=8 =TRUE ELSE =FALSE
  720 :
  740 DEFPROCinit_drive
  760 block!1=data
  780 X%=block MOD 256
  800 Y%=block DIV 256
  820 A%=&05
  840 CALL &FFD1
  860 xdr%=data?(2+data?0)
  880 ENDPROC
  900 :
  920 DEFPROCrw_adfs_sector(drive%,func$,err$,absector%,size%,no_sec%)
  940 block?0=0
  960 block!1=data
  980 IF func$="W" block?5=&0A ELSE block?5=&08
 1000 block?6=(drive%*32)+(absector%DIV&10000):REM top 5 bits
 1020 block?7=((absector%MOD&10000)DIV&100):REM middle 8 bits
 1040 block?8=absector%MOD&100:REM low 8 bits
 1060 block?9=no_sec%
 1080 block?10=0:REM UNUSED
 1100 IF func$="W" block!11=????:REM write length
 1120 X%=block MOD 256
 1140 Y%=block DIV 256
 1160 A%=&72
 1180 CALL &FFF1
 1200 IF block?0<>0 AND err$<>"N" PRINT "error &";~block?0:STOP
 1220 ENDPROC
 1240 :
 1260 DEFPROCprint_ADFS_cat
 1280 LOCAL I%,J%,K%,col%
 1300 CLS
 1320 FOR K%=0 TO 1:PRINT CHR$(141)CHR$(131)CHR$(157)CHR$(132)"Games Menu               Drive: ";xdr%:NEXT
 1340 J%=1
 1380 FOR I%=0 TO (47*26)-1 STEP 26
 1400 ignore%=TRUE
 1420 IF data?(I%+5)=&00 THEN I%=(47*26):GOTO 1700:REM no more dir entries
 1440 title$(J%) =FNstring(I%+5,I%+14)
 1460 load$(J%)  =FNaddress(I%+15,I%+18)
 1480 exec$(J%)  =FNaddress(I%+19,I%+22)
 1500 length$(J%)=FNaddress(I%+23,I%+26)
 1520 stsec$(J%) =FNaddress(I%+27,I%+29)
 1540 seq$(J%)   =FNaddress(I%+30,I%+30)
 1560 lang$(J%)  =FNlang(exec$(J%),I%+5+3)
 1580 IF ignore% THEN 1700
 1600 IF lang$(J%)="(dir)" THEN col%=129 ELSE col%=130
 1620 PRINT ;CHR$(135);MID$(option$,J%,1);CHR$(col%);title$(J%);
 1640 IF J%MOD3=0 PRINT;CHR$(130);
 1660 REM  load$(J%),exec$(J%),length$(J%),stsec$(J%),seq$(J%),lang$(J%);ignore%
 1680 J%=J%+1
 1700 NEXT
 1720 max_game%=J%-1
 1760 PRINTTAB(1,19);CHR$(131)CHR$(157)CHR$(132)"     f0/1: ADFS drive,";:IF dir_level%>1 PRINT ;"f8: parent dir"
 1780 PRINTTAB(1,20);CHR$(131)CHR$(157)CHR$(132)"shft+f0/3: DFS drive,"
 1800 IF max_game%>0 PRINTTAB(1,21);CHR$(131)CHR$(157)CHR$(132)"        else letter for OPTION"
 1820 ENDPROC
 1840 :
 1860 DEFFNstring(a%,b%)
 1880 string$=""
 1900 LOCAL I%,len%
 1920 len%=(b%-a%)+1
 1940 FOR I%=a% TO b%
 1960 IF data?I% MOD &80=&0D THEN I%=b% ELSE string$=string$+CHR$(data?I% MOD &80)
 1980 IF (data?I% MOD &80) <= ASC("Z") AND (data?I% MOD &80) >= ASC("A") THEN ignore%=FALSE
 2000 NEXT
 2020 =LEFT$(string$+STRING$(len%," "),len%)
 2040 :
 2060 DEFFNaddress(a%,b%)
 2080 address$=""
 2100 LOCAL I%
 2120 FOR I%=b% TO a% STEP -1
 2140 address$=address$+RIGHT$("0"+STR$~data?I%,2)
 2160 NEXT
 2180 REM address%=address%+(&100000*data?b%)
 2200 REM IF address% DIV &10000 =&10 THEN address%=&FFFF0000+(address% MOD &10000)
 2220 =address$
 2240 :
 2260 DEFFNlang(address$,b%)
 2280 LOCAL language$
 2300 language$="Machine code"
 2320 IF RIGHT$(address$,4)="802B" OR RIGHT$(address$,4)="8023" OR RIGHT$(address$,4)="801F" OR RIGHT$(address$,4)="B823" OR RIGHT$(address$,4)="B82B" THEN language$="Basic"
 2340 IF RIGHT$(address$,4)="0000" OR RIGHT$(address$,4)="FFFF" THEN language$="Exec"
 2360 IF RIGHT$(address$,4)="8000" THEN language$="Rom"
 2380 IF adfs% AND data?b% > &7F THEN language$="(dir)":ignore%=FALSE
 2400 =language$
 2420 :
 2440 DEFPROCmenu
 2460 REM to be able to use f-keys (f0=128,f1=129...)&shift/f-keys (f0=144,f1=145...)
 2480 *FX225,128
 2500 *FX226,144
 2520 option%=GET
 2540 IF option%>=128 AND option%<=129 THEN 2640
 2560 IF option%>=144 AND option%<=147 THEN 2640
 2580 IF dir_level%>1 AND option%=136 THEN 2640
 2600 game%=INSTR(LEFT$(option$,max_game%),CHR$(option%)):REM change GET value to subscript
 2620 IF game%=0 THEN VDU7:GOTO 2520
 2640 REM reset function keys
 2660 *FX225,0
 2680 *FX226,128
 2700 ENDPROC
 2720 :
 2740 DEFPROCwhat_next
 2760 REM BASIC
 2780 IF lang$(game%)<>"Basic" THEN 2840
 2800 PAGE=EVAL("&"+load$(game%))
 2820 CHAIN title$(game%)
 2840 REM ROM
 2860 IF lang$(game%)<>"Rom" THEN 2940
 2880 INPUT "Which rom socket " socket$
 2900 action$="SRLOAD "+title$(game%)+" 8000 "+socket$
 2920 OSCLI(action$)
 2930 GOTO 3200
 2940 REM  Exec
 2960 IF lang$(game%)<>"Exec" THEN 3040
 2980 action$="EXEC "+title$(game%)
 3000 OSCLI(action$)
 3020 GOTO 3200
 3040 REM Machine code
 3060 IF EVAL("&"+RIGHT$(load$(game%),4)) < &0E00 THEN 3160
 3080 REM no download required, just *RUN it
 3100 action$="*RUN "+title$(game%)
 3120 OSCLI(action$)
 3140 GOTO 3200
 3160 REM download required
 3180 PROCdownload(title$(game%),load$(game%),exec$(game%),length$(game%))
 3200 ENDPROC
 3220 :
 3240 DEFPROCdownload(title$,load$,exec$,length$)
 3260 REM to load supplied program at E00, and shift
 3280 REM down to appropriate place(load$), before entering
 3300 REM at required execution address(exec$)
 3320 P%=&7500
 3340 FOR 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'   PAGE
 3820       INC &73        \NEXT 'FROM' PAGE
 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 ]
 4100 NEXT
 4120 FOR 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$)
 4200 CALL GO
 4220 ENDPROC
 4240 :
 4260 DEFPROCrw_DFS_sector(drive%,func$,err$,track%,sector%,size%,no_sec%)
 4280 block?0=drive%
 4300 block!1=data
 4320 block?5=3:REM no. paras
 4340 IF func$="W" block?6=&4B ELSE block?6=&53
 4360 block?7=track%
 4380 block?8=sector%
 4400 block?9=(size%*32)+no_sec%:REM usually &21
 4420 X%=block MOD 256
 4440 Y%=block DIV 256
 4460 A%=&7F
 4480 CALL &FFF1
 4500 IF block?10<>0 AND err$<>"N" PRINT "error &";~block?10:STOP
 4520 ENDPROC
 4540 :
 4560 DEFPROCprint_DFS_cat
 4580 LOCAL I%,J%,K%,col%
 4600 CLS
 4620 FOR K%=0 TO 1:PRINT CHR$(141)CHR$(131)CHR$(157)CHR$(132)"Games Menu               Drive: ";xdr%:NEXT
 4640 J%=1
 4680 FOR I%=0 TO data?(256+5)-1 STEP 8
 4700 ignore%=TRUE
 4720 REM IF data?(I%+5)=&00 THEN I%=(47*26):GOTO 4960:REM no more dir entries
 4740 title$(J%) =FNstring(I%+15,I%+15)+"."+FNstring(I%+8,I%+14)
 4760 load$(J%)  =FNaddress(256+I%+8,256+I%+9)
 4780 exec$(J%)  =FNaddress(256+I%+10,256+I%+11)
 4800 length$(J%)=FNaddress(256+I%+12,256+I%+13)
 4820 stsec$(J%) =FNaddress(256+I%+15,256+I%+15)
 4822 REM now decode byte14 - bits0/1=sector, 2/3=load, 4/5=length, 6/7=exec
 4823 byte%=data?(256+I%+14)
 4824 stsec$(J%)=STR$~(byte%MOD4)+stsec$(J%):byte%=byte%DIV4
 4825 IF byte%MOD4=3 temp$="FF" ELSE temp$=STR$~(byte%MOD4)
 4826 load$(J%)=temp$+load$(J%):byte%=byte%DIV4
 4827 IF byte%MOD4=3 temp$="FF" ELSE temp$=STR$~(byte%MOD4)
 4828 length$(J%)=temp$+length$(J%):byte%=byte%DIV4
 4829 IF byte%MOD4=3 temp$="FF" ELSE temp$=STR$~(byte%MOD4)
 4830 exec$(J%)=temp$+exec$(J%)
 4840 lang$(J%)  =FNlang(exec$(J%),0)
 4860 IF ignore% THEN 4980
 4880 col%=130
 4900 PRINT ;CHR$(135);MID$(option$,J%,1);CHR$(col%);title$(J%);
 4920 IF J%MOD3=0 PRINT
 4940 REM load$(J%),exec$(J%),length$(J%),stsec$(J%),lang$(J%);ignore%
 4960 J%=J%+1
 4980 NEXT
 5000 max_game%=J%-1
 5040 PRINTTAB(1,19);CHR$(131)CHR$(157)CHR$(132)"     f0/1: ADFS drive,";:IF dir_level%>1 PRINT ;"f8: parent dir"
 5060 PRINTTAB(1,20);CHR$(131)CHR$(157)CHR$(132)"shft+f0/3: DFS drive,"
 5080 IF max_game%>0 PRINTTAB(1,21);CHR$(131)CHR$(157)CHR$(132)"        else letter for OPTION"
 5100 ENDPROC