 %BEGIN
 %INTEGERARRAY DDSARR(1:10)
 %INTEGER DDSPTR
 %ROUTINESPEC LINE(%INTEGER DELX,DELY,VIS)
 %ROUTINESPEC DISPOUT(%INTEGER N)
 %ROUTINESPEC MOVETO(%INTEGER XR,YR,VIS,SCALE,INTENS)
 %INTEGER %ARRAY IFILE(0:200)
 %INTEGER %ARRAY NAMSAV,MODSAV(1:10)
 %INTEGER ARRPTR,ARRLEN
 %INTEGER DAC,DEFINE,START,FTIME,INITAL,TOOBIG,ISCALE,LINT
 %INTEGER        LEVEL,JUNCT,NEWSUB,MAXDAC
 %INTEGER PUNSAV,NEWMOD,CURMOD,MX
 %ROUTINE COMPAC(%INTEGER JUG,KUG,LUG,MUG,NUG)
 %ROUTINE %SPEC PRINT ERROR MESSAGE
 %INTEGER SWORD, THIMOD, SETMOD, REQMOD, X, Y, V, SCALE, S, P, DESTIN
 %INTEGER  WHERE,INVIS,ISUM,STOP,INTERN,INTRET,JMPWRD,JMPADD
 %INTEGER I,M,MODE,INTENS
 %SWITCH SELECTOR(1:7), ILABEL(0:4)
 INTERN = 0 ; INTRET = 0
 -> SELECTOR(JUG) ; ! SELECT ROUTINE REQUIRED
 SELECTOR(1) :  1000 :  ! ROUTINE DISPAD(INTEGER SWORD)
       PUNSAV=KUG ; SWORD=KUG
 1010 : START=0
 1002 : DISPOUT(PUNSAV)
       DAC=DAC+1 ; ! INCREASE ADDRESS COUNTER
 1003 : -> ILABEL(INTERN) ; ! ILABEL(0) IS END OF ROUTINE
 SELECTOR(2) : 2000 : ! ROUTINE DISPAC(INTEGER SWORD,THIMOD,SETMOD)
       SWORD=KUG ; THIMOD=MUG ; SETMOD=NUG
 2020 : -> 2002 %IF INITAL=0
    1 : TOOBIG=0 ; INTERN=1 ; -> 1010
 ILABEL(1) : 2010 : CURMOD=0
       NEWMOD=0 ; PUNSAV=0 ; -> 2012
 2002 : -> 2012 %IF TOOBIG=1
       -> 2003 %IF DAC<MAXDAC
       SELECT OUTPUT(1); ! TT
       %CAPTION \\DISPLAY_FILE_TOO_LONG\
       %CAPTION CURTAILED_AT_DAC= ; WRITE (DAC,10)
       TOOBIG=1 ; -> 2012
 2003 : REQMOD=7;       %IF THIMOD<8 %THEN REQMOD=THIMOD
       %IF NEWSUB=0 %THEN -> 2022
       NEWSUB=0 ; MODSAV(DEFINE)=REQMOD
       -> 2021
 2022 : -> 2021 %IF JUNCT=0
       JUNCT=0
       JMPWRD=-131072+8192*REQMOD+DAC
       JMPADD=START+NAMSAV(DEFINE+1)-1
       IFILE(2)=JMPWRD ; MX=MX-1
 2021 : %IF CURMOD>=8 %THEN -> 2005
       ISUM=PUNSAV+CURMOD+NEWMOD+THIMOD
       -> 2005 %IF ISUM=0
       -> 2004 %IF NEWMOD=REQMOD
       -> 2006 %IF CURMOD=0 %OR CURMOD=1 %OR CURMOD=7
       -> 2007
 2006 : PUNSAV=PUNSAV+8192*(REQMOD-NEWMOD)
       -> 2004
 2007 : %IF NEWMOD#0 %THEN PUNSAV=PUNSAV-131072
       -> 2004 %IF REQMOD=0
       INTERN=2 ; -> 1010
 ILABEL(2) : 2011 : PUNSAV=8192*REQMOD
 2004 : INTERN=3 ; -> 1010
 ILABEL(3) : 2005 : CURMOD=THIMOD
       NEWMOD=SETMOD ; PUNSAV=SWORD ; INTERN=4
       -> 1010 %IF THIMOD>7
 ILABEL(4) : 2012 : %RETURN %IF INTRET=0
       INTRET=0 ; -> 3001
 SELECTOR(3) : 3000 : ! ROUTINE POINT(INTEGER MODE,INVIS,X,Y)
       %RETURN %IF TOOBIG=1
       MODE=KUG ; INVIS=LUG ; X=MUG
       Y=NUG ; M=MODE
       M=0 %UNLESS 0<=M<=7
       V=1024
       V=0 %IF INVIS=1
       -> 3001 %IF Y<0
       -> 3002 %IF Y<1024
       PRINT ERROR MESSAGE
 3002 : SWORD=Y-1024*(Y//1024)+65536
       -> 3003 %IF X<0
       SWORD=SWORD+8192 ; THIMOD=1
       SETMOD=1 ; INTRET=1 ; -> 2020
 3001 : %RETURN %IF X<0
 3005 : -> 3004 %IF X<1024
       PRINT ERROR MESSAGE
 3004 : SWORD=X-1024*(X//1024)
 3003 : SWORD=8192*M+V+SWORD
       THIMOD=1 ; SETMOD=M ; -> 2020 ; !
 SELECTOR(4) : 4000 : ! ROUTINE PARAM(INTEGER MODE,STOP,SCALE,INTERN)
       %RETURN %IF TOOBIG=1
       MODE=KUG ; STOP=LUG ; SCALE=MUG ; INTENS=NUG ; M=MODE
       M=0 %UNLESS 0<=MODE<=7
       P=0 ;
       P=1536 %IF STOP=1
       S=0
       -> 4001 %IF SCALE<0
       ISCALE=SCALE
       -> 4002 %IF SCALE<=3
       SELECT OUTPUT(1); ! TT
       %CAPTION \\SCALE_FUNNY\SCALE= ; WRITE(SCALE,3)
       %CAPTION \DAC= ; WRITE(DAC,5)
       ISCALE=0
 4002 : S=ISCALE+4
 4001 : I=0
       -> 4003 %IF INTENS<0
       LINT=INTENS
       -> 4004 %IF INTENS<=7
       SELECT OUTPUT(1); ! TT
       %CAPTION \\INTENSITY_FUNNY-RESET_TO_7 \
           %CAPTION    INTENSITY_WAS ; WRITE(INTENS,8)
       %CAPTION \DAC= ; WRITE(DAC,5)
       LINT=7
 4004 : I=LINT+8
 4003 : SWORD=8192*M+P+16*S+I
       THIMOD=0 ; SETMOD=M ; -> 2020
 SELECTOR(5) : 5000 : ! ROUTINE DJS(MODE,DESTIN)
       %RETURN %IF TOOBIG=1
       MODE=KUG ; DESTIN=MUG ; M=MODE
       M=0 %UNLESS 0<=MODE<=7
       SWORD=-65536+8192*M+DESTIN
       THIMOD=31 ; SETMOD=M ; -> 2020
 SELECTOR(6) : 6000 : ! ROUTINE DJP(MODE,DESTIN)
       %RETURN %IF TOOBIG=1
       MODE=KUG ; DESTIN=MUG ; M=MODE
       M=0 %UNLESS 0<=MODE<=7
       SWORD=-131072+8192*M+DESTIN+3072
       THIMOD=23 ; SETMOD=M ; -> 2020
 SELECTOR(7) : 7000 : ! ROUTINE DDS(MODE,WHERE)
       %RETURN %IF TOOBIG=1
       MODE=KUG ; WHERE=MUG ; M=MODE
       M=0 %UNLESS 0<=MODE<=7
       SWORD=65536+8192*M+WHERE+3072
       THIMOD=7 ; SETMOD=M ; -> 2020
 ILABEL(0) : %RETURN
 %ROUTINE PRINT ERROR MESSAGE
       SELECT OUTPUT(1) ; ! STREAM 6 IS FOR ERROR MESSAGES
       %CAPTION \\POINT_FUNNY_X=
       WRITE(X,8) ; NEWLINE ; SPACES(12)
       %CAPTION Y= ; WRITE(Y,8)
       NEWLINE ; SPACES(10)
       %CAPTION DAC= ; WRITE(DAC,5)
       %END ; !
 %END ; !
 %ROUTINE MOVE TO(%INTEGER XR,YR,VIS,SCALE,INTENS)
       %RETURN %IF TOOBIG=1
       %IF INTENS>3 %THEN INTENS=3
       -> 1 %IF INITAL=0
       INITAL=0 ; -> 3
 1 : -> 2 %IF SCALE<0 %AND INTENS<0
       -> 2 %IF SCALE=ISCALE %AND INTENS=LINT %AND LEVEL=0
 3 : COMPAC(4,1,0,SCALE,INTENS)
       LEVEL=0
 2 : %IF XR>=0 %OR YR>=0 %THEN COMPAC(3,0,1-VIS,XR,YR)
 %END
 %ROUTINE SET FILE ; !INITIALISES SYSTEM
       ARRPTR=1 ; ARRLEN=200
       DAC=3072 ; INITAL=1 ; TOOBIG=0
       DEFINE=0 ; JUNCT=0 ; NEWSUB=0
       MAXDAC=8500 ; MX=0
       MOVE TO(512,512,0,0,3)
       DDSPTR=0 ; FTIME=1
 %END
 %ROUTINE ENDFILE ; ! INSERTS DJP TO START OF FILE
       MX=0 ! MAKE SURE SUBPICTURE BUFFER CLEARED
       COMPAC(6,0,0,0,0) ; COMPAC(6,0,0,0,0)
 %END
 %ROUTINE DEFSUB(%INTEGER %NAME NAME)
       %INTEGER JUNSAV
       %RETURN %IF TOOBIG=1
       MX=MX+1
       COMPAC(6,0,1,1,0) %IF JUNCT=0
       JUNSAV=JUNCT ; JUNCT=0 ; NAME=DAC
       COMPAC(7,0,1,0,0)
       DDSPTR=DDSPTR+1 ; DDSARR(DDSPTR)=ARRPTR
       DEFINE=DEFINE+1 ; LEVEL=-1
       -> 1 %IF DEFINE>10
       NEWSUB=-1
       %IF JUNSAV=0 %THEN NAMSAV(DEFINE)=NAME
       %RETURN
 1 : COMPAC(4,0,0,-1,-1)
 %END
 %ROUTINE ENDSUB(%INTEGER %NAME NAME)
       %INTEGER SWORD,MODE,SUBDAC
       %RETURN %IF TOOBIG=1
       -> 1 %IF DEFINE>0
       SELECT OUTPUT(1) ; ! TT
       %CAPTION \\CALL_TO_ENDSUB_BUT_NO_SUBPICTURE_IS_BEING_DEFINED
       %RETURN
 1 : COMPAC(6,7,1,1,0)
       MODE=0
       MODE=8192*MODSAV(DEFINE) %IF DEFINE<=10
       SWORD=65536+MODE+DAC-1
       IFILE(DDSARR(DDSPTR))=SWORD
       DDSPTR=DDSPTR-1
       DEFINE=DEFINE-1 ; LEVEL=-1
       -> 3 %IF DEFINE>=10
       JUNCT=-1
       %RETURN
 3 : SUBDAC=NAME-1
       SWORD=-131072+DAC
       DISPOUT(SWORD)
       COMPAC(4,0,0,-1,-1)
 %END
 %ROUTINE CALSUB(%INTEGER %NAME NAME)
       %RETURN %IF TOOBIG=1
       -> 1 %IF NAME<4 %OR NAME >=DAC-3
       COMPAC(5,7,1,NAME,0)
       COMPAC(4,0,0,-1,-1)
       LEVEL=-1
       %RETURN
 1 : SELECT OUTPUT(1)
 %CAPTION \\SUBPICTURE_NAME ; WRITE(NAME,5)
               %CAPTION __IS_NOT_VALID
 %END ; !
 %ROUTINE LINE(%INTEGER DELX,DELY,VIS)
 %INTEGER ADELX,ADELY,DX,DY,SDX,SDY,CDX,CDY,P,D,VISBIT,SWORD,TWORD
 %INTEGER INVIS,DYMAX,IPOWER,IDELX,IDELY
 %INTEGER DMAX,DMIN,Q,DXQ,DYQ,CDXQ,CDYQ
       %RETURN %IF TOOBIG=1 %OR (DELX=0 %AND DELY=0)
       INVIS=1-VIS
       ADELX=!DELX! ; ADELY=!DELY!
       IPOWER=1
       %IF LEVEL=0 %THEN IPOWER=2**ISCALE
       IDELX=ADELX*IPOWER
       IDELY=ADELY*IPOWER
       %IF IDELX<1024 %AND IDELY<1024 %THEN -> 1
       SELECT OUTPUT(1); ! TT
       %CAPTION \\VECTOR_INCORRECT\DELX= ; WRITE(DELX,5)
       %CAPTION \DELY= ; WRITE(DELY,5)
       %CAPTION \SCALE= ; WRITE(ISCALE,3)
       %CAPTION \DAC= ; WRITE(DAC,5)
       %RETURN
 1 : SDX=0 ; SDX=128 %IF DELX<0
       SDY=0 ; SDY=32768 %IF DELY<0
       VISBIT=65536 ; %IF INVIS=1 %THEN VISBIT=0
       TWORD=VISBIT+SDY+SDX
       -> 3 %IF ADELY<ADELX
       DMAX=ADELY ; DMIN=ADELX
       DYMAX=1 ; -> 10
 3 : DMAX=ADELX ; DMIN=ADELY
       DYMAX=0
 10 : P=((DMAX-1)//127)
       %IF P>0 %THEN -> 5
       DX=ADELX ; DY=ADELY ; -> 6
 5 : CDX=0 ; CDY=0
       Q=127*DMIN//DMAX
       -> 7 %IF DYMAX=1
       DX=127
       DY=Q
       DXQ=127
       CDXQ=127 ; DYQ=Q; CDYQ=Q
       -> 6
 7 : DX=Q
       DY=127
       DXQ=Q
       CDXQ=Q
       DYQ=127
       CDYQ=127
 6 : SWORD=TWORD+256*DY+DX
       %IF P>0 %THEN -> 9
       COMPAC(2,SWORD,1,4,4)
       %RETURN
 9 : P=P-1
       COMPAC(2,SWORD,1,4,4)
       CDX=CDX+DX ; CDY=CDY+DY
       -> 11 %IF P>0
       DX=ADELX-CDX
       DY=ADELY-CDY ; -> 6
 11 : CDXQ=CDXQ+DXQ
       CDYQ=CDYQ+DYQ
       DX=(CDXQ)-CDX
       DY=(CDYQ)-CDY ; -> 6
%END ; !
%ROUTINE DISPOUT(%INTEGER N)
 %INTEGER I,X,K
 IFILE(ARRPTR)=N
 %IF MX>0 %THEN ->100; ! FOR BUFFERING
 SELECT OUTPUT(0); !DECTAPE USUALLY
 %CYCLE I=1,1,ARRPTR
 WRITE(IFILE(I),7)
 %REPEAT
 ARRPTR=1 ; DDSPTR=0 ; %RETURN
 100 : ARRPTR=ARRPTR+1
    %IF ARRPTR<ARRLEN %THENRETURN
 SELECT OUTPUT(1); ! TT USUALLY
 %CAPTION \\SUBPICTURE_BUFFER_OVERFLOW
 %CAPTION \DISPLAY_FILE_TERMINATED ; ENDFILE ;  %STOP
 %END

