unit coollow;
INTERFACE
const pfad='.\'; {}

procedure viewlow(akt_seite,artnr,subnr:word;titelstr:string);

IMPLEMENTATION
uses crt,coolmaus{,coolwash};

const spalten=53;
      zeilen=23;
      fonthoehe=12;
      fontdist=15;

type tmem=array[0..1000] of string[60];
     tfontmem=array[0..3072] of byte;

var textmem:^tmem;
    fontmem:^tfontmem;
    aktzeil,maxzeil:word;
    aktbutton:word;
    ende:boolean;

const leistart=46;
      leihoe=300;
      leibrei=5;{*8}
      leioff=70;
var baladdi,balhoe,balpos:word;
    balcal:real; {umrechnug aktzeil/bal}
    bild:array[1..5] of byte;
    titel:string;
type bildarray=array[1..5] of byte;

procedure printpage;forward; {req. aktzeil}

      {***UTILITIES}
procedure loadbmp(name:string);  {L„dt das Hintergrundbild + setzt die Palette}
var f:file;
    i:word;
    b:byte;
begin
  port[$3c6]:=0;   {screen dunkel}
  assign(f,name);
  reset(f,1);

      {Setcolorindices to dacreg 0-15}
  b:=port[$3da];   {indexmode}
  for b:=0 to 15 do begin
    port[$3c0]:=b;  {Die ersten 16 Farben des DAC sollen verwendet}
    port[$3c0]:=b;  {werden.}
  end;
  port[$3c0]:=1 shl 5;

       {palette}
  for i:=0 to 15 do begin {16*3 byte Palette lesen und}
    port[$3c8]:=i;        {setzen}
    blockread(f,b,1);
    port[$3c9]:=b;
    blockread(f,b,1);
    port[$3c9]:=b;
    blockread(f,b,1);
    port[$3c9]:=b;
  end;

  for i:=0 to 3 do begin {alle vier Bitplanes setzen}
    port[$3c4]:=2;      {writeplane einstellen...}
    port[$3c5]:=1 shl i;{writeplane setzen}
    blockread(f,mem[$a000:0],38400); {640*480 bit lesen}
  end;

  port[$3c6]:=$ff;{screen wieder an}
  close(f);
end;

procedure println(x,y:word;col:byte;text:string); {Zeile ausgeben, f�r Titelzeile}
var i,j,off,pl:word;
begin
  for pl:=0 to 3 do begin   {alle vier bitplanes}
    if boolean(col and (1 shl pl)) then begin {plane f�r Farbe n”tig??}
      port[$3c4]:=2;     {writeplane}
      port[$3c5]:=1 shl pl;
      port[$3ce]:=4;     {readplane}
      port[$3cf]:=pl;

      for i:=1 to byte(text[0]) do begin {alle Stringbuchstaben setzen}
        off:=(byte(text[i]))*fonthoehe; {buchstabenoffset im Font}

        for j:=0 to fonthoehe-1 do      {pixelzeilen setzen, Fontbreite= ein byte}
          mem[$a000:x+i+(10+y+j)*80]:=mem[$a000:x+i+(10+y+j)*80] or fontmem^[j+off] ;
      end;
    end;
  end;
end;


procedure pagerefresh;
begin
  asm       {NeuAufbau des Bildschirms, z.B. nach Bildanzeige}
    mov ax,12h
    int 10h
  end;
  loadbmp(pfad+'pics\layout1.new'); {Videomode, Hintegrunsbild}

   { Wenn Bild verf�gbar, dann Zahl unten links gr�n, sonst rot}
  if bild[1]=$ff then println(1,438,9,'1') else println(1,438,10,'1');
  if bild[2]=$ff then println(3,438,9,'2') else println(3,438,10,'2');
  if bild[3]=$ff then println(5,438,9,'3') else println(5,438,10,'3');
  if bild[4]=$ff then println(7,438,9,'4') else println(7,438,10,'4');
  if bild[5]=$ff then println(9,438,9,'5') else println(9,438,10,'5');

  if titel<>'' then begin  {kein Titel �bergeben?}
    println(20,396,13,titel);      {3 mal, =>Schatten oder so...}
    println(20,395,11,titel);
    println(20,394,14,titel);
  end;
end;


procedure showbcl(nr:byte); {Bild "im" Text anzeigen}
var f:file;
    hoehe,breite,i:word;
    dummy,fillme:string[3];
    b:byte;
begin
  port[$3c6]:=0;   {screen dunkel}
  delay(10);
  cursoraus;
  asm  {anderer Videomode}
    mov ax,13h
    int 10h
  end;
  fillme:='000'; {Bilder heiáen P000.bcl bis P010.bcl}
  str(nr,dummy); {NAME errechnen}
  fillme[0]:=char(3-byte(dummy[0]));
  assign(f,pfad+'pics\P'+fillme+dummy+'.bcl');
  reset(f,1);

  seek(f,4);     {bcl-File-format, breiteund hoehe ab 4}
  blockread(f,breite,2);
  breite:=swap(breite);
  blockread(f,hoehe,2);
  hoehe:=swap(hoehe);

  seek(f,10);  {256 Farben PALETTE einlesen und setzen}
  for i:=0 to 255 do begin
    port[$3c8]:=i;
    blockread(f,b,1);
    port[$3c9]:=b;
    blockread(f,b,1);
    port[$3c9]:=b;
    blockread(f,b,1);
    port[$3c9]:=b;
  end;

  for i:=0 to hoehe do  {breite*hoehe byte BILDDATA}
    blockread(f,mem[$a000:i*320+(320-breite)shr 1],breite+1);

  port[$3c6]:=$ff;{screen wieder an}


  while knopf<>0 do;      {Wartekrempel:}
  while keypressed do readkey;
  repeat
  until keypressed or (knopf<>0);
  while knopf<>0 do;
  while keypressed do readkey;{}

  pagerefresh; {Listerscreen wiederaufbauen}
  printpage;   {Seite wieder anzeigen}
  cursoran;    {Mausi}
end;


procedure drawbalken; {Anzeigebalken rechts}
var x,y,oldaddi:word;
begin
  port[$3c4]:=2;  {color}
  port[$3c5]:=4;

  oldaddi:=baladdi; {Alte Balkenstartposition}
  baladdi:=trunc((aktzeil-zeilen)*balcal)+leistart; {Neue Pos. errechnen}

  {Balkenzeilen werden abwechselnd gel”scht und neu gesetzt, gegen Flimmern}
  if oldaddi>baladdi then begin
    for y:=1 to balhoe do begin
      for x:=1 to leibrei do begin
        mem[$a000:(y+oldaddi)*80+leioff+x]:=0;
        mem[$a000:(y+baladdi)*80+leioff+x]:=$ff;
      end;
    end;
  end else begin {sitzt der neue Balken tiefer, so muá er von unten nach oben}
    for y:=balhoe downto 1 do begin {aufgebaut werden, sonst �berschreibt das L”schen}
      for x:=leibrei downto 1 do begin { vom alten Balken den neuen Balken}
        mem[$a000:(y+oldaddi)*80+leioff+x]:=0;
        mem[$a000:(y+baladdi)*80+leioff+x]:=$ff;
      end;
    end;
  end;
end;


procedure printpage; {Zeigt eine ganze Textseite an, bis Zeile Nr. aktzeil}
var i,j,z,off,line,curpos:word;
    col:byte;
begin
    cursoraus;
    if aktzeil>maxzeil then aktzeil:=maxzeil; {aktzeil=LETZTE textzeile sichtbar}
    if aktzeil<zeilen then aktzeil:=zeilen;   {wenn aktzeil nicht mehr vorhanden, dann korrigieren}

    port[$3c4]:=2;  {color=writeplane}
    z:=0;
    for line:=aktzeil-zeilen to aktzeil do begin
      {erst alle Bitplanes neu setzen, um das Alte zu �berschreiben}
      {dann zuviel gesetzte Planes �berschreiben->Farbe im Text}

      port[$3c5]:=15;       {***PRINT TEXT weiá! }
      curpos:=0;
      for i:=1 to 52 do begin {=printline, zeile 52 zeichen lang}
        inc(curpos);
        off:=(byte(textmem^[line,curpos])); {buchstabe nach off}
        if off>239 then begin   {>239 nicht anzeigen, Farbe „ndern}
          dec(i);  {ein byte ausgelassen!}
        end else begin            {text}
          off:=(off shl 3)+(off shl 2);
          for j:=0 to fonthoehe-1 do         {pixelzeilen setzen}
            mem[$a000:813+i+(z+j)*80]:=fontmem^[j+off];
        end;
      end;

      curpos:=0;          {***SET TEXT COLORS}
      col:=15;
      for i:=1 to 53 do begin {=printline}
        inc(curpos);
        off:=byte(textmem^[line,curpos]);{buchstabenoffset}
        if off>239 then begin
          col:=255-off;      {ev. Farbe „ndern}
          port[$3c5]:=col+8;
          dec(i);
        end else begin            {text}
          if col<15 then  {nur andersfarbiges neu �berschreiben}
            for j:=z*80 to (z+fonthoehe-1)*80-1 do begin    {pixelzeilen setzen}
              mem[$a000:813+i+j]:=0;
              inc(j,79);
            end;
        end;
      end;


      inc(z,fontdist); {fonthoehe+abstand: N„chste Zeile schreiben}
    end;
    drawbalken; {Anzeigebalken rechts}
    cursoran;  {Mausi..}
end;

procedure initfont; {Font UVIEW1.FNT einlesen}
var f:file;
    i:word;  {Organisation im Speicher:}
    b:byte;  {256 Zeichen   "fonthoehe" byte (fontbreite ist ein byte, 8 bit)}
begin
  new(fontmem);
  assign(f,pfad+'data\uview1.fnt');
  reset(f,1);
  blockread(f,fontmem^,3072);
  close(f);
end;


       {***HAUPTPROZEDUR}
procedure viewlow(akt_seite,artnr,subnr:word;titelstr:string);
var i,x:word;
    inp:char;
    b:byte;
    f:file;
    name:string;
begin
  titel:=titelstr; {in globaler Var speichern f�r andere prozeduren}
  bild[1]:=$ff;bild[2]:=$ff;bild[3]:=$ff;bild[4]:=$ff;bild[5]:=$ff;
  if (akt_seite=6) and (artnr=11) and (subnr=0) then begin
    bild[1]:=6;bild[2]:=7;bild[3]:=8;bild[4]:=9;bild[5]:=10;
  end;
  if (akt_seite=3) and (artnr=2) and (subnr=1) then begin
    bild[1]:=1;bild[2]:=2;bild[3]:=3;bild[4]:=4;bild[5]:=$ff;
  end;
  if (akt_seite=2) and (artnr=13) and (subnr=0) then begin
    bild[1]:=0;bild[2]:=$ff;bild[3]:=$ff;bild[4]:=$ff;bild[5]:=$ff;
  end;  {Bilder werden je nach Artikelnr. eingestellt. Man h„tte auch zu}
    {jedem Artikel die Bildernr in einem globalen Array speichern k”nnen,
    aber bei drei Artikelchen mit bild, na ich weiá nicht...}

  name:=pfad+'texte\'+char(akt_seite+64)+char((artnr div 10)+48)+char((artnr mod 10)+48)+
                     '-'+char(subnr+48)+'.dat'; { Name aus Nr und Subnr errechen}
  { und das geht so: seite(A bis F)+ artnr(0 bis 13 + '-' + subnr +'.DAT}
  {z.B. C04-1.DAT}

  new(textmem); {Speicher f�r Text}
  initfont;     {Font laden}

  pagerefresh;   {Bildschirmaufbaufunktionsaufruf}

  coolmaus.init; {Maus neu initialisieren}
  grenzen(0,0,640,480);
  setzmaus(320,240);
  cursoran;

     {***loadtext}
  assign(f,name);                      {Dat-File zum anzeigen ”ffnen}
  reset(f,1);                          {byteweiser lesezugriff}

  maxzeil:=0;
  for i:=1 to zeilen do
    fillchar(textmem^[i],60,32); {f�r kleine Files: 1. Seite mal auf space stzen}
  repeat
    fillchar(textmem^[maxzeil],60,222); {zeile l”schen}
    blockread(f,textmem^[maxzeil,0],2); {BP-String-Format: L„nge+Data einlesen}
    blockread(f,textmem^[maxzeil,1],integer(textmem^[maxzeil,0]));
    for i:=1 to 60 do {decodieren: zeichen= 254-byte}
      textmem^[maxzeil,i]:=char(254-byte(textmem^[maxzeil,i]));

    inc(maxzeil);
  until eof(f);
  dec(maxzeil); {maxzeil: anzahl zeilen im file}

  close(f);                            {file wieder schlieáen}

     {* balkenberechnug}
  balhoe:=trunc(zeilen/maxzeil*leihoe)+1; {hoehe ist konstant bim File}
  if balhoe>leihoe then balhoe:=leihoe;  {file zu klein: balken maximalgrӇe}
  balcal:=leihoe/maxzeil; {Umrechnungsqoutient textzeilen nach balkenzeilen}
  baladdi:=leistart;  {position am Anfang}

  ende:=false;
  aktzeil:=zeilen;
  printpage;


        {***STEUERUNG***}
  repeat
       {**Wart auf eingabe}
    repeat
    until (keypressed) or (knopf<>0);

       {REAKTIONEN:}
    if keypressed then begin {KEYBOARD}
       inp:=readkey;

      case inp of
        #72:dec(aktzeil);{lineup;}
        #80:inc(aktzeil);{linedown;}
        #73:dec(aktzeil,zeilen);{pageup;}
        #81:inc(aktzeil,zeilen);{pagedown;}
        #27:ende:=true;
      else
        if (byte(inp)>48) and (byte(inp)<54) then {BILD}
          if bild[byte(inp)-49]<>$ff then
            showbcl(bild[byte(inp)-48]);
      end;
    end;

    if knopf<>0 then begin {MAUS}
      if ver>427 then begin
        x:=hor;
        if x>520 then inc(x) {print}
        else if x>440 then inc(aktzeil,zeilen){pagedown;}
        else if x>360 then dec(aktzeil,zeilen){pageup;}
        else if x>280 then ende:=true
        else if x>200 then inc(aktzeil){linedown;}
        else if x>120 then dec(aktzeil){lineup;}
        else if x>100 then inc(x){nix}
        else if x>76 then begin
          if bild[5]<>$ff then showbcl(bild[5]);
        end else if x>60 then begin
          if bild[4]<>$ff then showbcl(bild[4]);
        end else if x>44 then begin
          if bild[3]<>$ff then showbcl(bild[3]);
        end else if x>28 then begin
          if bild[2]<>$ff then showbcl(bild[2]);
        end else if x>12 then if bild[1]<>$ff then showbcl(bild[1]);

      end;
      delay(70);{}
    end;

    printpage;{neue Seite darstellen}

  until ende;
  cursoraus;
  dispose(textmem); {Speicher freigeben}
  dispose(fontmem);

end;


begin
end.