10 REM > DefRoom 1.22
   20 REM 25-May-94 V1.00
   30 REM 02-Aug-97 V1.20
   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 REM Room1%=FNalloc(&4000):IFRoom1%=0:Room1%=&8000
   80 OSGBPB=&FFD1:in%=0:out%=0:rm%=-1:blk%=0:*FX4,1
   90 PROCasm:ONERROR IFFNerr:PROCend:END
  100 PRINTSPC3"Jet Set Willy Room Editor"''SPC4"(C)1989-97  J.G.Harston"
  110 PRINT''':PROCHelp
  120 VDU 23;9,7;0;0;0; 23;4,38;0;0;0;
  130 VDU 23;10,&60;0;0;0;23;7,31;0;0;0;
  140 VDU 23,136,255,0,0,0,0,0,0,0
  150 VDU 23,137,128,128,128,128,128,128,128,128
  160 VDU 23,138,16,0,16,0,16,0,16,0
  170 VDU 23,139,255,128,128,128,128,128,128,128
  180 FORA%=0TO16:PRINTTAB(32,A%);"‰":NEXT:PRINTSTRING$(40,"ˆ")
  190 x%=0:y%=0:PROCBlk:ONERROR IFFNerr:PROCend:END ELSE A%=INKEY(200):PROCclr1
  200 REPEATUNTILFNmenu:PROCend:END
  210 :
  220 DEFFNalloc(L%):DIMA%-1:IFHIMEM-A%-512>L%:DIMA%L%:=A% ELSE =0
  230 :
  240 DEFFNerr:PRINTTAB(0,22);:REPORT:PROCCloseAll:=INKEY-1
  250 :
  260 DEFPROCCloseAll
  270 IFin%:A%=in%:in%=0:CLOSE#A%
  280 IFout%:A%=out%:out%=0:CLOSE#A%
  290 ENDPROC
  300 :
  310 DEFPROCend:*FX4
  320 END:ENDPROC
  330 :
  340 DEFFNmenu:IFy%>16:x%=8:IFy%>21:x%=21:IFy%=23:y%=0:x%=0
  350 PRINTTAB(x%,y%);:A$=GET$:IFy%<17:IFA$=CHR$13:x%=0:A$=CHR$138
  360 IFA$>CHR$135 AND A$<CHR$140:PROCMove:=0
  370 IFy%<16:IFINSTR("1234",A$):PRINTTAB(33,blk%*2+1)" "CHR$9" ";:blk%=VALA$-1:PROCBlk:=0
  380 IFy%<16:IFINSTR(" 0"+CHR$135,A$):PROCPut:=0
  390 IFy%=16:PROCName:=0
  400 IFy%>16 AND y%<22:PROCExit:=0
  410 IFy%=22:PROCBorder:=0
  420 IFA$>"_":A$=CHR$(ASCA$-32)
  430 IFINSTR("EDOQHLSR*",A$)=0:=0
  440 REM IF A$="M" Copy to another room?
  450 REM IF A$="W" Swap with another room
  460 REM IF A$="C" PROCConvs
  470 REM IF A$="G" PROCGuardian
  480 IFA$="E":PROCEdChar:=0
  490 IFA$="O":PROCAddObj:=0
  500 IFA$="D":PROCDelObj:=0
  510 IFA$="R":PROCRoom:=0
  520 PROCWin:IFA$="Q":=TRUE
  530 IFA$="H":CLS:PROCHelp:A%=GET
  540 IFA$="*":PROCOscli:=0
  550 IFA$="L":PROCLoad:=0
  560 IFA$="S":PROCSave
  570 VDU12,26:PROCInfo:=0
  580 :
  590 DEFPROCBlk:PRINTTAB(33,blk%*2+1)">"CHR$9"<"TAB(x%,y%);:ENDPROC
  600 :
  610 DEFPROCPut:Ad%=Buf%+x%DIV4+y%*8:By%=3*4^(3-(x%AND3))
  620 ?Ad%=(?Ad% ANDNOTBy%)OR(blk%*By%DIV3):VDU128+blk%:x%=(x%+1)AND31:IFx%=0:VDU13
  630 ENDPROC
  640 :
  650 DEFPROCMove:IFy%>17 AND y%<22:PRINTTAB(6,y%)FNd(Buf%?(y%-18+233),3);
  660 PROCmv:xt%=-1:ENDPROC
  670 DEFPROCmv:IFA$=CHR$137:x%=(x%+1)AND31:ENDPROC
  680 IFA$=CHR$136:x%=(x%-1)AND31:ENDPROC
  690 IFA$=CHR$138:y%=y%+1-(y%=16):ENDPROC
  700 IFA$=CHR$139:y%=(y%-1)AND(y%>0):ENDPROC
  710 ENDPROC
  720 :
  730 DEFPROCName:A%=ASCA$:IFrm%<0:ENDPROC
  740 IFA%>31 AND A%<128:Buf%?(x%+128)=A%:VDUA%-12*(A%=127):x%=(x%+1)AND31:IFx%=0:VDU13
  750 ENDPROC
  760 :
  770 DEFPROCRoom:PRINTTAB(6,22)SPC3;TAB(0,22)"Room=   ";:VDU8,8,8:INPUT""A$:IFA$="":PRINTTAB(6,21);FNd(rm%,3);TAB(x%,y%);:ENDPROC
  780 PROCPutR:rm%=VALA$:PROCGetR
  790 PROCcopy(&A3FF+&10000*rom1%,Obj%,513):PROCDisp:x%=0:y%=0:ENDPROC
  800 :
  810 DEFPROCDisp:IFrm%<0:ENDPROC
  820 FORA%=0TO7:VDU23,128+A%:FORB%=0TO7
  830 VDUBuf%?(161+A%*9+B%-1*(A%=7)):NEXT:NEXT:VDU30
  840 FORA%=0TO127:B%=Buf%?A%:FORC%=0TO3:VDU128+(B%DIV64):B%=(B%*4)AND&FF
  850   NEXT:IF(A%AND7)=7:PRINT
  860   NEXT:PROCPrN(Buf%+128,TRUE):FORA%=0TO1
  870 PROCslope(A%,Buf%?(214+4*A%),Buf%!(215+4*A%),Buf%?(217+4*A%)):NEXT
  880 A%=240:REPEATIFBuf%?A%<>255:PROCSprite(Buf%?A%,Buf%?(A%+1)):A%=A%+2
  890 UNTILBuf%?A%=255 ORA%>255:PROCObjects:PROCInfo:PROCChars
  900 VDU19,0,FNc(Buf%?160 DIV8),0,0,0:ENDPROC
  910 DEFFNc(A%)=(A%DIV2+4*(A%AND1))AND7
  920 DEFFNd(A%,N%)=RIGHT$("        "+STR$A%,N%)
  930 DEFFNo0(A%,N%)=RIGHT$(CHR$(48+A%DIV64)+CHR$(48+(A%AND&38)DIV8)+CHR$(48+(A%AND7)),N%)
  940 DEFFNfile(A%,A$):$data%=A$:?X%=data%:X%?1=data%DIV256:=(USR&FFDD)AND&FF
  950 :
  960 DEFPROCslope(Type%,Dir%,Ad%,Num%):IFNum%<1:ENDPROC
  970 sx%=Ad%AND31:sy%=(Ad%AND&1E0)DIV32:REPEAT
  980   PRINTTAB(sx%,sy%);CHR$(133-A%);:sx%=sx%+2*(Dir%OR(1-Type%))-1:sy%=sy%-Type%
  990 Num%=Num%-1:UNTILNum%<1 OR sx%>31 OR sx%<0 OR sy%<0:ENDPROC
 1000 :
 1010 DEFPROCPrN(A%,F%):FORC%=0TO31:B%=A%?C%:IFB%>32:F%=TRUE
 1020   IFF%:IFB%>31 AND B%<128:VDUB%-12*(B%=127) ELSE IFF%:VDU32
 1030   IFPOS<1 OR POS>39:C%=32
 1040 NEXT:IFPOS>6:PRINTSPC(40-POS);
 1050 ENDPROC
 1060 :
 1070 DEFFNr(R%):R%=R%AND255:IFR%<64:=Room0%+256*R%+rom0%*&10000
 1080 IFR%<128:=Room1%+256*(R%-64)+rom1%*&10000
 1090 =&7F00
 1100 :
 1110 DEFPROCGetR:IFrm%<0:ENDPROC
 1120 PROCcopy(FNr(rm%),Buf%,256):ENDPROC
 1130 DEFPROCPutR:IFrm%<0:ENDPROC
 1140 PROCcopy(Buf%,FNr(rm%),256):ENDPROC
 1150 :
 1160 DEFPROCcopy(Src%,Dst%,Len%)
 1170 !&70=Src%:!&72=Dst%:!&74=Len%:?&76=Src%DIV&10000+Dst%DIV&10000
 1180 CALLmc%:ENDPROC
 1190 :
 1200 DEFPROCasm:DIMmc%50:FORa%=0TO1
 1210   P%=mc%:[OPT a%*2:\ &70/1=>src, &72/3=>dst, &74/5=len, &76=rom
 1220   LDA &F4:PHA:LDA &76:JSR SetRom
 1230   LDY #0:LDA &75:BEQ ZeroPages
 1240   .loop
 1250   LDA (&70),Y:STA (&72),Y:INY:BNE loop
 1260   INC &71:INC &73:DEC &75:BNE loop
 1270   .ZeroPages
 1280   LDA &74:BEQ ZeroBytes
 1290   .ZeroPageLp
 1300   LDA (&70),Y:STA (&72),Y:INY
 1310   DEC &74:BNE ZeroPageLp
 1320   .ZeroBytes
 1330   PLA
 1340   .SetRom
 1350   STA &F4:STA &FE30:RTS
 1360 ]NEXT:ENDPROC
 1370 :
 1380 DEFPROCObjects:ObjN%=0:FOR A%=?Obj%+1 TO 256
 1390   IF((Obj%?A%)AND63)=rm%:PRINTTAB((Obj%?(A%+256))AND31,Obj%?(A%+256)DIV32-8*(Obj%?A%>127))"‡";:ObjN%=ObjN%+1
 1400 NEXT:ENDPROC
 1410 :
 1420 DEFPROCSprite(Num%,Psn%):PROCcopy(&A000+8*Num%+rom1%*&10000,Sprite%,8)
 1430 Sprite%?2=Psn%:Num%=?Sprite%AND7:IFNum%=0:ENDPROC
 1440 IFNum%=3:FORz%=0TO10:PRINTTAB(16,z%)CHR$138;:NEXT:ENDPROC
 1450 IFNum%=4:ENDPROC:REM Arrows
 1460 ic%=(((Sprite%?1 AND Sprite%?0)OR Sprite%?2)AND&E0)+256*Sprite%?5
 1470 PRINTTAB(Sprite%?2 AND31,Sprite%?3DIV16);
 1480 PROCcopy(ic%,Icon%+&10000*rom1%,32)
 1490 FORz%=0TO3:VDU23,140+z%:FORw%=0TO7:VDUIcon%?(w%*2+(z%AND1)+8*(z%AND2))
 1500 NEXT:NEXT:VDU140,141,8,8,10,142,143:ENDPROC
 1510 :
 1520 DEFPROCInfo:PRINTTAB(0,18)"Left :"'"Right:"'"Up   :"'"Down :"
 1530 FORA%=0TO3:PROCPrExit(A%):NEXT:PRINT"Room :"FNd(rm%,3);:PROCInfoB:ENDPROC
 1540 DEFPROCInfoB:PRINTTAB(12,22)"Border:";FNd(Buf%?160,3);SPC3"Objects:"FNd(ObjN%,3)"/";256-?Obj%;"  ";:ENDPROC
 1550 :
 1560 DEFPROCPrExit(A%):B%=Buf%?(233+A%):PRINTTAB(6,A%+18);FNd(B%,3);" ";
 1570 PROCcopy(FNr(B%)+128,data%,32):PROCPrN(data%,FALSE):ENDPROC
 1580 :
 1590 DEFPROCChars:FORC%=0 TO 7:IFC%<>6:PRINTTAB(33,C%*2);MID$("BkGnd:Wall: Floor:Nasty:Slope:Conv.:******Objct:",C%*6+1,6);TAB(34,C%*2+1);CHR$(128+C%);:IFC%<6:PRINTCHR$9;CHR$9;FNo0(Buf%?(160+C%*9),3);
 1600 NEXT:ENDPROC
 1610 :
 1620 DEFPROCExit:IFA$=CHR$13:IFxt%>-1:Buf%?(y%-18+233)=xt%:xt%=-1:PROCPrExit(y%-18)
 1630 IFA$=CHR$13:y%=y%+1:ENDPROC
 1640 IFA$<"0" OR A$>"9":ENDPROC
 1650 xt%=(VALA$+10*(xt%AND(xt%>-1)))AND255:PRINTTAB(6,y%);FNd(xt%,3);:ENDPROC
 1660 :
 1670 DEFPROCBorder:IFA$=CHR$13:IFxt%>-1:Buf%?222=xt%:xt%=-1
 1680 IFA$=CHR$13:y%=0:x%=0:ENDPROC
 1690 IFA$<"0" OR A$>"9":ENDPROC
 1700 xt%=(VALA$+10*(xt%AND(xt%>-1)))AND255:PRINTTAB(19,y%);FNd(xt%,3);:ENDPROC
 1710 :
 1720 DEFPROCAddObj:IF?Obj%=0 OR rm%>127:ENDPROC
 1730 A%=?Obj%:Obj%?A%=rm%+16*(y%AND8):Obj%?(A%+256)=x%+32*y%:?Obj%=A%-1:ObjN%=ObjN%+1
 1740 PROCcopy(Obj%,&A3FF+&10000*rom1%,513):PRINT"‡";CHR$8;:PROCInfoB:ENDPROC
 1750 :
 1760 DEFPROCDelObj:IF?Obj%=255 OR rm%>127 OR ObjN%=0:ENDPROC
 1770 Num%=?Obj%:FOR A%=Num%+1 TO 256
 1780   IF((Obj%?A%)AND63)=rm%:IF((Obj%?A%)AND128)=(y%AND8)*16:IFObj%?(A%+256)=((x%+32*y%)AND255):Obj%?A%=Obj%?(?Obj%+1):Obj%?(A%+256)=Obj%?(?Obj%+257):?Obj%=?Obj%+1:ObjN%=ObjN%-1:VDU32,8
 1790 NEXT:PROCcopy(Obj%,&A3FF+&10000*rom1%,513):PROCInfoB:ENDPROC
 1800 :
 1810 DEFPROCHelp:PRINT"JSW Room editor instructions"
 1820 PRINT'"1,2,3,4 Select room blocks"'"R : Select new room"
 1830 PRINT"H : Help    C : Conveyors/Slopes"
 1840 PRINT"S : Save    L : Load"
 1850 ENDPROC
 1860 :
 1870 DEFPROCclr:PRINTTAB(0,23);SPC79;:VDU30:ENDPROC
 1880 DEFPROCclr1:PRINTTAB(0,23);SPC39;:VDU30:ENDPROC
 1890 DEFPROCWin:VDU28,0,24,39,18,31,0,5:ENDPROC
 1900 :
 1910 DEFPROCLoad:INPUT"Rooms file to load: "f$:IFf$<>"":PROCLoadR
 1920 VDU13:INPUT"Objects file to load: "f$:IFf$<>"":PROCLoadO
 1930 VDU12,26:PROCDisp:ENDPROC
 1940 DEFPROCLoadR:INPUT"Load rooms to : "st%
 1950 INPUT"Link room exits? "lk$:IFLEFT$(lk$,1)="y" OR LEFT$(lk$,1)="Y":lk$="Y"
 1960 PROCPutR:in%=OPENIN(f$):IFin%=0:PROCErrO:ENDPROC
 1970 ?X%=in%:A%=4:r%=st%:REPEAT:PRINTCHR$13;r%;
 1980   X%!1=Buf%:X%!5=256:CALL OSGBPB:PROCcopy(Buf%,FNr(r%),256)
 1990   IFlk$="Y":PROCLinkRooms
 2000 r%=r%+1:UNTILEOF#in%:CLOSE#in%:in%=0:PROCGetR:ENDPROC
 2010 DEFPROCLinkRooms:!data%=Buf%!233:FORlk%=0 TO 3
 2020   IFdata%?lk%<>r%:PROCcopy(FNr(data%?lk%),Buf%,256):Buf%?(233+(lk%EOR1))=r%:PROCcopy(Buf%,FNr(data%?lk%),256)
 2030 NEXT:ENDPROC
 2040 DEFPROCLoadO:in%=OPENIN(f$):IFin%=0:PROCErrO:ENDPROC
 2050 ?X%=in%:A%=4:X%!1=Obj%:X%!5=513:CALL OSGBPB
 2060 CLOSE#in%:in%=0:PROCcopy(Obj%,&A3FF+&10000*rom1%,513):ENDPROC
 2070 :
 2080 DEFPROCSave:INPUT"Rooms file to save: "f$:IFf$<>"":PROCSaveR
 2090 VDU13:INPUT"Objects file to save: "f$:IFf$<>"":PROCSaveO
 2100 ENDPROC
 2110 DEFPROCSaveR:INPUT"Save room start: "st%:INPUT"Save room end: "en%
 2120 IF(st%<64 AND en%>63) OR (st%>191 AND en%<192):PRINTTAB(0,23);"Must be continuous in 0-63 or 192-255";:A%=GET:ENDPROC
 2130 PROCPutR:out%=OPENOUT(f$):IFout%=0:PROCErrO:ENDPROC
 2140 ?X%=out%:A%=2:FOR r%=st% TO en%:PRINTCHR$13;r%;
 2150 PROCcopy(FNr(r%),Buf%,256):X%!1=Buf%:X%!5=256:CALL OSGBPB:NEXTr%
 2160 CLOSE#out%:out%=0:PROCGetR:PROCSetAd(f$,((st%EOR&C0)OR&300)*256):ENDPROC
 2170 DEFPROCSaveO:out%=OPENOUT(f$):IFout%=0:PROCErrO:ENDPROC
 2180 PROCcopy(&A3FF+&10000*rom1%,Obj%,513)
 2190 ?X%=out%:A%=2:X%!1=Obj%:X%!5=513:CALL OSGBPB:CLOSE#out%:out%=0
 2200 PROCSetAd(f$,&3A3FF):ENDPROC
 2210 :
 2220 DEFPROCSetAd(A$,B%):X%!2=B%:A%=FNfile(2,A$):X%!6=B%:A%=FNfile(3,A$):ENDPROC
 2230 DEFPROCErrO:PRINT"Can't open file";:A%=GET:ENDPROC
 2240 :
 2250 DEFPROCOscli:LOCAL A$:PROCWin:CLS:*FX4
 2260 REPEATINPUTLINE"*"A$:OSCLIA$:PRINT":";:REPEATA$=GET$:UNTILINSTR(CHR$13+"LlSs*",A$):IFA$="*":VDU127
 2270 UNTILA$<>"*":PRINT:IFA$="L" OR A$="l":PROCLoad:ENDPROC ELSE IF A$="S" OR A$="s":PROCSave:ENDPROC
 2280 VDU12,26:OSCLI"FX4,1":PROCInfo:ENDPROC
 2290 :
 2300 DEFPROCEdChar:IFrm%=-1:ENDPROC
 2310 INPUTTAB(0,23);"Edit char: "c$:PROCclr:IFc$<"1" OR c$>"7":ENDPROC
 2320 VDU28,0,16,31,0,12:C%=VALc$:xo%=Buf%+152+C%*9-10*(C%=7)
 2330 FORyc%=0 TO 7:PRINTTAB(1,1+yc%);:A%=xo%?yc%:FOR xc%=0 TO 7
 2340     A%=A%*2:IF(A%AND256):COLOUR135:VDU32:COLOUR128 ELSE VDU139
 2350 NEXT:PRINT"‰"FNd(xo%?yc%,4):NEXT:PRINT" "STRING$(8,"ˆ")
 2360 xc%=0:yc%=0:IFC%<7:PRINT'" Attr="FNo0(xo%?-1,3)
 2370 REPEATREPEATPRINTTAB(1+xc%,1+yc%);:A$=GET$:IFA$>CHR$135 AND A$<CHR$140:xc%=(xc%-(A$=CHR$137)+(A$=CHR$136))AND7:yc%=(yc%-(A$=CHR$138)+(A$=CHR$139))AND7:UNTIL0
 2380 UNTILINSTR(" 012A"+CHR$13,A$):IFA$="A"ORA$="a":IFC%<7:PRINTTAB(6,11);SPC3;CHR$8;CHR$8;CHR$8;:INPUT""f$:IFf$<>"":f$=RIGHT$("00"+f$,3):xo%?-1=64*VALLEFT$(f$,1)+8*VALMID$(f$,2,1)+VALRIGHT$(f$,1)
 2390 IFA$="A":IFC%<7:PRINTTAB(6,11)FNo0(xo%?-1,3)
 2400 IFA$=" ":A$=CHR$(49+((xo%?yc% AND (2^(7-xc%)))<>0))
 2410 IFA$="0":xo%?yc%=xo%?yc% AND NOT (2^(7-xc%)):VDU139,8
 2420 IFA$="1":xo%?yc%=xo%?yc% OR (2^(7-xc%)):COLOUR135:VDU32,8:COLOUR128
 2430 PRINTTAB(10,1+yc%);FNd(xo%?yc%,4):UNTILA$=CHR$13:PROCPutR:VDU26:PROCDisp:ENDPROC