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