%%HP: T(3)A(R)F(,);
DIR
  PLAY
    \<< INIT
      WHILE 1
      REPEAT DRM 0 WAIT
        IF DUP 51,1 \=/
        THEN UNMARK
        END
        CASE DUP 20 <
          THEN IP 10 - 2 setm
          END DUP 25 <
          THEN IP 14 - 2 setm
          END DUP 40 \>= OVER 50 < AND
          THEN IP 40 - 3 setm
          END { 82,1 83,1 84,1 72,1 73,1 } OVER POS DUP
          THEN 1 setm DROP
          END DROP { 51,1 55,1 91,3 95,1 75,1 } SWAP POS DUP
          THEN { enter clear OFF guess gmov } SWAP GET EVAL
          END BOOP
        END
      END
    \>>
  NM 0
  GL { }
  AL { }
  LM { }
  ML { }
  INIT
    \<< FIELD PICT STO { } 'ML' STO 0 'NM' STO
          { 5 1 6 } 'LM' STO { } 'GL' STO
          "HEXATOM by Jurjen Bos\010number of atoms:" { "5" { -1 1 
} V }
          INPUT OBJ\-> PICT (-6;68) 3 PICK 1 \->GROB REPL { }
      DO RAND 5 * IP 1 + RAND 10 * IP 1 + L\->C
        IF DUP2 POS
        THEN DROP
        ELSE +
        END
      UNTIL DUP2 SIZE \<=
      END 'AL' STO DROP { # 0h # 0h } PVIEW
    \>>
  setm
    \<< 'LM' SWAP ROT PUT
      IF LM LIST\-> DROP ROT NOT AND AND
      THEN
        IF LM 1 5 PUT CHECK LM 1 1 PUT CHECK OVER XOR
        THEN 4 * 1 + 'LM' 1 ROT PUT
        ELSE DROP
        END
      END
      IF LM LIST\-> DROP SWAP NOT AND AND
      THEN
        IF LM 2 10 PUT CHECK LM 2 1 PUT CHECK OVER XOR
        THEN 9 * 1 + 'LM' 2 ROT PUT
        ELSE DROP
        END
      END PICT (104;68) LM LIST\-> DROP ROT
      IF DUP NOT
      THEN DROP " "
      END ROT
      IF DUP
      THEN 64 + CHR
      ELSE DROP " "
      END + SWAP
      IF DUP
      THEN 82 + CHR
      ELSE DROP " "
      END + 2 \->GROB REPL
    \>>
  enter
    \<<
      IF
        IF LM LIST\-> DROP AND AND
        THEN LM CHECK
        ELSE 0
        END
      THEN PICT (112;57) 'NM' INCR 1 \->GROB REPL
          PICT (82;51) PICT (104;68) (120;62) SUB REPL
        IF SCAN
        THEN "---"
        ELSE DUP MARK LIST\-> DROP SWAP 64 + CHR SWAP 82 + CHR + +
        END 2 \->GROB PICT (108;51) ROT REPL clear
      ELSE UNMARK BOOP
      END
    \>>
  guess
    \<< LM LIST\-> DROP
      IF NOT AND AND
      THEN PICT LM LIST\-> DROP2 L\->C 'GL' OVER STOT (-1;1) +
        GROB 3 3 207020 GXOR clear
      ELSE BOOP
      END
    \>>
  SCAN
    \<< LM LIST\-> DROP dirs SWAP 6
      START LIST\-> ROLLD 6 \->LIST
      NEXT ROT ROT L\->C
      WHILE AL OVER POS NOT OVER
            C\->R DUP 5 > SWAP 55 \<= AND OVER 0 > AND SWAP 70 \<= 
AND AND
      REPEAT SWAP
        CASE DUP2 2 GET + AL SWAP POS
          THEN
            DO LIST\-> ROLLD 6 \->LIST
            UNTIL DUP2 2 GET + AL SWAP POS NOT
            END
          END DUP2 6 GET + AL SWAP POS
          THEN
            DO LIST\-> ROLL 6 \->LIST
            UNTIL DUP2 6 GET + AL SWAP POS NOT
            END
          END
        END SWAP OVER 1 GET +
      END
      IF AL OVER POS
      THEN DROP2 1
      ELSE SWAP 4 GET SWAP OVER + C\->R 10 / IP SWAP 7 /
            ROT dirs SWAP POS 3 \->LIST 0
      END
    \>>
  gmov
    \<< 1 AL SIZE
      FOR I PICT AL I GET (-2;2) + GROB 5 5 E0111111E0 GOR
      NEXT PICT (87;68) # 22h # 7h BLANK REPL 0 WAIT
      DROP AL SIZE Atoms \->TAG NM "Moves" \->TAG 0 0 1 GL SIZE
      IF DUP2 \<=
      THEN
        FOR a
          IF AL GL a GET POS
          THEN 1 +
          ELSE SWAP 1 + SWAP
          END
        NEXT
      ELSE DROP2
      END Right \->TAG SWAP Wrong \->TAG "Game over\010Your score:" 
DOERR
    \>>
  clear
    \<< { 0 0 0 } 'LM' STO PICT (104;68) GROB 17 7 0 REPL
    \>>
  DRM
    \<<
      IF
        IF LM LIST\-> DROP AND AND
        THEN LM CHECK
        ELSE LM LIST\-> DROP NOT AND AND
        END
      THEN LM MARK
      END
    \>>
  CHECK
    \<< LIST\-> DROP { 0 DROP 5 10 AND 5 10 > 1 0 DROP 1 1 > 1 1 
AND 5 }
          SWAP 3 * DUP 2 - SWAP SUB LIST\-> DROP 5 ROLL == 4 PICK 2 
MOD ROT
      EVAL ROT ROT == OR
    \>>
  MARK
    \<< LIST\-> DROP
      IF DUP
      THEN dirs SWAP GET -2 /
      END ROT ROT L\->C + (-1;1) + 'ML' OVER STO+ PICT SWAP
          GROB 3 3 705070 GXOR
    \>>
  UNMARK
    \<< 1 ML SIZE
      IF DUP2 \<=
      THEN
        FOR I PICT ML I GET GROB 3 3 705070 GXOR
        NEXT { } 'ML' STO
      ELSE DROP2
      END
    \>>
  L\->C
    \<< DUP 7 * SWAP 2 MOD 2 / ROT + 10 * R\->C
    \>>
  STOT
    \<<
      IF OVER RCL OVER POS
      THEN OVER RCL DUP ROT POS DUP2 1 SWAP 1 - SUB
            ROT ROT 1 + OVER SIZE SUB + SWAP STO
      ELSE STO+
      END
    \>>
  BOOP
    \<< 335 ,07 BEEP
    \>>
  FIELD
    \<< "GROB 128 64 "
      
"0007C3C178FC7C111704000E000C7E4400884422980402211204000400640154" +
      
"008844201904020112040004C36C3192008FC320197C320F1204000444004F11" +
      
"0088442019040231124400044460419200884422980402211244000444644154" +
      
"0088C3C178F40C311783000E4408315400000000000000000000000000000000" +
      
"008F00E308F00E308F0000000000000000401014040101404010000000000000" +
      
"00401014040101404010000000000000F12028080202808020200002272A7800" +
      
"102028080202808020200006B82A04141010C700F10C700F10C7000AA82A3410" +
      
"F02028080202808020280002A849041401202808020280802028000227887800" +
      
"0140101404010140401010000000000001401014040101404010100000000000" +
      
"118F00E308F00E308F00200000020000E0401014040101404010100000040000" +
      
"004010140401014040101000008F000080202808020280802028000000040000" +
      
"C0202808020280802028000000020000A010C700F10C700F10C7000000000000" +
      
"90202808020280802028000000000000F1202808020280802028000000000000" +
      
"8040101404010140401010000000000080401014040101404010100000000000" +
      
"808F00E308F00E308F00200000C1000080401014040101404010100000220000" +
      
"00401014040101404010100000200000E0202808020280802028000000C10000" +
      
"112028080202808020280000000200000110C700F10C700F10C700002222E300" +
      
"01202808020280802028000022C18000E0202808020280802028000041008000" +
      
"01401014040101404010100080E3800001401014040101404010100041148000" +
      
"118F00E308F00E308F00200022148000E040101404010140401010002A088000" +

"00401014040101404010100008080000E0202808020280802028000004001000" +
      
"112028080202808020280000080800001110C700F10C700F10C700002A082200" +
      
"8020280802028080202800002214220040202808020280802028000022142200" +
      
"204010140401014040101000A2E32200104010140401014040101000A2002200" +
      
"108F00E308F00E308F00200063222200F140101404010140401010002222C100" +
      
"0040101404010140401010000022000040202808020280802028000000410000" +
      
"602028080202808020280000004100004010C700F10C700F10C7000000800000" +
      
"4020280802028080202800000080000040202808020280802028000000000000" +
      
"4040101404010140401010000000000040401014040101404010144000080000" +
      
"408F00E308F00E308F00244000080000E0001014040101404010144E44EC17E6" +
      
"000010140401014040101C719209882900002808020280802028044F11E98829" +
      
"0000280802028080202804418219A8290000C700F10C700F10C7044E44E11729" +
          OBJ\-> DUP 'FIELD' STO
        \>>
  dirs { (0;-10) (-7;-5) (-7;5) (0;10) (7;5) (7;-5) }
  PPAR { (-6;5) (124;68) X 0 (0;0) FUNCTION Y }
END

