propeller terminal code

This commit is contained in:
jth0mass0n 2017-04-17 10:21:28 -07:00
parent b290497d95
commit 45fec70be2
11 changed files with 2972 additions and 0 deletions

Binary file not shown.

View File

@ -0,0 +1,680 @@
''''''''''''''''''''''''''''''
'' 6502 Terminal Program ''
'' Author: Jon Thomasson ''
'' 2016 The Reset Vector ''
'' ''
''''''''''''''''''''''''''''''
''
'' Current VT-100 Code list
''
'' ESC[m Turn off character attributes
'' ESC[0m Turn off character attributes
'' ESC[1m Turn bold character on (reverse)
'' ESC[7m Turn reverse video on
'' ESC[nA Move cursor up n lines
'' ESC[nB Move cursor down n lines
'' ESC[nC Move cursor right n lines
'' ESC[nD Move cursor left n lines
'' ESC[H Move cursor to upper left corner
'' ESC[;H Move cursor to upper left corner
'' ESC[line;columnH Move cursor to screen location v,h
'' ESC[f Move cursor to upper left corner
'' ESC[;f Move cursor to upper left corner
'' ESC[line;columnf Move cursor to sceen location v,h
'' ESCD Move/scroll window up one line
'' ESC[D Move/scroll window up one line
'' ESCL Move/scroll window up one line (undocumented)
'' ESC[L Move/scroll window up one line (undocumented)
'' ESCM Move/scroll window down one line
'' ESCK Clear line from right
'' ESC[0K Clear line from right
'' ESC[1K Clear line from left
'' ESC[2K Clear entire line
'' ESC[J Clear screen from down
'' ESC[0J Clear screen from down
'' ESC[1J Clear screen from up
'' ESC[2J Clear entire screen
'' ESC[0c Terminal ID responds with [?1;0c for VT-100 no options
'' ESC[c Terminal ID responds with [?1;0c for VT-100 no options
'' Esc[value@ Insert one character
'' Esc[valueP Delete one character
''
'' List of ignored codes
''
'' ESC[xxh All of the ESC[20h thru ESC[?9h commands
'' ESC[xxl All of the ESC[20i thru ESC[?9i commands
'' ESC= Alternate keypad mode
'' ESC< Enter/Exit ANSI mode
'' ESC> Exit Alternate keypad mode
'' Esc5n Device status report DSR
'' Esc0n Response: terminal is OK DSR
'' Esc3n Response: terminal is not OK DSR
'' Esc6n Get position DSR
'' EscLine;ColumnR Response: is at v,h CPR
'' Esc#8 Screen alignment display DECALN
'' Esc[2;1y Confidence power up test DECTST
'' Esc[2;2y Confidence loopback test DECTST
'' Esc[2;9y Repeat power up test DECTST
'' Esc[2;10y Repeat loopback test DECTST
'' Esc[0q Turn off all four leds DECLL0
'' Esc[1q Turn on LED #1 DECLL1
'' Esc[2q Turn on LED #2 DECLL2
'' Esc[3q Turn on LED #3 DECLL3
'' Esc[4q Turn on LED #4 DECLL4
CON
_clkmode = xtal1 + pll16x
_xinfreq = 5_000_000
Cursor = 95
VideoCls = 0
NUM = %100
CAPS = %010
SCROLL = %001
RepeatRate = 40
video = 16
backspace = $C8
RESET = 5 'pin used to reset 6502
RESET_PERIOD = 20_000_000 '1/2 second
' VT-100 values
'' Terminal Colors
TURQUOISE = $29
BLUE = $27
BABYBLUE = $95
RED = $C1
GREEN = $99
GOLDBROWN = $A2
AMBERDARK = $E2
LAVENDER = $A5
WHITE = $FF
HOTPINK = $C9
GOLD = $D9
PINK = $C5
r1 = 31 'PC serial port receive line
t1 = 30 'PC serial port transmit line
r2 = 25 'Host device receive line
t2 = 24 'Host device transmit line
EEPROMAddr = %1010_0000
EEPROM_Base = $7FE0
i2cSCL = 28
'' Sound Variables
right = 10
left = 11
OBJ
text: "VGA_1024v.905" ' VGA Terminal Driver
kb: "keyboard" ' Keyboard driver
ser: "FullDuplexSerial256" ' Full Duplex Serial Controller
ser2: "FullDuplexSerial2562" ' 2nd Full Duplex Serial Controller
i2c: "basic_i2c_driver"
VAR
word key
Byte Index
Byte Rx
Byte rxbyte
' Long Stack[100]
Byte temp
Byte serdata
Long Baud
Byte termcolor
Long BR[8]
Long CLR[11]
long i2cAddress, i2cSlaveCounter
Byte pcport
Byte ascii
Byte curset
word eepromLocation
Byte CR
Byte LNM
PUB main | i,j,k,remote,remote2,record,vt100,byte2,byte3,byte1,byte4,byte5,byte6,byte7,loop,var1,col,row,temp2,tempbaud,source
CTRA:= %00110 << 26 + 0<<9 + right
CTRB:= %00110 << 26 + 0<<9 + left
DIRA[right]~~ 'Set Right Pin to output
DIRA[left]~~ 'Set Left Pin to output
source:=@PIANO
LNM := 0 'CR only sent
i2c.Initialize(i2cSCL)
tempbaud:=5
CR := 0 '0= OFF 1 = CR AND LF
ascii := 0 '0=no 1=yes
pcport := 1 '1=pc port off, 2=on
termcolor:=5
curset := 5
BR[0]:=300
BR[1]:=1200
BR[2]:=2400
BR[3]:=4800
BR[4]:=9600
BR[5]:=19200
BR[6]:=38400
BR[7]:=57600
BR[8]:=115200
CLR[1]:=TURQUOISE
CLR[2]:=BLUE
CLR[3]:=BABYBLUE
CLR[4]:=RED
CLR[5]:=GREEN
CLR[6]:=GOLDBROWN
CLR[7]:=WHITE
CLR[8]:=HOTPINK
CLR[9]:=GOLD
CLR[10]:=PINK
CLR[11]:=AMBERDARK
'' Determine if previous settings are stored in EEPROM, if so, retrive for user
eepromLocation := EEPROM_Base 'Point i2c to EEPROM storage
temp2 := i2c.ReadByte(i2cSCL, EEPROMAddr, eepromLocation) 'read test byte to see if data stored
if temp2 == 55 'we have previously recorded settings, so restore them
eepromLocation +=4 'increase to next location
tempbaud := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read Baud as temp
eepromLocation +=4
termcolor := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read terminal color
eepromLocation +=4
pcport := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read pcport on/off setting
eepromLocation +=4
ascii := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read force 7bit setting
eepromLocation +=4
curset := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read type
eepromLocation +=4
CR := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read CR W/LF ON/OFF
waitcnt(clkfreq/200 + cnt)
Baud:=BR[tempbaud]
text.start(video)
text.color(CLR[termcolor])
kb.startx(26, 27, NUM, RepeatRate) 'Start Keyboard Driver
ser.start(r1,t1,0,baud) 'Start Port2 to PC
ser2.start(r2,t2,0,baud) 'Start Port1 to main device
Baud:=tempbaud
text.cls(Baud,termcolor,pcport,ascii,CR)
' text.clsupdate(Baud,termcolor,pcport,ascii,CR)
text.inv(0)
text.cursorset(curset)
vt100:=0
' send reset to 6502
outa[RESET] := 0
dira[RESET] := 1 'set reset pin as output
waitcnt(RESET_PERIOD + cnt)
outa[RESET] := 1
dira[RESET] := 1
waitcnt(RESET_PERIOD + cnt)
dira[RESET] := 0 'set reset pin as input (this makes it so the pin isn't held low forever)
repeat
key := kb.key 'Go get keystroke, then return here
if key == 194 'up arrow
ser2.str(string(27,"[A"))
if key == 195 'down arrow
ser2.str(string(27,"[B"))
'ser2.out($0A)
if key == 193 'right arrow
ser2.str(string(27,"[C"))
if key == 192 'left arrow
ser2.str(string(27,"[D"))
if key >576
if key <603
key:=key-576
if key > 608 and key < 635 'Is it a control character?
key:=key-608
'if key >0
' text.dec(key)
if key == 200
key:=08
if key == 203 'Is it upper code for ESC key?
key:= 27 'Yes, convert to standard ASCII value
if key == 720
Baud++ 'is ESC then + then increase baud or roll over
if Baud > 8
Baud:=0
temp:=Baud
Baud:=BR[temp]
ser.stop
ser2.stop
ser.start(r1,t1,0,baud) 'ready port for PC
ser2.start(r2,t2,0,baud) 'ready port for HOST
Baud:=temp
text.clsupdate(Baud,termcolor,pcport,ascii,CR)
EEPROM
if key == 721
if ++termcolor > 11
termcolor:=1
text.color(CLR[termcolor])
'text.clsupdate(Baud,termcolor,pcport,ascii)
EEPROM
if key == 722
if pcport == 1
pcport := 0
else
pcport := 1
text.clsupdate(Baud,termcolor,pcport,ascii,CR)
EEPROM
if key == 723
if ascii == 0
ascii := 1
else
ascii :=0
text.clsupdate(Baud,termcolor,pcport,ascii,CR)
EEPROM
if key == 724
curset++
if curset > 7
curset := 1
text.cursorset(curset)
EEPROM
if key == 725 'F6
if CR == 1
CR := 0
else
CR := 1
text.clsupdate(Baud,termcolor,pcport,ascii,CR)
EEPROM
if key <128 and key > 0 'Is the keystroke PocketTerm compatible? was 96
ser2.tx(key) 'Yes, so send it
if key == 13
'this probably needs to be if CR == 1
if LNM == 1 or CR == 1'send both CR and LF?
ser2.tx(10) 'yes, set by LNM ESC command, send LF also
'' END keyboard console routine
'LOOK FOR SERIAL INPUT HERE
if pcport == 0 'Is PC turned on at console for checking?
remote2 := ser.rxcheck 'Yes, look at the port for data
if (remote2 > -1) 'remote = -1 if no data
ser2.tx(remote2) 'Send the data out to the host device
waitcnt(clkfreq/200 + cnt) 'Added to attempt eliminate dropped characters
remote := ser2.rxcheck 'Look at host device port for data
if (remote > -1)
if ascii == 1 'yes force 7 bit ascii
if (remote > 127)
remote := remote -128
if pcport == 0
ser.tx(remote)
'Start of VT100 code
if remote == 27 'vt100 ESC code is being sent
vt100:=1
byte1:=0
byte2:=0
byte3:=0
byte4:=0
byte5:=0
byte6:=0
byte7:=0
remote:=0
temp2:=0 'Don't display the ESC code
if remote == 99 and vt100 == 1 'ESC c
remote:=0
vt100:=0
text.inv(0)
text.cls(Baud,termcolor,pcport,ascii,CR)
text.home
if remote == 61 and vt100 == 1 'lool for ESC=
vt100:= remote := 0
'put ESC D and ESC M here
if remote == 77 and vt100 == 1 'AKA ESC M
text.scrollM
vt100 := 0
if remote == 68 and vt100 == 1 'AKA ESC D
if byte2 <> 91 and byte3 <> 91 and byte4 <> 91 'not esc[D
'text.scrollD
vt100 := 0
if remote == 76 and vt100 == 1 'AKA ESC L
if remote == 91 and vt100 == 1 'look for open bracket [
vt100:=2 'start recording code
if remote == 62 and vt100 == 1 or remote == 60 and vt100 == 1 'look for < & >
vt100:=0 ' not sure why this is coming up, can't find in spec.
if vt100==2 ''Check checking for VT100 emulation codes
if remote > 10
byte7:=byte6
byte6:=byte5 ' My VTCode Mini Buffer
byte5:=byte4
byte4:=byte3
byte3:=byte2 'Record the last 7 bytes
byte2:=byte1
byte1:=remote
if remote == 109 'look for lowercase m
if byte2 == 91 'if [m turn off to normal set
text.inv(0)
vt100:=0
if byte2 == 49 and vt100 > 0 'is it ESC[1m BOLD
'text.inv(1)
vt100 := 0
if byte2 == 55 and vt100 > 0 'is it ESC[7m?
text.inv(1)
vt100 := 0
if byte2 == 48 and vt100 > 0 '0 is back to normal
text.inv(0)
vt100:=0
if byte2 == 52 and vt100 > 0 'is it ESC[4m underline?
vt100:=0 'yes ignore
if byte2 == 50 and vt100 >0 'is it ESC[2m dim text
vt100:=0 'yes ignore
if remote == 64 'look for ESC[value@ @=64 insert value spaces
if byte4 == 91 'two digit value
byte3:=byte3-48 'Grab 10's
byte2:=byte2-48 'Grab 1's
byte3:=byte3*10 'Multiply 10's
byte3:=byte3+byte2 'Add 1's
text.insertat(byte3)
if byte3 == 91 'single digit value
byte2:=byte2-48
text.insertat(byte2)
vt100 :=0
if remote == 80 'look for ESC[valueP P=64 delete value spaces
if byte4 == 91 'two digit value
byte3:=byte3-48 'Grab 10's
byte2:=byte2-48 'Grab 1's
byte3:=byte3*10 'Multiply 10's
byte3:=byte3+byte2 'Add 1's
text.delp(byte3)
if byte3 == 91 'single digit value
byte2:=byte2-48
text.delp(byte2)
vt100 :=0
if remote == 104 'look for lowercase h set CR/LF mode
if byte2 == 48 'if character before h is 0 maybe command is 20h
if byte3 == 50 'if byte3 then it is for sure 20h
LNM := 0
vt100:=0
if remote == 61 'lool for =
vt100:=0
if remote == 114 'look for lowercase r
vt100:=0
if remote == 108 'look for lowercase l
if byte2 == 48 'if character before l is 0 maybe command is 20l
if byte3 == 50 'if byte3 then it is for sure 20l
LNM := 1 '0 means CR/LF in CR mode only
vt100:=0
if remote == 62 'look for >
vt100:=0
if remote == 77 'ESC M look for obscure scroll window code
text.scrollM
vt100:=0
if remote == 68 or remote == 76 ' look for ESC D or ESC L
text.scrollD
vt100:=0
if remote == 72 or remote == 102 ' HOME CURSOR (uppercase H or lowercase f)
if byte2==91 or byte2==59 'look for [H or [;f
text.home
vt100:=0
'' Check for X & Y with [H or ;f - Esc[Line;ColumnH
else 'here remote is either H or f
if byte4 == 59 'is col is greater than 9 ; ALWAYS if byte4=59
byte3:=byte3-48 'Grab 10's
byte2:=byte2-48 'Grab 1's
byte3:=byte3*10 'Multiply 10's
byte3:=byte3+byte2 'Add 1's
col:=byte3 'Set cols
if byte7 == 91 'Assume row number is greater than 9 if ; at byte 4 and [ at byte 7 greater than 9
byte6:=byte6-48 'Grab 10's
byte5:=byte5-48 'Grab 1's
byte6:=byte6*10 'Multiply 10's
byte6:=byte6+byte5 'Add 1's
row:=byte6
if byte6 == 91 'Assume row number is less than 10
byte5:=byte5 - 48 'Grab 1's
row:=byte5
if byte3 == 59 ' Assume that col is less an 10
byte2:=byte2-48 'Grab 1's
col:=byte2 'set cols
if byte6 == 91 'Assume row number is greater than 9
byte5:=byte5-48 'Grab 10's
byte4:=byte4-48 'Grab 1's
byte5:=byte5*10 'Multiply 10's
byte5:=byte5+byte4 'Add 1's
row:=byte5
if byte5 == 91 'Assume that col is greater than 10
byte4:=byte4-48 'Grab 1's
row:=byte4
col:=col-1
if row == -459
row:=1
if col == -40 ' Patches a bug I havn't found. *yet*
col := 58 ' A Microsoft approach to the problem. :)
if row == -449
row := 2 ' Appears to be an issue with reading
if row == -439 ' single digit rows.
row := 3
if row == -429 ' This patch checks for the bug and replaces
row := 4 ' the faulty calculation.
if row == -419
row := 5 ' Add to list to find the source of bug later.
if row == -409
row := 6
if row == -399
row := 7
if row == -389
row := 8
if row == -379
row := 9
row--
if row < 0
row:=0
if col < 0
col:=0
if row > 35
row :=35
if col > 79
col := 79
text.cursloc(col,row)
vt100:=0
if remote == 114 'ESCr
text.out(126)
if remote == 74 '' CLEAR SCREEN
if byte2==91 '' look for [J '' clear screen from cursor to 25
text.clsfromcursordown
'vt100:=0
if byte2==50 '' look for [2J '' clear screen
text.cls(Baud,termcolor,pcport,ascii,CR)
if byte2==49 'look for [1J
text.clstocursor
if byte2==48 'look for [0J
text.clsfromcursordown
vt100:=0
if remote == 66 '' CURSOR DOWN Esc[ValueB
if byte4 == 91 '' Assume number over 10
byte3:=byte3-48
byte2:=byte2-48
byte3:=byte3*10
byte3:=byte3+byte2
var1:=byte3
if byte3 == 91 '' Assume number is less 10
byte2:=byte2-48
var1:=byte2
if byte2 == 91 ''ESC[B no numbers move down one
'text.out($C3)
var1 := 1
loop:=0
repeat until loop == var1
loop++
text.out($C3)
vt100:=0
if remote == 65 '' CURSOR UP Esc[ValueA
if byte4 == 91 '' Assume number over 10
byte3:=byte3-48
byte2:=byte2-48
byte3:=byte3*10
byte3:=byte3+byte2
var1:=byte3
if byte3 == 91 '' Assume number is less 10
byte2:=byte2-48
var1:=byte2
if byte2 == 91 ''ESC[A no numbers move down one
var1 := 1
loop:=0
repeat until loop == var1
text.out($C2)
loop++
vt100:=0
if remote == 67 '' CURSOR RIGHT Esc[ValueC
if byte4 == 91 '' Assume number over 10
byte3:=byte3-48
byte2:=byte2-48
byte3:=byte3*10
byte3:=byte3+byte2
var1:=byte3
if byte3 == 91 '' Assume number is less 10
byte2:=byte2-48
var1:=byte2
if byte2 == 91 ''ESC[C no numbers move RIGHT one
var1 := 1
loop:=0
repeat until loop == var1
text.out($C1)
loop++
vt100:=0
if remote == 68 '' CURSOR LEFT Esc[ValueD OR ESC[D
if byte4 == 91 '' Assume number over 10
byte3:=byte3-48
byte2:=byte2-48
byte3:=byte3*10
byte3:=byte3+byte2
var1:=byte3
if byte3 == 91 '' Assume number is less 10
byte2:=byte2-48
var1:=byte2
if byte2 == 91 ''ESC[D no numbers move LEFT one
var1 := 1
loop:=0
repeat until loop == var1
text.out($C0) 'was $C0
loop++
vt100:=0
if remote == 75 '' Clear line Esc[K
if byte2 == 91 '' Look for [
text.clearlinefromcursor
vt100:=0
if byte2 == 48 ' look for [0K
if byte3 == 91
text.clearlinefromcursor
vt100:=0
if byte2 == 49 ' look for [1K
if byte3 == 91
text.clearlinetocursor
vt100 := 0
if byte2 == 50 ' look for [2K
if byte3 == 91
text.clearline
vt100 := 0
if remote == 99 ' look for [0c or [c ESC [ ? 1 ; Ps c Ps=0 for VT-100 no options
if byte2 == 91 '' Look for [
ser2.str(string(27,"[?1;0c"))
vt100 := 0
if byte2 == 48
if byte3 == 91
ser2.str(string(27,"[?1;0c"))
vt100 := 0
remote:=0 '' hide all codes from the VGA output.
if record == 13 and remote == 13 ''LF CHECK
if CR == 1
text.out(remote)
remote :=0
if remote == 08
remote := $C0 'now backspace just moves cursor, doesn't clear character
if remote == 7
sound(source, 4500)
' if remote == 10
' text.out($0A)
if remote > 8
text.out(remote)
record:=remote ''record last byte
PUB EEPROM | eepromData
eepromLocation := EEPROM_Base
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, 55)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, Baud)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, termcolor)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, pcport)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, ascii)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, curset)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, CR)
waitcnt(clkfreq/200 + cnt)
PUB Sound (pWav,speed):bOK|n,i,nextCnt,rate,dcnt,wait
pWav+=44
i:=0
NextCnt:=cnt '+15000
'Play loop
repeat i from 0 to 1200
NextCnt+=speed
waitcnt(NextCnt)
FRQA:=(byte[pWav+i])<<24
FRQB:=FRQA
PUB forever | i
repeat i from 0 to 1000
waitcnt(i*32767)
DAT
PIANO
File "piano.wav" ' <--- put your 8-bit PCM mono 8000 sample/second WAV

View File

@ -0,0 +1,272 @@
'' Basic I2C Routines Version 1.1
'' Written by Michael Green and copyright (©) 2007
'' Permission is given to use this in any program for the Parallax
'' Propeller processor as long as this copyright notice is included.
'' This is a minimal version of an I2C driver in SPIN. It assumes
'' that the SDA pin is one higher than the SCL pin. It assumes that
'' neither the SDA nor the SCL pins have pullups, so drives both.
'' These routines are primarily intended for reading and writing EEPROMs.
'' The low level I2C are provided for use with other devices, but the
'' read/write byte routines assume a standard I2C serial EEPROM with a
'' 16 bit device address register, paged writes, and acknowledge polling.
'' All of these read/write routines accept an EEPROM address up to 19
'' bits (512K) even though the EEPROM addressing scheme normally allows
'' for only 16 bits of addressing. The upper 3 bits are used as part of
'' the device select code and these routines will take the upper 3 bits
'' of the address and "or" it with the supplied device select code bits
'' 3-1 which are used to select a particular EEPROM on an I2C bus. There
'' are two schemes for selecting 64K "banks" in 128Kx8 EEPROMs. Atmel's
'' 24LC1024 EEPROMs allow simple linear addressing up to 256Kx8 ($00000
'' to $3FFFF). Microchip's 24LC1025 allows for up to 512Kx8, but in two
'' areas: $00000 to $3FFFF and $40000 to $7FFFF. Each EEPROM provides
'' a 64K "bank" in each area. See the device datasheets for details.
'' This will work with the boot EEPROM and does not require a pull-up
'' resistor on the SCL line (but does on the SDA line ... about 4.7K to
'' +3.3V). According to the Philips I2C specification, both pull-ups
'' are required. Many devices will tolerate the absence of a pull-up
'' on SCL. Some may tolerate the absence of a pull-up on SDA as well.
'' Initialize may have to be called once at the beginning of your
'' program. Sometimes an I2C device is left in an invalid state. This
'' will reset the device to a known state so it will respond to the I2C
'' start transition (sent out by the i2cStart routine).
'' To read from or write to an EEPROM on pins 28/29 like the boot EEPROM:
'' CON
'' eepromAddress = $7000
'' VAR
'' byte buffer[32]
'' OBJ
'' i2c : "Minimal_I2C_Driver"
'' PRI readIt
'' if i2c.ReadPage(i2c#BootPin, i2c#EEPROM, eepromAddress, @buffer, 32)
'' abort ' an error occurred during the read
'' PRI writeIt | startTime
'' if i2c.WritePage(i2c#BootPin, i2c#EEPROM, eepromAddress, @buffer, 32)
'' abort ' an error occured during the write
'' startTime := cnt ' prepare to check for a timeout
'' repeat while i2c.WriteWait(i2c#BootPin, i2c#EEPROM, eepromAddress)
'' if cnt - startTime > clkfreq / 10
'' abort ' waited more than a 1/10 second for the write to finish
'' Note that the read and write use something called paged reads/writes.
'' This means that any read using ReadPage must fit entirely in one
'' EEPROM if you have several attached to one set of pins. For writes,
'' any write using i2cWritePage must fit entirely within a page of the
'' EEPROM. Usually these pages are either 32, 64, 128 or 256 bytes in
'' size depending on the manufacturer and device type. 32 bytes is a
'' good limit for the number of bytes to be written at a time if you
'' don't know the specific page size (and the write must fit completely
'' within a multiple of the page size). The WriteWait waits for the
'' write operation to complete. Alternatively, you could wait for 5ms
'' since currently produced EEPROMs will finish within that time.
CON
ACK = 0 ' I2C Acknowledge
NAK = 1 ' I2C No Acknowledge
Xmit = 0 ' I2C Direction Transmit
Recv = 1 ' I2C Direction Receive
BootPin = 28 ' I2C Boot EEPROM SCL Pin
EEPROM = $A0 ' I2C EEPROM Device Address
PUB Initialize(SCL) | SDA ' An I2C device may be left in an
SDA := SCL + 1 ' invalid state and may need to be
outa[SCL] := 1 ' reinitialized. Drive SCL high.
dira[SCL] := 1
dira[SDA] := 0 ' Set SDA as input
repeat 9
outa[SCL] := 0 ' Put out up to 9 clock pulses
outa[SCL] := 1
if ina[SDA] ' Repeat if SDA not driven high
quit ' by the EEPROM
PUB Start(SCL) | SDA ' SDA goes HIGH to LOW with SCL HIGH
SDA := SCL + 1
outa[SCL]~~ ' Initially drive SCL HIGH
dira[SCL]~~
outa[SDA]~~ ' Initially drive SDA HIGH
dira[SDA]~~
outa[SDA]~ ' Now drive SDA LOW
outa[SCL]~ ' Leave SCL LOW
PUB Stop(SCL) | SDA ' SDA goes LOW to HIGH with SCL High
SDA := SCL + 1
outa[SCL]~~ ' Drive SCL HIGH
outa[SDA]~~ ' then SDA HIGH
dira[SCL]~ ' Now let them float
dira[SDA]~ ' If pullups present, they'll stay HIGH
PUB Write(SCL, data) : ackbit | SDA
'' Write i2c data. Data byte is output MSB first, SDA data line is valid
'' only while the SCL line is HIGH. Data is always 8 bits (+ ACK/NAK).
'' SDA is assumed LOW and SCL and SDA are both left in the LOW state.
SDA := SCL + 1
ackbit := 0
data <<= 24
repeat 8 ' Output data to SDA
outa[SDA] := (data <-= 1) & 1
outa[SCL]~~ ' Toggle SCL from LOW to HIGH to LOW
outa[SCL]~
dira[SDA]~ ' Set SDA to input for ACK/NAK
outa[SCL]~~
ackbit := ina[SDA] ' Sample SDA when SCL is HIGH
outa[SCL]~
outa[SDA]~ ' Leave SDA driven LOW
dira[SDA]~~
PUB Read(SCL, ackbit): data | SDA
'' Read in i2c data, Data byte is output MSB first, SDA data line is
'' valid only while the SCL line is HIGH. SCL and SDA left in LOW state.
SDA := SCL + 1
data := 0
dira[SDA]~ ' Make SDA an input
repeat 8 ' Receive data from SDA
outa[SCL]~~ ' Sample SDA when SCL is HIGH
data := (data << 1) | ina[SDA]
outa[SCL]~
outa[SDA] := ackbit ' Output ACK/NAK to SDA
dira[SDA]~~
outa[SCL]~~ ' Toggle SCL from LOW to HIGH to LOW
outa[SCL]~
outa[SDA]~ ' Leave SDA driven LOW
PUB ReadPage(SCL, devSel, addrReg, dataPtr, count) : ackbit
'' Read in a block of i2c data. Device select code is devSel. Device starting
'' address is addrReg. Data address is at dataPtr. Number of bytes is count.
'' The device select code is modified using the upper 3 bits of the 19 bit addrReg.
'' Return zero if no errors or the acknowledge bits if an error occurred.
devSel |= addrReg >> 15 & %1110
Start(SCL) ' Select the device & send address
ackbit := Write(SCL, devSel | Xmit)
ackbit := (ackbit << 1) | Write(SCL, addrReg >> 8 & $FF)
ackbit := (ackbit << 1) | Write(SCL, addrReg & $FF)
Start(SCL) ' Reselect the device for reading
ackbit := (ackbit << 1) | Write(SCL, devSel | Recv)
repeat count - 1
byte[dataPtr++] := Read(SCL, ACK)
byte[dataPtr++] := Read(SCL, NAK)
Stop(SCL)
return ackbit
PUB ReadByte(SCL, devSel, addrReg) : data
'' Read in a single byte of i2c data. Device select code is devSel. Device
'' starting address is addrReg. The device select code is modified using the
'' upper 3 bits of the 19 bit addrReg. This returns true if an error occurred.
if ReadPage(SCL, devSel, addrReg, @data, 1)
return -1
PUB ReadWord(SCL, devSel, addrReg) : data
'' Read in a single word of i2c data. Device select code is devSel. Device
'' starting address is addrReg. The device select code is modified using the
'' upper 3 bits of the 19 bit addrReg. This returns true if an error occurred.
if ReadPage(SCL, devSel, addrReg, @data, 2)
return -1
PUB ReadLong(SCL, devSel, addrReg) : data
'' Read in a single long of i2c data. Device select code is devSel. Device
'' starting address is addrReg. The device select code is modified using the
'' upper 3 bits of the 19 bit addrReg. This returns true if an error occurred.
'' Note that you can't distinguish between a return value of -1 and true error.
if ReadPage(SCL, devSel, addrReg, @data, 4)
return -1
PUB WritePage(SCL, devSel, addrReg, dataPtr, count) : ackbit
'' Write out a block of i2c data. Device select code is devSel. Device starting
'' address is addrReg. Data address is at dataPtr. Number of bytes is count.
'' The device select code is modified using the upper 3 bits of the 19 bit addrReg.
'' Most devices have a page size of at least 32 bytes, some as large as 256 bytes.
'' Return zero if no errors or the acknowledge bits if an error occurred. If
'' more than 31 bytes are transmitted, the sign bit is "sticky" and is the
'' logical "or" of the acknowledge bits of any bytes past the 31st.
devSel |= addrReg >> 15 & %1110
Start(SCL) ' Select the device & send address
ackbit := Write(SCL, devSel | Xmit)
ackbit := (ackbit << 1) | Write(SCL, addrReg >> 8 & $FF)
ackbit := (ackbit << 1) | Write(SCL, addrReg & $FF)
repeat count ' Now send the data
ackbit := ackbit << 1 | ackbit & $80000000 ' "Sticky" sign bit
ackbit |= Write(SCL, byte[dataPtr++])
Stop(SCL)
return ackbit
PUB WriteByte(SCL, devSel, addrReg, data)
'' Write out a single byte of i2c data. Device select code is devSel. Device
'' starting address is addrReg. The device select code is modified using the
'' upper 3 bits of the 19 bit addrReg. This returns true if an error occurred.
if WritePage(SCL, devSel, addrReg, @data, 1)
return true
' james edit - wait for 5ms for page write to complete (80_000 * 5 = 400_000)
waitcnt(400_000 + cnt)
return false
PUB WriteWord(SCL, devSel, addrReg, data)
'' Write out a single word of i2c data. Device select code is devSel. Device
'' starting address is addrReg. The device select code is modified using the
'' upper 3 bits of the 19 bit addrReg. This returns true if an error occurred.
'' Note that the word value may not span an EEPROM page boundary.
if WritePage(SCL, devSel, addrReg, @data, 2)
return true
' james edit - wait for 5ms for page write to complete (80_000 * 5 = 400_000)
waitcnt(400_000 + cnt)
return false
PUB WriteLong(SCL, devSel, addrReg, data)
'' Write out a single long of i2c data. Device select code is devSel. Device
'' starting address is addrReg. The device select code is modified using the
'' upper 3 bits of the 19 bit addrReg. This returns true if an error occurred.
'' Note that the long word value may not span an EEPROM page boundary.
if WritePage(SCL, devSel, addrReg, @data, 4)
return true
' james edit - wait for 5ms for page write to complete (80_000 * 5 = 400_000)
waitcnt(400_000 + cnt)
return false
PUB WriteWait(SCL, devSel, addrReg) : ackbit
'' Wait for a previous write to complete. Device select code is devSel. Device
'' starting address is addrReg. The device will not respond if it is busy.
'' The device select code is modified using the upper 3 bits of the 18 bit addrReg.
'' This returns zero if no error occurred or one if the device didn't respond.
devSel |= addrReg >> 15 & %1110
Start(SCL)
ackbit := Write(SCL, devSel | Xmit)
Stop(SCL)
return ackbit
' *************** JAMES'S Extra BITS *********************
PUB devicePresent(SCL,deviceAddress) : ackbit
' send the deviceAddress and listen for the ACK
Start(SCL)
ackbit := Write(SCL,deviceAddress | 0)
Stop(SCL)
if ackbit == ACK
return true
else
return false
PUB writeLocation(SCL,device_address, register, value)
start(SCL)
write(SCL,device_address)
write(SCL,register)
write(SCL,value)
stop (SCL)
PUB readLocation(SCL,device_address, register) : value
start(SCL)
write(SCL,device_address | 0)
write(SCL,register)
start(SCL)
write(SCL,device_address | 1)
value := read(SCL,NAK)
stop(SCL)
return value

View File

@ -0,0 +1,336 @@
''************************************
''* Full-Duplex Serial Driver v1.1 *
''* (C) 2006 Parallax, Inc. *
''************************************
''
''
'' Added Notes from: Mike Green, lifted from: http://forums.parallax.com/forums/default.aspx?f=25
''
'' "FullDuplexSerial" is a full duplex serial driver. It uses only one cog to both transmit and receive.
'' You only need to call the start routine once to set up both directions. To use pin 0 for transmit and
'' pin 1 for receive at 9600 Baud you'd call "serial.start(1,0,%0000,9600)". That implies Rx not inverted,
'' Tx not inverted, not open drain on transmit, and no ignore echo on receive. This assumes that you declare
'' 'OBJ serial : "FullDuplexSerial"'.
''
'' The return value is true if the driver was started ok, false if there were no free cogs available (rarely happens).
''
'' FullDuplexSerial is intended to provide a buffered high speed serial communications channel in both directions
'' at once using a single cog.
''
'' The actual UART function in the FullDuplexSerial object resides in a cog (for each full duplex channel). This
'' does the actual "bit-banging" and does the manipulation of the I/O pins. It communicates with the "interface"
'' routines written in SPIN by means of transmit and receive buffers declared in the FullDuplexSerial object.
'' The interface routines (like .tx, .rx, .rxcheck) can be called from any cog running SPIN although, if you try
'' to receive or transmit from more than one cog at a time, you'll get into trouble since both cogs will try to
'' put data into or get data out of the same buffer at the same time. The fix for this is to use the semaphores
'' (LOCKxxx). It would be unusual to have to do this. Normally, only one cog would make use of any one full duplex
'' channel.
''
'' The FullDuplexSerial routines should work to at least 384 kB
''
''
VAR
long cog 'cog flag/id
long rx_head '9 contiguous longs
long rx_tail
long tx_head
long tx_tail
long rx_pin
long tx_pin
long rxtx_mode
long bit_ticks
long buffer_ptr
' transmit and receive buffers
' buffers need to be a power of 2; ie: 16 32 64 128 256 512
' Note: looks like the maximum size of the buffer can only be 512 bytes.
byte rx_buffer[256] ' <----------- Change Buffer Size Here
byte tx_buffer[256] ' <----------- Change Buffer Size Here
PUB start(rxpin, txpin, mode, baudrate) : okay
'' Start serial driver - starts a cog
'' returns false if no cog available
''
'' mode bit 0 = invert rx
'' mode bit 1 = invert tx
'' mode bit 2 = open-drain/source tx
'' mode bit 3 = ignore tx echo on rx
stop ' stop stops any existing running serial driver if say you reinitialized
' your program without previously stopping it.
longfill(@rx_head, 0, 4) ' The longfill initializes the first 4 longs to zero
' (rx_head through tx_tail)
longmove(@rx_pin, @rxpin, 3) ' The longmove copies the 4 parameters to start to the next 4 longs in
' the table (rx_pin through bit_ticks)
bit_ticks := clkfreq / baudrate ' The assignment to bit_ticks computes the number of clock ticks for
' the Baud requested.
buffer_ptr := @rx_buffer ' The assignment to buffer_ptr passes the address
' of the receive buffer (and the transmit buffer XX bytes further).
okay := cog := cognew(@entry, @rx_head) + 1 ' The cognew starts the assembly driver and passes to it the starting
' address of this whole table which it uses to refer to the various
' items in the table (rx_head through buffer_ptr).
PUB stop
'' Stop serial driver - frees a cog
if cog
cogstop(cog~ - 1)
'longfill(@rx_head, 0, 9)
PUB rxflush
'' Flush receive buffer
repeat while rxcheck => 0
PUB rxcheck : rxbyte
'' Check if byte received (never waits)
'' returns -1 if no byte received, $00..$FF if byte
rxbyte--
if rx_tail <> rx_head
rxbyte := rx_buffer[rx_tail]
rx_tail := (rx_tail + 1) & $FF ' <----------- Change Buffer Size Here
PUB rxtime(ms) : rxbyte | t
'' Wait ms milliseconds for a byte to be received
'' returns -1 if no byte received, $00..$FF if byte
t := cnt
repeat until (rxbyte := rxcheck) => 0 or (cnt - t) / (clkfreq / 1000) > ms
PUB rx : rxbyte
'' Receive byte (may wait for byte)
'' returns $00..$FF
repeat while (rxbyte := rxcheck) < 0
PUB tx(txbyte)
'' Send byte (may wait for room in buffer)
repeat until (tx_tail <> (tx_head + 1) & $FF) ' <----------- Change Buffer Size Here
tx_buffer[tx_head] := txbyte
tx_head := (tx_head + 1) & $FF ' <----------- Change Buffer Size Here
if rxtx_mode & %1000
rx
PUB str(stringptr)
'' Send string
repeat strsize(stringptr)
tx(byte[stringptr++])
PUB dec(value) | i
'' Print a decimal number
if value < 0
-value
tx("-")
i := 1_000_000_000
repeat 10
if value => i
tx(value / i + "0")
value //= i
result~~
elseif result or i == 1
tx("0")
i /= 10
PUB hex(value, digits)
'' Print a hexadecimal number
value <<= (8 - digits) << 2
repeat digits
tx(lookupz((value <-= 4) & $F : "0".."9", "A".."F"))
PUB bin(value, digits)
'' Print a binary number
value <<= 32 - digits
repeat digits
tx((value <-= 1) & 1 + "0")
DAT
'***********************************
'* Assembly language serial driver *
'***********************************
org
'
'
' Entry
'
entry mov t1,par 'get structure address
add t1,#4 << 2 'skip past heads and tails
rdlong t2,t1 'get rx_pin
mov rxmask,#1
shl rxmask,t2
add t1,#4 'get tx_pin
rdlong t2,t1
mov txmask,#1
shl txmask,t2
add t1,#4 'get rxtx_mode
rdlong rxtxmode,t1
add t1,#4 'get bit_ticks
rdlong bitticks,t1
add t1,#4 'get buffer_ptr
rdlong rxbuff,t1
mov txbuff,rxbuff
add txbuff,#256 ' <----------- Change Buffer Size Here
test rxtxmode,#%100 wz 'init tx pin according to mode
test rxtxmode,#%010 wc
if_z_ne_c or outa,txmask
if_z or dira,txmask
mov txcode,#transmit 'initialize ping-pong multitasking
'
'
' Receive
'
receive jmpret rxcode,txcode 'run a chunk of transmit code, then return
test rxtxmode,#%001 wz 'wait for start bit on rx pin
test rxmask,ina wc
if_z_eq_c jmp #receive
mov rxbits,#9 'ready to receive byte
mov rxcnt,bitticks
shr rxcnt,#1
add rxcnt,cnt
:bit add rxcnt,bitticks 'ready next bit period
:wait jmpret rxcode,txcode 'run a chuck of transmit code, then return
mov t1,rxcnt 'check if bit receive period done
sub t1,cnt
cmps t1,#0 wc
if_nc jmp #:wait
test rxmask,ina wc 'receive bit on rx pin
rcr rxdata,#1
djnz rxbits,#:bit
shr rxdata,#32-9 'justify and trim received byte
and rxdata,#$FF
test rxtxmode,#%001 wz 'if rx inverted, invert byte
if_nz xor rxdata,#$FF
rdlong t2,par 'save received byte and inc head
add t2,rxbuff
wrbyte rxdata,t2
sub t2,rxbuff
add t2,#1
and t2,#$FF ' <----------- Change Buffer Size Here
wrlong t2,par
jmp #receive 'byte done, receive next byte
'
'
' Transmit
'
transmit jmpret txcode,rxcode 'run a chunk of receive code, then return
mov t1,par 'check for head <> tail
add t1,#2 << 2
rdlong t2,t1
add t1,#1 << 2
rdlong t3,t1
cmp t2,t3 wz
if_z jmp #transmit
add t3,txbuff 'get byte and inc tail
rdbyte txdata,t3
sub t3,txbuff
add t3,#1
and t3,#$FF ' <----------- Change Buffer Size Here
wrlong t3,t1
or txdata,#$100 'ready byte to transmit
shl txdata,#2
or txdata,#1
mov txbits,#11
mov txcnt,cnt
:bit test rxtxmode,#%100 wz 'output bit on tx pin according to mode
test rxtxmode,#%010 wc
if_z_and_c xor txdata,#1
shr txdata,#1 wc
if_z muxc outa,txmask
if_nz muxnc dira,txmask
add txcnt,bitticks 'ready next cnt
:wait jmpret txcode,rxcode 'run a chunk of receive code, then return
mov t1,txcnt 'check if bit transmit period done
sub t1,cnt
cmps t1,#0 wc
if_nc jmp #:wait
djnz txbits,#:bit 'another bit to transmit?
jmp #transmit 'byte done, transmit next byte
'
'
' Uninitialized data
'
t1 res 1
t2 res 1
t3 res 1
rxtxmode res 1
bitticks res 1
rxmask res 1
rxbuff res 1
rxdata res 1
rxbits res 1
rxcnt res 1
rxcode res 1
txmask res 1
txbuff res 1
txdata res 1
txbits res 1
txcnt res 1
txcode res 1

View File

@ -0,0 +1,336 @@
''************************************
''* Full-Duplex Serial Driver v1.1 *
''* (C) 2006 Parallax, Inc. *
''************************************
''
''
'' Added Notes from: Mike Green, lifted from: http://forums.parallax.com/forums/default.aspx?f=25
''
'' "FullDuplexSerial" is a full duplex serial driver. It uses only one cog to both transmit and receive.
'' You only need to call the start routine once to set up both directions. To use pin 0 for transmit and
'' pin 1 for receive at 9600 Baud you'd call "serial.start(1,0,%0000,9600)". That implies Rx not inverted,
'' Tx not inverted, not open drain on transmit, and no ignore echo on receive. This assumes that you declare
'' 'OBJ serial : "FullDuplexSerial"'.
''
'' The return value is true if the driver was started ok, false if there were no free cogs available (rarely happens).
''
'' FullDuplexSerial is intended to provide a buffered high speed serial communications channel in both directions
'' at once using a single cog.
''
'' The actual UART function in the FullDuplexSerial object resides in a cog (for each full duplex channel). This
'' does the actual "bit-banging" and does the manipulation of the I/O pins. It communicates with the "interface"
'' routines written in SPIN by means of transmit and receive buffers declared in the FullDuplexSerial object.
'' The interface routines (like .tx, .rx, .rxcheck) can be called from any cog running SPIN although, if you try
'' to receive or transmit from more than one cog at a time, you'll get into trouble since both cogs will try to
'' put data into or get data out of the same buffer at the same time. The fix for this is to use the semaphores
'' (LOCKxxx). It would be unusual to have to do this. Normally, only one cog would make use of any one full duplex
'' channel.
''
'' The FullDuplexSerial routines should work to at least 384 kB
''
''
VAR
long cog 'cog flag/id
long rx_head '9 contiguous longs
long rx_tail
long tx_head
long tx_tail
long rx_pin
long tx_pin
long rxtx_mode
long bit_ticks
long buffer_ptr
' transmit and receive buffers
' buffers need to be a power of 2; ie: 16 32 64 128 256 512
' Note: looks like the maximum size of the buffer can only be 512 bytes.
byte rx_buffer[256] ' <----------- Change Buffer Size Here
byte tx_buffer[256] ' <----------- Change Buffer Size Here
PUB start(rxpin, txpin, mode, baudrate) : okay
'' Start serial driver - starts a cog
'' returns false if no cog available
''
'' mode bit 0 = invert rx
'' mode bit 1 = invert tx
'' mode bit 2 = open-drain/source tx
'' mode bit 3 = ignore tx echo on rx
stop ' stop stops any existing running serial driver if say you reinitialized
' your program without previously stopping it.
longfill(@rx_head, 0, 4) ' The longfill initializes the first 4 longs to zero
' (rx_head through tx_tail)
longmove(@rx_pin, @rxpin, 3) ' The longmove copies the 4 parameters to start to the next 4 longs in
' the table (rx_pin through bit_ticks)
bit_ticks := clkfreq / baudrate ' The assignment to bit_ticks computes the number of clock ticks for
' the Baud requested.
buffer_ptr := @rx_buffer ' The assignment to buffer_ptr passes the address
' of the receive buffer (and the transmit buffer XX bytes further).
okay := cog := cognew(@entry, @rx_head) + 1 ' The cognew starts the assembly driver and passes to it the starting
' address of this whole table which it uses to refer to the various
' items in the table (rx_head through buffer_ptr).
PUB stop
'' Stop serial driver - frees a cog
if cog
cogstop(cog~ - 1)
'longfill(@rx_head, 0, 9)
PUB rxflush
'' Flush receive buffer
repeat while rxcheck => 0
PUB rxcheck : rxbyte
'' Check if byte received (never waits)
'' returns -1 if no byte received, $00..$FF if byte
rxbyte--
if rx_tail <> rx_head
rxbyte := rx_buffer[rx_tail]
rx_tail := (rx_tail + 1) & $FF ' <----------- Change Buffer Size Here
PUB rxtime(ms) : rxbyte | t
'' Wait ms milliseconds for a byte to be received
'' returns -1 if no byte received, $00..$FF if byte
t := cnt
repeat until (rxbyte := rxcheck) => 0 or (cnt - t) / (clkfreq / 1000) > ms
PUB rx : rxbyte
'' Receive byte (may wait for byte)
'' returns $00..$FF
repeat while (rxbyte := rxcheck) < 0
PUB tx(txbyte)
'' Send byte (may wait for room in buffer)
repeat until (tx_tail <> (tx_head + 1) & $FF) ' <----------- Change Buffer Size Here
tx_buffer[tx_head] := txbyte
tx_head := (tx_head + 1) & $FF ' <----------- Change Buffer Size Here
if rxtx_mode & %1000
rx
PUB str(stringptr)
'' Send string
repeat strsize(stringptr)
tx(byte[stringptr++])
PUB dec(value) | i
'' Print a decimal number
if value < 0
-value
tx("-")
i := 1_000_000_000
repeat 10
if value => i
tx(value / i + "0")
value //= i
result~~
elseif result or i == 1
tx("0")
i /= 10
PUB hex(value, digits)
'' Print a hexadecimal number
value <<= (8 - digits) << 2
repeat digits
tx(lookupz((value <-= 4) & $F : "0".."9", "A".."F"))
PUB bin(value, digits)
'' Print a binary number
value <<= 32 - digits
repeat digits
tx((value <-= 1) & 1 + "0")
DAT
'***********************************
'* Assembly language serial driver *
'***********************************
org
'
'
' Entry
'
entry mov t1,par 'get structure address
add t1,#4 << 2 'skip past heads and tails
rdlong t2,t1 'get rx_pin
mov rxmask,#1
shl rxmask,t2
add t1,#4 'get tx_pin
rdlong t2,t1
mov txmask,#1
shl txmask,t2
add t1,#4 'get rxtx_mode
rdlong rxtxmode,t1
add t1,#4 'get bit_ticks
rdlong bitticks,t1
add t1,#4 'get buffer_ptr
rdlong rxbuff,t1
mov txbuff,rxbuff
add txbuff,#256 ' <----------- Change Buffer Size Here
test rxtxmode,#%100 wz 'init tx pin according to mode
test rxtxmode,#%010 wc
if_z_ne_c or outa,txmask
if_z or dira,txmask
mov txcode,#transmit 'initialize ping-pong multitasking
'
'
' Receive
'
receive jmpret rxcode,txcode 'run a chunk of transmit code, then return
test rxtxmode,#%001 wz 'wait for start bit on rx pin
test rxmask,ina wc
if_z_eq_c jmp #receive
mov rxbits,#9 'ready to receive byte
mov rxcnt,bitticks
shr rxcnt,#1
add rxcnt,cnt
:bit add rxcnt,bitticks 'ready next bit period
:wait jmpret rxcode,txcode 'run a chuck of transmit code, then return
mov t1,rxcnt 'check if bit receive period done
sub t1,cnt
cmps t1,#0 wc
if_nc jmp #:wait
test rxmask,ina wc 'receive bit on rx pin
rcr rxdata,#1
djnz rxbits,#:bit
shr rxdata,#32-9 'justify and trim received byte
and rxdata,#$FF
test rxtxmode,#%001 wz 'if rx inverted, invert byte
if_nz xor rxdata,#$FF
rdlong t2,par 'save received byte and inc head
add t2,rxbuff
wrbyte rxdata,t2
sub t2,rxbuff
add t2,#1
and t2,#$FF ' <----------- Change Buffer Size Here
wrlong t2,par
jmp #receive 'byte done, receive next byte
'
'
' Transmit
'
transmit jmpret txcode,rxcode 'run a chunk of receive code, then return
mov t1,par 'check for head <> tail
add t1,#2 << 2
rdlong t2,t1
add t1,#1 << 2
rdlong t3,t1
cmp t2,t3 wz
if_z jmp #transmit
add t3,txbuff 'get byte and inc tail
rdbyte txdata,t3
sub t3,txbuff
add t3,#1
and t3,#$FF ' <----------- Change Buffer Size Here
wrlong t3,t1
or txdata,#$100 'ready byte to transmit
shl txdata,#2
or txdata,#1
mov txbits,#11
mov txcnt,cnt
:bit test rxtxmode,#%100 wz 'output bit on tx pin according to mode
test rxtxmode,#%010 wc
if_z_and_c xor txdata,#1
shr txdata,#1 wc
if_z muxc outa,txmask
if_nz muxnc dira,txmask
add txcnt,bitticks 'ready next cnt
:wait jmpret txcode,rxcode 'run a chunk of receive code, then return
mov t1,txcnt 'check if bit transmit period done
sub t1,cnt
cmps t1,#0 wc
if_nc jmp #:wait
djnz txbits,#:bit 'another bit to transmit?
jmp #transmit 'byte done, transmit next byte
'
'
' Uninitialized data
'
t1 res 1
t2 res 1
t3 res 1
rxtxmode res 1
bitticks res 1
rxmask res 1
rxbuff res 1
rxdata res 1
rxbits res 1
rxcnt res 1
rxcode res 1
txmask res 1
txbuff res 1
txdata res 1
txbits res 1
txcnt res 1
txcode res 1

Binary file not shown.

Binary file not shown.

View File

@ -0,0 +1,701 @@
''''''''''''''''''''''''''''''
'' PockeTerm ''
'' Author: Vince Briel ''
'' 2009 Briel Computers ''
'' ''
''''''''''''''''''''''''''''''
'
'' Big thanks to Jeff Ledger on the VT100 code
'
'
' Start of RAW code for testing December 19,2008
' Jan 10th added INVERSE mode
' Jan 13 revised code for .04 working duel serial ports
' Jan 15 fixed so xmodem could work by allowing data 0 up to be sent not 1 and up
' Jan 21 added PC port on/off 7 bit ascii on/off
' V.71 cls to cursor fixed
' V.72 clsfrom cursor down working
' V.73 fixed EEPROM read/write issue and no serial port functioning
' V.74 ESC D and ESC L commands added, only 2 commands remaining
' V.80 VT100 majority codes finished
' V.81 Fixed cursor home to 0,0 and CLS to leave cursor where it is at after CLS
' V.82 Made Function control keys CTRL-Fx to avoid accidental changes
' V.83 Added CTRL-G beep sound effect
' V.84 Added ESC[c and ESC[0c terminal ID command
' V.85 Fixed scroll issue if beyond 36th line
' V.86 Fixed terminal ID, now working added 300 & 115200 Baud rates
' V.90 Added CTRL-F6 option for Carriage return to add line feed YES or NO
' V.901 Fixed ESC[A-D so they work if no value is added
' V.902 Modified so CR just does a Carriage Return and LF just does a linefeed
' V.903 More adjustments to CR adjusted command
' V.905 Fixed clear from cursor up ESC[1J did not clear line above cursor
'' Current VT-100 Code list
''
'' ESC[m Turn off character attributes
'' ESC[0m Turn off character attributes
'' ESC[1m Turn bold character on (reverse)
'' ESC[7m Turn reverse video on
'' ESC[nA Move cursor up n lines
'' ESC[nB Move cursor down n lines
'' ESC[nC Move cursor right n lines
'' ESC[nD Move cursor left n lines
'' ESC[H Move cursor to upper left corner
'' ESC[;H Move cursor to upper left corner
'' ESC[line;columnH Move cursor to screen location v,h
'' ESC[f Move cursor to upper left corner
'' ESC[;f Move cursor to upper left corner
'' ESC[line;columnf Move cursor to sceen location v,h
'' ESCD Move/scroll window up one line
'' ESC[D Move/scroll window up one line
'' ESCL Move/scroll window up one line (undocumented)
'' ESC[L Move/scroll window up one line (undocumented)
'' ESCM Move/scroll window down one line
'' ESCK Clear line from cursor right
'' ESC[0K Clear line from cursor right
'' ESC[1K Clear line from cursor left
'' ESC[2K Clear entire line
'' ESC[J Clear screen from cursor down
'' ESC[0J Clear screen from cursor down
'' ESC[1J Clear screen from cursor up
'' ESC[2J Clear entire screen
'' ESC[0c Terminal ID responds with [?1;0c for VT-100 no options
'' ESC[c Terminal ID responds with [?1;0c for VT-100 no options
'' Esc[value@ Insert one character
'' Esc[valueP Delete one character
''
'' List of ignored codes
''
'' ESC[xxh All of the ESC[20h thru ESC[?9h commands
'' ESC[xxl All of the ESC[20i thru ESC[?9i commands
'' ESC= Alternate keypad mode
'' ESC< Enter/Exit ANSI mode
'' ESC> Exit Alternate keypad mode
'' Esc5n Device status report DSR
'' Esc0n Response: terminal is OK DSR
'' Esc3n Response: terminal is not OK DSR
'' Esc6n Get cursor position DSR
'' EscLine;ColumnR Response: cursor is at v,h CPR
'' Esc#8 Screen alignment display DECALN
'' Esc[2;1y Confidence power up test DECTST
'' Esc[2;2y Confidence loopback test DECTST
'' Esc[2;9y Repeat power up test DECTST
'' Esc[2;10y Repeat loopback test DECTST
'' Esc[0q Turn off all four leds DECLL0
'' Esc[1q Turn on LED #1 DECLL1
'' Esc[2q Turn on LED #2 DECLL2
'' Esc[3q Turn on LED #3 DECLL3
'' Esc[4q Turn on LED #4 DECLL4
'' IN DEVELOPMENT
' Please report any bugs to vbriel@yahoo.com
CON
_clkmode = xtal1 + pll16x
_xinfreq = 5_000_000
Cursor = 95
VideoCls = 0
NUM = %100
CAPS = %010
SCROLL = %001
RepeatRate = 40
video = 16
backspace = $C8
' semi = 59
' rowsnow = 36
' VT-100 values
'' Terminal Colors
TURQUOISE = $29
BLUE = $27
BABYBLUE = $95
RED = $C1
GREEN = $99
GOLDBROWN = $A2
AMBERDARK = $E2
LAVENDER = $A5
WHITE = $FF
HOTPINK = $C9
GOLD = $D9
PINK = $C5
r1 = 31 'PC serial port receive line
t1 = 30 'PC serial port transmit line
r2 = 25 'Host device receive line
t2 = 24 'Host device transmit line
EEPROMAddr = %1010_0000
EEPROM_Base = $7FE0
i2cSCL = 28
'' Sound Variables
right = 10
left = 11
OBJ
text: "VGA_1024v.905" ' VGA Terminal Driver
kb: "keyboard" ' Keyboard driver
ser: "FullDuplexSerial256" ' Full Duplex Serial Controller
ser2: "FullDuplexSerial2562" ' 2nd Full Duplex Serial Controller
i2c: "basic_i2c_driver"
VAR
word key
Byte Index
Byte Rx
Byte rxbyte
' Long Stack[100]
Byte temp
Byte serdata
Long Baud
Byte termcolor
Long BR[8]
Long CLR[11]
long i2cAddress, i2cSlaveCounter
Byte pcport
Byte ascii
Byte curset
word eepromLocation
Byte CR
Byte LNM
PUB main | i,j,k,remote,remote2,record,vt100,byte2,byte3,byte1,byte4,byte5,byte6,byte7,loop,var1,col,row,temp2,tempbaud,source
CTRA:= %00110 << 26 + 0<<9 + right
CTRB:= %00110 << 26 + 0<<9 + left
DIRA[right]~~ 'Set Right Pin to output
DIRA[left]~~ 'Set Left Pin to output
source:=@PIANO
LNM := 0 'CR only sent
i2c.Initialize(i2cSCL)
tempbaud:=4
CR := 0 '0= OFF 1 = CR AND LF
ascii := 0 '0=no 1=yes
pcport := 1 '1=pc port off, 2=on
termcolor:=5
curset := 5
BR[0]:=300
BR[1]:=1200
BR[2]:=2400
BR[3]:=4800
BR[4]:=9600
BR[5]:=19200
BR[6]:=38400
BR[7]:=57600
BR[8]:=115200
CLR[1]:=TURQUOISE
CLR[2]:=BLUE
CLR[3]:=BABYBLUE
CLR[4]:=RED
CLR[5]:=GREEN
CLR[6]:=GOLDBROWN
CLR[7]:=WHITE
CLR[8]:=HOTPINK
CLR[9]:=GOLD
CLR[10]:=PINK
CLR[11]:=AMBERDARK
'' Determine if previous settings are stored in EEPROM, if so, retrive for user
eepromLocation := EEPROM_Base 'Point i2c to EEPROM storage
temp2 := i2c.ReadByte(i2cSCL, EEPROMAddr, eepromLocation) 'read test byte to see if data stored
if temp2 == 55 'we have previously recorded settings, so restore them
eepromLocation +=4 'increase to next location
tempbaud := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read Baud as temp
eepromLocation +=4
termcolor := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read terminal color
eepromLocation +=4
pcport := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read pcport on/off setting
eepromLocation +=4
ascii := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read force 7bit setting
eepromLocation +=4
curset := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read cursor type
eepromLocation +=4
CR := i2c.ReadLong(i2cSCL, EEPROMAddr, eepromLocation) 'read CR W/LF ON/OFF
waitcnt(clkfreq/200 + cnt)
Baud:=BR[tempbaud]
text.start(video)
text.color(CLR[termcolor])
kb.startx(26, 27, NUM, RepeatRate) 'Start Keyboard Driver
ser.start(r1,t1,0,baud) 'Start Port2 to PC
ser2.start(r2,t2,0,baud) 'Start Port1 to main device
Baud:=tempbaud
text.cls(Baud,termcolor,pcport,ascii,CR)
' text.clsupdate(Baud,termcolor,pcport,ascii,CR)
text.inv(0)
text.cursorset(curset)
vt100:=0
repeat
key := kb.key 'Go get keystroke, then return here
if key == 194 'up arrow
ser2.str(string(27,"[A"))
if key == 195 'down arrow
ser2.str(string(27,"[B"))
'ser2.out($0A)
if key == 193 'right arrow
ser2.str(string(27,"[C"))
if key == 192 'left arrow
ser2.str(string(27,"[D"))
if key >576
if key <603
key:=key-576
if key > 608 and key < 635 'Is it a control character?
key:=key-608
'if key >0
' text.dec(key)
if key == 200
key:=08
if key == 203 'Is it upper code for ESC key?
key:= 27 'Yes, convert to standard ASCII value
if key == 720
Baud++ 'is ESC then + then increase baud or roll over
if Baud > 8
Baud:=0
temp:=Baud
Baud:=BR[temp]
ser.stop
ser2.stop
ser.start(r1,t1,0,baud) 'ready port for PC
ser2.start(r2,t2,0,baud) 'ready port for HOST
Baud:=temp
text.clsupdate(Baud,termcolor,pcport,ascii,CR)
EEPROM
if key == 721
if ++termcolor > 11
termcolor:=1
text.color(CLR[termcolor])
'text.clsupdate(Baud,termcolor,pcport,ascii)
EEPROM
if key == 722
if pcport == 1
pcport := 0
else
pcport := 1
text.clsupdate(Baud,termcolor,pcport,ascii,CR)
EEPROM
if key == 723
if ascii == 0
ascii := 1
else
ascii :=0
text.clsupdate(Baud,termcolor,pcport,ascii,CR)
EEPROM
if key == 724
curset++
if curset > 7
curset := 1
text.cursorset(curset)
EEPROM
if key == 725 'F6
if CR == 1
CR := 0
else
CR := 1
text.clsupdate(Baud,termcolor,pcport,ascii,CR)
EEPROM
if key <128 and key > 0 'Is the keystroke PocketTerm compatible? was 96
ser2.tx(key) 'Yes, so send it
if key == 13
'this probably needs to be if CR == 1
if LNM == 1 or CR == 1'send both CR and LF?
ser2.tx(10) 'yes, set by LNM ESC command, send LF also
'' END keyboard console routine
'LOOK FOR SERIAL INPUT HERE
if pcport == 0 'Is PC turned on at console for checking?
remote2 := ser.rxcheck 'Yes, look at the port for data
if (remote2 > -1) 'remote = -1 if no data
ser2.tx(remote2) 'Send the data out to the host device
waitcnt(clkfreq/200 + cnt) 'Added to attempt eliminate dropped characters
remote := ser2.rxcheck 'Look at host device port for data
if (remote > -1)
if ascii == 1 'yes force 7 bit ascii
if (remote > 127)
remote := remote -128
if pcport == 0
ser.tx(remote)
'Start of VT100 code
if remote == 27 'vt100 ESC code is being sent
vt100:=1
byte1:=0
byte2:=0
byte3:=0
byte4:=0
byte5:=0
byte6:=0
byte7:=0
remote:=0
temp2:=0 'Don't display the ESC code
if remote == 99 and vt100 == 1 'ESC c
remote:=0
vt100:=0
text.inv(0)
text.cls(Baud,termcolor,pcport,ascii,CR)
text.home
if remote == 61 and vt100 == 1 'lool for ESC=
vt100:= remote := 0
'put ESC D and ESC M here
if remote == 77 and vt100 == 1 'AKA ESC M
text.scrollM
vt100 := 0
if remote == 68 and vt100 == 1 'AKA ESC D
if byte2 <> 91 and byte3 <> 91 and byte4 <> 91 'not esc[D
'text.scrollD
vt100 := 0
if remote == 76 and vt100 == 1 'AKA ESC L
if remote == 91 and vt100 == 1 'look for open bracket [
vt100:=2 'start recording code
if remote == 62 and vt100 == 1 or remote == 60 and vt100 == 1 'look for < & >
vt100:=0 ' not sure why this is coming up, can't find in spec.
if vt100==2 ''Check checking for VT100 emulation codes
if remote > 10
byte7:=byte6
byte6:=byte5 ' My VTCode Mini Buffer
byte5:=byte4
byte4:=byte3
byte3:=byte2 'Record the last 7 bytes
byte2:=byte1
byte1:=remote
if remote == 109 'look for lowercase m
if byte2 == 91 'if [m turn off to normal set
text.inv(0)
vt100:=0
if byte2 == 49 and vt100 > 0 'is it ESC[1m BOLD
'text.inv(1)
vt100 := 0
if byte2 == 55 and vt100 > 0 'is it ESC[7m?
text.inv(1)
vt100 := 0
if byte2 == 48 and vt100 > 0 '0 is back to normal
text.inv(0)
vt100:=0
if byte2 == 52 and vt100 > 0 'is it ESC[4m underline?
vt100:=0 'yes ignore
if byte2 == 50 and vt100 >0 'is it ESC[2m dim text
vt100:=0 'yes ignore
if remote == 64 'look for ESC[value@ @=64 insert value spaces
if byte4 == 91 'two digit value
byte3:=byte3-48 'Grab 10's
byte2:=byte2-48 'Grab 1's
byte3:=byte3*10 'Multiply 10's
byte3:=byte3+byte2 'Add 1's
text.insertat(byte3)
if byte3 == 91 'single digit value
byte2:=byte2-48
text.insertat(byte2)
vt100 :=0
if remote == 80 'look for ESC[valueP P=64 delete value spaces
if byte4 == 91 'two digit value
byte3:=byte3-48 'Grab 10's
byte2:=byte2-48 'Grab 1's
byte3:=byte3*10 'Multiply 10's
byte3:=byte3+byte2 'Add 1's
text.delp(byte3)
if byte3 == 91 'single digit value
byte2:=byte2-48
text.delp(byte2)
vt100 :=0
if remote == 104 'look for lowercase h set CR/LF mode
if byte2 == 48 'if character before h is 0 maybe command is 20h
if byte3 == 50 'if byte3 then it is for sure 20h
LNM := 0
vt100:=0
if remote == 61 'lool for =
vt100:=0
if remote == 114 'look for lowercase r
vt100:=0
if remote == 108 'look for lowercase l
if byte2 == 48 'if character before l is 0 maybe command is 20l
if byte3 == 50 'if byte3 then it is for sure 20l
LNM := 1 '0 means CR/LF in CR mode only
vt100:=0
if remote == 62 'look for >
vt100:=0
if remote == 77 'ESC M look for obscure scroll window code
text.scrollM
vt100:=0
if remote == 68 or remote == 76 ' look for ESC D or ESC L
text.scrollD
vt100:=0
if remote == 72 or remote == 102 ' HOME CURSOR (uppercase H or lowercase f)
if byte2==91 or byte2==59 'look for [H or [;f
text.home
vt100:=0
'' Check for X & Y with [H or ;f - Esc[Line;ColumnH
else 'here remote is either H or f
if byte4 == 59 'is col is greater than 9 ; ALWAYS if byte4=59
byte3:=byte3-48 'Grab 10's
byte2:=byte2-48 'Grab 1's
byte3:=byte3*10 'Multiply 10's
byte3:=byte3+byte2 'Add 1's
col:=byte3 'Set cols
if byte7 == 91 'Assume row number is greater than 9 if ; at byte 4 and [ at byte 7 greater than 9
byte6:=byte6-48 'Grab 10's
byte5:=byte5-48 'Grab 1's
byte6:=byte6*10 'Multiply 10's
byte6:=byte6+byte5 'Add 1's
row:=byte6
if byte6 == 91 'Assume row number is less than 10
byte5:=byte5 - 48 'Grab 1's
row:=byte5
if byte3 == 59 ' Assume that col is less an 10
byte2:=byte2-48 'Grab 1's
col:=byte2 'set cols
if byte6 == 91 'Assume row number is greater than 9
byte5:=byte5-48 'Grab 10's
byte4:=byte4-48 'Grab 1's
byte5:=byte5*10 'Multiply 10's
byte5:=byte5+byte4 'Add 1's
row:=byte5
if byte5 == 91 'Assume that col is greater than 10
byte4:=byte4-48 'Grab 1's
row:=byte4
col:=col-1
if row == -459
row:=1
if col == -40 ' Patches a bug I havn't found. *yet*
col := 58 ' A Microsoft approach to the problem. :)
if row == -449
row := 2 ' Appears to be an issue with reading
if row == -439 ' single digit rows.
row := 3
if row == -429 ' This patch checks for the bug and replaces
row := 4 ' the faulty calculation.
if row == -419
row := 5 ' Add to list to find the source of bug later.
if row == -409
row := 6
if row == -399
row := 7
if row == -389
row := 8
if row == -379
row := 9
row--
if row < 0
row:=0
if col < 0
col:=0
if row > 35
row :=35
if col > 79
col := 79
text.cursloc(col,row)
vt100:=0
if remote == 114 'ESCr
text.out(126)
if remote == 74 '' CLEAR SCREEN
if byte2==91 '' look for [J '' clear screen from cursor to 25
text.clsfromcursordown
'vt100:=0
if byte2==50 '' look for [2J '' clear screen
text.cls(Baud,termcolor,pcport,ascii,CR)
if byte2==49 'look for [1J
text.clstocursor
if byte2==48 'look for [0J
text.clsfromcursordown
vt100:=0
if remote == 66 '' CURSOR DOWN Esc[ValueB
if byte4 == 91 '' Assume number over 10
byte3:=byte3-48
byte2:=byte2-48
byte3:=byte3*10
byte3:=byte3+byte2
var1:=byte3
if byte3 == 91 '' Assume number is less 10
byte2:=byte2-48
var1:=byte2
if byte2 == 91 ''ESC[B no numbers move down one
'text.out($C3)
var1 := 1
loop:=0
repeat until loop == var1
loop++
text.out($C3)
vt100:=0
if remote == 65 '' CURSOR UP Esc[ValueA
if byte4 == 91 '' Assume number over 10
byte3:=byte3-48
byte2:=byte2-48
byte3:=byte3*10
byte3:=byte3+byte2
var1:=byte3
if byte3 == 91 '' Assume number is less 10
byte2:=byte2-48
var1:=byte2
if byte2 == 91 ''ESC[A no numbers move down one
var1 := 1
loop:=0
repeat until loop == var1
text.out($C2)
loop++
vt100:=0
if remote == 67 '' CURSOR RIGHT Esc[ValueC
if byte4 == 91 '' Assume number over 10
byte3:=byte3-48
byte2:=byte2-48
byte3:=byte3*10
byte3:=byte3+byte2
var1:=byte3
if byte3 == 91 '' Assume number is less 10
byte2:=byte2-48
var1:=byte2
if byte2 == 91 ''ESC[C no numbers move RIGHT one
var1 := 1
loop:=0
repeat until loop == var1
text.out($C1)
loop++
vt100:=0
if remote == 68 '' CURSOR LEFT Esc[ValueD OR ESC[D
if byte4 == 91 '' Assume number over 10
byte3:=byte3-48
byte2:=byte2-48
byte3:=byte3*10
byte3:=byte3+byte2
var1:=byte3
if byte3 == 91 '' Assume number is less 10
byte2:=byte2-48
var1:=byte2
if byte2 == 91 ''ESC[D no numbers move LEFT one
var1 := 1
loop:=0
repeat until loop == var1
text.out($C0) 'was $C0
loop++
vt100:=0
if remote == 75 '' Clear line Esc[K
if byte2 == 91 '' Look for [
text.clearlinefromcursor
vt100:=0
if byte2 == 48 ' look for [0K
if byte3 == 91
text.clearlinefromcursor
vt100:=0
if byte2 == 49 ' look for [1K
if byte3 == 91
text.clearlinetocursor
vt100 := 0
if byte2 == 50 ' look for [2K
if byte3 == 91
text.clearline
vt100 := 0
if remote == 99 ' look for [0c or [c ESC [ ? 1 ; Ps c Ps=0 for VT-100 no options
if byte2 == 91 '' Look for [
ser2.str(string(27,"[?1;0c"))
vt100 := 0
if byte2 == 48
if byte3 == 91
ser2.str(string(27,"[?1;0c"))
vt100 := 0
remote:=0 '' hide all codes from the VGA output.
if record == 13 and remote == 13 ''LF CHECK
if CR == 1
text.out(remote)
remote :=0
if remote == 08
remote := $C0 'now backspace just moves cursor, doesn't clear character
if remote == 7
sound(source, 4500)
' if remote == 10
' text.out($0A)
if remote > 8
text.out(remote)
record:=remote ''record last byte
PUB EEPROM | eepromData
eepromLocation := EEPROM_Base
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, 55)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, Baud)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, termcolor)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, pcport)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, ascii)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, curset)
eepromLocation +=4
i2c.WriteLong(i2cSCL, EEPROMAddr, eepromLocation, CR)
waitcnt(clkfreq/200 + cnt)
PUB Sound (pWav,speed):bOK|n,i,nextCnt,rate,dcnt,wait
pWav+=44
i:=0
NextCnt:=cnt '+15000
'Play loop
repeat i from 0 to 1200
NextCnt+=speed
waitcnt(NextCnt)
FRQA:=(byte[pWav+i])<<24
FRQB:=FRQA
PUB forever | i
repeat i from 0 to 1000
waitcnt(i*32767)
DAT
PIANO
File "piano.wav" ' <--- put your 8-bit PCM mono 8000 sample/second WAV

View File

@ -0,0 +1,647 @@
'' VGA_1024.spin
''
'' MODIFIED BY VINCE BRIEL FOR POCKETERM FEATURES
'' MODIIFED BY JEFF LEDGER / AKA OLDBITCOLLECTOR
''
CON
cols = 128 '128 ' number of screen columns
rows = 64 '64 ' number of screen rows
chars = rows*cols ' number of screen characters
esc = $CB ' keyboard esc char
rowsnow = 36 ' adjusted for split screen effect
chars1 = rowsnow*cols ' adjusted value for split screen effect
cols1 = 81 ' adjusted value for 80th character
TURQUOISE = $29
OBJ
vga : "vga_Hires_Text"
VAR
byte screen[chars] ' screen character buffer
word colors[rows] ' color specs for each screen row (see ColorPtr description above)
byte cursor[6] ' cursor info array (see CursorPtr description above)
long sync, loc, xloc, yloc ' sync used by VGA routine, others are local screen pointers
long kbdreq ' global val of kbdflag
long BR[8]
long Brate
byte inverse
byte invs
PUB start(BasePin) | i, char
''start vga
vga.start(BasePin, @screen, @colors, @cursor, @sync)
waitcnt(clkfreq * 1 + cnt) 'wait 1 second for cogs to start
''init screen colors to gold on blue
repeat i from 0 to rows - 1
colors[i] := $08F0 '$2804 (if you want cyan on blue)
''init cursor attributes
cursor[2] := %110 ' init cursor to underscore with slow blink
BR[0]:=300
BR[1]:=1200
BR[2]:=2400
BR[3]:=4800
BR[4]:=9600
BR[5]:=19200
BR[6]:=38400
BR[7]:=57600
BR[8]:=115200
xloc := cursor[0] := 0
yloc := cursor[1] := 0
loc := xloc + yloc*cols
PUB inv(c)
inverse:=c
PUB cursorset(c) | i
i:=%000
if c == 1
i:= %001
if c == 2
i:= %010
if c == 3
i:= %011
if c == 4
i:= %101
if c == 5
i:= %110
if c == 6
i:= %111
if c == 7
i:= %000
cursor[2] := i
PUB bin(value, digits)
'' Print a binary number, specify number of digits
repeat while digits > 32
out("0")
digits--
value <<= 32 - digits
repeat digits
out((value <-= 1) & 1 + "0")
'PUB binFP(value) | bitnum, bit, bitval
'' Prints FP long in special Binary format: sign, exp, mantissa
' repeat bitnum from 31 to 0
' bit := 1 << bitnum ' create mask bit
' bitval := (bit & value) >> bitnum ' extract bit and shift back to bit 0
' bin(bitval, 1) ' display one bit
' case bitnum
' 27,20,16,12,8,4: out($20) ' space after every 4 in group
' 31,23: str(string(" ")) ' two after sign and exponent
PUB insertat(amount) | i,j,len
len := (cols - xloc) - amount
i := @screen 'starting location
i := i + loc
j := i + amount 'new location which is plus 1?
bytemove(j,i, len) ' move chars over one
bytefill(i, $20,amount)
PUB delp(amount) | i,j,len
len := (cols - xloc) - amount
i := @screen 'starting location
i := i + loc
j := i + amount 'new location which is plus 1?
bytemove(i,j, len) ' move chars over one
'bytefill(j, $20,amount)
PUB cls(c,screencolor,pcport,ascii,CR) | i,x,y
x :=xloc
y := yloc
invs := inverse
clrbtm(TURQUOISE)
longfill(@screen, $20202020, chars/4)
xloc := 0
yloc :=0
loc := xloc + yloc*cols
repeat 80
out(32)
xloc := 0
yloc :=36
loc := xloc + yloc*cols
inverse := 1
str(string(" 6502 SATCOM V1.2 "))
inverse := 0
str(string("Baud Rate: "))
i:= BR[c]
dec(i)
str(string(" "))
xloc := 18
loc := xloc + yloc*cols
str(string("Color "))
str(string("PC Port: "))
if pcport == 1
str(string("OFF "))
if pcport == 0
str(string("ON "))
str(string(" Force 7 bit: "))
if ascii == 0
str(string("NO "))
if ascii == 1
str(string("YES "))
str(string(" Cursor CR W/LF: "))
if CR == 1
str(string("YES"))
if CR == 0
str(string("NO "))
out(13)
out(10)
inverse:=1
xloc := 6
loc := xloc + yloc*cols
str(string("F1"))
xloc := 19
loc := xloc + yloc*cols
str(string("F2"))
xloc := 30
loc := xloc + yloc*cols
str(string("F3"))
xloc := 46
loc := xloc + yloc*cols
str(string("F4"))
xloc := 58
loc := xloc + yloc*cols
str(string("F5"))
xloc := 70
loc := xloc + yloc*cols
str(string("F6"))
inverse := invs
xloc := cursor[0] := x 'right & left was 0
yloc := cursor[1] := y 'from top was 1
loc := xloc + yloc*cols
PUB clsupdate(c,screencolor,PCPORT,ascii,CR) | i,x,y,locold
invs := inverse
locold := loc
x := xloc
y := yloc
clrbtm(TURQUOISE)
xloc := 0
yloc :=36
loc := xloc + yloc*cols
inverse := 1
str(string(" PockeTerm V.905 "))
inverse := 0
xloc := 0
yloc :=37
loc := xloc + yloc*cols
str(string("Baud Rate: "))
i:= BR[c]
dec(i)
str(string(" "))
xloc := 18
loc := xloc + yloc*cols
str(string("Color "))
str(string("PC Port: "))
if pcport == 1
str(string("OFF "))
if pcport == 0
str(string("ON "))
str(string(" Force 7 bit: "))
if ascii == 0
str(string("NO "))
if ascii == 1
str(string("YES "))
str(string(" Cursor CR W/LF: "))
if CR == 1
str(string("YES"))
if CR == 0
str(string("NO "))
xloc := 0
yloc :=38
loc := xloc + yloc*cols
inverse:=1
xloc := 6
loc := xloc + yloc*cols
str(string("F1"))
xloc := 19
loc := xloc + yloc*cols
str(string("F2"))
xloc := 30
loc := xloc + yloc*cols
str(string("F3"))
xloc := 46
loc := xloc + yloc*cols
str(string("F4"))
xloc := 58
loc := xloc + yloc*cols
str(string("F5"))
xloc := 70
loc := xloc + yloc*cols
str(string("F6"))
inverse := invs
xloc := cursor[0] := x
yloc := cursor[1] := y
' loc := xloc + yloc*cols
loc := locold
PUB clearlinefromcursor | x,xx,y, loop
y := cursor[1] 'yloc
x := cursor[0] 'xloc
xx := cursor[0] 'xloc
repeat until xx == 80
out(32)
xx++
yloc := cursor[1] := y
xloc := cursor[0] := x
loc := xloc + yloc*cols
PUB clearlinetocursor | x,y,loop
x := xloc
xloc := loop := 0
loc := xloc + yloc*cols
repeat until loop == x
out(32)
loop++
xloc := x
loc := xloc + yloc*cols
PUB clearline | x,y
x := xloc
xloc := 0
loc := xloc + yloc*cols
repeat 80
out(32)
xloc := x
loc := xloc + yloc*cols
PUB clsfromcursordown | x,y,loop,i
x:=xloc
y:=yloc
i := rowsnow - y
i--
'xloc :=0
loop := 0
'loc := xloc + yloc*cols
repeat until xloc == 80
out(32)
xloc := 0
yloc++
loc := xloc + yloc*cols
loop := yloc
repeat until loop == rowsnow
str(string(" "))
loop++
xloc := cursor[0] := x
yloc := cursor[1] := y
loc := xloc + yloc*cols
PUB clstocursor | x,y,z,loop 'working correctly now
y := yloc
x := xloc
xloc :=0
loc := xloc + yloc*cols
repeat until xloc == x
out(32)
yloc := 0
z:=0
'repeat until z == y-1
repeat until z == y
yloc := z
xloc :=0
loc := xloc + yloc*cols
str(string(" "))
z:= z + 1
' yloc--
' repeat until yloc <= 0
' xloc :=0
' loc := xloc + yloc*cols
' repeat 80
' out(65)
' yloc--
' xloc := 0
' loc := xloc + yloc*cols
' repeat 80
' out(32)
xloc := cursor[0] := x
yloc := cursor[1] := y
loc := xloc + yloc*cols
PUB home
xloc := cursor[0] := 0 'right & left
yloc := cursor[1] := 0 'from top 'was 1
loc := xloc + yloc*cols
PUB color(ColorVal) | i
''reset screen colors
repeat i from 0 to rowsnow - 1
colors[i] := $0000 + ColorVal
PUB clrbtm(ColorVal) | i
repeat i from 36 to rows - 1 'was 35
colors[i] := $0000 + ColorVal
PUB rowcolor(ColorVal, row)
'' reset row color to colorval
if row > rows-1
row := rows-1
colors[row] := $0000 + ColorVal
PUB cursloc(x, y)
'' move cursor to x, y position
'my code fix for y axis 1 is actually 0
' y--
xloc := cursor[0] := x
yloc := cursor[1] := y
loc := xloc + yloc*cols
PUB cursrow(y)
'' move cursor to y position
' xloc := cursor[0] := x
yloc := cursor[1] := y
loc := xloc + yloc*cols
PUB dec(value) | i
'' Print a decimal number
if value < 0
-value
out("-")
i := 1_000_000_000
repeat 10
if value => i
out(value/i + "0")
value //= i
result~~
elseif result or i == 1
out("0")
i /= 10
PUB hex(value, digits)
'' Print a hexadecimal number, specify number of digits
repeat while digits > 8
out("0")
digits--
value <<= (8 - digits) << 2
repeat digits
out(lookupz((value <-= 4) & $f : "0".."9", "A".."F"))
PUB scrollD | i,len,y,dest,source
y := yloc * cols
i := @screen
dest := i + y
source := dest + cols
len := (chars1-y-80)/4
longmove(source, dest, len)
longfill(dest,$20202020, cols/4)
PUB scrollM | i,y,dest,source,len
'longmove(dest,source,length)
y := yloc * cols
i := @screen
dest := i + y
'len := (chars1-y)/4
len := (chars1-y-80)/4
source := dest + cols
longmove(dest,source,len)
PRI newline | i, j, len
if ++yloc == rowsnow ' if last line on screen, shift all up was just rows now says rowsnow
yloc-- ' reset yloc it at bottom of screen
i := @screen
i += cols
len := (chars1 - cols)/4 'was chars now rowsnow*cols (rowsnow*cols)
longmove(@screen, i, len) ' shift screen up one line
i := @screen
i += ((rowsnow*cols) - cols) ' set "i" for use below WAS CHARS NOW ROWSNOW*COLS
else ' if not last line, shift lines down
i := @screen
i += (rowsnow - 2)*cols ' init ptr to start of next-to-last line was -2 now -1
'if yloc < rows - 1
' repeat j from rows - 2 to yloc
' longmove(i + cols, i, cols/4) ' shift one line down
' i -= cols ' move i up one line
i += cols ' point to start of last line moved
longfill(i, $20202020, cols/4) ' clear the last line moved
j := i - cols + xloc ' point to original cursor location
bytemove(i, j, cols - xloc) ' move chars from cursor pos down to start of next line
bytefill(j, $20, cols - xloc) ' clear original part of line that was moved
xloc := cursor[0] := 0 ' reset xloc, loc and cursor position
cursor[1] := yloc
loc := yloc*cols
PRI linefeed | i, j, len
if ++yloc == rowsnow ' if last line on screen, shift all up was just rows now says rowsnow
yloc-- ' reset yloc it at bottom of screen
i := @screen
i += cols
len := (chars1 - cols)/4 'was chars now rowsnow*cols (rowsnow*cols)
longmove(@screen, i, len) ' shift screen up one line
i := @screen
i += ((rowsnow*cols) - cols) ' set "i" for use below WAS CHARS NOW ROWSNOW*COLS
else ' if not last line, shift lines down
i := @screen
i += (rowsnow - 2)*cols ' init ptr to start of next-to-last line was -2 now -1
i += cols ' point to start of last line moved
longfill(i, $20202020, cols/4) ' clear the last line moved
'j := i - cols + xloc ' point to original cursor location
j := i + xloc
bytemove(i, j, cols - xloc) ' move chars from cursor pos down to start of next line
bytefill(j, $20, cols - xloc) ' clear original part of line that was moved
cursor[1] := yloc
cursor[0] := xloc
loc := xloc + (yloc*cols)
PUB out(c) | i, j
'' Print a character
''
'' $09 = tab
'' $0A = Linefeed
'' $0D = return -> CR
'' $20..$7E = display character
'' $7F = skip
'' $C0 left arrow
'' $C1 = right arrow
'' $C2 = up arrow
'' $C3 = down arrow
'' $C4 = home key - go to beginning of line
'' $C5 = end key - go past last char on line
'' $C6 = page up key - skip this key
'' $C7 = page down key - skip this key
'' $C8 = backspace key
'' $C9 = delete key
'' $CA = insert key - skip this key
'' $CB = esc - skip this key
'' $CC = left arrow don't scroll up
case c
$09: ' tab command
repeat
out($C1) ' recursive call to out( )
while xloc & 7 ' tab to multiples of 8
'while xloc & 3 ' tab to multiples of 4
$0A:
linefeed
$0D: ' CR, return to start of line
if xloc
repeat
out($C0) ' recursive call to shift left until at leftmost edge
while xloc
$20..$7E: ' character
if inverse==1 'check for inverse character mode
c:=c + $80 'add for inverse
if ++xloc == cols1
xloc := xloc - 1
newline
xloc := cursor[0] := 1
screen[loc++] := c ' output the character
cursor[0] := xloc
cursor[1] := yloc
$C0: ' left arrow
if loc ' skip this if at upper left screen
loc--
if xloc
xloc--
else
xloc := cols - 1
yloc--
cursor[0] := xloc
cursor[1] := yloc
$C1: ' right arrow
if loc <> chars1 - 1 ' skip if at lower right of screen
loc++
if xloc <> cols - 1
xloc++
else
xloc := 0
yloc++
cursor[0] := xloc
cursor[1] := yloc
$C2: ' up arrow
if yloc ' skip if yloc at top of screen
yloc-- ' move yloc up one row
loc -= cols ' move loc var back one row
cursor[1] := yloc ' reset 'y' cursor position
$C3: ' down arrow
if yloc <> rowsnow - 1 ' skip if at bottom of screen
yloc++ ' move yloc dowm one row
loc += cols ' move loc var down one row
cursor[1] := yloc
$C4: ' home key - move to 1st char of line
xloc := cursor[0] := 0
loc := xloc + yloc*cols
$C5: ' end key - move to last char of line
if xloc <> cols - 1
repeat xloc from cols - 1 to 0
loc := xloc + yloc*cols
if screen[loc] <> $20 ' continue until first non-space char
if xloc <> cols - 1
xloc++ ' move past non-blank char
loc++
quit
cursor[0] := xloc ' loc is already reset from above
$C8: ' backspace
if loc ' skip if at upper left of screen
if xloc ' do 'else' if at start of line
xloc-- ' xloc left one space
loc--
i := @screen ' calculate
i += xloc + yloc*cols ' destination for shift left one
bytemove(i, i+1, cols - xloc - 1)
screen[cols - 1 + yloc*cols] := $20
else ' here if xloc == 0
if screen[loc-1] == $20 ' last char on prev line
yloc--
i := @screen ' calculate
i += loc - 1 ' destination for shift left one
repeat while screen[--loc] == $20
bytemove(i, i+1, cols) ' move one row's worth of chars
i-- ' dec "i" to correspond to --loc
screen[loc + cols] := $20 ' clear old char
if ++xloc == cols ' use xloc as counter here, 0..., don't move > 1 row
loc-- ' make as if loc had been bumped above B4 we quit
quit
loc++ ' bump loc to space char
xloc := loc - yloc*cols ' re-calculate xloc from loc and yloc
cursor[0] := xloc ' reset cursor loc
cursor[1] := yloc
$C9: ' delete
if xloc == cols - 1
screen[loc] := $20 ' if at last char on line, clear it and exit
else
repeat i from xloc to cols - 2
j := i + yloc*cols
screen[j] := screen[j+1]
screen[j+1] := $20 ' clear last char on line after shift left
PUB str(string_ptr)
'' Print a zero terminated string
repeat strsize(string_ptr)
out(byte[string_ptr++])

Binary file not shown.

Binary file not shown.