DECLARE SUB gpibterm (termin$, termout$)
DECLARE SUB pm500autocal (axis$)
DECLARE SUB pm500fiducial (axis$)
DECLARE SUB gpibin (addr$, msg$)
DECLARE SUB gpibout (addr$, cmd$)
DECLARE SUB pm500err ()
DECLARE SUB pm500getstatus (axis$, status$)

'****************************************************************************
'Module PM500
'This module contains I/O subroutines for the Newport PM500 precision
'motion system controller.
'
'Zachary Wolf
'3/3/96
'****************************************************************************

'Common area for shared parameters
COMMON SHARED /pm500/ gpibinP%, gpiboutP%, pm500addrP$

'Semi-permanent parameters
CONST pm500terminP$ = "CR LF EOI"
CONST pm500termoutP$ = "CR LF"

SUB pm500autocal (axis$)

'****************************************************************************
'This subroutine performs a self calibration on the given axis.  It should
'be performed before using the axis.
'
'Input:
' axis$, axis to calibrate
'
'Zachary Wolf
'3/3/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Check axis$
IF axis$ <> "A" AND axis$ <> "B" AND axis$ <> "X" AND axis$ <> "Y" AND axis$ <> "Z" THEN
 PRINT "PM500: axis not defined"
 EXIT SUB
END IF

'Message
PRINT "PM500 performing a calibration on axis "; axis$; "..."

'Perform the self calibration
CALL gpibout(pm500addrP$, axis$ + "AZ")

'Wait until the calibration is finished
status$ = "B"
WHILE status$ <> "D"
 SLEEP 1
 CALL pm500getstatus(axis$, status$)
' PRINT status$
WEND

END SUB

SUB pm500err

'****************************************************************************
'This subroutine reports errors from the PM500 controller.
'
'Zachary Wolf
'3/3/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Get the error register contents
CALL gpibout(pm500addrP$, "ESTAT")
CALL gpibin(pm500addrP$, errreg$)
'PRINT "DEBUG, PM500ERR: errreg$ = "; errreg$

'See if there is an error
errreg& = VAL(errreg$)
'PRINT "DEBUG, PM500ERR: errreg& = "; errreg&
IF errreg& = 0 THEN
 EXIT SUB
ELSE
 PRINT
 PRINT "PM500: ERROR, register contents = "; errreg$
END IF

'If it was an execute error, print the execute error status
IF (errreg& AND 4194304) = 4194304 THEN
 CALL gpibout(pm500addrP$, "EESTAT ?")
 CALL gpibin(pm500addrP$, errmsg$)
 errval& = VAL(errmsg$)
 PRINT "PM500: ERROR, execute error status = "; errmsg$
END IF

'See if the operator wants to continue
PRINT "There was an error in the PM500 controller."
INPUT "Do you want to continue? ", yn$
IF yn$ <> "y" AND yn$ <> "Y" THEN
 STOP
END IF

END SUB

SUB pm500fiducial (axis$)

'****************************************************************************
'This subroutine moves the given axis' stage to its fiducial (center of
'the stage).
'
'Input:
' axis$, axis name of the stage
'
'Zachary Wolf
'3/4/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Check axis$
IF axis$ <> "A" AND axis$ <> "B" AND axis$ <> "X" AND axis$ <> "Y" AND axis$ <> "Z" THEN
 PRINT "PM500: axis not defined"
 EXIT SUB
END IF

'Message
PRINT "Moving axis "; axis$; " to its fiducial..."

'Move the stage
CALL gpibout(pm500addrP$, axis$ + "F0")

'Wait until the move is finished
status$ = "B"
WHILE status$ <> "D"
 SLEEP 1
 CALL pm500getstatus(axis$, status$)
' PRINT status$
WEND

END SUB

SUB pm500getpos (axis$, position!)

'****************************************************************************
'This subroutine gets the position of a given axis from the PM500 controller.
'
'Input:
' axis$, axis name; A, B, X, Y, Z
'
'Output:
' position!, stage position in microns or rotary angle in arc-seconds
'
'Zachary Wolf
'3/3/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Check axis$
IF axis$ <> "A" AND axis$ <> "B" AND axis$ <> "X" AND axis$ <> "Y" AND axis$ <> "Z" THEN
 PRINT "PM500: axis not defined"
 position! = 0!
 EXIT SUB
END IF

'Request the axis position
CALL gpibout(pm500addrP$, axis$ + "R")

'Get the response message
CALL gpibin(pm500addrP$, msg$)

'Check the axis in the message header
IF MID$(msg$, 1, 1) <> axis$ THEN
 PRINT
 PRINT "PM500: Error in reading axis position: "; msg$
 position! = 0!
 EXIT SUB
END IF

'Check for done (D) in the message header
IF MID$(msg$, 2, 1) <> "D" THEN
 PRINT
 PRINT "PM500: Error in reading axis position: "; msg$
 position! = 0!
 EXIT SUB
END IF

'Extract the position
pos$ = MID$(msg$, 3)
position! = VAL(pos$)

END SUB

SUB pm500getstatus (axis$, status$)

'****************************************************************************
'This subroutine gets the status of a given axis from the PM500 controller.
'
'Input:
' axis$, axis name; A, B, X, Y, Z
'
'Output:
' status$, status of the given axis' stage
'
'Zachary Wolf
'3/3/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Request the axis status
CALL gpibout(pm500addrP$, axis$ + "STAT")

'Get the response message
CALL gpibin(pm500addrP$, msg$)
'PRINT "DEBUG, PM500GETSTATUS: status message = "; msg$

'Check the axis in the message header
IF MID$(msg$, 1, 1) <> axis$ THEN
 PRINT
 PRINT "PM500: Error in reading axis status: "; msg$
 status$ = ""
END IF

'Check for errors
IF MID$(msg$, 2, 1) = "E" THEN
 PRINT
 PRINT "PM500: Error in reading axis status: "; msg$
 CALL pm500err
END IF

'Extract the status
status$ = MID$(msg$, 2)

END SUB

SUB pm500init

'****************************************************************************
'This subroutine initializes the PM500 controller.
'
'Zachary Wolf
'3/3/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Message
PRINT
PRINT "Resetting the Newport PM500 controller..."

'Restart the system
CALL gpibout(pm500addrP$, "RSTART")
SLEEP 2

'Set communication options, CR/LF EOI
CALL gpibout(pm500addrP$, "ENAINT $606")

'Talk to the PM500
CALL gpibout(pm500addrP$, "VN")
CALL gpibin(pm500addrP$, msg$)
PRINT msg$

'Move stages A, B, X, Y to their fiducials, this sets the zero value
CALL pm500fiducial("A")
CALL pm500fiducial("B")
CALL pm500fiducial("X")
CALL pm500fiducial("Y")

'Perform an autocalibration on axes A, B, X, Y
'CALL pm500autocal("A")
'CALL pm500autocal("B")
'CALL pm500autocal("X")
'CALL pm500autocal("Y")

'Set the direction sign for axes A, B, X, Y
CALL gpibout(pm500addrP$, "ASIGN+1")
CALL gpibout(pm500addrP$, "BSIGN+1")
CALL gpibout(pm500addrP$, "XSIGN+1")
CALL gpibout(pm500addrP$, "YSIGN+1")

END SUB

SUB pm500move2abs (axis1$, axis2$, x!)

'****************************************************************************
'This subroutine moves the given 2 axes to position x (microns or
'arc-seconds).
'
'Input:
' axis1$, axis name of stage 1
' axis2$, axis name of stage 2
' x!, the position to move the stages to, in microns or arc-sec
'
'Zachary Wolf
'3/4/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Check axis1$
IF axis1$ <> "A" AND axis1$ <> "B" AND axis1$ <> "X" AND axis1$ <> "Y" AND axis1$ <> "Z" THEN
 PRINT "PM500: axis 1 not defined"
 EXIT SUB
END IF

'Check axis2$
IF axis2$ <> "A" AND axis2$ <> "B" AND axis2$ <> "X" AND axis2$ <> "Y" AND axis2$ <> "Z" THEN
 PRINT "PM500: axis 2 not defined"
 EXIT SUB
END IF

'Move the stages
CALL gpibout(pm500addrP$, axis1$ + "G" + LTRIM$(STR$(x!)))
CALL gpibout(pm500addrP$, axis2$ + "G" + LTRIM$(STR$(x!)))

'Wait until the move is finished, axis 1
status$ = "B"
WHILE status$ <> "D"
 SLEEP 1
 CALL pm500getstatus(axis1$, status$)
' PRINT status$
WEND

'Wait until the move is finished, axis 2
status$ = "B"
WHILE status$ <> "D"
 SLEEP 1
 CALL pm500getstatus(axis2$, status$)
' PRINT status$
WEND

END SUB

SUB pm500move2rel (axis1$, axis2$, x!)

'****************************************************************************
'This subroutine moves the given axes a distance x (microns or
'arc-seconds) from their current position.
'
'Input:
' axis1$, axis name of stage 1
' axis2$, axis name of stage 2
' x!, the relative distance to move the stages, in microns or arc-sec
'
'Zachary Wolf
'3/4/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Check axis1$
IF axis1$ <> "A" AND axis1$ <> "B" AND axis1$ <> "X" AND axis1$ <> "Y" AND axis1$ <> "Z" THEN
 PRINT "PM500: axis 1 not defined"
 EXIT SUB
END IF

'Check axis2$
IF axis2$ <> "A" AND axis2$ <> "B" AND axis2$ <> "X" AND axis2$ <> "Y" AND axis2$ <> "Z" THEN
 PRINT "PM500: axis 2 not defined"
 EXIT SUB
END IF

'Move the stages
CALL gpibout(pm500addrP$, axis1$ + "GR" + LTRIM$(STR$(x!)))
CALL gpibout(pm500addrP$, axis2$ + "GR" + LTRIM$(STR$(x!)))

'Wait until the move is finished, stage 1
status$ = "B"
WHILE status$ <> "D"
 SLEEP 1
 CALL pm500getstatus(axis1$, status$)
' PRINT status$
WEND

'Wait until the move is finished, stage 2
status$ = "B"
WHILE status$ <> "D"
 SLEEP 1
 CALL pm500getstatus(axis2$, status$)
' PRINT status$
WEND

END SUB

SUB pm500moveabs (axis$, x!)

'****************************************************************************
'This subroutine moves the given axis' stage to position x (microns or
'arc-seconds).
'
'Input:
' axis$, axis name of the stage
' x!, the position to move the stage to, in microns or arc-sec
'
'Zachary Wolf
'3/3/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Check axis$
IF axis$ <> "A" AND axis$ <> "B" AND axis$ <> "X" AND axis$ <> "Y" AND axis$ <> "Z" THEN
 PRINT "PM500: axis not defined"
 EXIT SUB
END IF

'Move the stage
CALL gpibout(pm500addrP$, axis$ + "G" + LTRIM$(STR$(x!)))

'Wait until the move is finished
status$ = "B"
WHILE status$ <> "D"
 SLEEP 1
 CALL pm500getstatus(axis$, status$)
' PRINT status$
WEND

END SUB

SUB pm500moverel (axis$, x!)

'****************************************************************************
'This subroutine moves the given axis' stage a distance x (microns or
'arc-seconds) from its current position.
'
'Input:
' axis$, axis name of the stage
' x!, the relative distance to move the stage, in microns or arc-sec
'
'Zachary Wolf
'3/4/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Check axis$
IF axis$ <> "A" AND axis$ <> "B" AND axis$ <> "X" AND axis$ <> "Y" AND axis$ <> "Z" THEN
 PRINT "PM500: axis not defined"
 EXIT SUB
END IF

'Move the stage
CALL gpibout(pm500addrP$, axis$ + "GR" + LTRIM$(STR$(x!)))

'Wait until the move is finished
status$ = "B"
WHILE status$ <> "D"
 SLEEP 1
 CALL pm500getstatus(axis$, status$)
' PRINT status$
WEND

END SUB

SUB pm500setpar (gpibinf%, gpiboutf%, pm500addr$)

'****************************************************************************
'This subroutine sets parameter values for the Newport PM500 controller.
'
'Input:
' gpibinf%, GPIB input file number
' gpiboutf%, GPIB output file number
' pm500addr$, the PM500 GPIB address in a string
'
'Zachary Wolf
'3/3/96
'****************************************************************************

'Make sure all GPIB parameters have reasonable values
IF gpibinf% < 0 OR gpibinf% > 100 THEN
 PRINT "PM500: GPIB problem"
 EXIT SUB
END IF

IF gpiboutf% < 0 OR gpiboutf% > 100 THEN
 PRINT "PM500: GPIB problem"
 EXIT SUB
END IF

IF pm500addr$ = "" THEN
 PRINT "PM500: GPIB problem"
 EXIT SUB
END IF

'Place the parameters in the local common block for future use
gpibinP% = gpibinf%
gpiboutP% = gpiboutf%
pm500addrP$ = pm500addr$

END SUB

SUB pm500zero (axis$)

'****************************************************************************
'This subroutine clears the given axis' position register so the present
'position becomes the zero position.
'
'Input:
' axis$, axis name of the stage to zero
'
'Zachary Wolf
'3/3/96
'****************************************************************************

'Set the GPIB terminators
CALL gpibterm(pm500terminP$, pm500termoutP$)

'Check axis$
IF axis$ <> "A" AND axis$ <> "B" AND axis$ <> "X" AND axis$ <> "Y" AND axis$ <> "Z" THEN
 PRINT "PM500: axis not defined"
 EXIT SUB
END IF

'Zero the stage
CALL gpibout(pm500addrP$, axis$ + "C")

END SUB