%%HP: T(3)A(D)F(.);

@ HP49G Version S.Lui 10/30/01

@ String general input routine S.Lui 8/23/98 Designer Version

@ Name : INSTRGD

@ Standard Inputs :  x y xd yn aon cint ival

@              x - upper left x-coordinate of box

@              y - upper left y-coordinate of box

@              xd - delta x of box

@              yn - number of maximum input lines

@                   maximum number of line is 8

@              aon - alphanumeric input (1), numeric input (0), or alphanumeric input (2) for password mode

@	   cint - prompt string

@              ival - initial value : 0 - no initial value; non-zero numeric value or "string" - initial value

@          

@ Alternative Inputs :  bflag tflag dflag  x y xd yn aon cint ival

@          When x is negative, this specifies the alternative inputs. 

@             bflag - (0/1) don't/do draw box around displays.

@             tflag  - (0/1) don't/do display prompt string.

@             dflag - (0/1) don't/do display prompt string, box, ival (if any) and

@                       return underlying grob and exits.  If dflag = 2, then normal operation, but
@                       do not replace with original grob when exits.

@ 

@ 

@ INSTRGD is a string input routine which allows an unlimited number of

@ characters to be input.

@ Note: x, y, xd, and yn can be adjusted automatically by INSTRGD in order 

@       to fit the display on the screen.

@ Outputs : string if aon=1, number if aon=0

@
\<< 
  0 RCLF 0 "" 0 GROB 1 5 1010101010 GROB 1 5 0000000000 1 0 {} {} {}
  {} {} 0 0 0 0 
  {} 0 \-> x y xd 
  yn aon cint ival   g fs k pd pt cursOR1 cursOR0 yi lx yp lxl0 lxl pxl gl yd 
  xb yb IP0 sc y1 \<< 
    
    IF x 0 < THEN x ABS 'x' STO ELSE 1 1 0 END \-> bflag tflag dflag 
    \<< 
      

@      IF 'MORE48D' VTYPE -1 == 'GETSTR' VTYPE -1 == OR THEN 
@        6 CF 
@      ELSE 
@        6 SF 
@      END 
      6 SF
      

@      IF 'POPM' VTYPE -1 == THEN 7 CF ELSE 7 SF END
      7 SF 

@   IF dflag THEN 1 'bflag' STO 1 'tflag' STO END

@      IF aon THEN
@        IF xd 65 < THEN 65 'xd' STO END
@      ELSE
@        IF xd 51 < THEN 51 'xd' STO END
@      END

      IF x xd + 1 - 130 > THEN 131 xd - 'x' STO END 
      
      IF yn 8 > THEN 8 'yn' STO END

@   flag # 8 is set when bflag=tflag=0
      8 CF
      IF tflag NOT THEN 8 SF END
     
      IF 8 FC? THEN yn 1 - 6 * 17 +  ELSE  yn 1 - 6 * 9 + 8 SF END 'yd' STO
 
      IF yd y + 1 - 63 > THEN 64 yd - 'y' STO END
      
      IF 8 FC? THEN 10 ELSE 2 END 'y1' STO 

      x 2 + 'lx' STO 1 yn 
      FOR i 'yp' i 1 - 6 * y1 + y + R\->B STO+ 'lxl' 0 STO+ NEXT x 
      R\->B 'xb' STO y R\->B 'yb' STO lxl 'lxl0' STO \<< 
        
        IF lx 5 + x xd + 3 - > THEN 
          lxl yi lx PUT 'lxl' STO 
          IF yi yn < THEN 
            x 2 + 'lx' STO 'yi' 1 STO+ 
          ELSE 
            'pxl' lxl 1 \->LIST STO+ 'gl' PICT x 2 + R\->B y y1 + 
            R\->B 2 \->LIST x xd + 3 - R\->B y y1 + yn 6 * + 1 - R\->B 
            2 \->LIST SUB STO+ PICT x 2 + R\->B y y1 + R\->B 2 \->LIST 
            xd 4 - R\->B yn 6 * R\->B BLANK REPL lxl0 'lxl' STO 1 'yi' 
            STO x 2 + 'lx' STO 
          END 
          
        END 
        lx R\->B yp yi GET 2 \->LIST 
      \>> \<< 
        1 \->GROB SIZE DROP B\->R lx + 'lx' STO 
      \>>  
      \-> calpt updlx  \<< 
        IF bflag THEN
         PICT xb yb 2 \->LIST x xd + 1 - R\->B y yd + 1 - R\->B 2 \->LIST
        ELSE
         PICT x 2 + R\->B y 2 + R\->B 2 \->LIST x xd + 3 - R\->B y yd + 3 -  R\->B 2 \->LIST
        END
        SUB 'g' STO
 
        IF bflag THEN
          PICT xb yb 2 \->LIST xd R\->B yd R\->B
        ELSE
          PICT x 2 + R\->B y 2 + R\->B 2 \->LIST xd 4 - R\->B yd 4 - R\->B
        END 
        BLANK REPL

        IF bflag THEN
          xb yb 2 \->LIST x xd + 1 - R\->B y yd + 1 - R\->B 2 \->LIST BOX 
          IF tflag THEN xb y 8 + R\->B 2 \->LIST x xd + 1 - R\->B y 8 + R\->B 2 \->LIST LINE END
        END
 
        IF tflag THEN PICT x 2 + R\->B y 2 + R\->B 2 \->LIST cint 1 \->GROB
           9 CF DUP SIZE DROP B\->R  xd 4 -   IF > THEN
           {#0 #0} xd 11 - R\->B #4d 2 \->LIST  SUB 9 SF END GOR
           IF 9 FS? THEN PICT x xd + 7 - R\->B  y 2 + R\->B 2 \->LIST 
             "..." 1 \->GROB GOR
           END
        END

@     display initial numeric value/string
        9 CF
        IF ival 0 SAME NOT THEN
           PICT x 4 + R\->B yp 1 GET 2 \->LIST
           IF aon NOT THEN
              ival \->STR
           ELSE
              IF aon 2 == THEN
                 "" 1 ival SIZE FOR i "*" + NEXT
              ELSE
                 ival
              END
           END
           1 \->GROB 
           DUP SIZE DROP B\->R  xd 6 -   IF > THEN
           {#0 #0} xd 9 - R\->B #4d 2 \->LIST  SUB 9 SF END GOR
           IF 9 FS? THEN PICT x xd + 5 - R\->B  yp 1 GET 2 \->LIST 
             "..." 1 \->GROB GOR END
           9 SF
        END
 
        3 CF
 
        IF dflag  1 \=/  THEN

         DO 
          1 CF 2 SF calpt EVAL 'pt' STO 
          WHILE 1 FC? REPEAT 
            PICT pt 
            IF 2 FS? THEN cursOR1 2 CF ELSE cursOR0 2 SF END REPL 
            IF KEY THEN 1 SF END 
          END 
          PICT pt cursOR0 REPL 1 CF 'k' STO
          
          IF 9 FS? THEN
             PICT x 4 + R\->B yp 1 GET 2 \->LIST xd 6 - R\->B #5d BLANK REPL 9 CF
          END
 
          IF k 105 \=/ THEN 
            
            IF k 45 == pd SIZE AND THEN 
              0 \-> dx \<< 
                
                IF pd DUP SIZE DUP SUB "." == THEN 3 CF END pd pd SIZE
                DUP SUB 1 \->GROB SIZE DROP B\->R 'dx' STO 
                IF lx dx - x 2 + < THEN 
                  
                  IF yi 1 == THEN 
                    PICT x 2 + R\->B y y1 + R\->B 2 \->LIST gl gl SIZE 
                    GET REPL gl 1 gl SIZE 1 - SUB 'gl' STO pxl pxl 
                    SIZE GET 'lxl' STO pxl 1 pxl SIZE 1 - SUB 'pxl' 
                    STO yn 'yi' STO lxl yi GET 'lx' STO 
                  ELSE 
                    'yi' 1 STO- lxl yi GET 'lx' STO 
                  END 
                  
                END 
                lx dx - 'lx' STO PICT lx R\->B yp yi GET 2 \->LIST dx 
                R\->B #5d BLANK REPL pd 1 pd SIZE 1 - SUB 'pd' STO 
              \>> 
            ELSE 
              
@ for hp49g, <|  Key restart input
              IF k 34 == THEN 
                "" 'pd' STO PICT x 2 + R\->B y y1 + R\->B 2 \->LIST xd
                4 - R\->B yn 6 * R\->B BLANK REPL 1 'yi' STO x 2 + 
                'lx' STO lxl0 'lxl' STO {} 'pxl' STO {} 'gl' STO 3 CF 
              ELSE 
                
                IF k 95 == THEN 
                  
                  IF aon NOT THEN 
@                  x  y  xd  yn ds bflag dflag cflag                    
                    IF 6 FS? THEN x 2 + y 2 + xd 1 cint 1 0 0  MORE48D  END 
                  ELSE 
                    
                    IF 7 FS? THEN 
                      IF x 72 + 130 > THEN 60 ELSE
                      x 2 + END 2 70 6 "INSTRG FUNCTIONS:" 0 {"CANCEL"
                      "WHAT I TYPE SO FAR" "VIEW PROMPT STRING" } POPM 'IP0' STO
                      IF IP0 1 \=/ THEN 
                        
                        IF IP0 2 == 6 FS? AND THEN 
                          x 2 + yp 1 GET B\->R 1 + xd 2 pd 1 0 0  MORE48D 
                        ELSE 
                          
                          IF IP0 3 == 6 FS? AND THEN 
                            x 2 + y 2 + xd 1 cint 1 0 0  MORE48D 
                          ELSE 
                            
@                            IF ip0 4 \>= THEN 
@                             PICT pt sc ip0 3 - GET 1 \->GROB GOR 'pd' 
@                              sc ip0 3 - GET STO+ sc ip0 3 - GET updlx 
@                              EVAL 
@                            END 
                            
                          END 
                          
                        END 
                        
                      END 
                      
                    END 
                    
                  END 
                  
                ELSE 
                  
                  IF k 103 == THEN 
                    
                    IF aon NOT 3 FC? AND aon OR THEN 
                      PICT pt "." 1 \->GROB GOR 'pd' "." STO+ "."
                      updlx EVAL 3 SF 
                    END 
                    
                  ELSE 
                    
                    IF k 62 == aon NOT AND THEN 
                      
                      IF pd "" == THEN
                        PICT pt "-" 1 \->GROB GOR 'pd' "-" STO+ "-"
                        updlx EVAL 
                      END 
                      
                    ELSE 
                      
                      IF k 104 == aon AND THEN 
                        PICT pt " " 1 \->GROB GOR 'pd' " " STO+ " "
                        updlx EVAL 
                      ELSE 
                        
                        IF aon THEN 
                          
                          IF k  ISALPHA  THEN 1 SF END 
                        ELSE 
                          
                          IF k  ISNUM  THEN 1 SF END 
                        END 
                        
                        IF 1 FS? THEN
                          CHR 'k' STO PICT pt IF aon 2 == THEN "*" ELSE k END 1 \->GROB GOR
                          'pd' k STO+ k updlx EVAL 
                        END 
                        
                      END 
                      
                    END 
                    
                  END 
                  
                END 
                
              END 
              
            END 
            
          END 
          
         UNTIL k 105 == END
            
         IF aon THEN
           IF pd "" \=/ THEN
             pd
           ELSE
             IF ival 0 SAME NOT THEN
                ival
             ELSE
                pd
             END
           END 
         ELSE 
          
           IF pd "" == pd "-" == OR pd "." == OR pd "-." == OR THEN
              IF ival 0 SAME NOT THEN
                ival
              ELSE 
                0
              END 
           ELSE 
              pd STR\-> 
           END 
          
         END 
         IF dflag 2 \=/ THEN 
            IF bflag THEN
              PICT xb yb 2 \->LIST
            ELSE
              PICT x 2 + R\->B y 2 + R\->B 2 \->LIST
            END
            g REPL 
         END
        ELSE
         g
        END

        fs STOF 
      \>> 
    \>> 
  \>> 
\>> 


















