Cloned SEACAS for EXODUS library with extra build files for internal package management.
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

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