10 REM Sideways Ram Utilites
   20 REM Written by Ben J. Dooks
   30 REM (c) 1990 Micro User
   40 REM
   50 REM Put all Rom Images in DIR R
   60 REM
   70 RM%=0:BK%=0
   80 DR%=0:TI$=" Hello"
   90 DIM RF$(32),RAM(16),LF$(16),LF(16)
  100 ONERROR IF ERR=17 END ELSE REPORT:PRINT " at line ";ERL:A=INKEY(200):GOTO 180
  110 MODE 7:HIMEM=&3C00
  120 HIMEM=&3C00
  130 PRINT ''" Programmed by B.J. Dooks"
  140 PRINT ''" Please wait .."'" Reading files ";
  150 PROCrfile
  160 PROCass
  170 PROCfindram
  180 MODE 7:HIMEM=&3C00
  190 s$=STRING$(34,"s")
  200 PRINT CHR$(148);" ";s$
  210 PRINT CHR$(141);CHR$(134);CHR$(157);CHR$(132);" Sideways RAM/ROM Utilites      ";CHR$(156)'CHR$(141);CHR$(134);CHR$(157);CHR$(132);" Sideways RAM/ROM Utilites      ";CHR$(156)
  220 PRINT CHR$(148)" ";STRING$(34,"s")
  230 PRINTTAB(1,19)CHR$(148)STRING$(34,"s")
  240 PRINTTAB(0,20)" ";CHR$(134);CHR$(157);CHR$(132);"  Drive :";CHR$(135);DR%;CHR$(132)"  Tit.";CHR$(135);TI$
  250 PRINTTAB(36,20)CHR$(156)
  260 PRINTTAB(0,21)" ";CHR$(134);CHR$(157);CHR$(135);"  ";FI%;CHR$(132);"Rom Image(s) on disc"
  270 PRINTTAB(36,21)CHR$(156)
  280 PRINTTAB(0,22)" ";CHR$(134);CHR$(157);CHR$(135);"  ";BK%;CHR$(132);"Bank(s) of RAM‡ ";CHR$(135);RM%;CHR$(132);"Roms"
  290 PRINTTAB(36,22)CHR$(156)
  300 PRINTTAB(1,23)CHR$(148);s$
  310 VDU 28,2,18,34,4
  320 PRINT '''" L..... Load to Sideways RAM"
  330 PRINT " S..... Save ROM Image"
  340 PRINT " C..... Clear Sideways RAM"
  350 PRINT " R..... List ROM's"
  360 PRINT " F..... List ROM Files on disc "
  370 PRINT " I..... Infomation on ROM "
  380 PRINT " (0-4). Change drive"
  390 PRINT '" Chose: "
  400 A$=GET$
  410 A=ASC(A$)
  420 IF A$="L" PROCl:GOTO 180
  430 IF A$="C" PROCc:GOTO 180
  440 IF A$="S" PROCs:GOTO 180
  450 IF A$="R" PROCr:GOTO 180
  460 IF A$="I" PROCi:GOTO 180
  470 IF A$="F" PROCf:GOTO 180
  480 IF A>47 AND A<53 PROCndrive:GOTO 180
  490 GOTO 400
  500 DEFPROCfindram
  510 CALL findram
  520 FOR I=HIMEM TO HIMEM+16
  530 RAM(I-HIMEM)=?I
  540 IF ?I=255 THEN BK%=BK%+1
  550 NEXT
  560 FOR I=0 TO 16 STEP 1
  570 IF ?(&2A1+I)>0 THEN RM%=RM%+1
  580 IF ?(&2A1+I)>0 AND RAM(I)=255 THEN LF(I)=1:LF$(I)=FNromtitle(I)
  590 NEXT I
  600 ENDPROC
  610 DEFPROCass
  620 romt=HIMEM
  630 FOR I%=0 TO 2 STEP 2
  640 P%=&900
  650 [OPT I%
  660 .findram
  670 LDA&F4:PHA
  680 LDA#0:LDX#15
  690 .lp3
  700 STA romt,X
  710 STX&F4:STX&FE30
  720 STX&8000
  730 DEX:BPL lp3
  740 LDX#15:LDA#255
  750 .lp4
  760 STX&F4:STX&FE30
  770 CPX&8000:BNE notram1
  780 STA romt,X
  790 .notram1
  800 DEX:BPL lp4
  810 LDX#15
  820 .lp5
  830 STX&F4:STX&FE30
  840 LDA#&4C:STA&8000
  850 LDA&8000
  860 CMP #&4C:BEQ notnotram2
  870 LDA#0:STA romt,X
  880 .notnotram2
  890 DEX:BPL lp5
  900 PLA:STA&F4:STA&FE30
  910 RTS
  920 .rtitle
  930 LDA &F4
  940 PHA
  950 SEI
  960 STX &F4:STX &FE30
  970 LDX #9
  980 LDY #0
  990 .looprt
 1000 LDA &8000,X
 1010 STA &C00,Y
 1020 CMP #0
 1030 BEQ finrd
 1040 CPX #&1C
 1050 BEQ finrd
 1060 INX:INY
 1070 JMP looprt
 1080 .finrd
 1090 INY
 1100 LDA #13
 1110 STA &C00,Y
 1120 PLA
 1130 STA &F4
 1140 STA &FE30
 1150 CLI
 1160 RTS
 1170 .moveup
 1180 SEI
 1190 LDA &F4:PHA
 1200 STX &F4
 1210 STX &FE30
 1220 LDA #0
 1230 LDA #0
 1240 STA &72
 1250 LDA #&3C
 1260 STA &71
 1270 LDA #&80
 1280 LDY #0
 1290 STA &73
 1300 .loopup
 1310 LDA (&70),Y
 1320 STA (&72),Y
 1330 CPY #&FF
 1340 BEQ incc
 1350 INY:JMP loopup
 1360 .incc
 1370 LDA &71
 1380 CLC
 1390 ADC #1
 1400 STA &71
 1410 CMP #&7C
 1420 BEQ finup
 1430 INC &73
 1440 LDY #0
 1450 JMP loopup
 1460 .finup
 1470 PLA:STA &F4
 1480 STA &FE30
 1490 CLI
 1500 RTS
 1510 .movedown
 1520 SEI
 1530 LDA &F4:PHA
 1540 STX &F4
 1550 STX &FE30
 1560 LDA #0
 1570 STA &72
 1580 STA &70
 1590 LDA #&3C
 1600 STA &71
 1610 LDA #&80
 1620 STA &73
 1630 LDY #0
 1640 .loopdown
 1650 LDA (&72),Y
 1660 STA (&70),Y
 1670 CPY #&FF
 1680 BEQ incd
 1690 INY
 1700 JMP loopdown
 1710 .incd
 1720 LDA &71
 1730 CLC
 1740 ADC #1
 1750 STA &71
 1760 CMP #&7C
 1770 BEQ findown
 1780 INC &73
 1790 LDY #0
 1800 JMP loopdown
 1810 .findown
 1820 PLA
 1830 STA &F4
 1840 STA &FE30
 1850 CLI
 1860 RTS
 1870 .clear
 1880 LDA &F4:PHA
 1890 SEI
 1900 STX &F4:STX &FE30
 1910 LDA #0:STA &70
 1920 LDA #&80:STA &71
 1930 LDA #0
 1940 LDY #0
 1950 .loopclr
 1960 LDA #0
 1970 STA (&70),Y
 1980 LDA &70
 1990 ADC #1
 2000 STA &70
 2010 LDA &71
 2020 ADC #0
 2030 STA &71
 2040 CMP #&C0
 2050 BEQ finclr
 2060 LDA #0
 2070 JMP loopclr
 2080 .finclr
 2090 PLA:STA &F4
 2100 STA &FE30
 2110 CLI
 2120 RTS
 2130 ]:NEXT
 2140 ENDPROC
 2150 RTS
 2160 DEFPROCr
 2170 CLS
 2180 PRINT ' " Current Roms are :"
 2190 PROCrlist
 2200 PROCwait:ENDPROC
 2210 ENDPROC
 2220 DEFPROCrlist
 2230 I=15
 2240 REPEAT
 2250 T$=FNromtype(I)
 2260 IF ?(&2A1+I)=0 THEN 2310
 2270 RT$=FNromtitle(I)
 2280 IF RAM(I)=&FF THEN C=131 ELSE C=134
 2290 PROCromp(I,CHR$(130)+T$+CHR$(C)+RT$)
 2300 T=0
 2310 I=I-1:UNTIL I=0
 2320 PRINT " ";CHR$(131);"Yellow =";CHR$(134);"Sideways Ram"
 2330 ENDPROC
 2340 DEF FNromtype(ROM%)
 2350 X%=?(&2A1+ROM%)
 2360 IF (X% AND 64)=64 THEN U$="Language":GOTO 2390
 2370 IF (X% AND 128)=128 THEN U$="Utility ":GOTO 2390
 2380 U$=""
 2390 =U$
 2400 DEF FNromtitle(ROM%)
 2410 IF ?(&2A1+ROM%)=0 THEN U$="":GOTO 2450
 2420 X%=ROM%
 2430 CALL rtitle
 2440 =$&C00
 2450 =""
 2460 DEFPROCromp(R%,M$)
 2470 PRINT CHR$(131);R%;CHR$(134);"....";
 2480 PRINTTAB(6,VPOS);M$
 2490 ENDPROC
 2500 DEFPROCl
 2510 CLS
 2520 IF BK%<1 THEN PRINT '''CHR$(134);"No SIDEWAYS RAM Present ":VDU 7:A=INKEY(300):ENDPROC
 2530 PRINT " Sideways RAM Status"
 2540 PROCdispram
 2550 PRINT
 2560 FOR I=1 TO FI% STEP 2
 2570 PRINT CHR$(134);CHR$(64+I);CHR$(131);;RF$(I);CHR$(134);CHR$(65+I);CHR$(131);RF$(I+1)
 2580 NEXT
 2590 PRINT 'CHR$(134)"Letter or 'RETURN' to EXIT";CHR$(133);"?"
 2600 F$=GET$
 2610 IF F$=CHR$(13) THEN ENDPROC
 2620 X=ASC(F$):IF X>64 AND X<90 THEN F$=RF$(X-64) ELSE VDU 7:GOTO 2600
 2630 PRINT CHR$(133)"Socket (0-16) ";:INPUT SN%
 2640 IF SN%<0 OR SN%>15 THEN VDU 7:GOTO 2510
 2650 IF RAM(SN%)<>255 THEN PRINT '" Bad socket ":VDU 7:A=INKEY(150):GOTO 2510
 2660 PROCload(SN%,F$)
 2670 LF(SN%)=1
 2680 LF$(SN%)=F$
 2690 PRINT CHR$(133)"Update ROM table ";
 2700 INPUT U$
 2710 IF U$="Y" THEN ?(&2A1+SN%)=?&3C06
 2720 ENDPROC
 2730 DEFPROCrfile
 2740 PROCdrive
 2750 *DIR R
 2760 FI%=0
 2770 ?&CD0=0
 2780 !&CD1=&C30
 2790 REPEAT
 2800 !&CD1=&C30
 2810 !&CD5=1
 2820 FI%=FI%+1
 2830 X%=&D0
 2840 Y%=&C
 2850 A%=8
 2860 R%=USR(&FFD1) AND &1000000
 2870 IF R%=TRUE THEN 2920
 2880 L=?&C30
 2890 ?(&C31+L)=13
 2900 RF$(FI%)=$&C31
 2910 PRINT "*";
 2920 UNTIL R%
 2930 ?&CD0=0
 2940 !&CD1=&C30
 2950 !&CD5=1
 2960 !&CD9=0
 2970 X%=&D0:Y%=&C
 2980 A%=5
 2990 CALL &FFD1
 3000 L=?&C30:?(&C31+L)=13
 3010 TI$=$&C31
 3020 FI%=FI%-1
 3030 ENDPROC
 3040 DEFPROCdrive
 3050 PROCosc("DRIVE "+STR$(DR%))
 3060 ENDPROC
 3070 DEFPROCosc($&C00)
 3080 X%=0
 3090 A%=0
 3100 Y%=&C
 3110 CALL &FFF7
 3120 ENDPROC
 3130 DEFPROCload(SK%,F$)
 3140 PROCosc("LOAD "+F$+" 3C00")
 3150 X%=SK%
 3160 CALL moveup
 3170 ENDPROC
 3180 DEFPROCsave(SK%,F$)
 3190 X%=SK%
 3200 CALL movedown
 3210 PROCosc("SAVE "+F$+" 3C00 7C00 8000 8000")
 3220 ENDPROC
 3230 DEFPROCndrive
 3240 DR%=A-48
 3250 CLS
 3260 PRINT '''" Changing to Drive ";DR%
 3270 PRINT ''" Reading files :";
 3280 PROCrfile
 3290 ENDPROC
 3300 DEFPROCc
 3310 CLS
 3320 PRINT '" Clear Sideways RAM"'
 3330 PROCdispram
 3340 PRINT 'CHR$(133)"Socket ";:INPUT SK%
 3350 X%=SK%
 3360 ?(&2A1+SK%)=0:LF(SK%)=0
 3370 X%=SK%
 3380 CALL clear
 3390 PRINT " Cleared ":A=INKEY(100):ENDPROC
 3400 DEFPROCdispram
 3410 R=15
 3420 REPEAT
 3430 IF RAM(R)<>255 THEN 3470
 3440 PRINT CHR$(131);R;CHR$(134);"....";
 3450 IF LF(R)=0 THEN PRINTTAB(10,VPOS)"‡Nothing Loaded "
 3460 IF LF(R)=1 THEN PRINTTAB(10,VPOS)CHR$(131);LF$(R);CHR$(134);"Loaded "
 3470 R=R-1
 3480 UNTIL R=0
 3490 ENDPROC
 3500 DEFPROCs
 3510 CLS
 3520 PROCrlist
 3530 PRINT 'CHR$(133)"Socket ";:INPUT SK%
 3540 IF SK%<0 OR SK%>15 THEN PRINT '" Bad socket ":VDU 7:A=INKEY(100):GOTO 3510
 3550 PRINT 'CHR$(133)"Filename ";:INPUT F$
 3560 IF F$="" ENDPROC
 3570 PROCsave(SK%,F$)
 3580 PRINT '"Done"
 3590 FI%=FI%+1
 3600 RF$(FI%-1)=F$
 3610 GOTO 3510
 3620 DEFPROCf
 3630 CLS
 3640 PRINT CHR$(135)" Rom Files on Disc "
 3650 PRINT
 3660 FOR I=1 TO FI% STEP 2
 3670 PRINT CHR$(134);" ";RF$(I);CHR$(131);".....";CHR$(134);RF$(I+1)
 3680 NEXT
 3690 PROCwait
 3700 ENDPROC
 3710 DEFPROCi
 3720 CLS
 3730 PRINT CHR$(135);" From ROM or ROM File (R/F) "
 3740 A$=GET$
 3750 IF A$="R" PROCri:ENDPROC
 3760 IF A$="F" PROCfi:ENDPROC
 3770 VDU 7:GOTO 3720
 3780 ENDPROC
 3790 DEFPROCri
 3800 CLS
 3810 PRINT 'CHR$(133)" Socket ";
 3820 INPUT "";SK%
 3830 IF SK%<0 OR SK%>15 THEN 3800
 3840 X%=SK%
 3850 A%=0:Y%=0
 3860 CALL movedown
 3870 PROCpi
 3880 ENDPROC
 3890 DEFPROCfi
 3900 PRINT 'CHR$(133)" Filename ";
 3910 INPUT "";F$
 3920 PROCosc("LOAD "+F$+" 3C00")
 3930 PROCpi
 3940 ENDPROC
 3950 DEFPROCpi
 3960 CLS
 3970 IF A$="R" PRINT '" Rom number ";SK%;"'s info:"
 3980 IF A$="F" PRINT '" Rom file ";F$;"'s info:"
 3990 PRINT CHR$(134)" Rom type ";CHR$(131);
 4000 T%=?&3C06
 4010 IF (T% AND 64)=64 PRINT " Language " ELSE IF (T% AND 128)=128 PRINT " Utility "
 4020 I=&3C08
 4030 REPEAT
 4040 I=I+1
 4050 IF ?I=0 THEN ?I=13
 4060 UNTIL ?I=13 OR I=&3C19
 4070 ?&3C19=13
 4080 PRINT CHR$(134)" Rom tit.  ";CHR$(131);$&3C09
 4090 IF (T% AND 64)=64 THEN PRINT 'CHR$(134)" Language entry ";CHR$(131);"&";~(?&3C01+?&3C02*256):ELSE PRINT 'CHR$(134)" No Language Entry"
 4100 IF (T% AND 128)=128 THEN PRINT CHR$(134)" Service  entry ";CHR$(131);"&";~(?&3C04+?&3C05*256):ELSE PRINT CHR$(134)" No Service Entry "
 4110 IF (T% AND 32)=32 THEN PRINT 'CHR$(134)" Tube Relocatable "
 4120 PROCwait:ENDPROC
 4130 DEFPROCwait
 4140 I=INKEY(1000):ENDPROC