Trailing-Edge
-
PDP-10 Archives
-
decuslib10-12
-
43,50547/symbol.mac
There are 7 other files named symbol.mac in the archive. Click here to see a list.
SUBTTL Revision History
;Entry points in this file:
; NUMBER, SYMBOL, SETSYM Dummy definitions if PLTUNV.REL is not used
; %NUMBE, %SYMBO, %SETSY Subroutines
; SYMB0L Data area spelled with a zero '0'
;External global symbols referenced:
; COSD., SIND., EXP2. Math routines from FORLIB
; TRACE. Subroutine trace from FOROTS
;NOTE: PLTUNV.UNV defines the following:
; TTL Macro to generate the TITLE statement
; T0-T4,P1-P4,X,Y All AC definitions
; FTMKTB Feature test for subroutine MKTBL
; FTDSKI Feature test for disk input in SETSYM
; REAL,INTEGER Numeric data types
; STRING,CHARACT Character data types
; $RELOC,$HISEG,$LOSEG Relocation macros
; FLOAT,ERRSTR,PFALL General macros
SALL
;Edit
; 442 1980 JMS Separate SYMBOL, NUMBER, and ISETAB from the rest.
; This allowed the use of SYMBOL.DAT for plotting
; characters on the VERSATEC using standard calls to
; subroutine PLOT.
;
; 505 20-Oct-82 JMS Remove debugging HALT that limited X,Y to 11.0 inches.
;
; 506 20-Oct-82 JMS Implemented CR, LF, TAB, BS, SI, and SO characters.
;
; 512 29-Oct-82 JMS Implement subroutine SETSYM to replace ISETAB/MSETAB.
;
; 513 2-Nov-82 JMS Fix bug near ISETA6 introduced by edit 512
;
; 514 9-Nov-82 JMS Do not special case CR, LF for centered symbols.
;
; 517 12-Apr-83 JMS Change SYMBOL to handle FORTRAN-77 CHARACTER variables.
; CALL SYMBOL (X,Y,HEIGHT,CSTRNG,ANGLE)
;
; 526 15-Sep-83 JMS Make 2 versions of SETSYM. The one written in MACRO
; does not use FOROTS I/O and is suitable for ALGOL and
; PASCAL on TOPS-10. The one written in FORTRAN-77 is
; suitable for TOPS-20 (since FOROT7 won't allow PA1050).
;
;End of Revision History
SUBTTL Table of contents
; Table of Contents for SYMBOL plotter
;
;
; Section Page
;
; 1. Revision History . . . . . . . . . . . . . . . . . . . 1
; 2. Table of contents . . . . . . . . . . . . . . . . . . 2
; 3. Subroutine descriptions
; 3.1 NUMBER - Draw numbers on the plot . . . . . . 3
; 3.2 SYMBOL - Plot symbols (letters, digits, etc) . 4
; 3.3 SETSYM - Get data from SYMBOL.DAT . . . . . . 4
; 4. NUMBER
; 4.1 Entry point . . . . . . . . . . . . . . . . . 5
; 4.2 Convert floating point to ASCII . . . . . . . 5
; 4.3 Variables and PRGEND . . . . . . . . . . . . . 7
; 5. SYMBOL
; 5.1 Entry point . . . . . . . . . . . . . . . . . 8
; 5.2 Set up translation and rotation . . . . . . . 9
; 5.3 Main loop, do a character . . . . . . . . . . 10
; 5.4 Control characters, CR, LF, etc . . . . . . . 12
; 5.5 Interface to PLOT and layout of SYMB0L data . 13
; 5.6 Variables . . . . . . . . . . . . . . . . . . 14
; 6. SETSYM
; 6.1 Entry point . . . . . . . . . . . . . . . . . 15
; 6.2 Dispatch, 'NUMBE' and 'WIDTH' . . . . . . . . 15
; 6.3 'TABLE' - Change symbol tables . . . . . . . . 16
; 7. MKTBL & SETABL
; 7.1 Entry points . . . . . . . . . . . . . . . . . 17
; 8. SYMBOL.DAT table #1
; 8.1 Pointers . . . . . . . . . . . . . . . . . . . 18
; 8.2 Data . . . . . . . . . . . . . . . . . . . . . 18
SUBTTL Subroutine descriptions -- NUMBER - Draw numbers on the plot
SEARCH PLTUNV ;Search the universal file
TTL (<DNUMBER - Dummy module for NUMBER>,DUMMY)
;Calling sequence:
; CALL NUMBER (X, Y, HEIGHT, FNUMB, ANGLE, NDIG)
; CALL NUMBER (X, Y, HEIGHT, FNUMB, ANGLE, NDIG, IRAD)
;
; (X,Y) - The coordinate of the first char to be drawn
; HEIGHT - The height of the numbers in inches
; FNUMB - The number for output (floating point real number)
; ANGLE - The angle of rotation
; NDIG - The number of digits beyond the decimal point
; IRAD - (optional) The output radix, from 2 to 36.
;Convert REAL number in FNUMB to a string of digits in NUMTXT, set NUMDIG,
; and then "CALL SYMBOL (X,Y,HEIGHT,NUMTXT,ANGLE,NUMDIG)".
;For example:
; Z = 3.141592653
; CALL NUMBER(X,Y,0.2,Z,90.0,2)
;will draw '3.14' at 90 degrees.
EXTERN SYMBOL ;Set up forward reference
ENTRY NUMBER ;This definition must come BEFORE 'SYMBOL'
NUMBER=%NUMBER## ;Dummy definition if PLTUNV.REL is not used
PRGEND
SUBTTL Subroutine descriptions -- SYMBOL - Plot symbols (letters, digits, etc)
SEARCH PLTUNV ;Search the universal file
TTL (<DSYMBOL - Dummy module for SYMBOL>,DUMMY)
;Calling sequence:
; CALL SYMBOL (X, Y, HEIGHT, CSTRNG, ANGLE)
; CALL SYMBOL (X, Y, HEIGHT, IARRAY, ANGLE, NUMCHR)
;
; (X,Y) - The coordinate of the first character to be drawn.
; HEIGHT - The height of the characters in inches.
; CSTRNG - CHARACTER variable or expression.
; IARRAY - Integer array of Hollerith characters, or an integer number.
; ANGLE - The angle of rotation.
; NUMCHR - the number of characters to be plotted from IARRAY.
; If NUMCHR is zero, plot the single character whose ASCII code is in ICHAR.
; If NUMCHR is negative, plot a centered symbol whose number is in ICHAR.
; -2 will draw the symbol with a connecting line to the old position.
; -3 will not draw the connecting line.
;
;For a description of symbols, see SETSYM routine.
EXTERN SETSYM ;Set up forward reference to data area
ENTRY SYMBOL ;This module must come before SETSYM
SYMBOL=%SYMBOL## ;Dummy definition if PLTUNV.REL is not used
PRGEND
SUBTTL Subroutine Descriptions -- SETSYM - Get data from SYMBOL.DAT
; This subroutine reads the SYMBOL table from either SYS:SYMBOL.DAT[1,4]
;or SYMBOL:SYMBOL.DAT[-], or returns information about the tables.
;NOTE: In order to use the negative tables, the user must define the
;logical device SYMBOL: via the ASSIGN or PATH commands to the Monitor.
;Calling sequence:
; CALL SETSYM(IFUNC,IARG,IANS) !The 3rd arg may be a REAL variable
; IFUNC = (input) Name of the function to perform. INTEGER or CHARACTER*5.
; IARG = (input) The argument of the function
; IANS = (output) Returned answer (not necessarily an integer)
; CALL SETSYM('TABLE',ITABLE,IERR)
; IFUNC = 'TABLE' - Change tables or return the value of the current one.
; ITABLE = The number of the table to be loaded into memory for SYMBOL.
; + = Positive values read from SYS:SYMBOL.DAT[1,4]
; - = Negative values read from SYMBOL:SYMBOL.DAT[-]
; 0 = Same as CALL SETSYM('NUMBER',0,IANS)
; IERR = The error flag . Returned as 0 if no errors, as -1 if errors.
; CALL SETSYM('NUMBER',0,IANS)
; IFUNC = 'NUMBE' - Read the current table number.
; IARG = Ignored.
; IANS = The table number. Positive if the table was read from
; SYS:SYMBOL.DAT[1,4], negative if from SYMBOL:SYMBOL.DAT[-].
; CALL SETSYM('NAME',IARG,CANS)
; IFUNC = 'NAME' - Return name corresponding with table number.
; IARG = Table number, zero means current table.
; CANS = The table name returned as CHARACTER*15.
; CALL SETSYM('WIDTH',LETTER,IWIDTH)
; IFUNC = 'WIDTH' - Read the width for the specified letter.
; LETTER = The ASCII code or CHARACTER*1 variable. "A"=65.
; IWIDTH = The width as compared to the height, a number from 0 to 1000.
PAGE
;The tables defined in SYS:SYMBOL.DAT are:
;
; Description Upper Lower Number Punctu- Bracket Symbols
; case case ation [\]^_ #$%+-<=>@
; -- -------------- ----- ----- ------ ------ ------- ---------
; 1. CSM standard Yes Yes Yes Yes Yes Yes
; 2. DEC standard Yes No Yes Yes Yes Yes
; 3. Olde English Yes Yes Yes Yes Yes $ only
; 4. Old German Yes Yes No No No No
; 5. Old Italian Yes Yes No No No No
; 6. Script Yes Yes No No No No
; 7. Double line Yes Yes Yes Yes [] +-/<=>
; 8. Italics Yes Yes Yes Yes [] +-/<=>
; 9. Triple line Yes Yes Yes Yes No #$%+-=
; 10. Triple Italics Yes Yes Yes Yes No #$%+-=
; 11. Round letters Yes Yes Yes Yes No #$%+-=
; 12. Greek letters Yes Yes No No No No
; 13. Double Greek Yes Yes No No No No
;There are 26 centered symbols in SETSYM tables +1 and +2.
; 0 Square box 8 Z
; 1 Circle 9 Y
; 2 Triangle 10 Square star
; 3 Plus sign 11 Asterisk
; 4 X 12 Hourglass
; 5 Diamond 13 Vertical bar
; 6 Up arrow 14 Five pointed star
; 7 X with a bar on top 15 Horizontal bar
; 16-25 Digits 0 through 9, centered about the point
SEARCH PLTUNV ;Search the universal file
IFN <FTDSKI-'FOROTS'>,<;For 'UUOS', 'FILOP.', and 'JSYS', use MACRO routine
TTL (<DSETSYM - Dummy module for SETSYM>,DUMMY)
ENTRY SETSYM ;This module must come after SYMBOL
SETSYM=%SETSYM## ;Dummy definition if PLTUNV.REL is not used
PRGEND > ;End of 'FOROTS'
SUBTTL NUMBER -- Entry point
SEARCH PLTUNV ;Search the universal file
TTL (<%NUMBER - Plots numbers on the plotter>)
;Definitions
ND MAXCHR,^D30 ;Max number of digits sent to SYMBOL
EXTERN SYMBOL,PLOT ;Call upon subroutine SYMBOL to do the plotting
EXTERN EXP2. ;Math routine from FORLIB
IFN FTKA,<EXTERN IFX.1> ;Convert REAL in T1 to INTEGER
A=P1 ;Preserved AC
B=P2 ;Byte pointer
C=P3 ;Counter
D=P4 ;Data
PURGE P1,P2,P3,P4
;CALL NUMBER (X,Y,HEIGHT,FNUMB,ANGEL,NDIG,IRAD)
ENTRY %NUMBER ;Set up entry point
SIXBIT /NUMBER/ ;For subroutine TRACE.
%NUMBER:MOVEM L,NUMB16 ;Save arg pointer
;Set up pointers to variables
MOVEI T0,ARGLST-1 ;Set up to get the arguments
PUSH T0,0(L) ;Get address of X
PUSH T0,1(L) ;Get address of Y
PUSH T0,2(L) ;Get address of HEIGHT
PUSH T0,@3(L) ;Get value of FNUMB
PUSH T0,4(L) ;Get address of ANGLE
PUSH T0,@5(L) ;Get value of NDIG
MOVE T1,[POINT 7,NUMTXT] ;Set up a pointer to
MOVEM T1,NUMPNT ; the data array
;Get the output radix (IRAD)
NUMARG 7 ;Optional 7th argument present?
JRST NUMBE0 ;Assume radix ten output
MOVE T1,@6(L) ;Get the radix to use
CAIL T1,^D2 ;Keep it if between 2
CAILE T1,^D36 ; and 36
NUMBE0: MOVEI T1,^D10 ;Set number of the radix to 10
MOVEM T1,IRAD ;Save the radix for later
;Get number of digits beyond decimal point (NDIG)
SKIPGE T1,NDIG ;Skip if number of digits beyond d. p. is positive
ADDI T1,1 ;Add 1 to the number digits trucated
CAILE T1,^D8 ;Skip if less than 9 digits behind the d. p.
MOVEI T1,^D8 ;Set the number of digits to 8
MOVNM T1,NUMDIG ;Save negative as argument to EXP2.
;Convert number to string of characters in NUMTXT, put the count in NUMDIG
N2TEXT: FLOAT T1,IRAD ;Convert the radix to floating point
MOVEM T1,FRAD ;Save for EXP2.
XMOVEI L,[-2,,0 ;2 args
REAL FRAD ;Base
INTEGER NUMDIG ;Power to raise base to
]+1 ;Point to args
PUSHJ P,EXP2.## ;Raise floating-point base to integer exponent
MOVE T1,T0 ;Duplicate the answer
FSC T1,-1 ;Set up for rounding
SKIPGE FNUMB ;Check to see if it's negative
MOVNS T1 ;It was negative, therefore negate
FADR T1,FNUMB ;Round the number to be used
;Convert number to properly scaled integer
FDVR T1,T0 ;Produce a whole number in floating point
IFN FTKA,< PUSHJ P,IFX.1## > ;Go convert the number to integer
IFE FTKA,< FIX T1,T1 > ;Convert the number to integer
JFCL .+1 ;Tell FOROTS to ignore %FRSAPR Integer Overflow
AOS NDIG ;Set up to put the d. p. in the right place
;Convert integer to ASCII
MOVSI C,-MAXCHR ;AOBJN pointer for character count
PUSHJ P,RADOUT ;Go put the number into NUMTXT
HRRZM C,NUMDIG ;Store number of characters
;Plot the data
MOVE T1,[INTEGER NUMTXT]
MOVEM T1,ARGLST+3 ;Point 4th arg to NUMTXT
MOVE T1,[INTEGER NUMDIG]
MOVEM T1,ARGLST+5 ;Point 6th arg to NUMDIG
MOVSI T1,-6 ;Set argument count
MOVEM T1,ARGLST-1
XMOVEI L,ARGLST ;Point to arguments
PUSHJ P,SYMBOL## ;Do the plotting
MOVE L,NUMB16 ;Restore AC 16
POPJ P, ;Return
;Convert integer to ASCII using radix in IRAD
RADOUT: JUMPGE T1,RADOU0 ;Jump if the number is positive
MOVNS T1 ;Make the number positive
MOVEI D,"-"
PUSHJ P,CHAR ;Put a '-' before the number
RADOU0: SOSE NDIG ;Skip if a '.' should be output
JRST RADOU1 ;Not yet
MOVEI D,"."
HRLM D,(P) ;Save the '.' for later
PUSH P,[RADOU2] ;Set up so POPJ will do the right thing
RADOU1: IDIV T1,IRAD ;Divide by proper radix
MOVEI D,"0"(T2) ;Convert to ASCII
CAILE D,"9" ;Skip if char is a digit
ADDI D,"A"-"9"-1 ;Convert the char to a letter
SKIPG NDIG ;Skip next test to output trailing zeros
JUMPE T1,CHAR ;Jump and return if no more numbers for output
HRLM D,(P) ;Store char on PDL
PUSHJ P,RADOU0 ;Go get an other number
RADOU2: HLRZ D,(P) ;Get char off PDL
CHAR: AOBJP C,NUMERR ;Count characters
IDPB D,NUMPNT ;Store a char
POPJ P,
NUMERR: MOVE D,[ASCII/*****/];Too many digits
MOVEM D,NUMTXT ;Set up to display
MOVEI C,5 ; 5 characters
POPJ P, ;Unwind the stack
SUBTTL NUMBER -- Variables and PRGEND
$LOSEG ;Variables
BLOCK 1 ;Six args for SYMBOL
ARGLST: BLOCK 6 ;Argument pointers
;X0= ARGLST+0 ;Address of starting coordinates
;Y0= ARGLST+1 ; ..
;HEIGHT=ARGLST+2 ;Address of height
FNUMB= ARGLST+3 ;The floating point number, addr of text
;ANGLE= ARGLST+4 ;Address of angle
NDIG= ARGLST+5 ;The number of digits to be plotted, byte count
NUMB16: BLOCK 1 ;Save AC 16
IRAD: BLOCK 1 ;Radix, integer
FRAD: BLOCK 1 ;Radix, floating point
NUMPNT: BLOCK 1 ;Byte pointer to NUMTXT
NUMTXT: BLOCK MAXCHR/5 ;Room for 30 digits (including "-" and ".")
NUMDIG: BLOCK 1 ;Number of characters in NUMTXT
$HISEG
LITS: PRGEND
SUBTTL SETSYM -- Entry point
SEARCH PLTUNV ;Search the universal file
IFE <FTDSKI-'FOROTS'>,<IF2,<PRINTX [Be sure to compile SETSYM.FOR]>>
IFN <FTDSKI-'FOROTS'>,<
TTL (<%SETSYM - Gets the data tables for SYMBOL>)
ND MAXSET,^D20 ;Number of tables in SYMBOL.DAT
ND SETSIZ,^D12*200 ;Table can be up to 12 blocks long
A=P1 ;Preserved AC
B=P2 ;Byte pointer
C=P3 ;Counter
D=P4 ;Data
PURGE P1,P2,P3,P4
; CALL SETSYM(IFUNC,IARG,IANS)
ENTRY %SETSYM ;Set up entry point
SIXBIT /SETSYM/
%SETSYM:LDB T1,[ACPNTR 0(L)] ;Get type of argument
CAIN T1,ACTYPE(CHARACT) ;CHARACTER expression?
SKIPA T1,@0(L) ;Yes, get byte pointer
XMOVEI T1,@0(L) ;No, get addr of numeric variable
MOVE T1,@T1 ;Get one word of data
ANDCM T1,[BYTE(7)40,40,40,40,40] ;Translate lower to uppercase
;(also converts spaces to nulls)
MOVSI T2,-FUNLEN ;Set up AOBJN counter
SETSY1: CAMN T1,FUNASC(T2) ;Match?
JRST @FUNDSP(T2) ;Yes, do it
AOBJN T2,SETSY1 ;Try next
ERRSTR (MSG,<SETSYM - Unknown function>)
PUSHJ P,TRACE.## ;Trace the subroutine calls
POPJ P,
DEFINE SETFUN,<XALL
XX TABLE ;Change symbol tables
XX NUMBE ;Return current table number
XX NAME ;Return table name
XX WIDTH ;Get width of a symbol
SALL> ;End of DEFINE SETFUN
DEFINE XX(ARG),<
ASCII/ARG/>
FUNASC: SETFUN ;Function names
FUNLEN==.-FUNASC
SUBTTL SETSYM -- 'NUMBER' and 'WIDTH'
DEFINE XX(ARG),<
IFIW D'ARG>
FUNDSP: SETFUN ;Dispatch table
;'NUMBE' - Return current table number
DNUMBE: MOVE T1,TNUMBR ;Get old number (+ or -)
MOVEM T1,@2(L) ;Return as IANS
POPJ P,
;'WIDTH' - Return width of a particular letter
DWIDTH: MOVE D,@1(L) ;Get the character
TLNE D,774000 ;Left justified ASCII?
LSH D,-^D29 ;Yes, right justify it
SUB D,MINC.N ;Subtract min
CAMG D,MAXC.N ;Within range?
SKIPN B,IPOINT(D) ;And pointer non-zero
POPJ P, ;No, return 0
AND B,[777700,,007777] ;Remove byte count
ADDI B,STROKS ;Point to the data area
ILDB T1,B ;Get the width of the character
FLOAT T1 ;To floating point
FDVR T1,HITE.N ;Ratio of width/height
FMPRI T1,(1000.0) ;Normalize to 1000
IFE FTKA,< FIX T1,T1 > ;Convert number to integer
IFN FTKA,< PUSHJ P,IFX.1## >
MOVEM T1,@2(L) ;Return IWIDTH fraction
POPJ P,
SUBTTL SETWIN -- 'NAME' and 'TABLE'
;'NAME' - Return name of table
DNAME: MOVE T1,@1(L) ;Get arg
CAME T1,TNUMBR ;Skip if asking for current table name
JUMPN T1,DNAME1 ;Zero means current table name
XMOVEI T1,@2(L) ;Get addr of array
DMOVE T2,TNAME+0
DMOVEM T2,0(T1) ;Return name of current table
MOVE T2,TNAME+2
MOVEM T2,2(T1)
POPJ P,
;Read SYMBOL.DAT and return name of specified table.
DNAME1: POPJ P, ;**** NOT IMPLEMENTED **********************************
;'TABLE' - Change symbol tables
DTABLE: MOVE T1,@1(L) ;Get the table to use
JUMPE T1,DNUMBE ;Zero to return current table
CAILE T1,MAXSET ;If out of range,
JRST SETSY3 ; return error
MOVEM T1,NUMB ;Positive means use table from SYS:
CAMN T1,TNUMBR ;Is this table already set up?
JRST SETSY5 ;Yes, use it
SKIPG T1 ;Positive?
SKIPA T3,['SYMBOL'] ;Use SIXBIT/SYMBOL/ for negative (MSETAB)
MOVSI T3,'SYS' ;Use SIXBIT/SYS/ for positive (ISETAB)
MOVEI T2,.IODMP ;Dump mode
MOVEI T4,0 ;No buffers
IF2,<PRINTX % *HACK* Using FTDSKI='UUOS' *HACK*>
FTDSKI='UUOS'
IFE <FTDSKI-'FILOP.'>,<PRINTX ?SETSYM - no code for FTDSKI='FILOP.'>
IFE <FTDSKI-'JSYS'>,< PRINTX ?SETSYM - no code for FTDSKI='JSYS'>
IFE <FTDSKI-'UUOS'>,< ;Use OPEN/LOOKUP instead of FILOP.
%0==0 ;Software I/O channel number
OPEN %0,T2 ;INIT SYS: or SYMBOL:
JRST SETSY3 ;No
MOVE T1,['SYMBOL'] ;File name
MOVSI T2,'DAT' ;Extension
SETZB T3,T4 ;Implied directory
LOOKUP %0,T1 ;Find SYMBOL.DAT
JRST SETSY2 ;Not there
; The first block is an index, each entry is <-WORD.LENGTH,,BLOCK.NUMBER>
INPUT %0,[IOWD MAXSET,SETBUF
0] ;Read in the index block
MOVM T1,NUMB ;Get ABS(table-number)
SKIPN T3,SETBUF-1(T1) ;Skip if the pointer to table is non-zero
JRST SETSY2 ;Go die
USETI %0,(T3) ;Get the right block to start with
CAML T3,[-SETSIZ,,0] ;If the IOWD is bigger than our buffer
TLNN T3,-1 ; or zero
HRLI T3,-SETSIZ ;Use the biggest we can handle
HRRI T3,BUFFER-1 ;Complete RH of IOWD
MOVEI T4,0 ;Stop word
IN %0,T3 ;Read in the data for this table
JRST SETSY4 ;Data read in OK
PFALL SETSY2 ;Error, return -1
SETSY2: RELEAS %0, ;Release the DSK
SETSY3: SETO T2, ;Set the error indicator to bad
JRST SETSY6 ;Return the value
SETSY4: RELEAS %0, ;Release the DSK
> ;End of IFE 'UUOS'
MOVE T1,NUMB ;Get the number of the stoke table read in
MOVEM T1,TNUMBR ;Save in global location
SETSY5: MOVEI T2,0 ;Set error indicator to good
SETSY6: MOVEM T2,@2(L) ;Store IERR as 3rd arg to SETSYM
SKIPE TNAME ;Is table name set up?
POPJ P, ;Yes
MOVE T1,[[ASCII/(unknown table)/],,TNAME]
BLT T1,TNAME+2 ;No, set name to 15 characters
POPJ P, ;End of SETSYM
IFN FTMKTB,< SUBTTL MKTBL & SETABL -- Entry points
MKTBL:: SETABL::
ERRSTR (FTL,<MKTBL and SETABL not implemented>)
**** MORE WORK NEEDED HERE *****************************************************
POPJ P,
> ;End of IFN FTMKTB
SUBTTL SYMBOL.DAT table #1 -- Pointers
$LOSEG
SYMB0L:: ENTRY SYMB0L
BUFFER: ;This data gets overwritten during CALL SETSYM('TABLE',NUMB)
PENU.N: 37 ;Pen-up code, -1 in 5 bits
HITE.N: 8.0 ;Units of height in floating point
MINC.N: 40 ;First normal character (octal code for SPACE)
MAXC.N: 140 ;Number of normal chars (96 including RUBOUT)
PENU.C: 7 ;-1 expressed in 3 bits
HITE.C: 6.0 ;Units of height in floating point
MINC.C: 0 ;First centered symbol
MAXC.C: ^D26 ;Number of centered symbols
UNUSED: EXP 0,0,0,0 ;4 words for future expansion
TNAME: ASCII /CSM Standard / ;CHARACTER*15 table name
;123456789012345
TNUMBR: 0,,1 ;Table number
;The next 200 words are byte pointers, the address an offset from STROKS,
; the count of strokes is in the middle 12 bits. All zero if no such character
IPOINT: <POINT 5,000,-1>+01_^D12 ;space 40
<POINT 5,000,14>+06_^D12 ;! 41
XLIST ;Save paper
<POINT 5,002,04>+06_^D12 ;" 42
<POINT 5,003,29>+14_^D12 ;# 43
<POINT 5,006,34>+21_^D12 ;$ 44
<POINT 5,013,24>+25_^D12 ;% 45
<POINT 5,021,24>+14_^D12 ;& 46
<POINT 5,025,09>+03_^D12 ;' 47
<POINT 5,026,09>+05_^D12 ;( 50
<POINT 5,027,29>+05_^D12 ;) 51
<POINT 5,031,14>+14_^D12 ;* 52
<POINT 5,034,19>+06_^D12 ;+ 53
<POINT 5,036,09>+07_^D12 ;, 54
<POINT 5,040,14>+03_^D12 ;- 55
<POINT 5,041,14>+06_^D12 ;. 56
<POINT 5,043,09>+03_^D12 ;/ 57
<POINT 5,044,09>+15_^D12 ;0 60
<POINT 5,047,34>+04_^D12 ;1 61
<POINT 5,051,09>+12_^D12 ;2 62
<POINT 5,054,09>+14_^D12 ;3 63
<POINT 5,057,29>+05_^D12 ;4 64
<POINT 5,061,14>+13_^D12 ;5 65
<POINT 5,064,24>+13_^D12 ;6 66
<POINT 5,067,34>+04_^D12 ;7 67
<POINT 5,071,09>+21_^D12 ;8 70
<POINT 5,076,09>+13_^D12 ;9 71
<POINT 5,101,19>+14_^D12 ;: 72
<POINT 5,104,34>+15_^D12 ;; 73
<POINT 5,110,24>+04_^D12 ;< 74
<POINT 5,111,34>+06_^D12 ;= 75
<POINT 5,113,24>+04_^D12 ;> 76
<POINT 5,114,34>+13_^D12 ;? 77
LIST
<POINT 5,120,04>+24_^D12 ;@ 100
<POINT 5,125,29>+07_^D12 ;A 101
XLIST
<POINT 5,127,29>+16_^D12 ;B 102
<POINT 5,133,29>+11_^D12 ;C 103
<POINT 5,136,19>+10_^D12 ;D 104
<POINT 5,140,34>+12_^D12 ;E 105
<POINT 5,143,24>+07_^D12 ;F 106
<POINT 5,145,24>+13_^D12 ;G 107
<POINT 5,150,34>+11_^D12 ;H 110
<POINT 5,153,14>+11_^D12 ;I 111
<POINT 5,155,29>+11_^D12 ;J 112
<POINT 5,160,14>+11_^D12 ;K 113
<POINT 5,162,29>+06_^D12 ;L 114
<POINT 5,164,19>+06_^D12 ;M 115
<POINT 5,166,14>+05_^D12 ;N 116
<POINT 5,167,34>+12_^D12 ;O 117
<POINT 5,172,34>+10_^D12 ;P 120
<POINT 5,175,14>+15_^D12 ;Q 121
<POINT 5,201,04>+13_^D12 ;R 122
<POINT 5,204,09>+13_^D12 ;S 123
<POINT 5,207,19>+06_^D12 ;T 124
<POINT 5,211,09>+07_^D12 ;U 125
<POINT 5,213,14>+04_^D12 ;V 126
<POINT 5,214,24>+06_^D12 ;W 127
<POINT 5,216,19>+06_^D12 ;X 130
<POINT 5,220,09>+07_^D12 ;Y 131
<POINT 5,222,09>+05_^D12 ;Z 132
<POINT 5,223,29>+05_^D12 ;[ 133
<POINT 5,225,14>+03_^D12 ;\ 134
<POINT 5,226,14>+05_^D12 ;] 135
<POINT 5,227,34>+07_^D12 ;^ 136
<POINT 5,231,34>+07_^D12 ;_ 137
<POINT 5,233,34>+03_^D12 ;` 140
<POINT 5,234,34>+17_^D12 ;a 141
<POINT 5,241,09>+14_^D12 ;b 142
<POINT 5,244,24>+11_^D12 ;c 143
<POINT 5,247,14>+15_^D12 ;d 144
<POINT 5,253,04>+13_^D12 ;e 145
<POINT 5,256,14>+11_^D12 ;f 146
<POINT 5,260,34>+17_^D12 ;g 147
<POINT 5,265,09>+11_^D12 ;h 150
<POINT 5,267,29>+10_^D12 ;i 151
<POINT 5,272,04>+10_^D12 ;j 152
<POINT 5,274,14>+11_^D12 ;k 153
<POINT 5,276,29>+03_^D12 ;l 154
<POINT 5,277,29>+17_^D12 ;m 155
<POINT 5,303,34>+11_^D12 ;n 156
<POINT 5,306,19>+12_^D12 ;o 157
<POINT 5,311,19>+14_^D12 ;p 160
<POINT 5,314,34>+14_^D12 ;q 161
<POINT 5,320,14>+10_^D12 ;r 162
<POINT 5,322,24>+13_^D12 ;s 163
<POINT 5,325,34>+11_^D12 ;t 164
<POINT 5,330,19>+10_^D12 ;u 165
<POINT 5,332,34>+04_^D12 ;v 166
<POINT 5,334,09>+06_^D12 ;w 167
<POINT 5,336,04>+06_^D12 ;x 170
<POINT 5,337,29>+07_^D12 ;y 171
<POINT 5,341,29>+05_^D12 ;z 172
<POINT 5,343,14>+10_^D12 ;{ 173
<POINT 5,345,29>+03_^D12 ;| 174
<POINT 5,346,29>+10_^D12 ;} 175
LIST
<POINT 5,351,09>+05_^D12 ;~ 176
<POINT 5,352,29>+04_^D12 ;<DEL> 177
;Centered symbols
<POINT 3,354,04>+10_^D12 ; 0
<POINT 3,355,20>+14_^D12 ; 1
XLIST
<POINT 3,357,23>+06_^D12 ; 2
<POINT 3,360,26>+07_^D12 ; 3
<POINT 3,361,35>+07_^D12 ; 4
<POINT 3,363,08>+07_^D12 ; 5
<POINT 3,364,17>+07_^D12 ; 6
<POINT 3,365,26>+06_^D12 ; 7
<POINT 3,366,29>+07_^D12 ; 8
<POINT 3,367,35>+07_^D12 ; 9
<POINT 3,371,08>+16_^D12 ; 10
<POINT 3,373,23>+15_^D12 ; 11
<POINT 3,375,32>+07_^D12 ; 12
<POINT 3,377,05>+04_^D12 ; 13
<POINT 3,377,32>+11_^D12 ; 14
<POINT 3,401,14>+04_^D12 ; 15
<POINT 3,402,05>+14_^D12 ; 16
<POINT 3,404,05>+10_^D12 ;1 17
<POINT 3,405,17>+13_^D12 ;2 18
<POINT 3,407,11>+20_^D12 ;3 19
<POINT 3,411,35>+11_^D12 ;4 20
<POINT 3,413,14>+14_^D12 ;5 21
<POINT 3,415,14>+17_^D12 ;6 22
<POINT 3,417,32>+11_^D12 ;7 23
<POINT 3,421,14>+24_^D12 ;8 24
LIST
<POINT 3,424,26>+17_^D12 ;9 25
BLOCK 200-<.-IPOINT> ;Unused pointers
SUBTTL SYMBOL.DAT table #1 -- Data
STROKS: BYTE (5) 10,0,6 (5)10,0,6,2, 6,2,7,-1,2,10,2
BYTE (5) 15 (5)10,0,6,2,14,2, 16,-1,4,16,4,14 (5)10
BYTE (5) 0,6,2,7,2,15,-1, 4,15,4,7,-1,6,11
XLIST ;More of the same
BYTE (5) 0,11,-1,0,13,6,13 (5)10,0,6,0,10,2,6
BYTE (5) 4,6,6,10,4,12,2, 12,0,14,2,16,4,16
BYTE (5) 6,14,-1,4,16,4,6, -1,2,6,2,16 (5)10,0
BYTE (5) 6,0,6,6,14,1,14, 0,13,0,12,1,11,2
BYTE (5) 11,3,12,3,13,2,14, -1,4,11,3,10,3,7
BYTE (5) 4,6,5,6,6,7,6, 10,5,11,4,11 (5)10,0
BYTE (5) 6,6,6,1,13,1,15, 2,16,3,16,4,15,0
BYTE (5) 11,0,7,1,6,3,6, 5,10 (5)10,0,6,2,14
BYTE (5) 4,16 (5)10,0,6,2,6, 0,10,0,14,2,16 (5)10
BYTE (5) 0,6,0,6,2,10,2, 14,0,16 (5)10,0,6,0
BYTE (5) 10,4,14,-1,2,14,2, 10,-1,4,10,0,14,-1
BYTE (5) 0,12,4,12 (5)10,0,6, 2,7,2,13,-1,0,11
BYTE (5) 4,11 (5)10,0,6,3,6, 3,7,2,7,2,6,3
BYTE (5) 6,2,5 (5)10,0,6,0, 11,4,11 (5)10,0,6,2
BYTE (5) 6,3,6,3,7,2,7, 2,6 (5)10,0,6,0,6
BYTE (5) 6,14 (5)10,0,6,0,7, 6,15,-1,6,14,4,16
BYTE (5) 2,16,0,14,0,10,2, 6,4,6,6,10,6,14
BYTE (5)10,0,6,1,14,3,16, 3,6 (5)10,0,6,0,14
BYTE (5) 0,15,1,16,5,16,6, 15,6,13,0,7,0,6
BYTE (5) 6,6 (5)10,0,6,0,15, 1,16,5,16,6,15,6
BYTE (5) 14,4,12,6,10,6,7, 5,6,1,6,0,7 (5)10
BYTE (5) 0,6,5,6,5,16,0, 11,6,11 (5)10,0,6,0
BYTE (5) 7,1,6,4,6,6,10, 6,11,5,12,1,12,0
BYTE (5) 11,0,16,6,16 (5)10,0, 6,0,11,1,12,5,12
BYTE (5) 6,11,6,7,5,6,1, 6,0,7,0,12,4,16
BYTE (5)10,0,6,0,16,6,16, 1,6 (5)10,0,6,1,12
BYTE (5) 0,11,0,7,1,6,5, 6,6,7,6,11,5,12
BYTE (5) 6,13,6,15,5,16,1, 16,0,15,0,13,1,12
BYTE (5) 5,12 (5)10,0,6,2,6, 6,12,6,15,5,16,1
BYTE (5) 16,0,15,0,13,1,12, 5,12,6,13 (5)10,0,6
BYTE (5) 2,6,3,6,3,7,2, 7,2,6,-1,2,12,3
BYTE (5) 12,3,13,2,13,2,12 (5)10,0,6,3,6,3,7
BYTE (5) 2,7,2,6,3,6,2, 5,-1,2,12,3,12,3
BYTE (5) 13,2,13,2,12 (5)10,0, 6,3,7,0,12,3,15
BYTE (5)10,0,6,0,10,6,10, -1,6,12,0,12 (5)10,0
BYTE (5) 6,0,7,3,12,0,15 (5)10,0,6,1,15,2,16
BYTE (5) 4,16,5,15,5,14,3, 12,3,10,-1,3,7,3
BYTE (5) 6 (5)10,0,6,1,6,0, 7,0,13,1,14,5,14
BYTE (5) 6,13,6,10,5,7,4, 10,4,13,-1,4,12,3
BYTE (5) 13,2,13,1,12,1,11, 2,10,3,10,4,11 (5)10
BYTE (5) 0,6,0,6,3,16,6, 6,-1,1,11,5,11 (5)10
BYTE (5) 0,6,0,6,0,16,5, 16,6,15,6,13,5,12
BYTE (5) 0,12,-1,5,12,6,11, 6,7,5,6,0,6 (5)10
BYTE (5) 0,6,6,15,5,16,2, 16,0,14,0,10,2,6
BYTE (5) 5,6,6,7 (5)10,0,6, 0,6,0,16,4,16,6
BYTE (5) 14,6,10,4,6,0,6 (5)10,0,6,0,6,0,16
BYTE (5) 6,16,-1,4,12,0,12, -1,0,6,6,6 (5)10,0
BYTE (5) 6,0,6,0,16,6,16, -1,4,12,0,12 (5)10,0
BYTE (5) 6,6,15,5,16,2,16, 0,14,0,10,2,6,4
BYTE (5) 6,6,10,6,12,4,12 (5)10,0,6,0,6,0,16
BYTE (5) -1,6,16,6,6,-1,0, 12,6,12 (5)10,0,6,1
BYTE (5) 6,5,6,-1,3,6,3, 16,-1,1,16,5,16 (5)10
BYTE (5) 0,6,1,7,2,6,3, 6,4,7,4,16,-1,2
BYTE (5) 16,6,16 (5)10,0,6,1, 6,1,16,-1,1,12,5
BYTE (5) 16,-1,1,12,5,6 (5)10, 0,6,0,6,0,16,-1
BYTE (5) 0,6,6,6 (5)10,0,6, 0,6,0,16,3,13,6
BYTE (5) 16,6,6 (5)10,0,6,0, 6,0,16,6,6,6,16
BYTE (5)10,0,6,0,10,0,14, 2,16,4,16,6,14,6
BYTE (5) 10,4,6,2,6,0,10 (5)10,0,6,0,6,0,16
BYTE (5) 5,16,6,15,6,13,5, 12,0,12 (5)10,0,6,0
BYTE (5) 10,0,14,2,16,4,16, 6,14,6,10,4,6,2
BYTE (5) 6,0,10,-1,4,10,6, 6 (5)10,0,6,0,6,0
BYTE (5) 16,5,16,6,15,6,13, 5,12,0,12,-1,2,12
BYTE (5) 6,6 (5)10,0,6,0,10, 2,6,4,6,6,10,4
BYTE (5) 12,2,12,0,14,2,16, 4,16,6,14 (5)10,0,6
BYTE (5) 3,6,3,16,-1,0,16, 6,16 (5)10,0,6,0,16
BYTE (5) 0,7,1,6,5,6,6, 7,6,16 (5)10,0,6,0
BYTE (5) 16,3,6,6,16 (5)10,0, 6,0,16,0,6,3,11
BYTE (5) 6,6,6,16 (5)10,0,6, 0,6,6,16,-1,0,16
BYTE (5) 6,6 (5)10,0,6,0,16, 3,13,6,16,-1,3,13
BYTE (5) 3,6 (5)10,0,6,0,16, 6,16,0,6,6,6 (5)10
BYTE (5) 0,6,3,4,0,4,0, 16,3,16 (5)10,0,6,0
BYTE (5) 14,6,6 (5)10,0,6,3, 4,6,4,6,16,3,16
BYTE (5)10,0,6,0,13,3,16, 6,13,-1,3,16,3,6
BYTE (5)10,0,6,3,7,0,12, 3,15,-1,0,12,6,12
BYTE (5)10,0,6,2,16,4,14 (5)10,0,6,0,11,1,12
BYTE (5) 3,12,4,11,4,6,-1, 4,10,3,11,1,11,0
BYTE (5) 10,0,7,1,6,3,6, 4,7 (5)10,0,6,0,6
BYTE (5) 0,15,-1,0,11,1,12, 3,12,4,11,4,7,3
BYTE (5) 6,1,6,0,7 (5)10,0, 6,4,11,3,12,1,12
BYTE (5) 0,11,0,7,1,6,3, 6,4,7 (5)10,0,6,0
BYTE (5) 7,0,11,1,12,3,12, 4,11,4,7,3,6,1
BYTE (5) 6,0,7,-1,4,6,4, 15 (5)10,0,6,4,7,3
BYTE (5) 6,1,6,0,7,0,11, 1,12,3,12,4,11,4
BYTE (5) 10,0,10 (5)10,0,6,2, 6,2,14,3,15,4,15
BYTE (5) 5,14,-1,0,13,4,13 (5)10,0,6,4,11,3,12
BYTE (5) 1,12,0,11,0,7,1, 6,3,6,4,7,-1,4
BYTE (5) 12,4,5,3,4,1,4, 0,5 (5)10,0,6,0,6
BYTE (5) 0,15,-1,0,11,1,12, 3,12,4,11,4,6 (5)10
BYTE (5) 0,6,3,14,3,13,-1, 3,12,3,7,4,6,5
BYTE (5) 6 (5)10,0,6,3,14,3, 13,-1,3,12,3,5,2
BYTE (5) 4,1,4 (5)10,0,6,0, 6,0,15,-1,0,10,2
BYTE (5) 12,-1,0,10,2,6 (5)10, 0,6,2,6,2,15 (5)10
BYTE (5) 0,6,0,6,0,12,-1, 0,11,1,12,2,12,3
BYTE (5) 11,3,6,-1,3,11,4, 12,5,12,6,11,6,6
BYTE (5)10,0,6,0,6,0,12, -1,0,11,1,12,2,12
BYTE (5) 3,11,3,6 (5)10,0,6, 0,7,0,11,1,12,3
BYTE (5) 12,4,11,4,7,3,6, 1,6,0,7 (5)10,0,6
BYTE (5) 0,4,0,12,-1,0,11, 1,12,3,12,4,11,4
BYTE (5) 7,3,6,1,6,0,7 (5)10,0,6,4,11,3,12
BYTE (5) 1,12,0,11,0,7,1, 6,3,6,4,7,-1,4
BYTE (5) 12,4,4 (5)10,0,6,0, 6,0,12,-1,0,11,1
BYTE (5) 12,3,12,4,11 (5)10,0, 6,0,7,1,6,3,6
BYTE (5) 4,7,3,10,1,10,0, 11,1,12,3,12,4,11
BYTE (5)10,0,6,2,15,2,7, 3,6,4,6,5,7,-1
BYTE (5) 1,13,3,13 (5)10,0,6, 0,12,0,7,1,6,3
BYTE (5) 6,4,7,4,12,4,6 (5)10,0,6,0,12,2,6
BYTE (5) 4,12 (5)10,0,6,0,12, 0,6,2,10,4,6,4
BYTE (5) 12 (5)10,0,6,0,6,4, 12,-1,0,12,4,6 (5)10
BYTE (5) 0,6,0,12,2,6,-1, 4,12,1,4,0,4 (5)10
BYTE (5) 0,6,0,12,4,12,0, 6,4,6 (5)10,0,6,3
BYTE (5) 16,2,15,2,13,0,11, 2,7,2,5,3,4 (5)10
BYTE (5) 0,6,2,4,2,16 (5)10, 0,6,0,16,1,15,1
LIST
BYTE (5) 13,3,11,1,7,1,5, 0,4 (5)0,0,6,2,20 ;350 & 351 = "~"
BYTE (5) 3,21,4,20,5,21 (5)0, 0,6,1,20,4,20,4 ;352 & 353
BYTE (5) 17 (3) 3,3,3,3,5,5,5,5,1,1 ;Start of centered symbols
BYTE (3) 1,1,5,3,5,3,3,3,3,3,3,5 ;355
BYTE (3) 4,5,5,4,5,2,4,1,2,1,1,2, 1,4,2,5,3,5,3,3,3,3,3,3
BYTE (3) 5,5,1,1,1,3,5,3,3,3,3,3, 3,5,3,1,3,3,1,3,5,3,3,3
XLIST
BYTE (3) 3,3,3,5,5,1,1,3,3,1,5,5, 1,3,3,3,3,3,3,5,5,3,3,1
BYTE (3) 1,3,3,5,3,3,3,3,3,3,1,3, 5,5,3,1,3,3,5,3,3,3,3,3
BYTE (3) 1,1,5,5,1,5,5,1,3,3,3,3, 3,1,5,5,5,1,1,5,1,-1,3,3
BYTE (3) 3,3,3,1,5,3,3,5,5,3,3,3, 1,3,3,3,3,3,5,5,4,4,2,4
BYTE (3) 1,5,2,4,2,2,1,1,2,2,4,2, 5,1,4,2,4,4,3,3,3,3,3,3
BYTE (3) 5,3,1,3,3,5,5,1,1,3,3,5, 3,1,3,3,3,5,1,1,5,3,3,3
BYTE (3) 3,3,3,3,5,5,1,5,5,1,1,1, 3,3,3,3,3,3,5,3,1,3,3,3
BYTE (3) 3,3,3,6,5,1,1,4,5,4,1,1, 3,6,-1,3,3,3,3,3,1,3,5,3
BYTE (3) 3,3,3,3,3,2,0,4,0,5,1,5, 5,4,6,2,6,1,5,1,1,2,0,-1
BYTE (3) 3,3,3,3,3,2,5,3,6,3,0,2, 0,4,0,-1,3,3,3,3,3,1,5,2
BYTE (3) 6,4,6,5,5,5,4,1,1,1,0,5, 0,-1,3,3,3,3,3,1,5,2,6,4
BYTE (3) 6,5,5,5,4,4,3,2,3,4,3,5, 2,5,1,4,0,2,0,1,1,-1,3,3
BYTE (3) 3,3,3,1,6,1,3,5,3,-1,4,6, 4,0,-1,3,3,3,3,3,1,1,2,0
BYTE (3) 4,0,5,1,5,2,4,3,1,3,1,6, 5,6,-1,3,3,3,3,3,5,5,4,6
BYTE (3) 2,6,1,5,1,1,2,0,4,0,5,1, 5,2,4,3,2,3,1,2,-1,3,3,3
BYTE (3) 3,3,1,5,1,6,5,6,5,5,3,1, 3,0,-1,3,3,3,3,3,1,5,2,6
BYTE (3) 4,6,5,5,5,4,4,3,2,3,4,3, 5,2,5,1,4,0,2,0,1,1,1,2
BYTE (3) 2,3,1,4,1,5,-1,3,3,3,3,3, 1,1,2,0,4,0,5,1,5,5,4,6
LIST
BYTE (3) 2,6,1,5,1,4,2,3,4,3,5,4, -1,3,3,0 ;End of centered data
BLOCK SETSIZ-<.-BUFFER> ;Reserve the rest of the space
SETEND==.-1 ;End of COMMON /SYMB0L/
IFL MAXSET-<TNUMBR-BUFFER+1>,<MAXSET==TNUMBER-BUFFER+1>;^D16 is minimum
NUMB: BLOCK 1 ;Arg to SETSYM, number of requested table
SETBUF: BLOCK MAXSET ;First block of SYMBOL.DAT, index pointers
$HISEG
LITS: PRGEND > ;End of IFN 'FOROTS' for SETSYM
SUBTTL SYMBOL -- Entry point
SEARCH PLTUNV ;Search the universal file
TTL (<%SYMBOL - Draws symbols on the plotter>,MAIN)
EXTERN SIND., COSD., TRACE. ;Routines in FORLIB
EXTERN PLOT ;Routine to move the pen
EXTERNAL SYMB0L ;Table in SETSYM module spelled with a zero '0'
ND SYMDEV,SIXBIT/SYS/ ;SYMBOL.DAT resides on SYS:
ND OLDVAL,999.0 ;Flag to continue where last symbol left off
;ACs defined in PLTUNV
A=P1 ;Preserved AC
B=P2 ;Byte pointer
C=P3 ;Counter
D=P4 ;Data
X=X ;Current position
Y=Y ; ...
PURGE P1,P2,P3,P4
SAVACL==A ;First AC to save before calling PLOT##
SAVACH==Y ;Last " " "
; Subroutine SYMBOL - this routine plots char and symbols
; Calling sequence:
; CALL SYMBOL (X,Y,HEIGHT,CSTRNG,ANGLE)
; 0 1 2 3 4 5
; CALL SYMBOL (X,Y,HEIGHT,IARRAY,ANGLE,NUMCHR)
ENTRY %SYMBOL ;Set up entry point
SIXBIT /SYMBOL/ ;Routine name and file name
%SYMBOL:MOVEM L,SYMB16 ;Preserve L across call
MOVEI T0,ARGS-1 ;Set up to get the arguments
PUSH T0,@0(L) ;Get X
PUSH T0,@1(L) ;Get Y
PUSH T0,@2(L) ;Get HEIGHT
PUSH T0,@4(L) ;Get ANGLE
XMOVEI T1,@3(L) ;String or array is 4th arg
LDB T2,[ACPNTR 3(L)] ;Get type of argument
CAIN T2,ACTYPE(CHARACT);CHARACTER expression?
JRST [DMOVE T1,(T1) ;Yes, get byte string descriptor
JRST SYMBO0 ]
HRLI T1,(POINT 7,) ;Point to the number or start of ASCIZ
MOVE T2,@5(L) ;Character count in 6th arg
PFALL SYMBO0 ;T1&T2 have byte string descriptor
;Mode 1 (NUMCHR positive) Plot left justified string of characters
;Mode 2 (NUMCHR zero) Plot single right justified ASCII character
;Mode 3 (NUMCHR -2 or -3) Plot centered symbol, with or without connecting line
;The RH of TABLE is IPOINT for normal chars, is IPOINT+140 for centered symbols
SYMBO0: DMOVEM T1,CHPTR ;Pointer in CHPTR, count in NUMCHR
SKIPL T1,NUMCHR ;Mode 1 or 2? (Normal)
JRST SYMNOR ;Yes, set up for normal symbols
;Mode 3 (Centered)
SYMCEN: SKIPE HITE.C ;Check on centered symbol height
SKIPN MAXC.C ; and number of them
JRST SYMBER ;Error - No centered symbols in this table
MOVE T2,[PENU.C,,PENU.$] ;BLT pointer
BLT T2,MAXC.$ ;Set up PENU.$, HITE.$, MINC.$, and MAXC.$
MOVEI T2,IPOINT ;Get addr of data area
ADD T2,MAXC.N ;Centered symbols start after normal symbols
TLO T2,D ;Put in index register for @SYMPTR
MOVEM T2,SYMPTR ;Set the stroke pointer for mode 3
JRST SYMBO1 ;Join common code
SYMBER:
;*; ERRSTR (MSG,<SYMBOL - No centered symbols in this table>)
;*; PUSHJ P,TRACE.## ;Trace the subroutine calls
POPJ P, ;Return to caller
SYMNOR: MOVE T2,[PENU.N,,PENU.$] ;BLT pointer
BLT T2,MAXC.$ ;Set up PENU.$, HITE.$, MINC.$, MAXC.$
MOVEI T2,IPOINT ;Get the start of the stroke array
TLO T2,D ;Put in index register for @SYMPTR
MOVEM T2,SYMPTR ;Set the stroke pointers for mode 1 and 2
PFALL SYMBO1 ;Join common code
SUBTTL SYMBOL -- Set up translation and rotation
SYMBO1: DMOVE X,SYMB.X ;Get the requested coordinates
CAMN X,[OLDVAL] ;If 999.0,
SKIPA X,POS.X ; use old position,
MOVEM X,CRLF.X ; else remember for CR and LF
CAMN Y,[OLDVAL] ;Same for Y
SKIPA Y,POS.Y
MOVEM Y,CRLF.Y
DMOVEM X,POS.X ;Set current position
MOVE T1,NUMCHR ;Get number of chars (negative for centered)
MOVEI D,PEN.DN ;Assume centered symbol with connecting line
CAMN T1,[-2] ;If -2 draw line from old pen position to
PUSHJ P,MYPLOT ; current position, if -3 do not draw line
SKIPN T1,HEIGHT ;Get the height of the symbols
MOVE T1,OLDHIT ;Zero, use previous
MOVEM T1,OLDHIT
FDVR T1,HITE.$ ;Divide by the max deltas allowed
MOVEM T1,ROTSIN ;Save for later
MOVEM T1,ROTCOS ; ..
XMOVEI L,[-1,,0 ;One arg
REAL ANGLE ;Number of degrees
]+1 ;Point to args
PUSHJ P,SIND. ;Go get the sine of the angle
FMPRM T0,ROTSIN ;Multiply by the height and save
XMOVEI L,[-1,,0 ;One arg
REAL ANGLE ;Number of degrees
]+1 ;Point to args
PUSHJ P,COSD. ;Go get the cosine of the angle
FMPRM T0,ROTCOS ;Multiply by the height and save
SKIPLE T1,NUMCHR ;Get the character count
JRST SYMLOP ;Output a string for NUMCHR=positive
MOVE D,@CHPTR ;Get the char code
JUMPE T1,SYMLP0 ;Do single ASCII character if NUMCHR=0
JRST SYMLP2 ;Do centered symbol if NUMCHR=negative
SUBTTL SYMBOL -- Main loop, do a character
SYMLOP: ILDB D,CHPTR ;Get next character from string
SYMLP0: JUMPE D,SYMB09 ;Stop at null if ASCIZ
;Special case CR and LF
SETO C, ;Set counter in case of match
MOVSI T1,-SCHARS ;Get AOBJN pointer
SYMLP1: HLRZ T2,SCHTAB(T1) ;Get a special character
HRRZ T3,SCHTAB(T1) ; and its dispatch addr
CAMN D,T2 ;Match?
JRST (T3) ;Yes, handle specially
AOBJN T1,SYMLP1 ;No try next one
SUB D,MINC.$ ;Subtract offset (so that 0=space)
SYMLP2: JUMPL D,SYMB08 ;Jump if the char is to small
CAMGE D,MAXC.$ ;Skip if the char is to big
SKIPN B,@SYMPTR ;Get pointer to data, indexed by D
JRST SYMB08 ;Punt off this char, pointer is zero
LDB C,[POINT 12,B,23];Get the number of strokes in the char
AND B,[777700,,007777];Remove the count from byte pointer
ADDI B,STROKS ;Add in the relocation of the data area
ILDB T1,B ;Get the width of the character
MOVEM T1,SPC.X ;Save for it later
ILDB T1,B ;Get the subtractive offset for the X direction
MOVEM T1,SUB.X ;This is used to allow negative offsets
ILDB T1,B ;Get the offset for Y
MOVEM T1,SUB.Y ;This allows for negative Y, for descenders
SOJLE C,SYMB06 ;Jump if this is the space character
;The first move is with the pen up
SYMB03: MOVEI D,PEN.UP ;Set to raise the pen on this move
SYMB04: ILDB X,B ;Get the X value to be used
CAMN X,PENU.$ ;Is it the pen up command?
SOJA C,SYMB03 ;Yes, next movement will be with the pen up
ILDB Y,B ;Get the Y value to be used
SUB Y,SUB.Y ;Relocate the Y value
SYMB05: SUB X,SUB.X ;Relocate the X value
FLOAT X ;Convert the number to floating point
FLOAT Y ;Convert the number to floating point
PUSHJ P,ROT.XY ;Rotate coordinates
FADR X,POS.X ;Add in the offset for the starting position
FADR Y,POS.Y ; for this character
PUSHJ P,MYPLOT ;Go move the pen to X, Y, and pen up/down in D
MOVEI D,PEN.DN ;Make the next segment be for pen down
SOJG C,SYMB04 ;Loop if more strokes left to do
JUMPL C,SYMB07 ;Stop if finished with character
;Here on last movement for this char
SYMB06: MOVE X,SPC.X ;Get the width of this character
SYMB6A: MOVEI Y,0 ;At the baseline
MOVEI D,PEN.UP ;Raise the pen
JRST SYMB05 ; and move to the end of the character
SYMB07: DMOVEM X,POS.X ;Save current position as start of next char
;Here when finished with the current character
SYMB08: SOSLE NUMCHR ;Skip if no more char left
JRST SYMLOP ;Loop for next character
;The coordinates for the start of the next symbol (POS.X and POS.Y) are
;available by calling subroutine WHERE(X,Y).
SYMB09: MOVE L,SYMB16 ;Restore L
POPJ P, ;Return from SYMBOL
;ROT.XY - Normalize the data and rotate the coordinates
;X0 = arg to SYMBOL, X1 = data from table, X2 = arg passed to PLOT
;SIZE = HEIGHT / <data for tallest letter>
;X2 = X0 + ( X1*SIZE*COS(ANG) - Y1*SIZE*SIN(ANG) )
;Y2 = Y0 + ( Y1*SIZE*COS(ANG) + X1*SIZE*SIN(ANG) )
ROT.XY: MOVE T3,X ;Get a copy of X
MOVE T4,Y ;Get a copy of Y
FMPR T4,ROTSIN ;Rotate the X
FMPR X,ROTCOS ; ..
FSBR X,T4 ; ..
FMPR T3,ROTSIN ;Rotate the Y
FMPR Y,ROTCOS ; ..
FADR Y,T3 ; ..
POPJ P,
SUBTTL SYMBOL -- Control characters, CR, LF, etc
;Table of special control characters
SCHTAB: 10,,DOBS ;Backspace
11,,DOTAB ;Horizontal tab
12,,DOLF ;Linefeed
15,,DOCR ;Carriage return
16,,DOSO ;Shift-out (superscript)
17,,DOSI ;Shift-in (subscript)
36,,DORS ;Record Separator (newline = CR + LF)
SCHARS==.-SCHTAB
DOTAB: SKIPA X,SPC.X ;TAB - go forward
DOBS: MOVN X,SPC.X ;BS - backspace
JRST SYMB6A ;Move with pen up
DOCR: DMOVE X,CRLF.X ;CR - Reset to start of line
DMOVEM X,POS.X ;Change position
JRST SYMB08 ;Loop if more chars to do
DORS: DMOVE X,CRLF.X ;RS (Record Separator) - Do CR and LF
DMOVEM X,POS.X
DOLF: MOVN Y,HITE.$ ;LF - Get height of chars (in increments f.p.)
FMPRI Y,(1.5) ;Leave room for descenders
MOVEI X,0 ;No change in X coordinate
PUSHJ P,ROT.XY ;Account for rotation
FADRM X,CRLF.X ;Update position of "column 1"
FADRM Y,CRLF.Y
DOLF1: FADRB X,POS.X ;Update position
FADRB Y,POS.Y
JRST SYMB08 ;Loop if more chars to do
DOSO: SKIPA Y,HITE.$ ;SO - Get +height for superscripts
DOSI: MOVN Y,HITE.$ ;SI - Get -height for subscripts
FDVRI Y,(2.0) ;Move only half that distance
MOVEI X,0 ;No change in X coordinate
PUSHJ P,ROT.XY ;Account for rotation
JRST DOLF1 ;Do a +/- half linefeed
SUBTTL SYMBOL -- Interface to PLOT and layout of SYMB0L data
;Destroys T1-T4, preserves A,B,C,D,X,Y
;Call:
; MOVEI D,ICODE ;PEN.UP or PEN.DN
; DMOVE X,[coordinates in inches]
; PUSHJ P,MYPLOT
; *return*
PLOT.P=SYMB00+D ;Pen up/down data
PLOT.X=SYMB00+X ;X position
PLOT.Y=SYMB00+Y ;Y position
MYPLOT: MOVE T1,[SAVACL,,SYMB00+SAVACL]
BLT T1,SYMB00+SAVACH;Store X,Y,IC in memory
XMOVEI L,[-3,,0 ;Three args
REAL PLOT.X ;X coordinate
REAL PLOT.Y ;Y coordinate
INTEGER PLOT.P ;Pen up/down code
]+1 ;Point to args
PUSHJ P,PLOT## ;Go plot the segment
MOVE T1,[SYMB00+SAVACL,,SAVACL]
BLT T1,SAVACH ;Restore A,B,C,D,X,Y
POPJ P, ;Return from MYPLOT
;Layout of data in COMMON/SYMB0L/ (note: spelled with a zero '0')
PENU.N=SYMB0L+0 ;37 ;Pen-up code, -1 in 5 bits
HITE.N=SYMB0L+1 ;8.0 ;Units of height in floating point
MINC.N=SYMB0L+2 ;40 ;First normal character (octal code for SPACE)
MAXC.N=SYMB0L+3 ;140 ;Number of normal chars (96 including RUBOUT)
PENU.C=SYMB0L+4 ;7 ;-1 expressed in 3 bits
HITE.C=SYMB0L+5 ;6.0 ;Units of height in floating point
MINC.C=SYMB0L+6 ;0 ;First centered symbol
MAXC.C=SYMB0L+7 ;^D26 ;Number of centered symbols
;;;;;;=SYMB0L+10,11,12,13 ;Reserved for future expansion
TNAME= SYMB0L+14 ;ASCII /CSM Standard /;CHARACTER*15 table name
TNUMBR=SYMB0L+17 ;1 ;Number of current table
IPOINT=SYMB0L+20 ;BLOCK 200 ;Combined byte pointer and stroke count
STROKS=SYMB0L+220 ;BLOCK 3000 ;Start of stroke table
SUBTTL SYMBOL -- Variables
$LOSEG
SYMB00: BLOCK 17 ;Place to save ACs, 0-16, for MYPLOT
SYMB16=SYMB00+L ;Accumulator L
POS.X: BLOCK 2 ;Starting position for current character
POS.Y=POS.X+1
CRLF.X: BLOCK 2 ;Saved position for doing CR or LF
CRLF.Y=CRLF.X+1
OLDHIT: BLOCK 1 ;Previous non-zero height
ROTSIN: BLOCK 1 ;SIN(ANG) * HEIGHT / <data for tallest char>
ROTCOS: BLOCK 1 ; for rotation
ARGS: BLOCK 4 ;Temporary storage
SYMB.X=ARGS+0 ;X coord for NUMBER or SYMBOL
SYMB.Y=ARGS+1 ;Y coord for NUMBER or SYMBOL
HEIGHT=ARGS+2 ;Size of characters
ANGLE= ARGS+3 ;Degrees of rotation
CHPTR: BLOCK 2 ;Byte pointer to string
NUMCHR=CHPTR+1 ;Number of characters in string
;These 3 values get set by ILDB at the start of each character plotted
SPC.X: BLOCK 1 ;The spacing for this char
SUB.X: BLOCK 1 ;The X subtractive value
SUB.Y: BLOCK 1 ;The Y subtractive value
;These 4 values get set by BLT from PENU.C or PENU.N
PENU.$: BLOCK 1 ;If X = PENU.$ the next movement will be pen up
HITE.$: BLOCK 1 ;The max height of the char in delta units
MINC.$: BLOCK 1 ;Subtract this off to get rid of unwanted chars
MAXC.$: BLOCK 1 ;Number of graphic characters this mode
SYMPTR: BLOCK 1 ;RH is IPOINT for NORMAL, IPOINT+140 for CENTER
;LH has D in index field for @SYMPTR
$HISEG ;For the literals
LITS: END