* CHANGE BACKGR.COL OF SPC WINDOW,(C) EMA 1999-2000        LM:07.11.2000
INTERNAL 
  INTEGER ER,I,RC,NBWIN,CONFSC,TPW(4)
  REAL    C(16),R,G,B,PT(2),SC(4),ORIGIN(3,4),NORM(3,4),UP(3,4),EYE(3,4)
  CHAR*35 CEMA INIT 'Change background color,(C)Ema 2000'
PROC 
  LOAD GIRSCR 1,NBWIN,CONFSC,PT,TPW,SC,ORIGIN,NORM,UP,EYE,ER
  IF(TPW(1)EQ 0)LET TPW(1)=4
  IF(TPW(2)EQ 0)LET TPW(2)=4
  IF(TPW(3)EQ 0)LET TPW(3)=4
  IF(TPW(4)EQ 0)LET TPW(4)=4
*  BLOCKIF(TPW(1)EQ 4)AND(TPW(2)EQ 4)AND(TPW(3)EQ 4)AND(TPW(4)EQ 4)THEN
*    BEEP
*    MSG 'NO SPACE WINDOW ON SCREEN, YES:END '//CEMA YES
*    EXIT
*  ENDIF
  LET I = 1
  DO
    LET C(I) = I*0.0666
    LET I = I+1
  WHILE (I LE 15)
  MENU 'WHITE','NORMAL'
  MSG 'Select MENU, YES:end               '//CEMA MENU,YES
  LET RC=IRET
  MENU
  IF(KODE EQ YES)EXIT
*  LET I = 1
*  DO
*    LOAD GIRRGB 1,I,R,G,B,ER
*    LOAD GICRGB 1,I,R,G,B,ER
*    LET I = I+1
*  WHILE (I LE 125)
  IF(RC EQ 1)LOAD GICRGB 1,134,C(15),C(15),C(15),ER
  IF(RC EQ 1)LOAD GICRGB 1,133,C(15),C(15),C(15),ER
  IF(RC EQ 2)LOAD GICRGB 1,134,.0,.0,C(3),ER
  IF(RC EQ 2)LOAD GICRGB 1,133,.0,C(2),C(4),ER
  MSGCNTL 'BACKGROUND COLOR CHANGED'
END