* Puzzle, (C) EMA 2001                                     LM:30.05.2001
INTERNAL 
  INTEGER I,J,K FORMAT 2,N,ER,II,JJ,I0,J0,STK1,STK2,LAYCUR,LAY FORMAT 3,
  %       IX(20)INIT 5 1 1 4 4 1 1 5 5 1 1 4 4 3 3 5 5 2 2 3,
  %       JX(20)INIT 1 1 4 4 1 1 4 4 1 1 3 3 1 1 3 3 1 1 2 2,
  %       WIN(4)INIT 1,NUM FORMAT 6
  REAL    SIDE,SPACE,X0(3),X1(3),X2(3),X3(3),XM(12),CNT(3),
  %       BASE(3)INIT 1 0 0,UP(3)INIT 0 1 0,
  %       PT(3,4),SCL(4)INIT 3.4953,ORIGIN(3,4)INIT -.4 .4,
  %       NORMPL(3,4)INIT 0 0 1,UPX(3,4)INIT 0 1,EYE(3,4)
  UNDEFLM LN(4),CCV(4,5),TXT(19),ELM,TRA(4),STONE(4,5)
  CHAR*35 CEMA INIT '               PUZZLE, (C) EMA 2001',STR
  LOGICAL SHUFFLE INIT TRUE
PROC 
  LOAD GUEACT 0,ER
  LET SIDE=12.
  LET SPACE=.8
  ACCEPT
LABEL PT
  SELECT 'SEL PT, YES:START GAME             '//CEMA ELM,YES,NO
  IF(KODE EQ NO)EXIT
  IF(KODE EQ YES)THEN START
  BLOCKIF(TYPP(ELM)NE 1)THEN
    BEEP
    MSGCNTL 'NO PT SELECTED '
    BRANCH PT
  ENDIF
  LOAD GIRMAT 1,ELM,I,CNT,ER
LABEL START
  LET CNT(1)=CNT(1)-(SPACE+SIDE)*3.5
  LET CNT(2)=CNT(2)+(SPACE+SIDE)*3
  LET X0(3)=CNT(3)
  LET X1(3)=CNT(3)
  LET X2(3)=CNT(3)
  LET X3(3)=CNT(3)
  LOAD GIRCUR 1,I,J,N,II,JJ,LAYCUR,ER
  IF(KODE EQ YES)LOAD GICSCR 1,1,0,PT,WIN,SCL,ORIGIN,NORMPL,UPX,EYE,ER
  LET LAY=1
  DO
    LET STR='*LAY'//CHCONV(LAY)
    LOAD GUMSEL 1,7,STR,1,1,1,1,STK1,ER
    IF(ER EQ 188)BRANCH LAY
    LET LAY=LAY+1
  WHILE(LAY LE 254)
  BEEP
  MSGCNTL 'NO EMPTY LAYER FOR NEW ELEMENTS'
  MSG 'YES:CONTINUE                       '//CEMA YES,NO
  IF(KODE EQ NO)EXIT
  LET LAY=254
LABEL LAY
  LOAD GICCLA 1,LAY,ER
  IF(KODE EQ YES)LOAD GICFIL 1,0,2,0,ER
  LET J=1
  DO
    LET I=1
    DO
      LET K=K+1
      LET X0(1)=CNT(1)+(SIDE+SPACE)*I
      LET X0(2)=CNT(2)-(SIDE+SPACE)*J
      LET X1(1)=X0(1)+SIDE
      LET X1(2)=X0(2)
      LET X2(1)=X0(1)+SIDE
      LET X2(2)=X0(2)-SIDE
      LET X3(1)=X0(1)
      LET X3(2)=X0(2)-SIDE
      LOAD GCWLN 1,X0,1,X1,1,LN(1),ER
      LOAD GCWLN 1,X0,1,X3,1,LN(2),ER
      LOAD GCWLN 1,X2,1,X1,1,LN(3),ER
      LOAD GCWLN 1,X2,1,X3,1,LN(4),ER
      LOAD GCWCCV 1,4,LN,CCV(J,I),ER
      LOAD GICCOL 1,CCV(J,I),1,ER
      IF(K LE 9)LET N=1
      IF(K GT 9)LET N=2
      LET STR=CHCONV(K)
      IF(K LE 9)LET STR(1:1)=STR(2:2)
      IF(K LE 9)LET STR(2:2)=' '
      LET X0(1)=X0(1)+SIDE/2
      LET X0(2)=X0(2)-SIDE*3/4
      LOAD GIWTXT 1,CCV(J,I),N,STR,X0,BASE,UP,'DSUS    ',
      %           5,0.,2,5,1,0,0,1,ER
      LET STONE(J,I)=CCV(J,I)
      LET I=I+1
    WHILE(I LE 5)
    LET J=J+1
  WHILE(J LE 4)
  LET CCV(4,5)=NULL
  LET X0(1)=CNT(1)+SIDE
  LET X0(2)=CNT(2)+SPACE/2-SIDE
  LET X1(1)=X0(1)+5*(SIDE+SPACE)+SPACE
  LET X1(2)=X0(2)
  LET X2(1)=X0(1)+5*(SIDE+SPACE)+SPACE
  LET X2(2)=X0(2)-4*(SIDE+SPACE)-2*SPACE
  LET X3(1)=X0(1)
  LET X3(2)=X0(2)-4*(SIDE+SPACE)-2*SPACE
  LOAD GCWLN 1,X0,1,X1,1,LN(1),ER
  LOAD GCWLN 1,X0,1,X3,1,LN(2),ER
  LOAD GCWLN 1,X2,1,X1,1,LN(3),ER
  LOAD GCWLN 1,X2,1,X3,1,LN(4),ER
  LOAD GICPIC 1,LN(1),0,ER
  LOAD GICPIC 1,LN(2),0,ER
  LOAD GICPIC 1,LN(3),0,ER
  LOAD GICPIC 1,LN(4),0,ER
******************
*  1  2  3  4  5 *
*  6  7  8  9 10 *
* 11 12 13 14 15 *
* 16 17 18 19    *j
******************
*               i
  ERASE STONE(4,5)
  LET XM(1)=1
  LET XM(5)=1
  LET XM(9)=1
  LET XM(10)=SIDE+SPACE
  LOAD GIWTRA 1,0,STR,XM,TRA(1),ER
  LET XM(10)=-XM(10)
  LOAD GIWTRA 1,0,STR,XM,TRA(2),ER
  LET XM(10)=0
  LET XM(11)=SIDE+SPACE
  LOAD GIWTRA 1,0,STR,XM,TRA(3),ER
  LET XM(11)=-XM(11)
  LOAD GIWTRA 1,0,STR,XM,TRA(4),ER
LABEL SORT
  SELECT 'SEL STONE, YES:EXIT                '//CEMA ELM,YES
  BLOCKIF(KODE EQ YES)THEN
    LET I=1
    DO
      ERASE CCV(1,I),CCV(2,I),CCV(3,I),CCV(4,I)
      LET I=I+1
    WHILE(I LE 5)
    ERASE LN(1),LN(2),LN(3),LN(4)
****LOAD GICFIL 1,0,1,0,ER
    LOAD GICCLA 1,LAYCUR,ER
****REFUSE
    EXIT
  ENDIF
  LET II=0
  LET J=1
  DO
    LET I=1
    DO
      IF(STONE(J,I)EQ ELM)LET II=I
      IF(STONE(J,I)EQ ELM)LET JJ=J
      IF(STONE(J,I)EQ NULL)LET I0=I
      IF(STONE(J,I)EQ NULL)LET J0=J
      LET I=I+1
    WHILE(I LE 5)
    LET J=J+1
  WHILE(J LE 4)
  BLOCKIF(II EQ 0)THEN
    BEEP
    MSGCNTL 'NO STONE SELECTED'
    BRANCH SORT
  ENDIF
**LET SHUFFLE=FALSE
  BLOCKIF SHUFFLE THEN
    LET SHUFFLE=FALSE
    LET NUM=0
    LET N=1
    DO
      LET II=IX(N)
      LET JJ=JX(N)
      BLOCKIF(II EQ I0)THEN
        BLOCKIF(JJ LT J0)THEN
          LET J=J0-1
          DO
            LET K=J+1
            LOAD GSEGEL 1,1,1,TRA(4),STONE(J,II),STK1,STK2,ELM,ER
            LET STONE(K,II)=STONE(J,II)
            LET J=J-1
          WHILE(J GE JJ)
        ENDIF
        BLOCKIF(JJ GT J0)THEN
          LET J=J0+1
          DO
            LOAD GSEGEL 1,1,1,TRA(3),STONE(J,II),STK1,STK2,ELM,ER
            LET K=J-1
            LET STONE(K,II)=STONE(J,II)
            LET J=J+1
          WHILE(J LE JJ)
        ENDIF
      ENDIF
      BLOCKIF(JJ EQ J0)THEN
        BLOCKIF(II LT I0)THEN
          LET I=I0-1
          DO
            LET K=I+1
            LOAD GSEGEL 1,1,1,TRA(1),STONE(JJ,I),STK1,STK2,ELM,ER
            LET STONE(JJ,K)=STONE(JJ,I)
            LET I=I-1
          WHILE(I GE II)
        ENDIF
        BLOCKIF(II GT I0)THEN
          LET I=I0+1
          DO
            LOAD GSEGEL 1,1,1,TRA(2),STONE(JJ,I),STK1,STK2,ELM,ER
            LET K=I-1
            LET STONE(JJ,K)=STONE(JJ,I)
            LET I=I+1
          WHILE(I LE II)
        ENDIF
      ENDIF
      LET STONE(JJ,II)=NULL
      LET I0=II
      LET J0=JJ
      LET N=N+1
    WHILE(N LE 20)
    MSGCNTL 'STONES SHUFFLED'
    BRANCH SORT
  ENDIF
  BLOCKIF(II NE I0)AND(JJ NE J0)THEN
    BEEP
    MSGCNTL 'CAN NOT MOVE THIS STONE'
    BRANCH SORT
  ENDIF
  BLOCKIF(II EQ I0)THEN
    BLOCKIF(JJ LT J0)THEN
      LET J=J0-1
      DO
        LET K=J+1
        LOAD GSEGEL 1,1,1,TRA(4),STONE(J,II),STK1,STK2,ELM,ER
        LET STONE(K,II)=STONE(J,II)
        LET J=J-1
      WHILE(J GE JJ)
    ENDIF
    BLOCKIF(JJ GT J0)THEN
      LET J=J0+1
      DO
        LOAD GSEGEL 1,1,1,TRA(3),STONE(J,II),STK1,STK2,ELM,ER
        LET K=J-1
        LET STONE(K,II)=STONE(J,II)
        LET J=J+1
      WHILE(J LE JJ)
    ENDIF
  ENDIF
  BLOCKIF(JJ EQ J0)THEN
    BLOCKIF(II LT I0)THEN
      LET I=I0-1
      DO
        LET K=I+1
        LOAD GSEGEL 1,1,1,TRA(1),STONE(JJ,I),STK1,STK2,ELM,ER
        LET STONE(JJ,K)=STONE(JJ,I)
        LET I=I-1
      WHILE(I GE II)
    ENDIF
    BLOCKIF(II GT I0)THEN
      LET I=I0+1
      DO
        LOAD GSEGEL 1,1,1,TRA(2),STONE(JJ,I),STK1,STK2,ELM,ER
        LET K=I-1
        LET STONE(JJ,K)=STONE(JJ,I)
        LET I=I+1
      WHILE(I LE II)
    ENDIF
  ENDIF
  LET STONE(JJ,II)=NULL
  LET II=0
  LET J=1
  DO
    LET I=1
    DO
      IF(STONE(J,I)NE CCV(J,I))LET II=1
      LET I=I+1
    WHILE(I LE 5)
    LET J=J+1
  WHILE(J LE 4)
  LET NUM=NUM+1
    LET STR='genius                     '
    IF(NUM GT 100)LET STR='brainy                     '
    IF(NUM GT 125)LET STR='bright                     '
    IF(NUM GT 150)LET STR='sharp                      '
    IF(NUM GT 175)LET STR='quick                      '
    IF(NUM GT 200)LET STR='clever                     '
    IF(NUM GT 225)LET STR='smart                      '
    IF(NUM GT 250)LET STR='slow                       '
    IF(NUM GT 270)LET STR='simple                     '
    IF(NUM GT 300)LET STR='dull                       '
    IF(NUM GT 320)LET STR='slack                      '
    IF(NUM GT 350)LET STR='soft-brained               '
    IF(NUM GT 370)LET STR='booby                      '
    IF(NUM GT 400)LET STR='simpleton                  '
    IF(NUM GT 420)LET STR='dolt                       '
    IF(NUM GT 450)LET STR='dummy                      '
    IF(NUM GT 470)LET STR='wooden                     '
    IF(NUM GT 500)LET STR='thick-skulled              '
    IF(NUM GT 520)LET STR='foolish                    '
    IF(NUM GT 550)LET STR='brainless                  '
    IF(NUM GT 570)LET STR='empty-headed               '
    IF(NUM GT 600)LET STR='cretin                     '
    IF(NUM GT 620)LET STR='idiot                      '
    IF(NUM GT 650)LET STR='imbecile                   '
    LET STR='LEVEL: '//CHUPC(STR)//'                  '
  BLOCKIF(II EQ 0)THEN
    BEEP
    MSGCNTL 'B I N G O     TOTAL MOVES:'//CHCONV(NUM)//'   '//STR
    LET SHUFFLE=TRUE
  ELSE
    MSGCNTL 'STONE MOVED          MOVE:'//CHCONV(NUM)//'   '//STR
  ENDIF
  BRANCH SORT
END