KevinMidboe/linguist
1
0
Fork 0
mirror of https://github.com/KevinMidboe/linguist.git synced 2025-12-08 12:28:47 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge pull request #988 from lamestation/master

Browse Source 
Added Propeller Spin language to languages.yml
This commit is contained in:
Arfon Smith
2014-05-05 22:11:06 -04:00
parent 658bf98b4c 8118546ac7
commit e9ff0f4998
11 changed files with 5431 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
lib/linguist/languages.yml
View File

@@ -1617,6 +1617,13 @@ Prolog:
- .ecl
- .pl
Propeller Spin:
type: programming
lexer: Text only
color: "#2b446d"
extensions:
- .spin
Protocol Buffer:
type: markup
aliases:

97
samples/Propeller Spin/4x4 Keypad Reader.spin Normal file
View File

@@ -0,0 +1,97 @@
{{
*****************************************
* 4x4 Keypad Reader v1.0 *
* Author: Beau Schwabe *
* Copyright (c) 2007 Parallax *
* See end of file for terms of use. *
*****************************************
}}
{
Operation:
This object uses a capacitive PIN approach to reading the keypad.
To do so, ALL pins are made LOW and an OUTPUT to "discharge" the
I/O pins. Then, ALL pins are set to an INPUT state. At this point,
only one pin is made HIGH and an OUTPUT at a time. If the "switch"
is closed, then a HIGH will be read on the input, otherwise a LOW
will be returned.
The keypad decoding routine only requires two subroutines and returns
the entire 4x4 keypad matrix into a single WORD variable indicating
which buttons are pressed. Multiple button presses are allowed with
the understanding that“BOX entries can be confused. An example of a
BOX entry... 1,2,4,5 or 1,4,3,6 or 4,6,*,# etc. where any 3 of the 4
buttons pressed will evaluate the non pressed button as being pressed,
even when they are not. There is no danger of any physical or
electrical damage, that s just the way this sensing method happens to
work.
Schematic:
No resistors, No capacitors. The connections are directly from the
keypad to the I/O's. I literally plugged mine right into the demo
board RevC.
Looking at the Back of the 4x4 keypad...
P7 P0
││││││││
┌─────── ││││││││ ───────┐
│ oo ││││││││ o │
│ │
│ O O O O O │
│ │
│ O O O O O │
│ {LABEL} │
│ O O O O O │
│ │
│ O O O O O │
│ │
│ O O O O O │
│ o o │
└────────────────────────┘
}
VAR
word keypad
PUB ReadKeyPad
keypad := 0 'Clear 4x4 'keypad' value
ReadRow(3) 'Call routine to read entire ROW 0
keypad <<= 4 'Shift 'keypad' value left by 4
ReadRow(2) 'Call routine to read entire ROW 1
keypad <<= 4 'Shift 'keypad' value left by 4
ReadRow(1) 'Call routine to read entire ROW 2
keypad <<= 4 'Shift 'keypad' value left by 4
ReadRow(0) 'Call routine to read entire ROW 3
Result := keypad
PRI ReadRow(n)
outa[0..7]~ 'preset P0 to P7 as LOWs
dira[0..7]~~ 'make P0 to P7 OUTPUTs ... discharge pins or "capacitors" to VSS
dira[0..7]~ 'make P0 to P7 INPUTSs ... now the pins act like tiny capacitors
outa[n]~~ 'preset Pin 'n' HIGH
dira[n]~~ 'make Pin 'n' an OUTPUT... Make only one pin HIGH ; will charge
' "capacitor" if switch is closed.
'
keypad += ina[4..7] 'read ROW value ... If a switch is open, the pin or "capacitor"
dira[n]~ 'make Pn an INPUT will remain discharged
DAT
{{
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ TERMS OF USE: MIT License │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation │
│files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, │
│modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software│
│is furnished to do so, subject to the following conditions: │
│ │
│The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.│
│ │
│THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE │
│WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR │
│COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, │
│ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}

181
samples/Propeller Spin/Debug_Lcd.spin Normal file
View File

@@ -0,0 +1,181 @@
''****************************************
''* Debug_Lcd v1.2 *
''* Authors: Jon Williams, Jeff Martin *
''* Copyright (c) 2006 Parallax, Inc. *
''* See end of file for terms of use. *
''****************************************
''
'' Debugging wrapper for Serial_Lcd object
''
'' v1.2 - March 26, 2008 - Updated by Jeff Martin to conform to Propeller object initialization standards.
'' v1.1 - April 29, 2006 - Updated by Jon Williams for consistency.
''
OBJ
lcd : "serial_lcd" ' driver for Parallax Serial LCD
num : "simple_numbers" ' number to string conversion
PUB init(pin, baud, lines) : okay
'' Initializes serial LCD object
'' -- returns true if all parameters okay
okay := lcd.init(pin, baud, lines)
PUB finalize
'' Finalizes lcd object -- frees the pin (floats)
lcd.finalize
PUB putc(txbyte)
'' Send a byte to the terminal
lcd.putc(txbyte)
PUB str(strAddr)
'' Print a zero-terminated string
lcd.str(strAddr)
PUB dec(value)
'' Print a signed decimal number
lcd.str(num.dec(value))
PUB decf(value, width)
'' Prints signed decimal value in space-padded, fixed-width field
lcd.str(num.decf(value, width))
PUB decx(value, digits)
'' Prints zero-padded, signed-decimal string
'' -- if value is negative, field width is digits+1
lcd.str(num.decx(value, digits))
PUB hex(value, digits)
'' Print a hexadecimal number
lcd.str(num.hex(value, digits))
PUB ihex(value, digits)
'' Print an indicated hexadecimal number
lcd.str(num.ihex(value, digits))
PUB bin(value, digits)
'' Print a binary number
lcd.str(num.bin(value, digits))
PUB ibin(value, digits)
'' Print an indicated (%) binary number
lcd.str(num.ibin(value, digits))
PUB cls
'' Clears LCD and moves cursor to home (0, 0) position
lcd.cls
PUB home
'' Moves cursor to 0, 0
lcd.home
PUB gotoxy(col, line)
'' Moves cursor to col/line
lcd.gotoxy(col, line)
PUB clrln(line)
'' Clears line
lcd.clrln(line)
PUB cursor(type)
'' Selects cursor type
'' 0 : cursor off, blink off
'' 1 : cursor off, blink on
'' 2 : cursor on, blink off
'' 3 : cursor on, blink on
lcd.cursor(type)
PUB display(status)
'' Controls display visibility; use display(false) to hide contents without clearing
if status
lcd.displayOn
else
lcd.displayOff
PUB custom(char, chrDataAddr)
'' Installs custom character map
'' -- chrDataAddr is address of 8-byte character definition array
lcd.custom(char, chrDataAddr)
PUB backLight(status)
'' Enable (true) or disable (false) LCD backlight
'' -- affects only backlit models
lcd.backLight(status)
{{
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ TERMS OF USE: MIT License │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation │
│files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, │
│modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software│
│is furnished to do so, subject to the following conditions: │
│ │
│The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.│
│ │
│THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE │
│WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR │
│COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, │
│ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}

1669
samples/Propeller Spin/Graphics.spin Normal file
View File

File diff suppressed because it is too large Load Diff

221
samples/Propeller Spin/Inductor.spin Normal file
View File

@@ -0,0 +1,221 @@
{{
*****************************************
* Inductive Sensor Demo v1.0 *
* Author: Beau Schwabe *
* Copyright (c) 2007 Parallax *
* See end of file for terms of use. *
*****************************************
Test Circuit:
10pF 100K 1M
FPin ───┳──┳── SDF(sigma-delta feedback)
│ ┣──── SDI(sigma-delta input)
L  100K
 
GND GND
Test Coils:
Wire used was the "Radio Shack Special" GREEN (about 27 gauge)
25T (Coke Can form) = 2.1MHz
15T (Coke Can form) = 3.9MHz
5T (Coke Can form) = 5.3MHz
50T (BIC pen form) = 3.2MHz
How does it work?
Note: The reported resonate frequency is NOT the actual resonate LC frequency. Instead it is where the voltage produced from
the LC circuit was clipped.
In the example circuit below:
C L
A ────┳──── GND
│
B
When you apply a small voltage at a specific frequency to an LC circuit (at point "A") that is at or near the resonate
frequency of LC, it is not uncommon to measure 10's or 100's of times the amount of voltage (at point "B") that you are
applying to the LC circuit. (at point "A")
In the "Test Circuit" above, point "B" passes through a diode which then basically feeds a divide by 2 voltage divider:
100K 100K
B ───┳── GND
│
C
...So in order see the sigma-delta ADC "clip" the frequency sweep result, the output from the LC circuit only needs
to generate about 6.6 Volts above ground. (0.6V drop across the diode, and since the ADC is only sensitive to about
3V, it works out to be about 6.6V after the voltage divider.)
A typical magnitude plot of a frequency sweep applied to an LC circuit might look something like this:
*
*
*
*
* *
* *
* *
* *
* *
***** *****
...With 'clipping' the pattern looks more like this:
X****
* *
* *
* *
***** *****
...The 'X' denotes the location of the reported resonate frequency. The reason this is slightly off is for
two reasons really. 1) lazy - I didn't want to fiddle with the voltage divider combo... adjusting so that the
"peak" was also where the ADC happened to "clip". 2) some benefit - When you apply a frequency to a tuned LC
circuit that's resonate frequency is the same as the applied frequency, the LC acts like a dead short. A
situation not exactly great for Propeller I/O's
Now that we have that out of the way, what happens next? How can we use this so called "coil" as a sensor?
If a frequency sweep is initially preformed to determine the resonate frequency clip point, then it just so
happens that adding additional "metal" (<- Does not need to be ferrous) causes the resonate frequency to shift
to a HIGHER frequency.
Once you determine the "clip" frequency and you use one of the available counters to constantly feed that
particular frequency back to the LC circuit, the resulting ADC output is proportional and somewhat linear when
metal objects are introduced to the coil.
Assume frequency increases from Left to Right. With a slight resonate shift to the right, the ADC reports a
lower "de-tuned" value because the voltage magnitude no longer "clips" at the reported resonate frequency.
Typical ranges are full scale between 65535 (no metal) and 0 (metal saturation)
X *****
* *
ADC reports value here --> * *
* *
***** *****
Slight shift to the right
I also made mention that the response is somewhat linear. As the LC resonance shifts and the ADC value begins
to lower, the slope is steepest near the "clip" point. Therefore, the slightest shift results in larger value
changes. Since the coil is actually the least sensitive to metal the further away it is (Law of squares) and
most sensitive to metal the closer it is, the resulting combination acts to linearize the output. I need to
point out that some LC combinations will exhibit plateaus and other anomalies caused by varying parasitic circuit
conditions that will affect the overall output, so a little bit of trial and error is necessary to get things
the way you want them.
}}
OBJ
Freq : "Synth"
ADC : "ADC"
gr : "graphics"
Num : "Numbers"
CON
FPin = 0
UpperFrequency = 6_000_000
LowerFrequency = 2_000_000
bitmap_base = $2000
display_base = $5000
VAR
long FMax, FTemp, FValue, Frequency
PUB demo
'start and setup graphics
gr.start
gr.setup(16, 12, 128, 96, bitmap_base)
FindResonateFrequency
DisplayInductorValue
PUB DisplayInductorValue | X
Freq.Synth("A", FPin, FValue)
repeat
ADC.SigmaDelta(@FTemp)
'**************************************** Graphics Option Start *********************************************
'clear bitmap
gr.clear
'draw text
gr.textmode(1,1,7,5)
gr.colorwidth(1,0)
gr.text(0,90,string("Inductive Propeller Sensor"))
gr.colorwidth(1,5)
X := (65535 - FTemp )*200/65535
gr.plot(-100+X,15)
gr.textmode(1,1,7,%0000)
gr.colorwidth(1,0)
gr.text(-100,-20,string("Resonate Frequency ="))
gr.text(35,-20,Num.ToStr(FValue,10))
gr.text(-100,-36,string("ADC Frequency Response ="))
gr.text(65,-36,Num.ToStr(FTemp,10))
'copy bitmap to display
gr.copy(display_base)
'**************************************** Graphics Option Finish *********************************************
PUB FindResonateFrequency | P
dira[FPin] := 1
FMax := 0
repeat Frequency from LowerFrequency to UpperFrequency step 1000
Freq.Synth("A", FPin, Frequency)
ADC.SigmaDelta(@FTemp)
if FTemp > FMax
FMax := FTemp
FValue := Frequency
'**************************************** Graphics Option Start *********************************************
P := (Frequency - LowerFrequency)*100/(UpperFrequency - LowerFrequency)
gr.colorwidth(1,5)
gr.plot(0,0)
gr.line(P,0)
gr.colorwidth(3,5)
gr.line(100,0)
gr.colorwidth(2,0)
gr.plot(P,(FTemp/1024)+10)
gr.colorwidth(0,1)
gr.plot(P+1,5)
gr.line(P+1,50)
gr.copy(display_base)
'**************************************** Graphics Option Finish *********************************************
DAT
{{
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ TERMS OF USE: MIT License │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation │
│files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, │
│modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software│
│is furnished to do so, subject to the following conditions: │
│ │
│The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.│
│ │
│THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE │
│WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR │
│COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, │
│ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}

736
samples/Propeller Spin/Keyboard.spin Normal file
View File

@@ -0,0 +1,736 @@
''***************************************
''* PS/2 Keyboard Driver v1.0.1 *
''* Author: Chip Gracey *
''* Copyright (c) 2004 Parallax, Inc. *
''* See end of file for terms of use. *
''***************************************
{-----------------REVISION HISTORY-----------------
v1.0.1 - Updated 6/15/2006 to work with Propeller Tool 0.96}
VAR
long cog
long par_tail 'key buffer tail read/write (19 contiguous longs)
long par_head 'key buffer head read-only
long par_present 'keyboard present read-only
long par_states[8] 'key states (256 bits) read-only
long par_keys[8] 'key buffer (16 words) read-only (also used to pass initial parameters)
PUB start(dpin, cpin) : okay
'' Start keyboard driver - starts a cog
'' returns false if no cog available
''
'' dpin = data signal on PS/2 jack
'' cpin = clock signal on PS/2 jack
''
'' use 100-ohm resistors between pins and jack
'' use 10K-ohm resistors to pull jack-side signals to VDD
'' connect jack-power to 5V, jack-gnd to VSS
''
'' all lock-keys will be enabled, NumLock will be initially 'on',
'' and auto-repeat will be set to 15cps with a delay of .5s
okay := startx(dpin, cpin, %0_000_100, %01_01000)
PUB startx(dpin, cpin, locks, auto) : okay
'' Like start, but allows you to specify lock settings and auto-repeat
''
'' locks = lock setup
'' bit 6 disallows shift-alphas (case set soley by CapsLock)
'' bits 5..3 disallow toggle of NumLock/CapsLock/ScrollLock state
'' bits 2..0 specify initial state of NumLock/CapsLock/ScrollLock
'' (eg. %0_001_100 = disallow ScrollLock, NumLock initially 'on')
''
'' auto = auto-repeat setup
'' bits 6..5 specify delay (0=.25s, 1=.5s, 2=.75s, 3=1s)
'' bits 4..0 specify repeat rate (0=30cps..31=2cps)
'' (eg %01_00000 = .5s delay, 30cps repeat)
stop
longmove(@par_keys, @dpin, 4)
okay := cog := cognew(@entry, @par_tail) + 1
PUB stop
'' Stop keyboard driver - frees a cog
if cog
cogstop(cog~ - 1)
longfill(@par_tail, 0, 19)
PUB present : truefalse
'' Check if keyboard present - valid ~2s after start
'' returns t|f
truefalse := -par_present
PUB key : keycode
'' Get key (never waits)
'' returns key (0 if buffer empty)
if par_tail <> par_head
keycode := par_keys.word[par_tail]
par_tail := ++par_tail & $F
PUB getkey : keycode
'' Get next key (may wait for keypress)
'' returns key
repeat until (keycode := key)
PUB newkey : keycode
'' Clear buffer and get new key (always waits for keypress)
'' returns key
par_tail := par_head
keycode := getkey
PUB gotkey : truefalse
'' Check if any key in buffer
'' returns t|f
truefalse := par_tail <> par_head
PUB clearkeys
'' Clear key buffer
par_tail := par_head
PUB keystate(k) : state
'' Get the state of a particular key
'' returns t|f
state := -(par_states[k >> 5] >> k & 1)
DAT
'******************************************
'* Assembly language PS/2 keyboard driver *
'******************************************
org
'
'
' Entry
'
entry movd :par,#_dpin 'load input parameters _dpin/_cpin/_locks/_auto
mov x,par
add x,#11*4
mov y,#4
:par rdlong 0,x
add :par,dlsb
add x,#4
djnz y,#:par
mov dmask,#1 'set pin masks
shl dmask,_dpin
mov cmask,#1
shl cmask,_cpin
test _dpin,#$20 wc 'modify port registers within code
muxc _d1,dlsb
muxc _d2,dlsb
muxc _d3,#1
muxc _d4,#1
test _cpin,#$20 wc
muxc _c1,dlsb
muxc _c2,dlsb
muxc _c3,#1
mov _head,#0 'reset output parameter _head
'
'
' Reset keyboard
'
reset mov dira,#0 'reset directions
mov dirb,#0
movd :par,#_present 'reset output parameters _present/_states[8]
mov x,#1+8
:par mov 0,#0
add :par,dlsb
djnz x,#:par
mov stat,#8 'set reset flag
'
'
' Update parameters
'
update movd :par,#_head 'update output parameters _head/_present/_states[8]
mov x,par
add x,#1*4
mov y,#1+1+8
:par wrlong 0,x
add :par,dlsb
add x,#4
djnz y,#:par
test stat,#8 wc 'if reset flag, transmit reset command
if_c mov data,#$FF
if_c call #transmit
'
'
' Get scancode
'
newcode mov stat,#0 'reset state
:same call #receive 'receive byte from keyboard
cmp data,#$83+1 wc 'scancode?
if_nc cmp data,#$AA wz 'powerup/reset?
if_nc_and_z jmp #configure
if_nc cmp data,#$E0 wz 'extended?
if_nc_and_z or stat,#1
if_nc_and_z jmp #:same
if_nc cmp data,#$F0 wz 'released?
if_nc_and_z or stat,#2
if_nc_and_z jmp #:same
if_nc jmp #newcode 'unknown, ignore
'
'
' Translate scancode and enter into buffer
'
test stat,#1 wc 'lookup code with extended flag
rcl data,#1
call #look
cmp data,#0 wz 'if unknown, ignore
if_z jmp #newcode
mov t,_states+6 'remember lock keys in _states
mov x,data 'set/clear key bit in _states
shr x,#5
add x,#_states
movd :reg,x
mov y,#1
shl y,data
test stat,#2 wc
:reg muxnc 0,y
if_nc cmpsub data,#$F0 wc 'if released or shift/ctrl/alt/win, done
if_c jmp #update
mov y,_states+7 'get shift/ctrl/alt/win bit pairs
shr y,#16
cmpsub data,#$E0 wc 'translate keypad, considering numlock
if_c test _locks,#%100 wz
if_c_and_z add data,#@keypad1-@table
if_c_and_nz add data,#@keypad2-@table
if_c call #look
if_c jmp #:flags
cmpsub data,#$DD wc 'handle scrlock/capslock/numlock
if_c mov x,#%001_000
if_c shl x,data
if_c andn x,_locks
if_c shr x,#3
if_c shr t,#29 'ignore auto-repeat
if_c andn x,t wz
if_c xor _locks,x
if_c add data,#$DD
if_c_and_nz or stat,#4 'if change, set configure flag to update leds
test y,#%11 wz 'get shift into nz
if_nz cmp data,#$60+1 wc 'check shift1
if_nz_and_c cmpsub data,#$5B wc
if_nz_and_c add data,#@shift1-@table
if_nz_and_c call #look
if_nz_and_c andn y,#%11
if_nz cmp data,#$3D+1 wc 'check shift2
if_nz_and_c cmpsub data,#$27 wc
if_nz_and_c add data,#@shift2-@table
if_nz_and_c call #look
if_nz_and_c andn y,#%11
test _locks,#%010 wc 'check shift-alpha, considering capslock
muxnc :shift,#$20
test _locks,#$40 wc
if_nz_and_nc xor :shift,#$20
cmp data,#"z"+1 wc
if_c cmpsub data,#"a" wc
:shift if_c add data,#"A"
if_c andn y,#%11
:flags ror data,#8 'add shift/ctrl/alt/win flags
mov x,#4 '+$100 if shift
:loop test y,#%11 wz '+$200 if ctrl
shr y,#2 '+$400 if alt
if_nz or data,#1 '+$800 if win
ror data,#1
djnz x,#:loop
rol data,#12
rdlong x,par 'if room in buffer and key valid, enter
sub x,#1
and x,#$F
cmp x,_head wz
if_nz test data,#$FF wz
if_nz mov x,par
if_nz add x,#11*4
if_nz add x,_head
if_nz add x,_head
if_nz wrword data,x
if_nz add _head,#1
if_nz and _head,#$F
test stat,#4 wc 'if not configure flag, done
if_nc jmp #update 'else configure to update leds
'
'
' Configure keyboard
'
configure mov data,#$F3 'set keyboard auto-repeat
call #transmit
mov data,_auto
and data,#%11_11111
call #transmit
mov data,#$ED 'set keyboard lock-leds
call #transmit
mov data,_locks
rev data,#-3 & $1F
test data,#%100 wc
rcl data,#1
and data,#%111
call #transmit
mov x,_locks 'insert locks into _states
and x,#%111
shl _states+7,#3
or _states+7,x
ror _states+7,#3
mov _present,#1 'set _present
jmp #update 'done
'
'
' Lookup byte in table
'
look ror data,#2 'perform lookup
movs :reg,data
add :reg,#table
shr data,#27
mov x,data
:reg mov data,0
shr data,x
jmp #rand 'isolate byte
'
'
' Transmit byte to keyboard
'
transmit
_c1 or dira,cmask 'pull clock low
movs napshr,#13 'hold clock for ~128us (must be >100us)
call #nap
_d1 or dira,dmask 'pull data low
movs napshr,#18 'hold data for ~4us
call #nap
_c2 xor dira,cmask 'release clock
test data,#$0FF wc 'append parity and stop bits to byte
muxnc data,#$100
or data,dlsb
mov x,#10 'ready 10 bits
transmit_bit call #wait_c0 'wait until clock low
shr data,#1 wc 'output data bit
_d2 muxnc dira,dmask
mov wcond,c1 'wait until clock high
call #wait
djnz x,#transmit_bit 'another bit?
mov wcond,c0d0 'wait until clock and data low
call #wait
mov wcond,c1d1 'wait until clock and data high
call #wait
call #receive_ack 'receive ack byte with timed wait
cmp data,#$FA wz 'if ack error, reset keyboard
if_nz jmp #reset
transmit_ret ret
'
'
' Receive byte from keyboard
'
receive test _cpin,#$20 wc 'wait indefinitely for initial clock low
waitpne cmask,cmask
receive_ack
mov x,#11 'ready 11 bits
receive_bit call #wait_c0 'wait until clock low
movs napshr,#16 'pause ~16us
call #nap
_d3 test dmask,ina wc 'input data bit
rcr data,#1
mov wcond,c1 'wait until clock high
call #wait
djnz x,#receive_bit 'another bit?
shr data,#22 'align byte
test data,#$1FF wc 'if parity error, reset keyboard
if_nc jmp #reset
rand and data,#$FF 'isolate byte
look_ret
receive_ack_ret
receive_ret ret
'
'
' Wait for clock/data to be in required state(s)
'
wait_c0 mov wcond,c0 '(wait until clock low)
wait mov y,tenms 'set timeout to 10ms
wloop movs napshr,#18 'nap ~4us
call #nap
_c3 test cmask,ina wc 'check required state(s)
_d4 test dmask,ina wz 'loop until got state(s) or timeout
wcond if_never djnz y,#wloop '(replaced with c0/c1/c0d0/c1d1)
tjz y,#reset 'if timeout, reset keyboard
wait_ret
wait_c0_ret ret
c0 if_c djnz y,#wloop '(if_never replacements)
c1 if_nc djnz y,#wloop
c0d0 if_c_or_nz djnz y,#wloop
c1d1 if_nc_or_z djnz y,#wloop
'
'
' Nap
'
nap rdlong t,#0 'get clkfreq
napshr shr t,#18/16/13 'shr scales time
min t,#3 'ensure waitcnt won't snag
add t,cnt 'add cnt to time
waitcnt t,#0 'wait until time elapses (nap)
nap_ret ret
'
'
' Initialized data
'
'
dlsb long 1 << 9
tenms long 10_000 / 4
'
'
' Lookup table
' ascii scan extkey regkey ()=keypad
'
table word $0000 '00
word $00D8 '01 F9
word $0000 '02
word $00D4 '03 F5
word $00D2 '04 F3
word $00D0 '05 F1
word $00D1 '06 F2
word $00DB '07 F12
word $0000 '08
word $00D9 '09 F10
word $00D7 '0A F8
word $00D5 '0B F6
word $00D3 '0C F4
word $0009 '0D Tab
word $0060 '0E `
word $0000 '0F
word $0000 '10
word $F5F4 '11 Alt-R Alt-L
word $00F0 '12 Shift-L
word $0000 '13
word $F3F2 '14 Ctrl-R Ctrl-L
word $0071 '15 q
word $0031 '16 1
word $0000 '17
word $0000 '18
word $0000 '19
word $007A '1A z
word $0073 '1B s
word $0061 '1C a
word $0077 '1D w
word $0032 '1E 2
word $F600 '1F Win-L
word $0000 '20
word $0063 '21 c
word $0078 '22 x
word $0064 '23 d
word $0065 '24 e
word $0034 '25 4
word $0033 '26 3
word $F700 '27 Win-R
word $0000 '28
word $0020 '29 Space
word $0076 '2A v
word $0066 '2B f
word $0074 '2C t
word $0072 '2D r
word $0035 '2E 5
word $CC00 '2F Apps
word $0000 '30
word $006E '31 n
word $0062 '32 b
word $0068 '33 h
word $0067 '34 g
word $0079 '35 y
word $0036 '36 6
word $CD00 '37 Power
word $0000 '38
word $0000 '39
word $006D '3A m
word $006A '3B j
word $0075 '3C u
word $0037 '3D 7
word $0038 '3E 8
word $CE00 '3F Sleep
word $0000 '40
word $002C '41 ,
word $006B '42 k
word $0069 '43 i
word $006F '44 o
word $0030 '45 0
word $0039 '46 9
word $0000 '47
word $0000 '48
word $002E '49 .
word $EF2F '4A (/) /
word $006C '4B l
word $003B '4C ;
word $0070 '4D p
word $002D '4E -
word $0000 '4F
word $0000 '50
word $0000 '51
word $0027 '52 '
word $0000 '53
word $005B '54 [
word $003D '55 =
word $0000 '56
word $0000 '57
word $00DE '58 CapsLock
word $00F1 '59 Shift-R
word $EB0D '5A (Enter) Enter
word $005D '5B ]
word $0000 '5C
word $005C '5D \
word $CF00 '5E WakeUp
word $0000 '5F
word $0000 '60
word $0000 '61
word $0000 '62
word $0000 '63
word $0000 '64
word $0000 '65
word $00C8 '66 BackSpace
word $0000 '67
word $0000 '68
word $C5E1 '69 End (1)
word $0000 '6A
word $C0E4 '6B Left (4)
word $C4E7 '6C Home (7)
word $0000 '6D
word $0000 '6E
word $0000 '6F
word $CAE0 '70 Insert (0)
word $C9EA '71 Delete (.)
word $C3E2 '72 Down (2)
word $00E5 '73 (5)
word $C1E6 '74 Right (6)
word $C2E8 '75 Up (8)
word $00CB '76 Esc
word $00DF '77 NumLock
word $00DA '78 F11
word $00EC '79 (+)
word $C7E3 '7A PageDn (3)
word $00ED '7B (-)
word $DCEE '7C PrScr (*)
word $C6E9 '7D PageUp (9)
word $00DD '7E ScrLock
word $0000 '7F
word $0000 '80
word $0000 '81
word $0000 '82
word $00D6 '83 F7
keypad1 byte $CA, $C5, $C3, $C7, $C0, 0, $C1, $C4, $C2, $C6, $C9, $0D, "+-*/"
keypad2 byte "0123456789.", $0D, "+-*/"
shift1 byte "{|}", 0, 0, "~"
shift2 byte $22, 0, 0, 0, 0, "<_>?)!@#$%^&*(", 0, ":", 0, "+"
'
'
' Uninitialized data
'
dmask res 1
cmask res 1
stat res 1
data res 1
x res 1
y res 1
t res 1
_head res 1 'write-only
_present res 1 'write-only
_states res 8 'write-only
_dpin res 1 'read-only at start
_cpin res 1 'read-only at start
_locks res 1 'read-only at start
_auto res 1 'read-only at start
''
''
'' _________
'' Key Codes
''
'' 00..DF = keypress and keystate
'' E0..FF = keystate only
''
''
'' 09 Tab
'' 0D Enter
'' 20 Space
'' 21 !
'' 22 "
'' 23 #
'' 24 $
'' 25 %
'' 26 &
'' 27 '
'' 28 (
'' 29 )
'' 2A *
'' 2B +
'' 2C ,
'' 2D -
'' 2E .
'' 2F /
'' 30 0..9
'' 3A :
'' 3B ;
'' 3C <
'' 3D =
'' 3E >
'' 3F ?
'' 40 @
'' 41..5A A..Z
'' 5B [
'' 5C \
'' 5D ]
'' 5E ^
'' 5F _
'' 60 `
'' 61..7A a..z
'' 7B {
'' 7C |
'' 7D }
'' 7E ~
''
'' 80-BF (future international character support)
''
'' C0 Left Arrow
'' C1 Right Arrow
'' C2 Up Arrow
'' C3 Down Arrow
'' C4 Home
'' C5 End
'' C6 Page Up
'' C7 Page Down
'' C8 Backspace
'' C9 Delete
'' CA Insert
'' CB Esc
'' CC Apps
'' CD Power
'' CE Sleep
'' CF Wakeup
''
'' D0..DB F1..F12
'' DC Print Screen
'' DD Scroll Lock
'' DE Caps Lock
'' DF Num Lock
''
'' E0..E9 Keypad 0..9
'' EA Keypad .
'' EB Keypad Enter
'' EC Keypad +
'' ED Keypad -
'' EE Keypad *
'' EF Keypad /
''
'' F0 Left Shift
'' F1 Right Shift
'' F2 Left Ctrl
'' F3 Right Ctrl
'' F4 Left Alt
'' F5 Right Alt
'' F6 Left Win
'' F7 Right Win
''
'' FD Scroll Lock State
'' FE Caps Lock State
'' FF Num Lock State
''
'' +100 if Shift
'' +200 if Ctrl
'' +400 if Alt
'' +800 if Win
''
'' eg. Ctrl-Alt-Delete = $6C9
''
''
'' Note: Driver will buffer up to 15 keystrokes, then ignore overflow.
{{
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ TERMS OF USE: MIT License │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation │
│files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, │
│modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software│
│is furnished to do so, subject to the following conditions: │
│ │
│The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.│
│ │
│THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE │
│WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR │
│COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, │
│ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}

711
samples/Propeller Spin/TV.spin Normal file
View File

@@ -0,0 +1,711 @@
''***************************************
''* TV Driver v1.1 *
''* Author: Chip Gracey *
''* Copyright (c) 2004 Parallax, Inc. *
''* See end of file for terms of use. *
''***************************************
' v1.0 - 01 May 2006 - original version
' v1.1 - 17 May 2006 - pixel tile size can now be 16 x 32 to enable more efficient
' character displays utilizing the internal font - see 'tv_mode'
CON
fntsc = 3_579_545 'NTSC color frequency
lntsc = 3640 'NTSC color cycles per line * 16
sntsc = 624 'NTSC color cycles per sync * 16
fpal = 4_433_618 'PAL color frequency
lpal = 4540 'PAL color cycles per line * 16
spal = 848 'PAL color cycles per sync * 16
paramcount = 14
colortable = $180 'start of colortable inside cog
VAR
long cog
PUB start(tvptr) : okay
'' Start TV driver - starts a cog
'' returns false if no cog available
''
'' tvptr = pointer to TV parameters
stop
okay := cog := cognew(@entry, tvptr) + 1
PUB stop
'' Stop TV driver - frees a cog
if cog
cogstop(cog~ - 1)
DAT
'*******************************
'* Assembly language TV driver *
'*******************************
org
'
'
' Entry
'
entry mov taskptr,#tasks 'reset tasks
mov x,#10 'perform task sections initially
:init jmpret taskret,taskptr
djnz x,#:init
'
'
' Superfield
'
superfield mov taskptr,#tasks 'reset tasks
test _mode,#%0001 wc 'if ntsc, set phaseflip
if_nc mov phaseflip,phasemask
test _mode,#%0010 wz 'get interlace into nz
'
'
' Field
'
field mov x,vinv 'do invisible back porch lines
:black call #hsync 'do hsync
waitvid burst,sync_high2 'do black
jmpret taskret,taskptr 'call task section (z undisturbed)
djnz x,#:black 'another black line?
wrlong visible,par 'set status to visible
mov x,vb 'do visible back porch lines
call #blank_lines
mov screen,_screen 'point to first tile (upper-leftmost)
mov y,_vt 'set vertical tiles
:line mov vx,_vx 'set vertical expand
:vert if_z xor interlace,#1 'interlace skip?
if_z tjz interlace,#:skip
call #hsync 'do hsync
mov vscl,hb 'do visible back porch pixels
xor tile,colortable
waitvid tile,#0
mov x,_ht 'set horizontal tiles
mov vscl,hx 'set horizontal expand
:tile rdword tile,screen 'read tile
or tile,line 'set pointer bits into tile
rol tile,#6 'read tile pixels
rdlong pixels,tile '(2 instructions between reads)
shr tile,#10+6 'set tile colors
movs :color,tile
add screen,#2 'point to next tile
mov tile,phaseflip
:color xor tile,colortable
waitvid tile,pixels 'pass colors and pixels to video
djnz x,#:tile 'another tile?
sub screen,hc2x 'repoint to first tile in same line
mov vscl,hf 'do visible front porch pixels
mov tile,phaseflip
xor tile,colortable
waitvid tile,#0
:skip djnz vx,#:vert 'vertical expand?
ror line,linerot 'set next line
add line,lineadd wc
rol line,linerot
if_nc jmp #:line
add screen,hc2x 'point to first tile in next line
djnz y,#:line 'another tile line?
if_z xor interlace,#1 wz 'get interlace and field1 into z
test _mode,#%0001 wc 'do visible front porch lines
mov x,vf
if_nz_and_c add x,#1
call #blank_lines
if_nz wrlong invisible,par 'unless interlace and field1, set status to invisible
if_z_eq_c call #hsync 'if required, do short line
if_z_eq_c mov vscl,hrest
if_z_eq_c waitvid burst,sync_high2
if_z_eq_c xor phaseflip,phasemask
call #vsync_high 'do high vsync pulses
movs vsync1,#sync_low1 'do low vsync pulses
movs vsync2,#sync_low2
call #vsync_low
call #vsync_high 'do high vsync pulses
if_nz mov vscl,hhalf 'if odd frame, do half line
if_nz waitvid burst,sync_high2
if_z jmp #field 'if interlace and field1, display field2
jmp #superfield 'else, new superfield
'
'
' Blank lines
'
blank_lines call #hsync 'do hsync
xor tile,colortable 'do background
waitvid tile,#0
djnz x,#blank_lines
blank_lines_ret ret
'
'
' Horizontal sync
'
hsync test _mode,#%0001 wc 'if pal, toggle phaseflip
if_c xor phaseflip,phasemask
mov vscl,sync_scale1 'do hsync
mov tile,phaseflip
xor tile,burst
waitvid tile,sync_normal
mov vscl,hvis 'setup in case blank line
mov tile,phaseflip
hsync_ret ret
'
'
' Vertical sync
'
vsync_high movs vsync1,#sync_high1 'vertical sync
movs vsync2,#sync_high2
vsync_low mov x,vrep
vsyncx mov vscl,sync_scale1
vsync1 waitvid burst,sync_high1
mov vscl,sync_scale2
vsync2 waitvid burst,sync_high2
djnz x,#vsyncx
vsync_low_ret
vsync_high_ret ret
'
'
' Tasks - performed in sections during invisible back porch lines
'
tasks mov t1,par 'load parameters
movd :par,#_enable '(skip _status)
mov t2,#paramcount - 1
:load add t1,#4
:par rdlong 0,t1
add :par,d0
djnz t2,#:load '+119
mov t1,_pins 'set video pins and directions
test t1,#$08 wc
if_nc mov t2,pins0
if_c mov t2,pins1
test t1,#$40 wc
shr t1,#1
shl t1,#3
shr t2,t1
movs vcfg,t2
shr t1,#6
movd vcfg,t1
shl t1,#3
and t2,#$FF
shl t2,t1
if_nc mov dira,t2
if_nc mov dirb,#0
if_c mov dira,#0
if_c mov dirb,t2 '+18
tjz _enable,#disabled '+2, disabled?
jmpret taskptr,taskret '+1=140, break and return later
movs :rd,#wtab 'load ntsc/pal metrics from word table
movd :wr,#hvis
mov t1,#wtabx - wtab
test _mode,#%0001 wc
:rd mov t2,0
add :rd,#1
if_nc shl t2,#16
shr t2,#16
:wr mov 0,t2
add :wr,d0
djnz t1,#:rd '+54
if_nc movs :ltab,#ltab 'load ntsc/pal metrics from long table
if_c movs :ltab,#ltab+1
movd :ltab,#fcolor
mov t1,#(ltabx - ltab) >> 1
:ltab mov 0,0
add :ltab,d0s1
djnz t1,#:ltab '+17
rdlong t1,#0 'get CLKFREQ
shr t1,#1 'if CLKFREQ < 16MHz, cancel _broadcast
cmp t1,m8 wc
if_c mov _broadcast,#0
shr t1,#1 'if CLKFREQ < color frequency * 4, disable
cmp t1,fcolor wc
if_c jmp #disabled '+11
jmpret taskptr,taskret '+1=83, break and return later
mov t1,fcolor 'set ctra pll to fcolor * 16
call #divide 'if ntsc, set vco to fcolor * 32 (114.5454 MHz)
test _mode,#%0001 wc 'if pal, set vco to fcolor * 16 (70.9379 MHz)
if_c movi ctra,#%00001_111 'select fcolor * 16 output (ntsc=/2, pal=/1)
if_nc movi ctra,#%00001_110
if_nc shl t2,#1
mov frqa,t2 '+147
jmpret taskptr,taskret '+1=148, break and return later
mov t1,_broadcast 'set ctrb pll to _broadcast
mov t2,#0 'if 0, turn off ctrb
tjz t1,#:off
min t1,m8 'limit from 8MHz to 128MHz
max t1,m128
mov t2,#%00001_100 'adjust _broadcast to be within 4MHz-8MHz
:scale shr t1,#1 '(vco will be within 64MHz-128MHz)
cmp m8,t1 wc
if_c add t2,#%00000_001
if_c jmp #:scale
:off movi ctrb,t2
call #divide
mov frqb,t2 '+165
jmpret taskptr,taskret '+1=166, break and return later
mov t1,#%10100_000 'set video configuration
test _pins,#$01 wc '(swap broadcast/baseband output bits?)
if_c or t1,#%01000_000
test _mode,#%1000 wc '(strip chroma from broadcast?)
if_nc or t1,#%00010_000
test _mode,#%0100 wc '(strip chroma from baseband?)
if_nc or t1,#%00001_000
and _auralcog,#%111 '(set aural cog)
or t1,_auralcog
movi vcfg,t1 '+10
mov hx,_hx 'compute horizontal metrics
shl hx,#8
or hx,_hx
shl hx,#4
mov hc2x,_ht
shl hc2x,#1
mov t1,_ht
mov t2,_hx
call #multiply
mov hf,hvis
sub hf,t1
shr hf,#1 wc
mov hb,_ho
addx hb,hf
sub hf,_ho '+52
mov t1,_vt 'compute vertical metrics
mov t2,_vx
call #multiply
test _mode,#%10000 wc 'consider tile size
muxc linerot,#1
mov lineadd,lineinc
if_c shr lineadd,#1
if_c shl t1,#1
test _mode,#%0010 wc 'consider interlace
if_c shr t1,#1
mov vf,vvis
sub vf,t1
shr vf,#1 wc
neg vb,_vo
addx vb,vf
add vf,_vo '+53
xor _mode,#%0010 '+1, flip interlace bit for display
:colors jmpret taskptr,taskret '+1=117/160, break and return later
mov t1,#13 'load next 13 colors into colortable
:colorloop mov t2,:colorreg '5 times = 65 (all 64 colors loaded)
shr t2,#9-2
and t2,#$FC
add t2,_colors
:colorreg rdlong colortable,t2
add :colorreg,d0
andn :colorreg,d6
djnz t1,#:colorloop '+158
jmp #:colors '+1, keep loading colors
'
'
' Divide t1/CLKFREQ to get frqa or frqb value into t2
'
divide rdlong m1,#0 'get CLKFREQ
mov m2,#32+1
:loop cmpsub t1,m1 wc
rcl t2,#1
shl t1,#1
djnz m2,#:loop
divide_ret ret '+140
'
'
' Multiply t1 * t2 * 16 (t1, t2 = bytes)
'
multiply shl t2,#8+4-1
mov m1,#8
:loop shr t1,#1 wc
if_c add t1,t2
djnz m1,#:loop
multiply_ret ret '+37
'
'
' Disabled - reset status, nap ~4ms, try again
'
disabled mov ctra,#0 'reset ctra
mov ctrb,#0 'reset ctrb
mov vcfg,#0 'reset video
wrlong outa,par 'set status to disabled
rdlong t1,#0 'get CLKFREQ
shr t1,#8 'nap for ~4ms
min t1,#3
add t1,cnt
waitcnt t1,#0
jmp #entry 'reload parameters
'
'
' Initialized data
'
m8 long 8_000_000
m128 long 128_000_000
d0 long 1 << 9 << 0
d6 long 1 << 9 << 6
d0s1 long 1 << 9 << 0 + 1 << 1
interlace long 0
invisible long 1
visible long 2
phaseflip long $00000000
phasemask long $F0F0F0F0
line long $00060000
lineinc long $10000000
linerot long 0
pins0 long %11110000_01110000_00001111_00000111
pins1 long %11111111_11110111_01111111_01110111
sync_high1 long %0101010101010101010101_101010_0101
sync_high2 long %01010101010101010101010101010101 'used for black
sync_low1 long %1010101010101010101010101010_0101
sync_low2 long %01_101010101010101010101010101010
'
'
' NTSC/PAL metrics tables
' ntsc pal
' ----------------------------------------------
wtab word lntsc - sntsc, lpal - spal 'hvis
word lntsc / 2 - sntsc, lpal / 2 - spal 'hrest
word lntsc / 2, lpal / 2 'hhalf
word 243, 286 'vvis
word 10, 18 'vinv
word 6, 5 'vrep
word $02_8A, $02_AA 'burst
wtabx
ltab long fntsc 'fcolor
long fpal
long sntsc >> 4 << 12 + sntsc 'sync_scale1
long spal >> 4 << 12 + spal
long 67 << 12 + lntsc / 2 - sntsc 'sync_scale2
long 79 << 12 + lpal / 2 - spal
long %0101_00000000_01_10101010101010_0101 'sync_normal
long %010101_00000000_01_101010101010_0101
ltabx
'
'
' Uninitialized data
'
taskptr res 1 'tasks
taskret res 1
t1 res 1
t2 res 1
m1 res 1
m2 res 1
x res 1 'display
y res 1
hf res 1
hb res 1
vf res 1
vb res 1
hx res 1
vx res 1
hc2x res 1
screen res 1
tile res 1
pixels res 1
lineadd res 1
hvis res 1 'loaded from word table
hrest res 1
hhalf res 1
vvis res 1
vinv res 1
vrep res 1
burst res 1
fcolor res 1 'loaded from long table
sync_scale1 res 1
sync_scale2 res 1
sync_normal res 1
'
'
' Parameter buffer
'
_enable res 1 '0/non-0 read-only
_pins res 1 '%pppmmmm read-only
_mode res 1 '%tccip read-only
_screen res 1 '@word read-only
_colors res 1 '@long read-only
_ht res 1 '1+ read-only
_vt res 1 '1+ read-only
_hx res 1 '4+ read-only
_vx res 1 '1+ read-only
_ho res 1 '0+- read-only
_vo res 1 '0+- read-only
_broadcast res 1 '0+ read-only
_auralcog res 1 '0-7 read-only
fit colortable 'fit underneath colortable ($180-$1BF)
''
''___
''VAR 'TV parameters - 14 contiguous longs
''
'' long tv_status '0/1/2 = off/invisible/visible read-only
'' long tv_enable '0/non-0 = off/on write-only
'' long tv_pins '%pppmmmm = pin group, pin group mode write-only
'' long tv_mode '%tccip = tile,chroma,interlace,ntsc/pal write-only
'' long tv_screen 'pointer to screen (words) write-only
'' long tv_colors 'pointer to colors (longs) write-only
'' long tv_ht 'horizontal tiles write-only
'' long tv_vt 'vertical tiles write-only
'' long tv_hx 'horizontal tile expansion write-only
'' long tv_vx 'vertical tile expansion write-only
'' long tv_ho 'horizontal offset write-only
'' long tv_vo 'vertical offset write-only
'' long tv_broadcast 'broadcast frequency (Hz) write-only
'' long tv_auralcog 'aural fm cog write-only
''
''The preceding VAR section may be copied into your code.
''After setting variables, do start(@tv_status) to start driver.
''
''All parameters are reloaded each superframe, allowing you to make live
''changes. To minimize flicker, correlate changes with tv_status.
''
''Experimentation may be required to optimize some parameters.
''
''Parameter descriptions:
'' _________
'' tv_status
''
'' driver sets this to indicate status:
'' 0: driver disabled (tv_enable = 0 or CLKFREQ < requirement)
'' 1: currently outputting invisible sync data
'' 2: currently outputting visible screen data
'' _________
'' tv_enable
''
'' 0: disable (pins will be driven low, reduces power)
'' non-0: enable
'' _______
'' tv_pins
''
'' bits 6..4 select pin group:
'' %000: pins 7..0
'' %001: pins 15..8
'' %010: pins 23..16
'' %011: pins 31..24
'' %100: pins 39..32
'' %101: pins 47..40
'' %110: pins 55..48
'' %111: pins 63..56
''
'' bits 3..0 select pin group mode:
'' %0000: %0000_0111 - baseband
'' %0001: %0000_0111 - broadcast
'' %0010: %0000_1111 - baseband + chroma
'' %0011: %0000_1111 - broadcast + aural
'' %0100: %0111_0000 broadcast -
'' %0101: %0111_0000 baseband -
'' %0110: %1111_0000 broadcast + aural -
'' %0111: %1111_0000 baseband + chroma -
'' %1000: %0111_0111 broadcast baseband
'' %1001: %0111_0111 baseband broadcast
'' %1010: %0111_1111 broadcast baseband + chroma
'' %1011: %0111_1111 baseband broadcast + aural
'' %1100: %1111_0111 broadcast + aural baseband
'' %1101: %1111_0111 baseband + chroma broadcast
'' %1110: %1111_1111 broadcast + aural baseband + chroma
'' %1111: %1111_1111 baseband + chroma broadcast + aural
'' -----------------------------------------------------------
'' active pins top nibble bottom nibble
''
'' the baseband signal nibble is arranged as:
'' bit 3: chroma signal for s-video (attach via 560-ohm resistor)
'' bits 2..0: baseband video (sum 270/560/1100-ohm resistors to form 75-ohm 1V signal)
''
'' the broadcast signal nibble is arranged as:
'' bit 3: aural subcarrier (sum 560-ohm resistor into network below)
'' bits 2..0: visual carrier (sum 270/560/1100-ohm resistors to form 75-ohm 1V signal)
'' _______
'' tv_mode
''
'' bit 4 selects between 16x16 and 16x32 pixel tiles:
'' 0: 16x16 pixel tiles (tileheight = 16)
'' 1: 16x32 pixel tiles (tileheight = 32)
''
'' bit 3 controls chroma mixing into broadcast:
'' 0: mix chroma into broadcast (color)
'' 1: strip chroma from broadcast (black/white)
''
'' bit 2 controls chroma mixing into baseband:
'' 0: mix chroma into baseband (composite color)
'' 1: strip chroma from baseband (black/white or s-video)
''
'' bit 1 controls interlace:
'' 0: progressive scan (243 display lines for NTSC, 286 for PAL)
'' less flicker, good for motion
'' 1: interlaced scan (486 display lines for NTSC, 572 for PAL)
'' doubles the vertical display lines, good for text
''
'' bit 0 selects NTSC or PAL format
'' 0: NTSC
'' 3016 horizontal display ticks
'' 243 or 486 (interlaced) vertical display lines
'' CLKFREQ must be at least 14_318_180 (4 * 3_579_545 Hz)*
'' 1: PAL
'' 3692 horizontal display ticks
'' 286 or 572 (interlaced) vertical display lines
'' CLKFREQ must be at least 17_734_472 (4 * 4_433_618 Hz)*
''
'' * driver will disable itself while CLKFREQ is below requirement
'' _________
'' tv_screen
''
'' pointer to words which define screen contents (left-to-right, top-to-bottom)
'' number of words must be tv_ht * tv_vt
'' each word has two bitfields: a 6-bit colorset ptr and a 10-bit pixelgroup ptr
'' bits 15..10: select the colorset* for the associated pixel tile
'' bits 9..0: select the pixelgroup** address %ppppppppppcccc00 (p=address, c=0..15)
''
'' * colorsets are longs which each define four 8-bit colors
''
'' ** pixelgroups are <tileheight> longs which define (left-to-right, top-to-bottom) the 2-bit
'' (four color) pixels that make up a 16x16 or a 32x32 pixel tile
'' _________
'' tv_colors
''
'' pointer to longs which define colorsets
'' number of longs must be 1..64
'' each long has four 8-bit fields which define colors for 2-bit (four color) pixels
'' first long's bottom color is also used as the screen background color
'' 8-bit color fields are as follows:
'' bits 7..4: chroma data (0..15 = blue..green..red..)*
'' bit 3: controls chroma modulation (0=off, 1=on)
'' bits 2..0: 3-bit luminance level:
'' values 0..1: reserved for sync - don't use
'' values 2..7: valid luminance range, modulation adds/subtracts 1 (beware of 7)
'' value 0 may be modulated to produce a saturated color toggling between levels 1 and 7
''
'' * because of TV's limitations, it doesn't look good when chroma changes abruptly -
'' rather, use luminance - change chroma only against a black or white background for
'' best appearance
'' _____
'' tv_ht
''
'' horizontal number pixel tiles - must be at least 1
'' practical limit is 40 for NTSC, 50 for PAL
'' _____
'' tv_vt
''
'' vertical number of pixel tiles - must be at least 1
'' practical limit is 13 for NTSC, 15 for PAL (26/30 max for interlaced NTSC/PAL)
'' _____
'' tv_hx
''
'' horizontal tile expansion factor - must be at least 3 for NTSC, 4 for PAL
''
'' make sure 16 * tv_ht * tv_hx + ||tv_ho + 32 is less than the horizontal display ticks
'' _____
'' tv_vx
''
'' vertical tile expansion factor - must be at least 1
''
'' make sure <tileheight> * tv_vt * tv_vx + ||tv_vo + 1 is less than the display lines
'' _____
'' tv_ho
''
'' horizontal offset in ticks - pos/neg value (0 for centered image)
'' shifts the display right/left
'' _____
'' tv_vo
''
'' vertical offset in lines - pos/neg value (0 for centered image)
'' shifts the display up/down
'' ____________
'' tv_broadcast
''
'' broadcast frequency expressed in Hz (ie channel 2 is 55_250_000)
'' if 0, modulator is turned off - saves power
''
'' broadcasting requires CLKFREQ to be at least 16_000_000
'' while CLKFREQ is below 16_000_000, modulator will be turned off
'' ___________
'' tv_auralcog
''
'' selects cog to supply aural fm signal - 0..7
'' uses ctra pll output from selected cog
''
'' in NTSC, the offset frequency must be 4.5MHz and the max bandwidth +-25KHz
'' in PAL, the offset frequency and max bandwidth vary by PAL type
{{
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ TERMS OF USE: MIT License │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation │
│files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, │
│modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software│
│is furnished to do so, subject to the following conditions: │
│ │
│The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.│
│ │
│THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE │
│WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR │
│COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, │
│ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}

244
samples/Propeller Spin/TV_Terminal.spin Normal file
View File

@@ -0,0 +1,244 @@
''***************************************
''* TV Terminal v1.1 *
''* Author: Chip Gracey *
''* Copyright (c) 2005 Parallax, Inc. *
''* See end of file for terms of use. *
''***************************************
{-----------------REVISION HISTORY-----------------
v1.1 - Updated 5/15/2006 to use actual pin number, instead of pin group, for Start method's basepin parameter.}
CON
x_tiles = 16
y_tiles = 13
x_screen = x_tiles << 4
y_screen = y_tiles << 4
width = 0 '0 = minimum
x_scale = 1 '1 = minimum
y_scale = 1 '1 = minimum
x_spacing = 6 '6 = normal
y_spacing = 13 '13 = normal
x_chr = x_scale * x_spacing
y_chr = y_scale * y_spacing
y_offset = y_spacing / 6 + y_chr - 1
x_limit = x_screen / (x_scale * x_spacing)
y_limit = y_screen / (y_scale * y_spacing)
y_max = y_limit - 1
y_screen_bytes = y_screen << 2
y_scroll = y_chr << 2
y_scroll_longs = y_chr * y_max
y_clear = y_scroll_longs << 2
y_clear_longs = y_screen - y_scroll_longs
paramcount = 14
VAR
long x, y, bitmap_base
long tv_status '0/1/2 = off/visible/invisible read-only
long tv_enable '0/? = off/on write-only
long tv_pins '%ppmmm = pins write-only
long tv_mode '%ccinp = chroma,interlace,ntsc/pal,swap write-only
long tv_screen 'pointer to screen (words) write-only
long tv_colors 'pointer to colors (longs) write-only
long tv_hc 'horizontal cells write-only
long tv_vc 'vertical cells write-only
long tv_hx 'horizontal cell expansion write-only
long tv_vx 'vertical cell expansion write-only
long tv_ho 'horizontal offset write-only
long tv_vo 'vertical offset write-only
long tv_broadcast 'broadcast frequency (Hz) write-only
long tv_auralcog 'aural fm cog write-only
long bitmap[x_tiles * y_tiles << 4 + 16] 'add 16 longs to allow for 64-byte alignment
word screen[x_tiles * y_tiles]
OBJ
tv : "tv"
gr : "graphics"
PUB start(basepin)
'' Start terminal
''
'' basepin = first of three pins on a 4-pin boundary (0, 4, 8...) to have
'' 1.1k, 560, and 270 ohm resistors connected and summed to form the 1V,
'' 75 ohm DAC for baseband video
'init bitmap and tile screen
bitmap_base := (@bitmap + $3F) & $7FC0
repeat x from 0 to x_tiles - 1
repeat y from 0 to y_tiles - 1
screen[y * x_tiles + x] := bitmap_base >> 6 + y + x * y_tiles
'start tv
tvparams_pins := (basepin & $38) << 1 | (basepin & 4 == 4) & %0101
longmove(@tv_status, @tvparams, paramcount)
tv_screen := @screen
tv_colors := @color_schemes
tv.start(@tv_status)
'start graphics
gr.start
gr.setup(x_tiles, y_tiles, 0, y_screen, bitmap_base)
gr.textmode(x_scale, y_scale, x_spacing, 0)
gr.width(width)
out(0)
PUB stop
'' Stop terminal
tv.stop
gr.stop
PUB out(c)
'' Print a character
''
'' $00 = home
'' $01..$03 = color
'' $04..$07 = color schemes
'' $09 = tab
'' $0D = return
'' $20..$7E = character
case c
$00: 'home?
gr.clear
x := y := 0
$01..$03: 'color?
gr.color(c)
$04..$07: 'color scheme?
tv_colors := @color_schemes[c & 3]
$09: 'tab?
repeat
out($20)
while x & 7
$0D: 'return?
newline
$20..$7E: 'character?
gr.text(x * x_chr, -y * y_chr - y_offset, @c)
gr.finish
if ++x == x_limit
newline
PUB str(string_ptr)
'' Print a zero-terminated string
repeat strsize(string_ptr)
out(byte[string_ptr++])
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
value <<= (8 - digits) << 2
repeat digits
out(lookupz((value <-= 4) & $F : "0".."9", "A".."F"))
PUB bin(value, digits)
'' Print a binary number
value <<= 32 - digits
repeat digits
out((value <-= 1) & 1 + "0")
PRI newline
if ++y == y_limit
gr.finish
repeat x from 0 to x_tiles - 1
y := bitmap_base + x * y_screen_bytes
longmove(y, y + y_scroll, y_scroll_longs)
longfill(y + y_clear, 0, y_clear_longs)
y := y_max
x := 0
DAT
tvparams long 0 'status
long 1 'enable
tvparams_pins long %001_0101 'pins
long %0000 'mode
long 0 'screen
long 0 'colors
long x_tiles 'hc
long y_tiles 'vc
long 10 'hx
long 1 'vx
long 0 'ho
long 0 'vo
long 55_250_000 'broadcast
long 0 'auralcog
color_schemes long $BC_6C_05_02
long $0E_0D_0C_0A
long $6E_6D_6C_6A
long $BE_BD_BC_BA
{{
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ TERMS OF USE: MIT License │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation │
│files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, │
│modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software│
│is furnished to do so, subject to the following conditions: │
│ │
│The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.│
│ │
│THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE │
│WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR │
│COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, │
│ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}

232
samples/Propeller Spin/TV_Text.spin Normal file
View File

@@ -0,0 +1,232 @@
''***************************************
''* TV Text 40x13 v1.0 *
''* Author: Chip Gracey *
''* Copyright (c) 2006 Parallax, Inc. *
''* See end of file for terms of use. *
''***************************************
CON
cols = 40
rows = 13
screensize = cols * rows
lastrow = screensize - cols
tv_count = 14
VAR
long col, row, color, flag
word screen[screensize]
long colors[8 * 2]
long tv_status '0/1/2 = off/invisible/visible read-only (14 longs)
long tv_enable '0/non-0 = off/on write-only
long tv_pins '%pppmmmm = pin group, pin group mode write-only
long tv_mode '%tccip = tile,chroma,interlace,ntsc/pal write-only
long tv_screen 'pointer to screen (words) write-only
long tv_colors 'pointer to colors (longs) write-only
long tv_ht 'horizontal tiles write-only
long tv_vt 'vertical tiles write-only
long tv_hx 'horizontal tile expansion write-only
long tv_vx 'vertical tile expansion write-only
long tv_ho 'horizontal offset write-only
long tv_vo 'vertical offset write-only
long tv_broadcast 'broadcast frequency (Hz) write-only
long tv_auralcog 'aural fm cog write-only
OBJ
tv : "tv"
PUB start(basepin) : okay
'' Start terminal - starts a cog
'' returns false if no cog available
setcolors(@palette)
out(0)
longmove(@tv_status, @tv_params, tv_count)
tv_pins := (basepin & $38) << 1 | (basepin & 4 == 4) & %0101
tv_screen := @screen
tv_colors := @colors
okay := tv.start(@tv_status)
PUB stop
'' Stop terminal - frees a cog
tv.stop
PUB str(stringptr)
'' Print a zero-terminated string
repeat strsize(stringptr)
out(byte[stringptr++])
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
value <<= (8 - digits) << 2
repeat digits
out(lookupz((value <-= 4) & $F : "0".."9", "A".."F"))
PUB bin(value, digits)
'' Print a binary number
value <<= 32 - digits
repeat digits
out((value <-= 1) & 1 + "0")
PUB out(c) | i, k
'' Output a character
''
'' $00 = clear screen
'' $01 = home
'' $08 = backspace
'' $09 = tab (8 spaces per)
'' $0A = set X position (X follows)
'' $0B = set Y position (Y follows)
'' $0C = set color (color follows)
'' $0D = return
'' others = printable characters
case flag
$00: case c
$00: wordfill(@screen, $220, screensize)
col := row := 0
$01: col := row := 0
$08: if col
col--
$09: repeat
print(" ")
while col & 7
$0A..$0C: flag := c
return
$0D: newline
other: print(c)
$0A: col := c // cols
$0B: row := c // rows
$0C: color := c & 7
flag := 0
PUB setcolors(colorptr) | i, fore, back
'' Override default color palette
'' colorptr must point to a list of up to 8 colors
'' arranged as follows:
''
'' fore back
'' ------------
'' palette byte color, color 'color 0
'' byte color, color 'color 1
'' byte color, color 'color 2
'' ...
repeat i from 0 to 7
fore := byte[colorptr][i << 1]
back := byte[colorptr][i << 1 + 1]
colors[i << 1] := fore << 24 + back << 16 + fore << 8 + back
colors[i << 1 + 1] := fore << 24 + fore << 16 + back << 8 + back
PRI print(c)
screen[row * cols + col] := (color << 1 + c & 1) << 10 + $200 + c & $FE
if ++col == cols
newline
PRI newline | i
col := 0
if ++row == rows
row--
wordmove(@screen, @screen[cols], lastrow) 'scroll lines
wordfill(@screen[lastrow], $220, cols) 'clear new line
DAT
tv_params long 0 'status
long 1 'enable
long 0 'pins
long %10010 'mode
long 0 'screen
long 0 'colors
long cols 'hc
long rows 'vc
long 4 'hx
long 1 'vx
long 0 'ho
long 0 'vo
long 0 'broadcast
long 0 'auralcog
' fore back
' color color
palette byte $07, $0A '0 white / dark blue
byte $07, $BB '1 white / red
byte $9E, $9B '2 yellow / brown
byte $04, $07 '3 grey / white
byte $3D, $3B '4 cyan / dark cyan
byte $6B, $6E '5 green / gray-green
byte $BB, $CE '6 red / pink
byte $3C, $0A '7 cyan / blue
{{
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ TERMS OF USE: MIT License │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation │
│files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, │
│modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software│
│is furnished to do so, subject to the following conditions: │
│ │
│The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.│
│ │
│THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE │
│WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR │
│COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, │
│ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}

596
samples/Propeller Spin/VGA.spin Normal file
View File

@@ -0,0 +1,596 @@
''***************************************
''* VGA Driver v1.1 *
''* Author: Chip Gracey *
''* Copyright (c) 2006 Parallax, Inc. *
''* See end of file for terms of use. *
''***************************************
' v1.0 - 01 May 2006 - original version
' v1.1 - 15 May 2006 - pixel tile size can now be 16 x 32 to enable more efficient
' character displays utilizing the internal font - see 'vga_mode'
CON
paramcount = 21
colortable = $180 'start of colortable inside cog
VAR
long cog
PUB start(vgaptr) : okay
'' Start VGA driver - starts a cog
'' returns false if no cog available
''
'' vgaptr = pointer to VGA parameters
stop
okay := cog := cognew(@entry, vgaptr) + 1
PUB stop
'' Stop VGA driver - frees a cog
if cog
cogstop(cog~ - 1)
DAT
'********************************
'* Assembly language VGA driver *
'********************************
org
'
'
' Entry
'
entry mov taskptr,#tasks 'reset tasks
mov x,#8 'perform task sections initially
:init jmpret taskret,taskptr
djnz x,#:init
'
'
' Superfield
'
superfield mov hv,hvbase 'set hv
mov interlace,#0 'reset interlace
test _mode,#%0100 wz 'get interlace into nz
'
'
' Field
'
field wrlong visible,par 'set status to visible
tjz vb,#:nobl 'do any visible back porch lines
mov x,vb
movd bcolor,#colortable
call #blank_line
:nobl
mov screen,_screen 'point to first tile (upper-leftmost)
mov y,_vt 'set vertical tiles
:line mov vx,_vx 'set vertical expand
:vert if_nz xor interlace,#1 'interlace skip?
if_nz tjz interlace,#:skip
tjz hb,#:nobp 'do any visible back porch pixels
mov vscl,hb
waitvid colortable,#0
:nobp
mov x,_ht 'set horizontal tiles
mov vscl,hx 'set horizontal expand
:tile rdword tile,screen 'read tile
add tile,line 'set pointer bits into tile
rol tile,#6 'read tile pixels
rdlong pixels,tile '(8 clocks between reads)
shr tile,#10+6 'set tile colors
movd :color,tile
add screen,#2 'point to next tile
:color waitvid colortable,pixels 'pass colors and pixels to video
djnz x,#:tile 'another tile?
sub screen,hc2x 'repoint to first tile in same line
tjz hf,#:nofp 'do any visible front porch pixels
mov vscl,hf
waitvid colortable,#0
:nofp
mov x,#1 'do hsync
call #blank_hsync '(x=0)
:skip djnz vx,#:vert 'vertical expand?
ror line,linerot 'set next line
add line,lineadd wc
rol line,linerot
if_nc jmp #:line
add screen,hc2x 'point to first tile in next line
djnz y,#:line wc 'another tile line? (c=0)
tjz vf,#:nofl 'do any visible front porch lines
mov x,vf
movd bcolor,#colortable
call #blank_line
:nofl
if_nz xor interlace,#1 wc,wz 'get interlace and field1 into nz (c=0/?)
if_z wrlong invisible,par 'unless interlace and field1, set status to invisible
mov taskptr,#tasks 'reset tasks
addx x,_vf wc 'do invisible front porch lines (x=0 before, c=0 after)
call #blank_line
mov x,_vs 'do vsync lines
call #blank_vsync
mov x,_vb 'do invisible back porch lines, except last
call #blank_vsync
if_nz jmp #field 'if interlace and field1, display field2
jmp #superfield 'else, new superfield
'
'
' Blank line(s)
'
blank_vsync cmp interlace,#2 wc 'vsync (c=1)
blank_line mov vscl,h1 'blank line or vsync-interlace?
if_nc add vscl,h2
if_c_and_nz xor hv,#%01
if_c waitvid hv,#0
if_c mov vscl,h2 'blank line or vsync-normal?
if_c_and_z xor hv,#%01
bcolor waitvid hv,#0
if_nc jmpret taskret,taskptr 'call task section (z undisturbed)
blank_hsync mov vscl,_hf 'hsync, do invisible front porch pixels
waitvid hv,#0
mov vscl,_hs 'do invisble sync pixels
xor hv,#%10
waitvid hv,#0
mov vscl,_hb 'do invisible back porch pixels
xor hv,#%10
waitvid hv,#0
djnz x,#blank_line wc '(c=0)
movd bcolor,#hv
blank_hsync_ret
blank_line_ret
blank_vsync_ret ret
'
'
' Tasks - performed in sections during invisible back porch lines
'
tasks mov t1,par 'load parameters
movd :par,#_enable '(skip _status)
mov t2,#paramcount - 1
:load add t1,#4
:par rdlong 0,t1
add :par,d0
djnz t2,#:load '+164
mov t1,#2 'set video pins and directions
shl t1,_pins '(if video disabled, pins will drive low)
sub t1,#1
test _pins,#$20 wc
and _pins,#$38
shr t1,_pins
movs vcfg,t1
shl t1,_pins
shr _pins,#3
movd vcfg,_pins
if_nc mov dira,t1
if_nc mov dirb,#0
if_c mov dira,#0
if_c mov dirb,t1 '+14
tjz _enable,#disabled '+2, disabled?
jmpret taskptr,taskret '+1=181, break and return later
rdlong t1,#0 'make sure CLKFREQ => 16MHz
shr t1,#1
cmp t1,m8 wc
if_c jmp #disabled '+8
min _rate,pllmin 'limit _rate to pll range
max _rate,pllmax '+2
mov t1,#%00001_011 'set ctra configuration
:max cmp m8,_rate wc 'adjust rate to be within 4MHz-8MHz
if_c shr _rate,#1 '(vco will be within 64MHz-128MHz)
if_c add t1,#%00000_001
if_c jmp #:max
:min cmp _rate,m4 wc
if_c shl _rate,#1
if_c sub x,#%00000_001
if_c jmp #:min
movi ctra,t1 '+22
rdlong t1,#0 'divide _rate/CLKFREQ and set frqa
mov hvbase,#32+1
:div cmpsub _rate,t1 wc
rcl t2,#1
shl _rate,#1
djnz hvbase,#:div '(hvbase=0)
mov frqa,t2 '+136
test _mode,#%0001 wc 'make hvbase
muxnc hvbase,vmask
test _mode,#%0010 wc
muxnc hvbase,hmask '+4
jmpret taskptr,taskret '+1=173, break and return later
mov hx,_hx 'compute horizontal metrics
shl hx,#8
or hx,_hx
shl hx,#4
mov hc2x,_ht
shl hc2x,#1
mov h1,_hd
neg h2,_hf
sub h2,_hs
sub h2,_hb
sub h1,h2
shr h1,#1 wc
addx h2,h1
mov t1,_ht
mov t2,_hx
call #multiply
mov hf,_hd
sub hf,t1
shr hf,#1 wc
mov hb,_ho
addx hb,hf
sub hf,_ho '+59
mov t1,_vt 'compute vertical metrics
mov t2,_vx
call #multiply
test _mode,#%1000 wc 'consider tile size
muxc linerot,#1
mov lineadd,lineinc
if_c shr lineadd,#1
if_c shl t1,#1
test _mode,#%0100 wc 'consider interlace
if_c shr t1,#1
mov vf,_vd
sub vf,t1
shr vf,#1 wc
neg vb,_vo
addx vb,vf
add vf,_vo '+53
movi vcfg,#%01100_000 '+1, set video configuration
:colors jmpret taskptr,taskret '+1=114/160, break and return later
mov t1,#13 'load next 13 colors into colortable
:loop mov t2,:color '5 times = 65 (all 64 colors loaded)
shr t2,#9-2
and t2,#$FC
add t2,_colors
rdlong t2,t2
and t2,colormask
or t2,hvbase
:color mov colortable,t2
add :color,d0
andn :color,d6
djnz t1,#:loop '+158
jmp #:colors '+1, keep loading colors
'
'
' Multiply t1 * t2 * 16 (t1, t2 = bytes)
'
multiply shl t2,#8+4-1
mov tile,#8
:loop shr t1,#1 wc
if_c add t1,t2
djnz tile,#:loop
multiply_ret ret '+37
'
'
' Disabled - reset status, nap ~4ms, try again
'
disabled mov ctra,#0 'reset ctra
mov vcfg,#0 'reset video
wrlong outa,par 'set status to disabled
rdlong t1,#0 'get CLKFREQ
shr t1,#8 'nap for ~4ms
min t1,#3
add t1,cnt
waitcnt t1,#0
jmp #entry 'reload parameters
'
'
' Initialized data
'
pllmin long 500_000 'pll lowest output frequency
pllmax long 128_000_000 'pll highest output frequency
m8 long 8_000_000 '*16 = 128MHz (pll vco max)
m4 long 4_000_000 '*16 = 64MHz (pll vco min)
d0 long 1 << 9 << 0
d6 long 1 << 9 << 6
invisible long 1
visible long 2
line long $00060000
lineinc long $10000000
linerot long 0
vmask long $01010101
hmask long $02020202
colormask long $FCFCFCFC
'
'
' Uninitialized data
'
taskptr res 1 'tasks
taskret res 1
t1 res 1
t2 res 1
x res 1 'display
y res 1
hf res 1
hb res 1
vf res 1
vb res 1
hx res 1
vx res 1
hc2x res 1
screen res 1
tile res 1
pixels res 1
lineadd res 1
interlace res 1
hv res 1
hvbase res 1
h1 res 1
h2 res 1
'
'
' Parameter buffer
'
_enable res 1 '0/non-0 read-only
_pins res 1 '%pppttt read-only
_mode res 1 '%tihv read-only
_screen res 1 '@word read-only
_colors res 1 '@long read-only
_ht res 1 '1+ read-only
_vt res 1 '1+ read-only
_hx res 1 '1+ read-only
_vx res 1 '1+ read-only
_ho res 1 '0+- read-only
_vo res 1 '0+- read-only
_hd res 1 '1+ read-only
_hf res 1 '1+ read-only
_hs res 1 '1+ read-only
_hb res 1 '1+ read-only
_vd res 1 '1+ read-only
_vf res 1 '1+ read-only
_vs res 1 '1+ read-only
_vb res 1 '2+ read-only
_rate res 1 '500_000+ read-only
fit colortable 'fit underneath colortable ($180-$1BF)
''
''___
''VAR 'VGA parameters - 21 contiguous longs
''
'' long vga_status '0/1/2 = off/visible/invisible read-only
'' long vga_enable '0/non-0 = off/on write-only
'' long vga_pins '%pppttt = pins write-only
'' long vga_mode '%tihv = tile,interlace,hpol,vpol write-only
'' long vga_screen 'pointer to screen (words) write-only
'' long vga_colors 'pointer to colors (longs) write-only
'' long vga_ht 'horizontal tiles write-only
'' long vga_vt 'vertical tiles write-only
'' long vga_hx 'horizontal tile expansion write-only
'' long vga_vx 'vertical tile expansion write-only
'' long vga_ho 'horizontal offset write-only
'' long vga_vo 'vertical offset write-only
'' long vga_hd 'horizontal display ticks write-only
'' long vga_hf 'horizontal front porch ticks write-only
'' long vga_hs 'horizontal sync ticks write-only
'' long vga_hb 'horizontal back porch ticks write-only
'' long vga_vd 'vertical display lines write-only
'' long vga_vf 'vertical front porch lines write-only
'' long vga_vs 'vertical sync lines write-only
'' long vga_vb 'vertical back porch lines write-only
'' long vga_rate 'tick rate (Hz) write-only
''
''The preceding VAR section may be copied into your code.
''After setting variables, do start(@vga_status) to start driver.
''
''All parameters are reloaded each superframe, allowing you to make live
''changes. To minimize flicker, correlate changes with vga_status.
''
''Experimentation may be required to optimize some parameters.
''
''Parameter descriptions:
'' __________
'' vga_status
''
'' driver sets this to indicate status:
'' 0: driver disabled (vga_enable = 0 or CLKFREQ < 16MHz)
'' 1: currently outputting invisible sync data
'' 2: currently outputting visible screen data
'' __________
'' vga_enable
''
'' 0: disable (pins will be driven low, reduces power)
'' non-0: enable
'' ________
'' vga_pins
''
'' bits 5..3 select pin group:
'' %000: pins 7..0
'' %001: pins 15..8
'' %010: pins 23..16
'' %011: pins 31..24
'' %100: pins 39..32
'' %101: pins 47..40
'' %110: pins 55..48
'' %111: pins 63..56
''
'' bits 2..0 select top pin within group
'' for example: %01111 (15) will use pins %01000-%01111 (8-15)
'' ________
'' vga_mode
''
'' bit 3 selects between 16x16 and 16x32 pixel tiles:
'' 0: 16x16 pixel tiles (tileheight = 16)
'' 1: 16x32 pixel tiles (tileheight = 32)
''
'' bit 2 controls interlace:
'' 0: progressive scan (less flicker, good for motion, required for LCD monitors)
'' 1: interlaced scan (allows you to double vga_vt, good for text)
''
'' bits 1 and 0 select horizontal and vertical sync polarity, respectively
'' 0: active low
'' 1: active high
'' __________
'' vga_screen
''
'' pointer to words which define screen contents (left-to-right, top-to-bottom)
'' number of words must be vga_ht * vga_vt
'' each word has two bitfields: a 6-bit colorset ptr and a 10-bit pixelgroup ptr
'' bits 15..10: select the colorset* for the associated pixel tile
'' bits 9..0: select the pixelgroup** address %ppppppppppcccc00 (p=address, c=0..15)
''
'' * colorsets are longs which each define four 8-bit colors
''
'' ** pixelgroups are <tileheight> longs which define (left-to-right, top-to-bottom) the 2-bit
'' (four color) pixels that make up a 16x16 or a 16x32 pixel tile
'' __________
'' vga_colors
''
'' pointer to longs which define colorsets
'' number of longs must be 1..64
'' each long has four 8-bit fields which define colors for 2-bit (four color) pixels
'' first long's bottom color is also used as the screen background color
'' 8-bit color fields are as follows:
'' bits 7..2: actual state of pins 7..2 within pin group*
'' bits 1..0: don't care (used within driver for hsync and vsync)
''
'' * it is suggested that:
'' bits/pins 7..6 are used for red
'' bits/pins 5..4 are used for green
'' bits/pins 3..2 are used for blue
'' for each bit/pin set, sum 240 and 470-ohm resistors to form 75-ohm 1V signals
'' connect signal sets to RED, GREEN, and BLUE on VGA connector
'' always connect group pin 1 to HSYNC on VGA connector via 240-ohm resistor
'' always connect group pin 0 to VSYNC on VGA connector via 240-ohm resistor
'' ______
'' vga_ht
''
'' horizontal number of pixel tiles - must be at least 1
'' ______
'' vga_vt
''
'' vertical number of pixel tiles - must be at least 1
'' ______
'' vga_hx
''
'' horizontal tile expansion factor - must be at least 1
''
'' make sure 16 * vga_ht * vga_hx + ||vga_ho is equal to or at least 16 less than vga_hd
'' ______
'' vga_vx
''
'' vertical tile expansion factor - must be at least 1
''
'' make sure <tileheight> * vga_vt * vga_vx + ||vga_vo does not exceed vga_vd
'' (for interlace, use <tileheight> / 2 * vga_vt * vga_vx + ||vga_vo)
'' ______
'' vga_ho
''
'' horizontal offset in ticks - pos/neg value (0 recommended)
'' shifts the display right/left
'' ______
'' vga_vo
''
'' vertical offset in lines - pos/neg value (0 recommended)
'' shifts the display up/down
'' ______
'' vga_hd
''
'' horizontal display ticks
'' ______
'' vga_hf
''
'' horizontal front porch ticks
'' ______
'' vga_hs
''
'' horizontal sync ticks
'' ______
'' vga_hb
''
'' horizontal back porch ticks
'' ______
'' vga_vd
''
'' vertical display lines
'' ______
'' vga_vf
''
'' vertical front porch lines
'' ______
'' vga_vs
''
'' vertical sync lines
'' ______
'' vga_vb
''
'' vertical back porch lines
'' ________
'' vga_rate
''
'' tick rate in Hz
''
'' driver will limit value to be within 500KHz and 128MHz
'' pixel rate (vga_rate / vga_hx) should be no more than CLKFREQ / 4
{{
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ TERMS OF USE: MIT License │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation │
│files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, │
│modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software│
│is furnished to do so, subject to the following conditions: │
│ │
│The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.│
│ │
│THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE │
│WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR │
│COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, │
│ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}

737
samples/Propeller Spin/VocalTract.spin Normal file
View File

@@ -0,0 +1,737 @@
{{
┌───────────────────────────────────────────┬────────────────┬───────────────────────────────────┬─────────────────┐
│ Vocal Tract v1.1 │ by Chip Gracey │ Copyright (c) 2006 Parallax, Inc. │ 28 October 2006 │
├───────────────────────────────────────────┴────────────────┴───────────────────────────────────┴─────────────────┤
│ │
│ This object synthesizes a human vocal tract in real-time. It requires one cog and at least 80 MHz. │
│ │
│ The vocal tract is controlled via 13 single-byte parameters which must reside in the parent object: │
│ │
│ VAR byte aa,ga,gp,vp,vr,f1,f2,f3,f4,na,nf,fa,ff 'vocal tract parameters │
│ │
│ │
│ aa │
│ ┌────────────┐ │
│ │ ASPIRATION ├──┐ │
│ └────────────┘ │ f1 f2 f3 f4 na nf │
│  ┌────┐ ┌────┐ ┌────┐ ┌────┐ ┌───────┐ │
│ +┣──┤ F1 ├──┤ F2 ├──┤ F3 ├──┤ F4 ├──┤ NASAL ├──┐ │
│ ga gp  └────┘ └────┘ └────┘ └────┘ └───────┘ │ │
│ ┌─────────┐ │  │
│ │ GLOTTAL ├──┘ +┣── OUTPUT │
│ └────┬────┘ fa ff  │
│  ┌───────────┐ │ │
│ vp │ vr │ FRICATION ├──┘ │
│ ┌────┴────┐ └───────────┘ │
│ │ VIBRATO │ │
│ └─────────┘ │
│ │
│ │
│ ┌───────────┬──────────────────────┬─────────────┬────────────────────────────────────────────────┐ │
│ │ parameter │ description │ unit │ notes │ │
│ ├───────────┼──────────────────────┼─────────────┼────────────────────────────────────────────────┤ │
│ │ aa │ aspiration amplitude │ 0..255 │ breath volume: silent..loud, linear │ │
│ │ ga │ glottal amplitude │ 0..255 │ voice volume: silent..loud, linear │ │
│ │ gp │ glottal pitch │ 1/48 octave │ voice pitch: 100 ─ 110.00Hz (musical note A2) │ │
│ │ vp │ vibrato pitch │ 1/48 octave │ voice vibrato pitch: 48 ─ ± 1/2 octave swing │ │
│ │ vr │ vibrato rate │ 0.0763 Hz │ voice vibrato rate: 52 ─ 4 Hz │ │
│ │ f1 │ formant1 frequency │ 19.53 Hz │ 1st resonator frequency: 40 ─ 781 Hz │ │
│ │ f2 │ formant2 frequency │ 19.53 Hz │ 2nd resonator frequency: 56 ─ 1094 Hz │ │
│ │ f3 │ formant3 frequency │ 19.53 Hz │ 3rd resonator frequency: 128 ─ 2500 Hz │ │
│ │ f4 │ formant4 frequency │ 19.53 Hz │ 4th resonator frequency: 179 ─ 3496 Hz │ │
│ │ na │ nasal amplitude │ 0..255 │ anti-resonator level: off..on, linear │ │
│ │ nf │ nasal frequency │ 19.53 Hz │ anti-resonator frequency: 102 ─ 1992 Hz │ │
│ │ fa │ frication amplitude │ 0..255 │ white noise volume: silent..loud, linear │ │
│ │ ff │ frication frequency │ 39.06 Hz │ white noise frequency: 60 ─ 2344 Hz ("Sh") │ │
│ └───────────┴──────────────────────┴─────────────┴────────────────────────────────────────────────┘ │
│ │
│ The parent object alternately modifies one or more of these parameters and then calls the go(time) method to │
│ queue the entire 13-parameter frame for feeding to the vocal tract. The vocal tract will load one queued frame │
│ after another and smoothly interpolate between them over specified amounts of time without interruption. Up to │
│ eight frames will be queued in order to relax the frame-generation timing requirement of the parent object. If │
│ eight frames are queued, the parent must then wait to queue another frame. If the vocal tract runs out of │
│ frames, it will continue generating samples based on the last frame. When a new frame is queued, it will │
│ immediately load it and begin inter-polating towards it. │
│ │
│ The vocal tract generates audio samples at a continuous rate of 20KHz. These samples can be output to pins via │
│ delta-modulation for RC filtering or direct transducer driving. An FM aural subcarrier can also be generated for │
│ inclusion into a TV broadcast controlled by another cog. Regardless of any output mode, samples are always │
│ streamed into a special variable so that other objects can access them in real-time. │
│ │
│ In order to achieve optimal sound quality, it is worthwhile to maximize amplitudes such as 'ga' to the point │
│ just shy of numerical overflow. Numerical overflow results in high-amplitude noise bursts which are quite │
│ disruptive. The closeness of 'f1'-'f4' and their relationship to 'gp' can greatly influence the amount of 'ga' │
│ that can be applied before overflow occurs. You must determine through experimentation what the limits are. By │
│ pushing 'ga' close to the overflow point, you will maximize the signal-to-noise ratio of the vocal tract, │
│ resulting in the highest quality sound. Once your vocal tract programming is complete, the attenuation level │
│ can then be used to reduce the overall output in 3dB steps while preserving the signal-to-noise ratio. │
│ │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│ Revision History v1.0 released 26 October 2006 │
│ │
│ v1.1 If the vocal tract runs out of frames, its internal parameters will now be brought all the way to the │
│ last frame's values. Before, they were left one interpolation point shy, and then set to the last frame's │
│ values at the start of the next frame. For continuous frames this was trivial, but it posed a problem │
│ during frame gaps because the internal parameters would get stalled at transition points just shy of the │
│ last frame's values. This change makes the vocal tract behave more sensibly during frame gaps. │
│ │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}
CON
frame_buffers = 8 'frame buffers (2n)
frame_bytes = 3 {for stepsize} + 13 {for aa..ff} '16 bytes per frame
frame_longs = frame_bytes / 4 '4 longs per frame
frame_buffer_bytes = frame_bytes * frame_buffers
frame_buffer_longs = frame_longs * frame_buffers
VAR
long cog, tract, pace
long index, attenuation, sample '3 longs ...must
long dira_, dirb_, ctra_, ctrb_, frqa_, cnt_ '6 longs ...be
long frames[frame_buffer_longs] 'many longs ...contiguous
PUB start(tract_ptr, pos_pin, neg_pin, fm_offset) : okay
'' Start vocal tract driver - starts a cog
'' returns false if no cog available
''
'' tract_ptr = pointer to vocal tract parameters (13 bytes)
'' pos_pin = positive delta-modulation pin (-1 to disable)
'' neg_pin = negative delta-modulation pin (pos_pin must also be enabled, -1 to disable)
'' fm_offset = offset frequency for fm aural subcarrier generation (-1 to disable, 4_500_000 for NTSC)
'Reset driver
stop
'Remember vocal tract parameters pointer
tract := tract_ptr
'Initialize pace to 100%
pace := 100
'If delta-modulation pin(s) enabled, ready output(s) and ready ctrb for duty mode
if pos_pin > -1
dira_[pos_pin >> 5 & 1] |= |< pos_pin
ctrb_ := $18000000 + pos_pin & $3F
if neg_pin > -1
dira_[neg_pin >> 5 & 1] |= |< neg_pin
ctrb_ += $04000000 + (neg_pin & $3F) << 9
'If fm offset is valid, ready ctra for pll mode with divide-by-16 (else disabled)
if fm_offset > -1
ctra_ := $05800000
'Ready frqa value for fm offset
repeat 33
frqa_ <<= 1
if fm_offset => clkfreq
fm_offset -= clkfreq
frqa_++
fm_offset <<= 1
'Ready 20KHz sample period
cnt_ := clkfreq / 20_000
'Launch vocal tract cog
return cog := cognew(@entry, @attenuation) + 1
PUB stop
'' Stop vocal tract driver - frees a cog
'If already running, stop vocal tract cog
if cog
cogstop(cog~ - 1)
'Reset variables and buffers
longfill(@index, 0, constant(3 + 6 + frame_buffer_longs))
PUB set_attenuation(level)
'' Set master attenuation level (0..7, initially 0)
attenuation := level
PUB set_pace(percentage)
'' Set pace to some percentage (initially 100)
pace := percentage
PUB go(time)
'' Queue current parameters to transition over time
''
'' actual time = integer(time * 100 / pace) #> 2 * 700µs (at least 1400µs, see set_pace)
'Wait until frame available (first long will be zeroed)
repeat while frames[index]
'Load parameters into frame
bytemove(@frames[index] + 3, tract, 13)
'Write stepsize into frame (non-0 alerts vocal tract that frame is ready)
frames[index] |= $01000000 / (time * 100 / pace #> 2)
'Increment frame index
index := (index + frame_longs) & constant(frame_buffer_longs - 1)
PUB full : status
'' Returns true if the parameter queue is full
'' (useful for checking if "go" would have to wait)
return frames[index]
PUB empty : status | i
'' Returns true if the parameter queue is empty
'' (useful for detecting when the vocal tract is finished)
repeat i from 0 to constant(frame_buffers - 1)
if frames[i * frame_longs]
return {false}
return true
PUB sample_ptr : ptr
'' Returns the address of the long which receives the audio samples in real-time
'' (signed 32-bit values updated at 20KHz)
return @sample
PUB aural_id : id
'' Returns the id of the cog executing the vocal tract algorithm
'' (for connecting a broadcast tv driver with the aural subcarrier)
return cog - 1
DAT
' ┌──────────────────┐
' │ Initialization │
' └──────────────────┘
entry org
:zero mov reserves,#0 'zero all reserved data
add :zero,d0
djnz clear_cnt,#:zero
mov t1,#2*15 'assemble 15 multiply steps into reserves
:minst mov mult_steps,mult_step '(saves hub memory)
add :minst,d0s0
test t1,#1 wc
if_c sub :minst,#2
djnz t1,#:minst
mov mult_ret,antilog_ret 'write 'ret' after last instruction
mov t1,#13 'assemble 13 cordic steps into reserves
:cstep mov t2,#8 '(saves hub memory)
:cinst mov cordic_steps,cordic_step
add :cinst,d0s0
djnz t2,#:cinst
sub :cinst,#8
add cordic_dx,#1
add cordic_dy,#1
add cordic_a,#1
djnz t1,#:cstep
mov cordic_ret,antilog_ret 'write 'ret' over last instruction
mov t1,par 'get dira/dirb/ctra/ctrb
add t1,#2*4
mov t2,#4
:regs rdlong dira,t1
add t1,#4
add :regs,d0
djnz t2,#:regs
rdlong frqa_center,t1 'get frqa center
add t1,#4 'get cnt ticks
rdlong cnt_ticks,t1
mov cnt_value,cnt 'prepare for initial waitcnt
add cnt_value,cnt_ticks
' ┌────────────────────┐
' │ Vocal Tract Loop │
' └────────────────────┘
' Wait for next sample period, then output sample
loop waitcnt cnt_value,cnt_ticks 'wait for sample period
rdlong t1,par 'perform master attenuation
sar x,t1
mov t1,x 'update fm aural subcarrier for tv broadcast
sar t1,#10
add t1,frqa_center
mov frqa,t1
mov t1,x 'update duty cycle output for pin driving
add t1,h80000000
mov frqb,t1
mov t1,par 'update sample receiver in main memory
add t1,#1*4
wrlong x,t1
' White noise source
test lfsr,lfsr_taps wc 'iterate lfsr three times
rcl lfsr,#1
test lfsr,lfsr_taps wc
rcl lfsr,#1
test lfsr,lfsr_taps wc
rcl lfsr,#1
' Aspiration
mov t1,aa 'aspiration amplitude
mov t2,lfsr
call #mult
sar t1,#8 'set x
mov x,t1
' Vibrato
mov t1,vr 'vibrato rate
shr t1,#10
add vphase,t1
mov t1,vp 'vibrato pitch
mov t2,vphase
call #sine
add t1,gp 'sum glottal pitch (+) into vibrato pitch (+/-)
' Glottal pulse
shr t1,#2 'divide final pitch by 3 to mesh with
mov t2,t1 '...12 notes/octave musical scale
shr t2,#2 '(multiply by %0.0101010101010101)
add t1,t2
mov t2,t1
shr t2,#4
add t1,t2
mov t2,t1
shr t2,#8
add t1,t2
add t1,tune 'tune scale so that gp=100 produces 110.00Hz (A2)
call #antilog 'convert pitch (log frequency) to phase delta
add gphase,t2
mov t1,gphase 'convert phase to glottal pulse sample
call #antilog
sub t2,h40000000
mov t1,ga
call #sine
sar t1,#6 'add to x
add x,t1
' Vocal tract formants
mov y,#0 'reset y
mov a,f1 'formant1, sum and rotate (x,y)
add x,f1x
add y,f1y
call #cordic
mov f1x,x
mov f1y,y
mov a,f2 'formant2, sum and rotate (x,y)
add x,f2x
add y,f2y
call #cordic
mov f2x,x
mov f2y,y
mov a,f3 'formant3, sum and rotate (x,y)
add x,f3x
add y,f3y
call #cordic
mov f3x,x
mov f3y,y
mov a,f4 'formant4, sum and rotate (x,y)
add x,f4x
add y,f4y
call #cordic
mov f4x,x
mov f4y,y
' Nasal anti-formant
add nx,x 'subtract from x (nx negated)
mov a,nf 'nasal frequency
call #cordic
mov t1,na 'nasal amplitude
mov t2,x
call #mult
mov x,nx 'restore x
neg nx,t1 'negate nx
' Frication
mov t1,lfsr 'phase noise
sar t1,#3
add fphase,t1
sar t1,#1
add fphase,t1
mov t1,ff 'frication frequency
shr t1,#1
add fphase,t1
mov t1,fa 'frication amplitude
mov t2,fphase
call #sine
add x,t1 'add to x
' Handle frame
jmp :ret 'run segment of frame handler, return to loop
' ┌─────────────────┐
' │ Frame Handler │
' └─────────────────┘
:ret long :wait 'pointer to next frame handler routine
:wait jmpret :ret,#loop '(6 or 17.5 cycles)
mov frame_ptr,par 'check for next frame
add frame_ptr,#8*4 'point past miscellaneous data
add frame_ptr,frame_index 'point to start of frame
rdlong step_size,frame_ptr 'get stepsize
and step_size,h00FFFFFF wz 'isolate stepsize and check if not 0
if_nz jmp #:next 'if not 0, next frame ready
mov :final1,:finali 'no frame ready, ready to finalize parameters
mov frame_cnt,#13 'iterate aa..ff
:final jmpret :ret,#loop '(13.5 or 4 cycles)
:final1 mov par_curr,par_next 'current parameter = next parameter
add :final1,d0s0 'update pointers
djnz frame_cnt,#:final 'another parameter?
jmp #:wait 'check for next frame
:next add step_size,#1 'next frame ready, insure accurate accumulation
mov step_acc,step_size 'initialize step accumulator
movs :set1,#par_next 'ready to get parameters and steps for aa..ff
movd :set2,#par_curr
movd :set3,#par_next
movd :set4,#par_step
add frame_ptr,#3 'point to first parameter
mov frame_cnt,#13 'iterate aa..ff
:set jmpret :ret,#loop '(19.5 or 46.5 cycles)
rdbyte t1,frame_ptr 'get new parameter
shl t1,#24 'msb justify
:set1 mov t2,par_next 'get next parameter
:set2 mov par_curr,t2 'current parameter = next parameter
:set3 mov par_next,t1 'next parameter = new parameter
sub t1,t2 wc 'get next-current delta with sign in c
negc t1,t1 'make delta absolute (by c, not msb)
rcl vscl,#1 wz, nr 'save sign into nz (vscl unaffected)
mov t2,#8 'multiply delta by step size
:mult shl t1,#1 wc
if_c add t1,step_size
djnz t2,#:mult
:set4 negnz par_step,t1 'set signed step
add :set1,#1 'update pointers for next parameter+step
add :set2,d0
add :set3,d0
add :set4,d0
add frame_ptr,#1
djnz frame_cnt,#:set 'another parameter?
:stepframe jmpret :ret,#loop '(47.5 or 8 cycles)
mov :step1,:stepi 'ready to step parameters
mov frame_cnt,#13 'iterate aa..ff
:step jmpret :ret,#loop '(3 or 4 cycles)
:step1 add par_curr,par_step 'step parameter
add :step1,d0s0 'update pointers for next parameter+step
djnz frame_cnt,#:step 'another parameter?
add step_acc,step_size 'accumulate frame steps
test step_acc,h01000000 wc 'check for frame steps done
if_nc jmp #:stepframe 'another frame step?
sub frame_ptr,#frame_bytes 'zero stepsize in frame to signal frame done
wrlong vscl,frame_ptr
add frame_index,#frame_bytes'point to next frame
and frame_index,#frame_buffer_bytes - 1
jmp #:wait 'check for next frame
:finali mov par_curr,par_next 'instruction used to finalize parameters
:stepi add par_curr,par_step 'instruction used to step parameters
' ┌────────────────────┐
' │ Math Subroutines │
' └────────────────────┘
' Antilog
'
' in: t1 = log (top 4 bits = whole number, next 11 bits = fraction)
'
' out: t2 = antilog ($00010000..$FFEA0000)
antilog mov t2,t1
shr t2,#16 'position 11-bit fraction
shr t1,#16+12 'position 4-bit whole number
and t2,h00000FFE 'get table offset
or t2,h0000D000 'get table base
rdword t2,t2 'lookup fractional antilog
or t2,h00010000 'insert leading bit
shl t2,t1 'shift up by whole number
antilog_ret ret
' Scaled sine
'
' in: t1 = unsigned scale (15 top bits used)
' t2 = angle (13 top bits used)
'
' out: t1 = 17-bit * 15-bit scaled sine ($80014000..$7FFEC000)
sine shr t2,#32-13 'get 13-bit angle
test t2,h00001000 wz 'get sine quadrant 3|4 into nz
test t2,h00000800 wc 'get sine quadrant 2|4 into c
negc t2,t2 'if sine quadrant 2|4, negate table offset
or t2,h00007000 'insert sine table base address >> 1
shl t2,#1 'shift left to get final word address
rdword t2,t2 'read sine word from table
negnz t2,t2 'if quadrant 3|4, negate word
shl t2,#15 'msb-justify result
'multiply follows...
' Multiply
'
' in: t1 = unsigned multiplier (15 top bits used)
' t2 = signed multiplicand (17 top bits used)
'
' out: t1 = 32-bit signed product
mult shr t1,#32-15 'position unsigned multiplier
sar t2,#15 'position signed multiplicand
shl t2,#15-1
jmp #mult_steps 'do multiply steps
mult_step sar t1,#1 wc 'multiply step that gets assembled into reserves (x15)
if_c add t1,t2
' Cordic rotation
'
' in: a = 0 to <90 degree angle (~13 top bits used)
' x,y = signed coordinates
'
' out: x,y = scaled and rotated signed coordinates
cordic sar x,#1 'multiply (x,y) by %0.10011001 (0.60725 * 0.984)
mov t1,x '...for cordic pre-scaling and slight damping
sar t1,#3
add x,t1
mov t1,x
sar t1,#4
add x,t1
sar y,#1
mov t1,y
sar t1,#3
add y,t1
mov t1,y
sar t1,#4
add y,t1
mov t1,x 'do first cordic step
sub x,y
add y,t1
sub a,h80000000 wc
jmp #cordic_steps+1 'do subsequent cordic steps (skip first instruction)
cordic_step mov a,a wc 'cordic step that gets assembled into reserves (x13)
mov t1,y
cordic_dx sar t1,#1 '(source incremented for each step)
mov t2,x
cordic_dy sar t2,#1 '(source incremented for each step)
sumnc x,t1
sumc y,t2
cordic_a sumnc a,cordic_delta '(source incremented for each step)
' ┌────────────────┐
' │ Defined Data │
' └────────────────┘
tune long $66920000 'scale tuned to 110.00Hz at gp=100 (manually calibrated)
lfsr long 1 'linear feedback shift register for noise generation
lfsr_taps long $80061000
cordic_delta long $4B901476 'cordic angle deltas (first is h80000000)
long $27ECE16D
long $14444750
long $0A2C350C
long $05175F85
long $028BD879
long $0145F154
long $00A2F94D
long $00517CBB
long $0028BE60
long $00145F30
long $000A2F98
h80000000 long $80000000 'miscellaneous constants greater than 9 bits
h40000000 long $40000000
h01000000 long $01000000
h00FFFFFF long $00FFFFFF
h00010000 long $00010000
h0000D000 long $0000D000
h00007000 long $00007000
h00001000 long $00001000
h00000FFE long $00000FFE
h00000800 long $00000800
d0 long $00000200 'destination/source field increments
d0s0 long $00000201
clear_cnt long $1F0 - reserves 'number of reserved registers to clear on startup
' ┌──────────────────────────────────────────────────┐
' │ Undefined Data (zeroed by initialization code) │
' └──────────────────────────────────────────────────┘
reserves
frqa_center res 1 'reserved registers that get cleared on startup
cnt_ticks res 1
cnt_value res 1
frame_index res 1
frame_ptr res 1
frame_cnt res 1
step_size res 1
step_acc res 1
vphase res 1
gphase res 1
fphase res 1
f1x res 1
f1y res 1
f2x res 1
f2y res 1
f3x res 1
f3y res 1
f4x res 1
f4y res 1
nx res 1
a res 1
x res 1
y res 1
t1 res 1
t2 res 1
par_curr '*** current parameters
aa res 1 'aspiration amplitude
ga res 1 'glottal amplitude
gp res 1 'glottal pitch
vp res 1 'vibrato pitch
vr res 1 'vibrato rate
f1 res 1 'formant1 frequency
f2 res 1 'formant2 frequency
f3 res 1 'formant3 frequency
f4 res 1 'formant4 frequency
na res 1 'nasal amplitude
nf res 1 'nasal frequency
fa res 1 'frication amplitude
ff res 1 'frication frequency
par_next res 13 '*** next parameters
par_step res 13 '*** parameter steps
mult_steps res 2 * 15 'assembly area for multiply steps w/ret
mult_ret
sine_ret res 1
cordic_steps res 8 * 13 - 1 'assembly area for cordic steps w/ret
cordic_ret res 1
{{
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ TERMS OF USE: MIT License │
├──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┤
│Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation │
│files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, │
│modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software│
│is furnished to do so, subject to the following conditions: │
│ │
│The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.│
│ │
│THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE │
│WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR │
│COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, │
│ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}