c-----------------------------------------------------------------------
c Sample program to read the scale from a Sartorius balance.
c Demonstrate the use of RS232 interface.
c
c The follwoing setting are assumed to be set on the balance:
c   * 1200 baud rate, odd parity
c   * Without data input
c   * Automatic data output with/without stability - no print command needed.
c      Also works in the print command mode
c To change these parameters on the balance, see the Satorius manual.
c RS232 Cable wiring
c          PC-25pin      Balance
c        ---------------------------
c              1--------1
c              2--------3
c              3--------2
c         20---5
c              6--------20
c              7--------7---4
c
c Link with ASM.OBJ
c-----------------------------------------------------------------------

      character atemp(16),text*16,ascii
      equivalence (text,atemp(1))

c Initialize the serial port -- See p279 of Norton
c   baud=1200, parity=odd, stop bits=1, word=7 bits, port=com1
      call rs232p(4,1,0,2,1)

c It is easy to write to a serial port through a regular file,
c   but not easy to read from it!
c This can be tested directly from DOS (e.g., send $eE >com1:).
      open(unit=1,file='com1',status='new')

c-----------------------------------------------------------------------
c Display the menu
      call menu

c-----------------------------------------------------------------------
c Enter selection
10    call posit(22,35)
      call readky(ascii,iscan)

c-----------------------------------------------------------------------
      if((ascii.eq.'A') .or. (ascii.eq.'a'))write(1,500)'S'            Initialize
      if((ascii.eq.'G') .or. (ascii.eq.'g'))write(1,500)'A'            g
      if((ascii.eq.'K') .or. (ascii.eq.'k'))write(1,500)'B'            kg
      if((ascii.eq.'L') .or. (ascii.eq.'l'))write(1,500)'D'            lb
      if((ascii.eq.'O') .or. (ascii.eq.'o'))write(1,500)'E'            oz
      if((ascii.eq.'T') .or. (ascii.eq.'t'))write(1,500)'T'            Tare
      if((ascii.eq.'B') .or. (ascii.eq.'b'))write(1,500)'Q'            Beep
      if((ascii.eq.'Q') .or. (ascii.eq.'q'))then                        Quit
        close(1)
        call clrscr
        stop
      endif
      if((ascii.eq.'P') .or. (ascii.eq.'p'))then                        Print
c       This first DO loop synchronizes the LF; the readings are thrown away
        do 20 i=1,16
c         read(1,500,err=22)atemp(i)  **** This statement does not work
c         Instead, use the following routine based on Interrupt
          call serin(atemp(i),ioerr)
c         The following should normally be checked in a noisy system
c           check for error in reading a character
c             if(ioerr .ne. 0)goto 20
c           check for error in reading a line (i.e., char(0) is a LF)
              if((atemp(i).eq.char(10)) .and. (i.lt.16))goto 30
20      continue

c       The value read in this second DO loop is displayed on the screen
30      do 40 i=1,16
          call serin(atemp(i),ioerr)
40      continue

        atemp(14)='$'
        call output(25,25,text)
        call askkey(iyesno)
        if(iyesno .eq. 0)goto 30
      endif
      goto 10

500   format(a)
      end


c-----------------------------------------------------------------------
      subroutine menu
c-----------------------------------------------------------------------
c Menu to be displayed initially
c-----------------------------------------------------------------------
      call clrscr
      call output( 1,20,'DEMONSTRATION OF RS232 INTERFACE$')
      call output( 4,20,'p - Print scale display.$')
      call output( 6,20,'a - Auto-Check.$')
      call output( 8,20,'g - Change units to  g (gram).$')
      call output(10,20,'k - Change units to kg (kilogram).$')
      call output(12,20,'l - Change units to lb (pound).$')
      call output(14,20,'o - Change units to oz (ounce).$')
      call output(16,20,'t - Tare.$')
      call output(18,20,'b - Beep.$')
      call output(20,20,'q - Quit.$')
      call output(25,15,'Reading:  $')
      call output(22,20,'Pick a choice: $')
      return
      end
