{$M 65000,0,400000} {l„uft noch bei 388k}
program coolmag;
uses crt,coolmaus,coollow,coolutil,coolopt,arkanoid;

type p64k=array[0..64000] of byte;
     menuobenp=array[1..41*320] of byte;
     menuuntenp=array[1..47*320] of byte;
     bildp=array[1..110*111] of byte;
     markonp=array[0..3*14] of byte;
     kastenp=array[1..6,1..104*15] of byte;
     kleinkastenp=array[1..6,1..97*15] of byte;
     paldata=array[0..768] of byte;

var puffer:^p64k;
    kasten:^kastenp;
    kleinka:^kleinkastenp;
    menuoben:^menuobenp;
    menuunten:^menuuntenp;
    propmem:^p64k;
    bild:array[1..6] of ^bildp;
    mark2,markon:^markonp;
    palette:array[1..6] of paldata;
    pal:paldata;

var mx,my:integer;
    akt_seite,artnr:byte;
    ende:boolean;
    f:file;
    zahler:word;
    inp:char;
    artikel:byte;
    laufstat:byte;
{$I inhalte.pas} {String konstanten f�r die Artikelnamen}

const fonthoehe=11;   {fontconstanten}
      fontbreite=4;   {hoehe;maxbreite}
      fontsize=fontbreite*fonthoehe+1;{breitebyte}
      asciilist1:array[1..79] of char='ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789.,;:!?"+-*/[]()><abcdefghijklmnopqrstuvwxyz';
      asciilist2:array[1..8] of char='„”�Ž™šá''';


procedure nextpage(nr:byte);forward;
procedure menupage;forward;

        {***0***UTILITIES}
procedure print(text:string;dest,font:pointer); {TEXT OHNE HINTERGRUND}
var i,y,x:word;
    buch:byte;
begin
  for i:=1 to byte(text[0]) do begin
    buch:=byte(text[i])-32;
      for y:=0 to fonthoehe-1 do
        for x:=0 to fontbreite-1 do
          if mem[seg(font^):ofs(font^)+x+y*fontbreite+buch*fontsize]<>0 then
          mem[seg(dest^):ofs(dest^)+x+i*fontbreite+y*320+5]:=30;
  end;
end;

procedure printback(text:string;dest,font:pointer); {Text mit Hintergrund f�r die HM-Swatch}
var i,y,x:word;
    buch:byte;
begin
  for i:=1 to byte(text[0]) do begin
    buch:=byte(text[i])-32;
      for y:=0 to fonthoehe-1 do
        for x:=0 to fontbreite-1 do
          if mem[seg(font^):ofs(font^)+x+y*fontbreite+buch*fontsize]<>0 then
          mem[seg(dest^):ofs(dest^)+x+i*fontbreite+y*320+5]:=30 else
          mem[seg(dest^):ofs(dest^)+x+i*fontbreite+y*320+5]:=5;
  end;
end;

            {SPECIAL FEATURE: Eingebaute Uhr Rechts unten anzeigen}
procedure showtime;
var std,min,sec:byte;
    timestr:string[8];
    dumstr:string[2];
begin
  asm             {GETTIME}
    mov ah,2
    int 1ah
    mov std,ch
    mov min,cl
    mov sec,dh
  end;   {PRINTTIME}
  std:=((std shr 4)*10+(std and 15)); {BCD-Zahlen nach Bin„rzahl konvertieren}
  min:=((min shr 4)*10+(min and 15));
  sec:=((sec shr 4)*10+(sec and 15));

  timestr:='';   {Zahlen in String speichern}
  str(std,dumstr);
  timestr:=dumstr+':';
  str(min,dumstr);
  timestr:=timestr+dumstr+':';
  str(sec,dumstr);
  timestr:=timestr+dumstr;

  printback(timestr+' ',ptr($a000,157*320+270),propmem); {Ausgabe}
  printback('Die COOLMAG-Swatch:',ptr($a000,157*320+10),propmem);
end;

procedure laufrahm(nr:byte;klein:boolean); {blinkrahmen um Artikel}
var i,addi,breit:word;    {KLEIN=True: Kleiner Rahmen f�r Submen�s}
    col:byte;
begin
  if klein then begin
    addi:=(14*(nr and $f))*320+10673;
    breit:=93;
  end else begin
    addi:=(16*(nr and $f)+25)*320+1;
    if nr>16 then inc(addi,215); {kasten rechts}
    breit:=101;
  end;

  dec(laufstat);
  col:=laufstat;
  for i:=0 to breit do begin
    inc(col);    {oben}
    col:=col and 15;
    mem[$a000:addi+i]:=col+209;
  end;
  for i:=12 downto 1 do begin
    inc(col);    {links}
    col:=col and 15;
    mem[$a000:addi+i*320]:=col+209;
  end;
  addi:=addi+breit;
  for i:=1 to 12 do begin
    inc(col);     {rechts}
    col:=col and 15;
    mem[$a000:addi+i*320]:=col+209;
  end;
  addi:=addi-breit+12*320;
  for i:=breit downto 0 do begin
    inc(col);    {unten}
    col:=col and 15;
    mem[$a000:addi+i]:=col+209;
  end;
end;


procedure rahmen(nr,col:byte;klein:boolean); {rahmen um Artikel entfernen}
var i,addi,breite:word;
begin
  if klein then begin  {Untermen�}
    addi:=(14*(nr and $f))*320+10673;
    breite:=93;
  end else begin           {oder Hauptmen�}
    breite:=101;
    addi:=(16*(nr and $f)+25)*320+1;
  end;
  if nr>16 then inc(addi,215); {rechts}
  for i:=0 to breite do mem[$a000:addi+i]:=col;
  for i:=1 to 12 do mem[$a000:addi+i*320]:=col;
  addi:=addi+breite;
  for i:=1 to 12 do mem[$a000:addi+i*320]:=col;
  addi:=addi-breite+12*320;
  for i:=0 to breite do mem[$a000:addi+i]:=col;
end;



            {***1*** INITIALISIERUNG}
procedure initfont;  {Font von den .S13-Files einlesen und in die richtige}
var i,x,y:word;      {Reihenfolge bringen  (mittels den ASCIILISTS, s.o)}
    fseg,pseg:word;

  procedure getletter(fontseg,fontofs,scrseg,scrofs:word);
    var x,y:word;   {liest einen Buchstaben in das fontmem}
    begin
      for y:=0 to fonthoehe-1 do
        for x:=0 to fontbreite-1 do
          mem[fontseg:fontofs+y*fontbreite+x]:=
             mem[scrseg:scrofs+y*320+x];
    end;  {unterprocedure getletter}


begin
  fseg:=seg(propmem^);
  pseg:=seg(puffer^); (* S13 ist in pseg($a000)*)
     (* Speicher initialisieren *)
  fillchar(propmem^,64000,0);

  x:=ofs(puffer^)+4;
  for i:=1 to 79 do begin(* ABCDEFGHIJKLMNOPQRSTUVWXYZ()!?" *)
   getletter(fseg,ofs(propmem^)+(byte(asciilist1[i])-32)*fontsize,pseg,19*320+x);
   x:=x+4;
  end;
  x:=ofs(puffer^);
  for i:=1 to 8 do (* „”�Ž™šá' *) begin
   getletter(fseg,ofs(propmem^)+(byte(asciilist2[i])-32)*fontsize,pseg,216+9*320+x);
   x:=x+4;
  end;
end;

procedure initcool;  {<<<<<<<Hauptinitialisierung f�r Coolmag}
var x,y,i:word;
    f:file;
begin
     asm
       mov ax,13h
       int 10h
     end;
     (* POINTER *)
     new(puffer);         {}
{     puffer:=ptr($a000,0);{alter Test, zum šberpr�fen der Offsets}
     new(menuoben);  {Obere+Untere Men�zeile}
     new(menuunten);
     new(kasten);    {Auswahlk„sten links und rechts}
     new(kleinka);   {Untemen�auswahlk„sten}
     new(markon);    {Leuchte oben aus/an}
     new(mark2);
     new(propmem);   {FONTSpeicher}
     for zahler:=1 to 6 do new(bild[zahler]); {Mittelbilder der Seiten}

     (* BILDER LADEN *)
     loadhm5(pfad+'pics\layout0.s13',seg(puffer^),ofs(puffer^),64000);
     initfont;

     for x:=1 to 8 do   {getmauscursor}
       for y:=0 to 7 do
         mousebild[0,x,y+1]:=mem[seg(puffer^):200+x+y*320];

     moved(@puffer^[36*320],menuoben,320*41);
     moved(@puffer^[320*77],menuunten,320*47);

     for zahler:=0 to 2 do
       move(puffer^[13+320*32+zahler*320],mark2^[1+zahler*13],13);
     for zahler:=0 to 2 do
       move(puffer^[320*32+zahler*320],markon^[1+zahler*13],13);{}

     for i:=1 to 6 do begin   {**SEITEN EINLESEN}
       assign(f,pfad+'pics\seite'+char(i+48)+'.s13');{}
{       assign(f,pfad+'pics\spiel.s13');}
       reset(f,1);
       blockread(f,palette[i],768);
       seek(f,1000);
       blockread(f,mem[seg(puffer^):ofs(puffer^)],64000);
       close(f);

       for x:=0 to 31 do begin
         palette[i,3*x]:=x shl 1;
         palette[i,3*x+1]:=x shl 1;
         palette[i,3*x+2]:=x shl 1;
       end;

       for zahler:=0 to 14 do    {KŽSTEN}
         moved(@puffer^[111+zahler*320],@kasten^[i,1+zahler*104],104);
       for zahler:=0 to 14 do    {Untermen�KŽSTEN}
         move(puffer^[215+zahler*320],kleinka^[i,1+zahler*97],97);

       for zahler:=0 to 110 do   {BILD}
         move(puffer^[zahler*320],bild[i]^[1+zahler*110],110);
     end;


      (* MAUSINIT *)
     ende:=false;
     coolmaus.init;
     coolmaus.cursoraus;
     coolmaus.grenzen(1,1,320-8,200-8);
     coolmaus.setzmaus(160,100);
     mx:=160;my:=100;

     (* 1. SEITE ANZEIGEN *)
     artikel:=1;
     akt_seite:=1;
     nextpage(akt_seite);
end;


                {***2*** UNTERMENšS}
procedure drawsubmenu(akt_seite,listnr,menuanz:word);
var i,zahler:word;
begin
  for i:=1 to menuanz do     {soviele Untermen�k„sten malen}
    for zahler:=0 to 14 do   {15 Untermen�KŽSTENzeilen}
      move(kleinka^[akt_seite,1+zahler*97],mem[$a000:10351+(i*14+zahler)*320],97);
  for i:=1 to menuanz do     {Schrift einf�gen}
    print(sublist[listnr,i],ptr($a000,11310+i*14*320),propmem);
end;


procedure submenu(akt_seite,artnr:word);
var zahler,menuanz,aktsub,listnr,i,x:word;
    ende:boolean;
    inp:char;
begin
  while knopf<>0 do;
  while keypressed do;
  restorehg(mx,my);
  listnr:=subnr[akt_seite,artnr];
  menuanz:=5;
  for i:=1 to 5 do    {Anzahl feststellen, aus der Namensliste}
    if sublist[listnr,i]='' then dec(menuanz);
  drawsubmenu(akt_seite,listnr,menuanz); {MEn� malen}

  ende:=false;
  aktsub:=1;

  repeat   {*****SUBMENUAuswahl}
    savehg(mx,my);
    putmouse(mx,my,0);
    repeat
      seekret;       {WAIT FOR MOUSE OR KEY}
      laufrahm(aktsub,true);
      showtime;
      if (mx<>hor) or (my<>ver) then begin
        restorehg(mx,my);
        mx:=hor;
        my:=ver;
        savehg(mx,my);
        putmouse(mx,my,0);
      end;
    until (knopf<>0) or keypressed;
    restorehg(mx,my);

    if keypressed  then begin  {******TASTATUR}
      while keypressed do inp:=readkey;
      rahmen(aktsub,0,true);
      case inp of
        #80:inc(aktsub);
        #72:dec(aktsub);
        #13:begin                {ARKANOID}
             if (akt_seite=3) and (artnr=0) and (aktsub>1) then begin
               playfirst(puffer);
               for zahler:=0 to 110 do
                 move(bild[akt_seite]^[1+zahler*110],mem[$a000:105+(zahler+40)*320],110);
               setpal(@palette[3]);
               drawsubmenu(akt_seite,listnr,menuanz);
             end else begin
               if artnr>7 then   {ARTIKEL LESEN}
                 viewlow(akt_seite,artnr,aktsub,inhalt[akt_seite,1,artnr-6])
               else
                 viewlow(akt_seite,artnr,aktsub,inhalt[akt_seite,0,artnr+1]);
               menupage;
               drawsubmenu(akt_seite,listnr,menuanz);
             end;
           end;

      else ende:=true;
      end;

      if aktsub<1 then aktsub:=menuanz;
      if aktsub>menuanz then aktsub:=1;
      rahmen(aktsub,255,true);
    end;

    if knopf<>0 then begin  {*******MAUSI}
      while knopf<>0 do;

      if (mx>108) and (mx<208) and (my>47) and (my<47+menuanz*14) then begin
        aktsub:=(my-33) div 14;
        if (akt_seite=3) and (artnr=0) and (aktsub>1) then begin
          playfirst(puffer);  {ARKANOID}
          for zahler:=0 to 110 do
            move(bild[akt_seite]^[1+zahler*110],mem[$a000:105+(zahler+40)*320],110);
          setpal(@palette[3]);
          drawsubmenu(akt_seite,listnr,menuanz);
        end else begin
          if artnr>7 then
            viewlow(akt_seite,artnr,aktsub,inhalt[akt_seite,1,artnr-6])
          else
            viewlow(akt_seite,artnr,aktsub,inhalt[akt_seite,0,artnr+1]);
          menupage;
          drawsubmenu(akt_seite,listnr,menuanz);
        end;
      end else ende:=true;
    end;

  until ende;

  restorehg(mx,my);             {Aufr„umen}
  for zahler:=0 to 110 do begin
    move(bild[akt_seite]^[1+zahler*110],mem[$a000:105+(zahler+40)*320],110);
  end;
  while keypressed do readkey;
  savehg(mx,my);
  putmouse(mx,my,0);
end;


                {***3*** MAINPROGRAM}

procedure menupage;  {back from viewer, restore gfxmode}
begin
     asm
       mov ax,13h
       int 10h
     end;
     savehg(mx,my);
     setpal(@palette[akt_seite]);
     nextpage(akt_seite);
     coolmaus.grenzen(1,1,320-8,200-8);
end;



procedure nextpage(nr:byte);  {Wechselt auf n„chst Seite}
var i,z2,zy,zahler:word;
begin
     restorehg(mx,my);
     moved(menuoben,ptr($a000,0000),320*41);
     moved(menuunten,ptr($A000,153*320),320*47);


     for i:=1 to 6 do    {LEUCHTE}
       for zahler:=0 to 2 do
         move(mark2^[1+zahler*13],mem[$a000:(zahler+36)*320+107+i*13],13);{}
     for zahler:=0 to 2 do
       move(markon^[1+zahler*13],mem[$a000:(zahler+36)*320+107+nr*13],13);{}


     (* ALTES BILD L™SCHEN *)
     for zahler:=1 to 434 do begin
       inc(zahler);
       for i:=1 to 110 do
         if (integer(zahler-i)>0) and ((zahler-i-1)<320) then begin
           mem[$a000:(40+i)*320+zahler-i-1]:=0;
           mem[$a000:(40+i)*320+320-zahler+i]:=0;
         end;
       delay(2);
     end;

     setpal(@palette[nr]);
     port[$3c8]:=44; {Farben f�r die Anzeigeleiste oben}
     port[$3c9]:=0;  {sind leider nicht inder Palette enthalten}
     port[$3c9]:=63; {und werden hier gesetzt}
     port[$3c9]:=63;
     port[$3c8]:=43;
     port[$3c9]:=0;
     port[$3c9]:=0;
     port[$3c9]:=48;


      (* NEUES BILD VORBEREITEN *)
      fillchar(puffer^,64000,0);
      for zahler:=0 to 110 do begin
        move(bild[nr]^[1+zahler*110],puffer^[105+zahler*320],110);
      end;

      for zahler:=0 to 6 do begin {MENšKŽSTEN}
        for i:=0 to 14 do begin
          moved(@kasten^[nr,1+i*104],@puffer^[(i+zahler*16)*320],104);
          moved(@kasten^[nr,1+i*104],@puffer^[(i+zahler*16)*320+215],104);
        end;
      end;
         {schrift einf�gen}
     for i:=1 to 7 do begin
       print(inhalt[nr,0,i],ptr(seg(puffer^),ofs(puffer^)
         +3*320+(i-1)*16*320-11+5*((25-length(inhalt[nr,0,i])) shr 1)),propmem);
     end;
     for i:=1 to 7 do begin  {mehr Schrift rechts}
       print(inhalt[nr,1,i],ptr(seg(puffer^),ofs(puffer^)
         +215+3*320+(i-1)*16*320-11+5*((25-length(inhalt[nr,1,i])) shr 1)),propmem);
     end;

     (* NEUES BILD DINGSEN *)
     for zahler:=434 downto 1 do begin
       dec(zahler);
       for i:=1 to 112 do
         if (integer(zahler-i)>0) and ((zahler-i-1)<320) then begin
           mem[$a000:(39+i)*320+zahler-i-1]:=puffer^[(i-1)*320+zahler-i-1];
           mem[$a000:(39+i)*320+320-zahler+i]:=puffer^[(i-1)*320+320-zahler+i];
         end;
       delay(2);
     end;

     laufrahm(artikel,false);
     savehg(mx,my);
     putmouse(mx,my,0);
end;


procedure main;
begin       {***** MAIN *****}
  repeat
    repeat         {WAIT FOR MOUSE/KEY ACTIVITY}
      seekret;
      laufrahm(artikel,false);
      showtime;
      if (mx<>hor) or (my<>ver) then begin
        restorehg(mx,my);
        mx:=hor;
        my:=ver;
        savehg(mx,my);
        putmouse(mx,my,0);
      end;
    until (knopf<>0) or keypressed;

    if knopf<>0 then begin    {1. MAUSKLICK auswerten}
      if my<33 then begin
      end;
      if my>170 then begin
        if mx<28 then begin(* LINKS *)
          dec(akt_seite);
          if akt_seite=0 then akt_seite:=6;
          nextpage(akt_seite);
        end else
          if mx<110 then begin(* OPTIONS *)
             options(puffer);
             menupage;
          end else
            if mx<215 then begin(* EXIT TO DOS *)
              ende:=true;
            end else
              if mx<292 then begin(* VOTE *)
              end else
                if mx<320 then begin(* RECHTS *)
                  inc(akt_seite);
                  if akt_seite=7 then akt_seite:=1;
                  nextpage(akt_seite);
                end;
      end;

      if (my>42) and (my<168) and (mx<120)then begin {ARTIKEL links}
        artnr:=byte((my-42)div 16);
        if subnr[akt_seite,artnr]>0 then submenu(akt_seite,artnr) else begin
        viewlow(akt_seite,artnr,0,inhalt[akt_seite,0,artnr+1]);
          menupage;
        end;
      end;
      if (my>42) and (my<168) and (mx>200)then begin {ARTIKEL rechts}
        artnr:=byte((my-42)div 16)+7;
          if subnr[akt_seite,artnr]>0 then submenu(akt_seite,artnr) else begin
            viewlow(akt_seite,artnr,0,inhalt[akt_seite,1,artnr-6]);
            menupage;
          end;
      end;


    end else begin
      if keypressed  then begin  {******2. TASTATUR auswerten}
        rahmen(artikel,0,false);
        while keypressed do inp:=readkey;
        case inp of
          #27:ende:=true;
          #73:begin  {links/pgdn}
              inc(akt_seite);
              if akt_seite=7 then akt_seite:=1;
              nextpage(akt_seite);
            end;
          #81:begin  {rechts/pgup}
              dec(akt_seite);
              if akt_seite=0 then akt_seite:=6;
              nextpage(akt_seite);
            end;
          #32:begin  {options}
              options(puffer);
              while not(keypressed) do;
            end;
          #13:begin
              if (artikel<16) then begin {links}
                artnr:=artikel-1;
                if subnr[akt_seite,artnr]>0 then submenu(akt_seite,artnr) else begin
                  viewlow(akt_seite,artnr,0,inhalt[akt_seite,0,artnr+1]);
                  menupage;
                end;
              end;
              if artikel>16 then begin  {rechts}
                artnr:=(artikel and $f)+6;
                if subnr[akt_seite,artnr]>0 then submenu(akt_seite,artnr) else
                  viewlow(akt_seite,artnr,0,inhalt[akt_seite,1,artnr-6]);

                menupage;
              end;
           end;
          #75:if (artikel and $10)=0 then begin {seite links}
                dec(akt_seite);
                if akt_seite=0 then akt_seite:=6;
                nextpage(akt_seite);
              end else artikel:=artikel and $ef; {linke spalte:nr < 16}
          #77:if (artikel and $10)>0 then begin {seite rechts}
                inc(akt_seite);
                if akt_seite=7 then akt_seite:=1;
                nextpage(akt_seite);
               end else artikel:=artikel or $10; {rechte spalte:nr>16}
          #80:inc(artikel);
          #72:dec(artikel);
        else
        end;
        if (artikel and $f)=0 then inc(artikel);
        if (artikel and $f)=8 then dec(artikel);
        laufrahm(artikel,false);
      end;  {artikelmenu}
    end;
  until ende;
end;

procedure exitcool; {Speicher wieder freigeben...}
var zahler:word;
begin
  dispose(puffer);         {}
  dispose(menuoben);  {Obere+Untere Men�zeile}
  dispose(menuunten);
  dispose(kasten);    {Auswahlk„sten links und rechts}
  dispose(kleinka);   {Untemen�auswahlk„sten}
  dispose(markon);    {Leuchte oben aus/an}
  dispose(mark2);
  dispose(propmem);   {FONTSpeicher}
  for zahler:=1 to 6 do dispose(bild[zahler]); {Mittelbilder der Seiten}

  textmode(co80);
  writeln('Es w„re wohl angebracht, noch etwas mehr Speicher freizuschaufeln,');
  writeln('denn mit dem biáchen Platz im RAM l„uft gar nichts. Nach unseren');
  writeln('Messungen sollten h”chstens 905 KB ausreichen. Falls das nicht zu');
  writeln('schaffen ist, so lege dir doch eine Bootdiskette an. Wie, das erf„hrst');
  writeln('du in deinem DOS-Handbuch oder (besser) in unserer README-Datei im');
  writeln('Coolmag-Verzeichnis.');
  writeln;
  writeln('Es wurden noch ',memavail,' Byte freier HEAP gefunden.');
  writeln('Ben”tigt werden ',926720-memavail,' Bytes mehr.');

end;

begin
  initcool;
  main;
  exitcool;
end.