PROGRAM COLORIT
C *****************************************
C By Dale Bickel, Senior Electronics Engineer, dale.bickel@fcc.gov
C Audio Division, FCC (USA)
C http://www.fcc.gov/mb/audio/
C
C This Fortran CGI application may be copied and/or
C modified freely. No restrictions are placed on its use.
C ******************************************
C This program was created to develop a Fortran CGI. It
C receives input from HTML and generates HTML output.
C It could easily be modified to allow input from the
C keyboard or a Fortran routine.
C CGI access is required if the program is used as written.
C The programming has not been optimized.
C ******************************************
C This Fortran 77 program prints the HTML color corresponding
C to a six-place hexadecimal number. It also prints, in table form,
C the colors which result by increasing or decreasing a single
C digit from the entered number.
C *******************************************
C First, we read the six digit value sent over from the HTML.
C Because this program uses the GET method, this program
C reads the environment variable QUERY_STRING. We
C read each character from the string, and ignore unnecessary
C characters (here, ... ?input= ).
C ********************************************
C QS represents the character string QUERY_STRING
C Digit is the numerical value of the corresponding character
C 12 places are required to cover the whole QUERY_STRING
C input=AAAAAA
C ********************************************
C Fortran reminders:
C Column 1 -- enter C for Comments
C Column 2-5 -- statement labels
C Column 6 -- continuation character
C Column 7 -- start commands in this column
C Column 72 -- Last column of statement -- use continuation
C characters or another Format statement if command is longer
C First Statement of Program : **********************
Character*12 QS
Character*1 newcolor
Dimension digit(12)
C ********************************************
C Retrieve environment variable QUERY_STRING, using
C "getenv" get environment variable subroutine on system.
C This command may differ on other computer systems.
C QUERY_STRING will be stored in the character string QS.
call getenv('QUERY_STRING', QS)
C ******************************************
C Now we set up the Fortran code to generate HTML output.
C The Content-type: text/html // statement accomplishes
C this action. The slashes // are VERY IMPORTANT!!
C Watch the placement of the quotes!
Write(6,55)
55 Format("Content-Type: text/html"//)
C ******************************************
C From now on, the usual HTML tags will appear inside
C FORMAT statements. Watch the quotation marks!
C Note that HTML tags may be placed on the same line, or
C one tag may be broken up onto different lines.
Write(6,64)
Write(6,65)
Write(6,66) ! Link style sheet, if desired
Write(6,67)
64 Format(''/)
65 Format('COLORIT Color Generator --- A Fortran CGI'/)
66 Format(''/)
67 Format(''/''/)
C Note the placement of the quote marks for the HTML
C code bgcolor="#FFFFFF"> in the previous statement
C ******************************************
C Here we generate the HTML for the output document's
C heading:
Write(6,1400)
Write(6,1401)
Write(6,1402)
Write(6,1403)
Write(6,1404)
Write(6,1405)
Write(6,1406)
Write(6,1407)
Write(6,1408)
Write(6,1410)
Write(6,1411)
Write(6,1412)
Write(6,1413)
Write(6,1414)
Write(6,1415)
Write(6,1416)
Write(6,1417)
Write(6,1418)
1400 FORMAT('
')
1401 FORMAT('')
1404 FORMAT('
' )
1410 FORMAT('
')
1411 FORMAT('
')
1414 FORMAT('COLORIT Color ')
1415 FORMAT(' Generator ------ A Fortran CGI
Page 2')
1418 FORMAT(' -- Output
')
C *************************************************
C Write the pertinent part of the Input QUERY_STRING to output
Write(6,79)
79 Format('
' )
C ********************************************
C Here we replicate the initial HTML Form data entry fields
Write(6,87)
Write(6,88)
Write(6,89)
Write(6,90)
Write(6,96)
Write(6,92)
Write(6,93)
Write(6,94)
Write(6,95)
Write(6,96)
87 Format('
')
96 Format('
')
C***********************************************
C Be aware that "numbers" in the query_string really
C aren't numbers -- they're ASCII characters. They must
C be converted to integer or real numbers before use,
C e.g., if(QS(*:*).eq."1") x=1
C
C Character entries in the query string can be retrieved
C by QS(first char. of substring : last char of substring)
C Both first and last characters will be retrieved.
C
C In the following code, a numerical character is looked for and
C converted into its decimal counterpart.
Do i=7,12,1
If(QS(i:i).eq."0") then
digit(i)=0.0
Else if(QS(i:i).eq."1") then
digit(i)=1
Else if(QS(i:i).eq."2") then
digit(i)=2
Else if(QS(i:i).eq."3") then
digit(i)=3
Else if(QS(i:i).eq."4") then
digit(i)=4
Else if(QS(i:i).eq."5") then
digit(i)=5
Else if(QS(i:i).eq."6") then
digit(i)=6
Else if(QS(i:i).eq."7") then
digit(i)=7
Else if(QS(i:i).eq."8") then
digit(i)=8
Else if(QS(i:i).eq."9") then
digit(i)=9
Else if((QS(i:i).eq."A").or.(QS(i:i).eq."a")) then
digit(i)=10
Else if((QS(i:i).eq."B").or.(QS(i:i).eq."b")) then
digit(i)=11
Else if((QS(i:i).eq."C").or.(QS(i:i).eq."c")) then
digit(i)=12
Else if((QS(i:i).eq."D").or.(QS(i:i).eq."d")) then
digit(i)=13
Else if((QS(i:i).eq."E").or.(QS(i:i).eq."e")) then
digit(i)=14
Else if((QS(i:i).eq."F").or.(QS(i:i).eq."f")) then
digit(i)=15
Else if(QS(i:i).eq."") then
Go to 162
Else
Write(6,159) QS(i:i)
159 Format(A ' is not a valid character -- ')
Write(6,160)
160 Format('Please reenter six characters,
')
Write(6,161)
161 Format('of type 0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F
')
Go to 335
162 End if
End do
Write(6,167)
Write(6,168)
Write(6,169)
167 Format('
')
168 Format('
')
169 Format('
')
C Loop through 9 rows, 4 above & 4 below the entered color code
Do j=-4,4,1
Write(6,177)
177 Format('
')
If(j.eq.0) then
Write(6,181)QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
181 Format('
. ')
C Create a small label table, inside the data element
Write(6,189)
Write(6,190) QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
189 Format('
')
190 Format('Submitted color= 'AAAAAA'
')
Write(6,193)
193 Format(' *
')
Go to 320
else if(j.ne.0) then
C Create HTML across the row -- 6 data elements
Write(6,200)
200 Format('
')
Do i=7,12,1
Number=digit(i)+j
If(number.eq.0) then
newcolor="0"
Else if(number.eq.1) then
newcolor="1"
Else if(number.eq.2) then
newcolor="2"
Else if(number.eq.3) then
newcolor="3"
Else if(number.eq.4) then
newcolor="4"
Else if(number.eq.5) then
newcolor="5"
Else if(number.eq.6) then
newcolor="6"
Else if(number.eq.7) then
newcolor="7"
Else if(number.eq.8) then
newcolor="8"
Else if(number.eq.9) then
newcolor="9"
Else if(number.eq.10) then
newcolor="A"
Else if(number.eq.11) then
newcolor="B"
Else if(number.eq.12) then
newcolor="C"
Else if(number.eq.13) then
newcolor="D"
Else if(number.eq.14) then
newcolor="E"
Else if(number.eq.15) then
newcolor="F"
End if
If((number.lt.0).or.(number.gt.15)) then
Write(6,243)
243 Format('
No color
')
Go to 320
End if
Write(6,243)
If(i.eq.7) then
write(6,270)newcolor,QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
Else if(i.eq.8) then
Write(6,270)QS(7:7),newcolor,QS(9:9),QS(10:10),QS(11:11),QS(12:12)
Else if(i.eq.9) then
Write(6,270)QS(7:7),QS(8:8),newcolor,QS(10:10),QS(11:11),QS(12:12)
Else if(i.eq.10) then
Write(6,270)QS(7:7),QS(8:8),QS(9:9),newcolor,QS(11:11),QS(12:12)
Else if(i.eq.11) then
Write(6,270)QS(7:7),QS(8:8),QS(9:9),QS(10:10),newcolor,QS(12:12)
Else if(i.eq.12) then
Write(6,270)QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),newcolor
End if
270 Format(AAAAAA' align=' 'center' '> ')
C Create a label table inside the data element
Write(6,276)
276 Format('
')
If(i.eq.7) then
Write(6,311)
Write(6,312)newcolor,QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
Write(6,313)newcolor,QS(8:8),QS(9:9),QS(10:10),QS(11:11),QS(12:12)
Else if(i.eq.8) then
Write(6,311)
Write(6,312)QS(7:7),newcolor,QS(9:9),QS(10:10),QS(11:11),QS(12:12)
Write(6,313)QS(7:7),newcolor,QS(9:9),QS(10:10),QS(11:11),QS(12:12)
Else if(i.eq.9) then
Write(6,311)
Write(6,312)QS(7:7),QS(8:8),newcolor,QS(10:10),QS(11:11),QS(12:12)
Write(6,313)QS(7:7),QS(8:8),newcolor,QS(10:10),QS(11:11),QS(12:12)
Else if(i.eq.10) then
Write(6,311)
Write(6,312)QS(7:7),QS(8:8),QS(9:9),newcolor,QS(11:11),QS(12:12)
Write(6,313)QS(7:7),QS(8:8),QS(9:9),newcolor,QS(11:11),QS(12:12)
Else if(i.eq.11) then
Write(6,311)
Write(6,312)QS(7:7),QS(8:8),QS(9:9),QS(10:10),newcolor,QS(12:12)
Write(6,313)QS(7:7),QS(8:8),QS(9:9),QS(10:10),newcolor,QS(12:12)
Else if(i.eq.12) then
Write(6,311)
Write(6,312)QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),newcolor
Write(6,313)QS(7:7),QS(8:8),QS(9:9),QS(10:10),QS(11:11),newcolor
End if
Write(6,314)
311 Format('
NOTE: Because the colors')
332 Format(' above are shown as BACKGROUNDS, they will')
333 Format(' not show up when this page is printed.
')
335 Continue
Write(6,337)
Write(6,338)
Write(6,339)
Write(6,338)
Write(6,340)
337 Format('This document may be accessed at ')
340 Format('
')
C Now that all of the colors have been shown, set up end-of-page
C links & gifs
call audio_page_end(6)
C ********************************************
C Without a closing HTML statement, you may not see ANY output!
Write(6,999)
999 Format('')
Call Exit(0)
C END OF PROGRAM
END
SUBROUTINE audio_page_end(luout)
character *500 line
character *100 where
! luout=6 is standard output
1 format(A)
! This subroutine shows how a CGI can incorporate common local
! files into the output for a larger document.
! Read and print end of html page stuff common across the FCC site
! Change this as needed to match you local files. Or comment the
! "call audio_page_end(6)" statement out in the main program.
80 format("")
where(1:38)="/pub/www/pub/ssi/ssi-fccbottommenu.txt" ! file location
open(83,file=where(1:38),form="formatted",status="unknown", ! on local machine
&err=86)
rewind(83)
85 continue
read(83,1,end=86,err=86) line(1:500)
write(luout,1) line(1:(length(line)))
go to 85
86 rewind(83)
close(83,status="keep") ! Keep the input file intact
where(1:41)="/pub/www/bureaus/mb/ssi-mbcontactinfo.txt" ! file location
open(84,file=where(1:41),form="formatted",status="unknown", ! on local machine
&err=88)
rewind(84)
87 continue
read(84,1,end=88,err=88) line(1:500)
write(luout,1) line(1:(length(line)))
go to 87
88 rewind(84)
close(84,status="keep") ! Keep the input file intact
write(6,80)
where(1:39)="/pub/www/pub/ssi/ssi-fcccontactinfo.txt" ! file location
open(85,file=where(1:39),form="formatted",status="unknown", ! on local machine
&err=90)
rewind(85)
89 continue
read(85,1,end=90,err=90) line(1:500)
write(luout,1) line(1:(length(line)))
go to 89
90 rewind(85)
close(85,status="keep") ! Keep the input file intact
return
end
! =======================================================================
! LENGTH.F:
!
! Function by John Boursy, January 1984.
!
! This function receives a character string, and returns its length
! as an integer. Note: this is different from the intrinsic LEN
! function in FORTRAN. This function LENGTH returns the length of
! the string out to the last non-blank character, while LEN returns
! the entire length of the string (including blanks).
!
function length(string)
!
character string*(*)
!
length = len(string)
! move back from end of string
do 100 loop = length, 1, -1
if (string(loop:loop) .ne. ' ') goto 200
100 continue
! completely blank string
length = 0
!
return
200 continue
length = loop
return
end