c	File LA100C.FOR
c	Rev. 8405.303
c
c	Contributed to DECUS at Spring 1984 U.S. Symposium
c	by Rob Hamilton of Multiware Inc., Davis, CA
c
c	*****************************************************
c	   This software is provided on an "AS-IS" basis.
c	*****************************************************
c
	Subroutine CHARGN (nch, string, ixp, iyp)
	integer nch, ixp, iyp
	byte string(1)
c
c	*****************************************************
c
c	Dot Matrix Character Generation
c
c	nch   - integer number of characters in string
c	string- byte string of characters
c	ixp   - beginning X coordinate
c	iyp   - beginning Y coordinate
c
c	*****************************************************
c
c	ipath - describes character path;
c		1 is left to right,
c		2 is from bottom to top
c		3 is upside down, right to left,
c		4 is from top to bottom
c
c	isize - describes size factor;
c		1 character box is 7 x 11 dots
c		2                 14 x 22
c		3                 21 x 33
c               4                 28 x 44  ... etc.
c	*****************************************************
c
	integer ibits(8)
	integer ixform, iyform
	integer ixpath, iypath, ixup, iyup
c
	byte chrdot
	common /CHRGEN/ ixform(4), iyform(4), ixpath(4), iypath(4),
	1		ixup(4), iyup(4), isize, ipath, ispath,
	2		chrdot(480)
c
	data ixform / 1, 0, -1, 0 /		! these do not change
	data iyform / 0, 1, 0, -1 /
c
	data ixpath / 2, 0, -2, 0 /		! these get set by CHRSIZ.
	data iypath / 0, 2, 0, -2 /
c
	data ixup   / 0, -2, 0, 2 /		! so do these.
	data iyup   / 2, 0, -2, 0 /
c
	data isize / 2 /			! default values
	data ipath / 1 /
	data ispath / 1 /
c
	data ibits / 1, 2, 4, 8, 16, 32, 64, 128 /
c
	call CHRDAT				! (non executable)
c
	ixcorn = ixp				! mark current position
	iycorn = iyp
	ixcp = ixpath(ipath)			! char dot path
	iycp = iypath(ipath)
	ixrp = ixform(ipath)			! raster dot path
	iyrp = iyform(ipath)
	ixcu = ixup(ipath)			! char dot up step
	iycu = iyup(ipath)
	index = ipath -1
	if (index .le. 0) index = 4
	ixru = ixform(index)			! raster up step
	iyru = iyform(index)
c
	do 500 ndx = 1,nch			! for each character...
	  index = string(ndx) .and. "177	! get ASCII value,
	  index = (index - 32) * 5 + 1		! find first dot entry
	  if (index .le. 0) index = 476		! illegal? Point to error
	  idecnd = chrdot(index) .and. "200	! decender char?
	  idcx = 0
	  idcy = 0
	  if (idecnd .eq. 0) go to 120
	  idcx = ixcu + ixcu
	  idcy = iycu + iycu
c
  120	  ix30 = ixcorn
	  iy30 = iycorn
	  do 300 icol=1,5
	    ix28 = ix30 - idcx			! adjust for decender
	    iy28 = iy30 - idcy
	    ibyte = chrdot(index)
	    do 280 irow=1,7
	      ibit =  ibyte .and. ibits(irow)
	      ix26 = ix28
	      iy26 = iy28
	      do 260 ixd=1,isize		! n raster dots wide
	        ix25 = ix26
		iy25 = iy26
		do 250 iyd=1,isize		! m raster dots high
		  if (ibit .ne. 0) call SETDOT (ix25, iy25)
		  ix25 = ix25 + ixru
		  iy25 = iy25 + iyru		! next raster dot up
  250	        continue
	        ix26 = ix26 + ixrp		! next raster dot over
	        iy26 = iy26 + iyrp
  260	      continue
	      ix28 = ix28 + ixcu		! next char dot up
	      iy28 = iy28 + iycu
  280	    continue
	    ix30 = ix30 + ixcp			! next char dot over
	    iy30 = iy30 + iycp
	    index = index + 1			! point to next column
  300	  continue
	  ixd = ixcp + ixcp + ixcp		! x-path of char dot * 3
	  ixd = ixd + ixd			! * 6
	  ixd = ixd + ixcp			! * 7
	  ixcorn = ixcorn + ixd			! move to next char
	  iyd = iycp + iycp + iycp		! * 3
	  iyd = iyd + iyd			! * 6
	  iyd = iyd + iycp			! * 7
	  iycorn = iycorn + iyd			! position.
  500	continue
	return
c
	end
	Subroutine CHRSIZ (ix, iy)
c
c	Set character size for dot matrix generater.
c
	integer ix, iy
c
	integer ixform, iyform
	integer ixpath, iypath, ixup, iyup
c
	byte chrdot
	common /CHRGEN/ ixform(4), iyform(4), ixpath(4), iypath(4),
	1		ixup(4), iyup(4), isize, ipath, ispath,
	2		chrdot(480)
c
	isize = (ix + 3) / 7
	if (isize .le. 0) isize = 1
	isize = isize .and. 7			! limit size to 7
c
	do 100 i=1,4
	ixpath(i) = ixform(i) * isize
	iypath(i) = iyform(i) * isize
	j = i - 1
	if (j .eq. 0) j = 4
	ixup(j) = ixpath(i)
	iyup(j) = iypath(i)
  100	continue
c
	return
c
	end
	Subroutine CHRANG (deg)
c
c	Set character rotation angle for dot matrix generater.
c
	real deg
c
	integer ixform, iyform
	integer ixpath, iypath, ixup, iyup
c
	byte chrdot
	common /CHRGEN/ ixform(4), iyform(4), ixpath(4), iypath(4),
	1		ixup(4), iyup(4), isize, ipath, ispath,
	2		chrdot(480)
c
	logical first
	common /MFTR01/ first , factmf, ixdev, iydev, ixsize, iysize,
	1		ixoffs, iyoffs, irotat
c
	ispath = IFIX(deg) / 90
	ispath = ispath .and. 3			! limit path to 4
	ipath  = ispath - irotat
	ipath  = ipath .and. 3
	ipath  = ipath + 1			! actual path
	ispath = ispath + 1			! user-set path
	return
c
	end
	Subroutine CHRDAT
c
c	Dot matrix data - 
c	No executable code; just COMMON initialization.
c
	byte chrdo1(80), chrdo2(80), chrdo3(80)
	byte chrdo4(80), chrdo5(80), chrdo6(80)
c
	integer ixform, iyform
	integer ixpath, iypath, ixup, iyup
c
	byte chrdot
	common /CHRGEN/ ixform(4), iyform(4), ixpath(4), iypath(4),
	1		ixup(4), iyup(4), isize, ipath, ispath,
	2		chrdot(480)
c
	equivalence (chrdo1(1), chrdot(1))
	equivalence (chrdo2(1), chrdot(81))
	equivalence (chrdo3(1), chrdot(161))
	equivalence (chrdo4(1), chrdot(241))
	equivalence (chrdo5(1), chrdot(321))
	equivalence (chrdo6(1), chrdot(401))
c
	data chrdo1 /
     1		"000, "000, "000, "000, "000,
     1		"000, "000, "175, "000, "000,
     2		"000, "160, "000, "160, "000,
     #		"024, "177, "024, "177, "024,
     $		"022, "052, "177, "052, "044,
     %		"143, "144, "010, "023, "143,
     &		"066, "111, "065, "002, "005,
     '		"000, "020, "140, "000, "000,
     8		"000, "034, "042, "101, "000,
     9		"000, "101, "042, "034, "000,
     *		"024, "010, "076, "010, "024,
     +		"010, "010, "076, "010, "010,
     ,		"200, "015, "016, "000, "000,
     -		"010, "010, "010, "010, "010,
     .		"000, "003, "003, "000, "000,
     /		"003, "004, "010, "020, "140 /
c
	data chrdo2 /
     1		"076, "101, "101, "076, "000,
     1		"000, "041, "177, "001, "000,
     2		"047, "111, "111, "111, "061,
     3		"042, "101, "111, "111, "066,
     4		"014, "024, "044, "177, "004,
     5		"162, "121, "121, "121, "116,
     6		"036, "051, "111, "111, "006,
     7		"103, "104, "110, "120, "140,
     8		"066, "111, "111, "111, "066,
     9		"060, "111, "111, "112, "074,
     :		"000, "066, "066, "000, "000,
     ;		"000, "155, "156, "000, "000,
     <		"000, "010, "024, "042, "101,
     =		"024, "024, "024, "024, "024,
     >		"101, "042, "024, "010, "000,
     ?		"040, "100, "115, "060, "000 /
c
	data chrdo3 /
     @		"076, "101, "135, "125, "074,
     A		"077, "110, "110, "110, "077,
     B		"101, "177, "111, "111, "066,
     C		"076, "101, "101, "101, "042,
     D		"101, "177, "101, "101, "076,
     E		"177, "111, "111, "101, "101,
     F		"177, "110, "110, "100, "100,
     G		"076, "101, "101, "111, "117,
     H		"177, "010, "010, "010, "177,
     I		"000, "101, "177, "101, "000,
     J		"002, "001, "001, "001, "176,
     K		"177, "010, "024, "042, "101,
     L		"177, "001, "001, "001, "001,
     M		"177, "040, "030, "040, "177,
     N		"177, "040, "020, "010, "177,
     O		"076, "101, "101, "101, "076 /
c
	data chrdo4 /
     P		"177, "110, "110, "110, "060,
     Q		"076, "101, "105, "102, "075,
     R		"177, "110, "114, "112, "061,
     S		"042, "121, "111, "105, "042,
     T		"100, "100, "177, "100, "100,
     U		"176, "001, "001, "001, "176,
     V		"160, "014, "003, "014, "160,
     W		"176, "001, "016, "001, "176,
     X		"143, "024, "010, "024, "143,
     Y		"140, "020, "017, "020, "140,
     Z		"103, "105, "111, "121, "141,
     [		"000, "177, "101, "101, "000,
     \		"140, "020, "010, "004, "003,
     ]		"000, "101, "101, "177, "000,
     ^		"020, "040, "100, "040, "020,
     _		"201, "001, "001, "001, "001 /
c
	data chrdo5 /
     `		"000, "100, "040, "020, "000,
     a		"016, "021, "021, "017, "001,
     b		"177, "011, "021, "021, "016,
     c		"016, "021, "021, "021, "021,
     d		"016, "021, "021, "011, "177,
     e		"016, "025, "025, "025, "010,
     f		"010, "077, "110, "100, "040,
     g		"270, "105, "105, "045, "176,
     h		"177, "010, "020, "020, "017,
     i		"000, "136, "001, "002, "000,
     j		"200, "002, "001, "136, "000,
     k		"177, "002, "004, "012, "021,
     l		"000, "100, "076, "001, "000,
     m		"037, "020, "014, "020, "017,
     n		"037, "010, "020, "020, "017,
     o		"016, "021, "021, "021, "016 /
c
	data chrdo6 /
     p		"377, "044, "104, "104, "070,
     q		"270, "104, "104, "110, "077,
     r		"037, "010, "020, "020, "010,
     s		"011, "025, "025, "025, "022,
     t		"020, "176, "021, "021, "002,
     u		"036, "001, "001, "002, "037,
     v		"030, "006, "001, "006, "030,
     w		"036, "001, "006, "001, "036,
     x		"021, "012, "004, "012, "021,
     y		"370, "005, "005, "011, "176,
     z		"021, "023, "025, "031, "021,
     {		"000, "010, "066, "101, "000,
     |		"000, "000, "167, "000, "000,
     }		"000, "101, "066, "010, "000,
     ~		"010, "020, "010, "004, "010,
     #		"052, "125, "052, "125, "052 /
c
	return
c
	end