BLOCKS.BIN

BenOS v1.0 Forth and OS kernel (c) Benjamin Hoyt 1998                                                                           Block(s)          Contains                                        0               block information                               1 through  3    BenOS essentials (already loaded)               4 through 12    BenOS block editor                             13 through 14    "screen saver" demo                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                           ( BenOS essentials )                                                                                                            : vocabulary  ( "name" -- )  \ create vocabulary called name       create  last  wordlist wid>head !                               does>  ( -- )  context @ ! ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 ( Block editor )                                                                                                                vocabulary editor  also editor  definitions  \ editor's vocab                                                                   blimit bstart - 1- constant bmax  \ max block #                                                                                 variable eofs  \ cursor offset into block                       variable esc?  \ exit from editor?                              defer cput  \ insert or overwrite char                                                                                          1k mallocate constant ebuf  \ line cut/copy/paste buffer        variable ebuf#  \ # of lines in ebuf                                                                                            32 mallocate constant sbuf  0 sbuf c!  \ search buffer                                                                                                                                          ( Editor housekeeping words )                                                                                                   : eblock  ( -- a )  scr @ block ;                               : ofs  ( -- ofs )  eofs @ ;                                     : >b  ( ofs -- a )  eblock + ;                                  : a  ( -- a )  ofs >b ;                                         : x  ( -- x )  ofs c/l mod ;                                    : y  ( -- y )  ofs c/l / ;                                      : esc   -1 esc? ! ;                                             : >xy  ( x y -- 'x 'y )  2 + ;                                                                                                                                                                                                                                                                                                                                                                                                                                  ( Editor display, screen and cursor motion )                                                                                    : cursor   x y  >xy at-xy ;                                     : >l  ( line# -- a )  c/l * >b ;                                : line#  ( line# )  0 over  >xy at-xy  >l c/l type ;            : dline   y line# ;                                             : dscrn   16 0 do  i line#  loop ;                              : screen  ( block# )  scr !  eblock drop update  dscrn ;        : pgup   scr @ 1-  0 max  screen ;                              : pgdn   scr @ 1+  bmax min  screen ;                           : tof   0 screen ;                                              : bof   bmax screen ;                                           : mover  ( n )  ofs +  1023 and  eofs ! ;                       : moves  ( #chars )  create ,  does>  @ mover ;                                                                                 -64 moves up  64 moves down  -1 moves left  1 moves right       ( Editor character insertion and deletion, line home and end )                                                                  : y>l  ( -- a )  y >l ;                                         : remm  ( -- #chars )  c/l x - 1- move ;                        : cover  ( char )  a c!  right dline ;                          : cins  ( char )  a a 1+ remm  cover ;                          : del   a 1+ a remm  bl  y 1+ >l 1- c!  dline ;                 : bksp   left del ;                                             : home   x if  y c/l *  else  0  then  eofs ! ;                 : end   y >l  dup c/l +  begin  1-  2dup u< while                  dup c@  bl = 0= until 1+  then  eblock -  eofs !  drop ;     : ins?  ( -- flag )  defer@ cput  ['] cins = ;                  : ins   ins? if  ['] cover  else  ['] cins  then  is cput ;     ' cins is cput  \ cput is initially insertion                                                                                                                                                  ( Editor line insertion and deletion, cut and paste )                                                                           : #left  ( -- #chars )  960  y c/l *  - ;                       : lins   y>l  dup c/l +  #left move ;                           : ldel   y>l c/l +  y>l  #left move  eblock 960 +  c/l blank ;  : >ebuf  ( line# -- a )  c/l *  ebuf + ;                        : dell   ldel  dscrn ;                                          : l>ebuf   y>l  ebuf# @ >ebuf  c/l move  1 ebuf# +! ;           : cut   ebuf# @ 16 < if  l>ebuf dell  then ;                    : copy   ebuf# @ 16 < if  l>ebuf down  then ;                   : edel   -1 ebuf# +!  ebuf c/l +  ebuf  ebuf# @ c/l * move ;    : paste   ebuf# @ if  lins  ebuf y>l  c/l move                     edel  down dscrn  then ;                                     : enter   x if  down home  then  lins  y>l c/l blank  dscrn ;                                                                                                                                   ( Editor searching )                                                                                                            : gets   21 0  2dup at-xy  43 spaces  at-xy  ." srch: "            sbuf 1+ 31 accept  sbuf c! ;                                 : s=  ( a1 a2 u -- flag )  tuck  compare 0= ;                   : smem  ( a u -- 'a t=found )  sbuf c@ - 1+  0 do  dup i +         sbuf count  s= if  i +  -1  unloop exit  then  loop  0 ;     : sscr  ( flag )  a  1k ofs -  smem swap  eblock - eofs ! ;     : srch   gets sscr drop ;                                       : snext   right sscr drop ;                                     : sthru   gets  0 eofs !  bmax 1+  scr @ do                        sscr if  leave  then  pgdn  loop ;                                                                                                                                                                                                                                                                                           ( Editor Ctrl-Q and key handling )                                                                                              create qeys  hex  \ Ctrl-Q scan code table                      473 , ' home ,  464 , ' end ,   466 , ' srch ,  ( ^S ^D ^F)     461 , ' sthru , 472 , ' tof ,   463 , ' bof ,   ( ^A ^R ^C)     here constant qend  decimal  \ end addr of Ctrl-Q table                                                                         : dokey  ( ekey 'end 'start )  do  dup                             i @ = if  drop  i unloop  cell+ @ execute  exit  then           [ 2 cells ] literal +loop                                       ekey>char if  cput  else  drop 7 emit  then ;                : ctrlq   ekey  qend qeys  dokey ;                                                                                                                                                                                                                                                                                              ( Editor remaining keys )                                                                                                       create keys  hex  \ editing key scan code table                 465 , ' up ,    478 , ' down ,  473 , ' left ,  ( ^E ^X ^S)     464 , ' right ,  1B , ' esc ,    9A , ' del ,   ( ^D      )      08 , ' bksp ,   90 , ' ins ,   472 , ' pgup ,  (       ^R)     463 , ' pgdn ,   0D , ' enter , 46A , ' cut ,   ( ^C    ^J)     46B , ' paste , 479 , ' dell ,  471 , ' ctrlq , ( ^K ^Y ^Q)     46C , ' snext , 468 , ' copy ,                  ( ^L ^H   )     here constant kend  decimal  \ end addr of key table                                                                            : edkey  ( ekey )  kend keys  dokey ;                                                                                                                                                                                                                                                                                           ( Editor main loop )                                                                                                            : status   0 0 at-xy  ." b" scr @ 3 .r  ."   "                     x 2 .r  ." ,"  y 2 .r  ."   c"  ebuf# @ 2 .r  ."   "            ins? negate 73 *  bl + emit  cursor ;                        : across   c/l 0 do  ." -"  loop ;                              : border   page  cr across  0 18 at-xy across ;                                                                                 forth definitions  editor  \ edit in forth vocabulary                                                                           : edit  ( block# )  border  0 eofs !  screen  0 esc? !             begin  status  ekey edkey  esc? @ until  0 19 at-xy ;        : e   scr @ edit ;  \ edit most recently edited block                                                                           previous                                                                                                                        ( Simple "screen saver" demonstration )                                                                                         vocabulary eater  also eater  definitions  \ eater wordlist                                                                     char @ constant man     \ character of eater                    15 constant lighting    \ eater attribute                       variable x  variable y  \ x,y position of eater                 variable tid            \ eater task id cell                                                                                    : umod  ( u1 u2 -- rem )  0 swap  um/mod drop ;                 : hungry   3 choose 1-  x @ +  80 umod x !                                 3 choose 1-  y @ +  25 umod y ! ;                    : at   x @ y @ at-xy ;                                          : gobble   at  lighting attr!  man emit ;                       : bite   at  bl emit ;                                                                                                          ( Simple "screen saver" demonstration )                                                                                         : eta   begin  at-xy? attr@  bite  hungry gobble                   attr! at-xy  100 ms  again ;                                                                                                 forth definitions  eater  \ define into forth vocab now                                                                         \ type EAT to start the demo, FULL when you get sick of it                                                                      : eat   39 x ! 12 y !  ['] eta 20 20 start-task  tid ! ;        : full  tid @ stop-task ;                                                                                                       previous