HIVE
/
TriOS
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
TriOS/system/bellatrix/bel-g0/g0key.spin

3099 lines
117 KiB
Plaintext
Raw Normal View History

Initial checkin of TriOS R56
2013-12-10 15:32:47 +01:00
{{ GR0KEY
┌──────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ Autor: Ingo Kripahle │
│ Copyright (c) 2010 Ingo Kripahle │
│ See end of file for terms of use. │
│ Die Nutzungsbedingungen befinden sich am Ende der Datei │
└──────────────────────────────────────────────────────────────────────────────────────────────────────┘
Informationen : hive-project.de
Kontakt : drohne235@googlemail.com
System : Hive
Name : GRAPHICS-KEYBOARD
Chip : Bellatrix
Typ : Treiber
Version : 00
Subversion : 01
Funktion : Graphics + Keyboard
Dieser Bellatrix-Code stellt Regnatix alle Graphics- und Keyboard-Funktionen
zur Verfügung. Der Speicher für den PASM-Code im hRAM wird nach dem Start der
Cogs als Heap verwendet.
Logbuch :
11-11-2011-dr235 - erste funktionsfähige version erstellt
23-11-2011-dr235 - keyboard-objekt in root-objekt eingefügt
- keyboard-pasm-code zu heap hinzugefügt
}}
CON
_CLKMODE = XTAL1 + PLL16X
_XINFREQ = 5_000_000
_STACK = ($3000 + $3000 + 100) >> 2
' +----------
' | +------- system
' | | +---- version (änderungen)
' | | | +- subversion (hinzufügungen)
CHIP_VER = $00_01_01_01
CHIP_SPEC = gcon#b_tv|gcon#b_key|gcon#b_vec
' hbeat --------+
' clk -------+|
' /wr ------+||
' /hs -----+||| +------------------------- /cs
' |||| | -------- d0..d7
DB_IN = %00001001_00000000_00000000_00000000 'maske: dbus-eingabe
DB_OUT = %00001001_00000000_00000000_11111111 'maske: dbus-ausgabe
M1 = %00000010_00000000_00000000_00000000
M2 = %00000010_10000000_00000000_00000000 'busclk=1? & /cs=0?
M3 = %00000000_00000000_00000000_00000000
M4 = %00000010_00000000_00000000_00000000 'busclk=0?
x_tiles = 16
y_tiles = 12
paramcount = 14
bit_base = $2000
disp_base = $5000
max_x = x_tiles * 16
max_y = y_tiles * 16
OBJ
tv : "bel-tv"
gcon : "glob-con" 'globale konstanten
VAR
long bel_key 'letzter tastencode
long datadr 'adresse des heap
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
word screen[x_tiles * y_tiles] 'tilemap
long grcolors[64] 'farbregister
CON ''------------------------------------------------- BELLATRIX
PUB main | cmd,i,index 'chip: kommandointerpreter
''funktionsgruppe : chip
''funktion : kommandointerpreter
''eingabe : -
''ausgabe : -
init_subsysteme 'bus/vga/keyboard/maus initialisieren
repeat
i := 0
cmd := gc 'kommando empfangen
case cmd
' ---------------------------------------------- KEYBOARD
1: key_stat '1: Tastaturstatus senden
2: key_code '2: Tastaturzeichen senden
4: key_spec '4: Statustasten ($100..$1FF) abfragen
' ---------------------------------------------- GRAPHICS
'clear
10: clear
'copy(dest_ptr)
11: copy(disp_base)
'color(c)
12: color(gc)
'width(w)
13: width(gc)
'colorwidth(c, w)
14: colorwidth(gc,gc)
'plot(x, y)
15: plot(gc,gc)
'line(x, y)
16: line(gc,gc)
'arc(x, y, xr, yr, angle, anglestep, steps, arcmode)
17: arc(gc,gc,gc,gc,gw,gw,gc,gc)
'vec(x, y, vecscale, vecangle, vecdef_ptr)
18: vec(gc,gc,gc,gw,datadr+gw)
'vecarc(x, y, xr, yr, angle, vecscale, vecangle, vecdef_ptr)
19: vecarc(gc,gc,gc,gc,gw,gc,gw,datadr+gw)
'pix(x, y, pixrot, pixdef_ptr)
20: pix(gc,gc,gc,datadr+gw)
'pixarc(x, y, xr, yr, angle, pixrot, pixdef_ptr)
21: pixarc(gc,gc,gc,gc,gw,gc,datadr+gw)
'text(x, y, string_ptr)
22: text(gc,gc,datadr+gw)
'textarc(x, y, xr, yr, angle, string_ptr)
23: textarc(gc,gc,gc,gc,gw,datadr+gw)
'textmode(x_scale, y_scale, spacing, justification)
24: textmode(gc,gc,gc,gc)
'box(x, y, box_width, box_height)
25: box(gc,gc,gc,gc)
'quad(x1, y1, x2, y2, x3, y3, x4, y4)
26: quad(gc,gc,gc,gc,gc,gc,gc,gc)
'tri(x1, y1, x2, y2, x3, y3)
27: tri(gc,gc,gc,gc,gc,gc)
' ---------------------------------------------- CHIP-MANAGMENT
93: repeat 64 'colortab empfangen
grcolors[i++] := gl
94: repeat x_tiles * y_tiles 'screen empfangen
screen[i++] := gw
95: index := gw
repeat gw 'heap empfangen
byte[datadr+index+i++] := gc
96: pw(@grdatend-datadr) 'heapgrösse senden
97: setup(tv_hc, tv_vc, 0, 0, bit_base) 'dynamischer modus
98: setup(tv_hc, tv_vc, 0, 0, disp_base) 'statischer modus
99: reboot 'bellatrix neu starten
PUB init_subsysteme | i,tx,ty 'chip: initialisierung des bellatrix-chips
''funktionsgruppe : chip
''funktion : - initialisierung des businterface
'' : - vga & keyboard-treiber starten
''eingabe : -
''ausgabe : -
dira := db_in 'datenbus auf eingabe schalten
outa[gcon#bus_hs] := 1 'handshake inaktiv
keystart(gcon#b_keybd, gcon#b_keybc) 'tastaturport starten
'tv-treiber starten
longmove(@tv_status, @tvparams, paramcount)
tv_screen := @screen
tv_colors := @grcolors
tv.start(@tv_status)
'start and setup graphics
grstart
' setup(tv_hc, tv_vc, 0, 0, disp_base) 'bitmap_base = puffer in welchen gezeichnet wird
' clear
datadr := (@grdat+4) & $FFFD 'ausgerichtete datenadresse berechnen
PUB pc(zeichen) 'chip: ein byte an regnatix senden
''funktionsgruppe : chip
''funktion : ein byte an regnatix senden
''eingabe : byte
''ausgabe : -
waitpeq(M1,M2,0) 'busclk=1? & prop2=0?
dira := db_out 'datenbus auf ausgabe stellen
outa[7..0] := zeichen 'daten ausgeben
outa[gcon#bus_hs] := 0 'daten gültig
waitpeq(M3,M4,0) 'busclk=0?
dira := db_in 'bus freigeben
outa[gcon#bus_hs] := 1 'daten ungültig
PUB gc : zeichen 'chip: ein byte von regnatix empfangen
''funktionsgruppe : chip
''funktion : ein byte von regnatix empfangen
''eingabe : -
''ausgabe : byte
waitpeq(M1,M2,0) 'busclk=1? & prop2=0?
zeichen := ina[7..0] 'daten einlesen
outa[gcon#bus_hs] := 0 'daten quittieren
waitpeq(M3,M4,0) 'busclk=0?
outa[gcon#bus_hs] := 1
CON ''------------------------------------------------- SUBPROTOKOLL-FUNKTIONEN
PUB pw(wert) 'sub: word senden
''funktionsgruppe : sub
''funktion : subprotokoll um einen long-wert an regnatix zu senden
''eingabe : 16bit wert der gesendet werden soll
''ausgabe : -
''busprotokoll : [put.byte1][put.byte2]
'' : [ hsb ][ ]
pc(wert >> 8)
pc(wert)
PUB gw:wert 'sub: word empfangen
''funktionsgruppe : sub
''funktion : subprotokoll um einen 16bit-wert von regnatix zu empfangen
''eingabe : -
''ausgabe : 16bit-wert der empfangen wurde
''busprotokoll : [get.byte1][get.byte2]
'' : [ hsb ][ lsb ]
wert := gc << 8
wert := wert + gc
PUB gl:wert 'sub: long empfangen
''funktionsgruppe : sub
''funktion : subprotokoll um einen long-wert von regnatix zu empfangen
''eingabe : -
''ausgabe : 32bit-wert der empfangen wurde
''busprotokoll : [get.byte1][get.byte2][get.byte3][get.byte4]
'' : [ hsb ][ ][ ][ lsb ]
wert := gc << 24 '32 bit empfangen hsb/lsb
wert := wert + gc << 16
wert := wert + gc << 8
wert := wert + gc
CON ''------------------------------------------------- KEYBOARD-FUNKTIONEN
PUB key_stat 'key: tastaturstatus abfragen
pc(gotkey)
PUB key_code 'key: tastencode abfragen
bel_key := key
case bel_key
$c8: bel_key := $08 'backspace wandeln
pc(bel_key)
PUB key_spec 'key: statustaten vom letzten tastencode abfragen
pc(bel_key >> 8)
DAT ''tv-parameter
tvparams long 0 'status
long 1 'enable
long %010_0101 'pins New Board
long %0000 'mode
pscreen long 0 'screen
pcolors long 0 'colors
long x_tiles 'hc - horizontale tiles
long y_tiles 'vc - vertikale tiles
long 10 'hx
long 1 'vx
long 0 'ho
long 0 'vo
long 60_000_000 '_xinfreq<<4 'broadcast
long 0 'auralcog
CON ' Keyboard-Objekt
''***************************************
''* 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
------------------------------------------------------------------}
{-----------------KEYBOARD LAYOUT HISTORY--------------------------
2009-08-31 (Y-M-D)
Patch for german keyboard layout
Author: oog
Added german keyboard layout.
Original layout is commented as keyboard-us-en (US-English).
German layout is commented as keyboard-de (de = deutsch = "german").
Now there are two tables for keys with and without SHIFT-Key.
It should be easier to implement different international layouts.
However, it's bigger now and uses more memory.
2009-09-05 (Y-M-D)
Fixed bugs
- code bug on home-key fixed
new replace-codes for de_ae, de_ou and de_ue
New
- Documentation of control-key bits
This should be helpful for translatíons of this driver into
different languages.
- table_alt_r
This table contains characters for the german "AltGr" key.
- AltGr+F1..F12
Returns line-characters, selected from $90..$9f
2009-09-06 (Y-M-D)
Fixed bugs
- patch table_shift for "?"
Differences to Parallax driver:
- Different codes for NumLock, CapsLock and ScrLock to avoid
conflict with german "ß"
Codes are defined as constants and easy to change
- Easy Cursor codes implemented to avoit conflict with the "Ä"-key
Easy Cursor codes are easy to understand,
for example "Cursor Left" is the character "←"
------------------------------------------------------------------}
CON
de_ae = $A6 'replace code - not used on keyboard
de_oe = $A7 'replace code - not used on keyboard
de_ue = $A8 'replace code - not used on keyboard
lock = $BC 'Parallax used codes $DD, $DE and $DF
'There was a conflict between $DF=NumLock="ß"
ScrLk = lock
CpsLk = lock+1
NumLk = lock+2
'
'Uncomment one of the next constant blocks
'
'
{{Parallax cursor codes start}}
{{
CrsLt = $C0E4
CrsRt = $C1E6
CrsUp = $C2E8
CrsDn = $C3E2
CrsHm = $C4E7 'Conflict with key "Ä" ($C4)
CrsEn = $C5E1
PgUp = $C6E9
PgDn = $C7E3
Bksp = $00C8
Del = $C9EA
Ins = $CAE0
Esc = $00CB
Apps = $CC00
Power = $CD00
Sleep = $CE00
WkUp = $CF00
}}
{{Parallax cursor codes end}}
{{Easy cursor codes start}}
CrsLt = $02E4 '←
CrsRt = $03E6 '→
CrsUp = $04E8 '↑
CrsDn = $05E2 '↓
CrsHm = $06E7 '◀
CrsEn = $07E1 '▶
PgUp = $A0E9 '
PgDn = $A2E3 '
Bksp = $00C8 'È
Del = $BAEA '
Ins = $BBE0 '
Esc = $001B '
Apps = $CC00 'Ì
Power = $CD00 'Í
Sleep = $CE00 'Î
WkUp = $CF00 'Ï
{{Easy cursor codes end}}
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 keystart(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_000, %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)
longmove(@par_keys, @dpin, 4)
okay := cog := cognew(@entry, @par_tail) + 1
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)
CON ' Graphics-Objekt
''***************************************
''* Graphics Driver v1.0 *
''* Author: Chip Gracey *
''* Copyright (c) 2005 Parallax, Inc. *
''* See end of file for terms of use. *
''***************************************
''
'' Theory of Operation:
''
'' A cog is launched which processes commands via the PUB routines.
''
'' Points, lines, arcs, sprites, text, and polygons are rasterized into
'' a specified stretch of memory which serves as a generic bitmap buffer.
''
'' The bitmap can be displayed by the TV.SRC or VGA.SRC driver.
''
'' See GRAPHICS_DEMO.SRC for usage example.
''
CON
#1, _setup, _color, _width, _plot, _line, _arc, _vec, _vecarc, _pix, _pixarc, _text, _textarc, _textmode, _fill, _loop
VAR
long command
long bitmap_base 'bitmap data
long bitmap_longs
word bases[32]
long pixel_width 'pixel data
long slices[8]
long text_xs, text_ys, text_sp, text_just 'text data (these 4 must be contiguous)
PUB grstart : okay
'' Start graphics driver - starts a cog
'' returns false if no cog available
fontptr := @font 'set font pointer (same for all instances)
cognew(@loop, @command) + 1
PUB setup(xtiles, ytiles, x_origin, y_origin, base_ptr) | bases_ptr, slices_ptr
'' Set bitmap parameters
''
'' xtiles - number of x tiles (tiles are 16x16 pixels each)
'' ytiles - number of y tiles
'' x_origin - relative-x center pixel
'' y_origin - relative-y center pixel
'' base_ptr - base address of bitmap
setcommand(_loop, 0) 'make sure last command finished
repeat bases_ptr from 0 to xtiles - 1 <# 31 'write bases
bases[bases_ptr] := base_ptr + bases_ptr * ytiles << 6
ytiles <<= 4 'adjust arguments and do setup command
y_origin := ytiles - y_origin - 1
bases_ptr := @bases
slices_ptr := @slices
setcommand(_setup, @xtiles)
bitmap_base := base_ptr 'retain high-level bitmap data
bitmap_longs := xtiles * ytiles
PUB clear
'' Clear bitmap
setcommand(_loop, 0) 'make sure last command finished
longfill(bitmap_base, 0, bitmap_longs) 'clear bitmap
PUB copy(dest_ptr)
'' Copy bitmap
'' use for double-buffered display (flicker-free)
''
'' dest_ptr - base address of destination bitmap
setcommand(_loop, 0) 'make sure last command finished
longmove(dest_ptr, bitmap_base, bitmap_longs) 'copy bitmap
PUB color(c)
'' Set pixel color to two-bit pattern
''
'' c - color code in bits[1..0]
setcommand(_color, @colors[c & 3]) 'set color
PUB width(w) | pixel_passes, r, i, p
'' Set pixel width
'' actual width is w[3..0] + 1
''
'' w - 0..15 for round pixels, 16..31 for square pixels
r := not w & $10 'determine pixel shape/width
w &= $F
pixel_width := w
pixel_passes := w >> 1 + 1
setcommand(_width, @w) 'do width command now to avoid updating slices when busy
p := w ^ $F 'update slices to new shape/width
repeat i from 0 to w >> 1
slices[i] := true >> (p << 1) << (p & $E)
if r and pixels[w] & |< i
p += 2
if r and i == pixel_passes - 2
p += 2
PUB colorwidth(c, w)
'' Set pixel color and width
color(c)
width(w)
PUB plot(gx, gy)
'' Plot point
''
'' x,y - point
setcommand(_plot, @gx)
PUB line(gx, gy)
'' Draw a line to point
''
'' x,y - endpoint
setcommand(_line, @gx)
PUB arc(gx, gy, xr, yr, angle, anglestep, steps, arcmode)
'' Draw an arc
''
'' x,y - center of arc
'' xr,yr - radii of arc
'' angle - initial angle in bits[12..0] (0..$1FFF = 0°..359.956°)
'' anglestep - angle step in bits[12..0]
'' steps - number of steps (0 just leaves (x,y) at initial arc position)
'' arcmode - 0: plot point(s)
'' 1: line to point(s)
'' 2: line between points
'' 3: line from point(s) to center
setcommand(_arc, @gx)
PUB vec(gx, gy, vecscale, vecangle, vecdef_ptr)
'' Draw a vector sprite
''
'' x,y - center of vector sprite
'' vecscale - scale of vector sprite ($100 = 1x)
'' vecangle - rotation angle of vector sprite in bits[12..0]
'' vecdef_ptr - address of vector sprite definition
''
''
'' Vector sprite definition:
''
'' word $8000|$4000+angle 'vector mode + 13-bit angle (mode: $4000=plot, $8000=line)
'' word length 'vector length
'' ... 'more vectors
'' ...
'' word 0 'end of definition
setcommand(_vec, @gx)
PUB vecarc(gx, gy, xr, yr, angle, vecscale, vecangle, vecdef_ptr)
'' Draw a vector sprite at an arc position
''
'' x,y - center of arc
'' xr,yr - radii of arc
'' angle - angle in bits[12..0] (0..$1FFF = 0°..359.956°)
'' vecscale - scale of vector sprite ($100 = 1x)
'' vecangle - rotation angle of vector sprite in bits[12..0]
'' vecdef_ptr - address of vector sprite definition
setcommand(_vecarc, @gx)
PUB pix(gx, gy, pixrot, pixdef_ptr)
'' Draw a pixel sprite
''
'' x,y - center of vector sprite
'' pixrot - 0: 0°, 1: 90°, 2: 180°, 3: 270°, +4: mirror
'' pixdef_ptr - address of pixel sprite definition
''
''
'' Pixel sprite definition:
''
'' word 'word align, express dimensions and center, define pixels
'' byte xwords, ywords, xorigin, yorigin
'' word %%xxxxxxxx,%%xxxxxxxx
'' word %%xxxxxxxx,%%xxxxxxxx
'' word %%xxxxxxxx,%%xxxxxxxx
'' ...
setcommand(_pix, @gx)
PUB pixarc(gx, gy, xr, yr, angle, pixrot, pixdef_ptr)
'' Draw a pixel sprite at an arc position
''
'' x,y - center of arc
'' xr,yr - radii of arc
'' angle - angle in bits[12..0] (0..$1FFF = 0°..359.956°)
'' pixrot - 0: 0°, 1: 90°, 2: 180°, 3: 270°, +4: mirror
'' pixdef_ptr - address of pixel sprite definition
setcommand(_pixarc, @gx)
PUB text(gx, gy, string_ptr) | justx, justy
'' Draw text
''
'' x,y - text position (see textmode for sizing and justification)
'' string_ptr - address of zero-terminated string (it may be necessary to call .finish
'' immediately afterwards to prevent subsequent code from clobbering the
'' string as it is being drawn
justify(string_ptr, @justx) 'justify string and draw text
setcommand(_text, @gx)
PUB textarc(gx, gy, xr, yr, angle, string_ptr) | justx, justy
'' Draw text at an arc position
''
'' x,y - center of arc
'' xr,yr - radii of arc
'' angle - angle in bits[12..0] (0..$1FFF = 0°..359.956°)
'' string_ptr - address of zero-terminated string (it may be necessary to call .finish
'' immediately afterwards to prevent subsequent code from clobbering the
'' string as it is being drawn
justify(string_ptr, @justx) 'justify string and draw text
setcommand(_textarc, @gx)
PUB textmode(x_scale, y_scale, spacing, justification)
'' Set text size and justification
''
'' x_scale - x character scale, should be 1+
'' y_scale - y character scale, should be 1+
'' spacing - character spacing, 6 is normal
'' justification - bits[1..0]: 0..3 = left, center, right, left
'' bits[3..2]: 0..3 = bottom, center, top, bottom
longmove(@text_xs, @x_scale, 4) 'retain high-level text data
setcommand(_textmode, @x_scale) 'set text mode
PUB box(gx, gy, box_width, box_height) | x2, y2, pmin, pmax
'' Draw a box with round/square corners, according to pixel width
''
'' x,y - box left, box bottom
if box_width > pixel_width and box_height > pixel_width
pmax := pixel_width - (pmin := pixel_width >> 1) 'get pixel-half-min and pixel-half-max
gx += pmin 'adjust coordinates to accomodate width
gy += pmin
x2 := gx + box_width - 1 - pixel_width
y2 := gy + box_height - 1 - pixel_width
plot(gx, gy) 'plot round/square corners
plot(gx, y2)
plot(x2, gy)
plot(x2, y2)
fill(gx, y2 + pmax, 0, (x2 - gx) << 16, 0, 0, pmax) 'fill gaps
fill(gx, y, 0, (x2 - gx) << 16, 0, 0, pmin)
fill(gx - pmin, y2, 0, (x2 - gx + pixel_width) << 16, 0, 0, y2 - gy)
PUB quad(x1, y1, x2, y2, x3, y3, x4, y4)
'' Draw a solid quadrilateral
'' vertices must be ordered clockwise or counter-clockwise
tri(x1, y1, x2, y2, x3, y3) 'draw two triangle to make 4-sides polygon
tri(x3, y3, x4, y4, x1, y1)
PUB tri(x1, y1, x2, y2, x3, y3) | xy[2]
'' Draw a solid triangle
' reorder vertices by descending y
case (y1 => y2) & %100 | (y2 => y3) & %010 | (y1 => y3) & %001
%000:
longmove(@xy, @x1, 2)
longmove(@x1, @x3, 2)
longmove(@x3, @xy, 2)
%010:
longmove(@xy, @x1, 2)
longmove(@x1, @x2, 4)
longmove(@x3, @xy, 2)
%011:
longmove(@xy, @x1, 2)
longmove(@x1, @x2, 2)
longmove(@x2, @xy, 2)
%100:
longmove(@xy, @x3, 2)
longmove(@x2, @x1, 4)
longmove(@x1, @xy, 2)
%101:
longmove(@xy, @x2, 2)
longmove(@x2, @x3, 2)
longmove(@x3, @xy, 2)
' draw triangle
fill(x1, y1, (x3 - x1) << 16 / (y1 - y3 + 1), (x2 - x1) << 16 / (y1 - y2 + 1), (x3 - x2) << 16 / (y2 - y3 + 1), y1 - y2, y1 - y3)
PUB finish
'' Wait for any current graphics command to finish
'' use this to insure that it is safe to manually manipulate the bitmap
setcommand(_loop, 0) 'make sure last command finished
PRI fill(gx, gy, da, db, db2, linechange, lines_minus_1)
setcommand(_fill, @gx)
PRI justify(string_ptr, justptr) | gx
gx := (strsize(string_ptr) - 1) * text_xs * text_sp + text_xs * 5 - 1
long[justptr] := -lookupz(text_just >> 2 & 3: 0, gx >> 1, gx, 0)
long[justptr][1] := -lookupz(text_just & 3: 0, text_ys << 3, text_ys << 4, 0)
PRI setcommand(cmd, argptr)
command := cmd << 16 + argptr 'write command and pointer
repeat while command 'wait for command to be cleared, signifying receipt
CON
' Vector font primitives
xa0 = %000 << 0 'x line start / arc center
xa1 = %001 << 0
xa2 = %010 << 0
xa3 = %011 << 0
xa4 = %100 << 0
xa5 = %101 << 0
xa6 = %110 << 0
xa7 = %111 << 0
ya0 = %0000 << 3 'y line start / arc center
ya1 = %0001 << 3
ya2 = %0010 << 3
ya3 = %0011 << 3
ya4 = %0100 << 3
ya5 = %0101 << 3
ya6 = %0110 << 3
ya7 = %0111 << 3
ya8 = %1000 << 3
ya9 = %1001 << 3
yaA = %1010 << 3
yaB = %1011 << 3
yaC = %1100 << 3
yaD = %1101 << 3
yaE = %1110 << 3
yaF = %1111 << 3
xb0 = %000 << 7 'x line end
xb1 = %001 << 7
xb2 = %010 << 7
xb3 = %011 << 7
xb4 = %100 << 7
xb5 = %101 << 7
xb6 = %110 << 7
xb7 = %111 << 7
yb0 = %0000 << 10 'y line end
yb1 = %0001 << 10
yb2 = %0010 << 10
yb3 = %0011 << 10
yb4 = %0100 << 10
yb5 = %0101 << 10
yb6 = %0110 << 10
yb7 = %0111 << 10
yb8 = %1000 << 10
yb9 = %1001 << 10
ybA = %1010 << 10
ybB = %1011 << 10
ybC = %1100 << 10
ybD = %1101 << 10
ybE = %1110 << 10
ybF = %1111 << 10
ax1 = %0 << 7 'x arc radius
ax2 = %1 << 7
ay1 = %00 << 8 'y arc radius
ay2 = %01 << 8
ay3 = %10 << 8
ay4 = %11 << 8
a0 = %0000 << 10 'arc start/length
a1 = %0001 << 10 'bits[1..0] = start (0..3 = 0°, 90°, 180°, 270°)
a2 = %0010 << 10 'bits[3..2] = length (0..3 = 360°, 270°, 180°, 90°)
a3 = %0011 << 10
a4 = %0100 << 10
a5 = %0101 << 10
a6 = %0110 << 10
a7 = %0111 << 10
a8 = %1000 << 10
a9 = %1001 << 10
aA = %1010 << 10
aB = %1011 << 10
aC = %1100 << 10
aD = %1101 << 10
aE = %1110 << 10
aF = %1111 << 10
fline = %0 << 14 'line command
farc = %1 << 14 'arc command
more = %1 << 15 'another arc/line
DAT
' Color codes
colors long %%0000000000000000
long %%1111111111111111
long %%2222222222222222
long %%3333333333333333
' Round pixel recipes
pixels byte %00000000,%00000000,%00000000,%00000000 '0,1,2,3
byte %00000000,%00000000,%00000010,%00000101 '4,5,6,7
byte %00001010,%00001010,%00011010,%00011010 '8,9,A,B
byte %00110100,%00111010,%01110100,%01110100 'C,D,E,F
' Vector font - standard ascii characters ($21-$7E)
font word fline + xa2 + yaC + xb2 + yb7 + more '!
word fline + xa2 + ya5 + xb2 + yb4
word fline + xa1 + yaD + xb1 + ybC + more '"
word fline + xa3 + yaD + xb3 + ybC
word fline + xa1 + yaA + xb1 + yb6 + more '#
word fline + xa3 + yaA + xb3 + yb6 + more
word fline + xa0 + ya9 + xb4 + yb9 + more
word fline + xa0 + ya7 + xb4 + yb7
word farc + xa2 + ya9 + a9 + ax2 + ay1 + more '$
word farc + xa2 + ya7 + aB + ax2 + ay1 + more
word fline + xa0 + ya6 + xb2 + yb6 + more
word fline + xa2 + yaA + xb4 + ybA + more
word fline + xa2 + yaA + xb2 + ybB + more
word fline + xa2 + ya6 + xb2 + yb5
word farc + xa1 + yaA + a0 + ax1 + ay1 + more '%
word farc + xa3 + ya6 + a0 + ax1 + ay1 + more
word fline + xa0 + ya6 + xb4 + ybA
word farc + xa2 + yaA + a7 + ax1 + ay1 + more '&
word farc + xa2 + ya7 + a5 + ax2 + ay2 + more
word fline + xa1 + yaA + xb4 + yb5
word fline + xa2 + yaD + xb2 + ybC ' '
word farc + xa3 + ya9 + aD + ax1 + ay4 + more '(
word farc + xa3 + ya7 + aE + ax1 + ay4 + more
word fline + xa2 + ya7 + xb2 + yb9
word farc + xa1 + ya9 + aC + ax1 + ay4 + more ')
word farc + xa1 + ya7 + aF + ax1 + ay4 + more
word fline + xa2 + ya7 + xb2 + yb9
word fline + xa4 + ya6 + xb0 + ybA + more '*
word fline + xa0 + ya6 + xb4 + ybA + more
word fline + xa2 + yaB + xb2 + yb5
word fline + xa0 + ya8 + xb4 + yb8 + more '+
word fline + xa2 + yaA + xb2 + yb6
word fline + xa2 + ya4 + xb1 + yb3 ',
word fline + xa0 + ya8 + xb4 + yb8 '-
word fline + xa2 + ya5 + xb2 + yb4 '.
word fline + xa0 + ya4 + xb4 + ybC '/
word farc + xa2 + ya8 + a0 + ax2 + ay4 '0
word fline + xa0 + ya4 + xb4 + yb4 + more '1
word fline + xa2 + ya4 + xb2 + ybC + more
word fline + xa0 + yaA + xb2 + ybC
word farc + xa2 + yaA + a8 + ax2 + ay2 + more '2
word farc + xa2 + yaA + aF + ax2 + ay3 + more
word farc + xa2 + ya4 + aD + ax2 + ay3 + more
word fline + xa0 + ya4 + xb4 + yb4
word farc + xa2 + yaA + a7 + ax2 + ay2 + more '3
word farc + xa2 + ya6 + a6 + ax2 + ay2
word fline + xa2 + yaC + xb0 + yb7 + more '4
word fline + xa0 + ya7 + xb4 + yb7 + more
word fline + xa3 + ya4 + xb3 + yb8
word farc + xa2 + ya6 + aB + ax2 + ay2 + more '5
word fline + xa4 + yaC + xb0 + ybC + more
word fline + xa0 + yaC + xb0 + yb8 + more
word fline + xa0 + ya8 + xb2 + yb8 + more
word fline + xa0 + ya4 + xb2 + yb4
word farc + xa2 + ya6 + a0 + ax2 + ay2 + more '6
word farc + xa2 + ya8 + aD + ax2 + ay4 + more
word fline + xa0 + ya6 + xb0 + yb8 + more
word fline + xa2 + yaC + xb3 + ybC
word fline + xa0 + yaC + xb4 + ybC + more '7
word fline + xa1 + ya4 + xb4 + ybC
word farc + xa2 + ya6 + a0 + ax2 + ay2 + more '8
word farc + xa2 + yaA + a0 + ax2 + ay2
word farc + xa2 + yaA + a0 + ax2 + ay2 + more '9
word farc + xa2 + ya8 + aF + ax2 + ay4 + more
word fline + xa4 + ya8 + xb4 + ybA + more
word fline + xa1 + ya4 + xb2 + yb4
word fline + xa2 + ya6 + xb2 + yb7 + more ':
word fline + xa2 + yaA + xb2 + yb9
word fline + xa2 + ya4 + xb1 + yb3 + more ';
word fline + xa2 + ya8 + xb2 + yb7
word fline + xa0 + ya8 + xb4 + ybA + more '<
word fline + xa0 + ya8 + xb4 + yb6
word fline + xa0 + yaA + xb4 + ybA + more '=
word fline + xa0 + ya6 + xb4 + yb6
word fline + xa4 + ya8 + xb0 + ybA + more '>
word fline + xa4 + ya8 + xb0 + yb6
word farc + xa2 + yaB + a8 + ax2 + ay1 + more '?
word farc + xa3 + yaB + aF + ax1 + ay2 + more
word farc + xa3 + ya7 + aD + ax1 + ay2 + more
word fline + xa2 + ya5 + xb2 + yb4
word farc + xa2 + ya8 + a0 + ax1 + ay1 + more '@
word farc + xa2 + ya8 + a4 + ax2 + ay3 + more
word farc + xa3 + ya8 + aF + ax1 + ay1 + more
word farc + xa2 + ya6 + aF + ax2 + ay1 + more
word fline + xa3 + ya7 + xb3 + yb9
word farc + xa2 + yaA + a8 + ax2 + ay2 + more 'A
word fline + xa0 + ya4 + xb0 + ybA + more
word fline + xa4 + ya4 + xb4 + ybA + more
word fline + xa0 + ya8 + xb4 + yb8
word farc + xa2 + yaA + aB + ax2 + ay2 + more 'B
word farc + xa2 + ya6 + aB + ax2 + ay2 + more
word fline + xa0 + ya4 + xb0 + ybC + more
word fline + xa0 + ya4 + xb2 + yb4 + more
word fline + xa0 + ya8 + xb2 + yb8 + more
word fline + xa0 + yaC + xb2 + ybC
word farc + xa2 + yaA + a8 + ax2 + ay2 + more 'C
word farc + xa2 + ya6 + aA + ax2 + ay2 + more
word fline + xa0 + ya6 + xb0 + ybA
word farc + xa2 + yaA + aC + ax2 + ay2 + more 'D
word farc + xa2 + ya6 + aF + ax2 + ay2 + more
word fline + xa0 + ya4 + xb0 + ybC + more
word fline + xa4 + ya6 + xb4 + ybA + more
word fline + xa0 + ya4 + xb2 + yb4 + more
word fline + xa0 + yaC + xb2 + ybC
word fline + xa0 + ya4 + xb0 + ybC + more 'E
word fline + xa0 + ya4 + xb4 + yb4 + more
word fline + xa0 + ya8 + xb3 + yb8 + more
word fline + xa0 + yaC + xb4 + ybC
word fline + xa0 + ya4 + xb0 + ybC + more 'F
word fline + xa0 + ya8 + xb3 + yb8 + more
word fline + xa0 + yaC + xb4 + ybC
word farc + xa2 + yaA + a8 + ax2 + ay2 + more 'G
word farc + xa2 + ya6 + aA + ax2 + ay2 + more
word fline + xa0 + ya6 + xb0 + ybA + more
word fline + xa4 + ya4 + xb4 + yb7 + more
word fline + xa3 + ya7 + xb4 + yb7
word fline + xa0 + ya4 + xb0 + ybC + more 'H
word fline + xa4 + ya4 + xb4 + ybC + more
word fline + xa0 + ya8 + xb4 + yb8
word fline + xa2 + ya4 + xb2 + ybC + more 'I
word fline + xa0 + ya4 + xb4 + yb4 + more
word fline + xa0 + yaC + xb4 + ybC
word farc + xa2 + ya6 + aA + ax2 + ay2 + more 'J
word fline + xa4 + ya6 + xb4 + ybC
word fline + xa0 + ya4 + xb0 + ybC + more 'K
word fline + xa4 + yaC + xb0 + yb8 + more
word fline + xa4 + ya4 + xb0 + yb8
word fline + xa0 + ya4 + xb0 + ybC + more 'L
word fline + xa0 + ya4 + xb4 + yb4
word fline + xa0 + ya4 + xb0 + ybC + more 'M
word fline + xa4 + ya4 + xb4 + ybC + more
word fline + xa2 + ya8 + xb0 + ybC + more
word fline + xa2 + ya8 + xb4 + ybC
word fline + xa0 + ya4 + xb0 + ybC + more 'N
word fline + xa4 + ya4 + xb4 + ybC + more
word fline + xa4 + ya4 + xb0 + ybC
word farc + xa2 + yaA + a8 + ax2 + ay2 + more '0
word farc + xa2 + ya6 + aA + ax2 + ay2 + more
word fline + xa0 + ya6 + xb0 + ybA + more
word fline + xa4 + ya6 + xb4 + ybA
word farc + xa2 + yaA + aB + ax2 + ay2 + more 'P
word fline + xa0 + ya4 + xb0 + ybC + more
word fline + xa0 + ya8 + xb2 + yb8 + more
word fline + xa0 + yaC + xb2 + ybC
word farc + xa2 + yaA + a8 + ax2 + ay2 + more 'Q
word farc + xa2 + ya6 + aA + ax2 + ay2 + more
word fline + xa0 + ya6 + xb0 + ybA + more
word fline + xa4 + ya6 + xb4 + ybA + more
word fline + xa2 + ya6 + xb4 + yb3
word farc + xa2 + yaA + aB + ax2 + ay2 + more 'R
word fline + xa0 + ya4 + xb0 + ybC + more
word fline + xa0 + ya8 + xb2 + yb8 + more
word fline + xa0 + yaC + xb2 + ybC + more
word fline + xa4 + ya4 + xb2 + yb8
word farc + xa2 + yaA + a4 + ax2 + ay2 + more 'S
word farc + xa2 + ya6 + a6 + ax2 + ay2
word fline + xa2 + ya4 + xb2 + ybC + more 'T
word fline + xa0 + yaC + xb4 + ybC
word farc + xa2 + ya6 + aA + ax2 + ay2 + more 'U
word fline + xa0 + ya6 + xb0 + ybC + more
word fline + xa4 + ya6 + xb4 + ybC
word fline + xa2 + ya4 + xb0 + ybC + more 'V
word fline + xa2 + ya4 + xb4 + ybC
word fline + xa0 + yaC + xb0 + yb4 + more 'W
word fline + xa4 + yaC + xb4 + yb4 + more
word fline + xa2 + ya8 + xb0 + yb4 + more
word fline + xa2 + ya8 + xb4 + yb4
word fline + xa4 + ya4 + xb0 + ybC + more 'X
word fline + xa0 + ya4 + xb4 + ybC
word fline + xa0 + yaC + xb2 + yb8 + more 'Y
word fline + xa4 + yaC + xb2 + yb8 + more
word fline + xa2 + ya4 + xb2 + yb8
word fline + xa0 + yaC + xb4 + ybC + more 'Z
word fline + xa0 + ya4 + xb4 + ybC + more
word fline + xa0 + ya4 + xb4 + yb4
word fline + xa2 + yaD + xb2 + yb3 + more '[
word fline + xa2 + yaD + xb4 + ybD + more
word fline + xa2 + ya3 + xb4 + yb3
word fline + xa4 + ya4 + xb0 + ybC '\
word fline + xa2 + yaD + xb2 + yb3 + more '[
word fline + xa2 + yaD + xb0 + ybD + more
word fline + xa2 + ya3 + xb0 + yb3
word fline + xa2 + yaA + xb0 + yb6 + more '^
word fline + xa2 + yaA + xb4 + yb6
word fline + xa0 + ya1 + xa4 + yb1 '_
word fline + xa1 + ya9 + xb3 + yb7 '`
word farc + xa2 + ya6 + a0 + ax2 + ay2 + more 'a
word fline + xa4 + ya4 + xb4 + yb8
word farc + xa2 + ya6 + a0 + ax2 + ay2 + more 'b
word fline + xa0 + ya4 + xb0 + ybC
word farc + xa2 + ya6 + a9 + ax2 + ay2 + more 'c
word fline + xa2 + ya4 + xb4 + yb4 + more
word fline + xa2 + ya8 + xb4 + yb8
word farc + xa2 + ya6 + a0 + ax2 + ay2 + more 'd
word fline + xa4 + ya4 + xb4 + ybC
word farc + xa2 + ya6 + a4 + ax2 + ay2 + more 'e
word fline + xa0 + ya6 + xb4 + yb6 + more
word fline + xa2 + ya4 + xb4 + yb4
word farc + xa4 + yaA + aD + ax2 + ay2 + more 'f
word fline + xa0 + ya8 + xb4 + yb8 + more
word fline + xa2 + ya4 + xb2 + ybA
word farc + xa2 + ya6 + a0 + ax2 + ay2 + more 'g
word farc + xa2 + ya3 + aF + ax2 + ay2 + more
word fline + xa4 + ya3 + xb4 + yb8 + more
word fline + xa1 + ya1 + xb2 + yb1
word farc + xa2 + ya6 + a8 + ax2 + ay2 + more 'h
word fline + xa0 + ya4 + xb0 + ybC + more
word fline + xa4 + ya4 + xb4 + yb6
word fline + xa1 + ya4 + xb3 + yb4 + more 'i
word fline + xa2 + ya4 + xb2 + yb8 + more
word fline + xa1 + ya8 + xb2 + yb8 + more
word fline + xa2 + yaB + xb2 + ybA
word farc + xa0 + ya3 + aF + ax2 + ay2 + more 'j
word fline + xa2 + ya3 + xb2 + yb8 + more
word fline + xa1 + ya8 + xb2 + yb8 + more
word fline + xa2 + yaB + xb2 + ybA
word fline + xa0 + ya4 + xb0 + ybC + more 'k
word fline + xa0 + ya6 + xb2 + yb6 + more
word fline + xa2 + ya6 + xb4 + yb8 + more
word fline + xa2 + ya6 + xb4 + yb4
word fline + xa1 + ya4 + xb3 + yb4 + more 'l
word fline + xa2 + ya4 + xb2 + ybC + more
word fline + xa1 + yaC + xb2 + ybC
word farc + xa1 + ya7 + a8 + ax1 + ay1 + more 'm
word farc + xa3 + ya7 + a8 + ax1 + ay1 + more
word fline + xa0 + ya4 + xb0 + yb8 + more
word fline + xa2 + ya4 + xb2 + yb7 + more
word fline + xa4 + ya4 + xb4 + yb7
word farc + xa2 + ya6 + a8 + ax2 + ay2 + more 'n
word fline + xa0 + ya4 + xb0 + yb8 + more
word fline + xa4 + ya4 + xb4 + yb6
word farc + xa2 + ya6 + a0 + ax2 + ay2 'o
word farc + xa2 + ya6 + a0 + ax2 + ay2 + more 'p
word fline + xa0 + ya1 + xb0 + yb8
word farc + xa2 + ya6 + a0 + ax2 + ay2 + more 'q
word fline + xa4 + ya1 + xb4 + yb8
word farc + xa2 + ya7 + a8 + ax2 + ay1 + more 'r
word fline + xa0 + ya4 + xb0 + yb8
word farc + xa2 + ya7 + a9 + ax2 + ay1 + more 's
word farc + xa2 + ya5 + aB + ax2 + ay1 + more
word fline + xa0 + ya4 + xb2 + yb4 + more
word fline + xa2 + ya8 + xb4 + yb8
word farc + xa4 + ya6 + aE + ax2 + ay2 + more 't
word fline + xa0 + ya8 + xb4 + yb8 + more
word fline + xa2 + ya6 + xb2 + ybA
word farc + xa2 + ya6 + aA + ax2 + ay2 + more 'u
word fline + xa0 + ya6 + xb0 + yb8 + more
word fline + xa4 + ya4 + xb4 + yb8
word fline + xa0 + ya8 + xb2 + yb4 + more 'v
word fline + xa4 + ya8 + xb2 + yb4
word farc + xa1 + ya5 + aA + ax1 + ay1 + more 'w
word farc + xa3 + ya5 + aA + ax1 + ay1 + more
word fline + xa0 + ya5 + xb0 + yb8 + more
word fline + xa2 + ya5 + xb2 + yb6 + more
word fline + xa4 + ya5 + xb4 + yb8
word fline + xa0 + ya8 + xb4 + yb4 + more 'x
word fline + xa0 + ya4 + xb4 + yb8
word farc + xa2 + ya6 + aA + ax2 + ay2 + more 'y
word farc + xa2 + ya3 + aF + ax2 + ay2 + more
word fline + xa4 + ya3 + xb4 + yb8 + more
word fline + xa0 + ya6 + xb0 + yb8 + more
word fline + xa1 + ya1 + xb2 + yb1
word fline + xa0 + ya8 + xb4 + yb8 + more 'z
word fline + xa4 + ya8 + xb0 + yb4 + more
word fline + xa0 + ya4 + xb4 + yb4
word farc + xa3 + yaA + aD + ax1 + ay3 + more '{
word farc + xa1 + ya6 + aC + ax1 + ay2 + more
word farc + xa1 + yaA + aF + ax1 + ay2 + more
word farc + xa3 + ya6 + aE + ax1 + ay3
word fline + xa2 + ya3 + xb2 + ybD '|
word farc + xa1 + yaA + aC + ax1 + ay3 + more '}
word farc + xa3 + ya6 + aD + ax1 + ay2 + more
word farc + xa3 + yaA + aE + ax1 + ay2 + more
word farc + xa1 + ya6 + aF + ax1 + ay3
word farc + xa1 + ya8 + a8 + ax1 + ay1 + more '~
word farc + xa3 + ya8 + aA + ax1 + ay1
' Vector font - custom characters ($7F+)
word fline + xa2 + ya9 + xb0 + yb4 + more 'delta
word fline + xa2 + ya9 + xb4 + yb4 + more
word fline + xa0 + ya4 + xb4 + yb4
word farc + xa2 + ya7 + a8 + ax2 + ay2 + more 'omega
word farc + xa1 + ya7 + aE + ax1 + ay2 + more
word farc + xa3 + ya7 + aF + ax1 + ay2 + more
word fline + xa1 + ya5 + xb1 + yb4 + more
word fline + xa3 + ya5 + xb3 + yb4 + more
word fline + xa0 + ya4 + xb1 + yb4 + more
word fline + xa4 + ya4 + xb3 + yb4
word farc + xa2 + ya8 + a0 + ax1 + ay1 'bullet
CON fx = 3 'number of custom characters
CON ''------------------------------------------------- GRAPHICS-HEAP
'
' diese daten werden zur laufzeit nur wärend des systemstarts gebraucht
' nach dem start steht dieser bereich bis zum screenpuffer als
' dynamischer speicher für strings, vektorobjekte und sprites zur verfügung
'
DAT ' graphics-heap-start (temp. pasm-puffer)
grdat
DAT ' keyboard-pasm-code (wird nach start als heap genutzt)
'******************************************
'* 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
mov data_s,data 'keyboard-de: store scancode for next table lookup with shift
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
'for keyboard-de changed #$DD to #lock
'in next code segment
cmpsub data,#lock 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,#lock
if_c_and_nz or stat,#4 'if change, set configure flag to update leds
{{ for keyboard-us-en start }}
{{
test y,#%11 wz 'get shift into nz
'
'Translate scan-codes $5B..$60 with characters from table "shift1"
'
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
'
'Translate scan-codes $27..$3D with characters from table "shift2"
'
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
}}
{{ for keyboard-us-en end }}
{{ for keyboard-de start }}
cmp data,#de_ae wz 'replace ae
if_z mov data,#"ä"
cmp data,#de_oe wz 'replace oe
if_z mov data,#"ö"
cmp data,#de_ue wz 'replace ue
if_z mov data,#"ü"
'
'Documentation of control-key bits
'
' test y,#%00000011 wz 'get SHIFT into nz
' test y,#%00000100 wz 'get CTRL-L into nz
' test y,#%00001000 wz 'get CTRL-R into nz
' test y,#%00010000 wz 'get ALT-L into nz
' test y,#%00100000 wz 'get ALT-R into nz
' test y,#%01000000 wz 'get WIN-L into nz
' test y,#%10000000 wz 'get WIN-R into nz
'
'Translate scan-codes with characters from "table_shift"
'
test y,#%00000011 wz 'get shift into nz
test _locks,#$40 wc
if_nz_and_nc mov data,data_s 'reload scancode
if_nz_and_nc call #look_shift 'translate by table_shift
'
'Translate scan-codes with characters from "table_alt_r"
'
test y,#%00100000 wz 'get ALT-R (AltGr) into nz
if_nz mov data,data_s 'reload scancode
if_nz call #look_alt_r 'translate by table_alt_r
{{ for keyboard-de end }}
: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
{{ for keyboard-de start }}
'
' Lookup byte in table_shift
'
look_shift ror data,#2 'perform lookup
movs :reg,data
add :reg,#table_shift
shr data,#27
mov x,data
:reg mov data,0
shr data,x
and data,#$FF 'isolate byte
look_shift_ret ret
'
' Lookup byte in table_alt_r
'
look_alt_r ror data,#2 'perform lookup
movs :reg,data
add :reg,#table_alt_r
shr data,#27
mov x,data
:reg mov data,0
shr data,x
and data,#$FF 'isolate byte
look_alt_r_ret ret
{{ for keyboard-de end }}
'
'
' 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
'
{{keyboard-us-en start}}
{{
table
'
'$00 --- F9 --- F5 F3 F1 F2 F12
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$00D8,$0000,$00D4,$00D2,$00D0,$00D1,$00DB
'
'$08 --- F10 F8 F6 F4 TAB ` ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$00D9,$00D7,$00D5,$00D3,$0009,$0060,$0000
' ALT-R Left CTRL-R
'$10 --- ALT-L SHIFT --- CTRL_L q 1 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$F5F4,$00F0,$0000,$F3F2,$0071,$0031,$0000
' WIN-L
'$18 --- --- z s a w 2 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$007A,$0073,$0061,$0077,$0032,$F600
' WIN-R
'$20 --- c x d e 4 3 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0063,$0078,$0064,$0065,$0034,$0033,$F700
' Apps
'$28 --- Spc v f t r 5 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0020,$0076,$0066,$0074,$0072,$0035,$CC00
' Power
'$30 --- n b h g y 6 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$006E,$0062,$0068,$0067,$0079,$0036,$CD00
' Sleep
'$38 --- --- m j u 7 8 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$006D,$006A,$0075,$0037,$0038,$CE00
'
'$40 --- , k i o 0 9 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$002C,$006B,$0069,$006F,$0030,$0039,$0000
' (/)
'$48 --- . / l } p + ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$002E,$EF2F,$006C,$003B,$0070,$002D,$0000
'
'$50 --- --- { --- [ = --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0027,$0000,$005B,$003D,$0000,$0000
' CAPS Right (ENTER) Wk.up
'$58 LOCK SHIFT ENTER ] --- \ --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $00DE,$00F1,$EB0D,$005D,$0000,$005C,$CF00,$0000
'
'$60 --- --- --- --- --- --- BkSpc ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0000,$0000,$0000,$0000,$00C8,$0000
' End Left Home
'$68 --- (1) --- (4) (7) --- --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$C5E1,$0000,$C0E4,$C4E7,$0000,$0000,$0000
' Ins Del Down --- Right Up
'$70 (0) (.) (2) (5) (6) (8) Esc NumLock
' ===== ===== ===== ===== ===== ===== ===== =====
word $CAE0,$C9EA,$C3E2,$00E5,$C1E6,$C2E8,$00CB,$00DF
' PgDn PrScr PgUp
'$78 F11 (+) (3) (-) (*) (9) ScrLock ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $00DA,$00EC,$C7E3,$00ED,$DCEE,$C6E9,$00DD,$0000
'
'$80 --- --- --- F7
' ===== ===== ===== =====
word $0000,$0000,$0000,$00D6
keypad1 byte $CA, $C5, $C3, $C7, $C0, 0, $C1, $C4, $C2, $C6, $C9, $0D, "+-*/"
keypad2 byte "0123456789.", $0D, "+-*/"
'
'Table "shift1" for scan-codes $5B..$60
'
shift1 byte "{|}", 0, 0, "~"
'
'Table "shift1" for scan-codes $27..$3D
'
shift2 byte $22, 0, 0, 0, 0, "<_>?)!@#$%^&*(", 0, ":", 0, "+"
}}
{{keyboard-us-en end}}
{{keyboard-de start}}
table
'
'$00 --- F9 --- F5 F3 F1 F2 F12
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$00D8,$0000,$00D4,$00D2,$00D0,$00D1,$00DB
'
'$08 --- F10 F8 F6 F4 TAB _^_ ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$00D9,$00D7,$00D5,$00D3,$0009,$005E,$0000
' ALT-R Left CTRL-R
'$10 --- ALT-L SHIFT --- CTRL_L q 1 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$F5F4,$00F0,$0000,$F3F2,$0071,$0031,$0000
' WIN-L
'$18 --- --- _y_ s a w 2 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0079,$0073,$0061,$0077,$0032,$F600
' WIN-R
'$20 --- c x d e 4 3 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0063,$0078,$0064,$0065,$0034,$0033,$F700
' Apps
'$28 --- Spc v f t r 5 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0020,$0076,$0066,$0074,$0072,$0035,Apps
' Power
'$30 --- n b h g _z_ 6 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$006E,$0062,$0068,$0067,$007A,$0036,Power
' Sleep
'$38 --- --- m j u 7 8 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$006D,$006A,$0075,$0037,$0038,Sleep
'
'$40 --- , k i o 0 9 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$002C,$006B,$0069,$006F,$0030,$0039,$0000
' (/)
'$48 --- . _-_ l _oe_ p _sz_ ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$002E,$EF2D,$006C,de_oe,$0070,$00DF,$0000
'
'$50 --- --- _ae_ --- _ue_ _'_ --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,de_ae,$0000,de_ue,$0060,$0000,$0000
' CAPS Right (ENTER) Wk.up
'$58 LOCK SHIFT ENTER _+_ --- # --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word CpsLk,$00F1,$EB0D,$002B,$0000,$0023,WkUp ,$0000
'
'$60 --- _<_ --- --- --- --- BkSpc ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$003C,$0000,$0000,$0000,$0000,BkSp ,$0000
' End Left Home
'$68 --- (1) --- (4) (7) --- --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,CrsEn,$0000,CrsLt,CrsHm,$0000,$0000,$0000
' Ins Del Down --- Right Up
'$70 (0) (.) (2) (5) (6) (8) Esc NumLock
' ===== ===== ===== ===== ===== ===== ===== =====
word Ins , Del ,CrsDn,$00E5,CrsRt,CrsUp, Esc ,NumLk
' PgDn PrScr PgUp
'$78 F11 (+) (3) (-) (*) (9) ScrLock ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $00DA,$00EC,PgDn ,$00ED,$DCEE,PgUp ,ScrLk,$0000
'
'$80 --- --- --- F7
' ===== ===== ===== =====
word $0000,$0000,$0000,$00D6
keypad1 byte $CA, $C5, $C3, $C7, $C0, 0, $C1, $C4, $C2, $C6, $C9, $0D, "+-*/"
keypad2 byte "0123456789.", $0D, "+-*/"
table_shift
'
'$00 --- F9 --- F5 F3 F1 F2 F12
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$00D8,$0000,$00D4,$00D2,$00D0,$00D1,$00DB
'
'$08 --- F10 F8 F6 F4 TAB _°_ ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$00D9,$00D7,$00D5,$00D3,$0009,$00B0,$0000
' ALT-R Left CTRL-R
'$10 --- ALT-L SHIFT --- CTRL_L Q ! ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$F5F4,$00F0,$0000,$F3F2,$0051,$0021,$0000
' WIN-L
'$18 --- --- _Y_ S A W " ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0059,$0053,$0041,$0057,$0022,$F600
' WIN-R
'$20 --- C X D E $ SHF+3 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0043,$0058,$0044,$0045,$0024,$0014,$F700
' Apps
'$28 --- Spc V F T R % ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0020,$0056,$0046,$0054,$0052,$0025,Apps
' Power
'$30 --- N B H G _Z_ & ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$004E,$0042,$0048,$0047,$005A,$0026,Power
' Sleep
'$38 --- --- M J U / ( ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$004D,$004A,$0055,$002F,$0028,Sleep
'
'$40 --- ; K I O _=_ ) ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$003B,$004B,$0049,$004F,$003D,$0029,$0000
' (/)
'$48 --- : ___ L _OE_ P _sz_ ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$003A,$EF5F,$004C,$00D6,$0050,$003F,$0000
'
'$50 --- --- _AE_ --- _UE_ _'_ --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$00C4,$0000,$00DC,$0060,$0000,$0000
' CAPS Right (ENTER) Wk.up
'$58 LOCK SHIFT ENTER _*_ --- _'_ --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word CpsLk,$00F1,$EB0D,$002A,$0000,$0027,WkUp ,$0000
'
'$60 --- _>_ --- --- --- --- BkSpc ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$003E,$0000,$0000,$0000,$0000,BkSp ,$0000
' End Left Home
'$68 --- (1) --- (4) (7) --- --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,CrsEn,$0000,CrsLt,CrsHm,$0000,$0000,$0000
' Ins Del Down --- Right Up
'$70 (0) (.) (2) (5) (6) (8) Esc NumLock
' ===== ===== ===== ===== ===== ===== ===== =====
word Ins , Del ,CrsDn,$00E5,CrsRt,CrsUp, Esc ,NumLk
' PgDn PrScr PgUp
'$78 F11 (+) (3) (-) (*) (9) ScrLock ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $00DA,$00EC,PgDn ,$00ED,$DCEE,PgUp ,ScrLk,$0000
'
'$80 --- --- --- F7
' ===== ===== ===== =====
word $0000,$0000,$0000,$00D6
table_alt_r
'
'$00 --- F9 --- F5 F3 F1 F2 F12
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0097,$0000,$0090,$009D,$009F,$009E,$0094
'
'$08 --- F10 F8 F6 F4 TAB _^_ ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0096,$0093,$0091,$009C,$0009,$0000,$0000
' ALT-R Left CTRL-R
'$10 --- ALT-L SHIFT --- CTRL_L q 1 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$F5F4,$00F0,$0000,$F3F2, "@", "¹", $0000
' WIN-L
'$18 --- --- _y_ s a w 2 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0000,$0000,$0000,$0000, "²", $F600
' WIN-R
'$20 --- c x d e 4 3 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0000,$0000, "€", $0000, "³", $F700
' Apps
'$28 --- Spc v f t r 5 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0000,$0000,$0000,$0000,$0000,Apps
' Power
'$30 --- n b h g _z_ 6 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0000,$0000,$0000,$0000,$0000,Power
' Sleep
'$38 --- --- m j u 7 8 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000, "µ", $0000,$0000, "{" , "[" ,Sleep
'
'$40 --- , k i o 0 9 ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0000,$0000,$0000, "}", "]", $0000
' (/)
'$48 --- . _-_ l _oe_ p _sz_ ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0000,$0000,$0000,$0000, "\", $0000
'
'$50 --- --- _ae_ --- _ue_ _'_ --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,$0000,$0000,$0000,$0000,$0000,$0000,$0000
' CAPS Right (ENTER) Wk.up
'$58 LOCK SHIFT ENTER _+_ --- # --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word CpsLk,$00F1,$EB0D, "~", $0000,$0000,WkUp ,$0000
'
'$60 --- _<_ --- --- --- --- BkSpc ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000, "|", $0000,$0000,$0000,$0000,BkSp ,$0000
' End Left Home
'$68 --- (1) --- (4) (7) --- --- ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0000,CrsEn,$0000,CrsLt,CrsHm,$0000,$0000,$0000
' Ins Del Down --- Right Up
'$70 (0) (.) (2) (5) (6) (8) Esc NumLock
' ===== ===== ===== ===== ===== ===== ===== =====
word Ins , Del ,CrsDn,$00E5,CrsRt,CrsUp, Esc ,NumLk
' PgDn PrScr PgUp
'$78 F11 (+) (3) (-) (*) (9) ScrLock ---
' ===== ===== ===== ===== ===== ===== ===== =====
word $0095,$00EC,PgDn ,$00ED,$DCEE,PgUp ,ScrLk,$0000
'
'$80 --- --- --- F7
' ===== ===== ===== =====
word $0000,$0000,$0000,$0092
{{keyboard-de end}}
'
'
' Uninitialized data
'
dmask res 1
cmask res 1
stat res 1
data res 1
data_s res 1 'Scancode-Storage (for keyboard-de)
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.
DAT ' graphics-pasm-code (wird nach start als heap genutzt)
'*************************************
'* Assembly language graphics driver *
'*************************************
org
'
'
' Graphics driver - main loop
'
loop rdlong t1,par wz 'wait for command
if_z jmp #loop
movd :arg,#arg0 'get 8 arguments
mov t2,t1
mov t3,#8
:arg rdlong arg0,t2
add :arg,d0
add t2,#4
djnz t3,#:arg
wrlong zero,par 'zero command to signify received
call #setd 'set dx,dy from arg0,arg1
ror t1,#16+2 'lookup command address
add t1,#jumps
movs :table,t1
rol t1,#2
shl t1,#3
:table mov t2,0
shr t2,t1
and t2,#$FF
jmp t2 'jump to command
jumps byte 0 '0
byte setup_ '1
byte color_ '2
byte width_ '3
byte plot_ '4
byte line_ '5
byte arc_ '6
byte vec_ '7
byte vecarc_ '8
byte pix_ '9
byte pixarc_ 'A
byte text_ 'B
byte textarc_ 'C
byte textmode_ 'D
byte fill_ 'E
byte loop 'F
'
'
' setup(x_tiles, y_tiles*16, x_origin, y_origin, base_ptr) bases_ptr, slices_ptr
'
setup_ mov xlongs,arg0 'set xlongs, ylongs
mov ylongs,arg1
mov xorigin,arg2 'set xorigin, yorigin
mov yorigin,arg3
mov basesptr,arg5 'set pointers
mov slicesptr,arg6
jmp #loop
'
'
' color(c)
'
color_ mov pcolor,arg0 'set pixel color
jmp #loop
'
'
' width(w) pixel_passes
'
width_ mov pwidth,arg0 'set pixel width
mov passes,arg1 'set pixel passes
jmp #loop
'
'
' plot(x, y)
'
plot_ call #plotd
jmp #loop
'
'
' line(x, y)
'
line_ call #linepd
jmp #loop
'
'
' arc(x, y, xr, yr, angle, anglestep, iterations, mode)
'
arc_ and arg7,#3 'limit mode
:loop call #arca 'get arc dx,dy
cmp arg7,#1 wz 'if not mode 1, set px,py
if_nz mov px,dx
if_nz mov py,dy
tjz arg6,#loop 'if no points exit with new px,py
cmp arg7,#3 wz 'if mode 3, set center
if_z call #setd
test arg7,#1 wz 'if mode 0 or 2, plot point
if_z call #plotp
test arg7,#1 wz 'if mode 1 or 3, plot line
if_nz call #linepd
cmp arg7,#2 wz 'if mode 2, set mode 1
if_z mov arg7,#1
add arg4,arg5 'step angle
djnz arg6,#:loop 'loop if more iterations
jmp #loop
'
'
' vec(x, y, vecscale, vecangle, vecdef_ptr)
' vecarc(x, y, xr, yr, angle, vecscale, vecangle, vecdef_ptr)
'
' vecdef: word $8000/$4000+angle 'vector mode + 13-bit angle (mode: $4000=plot, $8000=line)
' word length 'vector length
' ... 'more vectors
' ...
' word 0 'end of definition
'
vecarc_ call #arcmod
vec_ tjz arg2,#loop 'if scale 0, exit
:loop rdword t7,arg4 wz 'get vector mode+angle
add arg4,#2
if_z jmp #loop 'if mode+angle 0, exit
rdword t1,arg4 'get vector length
add arg4,#2
abs t2,arg2 wc 'add/sub vector angle to/from angle
mov t6,arg3
sumc t6,t7
call #multiply 'multiply length by scale
add t1,#$80 'round up 1/2 lsb
shr t1,#8
mov t4,t1 'get arc dx,dy
mov t5,t1
call #arcd
test t7,h8000 wc 'plot pixel or draw line?
if_nc call #plotd
test t7,h8000 wc
if_c call #linepd
jmp #:loop 'get next vector
'
'
' pix(x, y, pixrot, pixdef_ptr)
' pixarc(x, y, xr, yr, angle, pixrot, pixdef_ptr)
'
' pixdef: word
' byte xwords, ywords, xorigin, yorigin
' word %%xxxxxxxx,%%xxxxxxxx
' word %%xxxxxxxx,%%xxxxxxxx
' word %%xxxxxxxx,%%xxxxxxxx
' ...
'
pixarc_ call #arcmod
pix_ mov t6,pcolor 'save color
mov px,dx 'get center into px,py
mov py,dy
mov sy,pwidth 'get actual pixel width
add sy,#1
rdbyte dx,arg3 'get dimensions into dx,dy
add arg3,#1
rdbyte dy,arg3
add arg3,#1
rdbyte t1,arg3 'get origin and adjust px,py
add arg3,#1
rdbyte t2,arg3
add arg3,#1
neg t2,t2
sub t2,#1
add t2,dy
mov t3,sy
:adjust test arg2,#%001 wz
test arg2,#%110 wc
if_z sumnc px,t1
if_nz sumc py,t1
test arg2,#%010 wc
if_nz sumnc px,t2
if_z sumnc py,t2
djnz t3,#:adjust
:yline mov sx,#0 'plot entire pix
mov t3,dx
:xword rdword t4,arg3 'read next pix word
add arg3,#2
shl t4,#16
mov t5,#8
:xpixel rol t4,#2 'plot pixel within word
test t4,#1 wc 'set color
muxc pcolor,color1
test t4,#2 wc
muxc pcolor,color2 wz '(z=1 if color=0)
if_nz call #plotp
test arg2,#%001 wz 'update px,py for next x
test arg2,#%110 wc
if_z sumc px,sy
if_nz sumnc py,sy
add sx,sy
djnz t5,#:xpixel 'another x pixel?
djnz t3,#:xword 'another x word?
if_z sumnc px,sx 'update px,py for next y
if_nz sumc py,sx
test arg2,#%010 wc
if_nz sumc px,sy
if_z sumc py,sy
djnz dy,#:yline 'another y line?
mov pcolor,t6 'restore color
jmp #loop
'
'
' text(x, y, @string) justx, justy
' textarc(x, y, xr, yr, angle, @string) justx, justy
'
textarc_ call #arcmod
text_ add arg3,arg0 'add x into justx
add arg4,arg1 'add y into justy
:chr rdbyte t1,arg2 wz 'get chr
add arg2,#1
if_z jmp #loop 'if 0, done
sub t1,#$21 'if chr out of range, skip
cmp t1,#$7F-$21+fx wc
if_nc jmp #:skip
mov arg5,fontptr 'scan font for chr definition
:scan tjz t1,#:def
rdword t2,arg5
add arg5,#2
test t2,h8000 wc
if_nc sub t1,#1
jmp #:scan
:def rdword t7,arg5 'get font definition word
add arg5,#2
call #fontxy 'extract initial x,y
test t7,#$80 wc 'arc or line?
if_nc jmp #:line
mov t2,textsx 'arc, extract x radius
mov t3,#%0001_0001_1
call #fontb
mov t4,t1
mov t2,textsy 'extract y radius
mov t3,#%0010_0011_1
call #fontb
mov t5,t1
mov t2,#1 'extract starting angle
mov t3,#%0010_0011_0
call #fontb
shl t1,#11
mov t6,t1 'extract angle sweep
mov t3,#%0010_0011_0
call #fontb
neg arg6,t1
shl arg6,#4
add arg6,#65
call #arcd 'plot initial arc point
call #plotd
:arc call #arcd 'connect subsequent arc points with lines
call #linepd
add t6,#$80
djnz arg6,#:arc
jmp #:more
:line call #plotd 'line, plot initial x,y
call #fontxy 'extract terminal x,y
call #linepd 'draw line
:more test t7,#$02 wc 'more font definition?
if_c jmp #:def
:skip mov t1,textsp 'advance x to next chr position
mov t2,textsx
call #multiply
add arg3,t1
jmp #:chr 'get next chr
fontxy mov t2,textsx 'extract x
mov t3,#%0011_0111_0
call #fontb
mov arg0,t1
add arg0,arg3
mov t2,textsy 'extract y
mov t3,#%0100_1111_0
call #fontb
mov arg1,t1
add arg1,arg4
setd mov dx,xorigin 'set dx,dy from arg0,arg1
add dx,arg0
mov dy,yorigin
sub dy,arg1
setd_ret
fontxy_ret ret
fontb mov t1,t7 'extract bitrange from font word
shr t3,#1 wc
and t1,t3
if_c add t1,#1
shr t3,#4
shr t7,t3
shl t1,#32-4 'multiply t1[3..0] by t2
mov t3,#4
:loop shl t1,#1 wc
if_c add t1,t2
djnz t3,#:loop
fontb_ret ret
'
'
' textmode(x_scale, y_scale, spacing, justification)
'
textmode_ mov textsx,arg0 'set text x scale
mov textsy,arg1 'set text y scale
mov textsp,arg2 'set text spacing
jmp #loop
'
'
' fill(x, y, da, db, db2, linechange, lines_minus_1)
'
fill_ shl dx,#16 'get left and right fractions
or dx,h8000
mov t1,dx
mov t2,xlongs 'get x pixels
shl t2,#4
add arg6,#1 'pre-increment line counter
:yloop add dx,arg2 'adjust left and right fractions
add t1,arg3
cmps dx,t1 wc 'get left and right integers
if_c mov base0,dx
if_c mov base1,t1
if_nc mov base0,t1
if_nc mov base1,dx
sar base0,#16
sar base1,#16
cmps base0,t2 wc 'left out of range?
if_c cmps hFFFFFFFF,base1 wc 'right out of range?
if_c cmp dy,ylongs wc 'y out of range?
if_nc jmp #:skip 'if any, skip
mins base0,#0 'limit left and right
maxs base1,t2 wc
if_nc sub base1,#1
shl base0,#1 'make left mask
neg mask0,#1
shl mask0,base0
shr base0,#5
shl base1,#1 'make right mask
xor base1,#$1E
neg mask1,#1
shr mask1,base1
shr base1,#5
sub base1,base0 wz 'ready long count
add base1,#1
if_z and mask0,mask1 'if single long, merge masks
shl base0,#1 'get long base
add base0,basesptr
rdword base0,base0
shl dy,#2
add base0,dy
shr dy,#2
mov bits0,mask0 'ready left mask
:xloop mov bits1,pcolor 'make color mask
and bits1,bits0
rdlong pass,base0 'read-modify-write long
andn pass,bits0
or pass,bits1
wrlong pass,base0
shl ylongs,#2 'advance to next long
add base0,ylongs
shr ylongs,#2
cmp base1,#2 wz 'one more?
if_nz neg bits0,#1 'if not, ready full mask
if_z mov bits0,mask1 'if one more, ready right mask
djnz base1,#:xloop 'loop if more longs
:skip sub arg5,#1 wc 'delta change?
if_c mov arg3,arg4 'if so, set new deltas
:same
add dy,#1 'adjust y
djnz arg6,#:yloop 'another y?
jmp #loop
'
'
' Plot line from px,py to dx,dy
'
linepd cmps dx,px wc, wr 'get x difference
negc sx,#1 'set x direction
cmps dy,py wc, wr 'get y difference
negc sy,#1 'set y direction
abs dx,dx 'make differences absolute
abs dy,dy
cmp dx,dy wc 'determine dominant axis
if_nc tjz dx,#:last 'if both differences 0, plot single pixel
if_nc mov count,dx 'set pixel count
if_c mov count,dy
mov ratio,count 'set initial ratio
shr ratio,#1
if_c jmp #:yloop 'x or y dominant?
:xloop call #plotp 'dominant x line
add px,sx
sub ratio,dy wc
if_c add ratio,dx
if_c add py,sy
djnz count,#:xloop
jmp #:last 'plot last pixel
:yloop call #plotp 'dominant y line
add py,sy
sub ratio,dx wc
if_c add ratio,dy
if_c add px,sx
djnz count,#:yloop
:last call #plotp 'plot last pixel
linepd_ret ret
'
'
' Plot pixel at px,py
'
plotd mov px,dx 'set px,py to dx,dy
mov py,dy
plotp tjnz pwidth,#wplot 'if width > 0, do wide plot
mov t1,px 'compute pixel mask
shl t1,#1
mov mask0,#%11
shl mask0,t1
shr t1,#5
cmp t1,xlongs wc 'if x or y out of bounds, exit
if_c cmp py,ylongs wc
if_nc jmp #plotp_ret
mov bits0,pcolor 'compute pixel bits
and bits0,mask0
shl t1,#1 'get address of pixel long
add t1,basesptr
mov t2,py
rdword t1,t1
shl t2,#2
add t1,t2
rdlong t2,t1 'write pixel
andn t2,mask0
or t2,bits0
wrlong t2,t1
plotp_ret
plotd_ret ret
'
'
' Plot wide pixel
'
wplot mov t1,py 'if y out of bounds, exit
add t1,#7
mov t2,ylongs
add t2,#7+8
cmp t1,t2 wc
if_nc jmp #plotp_ret
mov t1,px 'determine x long pair
sub t1,#8
sar t1,#4
cmp t1,xlongs wc
muxc jumps,#%01 '(use jumps[1..0] to store writes)
add t1,#1
cmp t1,xlongs wc
muxc jumps,#%10
test jumps,#%11 wz 'if x out of bounds, exit
if_z jmp #plotp_ret
shl t1,#1 'get base pair
add t1,basesptr
rdword base1,t1
sub t1,#2
rdword base0,t1
mov t1,px 'determine pair shifts
shl t1,#1
movs :shift1,t1
xor :shift1,#7<<1
add t1,#9<<1
movs :shift0,t1
test t1,#$F<<1 wz '(account for special case)
if_z andn jumps,#%01
mov pass,#0 'ready to plot slices
mov slice,slicesptr
:loop rdlong mask0,slice 'get next slice
mov mask1,mask0
:shift0 shl mask0,#0 'position slice
:shift1 shr mask1,#0
mov bits0,pcolor 'colorize slice
and bits0,mask0
mov bits1,pcolor
and bits1,mask1
mov t1,py 'plot lower slice
add t1,pass
cmp t1,ylongs wc
if_c call #wslice
mov t1,py 'plot upper slice
test pwidth,#1 wc
subx t1,pass
cmp t1,ylongs wc
if_c call #wslice
add slice,#4 'next slice
add pass,#1
cmp pass,passes wz
if_nz jmp #:loop
jmp #plotp_ret
'
'
' Plot wide pixel slice
'
wslice shl t1,#2 'ready long offset
add base0,t1 'plot left slice
test jumps,#%01 wc
if_c rdlong t2,base0
if_c andn t2,mask0
if_c or t2,bits0
if_c wrlong t2,base0
add base1,t1 'plot right slice
test jumps,#%10 wc
if_c rdlong t2,base1
if_c andn t2,mask1
if_c or t2,bits1
if_c wrlong t2,base1
sub base0,t1 'restore bases
sub base1,t1
wslice_ret ret
'
'
' Get arc point from args and then move args 5..7 to 2..4
'
arcmod call #arca 'get arc using first 5 args
mov arg0,dx 'set arg0,arg1
sub arg0,xorigin
mov arg1,yorigin
sub arg1,dy
mov arg2,arg5 'move args 5..7 to 2..4
mov arg3,arg6
mov arg4,arg7
arcmod_ret ret
'
'
' Get arc dx,dy from arg0,arg1
'
' in: arg0,arg1 = center x,y
' arg2/t4 = x length
' arg3/t5 = y length
' arg4/t6 = 13-bit angle
'
' out: dx,dy = arc point
'
arca mov t4,arg2 'use args
mov t5,arg3
mov t6,arg4
arcd call #setd 'reset dx,dy to arg0,arg1
mov t1,t6 'get arc dx
mov t2,t4
call #polarx
add dx,t1
mov t1,t6 'get arc dy
mov t2,t5
call #polary
sub dy,t1
arcd_ret
arca_ret ret
'
'
' Polar to cartesian
'
' in: t1 = 13-bit angle
' t2 = 16-bit length
'
' out: t1 = x|y
'
polarx add t1,sine_90 'cosine, add 90° for sine lookup
polary test t1,sine_180 wz 'get sine quadrant 3|4 into nz
test t1,sine_90 wc 'get sine quadrant 2|4 into c
negc t1,t1 'if sine quadrant 2|4, negate table offset
or t1,sine_table 'or in sine table address >> 1
shl t1,#1 'shift left to get final word address
rdword t1,t1 'read sine/cosine word
call #multiply 'multiply sine/cosine by length to get x|y
add t1,h8000 'add 1/2 lsb to round up x|y fraction
shr t1,#16 'justify x|y integer
negnz t1,t1 'if sine quadrant 3|4, negate x|y
polary_ret
polarx_ret ret
sine_90 long $0800 '90° bit
sine_180 long $1000 '180° bit
sine_table long $E000 >> 1 'sine table address shifted right
'
'
' Multiply
'
' in: t1 = 16-bit multiplicand (t1[31..16] must be 0)
' t2 = 16-bit multiplier
'
' out: t1 = 32-bit product
'
multiply mov t3,#16
shl t2,#16
shr t1,#1 wc
:loop if_c add t1,t2 wc
rcr t1,#1 wc
djnz t3,#:loop
multiply_ret ret
'
'
' Defined data
'
zero long 0 'constants
d0 long $200
h8000 long $8000
hFFFFFFFF long $FFFFFFFF
color1 long %%1111111111111111
color2 long %%2222222222222222
fontptr long 0 'font pointer (set before cognew command)
pcolor long %%1111111111111111 'pixel color
pwidth long 0 'pixel width
passes long 1 'pixel passes
textsx long 1 'text scale x
textsy long 1 'text scale y
textsp long 6 'text spacing
'
'
' Undefined data
'
t1 res 1 'temps
t2 res 1
t3 res 1
t4 res 1
t5 res 1
t6 res 1
t7 res 1
arg0 res 1 'arguments passed from high-level
arg1 res 1
arg2 res 1
arg3 res 1
arg4 res 1
arg5 res 1
arg6 res 1
arg7 res 1
basesptr res 1 'pointers
slicesptr res 1
xlongs res 1 'bitmap metrics
ylongs res 1
xorigin res 1
yorigin res 1
dx res 1 'line/plot coordinates
dy res 1
px res 1
py res 1
sx res 1 'line
sy res 1
count res 1
ratio res 1
pass res 1 'plot
slice res 1
base0 res 1
base1 res 1
mask0 res 1
mask1 res 1
bits0 res 1
bits1 res 1
DAT ' graphics-heap-ende
grdatend
{{ ' lizenz
┌──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┐
│ 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. │
└──────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────────┘
}}