save
ok  Hey there. Hit ALT to see a shadow block with info.
ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok
 ok save
ok
 ok  0 block dump
ok save
ok .s
ok  0 block dump
ok
 ok
 ok save
ok
 ok save
ok
 ok
 ok
 ok
 ok
 ok
 ok save
ok
 ok
 ok
 ok
 ok
 ok .s
ok tetris
ok mem
ok
 ok
 ok
 ok warm
ok mem
ok warm
ok
 ok mem
ok
 ok warm
ok
 ok save
ok mem
ok .s
ok
 ok mem
ok
 ok
 ok
 ok Warm Boot! - HEIGTH word?
 ok
 ok
 ok 768 18  1024 /mod .s
ok 19200 .s
ok  768 25 *
ok save
ok mem
ok
 ok ..
ok 0 768 768 468 0 300  640 480 * 1024 /mod .s
ok 0 768 768 468  800 600 * 1024 /mod .s
ok 0 768  1024 768 * 1024 /mod .s
ok mem
ok
 ok
 ok mem
ok
 ok mem
ok  18 l

Boot enth 1 set-order
enth set-current multi
marker boot 13 load
warm kernel wake stop ;
screen 7 block read ;
12x22 8 block read ;
6x11 9 block read ;
disk1 1440 blocks ;
floppy@ 1  18 block read ;
floppy! 0  18 block read ;
l block ed 11 block read ;
when 17 block read ;
mem 16 block read ;
flux1 disk1 10000 + ;
save 20000  flux1  8000 move disk1 floppy! ;
revert flux1 400 +  20400  7f00 move ;
dump 10 block read ;
words 15 block read ;
tetris 20 block read ;
bye 3 block read ;
keys noop ;
marker basic
flux set-current disk1 floppy@ 4 load 2 load
await stop single 0  100000 ! self self ! boot end ; await

Color Terminal
0 1024 master cede
tib 0 block ;
emit tib dup dup 1 + 1023 cmove> c! ;
type push tib dup dup r@ + 1024 r@ - cmove> pop cmove ;
ok end ;
comment type 10 emit ;
. s>d number comment ;
u. 0 number comment ;
.s depth -1 ? if for depth r@ neg + pick . next ; then drop ;
marker terminal
spot 1024 allot macros
." " count type ; :
caught catch -1 ? drop ;
wrong spad count comment ;
edit tib  ed caught if revert wrong ."  Warm Boot! -" warm then ;
in tib 768 +  256 erase ."
  ok" spot edit tib over 1024 cmove ;
panic .. 0 hand ! ;
check depth 80000000 ? drop if depth abs . ."  Stack Underflow -" .. then ;
start mark off empty panic ..r
listen in read caught if wrong panic then check listen ;
start terminal ignore
Personal
wipe block 1024 erase ;
copy block push block pop 1024 cmove ;
call

Bye
RTC programmable int off
cli fac3 2, sti fbc3 2,
cli b 70 pc! 71 pc@ bf and b 70 pc! 71 pc!
c 70 pc! 71 pc@ drop sti
Reset machine via keyboard controller
fe 64 pc!

Keyboard
marker keyboard
vars effect keypad s1 s2 leds : -1 dup s1 ! s2 !
ekeys var 1096 allot
ckeys var 0 ,
esc       0 , 1! 21213131 , 2@ 40403232 , 3# 23233333 ,
4$ 24243434 , 5% 25253535 , 6^ 5E5E3636 , 7& 26263737 ,
8* 2A2A3838 , 9( 28283939 , 0) 29293030 , -_ 5F5F2D2D ,
=+ 2B2B3D3D , bkspace   0 , tab       0 , qQ 71515171 ,
wW 77575777 , eE 65454565 , rR 72525272 , tT 74545474 ,
yY 79595979 , uU 75555575 , iI 69494969 , oO 6F4F4F6F ,
pP 70505070 , [{ 7B7B5B5B , ]} 7D7D5D5D , enter     0 ,
ctrl      0 , aA 61414161 , sS 73535373 , dD 64444464 ,
fF 66464666 , gG 67474767 , hH 68484868 , jJ 6A4A4A6A ,
kK 6B4B4B6B , lL 6C4C4C6C , ;: 3A3A3B3B , '" 22222727 ,
`~ 7E7E6060 , lshift    0 , \| 7C7C5C5C , zZ 7A5A5A7A ,
xX 78585878 , cC 63434363 , vV 76565676 , bB 62424262 ,
nN 6E4E4E6E , mM 6D4D4D6D , ,< 3C3C2C2C , .> 3E3E2E2E ,
/? 3F3F2F2F , here 132 allot 132 erase
f11 20202020 , f12 20202020 , here 192 allot 192 erase

Keyboard
macros <>; 3906 2, drop if ; then ; :
irq1 fff4 ;
cmd n- 60 pc! wait 64 pc@ 2 ? drop if pause wait ; then ;
sc@ -u irq1 @ -1 ? if pc@ 0  irq1 ! ; then drop pause sc@ ;
sc -u sc@ e1 <>; drop sc@ drop sc@ drop sc ;
exdn u-v 2a <>; drop sc e0 <>; sc nip ;
exup u-v aa <>; drop sc e0 <>; sc exdn nip ;
scan sc e0 <>; sc exdn exup nip ;
xkeys keypad @ + 1 + dup @ + 4 + call ;
asc u-c 4 * effect @ + ckeys + c@ -1 ? ;
ascii u- dup asc if nip 0 xkeys ; then
exe u- swap 8 * + ekeys + @ call ;
process u- 80 ? if 7f and 4 exe ; then ascii ;
done pop drop ;
listen r@ keypad ! 1 scan process jump done listen
listen keys is
s+ s1 @ s2 @ and if 2  effect +! then drop ;
s- a- @ -1 ? if -2  effect +! then drop ;
s1+ s+ 0  s1 ! ;
s1- s2 s- -1  s1 ! ;
s2+ s+ 0  s2 ! ;
s2- s1 s- -1  s2 ! ;
adj 4 ? if -1 ; then 1 ;
caps leds @ adj effect +! 4 xor leds !
lights ed cmd leds @ cmd ;
repeat f3 cmd 5 cmd lights

Keyboard
!+ an-b over ! 4 + ;
n noop !+ ;
v n n ;
x push here !+ pop 5 * lit xkeys ; n ;
k push !+ pop !+ ;
ekeys v esc 1 x v v v v v v v v v v v v bks 14 x tab 15 x v v v v v v v v v v v v 0= noop k ctl 22 x v v v v v v v v v v v v s1+ s1- k v v v v v v v v v v v s2+ s2- k v 23 x spc 24 x caps noop k f1 2 x 3 x 4 x 5 x 6 x 7 x 8 x 9 x 10 x 11 x 69 v v 71 17 x 25 x 21 x v 26 x v 28 x v 20 x 27 x 18 x 16 x 19 x v v v 12 x 13 x v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v v drop
keyboard ignore end

Video
vars xy color :
rgb push push 8 f81f c@ - shr f820 c@ shl pop 8 f821 c@ - shr f822 c@ shl pop 8 f823 c@ - shr f824 c@ shl or or ;
pen dup 16 shl or color ! ;
black 00 00 00 rgb pen ;
white ff ff ff rgb pen ;
red ff 00 00 rgb pen ;
blue 00 00 ff rgb pen ;
green 00 ff 00 rgb pen ;
cyan 00 ff ff rgb pen ;
magenta ff 00 ff rgb pen ;
yellow ff ff 00 rgb pen ;
width f812 w@ ;
height f814 w@ ;
frame width height * 2* 1024 / 50 + blocks ;
at height min width * + 2* frame + xy ! ;
get xy @ frame - 2/ width /mod ;
+at width * + 2* xy +! ;
box pause push push xy @ pop 2/ pop for over over color @ flood width 2* u+ next drop drop ;
page frame dup width height * 2/  color @ flood xy ! ;
switch frame  f828 @  width height * 2/ move ;
end

12x22
cr get 22 + push drop 0 pop at ;
cf 24  xy +! ;
space get drop width 25 - - 1 min 0 max jump cf cr
ascii var 512 allot marker font
vars i a : 1d800 i ! ascii a !
ln width 2* 22 - ;
fp over over w! 2 + ;
fpl over over w! ln + ;
rev dup ff and 8 shl swap 8 shr or ;
@+ i @ w@ rev 2  i +! ;
!+ here a @ ! 4  a +! ;
!> here a @ 60 + ! ;
b -1 ? if lit + fp 0 ; then fp ;
b; -1 ? if lit + fpl 0 ; then fpl ;
p 2* 10000 ? if push b pop ; then 2 u+ ;
p; 2* 10000 ? if push b; pop ; then ln u+ ;
l @+ p p p p p p p p p p p p; drop ;
c 0  22 for l next lit + space ; ;
exp for !+ c next ;
fg color dup @ lit lit ! ;
t fg space ; !> fg cr ; ;
w !+ t ; n !+ lit base ! t ;
00 99 ff rgb dup pen w red w green w white w cyan 10 n magenta 16 n yellow w 99 aa 66 rgb pen w pen w w w w w w w w 64 a +! 96 exp font ignore
emit c- pause 127 min 4 * ascii + @ push color @ xy @ pop call drop drop ;
type au- -1 ? if for dup c@ emit 1 + next drop ; then drop drop ;
. s>d number type ; u. 0 number type ;
end

6x11
cr get 11 + push drop 0 pop at ;
cf 12  xy +! ;
space get drop width 13 - - 1 min 0 max jump cf cr
ascii var 512 allot marker font
vars i a : 1d800 4224 + i ! ascii a !
ln width 2* 10 - ;
fp over over w! 2 + ;
fpl over over w! ln + ;
@+ i @ c@ 1  i +! ;
!+ here a @ ! 4  a +! ;
!> here a @ 60 + ! ;
b -1 ? if lit + fp 0 ; then fp ;
b; -1 ? if lit + fpl 0 ; then fpl ;
p 2* 100 ? if push b pop ; then 2 u+ ;
p; 2* 100 ? if push b; pop ; then ln u+ ;
l @+ p p p p p p; drop ;
c 0  11 for l next lit + space ; ;
exp for !+ c next ;
fg color dup @ lit lit ! ;
t fg space ; !> fg cr ; ;
w !+ t ; n !+ lit base ! t ;
00 99 ff rgb dup pen w red w green w white w cyan 10 n magenta 16 n yellow w 99 aa 66 rgb pen w pen w w w w w w w w 64 a +! 96 exp font ignore
emit c- pause 127 min 4 * ascii + @ push color @ xy @ pop call drop drop ;
type au- -1 ? if for dup c@ emit 1 + next drop ; then drop drop ;
. s>d number type ; u. 0 number type ;
end

Dump a-
basic branch dump
mem , screen 12x22
line width 1022 - 2 min 1 max ;
incr line 3 shl ; lines 16 ;
digits over - 0 max -1 ? if for 48 emit next ; then drop ;
n. push 5 emit s>d number pop digits type ;
lo dup ff and ;
b lo 2 n. 8 shr ;
c lo 20 max emit 8 shr ;
@+ dup @ 4 u+ ;
dword @+ b b b b drop ;
equiv @+ c c c c drop ;
addr dup 8 n. space ;
orig "  Origin" count type mem @ addr drop cr cr mem @ ;
nums line for dword dword space next ;
text 10 emit line for equiv equiv space next ;
draw orig lines for addr nums incr - text cr next drop ;
out black page draw switch 20 ms out ;
point mem @ + 0 max mem ! ;
up incr neg point ; dn incr point ;
pgup incr lines * dup point ; pgdn neg point ;
l drop n ;
in keys l n n n n n n n n n n n n n n n n n pgup n n pgdn n n n up n dn n
out child in
dump end

Color Editor
basic branch editor
screen 12x22 macros
." " count type ; ;
ex pop drop ; :
pg 1024 ; sb 64 pg * ,
s dup , p dup 1 + , l pg + ,
last l @ 1 - ;
true -1 ? drop ;
bounds s @ max last min ;
in p @ ;
+to in +
to bounds p ! ;
+@ + dup c@ ;
@+ over c@ push + pop ;
check -1 +@ true if ex 1 + then ;
scan l @ check pg times ;
rear color @ swap 12  22 box black emit color ! ;
fore xy @ push emit xy @ pop xy ! 20 rear xy ! ;
cur 1 @+ e0 ? if rear ; then fore ;
show push r@ over over - type cur pg over pop - - type ;
add last c@ true if drop ; then in dup dup scan over - 1 u+ cmove> c! 1 +to ;
sub in 1 + dup l @ over - -1 u+ cmove 0 last c! ;
rev -1 +@
br e0 ? if drop ; then 10 ? if ex then drop ;
sol l @ over - index rev pg times ;
adv 1 +@ -1 ? if br ; then drop ex ;
eol 1 - bounds dup s @ - index adv pg times ;
t0 ." Vacant" t1 ." Define F1" t2 ." Compile F2" t3 ." Execute F3"
t4 ." Dec F4" t5 ." Hex F5" t6 ." Address F6" t7 ." Postpone F7"
tx ." Comment F10"

cl 0 , mode 3 ,
t dup mode ! cl @ or add 0  cl ! ;
f1 1 t ; f2 2 t ; f3 3 t ; f4 4 t ; f5 5 t ;
f6 6 t ; f7 7 t ; f8 8 t ; f9 9 t ; f10 10 t ;
f12 20 add ;
sbar mode @ add ;
left -1 +to ;
right in 1 + scan min to ;
up in dup sol push r@ - pop dup sol push r@ - min pop + to ;
dn in dup sol - in eol 1 + push r@ r@ eol swap - min pop + 1 - in 1 + max scan min to ;
home in sol 1 + to ;
lnend in eol to ;
bkspc left sub ;
ctrl 10  cl ! ;
alt sb @ dup neg sb !
scroll dup dup s +! p +! l +! scan p @ min p ! ; 0 scroll
pgup pg scroll ;
pgdn pg neg scroll ;
d. 4 emit . ;
info width 264 -  0 at s @ 0 block - pg / d. l @ scan - d. p @
.t -1 @+ e0 ? if drop .t ; then nip f and dup emit
jump t0 t1 t2 t3 t4 t5 t6 t7 tx tx tx tx tx tx tx tx
spot pg allot
copy s @ spot  pg 4 / move in s @ - spot + spot ;
out black page copy show info switch 20 ms out ;
n ;
in keys add n f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f12 f12 bkspc n n home pgup sub lnend pgdn ctrl alt sbar up left dn right
edit in editor end ;
out child edit

Macros get-order
hidden enth 2 set-order macros
drop drop, ; nip nip, ;
over dup, 8b4604 3, ;
swap 89c28b06 4, 8916 2, ;
+ ?lit if 5 1, , ; then 306 2, nip ;
u+ ?lit if 8106 2, , ; then 14604 3, drop ;
- ?lit if 2d 1, , ; then 2906 2, drop ;
and ?lit if 25 1, , ; then 2306 2, nip ;
or ?lit if d 1, , ; then b06 2, nip ;
xor ?lit if 35 1, , ; then 3306 2, nip ;
neg f7d8 2, ; nop 90 1, ; 2/ d1f8 2, ; 2* d1e0 2, ;
shr ?lit if c1e8 2, c, ; then 89c1d32e 4, drop ;
shl ?lit if c1e0 2, c, ; then 89c1d326 4, drop ;
push 50 1, drop ; pop dup, 58 1, ; r@ dup, 8b0424 3, ;
r+ ?lit if 830424 3, , ; then 10424 3, drop ;
@ ?lit if dup, 8b05 2, , ; then 8b00 2, ;
c@ ?lit if dup, 31c08a05 4, , ; then 9231c08a 4, 2 1, ;
! ?lit if ?lit if c705 2, swap , , ; then 8905 2, , drop ; then 8b168910 4, drop drop ;
c! ?lit if ?lit if c605 2, swap , c, ; then 8805 2, , drop ; then 8b168810 4, drop drop ;
+! ?lit if ?lit if 8105 2, swap , , ; then 105 2, , drop ; then 8b160110 4, drop drop ;

Macros
? ?lit if a9 1, , ; then 8506 2, drop ;
* ?lit if b9 1, , f7e1 2, ; then 91adf7e1 4, ;
/ ?lit if b9 1, , 99f7f9 3, ; then 89c1ad99 4, f7f9 2, ;
mod ?lit if b9 1, , 99f7f9 3, 89d0 2, ; then 89c1ad99 4, f7f989d0 4, ;
/mod ?lit if b9 1, , 99f7f983 4, ee048916 4, ; then 918b0699 4, f7f98916 4, ;
*/ ?lit if ?lit if bb 1, , b9 1, , f7ebf7f9 4, ; then b9 1, , 93ad 2, f7ebf7f9 4, ; then 91ad93ad 4, f7ebf7e9 4, ;
max ?lit if ba 1, , 39c27e02 4, 89d0 2, ; then max compile, ;
min ?lit if ba 1, , 39c27d02 4, 89d0 2, ; then min compile, ;
for ?lit if 68 1, , here reset ; then push here reset ;
next ff0c2475 4, here 1 allot back 83c404 3, ;
times ?lit 1 - here dup 4 - @ + swap for dup compile, next drop ;
" 34 fparse csliteral ;
set-order : end

Words a- @
basic branch words
screen 12x22
l drop n ;
show a-b 3 emit dup count type 1 u+ ;
all show 4 - @ -1 ? if all ; then drop ;
in keys l n 28 times
black page 0 swap all cr cr 4 emit . switch in
words end

Mem
basic branch mem
screen 12x22
macros ." " count type ; :
l drop n ;
zeros u-u 8 over - 0 max -1 ? if for ." 0" next ; then drop ;
n. n- 5 emit s>d number zeros type ;
h. a-b dup @ n. 4 + ;
show a-b dup h. h. h. n. @ ;
fields a- show -1 ? if cr fields ; then drop ;
in keys l n 28 times
header "  Link     Length   Link     Address" count type cr ;
black page white header 100000 fields switch in
mem end

Clock
basic branch clock
screen 12x22 macros
." " count type ;
cli fa 1, ;
sti fb 1, ; :
rtc@ cli 70 pc! 71 pc@ sti ;
ready a rtc@ 80 ? drop if ready ; then ;
td@ ready rtc@ 10 /mod a * + ;
z. td@ s>d number 1 ? if ." 0" then type ;
show push td@ 1 - 9 * pop 1 + + 9 -trailing type ;
.date 6 " Monday   Tuesday  WednesdayThursday Friday   Saturday Sunday   " show ." , " 8 " January  Febuary  March    April    May      June     July     August   SeptemberOctober  November December " show space 7 z. ." , 20" 9 z. ;
.time 4 z. ." :" 2 z. ." :" 0 z. ;
grey 60 60 60 rgb pen ;
shadow 20 20 20 rgb pen ;
time 451  387 at shadow .time 448  384 at white .time ;
date 0  0 at grey .date ;
clear 0  0 at black width  22 box 448  384 at grey 138  34 box ;
out clear date time switch 20 ms out ;
l drop n ;
in keys l n 28 times
black page
300 300 at grey 424 192 box
300 360 at shadow 384 1 box 360 300 at 4 192 box
250 350 at red 424 1 box 350 250 at 4 292 box
out child in
clock end

Floppy
2 10 master cede
basic branch floppy
macros cli fa 1, ; sti fb 1, ; :
irq6 fffc ; flag noop ; wait 5 ms ;
dma cli 6  a pc! 0  c pc! b pc! 0  4 over over pc! pc! 9  81 pc! 0  5 pc! 48  5 pc! 2  a pc! sti ;
c/r if drop 80 and ; then nip ;
ready c/r -1 ? drop ;
status 3f4 pc@ dup ;
c status 40 xor ready if 3f5 pc! ; then wait c ;
r status 40 and ready if 3f5 pc@ ; then wait r ;
ack r drop ;
int irq6 @ -1 ? if nip irq6 off ; then drop wait 5 -
await -1 ? if int ; then drop 1 throw ;
sense 1000 await c ack ack ;
seek -1 ? if f c 0 c c sense ; then drop cal 7 c 0 c sense ;
nod 1000 await drop ;
r/w c 0 c c 0 c 1 c 2 c 12 c 1b c ff c nod ack ack ack ack ack ack ack ;
cread dup seek 46 dma e6 r/w 90000 swap 1200 move ;
cwrite swap 90000  1200 move dup seek 5a dma c5 r/w ;
op flag jump cwrite cread
go for over over op 18432 u+ 1 + next ;
spin 300 ms ;
fd0 irq6 off 0 3f2 pc! spin
1c 3f2 pc! spin 0 3f7 pc! sense 3 c a1 c 2 c cal
0 25 go drop drop
/fd cal 0 3f2 pc! nod
floppy end

Tetris
basic branch tetris
screen macros
range 0 lit max 1 lit min ; :
rows 16 ; cols 10 ;
sq 40 ; x 50 ; y 50 ;
ln cols 4 * ; slots rows ln * ;
all slots ln + ;
align score 0 ,
arena all allot
bench all allot
world all allot
l drop n ;
@+ dup @ 4 u+ ;
update all 4 / move ;
marker game
f 0 , fg f @ , ; bg 0 , ;
c jump bg fg r c c c c ;
24 load 22 load 21 load
arena slots erase arena slots + ln f fill copy
fall down copy delay @ ms fall ;
in keys l n n n n n n n n n n n n n n n n n n n n n flip n n n left down right
fall child in
tetris end

Tetris Video Slave
0 128 slave cede
game branch video
12x22
tx cols sq * x + 20 + ; ty y ;
nl cr tx  0 +at ; macros
." nl 34 fparse sliteral type ; :
back 60 60 60 rgb nip
fore pen
sqr 1 dup +at sq 2 - dup box sq 1 -  -1 +at ;
slot @+ dup range jump back fore
line slot cols times get push drop x pop sq + at ;
draw x  y at line rows times drop
tx  ty at score @ 4 emit . ."  Tetris v1" ;
out world black page bench over update draw switch 20 ms out ;
out

align seed fff8 @ , shp 0 , bmp 0 , pnt 0 , s 0 , a 0 , delay 1000 ,
random seed @ 31421 * 6927 + dup seed ! um* nip ;
shape 6 random 256 * shapes + shp ! 0  bmp ! 8  pnt ! ; shape
pb pnt @ bmp @ ;
fg over ! 4 + pop ; bg drop 4 + pop ;
sq push @r+ dup range jump bg fg
row sq sq sq sq ln 16 - u+ ;
point pnt +!
copy arena  bench update
lay bench  pnt @ + shp @ bmp @ 64 * + row row row row drop drop ;
adj a +! s +! ;
h@ 4  4 adj s  @@ @ @ range ;
v@ -16  ln neg adj s @@ ;
exit pop drop again ;
check a @@ jump again exit
h h@ jump again check
ledge a @ 4 +
edge arena - ln mod range jump exit check
redge a @ edge ;
vl v@ jump again ledge
vr v@ jump again redge
src push 64 * shp @ + pop + s ! ;
dest arena u+ ln 4 * u+ + a ! ;
h+ -32  ln 16 + neg adj ;
v+ dup 64 u+ ln 4 * + adj ;
hbounds 44 src -4 dest 0 h h h h h+ h h h h h+ h h h h h+ h h h h 1 + ;
rvbounds 76 src 16 dest 0 vr vr vr vr -4 v+ vr vr vr vr -4 v+ vr vr vr vr 1 + ;
lvbounds 64 src -4 dest 0 vl vl vl vl 4 v+ vl vl vl vl 4 v+ vl vl vl vl 1 + ;

Lines
remove bench - push bench dup ln + pop cmove> 1  score +! ;
used @+ range jump exit again
check 0 swap used cols times 1 u+ ;
scan dup ln u+ dup check drop jump l remove
full bench scan rows times drop ;
flip! bmp ! copy ;
flip pb 1 + dup 4 and - over 4 + over lvbounds push over over rvbounds r+ swap ln - over hbounds pop + 2 - range jump l flip!
new drop full bench  arena update shape lay ;
right 4 pb rvbounds arrow jump l point
left -4 pb lvbounds arrow ;
down ln pb hbounds jump new point
end

Shapes
align shapes
ff 00 00 rgb f !
0 0 1 1 r 0 0 1 1 r 0 0 0 0 r 0 0 0 0 r
0 0 1 1 r 0 0 1 1 r 0 0 0 0 r 0 0 0 0 r
0 0 1 1 r 0 0 1 1 r 0 0 0 0 r 0 0 0 0 r
0 0 1 1 r 0 0 1 1 r 0 0 0 0 r 0 0 0 0 r
00 ff 00 rgb f !
0 0 0 0 r 1 1 1 1 r 0 0 0 0 r 0 0 0 0 r
0 0 1 0 r 0 0 1 0 r 0 0 1 0 r 0 0 1 0 r
0 0 0 0 r 1 1 1 1 r 0 0 0 0 r 0 0 0 0 r
0 0 1 0 r 0 0 1 0 r 0 0 1 0 r 0 0 1 0 r
00 99 ff rgb f !
0 0 1 0 r 0 1 1 1 r 0 0 0 0 r 0 0 0 0 r
0 0 1 0 r 0 1 1 0 r 0 0 1 0 r 0 0 0 0 r
0 0 0 0 r 0 1 1 1 r 0 0 1 0 r 0 0 0 0 r
0 0 1 0 r 0 0 1 1 r 0 0 1 0 r 0 0 0 0 r
00 ff ff rgb f !
0 0 0 0 r 0 0 1 1 r 0 1 1 0 r 0 0 0 0 r
0 0 1 0 r 0 0 1 1 r 0 0 0 1 r 0 0 0 0 r
0 0 0 0 r 0 0 1 1 r 0 1 1 0 r 0 0 0 0 r
0 0 1 0 r 0 0 1 1 r 0 0 0 1 r 0 0 0 0 r
ff 00 ff rgb f !
0 0 0 0 r 0 1 1 1 r 0 1 0 0 r 0 0 0 0 r
0 1 1 0 r 0 0 1 0 r 0 0 1 0 r 0 0 0 0 r
0 0 0 1 r 0 1 1 1 r 0 0 0 0 r 0 0 0 0 r
0 0 1 0 r 0 0 1 0 r 0 0 1 1 r 0 0 0 0 r

ff ff 00 rgb f !
0 1 0 0 r 0 1 1 1 r 0 0 0 0 r 0 0 0 0 r
0 0 1 1 r 0 0 1 0 r 0 0 1 0 r 0 0 0 0 r
0 0 0 0 r 0 1 1 1 r 0 0 0 1 r 0 0 0 0 r
0 0 1 0 r 0 0 1 0 r 0 1 1 0 r 0 0 0 0 r
end

Enth 0.4 Public Domain
Sean Pringle, 2002.
http://www.ynet.com.au/sean/
 Color Editor
 Normal QWERTY editing with permanent INSERT mode. Special keys:
 F1 F2 F3 F4 F5 F6 F7 F10 function keys insert color tokens
SPACEBAR mimic last used function key
CTRL then F1-F10 color token doubles as line break
ALT switch between code and shadow blocks
F12 insert normal blank space
 Top right of screen tells you:
 - Block ( 1024 bytes/chars )
- Spare characters
- Function, key and color of token/word underneath cursor
 Color Terminal
 Edit top of block 0. Press ENTER. Editor stops. Block 0 interpretted until OK reached. New OK inserted. Editor restarts.
Command history scrolls down. To reuse a command, hold down DELETE until it reaches the top of the screen once more.

Boot
  warm boot
screen compile video words
12x22 compile 12x22 pixel font words
6x11 compile 6x11 font words
disk1 system boot disk image
floppy@ a- read from floppy to a
floppy! a- write to floppy from a
l u- list ed a- start editor at block following a
when display system clock
mem display allocated memory
flux1 address of system source in boot image
save system to disk
revert reload system source from image
dump a- memory at a
words wid- display words in wordlist wid
 bye reboot
keys keyboard jump table handler
marker basic common baseline branchpoint
load keyboard driver and start color terminal
await a warm boot

Color Terminal
create as autonomous task
tib terminal input block
  ok synonym for end
comment au- display string as comment
. display number tos and discard
u. unsigned .
.s display stack
 spot -a where interpretting actually happens
  wrong display error message
edit run editor at tib
in edit block 0 and copy to spot
   start baseline the task
listen like QUIT
 Personal words to be available at the terminal eg
wipe u- erase block u and prepare for editing
copy uv- copy block u to block v

Keyboard
 QWERTY layout.
 The code isn't pretty, perhaps reflecting the PC keyboard design. It may not be the best way.
 Two execution token tables are used. Ekeys handles the control keys and Ckeys the ascii character keys.
 keys is the application keyboard handler. It has this jump table format:
text esc f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 bkspc tab ins home pgup del end pgdn ctrl alt space up left down right
An app can use these 28 control keys as it likes. All character keys get handed to the zeroth word (`text' above). An app must handle characters here, even if that means simply discarding them.
 Other control keys like SHIFT, CAPS LOCK and ENTER/RETURN are handled by the system. ENTER acts as the default `ok we are done' key. Hit it to exit an application or compile at the command block.
 NUM LOCK is not currently supported. It may be added in due course.

Video
 rgb rgb-c create correct color value for current video mode
 pen c- set drawing mode to color c
generic colors
         frame -a drawing buffer
at xy- move to screen pixel co-ordinates xy
get -xy last screen pixel co-ordinates
+at xy- relative at
box xy- draw filled box of dimensions xy
 page clear screen
switch move frame to screen

12x22 Font occupies 33 blocks of dictionary space
cr carriage return and line feed
cf carriage feed
 ascii execution token table for characters
 Basically the code in here expands the bitmapped characters into compiled code.
 fp writes one foreground pixel to memory at the pointer top of stack with post increment of 2 bytes for 16 bit VESA graphics.
fpl does the same except it advances the pointer by one scanline.
 Background pixels add themselves together to become simple additions to the pointer.
 Color tokens are characters too. They include a color change in their code but otherwise operate like space.
 The numbering color tokens, 4 and 5, also alter the system number base. This means that when displaying numbers, both display base and color can be set with a single color token emit.

6x11 Font occupies 13 blocks of dictionary space
Operates same as 12x22.

Dump
 mem dump start address
line adjust dwords per line according to screen resolution
incr increment
digits un-u display padding zeros
n. nm- display 1 number in hex
lo n-nb lowest byte
b n-m display 1 byte
c n-m display 1 character
@+ a-bn fetch with post increment from a
dword a-b display 1 dword
equiv a-b display text equivalent of 1 dword
addr a-a display address
orig display original dump address
nums hex display
text text display
draw everything
out video task
point n- adjust start address
up arrow dn arrow
pgdn key pgup key
l drop ascii n oop
in keyboard handler and control key jump table
start child task for video. handle keyboard

Color Editor
  ." compile string word
ex unnest
pg page sb shadow block offset
s start of block p cursor address l end of block
last character in block
true flag
bounds a-b ensure a is within current block
in get cursor
+to relative
to adjust cursor
+@ an-bc pre increment char fetch
@+ an-bc post increment char fetch
check a-b for char in previous byte
scan -a for last used byte in block
rear c- display cursor behind char
fore c- display cursor foreground
cur a-b display cursor as current word color
show a- display block at a
add c- character at cursor, auto insert mode
sub delete character at cursor
rev a-b reverse
br c- check for line break token
sol a-b locate start of current line
adv a-b advance
eol a-b locate end of current line
t0 through tx are display strings for respective tokens

cl ctrl key mode last used token
t t- insert token t
function keys
 f12 insert normal blank space 20
sbar spacebar insert mode
left arrow
right arrow
up arrow
dn arrow
 home key
lnend end key
bkspc backspace
ctrl key, next used color token will also be line break
alt key, alternate between code and shadow blocks
scroll n- adjust pointers by n chars
pgup previous block
pgdn next block
d. decimal .
info display current block info top right hand of screen
.t display action of current cursor color
 spot double buffer the display, prevents flicker
copy current block to spot
    edit compiling the word end means this source block can be edited

Clock
   cli sti pentium clear and set interupts instructions
 rtc@ r-n read from real time clock register r
ready check to make sure clock is not updating
td@ r-n read from time or date register r
z. n- display n padded out to two characters with zeros
show na- display string field n in array a
.date display formatted date
  .time display formatted time
  time display time with shadowed text
date display date top of screen
clear only areas of screen with updating text

Floppy af-
start as background task
 cli sti pentium clear and set interrupts instructions
irq6 floppy interrupt variable flag constant
dma m- initialize DMA in mode m to talk to disk controller
 c/r command or result
ready controller ready to talk?
status controller status register 3f4
c c- send 1 command
r -r receive 1 result
ack acknowledge and discard result
int poll interrupt
await t-n interrupt for n milliseconds
sense interrupt and acknowledge
seek c- cylinder, recalibrate drive if 0
 r/w cm- read or write cylinder c then await and receive results
cread dc- cylinder c read to destination address d
cwrite sc- cylinder c write from source address s
op select current operation
go acn- read/write n cylinders from cylinder c to address a
 Make sure irq6 and drive really are off
Spin up drive and recaliabrate
 Leave drive recalibrated and off