'
'                      Blocking
'
' version 2     (colour)
' 4 May 95

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


SCREEN 8
CLS
COLOR 14
PRINT "Blocking"
COLOR 11
LOCATE 10, 10
PRINT "Connect as procedure"
LOCATE 15, 10
PRINT "Press space to go on"


k = 1
k$ = ""
DO
  IF k < 4 THEN BEEP
  k = k + 1
  IF k = 1500 THEN k = 1
  k$ = INKEY$
LOOP UNTIL k$ = " "

DIM fr(20)
DIM r(12)
DIM r$(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\gpr4200\res\file" FOR APPEND AS #4

 SLEEP 5
 GOTO test

marbot:
 IF sgen = 2 THEN RETURN
 COLOR 11
 IOCTL #1, "3" + CHR$(13)
 IOCTL #2, marbot$ + CHR$(13)
RETURN

martop:
  IF sgen = 2 THEN RETURN
  IOCTL #1, "2" + CHR$(13)
  IOCTL #2, martop$ + CHR$(13)
RETURN


adrtop:
   IF sgen = 1 THEN RETURN
   IOCTL #1, "3" + CHR$(13)
   IOCTL #2, adrtop$ + CHR$(13)
   FOR t = 1 TO 500: NEXT t
RETURN

adrbot:
  IF sgen = 1 THEN RETURN
  IOCTL #1, "2" + CHR$(13)
  IOCTL #2, adrbot$ + CHR$(13)
  FOR t = 1 TO 500: NEXT t
RETURN

at:
  IOCTL #1, atten$ + CHR$(13)
  IOCTL #2, at$ + CHR$(13)
  SLEEP 1
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

martop$ = "*RST": GOSUB martop
martop$ = "mod:OFF": GOSUB martop
martop$ = "FSTD ext10": GOSUB martop
marbot$ = "*RST": GOSUB marbot
marbot$ = "mod:OFF": GOSUB marbot
marbot$ = "FSTD int10": GOSUB marbot

SLEEP 2
gpr$ = "REM": GOSUB gpr

gpr$ = "TS 4": GOSUB gpr
gpr$ = "VN": GOSUB gpr
marbot$ = "rflv:ON": GOSUB marbot
martop$ = "rflv:ON": GOSUB martop
SLEEP 2

rec$ = LEFT$(r$, 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$ = "Blocking"
COLOR 14
LOCATE 5, 20
PRINT title$
PRINT #4, title$

at$ = "A 87,": GOSUB at

gpr$ = "BW 1": GOSUB gpr
gpr$ = "RD L": GOSUB gpr
SLEEP 2

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


lp = 1
DO
  at$ = "A 100,": GOSUB at
  rescol = 13
  r$(lp) = "----"
  r$(lp) = "----"
  lev = 1
  rc43$ = LEFT$(rec$, 2)
  IF rc43$ = "43" THEN
   IF lp = 8 OR lp = 7 THEN GOTO endlp
  END IF

gprcal:
  fr1 = fr(lp)
  fr1$ = STR$(fr1)

bird:
  ofs = 0
  bdy = 1
  bird(2) = 0
  DO
    gpf = fr1 + ofs
    gpf = gpf * 10000
    gpf&(bdy) = gpf * 100
    gpf$(bdy) = STR$(gpf&(bdy))
       
    gpr$ = "FR" + gpf$(bdy): GOSUB gpr
    SLEEP 10
    gpr$ = "CL": GOSUB gpr
    SLEEP 5
    gpr$ = "SG": GOSUB gpr
    bird(bdy) = VAL(r$)
      IF bird(1) < -22 THEN bdy = 4
    bdy = bdy + 1
    ofs = ofs + .0125
  LOOP UNTIL bdy >= 3

    IF bird(1) <= bird(2) THEN
      fr1& = gpf&(1)
      gpf$ = gpf$(1)
      bdy$ = " "
      IF bdy <> 4 THEN
        gpr$ = "FR " + gpf$: GOSUB gpr
        SLEEP 10
        gpr$ = "CL": GOSUB gpr
        SLEEP 5
      END IF
    ELSE
      gpf$ = gpf$(2)
      fr1& = gpf&(2)
      bdy$ = "*"
    END IF


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 frset
    END IF
    fu = fu + 1
  LOOP UNTIL fu = 8

frset:
  fr1$ = STR$(fr1&)
  fr2& = fr1& + 2000000
  fr2$ = STR$(fr2&)
 
  marbot$ = "cfrq " + fr1$ + " hz": GOSUB marbot
  martop$ = "cfrq " + fr2$ + " hz": GOSUB martop
  martop$ = "rflv -87 dbm": GOSUB martop
 
  af1! = fr1&
  af1$ = STR$(af1)
  af2! = fr2&
  af2$ = STR$(af2)
  adrbot$ = "F" + af1$: GOSUB adrbot
  adrtop$ = "F" + af2$: GOSUB adrtop
  adrtop$ = "A -87": GOSUB adrtop

  adjlev = 0
sigset:
 
  atlev = 100 - adjlev
  atlev$ = STR$(atlev)
  rflev = 13 - adjlev
  rflev$ = STR$(rflev)

  adrbot$ = "A" + rflev$: GOSUB adrbot
  marbot$ = "rflv" + rflev$ + " dbm": GOSUB marbot
  at$ = "A" + atlev$ + ",": GOSUB at

  
adjbot:
  lv = rflev
  adjlp = 1
  DO
    SLEEP 1
    gpr$ = "SG": GOSUB gpr
    adlev = VAL(r$)
    inlev = lv - adlev
     
      ilev = inlev * 10
      ilev% = ilev
      inlev = ilev% / 10
   
    IF adlev <> 0 THEN
      IF inlev > 13 THEN
        inlev = 13
        adjlp = 10
      END IF
      l$ = STR$(inlev)
      adrbot$ = "A" + l$: GOSUB adrbot
      marbot$ = "rflv " + l$ + " dbm": GOSUB marbot
      lv = inlev
    END IF
   
    adjlp = adjlp + 1
    IF adjlp = 11 THEN
      adjlev = adjlev + 2
      GOTO sigset
    END IF

  LOOP UNTIL adlev = 0
  BEEP

  gpr$ = "FR " + fr2$
  GOSUB gpr
 
 
adjtop:
  adjlp = 1
  lv = -87
  DO
    SLEEP 1
    gpr$ = "SG": GOSUB gpr
    adlev! = VAL(r$)
    inlev = lv - adlev!
       ilev = inlev * 10
       ilev% = ilev
       inlev = ilev% / 10

    IF adlev! <> 0 THEN
      l$ = STR$(inlev)
      adrtop$ = "A" + l$: GOSUB adrtop
      martop$ = "rflv " + l$ + " dbm": GOSUB martop
      lv = inlev
    END IF
    adjlp = adjlp + 1
    IF adjlp = 11 THEN GOTO gprcal

  LOOP UNTIL adlev! = 0
  BEEP

atts:
   atst = 21 - adjlev
   atst$ = STR$(atst)
   at$ = "A" + atst$ + ",": GOSUB at
   atlp = 1
   DO

     att = atst - atlp
     att$ = STR$(att)
     at$ = "A" + att$ + ","
     GOSUB at
     gpr$ = "SG": GOSUB gpr
     blk = VAL(r$)
     lev = 0
       IF blk > 1 THEN
         dp = blk - 1
         GOTO result
       END IF
       IF blk < -1 THEN
         dp = blk + 1
         dp = 0 - dp
         GOTO result
       END IF
     atlp = atlp + 1
   LOOP UNTIL atlp = 20
  
   END
   
result:
  res = (atlev - att) - dp
endlp:
  COLOR 11
  LOCATE 7 + lp, 10
  PRINT fr(lp); " MHz";
  LOCATE 7 + lp, 20
 
 
  IF lev = 1 THEN
     COLOR 13
     PRINT " ----"
     bdy$ = " "
  ELSE
    COLOR 10
    PRINT USING "###.#"; res;
    PRINT " dBæV";
    PRINT "  "; bdy$
    r$(lp) = STR$(res)
  END IF
 
  fr$ = STR$(fr(lp))
  lev = 0
  PRINT #4, fr$, r$(lp)
  PRINT #4, bdy$
 
  lp = lp + 1
LOOP UNTIL lp = 3

PRINT : PRINT TAB(20); "*   'birdy' at this test  "
gpr$ = "BW 1": GOSUB gpr
gpr$ = "LOC": GOSUB gpr
martop$ = "*RST": GOSUB martop
marbot$ = "*RST": GOSUB marbot

 DATA 90,190

'DATA 27,75,95,130,170,220,250,350,440,700,999


SLEEP 5
PRINT #4, "Block end"

CLOSE
CHAIN "c:\qb\gpr4200\inter"

END

