'-------------------------------------------------------------------------------
' uCskel.bas for Power Basic for Windows
' DDT style skeleton program for communicating with a
' microcontroller board or other slave RS-232 device.
'
' Includes a simple dumb terminal feature which
' uses a modeless dialog box and custom message pump.
'
' Courtesy of Industrologic, Inc. www.industrologic.com
' written by Gary Peek
'-------------------------------------------------------------------------------

#DIM ALL
#COMPILE EXE
#OPTION VERSION4

#INCLUDE "WIN32API.INC"

' main menu
%ID_EXIT = 100
%ID_RUN = 101
%ID_SETUPCOMM = 102
%ID_TERM = 103

' main dialog box
%ID_RUNTEXT = 200

' setup communication
%IDSCTEXT = 300
%IDPORTTEXT = 310
%IDPORT1 = 311
%IDPORT2 = 312
%IDPORT3 = 313
%IDPORT4 = 314
%IDBAUDTEXT = 320
%IDBAUD1 = 321
%IDBAUD2 = 322
%IDBAUD3 = 323
%IDBAUD4 = 324
%IDBAUD5 = 325
%IDBAUD6 = 326
%IDBAUD7 = 327
%IDSCOK = 330
%IDSCCANCEL = 331

' dumb terminal
%IDTERM = 450

' Global data variables
GLOBAL mainexitflag AS LONG
GLOBAL setupexitflag AS LONG
GLOBAL hMainDlg AS LONG
GLOBAL hFile AS LONG
GLOBAL hComm AS LONG
GLOBAL comport AS STRING
GLOBAL baudrate AS LONG
GLOBAL commstatus AS LONG

' Callback Declarations
DECLARE CALLBACK FUNCTION MainProc()
DECLARE CALLBACK FUNCTION SetupCommProc()

' Function/Subroutine Declarations
DECLARE FUNCTION RunMode AS LONG
DECLARE FUNCTION SetupCom AS LONG
DECLARE FUNCTION Term AS LONG

DECLARE FUNCTION StartComm AS LONG
DECLARE FUNCTION ReadConfigFile AS LONG
DECLARE FUNCTION WriteConfigFile AS LONG


'------------------------------------------------------------------------------

FUNCTION PBMAIN

  LOCAL hMenu AS LONG

  hComm = FREEFILE
  hFile = FREEFILE

  DIALOG NEW 0, "uC/RS232 Slave Skeleton Program", 0, 0, 200, 100, %DS_CENTER OR %WS_CAPTION _
    OR %WS_SYSMENU OR %WS_MINIMIZEBOX, 0 TO hMainDlg

  MENU NEW BAR TO hMenu
  MENU ADD STRING, hMenu, "Exit", %ID_EXIT, %MF_ENABLED
  MENU ADD STRING, hMenu, "Run", %ID_RUN, %MF_ENABLED
  MENU ADD STRING, hMenu, "Terminal", %ID_TERM, %MF_ENABLED
  MENU ADD STRING, hMenu, "Setup Comm", %ID_SETUPCOMM, %MF_ENABLED
  MENU ATTACH hMenu, hMainDlg

  DIALOG SET COLOR hMainDlg, -1, %WHITE

  ' area to display text
  CONTROL ADD LABEL, hMainDlg, %ID_RUNTEXT, "", 0, 0, 200, 100
  CONTROL SET COLOR hMainDlg, %ID_RUNTEXT, %BLACK, %WHITE

  ' Start up dialog box, must be modeless to have user loop beyond here
  DIALOG SHOW MODAL hMainDlg, CALL MainProc

END FUNCTION

'------------------------------------------------------------------------------

CALLBACK FUNCTION MainProc()

  SELECT CASE CBMSG

    CASE %WM_INITDIALOG
      ReadConfigFile  ' read configuration or use default
      StartComm  ' open or change and open com port

    CASE %WM_COMMAND
      IF CBCTL = %ID_EXIT THEN DIALOG END CBHNDL, 0  ' causes %IDCANCEL message
      IF CBCTL = %ID_RUN AND commstatus = 1 THEN RunMode
      IF CBCTL = %ID_TERM THEN Term
      IF CBCTL = %ID_SETUPCOMM THEN SetupCom

  END SELECT

END FUNCTION


'------------------------------------------------------------------------------

' This is where you can put all the main functionality of your program, e.g.,
' the program can send commands to your device and display something in
' response to what it gets back.

' More controls can be added to the main dialog box to display these things.

' For demonstration purposes it not just displays any text it receives back
' from a fake "command".

FUNCTION RunMode AS LONG

  LOCAL oldtime AS SINGLE
  LOCAL RxChar AS STRING
  LOCAL RxStr AS STRING

  ' clear display
  SetDlgItemText hMainDlg, %ID_RUNTEXT, ""

  ' send "command" to device
  COMM PRINT #hComm, "command" + CHR$(13)  ' carriage return but no line feed

  ' wait for a response from device
  RxStr = ""  ' zero out response string
  oldtime = TIMER  ' save time right now
  WHILE TIMER < oldtime + 0.5  ' wait for specified time only
    WHILE COMM(#hComm, RXQUE) <> 0  ' while chars in RX buffer
      COMM RECV #hComm, 1, RxChar  ' get one character
      RxStr = RxStr + RxChar  ' add to response string
    WEND
  WEND

  ' display whatever the device returned (or whatever)
  SetDlgItemText hMainDlg, %ID_RUNTEXT, RxStr + CHR$(0)

END FUNCTION


'------------------------------------------------------------------------------

FUNCTION SetupCom AS LONG

  LOCAL hDlg AS LONG

    ' Create dialog box
    DIALOG NEW 0, "Setup Comm", 10, 10, 130, 130, _
        %DS_CENTER OR %WS_CAPTION OR %WS_SYSMENU OR %WS_MINIMIZEBOX, 0 TO hDlg

    ' Create controls
    CONTROL ADD LABEL, hDlg, %IDSCTEXT, "Setup Communication Parameters", 10, 5, 110, 10

    CONTROL ADD LABEL, hDlg, %IDPORTTEXT, "Com Port:", 10, 20, 40, 10
    CONTROL ADD OPTION, hDlg, %IDPORT1, "Com1", 10, 30, 40, 10, %WS_GROUP OR %WS_TABSTOP
    CONTROL ADD OPTION, hDlg, %IDPORT2, "Com2", 10, 40, 40, 10
    CONTROL ADD OPTION, hDlg, %IDPORT3, "Com3", 10, 50, 40, 10
    CONTROL ADD OPTION, hDlg, %IDPORT4, "Com4", 10, 60, 40, 10

    CONTROL ADD LABEL, hDlg, %IDBAUDTEXT, "Baud Rate:", 80, 20, 40, 10
    CONTROL ADD OPTION, hDlg, %IDBAUD1, "19200", 80, 30, 40, 10, %WS_GROUP OR %WS_TABSTOP
    CONTROL ADD OPTION, hDlg, %IDBAUD2, "9600", 80, 40, 40, 10
    CONTROL ADD OPTION, hDlg, %IDBAUD3, "4800", 80, 50, 40, 10
    CONTROL ADD OPTION, hDlg, %IDBAUD4, "2400", 80, 60, 40, 10
    CONTROL ADD OPTION, hDlg, %IDBAUD5, "1200", 80, 70, 40, 10
    CONTROL ADD OPTION, hDlg, %IDBAUD6, "600", 80, 80, 40, 10
    CONTROL ADD OPTION, hDlg, %IDBAUD7, "300", 80, 90, 40, 10

    CONTROL ADD BUTTON, hDlg, %IDSCOK, "OK", 15, 110, 40, 12, %WS_TABSTOP
    CONTROL ADD BUTTON, hDlg, %IDSCCANCEL, "Cancel", 75, 110, 40, 12, %WS_TABSTOP

    ' Start up dialog box and run until the user quits
    DIALOG SHOW MODAL hDlg, CALL SetupCommProc

END FUNCTION


'------------------------------------------------------------------------------

CALLBACK FUNCTION SetupCommProc()

  LOCAL result AS LONG

  SELECT CASE CBMSG

    CASE %WM_INITDIALOG

      IF comport = "Com1" THEN CONTROL SET CHECK CBHNDL, %IDPORT1, 1
      IF comport = "Com2" THEN CONTROL SET CHECK CBHNDL, %IDPORT2, 1
      IF comport = "Com3" THEN CONTROL SET CHECK CBHNDL, %IDPORT3, 1
      IF comport = "Com4" THEN CONTROL SET CHECK CBHNDL, %IDPORT4, 1

      IF baudrate = 19200 THEN CONTROL SET CHECK CBHNDL, %IDBAUD1, 1
      IF baudrate = 9600 THEN CONTROL SET CHECK CBHNDL, %IDBAUD2, 1
      IF baudrate = 4800 THEN CONTROL SET CHECK CBHNDL, %IDBAUD3, 1
      IF baudrate = 2400 THEN CONTROL SET CHECK CBHNDL, %IDBAUD4, 1
      IF baudrate = 1200 THEN CONTROL SET CHECK CBHNDL, %IDBAUD5, 1
      IF baudrate = 600 THEN CONTROL SET CHECK CBHNDL, %IDBAUD6, 1
      IF baudrate = 300 THEN CONTROL SET CHECK CBHNDL, %IDBAUD7, 1

    CASE %WM_COMMAND

      IF CBCTLMSG = %BN_CLICKED THEN

        IF CBCTL = %IDSCOK THEN

          CONTROL GET CHECK CBHNDL, %IDPORT1 TO result : IF result = 1 THEN comport = "Com1"
          CONTROL GET CHECK CBHNDL, %IDPORT2 TO result : IF result = 1 THEN comport = "Com2"
          CONTROL GET CHECK CBHNDL, %IDPORT3 TO result : IF result = 1 THEN comport = "Com3"
          CONTROL GET CHECK CBHNDL, %IDPORT4 TO result : IF result = 1 THEN comport = "Com4"

          CONTROL GET CHECK CBHNDL, %IDBAUD1 TO result : IF result = 1 THEN baudrate = 19200
          CONTROL GET CHECK CBHNDL, %IDBAUD2 TO result : IF result = 1 THEN baudrate = 9600
          CONTROL GET CHECK CBHNDL, %IDBAUD3 TO result : IF result = 1 THEN baudrate = 4800
          CONTROL GET CHECK CBHNDL, %IDBAUD4 TO result : IF result = 1 THEN baudrate = 2400
          CONTROL GET CHECK CBHNDL, %IDBAUD5 TO result : IF result = 1 THEN baudrate = 1200
          CONTROL GET CHECK CBHNDL, %IDBAUD6 TO result : IF result = 1 THEN baudrate = 600
          CONTROL GET CHECK CBHNDL, %IDBAUD7 TO result : IF result = 1 THEN baudrate = 300

          WriteConfigFile ' save selected communication parameters
          StartComm  ' open or change and open com port
          DIALOG END CBHNDL, 1

        END IF

        IF CBCTL = %IDSCCANCEL THEN
          DIALOG END CBHNDL, 0
        END IF

      END IF  ' CBCTLMSG

  END SELECT  '  CASE CBMSG

END FUNCTION



'------------------------------------------------------------------------------
' This function is a self contained dumb terminal function, except for
' needing to have the com port (#hComm) already opened by StartComm.

' Using a label style control and setting the text each time a new character is
' received from the com port makes the control flicker if characters are being
' received at a rapid rate, but is a quick way to create a terminal screen.

' The dialog box is sized so that the "terminal screen" is 80 characters wide
' by 25 lines long at the specified font and font size.

' The character handling part of the function performs the function of the most
' common and likely control characters, but other characters can be checked for.

FUNCTION Term AS LONG

  LOCAL hDlg AS LONG
  LOCAL termexitflag AS LONG
  LOCAL Msg AS tagMsg  'from Win32API, "TYPE tagMSG"
  LOCAL Char AS STRING
  LOCAL RxStr AS STRING
  LOCAL rownum AS LONG
  LOCAL colnum AS LONG

  DIALOG FONT "Courier", 8

  ' Create dialog box
  DIALOG NEW 0, "Terminal Mode", 10, 10, 322, 202, _
    %DS_CENTER OR %WS_CAPTION OR %WS_SYSMENU OR %WS_MINIMIZEBOX, 0 TO hDlg

  ' Create controls
  CONTROL ADD LABEL, hDlg, %ID_TERM, "", 0, 0, 322, 202', %SS_NOWORDWRAP
  CONTROL SET COLOR hDlg, %ID_TERM, %BLACK, %WHITE

  ' Start up dialog box, must be modeless to have user loop beyond here
  DIALOG SHOW MODELESS hDlg  ' no dialog procedure, we will process messages here

  rownum = 1 : colnum = 1  ' upper left corner of course
  RxStr = "_"  ' display string is cursor only at first
  SetDlgItemText hDlg, %ID_TERM, RxStr + CHR$(0)  ' display string in label area

  termexitflag = 0
  WHILE termexitflag = 0  ' keep doing this loop until user exits

    'process Windows messages for modeless window, replaces "dialog doevents"
    IF PeekMessage(Msg, %NULL, 0, 0, %PM_REMOVE) <> 0 THEN  ' if any message is pending
      TranslateMessage Msg
      DispatchMessage Msg
      IF Msg.message = %WM_CHAR THEN COMM PRINT #hComm, CHR$(Msg.wParam);
      IF Msg.message = %WM_NCLBUTTONDOWN AND Msg.wParam = %HTCLOSE THEN termexitflag = 1  ' if closing window
    END IF

    IF COMM(#hComm, RXQUE) <> 0 THEN  ' if chars in RX buffer
      COMM RECV #hComm, 1, Char  ' get one character

      SELECT CASE Char  ' do various things based on key hit

      CASE CHR$(7)  ' bell
        BEEP        ' default Windows sound

      CASE CHR$(12)  ' form feed (clear screen)
        rownum = 1
        colnum = 1
        RxStr = "_"

      CASE CHR$(8)  ' backspace
        IF colnum <> 1 THEN
          RxStr = LEFT$(RxStr, LEN(RxStr) - 2) + "_"  ' remove cursor and char, add cursor
        END IF

      CASE CHR$(10)  ' line feed

      CASE CHR$(13)  ' carriage return
        RxStr = LEFT$(RxStr, LEN(RxStr) - 1)  ' remove cursor
        RxStr = RxStr + CHR$(13) + CHR$(10) + "_"  ' add CR/LF, new character and cursor
        colnum = 1
        rownum = rownum + 1
        IF rownum > 25 THEN
          RxStr = RIGHT$(RxStr, LEN(RxStr) - INSTR(RxStr, CHR$(10)))  ' remove first line
        END IF

      CASE ELSE  ' all other keys, probably alphanumeric
        IF colnum < 80 THEN
          RxStr = LEFT$(RxStr, LEN(RxStr) - 1)  ' remove cursor
          RxStr = RxStr + Char + "_"  ' add new character and cursor
          colnum = colnum + 1
        ELSE
          RxStr = LEFT$(RxStr, LEN(RxStr) - 1)  ' remove cursor
          RxStr = RxStr + Char + CHR$(13) + CHR$(10) + "_"  ' add CR/LF and cursor
          colnum = 1
          rownum = rownum + 1
          IF rownum > 25 THEN
            RxStr = RIGHT$(RxStr, LEN(RxStr) - INSTR(RxStr, CHR$(10)))  ' remove first line
          END IF
        END IF

      END SELECT  ' Char

      SetDlgItemText hDlg, %ID_TERM, RxStr + CHR$(0)  ' display string in label area

    END IF  ' chars in RX buffer

  WEND  ' exitflag

  DIALOG FONT "MS Sans Serif", 8  ' normally the default font

END FUNCTION


'------------------------------------------------------------------------------

' Closes any com port already open, and opens the selected com port with the
' new parameters.

FUNCTION StartComm AS LONG

  LOCAL TempString AS STRING

  IF COMM(#hComm, RXQUE) THEN  ' if there are characters in the receive buffer
    COMM RECV #hComm, COMM(#hComm, RXQUE), TempString  ' clear them
  END IF
  COMM CLOSE #hComm

  ERRCLEAR  ' clear any leftover errors
  COMM OPEN comport AS #hComm  ' trying opening the port
  IF ERR <> 0 THEN  ' if there was any error
    commstatus = 0
    MSGBOX "Can't open " + comport + "." + CHR$(13) + "Select another com port.", %MB_ICONERROR, "Setup Error"
    EXIT FUNCTION
  END IF

  COMM SET #hComm, BAUD = baudrate
  COMM SET #hComm, BYTE = 8
  COMM SET #hComm, PARITYTYPE = 0
  COMM SET #hComm, STOP = 0
  COMM SET #hComm, XINPFLOW = 0
  COMM SET #hComm, XOUTFLOW = 0
  COMM SET #hComm, CTSFLOW = 0
  COMM SET #hComm, RTSFLOW = 0
  COMM SET #hComm, TXBUFFER = 100
  COMM SET #hComm, RXBUFFER = 1000

  commstatus = 1

END FUNCTION


'------------------------------------------------------------------------------

' These functions save the selected com port options, which will be used the
' next time the program is run (in the same directory). Other configuration
' items can of course be added.

FUNCTION ReadConfigFile AS LONG

  IF LEN(DIR$("uCskel.ini")) = 0 THEN
    MSGBOX "Initialization file not found." + CHR$(13) _
          + "Using Com1 at 9600 baud.", %MB_ICONWARNING, "Notice"
    comport = "Com1"
    baudrate = 9600
  ELSE
    OPEN "uCskel.ini" FOR INPUT AS #hFile
    IF NOT(EOF(hFile)) THEN INPUT #hFile, comport
    IF NOT(EOF(hFile)) THEN INPUT #hFile, baudrate
    CLOSE #hFile
  END IF

END FUNCTION


FUNCTION WriteConfigFile AS LONG

      OPEN "uCskel.ini" FOR OUTPUT AS #hFile
      PRINT #hFile, comport
      PRINT #hFile, TRIM$(STR$(baudrate))
      CLOSE #hFile

END FUNCTION