program XTRFIL,1.1(111) ! test/demo XTREE.sbr using file input ! !-------------------------------------------------------------------- ! EDIT HISTORY ![101] 01-Mar-98 Created /jdm ![102] 25-Aug-00 Support TAB, Left Arrow, function key exits /jdm ! !Version 1.1- ! ![103] June 24, 2004 02:13 PM Edited by Jack ! Get title line from first line of file; use new flag 8192 ! (alternate coordinate system) ![104] July 24, 2004 12:52 PM Edited by Jack ! Use XTREE.MAP symbols, ++PRAGMA ERROR_IF_NOT_MAPPED ![105] July 26, 2004 11:40 AM Edited by jack ! Add logic to check if first line of file uses simple or ! advanced syntax ![106] August 27, 2004 04:14 PM Edited by Jack ! Allow multi-select (898-2+) ![107] September 07, 2004 01:37 PM Edited by Jack ! Implement new index (FILIDX); this creates an index into the ! sequential file so that we can locate the selected item(s) ! using MIAMEX,MX'FILEPOS. Note that to specify FILIDX we had ! to specify XTRCTL, which changed some default settings. ! ESC from XTREE now exits program. ![108] September 22, 2004 05:20 AM Edited by Jack ! Support XTF_FILANS flag; expand answer array from 500 to 1000 ![109] May 28, 2008 04:23 PM Edited by joaquin ! Add option to add additional COLDEF; modernize symbols, includes ![110] February 23, 2009 03:46 PM Edited by jacques ! Minor aesthetic cleanup; chg tprint back to print; only display ! first 50 items of answer array (to avoid screen confusion) ![111] augusto 08, 2010 12:42 PM Edited by jacques ! Add test of XTROP_DELSEL !------------------------------------------------------------------- ++PRAGMA ERROR_IF_NOT_MAPPED "ON" ! (avoid stupid unmapped symbol errors) ++include ashinc:XTREE.MAP ++include ashinc:XTREE.DEF ++include ashinc:ASHELL.DEF MAP1 TEXT,S,256 !MAP1 ANSWER,F ! not used in this mode MAP1 EXITCODE,F MAP1 MAXCHOICE,F,6 ! now determined dynamically from file MAP1 SROW,F MAP1 SCOL,F MAP1 TROW,F MAP1 ECOL,F MAP1 EROW,F MAP1 COLDEF,S,300 ! [109] MAP1 i,f MAP1 FILE$,S,25 MAP1 FLAGS,F,6 ! [2] MAP1 X,F MAP1 PLINE,S,256 MAP1 FILIDX,B,4 ! [107] MAP1 CH,F,6,9 ! [107] MAP1 MSEL$,S,1 ! [106] MAP1 FILANS$,S,1 ! [108] MAP1 DELSEL$,S,1 ! [111] MAP1 AC$,S,1 ! [109] ! [106]... MAP1 ANSWERX ! ANSWERX may be used now for either: MAP2 ANSARY(1000),S,1 ! multi-selection [108] was 500 MAP1 ANSWER,B,4,@ANSWERX ! or single selection MAP1 ANSWER$,S,1000,@ANSWERX ! (convenient string format for display) [108] MAP1 MAXARY,F,6,1000 ! [107][108] was 500 MAP1 SELROW,F,6 ! [107] MAP1 I,F ! [107] ! !Colors: 0=blk,1=wht,2=blu,3=mag,4=red,5=yel,6=grn,7=cyan MAP1 MMOCLR ! HELP memo colors MAP2 BFCLR,B,1,3 ! border fg MAP2 BBCLR,B,1,2 ! border bg MAP2 TFCLR,B,1,0 ! text fg MAP2 TBCLR,B,1,1 ! text bg MAP2 AFCLR,B,1,3 ! arrows fg MAP2 ABCLR,B,1,2 ! arrows bg MAP2 PFCLR,B,1,-1 ! prompt fg MAP2 PBCLR,B,1,-1 ! prompt bg MAP2 WFCLR,B,1,5 ! warnings & messages fg MAP2 WBCLR,B,1,0 ! " " " bg MAP2 SFCLR,B,1,-1 ! orig. status line fg MAP2 SBCLR,B,1,-1 ! orig. status line bg MAP2 RFCLR,B,1,-1 ! ruler/reserved fg MAP2 RBCLR,B,1,-1 ! ruler/reserved bg FLAGS = 0 FLAGS = FLAGS or XTF_FKEY ! [104] allow F1-F16 FLAGS = FLAGS or XTF_LEFT ! [104] allow LEFT arrow exit FLAGS = FLAGS or XTF_RIGHT ! [104] " RIGHT FLAGS = FLAGS or XTF_UP ! [104] " UP FLAGS = FLAGS or XTF_TAB ! [104] " TAB FLAGS = FLAGS or XTF_FCOLDEF ! [104] col defs in file FLAGS = FLAGS or XTF_XYXY ! [104] alternate coordinate sys FLAGS = FLAGS or XTF_SORT ! [104] allow sorting FLAGS = FLAGS or XTF_REORD ! [104] allow reordering XTR'USETHEMES = 1 LOOP: ? tab(-1,0);"Test XCALL XTREE using FILE input (hit ENTER for defaults)" if (FLAGS and XTF_XYXY) then ! explicit upper left, lower right... ! input "Enter SROW,SCOL,EROW,ECOL: ",SROW,SCOL,EROW,ECOL if SROW=0 SROW=8 if SCOL=0 SCOL=20 if EROW=0 EROW=14 if ECOL=0 ECOL=50 else ! in original system, SROW & SCOL were a position in ! middle of box (lining up with prompt); other 2 ! coordinates were top and bottom row, with end column ! determined dynamically input "Enter ROW: ",SROW input "Enter COL (min 20): ",SCOL EROW=2 : ECOL=21 ! endif GETFIL: ? " (Note: first line of file must contain column spec) " input line "Enter FILE [xtrfil.seq]: ";FILE$ if FILE$="" FILE$="xtrfil.seq" X = instr(1,FILE$,".") if X < 1 then FILE$ = FILE$ + ".seq" ! [105] check if file exists and if first line uses simple ! [105] or advanced syntax. lookup FILE$,X if X=0 ? FILE$;" not found! " : goto GETFIL open #1, FILE$,input input line #1, PLINE if instr(1,PLINE,"~~") > 0 then FLAGS = FLAGS or XTF_COLDFX ? "Columns appear to be defined using advanced COLDEF syntax" ! [109]-- input "Do you want to add additional COLDEF features? ",AC$ if ucs(AC$)="Y" then input line "{-skip}[+|=]{0~0~x~H~...~~}: ",COLDEF endif ! --[109] endif close #1 input "Multi-select? [N] ",MSEL$ ! [106] if ucs(MSEL$)#"Y" then ! [108] input "Use ANSWER to set/return selection? [N] ",FILANS$ ! [106] if ucs(FILANS$)="Y" FLAGS = FLAGS or XTF_FILANS ! [108] else ! [111] FLAGS = FLAGS or XTF_MSEL ! [106] input "Test XTROP_DELSEL? [N] ",DELSEL$ ! [111] if ucs(DELSEL$)="Y" then ! [111] FLAGS = FLAGS or XTF_MODELESS ! [111] endif ! [111] endif LOOP2: ? tab(EROW+1,1);tab(-1,10); ! [111] clear previous messages xcall XTREE,SROW,SCOL,ANSWERX,TEXT,10,COLDEF,EXITCODE,EROW,ECOL, & FLAGS,FILE$,MMOCLR,XTRCTL,FILIDX ! [106] change ANSWER to ANSWERX ! [107] add XTRCTL(empty),FILIDX ? TAB(EROW+1,1);tab(-1,10); print "TEXT: >";TEXT;"<" print "EXITCODE = ";EXITCODE;" XROW = "; XTR'XROW if EXITCODE=1 then ? tab(-1,0);"End" END ! [107] quit on ESC endif if (FLAGS and XTF_MSEL) then print "ANSARY: ";ANSWER$[1,150];"..." SELROW = 0 ! [107] scan ANSARY for first selection I = 0 do while I < MAXARY I = I + 1 if ANSARY(I)="1" then SELROW = I if ucs(DELSEL$)="Y" then ! [111] try deleting/hiding XTR'OPCODE = XTROP_DELSEL ! [111] the selected rows endif EXIT endif loop ? "First selected row = ";SELROW if SELROW > 0 then ! [107] fetch 1st selected row from file using index... open #CH, FILE$, input xcall MIAMEX,MX_FILEPOS,CH,1,SELROW,FILIDX if SELROW = -1 then print "FILIDX seek error (FILIDX=";FILIDX;", SELROW=";I-1;")" else print "First selected row: "; input line #CH, PLINE print PLINE endif close #CH endif else print "ANSWER: ";ANSWER ! [102] endif ? tab(22,1); STOP goto LOOP2