home *** CD-ROM | disk | FTP | other *** search
/ hobbes.nmsu.edu / 2008-06-02_hobbes.nmsu.edu.zip / new / time4z12.zip / TZ.CMD < prev    next >
OS/2 REXX Batch file  |  2008-05-29  |  53KB  |  1,376 lines
  1. /* Time-4-Z Scheduler Front End version 1.2 - Plain OS/2 REXX plus REXXUTIL */
  2. /* for the Z! text-mode MP3 player by dink, http://dink.org/z/ */
  3. /* begun 11-16-2006; first recording 11-28-2006
  4.    v0.9 spooling to RAM, much clean up and improvement 04-05-2007
  5.    function key favorites; improvement? well, broke nothing obvious 12-21-2007
  6.    v1.0 merged file selector for browse mode 12-27-2007
  7.    v1.1 CLEAR frees up space; file selector less lag, help neater 03-12-2008
  8.    QUERY SWITCH LIST (duh, was in rexxutil) to check z IS running 03-21-2008
  9.    v1.2 MAX strategy limits size of save_path dir 04-08-2008
  10.    Probably fixed MAX strategy bug of exiting on failed stream 05-28-2008
  11. */
  12.  
  13. /* PROBLEM: Saturday sched twice now left Z running on wrong station!
  14.    0423: Attempting to fix with sleep in z_quit.
  15.    0529: Not seen since, but not certain of fix. Dead time between events may
  16.      be needed...
  17.    BUG REPORTS to ddan@cableone.net or to ddan on os2world.com forum */
  18.  
  19. /* ideas that seem less important the longer I go without implementing...
  20. - copy playlists to ramdisk so never need to spin up HD
  21. */
  22.  
  23. call rxfuncadd 'SysLoadFuncs','RexxUtil','SysLoadFuncs'
  24. call sysloadfuncs
  25. Call SysCurState 'OFF'
  26. call syscls
  27.  
  28. /* style point, spacing of "=": 'var=' indicates assignment, 'var =' test */
  29.  
  30. /* ANSI screen color thanks to someone, modified */
  31. black= 0; red= 1; green= 2; yellow= 3; blue= 4; magenta= 5; cyan= 6; white= 7;
  32. fgnd= 30         /* add color: 30 + 2= 32 ==> green foreground */
  33. bgnd= 40         /* add color: 40 + 7= 47 ==> white background */
  34. AEsc= '1B'x || '['  /* define ANSI-Escape; + 0 = low, 1 = high int*/
  35. l_wh_bk= AEsc||'0;'||fgnd + white||';'||bgnd + black||'m'
  36. l_bk_wh= AEsc||'0;'||fgnd + black||';'||bgnd + white||'m'
  37. call charout, l_wh_bk /* ensure low white on black esp after testing */
  38.  
  39. /* codes for most useful keys; see ex_read_key */
  40. zky= x2c('00') /* prefix for some extended keys */
  41. xky= 'α' /* another prefix for some extended keys */
  42. k_esc= x2c('1b');  k_enter= x2c('0d');  k_backspace= d2c(8);  k_tab= d2c(9);
  43. k_up= 'αH';      k_down= 'αP';    k_left= 'αK';    k_right= 'αM';
  44. k_ins= 'αR';     k_del= 'αS';     k_home= 'αG';    k_end= 'αO';
  45. k_pgup= 'αI';    k_pgdn= 'αQ';
  46. k_cleft= 'αs';   k_cright= 'αt';  k_cup= 'α'||d2c(141);  k_cdn= 'α'||d2c(145);
  47. k_f1= zky||';';  k_f2= zky||'<';  k_f3= zky||'=';  k_f4= zky||'>';
  48. k_f5= zky||'?';  k_f6= zky||'@';  k_f7= zky||'A';  k_f8= zky||'B';
  49. k_f9= zky||'C';  k_f10= zky||'D'; k_f11= zky||d2c(133);  k_f12= zky||d2c(134);
  50. fkeys= k_f1||k_f2||k_f3||k_f4||k_f5||k_f6||k_f7||k_f8||k_f9||k_f10||k_f11||k_f12
  51.  
  52. /* these VARs are pretty much CONSTANTS */
  53. splash= d2c(22)||' Time4Z by DGD -- Front-end scheduler for Dinks Z v1.2'
  54. sched_path= 'C:\TZ12\'
  55. sched_name= sched_path||'TZ.SCH'
  56. home_dir= sched_path||'favored\'
  57. zwindowtitle= 'Z for named pipe'
  58. numday= 'SunMonTueWedThuFriSat'
  59. pipe_to= ' 1>\pipe\zmp3' /* the "1" refers to stdout; here for info because
  60.   highly confusing when REXX changes literal " > \pipe\zmp3" to this anyway */
  61. legend.1= d2c(205)||' MP3s in dir' /* change graphics key chars HERE */
  62. legend.2= d2c(240)||'  └─ & random'
  63. legend.3= d2c(175)||' Stream'
  64. legend.4= d2c(247)||'  └─ & random'
  65. legend.5= d2c(254)||' Record'
  66. secsaday= 86400 /* seconds a day */
  67.  
  68. /* this section of VARs are semi-constant seldom changed */
  69. save_path= sched_path /* just to set other than nil */
  70. clear= 0 /* CLEAR flag */
  71. maxsp= 0 /* MAX space: set from keyword in TZ.SCH */
  72. save_interval= 0
  73. slin.0= 0 /* schedule file, 0 holds # of lines read */
  74. show.0= '' /* 24x60 "array" for display. Initialized here only for info. */
  75. ref.0= '' /* similar to above, holds reference to line numbers of tz.sch */
  76. pl.0= 0 /* playlist */
  77.  
  78. /* following actually change */
  79. curlin= '' /* current line running of tz.sch; when \= the character of */
  80.   /* pseudo-array ref.[hour, minute], then some action is needed */
  81. startday= ''
  82. curact= ''
  83. sleeptime= 1
  84. refc= d2c(255) /* just to ensure \= to curlin */
  85. last_message= '' /* avoids some tangles knowing which stream is playing */
  86. interval= secsaday /* yet another kludge tacked on along with below */
  87. split= secsaday /* time in seconds to split recordings */
  88. looptime= 0  /* counts seconds to change random streams or split recordings */
  89. move2= '' /* flag, set to dtfn formed below, without paths */
  90. ready2move= '' /* 2nd flag, preserving if started writing another file */
  91. rrst= ''
  92. writing= 0
  93.  
  94. /* start File Selector specific */
  95. parse value systextscreensize() with scry scrx
  96. scry= scry - 1; scrx= scrx - 1; /* adj to 0, 0 based values */
  97. numeric digits 12 /* necessary to display bytes of gigabytes */
  98. glo_var= 'dirlist.'
  99. dircolr= AEsc||'0;'||fgnd + white||';'||bgnd + black||'m' /* directory */
  100. revcolr= AEsc||'0;'||fgnd + black||';'||bgnd + white||'m' /* reversed */
  101. ansi_clreol= AEsc||'K'
  102. /* end File Selector specific */
  103.  
  104. call protect sched_path
  105.  
  106. do forever
  107.   if startday \= date('S') then do /* 1st run or passed midnight */
  108.     startday = date('S')
  109.     call read_file
  110.     call syscls
  111.     call interp_sched
  112.     call message splash
  113.     call show_sched
  114.   end
  115.   key = ''
  116.   if chars()>0 then do
  117.     key= ex_read_key()
  118.     n= pos(key, fkeys) /* to convert rather random scan codes into simple # */
  119.     select
  120.       when n > 0 then do /* F1-F12 keys choose from favorite streams */
  121.         call select_stream (n + 1) / 2
  122.       end
  123.       when (key = k_tab) & (writing = 0) then do /* if not recording, browse */
  124.         call syscls
  125.         call run_browse_mode
  126.         call protect sched_path /* in case of sched change during browse... */
  127.         call syscls
  128.         call show_sched
  129.       end
  130.       when key = k_backspace then do /* re-start, re-read TZ.SCH */
  131.         startday = ''
  132.         curlin= '0'
  133.       end
  134.       when key = 'h' | key = 'H' then do
  135.         call show_help
  136.         call syscls
  137.         call show_sched
  138.       end
  139.       when key = '`' then do  /* Refresh attempt for stream errors... */
  140.         curlin= '0' /* triggers "new action" below; stops writing, quits z */
  141.         if curact = 'REC' then split= secsaday
  142.       end
  143.       when key = '~' then do /* "Rem out" the current action to STOP it */
  144.         curlin= '0' /* triggers "new action" below */
  145.         refc= c2d(value('refc')) /* un-de-code the line # */
  146.         slin.refc= '~'||slin.refc /* add tilde; remove to restore line... */
  147.         call interp_sched /* and start over with that line being skipped */
  148.       end
  149.       otherwise select /* available commands vary with current action */
  150.       when curact = 'RST' then do /* only this or "otherwise" at present... */
  151.         key= translate(key)
  152.         select
  153.           when key = 'R' then do /* Random... */
  154.             call z_quit
  155.             call syssleep 1
  156.             if save_interval > 0 then do /* restore to normal after a Stay */
  157.               interval= save_interval
  158.               save_interval= 0
  159.             end
  160.             call random_stream
  161.           end
  162.           when key = 'S' then do /* Stay on station (for rest of day) */
  163.             save_interval= interval
  164.             interval= secsaday
  165.           end
  166.           otherwise nop
  167.         end /* RST key select */
  168.       end /* RST mode */
  169.       otherwise nop
  170.       end /* of mode-dependent select */
  171.     end /* outermost select */
  172.     looptime= 0 /* for now, any key resets timer */
  173.   end
  174.   else call syssleep sleeptime
  175.   if key = 'X' | key = 'x' then leave
  176.   now= time('N')
  177.   parse value now with ch ':' cm ':' cs
  178.   if pos('0', ch) = 1 then ch= delstr(ch, 1, 1)
  179.   if pos('0', cm) = 1 then cm= delstr(cm, 1, 1)
  180.   if pos(':00:00', now) = 3 then call show_sched /* hourly full refresh */
  181.   else if pos(':00', now) = 6 then do /* v1.1 EVERY MINUTE CHECK Z RUNNING */
  182.     call sysqueryswitchlist "windowlist.", 'd' /* Umm, lately discovered by */
  183.     zrunning= 0   /* accident this "new" function in standard rexxutil dll */
  184.     do w= 1 to windowlist.0  /* which allows simple (crude) monitoring. */
  185.       if pos(zwindowtitle, windowlist.w) > 0 then zrunning= 1
  186.     end  /* So, if stream errors cause Z to quit, this tries re-start(s). */
  187.     if zrunning = 0 & curact = 'REC' then do /* ONLY while recording. */
  188.       call syscurpos 22, 1
  189.       call charout, l_bk_wh||' !!! Z HAS APPARENTLY STOPPED! ATTEMPTING TO RE-START.'||l_wh_bk
  190.       call syscurpos 23, 1
  191.       curlin= '0'
  192.       split= secsaday
  193.     end
  194.     call syscurpos ch, 16  /* line refresh cleans up some garbage highlight */
  195.     call charout, show.ch  /*  chars left because of clock uncertainties */
  196.   end         /* below flashes cursor white on black */
  197.   if pos(substr(cs, 2, 1), '02468') > 0 then call charout, l_bk_wh
  198.   call syscurpos ch, cm + 19 /* offset on screen */
  199.   call charout, substr(show.ch, cm + 4, 1)
  200.   call charout, l_wh_bk
  201.   call syscurpos 23, 1
  202.   call charout, now
  203.   refc= substr(ref.ch, cm + 1, 1)
  204.   looptime= looptime + 1
  205.   /* CHECK IF NEW ACTION REQUIRED - (starts schedule even from middle) */
  206.   if (curlin \= refc) | (looptime > interval) | (looptime > split) then DO
  207.     interval= secsaday /* reset to max every pass through here */
  208.     if curlin \= '' then do /* presumably every time except very first */
  209.       if writing = 1 then do
  210.         call z_writetodisk ''
  211.         call message 'STOP writing...'
  212.         writing= 0
  213.         if move2 \= '' then do
  214.           call message 'Setting MOVE flag...'
  215.           ready2move= move2
  216.         end
  217.         else ready2move= ''
  218.       /* problem of missing a recorded segment seemed to occur right here */
  219.       /* possibly because drive has been spun down, so */
  220.         call syssleep 5  /* give system PLENTY of time to react... */
  221.       end /* writing */
  222.       if split = secsaday then do /* effect is DON'T quit Z if splitting */
  223.         call z_quit /* QUIT */
  224.         call message 'Telling Z to quit...'
  225.         call syssleep 3
  226.       end
  227.       move2= '' /* always set flag off */
  228.     end /* curlin \= '' */
  229.     /* REXX is just REPLETE with contortions; better explain this one to _me_*/
  230.     refc= c2d(value('refc')) /* refc is char = line #; convert it to _#_ */
  231.     curlin= slin.refc /* to refer to slin.# - curlin only a handy var here */
  232.     /* n.b. curlin= value('slin.'refc) looks more elegant, but doesn't work */
  233.     /* and tried other variations without success; the above works FINE */
  234.  
  235.     /* 2nd command because seems to not reliably QUIT after a stop writing */
  236.     if refc = 0 then do
  237.       call z_quit
  238.       call message 'No event scheduled; again sending QUIT to Z...'
  239.       call syssleep 3
  240.     end
  241.     kw= translate(left(curlin, 3)) /* vars duplicated from interp */
  242.     parse value word(curlin.ndx, 3) with sth ':' stm
  243.     dur= word(curlin, 4)
  244.     /* may be other parameters present, processed by each type */
  245.     remdr= right(curlin, length(curlin) - lastpos(':\', curlin) + 2)
  246.     /* the above depends on each key type specifying drive:\dir last */
  247.     select   /* start Z EVERY time; avoids problem when changing from */
  248.       /* stream to local; Z EXITS then anyway - see z_stream proc below */
  249.       /* seems streams can't use pipe, REQUIRE COMMAND LINE PARMS?! */
  250.       when kw= 'DIR' | kw= 'RND' then do
  251.         call z_start
  252.         if lastpos('\', remdr) <> length(remdr) then remdr= remdr||'\'
  253.         rc= sysfiletree(remdr||'*.MP3', "olist.", "FSO")
  254.         if kw= 'RND' then do /* randomize list; tougher than appears... */
  255.           m= olist.0  /* other methods tried were a bit less than random */
  256.           list.0= olist.0
  257.           do n= 1 to olist.0 - 1
  258.             r= random(1, m)
  259.             list.n= olist.r
  260.             do x= r to m - 1
  261.               y= x + 1
  262.               olist.x= olist.y
  263.             end
  264.             m= m - 1
  265.           end
  266.           n= olist.0
  267.           list.n= olist.1
  268.         end
  269.         else do  /* simulate the above kludge for a DIR */
  270.           do n= 0 to olist.0
  271.             list.n= olist.n
  272.           end
  273.         end
  274.         drop olist.
  275.         do n= 1 to list.0
  276.           call message 'Sending: '||list.n
  277.           list.n= '"'||list.n||'"'
  278.           call z_play list.n
  279.           call syssleep 3 /* hmm; is this enough time? */
  280.         end
  281.       end
  282.       when kw= 'STR' then do
  283.         call message d2c(22)||' Streaming: 'remdr
  284.         call z_stream remdr
  285.         call syssleep 3
  286.       end
  287.       when kw= 'RST' then do
  288.         interval= word(curlin, 5)
  289.         if datatype(interval) <> 'NUM' then interval= dur
  290.         interval= interval * 60 /* convert to seconds */
  291.         call get_playlists remdr
  292.         call random_stream
  293.       end
  294.       when kw= 'REC' then do
  295.         if pos('PATH', curlin) > 0 then do
  296.           i= pos('"', curlin) + 1
  297.           spool_path= substr(curlin, i, lastpos('"', curlin) - 1 - i)
  298.         end
  299.         else spool_path= save_path
  300.         if lastpos('\', spool_path) \= length(spool_path) then
  301.           spool_path= spool_path||'\'
  302.         if split = secsaday then do /* start only if 1st pass */
  303.           call z_stream remdr
  304.           call message 'Z should be buffering stream: 'remdr
  305.           call syssleep 3
  306.         end
  307.         if wordpos('SPLIT', curlin) > 0 then do
  308.           split= word(curlin, wordpos('SPLIT', curlin) + 1)
  309.           split= split * 60 /* seconds */
  310.         end
  311.         else split = secsaday
  312.         dtfn= substr(date('S'), 3, 6)||'_'||substr(time('N'), 1, 5)
  313.         dtfn= delstr(dtfn, 10, 1) /* keep name separate for easy MOVE */
  314.         if pos('MOVE', curlin) > 0 then move2= dtfn /* ^also a flag */
  315.         dtfn= spool_path||dtfn
  316.         call z_writetodisk dtfn
  317.         call message 'Z should start writing file 'dtfn
  318.         call syssleep 3
  319.         call message d2c(22)||' Recording: 'remdr
  320.         writing= 1
  321.       end
  322.     otherwise nop
  323.     end /* select RUN */
  324.     if ready2move \= '' then do /* FILE WAITING TO BE MOVED */
  325.     /* could get rid of clutter with "@" and ">nul", but I like to see... */
  326.       call syscls
  327.       say ' Moving recorded file - possibly clearing space - and cleaning up...'
  328.       rc= sysfiletree(spool_path||ready2move||'.MP3', vdl., 'F')
  329.       reqsp= word(vdl.1, 3) /* required space for current file */
  330.       if reqsp = '' then reqsp= 0 /* avoids crash at "do while" below */
  331.       /* v1.2 - MAX strategy supplements CLEAR by limiting directory size */
  332.       if maxsp > 0 then do
  333.         rc= sysfiletree(save_path||'\*.MP3', vdl., 'F')
  334.         used= 0
  335.         if vdl.0 > 0 then do  /* IF any files, total up directory size */
  336.           do f= 1 to vdl.0
  337.             used= used + word(vdl.f, 3)
  338.           end
  339.         end
  340.         say 'Used space in 'save_path' is: 'used' bytes; MAX is: 'maxsp'.'
  341.         f= 1 /* assumes #1 is the OLDEST file, true if all named by TZ.SCH */
  342.         do while (used + reqsp > maxsp) | (f > vdl.0)
  343.           'del 'right(vdl.f, length(vdl.f) - wordindex(vdl.f, 5) + 1)
  344.           f= f + 1
  345.           used= used - word(vdl.f, 3)
  346.           say 'Used space in 'save_path' is now: 'used' bytes.'
  347.           call syssleep 1
  348.         end
  349.       end
  350.       /* CLEAR space routine */
  351.       freesp= word(sysdriveinfo(substr(save_path, 1, 2)), 2)
  352.       say 'Free space is: 'freesp' bytes.'
  353.       if reqsp > freesp & clear = 1 then do /* delete (oldest) files */
  354.         rc= sysfiletree(save_path||'\*.MP3', vdl., 'F')
  355.         f= 1  /* PRESUMED oldest because ONLY MP3s created by TZ in dir */
  356.         do until (freesp > reqsp) | (f > vdl.0)
  357.           'del 'right(vdl.f, length(vdl.f) - wordindex(vdl.f, 5) + 1)
  358.           f= f + 1
  359.           freesp= word(sysdriveinfo(substr(save_path, 1, 2)), 2)
  360.           say 'Free space is now: 'freesp' bytes.'
  361.           call syssleep 1
  362.         end
  363.       end
  364.       drop vdl.
  365.       say  /* if enough files couldn't be deleted, copy fails normally... */
  366.       'copy 'spool_path||ready2move||'.MP3 '||save_path
  367.       'del 'spool_path||ready2move||'.MP3'
  368.       'del 'spool_path||ready2move||'.MP3.TXT'
  369.       ready2move= ''
  370.     end
  371.     if kw <> 'REC' then split= secsaday
  372.     curlin= substr(ref.ch, cm + 1, 1) /* now current line # for outer loop */
  373.     curact= kw
  374.     call syscls
  375.     call show_sched
  376.     call syscurpos 20, 1
  377.     call charout, 'Running # '||c2d(curlin)
  378.     looptime= 0
  379.   end /* curlin \= refc */
  380. end /* main loop */
  381. exit
  382.  
  383. run_browse_mode:
  384. rbm_quit= 0
  385. curpath= sched_path
  386. cursel= ''
  387. types= '*.MP3 *.WAV *.PLS *.M3U'
  388. do while rbm_quit = 0
  389.   rv= file_select(40, glo_var, curpath, types, '', cursel, 'N', 'M', '', 1)
  390.   rk= word(rv, 1)
  391.   if (rk = k_esc) | (rk = k_tab) then rbm_quit= 1
  392.   else do /* ■ */
  393.     call syscurpos 23, 1
  394.     call syssleep 1
  395.     remdr= right(rv, length(rv) - wordindex(rv, 4) + 1) /* remainder */
  396.     curpath= filespec("drive", remdr)||filespec("path", remdr)
  397.     cursel= filespec("name", remdr)
  398.     if pos('.', cursel) > 0 then
  399.       rt= translate(substr(cursel, lastpos('.', cursel), 4))
  400.     else rt= ''
  401.     select
  402.       when rk = k_enter & pos('.', rv) > 0 then do
  403.         call z_quit
  404.         call syscls
  405.         if rt = '.MP3' | rt = '.WAV' then do
  406.           call z_start
  407.           call message d2c(22)||' 'remdr
  408.           call z_play '"'||remdr||'"'
  409.         end
  410.         if rt = '.M3U' | rt = '.PLS' then do
  411.           call syssleep 2 /* without delay Z doesn't start up again, hmm */
  412.           call protect curpath
  413.           call message d2c(22)||' 'remdr
  414.           call z_stream remdr
  415.         end
  416.         call syssleep 1
  417.       end /* k_enter */
  418.       when rk = '\' then do /* make a new directory */
  419.         call syscurpos 1, 1
  420.         call charout, 'Make a new directory?'
  421.         call syscurpos 2, 1
  422.         call charout, 'Hit <enter> to exit without doing so.'
  423.         call syscurpos 3, 1
  424.         call charout, 'Make: '
  425.         parse pull newname .
  426.         if newname <> '' then do
  427.           curpath= strip(curpath, 'T', '\')
  428.           curpath= left(curpath, lastpos('\', curpath) - 1)
  429.           'mkdir 'curpath||newname
  430.           curpath= filespec("drive", remdr)||filespec("path", remdr)
  431.         end     /* ^ MUST restore curpath so shows same dir */
  432.         call syscls
  433.       end
  434.       when rk = k_home then do /* mark home directory */
  435.         rt= word(rv, 2) /* get index; check really is dir */
  436.         if (rt > 2) & (substr(dirlist.rt, wordindex(dirlist.rt, 4) + 1, 1) = 'D')
  437.           then home_dir= remdr||'\'
  438.       end
  439.       when (rk = k_ins) & (rt = '.M3U' | rt = '.PLS') then do
  440.         call syscurpos 1, 1                           /* copy IF playlist */
  441.         call charout, 'Copying playlist to '||home_dir
  442.         call syscurpos 2, 1
  443.         call charout, 'Just hit <enter> to use current name.'
  444.         call syscurpos 3, 1
  445.         call charout, 'Currently: '||cursel
  446.         call syscurpos 4, 1
  447.         call charout, 'Rename to: '
  448.         parse pull newname .
  449.         if newname = '' then newname= cursel
  450.           else newname= newname||rt
  451.         'copy "'||remdr||'" "'||home_dir||newname||'"'
  452.       end
  453.       when (rk = k_del) & (rt = '.M3U' | rt = '.PLS') then do
  454.         rc= SysFileTree(remdr, lists, 'FO', '****', '----')
  455.         'del "'||remdr||'"'
  456.         if length(word(rv, 3)) < 4 then do /* avoids bug when dir emptied */
  457.           curpath= strip(curpath, 'T', '\') /* at cost of possible confusion */
  458.           curpath= left(curpath, lastpos('\', curpath) - 1)
  459.           cursel= ''
  460.         end
  461.         call syscls
  462.       end
  463.       otherwise call beep 2000, 50
  464.     end /* select */
  465.   end /* not <esc> or <tab> */
  466. end /* rbm_quit */
  467. return
  468.  
  469. show_help:
  470. call syscls
  471. say ' Time 4 Z by DGD; (minimal) help...'
  472. say
  473. say ' X eXit, leaves "'zwindowtitle'" running (if it is); this is a feature'
  474. say
  475. say ' ` Attempts to refresh stream (for stream errors that cause Z to exit)'
  476. say ' ~ STOPS current action for the day (undo with <backspace>)'
  477. say ' <backspace> re-start; useful if TZ.SCH changed'
  478. say
  479. say ' <tab> switch to Browse mode (if not recording). Sub-commands:'
  480. say '   <enter> play a playlist or local file; interrupts any playing'
  481. say '   <home> sets where to copy playlists to; currently 'home_dir
  482. say '   <ins> copy playlist to home directory, optionally renaming'
  483. say '   <del> IMMEDIATELY deletes a playlist (.M3U or .PLS) but NO other files'
  484. say '   <tab> or <esc> returns to Scheduled mode'
  485. say '   \ (backslash) make a new directory'
  486. say '   <F1> help in File Selector; most important are lowercase a-z for drive'
  487. say
  488. say ' <F1> - <F12> are to be set up in TZ.SCH; if set, show left of number'
  489. say
  490. say ' These work only during Random STreaming:'
  491. say '   R select a new Random Stream'
  492. say '   S Stay on current stream (to end of day...)'
  493. say
  494. say ' Hit any key to resume, or wait 60 seconds...'
  495. n= 0
  496. do until (chars() > 0) | (n > 60)
  497.   call syssleep 1
  498.   n= n + 1
  499. end
  500. key= ex_read_key()
  501. return
  502.  
  503. ex_read_key: /* returns two bytes for extended codes */
  504.   xrkey= sysgetkey('noecho')
  505.   if xrkey = zky | xrkey = xky then xrkey= xrkey||sysgetkey('noecho')
  506. return xrkey
  507.  
  508. protect:
  509. /* SET read-only attributes which are NOT set on playlists under \TZ */
  510. /* This rather complex task turns out to be EASY to do ELEGANTLY in REXX! */
  511. parse arg m
  512. if substr(m, length(m), 1) \= '\' then m= m||'\'
  513. rc= SysFileTree(m||'*.PLS', lists, 'FSO', '***-','---+')
  514. drop lists.
  515. rc= SysFileTree(m||'*.M3U', lists, 'FSO', '***-','---+')
  516. drop lists.
  517. return
  518.  
  519. message:
  520.   parse arg m
  521.   m= left(m, 78) /* n.b. left() PADS with spaces, handy here */
  522.   call syscurpos 24, 1
  523.   call charout, m
  524.   last_message= m /* kludge for persistent messages, such as stream name */
  525. return
  526.  
  527. get_playlists: /* for random stream */
  528.   parse arg pld
  529.   if lastpos('\', pld) \= length(pld) then pld= pld||'\'
  530.   pld= pld||'*'
  531.   drop pl. /* clear any existing playlist */
  532.   rc= SysFileTree(pld, "pl.", "FO")
  533.   i= 1
  534.   do while i <= pl.0 /* get rid of any non-playlist */
  535.     fext= translate( right(pl.i, (length(pl.i) - lastpos(".", pl.i) + 1 )))
  536.     if fext <> '.M3U' & fext <> '.PLS' then do
  537.       do j= i to pl.0 - 1
  538.         k= j + 1 /* hmm; any other way to handle math on stem. index #s? */
  539.         pl.j= pl.k
  540.       end
  541.       drop pl.k
  542.       pl.0= pl.0 - 1
  543.     end
  544.     i= i + 1
  545.   end /* while */
  546. return
  547.  
  548. random_stream:
  549.   n= rrst
  550.   do until n \= rrst  /* so doesn't pick the current */
  551.     rrst= random(1, pl.0)
  552.   end
  553.   call message d2c(22)||' Random Stream: 'pl.rrst /* persistent message */
  554.   call z_stream pl.rrst
  555. return
  556.  
  557. /* attempts named pipe to not stop writing, despite apparent problem... */
  558. select_stream:
  559.   parse arg fkeyn
  560.   call message d2c(22)||' Selected Stream: 'favlist.fkeyn
  561.   call z_stream favlist.fkeyn
  562. return
  563.  
  564. read_file:
  565. if stream(sched_name, 'c', 'query exists') <> '' then do
  566.   say 'Reading schedule...'  /* KEEP ALL lines for easy reference in .sch */
  567.   ndx= 1
  568.   do until lines(sched_name) = 0 /* make some minor modifications to text */
  569.     tline= strip(linein(sched_name), 'B', ' ') /* filename case preserved */
  570.     p= pos(':', tline) /* remove lead zero from hour for later ease */
  571.     if p > 0 then if substr(tline, p - 2, 1) = '0' then
  572.       tline= delstr(tline, p - 2, 1)
  573.     p= pos(':', tline) /* remove lead zero from minutes for later ease */
  574.     if p > 0 then if substr(tline, p + 1, 1) = '0' then
  575.       tline= delstr(tline, p + 1, 1)
  576.     slin.ndx= tline
  577.     ndx= ndx + 1
  578.   end
  579.   ok= stream(sched_name, 'c', 'close')
  580.   slin.0= ndx - 1
  581. end /* file exists */
  582. else do
  583.   say 'Cannot find schedule file: 'sched_name
  584.   exit
  585. end
  586. return
  587.  
  588. init_scheds:  /* ref.23 used temporary for convenience */
  589. ref.23= '|'||copies('∙', 4)||d2c(179)||copies('∙', 4)||d2c(179)||copies('∙', 4)
  590. do l=0 to 23
  591.   show.l= l||' '||copies(ref.23, 4) /* copy 4 of quarter hour marks */
  592.   if (l<10) then show.l='0'||show.l
  593.   ref.l= copies(d2c(0), 60)
  594. end
  595. return
  596.  
  597. interp_sched:
  598. day= substr(date('W'), 1, 3)
  599. nd= (pos(day, numday) - 1) / 3 + 1 /* find a # 1-7 representing day */
  600. call init_scheds
  601. do ndx= 1 to slin.0
  602.   if pos('SAVEPATH', slin.ndx) = 1 then do  /* WILL CREATE IF DOESN'T EXIST */
  603.     save_path= right(slin.ndx, length(slin.ndx) - wordindex(slin.ndx, 2) + 1)
  604.     curdir= directory() /* must save start point */
  605.     rc= directory(save_path) /* changes TO if exists! */
  606.     call directory(curdir) /* change back on logged drive */
  607.     if rc= '' then do /* null means does not exist */
  608.       rc= sysmkdir(save_path)
  609.       if rc <> 0 then do
  610.         say 'Problem creating directory 'save_path
  611.         exit
  612.       end
  613.     end
  614.   end
  615.   if pos('CLEAR', slin.ndx) = 1 then do
  616.     clear = 1 /* SET FLAG TO CLEAR (OLDEST) FILES FROM SAVE_PATH */
  617.   end
  618.   if pos('MAX', slin.ndx) = 1 then do
  619.     maxsp= translate(word(slin.ndx, 2)) /* format 1.8G or 700M or 500000000 */
  620.     if maxsp = '' then maxsp= '1G'
  621.     m= substr(maxsp, length(maxsp), 1)
  622.     if (m = 'G' | m = 'M') then do
  623.       maxsp= left(maxsp, length(maxsp) - 1)
  624.       if m = 'G' then maxsp= maxsp * 1000000000
  625.       if m = 'M' then maxsp= maxsp * 1000000
  626.     end
  627.   end
  628.   kw= translate(left(slin.ndx, 3))
  629.   select /* set graphics char (from legend.) for pseudo-array show. */
  630.     when kw= 'DIR' then oc= substr(legend.1, 1, 1)
  631.     when kw= 'RND' then oc= substr(legend.2, 1, 1)
  632.     when kw= 'STR' then oc= substr(legend.3, 1, 1)
  633.     when kw= 'RST' then oc= substr(legend.4, 1, 1)
  634.     when kw= 'REC' then oc= substr(legend.5, 1, 1)
  635.     when kw= 'FKY' then do /* function key defs */
  636.       oc= '?' /* force skip on below test */
  637.       n= word(slin.ndx, 2) /* format: FKY 1 c:\path\filename */
  638.       favlist.n= word(slin.ndx, 3)
  639.     end
  640.   otherwise oc= '?'
  641.   end /* select */
  642.   if oc \= '?' then do  /* to skip if no keyword found */
  643.     days= word(slin.ndx, 2)
  644.     if substr(days, nd, 1) = substr(day, 1, 1) then do
  645.       dur= word(slin.ndx, 4)
  646.       if pos(':', dur) > 0 then do  /* optional hours:minutes form */
  647.         parse value word(slin.ndx, 4) with sth ':' stm /* temporary use */
  648.         if pos('0', stm) = 1 & length(stm) > 1 then /* strip any leading '0' */
  649.           stm= delstr(stm, 1, 1) /* hmm, may not be necessary in REXX... */
  650.         dur= sth * 60 + stm
  651.       end
  652.       parse value word(slin.ndx, 3) with sth ':' stm /* now re-use vars */
  653.       remdr= right(slin.ndx, length(slin.ndx) - lastpos('\', slin.ndx))
  654.       remdr= oc||remdr
  655.       if kw= 'RST' then remdr= remdr||' '||word(slin.ndx, 5)
  656.       if wordpos('SPLIT', slin.ndx) > 0 then do
  657.         p= word(slin.ndx, wordpos('SPLIT', slin.ndx) + 1)
  658.         remdr= remdr||' '||p
  659.       end
  660.       if length(remdr) + 5 > dur then remdr = left(remdr, dur - 5)
  661.       cl= sth
  662.       n= 1
  663.       m= stm
  664.       do while n <= dur
  665.         select
  666.         when n = 1 then tc= '▐'
  667.         when n = 2 then tc= d2c(16)
  668.         when n > 2 & n < length(remdr) + 3 then tc = substr(remdr, n - 2, 1)
  669.         when n = dur - 1 then tc= d2c(17)
  670.         when n = dur then tc= '▌'
  671.         otherwise tc= oc /* if possible fill out with code char */
  672.         end
  673.         show.cl= overlay(tc, show.cl, m + 4) /* offset in show. for hour digits */
  674.         ref.cl= overlay(d2c(ndx), ref.cl, m + 1)
  675.         n= n + 1
  676.         m= m + 1
  677.         if m > 59 then do
  678.           cl= cl + 1
  679.           if cl > 23 then cl= 0 /* primitive protection; just wraps around */
  680.           m= 0
  681.         end
  682.       end /* while n <= dur */
  683.     end /* passed check, runs today */
  684.   end /* oc \= '?' */
  685. end /* do */
  686. return /* interpret */
  687.  
  688. show_sched:
  689. do l= 0 to 23
  690.   call syscurpos 0, 0
  691.   call charout, '«──Favorites:─»'
  692.   call syscurpos 13, 0
  693.   call charout, '«───Legend:───»'
  694.   call syscurpos 19, 0
  695.   call charout, '«────Info:────»'
  696.   call syscurpos l, 1
  697.   select /* for displaying various info */
  698.     when (l > 0) & (l < 13) then do /* function key list */
  699.       n= filespec('N', favlist.l)
  700.       if length(n) > 1 then call charout, substr(n, 1, pos('.', n) - 1)
  701.     end
  702.     when (l > 13) & (l < 19) then do
  703.       n= l - 13
  704.       call charout, legend.n
  705.     end
  706.     when l = 21 then call charout, date('N')
  707.     when l = 22 then call charout, date('W')
  708.     otherwise nop
  709.   end
  710.   call syscurpos l, 16
  711.   call charout, show.l
  712.   if substr(last_message, 1, 1) = d2c(22) then do
  713.     call syscurpos 24, 1
  714.     call charout, last_message
  715.   end
  716.   call syscurpos 24, 69
  717.   call charout, 'H for Help'
  718. end
  719. return
  720.  
  721. exit /* catch all slips through... */
  722.  
  723. /* --- Z pipe control (not all routines are used) ------------------------ */
  724. /* --- presumably, only the parts below need modified to use with PM123... */
  725.  
  726. /* --- n.b. now not sure whether pipe vs command line problems really exist */
  727. /* --- seemed similar to problems others had with pipes not always present */
  728. /* --- but it's too dicey and time consuming to re-do the 'right' way... */
  729.  
  730. /* START actually exits when already streaming; see z_stream below... */
  731. z_start:
  732. '@start "'zwindowtitle'" /N /B /PGM "C:\Z28\Z.EXE"'
  733. call syssleep 3 /* give system some time... */
  734. return
  735.  
  736. /* pause            - pause playback */
  737. z_pause:
  738. '@echo *pause' pipe_to
  739. return
  740.  
  741. /* mute             - mute playback */
  742. z_mute:
  743. '@echo *mute' pipe_to
  744. return
  745.  
  746. /* next             - jumps to the next track */
  747. z_next:
  748. '@echo *next' pipe_to
  749. return
  750.  
  751. /* previous         - jumps to the previous track */
  752. z_previous:
  753. '@echo *previous' pipe_to
  754. return
  755.  
  756. /* stop             - stops playback and returns to the file-selector */
  757. z_stop:
  758. '@echo *stop' pipe_to
  759. return
  760.  
  761. /* seek [x]         - seek to position in track (in seconds, -# to seek back */
  762. z_seek:
  763. '@echo *seek' pipe_to
  764. return
  765.  
  766. /* vol+             - raises the volume a bit */
  767. z_volraise:
  768. '@echo *vol+' pipe_to
  769. return
  770.  
  771. /* vol-             - lowers the volume a bit */
  772. z_vollower:
  773. return
  774. '@echo *vol-' pipe_to
  775.  
  776. /* quit             - quits z! */
  777. z_quit:
  778. '@echo *quit' pipe_to
  779.  call syssleep 3 /* attempt "fix" for 1.1, 1.2 changes leaving z running */
  780. return
  781.  
  782. /* play [x]         - plays file [x] if not already playing something, */
  783. /*                    otherwise it just adds to the playlist */
  784. z_play:
  785. parse arg fs
  786. '@echo *play 'fs pipe_to
  787. return
  788.  
  789. /* STREAMING would use z_play IF it worked as expected, but doesn't seem */
  790. /* to accept .pls from named pipe, so calling Z directly... */
  791. z_stream:
  792. parse arg fs
  793. '@start "'zwindowtitle'" /N /B /PGM "C:\Z28\Z.EXE"' fs
  794. call syssleep 3 /* hope enough time to establish stream... */
  795. return
  796.  
  797. /* add [x]          - adds file [x] to the playlist */
  798. z_add:
  799. parse arg fs
  800. '@echo *add' pipe_to
  801. return
  802.  
  803. /* addlist [x]      - adds all the files in the playlist file [x] */
  804. z_addlist:
  805. parse arg pls
  806. '@echo *addlist' pls pipe_to
  807. return
  808.  
  809. /* addnext [x]      - adds file [x] after the current playing file */
  810. z_addnext:
  811. '@echo *addnext' pipe_to
  812. return
  813.  
  814. /* shout [x]        - immediately plays file [x] then continues w/playlist */
  815. z_shout:
  816. '@echo *shout' pipe_to
  817. return
  818.  
  819. /* clearlist        - clears the playlist */
  820. z_clearlist:
  821. '@echo *clearlist 'fs pipe_to
  822. return
  823.  
  824. /* writetodisk [fn] - save http stream to [fn] (no [fn] = stop writing) */
  825. z_writetodisk:
  826. parse arg fs
  827. '@echo *writetodisk 'fs pipe_to
  828. return
  829.  
  830.  
  831. /* ==================== File Selector section ==== (LD4) ================== */
  832. /* calling parameters:
  833.  fs_scol, glo_var, fs_path, fs_flspc, fs_attr, fs_cur, fs_sort, fs_initpos, fs_view, fs_filter
  834. example:
  835. rv= file_select(40, glo_var, 'C:\OS2', '*.ico', '', 'REXX.ICO', 'N', 'M', 'DTSAL', 1)
  836. */
  837. /* ============== All code BELOW is necessary for file_select ============ */
  838.  
  839. /* file_select does not save or restore the screen. */
  840. file_select:
  841. parse arg fs_scol, glo_var, fs_path, fs_flspc, fs_attr, fs_cur, fs_sort, fs_initpos, fs_view, fs_filter
  842.   ndx= 0; scrx= scrx; fs_showln= scry; /* initialize */
  843.   fs_sort= translate(fs_sort); fs_initpos= translate(fs_initpos); fs_view= translate(fs_view);
  844.   if pos(fs_sort, 'DENS') = 0 then fs_sort= 'N' /* useful default: fs_sort on Name */
  845.   if pos(fs_initpos, 'HMT') = 0 then fs_initpos= 'M' /* show Middle of list */
  846.   if fs_attr = '' then fs_attr= '*****'
  847.   fs_dtlwid= 1; /* too complex to check fs_view correctness, SO UP TO YOU */
  848.   if length(fs_view) > 0 then do fs_loop= 1 to length(fs_view)
  849.     v= substr(fs_view, fs_loop, 1) /* always GET details, CHOOSE which to display */
  850.     if v= 'D' then fs_dtlwid= fs_dtlwid + 9
  851.     if v= 'T' then fs_dtlwid= fs_dtlwid + 6
  852.     if v= 'S' then fs_dtlwid= fs_dtlwid + 11
  853.     if v= 'A' then fs_dtlwid= fs_dtlwid + 6
  854.     if v= 'L' then fs_dtlwid= fs_dtlwid + 5 /* show Long (Y2K) */
  855.   end
  856.   /* end \ is crucial, ensure ALWAYS present, starting here to count fs_lvls */
  857.   /* # of levels is actually limited only by a literal '10' in fs_enter_dir */
  858.   /* DON'T advise entering here with more than 9 levels in path! */
  859.   if substr(fs_path, length(fs_path), 1) \= '\' then fs_path= fs_path||'\'
  860.   fs_lvl= 0
  861.   do fs_loop= 1 to length(fs_path)
  862.     if substr(fs_path, fs_loop, 1) = '\' then fs_lvl= fs_lvl + 1
  863.   end
  864.   fs_ndx= get_1_directory(glo_var, fs_path, fs_flspc, fs_attr, fs_filter, 1)
  865.   if fs_ndx = 2 then do /* only dots back? turn off fs_filter and try for ANY */
  866.     fs_filter= 0
  867.     fs_ndx= get_1_directory(glo_var, fs_path, fs_flspc, fs_attr, fs_filter, 1)
  868.   end
  869.   if fs_ndx > 2 then do /* found more than dot dirs (no indent saves space) */
  870.   fs_tags= copies('·', fs_ndx) /* prepare tag "array" */
  871.   call fs_set_sel
  872.   call fs_show_new_dir
  873.   do fs_loop= 0 to fs_showln /* helps to set off from previous text */
  874.     call syscurpos fs_loop, fs_scol - fs_dtlwid
  875.     call charout, '╟'
  876.   end
  877.   fs_quit= 0
  878.   fs_t= time('R') /* BUSY in keyboard poll, but SLOW if sleeps every loop */
  879.   /* sleeps after 10 seconds of no keys -- reset may conflict with app... */
  880.   do while fs_quit < 1  /* begin key control */
  881.     if chars() > 0 then do
  882.     fs_kd= ex_read_key()
  883.     fs_t= time('R') /* reset timer on every keypress */
  884.     fs_n= fs_ndx_ofs.fs_lvl + fs_sel.fs_lvl /* used several times */
  885.     select /* keyboard constants avoid lengthy expose list... */
  886.     when fs_kd = 'αK' then call fs_exit_dir /* left arrow */
  887.     when fs_kd = 'αM' then call fs_enter_dir /* right arrow */
  888.     when fs_kd = 'αH' then do /* up arrow */
  889.       if fs_sel.fs_lvl > 1 then do
  890.         call fs_lowlight
  891.         fs_sel.fs_lvl= fs_sel.fs_lvl - 1
  892.         call fs_highlight
  893.       end
  894.       else do /* fs_sel.fs_lvl = 1 so scroll down */
  895.         if fs_ndx_ofs.fs_lvl > 0 then do
  896.           fs_ndx_ofs.fs_lvl= fs_ndx_ofs.fs_lvl - 1
  897.           call fs_show_section
  898.         end
  899.       end
  900.     end
  901.     when fs_kd = 'αP' then do /* down arrow */
  902.       if fs_sel.fs_lvl <= fs_maxln - 1 then do
  903.         call fs_lowlight
  904.         if fs_n < fs_ndx then fs_sel.fs_lvl= fs_sel.fs_lvl + 1
  905.         call fs_highlight
  906.       end
  907.       else do /* fs_sel.fs_lvl > fs_maxln so scroll up */
  908.         if fs_ndx_ofs.fs_lvl < fs_ndx - fs_showln then do
  909.           if fs_sel.fs_lvl < fs_ndx - 1 then fs_ndx_ofs.fs_lvl= fs_ndx_ofs.fs_lvl + 1
  910.           call fs_show_section
  911.         end
  912.       end
  913.     end
  914.     when fs_kd = 'αI' then do /* page up */
  915.       fs_ndx_ofs.fs_lvl= fs_ndx_ofs.fs_lvl - fs_showln
  916.       if fs_ndx_ofs.fs_lvl < 0 then do
  917.         fs_ndx_ofs.fs_lvl= 0
  918.         fs_sel.fs_lvl= 1
  919.       end
  920.       call fs_show_section
  921.     end
  922.     when fs_kd = 'α'||d2c(132) then do /* ctrl-page up */
  923.       fs_ndx_ofs.fs_lvl= 0
  924.       fs_sel.fs_lvl= 1
  925.       call fs_show_section
  926.     end
  927.     when fs_kd = 'αQ' then do /* page down */
  928.       if fs_ndx > fs_showln then do
  929.  
  930.         if fs_n + fs_showln < fs_ndx then do
  931.           fs_ndx_ofs.fs_lvl= fs_ndx_ofs.fs_lvl + fs_showln
  932.         end
  933.         else do
  934.           fs_ndx_ofs.fs_lvl= fs_ndx - fs_showln
  935.           fs_sel.fs_lvl= fs_showln
  936.         end
  937.  
  938.       end
  939.       else fs_sel.fs_lvl= fs_ndx
  940.       call fs_show_section
  941.     end
  942.     when fs_kd = 'αv' then do /* ctrl-page down */
  943.       if fs_ndx > fs_showln then do
  944.         fs_ndx_ofs.fs_lvl= fs_ndx - fs_showln
  945.         fs_sel.fs_lvl= fs_showln
  946.         call fs_show_section
  947.       end
  948.     end
  949.     when fs_kd > '`' & fs_kd < '{' then do /* LOWERCASE a-z, select drive */
  950.       fs_kd = translate(fs_kd)
  951.       if pos(fs_kd, sysdrivemap('A:', 'USED')) > 0 then do /* select new drive */
  952.         fs_path= fs_kd||':\'
  953.         fs_lvl= 1
  954. /*        fs_filter= 0 *//* cures not finding files when changing drive */
  955. /*    NOT ^ in time4z because want to find only .m3u, .pls, .wav, or .mp3 */
  956.         fs_ndx= get_1_directory(glo_var, fs_path, fs_flspc, fs_attr, fs_filter, 1)
  957.         fs_cur= ''
  958.         fs_tags= copies('·', fs_ndx)
  959.         call fs_set_sel
  960.         call fs_show_new_dir
  961.       end
  962.     end
  963.     when fs_kd = 'F' then do  /* fs_filter toggle */
  964.       if fs_filter = 1 then fs_filter= 0; else fs_filter= 1
  965.       fs_ndx= get_1_directory(glo_var, fs_path, fs_flspc, fs_attr, fs_filter, 1)
  966.       fs_tags= copies('·', fs_ndx)
  967.       call fs_set_sel
  968.       call fs_show_new_dir
  969.     end
  970.     when fs_kd = 'H' | fs_kd = 'M' | fs_kd = 'T' then do
  971.       fs_initpos= fs_kd
  972.       fs_cur= '' /* set off so fs_set_sel uses fs_initpos rather than finds this */
  973.       call fs_set_sel
  974.       call fs_show_new_dir
  975.     end
  976.     when fs_kd = 'D' | fs_kd = 'E'| fs_kd = 'N' | fs_kd = 'S' then do
  977.       fs_sort= 'N'; call fs_sort_list; /* always fs_sort first by name */
  978.       if fs_kd <> 'N' then do       /* results in better ordering */
  979.         fs_sort= fs_kd; call fs_sort_list;
  980.       end
  981.       call fs_show_new_dir
  982.     end
  983.     when fs_kd = 'α'||d2c(141) then do /* ctrl-up; SET tag and move up */
  984.       if fs_n > 2 then fs_tags= overlay('█', fs_tags, fs_n) /* don't tag dot dirs */
  985.       if fs_sel.fs_lvl > 2 then do
  986.         call syscurpos fs_sel.fs_lvl - 1, fs_scol
  987.         call fs_show_tag(fs_n)
  988.         call fs_lowlight
  989.         fs_sel.fs_lvl= fs_sel.fs_lvl - 1
  990.         call fs_highlight
  991.       end
  992.       else do
  993.         if fs_ndx_ofs.fs_lvl > 0 then do
  994.           fs_ndx_ofs.fs_lvl= fs_ndx_ofs.fs_lvl - 1
  995.           call fs_show_section
  996.         end
  997.       end
  998.     end
  999.     when fs_kd = ' ' |,   /* <space> TOGGLE tag and move down */
  1000.       fs_kd = 'α'||d2c(145) then do /* ctrl-down; SET tag and move down */
  1001.       if fs_n > 2 then do
  1002.         if fs_kd= ' ' & substr(fs_tags, fs_n, 1) = '█' then fs_tags= overlay('·', fs_tags, fs_n)
  1003.           else fs_tags= overlay('█', fs_tags, fs_n)
  1004.           call syscurpos fs_sel.fs_lvl - 1, fs_scol
  1005.           call fs_show_tag(fs_n)
  1006.           if fs_sel.fs_lvl <= fs_maxln - 1 then do
  1007.           call fs_lowlight
  1008.           if fs_n < fs_ndx then fs_sel.fs_lvl= fs_sel.fs_lvl + 1
  1009.           call fs_highlight
  1010.         end
  1011.         else do
  1012.           if fs_ndx_ofs.fs_lvl < fs_ndx - fs_showln then do
  1013.             if fs_sel.fs_lvl < fs_ndx - 1 then fs_ndx_ofs.fs_lvl= fs_ndx_ofs.fs_lvl + 1
  1014.             call fs_show_section
  1015.           end
  1016.         end
  1017.       end
  1018.     end
  1019.     when fs_kd = d2c(0)||';' then do /* F1 Help */
  1020.       call fs_show_instructions fs_scol
  1021.       call fs_show_section
  1022.     end
  1023.     when fs_kd = x2c('0d') then do /* <enter>, return selected name */
  1024.       if fs_n < 3  then call fs_exit_dir /* EXCEPT on dot dir, go up */
  1025.       else do
  1026.         fs_action= fs_kd
  1027.         fs_quit= 1
  1028.       end
  1029.     end
  1030.     otherwise do /* EXIT all other keys, handle in caller. May be annoying */
  1031.       fs_action= fs_kd /* because loses settings merely to discard a key. */
  1032.       fs_quit= 1 /* Can add code here of course. Not easy to re-enter */
  1033.     end        /* without re-initializing; need static variables. */
  1034.     end /* select */
  1035.     end /* if charin > 0 */
  1036.     else do /* without sleep keyboard poll keeps CPU BUSY */
  1037.       if time('E') > 10 then call syssleep 0.5 /* makes response lag, though */
  1038.     end /* uhh... previous to v11 someone thought syssleep took only integer */
  1039.   end /* while fs_quit */
  1040.   end /* fs_ndx > 0 so some found */
  1041.   else do
  1042.     fs_action= 'Not_Found'
  1043.     fs_n= 0
  1044.     fs_rv= ''
  1045.   end
  1046. return fs_action' '||fs_n||' '||fs_tags||' '||fs_path||fs_filnam(fs_n)
  1047.  
  1048. fs_fildat: /* word 1, year 2 or 4 chars depending whether 'L' in fs_view */
  1049. arg fs_ni
  1050. fs_rv= word(dirlist.fs_ni, 1)
  1051. if pos('L', fs_view) = 0 then fs_rv= substr(fs_rv, 3, 8)
  1052. return fs_rv
  1053.  
  1054. fs_filtim: /* word 2, colon and seconds omitted in short form */
  1055. arg fs_ni
  1056. fs_rv= word(dirlist.fs_ni, 2)
  1057. if pos('L', fs_view) = 0 then fs_rv= substr(fs_rv, 1, 5)
  1058. return fs_rv
  1059.  
  1060. fs_filsiz: /* word 3 WITH spaces for ease in display */
  1061. arg fs_ni
  1062. fs_twi= wordindex(dirlist.fs_ni, 2) + length(word(dirlist.fs_ni, 2)) + 1
  1063. return substr(dirlist.fs_ni, fs_twi, 10)
  1064.  
  1065. fs_filatt: /* word 4 attributes */
  1066. arg fs_ni
  1067. return word(dirlist.fs_ni, 4)
  1068.  
  1069. fs_filnam: /* word 5 --> remainder INCLUDING spaces */
  1070. arg fs_ni
  1071. fs_twi= wordindex(dirlist.fs_ni, 5)
  1072. return substr(dirlist.fs_ni, fs_twi, length(dirlist.fs_ni) - fs_twi + 1)
  1073.  
  1074. fs_ellipsis: /* shorten fs_filnam if necessary to fit available space */
  1075. arg fs_ni, fs_nw
  1076. fs_twi= fs_filnam(fs_ni)
  1077. if length(fs_twi) > fs_nw then
  1078.   fs_twi= left(fs_twi, fs_nw % 2)||'/≈/'||right(fs_twi, (fs_nw % 2) - 3)
  1079. return fs_twi
  1080.  
  1081. fs_show_section: /* displays however much of dirlist. fits screen space */
  1082.   do fs_loop= 0 to scry - 1/* sim clear screen; remove all of previous */
  1083.     if length(fs_view) = 0 then call syscurpos fs_loop, fs_scol
  1084.       else call syscurpos fs_loop, fs_scol - fs_dtlwid + 1
  1085.     call charout, ansi_clreol
  1086.   end
  1087.   fs_totlsiz= 0
  1088.   do fs_loop= 3 to fs_ndx
  1089.     fs_totlsiz= fs_totlsiz + fs_filsiz(fs_loop)
  1090.   end
  1091.   fs_loop= 0 /* 0 based for screen line */
  1092.   do until (fs_loop + fs_ndx_ofs.fs_lvl >= fs_ndx) | (fs_loop >= fs_maxln)
  1093.     fs_n= fs_loop + fs_ndx_ofs.fs_lvl + 1
  1094.     if length(fs_view) > 0 then do
  1095.       call syscurpos fs_loop, fs_scol - fs_dtlwid + 1
  1096.       call charout, ansi_clreol
  1097.       do fs_a= 1 to length(fs_view) /* order in fs_view sets displayed order! */
  1098.         fs_v= substr(fs_view, fs_a, 1)
  1099.         if fs_v= 'D' then call charout, fs_fildat(fs_n)' '
  1100.         if fs_v= 'T' then call charout, fs_filtim(fs_n)' '
  1101.         if fs_v= 'A' then call charout, fs_filatt(fs_n)' '
  1102.         if fs_v= 'S' then call charout, fs_filsiz(fs_n)' '
  1103.       end
  1104.     end
  1105.     call syscurpos fs_loop, fs_scol
  1106.     call charout, ansi_clreol
  1107.     select
  1108.       when fs_n = 1 then do
  1109.         call charout, d2c(17)||'.   '||fs_ndx - 2' files'
  1110.       end
  1111.       when fs_n = 2 then do
  1112.         call charout, d2c(17)||'..  'fs_totlsiz' bytes'
  1113.       end
  1114.       when (fs_n > 2) then do
  1115.         call fs_show_tag(fs_n)
  1116.         call charout, fs_ellipsis(fs_n, scrx - fs_scol)
  1117.       end
  1118.       otherwise nop
  1119.     end /* select */
  1120.     fs_loop= fs_loop + 1
  1121.   end /* do until */
  1122.   call fs_highlight
  1123. return
  1124.  
  1125. fs_show_path: /* assembles bottom line, then truncates to available space */
  1126.   fs_ps= ' (F1 Help)  ['||word(sysdriveinfo(substr(fs_path, 1, 2)), 4)||']  '||fs_path
  1127.   fs_width= scrx - fs_scol + fs_dtlwid - 1
  1128.   do while length(fs_ps) < fs_width + 1
  1129.     fs_ps= fs_ps||'_' /* to clear prev */
  1130.   end
  1131.   call syscurpos scry, fs_scol - fs_dtlwid + 1 /* 0, 0 based */
  1132.   call charout, substr(fs_ps, length(fs_ps) - fs_width, fs_width)
  1133. return
  1134.  
  1135. fs_show_new_dir: /* code needed several times */
  1136.   if fs_ndx < fs_showln then fs_maxln= fs_ndx; else fs_maxln= fs_showln
  1137.   call fs_show_section
  1138.   call fs_show_path
  1139. return
  1140.  
  1141. fs_exit_dir: /* for left-arrow at any time, or <enter> on a dot dir */
  1142.   if fs_lvl > 1 & length(fs_path) > 3 then do /* backs up one fs_lvl */
  1143.     if fs_lvl > 2 then do
  1144.       fs_loop= length(fs_path) - 1
  1145.       do until substr(fs_path, fs_loop, 1) = '\' | length(fs_path) < 4
  1146.         fs_loop= fs_loop - 1
  1147.       end
  1148.       fs_loop= fs_loop + 1
  1149.     end
  1150.     else fs_loop= 4
  1151.     fs_cur= substr(fs_path, fs_loop, length(fs_path) - fs_loop)
  1152.     fs_loop= length(fs_path)
  1153.     do until substr(fs_path, fs_loop, 1) = '\' | length(fs_path) < 4
  1154.       fs_loop= fs_loop - 1
  1155.     end
  1156.     fs_path= substr(fs_path, 1, fs_loop)
  1157.     fs_lvl= fs_lvl - 1
  1158. /* fs_filter= 0 */ /* going up, so off likely better (re-filter with alt-h) */
  1159. /* ^COMMENTED OUT from LD4 because distracting for this application */
  1160. /* (and does not require new coding for LOCK effect; can still turn off too) */
  1161.     fs_ndx= get_1_directory(glo_var, fs_path, fs_flspc, fs_attr, fs_filter, 1)
  1162.     fs_tags= copies('·', fs_ndx)
  1163.     call fs_set_sel
  1164.     call fs_show_new_dir
  1165.   end
  1166. return
  1167.  
  1168. fs_enter_dir: /* for right-arrow or <enter> on a non-dot dir; 10 LEVEL LIMIT */
  1169.   fs_n= fs_ndx_ofs.fs_lvl + fs_sel.fs_lvl
  1170.   if fs_lvl < 10 & fs_n > 2 & substr(fs_filatt(fs_n), 2, 1) = 'D' then do
  1171.     fs_cur= '' /* current selection always set off upon enter */
  1172.     fs_path= fs_path||fs_filnam(fs_n)||'\'
  1173.     fs_lvl= fs_lvl + 1
  1174.     fs_sel.fs_lvl= 1
  1175.     fs_ndx= get_1_directory(glo_var, fs_path, fs_flspc, fs_attr, fs_filter, 1)
  1176.     fs_tags= copies('·', fs_ndx)
  1177.     call fs_set_sel
  1178.     call fs_show_new_dir
  1179.   end
  1180. return
  1181.  
  1182. fs_highlight: /* show selected item (only the name...) in reverse color */
  1183.   call syscurpos fs_sel.fs_lvl - 1, fs_scol + 1
  1184.   call charout, revcolr||fs_ellipsis(fs_ndx_ofs.fs_lvl + fs_sel.fs_lvl, scrx - fs_scol)||dircolr
  1185. return
  1186.  
  1187. fs_lowlight: /* show name back in standard color */
  1188.   call syscurpos fs_sel.fs_lvl - 1, fs_scol + 1
  1189.   call charout, dircolr||fs_ellipsis(fs_ndx_ofs.fs_lvl + fs_sel.fs_lvl, scrx - fs_scol)
  1190. return
  1191.  
  1192. fs_show_tag: /* show tag (for dirs, simulate block w reverse color) */
  1193.   arg fs_ni
  1194.   if substr(fs_filatt(fs_ni), 2, 1) = 'D' then do
  1195.     if substr(fs_tags, fs_ni, 1) = '█' then call charout, revcolr||d2c(16)||dircolr
  1196.     else call charout, d2c(16)
  1197.   end
  1198.   else call charout, substr(fs_tags, fs_ni, 1)
  1199. return
  1200.  
  1201. fs_set_sel: /* figures out what part of list to display, and item to select */
  1202.   fs_n= 0
  1203.   if length(fs_cur) > 0 then do /* assumes fs_cur is valid... */
  1204.     fs_cs= 1
  1205.     do until fs_cs >= fs_ndx | pos(fs_cur, fs_filnam(fs_cs)) = 1
  1206.       fs_cs= fs_cs + 1
  1207.     end
  1208.   end
  1209.   else fs_cs= fs_ndx + 1
  1210.   if fs_cs <= fs_ndx then do
  1211.     if fs_cs > fs_showln then do
  1212.       fs_ndx_ofs.fs_lvl= fs_cs - fs_showln
  1213.       fs_sel.fs_lvl= fs_showln
  1214.       fs_n= fs_showln % 2
  1215.       if fs_ndx_ofs.fs_lvl + fs_sel.fs_lvl + fs_n < fs_ndx then do
  1216.         fs_ndx_ofs.fs_lvl= fs_ndx_ofs.fs_lvl + fs_n
  1217.         fs_sel.fs_lvl= fs_sel.fs_lvl - fs_n
  1218.       end
  1219.     end
  1220.     else do
  1221.       fs_ndx_ofs.fs_lvl= 0;
  1222.       fs_sel.fs_lvl= fs_cs;
  1223.     end
  1224.   end
  1225.   else do
  1226.     select
  1227.     when fs_initpos = 'H' then do /* show list from Head (top) */
  1228.       if fs_lvl > 1 & fs_ndx > 2 then fs_sel.fs_lvl= 3; else fs_sel.fs_lvl= 2
  1229.       fs_ndx_ofs.fs_lvl= 0
  1230.     end
  1231.     when fs_initpos = 'M' then do /* Middle */
  1232.       if fs_ndx > fs_showln then do /* more files than screen lines */
  1233.         fs_sel.fs_lvl= fs_showln % 2 + 1
  1234.         if (fs_ndx > 2 * fs_showln - 1) then fs_ndx_ofs.fs_lvl= fs_ndx % 2 - fs_sel.fs_lvl
  1235.           else fs_ndx_ofs.fs_lvl= (fs_ndx - fs_showln) % 2
  1236.       end
  1237.       else do
  1238.         if fs_ndx > 2 then fs_sel.fs_lvl= fs_ndx % 2 + 2; else fs_sel.fs_lvl = 2
  1239.         fs_ndx_ofs.fs_lvl= 0
  1240.       end
  1241.     end
  1242.     when fs_initpos = 'T' then do /* Tail (end) */
  1243.       if fs_ndx > fs_showln then do
  1244.         fs_sel.fs_lvl= fs_showln
  1245.         fs_ndx_ofs.fs_lvl= fs_ndx - fs_showln
  1246.       end
  1247.       else do
  1248.         fs_sel.fs_lvl= fs_ndx
  1249.         fs_ndx_ofs.fs_lvl= 0
  1250.       end
  1251.     end
  1252.     end /* select */
  1253.   end /* else of fs_cs <= fs_ndx */
  1254. return
  1255.  
  1256. get_1_directory:
  1257. parse arg glo_var, g1_path, g1_flspc, tattr, g1_filter, g1_dirs
  1258. /* get JUST ONE dir in Long (Y2K) form, and re-format:
  1259. 2000-09-06 12:43:00  1234567890  A----  C:\os2\SWITCHRX.CMD
  1260. by removing unnecessary spaces and (known elsewhere) path to:
  1261. 2000-09-06 12:43:00 1234567890 A---- SWITCHRX.CMD
  1262. 1  words   2        3          4     5 --> remainder inc spaces */
  1263.   drop value(glo_var) /* toss any previous list */
  1264.   g1_addl= '____Date__ _Time___ ___Size___ Attrb  .'
  1265.   rc= value(glo_var||'1', g1_addl) /* fake dot dirs for sake of convention */
  1266.   g1_addl= 'yyyy-mm-dd hh:mm:ss          0 ADHRS  ..'
  1267.   rc= value(glo_var||'2', g1_addl) /* though will use the space for info */
  1268.   g1_addl= 2 /* additional, now is offset for accumulating to glo_var.0 */
  1269.   if substr(g1_path, length(g1_path), 1) \= '\' then g1_path= g1_path||'\'
  1270.   if g1_filter = 0 then do; g1_flspc= '*'; tattr= '*****'; end;
  1271.   do g1_nspec= 0 to words(g1_flspc) /* space delim'd, so NO OTHER spaces */
  1272.     ts.0= 0
  1273.     if g1_nspec > 0 then do
  1274.       rc= SysFileTree(g1_path||word(g1_flspc, g1_nspec), 'ts', 'FTL', tattr)
  1275.     end
  1276.     else do /* check get dirs */
  1277.       if g1_dirs = 1 then rc= SysFileTree(g1_path||'*', 'ts', 'DTL', tattr)
  1278.     end
  1279.     if ts.0 > 0 then do
  1280.       do g1_n= 1 to ts.0
  1281.         ts.g1_n= delstr(ts.g1_n, wordindex(ts.g1_n, 3) - 1, 1)
  1282.         ts.g1_n= delstr(ts.g1_n, wordindex(ts.g1_n, 4) - 1, 1)
  1283.         ts.g1_n= delstr(ts.g1_n, wordindex(ts.g1_n, 5) - 1, 1)
  1284.         p= pos(':\', ts.g1_n) - 1
  1285.         ts.g1_n= delstr(ts.g1_n, p, lastpos('\', ts.g1_n) - p + 1) /* strip out path */
  1286.         l= g1_n + g1_addl /* arithmetic */
  1287.         p= value(glo_var||l, ts.g1_n) /* SET (global) glo_var.[g1_n + addl] TO ts.g1_n */
  1288.       end
  1289.     end
  1290.     g1_addl= g1_addl + ts.0 /* sum # in current list plus all previous */
  1291.     p= value(glo_var||'0', g1_addl) /* set the number of elements */
  1292.   end
  1293. return g1_addl /* becomes fs_ndx, # of entries found */
  1294.  
  1295. fs_sort_list:
  1296.   if fs_ndx > 3 then do
  1297.     if substr(fs_filnam(2), 2, 1) = '.' then fs_head= 3; else fs_head= 1
  1298.     do until fs_head >= fs_ndx
  1299.       fs_cnt= fs_head + 1
  1300.       do until fs_cnt > fs_ndx
  1301.         select /* get which field: Date, Extension, Name, or Size */
  1302.           when fs_sort = 'D' then do
  1303.             v1= word(dirlist.fs_cnt, 1)||word(dirlist.fs_cnt, 2)
  1304.             v2= word(dirlist.fs_head, 1)||word(dirlist.fs_head, 2)
  1305.           end
  1306.           when fs_sort = 'E' then do /* Simplistic. Scrambles re full name. */
  1307.             parse upper var dirlist.fs_cnt with dummy '.' v1
  1308.             parse upper var dirlist.fs_head with dummy '.' v2
  1309.           end
  1310.           when fs_sort = 'N' then do
  1311.             fs_twi= wordindex(dirlist.fs_cnt, 5)
  1312.             v1= substr(dirlist.fs_cnt, fs_twi, length(dirlist.fs_cnt) - fs_twi + 1)
  1313.             fs_twi= wordindex(dirlist.fs_head, 5)
  1314.             v2= substr(dirlist.fs_head, fs_twi, length(dirlist.fs_head) - fs_twi + 1)
  1315.           end
  1316.           when fs_sort = 'S' then do
  1317.             v1= word(dirlist.fs_cnt, 3)
  1318.             v2= word(dirlist.fs_head, 3)
  1319.           end
  1320.         end /* select */
  1321.         if v1 < v2 then do /* compare and swap */
  1322.           fs_twi= dirlist.fs_cnt
  1323.           dirlist.fs_cnt= dirlist.fs_head
  1324.           dirlist.fs_head= fs_twi
  1325.         end
  1326.         fs_cnt= fs_cnt + 1
  1327.       end
  1328.       fs_head= fs_head + 1
  1329.     end
  1330.   end
  1331. return
  1332.  
  1333. fs_show_instructions:
  1334. arg ix
  1335. if ix > 40 then ix= 40 /* caller handles all screen clean-up, heh */
  1336. iy= 2
  1337. call say_inc '╔═══════════════════════════════════╗'
  1338. call say_inc '║ arrows:             uppercase:    ║'
  1339. call say_inc '║ 'd2c(30)' up                Filter toggle ║'
  1340. call say_inc '║ 'd2c(31)' down                            ║'
  1341. call say_inc '║ 'd2c(16)' into directory    sort by:      ║'
  1342. call say_inc '║ 'd2c(17)' out of directory  D: Date/Time  ║'
  1343. call say_inc '║                     E: Extension  ║'
  1344. call say_inc '║ <enter> select      N: Name       ║'
  1345. call say_inc '║ <escape>            S: Size       ║'
  1346. call say_inc '║                                   ║'
  1347. call say_inc '║ lowercase a-z:      display from: ║'
  1348. call say_inc '║   select drive      H: Head       ║'
  1349. call say_inc '║                     M: Middle     ║'
  1350. call say_inc '║ tagging:            T: Tail       ║'
  1351. call say_inc '║ ctrl-up tag and up                ║'
  1352. call say_inc '║ ctrl-down " " down  DGDs  v1.0 of ║'
  1353. call say_inc '║ <space> toggle      File Selector ║'
  1354. call say_inc '╚═══════════════════════════════════╝'
  1355. kd= 0
  1356. do while chars() = 0
  1357.  if kd // 5 = 0 then do
  1358.    call syscurpos 2, ix + 5; call charout, ' Hit any key '
  1359.  end
  1360.  else do
  1361.    call syscurpos 2, ix + 5; call charout, '═════════════'
  1362.  end
  1363.  call syssleep 0.5
  1364.  kd= kd + 1
  1365. end
  1366. kd= ex_read_key()
  1367. kd= ''
  1368. return
  1369.  
  1370. say_inc:
  1371. parse arg it
  1372. call syscurpos iy, ix
  1373. call charout, it
  1374. iy= iy + 1
  1375. return
  1376.