Trailing-Edge
-
PDP-10 Archives
-
decuslib10-11
-
43,50540/colors.for
There are no other files named colors.for in the archive.
IMPLICIT INTEGER(A-Z)
DOUBLE PRECISION FILNAM
COMMON /AREA/HLS(8,3),LITNES(7),LETRS(13),CPP,PP,HUEINC,SATINC,
& SIGN,VALUE
C THIS PROGRAM MAKES IT EASY FOR A PERSON USING THE TEKTRONIX 4027
C TO CHANGE THE HUE, LIGHTNESS, AND SATURATION VALUES ON ANY PICTURE
C WHICH IS ALREADY DRAWN ON THE 4027 SCREEN. INSTEAD OF THE USER
C HAVING TO TYPE "!MAP C0,150,50,100" ETC., EVERY TIME HE WISHES TO
C CHANGE COLORS, HE MERELY TYPES IN H, L, OR S TO INCREMENT OR
C DECREMENT THE CURRENT HUE LIGHTNESS OR SATURATION VALUE FOR THE
C CURRENT COLOR. THIS MAKES IT EASIER TO GET THE MOST DESIRABLE
C COLOR COMBINATION FOR THAT PARTICULAR PICTURE.
C
C INITIALIZE ALL OF THE ARRAYS
C
CALL INITL
C
C TYPE A BRIEF HELP MESSAGE FOR THE USER'S BENEFIT
C
10 TYPE 15
15 FORMAT(' (H, L, S, C, P, E, ?, T, +, -, R, W, F)',
& ' FOR HELP (?) ')
C
C WE COME HERE TO PICK UP A CHARACTER FROM THE USER'S TERMINAL.
C THAT CHARACTER DETERMINES WHAT GETS DONE.
C
50 I=IKHAR(DUMY)
C
C CHECK FOR LOWER CASE LETTERS
C
IF(I.GT.96) I=I-32
C
C CHECK THE CHARACTER TO SEE IF IT REPRESENTS A VALID OPTION
C
DO 60 J=1,13
IF(I.EQ.LETRS(J)) GOTO 90
60 CONTINUE
C
C WE DIDN'T RECOGNIZE IT, SO PRINT THE BRIEF HELP MESSAGE AGAIN.
C
GOTO 10
C
C WE GOT A VALID OPTION, SO BRANCH TO THE APPROPRIATE CODE
C H L S C P + - E ? T R W F
90 GOTO(100,200,300,400,500,600,700,800,900,1000,1100,1200,1300)J
STOP 'THIS SHOULD NEVER BE TYPED OUT'
C
C CHARACTER ENTERED WAS "H". THE HUE WILL BE CHANGED.
C
100 HLS(CPP,1)=HLS(CPP,1)+HUEINC*SIGN
IF(HLS(CPP,1).GT.360) HLS(CPP,1)=HUEINC
IF(HLS(CPP,1).LT.0) HLS(CPP,1)=360-HUEINC
GOTO 10000
C
C CHARACTER ENTERED WAS "L". THE LIGHTNESS VALUE WILL CHANGE.
C FIND OUT WHAT THE CURRENT LIGHTNESS VALUE IS FIRST, THEN
C EITHER INCREMENT IT, OR DECREMENT IT.
C
200 DO 210 J=1,7
IF(HLS(CPP,2).EQ.LITNES(J)) GOTO 250
210 CONTINUE
J=4
250 VALUE=J
VALUE=VALUE+SIGN
IF(VALUE.LT.1) VALUE=7
IF(VALUE.GT.7) VALUE=1
HLS(CPP,2)=LITNES(VALUE)
GOTO 10000
C
C CHARACTER ENTERED WAS "S". THE SATURATION WILL CHANGE
C
300 HLS(CPP,3)=HLS(CPP,3)+SATINC*SIGN
IF(HLS(CPP,3).GT.100) HLS(CPP,3)=0
IF(HLS(CPP,3).LT.0) HLS(CPP,3)=100
GOTO 10000
C
C CHARACTER ENTERED WAS "C". CHANGE FROM ONE PAINT POT TO ANOTHER.
C THERE ARE 8 PAINT POTS LABELED C0 THROUGH C7.
C CHECK THE VALUES TO BE CERTAIN THAT THEY ARE IN THE VALID RANGE.
C
400 I=IKHAR(DUMY)
I=I-48
IF((I.GE.0).AND.(I.LE.7)) GOTO 450
TYPE 410
410 FORMAT(' AFTER ENTERING "C" YOU MUST ENTER A NUMBER FROM 0 TO 7')
GOTO 10
450 PP=I
CPP=PP+1
GOTO 10000
C
C CHARACTER ENTERED WAS A "P". ALL OF THE COLOR PAINT POTS WILL
C BE RETURNED TO THEIR DEFAULT PRIMARY COLORS.
C
500 CALL INITL
DO 550 J=1,8
JJ=J-1
TYPE 540,JJ,HLS(J,1),HLS(J,2),HLS(J,3)
540 FORMAT(' !MAP C',I1,',',I3,',',I3,',',I3,' ')
550 CONTINUE
TYPE 560
560 FORMAT(' ')
GOTO 50
C
C CHARACTER ENTERED WAS "+". VALUES WILL BE INCREMENTED.
600 SIGN=+1
GOTO 50
C
C CHARACTER ENTERED WAS "-". VALUES WILL BE DECREMENTED
700 SIGN=-1
GOTO 50
C
C CHARACTER ENTERED WAS "E". EXIT FROM THE PROGRAM.
C
800 STOP
C
C CHARACTER ENTERED WAS "?". TYPE OUT DETAILED INSTRUCTIONS
C
900 CALL HELPME
GOTO 50
C
C CHARACTER ENTERED WAS "T". TYPE OUT WHAT YOU HAVE
C WITHOUT CHANGING ANYTHING.
C
1000 TYPE 1010,PP,HLS(CPP,1),HLS(CPP,2),HLS(CPP,3)
1010 FORMAT(' MAP C',I1,',',I3,',',I3,',',I3,' ')
GOTO 50
C
C CHARACTER ENTERED WAS "R". READ A FILE CONTAINING
C COLOR COMMANDS WHICH WILL FILL EACH OF THE EIGHT PAINT POTS.
C
1100 TYPE 1110
1110 FORMAT(' WHAT FILE (CONTAINING COLOR COMMANDS) DO',
& ' YOU WANT TO READ? '$)
ACCEPT 1120,FILNAM
1120 FORMAT(A10)
IF(FILNAM.EQ.' ') GOTO 10
OPEN(UNIT=20,ACCESS='SEQIN',FILE=FILNAM,ERR=1190)
DO 1150 M=1,8
READ(20,1130,ERR=1194,END=1196) I,J,K
1130 FORMAT(8X,3I)
HLS(M,1)=I
HLS(M,2)=J
HLS(M,3)=K
JJ=M-1
TYPE 1140,JJ,I,J,K
1140 FORMAT(' !MAP C',I1,',',I3,',',I3,',',I3)
1150 CONTINUE
GOTO 10
1190 TYPE 1191,FILNAM
1191 FORMAT(' COULD NOT FIND THE FILE "',A10,'"')
GOTO 10
1194 TYPE 1195,FILNAM
1195 FORMAT(' HAD TROUBLE READING THE FILE "',A10,'"')
GOTO 10
1196 TYPE 1197
1197 FORMAT(' ENCOUNTERED END-OF-FILE BEFORE READING ALL OF THE',
& ' NEEDED VALUES.')
GOTO 10
C
C CHARACTER ENTERED WAS "W". WRITE THE CURRENT COLOR VALUES
C INTO A USER NAMED FILE.
C
1200 TYPE 1210
1210 FORMAT(' THE CURRENT COLORS WILL BE WRITTEN INTO A FILE.'/
& ' WHAT DO YOU WANT THE FILE''S NAME TO BE? '$)
ACCEPT 1220,FILNAM
1220 FORMAT(A10)
IF(FILNAM.EQ.' ') GOTO 10
1230 OPEN(UNIT=20,ACCESS='SEQOUT',FILE=FILNAM)
DO 1290 J=1,8
JJ=J-1
WRITE(20,1240) JJ,HLS(J,1),HLS(J,2),HLS(J,3)
1240 FORMAT('!MAP C',I1,',',I3,',',I3,',',I3)
1290 CONTINUE
CLOSE(UNIT=20)
GOTO 10
C
C CHARACTER ENTERED WAS "F". THE CURRENT COLOR VALUES WILL
C BE STORED IN A TEK4027 FUNCTION KEY (F1-F9)
C
1300 I=IKHAR(DUMY)
I=I-48
IF((I.GE.1).AND.(I.LE.9)) GOTO 1320
TYPE 1310
1310 FORMAT(' AFTER ENTERING "F" YOU MUST ENTER A NUMBER',
& ' FROM 1 TO 9')
GOTO 10
1320 IZ=0
TYPE 1330, I,IZ,HLS(1,1),HLS(1,2),HLS(1,3)
1330 FORMAT(' !LEARN F',I1,'/!MAP C',I1,1X,I3,',',I3,',',I3,'/-')
DO 1350 J=2,7
JM1=J-1
TYPE 1340,JM1,HLS(J,1),HLS(J,2),HLS(J,3)
1340 FORMAT(' /!MAP C',I1,' ',I3,',',I3,',',I3,'/-')
1350 CONTINUE
IZ=7
TYPE 1360, IZ,HLS(8,1),HLS(8,2),HLS(8,3)
1360 FORMAT(' /!MAP C',I1,' ',I3,',',I3,',',I3,'/13')
GOTO 10
C
C THIS IS THE OUTPUT ROUTINE. IT IS AN ASCII INSTRUCTION STRING TO
C THE TEKTRONIX 4027 TO CHANGE EITHER THE HUE, LIGHTNESS OR SATURATION
C OF ONE OF THE EIGHT COLOR PAINT POTS C0 THROUGH C7.
C
10000 TYPE 10100, PP,HLS(CPP,1),HLS(CPP,2),HLS(CPP,3)
10100 FORMAT(' !MAP C',I1,',',I3,',',I3,',',I3,' ')
TYPE 10200, PP,HLS(CPP,1),HLS(CPP,2),HLS(CPP,3)
10200 FORMAT(' MAP C',I1,',',I3,',',I3,',',I3,' ')
GOTO 50
END
SUBROUTINE INITL
IMPLICIT INTEGER (A-Z)
COMMON /AREA/HLS(8,3),LITNES(7),LETRS(13),CPP,PP,HUEINC,SATINC,
& SIGN,VALUE
C H
LETRS(1)=72
C L
LETRS(2)=76
C S
LETRS(3)=83
C C
LETRS(4)=67
C P
LETRS(5)=80
C +
LETRS(6)=43
C -
LETRS(7)=45
C E
LETRS(8)=69
C ?
LETRS(9)=63
C T
LETRS(10)=84
C R
LETRS(11)=82
C W
LETRS(12)=87
C F
LETRS(13)=70
LITNES(1)=0
LITNES(2)=20
LITNES(3)=40
LITNES(4)=50
LITNES(5)=60
LITNES(6)=80
LITNES(7)=100
DO 400 J=1,8
HLS(J,2)=50
HLS(J,3)=100
400 CONTINUE
HLS(1,2)=100
HLS(8,2)=0
HLS(1,1)=0
HLS(2,1)=120
HLS(3,1)=240
HLS(4,1)=0
HLS(5,1)=180
HLS(6,1)=300
HLS(7,1)=60
HLS(8,1)=0
HUEINC=20
SATINC=50
VALUE=4
SIGN=1
PP=0
CPP=1
RETURN
END
SUBROUTINE HELPX
TYPE 10
10 FORMAT(
& ' '
& /' This program makes it easier for you to change the hue,'
& /' lightness, or saturation values (H,L,S) of any of the eight'
& /' colors which a Tektronix 4027 color terminal is capable of'
& /' displaying at one time. To change colors you must normally'
& /' type: '
& /' MAP C0 80,50,100 '
& /' (The numbers will vary of course.) "COLORS" enables you to'
& /' change the H,L,S values of the eight paint pots (C0 through'
& /' C7) using a single keystroke. This makes it easy to adjust'
& /' the colors of a picture which has already been displayed on'
& /' the Tektronix 4027 screen without typing out the entire'
& /' command each time. '
& /' This program recognizes thirteen characters. They are: '
& /' '
& /' H The Hue will be changed. The hue (color) will change as'
& /' the numbers vary from 0 to 360 degrees. '
& /' EX. MAP C0 0,50,100 MAP C0 340,50,100 '
& /' '
& )
TYPE 20
20 FORMAT(
& ' L The lightness will be varied. The amount of black or'
& /' white added to the hue will vary from all black (0) to'
& /' all white (100). The program allows seven values. 0,'
& /' 20, 40, 50, 60, 80, and 100. '
& /' EX. MAP C0 180,20,100 MAP C0 180,80,100 '
& /' '
& /' S The saturation of the hue will be varied. At zero'
& /' saturation there is no color present at all (gray). At'
& /' 50% saturation all colors look muted. At 100%'
& /' saturation, all hues are at their brightest. '
& /' EX. MAP C0 120,50,0 MAP C0 120,50,100 '
& /' '
& /' C Changes the color pot which you are modifying. You must'
& /' enter a number from 0 to 7 to complete the command. In'
& /' the first example "C5" was entered. In the second'
& /' example "C2" was entered. '
& /' EX. MAP C5 120,50,100 MAP C2 120,50,100 '
& /' '
& /' E The program will stop. You can also type CTRL-C'
& )
TYPE 30
30 FORMAT(
& ' (control-C) and get the same effect. The picture on the'
& /' Tektronix 4027 will not be affected. '
& /' '
& /' T You can see the values of the current paint pot without'
& /' changing them by typing "T". '
& /' '
& /' P If you enter "P" all of the paint pots will be changed'
& /' to default values. The default colors in C0 through C7'
& /' are: white, red, green, blue, yellow, cyan, magenta, and'
& /' black. '
& /' '
& /' + H, L, and S values will be incremented by some amount.'
& /' The effect of "+" will remain until you type in "-". '
& /' '
& /' - H, L, and S values will be decremented by some amount.'
& /' The effect of "-" will remain until you type in "+". '
& /' '
& )
TYPE 40
40 FORMAT(
& ' R Reads a file which (hopefully) contains eight Tektronix'
& /' 4027 color commands. You will be asked for a filename.'
& /' The picture will change to the colors contained in the'
& /' file. '
& /' '
& /' W Writes a file which contains eight Tektronix 4027 color'
& /' commands. You will be asked for a filename. Be careful'
& /' not to give the name of a file which already exists,'
& /' because it will be overwritten. You can read the file'
& /' later with the "R" command. '
& /' '
& /' F The current color values will be stored in one of the'
& /' first nine Tektronix 4027 Function keys (F1-F9). Then,'
& /' when you press that function key, your display will'
& /' change to the colors which it contains. Note that'
& /' pressing the function key does NOT change the current'
& /' colors stored in this program; it changes the DISPLAY to'
& /' the colors stored in the function key. '
& /' '
& )
TYPE 50
50 FORMAT(
& ' ? Types out this help file. If you have any further'
& /' questions, call Dennis Clark at 576-7384. '
& )
RETURN
END
SUBROUTINE HELPME
COMMON /AREA/HLS(8,3),LITNES(7),LETRS(12),CPP,PP,HUEINC,SATINC,
& SIGN,VALUE
C
C THIS SUBROUTINE CONTAINS THE HELP MESSAGES FOR EACH OF THE COMMANDS
C OF THE MAIN PROGRAM. IT ALSO CALLS THE SUBROUTINE CONTAINING THE
C DETAILED HELP FILE WHICH IS ABOUT 100 LINES LONG.
C
TYPE 3
3 FORMAT(/' H=Hue L=Litness S=Saturation C=Change P=Primary'
& ,' E=Exit T=Type ?=Help'/' +=Increment',
& ' -=Decrement R=Read W=Write F=Function key'
& ,' ...TYPE ONE '$)
C
C GET A CHARACTER AND CHECK TO SEE IF IT IS ONE WE KNOW ABOUT
C
I=IKHAR(DUMY)
IF(I.GT.96)I=I-32
DO 5 J=1,13
IF(I.EQ.LETRS(J))GOTO 8
5 CONTINUE
C
C WE DIDN'T RECOGNIZE IT, SO JUST RETURN
C
6 TYPE 7
7 FORMAT(/' (H, L, S, C, P, E, ?, T, +, -, R, W, F)',
& ' FOR HELP (?) ')
RETURN
C
C WE RECOGNIZED THE CHARACTER, SO BRANCH TO THE APPROPRIATE MESSAGES.
C
C H L S C P + - E ? T R W F
8 GOTO(10,20,30,40,50,60,70,80,90,100,110,120,130),J
10 TYPE 11
11 FORMAT(/' Typing H causes the HUE of the current paint'
& ,' pot to be incremented or'/' decremented depending',
& ' on whether the + or - is in effect. ')
RETURN
20 TYPE 21
21 FORMAT(/' Typing L causes the LIGHTNESS of the current color to',
& ' be incremented'/' or decremented depending on whether the +'
& ,' or - is in effect. ')
RETURN
30 TYPE 31
31 FORMAT(/' Typing S causes the SATURATION of the current hue to',
& ' be incremented or'/' decremented depending on whether the',
& ' + or - is in effect. ')
RETURN
40 TYPE 41
41 FORMAT(/' Typing Cn (n=0-7) changes the current paint pot to',
& ' one of the'/' eight paint pots C0 through C7. ')
RETURN
50 TYPE 51
51 FORMAT(/' P causes all of the paint pots C0-C7 to'
& ,' revert to their initial values.'/' white, red, green, ',
& 'blue, yellow, cyan, magenta, and black. ')
RETURN
60 TYPE 61
61 FORMAT(/' Typing + causes the H, L, and S values to be'/
& ' incremented by some amount. ')
RETURN
70 TYPE 71
71 FORMAT(/' Typing - causes the H, L, and S values to be'/
& ' decremented by some amount. ')
RETURN
80 TYPE 81
81 FORMAT(/' Typing E causes you to Exit from the program.',
& ' The picture on the screen'/' will not be affected.',
& ' You can also type a control-C to exit. ')
RETURN
90 TYPE 91
91 FORMAT(/' If you want to see the entire set of instructions,'/
& ' (about 100 lines of information) type Y. '$)
I=IKHAR(DUMY)
IF(I.GT.96) I=I-32
IF(I.EQ.89)GOTO 97
93 TYPE 94
94 FORMAT(/' (H, L, S, C, P, E, ?, T, +, -, R, W, F)',
& ' FOR HELP (?) ')
RETURN
97 CALL HELPX
RETURN
100 TYPE 101
101 FORMAT(/' Typing T causes a message to be printed. It tells',
& ' what the current'/' paint pot is, (C0-C7) and what H, L,',
& ' and S values it contains. ')
RETURN
110 TYPE 111
111 FORMAT(/' Typing R causes the program to read a file ',
& 'which you name.'/' You can create files with the',
& ' W (Write) command. ')
RETURN
120 TYPE 121
121 FORMAT(/' Typing W causes the program to write the values',
& ' of the current colors'/' into a file which you name.',
& ' Read them later with the R command. ')
RETURN
130 TYPE 131
131 FORMAT(/' Typing Fn (n=1-9) causes the current colors of all',
& ' eight paint pots'/' to be stored in one of the first nine',
& ' (F1-F9) function keys. ')
RETURN
END