
'                       Adjacent Channel Selectivity
'

'version 2      (colour)
' 4 may 95

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

DIM fr$(15)
DIM fr(15)

SCREEN 0
COLOR 14, 1, 9
CLS

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

 PRINT #4, "Adj Channel"
 SLEEP 5
 GOTO test

mar:
  IF sgen = 2 THEN RETURN
  IOCTL #1, "3" + CHR$(13)
  IOCTL #2, mar$ + CHR$(13)
  'PRINT mar$
RETURN

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

at:
COLOR 13
  IOCTL #1, atten$ + CHR$(13)
  IOCTL #2, at$ + CHR$(13)
  SLEEP 1
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
  adret$ = "F " + STR$(adfr)
  GOSUB adret

  mar$ = "cfrq " + fr$ + " mhz"
  GOSUB mar
RETURN

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

gpr:
COLOR 10
PRINT #3, gpr$
INPUT #3, r$
SLEEP 1
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
gpr$ = "REM": GOSUB gpr
mar$ = "*RST": GOSUB mar
SLEEP 2
mar$ = "rflv:ON": GOSUB mar
mar$ = "mod:off": GOSUB mar
adret$ = "FM 0": GOSUB adret

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$
LOCATE 5, 20
COLOR 14
PRINT "Adjacent Channel"
LOCATE 6, 20
PRINT "컴컴컴컴컴컴컴컴"



FOR flp = 1 TO 12
  READ fr(flp)
 
NEXT flp
  DATA 27,75,95,130,170,220,250,350,440,610,700,999

fail = 50
bw = 1

IF VAL(sn$) >= 3000 THEN new = 1 ELSE new = 0
IF new = 1 THEN fr(9) = 401

DO
  bw$ = STR$(bw)
  lp = 1
 
  DO
    fr$(lp) = STR$(fr(lp))
    gpr$ = "RD L": GOSUB gpr
    at$ = "A 100,": GOSUB at
    gpr$ = "BW " + bw$: GOSUB gpr
    mar$ = "rflv:OFF": GOSUB mar

    res$ = ""
    rc43$ = LEFT$(rec$, 2)
    IF rc43$ = "43" THEN
      IF lp = 7 OR lp = 8 THEN
        res$ = "----"
        bd$ = " "
        GOTO result
      END IF
    END IF

    ofs = 0: sgofs = 0
    fr$ = fr$(lp)
    gpf = VAL(fr$)
 
bird:
    ofs = 0
    blp = 1
    bird(2) = 0
DO
    
      gpf = gpf + ofs
      gpfr = gpf * 10000
      gpf& = gpfr * 100
      f$(blp) = STR$(gpf&)
     
      gpr$ = "FR" + f$(blp): GOSUB gpr
      SLEEP 3

      IF blp = 1 THEN
        gpr$ = "CL": GOSUB gpr
        SLEEP 7
      END IF

      gpr$ = "SG": GOSUB gpr
      bird(blp) = VAL(r$)
       IF bird(1) < -22 THEN blp = 4
      blp = blp + 1
      ofs = ofs + .0125
    LOOP UNTIL blp >= 3
                   
    IF bird(2) < bird(1) THEN
      f$ = f$(2)
      bd$ = "*"
    ELSE
      f$ = f$(1)
      gpr$ = "FR" + f$: GOSUB gpr
      bd$ = " "
    END IF
 
  sgfr = VAL(f$)
  sgfr = sgfr / 1000000
  fr$ = STR$(sgfr)
  GOSUB freq
  

  l$ = "-6": GOSUB lev
  mar$ = "rflv:ON": GOSUB mar
  SLEEP 2
  lev = -6

adjust:
  DO
    
    SLEEP 1
    gpr$ = "SG": GOSUB gpr
 
    adlev = VAL(r$)
    inlev = lev - adlev
      ilev = inlev * 10
      ilev% = ilev
      inlev = ilev / 10
    IF inlev <> 0 THEN
      l$ = STR$(inlev)
      lev = inlev
     
      IF lev > 13 THEN
        LOCATE 23, 20
        COLOR 28
        PRINT "!! E R R O R !!   "
        DO
          k$ = INKEY$
          BEEP
          SLEEP 3
          lev = -6
        LOOP UNTIL k$ <> ""
        LOCATE 10, 10
        PRINT "                                  "
        END IF
     
      GOSUB lev
    END IF
  LOOP UNTIL adlev = 0

  gf& = VAL(f$) + (12500 * bw)
  gf$ = STR$(gf&)
  gpr$ = "FR" + gf$: GOSUB gpr


  at$ = "A 50,": GOSUB at
  SLEEP 2
  gpr$ = "SG": GOSUB gpr
  statt% = VAL(r$)
  at = (50 + statt%) + 4
 
atts:
  DO
    at = at - 1
    att$ = STR$(at)
    at$ = "A " + att$ + ",": GOSUB at
    SLEEP 1
    gpr$ = "SG": GOSUB gpr
    r = VAL(r$)
  LOOP UNTIL r > -.5

average:
   avlp = 1
   DO
     gpr$ = "SG": GOSUB gpr
     r(avlp) = VAL(r$)
     avlp = avlp + 1
   LOOP UNTIL avlp = 6
   avres = r(1) + r(2) + r(3) + r(4) + r(5)
   avres = avres / 5
   

result:
  LOCATE 7 + lp, 10
  COLOR 11
  PRINT fr$(lp); " MHz  "
  LOCATE 7 + lp, 12 + (bw * 14)
 
IF res$ = "----" THEN
  COLOR 13
  PRINT res$
  ELSE
  COLOR 10
  res = (100 - at) - avres
  IF res <= fail THEN
    fail$ = "!"
    COLOR 12
  ELSE
    COLOR 10
    fail$ = " "
  END IF
  PRINT USING "###.#"; res;
  PRINT " dB  "; bd$; fail$

  res$ = STR$(res)
END IF
  PRINT #4, res$
  PRINT #4, bd$
'  PRINT #4, fail$
  lp = lp + 1

LOOP UNTIL lp = 13
bw = bw + 1
fail = 55
LOOP UNTIL bw = 3

mar$ = "*RST": GOSUB mar
gpr$ = "BW 1": GOSUB gpr
gpr$ = "LOC": GOSUB gpr

PRINT #4, "adj end"
CLOSE

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

END





