CON                                                                             'Hive-Computer-Projekt
{{
Tutorial        : "Build your OS"
Name            : VGA-Texttreiber 
Chip            : Bellatrix-Code
Version         : 0
Dateien         : 
}}

CON                                                                             'Konstanten
  _clkmode = xtal1 + pll16x
  _xinfreq = 5_000_000

  cols = 64
  rows = 48
  tiles = cols * rows
  spacetile = $8000 + $20 << 6
  vga_basport = 8                                      'vga startport
  keyb_dport = 17                                      'tastatur datenport
  keyb_cport = 16                                      'tastatur taktport
  CURSORCHAR = $0E                                     'cursorzeichen
  TAB1       = 16
  TAB2       = 32
  TAB3       = 48


OBJ                                                                             'Verwendete Objekte
  vga     : "vga-treiber" 
  key     : "keyb-treiber"
  gfx1    : "gfx1"
  
VAR                                                                             'Variablen
  long  cur,col, row, color
  long  array[tiles/2]
  byte  cursor                                          'cursorzeichen
  byte  curstat                                         'cursorstatus 1 = ein
  byte  sline                                           'startzeile des scrollfensters
  byte  eline                                           'endzeile des scrollfensters

  long  stack1[48]
  long  stack2[48]
  long  stack3[48]
  long  stack4[48]

CON
srow    = 3
erow    = 45
rndfac  = $efffffff/256

PUB main | i                                                                    'Hauptroutine
  init_subsysteme
  gfx1.start                                                                    'tv-scroller starten
  print_char($115)
  cognew(mstring(0), @stack1)
  cognew(mstring(0), @stack2)
  cognew(mstring(0), @stack3)
  cognew(mstring(0), @stack4)
  mstring(0)
  
PUB mstring(cid) | i,len,x,ecnt,acc
  i := cnt
  repeat
    acc := ?i & $6f
    len := ?i & $2f
    x   := ?i & $3f
    ecnt:= ?i & $3ef + 10
      if acc == $2f
        flow(len,x,ecnt,cid+3)
      else
        flow(len,x,ecnt,cid)

PUB flow(len,x,ecnt,cid) | y,char,rnd,ccnt,mrow,mcol,mcolor
  mcol  := x
  mrow  := srow
  repeat len
    repeat ccnt from 0 to ecnt
      mcolor := 1 + cid
      mchar(?char & $FF,mrow,mcol,mcolor)
    mcolor := 0 + cid
    mchar(?char & $FF,mrow,mcol,mcolor)
    if mrow++ => erow
        mrow := srow

PUB unflow(len,x,ecnt,cid) | y,char,rnd,ccnt,mrow,mcol,mcolor
  mcol  := x
  mrow  := srow
  repeat len
    repeat ccnt from 0 to ecnt
      mcolor := 1 + cid
      mchar(?char & $FF,mrow,mcol,4)'mcolor)
    mchar(" ",mrow,mcol,mcolor)
    if mrow++ => erow
        mrow := srow

  
PRI mchar(c,mrow,mcol,mcolor) | i,k
'schreibt zeichen an aktuelle position ohne cursorposition zu verändern
  k := mcolor << 1 + c & 1
  i := $8000 + (c & $FE) << 6 + k
  array.word[mrow * cols + mcol] := i                                           'oberes tile setzen
  array.word[(mrow + 1) * cols + mcol] := i | $40                               'unteres tile setzen

PUB init_subsysteme
{{initialisierung des belatrix-chips}}
  color := 1
  key.start(keyb_dport, keyb_cport)                               'tastaturport starten
  vga.start(vga_basport, @array, @vgacolors, 0, 0, 0)             'vga-treiber starten
  print_char($100)
  print_string(@ver1)                                                             
  print_char($0D)
  cursor := CURSORCHAR                                            'cursorzeichen setzen
  curstat := 1                                                    'cursor anschalten
  sline := 2
  eline := rows
  
PRI print_string(ptr)                                                           'Stringausgabe          
  repeat while byte[ptr]                                                        'wiederhole bis $0
    print_char(byte[ptr++])                                                     'ausgabe des zeichens

PUB printdec(value) | i                                 
  if value < 0                                          'negativer zahlenwert
    -value
    print_char("-")
  i := 1_000_000_000
  repeat 10                                             'zahl zerlegen
    if value => i
      print_char(value / i + "0")
      value //= i
      result~~
    elseif result or i == 1
      print_char("0")
    i /= 10                                             'nächste stelle

PUB printhex(value, digits)                             
  value <<= (8 - digits) << 2
  repeat digits
    print_char(lookupz((value <-= 4) & $F : "0".."9", "A".."F"))

PUB print_char(c) | code,n
{{zeichen auf bildschirm ausgeben}}
'' Print a character
''
''       $0D = new line
''  $20..$FF = character
''      $100 = clear screen
''      $101 = home
''      $108 = backspace
''$110..$11F = select color

  case c

    $0A:                                                'LF ausblenden
      return
      
    $00..$0C:
      pchar(c)
      if curstat == 1
        schar(cursor)

    $0D:                                                'return?
      if curstat == 1
        schar($20)
      newline
      if curstat == 1
        schar(cursor)

    $0E..$FF:                                           'character?
      pchar(c)
      if curstat == 1
        schar(cursor)

    $100:                                               'clear screen?
      if curstat == 1
        schar($20)
      n := sline * cols * 2
      wordfill(@array + n, spacetile, tiles - n)
      row := sline
      col := 0
      if curstat == 1
        schar(cursor)

    $101:                                               'home?
      row := sline
      col := 0

    $102:                                               'backspace?
      if col
        if curstat == 1
          schar($20)
        col--
        if curstat == 1
          schar(cursor)

    $103:                                               'tab
      if col < TAB1
         if curstat == 1
           schar($20)
         col := TAB1
         if curstat == 1
           schar(cursor)
         return
      if col < TAB2
         if curstat == 1
           schar($20)
         col := TAB2
         if curstat == 1
           schar(cursor)
         return
      if col < TAB3
         if curstat == 1
           schar($20)
         col := TAB3
         if curstat == 1
           schar(cursor)
         return

    $105:                                               'pos1
      if curstat == 1
        schar($20)
      col := 0
      if curstat == 1
        schar(cursor)

    $113:                                               'screeninit
      wordfill(@array, spacetile, tiles)
      row := 0
      col := 0
      sline := 0

    $114:                                               'curon
      curstat := 1
      schar(cursor)

    $115:                                               'curoff
      if curstat == 1
        schar($20)
      curstat := 0

    $130..$13F:                                         'select color?
      color := c & $F

PRI schar(c)| i,k
'schreibt zeichen an aktuelle position ohne cursorposition zu verändern
  k := color << 1 + c & 1
  i := $8000 + (c & $FE) << 6 + k
  array.word[row * cols + col] := i                                             'oberes tile setzen
  array.word[(row + 1) * cols + col] := i | $40                                 'unteres tile setzen

PRI pchar(c)
'schreibt zeichen an aktuelle position zählt position weiter
  schar(c)
  if ++col == cols
    newline

PUB newline | i

  col := 0
  if (row += 2) == rows
    row -= 2
    'scroll lines
    repeat i from sline to rows-3

      wordmove(@array.word[i*cols], @array.word[(i+2)*cols], cols)              'wordmove(dest,src,cnt)
    'clear new line
    wordfill(@array.word[(rows-2)*cols], spacetile, cols<<1)
          
DAT                                                                             'Daten

'============================================================
'          v  h  v  h        ' v=Vordergrund, h=Hintergrund
'   long $ 3C 04 3C 04       'Muster
'          v  v  h  h
'   long $ 3C 3C 04 04       'Muster
'
'0     %%RGBx_RGBx_RGBx_RGBx
' long %%0220_0010_0220_0010
' long %%0220_0220_0010_0010
'============================================================
  
vgacolors long                                                                  'farbtabelle

'0     %%RGBx_RGBx_RGBx_RGBx    'dunkles grün auf schwarz
  long %%0100_0000_0100_0000    
  long %%0100_0100_0000_0000

'1     %%RGBx_RGBx_RGBx_RGBx    'helles grün auf schwarz
  long %%0200_0000_0200_0000    
  long %%0200_0200_0000_0000

'2     %%RGBx_RGBx_RGBx_RGBx    'dunkles rot auf schwarz
  long %%1000_0000_1000_0000    
  long %%1000_1000_0000_0000

'3     %%RGBx_RGBx_RGBx_RGBx    'helles rot auf schwarz
  long %%2000_0000_2000_0000    
  long %%2000_2000_0000_0000

'4     %%RGBx_RGBx_RGBx_RGBx    'dunkles rot auf schwarz
  long %%0010_0000_0010_0000    
  long %%0010_0010_0000_0000

'5     %%RGBx_RGBx_RGBx_RGBx    'helles rot auf schwarz
  long %%0020_0000_0020_0000    
  long %%0020_0020_0000_0000

  long $0C000C00       'blue
  long $0C0C0000
  long $FC00FC00       'white
  long $FCFC0000
  long $FF80FF80       'red/white
  long $FFFF8080
  long $FF20FF20       'green/white
  long $FFFF2020
  long $FF28FF28       'cyan/white
  long $FFFF2828
  long $C0408080       'redbox
  long $3010F020       'greenbox
  long $3C142828       'cyanbox
  long $FC54A8A8       'greybox
  long $3C14FF28       'cyanbox+underscore
  long $F030C050       'graphics colors

ver1    byte "▶Hive - UniMatrix",0
prompt1 byte "ok",$0D, 0