From df281ee2d0693956f1e755d412968fb75623a87e Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 12 Mar 2019 15:13:05 +0100 Subject: [PATCH] LINES 138 --- src/bkph/lines.138 | 2105 +++++++++++++++++++++++++++++++++++ src/bkph/rout.21 | 2580 +++++++++++++++++++++++++++++++++++++++++++ src/bkph/supprt.261 | 2460 +++++++++++++++++++++++++++++++++++++++++ 3 files changed, 7145 insertions(+) create mode 100755 src/bkph/lines.138 create mode 100755 src/bkph/rout.21 create mode 100755 src/bkph/supprt.261 diff --git a/src/bkph/lines.138 b/src/bkph/lines.138 new file mode 100755 index 00000000..2bf4ca0f --- /dev/null +++ b/src/bkph/lines.138 @@ -0,0 +1,2105 @@ +TITLE LINES + +FLEFLG==1 +STEREO==1 +LIBRAR==1 +OUTALL==1 +INPALL==1 +STMPIT==1 +CNTRLX==1 +COMMND==1 + +.INSRT SUPPRT > + +START: .CORE CORSIZ + .VALUE + JSR INIT + SZ FRAMSW +.I RSTART=#ACCEPT, MESSX=12. + SETOM DSPARY-YDISP+DSPIB + SETOM DSPARY-YDISP+DSPIB+LDSPIB + Q STRSWD ;GENERATE THE TWO DISPLAY ARRAYS + Q DINNE1 + Q DINYY + Q ADISON ;SWITCH ON DISPLAY +.I DISAAD ;PUT ARRAY 2 ON DISLIS + SETZB Y,TYPED +.I PTDTA1<-1> + J ACCEPT + +NMDATA=3000 + +MDATA: BLOCK NMDATA +MSAVE: BLOCK NMDATA + +DELTA: 4 ;<77 .0025" * DELTA +RATE: 7 ;<7 200/(RATE+1) PER SECOND +EPSIL: 30. ;ERROR ACCEPTABLE IN DELETE OPS-.0025"*EPSIL +SHTOVR: 100. ;LESS THAN THIS WILL NOT BE SQUARED-.0025"*SHTOVR +PERLN: 5 ;ITEMS PER LINE IN FOOD +DSRAT: 6 ;LOOKS PER DISPLAY IN STRGT + + +SNGFLG: 1 ;NON-ZERO TO CAUSE SINGLE POINTS TO BE DELETED +SLPFLG: 1 ;NON-ZERO TO CAUSE SLOPPINESS TO BE REMOVED +SQRFLG: 1 ;NON-ZERO TO SQUARE UP VERTICALS AND HORIZONTALS +DELFLG: 1 ;NON-ZERO TO ALLOW DELETING LINES BY REDRAWING THEM + +NOPINT: 0 ;NON-ZERO TO GENERATE NO DECIMAL POINTS ON OUTPUT +CRSFLG: 1 ;NON-ZERO TO MAP TABLET ON WHOLE SCREEN IN WINDOW OPS +COMFLG: 1 ;NON-ZERO TO CAUSE COMPACTING FOR EACH DSUFR +ONEFLG: 1 ;NON-ZERO SO OUTPUT AND INPUT IS SCOPE COORDS RATHER THAN TABLET +ESYFLG: 1 ;NON-ZERO TO CALL ESYPLT EACH FOOD +EPSFLG: 1 ;NON-ZERO TO SCALE EPSIL TOO + +BUTFLG: 0 ;NON-ZERO TO ENABLE 'PEN-BUTTONS' +WNDFLG: 0 ;NON-ZERO TO ENABLE WINDOWING +FIGFLG: 0 ;NON-ZERO TO MOVE FIGURES,NOT SEGMENTS +LSTFLG: -1 ;-1 => LIST OF QUADRUPLES, 0 => LIST OF LISTS OF DOTTED PAIRS, 1 => LIST OF LISTS OF LIST PAIRS IN OUTPUT + + + TBLC==7 + +TBDATA: BLOCK 100. + +TBLOP: 2,,(SIXBIT/TAB/) + 0 + 0 + +NGRX: 10. ;NUMBER OF INTERVALS IN X DIRECTION +NGRY: 10. ;NUMBER OF INTERVALS IN Y DIRECTION + +GRDINT: 0 ;GRID INTENSITY +DRWINT: 2 ;DRAWING INTENSITY + + +GRIDS: GET NGRX,NGRY,GRDINT +DINNE1: +.I GXD0=GYD0=0,GXD=4099./(NGRX+1),GYD=4099./(NGRY+1) +DINNER: +.I DISINS> ;GO TO FRAME ETC DISLIS + Q DSCRT + Q DISHAD + Q GRID + Q DISGO ;OK FOR ARRAY 1 TO DO A DISGO +.I DSPSEL<1> ;GO TO DRAWING DISLIS + R + +GRID: SKIPN W,GRDINT + R + Q DSPBRT ;CHANGE INTENSITY +.I 1,1 + SKIPN WNDFLG + J NOMGT + HLRZ A,WXFC + HLRZ B,WYFC +NOMGT: +.I ,,GRXD=GXD/A,GRYD=GYD/B +.I GRGX=GXD0 +ZPGRLX: +.I GHCPX +.I GRGX=GRGX+GRXD + CAIGE A,4096. + J ZPGRLX +.I GRGY=GYD0 +ZPGRLY: +.I GHCPY +.I GRGY=GRGY+GRYD + CAIGE A,4096. + J ZPGRLY + R + GHCPX: SKIPN WNDFLG + J NOWNDX + IMUL A,WXFC + HLRES A + ADD A,WXOF +NOWNDX: LSH A,-2 ;TO SCOPE COORDS + SKIPLE A + CAIL A,1777 + R + MM A,CRNG' +.I DSPPNI<,CRNG,0> +.I DSPVCA<,CRNG,1777> + R + +GHCPY: SKIPN WNDFLG + J NOWNDY + IMUL A,WYFC + HLRES A + ADD A,WYOF +NOWNDY: LSH A,-2 ;TO SCOPE COORDS + SKIPLE A + CAIL A,1777 + R + MM A,CRNG' +.I DSPPNI<,0,CRNG> +.I DSPVCA<,1777,CRNG> + R + +GX0: 0 +GX1: 0 +GXD0: 0 +GYD0: 0 +GY0: 0 +GY1: 0 +GXD: 0 +GYD: 0 +GRGX: 0 +GRGY: 0 +GRXD: 0 +GRYD: 0 + +BYTOLD==FOOADD ;IN PROTECTED STORAGE + +CMWNGR: +.I BYTOLD=BYTPNT,MODOLD'=DSPMOD + Q GTSGX + Q CHOP ;REMOVE TAIL END OF DISPLAY ARRAY AGAIN + M X,YBVR + M B,Y + M Y,X ;RESTORE Y TO BEFORE GRID SPEC + SUB B,X ;NUMBER OF NEW POINTS + R + +GRIDT:.I APOUSP=#WNDPS + Q CMWNGR + CAIGE B,2 + J GRIDW1 ;ONE POINT TOUCHED ONLY + MI A,1 + SKIPN GRDINT + MM A,GRDINT ;IN CASE ITS OFF + M A,MDATA(X) + HLRZM A,GX0 + HRRZM A,GY0 + M A,MDATA+1(X) + HLRZM A,GX1 + CAIG B,2 + J GLYTP ;ONLY TWO POINTS TOUCHED + M A,MDATA+2(X) + HRRZM A,GY1 +GMLYT: Q GTGFTA +GMLAT: J DINNER ;MAKE NEW GRID ETC. + +CHOP: MI A,403737 ;WIPE OUT DISPLAY GOODIES FROM BYTOLD TO BYTPNT + M B,BYTOLD + IDPB A,B + CAME B,BYTPNT + J .-2 +.I BYTPNT=BYTOLD,DSPMOD=MODOLD + SO XDISP + SO YDISP + SO XLST + SO YLST + R + +GRIDW1: SKIPN GRDINT + J GROFFN + SZ GRDINT + J GMLAT + +GROFFN: +.I GRDINT=1 + J GMLAT + +GLYTP: +.I GY1=GY0+ABS + J GMLYT + + NGRTX: +.I GX1=GX0,GX0=GX1 + J GTGFTA + +NGRTY: +.I GY1=GY0,GY0=GY1 + +GTGFTA: +.I GX1-GX0,GY1-GY0 + JUMPL A,NGRTX + JUMPL B,NGRTY + CAIL B,120. + CAIGE A,120. + J BDGRPR +.I GXD=,GYD= + SKIPE WNDFLG + Q FXUPCF +.I GXD0=GX0-(GX0/GXD)*GXD,GYD0=GY0-(GY0/GYD)*GYD + R + +FXUPCF: HLRZ A,WXFC + HLRZ B,WYFC +.I ,,GXD=GXD*A,GYD=GYD*B + R + +BDGRPR: STRIKE _GRID TOO FINE + R ;USE OLD VALUES + +OPNTAB: SKIPE TBLOPN + J INGSUT +.I (DELTA*8+RATE)*8+2 + HRLM A,TBLOP + .OPEN TBLC,TBLOP + STOP TABLET WON'T OPEN + SO TBLOPN + SZ Z +INGSUT: +.I IUPWAT'=IUPCNT + M A,IGNTMS + CAILE A,1 + SOS IGNTMS ;INCREASE RATE + R + +WXFC: 2,,0 +WYFC: 2,,0 +WXOF: -2048. +WYOF: -2048. + +MASK1: 7777,,7777 +TBLOPN: 0 ;NON-ZERO IF TABLET OPEN +IGNTMS: 1 ;DIVIDES RATE TO GIVE TRUE RATE READ AT +IGNCNT: 0 +IUPCNT: 250. ;TIMES ROUND BEFORE WE INCREASE RATE AGAIN + +DEFINE ZUM XX + AND XX,MASK1 +TERMIN + DISHAD: Q FRAME + SKIPN HEADSW + J NOLSD +.I TALK<#STAMP,MESSX,MESSY> +NOLSD: SKIPN BUTFLG + R +.I TALK<#TPBTMS,TBTXL,TBTYL> +.I TALK<#BTBTMS,TBTXL,BTBYL> + R + +TPBTMS: PRINT _&0.MOVE&12.MOVE&24.COPY&36.COPY&48.FLUSH&60.FLUSH&72.FLUSH + PRINT _&0.SEGMENTS&12.FIGURES&24.SEGMENTS&36.FIGURES&48.POINTS&60.SEGMENTS&72.FIGURES + R + +BTBTMS: PRINT _&0.FINISH&12.LINE&24.CURVE&36.WINDOW&48.GRID&60.GENERATE&72.MOVE + PRINT _&0. &12.DRAW&24.DRAW&36.DEFINE&48.DEFINE&60.POLYGONS&72.POINTS + R + +TBTXL: 115. ;X TO PUT BUTTON MESS ON SCOPE + +TBTYL: 970. ;Y TO PUT TOP BUTTON MESS +BTBYL: 100. ;Y TO PUT BOTTOM BUTTON MESS + +NBUT: 7 ;NUMBER OF BUTTONS IN EACH ROW + +XBTHG: 1000. ;RIGHT END OF RIGHT MOST BUTT +XBTLW: -50. ;LEFT END OF LEFTMOST BUTT + +YBTHG: 930. ;Y ON TABLET OF UPPER BUTTONS +YBTLW: 90. ;Y ON TABLET OF LOWER BUTTONS + +TSTBTT: SKIPN BUTFLG + R ;BUTTONS NOT ENABLED + HRRZ B,PRSVAL ;USE UNMASKED VALUE SAVED BY INSTANT DISPLAY HACK + CAML B,YBTLW + CAML B,YBTHG + SKIPA + R ;BUTTONS NOT PRESSED + SZ TOBBUT + CAML B,YBTLW + SO TOBBUT' + HLRZ A,PRSVAL ;PICK UP X VALUE +.I (A-XBTLW)*NBUT/(XBTHG-XBTLW)-TOBBUT*NBUT + MM A,LASJOB' + M B,CARNUM ;MAY NOT ALWAYS WIN + CAIL B,50. + STRIKE _ + M P,[-PDLL+1,,PDL] ;RESTORE PDL + TYP3 PPCHCH(A) ;TYPE APPROPRIATE CHARACTER + SZ BUTFLG ;AVOID GETTING BACK INTO THIS ROUTINE + Q REMOS ;AWAIT LIFT-OFF + SO BUTFLG ;HAD TO BE ON TO GET IN HERE +.I PTDTA1<-1> + M A,LASJOB + JRST @DPCHTB(A) ;GO TO APPROPRIATE ROUTINE + GOST: POP P,CARNUM +GO: Q OPNINT +.I APOUSP=#POPJP +.I BUTFLV'=BUTFLG + SZ FRAMSW + SO BUTFLG + SKIPN BUTFLV + Q DINNER ;DISPLAY BUTTONS + Q REDTAB ;AWAIT BUTTON PRESSURE + J .-1 + +WINDOX: PUSH P,CARNUM + Q WINDOW + J GOST + +GRIDTX: PUSH P,CARNUM + Q GRIDT + J GOST + +DPCHTB: APPLES?DRAWMR?CONTMR?WINDOX?GRIDTX?CPYPOL?STRPNT + STRSEG?STRFIG?CPYSEG?CPYFIG?FLUSH?FLSSEG?FLSFIG + +PPCHCH: SIXBIT / R!/ + SIXBIT / D!/ + SIXBIT / C!/ + SIXBIT / W!/ + SIXBIT / G!/ + SIXBIT / P!/ + SIXBIT / MP!/ + SIXBIT / MS!/ + SIXBIT / MF!/ + SIXBIT / CS!/ + SIXBIT / CF!/ + SIXBIT / FP!/ + SIXBIT / FS!/ + SIXBIT / FF!/ + +DINYY: SO XLST ;INITIALISE ALL DISPLAY GOODIES + SO YLST + M A,DSPARY + M B,ARYORG(A) + M C,[403737,,403737] + MM C,(B) + HRRZ C,BYTPNT + AOS C + CAMGE C,B + J DINX1 + HRLS B + AOS B + BLT B,-1(C) ;CLEAN OUT DISPLAY ARRAY +DINX1: Q DISIN2 +.I DSPPNZ<,0,0> ;TO PREVENT FOLLOWING FROM BEING ORED IN 7 + M W,DRWINT ;SET INTENSITY + J DSPBRT + REDTAB: +.I IGNCNT=IGNTMS +REDTA0: SKIPE TYPED ;TEST TYPE 'INTERUPT' + J APPLES ;FINISH + SOSG IUPWAT + Q INGSUT ;INCREASE RATE AGAIN + AOBJN Z,.+2 + Q GTOMP ;GET A GULP + M A,(Z) + M B,A + .RBTC B, ;SHOW IT + TLZE A,400000 + J REDTA1 ;MISSED DATA + M B,A ;DISPLAY ONE POINT SPECIAL + ZUM B + Q ADJXYW + MM B,PRSVAL' ;SAVE FOR BUTTON TEST + MOVSS B + SUB B,CROSSZ + M C,@SECRT ;DISPLAY CURRENT PEN LOCATION + AND C,[776000,,776000] + IOR B,C + MM B,@SECRT + TLNN A,340000 ;IN CONTACT ? + Q TSTBTT ;YES,TEST BUTTONS + TRNN A,760000 ;IS REPEAT COUNT >1 ? + SOSG IGNCNT + R + J REDTA0 ;IGNORE, READ NEXT WORD + +REDTA1: Q INGSLW + J REDTA0 + +INGSLW: M A,IGNTMS + CAIG A,5 + AOS IGNTMS ;DECREASE RATE + R + +APPLES: .CLOSE TBLC, + SZ TBLOPN +.I PTDTA1<-1> + Q @APOUSP ;FINAL REQUEST + SZ BUTFLG ;DISABLE BUTTONS + M P,[-PDLL,,PDL] ;RESTORE PDL + Q DINNER ;REMOVE BUTTON DISPLAY + J @RSTART ;RETURN TO COMMAND INTERPRETOR + + ADJXYW: HRRE C,B ;MAP POINT IN B ON 340 - WITH LIMITS + HLRES B + SKIPE WNDFLG + SKIPE CRSFLG + SKIPA + Q AEDG + ASH B,-2 + ASH C,-2 + SKIPGE B + SZ B + CAIL B,2000 + MI B,1777 + SKIPGE C + SZ C + CAIL C,2000 + MI C,1777 + HRLS B + HRR B,C + R + +ADJWYX: SKIPE CRSFLG + SKIPN WNDFLG + R +EADG: HRRE B,A ;UNMAP POINT IN A + HLRES A + SUB A,WXOF + SUB B,WYOF + HRLES A + HRLES B + IDIV B,WYFC + PUSH P,B + IDIV A,WXFC + POP P,B + HRLS A + HRR A,B + R + +APOUSP: 0 ;WHERE TO GO WHEN DONE + +SQRITN: M A,MDATA(Y) + SUB A,MDATA-1(Y) + HRLZ B,SHTOVR ;SHORTEST SEGMENT SQUARED UP + Q SAMGA ;IS IT TOO SHORT ? + SKIPA + R ;YES + HRLZ B,EPSIL + Q SCLEPS + HLRZ C,B + HLRE A,MDATA(Y) ;SQUARE UP VERTICALS AND HORIZONTALS + HLRE B,MDATA-1(Y) + SUB A,B + MOVMS A + CAMGE A,C + HRLM B,MDATA(Y) ;COPY IN OLD X + HRRE A,MDATA(Y) + HRRE B,MDATA-1(Y) + SUB A,B + MOVMS A + CAMGE A,C + HRRM B,MDATA(Y) ;COPY IN OLD Y + + M A,MDATA(Y) + R + +SCLEPS: SKIPE EPSFLG + SKIPN WNDFLG + R + IDIV B,WXFC ;RANDOM CHOICE OF X FACTOR-KILLS C + HRLZS B + R + +POUSP: SKIPN SLPFLG ;EXIT ROUTINE FRO DRAMR + R +SLOPFX: CAIG Y,4 + R + SKIPE SNGFLG + Q SNGKLL + Q SLOP ;FIX UP SLOP AND DISPLAY AGAIN + SKIPN SNGREM + SKIPE SLPREM ;DID ANYTHING CHANGE + J DSUFRB ;YES, NEED TO REDISPLAY + R + +GTOMP: M B,[-100.,,TBDATA] ;READ A GULP FROM TABLET + .IOT TBLC,B + SUB B,[-100.,,TBDATA] + CAML B,[20.,,20.] + Q INGSLW ;REDUCE RATE IF READ MORE THAN 20. POINTS + HLLZS B + MOVN Z,B + HRRI Z,TBDATA ;GEN NEW AOBJ POINTER + R + +DSCRT: MI T,117 ;GENERATE PLACE FOR PEN-POINT IMMEDIATE DISPLAY + Q DSPPTZ +.I DSPPNI<1,1> + HRRZ A,BYTPNT + MM A,SECRT + JRST DCROST + +EPSDRW: 40. ;.075" + +OPNINT: Q OPNTAB + SZ TYPED +.I PTDTA1<-1> + R + +DM:DRAWMR: +.I APOUSP=#POUSP,EPSIL=EPSDRW + Q OPNINT + J DRAWL6 + DRAWL1: +.I PTDTA1<-1> + Q POUSP ;FIX UP SLOP-MAY REDISPLAY +DRAWL6: SZ T + Q CONTAC ;AWAIT CONTACT +RCRDL1: ZUM A + Q ADJWYX + Q PTDTA1 ;STORE DATA AND DISPLAY IT + Q TOUCHD ;AWAIT UP AND THEN DOWN + J DRAWL5 ;REMOVED FAR + J RCRDL1 ;CONTACT AGAIN, RECORD IT + +TOUCHD: Q REDTAB + TLZE A,40000 ;REMOVED FAR ? + R ;YES-UNUSUAL + TLZN A,200000 ;IN CONTACT ? + J TOUCHD ;YES +TOUCHT: Q REDTAB ;NOW WE ARE IN LIGHT CONTACT ONLY + TLZE A,40000 ;REMOVED FAR ? + R ;YES + TLZE A,340000 ;IN CONTACT ? + J TOUCHT ;NO + AOS (P) + R + +FCRUSH: ZUM A + Q ADJWYX +UPYPL: MM A,MDATA(Y) ;STORE IT-WITHOUT HAIR TYPICAL OF PTDTA + Q PYUP + SKIPA +PTDTA1: Q PTDTA + SKIPL C,MDATA-1(Y) + J DDTPIR ;DISPLAY IT + SZ T ; + R + +PTDTA: CAMN A,MDATA-1(Y) + R ;SAME AS LAST POINT + MM A,MDATA(Y) ;STORE DATA + SKIPL A + SKIPN EPSIL + J PYUP ;FORGET ALL THE HAIR + SUB A,MDATA-1(Y) + Q SAMGB + SKIPA + R ;'SAME' AS LAST POINT + SKIPE SQRFLG + Q SQRITN ;SQUARE UP VERTICAL AND HORIZONTAL LINES + SKIPN DELFLG + J PYUP ;DELETIONS NOT PERMITTED + SKIPL E,MDATA(Y) + SKIPGE F,MDATA-1(Y) + J PYUP ;EITHER CURRENT OR PREVIOUS -1 + SUB A,MDATA-2(Y) + Q SAMGB ;EQUAL TO SECOND LAST POINT ? + J SUB2YD + SOS Y ;YES, DELETE + J DSUFRA ;END OF SNAKE BIT IT - COULD BE AVOIDED + TOUFT: Q REMOS +CONTAC: Q REDTAB + TLZE A,340000 ;IN CONTACT ? + J CONTAC ;NO + R + +REMOS: Q REDTAB + TLZN A,200000 ;WAIT FOR LIFT-OFF + J REMOS + R + +GTSGX: Q OPNINT ;GET ONE SEGMENT WITHOUT A LOT OF HAIR + MM Y,YBVR' + Q TOUFT ;WAIT FOR LIFT-OFF AND CONTACT + +FCRDL1: Q FCRUSH ;TRANSFORM AND RECORD + Q TOUCHD + R ;LIFTED FAR, DONE + J FCRDL1 ;MORE TO COME + + +WINDOW: ;READ WINDOW AND MAGNIFY THE WORLD +.I APOUSP=#WNDPS, WNDFLV'=WNDFLG + SZ WNDFLG + SKIPE WNDFLV + Q RESTRM + Q CMWNGR + CAIGE B,2 + J WNDW1 ;ONLY ONE POINT TOUCHED + M A,MDATA(X) + HLRZM A,XR0 + HRRZM A,YR0 + M A,MDATA+1(X) + HLRZM A,XR1 + CAIG B,2 + J NLYTP ;ONLY TWO POINTS + M A,MDATA+2(X) + HRRZM A,YR1 +CMLYT: Q GTCFTA ;CALCULATE TRANSFORMATION +OLMAG: SO WNDFLG +ALMAG: J RESTRM ;CHANGE GRID TOO + + WNDW1: SKIPN WNDFLV ;ONE POINT TOUCHED ONLY + J OLMAG + R ;NOTHING MORE TO DO + +OPEN: SKIPN WNDFLG ;KILL MAGNIFICATION + R +OPEN1: SZ WNDFLG + J RESTRM + +WNDPS: CAMN Y,YBVR + R + M Y,YBVR + J RESTRM + +RESET: .I WNDFLV'=WNDFLG + SETZB Y,WNDFLG ;KILL ALL DATA +.I PTDTA<-1> +RESTRA: SKIPE WNDFLV +RESTRM: Q DINNER ;REDO GRID ETC. + J DSUFRA ;REDO DRAWING + +NLYTP: ;USE A SQUARE WINDOW +.I YR1=YR0+ABS<(XR1-XR0)> + J CMLYT + + ;GET HERE IF LOOSE CONTACT IN DRAW +DRAWL5: SKIPGE MDATA-1(Y);WAS LAST A -1 + J DRAWL6 ;UNUSUAL + Q DROWNT ;INVESTIGATE WHAT REALLY HAPPENED + J DRAWL1 +.I PTDTA1<-1> ;JUST IN CASE + J DRAWL6 + +DROWNT: SKIPL MDATA-2(Y) ;WAS LAST A POINT ? + R ;NO, A SEGMENT + SKIPE SNGFLG ;YES, ARE WE REMOVING SINGLE POINTS ANYWAY ? + J SUTN2 ;YES, RESULTING DSUFRA COULD BE AVOIDED + CAIG Y,3 ;ENOUGH DATA TO WARRANT THIS FUSS + R ;NO + M C,MDATA-1(Y) + Q KLSPPN ;SEE IF CAN KILL SPECIFIC POINT INC + SKIPN SRFNIT ;DID ANYTHING HAPPEN + R ;NO +SUTN2: SOS Y ;YES, NEED TO REDISPLAY + Q DSUFRA + AOS (P) + R + +KLLTWO: SUBI Y,2 + SKIPG Y + J FOOKL2 + MI A,MDATA-1(X) + HRLI A,MDATA+1(X) + CAMGE X,Y + BLT A,MDATA-1(Y) + R + +FOOKL2: MI Y,1 + R + +KLSPPN: MI X,2 ;NOW SEE IF POINT ALREADY EXCISTS + SZ SRFNIT' + HRLZ B,EPSIL + Q SCLEPS +RTLPSR: SKIPGE MDATA-2(X) ;SINGLE POINT ? + SKIPL MDATA(X) + J NDLPSR ;NO + M A,MDATA-1(X) + SUB A,C + Q SAMG ;'SAME' POINT ? + J NDLPSR ;NO + SO SRFNIT ;YES, LETS DELETE IT + Q KLLTWO + SKIPA +NDLPSR: AOS X + CAMGE X,Y + J RTLPSR + R + SUB2YD: Q PYUP ;NO TROUBLE AT END SO TRY DELETING SEGMENT + MI W,-1(Y) + Q ASSOXY ;TRY KILLING THIS SEGMENT + SKIPN DELPHN ;DID IT HAPPEN + R ;NOTHING HAPPENED + M A,MDATA-1(Y) + SO MDATA-1(Y) ;PUT IN A RECORD MARK + MM A,MDATA(Y) ;MAKE AS IF POINTED HERE + PUSHJ P,PYUP + J DSUFRA ;DISPLAY ANEW + +PYUP: AOS Y ;INCREMENT Y + CAIGE Y,NMDATA + R + STOP _TOO MUCH DATA-PYUP + +SNGKLL: SZ SNGREM' + CAIG Y,4 ;KILL SINGLE POINTS + R + MI X,2 +SNGK1: SKIPGE MDATA(X) + SKIPL MDATA-2(X) + J NOGATP + Q KLLTWO + SO SNGREM ;INDICATE SOMETHING HAPPENED + SKIPA +NOGATP: AOS X + CAMGE X,Y + J SNGK1 + R + +FOOD: SKIPE ESYFLG + Q ESYPLT ;REARRANGE DATA +.I FRCNPT=NOPINT + SZ X ;TYPE OUT DATA + PRINT _(_ +FOOD1: SKIPL MDATA(X) + Q SEGMT + AOS X + CAMGE X,Y + J FOOD1 + PRINT _)_ + SZ FRCNPT + R + +SEGMT: PRINT _( + SZ U ;TYPE OUT SEGMENT + SETOM COMETH' ;TELL BEGINNING OF SEGMENT +SEGL1: SKIPGE B,MDATA(X) + J NDSEY1 + Q DOTPIR + AOS X + CAMGE X,Y + J SEGL1 + +NDSEY1: PRINT )_ + R + +DOTPIR: HLRE A,B ;TYPE OUT DOTTED PAIR + HRRES B + SKIPE ONEFLG + ASH A,-2 + SKIPE ONEFLG + ASH B,-2 + AOS U + SKIPL LSTFLG + CAMGE U,PERLN ;ENOUGH FOR THIS LINE OF OUTPUT + J PRUPR + PRINT _ + MI U,1 +PRUPR: SKIPLE COMETH + Q TERQUA + SKIPGE LSTFLG + AOS COMETH +.I NONE'=,NTWO'= + SKIPL LSTFLG + PRINT ( + PRINT #1 + SKIPN LSTFLG + PRINT . + PRINT #2 + SKIPL LSTFLG + PRINT ) + SKIPGE LSTFLG + PRINT + R + +TERQUA: PUSH P,A + PUSH P,B + PRINT ) + CAMGE U,PERLN + J POOPS + PRINT _ + MI U,2 +POOPS: +.I NONE,NTWO + PRINT (#1 #2 + POP P,B + POP P,A + POPJ P, + +DFOOD: Q DSUFR ;DISPLAY DATA + J DISGO ;DANGER ! + +DSUFR: SKIPE SNGFLG + Q SNGKLL ;KILL SINGLE POINTS +DSUFRB: SKIPE COMFLG + Q COMPCT ;COMPACTIFY +DSUFRA: Q DINYY ;DISPLAY IT ALL + SETZB X,T +DFOOD1: SKIPL C,MDATA(X) + Q DSEGL3 + AOS X + CAMGE X,Y + J DFOOD1 + R + +DSEGL1: SKIPGE C,MDATA(X) + J DSEGL2 +DSEGL3: Q DDTPIR + AOS X + CAMGE X,Yî + J DSEGL1 + R + +DSEGL2: SZ T + R + +DDTPIR: HLRE B,C ;DISPLAY A DOTTED PAIR + HRRES C + JUMPE T,PNTFRS + PUSH P,X + Q VVECT + POP P,X + R + +PNTFRS: SO T ;FIRST ONE IN POINT MODE + PUSH P,X + Q VPOIN + POP P,X + R + AEDG: IMUL B,WXFC ;APPLY WINDOWING TRANSFORMATIONS + HLRES B + ADD B,WXOF + IMUL C,WYFC + HLRES C + ADD C,WYOF + R + +VPOIN: SKIPN WNDFLG + J DSPPN5 ;NO WINDOWING NEEDED + Q AEDG + ASH B,-2 + ASH C,-2 + J DPOIN + +DSPPN5: ASH B,-2 + ASH C,-2 + SKIPN EXTFLG + J DSPPNI + J DPOIN + +VVECT: SKIPN WNDFLG + J DSPVC5 ;NO WINDOWING REQUIRED + Q AEDG + ASH B,-2 + ASH C,-2 + J DVECT + +DSPVC5: ASH B,-2 + ASH C,-2 + SKIPN EXTFLG + J DSPVCA + J DVECT + +EXTFLG: 0 ;NON-ZERO TO ALLOW SOME WINDOWING WITHOUT WNDFLG ON + ;NOTE-NEGATIVE X'S ARE IMPOSSIBLE + +NVRTX: +.I XR0=XR1,XR1=XR0 + J GTCFTA + +NVRTY: +.I YR0=YR1,YR1=YR0 + +GTCFTA: ;CALCULATE WINDOWING COEFFICIENTS +.I XR1-XR0,YR1-YR0 + JUMPL A,NVRTX + JUMPL B,NVRTY + CAIL B,120. + CAIGE A,120. + J BDWNPR +.I WXFC=4096.*1000000/(XR1-XR0) +.I WYFC=4096.*1000000/(YR1-YR0) +.I WXOF=-XR0*WXFC/1000000 +.I WYOF=-YR0*WYFC/1000000 + R + +BDWNPR: STRIKE _WINDOW TOO SMALL + R ;USE OLD VALUES + + XR0: 0 +YR0: 0 +XR1: 0 +YR1: 0 + +ST:STRGT:STRPNT: ;STRAIGHTEN FUNCTION-MOVES POINTS +.I APOUSP=#POPJP, EPSIL=EPSDRW + Q OPNINT + SETZB U,ADJSW' +STRG2: Q CONTRS + Q ADJST1 ;ADJUST NEARBY POINTS + Q DSUFRA ;DISPLAY IT AGAIN - OFTEN SKIPPED + J STRG2 + +ADJST1: M E,A + SZ X + HRLZ B,EPSIL + Q SCLEPS +ADJLP1: SKIPGE A,MDATA(X) + J NADJL1 + SUB A,E + JUMPE A,NADJL1 ;VERY UNLIKELY, BUT ... + Q SAMG + J NADJL1 + MM E,MDATA(X) ;UPDATE + SO ADJSW +NADJL1: AOS X + CAMGE X,Y + J ADJLP1 + + AOS (P) + AOS U + CAME U,DSRAT ;DISPLAY EVERY DSRAT'TH TIME + R + SZ U + SKIPN ADJSW + R + SZ ADJSW + SOS (P) + R + + +EPSFLS: 20. ;.05" + +FLUSH: ;FLUSH VERTICES INSTEAD OF LINES +.I APOUSP=#POPJP, EPSIL=EPSFLS + Q OPNINT + SKIPA +CUMLA: Q DSUFRA ;RE-DISPLAY + M W,Y +CUML2: Q CONTRS + M E,A + Q ASSEXY + SKIPN DELPHN ;DID IT HAPPEN + J CUML2 ;NO + J CUMLA ;YES, NEED TO REDISPLAY + ASSEXY: SZ DELPHN' ;DELETE POINT IN E + CAIG W,3 + R + SZ X + HRLZ B,EPSIL + Q SCLEPS +ASSEX0: SKIPL A,MDATA(X) + Q SESSY ;COMPARE POINTS TO PRESENT ONE + AOS X + CAMGE X,W + J ASSEX0 + R + +SESSY: SUB A,E + Q SAMG + R + SO DELPHN ;SAME POINT, SO DELETE IT + SKIPL MDATA+1(X) + SKIPGE MDATA-1(X) + J MUDW1 ;IS AT EITHER END OF SEGMENT + SO MDATA(X) ;IS INSIDE SEGMENT + R + +KLLONE: SOSG Y + J FOOKL2 + MI A,MDATA(X) + HRLI A,MDATA+1(X) ;FROM,,TO + CAMGE X,Y + BLT A,MDATA-1(Y) + R + +EAT: ;READ INPUT DATA-APPEND TO INTERNAL STUFF +.I PTDTA1<-1> +EAT1: Q TYI + CAIE A,"( + J EAT1 + +ESEG1: Q TYI + CAIN A,"( + J EDPTR + CAIE A,") + J ESEG1 + R ;END OF INPUT + +EDPTR: Q TYI ;READ A DOTTED PAIR + CAIN A,"( + J EDPTR0 + CAIN A,") + J EDPTR9 + CAIL A,"0 + CAILE A,"9 + J EDPTR + SETOM UNRCHF ;QUADS +.I PTDTA1<-1> + Q EDPTR8 + SETZM UNRCHF + Q EDPTR8 + J EDPTR + +EDPTR0: Q EDPTR8 +EDPTR7: Q TYI + CAIE A,") + J EDPTR7 + J EDPTR + +EDPTR9: +.I PTDTA1<-1> + J ESEG1 ;END OF SEGMENT + +EDPTR8: Q REDDED + PUSH P,A +EDPTR1: + Q TYI + CAIL A,"0 + CAILE A,"9 + J EDPTR1 + SETOM UNRCHF + Q REDDED + POP P,B + HRL A,B + SKIPE SWPFLG + MOVSS A + Q UPYPL + SETOM UNRCHF + POPJ P, + +SCLFCT: 1,,0 ;SCALE TO BE APPLIED TO INPUT +SWPFLG: 0 ;SHOULD X,Y BE SWAPPED +INVTX: 0 ;NON-ZERO TO INVERT X WRT 2000 +INVTY: 0 ;NON-ZERO TO INVERT Y WRT 2000 + +REDDED: Q REDNN + SKIPN INVTX + R +INVRTT: SUBI A,1777 + MOVNS A + R + +REDNN: Q RDNUM + SKIPE ONEFLG + LSH A,2 + IMUL A,SCLFCT + HLRES A + R + + SAMGB: HRLZ B,EPSIL +SAMGA: Q SCLEPS +SAMG: MOVMS A ;TEST IF BOTH HALVES < EPSIL IN B + CAML A,B + R + MOVSS A + MOVMS A + CAMGE A,B + AOS (P) + R + +ASSOX: M W,Y ;SEGMENT IN E,F FIND AND DELETE IT +ASSOXY: SZ DELPHN' + SKIPE EPSIL + CAIG W,3 + R + SZ X + HRLZ B,EPSIL + Q SCLEPS +ASSOX0: SKIPL A,MDATA(X) + Q SASSY + AOS X + CAMGE X,W + J ASSOX0 + R ;GIVE UP + +SASSY: SUB A,E ;FIRST ERROR TERM + Q SAMG + R ;LOSSAGE + M A,MDATA-1(X) + SUB A,F + Q SAMG + J OTHRS +;X AND X-1 +XAXM1: SKIPGE MDATA+1(X) ;IS THERE AN END OF SEGMENT NEARBY + J MVDW1 + SKIPGE MDATA-2(X) + J MVDW2 + Q PYUP ;NOPE, NEED TO EXPAND + + MI A,MSAVE + HRLI A,MDATA(X) + MI C,MSAVE(Y) + SUB C,X + BLT A,-1(C) + + SO MDATA(X) + + MI A,MDATA+1(X) + HRLI A,MSAVE + BLT A,MDATA-1(Y) + + SUB P,[1,,1] + SO DELPHN + R + + OTHRS: M A,MDATA+1(X) ;TRY OTHER DIRECTION OF SEGMENT + SUB A,F + Q SAMG + R ;FOOEY +;X AND X+1 + AOS X + J XAXM1 + +MVDW2: SOS X +MVDW1: SO DELPHN +MUDW1: Q KLLONE + AOS (P) ;SKIP THE AOS X + R + +DELET: Q RDNUM ;DELET SEGMENT SPECIFIED BY X1,Y1,X2,Y2 + HRL E,A + Q RDNUM + HRR E,A + Q RDNUM + HRL F,A + Q RDNUM + HRR F,A + Q ASSOX + J DSUFR + +DELAT: ;DELETE SEGMENT SPECIFIED BY N,M +.I AXAXM'=#XAXM1 +FNDPLC: Q RDNUM + MM A,SEGTN' + Q RDNUM + MM A,TERNT' + SZ X +DELA1: SKIPL MDATA(X) + Q ASECT + AOS X + CAMGE X,Y + J DELA1 + R ;NOT FOUND + +ASECT: SOSGE SEGTN + J RGHSEG +ASEC1: SKIPGE MDATA(X) + R + AOS X + J ASEC1 + +RGHSEG: ADD X,TERNT + AOS X + Q @AXAXM + Q DSUFR + SUB P,[1,,1] + R + MODIF: ;MODIFY N,M TO X,Y +.I AXAXM'=#HAIRM + J FNDPLC +HAIRM: Q RDNUM + M B,A + Q RDNUM + HRL A,B + MM A,MDATA-1(X) + J DSUFRA + +SLOP: SZ SLPREM' + SKIPE EPSIL + CAIG Y,3 + R + SZ X ;REMOVE SLOP IN DATA + HRLZ B,EPSIL + Q SCLEPS +TRYWUS: MI W,1(X) +TRYXUS: SKIPGE C,MDATA(W) + J AOSTWS + SKIPGE A,MDATA(X) + J AOSTXS + SUB A,C + Q SAMG + J AOSTWS + M A,MDATA(X) + MM A,MDATA(W) ;COPY UP + SO SLPREM ;INDICATE SOMETHING CHANGED +AOSTXS: AOS X + CAMGE X,Y + J TRYWUS + R + +AOSTWS: AOS W + CAMGE W,Y + J TRYXUS + J AOSTXS + + +COMPCT: CAIG Y,3 ;COMPACTIFY EXTRA -1'S ETC. + R + SO MDATA(Y) ;JUST IN CASE + SZ X ;REMOVE EXTRA -1'S AND LINK + SKIPA +COMPC0: AOS X +COMPC3: SKIPGE A,MDATA(X) + J COMPC2 + CAME A,MDATA+1(X) + J COMPC0 + Q KLLONE + CAML X,Y + J BLUBT + J COMPC3 + + COMPC2: CAML X,Y + J BLUBT + SKIPGE B,MDATA+1(X) + J MURT1 + CAMN B,MDATA-1(X) + Q KLLTWO + CAML X,Y + J BLUBT + J COMPC0 + +MURT1: Q KLLONE + J COMPC2 + +BLUBT: AOS Y + SO MDATA(Y) + R + +FIXMAG: Q FIXMA1 ;FIX MAGNIFICATION +.I WNDFLV'=WNDFLG + SZ WNDFLG + SKIPN WNDFLV + J RESTRM + R + +FIXMA1: SZ X +ASHLP1: SKIPGE C,MDATA(X) + J ASHT1 + HLRE B,C + HRRE C,C + Q AEDG ;MAGNIFY + JUMPL B,LOSTPA ;KILL THINGS OUT OF RANGE + JUMPL C,LOSTPA + CAIGE B,4096. + CAIL C,4096. + J LOSTPA + HRL C,B + MM C,MDATA(X) +ASHT1: AOS X +ASHT2: CAMGE X,Y + J ASHLP1 + R + +LOSTPA: Q KLLONE + J ASHT2 + +KLLOUT: Q FIXMA1 +UNMAG: Q UNMA1 ;INVERSE MAGNIFICATION +.I WNDFLV'=WNDFLG + SZ WNDFLG + J RESTRA + +UNMA1: SZ X +USHLP1: SKIPGE A,MDATA(X) + J USHT1 + Q EADG ;UNMAGNIFY + MM A,MDATA(X) +USHT1: AOS X + CAMGE X,Y + J USHLP1 + R + ESYPLT: Q COMPCT ;MAKE IT EASY TO PLOT + SZ X + SKIPA +ESYPL0: AOS X + SKIPL MDATA(X) + J ESYPL0 + CAML X,Y + J COMPCT ;DONE-UNUSUAL + M U,X +ESYPL1: AOS U + SKIPL MDATA(U) + J ESYPL1 + CAML U,Y + J COMPCT ;DONE + SOS U + HLRE E,MDATA(U) + HRRE F,MDATA(U) + M W,U + SZ WNEW' +.I MINDS'=1000000 + Q ESYPL2 ;FIND OPTIMAL NEXT LINE + SKIPN W,WNEW + J COMPCT ;WE DIND'T GET TOO FAR ! + SKIPL MDATA-1(W) + Q RVRDW ;REVERSES SEGMENT AND SKIPS + Q GTTPND + ADDI U,2 + Q MVDWN + MI X,-2(U) + J ESYPL0 + +MVDWN: CAMGE W,V + CAML U,W + R + MI A,MSAVE + HRLI A,MDATA(U) + MI B,MSAVE(W) + SUB B,U + BLT A,-1(B) + + MI A,MDATA(U) + HRLI A,MDATA(W) + MI B,MDATA(U) + ADD B,V + SUB B,W + BLT A,-1(B) + + MI A,MDATA(U) + ADD A,V + SUB A,W + HRLI A,MSAVE + BLT A,MDATA-1(V) + R +;U POINTS TO FIRST IN LOWER BLOCK +;W POINTS TO FIRST IN TOP BLOCK +;V POINTS TO LAST + 1 IN TOP BLOCK + ESYPL2: AOS W + SKIPL MDATA(W) + J ESYPL2 + SOS W + CAME W,U + Q CALCDS + ADDI W,2 + CAML W,Y + R ;DONE + Q CALCDS + J ESYPL2 + +CALCDS: HLRE A,MDATA(W) + HRRE B,MDATA(W) + SUB A,E + SUB B,F + MOVMS A + MOVMS B + CAMG A,B + M A,B ;RIGHT METRIC FOR PLOTTER + CAML A,MINDS + R ;NOT BETTER + MM W,WNEW + MM A,MINDS + CAMG A,ESYLIM ;WHY FUXX ABOUT SHORTER STUFF + SUB P,[1,,1] ;POP EXTRA LEVEL UP + R + +ESYLIM: 100. + +RVRDW: SKIPL MDATA+1(W) + .VALUE ;WHAT THE HELL, W NOT NEAR GAP + M V,W + Q GTTPW1 + PUSH P,V + PUSH P,W +EXRVRS: M A,MDATA(W) + EXCH A,MDATA(V) + MM A,MDATA(W) + AOS W + SOS V + CAMGE W,V + J EXRVRS + POP P,W + POP P,V + ADDI V,2 + AOS (P) + R + +GTTPND: M V,W +GTTPN1: AOS V ;MOVE V TO ABOVE NEXT -1 UP + SKIPL MDATA(V) + J GTTPN1 + AOS V + R + + GTTPW1: SOS W ;MOVE W TO ABOVE NEXT -1 DOWN + SKIPL MDATA(W) + J GTTPW1 + AOS W + R + +PLOTS: Q ESYPLT + PUSH P,GRDINT + PUSH P,FRAMSW + PUSH P,BUTFLG + SZ GRDINT + SO FRAMSW + SZ BUTFLG +.I PLOT>> + POP P,BUTFLG + POP P,FRAMSW + POP P,GRDINT + J RESTRM + SGX: 0 ;RUNNING TOTALS +SGY: 0 +SGX2: 0 +SGXY: 0 +SGY2: 0 + +SDGX2: 0 ;SUM OF PRODUCTS WRT CG +SDGXY: 0 +SDGY2: 0 + +SGMDV: 0 ;VARIANCE + +CGX: 0 ;CG +CGY: 0 + +LSIN: 0 ;SLOPE OF CURRENT LINE +LCOS: 0 + +CSX: 0 ;SAVED CGX,CGY +CSY: 0 + +SSIN: 0 ;SAVED LSIN,LCOS +SCOS: 0 + +XDX0: 0 ;FIRST POINT IN SEGMENT +YDY0: 0 + +XDXS: 0 ;FIRST POINT IN CURRENT LINE +YDYS: 0 + +XDX: 0 ;CURRENT POINT +YDY: 0 + +INCRCV: AOS NPNT ;UPDATE TOTALS +.F SGX=SGX+XDX,SGY=SGY+YDY,SGX2=SGX2+XDX^2 ,SGXY=SGXY+XDX*YDY,SGY2=SGY2+YDY^2 + R + +INTCV: ;INITIALISE TOTALS +.F NPNT'=SGX=SGY=SGX2=SGXY=SGY2=0 + R + +OFLNPN: ;DISTANCE^2 OF POINT XDX,YDY FROM LINE CGX,CGY;LSIN,LCOS +.F (LSIN*(XDX-CGX)-LCOS*(YDY-CGY))^2 /(LSIN^2 +LCOS^2 )-(OFSLIM/FLTSCL)^2 + SKIPGE A + AOS (P) + R ;SKIPS IF DISTANCE SMALL + + PRJLNP: ;PROJECTION OF POINT XDX,YDY ON LINE CGX,CGY;LSIN,LCOS +.F DENOM'=LSIN^2 +LCOS^2 +.F (LSIN^2 *CGX+LSIN*LCOS*(YDY-CGY)+LCOS^2 *XDX)/DENOM,$ +.F (LCOS^2 *CGY+LSIN*LCOS*(XDX-CGX)+LSIN^2 *YDY)/DENOM + R + +INTLNS: ;INTERSECTION CGX,CGY;LSIN,LCOS AND CSX,CSY;SSIN,SCOS +.F DENOM'=LSIN*SCOS-LCOS*SSIN + SKIPN A + J PRLLSS ;PARALLEL LINES +.F (LSIN*SCOS*CGX+LCOS*SCOS*(CSY-CGY)-LCOS*SSIN*CSX)/DENOM,$ +.F (LSIN*SCOS*CSY-LSIN*SSIN*(CSX-CGX)-LCOS*SSIN*CGY)/DENOM +;IF A,B TOO FAR FROM CGX,CGY OR CSX,CSY USE AVERAGE +.F ,,(CGX-CSX)^2 +(CGY-CSY)^2 ,(A-CGX)^2 +(B-CGY)^2 +(A-CSX)^2 +(B-CSY)^2 + CAMG D,C + R +PRLLSS: +.F (CGX+CSX)/2.0,(CGY+CSY)/2.0 + R + +TSTCRV: M A,NPNT ;GET OPTIMAL LINE AND RMS + CAIG A,1 + STOP _TOO FEW POINTS TSTCRV +.F FNPT'=FFLOAT +.F CGX=SGX/FNPT,CGY=SGY/FNPT +.F SDGX2=SGX2-FNPT*CGX^2, SDGXY=SGXY-FNPT*CGX*CGY, SDGY2=SGY2-FNPT*CGY^2 +.F LSIN2'=2.0*SDGXY/FNPT, LCOS2'=(SDGX2-SDGY2)/FNPT + SKIPN B + Q FXBSN + SKIPN A + Q FXASN +.F LSIN=SQRT-LCOS2, LCOS=LSIN2 +.F /(FNPT*(LSIN^2 +LCOS^2))*(LSIN^2 *SDGX2-2.0*LSIN*LCOS*SDGXY+$ +.F LCOS^2 *SDGY2)-(SGMLIM/FLTSCL)^2 +;VARIANCE - IE. RMS ^ 2 + SKIPGE A + AOS (P) + R ;SKIPS IF RMS SMALL + +FXBSN:.F ,LCOS2=0.0001 + R + +FXASN:.F LSIN2=.0001*LCOS2 + R + +CHKTMS: 7 ;REPEAT BEFORE CHECK RMS + +OFSLIM: 10.0 ;OFFSET LIMIT +SGMLIM: 10.0 ;RMS LIMIT +FLTSCL: 1.0 ;SCALING TO TO WINDOWING + +FLABC: HRRE B,A + HLRE A,A + FLOAT A + FLOAT B + R + CONTRS: Q CONTAC + ZUM A + J ADJWYX + +FXABC: FIX B + FIX A + HRL A,B + HRR A,C + R + +CM:CONTMR: +.I APOUSP=#POPJP + Q OPNINT +.F FLTSCL=1.0 + SKIPE EPSFLG + SKIPN WNDFLG + J CONL1 +.F FLTSCL=FFLOAT/FFLOAT<1000000> +CONL1: +.I PTDTA1<-1> + Q CONTRS + Q FLABC ;SEPERATE AND FLOAT +.I XDX0=XDXS=XDX=,YDY0=YDYS=YDY= ;SAVE BEGINNING OF SEGMENT + SO FRSGD' ;INDICATE START OF SEGMENT + Q INTCV ;RESET ACS +MYGDNS: SO ALSFRS' ;INDICATE NO GUESS AVAILABLE YET +CONL3A: SZ U +CONL3: Q REDTAB + TLZE A,200000 ;IN CONTACT ? + J CONL9 ;NO + ZUM A + Q ADJWYX + Q FLABC +.I XDX=,YDY= + SKIPE ALSFRS + J NOTYTS ;CANNOT TEST OFFSET YET + Q OFLNPN ;SKIPS IF OFFSET OK + J CONL11 ;NO + +NOTYTS: Q INCRCV ;UPDATE ACS + AOS U + CAME U,CHKTMS ;WANT TO CALC LINES AND RMS ? + J CONL3 ;NO + Q TSTCRV ;SKIPS IF RMS OK + J CONL10 + SZ ALSFRS ;NOW HAVE GUESS AT LINE + J CONL3A + +CONL9: SKIPN FRSGD ;LOST CONTACT + J GDND ;PROPER END +.F XDX-XDX0,YDY-YDY0 + JUMPN A,.+3 + SKIPN B + J COMNDL ;A SINGLE POINT +.I UPYPL> + COMNDL: +.I UPYPL> + J CONL1 + +GDND: SKIPN ALSFRS + J VGDND ;VERY PROPER ENDING +.I UPYPL> + J COMNDL + +VGDND: ;REALLY COOL ENDING +.I UPYPL>> ;FIND INTERSECTION WITH LAST +.I UPYPL>> ;AND PROJECTION + J CONL1 + +CONL11:CONL10: SKIPN FRSGD + J RGDND + SZ FRSGD + PUSH P,XDX + PUSH P,YDY +.I XDX=XDX0,YDY=YDY0 +.I UPYPL>> + POP P,YDY + POP P,XDX +MYCMNS: +.I XDXS=XDX,YDYS=YDY +.I CSX=CGX,CSY=CGY,SSIN=LSIN,SCOS=LCOS +;.F NPNT=1,SGX=XDX,SGY=YDY,SGX2=XDX^2,SGXY=XDX*YDY,SGY2=YDY^2 +;LAST POINT HERE GETS PUT IN WITH NEW LOT-MAY BE WORSE THAN INTCV + Q INTCV + J MYGDNS + +RGDND: +.I UPYPL>> ;INTERSECTION WITH PREVIOUS + J MYCMNS + +NSIDS: 6 ;NUMBER OF SIDES IN POLYGON +NSIZS: 120. ;RADIUS OF POLYGON +TWPIE: 6.2831852 + +KM:CPYPOL: SO OLDXY' +.I APOUSP=#POPJP, EPSIL=EPSDRW + Q OPNINT +KLUDG1: +.I PTDTA1<-1> + Q CONTRS + M E,A + SUB A,OLDXY + MM E,OLDXY + Q SAMGB + SKIPA + J KLUDG4 ;NEAR PREVIOUS ONE + HRRE B,E + HLRE A,E +.F XDX=,YDY= + Q INSRTK + KLUDG3: Q REMOS + J KLUDG1 + +KLUDG4: SUB Y,NSIDS + SOS Y + SOSG Y + MI Y,1 + Q DSUFRA + SO OLDXY + J KLUDG3 + +INSRTK: +.F FNSIDS'=FFLOAT,FNSIZS'=FFLOAT + M G,NSIDS +INSRL1: +.F FFIX/FNSIDS)>*FNSIZS>,FFIX*FNSIZS> + ADD A,XDX + ADD B,YDY + HRLS A + HRR A,B + Q UPYPL + SOJGE G,INSRL1 + R + +CPYNEW: ;COPY UP SEGMENT FROM VYLOW TO VYABS MOVE FROM (CXYSV) TO (G) + SKIPG V,VYABS + R +.I PTDTA1<-1> ;JUST IN CASE + SUB G,CXYSV + M X,VYLOW +MVUPMR: SKIPL A,MDATA(X) + ADD A,G + Q UPYPL + AOS X + CAME X,V + J MVUPMR +.I PTDTA1<-1> ;JUST IN CASE + R + +MOVFRS: ;MOVE SEGMENT FROM VYLOW TO VYABS FROM (CXYSV) TO (C) + SKIPG V,VYABS + R + SUB C,CXYSV + M X,VYLOW +MOVFR1: SKIPL MDATA(X) + ADDM C,MDATA(X) + AOS X + CAMGE X,V + J MOVFR1 + R + +KLLLST: SKIPG V,VYABS ;KILL LAST COPY CREATED + R + SUB Y,V + ADD Y,VYLOW + J DSUFRA + FNDSIM: ;FIND FIRST NEAR POINT TO ONE IN F + SZ X + HRLZ B,EPSIL + Q SCLEPS +NAOSLP: SKIPGE A,MDATA(X) + J NAOSXL + SUB A,F + Q SAMG + SKIPA + R ;MATCH +NAOSXL: AOS X + CAMGE X,Y + J NAOSLP + AOS (P) ;SKIPS IF NOT FOUND + R + +SPRWNG: M V,W ;PUT W AT START, V AT END +1 OF SEGMENT + Q GTTPW1 ;MOVE W DOWN + J GTTPN1 ;MOVE V UP + +FNDEQ1: CAMN A,MDATA(W) ;FIND POINT EQUAL TO A, START AT W + R ;FOUND IT + AOS W + CAMGE W,Y + J FNDEQ1 + AOS (P) ;SKIPS IF NOT FOUND + R + +CRFT1: M F,A + Q FNDSIM ;FIND NEAR ONE + SKIPA + R ;NO LUCK + M A,MDATA(X) + MM A,CXYSV' ;NEAREST POINT IN OBJECT + MM F,DXYSV' ;PEN POSITION + M W,X + Q SPRWNG ;SPREAD WINGS TO END OF CURRENT SEGMENT + MM V,VYABS' + MM W,VYLOW' + AOS (P) + SKIPN FIGFLG + R ;SEGMENTS ONLY + MI U,1 + Q MVDWN ;COPY DOWN THE WORLD +.I VYABS=VYABS-VYLOW+1,VYLOW=1 + SZ SLPREM ;CLOSE SET WRT TOUCHING OF SEGMENTS + SKIPE COMFLG ;BETTER BE ON + Q COMPCT + SKIPE SLPFLG ;BETTER BE ON + Q SLOP + SKIPE SLPREM + SO ADJSW ;TO ENSURE GETS DISPLAYED SOMETIME + SZ X +ALLSE1: SKIPL A,MDATA(X) + Q ALSECT + AOS X + CAMGE X,VYABS + J ALLSE1 + R + ALSECT: M W,VYABS + Q FNDEQ1 + SKIPA + R ;FOUND NONE + Q SPRWNG ;TOUCH NEAREST -1'S + M U,VYABS + Q MVDWN ;COPY IT DOWN +.I VYABS=U+V-W + CAMGE A,Y + J ALSECT ;TRY FOR MORE + SUB P,[1,,1] ;ALL DONE-POP EXTRA LEVEL UP + R + + +STRFIG: SO FIGFLG ;MOVE FIGURES AROUND + SKIPA +STRSEG: SZ FIGFLG ;MOVE SEGMENTS AROUND +.I APOUSP=#POPJP, EPSIL=EPSDRW + Q OPNINT + SETZB G,ADJSW' +STRSE3: SO CXYSV' +STRSE2: Q REDTAB + TLZE A,340000 + J STRSE3 ;TO ALLOW FIGURES TO GROW EASILY + ZUM A + Q ADJWYX + Q ADJST2 + Q DSUFRA ;OFTEN SKIPPED + J STRSE2 + +ADJST2: SKIPL C,CXYSV + J HAVONE ;WE ARE POINTING TO ONE +CRFT2: Q CRFT1 + SKIPA ;NOTHING + J ALLBLL ;HERE IF WE FOUND ONE +NOTNER: AOS (P) + AOS G + CAME G,DSRAT + R + SZ G + SKIPN ADJSW + R + SZ ADJSW + SOS (P) + R + +ALLBLL: M C,DXYSV ;PEN POSITION + J APSDUF + HAVONE: M D,A ;SAVE + SUB A,C + Q SAMGB ;NEAR ONE WE ARE KEEPING TABS ON ? + J NOTNRL ;NOPE + M C,D +APSDUF: Q MOVFRS ;MOVE + SO ADJSW + ADDM C,CXYSV + J NOTNER + +NOTNRL: M A,D + SO CXYSV + J CRFT2 + + +CPYFIG: SO FIGFLG ;COPY FIGURES + SKIPA +CPYSEG: SZ FIGFLG +.I APOUSP=#POPJP, EPSIL=EPSDRW + Q OPNINT +CPYSE2: SO OLDXY' + Q CONTRS + Q PCKUP1 ;SEE IF FOUND ONE + J CPYSE2 ;NO +CPYDG3: Q REMOS + Q CONTRS ;WAIT FOR PUT DOWN + M G,A + SUB A,OLDXY + MM G,OLDXY + Q SAMGB + SKIPA + J DELTG4 ;GO DELETE LAST COPY + Q CPYNEW + J CPYDG3 ;MORE TO COME + +PCKUP1: Q CRFT1 ;SEE IF ONE NEAR + J PCKST ;NO + AOS (P) + STRIKE * + R ;NOW READY TO GEN COPIES + +PCKST: SKIPE SLPREM + J DSUFRA ;REDISPLAY + R + +DELTG4: Q KLLLST + SO OLDXY + J CPYDG3 + + FLSFIG: SO FIGFLG ;FLUSH FIGURES + SKIPA +FLSSEG: SZ FIGFLG +.I APOUSP=#POPJP,EPSIL=EPSDRW + Q OPNINT + SO OLDXY' +FLSSE3: Q CONTRS + Q CRFT1 + SKIPA ;NO LUCK + J DELNEW ;DELETE IT + SKIPGE OLDXY + J FLSSE3 ;NO OLD POSITION AVAILABLE + M A,F ;PEN POSITION + SUB A,OLDXY + HRLI B,100. + Q SAMGA ;NEAR LAST ONE ? + J FLSSE3 ;NO (FLLSE2 ?) + Q OVBRTH ;BRING BACK TO LIFE +REFLS4: Q REMOS ;AWAIT LIFT-OFF + J FLSSE3 + +DELNEW: MM F,OLDXY' + SKIPGE W,VYABS + R + M U,VYLOW + M V,Y + Q MVDWN +.I VYLOW-Y=VYLOW+Y-VYABS,VYABS=Y +COMSUF: Q DSUFRA + J REFLS4 + + +OVBRTH: ;REINSTATE LAST ONE DELETED + SZ T +OVBRT0: SKIPGE C,MDATA(Y) ;? + J OVBRT1 + Q DDTPIR +OVBRT2: AOS Y + CAMGE Y,VYABS + J OVBRT0 + SZ T + J REFLS4 + +OVBRT1: SZ T + J OVBRT2 + + + TSTWAT: SETZM DSKYES' + CAIN A,(SIXBIT /DSK/) + SETOM DSKYES' + LSH A,-3 + CAIN A,(SIXBIT / UT/) + SETOM DSKYES' + POPJ P, + +WRITE: MOVEI A,1 ;OUTPUT ASCII MODE + HRLM A,ONOP + PUSHJ P,TTINW + HRRZ A,ONOP + PUSHJ P,TSTWAT + PUSHJ P,OPNDO + POPJ P, + SKIPE DSKYES + EXCH ZR,DSKONL +.I QITADR=#WRITEQ + + PUSHJ P,FOOD + +WRITEQ: SKIPE DSKYES + EXCH ZR,DSKONL + SETZM QITADR + JRST CLONDO + +READ: PUSHJ P,RESET +READMR: MOVEI A,0 ;INPUT ASCII MODE + HRLM A,INOP + PUSHJ P,TTINR + HRRZ A,INOP + PUSHJ P,TSTWAT + PUSHJ P,OPNDI + POPJ P, + SKIPE DSKYES + EXCH ZR,DSKONL +.I QITADR=#READQ + + MOVE A,DSKONL + TRNE A,DISFLG + TRO ZR,DISFLG ;COPY IN DISFLG + + PUSHJ P,EAT + +READQ: TRZ ZR,DISFLG + SKIPE DSKYES + EXCH ZR,DSKONL + SETZM QITADR + JRST CLONDI + + + +CONSTANTS +VARIA: +VARIABLES +PAT: +PATCH: BLOCK 200 +FS: +CORSIZ==<.+1777>_-10. + +END START +   J KLUDG1 + +KLUDG4: SUB Y,NSIDS + SOS Y + SOSG Y + MI Y,1 + Q DSUFRA + SO OLDXY + J KLUDG3 + +INSRTK: +.F FNSIDS'=FFLOAT,FNSIZS'=FFLOAT + M G,NSIDS +INSRL1: +.F FFIX/FNSIDS)>*FNSIZS>,FFIX*FNSIZS> + ADD A,XDX + ADD B,YDY + HRLS A + HRR A,B + Q UPYPL + SOJGE G,INSRL1 + R + +CPYNEW: ;COPY UP SEGMENT FROM VYLOW TO VYABS MOVE FROM (CXYSV) TO (G) + SKIPG V,VYABS + R +.I PTDTA1<-1> ;JUST IN CASE + SUB G,CXYSV + M X,VYLOW +MVUPMR: SKIPL A,MDATA(X) + ADD A,G + Q UPYPL + AOS X + CAME X,V + J MVUPMR +.I PTDTA1<-1> ;JUST IN CASE + R + +MOVFRS: ;MOVE SEGMENT FROM VYLOW TO VYABS FROM (CXYSV) TO (C) + SKIPG V,VYABS + R + SUB C,CXYSV + M X,VYLOW +MOVFR1: SKIPL MDATA(X) + ADDM C,MDATA(X) + AOS X + CAMGE X,V + J MOVFR1 + R + +KLLLST: SKIPG V,VYABS ;KILL LAST COPY CREATED + R + SUB Y,V + ADD Y,VYLOW + J DSUFRA + FNDSIM: ;FIND FIRST NEAR POINT TO ONE IN F + SZ X + HRLZ B,EPSIL + Q SCLEPS +NAOSLP: SKIPGE A,MDATA(X) + J NAOSXL + SUB A,F + Q SAMG + SKIPA + R ;MATCH +NAOSXL: AOS X + CAMGE X,Y + J NAOSLP + AOS (P) ;SKIPS IF NOT FOUND + R + +SPRWNG: M V,W ;PUT W AT START, V AT END +1 OF SEGMENT + Q GTTPW1 ;MOVE W DOWN + J GTTPN1 ;MOVE V UP + +FNDEQ1: CAMN A,MDATA(W) ;FIND POINT EQUAL TO A, START AT W + R ;FOUND IT + AOS W + CAMGE W,Y + J FNDEQ1 + AOS (P) ;SKIPS IF NOT FOUND + R + +CRFT1: M F,A + Q FNDSIM ;FIND NEAR ONE + SKIPA + R ;NO LUCK + M A,MDATA(X) + MM A,CXYSV' ;NEAREST POINT IN OBJECT + MM F,DXYSV' ;PEN POSITION + M W,X + Q SPRWNG ;SPREAD WINGS TO END OF CURRENT SEGMENT + MM V,VYABS' + MM W,VYLOW' + AOS (P) + SKIPN FIGFLG + R ;SEGMENTS ONLY + MI U,1 + Q MVDWN ;COPY DOWN THE WORLD +.I VYABS=VYABS-VYLOW+1,VYLOW=1 + SZ SLPREM ;CLOSE SET WRT TOUCHING OF SEGMENTS + SKIPE COMFLG ;BETTER BE ON + Q COMPCT + SKIPE SLPFLG ;BETTER BE ON + Q SLOP + SKIPE SLPREM + SO ADJSW ;TO ENSURE GETS DISPLAYED SOMETIME + SZ X +ALLSE1: SKIPL A,MDATA(X) + Q ALSECT + AOS X + CAMGE X,VYABS + J ALLSE1 + R + ALSECT: M W,VYABS + Q FNDEQ1 + SKIPA + R ;FOUND NONE + Q SPRWNG ;TOUCH NEAREST -1'S + M U,VYABS + Q MVDWN ;COPY IT DOWN +.I VYABS=U+V-W + CAMGE A,Y + J ALSECT ;TRY FOR MORE + SUB P,[1,,1] ;ALL DONE-POP EXTRA LEVEL UP + R + + +STRFIG: SO FIGFLG ;MOVE FIGURES AROUND + SKIPA +STRSEG: SZ FIGFLG ;MOVE SEGMENTS AROUND +.I APOUSP=#POPJP, EPSIL=EPSDRW + Q OPNINT + SETZB G,ADJSW' +STRSE3: SO CXYSV' +STRSE2: Q REDTAB + TLZE A,340000 + J STRSE3 ;TO ALLOW FIGURES TO GROW EASILY + ZUM A + Q ADJWYX + Q ADJST2 + Q DSUFRA ;OFTEN SKIPPED + J STRSE2 + +ADJST2: SKIPL C,CXYSV + J HAVONE ;WE ARE POINTING TO ONE +CRFT2: Q CRFT1 + SKIPA ;NOTHING + J ALLBLL ;HERE IF WE FOU \ No newline at end of file diff --git a/src/bkph/rout.21 b/src/bkph/rout.21 new file mode 100755 index 00000000..bac8a45f --- /dev/null +++ b/src/bkph/rout.21 @@ -0,0 +1,2580 @@ +IFN ARRALL,[ + +DSPMSK==1777 ;MASK FOR DISPLAY COORDINATES + +LPROPD==10 ;LENGTH OF PROTECTED PDL + +IFNDEF MXARS,[MXARS==20] ;FIXED MAX NUMBER DYNAMIC ARRAYS +IFNDEF NDSPI,[NDSPI==4] ;NO OF DISPLAYS CONCURRENTLY FILLING + +;ARRAY ALLOCATOR + +BXDARY: -1 ;CURRENT BOXED ARRAY + +ARYORG: REPEAT MXARS,-1 ;-1 OR CURRENT ARY ORG +ARYL: BLOCK MXARS ;CURRENT LENGTH +ARYF: REPEAT MXARS, ,-1 ;INDICATOR FLAGS 4.9 STOP DIS WHILE RELOCATING + ;4.8 NO NEED TO CLEAR CORE + ;RH ARY # OF NEXT HIGHER ARRAY -1 IF NONE + +BDISB==400000 ;STOP DISPLAY BIT +BGRBG==200000 ;GARBAGE OK + +ARYNAM: BLOCK MXARS ;NAME FOR USE WITH BOX HACK +ARYD1: BLOCK MXARS ;DIM 1 OF ARRY MOST RAPIDLY VARING (USUALLY X) +ARYD2: BLOCK MXARS ;DIM 2 (USUALLY Y) +ARYMT: BLOCK MXARS ;LINKS TO ARRAYS THAT ARE MARGIN TBLS FOR THIS ONE + ;4.9=1 OTHER ARRAYS POINT AT ME =0 I POINT AT HIM + ;IF I AM MARGIN ARRY THEN 3.4-3.1 =MARGIN INDEX IN ARRY + ;RH LINK OR -1 IF NONE +;ARYXOF: BLOCK MXARS ;X ORIGIN OF 0,0 ENTRY IN BAT COORD +;ARYYOF: BLOCK MXARS +;ARYSCL: BLOCK MXARS ;BAT PTS/ARRY PT _18. +ARYMPP: BLOCK MXARS ;MAIN PROTECTED PTR,BLKO PTR FOR DIS +AFRNDS: BLOCK MXARS ;USED TO LINK FRIENDS IE RAW AND PROCESSED FORMS + ;OF SAME BASIC DATA RH CIRCULAR LINK LH DATA TYPE + ;1 STORED PICTURE 2 GRAD 3 SHOW +ARYPNM: BLOCK MXARS ;"PRIMARY NAME" + +ARYHP: ,-1 ;PNTR TO HIGHEST ARRAY +ARYLP: ,-1 ;PNTR TO LOWEST ARRAY + +PROSTG: ;BEGINNING PROTECTED STORAGE + +BYTPNT: 0 ;PNTR INTO DISPLAY BUFFER +BYTPNS: 0 ;PNTR TO DISPLAY BUFF WHERE ENTERED INCR OR VECTOR MODE +DSPLIM: 0 ;END OF BUFFER +LDSPI==.-BYTPNT ;LENGTH OF PROTECTED DISPLAY BLOCK + +DSPI: BLOCK NDSPI*LDSPI ;STG OF PRECEDING DISPLAY INFO WHEN DORMANT + +GRADY: @(Z) ;REF TO GRAD ARRY + +PROPDL: BLOCK LPROPDL ;PROTECTED PDL + +;PROTECTED WORDS FOR VARIOUS SUPPRT USERS +PRT0: 0 +PRT1:FOOADD: 0 ;USED IN CONVEX +PRT2:SRTADD: 0 ;USED BY CONVEX +PRT3:SECRT: 0 ;SECRET PLACE FOR IMMEDIATE DISPLAY OF POINT IN LINES +PRT4:DATAR: 0 ;ADDRESS OF MAIN DATA ARRAY IN SAHDE +PRT5:DATLIM: 0 ;LAST WORD OF SAME +PRT6: 0 +PRT7: 0 +PRT8: 0 +PRT9: 0 + LPROSTG==.-PROSTG ;LENGTH PROTECTED STORAGE +PRPDLP: -LPROPDL,,PROPDL-1 + +ARYROT: 0 ;ROUTINE CALLED FOR EACH RESHUFFLE +;FOR MAINTAINING UNFRIENDLY MARGIN ARRAYS FOR EXAMPLE + +ARYDEL: JUMPL A,CPOPJ + MOVEI B,0 ;DELETE ARRY IN A +ARYALS: MOVEM 16,ARYAC+16 ;OR GENERATE A NEW ONE + MOVE 16,[C,,ARYAC+C] + BLT 16,ARYAC+15 + PUSHJ P,ARYAL + PUSH P,A + PUSH P,B + SKIPLE A,ARYROT + PUSHJ P,(A) + POP P,B + POP P,A + MOVS 16,[C,,ARYAC+C] + BLT 16,16 + POPJ P, + +ARYAC: BLOCK 17 ;SAVED ACS WHILE ARRAYING + +ARYAL: JUMPGE A,ARYA1 ;A -1 GENERATE NEW ARRAY ELSE ARRAY NUMBER + MOVSI F,-MXARS ;B DESIRED LENGTH FLAGS LH IF NEW + SKIPGE ARYORG(F) + JRST ARYAL2 + AOBJN F,.-2 + STOP _TOO MANY ARRAYS-ARYAL + +ARYAL2: HLLM B,ARYF(F) ;STORE FLAGS + CLEARM ARYMT(F) + HLLOS ARYMT(F) + CLEARM ARYNAM(F) + MOVEI D,AFRNDS(F) + MOVEM D,AFRNDS(F) ;INITIALIZE FRIENDS PNTR-NO FRIENDS + CLEARM ARYPNM(F) + HRRZS B + MOVEI D,FS ;LOOK FOR HOLE + HRRE C,ARYLP + MOVEI W,ARYLP + JUMPL C,ARYAL8 ;NO ACTIVE ARRAYS +ARYAL5: MOVN X,D + ADD X,ARYORG(C) + CAIL X,(B) + JRST ARYAL4 ;FOUND BIG ENUF HOLE + MOVE D,ARYORG(C) + ADD D,ARYL(C) + MOVEI W,ARYF(C) ;SAVE PTR TO CURRENT LINK WD + HRRE C,ARYF(C) + JUMPGE C,ARYAL5 +ARYAL3: HRRZ C,FSP ;NO HOLE ADD ARRAY TO TOP + ADDI C,(B) + PUSHJ P,MEMGT ;GET MEMORY + HRRZ A,F + HLLOS ARYF(A) ;ARY ON TOP + HRRE F,ARYHP + MOVEM A,ARYHP ;NOW HIGHEST + JUMPL F,ARYAL6 ;FIRST ARRAY + HRRM A,ARYF(F) ;PATCH PREVIOUS HIGHEST TO POINT TO ME +ARYAL7: MOVE C,FSP +ARYSX2: MOVEI X,0 +ARYSX: MOVEM C,ARYORG(A) ;STORE ARRAY IN A LOCN IN C + MOVEI F,-1(C) + HRRM F,ARYMPP(A) ;SET ADR OF DIS PNTR + ADD X,C ;CLEAR ALL BUT FIRST X REG + ADDI C,(B) ;LENGTH IN B + CAMLE C,FSP + MOVEM C,FSP + MOVE F,ARYF(A) + TLNN F,BGRBG ;DONT NEED TO CLEAR CORE + CAML X,C + JRST ARYSX1 + MOVEI F,0 + SKIPGE ARYF(A) + MOVE F,[403737,,403737] ;DISPLAY ARRY + MOVEM F,(X) + HRLS X + AOS X + CAILE C,(X) + BLT X,-1(C) +ARYSX1: HRRZM B,ARYL(A) + HRRE F,ARYF(A) ;ERROR CHECK + HRRZ X,B + ADD X,ARYORG(A) + JUMPL F,ARYCH1 + CAMLE X,ARYORG(F) + .VALUE ;TOP OF THIS ARRAY HIGHER THAN START OF NEXT - BUG ! +ARYCH2: SKIPL ARYF(A) + POPJ P, + MOVN X,ARYL(A) + HRLM X,ARYMPP(A) ;LENGTH OF DIS PNTR + POPJ P, + +ARYAL8: MOVEI C,FS + MOVEM C,FSP + JRST ARYAL3 + +ARYCH1: CAMLE X,FSP + .VALUE ;TOP OF THIS ARRAY HIGHER THAN CURRENT FREE SPACE - BUG ! + JRST ARYCH2 + + +ARYAL6: MOVEM A,ARYLP + JRST ARYAL7 + +ARYAL4: HRRZ A,F + HRRZ C,(W) ;PICK UP PNTR THAT PNTED TO FROB WE ARE INSERTING IN FRONT OF + HRRM C,ARYF(A) + HRRM A,(W) ;MAKE HIM POINT AT ME + MOVE C,D + JRST ARYSX2 + + MEMGT: CAMGE C,CORTOP ;INCREASE MEM SIZ TO AT LEAST VALUE IN C + POPJ P, + MOVE D,CRSZ +NOCRER: CAMGE D,CRLM ;IN CASE WE RETAINED IT + JRST AOCRSE + .CORE 1(D) + JRST NOCRW + AOS CRLM +AOCRSE: AOS CRSZ + MOVEI D,2000 + ADDM D,CORTOP + JRST MEMGT + +NOCRW: STRIKE _CORE ? + PUSH P,A + MOVEI A,300. ;WAIT 10 SECONDS AND TRY AGAIN + .SLEEP A, + POP P,A + JRST NOCRER + +ARYA1: SKIPGE ARYORG(A) + JRST ARYA1L + HRRZS B + CAMN B,ARYL(A) + POPJ P, ;CORRECT SIZE ALREADY + CAML B,ARYL(A) + JRST ARYEX ;EXPANDING EXISTING ARRAY + EXCH B,ARYL(A) + SUB B,ARYL(A) ;COMPUTE # REG VACATED + MOVN F,ARYL(A) + HRLM F,ARYMPP(A);STORE NEW LENGTH IN DIS PNTR + SKIPN F + CLEARM ARYMPP(A) +IFN DISALL,[ + SKIPGE ARYF(A) + PUSHJ P,ADISON ;MAKE SURE DISPLAY NOT IN FLUSHED CRUFT +] + SKIPN ARYL(A) + JRST ARYA6 ;FLUSHING ARRAY +ARY8A: HRRE F,ARYHP + JUMPL F,CPOPJ + HRRZ B,ARYORG(F) + ADD B,ARYL(F) + MOVEM B,FSP + MOVEI F,3*2000(B) + CAML F,CORTOP + POPJ P, ;HAVE ONLY A COUPLE EXTRA BLOCKS +ARYFM: MOVE B,CORTOP + SUBI B,2000 + CAMG B,FSP + POPJ P, + SOS CRSZ + MOVEM B,CORTOP + SKIPE HOARD ;DON'T RELEASE CORE IF HOARD IS ON + JRST ARYFM + .CORE @CRSZ + .VALUE ;LOST TRYING TO FLUSH MEM - BUG ! + SOS CRLM + JRST ARYFM + HOARD: 0 ;SET NON-ZERO TO STOP RELEASING CORE + +ARYA1L: STRIKE _ARRAY #1 DOESNT EXCIST-ARYA1 + MOVNI A,1 + JRST ARYAL + +ARYA6: CAMN A,BXDARY + SETOM BXDARY + SKIPL ARYF(A) + JRST ARYA6E ;NOT DIS ARRY + MOVEI F,DISLIST ;?+1 +ARYA6F: HLRZ D,(F) ;FLUSH ARRY FROM DISLIST + CAIN D,ARYMPP(A) + HRRZS (F) + HRRZ F,(F) + JUMPN F,ARYA6F +ARYA6E: MOVEI D,AFRNDS(A) + HRRZ W,AFRNDS(A) +ARYA6D: CAIN W,AFRNDS(A) + JRST ARYA6C + MOVE D,W + HRRZ W,(W) + JRST ARYA6D +ARYA6C: HRRZ W,AFRNDS(A);FIX UP FRIENDS PNTR + HRRM W,(D) + MOVEI W,ARYLP-ARYF + HRRZ F,ARYLP +ARYA6A: CAMN F,A + JRST ARYA6B ;FOUND WHAT PNTS TO ME + MOVE W,F + HRRE F,ARYF(F) + JUMPGE F,ARYA6A + .VALUE ;ARRAY LIST FOULED UP - BUG ! + +ARYA6B: SETOM ARYORG(A) ;FLUSH ARRAY + HRRZ D,ARYF(A) + HRRM D,ARYF(W) ;MAKE HIM PNT TO WHAT I POINTED TO + CAIN W,ARYLP-ARYF + MOVEI W,-1 ;IF I AM HIGHEST ARRAY I AM LAST ONE + CAMN A,ARYHP + HRRM W,ARYHP ;I WAS HIGHEST ARY SO HE IS NOW + SKIPGE W,ARYMT(A) + JRST ARY6E ;I AM DATA ARRAY WHICH OTHERS MAY POINT TO + MOVSI W,-MXARS +ARY6D: SKIPGE ARYORG(W) + JRST ARY6C + HRRZ X,ARYMT(W) + CAME X,A + JRST ARY6C + HRRZ X,ARYMT(A) ;YES MAKE HIM POINT TO WHAT I POINTED TO + HRRM X,ARYMT(W) + JRST ARY8A + +ARY6C: AOBJN W,ARY6D + JRST ARY8A + + ACORE: PUSH P,A ;FLUSH ALL EXCESS CORE + .CORE @CRSZ + .VALUE + MOVE A,CRSZ + MOVEM A,CRLM + JRST POPAJ + +AKILL: PUSH P,A ;KILL ALL ARRAYS ! + PUSH P,B + MOVEI A,MXARS-1 + SKIPL ARYORG(A) + PUSHJ P,ARYDEL + SOJGE A,.-2 + JRST POPBJ + +ARY6E: HRRE A,W ;FLUSH OTHER ARRAYS THAT MAY POINT AT ME + JUMPL A,ARY8A +ARY6F: MOVEI B,0 + PUSHJ P,ARYAL + HRRE A,ARYMT(A) + JUMPGE A,ARY6F + POPJ P, + + +ARYEX: CAMN A,ARYHP + JRST ARYEX3 ;TOP MOST ARRAY + HRRZ F,ARYF(A) ;COMPUTE BEG OF NEXT ARRAY + MOVE C,ARYORG(F) + SUB C,B ;B HAS DESIRED NEW SIZE + CAMG C,ARYORG(A) + JRST ARYSHF ;SHUFFLE NECCESSARY + ;DROP THRU ON CAN EXPAND INTO HOLE +ARYEX4: MOVE X,ARYL(A) ;DONT CLEAR OLD PART OF ARRAY + MOVE C,ARYORG(A) + JRST ARYSX + +ARYEX3: MOVE C,B + ADD C,ARYORG(A) + PUSHJ P,MEMGT + JRST ARYEX4 + +ARYSHF: MOVEI C,FS ;WRITE PNTR + HRRZ F,ARYLP +ARYSH3: CAME C,ARYORG(F) + PUSHJ P,ARYMVD + CAIN A,(F) + JRST ARYSH1 ;FOUND ARRAY WANT TO MAKE BIGGER + ADD C,ARYL(F) + HRRE F,ARYF(F) + JUMPGE F,ARYSH3 +ARYGCL: .VALUE ;GC LOST-BUG ! + +ARYSH1: HRRE F,ARYF(F) + JUMPL F,ARYGCL + ADD C,B ;END AFTER EXPANSION + CAMGE C,ARYORG(F) + JRST ARYEX4 ;WILL FIT NOW + ARYSH4: ADD C,ARYL(F) ;START FROM TOP AND SHUFFLE UP + HRRE F,ARYF(F) ;COMPUTE EVENTUAL TOP ADDRESS + JUMPGE F,ARYSH4 + PUSHJ P,MEMGT ;MAKE SURE HAVE ENUF MEMORY + CAMLE C,FSP + MOVEM C,FSP + HRRZ F,ARYHP +ARYSH7: SUB C,ARYL(F) ;DECREMENT WRITING PNTR BY SIZE THIS ARRAY + CAMLE C,ARYORG(F);EITHER HIGH ENUF OR NO CHANGE + PUSHJ P,ARYMVU + HRRZ X,ARYLP + MOVNI D,1 ;FIND ARRAY BELOW THIS +ARYSH5: CAMN X,F + JRST ARYSH6 + MOVE D,X + HRRE X,ARYF(X) + JUMPGE X,ARYSH5 + JRST ARYGCL + +ARYSH6: JUMPL D,ARYGCL + MOVE F,D + CAME F,A ;FOUND ARRAY MAKING ROOM FOR + JRST ARYSH7 + MOVE X,ARYORG(A);ERROR CHECK + ADD X,B + HRRE F,ARYF(A) + SKIPL F + CAMLE X,ARYORG(F) + .VALUE ;BUG ! + JRST ARYEX4 + +ARYMVD: CAML C,ARYORG(F);MOVE ARRAY IN F FROM CURRENT LOCN TO START IN LOCN C + .VALUE ;BUG ! + PUSHJ P,ARYRL ;RELOCATED PNTRS TO ARRAY + HRRZ D,C + HRL D,ARYORG(F) + MOVE X,D + ADD X,ARYL(F) + BLT D,-1(X) +ARYRST: HRRZM C,ARYORG(F) + HLLZ X,ARYF(F) +IFN DISALL,[ + TLNE X,BDISB + PUSHJ P,ADISON +] + MOVE X,ARYORG(F) + ADD X,ARYL(F) + HRRE D,ARYF(F) + JUMPL D,ARYCH3 + CAMLE X,ARYORG(D) + .VALUE ;BUG ! + POPJ P, + +ARYCH3: CAMLE X,FSP + .VALUE ;BUG ! + POPJ P, + +ESCSTP: 403737,,403737 + ARYMVU: PUSHJ P,ARYRL + MOVE D,C ;NEW ADDRESS + MOVE X,ARYORG(F) ;OLD ADDRESS + ADD D,ARYL(F) ;LAST NEW ADR+1 + ADD X,ARYL(F) ;LAST OLD ADR+1 +ARYMV1: MOVE W,-1(X) + MOVEM W,-1(D) + SOS X + CAML X,ARYORG(F) + SOJA D,ARYMV1 + JRST ARYRST + +ARYRL: HLLZ X,ARYF(F) ;RELOC PNTRS TO ARRY IN F + TLNE X,BDISB + .DSTOP + HRRZ D,ARYORG(F) ;OLD LOWER RANGE + MOVE X,D + ADD X,ARYL(F) ;OLD UPPER LIMIT + MOVE W,C + SUB W,ARYORG(F) ;CHANGE + HRRZ U,ARYMPP(F) ;RELOCATE EVEN IF DOESNT POINT INTO ARRAY + ADD U,W + HRRM U,ARYMPP(F) + SKIPL U,ARYMT(F) + JRST ARYRL3 ;OTHER ARRAYS DONT POINT AT THIS ONE +ARYRL4: PUSH P,U + MOVN T,ARYL(U) + HRLS T + HRR T,ARYORG(U) + PUSHJ P,ARYRLR + POP P,U + HRRE U,ARYMT(U) + JUMPGE U,ARYRL4 +ARYRL3: MOVE T,[-LPROSTG,,PROSTG] +ARYRLR:ARYRL1: HRRZ U,(T) + CAML U,D + CAML U,X + JRST ARYRL2 + ADD U,W + HRRM U,(T) +ARYRL2: AOBJN T,ARYRL1 + POPJ P, + +ARYCLR: SKIPG ARYF(A) + .DSTOP + PUSH P,X + PUSH P,W + HRRZ W,ARYORG(A) ;'CLEAR' ARRY IN A WITH (B) + MOVEM B,(W) + HRRZ X,W + ADD X,ARYL(A) + HRLS W + AOS W + BLT W,-1(X) + POP P,W + POP P,X +IFN DISALL,[ + SKIPG ARYF(A) + JRST ADISON +] + POPJ P, +] + IFN MARARR,[ + +MARG: HRRE X,ARYMT(A) ;CREATE MARG TABLE FOR ARY IN A ON AC IN B + JUMPL X,MARG2 +MARG4: LDB D,[220400,,ARYMT(X)] ;SEE IF DESIRED MARGIN TBL ALREADY EXISTS + CAMN D,B + JRST MARG3 ;YES + HRRE X,ARYMT(X) + JUMPGE X,MARG4 +MARG2: PUSH P,B ;GENERATE MARGIN TABLE FOR ARRAY IN A + ;AC DESIRED IN INDEX IN B + MOVE B,ARYD2(A) ;LENGTH OF MARGIN TABLE REQD + PUSH P,A + MOVNI A,1 + PUSHJ P,ARYALS + POP P,C + POP P,D + MOVE B,ARYD2(C) + MOVE X,ARYORG(A) + MOVE W,ARYORG(C) + HRL W,D +MARG1: MOVEM W,(X) + ADD W,ARYD1(C) + AOS X + SOJG B,MARG1 + MOVE W,ARYMT(C) + HRL W,D ;SAVE MARGIN INDEX + MOVEM W,ARYMT(A) + TLO A,400000 ;INDICATE I AM DATA ARRAY + MOVEM A,ARYMT(C) + POPJ P, ;RETURN RESULT ARRAY IN A + +MARG3: HRRZ A,X ;RETURN MARGIN ARRY + POPJ P, + +GRADYS: MOVEI B,Y + MOVEI C,GRADY +MARGST: PUSH P,A ;SET LCN IN C TO POINT TO MARG ARRY FOR ARRY IN A ON AC IN B + PUSH P,C + PUSHJ P,MARG + POP P,C + HRRZ B,ARYORG(A) + HRRM B,(C) + JRST POPAJ + +INTRO: HRL X,AFRNDS(B) ;MAKE ARRY IN A FRIEND OF ONE IN B + MOVSM X,AFRNDS(A) ;DATA TYPE OF ARY A IN X + MOVEI X,AFRNDS(A) + HRRM X,AFRNDS(B) + POPJ P, + +] + IFN DISALL,[ + + +;MACRO USED IN DISPLAYAGE + +;A1 IS MASK OF ALLOWED BITS, A2 IS CURENT VALUE, A3 IS CHANGE-ENABLE BIT + +DEFINE PARAM A1,A2,A3 + ANDI W,A1 + CAMN W,A2 + POPJ P, + MOVEM W,A2 + IORI W,A3 +TERMIN + +DKILL: PUSH P,A + PUSH P,B ;KILL ALL ARRAYS USED AS DISPLAY ARRAYS + MOVEI A,MXARS-1 +DKILLP: SKIPG ARYORG(A) + JRST DKILLN + SKIPGE ARYF(A) + PUSHJ P,ARYDEL +DKILLN: SOJGE A,DKILLP + JRST POPBJ + +DLAST: PUSH P,A ;KILL CURRENT DSPARY + PUSH P,B + MOVE A,DSPARY + PUSHJ P,ARYDEL + SETOM DSPARY + JRST POPBJ + +WALZ: MOVEI C,DISLIS ;SEE WHICH IS WHICH ON DISLIS +WALZ1: MOVE B,(C) + HLRZ A,B + JUMPE A,REVIVM + SUBI A,ARYMPP + HRRZS (C) + STRIKE KILL #1 ? + PUSHJ P,SKPYES +REVIVM: MOVEM B,(C) + HRRZ C,B + JUMPN C,WALZ1 + POPJ P, + +FLSNDS: MOVEI B,NDSPI-1 + SETZM C + SETOM DSPARY-YDISP+DSPIB(C) ;RESET ALL DSPARY'S TO -1 + ADDI C,LDSPIB + SOJGE B,.-2 + POPJ P, + MESAX: 125. ;SIMILAR TO MESSX + +DOTS: PUSH P,DSPARY ;PUT IN DOTS TO LINE UP 8.5" * 11" PAPER WITH MARGINS + SETOM DSPARY + PUSHJ P,DISINS +.I DSPPNI<,MESAX-125.,0> +.I DSPPNI<,MESAX,62.> +.I DSPPNI<,MESAX,962.> +.I DSPPNI<,MESAX-125.,1023.> +.I DSPPNI<,MESAX+725.,1023.> +.I DSPPNI<,MESAX+625.,962.> +.I DSPPNI<,MESAX+625.,62.> +.I DSPPNI<,MESAX+725.,0> + PUSHJ P,DISGO + POP P,DSPARY + POPJ P, + + +;DISPLAY ROUTINES - USE A,B,C,D,E AND W,X INDISCRIMINATLY + +DSPCRI: 0 ;INDEX OF CURRENT DSP ACTIVE +YDISP: 0 ;CURRENT Y COORD +XDISP: 0 +DSPSCL: 0 ;" SCALE_4 +DSPINT: 0 ;" INTENSITY +DSPSC: 0 ;CURRENT SCALE NOT SHIFTED +DSPMOD: 0 ;CURRENT MODE +DSPARY: -1 ;CURRENT ARRAY FOR DISPLAY +DINCNR: -1 ;NUMBER INCREMENTS STORED IN CURRENT BYTE -1 MAKE NEW BYTE +LDSPIB==.-YDISP + +DSPIB: BLOCK NDSPI*LDSPIB + +DSPPNZ: TDZA D,D ;NO INTENSIFY +DSPPNI: MOVEI D,2000 ;INTENSIFY +DSPPNT: PUSHJ P,MODPNT ; MAKE SURE THE DISPLAY IS IN POINT MODE +DSPPTU: ANDI B,DSPMSK ; EXTRACT COORDINATE VALUES + ANDI C,DSPMSK + CAME C,YDISP ; CHECK TO SEE IF Y VALUES COMPARE + JRST DSPINC + CAMN B,XDISP + POPJ P, ;SAME AS LAST POINT +DSPINA: MOVE W,B + MOVEM B,XDISP ; X VALUES EQUAL OR BOTH VALUES DIFFERENT +DSPINB: IORI W,(D) ; MERGE IN INTENSIFY BIT IF IT EXISTS + JRST DSPPUP ; PUT VALUE IN BUFFER AND RETURN + +DSPINC: MOVE W,C + MOVEM C,YDISP ; UPDATE VALUE OF Y COORDINATE + IORI W,200000 ; BIT USED TO INDICATE Y VALUE + CAMN B,XDISP ; CHECK TO SEE IF X VALUES COMPARE + JRST DSPINB ; THEY COMPARE - UPDATE Y VALUE ONLY + PUSHJ P,DSPPUP ; PUT Y VALUE IN BUFFER + JRST DSPINA ; GO RESET X COORDINATE + + DSPSEL: CAMN A,DSPCRI ;CALL WITH DSP # IN A, SWITCHES DISPLAY STATE + POPJ P, + CAIL A,NDSPI + STOP _INVALID SECTION-DSPSEL + SKIPGE A + MOVEI A,0 + MOVE B,DSPCRI + IMULI B,LDSPIB + HRLI C,YDISP + HRRI C,DSPIB(B) ;INFO ON THIS PAGE + BLT C,DSPIB+LDSPIB-1(B) + MOVE B,DSPCRI + IMULI B,LDSPI + HRLI C,BYTPNT + HRRI C,DSPI(B) + BLT C,DSPI+LDSPI-1(B) ;SAVE CURRENT INFO IN PROTECTED STORE + MOVEM A,DSPCRI + IMULI A,LDSPIB + HRLI B,DSPIB(A) + HRRI B,YDISP + BLT B,YDISP+LDSPIB-1 ;RESTORE CRUFT ON THIS PAGE + MOVE A,DSPCRI + IMULI A,LDSPI + HRLI B,DSPI(A) + HRRI B,BYTPNT + BLT B,BYTPNT+LDSPI-1 ;RESTORE SAVED CRUFT + POPJ P, + + +; ROUTINE TO PUT A CHARACTER IN THE DISPLAY LIST + +DTYOA: CAIN A,15 + JRST DTYCR ;HANDLE CR + CAIN A,12 + MOVEI A,33 ;LF + MOVE W,A ;TAKE OUT CHR FROM A +DSPCHR: PUSHJ P,MODCHR ; PUT DISPLAY IN CHARACTER MODE + JRST DSPPUT ; PUT CHARACTER INTO THE BUFFER AND RETURN + +DTYCR: PUSHJ P,MODPNT ;PUT IN POINT MODE + MOVE W,MESSX + ANDI W,DSPMSK + JRST DSPPUP + +; ROUTINE TO DISPLAY A MESSAGE +; DSPMSG POSITIONS THE DISPLAY +; DSPTXT JUST PUTS THE MESSAGE IN THE BUFFER +; PARAMETERS +; (A)=MESSAGE POINTER +; (B)=X COORD +; (C)=Y COORD + +DSPMSG: PUSHJ P,DSPPNZ ; POSITION DISPLAY +DSPTXT: PUSHJ P,MODCHR ; PUT DISPLAY IN CHARACTER MODE + HRLI A,440700 ; CONSTRUCT BYTE POINTER TO TEXT ARRAY +DSPTXM: ILDB W,A ; GET A CHARACTER + JUMPE W,CPOPJ ; NO MORE CHARACTERS - RETURN + PUSHJ P,DSPPUT ; PUT CHARACTER INTO THE BUFFER + JRST DSPTXM + + ;STEP DIR 567 +; 4 0 +; 321 + +DISTAP: SKIPA C,DINCT1(C) ;ENTRY WHICH CHECKS MODE +DISTP: SKIPA C,DINCT1(C) ;DISPLAY STEP IN C +DINC1: PUSHJ P,MODINC ;DISPLAY TO INC MODE +DINC: AOSE D,DINCNR ;DISPLAY INCREMENT IN C + JRST DINC2 + MOVEI W,200000 ;INTENSIFY + PUSHJ P,DSPPUT ;TIME FOR A NEW BITE +DINC2: MOVE W,BYTPNT + TLZ W,2200 ;FLUSH OLD SIZ FLD + ADD W,DINCT(D) + DPB C,W ;STORE AWAY + CAIL D,3 + SETOM DINCNR ;THIS BYTE FULL + POPJ P, + +DINCT: 140400,, ;PNTRS TO INCREMENT SUB BYTES + 100400,, + 40400,, + 400,, + +DINCT1: 10 ;STEP TO 340 INCR + 13 + 3 + 17 + 14 + 16 + 2 + 12 + +;ROUTINE FOR VECTOR CONTINUE + +DSPVCC: PUSHJ P,MODVCC + JRST DSPLNE + +; ROUTINE TO HANDLE THE PLACING OF VECTORS INTO THE DISPLAY LIST + +DSPVEC: PUSHJ P,MODVEC ; SPECIAL ENTRY TO MAKE SURE DISPLAY IS IN VECTOR MODE +DSPLNE: MOVEI D,200000 ;INTENSIFY +DSPLIN: LDB A,[430100,,B] ;CLOBBERS A,B,C,D,E,W,X + LDB W,[430100,,C] + DPB W,[10100,,A] ;SAVE SIGN BITS + MOVMS B + MOVMS C + MOVN X,DSPSC + LSH B,(X) + LSH C,(X) ;COMP FOR SCALE + CAIGE B,4000 + CAIL C,4000 + JRST VPLOT4 +VPLOT3: SKIPN B ;SEE IF ZERO LENGTH VECTOR + JUMPE C,CPOPJ + CAIGE B,200 + CAIL C,200 + JRST VPLOT1 +VPLOT2: MOVEI W,@VECTBL(A) + DPB C,[80700,,W] + IOR W,D ;INTENSIFY BIT + JRST DSPPUT + +VPLOT4: PRINT _MOBY VECTOR-DSPVEC +VPLOT1: PUSH P,B + PUSH P,C + CAMLE B,C + TLOA A,400000 + EXCH B,C + IMULI C,177 + IDIVM C,B + MOVEI C,177 + TLZE A,400000 + EXCH B,C + PUSHJ P,VPLOT2 + POP P,W + SUBM W,C + POP P,W + SUBM W,B + JRST VPLOT3 + +VECTBL: 000000(B) + 000200(B) + 100000(B) + 100200(B) + +DSPVVP: AOSN VECONN + JRST DSPPNI ;FIRST TIME GO INTO POINT MODE +DSPVCA: SKIPGE XDISP + STOP ILLEGAL RELATIVE VECTOR + SUB B,XDISP ;CONNECT POINT BY INTENSIFIED VECTOR WITH LAST PNT + SUB C,YDISP + ADDM B,XDISP + ADDM C,YDISP + PUSH P,XDISP + PUSH P,YDISP + PUSHJ P,DSPVEC + POP P,YDISP + POP P,XDISP + POPJ P, + +DSPVOP: AOSN VECONN + JRST DSPPNZ ;FIRST TIME GO INTO POINT MODE +DSPVOC: SKIPGE XDISP + STOP ILLEGAL RELATIVE VECTOR + SUB B,XDISP ;CONNECT POINT BY BLANK VECTOR WITH LAST PNT + SUB C,YDISP + ADDM B,XDISP + ADDM C,YDISP + PUSH P,XDISP + PUSH P,YDISP + PUSHJ P,DSPVCO + POP P,YDISP + POP P,XDISP + POPJ P, + +PUTCLL: 0 ;ROUTINE CALLED AFTER UPDATING DISPLAY LIST +VECONN: -1 ;-1 TO DO FIRST IN POINT MODE + +DSPVCO: PUSHJ P,MODVEC +DSPVC0: MOVEI D,0 ;VECTOR NOT INTENSIFIED + JRST DSPLIN + +; ROUTINE TO HANDLE SIZE CHANGES +DSIZG: MOVE W,B ;ENTER WITH SCALE IN B (0-3) + JRST DSIZ2 + +;DSIZST: HLRZ B,ARYSCL(B) ;SET SIZE TO CORRESP TO ARRY IN B +; ASH B,-4 ;CONVERT SCALE TO DISPLAY COORD +; CAIL B,8 +; MOVEI B,8 + +DSIZA: MOVEI W,0 ;ENTER HERE WITH SIZE IN B (1,2,4,8) +DSIZ1: CAIG B,1 + JRST DSIZ2 + LSH B,-1 + AOJA W,DSIZ1 + +DSIZ2: LSH W,4 +DSPSIZ: PARAM 60,DSPSCL,100 + LDB X,[40200,,W] + MOVEM X,DSPSC + PUSHJ P,MODPRM + LDB X,BYTPNT + ANDCMI X,60 + JRST DSPBTH ; GO FINISH UP + +; ROUTINE TO HANDLE INTENSITY CHANGES +DSPBRG: MOVE W,B ;ENTER HERE WITH INTENISTY IN B (0-7) +DSPBRT: PARAM 7,DSPINT,10 + PUSHJ P,MODPRM ; PUT DISPLAY IN PARAMETER MODE + LDB X,BYTPNT + ANDCMI X,7 +DSPBTH: IOR W,X + DPB W,BYTPNT ;CLOBBER ON TOP OF SKEL + POPJ P, + +; ROUTINE TO PUT A COMMAND INTO THE DISPLAY ARRAY +DSPPUP: IOR W,DSPMOD ; MERGE IN THE MODE BITS +DSPPUT: HRRZ X,BYTPNT ; GET CURRENT VALUE OF ARRAY POINTER + CAML X,DSPLIM ; CHECK TO SEE IF THE ARRAY IS FULL + JRST DSPFUL ; FULL - BETTER CHECK STATUS +DSPPTZ: IDPB W,BYTPNT ; ROOM EXISTS - PLACE COMMAND IN ARRAY + SKIPN PUTCLL + POPJ P, ; RETURN + JRST PUTCLL@ + +; ROUTINE TO HANDLE THE BUFFER FULL CONDITION +DSPFUL: PUSH P,A + PUSH P,B + SKIPGE A,DSPARY + STOP _NON-EXCISTANT DISPLAY ARRAY-DSPFUL + MOVEI B,2000 + ADD B,ARYL(A) ;TRY MORE ROOM + PUSHJ P,ARYALS + MOVEI B,2000 + ADDM B,DSPLIM ;MUST BE AFTER ARYALS TO RELOC IF ARRY MOVED + POP P,B + POP P,A + JRST DSPPTZ + ; ROUTINE WHICH PUTS THE DISPLAY INTO THE PROPER MODE + +MODPRM: TDZA E,E ; ENTRY FOR PARAMETER MODE +MODCHR: MOVEI E,60000 ; ENTRY FOR CHARACTER MODE + JRST MODCHK + +MODVCC: SKIPA E,[120000] ; ENTRY FOR VECTOR CONTINUE +MODVEC: MOVEI E,100000 ; ENTRY FOR VECTOR MODE + JRST MODCHK + +MODINC: SKIPA E,[140000] ; ENTRY FOR INCREMENT +MODPNT: MOVEI E,20000 ; ENTRY FOR POINT MODE + +MODCHK: CAMN E,DSPMOD ; COMPARE THE TWO VALUES + POPJ P, ; RETURN - NO CHANGE + SKIPGE DSPARY ; ARE WE REALLY WINNING? + STOP _NON-EXCISTANT DISPLAY ARRAY-MODCHK + MOVEM W,DSPTMP' ; SAVE WORKING REGISTER + MOVE X,DSPMOD ; GET CURRENT VALUE OF MODE TYPE + CAIGE X,40000 ; CHECK CURRENT MODE TYPE + JRST MODFNX ; TYPE 0 OR 1 NEED NO SPECIAL HANDLING + CAIE X,60000 ; CHECK FOR BEING IN CHARACTER MODE + JRST MODSPC ; NO - MUST BE MODE TYPE 4, 5, OR 6 + MOVEI W,37 ; PUT TERMINATION CHARACTER INTO THE BUFFER + PUSHJ P,DSPPUT + MOVE W,BYTPNT ; GET BYTE POINTER + TLZ W,177700 ; SET BIT POINTER TO NEXT HALFWORD + TLNE W,200000 + TLO W,20000 + TLO W,2200 ; SET BYTE SIZE BACK TO HALFWORD + MOVEM W,BYTPNT + JRST MODFIN + +MODSPC: MOVE W,BYTPNS + CAMN W,BYTPNT + JRST MODFNW ;HAVENT REALLY STORED ANY OF THIS FLAVOR + LDB W,BYTPNT ; GET MOST RECENT HALFWORD + IORI W,400000 ; SET PROPER ESCAPE BIT + DPB W,BYTPNT +MODFIN: SETZM DSPMOD ; MAKE SYSTEM THINK IT IS IN PARAMETER MODE + MOVEI W,(E) ; GET NEW VALUE OF MODE TYPE + PUSHJ P,DSPPUT ; PUT SKELETON TYPE 0 COMMAND INTO THE BUFFER + MOVE W,DSPTMP ; RESTORE WORKING REGISTER + JRST MODFNY ; CHECK TO SEE IF NEW MODE NEEDS SPECIAL HANDLING + +MODFNW: MOVE W,DSPTMP ;PREV WORD IS REALLY PNT OR PARAM +MODFNX: LDB X,BYTPNT ; GET LAST COMMAND FROM THE ARRAY + ANDCMI X,160000; INSERT NEW MODE BITS + IORI X,(E) + DPB X,BYTPNT ; PUT COMMAND BACK INTO THE ARRAY + JUMPE E,MODFIN ;INSERT SKEL TYPE 0 COMM + MODFNY: MOVEM E,DSPMOD ; UPDATE MODE VALUE + CAIGE E,60000 ; CHECK NEW MODE VALUE + POPJ P, ; RETURN - NEEDS NO SPECIAL HANDLING + CAIN E,120000 + SETZM DSPMOD ; CAUSE IT WILL RETURN TO PARM MODE WHEN DONE WITH VECTOR CONTINUE + SETOM DINCNR ; REST INCREMENT STATE CNTR + MOVE X,BYTPNT ; SAVE SO CAN TELL IF ANY WDS IN THIS MODE REALLY STORED + MOVEM X,BYTPNS + CAIE E,60000 ; CHECK FOR NEW MODE BEING CHARACTER MODE + JRST MODFNZ ; NOT CHARACTER - BETTER CHECK SOME MORE + MOVSI X,2400 ; SET BYTE POINTER TO HANDLE CHARACTERS + XORM X,BYTPNT +MODFNZ: SETOM XDISP ; X AND Y VALUES ARE UNDEFINED - TELL THE SYSTEM + SETOM YDISP + POPJ P, ; RETURN + +DCROSS: PUSHJ P,OUTSID + POPJ P, + PUSH P,DSPSCL ;SAVE SIZE DISPLAY A CROSS + MOVEI W,0 + PUSHJ P,DSPSIZ ;SET SIZE TO 0 + SUB B,CROSSZ + PUSHJ P,DSPPNZ ;WEST + SKIPA +DCROST: PUSH P,DSPSCL + MOVE B,CROSSZ + LSH B,1 + MOVEI C,0 + PUSHJ P,DSPVEC ;EAST + MOVN C,CROSSZ + MOVE B,C + PUSHJ P,DSPVC0 ;SOUTH + MOVEI B,0 + MOVE C,CROSSZ + LSH C,1 + PUSHJ P,DSPLNE ;NORTH + POP P,W + JRST DSPSIZ ;RESTORE SIZE + +CROSSZ: 5 ;LENGTH OF ARM OF CROSS + +;ACDISC: IMUL B,ARYSCL(A) ;CONVRT ARY COORDS IN B,C TO 340 COORDS +; IMUL C,ARYSCL(A) +; TRNE B,400000 +; ADD B,[1,,] +; TRNE C,400000 +; ADD C,[1,,] +; HLRZS B +; HLRZS C +; ADD B,ARYXOF(A) +; ADD C,ARYYOF(A) +; ASH B,-4 +; ASH C,-4 +; POPJ P, + +IFN LIBRAR,[ + +ARROW: ;X1, Y1, X2, Y2 FIXED - GENERATE ARROW +.I ,XQA'=,XQB'=,XQC'=,XQD'= + PUSHJ P,DSPPNI +ARROWT: +.I DSPVCA<,XQC,XQD> ;DRAW SHAFT +.I FEATH'=MIN>>,LNMIN>*FTHFRC/100. +.I DXRW'=(XQC-XQA)*FEATH/LENTF, DYRW'=(XQD-XQB)*FEATH/LENTF +.I DXRW=DXRW-DYRW, DYRW=DXRW+DYRW +.I DSPLNE<,-DXRW,-DYRW> +.I DSPVC0<,DXRW,DYRW> +.I DSPLNE<,-DYRW,+DXRW> + POPJ P, + + +FTHFRC: 30. ;ARM FRACTION OF SHAFT +LNMIN: 20. ;MAX SIZE OF PROPOR + +] + +DSPWHR: PUSHJ P,MODPNT ;PREPARE A JOINT + SETOM XDISP + SETOM YDISP + MOVE A,BYTPNT + POPJ P, ;HE NEEDS TO PROTECT THIS ADDRESS + + +DSPSHM: ANDI C,DSPMSK + ILDB W,A + ANDCMI W,DSPMSK + IOR W,C + DPB W,A + ANDI B,DSPMSK + ILDB W,A + ANDCMI W,DSPMSK + IOR W,B + DPB W,A + POPJ P, + DSTUP: SKIPL A,DSPARY ;INITIALISE DISPLAY ARRAY AND PUT ON DISPLAY LIST + PUSHJ P,ARYDEL + SETOM DSPARY + PUSHJ P,DISINS + JRST DISAAD + +DISIN: TLOA A,-1 ;GET NEW DISPLAY ARRAY +DISINS: MOVE A,DSPARY ;INITIALISE POSSIBLY EXCISTING DISPLAY ARRAY + MOVEI B,2000 ;INITIAL BUFFER LENGTH +DISNAS: TLO B,BDISB ;STOP DISPLAY IF BUFFER RELOC + JUMPL A,DISIN1 + PUSH P,A + PUSHJ P,DISAFL ;REMOVE OLD ARRAY FROM DISLIS + POP P,A +DISIN1: PUSHJ P,ARYALS ;GET ARRAY + MOVEM A,DSPARY ;REMEMBER FOR DISGO +DISIN2: MOVE B,ARYORG(A);UNLIKE DISINS THIS DOES NOT CHANGE ARYL TO 2000 + HRLI B,442200 + MOVEM B,BYTPNT ;BYTE POINTER INTO DISPLAY ARRAY + SOS B + ADD B,ARYL(A) + HRRZM B,DSPLIM ;UPPER LIMIT, LAST WORD + SETOM XDISP + SETOM YDISP + CLEARM DSPMOD + MOVEI A,7 + MOVEM A,DSPINT + CLEARM DSPSCL + CLEARM DSPSC + MOVE A,DSPARY + MOVEI W,117 ;SCALE 0, INT 7-MAY LOOSE IF TRY TO IMMEDIATLY CHANGE INT + JRST DSPPTZ + +DISAFL: MOVEI A,ARYMPP(A) ;FLUSH ARRAY FROM DISLIST +DISFLS: PUSH P,B + PUSH P,C + MOVEI C,DISLIST +DISFL1: HLRZ B,(C) + CAIN B,(A) + HRRZS (C) ;FLUSH THIS ENTRY + HRRZ C,(C) + JUMPN C,DISFL1 + POP P,C + POP P,B + POPJ P, + + LDISGO: STRIKE _NON-EXCISTANT DISPLAY ARRAY-DISGO + POPJ P, + +DISGO: PUSHJ P,MODPRM ;FINISH OFF ARRAY AND PUT ON DISLIST + MOVEI W,3000 + IDPB W,BYTPNT + SKIPGE A,DSPARY + JRST LDISGO + HRRZ B,BYTPNT + SUB B,ARYORG(A) + MOVEI B,5(B) + PUSHJ P,ARYALS ;FLUSH ANY UNUSED DISPLAY ARRAY SPACE + +DISAD1: ;ADD ARRAY TO DISLIST +DISAAD: JUMPL A,POPJP + MOVEI A,ARYMPP(A) +DISAD: MOVEI C,DISLIST +DISA3: HLRZ B,(C) ;SEE IF ALREADY THERE + CAMN B,A + POPJ P, ;YES + HRRZ C,(C) + JUMPN C,DISA3 + MOVEI C,DISLIST +DISA2: HLRZ B,(C) ;LOOK FOR HOLE TO PUT IT IN + JUMPE B,DISA1 + HRRZ C,(C) + JUMPN C,DISA2 + STRIKE _DISLIST FULL-DISAD + POPJ P, + +DISA1: HRLM A,(C) + POPJ P, + +DARYF: SKIPGE A,DSPARY ;FLUSH DSPARY + STRIKE _NON-EXCISTANT DISPLAY ARRAY-DARYF + SETOM DSPARY + JRST ARYDEL + +GRBDIS: .DSTAR DISLIS ;GRAB DISPLAY + JRST .-1 + POPJ P, + +ADISON: PUSHJ P,OPNDIS + POPJ P, + POPJ P, + +ADISOF: JRST CLODIS + +MESSX: 0 +MESSY: 1750 ;PLACE TO PUT COMMENTS +HEADSW: 1 ;NON-0 FOR HEADING +FRAMSW: 0 ;NON-0 FOR FRAME +REPET: 60 ;CAMERA REPEAT + +XBTT: 0 ;WINDOW EDGES +XTOP: 1777 +YBTT: 0 +YTOP: 1777 + + +SCPTTY: PUSHJ P,TYI ;READ TTY AND PUT CHRS ON SCOPE + CAIN A,^C + POPJ P, + CAIN A,177 + JRST SCPRUB + CAIN A,15 + MOVEI A,34 + PUSHJ P,DTYOA + JRST SCPTTY + +SCPRUB: LDB A,BYTPNT + MOVEI A,100 + PUSHJ P,TYO + MOVEI A,40 + DPB A,BYTPNT ;CHANGE CHARACTER TO SPACE + MOVE A,BYTPNT + CAML A,[360600,,0] + JRST WRDBRK + ADD A,[060000,,0] + MOVEM A,BYTPNT + JRST SCPTTY + +WRDBRK: PUSH P,B + SUB A,[360000,,1] + HRRZ B,BYTPNS + SUB B,A + TRNN B,-1 + JRST PSSBEG + MOVEM A,BYTPNT + MOVE B,[403737,,403737] + MOVEM B,1(A) + POP P,B + JRST SCPTTY + +PSSBEG: POP P,B + MOVEI A,"? + PUSHJ P,TYO + JRST SCPTTY + +SCPPLC: GET X,Y,SCC,BRT + MOVEM X,MESAX ;READ PLACE, SCALE, INTENSITY BEFORE SCPTTY + MOVEI B,1 + PUSHJ P,DSIZA + MOVE W,BRT + PUSHJ P,DSPBRT +.I DSPPNZ<,X,Y> + MOVE B,SCC + PUSHJ P,DSIZA + POPJ P, + +SCC: 0 +BRT: 0 + +OUTSID: CAMG B,XTOP ;SKIPS IF POINT INSIDE + CAMLE C,YTOP + POPJ P, ;OUTSIDE + CAML B,XBTT + CAMGE C,YBTT + POPJ P, + AOS (P) ;INSIDE + POPJ P, + +CHRSCL: 2 ;CHRACTER SCALE IN TALK + +TALK: MOVEM A,ROTTLK' + PUSHJ P,OUTSID ;IS INSIDE SCOPE FACE + POPJ P, ;NO + PUSHJ P,DSPPNZ ;GO TO MESSAGE PLACE + PUSH P,DSPSCL +.I DSIZA<,CHRSCL> ;CHANGE SCALE FOR CHARACTERS + TRO ZR,DISCHR + PUSHJ P,@ROTTLK ;PRINT + TRZ ZR,DISCHR + POP P,W + JRST DSPSIZ + +FRAME: SKIPN FRAMSW + POPJ P, +.I DSPPNI<,XBTT,YBTT> ;ORIGIN +.I DSPVCA<,XTOP,YBTT> ;BOTTOM LINE +.I DSPVCA<,XTOP,YTOP> ;RIGHT EDGE +.I DSPVCA<,XBTT,YTOP> ;TOP EDGE +.I DSPVCA<,XBTT,YBTT> ;BACK TO ORG + POPJ P, + +STRSWD: .DSTOP +.I DISINS> ;GET REQUIRED DISPLAY ARRAYS +.I DISINS> + JRST ADISON ;SWITCH ON DISPLAY + +DCLEAR: .DSTOP +.I DSPCFT'=#NDSPI-1 +DPLPCR: PUSHJ P,DSPSEL + SKIPL A,DSPARY + PUSHJ P,ARYDEL + SETOM DSPARY + SOSL A,DSPCFT + JRST DPLPCR + MOVEI C,DISLIST +DCLR1: HLRZ A,(C) + SUBI A,ARYMPP ;CALCULATE ARRAY NUMBER + SKIPL A + PUSHJ P,ARYDEL + HRRZS (C) ;WIPE POINTER + HRRZ C,(C) ;GROVEL ALONG LIST + JUMPN C,DCLR1 + JRST ADISON ;START UP DISPLAY AGAIN + + + +;PLOTTER OUTPUT GOODIES + +PLOT1: .OPEN IPLC,IPLOP + STOP _PLOTTER WON'T OPEN + POPJ P, + +PLOT2: MOVE A,IPLIO0 + .IOT IPLC,A + POPJ P, + +PLOTA: PUSHJ P,PLOT1 + PUSHJ P,PLOT2 +PLOT3: MOVE A,DISLIS +DETA: PUSHJ P,COUP + TRNN A,-1 + POPJ P, ;END OF DISLIS + MOVE A,(A) + JRST DETA + +COUP: MOVE B,A + HRRI B,747 + TLNE B,-1 ;IF NULL ADDRESS IGNORE + .IOT IPLC,B + POPJ P, + +PLOT: PUSHJ P,PLOTA + PUSHJ P,PLOT4 +PLOT5: .CLOSE IPLC, + POPJ P, + +PLOT4: MOVE A,IPLIO2 + .IOT IPLC,A + POPJ P, + +IPLIO0: -1 ;RESET THE WORLD +IPLIO2: 22001,,1 ;GO TO X=11", Y=0" + +IPLOP: 5,,(SIXBIT/IPL/) + 0 + 0 + +] + IFN STEREO,[ + +INSID: 0 ;NON-0 WHEN INSIDE WINDOW +XLST: 0 ;LAST X +YLST: 0 ;LAST Y + +XNEW: 0 ;END POINTS OF LINE INTERSECTING FRAME +YNEW: 0 +XOLD: 0 +YOLD: 0 + +DPOIN: CAMN B,XLST ;GO TO A POINT + CAME C,YLST ;FIXED COORDS IN B,C + JRST .+2 ;SKIPA + POPJ P, ;SAME POINT SO IGNORE +.F ,XLST=,YLST= ;UPDATE LAST POINT + SETZM INSID + PUSHJ P,OUTSID ;SEE IF INSIDE FRAME + POPJ P, ;NO + SETOM INSID ;YES + JRST DSPPNI ;SO GENERATE A POINT THERE + +DVOIN: AOSN VECONN + JRST DPOIN ;POINT FIRST TIME +DVECT: CAMN B,XLST ;DRAW VECTOR TO THIS POINT + CAME C,YLST ;FIXED COORDS IN B,C + JRST .+2 ;SKIPA + POPJ P, ;SAME POINT SO IGNORE + SKIPN INSID ;WAS LAST POINT INSIDE + JRST OLSID ;NO + PUSHJ P,OUTSID ;IS NEW POINT INSIDE + JRST NLSID ;NO +.I ,XLST=,YLST= ;BOTH INSIDE IT SEEMS + JRST DSPVCA ;SO DRAW A VECTOR + +OLSID: PUSHJ P,OUTSID ;IS NEW POINT INSIDE + JRST BTSID ;NEITHER INSIDE +.I ,XOLD=,YOLD= +.I ,XNEW=XLST,YNEW=YLST + PUSHJ P,SWPLPA ;FIND POINT ON FRAME-EDGE + PUSHJ P,DSPPNI ;GO TO POINT ON EDGE + SETOM INSID +.I ,XLST=XOLD,YLST=YOLD + JRST DSPVCA ;DRAW CONNECTING VECTOR FROM EDGE + + SVCRDS: +.I ,XNEW=,YNEW= +.I ,XOLD=XLST,YOLD=YLST +.I ,XLST=XNEW,YLST=YNEW + POPJ P, + +NLSID: PUSHJ P,SVCRDS ;EXCHANGE SOME POINTS + PUSHJ P,SWPLPA ;FIND POINT ON FRAME-EDGE + SETZM INSID + JRST DSPVCA ;DRAW VECTOR TO EDGE + +BTSID: PUSHJ P,SVCRDS ;BOTH POINTS OUTSIDE + SETOM GNPNT' + MOVEI Z,3 + MOVEM Z,ZSVD' +BTTLP: PUSHJ P,BTTMC ;TEST IF POSSIBLE + SOSL Z,ZSVD + JRST BTTLP + POPJ P, ;ALL FOUR LOST + +BTTMC: +.I ,XYCR1@(Z),XYCR2@(Z),XYLVL@(Z) + CAML B,C + EXCH B,C + CAMG B,D + CAMG C,D + POPJ P, ;FORGET IT + PUSHJ P,ROTINZ ;CALL CALCULATOR FOR THIS EDGE + PUSHJ P,OUTSID ;IS INTERSECTION INSIDE + POPJ P, ;NO + AOSN GNPNT ;IS THIS THE FIRST CALL + JRST DSPPNI ;YES, GO TO POINT + SUB P,[1,,1] ;POP UP AN EXTRA LEVEL ON RETURN + JRST DSPVCA ;CONNECT BY VECTOR + + +XYCR1: YOLD?XOLD?YOLD?XOLD +XYCR2: YNEW?XNEW?YNEW?XNEW +XYLVL: YBTT?XTOP?YTOP?XBTT + SWPLPA: SETZM D ;WINDOW FUNCTION + CAML B,XTOP ;FIND WHICH EDGE IT CROSSES + ADDI D,1+5 + CAML C,YTOP + ADDI D,2+5 + CAMGE B,XBTT + ADDI D,4+5 + CAMGE C,YBTT + ADDI D,0+5 + MOVE Z,D + SUBI Z,5 + SKIPGE Z + .VALUE ;CROSSES NO EDGE ! - PROGRAM ERROR + CAIN Z,4 + MOVEI Z,3 + CAIGE Z,5 ;'CROSSES' ONE OR TWO LINES ? + JRST EDGCRP ;ONLY ONE SO ITS EASY + SUBI Z,6 + CAIN Z,3 + MOVEI Z,6 ; CAIN Z,5; MOVEI Z,4 + LSH Z,-1 +.I ,(XNEW-XOLD)*(@YCRN(Z)-YOLD)-(YNEW-YOLD)*(@XCRN(Z)-XOLD) ;CROSS PRODUCT + SKIPGE B ;DECIDE WHICH IT ACTUALLY CROSSES + AOS Z ;ONE EDGE FURTHER ON + CAIN Z,4 + MOVEI Z,0 +EDGCRP: +ROTINZ: MOVE D,@XYLVL(Z) +.I ,,,,XNEW-XOLD,YNEW-YOLD + JRST @ROUTF(Z) ;SELECT ROUTINE TO FIND POINT ON EDGE + +ROUTF: BTTM?RGHT?TOPE?LEFE +XCRN: XTOP?XTOP?XBTT?XBTT +YCRN: YBTT?YTOP?YTOP?YBTT + +TOPE:BTTM: SKIPN F + AOS F ;AVOID ZERO DENOM +.I ,(D-YOLD)*E/F+XOLD,D + POPJ P, + +LEFE:RGHT: SKIPN E + AOS E ;AVOID ZERO DENOM +.I ,D,(D-XOLD)*F/E+YOLD + POPJ P, + +CAMERR: 1.0 ;-1.0 FOR LEFT, 1.0 FOR RIGHT, 0 NORMALLY +LFTRGH: 0 ;-1.0 FOR LEFT, 1.0 FOR RIGHT + +HEADF: 0 ;ROUTINE TO GEN HEADING +CALLF: 0 ;ROUTINE TO GEN DISPLAYAGE + +XDCN: 1000 ;ASSUMED CENTRE OF SCREEN +YDCN: 1000 + +CAMMAG: 3.6 ;CAMERA DE-MAGNIFICATION (FOR POLAROID ON BOX) + +DOBJ: 1000.0 ;OPTICAL SYSTEM SPECS, CHANGED BY POT READ IN +DSEY: 70.0 +FDIS: 140.0 +SIZEC: 1.0 + CRAT: 0 ;X PERSPECTIVE OFFSET +PROJR: 0 ;PROJECTION RATIO +BEHND: 0 ;NON 0 WHEN POINT BEHIND CAMERA +ORTHG: 0 ;1 FOR 'ORTHOGONAL' PROJECTION + +MINSR: 1.0 +MINST: -1.0 + +DSPSCQ: 4.6 ;UNITS PER MM (4.1 FOR PLOTTER) + +AVCT: BLOCK 3 ;WORK VECTORS +;RVCT: BLOCK 3 +ROTER: BLOCK 9 ;OBJECT ROTATION MATRIX +ADSM: BLOCK 3 ;OBJECT OFFSET VECTOR + +EYEPRJ: ;X,Y,Z, FLOATING, BEHND IS NON 0 IF BEHIND CAMERA + SETZM BEHND + SKIPE ORTHG + SETZM C + FADR C,DOBJ ;CALCULATE TOTAL Z + PUSHJ P,REHIR ;TO MAKE SURE ITS NOT 0 + SKIPG C + SETOM BEHND ;POINT BEHIND CAMERA +.F ,,,(1.0-PROJR=FDIS/C)*(CRAT=DSEY/2.0*LFTRGH) + FMPR A,PROJR + FMPR B,PROJR + FADR A,D ;X OFFSET DUE TO EYE POSITION + SKIPN CAMERR + JRST NDFXSC ;CAMERA NOT USED NOW +.F ,,,(1.0-FDIS/DOBJ)*CRAT + FSBR A,D + FMPR A,CAMMAG + FMPR B,CAMMAG +NDFXSC: FMPR A,DSPSCQ ;CONVERT MM TO SCOPE UNITS + FMPR B,DSPSCQ + FIX B + FIX A + ADD B,XDCN ;ADD TO CENTRE OF SCREEN + ADD C,YDCN + SKIPN MVRFLG + POPJ P, + MOVE A,POTDAT+7 ;OFFSET BY AMOUNT INDICATED BY POT(7) + LSH A,-2 + SUBI A,1000 + ADD B,A + POPJ P, + +MVRFLG: 0 ;OFFSET BY POTDAT+7 IF ON + + +REHIR: CAML C,MINSR + POPJ P, + CAMG C,MINST + POPJ P, + SKIPL C + MOVE C,MINSR + SKIPG C + MOVE C,MINST + POPJ P, + +CHNAPR: ;CHANGE APPEARANCE OF OBJECT ROTATE, ENLARGE ,MOVE +.F AVCT(0)=,AVCT(1)=,AVCT(2)= +.F (ROTER(0)*AVCT(0)+ROTER(1)*AVCT(1)+ROTER(2)*AVCT(2))*SIZEC+ADSM(0),$ +.F (ROTER(3)*AVCT(0)+ROTER(4)*AVCT(1)+ROTER(5)*AVCT(2))*SIZEC+ADSM(1),$ +.F (ROTER(6)*AVCT(0)+ROTER(7)*AVCT(1)+ROTER(8)*AVCT(2))*SIZEC+ADSM(2) + POPJ P,î + +RPPS: 60. ;REPEAT SLEEP IF NOTHING HAPPENS +PAUSE: 8 ;SLEEP PERIOD +NOCMRS: 1 ;NON-ZERO TO AVOID RESETTING CAMERA HACK + +;DSPCRI IS 0 AND 1 FOR ALTERNATE OUTPUT DISPLAYS, 2 FOR HEADINGS + +GANDRV: SETOM IGNPOT ;IGNORE POTS +GUNDRV: SETOM TYPED ;DO A SINGLE DISPLAY + JRST .+2 +GENDRV: SETZM TYPED +.I QITADR=#GANDON + SETZM POTFLS + SKIPN NOCMRS ; + SETZM CAMERR +GENDR1: PUSHJ P,STRSWD ;GENERATE THE TWO DISPLAY ARRAYS + PUSHJ P,OPNPOT ;OPEN POTS + MOVEI Z,0 +.I ARYCLR + Q DISIN2 +.I DISAAD + JRST UNCHN1 + +RADPOT: MOVE Z,RPPS ;REPEAT SLEEPING +UNCHND: MOVE A,PAUSE + SKIPE FAST + MOVEI A,1 + SKIPN TYPED + .SLEEP A, + SETZM IGNPOT + SKIPE TYPED + JRST GANDON +UNCHN1: SKIPE IGNPOT + JRST UNAGN + PUSHJ P,REDPOT ;READ POTS - SKIPS IF CHANGED + SOJGE Z,UNCHND ;NOTHING HAPPENED, SLEEP AGAIN + SKIPE CARDAT + PUSHJ P,HNGINT ;WAIT FOR POTS TO SETTLE +UNAGN: PUSHJ P,RAUS + JRST RADPOT ;GO IT AGAIN + +GANDON: SETZM QITADR + PUSHJ P,CLOPOT +.I ARYDEL + SO DSPARY +.I DSPSEL<1-DSPCRI> + POPJ P, + + HNGINT: PUSHJ P,@HEADF ;REPEAT HEADING + MOVE A,PAUSE + SKIPE FAST + MOVEI A,1 + .SLEEP A, + PUSHJ P,REDPOT + POPJ P, ;UNCHANGED + SKIPE TYPED + POPJ P, + JRST HNGINT + +CARDAT: 0 ;WAIT FOR POTS TO SETTLE IF ON +IGNPOT: 0 ;IGNORE POTS IF ON + +RAUS: PUSHJ P,EYESTP ;CHANGE ROTATION MATRIX + PUSHJ P,@HEADF ;GENERATE HEADINGS, FRAMES ETC + PUSHJ P,@CALLF ;GENERATE GRAPH +SWPSWD: PUSHJ P,DISGO ;COMPLETE AND PUT ON DISPLAY LIST +.I DSPSEL<1-DSPCRI> ;SWITCH TO OTHER DATA +.I DISIN2 ;REINITIALISE + MOVE A,DSPARY + JRST DISAFL ;REMOVE ONE FROM DISLIS + +POTTER: PUSHJ P,DCLEAR +.I DISINS + SETZM TYPED + PUSHJ P,OPNPOT + PUSHJ P,ADISON +RAVAG: PUSHJ P,REDPOT + SKIPA + PUSHJ P,DISGRL + SKIPN TYPED + JRST RAVAG + JRST CLOPOT + +HEDBRT: 7 ;HEADING BRIGHTNESS + +DISGRL: PUSH P,DSPCRI ;ONE TYPE OF HEADING +.I DSPSEL<2> + SKIPGE A,DSPARY + PUSHJ P,DISINS + PUSHJ P,DISIN2 +.I DSPPNZ<,0,0> + MOVE W,HEDBRT + PUSHJ P,DSPBRT + SKIPE FRAMSW + PUSHJ P,FRAME ;GENERATE FRAME + SKIPE HEADSW + PUSHJ P,TLKPOT + PUSHJ P,DISGO + POP P,A + JRST DSPSEL + +TLKPOT: +.I TALK<#POTPNT,MESSX,MESSY> + POPJ P, + + RGHEYE: MOVE A,[1.0] + JRST .+2 ;SKIPA +LFTEYE: MOVE A,[-1.0] +.I CAMERR=LFTRGH= + SETZM TYPED + PUSHJ P,RAUS +.I LFTRGH=CAMERR + QUERY OK + PUSHJ P,GENDR1 +PHOTO: MOVEI A,1 +BLTPHO: .NDIS A, + JFCL + MOVNI A,1 + .NDIS A, ;WAIT FOR IT + QUERY READY + JRST OPNDIS ;RETURN TO TOP LEVEL + SKIPE HEADF + PUSHJ P,HEADF@ ;REDO HEADING + MOVE A,REPET + JRST BLTPHO ;DO ANOTHER EXPOSURE + +DLTCRN: 20. ;CORNER SIZE + +LFTFRM: +.I DSPPNI<,DLTCRN,0> +.I DSPVCA<,0,0> +.I DSPVCA<,0,DLTCRN> +.I DSPPNI<,0,1777-DLTCRN> +.I DSPVCA<,0,1777> +.I DSPVCA<,DLTCRN,1777> + POPJ P, + +RGHFRM: +.I DSPPNI<,1777,1777-DLTCRN> +.I DSPVCA<,1777,1777> +.I DSPVCA<,1777-DLTCRN,1777> +.I DSPPNI<,1777-DLTCRN,0> +.I DSPVCA<,1777,0> +.I DSPVCA<,1777,DLTCRN> + POPJ P, + +POTTRK: PUSHJ P,OPNPOT + SETZM TYPED +MUMPOT: PUSHJ P,REDPOT + PUSHJ P,DISGRL + SKIPE TYPED + JRST CLOPOT + MOVEI A,3 + .SLEEP A, + JRST MUMPOT + +IDENTY: 1.0?0?0?0?1.0?0?0?0?1.0 ;IDENTITY MATRIX + +PITCH: 0 ;OMEGA -RED FROM POTS +YAW: 0 ;PHI +ROLL: 0 ;KAPPA + + +SETROT: MOVE A,[IDENTY,,ROTER] ;RESET OBJECT ROTATION TO NOTHING + BLT A,ROTER+8. +.F PITCH=ROLL=YAW=0 +.F DSEY=0 + POPJ P, + +EYESTP: +IFN LIBRAR,[ +ROTCHN: ;ALTERNATE OBJECT ROTATION GENERATOR +; PITCH FIRST (X-AXIS),THEN YAW (Y-AXIS), THEN ROLL (Z-AXIS) +.F CPIT'=COS, SPIT'=SIN +.F CYAW'=COS, SYAW'=SIN +.F CROL'=COS, SROL'=SIN + +.F ROTER(0)=CROL*CYAW +.F ROTER(1)=CROL*SYAW*SPIT-SROL*CPIT +.F ROTER(2)=CROL*SYAW*CPIT+SROL*SPIT + +.F ROTER(3)=SROL*CYAW +.F ROTER(4)=SROL*SYAW*SPIT+CROL*CPIT +.F ROTER(5)=SROL*SYAW*CPIT-CROL*SPIT + +.F ROTER(6)=-SYAW +.F ROTER(7)=CYAW*SPIT +.F ROTER(8)=CYAW*CPIT + + POPJ P, +] + .VALUE ;ROTCHN WAS NOT ASSEMBLED IN + +OPNPOT: JFCL ;UNTIL ITS FIXED ?#? + .OPEN IMPC,IMPOPN ;OPEN INPUT MULTIPLEXOR + STOP _POTS WON'T OPEN + WIPE POTSAV,POTNMB + POPJ P, + +CLOPOT: JFCL ;UNTIL ITS FIXED ?#? + .CLOSE IMPC, + POPJ P, + +IMPOPN: 2,,(SIXBIT/IMX/) + 0 + 0 + +OFSAT: 0 ;RANDOM PLACE FOR LAST POT +POTSNM: 36?37?24?23?25?26?27?22 +POTNMB: .-POTSNM ;USUAL NUMBER OF POTS +FSTNMB: 4 ;NUMBER READ IN FAST MODE +POTSAV: BLOCK 10 ;SAVED POT-READINGS +POTDAT: BLOCK 10 ;INPUT DATA +FAST: 0 ;NON-ZERO FOR FAST DISPLAYING +FINEP: 0 ;NON-ZERO FOR FINE POT CONTROL +PTNISE: 12 ;ACCEPTABLE POT NOISE +FREEZE: 0 ;NON-ZERO TO DISALLOW POTS TO VARY + +TWPP=4.0 +TWPN=-TWPP + POTMN: TWPN?TWPN?TWPN?-1.0?-1.0?-1.0?-1.0?-128.0 +POTMX: TWPP?TWPP?TWPP?100.0?300.0?1200.0?120.0?128.0 + +TWPF=1.5 +TWNF=-TWPF + + POTFMN: TWNF?TWNF?TWNF?50.0?100.0?500.0?50.0?-64.0 +POTFMX: TWPF?TWPF?TWPF?200.0?200.0?1000.0?75.0?64.0 + +POTADD: PITCH?YAW?ROLL?SIZEC?FDIS?DOBJ?DSEY?OFSAT + +REDPOT: JFCL ;UNTIL ITS FIXED ?#? + SKIPE FREEZE ;FREEZE MEANS IGNORE POTS + JRST APOPJP + SETZM POTCHN' + COPY POTDAT,POTSNM,POTNMB + MOVEI A,POTDAT + MOVN B,POTNMB + SKIPE FAST ;DO NOT READ ALL POTS IN FAST MODE + MOVN B,FSTNMB + HRL A,B + .IOT IMPC,A + + MOVE G,POTNMB + SKIPE FAST + MOVE G,FSTNMB + SOS G +LPDPO: SKIPG POTDAT(G) ;-1 IF HARDWARE OR SYSTEM LOST + JRST NLDPA +.I ABS-PTNISE + JUMPG A,VALCHP +NLDPA: +.I POTDAT(G)=POTSAV(G) + JRST NLDPO +VALCHP: AOS POTCHN + SKIPN FINEP + JRST COARSE +.F POTADD@(G)=FFLOAT/4096.0*(POTFMX(G)-POTFMN(G))+POTFMN(G) + JRST NLDPO +COARSE: +.F POTADD@(G)=FFLOAT/4096.0*(POTMX(G)-POTMN(G))+POTMN(G) +NLDPO: SOJGE G,LPDPO + COPY POTSAV,POTDAT,POTNMB + SKIPE POTCHN +APOPJP: AOS (P) + POPJ P, + +POTFLS: 0 ;ONE TO FLUSH ROTATION PARAMETERS + +POTPNT: PRINT +IFN STMPIT,[ + PUSHJ P,STAMP ;DISPLAY PARAMETERS +] + SKIPE HEADIN + PUSHJ P,@HEADIN + SKIPE POTFLS + POPJ P, +.F PITCH,YAW,ROLL,SIZEC + PRINT _ PITCH=%1F2.3 YAW=%2F2.3 ROLL=%3F2.3 MAG=%4F3.1 +.F FDIS,DOBJ,DSEY + PRINT _ DIMG=%1F4.1 DOBJ=%2F4.1 EYES=%3F4.1_ + POPJ P, +] + IFN MOVFLG,[ + +FRAMEN: PUSHJ P,FRAME ;EXPOSE C(A) FRAMES + SOJG A,.-1 + POPJ P, + +FRAME: PUSHJ P,OPEN ;EXPOSE ONE FRAME + PUSH P,A + MOVE A,REPAT + .NDIS A, ;DISPLAY REPEAT TIMES + JRST .-1 ;IN CASE NDIS DIDN'T WIN + MOVNI A,1 + .NDIS A, ;HANG UNTIL DONE + POP P,A +CLOSE: SKIPN SHUTTR + POPJ P, ;ALREADY CLOSED + SETZM SHUTTR + JRST OPNCLS + +OPEN: SKIPN STOPPE + SKIPE SHUTTR + POPJ P, ;ALREADY OPEN OR STOPPED SET + SETOM SHUTTR +OPNCLS: PUSH P,A + PUSH P,B + MOVEI A,50. ;25. COMPLETE 4 STEP CYCLES = 1/2 REVOLUTION + SETZM MOTOR ;TO AVOID REVERSING ON QUIT +OPCLLP: MOVEI B,100 + PUSHJ P,YANKM + MOVEI B,200 + PUSHJ P,YANKM + SOJG A,OPCLLP + AOS NHREVS ;INCREMENT HAL-REV COUNTER + JRST POPBJ + +YANKM: XORB B,MOTOR + DATAO 760,B ;OUTPUT GREY CODE TO MOTOR + MOVE B,TIMSUP + SOJG B,. ;WAIT APPROPRIATE TIME FOR DATAO TO SETTLE + POPJ P, + +SHUTTR: 0 ;0 = SHUTTR CLOSED, -1 = SHUTTER OPEN +MOTOR: 0 ;LAST DATAO TO MOTOR +NHREVS: 0 ;NUMBER OF HALF REVOLUTIONS SINCE START +STOPPE: 0 ;NON-ZERO = NO MORE EXPOSURES +TIMSUP: 1000 ;1000 FOR PDP-10, 440 FOR PDP-6 +REPAT: 1 ;HOW MANY TIMES DISLIS IS DISPLAYED + +] + IFN GPHFLG,[ + +;;DPNT + +DOPT: SKIPA C,[10] ;OUTPUT AN OCTAL NUMBER +DDPT: MOVEI C,10. ;OUTPUT A DECIMAL NUMBER +ANPNT: CAIE C,10. ;OUTPUT A NUMBER + JRST DOPT3 + PUSHJ P,DOPT3 + MOVEI A,". ;DECIMAL POINT + JRST (U) ;CALL HIS OUTPUT ROUTINE + +DOPT3: JUMPGE A,DOPT1 ;JUMP IF POSITIVE, ELSE OUTPUT - + PUSH P,A + MOVEI A,"- + PUSHJ P,(U) + POP P,A + MOVNS A +DOPT1: IDIVI A,(C) + HRLM B,(P) ;SQUEZE A DIGIT ONTO PDL + SKIPE A + PUSHJ P,DOPT1 ;RECURSIVE CALL TO STACK MORE DIGITS ON PDL + HLRZ A,(P) ;DROP A DIGIT OFF PDL + ADDI A,"0 + JRST (U) ;CALL HIS OUTPUT ROUTINE + + +LHINT: TLC A,<233-1-18.>*1000 ;CONVERT TO FLOATING FOR PRINTOUT + FAD A,A + JRST FPFP + +;;FP + +FPFP: MOVE V,A ;OUTPUT A FLOATING POINT NUMBER + CLEARB W,C ;W 0 ->E- 1 ->E+ + JUMPG V,FPFP1 + JUMPE V,FPFP3 + MOVNS V + MOVEI A,"- + TLZE V,400000 + JRST FPFP3 +FPOUT: PUSHJ P,(U) +FPFP1: MOVEI A,"# + TLNN V,400 ;NORMALISED ? + XCT FPOUT ;NO, TYPE # FIRST + CAMGE V,FPFT01 + JRST FPFP4 ;<.1 + CAML V,FPFT8 + AOJA W,FPFP4 ;>=10^8 + +;DROP THRU ON DIGIT NEXT TO DECIMAL PT SIG PRNT # W/O E + +FPFP3: CLEARB D,X ;CLEAR DIGIT CNTR, X TO RECEIVE FRAC + MULI V,400 ;MANTISSA TO W + ASHC W,-243(V) ;FRACTION PART IN X + MOVE V,W + PUSHJ P,FPFP7 ;PRINT INTEGER PART + MOVEI A,". ;# DIGITS OUTPUT IN D + XCT FPOUT + MOVNI C,10 + ADD C,D + MOVE W,X + +FPFP3A: MOVE V,W ;PRINT FRACTION PART + MULI V,12 + MOVE A,V + PUSHJ P,FPFP7B + SKIPE W + AOJL C,FPFP3A + POPJ P, + +FPFP4: MOVNI X,6 ;DIGIT NEXT TO DECIMAL NOT SIG PRINT WITH E + MOVEI B,0 ;W 0 GENERATE E- 1 E+ +FPFP4A: ADDI B,1(B) + XCT FPFCP(W) + TRZA B,1 + FMPR V,@FPFCP+1(W) +FPFP4B: AOJN X,FPFP4A + PUSH P,B + PUSH P,EXPSGN(W) + PUSHJ P,FPFP3 ;# NORMALIZED + MOVEI A,"E + XCT FPOUT + POP P,A + XCT FPOUT + POP P,V ;DROP THRU AND PRINT EXPONENT +FPFP7: JUMPE V,FPFP71 ;AVOID INCR D, NOT SIGNIFICANT DIGIT + IDIVI V,12 + AOS D +FPFP7A: HRLM W,(P) + JUMPE V,FPFP71 + PUSHJ P,FPFP7 + +FPFP71: HLRE A,(P) +FPFP7B: ADDI A,60 + XCT FPOUT + POPJ P, + +;ALL THOSE XCT FPOUT'S SEEM TO BE LOSS + + 1.0^32. + 1.0^16. +FPFT8: 1.0^8 + 1.0^4 + 1.0^2 + 1.0^1 +FPFT: 1.0^0 + 1.0^-32. + 1.0^-16. + 1.0^-8 + 1.0^-4 + 1.0^-2 +FPFT01: 1.0^-1 +FPFT0: +FPFCP: CAMLE V,FPFT0(X) + CAMGE V,FPFT(X) + X,,FPFT0 + +EXPSGN: "- + "+ + +;;;LNDV + +;GHXOR: 1740 ;RH ORG FOR GRAPH +;GHYOR: 40 ; " " +;GHDSP: 40 ;V SPACE BETWEEN LINK LINE + GRAPH Y AXIS +;LNGHH: 300 ;HEIGHT OF GRAPH +;FLNGHH: 300.0' ;SAME F.P. +;LNGHS: 400 ;SPACING OF GRAPHS +;GHSCL: 0 ;0 AUTO .NE. 0 AUTO SCALE FOR GRAPHS L.H. INTEGER POTTED +;GHSCLE: 0 ;EFFECTIVE SCALE +;GHLXR: 0 ;COMPUTED Y OF GRPH ORG +FPNBF: BLOCK 5 ;BUFFER FOR FLOATING PT NOS +FPNBFP: 0 ;BYTE POINTER INTO FPNBF +DFPCNT: 0 ;COUNT OF ... +;DGYOR: 0 ;Z ORG OF DOT GRAPH + +DPTDS: MOVEI D,1 ;DECIMAL RIGHT ADJUST + JRST DPTDS1 + +OCTDS: TDZA D,D ;OCTAL +FPDIS: MOVEI D,2 ;FLOATING +DPTDS1: TDZA U,U ;RIGHT ADJUST +DPTS2: MOVNI U,1 ;NO RIGHT ADJ JUST KEEP TRACK OF CHRS + MOVEM U,RADJSW ;SAVE ADJUST OR NOT FLAG + MOVE D,FPDTB(D) + MOVEM D,FPDSW ;REMEMBER FLAVOUR OF NUMBER + MOVE D,[440700,,FPNBF] ;DISPLAY FLT PT NO IN A SO IT IS RIGHT ADJ AT COORDS + MOVEM D,FPNBFP ;IN B AND C + PUSH P,C + PUSH P,B + MOVEI U,DFPST1 + CLEARM DFPCNT + PUSHJ P,@FPDSW + POP P,B + POP P,C + MOVNI A,6*2 ;SCALE *6PTS/CHR + IMUL A,DFPCNT + SKIPGE RADJSW + JRST DFPST2 + ADD B,A + MOVEM B,DFPXCR ;SAVE MIN X COORD ACTUALLY USED +DFPST3: MOVEI A,0 + IDPB A,FPNBFP + MOVEI A,FPNBF + JRST DSPMSG ;OUTPUT ON DISPLAY USING MESSAGE ROUTINE + +DFPST2: SUB A,B + MOVMM A,DFPXCR + JRST DFPST3 + +DFPST1: IDPB A,FPNBFP + AOS DFPCNT + POPJ P, + +FPDSW: 0 ;ENTRY TO PRINT ROUTINE + +FPDTB: DOPT ;OCTAL 0 + DDPT ;DECIMAL 1 + FPFP ;F.P. 2 + LHINT ;LEFT HAND INT 3 + +DFPXCR: 0 ;MIN X COORD ACTUALLY USED OR MAX IF NOT RIGHT ADJ +RADJSW: 0 ;RIGHT ADJ IF -1 + +;;GPH + +;CALL TO GPHMK + +;;JSP T,PHMK + +;WD0 ORG Y,,ORG X - 4.9, 2.9 =0 ABSOLUTE, =1 MEAN RELATIVE TO MAX X, Y + ;4.8 =0 USE DOTS, =1 CONNECT POINTS WITH LINES + +;WD1 MAX X, OR IF 4.9 =1 ADR OF ROUTINE TO GET MAX X (RET IN A) + ;4.8 =0 ABSOLUTE, =1 RELATIVE TO ORG X + ;4.7 =0 DATA DIRECT, =1 DATA IMMEDIATE + ;4.6-4.4 DATA TYPE: 0 FIXED OCTAL, 1 FIXED DECIMAL, 2 F.P., 3 LH INT + ;4.3 =0 ORG IS 0, =1 ORG IS MIN OF DATA +;WD2 MAX Y ETC + +;WD3 AOBJN PTR TO HORIZ DATA (IMMEDIATE OR NOT AS PER 4.7 WD2) +;WD4 AOBJN PTR TO VERTL DATA + +;WD5 HORIZ LIMIT LABELLING + ;4.9 =1 ADD OF ROUTINE WHICH RETURNS MIN, MAX IN A, B + ;4.8 =1 NORMAL LABELING + ;WHOLE WD=0 NO LABELLING +;WD6 VERTL LIMIT LABELLING + +;WD7 HORZ AXIS LABEL (PNTR TO ASCIZ) OR 0 IF NONE +;WD10 VERT AXIS LABEL + +;WD11 HORIZ TRANSF FUNCTN (DATA IN AND OUT IN A), 0 IF NONE +;WD12 VERTL TRANSF FUCNTN + +GPHMK: SKIPGE 3(T) + SKIPL 4(T) + JRST 13(T) ;ONE AXIS NULL + MOVEM Z,GPHAC+Z + MOVEI Z,GPHAC + BLT Z,GPHAC+Z-1 ;SAVE ALL ACS + + MOVEI W,0 + PUSHJ P,DSPSIZ ;SIZE 0 FOR AXIS + + SKIPGE A,1(T) ;COMPUTE XMAX + PUSHJ P,(A) + MOVE Y,1(T) + TLNE Y,200000 + ADD A,(T) ;RELATIVE TO X-ORG + ANDI A,1777 ;LIMIT IT + HRRZM A,GPHMX ;X COORD OF + END X AXIS + + SKIPGE A,2(T) ;COMPUTE YMAX + PUSHJ P,(A) + MOVE Y,2(T) + TLNN Y,200000 + JRST GPH1 + HLRZ Z,(T) + ADD A,Z ;RELATIVE TO Y-ORG +GPH1: ANDI A,1777 ;LIMIT IT + HRRZM A,GPHMY ;Y COORD OF + END OF Y-AXIS + + MOVE Y,(T) + LDB A,[1300,,Y] ;EXTRACT PURE X ORG + TRNE A,2000 + ORCMI A,1777 ;EXTEND SIGN + TRNE Y,400000 + ADD A,GPHMX ;ORG WAS RELATIVE TO X-MAX + ANDI A,1777 ;LIMIT IT + MOVEM A,GPHXO ;X COORD OF ORIG + + LDB A,[221300,,Y] ;EXTRACT PURE Y ORG + TRNE A,2000 + ORCMI A,1777 ;EXTEND SIGN + TLNE Y,400000 + ADD A,GPHMY ;ORG WAS RELATIVE TO Y-MAX + ANDI A,1777 ;LIMIT IT + MOVEM A,GPHYO ;Y COORD OF ORIG + +.I DSPPNI<,GPHMX,GPHYO> ;TIP OF X-AXIS +.I DSPVCA<,GPHXO,GPHYO> ;TO ORIGIN +.I DSPVCA<,GPHXO,GPHMY> ;TO TIP OF Y-AXIS + + MOVEI W,20 + PUSHJ P,DSPSIZ ;SIZE 1 CHRS FOR LABELS + + HLLZ V,5(T) ;MASK OUT ROUTINE ADR TO GET 0 IF NO LABELLING + MOVE W,1(T) + CLEARM GPHHBF ;HORZ DATA BACKWARDS FLAG + JUMPL V,GPH3 ;TRANSFER TO FUNCT ARG + TLNE W,100000 + JRST GPH3B ;DATA IMMEDIATE + PUSHJ P,GPHDDS ;DATA DIRECT FIND MAX AND MIN RET IN B,A +GPH3A: TLNN W,4000 + MOVEI A,0 ;SET ORG VAL TO 0 + MOVEM A,GXDMIN ;DATA VALUE OF ORG + MOVEM B,GXDMAX ;DATA VALUE OF FULL Y DEFLECTION + + MOVE A,GPHMX + MOVE B,GPHXO + JUMPE V,GPH2A ;NO HORZ LIMIT LABELS + +.I DSPPNZ<,GPHXO+GPHCHS,GPHYO-21.> ;POSITION FOR LOW HORZ LABEL + PUSHJ P,MODCHR + LDB D,[360300,,1(T)] ;DATA TYPE +.I DPTS2 +.I GXLLR=DFPXCR ;X COORD OF HIGH END OF LABEL + LDB D,[360300,,1(T)] ;DATA TYPE +.I DPTDS1 ;HIGH HORIZ LABEL - RIGHT ADJ + SKIPA A,DFPXCR +GPH2A: MOVEM B,GXLLR + MOVEM A,GXULL ;LEFT COORD OF LABEL + + MOVE A,GPHYO ;WHAT ? B ? + MOVE A,GPHXO ;SET COORD IN CASE NO Y LBL + + HLLZ V,6(T) ;MASK OUT ROUTINE ADDRESS TO GET 0 IF NO LABELLING + MOVE W,2(T) + CLEARM GPHVBF ;VERT DATA BACKWARDS FLAG + JUMPL V,GPH5 ;TRANSFER TO FUNCT ARG + TLNE W,100000 + JRST GPH5B ;DATA IMMEDIATE + AOS T ;SWITCH TO Y + PUSHJ P,GPHDDS + SOS T ;RESTORE T +GPH5A: TLNN W,4000 + MOVEI A,0 ;SET ORG VALUE TO 0 + MOVEM A,GYDMIN + MOVEM B,GYDMAX + + MOVE A,GPHXO + JUMPE V,GPH4A + LDB D,[360300,,2(T)] ;DATA TYPE +.I DPTDS1 +.I ,,,GPHXLO=DFPXCR + LDB D,[360300,,2(T)] ;DATA TYPE +.I DPTDS1 + MOVE A,DFPXCR + CAMGE A,GPHXLO ;SELECT MAX EXCURSION IN -Y DIR +GPH4A: MOVEM A,GPHXLO ;Y ORG OF AXIS LABEL IF WONT FIT BETWEEN LIMIT LABELS + + SKIPN A,7(T) + JRST GPH6 ;NO HORIZ LABEL + PUSHJ P,GHPCHC ;COUNT CHRS IN LABEL +.I ,,GXULL-GXLLR-B ;B HAS REQUIRED SPACE + JUMPGE C,GPH4C ;WILL FIT ? + MOVE C,GPHMX ;TRY TO CENTER BETWEEN ENDS OF AXIS AND DOWN + SUB C,GPHXO + SUBM C,B +GPH4D: ASH B,-1 + SKIPGE B + MOVEI B,0 + ADD B,GPHXO + ADDI B,6*2*2 + MOVE C,GPHYO + SUBI C,30. + HRRZ A,7(T) + PUSHJ P,DSPMSG ;OUTPUT X-LABEL VIA MESSAGE ROUTINE + +GPH6: SKIPN A,10(T) + JRST GPHP ;NO VERT LABEL + PUSHJ P,GHPCHC +.I ,,GPHMY-GPHYO-B + SKIPL C + SKIPA B,GPHXO ;IT FITS + MOVE B,GPHXLO + ASH C,-1 + SKIPGE C + MOVEI C,0 + ADD C,GPHYO + SUB B,GPHCHS + ADDI C,30. + PUSHJ P,DSPPNZ + PUSHJ P,MODCHR +.I DTYOA<36> ;GO OUT +.I DTYOA<76> ;CHANGE TO VERTICAL CHARACTERS +.I DTYOA<35> ;GO IN + HRRZ A,10(T) + PUSHJ P,DSPTXT ;OUTPUT Y LABEL VIA TEXT ROUTINE +.I DTYOA<36> ;GO OUT +.I DTYOA<74> ;CHANGE BACK TO HORIZONTAL CHARACTERS +.I DTYOA<35> ;GO IN + +GPHP: SETOM VECONN ;FIRST PNT FLAG + LDB F,[360300,,1(T)] ;DATA TYPE +.I GXDMIN=GPHFPC ;CONVERT DATA MIN TO FLOATING IF NECC +.F GPHFPC-GXDMIN + MOVE W,1(T) + TLNN W,100000 + JRST GPHPA ;DATA DIRECT + CLEARM GXDMIN + HLRO A,3(T) ;GET COUNT FROM AOBJN + MOVMS A + SOS A ;N-1 PIECES + FLOAT A +GPHPA: MOVE C,GPHMX + SUB C,GPHXO + FLOAT C + FDVR C,A + MOVEM C,GPHHI ;HORIZ INCR PER DATA UNIT + + LDB F,[360300,,2(T)] ;DATA TYPE +.I GYDMIN=GPHFPC ;CONVERT DATA TO FLOATING IF NECC +.F GPHFPC-GYDMIN + MOVE W,2(T) + TLNN W,100000 + JRST GPHPB ;DATA DIRECT + CLEARM GYDMIN + HLRO A,4(T) ;GET COUNT FROM AOBJN + MOVMS A + SOS A ;N-1 PIECES + FLOAT A +GPHPB: MOVE C,GPHMY + SUB C,GPHYO + FLOAT C + FDVR C,A + MOVEM C,GPHVI ;VERTICAL INCR PER DATA UNIT + + MOVE Y,3(T) ;HORZ AOBJN PTR + MOVE Z,4(T) ;VERT AOBJN PTR + HLRO A,Y ;X-COUNT + HLRO B,Z ;Y-COUNT + CAML A,B + MOVE A,B ;A GETS - # PTS TO BE PLOTTED + MOVNS A + SKIPL GPHHBF + JRST GPHPC + ADDI Y,-1(A) ;MUST REF HORZ DATA BACKWARDS + HRL Y,A ;STORE + COUNT +GPHPC: SKIPL GPHVBF + JRST GPHPD + ADDI Z,-1(A) + HRL Z,A +GPHPD: + +GPHPL: MOVE W,1(T) + TLNE W,100000 + JRST GPHP1 ;IMMED DATA + MOVE A,(Y) ;DIRECT DATA + SKIPE 11(T) + PUSHJ P,@11(T) ;CONVERT DATA IF NECC (X-TRANSF) +GPHP2B: LDB F,[360300,,1(T)] ;DATA TYPE +.F (GPHFPC<>-GXDMIN)*GPHHI + FIX A + ADD B,GPHXO + PUSH P,B ;SAVE X COORD + + MOVE W,2(T) + TLNE W,100000 + JRST GPHP4 ;IMMED DATA + MOVE A,(Z) ;DIRECT DATA + SKIPE 12(T) + PUSHJ P,@12(T) ;CONVERT DATA IF NECC (Y-TRANSF) + LDB F,[360300,,2(T)] ;DATA TYPE +GPHP4B: +.F (GPHFPC<>-GYDMIN)*GPHVI + FIX A + ADD B,GPHYO + MOVE C,B + POP P,B ;SAVED X COORD + + MOVE W,(T) + TLNE W,200000 + JRST GPHPL1 ;USE LINES + PUSHJ P,DSPPNI +GPHPL3: SKIPGE GPHHBF + JRST GPHPL5 + AOBJP Y,GPHPE + +GPHPL4: SKIPGE GPHVBF + JRST GPHPL6 + AOBJN Z,GPHPL + +GPHPE: MOVSI Z,GPHAC + BLT Z,Z ;RESTORE ACS - TIME TO GO HOME! + JRST 13(T) + +GPHPL5: SUB Y,[1,,1] + JUMPGE Y,GPHPL4 + JRST GPHPE + +GPHPL6: SUB Z,[1,,1] + JUMPGE Z,GPHPL + JRST GPHPE + +GPH4C: MOVE B,C + JRST GPH4D + + +GPHP1: HRRZ A,Y + JRST GPHP2B + +GPHP4: HRRZ A,Z + JRST GPHP4B + +GPHPL1: PUSHJ P,DSPVVP + JRST GPHPL3 + + +GPHFPC: CAIN F,2 + POPJ P, ;ALREADY FLOATING + CAIE F,3 + TLCA A,232000 + TLC A,<233-1-18.>*1000 + FAD A,A + POPJ P, + +GPH3: PUSHJ P,@5(T) ;GO TO X-LABELLING ROUTINE MIN,MAX IN A,B + CAMG A,B + JRST GPH3A + SETOM GPHHBF ;SET BACKWARD HORIZONTAL + EXCH A,B + JRST GPH3A + +GPH3B: HRRZ A,3(T) ;IMMEDIATE DATA FINDER + HLRE B,3(T) + MOVNS B + ADD B,A + JRST GPH3A + +GPH5: PUSHJ P,@6(T) ;GO TO Y-LABELLING ROUTINE MIN,MAX A,B + CAMG A,B + JRST GPH5A + SETOM GPHVBF ;SET BACKWARD VERTICAL + EXCH A,B + JRST GPH5A + +GPHDDS: MOVSI B,(SETZ) + HRLOI D,377777 + MOVE C,3(T) ;PICK UP AOBJN PTR +GPHDD1: MOVE A,(C) ;FIND MAX AND MIN IN DATA + SKIPE 11(T) + PUSHJ P,@11(T) ;CALL DATA CONVERT ROUTINE IF ANY + CAMLE D,A + MOVE D,A + CAMGE B,A + MOVE B,A + AOBJN C,GPHDD1 + MOVE A,D + POPJ P, + +GPH5B: HRRZ A,4(T) + HLRE B,4(T) + MOVNS B + ADD B,A + JRST GPH5A + +GHPCHC: MOVEI B,4 ;MUST HAVE AT LEAST 4 CHRS EXTRA ROOM + HRLI A,440700 +GHPCH1: ILDB C,A + JUMPE C,GHPCH2 + AOJA B,GHPCH1 ;COUNT CHARACTERS IN LABEL +GHPCH2: IMULI B,6*2 ;SIZE OF CHR + POPJ P, + +GXDMIN: 0 ;MIN DATA IN X DIR +GXDMAX: 0 ;MAX +GYDMIN: 0 ;MIN DATA IN Y DIR +GYDMAX: 0 ;MAX +GPHXO: 0 ;X COORD OF ORG +GPHYO: 0 ;Y COORD OF ORG +GPHMX: 0 ;X COORD OF + END X AXIS +GPHMY: 0 ;Y COORD OF + END Y AXIS +;GPHT1: 0 ;TEMP +GPHCHS: 7*2 ;CHR SIZ +GPHXLO: 0 ;LOWEST X-COORD USED BY Y LIMIT LABELS +GXLLR: 0 ;FARTHEST EXCURSION IN +X DIR BY LOWER X LABEL +GXULL: 0 ;FARTHEST EXCURSION IN -X DIR BX UPPER X LABEL +GPHAC: BLOCK Z+1 ;SAVE AREA FOR ACS +;GPHFPF: 0 ;-1 ON FIRST PNT +GPHHI: 0 ;HORZ INCR PER DATA UNIT +GPHVI: 0 ;VERT INCR PER DATA UNIT +GPHHBF: 0 ;HORZ BACKWARD FLAG +GPHVBF: 0 ;VERT + +] +   VALUE TO 0 + MOVEM A,GYDMIN + MOVEM B,GYDMAX + + MOVE A,GPHXO + JUMPE V,GPH4A + LDB D,[360300,,2(T)] ;DATA TYPE +.I DPTDS1 +.I ,,,GPHXLO=DFPXCR + LDB D,[360300,,2(T)] ;DATA TYPE +.I DPTDS1 + MOVE A,DFPXCR + CAMGE A,GPHXLO ;SELECT MAX EXCURSION IN -Y DIR +GPH4A: MOVEM A,GPHXLO ;Y ORG OF AXIS LABEL IF WONT FIT BETWEEN LIMIT LABELS + + SKIPN A,7(T) + JRST GPH6 ;NO HORIZ LABEL + PUSHJ P,GHPCHC ;COUNT CHRS IN LABEL +.I ,,GXULL-GXLLR-B ;B HAS REQUIRED SPACE + JUMPGE C,GPH4C ;WILL FIT ? + MOVE C,GPHMX ;TRY TO CENTER BETWEEN ENDS OF AXIS AND DOWN + SUB C,GPHXO + SUBM C,B +GPH4D: ASH B,-1 + SKIPGE B + MOVEI B,0 + ADD B,GPHXO + ADDI B,6*2*2 + MOVE C,GPHYO + SUBI C,30. + HRRZ A,7(T) + PUSHJ P,DSPMSG ;OUTPUT X-LABEL VIA MESSAGE ROUTINE + +GPH6: SKIPN A,10(T) + JRST GPHP ;NO VERT LABEL + PUSHJ P,GHPCHC +.I ,,GPHMY-GPHYO-B + SKIPL C + SKIPA B,GPHXO ;IT FITS + MOVE B,GPHXLO + ASH C,-1 + SKIPGE C + MOVEI C,0 + ADD C,GPHYO + SUB B,GPHCHS + ADDI C,30. + PUSHJ P,DSPPNZ + PUSHJ P,MODCHR +.I DTYOA<36> ;GO OUT +.I DTYOA<76> ;CHANGE TO VERTICAL CHARACTERS +.I DTYOA<35> ;GO IN + HRRZ A,10(T) + PUSHJ P,DSPTXT ;OUTPUT Y LABEL VIA TEXT ROUTINE +.I DTYOA<36> ;GO OUT +.I DTYOA<74> ;CHANGE BACK TO HORIZONTAL CHARACTERS +.I DTYOA<35> ;GO IN + +GPHP: SETOM VECONN ;FIRST PNT FLAG + LDB F,[360300,,1(T)] ;DATA TYPE +.I GXDMIN=GPHFPC ;CONVERT DATA MIN TO FLOATING IF NECC +.F GPHFPC-GXDMIN + MOVE W,1(T) + TLNN W,100000 + JRST GPHPA ;DATA DIRECT + CLEARM GXDMIN + HLRO A,3(T) ;GET COUNT FROM AOBJN + MOVMS A + SOS A ;N-1 PIECES + FLOAT A +GPHPA: MOVE C,GPHMX + SUB C,GPHXO + FLOAT C + FDVR C,A + MOVEM C,GPHHI ;HORIZ INCR PER DATA UNIT + + LDB F,[360300,,2(T)] ;DATA TYPE +.I GYDMIN=GPHFPC ;CONVERT DATA TO FLOATING IF NECC +.F GPHFPC-GYDMIN + MOVE W,2(T) + TLNN W,100000 + JRST GPHPB ;DATA DIRECT + CLEARM GYDMIN + HLRO A,4(T) ;GET COUNT FROM AOBJN + MOVMS A + SOS A ;N-1 PIECES + FLOAT A +GPHPB: MOVE C,GPHMY + SUB C,GPHYO + FLOAT C + FDVR C,A + MOVEM C,GPHVI ;VERTICAL INCR PER DATA UNIT + + MOVE Y,3(T) ;HORZ AOBJN PTR + MOVE Z,4(T) ;VERT AOBJN PTR + HLRO A,Y ;X-COUNT + HLRO B,Z ;Y-COUNT + CAML A,B + MOVE A,B ;A GETS - # PTS TO BE PLOTTED + MOVNS A + SKIPL GPHHBF + JRST GPHPC + ADDI Y,-1(A) ;MUST REF HORZ DATA BACKWARDS + HRL Y,A ;STORE + COUNT +GPHPC: SKIPL GPHVBF + JRST GPHPD + ADDI Z,-1(A) + HRL Z,A +GPHPD: + +GPHPL: MOVE W,1(T) + TLNE W,100000 + JRST GPHP1 ;IMMED DATA + MOVE A,(Y) ;DIRECT DATA + SKIPE 11(T) + PUSHJ P,@11(T) ;CONVERT DATA IF NECC (X-TRANSF) +GPHP2B: LDB F,[360300,,1(T)] ;DATA TYPE +.F (GPHFPC<>-GXDMIN)*GPHHI + FIX A + ADD B,GPHXO + PUSH P,B ;SAVE X COORD + + MOVE W,2(T) + TLNE W,100000 + JRST GPHP4 ;IMMED DATA + MOVE A,(Z) ;DIRECT DATA + SKIPE 12(T) + PUSHJ P,@12(T) ;CONVERT DATA IF NECC (Y-TRANSF) + LDB F,[360300,,2(T)] ;DATA TYPE +GPHP4B: +.F (GPHFPC<>-GYDMIN)*GPHVI + FIX A + ADD B,GPHYO + MOVE C,B + POP P,B ;SAVED X COORD + + MOVE W,(T) + TLNE W,200000 + JRST GPHPL1 ;USE LINES + PUSHJ P,DSPPNI +GPHPL3: SKIPGE GPHHBF + JRST GPHPL5 + AOBJP Y,GPHPE + +GPHPL4: SKIPGE GPHVBF + JRST GPHPL6 + AOBJN Z,GPHPL + +GPHPE: MOVSI Z,GPHAC + BLT Z,Z ;RESTORE ACS - TIME TO GO HOME! + JRST 13(T) + +GPHPL5: SUB Y,[1,,1] + JUMPGE Y,GPHPL4 + JRST GPHPE + +GPHPL6: SUB Z,[1,,1] + JUMPGE Z,GPHPL + JRST GPHPE + +GPH4C: MOVE B,C + JRST GPH4D + + +GPHP1: HRRZ A,Y + JRST GPHP2B + +GPHP4: HRRZ A,Z + JRST GPHP4B + +GPHPL1: PUSHJ P,DSPVVP + JRST GPHPL3 + + +GPHFPC: CAIN F,2 + POPJ P, ;ALREADY FLOATING + CAIE F,3 + TLCA A,232000 + TLC A,<233-1-18.>*1000 + FAD A,A + POPJ P, + +GPH3: PUSHJ P,@5(T) ;GO TO X-LABELLING ROUTINE MIN,MAX IN A,B + CAMG A,B + JRST GPH3A + SETOM GPHHBF ;SET BACKWARD HORIZONTAL + EXCH A,B + JRST GPH3A + +GPH3B: HRRZ A,3(T) ;IMMEDIATE DATA FINDER + HLRE B,3(T) + MOVNS B + ADD B,A + JRST GPH3A + +GPH5: PUSHJ P,@6(T) ;GO TO Y-LABELLING ROUTINE MIN,MAX A,B + CAMG A,B + JRST GPH5A + SETOM GPHVBF ;SET BACKWARD VERTICAL + EXCH A,B + JRST GPH5A + +GPHDDS: MOVSI B,(SETZ) + HRLOI D,377777 + MOVE C,3(T) ;PICK UP AOBJN PTR +GPHDD1: MOVE A,(C) ;FIND MAX AND MIN IN DATA + SKIPE 11(T) + PUSHJ P,@11(T) ;CALL DATA CONVERT ROUTINE IF ANY + C \ No newline at end of file diff --git a/src/bkph/supprt.261 b/src/bkph/supprt.261 new file mode 100755 index 00000000..288b5b37 --- /dev/null +++ b/src/bkph/supprt.261 @@ -0,0 +1,2460 @@ +;HANDLE UNASSIGNED FLAGS BY TURNING THEM OFF + +IRPS V,,[ FLEFLG ARRALL MARARR DISALL LIBRAR MATROT + OUTALL INPALL STMPIT TVCROT COMMND CNTRLX CNTRLA + STEREO MOVFLG GPHFLG SRTFLG] +IFNDEF V,[V==0] +TERMIN + +IRPS V,,[ UUOFLG INTFLG] +IFNDEF V,[V==1] +TERMIN + +; FLEFLG ;FILE NAME INPUT +; ARRALL ;ARRAY ALLOCATOR +; MARARR ;MARGIN GENERATOR +; DISALL ;DISPLAY ROUTINES +; LIBRAR ;LIBRARY ROUTINES +; MATROT ;MATRIX AND VECTOR ROUTINES +; OUTALL ;FIXED AND FLOATING OUTPUT +; INPALL ;FIXED AND FLOATING INPUT +; STMPIT ;NAME AND DATE STAMPING +; TVCROT ;TVC ROUTINES +; COMMND ;COMMAND INTERPRETOR +; CNTRLX ;FOR CONTROL CHARACTER HANDLING +; CNTRLA ;FOR CNTRLA INTERUPT HACK +; STEREO ;FOR STEREOSCOPIC PROJECTION +; MOVFLG ;FOR MOVIE MOTOR OUTPUT +; GPHFLG ;GRAPH GENERATOR +; UNDIST ;UNDISTORTING ROUTINES +; FOCUSL ;FOCUS ROUTINES AND FFT +; SRTFLG ;RADIX EXCHANGE SORT +; UUOFLG ;UUOS FOR PRINTING OUT STUFF +; INTFLG ;INTERUPT HANDLING + +IFN GPHFLG+STEREO,[DISALL==1] +IFN DISALL+MARARR,[ARRALL==1] + +IFN COMMND,[ INPALL==1 + OUTALL==1] + +IFN CNTRLX,[ INTFLG==1] +IFN COMMND+OUTALL,[UUOFLG==1] + +;MACROS + +DEFINE FIX AX,AY + MULI AX,400 + TSC AX,AX + ASH AX+1,AY-243(AX) +TERMIN + +DEFINE FLOAT AX,AY + TLC AX,232000+1000*AY + FADR AX,AX +TERMIN + +;OUTPUT TO CURRENTLY SELECTED OUTPUT DEVICES +DEFINE PRINT ARG + TYPE [SIXBIT \ARG!!\] +TERMIN + +;OUTPUT TO TTY ONLY +DEFINE STRIKE ARG + TYP3 [SIXBIT \ARG!!\] +TERMIN + +;OUTPUT AND THEN QUIT +DEFINE STOP ARG + FATAL [SIXBIT \_ARG!!\] +TERMIN + +DEFINE CONC A,B + A!B!TERMIN + ;PUSH AC'S ON PDL +DEFINE SAVE AC +REPEAT AC-A+1,PUSH P,A+.RPCNT +TERMIN + + +DEFINE GET LIST/ + TYP3 [SIXBIT \_!\] +IRP XA,,[LIST] + TYP3 [SIXBIT \XA!=!\] + PUSHJ P,RDNUM + MOVEM A,XA +TERMIN +TERMIN + +;SKIP IF ANSWER TO QUERY IS YES +DEFINE QUERY XA/ + TYP3 [SIXBIT \ XA! ? !\] + PUSHJ P,SKPYES +TERMIN + +;CLEAR ARRAY XA OF LENGTH (L) +DEFINE WIPE XA,L + SETZM XA + MOVE A,[XA,,XA+1] + MOVE B,L + BLT A,XA-1(B) +TERMIN + +;COPY ARRAY XB TO XA OF LENGTH (L) +DEFINE COPY XA,XB,L + MOVE A,[XB,,XA] + MOVE B,L + BLT A,XA-1(B) +TERMIN + +;INCREMENT AC, IF < (LM) GO TO AD +DEFINE LOOP AC,LM,AD + AOS AC + CAMGE AC,LM + JRST AD +TERMIN + +;GO TO XL,XE,XG IF A IS < ,=,> ZERO +DEFINE IF XL,XE,XG + JUMPL A,XL + JUMPE A,XE + JRST XG +TERMIN + + ;THIS PAGE IS NOT WITHIN THE SCOPE OF ANY IFN. + + +IFNDEF PDLL,[PDLL==200] + +PDL: BLOCK PDLL + + +ZR=0 ;FLAG AC + +A=1 +B=2 +C=3 +D=4 +E=5 +F=6 +G=7 + +T=10 +U=11 +V=12 +W=13 +X=14 +Y=15 +Z=16 + +P=17 ;PUSH DOWN POINTER + +FSP: FS ;MUST BE LAST PLACE PLUS ONE IN PROG +CORTOP: CORSIZ*2000 ;MUST BE SIZE NEEDED IN 2000 BLOCKS +CRSZ: CORSIZ ;NUMBER OF PAGES PROGRAM HAS +CRLM: CORSIZ ;BLOCKS ACTUALLY RETAINED + +; SEE IF HAVE TO INSERT OTHER SUPPRT ROUTINES TOO + +IFN ARRALL+MOVFLG,[ + +.INSRT ROUT > + +] + + IFN LIBRAR,[ + +;'LIBRARY ROUTINES' - MAY BE REENTRANT BY NOW AND 'SAFE' (I.E. NO ARITH OVERFL FOR VALID DATA) + +COSD: FADR A,[90.0] +SIND: FDV A,[57.295779] ;180.0/PI + JRST .+2 ;SKIPA +COS: FADR A,[1.57079632] ;PI/2 +SIN: PUSH P,B + PUSH P,C + MOVE C,A ;SAVE A + MOVMS A + CAMG A,[0.019] + JRST SNSN3 ;SMALL ENOUGH, SO SIN(X)=X + CAML A,[1.0^8 ] + STOP _ARGUMENT TOO LARGE-COS-SIN + FDV A,[1.57079632] ;PI/2 + CAMG A,[1.0] + JRST SNSN2 ;SMALL ENOUGH NOT TO REQUIRE ARGUMENT REDUCTION + MULI A,400 ;FIX IT + LSH B,-202(A) + MOVEI A,200 + ROT B,3 + LSHC A,33 + FAD A,[0] ;FLOAT IT + JUMPE B,SNSN2 + TLCE B,1000 + FSB A,[1.0] ;01,11 + TLCE B,3000 + TLNN B,3000 + MOVNS A ;01,10 +SNSN2: SKIPGE C + MOVNS A + MOVEM A,C + FMPR A,A + MOVE B,[0.00015148419] ;0 + FMP B,A + FAD B,[-0.00467376557] ;-0.004362476 + FMP B,A + FAD B,[0.07968967928] ;0.079487663 + FMP B,A + FAD B,[-0.64596371106] ;-0.645920978 + FMP A,B + FAD A,[1.57079632] ;PI/2 + FMPR A,C +SINX: POP P,C + POP P,B + POPJ P, + +SNSN3: MOVE A,C + JRST SINX + + +;FLOATING POINT SQUARE ROOT FUNCTION + +SQRT: SKIPGE A + STOP _NEGATIVE SQRT + SKIPN A + POPJ P, + PUSH P,B + PUSH P,C + ASHC A,-33 + SUBI A,201 + ROT A,-1 + HRRZ C,A + PUSH P,C ;SQ1 + LSH A,-43 + ASH B,-10 + FSC B,177(A) + MOVE C,B + FMP B,SQRT1(A) + FAD B,SQRT2(A) ;LINEAR APPROXIMATION + MOVE A,C ;THEN TWO ITERATIONS OF NEWTON-RAPHSON + FDV A,B + FAD B,A + FSC B,-1 + MOVE A,C + FDV A,B + FADR A,B + POP P,B ;SQ1 + FSC A,(B) + POP P,C + POP P,B + POPJ P, + +SQRT1: 0.8125 + 0.578125 +SQRT2: 0.302734 + 0.421875 + +ATAN: PUSH P,B + PUSH P,C + MOVM B,A + CAMG B,[0.4^-8 ] + JRST TANDON ;SMALL ENOUGH SO THAT ATAN(X)=X + PUSH P,A + CAML B,[7.0^7 ] + JRST ATANS4 ;LARGE ENOUGH SO ATAN(X)=PI/2 + MOVN C,[1.0] + CAMLE B,[1.0] ;1.0 + FDVM C,B + PUSH P,B + FMPR B,B + MOVE C,[1.44863154] + FADR C,B + MOVE A,[-0.264768620] + FDVM A,C + FADR C,B + FADR C,[3.31633543] + MOVE A,[-7.10676005] + FDVM A,C + FADR C,B + FADR C,[6.76213924] + MOVE A,[3.70925626] + FDVR A,C + FADR A,[0.174655439] + POP P,B + FMPR A,B + JUMPG B,ATANS5 + FADR A,[1.57079632] ;PI/2 + JRST .+2 ;SKIPA +ATANS4: MOVE A,[1.57079632] +ATANS5: POP P,B + SKIPGE B + MOVNS A +TANDON: POP P,C + POP P,B + POPJ P, + +LOG: SKIPG A + STOP _NON-POSITIVE LOG + PUSH P,B + PUSH P,C + PUSH P,D + LDB D,[331100,,A] ;GRAB EXPONENT + SUBI D,201 + TLZ A,777000 + TLO A,201000 + MOVE B,A + FSBR A,[1.41421356] + FADR B,[1.41421356] + FDVB A,B + FMPR B,B + MOVE C,[0.434259751] + FMPR C,B + FADR C,[0.576584342] + FMPR C,B + FADR C,[0.961800762] + FMPR C,B + FADR C,[2.88539007] + FMPR C,A + FADR C,[0.5] + MOVE A,D + FLOAT A + FADR A,C + FMPR A,[0.69314718] ;LOG E OF 2.0 + POP P,D + POP P,C + POP P,B + POPJ P, + +IF1 EXPUNGE EXP + +EXP: PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,E + SETZM B + PUSH P,A + MOVMS A + FMPR A,[0.43429448] + MOVE D,[1.0] + CAMG A,D + JRST RATEX + MULI A,400 + ASHC B,-243(A) + CAILE B,43 + STOP _ARGUMENT TOO LARGE-EXP + CAILE B,7 + JRST EXPR2 +EXPR1: FMPR D,FLOAP1(B) + LDB A,[103300,,C] + SKIPE A + TLO A,177000 + FADR A,A +RATEX: MOVEI B,7 + SETZM C +RATEY: FADR C,COEF2-1(B) + FMPR C,A + SOJN B,RATEY + + FADR C,[1.0] + FMPR C,C + FMPR D,C + MOVE A,[1.0] + POP P,B + SKIPL B + SKIPN A,D + FDVR A,D + POP P,E + POP P,D + POP P,C + POP P,B + POPJ P, + +EXPR2: LDB E,[030300,,B] + ANDI B,7 + MOVE D,FLOAP1(E) + FMPR D,D ;TO THE 8'TH POWER + FMPR D,D + FMPR D,D + JRST EXPR1 + +COEF2: 1.15129278 + 0.662730884 + 0.254393575 + 0.0729517367 + 0.0174211199 + 2.55491796^-3 + 9.3264267^-4 + +FLOAP1: 1.0?1.0^1 ?1.0^2 ?1.0^3 ?1.0^4 ?1.0^5 ?1.0^6 ?1.0^7 + + +INTEG: PUSH P,B ;INTEGER PART + FIX A + FLOAT B + MOVE A,B + POP P,B + POPJ P, + +FRACT: PUSH P,B ;FRACTIONAL PART + PUSH P,A + FIX A + FLOAT B + POP P,A + FSBR A,B + POP P,B + POPJ P, + +MOD: PUSH P,A ;FLOATING MODULUS + FDVR A,B + PUSH P,B + FIX A + FLOAT B + FMPR B,(P) ;SAVED B + MOVE A,-1(P) ;SAVED A + FSBR A,B + POP P,B + SUB P,[1,,1] + POPJ P, + +STARTX: 171622221402 +IMPTX: 3125. +PRIMEL: 377777,,777741 + +RANDOM: PUSH P,B ;UNIFORM 0.0 - 1.0 + MOVE A,STARTX + MUL A,IMPTX + DIV A,PRIMEL + MOVEM B,STARTX + MOVE A,B + LSH A,-8. + FLOAT A,-33 + POP P,B + POPJ P, + +GCD: PUSH P,C ;FIX ARGS IN A,B + CAMGE A,B + EXCH A,B + JRST GCDNP + +GCDLP: MOVE C,B + IDIV A,C + MOVE A,C +GCDNP: JUMPN B,GCDLP + POP P,C + POPJ P, + +EXPLOG: JUMPG A,POSEXP ;A^B + JUMPE A,ZREXP + PUSH P,A + MOVE A,B + PUSHJ P,FRACT + SKIPE A + STOP _NEGATIVE NUMBER TO NON-INTEGER POWER + MOVM A,(P) + PUSHJ P,POSEXP + MOVEM A,(P) + MOVM A,B + FIX A + TRNE B,1 + MOVNS (P) ;ODD POWER + JRST POPAJ + +POSEXP: PUSHJ P,LOG + FMPR A,B + JRST EXP + +ZREXP: SKIPG B + STOP _ZERO TO NON-POSITIVE POWER + POPJ P, + +CLAMP: CAML B,C + MOVE B,C + CAMG B,A + MOVE B,A + MOVE A,B + POPJ P, + +;END OF 'LIBRARY' ROUTINES +] + +;THIS PAGE NOT WITHIN THE SCOPE OF ANY IFN'S + +ABS: MOVMS A + POPJ P, + +MAX: CAMG A,B + MOVE A,B + POPJ P, + +MIN: CAML A,B + MOVE A,B + POPJ P, + +FFIX: PUSH P,B + FIX A + MOVE A,B + POP P,B + POPJ P, + +FFLOAT: FLOAT A + POPJ P, + +HFIX: PUSH P,B + FIX A,18. + MOVE A,B + POP P,B + POPJ P, + +HFLOAT: FLOAT A,-18. + POPJ P, + + IFN MATROT,[ + ;MATRIX AND VECTOR ROUTINES + +MATVCT: ;MULTIPLY MATRIX BY VECTOR +;ANSWER,MATRIX,VECTOR,N,M N-ROWS + CAMN A,C + STOP _INLINE-MATVCT + PUSH P,A + MOVNS E + HRL C,E + PUSH P,C +CLLOSP: MOVE C,(P) + SETZM (A) +RWLOSP: MOVE E,(B) + FMPR E,(C) + FADRM E,(A) + AOS B + AOBJN C,RWLOSP + AOS A + SOJG D,CLLOSP + SUB P,[1,,1] + JRST POPAJ + +VCTSCL: ;MULTIPLY VECTOR OR MATRIX BY SCALAR +;ANSWER,VECTOR,SCALAR,N + PUSH P,A + MOVNS D + HRL B,D +SCLMPT: MOVE D,(B) + FMPR D,C + MOVEM D,(A) + AOS A + AOBJN B,SCLMPT + JRST POPAJ + +VCTADD: ;ADD TWO VECTORS OR MATRICES +;ANSWER,VECTOR1, VECTOR2,N + PUSH P,A + MOVNS D + HRL C,D +VCTAPT: MOVE D,(B) + FADR D,(C) + MOVEM D,(A) + AOS A + AOS B + AOBJN C,VCTAPT + JRST POPAJ + +VCTSUB: ;SUB TWO VECTORS OR MATRICES +;ANSWER,VECTOR1, VECTOR2,N + PUSH P,A + MOVNS D + HRL C,D +VCTSPT: MOVE D,(B) + FSBR D,(C) + MOVEM D,(A) + AOS A + AOS B + AOBJN C,VCTSPT + JRST POPAJ + +VCTCPY: ;COPY A VECTOR OR MATRIX +;NEW,OLD,N + PUSH P,A + ADD C,A + HRL A,B + BLT A,-1(C) + JRST POPAJ + +DOTPRT: ;DOTPRODUCT OF TWO VECTORS, ANSWER IN A +;VECTOR1,VECTOR2,N + MOVNS C + HRL B,C + SETZM C + PUSH P,D +DOTELT: MOVE D,(A) + FMPR D,(B) + FADR C,D + AOS A + AOBJN B,DOTELT + MOVE A,C + POP P,D + POPJ P, + + +SUMVEC: ;SUM FROM B TO C-1 OF ARRAY A + CAMLE B,C + EXCH B,C + ADD A,B + SUB B,C + MOVNS B +VCTTRC: ;SUM OF ALL TERMS IN A VECTOR, ANSWER IN A ;VECTOR,N + JUMPE B,VCTLP1 + MOVNS B + HRL A,B + SETZM B +VCTLPZ: FADR B,(A) + AOBJN A,VCTLPZ +VCTLP1: MOVE A,B + POPJ P, + +TRNSPS: ;TRANSPOSE A MATRIX +;ANSWER,MATRIX,N,M + PUSH P,E + PUSH P,C + PUSH P,A + CAMN A,B + JRST TRANST ;INLINE TRANSPOSE + MOVNS D +CLLMA: HRL B,D + MOVE A,(P) +RWLMA: MOVE E,(B) + MOVEM E,(A) + ADD A,-1(P) + AOBJN B,RWLMA + AOS (P) + SOJG C,CLLMA + +CMTRND: POP P,A + SUB P,[1,,1] + POP P,E + POPJ P, + +TRANST: CAME C,D + STOP _INLINE NONSQUARE-TRNSPS + MOVNS D +CLAMA: HRL B,D + MOVE A,(P) +RWAMA: HRR G,B + CAML A,G + JRST NDRWLP + MOVE E,(A) + EXCH E,(B) + MOVEM E,(A) +NDRWLP: ADD A,-1(P) + AOBJN B,RWAMA + AOS (P) + SOJG C,CLAMA + JRST CMTRND + +MATMUL: ;MATRIX MULTIPLY +;ANSWER,MATRIX1,MATRIX2,N,M,L + CAME A,B + CAMN A,C + STOP _INLINE-MATMUL + PUSH P,A + PUSH P,G + PUSH P,T + + PUSH P,B + PUSH P,C + MOVE G,C + MOVNS E + MOVNS F +IRWIST: MOVE C,G + MOVEM C,(P) + HRL A,F +ARWIST: MOVE C,(P) + MOVE B,-1(P) + SETZM (A) + HRL B,Eî +ADRWM: MOVE T,(B) + FMPR T,(C) + FADRM T,(A) + SUB C,F + AOBJN B,ADRWM + AOS (P) + AOBJN A,ARWIST + MOVEM B,-1(P) + SOJG D,IRWIST + SUB P,[2,,2] + POP P,T + POP P,G + JRST POPAJ + ; VECTOR HANDLING + +CRSPRT: ;CROSS PRODUCT OF TWO 3-TUPLES + PUSH P,E + PUSH P,F + PUSH P,G + + MOVE E,A + MOVE F,B + MOVE G,C + +.F ZR(E)=A(F)*B(G)-B(F)*A(G) +.F A(E)=B(F)*ZR(G)-ZR(F)*B(G) +.F B(E)=ZR(F)*A(G)-A(F)*ZR(G) + + POP P,G + POP P,F + MOVE A,E + POP P,E + POPJ P, + +IFN LIBRAR,[ +UNIFY: PUSH P,A ;UNIFY A VECTOR, NEW,OLD,N + PUSH P,B + PUSH P,C + MOVE A,B + PUSHJ P,DOTPRT + PUSHJ P,SQRT + + MOVE C,[1.0] + FDVR C,A + POP P,D + POP P,B + POP P,A + JRST VCTSCL + +] + +VCELPR: ;ELEMENT BY ELEMENT VECTOR PRODUCT +;ANSWER,VECTOR1,VECTOR2,N + PUSH P,A + PUSH P,E + MOVNS D + HRL C,D +VCARSH: MOVE E,(B) + FMPR E,(C) + MOVEM E,(A) + AOS A + AOS B + AOBJN C,VCARSH + POP P,E + JRST POPAJ + + +AM: BLOCK 9 ;INTERMEDIATE RESULTS TO ALLOW INLINE MAT3IN + +MAT3IN: ;INVERSE OF 3 BY 3 MATRIX +;ANSWER,MATRIX +.F QQA= + MOVE F,B +.F AM(0)=ZR(F+4)*ZR(F+8)-ZR(F+5)*ZR(F+7) +.F AM(3)=ZR(F+5)*ZR(F+6)-ZR(F+3)*ZR(F+8) +.F AM(6)=ZR(F+3)*ZR(F+7)-ZR(F+4)*ZR(F+6) +.F DELT'=ZR(F+0)*AM(0)+ZR(F+1)*AM(3)+ZR(F+2)*AM(6) + SKIPN DELT + STOP _ZERO DETERMINANT-MAT3IN +.F AM(0)=AM(0)/DELT +.F AM(3)=AM(3)/DELT +.F AM(6)=AM(6)/DELT +.F AM(1)=(ZR(F+2)*ZR(F+7)-ZR(F+1)*ZR(F+8))/DELT +.F AM(4)=(ZR(F+0)*ZR(F+8)-ZR(F+2)*ZR(F+6))/DELT +.F AM(7)=(ZR(F+1)*ZR(F+6)-ZR(F+0)*ZR(F+7))/DELT +.F AM(2)=(ZR(F+1)*ZR(F+5)-ZR(F+2)*ZR(F+4))/DELT +.F AM(5)=(ZR(F+2)*ZR(F+3)-ZR(F+0)*ZR(F+5))/DELT +.F AM(8)=(ZR(F+0)*ZR(F+4)-ZR(F+1)*ZR(F+3))/DELT + +.I VCTCPY + POPJ P, + +MATPNT: ;PRINT A MATRIX +;ADDRESS,N,M + PUSH P,A + MOVNS C + PUSH P,D + PRINT _ +PNOTLP: PRINT _ + HRL A,C +PNINLP: MOVE D,(A) + PRINT %4E3 + AOBJN A,PNINLP + SOJG B,PNOTLP + PRINT _ + POP P,D + JRST POPAJ + +QQA: 0 +QQB: 0 +QQC: 0 + +MATINV: ;MATRIX INVERSE - KEEPS OLD AND NEW MATRICES IN SAME PLACE +;ANSWER,MATRIX,N + CAIN C,3 + JRST MAT3IN +.F QQA=,,QQC=-QQB= + CAME A,B + PUSHJ P,COPMAT ;COPY MATRIX ACROSS +.F DELT=1.0 + SETZM E + MOVE F,QQA ;ADDRESS +LOPD1: MOVE G,F + ADD G,E ;DIAGONAL ELEMENT + SKIPN (G) + STOP _ZERO TERM-MATINV + MOVE B,[1.0] + MOVE A,B + FDVR B,(G) ;COM=1.0/A(I,I) + MOVEM A,(G) ;A(I,I)=1.0 + +; FMPRM B,DELT ;UPDATE DETERMINANT - CAUSES OVERFLOWS OFTEN + + MOVE G,F + HRL G,QQC +LOPD2: FMPRM B,(G) ;A(I,J)=A(I,J)*COM + AOBJN G,LOPD2 + + SETZM U + MOVE V,QQA ;ADDRESS +LOPD3: CAMN E,U + JRST NDLP3 + MOVE G,F + MOVE W,V + ADD W,E + MOVN B,(W) ;COP=-A(I,L) + SETZM (W) ;A(I,L)=COP + MOVE W,V + HRL W,QQC +LOPD5: MOVE A,(G) + FMPR A,B + FADRM A,(W) ;A(I,J)=A(I,J)+A(L,J)*COP + AOS G + AOBJN W,LOPD5 + +NDLP3: ADD V,QQB + LOOP U,QQB,LOPD3 + + ADD F,QQB + LOOP E,QQB,LOPD1 + + SKIPN DELT + STOP _ZERO DELT-MATINV +.F QQA,DELT=/DELT + POPJ P, + + COPMAT: HRL B,B ;COPY THE MATRIX ACROSS + HRR B,A + IMUL C,C + ADD A,C + BLT B,-1(A) + POPJ P, + +REVRS: ;REVERSE A MATRIX +;ANSWER,MATRIX,N,M + PUSH P,A + IMUL C,D + CAMN A,B + JRST RASBS + ADD A,C + SOS A + MOVNS C + HRL B,C +REVLOP: MOVE C,(B) + MOVEM C,(A) + SOS A + AOBJN B,REVLOP + JRST POPAJ + +RASBS: ADD A,C ;INLINE REVERSE + SOS A + LSH C,-1 + MOVNS C + HRL B,C +RAVLOP: MOVE C,(B) + EXCH C,(A) + MOVEM C,(B) + SOS A + AOBJN B,RAVLOP + JRST POPAJ + +MARGIN: ;SET UP MARGIN ARRAY +;MARGIN,ARRAY,N,M,AC + PUSH P,A + MOVNS D + HRL B,E + HRL A,D +MRGPLC: MOVEM B,(A) + ADD B,C + AOBJN A,MRGPLC + JRST POPAJ + PEEL: PUSH P,A + PUSH P,V + MOVE V,A ;PEELS LAST COLUMN OFF ARRAY + HRL A,B ;NEWARRAY, OLDARRAY, COLUMN, N, M N-NUMBER OF ROWS + MOVE B,A + MOVNS D + HRL C,D + ADD V,E ;LENGTH OF ROW + SUBI V,2 +PELLP: MOVE A,B + BLT A,(V) + ADD B,E + SOS B ;NEW ROW PLACE + ADD V,E + SOS V + MOVSS B ;LOOK AT LEFT FOR A CHANGE + ADD B,E + MOVE D,-1(B) + MOVEM D,(C) + MOVSS B + AOBJN C,PELLP + POP P,V + JRST POPAJ + +CLOTHE: ;OPPOSITE OF PEEL - ADDS ONE COLUMN +;ANSWER,ARRAY,COLUMN,N,M + CAMN A,B + STOP CLOTHE INLINE + PUSH P,A + MOVNS D + HRL C,D + HRL A,B + HRRZ B,A + SOS B +CLOTLP: ADD B,E + MOVE D,A + BLT D,(B) + MOVE D,(C) + AOS B + MOVEM D,(B) + ADD A,E + AOS A + MOVSS A + ADD A,E + MOVSS A + AOBJN C,CLOTLP + JRST POPAJ + + +ROTVCT: ;ROTATE A VECTOR +;VECTOR,WORK,POINTER OF ITEM TO COME TO ZERO POSITION,N + SKIPN C + POPJ P, ;NOTHING TO DO + PUSH P,A + PUSH P,E + PUSH P,F + HRL E,A + HRR E,B + MOVE F,B + ADD F,C + SOS F + BLT E,(F) + HRR E,A + HRL E,A + ADD E,C + MOVSS E ;VECTOR,,VECTOR+PNT + MOVE F,A + ADD F,D + SUB F,C ;VECTOR+SZE-PNT + BLT E,(F) + HRR E,A + HRL E,B + ADD E,D + SUB E,C ;WORK,,VECTOR+SZE-PNT + MOVE F,A + ADD F,D + SOS F ;VECTOR+SZE-1 + BLT E,(F) + POP P,F + POP P,E + JRST POPAJ + +] + OLD: 0 +BATCON: 0 + +CFL: 0 +DCL: 0 + +IFN TVCROT,[ + +TVCOP: PUSHJ P,TVCCLS +.I BATCON=CFL+4*DCL+340*OLD ;OPEN TVC + MOVEI A,(SIXBIT /TVC/) + MOVE B,BATCON + DPB B,[251700,,A] + TLO A,2 ;BLOCK MODE + .OPEN TVCI,A +TVCOL1: STOP _BAT NOT AVAILABLE-TVCOP + TLO A,1 ;OUTPUT + .OPEN TVCO,A + JRST TVCOL1 + POPJ P, + +TVCCLS: .CLOSE TVCI, ;CLOSE TVC + .CLOSE TVCO, + POPJ P, + +TVCBUF==300 ;SYSTEMS TVC BUFFER SIZE + +QAT: 0 +QBT: 0 +QCT: 0 + +TVCLRG: SKIPN A ;READ ANY BUFFER LENGTH OF TVC DATA + STOP _TVCLRG HAS BUM ADDRESS +.I QAT=,QBT=,QCT= +TVCREC: CAILE C,TVCBUF + MOVEI C,TVCBUF + MOVNS C + HRL B,C + .IOT TVCO,B + HRL A,C + .IOT TVCI,A + MOVE A,QAT + MOVE A,(A) + CAMGE A,[4096.0] + CAMG A,[0.5] + JRST TVCBIT +.I QAT+#TVCBUF,QBT+#TVCBUF,QCT-#TVCBUF + JUMPG C,TVCLRG + POPJ P, + +TVCBIT: STRIKE _TVC BITES-TVCBIT +.F QAT,QBT,QCT + JRST TVCREC + + +VIDOT: PUSH P,A ;FIRST ADR - READ AND INVERT VIDISECTOR + PUSH P,B ;COUNT TO READIN + MOVE C,B + MOVE B,A + PUSHJ P,TVCLRG + POP P,B + POP P,A + + SKIPN A + STOP _VIDOT BITES + MOVE C,[1024.0] + +VIDAL: MOVNS B ;ARRAY,SIZE,PIVOT + HRL A,B + FDVRM C,(A) + AOBJN A,.-1 + POPJ P, + + +SCNTVC: ;XORG,YORG,XWDTH,YWDTH,XN,YN,ARRAY + HRRM G,AOBARR + HRLM F,RESOL + HRRM E,RESOL + IMUL E,F + MOVNS E + HRLM E,AOBARR + HRLZM C,MATR1 + SETZM MATR2 + SETZM MATR3 + HRLZM D,MATR4 + SETZM MATP1 + SETZM MATP2 + HRLZM A,MATC1 + HRLZM B,MATC2 + .VSCAN PTBLE + POPJ P, +] + +PTBLE: 0 ;CONO BITS GO HERE (OLD*340+DCL*4+CFL) +AOBARR: 0 ;AOBJN POINTER TO ARRAY +RESOL: 0 ;XN,,YN +MATR1: 0 +MATR2: 0 +MATC1: 0 ;XORG +MATR3: 0 +MATR4: 0 +MATC2: 0 ;YORG +MATP1: 0 +MATP2: 0 + ;THIS PAGE ISNOT WITHIN THE SCOPE OF ANY IFN'S + +A0==1 ;AC NAMES FOR ALGEBRAIC STATMENTS +A1==2 +A2==3 +A3==4 +A4==5 +A5==6 +A6==7 +A7==10 +A8==11 +A9==12 + +;IO CHANNELS + +TYIC==1 ;TTY IN +TYOC==2 ;TTY OUT +LPTC==3 ;LPT OR TPL OUT +TVCI==4 ;TVC IN +TVCO==5 ;TVC OUT +DSIC==6 ;DISK IN +DSOC==7 ;DISK OUT +IMPC==10;A/D MULTIPLEXOR IN +OMPC==11;D/A MULTIPLEXOR OUT +ERRC==12;ERROR DEVICE +IPLC==13;PLOTTER DEVICE + +;INTERRUPT BITS + +TTYINT==1 ;CHARACTER TYPED +AROVFL==10 ;ARITHMETIC OVERFLOW +SLWINT==10000 ;1/2 SECOND CLOCK +MPVINT==20000 ;MEMORY PROTECTION VIOLATION +PDOINT==200000 ;PDL OVERFLOW + + +;INTERUPT ROUTINES AND UUO HANDLER FOLLOW + +TTOFLG==1 ;TTY OUT ON +LPTFLG==2 ;LPT OR TPL OUT ON +DISFLG==4 ;DISPLAY ON +DISCHR==10 ;DISPLAY IN PRINT MODE +DSIFLG==20 ;DISK IN ON +DSOFLG==40 ;DISK OUT ON + + +POPDJ: POP P,D +POPCJ: POP P,C +POPBJ: POP P,B +POPAJ: POP P,A +POPJP: POPJ P, +CPOPJ==POPJP + +IFN UUOFLG+INTFLG,[ +QUIT: 0 ;JSR'ED TO BY STOP AND CNTRL G + .RESET TYOC, +GOGO: MOVEM P,QUITP + MOVE P,[-PDLL,,PDL-1] + .SUSET [.SMASK,,[PDOINT+TTYINT+AROVFL]] ;FLUSH NON-STANDARD ENABLED INTERUPTS + SKIPG A,QITADR + JRST NOENQT + SETZM QITADR + PUSHJ P,(A) ;CALL HIS CLEAN-UP ROUTINE +NOENQT: SKIPE RSTART ;DOES THERE EXCIST A RESTART ADDRESS + .DISMIS RSTART + MOVE P,QUITP + .VALUE + .DISMIS NTRUPT+1 + +INIT: 0 ;INITIALISE PDL ETC. , TO BE JSR'ED TO AT BEGINNING + MOVE P,[-PDLL,,PDL-1] ;SET PDL UP + MOVE A,[JSR UUOS] + MOVEM A,41 + MOVE A,[JSR NTRUPT] + MOVEM A,42 +IFN DISALL,[ + PUSHJ P,FLSNDS ;INITIALLY SET DSPARY'S TO -1 +] + .CORE @CRSZ + .VALUE ;NO CORE + .SUSET [.SMASK,,[PDOINT+TTYINT+AROVFL]] ;INTERUPTS ENABLED + JFCL 17,.+1 ;CLEAR FLAGS + .SUSET [.SPICL,,[-1]] ;ENABLE INTERUPTS + .OPEN TYOC,TTOOP ;OPEN TTY OUT + .VALUE + .OPEN TYIC,TTIOP ;OPEN TTY IN + .VALUE + MOVEI ZR,TTOFLG+DISFLG ;OUTPUT TO TTY ONLY INITIALLY + JRST @INIT +] + +;IO DEVICE OPENS + +; INPUT: ASCII: UNIT: +; INPUT: ASCII: BLOCK: " +; INPUT: IMAGE: UNIT: $ +; INPUT: IMAGE: BLOCK: & +; OUTPUT: ASCII: UNIT: ! +; OUTPUT: ASCII: BLOCK: # +; OUTPUT: IMAGE: UNIT: % +; OUTPUT: IMAGE: BLOCK: ' + + +TTOOP: SIXBIT / !TTYTTY OUT/ +LPTOP: SIXBIT / !LPTLPT OUT/ +TPLOP: SIXBIT / !TPLTPL OUT/ +TTIOP: SIXBIT / (TTYTTY IN/ + +TYPED: 0 ;SET ON TTY INTERUPT +QUITP: 0 ;PDL POINTER SAVED AFTER QUIT +TTYONL: TTOFLG ;USED TO DISABLE ALL BUT TTY ON GET AND STRIKE +RSTART: 0 ;PLACE TO PUT RESTART ADDRESS +QITADR: 0 ;CALLED ON QUIT +INTADR: 0 ;ROUTINE JUMPED TO FOR STRANGE INTERUPTS + +IFNDEF DISLL,[DISLL==10] + +DISLIS: +REPEAT DISLL-1, .+1 + 0 + +INTACS: 0 ;SAVED ACS IN INTERUPT + +IFN UUOFLG,[ + +FATAL=(1000) +TYP3=(2000) +TYPE=(4000) + +UUOS: 0 ;RETURN ADDRESS AND FLAGS + PUSH P,UUOS + PUSH P,A ;A MUST BE LAST PUSHED FOR STRING + HLRZ A,40 + ANDI A,777000 ;WHICH UUO WAS IT + CAIN A,(TYPE) + JRST TYPEU + CAIN A,(FATAL) + JRST QUITU + CAIN A,(TYP3) + JRST STRK +ILLUUO: POP P,A + POP P,UUOS + .VALUE ;ILLEGAL UUO AND ARG ADDRESS IN 40 + MOVE A,UUOS + MOVEM A,NTRUPT+1 + JSR QUIT + +NDUUO: POP P,A ;RETURN FROM UU0 + POP P,UUOS + JRST 2,@UUOS + + +STRK: HRRZ A,40 ;STRIKE - LIKE PRINT EXCEPT ALWAYS GOES TO TTY + EXCH ZR,TTYONL + PUSHJ P,STRING + EXCH ZR,TTYONL + JRST NDUUO + +TYPEU: TRNN ZR,TTOFLG+LPTFLG+DISCHR+DSOFLG + JRST NDUUO ;NO OUTPUT FLAGS ON + HRRZ A,40 ;PRINT GET ARG ADDRESS + PUSHJ P,STRING + JRST NDUUO + QUITU: MOVE A,UUOS ;COPY RETURN ADDRESS + MOVEM A,NTRUPT+1 + HRRZ A,40 ;STOP + EXCH ZR,TTYONL + PUSHJ P,STRING + EXCH ZR,TTYONL + POP P,A + POP P,UUOS + JSR QUIT +] + +IFN INTFLG,[ + +NTRUPT: 0 ;INTERUPT BITS + 0 ;RETURN ADDRESS + MOVEM A,INTACS ;SAVE A + MOVE A,NTRUPT ;SEE WHAT KIND OF AN INTERUPT + TRNE A,TTYINT ;IF KEY HIT, + JRST TTYHND + TRNE A,AROVFL + JRST ARRFLW + TRNE A,PDOINT + JRST PDLOV + SKIPE INTADR + JRST INTADR@ + PUSH P,OBASE + MOVEI B,10 + MOVEM B,OBASE + PRINT _#1 STRANGE INTERUPT + POP P,OBASE + STOP _ + +PDLOV: MOVE A,INTACS + .VALUE ;PDL OVERFLOW + MOVE P,[-PDLL,,PDL-1] + SKIPE RSTART + .DISMIS RSTART + .VALUE + +ARRFLW: MOVE A,INTACS + .VALUE ;ARITHMETIC OVERFLOW + .DISMIS NTRUPT+1 + +TTYHND: MOVE A,INTACS + .ITYI A, + .DISMIS NTRUPT+1 + CAIN A,15 ;CAR RET + JRST ECHCR + CAIGE A,40 + JRST CNTCHR ;CONTROL CHARACTER + MOVEM A,TYPED ;TAKE NOTE CHARACTER HAS BEEN TYPED + JRST DANT + +DANT: MOVE A,INTACS + .DISMIS NTRUPT+1 +] + +ECHCR: .IOT TYOC,A + MOVEI A,12 ;LINE FEED + .IOT TYOC,A + JRST DANT + CNTCHR: + +IFN CNTRLX,[ + CAIE A,^P + CAIN A,^G + JRST CNTRLG + CAIN A,^A + JRST CATRLA + CAIN A,^U + JRST CNTRLU + CAIN A,^B + PUSHJ P,CNTRLB + CAIN A,^T + PUSHJ P,CNTRLT + CAIN A,^E + PUSHJ P,CLOLPT + CAIN A,^V + TRO ZR,TTOFLG + CAIN A,^W + TRZ ZR,TTOFLG + CAIN A,^F + PUSHJ P,CNTRLF + CAIN A,^Y + PUSHJ P,CNTRLY + CAIN A,^R + PUSHJ P,CNTRLR + CAIN A,^S + PUSHJ P,CNTRLS + CAIN A,^L + PUSHJ P,TOPPGE + CAIN A,^X + .VALUE [ASCIZ /:KILL /] + JRST DANT + +CATRLA: +IFN CNTRLA,[ + SKIPN RSTART + .VALUE ;NO RESTART ADDRESS + MOVE A,INTACS + + PUSH P,TYPED + PUSH P,NTRUPT + PUSH P,NTRUPT+1 + +;ACS +IRPC XA,,ABCDEFGTUVWXYZ + PUSH P,XA +TERMIN + +IFN COMMND,[ +;COMMAND INTERPRETOR +IRP XA,,[BYTACT,RAILW,STRANG,STRANG+1,STRANG+2,STRANG+3,NOCNAY,DOTFUN] + PUSH P,XA +TERMIN +] + +IFN OUTALL,[ +;OUTPUT FORMATTING ROUTINES +IRP XA,,[FRCNPT,SINPT,LNTFLD,NOPNT,LDZRO,CARNUM,LATFLD,SNFLG,EXPCNT,IBASE,OBASE] + PUSH P,XA +TERMIN +] + IFN INPALL,[ +;RDNUM ROUTINES +IRP XA,,[SGNREG,OCTNUM,DECNUM,FLOGBE,FRSPRT] + PUSH P,XA +TERMIN +] + + PUSH P,[123456,,654321] ;SPECIAL MARKER + .DISMIS RSTART + +LMSSUC: STOP _CNTRL U LOST $! + JSR QUIT + +] + .DISMIS NTRUPT+1 + +CNTRLU: +IFN CNTRLA,[ + POP P,A ;ASSUME WE ARE BACK AT COMMAND LEVEL + POP P,A + CAME A,[123456,,654321] + JRST LMSSUC + +IFN INPALL,[ +;RDNUM ROUTINES +IRP XA,,[FRSPRT,FLOGBE,DECNUM,OCTNUM,SGNREG] + POP P,XA +TERMIN +] + +IFN OUTALL,[ +;OUTPUT FORMATTING ROUTINES +IRP XA,,[OBASE,IBASE,EXPCNT,SNFLG,LATFLD,CARNUM,LDZRO,NOPNT,LNTFLD,SINPT,FRCNPT] + POP P,XA +TERMIN +] + +IFN COMMND,[ +;COMMAND INTERPRETOR +IRP XA,,[NOCNAY,DOTFUN,STRANG+3,STRANG+2,STRANG+1,STRANG,RAILW,BYTACT] + POP P,XA +TERMIN +] + +IRPC XA,,ZYXWVUTGFEDCBA + POP P,XA +TERMIN + + POP P,NTRUPT+1 + POP P,NTRUPT + + POP P,TYPED + STRIKE _$! +] + .DISMIS NTRUPT+1 + + +CNTRLS: SKIPA A,[1] +CNTRLR: MOVNI A,1 + .MASTER A, + STRIKE SLAVE + POPJ P, + +CNTRLG: MOVE A,INTACS + .DISMIS [QUIT+1] + CNTRLB: PUSHJ P,OPNLPT + POPJ P, + POPJ P, + +CNTRLT: PUSHJ P,OPNTPL + POPJ P, + POPJ P, + +CNTRLF: TRO ZR,DISFLG + PUSHJ P,OPNDIS + POPJ P, + POPJ P, + +] + JRST DANT + +CNTRLY: TRZ ZR,DISFLG +CLODIS: .DCLOSE + POPJ P, + +OPNDIS: TRNN ZR,DISFLG + POPJ P, + .DSTART DISLIS + JRST NODSP + AOS (P) + POPJ P, + +NODSP: TRZ ZR,DISFLG + STRIKE _ DISPLAY BUSY + POPJ P, + IFN COMMND,[ + +BYTACC: 440700,,STRANG ;USED BY COMMAND INTERPRETOR +STRANG: BLOCK 4 +BYTACT: 0 ;BYTE-POINTER INTO STRANG +RAILW: 0 ;ADDRES GOT FROM DDT +NOCNAY: 0 ;INDICATES IF CNTRL A HAS BEEN PUT IN STRANG +DOTFUN: 0 ;INDICATES IF ANY CHRS TYPED YET + +ACCEP1: STRIKE ? + JRST ACCEP2 + +ACCAPT:ACCEPT: PUSH P,A +ACCEP2: STRIKE _$# + SETZM STRANG + MOVE A,[STRANG,,STRANG+1] + BLT A,STRANG+3 + MOVE A,BYTACC + MOVEM A,BYTACT ;BYTE POINTER TO STRANG + MOVEI A,27 ;_W + IDPB A,BYTACT + MOVEI A,"1 + IDPB A,BYTACT + MOVEI A,"! + IDPB A,BYTACT + SETOM NOCNAY ;NO CNTRL A IN STRANG YET + SETZM DOTFUN ;NO TEXT READ YET +REMAC: .IOT TYIC,A + CAIE A,12 + CAIN A,15 ;SAME AS SPACE + JRST COMMAR + CAIGE A,40 ;IGNORE CONTROL CHARACTERS + JRST REMAC + CAIN A,177 ;RUB-OUT + JRST ACCEP1 + CAIN A,"- + PUSHJ P,CNTUIN + CAIE A,"+ + CAIN A,"( + PUSHJ P,CNTAIN ;PUT IN CNTRL A + CAIN A,") ;IGNORE RIGHT ) + JRST REMAC + CAIN A," + JRST COMMAR ;INTERPRET COMMAND + CAIN A,"= + JRST SETVAX ;SET A VALUE + CAIN A,"# + JRST SPEAKX ;SPEAK A FIXED POINT VALUE + CAIN A,"? + JRST SPEAKF ;SPEAK A FLOATING VALUE + CAIN A,"< + JRST LFCART ;ARGUMENTS TO FUNCTION + SETOM DOTFUN ;AHA, SOME TEXT + IDPB A,BYTACT ;STORE THIS CHARACTER + JRST REMACî + CNTUIN: MOVEI A,1 + IDPB A,BYTACT + MOVEI A,"- + JRST CNTCOM + +CNTAIN: MOVEI A,1 ;CONTROL A + IDPB A,BYTACT + MOVEI A,"+ +CNTCOM: IDPB A,BYTACT + SETZM NOCNAY + POPJ P, + +LFCART:PUSHJ P,GETENT ;GET ADDRESS + SETZM ACPNTR' + POP P,A + PUSHJ P,HTCFCA ;GET ARGUMENTS + PUSHJ P,@RAILW + JFCL + JRST ACCEPT + +HTCFCA: AOS ACPNTR + MOVE A,ACPNTR@ + PUSHJ P,RDNUM ;GET NUMBER + PUSH P,A + MOVE A,TYPIN + CAIE A,"> ;END OF ARGUMENTS ? + PUSHJ P,HTCFCA + POP P,ACPNTR@ + SOS ACPNTR + POPJ P, + +COMMAR: PUSHJ P,GETENT + MOVE A,RAILW + TLZN A,-1 + CAIG A,17 + JRST EXTACC ;TRYING TO EXCECUTE IN ACS OR GARBAGE + POP P,A + PUSHJ P,@RAILW + JFCL + JRST ACCEPT + +EXTACC: STRIKE BARF ? + JRST ACCEP2 + +SETVAX: PUSHJ P,GETENT + PUSHJ P,RDNUM + EXCH A,(P) + POP P,@RAILW + JRST ACCEPT + +SPEAKX: PUSHJ P,GETENT + POP P,A + SKIPE HLFFXF + JRST COMOST + MOVE A,@RAILW +SPUFT: STRIKE #1 + JRST ACCEPT + + SPEAKF: PUSHJ P,GETENT + POP P,A + SKIPE HLFFXF + JRST COMOST +SPAST: MOVE A,@RAILW + MOVMS A + CAMG A,[1.0^-3 ] + JUMPN A,SPAKF + MOVE A,@RAILW + STRIKE %1F4.4 + JRST ACCEPT + +SPAKF: MOVE A,@RAILW + STRIKE %1E8 + JRST ACCEPT + +HLFFXF: 1 ;TO CHECK IF FIXED OR FLOATING IS REASONABLE + +COMOST: MOVE A,RAILW@ + TLNN A,777000 ;WHETHER FIXED OR FLOATING + JRST SPUFT ;PROBABLY FIXED + MOVNS A + TLNE A,777000 + JRST SPAST ;PROBABLY FLOATING + MOVNS A + JRST SPUFT ;PROBABLY FIXED NEGATIVE + +GETENT: SKIPN DOTFUN + POPJ P, ;NO NAME TYPED - USE PREVIOUS VALUE + MOVEI A,1 ;CONTROL A + SKIPE NOCNAY ;DON'T IF WE ALREADY HAVE A CNTRL A IN STRANG + IDPB A,BYTACT + MOVEI A,15 ;RET CAR + IDPB A,BYTACT + MOVEI A,": + IDPB A,BYTACT + MOVEI A,"V + IDPB A,BYTACT + MOVEI A,"P + IDPB A,BYTACT + MOVEI A,40 + IDPB A,BYTACT + SETZM A + .VALUE STRANG + MOVEM A,RAILW + PUSH P,A + MOVE A,DDTWIN + PUSHJ P,TYO + POP P,A + SKIPE A + POPJ P, + + STRIKE MUMBLE ? + SUB P,[1,,1] + JRST ACCEP2 + +DDTWIN: "' ;CHARACTER TYPED TO TELL THAT SYMBOL LOOKED UP +] + IFN OUTALL,[ + +STRING: PUSH P,E + PUSH P,V + PUSH P,W + PUSH P,X + PUSH P,A + HRLI A,440600 ;MAKE A BYTE PT + MOVEM A,SINPT + PUSHJ P,NXCHAR + POP P,A + POP P,X + POP P,W + POP P,V + POP P,E + POPJ P, + +TACIT: ILDB V,SINPT ;EASY FIXED POINT OUTPUT + SETZM LNTFLD ;INDICATE FREE FORMAT + SETZM NOPNT ;INDICATE DECPNT REQ + SETZM LDZRO ;INDICATE NO LEADING ZEROS + MOVE A,-7(P) ;RESTORE A (ASSUME PUSHED) + MOVE A,A-'1(V) ;GET DESIRED VALUE + PUSHJ P,DIGIT ;TYPE IT +NXCHAR: ILDB A,SINPT + CAIN A,'_ ;TYPE AS CR. + MOVNI A,40-15 + CAIN A,'! ;TERMINATION + POPJ P, + CAIN A,'^ ;TYPE NEXT AS CONTROL CHAR. + JRST TYPCNT + CAIN A,'# ;TYPE C(NEXT AC) AS NUMBER + JRST TACIT + CAIN A,'% ;TYPE NEXT IN FIXED FORMAT + JRST FXFRM + CAIN A,'& ;FILL UP + JRST FLLUPT + CAIN A,'$ ;TYPE NEXT UNCONDITIONALLY + ILDB A,SINPT + JRST ACNVRT + + FLLUPT: PUSH P,B + MOVEI B,0 +FLLUP1: ILDB A,SINPT + CAIE A,' ;SPACE + CAIN A,'. + JRST FLLUP2 + SUBI A,'0 + IMULI B,10. + ADD B,A + JRST FLLUP1 + +FLLUP2: PUSHJ P,COLUMN + POP P,B + JRST NXCHAR + +TYPCNT: ILDB A,SINPT ;HANDLE CONTROL CHARCT OUT + SUBI A,100 +ACNVRT: ADDI A,40 ;CONVERT TO ASCII + PUSHJ P,TYPA ;TYPE CHARACTER + JRST NXCHAR + +TYPA: AOS CARNUM + CAIN A,15 ;CAR. RET. + JRST ECHLF +TYO: +IFN DISALL,[ + TRNE ZR,DISCHR ;TYPE OUT SUBROUTINE + JRST DTYOA ;OUTPUT TO DISPLAY ONLY HACKS E,W,X +] + SKIPE MURDER + POPJ P, ;ALL OUTPUT MURDERED + TRNE ZR,TTOFLG + .IOT TYOC,A ;OUTPUT TO TTY + TRNE ZR,LPTFLG + .IOT LPTC,A ;OUTPUT TO LPT + TRNE ZR,DSOFLG + .IOT DSOC,A ;OUTPUT TO DISK ETC + POPJ P, + +MURDER: 0 ;NON-ZERO TO KILL ALL BUT DISPLAY OUTPUT + ECHLF: SETZM CARNUM ;ECHO LINE FEED + PUSHJ P,TYO + MOVEI A,12 + PUSHJ P,TYO + MOVEI A,15 + POPJ P, +FXFRM: SETZM NOPNT ;INDICATE DECPNT REQ + SETZM LDZRO ;INDICATE NO LEADING ZEROS + ILDB V,SINPT + MOVE A,-7(P) ;RESTORE A (ASSUME PUSHED) + MOVE A,A-'1(V) + ILDB V,SINPT + CAIN V,'I ;FIXED POINT + JRST IFORM + CAIN V,'F ;FLOATING F FORM + JRST FFORM + CAIN V,'E ;FLOATING E FORM + JRST EFORM + CAIN V,'A ;ASCII FORMAT + JRST AFORM + STOP _WEIRD FORMAT SPECIFICATION + +IFORM: ILDB V,SINPT + MOVEI V,0-'0(V) + MOVEM V,LNTFLD + PUSHJ P,DIGIT + JRST NXCHAR + +AFORM: MOVE V,A ;GET ADDR OF STRING + HRLI V,440700 + ILDB A,V + JUMPE A,NXCHAR ;QUIT IF ZERO + PUSHJ P,TYPA + JRST .-3 + +FFORM: SETOM NOPNT + ILDB V,SINPT ;FLOATING POINT OUT + MOVEI V,0-'0(V) + MOVEM V,LNTFLD + PUSH P,OBASE ;SET OBASE TO 10. TEMP + MOVEI V,10. + MOVEM V,OBASE + SAVE B + ILDB V,SINPT ;IGNORE COMMA + ILDB V,SINPT + MOVEI V,0-'0(V) + MOVEM V,LATFLD + MOVE B,[0.5] + FMPR B,[0.1] ;GENERATE ROUNDING QUANTITY + SOJG V,.-1 + SETZM SNFLG + JUMPGE A,POSFL + MOVNS A + SETOM SNFLG + SOS LNTFLD + POSFL: CAML A,[1.0^6] + JRST TOOLRF + FADR A,B ;ADD IN ROUNDING QUANTITY + MOVEM A,-1(P) ;UPDATE SAVED VALUE + FIX A + MOVE A,B + SKIPG LNTFLD + JRST ZSOFLT + PUSHJ P,DIGITS ;OUTPUT INTEGER PART +PSZRFT: PUSH P,A + MOVEI A,". + PUSHJ P,TYPA ;DECIMAL POINT + POP P,A + MOVE V,LATFLD ;RESTORE SECOND FIELD LENGTH + JUMPE V,PNDXDC + MOVEM V,LNTFLD + SETOM LDZRO + FLOAT A + MOVNS A + FADR A,-1(P) +GROWMN: FMPR A,[10.0] + SOJG V,GROWMN + FIX A + MOVE A,B + PUSHJ P,DIGIT +PNDXDC: POP P,B + POP P,A + POP P,OBASE + JRST NXCHAR + +ZSOFLT: PUSH P,A + MOVEI A,"- ;MAY SCREW ALIGNMENT BUT ... + SKIPE SNFLG + PUSHJ P,TYPA + POP P,A + JRST PSZRFT + +TOOLRF: MOVEM A,-1(P) + SKIPE SNFLG; TOO LARGE FOR F FORM + AOS LNTFLD + SETOM LDZRO + SETZM EXPCNT + JRST RDCMRP + + +NOTFRE: SKIPE LDZRO ;LEADING SPACE OR ZERO GENERATOR + SKIPA A,["0] + MOVEI A," ;SPACE + JRST .+2 + PUSHJ P,TYPA + SOJGE C,.-1 + POPJ P, + EFORM: PUSH P,OBASE ;SET OBASE TO 10. TEMP + SAVE B + MOVEI V,10. + MOVEM V,OBASE + SETOM NOPNT + SETOM LDZRO + SETZM EXPCNT + SETZM SNFLG + JUMPGE A,BLBIL + MOVNS A + SETOM SNFLG +BLBIL: ILDB V,SINPT + MOVEI V,0-'0(V) + MOVEM V,LNTFLD ;ROUNDING CLUDGE GOES HERE + JUMPE A,WORRYO + CAMGE A,[1.0] + JRST ZRXPN +RDCMRP: FMPR A,[0.1] + AOS EXPCNT + CAML A,[1.0] + JRST RDCMRP +BANDG: MOVE B,LNTFLD +BANDAG: FMPR A,[10.0] + SOJG B,BANDAG + FIX A +SGNEFR: MOVEI A," ;SPACE + SKIPE SNFLG + MOVEI A,"- + PUSHJ P,TYPA + MOVEI A,". + PUSHJ P,TYPA + MOVE A,B + PUSHJ P,DIGIT ;MANTISSA + MOVEI A,"E + PUSHJ P,TYPA + MOVEI A,"+ + SKIPGE EXPCNT ;EXPONENT + MOVEI A,"- + PUSHJ P,TYPA + MOVM A,EXPCNT + IDIVI A,10. + ADDI A,260 + ADDI B,260 + PUSHJ P,TYPA + MOVE A,B + PUSHJ P,TYPA + POP P,B + POP P,A + POP P,OBASE + JRST NXCHAR + +NEGXPE: FMPR A,[10.0] +ZRXPN: SOS EXPCNT + CAMGE A,[0.1] + JRST NEGXPE + AOS EXPCNT + JRST BANDG + +WORRYO: SETZM B + JRST SGNEFR + DIGIT: SETZM SNFLG +DIGITS: SAVE C + PUSHJ P,DIGDOG + MOVE A,OBASE + CAIE A,10. + JRST DIGEND + SKIPN FRCNPT + SKIPE NOPNT + JRST DIGEND + MOVEI A,". + PUSHJ P,TYPA +DIGEND: JRST POPCJ + +DIGDOG: MOVE C,LNTFLD + JUMPGE A,PSHDIG + SETOM SNFLG + SOS C + MOVNS A ; + +PSHDIG: IDIV A,OBASE ;ASSEMBLE NUMBER IN OUTPUT FORM + CAILE B,9. ;CHECK FOR OBASE > 10. POSSIBILITY + ADDI B,7 ;USE A, B, C, ETC. + ADDI B,260 + HRLM B,(P) ;STORE ONE DIGIT + SOS C + JUMPE A,FOOEAY + PUSHJ P,PSHDIG ;MORE TO COME +POPDIQ: HLRZ A,(P) ;SPEW ONE OF PDL + JRST TYPA + +FOOEAY: SKIPE LNTFLD + PUSHJ P,NOTFRE ;LEADING BLANKS OR ZEROS + SKIPE SNFLG + PUSHJ P,PTMNS ;MINUS SIGN + JRST POPDIQ + +PTMNS: MOVEI A,"- + JRST TYPA + +FRCNPT: 0 ;1 TO FORCE NO DECIMAL POINT +SINPT: 0 +LNTFLD: 0 +NOPNT: 0 +LDZRO: 0 +CARNUM: 0 +LATFLD: 0 +SNFLG: 0 +EXPCNT: 0 + +] + ;THIS PAGE IS NOT WITHIN THE SCOPE OF ANY IFN. + +IBASE: 10. +OBASE: 10. + +TOPPGE: MOVEI A,14 ;CONTROL L + JRST TYO + +;FILL OUT UP TO B CHARACTERS +COLUMN: PUSH P,A + PUSH P,B + MOVEI A," ;SPACE +MORSPC: CAMG B,CARNUM + JRST POPBJ + PUSHJ P,TYPA + JRST MORSPC + +;OPEN LPT (SKIPS UNLESS BUSY) +OPNLPT: .OPEN LPTC,LPTOP ;OPEN LINE PRINTER + JRST LPTBUS +OPNSOK: TRO ZR,LPTFLG + AOS (P) + POPJ P, +LPTBUS: STRIKE _CHANGED TO TPL +OPNTPL: .OPEN LPTC,TPLOP + JRST .+2 ;SKIPA + JRST OPNSOK + STRIKE _SORRY TPL LOSES + POPJ P, + +CLOLPT: .CLOSE LPTC, ;CLOSE LINE PRINTER + TRZ ZR,LPTFLG + POPJ P, +REREAD: MOVE A,TYPIN ;REREAD LAST CHARACTER + POPJ P, + +TYI: AOSN UNRCHF + JRST REREAD + TRNE ZR,DSIFLG + JRST TYIDSK + .IOT TYIC,A + JRST .+2 ;SKIPA +TYIDSK: .IOT DSIC,A ;INPUT FROM DISK ETC. + SKIPN FXLWCS + JRST NOFXLW + CAIL A,140 + SUBI A,40 ;CHANGE LOWER CASE TO UPPER CASE +NOFXLW: MOVEM A,TYPIN + POPJ P, + +UNRCHF: 0 ;-1 TO REREAD LAST CHARACTER +FXLWCS: 0 ;CHANGE LOWER CASE TO UPPER CASE +TYPIN: 0 ;LAST CHARACTER READ IN + IFN INPALL,[ + +RDNUMA: STRIKE ? + SKIPA +RDNUM: PUSH P,A ;SAVE OLD VALUE + SETZM NONEMP' + SETZM SGNREG ;READ A NUMBER ROUTINE + SETZM OCTNUM + SETZM DECNUM + SETZM FLOGBE ;DIGITS PAST DECIMAL POINT +RDLP1: PUSHJ P,TYI + CAIG A,40 ;SPACE OR CONTROL CHARACTERS + JRST RDLP1 + SKIPA +RDLP: PUSHJ P,TYI + CAIE A,15 + CAIN A,12 + JRST GOTNUM ;END OF NUMBER + CAIGE A,40 + JRST RDLP ;IGNORE CONTROL CHAR + CAIN A,"- + JRST MSGN + CAIN A,". + JRST DECPT + CAIN A,"+ + JRST RDLP + CAIN A,"E + JRST GOTANE + CAIN A,177 ;RUBOUT + JRST RDNUMA ;START ALL OVER + + CAIL A,"0 ;IS IT A DIGIT + CAILE A,"9 + JRST .+2 + JRST OKNUMB ;YES + CAIL A,"A ;IS IT A LETTER + CAILE A,"Z + JRST GOTNUM ;NO - SO MUST BE END OF NUMBER +OKNUMB: + SUBI A,"0 + CAIL A,10. + SUBI A,7 ;FOR IBASE>10. WE USE A,B,C ETC + CAIL A,IBASE + JRST GOTNUM ;IF TOO LARGE FOR IBASE + SETOM NONEMP ;INDICATE WE GOT SOME DIGIT + PUSH P,A + EXCH A,OCTNUM ;ACCUMULATE NUMBER IN IBASE + IMUL A,IBASE + ADDM A,OCTNUM + POP P,A + EXCH A,DECNUM ;ACCUMULATE NUMBER IN DECIMAL + IMULI A,10. + ADDM A,DECNUM + SKIPLE FLOGBE + AOS FLOGBE ;UPDATE COUNT + SKIPL FLOGBE + JRST RDLP + MOVEI A,1 + MOVEM A,FLOGBE + JRST RDLP + +MSGN: SETOM SGNREG ;MINUS SIGN ENCOUNTERED + JRST RDLP + DECPT: MOVE A,DECNUM + MOVEM A,OCTNUM + SETOM FLOGBE ;INDICATE POSSIBLE FLOATING + JRST RDLP + +GOTNUM: POP P,A + SKIPN NONEMP + POPJ P, ;NOTHING WORTHWHILE WAS TYPED, SO RETURN OLD VALUE + SKIPLE FLOGBE + JRST FLONGN + MOVE A,OCTNUM +GOTITL: SKIPE SGNREG + MOVNS A + POPJ P, + +FLONGN: MOVE A,[1.0] +FLNMGN: FMPR A,[0.1] + SOSE FLOGBE + JRST FLNMGN + EXCH A,DECNUM + FLOAT A + FMPR A,DECNUM + JRST GOTITL + +GOTANE: SKIPLE FLOGBE + JRST FLOCLL ;WE DID HAVE A . + MOVEI A,10. ;SIMULATE ZERO AFTER . + IMULM A,DECNUM + MOVEI A,1 + MOVEM A,FLOGBE +FLOCLL: PUSHJ P,FLONGN + MOVEM A,FRSPRT ;STORE FIRST COMPONENT + PUSHJ P,RDNUM ;NOW READ EXPONENT AND HOPE TO HELL A SECOND E DOES NOT REAR ITS UGLY HEAD + MOVE A,DECNUM + EXCH A,FRSPRT + SKIPN FRSPRT + POPJ P, + SKIPE SGNREG + JRST SCLDWN +SCLUPE: FMPR A,[10.0] + SOSE FRSPRT + JRST SCLUPE + POPJ P, +SCLDWN: FMPR A,[0.1] + SOSE FRSPRT + JRST SCLDWN + POPJ P, + +SKPYES: PUSH P,A ;AWAIT YES OR NO ANSWER +SKPYS: PUSHJ P,TYI + CAIN A,"Y + JRST GOTY + CAIN A,"N + JRST GOTN + JRST SKPYS + GOTY: STRIKE ES + AOS -1(P) + JRST POPAJ + +GOTN: STRIKE O + JRST POPAJ + +SGNREG: 0 +OCTNUM: 0 +DECNUM: 0 +FLOGBE: 0 +FRSPRT: 0 +] + +HEADIN: 0 +IFN STMPIT,[ + +;GENERATES TIME AND DATE STAMP + +MYNAME: .FNAM1?SIXBIT/ /?.FNAM2?SIXBIT/ / + +STAMP: SAVE D + MOVE C,[440600,,MYNAME] + PUSHJ P,LPDAT + MOVE C,[440600,,MYNAME+2] + PUSHJ P,LPDAT + .RDATE D, + PUSHJ P,SPLASH + .RTIME D, + PUSHJ P,SPLASH + JRST POPDJ + +SPLASH: MOVE C,[440600,,D] + PUSHJ P,CLSPS1 + PUSHJ P,CLSPSP + PUSHJ P,.+1 + MOVEI A," + JRST TYPA + +CLSPSP: PUSHJ P,.+1 + MOVEI A,": + PUSHJ P,TYPA + JRST CLSPS1 + +LPDAT: PUSHJ P,.+1 + PUSHJ P,.+1 +CLSPS1: PUSHJ P,.+1 + ILDB A,C + CAIE A,"? + ADDI A," + JRST TYPA + +BARF: PRINT _ + PUSHJ P,STAMP + SKIPE HEADIN + PUSHJ P,@HEADIN + PRINT _ + POPJ P, + +] + IFN FLEFLG,[ + +NAMEP: PUSH P,A ;OUTPUT CURRENT FILE-NAME + PUSH P,B + MOVE B,[440600,,INOP+1] + ADD B,FRMTSW + PUSHJ P,NAMEL + PUSHJ P,NAMEL + JRST POPBJ + +NAMEL: ILDB A,B + ADDI A,40 + PUSHJ P,TYO + TLNE B,770000 + JRST NAMEL + MOVEI A,40 + JRST TYO + +OPINFL: PUSH P,A + .OPEN ERRC,ERROP + .VALUE +ERRLOP: .IOT ERRC,A + CAIN A,14 + JRST CLORIN + .IOT TYOC,A + JRST ERRLOP + +CLORIN: .CLOSE ERRC, + JRST POPAJ + +ERROP: 0,,(SIXBIT/ERR/) + 1 + 0 + +INOP: 0,,(SIXBIT/DSK/) + 0 + SIXBIT />/ + +FRMSNM: 0 ;SNAME + +ONOP: 0,,(SIXBIT /DSK/) + 0 + SIXBIT />/ + +FRMSOM: 0 ;SNAME + +NMSWT: 0 ;NON-ZERO ON FNAM2 +FRMTSW: 0 ;NON-ZERO FOR OUTPUT + +VPLC: BLOCK 6 + +TTINR: MOVEI C,0 + JRST .+2 +TTINW: MOVEI C,ONOP-INOP + MOVEM C,FRMTSW +TTINT: SETZM NMSWT ;ACCEPT FILE NAME + MOVE D,[10700,,VPLC-1] +AGAST: .IOT TYIC,A + CAIE A,177 + JRST NOOUT + CAMN D,[10700,,VPLC-1] + JRST KILLIT + LDB A,D + CAML D,[350700,,0] + JRST WRDBND + ADD D,[70000,,] ;DECREMENT BYTE-POINTER +AGAST1: .IOT TYOC,A + JRST AGAST + +WRDBND: SUB D,[340000,,1] + JRST AGAST1 + +NOOUT: IDPB A,D + CAIE A,15 + CAIN A,"_ + JRST .+2 + JRST AGAST + .IOT TYOC,[15] + .IOT TYOC,[12] + MOVE D,[10700,,VPLC-1] +AGAIN: MOVEI B,0 +RLOP: ILDB A,D ;GET A CHARACTER + CAIN A," ;SPACE + JRST SPAE + CAIN A,": + JRST COLON + CAIE A,"_ + CAIN A,15 ;CAR RET + JRST RETCR + CAIN A,"; + JRST SMCLN + SUBI A," ;SPACE + TLNE B,770000 + JRST RLOP ;IGNORE PAST 6 CHRS + LSH B,6 + IOR B,A + JRST RLOP + +LFTJST: SKIPE B ;LEFT ADJUST + TLNE B,770000 + POPJ P, + LSH B,6 + JRST LFTJST + +SPAE: PUSHJ P,SPCOUT + JRST AGAIN + +RETCR: +SPCOUT: PUSHJ P,LFTJST + SKIPN B + POPJ P, + SKIPE NMSWT ;FIRST FILE NAME + JRST NAM2 + MOVEM B,INOP+1(C) + SETOM NMSWT + POPJ P, + +NAM2: MOVEM B,INOP+2(C) + POPJ P, + +COLON: PUSHJ P,LFTJST + HLRM B,INOP(C) + JRST AGAIN + +SMCLN: PUSHJ P,LFTJST + MOVEM B,FRMSNM(C) + JRST AGAIN + +KILLIT: MOVEI A,40 + .IOT TYOC,A + MOVEI A,"? + .IOT TYOC,A + JRST TTINT + +OPNDI: SKIPE FRMSNM + .SUSET [.SSNAME,,FRMSNM] + .OPEN DSIC,INOP + JRST OPINFL ;FAILED + TRO ZR,DSIFLG + AOS (P) + POPJ P, + +OPNDO: SKIPE FRMSOM + .SUSET [.SSNAME,,FRMSOM] + .OPEN DSOC,ONOP + JRST OPINFL + TRO ZR,DSOFLG + AOS (P) + POPJ P, + +CLONDI: .CLOSE DSIC, + TRZ ZR,DSIFLG + POPJ P, + +CLONDO: .CLOSE DSOC, + TRZ ZR,DSOFLG + POPJ P, + +DSKONL: DSOFLG+DSIFLG + +] + +IFN SRTFLG,[ + +;NELSON'S RADIX EXCHANGE SORT, SORTS TABLE OF WORDS STARTING AT (A) AND OF LENGTH (B) +;EACH ENTRY CONSISTS OF TWO WORDS, THE FIRST OF WHICH IS SORTED ON +;C CONTAINS THE INITIAL MASK BIT, SORTING IS DONE ON IT AND ALL BITS TO THE RIGHT +;SO TO SORT ON THE RIGHT-HALF OF THE WORD C SHOULD BE 400000 +;AND TO SORT ON THE WHOLE WORD IT WOULD BE 400000,,0 + +SORT: PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,D + ADD B,A ;GET FINAL ADDRESS+1 + PUSHJ P,SORT1 ;GO SORT IT + JRST POPDJ ;RESTORE ACS + +SORT1: HRLM B,(P) ;STUFF *TOP* ON LEFT HALF OF PDL + CAIL A,-2(B) ;SORT FINISHED IF AT CENTER + JRST SORT7 + PUSH P,A ;PUSH *BOTTOM* ON PDL +SORT3: TDNN C,(A) ;LOWER BIT ON? + JRST SORT4 + SUBI B,2 ;FIND BOTTOM ENTRY + TDNE C,(B) ;IS THIS IT? + JRST SORT2 + + MOVE D,(A) ;YES SWAP WORDS SORTED ON + EXCH D,(B) + MOVEM D,(A) + MOVE D,1(A) ;AND NOW SWAP THE SECOND WORDS + EXCH D,1(B) + MOVEM D,1(A) + +SORT4: ADDI A,2 ;FIND TOP ENTRY +SORT2: CAME A,B ;HAVEN'T WE MET SOMEWHERE? + JRST SORT3 + ROT C,-1 ;NEXT LEVEL + POP P,A ;RETORE OLD *BOTTOM*, B IS ALREADY SET UP TO HALF-WAY UP + JUMPL C,SORT6 ;CROCK -ROTATED AROUND, SO DONE + PUSHJ P,SORT1 ;CALL SELF ONCE - BOTTOM HALF + HLRZ B,(P) ;GRAB OLD *TOP* OF LEFT-HALF OF PDL, MAKE NEW *TOP*, A IS ALREADY SET HALF-WAY UP + PUSHJ P,SORT1 ;CALL SELF TWICE - TOP HALF +SORT6: ROT C,1 ;RESTOR FOR NEXT HIGHER LEVEL +SORT7: HLRZ A,(P) ;GRAB OLD *TOP* MAKE NEW *BOTTOM* + POPJ P, + +] + +CONSTANTS +VARIABLES + +Q==PUSHJ P, +R==POPJ P, +M==MOVE +MI==MOVEI +MM==MOVEM +J==JRST +SZ==SETZM +SO==SETOM +SG==SOJGE +AB==AOBJN + +  RST SCLUPE + POPJ P, +SCLDWN: FMPR A,[0.1] + SOSE FRSPRT + JRST SCLDWN + POPJ P, + +SKPYES: PUSH P,A ;AWAIT YES OR NO ANSWER +SKPYS: PUSHJ P,TYI + CAIN A,"Y + JRST GOTY + CAIN A,"N + JRST GOTN + JRST SKPYS + GOTY: STRIKE ES + AOS -1(P) + JRST POPAJ + +GOTN: STRIKE O + JRST POPAJ + +SGNREG: 0 +OCTNUM: 0 +DECNUM: 0 +FLOGBE: 0 +FRSPRT: 0 +] + +HEADIN: 0 +IFN STMPIT,[ + +;GENERATES TIME AND DATE STAMP + +MYNAME: .FNAM1?SIXBIT/ /?.FNAM2?SIXBIT/ / + +STAMP: SAVE D + MOVE C,[440600,,MYNAME] + PUSHJ P,LPDAT + MOVE C,[440600,,MYNAME+2] + PUSHJ P,LPDAT + .RDATE D, + PUSHJ P,SPLASH + .RTIME D, + PUSHJ P,SPLASH + JRST POPDJ + +SPLASH: MOVE C,[440600,,D] + PUSHJ P,CLSPS1 + PUSHJ P,CLSPSP + PUSHJ P,.+1 + MOVEI A," + JRST TYPA + +CLSPSP: PUSHJ P,.+1 + MOVEI A,": + PUSHJ P,TYPA + JRST CLSPS1 + +LPDAT: PUSHJ P,.+1 + PUSHJ P,.+1 +CLSPS1: PUSHJ P,.+1 + ILDB A,C + CAIE A,"? + ADDI A," + JRST TYPA + +BARF: PRINT _ + PUSHJ P,STAMP + SKIPE HEADIN + PUSHJ P,@HEADIN + PRINT _ + POPJ P, + +] + IFN FLEFLG,[ + +NAMEP: PUSH P,A ;OUTPUT CURRENT FILE-NAME + PUSH P,B + MOVE B,[440600,,INOP+1] + ADD B,FRMTSW + PUSHJ P,NAMEL + PUSHJ P,NAMEL + JRST POPBJ + +NAMEL: ILDB A,B + ADDI A,40 + PUSHJ P,TYO + TLNE B,7700 \ No newline at end of file