'
'                      Level  Accuracy
'
'version 2
'4 may 95

COMMON sgcode$, atten$, sgen$, ch$, ctr$

CLOSE
sgen = VAL(sgcode$)
sgen = 1
atten$ = "27"
'sgen$ = "CH_039"
'ctr$="1"


DIM r$(3, 20)
DIM r(3, 20)
DIM sgfr(20)
DIM sglv(20)
DIM fr(20)

SCREEN 9
CLS
COLOR 14, 1
start:
' initial set up of gp-ib

 OPEN "ieeectrl" FOR RANDOM AS #1
 OPEN "ieeedata" FOR RANDOM AS #2
 IOCTL #1, "init" + CHR$(13)
 IOCTL #1, "clear" + CHR$(13)
 IOCTL #1, "to 10 end=13 eos=13" + CHR$(13)

 OPEN "com2:9600,n,8,2" FOR RANDOM AS #3
 OPEN "c:\qb\gpr\res\file" FOR APPEND AS #4
 OPEN "c:\qb\gpr\siggen\" + sgen$ FOR INPUT AS #5

lp = 1
DO
INPUT #5, xx$

sgfr(lp) = VAL(LEFT$(xx$, 4))
sglv(lp) = VAL(RIGHT$(xx$, 5))
lp = lp + 1
LOOP UNTIL lp = 15

sgfr(12) = sgfr(13): sglv(12) = sglv(13)
sgfr(13) = sgfr(14): sglv(13) = sglv(14)


 SLEEP 5
 GOTO test

mar:
  IF sgen = 2 THEN RETURN

 COLOR 11
 IOCTL #1, "3" + CHR$(13)
 IOCTL #2, mar$ + CHR$(13)
RETURN

adret:
  IF sgen = 1 THEN RETURN

  COLOR 10
  IOCTL #1, "3" + CHR$(13)
  IOCTL #2, adret$ + CHR$(13)
  'PRINT adret$
RETURN

at:
COLOR 13

  IOCTL #1, atten$ + CHR$(13)
  IOCTL #2, at$ + CHR$(13)
  FOR t = 1 TO 500: NEXT t

  'LOCATE 18, 40
  'PRINT at$
  'SLEEP
  'LOCATE 18, 40
  'PRINT "            "
RETURN

ip:
COLOR 14
   ip$ = IOCTL$(#2)
'   PRINT ip$
   ip# = VAL((MID$(ip$, s, e)))
   RETURN

freqip:
mar$ = "cfrq?": GOSUB mar
s = 12
e = 14
GOSUB ip
ip# = ip# / 1000000
'PRINT ip#; " MHz"
RETURN

levip:
mar$ = "rflv?": GOSUB mar
s = 22
e = 6
GOSUB ip
u$ = MID$(ip$, 12, 4)
'PRINT ip#; u$
RETURN

freq:

adfr = VAL(fr$)
adfr = adfr * 1000000
adfr$ = STR$(adfr)

adret$ = "F " + adfr$
mar$ = "cfrq " + fr$ + " mhz"
GOSUB mar
GOSUB adret
RETURN

lev:
  adret$ = "A" + l$
  mar$ = "rflv " + l$ + "dbm"
  GOSUB mar
  GOSUB adret
RETURN

gpr:
  
   PRINT #3, gpr$
   SLEEP 1
   INPUT #3, r$
   
er$ = LEFT$(r$, 1)

IF er$ <> "E" THEN RETURN
IF gpr$ = "REM" THEN RETURN


eror:
BEEP
COLOR 15
PRINT
PRINT "                 Error in GPR code   :    "; gpr$
BEEP
SLEEP
RETURN


test:
at$ = "A 100,": GOSUB at
mar$ = "*RST": GOSUB mar
mar$ = "imode normal": GOSUB mar
mar$ = "MOD:off": GOSUB mar
SLEEP 2
mar$ = "rflv:ON": GOSUB mar
gpr$ = "REM": GOSUB gpr

gpr$ = "TS 6": GOSUB gpr
gpr$ = "VN": GOSUB gpr

rec$ = LEFT$(r$, 4)

'************************************************************
IF VAL(LEFT$(r$, 5)) = 4305 THEN rec$ = MID$(STR$(4301), 2, 4)
'************************************************************

sn$ = RIGHT$(r$, 4)
fv$ = MID$(r$, 5, 5)
COLOR 15
PRINT "Receiver type         GPR"; rec$
PRINT "Serial no.               "; sn$
PRINT "Firmware version        "; fv$

title$ = "Level Accuracy"
COLOR 14
LOCATE 5, 20
PRINT title$
PRINT #4, title$

at$ = "A 87,": GOSUB at
l$ = "0": GOSUB lev
gpr$ = "BW 1": GOSUB gpr
gpr$ = "RD L": GOSUB gpr
gpr$ = "AT N": GOSUB gpr
SLEEP 2

lp = 1
DO
  READ fr(lp)
  lp = lp + 1
LOOP UNTIL lp = 14

fail = 3
lp = 1
DO
  fail$(1) = ""
  fail$(2) = ""
  r$(1, lp) = "----"
  r$(2, lp) = "----"
  at$ = "A87,": GOSUB at
 
  lev = 1
  rc43$ = LEFT$(rec$, 2)
  IF rc43$ = "43" THEN
    IF lp = 8 OR lp = 6 OR lp = 7 THEN GOTO endlp
  END IF
 
  fr& = sgfr(lp) * 1000000
  f$ = STR$(fr&)
  fr$ = STR$(fr(lp))
  GOSUB freq
 
  l$ = STR$(sglv(lp))
  GOSUB lev

  
  gpr$ = "FR " + f$
  GOSUB gpr
  SLEEP 10
  gpr$ = "CL": GOSUB gpr
  SLEEP 5

fault:
  gpr$ = "RS": GOSUB gpr
  fu = 2
  DO
    uc$ = MID$(r$, fu, 1)
    IF uc$ <> "-" THEN
      BEEP
      LOCATE 7 + lp, 44
        IF uc$ = "U" THEN fault$ = "Un Cal"
        IF uc$ = "L" THEN fault$ = "Battery"
        IF uc$ = "O" THEN fault$ = "Lock"
        IF uc$ = "R" THEN fault$ = "Range"
        IF uc$ = "V" THEN fault$ = "Overload"
        COLOR 12
      PRINT "GPR ( "; fault$; " ) Fault at"; fr(lp); " MHz"
      BEEP
      lev = 1
      SLEEP 1
      GOTO endlp
    END IF
    fu = fu + 1
  LOOP UNTIL fu = 8

  atlp = 1
  lev = 0
  DO
    SLEEP 10
    gpr$ = "SG": GOSUB gpr
    r(atlp, lp) = VAL(r$)
    r$(atlp, lp) = r$
    atlp = atlp + 1
    at$ = "A 27,": GOSUB at
  LOOP UNTIL atlp = 3

endlp:
COLOR 11
  LOCATE 7 + lp, 10
  PRINT fr(lp); " MHz";
  LOCATE 7 + lp, 20
 
  IF lev = 1 THEN
     COLOR 13
     PRINT " ----"
     LOCATE 7 + lp, 35
     PRINT " ----"
 ELSE
    
    f1 = 20 - r(1, lp)
    f2 = 80 - r(2, lp)
    IF f1 > fail OR f1 < -fail THEN
      fail$(1) = "!"
      COLOR 12
    ELSE
        fail$(1) = ""
        COLOR 10
    END IF
    PRINT USING "###.#"; r(1, lp);
    PRINT " dBæV  "; fail$(1);
    LOCATE 7 + lp, 35
    IF f2 > fail OR f2 < -fail THEN
      fail$(2) = "!"
      COLOR 12
    ELSE
      fail$(2) = ""
      COLOR 10
    END IF
    PRINT USING "###.#"; r(2, lp);
    PRINT " dBæV  "; fail$(2)
  END IF
  lev = 0
  fr$ = STR$(fr(lp))
  PRINT #4, fr$, r$(1, lp), r$(2, lp)
  PRINT #4, fail$(1)
  PRINT #4, fail$(2)

  fail = 1.5
  lp = lp + 1
LOOP UNTIL lp = 14
   
mar$ = "*RST": GOSUB mar

gpr$ = "BW 1": GOSUB gpr
gpr$ = "LOC": GOSUB gpr

DATA 20,50,105,150,210,240,325,390,451,610,720,910,999

SLEEP 5
PRINT #4, "la end"

CLOSE
IF ctr$ = "1" THEN CHAIN "c:\qb\gpr\bwlev"
CHAIN "c:\qb\gpr\menu"

END

