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

Download DefRoom123

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.