(*---------------------------------------------------------------------------
  :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.3 [Christian Stiens]
  :Imports.    ReqTFileReq, BobHelp, InitBMap [Frank Lömker], IFFLib [fbs]
  :History.    V1.0, [Frank Lömker] 26-Dez-91
  :History.    V2.0, [Frank Lömker] 06-Jul-92 erweitert
  :Bugs.       keine bekannt
---------------------------------------------------------------------------*)

IMPLEMENTATION MODULE BobDisk;

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

FROM ExecL IMPORT RawDoFmt;
FROM IntuitionD IMPORT GadgetPtr,ScreenPtr,WindowPtr,IntuiMessage,
      WindowFlagSet,WindowFlags,IDCMPFlagSet,IDCMPFlags,selectDown;
FROM IntuitionL IMPORT CloseWindow,ModifyIDCMP,RefreshGadgets,RemoveGadget,
      CloseScreen,ActivateGadget,ScreenToBack;
FROM GraphicsD IMPORT BitMap,RastPortPtr,ViewModeSet,ViewModes,DrawModeSet,
      DrawModes,spriteAttached,ColorMapPtr;
FROM GraphicsL IMPORT SetAPen,RectFill,BltBitMap,SetRGB4,LoadRGB4,
      BltClear,SetDrMd,GetRGB4;
FROM GfxMacros IMPORT RasSize;
FROM DosD IMPORT FileLockPtr,accessRead,FileInfoBlock;
FROM DosL IMPORT SetComment,Lock,UnLock,Examine,CurrentDir;
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,FirstPos *)
FROM FileSystem IMPORT File,Lookup,Close,Response,WriteBytes,ReadBytes,
      SetPos,Length;
FROM IntuiSupport IMPORT CreateScreen,autoFont,CreateWindow,GetIMes,
      CreateStrGadget,autoBord3D,stdGadg,stdActv;
FROM ReqTFileReq IMPORT FileReq;
FROM IFFLib IMPORT OpenIFF,CloseIFF,GetBMHD,BitMapHeaderPtr,BitMapHeader,
      GetColorMap,DecodePic,IffError,SaveClip,SaveIFFFlagSet,SaveIFFFlags,
      GetViewModes;
FROM BobHelp IMPORT maxbreite,MaxX,MaxY,Tfarben,Tgrenzen,TgrenzG,str70,str10,
      str2,myscreen,rp,mywin,bilder,anzbilder,kleinx,kleiny,xbreite,ybreite,
      helpbit,Farben,box,Print,PrintHot,rahmen,gadget,bin,fehler,frage,getCol,
      lupe,checkgads,datfehler,zeigdatf;
FROM InitBMap IMPORT FreeBit,InitBit;

CONST header="BildBobE";
      sourceIcon="source.icon";
      animIcon="anim.icon";
      commentStr="BobEdi 2.0 Bilder:22 Breite:32 Höhe:32 Planes:4";
TYPE Tsprache=(modula,oberon,assem,c,modalt);
VAR imes:IntuiMessage;
    endT,zeileT,kstartT,kendT:ARRAY [modula..modalt],[1..15] OF CHAR;
    startT:ARRAY [modula..modalt],[1..30] OF CHAR;
    startDat,startFarb:ARRAY [modula..modalt],[1..60] OF CHAR;
    bildscr:ScreenPtr;
    bildwin:WindowPtr;
    dat:File;
    Flock,startLock:FileLockPtr;
    copybit:BitMap;
    SIcon,farbe,sprite:BOOLEAN;
    info:FileInfoBlock;

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;

(*$ CopyDyn:=FALSE *)
PROCEDURE overwrite(name:str70):BOOLEAN;
VAR weiter:BOOLEAN;
BEGIN
  weiter:=TRUE;
  Flock:=Lock (ADR(name),accessRead);
  IF Flock#NIL THEN
    IF Examine (Flock,ADR(info)) THEN
      IF (info.dirEntryType<=0) AND (info.size>0) THEN
        weiter:=frage ("Datei existiert !","Überschreiben ?");
      END;
    END;  (* IF Examine *)
    UnLock (Flock); Flock:=NIL;
  END;  (* IF Flock#NIL *)
  RETURN weiter;
END overwrite;

PROCEDURE getCol2 (VAR farben:Tfarben;cmap:ColorMapPtr);
VAR nr:INTEGER;
    rgb:LONGCARD;
BEGIN
  FOR nr:=0 TO cmap^.count-1 DO
    rgb:=GetRGB4 (cmap,nr);
    farben[nr,1]:=SHIFT (rgb,-8);
    farben[nr,2]:=SHIFT(SHIFT(rgb,24),-28);
    farben[nr,3]:=SHIFT(SHIFT(rgb,28),-28);
  END;
END getCol2;

PROCEDURE saveIcon (IconN,name:ADDRESS);
VAR icon:DiskObjectPtr;
    altLock:FileLockPtr;
BEGIN
  IF SIcon THEN
    altLock:=CurrentDir (startLock);
    icon:=NIL;
    icon:=GetDiskObject (IconN);
    altLock:=CurrentDir (altLock);
    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 anzfarb:INTEGER);
VAR datei:ADDRESS;
    mybmhd:BitMapHeaderPtr;
    farb:ARRAY [0..31] OF INTEGER;
    anz,x,y:INTEGER;
    err:LONGINT;
    nr:CARDINAL;
    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<=MaxX) AND (mybmhd^.h<=MaxY) THEN
          clear (bildnr);
          IF DecodePic (datei,ADR(helpbit)) THEN
            err:=BltBitMap (ADR(helpbit),0,0,ADR(bilder^[bildnr]),
                            0,0,mybmhd^.w,mybmhd^.h,192,255-16,NIL);
            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<MaxY THEN nr:=MaxY
                            ELSE nr:=mybmhd^.h; END;
          bildscr:=CreateScreen (NIL,x,nr+CARDINAL(y),mybmhd^.nPlanes,viewm,
                                 autoFont);
          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+MaxX-1,y+MaxY-1,1);
                  GetIMes (bildwin,imes,TRUE);
                  box (x,y,x+MaxX-1,y+MaxY-1,1);
                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)+MaxX>mybmhd^.w THEN x:=INTEGER(mybmhd^.w)-MaxX; END;
                  IF CARDINAL(y)+MaxY>mybmhd^.h THEN y:=INTEGER(mybmhd^.h)-MaxY; 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,MaxX,MaxY,192,255-16,NIL);
                END;
                CloseWindow (bildwin); bildwin:=NIL;
                CloseScreen (bildscr); bildscr:=NIL;
              ELSE
                CloseWindow (bildwin); bildwin:=NIL;
                CloseScreen (bildscr); bildscr:=NIL;
                fehler ("Bild nicht zu","entpacken !");
              END;  (* If DecodePic *)
            ELSE
              CloseScreen (bildscr); bildscr:=NIL;
              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>anzfarb THEN anzfarb:=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;anzfarb:INTEGER);
VAR nr,tiefe:INTEGER;
    ok:BOOLEAN;
    farben:ADDRESS;
BEGIN
  tiefe:=bin (anzfarb)-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");
    name[S.Length(name)-1]:=CHAR(grenzen[1] DIV 10+48);
    name[S.Length(name)]:=CHAR(grenzen[1] MOD 10+48);
  END;
  IF overwrite (name) THEN
    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;  (* IF NOT ok *)
  END;  (* IF overwrite *)
END saveiff;

PROCEDURE loadBob (name:str70;grenzen:Tgrenzen;VAR anzfarb: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 (anzfarb<SHIFT(nr,tiefe-1)) THEN
              anzfarb:=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 anzfarb<SHIFT(nr,tiefe-1) THEN
                anzfarb:=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 anzfarb: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],anzfarb);
      ELSIF help=CAST(LONGINT,"Bild") THEN   (* header="BildBobE" *)
        loadBob (name,grenzen,anzfarb,FALSE);
      ELSE
        loadBob (name,grenzen,anzfarb,TRUE);
      END;
    ELSE
      Close (dat);
    END;
  ELSE
    Close (dat);
  END;  (* IF NOT datfehler *)
END load;

PROCEDURE saveBob (name:str70;grenzen:Tgrenzen;anzfarb: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
  IF overwrite (name) THEN
    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 (anzfarb)-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 anzfarb 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),anzfarb*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;  (* IF overwrite *)
END saveBob;

PROCEDURE PutChar; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE ( MOVE.B D0,(A3)+
             RTS
             END );
END PutChar;

(*$ CopyDyn:=FALSE *)
PROCEDURE Printf (str:ARRAY OF CHAR;z2,z1:INTEGER);
VAR actual:LONGINT;
    res:str70;
BEGIN
  RawDoFmt (ADR(str),ADR(z1),ADR(PutChar),ADR(res));
  WriteBytes (dat,ADR(res),S.Length(res),actual);
END Printf;

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);
    |oberon: WriteHex (wert,5);
             WriteStr ("U");
    |c: WriteStr ("0x");
        WriteHex (wert,4);
    |modalt: WriteHex (wert,5);
             WriteStr ("H");
  END;
END WriteWert;

PROCEDURE saveFarb (spra:Tsprache;anzfarb:INTEGER;cmap:ColorMapPtr);
VAR farben:Tfarben;
    nr,df:INTEGER;
    farb:ARRAY [1..32] OF INTEGER;
BEGIN
  df:=-1;
  IF cmap=NIL THEN getCol (farben); df:=15;
              ELSE getCol2 (farben,cmap); END;
  IF anzfarb>32 THEN anzfarb:=32; END;
  FOR nr:=1 TO anzfarb DO
    farb[nr]:=INTEGER(farben[nr+df,1]*256)+INTEGER(farben[nr+df,2])*16+
              INTEGER(farben[nr+df,3]);
  END;
  WriteStr ("\n");
  Printf (startFarb[spra],0,anzfarb); WriteStr (startT[spra]);
  IF spra=oberon THEN WriteStr ("        ");
  ELSIF spra=assem THEN WriteStr (" DC.W ");
  ELSIF spra=c THEN WriteStr ("    "); END;
  FOR nr:=1 TO anzfarb DO
    WriteWert (spra,farb[nr]);
    IF (nr MOD 8=0) AND (anzfarb#nr) THEN
      IF spra#assem THEN WriteStr (","); END;
      WriteStr (zeileT[spra]);
    ELSE
      IF nr#anzfarb THEN WriteStr (", "); END;
    END;
  END;
  WriteStr ("\n");
  WriteStr (endT[spra]);
  IF (spra=modula) OR (spra=modalt) THEN WriteStr("Farben;\n"); END;
END saveFarb;

PROCEDURE saveSource (name:str70;grenzen:Tgrenzen;
                      anzfarb,anzPlanes,art:INTEGER;cmap:ColorMapPtr);
VAR x,y,bildnr,nr,tiefe:INTEGER;
    spra:Tsprache;
    actual,offset:LONGINT;
    bild:POINTER TO ARRAY [1..500000] OF CARDINAL;
    str:str10;
BEGIN
  IF art>7 THEN DEC (art,6);
           ELSE DEC (art,5); END;
  spra:=Tsprache(art);
  Lookup (dat,name,1024,TRUE);
  IF NOT datfehler (dat) THEN
    bildnr:=grenzen[2]-grenzen[1]+1;
    WriteStr (kstartT[spra]);
    WriteStr (" Daten erstellt mit BobEdi V2.0"); WriteStr (kendT[spra]);
    WriteStr ("\n");
    WriteStr (kstartT[spra]);
    Printf (" Bilder: %d  Breite: %d",xbreite,bildnr);
    Printf ("  Höhe: %d  Tiefe: %d",anzPlanes,ybreite);
    WriteStr (kendT[spra]);
    INC (xbreite,15);
    IF (spra=modula) OR (spra=modalt) THEN
     IF bildnr>1 THEN
       Printf ("TYPE DatenPtr=POINTER TO ARRAY [1..%d],[1..%d] OF INTEGER;\n",
               anzPlanes*ybreite*(xbreite DIV 16),bildnr);
     ELSE
       Printf ("TYPE DatenPtr=POINTER TO ARRAY [1..%d] OF INTEGER;\n",
               1,anzPlanes*ybreite*(xbreite DIV 16));
     END;
    END;
    IF (spra=c) AND (bildnr>1) THEN
      Printf ("UWORD Daten[%d][%d]",anzPlanes*ybreite*(xbreite DIV 16),bildnr);
    ELSIF (spra=oberon) AND (bildnr>1) THEN
      Printf ("TYPE DatArray=ARRAY %d,%d OF INTEGER;\n"+
              "CONST Daten=DatArray",anzPlanes*ybreite*(xbreite DIV 16),bildnr);
    ELSE
      Printf (startDat[spra],1,anzPlanes*ybreite*(xbreite DIV 16));
    END;
    WriteStr (startT[spra]);
    str:="";
    S.Copy (str,kendT[spra]); str[S.Length(str)]:=0C;
    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]);
        Printf (" Plane: %d",0,tiefe);
        WriteStr (str);
        WriteStr (zeileT[spra]);
        bild:=bilder^[bildnr].planes[tiefe-1]; nr:=1;
        offset:=0;
        FOR y:=1 TO ybreite DO
          FOR x:=1 TO xbreite DIV 16 DO
            WriteWert (spra,bild^[x+offset]);
            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 *)
          INC (offset,(bilder^[bildnr].bytesPerRow) DIV 2);
        END;  (* FOR y *)
        WriteStr ("\n");
        INC (tiefe);
      UNTIL (dat.res#done) OR (tiefe>anzPlanes);
      INC (bildnr);
    UNTIL (dat.res#done) OR (bildnr>grenzen[2]);
    DEC (xbreite,15);
    WriteStr (endT[spra]);
    IF (spra=modula) OR (spra=modalt) THEN WriteStr("Daten;\n"); END;
    IF NOT datfehler (dat) THEN
      IF farbe THEN saveFarb (spra,anzfarb,cmap); 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;
                        anzfarb,anzPlanes,art:INTEGER;cmap:ColorMapPtr);
VAR x,y,bildnr,nr,tiefe:INTEGER;
    spra:Tsprache;
    actual,offset:LONGINT;
    bild:POINTER TO ARRAY [1..500000] OF CARDINAL;
    str:str10;
    weiter:BOOLEAN;
BEGIN
  IF art>7 THEN DEC (art,6);
           ELSE DEC (art,5); END;
  spra:=Tsprache(art);
  weiter:=TRUE;
  IF (anzPlanes>4) AND (xbreite>16) THEN
    weiter:=frage ("Kann nur 4 Bitplanes","und 16 Pixel saven !");
  ELSIF anzPlanes>4 THEN
    weiter:=frage ("Kann nur 4","Bitplanes saven !");
  ELSIF xbreite>16 THEN
    weiter:=frage ("Kann nur linke","16 Pixel saven !");
  END;
  IF weiter THEN
    Lookup (dat,name,1024,TRUE);
    IF NOT datfehler (dat) THEN
      IF anzPlanes>4 THEN anzPlanes:=4; END;
      bildnr:=grenzen[2]-grenzen[1]+1;
      WriteStr (kstartT[spra]);
      WriteStr (" Daten erstellt mit BobEdi V2.0"); WriteStr (kendT[spra]);
      WriteStr ("\n");
      WriteStr (kstartT[spra]);
      Printf (" Bilder: %d  Breite: %d",16,bildnr);
      Printf ("  Höhe: %d  Tiefe: %d",anzPlanes,ybreite);
      IF ODD(anzPlanes) THEN INC (anzPlanes); END;
      WriteStr (kendT[spra]);
      bildnr:=bildnr*anzPlanes DIV 2;
      IF (spra=modula) OR (spra=modalt) THEN
       IF bildnr>1 THEN
         Printf ("TYPE DatenPtr=POINTER TO ARRAY [1..%d],[1..%d] OF INTEGER;\n",
                 2*ybreite+4,bildnr);
       ELSE
         Printf ("TYPE DatenPtr=POINTER TO ARRAY [1..%d] OF INTEGER;\n",
                 1,2*ybreite+4);
       END;
      END;
      IF (spra=c) AND (bildnr>1) THEN
        Printf ("UWORD Daten[%d][%d]",2*ybreite+4,bildnr);
      ELSIF (spra=oberon) AND (bildnr>1) THEN
        Printf ("TYPE DatArray=ARRAY %d,%d OF INTEGER;\n"+
                "CONST Daten=DatArray",2*ybreite+4,bildnr);
      ELSE
        Printf (startDat[spra],1,2*ybreite+4);
      END;
      WriteStr (startT[spra]);
      str:=""; S.Copy (str,kendT[spra]); str[S.Length(str)]:=0C;
      bildnr:=grenzen[1];
      REPEAT
        tiefe:=1;
        REPEAT
          WriteStr (kstartT[spra]);
          Printf (" Bild: %2d",0,bildnr-grenzen[1]+1);
          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]) OR (anzPlanes=4)) THEN
            WriteStr ("  {\n");              (* mehrdimensional bei c *)
          END;
          WriteStr (kstartT[spra]);
          Printf   (" Plane: %d     %d",tiefe+1,tiefe);
          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; offset:=1;
          FOR y:=1 TO ybreite DO
            FOR x:=0 TO 1 DO
              bild:=bilder^[bildnr].planes[tiefe-1+x];
              WriteWert (spra,bild^[offset]);
              IF nr MOD 2=0 THEN
                IF spra#assem THEN WriteStr (","); END;
                WriteStr (zeileT[spra]);
              ELSE
                WriteStr (", ");
              END;
              INC (nr);
            END;  (* FOR x *)
            INC (offset,(bilder^[bildnr].bytesPerRow) DIV 2);
          END;  (* FOR y *)
          WriteWert (spra,0); WriteStr (", "); WriteWert (spra,0);
          IF (spra=c) AND ((grenzen[1]#grenzen[2]) OR (anzPlanes=4)) THEN
            WriteStr ("\n  }");                 (* BildEnde *)
          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 (spra=modula) OR (spra=modalt) THEN WriteStr("Daten;\n"); END;
      IF NOT datfehler (dat) THEN
        IF anzfarb>16 THEN anzfarb:=16; END;
        IF farbe THEN saveFarb (spra,anzfarb,cmap); END;
        IF NOT datfehler (dat) THEN saveIcon (ADR(sourceIcon),ADR(name)); END;
      END;
    END;  (* IF NOT datfehler *)
    Close (dat);
  END; (* IF weiter *)
END saveSourceSp;

PROCEDURE saveBas (name:str70;grenzen:Tgrenzen;anzfarb,anzPlanes:INTEGER;
                   cmap:ColorMapPtr);
TYPE Theader=RECORD
              ColorSet,DataSet,Depth,Width,Height:LONGINT;
              flags,planePick,planeOnOff:INTEGER;
            END;
VAR actual,offset:LONGINT;
    XBreite,bildnr,plane:INTEGER;
    y:LONGINT;
    bild:POINTER TO ARRAY [1..500000] OF CARDINAL;
    farbWerte:Tfarben;
    farb:ARRAY [1..3] OF INTEGER;
    header:Theader;
    weiter:BOOLEAN;
    altname:str70;
BEGIN
  altname:=name;
  IF grenzen[1]#grenzen[2] THEN
    S.Concat (name,".00");
    name[S.Length(name)-1]:=CHAR(grenzen[1] DIV 10+48);
    name[S.Length(name)]:=CHAR(grenzen[1] MOD 10+48);
  END;
  XBreite:=xbreite; weiter:=TRUE; y:=0;
  IF cmap=NIL THEN getCol (farbWerte); y:=16;
              ELSE getCol2 (farbWerte,cmap); END;
  weiter:=overwrite(name);
  IF sprite AND weiter THEN
    farb[1]:=INTEGER(farbWerte[1+y,1]*256)+INTEGER(farbWerte[1+y,2])*16+
              INTEGER(farbWerte[1+y,3]);
    farb[2]:=INTEGER(farbWerte[2+y,1]*256)+INTEGER(farbWerte[2+y,2])*16+
              INTEGER(farbWerte[2+y,3]);
    farb[3]:=INTEGER(farbWerte[3+y,1]*256)+INTEGER(farbWerte[3+y,2])*16+
              INTEGER(farbWerte[3+y,3]);
    IF (anzPlanes>2) AND (XBreite>16) THEN
      weiter:=frage ("Kann nur 2 Bitplanes","und 16 Pixel saven !");
    ELSIF anzPlanes>2 THEN
      weiter:=frage ("Kann nur 2","Bitplanes saven !");
    ELSIF XBreite>16 THEN
      weiter:=frage ("Kann nur linke","16 Pixel saven !");
    END;
    anzPlanes:=2; XBreite:=16;
  END;
  y:=( (LONGINT(XBreite)+15) DIV 16 * 2) *LONGINT(ybreite)*LONGINT(anzPlanes);
  IF weiter AND (SIZE(header)+y>32568) THEN
    weiter:=frage ("Datei über 32 Kbyte","lang ! Weiter ?");
  END;
  IF weiter THEN
    WITH header DO
      ColorSet:=0; DataSet:=0;
      Depth:=anzPlanes; Width:=XBreite; Height:=ybreite;
      flags:=24+INTEGER(sprite);  (* SAVEBACK=8, OVERLAY=16 *)
      IF sprite THEN
        planePick:=3;
      ELSE
        planePick:=anzfarb-1;
      END;
      planeOnOff:=0;
    END;
    bildnr:=grenzen[1]-1;
    XBreite:=(XBreite+15) DIV 16 * 2;
    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<anzPlanes) DO
          y:=1; bild:=bilder^[bildnr].planes[plane];
          offset:=1;
          REPEAT
            WriteBytes (dat,ADR(bild^[offset]),XBreite,actual);
            INC (offset,(bilder^[bildnr].bytesPerRow) DIV 2);
            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[1]),2,actual);
          WriteBytes (dat,ADR(farb[2]),2,actual);
          WriteBytes (dat,ADR(farb[3]),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
        IF anzfarb>32 THEN anzfarb:=32; END;
        IF cmap=NIL THEN y:=16;
                    ELSE y:=0; END;
        WriteBytes (dat,ADR(farbWerte[y]),anzfarb*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 saveRaw (name:str70;VAR bitmap:BitMap;anzfarb,tiefe:INTEGER;
                   cmap:ColorMapPtr);
VAR err:BOOLEAN;
    plane:INTEGER;
    actual:LONGINT;
BEGIN
  IF overwrite (name) THEN
    Lookup (dat,name,1024,TRUE);
    IF NOT datfehler (dat) THEN
      WITH bitmap DO
        plane:=1;
        REPEAT
          WriteBytes (dat,planes[plane-1],RasSize(xbreite,ybreite),actual);
          INC (plane);
        UNTIL (dat.res#done) OR (plane>tiefe);
      END;
      err:=datfehler (dat);
      IF NOT err THEN
        IF farbe THEN
          IF anzfarb>32 THEN anzfarb:=32; END;
          WriteBytes (dat,cmap^.colorTable,anzfarb*SIZE(INTEGER),actual);
          err:=datfehler (dat);
        END;
        IF NOT err THEN
          saveIcon (ADR(animIcon),ADR(name));
        END;
      END;
    END;  (* IF NOT datfehler *)
    Close (dat);
  END;  (* IF overwrite *)
END saveRaw;

PROCEDURE Convert (VAR name:str70;art:INTEGER);
VAR datei:ADDRESS;
    bmap:BitMapHeaderPtr;
    viewm:ViewModeSet;
    farben:ARRAY [0..63] OF CARDINAL;
    grenzen:Tgrenzen;
    anz,breite,hoehe,tiefe:INTEGER;
    altBit:BitMap;
BEGIN
  IF FileReq (name,mywin,"Source File (IFF)",10,20,"") THEN
    datei:=OpenIFF (ADR(name));
    IF (IffError()=0) AND (datei#NIL) THEN
      bmap:=GetBMHD (datei);
      IF (IffError()=0) AND (bmap#NIL) AND (bmap^.nPlanes>0)
                                       AND (bmap^.nPlanes<7) THEN
        anz:=GetColorMap (datei,ADR(farben));
        IF anz>0 THEN
          breite:=bmap^.w; hoehe:=bmap^.h;
          IF art#4 THEN               (* Save Raw *)
            IF breite<320 THEN breite:=320; END;
          END;
          tiefe:=bmap^.nPlanes;
          IF (art#4) AND sprite THEN
            IF (art=8) AND (tiefe<2) THEN  (* Basic *)
              tiefe:=2;
            ELSIF (art#8) AND ( (tiefe=1) OR (tiefe=3) ) THEN
              INC (tiefe);
            END;
          END;
          viewm:=GetViewModes(datei);
          bildscr:=CreateScreen (NIL,breite,hoehe,tiefe,viewm,autoFont);
          IF bildscr#NIL THEN
            tiefe:=anz;
            IF tiefe>32 THEN tiefe:=32; END;
            LoadRGB4 (ADR(bildscr^.viewPort),ADR(farben),tiefe);
            IF DecodePic (datei,bildscr^.rastPort.bitMap) THEN
              ScreenToBack (bildscr);
              IF FileReq (name,mywin,"Destination File",10,20,"") THEN
                grenzen[1]:=1; grenzen[2]:=1;
                altBit:=bilder^[1];
                breite:=xbreite; hoehe:=ybreite;
                bilder^[1]:=bildscr^.rastPort.bitMap^;
                xbreite:=bmap^.w; ybreite:=bmap^.h;
                tiefe:=bmap^.nPlanes;
                CASE art OF
                   4: saveRaw (name,bildscr^.bitMap,anz,tiefe,
                               bildscr^.viewPort.colorMap);
                  |5..7,9..10:
                      IF overwrite (name) THEN
                        IF sprite THEN
                          saveSourceSp (name,grenzen,anz,tiefe,art,
                                        bildscr^.viewPort.colorMap);
                        ELSE
                          saveSource (name,grenzen,anz,tiefe,art,
                                      bildscr^.viewPort.colorMap);
                        END;
                      END;
                  |8: saveBas (name,grenzen,anz,tiefe,
                               bildscr^.viewPort.colorMap);
                END;
                bilder^[1]:=altBit;
                xbreite:=breite; ybreite:=hoehe;
              END;  (* IF FileReq *)
              CloseScreen (bildscr); bildscr:=NIL
            ELSE
              CloseScreen (bildscr); bildscr:=NIL;
              fehler ("Bild nicht zu","entpacken !");
            END;  (* If DecodePic *)
          ELSE
            fehler ("Screen ist nicht","zu öffnen !");
          END;  (* IF bildscr *)
        ELSE
          fehler ("ColorMap nicht","zu finden !");
        END;  (* IF anz>0 *)
      ELSE
        fehler ("BitMapHeader nicht","zu finden !");
      END;  (* IF iffError *)
    ELSE
      fehler ("Fehler beim Öffnen","der IFF-Datei !");
    END;  (* IF iffError *)
    CloseIFF (datei);
  END;  (* IF FileReq *)
END Convert;

PROCEDURE disk (VAR name:str70;VAR grenzen:Tgrenzen;bildnr:INTEGER;
                VAR anzfarb:INTEGER);
VAR err,convert:BOOLEAN;
    wahl,xpos,ypos:INTEGER;
    grenzgad:TgrenzG;
    ko:POINTER TO ARRAY [1..17],[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,43,92,55, 135,37,188,49, 135,52,188,64, 135,67,188,79,
        (* Modula         Oberon          Assem            Basic *)
           135,82,188,94, 135,97,188,109, 135,112,188,124, 135,127,188,139,
        (* C                ModAlt           Cancel          Sprite *)
           135,142,188,154, 135,157,188,169, 86,181,139,193, 39,108,92,120,
        (* Farben         Icon           Convert        Load (ganz) *)
           39,123,92,135, 39,138,92,150, 39,157,92,169, 36,27,95,60,
        (* Save (ganz) *)
           132,21,191,174
    END);
  END diskKords;

BEGIN
  SetAPen (rp,0);
  RectFill (rp,0,0,maxbreite+1,maxbreite+1);
  box (1,1,maxbreite+1,maxbreite+1,4);
  box (2,2,maxbreite,maxbreite,7);
  ko:=ADR(diskKords);
  ValToStr (grenzen[1],TRUE,helpstr,10,-2,0C,err);
  grenzgad[1]:=CreateStrGadget (1,67,70,24,8,3,autoBord3D,stdGadg,stdActv,
                                helpstr,grenzen[1],mywin);
  ValToStr (grenzen[2],TRUE,helpstr,10,-2,0C,err);
  grenzgad[2]:=CreateStrGadget (2,67,91,24,8,3,autoBord3D,stdGadg,stdActv,
                                helpstr,grenzen[2],mywin);
  RefreshGadgets (grenzgad[1],mywin,NIL);
  PrintHot (2,39,76,3,ADR("von"),1);
  PrintHot (2,39,97,3,ADR("bis"),1);
  rahmen (36,65,95,103,FALSE);
  FOR xpos:=16 TO 17 DO
    rahmen (ko^[xpos,1],ko^[xpos,2],ko^[xpos,3],ko^[xpos,4],FALSE);
  END;
  rahmen (ko^[1,1],ko^[1,2],ko^[1,3],ko^[1,4],FALSE);
  Print (2,ko^[1,1]+7,ko^[1,2]+9,5,ADR("I/B/R"));
  gadget (ko^[2,1],ko^[2,2],ko^[2,3],"IFF",1);
  gadget (ko^[3,1],ko^[3,2],ko^[3,3],"BobEdi",4);
  gadget (ko^[4,1],ko^[4,2],ko^[4,3],"RAW",1);
  gadget (ko^[5,1],ko^[5,2],ko^[5,3],"Modula",4);
  gadget (ko^[6,1],ko^[6,2],ko^[6,3],"Oberon",1);
  gadget (ko^[7,1],ko^[7,2],ko^[7,3],"Assem",5);
  gadget (ko^[8,1],ko^[8,2],ko^[8,3],"Basic",3);
  gadget (ko^[9,1],ko^[9,2],ko^[9,3],"C",1);
  gadget (ko^[10,1],ko^[10,2],ko^[10,3],"ModAlt",3);
  gadget (ko^[11,1],ko^[11,2],ko^[11,3],"Cancel",2);
  gadget (ko^[12,1],ko^[12,2],ko^[12,3],"Sprite",2);
  gadget (ko^[13,1],ko^[13,2],ko^[13,3],"Farben",1);
  gadget (ko^[14,1],ko^[14,2],ko^[14,3],"Icon",4);
  gadget (ko^[15,1],ko^[15,2],ko^[15,3],"Konver",1);
  PrintHot (2,ko^[16,1]+5,ko^[16,2]+10,6,ADR(" Load "),2);
  Print (2,ko^[17,1]+5,ko^[17,2]+10,6,ADR(" Save "));
  rahmen (ko^[12,1],ko^[12,2],ko^[12,3],ko^[12,4],sprite);
  rahmen (ko^[13,1],ko^[13,2],ko^[13,3],ko^[13,4],farbe);
  rahmen (ko^[14,1],ko^[14,2],ko^[14,3],ko^[14,4],SIcon);
  ModifyIDCMP (mywin,IDCMPFlagSet{mouseButtons,gadgetUp,vanillaKey});
  err:=ActivateGadget (grenzgad[1],mywin,NIL);
  convert:=FALSE; wahl:=0;
  REPEAT
    GetIMes (mywin,imes,TRUE);
    wahl:=0;
    IF gadgetUp IN imes.class THEN
      checkgads (grenzgad,grenzen,FALSE);
      IF imes.iAddress=grenzgad[1] THEN
        err:=ActivateGadget (grenzgad[2],mywin,NIL);
      END;
    ELSIF (mouseButtons IN imes.class) AND (imes.code=selectDown) THEN
      xpos:=imes.mouseX; ypos:=imes.mouseY;
      REPEAT
        INC (wahl);
      UNTIL (wahl>15) OR ((xpos>=ko^[wahl,1]) AND (ypos>=ko^[wahl,2]) AND
                         (xpos<=ko^[wahl,3]) AND (ypos<=ko^[wahl,4]));
    ELSIF vanillaKey IN imes.class THEN
      wahl:=S.FirstPos (" LIERUOMSCDAPFNKVB",0,CAP(CHAR(imes.code)));
      IF wahl>15 THEN
        err:=ActivateGadget (grenzgad[wahl-15],mywin,NIL);
      END;
    END;  (* IF gadgetUp *)
    IF (wahl>0) AND (wahl<12) THEN
      rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],TRUE);
      IF convert AND (wahl<4) THEN
        fehler ("Mit Konvert nicht","möglich !");
        rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],FALSE);
        wahl:=0;
      END;
    ELSIF wahl=12 THEN
      sprite:=NOT sprite;
      rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],sprite);
    ELSIF wahl=13 THEN
      farbe:=NOT farbe;
      rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],farbe);
    ELSIF wahl=14 THEN
      SIcon:=NOT SIcon;
      rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],SIcon);
    ELSIF wahl=15 THEN
      convert:=NOT convert;
      rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],convert);
    END;
  UNTIL (wahl>0) AND (wahl<12);
  checkgads (grenzgad,grenzen,FALSE);
  IF convert AND (wahl>3) AND (wahl<11) THEN
    Convert (name,wahl);
  ELSIF wahl<11 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,20,"") THEN
      xpos:=bin (anzfarb)-1;
      CASE wahl OF
        |1: load (name,grenzen,anzfarb);
        |2: saveiff (name,grenzen,anzfarb);
        |3: saveBob (name,grenzen,anzfarb,FALSE);
        |4: saveBob (name,grenzen,anzfarb,TRUE);
        |5..7,9..10:
          IF overwrite (name) THEN
            IF sprite THEN saveSourceSp (name,grenzen,anzfarb,xpos,wahl,NIL);
                      ELSE saveSource (name,grenzen,anzfarb,xpos,wahl,NIL); END;
          END;
        |8: saveBas (name,grenzen,anzfarb,xpos,NIL);
      END;
      error:=BltBitMap (ADR(bilder^[bildnr]),0,0,rp^.bitMap,
                        kleinx,kleiny+11,xbreite,ybreite,192,255,NIL);
    END;
  END;
  ModifyIDCMP (mywin,IDCMPFlagSet{mouseButtons,rawKey});
  xpos:=RemoveGadget (mywin,grenzgad[1]);
  xpos:=RemoveGadget (mywin,grenzgad[2]);
  SetAPen (rp,0);
  RectFill (rp,1,1,maxbreite+1,maxbreite+1);
  FOR xpos:=16 TO anzfarb+15 DO
    SetAPen (rp,xpos);
    RectFill (rp,xpos*14-221,230,xpos*14-211,242);
  END;
  lupe;
END disk;

BEGIN
  Flock:=NIL; startLock:=NIL; bildwin:=NIL; bildscr:=NIL;
  sprite:=FALSE; farbe:=FALSE; SIcon:=TRUE;
  startDat[modula]:="";
  startLock:=Lock (ADR(startDat[modula]),accessRead);
  startDat[modula]:="PROCEDURE Daten; (*$ EntryExitCode:=FALSE *)\n";
  startDat[oberon]:= "TYPE DatArray=ARRAY %d OF INTEGER;\n"+
                     "CONST Daten=DatArray";
  startDat[assem]:="Daten:\n";
  startDat[c]:="UWORD Daten[%d]";
  startDat[modalt]:="PROCEDURE Daten; (* $E- *)\n";
  startFarb[modula]:="PROCEDURE Farben; (*$ EntryExitCode:=FALSE *)\n";
  startFarb[oberon]:="TYPE FarbArray=ARRAY %d OF INTEGER;\n"+
                     "CONST Farben=FarbArray";
  startFarb[assem]:="Farben:\n";
  startFarb[c]:="UWORD Farben[%d]";
  startFarb[modalt]:="PROCEDURE Farben; (* $E- *)\n";
  startT[modula]:="BEGIN\n  ASSEMBLE (\n    DC.W ";
  startT[oberon]:="(\n";
  startT[assem]:=""; startT[c]:="={\n"; startT[modalt]:="BEGIN\n  INLINE (";
  endT[modula]:="  END);\nEND "; endT[oberon]:="      );\n";
  endT[assem]:="";               endT[c]:="};\n";
  endT[modalt]:="  );\nEND ";
  zeileT[modula]:="\n         "; zeileT[oberon]:="\n        ";
  zeileT[assem]:="\n DC.W ";     zeileT[c]:="\n    ";
  zeileT[modalt]:="\n          ";
  kstartT[modula]:="  (*"; kstartT[oberon]:="      (*";
  kstartT[assem]:=";";     kstartT[c]:="/*";
  kstartT[modalt]:="  (*";
  kendT[modula]:=" *)\n"; kendT[oberon]:=" *)\n";
  kendT[assem]:="\n";     kendT[c]:=" */\n";
  kendT[modalt]:=" *)\n";
CLOSE
  IF Flock#NIL THEN UnLock (Flock); Flock:=NIL; END;
  IF startLock#NIL THEN UnLock (startLock); startLock:=NIL; END;
  FreeBit (copybit);
  IF bildwin#NIL THEN CloseWindow (bildwin); bildwin:=NIL; END;
  IF bildscr#NIL THEN CloseScreen (bildscr); bildscr:=NIL; END;
END BobDisk.