PROGRAM RTERM

? This program demonstrates F-Basic's ability to interact with the
? serial port. It has been adapted from the example given
? in Chapter 13 of the ROM Kernel Manual, "Serial Device". Using
? direct ROM routine calls, it opens, initializes, and activates the
? serial device.

?/*************************************************************************
?/***   RTERM   STARTED 4-10-89  FINISHED 4-19-89  BY RICHARD HUXFORD  ***/
?/***   MAILING ADDRESS: 4007 REDSKIN COURT  RAPID CITY, SD  57701     ***/
?/***                                                                  ***/
?/***    SIMPLE TERMINAL PROGRAM THAT UTILIZES THE SERIAL DEVICE       ***/
?/***                                                                  ***/
?/***    DEFAULTS TO 8N1 9600 BAUD AND CAN EASILY BE CHANGED WITH      ***/
?/***       SETPARAMS COMMAND REFER TO THE ROM KERNAL MANUAL           ***/
?/*************************************************************************

CONSTANT SERIALNAME = "serial.device"
CONSTANT SDCMD_QUERY=9,SDCMD_SETPARAMS=11

INCLUDE finclude/AmigaExecTypes
APPEND  finclude/AmigaExecSubs


TYPE IOTArray IS RECORD
  INTEGER TermArray0,TermArray1
ENDTYPE

TYPE IOExtSer IS RECORD
  IOStdReq  IOSer
  INTEGER   io_CtlChar,io_RBufLen,io_ExtFlags,io_Baud,io_BrkTime
  IOTArray  io_TermArray
  BYTE      io_ReadLen,io_WriteLen,io_StopBits,io_SerFlags
  WORD      io_Status
ENDTYPE

GLOBAL
   PTR_TO IOExtSer mySerReq                       ;? READ POINTERS
   PTR_TO MsgPort mySerPort
   PTR_TO Message myIO
   PTR_TO MsgPort mySerWritePort                  ;? WRITE POINTERS
   PTR_TO IOExtSer mySerWriteReq
   WORD error,codevalue
   INTEGER ExecBase,LOOPCOUNT,STUFF,A,fault,mysize,myRsize,keynum
   INTEGER HDUP,DEBUG
   TEXT*1 myReadData(512),ISAY,myWriteData(512),myEchoData(512)
   WORD MALEV(6)                                  ;? WINDOW ODDS ENDS
   INTEGER S,M,J,L,K,T,RESULT,LRESULT,M1,M2,M3,LF,BUG
   INTEGER OURSCREEN,OURWINDOW
   TEXT*40 NAME,RESPONSE*1,HBUG*2
   TEXT*10  STR1(3),STR2(7),STR3(5)

DATA    (STR1,"MENU  "," QUIT ")
DATA    (STR2,"BAUD  ","  300","  1200","  2400","  4800","  9600","  19200")
DATA    (STR3,"DISPLAY  ","  ECHO","  CR=CRLF","  DEBUG")

DATA    (MALEV,110,0,200,0,22000,64)

SUBPROGRAM
   SUBROUTINE DATAPRINT,WRITESER,ECHOSER,SAY
   INTEGER INITIALIZE,READSER
   TEXT*1 REQUESTER
   INCLUDE finclude/AmigaSubNames
    

ExecBase=OPENLIB("exec.library",0)

&SYSLIB 1


VOICE(MALEV)
S=1

?/*** CALL FOR INITIAL SERIAL SETTINGS WITH SUBROUTINE INITIALIZE***/
fault = 0
fault = INITIALIZE()
 IF fault = 1 THEN GOTO cleanup1
 IF fault = 2 THEN GOTO cleanup2
 IF fault = 3 THEN GOTO cleanup3
 IF fault = 4 THEN GOTO cleanup4
 IF fault = 5 THEN GOTO cleanup5
 IF fault = 6 THEN GOTO cleanup6


ON MENU_SELECT EVENT
   WHEN MENU_NUMBER IS
      [1] WHEN ITEM_NUMBER IS

            [1] PRINT "THANKS FOR PLAYING!!"
                DELAY(3)
                ISAY = "Q"

          ENDCASES
      [2] WHEN ITEM_NUMBER IS
            [1] mySerReq.io_Baud = 300
                RESULT = 1
            [2] mySerReq.io_Baud = 1200
                RESULT = 2
            [3] mySerReq.io_Baud = 2400
                RESULT = 3
            [4] mySerReq.io_Baud = 4800
                RESULT = 4
            [5] mySerReq.io_Baud = 9600
                RESULT = 5
            [6] mySerReq.io_Baud = 19200
                RESULT = 6
          ENDCASES
      [3] WHEN ITEM_NUMBER IS
            [1] IF HDUP = 1 THEN
                   HDUP = 0
                   MENU_CHECK #3 (-1)
                ELSE
                   HDUP = 1
                   MENU_CHECK #3 (1)
                ENDIF
            [2] IF LF = 10 THEN
                   LF = 0
                   MENU_CHECK #3 (-2)
                ELSE
                   LF = 10
                   MENU_CHECK #3 (2)
                ENDIF
            [3] IF BUG = 1 THEN
                   BUG = 0
                   MENU_CHECK #3 (-3)
                ELSE
                   BUG = 1
                   MENU_CHECK #3 (3)
                ENDIF
          ENDCASES
   ENDCASES
   IF RESULT  > 0 THEN
      MENU_CHECK #2 (LRESULT)                     ;? CHECK MENU AND RESET
      mySerReq.IOSer.io_Command = SDCMD_SETPARAMS ;? COMMO PARAMETERS
      DoIO(ExecBase,mySerReq)
      MENU_CHECK #2 (RESULT)
      RESULT = -RESULT
      LRESULT = RESULT
   ENDIF

END EVENT

?/*** CHECK FOR A RESPONSE FROM THE CONSOLE AND SEND OUT SERIAL PORT ***/

ON INKEY EVENT
   keynum = KEY_NUMBER
      IF HDUP = 1 THEN  PRINT  CHAR(keynum),  ;? ECHO IF HALFDUPLEX
      myWriteData(1) = CHAR(keynum)
      mysize = 1
      IF LF = 10 THEN                         ;?INSERT LF TO CR  IF SET
         IF keynum = 13 THEN
            myWriteData(2) = CHAR(LF)
            mysize = 2
            IF HDUP = 1 THEN PRINT ;?CHAR(10) ;?ECHO LF ALSO IF ECHO IS SET
         ENDIF
      ENDIF
      WRITESER(mysize)                        ;?SEND size of array myWriteData
END EVENT

T=0
&FILESEP 0

?/*** CHECK FOR INCOMING DATA ON SERIAL PORT ***/

REPEAT
myRsize = READSER()                       ;? reads text into array myReadData

IF myRsize <> 0 THEN
   FOR A = 1 TO myRsize
     IF BUG = 1 THEN
       DEBUG = ASCII(myReadData(A))       ;?PRINT ASCII HEX VALUE (DEBUG)
       IF (DEBUG < 32) OR (DEBUG > 125) THEN
          HBUG =  HEX(DEBUG)
          IF DEBUG < 16 THEN              ;?IF HEX STRING IS ONLY ONE CHAR
             PRINT "<",HBUG(1:1),"> ",
          ELSE
            PRINT "<",HBUG,"> ",
          ENDIF
       ENDIF
     ENDIF
      PRINT  myReadData(A),

?      myEchoData(A) = myReadData(A)      ;? fill array to write out port from
   NEXT A                                 ;? READSER    [ ECHO ]
ENDIF
?ECHOSER(myRsize)                         ;?SEND size of array myWriteData
                                          ;?echo back what is coming in PORT
UNTIL ISAY = "Q"

{cleanup6}
DeleteExtIO(mySerWriteReq,SIZEOF(IOExtSer))
{cleanup5}
DeletePort(mySerWritePort)
{cleanup4}
CloseDevice(ExecBase,mySerReq)
{cleanup3}
DeleteExtIO(mySerReq,SIZEOF(IOExtSer))
{cleanup2}
DeletePort(mySerPort)
{cleanup1}
WINDOW_CLOSE #1
SCREEN_CLOSE #1
END



FUNCTION  INITIALIZE


?/*** SET UP THE PORTS AND BLOCKS TO RECEIVE MESSAGES ***/
&SYSLIB 1

?/*** CREATE A REPLY PORT TO WHICH SERIAL DEVICE CAN RETURN THE REQUEST***/
?/*** SEND POINTER TO TEXT(NAME OF PORT) BYTE PRIORITY OF PORT ***/
?/*** RETURNS NIL IF INADEQUATE MOMORY OR SIGBITS PTR_TO MsgPort (mySerPort) ***/
PRINT "INITIALIZING "
mySerPort=CreatePort(0,0)
IF mySerPort=NIL THEN
   PRINT "CAN'T CREATE SERIAL READ PORT?"
   INITIALIZE = 1
   GOTO CUT
ENDIF

?/*** CREATE A REQUEST BLOCK APPROPRIATE TO SERIAL OF USER SIZE IN BYTES (82)***/
?/*** SEND PTR_TO AN ALREADY INITIALIZED MSGPORT TO USE AS REPLYBLOCK***/
?/*** RECEIVES A PTR_TO IORequest POINTING TO THE NEW BLOCK ***/

mySerReq = CreateExtIO(mySerPort,SIZEOF(IOExtSer))
IF mySerReq = NIL THEN
   PRINT "not enough memory or sigBits to CreateExtIO for READ"
   INITIALIZE = 2
   GOTO CUT
ENDIF

mySerReq.io_SerFlags=0

?/*** OPEN THE DEVICE **/
error=OpenDevice(ExecBase,@"serial.device",0,mySerReq,0)
IF error<>0 THEN
   PRINT "Error In Opening The SERIAL Device for READ"
   INITIALIZE = 3
   GOTO CUT
ENDIF

?/*** INITIALIZE WRITE  ***/
                                            ?@"mySerialWrite"0
mySerWritePort = CreatePort(0,0)
IF mySerWritePort=NIL THEN
   PRINT "CAN'T CREATE SERIAL WRITE PORT?"
   INITIALIZE = 4
   GOTO CUT
ENDIF

mySerWriteReq = CreateExtIO(mySerWritePort,SIZEOF(IOExtSer))
IF mySerWriteReq = NIL THEN
   PRINT "not enough memory or sigBits to CreateExtIO for WRITE"
   INITIALIZE = 5
   GOTO CUT
ENDIF

?/*** OPEN THE DEVICE (AGAIN) FOR WRITE  ***/
?/*** IF YOU WANT TO USE EXCULSIVE ACCES MODE YOU MUST CLONE mySerReq TO
?/*** mySerWriteReq ON A BYTE BY BYTE BASIS

FOR I = 0 TO (SIZEOF(mySerReq))-1              ;?  CLONER  BYTE BY BYTE
   ^mySerWriteReq+I = ^mySerReq+I              ;? WOW THIS IS GREAT !
NEXT I
mySerWriteReq.IOSer.io_Message.mn_ReplyPort = mySerWritePort

?error=OpenDevice(ExecBase,@"serial.device",0,mySerWriteReq,0)
?IF error<>0 THEN
?   PRINT "Error In Opening The SERIAL Device for WRITE"
?   INITIALIZE = 6
?   GOTO CUT
?ENDIF

?/*** OPEN THEN SCREEN, WINDOW AND SET MENU DEFAULTS ***/

OURSCREEN=SCREEN #1(0,200,3,2,@"RTERM")
OURWINDOW=WINDOW #1(0,0,640,200,10,10,640,200,-1,-1,31,@"RTERM",1)
SCR_CLER
&MENUWIDTH 100
M1=MENU #1 (@STR1,1)
M2=MENU #2 (@STR2,6)
M3=MENU #3 (@STR3,3)
MENU_ON
MENU_CHECK #2 (5)                             ;? PUT CHECKMARK ON 9600 IN MENU
LRESULT = -5                                  ;? IF CHANGED REMOVE FROM 9600
INITIALIZE = 0
{CUT}
END

SUBROUTINE DATAPRINT
PRINT "test"
PRINT mySerReq.io_CtlChar
PRINT mySerReq.io_RBufLen
PRINT mySerReq.io_ExtFlags
PRINT mySerReq.io_Baud
PRINT mySerReq.io_BrkTime
PRINT mySerReq.io_ReadLen
PRINT mySerReq.io_WriteLen
PRINT mySerReq.io_StopBits
PRINT mySerReq.io_SerFlags
PRINT mySerReq.io_Status
PRINT "done"
END

FUNCTION READSER

LOCAL
   INTEGER ASIZE,R,C

mySerReq.IOSer.io_Data = @myReadData(1)       ;? where to put data
mySerReq.IOSer.io_Length = 512                ;? read in characters
                                              ;? 512 MAX set with SETPARAMS
   mySerReq.IOSer.io_Command = SDCMD_QUERY    ;? say it is a query
   SendIO(ExecBase,mySerReq)
   ASIZE = mySerReq.IOSer.io_Actual           ;? ASIZE = ACTUAL SIZE READ IN
                                              ;?appears to report char past
                                              ;?length WITH QUERY
   IF ASIZE <> 0 THEN                         ;? ASIZE = ACTUAL SIZE READ IN
      mySerReq.IOSer.io_Length = ASIZE
      mySerReq.IOSer.io_Command = CMD_READ    ;? say it is a read
      SendIO(ExecBase,mySerReq)
   ENDIF                                      ;? io_Actual seems to report
                                              ;? only  up to length on CMD_READ
                                              ;? and saves the rest for next
       READSER = mySerReq.IOSer.io_Actual
END


SUBROUTINE WRITESER
       PARAMETER
          INTEGER writesize

       mySerReq.IOSer.io_Data = @myWriteData(1) ;? Where to get data
       mySerReq.IOSer.io_Length = writesize     ;? Write n characters
       mySerReq.IOSer.io_Command = CMD_WRITE    ;? say it's a write
       DoIO(ExecBase,mySerReq)                  ;? SENDIO seems to lose
                                                ;? chars if Amiga is busy?

END                                             ;? so I used DoIO
SUBROUTINE ECHOSER
       PARAMETER
          INTEGER writesize

       mySerReq.IOSer.io_Data = @myEchoData(1)  ;? Where to get data
       mySerReq.IOSer.io_Length = writesize     ;? Write n characters
       mySerReq.IOSer.io_Command = CMD_WRITE    ;? say it's a write
       DoIO(ExecBase,mySerReq)                  ;? SENDIO seems to lose
                                                ;? chars if Amiga is busy?

END                                             ;? so I used DoIO


?       ************   MISC SUBPROGRAMS START HERE   **************

FUNCTION REQUESTER
PARAMETER
   TEXT*$ RTITLE
LOCAL
   TEXT*1 FRESULT
   INTEGER REQWINDOW
REQWINDOW = WINDOW #2 (170,60,300,40,0,0,0,0,3,4,18,@RTITLE,1)
INPUT FRESULT
REQUESTER=FRESULT
WINDOW_CLOSE #2
END

SUBROUTINE SAY
PARAMETER
   TEXT*$ STRA
LOCAL
   TEXT*80 STRB
   INTEGER Z
IF S THEN
   Z=FILLCHAR(STRB," ")
   IF LENGTH(STRA)<>0 THEN
      Z=TRANSLATE(STRA,STRB)
      Z=NARRATE(STRB)
   ENDIF
ENDIF
END