home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a054 / 1.img / GETPRGS.EXE / GETS22.PRG < prev    next >
Encoding:
Text File  |  1992-03-08  |  6.0 KB  |  231 lines
  1. /***
  2. * Gets22.prg
  3. *
  4. * GETs in SECTIONs. TAB key moves to start of next section,
  5. * SH-TAB to previous section.
  6. */
  7.  
  8. #command @ <row>, <col> GET <var>                                   ;
  9.                         [<clauses,...>]                             ;
  10.                         SECTION <nSection>                          ;
  11.                         [<moreClauses,...>]                         ;
  12.          =>                                                         ;
  13.          @ <row>, <col> GET <var>                                   ;
  14.                         [<clauses>]                                 ;
  15.                         [<moreClauses>] ;                           ;
  16.          Atail(getList):cargo := DictNew()                          ;
  17.          ; DictPutPair(Atail(getList):cargo, {"SEC #", <nSection>}) ;
  18.          ; Atail(getList):reader := {|oGet| SectReader(oGet)}
  19.  
  20. #command READ SECTION                                               ;
  21.          =>                                                         ;
  22.          SectionStarts(GetSecStarts(GetList))                       ;
  23.          ; ReadModal(GetList); GetList := {}                        ;
  24.          ; SectionStarts(NIL)
  25.  
  26. #include "Inkey.ch"
  27. #include "Getexit.ch"
  28.  
  29. MEMVAR GetList
  30.  
  31. FUNCTION Gets22
  32.  
  33. LOCAL cLname, cFname, cAddr1, cAddr2, cAddr3, cTel
  34. LOCAL cCard, cCardNum
  35. LOCAL nDbls, nSgls, nSglSuites, nDblSuites, nReservation
  36. LOCAL aSecStarts
  37.  
  38.   SET SCOREBOARD OFF
  39.   cLname := Space(15)
  40.   cFname := Space(15)
  41.   cAddr1 := Space(20)
  42.   cAddr2 := Space(20)
  43.   cAddr3 := Space(20)
  44.   cTel   := Space(20)
  45.  
  46.   CLEAR SCREEN
  47.   @ 0, 0 TO 24,  79
  48.   @ 1, 2  SAY "Name" COLOR "W+/N"
  49.   @ 2, 2  SAY " Last Name [" + Space(Len(cLname)) + "]"
  50.   @ 2, 14 GET cLname SECTION 1
  51.   @ 3, 2  SAY "First Name [" + Space(Len(cFname)) + "]"
  52.   @ 3, 14 GET cFname SECTION 1
  53.   @ 4, 2  SAY "   Address [" + Space(Len(cAddr1)) + "]"
  54.   @ 4, 14 GET cAddr1 SECTION 1
  55.   @ 5, 2  SAY "           [" + Space(Len(cAddr2)) + "]"
  56.   @ 5, 14 GET cAddr2 SECTION 1
  57.   @ 6, 2  SAY "           [" + Space(Len(cAddr3)) + "]"
  58.   @ 6, 14 GET cAddr3 SECTION 1
  59.   @ 7, 2  SAY "       Tel [" + Space(Len(cTel))   + "]"
  60.   @ 7, 14 GET cTel   SECTION 1
  61.  
  62.   cCard    := Space(10)
  63.   cCardNum := Space(16)
  64.   @ 9, 2   SAY "Confirmation" COLOR "W+/N"
  65.   @ 10, 2  SAY "     Card [" + Space(Len(cCard)) + "]"
  66.   @ 10, 13 GET cCard SECTION 2
  67.   @ 11, 2  SAY "   Card # ["
  68.   @ 11, 13 GET cCardNum PICTURE "@R 9999-9999-9999-9999" SECTION 2
  69.   @ 11, Col() SAY "]"
  70.  
  71.   nDbls := 0
  72.   nSgls := 0
  73.   nSglSuites := 0
  74.   nDblSuites := 0
  75.   @ 13, 2  SAY "Rooms" COLOR "W/N+"
  76.   @ 14, 2  SAY "      Dbl. [    ]"
  77.   @ 14, 14 GET nDbls  PICTURE "9999" SECTION 3
  78.   @ 15, 2  SAY "      Sgl. [    ]"
  79.   @ 15, 14 GET nSgls  PICTURE "9999" SECTION 3
  80.   @ 16, 2  SAY "Sgl. Suite [    ]"
  81.   @ 16, 14 GET nSglSuites PICTURE "9999" SECTION 3
  82.   @ 17, 2  SAY "Dbl. Suite [    ]"
  83.   @ 17, 14 GET nDblSuites  PICTURE "9999" SECTION 3
  84.  
  85.   nReservation := 0
  86.   @ 19, 2  SAY "Reservation # [        ]"
  87.   @ 19, 17 GET nReservation PICTURE "99999999" SECTION 4
  88.  
  89.   READ SECTION
  90.  
  91. RETURN NIL
  92.  
  93.  
  94. PROCEDURE SectReader( oGet )
  95.  
  96. LOCAL nKey
  97. LOCAL nSect := DictAt(oGet:cargo, "SEC #")
  98. LOCAL nCurrentGet
  99.  
  100.   nCurrentGet := Ascan(GetList, {|o| o == oGet })
  101.   IF !(GetMovingTo() == NIL) .AND. nCurrentGet != GetMovingTo()
  102.     IF nCurrentGet > GetMovingTo()
  103.       oGet:exitState := GE_UP
  104.     ELSE
  105.       oGet:exitState := GE_DOWN
  106.     ENDIF
  107.   ELSE
  108.     GetMovingTo(NIL) 
  109.  
  110.     // Read the GET if the WHEN condition is satisfied
  111.     IF ( GetPreValidate(oGet) )
  112.  
  113.       // activate the GET for reading
  114.       oGet:SetFocus()
  115.  
  116.       DO WHILE ( oGet:exitState == GE_NOEXIT )
  117.  
  118.         // check for initial typeout (no editable positions)
  119.         IF ( oGet:typeOut )
  120.           oGet:exitState := GE_ENTER
  121.         ENDIF
  122.  
  123.         // apply keystrokes until exit
  124.         DO WHILE ( oGet:exitState == GE_NOEXIT )
  125.           nKey := InKey(0)
  126.           DO CASE
  127.             CASE nKey == K_TAB
  128.               oGet:exitState := GE_DOWN
  129.               GoToGet(NextSection(oGet, GetList))
  130.             
  131.             CASE nKey == K_SH_TAB
  132.               oGet:exitState := GE_UP
  133.               GoToGet(PrevSection(oGet, GetList))
  134.  
  135.             OTHERWISE
  136.               GetApplyKey( oGet, nKey )
  137.           ENDCASE
  138.         ENDDO
  139.  
  140.         // disallow exit if the VALID condition is not satisfied
  141.         IF ( !GetPostValidate(oGet) )
  142.           oGet:exitState := GE_NOEXIT
  143.         ENDIF
  144.  
  145.       ENDDO
  146.  
  147.       // de-activate the GET
  148.       oGet:KillFocus()
  149.     ENDIF
  150.   ENDIF
  151.  
  152. RETURN
  153.  
  154.  
  155. FUNCTION GoToGet(n)
  156.  
  157. LOCAL oGetCurrent := GetActive()
  158. LOCAL nGetCurrent := Ascan(GetList, {|o| o == oGetCurrent})
  159.  
  160.   IF nGetCurrent > n
  161.     oGetCurrent:exitState := GE_UP
  162.   ELSE
  163.     oGetCurrent:exitState := GE_DOWN
  164.   ENDIF
  165.   GetMovingTo(n)
  166.  
  167. RETURN NIL
  168.  
  169.  
  170. FUNCTION GetMovingTo(n)
  171.  
  172. STATIC nWhereToGo
  173. LOCAL  nOldWhereGo := nWhereToGo
  174.  
  175.   IF PCount() > 0
  176.     nWhereToGo := n
  177.   ENDIF
  178.  
  179. RETURN nOldWhereGo
  180.  
  181.  
  182. FUNCTION NextSection(oGet)
  183.  
  184. LOCAL oCurrentSection := DictAt(oGet:cargo, "SEC #")
  185. LOCAL aSections := SectionStarts()
  186.  
  187. RETURN aSections[oCurrentSection % Len(aSections) + 1, 2]
  188.  
  189.  
  190. FUNCTION PrevSection(oGet)
  191.  
  192. LOCAL oCurrentSection := DictAt(oGet:cargo, "SEC #")
  193. LOCAL aSections := SectionStarts()
  194.  
  195. RETURN iif(oCurrentSection == 1,       ;
  196.            aSections[Len(aSections), 2], ;
  197.            aSections[(oCurrentSection - 1) % Len(aSections), 2])
  198.  
  199.  
  200. FUNCTION GetSecStarts(GetList)
  201.  
  202. LOCAL aSectionStarts := {}
  203. LOCAL nGets := Len(GetList)
  204. LOCAL i
  205. LOCAL aCargo
  206.  
  207.   FOR i := 1 TO nGets
  208.     aCargo := GetList[i]:cargo
  209.     IF Ascan(aSectionStarts, ;
  210.              {|e| e[1] == DictAt(aCargo, "SEC #") } ) == 0
  211.       Aadd(aSectionStarts, ;
  212.            { DictAt(aCargo, "SEC #"), i })
  213.     ENDIF
  214.   NEXT
  215.  
  216. RETURN aSectionStarts
  217.  
  218.  
  219. // Get / Set array containing section start / get # pairs
  220.  
  221. FUNCTION SectionStarts(aSecs)
  222.  
  223. STATIC aSectionStarts := {}
  224. LOCAL aOldStarts := aSectionStarts
  225.  
  226.   IF Pcount() > 0
  227.     aSectionStarts := aSecs
  228.   ENDIF
  229.  
  230. RETURN aOldStarts
  231.