/DECMATE II REGIS INTERPRETER REV= 44 / VERSION 44 - 02 JUL 84 - K HOUSE - FIX LINE PATTERN FROM BINARY STRING. / VERSION 43 - 22 JUN 84 - K HOUSE - IGNORE SCREEN ADDRESS COMMAND UNLESS / BOTH BRACKETED PAIRS GIVEN; / TREAT A MISSING PARAMETER OR A RELATIVE / ZERO AS NO CHANGE IN SCREEN HARDCOPY / OFFSET COMMAND 'S(H(P[X,Y]))'. / VERSION 42 - 21 JUN 84 - K HOUSE - FIX 'GTRUN' SO IT HANDLES AN EMPTY / STRING (HAD MISSED FIRST NON-SPACE / CHARACTER AFTER FIRST QUOTE); / INITIALIZE 'S' PARAMETER AT LOAD TIME / (HAD CAUSED EXPLICIT TEXT SIZING TO FAIL); / FORCE TEXT SIZES > 16 TO SIZE ONE (HAD / FORCED TO SIZE ZERO); / ** VERSION 41 RELEASED WITH V43 FIELD / TEST ** / VERSION 41 - 16 MAY 84 - K HOUSE - FIX CIRCLES AFTER SET SHADE REFERENCE. / VERSION 40 - 09 MAY 84 - K HOUSE - FIX TEXT MULTIPLIER (SHOULDN'T HAVE / BEEN AFFECTED BY SCREEN ADDRESSING). / VERSION 37 - 03 MAY 84 - K HOUSE - EXPAND STACK TO 16 DECIMAL ENTRIES. / VERSION 36 - 25 APR 84 - K HOUSE - FIX TEXT CELL WIDTH SPECIFIER; / SCALE TEXT CELL, UNIT, AND MULTIPLIER / CHANGE DEFAULT COLOR MAP VALUES. /1. FIX TEXT SIZE ROUTINE TO NOT CHANGE TO DEFAULT OF S(1) IF THERE IS A ZERO / PARAMETER IN THE PARAMETERS. /2. DELETE "DCA STKPNT" AT REGI2B+2 TO CORRECT PROBLEM OF SEMICOLON CLEARING / THE POSITION STACK WHEN IT SHOULDN'T. /3. ADD CODE IN LOOKUP ROUTINE TO PREVENT COMMAS FROM PUSHING TO TOP COMMAND / LEVEL. /4. DELETE CODE THAT CALLS INIMAP AT INIT. TIME. ADD A FIXED TABLE AT CMAPTB / WITH VALUES 10 -> 17, 0 -> 7. /DECMATE II REGIS INTERPRETER VER 0.34 2-APR-84 /1. FIX TO SEND PATTERN CALL. /2. ADD COMMA TO TEXT COMMAND OPTION LOOKUP TABLE. /DECMATE II REGIS INTERPRETER VER 0.33 23-MAR-84 /1. ADD NEW ROUTINES TO HANDLE SCREEN HARD COPY COMMANDS ALA VT240 MODE. /2. NEW CODE FOR S(C)"CURSOR ON/OFF". /3. NEW CODE FOR S(T<>) TIMER REQUEST. /4. FIX CODE SO THAT REGIS DOES THE RIGHT THING WHEN GETTING A L"@" -- IT WAS / PREVIOUSLY TRAPPING THE "@" CHAR AS A MACRO-GRAPH INTRODUCER. /5. PUT IN CHANGES TO THE HLSCLB CODE TO MAKE DECGRAPH LOOK BETTER. /DECMATE II REGIS INTERPRETER VER 0.30 29-FEB-84 /1. FIX A BUG IN REGIS WHERE THE PROGRAM WOULD HANG WHEN EXECUTING A MACRO / GRAPH CONTAINING A LOAD TEXT COMMAND. DELETED CODE IN THE CLEANUP ROUTINE, / AND MOVED (2) CONSTANTS OFF OF PAGE 0 AS THEY WERE CONFLICTING WITH PRIMS. /DECMATE II REGIS INTERPRETER VER 0.27 20-FEB-84 /1. FIX "L"OAD CHAR COMMAND TO TERMINATE ON OTHER THAN A SEMICOLON. IT NOW / TERMINATES ON THE FIRST NON-HEX CHARACTER. ****NOTE THAT A "C"IRCLE COMMAND / FOLLOWING A LOAD COMMAND MAY EXPERIENCE PROBLEMS, BECAUSE THE "C" IS VALID / HEX INPUT. /2. DELETE VARIOUS CODE THAT IS NO LONGER USED OR USEFUL. /3. CHANGE TO STORE TEXT (B)EGIN AND RESTORE TEXT (E)ND DATA IN THE REGIS FIELD / INSTEAD OF THE PRIMS. /DECMATE II REGIS INTERPRETER VER 0.25 15-FEB-84 /DECMATE II REGIS INTERPRETER VER 0.24 6-FEB-84 /1. CHANGES TO INCORPORATE THE FIXES TO TEXT COMMAND, WHICH WILL MAKE IT MORE / CLOSELY EMULATE THE VT240. /2. DELETED ADDING 90. TO THE VALUE PASSED BY TEXT ITALIC COMMAND. /3. DELETED CALLS TO THE "SNDESC" ROUTINE. /4. ADDED TEXT COMMAND BLOCK IN PAGE 0. /5. ADDED TABLES TO SUPPORT CHARACTER CELL WIDTH AND HEIGHT. /6. CHANGED THE LOAD CHARACTER ROUTINE TO LOAD 10 BYTES INSTEAD OF 8. /DECMATE II REGIS INTERPRETER VER 0.23 19-JAN-84 /1.MOVE MACROGRAPH CODE INTO TABLE FIELD (5) TO MAKE ROOM FOR NEW CODE TO THE / "TEXT" COMMAND TO REGIS. /DECMATE II REGIS INTERPRETER VER 0.22 13-JAN-84 /1.CHANGE IN CLRTB2 TO PUT "D" AT THE END OF THE TABLE FOR COLOR SELECTION. /DECMATE II REGIS INTERPRETER VER 0.21 15-DEC-83 /1.CHANGED LINE PATTERNS 6 TO 9 TO AGREE WITH THE VT240 IMPLEMENTATION. /2.CHANGED THE WAY S(H) COMMAND IS HANDLED, DOESN'T REQUIRE 2 S(H) COMMANDS NOW. /3.CHANGE IN FL2INT ROUTINE TO CORRECT PROBLEM WHERE CO-ORDS [-1,-1] COULDN'T / BE PASSED TO THE PRIMS. /DECMATE II REGIS INTERPRETER VER 0.20 22-NOV-83 /1.FIXED PROBLEM WITH TEXT COMMAND WHICH WAS NOT RESETING SEMIOK AFTER A QUOTE /ENDING TEXT INPUT. /DECMATE II REGIS INTERPRETER VER 0.17 17-NOV-83 /1.CHANGE AT HLSCLB TO CHECK FOR -41 INSTEAD OF -62 TO FIX COLOR MAP PROBLEM /WITH DECSLIDE. /2.DELETE INITAB. /3.CLEANED UP CODE TO ALWAYS JMP TO LABELS WHEN GOING MORE THAN + OR - 3 WORDS. /DECMATE II REGIS INTERPRETER VER 0.16 15-NOV-83 /1.ADD CODE TO INIT REGIS PROPERLY WHEN ENTERING FROM P1p IN THE MIDST OF A TEXT / OR MACRO-GRAPH COMMAND. /2.ADD CODE TO REQUEST DEVICE PARAMS DURING AN INIT. /3.FIXED PROBLEM WITH REQPOS ROUTINE WHEN IT CONVERTED BETWEEN F.P. -> INTEGER. / /DECMATE II REGIS INTERPRETER VER 0.15 11-NOV-83 / /FIXED HARD COPY FUNCTION TO PRINT ONLY ON SECOND "H" REQUEST. /PARAMETERIZED THE MACRO STORAGE FIELD FOR DEBUG SO THAT THE TERMINAL /EMULATOR WILL WORK PROPERLY. / /DECMATE II REGIS INTERPRETER VER 0.14 10-NOV-83 / /ADDED PIXEL VECTOR MULTPLIER AND CHANGED PV COMMANDS TO USE A PLUSX,MINUSX, /PLUSY, MINUSY RATHER THAN AS IT EXISTED OF ALWAYS ADDING AN PLUS OR MINUS 1. / /REMOVE THE RANGE CHECK ROUTINE BECAUSE IT WAS NOT USED TO MAKE SPACE FOR THE /ABOVE THINGS. / /CHANGED THE FLOATING POINT PACKAGE TO A 3 WORD PACKAGE RATHER THAN /A FOUR WORD PACKAGE. / /DECMATE II REGIS INTERPRETER VER 0.12 2-NOV-83 / 1. INCREASED MACRO GRAPH STORGE TO ALLOW IT TO RUN SPOC PROPERLY /IN ORDER TO DO THIS THE MACRO BUFFER HAD TO BE SHORTENED TO 16 WORDS TO ALLOW /FOR BOTH AN INPUT AND AN OUTPUT BFFER FOR PURGING THE MACRO GRAPH STORAGE. / 2. HLS COLOR MAPPING CODE ADDED. / 3. TABLE ENTRIES MOVED TO FIELD 5. / 4. FIXED A PROBLEM WITH GETCOP WHERE IT WASN'T RETURNING TO THE PROPER / LEVEL WHEN AN ALPHA SPECIFIER WAS USED. / 5. DELETED SOME MORE UNEEDED CODE IN THE FLOATING POINT AREA. / 6. ADDED 'ESCAPE' FLAG TO MARK WHEN ESCAPMENT IS ACTIVE. /DECMATE II REGIS INTERPRETER VER 0.10 26-OCT-83 / / 1. MOVED CODE AROUND TO MAKE PATTERN SPECIFIER FIT. / 2. ADDED PATTERN SPECIFIER TO REGIS. / 3. SCRUNCH MORE CODE. / 4. JMS GETNUM REPLACED BY JMS I XGETNU WHICH RTNS +1 ON ERROR OR +2 ON / VALID INPUT. /DECMATE II REGIS INTERPRETER VER 0.7 25-OCT-83 / 1. ADD CODE TO FIX MACRO-GRAPH PROBLEMS. / 2. DELETE MORE UNNECESSARY CODE TO FREE-UP SPACE FOR EXTRA FUNCTIONS. /DECMATE II REGIS INTERPRETER VER 0.6 21-OCT-83 / 1. DELETED MORE REDUNDENT CODE. / 2. IMPLEMENTED W(F). / 3. CHANGED 5047 TO 5007+RGFLD AND 4074 TO 4070+REGFLD. /DECMATE II REGIS INTERPRETER VER 0.5 21-OCT-83 / 1. ADDED TEXT PIXEL VECTORING. /DECMATE II REGIS INTERPRETER VER 0.4 20-OCT-83 / 1. SHORTENED THE TRANSFER FROM AND TO CP MEMORY. / 2. CORRECTED A PROBLEM IN TEXT AREA IN THAT IS A QUOTE WERE / FOLLOWED BY ANY CHARACTER <40 IT WOULD NOT GET PROCESSED. / ALSO, IF A SEMICOLON WAS THE FIRST CHARACTER AFTER THE QUOTE, / IT WOULD NOT GET DISPLAYED AND RETURN WOULD BE DONE TO MAIN LEVEL. /DECMATE II REGIS INTERPRETER VER 0.3 13-OCT-83 / 1. CRUNCHED THE EQUATES FOR THE PRIMATIVES AND RENAMED TO AGREE WITH / THE NAMING CONVENTIONS USED BY THE PRIMS. /DECMATE II REGIS INTERPRETER VER 0.2 7-OCT-83 / 1. FIX CODE AT SCRADR TO HANDLE NON-PAREN CHARACTER AFTER AN "A". / 2. CHANGE AT GETOP3+4 TO GET CHARACTER FROM LOOK1 INSTEAD OF "CHAR". / 3. CHANGE SHADE COMMAND TO PASS SELECTED CHARACTER, IF ANY, ALONG WITH / THE SHADING REFERENCE LINE. DELETE SHADEC COMMAND (15). / /*************************************************************************** /Basic regis interpretter for the DECmate II /This code is similar to the DECmate II ANSI parser in that it is a /state machine which remains in a particular function until the next /valid sequence is defined. For a more detailed explanation of the functions /supported refer to the ReGIS command summary. / /Entry to this interpretter is done by a JMS 177 to this field with the data /field set to the calling field. The contents of the ac has the following /definition upon entry. / / AC=0 NULL ENTRY. REQUEST FROM TERMINAL EMULATOR / FOR ANY OUTPUT DATA THAT MIGHT BE PENDING. / / AC 101(8)<377(8) GRAPHICS COMMAND TO REGIS / / AC=-1 INITIALIZE THE REGIS INTERPRETTER TO ITS / INITIAL STATE. ALL MACRO GRAPHS ARE CLEARED; / THE CURSOR IS POSTIONED AT HOME (0,0); THE / SELECTED ALPHABET WILL BE 0 (FOR USASCII); TEXT / SIZE WILL BE SET TO 1; DISPLAY REGION WILL / DEFAULT TO THE FULL SCREEN (0,0 TO 799,479); / ALL CURVE FUNCTIONS ARE TERMINATED; ITALIC TO / ZERO IN TEXT; TEXT SPACING FOR TEXT WILL BE 10 / HORIZINTAL WITH A MULTIPLIER OF 1; THE / PERMANENT WRITING OPTIONS WILL BE SET UP AS: / DEFINED BELOW: / / 1. BACKGROUND COLOR WILL BE SET TO BLACK / 2. THE FOREGROUND INTENSITY WILL BE SET TO WHITE; / 3. WRITING MODE WILL BE REPLACE / 4. PIXEL MULTILIER SET TO 1 / 5. NEGATIVE OFF / 6. SHADING OFF / 7. SHADING REFERENCE TO 0,0 (TO X, TO Y TO POINT) / 8. BINARY PATTERN TO 377 (SOLID LINE) / 9. PATTERN MULTIPLIER TO 1 (1 AND 2 ARE SUPPORTED) / 10. PATTERN NUMBER TO 0 FOR SOLID LINE. / 11. AREA TEXTURE (PATTTERN) IS SOLID. / /ALL FLOATING POINT NUMBERS ARE CONVERTED TO INTEGERS WITH NO NORMALIZING DONE. /THE FINAL RESULT IS STORED AS A 36 BIT SIGNED INTEGER AND IS SENT TO THE /TO THE PRIMATIVES IN THE RANGE OF -2048 TO +2047 / R3L= 7014 PR3= 6236 /PRQ 3 DEFINITION /DEBUG=0 /IF IN DEBUG /DFB WPS CHANGE IFDEF DEBUG < MACFLD= 7 /FOR DEBUG ONLY > IFNDEF DEBUG < MACFLD= 4 /FIELD 4 IF THE REAL THING.> MCFLD= MACFLD^10 / REGFLD= 4 /FIELD OF REGIS / PRMFLD= 30 /FIELD OF PRIMATIVES PRIMS=200 /ADDRESS OF PRIMATIVES / RGFLD=REGFLD^10 / TABFLD= 5 /FIELD OF TABLES, BUFFERS AND MACROGRAPH CODE / TBLFLD= TABFLD^10 /FOR CDF STUFF. / TABADD= 200 /STARTING ADDRESS OF TABLES AND BUFFERS. FIELD REGFLD /ESTABLISH *5 /FLOATING POINT ROUTINE POINTERS FPINP= JMS I . FLINTP /FLOATING POINT INPUT ROUTINES /FPOUT= JMS I . / FLOUTP /FLOATING POINT OUTPUT ROUTINES FPINT= JMS I . FPNT /FLOATING POINT INTERPRETTER /EQUATES / DECIMAL PWRUP= 0 /POWER-UP CLEAR POSTN1= 1 /POSTION CURSOR SVTMPW= 2 /SAVE TEMPORARY WRITE OPTIONS RSTMPW= 3 /RESTORE TEMPORARY WRITE OPTIONS GETVEC= 4 /DRAW A VECTOR GTNEGM= 5 /DISABLE/ENABLE NEGATE MODE SCRNER= 6 /SCREEN ERASE - FILL CLIPPING REGION WITH SPEC. COLOR GETDRG= 7 /SET DISPLAY REGION GTBGRD= 8 /SET BACKGROUND COLOR GTFGRD= 9 /SET FOREGROUND COLOR GTWRTM= 10 /SET WRITING MODE GTLTXT= 11 /SET LINE TEXTURE GTSHDY= 12 /SHADING ON GTSHDO= 13 /SHADING OFF SCRDMP= 14 /SCREEN SIXEL DUMP DRWARC= 15 /DRAW A CIRCLE CRVBGN= 16 /CURVE BEGIN OPEN CRVCLS= 17 /CURVE BEGIN CLOSED CRVCNT= 18 /CURVE CONTINUE CRVEND= 19 /CURVE END GTPLNS= 20 /PLANE SELECT MASK WORD GETTXT= 21 /DRAW A GRAPHIC CHARACTER GTCESC= 22 /CHANGE TEXT ESCAPMENT GTCSIZ= 23 /CELL STORAGE SIZE GTCELM= 24 /CELL DISPLAY SIZE GTCROT= 25 /CELL ROTATION ANGLE GTCITL= 26 /CELL ITALIC GTCSET= 27 /SET ALPHABET GTCBMP= 28 /LOAD CHARACTER BITMAP INIT= 29 /POWER UP FROM DEAD SPACE SVTXTO= 30 /SAVE TEXT OPTION RSTXTO= 31 /RESTORE TEXT OPTION RETPOS= 32 /RETURN CO-ORDINATES OF CURSOR POSITION TRMNTE= 33 /TERMINATE GRAPHICS SETUP= 34 /SETUP DMYSUB= 35 /NOT DEFINED GTLMLT= 36 /SET LINE PATTERN MULTIPLIER RETREG= 37 /RETURN LOGICAL SCREEN REGION GTTXTR= 38 /SPECIFY_STARTING_POSTION_OF_TEXT_STRING RSTCUR= 39 /RESTORE CURSOR AT END OF TEXT TPVCMD= 40 /TEXT PIXEL VECTOR COMMAND GTXSET= 42 /TEXT SETUP COMMAND OCTAL *20 CURLEV, 0 RDF TAD KCIF CDF RGFLD DCA I XMAINL /SAVE IN MAINLINE NEXT /EXIT WITH NEXT ENTRY SET UP TO PARSER. NEXT= JMP I . REGRET /EXIT THE CURRENT LEVEL WITHOUT /RESTORING FINI= JMP I . /EXIT BACK TO MAIN LINE INTERPRETTER AS A COMMAND REGIS4 /WAS SEEN AT A TOP LEVEL FUNCTION WHICH COULD /POSSIBLY BE A NEW COMMAND. / /NUMERICAL CONSTANTS / K27, 27 M32, -32 M40, -40 M100, -100 M101, -101 XMAINL, MAINLI KCIF, CIF /ADDRESSES 40-62 ARE RESERVED FOR THE FLOATING POINT PACKAGE / *40 EX1, 0 HIGH1, 0 LOW1, 0 EXP, 0 HORDER, 0 LORDER, 0 OVER2, 0 OVER1, 0 / *62 FLAG, 0 /ARITHMETIC ERROR FLAG / / *63 DIGIT, 0 /STORAGE FOR DIGIT (FP ROUTINES) SIGN, 0 /=0 IF PLUS; = 7777 IF MINUS DNUMBR, 0 /= NUMBER OF DIGITS CURX, ZBLOCK 3 /CURRENT X POSITION(FP NOTATION) CURY, ZBLOCK 3 /CURRENT Y POSITION(FP NOTATION) CURACT, CURVEF, 0 /CURVE FUNCT NOT IN PROGRESS (CURVE TERMINATED) /CURVE ACTIVE FLAG. 0 SAYS NO CURVE IN PROGRESS /AND 3 IF CURVE ACTIVE. (USED TO CALCUALTE PRIM /CALL) / /PERMANENT WRITING OPTIONS / BCOLR, 0 /BACK GROUND COLOR TO BLACK FCOLR, 17 /FORGROUND TO BRIGHT WHITE PMULT, 1; 2000; 0 /CONVERTED TO FLOATING POINT SHADE, 0 /SHADING OFF PATTRN, 377 /BINARY PATTERN (377 BY DEFAULT) PATMUL, 2 /PATTERN MULTIPLIER TO 1 (MAX OF 2) / MLBRKT, -"[+200 /SEVEN BIT CODE FOR "[" MRBRKT, -"]+200 /SEVEN BIT FOR "]" MSEMI, -";+200 /SEVEN BIT FOR ";" MCOMMA, -",+200 /SEVEN BIT FOR "'" MLPREN, -"(+200 /SEVEN BIT FOR "(" MRPREN, -")+200 /SEVEN BIT FOR ")" MSGLQU, -"'+200 /SEVEN BIT FOR "'" MDBLQU, -""+200 /SEVEN BIT FOR '"' /MISC STORAGE ABSFLG, 0 /ABSOLUTE OR RELATIVE FLAG FOR INCOMING NUMERIC /DATA. CIRCUM, 0 /0 SAYS END POINT IS IN THE CENTER /NON-ZERO IS ON THE CIRCUMFERENCE NUMMER, ZBLOCK 3 REPLY, 0 /RESPONSE TO CALLER SEMIOK, 0 /-1 = OK TO PASS SEMICOLON, SPACE, AND CONTROLS /+1 = SEMI'S AND SPACES OK, NO CONTROLS / 0 = NO SEMI'S, SPACES OR CONTROLS TEMP1, 0 TEMP1A, 0 TEMP2, 0 TEMP2A, 0 /HLS CONSTANTS LIGNUM, 0 /LIGHTNESS VALUE SATNUM, 0 /SATURATION HUENUM, 0 /HUE VALUE HLSSEE, 0 /INDICATOR COLSEE, 0 SAVCLR, 0 / XLOOKU, LOOKUP XPRIMS, PRIMS XGETNU, GETNUM XUPPER, UPPER UPPETM, 0 TXTCHR, 0 /FIRST CHARACTER FROM 'GTRUN' TOPBY, 0 TOPBX, 0 / TEXT SETUP PARAMETER BLOCK / TXTBLK, GTXSET /TEXT SETUP COMMAND TDISPL, 0 /DISPLAY ALPHABET TCHRAN, 0 /TEXT CHARACTER ANGLE TCELLH, 24 /TEXT CELL HEIGHT TCELLW, 11 /TEXT CELL WIDTH TUNITH, 24 /TEXT UNIT HEIGHT TUNITW, 10 /TEXT UNIT WIDTH TITLAN, 0 /TEXT ITALIC ANGLE TXFLAG, 0001 /TEXT FLAG FOR BASELINE ANGLE / 0001 = NO CHANGE / 0000 = BASELINE / 7777 = ABSOLUTE ESCAPEMENT TBASES, 0 /TEXT BASELINE OR 'X' ESCAPEMENT TYESCP, 0 /TEXT 'Y' ESCAPEMENT TCHNGE, 0 /TEXT CHANGE FLAG FOR TEXT BEGIN/END LOACTV, 0 /FLAG TO KEEP TRACK OF "@" SIGNS / TEMPO, ZBLOCK 4 / / *176 /*** FIXED ADDRESS **** VERS, REV /COUNT WILL BE IN OCTAL / *177 /BEGINNING OF REGIS REGIS, 0 DCA CHAR /SAVE THE AC AS IT CONTAINS WHAT TO DO DCA REPLY /ENSURE NO REPSONSE RDF /GET THE CALLING DATA FIELD TAD (CIF CDF /MAKE IT A RETURN FIELD DCA REGRT2 /SET UP THE RETURN ADDRESS CIF CDF RGFLD /SET TO REGIS FIELD TAD CHAR /GET THE CURRENT OPERATION SMA CLA /SKIP IF SPECIAL CONTROL CODE JMP REGIS1 /ON TO THE NORMAL REGIS PROCESSING ISZ CHAR /CHECK IF -1(INIT) JMP REGI2B /NO, ASSUME -2 (FORGET MAIN COMMAND) CIF TBLFLD /CHANGE TO FIELD THAT CONTAINS THIS ROUTINE JMS I XCLRGR /AND GO INIT MACRO-GRAPHS // JMS INIMAP /INIT COLOR MAP JMS GTCORD /GET THE PHYSICAL SCREEN COORDINATES. JMS REQPOS /GET CURRENT POSITION DATA DCA LOACTV /INIT LOAD ACTIVE REGRET, CLA CLL TAD REPLY /PASS RESPONSE BACK TO CALLER IN THE AC REGRT2, HLT /MODIFIED TO CIF CDF CALLING FIELD JMP I REGIS /THE AC MAY CONTAIN DATA SO DON'T CLEAR IT OUT REGIS1, TAD CHAR SZA /SKIP IF CHECK FOR OUTPUT JMP REGIS2 /GO PROCESS A REGIS COMMAND JMP REGRET /EXIT WITH PROPER CHARACTER IN THE AC XCLRGR, CLRGRP /POINTER FOR CROSS FIELD CALL / /MAIN LEVEL OF REGIS INTERPRETTER. /AT THIS LEVEL OF PROCESSING THE FOLLOWING COMMANDS ARE LOOKED AT: / P = POSITION COMMAND / V = VECTOR COMMAND / C = CURVE COMMAND / T = TEXT COMMAND / W = PERMANENT WRITING OPTION / S = SCREEN COMMAND / @ = MACROGRAPH COMMAND / R = REPORT COMMAND / L = LOAD CHARACTER COMMAND REGIS2, JMS MAKE7 /CONVERT TO 7 BIT FOR NOW DCA MANTMP /SAVE THE CHARACTER TO PROCESS. REGIAT, TAD LOACTV /SEE IF "LOAD" COMMAND SZA CLA JMP REGI2T JMS CHKMAC /TEST FOR MACRO-GRAPH ARGUMENTS SNA CLA JMP REGIS4 REGI2T, TAD SEMIOK /CHECK IF SEMI TO BE PASSED ON SZA JMP REGI2A /YES, SKIP CHECK TO ABORT TAD MSEMI /TEXT FOR ";" TAD CHAR /GET CHARACTER SZA CLA /SKIP IF IT IS A SEMI JMP REGI2A REGI2B, DCA CURLEV /RETURN TO HIGHEST COMMAND LEVEL DCA CURACT /RESET CURVE ACTIVE // DCA STKPNT /INITIALIZE THE STACK FOR POSITION AND VECTOR JMS CLEANU /GO CLEANUP ANY PENDING TEXT OR MARCO'S JMS RESWOP /RESTORE THE PERMANENT OPTIONS SAVED. IF ANY. NEXT //REGI2E, SPA CLA /POSITIVE MEANS TEXT LOAD IS ACTIVE // JMP REGI2A // JMS CHKMAC /TEST FOR MACRO GRAPH ARGUMENTS // SNA CLA /SKIPS IF NOT A MACRO GRAPH FUNCTION // JMP REGIS4 /GO CLEAR CURRENT LEVEL REGI2A, TAD SEMIOK /ARE SPACES OK? SZA CLA JMP REGI2D /SPACE NOT IGNORED TAD CHAR TAD M40 SNA CLA NEXT /AHA, IGNORE THIS SPACE REGI2D, TAD SEMIOK /ARE CONTROLS OK? SPA CLA JMP REGI2C TAD CHAR /CONTROLS NOT OK TAD M40 SPA CLA NEXT /AHA!, IGNORE THIS CONTROL REGI2C, TAD CURLEV /TEST TO SEE IF A REGIS COMMAND IS IN PROCESS SNA CLA /SKIP IF YES /AND PROCESS ACCORDINGLY. JMP REGIS3 TAD CHAR /GET THE CURRENT CHARACTER MAINLI, HLT JMP I CURLEV /DISPATCH TO CURRENT ACTIVE LEVEL REGIS3, JMS I XLOOKU /DO THE LOOKUP MANTMP, 0 /CHARACTER TO DO MCMD /MAIN COMMAND LINES NEXT /INVALID MAINLINE COMMAND DCA CURLEV /SAVE THE CURRENT LEVEL OF PROCESSING JMS I CURLEV /ESTABLISH RETURN FROM NEXT LOWER LEVEL AND START /THE COMMAND TO PERFORM REGIS4, CLA DCA CURLEV /MARK COMMAND AS COMPLETED. TAD CHAR SNA /SKIP IF COMMAND IS ACTIVE NEXT /NO COMMAND FROM THE PREVIOUS LEVEL THERE JMP REGIS2 /GO BACK AND START NEXT COMMAND CYCLE / /ROUTINE TO CAUSE THE TEMP WRITE OPTIONS TO BE SAVED. / TMPOPT, 0 TAD (SAVOPT /SAVE OPTION BLOCK CIF PRMFLD /CALL THE PRIMATIVES JMS I XPRIMS /CALL THE PRIMATIVES STA DCA WTMOPT /MARK TEMP WRITE OPTIONS AS ACTIVE TAD PMULT /SAVE THE CURRENT PIXEL MULTIPLIER DCA PMULT1 JMS WRITE ISZ TMPOPT /BUMP RETURN OVER ACTION ROUTINE JMP I TMPOPT /EXIT BACK TO CALLER. / /RESTORE THE PERMANENT WRITE OPTIONS / RESWOP, 0 TAD WTMOPT /SEE IF TEMP OPTIONS ACTIVE SNA CLA JMP RESWO1 TAD (RESOPT /RESTORE BLOCK CIF PRMFLD JMS I XPRIMS TAD PMULT1 DCA PMULT /RESTORE THE PIXEL MULTIPLIER RESWO1, DCA WTMOPT /CLEAR INDICATOR JMP I RESWOP RESOPT, RSTMPW /RESTORE TEMP WRITE OPTIONS SAVOPT, SVTMPW /SAVE " " " PMULT1, 0 WTMOPT, 0 DXR, ZBLOCK 3 DYR, ZBLOCK 3 PAGE / /POSITION COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / POSIT, 0 POSIT1, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. / DCA POSCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP POSCMD, 0 POSTAB /1ST LEVEL OPTION TABLE JMP PCMDER /GO HERE ON ERROR DCA POSCMD /SAVE THE POINTER HERE ON RETURNING JMS I POSCMD /AND DISPATCH TO POINTER ADDRESS / SKP CLA JMS DOPOS /CALL THE PRIMS JMP POSIT1 /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / /COMMOM EXIT FOR VECTOR AND POSITION / VCMDER, PCMDER, JMS RESWOP FINI /FOR NOW GO BACK TO MAIN LEVEL / POPT, 0 /COME HERE AFTER FINDING A LEFT PAREN / POPT1, JMS CURLEV / POPT3, DCA POPT2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP POPT2, 0 POPTBL /2ND LEVEL TABLE FOR POSTION JMP POPT1 /NOT FOUND, GET ANOTHER DCA POPT2 /ELSE SAVE THE POINTER JMS I POPT2 /AND DISPATCH TO POINTER ADDRESS / JMS DOPOS /EXECUTE THE PRIMS / /RETURN HERE ON W,B,E OPTIONS / SNA JMP POPT1 /GET ANOTHER CHARACTER JMP POPT3 / POSITX, 0 JMP I POPT / /DOPOS - EXECUTE THE POSITION COMMAND BY CALLING THE PRIMATIVE PACKAGE / DOPOS, 0 JMS SCAL /GO TO SCALE ROUTINE TAD DXI+2 /GET THE CURRENT X POSTITION DCA MBX /CURRENT X VALUE TAD DYI+2 /Y POSITION DCA MBY CIF PRMFLD TAD (POSBLK /POSITION BLOCK DATA JMS I XPRIMS /TO THE PRIMATIVES JMP I DOPOS / /PBKT - POSITION BRACKET ROUTINE TO HANDLE GETTING AND EXECUTION OF A POSITION / COMMAND. / PBKT, 0 /COME HERE AFTER FINDING A LEFT BRACKET "[" CLA JMS BKTPAR /GET THE NEW POSITION ARGUMENTS POSX /AND SAVE THEM HERE POSY / JMS PVGEN /SEE IF RELATIVE OR ABSOLUTE / ISZ PBKT /BUMP THE RETURN (NEEDED FOR STACK COMMANDS TO / WORK CORRECTLY) JMP I PBKT /AND RETURN POSBLK, POSTN1 /POSITION COMMAND MBX, 0 MBY, 0 VECBLK, GETVEC /VECTOR COMMAND VBX, 0 VBY, 0 / /PVGEN - ROUTINE TO HANDLE GETTING POSITION AND VECTOR NUMERICS / PVGEN, 0 CLA TAD POSX /SEE IF RELATIVE OR ABSOLUTE SNA CLA /SKIP IF RELATIVE JMP GENPX /MOVE NEW VALUE OF X TO PLACE OF USE FPINT /CALL THE FP INTERPRETTER FGET CURX /CURRENT VALUE TO FAC FADD POSX+1 /ADD IT TO EXISTING VALUE FPUT POSX+1 /AND RETURN IT TO NEW VALUES FEXT GENPX, FPINT /CALL THE FP INTERPRETTER FGET POSX+1 FPUT CURX /STORE THE NEW VALUE OF X FEXT /EXIT FLOATING POINT / /NOW SETUP THE NEW VALUE OF Y / TAD POSY /SEE IF RELATIVE OR ABSOLUTE SNA CLA /SKIP IF RELATIVE JMP GENPY /MOVE NEW VALUE OF Y TO PLACE OF USE FPINT /CALL THE FP INTERPRETTER FGET CURY /CURRENT VALUE TO FAC FADD POSY+1 /ADD IT TO THE CURRENT VALUE FPUT POSY+1 /AND RETURN IT TO NEW VALUES FEXT GENPY, FPINT /CALL THE FP INTERPRETTER FGET POSY+1 FPUT CURY /STORE THE NEW VALUE OF Y FEXT /EXIT FLOATING POINT JMP I PVGEN /RETURN / /LPRUN - LEFT PAREN RUN DOWN / COME HERE TO RUN DOWN MATCHING LEFT AND RIGHT PARENS. / / LPRUTM, 0 LPRUN, 0 STA /MARK AS 1 LEFT PAREN DCA LPRUTM /AND SAVE HERE JMS CURLEV /ESTABLISH THIS LEVEL TAD MRPREN /SEE IF IT'S A RIGHT PAREN SZA CLA /SKIP IF IT IS JMP LPRUN5 /ELSE GO HERE ISZ LPRUTM /INCRMENT THE COUNTER NEXT /AND GET ANOTHER CHARACTER JMP I LPRUN /WHEN COUNT = 0 WE'RE DONE LPRUN5, TAD CHAR /GET THE CHARACTER TAD MLPREN /IS IT A LEFT PAREN SZA CLA /SKIP IF YES NEXT /NO, CHECK NEXT CHARACTER STA /ADD -1 TO THE COUNT TAD LPRUTM /ADD TO CURRENT COUNT DCA LPRUTM /SAVE IT NEXT /THEN GET NEXT CHARACTER K360, 11 2640 0 0 / /WOPR - WRITE OPTION REPLACE ROUTINE / WOPR, 0 CLL CLA IAC /MAKE A 1 DCA SETWR+1 /SAVE IT JMS SETWRT /SEND THE CMD TO THE TERM JMP I WOPR / /ROUTINE TO GET UNUSED ARGUMENTS AFTER A "[" / NULBKT, 0 JMS BKTPAR NULLXY NULLXY JMP I NULBKT PAGE / /VECTOR COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / VECTOR, 0 VECTO1, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA VECCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP VECCMD, 0 VECTAB /1ST LEVEL OPTION TABLE JMP VCMDER /GO HERE ON ERROR DCA VECCMD /SAVE THE POINTER HERE ON RETURNING JMS I VECCMD /AND DISPATCH TO POINTER ADDRESS / SKP CLA JMS DOVEC /CALL THE PRIMS JMP VECTO1 /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / /VCMDER MADE A COMMON EXIT WITH PCMDER / VOPT, 0 /COME HERE AFTER FINDING A LEFT PAREN / VOPT1, JMS CURLEV / VOPT3, DCA VOPT2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP VOPT2, 0 VOPTBL /2ND LEVEL TABLE FOR POSTION JMP VOPT1 /NOT FOUND, GET ANOTHER DCA VOPT2 /ELSE SAVE THE POINTER JMS I VOPT2 /AND DISPATCH TO POINTER ADDRESS / JMS DOVEC /EXECUTE THE PRIMS / /COME HERE ON A W,B, OR S OPTION / SNA JMP VOPT1 /GET ANOTHER CHARACTER JMP VOPT3 / VECTOX, 0 JMP I VOPT / / /CURVE COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / CURVE, 0 DCA CIRCUM /INIT THIS FLAG TO ZERO TAD (550 /SET UP CIRCLE DEFAULT ARC VALUE OF 360 DEGREES DCA CIRBLK+3 CURVE1, JMS CURLEV /**ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA CURCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP CURCMD, 0 CURTAB /1ST LEVEL OPTION TABLE JMP CCMDER /GO HERE ON ERROR DCA CURCMD /SAVE THE POINTER HERE ON RETURNING JMS I CURCMD /AND DISPATCH TO POINTER ADDRESS / JMP CURVE1 /**GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / CCMDER, DCA CURACT /CLEAR CURVE ACTIVE IN CASE JMS RESWOP /RESTORE TEMP WRITE OPTIONS FINI /GO BACK TO MAIN LEVEL / COPT, 0 /COME HERE AFTER FINDING A LEFT PAREN / COPT1, JMS CURLEV / COPT1A, DCA COPT2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP COPT2, 0 COPTBL /2ND LEVEL TABLE FOR CURVE JMP COPT1 /NOT FOUND, GO SEE IF A NEW COMMAND DCA COPT2 /ELSE SAVE THE POINTER JMS I COPT2 /AND DISPATCH TO POINTER ADDRESS NOP /REQUIRED - SNA /**SKIP IF SUBOPTION RETURNED FROM PREVIOUS LEVEL JMP COPT1 /GET ANOTHER CHARACTER JMP COPT1A /TRY NEXT SUBOPTION. CURVEX, 0 JMP I COPT /RETURN / /AN OPEN BRACKET WAS SEEN AS THE INTRODUCER. THIS SAYS A CIRCLE IS TO BE /DRAWN WITH A GIVEN CENTER WITH THE EXIT POINT IN THE CENTER. / CURBKT, 0 JMS SAVCUR /SAVE CURRENT POINT AS IT MAY BE USED LATER JMS SCAL /ENSURE PROPER SCALING JMS CIRSET /DO CIRCLE (SETUP CODE) JMS PBKT /ACCEPT A BRACKETED PAIR NOP /NEEDED BECAUSE PBKT NORMALLY RTN'S +2 TAD CURACT /SEE IF A BOUNDED CURVE IS IN PROGRSS SZA CLA /SKIP IF NOT JMP CURBK1 /GO DO SOME SPECIAL STUF FOR THE CURVE TAD CIRCUM /IF ZERO THE CENTER IS SPECIFIED. NEED TO /REPOSITION TO CIRCUMFERENCE SZA CLA /RESTORE TO BEGINNING POINT JMP .+3 JMS DOPOS /DO A POSITION TO GET TO EDGE OF CIRCLE JMP .+3 CURBK1, JMS SCAL JMS CIRSET TAD CURACT /MAKE THE COMMAND FOR THE PRIMATIVES. TAD (DRWARC /NORMAL ARC COMMAND DCA CIRBLK /SAVE IT IN THE COMMAND BLOCK. CIF PRMFLD TAD (CIRBLK /CURVE BLOCK DATA JMS I XPRIMS /TO THE PRIMATIVES TAD CURACT /IF CURVE ACTIVE THEN DON'T RESTORE THE POINT SZA CLA JMP CURBK2 TAD CIRCUM /SEE IF A CIRCLE OR ARC SZA CLA JMP CURBK3 /GO HERE IF AN ARC, ELSE JMS RESCUR /RESTORE CURRENT POINT. JMS DOPOS /AND REPOSITION TO THE CENTER OF THE CIRCLE CURBK2, DCA CIRCUM /CLEAR THE FLAG CURBEX, JMP I CURBKT /EXIT / CURBK3, JMS REQPOS /REQUEST POSITION INFO FROM THE PRIMS JMP CURBEX / /GETNUM - ROUTINE TO GET A NUMERICAL INPUT STREAM / IF NUMERICAL INPUT, EXIT WITH AN INTEGER IN LOCATION "NUMBER" / AND EXIT CALL +2 / IF NO CONVERSION THEN EXIT CALL +1. GETNUM, 0 FPINP /GET DATA TAD DSWIT /ANY CONVERSION ? SNA CLA JMP I GETNUM /NO, TAKE THE ERROR EXIT. FPINT /ELSE, GET THE VALUE FPUT NUMMER /SAVE IT FEXT /EXIT FP JMS FL2INT /CONVERT TO INTEGER NUMMER ISZ GETNUM JMP I GETNUM /RETURN / /SOPT - SCREEN OPTION TIMER / GET THE NUMBER OF CLOCK TICKS / SOPT, 0 JMS I XGETNU /GET THE INPUT JMP SOPTEX /NON-NUMERIC SO EXIT TAD NUMMER+2 /GET THE INTEGER DCA TICKS+1 /SAVE IN CONTROL BLOCK SOPTEX, TAD CHAR /GET THE CHAR THAT TERMINATED INPUT JMP I SOPT /AND RETURN / TICKS, 7776 0 /STORAGE FOR THE TIMER VALUE PAGE / /PIXEL POSITION COMMANDS /THESE ROUTINES ARE ALSO USED IN PROCESSING THE VECTOR COMMAND /PV0 MOVED TO MAKE ROOM FOR PATTERN INPUT. / GETPT4, PV1, 0 JMS MOVEP PLUSX /NEW VALUE OF X MINUSY /NEW VALUE OF Y / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV1 JMP I PV1 /EXIT GETPT5, PV2, 0 JMS MOVEP ZERO MINUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV2 JMP I PV2 GETPT3, PV3, 0 JMS MOVEP MINUSX MINUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV3 JMP I PV3 GETPT1, /USED AS A TEMP FOR PATTERN INPUT PV4, 0 JMS MOVEP MINUSX ZERO / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV4 JMP I PV4 GETPT2, /USED AS A TEMP FOR PATTERN INPUT PV5, 0 JMS MOVEP MINUSX PLUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV5 JMP I PV5 / /GET PATTERN ROUTINE /INPUTS EITHER A PATTERN BY NUMBER OF BY BINARY VALUE. / GETPAT, 0 TAD PATTRN /SAVE THE CURRENT PATTERN SO IT DOES NOT GET /DESTROYED IN THE PROCESS. DCA GETPT1 GETPTA, DCA GETPT2 /INIT THE CHARACTER COUNTER GETPTB, JMS GETDIG /GET A CHARACTER JMP GETPTC /INVALID CHARACTER DCA GETPT3 /SAVE THE NUMBER. STA /FIRST LOOK FOR 0 OR 1 TAD GETPT3 /ADD BACK IN WHAT WAS RECEIVED SMA SZA CLA /SKIP IF EITHER ZERO OR 1 JMP GETPTD /NOT ZERO OR ONE. MUST BE SOMETHING GREATER. /USE IT AS A PATTERN NUMBER. TAD GETPT2 /GET BACK THE VALUE SNA CLA /SKIP IF NO INIT NEEDED. DCA GETPT1 /INIT THE PATTERN TAD GETPT1 /GET THE CURRENT PATTERN CLL RAL /SETUP TO ADD IN CURRENT BIT PATTERN TAD GETPT3 /CURRENT PATTERN. DCA GETPT1 /AND SAVE IT ISZ GETPT2 /UPDATE THE COUNTER JMP GETPTB /AND TRY ANOTHER. GETPTD, TAD GETPT3 DCA GETPT1 /MAKE THE PATTERN NUMBER CLL CLA IAC /AC=1 TO INDICATE NUMBER OF CHARACTERS ALLOWED. JMP GETPTA /AND SAVE IT AND RTY AGAIN. / /AT THIS POINT A NON-NUMERIC VALUE WAS SEEN. TERMINATE THE FUNCTION AND EXIT. / GETPTC, CLL CLA /BECAUSE THE AC IS GUARENTEED NOT TO BE CLEAR. TAD GETPT2 /FIRST SEE IF ANYTHING WAS SENT IN. SZA CLA /SKIP IF NOT JMP GETPTE /ESTABLISH THE NEW PATTERN TAD PATTRN /JUST RETURN THE PATTERN JMP I GETPAT /AND EXIT. GETPTE, STA /DETERMINE NUMBER OF DIGITS SENT DOWN TAD GETPT2 /IF ONE THEN USE IT AS A PATTERN NUMBER SPECIFOMIER SZA CLA /SKIP IF SPECIFIED BY PATTERN NUMBER. JMP GETPTF /BINARY PATTERN. GO DO THE JUSTIFICATION ON IT TAD GETPT1 /CONTAINS A PATTERN NUMBER RATHER THAN A PATTERN SPA /NEED TO ADJUST IT IF A BINARY 1 CLL CLA IAC /MAKE A 1 TAD (PATTAB-1 /OFFSET INTO PATTERN DCA 10 TAD I 10 JMP I GETPAT /EXIT WITH PATTERN IN THE AC. GETPTF, TAD GETPT2 /TRUNCATE BIT COUNT TO EIGHT TAD (-0010 SMA /NO CHANGE IF LESS THAN EIGHT CLA /FORCE TO EIGHT IF GREATER THAN EIGHT TAD (0010 /RESTORE BIT COUNT DCA GETPT2 / TAD GETPT2 /SHIFT PATTERN TO LEFT JUSTIFY IN 12-BIT WORD TAD (-0014 DCA GETPT3 /NUMBER BITS TO SHIFT = 12. - WHAT WE HAVE / TAD GETPT1 /GET PATTERN AS ENTERED GETPTG, CLL RAL /SHIFT ONE ISZ GETPT3 /LOOP UNTIL LEFT JUSTIFIED JMP GETPTG DCA GETPT1 /SAVE SHIFTED PATTERN / TAD (-0010 /SET UP TO SHIFT EIGHT TIMES TO CREATE REAL DCA GETPT3 / PATTERN (MAY REPEAT ENTERED PATTERN) / DCA GETPT5 /CLEAR 'NEW' PATTERN BEFORE SHIFTING INTO IT / GETPTH, TAD GETPT2 /GET SIZE OF ENTERED PATTERN CIA DCA GETPT6 /FOR LOOP CONTROL / TAD GETPT1 /GET ENTERED PATTERN DCA GETPT4 / AS WORKING SHIFT-OUT PATTERN / GETPTI, TAD GETPT4 /GET WORKING SHIFT-OUT PETTERN CLL RAL /PUT LEFT BIT INTO LINK DCA GETPT4 /SAVE SHIFTED PATTERN TAD GETPT5 /GET WORKING SHIFT-IN PATTERN RAL /SHIFT LINK INTO IT ISZ GETPT3 /CHECK IF DONE EIGHT BITS JMP GETPTJ /NOT YET, KEEP GOING JMP GETPTK /YES, GO RETURN WITH NEW PATTERN GETPTJ, DCA GETPT5 /SAVE WORKING SHIFT-IN PATTERN / ISZ GETPT6 /CHECK IF NEED TO REPEAT ENTERED PATTERN JMP GETPTI /NO, SHIFT WHAT WE HAVE JMP GETPTH /YES, GO REESTABLISH ENTERED PATTERN / GETPTK, JMP I GETPAT /RETURN WITH PATTERN IN AC / / GETPT6, 0 / PAGE / /SOPA - SCREEN ADDRESS ROUTINE /COME HERE FROM A SCREEN ADDRESS COMMAND / SOPA, 0 JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. TAD MLBRKT /SEE IF IT IS AN OPENING BRACKET "[" SZA CLA /SKIP IF YES JMP SOP1A /INVALID CHARACTER SEEN. RETURN TO PREVIOUS LEVEL JMS BKTPAR /INPUT A BRACKETED PAIR OF DATA TEMPX / INTO TEMPORARY STORAGE TEMPY JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. TAD MLBRKT /SEE IF IT IS AN OPENING BRACKET "[" SZA CLA /SKIP IF YES JMP SOP1A /ERROR. INVALID CHARACTER IN THE SEQUENCE JMS BKTPAR /INPUT A BRACKETED PAIR OF DATA SCRBX /STORAGE FOR THE PARAMETERS FROM THE INPUT SCRBY / TAD (TEMPX-1 /HAVE BOTH PAIRS, MOVE FIRST TEMP DATA TO REAL DCA 10 TAD (SCRTX-1 DCA 11 TAD (-10 DCA SOPATM SOP2A, TAD I 10 /GET A WORD FROM TEMPORARY DCA I 11 / AND PUT INTO REAL STORAGE ISZ SOPATM /LOOP THROUGH DATA UNTIL DONE JMP SOP2A / /CLEAR OUT THE WORDS AT TX, TY, BX, BY JMS CLTXTY JMS GTCORD /GET THE PHYSICAL COORDINATES JMS SCALER /GO DO THE SCALING CALCULATIONS JMS REQPOS /GET THE CURRENT ABSOLUTE POSITION AND /CONVERT TO THE CURRENT USER COORDINATES / JMS SETCLP /NOW DO THE CLIPPING CALCULATIONS / /SEND THE CLIPPING INFORMATION TO THE PRIMATIVES JMS GENOFF /GO GENERATE THE PV OFFSETS CIF PRMFLD TAD (TSETDR /SET ADDRESS DATA JMS I XPRIMS /TO THE PRIMATIVES JMS DOPOS /REPOSITION TO WHERE THE USER WAS /PREVIOUS TO SCALING. SKP /ALL IS WELL HERE SOP1A, TAD CHAR /RETURN THE CHARACTER. ERROR ON INPUT. JMP I SOPA /EXIT / SOPATM, 0 /LOCAL COUNTER FOR LOOP CONTROL GTCORD, 0 /REQUEST THE PHSICAL PARAMS CIF PRMFLD TAD (RQTBLK JMS I XPRIMS /TO THE PRIMATIVES /SAVE THE INTEGERS RETURNED BY THE PRIMS INTO AREAS USED BY THE SCALER TAD RQTBLK+1 DCA TX+2 TAD RQTBLK+2 DCA TY+2 TAD RQTBLK+3 DCA BX+2 TAD RQTBLK+4 DCA BY+2 /CONVERT TO FLOATING POINT JMS INT2FL TX JMS INT2FL TY JMS INT2FL BX JMS INT2FL BY / JMP I GTCORD / /TOP OF SCREEN / TX, 0 /SCREEN SIZE 0,0 TO 799,479 (THIS WILL REQUIRE /FOUR WORDS OF STORAGE FOR EACH POINT. IT WILL /BE STORED IN FLOATING POINT VALUES AND CONVERTED /TO THE PROPER SCALING COORDINATES. THE DATA IS /STORED IN THE FOLLOWING FORMAT: /WORD 0 = EXPONENT /WORD 1 = HIGH ORDER MANTISSA /WORD 2 = LOW ORDER MANTISSA) 0 /THE INTIAL VALUES MAY CHANGE 0 /X=0 TY, 0 0 0 /Y=0 / /LOWER RIGHT CORNER / BX, 12 /X=799 3076 0 BY, 11 3574 0 /Y=479 / SCRTX, ZBLOCK 4 /REGIS INPUT FOR SCREEN ADDRESS SETUP SCRTY, ZBLOCK 4 /(MUST BE TOGETHER AND IN ORDER) SCRBX, 0; 12; 3076; 0 / = 799 DECIMAL(1437 OCTAL) SCRBY, 0; 11; 3574; 0 / = 479 DECIMAL(737 OCTAL) / TEMPX, ZBLOCK 4 /TEMPORARY STORAGE FOR UPPER LEFT SCREEN ADDRESS TEMPY, ZBLOCK 4 / TSETDR, GETDRG /SET DISPLAY REGION TSETTX, 0 TSETTY, 0 TSETBX, 0 TSETBY, 0 / RQTBLK, RETREG /REQUEST PHYS SCREEN PARAMS 0 /DEFAULT IMPLEMENTATION FOR SCREEN 0 1437 /799 DECIMAL 737 /479 DECIMAL PAGE / /TEXT COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN, AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / / RTEXT, 0 RTEXT1, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. RETYP, DCA RTXCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP RTXCMD, 0 TXTTAB /1ST LEVEL OPTION TABLE JMP RTXERR /GO HERE ON ERROR DCA RTXCMD /SAVE THE POINTER HERE ON RETURNING JMS I RTXCMD /AND DISPATCH TO POINTER ADDRESS SNA JMP RTEXT1 /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL JMP RETYP / RTXERR, JMS RESWOP /RESTORE PERMANENT WRITE OPTIONS SAVEED IF ANY DCA SEMIOK /TERMINATE THE TEXT FUNCTION DCA TYTETM /INIT THE TEXT QUOTE FLAG FINI /GO BACK TO MAIN LEVEL TEXOPT, 0 / TEXOP1, JMS CURLEV TEXOP3, DCA TEXOP2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP TEXOP2, 0 TOPTBL /2ND LEVEL TABLE FOR TEXT COMMAND JMP TEXOP1 /NOT FOUND, GET ANOTHER CHAR DCA TEXOP2 /ELSE SAVE THE POINTER JMS I TEXOP2 /AND DISPATCH TO POINTER ADDRESS NOP /REQUIRED. SNA /SKIP IF A CHARACTER CAME IN FROM GETNUM JMP TEXOP1 /GET ANOTHER CHARACTER JMP TEXOP3 /TRY ANOTHER CHARACTER TEXOPX, 0 JMP I TEXOPT /RETURN / TYTEXS, 0 /COME HERE FROM A QUOTE CHAR TAD CHAR /GET A CHARACTER CIA /COMPLEMENT DCA TYTETM /SAVE FOR COMPARISON / CIF PRMFLD /ISSUE A CALL TO SET THE STARTING POSITION TAD (SSPBLK JMS I XPRIMS STA DCA SEMIOK /SET FLAG TO ALLOW PRINING OF ";" TYTXS2, STA DCA LOACTV /SET FLAG TO ALLOW PRINING OF ";" JMS CURLEV TAD TYTETM /SEE IF A TERMINATION CHARACTER SNA CLA /SKIP IF NOT JMP TYTXS1 /ELSE GO HERE TO CHECK IT FURTHER JMS TTXT /GO SEND THE CHAR TO SCREEN NEXT /AND THEN GET ANOTHER TYTXS1, DCA LOACTV /KNOCK DOWN FLAG IN CASE A MARCO COMES IN JMS CURLEV TAD TYTETM /IS IT ANOTHER QUOTE? SZA CLA /SKIP IF IT IS AND SEND IT JMP TYEXIT /ELSE EXIT AND GO THRU LOOKUP TABLE AGAIN JMS TTXT /SEND IT TO SCREEN JMP TYTXS2 /AND GO ESTABLISH THIS LEVEL AGAIN AND GET /ANOTHER CHARACTER TYEXIT, JMS RSTPOS /RESTORE CURSOR POSITION DCA SEMIOK /DON'T PASS ON CONTROL,SPACES OR SEMI'S TAD CHAR TAD (-41 /HAVE TO CHECK IN-LINE BECAUSE ALL CHARS WERE SPA CLA /BEING REC'D AT THIS LEVEL SKP /SKIP IF A CONTROL CHARACTER TAD CHAR /ELSE RETURN WITH THE CHAR IN THE AC JMP I TYTEXS /RETURN TYTETM, 0 / /ROUTINE TO RESTORE CURSOR POSITION AFTER A TEXT COMMAND / RSTPOS, 0 CIF PRMFLD TAD (RCURBL JMS I XPRIMS JMS REQPOS JMP I RSTPOS / RCURBL, RSTCUR /RESTORE CURSOR COMMAND BLOCK / /TBKT - COME HERE TO ESTABLISH ESCAPMENT / TBKT, 0 JMS BKTPAR /GET PAIR OF NUMERALS POSX POSY FPINT /CALL THE FLOATING POINT FGET POSX+1 FMPY XFACT FPUT POSX+1 FGET POSY+1 FMPY YFACT FPUT POSY+1 FEXT JMS FL2INT POSX+1 JMS FL2INT POSY+1 TAD POSX+3 /GET NUMERAL DCA TBASES /SAVE TO SEND TO THE PRIMS (X ESCAPMENT) TAD POSY+3 /GET THE Y VALUE DCA TYESCP /SAVE FOR THE PRIMS STA DCA TXFLAG /SET THE TEXT BLOCK ESCAPEMENT FLAG = 7777 JMS DOTXT /SEND IT TO THE PRIMS JMP I TBKT / /SOPH - HARDCOPY COMMAND, SCREEN OPTION H / SOPH, 0 SOPH2, JMS CURLEV /ESTABLISH THIS LEVEL SOPH3, DCA SOPH4 /SAVE FOR THE LOOKUP JMS I XLOOKU /DO THE LOOKUP SOPH4, 0 SHTAB /THE TABLE TO ACCESS JMP SOPH2 /NOT FOUND (MUST BE DONE) DCA SOPH4 JMS I SOPH4 SNA JMP SOPH2 JMP SOPH3 / SOPHEX, 0 SOPH6, TAD (HRDCPY /TELL CALLER THERE IS A HARDCOPY REQUEST DCA REPLY TAD CHAR /GET THE CHAR BACK JMP I SOPH /AND RETURN WITH IT FOR FURTHER PROCESSING PAGE / SOHO, 0 /HERE FROM "S(H(" SOHO2, JMS CURLEV SOHO3, DCA SOHO5 JMS I XLOOKU SOHO5, 0 SOHOPT JMP SOHO2 DCA SOHO5 JMS I SOHO5 SNA JMP SOHO2 JMP SOHO3 SOHOEX, 0 JMP I SOHO / /CURVE CONTROL BLOCK. / CIRBLK, DRWARC /CIRCLE COMMAND 0 /X POSITION 0 /Y POSITION 550 /DRAW AN ARC OF 360 (DECIMAL) DEGREES CURVEC, 0 STA DCA CIRCUM /MARK THE CIRCUMFERENCE AS THE POINT TO END. JMP I CURVEC /AND EXIT / /TTXT - TYPE TEXT PUTS LETTERS ON THE SCREEN / TTXT, 0 CLA TAD CHAR /GET CURRENT CHARACTER DCA TXTCMD+1 /STORE IN CMD BLOCK CIF PRMFLD TAD (TXTCMD /SET ADDRESS DATA JMS I XPRIMS /TO THE PRIMATIVES JMP I TTXT /RETURN / / SSPBLK, GTTXTR /SPEC_STARTING_POSITION_OF_TEXT_STRING COMMAND TXTCMD, GETTXT /TEXT COMMAND 0 /CURRENT CHARACTER TO SEND / /REPORT COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / REPORT, 0 REPOR1, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA REPCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP REPCMD, 0 REPTAB /1ST LEVEL REPORT OPTION TABLE JMP REPERR /GO HERE ON ERROR DCA REPCMD /SAVE THE POINTER HERE ON RETURNING JMS I REPCMD /AND DISPATCH TO POINTER ADDRESS / JMP REPOR1 /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / REPERR, FINI /GO BACK TO MAIN LEVEL REPOPT, 0 /COME HERE TO HANDLE REPORT OPTIONS REPOT1, JMS CURLEV /ESTABLISH THIS LEVEL REPOT3, DCA REPOT2 /SAVE FOR LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP REPOT2, 0 REPTBL /2ND LEVEL TABLE FOR REPORT JMP REPOT1 /NOT FOUND, GET ANOTHER CHAR DCA REPOT2 /ELSE AAVE THE POINTER JMS I REPOT2 /AND DISPATCH TO THE POINTER ADDRESS SNA /SKIP IF MORE PROCESSING AT THIS LEVEL JMP REPOT1 /NO, GET ANOTHER CHAR JMP REPOT3 /TRY ANOTHER CHARACTER REPEXI, 0 JMP I REPOPT /RETURN / / /WOPS - WRITE OPTION, SHADING ON/OFF / WOPS, 0 DCA SHYBLK+2 /INIT THE SHADE CHAR LOCATION JMS I XGETNU DCA NUMMER+2 /ERROR RETURN JMS SAVCUR /SAVE CURRENT X AND Y TAD CHAR SKP /HAVE A CHARACTER ALREADY WOPS1, JMS CURLEV /ESTABLISH THIS LEVEL AND GET NEXT CHAR WOPS2, DCA WOPS4 /SAVE FOR THE LOOKUP JMS I XLOOKU /DO THE LOOKUP WOPS4, 0 WOPSTB /TABLE TO ACCESS JMP WOPS8 /IF NOT FOUND, FINISH PROCESS DCA WOPS4 /SAVE THE POINTER JMS I WOPS4 /AND DISPATCH TO POINTER ADDRESS SNA /CHECK IF A CHAR ON RETURN JMP WOPS1 /IF NOT, LOOP UNTIL NOT FOUND JMP WOPS2 /IF SO, USE THAT ONE WOPS8, CLA /CHECK IS SHADING REQUESTED TAD NUMMER+2 SNA CLA JMP WOPS9 /NO, GO TURN IT OFF JMS SCAL /ELSE, SCALE TAD DYI+2 DCA SHYBLK+1 /SAVE CIF PRMFLD TAD (SHYBLK JMS I XPRIMS JMP WOPS10 /RETURN TO CALLER WOPS9, CIF PRMFLD TAD (SHOBLK /TURN OFF SHADING JMS I XPRIMS WOPS10, JMS RESCUR /RESTORE CURRENT X AND Y TAD CHAR JMP I WOPS /RETURN TO CALLER WOPSQT, 0 / CLA IAC DCA SEMIOK /NEED TO HANDLE SPACES AT THIS TIME TAD CHAR /GET THE FIRST QUOTE JMS GTRUN /GET THE FIRST CHARACTER IN THE QUOTED STRING CLA /(CLEAR AC, HAS NEXT CHARACTER) DCA SEMIOK /IGNORE SPACES AGAIN TAD TXTCHR /HERE'S THE QUOTED CHARACTER DCA SHYBLK+2 /SAVE IN THE PRIM CONTROL BLOCK / STA /INSURE SHADE WILL BE ON DCA NUMMER+2 TAD CHAR /PASS BACK THE NEXT CHARACTER JMP I WOPSQT / SHOBLK, GTSHDO /SHADE OFF COMMAND SHYBLK, GTSHDY /SHADE ON COMMAND 0 /CURRENT Y POSTION 0 /CURRENT CHARACTER PAGE / /WRITE COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / WRITE, 0 WRITEA, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA WRTCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP WRTCMD, 0 WRTTAB /1ST LEVEL OPTION TABLE JMP WRTERR /GO HERE ON ERROR DCA WRTCMD /SAVE THE POINTER HERE ON RETURNING JMS I WRTCMD /AND DISPATCH TO POINTER ADDRESS / JMP WRITEA /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / WRTERR, TAD CHAR /GO BACK TO MAIN LEVEL WITH CHARACTER IN THE AC JMP I WRITE /BACK TO CALLER. COULD BE FROM TEMP WRITE /OPTIONS WRTOPT, 0 /COME HERE TO HANDLE WRITE OPTIONS WRTOP1, JMS CURLEV / WRTOP3, DCA WRTOP2 JMS I XLOOKU /LOOKUP DESIRED OPTION WRTOP2, 0 WRTTBL /TABLE TO FIND OPTION IN JMP WRTOP1 /NOT FOUND, GET ANOTHER DCA WRTOP2 /SAVE THE ADDRESS JMS I WRTOP2 /AND GO EXECUTE DESIRED OPTION SNA /SKIP IF MORE PROCESSING AT THIS LEVEL JMP WRTOP1 /NO, GET ANOTHER CHAR JMP WRTOP3 /TRY THE CHARACTER FROM PREVIOUS ROUTINE WRITEX, 0 JMP I WRTOPT /RETURN / /SOPE - ERASE ROUTINE /DO A JMS I PRIMS TO ERASE THE SCREEN, THEN /RETURN FROM THE LOOKUP. / SOPE, 0 DCA SHADE /TURN SHADING OFF DCA CURVEF /CLEAR CURVE IN PROGRESS FLAG / DCA STKPNT /THIS, IN EFFECT, CLEARS ANY (B),(S), / OR (E) BLOCKS / CIF PRMFLD TAD (ERASCM /GET THE ERASE COMMAND JMS I XPRIMS /TO THE PRIMATIVES JMP I SOPE /AND JUST RETURN / ERASCM, SCRNER /ERASE COMMAND / PIXEL POSITION COMMANDS / PV6, 0 JMS MOVEP ZERO PLUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV6 JMP I PV6 PV7, 0 JMS MOVEP PLUSX PLUSY / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV7 JMP I PV7 /MOVEP ROUTINE /THIS ROUTINE WILL STORE THE RESULTS OF CALL +1 INTO POSX /AND CALL+2 INTO POSY AS RELATIVE VALUES / MOVEP, 0 TAD I MOVEP /RELATIVE VALUE OF X DCA MOVEP1 /SAVE IT ISZ MOVEP TAD (POSX /DO X FIRST DCA MOVEP2 TAD (-4 /NUMBER OF WORDS, REL. FLAG + 3 FP DATA WORDS DCA MOVEP3 JMS MOVEP4 /DO THE MOVE TAD I MOVEP /RELATIVE VALUE OF Y DCA MOVEP1 /SAVE IT ISZ MOVEP TAD (POSY /NOW DO Y DCA MOVEP2 TAD (-4 /NUMBER OF WORDS DCA MOVEP3 JMS MOVEP4 /DO THE MOVE JMP I MOVEP /EXIT MOVEP1, 0 MOVEP2, 0 MOVEP3, 0 MOVEP4, 0 MOVP4A, TAD I MOVEP1 DCA I MOVEP2 ISZ MOVEP1 ISZ MOVEP2 ISZ MOVEP3 JMP MOVP4A JMP I MOVEP4 / /TOPI - TEXT OPTION ITALIC / TOPI, 0 JMS I XGETNU /GET A DECIMAL NUMBER JMP TOPIA /NOT A NUMERIC VALUE TAD NUMMER+2 /GET THE 12 BIT INTEGER DCA TITLAN /SAVE IT HERE FOR COMMAND BLK JMS DOTXT /SEND IT TO THE PRIMS / JMS SNDESC TOPIA, TAD CHAR /GET CHARACTER WHICH TERMINATED THE INPUT JMP I TOPI /RETURN / SCROPT, 0 /COME HERE AFTER FINDING A LEFT PAREN / SCROP1, JMS CURLEV / SCROP3, DCA SCROP2 /SAVE FOR THE LOOKUP JMS I XLOOKU /EXECUTE THE LOOKUP SCROP2, 0 SOPTBL /2ND LEVEL TABLE FOR SCREEN ADDR COMMAND JMP SCROP1 /NOT FOUND, GET ANOTHER DCA SCROP2 /ELSE SAVE THE POINTER JMS I SCROP2 /AND DISPATCH TO POINTER ADDRESS SNA /SKIP IF MORE TO COME JMP SCROP1 /NO, GET ANOTHER CHAR JMP SCROP3 SCREEX, 0 JMP I SCROPT /RETURN ZERO, -1; 0; 0 ;0 / /SOPC - SCREEN OPTION "C" - CURSOR ON/OFF / ANY NON-ZERO NUMBER WILL TURN ON THE GRAPHICS CURSOR / SOPC, 0 JMS I XGETNU /GET INPUT JMP SOPCEX /NOT A VALID NUMBER, SO EXIT TAD NUMMER+2 /GET THE NUMMER DCA CURSOR+1 /SAVE IT IN THE CURSOR CONTROL BLOCK TAD (CURSOR DCA REPLY SOPCEX, TAD CHAR /GET THE LAST CHAR JMP I SOPC /AND RETURN WITH IT CURSOR, 7774 /TELLS THE VT125 MODULE THIS IS A CURSOR CMD 0 /STORAGE FOR THE ARGUMENT PAGE / /INPUT A BRACKETED PAIR OF COORDINATES. /ENTER THE ROUTINE WITH: / CALL +1 = X POSITION BUFFER / CALL +2 = Y POSITION BUFFER / /ALL INPUT IS DONE IN FOUR WORD FLOATING POINT. / /THE STRUCTURE OF BOTH THE X AND THE Y BUFFER ARE AS FOLLOWS: / WORD 0 = ABSLOLUTE FLAG INDICATOR. THIS IS USED TO DETERMINE IF A SIGN / PRECEDED THE CHARACTER. IF A SIGN IS IN FRONT OF THE STREAM / THEN THE DATA IS ASSUMED TO BE RELATIVE AND IS ADDED TO THE / EXISTING VALUE. IF THERE IS NO SIGN THEN THE VALUE IS TAKEN / AS ABSOLUTE. (-1 IN THE WORD INDICATES RELATIVE. 0 INDICATES / ABSOLUTE.) / WORD 1 = EXPONENT / WORD 2 = HIGH ORDER MANTISSA / WORD 3 = MID ORDER MANTISSA / WORD 4 = LOW ORDER MANTISSA / /EXIT IS MADE TO THE USER WITH THE APPROPRIATE VALUES SET. / /THE FOLLOWING TESTS ARE PERFORMED AND RESULTS RETURNED AS DESCRIBED BELOW: / / FORMAT [] RETURNS 0 FOR X AND Y WITH BOTH FLAGS SET TO RELATIVE. / THIS IS A NULL PARAMETER. / FORMAT [X,Y] RETURNS THE VALUES OF X AND Y WITH THE INDICATOR SET / TO ZERO FOR ABSOLUTE ADDRESSING / FORMAT [X] RETURNS X WITH THE FLAG SET TO ABSLOUTE AND Y SET TO / ZERO AND THE FLAG TO -1 FOR RELATIVE ADDESSING / FORMAT [,Y] RETURNS X EQUAL TO ZERO AND THE FLAG SET TO -1 FOR / RELATIVE AND Y SET TO VALUE WITH THE FLAG SET TO ZERO / FOR ABSOLUTE ADDRESSING. / FORMAT [+-X] RETURNS X WITH THE FLAG SET TO -1 FOR RELATIVE AND Y / EQUAL TO ZERO WITH FLAG EQUAL TO -1 FOR RELATIVE. / FORMAT [,+-Y] RETURNS X EQUAL TO ZERO WITH THE FLAG SET TO -1 FOR / RELATIVE AND THE VALUE OF Y WITH FLAG EQUAL TO -1 / FOR RELATIVE. / FORMAT [X,+-Y] RETURNS THE VALUE OF X WITH THE FLAG EQUAL TO ZERO FOR / ABSOLUTE AND THE VALUE OF Y WITH THE FLAG EQUAL TO -1 / FOR RELATIVE ADDRESSING / FORMAT [+-X,Y] RETURNS THE VALUE OF X WITH THE FLAG EQUAL TO -1 FOR / RELATIVE AND THE VALUE OF Y WITH THE FLAG EQUAL TO ZERO / FOR ABSOLUTE VALUE. / FORMAT [+-X,+-Y]RETURNS THE VALUE OF X WITH THE FLAG EQUAL TO -1 FOR / RELATIVE AND THE VALUE OF Y WITH THE FLAG EQUAL TO -1 / FOR RELATIVE. / BKT1, 0 BKT2, 0 BKTPAR, 0 /INPUT A BRACKETED PAIR TAD I BKTPAR /GET X VALUE POINTERS DCA BKT1 ISZ BKTPAR TAD I BKTPAR /AND THE Y VALUES ISZ BKTPAR DCA BKT2 /AND SAVE IT AS WELL DCA ABSFLG /CLEAR SIGN INDICATOR FOR X FUNCTION FPINP /GET DATA TAD CHAR /GET BACK THE CHARACTER TAD MRBRKT /SEE IF CLOSING SQUARE BRACKET SZA CLA /SKIP IF YES (NO ARGUMENTS TO IT) JMP GETX2 /ERROR IN COMMAND. TRY LOOKING FOR A COMMA /AND THEN TRY TO RESYNC THE ROUTINE TAD DSWIT /SEE IF CONVERSION WAS PERFORMED (WILL BE ZERO IF NOT) SNA CLA /SKIP IF NO JMP GETX1 /NO DIGIT INPUT. MARK BOTH AS ZERO FOR RESYNCH TAD ABSFLG /MAINTAIN RELATIVE/ABSOLUTE FLAG DCA I BKT1 ISZ BKT1 STA DCA I BKT2 ISZ BKT2 /MARK THE Y AS RELATIVE FPINT /NOW GET THE VALUE RETRIEVED FROM INPUT FPUT I BKT1 /STORE THE NEW VALUE OF X FGET ZERO+1 FPUT I BKT2 /MAKE SURE Y POINTER IS ZEROED FEXT JMP I BKTPAR /AND EXIT GETX1, STA /MARK THE FLAG AS RELATIVE FOR NOW DCA I BKT1 STA DCA I BKT2 /AS WELL AS THE Y VALUE / /NOW GET THE VALUE (SHOULD BE ZERO) / DCA EXP /CLEAR OUT FLOATING POINT DCA HORDER DCA LORDER ISZ BKT1 /POINT TO FLOATING POINT STORAGE AREA ISZ BKT2 FPINT /GET THE VALUE FPUT I BKT1 /NOW POINTS TO BUFFER AREA FOR VALUES FPUT I BKT2 FEXT /ALL DONE JMP I BKTPAR /AND EXIT THE ROUTINE GETX2, TAD MCOMMA /SEE IF IT IS A COMMA TAD CHAR /AND THE CHARACTER SNA CLA /SKIP IF NOT. (ERROR IN COMMAND STREAM) JMP GETY /NOW GO GET THE Y VALUE JMS GETERR JMP GETX1 GETY, TAD DSWIT /SEE IF CONVERSION WAS PERFORMED (WILL BE ZERO IF NOT) SZA CLA /SKIP IF NO JMP GETY1 /MAINTAIN VALUE OF ABSOLUTE/RELATIVE FLAG STA /ESTABLISH RELATIVE POINTER DCA ABSFLG /MARK ABSOLUTE INDICATOR FOR RELATIVE GETY1, TAD ABSFLG /GET THE VALUE OF THE RELATIVE/ABSOLUTE INDICATOR DCA I BKT1 /MARK AS RELATIVE DCA ABSFLG ISZ BKT1 /POINT TO STORAGE AREA FPINT /CALL THE FP INTERPRETTER FPUT I BKT1 /STORE THE DATA OF ZERO FEXT /EXIT COMMAND FPINP /GET THE NEW VALUES TAD CHAR /FIRST LETS SEE IF CHARACTER WAS THE PROPER TERMINATOR TAD MRBRKT /RIGHT SQUARE BRACKET SNA CLA /SKIP IF NOT JMP GETY1A STA /SET THE X POINTER TO PROPER VALUE TAD BKT1 DCA BKT1 /AND SAVE IT AGAIN JMS GETERR /ERROR IN COMMAND STRING JMP GETX1 /TAKE ERROR EXIT GETY1A, TAD DSWIT /SEE IF ANY CONVERSIONS DONE SZA CLA /SKIP IF YES JMP GETY2 STA DCA ABSFLG /MARK THE ABSOLUTE/RELATIVE INDICATOR PROPERLY GETY2, TAD ABSFLG /GET THE VALUE OF THE RELATIVE/ABSOLUTE INDICATOR DCA I BKT2 /MARK AS RELATIVE ISZ BKT2 /POINT TO STORAGE AREA FPINT /CALL THE FP INTERPRETTER FPUT I BKT2 /STORE THE DATA OF ZERO FEXT /EXIT COMMAND JMP I BKTPAR /BRACKETTED PAIR SHOULD HAVE BEEN DONE GETERR, 0 JMS CURLEV /SET UP NEXT ENTRY POINT TO PARSER TAD MRBRKT /RIGHT BRACKET SZA CLA /SKIP IF NOT NEXT JMP I GETERR / /WOPC - WRITE OPTION COMPLEMENT ROUTINE / WOPC, 0 CLA CLL IAC RAL / AC = 2 DCA SETWR+1 /SAVE IT JMS SETWRT /SEND THE CMD TO THE TERM JMP I WOPC /RETURN TO HIGHER LEVEL / /WOPE - WRITE OPTION ERASE ROUTINE / WOPE, 0 CLA CLL IAC CML RAL /AC = 3 DCA SETWR+1 /SAVE IT JMS SETWRT /SEND THE CMD TO THE TERM JMP I WOPE / /WOPV - WRITE OPTION OVERLAY ROUTINE / WOPV, 0 CLA DCA SETWR+1 /SAVE IT JMS SETWRT /SEND THE CMD TO THE TERM JMP I WOPV / /TOPD - TEXT OPTION "D" - CELL ROTATION / TOPD, 0 JMS I XGETNU /GET A DECIMAL NUMBER JMP TOPDA /INVALID RESPONSE TAD NUMMER+2 /GET THE INTEGER DCA TCHRAN /SAVE IN COMMAND BLK JMS DOTXT /SEND IT TO THE PRIMS / JMS SNDESC /SEND THE STORED ESCAPEMENT IF NECESSARY TOPDA, TAD CHAR /GET CHARACTER WHICH TERMINATED THE INPUT JMP I TOPD /RETURN NULLXY, ZBLOCK 4 PAGE / /SOPI - SET BACKGROUND COLOR OPERATION /COME HERE TO CHANGE BACKGROUND COLOR WHEN SELECTED BY AN S(I) COMMAND / SEBCLR, GTBGRD /SET BACKGROUND COLOR COMMAND BCLR, 0 /CONTAINS THE DESIRED COLOR / / /RETURN HERE SAYS ANOTHER CHARACTER HAS TO BE PROCESSED / SOPI1A, TAD CHAR /GET CHARACTER WHICH TERMINATED THE INPUT JMP I SOPI /EXIT BACK TO CALLER SOPI, 0 JMS GETCLR /GET THE COLOR JMP SOPI1A /ERROR IN SPECIFIER. EXIT WITH CURRENT CHARACTER /IN THE AC. CLA TAD SAVCLR /GET DESIRED COLOR DCA BCOLR /AND SAVE IT FOR LATER USE TAD SAVCLR DCA BCLR /SAVE FOR THE BACKGROUND COMMAND / CIF PRMFLD TAD (SEBCLR /POINTS TO THE COMMAND JMS I XPRIMS /SEND IT TO THE PRIMS JMP SOPI1A /RETURN TO HIGHER LEVEL / / /WOPI - SET FOREGROUND COLOR OPERATION /COME HERE TO CHANGE FOREGROUND COLOR WHEN SELECTED BY A W(I) COMMAND / SEFCLR, GTFGRD /SET FOREGROUND COLOR COMMAND FCLR, 0 /CONTAINS THE DESIRED COLOR / /ENTRY HERE SAYS AN INVALID CHARACTER WAS SEEN AT THIS LEVEL. RETURN TO HIGH /LEVEL FOR PROCESSING / WOPI, 0 JMS GETCLR JMP WOPIA /ERROR EXIT. INVALID SELECTION IN COLOR VALUES /GO BACK TO PREVIOUS LEVEL AND DO ANOTHER OPTION CLA TAD SAVCLR /GET DESIRED COLOR DCA FCOLR /AND SAVE IT FOR LATER USE TAD SAVCLR DCA FCLR /SAVE FOR THE BACKGROUND COMMAND / CIF PRMFLD TAD (SEFCLR /POINTS TO THE COMMAND JMS I XPRIMS /SEND IT TO THE PRIMS WOPIA, TAD CHAR /RETURN CHARACTER IN THE AC JMP I WOPI / /SETWRT - SENDS THE WRITE OPTION CONTAINED IN LOC SETWR+1 TO THE PRIMS / SETWRT, 0 CIF PRMFLD TAD (SETWR /SEND TO THE PRIMS JMS I XPRIMS JMP I SETWRT SETWR, GTWRTM 0 /LOCATION FOR BUILDING OPTION WORD / /ROUTINE TO INPUT A FOREGROUND OR BACKGROUND COLOR FOR THE WRITING OPTIONS. /RETURN IS MADE CALL +1 IF AN INVALID SELECTION; CALL+2 IF VALID. /STAY IN THIS ROUTINE UNTIL AN INVALID SELECTION IS SEEN. / GETCLR, 0 STA DCA SAVCLR /MARK THE COLOR AS INVALID FOR RETURN CODE. JMS I XGETNU /GO TO INPUT ROUTINE JMP GETCL3 /INVALID ARGUMENT. NON-NUMERIC. TAD NUMMER+2 /GET THE NUMBER BACK AND (17 /MASK TO A VALID COLOR. TAD (CMAPTB /BASE OFFSET TO COLOR MAP DCA SAVCLR /SAVE THE COLOR SELECTED. CDF TBLFLD /TABLE FIELD TAD I SAVCLR /GET THE REAL COLOR VALUE CDF RGFLD /BACK TO HOME FIELD DCA SAVCLR /AND SAVE IT FOR LATER USEAGE JMP EXBCLR /GO SEND THE COMMAND TO THE PRIMS /COME HERE TO SEE IF CHAR IS ONE OF DESIGNATED ALPHA COLOR SPECIFIERS /OR AN HLS DESCRIPTOR GETCL3, TAD CHAR DCA GETCL4 /SAVE FOR LOOKUP JMS I XLOOKU /DO THE LOOKUP GETCL4, 0 CLRTB1 /PROCESS COLOR BY LETTER VALUE JMP I GETCLR /ERROR, GO BACK TO HIGHER LEVEL AND PROCESS DCA GETCL4 JMS I GETCL4 EXBCLR, TAD SAVCLR /SEE IF A VALID COLOR WAS SPECIFIED. SPA CLA /SKIP IF YES JMP I GETCLR /ERROR EXIT ISZ GETCLR /UPDATE TO VALID RETURN JMP I GETCLR /AND EXIT / /SUBOPTION ROUTINE. AN OPEN PARENS WAS SEEN. NOW START LOOKING FOR VALID COLOR /VALUES AS CHARACTERS OR AS HLS RATHER THAN NUMBERS. / GETCOP, 0 /GET COLOR BY LETTER UNTIL A CLOSE PAREN IS SEEN TAD (62 /SET UP HLS DEFAULTS DCA LIGNUM /L=50% TAD (144 DCA SATNUM /SATURATION TO 100% TAD (360 DCA HUENUM /HUE TO 240 STA DCA HLSSEE /NO HLS SET STA / DCA COLSEE /NO COLOR SET GETCOA, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING. GETCOB, DCA GETOP1 /SAVE THE CHARACTER FOR THE LOOKUP JMS I XLOOKU /SEE IF CLOSING PARENS (LOOKUP WILL RUN DOWN ANY /THING THAT IS NOT VALID GETOP1, 0 CLRTB3 JMP GETOP2 /NOT A CLOSE PAREN. SEE IF IT IS A VALID COLOR DCA GETOP1 /SAVE THE ROUTINE ADDRESS JMS I GETOP1 /EXECUTE THE ROUTINE SZA JMP GETCOB JMP GETCOA GETOP2, DCA GETOP1 /INIT THE COUNTER. TAD (CLRTB2-1 /OPTION TABLE DCA 10 SKP GETOP3, ISZ GETOP1 /UPDATE THE COLOR INDEX CDF TBLFLD TAD I 10 /SCAN THE TABLE FOR A MATCH CDF RGFLD SNA /SKIP IF NOT THE END OF THE TABLE JMP GETCOA /TRY THE NEXT VALUE. TAD LOOK1 /SEE IF IT IS THIS ONE (CONVERTED CHARACTER) SZA CLA /SKIP IF A MATCH IS FOUND JMP GETOP3 /TRY ANOTHER CLL CLA IAC R3L /AC=10 TAD GETOP1 /GET THE COLOR INDEX AND (17 /MASK TO VALID VALUE DCA COLSEE /AND SAVE IT JMP GETCOA /TRY ANOTHER CLRRP, 0 TAD COLSEE /END OF COLOR SELECTION. NOW DETERMINE WHAT HAS /TO BE DONE FOR HLS SUPPORT. SPA CLA /POSITIVE VALUE SAYS A COLOR HAS BEEN SPECIFIED JMP CLRRPB TAD COLSEE /GET SPECIFIED COLOR DCA SAVCLR /AND SAVE IT JMP CLRRPA /AND FINISH UP. CLRRPB, TAD HLSSEE /SEE IF HLS HAS BEEN SPECIFIED. SNA CLA /SKIP IF YES. JMS HLSCOL /GO ESTABLISH COLOR SPECIFIED. CLRRPA, DCA CHAR JMP I GETCOP /EXIT PAGE / /LOOKUP ROUTINE FOR PROCESSING NEXT LEVEL OF FUNCTION /THE ROUTINE WILL FIRST CONVERT ALL LOWER CASE CHARACTERS TO UPPER CASE AND /THEN PERFORM THE PROPER LOOKUP ON THE CONVERTED CHARACTER. /ENTER WITH THE CHARACTER IN THE AC; / CALL+1 = CHARACTER / CALL+2 = TABLE ADDRESS /EXIT TO: / CALL +3 IF INVALID SEQUENCE SEEN / CALL +4 IF VALID SEQUENCE SEEN AND ROUTINE ADDRESS IN THE AC. / LOOKUP, 0 RDF /ESTABLISH WHERE WE CAME FROM TAD (CIF CDF DCA LOOKEX /SAVE FOR LATER USE TAD I LOOKUP /GET THE CHARACTER ISZ LOOKUP /UPDATE THE POINTER DCA LOOK1 /SAVE THE CHARACTER TO DO TAD I LOOKUP /NOW THE TABLE ADDRESS ISZ LOOKUP DCA LOOKTM /SAVE TABLE ADDRESS FOR LATER. LOOKU2, TAD LOOKTM /SET UP TABLE ADDRESS. DCA LOOK2 /SAVE IT TAD LOOK1 JMS I XUPPER /MAKE UPPER CASE IF NECESSARY DCA LOOK1 LOOK3, CLA /MAKE SURE THE AC IS CLEAR CDF TBLFLD /TABLE FIELD TAD I LOOK2 /GET A COMPARISON VALUE CDF RGFLD /TO MAINTAIN THE PROPER FIELD DATA SNA /SKIP IF NOT DONE JMP LOOK7 /FUNCTION NOT FOUND. GO TEST FOR MATCHING PAIRS TAD LOOK1 /NOW DO THE COMPARISON SZA CLA /SKIP IF EQUAL. SAYS WE FOUND A MATCH JMP LOOK5 /GO UPDATE THE POINTERS ISZ LOOK2 /POINT TO THE ROUTINE CDF TBLFLD /BUFFER FIELD AGAIN TAD I LOOK2 /GET ROUTINE ADDRESS CDF RGFLD /RETURN TO THIS FIELD ISZ LOOKUP /UPDATE THE RETURN TO NON-ERROR JMP LOOKEX /AND EXIT TO VALID RETURN WITH ADDRESS IN THE AC LOOK5, ISZ LOOK2 ISZ LOOK2 /UPDATE THE POINTERS TO POINT TO THE /NEXT COMPARISON VALUE JMP LOOK3 LOOK7, TAD LOOK1 /SEE IF IT'S A COMMA TAD MCOMMA SNA CLA /THROW AWAY THE COMMA AND JMP LOOK7Z /GO GET ANOTHER CHARACTER TAD LOOK1 /GET THE CHARACTER AND START TESTING FOR /RUN DOWNS. TAD MLPREN /FIRST LEFT PAREN SZA CLA /SKIP IF YES JMP LOOK7A /GO TEST FOR "[" JMS LPRUN /RUN DOWN PARENS JMP LOOK7Z /GO TRY NEXT CHARACTER IN LINE LOOK7A, TAD LOOK1 /GET CHARACTER AGAIN TAD MLBRKT /LOOK FOR LEFT BRACKET SZA CLA /SKIP IF YES JMP LOOK7B JMS NULBKT /RUN DOWN BRACKETS JMP LOOK7Z /EXIT TO GET NEXT CHARACTER LOOK7B, TAD LOOK1 /NOW FOR QUOTES TAD MSGLQU SNA CLA /SKIP IF NOT SINGLE WUOTE JMP LOOK7W /GO PROCESS SINGLE QUOTE. (COMMON ROUTINE) TAD LOOK1 /NOW THE DOUBLE QUOTE TAD MDBLQU SNA CLA /SKIP IF NOT JMP LOOK7W /GO RUN DOWN QUOTES TAD LOOK1 /NOW TEST FOR NUMERICS. TAD (-60 SPA /SKIP IF NOT NUMERIC JMP LOOK7E /NOT THIS TAD (-11 /THE HIGH END SMA SZA CLA /SKIP IF WITHIN RANGE JMP LOOK7E /TAKE THE NOT FOUND EXIT DCA CHAR /CLEAR THE CURRENT CHARACTER JMP LOOK7Z /CONTINUE LOOK7W, TAD LOOK1 /PASS THE QUOTE TO THE RUN-DOWN ROUTINE JMS GTRUN /RUN DOWN A QUOTED STRING DCA LOOK1 /SAVE NEXT CHAR AS NEW LOOKUP TARGET JMP LOOKU2 /BACK IN LINE - TO PROCESS NEXT CHARACTER LOOK7E, CLA LOOKEX, HLT /MODIFIED TO CIF CDF CALLING FIELD JMP I LOOKUP /AND EXIT THE ROUTINE LOOK7Z, JMS CURLEV DCA LOOK1 /SAVE THE INCOMING CHARACTER JMP LOOKU2 /AND TRY AGAIN LOOK1, 0 /TEMPS FOR THIS ROUTINE LOOK2, 0 LOOKTM, 0 UPPER, 0 / DCA UPPETM /SAVE CHAR TAD UPPETM TAD (-141 /LOWER CASE A TO Z SPA /SKIP IF IT STILL LOOKS GOOD JMP UPPER8 /NOT LOWER CASE TAD M32 /THE RANGE OF CHARACTERS SMA CLA /SKIP IF WITHIN RANGE JMP UPPER8 /NOT LOWER CASE CHARACTER TAD UPPETM /MAKE IT UPPERCASE TAD M40 /THIS DOES IT DCA UPPETM /SAVE FOR RETURN / UPPER8, CLA CLL TAD UPPETM /GET CONVERTED CHAR JMP I UPPER /RETURN WITH CHAR, NOW UPPER-CASE / /RUN DOWN A QUOTED PAIR / GTRUN, 0 CIA /COMPLEMENT THE FIRST QUOTE DCA GTRNTM /SAVE IT FOR LATER COMPARES STA DCA LOACTV /PASS ALL CHARS / JMS CURLEV /GET NEXT CHARACTER DCA TXTCHR /SAVE AS FIRST IN STRING TAD TXTCHR /GET IT BACK JMP GTRUN6 / AND JUMP INTO NEXT LEVEL / GTRUN4, STA DCA LOACTV /RESET FLAG TO IGNORE EXPANDING A MARCO JMS CURLEV /MAKE THIS LEVEL GTRUN6, TAD GTRNTM /CHARACTER TO LOOK FOR SZA CLA /SKIP IF TERMINATOR - MAYBE JMP GTRUN4 /TRY ANOTHER DCA LOACTV /KNOCK DOWN IN CASE A MARCO COMES IN JMS CURLEV /NOW SEE IF NEXT CHARACTER IS A QUOTE DCA GTRNT1 /SAVE THE CHARACTER IN CASE TAD GTRNT1 TAD GTRNTM /COMPARE SNA CLA /SKIP IF NOT A TERMINATOR JMP GTRUN4 /TRY AGAIN TAD GTRNT1 /GET FIRST CHAR AFTER STRING JMS I XUPPER /MAKE UPPER-CASE IF NECESSARY JMP I GTRUN /EXIT ROUTINE WITH NEXT CHAR IN AC GTRNTM, 0 GTRNT1, 0 / / PAGE WOPSLB, 0 STA DCA NUMMER+2 JMS PBKT /GET THE SHADING REFERENCE LINE NOP /NEED BECAUSE OF STACK COMMANDS JMP I WOPSLB / /RESTORE THE POINT PREVIOUSLY SAVED / RESCUR, 0 TAD TEMP1 /RESTORE STARTING X DCA CURX+1 TAD TEMP1A DCA CURX+2 TAD TEMP2 /RESTORE STARTING Y DCA CURY+1 / TAD TEMP2A DCA CURY+2 JMS INT2FL CURX JMS INT2FL CURY /INTEGER TO FLOAT CONVERSION. JMP I RESCUR /B, S, AND E OPTIONS. / /THE FOLLOWING ROUTINES PROVIDE SUPPORT FOR THE B, S, AND E SUBOPTIONS /IN THE VECTOR, POSTION, AND CIRCLE COMMAND. THE B OPTION PUSHES A POINT /ONTO THE STACK. THE S OPTION IS SIMILAR TO THE B OPTION IN THAT IT PUSHES /A DUMMY ARGUMENT ONTO THE STACK AND ON THE E COMMAND HAS NO MEANING. THE /E OPTION POPS A POINT OF THE STACK AND CAUSE THE PROPER COMMAND TO BE /PERFORMED. / / /ROUTINE TO PUSH A POINT ONTO THE POSITION STACK. THE STACK IS 16 POINTS /DEEP. IT WILL TAKE THE CONTENTS OF CURX AND CURY AND STORE THEM WITH /THE FLAG INFORMATION CONTAINED IN THE AC. UPON ENTRY THE AC WILL CONTAIN /0 FOR A REAL POINT TO PUSH AND -1 FOR A DUMMY PUSH FOR THE S OPTION. / /STKPNT CONTAINS THE CURRENT LEVEL OF THE STACK AND CANNOT BE ANY GREATER /THAN 16 DECIMAL POINTS DEEP. / PUSHPT, 0 DCA STKTMP /SAVE WHATEVER IS IN THE AC / TAD STKPNT /SEE IF STACK IS ALREADY FULL TAD (-20 /MAX SIZE OF STACK SMA CLA JMP I PUSHPT /JUST RETURN IF ALREADY FULL / TAD STKPNT /CURRENT STACK DEPTH CLL RTL /MULTIPLY BY FIVE FOR OFFSET TO ACTUAL /STACK POINTER TAD STKPNT TAD (STACK-1 /MAKE THE POINTER FOR USE DCA 10 /SAVE THE POINTER. TAD STKTMP /GET THE CONTENTS OF THE AC DCA I 10 /SAVE THE FLAG DATA. IT TELL WHETHER IT /IS A REAL POINT OR A DUMMY ARGUMENT JMS FL2INT /CONVERT TO INTEGER CURX JMS FL2INT CURY TAD CURX+1 /CURRENT VALUE OF X DCA I 10 TAD CURX+2 DCA I 10 TAD CURY+1 /AND THE Y VALUE DCA I 10 TAD CURY+2 DCA I 10 JMS INT2FL CURX JMS INT2FL CURY ISZ STKPNT /NEXT ENTRY ON THE STACK (POST INCREMENT) JMP I PUSHPT /AND EXIT THE ROUTINE STKPNT, 0 STKTMP, 0 / /ROUTINE TO POP A POINT OF THE STACK. /IF THE STACK POINTER IS AT ZERO THEN UPDATES ARE NOT DONE ELSE THE POINTER /IS UPDATED. IF THE FIRST WORD IS NOT ZERO THEN IT IS A DUMMY POINT AND /THE ARGUMENTS ARE NOT RESTORED TO DXI+2 AND DYI+2. / POPPNT, 0 TAD STKPNT /SEE IF AT THE TOP OF THE STACK SNA CLA /IF YES DON'T DO THE UPDATE JMP I POPPNT /EXIT AS STACK IS EMPTY STA /(PRE-DECREMENT) TAD STKPNT /UPDATE AS NEEDED DCA STKPNT TAD STKPNT /CURRENT STACK DEPTH CLL RTL /MULTIPLY BY FIVE FOR OFFSET TO ACTUAL /STACK POINTER TAD STKPNT TAD (STACK-1 /MAKE THE POINTER FOR USE DCA 10 /SAVE THE POINTER. TAD I 10 /GET THE FLAG WORD SZA /SKIP IF THE POINT IS REAL AND EXIT WITH AC /THE ACSET FOR CALLING ROUTINE. JMP POPEX1 /TAKE THE UPDATE EXIT AND JUST UPDATE THE /POINTERS. TAD I 10 /CURX DCA CURX+1 TAD I 10 /CURX DCA CURX+2 TAD I 10 /CURY DCA CURY+1 TAD I 10 /CURY DCA CURY+2 JMS INT2FL CURX JMS INT2FL CURY POPEX1, JMP I POPPNT /TAKE THE EXIT. / /SAVE A DUMMAY ARGUMENT ON THE POSITION STACK. SAME AS ABOVE ROUTINE /EXCEPT A FLAG IS SENT TO THE STACK ROUTINES TO SAVE IT IS A DUMMY ARGUMENT. / SAVDUM, 0 STA JMS PUSHPT /SAVE THE CURRENT POINT AS A DUMMY ARGUMENT ISZ SAVDUM /UPDATE TO BYPASS EXECUTING ON RETURN JMP I SAVDUM /AND EXIT BACK TO CALLING ROUTINE. / /RESTORE THE LAST POSITION SAVED. IF THE AC RETURNS FROM THE POP ROUTINE /AS -1 THEN THE POSITION FUNCTION IS NOT DONE. / LASPOS, 0 JMS POPPNT /GET A POINT TO RESTORE. SZA CLA /SKIP IF IT IS A REAL POINT ISZ LASPOS JMP I LASPOS /AND EXIT. / /SCREEN MAP FUNCTION / SOPM, 0 SOPM1, JMS I XGETNU JMP SOPMB /INVALID NUMBER TAD NUMMER+2 /GET BACK THE NUMMER AND (17 /MASK TO A COLOR VALUE TAD (CMAPTB /OFFSET TO COLOR VALUE DCA SOPMTM /SAVE IT SOPMB, TAD CHAR /GET THE CHARACTER WHICH CAUSED THE EXIT. DCA SOPM2 /SAVE IT FOR A LOOKUP. JMS I XLOOKU /DO THE LOOKUP SOPM2, 0 CLRTB1 /COLOR BY LETTER JMP SOPMA /NOT A VALID CHARACTER DCA SOPM2 /SAVE THE ADDRESS OF THE ROUTINE JMS I SOPM2 /EXECUTE THE ROUTINE TAD SAVCLR /GET BACK THE COLOR SPECIFIED. SPA /SKIP IF A VALID COLOR JMP SOPM1 /TRY ANOTHER CDF TBLFLD /TABLE FIELD DCA I SOPMTM /SAVE THE COLOR MAP VALUE CDF RGFLD /HOME FIELD JMP SOPM1 /TRY ANOTHER SOPMA, CLL CLA TAD CHAR /FAILING CHARACTER JMP I SOPM /EXIT. SOPMTM, 0 / /DUMMY SUBROUTINE / DUMMY, 0 JMP I DUMMY / PAGE / /SCALING ALGORITHM / SCALER, 0 FPINT /CALL FLOATING PT /DELTA X IMPLENTATION = BX-TX FGET BX FSUB TX FPUT DXI /DELTA Y IMPLMENTATION = BY-TY FGET BY FSUB TY FPUT DYI /DELTA X REQUESTED = SCRBX+1 MINUS SCRTX+1 FGET SCRBX+1 FSUB SCRTX+1 FPUT DXR /DELTA Y REQUESTED = SCRBY+1 MINUS SCRTY+1 FGET SCRBY+1 FSUB SCRTY+1 FPUT DYR FEXT / X RATIO = DXI/DXR FPINT /GET BACK INTO FLOATING POINT FGET DXI FDIV DXR FPUT XR / Y RATIO = DYI/DYR FGET DYI FDIV DYR FPUT YR /TEST FOR ABS(YR/XR) >= 1 FGET YR FDIV XR FPUT NUMMER FEXT TAD NUMMER+1 SMA CLA JMP SC8 FPINT FGET NUMMER FMPY MINUS1+1 FPUT NUMMER FEXT SC8, FPINT FGET NUMMER FADD MINUS1+1 FPUT NUMMER FEXT TAD NUMMER+1 SMA CLA SPA CLA /THEN ABS(YR/XR) IS >=1 JMP SC10 /OR IF IT IS LESS THAN 1, GO HERE /SET S = ABS(XR) TAD XR+1 SMA CLA JMP SC9A FPINT FGET XR FMPY MINUS1+1 /MULT BY -1 TO GET ABSOLUTE VALUE FPUT S FEXT JMP SC11 SC9A, FPINT /SAVE THE VALUE OF XR INTO S FGET XR FPUT S FEXT JMP SC11 /SET S =ABS(YR) SC10, TAD YR+1 SMA CLA JMP SC10A FPINT FGET YR FMPY MINUS1+1 /MULT BY -1 TO GET ABSOLUTE VALUE FPUT S FEXT JMP SC11 SC10A, FPINT /SAVE THE POSITIVE VALUE OF YR INTO S FGET YR FPUT S FEXT /EXIT FLOATING POINT AND CONTINUE AT SC11 / X_FACTOR = (S)(SIGN(XR)) SC11, TAD XR+1 SMA CLA JMP SC11A FPINT FGET S FMPY MINUS1+1 FPUT XFACT FEXT JMP SC11B SC11A, FPINT FGET S FMPY PLUS1+1 FPUT XFACT FEXT / Y_FACTOR = (S)(SIGN(YR)) SC11B, TAD YR+1 SMA CLA JMP SC11C FPINT FGET S FMPY MINUS1+1 FPUT YFACT FEXT JMP SC12 SC11C, FPINT FGET S FMPY PLUS1+1 FPUT YFACT FEXT JMP SC12 /JUMP OVER PAGE BOUNDRY SCLREX, JMP I SCALER /RETURN S, 1; 2000; 0 /SCREEN SCALING (INITIAL VALUE, MAY CHANGE) XR, ZBLOCK 3 /TEMPORARY YR, ZBLOCK 3 /TEMPORARY / PAGE / X_OFFSET = TX + (DXI - ((DXR)(XFACT)) / --------------------- / 2 SC12, FPINT FGET XFACT FMPY DXR FPUT DXR FGET DXI FSUB DXR FDIV PLUS2 FADD TX FPUT XOFSET / Y_OFFSET = TY + (DYI - ((DYR)(YFACT)) / --------------------- / 2 FGET YFACT FMPY DYR FPUT DYR FGET DYI FSUB DYR FDIV PLUS2 FADD TY FPUT YOFSET FEXT JMP SCLREX /RETURN / /MACRO COMMAND SEEN TO REGIS /ACCEPT THE INCOMING DATA UNTIL A NEW COMMAND IS SEEN AT WHICH POINT A RETURN /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / MACRO, 0 JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. JMS I XUPPER /GO MAKE UPPER CASE DCA CHAR TAD CHAR TAD M101 SPA JMP MACLUK /GO SEE IF IT IS A VALID MACRO FUNCTION TAD M32 /NOW CHECK THE HIGH END SMA CLA /SKIPS IF WITHIN RANGE JMP MACLUK /ALL DONE OR INVALID COMMAND TAD CHAR CIF TBLFLD JMP DOGRPH /GO EXECUTE THE DESIRED MACRO MACLUK, CLA TAD CHAR DCA MACCMD /SAVE IT FOR THE LOOKUP CIF RGFLD JMS LOOKUP /EXECUTE A LOOKUP MACCMD, 0 MACTAB /1ST LEVEL OPTION TABLE JMP MACERR /GO HERE ON ERROR DCA MACCMD /SAVE THE POINTER HERE ON RETURNING CIF TBLFLD JMS I MACCMD /AND DISPATCH TO POINTER ADDRESS / JMP MACROX /EXIT BACK TO MAIN LEVEL / MACERR, MACROX, CLA DCA CHAR /ALL DONE DCA SEMIOK /TERMINATE THE FUNCTION JMP I MACRO /RETURN / /SOPHP - SCREEN OPTION HARD COPY POSITION COMMAND / SOPHP, 0 JMS CURLEV /ESTABLISH THIS LEVEL TAD MLBRKT /SEE IF A LEFT BRACKET WAS INPUT SZA CLA JMP SOPHP8 /INVALID CHARACTER SO EXIT JMS TOPBKT /ELSE GO GET THE PARAMETERS TAD POSX /CHECK IF MISSING PARAMETER TO IGNORE SNA CLA /(WILL LOOK LIKE RELATIVE ZERO) JMP SOPHP2 /ABSOLUTE, GO USE IT TAD POSX+3 /RELATIVE, CHECK IF ZERO (IMPLIES MISSING) SNA CLA JMP SOPHP4 /IS RELATIVE ZERO, DON'T CHANGE THIS PARAMETER SOPHP2, TAD POSX+3 /REAL VALUE, MOVE INTO CONTROL BLOCK DCA HRDCPY+1 / SOPHP4, TAD POSY /CHECK IF MISSING PARAMETER TO IGNORE SNA CLA /(WILL LOOK LIKE RELATIVE ZERO) JMP SOPHP6 /ABSOLUTE, GO USE IT TAD POSY+3 /RELATIVE, CHECK IF ZERO (IMPLIES MISSING) SNA CLA JMP SOPHP8 /IS RELATIVE ZERO, DON'T CHANGE THIS PARAMETER SOPHP6, TAD POSY+3 /REAL VALUE, MOVE INTO CONTROL BLOCK DCA HRDCPY+2 SOPHP8, TAD CHAR /GET THE CHARACTER THAT TERMINATED INPUT JMP I SOPHP /AND RETURN FOR FURTHER PROCESSING / /SHBRKT - SCREEN OPTION HARD COPY COMMAND TO GET THE SCREEN PARAMETERS FROM THE / USER FOR PRINTING. / SHBRKT, 0 JMS CURLEV /ESTABLISH THIS LEVEL TAD MLBRKT /SEE IF CHAR IS A LEFT BRACKET SZA CLA JMP SHBRKX /EXIT IF IT IS JMS TOPBKT /ELSE GO GET THE DESIRED PARAMETERS TAD POSX+3 /TO BE THE UPPER LEFT CO-ORD DCA HRDCPY+3 TAD POSY+3 /TO BE THE TOP Y CO-ORD DCA HRDCPY+4 JMS CURLEV /NEW LEVEL TAD MLBRKT /LOOK FOR NEXT LEFT BRACKET SZA CLA JMP SHBRKX /GET OUT IF IT'S NOT (MUST BE DONE) JMS TOPBKT /GO GET NEXT PARAMETERS TAD POSX+3 /TO BE THE RIGHT X CO-ORD SNA TAD (1437 /FORCE DEFAULTS IF CAME BACK ZERO DCA HRDCPY+5 TAD POSY+3 /TO BE THE BOTTOM RIGHT CO-ORD SNA TAD (737 DCA HRDCPY+6 SHBRKX, TAD CHAR /GET THE CHAR THAT TERMINATED THE INPUT JMP I SHBRKT /RETURN FOR FURTHER PROCESSING / HRDCPY, -1 62 0 0 0 1437 737 PAGE / /SAVE A POSITION ON THE POSITION STACK. /USED BY AT LEAST THE VECTOR AND POSITION COMMAND AND POSSIBLY THE /CURVE COMMAND. / SAVPOS, 0 JMS PUSHPT /SAVE THE CURRENT POINT. THIS IS A REAL POINT /SO THE AC WILL BE CLEAR. ISZ SAVPOS /UPDATE TO BYPASS EXECUTING ON RETURN JMP I SAVPOS /AND EXIT BACK TO CALLING ROUTINE / /SCALE / SCAL, 0 FPINT FGET CURX /X_PHYS = (CURX-SCRTX+1)(XFACT) + XOFSET FSUB SCRTX+1 FMPY XFACT FADD XOFSET FPUT DXI /Y_PHYS = (CURY-SCRTY+1)(YFACT) + YOFSET FGET CURY /DO THE CALCULATIONS FSUB SCRTY+1 FMPY YFACT FADD YOFSET FPUT DYI FEXT /CONVERT TO INTEGERS JMS FL2INT DXI JMS FL2INT DYI JMP I SCAL /RETURN XFACT, 1; 2000; 0 /INITIAL VALUE MAY CHANGE YFACT, 1; 2000; 0 /INITIAL VALUE MAY CHANGE PLUS2, 2; 2000; 0 / /CLTXTY - ROUTINE TO CLEAR OUT LOCATIONS USED BY SCALER ROUTINE / CLTXTY, 0 FPINT FGET ZERO+1 /GET FLT. PT. ZERO FPUT NUMMER /NOW CLEAR OUT THE LOCATIONS FPUT TX FPUT TY FPUT BX FPUT BY FEXT JMP I CLTXTY /AND RETURN / /SETCLP - SET CLIPPING REGION ROUTINE / CALCULATES THE CLIPPING PARAMETERS TO BE SENT TO THE PRIMS / SETCLP, 0 /TSETTX = TX + XOFSET FPINT FGET TX FADD XOFSET FPUT NUMMER FEXT JMS FL2INT /CONVERT TO INTEGER NUMMER TAD NUMMER+2 DCA TSETTX /TSETTY = TY + YOFSET FPINT FGET TY FADD YOFSET FPUT NUMMER FEXT JMS FL2INT /CONVERT TO INTEGER NUMMER TAD NUMMER+2 DCA TSETTY /TSETBX = ((SCRBX-SCRTX)(XFACT)) + TX + XOFET FPINT FGET SCRBX+1 FSUB SCRTX+1 FMPY XFACT FADD TX FADD XOFSET FPUT NUMMER FEXT JMS FL2INT NUMMER TAD NUMMER+2 DCA TSETBX /TSETBY = ((SCRBY-SCRTY)(YFACT)) + TY + YOFET FPINT FGET SCRBY+1 FSUB SCRTY+1 FMPY YFACT FADD TY FADD YOFSET FPUT NUMMER FEXT JMS FL2INT NUMMER TAD NUMMER+2 DCA TSETBY JMP I SETCLP /EXIT PV0, 0 JMS MOVEP /ESTABLISH THE OFFSET PLUSX /+1 TO X ZERO /AND ZERO TO Y / JMS PVGEN /GO HERE TO TREAT THE NUMBERS AS RELATIVE / ISZ PV0 JMP I PV0 / /TEXT PIXEL VECTOR COMMAND PROCESSOR / TPV, 0 TAD CHAR AND (7 /MASK TO OFFSET VALUE DCA TPVBLK+1 TAD (TPVBLK /COMMAND BLOCK TO PRIMATIVES. CIF PRMFLD /FIELD OF PRIMATIVES. JMS I XPRIMS /CALL THE PRIMATIVES. JMS REQPOS /GET THE CURRENT POSITION JMP I TPV /AND EXIT TPVBLK, TPVCMD 0 /TEXT PIXEL VECTOR DIRECTION VALUE. PAGE / /WOPM SEPCIFY A PIXEL VECTOR MULTIPLIER / WOPM, 0 JMS I XGETNU /GET A NUMBER FOR THE MULTIPLIER. JMP WOPMA /ERROR IN NUMBER. JMS INT2FL /CONVERT TO FLOAT NUMMER TAD NUMMER+1 /NOW MAKE IT POSITIVE ONLY SMA CLA /SKIP IF VALUE IS NEGATIVE. JMP WOPMB /NOT NEGATIVE. FPINT FGET NUMMER FMPY MINUS1 /MAKE THE NUMBER POSITIVE FPUT NUMMER /STORE IT BACK FEXT /EXIT FLOATING POINT WOPMB, FPINT FGET NUMMER FPUT PMULT /STORE THE NEW PATTERN MULTIPLIER AS FLOATING /POINT NUMBER. FEXT JMS GENOFF /GO GENERATE THE PROPER VALUES /FOR PV STUFF. WOPMA, TAD CHAR JMP I WOPM /AND EXIT. POSX, ZBLOCK 4 /X POSITION POSY, ZBLOCK 4 /Y POSIITON PLUS1, -1; 1; 2000; 0 MINUS1, -1; 1; 6000; 0 / /CHKMAC - ROUTINE TO TEST IF A MACRO INTRODUCER IS IN LINE. /EXITS CALL+1 IF EITHER A DEFINITION OR A CLEAR MACROGRAPH / " CALL+2 IF NOT A MACRO INTRODUCER / CHKMAC, 0 TAD CHAR /GET THE CHARACTER TAD M100 /TEST FOR "@" INTRODUCER SZA CLA /SKIP IF MACRO INTRODUCER JMP CHKMC1 /TAKE THE NON-MACRO EXIT TAD CURLEV /GET CURRENT LEVEL OF EXECUTION CDF TBLFLD DCA I (LASACT /AND SAVE IT IF IT IS A REQUEST FOR A /MACRO EXECUTION CDF RGFLD JMS MACRO /GO TO THE MACRO PROCESSOR SKP /EXIT ROUTINE AS A MACRO DEFINITION OR CLEAR /MACRO WAS DONE. CHKMC1, TAD CHAR /RETURN HERE SAYS CONTINUE ON JMP I CHKMAC /EXIT / /GETHEX - MAKE A BINARY NUMBER FROM A HEX ASCII INPUT / GETHEX, 0 /GET A BINARY NUMBER FROM HEX ASCII / CLA CLL CMA RAL /ALLOW ONLY TWO HEX DIGITS PER CHARACTER DCA GETHT1 / DCA GETHT3 /MARK AS NO NUMBER YET / DCA GETHTM /CLEAR THE ACCUMULATED NUMBER / TAD CHAR /DO WE ALREADY HAVE A CHARACTER? SNA GETHE2, JMS CURLEV /IF NOT, GET A CHARACTER FROM USER JMS I XUPPER /MAKE CHARACTER UPPER-CASE IF NECESSARY TAD (-0060 /CHECK FOR DIGITS 0 - 9 SPA JMP GETHE8 /TOO LOW, CAN'T BE HEX TAD (-0011 SMA SZA JMP GETHE4 /NOT A DIGIT, GO CHECK FOR A - F / TAD (0011 /IS A DIGIT, RESTORE BINARY VALUE JMP GETHE6 / AND ACCUMULATE A NUMBER / GETHE4, TAD (-0010 /CHECK FOR LETTERS A - F SPA JMP GETHE8 /TOO LOW, CAN'T BE HEX TAD (-0005 SMA SZA JMP GETHE8 /TOO HIGH, CAN'T BE HEX / TAD (0017 /RESTORE BINARY VALUE GETHE6, DCA GETHT2 /SAVE THE NIBBLE FOR A WHILE / TAD GETHTM /GET THE PREVIOUS PARTS OF THE NUMBER R3L /SHIFT OVER BY A NIBBLE CLL RAL TAD GETHT2 /ADD IN THE NEW NIBBLE DCA GETHTM /SAVE AS ACCUMULATED NUMBER / STA /MARK AS HAVING SEEN A DIGIT DCA GETHT3 / ISZ GETHT1 /CHECK IF ENOUGH DIGITS JMP GETHE2 /LOOP FOR ANOTHER / DCA CHAR /CLEAR CHARACTER AS HAVING BEEN USED / GETHE8, CLA CLL TAD GETHTM /GET THE NUMBER ISZ GETHT1 /IF GETH1 = -1 THEN SHIFT ONE NIBBLE JMP GETHE9 R3L /SHIFT OVER BY A NIBBLE CLL RAL GETHE9, JMP I GETHEX /RETURN WITH NUMBER IN AC / / GETHTM, 0 GETHT1, 0 GETHT2, 0 GETHT3, 0 //***** COMMENTED OUT BECAUSE OF HARDWARE LIMITATIONS. // //PLANE SELECT SUBOPTION - WRITE OPTION (F) // VALID ARGUMENT IS 0-15 WITH MASKING TO THOSE 4 BITS // /WOPF, 0 / JMS I XGETNU / JMP WOPFA /ERROR EXIT. INVALID COLOR SELECTION VALUE, / /GO BACK TO PREVIOUS LEVEL AND DO ANOTHER OPTION / TAD NUMMER+2 /GET DESIRED COLOR / DCA PMASK /AND SAVE FOR LATER USE // //// CIF PRMFLD //// TAD (PLNSEL /POINTS TO THE COMMAND //// JMS I XPRIMS /SEND IT TO THE PRIMS / NOP / NOP / NOP /WOPFA, TAD CHAR /RETURN THE CHARACTER IN THE AC / JMP I WOPF // /PLNSEL, GTPLNS /PLANE SELECT COMMAND /PMASK, 0 /PLANE SELECT MASK / / /SET-UP STUFF / CIRSET, 0 TAD DXI+2 /GET THE CURRENT X POSTITION DCA CIRBLK+1 /CURRENT X VALUE TAD DYI+2 /Y POSITION DCA CIRBLK+2 JMP I CIRSET /RETURN / /DRAW TO LAST POSITION SAVED. /IF THE AC IS NOT ZERO UPON EXITING THE POP ROUTINE THEN JUST RUN DOWN THE /PARENS AND EXIT. / VCLSPS, 0 JMS POPPNT /GET THE LAST POINT SAVED. SZA CLA /SKIP IF A VALID POINT. ISZ VCLSPS JMP I VCLSPS /AND EXIT. PAGE // //COLOR MAP INITIALIZATION CODE. // // //INIMAP, 0 // TAD (CMAPTB-1 /INIT THE POINTERS // DCA 10 // TAD (-20 /16 WORDS // DCA TEMP1 // CLL CLA IAC R3L /MAKE 10 // DCA TEMP2 /STARTING MAP VALUE //INIMPA, TAD TEMP2 // AND (17 /MASK TO THE PROPER BITS. // CDF TBLFLD /TABLE FIELD // DCA I 10 // CDF RGFLD /THIS FIELD // ISZ TEMP2 /UPDATE THE PATTERN // ISZ TEMP1 /SEE IF DONE // JMP INIMPA /NOT YET. GO TRY IT AGAIN // JMP I INIMAP /AND EXIT / /SCREEN COMMAND TO REGIS /TO THE MAIN LEVEL IS DONE TO ACCEPT THE NEW COMMAND. / AC = 0 AT ENTRY / SCREEN, 0 SCRENA, JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING FOR /NEXT INCOMING CHARACTER. DCA SCRCMD /SAVE IT FOR THE LOOKUP JMS I XLOOKU /EXECUTE A LOOKUP SCRCMD, 0 SCRTAB /1ST LEVEL OPTION TABLE JMP SCRERR /GO HERE ON ERROR DCA SCRCMD /SAVE THE POINTER HERE ON RETURNING JMS I SCRCMD /AND DISPATCH TO POINTER ADDRESS / JMP SCRENA /GET NEXT CHAR AND RE-ESTABLISH THIS LEVEL / SCRERR, FINI /GO BACK TO MAIN LEVEL / /INPUT A PATTERN MULTIPLIER VALUE / WOPPM, 0 JMS I XGETNU /GET THE MULTIPLIER VALUE JMP WOPPME /ERROR, JUST EXIT WITH NO CHANGE TAD NUMMER+2 DCA PATMUL WOPPME, TAD CHAR JMP I WOPPM /EXIT. / /CLEANUP - ROUTINE TO CLEANUP UPON RE-ENTERING AFTER A TEXT OR MACRO CMD. / CLEANU, 0 CLEAN1, TAD TYTETM /NOW CHECK FOR PREV. ACTIVE TEXT SZA CLA JMS RSTPOS /HAD BEEN ACTIVE, GO RESTORE CURSOR BLOCK DCA TYTETM DCA SEMIOK / JMP I CLEANU /RETURN / CLEAN2, CIF TBLFLD /CHANGE TO FIELD 5 JMS NULLGR /GO CLEAR ALL MARCO'S JMP CLEAN1 /RETURN TO NORMAL PROCESSING / /INT2FL - INTEGER TO FLOATING POINT /CONVERT THE CONTENTS OF THE ADDRESS AT CALL+1 INTO FLOATING POINT FORMAT / INT2FL, 0 CLL CLA IAC /AC=1 TAD I INT2FL /GET THE POINTER DCA INT2TM /SAVE IT TAD I INT2TM /GET THE ACTUAL VALUE DCA INT2TM+2 /AND SAVE IT FOR CONVERSION ISZ INT2TM /POINT TO THE LOW ORDER PORTION OF THE INTEGER TAD I INT2TM DCA INT2TM+3 CLA CLL CMA RAL / AC = -2 TAD INT2TM DCA INT2TM /SAVE THE ACTUAL ADDRESS OF THE STORAGE FPINT /CALL FP INTERPRETER FGET INT2TM+1 FEXT TAD K27 /NEEDED TO NORMALIZE DCA EXP FPINT FNOR FPUT I INT2TM /SAVE IT TO WHERE IT CAME FROM FEXT ISZ INT2FL /UPDATE THE RETURN JMP I INT2FL /AND THEN RETURN / INT2TM, ZBLOCK 4 /DOVEC - EXECUTE THE VECTOR COMMAND BY CALLING THE PRIMATIVE PACKAGE / DOVEC, 0 JMS SCAL TAD DXI+2 /GET THE CURRENT X POSTITION DCA VBX /CURRENT X VALUE TAD DYI+2 /Y POSITION DCA VBY CIF PRMFLD TAD (VECBLK /POSITION BLOCK DATA JMS I XPRIMS /TO THE PRIMATIVES JMP I DOVEC / /DOTXT - EXECUTE THE TEXT COMMAND BY CALLING THE PRIMATIVE PACKAGE / AND LEAVE THE "TXFLAG" = NO CHANGE WHEN FINISHED. / DOTXT, 0 CIF PRMFLD TAD (TXTBLK /TEXT BLOCK DATA JMS I XPRIMS /TO THE PRIMATIVES TAD TXFLAG /GET THE TEXT FLAG SPA SNA /SKIP IF PLUS 1 OR GREATER DCA TCHNGE /SAVE FLAG IF 0 FOR BASELINE OR -1 FOR ESCPMT CLL CLA IAC /AC=1 DCA TXFLAG /SET TEXT BLOCK TO = NO CHANGE JMP I DOTXT /RETURN / TUSBKT - TEXT USER SCALING BRACKETED PAIR HANDLING / TUSBKT, 0 / JMS BKTPAR /GET A PAIR OF VALUES POSX POSY / TAD POSX /ENSURE NEGATIVE VALUES SEEN AS ZERO SPA CLA DCA POSX / TAD POSY SPA CLA DCA POSY / FPINT /START FLOATING POINT OPERATIONS FGET POSX+1 /GET 'X' VALUE FMPY S /SCALE FOR USER COORDINATES FPUT POSX+1 /PUT IT BACK FGET POSY+1 /SAME FOR 'Y' VALUE FMPY S FPUT POSY+1 FEXT /END OF FLOATING POINT STUFF / JMS FL2INT /FIX 'X' POSX+1 / JMS FL2INT /FIX 'Y' POSY+1 / JMP I TUSBKT /RETURN PAGE / /CURVE ARC FUNCTION. /DRAWS AN ARC WITH THE SPECIFIED RADIUS. IF THE RADIUS IS GREATER THAN /-+ 360 THEN A COMPLETE CIRCLE IS DRAWN REGARDLESS. / CURARC, 0 FPINP /GET THE FLOATING POINT NUMBER FPINT FPUT ARCVAL /STORE THE VALUE FEXT /EXIT INTERPRETER. TAD ARCVAL+1 /SEE IF THE VALUE IS NEGATIVE TO CHECK FOR -360 SMA CLA /SKIP IF VALUE IS NEGATIVE. JMP ARC1 /NO. ON TO POSITIVE CHECKING. FPINT /FLOATING INTERPRETER FGET ARCVAL /VALUE TO FPAC FADD K360 /FLOAT 360 FPUT TEMPO+1 /GET IT BACK FEXT TAD TEMPO+2 /SEE IF STILL NEGATIVE. (INVALID NUMBER) SMA CLA /SKIP IF OUT OF RANGE JMP ARC2 /VALID NUMBER FPINT FGET K360 /SET IT TO MINUS 360 DEGREES. FMPY MINUS1+1 FPUT ARCVAL FEXT JMP ARC2 ARC1, FPINT /FLOATING INTERPRETER FGET ARCVAL /VALUE TO FPAC FSUB K360 /FLOAT 360 FPUT TEMPO+1 /GET IT BACK FEXT TAD TEMPO+2 /SEE IF STILL NEGATIVE. (INVALID NUMBER) SPA SNA CLA /SKIP IF OUT OF RANGE JMP ARC2 /VALID NUMBER FPINT FGET K360 /SET IT TO MINUS 360 DEGREES. FPUT ARCVAL FEXT ARC2, JMS FL2INT /FLOAT TO INTEGER ARCVAL /CONVERT THIS TO INTEGER TAD ARCVAL+2 DCA CIRBLK+3 /SAVE THE ARC VALUE. TAD CHAR /RETURN CHARACTER PREVIOUS LEVEL JMP I CURARC /AND EXIT. ARCVAL, ZBLOCK 3 /THREE WORDS FOR IT. / /BEGIN UNBOUNDED CURVE / UNBCUR, 0 TAD (CRVBGN /SET UP START UNBOUNDED CURVE COMMAND DCA CIRSTA /SAVE IT JMS STACUR /START CURVE COMMAND TO PRIMATIVES. JMP I UNBCUR /AND EXIT ROUTINE / /BEGIN BOUNDED CURVE. / BOUCUR, 0 TAD (CRVCLS /SET UP START UNBOUNDED CURVE COMMAND DCA CIRSTA /SAVE IT JMS STACUR /START CURVE COMMAND TO PRIMATIVES. JMP I BOUCUR /AND EXIT ROUTINE / /START A BOUNDED SEQUENCE. / STACUR, 0 JMS SCAL /SCALE THE CURRENT STUFF TAD DXI+2 DCA CIRSTA+1 /STARTING X TAD DYI+2 DCA CIRSTA+2 /STARTING Y TAD (CRVCNT-DRWARC /OFFSET VALUE FOR CURVE DRAW ROUTINE DCA CURACT /SAVE IT TAD (CIRSTA /CURVE START FUNCTION CIF PRMFLD /PRIMATIVE FIELD JMS I XPRIMS JMP I STACUR /EXIT ROUTINE CIRSTA, 0 /DEFINED AS NEEDED 0 0 / ENDBLK, CRVEND /END CURVE BLOCK. /THE RANGE CHECK ROUTINE HAS BEEN REMOVED TO MAKE ROOM FOR GENERATING THE /CORRECT OFFSET WITH PIXEL VECTOR COMMANDS (P0 OR V0) / /RANGE - CHECK THE INTEGER AT NUMBER+2 TO SEE THAT IT IS BETWEEN 0 AND THE 12 BIT / INTEGER AT CALL+1, WHERE CALL+1 = THE MAXIMUM SPECIFIED VALUE. IF GREATER / THEN MODULO SUBTRACTION IS PERFORMED UNTIL THE VALUE IS LESS THAN THE / MAX. VALUE SECIFIED AND THIS VALUE IS RETURNED TO NUMBER+2 WITH ITS / ORIGINAL SIGN. /RANGE, 0 / CLA / TAD I (RANGE /GET THE MAXIMUM VALUE ALLOWED / DCA TEMPO /SAVE HERE FOR USE / ISZ RANGE /BUMP THE RETURN TO CALL+2 /CHECK SIGN OF NUMMER+2 / TAD NUMMER+2 /GET THE INTEGER / SMA CLA /SKIP IF NEGATIVE / JMP RANGE2 /ELSE PROCESS THE POSITIVE VALUE / / TAD NUMMER+2 /GET THE VALUE BACK /RANGE1, TAD TEMPO /GET THE NEGATIVE NUMBER / SPA /IF STILL POSITIVE IT'S OK / JMP RANGE1 /OTHERWISE SUBTRACT UNTIL IT IS / CMA IAC /MAKE IT A NEGATIVE VALUE / DCA NUMMER+2 /AND THEN SAVE IT FOR USE LATER / JMP RANGEX /THEN EXIT / /RANGE2, TAD TEMPO /GET THE MAX VALUE / CMA IAC /FORM 2'S COMPLEMENT FOR SUBTRACTION / DCA TEMPO /AND SAVE IT / TAD NUMMER+2 /GET THE VALUE TO BE CHECKED /RANGE3, TAD TEMPO /ADD THE 2'S COMPLEMENT OF THE MAX VALUE / SMA /SKIP IF NEGATIVE / JMP RANGE3 /OR SUBTRACT THE VALUE UNTIL IT IS / CMA IAC /2'S COMPLEMENT TO GET IT BACK TO ORIGINAL SIGN / DCA NUMMER+2 /SAVE FOR LATER USE / /RANGEX, JMP I RANGE /RETURN / /ROUTINE TO GENERATE THE PROPER VALUES OF OFFSET FOR PV FUNCTIONS / GENOFB, 0 GENOFF, 0 TAD XFACT+1 /CALCUALTE THE PLUS AND MINUS X VALUE BASED /ON THE SIGN OF XOFFSET VALUE. SMA CLA /SKIP IF SIGN IS NEGATIVE. SAYS THE OFFSET WILL /BE NEGATIVE AS WELL JMP GENOFA /NOT NEGATIVE JUST MOVE IN A PLUS AND MINUS ONE TAD (MINUS1+1 SKP GENOFA, TAD (PLUS1+1 DCA GENOFB /SAVE THE REAL OFFSET VALUE FPINT /NOW CALL THE FLOATING POINT UNIT FGET I GENOFB /GET THE OFFSET VALUE FMPY PLUS1+1 /CALCULATE THE REAL VALUE FMPY PMULT /FOR THE REAL VALUE FPUT PLUSX+1 FGET I GENOFB /GET BACK THE OFFSET FMPY MINUS1+1 FMPY PMULT /FOR THE REAL VALUE FPUT MINUSX+1 FEXT /DONE WITH THE X VALUE / /NOW GENERATE THE Y OFFSETS. / TAD YFACT+1 /CALCUALTE THE PLUS AND MINUS Y VALUE BASED /ON THE SIGN OF YOFFSET VALUE. SMA CLA /SKIP IF SIGN IS NEGATIVE. SAYS THE OFFSET WILL /BE NEGATIVE AS WELL JMP GENOFC /NOT NEGATIVE JUST MOVE IN A PLUS AND MINUS ONE TAD (MINUS1+1 SKP GENOFC, TAD (PLUS1+1 DCA GENOFB /SAVE THE REAL OFFSET VALUE FPINT /NOW CALL THE FLOATING POINT UNIT FGET I GENOFB /GET THE OFFSET VALUE FMPY PLUS1+1 /CALCULATE THE REAL VALUE FMPY PMULT /FOR THE REAL VALUE FPUT PLUSY+1 FGET I GENOFB /GET BACK THE OFFSET FMPY MINUS1+1 FMPY PMULT /FOR THE REAL VALUE FPUT MINUSY+1 FEXT /DONE WITH THE X VALUE JMP I GENOFF /EXIT THE ROUTINE. PAGE / /HLS SUPPORT ROUTINES. / CLRH, 0 DCA HLSSEE JMS I XGETNU /GET A NEW VALUE JMP CLRH8 /INVALID NUMBER TAD NUMMER+2 /SAVE THE NUMMER RETURNED DCA HUENUM /SAVE THE NEW VALUE CLRH8, TAD CHAR /RETURN THE CHARACTER JMP I CLRH CLRL, 0 DCA HLSSEE JMS I XGETNU /GET A NEW VALUE JMP CLRL8 /INVALID NUMBER TAD NUMMER+2 /SAVE THE NUMMER RETURNED DCA LIGNUM /SAVE THE NEW VALUE CLRL8, TAD CHAR /RETURN THE CHARACTER JMP I CLRL CLRS, 0 DCA HLSSEE JMS I XGETNU /GET A NEW VALUE JMP CLRS8 /INVALID NUMBER TAD NUMMER+2 /SAVE THE NUMMER RETURNED DCA SATNUM /SAVE THE NEW VALUE CLRS8, TAD CHAR /RETURN THE CHARACTER JMP I CLRS / /HLS TO COLOR ROUTINE. / HLSCOL, 0 CLL CLA HLSCLI, TAD LIGNUM /LIGHTNESS VALUE TAD (-16 SPA SNA CLA /IF LESS THAN OR EQUAL TO 14 THEN VALUE = BLACK JMP HLSCLA TAD LIGNUM /HIGH END. IF GREATER THAN 86 THEN MAKE IT /WHITE. TAD (-126 SPA CLA JMP HLSCLB TAD (17 /SET TO MAX JMP HLSCLA /AND PROCESS IT. HLSCLB, TAD SATNUM /GET THE SAVED VALUE TAD (-41 SMA SZA CLA JMP HLSCLK TAD LIGNUM TAD (-52 SMA SZA CLA TAD (5 TAD (7 JMP HLSCLA HLSCLK, TAD LIGNUM /NOW MAKE THE COLOR VALUE TO USE. TAD (-52 SMA CLA /SKIP IF INTENSITY BIT TO BE SET. CLL CLA IAC R3L /AC=10 TO ASSERT INTENSITY BIT. DCA HLSCTM /SAVE IT FOR LATER USE TAD SATNUM /NOW DETERMINE THE SATURATION VALUE. TAD (-41 /COVER THE CASE OF GREY SCALES. SMA CLA JMP HLSCLC TAD (7 /WHITE TAD HLSCTM /ADD IN THE INTENSITY BIT. JMP HLSCLA /GO PROCESS IT. HLSCLC, TAD HUENUM /GET THE HUE VALUE TAD (35 HLSCLE, SPA JMP HLSCLD TAD (-550 /-360 DEGREES. JMP HLSCLE /HUE PLUS 29(MOD 360) HLSCLD, SMA JMP HLSCLF TAD (550 /+360 JMP HLSCLD /STAY IN THE LOOP FOR MOD 360. HLSCLF, DCA HLSCT1 /SAVE THE HLS VALUE FOR THE LOOKUP. DCA HLSCT2 /ASSUME DIVIDE BY 60. = 0 TAD HLSCT1 / HLSCLH, TAD (-74 /SUBTRACT 60 SPA /SEE IF MOD DONE YET JMP HLSCLG /DONE. CONTINUE THE PROCESSING. ISZ HLSCT2 /UPDATE THE COUNTER FOR COLOR VALUE NOP /IN CASE OF OVER FLOW JMP HLSCLH /AND TRY AGAIN. HLSCLG, CLL CLA /BECAUSE THE AC MAY NOT BE CLEAR TAD HLSCT2 /((HUE+30)MOD360)DIV 60 TAD (TABLEB /OFFSET TO GET THE REAL COLOR VALUE DCA HLSCT2 CDF TBLFLD TAD I HLSCT2 CDF RGFLD /HOME FIELD TAD HLSCTM HLSCLA, DCA SAVCLR JMP I HLSCOL /AND EXIT. / /TEMPS USED BY HLS ROUTINE. / HLSCTM, 0 HLSCT1, 0 HLSCT2, 0 / /CONVERT THE CHARACTER IN THE AC TO SEVEN BIT AND SAVE IN "CHAR". RETURN /WITH THE CHARACTER IN THE AC IN SEVEN BIT MODE. / MAKE7, 0 AND (177 /MASK TO SEVEN BITS DCA CHAR TAD CHAR JMP I MAKE7 /EXIT WITH CHARACTER IN AC PAGE / /TOPS - TEXT SIZE OPTION / TOPS, 0 JMS I XGETNU /GET THE INPUT JMP TOPSEX /NON-NUMERIC, SO EXIT TAD NUMMER+2 /CHECK FOR NEGATIVE NUMBERS SPA CLA JMP TOPS4A /NEGATIVE, GO SAVE A ZERO VALUE TOPS1, TAD NUMMER+2 /CHECK FOR NUMBER > 16 DECIMAL TAD (-21 SPA CLA JMP TOPS4 /VALID NUMBER, GO USE IT CLA CLL IAC /TOO HIGH, FORCE DEFAULT TO ONE JMP TOPS4A TOPS4, TAD NUMMER+2 /GET THE NUMBER BACK TOPS4A, DCA TXSBLK / TOPS3, TAD TXSBLK TAD (SZTBL /FORM AN INDEX INTO THE SIZE TABLE DCA SAVS1 TAD I SAVS1 /GET THE STARTING ADDR DCA SAVS1 /THIS IS THE "FROM" POINTER TAD (TCELLH DCA SAVS2 /THIS IS THE "TO" POINTER INTO THE TEXT CMD BLK TAD (-4 /WANT TO DO 4 WORDS DCA SAVS3 /SAVE FOR COUNTING JMS SWAPIT /GO SWAP THE LOCATIONS / CLL CLA DCA TXFLAG /SET FLAG TO BASELINE INDICATION = 0000 TAD TCHRAN /GET THE CELL ROTATION DCA TBASES /AND PUT IN THE BASELINE ANGLE TOPS5, JMS DOTXT /SEND IT TO THE PRIMS TOPSEX, CLA TAD CHAR /GET THE CHAR BACK TAD MLBRKT /SEE IF CHAR IS AN OPENING BRACKET "[" SZA CLA /SKIP IF YES JMP TOPSE1 /IT WASN'T SO JUST EXIT /OTHERWISE GET THE DESIRED CELL WIDTH AND HEIGHT JMS TUSBKT /NOW DO DEFAULT PARAMETER CHECKING TAD POSX+3 /GET THE NUMERAL SZA DCA TCELLW TAD POSY+3 SZA DCA TCELLH JMP TOPS5 /SEND THE TEXT BLOCK TO THE PRIMS TOPSE1, TAD CHAR /GET THE CHARACTER WHICH TERMINATED THE INPUT JMP I TOPS /RETURN / /TEXT BEGIN - SAVE THE TXTBLK DATA / TOPB, 0 TAD (TXTBLK+1 /FROM THIS ADDRESS DCA SAVS1 TAD (TXSAVE /TO THIS BLOCK DCA SAVS2 TAD (-13 /THIS MANY WORDS DCA SAVS3 JMS SWAPIT /DO IT JMP I TOPB /RETURN / /TEXT END - RESTORE TXTBLK DATA / TOPE, 0 TAD (TXSAVE /FROM THIS BLOCK DCA SAVS1 TAD (TXTBLK+1 /TO THIS BLOCK DCA SAVS2 TAD (-13 /THIS MANY WORDS DCA SAVS3 JMS SWAPIT /DO IT TAD TCHNGE /GET THE CHANGE FLAG DCA TXFLAG /AND UPDATE THE TEXT FLAG WITH IT JMS DOTXT /SEND IT TO THE PRIMS JMP I TOPE / /ROUTINE TO SWAP DATA FROM ONE BLOCK TO ANOTHER / SWAPIT, 0 SWAPS, TAD I SAVS1 /FROM THIS ADDR DCA I SAVS2 /TO HERE ISZ SAVS1 /BUMP PTRS AND COUNTER ISZ SAVS2 ISZ SAVS3 JMP SWAPS /LOOP UNTIL DONE JMP I SWAPIT /DONE, SO RETURN / /TEXT SAVE BLOCK FOR TEXT BEGIN/END DATA / TXSAVE, ZBLOCK 13 /FOR SAVING TXTBLK+1 TO TXTBLK+13 / / TXSBLK, 0 SAVS1, 0 SAVS2, 0 SAVS3, 0 SZTBL, SIZE0 SIZE1 SIZE2 SIZE3 SIZE4 SIZE5 SIZE6 SIZE7 SIZE8 SIZE9 SIZE10 SIZE11 SIZE12 SIZE13 SIZE14 SIZE15 SIZE16 PAGE / /TOPM - TEXT OPTION M(ULTIPLIER) COMMAND / TOPM, 0 JMS CURLEV /ESTABLISH THEIS LEVEL TAD MLBRKT /SEE IF A LEFT BRACKET "[" SZA CLA JMP TOPMEX /IT'S NOT SO EXIT / JMS TOPBKT /GO GET THE PARAMETERS JMS INT2FL /HAVE TO CONVERT BACK TO FLT. PT. POSX+1 JMS INT2FL POSY+1 /NOW DO THE MULTIPLICATION FPINT /ENTER FLOATING POINT INTERPRETER FGET POSX+1 FMPY KFP8 /MULTIPLY BY 8(DECIMAL) FPUT POSX+1 /SAVE IT FGET POSY+1 FMPY KFP10 /MULTIPLY BY 10(DECIMAL) FPUT POSY+1 FEXT /EXIT FLOATING POINT /CONVERT BACK TO INTEGERS AND SAVE IT INTO TEXT BLOCK JMS FL2INT /CONVERT BACK TO INTEGER POSX+1 JMS FL2INT POSY+1 TAD POSX+3 /GET AN INTEGER SNA /IF ZERO TAD (10 /FORCE IT TO DEFAULT TO 8(DECIMAL) DCA TUNITW /SAVE THE WIDTH TAD POSY+3 /GET THE NEXT INTEGER SNA /IF ZERO TAD (24 /DEFAULT TO 20(DECIMAL) DCA TUNITH /SAVE THE HEIGHT JMS DOTXT /CALL THE PRIMS TOPMEX, TAD CHAR /GET BACK THE CHARACTER WHICH TERMINATED INPUT JMP I TOPM /AND RETURN TO PREVIOUS LEVEL / /TOPU - TEXT OPTION 'U' COMMAND / TOPU, 0 JMS CURLEV /ESTABLISH THEIS LEVEL TAD MLBRKT /SEE IF A LEFT BRACKET "[" SZA CLA JMP TOPUEX /IT'S NOT SO EXIT / JMS TUSBKT /CHECK FOR ZERO OR MISSING INPUT PARAMETERS TAD POSX+3 /GET THE INTEGER SZA DCA TUNITW /SAVE INTO TEXT BLOCK TAD POSY+3 /GET THE INTEGER SZA DCA TUNITH /SAVE INTO TEXT BLOCK JMS DOTXT /SEND DATA TO THE PRIMS TOPUEX, TAD CHAR /GET CHAR THAT TERMINATED INPUT JMP I TOPU /AND RETURN TO PREVIOUS LEVEL /TOPBKT - ROUTINE TO GET A BRACKETED PAIR ARGUMENT INTO POSX AND POSY / AS INTEGERS / TOPBKT, 0 JMS BKTPAR /CALL BRACKETED PAIR ROUTINE POSX POSY JMS FL2INT /CONVERT TO INTEGER POSX+1 JMS FL2INT POSY+1 JMP I TOPBKT /EXIT / /TOPH -TEXT OPTION H(EIGHT) COMMAND / TOPH, 0 JMS I XGETNU /GET THE INPUT JMP TOPHEX /NON-NUMERIC, SO EXIT TAD NUMMER+2 /CHECK FOR NEGATIVE NUMBERS SMA CLA JMP TOPH1 /ZERO OR POSITVE TOPH2, CLL CLA IAC /FORCE DEFAULT OF HEIGHT 1 DCA TXSBLK JMP TOPH3 TOPH1, TAD NUMMER+2 /CHECK FOR NUMBER > 16 DECIMAL TAD (-21 SMA CLA JMP TOPH2 /NUMBER WAS GREATER THAN 16., SO SAVE A ONE TOPH3, JMS INT2FL /CONVERT BACK TO F.P. NOTATION NUMMER FPINT /ENTER FLT. PT. INTERPRETER FGET NUMMER /GET THE NUMER TO BE ACTED ON FMPY KFP10 /MULTIPLY BY 10 DECIMAL FPUT NUMMER /SAVE IT FEXT /EXIT FLOATING POINT /CONVERT BACK TO AN INTEGER AND SAVE IN THE UNIT AND CELL HEIGHT JMS FL2INT NUMMER TAD NUMMER+2 /GET THE INTEGER DCA TCELLH /SAVE HERE TAD NUMMER+2 /GET IT AGAIN DCA TUNITH /SAVE HERE ALSO JMS DOTXT /SEND IT TO THE PRIMS TOPHEX, TAD CHAR /GET THE CHARACTER WHICH TERMINATED THE INPUT JMP I TOPH /RETURN KFP8, 4; 2000; 0 /FLOATING POINT CONSTANT FOR 8 (DECIMAL) KFP10, 4; 2400; 0 /FLOATING POINT CONSTANT FOR 10 (DECIMAL) / / / REPORT CURSOR POSITION - JUST SENDS 060 015 FOR NOW / ROPP, 0 TAD (060 /ASCII FOR ZERO DCA RPTBLK+1 /PUT IN BLOCK TO SEND STA /SETUP A -1 DCA RPTBLK+2 /TO END THE REPSONSE TAD (RPTBLK DCA REPLY /TELL VT125 MODULE THERE'S DATA WAITING JMP I ROPP /RETURN RPTBLK, 7775 /CURSOR POSITION REPORT BLOCK ZBLOCK 12 PAGE / SIZE0, 12; 11; 12; 10 SIZE1, 24; 11; 24; 10 SIZE2, 36; 22; 36; 20 SIZE3, 55; 33; 50; 30 SIZE4, 74; 44; 74; 40 SIZE5, 113; 55; 106; 50 SIZE6, 132; 66; 132; 60 SIZE7, 151; 77; 144; 70 SIZE8, 170; 110; 170; 100 SIZE9, 207; 121; 202; 110 SIZE10, 226; 132; 226; 120 SIZE11, 245; 143; 240; 130 SIZE12, 264; 154; 264; 140 SIZE13, 276; 165; 276; 150 SIZE14, 322; 176; 322; 160 SIZE15, 341; 207; 334; 170 SIZE16, 360; 220; 360; 200 / / / POSITION STACK - SIXTEEN DECIMAL POSITIONS DEEP / STACK, ZBLOCK 120 /FLOATING POINT PACKAGE / /THIS PACKAGE HANDLES 3 WORD FLOATING POINT WORDS. / FPNT, 0 FPNTA, CLA CLL DCA OVER1 DCA OVER2 TAD I FPNT DCA JUMP TAD JUMP AND PAGENO /PAGE 0 ?? SNA CLA JMP .+3 /YES TAD MASK5 /NO - GET PAGE BITS AND FPNT DCA ADDRS TAD MASK7 /GET 7 BIT ADDRESS AND JUMP TAD ADDRS DCA ADDRS TAD INDRCT /BIT3 = 1 ?? AND JUMP SNA CLA JMP LOOP01 TAD I ADDRS /YES - DEFER DCA ADDRS LOOP01, ISZ FPNT TAD I ADDRS DCA EX1 /EXPONENT TAD ADDRS DCA SAVE ISZ SAVE TAD I SAVE /HIGH ORDER DCA HIGH1 ISZ SAVE TAD I SAVE DCA LOW1 /LOWER BITS TAD JUMP CLL RTL RTL AND MASK3 /LOOK-UP ON TABLE TAD TABLE DCA JUMP2 TAD I JUMP2 DCA JUMP2 JMS I JUMP2 /EXECUTE JMP FPNTA /GET NEXT JUMP, 0 JUMP2, 0 ADDRS, 0 SAVE, 0 MASK3, 0017 PAGENO, 0200 INDRCT, 0400 MASK5, 7600 MASK7, 0177 TABLE, FPTBLE /FLOATING GET = 5000 / FLGT, 0 FLGTA, TAD EX1 DCA EXP TAD HIGH1 DCA HORDER TAD LOW1 DCA LORDER JMP FPNTA /FLOATING EXIT OR SUBROUTINE = 00XX FEXIT, 0 JMP I FPNT / /WOPN - WRITE OPTION NEGATE / WOPN, 0 DCA NEGBLK+1 /CLEAR JMS I XGETNU /SEE IF NON-ZERO JMP WOPNA / = 0 SO GO CLEAR NEGATE MODE TAD NUMMER+2 DCA NEGBLK+1 /SAVE IN COMMAND BLOCK WOPNA, CIF PRMFLD TAD (NEGBLK JMS I XPRIMS TAD CHAR /GET THE CHARACTER BACK THAT TERMINATED INPUT JMP I WOPN /AND THEN RETURN / NEGBLK, GTNEGM 0 / / /INPUT A DECIMAL DIGIT. RETURN CALL +2 AND AC= NUMBER IF VALID /AND CALL PLUS ONE AC=0 IF NOT VALID. GETDIG, 0 JMS CURLEV /THIS LEVEL FOR PROCESSING TAD (-60 /NOW SEE IF IT IS NUMERIC OR NOT. SPA /SKIP IF STILL VALID JMP GETDGC /NOT NUMERIC TAD (-12 /HIGH END +1 SMA /SKIP IF STILL VALID. JMP GETDGC /TAKE THE EXIT. COMMAND TERMINATED. TAD (12 /MAKE THE CHARACTER BINARY ISZ GETDIG JMP I GETDIG GETDGC, CLL CLA JMP I GETDIG /FLOATING PUT = 6000 FLPT, 0 TAD EXP DCA I ADDRS TAD HORDER ISZ ADDRS DCA I ADDRS TAD LORDER ISZ ADDRS DCA I ADDRS JMP FPNTA *6000 / /FLOATING ADD = 1000 / FLAD, 0 JMS ALIGN /ALIGN WORDS JMP I FLAD /NO ALIGNMENT JMS SCALE CLA CLL /TRIPLE ADDITION TAD OVER1 TAD OVER2 DCA OVER2 RAL /CARRY TAD LOW1 TAD LORDER DCA LORDER RAL TAD HIGH1 TAD HORDER DCA HORDER JMS I NORMAL JMP I FLAD / /FLOATING SUBTRACT = 2000 / FLSU, 0 JMS I OPMINS /NEGATE OPERAND JMS FLAD JMP I FLSU / /ALIGN BIANRY POINTS / ALIGN, 0 TAD HORDER SZA CLA JMP ALIGNA TAD EX1 /C(FAC) = 0 DCA EXP JMP DONE ALIGNA, TAD HIGH1 SNA CLA JMP I ALIGN /OPERAND = 0 TAD EX1 CMA IAC TAD EXP SNA JMP DONE /EXPONENTS EQUAL - EXIT SMA CMA IAC DCA AMOUNT /NUMBER OF PLACES TAD AMOUNT TAD TEST1 SPA CLA JMP NOGO /NO SHIFTING POSSIBLE TAD EX1 CMA IAC TAD EXP RAL SNL CLA TAD TCON1 /SHIFT OPERAND RIGHT TAD TCON2 /SHIFT FAC RIGHT DCA POINT JMS I POINT ISZ AMOUNT JMP .-2 DONE, ISZ ALIGN JMP I ALIGN NOGO, TAD EX1 CMA IAC TAD EXP SMA CLA JMP I ALIGN JMP I .+1 FLGTA POINT, 0 AMOUNT, 0 NORMAL, FNORM OPMINS, OPNEG TEST1, 0030 TCON1, SHFTOP-SHFTAC TCON2, SHFTAC / /SCALE BOTH RIGHT / SCALE, 0 JMS SHFTOP JMS SHFTAC JMP I SCALE / /SCALE FLOATING AC RIGHT / SHFTAC, 0 CLA CLL TAD HORDER SPA CML RAR DCA HORDER TAD LORDER RAR DCA LORDER TAD OVER2 RAR DCA OVER2 ISZ EXP NOP JMP I SHFTAC / /SCALE OPERAND RIGHT / SHFTOP, 0 CLA CLL TAD HIGH1 SPA CML RAR DCA HIGH1 TAD LOW1 RAR DCA LOW1 TAD OVER1 RAR DCA OVER1 ISZ EX1 NOP JMP I SHFTOP SNDMUL, 0 TAD PATMUL DCA PTMUL /SAVE THE CURRENT PATTERN VALUE TAD (MULBLK /LINE TEXTURE PATTERN CIF PRMFLD /TO THE PRIMATIVES JMS I XPRIMS /CALL THEM JMP I SNDMUL /EXIT MULBLK, GTLMLT /FUNCTION 36 PTMUL, 0 / ROPE, 0 STA /SETUP A -1 DCA RPTBLK+1 /TO END THE REPSONSE TAD (RPTBLK DCA REPLY /TELL VT125 MODULE THERE'S DATA WAITING JMP I ROPE /RETURN / /NORMALIZE FLOATING POINT ACCUMULATOR / *6200 FNORM, 0 CLA CLL DCA MP1 /0 # OF SHIFTS DCA MP3 /RESET SWITCH TAD HORDER SPA /INPUT < 0 ISZ MP3 /YES, SET SWITCH SZA CLA /FAC = 0 ? JMP GO6 /NO TAD LORDER SZA CLA JMP GO6 /NO TAD OVER2 SZA CLA JMP GO6 /NO DCA EXP /YES JMP I FNORM /EXIT GO6, TAD MP3 SZA CLA /WAS INPUT < 0 JMS ACNEG /YES SHIFT, TAD HORDER CLL RAL SPA CLA /TOO FAR ? JMP NOREXT /YES, EXIT ROUTINE TAD OVER2 /NO CLL RAL DCA OVER2 /SHIFT LEFT TAD LORDER RAL DCA LORDER TAD HORDER RAL DCA HORDER ISZ MP1 /ADD 1 TO COUNT JMP SHIFT /CONTINUE NOREXT, TAD MP1 /SUBTRACT COUNT FROM EXPONENT CMA IAC TAD EXP DCA EXP TAD MP3 /WAS INPUT < 0 ? SZA CLA JMS ACNEG /YES JMP I FNORM /EXIT / /NEGATE FLOATING AC / ACNEG, 0 CLA CLL TAD OVER2 CMA IAC DCA OVER2 TAD LORDER CMA SZL CLL IAC DCA LORDER TAD HORDER CMA SZL CLL IAC DCA HORDER JMP I ACNEG /NEGATE OPERAND OPNEG, 0 CLA CLL TAD OVER1 CMA IAC DCA OVER1 TAD LOW1 CMA SZL CLL IAC DCA LOW1 TAD HIGH1 CMA SZL CLL IAC DCA HIGH1 JMP I OPNEG MULTIP, 0 DCA MP1 DCA MPSCON TAD THIR DCA MP3 CLL MULTA, TAD MP1 RAR DCA MP1 TAD MPSCON SNL JMP .+3 CLL TAD MP2CON RAR DCA MPSCON ISZ MP3 JMP MULTA TAD MP1 RAR CLL JMP I MULTIP MP1, 0 MP2CON, 0 MP3, 0 MPSCON, 0 THIR, -14 FMULT1, FMULT FLMY, 0 JMS I FMULT1 JMS FNORM DCA OVER2 ISZ I SIGN1 JMP I FLMY JMS ACNEG JMP I FLMY SIGN1, SGNTST SVTBLK, SVTXTO / / FPTBLE, FEXIT FLAD FLSU FLMY FLDV FLGT FLPT FNORM *6400 / /FLOATING MULTIPLY / FMULT, 0 CLA IAC TAD EX1 TAD EXP DCA EXP /ADD EXPONENTS TAD M100 DCA I SGNSW /SET UP SIGN ROUTINE JMS I SIGNP / AND GO THERE TAD LOW1 DCA I MP2 TAD LORDER /C*F JMS I DMULT CLA TAD I MP5 DCA OVER2 TAD HORDER DCA I MP2 TAD LOW1 /A*F JMS I DMULT TAD OVER2 DCA OVER2 RAL TAD I MP5 DCA MUL3 RAL DCA MUL2 TAD HIGH1 DCA I MP2 TAD LORDER /D*C JMS I DMULT TAD OVER2 DCA OVER2 RAL TAD MUL3 TAD I MP5 DCA MUL3 RAL TAD MUL2 DCA MUL2 TAD HORDER DCA I MP2 TAD HIGH1 /A*D JMS I DMULT TAD MUL3 DCA LORDER RAL TAD MUL2 TAD I MP5 DCA HORDER JMP I FMULT / MUL2, 0 MUL3, 0 SGNSW, SGNSWT SIGNP, SIGNCL DMULT, MULTIP MP2, MP2CON MP5, MPSCON / /REQPOS - REQUEST POSITION ROUTINE / REQPOS, 0 CIF PRMFLD TAD (RQBLK /REQUEST CURRENT POSITION JMS I XPRIMS DCA DXI+1 /CLEAR THESE PRIOR TO USING THEM DCA DYI+1 TAD RQBLK+1 DCA DXI+2 /UPDATE CURRENT X POSITION TAD RQBLK+2 DCA DYI+2 /UPDATE CURRENT Y POSITION JMS MOVDXY /UPDATE CURX AND CURY ALSO JMP I REQPOS /RETURN RQBLK, RETPOS /REQUEST POSITION FROM PRIMITIVES COMMAND BLOCK 0 0 / / / /FLOATING DIVIDE = 4000 / *6600 FLDV, 0 TAD EX1 /SUBTRACT EXPONENTS CMA IAC TAD EXP IAC DCA EXP TAD SPACLA DCA SGNSWT JMS SIGNCL /SET UP SIGNS TAD HIGH1 SNA CLA /DIVISOR = 0 ?? JMP DVER /YES, ERROR CLA CLL DCA QUOL TAD MIF DCA DIVCNT JMP DVX DV3, TAD LORDER RAL DCA LORDER TAD HORDER RAL DCA HORDER DVX, TAD LOW1 /PARTIAL SUBTRACT TAD LORDER DCA DTEM1 RAL TAD HIGH1 TAD HORDER SNL /DIVISOR < DIVIDEND ?? JMP DV2A /NO DCA HORDER /YES, C(L) = QUOTIENT BIT TAD DTEM1 DCA LORDER DV2A, CLA TAD QUOL /SHIFT BIT INTO QUOTIENT RAL DCA QUOL TAD OVER2 RAL DCA OVER2 ISZ DIVCNT /DONE ? JMP DV3 /NO TAD QUOL DCA LORDER TAD OVER2 DCA HORDER DCA OVER2 JMS I NORMIT DEXIT, ISZ SGNTST JMS I FACNEG JMP I FLDV / DVER, CLA CMA /DIVIDE ERROR DCA LORDER CMA CLL RAR DCA HORDER TAD HORDER DCA EXP ISZ FLAG NOP JMP DEXIT / NORMIT, FNORM QUOL, 0 DTEM1, 0 DIVCNT, 0 MIF, -27 /STEP COUNT SPACLA, SPA CLA / /TEST SIGN SUBROUTINE / SIGNCL, 0 CLA CMA CLL RAL / AC = -2 DCA SGNTST TAD HORDER SMA CLA JMP .+3 JMS I FACNEG ISZ SGNTST TAD HIGH1 SGNSWT, SMA CLA /OR SPA CLA JMP I SIGNCL JMS I OPNEGS ISZ SGNTST NOP JMP I SIGNCL / FACNEG, ACNEG OPNEGS, OPNEG SGNTST, 0 /WRITE P SUBOPTION ROUTINE / WOPPO, 0 WOPPOA, JMS CURLEV /GET THE LEVEL OF EXECUTION WOPPOB, DCA WOPPOC /SAVE THE CHARACTER JMS I XLOOKU /DO THE LOOKUP WOPPOC, 0 WRTPOT /TABLE ADDRESS JMP WOPPOA /STAY HERE UNTIL TERMINATOR IS SEEN DCA WOPPOC /SAVE THE ROUTINE ADDRESS JMS I WOPPOC JMP WOPPOB /RETURNS WITH THE CHARACTER IN THE AC WOPPOX, 0 JMP I WOPPO /TAKE THE EXIT ROUTINE AS A ")" WAS SEEN TO /TERMINATE THE FUNCTION. / /SAVE THE CURRENT X AND Y VALUE / SAVCUR, 0 JMS FL2INT CURX JMS FL2INT CURY TAD CURX+1 DCA TEMP1 TAD CURX+2 DCA TEMP1A TAD CURY+1 DCA TEMP2 TAD CURY+2 DCA TEMP2A JMS INT2FL CURX JMS INT2FL CURY JMP I SAVCUR YOFSET, ZBLOCK 3 /FLT PNT I/O SUBROUTINES / /4 WORD FLOATING POINT I/O SUBROUITNES /REQUIRES FLOATING POINT INTERPRETER /ENTRY IS AT 0007 /REQUIRED DEFINITIONS TO MAKE THIS FUNCTION PROPERLY. /(FIXMRI IS A PAL PSEUDO-OP) FIXMRI FADD= 1000 FIXMRI FSUB= 2000 FIXMRI FMPY= 3000 FIXMRI FDIV= 4000 FIXMRI FGET= 5000 FIXMRI FPUT= 6000 FIXMRI FNOR= 7000 FIXMRI FEXT= 0000 *52 FPAC1, 0 0 0 SWIT1, 7777 /IF = 0, NO CRLF AFTER OUTPUT SWIT2, 7777 /IF = 0, NO LF AFTER CR IN INPUT CHAR, 0 /CONTAINS LAST CHAR READ DSWIT, 0 /IS = 0 IF NO CONVERSION TOOK PLACE / /DOUBLE PRECISION DECIMAL TO BINARY /INPUT AND CONVERSION / *7000 DECONV, 0 CLA /INITIALIZE MANTISSA DCA HORDER DCA LORDER DCA SIGN DCA DNUMBR JMS CURLEV /ESTABLISH CURRENT INPUT LEVEL TAD PLUS /TEST FOR SIGN SNA JMP DECON1 TAD MINUS SZA JMP DECON2 /CHARACTER IS ALREADY THERE CLA CMA DCA SIGN /IF MINUS, SET SWITCH DECON1, STA DCA ABSFLG /MARK ABSOLUTE/RELATIVE MODE DECON, JMS CURLEV /THIS LEVEL OF PROCESSING DECON2, CLA TAD CHAR /IS IT A DIGIT TAD MIN9 SMA JMP I DECONV /NO TAD PLUS12 SPA JMP I DECONV /NO DCA DIGIT /YES TAD HORDER AND MASK /OVERFLOW ?? SZA JMP DECON /YES, IGNORE ISZ DSWIT ISZ DNUMBR /INDEX NUMBER OF DIGITS JMS MULT10 JMP DECON /CONTINUE MULT10, 0 /ROUTINE TO MULTIPLY DOUBLE TAD LORDER / PRECISION WORD BY 10 (DECIMAL) DCA LOW1 /DOUBLE PRECISION WORD TAD HORDER /REMAIN=REMAINDER DCA HIGH1 DCA EX1 JMS MULT2 /CALL SUBROUTINE TO JMS MULT2 /MULTIPLY BY TWO JMS DUBLAD /CALL DOUBLE ADD JMS MULT2 TAD DIGIT /ADD LAST DIGIT RECEIVED DCA LOW1 DCA HIGH1 JMS DUBLAD TAD EX1 /EXIT WITH REMAINDER JMP I MULT10 /IN AC / MULT2, 0 /MULTIPLY LORDER, HORDER BY 2 / CLA CLL TAD LORDER RAL DCA LORDER TAD HORDER RAL DCA HORDER TAD EX1 RAL DCA EX1 JMP I MULT2 DUBLAD, 0 /DOUBLE PRECISION ADDITION CLA CLL TAD LORDER TAD LOW1 DCA LORDER RAL TAD HORDER TAD HIGH1 DCA HORDER RAL TAD EX1 DCA EX1 JMP I DUBLAD MSIGN, 0 /ROUTINE TO FORM CLA CLL /2'S COMPLEMENT ISZ SIGN /IF C(SIGN)=7777 JMP I MSIGN JMS I MSIGNX JMP I MSIGN MSIGNX, ACNEG /"ACNEG" IN INTERPRETER /ALL CHARACTER CODES ARE IN SEVEN BIT MINUS, 53-55 /TEST FOR SIGN PLUS, -53 MIN9, -72 /TEST FOR DIGIT PLUS12, 72-60 MASK, 7600 /TEST FOR OVERFLOW CD10, 7775 3146 3147 / /WOPP ROUTINE TO PROCESS A PATTERN VALUE / WOPP, 0 WOPPA, JMS GETPAT /GET A PATTERN DCA PATTRN /SAVE THE PATTERN SPECIFIER TAD CHAR /RETURN THE CHARACTER TO THE CALLER DCA WOPPC /DO A LOOKUP ON THE INVALID CHARACTER JMS I XLOOKU WOPPC, 0 WOPPOP JMP WOPPE /EXIT, NOT IN TABLE DCA WOPPC JMS I WOPPC JMP WOPPA /AND TRY AGAIN WOPPE, JMS SNDPAT /SEND THE PATTERN JMS SNDMUL /AND THE MULTIPLIER TAD CHAR /AND RETURN THE INVALID CHARACTER JMP I WOPP /AND EXIT / /CURVE END COMMAND. / ENDCUR, 0 TAD (ENDBLK /FUNCTION BLOCK CIF PRMFLD /PRMATIVE FIELD JMS I XPRIMS /CALL THE PRIMATIVES CLA JMS REQPOS /RESTORE THE CURRENT POSITION DCA CURACT /TERMINATE THE CURVE FUNCTION JMP I ENDCUR /AND EXIT DXI, ZBLOCK 3 DYI, ZBLOCK 3 *7200 PLUSX, -1; 1; 2000; 0 PLUSY, -1; 1; 2000; 0 MINUSX, -1; 1; 6000; 0 MINUSY, -1; 1; 6000; 0 / /FLOAT TO INTEGER CONVERSION ROUTINE / FL2INT, 0 DCA FL2EXP /INIT THE VALUES TO START WITH DCA FL2HI DCA FL2LOW TAD I FL2INT /GET VALUES TO CONVERT TO INTEGERS ISZ FL2INT /UPDATE THE RETURN PC DCA FL2A /SAVE THE POINTER. TAD FL2A DCA FL3A /FOR FINAL STORAGE FPINT FGET I FL2A FADD PLUSP5 /ROUND UP ALWAYS???????? FPUT I FL2A FEXT TAD I FL2A /GET THE EXPONENT ISZ FL2A /UPDATE THE POINTER / SMA SZA /IS THE NUMBER <1? SMA JMP .+3 /NO CLA /YES. FIX IT TO ZERO??? JMP DONE1 TAD (-27 /NO. SET BINARY POINT AT SNA /35 PLACES TO RIGHT OF CURRENT POSITION JMP DONE1 /IT IS ALREADY THERE. ALL DONE SMA /TEST TO SEE IF IT IS TO LARGE. HLT /YES: NUMBER >2**23 DCA FL2EXP /NO. SET SCALE COUNT. TAD I FL2A /HIGH ORDER MANTISSA DCA FL2HI ISZ FL2A TAD I FL2A /LOW ORDER MANTISSA DCA FL2LOW / FGO, CLL TAD FL2HI /FETCH HIGH ORDER MANTISSA SPA /IS IT <0 CML /YES RAR /SCALE RIGHT DCA FL2HI TAD FL2LOW /SCALE RIGHT ALSO RAR DCA FL2LOW / ISZ FL2EXP /SEE IF ALL DONE JMP FGO /AND TRY AGAIN DONE1, TAD FL2EXP /GET THE EXPONENT DCA I FL3A ISZ FL3A TAD FL2HI DCA I FL3A ISZ FL3A TAD FL2LOW DCA I FL3A JMP I FL2INT /AND EXIT THE ROUTINE FL2A, 0 FL3A, 0 FL2EXP, 0 FL2HI, 0 FL2LOW, 0 PLUSP5, 0; 2000; 0 DIVTWO, 0 /DIVIDE BY TWO IE. ROTATE RIGHT CLL RAR DCA TEMP1 /TEMPORARY STORAGE TAD HORDER RAR DCA HORDER TAD LORDER RAR DCA LORDER TAD TEMP1 JMP I DIVTWO TOPA, 0 /TEXT DISPLAY ALPHABET SELECT / JMS I XGETNU /GET THE ALPHABET NUMBER JMP TOPA8 /NON-NUMERIC, JUST RETURN / TAD NUMMER+2 /GET THE SELECTED ALPHABET NUMMER DCA TDISPL /STORE IN PRIMITIVES COMMAND BLOCK / JMS DOTXT /SEND IT TO THE PRIMS / TOPA8, TAD CHAR /GET THE NEXT CHAR, IF ANY JMP I TOPA /RETURN WITH NEXT CHAR / / /DALBLK, GTCSET /PRIMITIVES COMMAND BLOCK TO PASS / 0000 / DISPLAY ALPHABET SELECTION SNDPAT, 0 TAD PATTRN DCA PATRN /SAVE THE CURRENT PATTERN VALUE TAD KPATBL /LINE TEXTURE PATTERN CIF PRMFLD /TO THE PRIMATIVES JMS I XPRIMS /CALL THEM JMP I SNDPAT /AND EXIT KPATBL, PATBLK PATBLK, GTLTXT PATRN, 0 CLRBMP, 0 TAD (LDCBLK+2 /SET UP TO CLEAR THE CHARACTER BITMAP DCA 10 TAD (-0012 DCA LDCHTM CLRBM1, DCA I 10 ISZ LDCHTM JMP CLRBM1 / TAD (LDCBLK+3 /SET UP TO SAVE BYTES IN THE BITMAP DCA LDCHT1 / POINTER TAD (-0012 DCA LDCHTM / COUNTER JMP I CLRBMP /RETURN *7400 / /FLOATING POINT INPUT / FLINTP, 0 CLA CMA /INITIALIZE "PERIOD SWITCH" DCA PRSW DCA DSWIT JMS I DPCVPT / 7777 = NO PERIOD CLA TAD CHAR TAD PER SZA CLA JMP FIGO1 TAD PRSW /PERIOD FOUND SNA CLA /SECOND PERIOD ? JMP FIGO2 /YES, TERMINATE DCA I DPN /NO, SET NUMBER OF DIGITS TO 0 DCA PRSW /SET PERIOD SWITCH TO 0 JMP I DPCSPT /CONVERT REST OF STRING FIGO1, TAD PRSW /PERIOD READ IN PREVIOUSLY ? SNA CLA FIGO2, TAD I DPN /YES, -NUMBER OF DIGITS IN SEXP CMA IAC /NO DCA SEXP JMS I MSGPNT /TEST SIGN TAD K27 DCA EXP FPINT /NORMALIZE F.P. NUMBER FNOR FPUT FPAC1 /SAVE NUMBER FEXT TAD CHAR TAD MINUSE SZA CLA /"E" READ IN ? JMP ENDFI /NO JMS I DPCVPT /YES, CONVERT DECIMAL EXPONENT JMS I MSGPNT /TEST SIGN TAD HORDER /EXPONENT TOO LARGE ?? SPA IAC SZA CLA JMP EXCESS /YES TAD LORDER /NO, DECIMAL POINT IS TAD SEXP /C(SEXP) PLACES TO RIGHT DCA SEXP /OF LAST DIGIT / /END OF FLOATING POINT INPUT /COMPENSATE FOR DECIMAL EXPONENTS / ENDFI, FPINT /RESTORE MANTISSA FGET FPAC1 FEXT ENDFIA, TAD SEXP SNA JMP I FLINTP SMA CLA JMP FIGO4 FPINT /. IS TO THE LEFT: FMPY I PCD10 /TIMES .1000 FEXT ISZ SEXP JMP ENDFIA JMP I FLINTP FIGO4, FPINT /. IS TO THE RIGHT, FMPY TEN /MULTIPLY BY 10 FEXT CLA CMA TAD SEXP DCA SEXP JMP ENDFIA EXCESS, TAD C3777 DCA EXP TAD C3777 DCA HORDER JMP I FLINTP TEN, 0004 2400 0000 PCD10, CD10 /.10 MINUSE, -105 PER, -56 PRSW, 0 SEXP, 0 /CONTAINS DECIMAL EXPONENT C3777, 3777 / DPCVPT, DECONV DPCSPT, DECON MSGPNT, MSIGN DPN, DNUMBR PATTAB, 0 /LINE PATTERNS = 377 / 11111111 360 / 11110000 344 / 11100100 252 / 10101010 352 / 11101010 210 / 10001000 204 / 10000100 310 / 11001000 206 / 10000110 XOFSET, ZBLOCK 3 / /MOVDXY - CONVERT DXI/DYI TO F.P. AND UPDATE CURX/CURY, THEN CHANGE BACK TO / INTEGERS /*********************CONVERT BACK TO USER SCALE VALUES. MOVDXY, 0 /CONVERT FROM INTEGER TO FLOATING POINT JMS INT2FL DXI JMS INT2FL DYI /UPDATE CURX AND CURY FPINT FGET DXI FSUB XOFSET /CALCULATION FOR INVERSE SCALING. FDIV XFACT FADD SCRTX+1 FPUT CURX FGET DYI FSUB YOFSET /CALCULATION FOR INVERSE SCALING. FDIV YFACT FADD SCRTY+1 FPUT CURY FEXT /CHANGE BACK TO INTEGERS JMS FL2INT DXI JMS FL2INT DYI JMP I MOVDXY /EXIT PAGE /LOAD CHARACTER CODE FOR REGIS / LDCHAR, 0 /LOAD CHARACTER COMMAND - HERE FROM << L >> / DCA CHAR /CLEAR OLD CHAR ON ENTRY ??? / CLA IAC /NEED TO GET SEMICOLONS AND SPACES AT THIS LEVE DCA SEMIOK / LDCHA2, DCA LDCBLK+2 /CLEAR THE CHARACTER CODE UNTIL SPECIFIED / LDCHA6, TAD LDCBLK+1 /CHECK IF ALPHABET DEFINED SNA CLA JMP LDCHA7 /NOT YET, GO CHECK FOR DEFINITION / TAD LDCBLK+2 /CHECK IF CHARACTER CODE SPECIFIED SNA CLA JMP LDCHA7 /NOT YET, GO CHECK FOR SPECIFICATION / JMS GETHEX /CHECK FOR ANY HEX-ENCODED DATA DCA I LDCHT1 /SAVE IN THE CHARACTER BITMAP / TAD GETHT3 /CHECK IF VALID DATA SNA CLA JMP LDCHA8 /NO, SKIP BUMPING POINTER AND COUNTER ISZ LDCHT1 /DATA OK, BUMP POINTER THROUGH BITMAP ISZ LDCHTM /INCREMENT COUNTER JMP LDCHA6 /LOOP THROUGH BITMAP DATA / JMS LDCSND /HAVE ALL DATA, SEND CHAR TO PRIMS / JMP LDCHA2 /START ON ANOTHER CHARACTER / LDCHA7, JMS CLRBMP /CLEAR THE CHARACTER BIT MAP / LDCHA8, TAD CHAR /CHECK IF ALREADY HAVE A CHARACTER SNA JMS CURLEV /IF NOT, GET ON NOW DCA LDCH10 /SAVE FOR LOOKUP JMS LOOKUP LDCH10, 0 /(BECOMES CHARACTER TO COMPARE) LOADTB /'LOAD' COMMAND MAIN TABLE JMS LDCEND /NOT FOUND, SEND ANY PARTIAL BITMAP DCA LDCH10 /FOUND, SAVE ROUTINE ADDRESS JMS I LDCH10 / AND CALL IT / JMP LDCHA6 /BACK TO CHECK FOR CHARACTER DATA / JMS GETHEX /CHAR NOT FOUND, CHECK FOR RANDOM HEX DATA CLA CLL /DISCARD THE DATA TAD GETHT3 /CHECK IF THERE WAS DATA, REALLY SZA CLA JMP LDCHA6 /YES, STAY AT THIS LEVEL JMP I LDCHAR /NO, BACK TO MAIN LEVEL / / LDCHTM, 0 LDCHT1, 0 / LDCBLK, GTCBMP /PRIMITIVE CONTROL BLOCK FOR LOAD CHARACTER 0000 /ALPHABET 0000 /CHARACTER CODE ZBLOCK 12 /TEN BYTE CHARACTER BITMAP LDCOPT, 0 /LOAD CHARACTER OPTION - HERE FROM << L( >> / JMS LDCSND /SEND ANY PARTIALLY COMPLETED BITMAP / JMP LDCOP4 /SKIP TO GET A NEW CHARACTER ON FIRST ENTRY / LDCOP2, TAD CHAR /DO WE HAVE A CHARACTER? SNA /IF SO, SKIP GETTING ANOTHER / LDCOP4, JMS CURLEV /GET ANOTHER CHARACTER FROM USER DCA LDCOP6 /SAVE FOR LOOKUP JMS LOOKUP LDCOP6, 0 /(BECOMES CHARACTER TO COMPARE) LDOPTB /LOAD OPTIONS TABLE JMP LDCOP4 /IF NOT FOUND, TRY ANOTHER / DCA LDCOP6 /SAVE ADDRESS OF ROUTINE JMS I LDCOP6 / AND CALL IT / JMP LDCOP2 /TRY ANOTHER CHARACTER / / LDOPEN, 0 /END OF LOAD OPTIONS - HERE ON << L(...) >> / DCA CHAR /CLEAR THE ')' FROM FURTHER CONSIDERATION / JMP I LDCOPT /RETURN FROM OPTIONS ROUTINE / LDCALP, 0 /LOAD CHARACTER ALPHABET - HERE FROM << L(A >> / JMS I XGETNU /GET THE ALPHABET NUMBER / JMP LDCAL8 /RETURN WITH NO CHANGE IN ALPHABET / TAD NUMMER+2 /GET THE ALPHABET NUMBER DCA LDCBLK+1 /SAVE IN THE CONTROL BLOCK / LDCAL8, JMP I LDCALP /RETURN / LDCABO, 0 /LOAD CHARACTER ABORT - HERE FROM << ; >> / DCA SEMIOK /SEMICOLONS CAN AGAIN ABORT COMMANDS / JMP I LDCHAR /GO RESET TO MAIN COMMAND LEVEL / LDCCOD, 0 /LOAD CHARACTER CODE - HERE FROM << L' >> / JMS LDCSND /SEND ANY PARTIALLY COMPLETED CHARACTER / TAD CHAR /GET THE QUOTE THAT STARTED US OFF JMS GTRUN /RUN DOWN THE QUOTES AND GET A CHARACTER CLA CLL /CLEAR AC (HAS NEXT CHAR AFTER QUOTE) / TAD TXTCHR /GET A CHARACTER FROM THE STRING DCA LDCBLK+2 /SAVE AS THE CHARACTER CODE BEING LOADED / JMP I LDCCOD /RETURN / / LDCOMM, 0 /LOAD CHARACTER COMMA HANDLER / DCA CHAR /BLOW AWAY THE COMMA CHARACTER / JMP I LDCOMM /AND RETURN / / LDCEND, 0 /LOAD CHARACTER TERMINATION << L'A'12,34,56; >> / JMS LDCSND /SEND ANY PARTIALLY COMPLETED BITMAP / JMS LDCABO /CALL ANOTHER ROUTINE THAT RETURNS TO MAIN / COMMAND LEVEL / / LDCSND, 0 /LOAD CHARACTER SENDING BITMAP TO PRIMITIVES / TAD LDCBLK+1 /CHECK IF ALPHABET SPECIFIED SNA CLA JMP LDCSN8 /NOT YET, SKIP SENDING / TAD LDCBLK+2 /CHECK IF CHARACTER CODE SPECIFIED SNA CLA JMP LDCSN8 /NOT YET, SKIP SENDING / CIF PRMFLD /OK TO SEND, CALL THE PRIMITIVES TAD (LDCBLK JMS I XPRIMS / DCA LDCBLK+2 /CLEAR THE CHARACTER CODE / JMS CLRBMP /GO CKEAR THE CHARACTER BITMAP / LDCSN8, JMP I LDCSND /RETURN / / JSTFY, 0 DCA 12 /SAVE THE COUNT TAD 10 CLL RAL ISZ 12 JMP .-2 JMP I JSTFY FIELD TABASY *1 /CONSTANTS NEEDED BY MACRO-GRAPH HANDLING. MACCUR, 0 MSTART, 0 / / *TABADD WRTPOT, -"M+200 /WOPP SUBOPTION TABLE WOPPM -")+200 WOPPOX 0 WOPPOP, -"(+200 WOPPO 0 MCMD, -"P+200 /POSITION COMMAND POSIT -"V+200 /VECTOR COMMAND VECTOR -"C+200 /CURVE COMMAND CURVE -"T+200 /TEXT COMMAND RTEXT /(TEXT IS A PSEUDO OP FOR PAL) -"W+200 /PERMANENT WRITING OPTIONS WRITE -"S+200 /SCREEN COMMANDS SCREEN -"R+200 /REPORT COMMAND REPORT -"L+200 /LOAD CHARACTER CELL COMMAND LDCHAR 0 /TERMINATOR. THATS ALL THERE IS AT THIS LEVEL CURTAB, -"[+200 CURBKT -"(+200 COPT 0 COPTBL, -")+200 CURVEX -"B+200 /SAVE CURRENT POSTION BOUCUR -"C+200 CURVEC -"S+200 /SAVE DUMMY POSTION UNBCUR -"E+200 /MOVE TO LAST SAVED POSITION ENDCUR -"A+200 CURARC -"W+200 TMPOPT 0 MACTAB, -".+200 /MACROGRAPH FUNCTION CLRGRP /CLEAR ALL MACROGRAPHS -":+200 /DEFINE A MACROGRAPH DEFGRP 0 POSTAB, -"[+200 PBKT -"0+200 /MOVE IN THIS DIRECTION (+0 DEG) PV0 -"1+200 PV1 /MOVE IN THIS DIRECTION (+45 DEG) -"2+200 PV2 /MOVE IN THIS DIRECTION (+90 DEG) -"3+200 PV3 /MOVE IN THIS DIRECTION (+135 DEG) -"4+200 PV4 /MOVE IN THIS DIRECTION (+180 DEG) -"5+200 PV5 /MOVE IN THIS DIRECTION (+225 OR -135 DEG) -"6+200 PV6 /MOVE IN THIS DIRECTION (+270 OR -90 DEG) -"7+200 PV7 /MOVE IN THIS DIRECTION (+315 OR -45 DEG) -"(+200 POPT 0 / /POSITION OPTIONS AVAILABLE - (, ), B, S, E, W, ', " / POPTBL, -")+200 POSITX -"B+200 /SAVE CURRENT POSTION SAVPOS -"S+200 /SAVE DUMMY POSTION SAVDUM -"E+200 /MOVE TO LAST SAVED POSITION LASPOS -"W+200 TMPOPT 0 REPTAB, -"(+200 REPOPT 0 REPTBL, -"=+200 ROPP /REPORT MACRO-GRAPH STORAGE -"P+200 ROPP /REPORT CURSOR POSITION -"E+200 ROPE /REPORT ANY ERRORS -")+200 REPEXI /EXIT REPORT 0 SCRTAB, -"(+200 SCROPT 0 SHTAB, -"(+200 SOHO -")+200 SOPHEX -"P+200 SOPHP -"[+200 SHBRKT 0 SOHOPT, -"P+200 SOPHP -")+200 SOHOEX 0 SOPTBL, -")+200 SCREEX -"C+200 /CURSOR ON/OFF FUNCTION SOPC -"E+200 /ERASE FUNCTION SOPE -"A+200 /ADDRESS FUNCTION SOPA -"I+200 /SET BACKGROUND COLOR SOPI -"H+200 /REQUEST FOR SCREEN DUMP SOPH -"M+200 SOPM -"T+200 /REQUEST THE TIME TO WAIT SOPT 0 /TERMINATOR. THAT'S ALL THERE IS AT THIS LEVEL. TXTTAB, -"'+200 TYTEXS -""+200 TYTEXS -"(+200 TEXOPT -"[+200 TBKT // -",+200 // DUMMY -"0+200 /MOVE IN THIS DIRECTION (+0 DEG) TPV -"1+200 TPV /MOVE IN THIS DIRECTION (+45 DEG) -"2+200 TPV /MOVE IN THIS DIRECTION (+90 DEG) -"3+200 TPV /MOVE IN THIS DIRECTION (+135 DEG) -"4+200 TPV /MOVE IN THIS DIRECTION (+180 DEG) -"5+200 TPV /MOVE IN THIS DIRECTION (+225 OR -135 DEG) -"6+200 TPV /MOVE IN THIS DIRECTION (+270 OR -90 DEG) -"7+200 TPV /MOVE IN THIS DIRECTION (+315 OR -45 DEG) 0 TOPTBL, -"S+200 TOPS -"H+200 TOPH -"U+200 TOPU -"M+200 TOPM -"D+200 TOPD -"I+200 TOPI -"A+200 TOPA -"B+200 TOPB -"E+200 TOPE -"W+200 TMPOPT -")+200 TEXOPX 0 VECTAB, -"[+200 PBKT -"0+200 /MOVE IN THIS DIRECTION (+0 DEG) PV0 -"1+200 PV1 /MOVE IN THIS DIRECTION (+45 DEG) -"2+200 PV2 /MOVE IN THIS DIRECTION (+90 DEG) -"3+200 PV3 /MOVE IN THIS DIRECTION (+135 DEG) -"4+200 PV4 /MOVE IN THIS DIRECTION (+180 DEG) -"5+200 PV5 /MOVE IN THIS DIRECTION (+225 OR -135 DEG) -"6+200 PV6 /MOVE IN THIS DIRECTION (+270 OR -90 DEG) -"7+200 PV7 /MOVE IN THIS DIRECTION (+315 OR -45 DEG) -"(+200 VOPT 0 / /VECTOR OPTIONS AVAILABLE - (, ), B, S, E, W, ', " / VOPTBL, -")+200 VECTOX -"B+200 /SAVE CURRENT POSTION SAVPOS -"S+200 /SAVE DUMMY POSTION SAVDUM -"E+200 /MOVE TO LAST SAVED POSITION LASPOS -"W+200 TMPOPT 0 WRTTAB, -"(+200 WRTOPT 0 WRTTBL, -"I+200 /SET FOREGROND COLOR COMMAND WOPI -"C+200 WOPC -"E+200 WOPE -"R+200 WOPR -"V+200 WOPV // -"F+200 /NOT USED DUE TO HARDWARE LIMITATIONS..... // WOPF -"M+200 WOPM -"N+200 WOPN -"S+200 WOPS -"P+200 WOPP -")+200 WRITEX 0 /WRITE FUNCTION WOPSTB, -"[+200 WOPSLB -"'+200 WOPSQT -""+200 WOPSQT 0 / CLRTB1, -"(+200 GETCOP 0 /TERMINATOR CLRTB2, 1 -"B+200 -"R+200 -"M+200 -"G+200 -"C+200 -"Y+200 -"W+200 -"D+200 0 /TERMINATOR CLRTB3, -")+200 CLRRP -"H+200 CLRH -"L+200 CLRL -"S+200 CLRS 0 / / MORE TABLES / LOADTB, -"(+200; LDCOPT -""+200; LDCCOD -"'+200; LDCCOD -";+200; LDCEND -",+200; LDCOMM 0000 / LDOPTB, -"A+200; LDCALP -")+200; LDOPEN -";+200; LDCABO ///// -"E+200; LDCEXT (HANDLE ALPHABET EXTENT LATER, IF AT ALL) 0000 TABLEB, 1; 3; 2; 6; 4; 5 / MSTACK, ZBLOCK 33 CMAPTB, 0; 11; 12; 14; 13; 15; 16; 17 10; 1; 2; 4; 3; 5; 6; 7 MACBUF, ZBLOCK 66 PAGE / /SCAN THE MACRO BUFFER FOR A TERMINATOR. EXIT CALL +1 IF TERMINATOR FOUND ELSE /CALL +2 FOR NEXT READ / SCNBUF, 0 JMS IOPEN /SET UP FOR THE READ. SCNBF2, JMS GETMAC /PROCESS UNTIL TERMINATOR SEEN JMP SCNBF1 /END FOUND. CLA JMP SCNBF2 SCNBF1, JMS GETMAC /GET MACRO GRAPH NUMBER NOP CIA /NEGATE IT JMS GT2END /LOOK FOR THE FINAL VALUE CLA JMP I SCNBUF / /CLEAR ALL MACRO GRAPHS / CLRGRP, 0 RDF TAD (CIF CDF DCA CLRGR9 CIF CDF TBLFLD TAD (-32 /INIT THE FILL COUNTER. DCA 10 /USE AN AUTO INDEX AS A TEMPORARY TAD (MSTACK-1 /SET UP BUFFER ADDRESS DCA 11 DCA I 11 /NOW THE ACTUAL CLEAR LOOP ISZ 10 /UPDATE COUNTER JMP .-2 /STAY IN THE LOOP TILL DONE. TAD (-27 /AMOUNT OF FREE SPACE WHEN THE STATCK IS FILLED DCA I 11 JMS STTAB /RESTORE THE NEW TABLE PR3 4000+MCFLD+TABFLD /MARK THE END OF THE TABLE ZZERO+1 33 -1 -1 DCA MACSTK CLRGR9, HLT JMP I CLRGRP /EXIT. THE MACRO GRAPHS HAVE BEEN INITIALIZED. / /UPER - MAKE UPPER CASE ROUTINE (SAME CODE AS "UPPER" IN REGFLG / UPER, 0 / DCA UPETM /SAVE CHAR TAD UPETM TAD (-141 /LOWER CASE A TO Z SPA /SKIP IF IT STILL LOOKS GOOD JMP UPER8 /NOT LOWER CASE TAD (-32 /THE RANGE OF CHARACTERS SMA CLA /SKIP IF WITHIN RANGE JMP UPER8 /NOT LOWER CASE CHARACTER TAD UPETM /MAKE IT UPPERCASE TAD (-40 /THIS DOES IT DCA UPETM /SAVE FOR RETURN / UPER8, CLA CLL TAD UPETM /GET CONVERTED CHAR JMP I UPER /RETURN WITH CHAR, NOW UPPER-CASE / IOPEN, 0 DCA GETM1 /BUFFER ADDRESS TO START READ STA DCA MACCNT JMP I IOPEN / CLRMAP, 0 TAD (MSTACK-1 DCA 10 TAD (-33 DCA 11 DCA I 10 ISZ 11 JMP .-2 JMP I CLRMAP / LASACT, 0 MACACT, 0 /MACRO ACTIVE FLAG MACCNT, 0 UPETM, 0 ZZERO, -1; 0; 0; 0 PAGE / / /VT125 MACRO GRAPH HANDLER ROUTINES. / /THE FOLLOWING ROUTINES WILL PERFORM THE FOLLOWING FUNCTIONS: / / @. SAYS TO CLEAR THE MACRO GRAPHS / @: A-Z @; DEFINE A MACROGRAPH. / / A TABLE OF 27 WORDS IS RESERVED IN PANEL MEMORY FIELD 4 / AT ADDRESS ZERO FOR THE TABLE POINTER FOR THE MACRO GRAPHS. / THE TABLE CONSISTS OF A POINTER TO THE START OF THE MACRO / GRAPH BEING USED. AND WORD 27 CONTAINS THE AMOUNT OF FREE SPACE LEFT / MINUS THE NUMBER OF UNUSED CHARACTER DESIGNATORS. / A MACROGRAPH IS N-1 CHARACTERS WITH THE LAST WORD CONTAINING THE / NEGATIVE VALUE OF THE MACRO GRAPH MINUS THE ASCII CODE FOR "A" / SO THAT MACRO GRAPH A WILL BE "-1" INTERNALLY. THIS IS USED TO / TERMINATE THE MACRO GRAPH AND AND TO DETERMINE WHAT GRAPH IS BEING / MANIPULATED DURING THE PURGE PROCESS. / / A 27 WORD AREA IS RESERVED FOR A MACRO GRAPH STORAGE AREA IN MAIN / MEMORY TO KEEP TRACK OF WHICH MACRO GRAPHS ARE ACTIVE AT ANY ONE / TIME. IN ADDITION A 32 WORD AREA IS NEEDED TO STORE MACRO GRAPHS / BEING EXECUTED. / / MACSTK = CURRENT ENTRY INTO THE MACROGRAPH TABLE. THIS / POINT TO THE CURRENT ACTIVE ENTRY IN THE MACROGRAPH. / / MSTACK = 27 WORD MACRO STORAGE AREA. / MACCUR = CURRENT ENTRY IN THE MACRO BEING USED / MACPNT = CURRENT POINT IN THE 32 WORD MACRO STORAGE AREA. / MACCNT = CURRENT NEGATIVE VALUE IN THE BUFFER AREA. THIS IS / = USED TO DETERMINE WHEN DATA HAS TO BE STORED OR / RETRIEVE FROM PANEL MEMORY. / MSTART = CURRENT STYARTING ADDRESS OF THE MACRO GRAPH. / / THE MACRO GRAPH DEFINITIONS ARE TERMINATED BY A ZERO ENTRY IN THE / MACRO GRAPH STORAGE AREA IN CONTROL PANEL MEMORY. / / /DEFINE A MACRO GRAPH. THIS ROUTINE DEFINES A MACRO GRAPH AS DEFINED /BY THE CHARACTER FOLLOWING THE INTRODUCER. CHARACTERS FROM A TO Z ARE ALLOWED /WITH LOWER CASE TO UPPER CASE CONVERSION DONE. THE ROUTINE WILL FIRST /PURGE THE EXISTING MACRO GRAPH LIBRARY IN THE EVENT THE GRAPH IS BEING /REDEFINED. CURRENTLY THERE IS NO METHOD FOR DELETING A MACRO GRAPH ONLY IN /MAKING A NULL GRAPH WHICH CAUSES NO ACTION. / DEFTMP, 0 /TEMP REQUIRED MACSTK, 0 DEFGRP, 0 /DEFINE A MACRO GRAPH. STA /TELL MAIN LEVEL TO PASS ALL CDF RGFLD DCA I (SEMIOK STA DCA I (LOACTV CDF TBLFLD DEFGR6, CIF RGFLD JMS CURLEV /ESTABLISH THIS LEVEL OF PROCESSING CDF TBLFLD /ESTABLISH THIS FIELD FOR RETURN DCA CHAR TAD CHAR JMS UPER /MAKE UPPER CASE DCA CHAR /THIS WILL MAKE IT UPPER CASE ONLY DEFGR1, CLA /MAKE SURE AC IS CLEARED AS IT MAY NOT /BE FROM A PREVIOUS CONDITION TAD CHAR /NOW SEE IF IT IS A VALID CHRACTER TAD (-101 /A-Z ALLOWED SPA /SKIP IF IT A LETTER JMP DEFEXT /ERROR EXIT. THE CHARACTER WAS NOT IN THE /DESIRED RANGE OF CHARCTERS TAD (-32 /THE HIGH END SMA CLA /SKIP IF VALID CHARACTER JMP DEFEXT /ERROR EXIT. PR3 /GET THE CURRENT DEFINITIONS 5000+TBLFLD+MACFLD /FROM USER TO CP 0 /ADDRESS 0 MSTACK -33 /FOR THIRTY THREE WORDS -1 /TERMINATION TAD CHAR TAD (-101 /MAKE THE GRAPH OFFSET. DCA MACSTK /SAVE THE CURRENT VALUE TAD (MSTACK /BUFFER ADDRESS TAD MACSTK /CURRENT OFFSET DCA MSTART /CURRENT POINTER TAD I MSTART /NOW DETERMINE IF MACRO IS ACTIVE. (NON-ZERO) SZA /SKIP IF NOT JMS PURGE /GO PURGE THE MACRO GRAPHS TO GET AS MUCH SPACE /AS POSSIBLE. THIS ROUTINE IS EXECUTED ONLY IF /THE MACRO IS TO BE REDEFINED. JMS FNDFRE /FIND THE FIRST AVAILABLE FREE SPACE. DCA MSTART /SAVE THE STARTING ADDRESS. TAD MSTART /WORD TO START AT JMS OUSETP /SET UP OUTPUT ROUTINE DEFGR2, CIF RGFLD JMS CURLEV /CURRENT ENTRY FROM INPUT ROUTINE CDF TBLFLD /ESTABLISH THIS FIELD FOR RETURN DCA CHAR TAD CHAR TAD (-100 /LOOK FOR AN "@" SZA CLA /SKIP IF YES. GO LOOKAHEAD AT THE NEXT CHARCTER /TO SEE IF IT IS A TERMINATOR. JMP DEFGR3 /NOT AN INTRODUCER CIF RGFLD JMS CURLEV /MAKE THIS THE NEXT LEVEL CDF TBLFLD /ESTABLISH THIS FIELD FOR RETURN DCA CHAR TAD CHAR TAD (-";+200 /LOOK FOR A SEMI COLON TO TERMINATE THE LOOP SZA CLA /SKIP IF TERMINAL CHARACTER JMP DEFGR4 /NOT A TERMINAL CHARACTER. GO TEST FOR AN /ERROR CONDITION TAD FULL /SEE IF MACRO GRAPHS ARE FULL SZA CLA /NON-ZERO SAYS IT IS DCA MACCUR /SET UP TO NULL THE GRAPH JMS NULLGR DEFEXT, CLA /ERROR EXIT AT THIS POINT CIF CDF RGFLD DCA I (SEMIOK DCA I (LOACTV CDF TBLFLD DCA FULL DCA MACACT /CLEAR MACRO ACTIVE FLAG DCA MACSTK /MAKE SURE THE STACK LEVEL IS CLEARED JMP I DEFGRP /EXIT THE ROUTINE DEFGR4, TAD CHAR /LOOK TO SEE IF A REDEFINITION IS BEING ASKED TAD (-":+200 SZA CLA /SKIP IF YES JMP DEFGR5 /STORE THE PROPER CHARACTERS JMS CLRCUR /CLEAR THE CURRENT ONE BEING DONE AND RESTART /THE MACRO GRAPH DEFINITION AS A MACRO GRAPH /CANNOT DEFINE ANOTHER MACRO GRAPH. JMP DEFGR6 /GO BACK AND TRY AGAIN /********************************************************************** /NEED TO HANDLE THE CLEAR MACRO GRAPH CONDITION /AS THE MACRO GRAPH DO NOT GET CLEARED UNTIL /IT IS TERMINATED. /********************************************************************** DEFGR5, CLL CLA IAC BSW /AC=100 JMS STMAC /STORE A MACRO CHARACTER DEFGR3, TAD CHAR /STORE THE INCOMING CHARACTER JMS STMAC /DO IT. JMP DEFGR2 /GO BACK AND GET ANOTHER. / /NULLGR - ROUTINE TO NULL THE MARCO'S / NULLGR, 0 RDF TAD (CIF CDF DCA NULRTN CIF CDF TBLFLD TAD MACSTK /GET TERMINATOR VALUE CMA /MAKE THE TERMINATOR JMS OCLOSE /TERMINATE THE FUNCTION TAD MACSTK /NOW SET UP TO RESTORE THE TABLE TAD (MSTACK /MAKE THE POINTER DCA DEFTMP TAD MSTART /STARTING ADDRESS FOR THE MACRO DCA I DEFTMP JMS FNDFRE /FIND THE FIRST FREE SPOT CIA /MAKE THE NUMBER OF FREE WORDS DCA MSTACK+32 /SAVE IT. PR3 4000+MCFLD+TABFLD MSTACK 0 -33 -1 /WRITE OUT THE NEW MACRO TABLE. NULRTN, HLT JMP I NULLGR /RETURN PAGE / /STORE A CHARACTER INTO AN OUTPUT BUFFER AND IF FULL SEND IT TO THE /PANEL RAM ADDRESS SEPCIFIED BY MACCUR. A 32 WORD TRANSFER IS DONE /UNLESS A TERMINATOR IS SEEN IN WHICH CASE THE REMAINING PART OF THE /BUFFER IS SENT. /IF MACCUR IS ZERO THEN THE POINTERS ARE TO BE RESET. / STMAC5, 0 STMAC, 0 DCA STMAC2 /SAVE THE CHARACTER TO DO TAD FULL /TEST TO SEE IF OUTPUT INHIBITED SZA CLA /SKIP IF NOT JMP I STMAC /TAKE THE EXIT. TAD STMAC2 JMS PACK /DO THE PROPER PACKING STMAC6, CLL CLA IAC R3L /(AC=10)SEE IF AT THE END OF THE BUFFER TAD STMAC5 /GET THE POSITIVE VALUE IAC /DOUBLE WORD OFFSET CLL RAL /*2 FOR FINAL RESULT TAD STMAC4 /NOW THE CURRENT BUFFER ADDRESS SZA CLA /SKIPS IF NO ROOM AVAILABLE JMP I STMAC /EXIT STA /MARK THE MACRO STORAGE AS FULL DCA FULL /MARK IT AS NOT AVAILABLE JMP I STMAC /JUST EXIT. DON'T UPDATE COUNTERS OR POINTERS /AS THERE IS NOT ENOUGH ROOM. / /OS8 PACKING ROUTINE. / PACK, 0 DCA STMAC2 ISZ OUJMP /BUMP UNPACK SWITCH OUJMP, HLT /MODIFIED FOR PACKING SWITCH JMP OCHAR1 JMP OCHAR2 TAD OUJMPE DCA OUJMP /RESET UNPACK SWITCH TAD STMAC2 /THIRD CHARACTER PACKING CLL RTL RTL AND (7400 /MASK OFF TO THE PROPER BITS TAD I OUPOLD /GET BACK THE CHARACTER PREVIOUSLY STORED DCA I OUPOLD /AND RESTORE IT TAD STMAC2 /NOW FOR THE SECOND HALF OF IT CLL RTR /THE SECOND DOUBLE WORD GETS THE LOW ORDER /BITS OF THE THIRD WORD. RTR RAR AND (7400 /MASK TO THE NEEDED FOUR BITS TAD I MACCUR /OUTPUT POINTER. DCA I MACCUR /TO THE BUFFER ISZ MACCUR /UPDATE BUFFER ADDRESS ISZ STMAC5 /SEE IF READY TO WRITE. JMP OUCOMN /TAKE THE NORMAL EXIT. TAD (-20 /SET UP TO DO THE WRITE TO PANEL.(16 WORDS) JMS PRWRT /DO THE WRITE TO PANEL MEMORY JMS OUSETP /RESET THE BUFFERS AND STUFF JMP I PACK OCHAR2, TAD MACCUR /POINT TO FIRST DOUBLE WORD. DCA OUPOLD ISZ MACCUR OCHAR1, TAD STMAC2 /GET BACK THE CHARACTER DCA I MACCUR /STORE THE CHARACTER OUCOMN, ISZ BYTCNT /SET UP FOR CLOSE JMP I PACK /EXIT CLL CLA CMA RTL /AC=-3 DCA BYTCNT /RESET PACKING SWTICH. JMP I PACK OUPOLD, 0 STMAC2, 0 FULL, 0 BYTCNT, 0 PURTMP, 0 PURCNT, 0 OUJMPE, JMP OUJMP /PACKING SWITCH. / /PURGE THE CURRENT MACRO GRAPH LIBRARY AS A REDEFINTION HAS BEEN REQUESTED. / PURGE, 0 DCA PURTMP /SAVE THE CURRENT POINTER. DCA I MSTART /CLEAR THE CURRENT ACTIVE POINTER TAD PURTMP /CURRENT STARTING ADDRESS DCA MSTART /SAVE IT FOR STORAGE ROUTINE TAD MSTART JMS CLEAR1 TAD PURTMP /BUFFER ADDRESS TO AC JMS SCNBUF /SCAN THE BUFFER FOR A TERMINATOR PURG3, TAD INPTR /CALCULATE THE STARTING ADDRESS TAD (-MBUF1 TAD RDTEMP /NOW CALCULATE THE ADDRESS. DCA PURTMP /AND SAVE IT TAD MSTART /OPEN UP THE OUTPUT AREA JMS OUSETP /SET UP OUTPUT BUFFER STUFF. TAD PURTMP /BUFFER ADDRESS TO AC JMS IOPEN /SET TO READ PURG4A, JMS GETMAC /GET A CHARACTER FROM THE MACRO BUFFER SKP JMP PURG4B JMS GETMAC NOP CIA /GET THE MACRO GRAPH NUMBER JMS GT2END /GET TO THE END OF THE GRAPH AS IT MAY NOT BE /ON A 2 WORD BOUNDRY PURG4B, SPA /SKIP IF NOT THE END JMP PURG5 /GO TERMINATE THE MACRO SNA /SKIP IF ALL DONE JMP I PURGE /AND EXIT JMS STMAC /STORE THE MACRO CHARACTER JMP PURG4A /TRY NEXT BUFFER PURG5, DCA PURCNT /SAVE THE TERMINATOR TAD PURCNT /NOW TERMINATE THE BUFFER JMS OCLOSE /DO IT TO IT TAD PURCNT CMA /MAKE IT POSITIVE. TAD (MSTACK /TABLE POINTER FOR MACRO ENTRIES DCA PURCNT TAD MSTART /GET THE CURRENT STARTING POINT DCA I PURCNT /AND MARK THE STARTING POINT OF THE MACRO. TAD STMAC9 /GET THE END OF THE BUFFER CMA TAD STMAC4 /THE BUFFER ADDRESS TAD (-20 /TO OFFSET THE BUFFER UPDATE AT STMAC DCA MSTART /AND RESET THE OUTPUT BUFFER JMP PURG3 / PAGE / /READ A 64 WORD OF MACRO GRAPH AREA INTO THE BUFFER. / RDTMP1, 0 / RDGRPH, 0 DCA RDTEMP /SAVE THE BUFFER ADDRESS DCA RDTMP1 ISZ RDTMP1 JMP .-1 PR3 /FIND THE FIRST TERMINATOR AS IT HAS TO BE /SKIPPED OVER. 5000+TBLFLD+MACFLD RDTEMP, 0 MBUF1 /BUFFER -20 /FOR 16 WORDS -1 /TERMINATOR JMP I RDGRPH /EXIT. / /ROUTINE TO FIND THE FIRST AVAILABLE FREE SLOT IN MACRO GRAPH STORAGE AREA. /A ZERO TERMINATES THE MACRO GRAPH BUFFER AREA IN CP MEMORY. / FNDFR1, 0 FNDFRE, 0 TAD (33 /SET UP THE PRQ FOR THE TRANSFER DCA FNDFR1 /AND SAVE IT. (IT GETS MODIFIED AS THINGS /GO ALONG.) FNDFR4, TAD FNDFR1 /BUFFER ADDRESS TO START AT JMS RDGRPH /READ BUFFER TAD (-20 /BUFFER COUNTER DCA FNDTMP /CLEAR A COUNTER TAD (MBUF1-1 /NOW SCAN THE BUFFER DCA 10 /USE AN AUTO INDEX REGISTER FNDFR3, TAD I 10 /GET A VALUE SNA CLA /SKIP IF NOT AT THE END JMP FNDFR2 /AT THE END. FIND THE ACTUAL POINTER. ISZ FNDTMP /UPDATE THE COUNTER JMP FNDFR3 /GO BACK AND TRY AGAIN TAD (20 /16 WORDS TAD FNDFR1 DCA FNDFR1 /SAVE IT JMP FNDFR4 /TRY ANOTHER BUFFER. FNDFR2, TAD (20 /16 WORDS TAD FNDTMP /CURRENT VALUE TAD FNDFR1 /NOW MAKE THE FINAL VALUE JMP I FNDFRE /AND EXIT WITH THE VALUE IN THE AC. FNDTMP, 0 /TEMP WORK AREA / /CLEAR THE CURRENT MACRO DEFINITION AS A DEFINITION IS TRYING TO /BE DONE FROM WITH A DEFINITION. / CLRCUR, 0 TAD MACSTK /GET THE CURRENT MACRO TAD (MSTACK /THE ADDRESS OF THE POINTER DCA CLRTMP /SAVE THE POINTER DCA I CLRTMP /CLEAR THE CURRENT VALUE PR3 /NOW WRITE BACK THE EXISTING STUFF. 4000+MCFLD+TABFLD /FROM FIELD 4 TO FIELD 4 0 MSTACK /FROM THIS ADDRESS -33 /FOR 27 WORDS -1 /TERMINATOR TAD MSTART /CLEAR OUT THE ENTRY JMS CLEAR1 JMP I CLRCUR /CLEAR THE CURRENT VALUE CLRTMP, 0 / /GET A CHARACTER FOR THE DESIRED MACRO. /IF THE AC IS NON-ZERO AT ENTRY A NEW READ IS FORCED TO GET THE GRAPH /GRAPH STARTED. EXT CALL +1 IF A TERMINATOR SEEN AND CALL PLUS 2 IF NOT. / INJMPE, JMP INJMP INCTLW, 0 INPTR, 0 GETMAC, 0 GETM3, ISZ INJMP /UNPACKING SWITCH ISZ MACCNT /UPDATE THE COUNTER TO SEE IF NEXT READ TO BE /DONE. JMP INJMP /NOT YES GO GET A CHARACTER TAD (MBUF1 /READ BUFFER DCA INPTR /SET UP THE STARTING OUTPUT POINTER. TAD (-31 /THIS NUMBER OF WORDS(16*3/2) DCA MACCNT TAD GETM1 /GET THE BUFFER TO READ JMS RDGRPH /GO READ IT AND PUT IT IN MBUF1. TAD (20 /FOR THE UPDATE TAD GETM1 DCA GETM1 /SAVE THE NEW BUFFER ADDRESS. TAD INJMPE DCA INJMP JMP GETM3 /GO PROCESS THE BUFFER INJMP, HLT /MODIFIED TO JUMP TO THE PROPER PLACE JMP ICHAR1 JMP ICHAR2 TAD INJMPE DCA INJMP TAD I INPTR /GET A CHARACTER AND (7400 /MASK OFF CLL RTR RTR ISZ INPTR TAD INCTLW /PREVIOUS FOUR BITS RTR RTR JMP INCOMN /NORMAL EXIT ICHAR2, TAD I INPTR /SECOND CHARACTER AND (7400 /MASK OFF DCA INCTLW /SAVE IT FOR NOW ISZ INPTR ICHAR1, TAD I INPTR /GET THE CHARACTER INCOMN, AND (377 /MASK TO 8 BITS TAD (-377 /LOOK FOR THE TERMINATOR SNA /SKIP IF NOT DONE JMP I GETMAC /ERROR EXIT. TERMINATOR SEEN TAD (377 /RESTORE THE CHARACTER ISZ GETMAC /UPDATE RETURN FOR COMPLETION ON THIS GRAPH JMP I GETMAC GETM1, 0 /BUFFER ADDRESS FOR A READ. / PAGE / /A REQUEST HAS BEEN MADE TO PROCESS A MACRO GRAPH. /FIRST A TEST IS DONE TO SEE IF THE MACRO GRAPH IS ACTIVE IF IT IS THIS IS /AN ERROR CONDITION AND RETURN TO THE CALLER IS MADE WITH NO PROCESSING. NEXT /THE GRAPH STARTING ADDRESS IS FOUND. IF THERE IS NO GRAPH DEFINED THEN AGAIN /IT IS AN ERROR AND RETURN IS MADE TO THE USER. ONE THE GRAPH HAS BEEN VALIDATED /AS BEING VALID A TEST IS DONE TO SEE IF THERE ARE ANY ENTRIES ACTIVE. IF /THERE ARE NO ENTRIES THEN THE CALLING FIELD AND RETURN ADRRES FOR REGIS ARE /SAVE SO THAT THE MACRO PROCESSOR CAN CALL REGIS. ALL PROCESSING CONTINUES UNTIL /ALL GRAPHS HAVE BEEN PROCESSED AND THE STACK LEVEL RETURNS TO ZERO AT WHICH /TIME THE REGIS RETURN FIELD AND ADDRESS ARE RESTORED. /(ONE NOTE. THE STACK IS A MAXIMUM OF 26 WORDS AS THAT IS ALL THE LETTERS THAT /ARE ALLOWED IN THE ALPHABET.) / DOGR2, 0 DOGR3, 0 DOGRPH, DCA CHAR CDF TBLFLD TAD LASACT /RESTORE THE CURRENT LEVEL CDF RGFLD /ESTABLISH THIS FIELD FOR RETURN DCA I (CURLEV /TERMINATE THE ACTIVITY AS THIS IS THE SAME /AS NORMAL INPUT. CDF TBLFLD /ESTABLISH THIS FIELD FOR RETURN TAD MACSTK /SEE IF FLAG BUFFER NEEDS TO BE SET UP. SNA CLA /SKIP IF NOT JMS CLRMAP TAD CHAR /GET THE CHARACTER TO PROCESS TAD (-101 /OFFSET INTO ACTIVE TABLE DCA DOGR5 /SAVE THE TABLE ADDRESS FOR LATER. TAD DOGR5 /NOW CALCULATE THE ACTIVE BUFFER ADDRESS TAD (MSTACK /USE THIS STACK. DCA DOGR4 /SAVE IT TAD I DOGR4 /GET THE ADDRESS OF THE ENTRY TO SEE IF THIS /MACRO GRAPH IS BEING USED. SZA CLA /A ZERO SAYS IT IS NOT ACTIVE AND WE CAN CONTINUE JMP DOGR9 /EXIT ROUTINE. NO SENSE IS DOING THIS AS /RECURSION IS NOT SUPPORTED. PR3 5000+TBLFLD+MACFLD /READ FROM PANEL DOGR5, 0 /MODIFIED TO ADDRESS TO READ IN PANEL DOGR4, 0 /MODIFIED TO ADDRESS TO WRITE TO IN MAIN -1 /FOR ONE WORD -1 /TERMINATOR. TAD I DOGR4 /NOW SEE IF THERE IS A MACRO DEFINED. SNA CLA /SKIP IF YES. JMP DOGR9 /EXIT. THERE IS NO GRAPH TO DO. / /NOW TEST TO SEE IF RETURN ADDRESSES HAVE TO BE SAVED. / TAD MACSTK /IF ZERO THEN SAVE REGIS RETURN SZA CLA /SKIP IF INIT TO BE DONE. JMP DOGR1 /ALREADY ACTIVE. DON'T SAVE IT AGAIN ISZ MACSTK /MARK THE FIRST ENTRY LEVEL CDF RGFLD TAD I (REGIS /SAVE THE CURRENT REGIS RETURN DATA DCA DOGR2 TAD I (REGRET+2 /AND THE RETURN FIELD STUFF. DCA DOGR3 /SAVE IT. CDF TBLFLD JMP DOGR1B /GO OPEN UP THE INPUT AREA DOGR1, TAD MACSTK /NOW STORE THE CURRENT POINTER FOR LATER USE CLL RAL /*2 FOR OFFSET TO TABLE POINTER ISZ MACSTK /UPDATE THE ENTRY LEVEL TAD (MACBUF-1 / DCA DOGR5 /SAVE THE POINTER TAD RDTEMP /CURRENT READ ADDRESS CDF TBLFLD /BUFFER FIELD DCA I DOGR5 /SAVE THE POINTER ISZ DOGR5 /POINT TO THE BYTE VALUE POINTER TAD MACCNT /CURRENT NEGATIVE OFFSET DCA I DOGR5 CDF TBLFLD /HOME FIELD. DOGR1B, TAD I DOGR4 /GET THE BUFFER ADDRESS JMS IOPEN /SET UP THE INPUT INFORMATION DOGR1A, JMS GETMAC /GO GET A CHARACTER FOR THE MACRO GRAPH. JMP DOGR7 /THIS GRAPH IS DONE. SEE IF ALL DONE THE ENTIRE /SET OF MACROS. CIF RGFLD JMS REGIS /GO SEND THE COMMAND TO REGIS JMP DOGR1A /AND TRY AGAIN. / /AT THIS POINT A TERMINATOR WAS SEEN AND IS IN THE AC. CLEAR THE CURRENT /GRAPH FLAG AND GET THE NEXT ONE IF AVAILABLE. / DOGR7, JMS GETMAC /GET THE MACRO GRAPH NUMBER +1 NOP TAD (-1 TAD (MSTACK /CALCULATE THE POINTER FOR ACTIVITY. DCA DOGR4 / DCA I DOGR4 /CLEAR THIS ENTRY STA TAD MACSTK /GET THE CURERNT POINTER DCA MACSTK /SAVE THE OFFSET TAD MACSTK SPA SNA /SKIP IF NOT EMPTY. JMP DOGR8 /CLEAN UP AND EXIT CLL RAL /*2 FOR BUFFER OFFSET TAD (MACBUF-1 JMS GETTHR /GET TOT THE PROPER POINT IN THE BUFFER JMP DOGR1A /AND TRY AGAIN CONTINUING AT THE LAST POINT /THAT WAS LEFT OFF. DOGR8, CDF RGFLD TAD DOGR2 /NOW RESTORE REGIS LEVEL DCA I (REGIS TAD DOGR3 DCA I (REGRET+2 /AND THE FIELDS DOGR9, CIF RGFLD JMP REGRET /SAME AS "NEXT" BUT MODIFIED FOR THIS FIELD / /POSITION THE POINTERS AT THE PROPER POINT IN THE UNPACKING BUFFER. /ENTER WITH BUFFER POINTER IN THE AC. / GETTHR, 0 DCA DOGR4 /SAVE THE POINTER CDF TBLFLD /TABLE FIELD TAD I DOGR4 DCA DOGR5 /SAVE IT ISZ DOGR4 /NOW THE BYTE COUNT TAD I DOGR4 DCA DOGR4 /SAVE IT FOR LATER. CDF TBLFLD /HOME FIELD AGAIN TAD DOGR5 /STARTING ADDRESS TO AC JMS IOPEN /SET UP THE POINTERS FOR INITIAL READS TAD (31 /NOW GET THE THE SAME CHARACTER YOU LEFT OFF AT TAD DOGR4 CMA DCA DOGR4 /SAVE IT GETHR1, ISZ DOGR4 SKP JMP I GETTHR JMS GETMAC /GET A CHARACTER NOP CLA JMP GETHR1 /STAY IN THE LOOP TILL AT THE PROPER POINT. PAGE /CLEAR A LOCATION IN THE MACRO GRPAH DEFINITION AS DEFINED BY THE AC AT INPUT / CLEAR1, 0 DCA CLR1TM PR3 /NULL THE MACRO IN CASE IT IS LAST IN MEMORY 4000+MCFLD+TABFLD ZZERO+1 CLR1TM, 0 -1 -1 JMP I CLEAR1 / / PRWRT, 0 DCA STMAC9 /SAVE THE NUMBER OF WORDS TO MOVE PR3 /SEND THE DATA 4000+MCFLD+TABFLD MBUF /BUFFER ADDRESS STMAC4, 0 /BUFFER IN CP MEMEORY STMAC9, 0 /WORD COUNT -1 TAD STMAC4 TAD (20 /NEXT AREA TO DO DCA STMAC4 JMP I PRWRT /EXIT. / /TERMINATE A MACRO GRAPH STORAGE / OCLTMP, 0 OCLOSE, 0 CIA /MAKE THE GRAPH NUMBER POSITIVE. DCA OCLTMP /SAVE IT FOR NOW DCA FULL /TERMINATE THE FULL CONDITION TAD (377 /TERMINATOR JMS STMAC /TO THE BUFFER OCLOS1, TAD OCLTMP /GET BACK TERMINATOR VALUE JMS STMAC /TO THE BUFFER CLL CLA IAC CML RAL /AC=3 TAD BYTCNT /SEE IF IT ALL DONE SZA CLA /SKIP IF YES JMP OCLOS1 /NOT YET - TRY AGAIN CLL CLA IAC R3L /SET UP BYTE COUNT TO WRITE TAD STMAC5 CLL RAL /*2 FOR FINAL RESULT IAC /ONE MORE TO COMPENSATE FOR THE TERMINATOR CIA DCA 10 DCA I MACCUR TAD 10 JMS PRWRT /SEND IT JMP I OCLOSE /AND EXIT. OUSETP, 0 SZA /SKIP IF OLD BUFFER TO BE USED DCA STMAC4 /BUFFER STARTING ADDRESS TAD OUJMPE /SET UP PACKING SWITCH DCA OUJMP / TAD (MBUF /BUFFER ADDRESS DCA MACCUR /TO FORCE A RESET TAD (-10 /SET UP DOUBLE WORD COUNTER DCA STMAC5 /SAVE THE COUNT VALUE CLL CLA CMA RTL /AC=-3 DCA BYTCNT /PACKING SWITCH FOR CLOSE JMP I OUSETP /EXIT. / /LOOK FOR THE FINAL GRAPH INDICATOR / GT2END, 0 DCA CLRTM1 /SAVE THE TWO'S COMPLIMENT OF NUMBER SCNBF3, JMS GETMAC /GET THE MACRO GRAPH NUMBER NOP TAD CLRTM1 SNA CLA JMP SCNBF3 TAD CLRTM1 /RETURN CHARACTER IN THE AC JMP I GT2END CLRTM1, 0 STTAB, 0 PR3 /NOW SEND THE DATA TO CP MEMORY 4000+MCFLD+TABFLD /FORM USER TO CP MSTACK /********************************************* 0000 /FORM MSTACK TO 0 OF FIELD FOUR -33 /NUMBER OF WORDS TO MOVE -1 /TERMINATOR JMP I STTAB MBUF, ZBLOCK 22 /WRITE BUFFER REQUIRED - NOW AT 16 CHARACTERS MBUF1, ZBLOCK 20 /READ BUFFER PAGE EJECT / / / / /The following code has been taken out of VT125 module and put into / REGIS for several reasons. First is to take the sixel dump out / of the wpcx WPS modules and put it with the rest of regis. Hopefully / this will lead to an easier conversion process. / I hope to parametize most of the regis and prim modules / to facilitate this conversion.... I am also hoping to list all the / steps necessary to convert the graphics to WPS. Hopefully when / this has been done and I have a full understanding of what I have done / I will list the steps in rgishd.pa and primhd.pa modules. If / the instructions don't get there I forgot to put them in..... / / This module is a dispatch module used to call the SIXEL screen dump, / the reporter, the cursor visibility routine, and the timer. / I'm still not sure what the do at this point but they are / not actually called thru regis but executed in the VT125 GTE module. / this is why they are called directly via a different dispatcher / than REGIS. Hope this is clear. / / THE ROUTINE ACTUALLY CALLED FROM THIS DISPATCH TABLE(RSPNST) HAVE / BEEN TAKEN FROM VT125. CRSVRS REPORT TIMER HARDCP / REPORT IS A DUPLICATE TAG AND MUST BE CHANGED IN THIS AREA SO AS / NOT TO CONFLICT WITH REGIS.. THE LABEL DMYSUB IS ALSO DEFINED IN REGIS / BUT CAN BE DELETED FROM THIS CODE / / GRAPHICS OPTION WORD PASSED TO DISREG FROM CX IN MQ / DISREG,0 /ENTRY..SHOULD BE DEFINED IN WPF1 AND REFERENCED /.......IN WPCX2.PA MODULE..IF ERROR CHECK ADDR. DCA REGRTN /CODE RETURNED TO WPCX FROM REGIS AND PASSED ON RDF /CALLING FIELD TAD (CIF CDF /SET RETURN DCA DISRET /SET DISPATCH RETURN TAD REGRTN SNA CLA /VALID POINTER? 0=NOT A POINTER JMP DISRET /NOT A POINTER.. IGNORE IT CDF RGFLD /POINTER POINTS TO TABLE IN REGIS FLD TAD I REGRTN /GET DATA CDF TBLFLD /MYFLD SMA /ONLY CODES -1, -2, -3, -4 VALID JMP DISRT0 /IGNORE CODE TOO HIGH TAD K0004 /CHECK LIMITS SPA JMP DISRT0 /TOO LOW TAD PRSPNS /ADD BASE ADDRESS OF DISPATCH TABLE DCA KHTMP4 /SAVE AS POINTER TO ROUTINE ADDRESS TAD I KHTMP4 /GET ROUTINE ADDRESS FROM TABLE DCA KHTMP4 /SAVE FOR DISPATCH SWP /GET GRAPHICS OPTION CONTROL WORD DCA OPTION /SET UP AT CX LEVEL(USED ONLY FOR CRSRVS) JMS I KHTMP4 /DISPATCH TO SUBROUTINE / DISRT0, CLA CLL /CLEAR FOR RET DISRET, HLT /SET FIELDS JMP I DISREG /RETURN / / / REGRTN, 0 /DISPATCH CODE POINTER KHTMP4, 0 PRSPNS, RSPNST /REGIS RESPONSE TABLE RSPNST, CRSRVS /-4 --> CURSOR VISIBILITY RPORT1 /-3 --> REPORT TIMER /-2 --> TIMER HARDCP /-1 --> SCREEN DUMP / -------------------------------------------- / RPORT1 - HANDLE REGIS REPORT RESPONSE STRING / -------------------------------------------- / RPORT1, 0 / REPOR2, CLA CLL ISZ REGRTN /INCREMENT THROUGH RESPONSE STRING NOP /(JUST IN CASE) / CDF RGFLD /REGIS FIELD HAS THE STRING TAD I REGRTN /GET A CHARACTER CDF TBLFLD /BACK TO THIS FIELD SPA /CHECK IF TERMINATOR (7777) JMP REPOR6 /YES, GO FINISH UP / JMS I COMCHR /ENQUEUE THIS CHARACTER TO THE HOST / JMP REPOR2 /LOOP UNTIL TERMINATOR SEEN / REPOR6, CLA CLL /END OF STRING, SEND A CR TAD K0015 /GET THE CR CHARACTER JMS I COMCHR /ENQUEUE TO HOST / CLA CLL JMP I RPORT1 /RETURN / / K0004, 0004 K0015, 0015 / /SUBROUTINE TO PUT CHARS TO HOST / COMCHR, XX COMCH1, CIFSYS /SYSTEM IO JMS I KHS2OU /TO COMM JMP NOCNDO /DIDN'T DO IT JMP I COMCHR /DONE NOCNDO, DCA COMSVE /SAVE CHAR CDFSYS TAD I (JWAIT&177 /ADDR. OF JWAIT IN SYSFLD PAGE0 CDF TBLFLD DCA KJWAIT /SET UP JMP(PAGE0 THIS FLD NOT WPS CIFSYS JMS I KJWAIT /WAIT TAD COMSVE /GET CHAR JMP COMCH1 /DO IT / COMSVE, 0 /SAVE CHAR THAT WASN'T OUTPUT KJWAIT, JWAIT /JWAIT KHS2OU, HS2OU /PUT 1 CHAR OUT ON COM LINE / / ------------------------------------- / UNIMPLEMENTED REGIS RESPONSE ROUTINES / ------------------------------------- / TIMER, /SCREEN TIMER /DMYSUB, 0 /DUMMY / CLA CLL JMP I TIMER / ------------------------------- / HARDCP - REGIS HARDCOPY REQUEST / ------------------------------- / HARDCP, 0 / CDF RGFLD /REGIS FIELD FOR HARDCOPY OFFSETS ISZ REGRTN /BUMP POINTER NOP TAD I REGRTN /GET X OFFSET DCA SHPX ISZ REGRTN /BUMP POINTER NOP TAD I REGRTN /GET Y OFFSET DCA SHPY CDF TBLFLD /BACK TO THIS FIELD / JMS I XSCRDM /REQUEST SCREEN DUMP / CLA CLL JMP I HARDCP /RETURN / / XSCRDM, SCRPNT / ---------------------------------------- / CRSRVS - HANDLE SCREEN CURSOR VISIBILITY / ---------------------------------------- / CRSRVS, 0 / CDF RGFLD /REGIS FIELD FOR ON/OFF ISZ REGRTN /BUMP POINTER NOP TAD I REGRTN /GET CURSOR ON/OFF FLAG CDF TBLFLD /BACK TO THIS FIELD / SZA CLA /CHECK IF NON-ZERO AC0001 /SET OR RESET LSB FOR CURSOR VISIBILITY DCA CRSRTM /SAVE FOR LATER MERGE WITH OPTION WORD / TAD K7776 /MASK FOR OPTION WORD (7776 OR 7777) AND OPTION TAD CRSRTM /SET CURSOR VISIBILITY IF NEEDED DCA OPTION / TAD (SETGRP /SET GRAPHICS CONTROL POINTER CIF PRMFLD /PRIM FIELD JMS I (PRIMS /DO IT / JMP I CRSRVS /RETURN / / K7776, 7776 CRSRTM, 0 / SETGRP, CMDSET /SET CURSOR GRAPHICS CONTROL OPTION, 0 / PAGE EJECT / ---------------------------------------- / SCRPNT - SCREEN DUMP WITH SIXEL PROTOCOL / ---------------------------------------- / SCRPNT, 0 / / ------------------------------------------- / SCRDM1 - IDLE LOOP HANDLING FOR SCREEN DUMP / ------------------------------------------- / SCRDM1, / SCRD1A, CLA CLL TAD K0033 /PUT PRINTER IN 'SIXEL MODE' JMS PRCHR / BY SENDING 'ESC P LITTLE-Q' TAD K0120 JMS PRCHR TAD K0161 JMS PRCHR / JMS DOSHPY /HANDLE VERTICAL OFFSETS / DCA RDBITS+2 /RESET Y POSITION TAD (-50 /SET UP Y COUNTER DCA SCRDT5 / SCRDM2, JMS DOSHPX /HANDLE HORIZONTAL OFFSET / DCA RDBITS+1 /RESET X POSITION TAD (-62 /SET UP X COUNTER DCA SCRDT6 / SCRDM4, CLA CLL /? JMS SXLPRO /ENTER HERE FROM IDLE LOOP / CIF PRMFLD /ASK GRAPHICS PRIMITIVES FOR SCREEN DATA TAD PRDBIT JMS PRIM / JMS MAKVIS /DETERMINE WHICH PIXELS SHOW UP AGAINST / THE BACKGROUND / AC7776 /SET UP FOR TWO PASSES THROUGH DISPLAY DCA SCRDT4 / SCRDM6, TAD PWRBIT /POINT TO FOREGROUND DATA FROM GRAPHICS PRIMS DCA SCRDTM / TAD (-6 /SET UP TO TRANSLATE SIX BYTES DCA SCRDT3 / SCRDM8, TAD (-10 /SET UP FOR EIGHT BITS PER BYTE TO XLATE DCA SCRDT2 / TAD PSXLBL /POINT TO SIXEL DATA STORAGE DCA SCRDT1 SCRD10, TAD I SCRDTM /GET A GDC WORD RAR /ROTATE A BIT INTO LINK DCA I SCRDTM /SAVE ROTATED WORD TAD I SCRDT1 /GET SIXEL CHARACTER-IN-PROGRESS RAR /ROTATE BIT FROM SCREEN INTO IT DCA I SCRDT1 /SAVE / ISZ SCRDT1 /POINT OT NEXT SIXEL CHAR ISZ SCRDT2 /INCREMENT THROUGH BITS/CHARS JMP SCRD10 /LOOP / ISZ SCRDTM /POINT TO NEXT GDC WORD ISZ SCRDTM /(TWO TIMES CAUSE INTERDIGITATED) ISZ SCRDT3 /INCREMENT WORD COUNTER JMP SCRDM8 /LOOP / TAD (-10 /SET UP FOR EIGHT SIXEL CHARACTERS DCA SCRDT2 / TAD PSXLBL /POINT TO HALF-FORMED SIXEL CHARS DCA SCRDT1 / SCRD12, /? JMS SXLPRO /BACK TO IDLE LOOP FOR A WHILE /? JMS I XBF16T /CHECK IF ROOM IN BUFFER /? JMP SCRD13 /YES /? NOP /HALF FULL /? JMP SCRD12 /TOO FULL, KEEP CHECKING / SCRD13, CLA CLL TAD I SCRDT1 /GET A CHAR BSW /SWAP INTO LOW SIX BITS FROM HIGH SIX BITS AND (77 /MASK TO SIX BITS TAD (77 /ADD OFFSET TO MAKE A REAL SIXEL DATUM JMS PRCHR /ENQUEUE FOR DISPLAY TO PRINTER / ISZ SCRDT1 /INCREMNT TO NEXT SIXEL CHAR ISZ SCRDT2 /INCREMENT CHAR COUNTER JMP SCRD12 /LOOP / ISZ SCRDT4 /INCREMENT TWO-PASS COUNTER SKP /SKIP IF MORE TO DO JMP SCRD14 /NO MORE TO DO / AC0001 /POINT TO OTHER HALF (INTERDIGITATED) JMP SCRDM6 / OF GDC DATA / SCRD14, TAD (20 /POINT TO NEXT X TAD RDBITS+1 /BY CHANGING CONTROL BLOCK DCA RDBITS+1 / ISZ SCRDT6 /INCREMENT ACROSS SCREEN JMP SCRDM4 /LOOP TAD (55 /SEND A GRAPHICS NEW-LINE TO PRINTER JMS PRCHR / TAD K0014 /POINT TO NEXT Y TAD RDBITS+2 /BY CHANGING CONTROL BLOCK DCA RDBITS+2 / ISZ SCRDT5 /INCREMNT DOWN SCREEN JMP SCRDM2 /LOOP / CLA CLL /? JMS SXLPRO /ENTER HERE FROM IDLE LOOP / CLA CLL TAD K0033 /TAKE PRINTER OUT OF 'SIXEL MODE' JMS PRCHR / BY SENDING AN 'ESC \' TAD K0134 JMS PRCHR / CLA CLL JMP I SCRPNT /RETURN / SHPX, 0 /X OFFSET FOR SCREEN HARDCOPY SHPY, 0 /Y OFFSET FOR SCREEN HARDCOPY SCRDTM, 0 SCRDT1, 0 SCRDT2, 0 SCRDT3, 0 SCRDT4, 0 SCRDT5, 0 SCRDT6, 0 K0014, 0014 K0033, 0033 K0120, 0120 K0161, 0161 K0134, 0134 / PSXLBL, SXLBLK PRDBIT, RDBITS PWRBIT, WRBITS / PAGE / / / -------------------------------------------- / DOSHPY - HANDLE Y OFFSET FOR SCREEN HARDCOPY / -------------------------------------------- / DOSHPY, 0 / DCA DOSHTM /CLEAR COUNTER FOR GRAPHICS NEW-LINES / TAD SHPY /GET NUMBER OF PIXELS TO SKIP VERTICALLY SPA SNA JMP DSHPY6 /NONE REQUESTED / DSHPY2, ISZ DOSHTM /INCREMENT WORKING QUOTIENT / TAD MM0014 /DIVIDE BY TWELVE LOGICAL PIXELS PER NEW-LINE SMA SZA JMP DSHPY2 /LOOP UNTIL DIVIDE COMPLETE / CLA CLL TAD DOSHTM /MAKE NEWLINE COUNTER NEGATIVE FOR LOOP CONTROL CIA DCA DOSHTM / DSHPY4, TAD (55 /SEND A NEWLINE JMS PRCHR ISZ DOSHTM /LOOP UNTIL DOWN FAR ENOUGH JMP DSHPY4 / JMP DSHPY8 /FINISHED WITH NEW LINES / DSHPY6, CLA CLL TAD (44 /NO NEWLINES, ENSURE GRAPHICS RETURN JMS PRCHR / DSHPY8, JMP I DOSHPY /RETURN / / DOSHTM, 0 / -------------------------------------------- / DOSHPX - HANDLE X OFFSET FOR SCREEN HARDCOPY / -------------------------------------------- / DOSHPX, 0 / DCA DOSHTM /CLEAR COUNTER FOR GRAPHICS NULLS / TAD SHPX /GET NUMBER OF PIXELS TO SKIP HORIZONTALLY SPA SNA JMP DSHPX6 /NONE REQUESTED / CIA /MAKE NULL COUNTER NEGATIVE FOR LOOP CONTROL DCA DOSHTM / DSHPX4, TAD (77 /SEND A NULL JMS PRCHR ISZ DOSHTM /LOOP UNTIL OVER FAR ENOUGH JMP DSHPX4 / DSHPX6, CLA CLL JMP I DOSHPX /RETURN MM0014, -0014 / / ------------------------------------------------------------ / MAKVIS - DETERMINE WHICH PIXELS DIFFER FROM BACKGROUND COLOR / ------------------------------------------------------------ / MAKVIS, 0 / CLA CLL TAD M0014 /SET UP COUNTER FOR CLEARING VISIBLE BITS DCA MAKVTM AC7777 TAD PPWRBI /SET UP POINTER TO BLOCK OF VISIBLE PIXELS DCA 14 MAKVI2, DCA I 14 /CLEAR EACH WORD OF PIXELS, NOT YET BUILT ISZ MAKVTM /INCREMENT THROUGH WORDS JMP MAKVI2 /LOOP UNTIL BLOCK IS CLEARED / TAD PPRDB2 /POINT TO STORAGE FOR PRIMITIVE'S PIXELS DCA 15 TAD M0004 /GET COUNT OF PLANES DCA MAKVT1 / MAKVI4, TAD I PRDB63 /GET BACKGROUND COLOR CLL RAR /ROTATE A COLOR SELECTOR BIT INTO LINK DCA I PRDB63 /SAVE MODIFIED BACKGROUND COLOR SZL CLA /CHECK IF THIS PLANE IS ON AC7777 /YES, GET ALL 1S FOR LATER COMPARE DCA MAKVT2 / OR USE ALL 0S IF PLANE NOT ON / TAD PPWRBI /POINT TO BLOCK OF PIXELS BEING BUILT DCA MAKVT5 TAD M0014 /SET UP COUNTER FOR BUILDING THE VISIBLE PIXELS DCA MAKVT3 / MAKVI6, TAD I 15 /GET A BUNCH OF BITS FROM THE PRIMITIVE STORAGE DCA MAKVT4 /SAVE FOR COMPARE WITH THE BACKGROUND COLOR / TAD MAKVT2 /GET MASK OF BACKGROUND COLOR CMA /1S COMPLEMENT AND MAKVT4 /PIXELS .AND. (.NOT. BACKGROUND) MQL /SAVE IN MQ FOR LATER 'OR' TAD MAKVT4 /GET PIXELS CMA /1S COMP AND MAKVT2 /BACKGROUND .AND. (.NOT.PIXELS) MQA /BACKGROUND .XOR. PIXELS MQL /SAVE FOR OR WITH OTHER PLANE'S CONTRIBUTIONS TAD I MAKVT5 /GET A VISIBLE PIXEL WORD MQA /'OR' IN THE LATEST CONTRIBUTION DCA I MAKVT5 /SAVE UNTIL ALL PLANES DONE / ISZ MAKVT5 /INCREMENT POINTER THROUGH BLOCK /(NEVER SKIPS) ISZ MAKVT3 /INCREMENT THROUGH WORDS IN EACH PLANE JMP MAKVI6 /LOOP THROUGH WORDS / ISZ MAKVT1 /INCREMENT THROUGH PLANES JMP MAKVI4 /LOOP THROUGH PLANES / JMP I MAKVIS /RETURN / / MAKVTM, 0 MAKVT1, 0 MAKVT2, 0 MAKVT3, 0 MAKVT4, 0 MAKVT5, 0 PPRDB2, RDBITS+2 M0004, -0004 M0014, -0014 PRDB63, RDBITS+63 PPWRBI, WRBITS /SUBROUTINE TO PRINT CHARS /A050 PRCHR, XX /A050 PRCHR1, CIFSYS /USE SYSTEM I/O /A050 JMS I KLPTOU /CALL IT /A050 JMP UNSUCS /UNSUCCESSFUL /A050 JMP I PRCHR /IT MUST HHAVE ACCEPTED IT /A050 UNSUCS, DCA PRTSVE /SAVE PRINT CHAR CDFSYS TAD I (JWAIT&177 /ADDR. OF JWAIT IN SYSFLD PAGE0 CDF TBLFLD DCA PJWAIT /SET UP JMP(PAGE0 THIS FLD NOT WPS CIFSYS /REGROUP AND TRY AGAIN /A050 JMS I PJWAIT /AFTER WAITING /A050 TAD PRTSVE /GET CHAR THAT WASN'T OUTPUT LAST TIME JMP PRCHR1 /START OVER /A050 / PRTSVE, 0 /CHAR SAVED.. NOT PRINTED AS BUFF FULL KLPTOU, LPOCHR /PRINT A CHAR PJWAIT, PJWAIT /ADDRESS OF JWAIT / PAGE /A050 / RDBITS, 0016 /PRIMITIVE COMMAND TO READ SCREEN 0 /X POSITION 0 /Y POSITION ZBLOCK 60 /RESERVE SPACE FOR RETURN DATA 0 /BACKGROUND COLOR AT LAST SCREEN ERASE /(NOTE BLUE IS LSB, THEN RED, GREEN, INTENSITY) / SXLBLK, ZBLOCK 10 /RESERVE SPACE FOR SIXEL STRING WRBITS, ZBLOCK 14 /BITMAP OF VISIBLE PIXELS PAGE