i91@nikhefh.hep.nl (Fons Rademakers) (07/27/88)
Hi,
here a small program that allows you to compose interactively
a new colormap.
It gives as output a new colormap in the /sys/dm/color_map format.
Paste the output in a file and do /com/lcm -p file to load the
new colormap.
Have Fun,
Fons Rademakers.
========================= cut here ===================
C#COLORMAP -------------------------------------------------------------
PROGRAM COLORMAP
C ------- --------
C Display the current color map, and make visual changes.
C The new color values are printed on standard output,
C in the same format as /sys/dm/color_map.
C Only the first 16 entries are displayed for a 4 plane display.
C
C Author: E.Wassenaar, Nikhef-H
C Version: 18-FEB-1985
C Revision:
C
C To change the color components in a displayed box, you must point
C to the box with the mouse. If the mouse is positioned in the
C leftmost third of the box, the red component will be changed.
C If it is positioned in the middle third of the box, the green
C component will be changed. If it is in the rightmost third of the box,
C the blue component will be changed.
C The leftmost mouse button causes a color component increment.
C The rightmost mouse button causes a color component decrement.
C The change is continuous as long the mouse button is held depressed.
C The change stops when you release the mouse button.
INTEGER*2 TYPE {Display type}
INTEGER*2 PLANE {Highest plane}
C Fetch the display type, and the maximum display memory plane.
CALL GPR_CONFIG (TYPE,PLANE)
CALL SHOW_COLOR_MAP (PLANE)
END
C#SHOW_COLOR_MAP -------------------------------------------------------
SUBROUTINE SHOW_COLOR_MAP (PLANE)
C ---------- --------------
C Display the current color map.
C
C ENTRY: PLANE = Highest plane available.
INTEGER*2 PLANE {Highest plane}
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/gpr.ins.ftn'
INTEGER*4 STATUS {General status word}
INTEGER*4 INDEX {Color index}
INTEGER*2 FONT {Text font ID}
INTEGER*4 BITMAP_DESC {Bitmap pointer}
INTEGER*2 BITMAP_SIZE(2) {Bitmap size}
INTEGER*2 BITMAP_PLANE {Highest available plane}
INTEGER*4 START_INDEX {First color index}
INTEGER*4 LAST_INDEX {Last color index}
INTEGER*2 N_COLORS {Number of color entries}
INTEGER*4 COLOR_MAP(0:255) {Color values}
C Initialize the graphics primitives. Request standard size bitmap.
BITMAP_PLANE= PLANE
BITMAP_SIZE(1) = 1024
BITMAP_SIZE(2) = 800
CALL GPR_$INIT (GPR_$BORROW,INT2(1),
> BITMAP_SIZE,BITMAP_PLANE,
> BITMAP_DESC,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
C Fetch the current bitmap parameters.
CALL GPR_$INQ_BITMAP_DIMENSIONS (BITMAP_DESC,
> BITMAP_SIZE,
> BITMAP_PLANE,
> STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
CCC WRITE (6,'(A,I5,I5)') 'Bitmap size ', BITMAP_SIZE
WRITE (6,'(A,I1)') 'Highest plane ', BITMAP_PLANE
C Fetch the current color map values. Process only the first 16.
START_INDEX= 0
N_COLORS= 2**(BITMAP_PLANE + 1)
LAST_INDEX= N_COLORS - 1
IF (LAST_INDEX .GT. 15) LAST_INDEX= 15
WRITE (6,'(A,I3)') 'Number of colors ', N_COLORS
CALL GPR_$INQ_COLOR_MAP (START_INDEX,N_COLORS,
> COLOR_MAP,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
WRITE (6,'(A)') 'Old color map: '
DO INDEX= START_INDEX,LAST_INDEX
CALL PRINT_VALUE (INDEX,COLOR_MAP(INDEX))
ENDDO
C Perform further initialization.
CALL GPR_$LOAD_FONT_FILE ('std',INT2(3),FONT,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
CALL GPR_$SET_TEXT_FONT (FONT,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
CALL GPR_$SET_TEXT_VALUE (INT4(7),STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
C Display the current color map.
DO INDEX= START_INDEX,LAST_INDEX
CALL SHOW_COLOR (INDEX)
CALL SHOW_VALUE (INDEX,COLOR_MAP(INDEX))
ENDDO
C Make any changes to the display.
CALL SHOW_UPDATE (COLOR_MAP,LAST_INDEX)
WRITE (6,'(A)') 'New color map: '
DO INDEX= START_INDEX,LAST_INDEX
CALL PRINT_VALUE (INDEX,COLOR_MAP(INDEX))
ENDDO
C Terminate the graphics primitives.
CALL GPR_$TERMINATE (.FALSE.,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
RETURN
END
C#GPR_CONFIG -----------------------------------------------------------
SUBROUTINE GPR_CONFIG (TYPE,PLANE)
C ---------- ----------
C Fetch display type from GPR.
C
C EXIT: TYPE = Display type.
C PLANE = Highest available plane.
INTEGER*2 TYPE {Display type}
INTEGER*2 PLANE {Highest available plane}
%include '/sys/ins/base.ins.ftn'
%include '/sys/ins/gpr.ins.ftn'
INTEGER*4 STATUS {General status word}
INTEGER*2 BITMAP_PLANE {Highest available plane}
INTEGER*2 BITMAP_SIZE(2) {Initial bitmap size}
INTEGER*4 BITMAP_DESC {Bitmap descriptor}
INTEGER*2 BITMAP_TYPE {Display type}
INTEGER*2 HI_PLANE(0:11) {Highest plane values}
DATA HI_PLANE /0,0,3,7,3,7,7,7,3,0,7,0/
CCC O 'gpr_$bw_800x1024'
CCC 1 'gpr_$bw_1024x800'
CCC 2 'gpr_$color_1024x1024x4'
CCC 3 'gpr_$color_1024x1024x8'
CCC 4 'gpr_$color_1024x800x4'
CCC 5 'gpr_$color_1024x800x8'
CCC 6 'gpr_$color_1280x1024x8'
CCC 7 'gpr_$color1_1024x800x8'
CCC 8 'gpr_$color2_1024x800x4'
CCC 9 'gpr_$bw_1280x1024'
CCC 10 'gpr_$color2_1024x800x8'
CCC 11 'gpr_$bw5_1024x800'
C Initialize GPR without a real display.
C Specify the smallest possible main memory bitmap.
BITMAP_PLANE= GPR_$HIGHEST_PLANE
BITMAP_SIZE(1) = 1
BITMAP_SIZE(2) = 1
CALL GPR_$INIT (GPR_$NO_DISPLAY,INT2(0),
> BITMAP_SIZE,BITMAP_PLANE,
> BITMAP_DESC,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
C Fetch the display type.
CALL GPR_$INQ_CONFIG (BITMAP_TYPE,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
C Return the highest plane depending on the display configuration.
C Inquiring in no_display mode would have returned the maximum value 7.
BITMAP_PLANE= HI_PLANE(BITMAP_TYPE)
CCC CALL GPR_$INQ_BITMAP_DIMENSIONS (BITMAP_DESC,
CCC > BITMAP_SIZE,
CCC > BITMAP_PLANE,
CCC > STATUS)
CCC IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
C Terminate GPR. Return the desired values.
CALL GPR_$TERMINATE (.FALSE.,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
TYPE = BITMAP_TYPE
PLANE= BITMAP_PLANE
RETURN
END
C#GPR_ERROR ------------------------------------------------------------
SUBROUTINE GPR_ERROR (STATUS)
C ---------- ---------
C Terminate current program in case of error status.
C
C ENTRY: STATUS = General status code
INTEGER*4 STATUS {General status word}
%include '/sys/ins/pgm.ins.ftn'
C Check status. Terminate program if in error.
IF (STATUS .NE. 0) THEN
CALL PGM_$SET_SEVERITY (PGM_$ERROR)
CALL PFM_$ERROR_TRAP (STATUS)
CCC CALL ERROR_$PRINT (STATUS)
CCC CALL PGM_$EXIT
ENDIF
RETURN
END
C#SHOW_COLOR -----------------------------------------------------------
SUBROUTINE SHOW
C --------- ----
C Various display routines. Assumes a maximum of 16 color entries.
INTEGER*4 INDEX {Color index}
INTEGER*4 VALUE {color value}
INTEGER*2 POS(2) {Cursor position}
INTEGER*2 PART {Part within box}
%include '/sys/ins/gpr.ins.ftn'
INTEGER*4 STATUS {General status word}
INTEGER*2 BOX(4) {Rectangular box specs}
INTEGER*4 RED, GREEN, BLUE {Individual colors}
CHARACTER TEXT*12 {Printed text}
C Statement functions for generating coordinate values.
INTEGER*4 I {Dummy index}
INTEGER*2 HOR, VER {Offsets}
INTEGER*2 X1, Y1, X2, Y2 {Corner positions}
INTEGER*2 XT, YT {Position for text string}
INTEGER*2 XA, XB {Position at 1/3, 2/3}
INTEGER*2 XL {position of a single line}
INTEGER*2 P, A, B {Dummy coordinates}
LOGICAL IN RANGE
IN RANGE(P,A,B)= (P .GE. A) .AND. (P .LE. B)
HOR(I)= MOD(I,4)
VER(I)= AND((I/4),3)
X1(I)= 40 + HOR(I)*190
Y1(I)= 40 + VER(I)*190
X2(I)= X1(I) + 150
Y2(I)= Y1(I) + 150
XT(I)= X1(I) + 30
YT(I)= Y2(I) + 20
XA(I)= X1(I) + 50
XB(I)= X1(I) + 100
XL(I)= 840 + HOR(I)*40
ENTRY SHOW_COLOR (INDEX)
C ----- ----------
C Draw rectangle showing the color of the specified color index.
BOX(1)= X1(INDEX)
BOX(2)= Y1(INDEX)
BOX(3)= X2(INDEX) - X1(INDEX)
BOX(4)= Y2(INDEX) - Y1(INDEX)
CALL GPR_$SET_FILL_VALUE (INDEX,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
CALL GPR_$RECTANGLE (BOX,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
C Draw a white border around the box.
BOX(1)= X1(INDEX)
BOX(2)= Y1(INDEX)
BOX(3)= X2(INDEX)
BOX(4)= Y2(INDEX)
CALL GPR_$SET_DRAW_VALUE (INT4(7),STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
CALL GPR_$DRAW_BOX (BOX(1),BOX(2),BOX(3),BOX(4),STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
C Draw a vertical line in the same color.
CALL GPR_$SET_DRAW_VALUE (INDEX,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
CALL GPR_$MOVE (XL(INDEX),Y1(INDEX),STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
CALL GPR_$LINE (XL(INDEX),Y2(INDEX),STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
RETURN
ENTRY SHOW_VALUE (INDEX,VALUE)
C ----- ----------
C Display the individual color values of the given color index.
RED = AND(RSHFT(VALUE,16),16#FF)
GREEN= AND(RSHFT(VALUE,8) ,16#FF)
BLUE = AND( VALUE ,16#FF)
WRITE (TEXT,'(3I4)') RED, GREEN, BLUE
CALL GPR_$MOVE (XT(INDEX),YT(INDEX),STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
CALL GPR_$TEXT (TEXT,INT2(12),STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
RETURN
ENTRY PRINT_VALUE (INDEX,VALUE)
C ----- -----------
C Print the individual color values of the given color index.
RED = AND(RSHFT(VALUE,16),16#FF)
GREEN= AND(RSHFT(VALUE,8) ,16#FF)
BLUE = AND( VALUE ,16#FF)
WRITE (6,'(4I4)') INDEX, RED, GREEN, BLUE
RETURN
ENTRY SHOW_GET_INDEX (INDEX,POS,PART)
C ----- --------------
C Return color index, given specified cursor position.
C Also return the part of the box in which the cursor is positioned.
C Returns negative index in case not positioned in a box.
DO INDEX= 0,15
IF (INRANGE(POS(2),Y1(INDEX),Y2(INDEX))) THEN
IF (INRANGE(POS(1),X1(INDEX),X2(INDEX))) THEN
IF (INRANGE(POS(1),X1(INDEX),XA(INDEX))) THEN
PART= 1
ELSEIF (INRANGE(POS(1),XB(INDEX),X2(INDEX))) THEN
PART= 3
ELSE
PART= 2
ENDIF
RETURN
ENDIF
ENDIF
ENDDO
INDEX= -1
END
C#SHOW_UPDATE ----------------------------------------------------------
SUBROUTINE SHOW_UPDATE (COLOR_MAP,LAST_INDEX)
C ---------- -----------
C Update the current display and color map.
C
C ENTRY: COLOR_MAP = Current color map setting.
C LAST_INDEX = Maximum color index.
C
C EXIT: COLOR_MAP = New color map settings.
INTEGER*4 LAST_INDEX {Highest color index}
INTEGER*4 COLOR_MAP(0:255) {Color map}
%include '/sys/ins/gpr.ins.ftn'
INTEGER*4 STATUS {General status word}
INTEGER*4 INDEX {Color index}
INTEGER*2 PART {part within box}
LOGICAL UNOBSCURED
INTEGER*2 TYPE {Event type}
INTEGER*2 POS(2) {Cursor position}
CHARACTER BUTTON*1 {Keystroke}
LOGICAL UP, DOWN
INTEGER*4 VALUE {Color value}
INTEGER*4 COLOR(3) {Individual colors}
INTEGER*4 INCREMENT {increment value}
INTEGER*2 KEYSET(16) {Defined keyboard keys}
DATA KEYSET /
1 16#0000,16#0000,16#0000,16#0000,
2 16#0000,16#0000,16#0000,16#0000,
3 16#FFFF,16#FFFF,16#FFFF,16#FFFF,
4 16#FFFF,16#FFFF,16#0000,16#0000/
DOWN(BUTTON)= (BUTTON .GE. 'a') .AND. (BUTTON .LE. 'c')
UP (BUTTON)= (BUTTON .GE. 'A') .AND. (BUTTON .LE. 'C')
C Enable the mouse buttons.
CALL GPR_$ENABLE_INPUT (GPR_$BUTTONS,KEYSET,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
CALL GPR_$SET_CURSOR_ACTIVE (.TRUE.,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
C Wait for a mouse button. The middle one terminates the process.
C The left button causes a specific color increment.
C The right button causes a similar decrement.
1 UNOBSCURED= GPR_$EVENT_WAIT (TYPE,BUTTON,POS,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
IF ((TYPE .EQ. GPR_$BUTTONS) .AND. DOWN(BUTTON)) THEN
IF (BUTTON .EQ. 'b') RETURN
IF (BUTTON .EQ. 'a') INCREMENT= +1
IF (BUTTON .EQ. 'c') INCREMENT= -1
C Check if the cursor is pointing to a color box.
CALL SHOW_GET_INDEX (INDEX,POS,PART)
IF ((INDEX .GE. 0) .AND. (INDEX .LE. LAST_INDEX)) THEN
C Update the color component until the mouse button is released again.
C No actual change is made for black/white displays.
2 UNOBSCURED= GPR_$COND_EVENT_WAIT (TYPE,BUTTON,POS,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
IF (TYPE .NE. GPR_$BUTTONS) THEN
VALUE= COLOR_MAP(INDEX)
COLOR(1)= AND(RSHFT(VALUE,16),16#FF)
COLOR(2)= AND(RSHFT(VALUE,8) ,16#FF)
COLOR(3)= AND( VALUE ,16#FF)
COLOR(PART)= COLOR(PART) + INCREMENT
IF (COLOR(PART) .GT. 255) COLOR(PART)= 255
IF (COLOR(PART) .LT. 0) COLOR(PART)= 0
VALUE= COLOR(1)*65536 + COLOR(2)*256 + COLOR(3)
COLOR_MAP(INDEX)= VALUE
CALL SHOW_VALUE (INDEX,VALUE)
IF (LAST_INDEX .GT. 1) THEN
CALL GPR_$SET_COLOR_MAP (INDEX,INT2(1),VALUE,STATUS)
IF (STATUS .NE. 0) CALL GPR_ERROR (STATUS)
ENDIF
GOTO 2
ENDIF
ENDIF
ENDIF
GOTO 1
END
============= cut here ============
--
Org: NIKHEF-H, National Institute for Nuclear and High-Energy Physics.
Mail: Kruislaan 409, P.O. Box 41882, 1009 DB Amsterdam, the Netherlands
Phone: (20)5925018 or 5925003 Telex: 10262 (hef nl)
UUCP: i91@nikhefh.hep.nl BITNET: nikhefh!i91@mcvax.bitnet