10REM Rom builder program 20REM By Dugald Holmes 30REM The Animation Station 40REM Tel.:(0372) 743809 50MODE7:IF PAGE<>&5900 THENPAGE=&5900 :CHAIN"PROMMER" 60ONERRORVDU26:PROCer2:END 70PROCinit:PROCscr1:PROCrom 80PROCsize:PROChdr:H%=P%-C% 90PROCscr2:I%=0:PROCfname 100IFI%<0 END ELSEIFI%>1 PROCsort 110FORB%=0TO2STEP2:P%=C% 120PROChdr:PROClist:NEXT 130PROCscr3:PROCgfiles:PROCclear 140ONERROR PROCer1:GOTO 150 150IF FNy("Save to disk ") PROCsave E LSE GOTO170 160IF FNy("Further copies")THEN150 170IF NOT saved END 180IF FNy("Load to S/W RAM") PROCram 190END 200DEFPROCinit:saved=FALSE 210B%=0:G%=&FFFF:K%=&FFE3:M%=&FFE7:T%= &FFF4 220DIMNm$(15),Ln%(15),Ad%(15),DNm$(15) ,p%(15),Ld%(15),Xq%(15) 230A%=&83:C%=(USR(T%) DIV 256) AND &FF 00:S%=&900:O%=&8000-C% 240master= (253=INKEY-256):ENDPROC 250DEFPROCer1 260IF ERR=190 OR ERR=195 OR ERR=198 OR ERR=201 THEN290 270DEFPROCer2 280REPORT:PRINT" at line ";ERL:END 290CLS:REPORT:VDU7:A=INKEY(200):CLS:EN DPROC 300DEFPROClist:[OPTB%:.hdg 310OPT FNs(" Program List") 320OPT FNeb(13):BRK:.ls:] 330FORJ%=0TOI%:[OPTB% 340OPT FNs(Nm$(J%)) 350OPT FNeb(Ad%(J%) DIV256) 360OPT FNeb(Ad%(J%) MOD256) 370OPT FNew(Ln%(J%)) 380OPT FNeb(p%(J%)) 390OPT FNew(Ld%(J%)) 400OPT FNew(Xq%(J%)) 410]NEXT:[OPTB%:OPT FNeb(&FF) 420BRK:.lh% 430OPT FNs(LEFT$(r$,1)) 440OPT FNeb(&FE):]ENDPROC 450DEFPROChdr:P%=C%:[OPTB% 460BRK:BRK:BRK:JMPO%+E% 470OPT FNeb(&82) 480OPT FNeb(D% MOD256) 490OPT FNeb(1) 500.t%:OPT FNs(r$):.D%:BRK 510OPT FNs("(C) 1987 Hugh Haskell") 520BRK:.E%:PHA:CMP#9:BEQh% 530CMP#4:BEQnr:PLA:RTS:.h% 540TYA:PHA:TXA:PHA:LDA(&F2),Y 550CMP#13:BEQsh%:LDX#&FF:DEY 560.L0:INX:INY:LDAO%+lh%,X 570CMP(&F2),Y:BEQL0:CMP#&FE 580BEQprgs:PLA:TAX:PLA:TAY 590PLA:RTS:.sh%:JSRO%+ph% 600JMPO%+out:.ph%:JSRM% 610LDX#&FF:.L1:INX:LDAO%+t%,X 620JSRK%:BNEL1:JSRM%:RTS 630.prgs:JSRO%+ph%:JSRM% 640LDX#&FF:.L2:INX:LDAO%+hdg,X 650JSRK%:CMP#13:BNEL2:JSRM% 660LDY#&FF:.stn:LDX#5:LDA#32 670.spc:JSRK%:DEX:BNEspc:.L3 680INY:LDAO%+ls,Y:BMInxn 690JSRK%:BNEL3:.nxn:TAX:JSRM% 700CPX#&FF:BEQout:TYA:CLC:ADC#8 710CMP#&FF:BEQout:TAY:BNEstn 720.nr:TYA:PHA:TXA:PHA:DEY 730STY86:LDX#&FF:.L4:INX:INY 740LDAO%+ls,X:BMIfnd:LDA(&F2),Y 750CMPO%+ls,X:BEQL4:CMP#&2E 760BNEncd:INY:.L5:INX 770LDAO%+ls,X:BPLL5:JMPO%+fnd 780.ncd:INX:LDAO%+ls,X:BPLncd 790CMP#&FF:BEQout:TXA:CLC:ADC#8 800CMP#&FF:BEQout:TAX:LDY86 810JMPO%+L4:.out:PLA:TAX 820PLA:TAY:PLA:RTS:.fnd:CMP#&FF 830BEQout:STA83:INX:LDAO%+ls,X 840STA82:INX:LDAO%+ls,X:STA84 850INX:LDAO%+ls,X:STA85:INX 860LDAO%+ls,X:STA86:BEQdef 870BMIm%:STA24:CMP#&19 880BEQdef:BCSdef:LDA#&8C:JSRT% 890.def:LDA24:STA88:LDA#0:STA87 900.mv%:LDX85:CPX#0:BEQsp%:LDY#0 910.L6:LDA(82),Y:STA(87),Y:INY 920BNEL6:INC88:INC83:DEX:BNEL6 930.sp%:LDY84:.L7:LDA(82),Y 940STA(87),Y:DEY:BNEL7:LDA(82),Y 950STA(87),Y:LDA86:BMIms% 960LDA#&8A:LDX#&00:LDY#79:JSRT% 970LDY#76:JSRT%:LDY#68:JSRT% 980LDY#13:JSRT%:LDY#82:JSRT% 990LDY#85:JSRT%:LDY#78:JSRT% 1000LDY#13:JSRT%:.ex%:PLA:PLA 1010PLA:LDA#0:RTS:.m%:INX 1020LDAO%+ls,X:STA87:INX 1030LDAO%+ls,X:STA88 1040LDA#&60:LDY86:CPY#&FF 1050BNEload:LDA#&4C:.load 1060STA89:INX:LDAO%+ls,X 1070STA90:INX:LDAO%+ls,X:STA91 1080JMPO%+mv%:.ms%:JSR89 1090JMPO%+ex%:]ENDPROC 1100DEFFNS(n$) 1110IFLEFT$(n$,1)=" " n$=RIGHT$(n$,LENn $-1):GOTO1110 1120IFRIGHT$(n$,1)=" " n$=LEFT$(n$,LENn $-1):GOTO1120 1130DNm$(I%)=n$ 1140IFLEFT$(n$,1)=":" n$=RIGHT$(n$,LENn $-3) 1150IFINSTR(n$,".")=2 n$=RIGHT$(n$,LENn $-2) 1160=n$ 1170DEFFNy(y$) 1180PRINTCHR$12;y$;" Y/N"; 1190REPEAT:Z%=INSTR("YyNn*",GET$):UNTIL Z% 1200IFZ%=5 INPUT'"*"$S%:PROCos($S%):GOT O1180 1210PRINT:IFZ%<3 =TRUE ELSE =FALSE 1220DEFPROCos($S%) 1230X%=S% MOD256:Y%=S% DIV256:CALL&FFF7 :ENDPROC 1240DEFFNs($S%):$P%=$S% 1250P%=P%+LEN$P%:=B% 1260DEFFNeb(V%):?P%=V%:P%=P%+1:=B% 1270DEFFNew(V%):?P%=V% MOD256:P%?1=V% D IV256:P%=P%+2:=B% 1280DEFPROClfile:err=FALSE 1290F%=OPENIN(DNm$(J%)):CLOSE#0 1300IFF%>0 THEN1410 1310err=TRUE:VDU28,0,3,39,0,12 1320FORA=0 TO3:VDU31,0,A,132,157,131:NE XT 1330VDU28,3,3,39,0,15 1340PRINTCHR$129"Can't find "DNm$(J%) 1350PRINT"Change Disk, Directory, Drive " 1360PRINT"Press RETURN when ready to tr y again" 1370REPEAT:INPUT": "N$ 1380UNTILLENN$=0ORLEFT$(N$,1)="*" 1390IFLENN$>0PROCos(N$) 1400GOTO1290 1410PROCos("L."+DNm$(J%)+" "+STR$÷(Ad%( J%)-O%)) 1420IFerr VDU28,0,3,39,0,12,31,11,0,23, 1,0;0;0;0;:PROCscr1a 1430ENDPROC 1440DEFFNnname(n$):INPUT""R$:IFLENR$=0 =n$ ELSE =R$ 1450DEFFNchk(n$):m=ASCn$:IFm>47 ANDm<58 =TRUE ELSE =FALSE 1460DEFFNletr(n$):n=ASCn$AND&DF:IFn<65O Rn>90=FALSE ELSE =TRUE 1470DEFFNinfo($S%) 1480FORA=0TO16STEP4:A!96=0:NEXT 1490?96=S% MOD256:?97=S% DIV256 1500X%=96:Y%=0:A%=5:CALL&FFDD 1510Ld%(I%)=!98ANDG% 1520Xq%(I%)=!102ANDG% 1530Ln%(I%)=!106ANDG% 1540=Ln%(I%) 1550DEFPROCpage 1560INPUT"PAGE setting :- <ret>=default &"p$ 1570IF NOT FNhx(p$)THEN1560 1580IFLENp$=0 p%(I%)=0 ELSEp%(I%)=EVAL( "&"+p$) DIV256 1590Ld%(I%)=p%(I%)*256:ENDPROC 1600DEFPROClorun 1610PRINT"Load <L> or Run <RETURN> "; 1620REPEAT Z%=GET:Z%=Z% AND &DF:UNTILZ% =76 OR Z%=13 1630IF Z%=76 p%(I%)=&F0 ELSE p%(I%)=&FF :Z%=82 1640PRINTCHR$Z%:ENDPROC 1650DEFPROCrom 1660INPUT'"ROM name : "r$ 1670IFLENr$>7 PRINTCHR$7''"Too long to save on disk:"'"(Optional) new name ";:r $= FNnname(r$) 1680IFLENr$=0PRINTCHR$7'"You must give a name ! :- ";:r$= FNnname(r$):GOTO1670 1690ENDPROC 1700DEFPROCsize 1710INPUT'"ROM size . . 16K ";l$ 1720IFLENl$=0 ORNOT FNchk(l$) l%=0 ELSE l%=VAL(l$):PRINT 1730IFl%=0 ORl%>8 L%=&4000:ENDPROC 1740IFl% MOD2<>0 ORl%=6 l%=l%+1:GOTO174 0 1750L%=1024*l%:ENDPROC 1760DEFPROCfname:REPEAT 1770INPUT"File Name "N$ 1780IFLENN$=0THEN2070 1790IFLEFT$(N$,1)="*"PROCos(N$):GOTO177 0 1800Nm$(I%)= FNS(N$) 1810IF FNlen(Nm$(I%))THEN1770 1820F%= FNinfo(DNm$(I%)) 1830IFF%=0PRINT'CHR$129"No Such File":P ROCos("*."):GOTO1770 1840INPUT"Name for use in ROM "$S% 1850IFLEN$S%=0 $S%=Nm$(I%) 1860IFNOT FNletr($S%)PRINTCHR$7"Names m ust start with a letter":GOTO1840 1870IF FNlen($S%)THEN1840 1880Nm$(I%)=$S% 1890IFI%=0GOTO1930 ELSE used=FALSE:FORJ %=0TOI%-1 1900IFNm$(J%)=Nm$(I%) used=TRUE 1910NEXT 1920IF used PRINT"Used before":GOTO1840 1930Basic=(Xq%(I%)>&8000 AND Xq%(I%)<&C 000) 1940P%=C%:PROClist:tl%=P%-C%:Len%=0 1950FORJ%=0 TO15:Len%=Len%+Ln%(J%):NEXT 1960Q%=Len%+H%+tl% 1970IFQ%>L% PRINT"Not enough room for t hat one!!":Ln%(I%)=0:GOTO1770 1980IF Basic PROCpage ELSE PROClorun 1990PRINT"Space Remaining &";÷L%-Q% 2000Ad%(0)=&8000+H%+tl% 2010FORJ%=1TOI% 2020Ad%(J%)=Ad%(J%-1)+Ln%(J%-1) 2030NEXT 2040I%=I%+1 2050IFI%>15PRINTCHR$7"Catalogue full":G OTO2070 2060UNTILFALSE 2070UNTILTRUE 2080I%=I%-1:ENDPROC 2090DEFPROCgfiles 2100FORJ%=0TOI% 2110PROClfile 2120VDU28,0,24,39,8+J%,23,1,1;0;0;0; 2130PRINTCHR$130;Nm$(J%)TAB(14)CHR$134; DNm$(J%)TAB(29)CHR$131; 2140IFp%(J%)=0 PRINT"default";:GOTO2180 2150IF p%(J%)<&F0 PRINT"&"+STR$÷p%(J%)+ "00";: ELSE PRINT"&"+STR$÷Ld%(J%); 2160IFp%(J%)=&FF PRINT" r";:GOTO2180 2170IFp%(J%)=&F0 PRINT" l"; 2180PRINT:NEXT 2190VDU28,0,24,39,8+J%:REM9+(J%>15) 2200ENDPROC 2210DEFPROCclear 2220FORR%=Q%TOL%-4STEP4:C%!R%=TRUE:NEXT 2230IFR%<L% R%?C%=TRUE:R%=R%+1:GOTO2230 2240ENDPROC 2250DEFPROCram 2260IF NOT master THEN2310 2270PRINTCHR$12;"Slot No."; 2280REPEATz$=GET$:UNTILFNhx(z$) 2290PRINTz$;:b=EVAL("&"+z$) 2300OSCLI("SRLOAD "+LEFT$(r$,7)+" 8000 "+STR$÷b+" Q"):GOTO2320 2310PROCos("L."+LEFT$(r$,7)+" 8000") 2320PRINTCHR$12;CHR$133;SPC6"Loaded "CH R$129" - END";:A=INKEY(200):CLS:ENDPRO C 2330DEFPROCsave 2340PROCos("S."+LEFT$(r$,7)+" "+STR$÷C% +" "+STR$÷(C%+L%)) 2350saved=TRUE:ENDPROC 2360DEFFNlen(n$) 2370IFLENn$>7 PRINTCHR$7"Too long ! 7 c hars max":=TRUE ELSE =FALSE 2380DEFPROCscr1:VDU26,12,31,11,0,15 2390DEFPROCscr1a 2400PRINTCHR$&83+"PROGRAM PROMMER"' 2410PRINTSPC8CHR$&82+"(c) Hugh Haskell 1987" 2420ENDPROC 2430DEFPROCscr2:VDU28,0,24,39,4,12 2440$S%=CHR$129+r$+CHR$131+": Buffer &" +STR$÷C%+" - &"+STR$÷(C%+L%) 2450IFLEN$S%<40 PRINTTAB(20-LEN$S%/2);$ S% ELSEPRINT$S% 2460PRINT"* Commands:"'" May be entered in place of file name" 2470VDU28,0,24,39,8:ENDPROC 2480DEFPROCscr3:VDU28,0,24,39,5,12 2490PRINT'CHR$130"Call name"CHR$134" Disk name"CHR$131SPC5"PAGE" 2500VDU28,0,24,39,8:ENDPROC 2510DEFFNhx($S%) 2520IFLEN$S%=0 =TRUE 2530a=-1:REPEAT:a=a+1 2540IFNOT(S%?a>47ANDS%?a<58)ANDNOT(S%?a >64ANDS%?a<71)THENUNTILTRUE:=FALSE 2550UNTILa=LEN($S%)-1:=TRUE 2560DEFPROCsort:REPEATswapped=FALSE 2570FORJ%=0TOI%-1 2580N%=J%+1 2590IFNm$(J%)>Nm$(N%) PROCswap 2600NEXT 2610UNTILNOTswapped:ENDPROC 2620DEFPROCswap 2630$S%=Nm$(J%):Nm$(J%)=Nm$(N%):Nm$(N%) =$S% 2640$S%=DNm$(J%):DNm$(J%)=DNm$(N%):DNm$ (N%)=$S% 2650!S%=Ln%(J%):Ln%(J%)=Ln%(N%):Ln%(N%) =!S% 2660!S%=Ad%(J%):Ad%(J%)=Ad%(N%):Ad%(N%) =!S% 2670!S%=p%(J%):p%(J%)=p%(N%):p%(N%)=!S% 2680!S%=Ld%(J%):Ld%(J%)=Ld%(N%):Ld%(N%) =!S% 2690!S%=Xq%(J%):Xq%(J%)=Xq%(N%):Xq%(N%) =!S% 2700swapped=TRUE:ENDPROC