C PROGRAM BGETPUT.FT C ----------------- C C C## SUBROUTINE BGETPUT(IOPR) C C C C C P. LEMKIN C NATIONAL INSTITUTES OF HEALTH C BETHESDA, MD 20014 C C C C MARCH 9, 1977 C MARCH 7, 1977 C MARCH 4, 1977 C FEB 28, 1977 C FEB 26, 1977 C FEB 14, 1977 C FEB 10, 1977 C FEB 9, 1977 C FEB 8, 1977 C JAN 27, 1977 C JAN 26, 1977 C C C C INTRODUCTION C ------------ C BGETPUT IMPLEMENTS THE GENERAL PURPOSE TRANSFER C BETWEEN RTPP DEVICES (BM0-BM7,QMT,MASK,BOUNDARY,DICMED, C GALSCAN) AND DISK DATA FILES. THE DATA FILE FORMATS C ARE DISCUSSED IN DETAIL IN DDTG.DOC. C C C C ALL PUTS FIRST LOOKUP THE FILE C IN FILE SPACE, THEN READ THE HEADER, THEN C DISPATCH TO THE ACTUAL I/O TRANSFER OPERATION. C C C IOPR FUNCTION C ---- -------- C 1 GET - SAVE THE KSUBTYPE. C 2 PUT - LOAD THE DATA SPACE FROM "FILESPEC". C C C ARGUMENTS IN COMMON C ------------------- C DEVICE - A4 DEVICE NAME FROM "FILESPEC" C IDEVICE - DEVICE NUMBER FROM "FILESPEC" C FILE - A6 FILE NAME FROM "FILESPEC" C EXT - A2 FILE EXTENSION FROM "FILESPEC" C KSUBTYPE= DATA SUB TYPES USED 1:17 SET BY XMITBM. C MODECOMMENT - SET TO /C (ISW(3). 1 TO USE COMMENT FIELD C 0 TO IGNORE IT. C LSUCLASS - 1 TO WAIT FOR KEYPAD # (SET BY /K) ON PUT. C 0 TO NOT WAIT. C C LOGICAL STRUCTURE OF BGETPUT C --------------------------- C BGETPUT IS PRIMARILY USED TO TRANSFER FILES C FROM DEVICES (GET) OR TRANSFER FILES TO DEVICES (PUT). C ON ENTRY, AFTER CHECKING FOR A LEGAL IOPR OPERATION, C CONTROL IS DIVIDED AT [2] INTO TWO MAJOR PATHS. C C C C THE GET DISPATCHES [2.2.1] DOES THE FOLLOWING: C [1] ENTERS THE SPECIFIED OUTPUT FILE, [2] CALLS C "WRTHEADER" TO COMPUTE (USING TABLE LOOKUP C "MT" TABLE) THE HEADER BLOCK FROM THE KSUBTYPE C SWITCH VALUES, AND [3] DISPATCHES THE GET OPERATION C AS A FUNCTION OF KSUBTYPE. THESE SERVICE ROUTINES C ARE CODED AS FOLLOWS: LABELS "N00" TO "N49" (WHERE N IS C 1 TO 16) ARE THE [G.] SERVICE ROUTINES. C C A TYPICAL "GET" SERVICE WILL GET THE C REQUIRED DATA AND WRITE IT OUT IN THE FILE AND C GOTO [G.1] TO CLOSE THE FILE AND RETURN. C C THE PUT DISPATCHER [2.2.2] [1] FIRST C LOOKS UP THE INPUT FILE AND READS THE HEADER C BLOCK INTO IBUF4[1:256], [2] COPIES THE HEADER C INFORMATION INTO THE LOCAL HEADER VARIABLES C AND TESTS IF THE DATA FILE IS VALID BY THE C MODE OF BE DATA FILE BEING LEGAL. IT THEN [3] C DISPATCHES THE PUT OPERATION AS A FUNCTION OF C KSUBTYPE. THESE ARE SERVICED WITH CODE LABELS: C "N50" TO "N99" WHERE N IS 1 TO 17. THE PUT C SERVICE ROUTINE HAS COMMENT LABELS [P.]. C C A TYPICAL "PUT" OPERATION WILL ANALYZE C BOTH GIVEN AND HEADER SWITCHES, DISPATCH ACCORDINGLY, C TRANSFER DATA FROM THE FILE TO THE DEVICE, AND C THEN RETURN FROM BGETPUT. C C C THE "BDOAUX" INTERNAL SUBROUTINES ARE DESIGNED C WITH THE SUPPORT OF GET/PUT SERVICE IN MIND. C C C EXTERNAL SUBROUTINES CALLED BY BGETPUT C ------------------------------------- C 1. IO.FT - CHARACTER AND BLOCK I/O C 2. DICMED.FT - DICOMED HANDLER C 3. BDOAUX.FT - AUXILLARY SUBROUTINE PACKAGE. C 4. PHEADER - PRINT THE HEADER AFTER IT IS READ==>IBUF4 C C C PDP8E IOTS NOT DEFINED IN SABR C ------------------------------- S OPDEF RDF 6214 /READ DATA FIELD INTO AC[6:8] S OPDEF CLAMQ 7621 /CLA MQL S OPDEF SWP 7521 S OPDEF BSW 7002 S OPDEF MQL 7421 S OPDEF MQA 7501 S OPDEF MUY 7405 S OPDEF DVI 7407 S OPDEF SHL 7413 /SHIFT LEFT S OPDEF LSR 7417 /LOGICAL SHIFT RIGHT S OPDEF SWAB 7431 S OPDEF SWBA 7447 S OPDEF DAD 7443 S OPDEF DST 7445 C C S OPDEF DISP1 6435 S OPDEF DISP2 6436 C S OPDEF STQMT 6300 /START THE QMT SCAN S SKPDF QMSKP 6301 /SKIP WHEN QMT SCAN DONE C C S OPDEF CSRGI 6315 /ZERO THE SRG INDEX CNTR S SKPDF IZSKP 6317 /SKIP WHEN SSRGI IS DONE S OPDEF ZSRGI 6316 /ADVANCE THE SRG INDEX CNTR C /AND SRG TO 0.(MOVE DATA TO FRONT). S OPDEF RSRGI 6332 /READ SRGI==>AC S OPDEF QSTAT 6374 /LOAD THE QMT STATUS REGISTER S OPDEF RQSTAT 6327 /READ THE QMT STATUS REG==>AC C S OPDEF QPROG2 6371 /LOAD MASK-F&S ALU BITS 0:3. S OPDEF QPROG7 6433 /MASK REGISTER DISPLAY - NOTE: DISPLAY ONLY... C S OPDEF TADI 1400 S OPDEF DCAI 3400 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 C C COMPILE AS: C ---------- C .R FORT C *BGETPUT.RL,BGETPUT.LS 17 C C GOTO(150,250,95,95,95,95,750,750,95,95,95,95,1350,1450 1,95,95,1750,1850),MSUBTYPE C C C C C *************************************** C * G E T O P R S * C *************************************** C [G.1] GET THE BUFFER MEMORIES. IT USES 2 BM DMA MODES: C HIGH BYTE, LOW BYTE. THEY DIFFER C ONLY IN WHICH BYTE OF THE 16-BIT BM WORD IS TRANSFERED C BY THE DMA. BYTE DATA IS PACKED 3/2 . C S DUMMY BMBUFFER S CPAGE 2 S BMBUFFER, 6271 /CDF 70 S 0000 /USE BOTTOM 1/2 OF FIELD 7 C C C DO A READ BM - WRITE IO 100 IOCMD=7 C C ## ENTER HERE FOR BOTH GET AND PUT BM DMA IO ### C WITH IOCMD=7 FOR GET, C WITH IOCMD=6 FOR PUT. C 107 IBMCTL=0000 C C TEST IF HIGH BYTE S TAD \IBYTE S SZA CLA S TAD (0200 /HIGH 8-BITS S TAD (0200 /LOW 8-BITS S DCA \IBMCTL C C SET UP THE FILE BLOCK COUNTER NBLOCKS=171 C C SET THE BYTE SIZE TO 8 BITS M8OR16=0 C C C C [G.1.0.1] ************ ENTRY HERE FOR 16-BIT DATA******** 108 CONTINUE C C SETUP THE BUFFER SIZE NBFSIZE=9 C SET UP FOR LOW BYTE C DETERMINE THE DATA BYTE MODE - DEFAULT TO LOW BYTE C C SETUP THE DATA FIELD FOR BUFFER S TAD BMBUFFER /DATA FIELD FOR BUFFER S AND (0070 S TAD \IBMCTL S DCA \IBMCTL C S DMACLR /CLEAR THE CHANNEL AND ADDRESSES C C ***NOTE STORE THE ADDRESS IN IA WHICH IS IN COMMON*** S DCA \IA /ZERO THE LOW ORDER ADDRESS S TAD \MEM /SET BY XMITBM C THE BM# IS SPECIFIED IN BITS [5:7] OF THE HIGH ORDER ADDRESS S RTL; RTL S AND (0160 S DCA \IA# /LOAD HIGH ORDER C C C [G.1.1] DO (NBLOCKS/NBFSIZE) NBFSIZE-BLOCK TRANSFERS 101 KWC=NBFSIZE NBLOCK=NBLOCK-NBFSIZE C IF NBLOCK < 0 C THEN KWC=NBFSIZE+NBLOCK ELSE KWC=NBFSIZE; S TAD \NBLOCK S SMA CLA S JMP \102 /.GE. 0 C KWC=NBFSIZE+NBLOCK C C SET UP THE WORD COUNT AND CURRENT ADDRESS REGISTERS C DISPLAY CURRENT BLOCK # S\102, TAD \NBLOCK S DISP1 C S TAD BMBUFFER# S DMACA C C LOAD THE WORD COUNT REGISTER WITH (256*KWC) WORDS. S TAD \KWC S MQL S CPAGE 2 S MUY S 400 /256 S CLA S MQA /256*KWC S DCA \IZ C IF THIS IS THE LAST BLOCK, THEN DO (256*KWC-84) S TAD \NBLOCK S SNA CLA S TAD (-D84 /LAST BLOCK OFFSET S TAD \IZ S DMAWC C C SETUP THE CURRENT ADDRESS FOR BM DMA S TAD \IA# S EXDMA1 /LOAD HIGH ADDRESS S TAD \IA S EXDMA2 /LOAD LOW ADDRESS C C COMPUTE FUTURE BM DMA ADDRESS (NOTE: 8-BITS=(3/2)12-BITS): C IA_IA+(3/2)*128*(M8OR16+1)*KWC [ I.E. 192*(M8OR16+1)*KWC] S TAD \M8OR16 S SNA CLA S TAD (D192 S TAD (D192 S DCA MSIZE C S TAD \KWC S MQL S CPAGE 2 S MUY S MSIZE, 600 /D384 S CLA S MQA S DCA \IZ /(384*KWC) C S CPAGE 11 S TAD \IZ S SWAB /MODE B AND MQL C S DAD S \IA C S DST S \IA C S CLAMQ S SWBA C C C IF "GET" THEN DO DMA BM READ BEFORE IO WRITE (BM==>DSK) S CLA CMA S TAD \IOPR S SZA CLA S JMP \105 /NO DO THE "PUT" IO READ THEN BM DMA WRITE C C LOAD THE "GET" GO WORD AND GO C NOTE: R/W BIT IS 0 FOR READ S TAD \IBMCTL /I/O CONTROL WORD S DMAGO S DMAGET, DMASKP S JMP DMAGET /NOT YET C S\105, TAD BMBUFFER /COPY POINTER S DCA PBARG S TAD BMBUFFER# S DCA PBARG# C S CALL 4,IO S ARG \KWC /15 BLOCKS OR LESS S PBARG, ARG BMBUFFER /POINTER S ARG (0 S ARG \IOCMD C C IF IOERROR THEN GOTO 96 S SZA CLA S JMP \96 /IO ERROR C C TEST IF DO "PUT" THEN DO DMA WRITE S TAD (-2 S TAD \IOPR S SZA CLA S JMP \104 /NO, IT MUST BE A GET C C LOAD THE "PUT" GO WORD AND GO S TAD (4000 /DO A WRITE S TAD \IBMCTL S DMAGO S DMAPUT, DMASKP S JMP DMAPUT C C C TEST IF DONE WITH I/O C IF NBLOCK LEQ 0 C THEN DONE ELSE GOTO 101 S \104, CLA CMA S TAD \NBLOCK S SMA CLA S JMP \101 /CONTINUE C C RETURN BY CLOSING FILE IF 'GET' ELSE JUST RETURN FOR 'PUT' S CLA CMA S TAD \IOPR S SNA CLA S JMP \98 /CLOSE FILE AND RETURN FOR 'GET' S JMP \2047 /JUST RETURN FOR 'PUT' C [G.2] GET 16-BIT BM DATA 200 IOCMD=7 C C SETUP DMA WORD S TAD (0600 /16-BIT PACKED DMA S DCA \IBMCTL C C SET FILE BLOCK SIZE NBLOCKS=342 C C SET BYTE SIZE TO 16 BITS M8OR16=1 C C CONTINUE AT [G.1.0.1] GOTO 108 C [G.4] GET QMT FUNCTION COMPUTER DATA 400 CONTINUE C FIRST RUN THE QMT C C C PROGRAM FC1/FC2 6X10 IN QPROG7 PROGRAMS FC1=X, FC2=AREA C ISW(28) EQV /1 C DEFAULT IS AREA,AREA IPROGRAM=2 S TAD (0210 S QPROG7 C DO 410 IX=28,34 IY=ISW(IX) S TAD \IY S SNA CLA S JMP \410 C OK, LOAD THE QPROG WORD S TAD \IX S TAD (-D27 /1:7 S DCA \IPROGRAM S TAD \IPROGRAM S BSW /MOVE TO LEFT BYTE S AND (0700 S TAD (0010 /PROGRAM FC1=IX-27,FC2=AREA S QPROG7 410 CONTINUE C S RQSTAT /SAVE STATUS S AND (7377 /FORCE THE DATA ROTATE BIT ON S MQL C S MQA /OR THEM TOGETHER S TAD (0400 /ENABLE STACK S QSTAT C S CSRGI /ZERO THE INDEX COUNTER S STQMT /START THE SCAN S G4W, QMSKP /DONE? S JMP G4W /NO C S TAD \IFILTOP /GET BACK OLD QPROG7 STATUS S QPROG7 C S MQA /GET BACK THE OLD STATUS S QSTAT C C [G.4.1] FIND OUT THE NUMBER OF ENTRIES S RSRGI S DCA \LPTR C ADVANCE THE SHIFT REGISTER SO DATA IS IN FRONT OF STACK. S ZSRGI S G4, IZSKP /SKIP WHEN DONE S JMP G4 /NOT YET C C C [G.4.2] TRANSFER QMT DATA TO THE FILE DO 401 MDX=1,6 C DO RQMT OPERATION C READ QMT DATA==>IBUF1[1:768] C CALL BDOAUX(KRQMT) C WRITE 3 BLOCKS FROM IBUF1[1:768] IF(IO(3,IBUF1,0,7))96,401,96 401 CONTINUE C C C [G.4.3] GO CLOSE THE FILE GOTO 98 C C C [G.7] GET BOUNDARY C **** FOR NOW - IF SIGN BIT THEN DUMP*** C C [G.7.1] ASSIGN MEMORY 700 MEM=IBM1 IBYTE=IHGH1 C C [G.7.2] DO RASTER SCAN DO 701 IY1=KY1,KY2 IY=IY1-1 S TAD \IY S DISP2 C S CPAGE 3 S JMS TTYCTL S JMP \2047 C DO 701 IX1=KX1,KX2 IX=IX1-1 S TAD \IX S DISP1 C C [G.7.2.1] GET PIXEL AND TEST IF > 128 CALL FETCH2D S TAD \IZ S TAD (-D128 S SPA CLA S JMP \701 /NO C C C [G.7.2.2] ACTIVE LINE PIXEL S TAD \IX S CALL 0,OUTC S TAD \IY S CALL 0,OUTC 701 CONTINUE C C C [G.7.3] WRITE THE EOF DO 703 IX=1,6 S CALL 0,OUTC 703 CONTINUE GOTO 98 C C C [G.9] GET GALVANOMETER SCANNER 900 CONTINUE C C CASE MODE PACKED SWITCHES C ---- ---- ------ -------- C 9 256 RASTER 2/3 - C C C [G.9.1] FORCE THE SIZE OF THE SCAN TO BE 256X256 KGALPNT=2 KX1=384 KY1=384 KX2=KX1+255 KY2=KY1+255 C C DO 256 LINES DO 903 IY1=KY1,KY2 IY=IY1-1 C C DISPLAY THE LINE S TAD \KY1 S CIA S TAD \IY S DISP2 C C C IF ^O THEN WRITE OUT LAST LINE OF BUFFER S CPAGE 3 S JMS TTYCTL S JMP \904 /EXIT C C C [G.9.2] DO A PRESCAN OF 50 PIXELS C SO REACH CONSTANT VELOCITY IX2=KX1-50 DO 902 IX1=IX2,KX1 IX=IX1-1 C DO GALPNT OPERATION (IX,IY)==>GALV,DATA==>IZ CALL BDOAUX(KGALPNT) 902 CONTINUE C C C [G.9.3] SCAN DATA FOR 1 LINE AT IY C RESET THE BUFFER PTR S CLA CMA S TAD PBUF4 S DCA 17 S TAD 17 S DCA 16 C DO 901 IX1=KX1,KX2 IX=IX1-1 C C DISPLAY THE LINE S TAD \KX1 S CIA S TAD \IX S DISP1 C C DO GALPNT OPERATION (IX,IY)==>GALV, DATA==>IZ CALL BDOAUX(KGALPNT) C C C [G.9.3.1] STORE THE VALUE IN IBUF4 S CPAGE 4 S TAD \IZ /GET THE VALUE AND FORCE D.F. TO COMMON S DCAI 17 /PUSH VIA AUTOINDEX 901 CONTINUE C C C C [G.9.4] WRITE OUT THE LINE AT THIS TIME C RATHER THAN WHEN DID SCAN SO DON'T HALT SCAN DURING I/O. C 904 DO 903 IX=1,256 S CPAGE 4 S DCA \IZ /SET DF TO 1 S TADI 16 /GET IBUF4(IX) S CALL 0,OUTC 903 CONTINUE C C DONE, WRITE THE EOF GOTO 98 C C C C [G.13] GET THE HEADER STATE 8-TUPLES (8 D.P. STATE WORDS IN C CURRENT). C C THE CURREN IS COPIED FROM COMMON ARRAY MDPDATA(*,7:8) C FOR *=[1:12]. THIS IS DONE IN WRTHEADER (BDOAUX). THEREFORE, C THE ONLY THING WHICH REMAINS TO BE DONE IS TO CLOSE THE FILE. 1300 GOTO 98 C C C [G.14] GET BINARY MASK 1400 CONTINUE C [G.14.1] ASSIGN MEMORY MEM=IBM1 IBYTE=IHGH1 C C [G.14.2] DO RASTER SCAN DO 1401 IY1=1,256 IY=IY1-1 S TAD \IY S DISP2 C S CPAGE 3 S JMS TTYCTL S JMP \2047 C DO 1401 IX2=1,256,8 KX1=IX2 KX2=IX2+7 LSFILL=0 C C ASSEMBLE 8 PACKED BINARY PIXELS DO 1402 IX1=KX1,KX2 IX=IX1-1 S TAD \IX S DISP1 C ROTATE THE WORD S TAD \LSFILL S RAL S DCA \LSFILL CALL FETCH2D S TAD \IZ S AND (0200 /GET BIT S SZA CLA S IAC /MAKE IT 1 IF ON S TAD \LSFILL S DCA \LSFILL 1402 CONTINUE C C C [G.14.2.1] DUMP THE PACKED PIXELS S TAD \LSFILL S CALL 0,OUTC 1401 CONTINUE C C C [G.14.3] WRITE THE EOF DO 1403 IX=1,6 S CALL 0,OUTC 1403 CONTINUE GOTO 98 C C [G.16] GET LINE DRAWING 1600 CONTINUE GOTO 100 C C C C *************************************** C * P U T O P R S * C *************************************** C C C [P.1] PUT BM 8BIT RASTER C ONLY 256 SQ WINDOWS MAY BE WRITTEN TO BM'S. C 150 IOCMD=6 C FINISH I/O WITH GET BM. GOTO 107 C C C [P.2] PUT 16-BIT BM DATA 250 IOCMD=6 C C SETUP DMA WORD S TAD (0600 /16-BIT PACKED DMA S DCA \IBMCTL C C SET BYTE SIZE TO 16 BITS M8OR16=1 C C SET FILE BLOCK SIZE NBLOCKS=342 C C CONTINUE AT [G.1.0.1] GOTO 108 C C C [P.7] PUT BM 8-BIT VECTOR 750 CONTINUE GOTO 850 C C [P.8] PUT BM 8-BIT NO VECTOR 850 CONTINUE C VERIFY THAT IT IS EITHER A TYPE 7 OR 8 S TAD \KSUBTYPE S TAD (-D7 S SPA CLA S JMP \99 /FAILED S TAD \KSUBTYPE S TAD (-D9 S SMA CLA S JMP \99 /FAILED C C SETUP THE MEMORY MEM=JBM IBYTE=JHGH C C READ (X,Y) PAIRS UNTIL 3 (0,0) PAIRS C NOTE 1 (0,0) IS DATA. 2(0,0) IS SPACE BETWEEN BOUNDARIES. IEOF=-3 851 CONTINUE S CPAGE 3 S JMS TTYCTL S JMP \2047 /ESCAPE C S CALL 0,INNC S DCA \IX S CALL 0,INNC S DCA \IY C S TAD \IX S TAD \IY S SZA CLA S JMP \853 /NO C S ISZ \IEOF /TEST IF DONE S JMP \851 /NOT YET, MAY BE DATA S JMP \2047 /DONE (WAS EOF) C C IF EOF IEOF =-2 C THEN OUTPUT (0,0) BEFORE CONTINUE. C IF EOF =-1 C THEN END OF BOUNDARY. 853 IVAL=-IEOF GOTO(861,862,863),IZ C !!! END OF BOUNDARY!!! 861 CONTINUE GOTO 851 C C !!! (0,0) DATA, OUTPUT IT!!! C SAVE CURRENT (X,Y) 862 IX1=IX IY1=IY IZ=255 IX=0 IY=0 CALL PACK2D IX=IX1 IY=IY1 C C !!! NORMAL DATA !!! 863 IZ=255 CALL PACK2D C RESET THE EOF FLAG IEOF=-3 GOTO 851 C [P.13] PUT THE HEADER "STATE" INTO THE DESIRE VALUES C USING MOTORS, THEN USE MVMTR TO CHANGE CURREN. C SET THE POINTER TO THE STATE VECTOR IN THE HEADER C READ THE 8 D.P. TUPLES FROM THE INPUT FILE HEADER TO DESIRE. 1350 DO 1352 MTRNUM=1,8 C DO 1351 J=1,2 1351 IA(J)=IBUF4(52+ (8*(MTRNUM-1)+(J-1))) S TAD \IA S DCA \MLOVAL S TAD \IA# S DCA \MHIVAL C C NOTE: MDPDATA(MTRNUM[1:12], IFUNCTION[1:8]) C C MOVE THE MOTOR ABSOLUTE AND CHECK FOR ERROR MTROP=4 CALL MOTORS IF(IERRNUM)2047,1352,2047 1352 CONTINUE C C GO MOVE EVERYTHING 1353 IF(MACTIVE)1354,2047,1354 1354 CALL MVMTR GOTO 1353 C C C [P.14] PUT BINARY MASK 1450 CONTINUE C CHECK TO SEE IF DATA TYPE IS VALID IF(KSUBTYPE-14)99,1459,99 1459 CONTINUE C [P.14.1] ASSIGN MEMORY MEM=JBM IBYTE=JHGH C C [P.14.2] DO RASTER SCAN DO 1451 IY1=1,256 IY=IY1-1 S TAD \IY S DISP2 C S CPAGE 3 S JMS TTYCTL S JMP \2047 C DO 1451 IX2=1,256,8 KX1=IX2 KX2=IX2+7 C GET 8-BITS OF PIXELS PACKED S CALL 0,INNC S DCA \LSFILL C C DIS-ASSEMBLE 8 PACKED BINARY PIXELS DO 1452 IX1=KX1,KX2 IX=IX1-1 S TAD \IX S DISP1 S TAD \LSFILL S AND (0200 S SZA CLA S TAD (D255 /BIT WAS ON S DCA \IZ CALL PACK2D C ROTATE THE WORD S TAD \LSFILL S RAL S DCA \LSFILL 1452 CONTINUE C 1451 CONTINUE C C GOTO 2047 C C [P.17] PUT LINE DRAWING 1750 CONTINUE GOTO 150 C C C C [P.18] PUT DICOMED DISPLAY C THERE ARE 4 POSSIBLE FILE DATA TYPES C WHICH COULD BE PUT ONTO THE DICOMED. C CASE SUBTYPE MODE TYPE OF DATA C ---- ------- ---- ------------ C C . RASTERS - 256 POINT RASTERS START AT (IX,IY). C 1 BM (2/3 WORD), 256 PT PACKED C 7 XY VECTOR 8-BIT PACKED X,Y DATA C 8 XY NO VECTOR 8-BIT PACKED X,Y DATA C 9 GAL-SCN (2/3 WORD), 256PT PACKED C C 1850 IEOF=-3 C C C IF /E THEN ERASE THE DICOMED FIRST IF(ISW(5))1888,1884,1888 1888 CALL DICMED(4) C C GET THE CURRETN F&S POSITION TO BE USED TO POSITION THE C DICOMED WINDOW C IF /F C THEN (IXPOSITION, IYPOSITION<==ICNUM[1:2]) 1884 LSUDIC=ISW(6) C C DEFAULT TO /F IXPOSITION=ICNUM S TAD \ICNUM# S DCA \IYPOSITION C S TAD \LSUDIC S SZA CLA S JMP \1887 /USE /F LCS SUPPLIED COORDINATES C ELSE C GET THE F&S CALL BDOAUX(KGETWINDOW) C C 1887 GOTO(1854,95,95,95,95,95,1851,1851,1854,95,95,95,95 1,95,95,95,95),KSUBTYPE C C [P.18.1] 8-BIT VECTOR. READ UNTIL EOF C VERIFY THAT IT IS EITHER A TYPE 7 OR 8 S \1851, TAD \KSUBTYPE S TAD (-D7 S SPA CLA S JMP \99 /FAILED S TAD \KSUBTYPE S TAD (-D9 S SMA CLA S JMP \99 /FAILED C LSUDIC=10 C SETUP THE MEMORY MEM=JBM IBYTE=JHGH C C READ (X,Y) PAIRS UNTIL 3 (0,0) PAIRS C NOTE 1 (0,0) IS DATA. 2(0,0) IS SPACE BETWEEN BOUNDARIES. IEOF=-3 1856 CONTINUE S CPAGE 3 S JMS TTYCTL S JMP \1899 /ESCAPE C S CALL 0,INNC S DCA \IX S CALL 0,INNC S DCA \IY C S TAD \IX S TAD \IY S SZA CLA S JMP \1853 /NO C S ISZ \IEOF /TEST IF DONE S JMP \1856 /NOT YET, MAY BE DATA S JMP \1899 /DONE (WAS EOF) C C IF EOF IEOF =-2 C THEN OUTPUT (0,0) BEFORE CONTINUE. C IF EOF =-1 C THEN END OF BOUNDARY. 1853 IVAL=-IEOF GOTO(1861,1862,1863),IZ C !!! END OF BOUNDARY!!! 1861 CONTINUE C ***** PUT CODE HERE TO PICK UP PARTICULAR BOUNDARY**** GOTO 1856 C C !!! (0,0) DATA, OUTPUT IT!!! C SAVE CURRENT (X,Y) 1862 IX1=IX IY1=IY IZ=255 IX=IXPOSITION IY=IYPOSITION CALL BDOAUX(KDICPNT) IX=IX1 IY=IY1 C C NORMAL DATA 1863 IX=IX+IXPOSITION IY=IY+IYPOSITION IX=255 CALL BDOAUX(KDICPNT) C RESET THE EOF FLAG IEOF=-3 GOTO 1856 C C C [P.18.2] RASTERS. SCAN THROUGH LINES C READ INTO IBUF4[1:256] FOR 256 LINE C THEN CALL DICMED(1) AND INCREMENT IY C EACH CALL. 1854 LSUDIC=1 C C C [P.18.2.1] DO 256 LINES C FORCE THE SIZE TO BE 256X256 C DO 1875 IY1=1,256 IY=IY1-1 S TAD \IY S DISP2 C C TEST IF EXIT S CPAGE 3 S JMS TTYCTL S JMP \1899 C C C [G.18.2.2] COPY 1 LINE INTO THE BUFFER (256) C RESET BUFFER POINTER S CLA CMA S TAD PBUF4 S DCA 17 C DO 1876 IX1=1,256 S CALL 0,INNC S DCA \IZ S CPAGE 4 S TAD \IZ S DCAI 17 /IBUF4(IX1) 1876 CONTINUE C C C [P.18.2.3] GO DISPLAY A LINE C AT (IX,IY) IX=IXPOSITION IY=IYPOSITION+(IY1-1) CALL BDOAUX(KDICPNT) 1875 CONTINUE C C C [P.18.3] TURN ON THE VIEW LIGHT 1899 CALL DICMED(7) GOTO 2047 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 ******PARAMETERS***** S PBUF1, \IBUF1 S PBUF4, \IBUF4 END