//
//  WORM KUN  1939.11.17-21
//        FOR SLANG
//     Programed by JUNJI

        ORG   $8000;

        VAR   LENG,I,J,SCORE,HISC,X,Y,
              DEATH,ROUND,PX,PY,PFLAG,
              HANI,NOKORI,RONALL,NAGASA,
              TKAZU,KCODE,SPC,APF,OVER;

        ARRAY BYTE  WORM[31],
              BYTE  VRAM[29][24]:$B000,
              BYTE  RON[45],
              BYTE  BACK[300],
              BYTE  ASTA[15];

MAIN()
   VAR I,OVKEY;
 BEGIN
   WIDTH(40);
   REPEAT (
    SHOKI();
    GAMEN();
    MENSHOKI();
    PARAMETER();
    WORMPRINT();
    REPEAT (
    LOCATE(30,20); PRINT("PUSH ANY");
    LOCATE(30,21); PRINT("  KEY!");
    LOCATE(30,20); PRINT("        ");
    LOCATE(30,21); PRINT("      ");
    ) UNTIL INKEY(0)<>0;
     REPEAT (
      ASTAMAIN();
      FOR I=0 TO 2 (
      RONMAIN();
       WAIT();
       WORMMAIN();
       IF PFLAG<>0 THEN POINTPUT();
       IF RONALL==0 THEN ROUNDCLEAR();
       IF DEATH<>0 THEN (
           WSHINDA();I=0;
        ) ENDIF;
      ) NEXT;
       APF--;
      )
     UNTIL OVER<>0;
     OVKEY=GAMEOVER();
    ) UNTIL OVKEY==2;
   LOCATE(0,0);
 END;

WORMMAIN()
   VAR  KEY,FLAG;
BEGIN
      KEY=KEYSET();
      IF KEY==0 THEN KEY=KCODE;
         ELSE IF KEY<>5 THEN KCODE=KEY;
       X=WORM[0];
       Y=WORM[1];
       CASE KEY OF (
          1   Y--;
          2   X++;
          3   Y++;
          4   X--;
          5   IF SPC==0 THEN (;
               POINTSET();SPC=10;
            ) ENDIF;
         10   OVER=10;
        )
    IF KEY<>0 THEN (
       FLAG=XYCHK();
       FLAG=CHRCHK();
        IF FLAG==0 THEN (
          WORMMOVE();
       ) ENDIF;
    )  ENDIF;
      WORMPRINT();
END;

KEYSET()
   VAR CODE;
 BEGIN
     CODE=INKEY(0);
       CASE CODE OF (
           '2'  CODE=3;
           '4'  CODE=4;
           '6'  CODE=2;
           '8'  CODE=1;
           'M'  CODE=3;
           'J'  CODE=4;
           'L'  CODE=2;
           'I'  CODE=1;
           $1F  CODE=3;
           $1D  CODE=4;
           $1C  CODE=2;
           $1E  CODE=1;
           ' '  CODE=5;
           $1B  CODE=10;
         OTHERS CODE=0;
        )
       IF CODE<>5 THEN ( SPC=0;
         IF CODE<>0 THEN CODE=TURNCHK(CODE);
     ) ENDIF;
 END(CODE);

TURNCHK(CODE)
  VAR   CD;
 BEGIN
  CD=CODE;
   CODE=CODE+2;
    IF CODE>4 THEN CODE=CODE-4;
    IF KCODE==CODE THEN CD=0;
   END(CD);

WORMMOVE()
    VAR  XT,YT;
 BEGIN
   I=LENG*2-2;
   XT=WORM[I];
   YT=WORM[I+1];
   LOCATE(XT,YT); PRINT(" ");
     REPEAT (
      WORM[I]=WORM[I-2];
      WORM[I+1]=WORM[I-1];
      I=I-2;
   ) UNTIL I<2;
    WORM[0]=X;WORM[1]=Y;
  END;

XYCHK()
    VAR CHK;
 BEGIN
    CHK=0;
    IF X==0  THEN CHK=10;
    IF X==29 THEN CHK=10;
    IF Y==0  THEN CHK=10;
    IF Y==29 THEN CHK=10;
 END(CHK);

CHRCHK()
    VAR CHK,DISP;
 BEGIN
   CHK=0;
     DISP=SCREEN(X,Y);
      CASE DISP OF (
         $7B  CHK=10;
         'Q' ( GETRON();
                SCOREPLUS(5); )
         '*'  DEATH=10;
      )
 END(CHK);

WSHINDA()
 BEGIN
      WORMLINE('*');
       BEEP(); BEEP();
        WAIT();
        WORMLINE(' ');
        NOKORI--;
      IF NOKORI==0 THEN OVER=10;
       LOCATE(PX,PY);
       PRINT(" ");
       PFLAG=0;
      DEATH=0;
     PARAMETER();
    WORMSET();
    ASTAOFF();
    ASTACLR();
   APF=1;
  END;

ASTAOFF()
 BEGIN
  FOR I=0 TO 4 (
   IF ASTA[I*3]<>0 THEN (
      LOCATE(ASTA[3*I+1],ASTA[I*3+2]);
      PRINT(" ");
     ) ENDIF;
   ) NEXT;
  END;

WORMLINE(CH)
 BEGIN
   FOR I=0 TO LENG-1 (
     LOCATE(WORM[I*2],WORM[I*2+1]);
      PRINT(CHR$(CH));
     ) NEXT;
  END;


RONDEATH(XR,YR)
   VAR  RI,I;
 BEGIN
  RI=99; I=0;
   REPEAT (
    IF RON[I]<>0 THEN (
         IF RON[I+1]==XR THEN (
          IF  RON[I+2]==YR THEN RI=I;
     ) ENDIF;
   ) ENDIF;
    I=I+3;
     ) UNTIL I>44;
   RON[RI]=0;
  END(RI);

GETRON()
   VAR  RI;
 BEGIN
   RONDEATH(X,Y);
    IF RI<>99 THEN (
         LOCATE(X,Y);
          PRINT(" ");
        RONALL--; PARAMETER();
    ) ENDIF;
   BEEP();
   END;

WORMPRINT()
 BEGIN
   I=LENG*2-2;
     REPEAT (
      LOCATE(WORM[I],WORM[I+1]);
      PRINT("O");I=I-2;
   ) UNTIL I<2;
    LOCATE(WORM[0],WORM[1]);
    PRINT("@");
 END;


POINTSET()
 BEGIN
   IF PFLAG==0 THEN (
         PFLAG=10;
           PX=WORM[LENG*2-2];
           PY=WORM[LENG*2-1];
            POINTPUT(); BEEP();
        ) ELSE (
          LOCATE(PX,PY);PRINT(" ");
          PFLAG=0;
         BOXFULL(PX,PY);
       LOCATE(33,15);
       PRINT(FORM$(NAGASA,02),":",FORM$(NAGASA,02));
         )
    ENDIF;
 END;

POINTPUT()
   VAR  PF;
 BEGIN
  LOCATE(PX,PY);
    PRINT("P");
     PF=POINTCHK();
     IF PF<>0 THEN (
        PFLAG=0; BEEP();
        LOCATE(PX,PY);
       PRINT(" ");
       LOCATE(33,15);
       PRINT(FORM$(NAGASA,02),":",FORM$(NAGASA,02));
    ) ENDIF;
  END;

POINTCHK()
     VAR   SX,SY,PF;
 BEGIN
   PF=0;
   SX=PX-WORM[0];
   SY=PY-WORM[1];
     IF SX.<.0 THEN (
          SX=CPL(SX)+1;
        ) ENDIF;
     IF SY.<.0 THEN (
          SY=CPL(SY)+1;
        ) ENDIF;
     IF  NAGASA<SX THEN PF=10;
     IF  NAGASA<SY THEN PF=10;
   LOCATE(33,15);
   PRINT(FORM$(NAGASA-SX,02),":",FORM$(NAGASA-SY,2));
  END(PF);

BOXFULL(RX,RY)
    VAR  LX,LY,SC,CN;
 BEGIN
   LX=WORM[0];
    LY=WORM[1];
     IF LX>RX THEN (
       I=RX;RX=LX;LX=I;
       ) ENDIF;
        IF LY>RY THEN (
        I=RY;RY=LY;LY=I;
       ) ENDIF;
         BACKCHK(RX,RY,LX,LY);
         FOR I=LY TO RY (
         LOCATE(LX,I);
         PRINT(STR$($7B,RX-LX+1));
       ) NEXT;
         IF TKAZU<>0 THEN (
          TDEATHPRT();
           SC=0; CN=10;
            FOR I=0 TO TKAZU-1 (
             SC=SC+CN; CN=CN*2;
           ) NEXT;
       ) ENDIF;
         WAIT(); SCOREPLUS(SC);
         FOR I=LY TO RY (
         FOR J=LX TO RX (
        LOCATE(J,I);
        PRINT(CHR$(VRAM[J][I]));
     ) NEXT;
   ) NEXT;
 END;

BACKCHK(BRX,BRY,BLX,BLY)
    VAR   CH;
 BEGIN
   TKAZU=0;
    FOR I=BLY TO BRY (
     FOR J=BLX TO BRX (
       CH=SCREEN(J,I);
       CASE CH OF (
          'Q' (
                RONALL--;
                 PARAMETER();
                RONDEATH(J,I);
              TBSET(J,I,CH);
         ) )
      ) NEXT;
    ) NEXT;

    END;

TBSET(HX,HY,CH)
 BEGIN
   BACK[TKAZU*3]=CH;
   BACK[TKAZU*3+1]=HX;
   BACK[TKAZU*3+2]=HY;
   TKAZU++;
   END;


TDEATHPRT()
   VAR RI,XC,YC;
 BEGIN
    FOR I=0 TO TKAZU-1 (
     XC=BACK[I*3+1];
     YC=BACK[I*3+2];
      CASE BACK[I*3] OF (
        'Q' ( RI=RONDEATH(XC,YC);
           )
        )
       LOCATE(XC,YC);PRINT("*");
      BEEP();
     ) NEXT;
   END;

//    ENEMY MAIN

RONMAIN()
 BEGIN
  I=0;
   REPEAT (
     IF RON[I]<>0 THEN RONMOVE();
    I=I+3;
  )  UNTIL I>43;
   END;

RONMOVE()
    VAR   RNX,RNY,RN;
 BEGIN
  RNX=RON[I+1];
  RNY=RON[I+2];
   LOCATE(RNX,RNY);
   PRINT(" ");
    IF RON[I]<>1 THEN (
      RN=RNIGERU(RNX,RNY);
    ) ELSE  ( RN=RND(4);
   ) ENDIF;
    CASE RN OF (
       0  RNY++;
       1  RNX--;
       2  RNX++;
       3  RNY--;
  )
     IF SCREEN(RNX,RNY)==$20 THEN (
            RON[I+1]=RNX;
            RON[I+2]=RNY;
      ) ENDIF;
       LOCATE(RON[I+1],RON[I+2]);
     PRINT("Q");
 END;

RNIGERU(RNX,RNY)
   VAR   RDX,RDY,RN,CH;
 BEGIN
  RDX=RNX-WORM[0];
  RDY=RNY-WORM[1];

   IF RDX==0 THEN (
       IF RNX<14 THEN RN=2;
         ELSE RN=1;
     ) ENDIF;
   IF RDX.<.0 THEN RN=1;
   IF RDX.>.0 THEN RN=2;
     CH=RCHK(RNX,RNY,RN);
      IF CH<>$20 THEN (
       IF RDY==0 THEN (
           IF RNY<11 THEN RN=0;
               ELSE RN=3;
         ) ENDIF;
       IF RDY.<.0 THEN RN=3;
       IF RDY.>.0 THEN RN=0;
   ) ENDIF;
  END(RN);

RCHK(RNX,RNY,RN)
  VAR   CH;
 BEGIN
   CASE RN OF (
       0  RNY++;
       1  RNX--;
       2  RNX++;
       3  RNY--;
     )
     CH=SCREEN(RNX,RNY);
   END(CH);

ASTAMAIN()
 BEGIN
   FOR I=0 TO 4 (
      IF ASTA[I*3]<>0 ASTAMOVE();
          ELSE ASTADASU();
    ) NEXT;
   END;

ASTADASU()
 BEGIN
  IF APF==0 THEN (
    APF=100-ROUND*10;
     IF APF<5 THEN APF=5;
     ASTA[I*3]=RND(02)+1;
     REPEAT (
      ASTA[I*3+1]=RND(28)+1;
      ASTA[I*3+2]=RND(2)*22+1;
   ) UNTIL SCREEN(ASTA[I*3+1],ASTA[I*3+2])==$20;
    LOCATE(ASTA[I*3+1],ASTA[I*3+2]);
    PRINT("*"); BEEP();
  ) ENDIF;
  END;

ASTAMOVE()
   VAR  XA,YA,DX,DY,DFL,FC;
 BEGIN
  XA=ASTA[I*3+1];
  YA=ASTA[I*3+2];
   LOCATE(XA,YA);
   PRINT(" ");
   CASE ASTA[I*3] OF (
       01  DX=-1, DY=1;
       02  DX=1 , DY=1;
       03  DX=1 , DY=-1;
       04  DX=-1, DY=-1;
     )
     DFL=0;
      FC=ASTACHK(XA+DX,YA);
       IF FC<>0 THEN (
         DX=CPL(DX)+1; DFL=10;
       ) ENDIF;
       FC=ASTACHK(XA+DX,YA+DY);
       IF  FC<>0 THEN (
            DY=CPL(DY)+1; DFL=10;
        ) ENDIF;
       IF DFL<>0 THEN (
           ASTA[I*3]=DIRSET(DX,DY);
        ) ELSE (
        ASTA[I*3+1]=ASTA[I*3+1]+DX;
        ASTA[I*3+2]=ASTA[I*3+2]+DY;
      ) ENDIF;
    LOCATE(ASTA[I*3+1],ASTA[I*3+2]);
    PRINT("*");
   END;

ASTACHK(ASX,ASY)
   VAR  AW;
 BEGIN
  AW=SCREEN(ASX,ASY);
    CASE AW OF (
     'O'  DEATH=10, AW=0;
     '@'  DEATH=10, AW=0;
     $7B  AW=10;
   OTHERS AW=00;
     )
  END(AW);

DIRSET(DX,DY)
  VAR  DIR;
BEGIN
   CASE DX*3+DY OF (
       -2  DIR=1;
        4  DIR=2;
        2  DIR=3;
       -4  DIR=4;
     )
  END(DIR);

ROUNDCLEAR()
    VAR  K;
 BEGIN
   LOCATE(05,12);
    PRINT("**  ROUND CLEAR!! **");
    BEEP();
    ROUND++;LENG++;NAGASA++;
     IF LENG==16 THEN LENG=15;
     IF NAGASA==16 THEN NAGASA=15;
     LOCATE(07,14);
     PRINT("PUSH RETURN KEY!");
      REPEAT (
       K=INKEY(2);
      ) UNTIL K==$0D;
     VRAMCLR();
     GAMEN();
    MENSHOKI();
    PARAMETER();
   WORMPRINT();
   KCODE=1;
  END;

GAMEOVER()
   VAR   K;
 BEGIN
   LOCATE(08,12);
    PRINT("** GAME OVER **");
    LOCATE(08,14);
     PRINT("TRY AGAIN(Y/N)?");
     REPEAT (
      K=INKEY(2);
      CASE K OF (
       'Y'  K=1;
       'N'  K=2;
     OTHERS K=0;
     )
      ) UNTIL K<>0;
   END(K);

MENSHOKI()
 BEGIN
    APF=1;
    PFLAG=0;
    KCODE=1;
     WORMSET();
     RONSET();
     ASTACLR();
  END;

WORMSET()
 BEGIN
     I=0;
     REPEAT (
       WORM[I]=15;
        WORM[I+1]=15;
       I=I+2;
   ) UNTIL I>LENG*2-2;
  END;

ASTACLR()
 BEGIN
   FOR I=0 TO 15  (
     ASTA[I]=0;
   ) NEXT;
 END;

RONSET()
    VAR   TC,NIGE;
 BEGIN
    NIGE=ROUND MOD 10;
    FOR I=0 TO 09 (
      IF NIGE<>0 THEN (
      RON[I*3]=2; NIGE--;
      ) ELSE (
        RON[I*3]=1;
       ) ENDIF;
          REPEAT (
          X=RND(29)+1;
          Y=RND(22)+1;
         TC=SCREEN(X,Y);
       ) UNTIL TC==$20;
        RON[I*3+1]=X;
        RON[I*3+2]=Y;
       LOCATE(X,Y);PRINT("Q");
     ) NEXT;
   RONALL=10;
 END;

SHOKI()
 BEGIN
    SCORE=0;
    ROUND=1;
    NOKORI=3;
    NAGASA=5;
     LENG=4;
     DEATH=0;
     OVER=0;
  VRAMCLR();
 END;

VRAMCLR()
 BEGIN
   FOR I=0 TO 24 (
     FOR J=0 TO 29 (
       VRAM[J][I]=$20;
     ) NEXT;
   ) NEXT;
 END;

GAMEN()
  BEGIN
   PRINT(CHR$($0C));
     PRINT(STR$($7B,30));
     LOCATE(0,1);
      FOR I=1 TO 23 (
       PRINT(CHR$($7B),SPC$(28),CHR$($7B),"\N");
       VRAM[0][I]=$7B;
       VRAM[29][I]=$7B;
       ) NEXT;
     PRINT(STR$($7B,30));
    STAGEPRINT();
   END;

PARAMETER()
 BEGIN
     LOCATE(30,1);
     PRINT("*>>>>>>>>*");
      LOCATE(30,2);
      PRINT("  WORM");
        LOCATE(30,3);
        PRINT("     kun");
         LOCATE(30,4);
         PRINT("*<<<<<<<<*");
         SCOREPRINT();
        LOCATE(31,11);
       PRINT("WORM  RON");
     LOCATE(32,12);
    PRINT("@:",NOKORI," Q:",FORM$(RONALL,2));
    LOCATE(32,14);
    PRINT("AREA");
    LOCATE(33,15);
   PRINT(FORM$(NAGASA,02),":",FORM$(NAGASA,02));
   LOCATE(31,17);
   PRINT("ROUND");
   LOCATE(33,18);
  PRINT(FORM$(ROUND,02));
  LOCATE(30,23);
  PRINT("FOR SLANG");
 END;

SCOREPLUS(SC)
 BEGIN
  SCORE=SCORE+SC;
   IF SCORE>HISC THEN HISC=SCORE;
   SCOREPRINT();
  END;

SCOREPRINT()
 BEGIN
   LOCATE(31,6);
    PRINT("HI-SCORE");
    LOCATE(33,7);
    PRINT(%(HISC));
      LOCATE(31,8);
      PRINT("SCORE");
      LOCATE(33,9);
     PRINT(%(SCORE));
 END;

STAGEPRINT()
   VAR  SA;
 BEGIN
   SA=ROUND MOD 5;
    CASE SA OF (
         1    STAGE1();
         2    STAGE2();
         3    STAGE3();
         4    STAGE4();
         0    STAGE0();
       )
  END;

STAGE1()
 BEGIN
     BLOCKPRINT(5,5,6,0,2);
     BLOCKPRINT(23,5,6,0,2);
     BLOCKPRINT(10,11,4,2,0);
  END;

STAGE2()
 BEGIN
     BLOCKPRINT(7,5,6,0,2);
     BLOCKPRINT(21,5,6,0,2);
     BLOCKPRINT(5,11,9,2,0);
  END;

STAGE3()
 BEGIN
     BLOCKPRINT(6,5,6,0,2);
     BLOCKPRINT(22,5,6,0,2);
     BLOCKPRINT(14,1,3,0,2);
     BLOCKPRINT(14,17,3,0,2);
  END;

STAGE4()
 BEGIN
     BLOCKPRINT(7,5,6,0,2);
     BLOCKPRINT(21,5,6,0,2);
     BLOCKPRINT(5,19,9,2,0);
  END;

STAGE0()
 BEGIN
     BLOCKPRINT(5,5,9,2,0);
     BLOCKPRINT(10,1,6,0,2);
     BLOCKPRINT(5,19,9,2,0);
  END;

BLOCKPRINT(X,Y,N,DX,DY)
    VAR I;
 BEGIN
   FOR I=0 TO N (
      BLOCKPUT(X,Y);
       X=X+DX; Y=Y+DY;
   ) NEXT;
END;

BLOCKPUT(XB,YB)
   VAR  XS;
 BEGIN
    LOCATE(XB,YB);
     PRINT(STR$($7B,2),"\D\L\L",STR$($7B,2));
      FOR I=0 TO 1 (
       XS=XB;
      FOR J=0 TO 1 (
         VRAM[XB][YB]=$7B;
        XB++;
      ) NEXT;
     XB=XS;
     YB++;
    ) NEXT;
 END;

WAIT()
    VAR  MATU;
 BEGIN
   MATU=2800-(200*(ROUND MOD 10)+1);
    FOR I=0 TO MATU (
     ) NEXT;
 END;