/***
*       getsys.prg
*       Standard Clipper 5.0 GET/READ subsystem
*       Copyright (c) 1990 Nantucket Corp.  All rights reserved.
*
*		Note:  compile with /m/n/w/a  (Yeah they really mean it! LMc)
*
*	Modified 02/13/91 by Lindsay McCann.
*		pressing + or - in a date field changes the date.
*	All lines that I have modified are commented as follows:
*			// Added 02/13/91 by LMc
*
*/

#include "set.ch"
#include "inkey.ch"


#define K_UNDO          K_CTRL_U


/* go team */
#define SCORE_ROW		0
#define SCORE_COL		60

static __Updated := .f.
static __Format

static KillRead := .f.

static currentActiveGet := NIL

/***
*   __SetFormat()
*/
func __SetFormat(b)
    __Format := if ( ValType(b) == "B", b, NIL )
return (NIL)



/***
*	__KillRead()
*
*   CLEAR GETS service
*/
proc __KillRead()
    KillRead := .t.
return



/***
*	Updated()
*/
func Updated()
return (__Updated)



/***
*	ReadExit()
*/
func ReadExit(lNew)
return ( Set(_SET_EXIT, lNew) )



/***
*	ReadInsert()
*/
func ReadInsert(lNew)
return ( Set(_SET_INSERT, lNew) )



/***
*   ShowScoreboard()
*/
static proc ShowScoreboard()
local nRow, nCol

    if ( Set(_SET_SCOREBOARD) )
        nRow := Row()
        nCol := Col()

		SetPos(SCORE_ROW, SCORE_COL)
		DispOut( if(Set(_SET_INSERT), "Ins", "   ") )
        SetPos(nRow, nCol)

	end

return



/***
*	DateMsg()
*/
static proc DateMsg()
local nRow, nCol

    if ( Set(_SET_SCOREBOARD) )
		nRow := Row()
		nCol := Col()

		SetPos(SCORE_ROW, SCORE_COL)
		DispOut("Invalid Date")
        SetPos(nRow, nCol)

		while ( Nextkey() == 0 )
		end

		SetPos(SCORE_ROW, SCORE_COL)
		DispOut("            ")
        SetPos(nRow, nCol)

	end

return



/***
*   RangeCheck()
*/
func RangeCheck(xValue, lChanged, lo, hi)
local cMsg, nRow, nCol

/*
if (!lChanged)
	return (.t.)
end
*/

	if ( xValue >= lo .and. xValue <= hi )
		return (.t.)									/* NOTE */
	end

    if ( Set(_SET_SCOREBOARD) )
		cMsg := "Range: " + Ltrim(Transform(lo, "")) + ;
				" - " + Ltrim(Transform(hi, ""))

		if ( Len(cMsg) > MaxCol() )
			cMsg := Substr( cMsg, 1, MaxCol() )
		end

		nRow := Row()
		nCol := Col()

		SetPos( SCORE_ROW, Min(60, MaxCol() - Len(cMsg)) )
		DispOut(cMsg)
        SetPos(nRow, nCol)

		while ( NextKey() == 0 )
		end

		SetPos( SCORE_ROW, Min(60, MaxCol() - Len(cMsg)) )
		DispOut( Space(Len(cMsg)) )
        SetPos(nRow, nCol)

	end

return (.f.)


/***
*	GetActive()
*/
func GetActive()
return (currentActiveGet)




/* bounce direction for ReadModal */
#define FORWARD 	1
#define BACKWARD   -1


/***
*	ReadModal()
*/
func ReadModal(aList)

local g
local i, new
local nLen
local nKey, cKey
local bKeyBlock
local saveReadVar
local saveCurrentActiveGet
local localUpdated
local localReadExit
local GetExitRequested
local GetExitGranted
local direction := FORWARD
local nLastKey, nm, dt, mul			// Added 02/13/91 by LMc

    /* format? */
	if ( ValType(__Format) == "B" )
		Eval(__Format)
	end

	if ( Empty(aList) )
		/* S87 compat. */
        SetPos( MaxRow()-1, 0 )
		return (.f.)									/* NOTE */
	end

    /* CAUTION: save readexit? */
    localReadExit := Set(_SET_EXIT)

    /* set CLEAR GETS flag off */
    KillRead := .f.

    /* set Updated() flag off */
    __Updated := localUpdated := .f.

    /* save, set ReadVar() */
    saveReadVar := ReadVar("")

	/* save currentActiveGet */
	saveCurrentActiveGet := currentActiveGet

    nLen := Len(aList)


    /***
    *   READ loop
    */

    i := 1
    while (i != 0 .and. !KillRead)

        /* set current get */
		g := currentActiveGet := aList[i]

        /* set ReadVar() */
        ReadVar(Upper(g:name))

        /* pre-validation (WHEN clause) */
        if ( g:preBlock != NIL .and. !Eval( g:preBlock ) )
			if ( direction == FORWARD )
				if ( ++i > nLen )
					/* going forward, at bottom of getlist */
					if (localReadExit)
						i := 0
					else
						i := nLen
						direction := BACKWARD
					end
				end
			else
				if ( --i < 1 )
					/* going backward, at top of getlist */
					if (localReadExit)
						i := 0
					else
						i := 1
						direction := FORWARD
					end
				end
			end
            loop    									/* NOTE */
        end

        ShowScoreboard()

        /* Give to it the focus, Kenneth */
        g:setFocus()

        /***
        *   GET loop
        */

        GetExitGranted := .f.

        while (!GetExitGranted)

            if (g:typeOut)
                /* no editable positions */
                /* CAUTION should it bounce? not s87 compat but */
                GetExitRequested := .t.
                if ((new := i + 1) > Len(aList) )
                    new := 0  /* CAUTION typeout w/readexit? */
                end
            else
                GetExitRequested := .f.
            end

            /***
            *   keystroke processing loop
            */

			nKey=0						// Added 02/13/91 by LMc
            while (!GetExitRequested)

				nLastKey := nKey		// Added 02/13/91 by LMc
                nKey := Inkey(0)

                if ( (bKeyBlock := SetKey(nKey)) != NIL )

                    if (g:changed)
                        g:assign()
                    end

                    /* run SET KEY block */
                    Eval(bKeyBlock, ProcName(2), ProcLine(2), ReadVar())

                    /* in case var was reassigned in SET KEY code */
                    g:updateBuffer()

                    /* in case insert status was diddled in SET KEY code */
                    ShowScoreboard()

                    /* if CLEAR GETS was issued in SET KEY code, get out */
                    if (KillRead)
                        exit    						/* NOTE */
                    end

                    loop 								/* NOTE */
                end

                /***
                *   key processing switch
                */

                do case
                case (nKey == K_UP)
					direction := BACKWARD
                    GetExitRequested := .t.
                    if ((new := i - 1) < 1)
                        new := if( localReadExit, 0, 1 )
                    end

                case (nKey == K_DOWN)
					direction := FORWARD
                    GetExitRequested := .t.
                    if ((new := i + 1) > nLen)
                        new := if( localReadExit, 0, nLen )
                    end

                case (nKey == K_ESC)
                    if ( Set(_SET_ESCAPE) )
                        g:undo()
                        GetExitRequested := .t.
                        KillRead := .t.
                    end

                case (nKey == K_PGUP)
                    GetExitRequested := .t.
                    new := 0

                case (nKey == K_PGDN)
                    GetExitRequested := .t.
                    new := 0

                case (nKey == K_CTRL_HOME)
					direction := FORWARD
                    GetExitRequested := .t.
                    new := 1
#ifdef NOTDEF
                /* this code causes both ^W and ^End to behave like ^End */
                case (nKey == K_CTRL_END)
					direction := BACKWARD
                    GetExitRequested := .t.
                    new := Len(aList)
#else
                /* this code causes both ^W and ^End to behave like ^W */
                case (nKey == K_CTRL_W)
                    GetExitRequested := .t.
                    new := 0
#endif
                case (nKey == K_ENTER)
					direction := FORWARD
                    GetExitRequested := .t.
                    if ((new := i + 1) > Len(aList) )
                        new := 0  /* CAUTION typeout w/readexit? */
                    end

                case (nKEY == K_UNDO)
                    g:undo()

                case (nKey == K_INS)
                    Set( _SET_INSERT, !Set(_SET_INSERT) )
                    ShowScoreboard()

                case (nKey == K_HOME)
                    g:home()

                case (nKey == K_END)
                    g:end()

                case (nKey == K_RIGHT)
                    g:right()

                case (nKey == K_LEFT)
                    g:left()

                case (nKey == K_CTRL_RIGHT)
                    g:wordRight()

                case (nKey == K_CTRL_LEFT)
                    g:wordLeft()

                case (nKey == K_BS)
                    g:backSpace()

                case (nKey == K_DEL)
                    g:delete()

                case (nKey == K_CTRL_T)
                    g:delWordRight()

                case (nKey == K_CTRL_Y)
                    g:delEnd()

// Added 02/13/91 by LMc
// The next 8 code lines allow you to change the date using +/- while
// editing a date field.  Note the mul variable which provides acceleration.

                case (g:type == "D" .and. (nKey == 43 .or. nKey == 45))
					mul := iif(nLastkey==nKey, ++mul, 10)
					nm=-(nKey-44)*int(mul/10)
					g:assign()
					dt=Eval( g:Block )
					dt=iif(empty(dt),date(),dt)
			        Eval( g:Block, dt+nm ) 
                    g:updateBuffer()

                otherwise
					if (nKey >= 32 .and. nKey <= 127)
						/* data key */
						cKey := Chr(nKey)


						if (g:type == "N" .and. ;
							(cKey == "." .or. cKey == ","))
							/* go to decimal point */
							g:toDecPos()
						else
							/* send it to the get */
							if ( Set(_SET_INSERT) )
								g:insert(cKey)
							else
								g:overstrike(cKey)
							end
						end

						if (g:typeOut .and. !Set(_SET_CONFIRM) )

							/* ding */
							if ( Set(_SET_BELL) )
								?? Chr(7)
							end

							GetExitRequested := .t.
							if ((new := i + 1) > Len(aList) )
								new := 0  /* CAUTION typeout w/readexit? */
							end
						end
					end

                endcase

            end     /* end of keystroke processing loop */


            /***
            *   if KillRead (from CLEAR GETS in SetKey() or key escape),
            *   fall out
            */
            if (KillRead)
                exit    								/* NOTE */
            end


            /* check for bad date before sprucing up edit buffer */
            if (g:badDate())

                g:home()
                DateMsg()
                ShowScoreboard()

                loop    								/* NOTE */
            end

            /* assign get var */
            if (g:changed)
                __Updated := localUpdated := .t.
                g:assign()
            end

            /* reset editing machinery (and redisplay) */
            g:reset()

            if (Valtype(g:postBlock) == "B")
                /* run the valid block */
				GetExitGranted := Eval(g:postBlock, g:VarGet(), g:changed)

                /* in case insert status was changed in valid code */
                ShowScoreboard()

                /* in case var was reassigned in valid code */
                g:updateBuffer()

                /* in case nested read changed global updated flag */
                __Updated := localUpdated

            else
                /* no valid clause */
                GetExitGranted := .t.

            end

        end     /* end of GET editing loop */

        /* take away from it the focus, Kenneth */
        g:killFocus()

        /* set getList index for next edit */
        i := new

    end     /* end of READ loop */

    /* reset CLEAR GETS flag */
    KillRead := .f.

	/* reset GetActive holder */
	currentActiveGet := saveCurrentActiveGet

	/* S87 compat. */
    SetPos( MaxRow()-1, 0 )

    /* restore readvar */
    ReadVar(saveReadVar)

return (__Updated)