mmbasic:mmbasic_driver_for_mcp2515_can_adaptor
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.
An old but useful CAN primer
CAN Bus Bit Timing Calculator
Datasheet
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. See here for details.
* 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
Picomites
The I/O pins on the RP2350 (Pico 2) series of microcontrollers can withstand 5V (while powered up) so the module
can be directly connected to the 5V supplied by the VSYS pin on the Raspberry Pi Pico 2.
The RP2040 (Pico) must not be subjected to more than 3.6V so to use this module one of the above methods is required to use it on 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.1.0" '
' '
Dim ProgDate$ = "09-Aug-2025" '
'----------------------------------------------------------------------------'
'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
' 09/08/2025 Updated for Picomites Tidy up as a driver for MCP2525
' 19/08/2025 Added RxBuffer and cleanup iof many things.
'===============================================================================
' Option settings
'===============================================================================
option explicit
option default NONE
OPTION BASE 0
'OPTION AUTORUN ON
'===============================================================================
' MCP2515 SPI Routines
'===============================================================================
'Code for MMBASIC to communicate with a MCP2515 over SPI
'Original Author:
'Ported to MMBasic by Disco4now!, TBS forums
'*******************************************************************************
'===============================================================================
'Initialisation scanning of Console and serial ports if required (SETTICK)
'===============================================================================
Dim integer loc0last,loc0now,loc1last,loc1now,loc2last,loc2now,GetCon=0
settick 100,IsSerialOrConsoleComplete,1
'settick 300,IsSerialOrConsoleComplete,1 'need longer for VT100 ESC sequences
'===============================================================================
' 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.
'=============================================================================
' Program Initialization and variables
'=============================================================================
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
Print "Starting " + ProgTitle$ + ": " + ProgVer$ + " - " + ProgDate$
'=============================================================================
' 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 SPI and MCP2515 CS Pin
'===============================================================================
'THE MCP2515 module needs to be mofified for 3,3V
DIM INTEGER CAN_CS ,SPI_NUMBER
' Set the CAN CS pin The SPI Pins and The SPI_NUMBER
'Set SPI_NUMBER
SPI_NUMBER=2
'Set CS Pin for MCP2515 module
CAN_CS=MM.INFO(PINNO GP22) 'MCP2515 chip select GP22
PIN(CAN_CS)=1
SETPIN CAN_CS,DOUT ' set as DOUT
' Set the SPI Pins
'SETPIN rx, tx, clk, SPI2
IF SPI_NUMBER=1 THEN
SETPIN GPrx, GPtx, GPclk, SPI
ELSE
SETPIN GP28, GP27, GP26, SPI2
END IF
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'===============================================================================
' --- Global Variables used by the Driver----
' These should not be manipulated directly.
' They as set by the high level functions
'===============================================================================
DIM INTEGER NOFILTERS = 0 'Accept Filters Status
DIM INTEGER HASROLLOVER = 0 'Rollover Status
DIM INTEGER CANMODE=0 'CAN Mode
DIM INTEGER EchoAllMsg=0 '
DIM integer rts(2)=(&H81,&H82,&H84),tbn=0
dim integer values(14),req(3),sets(7)
DIM INTEGER id,eid,rtr,dlc,msg,fmi,ret
'==============================================================================
' Configure SPIOpen ans SPIClose SUBs to the desired SPI
' and settings for the specific MMBASIC platform.
'==============================================================================
dim integer SPISPEED=10000000 'SPI 10MHz
'Open the SPI
IF SPI_NUMBER=1 THEN
SPI1 OPEN SPISPEED,0,8
ELSE
SPI2 OPEN SPISPEED,0,8
END IF
SUB SPIOpen
PIN(CAN_CS)=0
END SUB
SUB SPIClose
PIN(CAN_CS)=1
END SUB
'===============================================================================
' Setup MMBasic FIFO Transmit and Receive Buffers
'===============================================================================
'MCP2515 Hardware has only 3 TxBuffers. We can use a queue inside MMBasic to
'ensure we can control the transmissions so as not to overflow the CAN module.
'TxFifoSize sets the size of the buffer. Set to 0 to disable use of the buffer.
DIM INTEGER TxFifoSize=30 'Number of elements in the FiFo Buffer
'MCP2515 Harware has two FIFO Mailboxes. We can use a queue inside MMBasic to
'ensure these are read immediately so thet don't overflow, and process the
'messages from the internal queue.
'RxFifoSize sets the size of the buffer. Set to 0 to disable use of the buffer.
DIM INTEGER RxFifoSize=30 'Number of elements in the FiFo Buffer
'The TX and Rx Buffers are serviced alternately in the main DO:LOOP. The
'Buffer Service Threshold is used to regulate the frequency at which they are
'serviced. BSThreshold is set to 20 by default. i.e. service once every 20 loops.
DIM INTEGER BSThreshold=20
' Supporting variables.
DIM INTEGER BSCount,BSToggle
DIM INTEGER TXBuffer(TxFifoSize+1,1)'Buffer is 128 bits wide (2 integers)
DIM INTEGER TxFifoStart,TxFifoEnd
DIM INTEGER RXBuffer(RxFifoSize+1,1)'Buffer is 128 bits wide (2 integers )
DIM INTEGER RxFifoStart,RxFifoEnd
'===============================================================================
' Initialse and start the MCP2515 CAN Module
'===============================================================================
CONST Normal=0,Loopback=1 ,EchoAll=2
CONST Acceptall=1,UseFilters=0
CONST UseRollover=1,NoRollOver=0
can_init(LoopBack ,125000,UseFilters,UseRollover) 'initialise module
'can_init(LoopBack ,125000,Acceptall,UseRollover) 'initialise module
can_SetFilters
can_Start
'==========================================================================
' Setup the Console
'==========================================================================
OPTION DISPLAY 50,81
vtClr 'clear screen
vtBox(1,1,80,12,1) 'draw a box in "Terminal" font box chars
PRINT At(4,3)+vt100.colour$("RED")+"F8 - Send 1"+vt100.colour$("reset");
PRINT At(5,3)+vt100.colour$("RED")+"F9 read 1 RBX0"+vt100.colour$("reset");
PRINT At(6,3)+vt100.colour$("RED")+"F10 read 1 RBX1"+vt100.colour$("reset");
vtWindow 15,19 ' define window
showheader
vtWindow 19,40 ' define window
'===========================================================================
'print hex$(mcp_readReg(&H0F),2)
'print "initialised"
'===============================================================================
' CAN High Level Functional Routines
'===============================================================================
SUB can_init(cmode as integer,canspeed as integer,filters as integer,rollover as integer)
'SUB mcp_init(mode as integer,CANSPEED as integer,filters as integer,ROLLOVER as integer)
can_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
CANMODE=cmode
NoFilters=filters
HasRollover=rollover
'**** If CANMODE=2 the all received messages will be sent back***********
If CANMODE=2 then
EchoAllMsg = 1 'echo all received messages
else
EchoAllMsg = 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 )
' 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)'
' If ECHO mode then don't use filters.
if EchoAllMsg=0 THEN
setRecBufferCTRLS(NoFilters,HasRollover)
else
' Override any setting and accept all messages
' with rollover from RBX0 to RBX1
setRecBufferCTRLS(AcceptAll,UseRollover)
endif
END SUB
' ===== Setup the acceptance masks for RBX0 and RBx1 as required ============
' These determine which messages are forward to the Acceptance Filters
' The message is rejected if it does not pass one of the Accptance Masks
' If eid=0 then datamask can be used to filter on Byte(0)+Byte(1) of the data.
' ============================================================================
SUB can_SetFilters
IF NOFILTERS then exit SUB
' setAcceptMask(rbxno,eid ,idmask,datamask )
setAcceptMask(0, 1,&H1FFFFFFF,&H0) 'Uncomment to forward all STDIDs
'setAcceptMask(1, 1,&H1FFFFFFF,&H0) 'Uncomment to forward all EXTIDs
setAcceptMask(0, 1,&H1FFFFFFF,&H0) 'Uncomment to forward all EXTIDs
'--Some examples --------
'setAcceptMask(0, 1,&H2222222,0); 'Forwards ID &H2222222
'setFilterMask(1, 0, &H7FF,&HAA55) 'Forwards all STDIDs matchhing mask AA55
' ===== Setup acceptance Filters for RBX0 and RBX1 as required ==============
' If ROLLOVER is enabled then RFX6 and RFX7 indicate a message originally
' destined for RFX0 or RFX1 but been redirected to because RBX0 or RBX1 contains
' a message that has not been read yet. If ROLLOVER is nor enabled the messages
' are discarded.
setFilter(0, 1, &H0123456,0) 'RFX0 RFX6
setFilter(1, 1, &H0123457,0) 'RFX1 RFX7
setFilter(2, 0, &H7FF,0) 'RFX2
setFilter(3, 1, &H5555555,&H0) 'RFX3
setFilter(4, 1, &H2222222,&H0) 'RFX4
setFilter(5, 0, &H7FF,&H0) 'RBX5
showFilters()
END SUB
SUB can_Start
'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,&H40)'loopback mode - oneshot is disabled.
else
mcp_modReg(&H0F,&HE0,&H0) 'Normal mode - oneshot is disabled.
END IF
pause 20
end sub
Sub SHOWHEADER
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 "- -------- - - - ---------------------- -------------------"
end sub
'===========================================================================
' ********************* 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
'========== Alternately Process Tx and Rx Queues ==========================
BSCount=BSCount+1
IF BSCount=BSThreshold Then
BSCount=0
if BSToggle=0 Then
if TxFifoSize > 0 THEN sendSingleMessage 'from the TxBuffer
BSToggle=1
ELSE
if RxFifoSize > 0 THEN actionSingleMessage(-1) 'from the RxBuffer
BSToggle=0
END IF
ENDIF
'======================Poll for Messages =========================
if RxFifoSize = 0 THEN
'method 1 Read one message from each RX Fifo and action immediately
CAN_READ 0
If ret>0 Then actionSingleMessage(0)
CAN_READ 1
If ret>0 THEN actionSingleMessage(1)
else
'Method 2 Read all messages in each RX Fifo and add to queue
'Read Fifo0
DO
CAN_READ 0
If ret>0 Then addRxMessage(0)
LOOP UNTIL ret=0
'Read Fifo1
DO
CAN_READ 1
If ret>0 THEN addRxMessage(1)
LOOP UNTIL ret=0
END IF
'===============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=====================
Loop
'=========================================================================
' ****************** -- END of Main program loop-- **********************
'==========================================================================
'===============================================================================
' CAN High Level Functional Routines actionmsg,
'===============================================================================
SUB CAN_READ rxno as integer
'Global variables are:id,eid,rtr%dlc,msg,fmi,ret
if rxno=0 then
if mcp_readReg(&H2c) AND &H01 then 'test CANINTF B(0)
mcp_readRegs(&H60,values() ,14) 'read the values from the can
fmi=mcp_readReg(&H60) AND &H07 'read Filter match Index
LoadValues
mcp_modReg(&H2c,&H01,&H00) 'clear CANINTF B(0)
ret=1
else
ret=0
EXIT SUB
end if
else 'rxno=1
if mcp_readReg(&H2c) AND &H02 then 'test CANINTF B(1)
mcp_readRegs(&H70,values() ,14) 'read the values from the can
fmi=mcp_readReg(&H70) AND &H07 'read Filter match Index
LoadValues
mcp_modReg(&H2c,&H02,&H00) 'clear CANINTF B(1)
ret=1
else
ret=0
EXIT SUB
end if
endif
end sub
SUB LoadValues
'Load the register data in to our global variables
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)
id=id 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
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
end sub
' Process and action a received CAN message.
' This routine can be called directly when the message is read
' or later to proccess a message from the MMBasic RXBuffer
' if one is being used.
SUB ActionSingleMessage(rxno as integer)
Local INTEGER fminitial(7)=(0,1,2,3,4,5,0,1)
Local INTEGER fmoverflow(7)=(6,7,2,3,4,5,0,1)
Local amsg$
'If we are using an RxBuffer then get the values
IF RxFifoSize>0 and rxno<0 then
IF RxFifoEnd<>RxFifoStart Then
RxFifoStart=RxFifoStart + 1:If RxFifoStart=RxFifoSize then RxFifoStart=0
msg=RXBuffer(RxFifoStart,1)
id=RXBuffer(RxFifoStart,0) AND &H1FFFFFFF
eid=RXBuffer(RxFifoStart,0)>>63 AND &H1
rtr=RXBuffer(RxFifoStart,0)>>62 AND &H1
rxno=RXBuffer(RxFifoStart,0)>>61 AND &H1
dlc=RxBuffer(RxFifoStart,0)>>57 AND &H0F
ret=RXBuffer(RxFifoStart,0)>>53 AND &H3 'number in queue
else
exit sub
endif
endif
'Resolve the matched filter
if NOFILTERS then
fmi=-1
ELSE
if HASROLLOVER and rxno=1 then
fmi=fmoverflow(fmi)
else
fmi=fminitial(fmi)
endif
ENDIF
'Process the id and msg contents
select case id
CASE &H05014400 'Login request
print "login request Eltek"
'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
amsg$= "Got Voltage="+ str$(BIN32ToFloat((msg AND &HFFFFFFFF00000000)>>32))
amsg$=amsg$+ " Got Current="+str$(BIN32ToFloat((msg AND &HFFFFFFFF) ))
LogAction(amsg$)
CASE ELSE
'PRINT
end select
Print STR$(rxno)+" "+SPACE$(5-eid*5)+HEX$(id,3+eid*5)+" "+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 EchoAllMsg THEN
addTxMessage( id,eid,rtr,dlc,msg)
END IF
END SUB
SUB addRxMessage(rxno as integer)
Local INTEGER i
if RxFifoSize>0 then
RxFifoEnd=RxFifoEnd + 1 : If RxFifoEnd=RxFifoSize then RxFifoEnd=0
i=id OR (eid<<63)OR(rtr<<62)OR(rxno<<61)or((dlc AND &H0F)<<57)OR(ret aND &H0F<<53)
RXBuffer(RxFifoEnd,0)=i
RXBuffer(RxFifoEnd,1)=msg
else
Print "addRxMessage() called but RxFifoSize is 0"
END
END IF
end sub
'Add a message to the TXFifo if it is used, else send directly
SUB addTxMessage(id as Integer,eid as integer,rtr as integer,dlc as integer,msg as integer)
if TxFifoSize>0 then
TxFifoEnd=TxFifoEnd + 1 : If TxFifoEnd=TxFifoSize then TxFifoEnd=0
TXBuffer(TxFifoEnd,0)=id OR (eid << 63)OR(rtr << 62)or((dlc AND &H0F) << 55)
TXBuffer(TxFifoEnd,1)=msg
else
CAN_SEND id,eid,rtr,dlc,msg
end if
end sub
SUB sendSingleMessage()
IF TxFifoEnd<>TxFifoStart Then
TxFifoStart=TxFifoStart + 1:If TxFifoStart=TxFifoSize then TxFifoStart=0
msg=TXBuffer(TxFifoStart,1)
id=TXBuffer(TxFifoStart,0) AND &H1FFFFFFF
eid=TXBuffer(TxFifoStart,0)>>63 AND &H1
rtr=TXBuffer(TxFifoStart,0)>>62 AND &H1
dlc=TXBuffer(TxFifoStart,0)>>55 AND &H0F
CAN_SEND id,eid,rtr,dlc,msg
endif
end sub
SUB CAN_SEND(id as integer,eid as integer,rtr as integer,dlc as integer,msg 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)=msg >> (56-i*8) AND &HFF
next i
endif
'Use the 3 TxBuffers in rotation
mcp_setRegs(8+i,buff()) 'load the Txmailbox
mcp_send(tbn) 'send on next Txmailbox
tbn=tbn+1:if tbn=3 then tbn=0 'advance Txmailbox pointer
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 ctr1%=((IgnoreFilters AND &H1) << 6)OR((IgnoreFilters AND &H1)<< 5)OR((rollover AND &H1) << 2)
local ctr2%=((IgnoreFilters AND &H1) << 6)OR((IgnoreFilters AND &H1)<< 5)
mcp_modReg(&H60,&H64,ctr1%)
mcp_modReg(&H70,&H60,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
IF SPI_NUMBER=1 THEN
SPI WRITE 3,&H02,reg,dat
ELSE
SPI2 WRITE 3,&H02,reg,dat
END IF
SPICLOSE
end sub
SUB mcp_setRegs(n as integer,dat() as integer)
SPIOPEN 'speed,0,8
IF SPI_NUMBER=1 THEN SPI WRITE n,dat() ELSE SPI2 WRITE n,dat()
SPICLOSE
end sub
SUB mcp_modReg(reg as integer,mask as integer,dat as integer)
SPIOPEN 'speed,0,8
IF SPI_NUMBER=1 THEN
SPI WRITE 4,&H05,reg,mask,dat 'MCP_BITMOD=&H05
else
SPI2 WRITE 4,&H05,reg,mask,dat
ENDIF
SPICLOSE
end sub
FUNCTION mcp_readReg(reg as integer) as integer
SPIOPEN 'speed,0,8
IF SPI_NUMBER=1 THEN
SPI WRITE 2,&H03,reg
mcp_readReg=SPI(0)
else
SPI2 WRITE 2,&H03,reg
mcp_readReg=SPI2(0)
endif
SPICLOSE
END FUNCTION
FUNCTION mcp_readStatus() as integer
SPIOPEN 'speed,0,8
IF SPI_NUMBER=1 THEN
SPI WRITE 1,&HA0
mcp_readStatus=SPI(0)
else
SPI2 WRITE 1,&HA0
mcp_readStatus=SPI2(0)
end if
SPICLOSE
END FUNCTION
FUNCTION mcp_readStatusRX() as integer
SPIOPEN 'speed,0,8
IF SPI_NUMBER=1 THEN
SPI WRITE 1,&HB0
mcp_readStatusRX=SPI(0)
else
SPI2 WRITE 1,&HB0
mcp_readStatusRX=SPI2(0)
end if
SPICLOSE
END FUNCTION
SUB mcp_readRegs(reg as integer,values() as INTEGER,n as integer)
SPIOPEN 'speed,0,8
IF SPI_NUMBER=1 THEN
SPI WRITE 2,&H03,reg
SPI READ n,values()
else
SPI2 WRITE 2,&H03,reg
SPI2 READ n,values()
end if
SPICLOSE
END SUB
SUB mcp_readRxBuff(reg as integer,values() as INTEGER,n as integer)
SPIOPEN 'speed,0,8
IF SPI_NUMBER=1 THEN
SPI WRITE 2,&H03,reg
SPI READ n,values()
else
SPI2 WRITE 2,&H03,reg
SPI2 READ n,values()
END IF
SPICLOSE
END SUB
SUB mcp_send(n as integer)
'Set Request to Send for desired TX Buffer
SPIOPEN 'speed,0,8
IF SPI_NUMBER=1 THEN SPI WRITE 1,rts(n) else SPI2 WRITE 1,rts(n)
'ret=SPI(&HC0)
SPICLOSE
end SUB
SUB can_reset()
'open the SPI at 10KHz
SPIOPEN 'speed,0,8
IF SPI_NUMBER=1 THEN SPI WRITE 1,&HC0 ELSE SPI2 WRITE 1,&HC0
SPICLOSE
end SUB
'===============================================================================
' Utility functions to convert between Float and and binary BIN32
'===============================================================================
'---------------------------------------------------------------------------------
'This function takes a float (single or double precision depending on the platform)
'and returns an integer where the last 32 bits contain binary formatted as for a
'32 bit float.(This could then be sent to a device that expects single precision).
'---------------------------------------------------------------------------------
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
if i<>0 then
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
else
j=0
endif
FloatToBIN32=j
endif
End Function
'---------------------------------------------------------------------------------
'This function takes an integer where the last 32 bits contain binary formatted as
'for a 32 bit float.(This could be from a device that works in single precision).
'It returns a float (single or double precision to match the current platform)
'---------------------------------------------------------------------------------
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
if (w% XOR &H0000000000000000) then
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
else
j=0
endif
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
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)
char$=inkey$
if char$<>"" then
IF char$=" " THEN
'? "-----SPACE BAR--------"
'? "**************************"
'CAN SEND id,eid,dlc,msg,ret
msg%=&H1213141516171820
'eid%=1:dlc%=8
LogAction("11 Messages Sent")
addTxMessage(&H111,0,0,8,msg%)
addTxMessage(&H222,0,0,8,msg%)
addTxMessage(&H234,0,0,8,msg%)
addTxMessage(&H555,0,0,8,msg%)
addTxMessage(&H525,0,1,8,&HFFFFFFFFFFFFFFFF)
addTxMessage(&H1111111,1,0,8,&H1113141516171800)
addTxMessage(&H2222222,1,0,8,&H1213141516171820)
addTxMessage(&H3333333,1,0,8,&H1F03141516171820)
addTxMessage(&H4444444,1,0,8,&H1413141516171800)
addTxMessage(&H123457,1,0,8,&H1613141516171820)
addTxMessage(&H123456,1,0,4,&H1513141516171820)
'addMessage (&H123456,1,0,4,&H1513141516171820)
'addMessage (&H123457,1,0,4,&H1513141516171820)
'addMessage (&H123456,1,0,4,&H1513141516171820)
'addMessage (&H123457,1,0,4,&H1513141516171820)
'addMessage (&H123456,1,0,4,&H1513141516171820)
'addMessage (&H123457,1,0,4,&H1513141516171820)
'sendMsg (&H123456,1,0,4,&H1513141516171820)
'sendMsg (&H123457,1,0,4,&H1513141516171820)
'sendMsg (&H123456,1,0,4,&H1513141516171820)
'sendMsg (&H123457,1,0,4,&H1513141516171820)
'sendMsg (&H123456,1,0,4,&H1513141516171820)
'sendMsg (&H123457,1,0,4,&H1513141516171820)
end if
IF Char$="0" then
'id=0
' addMessage( 0,id,1,8,login())
endif
IF Char$="1" then
'login invitation
id=&H1FFFFFFF
'id=&H06000783
'mcp_sendMsg( 2,id,1,8,reqone())
addTxMessage( id,1,0,8,&H12345678abcdef11)
addTxMessage( id,1,0,8,&Habcdef11abcdef22)
addTxMessage( id,1,0,8,&Habcdef22abcdef22)
'mcp_sendMsg( 0,id,1,8,login())
print "add msg ",hex$(id)
endif
IF Char$="2" then
'login
id=&H1FFFFFFE
addTxMessage( id,1,0,8,&H1122334455667788)
print "mcp msg send",hex$(id)
endif
IF Char$="3" then
'login
id=&H7FFF
addTxMessage( id,1,0,8,&H1122334455667788)
print "mcp msg send",hex$(id)
endif
IF Char$="4" then
id=&H5555555
msg%=(FloatToBIN32(58.5)<<32 AND &HFFFFFFFF00000000) OR (FloatToBIN32(19.5) AND &HFFFFFFFF)
addTxMessage( id,1,0,8,msg%)
LogAction( "Sent voltage=58.5 Sent Current=19.5" )
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)
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)
end if
''EMERSON R48-2900U
'IF Char$="6" then
'
'id=&H0607FF83
'addMessage( id,1,0,8,readall)
'end if
IF Char$="7" then
'id=&H0607FF83
'? "Fan Auto"
'addMessage( id,1,0,8,req1)
end if
IF Char$="8" then
id=&H0607FF83
? "fan full"
addTxMessage( id,1,0,8,req2)
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
addTxMessage( id,1,0,8,reqone)
case 2
? "Read one"
id=&H06000783
'reqone(3)=2
addTxMessage( id,1,0,8,reqone)
case 3
? "Read one"
id=&H06000783
r'eqone(3)=3
addTxMessage( id,1,0,8,reqone)
case 4
? "Read one"
id=&H06000783
'reqone(3)=4
addTxMessage( id,1,0,8,reqone)
case 5
? "Read one"
id=&H06000783
reqone(3)=5
addTxMessage( id,1,0,8,reqone)
case 6
? "Read one"
id=&H06000783
reqone(3)=6
addTxMessage( id,1,0,8,reqone)
case 7
? "Read one"
id=&H06000783
reqone(3)=7
addTxMessage( 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
*/
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"
'vtsc
'vtWindow 13,17 ' define window
'vtClrArea
'PRINT At(17,1)+vt100.colour$("YELLOW")+"DEVICE1"+vt100.colour$("reset")
'PRINT vt100.colour$("YELLOW")+"DEVICE2"+vt100.colour$("reset")
'PRINT vt100.colour$("YELLOW")+"DEVICE3"+vt100.colour$("reset")
'PRINT vt100.colour$("YELLOW")+"DEVICE4"+vt100.colour$("reset")
'PRINT vt100.colour$("YELLOW")+"DEVICE5"+vt100.colour$("reset")
'vtWindow 19,40 ' define window
'vtrc
LogAction("F1 Pressed")
endif
if char$=chr$(146) or mid$(char$,2)="[12~" then 'F2 VT100
'print "F2"
LogAction("F2 Pressed"+time$)
end if
if char$=chr$(147) or mid$(char$,2)="[13~" then 'F3 VT100
print "F3"
end if
if char$=chr$(148) or mid$(char$,2)="[14~" then 'F4 VT100
? "F4"
end if
if char$=chr$(149) or mid$(char$,2)="[15~" then 'F5 VT100
? "F5"
end if
if char$=chr$(150) or mid$(char$,2)="[17~" then 'F6 VT100
? "F6"
end if
if char$=chr$(151) or mid$(char$,2)="[18~" then 'F7 VT100
? "F7"
end if
if char$=chr$(152) or mid$(char$,2)="[19~" then 'F8 VT100
LogAction("Single Messages Sent &H123456")
CAN_SEND(&H123456,1,0,8,&H1413141516171800)
end if
if char$=chr$(153) or mid$(char$,2)="[20~" then 'F9 VT100
LogAction("Single Messages Read RBX0")
'Check for Message in RX0
CAN_READ 0
if ret>0 then
actionmsg 0
else
LogAction("No Messages in RBX0")
endif
end if
if char$=chr$(154) or mid$(char$,2)="[21~" then 'F10 VT100
LogAction("Single Messages Read RBX1")
'Check for Message in RX1
CAN_READ 1
if ret>0 then
actionmsg 1
else
LogAction("No Messages in RBX1")
endif
end if
if char$=chr$(155) or mid$(char$,2)="[23~" then 'F11 VT100
print "F11"
end if
if char$=chr$(156) or mid$(char$,2)="[24~" then 'F12 VT100
print "F12"
end if
if char$=chr$(127) or mid$(char$,2)="[3~" then 'del
text 10,200, "SLOW"
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)
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)
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)
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)
end if
if char$=chr$(132) or mid$(char$,2)="[2~" then 'INS
walkfast=1
text 10,200, "FAST"
end if
if char$=chr$(133) then
print "133"
end if
if char$=chr$(134) or mid$(char$,2)="[1~" then 'home
adjvoltage=0
text 10,220, "adj="+str$(adjvoltage)+" "
end if
if char$=chr$(135) or mid$(char$,2)="[4~" then 'end
print reqcurrent10x,reqvoltage100x +adjvoltage,reqvoltage100x
sendconfig=1
end if
if char$=chr$(136) or mid$(char$,2)="[5~" then 'PgUp VT100
adjvoltage=100
text 10,220, "adj="+str$(adjvoltage)+" "
end if
if char$=chr$(137) or mid$(char$,2)="[6~" then 'Pgdn VT100
adjvoltage=-100
text 10,220, "adj="+str$(adjvoltage)+" "
end if
if char$=chr$(138) then
print "138"
end if
if char$=chr$(139) then
print "ALT"
end if
if char$=chr$(140) then
print "140"
end if
end if
End if
End sub
'===============================================================================
' User Application Supporting Routines
'===============================================================================
SUB LogAction(update1$)
vtsc
vtWindow 11,14 ' define window
PRINT At(14,1)+vt100.colour$("YELLOW")+update1$+vt100.colour$("reset")
vtWindow 19,40 ' define window
vtrc
END SUB
Function At(v As Integer,h As Integer) As String
At=Chr$(27)+"["+Str$(v)+";"+Str$(h)+"H"
End Function
Sub vtClr
'Window 1,25' redefine the whole screen
Print Chr$(27);"[2J";
End Sub
Sub vtsc 'save current cursor position
Print Chr$(27);"7";
End Sub
Sub vtrc 'restore cursor position saved with Vsc
Print Chr$(27);"8";
End SUB
Sub vtreset 'reset terminal
Print Chr$(27)+"c";
End Sub
Sub vtWindow(Pt As Integer, Pb As Integer)
'defines a window from line Pt to line Pb and positions the cursor in the start of it
'Clr and At still work on the whole screen. Only when scrolling (or CRLF) enteres the
'window does it capture the cursor. Note 0<Pt<Pb is enforced by the console emulator
Print Chr$(27)+"["+Str$(Pt)+";"+Str$(Pb)+"r"+At(Pt,1);
End Sub
'draw a box in "Terminal" font box chars
Sub vtBox(row as integer,col as integer ,w as integer,h as integer,t as integer)
local integer i
If t=0 Then
Print At( row,col);Chr$(218);String$(w-2,196);Chr$(191);
'Vat row+h,col
Print At(row+h,col);Chr$(192);String$(w-2,196);Chr$(217);
For i=1 To h-1
Print At(row+i,col)+Chr$(179);
PRINT At(row+i,col+w-1)+Chr$(179);
Next
Else
PRINT At( row,col)Chr$(201)+String$(w-2,205)+Chr$(187);
' Vat row+h,col
Print At(row+h,col)+Chr$(200);String$(w-2,205)+Chr$(188);
For i=1 To h-1
Print At(row+i,col)+Chr$(186);
PRINT At(row+i,col+w-1)+Chr$(186);
Next
End If
End Sub
'Erase rectangular area.
'Ps1 Top-line border.
'Ps2 Left-column border.
'Ps3 Bottom-line border.
'Ps4 Right-column border.
SUB vtClrArea
Print Chr$(27)+"[>3;13;1;17;80J"
End sub
Function vt100$(s$)
vt100$ = Chr$(27) + "[" + s$
End Function
Function vt100.colour$(c$)
Select Case LCase$(c$)
Case "black" : vt100.colour$ = vt100$("30m")
Case "red" : vt100.colour$ = vt100$("31m")
Case "green" : vt100.colour$ = vt100$("32m")
Case "yellow" : vt100.colour$ = vt100$("33m")
Case "blue" : vt100.colour$ = vt100$("34m")
Case "magenta", "purple" : vt100.colour$ = vt100$("35m")
Case "cyan" : vt100.colour$ = vt100$("36m")
Case "white" : vt100.colour$ = vt100$("37m")
Case "reset" : vt100.colour$ = vt100$("0m")
Case Else : Error "Unknown VT100 colour: " + c$
End Select
End Function
mmbasic/mmbasic_driver_for_mcp2515_can_adaptor.txt · Last modified: by Gerry