You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
177 lines
4.9 KiB
177 lines
4.9 KiB
2 years ago
|
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
||
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
||
|
C NTESS, the U.S. Government retains certain rights in this software.
|
||
|
C
|
||
|
C See packages/seacas/LICENSE for details
|
||
|
|
||
|
C=======================================================================
|
||
|
SUBROUTINE GRSNAP (CMD, INDEV)
|
||
|
C=======================================================================
|
||
|
|
||
|
C --*** GRSNAP *** (GRPLIB) Perform movie snap operations
|
||
|
C -- Written by Amy Gilkey, revised 01/25/88
|
||
|
C --
|
||
|
C --GRSNAP sets up a device for snapping multiple frames for movies.
|
||
|
C --This code is very device-dependent.
|
||
|
C --
|
||
|
C --At the present time, the only device that may be snapped is a camera
|
||
|
C --(attached to a terminal) or a Dicomed.
|
||
|
C --
|
||
|
C --An attached camera device must be pre-initialized and NSNAP must
|
||
|
C --be set non-negative (zero ok).
|
||
|
C --
|
||
|
C --Parameters:
|
||
|
C -- CMD - IN - the snap operation:
|
||
|
C -- QUERY = initialize device code, nsnap < 0 if cannot snap frames
|
||
|
C -- INIT = initialize device to snap nsnap frames
|
||
|
C -- ABORT = abort plot
|
||
|
C -- START = start plot
|
||
|
C -- STOP = end plot and snap frames
|
||
|
C -- EXIT = deactivate device
|
||
|
C -- INDEV - IN - the device; 0 for current device (only QUERY allowed
|
||
|
C -- for non-current device)
|
||
|
C --
|
||
|
C --Common Variables:
|
||
|
C -- Uses ICURDV, DEVCOD, NSNAP of /GRPCOM/
|
||
|
|
||
|
C --Routines Called:
|
||
|
C -- VDESCP - (VDI) Send escape sequence to device
|
||
|
|
||
|
COMMON /GRPCOC/ DEVNAM(2), DEVCOD(2)
|
||
|
CHARACTER*3 DEVNAM
|
||
|
CHARACTER*8 DEVCOD
|
||
|
COMMON /GRPCOM/ ICURDV, ISHARD, DEVOK(2), TALKOK(2),
|
||
|
& NSNAP(2), IFONT(2), SOFTCH(2), AUTOPL(2),
|
||
|
& MAXCOL(2), NUMCOL(0:1,2), MAPALT(2), MAPUSE(2)
|
||
|
LOGICAL ISHARD, DEVOK, TALKOK, SOFTCH, AUTOPL
|
||
|
|
||
|
CHARACTER*(*) CMD
|
||
|
INTEGER INDEV
|
||
|
|
||
|
INTEGER RBUF(2)
|
||
|
|
||
|
CHARACTER*8 IDSNAP(2)
|
||
|
SAVE IDSNAP
|
||
|
C --IDSNAP - an artificial device code related to the device code
|
||
|
|
||
|
DATA IDSNAP / ' ', ' ' /
|
||
|
|
||
|
IF ((INDEV .NE. 1) .AND. (INDEV .NE. 2)) THEN
|
||
|
IDEV = ICURDV
|
||
|
ELSE
|
||
|
IDEV = INDEV
|
||
|
END IF
|
||
|
|
||
|
C --Initialize device code
|
||
|
IF (IDSNAP(IDEV) .EQ. ' ') THEN
|
||
|
IDSNAP(IDEV) = 'NONE'
|
||
|
IF (NSNAP(IDEV) .GE. 0) THEN
|
||
|
IDSNAP(IDEV) = 'CAMERA'
|
||
|
ELSE IF (DEVCOD(IDEV) .EQ. 'DICOMED') THEN
|
||
|
IDSNAP(IDEV) = DEVCOD(IDEV)
|
||
|
END IF
|
||
|
|
||
|
C --Initialize the device
|
||
|
IF (IDSNAP(IDEV) .EQ. 'CAMERA') THEN
|
||
|
C --Initialized before the routine was called
|
||
|
CONTINUE
|
||
|
ELSE IF (IDSNAP(IDEV) .EQ. 'DICOMED') THEN
|
||
|
CONTINUE
|
||
|
END IF
|
||
|
END IF
|
||
|
|
||
|
C --Set nsnap = -999 if cannot snap device
|
||
|
IF (IDSNAP(IDEV) .EQ. 'NONE') NSNAP(IDEV) = -999
|
||
|
|
||
|
IF (CMD .NE. 'QUERY') THEN
|
||
|
|
||
|
C --Skip if not current device
|
||
|
IF (IDEV .NE. ICURDV) GOTO 110
|
||
|
|
||
|
C --Skip if snaps are not requested on device
|
||
|
IF (NSNAP(ICURDV) .LE. 0) GOTO 110
|
||
|
|
||
|
CALL PLTFLU
|
||
|
|
||
|
IF (CMD .EQ. 'INIT') THEN
|
||
|
|
||
|
C --Initialize number of snaps
|
||
|
|
||
|
IF (IDSNAP(IDEV) .EQ. 'CAMERA') THEN
|
||
|
CONTINUE
|
||
|
|
||
|
ELSE IF (IDSNAP(IDEV) .EQ. 'DICOMED') THEN
|
||
|
CONTINUE
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (CMD .EQ. 'ABORT') THEN
|
||
|
|
||
|
C --Abort plot
|
||
|
|
||
|
IF (IDSNAP(IDEV) .EQ. 'CAMERA') THEN
|
||
|
CONTINUE
|
||
|
|
||
|
ELSE IF (IDSNAP(IDEV) .EQ. 'DICOMED') THEN
|
||
|
C --Close segment and delete all segments
|
||
|
RBUF(1) = 0
|
||
|
CALL VDESCP (201, 0, RBUF)
|
||
|
CALL VDESCP (203, 1, RBUF)
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (CMD .EQ. 'START') THEN
|
||
|
|
||
|
C --Start plot
|
||
|
|
||
|
IF (IDSNAP(IDEV) .EQ. 'CAMERA') THEN
|
||
|
CONTINUE
|
||
|
|
||
|
ELSE IF (IDSNAP(IDEV) .EQ. 'DICOMED') THEN
|
||
|
C --Open segment
|
||
|
RBUF(1) = 1
|
||
|
RBUF(2) = 1
|
||
|
CALL VDESCP (200, 2, RBUF)
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (CMD .EQ. 'STOP') THEN
|
||
|
|
||
|
C --End plot and snap frames
|
||
|
|
||
|
IF (IDSNAP(IDEV) .EQ. 'CAMERA') THEN
|
||
|
C --Snap n frames
|
||
|
CONTINUE
|
||
|
|
||
|
ELSE IF (IDSNAP(IDEV) .EQ. 'DICOMED') THEN
|
||
|
C --Close segment
|
||
|
RBUF(1) = 0
|
||
|
CALL VDESCP (201, 0, RBUF)
|
||
|
|
||
|
C --Snap n-1 frames (plot segment with newpage)
|
||
|
DO 100 I = 1, NSNAP(ICURDV)-1
|
||
|
CALL VDNWPG
|
||
|
100 CONTINUE
|
||
|
|
||
|
C --Delete all segments
|
||
|
RBUF(1) = 0
|
||
|
CALL VDESCP (203, 1, RBUF)
|
||
|
END IF
|
||
|
|
||
|
ELSE IF (CMD .EQ. 'EXIT') THEN
|
||
|
|
||
|
C --Deactivate device
|
||
|
|
||
|
IF (IDSNAP(IDEV) .EQ. 'CAMERA') THEN
|
||
|
CONTINUE
|
||
|
|
||
|
ELSE IF (IDSNAP(IDEV) .EQ. 'DICOMED') THEN
|
||
|
CONTINUE
|
||
|
END IF
|
||
|
|
||
|
ELSE
|
||
|
GOTO 110
|
||
|
END IF
|
||
|
END IF
|
||
|
|
||
|
110 CONTINUE
|
||
|
RETURN
|
||
|
END
|