' $INCLUDE: 'QBSERIAL.DEC' ' DECLARE FUNCTION SendCommand$ (msg$) DECLARE FUNCTION ReadResponse$ () DEFINT A-Z ' define the key codes that map to special keys ' use the Chr$() function to convert to string CONST kESC = 27, kAltR = 19, kAltA = 30, kAltH = 35 CONST kPlus = 43, kMinus = 45 CONST kHome = 71, kPgUp = 73, kEnd = 79, kPgDn = 81 CONST kUp = 72, kLeft = 75, kRight = 77, kDown = 80 ' other constants CONST kSetupMode = 1, kRunMode = 2, kIntroMode = 3 ' subroutine declarations DECLARE SUB LoadPrefs () DECLARE SUB SavePrefs () DECLARE SUB DrawSetupMenu () DECLARE SUB DrawRunMenu () DECLARE SUB DrawIntroMenu () DECLARE SUB DoNewSerialPort () DECLARE SUB DoNewBaudRate () DECLARE SUB DoPanLeft () DECLARE SUB DoPanRight () DECLARE SUB DoTiltUp () DECLARE SUB DoTiltDown () DECLARE SUB DoResetZoom () DECLARE SUB DoZoomIn () DECLARE SUB DoZoomOut () DECLARE SUB DoPanUpLeft () DECLARE SUB DoPanUpRight () DECLARE SUB DoPanDnLeft () DECLARE SUB DoPanDnRight () DECLARE SUB DoHomePanTilt () ' function declarations DECLARE FUNCTION OpenPort% () DECLARE FUNCTION AddressSet% () DECLARE FUNCTION IFClearAll% () ' global preference variables COMMON SHARED gPortNo AS INTEGER COMMON SHARED gBaudRate AS LONG 'global control variables COMMON SHARED gNumCams AS INTEGER COMMON SHARED gZoomPos AS INTEGER CLS ' clear the screen ' load the preferences LoadPrefs ' enter main loop ' can banch out of this loop for either ' setup, or ' main run loop mode = kIntroMode ExitMain = 0 temp$ = "" WHILE ExitMain = 0 ' draw the appropriate screen IF mode = kSetupMode THEN DrawSetupMenu Choices$ = "SBX" ELSEIF mode = kRunMode THEN DrawRunMenu Choices$ = "X" ELSEIF mode = kIntroMode THEN DrawIntroMenu Choices$ = "SRQ" END IF ' wait for a correct choice DO temp$ = "" DO temp$ = INKEY$ LOOP WHILE temp$ = "" LOOP WHILE INSTR(Choices$, UCASE$(temp$)) = 0 temp$ = UCASE$(temp$) ' if we get here, then the user entered a valid key IF mode = kSetupMode THEN ' handle set port, baud rate, and exit setup IF temp$ = "S" THEN DoNewSerialPort ELSEIF temp$ = "B" THEN DoNewBaudRate ELSE ' exit the setup, so save prefs now SavePrefs mode = kIntroMode END IF ELSEIF mode = kRunMode THEN ' handle the run items, exit and special keys IF temp$ = "X" THEN CloseComm mode = kIntroMode END IF ELSEIF mode = kIntroMode THEN ' handle the intro menu items IF temp$ = "S" THEN mode = kSetupMode ELSEIF temp$ = "R" THEN mode = kRunMode rc = OpenPort% gNumCams = AddressSet% PRINT "AddressSet detected"; gNumCams; "Cameras..." rc = IFClearAll% DoHomePanTilt DoResetZoom ' Debugging only next line DrawRunMenu DO ' CLS ' DrawRunMenu key$ = "" DO key$ = UCASE$(INKEY$) LOOP WHILE key$ = "" IF LEN(key$) = 1 THEN SELECT CASE key$ CASE CHR$(kESC) key$ = "X" mode = kIntroMode CASE "+" DoZoomIn CASE "-" DoZoomOut CASE "X" mode = kIntroMode CASE ELSE PRINT "Unrecognised key " + HEX$(VAL(key$)) + "h" END SELECT ELSE key$ = RIGHT$(key$, 1) SELECT CASE key$ CASE CHR$(kUp) DoTiltUp CASE CHR$(kDown) DoTiltDown CASE CHR$(kLeft) DoPanLeft CASE CHR$(kRight) DoPanRight CASE CHR$(kHome) DoPanUpLeft CASE CHR$(kEnd) DoPanDnLeft CASE CHR$(kPgUp) DoPanUpRight CASE CHR$(kPgDn) DoPanDnRight CASE CHR$(kPlus) DoZoomIn CASE CHR$(kMinus) DoZoomOut CASE CHR$(kAltA) DoResetZoom DoHomePanTilt CASE CHR$(kAltH) DoHomePanTilt CASE CHR$(kAltR) DoResetZoom CASE ELSE PRINT "Unrecognised extended key " + HEX$(VAL(key$)) + "h" END SELECT END IF LOOP UNTIL key$ = "X" mode = kIntroMode ELSEIF temp$ = "Q" THEN ExitMain = 1 ' exit the application END IF END IF WEND FUNCTION AddressSet% ' This function sends the address set message to the EVI-D70 device(s) ' The command is a broadcast, so we might receive multiple camera responses msg$ = "883001FF" temp$ = SendCommand$(msg$) PRINT "SendCommand->AddressSet = " + temp$ ' Read the command complete response temp$ = ReadResponse$ PRINT "ReadResponse->AddressSet returned " + temp$ ' check the sent vs the return s1$ = MID$(msg$, 3, 1) s2$ = MID$(temp$, 3, 1) s1 = VAL(s1$) s2 = VAL(s2$) IF s1 = s2 - 1 THEN AddressSet% = s1 ELSE AddressSet% = 255 END IF END FUNCTION SUB DoHomePanTilt ' Send the Home Pan & Tilt command cmnd$ = "81010604FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->HomePanTilt = " + temp$ ' Read the ACK response temp$ = ReadResponse$ ' PRINT "ReadResponse->HomePanTilt returned " + temp$ start! = TIMER ' Read the command complete response temp$ = ReadResponse$ PRINT "ReadResponse->HomePanTilt returned " + temp$ ' Wait 1 second ' DO ' endup! = TIMER ' LOOP UNTIL endup! - start! > 1 ' Send the Pan/Tilt Stop command ' cmnd$ = "8101060109090303FF" ' temp$ = SendCommand$(cmnd$) ' PRINT "SendCommand->EndPanTilt = " + temp$ ' Read the ACK response ' temp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + temp$ ' Read the command complete response ' temp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + temp$ END SUB SUB DoNewBaudRate ' This subroutine allows the user to select a new baud rate ' The EVDI70 supports two baud rates: ' 9600 ' 38400 choice = 0 DO PRINT PRINT "1. 9600" PRINT "2. 38400" INPUT "New baud rate (1 or 2): ", temp$ choice = INT(VAL(temp$)) LOOP UNTIL choice > 0 AND choice < 3 ' once out, setup the global variable IF choice = 1 THEN gBaudRate = 9600 ELSE gBaudRate = 38400 END IF END SUB SUB DoNewSerialPort ' This subroutine gets a new serial port number oldPortNo = gPortNo portNo = 0 DO PRINT INPUT "New serial port (1,2,3,4): ", temp$ portNo = VAL(temp$) PRINT portNo LOOP UNTIL portNo > 0 AND portNo < 5 gPortNo = portNo END SUB SUB DoPanDnLeft ' Send Pan Down & Left (V+H speed 9) command cmnd$ = "8101060109090102FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->PanDnLeft = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->PanDnLeft returned " + resp$ start! = TIMER ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->PanDnLeft returned " + resp$ ' Wait 1 second DO endup! = TIMER LOOP UNTIL endup! - start! > 1 ' Send the Pan/Tilt Stop command cmnd$ = "8101060109090303FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->EndPanTilt = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + resp$ ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->EndPanTilt returned " + resp$ END SUB SUB DoPanDnRight ' Send Pan Down & Right (V+H speed 9) command cmnd$ = "8101060109090202FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->PanDnRight = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->PanDnRight returned " + resp$ start! = TIMER ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->PanDnRight returned " + resp$ ' Wait 1 second DO endup! = TIMER LOOP UNTIL endup! - start! > 1 ' Send the Pan/Tilt Stop command cmnd$ = "8101060109090303FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->EndPanTilt = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + resp$ ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->EndPanTilt returned " + resp$ END SUB SUB DoPanLeft ' Send the Pan Left (V+H speed 9) command cmnd$ = "8101060109090103FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->PanLeft = " + temp$ ' Read the ACK response temp$ = ReadResponse$ ' PRINT "ReadResponse->PanLeft returned " + temp$ start! = TIMER ' Read the command complete response temp$ = ReadResponse$ PRINT "ReadResponse->PanLeft returned " + temp$ ' Wait 1 second DO endup! = TIMER LOOP UNTIL endup! - start! > 1 ' Send the Pan/Tilt Stop command cmnd$ = "8101060109090303FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->EndPanTilt = " + temp$ ' Read the ACK response temp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + temp$ ' Read the command complete response temp$ = ReadResponse$ PRINT "ReadResponse->EndPanTilt returned " + temp$ END SUB SUB DoPanRight ' Send the Pan Right (V+H speed 9) command cmnd$ = "8101060109090203FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->PanRight = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->PanRight returned " + resp$ start! = TIMER ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->PanRight returned " + resp$ ' Wait 1 second DO endup! = TIMER LOOP UNTIL endup! - start! > 1 ' Send the Pan/Tilt Stop command cmnd$ = "8101060109090303FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->EndPanTilt = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + resp$ ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->EndPanTilt returned " + resp$ END SUB SUB DoPanUpLeft ' Send the Pan Up & Left (V+H speed 9) command cmnd$ = "8101060109090101FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->PanUpLeft = " + temp$ ' Read the ACK response temp$ = ReadResponse$ ' PRINT "ReadResponse->PanUpLeft returned " + temp$ start! = TIMER ' Read the command complete response temp$ = ReadResponse$ PRINT "ReadResponse->PanUpLeft returned " + temp$ ' Wait 1 second DO endup! = TIMER LOOP UNTIL endup! - start! > 1 ' Send the Pan/Tilt Stop command cmnd$ = "8101060109090303FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->EndPanTilt = " + temp$ ' Read the ACK response temp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + temp$ ' Read the command complete response temp$ = ReadResponse$ PRINT "ReadResponse->EndPanTilt returned " + temp$ END SUB SUB DoPanUpRight ' Send the Pan Up & Right (V+H speed 9) command cmnd$ = "8101060109090201FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->PanUpRight = " + temp$ ' Read the ACK response temp$ = ReadResponse$ ' PRINT "ReadResponse->PanUpRight returned " + temp$ start! = TIMER ' Read the command complete response temp$ = ReadResponse$ PRINT "ReadResponse->PanUpRight returned " + temp$ ' Wait 1 second DO endup! = TIMER LOOP UNTIL endup! - start! > 1 ' Send the Pan/Tilt Stop command cmnd$ = "8101060109090303FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->EndPanTilt = " + temp$ ' Read the ACK response temp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + temp$ ' Read the command complete response temp$ = ReadResponse$ PRINT "ReadResponse->EndPanTilt returned " + temp$ END SUB SUB DoResetZoom ' Send the Reset Zoom command gZoomPos = 0 ' Send Zoom Direct to 0000h command cmnd$ = "8101044700000000FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->ResetZoom = " + temp$ ' Read ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->ResetZoom returned " + resp$ ' Read comand complete response resp$ = ReadResponse$ PRINT "ReadResponse->ResetZoom returned " + resp$ END SUB SUB DoTiltDown ' Send Tilt Down (V+H speed 9) command cmnd$ = "8101060109090302FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->TiltDown = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->TiltDown returned " + resp$ start! = TIMER ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->TiltDown returned " + resp$ ' Wait 1 second DO endup! = TIMER LOOP UNTIL endup! - start! > 1 ' Send the Pan/Tilt Stop command cmnd$ = "8101060109090303FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->EndPanTilt = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + resp$ ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->EndPanTilt returned " + resp$ END SUB SUB DoTiltUp ' Send Tilt Up (V+H speed 9) command cmnd$ = "8101060109090301FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->TiltUp = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->TiltUp returned " + resp$ ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->TiltUp returned " + resp$ start! = TIMER ' Wait 1 second DO endup! = TIMER LOOP UNTIL endup! - start! > 1 ' Send the Pan/Tilt Stop command cmnd$ = "8101060109090303FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->EndPanTilt = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->EndPanTilt returned " + resp$ ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->EndPanTilt returned " + resp$ END SUB SUB DoZoomIn ' Send the Zoom In command IF gZoomPos < 17 THEN gZoomPos = gZoomPos + 1 head$ = "81010447" SELECT CASE gZoomPos CASE 0 tail$ = "00000000" CASE 1 tail$ = "01060006" CASE 2 tail$ = "02010501" CASE 3 tail$ = "02080600" CASE 4 tail$ = "020C0B05" CASE 5 tail$ = "03000600" CASE 6 tail$ = "03020D03" CASE 7 tail$ = "03050405" CASE 8 tail$ = "03070207" CASE 9 tail$ = "03080A09" CASE 10 tail$ = "030A0402" CASE 11 tail$ = "030B040B" CASE 12 tail$ = "030C0805" CASE 13 tail$ = "030D0705" CASE 14 tail$ = "030E040E" CASE 15 tail$ = "030E0F07" CASE 16 tail$ = "030F0A00" CASE 17 tail$ = "04000000" END SELECT cmnd$ = head$ + tail$ + "FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->ZoomIn (Pos + 1) = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->ZoomIn returned " + resp$ ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->ZoomIn returned " + resp$ ELSE BEEP END IF END SUB SUB DoZoomOut ' Send the Zoom Out command IF gZoomPos > 0 THEN gZoomPos = gZoomPos - 1 head$ = "81010447" SELECT CASE gZoomPos CASE 0 tail$ = "00000000" CASE 1 tail$ = "01060006" CASE 2 tail$ = "02010501" CASE 3 tail$ = "02080600" CASE 4 tail$ = "020C0B05" CASE 5 tail$ = "03000600" CASE 6 tail$ = "03020D03" CASE 7 tail$ = "03050405" CASE 8 tail$ = "03070207" CASE 9 tail$ = "03080A09" CASE 10 tail$ = "030A0402" CASE 11 tail$ = "030B040B" CASE 12 tail$ = "030C0805" CASE 13 tail$ = "030D0705" CASE 14 tail$ = "030E040E" CASE 15 tail$ = "030E0F07" CASE 16 tail$ = "030F0A00" CASE 17 tail$ = "04000000" END SELECT cmnd$ = head$ + tail$ + "FF" temp$ = SendCommand$(cmnd$) PRINT "SendCommand->ZoomOut (Pos + 1) = " + temp$ ' Read the ACK response resp$ = ReadResponse$ ' PRINT "ReadResponse->ZoomOut returned " + resp$ ' Read the command complete response resp$ = ReadResponse$ PRINT "ReadResponse->ZoomOut returned " + resp$ ELSE BEEP END IF END SUB SUB DrawIntroMenu ' This subroutine draws the Intro Menu CLS PRINT PRINT "EVI-D70 Control Application" PRINT PRINT "S Set Configuration" PRINT "R Run Main Loop" PRINT "------------------------" PRINT "Q Quit Application" END SUB SUB DrawRunMenu ' This subroutine draws the Runtime Menu ' Following line commented out for debugging ' CLS PRINT PRINT "EVI-D70 Run Mode" PRINT " [AltA] Home All PTZ " PRINT "[Left] Pan Left [Home] Pan Up & Left " PRINT "[Right] Pan Right [PgUp] Pan Up & Right " PRINT "[Up] Pan Up [End] Pan Down & Left " PRINT "[Down] Pan Down [PgDn] Pan Down & Right" PRINT "[+] Zoom In [AltR] Reset Zoom " PRINT "[-] Zoom Out [AltH] Home Pan & Tilt " PRINT "-----------------------------------------" PRINT "X Exit Run Mode " END SUB SUB DrawSetupMenu ' This subroutine draws the Setup Menu CLS PRINT PRINT "EVI-D70 Setup" PRINT PRINT "S Serial Port [" + STR$(gPortNo) + "]" PRINT "B Baud Rate [" + STR$(gBaudRate) + "]" PRINT "------------------------" PRINT "X Exit Setup" END SUB FUNCTION IFClearAll% ' This function sends the IF_Clear Broadcast message to all devices msg$ = "88010001FF" temp$ = SendCommand$(msg$) PRINT "SendCommand->IFClearAll = " + temp$ ' Read the response temp$ = ReadResponse$ PRINT "ReadResponse->IFClearAll returned " + temp$ ' Error check IF msg$ = temp$ THEN IFClear% = 0 ELSE IFClear% = -1 END IF END FUNCTION SUB LoadPrefs ' This subroutine will check for EVID70.CFG and read in ' its contents. If it does not exist, then it is created ' and defaults are saved FileNum = FREEFILE ' the next free file number FileName$ = "EVID70.CFG" ' the file name temp$ = " " ' Open the pref file OPEN FileName$ FOR RANDOM AS #FileNum ' check for end of file condition (non-existing prefs) IF LOF(FileNum) = 0 THEN gPortNo = 1 temp$ = MKI$(gPortNo) PUT #FileNum, 1, temp$ gBaudRate& = 9600 temp$ = MKL$(gBaudRate) PUT #FileNum, 2, temp$ CLOSE #FileNum ' close the file first! SavePrefs ' now save the preferences ELSE ' close the file in RANDOM mode CLOSE #FileNum ' re-open as INPUT mode FileNum = FREEFILE OPEN FileName$ FOR INPUT AS #FileNum ' read in the port number LINE INPUT #FileNum, temp$ gPortNo = VAL(temp$) ' read in the baud rate LINE INPUT #FileNum, temp$ gBaudRate& = VAL(temp$) ' finally, close the pref file before exiting CLOSE #FileNum END IF END SUB FUNCTION OpenPort% ' This function opens the serial port OpenComm gPortNo%, 0, 8, 0, 1, gBaudRate&, 0, 0 ' output paramters used CLS PRINT "Opened Port " + "COM" + LTRIM$(STR$(gPortNo)) + " with " + LTRIM$(STR$(gBaudRate)) + " 8N1" ' Disable CD checks CarrierDetect 0 PRINT "Carrier Detect disabled" ClearInputBuffer PRINT "Input buffer cleared" DTRcontrol 1 PRINT "DTR raised to ensure EVI-D70 sees DSR due to cable crossover" OpenPort% = 0 END FUNCTION FUNCTION ReadResponse$ ' This method retuns what is read from the serial port as a string temp$ = "" byte% = 0 start! = TIMER DO DO WHILE DataWaiting AND byte% <> 255 byte% = ReadChar IF byte% < 16 THEN temp$ = temp$ + "0" + HEX$(byte%) ELSE temp$ = temp$ + HEX$(byte%) END IF LOOP endup! = TIMER IF (endup! - start!) > 3 THEN temp$ = "Timeout..." byte% = 255 END IF LOOP UNTIL byte% = 255 IF temp$ <> "Timeout..." THEN SELECT CASE temp$ CASE "9041FF" PRINT "Camera 1 Socket 1 ACK received" CASE "9042FF" PRINT "Camera 1 Socket 2 ACK received" CASE "9051FF" PRINT "Camera 1 Socket 1 Command complete" CASE "9052FF" PRINT "Camera 1 Socket 2 Command complete" CASE "906002FF" PRINT "Camera 1 Syntax error..." CASE "906003FF" PRINT "Camera 1 Command buffer full..." CASE "906104FF" PRINT "Camera 1 Socket 1 Command cancelled..." CASE "906204FF" PRINT "Camera 1 Socket 2 Command cancelled..." CASE "906141FF" PRINT "Camera 1 Socket 1 Command not executable..." CASE "906241FF" PRINT "Camera 1 Socket 2 Command not executable..." CASE ELSE PRINT "Undeciphered response received = " + temp$ END SELECT END IF ReadResponse$ = temp$ END FUNCTION SUB SavePrefs ' This subroutine saves the preferences to EVID70.CFG FileName$ = "EVID70.CFG" FileNum = FREEFILE ' delete the existing file KILL FileName$ ' open the file OPEN FileName$ FOR OUTPUT AS #FileNum ' save the port and baud raue data WRITE #FileNum, gPortNo WRITE #FileNum, gBaudRate ' close the file before exiting CLOSE #FileNum END SUB FUNCTION SendCommand$ (msg$) ' This function transmits the Command Packet cmnd$ = "" temp$ = msg$ DO byte$ = CHR$(VAL("&H0" + LEFT$(temp$, 2))) cmnd$ = cmnd$ + byte$ temp$ = MID$(temp$, 3) LOOP UNTIL temp$ = "" Transmit cmnd$ SendCommand$ = msg$ END FUNCTION