C PROGRAM BMOMNI.FT C --------------- C C NCI/IP-TR/x C C C C BMOMNI - Fortran Interface Program for the RTPP C ----------------------------------------------- C C Buffer Memory, Quantimet and Control Desk C ----------------------------------------- C C SUBROUTINE BMOMNI(JMEM,JBYTE,JX,JY,JG,LINEBUF,IOPR) C C C C TECHNICAL REPORT #23 C C C PETER LEMKIN C IMAGE PROCESSING UNIT, DCBD C NATIONAL CANCER INSTITUTE C NATIONAL INSTITUTES OF HEALTH C BETHESDA, MD. 20014 C C JUNE 1, 1978 C FEB 17, 1977 C JAN 12, 1977 C JAN 10, 1977 C DEC 14, 1976 C C INTRODUCTION C ------------ C BMOMNI is a low level graphics and hardware control package C for the Real Time Picture Processor (RTPP) written in C FORTRAN II. The RTPP hardware is discussed in ([1], [2], C [3], and [4]). Reference [3] discusses the RTPP programming C structure in detail. C C Discussion of Terms used in BMOMNI C ---------------------------------- C The single user (not time-shared) RTPP display and image C computing system is controlled from the PDP8e computer and C consists of a 32K PDP8e computer; eight 16-bit 256x256 C pixel buffer memories capable of acquiring and displaying two C 8-bit digitized video images (although not simultaneously); C a QuantTV rate imet (QMT) image analyzer; C a GraphPen graphics tablet; a control desk and other hardware. C The PDP8e may readd, write, and control many C of these devices. BMOMNI is a software C interface between the hardware and the programmer. C The hardware is discussed in ([1], [2], [3], [4]). C C Each buffer memory (numbered 0, 1, ..., 7) stores C 16-bit data. The data may be interpreted both in hardware C and in software as 8-bit data. Thus a single buffer memory C (BM) may store 2 images. The image in the low half of the BM C is called the LOW byte image and the other the HIGH byte image. C Thus a BM image is specified by a pair: (BM#,byte#). C Only one of the two halves may be used to acquire gray scale video C from the QMT camera or display gray scale video on the QMT TV monitor. C However, the other half not being displayed as gray scale C video may be used to generate a QMT live frame (See [3]). C C The eight BMs are divided into two groups: A(0,1,2,3), C and B(4,5,6,7). PDP8e I/O may proceed with one group without C intefering with the display on the QMT with the other group because C each group has its own memory controller. C C BM data may be posted (displayed) on the QMT display which is C a 860 pixel by 720 line non interlaced 10 frame/second display. C A logical coordinate system (LCS) is defined over the QMT C camera and display, graphpen table, and other hardware (see [4]). C The LCS is a positive integer coordinate system with (x,y)=(0,0) C at the upper left hand corner of the window, (1023,1023) C is the lower right hand corner of the window. Each BM may be C positioned independently anywhere in the LCS by specifying C its "BM WINDOW" coordinates (upper left hand corner). C BMs intersecting the same LCS space will be displayed on a priority C basis with BM0>BM1>...>BM7. C C In addition to posting images on the QMT, it is possible to C acquire BM images at 1/10 second intervals from the QMT TV C camera (vidicon or Plumbicon). C C Movies are created by posting all BMs in the same BM window and C successively unposting old frames while posting the new frames. C In BMOMNI, a movie may consist of up to 16 different frames C (JMEM,JBYTE) which may be cycled any number of times. C C C C The GraphPen is a spark tablet (see [3]) mapped to the LCS C or [0:255]. A cursor corresponding to the pen position may C be displayed on the QMT "SCALE" intensity display control. C If the [0:255] pen range is used, then the user must also C specify an (x,y) BM WINDOW offset so that the cursor may C be positioned relative to an associated BM. The C GraphPen has a switch at the tip of the pen which may C be sensed. The pen (x,y) coordinates are is also available C through BMOMNI. C C The Quantimet hardware is capable of making simple measurements, C at TV frame rates, of well defined objects in the image. C An object is specified in the QMT system by a set C of adjacent pixels whose density range is the same. The C density range is specified as a slice range [C C AS (MASK VIDEO&(F&S)) SET JY=1 ELSE JY=0. C C 6 MUNPOST - UNPOST BUFFER MEMORY SPECIFIED BY (JMEM,JBYTE). C C 7 MWINDOW - MOVE BM WINDOW COORDINATE (BMXj,BMYj) FOR C BUFFER MEMORY JBM TO LCS (JX,JY). C C 8 MNUMBER - DISPLAY THE NUMBER CONTAINED IN JG AS C 4 DIGIT SIGNED DECIMAL AT (JMEM,JBYTE,JX,JY). C C 9 MGET - GET A VIDEO IMAGE FROM THE QMT INTO THE C BUFFER MEMORY SPECIFIED BY (JMEM,JBYTE). C TO GET DETECTED VIDEO IN THE JBYTE' 1/2 C OF THE BM SET JY=1 ELSE JY=0. THE MEMORY MUST C BE POSITIONED AT THE DESIRED BM WINDOW PRIOR C TO THE MGET. THE MGET IS PERFORMED INDEPENDENTLY OF THE C POST STATUS FOR THE SPECIFIED BM. C C 10 MFETCH2D - READ BM PIXEL (JMEM,JBYTE,JX,JY)==>JG C C 11 MPACK2D - WRITE BM PIXEL (JMEM,JBYTE,JX,JY)<==JG C C 12 MRDLINE - READ BM LINEBUF[1:256]<==(JMEM,JBYTE,JY) C C 13 MWTLINE - WRITE BM LINEBUF[1:256]==>(JMEM,JBYTE,JY) C C 14 MCLRMOVIE - CLEAR MOVIE LIST (SEE IOPRS # 15, 16). C C 15 MINSMOVIE - INSERT BM SPECIFIED BY (JMEM,JBYTE) INTO MOVIE C FRAME JG (1:384). TO USE MASK&(F&S) VIDEO (IE. JBYTE') C FOR THIS FRAME THEN SET JY=1 ELSE JY=0. C C 16 MRUNMOVIE - RUN MOVIE JG TIMES (MINIMUM OF 1 TIME). C TYPE ^O TO RETURN BEFORE JG TIMES RUNS OUT. JY IS USED C TO SPECIFY THE NUMBER OF TIMES A BM FRAME IS SHOWN (IN C TERMS OF QMT FRAMES OF 1/10 SEC) BEFORE THE NEXT C FRAME IS SHOWN. BOTH JY AND JG DEFAULT IF 0 TO 1. C THE CURRENT FRAME # (1 TO 384) IS POSTED IN THE RIGHT C QMT DISPLAY. C C 17 MGRFPEN - GET (JX,JY) FROM GRAPHPEN AFTER PEN SPARKS. C NOTE: PUT THE GRAPHPEN CONTROLLER SWITCH IN "RUN" MODE. C ALSO THE "RESET" SWITCH MUST BE PRESSED WHEN THE C PDP8E IS RESTARTED. C IN ADDITION TO RETURNING THE (X,Y) PEN COORDINATES, C THE PENSWITCH (FBW12[11]) IS RETURNED IN LINEBUF[1]. THE C CURSOR ON THE QUANTIMET DISPLAY (USING THE SCALE C CONTROL) IS MOVED WITH THE PEN REGUARDLESS OF C WHETHER DATA IS ACQUIRED OR NOT. IF THE LCS C (1024X1024) COORDINATE SYSTEM IS DESIRED C INSTEAD OF THE 256X256 SYSTEM, THEN CALL MGRFPEN WITH C JG=1 OTHERWISE SET JG=0. C WHEN USING THE (256X256) COORDINATE SYSTEM, C (JX,JY) MUST BE SET TO THE POSITION OF THE 256X256 C WINDOW OVER WHICH THE DATA IS TO BE MAPPED FOR THE C QMT CURSOR. DATA IS IN THE RANGE OF (0:255). C C 18 MLDCURSOR - LOAD QMT CURSOR FROM (JX,JY) C INTO LCS COORDINATES. THE QMT "SCALE" CONTROL C CONTROLS THE INTENSITY OF THE CURSOR. C C 19 MLDFS - LOAD QMT FRAME AND SCALE QMT WINDOW SPECIFIED BY C THE 4-TUPLE: (HORIZONTAL POSITION, HORIZONTAL SIZE, C VERTICAL POSITION, VERTICAL SIZE) C FROM LINEBUF[1:4] SPECIFIED AS LCS (0:1023]) COORDINATES. C C 20 MRDFS - READ THE QMT FRAME AND SCALE QMT WINDOW (HP,HS,VP,VS) C LCS COORDINATES INTO LINEBUF[1:4]. C C 21 MRDKBD - READ THE CONTROL DESK KEYPAD 6-DIGIT SWITCHES C AND RETURN FLOATING POINT NUMBER IN LINEBUF[1:3]. C PRESSTHE KEYPAD "C" TO CLEAR THE KEYPAD BEFORE READING C BY THE PDP8E, PRESS "S" TO SEND THE CONTENTS OF THE NUMBER C ENTERED INTO THE KEYPAD TO THE PDP8E. C C 22 MRDFBW - READ THE CONTROL DESK "FBWi" SWITCHES C NUMBERS 1 THROUGH 12 OCTAL AND PUT THE RESULTS C INTO LINEBUF[1:12 OCTAL]. SEE [3] FOR DETAILED SWITCH C DESCRIPTION. C C 23 MLDQMT - LOAD LINEBUF[1:2] (LOW,HIGH) 3 DIGIT C DECIMAL (POSITIVE) NUMBERS INTO THE RIGHT QMT C NUMERAL DISPLAY. C C 24 MLDCDLIGHTS - LOAD JG==>CONTROL DESK COMMAND KEY C (FBW2) LIGHTS. THE 12-BIT JG BIT PATTERN CORRESPONDS TO C THE 12 COMMAND KEYS. C C 25 MLDDISP - LOAD LINEBUF[1:2] DATA INTO DISP1, DISP2 C CONTROL DESK LIGHTS. THE LIGHTS DECODED THE 12-BIT C DATA INTO BOTH BCD AND OCTAL NUMBERS. C C 26 MRUNQMT - RUN THE QMT WITH "QMT FUNCTION COMPUTERS C FC1 AND FC2 PROGRAMMED BY (JX,JY). C THE NUMBER OF OBJECTS FOUND RETURNED IN JG (SEE [3]). C QMT FULL FIELD DATA FOR FC1 IS RETURNED AS A FLOATING C POINT NUMBER IN LINEBUF[1:3]. FC1 IS PROGRAMMED BY C JX, FC2 BY JY RUNQMT. C VALUE FUNCTION C ----- -------- C 1 DENSITY C 2 AREA C 3 PERIMETER C 4 HORIZONTAL PROJECTION C 5 VERTICAL PROJECTION C 6 VERTICAL FERET C 7 HORIZONTAL FERET C C 27 MRDFCT - READ THE NEXT QMT OBJECT (ACP) DATA C FROM THE SHIFT REGISTER STACK. DATA INCLUDES C [FC1,FC2,(X,Y)ACP] GENERATED WITH THE LAST MRUNQMT. C DATA IS RETURNED AS: C JX=XACP, JY=YACP; LINEBUF[1:3]=FLOATING FC1 DATA; C LINEBUF[4:6]=FLOATING FC2 DATA. C C 28 MQSTAT - LOAD JG INTO QSTAT QMT STATUS REGISTER (SEE [3]). C C C 29 MQPROG - LOAD LINEBUF[1:8]==>QPROG[1:8]. THE QPROG WORDS C ARE THE QMT HIGH LEVEL PROGRAM WORDS DISCUSSED IN [3]. C C 30 MCLOCK - WAIT JG*0.05 SECONDS BEFORE C RETURN (REAL TIME 200HZ CLOCK). IF JG=0 THEN WAIT 0.05 SEC. C C 31 MSAMPLE - SAMPLE THE PDP8E 16 CHANNEL A/DS AND RETURN THE C A/D DATA IN LINEBUF[1:16] IN THE RANGE OF 0:1023. C CHANNEL FUNCTION C ------- -------- C 0 GALVANOMETER SCANNER DATA C 1 " " REFERENCE C 2:7 -SPARES C 8:15 CONTROL DESK KNOB POTS 0:7 C C 32 MRD3LINES - READ 3 BM LINES STARTING AT (JMEM,JBYTE,JY) C INTO LINEBUF[1:512] PACKED 3/2 3-BYTES/2PDP8E(12-BIT) WORDS. C IF JY=254 OR 255 THEN THE DATA WILL WRAP AROUND C TO LINE 0 OR 0,1. C C 33 MWT3LINES - WRITE 3 BM LINES FROM LINEBUF[1:512] C INTO (JMEM,JBYTE,JY) PACKED 3/2 3-BYTES/2PDP8E(12-BIT) C WORDS. IF JY=254 OR 255 THEN ONLY LINES 254:255 OR 255 C WILL BE WRITTEN OUT TO THE BM (I.E. THE BM IS PROTECTED C AGAINST WRAP AROUND). C C 34 MLDETBC - LOAD THE QMT DETECTOR MODULE THRESHOLDS B AND C C THB<==JX, THC<==JY (SEE [3]). NOTE: THE VALUES ARE IN C THE RANGE OF [0:255]. C C 35 MRD16BITS - READ 16-BIT BM WORD ADDRESSED BY (MEM,IX,IY) C ==> LINEBUF[1:2] IN EAE FORMAT. C C 36 MWT16BITS - WRITE 16-BIT BM WORD ADDRESSED BY (MEM,IX,IY) C <== LINEBUF[1:2] IN EAE FORMAT. C LIST OF INTERNAL PROCEDURES IN BMOMNI C ------------------------------------- C 1. FETCH2D - FETCH 8 BIT GRAY VALUE FROM BM. C MEM - BM NUMBER 0:7 C IBYTE - LOW (0), HIGH (1) BYTE C IX - 0:255 X ADDRESS C IY - 0:255 Y ADDRESS C IZ - 0:255 GRAY VALUE C C 2. PACK2D - PACK 8 BIT GRAY VALUE INTO BM. C MEM - BM NUMBER 0:7 C IBYTE - LOW (0), HIGH (1) BYTE C IX - 0:255 X ADDRESS C IY - 0:255 Y ADDRESS C IZ - 0:255 GRAY VALUE C C 3. W/RT3BUF(BUFFER,IOPR) - TRANSFER 512 BUFFER WORDS TO/FROM BM C IN 3/2 PACKED FORMAT. READ (IOPR=0) BUFFER<==BM, C WRITE (IOPR=1) BUFFER==>BM. C THE FIRST LINE (IY,MEM,IBYTE) IS SPECIFIED. C C 4. DTEXT - DISPLAY TEXT LIN BUFFER LINE AT C (MEM,IBYTE,IX,IY) C C 5. TTYCTL - TEST FOR ^S,^O,^Q C C 6. SETBITS - DEFINE IMA(1), IMA(2) FROM (MEM,IBYTE) C C 7. BCDTOFLOAT - CVT (IMA,IHIGH) BCD TO F.P. VAR FFF. C OPDEFS C ------ S OPDEF RIF 6224 C C S OPDEF CLKACK 6302 S SKPDF CLKSKP 6303 C S OPDEF DETB 6420 S OPDEF DETC 6421 C C S OPDEF QPROG1 6370 S OPDEF QPROG2 6371 S OPDEF QPROG3 6372 S OPDEF QPROG4 6373 S OPDEF QPROG5 6431 S OPDEF QPROG6 6432 S OPDEF QPROG7 6433 S OPDEF QPROG8 6434 C S OPDEF FBW1 6341 S OPDEF LFBW2 6437 S OPDEF FBW12 6352 C C S OPDEF LQDT1 6375 S OPDEF LQDT2 6376 S OPDEF QDAT1 6324 S OPDEF QDAT2 6325 C S OPDEF STQMT 6300 S SKPDF QMSKP 6301 /SKIP ON QMT READY C S OPDEF CSRGI 6315 /ZERO THE SRG INDEX CNTR S OPDEF ZSRGI 6316 /ADVANCE THE SRG INDEX CNTR C /AND SRG TO 0.(MOVE DATA TO FRONT). S OPDEF IZSKP 6317 /TEST IF ZSRGI IS DONE S OPDEF RSRGI 6332 /READ SRGI==>AC C S OPDEF RSRGX 6330 /READ SRGI X-ACP FRONT==>AC S OPDEF RSRGY 6331 /READ SRGI Y-ACP FRONT==>AC S OPDEF RFC1H 6334 /READ SRGI FUNC.1 MSW FRONT==>AC S OPDEF RFC1L 6335 /READ SRGI FUNC.1 LSW FRONT==>AC S OPDEF RFC2H 6336 /READ SRGI FUNC.2 MSW FRONT==>AC S OPDEF RFC2L 6337 /READ SRGI FUNC.2 LSW FRONT==>AC S OPDEF ADVSR 6314 /ADVANCE THE SRG C S OPDEF QSTAT 6374 /LOAD THE QMT STATUS REGISTER S OPDEF RQSTAT 6327 /READ THE QMT STATUS REG==>AC S SKPDF QMSKP 6301 C C C S OPDEF READGP 6146 S OPDEF GPSKP 6141 C S OPDEF RKYPDH 6340 S OPDEF RKYPDL 6353 S SKPDF SKPKPD 6313 C S OPDEF LDXP 6443 S OPDEF LDYP 6444 C S OPDEF DISP1 6435 S OPDEF DISP2 6436 C S OPDEF TADI 1400 S OPDEF DCAI 3400 C C C S OPDEF HPL 6360 S OPDEF VPL 6362 S OPDEF HSL 6361 S OPDEF VSL 6363 C S OPDEF HPR 6320 S OPDEF VPR 6322 S OPDEF HSR 6321 S OPDEF VSR 6323 C S OPDEF LDXP 6443 S OPDEF LDYP 6444 S OPDEF READGP 6146 S SKPDF GPSKP 6141 C S OPDEF GETA 6522 S OPDEF GETB 6523 S OPDEF POSTA 6520 S OPDEF POSTB 6521 C S OPDEF BMX0 6500 S OPDEF BMY0 6504 S OPDEF BMX4 6510 S OPDEF BMY4 6514 C S OPDEF DMAGO 6070 S SKPDF DMASKP 6071 S OPDEF DMAWC 6072 S OPDEF DMACA 6073 S OPDEF DMACLR 6074 S OPDEF EXDMA1 6524 S OPDEF EXDMA2 6525 C S OPDEF SWAB 7431 S OPDEF SWBA 7447 S OPDEF SHL 7413 S OPDEF DAD 7443 S OPDEF DST 7445 S OPDEF DPIC 7573 S OPDEF CAM 7621 C S OPDEF MQA 7501 S OPDEF MQL 7421 S OPDEF BSW 7002 C C C Analogue to Digital 16 channel converter C (DEC AD8-ea/AM8-ea) with an input voltage C range of +/- 1 volt, 0-30 KHZ bandwidth, 10 C bit resolution, 200 nsec. apperature time. S OPDEF ADCL 6530 /Clear AD done and timing error flags. C Clear enable, mux and status register. S OPDEF ADLM 6531 /LOAD mux register from AC[8:11], C clear AC. S OPDEF ADST 6532 /CLear AD done and timing error flags. C Start AD converter. Channel to C be converted is to be determined by C mux register. S OPDEF ADRB 6533 /CLear AD done flag. Contents of C AD buffer ==>ac[0:11]. S SKPDF ADSK 6534 /SKIp next instruction if AD done=1. C Do not clear flag. C@S SKPDF ADSE 6535 /Skip next instruction if C timing error=1. C Do not clear flag. C@S OPDEF ADLE 6536 /LOad enable register from AC[2:5]. C@S OPDEF ADRS 6537 /REAd AD status/enable register and C mux into AC[0:11]. C C A/D Status register C Bit function C ---- -------- C 0 Conversion done C 1 error C 2 done interrupt enable C 3 error interrupt enable C 4 external start enable C 5 auto increment enable C 6-7 not used C 8-11 contents of mux register C C C C DIMENSION IBUF(768), IMA(4) EQUIVALENCE (IMA(2),IMB) C C ***DUMMY**** S DUMMY CC S DUMMY BB S DUMMY BUFF C C CHECK FOR ARGUMENT COUNT ERROR. THERE SHOULD BE 7 ARGS C EACH ARG TAKING UP 2 LOCS AND THE POINTER IS ON THE RETURN C P-D15=LOC(NARGS*'100+LINK SUBR#). THEREFORE CHECK NARGS S TAD BMOMN S DCA CC S TAD BMOMN# S TAD (-D15 S DCA CC# S TAD I CC /GET NARG&LINK S BSW S AND (0077 S DCA \IX S TAD \IX S TAD (-7 /-# ARGS S SZA CLA S JMP \2045 /FATAL ERROR!!! C C C VERIFY OPR BEFORE DISPATCH C S CLA CMA /IF IOPR < 1 THEN ERROR S TAD I \IOPR S SPA CLA S JMP \2045 /ERROR C C IF IOPR > 36 (I.E. MAX # OF COMMANDS) C THEN ERROR ELSE CONTINUE S CLA CMA S TAD (-D36 / ***** CHANGE IF ADD COMMANDS ***** S TAD I \IOPR S SPA CLA S JMP \2043 /OK, CONTINUE C C ERROR!!!!! 2045 WRITE(1,2046)IOPR 2046 FORMAT('ILL BMOMNI OPR=',I5) CALL EXIT C C DISPATCHER 2043 MEM=JMEM IBYTE=JBYTE IX=JX IY=JY IZ=JG C C SAVE THE TRIPLE LINE BUFFER PTR S RIF S TAD (6201 S DCA CC S TAD PIBUF S DCA CC# C GOTO(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18 1,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36),IOPR C C C C [1] MTEXT - DISPLAY TEXT AT (MEM,IBYTE,IX,IY,IZ) 1 DO 100 I=1,20 IBUF(I)=LINEBUF S INC \LINEBUF# 100 CONTINUE S JMS DTEXT 2047 RETURN C C C [2] MMOVE - MOVE (X0,Y0) TO (IX,IY) 2 IX0=IX IY0=IY C RETURN C C C C [3] MDRAW - DRAW A VECTOR FROM (IX0,IY0) TO (IX,IY) C COMPUTE DIFFERENCES C 3 NSIZ=-255 C IF JG=-2 THEN NSIZ=-1023; NSIZ=-255 S TAD (2 S TAD I \JG S SNA CLA S TAD (-D768 S TAD \NSIZ S DCA \NSIZ C C ZERO COUNTER JG=0 C IDY=IY-IY0 IDX=IX-IX0 IADX=IABS(IDX) IADY=IABS(IDY) C C TEST IF NULL VECTOR S TAD \IADX S TAD \IADY S SNA CLA S JMP \2047 /ZERO==>RETURN C C C TEST IF HORIZONTAL LINE S TAD \IDY S SNA CLA S JMP \302 /DY=0 ==> HORIZONTAL LINE C C TEST IF VERTICAL LINE IF(IDX)305,306,305 C C C [3.1] DRAW HORIZONTAL LINE 302 IX1=IX0 IX2=IX C S TAD \IDX S SPA CLA /GET THE SIGN S CMA /-1 S SMA S IAC /+1 S DCA \ISIGN C IX=IX1 C C LOOP 311 CONTINUE S CPAGE 3 S JMS TTYCTL S JMP \2047 C C TEST IF CLIP S TAD \IX S SPA /TEST IF < 0 S CLA CLL CMA RAR /LOAD 2047 S TAD \NSIZ /TEST IF > -NSIZ S SPA CLA C C OK, DRAW IT S JMS DOXY /TEST IF PACK AND SAVE C TEST IF DONE S TAD \IX S CIA S TAD \IX2 S SNA CLA S JMP \2047 /DONE C C NOT DONE, INCREMENT IX=IX+ISIGN GOTO 311 C C C [3.2] DRAW VERTICAL LINE 306 IY1=IY0 IY2=IY C S TAD \IDY S SPA CLA /GET THE SIGN S CMA /-1 S SMA S IAC /+1 S DCA \ISIGN C IY=IY1 C LOOP S CPAGE 3 S\321, JMS TTYCTL S JMP \2047 C C TEST IF CLIP S TAD \IY S SPA /TEST IF < 0 S CLA CLL CMA RAR /LOAD 2047 S TAD \NSIZ /TEST IF > -NSIZ S SPA CLA C C OK, DRAW IT S JMS DOXY /TEST IF PACK AND SAVE C TEST IF DONE S TAD \IY S CIA S TAD \IY2 S SNA CLA S JMP \2047 /DONE C C INCREMENT IY=IY+ISIGN GOTO 321 C C C C [3.3] DRAW OFF AXIS LINE C IF |dx| > |dy| C THEN DRAW Y=MX+B ELSE DRAW X=MY+B; S \305, TAD \IADX S CIA S TAD \IADY S SPA CLA S JMP \340 /DRAW Y=MX+B C C C [3.3.1] DRAW IX=FM*IY+B FM=FLOAT(IDX)/FLOAT(IDY) B=FLOAT(IX0)-FM*FLOAT(IY0) IY1=IY0 IY2=IY C GET THE SIGN S TAD \IDY S SPA CLA S CMA /-1 S SMA S IAC /+1 S DCA \ISIGN C IY=IY1 C C LOOP S CPAGE 3 S\332, JMS TTYCTL S JMP \2047 C IX=FM*FLOAT(IY)+B C TEST IF CLIP S TAD \IX S SPA /TEST OF <0 S CLA CLL CMA RAR /LOAD 2047 S TAD \NSIZ /TEST IF > -NSIZ S SPA CLA C S JMS DOXY /TEST IF PACK AND SAVE C TEST IF DONE S TAD \IY S CIA S TAD \IY2 S SNA CLA S JMP \2047 /YES, DONE C C INCREMENT IY=IY+ISIGN GOTO 332 C C C C [3.3.2] DRAW IY=FM*IX+B 340 FM=FLOAT(IDY)/FLOAT(IDX) B=FLOAT(IY0)-FM*FLOAT(IX0) IX1=IX0 IX2=IX S TAD \IDX S SPA CLA S CMA /-1 S SMA S IAC /+1 S DCA \ISIGN C IX=IX1 C C LOOP S CPAGE 3 S\342, JMS TTYCTL S JMP \2047 C IY=FM*FLOAT(IX)+B C TEST IF CLIP S TAD \IY S SPA /TEST IF < 0 S CLA CLL CMA RAR /YES, LOAD 2047 S TAD \NSIZ /TEST IF > -NSIZ S SPA CLA /TEST IF > -NSIZ C S JMS DOXY /TEST IF PACK AND SAVE C TEST IF DONE S TAD \IX S CIA S TAD \IX2 S SNA CLA S JMP \2047 /DONE C C INCREMENT IX=IX+ISIGN GOTO 342 C C C C ****SUBROUTINE D O X Y **** C TEST IF PACK AND SAVE IN LINEBUF S CPAGE 4 S RDOXY, CLA S JMP I DOXY S DOXY, 0 /ENTRY C DO CLIPPING ON (X,Y) IN RANGE [0:-NSIZ] C SET C(25)= NSIZ-1 S CLA CMA S TAD \NSIZ S DCA 25 C S TAD \IX S SPA S JMP RDOXY /IGNORE , X<0 S TAD 25 /(NSIZ-1) S SMA CLA S JMP RDOXY /IGNORE, X > -(NSIZ-1) C S TAD \IY S SPA S JMP RDOXY /IGNORE , Y<0 S TAD 25 /(NSIZ-1) S SMA CLA S JMP RDOXY /IGNORE, Y > -(NSIZ-1) C S TAD \IZ /DO NOT DRAW IF < 0 S SMA CLA S JMS PACK2D C C COY # OF POINTS TO OUTPUT BUFFER JG=JG+1 LINEBUF=IX S INC \LINEBUF# LINEBUF=IY S INC \LINEBUF# S JMP RDOXY /RETURN C C [4] MCOLOR - COLOR (MEM,IBYTE) WITH IZ 4 CONTINUE S TAD \IZ S RTR; RTR; RAR S AND (7400 S TAD \IZ S DCA \IX2 S TAD \IZ S RTL; RTL S AND (7400 S TAD \IZ S DCA \IX1 DO 400 I=1,512,2 IBUF(I)=IX1 IBUF(I+1)=IX2 400 CONTINUE DO 401 IY1=1,256,3 IY=IY1-1 S JMS WT3BUF 401 CONTINUE C RETURN C C C [5] MPOST - POST (MEM,IBYTE) S \5, JMS SETBITS S TAD \IPSTA S MQL S TAD \IMA S MQA S DCA \IPSTA S TAD \IPSTA S POSTA C C S TAD \IPSTB S MQL S TAD \IMB S MQA S DCA \IPSTB S TAD \IPSTB S POSTB C RETURN C C C C C [6] MUNPOST - UNPOST (MEM,IBYTE) S \6, JMS SETBITS C S TAD \IMA S CMA S DCA 7 S TAD \IPSTA S AND 7 S DCA \IPSTA S TAD \IPSTA S POSTA C S TAD \IMB S CMA S DCA 7 S TAD \IPSTB S AND 7 S DCA \IPSTB S TAD \IPSTB S POSTB RETURN C C C C C [7] MWINDOW - MOVE MBMX(MEM),BMY(MEM) TO LCS (IX,IY) S \7, CLA S TAD \MEM S TAD (-4 S SMA CLA S TAD (10 S MQL C S TAD \MEM S AND (3 S MQA S MQL /ADD OFFSET C S MQA S TAD PBMX0 S DCA \701 S TAD \IX S \701, BMX0 C S MQA S TAD PBMY0 S DCA \702 S TAD \IY S \702, BMY0 C RETURN C C C C C [8] MNUMBER - DISLAY NUMBER IN JG AS DECIMAL NUMBER WITH SIGN C AT (MEM,IBYTE,IX,IY) WITH DENSITY IZ. C SAVE THE SIGN AND MAKE > 0 S\8, TAD \IZ S SPA CLA S TAD (2 /"-" S TAD (53 /"+" S DCA SIXBIT C S TAD \IZ S SPA S CIA /MAKE >0 S DCA \IZ C I1=IZ/1000 I2=(IZ-I1)/100 I3=(IZ-I1-I2)/10 I4=IZ-I1-I2-I3 C C CONSTRUCT TEXT S TAD SIXBIT S BSW S TAD (60 S TAD \I1 S DCA \IBUF C S TAD (60 S TAD \I2 S BSW S TAD (60 S TAD \I3 S DCA \IBUF# C S TAD (60 S TAD \I4 S BSW S DCA \I /NOTE: CONTAINS "I4&@" (EOS). IBUF(3)=I S JMS DTEXT RETURN C C C C [9] MGET - GET BM(MEM,IBYTE) S \9, JMS SETBITS S TAD \IMA S GETA S TAD \IMB S GETB C S STQMT S \901, QMSKP S JMP \901 /NOT DONE RETURN C C C C [10] MFETCH2D - READ PIXEL(MEM,IBYTE,IX,IY)==>JG S \10, JMS FETCH2D JG=IZ RETURN C C C C C [11] MPACK2D - WRITE PIXEL (MEM,IBYTE,IX,IY)<==IZ S \11, JMS PACK2D RETURN C C C C C C [12] MRDLINE - READ LINEBUF[1:256]<==(MEM,IBYTE,IY) 12 DO 1020 IX1=1,256 IX=IX1-1 S CPAGE 3 S JMS TTYCTL S JMP \2047 S JMS FETCH2D LINEBUF=IZ S INC \LINEBUF# 1020 CONTINUE RETURN C C C C [13] MWTLINE - WRITE LINEBUF[1:256]==>(MEM,IBYTE,IY) 13 DO 1030 IX1=1,256 IX=IX1-1 S CPAGE 3 S JMS TTYCTL S JMP \2047 IZ=LINEBUF S INC \LINEBUF# S JMS PACK2D 1030 CONTINUE RETURN C C C C [14] MCLRMOVIE - CLEAR MOVIE LIST 14 DO 1040 I=1,768 C COMPUTE IBUF(I)=0 S CLA CMA S TAD \I S TAD PIBUF S DCA 7 S DCAI 7 1040 CONTINUE C C CLEAR MAX FRAME COUNTER MAXFRAMES=0 RETURN C C C C C [15] MINSMOVIE - INSERT (MEM,IBYTE) ==> MOVIE FRAME IZ. 15 CONTINUE S JMS SETBITS S TAD \IZ S TAD (-D384 S SMA S CLA CMA /-1 S TAD (D384 S DCA \IZ C C COMPUTE: IBUF(IZ+1,1)=IMA(1) S CLA CMA S TAD \IZ S CLL RAL /*2 S TAD PIBUF S IAC S DCA 7 S TAD \IMA S DCAI 7 C C COMPUTE: IBUF(IZ+1,2)=IMA(2) S TAD \IMA# S INC 7 S DCAI 7 C C INCREMENT FRAME COUNTER S ISZ \MAXFRAMES S CLA C RETURN C C C C [16] MRUNMOVIE - RUN MOVIE IZ TIMES S \16, TAD \IZ /IF 0 THEN 1 S SNA S IAC S DCA \IZ C C SET FRAME RATE TO IY S TAD \IY S SNA S IAC S DCA \IY C C DO 1060 ITIMES=1,IZ DO 1060 I=1,MAXFRAMES C DISPLAY CURRENT FRAME IN QMT RIGHT DISPLAY C NOTE: MAXFRAMES IS TWO BCD DIGITS SO MUST USE BCD! IXX=IBCD(I,-1) S TAD \IXX S LQDT1 /LSB S LQDT2 /000==>MSB C C COMPUTE: IMA(1)=IBUF(I,1) S CLA CMA S TAD \I S CLL RAL /*2 S TAD PIBUF S DCA 7 S TADI 7 S DCA \IMA C C COMPUTE: IMA(2)=IBUF(I,2) S INC 7 S TADI 7 S DCA \IMA# C C DO IT IY FRAME TIMES DO 1060 IX=1,IY C C C TEST IF ^S,^Q,^O S CPAGE 3 S JMS TTYCTL S JMP \2047 /EXIT C C TEST IF SHOW THIS FRAME S TAD \IMA S TAD \IMB S SNA CLA S JMP \1060 C C SYNC WITH THE QMT BEFORE LOAD POST REGISTERS S MW, QMSKP S JMP MW C C DO FRAME S TAD \IMA S POSTA S TAD \IMB S POSTB C C START QMT SYNC PROCESS S STQMT C 1060 CONTINUE RETURN C C C C C [17] MGRFPEN - GET GRAPH-PEN DATA MAPPED TO (0:255) C AND DISPLAY THE CURSOR ON THE C QMT AT THE LINEBUF[1:2] OFFSET GIVEN WHEN CALLED. C ONLY TAKE DATA WHEN PEN IS PRESSED. 17 CONTINUE C C C TEST IF ^O ETC. S CPAGE 3 S WG, JMS TTYCTL S JMP \2047 /DONE C S GPSKP S JMP WG /NO C C C GET THE PEN TIP SWITCH S FBW12 S AND (0001 S DCA I \LINEBUF S INC \LINEBUF# C C C YES, GET DATA S READGP S DCA \IX S READGP S CIA S DCA \IY C C TEST IF LCS OR 256 SYSTEM S TAD \IZ S SNA CLA S JMP \1702 /256 SYSTEM C C USE LCS 1024 MAPPING S TAD \IX S CLL RTR S AND (1777 S DCA \IX C S TAD \IY S CLL RTR S AND (1777 S DCA \IY IY1=IY IX1=IX GOTO 1703 C C USE 256 MAPPING S \1702, TAD \IX S CLL RTR; RTR S AND (377 S DCA \IX C S TAD \IY S CLL RTR; RTR S AND (377 S DCA \IY C C COMPUTE CURSOR LCS VALUES USING OFFSETS IX1=JX+IX IY1=JY+IY C C SAVE DATA 1703 JX=IX JY=IY S TAD \IY1 S LDYP S TAD \IX1 S LDXP RETURN C C C C [18] LOAD THE QMT CURSOR WITH (IX,IY) IN LCS 18 CONTINUE S TAD \IX S LDXP S TAD \IY S LDYP C RETURN C C C C [19] LOAD F&S (HP,HS,VP,VS) <<==LINEBUF[1:4] 19 CONTINUE C C DO 1901 J=1,4 S CLA CMA S TAD \J S TAD PHPL S DCA DOHPL C I=LINEBUF S INC \LINEBUF# C CVT TO BCD I=IBCD(I,-1) C S TAD \I S DOHPL, HPL 1901 CONTINUE RETURN C S PHPL, HPL C C [20] READ F&S (HP,HS,VP,VS)==>LINEBUF[1:4] 20 CONTINUE C DO 1201 J=1,4 S CLA CMA S TAD \J S TAD PHPR S DCA DOHPR S DOHPR, HPR S DCA \I LINEBUF=IBCD(I,1) S INC \LINEBUF# 1201 CONTINUE RETURN C S PHPR, HPR C C [21] READ THE KEYPAD ==> IMA (LOW), IMB(HIGH) 21 CONTINUE S SKPKPD S JMP \21 C S RKYPDL S DCA \IMA S RKYPDH S DCA \IMB S JMS BCDTOFLOAT S CALL 1,FAD S ARG \FFF S CALL 1,ISTO S ARG \LINEBUF RETURN C C C C [22] MRDFBW - READ CTL DESK KEYS INTO LINEBUF[1:10] 22 CONTINUE DO 1220 I=1,10 S CLA CMA S TAD \I S TAD PFBW1 S DCA \1221 S \1221, FBW1 /ETC S DCA I \LINEBUF S INC \LINEBUF# 1220 CONTINUE RETURN C S PFBW1, FBW1 C C C C [23] MLDQMT - LOAD RIGHT QMT DISPLAY FROM LINEBUF[1:2] C LOW, HIGH 3 DIGIT POSITIVE NUMBERS 23 DO 1231 J=1,2 I=LINEBUF S INC \LINEBUF# 1231 IMA(J)=IBCD(I,-1) C LOAD ONLY IF QMT READY S QMSKP S JMP \2047 /NO, RETURN C C OK, LOAD IT AND START QMT S TAD \IMA S LQDT1 S TAD \IMB S LQDT2 C S STQMT /LOAD IT INTO THE RIGHT DISPLAY RETURN C C C C C [24] MLDCDLIGHTS - LOAD CMD KEY LIGHTS S \24, TAD \IZ S LFBW2 RETURN C C C C C [25] MLDDISP - LOAD LINEBUF[1:2]==>DISP[1:2] 25 IX=LINEBUF S INC \LINEBUF# IY=LINEBUF S TAD \IX S DISP1 S TAD \IY S DISP2 RETURN C C C C C C C [26] MRUNQMT - RUN QMT FUNCTION COMPUTERS FC1 FC2 WITH PROGRAM C IN JX,JY FOR FC1,FC2. RETURN # OBJECTS IN JG AND C FULL FIELD DATA FROM FC1 IN LINEBUF[1:3] 26 CONTINUE S TAD \IX S BSW S AND (1700 S MQL S TAD \IY S RTR S AND (0074 S MQA S QPROG7 C S CSRGI S STQMT S WQF, QMSKP S JMP WQF C C ADVANCE SRG S RSRGI S DCA I \JG S ZSRGI S WZF, IZSKP S JMP WZF C C C GET FIELD DATA S QDAT1 S DCA \IMA S QDAT2 S DCA \IMB S JMS BCDTOFLOAT S CALL 1,FAD S ARG \FFF S CALL 1,ISTO S ARG \LINEBUF RETURN C C C C [27] MRDFCT - READ NEXT ACP INTO (JX,JY) AND NEXT C FC1,FC2 DATA AS FLOATING POINT INTO LINEBUF[1:3], LINEBUF[4:6]. 27 CONTINUE S RSRGX S TAD (-D17 /OFFSET S DCA I \JX C S RSRGY S AND (1777 S DCA I \JY C C LOAD QMT CURSOR S TAD I \JX S LDXP S TAD I \JY S LDYP C C GET FC1 DATA S RFC1L S DCA \IMA S RFC1H S DCA \IMB S JMS BCDTOFLOAT S CALL 1,FAD S ARG \FFF S CALL 1,ISTO S ARG \LINEBUF C C C GET FC2 DATA S RFC2L S DCA \IMA S RFC2H S DCA \IMB S JMS BCDTOFLOAT C S TAD (3 S TAD \LINEBUF# S DCA \LINEBUF# S CALL 1,FAD S ARG \FFF S CALL 1,ISTO S ARG \LINEBUF C RETURN C C C C [28] MQSTAT - LOAD JG==>QSTAT S \28, TAD \IZ S QSTAT RETURN C C C C C [29] MQPROG - LOAD LINEBUF[1:8]==>QPROG[1:8] 29 CONTINUE DO 1290 I=1,8 S CLA CMA S TAD \I S TAD PQT S DCA 20 S TAD I 20 S DCA DOQPROG S TAD I \LINEBUF S INC \LINEBUF# S DOQPROG, QPROG1 /ETC S CLA 1290 CONTINUE RETURN S PQT, QTABLE S CPAGE 10 S QTABLE, QPROG1 S QPROG2 S QPROG3 S QPROG4 S QPROG5 S QPROG6 S QPROG7 S QPROG8 C C C C [30] MCLOCK - WAIT 1/200HZ S \30, TAD \IZ /SETUP COUNTER S SNA S IAC /MAKE IT 1 S CIA S DCA \IZ S \301, CLKSKP S JMP \301 /NOT YET S CLKACK ICLK=ICLK+1 S TAD \ICLK S MQL S ISZ \IZ /DONE WITH IZ CLOCK TICKS? S JMP \301 /NOT YET C RETURN C C [31] MSAMPLE -SAMPLE THE 16 A/D CHANNELS AND STORE THE VALUES IN C LINEBUF[1:16]. 31 CONTINUE C DO 1310 IX=1,16 IZ=IX-1 C C [AD.1] SET UP THE CHANNEL WHICH IS PASSED C THROUGH IZ. S ADCL S TAD \IZ /CHANNEL # S AND (0017 /ONLY 0 TO 17 S ADLM /LOAD THE MUX SELECTOR C C C [AD.2] START THE A/D S ADST S ADFIN,ADSK S JMP ADFIN /NOT FINISHED. C C C [AD.3] GET THE DATA S ADRB S TAD (1000 /ADD +512 SO -1 TO +1 VDC ==>[0:1777] S DCA I \LINEBUF S INC \LINEBUF# 1310 CONTINUE RETURN C C C C [32] MRD3LINES - READ 3 LINES FROM C (JMEM,JBYTE,JY)==>LINEBUF[1:512] C PACKED 3/2. 32 CONTINUE S TAD \LINEBUF S DCA CC S TAD \LINEBUF# S DCA CC# S JMS RT3BUF RETURN C C C C [33] MWT3LINES - WRITE 3 LINES TO C (JMEM,JBYTE,JY)<==LINEBUF[1:512] C PACKED 3/2. S \33, TAD \LINEBUF S DCA CC S TAD \LINEBUF# S DCA CC# S JMS WT3BUF RETURN C C C C [34] MLDETBC - LOAD QMT THRESHOLDS B<==JX, C<==JY. C AFTER MULT BY 16. S \34, TAD \IX S CLL RTL ; RTL /MULT BY 16 S DETB C S TAD \IY S CLL RTL ; RTL /MULT BY 16 S DETC RETURN C C C C [35] MRD16BITS - READ 16-BIT WORD FROM (MEM,IX,IY)==>LINEBUF[1:2] C IN EAE FORMAT S \35, JMS FETCH2D S TAD BUFF S DCA I \LINEBUF /LOW ORDER WORD C S INC \LINEBUF# /SETUP FOR HIGH ORDER S TAD BUFF# S DCA I \LINEBUF RETURN C C C C [36] MWT16BITS - WRITE 16-BIT WORD (MEM,IX,IY)<==LINEBUF[1:2] C IN EAE FORMAT 36 IBYTE=0 IZ=LINEBUF S JMS PACK2D IBYTE=1 S TAD I \LINEBUF /GET 0:4 S BSW; RTR /0:4==>8:11 S MQL S INC \LINEBUF# S TAD I \LINEBUF S RTL;RTL S AND (0340 S MQA S DCA \IZ S JMS PACK2D RETURN C C ********************************************************* C SUBROUTINE: F E T C H 2 D * C ********************************************************* C FETCH IZ=BM(MEM&IY&IX,IBYTE); C C FETCH AN 8-BIT BYTE FROM THE SPECIFIED BM C C ARGS IN COMMON FOR SPEED C ------------------------ C MEM - BM NUMBER 0 TO 7 C IBYTE - 0 (LOW), 1 FOR HIGH BYTE OF 16 BIT BYTE C IX - XADDR , 0 TO 255 C IY - YADDR, 0 TO 255 C IZ - RESULT. C S CPAGE 3 S RFETCH2D, JMP I FETCH2D S FETCH2D, 0 C C C [1] INITIALIZE PDP8/E REGISTERS S DMACLR S TAD PBUFF /BUFFER POINTER S DMACA /LOAD ADDRESS REGISTER S TAD (2 /2 WORDS S DMAWC /LOAD WORD COUNT REGISTER C C C [2] SET UP I/O DEVICE ADDRESS REGISTERS C S TAD \MEM S CLL RTL; RTL /MOVE BITS [9:11] ==> [5:7] S MQL S TAD \IY S CLL RTR; RTR /MOVE BITS [4:7] ==> [8:11] S AND (0017 S MQA /'OR' S DCA EX1 /SAVE FOR LATER USE S TAD EX1 S EXDMA1 /HIGH-ORDER WORD C S TAD \IY S CLL RTR; RTR; RAR /MOVE BITS [8:11] ==> [0:3] S AND (7400 S TAD \IX S DCA EX2 /SAVE FOR LATER USE S TAD EX2 S EXDMA2 /LOAD LO-ORDER WORD C C C [3] EXECUTE COMMAND C S RIF /GET CURRENT DATA FIELD FOR READ S DMAGO /DO IT! S DCA 7 /ZERO COUNTER C S RBM, DMASKP /WAIT 'TIL DONE S SKP S JMP F2D4 /DONE WITH I/O S ISZ 7 S JMP RBM /NOT YET S JMP \102 /OVERFLOW C C C [4] GET 8 BIT WORD FROM 16 BIT DATA C S F2D4, TAD \IBYTE /=1 FOR HIGH PACKING, =0 FOR LOW PACKING S SZA CLA S JMP GETHIGH C C C [4.1] GET LOW BYTE S TAD BUFF S AND (0377 S DCA \IZ S JMP RFETCH2D /DONE, RETURN C C C [4.2] GET HIGH BYTE S GETHIGH, TAD BUFF S MQL S TAD BUFF# S CPAGE 2 S SHL S 3 /LEFT SHIFT 4 BITS S AND (377 S DCA \IZ /STORE IT S JMP RFETCH2D /DONE, RETURN C C C C [5.] FATAL BM DMA TIMEOUT ERROR S\102, CLA S DMACLR WRITE(1,101) 101 FORMAT('BMOMNI DMA TIMEOUT ERR, RE-BOOT SYS:!') S HLT GOTO 102 C ********************************************************* C SUBROUTINE: P A C K 2 D * C ********************************************************* C PACK BM(MEM&IY&IX,IBYTE)=IZ C C C PACK AN 8-BIT BYTE FROM THE SPECIFIED BM C C ARGS IN COMMON FOR SPEED C ------------------------ C MEM - BM NUMBER 0 TO 7 C IBYTE - 0 (LOW), 1 FOR HIGH BYTE OF 16 BIT BYTE C IX - XADDR , 0 TO 255 C IY - YADDR, 0 TO 255 C IZ - DATA TO BE PACKED (8-BITS). C S CPAGE 3 S RPACK2D, JMP I PACK2D S PACK2D, 0 C C C [1] SAVE DATA FOR RETURN IZBACK=IZ C MAKE SURE THE DATA IS 0:255 S TAD \IZBACK S AND (377 S DCA \IZBACK C C C [2] FETCH IT S JMS FETCH2D C C C [3] SET UP OUTPUT WORD C S DMACLR /CLEAR S TAD PBUFF /BUFFER POINTER S DMACA /LOAD ADDRESS S TAD (2 /2 WORDS S DMAWC /LOAD WORD COUNT C S TAD EX1 /RETRIEVE HI-ORDER WORD S EXDMA1 /LOAD IT S TAD EX2 /RETRIEVE LO-ORDER WORD S EXDMA2 /LOAD IT C C SELECT PACKING MODE S TAD \IBYTE S SZA CLA S JMP PACKHIGH C C C [3.1] TRANSFER LOW BYTE S TAD BUFF S AND (7400 S TAD \IZBACK S DCA BUFF S JMP TRANSFER C C [3.2] PACK HIGH BYTE S PACKHIGH, TAD BUFF S AND (0377 S MQL S TAD \IZBACK S BSW S RTL S AND (7400 S MQA S DCA BUFF S TAD \IZBACK S RTR;RTR S DCA BUFF# C C C [4] EXECUTE TRANSFER C S TRANSFER,RIF /GET CURRENT DATA FIELD S TAD (4000 /SET WRITE BIT S DMAGO /GO TO IT! S DCA 7 /ZERO COUNTER C S WBM, DMASKP S SKP S JMP P2D4/IO DONE S ISZ 7 S JMP WBM /NOT YET S JMP \102 /TIMEOUT!!! C C (RESTORE IZ) S P2D4, TAD \IZBACK S DCA \IZ S JMP RPACK2D /RETURN C C C C ***************************************************** C * SUBROUTINE W/R T 3 B U F C ***************************************************** C C T3BUF - TRANSFER 512 BUFFER WORDS TO/FROM BM C IN 3/2 PACKED FORMAT. RT3BUF FOR READ WT3BUF FOR WRITE. C THE FIRST LINE (IY,MEM,IBYTE) IS SPECIFIED. C C C [0] INIT S CPAGE 3 S RRT3BUF, JMP I RT3BUF S RT3BUF, 0 C ICMD=0 GOTO 1989 C S WT3BUF, 0 S TAD WT3BUF S DCA RT3BUF S TAD (4000 S DCA \ICMD C C C C [1] GET THE BUFFER FIELD AND PTR, AND READ/WRITE WORD 1989 CONTINUE S DMACLR /CLEAR THE CHANNEL IYT3BACK=IY C C [2] GET DATA FIELD FOR COMMAND S TAD CC S AND (0070 S TAD \ICMD S DCA \ICMD C C C [3] TEST IF WRITING OUT LINES 254,255 C IN WHICH CASE WRITE OUT ONLY LINES 254, 255 USING PACK2D. S TAD \ICMD S SMA CLA S JMP \1900 /NO C S TAD \IY S TAD (-D254 S SPA CLA S JMP \1900 /NO C C C C [3.1] GO WRITE OUT LINES 254,255 USING PACK2D AFTER C UNPACKING THE DATA FROM THE BUFFER. J=IY IW1=0 IW2=0 ITRIPLE=0 C KK=0 DO 1952 IY=J,255 DO 1952 IXX=1,256 IX=IXX-1 C C GET THE BYTE USING THE TRIPLE COUNTER ITRIPLE=ITRIPLE+1 GOTO(1961,1962,1963),ITRIPLE C C GET 2 WORDS AND PACK 1ST BYTE S \1961, TAD I CC S DCA \IW1 S INC CC# S TAD I CC S DCA \IW2 C S TAD \IW1 S AND (377 GOTO 1964 C C GET 2ND BYTE S \1962, TAD \IW2 S AND (377 GOTO 1964 C C GET 3RD BYTE 1963 ITRIPLE=0 S TAD \IW1 S RTR;RTR S AND (0360 S MQL S TAD \IW2 S RTL; RTL; RAL S AND (0017 S MQA C S \1964, DCA \IZ S JMS PACK2D 1952 CONTINUE IY=IYT3BACK S JMP RRT3BUF C C C C [4] FINISH SETTING UP THE CHANNEL TO MOVE 3 LINES S\1900, TAD (D512 /SET WORD COUNT TO... S DMAWC /...2 BLOCKS C C LOAD BM ADDRESS S TAD CC# S DMACA C S TAD \MEM /GET BM NUMBER AND SET UP BM ADDRESS S CLL RTL; RTL /9:11==>5:7 S MQL S TAD \IY /ADD CURRENT POINTER OFFSET S CLL RTR; RTR /8:11==>4:7 S AND (0017 S MQA S EXDMA1 C S TAD \IY S CLL RTR; RTR; RAR /8:11==>0:3 S AND (7400 S EXDMA2 C S TAD \IBYTE /SEE IF HIGH BYTE (IE. JHGH=1) S CLL RAR /PUT INTO LINK BIT S TAD (0200 /LOW S SZL S CLL RAL /0400 HIGH S TAD \ICMD /READ OR WRITE THE BUFFER FIELD S DMAGO S DCA 7 /ZERO COUNTER C S WAITZ, DMASKP S SKP S JMP RRT3BUF /DONE WITH I/O S ISZ 7 S JMP WAITZ /NOT YET S JMP \102 /OVERFLOW C C *********************************************************** C *SUBROUTINE D T E X T C ************************************************************ C DISPLAY TEXT IN IBUF[1:20] AT (MBM,IBYTE,IX,IY) C C S CPAGE 3 S RDTEXT, JMP I DTEXT S DTEXT, 0 /ENTRY C C [1] INIT ISHADE=IZ C C C [1.1] INITIALIZE POINTERS KTOP=IY KBOT=KTOP+5 C KLEFT=IX C C C [2] MAP CHARACTER AND POST DO 1987 J=1,40 KRITE=KLEFT+3 C IF KRITE > 255 C THEN DONE! S TAD (-D256 S TAD \KRITE S SMA CLA S JMP RDTEXT /YES, DONE! C C COMPUTE: IZ=((J-1)/2)+1 S CLA CMA S TAD \J S CLL RAR /"/2" S IAC /+1 S DCA \IZ C IX=IBUF(IZ) C C IF ODD(J) THEN BSW IX; C SET UP THE LINK BIT TO BE 1 FOR ODD J S TAD \J S CLL RAR S CLA C C IF LINK=1 THEN ODD; S TAD \IX S SZL /DON'T BSW EVEN J S BSW S AND (0077 C C IF OFFSET=0 THEN DONE S SNA S JMP RDTEXT /DONE! C S CLL RAL /MULTIPLY BY 2 C C C [2.1] GO LOOKUP THE CHARACTER S TAD PTAB /GET TABLE POINTER S TAD (-1 /FOR AUTOINDEX S DCA 11 /STUFF INTO AUTO-INDEX REGISTER S TAD I 11 /GET FIRST HALF OF BIT PATTERN S DCA SIXBIT# /PUT IT IN HI-ORDER HALF OF WORD S TAD I 11 /GET SECOND HALF OF BIT PATTERN S DCA SIXBIT /PUT IN IN LOW-ORDER HALF C C C [2.2] WRITE A CHARACTER DO 1988 IX=KLEFT,KRITE DO 1988 IY=KTOP,KBOT C S SWAB /CHANGE TO MODE B S CPAGE 14 S DAD /GET... S SIXBIT /DOUBLE PRECISION BIT PATTERN INTO AC-MQ S SHL /SHIFT LEFT.. S 0001 /...ONE PLACE (INTO LINK) S DST /RESTORE... S SIXBIT /...REMAINDER OF BIT PATTERN S CAM /CLEAN IT OUT S SWBA /RESTORE MODE A S SNL /SKIP ON ZERO LINK S JMP \1988 /DO NOT WRITE IT OUT C C DISPLAY THE LOC IZ=ISHADE S JMS PACK2D C 1988 CONTINUE C C INCREMENT LEFT PTR 1987 KLEFT=KLEFT+6 S JMP RDTEXT C ***************************************************** C *SUBROUTINE S E T B I T S C ************************************************************** C C SET BITS FOR BM MEM C C S CPAGE 3 S RSETBITS, JMP I SETBITS S SETBITS, 0 C C C [1] COMPUTE BASIC BIT PATTERN IMA=0 S DCA \IMB I=MEM+1 GOTO(1870,1871,1872,1873,1874,1875,1876,1877),I C 1870 IMA=8 GOTO 1879 1871 IMA=4 GOTO 1879 1872 IMA=2 GOTO 1879 1873 IMA=1 GOTO 1879 1874 IMB=8 GOTO 1879 1875 IMB=4 GOTO 1879 1876 IMB=2 GOTO 1879 1877 IMB=1 C 1879 CONTINUE C C C C C C C [2]SET DET VIDEO BITS IF JY=1 S CLA CMA S TAD \IY S SZA CLA S JMP \1878 /NO C C YES, SET BINARY DISPLAY BITS S TAD \IMA S CLL RTL;RTL S TAD \IMA S DCA \IMA C S TAD \IMB S CLL RTL; RTL S TAD \IMB S DCA \IMB C C C [3] SET IBYTE HIGH BYTE WORDS 1878 CONTINUE S TAD \IBYTE S SNA CLA S JMP RSETBITS /NO C S TAD \IMA /GET MEM NUMBER OF "SOURCE" S AND (0017 /ONLY KEEP MEM NUMBER S CLL RTR; RTR; RAR /MOVE BITS 8-11 TO 0-3 S TAD \IMA /ADD ON BITS 4-11 S DCA \IMA /FORM FINAL WORD S TAD \IMB /REPEAT FOR GROUP B... S AND (0017 S CLL RTR; RTR; RAR S TAD \IMB S DCA \IMB /...SAVE C C C C C S JMP RSETBITS C C C ************************************************************ C *SUBROUTINE B C D T O F L O A T C ************************************************************ C CVT (IMA,IMB) IN BCD TO FLOATING PT # FFF C S CPAGE 3 S RBCDTOFLOAT, JMP I BCDTOFLOAT S BCDTOFLOAT, 0 C FFF=FLOAT(IBCD(IMB,0))*1000.0 + FLOAT(IBCD(IMA,0)) S JMP RBCDTOFLOAT C C C C ************************************************************ C SUBROUTINE: T T Y C T L (INTERNAL) C ************************************************************ C S CPAGE 3 S RTTYC, JMP I TTYCTL S TTYCTL, 0000 /ENTRY C S KSF /ANYTHING TYPED S JMP NORMAL /NO, RETURN NORMALLY S KRB /GET TYPED CHARACTER S AND (0177 /TAKE CARE OF PARITY PROBLEMS S TAD (-17 /TEST FOR CTRL/O S SNA /SKIP IF NOT CTRL/O S JMP RTTYC /ABORT CALLING ROUTINE (ERROR RETURN) S TAD (-4 /TEST FOR CTRL/S [-17-4=-23(OCTAL)] S SZA CLA /SKIP IF CTRL/S S JMP NORMAL /NOT CTRL/O OR CTRL/S SO RETURN NORMALLY C S SLEEP,KSF /WAIT FOR CTRL/Q S JMP SLEEP /KEEP WAITING S KRB /READ CHARACTER S AND (0177 S TAD (-17 /IS IT A CTRL/O? S SNA /SKIP IF NOT S JMP RTTYC /YES, ABORT S TAD (-2 /TEST FOR CTRL/Q (-17-2=-21 OCTAL) S SZA CLA /SKIP IF SO S JMP SLEEP /NOPE, KEEP SLEEPING C S NORMAL,INC TTYCTL /INCREMENT RETURN ADDRESS FOR NORMAL RETURN S CLA /SAFETY VALVE S JMP RTTYC /RETURN C C POINTERS C -------- S PBMX0, BMX0 S PBMX4, BMX4 S PBMY0, BMY0 S PBMY4, BMY4 S PIBUF, \IBUF S PTAB, TABLE C S CPAGE 2 S SIXBIT, BLOCK 2 C S PBUFF, BUFF S CPAGE 2 S BUFF, BLOCK 2 C C C C C C POINTERS C -------- S CPAGE 2 S BB, BLOCK 2 S CPAGE 2 S CC, BLOCK 2 S CPAGE 2 S EX1, 0000 S EX2, 0000 S W1, 0 S W2, 0 S B1, 0 S B2, 0 S B3, 0 C IPSTA=0 IPSTB=0 C S MEMBACK, -1 /START OFF AS -1 S LAP S PAGE S TABLE, 0000 /@ S 0000 S 7744 /A S 4477 S 7751 /B S 5126 S 3641 /C S 4122 S 7741 /D S 4136 S 7745 /E S 4541 S 7744 /F S 4440 S 3641 /G S 4526 S 7710 /H S 1077 S 4177 /I S 4100 S 4241 /J S 7640 S 7710 /K S 2443 S 7701 /L S 0103 S 7730 /M S 3077 S 7730 /N S 0677 S 3641 /O S 4136 S 7744 /P S 4430 S 7642 /Q S 7603 S 7744 /R S 4631 S 2151 /S S 5146 S 4040 /T S 7740 S 7701 /U S 0177 S 7601 /V S 0274 S 7706 /W S 0177 S 6314 /X S 1463 S 7007 /Y S 0770 S 4345 /Z S 5161 S 7741 /[ S 0000 S 6010 /\ S 0403 S 0000 /] S 4177 S 0010 /^ S 2010 S 0101 /_ S 0101 S 0000 /SPACE S 0000 S 0075 /! S 0000 S 6000 /" S 0060 S 7227 /# S 7227 S 0677 /$ S 7730 S 6374 /% S 2543 S 6625 /& S 1067 S 0000 /' S 6000 S 3641 /( S 0000 S 0000 /) S 4136 S 2214 /* S 1422 S 1034 /+ S 1000 S 0102 /, S 0000 S 1010 /- S 1000 S 0303 /. S 0000 S 0304 // S 1060 S 7745 /0 S 5177 S 0121 /1 S 7701 S 2345 /2 S 5121 S 2241 /3 S 5126 S 1424 /4 S 7704 S 7251 /5 S 5106 S 0615 /6 S 2542 S 4344 /7 S 5060 S 2651 /8 S 5126 S 2051 /9 S 5136 S 0063 /: S 6300 S 6162 /; S 0000 S 1024 /< S 4200 S 2222 /= S 2222 S 0042 /> S 2410 S 5550 /? S 2000 C C C END