Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-12 - 43,50547/pltlib/v12a/setsym.for
There is 1 other file named setsym.for in the archive. Click here to see a list.
	SUBROUTINE SETSYM(IFUNC,IARG,IANS)
*  See SETSYM portion of SYMBOL.MAC for documentation
	INTEGER IFUNC,IARG,IANS(3)		!3 words for 'NAME'
	INTEGER IUNIT,ITEMP(0:127),I,J		!Local variables
	INTEGER IPOS,MASK,IREC,INDEX

	PARAMETER (ISETSZ=12*128-1)		!Size of entire buffer
	PARAMETER (ISTRSZ=ISETSZ-16-128)	!Size of strokes table

	COMMON /SYMB0L/BUFFER(0:ISETSZ)		!Data from SYMBOL.DAT

	EQUIVALENCE (NPENUP,BUFFER(0))		!Pen up code for NORMAL
	EQUIVALENCE (HITEN, BUFFER(1))		!Height for NORMAL
	EQUIVALENCE (NMINC, BUFFER(2))		!Min ASCII char for NORMAL
	EQUIVALENCE (NMAXC, BUFFER(3))		!Number of chars for NORMAL
	EQUIVALENCE (KPENUP,BUFFER(4))		!Pen up code for CENTER
	EQUIVALENCE (HITEK, BUFFER(5))		!Height for CENTER
	EQUIVALENCE (KMINC, BUFFER(6))		!Min index for CENTER
	EQUIVALENCE (KMAXC, BUFFER(7))		!Number of symbols for CENTER

	INTEGER UNUSED(4),INAME(3)
	EQUIVALENCE (UNUSED,BUFFER(8))		!4 words reserved for future
	EQUIVALENCE (INAME, BUFFER(12))		!Name of table CHARACTER*15
	EQUIVALENCE (NTABLE,BUFFER(15))		!Table number

	INTEGER POINTR(0:127),STROKS(0:ISTRSZ)
	EQUIVALENCE (POINTR,BUFFER(16))		!Pointers to strokes
	EQUIVALENCE (STROKS,BUFFER(144))	!Data for SYMBOL

	DATA IUNIT /0/				!Use OPEN(UNIT=0) by default)
*******************************************************************************
	DATA (BUFFER(I),I=0,3)  /"37,8.0,"40,"140/	!Normal
	DATA (BUFFER(I),I=4,7)  /"07,6.0,"00,"032/	!Centered
	DATA (BUFFER(I),I=8,11) /"0,"0,"0,"0/		!Reserved for future
	DATA (BUFFER(I),I=12,15)/'CSM Standard   ',1/	!Table name & number

*  Start of POINTR - pointer to table of strokes, indexed by character-"40
	DATA (BUFFER(I),I=  16,  31)		! !"#$%&'()*+,-./
     &  / "440500010000, "250500060000, "370500060002, "060500140003
     &  , "010500210006, "130500250013, "130500140021, "320500030025
     &  , "320500050026, "060500050027, "250500140031, "200500060034
     &  , "320500070036, "250500030040, "250500060041, "320500030043/
	DATA (BUFFER(I),I=  32,  47)		!0123456789:;<=>?
     &  / "320500150044, "010500040047, "320500120051, "320500140054
     &  , "060500050057, "250500130061, "130500130064, "010500040067
     &  , "320500210071, "320500130076, "200500140101, "010500150104
     &  , "130500040110, "010500060111, "130500040113, "010500130114/
	DATA (BUFFER(I),I=  48,  63)		!@ABCDEFGHIJKLMNO
     &  / "370500240120, "060500070125, "060500160127, "060500110133
     &  , "200500100136, "010500120140, "130500070143, "130500130145
     &  , "010500110150, "250500110153, "060500110155, "250500110160
     &  , "060500060162, "200500060164, "250500050166, "010500120167/
	DATA (BUFFER(I),I=  64,  79)		!PQRSTUVWXYZ[\]^_
     &  / "010500100172, "250500150175, "370500130201, "320500130204
     &  , "200500060207, "320500070211, "250500040213, "130500060214
     &  , "200500060216, "320500070220, "320500050222, "060500050223
     &  , "250500030225, "250500050226, "010500070227, "010500070231/
	DATA (BUFFER(I),I=  80,  95)		!`abcdefghijklmno
     &  / "010500030233, "010500170234, "320500140241, "130500110244
     &  , "250500150247, "370500130253, "250500110256, "010500170260
     &  , "320500110265, "060500100267, "370500100272, "250500110274
     &  , "060500030276, "060500170277, "010500110303, "200500120306/
	DATA (BUFFER(I),I=  96, 111)		!pqrstuvwxyz{|}~
     &  / "200500140311, "010500140314, "250500100320, "130500130322
     &  , "010500110325, "200500100330, "010500040332, "320500060334
     &  , "370500060336, "060500070337, "060500050341, "250500100343
     &  , "060500030345, "060500100346, "320500050351, "060500040352/
	DATA (BUFFER(I),I= 112, 127)		!16 centered symbols
     &  / "370300100354, "170300140355, "140300060357, "110300070360
     &  , "000300070361, "330300070363, "220300070364, "110300060365
     &  , "060300070366, "000300070367, "330300160371, "140300150373
     &  , "030300070375, "360300040377, "030300110377, "250300040401/
	DATA (BUFFER(I),I= 128, 143)		!Centered digits 0-9
     &  / "360300140402, "360300100404, "220300130405, "300300200407
     &  , "000300110411, "250300140413, "250300170415, "030300110417
     &  , "250300240421, "110300170424, "000000000000, "000000000000
     &  , "000000000000, "000000000000, "000000000000, "000000000000/

*  Start of STROKS table
	DATA (BUFFER(I),I= 144, 159)
     &  / "200062000604, "141077611004, "324001411404, "357443421420
     &  , "003021611576, "106441774622, "004770054626, "200060040214
     &  , "103062021204, "240140470434, "146371070414, "761060471000
     &  , "140061460130, "005402405104, "221520654230, "762110640316/
	DATA (BUFFER(I),I= 160, 175)
     &  / "103051430714, "202511045000, "143060254132, "047033421500
     &  , "220070230314, "124100030230, "107100030214, "004003011620
     &  , "003001411004, "300162000600, "202147611404, "217442001476
     &  , "005042440014, "043422774022, "104500030314, "063421610606/
	DATA (BUFFER(I),I= 176, 191)
     &  / "141052000600, "222112000604, "141460634216, "043100030014
     &  , "146100030016, "146771460434, "047003001004, "142061440630
     &  , "200060260334, "063100030030, "006413425614, "323130034014
     &  , "143100030032, "027053431514, "302121440616, "123011400720/
	DATA (BUFFER(I),I= 192, 207)
     &  / "003051425600, "223112000600, "160461030620, "144452405200
     &  , "220161471000, "140110250524, "144461624602, "140070050434
     &  , "200060070634, "023100030124, "004401604612, "143071444524
     &  , "145463225602, "340150054124, "125100030214, "145063225602/
	DATA (BUFFER(I),I= 208, 223)
     &  / "340150054124, "125062640014, "043031414704, "161067611206
     &  , "241530454224, "200060630316, "043421414604, "137422415206
     &  , "261130451000, "141470050332, "200060040620, "763120051000
     &  , "140070650032, "200060264234, "107053225406, "241507614706/
	DATA (BUFFER(I),I= 224, 239)
     &  / "144001404600, "160130260530, "145462024710, "202137621206
     &  , "261130250122, "044032021120, "003001415614, "157412225120
     &  , "003001401612, "343151454524, "005371250622, "143451400620
     &  , "003063225604, "340140040214, "123061640014, "003003421614/
	DATA (BUFFER(I),I= 240, 255)
     &  / "303101030014, "200060030034, "147371050024, "760061431000
     &  , "140060070634, "762120051000, "143151270234, "006002010610
     &  , "143101450424, "200060030034, "763161433700, "243122000602
     &  , "142467614606, "357413425620, "003011610606, "142071073704/
	DATA (BUFFER(I),I= 256, 271)
     &  / "343162000602, "140567605212, "357412424620, "003001401676
     &  , "003061440014, "003003415314, "343062000600, "140161430634
     &  , "200060040030, "047043431414, "202060430020, "200060030034
     &  , "127063231312, "240122000600, "200140470434, "146062020604/
	DATA (BUFFER(I),I= 272, 287)
     &  / "140107621014, "144001400600, "342561464626, "125002574224
     &  , "143100030020, "043041431010, "241120060234, "107063040014
     &  , "063033574034, "147100030034, "003411424614, "163162000600
     &  , "341461471000, "140160030322, "143063440014, "003063574034/
	DATA (BUFFER(I),I= 288, 303)
     &  / "143100030034, "065463574326, "063100030034, "147001430620
     &  , "003031000400, "341562000600, "303062000606, "103041470334
     &  , "200060054334, "145770670314, "200060634024, "066770050624
     &  , "200060470430, "200060044124, "065042220676, "104032205100/
	DATA (BUFFER(I),I= 304, 319)
     &  / "200070230314, "103500030014, "006770044124, "065042220706
     &  , "140460035000, "142110650124, "004401604606, "142072000600
     &  , "160110250324, "104441614602, "140077620610, "324001420706
     &  , "140460034022, "025032421110, "200102000604, "141140664432/
	DATA (BUFFER(I),I= 320, 335)
     &  / "126370054426, "200061044324, "025002200702, "141461037710
     &  , "242050620110, "002500030014, "006770044124, "065042220620
     &  , "003033015376, "065031620612, "144001415406, "277432414504
     &  , "100442000600, "140157601004, "257402010620, "003021411520/
	DATA (BUFFER(I),I= 336, 351)
     &  / "003001401276, "004412411206, "221467615110, "242521444614
     &  , "200060030024, "760110250224, "064431440014, "003402205206
     &  , "242111034314, "023001640014, "002002574022, "025032421110
     &  , "161460230016, "200061044324, "025002200702, "141461037710/
	DATA (BUFFER(I),I= 352, 367)
     &  / "242042000600, "140127601102, "241521045000, "140070230314
     &  , "103432005000, "220520650422, "200060464216, "063041424776
     &  , "025432640014, "005001604606, "142071050414, "200060050214
     &  , "105100030024, "003022020610, "244001400610, "257402420620/
	DATA (BUFFER(I),I= 368, 383)
     &  / "003002410676, "105011000420, "003002421200, "142062000606
     &  , "341150454022, "043421214420, "003021011620, "003003405502
     &  , "261510234112, "002000030240, "070444026100, "003014022010
     &  , "366667333222, "115353333335, "455452412112, "142535333333/
	DATA (BUFFER(I),I= 384, 399)
     &  / "551113533333, "353133135333, "333551133155, "133333355331
     &  , "133533333313, "553133533333, "115515513333, "315551151733
     &  , "333153355333, "133333554424, "152422112242, "514244333333
     &  , "531335511335, "313335115333, "333355155111, "333333531333/
	DATA (BUFFER(I),I= 400, 415)
     &  / "333651145411, "367333331353, "333332040515, "546261511207
     &  , "333332536302, "040733333152, "646555411105, "073333315264
     &  , "655544323435, "251402011733, "333161353746, "407333331120
     &  , "405152431316, "567333335546, "261511204051, "524323127333/
	DATA (BUFFER(I),I= 416, 431)
     &  / "331516565531, "307333331526, "465554432343, "525140201112
     &  , "231415733333, "112040515546, "261514234354, "733000000000
     &  , "000000000000, "000000000000, "000000000000, "000000000000
     &  , "000000000000, "000000000000, "000000000000, "000000000000/

*  The remainder of BUFFER for SETSYM table #1 is filled with zeros
	DATA (BUFFER(I),I=432,1535) /1104*"000000000000/
******************************************************************************
	IF(IFUNC.EQ.'UNIT')  GOTO 100
	IF(IFUNC.EQ.'NUMBE') GOTO 200
	IF(IFUNC.EQ.'NAME ') GOTO 300
	IF(IFUNC.EQ.'TABLE') GOTO 400
	IF(IFUNC.EQ.'WIDTH') GOTO 500
*  Here if none of the above
	CALL PLOT(0.0,0.0,999)			!Turn off all plotting
	TYPE 50,IFUNC
50	FORMAT(' ?SETSYM - Unknown function ',A5)
	RETURN


*****  'UNIT' - Declare which FORTRAN I/O unit to use
100	IANS(1) = IUNIT				!Return old value
	IUNIT = IARG				!Set new value
	RETURN



*****  'NUMBE' - Return current table number
200	IANS(1) = NTABLE			!IARG is ignored
	RETURN



*****  'NAME ' - Return current table name
300	IF(IARG.NE.0) GOTO 350			!Zero means current table
	IANS(1)=INAME(1) ; IANS(2)=INAME(2) ; IANS(3)=INAME(3)
	IF(IANS(1).NE.0) RETURN
	IANS(1)='Unkno'  ; IANS(2)='n tab'  ; IANS(3)='le  '
350	RETURN



*****  'TABLE' - Read SYS:SYMBOL.DAT or SYMBOL:SYMBOL.DAT
400	IF(IARG.EQ.0) GOTO 200			!Return current table if zero
	IF(IARG.GT.0) OPEN (UNIT=IUNIT, NAME='SYS:SYMBOL.DAT',
     &	MODE='IMAGE', ACCESS='RANDIN', RECORDSIZE=128, ERR=499)
	IF(IARG.LT.0) OPEN (UNIT=IUNIT, NAME='SYMBOL:SYMBOL.DAT',
     &	MODE='IMAGE', ACCESS='RANDIN', RECORDSIZE=128, ERR=499)
	READ (IUNIT'1) ITEMP			!Read index block
	IREC = ITEMP(IABS(IARG)-1)		!Get record number
	IF(IREC.LE.0) GOTO 499			!Zero means no such table

	DO 410 I = 0,11				!Read in 12 records
410	READ(IUNIT'IREC+I) (BUFFER(J),J=I*128,I*128+127)
	CLOSE (UNIT=IUNIT)
	IANS(1) = 0				!Clear error flag
	RETURN

499	IANS(1) = -1				!Errors were detected
	RETURN



*****  'WIDTH' - Return width of character, 1000 means width=height
500	I = IARG				!Get character number
*  Convert A1 format to R1 format so that I is between 0 and 127
	IF(I.LT.0) I = ((I/"004000000000)-1).AND."177
	IF((I.AND."774000000000).NE.0)  I = I/"004000000000
	I = I - NMINC				!Subtract off offset
	IANS(1) = 0				!In case out of range
	IF((I.GT.NMAXC) .OR. POINTR(I).EQ.0) RETURN
	I = POINTR(I).AND."777700007777		!Get byte pointer
	INDEX = I.AND."7777			!Index into STROKS array
*  Fake an ILDB instruction
	J = (I.AND."007700000000)/"000100000000	!Get byte size
	MASK = (2**J)-1				!Byte mask
	IPOS = I/"010000000000			!Byte position
	IF(I.LE.0) IPOS = (IPOS-1).AND."77	!Undo 2's complement
	IPOS = IPOS - J				!Increment byte pointer
	IF(IPOS.LT.0) INDEX = INDEX +1		!If past end of word,
	IF(IPOS.LT.0) IPOS = 36 - J		! increment to next word
	I = STROKS(INDEX)/(2**IPOS)		!Get byte
	IF(I.GT.0) I = I.AND.MASK		!I gets integer width
	IF(I.LT.0) I = (I-1).AND.MASK		!Undo 2's complement
	IANS(1) = 1000.0 * FLOAT(I)/HITEN	!Ratio of width/height * 1000
	RETURN

	END