home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB51.ZIP / C5P78.EXE / SOURCE / GETSYS.PRG < prev    next >
Encoding:
Text File  |  1990-05-31  |  10.0 KB  |  452 lines
  1. /***
  2. *       getsys.prg
  3. *       Standard Clipper 5.0 GET/READ subsystem!
  4. *       Copyright (c) 1990 Nantucket Corp.  All rights reserved.
  5. *
  6. *        Note:  compile with /n/w/a
  7. */
  8.  
  9. #include "set.ch"
  10. #include "inkey.ch"
  11.  
  12.  
  13. #define K_UNDO          K_CTRL_U
  14.  
  15.  
  16. static __Updated := .f.
  17. static __Format
  18.  
  19. static KillRead := .f.
  20.  
  21.  
  22.  
  23. /***
  24. *   __SetFormat()
  25. */
  26. func __SetFormat(b)
  27.     __Format := if ( ValType(b) == "B", b, NIL )
  28. return (NIL)
  29.  
  30.  
  31.  
  32. /***
  33. *    __KillRead()
  34. *
  35. *   CLEAR GETS service
  36. */
  37. func __KillRead()
  38.     KillRead := .t.
  39. return (NIL)
  40.  
  41.  
  42.  
  43. /***
  44. *    Updated()
  45. */
  46. func Updated()
  47. return (__Updated)
  48.  
  49.  
  50.  
  51. /***
  52. *    ReadExit()
  53. */
  54. func ReadExit(lNew)
  55. return ( Set(_SET_EXIT, lNew) )
  56.  
  57.  
  58.  
  59. /***
  60. *    ReadInsert()
  61. */
  62. func ReadInsert(lNew)
  63. return ( Set(_SET_INSERT, lNew) )
  64.  
  65.  
  66.  
  67. /***
  68. *   ShowScoreboard()
  69. */
  70. proc ShowScoreboard()
  71. local nRow, nCol
  72.     if ( Set(_SET_SCOREBOARD) )
  73.         nRow := row()
  74.         nCol := col()
  75.         @ 0, 60 SAY if( Set(_SET_INSERT), "Ins", "   " )
  76.         @ nRow, nCol SAY ""
  77.     end
  78. return
  79.  
  80.  
  81.  
  82. /***
  83. *    DateMsg()
  84. */
  85. static func DateMsg()
  86. local nRow, nCol
  87.  
  88.     if ( Set(_SET_SCOREBOARD) )
  89.         nRow := Row()
  90.         nCol := Col()
  91.         @ 0, 60 SAY "Invalid Date"
  92.         @ nRow, nCol SAY ""
  93.  
  94.         while ( Nextkey() == 0 )
  95.         end
  96.  
  97.         @ 0, 60 SAY "            "
  98.         @ nRow, nCol SAY ""
  99.     end
  100.  
  101. return (.f.)
  102.  
  103.  
  104.  
  105. /***
  106. *   RangeCheck()
  107. */
  108. func RangeCheck(xValue, lChanged, aRange)
  109. local cMsg, nRow, nCol
  110.  
  111. /*
  112. if (!lChanged)
  113.     return (.t.)
  114. end
  115. */
  116.  
  117.     if ( xValue >= aRange[1] .and. xValue <= aRange[2] )
  118.         return (.t.)    /* NOTE */
  119.     end
  120.  
  121.     if ( Set(_SET_SCOREBOARD) )
  122.         cMsg := "Range: " + Ltrim(Transform(aRange[1], "")) + ;
  123.                 " - " + Ltrim(Transform(aRange[2], ""))
  124.  
  125.         if ( Len(cMsg) > MaxCol() )
  126.             cMsg := Substr( cMsg, 1, MaxCol() )
  127.         end
  128.  
  129.         nRow := Row()
  130.         nCol := Col()
  131.         @ 0, Min( 60, MaxCol() - Len(cMsg) ) SAY cMsg
  132.         @ nRow, nCol SAY ""
  133.  
  134.         while ( NextKey() == 0 )
  135.         end
  136.  
  137.         @ 0, Min( 60, MaxCol() - Len(cMsg) ) SAY Replicate( " ", Len(cMsg) )
  138.         @ nRow, nCol SAY ""
  139.     end
  140.  
  141. return (.f.)
  142.  
  143.  
  144.  
  145. /***
  146. *    ReadModal()
  147. */
  148. func ReadModal(aList)
  149.  
  150. local g
  151. local i, new
  152. local nLen
  153. local nKey, cKey
  154. local bKeyBlock
  155. local saveReadVar
  156. local localUpdated
  157. local localReadExit
  158. local GetExitRequested
  159. local GetExitGranted
  160.  
  161.     /* format? */
  162.     if ( ValType(__Format) == "B" )
  163.         Eval(__Format)
  164.     end
  165.  
  166.     if ( Empty(aList) )
  167.         /* S87 compat. */
  168.         @ MaxRow()-1, 0 SAY ""
  169.         return (.f.)
  170.     end
  171.  
  172.     /* CAUTION save readexit? */
  173.     localReadExit := Set(_SET_EXIT)
  174.  
  175.     /* set CLEAR GETS flag off */
  176.     KillRead := .f.
  177.  
  178.     /* set Updated() flag off */
  179.     __Updated := localUpdated := .f.
  180.  
  181.     /* save, set ReadVar() */
  182.     saveReadVar := ReadVar("")
  183.  
  184.     nLen := Len(aList)
  185.  
  186.     /***
  187.     *   READ loop
  188.     */
  189.  
  190.     i := 1
  191.     while (i != 0 .and. !KillRead)
  192.  
  193.         /* set current get */
  194.         g := aList[i]
  195.  
  196.         /* set ReadVar() */
  197.         ReadVar(Upper(g:name))
  198.  
  199.         /* pre-validation (WHEN clause) */
  200.         if ( g:preBlock != NIL .and. !Eval( g:preBlock ) )
  201.             /* CAUTION needs to bounce */
  202.             if ( ++i > nLen )
  203.                 i := if( localReadExit, 0, nLen )
  204.             end
  205.             loop    /* NOTE */
  206.         end
  207.  
  208.         ShowScoreboard()
  209.  
  210.         /* Give to it the focus, Kenneth */
  211.         g:setFocus()
  212.  
  213.         /***
  214.         *   GET loop
  215.         */
  216.  
  217.         GetExitGranted := .f.
  218.  
  219.         while (!GetExitGranted)
  220.  
  221.             if (g:typeOut)
  222.                 /* no editable positions */
  223.                 /* CAUTION should it bounce? not s87 compat but */
  224.                 GetExitRequested := .t.
  225.                 if ((new := i + 1) > Len(aList) )
  226.                     new := 0  /* CAUTION typeout w/readexit? */
  227.                 end
  228.             else
  229.                 GetExitRequested := .f.
  230.             end
  231.  
  232.             /***
  233.             *   keystroke processing loop
  234.             */
  235.  
  236.             while (!GetExitRequested)
  237.  
  238.                 nKey := Inkey(0)
  239.  
  240.                 if ( (bKeyBlock := SetKey(nKey)) != NIL )
  241.  
  242.                     if (g:changed)
  243.                         g:assign()
  244.                     end
  245.  
  246.                     /* run SET KEY block */
  247.                     Eval(bKeyBlock, ProcName(2), ProcLine(2), ReadVar())
  248.  
  249.                     /* in case var was reassigned in SET KEY code */
  250.                     g:updateBuffer()
  251.  
  252.                     /* in case insert status was diddled in SET KEY code */
  253.                     ShowScoreboard()
  254.  
  255.                     /* if CLEAR GETS was issued in SET KEY code, get out */
  256.                     if (KillRead)
  257.                         exit    /* NOTE */
  258.                     end
  259.  
  260.                     loop /* NOTE */
  261.                 end
  262.  
  263.                 /***
  264.                 *   key processing switch
  265.                 */
  266.  
  267.                 do case
  268.                 case (nKey == K_UP)
  269.                     GetExitRequested := .t.
  270.                     if ((new := i - 1) < 1)
  271.                         new := if( localReadExit, 0, 1 )
  272.                     end
  273.  
  274.                 case (nKey == K_DOWN)
  275.                     GetExitRequested := .t.
  276.                     if ((new := i + 1) > nLen)
  277.                         new := if( localReadExit, 0, nLen )
  278.                     end
  279.  
  280.                 case (nKey == K_ESC)
  281.                     if ( Set(_SET_ESCAPE) )
  282.                         g:undo()
  283.                         GetExitRequested := .t.
  284.                         KillRead := .t.
  285.                     end
  286.  
  287.                 case (nKey == K_PGUP)
  288.                     GetExitRequested := .t.
  289.                     new := 0
  290.  
  291.                 case (nKey == K_PGDN)
  292.                     GetExitRequested := .t.
  293.                     new := 0
  294.  
  295.                 case (nKey == K_CTRL_HOME)
  296.                     GetExitRequested := .t.
  297.                     new := 1
  298. #ifdef NOTDEF
  299.                 /* this code causes both ^W and ^End to behave like ^End */
  300.                 case (nKey == K_CTRL_END)
  301.                     GetExitRequested := .t.
  302.                     new := Len(aList)
  303. #else
  304.                 /* this code causes both ^W and ^End to behave like ^W */
  305.                 case (nKey == K_CTRL_W)
  306.                     GetExitRequested := .t.
  307.                     new := 0
  308. #endif
  309.                 case (nKey == K_ENTER)
  310.                     GetExitRequested := .t.
  311.                     if ((new := i + 1) > Len(aList) )
  312.                         new := 0  /* CAUTION typeout w/readexit? */
  313.                     end
  314.  
  315.                 case (nKEY == K_UNDO)
  316.                     g:undo()
  317.  
  318.                 case (nKey == K_INS)
  319.                     Set( _SET_INSERT, !Set(_SET_INSERT) )
  320.                     ShowScoreboard()
  321.  
  322.                 case (nKey == K_HOME)
  323.                     g:home()
  324.  
  325.                 case (nKey == K_END)
  326.                     g:end()
  327.  
  328.                 case (nKey == K_RIGHT)
  329.                     g:right()
  330.  
  331.                 case (nKey == K_LEFT)
  332.                     g:left()
  333.  
  334.                 case (nKey == K_CTRL_RIGHT)
  335.                     g:wordRight()
  336.  
  337.                 case (nKey == K_CTRL_LEFT)
  338.                     g:wordLeft()
  339.  
  340.                 case (nKey == K_BS)
  341.                     g:backSpace()
  342.  
  343.                 case (nKey == K_DEL)
  344.                     g:delete()
  345.  
  346.                 case (nKey == K_CTRL_T)
  347.                     g:delWordRight()
  348.  
  349.                 case (nKey == K_CTRL_Y)
  350.                     g:delEnd()
  351.  
  352.                 otherwise
  353.                     /* data key */
  354.                     cKey := Chr(nKey)
  355.  
  356.                     if (g:type == "N" .and. (cKey == "." .or. cKey == ","))
  357.                         g:toDecPos()
  358.                     else
  359.                         if ( Set(_SET_INSERT) )
  360.                             g:insert(cKey)
  361.                         else
  362.                             g:overstrike(cKey)
  363.                         end
  364.                     end
  365.  
  366.                     if (g:typeOut .and. !Set(_SET_CONFIRM) )
  367.  
  368.                         /* ding */
  369.                         if ( Set(_SET_BELL) )
  370.                             ?? Chr(7)
  371.                         end
  372.  
  373.                         GetExitRequested := .t.
  374.                         if ((new := i + 1) > Len(aList) )
  375.                             new := 0  /* CAUTION typeout w/readexit? */
  376.                         end
  377.                     end
  378.  
  379.                 endcase
  380.  
  381.             end     /* end of keystroke processing loop */
  382.  
  383.  
  384.             /***
  385.             *   if KillRead (from CLEAR GETS in SetKey() or key escape),
  386.             *   fall out
  387.             */
  388.             if (KillRead)
  389.                 exit    /* NOTE */
  390.             end
  391.  
  392.  
  393.             /* check for bad date before sprucing up edit buffer */
  394.             if (g:badDate())
  395.  
  396.                 g:home()
  397.                 DateMsg()
  398.                 ShowScoreboard()
  399.  
  400.                 loop    /* NOTE */
  401.             end
  402.  
  403.             /* assign get var */
  404.             if (g:changed)
  405.                 __Updated := localUpdated := .t.
  406.                 g:assign()
  407.             end
  408.  
  409.             /* reset editing machinery (and redisplay) */
  410.             g:reset()
  411.  
  412.             if (Valtype(g:postBlock) == "B")
  413.                 /* run the valid block */
  414.                 GetExitGranted := Eval(g:postBlock, g:getVar(), g:changed)
  415.  
  416.                 /* in case insert status was changed in valid code */
  417.                 ShowScoreboard()
  418.  
  419.                 /* in case var was reassigned in valid code */
  420.                 g:updateBuffer()
  421.  
  422.                 /* in case nested read changed global updated flag */
  423.                 __Updated := localUpdated
  424.  
  425.             else
  426.                 /* no valid clause */
  427.                 GetExitGranted := .t.
  428.  
  429.             end
  430.  
  431.         end     /* end of GET editing loop */
  432.  
  433.         /* take away from it the focus, Kenneth */
  434.         g:killFocus()
  435.  
  436.         /* set getList index for next edit */
  437.         i := new
  438.  
  439.     end     /* end of READ loop */
  440.  
  441.     /* reset CLEAR GETS flag */
  442.     KillRead := .f.
  443.  
  444.     /* S87 compat. */
  445.     @ MaxRow()-1, 0 SAY ""
  446.  
  447.     /* restore readvar */
  448.     ReadVar(saveReadVar)
  449.  
  450. return (__Updated)
  451.  
  452.