%%HP: T(3)A(R)F(.);
@
@ Pop up window display routine S.Lui 9/8/94
@ POPM Plus 7/8/97 
@ Inputs : c ix gb pdir par prg   x y xs yn t l nlist  
@	   x		- x-coordinate of upper left corner of window
@                         If x is POSITIVE, then input list is
@                            x y xs yn t l nlist
@                         If x is NEGATIVE, then input list is
@                            c ix gb pdir par prg  x y xs yn t l nlist  
@                         This is for compatibility with the previous version.
@                         Important : Note the parameter order.
@
@	   y		- y-coordinate of upper left corner of window
@	   xs		- horizontal length in pixels of window
@	   yn		- number of rows of display data (maximum=6)
@	   t		- window title
@	   l		- zero if display list elements are not lists themseleves,
@			  otherwise it indicates the element number of the list 
@			  element to be displayed.
@	   nlist	- display list
@  ----- POPM Plus inputs -----
@          c            - control flag
@                       0 : 'normal' operation. The pop up window is created,
@                           displayed, and removed upon exit.  The underlying
@                           image is restored. The list is display starting at
@                           index #1.
@                       1 : draws frame and blanks lines, and exits.  The 
@                           # of lines to blank is yn. The underlying grob is
@                           returned.
@                       2 : draws frame; displays list starting at index #1;
@                           and exits.  If list is {}, yn lines are blanked.
@                           The underlyng grob is returned.
@                       3 : display list starting at ix, and exits. If number of
@                           list items is <= yn, the underlying grob
@                           'gb' is redrawned, and the frame is redrawned.
@                           gb is returned.
@                       4 : input selection, with ix as last item selected.
@                           if 'pdir'and 'prg' are specified, the program is 
@                           executed.
@                       5 : same as 0, except the pop up window is not removed.
@                           outputs: underlying grob index_of_item_selected
@
@          ix           -   index of list item to be highlighted.  
@                           ix indicates the last highlighted item in the list
@                           from the previous call to popm.
@          gb           -   the underlying grob object, used only when c = 3.
@          pdir         -   directory path of an application program to execute
@                           when the first page is displayed; and when a list
@                           item is highlighted; and when popm exits.
@          par          -   parameter data to pass to the program 'prg'.
@          prg          -   general program to handle the initialization, 
@                           main process, and cleaning up.  The inputs to be
@               passed to 'prg' are :
@               1. initialization - par 0 0 1
@               2. main routine   - par nlist index_of_item_hilited 2
@               3. finish up      - par 0 0 3
@               Note: 'prg' should have a CASE statement to handle all 3 routes.
@
@ Outputs : index number of the element in the display list selected
@
@ Notes : help function key (+) is active in this routine.
@         Applications should call popm with c=1 or c=2 initially to store
@         the grob which should be used for replacing the popm area throughout
@         the application existence as needed.  
@
\<< RCLF 0 0 0 0 {HOME URPLUI} 0 {} 0 0 
    \-> x y xs yn t l nlist   fs yy k f1 yn0 udir byg glst idx idy \<<
     IF x 0 < THEN x ABS 'x' STO ELSE 0 0 0 {} 0 0 END \->
     c ix gb pdir par prg \<<

    7 CF IF c 5 == THEN 7 SF 0 'c' STO END

    8 CF
    IF c 3 == nlist SIZE yn \<= AND THEN
      PICT x R\->B y R\->B 2 \->LIST gb REPL 8 SF
    END

    yn 'yn0' STO
    IF nlist {} \=/ THEN yn nlist SIZE MIN 'yn' STO END

    x R\->B y R\->B 2 \->LIST x xs + R\->B y yn 1 + 8 * +
    R\->B 2 \->LIST  PICT x R\->B y R\->B 2 \->LIST 
    x xs + R\->B y yn0 1 + 8 * + R\->B 2 \->LIST SUB 

    x xs 5 - +  DUP 'idx' STO  R\->B y 1 + DUP 'idy' STO R\->B 2 \->LIST 
    BBOX {#0d #0d} xs 2 - R\->B #6d 2 \->LIST SUB 
    \-> c1 c2 g pt1 bbx \<<

    IF 8 FS? THEN gb 'g' STO END

@   Draw frame: box,lines and title
    IF c 3 < 8 FS? OR THEN
      PICT c1 xs R\->B yn 1 + 8 * R\->B BLANK REPL
      c1 c2 BOX
      1 yn FOR i
        x R\->B y i 8 * + R\->B 2 \->LIST
        x xs + R\->B y i 8 * + R\->B 2 \->LIST LINE
      NEXT
      PICT x 1 + R\->B y 1 + R\->B 2 \->LIST bbx GOR
      9 CF PICT x 2 + R\->B y 1 + R\->B 2 \->LIST t 1 \->GROB DUP SIZE 'yy' STO 
      B\->R IF xs 9 - > THEN {#0 #0} xs 16 - R\->B yy B\->R 1 - R\->B 2 \->LIST SUB 9 SF END
      GXOR
      IF 9 FS? THEN PICT x xs + 12 - R\->B y 1 + R\->B 2 \->LIST "..." 1 \->GROB GXOR END
    END

    IF c 4 == THEN 
      ix 1 - yn / IP IF DUP nlist SIZE 1 - yn / IP \=/ THEN 1 + yn * ELSE 
      DROP nlist SIZE END   ix 1 - yn / IP
    ELSE
      IF c 3 == THEN
       ix 1 - yn / IP yn *    ix 1 - yn / IP
      ELSE
       0 0 
      END 
    END
    \-> di pg \<<
    2 CF 3 CF 4 CF
    DO
    IF c 4 == 3 FC? AND NOT THEN
@    Blank the yn boxes
     1 yn FOR i
      PICT x 1 + R\->B y i 8 * + 1 +  R\->B 2 \->LIST xs 1 -
      R\->B #7d BLANK REPL
     NEXT
     PICT pt1 BBOX {#0d #0d} {#4 #5} SUB REPL  
    END
    1 CF 
    IF c 4 == 3 FC? AND THEN
      ix 1 - yn / IP IF nlist SIZE 1 - yn / IP \=/ THEN yn  ELSE 
      nlist SIZE 1 - yn / FP yn * 1 + END 
    ELSE 0 END \-> si0 \<<
    IF c 4 == 3 FC? AND c 1 == OR nlist {} == OR NOT THEN
@    Display text lines
     11 CF
     DO
      'di' INCR IF nlist SIZE \<= THEN
         'si0' INCR IF yn \<= THEN 
	    9 CF PICT x 2 + R\->B y si0 8 * + 2 + R\->B 2 \->LIST
	    nlist di GET IF l THEN l GET END 1 \->GROB DUP SIZE 'yy' STO 
                  B\->R IF xs 4 - > THEN {#0 #0} xs 11 - R\->B yy B\->R 1 - R\->B 2 \->LIST SUB 9 SF END
                  GOR 
                  IF 9 FS? THEN PICT x xs + 7 - R\->B y si0 8 * + 2 + R\->B 2 \->LIST "..." 1 \->GROB GOR END
         ELSE
	    'di' DECR DROP 'si0' DECR DROP 1 SF
	    PICT pt1 DUP2 BBOX {#0d #0d} {#4 #5} SUB REPL PTL GXOR 
         END
       ELSE
         'di' 1 STO- 1 SF
         PICT pt1 DUP2 BBOX {#0d #0d} {#4 #5} SUB REPL PTLE GXOR 11 SF
       END
     UNTIL 1 FS? END
@  determine grob list for input     
     IF 11 FS? THEN
       GROB 4 5 6040004060
     ELSE
       GROB 4 5 E0C080C0E0
     END
     GROB 4 5 F0D080D0F0
     2 \->LIST 'glst' STO

    END

@ flash title : only for c = 0 or c = 4.  Press any key to stop flashing
    IF c NOT c 4 == OR 4 FC? AND THEN
        5 CF 6 SF WHILE 5 FC? REPEAT
         PICT x 1 + R\->B y 1 + R\->B 2 \->LIST bbx GXOR
         IF  6 FS? THEN 6 CF ELSE 6 SF END 
         IF KEY THEN 5 SF DROP ELSE 'f1' INCR IF 10 == THEN 5 SF END END 
@        1 WAIT
        END
        IF 6 FC? THEN PICT x 1 + R\->B y 1 + R\->B 2 \->LIST bbx GXOR END
    END


    \<< \-> x y yi \<< PICT x 1 + R\->B y yi 8 * + 1 +  R\->B 
	2 \->LIST bbx GXOR \>>  
    \>> IF c 4 == 3 FC? AND c 3 == OR THEN ix 1 - yn / FP yn * 1 + ELSE 1 END \-> px si \<<
     IF 'MORE48D' VTYPE -1 == THEN 
      10 CF ELSE 10 SF END 
 
     IF c 4 == 3 FC? AND nlist {} == OR NOT THEN x y si px EVAL END  1 CF
     IF c 4 == THEN 3 SF END
     IF c NOT c 4 == OR THEN
      IF 4 FC? THEN
        IF pdir {} \=/ THEN 0 0 BUSY 'byg' STO pdir EVAL par 0 0 1 prg EVAL udir EVAL byg 0 BUSY END
      END
      4 SF
      IF pdir {} \=/ THEN 0 0 BUSY 'byg' STO pdir EVAL par nlist pg yn * si +  2 prg EVAL udir EVAL byg 0 BUSY END
      DO
@     xp yp tw rflag xs ys glst
        idx idy  1 0 4 5 glst DSPGRBIN  'k' STO
        CASE
          k 104 == THEN
            
            IF 10 FS? THEN
              x 2 + y si 8 * + 2 + xs 1 nlist pg yn * si + GET IF l THEN l GET END IF DUP TYPE 2 \=/ THEN \->STR END 1 0 0 MORE48D
            END
          END
          k 54 == THEN
            IF 10 FS? THEN 
             x 2 + y 2 + xs 1  t  1 0 0 MORE48D END
          END
	  k 25 == THEN
	    x y si px EVAL 'si' 1 STO- IF si 0 == THEN si0 'si' STO END
	    x y si px EVAL 
            IF pdir {} \=/ THEN 0 0 BUSY 'byg' STO pdir EVAL par nlist pg yn * si +  2 prg EVAL udir EVAL byg 0 BUSY END
          END
	  k 35 == THEN
	    x y si px EVAL 1 'si' STO+ IF si si0 > THEN 1 'si' STO END
	    x y si px EVAL 
            IF pdir {} \=/ THEN 0 0 BUSY 'byg' STO pdir EVAL par nlist pg yn * si +  2 prg EVAL udir EVAL byg 0 BUSY END
          END
	  k 34 == THEN
	    IF di si0 - yn \>= THEN di si0 - yn - 'di' STO 1 SF 'pg' DECR 
	    DROP END
          END
	  k 36 == THEN
	    IF nlist SIZE di - 0 > THEN 'pg' INCR DROP 
	    ELSE
	       0 'di' STO 0 'pg' STO 
	    END  1 SF
          END
	  k 105 == THEN
            IF pdir {} \=/ THEN 0 0 BUSY 'byg' STO pdir EVAL par 0 0 3 prg EVAL udir EVAL byg 0 BUSY END
	    IF c 4 \=/ THEN 
              IF 7 FC? THEN
               PICT c1 g REPL 
              ELSE g END
            END
            1 SF 2 SF pg yn * si +
          END
	  k 95 == THEN
                  {" " " " " " " " " " "T" " " "+"}
                  {"UP: UP ONE LINE"
                   "DOWN: DOWN ONE LINE"
                   "<| : BACK PAGE"
                   "|> : NEXT PAGE"
                   "ENTER: SELECT/EXIT"
                   "VIEW TITLE IN DETAIL"
                   "SPC: VIEW SELECTED LINE IN DETAIL"
                   "POPM COMMAND HELP"} CMDHELP
	  END
        END 
      UNTIL 1 FS? END 
     ELSE
       2 SF g
     END
    \>> \>>
    UNTIL 2 FS? END
    \>> \>> fs STOF
    \>>
\>>    
\>>    

