+USES CRT;
+
+CONST GAMETYPE:ARRAY[1..8]OF STRING[12] =
+ ('SINGLEPLAYER','PEAWORM','TRON','DEATHMATCH',
+ 'FOODMATCH','LINKPLAY','RACE','CTF');
+
+ OBJTYPE:ARRAY[0..3]OF STRING[8] =
+ ('NONE','LINE','FAT LINE','BAR');
+
+ ENDTYPE:ARRAY[-1..0]OF STRING[8] =
+ ('MESSAGE','NONE');
+
+ HEAD86S:STRING[53] =
+ ('**TI86**'+#$1A+#$A+#0+ {HEADER}
+ 'Levelfile for Worm 0�92 made with WormEdit'); {COMMENT}
+
+ HEADEDIT = ('WormEdit�92'+#0+'LVL');
+ HEADVERSION = 92;
+
+ B:RECORD
+ HEAD:ARRAY[1..15]OF CHAR;
+ VERSION:BYTE;
+ NAME:STRING[32];
+ LSINGLE,LMULTI,LCTF,LTOTAL:BYTE;
+ LFROM:ARRAY[1..8]OF BYTE;
+ LTO:ARRAY[1..8]OF BYTE;
+ SPRSIZE:BYTE;
+ SPRITE:ARRAY[1..8]OF BYTE;
+ ENDTYPE:INTEGER;
+ ENDDATA:STRING[255];
+ END {B} =
+ (HEAD:HEADEDIT;
+ VERSION:HEADVERSION;
+ NAME:'Custom Worm Level';
+ LSINGLE:0; LMULTI:0; LCTF:0; LTOTAL:0;
+ LFROM:(0,0,0,0,0,0,0,0);
+ LTO:(0,0,0,0,0,0,0,0);
+ SPRSIZE:4;
+ SPRITE:(6*16,15*16,15*16,6*16,0,0,0,0);
+ {01100000
+ 11110000
+ 11110000
+ 01100000}
+ ENDTYPE:0);
+
+
+VAR I,I2:WORD;
+ II,III,I4:SHORTINT;
+ C:CHAR;
+ S:STRING;
+ F,FF:FILE;
+
+ L:ARRAY[1..64]OF RECORD
+ NAME:STRING[32];
+ SIZE:BYTE;
+ PEAS,DELAY:BYTE;
+ GROWTH,BSIZE:BYTE;
+ SPRSIZE:BYTE;
+ SPRITE:ARRAY[1..8]OF BYTE;
+ NRBALLS:BYTE;
+ BALLS:ARRAY[1..32]OF RECORD
+ Y,X,D:BYTE; {Z:%00=right+down, %11=left+up}
+ END; {BALLS}
+ W:ARRAY[1..4]OF RECORD
+ D,Y,X:BYTE;
+ END; {W(ORMS)}
+ FIELDX,FIELDY:BYTE;
+ FLAG1Y,FLAG1X:BYTE;
+ FLAG2Y,FLAG2X:BYTE;
+ NROBJ:BYTE;
+ OBJ:ARRAY[1..32]OF RECORD
+ TYP,X1,Y1,X2,Y2:BYTE;
+ END; {OBJ}
+ END; {L}
+
+ FILENAME:STRING[8];
+
+FUNCTION NR(VALUE:INTEGER):STRING;
+VAR NRSTR:STRING;
+BEGIN
+ STR(VALUE,NRSTR); NR:=NRSTR;
+END; {NR}
+
+FUNCTION EDITMENU(EDITMENUMAX:BYTE):SHORTINT;
+BEGIN
+ REPEAT
+ REPEAT C:=READKEY;
+ UNTIL(C>='1')AND(C<=CHR(EDITMENUMAX+48))OR(C=#27);
+ IF C=#27THEN EDITMENU:=-1 ELSE EDITMENU:=ORD(C)-48;
+ UNTIL ORD(C)<>0;
+END; {EDITMENU}
+
+FUNCTION COMPSIZE:WORD;
+BEGIN
+ I:=$32+B.SPRSIZE+ORD(B.NAME[0])+
+ 2*(1+(B.LTO[2]-B.LFROM[2])+(B.LTO[3]-B.LFROM[3]));
+ FOR II:=1TO B.LTOTAL DO INC(I,L[II].SIZE);
+ COMPSIZE:=I;
+END; {COMPSIZE}
+
+PROCEDURE EDITTITLE(BAR:SHORTINT;TITLNAME:STRING);
+BEGIN
+ WINDOW(41,2,80,20); CLRSCR; TEXTCOLOR(15); TEXTBACKGROUND(1);
+ CASE BAR OF
+ 1:BEGIN
+ WRITE('LEVELS',' ':40-6); TEXTCOLOR(7); TEXTBACKGROUND(0);
+ IF B.LTOTAL<1THEN WRITELN('NONE PRESENT')ELSE
+ FOR II:=1TO B.LTOTAL DO BEGIN
+ WRITE(II); TEXTCOLOR(3); WRITELN(': '+L[II].NAME); TEXTCOLOR(7);
+ END; {DISP LEVELS}
+ END; {1:SINGLVLS}
+ 2:BEGIN
+ WRITE('LEVEL OBJECTS',' ':40-13); TEXTCOLOR(7); TEXTBACKGROUND(0);
+ IF L[II].NROBJ<1THEN WRITELN('NONE')ELSE
+ FOR I:=1TO L[II].NROBJ DO BEGIN
+ WRITE(I); TEXTCOLOR(3); WRITE(': ',OBJTYPE[L[II].OBJ[I].TYP]);
+ WRITE(' (',L[II].OBJ[I].X1,',',L[II].OBJ[I].Y1,')-(');
+ IF L[II].OBJ[I].TYP=3THEN
+ WRITELN(L[II].OBJ[I].X2,',',L[II].OBJ[I].Y1+L[II].OBJ[I].Y2,')')
+ ELSE WRITELN(L[II].OBJ[I].X2,',',L[II].OBJ[I].Y2,')');
+ TEXTCOLOR(7);
+ END; {DISP OBJS}
+ END; {2:SINGLVLS}
+ 3:BEGIN
+ WRITE('LEVEL INFO',' ':40-10); TEXTCOLOR(7); TEXTBACKGROUND(0);
+ WRITELN('LEVEL #',II,' MP #',II-B.LSINGLE);
+ WRITELN('LEVEL SIZE: ',L[II].SIZE);
+ IF II<=B.LSINGLE THEN WRITELN('SINGLEPLAYER')ELSE FOR I:=2TO 7DO
+ IF(II-B.LSINGLE>=B.LFROM[I])AND(II-B.LSINGLE<=B.LTO[I])THEN
+ WRITELN(GAMETYPE[I]);
+ END; {3:LEVEL}
+ 4:BEGIN
+ WRITE(FILENAME,'.LVL',' ':36-ORD(FILENAME[0])); TEXTCOLOR(7);
+ TEXTBACKGROUND(0); WRITE('FILE VERSION: '); TEXTCOLOR(3);
+ WRITELN(B.VERSION); TEXTCOLOR(7); WRITE('FILE SIZE: '); TEXTCOLOR(3);
+ WRITE(FILESIZE(F)SHR 10); TEXTCOLOR(7); WRITELN('kB');
+ WRITE('COMPILED: '); TEXTCOLOR(3); WRITE(COMPSIZE); TEXTCOLOR(7);
+ WRITE(' BYTES');
+ END; {4:FILE}
+ END; {BAR}
+ WINDOW(1,2,40,20);
+ TEXTBACKGROUND(1); TEXTCOLOR(15); WRITE(TITLNAME,' ':40-ORD(TITLNAME[0]));
+ WINDOW(1,3,40,20); TEXTBACKGROUND(0); CLRSCR;
+END; {EDITTITLE}
+
+PROCEDURE EDITGAME;
+LABEL EDITGAME1,EDITGAME2;
+BEGIN
+ REPEAT
+ EDITTITLE(1,'EDIT GAMETYPES'); TEXTCOLOR(7); WRITE('1: SINGLEPLAYER ');
+ TEXTCOLOR(3); IF B.LSINGLE=0THEN WRITELN('(NO LEVELS)')
+ ELSE WRITELN('(',B.LSINGLE,')');
+ FOR II:=2TO 7DO BEGIN
+ TEXTCOLOR(14); WRITE(II); TEXTCOLOR(7); WRITE(': '+GAMETYPE[II],' ');
+ TEXTCOLOR(3); IF B.LFROM[II]=0THEN WRITELN('(NO LEVELS)')
+ ELSE WRITELN('(',B.LFROM[II]+B.LSINGLE,'-',B.LTO[II]+B.LSINGLE,')');
+ END; {MULTIP}
+ TEXTCOLOR(7); WRITE('8: CTF '); TEXTCOLOR(3);
+ IF B.LCTF=0THEN WRITELN('(NO LEVELS)')ELSE WRITELN('(',B.LCTF,')');
+ TEXTCOLOR(7); WRITELN;III:=EDITMENU(8);
+
+ IF III>1THEN BEGIN
+EDITGAME1:
+ WRITELN('ENTER NEW STARTING LEVEL FOR '+GAMETYPE[III]); WRITE('> ');
+ READLN(B.LFROM[III]); IF B.LFROM[III]>B.LMULTI THEN BEGIN
+ TEXTCOLOR(15); WRITE('THAT LEVEL DOES NOT EXIST! ');
+ TEXTCOLOR(7); WRITELN('JUST ',B.LMULTI,' LEVELS PRESENT.');
+ GOTO EDITGAME1;
+ END; {TOO MUCH}
+ IF B.LFROM[III]=0THEN WRITELN('NO LEVELS FOR THIS GAMETYPE.') {NO LVLS}
+ ELSE BEGIN
+EDITGAME2:
+ WRITE('ENTER LAST LEVEL #> '); READLN(B.LTO[III]);
+ IF B.LTO[III]<B.LFROM[III]THEN BEGIN
+ WRITELN('LAST LEVEL MUST BE BEHIND THE FIRST LEVEL.'); GOTO EDITGAME2;
+ END; {ERROR}
+ IF B.LTO[III]>B.LMULTI THEN BEGIN
+ TEXTCOLOR(15); WRITE('THAT LEVEL DOES NOT (YET) EXIST! ');
+ TEXTCOLOR(7); WRITELN('JUST ',B.LMULTI,' LEVELS PRESENT.');
+ GOTO EDITGAME2;
+ END; {TOO MUCH}
+ END; {ASK LTO}
+ END; {HANDLE}
+ UNTIL III=-1; III:=0;
+END; {EDITGAME}
+
+PROCEDURE EDITOBJ;
+LABEL EDITOBJ1;
+BEGIN
+ REPEAT
+ EDITTITLE(2,'EDIT OBJECT #'+NR(I)+' IN LEVEL '+NR(II));
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITE(': OBJECT TYPE ');
+ III:=L[II].OBJ[I].TYP; TEXTCOLOR(3); WRITELN('(',III,')');
+ IF III<>0THEN BEGIN
+ TEXTCOLOR(14); WRITE('2'); TEXTCOLOR(7); WRITE(': OBJECT BEGIN ');
+ TEXTCOLOR(3); WRITELN('(',L[II].OBJ[I].X1,',',L[II].OBJ[I].Y1,')');
+ TEXTCOLOR(14); WRITE('3'); TEXTCOLOR(7); WRITE(': OBJECT END ');
+ TEXTCOLOR(3); IF L[II].OBJ[I].TYP=3THEN
+ WRITELN('(',L[II].OBJ[I].X2,',',L[II].OBJ[I].Y1+L[II].OBJ[I].Y2,')')
+ ELSE WRITELN('(',L[II].OBJ[I].X2,',',L[II].OBJ[I].Y2,')');
+ END; {OBJECT PROPERTIES}
+ WRITELN; TEXTCOLOR(7); IF III<>0THEN III:=EDITMENU(3)ELSE III:=EDITMENU(1);
+ CASE III OF
+ 1:BEGIN
+EDITOBJ1:
+ WRITELN('ENTER OBJECT TYPE');
+ TEXTCOLOR(8); FOR I4:=0TO 3DO WRITE(I4,': ',OBJTYPE[I4],' ');
+ TEXTCOLOR(7); WRITELN; WRITE('> '); READLN(L[II].OBJ[I].TYP);
+ IF L[II].OBJ[I].TYP>3THEN BEGIN
+ WRITELN('INVALID TYPE!'); GOTO EDITOBJ1;
+ END; {INVALID}
+ TEXTCOLOR(8); WRITELN('SCREEN=(2,2)-(',L[II].FIELDX-2,',',L[II].FIELDY-2,
+ '); CENTER=(',(L[II].FIELDX-1)SHR 1,',',(L[II].FIELDY-1)SHR 1,')');
+ TEXTCOLOR(7); WRITE('ENTER X1> '); READLN(L[II].OBJ[I].X1);
+ WRITE('ENTER Y1> '); READLN(L[II].OBJ[I].Y1);
+ WRITE('ENTER X2> '); READLN(L[II].OBJ[I].X2);
+ WRITE('ENTER Y2> '); READLN(L[II].OBJ[I].Y2);
+ IF L[II].OBJ[I].TYP=3THEN
+ L[II].OBJ[I].Y2:=L[II].OBJ[I].Y2-L[II].OBJ[I].Y1;
+ END; {TYPE}
+ 2:BEGIN
+ TEXTCOLOR(8); WRITELN('SCREEN=(2,2)-(',L[II].FIELDX-2,',',L[II].FIELDY-2,
+ '); CENTER=(',(L[II].FIELDX-1)SHR 1,',',(L[II].FIELDY-1)SHR 1,')');
+ TEXTCOLOR(7); WRITE('ENTER BEGIN X> '); READLN(L[II].OBJ[I].X1);
+ WRITE('ENTER BEGIN Y> '); READLN(L[II].OBJ[I].Y1);
+ END; {BEGIN}
+ 3:BEGIN
+ TEXTCOLOR(8); WRITELN('SCREEN=(2,2)-(',L[II].FIELDX-2,',',L[II].FIELDY-2,
+ '); CENTER=(',(L[II].FIELDX-1)SHR 1,',',(L[II].FIELDY-1)SHR 1,')');
+ TEXTCOLOR(7); WRITE('ENTER END X> '); READLN(L[II].OBJ[I].X2);
+ WRITE('ENTER END Y> '); READLN(L[II].OBJ[I].Y2);
+ IF L[II].OBJ[I].TYP=3THEN
+ L[II].OBJ[I].Y2:=L[II].OBJ[I].Y2-L[II].OBJ[I].Y1;
+ END; {END}
+ END; {HANDLE}
+ UNTIL III=-1; III:=0;
+END; {EDITOBJ}
+
+PROCEDURE EDITOBJS;
+LABEL EDITOBJS1,EDITOBJS2;
+BEGIN
+ REPEAT
+ EDITTITLE(2,'EDIT LEVEL OBJECTS');
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITELN(': CREATE OBJECT');
+ TEXTCOLOR(14); WRITE('2'); TEXTCOLOR(7); WRITELN(': EDIT OBJECT');
+ TEXTCOLOR(14); WRITE('3'); TEXTCOLOR(7); WRITELN(': DELETE OBJECT');
+ WRITELN;
+ III:=EDITMENU(3);
+
+ CASE III OF
+ 1:BEGIN
+ INC(L[II].NROBJ); I:=L[II].NROBJ; EDITOBJ;
+ END; {CREATE}
+ 2:BEGIN
+EDITOBJS1:
+ WRITE('EDIT WHICH OBJECT> '); READLN(I);
+ IF I>L[II].NROBJ THEN BEGIN
+ WRITELN('JUST ',L[II].NROBJ,' OBJECTS PRESENT!');
+ GOTO EDITOBJS1;
+ END; {DNOT EXIST}
+ IF I<>0THEN EDITOBJ;
+ END; {PEAS}
+ 3:BEGIN
+EDITOBJS2:
+ WRITE('DELETE WHICH OBJECT> '); READLN(I);
+ IF I>L[II].NROBJ THEN BEGIN
+ WRITELN('I''M SORRY BUT THAT OBJECT DOES NOT EXIST');
+ GOTO EDITOBJS2;
+ END; {ERROR}
+ IF I<>0THEN BEGIN
+ WRITE('PLEASE CONFIRM OBJECT TO '); TEXTCOLOR(15); WRITE('REMOVE');
+ TEXTCOLOR(7); WRITE('> '); READLN(I4);
+ IF I=I4 THEN BEGIN
+ DEC(L[II].NROBJ); FOR I:=I4 TO L[II].NROBJ DO L[II].OBJ[I]:=L[II].OBJ[I+1];
+ END; {OK}
+ END; {SMTN}
+ END; {DELETE}
+ END; {HANDLE}
+ UNTIL III=-1; III:=0;
+END; {EDITOBJS}
+
+FUNCTION BYTE2STR(SPRITE,SPRSIZE:BYTE):STRING;
+VAR SPRTEMP:STRING[8];
+ SPRTEMP2:BYTE;
+BEGIN
+ SPRTEMP:='';
+ FOR SPRTEMP2:=1TO 8-SPRSIZE DO SPRITE:=SPRITE SHR 1;
+ FOR SPRTEMP2:=9-SPRSIZE TO 8DO BEGIN
+ IF SPRITE MOD 2=1THEN SPRTEMP:='X'+SPRTEMP ELSE SPRTEMP:='�'+SPRTEMP;
+ SPRITE:=SPRITE SHR 1;
+ END;
+ BYTE2STR:=SPRTEMP;
+END; {BYTE2STR}
+
+FUNCTION STR2BYTE(SPRITE:STRING):BYTE;
+VAR SPRTEMP,SPRTEMP2:BYTE;
+BEGIN
+ SPRTEMP:=0; SPRTEMP2:=1;
+ FOR SPRTEMP2:=1TO LENGTH(SPRITE)DO
+ IF SPRITE[SPRTEMP2]='1'THEN INC(SPRTEMP,1SHL(8-SPRTEMP2));
+ STR2BYTE:=SPRTEMP;
+END; {STR2BYTE}
+
+PROCEDURE EDITSPR;
+BEGIN
+ REPEAT
+ EDITTITLE(0,'EDIT SPRITE');
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITE(': SPRITE SIZE ');
+ TEXTCOLOR(3); IF L[II].SPRSIZE=0THEN WRITELN('(DEFAULT)')
+ ELSE WRITELN('(',L[II].SPRSIZE,')');
+ IF L[II].SPRSIZE=0THEN BEGIN
+ TEXTCOLOR(14); WRITE('2'); TEXTCOLOR(7); WRITE(': EDIT SPRITE');
+ TEXTCOLOR(3); WRITELN(' (DEFAULT)');
+ END {DEF SPR} ELSE FOR I:=1TO L[II].SPRSIZE DO BEGIN
+ TEXTCOLOR(14); WRITE(I+1); TEXTCOLOR(7); WRITE(': EDIT '); TEXTCOLOR(3);
+ WRITELN(BYTE2STR(L[II].SPRITE[I],L[II].SPRSIZE));
+ END; {DISP SPRITE}
+ TEXTCOLOR(7); WRITELN; III:=EDITMENU(1+L[II].SPRSIZE);
+
+ IF III=1THEN BEGIN
+ WRITE('ENTER NEW SPRITE SIZE (MAX.HEIGHT/WIDTH)> '); READLN(I);
+ IF I>L[II].SPRSIZE THEN FOR I4:=L[II].SPRSIZE+1TO I DO
+ L[II].SPRITE[I4]:=0;
+ L[II].SPRSIZE:=I;
+ END {SIZE} ELSE IF III>1THEN BEGIN
+ WRITELN('ENTER NEW LINE #',III-1,' OF SPRITE'); TEXTCOLOR(8);
+ WRITE('(ex: 100101 = X��X�X)'); TEXTCOLOR(7); WRITE('> ');
+ READLN(S); L[II].SPRITE[III-1]:=STR2BYTE(S);
+ END; {APP}
+ UNTIL III=-1; III:=0;
+END; {EDITSPR}
+
+PROCEDURE EDITWORMS;
+BEGIN
+ REPEAT
+ EDITTITLE(0,'EDIT WORMS IN LEVEL #'+NR(II));
+ IF II>B.LSINGLE THEN III:=4 ELSE III:=1;
+ FOR III:=1TO III DO BEGIN
+ TEXTCOLOR(14); WRITE(III SHL 1-1); TEXTCOLOR(7);
+ WRITE(': WORM #',III,' DIRECTION '); TEXTCOLOR(3);
+ WRITELN('(',L[II].W[III].D,')');
+ TEXTCOLOR(14); WRITE(III SHL 1); TEXTCOLOR(7);
+ WRITE(': WORM #',III,' POSITION '); TEXTCOLOR(3);
+ WRITELN('(',L[II].W[III].X,',',L[II].W[III].Y,')');
+ END; {}
+ TEXTCOLOR(7); WRITELN;
+ IF III=4THEN III:=EDITMENU(8)ELSE III:=EDITMENU(2);
+
+ CASE III OF
+ 1,3,5,7:BEGIN
+ WRITELN('ENTER WORM #',(III+1)SHR 1,' STARTING DIRECTION'); TEXTCOLOR(8);
+ WRITELN('(0=down; 64=right; 128=up; 192=left)');
+ TEXTCOLOR(7); WRITE('> '); READLN(I); L[II].W[(III+1)SHR 1].D:=I;
+ END; {DIR}
+ 2,4,6,8:BEGIN
+ WRITELN('ENTER WORM #',III SHR 1,' BEGIN X-POSITION'); TEXTCOLOR(8);
+ WRITELN('(screen = 2-',L[II].FIELDX-2,'; center = ',L[II].FIELDX DIV 2);
+ TEXTCOLOR(7); WRITE('> '); READLN(I); L[II].W[III SHR 1].X:=I;
+ WRITELN('ENTER WORM #',III SHR 1,' BEGIN Y-POSITION'); TEXTCOLOR(8);
+ WRITELN('(screen = 2-',L[II].FIELDY-2,'; center = ',L[II].FIELDY DIV 2);
+ TEXTCOLOR(7); WRITE('> '); READLN(I); L[II].W[III SHR 1].Y:=I;
+ END; {POS}
+ END; {HANDLE}
+ UNTIL III=-1; III:=0;
+END; {EDITWORMS}
+
+PROCEDURE EDITLEVEL;
+BEGIN
+ REPEAT
+ L[II].SIZE:=12+L[II].NRBALLS+L[II].SPRSIZE+L[II].NROBJ*5;
+ IF II>B.LSINGLE THEN INC(L[II].SIZE,9);
+ EDITTITLE(3,'EDIT LEVEL #'+NR(II));
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITE(': DESCRIPTION ');
+ TEXTCOLOR(3); WRITELN('(',L[II].NAME,')');
+ TEXTCOLOR(14); WRITE('2'); TEXTCOLOR(7); WRITE(': NUMBER OF PEAS ');
+ TEXTCOLOR(3); WRITELN('(',L[II].PEAS,')');
+ TEXTCOLOR(14); WRITE('3'); TEXTCOLOR(7); WRITE(': GAME DELAY ');
+ TEXTCOLOR(3); WRITELN('(',L[II].DELAY,')');
+ TEXTCOLOR(14); WRITE('4'); TEXTCOLOR(7); WRITE(': GROWTH ');
+ TEXTCOLOR(3); WRITELN('(',L[II].GROWTH,'+',L[II].BSIZE,')');
+ TEXTCOLOR(14); WRITE('5'); TEXTCOLOR(7); WRITE(': SPRITE ');
+ TEXTCOLOR(3); IF L[II].SPRSIZE=0THEN WRITELN('(DEFAULT)')
+ ELSE WRITELN('(',L[II].SPRSIZE,')');
+ TEXTCOLOR(14); WRITE('6'); TEXTCOLOR(7); WRITE(': BOUNCY BALLS ');
+ TEXTCOLOR(3); WRITELN('(',L[II].NRBALLS,')');
+ TEXTCOLOR(14); WRITE('7'); TEXTCOLOR(7); WRITE(': WORMS '); TEXTCOLOR(3);
+ IF II>B.LSINGLE THEN BEGIN
+ WRITELN('(',L[II].W[1].D,';',L[II].W[2].D,';',L[II].W[3].D,';',L[II].W[4].D,')');
+ END {FOUR WORMS} ELSE
+ WRITELN('(',L[II].W[1].X,',',L[II].W[1].Y,':',L[II].W[1].D,')');
+ TEXTCOLOR(14); WRITE('8'); TEXTCOLOR(7); WRITE(': FIELD SIZE ');
+ TEXTCOLOR(3); WRITELN('(',L[II].FIELDX,',',L[II].FIELDY,')');
+ TEXTCOLOR(14); WRITE('9'); TEXTCOLOR(7); WRITE(': OBJECTS ');
+ TEXTCOLOR(3); WRITELN('(',L[II].NROBJ,')');
+ TEXTCOLOR(7); WRITELN;
+ III:=EDITMENU(9);
+
+ CASE III OF
+ 1:BEGIN
+ WRITELN('ENTER DESCRIPTION FOR THIS LEVEL'); WRITE('> ');
+ READLN(S); IF S<>''THEN L[II].NAME:=S;
+ END; {DESCR}
+ 2:BEGIN
+ WRITE('ENTER TOTAL NUMBER OF PEAS> ');
+ READLN(I); L[II].PEAS:=I;
+ END; {PEAS}
+ 3:BEGIN
+ WRITE('ENTER NEW DELAY '); TEXTCOLOR(8); WRITE('(0=fastest; 4=def.)');
+ TEXTCOLOR(7); WRITE('> '); READLN(I); L[II].DELAY:=I;
+ END; {DELAY}
+ 4:BEGIN
+ WRITE('ENTER GROWTH PER PEA '); TEXTCOLOR(8); WRITE('(15=default)');
+ TEXTCOLOR(7); WRITE('> '); READLN(I); L[II].GROWTH:=I;
+ WRITE('ENTER WORM BEGIN SIZE '); TEXTCOLOR(8); WRITE('(15=default)');
+ TEXTCOLOR(7); WRITE('> '); READLN(I); L[II].BSIZE:=I;
+ END; {GROWTH}
+ 5:EDITSPR;
+ 7:EDITWORMS;
+ 8:BEGIN
+ WRITELN('ENTER FIELD WIDTH'); TEXTCOLOR(8);
+ WRITE('(128=screen-width; 255=max.)');
+ TEXTCOLOR(7); WRITE('> '); READLN(I); L[II].FIELDX:=BYTE(I);
+ WRITELN('ENTER FIELD HEIGHT'); TEXTCOLOR(8);
+ WRITE('(57=screen-height 255=max.)');
+ TEXTCOLOR(7); WRITE('> '); READLN(I); L[II].FIELDY:=BYTE(I);
+ END; {FIELD}
+ 9:EDITOBJS;
+ END; {HANDLE}
+ UNTIL III=-1; III:=0;
+END; {EDITLEVEL}
+
+PROCEDURE EDITLVL;
+LABEL EDITHLVL1,EDITHLVL2;
+BEGIN
+ REPEAT
+ EDITTITLE(1,'EDIT LEVELS');
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITELN(': EDIT LEVEL');
+ TEXTCOLOR(14); WRITE('2'); TEXTCOLOR(7); WRITELN(': DELETE LEVEL');
+ TEXTCOLOR(14); WRITE('3'); TEXTCOLOR(7); WRITELN(': CREATE SINGLEPLAYER LEVEL');
+ TEXTCOLOR(14); WRITE('4'); TEXTCOLOR(7); WRITELN(': CREATE MULTIPLAYER LEVEL');
+ TEXTCOLOR(7); WRITE('5'); TEXTCOLOR(7); WRITELN(': CREATE CTF LEVEL');
+ TEXTCOLOR(7); WRITELN; III:=EDITMENU(4);
+
+ CASE III OF
+ 1:BEGIN
+EDITHLVL1:
+ WRITE('EDIT WHICH LEVEL> '); READLN(II);
+ IF II>B.LTOTAL THEN BEGIN
+ WRITELN('THAT LEVEL DOES NOT EXIST!'); GOTO EDITHLVL1;
+ END; {ERROR}
+ IF II<>0THEN EDITLEVEL;
+ END; {EDIT}
+ 2:BEGIN
+EDITHLVL2:
+ WRITE('DELETE WHICH LEVEL> '); READLN(II);
+ IF II>B.LTOTAL THEN BEGIN
+ WRITELN('YOU CANNOT DELETE A LEVEL THAT DOES NOT EXIST!');
+ GOTO EDITHLVL2;
+ END; {ERROR}
+ IF II<>0THEN BEGIN
+ WRITE('PLEASE CONFIRM LEVEL TO '); TEXTCOLOR(15); WRITE('DELETE');
+ TEXTCOLOR(7); WRITE('> '); READLN(I);
+ IF I=II THEN BEGIN
+ IF I<=B.LSINGLE THEN DEC(B.LSINGLE)ELSE
+ IF I<=B.LMULTI+B.LSINGLE THEN DEC(B.LMULTI)ELSE
+ DEC(B.LCTF);
+ DEC(B.LTOTAL); FOR I:=II TO B.LTOTAL DO L[I]:=L[I+1];
+ FOR I:=2TO 7DO BEGIN
+ IF B.LTO[I]>B.LMULTI THEN B.LTO[I]:=B.LMULTI;
+ IF B.LFROM[I]>B.LTO[I]THEN B.LFROM[I]:=B.LTO[I];
+ END; {CHECK}
+ END; {OK}
+ END; {SMTN}
+ END; {DELETE}
+
+ 3:BEGIN
+ INC(B.LSINGLE); INC(B.LTOTAL); II:=B.LSINGLE;
+ FOR I:=B.LTOTAL DOWNTO II+1DO L[I]:=L[I-1];
+ L[II].NAME:='Level #'+NR(II);
+ L[II].PEAS:=8; L[II].DELAY:=4; L[II].GROWTH:=15; L[II].BSIZE:=15;
+ L[II].SPRSIZE:=0; L[II].NRBALLS:=0; L[II].W[1].D:=0; L[II].W[1].X:=63;
+ L[II].W[1].Y:=2; L[II].FIELDX:=128; L[II].FIELDY:=57; L[II].NROBJ:=0;
+ EDITLEVEL;
+ END; {CREATE SP}
+ 4:BEGIN
+ FOR I:=2TO 7DO IF B.LTO[I]=B.LMULTI THEN BEGIN
+ INC(B.LTO[I]); IF B.LFROM[I]=0THEN INC(B.LFROM[I]);
+ END; {}
+ INC(B.LTOTAL); INC(B.LMULTI); II:=B.LSINGLE+B.LMULTI;
+ FOR I:=B.LTOTAL DOWNTO II+1DO L[I]:=L[I-1];
+ L[II].NAME:='Arena #'+NR(B.LMULTI);
+ L[II].DELAY:=4; L[II].GROWTH:=15; L[II].BSIZE:=15; L[II].SPRSIZE:=0;
+ L[II].W[1].D:=$40; L[II].W[1].Y:=28; L[II].W[1].X:=2;
+ L[II].W[2].D:=$C0; L[II].W[2].Y:=28; L[II].W[2].X:=125;
+ L[II].W[3].D:=$00; L[II].W[3].Y:=02; L[II].W[3].X:=63;
+ L[II].W[4].D:=$80; L[II].W[4].Y:=54; L[II].W[4].X:=63;
+ L[II].NRBALLS:=0; L[II].FIELDX:=128; L[II].FIELDY:=57;
+ L[II].NROBJ:=0; EDITLEVEL;
+ END; {CREATE MP}
+ END; {HANDLE}
+ UNTIL III=-1; III:=0;
+END; {EDITLVL}
+
+PROCEDURE EDITDSPR;
+BEGIN
+ REPEAT
+ EDITTITLE(0,'EDIT DEFAULT SPRITE');
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITE(': SPRITE SIZE ');
+ TEXTCOLOR(3); WRITELN('(',B.SPRSIZE,')');
+ FOR I:=1TO B.SPRSIZE DO BEGIN
+ TEXTCOLOR(14); WRITE(I+1); TEXTCOLOR(7); WRITE(': EDIT '); TEXTCOLOR(3);
+ WRITELN(BYTE2STR(B.SPRITE[I],B.SPRSIZE));
+ END; {DISP SPRITE}
+ TEXTCOLOR(7); WRITELN; III:=EDITMENU(1+B.SPRSIZE);
+
+ IF III=1THEN BEGIN
+ WRITELN('ENTER THE DEFAULT SPRITE SIZE'); TEXTCOLOR(8);
+ WRITE('(1-8; can be changed per level)'); TEXTCOLOR(7); WRITE('> ');
+ READLN(I); IF(I>0)AND(I<=8)THEN BEGIN
+ IF I>B.SPRSIZE THEN FOR I4:=B.SPRSIZE+1TO I DO B.SPRITE[I4]:=0;
+ B.SPRSIZE:=I;
+ END; {OK}
+ END {SIZE} ELSE IF III>1THEN BEGIN
+ WRITELN('ENTER NEW LINE #',III-1,' OF SPRITE'); TEXTCOLOR(8);
+ WRITE('(ex: 100101 = X��X�X)'); TEXTCOLOR(7); WRITE('> ');
+ READLN(S); B.SPRITE[III-1]:=STR2BYTE(S);
+ END; {APP}
+ UNTIL III=-1; III:=0;
+END; {EDITDSPR}
+
+PROCEDURE EDITSPEND;
+BEGIN
+ REPEAT
+ EDITTITLE(0,'SINGLEPLAYER ENDING');
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITE(': END TYPE ');
+ TEXTCOLOR(3); WRITELN(' (',ENDTYPE[B.ENDTYPE],')'); TEXTCOLOR(14);
+ CASE B.ENDTYPE OF
+ -1:BEGIN
+ WRITE('2'); TEXTCOLOR(7); WRITE(': EDIT MESSAGE');
+ TEXTCOLOR(3); WRITE(' (',COPY(B.ENDDATA,1,18));
+ IF LENGTH(B.ENDDATA)>18THEN WRITELN('...)')ELSE WRITELN(')');
+ END; {MSG}
+ END; {TYPE} TEXTCOLOR(7); WRITELN; III:=EDITMENU(2);
+ CASE III OF
+ 1:BEGIN
+ WRITELN('ENTER NEW END TYPE:'); TEXTCOLOR(8);
+ FOR II:=0TO 1DO WRITE(II,': ',ENDTYPE[-II],' '); WRITELN; TEXTCOLOR(7);
+ WRITE('> '); READLN(II); IF(II<=1)AND(II>=0)THEN B.ENDTYPE:=-II;
+ IF II=1THEN B.ENDDATA:='Congratulations!!';
+ END; {TITLE}
+ 2:BEGIN
+ CASE B.ENDTYPE OF
+ -1:BEGIN
+ WRITE('ENTER NEW END MESSAGE '); TEXTCOLOR(8);
+ WRITELN('(max 255 chars)'); WRITE('> ');
+ READLN(S); IF S<>''THEN B.ENDDATA:=S;
+ END; {MSG}
+ END; {TYPE}
+ END; {EDIT}
+ END; {HANDLE}
+ UNTIL III=-1; III:=0;
+END; {EDITSPEND}
+
+
+PROCEDURE EDITMAIN;
+BEGIN
+ REPEAT
+ S:=''; FOR II:=1TO LENGTH(B.NAME)DO S:=S+UPCASE(B.NAME[II]); EDITTITLE(4,S);
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITELN(': EDIT TITLE');
+ TEXTCOLOR(14); WRITE('2'); TEXTCOLOR(7); WRITE(': DEFAULT SPRITE');
+ TEXTCOLOR(3); WRITELN(' (',B.SPRSIZE,')');
+ TEXTCOLOR(14); WRITE('3'); TEXTCOLOR(7); WRITELN(': GAME TYPES');
+ TEXTCOLOR(14); WRITE('4'); TEXTCOLOR(7); WRITE(': SP ENDING');
+ TEXTCOLOR(3); WRITELN(' (',ENDTYPE[B.ENDTYPE],')');
+ TEXTCOLOR(14); WRITE('5'); TEXTCOLOR(7); WRITE(': LEVELS');
+ TEXTCOLOR(3); WRITELN(' (',B.LTOTAL,')');
+ TEXTCOLOR(7); WRITELN; III:=EDITMENU(5);
+ CASE III OF
+ 1:BEGIN
+ WRITELN('ENTER NEW TITLE FOR THIS LEVELFILE ');
+ TEXTCOLOR(8); WRITE('enter=don''t alter; max. length 32 chars ');
+ TEXTCOLOR(7); WRITE('> '); READLN(S); IF S<>''THEN B.NAME:=S;
+ END; {TITLE}
+ 2:EDITDSPR;
+ 3:EDITGAME;
+ 4:EDITSPEND;
+ 5:EDITLVL;
+ END; {HANDLE}
+ UNTIL III=-1; III:=0;
+END; {EDITMAIN}
+
+PROCEDURE OPENFILE;
+BEGIN
+ ASSIGN(F,FILENAME+'.LVL'); {$I-} RESET(F,1); {$I+} IF IORESULT=0THEN BEGIN
+ {$I-} BLOCKREAD(F,B,SIZEOF(B)); BLOCKREAD(F,L,SIZEOF(L)); {$I+}
+ IF(IORESULT<>0)OR(B.HEAD<>HEADEDIT)THEN BEGIN
+ TEXTCOLOR(15); WRITE('WARNING!! '); TEXTCOLOR(7);
+ WRITELN('ERROR READING LEVEL FILE!');
+ CLOSE(F); HALT;
+ END; {ERROR}
+ IF B.VERSION<>HEADVERSION THEN BEGIN
+ WRITELN('CAN''T READ FILE VERSION ',B.VERSION,'.'); CLOSE(F); HALT;
+ END; {VERSION}
+ END; {OPEN EXISTING FILE}
+END; {OPENFILE}
+
+PROCEDURE FILESAVE;
+BEGIN
+ ASSIGN(F,FILENAME+'.LVL'); REWRITE(F,1);
+ BLOCKWRITE(F,B,SIZEOF(B)); BLOCKWRITE(F,L,SIZEOF(L)); CLOSE(F);
+END; {FILESAVE}
+
+PROCEDURE FILECOMP;
+VAR ISTACK:WORD;
+BEGIN
+ ASSIGN(FF,FILENAME+'.86S'); REWRITE(FF,1);
+
+ BLOCKWRITE(FF,HEAD86S[1],ORD(HEAD86S[0])); {86S-HEADER}
+ ISTACK:=$12+6+B.SPRSIZE+ORD(B.NAME[0])+24+2+
+ 2*(1+(B.LTO[2]-B.LFROM[2])+(B.LTO[3]-B.LFROM[3]));
+ FOR II:=1TO B.LTOTAL DO INC(ISTACK,L[II].SIZE);
+ BLOCKWRITE(FF,ISTACK,2); {FILE LENGTH (x+$12)}
+ I:=$000C; BLOCKWRITE(FF,I,2); {STRING ID}
+ DEC(ISTACK,$10); BLOCKWRITE(FF,ISTACK,2); {DATA LENGTH (x+2)}
+
+ I:=$080C; BLOCKWRITE(FF,I,2); {STRING ID}
+ S:='wormlvl1'; BLOCKWRITE(FF,S[1],8); {PRGNAME}
+ BLOCKWRITE(FF,ISTACK,2); {DATA LENGTH (x+2)}
+ DEC(ISTACK,2); BLOCKWRITE(FF,ISTACK,2); {PROG LENGTH (x)}
+
+ C:='w'; BLOCKWRITE(FF,C,1); {WORM ID}
+ I:=92; BLOCKWRITE(FF,I,1); {VERSION}
+ BLOCKWRITE(FF,B.NAME[0],ORD(B.NAME[0])+1); {TITLE}
+ I:=1+B.SPRSIZE+2; FOR II:=1TO B.LTOTAL DO I:=I+L[II].SIZE;
+ BLOCKWRITE(FF,I,2); {SIZE}
+
+ I2:=0; I:=$F401+B.SPRSIZE;
+ IF B.LSINGLE=0THEN BLOCKWRITE(FF,I2,2)ELSE BEGIN
+ BLOCKWRITE(FF,I,2); FOR II:=1TO B.LSINGLE DO INC(I,L[II].SIZE);
+ END; {SINGLLVLS} INC(I,2);
+ ISTACK:=I; FOR II:=2TO 7DO BEGIN
+ I:=ISTACK; IF B.LFROM[II]=0THEN I:=0 ELSE
+ FOR III:=B.LSINGLE TO B.LSINGLE+B.LFROM[II]-2DO
+ INC(I,L[III].SIZE);
+ BLOCKWRITE(FF,I,2);
+ END; {LOC}
+ FOR II:=B.LSINGLE+B.LMULTI+1TO B.LTOTAL DO INC(ISTACK,L[II].SIZE);
+ I:=0; IF B.LCTF=0THEN BLOCKWRITE(FF,I,2)ELSE BLOCKWRITE(FF,ISTACK,2);
+
+ BLOCKWRITE(FF,B.LSINGLE,1);
+ FOR II:=2TO 7DO BEGIN
+ IF B.LFROM[II]=0THEN I:=0 ELSE I:=B.LTO[II]-B.LFROM[II]+1;
+ BLOCKWRITE(FF,I,1);
+ END; {NR}
+ BLOCKWRITE(FF,B.LCTF,1);
+
+ BLOCKWRITE(FF,B.SPRSIZE,1);
+ BLOCKWRITE(FF,B.SPRITE,B.SPRSIZE);
+
+ FOR II:=1TO B.LSINGLE DO BEGIN
+ BLOCKWRITE(FF,L[II].PEAS,1);
+ BLOCKWRITE(FF,L[II].DELAY,1);
+ BLOCKWRITE(FF,L[II].GROWTH,1);
+ BLOCKWRITE(FF,L[II].BSIZE,1);
+ BLOCKWRITE(FF,L[II].SPRSIZE,1);
+ BLOCKWRITE(FF,L[II].SPRITE,L[II].SPRSIZE);
+ BLOCKWRITE(FF,L[II].NRBALLS,1);
+ BLOCKWRITE(FF,L[II].BALLS,L[II].NRBALLS*3);
+ BLOCKWRITE(FF,L[II].W[1].D,3); {D,X,Y}
+ BLOCKWRITE(FF,L[II].FIELDX,2); {FIELDX,FIELDY}
+ FOR I:=1TO L[II].NROBJ DO BEGIN
+ BLOCKWRITE(FF,L[II].OBJ[I].TYP,5);
+ END; {OBJS}
+ I:=0; BLOCKWRITE(FF,I,1); {LVL END}
+ END; {LEVELS SINGLEPL}
+
+ I:=255; BLOCKWRITE(FF,I,1); {END}
+ I:=$C9; BLOCKWRITE(FF,I,1); {RET}
+
+ FOR II:=B.LSINGLE+1TO B.LSINGLE+B.LMULTI DO BEGIN
+ BLOCKWRITE(FF,L[II].PEAS,1);
+ BLOCKWRITE(FF,L[II].DELAY,1);
+ BLOCKWRITE(FF,L[II].GROWTH,1);
+ BLOCKWRITE(FF,L[II].BSIZE,1);
+ BLOCKWRITE(FF,L[II].SPRSIZE,1);
+ BLOCKWRITE(FF,L[II].SPRITE,L[II].SPRSIZE);
+ BLOCKWRITE(FF,L[II].NRBALLS,1);
+ BLOCKWRITE(FF,L[II].BALLS,L[II].NRBALLS*3);
+ BLOCKWRITE(FF,L[II].W[1].D,3*4); {D,X,Y}
+ BLOCKWRITE(FF,L[II].FIELDX,2); {FIELDX,FIELDY}
+ FOR I:=1TO L[II].NROBJ DO BEGIN
+ BLOCKWRITE(FF,L[II].OBJ[I].TYP,5);
+ END; {OBJS}
+ I:=0; BLOCKWRITE(FF,I,1); {LVL END}
+ END; {LEVELS MULTIPL}
+
+ I:=0; FOR II:=1TO 1+(B.LTO[2]-B.LFROM[2])+(B.LTO[3]-B.LFROM[3])DO
+ BLOCKWRITE(FF,I,2); {HI}
+
+ SEEK(FF,$37); I2:=0; I:=0;
+ REPEAT INC(I,I2); BLOCKREAD(FF,I2,1,ISTACK); UNTIL ISTACK<>1;
+ BLOCKWRITE(FF,I,2); {CHECKSUM}
+END; {FILECOMP}
+
+PROCEDURE EDITQUIT;
+BEGIN
+ REPEAT
+ EDITTITLE(0,'CHOOSE LEVELFILE');
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITELN(': COMPILE, SAVE AND QUIT');
+ TEXTCOLOR(14); WRITE('2'); TEXTCOLOR(7); WRITE(': SAVE ');
+ TEXTCOLOR(3); WRITELN(FILENAME,'.LVL');
+ TEXTCOLOR(14); WRITE('3'); TEXTCOLOR(7); WRITELN(': QUIT');
+ TEXTCOLOR(14); WRITE('4'); TEXTCOLOR(7); WRITELN(': CONTINUE EDITING');
+ WRITELN; III:=EDITMENU(4);
+ CASE III OF
+ 1:BEGIN
+ FILESAVE; FILECOMP; HALT;
+ END; {COMPILE}
+ 2:FILESAVE;
+ 3:BEGIN
+ WRITE('REALLY QUIT '); TEXTCOLOR(8); WRITE('[Y/N]'); TEXTCOLOR(7);
+ WRITE('> '); REPEAT C:=READKEY; UNTIL(UPCASE(C)='Y')OR(UPCASE(C)='N');
+ IF UPCASE(C)='N'THEN III:=0;
+ END; {QUIT}
+ 4:EDITMAIN;
+ END; {HANDLE}
+ UNTIL III=3; HALT;
+END; {EDITQUIT}
+
+PROCEDURE EDITFILE;
+BEGIN
+ REPEAT
+ EDITTITLE(0,'CHOOSE LEVELFILE');
+ TEXTCOLOR(14); WRITE('1'); TEXTCOLOR(7); WRITELN(': CREATE NEW FILE');
+ TEXTCOLOR(14); WRITE('2'); TEXTCOLOR(7); WRITELN(': EDIT EXISTING');
+ TEXTCOLOR(14); WRITE('3'); TEXTCOLOR(7); WRITE(': EDIT'); TEXTCOLOR(3);
+ WRITELN(' WORMLVL1.LVL'); TEXTCOLOR(7); WRITELN; III:=EDITMENU(3);
+ CASE III OF
+ 1:BEGIN
+ WRITE('ENTER FILENAME '); TEXTCOLOR(8); WRITE('(max.8 chars)');
+ TEXTCOLOR(7); WRITE('> '); READLN(FILENAME); EDITMAIN; EDITQUIT;
+ END; {NEW}
+ 2:BEGIN
+ WRITE('ENTER LEVELNAME '); TEXTCOLOR(8); WRITE('(w/o extension)');
+ TEXTCOLOR(7); WRITE('> '); READLN(FILENAME); OPENFILE; EDITMAIN;
+ EDITQUIT;
+ END; {EDIT}
+ 3:BEGIN
+ FILENAME:='WORMLVL1'; OPENFILE; EDITMAIN; EDITQUIT;
+ END; {WORMLVL1}
+ END; {HANDLE}
+ UNTIL III=-1;
+END; {EDITFILE}
+
+
+BEGIN
+ CLRSCR;
+ TEXTCOLOR(1); WRITE('���������������������������<');
+ TEXTCOLOR(14); WRITE(' WormEdit � ');
+ TEXTCOLOR(15); WRITE(' by SHIAR ');
+ TEXTCOLOR(1); WRITE('>�����������������������������');
+ EDITFILE;
+END.
\ No newline at end of file