PROGRAM PALAT C C Display all possible colors, 6 at a time against a standard background. C C B. Z. Lederman Bankers Trust Co. C INCLUDE '[001005]CGL.FTN/NOLIST' REAL A, B, C, D BYTE NUMBER(80) INTEGER*2 ARYCOL(777), SAVCOL(24), MOVCOL(24) DATA MOVCOL / 0, 0, 0, 0, 0, 6, 0, 7, 0, 7, 0, 0, 7, 7, 0, 1 0, 7, 6, 7, 0, 6, 7, 7, 6 / C C Fill the array ARYCOL with every possible combination of C Red, Green, Blue. C I = 1 DO 50 B = 0, 6, 2 ! 4 levels of Blue. DO 50 G = 0, 7 ! 8 of Green, DO 50 R = 0, 7 ! 8 of Red. ARYCOL(I) = R ARYCOL(I + 1) = G ARYCOL(I + 2) = B I = I + 3 IF (I .GE. 777) GOTO 60 50 CONTINUE 60 DO 65 J = I, 777 ! finish array with grey. 65 ARYCOL(J) = 4 C CALL CGL (GIC) ! Initialize CALL CGL (GNF) ! New Frame CALL CGL (GSWI, 7) ! set write index to white CALL CGL (GSW, 0., 25., 0., 8.) ! Set window CALL CGL (GSO, 0) ! Set origin to bottom left CALL CGL (GICM, SAVCOL) ! Save preset colors CALL CGL (GSCM, MOVCOL) ! First set of colors CALL CGL (GSFM, 4) ! fill to poly CALL CGL (GMA2, 0., 4.) ! Draw top box CALL CGL (GRA2, 25., 8.) CALL CGL (GSFE, 25., 8.) ENCODE (80, 300, NUMBER) (MOVCOL(I), I = 4, 21) ! label colors C I = 1 DO 100 X = 1, 21, 4 A = X C = A + 3. IF (I .NE. 7) CALL CGL (GSWI, I) ! set current color I = I + 1 ! next color CALL CGL (GMA2, A, 1.) ! move to corner of box CALL CGL (GRA2, C, 7.) ! draw box CALL CGL (GSFE, C, 7.) ! fill box 100 CONTINUE C CALL CGL (GSWM, 6) ! set write mode replace CALL CGL (GSWI, 7) ! write index white CALL CGL (GMA2, 0., 0.5) ! identify colors CALL CGL (GT, NUMBER, 80) CALL CGL (GCW, 5.) C C Now that the pattern has been drawn, be only need to change C the color map values and the numbers labeling the colors. C J = 0 150 DO 200 I = 4, 21 J = J + 1 200 MOVCOL(I) = ARYCOL(J) 210 ENCODE (80, 300, NUMBER) (MOVCOL(I), I = 4, 21) 300 FORMAT( 2X, 6( 4X, 3( I1, 2X))) CALL CGL (GSCM, MOVCOL) ! load in next set of colors CALL CGL (GMA2, 0., 0.5) ! identify colors CALL CGL (GT, NUMBER, 80) CALL CGL (GCW, 2.) ! wait awhile IF (J .LT. 768) GOTO 150 ! repeat until all colors shown C CALL CGL (GSCM, SAVCOL) ! Put original colors back CALL CGL (GNF) ! New Frame CALL CGL (GTC) ! Terminate C CALL EXIT C END