Initial commit
This commit is contained in:
Dener Silva
199
modsources/hershey.f77
Normal file
199
modsources/hershey.f77
Normal file
@@ -0,0 +1,199 @@
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user