(*---------------------------------------------------------------------------
  :Program.    BobDisk.mod
  :Contents.   DiskSupport für BobEdi
  :Author.     Frank Lömker
  :Copyright.  FreeWare, siehe Dok-File
  :Language.   Modula-2
  :Translator. M2Amiga V4.0d
  :Imports.    IntuiSupport 1.1.1 [Christian Stiens]
  :Imports.    ARPFileReq 1.0.1 [Bernd Preusing], IFFLib [fbs]
  :History.    V1.0, [Frank Lömker] 26-Dez-91
  :Bugs.       keine bekannt
---------------------------------------------------------------------------*)

IMPLEMENTATION MODULE BobDisk;

(*$ LargeVars:=FALSE StackParms:=FALSE StackChk:=FALSE EntryClear:=FALSE
    CaseChk:=FALSE RangeChk:=FALSE NilChk:=FALSE OverflowChk:=FALSE *)

FROM IntuitionD IMPORT GadgetPtr,ScreenPtr,WindowPtr,IntuiMessage,
      WindowFlagSet,WindowFlags,IDCMPFlagSet,IDCMPFlags,selectDown;
FROM IntuitionL IMPORT CloseWindow,ModifyIDCMP,RefreshGadgets,RemoveGadget,
      CloseScreen,ActivateGadget;
FROM GraphicsD IMPORT BitMap,RastPortPtr,ViewModeSet,ViewModes,DrawModeSet,
      DrawModes,spriteAttached;
FROM GraphicsL IMPORT SetAPen,RectFill,BltBitMap,SetRGB4,LoadRGB4,
      BltClear,SetDrMd;
FROM GfxMacros IMPORT RasSize;
FROM DosD IMPORT FileLockPtr,accessRead,FileInfoBlock;
FROM DosL IMPORT SetComment,Lock,UnLock,Examine;
FROM WorkbenchD IMPORT noIconPosition,DiskObjectPtr;
FROM IconL IMPORT GetDiskObject,PutDiskObject,FreeDiskObject;
FROM SYSTEM IMPORT CAST,ADDRESS,ADR,ASSEMBLE,LONGSET,SHIFT;
FROM Conversions IMPORT ValToStr;
IMPORT S:String;  (* Copy,Concat,Length,Compare *)
FROM FileSystem IMPORT File,Lookup,Close,Response,WriteBytes,ReadBytes,
      SetPos,Length;
FROM IntuiSupport IMPORT CreateScreen,CreateWindow,GetIMes,
      CreateStrGadget,autoBorder,stdGadg,stdActv;
FROM ARPFileReq IMPORT FileReq;
FROM IFFLib IMPORT OpenIFF,CloseIFF,GetBMHD,BitMapHeaderPtr,BitMapHeader,
      GetColorMap,DecodePic,IffError,SaveClip,SaveIFFFlagSet,SaveIFFFlags;
FROM BobHelp IMPORT maxbreite,  Tfarben,Tgrenzen,TgrenzG,str70,str10,str2,
      myscreen,rp,mywin,bilder,anzbilder,kleinx,kleiny,xbreite,ybreite,
      Farben,box,Print,rahmen,bin,fehler,frage,getCol,lupe,checkgads,
      datfehler,zeigdatf;
FROM InitBMap IMPORT FreeBit,InitBit;

CONST header="BildBobE";
      sourceIcon="source.icon";
      animIcon="anim.icon";
      commentStr="BobEdi 1.0 Bilder:22 Breite:32 Höhe:32 Planes:4";
TYPE Tsprache=(modula,assem,c,modalt);
VAR imes:IntuiMessage;
    startT,endT,zeileT,kstartT,kendT:ARRAY [modula..modalt],[1..25] OF CHAR;
    dat:File;
    Flock:FileLockPtr;
    copybit:BitMap;
    SIcon,farbe,sprite:BOOLEAN;

PROCEDURE clear (bildnr:INTEGER);
VAR nr:INTEGER;
BEGIN
  WITH bilder^[bildnr] DO
    FOR nr:=0 TO 3 DO
      BltClear (planes[nr],bytesPerRow*rows,LONGSET{});
    END;
  END;
END clear;

PROCEDURE saveIcon (IconN,name:ADDRESS);
VAR icon:DiskObjectPtr;
BEGIN
  IF SIcon THEN
    icon:=NIL;
    icon:=GetDiskObject (IconN);
    IF icon#NIL THEN
      icon^.currentX:=noIconPosition;
      icon^.currentY:=noIconPosition;
      IF NOT PutDiskObject (name,icon) THEN
        fehler ("Kann Icon nicht","saven !");
      END;
      FreeDiskObject (icon);
    ELSE
      fehler ("Icon nicht","vorhanden !");
    END;
  END;
END saveIcon;

PROCEDURE loadIff (name:str70;bildnr:INTEGER;VAR anzfarben:INTEGER);
VAR datei:ADDRESS;
    mybmhd:BitMapHeaderPtr;
    farb:ARRAY [0..31] OF INTEGER;
    anz,x,y:INTEGER;
    err:LONGINT;
    nr:CARDINAL;
    bildscr:ScreenPtr;
    bildwin:WindowPtr;
    viewm:ViewModeSet;
    error:BOOLEAN;
BEGIN
  error:=TRUE;
  datei:=OpenIFF (ADR(name));
  IF (IffError()=0) AND (datei#NIL) THEN
    mybmhd:=GetBMHD (datei);
    IF (IffError()=0) AND (mybmhd#NIL) THEN
      IF (mybmhd^.nPlanes<6) AND (mybmhd^.w<750) AND (mybmhd^.h<570) THEN
        anz:=GetColorMap (datei,ADR(farb));
        IF anz<=0 THEN
          fehler ("ColorMap nicht","zu finden !");
        ELSIF (mybmhd^.w<49) AND (mybmhd^.h<49) THEN
          clear (bildnr);
          IF DecodePic (datei,ADR(bilder^[bildnr])) THEN
            error:=FALSE;
          ELSE
            fehler ("Bild nicht zu","entpacken !");
          END;
        ELSE
          IF mybmhd^.w>330 THEN viewm:=ViewModeSet{hires};
                           ELSE viewm:=ViewModeSet{}; END;
          IF mybmhd^.h>266 THEN INCL (viewm,lace); END;
          y:=10;
          IF ( (lace IN viewm) AND (mybmhd^.h>518) ) OR
             ( NOT (lace IN viewm) AND (mybmhd^.h>259) ) THEN y:=0; END;
          IF mybmhd^.w<310 THEN x:=310
                           ELSE x:=mybmhd^.w; END;
          IF mybmhd^.h<50 THEN nr:=50
                          ELSE nr:=mybmhd^.h; END;
          bildscr:=CreateScreen (NIL,x,nr+CARDINAL(y),mybmhd^.nPlanes,viewm);
          IF bildscr#NIL THEN
            bildwin:=CreateWindow (NIL,0,0,x,nr+CARDINAL(y),bildscr,NIL,
                 WindowFlagSet{rmbTrap,activate,reportMouse,borderless},
                 IDCMPFlagSet{mouseMove,mouseButtons});
            IF bildwin#NIL THEN
              LoadRGB4 (ADR(bildscr^.viewPort),ADR(farb),anz);
              IF DecodePic (datei,ADR(bildwin^.rPort^.bitMap^)) THEN
                IF mybmhd^.nPlanes=5 THEN
                  WITH bildwin^.rPort^.bitMap^ DO
                    BltClear (planes[4],bytesPerRow*rows,LONGSET{});
                  END;
                END;
                rp:=bildwin^.rPort;
                IF y=10 THEN
                  Print (1,1,mybmhd^.h+7,39,
                         ADR("Bitte Ausschnitt wählen (rechts:Cancel)"));
                END;
                SetDrMd (rp,DrawModeSet{complement});
                REPEAT
                  x:=bildwin^.mouseX; y:=bildwin^.mouseY;
                  box (x,y,x+47,y+47,0);
                  GetIMes (bildwin,imes,TRUE);
                  box (x,y,x+47,y+47,0);
                UNTIL mouseButtons IN imes.class;
                SetDrMd (rp,DrawModeSet{dm0});
                Print (0,1,mybmhd^.h+7,39,
                       ADR("Bitte Ausschnitt wählen (rechts:Cancel)"));
                rp:=mywin^.rPort;
                IF imes.code=selectDown THEN
                  clear (bildnr); error:=FALSE;
                  IF CARDINAL(x)+48>mybmhd^.w THEN x:=INTEGER(mybmhd^.w)-48; END;
                  IF CARDINAL(y)+48>mybmhd^.h THEN y:=INTEGER(mybmhd^.h)-48; END;
                  IF x<0 THEN x:=0; END;
                  IF y<0 THEN y:=0; END;
                  err:=BltBitMap (bildwin^.rPort^.bitMap,x,y,
                              ADR(bilder^[bildnr]),0,0,48,48,192,255-16,NIL);
                END;
                CloseWindow (bildwin);
                CloseScreen (bildscr);
              ELSE
                CloseWindow (bildwin);
                CloseScreen (bildscr);
                fehler ("Bild nicht zu","entpacken !");
              END;  (* If DecodePic *)
            ELSE
              CloseScreen (bildscr);
              fehler ("Fenster ist nicht","zu öffnen !");
            END;  (* IF bildwin *)
          ELSE
            fehler ("Screen ist nicht","zu öffnen !");
          END;  (* IF bildscr *)
        END;  (* IF mybmhd^.w *)
      ELSE
        fehler ("Bild hat falsche","Ausmaße !");
      END;  (* IF mybmhd^.nPlanes *)
    ELSE
      fehler ("BitMapHeader nicht","zu finden !");
    END;  (* IF iffError *)
  ELSE
    fehler ("Fehler beim Öffnen","der Datei !");
  END;  (* IF iffError *)
  CloseIFF (datei);
  IF NOT error THEN
    IF anz>16 THEN anz:=16; END;
    IF anz>anzfarben THEN anzfarben:=anz; END;
    FOR nr:=0 TO anz-1 DO
      SetRGB4 (ADR(myscreen^.viewPort),nr+16,(farb[nr] DIV 256),
               (farb[nr] DIV 16 MOD 16),(farb[nr] MOD 16));
    END;
  END;
END loadIff;

PROCEDURE saveiff (name:str70;grenzen:Tgrenzen;anzfarben:INTEGER);
VAR nr,tiefe:INTEGER;
    ok:BOOLEAN;
    farben:ADDRESS;
BEGIN
  tiefe:=bin (anzfarben)-1;
  farben:=myscreen^.viewPort.colorMap^.colorTable;
  INC (farben,SIZE(INTEGER)*16);      (* Nur letzten 16 Farben speichern *)
  IF grenzen[1]#grenzen[2] THEN S.Concat (name,".00"); END;
  ok:=TRUE; nr:=grenzen[1]-1;
  REPEAT
    INC (nr);
    IF grenzen[1]#grenzen[2] THEN
      name[S.Length(name)-1]:=CHAR(nr DIV 10+48);
      name[S.Length(name)]:=CHAR(nr MOD 10+48);
    END;
    bilder^[nr].depth:=tiefe;
    ok:=SaveClip (ADR(name),ADR(bilder^[nr]),farben,
                  SaveIFFFlagSet{cmpByteRun1},0,0,xbreite DIV 8,ybreite);
    bilder^[nr].depth:=5;
    IF ok THEN saveIcon (ADR(animIcon),ADR(name)); END;
  UNTIL (NOT ok) OR (nr>=grenzen[2]);
  IF NOT ok THEN
    DEC (nr);
    IF nr<grenzen[1] THEN
      fehler ("Konnte keine Bilder","saven !");
    ELSIF nr=grenzen[1] THEN
      fehler ("Konnte nur 1 Bild","saven !");
    ELSE
      name:="   Konnte nur  2   ";
      IF nr-grenzen[1]+1>0 THEN
        name[15]:=CHAR((nr-grenzen[1]+1) DIV 10+48);
      END;
      name[16]:=CHAR((nr-grenzen[1]+1) MOD 10+48);
      fehler (name,"Bilder saven !");
    END;
  END;
END saveiff;

VAR info:FileInfoBlock;

PROCEDURE loadBob (name:str70;grenzen:Tgrenzen;VAR anzfarben:INTEGER;
                   raw:BOOLEAN);
VAR actual:LONGINT;
    farben:POINTER TO ARRAY [0..31] OF INTEGER;
    help:ARRAY [1..SIZE(header)] OF CHAR;
    farbInfo,weiter:BOOLEAN;
    nr,tiefe,anz,anzahl,breite,hoehe,plane:INTEGER;
    err:LONGINT;
BEGIN
  weiter:=FALSE; anz:=0; breite:=0; hoehe:=0; tiefe:=0;
  IF raw THEN
    Flock:=Lock (ADR(name),accessRead);
    IF Flock#NIL THEN
      IF Examine (Flock,ADR(info)) THEN
        WITH info DO
          IF (S.Length(comment)>=SIZE(commentStr)) AND
             (S.Compare ("BobEdi-",comment)=7) THEN
            anz:=(INTEGER(comment[18])-48)*10; anz:=anz+INTEGER(comment[19])-48;
            breite:=(INTEGER(comment[28])-48)*10;
            breite:=breite+INTEGER(comment[29])-48;
            hoehe:=(INTEGER(comment[36])-48)*10;
            hoehe:=hoehe+INTEGER(comment[37])-48;
            tiefe:=INTEGER(comment[46])-48;
            farbInfo:=S.Length(comment)>SIZE(commentStr);
            nr:=2;
            IF size#( LONGINT(breite DIV 8)*hoehe*tiefe*anz+
                     LONGINT(farbInfo)*SHIFT(nr,tiefe-1)*SIZE(INTEGER) ) THEN
              fehler ("Falsches Format !","");
            ELSE
              weiter:=TRUE;
            END;  (* IF size# *)
            IF weiter AND farbInfo AND (anzfarben<SHIFT(nr,tiefe-1)) THEN
              anzfarben:=SHIFT(nr,tiefe-1);
            END;
          ELSE
            fehler ("Falsches Format !","");
          END;  (* IF (S.Length(comment *)
        END; (* With *)
      ELSE
        fehler ("Datei nicht zu","untersuchen !");
      END;  (* IF Examine *)
      UnLock (Flock); Flock:=NIL;
    ELSE
      zeigdatf (lockErr);
    END;  (* IF Flock#NIL *)
  ELSE
    Lookup (dat,name,20,FALSE);
    IF NOT datfehler (dat) THEN
      ReadBytes (dat,ADR(help),SIZE(header),actual);
      IF NOT datfehler (dat) THEN
        IF S.Compare (header,help)=0 THEN
          ReadBytes (dat,ADR(anz),SIZE(anz),actual);
          ReadBytes (dat,ADR(breite),SIZE(breite),actual);
          ReadBytes (dat,ADR(hoehe),SIZE(hoehe),actual);
          ReadBytes (dat,ADR(tiefe),SIZE(tiefe),actual);
          IF NOT datfehler (dat) THEN
            Length (dat,err);  (* err=Länge *)
            IF err#( LONGINT(breite DIV 8)*hoehe*tiefe*anz+
                LONGINT(SHIFT(2,tiefe-1))*SIZE(INTEGER)+SIZE(header)+8 ) THEN
              fehler ("Falsches Format !","");
            ELSE
              nr:=2;
              IF anzfarben<SHIFT(nr,tiefe-1) THEN
                anzfarben:=SHIFT(nr,tiefe-1);
              END;
              farbInfo:=TRUE;
              weiter:=TRUE;
            END;
          END;
        ELSE
          fehler ("Falsches Format !","");
        END;  (* IF S.Compare *)
      END;  (* IF NOT datfehler *)
    END;  (* IF NOT datfehler *)
    Close (dat);
  END;  (* IF raw *)
  IF weiter THEN
    Lookup (dat,name,1024,FALSE);
    IF NOT datfehler (dat) THEN
      IF NOT raw THEN SetPos (dat,SIZE(header)+8); END;
      IF InitBit (copybit,5,breite,hoehe) THEN
        IF grenzen[2]-grenzen[1]+1<anz THEN
          IF NOT frage ("In Datei mehr Bilder","Alle laden ?") THEN
            anz:=grenzen[2]-grenzen[1]+1;
          END;
        END;
        nr:=grenzen[1]; anzahl:=1;
        REPEAT
          clear (nr);
          WITH copybit DO
            plane:=1;
            REPEAT
              ReadBytes (dat,planes[plane-1],RasSize(breite,hoehe),actual);
              INC (plane);
            UNTIL (dat.res#done) OR (plane>tiefe);
          END;
          err:=BltBitMap (ADR(copybit),0,0,
                          ADR(bilder^[nr]),0,0,breite,hoehe,192,255-16,NIL);
          INC (nr); INC (anzahl);
          IF nr>anzbilder THEN nr:=1; END;
        UNTIL (dat.res#done) OR (anzahl>anz);
        FreeBit (copybit);
        IF (NOT datfehler (dat)) AND farbInfo THEN
          farben:=ADR(Farben);
          Length (dat,err);  (* err=Länge *)
          anzahl:=SHIFT(2,tiefe-1);
          SetPos (dat,err-anzahl*SIZE(INTEGER));
          ReadBytes (dat,ADR(farben^[16]),anzahl*SIZE(INTEGER),actual);
          IF NOT datfehler (dat) THEN
            LoadRGB4 (ADR(myscreen^.viewPort),farben,anzahl+16);
          END;
        END;
      ELSE
        fehler ("Zu wenig Speicher !","");
      END;  (* IF InitBit *)
    END;  (* IF dat.res *)
    Close (dat);
  END;  (* IF weiter *)
END loadBob;

PROCEDURE load (name:str70;grenzen:Tgrenzen;VAR anzfarben:INTEGER);
VAR actual,help:LONGINT;
BEGIN
  Lookup (dat,name,0,FALSE);
  IF NOT datfehler (dat) THEN
    ReadBytes (dat,ADR(help),SIZE(help),actual);
    IF NOT datfehler (dat) THEN
      Close (dat);
      IF help=CAST(LONGINT,"FORM") THEN
        loadIff (name,grenzen[1],anzfarben);
      ELSIF help=CAST(LONGINT,"Bild") THEN   (* header="BildBobE" *)
        loadBob (name,grenzen,anzfarben,FALSE);
      ELSE
        loadBob (name,grenzen,anzfarben,TRUE);
      END;
    END;
  ELSE
    Close (dat);
  END;  (* IF NOT datfehler *)
END load;

PROCEDURE saveBob (name:str70;grenzen:Tgrenzen;anzfarben:INTEGER;raw:BOOLEAN);
VAR actual:LONGINT;
    nr,plane,tiefe,anz:INTEGER;
    farben:Tfarben;
    farb:ARRAY [1..16] OF INTEGER;
    comment:str70;
    error:LONGCARD;
    err:BOOLEAN;
BEGIN
  Lookup (dat,name,1024,TRUE);
  IF NOT datfehler (dat) THEN
    IF InitBit (copybit,5,xbreite,ybreite) THEN
      anz:=grenzen[2]-grenzen[1]+1;
      tiefe:=bin (anzfarben)-1;
      IF NOT raw THEN
        WriteBytes (dat,ADR(header),SIZE(header),actual);
        WriteBytes (dat,ADR(anz),SIZE(anz),actual);
        WriteBytes (dat,ADR(xbreite),SIZE(xbreite),actual);
        WriteBytes (dat,ADR(ybreite),SIZE(ybreite),actual);
        WriteBytes (dat,ADR(tiefe),SIZE(tiefe),actual);
      END;
      nr:=grenzen[1];
      REPEAT
        error:=BltBitMap (ADR(bilder^[nr]),0,0,
                        ADR(copybit),0,0,xbreite,ybreite,192,255-16,NIL);
        WITH copybit DO
          plane:=1;
          REPEAT
            WriteBytes (dat,planes[plane-1],RasSize(xbreite,ybreite),actual);
            INC (plane);
          UNTIL (dat.res#done) OR (plane>tiefe);
        END;
        INC (nr);
        err:=datfehler (dat);
      UNTIL err OR (nr>grenzen[2]);
      FreeBit (copybit);
      IF (NOT err) AND ( farbe OR (NOT raw) ) THEN
        getCol (farben);
        FOR nr:=1 TO anzfarben DO
          farb[nr]:=INTEGER(farben[nr+15,1]*256)+INTEGER(farben[nr+15,2])*16+
                    INTEGER(farben[nr+15,3]);
        END;
        WriteBytes (dat,ADR(farb),anzfarben*SIZE(INTEGER),actual);
        err:=datfehler (dat);
      END;
      IF NOT err THEN
        IF raw THEN
          comment:=commentStr;
          IF farbe THEN S.Concat (comment," , Farben"); END;
          comment[19]:=CHAR(anz DIV 10 + 48); comment[20]:=CHAR(anz MOD 10 + 48);
          comment[29]:=CHAR(xbreite DIV 10 + 48);
          comment[30]:=CHAR(xbreite MOD 10 + 48);
          comment[37]:=CHAR(ybreite DIV 10 + 48);
          comment[38]:=CHAR(ybreite MOD 10 + 48);
          comment[47]:=CHAR(tiefe MOD 10 + 48);
          IF NOT SetComment (ADR(name),ADR(comment)) THEN
            fehler ("Kommentar der Datei","nicht anzupassen !");
          END;
        END;  (* IF raw *)
        saveIcon (ADR(animIcon),ADR(name));
      END;
    ELSE
      fehler ("Zu wenig Speicher !","");
    END;  (* IF InitBit *)
  END;  (* IF NOt datfehler *)
  Close (dat);
END saveBob;

PROCEDURE WriteInt (zahl,len:INTEGER);
VAR str:str10;
    actual:LONGINT;
    err:BOOLEAN;
BEGIN
  ValToStr (zahl,FALSE,str,10,len," ",err);
  WriteBytes (dat,ADR(str),len,actual);
END WriteInt;

PROCEDURE WriteHex (zahl,len:CARDINAL);
VAR str:str10;
    actual:LONGINT;
    err:BOOLEAN;
BEGIN
  ValToStr (zahl,FALSE,str,16,len,"0",err);
  WriteBytes (dat,ADR(str),len,actual);
END WriteHex;

(*$ CopyDyn:=FALSE *)
PROCEDURE WriteStr (str:ARRAY OF CHAR);
VAR actual:LONGINT;
BEGIN
  WriteBytes (dat,ADR(str),S.Length(str),actual);
END WriteStr;

PROCEDURE WriteWert (spra:Tsprache;wert:CARDINAL);
BEGIN
  CASE spra OF
     modula,assem: WriteStr ("$");
                   WriteHex (wert,4);
    |c: WriteStr ("0x");
        WriteHex (wert,4);
    |modalt: WriteHex (wert,5);
             WriteStr ("H");
  END;
END WriteWert;

PROCEDURE saveFarb (spra:Tsprache;anzfarben:INTEGER);
VAR farben:Tfarben;
    nr:INTEGER;
    farb:ARRAY [1..16] OF INTEGER;
BEGIN
  getCol (farben);
  FOR nr:=1 TO anzfarben DO
    farb[nr]:=INTEGER(farben[nr+15,1]*256)+INTEGER(farben[nr+15,2])*16+
              INTEGER(farben[nr+15,3]);
  END;
  WriteStr ("\n");
  WriteStr (kstartT[spra]); WriteStr (" Farben"); WriteStr (kendT[spra]);
  WriteStr (startT[spra]);
  IF spra=assem THEN WriteStr ("DC.W ");
  ELSIF spra=c THEN WriteStr ("    "); END;
  FOR nr:=1 TO anzfarben DO
    WriteWert (spra,farb[nr]);
    IF (nr=8) AND (anzfarben#8) THEN
      IF spra#assem THEN WriteStr (","); END;
      WriteStr (zeileT[spra]);
    ELSE
      IF nr#anzfarben THEN WriteStr (", "); END;
    END;
  END;
  WriteStr ("\n");
  WriteStr (endT[spra]);
END saveFarb;

PROCEDURE saveSource (name:str70;grenzen:Tgrenzen;anzfarben,art:INTEGER);
VAR x,y,bildnr,nr,tiefe,anzPlanes:INTEGER;
    spra:Tsprache;
    actual:LONGINT;
    bild:POINTER TO ARRAY [1..48],[1..3] OF CARDINAL;
    str:str10;
BEGIN
  IF art>6 THEN DEC (art,6);
           ELSE DEC (art,5); END;
  spra:=Tsprache(art);
  Lookup (dat,name,1024,TRUE);
  IF NOT datfehler (dat) THEN
    anzPlanes:=bin (anzfarben)-1;
    WriteStr (kstartT[spra]);
    WriteStr (" Daten erstellt mit BobEdi V1.0"); WriteStr (kendT[spra]);
    WriteStr (kstartT[spra]);
    WriteStr (" Bilder:"); WriteInt (grenzen[2]-grenzen[1]+1,3);
    WriteStr ("  Breite:"); WriteInt (xbreite,3);
    WriteStr ("  Höhe:"); WriteInt (ybreite,3);
    WriteStr ("  Tiefe:"); WriteInt (anzPlanes,2);
    WriteStr (kendT[spra]);
    WriteStr (startT[spra]);
    bildnr:=grenzen[1];
    REPEAT
      WriteStr (kstartT[spra]);
      WriteStr (" Bild:"); WriteInt (bildnr-grenzen[1]+1,3);
      WriteStr (kendT[spra]);
      IF (spra=c) AND (grenzen[1]#grenzen[2]) THEN  (* mehrdimensional *)
        WriteStr ("  {\n");
      END;
      tiefe:=1;
      REPEAT
        IF spra=c THEN WriteStr ("  "); END;
        WriteStr (kstartT[spra]);
        WriteStr (" Plane:"); WriteInt (tiefe,2);
        S.Copy (str,kendT[spra]); str[S.Length(str)]:=0C;
        WriteStr (str);
        WriteStr (zeileT[spra]);
        bild:=bilder^[bildnr].planes[tiefe-1]; nr:=1;
        FOR y:=1 TO ybreite DO
          FOR x:=1 TO xbreite DIV 16 DO
            WriteWert (spra,bild^[y,x]);
            IF (y#ybreite) OR (x#xbreite DIV 16) THEN
              IF nr MOD 8=0 THEN        (* Zeilenende *)
                 IF spra#assem THEN WriteStr (","); END;
                 WriteStr (zeileT[spra]);
              ELSE
                WriteStr (", ");
              END;
            ELSE
              IF (spra=c) AND (grenzen[1]#grenzen[2])
                 AND (tiefe=anzPlanes) THEN           (* BildEnde *)
                WriteStr ("\n  }");
              END;
              IF (spra#assem) AND ((bildnr#grenzen[2]) OR (tiefe#anzPlanes))
                THEN WriteStr (","); END;
            END;
            INC (nr);
          END;  (* FOR x *)
        END;  (* FOR y *)
        WriteStr ("\n");
        INC (tiefe);
      UNTIL (dat.res#done) OR (tiefe>anzPlanes);
      INC (bildnr);
    UNTIL (dat.res#done) OR (bildnr>grenzen[2]);
    WriteStr (endT[spra]);
    IF NOT datfehler (dat) THEN
      IF farbe THEN saveFarb (spra,anzfarben); END;
      IF NOT datfehler (dat) THEN saveIcon (ADR(sourceIcon),ADR(name)); END;
    END;
  END;  (* IF NOT datfehler *)
  Close (dat);
END saveSource;

PROCEDURE saveSourceSp (name:str70;grenzen:Tgrenzen;anzfarben,art:INTEGER);
VAR x,y,bildnr,nr,tiefe,anzPlanes:INTEGER;
    spra:Tsprache;
    actual:LONGINT;
    bild:POINTER TO ARRAY [1..48],[1..3] OF CARDINAL;
    str:str10;
    weiter:BOOLEAN;
BEGIN
  IF art>6 THEN DEC (art,6);
           ELSE DEC (art,5); END;
  spra:=Tsprache(art);
  Lookup (dat,name,1024,TRUE);
  IF NOT datfehler (dat) THEN
    weiter:=TRUE;
    IF xbreite>16 THEN
      weiter:=frage ("Kann nur linke","16 Pixel saven !");
    END;
    IF weiter THEN
      anzPlanes:=bin (anzfarben)-1;
      WriteStr (kstartT[spra]);
      WriteStr (" Daten erstellt mit BobEdi V1.0"); WriteStr (kendT[spra]);
      WriteStr (kstartT[spra]);
      WriteStr (" Bilder:"); WriteInt (grenzen[2]-grenzen[1]+1,3);
      WriteStr ("  Breite:"); WriteInt (xbreite,3);
      WriteStr ("  Höhe:"); WriteInt (ybreite,3);
      WriteStr ("  Tiefe:"); WriteInt (anzPlanes,2);
      IF ODD(anzPlanes) THEN INC (anzPlanes); END;
      WriteStr (kendT[spra]);
      WriteStr (startT[spra]);
      bildnr:=grenzen[1];
      REPEAT
        tiefe:=1;
        REPEAT
          WriteStr (kstartT[spra]);
          WriteStr (" Bild:"); WriteInt (bildnr-grenzen[1]+1,3);
          IF anzPlanes=4 THEN
            IF tiefe=1 THEN WriteStr (".1");
                       ELSE WriteStr (".2"); END;
          END;
          WriteStr (kendT[spra]);
          IF (spra=c) AND (grenzen[1]#grenzen[2]) THEN (* mehrdimensional bei c *)
            WriteStr ("  {\n");
          END;
          WriteStr (kstartT[spra]);
          WriteStr (" Plane:"); WriteInt (tiefe,2);
          WriteStr ("     "); WriteInt (tiefe+1,2);
          S.Copy (str,kendT[spra]); str[S.Length(str)]:=0C; WriteStr (str);
          WriteStr (zeileT[spra]);
          WriteWert (spra,0); WriteStr (", ");
          IF tiefe=1 THEN WriteWert (spra,0);
                     ELSE WriteWert (spra,spriteAttached); END;
          IF spra#assem THEN WriteStr (","); END;
          WriteStr (zeileT[spra]);
          nr:=1;
          FOR y:=1 TO ybreite DO
            FOR x:=0 TO 1 DO
              bild:=bilder^[bildnr].planes[tiefe-1+x];
              WriteWert (spra,bild^[y,1]);
              IF nr MOD 2=0 THEN
                IF spra#assem THEN WriteStr (","); END;
                WriteStr (zeileT[spra]);
              ELSE
                WriteStr (", ");
              END;
              INC (nr);
            END;  (* FOR x *)
          END;  (* FOR y *)
          WriteWert (spra,0); WriteStr (", "); WriteWert (spra,0);
          IF (spra=c) AND (grenzen[1]#grenzen[2]) THEN     (* BildEnde *)
            WriteStr ("\n  }");
          END;
          IF (spra#assem) AND ((bildnr#grenzen[2]) OR (tiefe+1#anzPlanes)) THEN
            WriteStr (",");
          END;
          WriteStr ("\n");
          INC (tiefe,2);
        UNTIL (dat.res#done) OR (tiefe>anzPlanes);
        INC (bildnr);
      UNTIL (dat.res#done) OR (bildnr>grenzen[2]);
      WriteStr (endT[spra]);
      IF NOT datfehler (dat) THEN
        IF farbe THEN saveFarb (spra,anzfarben); END;
        IF NOT datfehler (dat) THEN saveIcon (ADR(sourceIcon),ADR(name)); END;
      END;
    END; (* IF weiter *)
  END;  (* IF NOT datfehler *)
  Close (dat);
END saveSourceSp;

PROCEDURE saveBas (name:str70;grenzen:Tgrenzen;anzfarben:INTEGER);
TYPE Theader=RECORD
              ColorSet,DataSet,Depth,Width,Height:LONGINT;
              flags,planePick,planeOnOff:INTEGER;
            END;
VAR actual:LONGINT;
    tiefe,XBreite,bildnr,plane,y:INTEGER;
    bild:POINTER TO ARRAY [1..48],[1..3] OF CARDINAL;
    farbWerte:Tfarben;
    farb:ARRAY [17..19] OF INTEGER;
    header:Theader;
    weiter:BOOLEAN;
    altname:str70;
BEGIN
  tiefe:=bin (anzfarben)-1;
  altname:=name;
  IF grenzen[1]#grenzen[2] THEN S.Concat (name,".00"); END;
  XBreite:=xbreite; weiter:=TRUE;
  getCol (farbWerte);
  IF sprite THEN
    farb[17]:=INTEGER(farbWerte[17,1]*256)+INTEGER(farbWerte[17,2])*16+
              INTEGER(farbWerte[17,3]);
    farb[18]:=INTEGER(farbWerte[18,1]*256)+INTEGER(farbWerte[18,2])*16+
              INTEGER(farbWerte[18,3]);
    farb[19]:=INTEGER(farbWerte[19,1]*256)+INTEGER(farbWerte[19,2])*16+
              INTEGER(farbWerte[19,3]);
    IF (tiefe>2) AND (XBreite>16) THEN
      weiter:=frage ("Kann nur 2 Bitplanes","und 16 Pixel saven !");
    ELSIF tiefe>2 THEN
      weiter:=frage ("Kann nur 2","Bitplanes saven !");
    ELSIF XBreite>16 THEN
      weiter:=frage ("Kann nur linke","16 Pixel saven !");
    END;
    tiefe:=2; XBreite:=16;
  END;
  IF weiter THEN
    WITH header DO
      ColorSet:=0; DataSet:=0;
      Depth:=tiefe; Width:=XBreite; Height:=ybreite;
      flags:=24+INTEGER(sprite);  (* SAVEBACK=8, OVERLAY=16 *)
      IF sprite THEN
        planePick:=3;
      ELSE
        planePick:=anzfarben-1;
      END;
      planeOnOff:=0;
    END;
    bildnr:=grenzen[1]-1;
    REPEAT
      INC (bildnr);
      IF grenzen[1]#grenzen[2] THEN
        name[S.Length(name)-1]:=CHAR(bildnr DIV 10+48);
        name[S.Length(name)]:=CHAR(bildnr MOD 10+48);
      END;
      Lookup (dat,name,1200,TRUE);
      IF dat.res=done THEN
        WriteBytes (dat,ADR(header),SIZE(header),actual);
        plane:=0;
        WHILE (dat.res=done) AND (plane<tiefe) DO
          y:=1; bild:=bilder^[bildnr].planes[plane];
          REPEAT
            WriteBytes (dat,ADR(bild^[y]),XBreite DIV 8,actual);
            INC (y);
          UNTIL (dat.res#done) OR (y>ybreite);
          INC (plane);
        END;  (* WHILE (dat.res *)
        IF (dat.res=done) AND sprite THEN
          WriteBytes (dat,ADR(farb[17]),2,actual);
          WriteBytes (dat,ADR(farb[18]),2,actual);
          WriteBytes (dat,ADR(farb[19]),2,actual);
        END;
      END;  (* IF dat.res *)
      IF dat.res=done THEN saveIcon (ADR(sourceIcon),ADR(name)); END;
      Close (dat);
    UNTIL (dat.res#done) OR (bildnr>=grenzen[2]);
    IF farbe AND (dat.res=done) THEN
      S.Concat (altname,".pal");
      Lookup (dat,altname,200,TRUE);
      IF dat.res=done THEN
        WriteBytes (dat,ADR(farbWerte),anzfarben*3,actual);
      END;
      IF dat.res=done THEN saveIcon (ADR(sourceIcon),ADR(altname));
                      ELSE fehler ("Konnte Farben nicht","saven !"); END;
      Close (dat);
    ELSIF dat.res#done THEN
      DEC (bildnr);
      IF bildnr<grenzen[1] THEN
        fehler ("Konnte keine Bilder","saven !");
      ELSIF bildnr=grenzen[1] THEN
        fehler ("Konnte nur 1 Bild","saven !");
      ELSE
        name:="Konnte nur  2";
        IF bildnr-grenzen[1]+1>0 THEN
          name[12]:=CHAR((bildnr-grenzen[1]+1) DIV 10+48);
        END;
        name[13]:=CHAR((bildnr-grenzen[1]+1) MOD 10+48);
        fehler (name,"Bilder saven !");
      END;
    END;  (* IF farben AND *)
  END;  (* IF weiter *)
END saveBas;

PROCEDURE disk (VAR name:str70;VAR grenzen:Tgrenzen;bildnr:INTEGER;
                VAR anzfarben:INTEGER);
VAR err:BOOLEAN;
    wahl,xpos,ypos:INTEGER;
    grenzgad:TgrenzG;
    ko:POINTER TO ARRAY [1..15],[1..4] OF INTEGER;
    text:ARRAY [1..13] OF CHAR;
    helpstr:str2;
    error:LONGCARD;

  PROCEDURE diskKords; (*$ EntryExitCode:=FALSE *)
  BEGIN
    ASSEMBLE ((* IFF    IFF            BobEdi         RAW *)
      DC.W 39,51,92,63, 135,44,188,56, 135,59,188,71, 135,74,188,86,
        (* Modula          Assem            Basic            C *)
           135,89,188,101, 135,104,188,116, 135,119,188,131, 135,134,188,146,
        (* ModAlt           Cancel          Sprite         Farben *)
           135,149,188,161, 86,173,139,185, 39,116,92,128, 39,131,92,143,
        (* Icon           Load (ganz)  Save (ganz) *)
           39,146,92,158, 36,35,95,68, 132,28,191,166
    END);
  END diskKords;

BEGIN
  box (1,1,maxbreite+1,maxbreite+1,3);
  box (2,2,maxbreite,maxbreite,4);
  SetAPen (rp,2);
  RectFill (rp,3,3,maxbreite-1,maxbreite-1);
  SetAPen (rp,0);
  ko:=ADR(diskKords);
  RectFill (rp,66,78,90,86);
  RectFill (rp,66,99,90,107);
  ValToStr (grenzen[1],TRUE,helpstr,10,-2,0C,err);
  grenzgad[1]:=CreateStrGadget (1,67,78,24,8,3,autoBorder,stdGadg,stdActv,
                                helpstr,grenzen[1],mywin);
  ValToStr (grenzen[2],TRUE,helpstr,10,-2,0C,err);
  grenzgad[2]:=CreateStrGadget (2,67,99,24,8,3,autoBorder,stdGadg,stdActv,
                                helpstr,grenzen[2],mywin);
  RefreshGadgets (grenzgad[1],mywin,NIL);
  Print (1,39,84,3,ADR("von"));
  Print (1,39,105,3,ADR("bis"));
  rahmen (36,73,95,111,FALSE);
  FOR xpos:=1 TO 15 DO
    rahmen (ko^[xpos,1],ko^[xpos,2],ko^[xpos,3],ko^[xpos,4],FALSE);
  END;
  rahmen (ko^[11,1],ko^[11,2],ko^[11,3],ko^[11,4],sprite);
  rahmen (ko^[12,1],ko^[12,2],ko^[12,3],ko^[12,4],farbe);
  rahmen (ko^[13,1],ko^[13,2],ko^[13,3],ko^[13,4],SIcon);
  Print (1,ko^[1,1]+7,ko^[1,4]-3,5,ADR("I/B/R"));
  Print (1,ko^[2,1]+7,ko^[2,4]-3,5,ADR(" IFF "));
  Print (1,ko^[3,1]+3,ko^[3,4]-3,6,ADR("BobEdi"));
  Print (1,ko^[4,1]+7,ko^[4,4]-3,5,ADR(" RAW "));
  Print (1,ko^[5,1]+3,ko^[5,4]-3,6,ADR("Modula"));
  Print (1,ko^[6,1]+7,ko^[6,4]-3,5,ADR("Assem"));
  Print (1,ko^[7,1]+7,ko^[7,4]-3,5,ADR("Basic"));
  Print (1,ko^[8,1]+7,ko^[8,4]-3,5,ADR("  C  "));
  Print (1,ko^[9,1]+3,ko^[9,4]-3,6,ADR("ModAlt"));
  Print (1,ko^[10,1]+3,ko^[10,4]-3,6,ADR("Cancel"));
  Print (1,ko^[11,1]+3,ko^[11,4]-3,6,ADR("Sprite"));
  Print (1,ko^[12,1]+3,ko^[12,4]-3,6,ADR("Farben"));
  Print (1,ko^[13,1]+3,ko^[13,4]-3,6,ADR(" Icon "));
  Print (1,ko^[14,1]+5,ko^[14,2]+10,6,ADR(" Load "));
  Print (1,ko^[15,1]+5,ko^[15,2]+10,6,ADR(" Save "));
  ModifyIDCMP (mywin,IDCMPFlagSet{mouseButtons,gadgetUp});
  err:=ActivateGadget (grenzgad[1],mywin,NIL);
  wahl:=0;
  REPEAT
    GetIMes (mywin,imes,TRUE);
    IF gadgetUp IN imes.class THEN
      checkgads (grenzgad,grenzen,FALSE);
      err:=ActivateGadget (grenzgad[2-INTEGER(imes.iAddress=grenzgad[2])],
                           mywin,NIL);
    ELSIF (mouseButtons IN imes.class) AND (imes.code=selectDown) THEN
      xpos:=imes.mouseX; ypos:=imes.mouseY;
      wahl:=0;
      REPEAT
        INC (wahl);
      UNTIL (wahl>13) OR ((xpos>=ko^[wahl,1]) AND (ypos>=ko^[wahl,2]) AND
                         (xpos<=ko^[wahl,3]) AND (ypos<=ko^[wahl,4]));
      IF wahl<11 THEN
        rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],TRUE);
      ELSIF wahl=11 THEN
        sprite:=NOT sprite;
        rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],sprite);
      ELSIF wahl=12 THEN
        farbe:=NOT farbe;
        rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],farbe);
      ELSIF wahl=13 THEN
        SIcon:=NOT SIcon;
        rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],SIcon);
      END;
    END;  (* IF gadgetUp *)
  UNTIL (wahl>0) AND (wahl<11);
  checkgads (grenzgad,grenzen,FALSE);
  IF wahl<10 THEN
    IF grenzen[1]=grenzen[2] THEN text:="Bild ";
                             ELSE text:="Bilder "; END;
    IF wahl>1 THEN S.Concat (text,"saven");
              ELSE S.Concat (text,"laden"); END;
    IF FileReq (name,mywin,text,10,-1,FALSE) THEN
      CASE wahl OF
        |1: load (name,grenzen,anzfarben);
        |2: saveiff (name,grenzen,anzfarben);
        |3: saveBob (name,grenzen,anzfarben,FALSE);
        |4: saveBob (name,grenzen,anzfarben,TRUE);
        |5..6,8..9:
            IF sprite THEN saveSourceSp (name,grenzen,anzfarben,wahl);
                      ELSE saveSource (name,grenzen,anzfarben,wahl); END;
        |7: saveBas (name,grenzen,anzfarben);
      END;
      error:=BltBitMap (ADR(bilder^[bildnr]),0,0,rp^.bitMap,
                        kleinx,kleiny+11,xbreite,ybreite,192,255,NIL);
    END;
  END;
  ModifyIDCMP (mywin,IDCMPFlagSet{mouseButtons});
  xpos:=RemoveGadget (mywin,grenzgad[1]);
  xpos:=RemoveGadget (mywin,grenzgad[2]);
  SetAPen (rp,2);
  RectFill (rp,1,1,maxbreite+1,maxbreite+1);
  FOR xpos:=16 TO anzfarben+15 DO
    SetAPen (rp,xpos);
    RectFill (rp,xpos*14-221,228,xpos*14-211,240);
  END;
  lupe;
END disk;

BEGIN
  Flock:=NIL;
  sprite:=FALSE; farbe:=FALSE; SIcon:=TRUE;
  startT[modula]:="  ASSEMBLE (\n    DC.W ";
  startT[assem]:=""; startT[c]:="{\n"; startT[modalt]:="  INLINE (";
  endT[modula]:="  END);\n"; endT[assem]:="";
  endT[c]:="};\n";           endT[modalt]:="  );\n";
  zeileT[modula]:="\n         "; zeileT[assem]:="\nDC.W ";
  zeileT[c]:="\n    ";           zeileT[modalt]:="\n          ";
  kstartT[modula]:="  (*"; kstartT[assem]:=";";
  kstartT[c]:="/*";        kstartT[modalt]:="  (*";
  kendT[modula]:=" *)\n"; kendT[assem]:="\n";
  kendT[c]:=" */\n";      kendT[modalt]:=" *)\n";
CLOSE
  IF Flock#NIL THEN UnLock (Flock); Flock:=NIL; END;
  FreeBit (copybit);
END BobDisk.