home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 3 / CDASC03.ISO / sorties / 2078 / boxes.kex < prev    next >
Encoding:
Text File  |  1993-04-01  |  2.4 KB  |  67 lines

  1. *┌───────────────────────────────────────────────────────────────────────┐
  2. *│ draw semigraphic boxes and arrows with cursor keys                          │
  3. *│ character address based on values: 1(bot.)+2(le.)+4(ri.)+8(top)         │
  4. *│ added (bitwise-Or isn't available) for connectors, as is for arrows   │
  5. *└───────────────────────────────────────────────────────────────────────┘
  6. if COMMAND() then 'cursor home'; else if INPREFIX() then 'cursor column';
  7. C = -1; B = 0; P = 0; E = ''; L = 0; N = 0;
  8. D = 'down left 3 right 5 6 7 up'; O = 'nomsg coverlay';
  9. if CURSORSHAPE.1() = 'AUTO' then S = 'set cursorshape AUTO';
  10. else do; 'modify cursorshape'; S = CURLINE.3(); 'cmsg'; end
  11. 'set cursorshape USER 0 31 0 31'; A = 'set alt' ALT.1()+1 ALT.2()+1;
  12. 'preserve'; 'set autosave OFF';
  13. do forever
  14.     if L > 1 | C = SPACECHAR() then
  15.         do
  16.         'refresh'; if L > 1 then L = L-1;
  17.         if \ NOQUEUE() then do; 'readv KEY'; L = 0; C = -1; end
  18.         end
  19.     else
  20.         do
  21.         if NOQUEUE() & C >= 0 then 'cursor' WORD( D , 8%N ); C = -1; L = 0;
  22.         if E = '' then 'msg BOXES arrow=move  S┌─┬ D╔═╦ H╒═╤ V╓─╥ A'D2C(26)' B L+-+ P÷·÷ SPACE=none   ESC=end';
  23.         else 'msg BOXES arrow=line 1back=junction PLUS=cross STAR/ALT=long SDHVABLP 'SUBSTR(E,5,3)'  ESC=end';
  24.         'readv KEY'; R = WORD( READV.1 , 1 ); K = UPPER( READV.2 );
  25.         if R = 'ASCII' & N > 0 then
  26.             do; L = WORD( READV.1 , 2 ); C = 0; end
  27.         else if R = 'STAR' & N > 0 then
  28.             C = SPACECHAR();
  29.         else if R = 'PLUS' & N > 0 & LENGTH( E ) = 15 then
  30.             N = 15;
  31.         else if R = 'CURD' then
  32.             N = 1;
  33.         else if R = 'CURL' then
  34.             N = 2;
  35.         else if R = 'CURR' then
  36.             N = 4;
  37.         else if R = 'CURU' then
  38.             N = 8;
  39.         else
  40.             do
  41.             if R = 'SPACE' then E = '';
  42.             if K = 'S' then E = '│─┐─┌─┬││┘┤└├┴┼';
  43.             if K = 'D' then E = '║═╗═╔═╦║║╝╣╚╠╩╬';
  44.             if K = 'H' then E = '│═╕═╒═╤││╛╡╘╞╧╪';
  45.             if K = 'V' then E = '║─╖─╓─╥║║╜╢╙╟╨╫';
  46.             if K = 'A' then E = ' 'D2C(26)''D2C(26)'';
  47.             if K = 'B' then E = ' ';
  48.             if K = 'L' then E = '|-+-+-+||++++++';
  49.             if K = 'P' then E = ':·÷·÷·÷::÷÷÷÷÷÷';
  50.             if R = 'ESC' then leave;
  51.             iterate;
  52.             end
  53.         end
  54.     if LENGTH( E ) < 15 then
  55.         do; O SUBSTR( E , N , 1 ); P = 8%N; end
  56.     else if N = 15 then
  57.         do; O SUBSTR( E , N , 1 ); N = 8%P; end
  58.     else if N \= P then
  59.         do; O SUBSTR( E , N*(N+8%N\=P)+P , 1 ); B = P; P = 8%N; end
  60.     else if B = N | B = 8%N then
  61.         do; B = P; P = N+8%N; end
  62.     else
  63.         do; 'cursor' WORD( D , N ); P = 8%N; O SUBSTR( E , N+P+B , 1 ); end
  64.     'cursor' WORD( D , N );
  65. end
  66. A; 'restore'; S;
  67.