H*PARMS DFTACTGRP(*NO) BNDDIR(QC2LE)
     h*=====================================================================
     h* PROGRAMA...: JCKR
     h* DESCRIPCION: Ordenar números.
     h* AUTOR......: Diego M. ACEVEDO
     h* FECHA......: 01/11/2004
     h*=====================================================================
     fJckD      cf   e             WorkStn InfDs(Status)
     d*----------------------------------------------------------
     d* Prototipo C++ RAND
     d*----------------------------------------------------------
     d rand            pr            10i 0 ExtProc('rand')
     f*----------------------------------------------------------
     d* ARRAYS
     d*-------------------------------------------------------
     d Posic           Ds                  Inz
     d  Board                         1a   Dim(9) Overlay(Posic)
     d   FLD001                       1a   Overlay(Posic)
     d   FLD002                       1a   Overlay(Posic:2)
     d   FLD003                       1a   Overlay(Posic:3)
     d   FLD004                       1a   Overlay(Posic:4)
     d   FLD005                       1a   Overlay(Posic:5)
     d   FLD006                       1a   Overlay(Posic:6)
     d   FLD007                       1a   Overlay(Posic:7)
     d   FLD008                       1a   Overlay(Posic:8)
     d   FLD009                       1a   Overlay(Posic:9)
     d*-----------------------------------------------------
     d $Pos            s              4s 0 Dim(9) CtData PerRcd(1)
     d $Idx            s              1s 0 Dim(9) Alt($Pos)
     d*-----------------------------------------------------
     d* Display File Feedback Data Structure               .
     d*-----------------------------------------------------
     d Status          Ds
     d  W0Aib                         1a   Overlay(Status:369)
     d  W0crs                         5i 0 Overlay(Status:370)
     d*-------------------------------------------------------
     d                 Ds                  Inz
     d PosA                    1      4s 0 Inz
     d  ALin                          2s 0 Overlay(PosA)
     d  ACol                          2s 0 Overlay(PosA:3)
     d*-------------------------------------------------------
     d $$$             s             10i 0 Inz
     d Res             s             10i 0 Inz
     d X               s              5i 0 Inz
     d Z               s                   Like(X) Inz
     d S               s                   Like(X) Inz
     d Valor           s                   Like(FLD001) Inz
     d Exit            s              1n   Inz(*Off)
     d F01             c                   Const(X'31')
     d*-------------------------------------------------------
     c*
     c*=======================================================
     c*
     c*                 M A I N   P R O G R A M
     c*
     c* =====================================================
     c*
     c                   DoU       *In03                                     
    <-------------+
     c*                                                                      
                  |
     c* Inicializar pantalla.                                                
                  |
     c                   Clear                   Board                       
                  |
     c                   Clear                   X                           
                  |
     c                   Eval      Exit = *Off                               
                  |
     c                   SetOff                                         80   
                  |
     c*                                                                      
                  |
     c                   DoU       Exit                                      
    <------------+|
     c                   Eval      $$$ = rand                                
                 ||
     c                   Eval      Res = %Rem($$$:10)                        
                 ||
     c*                                                                      
                 ||
     c                   If        Res >= 1 and Res <= 9                     
    <-----------+||
     c                   If        X = 8                                     
    <----------+|||
     c                   Eval      Exit = *On                                
               ||||
     c                   Else                                                
    }----------||||
     c*                                                                      
               ||||
     c                   If        Board(Res) = *Blank                       
    <---------+||||
     c                   Eval      X = X+1                                   
              |||||
     c                   Eval      Board(Res) = %char(X)                     
              |||||
     c                   EndIf                                               
    >---------+||||
     c                   EndIf                                               
    >----------+|||
     c                   EndIf                                               
    >-----------+||
     c                   EndDo                                               
    >------------+|
     c*                                                                      
                  |
     c* Muestra pantalla.                                                    
                  |
     c                   DoU       *In03 or *In05                            
    <------------+|
     c*                                                                      
                 ||
     c                   Write     Rec1                                      
                 ||
     c                   Read      JckD                                      
                 ||
     c*                                                                      
                 ||
     c                   ExSr      $Move                                     
                 ||
     c                   EndDo                                               
    >------------+|
     c                   EndDo                                               
    >-------------+
     c*
     c                   Eval      *InLR = *On
     c*
     c* =====================================================
     c     $Move         BegSr
     c*
     c                   Clear                   Valor
     c*
     c                   If        W0Aib = F01                               
    <-------------+
     c*                                                                      
                  |
     c* Captura valor de casilla.                                            
                  |
     c                   Eval      Z = 1                                     
                  |
     c     W0crs         Div       256           ALin                        
                  |
     c                   Mvr                     Acol                        
                  |
     c*                                                                      
                  |
     c     PosA          LookUp    $Pos(Z)                                69 
                  |
     c                   If        *In69 and Board($Idx(Z)) <> *Blank        
    <------------+|
     c                   Eval      Valor = Board($Idx(Z))                    
                 ||
     c                   EndIf                                               
    >------------+|
     c*                                                                      
                  |
     c* Desplaza hacia casilla libre.                                        
                  |
     c                   Eval      S = 1                                     
                  |
     c     *Blank        LookUp    Board(S)                               69 
                  |
     c*                                                                      
                  |
     c                   If        (S = $Idx(Z)-1 and ($Idx(Z) <> 7 and      
    <------------+|
     c                             $Idx(Z) <> 4 and $Idx(Z) <> 1))      OR   
                 ||
     c                             (S = $Idx(Z)+1 and ($Idx(Z) <> 3 and      
                 ||
     c                             $Idx(Z) <> 9 and $Idx(Z) <> 9))      OR   
                 ||
     c                             (S = $Idx(Z)-3 and ($Idx(Z) <> 1 and      
                 ||
     c                             $Idx(Z) <> 2 and $Idx(Z) <> 3))      OR   
                 ||
     c                             (S = $Idx(Z)+3 and ($Idx(Z) <> 7 and      
                 ||
     c                             $Idx(Z) <> 8 and $Idx(Z) <> 9))           
                 ||
     c*                                                                      
                 ||
     c                   Eval      Board(S) = Valor                          
                 ||
     c                   Eval      Board($Idx(Z)) = *Blank                   
                 ||
     c                   EndIf                                               
    >------------+|
     c*                                                                      
                  |
     c                   EndIf                                               
    >-------------+
     c*
     c* Comprueba si completó el cuadro.
     c* Asume que sí.
     c                   SetOn                                          80
     c*
     c                   Do        8             X                           
    <-------------+
     c                   If        Board(X) <> %Char(X)                      
    <------------+|
     c* Los elementos no se encuentran aún ordenados.
     c                   SetOff                                         80   
                 ||
     c                   Leave                                               
                 ||
     c                   EndIf                                               
    >------------+|
     c                   EndDo                                               
    >-------------+
     c*
     c                   EndSr
      * =====================================================
** $Pos/$Idx
11321
11342
11363
12324
12345
12366
13327
13348
13369