azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
main
claudetools/projects/dataforth-dos/datasheet-pipeline/scmvas-hvas-research/source/LIBATE3.BAS
Mike Swanson 45083f4735 Add SCMVAS/SCMHVAS datasheet pipeline extension (Dataforth) 
Extends the Test Datasheet Pipeline on AD2:C:\Shares\testdatadb to
generate web-published datasheets for the SCMVAS-Mxxx (obsolete) and
SCMHVAS-Mxxxx (replacement) High Voltage Input Module product lines.
Both are tested either with the existing TESTHV3 software (production
VASLOG .DAT logs) or in Engineering with plain .txt output.

Key changes on AD2 (all deployed 2026-04-12 with dated backups):

- parsers/spec-reader.js: getSpecs() returns a `{_family:'SCMVAS',
  _noSpecs:true}` sentinel for SCMVAS/SCMHVAS/VAS-M/HVAS-M model prefixes
  so the export pipeline does not silently skip them for missing specs.
- templates/datasheet-exact.js: new Accuracy-only template branch
  (generateSCMVASDatasheet + helpers) that mirrors the existing shipped
  format byte-for-byte. Extraction regex covers both QuickBASIC STR$()
  output formats: scientific-with-trailing-status-digit (98.4% of
  records) and plain-decimal (1.6% of records above QB's threshold).
- parsers/vaslog-engtxt.js (new): parses the Engineering-Tested .txt
  files in TS-3R\LOGS\VASLOG\VASLOG - Engineering Tested\. Filename SN
  regex strips optional trailing 14-digit timestamp; in-file "SN:"
  header is the authoritative source when the filename is malformed.
- database/import.js: LOG_TYPES grows a VASLOG_ENG entry with
  subfolder + recursive flags. Pre-existing 7 log types keep their
  implicit recursive=true behaviour (config.recursive !== false).
  importFiles() routes VASLOG_ENG paths before the generic loop so a
  VASLOG - Engineering Tested/*.txt path does not mis-dispatch to the
  multiline parser.
- database/export-datasheets.js: VASLOG_ENG records are written
  verbatim via fs.copyFileSync(source_file, For_Web/<SN>.TXT) for true
  byte-level pass-through, with a graceful raw_data fallback when the
  source file is no longer on disk.

Deploy outcome:
- 27,503 SCMVAS/SCMHVAS datasheets rendered (27,065 from scientific +
  438 from plain-decimal PASS lines, post-patch rerun)
- 434 Engineering-Tested .txt files pass-through-copied to For_Web
- 0 errors across both batches

Repo layout added here:
- scmvas-hvas-research/: discovery artifacts (source .BAS, hvin.dat,
  sample .DAT + .txt, binary-format notes, IMPLEMENTATION_PLAN.md)
- implementation/: staged final code + deploy helpers + local test
  harness + per-step verification scripts
- backups/pre-deploy-20260412/: independent local snapshot of the 4
  AD2 files replaced, pulled byte-for-byte before deploy

All helper scripts fetch the AD2 password at runtime from the SOPS
vault (clients/dataforth/ad2.sops.yaml). None of the committed files
contain the plaintext credential. Known vault-entry hygiene issue
(stale shell-escape backslash before the `!`) is documented in the
fetcher comments and stripped at read-time; flagged separately for
cleanup.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-13 07:36:45 -07:00

777 lines
25 KiB
QBasic
Raw Permalink Blame History

DECLARE SUB INSTALLDUT (NUMDUT%)
'Library of functions used with SCM5B33 and DSCA33 test programs.
'Created from LIBATE.BAS
'Author: John Lehman
'Date: 06/21/99
'
' REVISION RECORD
'
'Date of Change Description
'-------------- -----------
'06/21/99 JL Initial Release
DECLARE SUB CHANGEDN (SN$) 'Allow user to change dash number
DECLARE SUB CONTINUE () 'Waits for a key press
DECLARE SUB GETNEXTSN (TIME2!, SERNO$(), NUMDUT%) 'Allows user the change the SN info for a new group of modules
DECLARE SUB GETSN (SN$) 'Gets DUT serial number from user
DECLARE SUB INPUTSN (SERNO$(), NUMDUT%) 'Gathers the SN infor for the unit in slot 1
DECLARE SUB HS1 () 'GPIB communications handshake
DECLARE SUB pause (TIME!) 'Pause for TIME
DECLARE FUNCTION BESTFIT! (SLOPE!, OFFSET1!, INSIM!(), NUMPTS%, ERROROUT!(), L%)
DECLARE FUNCTION REPEAT2$ (MN$, ELAP2!, TIME2!, SN$)
'** Calculates besfit line and max error
DECLARE FUNCTION KEYBDIN$ () '** Get keyboard input
DECLARE FUNCTION REPEAT$ (MN$, ELAP2!, TIME2!) '** Ask if you would like to repeat test
DECLARE FUNCTION READDVM! (CH%, FUNC$, RANGETXT$, RANGENUM!, RESOLTXT$, RESOLNUM!) '**
DECLARE FUNCTION STRINGVAL% (A$) '**
DECLARE FUNCTION UPSN$ (SN$, NUMDUT%) '** Increments dash# of serial#
'** Function called from main programs.
' Declare in programs which call this function.
'GPIB Communication routines for dataforth GPIB card
DECLARE SUB HS2 ()
DECLARE SUB HS1 ()
DECLARE SUB INIT488 (DEVADDR%)
DECLARE SUB IO488 (DDATA$, DEVADDR%, SEL4%)
'Kepco DPS 125-0.5M control routines via RS-232C
DECLARE SUB INITPS (DPSADDR%, OVERI!, OVERV!) 'initializes supply
DECLARE SUB SETDPS (DPSADDR%, VSUPPLY!) 'Sets Kepco DPS power supply
DECLARE FUNCTION POWERIO$ (DPSADDR%, CMD$) '** Kepco DPS power supply I/O
'HP33120A (function generator) control routines via GPIB
DECLARE SUB FUNGEN33120A (CMD$, VALUE!) 'Write command to func. gen.
'HP34970A (data acquisition/switch unit) control routines via GPIB
DECLARE SUB DVMCONF (CH%, FUNC$, RANGETXT$, RANGENUM!, RESOLTXT$, RESOLNUM!) 'Configure DVM
DECLARE SUB DVMSENS (CH%, FUNC1$, FUNC2$, SETTXT$, SETNUM!) 'Configure DVM
DECLARE SUB SETDAC3 (DACNUM%, VOLTAGE!) 'Set 34907 DACs
DECLARE SUB SETSWITCH (CH%, STATE%) 'Set switch on 34903A 20-ch actuator
DECLARE FUNCTION GETREADING! () '** Send trigger & read dvm
'HP760A meter calibrator routines
DECLARE SUB HP760APANEL (VALUE!, UNITS%) 'Draw a display of instrument panel.
COMMON SHARED PON%, IINSEN1.MEAS!, IOUTSEN1.MEAS!(), IOUTSEN2.MEAS!(), SERNO$(), SN$, PSCOM$, GENOUTMAX!, PCBNO$
COMMON SHARED BADDRS%, DPSADDR%, PSPORT%, DASADDR%, GENADDR%, DIOCH01DATA%, DIOCH02DATA%
CONST MTA% = &H40 'GPIB talk address
CONST MLA% = &H20 'GPIB listen address
'********************************************************************
'Assign constants to Kepco DPS power supply commands:
CONST PSVOLT$ = "STV=" 'Set terminal voltage
CONST SUPPLYON$ = "SOP=ON" 'Set output to ON
CONST ISTAT$ = "RCS" 'Read Current protection status
CONST SETIMAX$ = "SOC=" 'Set overcurent limit...4mA resol.
'********************************************************************
'Assign constants to HP freq. gen. commands
CONST FREQ$ = "FREQ"
'********************************************************************
'Assign constants to HP DAS commands
CONST SETDAC$ = "SOUR:VOLT"
'********************************************************************
'Assign constants to HP DAS configuration
CONST DAC1.CH% = 304 'DAC #1
CONST DAC2.CH% = 305 'DAC #2
KEY(10) ON 'Activates F10 key
ON KEY(10) GOSUB FINISH 'Traps for F10 key Exits if pressed
FINISH: END
FUNCTION BESTFIT! (SLOPE!, OFFSET1!, INSIM!(), NUMPTS%, ERROROUT!(), L%)
'Calculates Max error of data from bestfit line
MTERR! = 0
MIN! = INSIM!(L%, 1)
MAX! = INSIM!(L%, NUMPTS%)
FOR INC% = 1 TO NUMPTS% 'Increments thru test points
BVEC! = INSIM!(L%, INC%) * SLOPE! + OFFSET1! 'Calculates point on best fit line
AVEC! = ERROROUT!(L%, INC%) 'Gets corresponding data point
TERR! = AVEC! - BVEC! 'Calculates difference
IF ABS(TERR!) > ABS(MTERR!) THEN 'Checks if bigger than last Max
MTERR! = TERR! 'Assigns max error
END IF
NEXT
BESTFIT! = MTERR! 'Passes Max error back
END FUNCTION
SUB CHANGEDN (SN$)
N = 1
NWO$ = ""
DO
C$ = MID$(SN$, N, 1)
NWO$ = NWO$ + C$
N = N + 1
LOOP WHILE C$ <> "-"
WO$ = LEFT$(SN$, N)
PRINT "Current serial number is: "; SN$
INPUT "Enter the new dash number (Press 'Enter' for 1) "; DS$
IF DS$ = "" THEN DS$ = "1"
SN$ = NWO$ + DS$
END SUB
SUB DVMCONF (CH%, FUNC$, RANGETXT$, RANGENUM!, RESOLTXT$, RESOLNUM!)
' Inputs:
' CH% = channel to be measured
' FUNC$ = parameter to be measured
' RANGETXT$ = measurement range, specified in text
' If 'N/A', don't include in command. Not needed for FUNC$
' If "", range specified in RANGENUM! or not specified
' RANGENUM! = measurement range, specified numerically
' If 0, range specified in RANGETXT$ or not specified
' RESOLTXT$ = indicate how resolution is specified. 0 = text, 1 = numerically
' If 'N/A', don't include in command. Not needed for FUNC$
' IF "", resolution specified in RESOLNUM! or not specified
' RESOLNUM! = measurement resolution
' 0 = Resolution specified in RESOLTXT$ or not specified
' Outputs: None
' Description - configures HP34970A to take a measurement
'
' Reference;
' MEAS and CONF use the following default instrument settings
' Integration Time 1PLC
' Input Resistane 10Mohm, fixed for all DCV ranges
' AC Filter 20Hz (medium)
' Scan List Redefined when command executed
' Scan Interval Source Immediate
' Scan Count 1 Scan Sweep
' Channel Delay Automatic Delay
IF RANGETXT$ = "N/A" THEN 'String command only.
'No range or resolution data.
DDATA$ = "CONF:" + FUNC$ + " (@" + STR$(CH%) + ")"
ELSE
IF RANGENUM! <> 0 THEN 'Range specified numerically
RG$ = STR$(RANGENUM!)
ELSE 'Range specified w/ text
RG$ = " " + RANGETXT$
END IF
IF RESOLNUM! <> 0 THEN 'Resolution specified numerically
RES$ = STR$(RESOLNUM!)
ELSE 'Resolution specified w/ text
IF RESOLTXT$ <> "" THEN
RES$ = RESOLTXT$
ELSE
RES$ = ""
END IF
END IF
DDATA$ = "CONF:" + FUNC$ + RG$ + RES$ + ",(@" + STR$(CH%) + ")"
END IF
'Y% = CSRLIN
'LOCATE 22
'PRINT "DVMCONF a" + DDATA$ + "b";
'PRINT SPC(10); : PRINT
'LOCATE Y%
CALL IO488(DDATA$, DASADDR%, 1) 'Write configuration
END SUB
SUB DVMSENS (CH%, FUNC1$, FUNC2$, SETTXT$, SETNUM!)
' Inputs:
' CH% = channel to be measured
' FUNC1$ = parameter to be measured
' FUNC2$ = parameter to be configured
' SETTXT$ = configuration, specified in text
' If "", specified in SETNUM!
' SETNUM! = configuration, specified numerically
' If 0, range specified in SETTXT$
' Outputs: None
' Description - configures HP34970A to take a measurement
'
' Reference;
' DC Voltage and Current Readings
' Integration Time Resolution Digits Bits
' 0.02PLC <0.0001 * Range 4 1/2 15
' 0.2PLC <0.00001 * Range 5 1/2 18
' 1PLC <0.000003 * Range 5 1/2 20
' 2PLC <0.0000022 * Range 6 1/2 21
' 10PLC <0.000001 * Range 6 1/2 24
' 20PLC <0.0000008 * Range 6 1/2 25
' 100PLC <0.0000003 * Range 6 1/2 26
' 200PLC <0.00000022 * Range 6 1/2 26
'
' AC Voltage and Current Readings
' Filter Readings/s Settling Delay Digits
' 3Hz 0.14 1.5s 6 1/2
' 20Hz 1 0.2s 6 1/2
' 200Hz 8 0.02s 6 1/2
IF SETNUM! <> 0 THEN 'specified numerically
ST$ = STR$(SETNUM!)
ELSE 'specified w/ text
ST$ = " " + SETTXT$
END IF
DDATA$ = "SENS:" + FUNC1$ + ":" + FUNC2$ + ST$ + ",(@" + STR$(CH%) + ")"
'Y% = CSRLIN
'LOCATE 23
'PRINT "DVMSENSE a" + DDATA$ + "b";
'PRINT SPC(10); : PRINT
'LOCATE Y%
CALL IO488(DDATA$, DASADDR%, 1) 'Write configuration
END SUB
SUB FUNGEN33120A (CMD$, VALUE!)
' Inputs - String of commands to be sent to the HP33120A
' Outputs - None
' Description - Writes a string of commands to the HP33120A
' function generator, through the IEEE 488 interface
' If VALUE! = -99 then the command is a string only
IF VALUE! = -99 THEN
VALUE2$ = "" 'Command contains no numerical value
ELSEIF CMD$ = FREQ$ AND ABS(VALUE!) < .0001 THEN
VALUE! = .0001 'Func. gen. min output = 100uHz
VALUE2$ = STR$(VALUE!)
ELSEIF (LEFT$(CMD$, 3) = "FSK" OR LEFT$(CMD$, 7) = "FREQ:ST") AND VALUE! <= .0001 THEN
VALUE! = .01 'Func. gen. min FSK value = 10mHz
VALUE2$ = STR$(VALUE!) 'Func. gen. min sweep value = 10mHz
ELSE
VALUE2$ = STR$(VALUE!)
END IF
DDATA$ = CMD$ + " " + VALUE2$
'Y% = CSRLIN
'LOCATE 20
'PRINT "FUNGEN33120A a" + DDATA$ + "b";
'PRINT SPC(10); : PRINT
'LOCATE Y%
CALL IO488(DDATA$, GENADDR%, 1) 'Write data to generator
END SUB
FUNCTION GETREADING!
' Inputs: None
' Outputs: None
' Description - configures HP34970A trigger source, sends a trigger
' command, reads the DVM and returns the reading.
DDATA$ = "TRIG:SOUR BUS" 'Trigger source = bus
CALL IO488(DDATA$, DASADDR%, 1)
DDATA$ = "INIT" 'set 'wait-for-trigger' state
CALL IO488(DDATA$, DASADDR%, 1)
DDATA$ = "*TRG" 'send trigger
CALL IO488(DDATA$, DASADDR%, 1)
DDATA$ = "FETC?" 'retrieve reading
CALL IO488(DDATA$, DASADDR%, 1)
CALL IO488(DDATA$, DASADDR%, 2)
GETREADING! = VAL(DDATA$)
END FUNCTION
SUB HP760APANEL (VALUE!, UNITS%)
'Print a display of the HP760A front panel to show number setting.
'Inputs; VALUE! = Value of voltage or current to be set
' UNITS% 1 = Voltage
' 2 = Current
' 3 = None, FUNCTION = STD BY
' 5 10 15 20 25 30 35 40 45 50 55 60 65 70 75
'
DIM DIG%(7) 'Display digits
TOPLOC% = 16
IF UNITS% = 1 THEN
SCALE! = 1 'Max voltage output is 1000V
LEDTAB% = 34
ELSEIF UNITS% = 2 THEN
SCALE! = 100 'Max current output is 10A
LEDTAB% = 14
ELSE
LEDTAB% = 0
END IF
'Set meter for twice max D.U.T. input
'Set only one digit. Setting other digits
'after most significant digit does not
'always increase output signal magnitude.
IF VALUE! * 2 >= 100 THEN
SETVALUE! = CINT(VALUE! * 2 / 100) * 100 * SCALE!
ELSEIF VALUE! * 2 >= 10 THEN
SETVALUE! = CINT(VALUE! * 2 / 10) * 10 * SCALE!
ELSEIF VALUE! * 2 >= 1 THEN
SETVALUE! = CINT(VALUE! * 2) * SCALE!
ELSEIF VALUE! * 2 >= .1 THEN
SETVALUE! = CINT(VALUE! * 2 * 10) / 10 * SCALE!
ELSEIF VALUE! * 2 >= .01 THEN
SETVALUE! = CINT(VALUE! * 2 * 100) / 100 * SCALE!
ELSEIF VALUE! * 2 >= .001 THEN
SETVALUE! = CINT(VALUE! * 2 * 1000) / 1000 * SCALE!
ELSEIF VALUE! * 2 >= .0001 THEN
SETVALUE! = CINT(VALUE! * 2 * 10000) / 10000 * SCALE!
END IF
NUM$ = STR$(SETVALUE!)
FOR L% = 1 TO 7
DIG%(L%) = 0
NEXT
IF SETVALUE! >= 1000 THEN
DIG%(7) = 9
ELSEIF SETVALUE! >= 100 THEN
DIG%(7) = VAL(MID$(NUM$, 2, 1))
ELSEIF SETVALUE! >= 10 THEN
DIG%(6) = VAL(MID$(NUM$, 2, 1))
ELSEIF SETVALUE! >= 1 THEN
DIG%(5) = VAL(MID$(NUM$, 2, 1))
ELSEIF SETVALUE! >= .1 THEN
DIG%(4) = VAL(MID$(NUM$, 3, 1))
ELSEIF SETVALUE! >= .01 THEN
DIG%(3) = VAL(MID$(NUM$, 4, 1))
ELSEIF SETVALUE! >= .001 THEN
DIG%(3) = VAL(MID$(NUM$, 5, 1))
ELSEIF SETVALUE! >= .0001 THEN
DIG%(3) = VAL(MID$(NUM$, 6, 1))
END IF
FOR L% = 1 TO 7
LOCATE TOPLOC%, (L% - 1) * 10 + 7 'top left corner
PRINT CHR$(201)
FOR M% = 8 TO 10 'top horizontal line
LOCATE TOPLOC%, (L% - 1) * 10 + M%
PRINT CHR$(205)
NEXT M%
LOCATE TOPLOC%, (L% - 1) * 10 + 11 'top right corner
PRINT CHR$(187)
FOR N% = TOPLOC% + 1 TO TOPLOC% + 3
LOCATE N%, (L% - 1) * 10 + 7 'left vertical line
PRINT CHR$(186)
IF N% = TOPLOC% + 2 THEN 'print display digit
LOCATE N%, ((L% - 1) * 10 + 8)
PRINT DIG%(8 - L%)
END IF
LOCATE N%, (L% - 1) * 10 + 11 'right vertical line
PRINT CHR$(186)
NEXT N%
LOCATE TOPLOC% + 4, (L% - 1) * 10 + 7 'bottom left corner
PRINT CHR$(200)
FOR M% = 8 TO 10 'bottom horizontal line
LOCATE TOPLOC% + 4, (L% - 1) * 10 + M%
PRINT CHR$(205)
NEXT M%
LOCATE TOPLOC% + 4, (L% - 1) * 10 + 11 'bottom right corner
PRINT CHR$(188)
NEXT L%
IF LEDTAB% <> 0 THEN
LOCATE TOPLOC% + 2, LEDTAB% 'print LED location
PRINT CHR$(15)
END IF
END SUB
SUB HS1
' Module Name - HS1
'
' Inputs - None
' Outputs - None
' Description - HS1 waits for EOI to occur with ATN = 0
' >>>> Check Bit #4 for true (EOI)
BYTE% = 0
WHILE (BYTE% AND 16) = 0
BYTE% = INP(BADDRS% + 0)
WEND
END SUB
SUB HS2
' Module Name - HS2
'
' Inputs - None
' Outputs - None
' Description - HS1 checks that serial poll active state
' has occured with rsv set in the serial poll register.
' >>>>> Check Bit #5 for true (SPAS)
BYTE% = 0
WHILE NOT BYTE% AND 32 AND BYTE% <> 40
BYTE% = INP(BADDRS% + 0)
WEND
END SUB
SUB INIT488 (DEVADDR%)
' Module Name - INIT488
'
' Inputs - None
' Outputs - None
' Description - Initalizes the IEEE 488 interface
OUT (BADDRS% + 8), &H0 'Configure PC4311 as controller
OUT (BADDRS% + 3), &H80 'Release ACDS holdoff, set operation
OUT (BADDRS% + 3), &H0 'Software reset, set operation
OUT (BADDRS% + 4), DEVADDR% 'Enable dual primary addressing mode
OUT (BADDRS% + 0), &H0 'Disable all interrupts
OUT (BADDRS% + 3), &H8F 'Request control, clear operation
OUT (BADDRS% + 3), &HF 'Send remote enable, clear operation
OUT (BADDRS% + 3), &H90 'Listen only, set operation
END SUB
SUB INITPS (DPSADDR%, OVERI!, OVERV!)
'Initialize Kepco power supply
PS$ = POWERIO$(DPSADDR%, "ZER") 'Clear errors if any
PS$ = POWERIO$(DPSADDR%, "SMD=OC") 'Select over-current protection mode
'Set over-current limit
STLEN% = LEN(STR$(OVERI!))
PS$ = POWERIO$(DPSADDR%, SETIMAX$ + RIGHT$(STR$(OVERI!), STLEN% - 1))
STLEN% = LEN(STR$(OVERV!))
PS$ = POWERIO$(DPSADDR%, "SOV=" + RIGHT$(STR$(OVERV!), STLEN% - 1))'Set over-voltage limit
END SUB
SUB IO488 (DDATA$, DEVADDR%, SEL4%)
'***********************************************************************************************
'* *
'* Description: Output and input to GPIB device using PC4311 GPIB card *
'* *
'* Input : DDATA$ -- Data string to GPIB device *
'* DEVADDR% -- Device address desired *
'* SEL4% -- Write (1) or Read (2) command *
'* *
'* Output : DDATA$ -- Data string from GPIB device *
'* *
'***********************************************************************************************
CALL INIT488(DEVADDR%) 'Address GPIB card
SELECT CASE SEL4%
'Write...
CASE 1
BYTE% = MLA% OR DEVADDR% 'GPIB device address
OUT (BADDRS% + 7), BYTE% 'Send out to GPIB card
CALL HS1 'Wait for recieved status
OUT (BADDRS% + 3), &H8A 'Request control, clear operation
OUT (BADDRS% + 3), &HB 'Remote enable, clear
FOR X1 = 1 TO LEN(DDATA$) 'Create character and send out
BYTE% = ASC(MID$(DDATA$, X1, 1))
OUT (BADDRS% + 7), BYTE%
CALL HS1
NEXT
OUT (BADDRS% + 7), &HD 'Send CR, tell device to execute command
CALL HS1 'Wait for recieved status
OUT (BADDRS% + 7), &HA 'Send LF
CALL HS1 'Wait for recieved status
OUT (BADDRS% + 3), &HC 'Remote enable, set operation
OUT (BADDRS% + 3), &HA 'Clear talk only
OUT (BADDRS% + 7), &H3F 'Un-listen
'Read
CASE 2
DDATA$ = ""
BYTE% = MTA% OR DEVADDR% 'GPIB device address
OUT (BADDRS% + 7), BYTE% 'Send out to GPIB card
CALL HS1 'Wait for recieved status
OUT (BADDRS% + 3), &H89 'Request control, clear
OUT (BADDRS% + 3), &HB 'Remote enable, clear
DO
CALL HS2
DATABYTE = INP(BADDRS% + 7)
IF DATABYTE <> &HA THEN
DDATA$ = DDATA$ + CHR$(DATABYTE)
END IF
LOOP WHILE DATABYTE <> &HA
OUT (BADDRS% + 3), &HC 'Remote enable, set command
OUT (BADDRS% + 3), &H9 'Clear listen only
OUT (BADDRS% + 7), &H5F 'Un-talk command
END SELECT
CALL HS1 'Wait for recieved status
END SUB
FUNCTION KEYBDIN$
'Get input from keyboard
DO
X$ = INKEY$
LOOP WHILE X$ = ""
KEYBDIN$ = UCASE$(X$)
END FUNCTION
SUB pause (TIME!)
T1! = TIMER
DO
T2! = TIMER
LOOP UNTIL (T2! - T1!) > TIME!
END SUB
FUNCTION POWERIO$ (DPSADDR%, CMD$)
'This function sends commands and receives output from the
'Kepco DPS 125-0.5M programmable power supply.
'Inputs: power supply address, command
'Outputs: supply response, if any
'Open and initialize the power supply controller communications channel for I/O
PSCOM$ = "COM" + RIGHT$(STR$(PSPORT%), 1) + ":9600,N,8,1"
OPEN PSCOM$ FOR RANDOM AS #1
DEVSEL = DPSADDR% + &HE0
RXOK = DPSADDR% + &HC0
'DEVSEL must be sent without a <CR>
'prior to each command
'Send DEVSEL byte to DPS
PRINT #1, CHR$(DEVSEL);
N = 0
'Await input buffer to become non-zero
'print message if not successful
DO
IF N > 5000 THEN
PRINT "COM ERROR - INPUT BUFFER EMPTY"
CLOSE #1 'close power supply communication channel
END 'exit program
END IF
N = N + 1
LOOP WHILE (LOC(1) = 0)
'RXOK is returned (without a <CR>) in
'response to DEVSEL
A$ = INPUT$(1, #1) 'Input RXOK byte
PRINT #1, CMD$
'Await input buffer to become non-zero
DO
LOOP WHILE (LOC(1) = 0)
A$ = INPUT$(1, #1) 'Input first (non-ASCII) character of
'string and discard
INPUT #1, B$ 'Input balance of string
POWERIO$ = B$
CLOSE #1 'close power supply communication channel
END FUNCTION
FUNCTION READDVM! (CH%, FUNC$, RANGETXT$, RANGENUM!, RESOLTXT$, RESOLNUM!)
' Inputs:
' CH% = channel to be measured
' FUNC$ = parameter to be measured
' RANGETXT$ = indicate how range is specified. 0 = text, 1 = numerically
' If "", range specified in RANGENUM! or not specified
' RANGENUM! = measurement range
' If 0, range specified in RANGETXT$ or not specified
' RESOLTXT$ = indicate how resolution is specified. 0 = text, 1 = numerically
' IF "", resolution specified in RESOLNUM! or not specified
' RESOLNUM! = measurement resolution
' 0 = Resolution specified in RESOLTXT$ or not specified
' Outputs: None
' Description - configures HP34970A to take a measurement, reads
' the DVM and returns the reading.
'
' Reference;
' MEAS and CONF use the following default instrument settings
' Integration Time 1PLC (5 1/2 digits, 20 bits)
' Input Resistane 10Mohm, fixed for all DCV ranges
' AC Filter 20Hz (medium)
' Scan List Redefined when command executed
' Scan Interval Source Immediate
' Scan Count 1 Scan Sweep
' Channel Delay Automatic Delay
'
' DVM Accuracy;
' The following specs use the 3Hz filter
' ACV +/-0.06% reading +/-0.04% range, 10Hz-20KHz, 0.1V - 100V, 1 year
' ACV +/-0.06% reading +/-0.04% range, 10Hz-20KHz, 0.1V - 100V, 1 year
' ACV +/-0.05% reading +/-0.08% range, 10Hz-20KHz, 300V, 90 day
' ACV +/-0.05% reading +/-0.08% range, 10Hz-20KHz, 300V, 90 day
'
' If the 20Hz filter is used, add the following low frequency error
' +/-0.06% reading, 40Hz-100Hz
' +/-0.01% reading, 100Hz-200Hz
' +/-0.0% reading, 200Hz->1000Hz
IF RANGENUM! <> 0 THEN 'Range specified numerically
RG$ = STR$(RANGENUM!) + ","
ELSE 'Range specified w/ text
RG$ = RANGETXT$ + ","
END IF
IF RESOLNUM! <> 0 THEN 'Resolution specified numerically
RES$ = STR$(RESOLNUM!) + ","
ELSE 'Resolution specified w/ text
IF RESOLTXT$ <> "" THEN
RES$ = RESOLTXT$ + ","
ELSE
RES$ = ""
END IF
END IF
DDATA$ = "MEAS:" + FUNC$ + "?" + RG$ + RES$ + "(@" + STR$(CH%) + ")"
'Y% = CSRLIN
'LOCATE 21
'PRINT "READDVM a" + DDATA$ + "b";
'PRINT SPC(10); : PRINT
'LOCATE Y%
CALL IO488(DDATA$, DASADDR%, 1) 'Write configuration
CALL IO488(DDATA$, DASADDR%, 2) 'Read result
READDVM! = VAL(DDATA$)
END FUNCTION
FUNCTION REPEAT$ (MN$, ELAP2!, TIME2!)
CLS
LOCATE 10, 10
PRINT "Do you want to test another set of "; MN$; " modules?"
LOCATE 23, 49
PRINT USING "Test Time: ## Min. ## Sec."; INT(ELAP2! / 60); ELAP2! - INT(ELAP2! / 60) * 60
DO
A$ = INKEY$
LOOP WHILE A$ = ""
IF UCASE$(A$) <> "N" THEN
LOCATE 12, 10
PRINT "Insert the next set of modules, starting with channel 1."
CALL CONTINUE
END IF
TIME2! = TIMER
REPEAT$ = UCASE$(A$)
END FUNCTION
SUB SETDAC3 (DACNUM%, VOLTAGE!)
'Sets the HP34907 DACs
'Both DACs are;
' +/-12V out
' 10mA max
' 1mV resolution
' ground referenced, cannot float
'
'DAC1 is on CH04, DAC2 is on CH05
'Inputs; DACNUM% 1 = DAC1, 2 = DAC2
' VOLTAGE! Voltage to set
SELECT CASE DACNUM%
CASE 1
CH% = DAC1.CH%
CASE 2
CH% = DAC2.CH%
END SELECT
DDATA$ = SETDAC$ + " " + STR$(VOLTAGE!) + ",(@" + STR$(CH%) + ")"
'Y% = CSRLIN
'LOCATE 21
'PRINT "SETDAC3 a" + DDATA$ + "b";
'PRINT SPC(10); : PRINT
'LOCATE Y%
CALL IO488(DDATA$, DASADDR%, 1) 'Write configuration
END SUB
SUB SETDPS (DPSADDR%, VSUPPLY!)
'Set supply voltage
SETP$ = POWERIO$(DPSADDR%, PSVOLT$ + RIGHT$(STR$(VSUPPLY!), LEN(STR$(VSUPPLY!)) - 1))
SETP$ = POWERIO$(DPSADDR%, SUPPLYON$) 'enable power supply output
CALL pause(.02) '20ms over-current prot. delay
IF POWERIO$(DPSADDR%, ISTAT$) = "RCS=01" THEN 'Check for over-current
SOUND 1000, .5
PRINT
PRINT TAB(10); "Module supply current has exceeded maximum value."
PRINT TAB(10); "Power supply has been disabled."
CALL pause(1)
'PRINT TAB(10); "Press any key to continue"
'A$ = KEYBDIN$
END IF
END SUB
SUB SETSWITCH (CH%, STATE%)
' Inputs:
' CH% = channel to be closed
' STATE% = switch state, 1 = CLOSED, 0 = OPEN
' Outputs: None
' Description - sets the specified switch on the HP34903A 20-channel
' actuator
IF STATE% = 1 THEN 'close switch
DDATA$ = "ROUT:CLOS " + "(@" + STR$(CH%) + ")"
ELSE 'String command only
DDATA$ = "ROUT:OPEN " + "(@" + STR$(CH%) + ")"
END IF
'Y% = CSRLIN
'LOCATE 22
'PRINT "SETSWITCH a" + DDATA$ + "b";
'PRINT SPC(10); : PRINT
'LOCATE Y%
CALL IO488(DDATA$, DASADDR%, 1) 'Write configuration
END SUB
FUNCTION UPSN$ (SN$, NUMDUT%)
'SN$ = NNNN-DD
N% = 1
WHILE MID$(SN$, N%, 1) <> "-"
' PRINT MID$(SN$, N%, 1)
SNTEMP$ = SNTEMP$ + MID$(SN$, N%, 1)
N% = N% + 1
WEND
L% = LEN(SN$)
UPSN$ = SNTEMP$ + "-" + LTRIM$(STR$(VAL(MID$(SN$, N% + 1, L% - N%)) + NUMDUT%))
END FUNCTION
Reference in New Issue View Git Blame Copy Permalink