//
// CP1015D - Display File Source
//
     A* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     A* * "If it's squinky, then you know it's BrilligWare!"            * *
     A* *                                                               * *
     A* * Source available at www.brilligware.com                       * *
     A* * Brillig Enterprises (aka Chris Pando) (C)2005                 * *
     A* *                                                               * *
     A* * This work is licensed under a Creative Commons                * *
     A* * Attribution-NonCommercial-ShareAlike License:                 * *
     A* * http://creativecommons.org/licenses/by-nc-sa/2.0/legalcode    * *
     A* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     A* *                                                               * *
     A* * *                  MineSweeper 5250 v3.1415                 * * *
     A* *                                                               * *
     A* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     A                                      DSPSIZ(24 80 *DS3)
     A                                      CF01(15)
     A                                      CF02(15)
     A                                      CF03(15)
     A                                      CF04(15)
     A                                      CF05(15)
     A                                      CF06(15)
     A                                      CF07(15)
     A                                      CF08(15)
     A                                      CF09(15)
     A                                      CF10(15)
     A                                      CF11(15)
     A                                      CF12(15)
     A                                      CF13(15)
     A                                      CF14(15)
     A                                      CF15(15)
     A                                      CF16(15)
     A                                      CF17(15)
     A                                      CF18(15)
     A                                      CF19(15)
     A                                      CF20(15)
     A                                      CF21(15)
     A                                      CF22(15)
     A                                      CF23(15)
     A                                      CF24(15)
     A                                      HELP(15)
     A                                      CLEAR(15)
     A                                      ROLLDOWN(15)
     A                                      ROLLUP(15)
     A                                      VLDCMDKEY(15 'Any Valid Command Ke')
     A                                      PRINT
     A          R FMT001
     A                                      CSRLOC(ROW        COL)
     A                                  1 28'MineSweeper 5250 v3.1415'
     A            CNTMRK         5Y 0O  1 65EDTWRD('   0 ')
     A            FLD001        78A  O  2  2
     A            FLD002        78A  O  3  2
     A            FLD003        78A  O  4  2
     A            FLD004        78A  O  5  2
     A            FLD005        78A  O  6  2
     A            FLD006        78A  O  7  2
     A            FLD007        78A  O  8  2
     A            FLD008        78A  O  9  2
     A            FLD009        78A  O 10  2
     A            FLD010        78A  O 11  2
     A            FLD011        78A  O 12  2
     A            FLD012        78A  O 13  2
     A            FLD013        78A  O 14  2
     A            FLD014        78A  O 15  2
     A            FLD015        78A  O 16  2
     A            FLD016        78A  O 17  2
     A            FLD017        78A  O 18  2
     A            FLD018        78A  O 19  2
     A            FLD019        78A  O 20  2
     A            FLD020        78A  O 21  2
     A            FLD021        78A  O 22  2
     A            FLD022        78A  O 23  2
     A            COL            3S 0H
     A            ROW            3S 0H
     A                                 24  2'F1=Mark     F2=Flip     F3=Clear  -
     A                                        F4=NewGame  F5=EOJ      F12=Flip -
     A                                      Random'
//
// CP1015H - Procedure Definitions - /COPY source member
//
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *      "If it's squinky, then you know it's BrilligWare!"       * *
      * *                                                               * *
      * *            Source available at www.brilligware.com            * *
      * *         Brillig Enterprises (aka Chris Pando) (c)2007         * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *                 This work is licensed under a                 * *
      * *     Creative Commons Attribution-NonCommercial-ShareAlike     * *
      * *                           license:                            * *
      * *                                                               * *
      * *   http://creativecommons.org/licenses/by-nc-sa/3.0/legalcode  * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *    The author disclaims all warranties with regard to this    * *
      * * software, including all implied warranties of merchantability * *
      * *  and fitness. In no event shall the author be liable for any  * *
      * *   special, indirect or consequential damages or any damages   * *
      * *    whatsoever resulting from loss of use, data or profits,    * *
      * *     whether in an action of contract, negligence or other     * *
      * * tortious action, arising out of or in connection with the use * *
      * *                or performance of this software.               * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *   This software remains the property of Brillig Enterprises   * *
      * *      (aka Chris Pando) and can be used or copied only in      * *
      * *          accordance with the terms of the agreement.          * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * * *                  MineSweeper 5250 v3.1415                 * * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     d init            pr              *   ProcPtr
     d                               10u 0
     d                                1a
     d                                1a
     d eoj             pr
//
// CP1015B         Binding Language
//
STRPGMEXP  PGMLVL(*CURRENT)               /* v3.1415 */
   EXPORT     SYMBOL(INIT        )
   EXPORT     SYMBOL(EOJ         )
ENDPGMEXP
//
// CP1015R - Program Source
//
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *      "If it's squinky, then you know it's BrilligWare!"       * *
      * *                                                               * *
      * *            Source available at www.brilligware.com            * *
      * *         Brillig Enterprises (aka Chris Pando) (c)2007         * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *                 This work is licensed under a                 * *
      * *     Creative Commons Attribution-NonCommercial-ShareAlike     * *
      * *                           license:                            * *
      * *                                                               * *
      * *   http://creativecommons.org/licenses/by-nc-sa/3.0/legalcode  * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *    The author disclaims all warranties with regard to this    * *
      * * software, including all implied warranties of merchantability * *
      * *  and fitness. In no event shall the author be liable for any  * *
      * *   special, indirect or consequential damages or any damages   * *
      * *    whatsoever resulting from loss of use, data or profits,    * *
      * *     whether in an action of contract, negligence or other     * *
      * * tortious action, arising out of or in connection with the use * *
      * *                or performance of this software.               * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *   This software remains the property of Brillig Enterprises   * *
      * *      (aka Chris Pando) and can be used or copied only in      * *
      * *          accordance with the terms of the agreement.          * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *                  MineSweeper 5250 v3.1415                   * * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     h
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *  CRTRPGMOD MODULE(CPANDO/CP1015R) SRCFILE(CPANDO/SRC)             *
      *  CRTPGM    PGM(CPANDO/CP1015R) BNDSRVPGM(CPANDO/CP1015S)          *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... procedure interfaces ...                                      *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *
      * ... entry interfaces ...
      *
     d entryParms      pr                  ExtPgm('CP1015R')
     d  pmSeed                       10u 0
     d  pmUncleared                   1a
     d  pmEmpty                       1a
     d entryParms      pi
     d  pmSeed                       10u 0
     d  pmUncleared                   1a
     d  pmEmpty                       1a
      *
      * ... service procedures ...
      *
      /copy src,cp1015h
      *
      * ... pointer based procedures ...
      *
     d procProxy       pr              *   ProcPtr ExtProc(procProxy@)
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... standalone variables ...                                      *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     d procProxy@      s               *   ProcPtr
     d seed            s                   Like(pmSeed) Inz(0)
     d uncleared       s              1a   Inz(x'60')                           '-'
     d empty           s              1a   Inz(x'40')                           ' '
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * * *                        Mainline                           * * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      /free
       *InLR = *On;

       procProxy@ = init(seed : uncleared : empty );
       DoU ( procProxy@ = *NULL );
          procProxy@ = procProxy();
       EndDo;

       eoj();
       Return;

       BegSR *INZSR;
          //
          // seed for random number generator
          //
          If ( %PARMS >= 1 );
             seed = pmSeed;
          EndIf;
          //
          // character representing uncleared tile
          //
          If ( %PARMS >= 2 );
             uncleared = pmUncleared;
          EndIf;
          //
          // character representing tile with zero neighbors
          //
          If ( %PARMS = 3 );
             empty = pmEmpty;
          EndIf;
       EndSR;
      /end-free
//
// CP1015S - Service Program Source
//
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *      "If it's squinky, then you know it's BrilligWare!"       * *
      * *                                                               * *
      * *            Source available at www.brilligware.com            * *
      * *         Brillig Enterprises (aka Chris Pando) (c)2007         * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *                 This work is licensed under a                 * *
      * *     Creative Commons Attribution-NonCommercial-ShareAlike     * *
      * *                           license:                            * *
      * *                                                               * *
      * *   http://creativecommons.org/licenses/by-nc-sa/3.0/legalcode  * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *    The author disclaims all warranties with regard to this    * *
      * * software, including all implied warranties of merchantability * *
      * *  and fitness. In no event shall the author be liable for any  * *
      * *   special, indirect or consequential damages or any damages   * *
      * *    whatsoever resulting from loss of use, data or profits,    * *
      * *     whether in an action of contract, negligence or other     * *
      * * tortious action, arising out of or in connection with the use * *
      * *                or performance of this software.               * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * *   This software remains the property of Brillig Enterprises   * *
      * *      (aka Chris Pando) and can be used or copied only in      * *
      * *          accordance with the terms of the agreement.          * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * * *                  MineSweeper 5250 v3.1415                 * * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     h nomain bndDir('QC2LE')
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * CRTRPGMOD MODULE(CPANDO/CP1015S) SRC(CPANDO/SRC)                  *
      * CRTSRVPGM SRVPGM(CPANDO/CP1015S) MODULE(CPANDO/CP1015S)           *
      *           SRCFILE(CPANDO/SRC)    SRCMBR(CP1015B)                  *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... files ...                                                     *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     fcp1015d   cf   e             workstn InfDS(dspfFdbkDS) UsrOpn
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... procedure interfaces ...                                      *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *
      * ... public procedures ...
      *
      /copy src,cp1015h
      *
      * ... STATE procedures ...
      *
     d p001            pr              *   ProcPtr                              NEWGAME
     d p002            pr              *   ProcPtr                              PLAYGAME
     d p003            pr              *   ProcPtr                              MARK
     d p004            pr              *   ProcPtr                              MARK II
     d p005            pr              *   ProcPtr                              FLIP
     d p006            pr              *   ProcPtr                              LOST
     d p007            pr              *   ProcPtr                              CLEAR
     d p008            pr              *   ProcPtr                              WON
     d p009            pr              *   ProcPtr                              FLIPRANDOM
     d p010            pr              *   ProcPtr                              FLIPCHEAT
      *
      * ... private procedures ...
      *
     d clearAll        pr             1n
     d                                5i 0 Value
     d                                5i 0 Value
     d count_@arr      pr
     d count_cell      pr
     d                                5i 0 Value
     d                                5i 0 Value
     d cursorValid     pr             1n
     d                                5i 0 Value
     d                                5i 0 Value
     d cvtXY           pr             5i 0
     d                                5i 0 Value
     d                                5i 0 Value
     d cvtInt          pr
     d                                5i 0 Value
     d                                3i 0
     d                                3i 0
     d cvtToHex        pr             8a
     d                               10u 0 Value
     d getRandInt      pr             5i 0
     d                               10u 0
     d load_@arr       pr
     d screenIO        pr
     d setField        pr             1n
     d                                5i 0 Value
     d                                5i 0 Value
      *
      * ... services (external) ...
      *
     d memset          pr                  ExtProc('memset')                    from the C run-time
     d                                 *   Value                                library
     d                               10i 0 Value
     d                               10i 0 Value
     d random          pr                  ExtProc('CEERAN0')
     d                               10u 0
     d                                8f
     d                               12    Options(*Omit)
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... data structures ...                                           *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *
      * ... array of procedure pointers ...
      *
     d                 ds
     d                                 *   ProcPtr Inz(%PAddr(p001))            NEW
     d                                 *   ProcPtr Inz(%PAddr(p002))            PLAY
     d                                 *   ProcPtr Inz(%PAddr(p003))            MARK
     d                                 *   ProcPtr Inz(%PAddr(p004))            MARK II
     d                                 *   ProcPtr Inz(%PAddr(p005))            FLIP
     d                                 *   ProcPtr Inz(%PAddr(p006))            LOST
     d                                 *   ProcPtr Inz(%PAddr(p007))            CLEAR
     d                                 *   ProcPtr Inz(%PAddr(p008))            WON
     d                                 *   ProcPtr Inz(%PAddr(p009))            FLIPRANDOM
     d                                 *   ProcPtr Inz(%PAddr(p010))            FLIPCHEAT
     d @procProxy@             1    160*   ProcPtr Dim(10)
      *
      * ... WORKSTN file information data structure ...
      *
     D dspfFdbkDS      ds
     D  dspfAID              369    369
     D  dspfX                370    370i 0
     D  dspfY                371    371i 0
      *
      * ... display, broken into 22 fields ...
      *
     D                 ds
     D  FLD001
     D  FLD002
     D  FLD003
     D  FLD004
     D  FLD005
     D  FLD006
     D  FLD007
     D  FLD008
     D  FLD009
     D  FLD010
     D  FLD011
     D  FLD012
     D  FLD013
     D  FLD014
     D  FLD015
     D  FLD016
     D  FLD017
     D  FLD018
     D  FLD019
     D  FLD020
     D  FLD021
     D  FLD022
     d  @fld                   1   1716a   Dim(1716)
     d  countMarked                   5s 0
     d  CNTMRK                        5s 0 Overlay(countMarked)
     d  uncleared                     1a
     d  unclearedN                    3i 0 Overlay(uncleared)
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... standalone variables ...                                      *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     d @arr            s              3u 0 Dim(1716)
     d seed            s             10u 0 Inz(0)
     d svSeed          s                   Like(seed)
     d arrSize         s              5i 0
     d hexValues       s              1a   CtData PerRcd(16) Dim(16)
     d hex             s              8a
      /EJECT
      *
      *    ... state variables ...
      *
     d countFound      s              5i 0
     d countMissd      s              5i 0
     d kaBoom          s              1n
     d flipFirst       s              1n   Inz(*Off)
     d empty           s              1a
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... constants ...                                                 *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *
      * ... states ...
      *
     d NEWGAME         c                   1
     d PLAYGAME        c                   2
     d MARK            c                   3
     d MARKII          c                   4
     d FLIP            c                   5
     d LOST            c                   6
     d CLEAR           c                   7
     d WON             c                   8
     d FLIPRANDOM      c                   9
     d FLIPCHEAT       c                   10
      *
      * ... function keys ...
      *
     d F01             c                   x'31'                                MARK
     d F02             c                   x'32'                                FLIP
     d F03             c                   x'33'                                CLEAR
     d F04             c                   x'34'                                NEWGAME
     d F05             c                   x'35'                                eoj
     d F06             c                   x'36'                                MARK II
     d F10             c                   x'3A'                                replay
     d F11             c                   x'3B'                                replay
     d F12             c                   x'3C'                                FLIPRANDOM
     d F13             c                   x'B1'                                FLIPCHEAT
     d F23             c                   x'BB'                                display seed/PLAYGAME
      *
      * ... miscellaneous constants ...
      *
     d MINECOUNT       c                   354
     d XSIZE           c                    22
     d YSIZE           c                    78
     d XULCORNER       c                     2
     d YULCORNER       c                     2
     d XLRCORNER       c                    23
     d YLRCORNER       c                    79
     d XMIDFIELD       c                    12
     d YMIDFIELD       c                    40
     d STAR            c                    '*'
     d BIGX            c                    'X'
     d MINE            c                    9
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                                                               * *
      * * *                       Procedures                          * * *
      * *                                                               * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                       Service Procedures                      * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... init ...                                                      *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p init            b                   Export
     d                 pi              *   ProcPtr
     D pmSeed                        10u 0
     D pmUncleared                    1a
     D pmEmpty                        1a
      /free

       Open cp1015d;
       arrSize = XSIZE * YSIZE;

       seed      = pmSeed;
       uncleared = pmUncleared;
       empty     = pmEmpty;

       Return @procProxy@(NEWGAME);

      /end-free
     p init            e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... eoj ...                                                       *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p eoj             b                   Export
     d                 pi
      /free
       Close cp1015d;
      /end-free
     p eoj             e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                       State Procedures                        * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... NEWGAME ...                                                   *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p001            b
     d                 pi              *   ProcPtr
      /free
       If (seed = 0);
          getRandInt(seed);            // 0 isn't repeatable
       EndIf;
       svSeed = seed;                  // save for replay

       If ( Not flipFirst );
          ROW = XMIDFIELD;
          COL = YMIDFIELD;
       EndIf;
       kaBoom      = *Off;              // global state variable
       countFound  = 0;                 // global state variable
       countMissd  = 0;                 // global state variable
       countMarked = 0;                 // global state variable
       load_@arr();
       count_@arr();
       memset( %Addr(@fld)
             : unclearedN
             : %Size(@fld:*ALL)
             );

       If ( flipFirst );
          flipFirst = *Off;
          Return @procProxy@(FLIP    );
       Else;
          Return @procProxy@(PLAYGAME);
       EndIf;
      /end-free
     p p001            e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... PLAYGAME ...                                                  *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p002            b
     d                 pi              *   ProcPtr
      /free
       screenIO();

       Select;
       When ( dspfAID = F01 );
          Return @procProxy@(MARK);
       When ( dspfAID = F02 );
          Return @procProxy@(FLIP);
       When ( dspfAID = F03 );
          Return @procProxy@(CLEAR);
       When ( dspfAID = F04 );
          Return @procProxy@(NEWGAME);
       When ( dspfAID = F05 );
          Return *NULL;
       When ( dspfAID = F06 );
          Return @procProxy@(MARKII);
       When ( dspfAID = F10 );             // replay
          seed = svSeed;
          flipFirst = *On;
          Return @procProxy@(NEWGAME);
       When ( dspfAID = F11 );             // replay
          seed = svSeed;
          Return @procProxy@(NEWGAME);
       When ( dspfAID = F12 );
          Return @procProxy@(FLIPRANDOM);
       When ( dspfAID = F13 );
          Return @procProxy@(FLIPCHEAT);
       When ( dspfAID = F23 );             // display seed
          hex = cvtToHex(svSeed);
          Dsply hex;
          Return @procProxy@(PLAYGAME);
       Other;
          Return @procProxy@(PLAYGAME);
       EndSl;

      /end-free
     p p002            e
      /EJECT
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... MARK ...                                                      *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p003            b
     d                 pi              *   ProcPtr
      /free
       If ( cursorValid(dspfX:dspfY) );

          Select;
          When ( @fld(cvtXY(dspfX:dspfY)) = uncleared);
             @fld(cvtXY(dspfX:dspfY)) = STAR;
             If ( @arr(cvtXY(dspfX:dspfY)) = MINE );
                countFound = countFound + 1;
             Else;
                countMissd = countMissd + 1;
             EndIf;
             countMarked = countMarked + 1;

          When ( @fld(cvtXY(dspfX:dspfY)) = STAR);
             @fld(cvtXY(dspfX:dspfY)) = uncleared;
             If ( @arr(cvtXY(dspfX:dspfY)) = MINE );
                countFound = countFound - 1;
             Else;
                countMissd = countMissd - 1;
             EndIf;
             countMarked = countMarked - 1;

          Other;

          EndSl;
       EndIf;

       If ( countFound = MINECOUNT And countMissd = 0 );
          Return @procProxy@(WON);
       Else;
          Return @procProxy@(PLAYGAME);
       EndIf;
      /end-free
     p p003            e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... MARK (II) ...                                                 *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p004            b
     d                 pi              *   ProcPtr
      /free
       If ( cursorValid(dspfX:dspfY) );

          Select;
          When ( @fld(cvtXY(dspfX:dspfY)) = uncleared);
             @fld(cvtXY(dspfX:dspfY)) = BIGX;

          When ( @fld(cvtXY(dspfX:dspfY)) = BIGX);
             @fld(cvtXY(dspfX:dspfY)) = uncleared;

          Other;
          EndSl;
       EndIf;

       Return @procProxy@(PLAYGAME);
      /end-free
     p p004            e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... FLIP ...                                                      *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p005            b
     d                 pi              *   ProcPtr

      /free
       If ( cursorValid(dspfX:dspfY)  And
            @fld(cvtXY(dspfX:dspfY)) = uncleared);
          kaBoom = setField(dspfX:dspfY);
       EndIf;

       If ( Not kaBoom );
          Return @procProxy@(PLAYGAME);
       Else;
          Return @procProxy@(LOST);
       EndIf;
      /end-free
     p p005            e
      /EJECT
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... LOST ...                                                      *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p006            b
     d                 pi              *   ProcPtr
      /free
       ROW = XULCORNER;
       COL = YULCORNER;

       screenIO();

       Select;
       When ( dspfAID = F04 );
          Return @procProxy@(NEWGAME);
       When ( dspfAID = F05 );
          Return *NULL;
       When ( dspfAID = F10 );             // replay
          seed = svSeed;
          flipFirst = *On;
          Return @procProxy@(NEWGAME);
       When ( dspfAID = F11 );             // replay
          seed = svSeed;
          Return @procProxy@(NEWGAME);
       When ( dspfAID = F23 );             // display seed
          hex = cvtToHex(svSeed);
          Dsply hex;
          Return @procProxy@(LOST);
       Other;
          Return @procProxy@(LOST);
       EndSl;

      /end-free
     p p006            e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... CLEAR (flip all adjacent to current) ...                      *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p007            b
     d                 pi              *   ProcPtr

      /free
       If ( cursorValid(dspfX:dspfY)              And
            @fld(cvtXY(dspfX:dspfY)) <> uncleared And
            @fld(cvtXY(dspfX:dspfY)) <> STAR );
          kaBoom = clearAll(dspfX:dspfY);
       EndIf;

       If ( Not kaBoom );
          Return @procProxy@(PLAYGAME);
       Else;
          Return @procProxy@(LOST);
       EndIf;
      /end-free
     p p007            e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... WON ...                                                       *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p008            b
     d                 pi              *   ProcPtr
      /free
       ROW = XLRCORNER;
       COL = YLRCORNER;

       screenIO();

       Select;
       When ( dspfAID = F04 );
          Return @procProxy@(NEWGAME);
       When ( dspfAID = F05 );
          Return *NULL;
       When ( dspfAID = F10 );             // replay
          seed = svSeed;
          flipFirst = *On;
          Return @procProxy@(NEWGAME);
       When ( dspfAID = F11 );             // replay
          seed = svSeed;
          Return @procProxy@(NEWGAME);
       When ( dspfAID = F23 );             // display seed
          hex = cvtToHex(svSeed);
          Dsply hex;
          Return @procProxy@(WON);
       Other;
          Return @procProxy@(WON);
       EndSl;


      /end-free
     p p008            e
      /EJECT
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... FLIPRANDOM (flip a random square)                             *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p009            b
     d                 pi              *   ProcPtr
     d integer         s              5i 0
      /free
       seed = 0;                       // reset
       DoU (@fld(integer) = uncleared);
          integer = getRandInt(seed);
       EndDo;

       cvtInt( integer : dspfX : dspfY );
       ROW   = dspfX + 1;
       COL   = dspfY + 1;

       kaBoom = setField(dspfX:dspfY);

       If ( Not kaBoom );
          Return @procProxy@(PLAYGAME);
       Else;
          Return @procProxy@(LOST);
       EndIf;
      /end-free
     p p009            e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... FLIPCHEAT  (flip a fifty random squares                       *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p p010            b
     d                 pi              *   ProcPtr
     d integer         s              5i 0
     d $I              s              5i 0
      /free
       seed = 0;                       // reset


       For $I = 1 to 50;

          integer = getRandInt(seed);
          cvtInt( integer : dspfX : dspfY );
          If ( setField(dspfX:dspfY) );
             kaBoom = *On;
          EndIf;

       EndFor;

       If ( Not kaBoom );
          Return @procProxy@(PLAYGAME);
       Else;
          Return @procProxy@(LOST);
       EndIf;

      /end-free
     p p010            e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      * *                   Private Procedures                          * *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... for each non-occupied element, count the number of neighbors  *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p count_@arr      b
     d                 pi

     d $I1             s              5i 0
     d $J1             s              5i 0
      /free
       For $I1 = 1 to XSIZE;
          For $J1 = 1 to YSIZE;
             If ( @arr(cvtXY($I1:$J1)) <> MINE );
                count_cell($I1:$J1);
             EndIf;
          EndFor;
       EndFor;
       Return;
      /end-free
     p count_@arr      e
      /EJECT
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... count one cell ...                                            *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p count_cell      b
     d                 pi
     d $I1                            5i 0 Value
     d $J1                            5i 0 Value

     d $I2             s              5i 0
     d $J2             s              5i 0

      /free
       //
       // this is where Performance Explorer says we
       // spend our time - lots of room for optimisation
       //
       For $I2 = ($I1 -1) to ($I1 + 1);
          For $J2 = ($J1 -1) to ($J1 + 1);
             If ( cursorValid($I2:$J2) And @arr(cvtXY($I2:$J2)) = MINE );
                @arr(cvtXY($I1:$J1)) = @arr(cvtXY($I1:$J1)) + 1;
             EndIf;
          EndFor;
       EndFor;
       Return;
      /end-free
     p count_cell      e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... load array with mines ...                                     *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p load_@arr       b
     d                 pi

     d integer         s              5i 0
     d $I              s              5i 0

      /free
       memset( %Addr(@arr)
             : 0                      // x'00'
             : %Size(@arr:*ALL)
             );

       For $I = 1 to MINECOUNT;
          DoU (@arr(integer) = 0);
             integer = getRandInt(seed);
          EndDo;
          @arr(integer) = MINE;
       EndFor;

       Return;
      /end-free
     p load_@arr       e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... convert X and Y to an array index                             *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * This is so, so, so *not* optimized. The array index probably      *
      * ought to be cached in a global variable, rather than constantly   *
      * recalculated. On the other hand, Performance Explorer indicates   *
      * only 10% of the program is spent here, so it really isn't worth   *
      * the effort                                                        *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p cvtXY           b
     d                 pi             5i 0
     d $I1                            5i 0 Value
     d $J1                            5i 0 Value
      /free
       Return ( ($I1 - 1)*YSIZE + $J1 );
      /end-free
     p cvtXY           e
      /EJECT
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... convert an array index into X and Y ...                       *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p cvtInt          b
     d                 pi
     d int                            5i 0 Value
     d $I1                            3i 0
     d $J1                            3i 0
      /free
       $J1 = %Rem(int:YSIZE);
       If ($J1 = 0);
          $J1 = YSIZE;
       EndIf;
       $I1 = %Div(int - $J1:YSIZE) + 1;
       Return;
      /end-free
     p cvtInt          e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... if no neighbors, set to blank and check neighbors ...         *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * DANGER DANGER DANGER - this procedure recurses                    *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p clearAll        b
     d                 pi             1n
     d $I1                            5i 0 Value
     d $J1                            5i 0 Value

     d $I2             s              5i 0
     d $J2             s              5i 0
     d mineFound       s              1n
      /free
       For $I2 = ($I1 - 1) to ($I1 + 1);
          For $J2 = ($J1 - 1) to ($J1 + 1);
             If ( cursorValid($I2:$J2) And @fld(cvtXY($I2:$J2)) = uncleared );
                If ( setField($I2:$J2) );                                   // setField can clearAll()
                   mineFound = *On;
                EndIf;
             EndIf;
          EndFor;
       EndFor;

       Return mineFound;
      /end-free
     p clearAll        e
      /EJECT
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... set field to a numeric value ...                              *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p setField        b
     d                 pi             1n
     d $I1                            5i 0 Value
     d $J1                            5i 0 Value

     d mineFound       s              1n   Inz(*Off)
     d hold            s              3s 0
      /free
       hold = @arr(cvtXY($I1:$J1));
       Select;
       When (hold = 0);
          @fld(cvtXY($I1:$J1)) = empty;
          mineFound = clearAll($I1:$J1);      // could be a recursive call
       When (hold = 1);
          @fld(cvtXY($I1:$J1)) = '1';
       When (hold = 2);
          @fld(cvtXY($I1:$J1)) = '2';
       When (hold = 3);
          @fld(cvtXY($I1:$J1)) = '3';
       When (hold = 4);
          @fld(cvtXY($I1:$J1)) = '4';
       When (hold = 5);
          @fld(cvtXY($I1:$J1)) = '5';
       When (hold = 6);
          @fld(cvtXY($I1:$J1)) = '6';
       When (hold = 7);
          @fld(cvtXY($I1:$J1)) = '7';
       When (hold = 8);
          @fld(cvtXY($I1:$J1)) = '8';
       When (hold = 9);
          @fld(cvtXY($I1:$J1)) = '@';               // 9 is a mine, so
          mineFound = *On;                          // the jig is up
       EndSl;

       Return mineFound;
      /end-free
     p setField        e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... determine whether valid cursor position ...                   *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p cursorValid     b
     d                 pi             1n
     d $I1                            5i 0 Value
     d $J1                            5i 0 Value
      /free
       If ($I1 >= 1 And $I1 <= XSIZE And $J1 >= 1 And $J1 <= YSIZE);
          Return *On;
       Else;
          Return *Off;
       EndIf;
      /end-free
     p cursorValid     e
      /EJECT
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... Write/Read display file, and twitch cursor position values ...*
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p screenIO        b
     d                 pi
      /free
       Exfmt fmt001;

       ROW   = dspfX;                           // used with CSRLOC in
       COL   = dspfY;                           // the workstation file

       dspfX = dspfX - 1;                       // map from absolute
       dspfY = dspfY - 1;                       // to relative

       Return;
      /end-free
     p screenIO        e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... get random integer ...                                        *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p getRandInt      b
     d                 pi             5i 0
     d seed                          10u 0

     d floater         s              8f
     d fc              s             12a
      /free
       random(seed:floater:fc);
       Return (floater * arrSize + 1);    // 1 <= return value <= arrSize
      /end-free
     p getRandInt      e
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
      *                                                                   *
      * ... convert 10u 0 integer into 8a hex                             *
      *                                                                   *
      * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
     p cvtToHex        b
     d                 pi             8a
     d fromInt                       10u 0 Value

     d $I              s              5s 0
     d toHex           s              8a
      /free
       For $I = 1 to 8;
          %SubSt( toHex : 9 - $I : 1 ) = hexValues( %Rem(fromInt:16) + 1 );
          fromInt = %Div(fromInt:16);
       EndFor;
       Return toHex;
      /end-free
     p cvtToHex        e
**
0123456789ABCDEF