'
'                      Intermod
'

'version 2 (colour)
'4 May 95

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

sgen = VAL(sgcode$)

'sgen = 1
'atten$ = "27"
'sgen$ = "CH_039"

DIM fr(20)
DIM r(13)
DIM r$(20)
DIM res$(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

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

RETURN

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

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

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

at:
  COLOR 13
  IOCTL #1, atten$ + CHR$(13)
  IOCTL #2, at$ + CHR$(13)
  'PRINT at$
  SLEEP 1
RETURN


gpr:
   PRINT #3, gpr$
   SLEEP 1
   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
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$ = "TS 4": GOSUB gpr
gpr$ = "VN": GOSUB gpr

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$

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


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
  adjlp = 1
  at$ = "A 0,": GOSUB at

' turn off sig gens
teststart:
  martop$ = "rflv:OFF": GOSUB martop
  marbot$ = "rflv:OFF": GOSUB marbot
  adrtop$ = "A -120": GOSUB adrtop
  adrbot$ = "A -120": GOSUB adrbot
  marbot$ = "rflv -100 dbm": GOSUB marbot
  martop$ = "rflv -100 dbm": GOSUB martop

  IF adjlp = 11 THEN
    at$ = "A 3,": GOSUB at
  END IF

  rescol = 13
  res$(lp) = "----"
 
  lev = 1
  rc43$ = LEFT$(rec$, 2)
  IF rc43$ = "43" THEN
    IF lp = 8 OR lp = 7 THEN GOTO result
  END IF
 
  fr1 = fr(lp)
 
birdy:
  bdy = 1
  ofs = .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 6
    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
    bdy$ = "*"
    fr& = gpf&(2)
  ELSE
    bdy$ = " "
    fr& = gpf&(1)
  END IF
 
  fr& = fr& - 100000
  gpf$ = STR$(fr&)
  gpr$ = "FR" + gpf$: GOSUB gpr
  SLEEP 5
  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 sigset
    END IF
    fu = fu + 1
  LOOP UNTIL fu = 8
 
sigset:
  fr1$ = STR$(fr&)
  fr2& = fr& + 50000
  fr3& = fr& + 100000
  fr2$ = STR$(fr2&)
  f3$ = STR$(fr3&)

  marbot$ = "cfrq " + fr1$ + " Hz": GOSUB marbot
  marbot$ = "rflv -32 dbm": GOSUB marbot
  martop$ = "cfrq " + fr2$ + " Hz": GOSUB martop
  martop$ = "rflv -32 dbm": GOSUB martop

  adrbot$ = "F" + fr1$: GOSUB adrbot
  adrtop$ = "F" + fr2$: GOSUB adrtop
 
  martop$ = "rflv:ON": GOSUB martop
  marbot$ = "rflv:ON": GOSUB marbot
  adrtop$ = "A -30": GOSUB adrtop
  adrbot$ = "A -30": GOSUB adrbot
 
adj2:
 
    lv = 59
    sglev = -32
    adjlp = 1
    DO
      l$ = STR$(sglev)
      marbot$ = "rflv " + l$ + " dbm": GOSUB marbot
     
      gpr$ = "SG": GOSUB gpr
      adlev = VAL(r$)
     
      sglev = sglev + .1
    LOOP UNTIL adlev = 59
    BEEP
   
    gpr$ = "FR " + fr2$
    GOSUB gpr
 
 
adj1:
    lv = 59
    sglev = -32
    adjlp = 1
    DO
      l$ = STR$(sglev)
      martop$ = "rflv " + l$ + " dbm": GOSUB martop
    
      gpr$ = "SG": GOSUB gpr
      adlev = VAL(r$)
    
      sglev = sglev + .1
    LOOP UNTIL adlev = 59
    
  BEEP
  SLEEP 1

  
            
  gpr$ = "FR " + f3$
  GOSUB gpr

   lev = 0
  SLEEP 1
  gpr$ = "SG": GOSUB gpr
  res = 59 - VAL(r$)
  resl = VAL(r$)

result:
  COLOR 11
  LOCATE 7 + lp, 10
  PRINT fr(lp); " MHz";
  PRINT "  "; bdy$;
  PRINT TAB(30);
 
 
  IF lev = 1 THEN
     COLOR 13
     PRINT res$(lp);
     PRINT TAB(50);
     PRINT res$(lp)
     r$ = res$(lp)

  ELSE
    cr = 10
    COLOR cr
    PRINT USING "###.#"; resl;
    PRINT TAB(50);
    PRINT USING "###.#"; res;
    PRINT " dBæV"
    res$(lp) = STR$(res)
  END IF
 
  lev = 0
  frs$ = STR$(fr(lp))
  PRINT #4, frs$, r$, res$(lp)
  PRINT #4, bdy$
  lp = lp + 1
LOOP UNTIL lp = 3
    
martop$ = "*RST": GOSUB martop
marbot$ = "*RST": GOSUB marbot
at$ = "A 100,": GOSUB at
gpr$ = "LOC": GOSUB gpr

PRINT #4, "Inter end"
CLOSE

DATA 90, 190
'DATA 27,75,95,130,170,220,250,350,440,700,999
SLEEP 5

IF ctr$ = "1" THEN CHAIN "C:\qb\gpr4200\results"
CHAIN "c:\qb\gpr4200\menu"

END

