200 lines
7.2 KiB
Fortran
200 lines
7.2 KiB
Fortran
c .. display all of the Hershey font data
|
|
c
|
|
c .. By James Hurt when with
|
|
c .. Deere and Company
|
|
c .. John Deere Road
|
|
c .. Moline, IL 61265
|
|
c
|
|
c .. Author now with Cognition, Inc.
|
|
c .. 900 Technology Park Drive
|
|
c .. Billerica, MA 01821
|
|
c
|
|
c .. graphics subroutines
|
|
c .. identy - initialize graphics
|
|
c .. vwport - set where to display image on screen
|
|
c .. - full screen is 0.0 to 100.0 in vertical (y) direction
|
|
c .. - 0.0 to ???.? in horizontal (x) direction
|
|
c .. - origin is lower left corner of screen
|
|
c .. window - set window limits in world coordinates
|
|
c .. newpag - if action left to be take on existing screen, take it
|
|
c .. - then take actions to start with a blank screen
|
|
c .. jnumbr - display an integer (code included)
|
|
c .. move - set current cursor position to (x,y)
|
|
c .. draw - draw from current cursor position to (x,y)
|
|
c .. - then set current cursor position to (x,y)
|
|
c .. - The point (x,y) is always in world coordinates
|
|
c .. skip - Make the next draw really be a move
|
|
c .. waitcr - finish all graphics actions then let the user look at
|
|
c .. - the image. User signals (usually by pressing RETURN)
|
|
c .. - when it is safe to continue.
|
|
c .. grstop - finish all graphics routines (no more graphics to follow)
|
|
c
|
|
external identy,vwport,window,newpag,jnumbr,move ,draw ,skip,
|
|
x waitcr,grstop
|
|
c .. local variables
|
|
real deltac, deltar, colmax
|
|
parameter (deltac = 6.25, deltar = 6.25, colmax = 100.0)
|
|
c .. font data file name
|
|
character*80 name
|
|
c .. font data
|
|
character*1 line(2,256)
|
|
c .. co-ordinates
|
|
real x,y,col,row
|
|
c .. which data point and which character
|
|
integer ipnt,ich,nch,i
|
|
intrinsic ichar
|
|
cexecutable code begins
|
|
c .. file unit number
|
|
kfile=1
|
|
c .. get hershey file name
|
|
write(*,'(a)') ' packed hershey font file name'
|
|
read(*,'(a)') name
|
|
open(unit=kfile,file=name,status='old')
|
|
c .. initialize graphics
|
|
call identy
|
|
c .. want square picture for each character
|
|
c .. Note: most but not all Hershey font characters fit inside this window
|
|
call window(-15.0, 15.0,-15.0, 15.0)
|
|
c .. loop per screen
|
|
5 continue
|
|
c .. start with a clean sheet
|
|
call newpag
|
|
c .. where to display this character
|
|
col = 0.0
|
|
row = 100.0
|
|
c .. loop per character
|
|
10 continue
|
|
c .. read character number and data
|
|
read(unit=kfile,'(i5,i3,64a1/(72a1))',end=90) ich,nch,
|
|
x (line(1,i),line(2,i),i=1,nch)
|
|
c .. select view port (place character on screen)
|
|
call vwport(col,col+deltac,row-deltar,row)
|
|
c .. identify character
|
|
call jnumbr(ich,4,-15.0,9.0,5.0)
|
|
c .. draw character limits
|
|
c .. Note: this data can be used for proportional spacing
|
|
x=ichar(line(1,1))-ichar('R')
|
|
y=ichar(line(2,1))-ichar('R')
|
|
call move(x,-10.0)
|
|
call draw(x,10.0)
|
|
call move(y,-10.0)
|
|
call draw(y,10.0)
|
|
c .. first data point is a move
|
|
call skip
|
|
c .. loop per line of data
|
|
do 20 ipnt = 2, nch
|
|
c .. process vector number ipnt
|
|
if(line(1,ipnt).eq.' ') then
|
|
c .. next data point is a move
|
|
call skip
|
|
else
|
|
c .. draw (or move) to this data point
|
|
x=ichar(line(1,ipnt))-ichar('R')
|
|
y=ichar(line(2,ipnt))-ichar('R')
|
|
c .. Note that Hershey Font data is in TV coordinate system
|
|
call draw(x,-y)
|
|
endif
|
|
20 continue
|
|
c .. end of this character
|
|
col = col + deltac
|
|
if( col .lt. colmax ) go to 10
|
|
col = 0.0
|
|
row = row - deltar
|
|
if( row .ge. deltar ) go to 10
|
|
call waitcr
|
|
go to 5
|
|
90 continue
|
|
call waitcr
|
|
c .. all done
|
|
call grstop
|
|
end
|
|
subroutine jnumbr( number, iwidth, x0, y0, height )
|
|
integer number, iwidth
|
|
real x0, y0, height
|
|
c .. draw one of the decimal digits
|
|
c .. number = the integer to be displayed
|
|
c .. iwidth = the number of characters
|
|
c .. (x0, y0) = the lower left corner
|
|
c .. height = height of the characters
|
|
c
|
|
c
|
|
c .. By James Hurt when with
|
|
c .. Deere and Company
|
|
c .. John Deere Road
|
|
c .. Moline, IL 61265
|
|
c
|
|
c .. Author now with Cognition, Inc.
|
|
c .. 900 Technology Park Drive
|
|
c .. Billerica, MA 01821
|
|
c
|
|
c .. graphics (graphics) routines called
|
|
external skip,draw
|
|
c .. local variables used
|
|
integer ipnt, ipos, ival, idigit
|
|
real x, y, scale
|
|
real xleft, ylower
|
|
c .. character data for the ten decimal digit characters
|
|
c .. data extracted from one of the Hershey fonts
|
|
integer start(0:10), power(0:9)
|
|
character*1 line(2,104)
|
|
data power/ 1, 10, 100, 1000, 10000, 100000, 1000000, 10000000,
|
|
x 100000000, 1000000000 /
|
|
data start/0,11,14,22,36,42,55,68,73,91,104/
|
|
c 0:poly(4 9,2 8,1 6,1 3,2 1,4 0,6 1,7 3,7 6,6 8,4 9)
|
|
c 1:poly(2 7,4 9,4 0)
|
|
c 2:poly(1 8,3 9,5 9,7 8,7 6,6 4,1 0,7 0)
|
|
c 3:poly(1 8,3 9,5 9,7 8,7 6,5 5)
|
|
c poly(4 5,5 5,7 4,7 1,5 0,3 0,1 1)
|
|
c 4:poly(5 9,5 0)
|
|
c poly(5 9,0 3,8 3)
|
|
c 5:poly(2 9,1 5,3 6,4 6,6 5,7 3,6 1,4 0,3 0,1 1)
|
|
c poly(2 9,6 9)
|
|
c 6:poly(6 9,4 9,2 8,1 6,1 3,2 1,4 0,6 1,7 3,6 5,4 6,2 5,1 3)
|
|
c 7:poly(7 9,3 0)
|
|
c poly(1 9,7 9)
|
|
c 8:poly(3 9,1 8,1 6,3 5,5 5,7 6,7 8,5 9,3 9)
|
|
c poly(3 5,1 4,1 1,3 0,5 0,7 1,7 4,5 5)
|
|
c 9:poly(7 6,6 4,4 3,2 4,1 6,2 8,4 9,6 8,7 6,7 3,6 1,4 0,2 0)
|
|
c
|
|
data line/'R','M','P','N','O','P','O','S','P','U','R','V','T','U',
|
|
A'U','S','U','P','T','N','R','M','P','O','R','M','R
|
|
B','V','O','N','Q','M','S','M','U','N','U','P','T','R','O',
|
|
C'V','U','V','O','N','Q','M','S','M','U','N','U','P','S','Q
|
|
D',' ','R','R','Q','S','Q','U','R','U','U','S','V','Q','V','O','U',
|
|
E'S','M','S','V',' ','R','S','M','N','S','V','S','P
|
|
F','M','O','Q','Q','P','R','P','T','Q','U','S','T','U','R','V','Q',
|
|
G'V','O','U',' ','R','P','M','T','M','T','M','R','M','P','N
|
|
H','O','P','O','S','P','U','R','V','T','U','U','S','T','Q','R','P',
|
|
I'P','Q','O','S','U','M','Q','V',' ','R','O','M','U','M',
|
|
J'Q','M','O','N','O','P','Q','Q','S','Q','U','P','U','N','S',
|
|
K'M','Q','M',' ','R','Q','Q','O','R','O','U','Q','V','S','V','U','U
|
|
L','U','R','S','Q','U','P','T','R','R','S','P','R','O','P',
|
|
M'P','N','R','M','T','N','U','P','U','S','T','U','R','V','P','V'/
|
|
c .. compute scale factor and lower left of first digit
|
|
scale = height/10.0
|
|
xleft = x0
|
|
ylower = y0
|
|
ival = number
|
|
c .. loop for each position
|
|
do 30 ipos = iwidth,1,-1
|
|
idigit = mod( ival/power(ipos-1), 10 )
|
|
c .. first data point is a move
|
|
call skip
|
|
c .. loop over data for this digit
|
|
do 20 ipnt=start(idigit)+1,start(idigit+1)
|
|
if(line(1,ipnt).eq.' ') then
|
|
c .. next data point is a move
|
|
call skip
|
|
else
|
|
c .. draw (or move) to this data point
|
|
x=ichar(line(1,ipnt))-ichar('N')
|
|
y=ichar(line(2,ipnt))-ichar('V')
|
|
call draw(xleft+scale*x,ylower-scale*y)
|
|
endif
|
|
20 continue
|
|
c .. move for next digit
|
|
xleft = xleft + height
|
|
30 continue
|
|
end
|
|
|