COMMON sgcode$, atten$, sgen$, CH$, ctr$

DEFINT A-Z
'---- assembly language functions and subroutines
DECLARE FUNCTION PeekWord% (BYVAL Segment, BYVAL Address)
DECLARE SUB MouseInt (MouseRegs AS ANY)


'---- BASIC functions and subprograms
DECLARE FUNCTION Bin2Hex% (Binary$)
DECLARE FUNCTION MouseThere% ()
DECLARE FUNCTION WaitButton% ()
DECLARE SUB CursorShape (HotX, HotY, Shape())
DECLARE SUB HideCursor ()
DECLARE SUB MouseTrap (ULRow, ULCol, LRRow, LRCol)
DECLARE SUB MoveCursor (x, y)
DECLARE SUB readcursor (x, y, Buttons)
DECLARE SUB ShowCursor ()
DECLARE SUB TextCursor (FG, BG)

DECLARE SUB prompt (Message$, hps, vps, col) 'used for this demo only


TYPE MouseType                  'similar to DOS Registers
  AX      AS INTEGER
  BX      AS INTEGER
  CX      AS INTEGER
  DX      AS INTEGER
  Segment AS INTEGER
END TYPE



CLOSE
mo = 1

RESTORE month
DIM mon$(13)
FOR mo = 1 TO 12
  mon$(mo) = ""
  READ mon$(mo)
NEXT mo

month:
DATA "Jan","Feb","Mar","Apr","May","Jun"
DATA "Jul","Aug","Sep","Oct","Nov","Dec"

atten$ = "7"
sgcode$ = "1"
IF LEFT$(sgen$, 2) <> "CH" THEN sgen$ = "CH_039"
ctr$ = ""
CH$ = ""

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

  PRINT #1, "3" + CHR$(13)
  PRINT #2, "*RST" + CHR$(13)
  SLEEP 3

  PRINT #1, "3" + CHR$(13)
  PRINT #2, "*IDN?" + CHR$(13)
  idn$ = IOCTL$(#2)
  
  id$ = MID$(idn$, 33, 3)
  IF id$ = "006" THEN
    sgen$ = "CH_055"
    sg$ = "Marconi 2024"
  END IF

  IF id$ = "23," THEN
    sgen$ = "CH_054"
    sg$ = "Marconi 2042"
  END IF

  id$ = MID$(idn$, 40, 3)
  IF id$ = "038" THEN
    sgen$ = "CH_039"
    sg$ = "Marconi 2031"
  END IF

  IF id$ = "021" THEN
    sgen$ = "CH_0117"
    sg$ = "Marconi 2031"
  END IF

  IF LEFT$(sg$, 3) <> "Mar" THEN
    sgen$ = "CH_0108"
    sg$ = "Adret"
    sgcode$ = "2"
  END IF



menu:
SCREEN 8
CLS
LOCATE 1, 70
PRINT "Version 2.1"
LOCATE 2, 30
'COLOR 14, 1
PRINT "GPR  TEST PROGRAM"
LINE (220, 5)-(380, 18), 11, B
LINE (222, 3)-(382, 3), 11
LINE (382, 3)-(382, 16), 11
LINE (224, 1)-(384, 1), 11
LINE (384, 1)-(384, 14), 11

choice:

GOSUB mouseprog

IF ky$ = "a" OR ky$ = "A" THEN
  CH$ = "A"
  ky$ = ""
END IF

IF ky$ <> "" THEN
  ky$ = RIGHT$(ky$, 1)
'  PRINT ky$

  IF ky$ = ";" THEN ky = 1
  IF ky$ = "<" THEN ky = 2
  IF ky$ = "=" THEN ky = 3
  IF ky$ = ">" THEN ky = 4
  IF ky$ = "?" THEN ky = 5
  IF ky$ = "@" THEN ky = 6
  IF ky$ = "A" THEN ky = 7
  IF ky$ = "B" THEN ky = 8
  IF ky$ = "C" THEN ky = 9
  IF ky$ = "D" THEN ky = 10
  IF ky$ = CHR$(133) THEN ky = 11
  IF ky$ = "s" OR ky$ = "S" THEN CH$ = "S"
  IF ky$ = "R" OR ky$ = "r" THEN CH$ = "R"
  IF ky$ = "e" OR ky$ = "E" THEN CH$ = "E"

  END IF
IF ky >= 1 AND ky < 12 THEN CH$ = STR$(ky)
CH$ = UCASE$(CH$)

IF CH$ = "A" THEN
  GOSUB newfile
  ctr$ = "1"
  CHAIN "c:\qb\gpr\conn2"
END IF
 
IF CH$ = "E" THEN
  CLS
  END
END IF

IF CH$ = "R" THEN
  CHAIN "c:\qb\gpr\results"
END IF
CLOSE

IF CH$ = "S" THEN
  GOSUB newfile
END IF


link:
CH = VAL(CH$)
IF CH < 1 OR CH > 12 THEN GOTO menu

ctr$ = "2"

  OPEN "c:\qb\gpr\res\file" FOR APPEND AS #4
  GOSUB info

IF CH = 11 THEN CHAIN "c:\qb\gpr\blk_int"
IF CH < 1 OR CH > 10 THEN GOTO menu
IF CH = 10 THEN CHAIN "c:\qb\gpr\conn1"
CHAIN "c:\qb\gpr\conn2"

END


newfile:
  OPEN "c:\qb\gpr\res\file" FOR OUTPUT AS #4

info:

OPEN "com2:9600,n,8,2" FOR RANDOM AS #3

gpr$ = "REM": GOSUB gpr
gpr$ = "VN": GOSUB gpr

rec$ = LEFT$(r$, 5)
rec42$ = LEFT$(r$, 2)

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

  IF rec42$ = "42" THEN
    CLS
    BEEP
    LOCATE 10, 10
    BEEP
    COLOR 11
    PRINT " GPR 42xx Type"
    LOCATE 12, 10
    SLEEP 2
    BEEP
    PRINT " the program will divert to GPR 4200 series calibration"
    BEEP
    CLOSE
    SLEEP 2
    CHAIN "c:\qb\gpr4200\conn0"
  END IF

sn$ = RIGHT$(r$, 5)
fw$ = MID$(r$, 6, 5)

gpr$ = "LU 1": GOSUB gpr
gpr$ = "LD 2": GOSUB gpr
gpr$ = "FR 100000000": GOSUB gpr
gpr$ = "RD L": GOSUB gpr
gpr$ = "BW 1": GOSUB gpr
gpr$ = "LOC": GOSUB gpr

date:

yy$ = RIGHT$(DATE$, 4)
dd$ = MID$(DATE$, 4, 2)
mm$ = LEFT$(DATE$, 2)
mm = VAL(mm$)
mon$ = mon$(mm)
d$ = dd$ + " . " + mon$ + " . " + yy$


  PRINT #4, "info"
  PRINT #4, rec$
  PRINT #4, sn$
  PRINT #4, fw$
  PRINT #4, d$
  PRINT #4, "Info end"

CLOSE
RETURN

gpr:
  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 : PRINT "Error in GPR code....           "; gpr$
  BEEP
  SLEEP
RETURN


mouseprog:


DIM SHARED MouseRegs AS MouseType 'so all the subs can get at them
DIM SHARED MousePresent
REDIM Cursor(1 TO 32)           'holds the cursor shape definition

IF NOT MouseThere% THEN         'ensure that a mouse is present
  PRINT "No mouse is installed" '  and initialize it if so
  END
END IF
'CLS


DEF SEG = 0                     'see what type of monitor
IF PEEK(&H463) <> &HB4 THEN     'if it's color
  ColorMon = -1                 'remember that for later
 ' SCREEN 12                     'this requires a VGa
 ' LINE (0, 0)-(639, 460), 1, BF 'paint a blue background
END IF


DIM choice$(20)                  'display some choices on the screen,
DIM lp(25)
DIM yp(25)
DIM yb(25)
DIM yt(25)
DIM xp(25)
DIM xr(25)
DIM xl(25)
DIM xx(25)
DIM col(25)
DIM CH$(20)
                              
RESTORE choices
FOR lp = 1 TO 15
  READ choice$(lp), yp(lp), xp(lp), col(lp)
  CALL prompt(choice$(lp), yp(lp), xp(lp), col(lp))
 
  yt(lp) = ((yp(lp) - 1) * 8) - 1
  yb(lp) = yt(lp) + 7
  xl(lp) = xp(lp) * 7
  xr(lp) = xl(lp) + 300
NEXT

choices:
DATA "F1..    Input Level Accuracy",5,10,11
DATA "F2..    Bandwidth Level Accuracy",6,10,11
DATA "F3..    Linearity",7,10,11
DATA "F4..    Attenuator Accuracy",8,10,11
DATA "F5..    A.M. Modulation",9,10,11
DATA "F6..    F.M. Deviation",10,10,11
DATA "F7..    Adjacent Channel Selectivity",11,10,11
DATA "F8..    Image Rejection",12,10,11
DATA "F9..    I.F. Rejection",13,10,11
DATA "F10.     Noise Floor",14,10,11
DATA "F11.     Blocking & Intermodulation",15,10,11
DATA "A..     All Tests",17,10,13
DATA "R..     Results",18,10,10
DATA "S..     Start A New File",19,10,15
DATA "E..     Exit",20,10,12


IF NOT ColorMon THEN            'if it's not color
  CALL TextCursor(-2, -2)       'select a text cursor
END IF


CALL ShowCursor
CALL prompt("or    Press a key ( F1 - F11 , a, r, s ,e )  ", 25, 12, 10)
CALL prompt("Point the cursor at a choice, and press a button ", 24, 10, 14)

mouse:
DO                              'wait for a button press
  CALL readcursor(x, y, button)
  ky$ = INKEY$

lp = 1
DO
  IF xx(lp) = 0 THEN
    IF y > yt(lp) AND y < yb(lp) AND x > xl(lp) AND x < xr(lp) THEN
      xx(lp) = 1
      CALL prompt(choice$(lp), yp(lp), xp(lp), 14)
    END IF
  ELSE
    IF y < yt(lp) OR y > yb(lp) OR x < xl(lp) OR x > xr(lp) THEN
      xx(lp) = 0
      CALL prompt(choice$(lp), yp(lp), xp(lp), col(lp))
    END IF
  END IF

  lp = lp + 1
  LOOP UNTIL lp = 16
LOOP UNTIL button OR ky$ <> ""

IF ky$ <> "" THEN GOTO mouseoff

buttpress:
IF button AND 4 THEN button = 3 'for three-button mice
lp = 1
DO
IF y > yt(lp) AND y < yb(lp) AND x > xl(lp) AND x < xr(lp) THEN
  xy = 1
  CALL prompt("You Pressed  " + choice$(lp), 22, 18, col(lp))
    CH$ = STR$(lp)
    IF lp = 12 THEN CH$ = "a"
    IF lp = 13 THEN CH$ = "r"
    IF lp = 14 THEN CH$ = "s"
    IF lp = 15 THEN CH$ = "e"

END IF
lp = lp + 1
LOOP UNTIL lp = 16
IF xy = 0 THEN GOTO mouse


'CALL prompt("You pressed button" + STR$(button) + " and the cursor was at location" + STR$(x) + "," + STR$(y) + " - press a button.", 25, 1, 10)

mouseoff:

IF ColorMon THEN                      'if it is a color monitor
  RESTORE hourglass                 '  load a custom arrow
  GOSUB definecursor
  CALL prompt("                                                         ", 24, 10, 11)
  CALL prompt("                                                         ", 25, 10, 10)
END IF


dummy = InitMouse%              'reset the mouse driver
'CALL HideCursor                 'and turn off the cursor
'SCREEN 0                        'revert to text mode
RETURN

definecursor:
FOR x = 1 TO 32                 'read 32 words of data
  READ Dat$                     'read the data
  Cursor(x) = Bin2Hex%(Dat$)    'convert to integer
NEXT
CALL CursorShape(Zero, Zero, Cursor())
RETURN



arrow:

NOTES:
'The first group of binary data is the screen mask.
'The second group of binary data is the cursor mask.
'The cursor color is black where both masks are 0.
'The cursor color is XORed where both masks are 1.
'The color is clear where the screen mask is 1 and the cursor mask is 0.
'The color is white where the screen mask is 0 and the cursor mask is 1.
'
'--- this is the screen mask
DATA "1110011111111111"
DATA "1110001111111111"
DATA "1110000111111111"
DATA "1110000011111111"
DATA "1110000001111111"
DATA "1110000000111111"
DATA "1110000000011111"
DATA "1110000000001111"
DATA "1110000000000111"
DATA "1110000000000011"
DATA "1110000000000001"
DATA "1110000000011111"
DATA "1110001000011111"
DATA "1111111000011111"
DATA "1111111100011111"
DATA "1111111110001111"

'---- this is the cursor mask
DATA "0001100000000000"
DATA "0001010000000000"
DATA "0001001000000000"
DATA "0001000100000000"
DATA "0001000010000000"
DATA "0001000001000000"
DATA "0001000000100000"
DATA "0001000000010000"
DATA "0001000000001000"
DATA "0001000000000100"
DATA "0001000000111110"
DATA "0001001100100000"
DATA "0001110100100000"
DATA "0000000010010000"
DATA "0000000010010000"
DATA "0000000001110000"



crosshairs:

DATA "1111111101111111"
DATA "1111111101111111"
DATA "1111111101111111"
DATA "1111000000000111"
DATA "1111011101110111"
DATA "1111011101110111"
DATA "1111011111110111"
DATA "1000000111000000"
DATA "1111011111110111"
DATA "1111011101110111"
DATA "1111011101110111"
DATA "1111000000000111"
DATA "1111111101111111"
DATA "1111111101111111"
DATA "1111111101111111"
DATA "1111111111111111"

DATA "0000000010000000"
DATA "0000000010000000"
DATA "0000000010000000"
DATA "0000111111111000"
DATA "0000100010001000"
DATA "0000100010001000"
DATA "0000100000001000"
DATA "0111111000111111"
DATA "0000100000001000"
DATA "0000100010001000"
DATA "0000100010001000"
DATA "0000111111111000"
DATA "0000000010000000"
DATA "0000000010000000"
DATA "0000000010000000"
DATA "0000000000000000"



hourglass:

DATA "1100000000000111"
DATA "1100000000000111"
DATA "1100000000000111"
DATA "1110000000001111"
DATA "1110000000001111"
DATA "1111000000011111"
DATA "1111100000111111"
DATA "1111110001111111"
DATA "1111110001111111"
DATA "1111100000111111"
DATA "1111000000011111"
DATA "1110000000001111"
DATA "1110000000001111"
DATA "1100000000000111"
DATA "1100000000000111"
DATA "1100000000000111"

DATA "0000000000000000"
DATA "0001111111110000"
DATA "0000000000000000"
DATA "0000111111100000"
DATA "0000100110100000"
DATA "0000010001000000"
DATA "0000001010000000"
DATA "0000000100000000"
DATA "0000000100000000"
DATA "0000001010000000"
DATA "0000011111000000"
DATA "0000110001100000"
DATA "0000100000100000"
DATA "0000000000000000"
DATA "0001111111110000"
DATA "0000000000000000"

FUNCTION Bin2Hex% (Binary$) STATIC  'binary to integer

  Temp& = 0
  Count = 0

  FOR x = LEN(Binary$) TO 1 STEP -1
    IF MID$(Binary$, x, 1) = "1" THEN
      Temp& = Temp& + 2 ^ Count
    END IF
    Count = Count + 1
  NEXT

  IF Temp& > 32767 THEN Temp& = Temp& - 65536
  Bin2Hex% = Temp&

END FUNCTION

SUB CursorShape (HotX, HotY, Shape()) STATIC
 
  IF NOT MousePresent THEN EXIT SUB

  MouseRegs.AX = 9
  MouseRegs.BX = HotX
  MouseRegs.CX = HotY
  MouseRegs.DX = VARPTR(Shape(1))
  MouseRegs.Segment = VARSEG(Shape(1))

  CALL MouseInt(MouseRegs)

END SUB

SUB HideCursor STATIC       'turns off the mouse cursor

  IF NOT MousePresent THEN EXIT SUB

  MouseRegs.AX = 2
  CALL MouseInt(MouseRegs)

END SUB

FUNCTION MouseThere% STATIC     'reports if a mouse is present

  MouseThere% = 0               'assume there is no mouse
  IF PeekWord%(Zero, (4 * &H33) + 2) = 0 THEN 'if segment = 0
    EXIT FUNCTION                             '  then there's no mouse
  END IF

  MouseRegs.AX = 0
  CALL MouseInt(MouseRegs)
  MouseThere% = MouseRegs.AX
  IF MouseRegs.AX THEN MousePresent = -1

END FUNCTION

SUB MouseTrap (ULRow, ULColumn, LRRow, LRColumn) STATIC

  IF NOT MousePresent THEN EXIT SUB

  MouseRegs.AX = 7      'restrict horizontal movement
  MouseRegs.CX = ULColumn
  MouseRegs.DX = LRColumn
  CALL MouseInt(MouseRegs)

  MouseRegs.AX = 8      'restrict vertical movement
  MouseRegs.CX = ULRow
  MouseRegs.DX = LRRow
  CALL MouseInt(MouseRegs)

END SUB

SUB MoveCursor (x, y) STATIC    'positions the mouse cursor

  IF NOT MousePresent THEN EXIT SUB

  MouseRegs.AX = 4
  MouseRegs.CX = x
  MouseRegs.DX = y
  CALL MouseInt(MouseRegs)

END SUB

SUB prompt (Message$, hps, vps, col) STATIC 'prints prompt message

    V = CSRLIN                  'save current cursor position
    H = POS(0)

    LOCATE hps, vps                'use 25 for SCREEN 9
    CALL HideCursor             'this is very important!
    COLOR col
    PRINT Message$;
    CALL ShowCursor             'and so is this
    LOCATE V, H                 'restore the cursor

END SUB

SUB readcursor (x, y, Buttons)  'returns cursor and button information

  IF NOT MousePresent THEN EXIT SUB

  MouseRegs.AX = 3
  CALL MouseInt(MouseRegs)
 
  Buttons = MouseRegs.BX AND 7
  x = MouseRegs.CX
  y = MouseRegs.DX

END SUB

SUB ShowCursor STATIC           'turns on the mouse cursor

  IF NOT MousePresent THEN EXIT SUB

  MouseRegs.AX = 1
  CALL MouseInt(MouseRegs)

END SUB

SUB TextCursor (FG, BG) STATIC

  IF NOT MousePresent THEN EXIT SUB

  MouseRegs.AX = 10
  MouseRegs.BX = 0
  MouseRegs.CX = &HFF
  MouseRegs.DX = 0

  IF FG = -1 THEN                       'maintain FG as the cursor moves?
    MouseRegs.CX = MouseRegs.CX OR &HF00
  ELSEIF FG = -2 THEN                   'invert FG as the cursor moves?
    MouseRegs.CX = MouseRegs.CX OR &H700
    MouseRegs.DX = &H700
  ELSE
    MouseRegs.DX = 256 * (FG AND &HFF)  'use the specified color
  END IF

  IF BG = -1 THEN                       'maintain BG as the cursor moves?
    MouseRegs.CX = MouseRegs.CX OR &HF000
  ELSEIF BG = -2 THEN                   'invert BG as the cursor moves?
    MouseRegs.CX = MouseRegs.CX OR &H7000
    MouseRegs.DX = MouseRegs.DX OR &H7000
  ELSE
    Temp = (BG AND 7) * 16 * 256
    MouseRegs.DX = MouseRegs.DX OR Temp 'use the specified color
  END IF

  CALL MouseInt(MouseRegs)

END SUB

FUNCTION WaitButton% STATIC     'waits for a button press

  IF NOT MousePresent THEN EXIT FUNCTION

  x! = TIMER                    'pause to allow releasing
  WHILE x! + .2 > TIMER         '  the button
  WEND

  DO                            'wait for a button press
    CALL readcursor(x, y, button)
  LOOP UNTIL button

  IF button AND 4 THEN button = 3 'for three-button mice
  WaitButton% = button            'assign the function

END FUNCTION

