MMBasic Driver For MCP2515 SPI CAN Adaptor
This driver allows sending and receiving CAN Bus message for MMBasic via SPI using the MCP2515 CAN adaptor.
The MCP2515 CAN Controller chip on the module can operate from 2.7V to 5.5v but the TJA1050 transceiver is a 5V(4.75-5.25V) device so to use the module with a 3.3v micro you will need to convert to use 3.3v by one of these methods:
* Use a level shifter to interface the SPI and CS pins (The nominal 10MHz SPI speed may need to reduced to 5MHz)
* Replace the TJA1050 transceiver chip on the module with the 3.3V SN65HVD230 transceiver chip, which is proven to be a pin for pin direct replacement and power the module from 3.3V
* Some have hacked the module and supplied it with separate 3.3V and 5V to the respective chips.
* The MCP2515 module is available with the SN65HVD230 transceiver chip but these seem to be much more expensive than the modules with the TJA1050 chip.
If you want to just play with the module in loopback mode without connecting to the CAN Bus you could just temporarily power it with 3.3V
'FLATPAC 'target port\com10:38400 le\lf s\micromite+
'------------------------------------------------------------------------------'
' Micromite library for MCP2515 CAN Module '
' '
' '
' '
' Author: Disco4now TBS Forum '
' '
dim ProgTitle$ = "CAN MCP2515 Test Suite -Polling" '
' '
Dim ProgVer$ = "v1.0.0" '
' '
Dim ProgDate$ = "25-Aug-2024" '
'----------------------------------------------------------------------------'
'Code for a MMBasic to communicate with a MCP2515 SPI CAN chip.
'The console input is scanned and characters read as they are typed
' 18/01/2021 SPI set to 10K with 3.3v chip
' 19/06/2024 Added values for Emerson R48-2900U and more development.
' 22/07/2024 Filters now working. poll for messages in lieu of interrupts
'===============================================================================
' Option settings
'===============================================================================
option explicit
option default NONE
OPTION BASE 0
'OPTION AUTORUN ON
'===============================================================================
' LCD and Touch Initialisation and Test Commands from command prompt
'===============================================================================
'OPTION LCDPANEL ILI9341,L,6,5,4 ' d/c rst cs veroboard version that matches ICSP layout
'OPTION TOUCH 15,2
'GUI TEST LCDPANEL
'GUI CALIBRATE
'===============================================================================
' MCP2515 SPI Routines
'===============================================================================
'Code for MMBASIC to communicate with a MCP2515 over SPI
'Original Author:
'Ported to MMBasic by Disco4now!, TBS forums
'*******************************************************************************
'
'*******************************************************************************
' ILI9488 Display Driver for the Micromite Plus
' Written by Peter Mather (matherp on the Back Shed Forum)
Sub MM.Startup
'ILI9488 D/C, RESET, CS, OR
' ILI9488 6, 5, 4, 3
'ILI9481 6,5,4,3
End Sub
'===============================================================================
'Initialisation scanning of Console and serial ports if required (SETTICK)
'===============================================================================
Dim integer loc0last,loc0now,loc1last,loc1now,loc2last,loc2now,GetCon=0
DIM INTEGER GetCom1=0,GetCom2=0
'Dim integer i,highlow=0
'settick 100,IsSerialOrConsoleComplete,1
settick 300,IsSerialOrConsoleComplete,1 'need longer for VT100 ESC sequences
'===============================================================================
' Data Variables
'===============================================================================
DIM Integer buttonstart=0,LoginRefresh=1 ' flag allocation for timers 0-9+10
DIM Integer buttondown=11,buttonup=12, buttonafter=13 ' other flag allocation
dim integer laststate =1
dim integer buttontimer
'===============================================================================
'Initialisation and Setup of timers 0-9 (SETTICK)
'===============================================================================
Dim Integer TMRctr(9),TMRini(9),Flags=0
SETTICK 100,CoreTMR,4' service timers every 100mS
'===============================================================================
' Rotary Encoder Initialisation Button and Polling via (SETTICK)
'===============================================================================
' KY040 connected to Micromite
' CLK 2 ---> 0.1uF ---> Ov
' DT 3 ---> 0.1uF ---> Ov
'SW 4 ---> 0.1uF ---> Ov
'+ 3V3
' Gnd 0V
'Rotary Encoder Input pins
DIM integer CLK=10,DT=9
'Configure uMite pins
SETPIN DT, DIN
SETPIN CLK, INTH, REInt
'Rotary Encoder Button Long/Short Press setup
dim integer SwPin = 7' Pin number for the push button input
Dim Integer btnUPctr ' counter to hold the shifts
dim integer buttonstate=0',buttoncount=0
SetPin SwPin,DIN,PULLUP
SETTICK 20,ButtonTest,3' check button status every 20mS
'Variable incremented/decremented by the Interrupt handling
'routine for the Rotary Encoder.Needs to be global so that
'REInt ISR can access it
DIM Value as integer
'Var Display Value Inc/Decremented in Main Loop
'Cleared when Switch is pushed.Needs to be Global so that
'SWInt ISR can access it
DIM DispValue as integer
'Set to 1 to request a refresh of the display.Needs to be Global so that
'SWInt ISR can access it
DIM integer DisplayRefresh
dim integer LastValue,Change
'===============================================================================
' CAN Module Variables
'===============================================================================
'There are 2 receive mask registers and 6 filter registers on the controller
'chip that guarantee you get data from the target device. They are useful,
'especially in a large network consisting of numerous nodes.
'// clock and speed
'#define MCP_8MHz_125kBPS_CFG1 (0x01)
'#define MCP_8MHz_125kBPS_CFG2 (0xb1)
'#define MCP_8MHz_125kBPS_CFG3 (0x05)
' 1000000, { 0x00, 0x80, 0x00 } },
' 500000, { 0x00, 0x90, 0x02 } },
' 250000, { 0x00, 0xb1, 0x05 } },
' 200000, { 0x00, 0xb4, 0x06 } },
' 125000, { 0x01, 0xb1, 0x05 } },
' 100000, { 0x01, 0xb4, 0x06 } },
' 80000, { 0x01, 0xbf, 0x07 } },
' 50000, { 0x03, 0xb4, 0x06 } },
' 40000, { 0x03, 0xbf, 0x07 } },
' 20000, { 0x07, 0xbf, 0x07 } },
' 10000, { 0x0f, 0xbf, 0x07 } },
' 5000, { 0x1f, 0xbf, 0x07 } },
'=============================================================================
' Program Initialization and variables
'=============================================================================
DIM INTEGER emersonR48=1
'dim string newmsg
'dim string lastmsg
dim integer sendlogin=0 , tempin=0,tempout=0,vin=0,request_warnings=0
DIM INTEGER request_errors=0,walkfast=0
dim integer sendconfig=0
dim float reqvoltage100x=4800,reqcurrent10x=200,adjvoltage=0
dim float vout=100,iout=100
DIM float hextofloat,vreported,ireported,tempreported,vacreported,ilimitreported
'DIM integer hextofloataddr=PEEK(VARADDR hextofloat)
Print "Starting " + ProgTitle$ + ": " + ProgVer$ + " - " + ProgDate$
'EVERY 100,LoginRefresh 'multiples of 100ms login each 10Secs
'LCD Backlight
'pwm 2,1000,40
'ShowStartScreen
'cls
'BOX 0,0,320,240,,RGB(BLUE)
'=============================================================================
' Configure platform specific variables
'=============================================================================
DIM integer doubleprecision
if (MM.DEVICE$="Micromite MkII" OR MM.DEVICE$="Micromite Plus") THEN
doubleprecision=0
else
doubleprecision=1
ENDIF
'===============================================================================
' ***************** Setup MCP2515 connections
'===============================================================================
'THE MCP2515 module needs to be mofified for 3,3V
'dim integer CANSPEED=125000 'CAN 125KHz 10MHz
DIM INTEGER CAN_CS
CAN_CS=17 'MCP2515 chip select pin17
SETPIN CAN_CS,DOUT
DIM INTEGER sendnow
DIM INTEGER MCP_MODE_NORMAL=&H0 'Normal mode
DIM INTEGER MCP_MODE_LOOPBACK=&H40 'Loopback mode
DIM INTEGER ECHOMSG = 0 'echo messages
DIM INTEGER NOFILTERS = 0 'Accept Filters Status
DIM INTEGER ISROLLOVER = 0 'Rollover Status
DIM integer rts(2)=(&H81,&H82,&H84),tbn=0
dim integer values(14),req(3),sets(7)
'==============================================================================
' Configure SPIOpen ans SPIClose SUBs to the desired SPI
' and settings for the specific MMBASIC platform.
'==============================================================================
dim integer SPISPEED=10000000 'SPI 10MHz
SUB SPIOpen
SPI OPEN SPISPEED,0,8
PIN(CAN_CS)=0
END SUB
SUB SPIClose
PIN(CAN_CS)=1
SPI CLOSE
END SUB
'=============================================================================
' Setup MMBasic FIFO Transmit Buffer
'=============================================================================
DIM INTEGER FifoSize=15 'Number of elements in the FiFo Burrer
DIM INTEGER TXBuffer(FifoSize,1) 'Buffers are 128 bits wide i.e.2 integers wide
DIM INTEGER FifoStart,FifoEnd
'DIM INTEGER login(7) = (&H13, &H45, &H71, &H13, &H59, &H72, &H00, &H00)
'DIM INTEGER readall(7) = (&H00, &H00, &H00, &H00, &H00, &H00, &H00, &H00)
'DIM INTEGER reqone(7)=(&H01,&HF0,&H00,&H01,&H00,&H00,&H00,&H00)
'
DIM INTEGER id=&H05004804
if emersonR48 THEN
EVERY 100,LoginRefresh '(multiples of 100ms) refresh the login each 10Secs
ENDIF
'===============================================================================
' Initialse the MCP2515 CAN Module
'===============================================================================
DIM INTEGER ROLLOVER=1,NOROLLOVER=0
DIM INTEGER Normal=0,Loopback=1 ,echoall=2
DIM INTEGER Acceptall=1,UseFilters=0
mcp_init(LoopBack ,125000,AcceptAll,Rollover) 'initialise module
pause 20
print hex$(mcp_readReg(&H0F),2)
print "initialised"
SUB mcp_init(canmode as integer,CANSPEED as integer,USEFILTERS as integer,ROLLOVER as integer)
mcp_reset() ' after reset its in config mode
'set bus speed
If CANSPEED =125000 THEN
mcp_setReg(&H2A, &H01) 'MCP_CNF1 0x01, 0xb1, 0x05
mcp_setReg(&H29, &Hb1) 'MCP_CNF2
mcp_setReg(&H28, &H05) 'MCP_CNF3
else If CANSPEED =250000 THEN
mcp_setReg(&H2A, &H00) 'MCP_CNF1 0x00, 0xb1, 0x05
mcp_setReg(&H29, &Hb1) 'MCP_CNF2
mcp_setReg(&H28, &H05) 'MCP_CNF3
else If CANSPEED =500000 THEN
mcp_setReg(&H2A, &H00) 'MCP_CNF1 0x00, 0x90, 0x02
mcp_setReg(&H29, &H90) 'MCP_CNF2
mcp_setReg(&H28, &H02) 'MCP_CNF3
else If CANSPEED =100000 THEN
mcp_setReg(&H2A, &H00) 'MCP_CNF1 0x00, 0x80, 0x00
mcp_setReg(&H29, &H80) 'MCP_CNF2
mcp_setReg(&H28, &H00) 'MCP_CNF3
else
PRINT "Error: Invalid canspeed. Valid are 125000,50000,100000 "
END
ENDIF
'**** UnComment the line below to echo all received messages ***********
If canmode=2 then
ECHOMSG = 1 'echo all received messages
else
ECHOMSG = 0
endif
'Initiate the 3 TxBuffers and two RxBuffers.
initBuffers()
'****** Set Interrupt mode if using interrupts.**********
' DONT USE - WE ARE POLLING
' mcp_setReg(&H2B, &H03) 'MCP_CANINTE=&H2B
' ***** setRecBufferCTRLS commands ******************
'setRecBufferCTRLS(IgnoreFilters,rollover )
'
' If ECCH mode then don't use filters.
if ECHOMSG=0 THEN
setRecBufferCTRLS(USEFILTERS,ROLLOVER)
else
setRecBufferCTRLS(AcceptAll,ROLLOVER)
endif
' Use filters on both receive-buffers to receive accept on only messages passing
' the mask and filter conditions. Dont allow Remote Frames.
'setRecBufferCTRLS(0,0,1,0)
' ***** Setup the acceptance masks for RBX0 and RBx1 as required ******************
'setAcceptMask(rbxno,eid ,idmask,datamask ) 'datamask for data(0)+data(1) if eid=0
'setAcceptMask(0, 1, &H2222222,0);
'setAcceptMask(0, 1, &H1FFFFFFF,&H0)
setAcceptMask(0, 1, &H1FFFFFFF,&H0)
setAcceptMask(1, 1, &H1FFFFFFF,&H0)
'setFilterMask(1, 0, &H7FF,&HAA55)
' ***** Setup the acceptance Filter for RBX0 and RBX1 as required ******************
setFilter(0, 1, &H0123456,0) 'RBX6 RBX0
setFilter(1, 1, &H1FFFFFFF,0) 'RBX7 RBX1
setFilter(2, 0, &H7FF,0) 'RBX2
setFilter(3, 1, &H4444444,&H0) 'RBX3
setFilter(4, 1, &H2222222,&H0) 'RBX4
setFilter(5, 0, &H7FF,&H0) 'RBX5
showFilters()
'Set mode MCP2515 mode ..Select one of .. NORMAL or LOOPBACK
'mcp_modReg(&H0F,&HE0,MCP_MODE_NORMAL) 'Normal mode - oneshot is disabled.
'mcp_modReg(&H0F,&HE0,MCP_MODE_LOOPBACK) 'loopback mode - oneshot is disabled.
IF CANMODE=1 then
mcp_modReg(&H0F,&HE0,MCP_MODE_LOOPBACK)'loopback mode - oneshot is disabled.
else
mcp_modReg(&H0F,&HE0,MCP_MODE_NORMAL) 'Normal mode - oneshot is disabled.
END IF
print "mcp mode ";
print hex$(getMode(),2)
'PRINT "Status=" ;
'print hex$(mcp_readStatus(),2)
'PRINT "StatusRX=" ;
'print hex$(mcp_readStatusRX(),2)
'PRINT "CANSTAT=" ;
'PRINT hex$(mcp_readReg(&H0E),2)
'PRINT "CANCTRL=" ;
'PRINT hex$(mcp_readReg(&H0F),2)
'PRINT "CANINTE=" ;
'PRINT hex$(mcp_readReg(&H2B),2)
'PRINT "CANINTF=" ;
'PRINT hex$(mcp_readReg(&H2C),2)
end sub
Print "Listening"
PRint "R ID E R D --------DATA--------- Filter Match Index "
PRint "X ID I T L --------DATA--------- Filter Match Index "
PRint "B ID D R C --------DATA--------- Filter Match Index "
PRINT "- ------- - - - ---------------------- -------------------"
'=============================================================================
' ********************* Main program loop ***********************************
'=============================================================================
timer=0
do
'Watchdog 40000 'reset after 40 secs on hang
'==============================Check Console and Serial Ports===============
IF GetCon=1 then
ReadConsole 'If data in console1 then GOSUB GetConsole
END IF
IF GetCom1=1 then
ReadSerial1 'If data in COM1 then GOSUB GetSerial1
END IF
IF GetCom2=1 then
ReadSerial2 'If data in COM2 then GOSUB GetSerial2
END IF
'==============================Check Rotary Encoder=========================
'Has there been any movement of the encoder ?
Change=Value-LastValue
'We've caught the change so prepare for next time round
LastValue=Value
'Was there any movement of the encoder ?
IF Change<>0 THEN
'If encoder is turning ANTI-clockwise, Decrement
IF Change<0 THEN
DispValue=DispValue-1
ENDIF
'If encoder is turning CLOCKwise, Increment
IF Change>0 THEN
DispValue=DispValue+1
ENDIF
'Request a Display Refresh
DisplayRefresh=1
ENDIF
'==============================Poll for Messages =========================
'Check for Message in RX0
if mcp_readReg(&H2c) AND &H01 then 'test CANINTF B(0)
mcp_readRegs(&H60,values() ,14)
mcp_modReg(&H2c,&H01,&H00) 'clear CANINTF B(0)
actionmsg 0
endif
'Check for Message in RX1
if mcp_readReg(&H2c) AND &H02 then 'test CANINTF B(1)
mcp_readRegs(&H70,values() ,14)
mcp_modReg(&H2c,&H02,&H00) 'clear CANINTF B(1)
actionmsg 1
endif
''==================NOT USED WE ARE POLLING ===Check MCP Interrupts==========
'if (pin(CANINT1)=0) THEN
'intno=mcp_readReg(&H0E)
'intno=(intno AND &H0E)>>1
''PRINT intno
'select case intno
'case 7 'message in RX1
'mcp_readRegs(&H70,values() ,14)
'actionmsg 1
'mcp_modReg(&H2c,&H02,&H00) 'clear CANINTF B(1)
'case 6 'message in RX0
''mcp_readRxBuff(&H90,values(),13)
'mcp_readRegs(&H60,values() ,14)
'actionmsg 0
'mcp_modReg(&H2c,&H01,&H00) 'clear CANINTF B(0)
'case 5
'Print "TX2"
'mcp_modReg(&H2c,&H10,&H00) 'clear CANINTF B(4)
'case 4
'Print "TX1"
'mcp_modReg(&H2c,&H08,&H00) 'clear CANINTF B(3)
'case 3
'Print "TX0"
'mcp_modReg(&H2c,&H04,&H00) 'clear CANINTF B(2)
'case 2
'PRINT "WAKI"
'mcp_modReg(&H2c,&H40,&H00) 'clear CANINTF B(6)
'case 1
'PRINT "ERRI"
'mcp_modReg(&H2c,&H20,&H00) 'clear CANINTF B(5)
'case else
'' PRINT "NO INTS !!!!!!!!!!"
'end select
'endif
'=====================ACtion any Application Requests=========================
if sendlogin=1 then
if emersonR48 THEN
id=&H06000783
reqone(3)=1
sendMsg( id,1,0,8,reqone())
else
'login
id=&H05004804
sendMsg( id,1,0,8,login())
endif
sendlogin=0
endif
if request_warnings=1 then
id=&H0501BFFC
req(0)=&H08:req(1)=&H04:req(2)=&H00
mcp_sendMsg( id,1,3,req())
request_warnings=0
endif
if request_errors=1 then
id=&H0501BFFC
req(0)=&H08:req(1)=&H08:req(2)=&H00
mcp_sendMsg( id,1,3,req())
request_errors=0
endif
if sendconfig=1 then
if walkfast=1 then
id=&H05FF4004 ' 5sec walkin
else
id=&H05FF4005 '60sec walkin
endif
sets(6)=&H3E:sets(7)=&H17 'OVP set to 59.9 ????
sets(0)=reqcurrent10x AND &HFF
sets(1)=(reqcurrent10x>>8) AND &HFF
sets(2)=reqvoltage100x AND &HFF
sets(3)=(reqvoltage100x>>8) AND &HFF
sets(4)=reqvoltage100x AND &HFF
sets(5)=(reqvoltage100x>>8) AND &HFF
mcp_sendMsg( id,1,8,sets())
sendconfig=0
end if
'==========================Transmit next Messages ========================
'Process the the next meaage in the Transmit Queue
sendnow=sendnow+1
IF sendnow=10 Then
sendnow=0
sendSingleMessage
endif
'Update the Display ?
IF DisplayRefresh=1 THEN
'Reset the trigger
DisplayRefresh=0
'Display on the Console
PRINT STR$(DispValue)
ENDIF
If FlagTest(buttondown) Then '
if FlagTest(buttonafter)=0 then After 2,buttonstart ' 2*100ms
FlagSet buttonafter
FlagRes buttonup
'FlagRes buttondown
endif
If FlagTest(buttonup) Then '
if buttonstate=0 then 'down
elseif buttonstate=1 then 'SHORT PRESS
? "Short Press"
elseif buttonstate=2 then 'LONG PRESS
? "Long Press"
endif
FlagRes buttonup
endif
If FlagTest(buttonstart) Then
FlagRes buttonstart
FlagRes buttondown
FlagRes buttonafter
endif
'Send a login every 10 seconds
if FlagTest(LoginRefresh) Then
FlagRes LoginRefresh
'? "login now"+str$(timer)
'sendlogin=1
end if
Loop
'==============================================================================
' ********************* -- END of Main program loop-- ************************
'==============================================================================
'===============================================================================
' CAN High Level Functional Routines actionmsg,
'===============================================================================
SUB actionmsg(rxno as integer)
local integer id,eid ,dat ,dlc,rtr,msg,i,rfx
Local INTEGER fmi,fminitial(7)=(0,1,2,3,4,5,0,1)
Local INTEGER fmo,fmoverflow(7)=(6,7,2,3,4,5,0,1)
eid=(values(2)>>3) and &H1
rtr=(values(5)>>6) and &H1
dlc= values(5) AND &H0F
if eid=1 then
id=(values(1)<<21) OR ((values(2) AND &HE0)<<13) OR ((values(2) AND &H03)<<16) or (values(3)<<8) or values(4)
else
id =(values(1)<<3) or ((values(2)>>5) AND &H07)
end if
'Resolve the matched filter
if NOFILTERS then
fmi=-1
fmo=-1
ELSE
'Get the matching filter
if rxno=0 then rfx=mcp_readReg(&H60) AND &H07
if rxno=1 then rfx=mcp_readReg(&H70) and &H07
if ISROLLOVER then
fmi=fminitial(rfx)
fmo=fmoverflow(rfx)
endif
ENDIF
msg=&H0
if rtr=0 then
if dlc > 0 then msg=((values(6) AND &HFF)<<56)
if dlc > 1 then msg=msg OR ((values(7) AND &HFF)<<48)
if dlc > 2 then msg=msg OR ((values(8) AND &HFF)<<40)
if dlc > 3 then msg=msg OR ((values(9) AND &HFF)<<32)
if dlc > 4 then msg=msg OR ((values(10) AND &HFF)<<24)
if dlc > 5 then msg=msg OR ((values(11) AND &HFF)<<16)
if dlc > 6 then msg=msg OR ((values(12) AND &HFF)<<8)
if dlc > 7 then msg=msg OR ((values(13) AND &HFF))
endif
'if rtr Then msg=&H0
'print id," ";
select case id
CASE &H05014400 'Login request
print "login request Eltek"
CLS
login(0)= values(6)
login(1)= values(7)
login(2)= values(8)
login(3)= values(9)
login(4)= values(10)
login(5)= values(11)
sendlogin=1
EVERY 100,LoginRefresh '(multiples of 100ms) refresh the login each 10Secs
CASE &H05001972 'alt login
'sendlogin=1 'Now done with timer above
CASE &H05014004 'status update normal
ShowStatus 0
CASE &H05014008 'status update with warning
ShowStatus 1
CASE &H0501400C 'status update with error
ShowStatus 2
CASE &H05014010 'status update with walkin
ShowStatus 3
'EMERSON R48-2900U Replrties
CASE &H5555555
? "Got Voltage=",BIN32ToFloat((msg AND &HFFFFFFFF00000000)>>32 )
'? hex$(msg)
'? hex$( msg AND &HFFFF000000000000)
' ? hex$((msg AND &HFFFF000000000000)>> 32)
? "Got Current=",BIN32ToFloat((msg AND &HFFFFFFFF) )
'? hex$((msg AND &HFFFFFFFF0000000000000000) >> 16)
CASE &H060F8003
'01 = output voltage
'02 = output current
'03 = output current limit
'04 = temperature in C
'05 = supply voltage
'06 =
'07 =
'08 =
'09 =
? "data=" +hex$(values(6),2)+hex$(values(7),2)+hex$(values(8),2)+" "+hex$(values(9),2);
? " "+hex$(values(10),2)+hex$(values(11),2)+hex$(values(12),2)+hex$(values(13),2)
'this works between 42 24 00 00 min 41V and 42 6A 00 00 max 58,5V
' ? peek(float )
'POKE WORD vrequestaddr, &H42240000
POKE WORD hextofloataddr, values(10)<<24 OR values(11)<<16 OR values(12)<<8 OR values(13)
select case values(9)
CASE 1
vreported = hextofloat
? "Voltage:",vreported
CASE 2
ireported = hextofloat
? "Current",ireported
CASE 3
ilimitreported = hextofloat
? "Current Limit:",ilimitreported
CASE 4
tempreported = hextofloat
? "Temperature",tempreported
CASE 5
vacreported = hextofloat
? "AC Voltage",vacreported
case else
? values(9),hextofloat
end select
CASE ELSE
'Print STR$(rxno)+" "+SPACE$(4-eid*4)+HEX$(id%,3+eid*4)+" "+HEX$(eid%)+" "+HEX$(rtr%)+" "+HEX$(dlc%)+" ";
'PRINT FMT$(HEX$(msg%,16));
'
'if NOFILTERS then
'PRINT " No filters - Accept All"
'ELSE
'if rxno=0 then print " (RBX0) RFX"+STR$(fmi)
'if rxno=1 then print " (RBX1) RFX"+STR$(fmi)
'ENDIF
'If ECHOMSG THEN
'addMessage( id,eid,rtr,dlc,dat)
'END IF
end select
Print STR$(rxno)+" "+SPACE$(4-eid*4)+HEX$(id%,3+eid*4)+" "+HEX$(eid)+" ";
PRINT HEX$(rtr%)+" "+HEX$(dlc%)+" ";
PRINT FMT$(HEX$(msg%,16));
if NOFILTERS then
PRINT " No filters - Accept All"
ELSE
if rxno=0 then print " (RBX0) RFX"+STR$(fmi)
if rxno=1 then print " (RBX1) RFX"+STR$(fmi)
ENDIF
If ECHOMSG THEN
addMessage( id,eid,rtr,dlc,msg)
END IF
END SUB
SUB addMessage(id as Integer,eid as integer,rtr as integer,dlc as integer,dat as integer)
local integer i
FifoEnd=FifoEnd + 1 : If FifoEnd=FifoSize then FifoEnd=0
TXBuffer(FifoEnd,0)=id OR (eid << 63) OR (rtr << 62) or ((dlc AND &H0F) << 55)
TXBuffer(FifoEnd,1)=dat
end sub
SUB sendSingleMessage()
local INTEGER value,id,eid,rtr,dlc,i
IF FifoEnd<>FifoStart Then
FifoStart=FifoStart + 1 : If FifoStart=FifoSize then FifoStart=0
value=TXBuffer(FifoStart,1)
id=TXBuffer(FifoStart,0) AND &H7FFFFFFF
eid=TXBuffer(FifoStart,0)>>63 AND &H1
rtr=TXBuffer(FifoStart,0)>>62 AND &H1
dlc=TXBuffer(FifoStart,0)>>55 AND &H0F
sendMsg(id,eid,rtr,dlc,value)
'sendMsg(id,eid,rtr,dlc,value)
endif
end sub
SUB sendMsg( id as integer,eid as integer,rtr as integer,dlc as integer,dat as integer)
local integer sidh,ctl,buff(15),canid,i
sidh=&H31+16*tbn 'get the SIDH buffer address ie. 31,41,51 for buffers 0,1,2
ctl=&H30+16*tbn 'get the CTL register address ie. 30,40,50 for buffers 0,1,2
'prepare 14 bytes to load to tx buffers
buff(0)=&H02 'the write command
buff(1)=ctl 'the start register
buff(2)=0 'just set the priorit bit 0:1)
' 3=SIDH, 4=SIDL , 5=EID8,6=EID0
if (eid = 1) then
canid = id AND &H1FFFFFFF
buff(6) = canid AND &HFF
buff(5) = canid >> 8 and &HFF
canid = id >> 16
buff(4) = (canid AND 3) or ((canid AND &H1c)<<3)
buff(4)=buff(4) OR 8 'set the EXIDE bit
buff(3) = canid >> 5 AND &HFF
else
canid = id AND &H7FF
buff(3)=canid >> 3
buff(4)=((canid AND &H07) << 5)
buff(5)=0
buff(6)=0
endif
if rtr then
buff(7)=((rtr<<6) AND &H40) '-- RTR -- -- DLC3 DLC2 DLC1 DLC0
else
buff(7)=(dlc AND &H0F) '-- RTR -- -- DLC3 DLC2 DLC1 DLC0
endif
'load data
if rtr=0 then
for i = 0 to dlc-1
buff(8+i)=dat >> (56-i*8) AND &HFF
next i
endif
'PRINT "Load regs"
mcp_setRegs(8+i,buff())
mcp_send(tbn)
tbn=tbn+1:if tbn=3 then tbn=0
end sub
Function FMT$(a$) As string
local b$
b$= " "+Mid$(a$,1,2)+" "+Mid$(a$,3,2)+" "+Mid$(a$,5,2)+" "+Mid$(a$,7,2)
FMT$=b$+" "+Mid$(a$,9,2)+" "+Mid$(a$,11,2)+" "+Mid$(a$,13,2)+" "+Mid$(a$,15,2)
End Function
SUB initBuffers()
Local integer i
for i=0 to 13
mcp_setReg(&H30+i,0) 'TXB0CTRL=&H30
mcp_setReg(&H40+i,0) 'TXB1CTRL=&H40
mcp_setReg(&H50+i,0) 'TXB2CTRL=&H50
next i
mcp_setReg(&H60,0) 'RXB0CTRL=&H60
mcp_setReg(&H70,0) 'RXB1CTRL=&H70
END SUB
'Reg 60 RXB0CTRL[6:5]=11 to bypass filter and accept all messages , 00 to enabled filters
'Reg 60 RXB0CTRL[2]=1 to enable rollover to RBX1 if RBX0 is full
'Reg70 RXB1CTRL[6:5]=11 to bypass filter and accept all messages , 00 to enabled filters
'mcp_setFilterCTRLS(0,0,1,0)
SUB setRecBufferCTRLS(IgnoreFilters AS INTEGER,rollover AS INTEGER)
local integer ctr1=((IgnoreFilters AND &H1) << 6) OR ((IgnoreFilters AND &H1)<< 5) OR ( (rollover AND &H1) << 2 )
local integer ctr2=((IgnoreFilters AND &H1) << 6) OR ((IgnoreFilters AND &H1)<< 5)
mcp_modReg(&H60,&H64,ctr1)
mcp_modReg(&H70,&H60,ctr2)
NOFILTERS=IgnoreFilters
ISROLLOVER=rollover
? "CTRL",HEX$(ctr1),HEX$(ctr2)
END SUB
'Regs 20-23 Filter 5 Mask (used for RBX0) STANDARD/EXTENDED
'Regs 24-27 Filter 5 Mask (used for RBX1) STANDARD/EXTENDED
'RBxno is the recieve buffer 0 or 1
'eid is 0 for STANDARD 11 bit IDs , 1 for EXTENDED 29 bit IDs
'id is the id 0-&H7FF for STDIDs , 0-&H1FFFFFFF for EXTIDs
'data01 allows filtering on the first 16 bits of data for STANDARD frames. This is added to the filter.
' is ignored for extended frames so set t0 0
'mcp_setAcceptMask(0, 1, 0x1FFFFFFF,0); Go to regsreg 20-23
SUB setAcceptMask(rbxno as integer,eid as integer,id as integer,data01 as integer)
LOCAL INTEGER buff(10) ,startreg
if RBxno=0 Then startreg=&H20
if RBxno=1 Then startreg=&H24
buff(0)=&H02 'the write command
buff(1)=startreg 'the start register
'Ext id is B28 B27--------B24 B23------B16 B15-----B8 B7-----B0
'Std id B18B17B16 B15-----B8 B7-----B0
if (eid=1) then
if (id >> 29)<>0 THEN PRINT "Error: ID > &H1FFFFFFF when setting filterMask "+str$(RBxno):END
buff(2)=(id >> 21 and &HFF )
buff(3)=((id >> 13 and &HE0 ) OR (id >> 16 AND &H03) )
buff(4)=((id >> 8)and &HFF)
buff(5)=(id and &HFF)
else
if (id >> 11)<>0 THEN PRINT "Error: ID > &H7FF when setting filterMask "+Str$(RBxno):END
buff(2)=((id >> 3 and &HFF ))
buff(3)=(((id AND &H07) << 5) and &HFF )
buff(4)=(data01 >> 8 and &HFF) 'data0 filter for std
buff(5)=(data01 and &HFF) 'data1 filter for std
endif
mcp_setRegs(6,buff())
END SUB
'Set filter mask for RXB0 or RXB1
'Regs 00-03 Filter 0 Mask (used for RBX0) STANDARD/EXTENDED
'Regs 04-07 Filter 1 Mask (used for RBX0) STANDARD/EXTENDED
'Regs 08-0B Filter 2 Mask (used for RBX1) STANDARD/EXTENDED
'Regs 10-13 Filter 3 Mask (used for RBX1) STANDARD/EXTENDED
'Regs 13-17 Filter 4 Mask (used for RBX1) STANDARD/EXTENDED
'Regs 18-1B Filter 5 Mask (used for RBX1) STANDARD/EXTENDED
' STD fills 2 registers, Extend fills 4 registers.
'mcp_setFilter(3,1,&H1A1010B1) go to reg 10-13
SUB setFilter(filterno as integer,eid as integer,id as integer,data01 as integer)
LOCAL INTEGER buff(10) ,startreg
if filterno=0 Then startreg=&H00
if filterno=1 Then startreg=&H04
if filterno=2 Then startreg=&H08
if filterno=3 Then startreg=&H10
if filterno=4 Then startreg=&H14
if filterno=5 Then startreg=&H18
buff(0)=&H02 'the write command
buff(1)=startreg 'the start register
if (eid=1) then
if (id >> 29)<>0 THEN PRINT "Error: ID > &H1FFFFFFF when setting filter "+str$(filterno):END
buff(5)=(id and &HFF)
buff(4)=((id >> 8) and &HFF )
buff(3)=((id >> 13 and &HE0 ) OR (id >> 16 AND &H03) or (1 << 3) )
buff(2)=((id >> 21) and &HFF )
else
if (id >> 11)<>0 THEN PRINT "Error: ID > &H7FF when setting filter "+str$(filterno):END
buff(2)=((id >> 3 and &HFF ))
buff(3)=(((id AND &H07) << 5) and &HFF )
buff(4)=(data01 >> 8 and &HFF) 'data0 filter for std
buff(5)=(data01 and &HFF) 'data1 filter for std
endif
mcp_setRegs(6,buff())
END SUB
function getmode() as integer
getmode=mcp_readReg(&H0E)'&& &HE0)
end function
'Print out the filter and mask configurations
SUB showFilters()
LOCAL integer id1,id2
LOCAL INTEGER mask(3)
LOCAL INTEGER rid
id1=mcp_readReg(&H60)
id2=mcp_readReg(&H70)
PRINT " *********** FILTER and MASK Summary **************"
PRINT "RBX0 Overflows to RBX1 :";
if (id1 AND &H04) THEN Print "YES" ELSE PRINT "NO"
PRINT "RBX0 Uses Mask and Filters :";
if (id1 AND &H60) THEN Print "NO" ELSE PRINT "YES"
PRINT "RBX1 Uses Mask and Filters :";
if (id2 AND &H60) THEN Print "NO" ELSE PRINT "YES"
mcp_readRegs(&H20,mask(),4)
Print "----------------------------"
? HEX$(rid,8)
print "RBX0 Mask -->"+HEX$(mask(0),2)+" "+HEX$(mask(1),2)+" "+HEX$(mask(2),2)+" "+HEX$(mask(3),2)
mcp_readRegs(&H24,mask(),4)
print "RBX1 Mask -->"+HEX$(mask(0),2)+" "+HEX$(mask(1),2)+" "+HEX$(mask(2),2)+" "+HEX$(mask(3),2)
Print "---------------------------"
mcp_readRegs(&H00,mask(),4)
print "RBX0 Flter 0-->"+BIN$(mask(0),8)+" "+BIN$(mask(1),8)+" "+BIN$(mask(2),8)+" "+BIN$(mask(3),8)
mcp_readRegs(&H04,mask(),4)
print "RBX0 Flter 1-->"+BIN$(mask(0),8)+" "+BIN$(mask(1),8)+" "+BIN$(mask(2),8)+" "+BIN$(mask(3),8)
mcp_readRegs(&H08,mask(),4)
print "RBX1 Flter 2-->"+BIN$(mask(0),8)+" "+BIN$(mask(1),8)+" "+BIN$(mask(2),8)+" "+BIN$(mask(3),8)
mcp_readRegs(&H10,mask(),4)
print "RBX1 Flter 3-->"+BIN$(mask(0),8)+" "+BIN$(mask(1),8)+" "+BIN$(mask(2),8)+" "+BIN$(mask(3),8)
'print "RBX1 Filter -->"+HEX$(mask(0),2)+" "+HEX$(mask(1),2)+" "+HEX$(mask(2),2)+" "+HEX$(mask(3),2)
mcp_readRegs(&H14,mask(),4)
print "RBX1 Flter 4-->"+BIN$(mask(0),8)+" "+BIN$(mask(1),8)+" "+BIN$(mask(2),8)+" "+BIN$(mask(3),8)
mcp_readRegs(&H18,mask(),4)
print "RBX1 Flter 5-->"+BIN$(mask(0),8)+" "+BIN$(mask(1),8)+" "+BIN$(mask(2),8)+" "+BIN$(mask(3),8)
PRINT " *********** -------------- **************"
END SUB
'===============================================================================
' Low Level Register Read and Write via SPI to MCP2515 Module
'===============================================================================
SUB mcp_setReg(reg as integer,dat as integer)
SPIOPEN 'speed,0,8
SPI WRITE 3,&H02,reg,dat
SPICLOSE
end sub
SUB mcp_setRegs(n as integer,dat() as integer)
SPIOPEN 'speed,0,8
SPI WRITE n,dat()
SPICLOSE
end sub
SUB mcp_modReg(reg as integer,mask as integer,dat as integer)
SPIOPEN 'speed,0,8
SPI WRITE 4,&H05,reg,mask,dat 'MCP_BITMOD=&H05
SPICLOSE
end sub
FUNCTION mcp_readReg(reg as integer) as integer
SPIOPEN 'speed,0,8
SPI WRITE 2,&H03,reg
mcp_readReg=SPI(0)
SPICLOSE
END FUNCTION
FUNCTION mcp_readStatus() as integer
SPIOPEN 'speed,0,8
SPI WRITE 1,&HA0
mcp_readStatus=SPI(0)
SPICLOSE
END FUNCTION
FUNCTION mcp_readStatusRX() as integer
SPIOPEN 'speed,0,8
SPI WRITE 1,&HB0
mcp_readStatusRX=SPI(0)
SPICLOSE
END FUNCTION
SUB mcp_readRegs(reg as integer,values() as INTEGER,n as integer)
SPIOPEN 'speed,0,8
SPI WRITE 2,&H03,reg
SPI READ n,values()
SPICLOSE
END SUB
SUB mcp_readRxBuff(reg as integer,values() as INTEGER,n as integer)
SPIOPEN 'speed,0,8
SPI WRITE 2,&H03,reg
SPI READ n,values()
SPICLOSE
END SUB
SUB mcp_send(n as integer)
'Set Request to Send for desited TX Buffer
SPIOPEN 'speed,0,8
SPI WRITE 1,rts(n)
'ret=SPI(&HC0)
SPICLOSE
end SUB
SUB mcp_reset()
'open the SPI at 10KHz
SPIOPEN 'speed,0,8
SPI WRITE 1,&HC0
SPICLOSE
end SUB
'===============================================================================
' Utility functions to convert between Float and and binary BIN32
'===============================================================================
Function FloatToBIN32(i As FLOAT) As INTEGER
local INTEGER w%,c%,d%,e%,o%
Local INTEGER j
if doubleprecision=0 then
FloatToBIN32=Peek(INTEGER Peek(VARADDR i))
else
Poke FLOAT Peek(varaddr w%),i 'store the 64 bits double precision HEX of the floating point to w%
c%=(w% And &H8000000000000000)>>32 'get the sign bit back to Bit32
d%=(w% And &hFFFFFE0000000)>>29 'get the shortened mantissa and move to new position
e%=(((w% And &H7FF0000000000000)>>52)+127-1023)<<23 'get the exponent and convert
o%=(c% Or d% Or e%)
Poke integer Peek(varaddr j),o% 'put the answer into the integer
FloatToBIN32=j
endif
End Function
Function BIN32ToFloat(i As INTEGER) As FLOAT
Local float j
local INTEGER w%,c%,d%,e%,o%
if doubleprecision=0 then
Poke INTEGER Peek(VARADDR j),i
BIN32ToFloat=j
else
Poke word Peek(varaddr w%),i 'store the single precision HEX of the floating point
c%=(w% And &H80000000)<<32 'get the sign bit
d%=(w% And &h7FFFFF)<<29 'get the mantissa
e%=(((w% And &H7f800000)>>23)-127+1023)<<52 'get the exponent and convert
o%=(c% Or d% Or e%)
Poke integer Peek(varaddr j),o% 'put the answer into a double
BIN32ToFloat=j
ENDIF
End Function
'=============================================================================
' Procedures providing program functionality components
'=============================================================================
'Checks console and serial ports for data and sets flag if data has stopped coming in.
'flag triggers read of the data in the main program loop
sub IsSerialOrConsoleComplete
'Check console and set flag if data exists and has stopped coming in
loc0now=LOC(#0)
IF Loc0now>0 then
IF loc0now=loc0last THEN 'data finished
GetCon=1 'If data in CON then set GetConsole flag
else
loc0last=loc0now
ENDIF
END IF
'Check COM1 and set flag if data exists and has stopped coming in
' loc1now=LOC(#1)
' IF loc1now > 0 THEN
' if loc1now=loc1last then 'data finished
' GetCom1=1
' ELSE
' loc1last=loc1now
' ENDIF
' ENDIF
'
'Check COM2 and set flag if data exists and has stopped coming in
' loc2now=LOC(#2)
' IF loc2now > 0 THEN
' if loc2now=loc2last then 'nothin new
' GetCom2=1
' ELSE
' loc2last=loc2now
' ENDIF
' ENDIF
end sub
'Reads data from the console
SUB ReadConsole
local char$
LOCAL INTEGER msg%
LOCAL INTEGER i,j,k,ret,ret1,ret2,ret3,ok=0
STATIC INTEGER x=1
'Fan speed auto?
Local INTEGER req1=&H03F0003300000000
'Fan speed full
Local INTEGER req2=&H03F0003300010000
'read ??
Local INTEGER req3=&H00F0008046A53400
'Fan speed full
Local INTEGER reqall=&H0000000000000000
'Fan speed full
j=LOC(#0)
char$= INPUT$(100,#0)
ok=0
if char$<>"" then
IF char$=" " THEN
'? "-----SPACE BAR--------"
'? "**************************"
'CAN SEND id,eid,dlc,msg,ret
msg%=&H1213141516171820
'eid%=1:dlc%=8
addMessage(&H111,0,0,8,msg%)
addMessage(&H222,0,0,8,msg%)
addMessage(&H234,0,0,8,msg%)
addMessage(&H555,0,0,8,msg%)
addMessage(&H525,0,1,8,&HFFFFFFFFFFFFFFFF)
addMessage(&H1111111,1,0,8,&H1113141516171800)
addMessage(&H2222222,1,0,8,&H1213141516171820)
addMessage(&H3333333,1,0,8,&H1F03141516171820)
addMessage(&H4444444,1,0,8,&H1413141516171800)
addMessage(&H123456,1,0,4,&H1513141516171820)
addMessage(&H123457,1,0,8,&H1613141516171820)
end if
IF Char$="0" then
'id=0
' addMessage( 0,id,1,8,login())
ok=1
endif
IF Char$="1" then
'login invitation
id=&H1FFFFFFF
'id=&H06000783
'mcp_sendMsg( 2,id,1,8,reqone())
addMessage( id,1,0,8,&H12345678abcdef11)
addMessage( id,1,0,8,&Habcdef11abcdef22)
addMessage( id,1,0,8,&Habcdef22abcdef22)
'mcp_sendMsg( 0,id,1,8,login())
print "add msg ",hex$(id)
ok=1
endif
IF Char$="2" then
'login
id=&H1FFFFFFE
addMessage( id,1,0,8,&H1122334455667788)
print "mcp msg send",hex$(id)
ok=1
endif
IF Char$="3" then
'login
id=&H7FFF
addMessage( id,1,0,8,&H1122334455667788)
print "mcp msg send",hex$(id)
ok=1
endif
IF Char$="4" then
id=&H5555555
msg%=(FloatToBIN32(58.5)<<32 AND &HFFFF000000000000) OR (FloatToBIN32(19.5) << 16 AND &HFFFF00000000)
addMessage( id,1,0,8,msg%)
print "Sent voltage=58.5 Current=19.5",hex$(id)
ok=1
end if
IF Char$="5" then
? "Get voltage 58.56789 From BIN32 of 42 6A 45 85"
'" 42 24 00 00 min 41V and 42 6A 00 00 max 58,5V"
id=&H426A4585
? BIN32ToFloat(id)
ok=1
end if
IF Char$="6" then
? "Get 42 6A 00 00 from float voltage 58.5 "
'" 42 24 00 00 min 41V and 42 6A 00 00 max 58,5V"
id=&H426A0000
? HEX$(FloatToBIN32(58.5),8)
? HEX$(FloatToBIN32(58.56),8)
? HEX$(FloatToBIN32(1000.5),8)
ok=1
end if
''EMERSON R48-2900U
'IF Char$="6" then
'
'id=&H0607FF83
'addMessage( id,1,0,8,readall)
'ok=1
'end if
'IF Char$="7" then
'id=&H0607FF83
'? "Fan Auto"
'addMessage( id,1,0,8,req1)
'ok=1
end if
IF Char$="8" then
id=&H0607FF83
? "fan full"
addMessage( id,1,0,8,req2)
ok=1
end if
IF Char$="9" then
' ? "Read aa1"
' id=&H060F8007
' mcp_sendMsg( 2,id,1,8,reqall)
' ? "Read aa2"
' id=&H0607FF83
' addMessage( id,1,0,8,reqall)
select case x
case 1
? "Read one"
id=&H06000783
reqone(3)=1
addMessage( id,1,0,8,reqone)
case 2
? "Read one"
id=&H06000783
'reqone(3)=2
addMessage( id,1,0,8,reqone)
case 3
? "Read one"
id=&H06000783
r'eqone(3)=3
addMessage( id,1,0,8,reqone)
case 4
? "Read one"
id=&H06000783
'reqone(3)=4
addMessage( id,1,0,8,reqone)
case 5
? "Read one"
id=&H06000783
reqone(3)=5
addMessage( id,1,0,8,reqone)
case 6
? "Read one"
id=&H06000783
reqone(3)=6
addMessage( id,1,0,8,reqone)
case 7
? "Read one"
id=&H06000783
reqone(3)=7
addMessage( id,1,0,8,reqone)
case else
/*
To read from the R48
Send to 06000783 => 01 F0 00 xx 00 00 00 00 xx = measurement No.
Response from 060F8003 <= 41 F0 00 xx yy yy yy yy xx = measurement No. yy yy yy yy = value
EDIT - corrected the response address
xx =
01 = output voltage
02 = output current
03 = output current limit
04 = temperature in C
05 = supply voltage
06 =
07 =
08 =
09 =
*/
end select
x=x+1
if x> 7 then x=1
ok=1
end if
IF Char$="a" then
'PIN(CANCS)=0
end if
IF Char$="b" then
'PIN(CANCS)=1
end if
IF Char$="b" then id=11
IF Char$="c" then id=12
IF Char$="d" then id=13
IF Char$="e" then id=14
IF Char$="f" then id=15
if char$=chr$(145) or mid$(char$,2)="[11~" then 'F1 VT100
print "F1"
ok=1
endif
if char$=chr$(146) or mid$(char$,2)="[12~" then 'F2 VT100
print "F2"
ok=1
end if
if char$=chr$(147) or mid$(char$,2)="[13~" then 'F3 VT100
print "F3"
ok=1
end if
if char$=chr$(148) or mid$(char$,2)="[14~" then 'F4 VT100
? "F4"
ok=1
end if
if char$=chr$(149) or mid$(char$,2)="[15~" then 'F5 VT100
? "F5"
ok=1
end if
if char$=chr$(150) or mid$(char$,2)="[17~" then 'F6 VT100
? "F6"
ok=1
end if
if char$=chr$(151) or mid$(char$,2)="[18~" then 'F7 VT100
? "F7"
ok=1
end if
if char$=chr$(152) or mid$(char$,2)="[19~" then 'F8 VT100
? "F8"
ok=1
end if
if char$=chr$(153) or mid$(char$,2)="[20~" then 'F9 VT100
? "F9"
ok=1
end if
if char$=chr$(154) or mid$(char$,2)="[21~" then 'F10 VT100
? "F10"
ok=1
end if
if char$=chr$(155) or mid$(char$,2)="[23~" then 'F11 VT100
print "F11"
ok=1
end if
if char$=chr$(156) or mid$(char$,2)="[24~" then 'F12 VT100
print "F12"
ok=1
end if
if char$=chr$(127) or mid$(char$,2)="[3~" then 'del
walkfast=0
text 10,200, "SLOW"
ok=1
end if
if char$=chr$(128) or mid$(char$,2)="[A" then 'up arrow VT100
reqvoltage100x=reqvoltage100x+10
text 170,70, "Req Voltage="+STR$(reqvoltage100x/100,2,1)
ok=1
end if
if char$=chr$(129) or mid$(char$,2)="[B" then 'down arrow
reqvoltage100x=reqvoltage100x-10
text 170,70, "Req Voltage="+STR$(reqvoltage100x/100,2,1)
ok=1
end if
if char$=chr$(131) or char$=chr$(4) or mid$(char$,2)="[C" then 'right arrow VT100 MMEdit
reqcurrent10x=reqcurrent10x+2
text 170,50, "Req Current="+STR$(reqcurrent10x/10,2,1)
ok=1
end if
if char$=chr$(130) or char$=chr$(19)or mid$(char$,2)="[D" then 'left arrow VT100 VT100 MMEdit
reqcurrent10x=reqcurrent10x-2
text 170,50, "Req Current="+STR$(reqcurrent10x/10,2,1)
ok=1
end if
if char$=chr$(132) or mid$(char$,2)="[2~" then 'INS
walkfast=1
text 10,200, "FAST"
ok=1
end if
if char$=chr$(133) then
print "133"
ok=1
end if
if char$=chr$(134) or mid$(char$,2)="[1~" then 'home
adjvoltage=0
text 10,220, "adj="+str$(adjvoltage)+" "
ok=1
end if
if char$=chr$(135) or mid$(char$,2)="[4~" then 'end
print reqcurrent10x,reqvoltage100x +adjvoltage,reqvoltage100x
sendconfig=1
ok=1
end if
if char$=chr$(136) or mid$(char$,2)="[5~" then 'PgUp VT100
adjvoltage=100
text 10,220, "adj="+str$(adjvoltage)+" "
ok=1
end if
if char$=chr$(137) or mid$(char$,2)="[6~" then 'Pgdn VT100
adjvoltage=-100
text 10,220, "adj="+str$(adjvoltage)+" "
ok=1
end if
if char$=chr$(138) then
print "138"
ok=1
end if
if char$=chr$(139) then
print "ALT"
ok=1
end if
if char$=chr$(140) then
print "140"
ok=1
end if
'else
'? char$;
' ? ASC(left$(char$,1));
'endif
IF ASC(Left$(char$,1))=27 and ok=0 then
? "ESC"
? len(char$)
? mid$(char$,2)
?
end if
end if
End if
End sub
'===============================================================================
' User Application Supporting Routines
'===============================================================================
SUB ShowStartScreen
CLS
BOX 0,0,MM.HRES, MM.VRES,,RGB(GREEN)
TEXT 50, 10, Progtitle$
TEXT 50, 30, "Software "+progver$
TEXT 50, 50, "Date "+progdate$
TEXT 50, 100, "Waiting Login Request!"
ShowLed(1,RGB(YELLOW))
ShowLed(2,RGB(YELLOW))
ShowLed(3,RGB(YELLOW))
ShowLed(4,RGB(YELLOW))
ShowLed(5,RGB(YELLOW))
END SUB
SUB ShowLed(i as integer, c as integer)
CIRCLE 40*i,205,13,1,1,c,c
END SUB
SUB ShowStatus(errorlevel as integer)
if tempin<>values(6) then
tempin=values(6)
text 10,10, "temp in="+str$(tempin)
endif
if tempout<>values(13) then
tempout=values(13)
text 10,30, "temp out="+str$(tempout)
endif
if iout<>values(8)*256+values(7)then
iout=values(8)*256+values(7)
text 10,50, "Current Out="+STR$(iout/10,2,1)
endif
if vout<>INT((values(10)*256+values(9))/10) then
vout=INT((values(10)*256+values(9))/10)
text 10,70, "Voltage Out="+STR$(vout/10,2,1)
endif
if vin<>values(12)*256+values(11) then
vin=values(12)*256+values(11)
text 10,90,"Voltage In="+str$(vin)
endif
if errorlevel=0 then
text 10,150,"NORMAL "
ENDIF
if errorlevel=1 then
text 10,150,"WARNING "
request_warnings=1
ENDIF
if errorlevel=2 then
text 10,150,"ERROR "
request_errors=1
END IF
if errorlevel=3 then
text 10,150,"WALK IN "
end if
end sub
'===============================================================================
' Timer functions
'===============================================================================
'Usage:
' After 10,1 ' 10 seconds using timer 1
' Every 1 ,2 ' count 1 second intervals using timer 2
' Every 2 ,3 ' count 2 second intervals using timer 3
'Variable Descriptions:
'TMRctr() maintains the count for a given timer
'TMRini()holds the timer type and its initialization value.
'- bits 0-61 store the initial value value
'- bits 63&62 store the format of the counter:
'0=disabled
'1=(actually 0x4000000000000000) indicates a one shot "AFTER x" type counter
'2=(actually 0x8000000000000000) indicates a repetitive "EVERY x" type counter
SUB CoreTMR ' needs to run on a ticker at whatever interval is required - this is also the multiple of timer counts
If FlagTest(10) Then Exit Sub
Local Integer n,f,v
For n=0 To 9
f=TMRini(n) And &hC000000000000000 ' extract the top 2 bits
Select Case f
Case 0,&hC000000000000000 'disabled or invalid
FlagRes(n)
Case &h4000000000000000' AFTER
If TMRctr(n)>0 then
TMRctr(n)=TMRctr(n)-1
If TMRctr(n)=0 Then FlagSet(n) ' indicate the timer has expired
EndIf
Case &h8000000000000000' EVERY
If TMRctr(n)>0 then
TMRctr(n)=TMRctr(n)-1
If TMRctr(n)=0 Then
FlagSet(n) ' indicate the timer has expired
TMRctr(n)=TMRini(n) And &h3FFFFFFFFFFFFFFF ' reset the timer
EndIf
EndIf
End Select
Next
END SUB
Sub After(Interval As Integer,Tmr As Integer)' starts a one-shot timer
TMRini(Tmr)=Interval OR &h4000000000000000:TMRctr(Tmr)=Interval And &h3FFFFFFFFFFFFFFF:FlagRes(Tmr)
End Sub
Sub Every(Interval As Integer,Tmr As Integer)' starts a repetitive timer
TMRini(Tmr)=Interval OR &h8000000000000000:TMRctr(Tmr)=Interval And &h3FFFFFFFFFFFFFFF:FlagRes(Tmr)
End Sub
'
Sub DI 'Disable interval interupts
FlagSet 10
End Sub
'
Sub EI 'Enable interval interupts
FlagRes 10
End Sub
'
'
'
'===============================================================================
' Bit manipulation functions
'===============================================================================
'Set a bit
SUB FlagSet(bit AS INTEGER)
FLAGS=FLAGS OR (2^bit)
END SUB
'Clear a bit
SUB FlagRes(bit AS INTEGER)
FLAGS=(FLAGS OR (2^bit)) XOR (2^bit)
END SUB
'Set bit equal to value passed
SUB FlagEq(bit As Integer,v as integer)
IF v=0 THEN
FlagRes(bit)
ELSE
FlagSet(bit)
ENDIF
END SUB
'Test if bit is set
FUNCTION FlagTest(bit AS INTEGER) AS INTEGER
FlagTest=ABS(SGN(FLAGS AND (2^bit)))
END FUNCTION
'===============================================================================
' Rotary Encoder and Button Support Routines
'===============================================================================
'ISR for Rotary Encoder
'Here when the Rotary encoder moves
SUB REInt()
IF PIN(DT)=0 THEN
'Clockwise rotation
Value=Value+1
ELSE
'Anti-Clockwise rotation
Value=Value-1
ENDIF
END SUB
'ISR for Push-Switch
'Here when Switch changes state
SUB SWInt()
'Clear the Displayed Value
DispValue=0
'And trigger a DisplayRefresh of DispValue
DisplayRefresh=1
END SUB
Sub ButtonTest
'STATIC integer laststate =1
'STATIC integer buttontimer
local integer buttontemp,b
btnUPctr=btnUPctr<<1 Xor Pin(SwPin) And &h01f ' sample the input pin and shift the bit into the counter
' If this loop is fast, increase the &h1f so we sample more bits... reduce it if the main loop is slower - tune it for your purposes
' If we shift enough zeroes in, the button has been pressed.
' Any bounce (back to 1) will shift a one in and "spoil" our counter for which will start again.
'If FlagTest(buttonchange)=0 Then
Select Case btnUPctr
Case 0 'button down
If FlagTest(buttondown)=0 Then
buttonstate=0
if laststate<>buttonstate then
FlagSet(buttondown)
laststate=buttonstate
buttontimer=timer
endif
endif
'After 2,buttonstart ' 20*100ms i.e 2 seconds
Case &h01f 'button up
b = TIMER - buttontimer ' this is how long the button was down
IF b < 700 THEN ' short press
buttontemp=1
else
buttontemp=2
endif
if laststate=0 then
FlagSet(buttonup)
buttonstate=buttontemp
laststate=buttonstate
endif
'After 2,buttonstart ' 20*100ms i.e 2 seconds
Case Else 'neither up nor down
'buttonstate=2
End Select
End sub