(****************************************************************************)
(*                                                                          *)
(*                Bibliotheksmodul zum Ansteuern der COL256                 *)
(*     (COL256 mit 256k RAM, bei 64k RAM gibt's nur 1 Bildschirmseite)      *)
(* t col_type = array[0..15] of byte;                                       *)
(* c weiss : col_type;    \                                                 *)
(*   gelb : col_type;      |                                                *)
(*   cyan : col_type;      |                                                *)
(*   gruen : col_type;     > Farbwerte in 12 Helligkeitsstufen              *)
(*   magenta : col_type;   | (fuer COL256 o h n e CLUT !)                   *)
(*   rot : col_type;       |                                                *)
(*   blau : col_type;     /                                                 *)
(* v col_adresse : integer  : Startadresse des Bildspeichers (fuer CRTC)    *)
(* v col_page : byte  : Nummer der aktuellen Bildschirmseite                *)
(* p ColInit : Initialisiert die COL256 auf 256 x 256 Punkte                *)
(* p PSet(x,y:integer; col,f:byte) : Setzt an der Position (x,y) einen      *)
(*                                   Punkt der Farbe col.                   *)
(*                                     f = 0 : Punkt setzen                 *)
(*                                     f = 1 : Punkt ODER verknuepfen       *)
(*                                     f = 2 : Punkt UND verknuepfen        *)
(*                                     f = 3 : Punkt XOR verknuepfen        *)
(* f PGet(x,y:integer) : byte -> Liest die Farbe des Punktes (x,y)          *)
(* p ClrCol(col,seite:byte) : Loeschen des Grafikschirms mit der Farbe Col  *)
(* p Line(x1,y1,x2,y2:integer; col,f:byte) : Linie von (x1,y1) nach (x2,y2) *)
(*                                           ziehen, sonst wie PSet.        *)
(* p Circle(x0,y0,r : integer; col,f : byte) : Kreis um (x0,y0) mit Radius  *)
(*                                             r zeichnen, sonst wie PSet.  *)
(* p Scroll(wie:integer) : Bild um 4 Zeilen verschieben:                    *)
(*                             wie > 0 --> nach oben verschieben,           *)
(*                             wie < 0 --> nach unten verschieben.          *)
(*                             wie = 0 --> keine Aktion                     *)
(* p ReadPage(num:integer) : Waehlt eine von 4 Leseseiten aus, Num = 0..3   *)
(* p WritePage(num:integer) : Waehlt eine von 4 Schreibseiten aus, Num = 0..3 *)
(* p SetReg(reg,data:byte) : Laedt das Register reg mit dem Wert data       *)
(* f GetReg(reg:byte) : byte -> Liest den Inhalt des Registers reg          *)
(*                                                                          *)
(****************************************************************************)

type
  col_type = array[0..11] of byte;

const
  crt = $cc;
  crtd = $cd;
  crtb = $ce;
  weiss : col_type =
       ($15,$55,$95,$d5,$2a,$6a,$aa,$ea,$3f,$7f,$bf,$ff);
  gelb  : col_type =
       ($05,$45,$85,$c5,$0a,$4a,$8a,$ca,$0f,$4f,$8f,$cf);
  cyan  : col_type =
       ($14,$54,$94,$d4,$28,$68,$a8,$e8,$3c,$7c,$bc,$fc);
  gruen : col_type =
       ($04,$44,$84,$c4,$08,$48,$88,$c8,$0c,$4c,$8c,$cc);
  magenta : col_type =
       ($11,$51,$91,$d1,$22,$62,$a2,$e2,$33,$73,$b3,$f3);
  rot   : col_type =
       ($01,$41,$81,$c1,$02,$42,$82,$c2,$03,$43,$83,$c3);
  blau  : col_type =
       ($10,$50,$90,$d0,$20,$60,$a0,$e0,$30,$70,$b0,$f0);

var
  col_adresse : integer;
  col_page    : byte;

procedure colinit;
  const data : array[0..14] of byte =
               (111,64,80,7,77,0,64,70,0,3,0,0,0,0,0);
  var i:integer;
begin
  for i:=0 to 14 do
    begin
      port[crt]:=i;
      port[crtd]:=data[i];
    end;
  col_adresse := 0;
  col_page:=0;
end;

procedure pset(x,y:integer; col,f:byte);
  var andmask,xormask : byte;
  begin
    if f=0 then
      begin andmask:=0; xormask:=col end
    else if f=1 then
      begin andmask:=not col; xormask:=col end
    else if f=2 then
      begin andmask:=col; xormask:=0 end
    else if f=3 then
      begin andmask:=$ff; xormask:=col end;
    inline($d9/$3a/xormask/$47/$3a/andmask/$4f/$d9/$2a/x/$ed/$5b/y/$7b/
           $2f/$5f/$f6/$c0/$67/$7b/$07/$07/$e6/$03/$f6/$80/$e5/$21/col_page/$86/
           $e1/$d3/$ce/$d9/$78/$d9/$47/$d9/$79/$d9/$a6/$a8/$77/$af/$d3/$ce);
  end;

function pget(x,y:integer) : byte;
  var col : byte;
  begin
    inline($2a/x/$ed/$5b/y/$7b/$2f/$5f/$f6/$c0/$67/$7b/$07/$07/
           $e6/$03/$f6/$80/$e5/$21/col_page/$86/$e1/
           $d3/$ce/$46/$af/$d3/$ce/$78/$32/col);
    pget:=col;
  end;

procedure clrcol(col,seite:byte);
  var i:integer;
  begin
    col_page:=seite*4;
    col_adresse:=seite*4096;
    port[crt]:=12; port[crtd]:=hi(col_adresse);
    port[crt]:=13; port[crtd]:=lo(col_adresse);
    seite:=$80+seite*4;
    for i:=0 to 3 do
      begin
        inline($3a/col/$47/$3a/seite/$d3/$ce/$21/$00/$c0/
               $11/$01/$c0/$78/$77/$01/$ff/$3f/$ed/$b0/$af/$d3/$ce);
        seite:=succ(seite);
      end;
  end;

procedure clrall(col:byte);
  var s,i:integer;
  begin
    s:=$80;
    for i:=0 to 15 do
      begin
        inline($3a/col/$47/$3a/s/$d3/$ce/$21/$00/$c0/
               $11/$01/$c0/$78/$77/$01/$ff/$3f/$ed/$b0/$af/$d3/$ce);
        s:=succ(s);
      end;
    col_page:=0;
    col_adresse:=0;
  end;

procedure line(x1,y1,x2,y2:integer; col,f:byte);
(* Bresenham-Algorithmus,                                    *)
(* aus 'Procedural Elements For Computer Graphics', Seite 40 *)
(* die FOR-Schleife ist durch ein Maschienenprogramm ersetzt *)
  var x,y,dx,dy,s1,s2,change,e,i : integer;
  begin
    dx:=(x2-x1); dy:=(y2-y1);
    if (dx=0) and (dy=0) then pset(x1,y1,col,f)
    else if dy=0 then
      begin
        if x1>x2 then begin x:=x1; x1:=x2 end else x:=x2;
        for i:=x1 to x do
          pset(i,y1,col,f);
      end
    else if dx=0 then
      begin
        if y1>y2 then begin y:=y1; y1:=y2 end else y:=y2;
        for i:=y1 to y do
          pset(x1,i,col,f);
        end
    else begin
      x:=x1; y:=y1;
      if dx>0 then s1:=1
        else if dx<0 then begin s1:=-1; dx:=abs(dx) end
        else s1:=0;
      if dy>0 then s2:=1
        else if dy<0 then begin s2:=-1; dy:=abs(dy) end
        else s2:=0;
      if dy>dx then
        begin
          change:=dx;
          dx:=dy;
          dy:=change;
          change:=1;
        end
      else change:=0;
      e:=2*dy-dx;
      for i:=1 to dx do
        begin
          pset(x,y,col,f);
          inline ($2A/E/$B4/$FA/*+$0032/$3A/CHANGE/$3D/$20/$0E
                  /$2A/X/$ED/$5B/S1/$19/$22/X/$C3/*+$000D/$2A/Y
                  /$ED/$5B/S2/$19/$22/Y/$2A/DX/$29/$EB/$2A/E/$A7
                  /$ED/$52/$22/E/$C3/*+$FFCF/$3A/CHANGE/$3D
                  /$20/$0E/$2A/Y/$ED/$5B/S2/$19/$22/Y/$C3/*+$000D
                  /$2A/X/$ED/$5B/S1/$19/$22/X/$2A/DY/$29/$ED/$5B/E
                  /$19/$22/E);
        end;
      pset(x,y,col,f);
    end;
  end;

procedure circle(x0,y0,r:integer; col,f:byte);
  var x,y,s:integer;
  begin
    x:=r; y:=0; s:=-r;
    while y<=x do
      begin
        pset(x0+x,y0+y,col,f);
        pset(x0+y,y0+x,col,f);
        pset(x0-y,y0+x,col,f);
        pset(x0-x,y0+y,col,f);
        pset(x0-x,y0-y,col,f);
        pset(x0-y,y0-x,col,f);
        pset(x0+y,y0-x,col,f);
        pset(x0+x,y0-y,col,f);
        s := succ(s+2*y);
        y := succ(y);
        if s>=0 then
          begin
            s := s-2*x+2;
            x := pred(x);
          end;
      end;
  end;

procedure scroll(wie:integer);
  begin
    if wie<0 then wie:=-1
      else if wie>0 then wie:=1;
    col_adresse:=col_adresse+wie*64;
    port[crt]:=12; port[crtd]:=hi(col_adresse);
    port[crt]:=13; port[crtd]:=lo(col_adresse);
  end;

procedure readpage(num:integer);
  begin
    col_adresse:=num*4096;
    port[crt]:=12; port[crtd]:=hi(col_adresse);
    port[crt]:=13; port[crtd]:=lo(col_adresse);
  end;

procedure writepage(num:integer);
  begin
    col_page:=num*4;
  end;

procedure setreg(reg,data:byte);
  begin
    port[crt]:=reg;
    port[crtd]:=data;
  end;

function getreg(reg:byte) : byte;
  begin
    port[crt]:=reg;
    getreg:=port[crtd];
  end;

