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