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