/* Implements a single line edit box as an input field with parameterized checking and output conversion. */!!

inherit(TextWindow, #EditField, #(dirty    /* Boolean flag--true if text has been changed */
legalChars /* set of legal input chars */
outCheckFun   /* check for legal string */
outConvertFun /* ^return value from string */
maxLength /* how many chars in line? */
editDone?
parentInformed?
inClose?), 2, nil)!!

now(class(EditField))!!

/* Create a new window class Struct. Assigns the 
 I-Beam cursor style to windows of this class
 and descendants. */
Def newWClass(self, className, iconName | wc)
{ wc := newWClass(self:ancestor, className, iconName);
  putWord(wc, Call LoadCursor(0, IDC_IBEAM), 14);
  ^wc;
}!!

/* PRIVATE */
Def style(self)
{ 
  ^WS_CHILD
}
!!

/* Return static string for this window class name ("EditField"). */
Def wndClass(self)
{ ^"EditField";
}!!

now(EditField)!!

/* 10/12/1994 17:22 */
Def getStatus(self)
{
   ^editDone?
}
!!

/* 10/13/1992 9:42 */
Def deleteKey(self | aStr)
{ 
    if (xPos < size(workText[0]))
    then 
      deleteChar(workText, 0, xPos); /* N.B. line# is always 0 */
      aStr := copyFrom( workText[0], 0, size(workText[0]) )  +  "  " ;
      drawText( self, aStr, 0, 0 ) 
    else
      beep();
    endif ;
}
!!

/* comment */
Def aREAD_ME(self)
{ 
/*
We need to implement an integrated inter-field behavior.  The obvious
way to do this is to propagate arrow keys to the parent window when they
"leave the field".  So up/down arrow keys are always sent to the parent,
which can them switch the focus to the field above/below this one.  
Likewise, left and right arrow keys are propagated when the user reaches
the end of the field.  When the user types the last character in the field,
the field can also send a right-arrow to the parent, so the user can just
type from one field to another.

We need to implement select, copy/paste for fields.

Delete outConvertFun checks (not very useful).
*/
}
!!

/* Respond to arrow keys and home and page-end keys. */
Def arrows(self, wP | xTmp)
{ 
  select
    case wP == 37   /* left */
      if xPos > 0
        xPos := xPos-1;
      else
        ^arrows(parent,wP);
      endif;
    endCase
    case wP == 39   /* right */
      if ((xPos+1) < maxLength) cand (xPos < size(workText[0]))
        xPos := xPos+1;
      else
        ^arrows(parent,wP);
      endif;
    endCase
    case wP == 38   /* up */
      ^arrows(parent,wP);
    endCase
    case wP == 40  /* down */
      ^arrows(parent,wP);
    endCase
    case wP == EDIT_HOME
      xPos := 0 ;
    endCase
    case wP == EDIT_END
      xPos := min( size(workText[0]), maxLength-1 ) ;
    endCase
  endSelect;
  moveCaret(self);
  showCaret(self);
}!!

Def beginDrag(self, wp, pt)
{ 
  setCurPos( self, pt ) ;
  setFocus( self ) ;
  ^0
}!!

/* Process MS-Window's character input message. */
Def charIn(self, wP, lP)
{ if not(hWnd(self)) cor editDone?
  then ^0
  endif;

  hideCaret( self ) ;
  if not( charInput(self, asChar(wP)) ) /* closing */
  then ^0
  endif ;
  dirty := true;
  moveCaret( self ) ;
  showCaret( self ) ;

  ^0
}!!

/* PRIVATE -- Handle the input character, checking for legality. */
Def charInput(self, aChar | aStr)
{ 
/*@@{ printNewLine("EditField: char input is '0x" 
                    + asHex(asInt(aChar)) + "'" ) ;
}@@*/

  if (aChar == CR) cor (aChar == asChar(10))
  then
    editComplete( self ) ;
    ^nil ;
  endif ;

  select
    case (aChar in legalChars) and (xPos < maxLength)
    is /* add new char or replace existing char */
      if ( size(workText[0]) > xPos )
      then
        workText[0][xPos] := aChar; /* replace */
      else
        insertString(workText, asString(aChar), 0, xPos); /* new */
      endif ;
      drawText( self, workText[0], 0, 0 ) ;
      if ((xPos+1) < maxLength)
      then
        xPos := xPos + 1;
      endif
    endCase

    case (aChar = BS) cand (xPos > 0)
    is 
      deleteChar(workText, 0, (xPos-1)); /* N.B. line# is always 0 */
      xPos := xPos - 1;
      aStr := copyFrom( workText[0], 0, size(workText[0]) )  +  "  " ;
      drawText( self, aStr, 0, 0 ) 
    endCase
 
    default
      /*@@{
      printNewLine( "EditField: discarded char is '0x" 
                    + asHex(asInt(aChar)) + "'" ); }@@*/
      beep();
  endSelect;

  ^aChar 
}!!

/* PUBLIC */
Def close(self)
{ 
/*@@ debug @@{
printNewLine("VV=============actor=====stack====================VV");
printNewLine("Inclose is ");
if inClose? then printLine("true"); else printLine("false"); endif ;
do( frames( fill(Bug, stackTop()) ), {using(str) printNewLine(str); } );
}@@*/

  if inClose?
  then ^nil ;
  else inClose? := #true ;
  endif ;

  if not(parentInformed?)
  then
    parentInformed? := #true ;
    fieldEditComplete( parent, workText[0] ) ;
  endif ;

  if hWnd( self )
  then
    close( self:ancestor ) ;
  endif ;
}
!!

/* PRIVATE */
Def command(self, wP, lP)
{ 
  if between(wP, 37, 40) cor (wP = EDIT_HOME) cor (wP = EDIT_END)
  then
    arrows( self, wP ) ;
  else
    if (wP == 301) /* code for DELETE (N.B.: <> VK_DELETE) */
    then
      deleteKey( self ) ;
    endif ;
  endif ;
}
!!

/* PRIVATE */
Def editComplete(self)
{
  if editDone? then ^nil ; endif;

  editDone? := #true ;
  show( self, SW_HIDE ) ;
  hideCaret( self ) ;
  Call DestroyCaret() ;

  close( self ) ; /* no more work to do */
}

!!

/* Return the text string from the Clipboard. */
Def getClipText(self | hStr, aStr)
{ if Call OpenClipboard(hWnd) <> 0
  then hStr := Call GetClipboardData(CF_TEXT);
    aStr := getText(hStr);
    Call CloseClipboard();
    ^removeNulls(aStr);
  endif;
  Call CloseClipboard();
  ^nil
}!!

/* PUBLIC -- copy workText string */
Def getText(self)
{ 
  ^copyFrom( workText[0], 0, size(workText[0]) ) ;
}
!!

/* Prepare window for input and output, show selected
  text. */
Def gotFocus(self, hWndPrev)
{ 
  enable(self);
  xMax := maxLength;
  Call CreateCaret(hWnd, 0, 0, tmHeight);
  moveCaret(self);
  caretVis := nil;
  Call GetUpdateRect(hWnd, &(0, 0, 0, 0), 1);
  showCaret(self);
}!!

/* Hide the caret if it is visible and switch caretVis flag. */
Def hideCaret(self)
{ if caretVis
  then Call HideCaret(hWnd);
    caretVis := nil
  endif;
}!!

/* PRIVATE */
Def init(self)
{ 
  init( self:ancestor ) ;
  
  /* default to HEX Numeric input field (no don't care's) */
  setLegalChars( self, asSet("1234567890ABCDEFabcdef") ) ; 
  setMaxLength( self, 8 ) ; /* 32 bit field */
  add( workText, new(String, maxLength(self)) ) ;
  setOutConvertFun( self, {using(aString) ^asInt(aString, 16)} ) ;
  setOutCheckFun( self, {using(aString) ^aString} ) ;
}
!!

/* PRIVATE
  Initialize text metrics data for this browser.  Load the font data 
  into textMetrics, set the text width and height instance variables.
  
  Nota Bene: This sets up for Windows' defaults.  The containing window
  should use setTmWidth and setTmHeight methods to size for its chosen
  font characteristics.
*/
Def initTextMetrics(self | hdc, tm)
{ tm := new(Struct, 32);
  Call SelectObject(hdc := getContext(self),
                    Call GetStockObject(SYSTEM_FIXED_FONT));
  Call GetTextMetrics(hdc, tm);
  tmWidth  := asInt(wordAt(tm, 10));
  tmHeight := asInt(wordAt(tm, 8)) + asInt(wordAt(tm, 0));
  Call SelectObject(hdc, Call GetStockObject(SYSTEM_FONT));
  releaseContext(self, hdc);
}!!

/* Return true flag for error insertion routines. */
Def isEditable(self)
{ ^true
}!!

/* PUBLIC */
Def legalChars(self)
{ 
  ^legalChars
}
!!

/* When losing focus, de-select text visually, and
  then hide and destroy the caret. */
Def losingFocus(self, hWndNew | aFieldStr, hdc)
{ 
  /* stop editing */
  if hWnd( self )
  then
    hideCaret( self ) ;
    Call DestroyCaret() ;
    if not(inClose?) cand not(editDone?)
    then childIsLosingFocus( parent, self ) ;
    endif ;
  endif ;
  
  ^0
}!!

/* PUBLIC */
Def maxLength(self)
{ 
  ^maxLength
}
!!

/* PUBLIC */
Def paint(self, hdc)
{ 
  initTextColors(self, hdc);
  Call TextOut( hdc, 0, 0, workText[0], size(workText[0]) ) ;
}
!!

/* Set cursor position (xPos, yPos) according to the
  specified point. */
Def setCurPos(self, aPnt)
{ 
  xPos := min((xMax-1), x(aPnt)/tmWidth);
}!!

/* PUBLIC */
Def setLegalChars(self, newCharSet)
{ 
  ^legalChars := newCharSet ;
}
!!

/* PUBLIC */
Def setMaxLength(self, newLength)
{ 
  ^xMax := maxLength := newLength ;
}
!!

/* PUBLIC 
  When focus leaves field, this function checks for legality.  
  It should do any required error recovery and return an appropriate string.
  (I.e. outputCheckingFunction() takes a string arg and returns a string 
  result).
*/
Def setOutCheckFun(self, outputCheckingFunction)
{ 
  ^outCheckFun := outputCheckingFunction ;
}
!!

/* PUBLIC 
  When field value is asked for, this function takes the field string and
  returns a value.  The value can be of any type.
  
  The field string has already been checked via outCheckFun().
*/
Def setOutConvertFun(self, outputConvertFunction)
{ 
  ^outConvertFun := outputConvertFunction ;
}
!!

/* PUBLIC */
Def setText(self, aString)
{ 
  /* @@ adjust string size to maxLength (Procrustean) @@ */
  add( (workText := new(TextCollection, 1)), 
                    subString(aString, 0, size(aString)) )  ;
}
!!

/* Show the caret if it is hidden and switch caretVis flag. */
Def showCaret(self)
{ if not(caretVis) cand hWnd
  then Call ShowCaret(hWnd);
    caretVis := true;
  endif;
}!!

/* Allow "arrow" keys and the tab key to work 
   without using accelerators. 
   NOTES: Nghia - 10/12/93
   Intercept ESC key and close edit field. 
*/
Def WM_KEYDOWN(self, wp, lp)
{ if between(wp, 37, 40) then
    command(self, wp, 0x10000);  
  endif;
  if (wp == VK_ESCAPE) then
    editDone? := #false ;
    close(self);
  endif;  
}!!

/* WINDOWS
  MS-Window's message to paint self -- sends a
  paint(self) message.  This overrides Window:WM_PAINT
  so that TextWindow and its descendants use the
  System Fixed Font instead of the System Font. */
Def WM_PAINT(self, wP, lP | hdc)
{ hdc := Call BeginPaint(getHWnd(self), paintStruct);
  Call SelectObject(hdc, Call GetStockObject(SYSTEM_FIXED_FONT));
  initTextColors( self, hdc ) ;
  paint(self, hdc);
  Call SelectObject(hdc, Call GetStockObject(SYSTEM_FONT));
  Call EndPaint(getHWnd(self), paintStruct);
  ^0;
}!!

/* When losing focus, de-select text visually, and
  then hide and destroy the caret. */
Def XXlosingFocus(self, hWndNew | aFieldStr, hdc)
{ 
  /* stop editing */
  hideCaret( self ) ;
  Call DestroyCaret() ;
  
  /* Call user code to check semantics and possibly recover */
  aFieldStr := eval( outCheckFun, getText(self) ) ;
  
  /* (possibly) reset work test */
  if not( aFieldStr = workText[0] ) 
  then
    setText( self, aFieldStr ) ;
    hdc := Call BeginPaint( hWnd, paintStruct ) ;
    Call TextOut( hdc, x(self), y(self), aFieldStr, size(aFieldStr) ) ;
    Call EndPaint( hWnd, paintStruct ) ;
  endif ;
  
  ^0
}!!
