10 REM > Map
   20 REM Map out JSW rooms
   30 REM 25-07-97 JGH: 0.01
   40 REM 29-07-97 JGH: 0.20 Will also do single room
   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"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 PROCcopy(&8000+256*r%,buf%,256,rom%):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:REM Arrows
 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