C PROGRAM DICMED.FT C ----------------- C C## SUBROUTINE DICMED(IOPR) C C P. LEMKIN C NATIONAL INSTITUTES OF HEALTH C BETHESDA, MD 20014 C C C C APRIL 15, 1975 C REVISED APRIL 16, 19755 C REVISED APRIL 19, 1975 C REVISED APRIL 24, 1975 C REVISED MAY 21, 1975 C REVISED MAY 22, 1975 C REVISED AUGUST 14, 1975 C REVISED OCT 21, 1975 C REVISED NOV 4, 1975 C C C C INTRODUCTION C ------------ C *EX* SUBROUTINE DICMED IS A FORTRAN CALLABLE C HANDLER FOR THE DICOMED MODEL 31 GRAY SCALE STORAGE C DISPLAY. THE DICOMED IS DOCUMENTED IN THEIR MANUAL C NUMBER 12M005 "OPERATOR AND PROGRAMMING MANUAL". C C SUBROUTINE DICMED IS CALLED WITH THE C COMMAND IN IDOPR, (X,Y,Z) IN (IX,IY,IZ) (IF C APPLICABLE), RASTER DATA IN COMMON IBUF4[1:256] C DATA IS IN THE GRAY SCALE RANGE OF [0:255] WHERE ONLY C THE 6 MOST SIGNIFICANT BITS ARE USED TO DISPLAY [0:63] C GRAY LEVELS. IT USES INTERNAL SUBROUTINES DICSND, DICOUT. C C THE INTERFACE USES A 9 BIT PARALLEL INTERFACE C DESIGNED AT NIH (IPU) BY GEORGE CARMAN AND PETER C LEMKIN. THE DATA TO THE DICOMED IS LOADED WITH THE C (DICO) COMMAND FROM AC[3:11] AND FROM C AC[0] FOR THE CONTROL BIT. A TEST AND SET (DICSKP) C FLIP-FLOP IS USED TO SKIP WHEN DATA IS DONE. C THE PDP8E MQ REGISTER IS USED C IN THE HANDLER TO STORE Z VALUES. C C NOTE: PROGRAM GRFDRW.FT CAN DRAW WITH THE C VIEW LIGHT ON. IT DOES NOT START OFF C ERASING THE SCREEN. IT DOES (RESET,BEGIN, C DATA....). IF YOU ERASE THE SCREEN (AFTER C POWERING IT UP THEN YOU HAVE TO DIDDLE C WITH THE VIEW LIGHT. C C IDOPR COMMAND C ----- ------- C 1 DISPLAY 256 POINT LINE DENSITY Z IN IBUF4[1:256], C LEFT EDGE IS GIVEN BY IY,IY. C 2 BEGIN PICTURE - ENABLE INPUT DATA, TURN OFF C VIEW LIGHT, TURN OFF IMAGE WAITING LIGHT. C 3 END PICTURE - TERMINATE DATA IN, ENABLE VIEW LIGHT. C 4 ERASE CURRENT IMAGE AND WAIT 20 SECONDS. C 5 SET IMAGE NORMAL (0 IS BLACK , 255 WHITE) C 6 SET IMAGE NORMAL (255 IS BLACK , 0 WHITE) C 7 TURN ON IMAGE WAITING LIGHT C 8 SET GAMMA CORRECTOR ON. C 9 RESET - SET LOGIC IN OPERATE MODE, (HOR,VERT) C COUNTERS TO (0,0), IMAGE WAITING LIGHT C ON IF ENABLED, IMAGE NORMAL MODE. C 10 DISPLAY POINT IN (IX,IY,IZ) C 11 DISPLAY THE 1024 LINE IN IBUF1[1:1024] C AT LINE IY. C C C COMPILE AS: C ---------- C .R FORT C *DICMED.RL,DICMED.LS B (ALSO DOES AN MQL) S OPDEF SWBA 7447 /B ==> A S OPDEF DAD 7443 S OPDEF DST 7445 S OPDEF DPIC 7573 S OPDEF DCM 7575 S OPDEF DPSZ 7451 C S SKPDF DICSKP 6101 /SKIP IF DICOMED READY S OPDEF DICLR 6102 /CLEAR THE REQUEST FF S OPDEF DICO 6106 /SEND "INPUT "READ" C /BITS [0,4:11] INTO DICOMED. S OPDEF TADI 1400 S OPDEF DCAI 3400 C C C INTERNAL DICMED SUBROUTINES C ------------------------------ C THERE ARE TWO TYPES OF INTERNAL SUBROUTINES. THOSE C WHICH ARE TRULY INTERNAL AND ARE CALLED WITH A "JMS", C AND THOSE WHICH ARE FORTRAN CALLABLE AND ARE C MARKED WITH THE SYMBOL *EX*. C 1. DICSND - SEND (, Z COORD IN MQ) C TO THE DICOMED. C 2. DICOUT - ACTUAL DICOMED I/O ROUTINE. C C C [DI.0] ENTRY AND DO A FAST COPY OF THE "IOPR" ARG. S ENTRY DICME S CPAGE 13 S DICME, BLOCK 2 /ENTRY C FETCH THE DUMMY ARG IDOPR S TAD DICME /GET THE ARG FIELD S DCA ARGFLD /SET FIELD TO ARG FIELD S ARGFLD, 6201 /CDF TO ARG FIELD S TADI DICME# /GET ARG FIELD S DCA IOPRFLD /SAVE POINTER S INC DICME# /ADVANCE POINTER TO ADDRESS S TADI DICME# /GET ADDRESS OF IOPR S DCA 7 /SAVE POINTER S INC DICME# /SET UP RETURN SIOPRFLD, 6201 /SET DATA FIELD OF IOPR S TADI 7 /GET THE DATA S JMS 45 /CDF TO CURRENT FIELD S NOP /DUMMY CDFSKP 2ND ARG S DCA \IDOPR C C C [DI.1] TEST IF VALID OPERATOR IF(IDOPR)1899,1899,1802 1802 IF(IDOPR-11)1803,1803,1899 1899 IERRNUM=701 S RETRN DICME C C C [DI.2] DISPATCH IDOPR 1803 GOTO(1810,1820,1830,1840,1850,1860,1870,1880,1890, 11900,1910),IDOPR C C C [DI.2.1] DISPLAY THE LINE WITH GRAYSCALE C VALUES IN IBUF4[1:256] AT COORD (IX,IY). S\1810, CLA CMA /-1 S TAD PIBUF4 S DCA 11 /SET INPUT DATA BUFFER POINTER C ISIZE=256 IXLOCAL=IX C C C [DI.2.1.1] SEND ISIZE BUFFER DATA POINTED TO BY 11. S\200, CLA CLL S TAD (4011 /RESET Y TO IY S JMS DICOUT S TAD \JZERO /EITHER 0 OR 63 (IF IMAGE COMP) S MQL /Z=0, JUST TO POSITION Y S TAD \IY S JMS DICSND S TAD (4010 /RESET X TO IX S JMS DICOUT S TAD \JZERO S MQL S TAD \IXLOCAL S JMS DICSND C C C [DI.2.1.2] SEND EITHER IBUF1 OR IBUF4 TO THE DICOMED DO 1811 IXX=1,ISIZE S 6211 /CDF 10 S TADI 11 S CPAGE 2 S JMS 45 /CDFSKP S NOP /DUMMY CDFSKP 2ND ARG S RTR /SCALE 0:255 TO 0:63 S AND (0077 /ONLY Z S JMS DICOUT /DISPLAY Z RASTER 1811 CONTINUE S RETRN DICME C C C C [DI.2.2] BEGIN PICTURE S\1820, TAD (4001 S JMS DICOUT S RETRN DICME C C C [DI.2.3] END PICTURE S\1830, TAD (4004 S JMS DICOUT S RETRN DICME C C C [DI.2.4] ERASE PICTURE AND WAIT 20 SEC... S\1840, TAD (4200 S JMS DICOUT DO 1841 ITIME=1,25 S TAD \ITIME S MQL DO 1841 JTIME=1,200 S TAD (-2032 /ABOUT 5000 USEC./(2.4+2.4 USEC) S DCA 7 S CLK, ISZ 7 S JMP CLK 1841 CONTINUE S RETRN DICME /RETURN C C C [DI.2.5] SET IMAGE NORMAL S\1850, TAD (4201 S JMS DICOUT JZERO=0 S RETRN DICME C C C [DI.2.6] SET IMAGE COMPLEMENT S\1860, TAD (4202 S JMS DICOUT JZERO=63 S RETRN DICME C C C [DI.2.7] TURN ON THE IMAGE WAITING LIGHT S\1870, TAD (4204 S JMS DICOUT S RETRN DICME C C C [DI.2.8] SET GAMMA CORRECTOR ON S\1880, TAD (4205 S JMS DICOUT S RETRN DICME C C C [DI.2.9] RESET S\1890, TAD (4000 S JMS DICOUT S RETRN DICME C C C C C [DI.2.10] DISPLAY A POINT (IX,IY,IZ) S\1900, CLA CLL S TAD (4010 S JMS DICOUT S MQL /Z=0 S TAD \IX S JMS DICSND S TAD (4011 S JMS DICOUT S TAD \IZ S RTR /SCALE 0:255 TO 0:63 S AND (0077 S MQL S TAD \IY S JMS DICSND S RETRN DICME C C C [DI.2.11] DO A 1024 RASTER FROM IBUF1[1:1024] C S\1910, CLA CMA /-1 FOR AUTOINDEX S TAD PIBUF1 S DCA 11 ISIZE=1024 IXLOCAL=0 C C NOW CONTINUE AT [DI.2.1.1] GOTO 200 S RETRN DICME C C C C ********************************************* C *SUBROUTINE D I C S N D * C ********************************************* C INTERNAL SUBROUTINE DICSND IS CALLED WITH THE C VALUE OF X OR Y IN THE AC AND THE VALUE OF Z IN THE C MQ IN DICOMED FORMAT (6-BIT RIGHT JUSTIFIED FOR C Z), 0 TO 1024 FOR X AND Y. S CPAGE 3 S RDICSND, JMP I DICSND S DICSND, 0 /ENTRY S DCA SAVEAC S MQA S AND (0077 /MAKE SURE Z IS ONLY 6 BITS S MQL /SAVE IT AGAIN S TAD SAVEAC S BSW /OUTPUT ONLY THE BOTTOM TWO BITS WITH Z S AND (0300 S MQA /OR IN Z S JMS DICOUT /OUTPUT IT TO DICOMED S TAD SAVEAC S RTR S AND (0377 /SEND THE REST OF THE DATA S JMS DICOUT /SEND THE REST OF X OR Y S JMP RDICSND /RETURN C ********************************************* C *SUBROUTINE D I C O U T * C ********************************************* C INTERNAL SUBROUTINE DICOUT IS CALLED WITH THE C VALUE TO BE SENT TO THE DICOMED IN THE ACC. C IT RETURNS WITH THE ACC=0. S CPAGE 3 S RDICOUT, JMP I DICOUT S DICOUT, 0 /ENTRY S DICO /SEND DATA TO DICOMED S DICDONE, DICSKP S JMP DICDONE S CLA S JMP RDICOUT /RETURN C C C C C ************POINTERS******** S SAVEAC, 0 S PIBUF1, \IBUF1 S PIBUF4, \IBUF4 END