home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 3 / CDASC03.ISO / sorties / 2078 / colors.kex < prev    next >
Text File  |  1993-04-01  |  2KB  |  45 lines
  1. *┌───────────────────────────────────────────────────────────────────────┐
  2. *│ interface to set colors interactively                                             │
  3. *│ preserves the =-value and puts the Attribute setting into the ?-stack │
  4. *└───────────────────────────────────────────────────────────────────────┘
  5. F = 'Filearea Curline Block Cblock Cmdline Idline Msgline Arrow Prefix Pending Scale Tofeof Ctofeof Tabline Shadow Statarea Divider';
  6. if COMMAND() then M = 5;
  7. else if SHADOW() then M = 15;
  8. else if INPREFIX() then M = 10 - BLANK();
  9. else if FOCUSTOF() | FOCUSEOF() then M = 12 + CURRENT();
  10. else if INBLOCK() then M = 3 + CURRENT();
  11. else M = 1 + CURRENT();
  12. 'sos save'; 'modify attributes'; ORIG = CMDLINE.3();
  13. 'cmsg ?'; 'sos execute'; L = CMDLINE.3();
  14. 'cmsg ?+'; 'sos execute'; 'cmsg'; 'sos restore';
  15. 'preserve'; 'set curline M-3'; 'set msgline ON M-1 3 OVERLAY';
  16. do forever
  17.     if M = 0 then
  18.         do
  19.         A = BORDER.1(); if \ DATATYPE( A , 'N' ) then A = 0;
  20.         W = 'Border'; S = 'set' W;
  21.         end
  22.     else
  23.         do
  24.         'extract /ATTRIBUTES'; A = ATTRIBUTES.M;
  25.         W = WORD( F , M ); S = 'set color' W;
  26.         end
  27.     FG = A//8; BR = (A%8)//2; BG = (A%16)//8; BL = A%128; 'msg';
  28.     'msg COLORS U/D='FG'foreg. L/R='BG'backg. INS='BR'bright DEL='BL'blink PGU/D='SUBSTR( W , 1 , 8 )' ENTER,ESC';
  29.     'msg'; 'readv KEY'; R = READV.1;
  30.     if R = 'ENTER' then do; 'modify border'; 'sos execute'; 'modify attributes'; 'sos execute restore'; leave; end
  31.     else if R = 'ESC' then do; ORIG; leave; end
  32.     else if R = 'CURU' then FG = (FG+9)//8;
  33.     else if R = 'CURD' then FG = (FG+7)//8;
  34.     else if R = 'CURR' then BG = (BG+9)//8;
  35.     else if R = 'CURL' then BG = (BG+7)//8;
  36.     else if R = 'PGDN' then M = (M+19)//18;
  37.     else if R = 'PGUP' then M = (M+17)//18;
  38.     else if R = 'INS' then BR = (BR+1)//2;
  39.     else if R = 'DEL' then BL = (BL+1)//2;
  40.     else if WORD( R , 1 ) = 'ASCII' then do; S WORD( R , 2 ); iterate; end
  41.     else do; R = POS( UPPER( READV.2 ) , '01234567KBGCRMYW' ); if R > 0 then do; FG = BG; BG = (R-1)//8; end; end
  42.     S FG+8*BR+16*BG+128*BL;
  43. end
  44. 'restore'; 'set =' L;
  45.