10
20
30
40 :
50 MODE&86:DIM Obj% &301,Buf% &100,ctrl% 20,data% 127,Sprite% 7,Icon% 31:X%=ctrl%:Y%=X%DIV256
60 Room0%=&8000:rom0%=4:rom1%=5:Room1%=&8000
70
80 OSGBPB=&FFD1:in%=0:out%=0:room%=-1
90 PROCasm:ONERROR IFFNerr:PROCend:END
100 PRINTSPC3"Jet Set Willy Room Editor"''SPC4"(C)1989-97 J.G.Harston"
110 VDU 23;9,7;0;0;0; 23;4,38;0;0;0;
120 VDU 23;10,&60;0;0;0;23;7,31;0;0;0;
130 VDU 23,136,255,0,0,0,0,0,0,0
140 VDU 23,137,128,128,128,128,128,128,128,128
150 VDU 23,138,16,0,16,0,16,0,16,0
160 VDU 23,139,&3C,&42,&99,&A1,&A1,&99,&42,&3C
170 FORA%=0TO16:PRINTTAB(32,A%);"‰":NEXT:PRINTSTRING$(40,"ˆ")
180 PROCRoom:ONERROR IFFNerr:PROCend:END
190 REPEATUNTILFNmenu:PROCend:END
200 :
210 DEFFNalloc(L%):DIMA%-1:IFHIMEM-A%-512>L%:DIMA%L%:=A% ELSE =0
220 :
230 DEFFNerr:REPORT:=TRUE
240 :
250 DEFPROCend:*FX4
260 END:ENDPROC
270 :
280 DEFFNmenu:A$=GET$:IFA$>"0" AND A$<"5":PRINTTAB(34,blk%*2+1)" "CHR$9" ";:blk%=VALA$-1:PROCBlk:=0
290 IFA$>CHR$135 AND A$<CHR$140:PROCMove:PRINTTAB(x%,y%);:=0
300 IFy%=16:PROCname:=0
310 IFy%>16 AND y%<20:PROCexit:=0
320 IFy%=21:::
330 :
340 IF A$=" " PROCput_in
350 IF A$="H" PROChelp(TRUE):PRINTTAB(Xc,Yc);
360 IF A$="E" PROCEditChar
370
380
390
400 IF A$="C" PROCConvs
410 IF A$="L" PROCLoad:PROCIndicate
420 IF A$="S" PROCSave:PROCIndicate
430 IF A$="R" PROCRoom:PROCIndicate
440 IF A$="*" PROCOscli:PROCIndicate
450 =1
460 :
470 DEFPROCBlk:PRINTTAB(34,blk%*2+1)">"CHR$9"<"TAB(x%,y%);:ENDPROC
480 :
490 DEFPROCMove:IFA$=CHR$137:x%=(x%+1)AND31:ENDPROC
500 IFA$=CHR$136:x%=(x%-1)AND31:ENDPROC
510 IFA$=CHR$138:y%=y%+1:ENDPROC
520 IFA$=CHR$139:y%=(y%-1)AND(y%>0):ENDPROC
530 ENDPROC
540 :
550 DEFPROCname:A%=ASCA$:IFroom%<0:ENDPROC
560 IFA%>31 AND A%<128:Buff%?x%=A%:VDUA%-12*(A%=127):x%=(x%+1)AND31:IFx%=0:VDU13
570 ENDPROC
580 :
590 DEFPROCRoom:PRINTTAB(0,21)"Room= ";:VDU8,8,8:INPUT""A$:IFA$="":PRINTTAB(5,21);room%;TAB(x%,y%);:ENDPROC
600 IFroom%>=0:PROCcopy(Buf%,FNr(room%),256,rom0%)
610 room%=VALA$:PROCcopy(FNr(room%),Buf%,256,rom0%):PROCcopy(&A3FF,Obj%,513,rom1%)
620 PROCDisp:x%=0:y%=0:ENDPROC
630 :
640 DEFPROCDisp:FORA%=0TO7:VDU23,128+A%:FORB%=0TO7
650 VDUBuf%?(161+A%*9+B%-1*(A%=7)):NEXT:NEXT:VDU30
660 FORA%=0TO127:B%=Buf%?A%:FORC%=0TO3:VDU128+(B%DIV64):B%=(B%*4)AND&FF
670 NEXT:IF(A%AND7)=7:PRINT
680 NEXT:PROCPrN(Buf%+128,TRUE):FORA%=0TO1
690 PROCslope(A%,Buf%?(214+4*A%),Buf%!(215+4*A%),Buf%?(217+4*A%)):NEXT
700 A%=240:REPEATIFBuf%?A%<>255:PROCSprite(Buf%?A%,Buf%?(A%+1)):A%=A%+2
710 UNTILBuf%?A%=255 ORA%>255:PROCObjects
720 PROCInfo:PROCChars:ENDPROC
730 :
740 DEFPROCslope(Type%,Dir%,Ad%,Num%):IFNum%<1:ENDPROC
750 sx%=Ad%AND31:sy%=(Ad%AND&1E0)DIV32:REPEAT
760 PRINTTAB(sx%,sy%);CHR$(133-A%);:sx%=sx%+2*(Dir%OR(1-Type%))-1:sy%=sy%-Type%
770 Num%=Num%-1:UNTILNum%<1 OR sx%>31 OR sx%<0 OR sy%<0:ENDPROC
780 :
790 DEFPROCPrN(A%,F%):FORC%=0TO31:B%=A%?C%:IFB%>32:F%=TRUE
800 IFF%:IFB%>31 AND B%<128:VDUB%-12*(B%=127) ELSE IFF%:VDU255
810 IFPOS>31:C%=32
820 NEXT:ENDPROC
830 :
840 DEFFNr(R%):IFR%<64:=Room0%+256*R%+rom0%*&10000
850 =Room1%+256*(R%-&B0-&22*(R%<&B0))+rom1%*&10000
860 :
870 DEFPROCcopy(Src%,Dst%,Len%,Rom%)
880 !&70=Src%:!&72=Dst%:!&74=Len%:?&76=Rom%
890 CALLmc%:ENDPROC
900 :
910 DEFPROCasm:DIMmc%50:FORa%=0TO1
920 P%=mc%:[OPT a%*2:\ &70/1=>src, &72/3=>dst, &74/5=len, &76=rom
930 LDA &F4:PHA:LDA &76:JSR SetRom
940 LDY #0:LDA &75:BEQ ZeroPages
950 .loop
960 LDA (&70),Y:STA (&72),Y:INY:BNE loop
970 INC &71:INC &73:DEC &75:BNE loop
980 .ZeroPages
990 LDA &74:BEQ ZeroBytes
1000 .ZeroPageLp
1010 LDA (&70),Y:STA (&72),Y:INY
1020 DEC &74:BNE ZeroPageLp
1030 .ZeroBytes
1040 PLA
1050 .SetRom
1060 STA &F4:STA &FE30:RTS
1070 ]NEXT:ENDPROC
1080 :
1090 DEFPROCObjects:Num%=?Obj%:FOR A%=Num%+1 TO 256
1100 IF((Obj%?A%)AND63)=room%:PRINTTAB((Obj%?(A%+256))AND31,Obj%?(A%+256)DIV32-8*(Obj%?A%>127))"‡";
1110 NEXT:ENDPROC
1120 :
1130 DEFPROCSprite(Num%,Psn%):PROCcopy(&A000+8*Num%,Sprite%,8,rom1%)
1140 Sprite%?2=Psn%:Num%=?Sprite%AND7:IFNum%=0:ENDPROC
1150 IFNum%=3:FORz%=0TO10:PRINTTAB(16,z%)CHR$138;:NEXT:ENDPROC
1160 IFNum%=4:ENDPROC:
1170 ic%=(((Sprite%?1 AND Sprite%?0)OR Sprite%?2)AND&E0)+256*Sprite%?5
1180 PRINTTAB(Sprite%?2 AND31,Sprite%?3DIV16);
1190 PROCcopy(ic%,Icon%,32,rom1%)
1200 FORz%=0TO3:VDU23,140+z%:FORw%=0TO7:VDUIcon%?(w%*2+(z%AND1)+8*(z%AND2))
1210 NEXT:NEXT:VDU140,141,8,8,10,142,143:ENDPROC
1220 :
1230 DEFPROCInfo:PRINTTAB(0,18)"Left :"'"Right:"'"Up :"'"Down :"
1240 FORA%=0TO3:PROCExit(A%):NEXT:ENDPROC
1250 :
1260 DEFPROCExit(A%):B%=Buf%?(233+A%):PRINTTAB(7,A%+18);LEFT$(STR$B%+" ",3);
1270 PROCcopy(FNr(B%)+128,data%,32,rom0%):PROCPrN(data%,FALSE):ENDPROC
1280 :
1290 DEFPROCChars
1300 LOCAL A
1310 FOR A=0 TO 7
1320 IF A<>6 PRINTTAB(33,A*2);MID$("BkGnd:Wall: Floor:Nasty:Slope:Conv.:******Objct:",A*6+1,6);TAB(35,A*2+1);CHR$(128+A)
1330 NEXT
1340 ENDPROC
1350 DEFPROCDoSprites
1360 LOCAL A,B,C:A=0:PRINTTAB(0,22);" Sprites: "
1370 REPEAT
1380 B=?(Buffer+A*2+240):IFB<>255 PRINTTAB((A*8+1)MOD40,23+(A DIV 5));B;"/";?(Buffer+A*2+241);
1390 IF B=1:FORC=0 TO 10:PRINTTAB(15,C);"Š";:NEXT
1400 A=A+1:UNTILA=7 OR B=255:PRINTTAB(33,24);"(C)JGH";:VDU30
1410 ENDPROC
1420 DEFFNcol(C)=C DIV 2+4*(C AND 1)
1430 DEFPROCcopy(rom,src,dst)
1440 ?&74=rom:?&71=src DIV 256:?&73=dst DIV 256
1450 CALLcopy:ENDPROC
1460 DEFPROCassem1
1470 DIM copy 39
1480 FOR P=0 TO 1
1490 P%=copy
1500 [OPT P*2
1510 LDY #0:STY &70:STY &72
1520 LDA &F4:PHA
1530 LDA &74:STA &F4:STA &FE30
1540 .loop
1550 LDA (&70),Y:STA (&72),Y:INY
1560 BNE loop
1570 PLA:STA &F4:STA &FE30
1580 RTS
1590 ]NEXT:ENDPROC
1600 DEFFNerr:IF chn<>0 X=chn:chn=0:CLOSE#X
1610 IF ERR=17 AND NOT INKEY-1 THEN =0
1620 LOCAL X%:X%=INKEY-1:PRINTTAB(0,23);:REPORT:IF ERR<128 OR X% PRINT" at line ";ERL;
1630 IF X% THEN *FX4
1640 =X%
1650 DEFPROCStart
1660 VDU19,0,4,0,0,0
1670 Room=-1:PRINTTAB(0,0);" ***** JSW Room Editor *****"'SPC5"(C)1989 J.G.Harston."
1680 PROChelp(0):char=0
1690 :
1700 Xc=0:Yc=0
1710 ON ERROR IF FNerr END
1720 VDU26:PRINTTAB(Xc,Yc);:*FX4,1
1730 :
1740 :
1750 :
1760 DEFPROChelp(flg)
1770 IF flg VDU28,0,24,39,18,12 ELSE PRINTTAB(0,18);
1780 PRINT"JSW Room editor instructions"
1790 PRINT'"1,2,3,4 Select room blocks"'"R : Select new room"
1800 PRINT"H : Help C : Conveyors/Slopes"
1810 PRINT"S : Save L : Load"
1820 IF flg flg=GET:CLS:VDU26:PROCInfo:ENDPROC
1830 VDU26:ENDPROC
1840 DEFPROCIndicate:PRINTTAB(34,char*2+1);">";CHR$9;"<";TAB(Xc,Yc);:ENDPROC
1850 DEFPROCMove
1860 IF A$=CHR$137 Xc=(Xc+1)AND31:ENDPROC
1870 IF A$=CHR$136 Xc=(Xc-1)AND31:ENDPROC
1880 IF A$=CHR$138 Yc=Yc+1:ENDPROC
1890 IF A$=CHR$139 Yc=(Yc-1) AND (Yc>0):ENDPROC
1900 ENDPROC
1910 DEFPROCput_in
1920 LOCAL a,b
1930 a=Buffer+Xc DIV 4+Yc*8:b=3*4^(3-(Xc AND 3))
1940 ?a=(?a AND NOT b) OR (char*b/3):VDU128+char:Xc=(Xc+1)AND31:IFXc=0 PRINTTAB(Xc,Yc);
1950 ENDPROC
1960 DEFPROCclr:PRINTTAB(0,23);SPC79;:VDU30:ENDPROC
1970 DEFPROCclr1:PRINTTAB(0,23);SPC39;:VDU30:ENDPROC
1980 DEFPROCSave
1990 LOCAL rst,rend,f$,r,A%,X%,Y%
2000 PRINTTAB(0,24);"Save a set of rooms";:INPUTTAB(0,23);"Room start: "rst
2010 PROCclr1:INPUTTAB(0,23);"Room end: "rend
2020 PROCclr1:IF (rst<64 AND rend>63) OR (rst>63 AND rend<64) PRINTTAB(0,23);"Must be continuous in 0-63 or 64-79";:Z=GET:PROCclr:ENDPROC
2030 INPUTTAB(0,23);"Filename: "f$
2040 IF rst>63 THEN OSCLI"SAVE "+f$+" "+STR$~FN_RADDR(rst)+" "+STR$~FN_RADDR(rend):PROCclr:ENDPROC
2050 IF Room<>-1 PROCcopy(rom,Buffer,FN_RADDR(Room))
2060 chn=OPENOUT(f$):IF chn=0 PRINT"Error":Z=GET:ENDPROC
2070 ?cblk=chn:X%=cblk:Y%=X%DIV256:A%=2
2080 FOR r=rst TO rend
2090 PROCcopy(rom,FN_RADDR(r),Buffer)
2100 cblk!1=Buffer:cblk!5=256
2110 CALL OSBGPB:NEXTr
2120 CLOSE#chn
2130 IF Room<>-1 PROCcopy(rom,FN_RADDR(Room),Buffer)
2140 ENDPROC
2150 DEFPROCOscli:LOCAL A$:*FX4
2160 VDU28,0,24,39,18,12
2170 REPEAT:INPUT"*"A$
2180 OSCLIA$:UNTILA$="":*FX4,1
2190 VDU12,26:PROCInfo:ENDPROC
2200 DEFPROCname_in:IF Room=-1 ENDPROC
2210 IF A$>=" " AND A$<="~" ?(Buffer+128+Xc)=ASC A$:PRINTA$;:Xc=(Xc+1)AND31:A$="":IFXc=0PRINTTAB(0,16);
2220 ENDPROC
2230 DEFPROCEditChar:IF Room=-1 ENDPROC
2240 :
2250 INPUTTAB(0,23);"Edit char: "c$
2260 IF c$<"1" OR c$>"7" PROCclr:ENDPROC
2270 VDU28,0,16,31,0,12
2280
2290
2300
2310 :
2320 MODE&84:DIMbuf%256,Obj%513,Sprite%8,Icon%32:PROCassem:room%=-1
2330 PRINT"JSW Mapping Program"'"1: Small Map"'"2: Large Map"
2340 REPEATA$=GET$:UNTILINSTR("12",A$):PRINT'A$'
2350 PRINT"Print out? (Y/N)";:REPEATP$=GET$:UNTILINSTR("YyNn",P$):PRINT" "P$'
2360 IFP$="Y"ORP$="y":P$="Y"
2370 INPUT"Rom: "rom%:IFrom%=0:rom%=4
2380 PROCcopy(&A3FF,Obj%,513,rom%+1)
2390 INPUT"Start room: "b%:IFb%=0:b%=60
2400 IFA$="1":PROCsmall:END
2410 IFA$="2":MODE&80:PROClarge:END
2420 :
2430 DEFPROCsmall
2440 CLS:x%=0:y%=576
2450 :
2460 REPEAT
2470 middle%=b%:x0%=x%:y0%=y%
2480 REPEAT:here%=b%:PROCmap(here%,x%,y%)
2490 b%=buf%?235:y%=y%+64:UNTILb%=here% OR (b%=0 AND here%>2)
2500 b%=middle%:y%=y0%
2510 REPEAT:here%=b%:PROCmap(here%,x%,y%)
2520 b%=buf%?236:y%=y%-64:UNTILb%=here% OR (b%=0 AND here%>2)
2530 here%=middle%:y%=y0%:x%=x%+128:PROCrd(here%)
2540 IFx%>&4FF:x%=0:y0%=128:y%=128
2550 b%=buf%?234:UNTILb%=here% OR (b%=0 AND here%>2)
2560 IFP$="Y":PROCdump(32)
2570 ENDPROC
2580 :
2590 DEFPROCassem:DIMmc%50:FORa%=0TO1
2600 P%=mc%:[OPT a%*2:\ &70/1=>src, &72/3=>dst, &74/5=len, &76=rom
2610 LDA &F4:PHA:LDA &76:JSR SetRom
2620 LDY #0:LDA &75:BEQ ZeroPages
2630 .loop
2640 LDA (&70),Y:STA (&72),Y:INY:BNE loop
2650 INC &71:INC &73:DEC &75:BNE loop
2660 .ZeroPages
2670 LDA &74:BEQ ZeroBytes
2680 .ZeroPageLp
2690 LDA (&70),Y:STA (&72),Y:INY
2700 DEC &74:BNE ZeroPageLp
2710 .ZeroBytes
2720 PLA
2730 .SetRom
2740 STA &F4:STA &FE30:RTS
2750 ]NEXT:ENDPROC
2760 :
2770 DEFPROCmap(r%,x%,y%):PROCrd(r%)
2780 FORz%=0 TO 127:b%=buf%?z%:FORa%=0TO3
2790 IF(b%AND&C0):PLOT69,x%+(a%+(z%AND7)*4)*4,y%-(z%DIV8)*4
2800 b%=(b%AND&3F)*4:NEXT:NEXT
2810 FORz%=0 TO 1:cx%=buf%!(215+z%*4):n%=buf%?(217+z%*4)
2820 d%=buf%?(214+z%*4):cy%=(cx%DIV32)AND15:cx%=cx%AND31
2830 IFn%:FORa%=0TOn%-1:PLOT69,x%+(cx%+((d%OR(1-z%))*2-1)*a%)*4,y%-(cy%-a%*z%)*4:NEXT
2840 NEXT:ENDPROC
2850 :
2860 DEFPROCrd(r%):IFr%=room%:ENDPROC
2870 PROCcopy(&8000+256*r%,buf%,256,rom%):room%=r%:ENDPROC
2880 :
2890 DEFPROCcopy(Src%,Dst%,Len%,Rom%)
2900 !&70=Src%:!&72=Dst%:!&74=Len%:?&76=Rom%:CALLmc%:ENDPROC
2910 :
2920 DEFPROClarge
2930 VDU 23,138,16,0,16,0,16,0,16,0
2940 VDU 23,139,&3C,&42,&99,&A1,&A1,&99,&42,&3C
2950 :
2960 REPEAT:PROCup:top%=here%:b%=here%
2970 REPEAT:here%=b%:VDU26,12
2980 PROCroom(here%,0,0):b%=buf%?234:IFb%<>here%:PROCroom(b%,32,0):IFbuf%?234<>b%:PROCroom(buf%?234,0,16)
2990 IFP$="Y":PROCdump(17)
3000 PROCrd(here%):b%=buf%?236:UNTILb%=here% OR (b%=0 AND here%>2)
3010 IFP$="Y":VDU2:PRINT''':VDU3
3020 b%=top%:REPEAT
3030 here%=b%:PROCrd(here%):b%=buf%?236:UNTILbuf%?234<>here%
3040 b%=buf%?234:PROCrd(b%):b%=buf%?234:PROCrd(b%):b%=buf%?234:PROCup
3050 PROCrd(here%):b%=buf%?235:UNTILb%=0
3060 :
3070 ENDPROC
3080 :
3090 DEFPROCup:REPEAT:here%=b%:PROCrd(here%):b%=buf%?235:UNTILb%=here% OR b%<2
3100 ENDPROC
3110 :
3120 DEFPROCroom(r%,x%,y%):VDU28,x%,y%+15,x%+32,y%:PROCrd(r%)
3130 PROCDisp:ENDPROC
3140 :
3150 DEFPROCDisp:FORA%=0TO7:VDU23,128+A%:FORB%=0TO7
3160 VDUbuf%?(161+A%*9+B%-1*(A%=7)):NEXT:NEXT:VDU30
3170 FORA%=0TO127:B%=buf%?A%:FORC%=0TO3:VDU128+(B%DIV64):B%=(B%*4)AND&FF
3180 NEXT:IF(A%AND7)=7 AND A%<>127:PRINT
3190 NEXT:FORA%=0TO1
3200 PROCslope(A%,buf%?(214+4*A%),buf%!(215+4*A%),buf%?(217+4*A%)):NEXT
3210 PROCObjects:A%=240:REPEATIFbuf%?A%<>255:PROCSprite(buf%?A%,buf%?(A%+1)):A%=A%+2
3220 UNTILbuf%?A%=255:PROCPrN(buf%+128,TRUE):ENDPROC
3230 :
3240 DEFPROCslope(Type%,Dir%,Ad%,Num%):IFNum%<1:ENDPROC
3250 sx%=Ad%AND31:sy%=(Ad%AND&1E0)DIV32:REPEAT
3260 PRINTTAB(sx%,sy%);CHR$(133-A%);:sx%=sx%+2*((Dir%OR(1-Type%)))-1:sy%=sy%-Type%
3270 Num%=Num%-1:UNTILNum%<1 OR sx%>31 OR sx%<0 OR sy%<0:ENDPROC
3280 :
3290 DEFPROCPrN(A%,F%):VDU26,31,32,16+x%DIV32+y%DIV8
3300 FORC%=0TO31:B%=A%?C%:IFB%>32:F%=TRUE
3310 IFF%:IFB%>31 AND B%<128:VDUB%-12*(B%=127) ELSE IFF%:VDU32
3320 NEXT:ENDPROC
3330 :
3340 DEFPROCObjects:Num%=?Obj%:FOR A%=Num%+1 TO 256
3350 IF((Obj%?A%)AND63)=room%:PRINTTAB((Obj%?(A%+256))AND31,Obj%?(A%+256)DIV32-8*(Obj%?A%>127))"‡";
3360 NEXT:ENDPROC
3370 :
3380 DEFPROCSprite(Num%,Psn%):PROCcopy(&A000+8*Num%,Sprite%,8,rom%+1)
3390 Sprite%?2=Psn%:Num%=?Sprite%AND7:IFNum%=0:ENDPROC
3400 IFNum%=3:FORz%=0TO10:PRINTTAB(16,z%)CHR$138;:NEXT:ENDPROC
3410 IFNum%=4:ENDPROC:
3420 ic%=(((Sprite%?1 AND Sprite%?0)OR Sprite%?2)AND&E0)+256*Sprite%?5
3430 PRINTTAB(Sprite%?2 AND31,Sprite%?3DIV16);
3440 PROCcopy(ic%,Icon%,32,rom%+1)
3450 FORz%=0TO3:VDU23,140+z%:FORw%=0TO7:VDUIcon%?(w%*2+(z%AND1)+8*(z%AND2))
3460 NEXT:NEXT:VDU140,141,8,8,10,142,143:ENDPROC
3470 :
3480 DEFPROCdump(Lines%):Lines%=16:num%=768:VDU2
3490 VDU1,27,1,65,1,8
3500 FOR y%=1023 TO 1024-32*Lines% STEP -32:*FX229,1
3510 VDU 1,27,1,76,1,num%,1,num%DIV256
3520 FOR x%=0 TO 1535 STEP 2:byte%=0
3530 FOR pixel%=0 TO 7
3540 byte%=byte%*2+POINT((x%AND&3FF),y%-pixel%*4+512*(x%>&3FF))
3550 NEXT:VDU 1,byte%:NEXT
3560 VDU 1,10,1,13:NEXT:*FX229
3570 IFADVAL(-1):IFGET=27:*FX125
3580 *FX229,1
3590 VDU 1,27,1,76,1,num%,1,num%DIV256
3600 FOR x%=0 TO 1535 STEP 2:byte%=0
3610 FOR pixel%=0 TO 7
3620 byte%=byte%*2+POINT(&200+(x%AND&1FF),511-pixel%*4-((x%AND&FFE00)DIV16))
3630 NEXT:VDU 1,byte%:NEXT:*FX229
3640 VDU 1,10,1,13,3:IFADVAL(-1):IFGET=27:*FX125
3650 ENDPROC