10
20
30
40
50 :
60 MODE&84:DIMbuf%256,Obj%513,Sprite%8,Icon%32:PROCassem:room%=-1
70 PRINT"JSW Mapping Program"'"1: Small Map"'"2: Large Map"'"3: Single room"
80 REPEATA$=GET$:UNTILINSTR("123",A$):PRINT'A$'
90 PRINT"Print out? (Y/N)";:REPEATP$=GET$:UNTILINSTR("YyNn",P$):PRINT" "P$'
100 IFP$="Y"ORP$="y":P$="Y"
110 INPUT"Base rom: "rom%:IFrom%=0:rom%=4
120 PROCcopy(&A3FF,Obj%,513,rom%+1)
130 INPUT"Start room: "b%:IFb%=0:b%=60
140 IFA$="1":PROCsmall:END
150 IFA$="2":MODE&80:PROClarge:END
160 IFA$="3":PROCroom(b%,0,0):A%=GET:RUN
170 END
180 :
190 DEFPROCsmall
200 CLS:x%=0:y%=576
210 :
220 REPEAT
230 middle%=b%:x0%=x%:y0%=y%
240 REPEAT:here%=b%:PROCmap(here%,x%,y%)
250 IFbuf%?233<>here%:PROCmap(buf%?233,x%-128,y%):PROCrd(here%)
260 IFbuf%?234<>here%:PROCmap(buf%?234,x%+128,y%):PROCrd(here%)
270 b%=buf%?235:y%=y%+64:UNTILb%=here% OR (b%=0 AND here%>2)
280 b%=middle%:y%=y0%
290 REPEAT:here%=b%:PROCmap(here%,x%,y%)
300 b%=buf%?236:y%=y%-64:UNTILb%=here% OR (b%=0 AND here%>2)
310 here%=middle%:y%=y0%:x%=x%+128:PROCrd(here%)
320 IFx%>&4FF:x%=0:y0%=128:y%=128
330 b%=buf%?234:UNTILb%=here% OR (b%=0 AND here%>2)
340 IFP$="Y":PROCdump(32)
350 ENDPROC
360 :
370 DEFPROCassem:DIMmc%50:FORa%=0TO1
380 P%=mc%:[OPT a%*2:\ &70/1=>src, &72/3=>dst, &74/5=len, &76=rom
390 LDA &F4:PHA:LDA &76:JSR SetRom
400 LDY #0:LDA &75:BEQ ZeroPages
410 .loop
420 LDA (&70),Y:STA (&72),Y:INY:BNE loop
430 INC &71:INC &73:DEC &75:BNE loop
440 .ZeroPages
450 LDA &74:BEQ ZeroBytes
460 .ZeroPageLp
470 LDA (&70),Y:STA (&72),Y:INY
480 DEC &74:BNE ZeroPageLp
490 .ZeroBytes
500 PLA
510 .SetRom
520 STA &F4:STA &FE30:RTS
530 ]NEXT:ENDPROC
540 :
550 DEFPROCmap(r%,x%,y%):PROCrd(r%)
560 FORz%=0 TO 127:b%=buf%?z%:FORa%=0TO3
570 IF(b%AND&C0):IFPOINT(x%+(a%+(z%AND7)*4)*4,y%-(z%DIV8)*4):a%=4:z%=128:NEXT:NEXT:ENDPROC
580 IF(b%AND&C0):PLOT69,x%+(a%+(z%AND7)*4)*4,y%-(z%DIV8)*4
590 b%=(b%AND&3F)*4:NEXT:NEXT
600 FORz%=0 TO 1:cx%=buf%!(215+z%*4):n%=buf%?(217+z%*4)
610 d%=buf%?(214+z%*4):cy%=(cx%DIV32)AND15:cx%=cx%AND31
620 IFn%:FORa%=0TOn%-1:PLOT69,x%+(cx%+((d%OR(1-z%))*2-1)*a%)*4,y%-(cy%-a%*z%)*4:NEXT
630 NEXT:ENDPROC
640 :
650 DEFPROCrd(r%):IFr%=room%:ENDPROC
660 IFr%<64:PROCcopy(&8000+256*r%,buf%,256,rom%):room%=r%:ENDPROC
670 PROCcopy(&8000+256*(r%-192),buf%,256,rom%+1):room%=r%:ENDPROC
680 :
690 DEFPROCcopy(Src%,Dst%,Len%,Rom%)
700 !&70=Src%:!&72=Dst%:!&74=Len%:?&76=Rom%:CALLmc%:ENDPROC
710 :
720 DEFPROClarge
730 VDU 23,138,16,0,16,0,16,0,16,0
740 VDU 23,139,&3C,&42,&99,&A1,&A1,&99,&42,&3C
750 :
760 REPEAT:PROCright2:top%=b%:PROCup:b%=here%
770 REPEAT:here%=b%:VDU26,12
780 PROCroom(here%,0,16):b%=buf%?233:IFb%<>here%:PROCroom(b%,32,0):IFbuf%?233<>b%:PROCroom(buf%?233,0,0)
790
800 IFP$="Y":PROCdump(17)
810 PROCrd(here%):b%=buf%?236:UNTILb%=here% OR (b%=0 AND here%>2)
820 IFP$="Y":VDU2:PRINT''':VDU3
830
840
850 b%=top%:PROCrd(b%):b%=buf%?234
860 UNTILb%=0
870 :
880 ENDPROC
890 :
900 DEFPROCup:REPEAT:here%=b%:PROCrd(here%):b%=buf%?235:UNTILb%=here% OR b%=0
910 ENDPROC
920 :
930 DEFPROCright2:A%=2:REPEAT:here%=b%:PROCrd(here%):b%=buf%?234:A%=A%-1:UNTILb%=here% OR b%=0 OR A%<1
940 ENDPROC
950 :
960 DEFPROCroom(r%,x%,y%):VDU28,x%,y%+15,x%+32,y%:PROCrd(r%)
970 PROCDisp:ENDPROC
980 :
990 DEFPROCDisp:FORA%=0TO7:VDU23,128+A%:FORB%=0TO7
1000 VDUbuf%?(161+A%*9+B%-1*(A%=7)):NEXT:NEXT:VDU30
1010 FORA%=0TO127:B%=buf%?A%:FORC%=0TO3:VDU128+(B%DIV64):B%=(B%*4)AND&FF
1020 NEXT:IF(A%AND7)=7 AND A%<>127:PRINT
1030 NEXT:FORA%=0TO1
1040 PROCslope(A%,buf%?(214+4*A%),buf%!(215+4*A%),buf%?(217+4*A%)):NEXT
1050 PROCObjects:A%=240:REPEATIFbuf%?A%<>255:PROCSprite(buf%?A%,buf%?(A%+1)):A%=A%+2
1060 UNTILbuf%?A%=255:PROCPrN(buf%+128,TRUE):ENDPROC
1070 :
1080 DEFPROCslope(Type%,Dir%,Ad%,Num%):IFNum%<1:ENDPROC
1090 sx%=Ad%AND31:sy%=(Ad%AND&1E0)DIV32:REPEAT
1100 PRINTTAB(sx%,sy%);CHR$(133-A%);:sx%=sx%+2*((Dir%OR(1-Type%)))-1:sy%=sy%-Type%
1110 Num%=Num%-1:UNTILNum%<1 OR sx%>31 OR sx%<0 OR sy%<0:ENDPROC
1120 :
1130 DEFPROCPrN(A%,F%):VDU26,31,32+32*(A$="3"),16+x%DIV32+y%DIV8
1140 FORC%=0TO31:B%=A%?C%:IFB%>32:F%=TRUE
1150 IFF%:IFB%>31 AND B%<128:VDUB%-12*(B%=127) ELSE IFF%:VDU32
1160 NEXT:ENDPROC
1170 :
1180 DEFPROCObjects:Num%=?Obj%:FOR A%=Num%+1 TO 256
1190 IF((Obj%?A%)AND63)=room%:PRINTTAB((Obj%?(A%+256))AND31,Obj%?(A%+256)DIV32-8*(Obj%?A%>127))"‡";
1200 NEXT:ENDPROC
1210 :
1220 DEFPROCSprite(Num%,Psn%):PROCcopy(&A000+8*Num%,Sprite%,8,rom%+1)
1230 Sprite%?2=Psn%:Num%=?Sprite%AND7:IFNum%=0:ENDPROC
1240 IFNum%=3:FORz%=0TO10:PRINTTAB(16,z%)CHR$138;:NEXT:ENDPROC
1250 IFNum%=4:ENDPROC:
1260 ic%=(((Sprite%?1 AND Sprite%?0)OR Sprite%?2)AND&E0)+256*Sprite%?5
1270 PRINTTAB(Sprite%?2 AND31,Sprite%?3DIV16);
1280 PROCcopy(ic%,Icon%,32,rom%+1)
1290 FORz%=0TO3:VDU23,140+z%:FORw%=0TO7:VDUIcon%?(w%*2+(z%AND1)+8*(z%AND2))
1300 NEXT:NEXT:VDU140,141,8,8,10,142,143:ENDPROC
1310 :
1320 DEFPROCdump(Lines%):Lines%=16:num%=768:VDU2
1330 VDU1,27,1,65,1,8
1340 FOR y%=1023 TO 1024-32*Lines% STEP -32:*FX229,1
1350 VDU 1,27,1,76,1,num%,1,num%DIV256
1360 FOR x%=0 TO 1535 STEP 2:byte%=0
1370 FOR pixel%=0 TO 7
1380 byte%=byte%*2+POINT((x%AND&3FF),y%-pixel%*4+512*(x%>&3FF))
1390 NEXT:VDU 1,byte%:NEXT
1400 VDU 1,10,1,13:NEXT:*FX229
1410 IFADVAL(-1):IFGET=27:*FX125
1420 *FX229,1
1430 VDU 1,27,1,76,1,num%,1,num%DIV256
1440 FOR x%=0 TO 1535 STEP 2:byte%=0
1450 FOR pixel%=0 TO 7
1460 byte%=byte%*2+POINT(&200+(x%AND&1FF),511-pixel%*4-((x%AND&FFE00)DIV16))
1470 NEXT:VDU 1,byte%:NEXT:*FX229
1480 VDU 1,10,1,13,3:IFADVAL(-1):IFGET=27:*FX125
1490 ENDPROC