(*---------------------------------------------------------------------------
  :Program.    BobHelp.mod
  :Contents.   Hilsproceduren für BobEdi
  :Author.     Frank Lömker
  :Copyright.  FreeWare, siehe Dok-File
  :Language.   Modula-2
  :Translator. M2Amiga V4.0d
  :Support.    lupe basiert auf Lupe von Wolfgang Friebe (AmigaMagazin 12/90)
  :Imports.    IntuiSupport 1.1.3 [Christian Stiens]
  :History.    V1.0, [Frank Lömker] 26-Dez-91
  :History.    V2.0, [Frank Lömker] 27-Jun-92 erweitert
  :Bugs.       keine bekannt
---------------------------------------------------------------------------*)

IMPLEMENTATION MODULE BobHelp;

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

FROM ExecD      IMPORT IOStdReq,DevicePtr;
FROM ExecL      IMPORT OpenDevice,CloseDevice;
FROM IntuitionD IMPORT WindowPtr,StringInfo,IntuiMessage,IntuiMessagePtr,
      GadgetPtr,WindowFlagSet,WindowFlags,IDCMPFlagSet,IDCMPFlags,selectDown;
FROM IntuitionL IMPORT CloseWindow,RefreshGList,RefreshGadgets,RemoveGadget,
      ModifyIDCMP,ActivateGadget;
FROM InputEvent IMPORT Class,InputEvent;
FROM Console IMPORT RawKeyConvert;
FROM GraphicsL IMPORT SetAPen,Move,Draw,Text,RectFill,BltBitMap,
      GetRGB4,SetRGB4,BltClear,BltPattern;
FROM SYSTEM IMPORT ADDRESS,ADR,SHIFT,ASSEMBLE,LONGSET;
FROM Arts IMPORT Assert;
FROM FileSystem IMPORT File,Lookup,Close,Response,WriteBytes,ReadBytes;
FROM String IMPORT Length,Compare,FirstPos;
FROM Conversions IMPORT ValToStr;
FROM IntuiSupport IMPORT CreateWindowA,GetIMes,CreateStrGadget,autoBord3D,
      stdGadg,stdActv;

VAR imes:IntuiMessage;

PROCEDURE Farben; (*$ EntryExitCode:=FALSE *)
BEGIN       (* Logo-Farben: 0000H,0EEEH,0F00H,00A0H (Planes 1,2 und 3) *)
   ASSEMBLE (
     DC.W $777,$000,$CCC,$58C,$AAA,$F00,$0A0,$EEE,
          $F00,$FFF,$FFF,$FFF,$0A0,$FFF,$FFF,$FFF,
          $000,$FFF,$F00,$0F0,$00F,$FF0,$F0F,$0FF,
          $555,$AAA,$A00,$0A0,$00A,$AA0,$A0A,$0AA
  END);
END Farben;

PROCEDURE Plot (x{0},y{1},farb{2}:INTEGER); (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE (
    MOVEM.L D3-D4,-(SP)
    LEA     myBit.planes(A4),A0
    ADD.W   #11,D1
    MOVE.W  D0,D3
    AND.W   #7,D3
    EORI.W  #7,D3                            (* Zu beinflussendes Bit *)
    LSR.W   #3,D0
    MULU    myBit.bytesPerRow(A4),D1
    EXT.L   D0
    ADD.L   D0,D1                            (* Offset *)
    MOVEQ   #4,D4                            (* Depth-1 *)
    MOVEQ   #0,D0
  loop:
    MOVE.L  (A0)+,A1                         (* Naechste Bitplane-Base *)
    ADD.L   D1,A1
    BTST    D0,D2                            (* Set or Clr ? *)
    BEQ.S   clr
    BSET    D3,(A1)                          (* Bit setzen *)
    BRA.S   weiter
  clr:
    BCLR    D3,(A1)                          (* Bit loeschen *)
  weiter:
    ADDQ.W  #1,D0
    DBF     D4,loop
    MOVEM.L (SP)+,D3-D4
    RTS
  END);
END Plot;

PROCEDURE PixCol (x{0},y{1}:INTEGER):INTEGER; (*$ EntryExitCode:=FALSE *)
BEGIN
  ASSEMBLE (
    MOVEM.L D2-D4,-(SP)
    ADD.W   #11,D1
    LEA     myBit.planes(A4),A0
    MOVE.W  D0,D3
    AND.W   #7,D3
    EORI.W  #7,D3                            (* Zu beinflussendes Bit *)
    LSR.W   #3,D0
    MULU    myBit.bytesPerRow(A4),D1
    EXT.L   D0
    ADD.L   D0,D1                            (* Offset *)
    MOVEQ   #4,D4                            (* Depth-1 *)
    MOVEQ   #0,D2
    MOVEQ   #0,D0
  loop:
    MOVE.L  (A0)+,A1
    ADD.L   D1,A1                            (* Plane-Pointer + Offset *)
    BTST    D3,(A1)                          (* Pixel gesetzt ? *)
    BEQ     weiter
    BSET    D2,D0
  weiter:
    ADDQ.W  #1,D2
    DBF     D4,loop
    MOVEM.L (SP)+,D2-D4
    RTS
  END);
END PixCol;

PROCEDURE box (x1,y1,x2,y2,farb:INTEGER);
BEGIN
  SetAPen (rp,farb);
  Move (rp,x1,y1);
  Draw (rp,x2,y1);Draw (rp,x2,y2);Draw (rp,x1,y2);Draw (rp,x1,y1);
END box;

PROCEDURE line (x1,y1,x2,y2:INTEGER);
BEGIN
  Move (rp,x1,y1);
  Draw (rp,x2,y2);
END line;

PROCEDURE Print (farb,x,y,len:INTEGER;text:ADDRESS);
BEGIN
  SetAPen (rp,farb);
  Move (rp,x,y);
  Text (rp,text,len);
END Print;

PROCEDURE PrintHot (farb,x,y,len:INTEGER;text:ADDRESS;hotkey:SHORTINT);
BEGIN
  Print (farb,x,y,len,text);
  line (x+hotkey*8-8,y+1,x+hotkey*8-1,y+1);
END PrintHot;

PROCEDURE PrintVal (farb,x,y,len:INTEGER;zahl:INTEGER);
VAR s:str10;
    err:BOOLEAN;
BEGIN
  ValToStr (zahl,FALSE,s,10,len," ",err);
  Print (farb,x,y,ABS(len),ADR(s));
END PrintVal;

PROCEDURE PrintHex (farb,x,y,len:INTEGER;zahl:INTEGER);
VAR s:str10;
    err:BOOLEAN;
BEGIN
  ValToStr (zahl,FALSE,s,16,len," ",err);
  Print (farb,x,y,ABS(len),ADR(s));
END PrintHex;

PROCEDURE PrintLong (col,x,y,len:INTEGER;zahl:LONGINT);
VAR s:str10;
    err:BOOLEAN;
BEGIN
  ValToStr (zahl,TRUE,s,10,len," ",err);
  Print (col,x,y,ABS(len),ADR(s));
END PrintLong;

PROCEDURE rahmen (x1,y1,x2,y2:INTEGER;gedrueckt:BOOLEAN);
BEGIN
  SetAPen (rp,INTEGER(NOT gedrueckt)+1);
  Move (rp,x1,y2-1); Draw (rp,x1,y1); Draw (rp,x2,y1);
  SetAPen (rp,INTEGER(gedrueckt)+1);
  Move (rp,x2,y1+1); Draw (rp,x2,y2); Draw (rp,x1,y2);
END rahmen;

PROCEDURE gadget (x1,y1,x2:INTEGER;text:ARRAY OF CHAR;hotkey:SHORTINT);
VAR x:INTEGER;
BEGIN
  rahmen (x1,y1,x2,y1+12,FALSE);
  x:=x1+( (x2-x1) DIV 2 - (HIGH(text)+1)*4 )+1;
  Print (2,x,y1+9,HIGH(text)+1,ADR(text));
  line (x+hotkey*8-8,y1+10,x+hotkey*8-1,y1+10);
END gadget;

(*$ EntryExitCode:=FALSE *)
PROCEDURE bin (wert{1}:INTEGER):INTEGER;  (* Berechnung der Binärstellen *)
BEGIN
  ASSEMBLE (
         MOVEQ #7,D0
   LOOP: ASL.B #1,D1
         DBCS D0,LOOP
         ADDQ.B #1,D0
         RTS
  END);
END bin;

(*$ CopyDyn:=FALSE*)
PROCEDURE fehler (text1,text2:ARRAY OF CHAR);
VAR fehlerwin:WindowPtr;
    x,mitwin:INTEGER;
BEGIN
  mitwin:=82; x:=Length(text1);
  IF Length(text2)>x THEN x:=Length(text2); END;
  IF x>19 THEN
    mitwin:=mitwin+(x-19)*4;
    IF mitwin>mittex THEN x:=mitwin-mittex
                     ELSE x:=0; END;
  ELSE x:=0; END;
  fehlerwin:=CreateWindowA (NIL,mittex-mitwin+x,mittey-15,mitwin*2,38,myscreen,
                   NIL,WindowFlagSet{activate,borderless,rmbTrap},
                   IDCMPFlagSet{mouseButtons,vanillaKey});
  rp:=fehlerwin^.rPort;
  box (0,0,mitwin*2-1,37,2);
  box (1,0,mitwin*2-2,37,2);
  x:=20;
  IF text2[0]#0C THEN x:=15; END;
  Print (2,mitwin-Length(text1)*4,x,Length(text1),ADR(text1));
  IF text2[0]#0C THEN
    Print (2,mitwin-Length(text2)*4,30,Length(text2),ADR(text2));
  END;
  rp:=mywin^.rPort;
  REPEAT
    GetIMes (fehlerwin,imes,TRUE);
  UNTIL (imes.code=selectDown) OR (vanillaKey IN imes.class);
  CloseWindow (fehlerwin); fehlerwin:=NIL;
END fehler;

PROCEDURE zeigdatf (res:Response);
VAR st:str70;
BEGIN
  IF res#done THEN
    CASE res OF
       lockErr           : st:="Dateizugriff verweigert !";
      |openErr           : st:="Datei nicht zu öffnen !";
      |readErr           : st:="Lesefehler !";
      |writeErr          : st:="Schreibfehler !";
      |seekErr           : st:="Fehler bei Seek !";
      |memErr            : st:="Zu wenig Speicher !";
      |inUse             : st:="Datei wird benutzt !";
      |notFound          : st:="Datei nicht gefunden !";
      |diskWriteProtected: st:="Diskette schreibgeschützt !";
      |deviceNotMounted  : st:="Gerät nicht vorhanden !";
      |diskFull          : st:="Diskette ist voll !";
      |deleteProtected   : st:="Datei vor Löschen geschützt !";
      |writeProtected    : st:="Datei schreibgeschützt !";
      |notDosDisk        : st:="Keine Dos-Diskette !";
      |noDisk            : st:="Keine Diskette vorhanden !";
      ELSE                 st:="Fehler bei Operation !";
    END;
    fehler ("Dateifehler:",st);
  END;  (* IF res#done *)
END zeigdatf;

PROCEDURE datfehler (VAR dat:File):BOOLEAN;
BEGIN
  IF dat.res#done THEN
    zeigdatf (dat.res);
    RETURN TRUE;
  ELSE
    RETURN FALSE;
  END;
END datfehler;

(*$ CopyDyn:=FALSE *)
PROCEDURE frage (text1,text2:ARRAY OF CHAR):BOOLEAN;
VAR fragewin:WindowPtr;
    wahl,x,y:INTEGER;
BEGIN
  fragewin:=CreateWindowA (NIL,mittex-86,mittey-20,172,54,myscreen,NIL,
                  WindowFlagSet{activate,borderless,rmbTrap},
                  IDCMPFlagSet{mouseButtons,vanillaKey});
  rp:=fragewin^.rPort;
  box (0,0,171,53,2);
  box (1,0,170,53,2);
  x:=18;
  IF text2[0]#0C THEN x:=15; END;
  Print (2,86-Length(text1)*4,x,Length(text1),ADR(text1));
  IF text2[0]#0C THEN
    Print (2,86-Length(text2)*4,28,Length(text2),ADR(text2));
  END;
  gadget (29,37,64,"OK",1);
  gadget (90,37,143,"CANCEL",1);
  wahl:=0;
  REPEAT
    GetIMes (fragewin,imes,TRUE);
    IF (mouseButtons IN imes.class) AND (imes.code=selectDown) THEN
      x:=imes.mouseX; y:=imes.mouseY;
      IF (x>28) AND (x<65) AND (y>36) AND (y<50) THEN
        wahl:=1;                          (* OK *)
      ELSIF (x>89) AND (x<144) AND (y>36) AND (y<50) THEN
        wahl:=2;                          (* CANCEL *)
      END;
    ELSIF vanillaKey IN imes.class THEN
      IF CAP(CHAR(imes.code))="O" THEN wahl:=1;
      ELSIF CAP(CHAR(imes.code))="C" THEN wahl:=2; END;
    END;
  UNTIL wahl#0;
  rp:=mywin^.rPort;
  CloseWindow (fragewin); fragewin:=NIL;
  RETURN wahl=1;
END frage;

PROCEDURE getCol (VAR farben:Tfarben);
VAR nr:LONGINT;
    rgb:LONGCARD;
BEGIN
  FOR nr:=16 TO 31 DO
    rgb:=GetRGB4 (myscreen^.viewPort.colorMap,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 getCol;

PROCEDURE drawraster;
VAR x,y:INTEGER;
BEGIN
  WITH Lkor DO
    IF RasterA=aus THEN
      box (xmin-1,ymin-1,xmax+1,ymax+1,4);
    ELSE
      SetAPen (rp,RasterA*3-2);
      FOR x:=0 TO xbreite DO
        line (xmin+dx*x-1,ymin-1,xmin+dx*x-1,ymax);
      END;
      FOR y:=0 TO ybreite DO
        line (xmin-1,ymin+dy*y-1,xmax,ymin+dy*y-1);
      END;
      SetAPen (rp,2);
      line (mittex-1,ymin-1,mittex-1,ymax);
      line (xmin-1,mittey-1,xmax,mittey-1);
    END;
  END;
END drawraster;

PROCEDURE lupe;
VAR help,nr,rest,ende:INTEGER;
    err:LONGCARD;
BEGIN
  WITH Lkor DO
    IF xbreite*ybreite<200 THEN
      help:=INTEGER(RasterA<>0)+1;
      FOR nr:=0 TO ybreite-1 DO
        FOR rest:=0 TO xbreite-1 DO
          SetAPen (rp,PixCol(rest+kleinx,nr+kleiny));
          BltPattern (rp,NIL,rest*dx+xmin,nr*dy+ymin,
                       (rest+1)*dx+xmin-help,(nr+1)*dy+ymin-help,0);
        END;  (* ^ etwas schneller als RectFill *)
      END;
    ELSE
      SetAPen (rp,16);
      RectFill (rp,xmin,ymin,xmax,ymax);
      FOR nr:=0 TO xbreite-1 DO
        err:=BltBitMap (rp^.bitMap,kleinx+nr,kleiny+11,rp^.bitMap,
                        xmin+nr*dx,ymin+11,1,ybreite,192,255,NIL);
      END;
      ende:=0;
      WHILE INTEGER(SHIFT(1,ende))<(dx+INTEGER(ODD(dx))) DIV 2 DO
        INC (ende);
      END;
      rest:=dx-INTEGER(SHIFT(1,ende));
      FOR nr:=0 TO ende-1 DO
        help:=INTEGER(SHIFT(1,nr));
        err:=BltBitMap (rp^.bitMap,xmin,ymin+11,rp^.bitMap,
                  help+xmin,ymin+11,xmax-xmin-help,
                  ymax-ymin,224,255,helpbit.planes[0]);
      END;
      err:=BltBitMap (rp^.bitMap,xmin,ymin+11,rp^.bitMap,rest+xmin,
                 ymin+11,xmax-xmin-rest+1,ybreite,224,255,
                 helpbit.planes[0]);
      FOR nr:=ybreite-1 TO 1 BY -1 DO
        err:=BltBitMap (rp^.bitMap,xmin,ymin+nr+11,rp^.bitMap,
            xmin,nr*dy+ymin+11,xmax-xmin+1,1,224,255,helpbit.planes[0]);
        line (xmin,ymin+nr,xmax,ymin+nr);
      END;
      ende:=0;
      WHILE INTEGER(SHIFT(1,ende))<(dy+INTEGER(ODD(dy))) DIV 2 DO
        INC (ende);
      END;
      rest:=dy-INTEGER(SHIFT(1,ende));
      FOR nr:=0 TO ende-1 DO
        help:=INTEGER(SHIFT(1,nr));
        err:=BltBitMap (rp^.bitMap,xmin,ymin+11,rp^.bitMap,
                        xmin,help+ymin+11,xmax-xmin+1,
                        ymax-ymin-help,224,255,helpbit.planes[0]);
      END;
      err:=BltBitMap (rp^.bitMap,xmin,ymin+11,rp^.bitMap,
                xmin,rest+ymin+11,xmax-xmin+1,
                ymax-ymin-rest+1,224,255,helpbit.planes[0]);
    END;  (* IF xbreite*ybreite *)
  END;  (* WITH Lkor *)
  drawraster;
END lupe;

PROCEDURE checkgads (VAR grenzgad:TgrenzG;VAR grenzen:Tgrenzen;
                     groesser:BOOLEAN);
VAR stinfo:POINTER TO StringInfo;
    nr:INTEGER;
    Pstring:pstr2;
    helpstr:str2;
    err:BOOLEAN;
BEGIN
  stinfo:=grenzgad[1]^.specialInfo; grenzen[1]:=stinfo^.longInt;
  stinfo:=grenzgad[2]^.specialInfo; grenzen[2]:=stinfo^.longInt;
  FOR nr:=1 TO 2 DO
    IF grenzen[nr]<1 THEN grenzen[nr]:=1;
    ELSIF grenzen[nr]>anzbilder THEN grenzen[nr]:=anzbilder; END;
  END;
  IF grenzen[1]+INTEGER(groesser)>grenzen[2] THEN
    IF grenzen[1]<anzbilder THEN grenzen[2]:=grenzen[1]+INTEGER(groesser);
                            ELSE grenzen[1]:=grenzen[2]-INTEGER(groesser); END;
  END;
  FOR nr:=1 TO 2 DO
    stinfo:=grenzgad[nr]^.specialInfo; Pstring:=stinfo^.buffer;
    ValToStr (grenzen[nr],TRUE,helpstr,10,-2,0C,err);
    Pstring^:=helpstr;
    stinfo^.longInt:=grenzen[nr];
  END;
  RefreshGList (grenzgad[1],mywin,NIL,2);
END checkgads;

PROCEDURE raster (anzfarben:INTEGER;quadrat:BOOLEAN);
VAR x,y:INTEGER;
BEGIN
  SetAPen (rp,0);
  RectFill (rp,Mkleinx-34,Mkleiny-33,Mkleinx+33,Mkleiny+32);
  RectFill (rp,0,0,mittex*2,mittey*2);
  kleinx:=Mkleinx-(xbreite DIV 2); kleiny:=Mkleiny-(ybreite DIV 2);(*Original*)
  x:=kleinx+xbreite-1; y:=kleiny+ybreite-1;
  SetAPen (rp,16);
  RectFill (rp,kleinx,kleiny,x,y);
  box (kleinx-1,kleiny-1,x+1,y+1,4);
  box (kleinx-2,kleiny-1-INTEGER(ybreite<MaxY),
       x+2,y+1+INTEGER(ybreite<MaxY-1),7);
  y:=INTEGER(ODD(ybreite));
  Lkor.dx:=maxbreite DIV xbreite; Lkor.dy:=maxbreite DIV (ybreite+y); (*groß*)
  IF quadrat THEN
    IF Lkor.dx>Lkor.dy THEN Lkor.dx:=Lkor.dy;
                       ELSE Lkor.dy:=Lkor.dx; END;
  END;
  Lkor.xmin:=mittex-(xbreite DIV 2)*Lkor.dx;
  Lkor.ymin:=mittey-(ybreite DIV 2)*Lkor.dy;
  Lkor.xmax:=Lkor.xmin+xbreite*Lkor.dx-1;
  Lkor.ymax:=Lkor.ymin+ybreite*Lkor.dy-1;
  SetAPen (rp,16);
  RectFill (rp,Lkor.xmin,Lkor.ymin,Lkor.xmax,Lkor.ymax);
  SetAPen (rp,0); RectFill (rp,30,229,224,243);
  FOR y:=16 TO anzfarben+15 DO
    SetAPen (rp,y);
    RectFill (rp,y*14-221,230,y*14-211,242);
  END;
END raster;

PROCEDURE loadEinstell (VAR xbreite,ybreite,anzfarben:INTEGER;
                        VAR quadrat,err:BOOLEAN);
VAR datei:File;
    actual:LONGINT;
    help:ARRAY [1..9] OF CHAR;
    farben:Tfarben;
BEGIN
  err:=TRUE;
  Lookup (datei,prefsname,0,FALSE);
  IF datei.res=done THEN
    help:="         ";
    ReadBytes (datei,ADR(help),SIZE(prefsHeader),actual);
    IF Compare (prefsHeader,help)=0 THEN
      ReadBytes (datei,ADR(xbreite),SIZE(INTEGER),actual);
      ReadBytes (datei,ADR(ybreite),SIZE(INTEGER),actual);
      ReadBytes (datei,ADR(anzfarben),SIZE(INTEGER),actual);
      ReadBytes (datei,ADR(quadrat),SIZE(BOOLEAN),actual);
      ReadBytes (datei,ADR(RasterA),SIZE(SHORTINT),actual);
      ReadBytes (datei,ADR(farben[16]),SIZE(Tfarben) DIV 2,actual);
      IF (actual#LONGINT(SIZE(Tfarben) DIV 2)) OR (datei.res#done) THEN
        fehler ("Fehler beim Laden","der Einstellungen !");
      ELSE
        FOR actual:=16 TO 31 DO
          (*$ StackParms:=TRUE *)
          SetRGB4 (ADR(myscreen^.viewPort),actual,
               farben[actual,1],farben[actual,2],farben[actual,3]);
          (*$ POP StackParms *)
        END;
        err:=FALSE;
      END;
    ELSE
      fehler ("Einstellungsdatei","fehlerhaft !");
    END;  (* IF Compare *)
  END;  (* IF datei.res *)
  Close (datei);
END loadEinstell;

PROCEDURE saveEinstell (xbreite,ybreite,anzfarben:INTEGER;quadrat:BOOLEAN);
VAR datei:File;
    actual:LONGINT;
    farben:Tfarben;
BEGIN
  Lookup (datei,prefsname,0,TRUE);
  IF NOT datfehler (datei) THEN
    getCol (farben);
    WriteBytes (datei,ADR(prefsHeader),SIZE(prefsHeader),actual);
    WriteBytes (datei,ADR(xbreite),SIZE(INTEGER),actual);
    WriteBytes (datei,ADR(ybreite),SIZE(INTEGER),actual);
    WriteBytes (datei,ADR(anzfarben),SIZE(INTEGER),actual);
    WriteBytes (datei,ADR(quadrat),SIZE(BOOLEAN),actual);
    WriteBytes (datei,ADR(RasterA),SIZE(SHORTINT),actual);
    WriteBytes (datei,ADR(farben[16]),SIZE(Tfarben) DIV 2,actual);
    IF NOT datfehler (datei) THEN
      IF actual#LONGINT(SIZE(Tfarben) DIV 2) THEN
        fehler ("Fehler beim Saven !","");
      END;
    END;
  END;  (* IF NOT datfehler *)
  Close (datei);
END saveEinstell;

PROCEDURE setEinstell (VAR anzfarben:INTEGER;VAR quadrat:BOOLEAN);

  PROCEDURE einKords; (*$ EntryExitCode:=FALSE *)
  BEGIN  (* 16           32             48             64 *)
    ASSEMBLE (
      DC.W 92,50,112,62, 117,50,137,62, 142,50,162,62, 167,50,187,62,
        (* 2             4              8              16 *)
           92,81,112,93, 117,81,137,93, 142,81,162,93, 167,81,187,93,
        (* aus            Schw            Grau            Quadrat *)
           92,98,120,110, 125,98,161,110, 166,98,202,110, 41,116,109,128,
        (* Save             OK             Cancel *)
           117,116,161,128, 55,150,90,162, 105,150,158,162
    END);
  END einKords;

VAR hogad:GadgetPtr;
    helpstr:str2;
    ko:POINTER TO ARRAY [1..15],[1..4] OF INTEGER;
    altfarben,altbreite,althoehe,nr,wahl,xpos,ypos:INTEGER;
    altRaster:SHORTINT;
    altquadrat,err:BOOLEAN;

  PROCEDURE checkgad;
  VAR stinfo:POINTER TO StringInfo;
      Pstring:pstr2;
  BEGIN
    stinfo:=hogad^.specialInfo;
    ybreite:=stinfo^.longInt;
    IF ybreite<2 THEN ybreite:=2;
    ELSIF ybreite>MaxY THEN ybreite:=MaxY; END;
    Pstring:=stinfo^.buffer;
    ValToStr (ybreite,TRUE,helpstr,10,-2,0C,err);
    Pstring^:=helpstr;
    stinfo^.longInt:=ybreite;
    RefreshGList (hogad,mywin,NIL,1);
  END checkgad;

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(einKords);
  PrintHot (2,ko^[1,1]-51,ko^[1,4]-3,6,ADR("Breite"),1);
  Print (2,ko^[1,1]+2,ko^[1,4]-3,2,ADR("16"));
  Print (2,ko^[2,1]+2,ko^[2,4]-3,2,ADR("32"));
  Print (2,ko^[3,1]+2,ko^[3,4]-3,2,ADR("48"));
  Print (2,ko^[4,1]+2,ko^[4,4]-3,2,ADR("64"));
  PrintHot (2,ko^[1,1]-51,ko^[1,4]+12,4,ADR("Höhe"),1);
  ValToStr (ybreite,TRUE,helpstr,10,-2,0C,err);
  hogad:=CreateStrGadget (1,ko^[1,1]+1,ko^[1,2]+18,24,8,3,autoBord3D,stdGadg,
                          stdActv,helpstr,ybreite,mywin);
  RefreshGadgets (hogad,mywin,NIL);
  PrintHot (2,ko^[5,1]-51,ko^[5,4]-3,6,ADR("Farben"),1);
  Print (2,ko^[5,1]+6,ko^[5,4]-3,1,ADR("2 "));
  Print (2,ko^[6,1]+6,ko^[6,4]-3,1,ADR("4 "));
  Print (2,ko^[7,1]+6,ko^[7,4]-3,1,ADR("8 "));
  Print (2,ko^[8,1]+2,ko^[8,4]-3,2,ADR("16"));
  PrintHot (2,ko^[9,1]-51,ko^[9,4]-3,6,ADR("Raster"),1);
  Print (2,ko^[9,1]+2,ko^[9,4]-3,3,ADR("aus"));
  Print (2,ko^[10,1]+2,ko^[10,4]-3,4,ADR("Schw"));
  Print (2,ko^[11,1]+2,ko^[11,4]-3,4,ADR("Grau"));

  gadget (ko^[12,1],ko^[12,2],ko^[12,3],"Quadrate",1);
  gadget (ko^[13,1],ko^[13,2],ko^[13,3],"Save",1);
  gadget (ko^[14,1],ko^[14,2],ko^[14,3],"OK",1);
  gadget (ko^[15,1],ko^[15,2],ko^[15,3],"CANCEL",1);
  FOR nr:=1 TO 11 DO
    rahmen (ko^[nr,1],ko^[nr,2],ko^[nr,3],ko^[nr,4],FALSE);
  END;
  wahl:=xbreite DIV 16;                       (* xbreite *)
  rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],TRUE);
  wahl:=bin (anzfarben)-1+4;                      (* Farben *)
  rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],TRUE);
  wahl:=RasterA+9;
  rahmen (ko^[wahl,1],ko^[wahl,2],ko^[wahl,3],ko^[wahl,4],TRUE);
  rahmen (ko^[12,1],ko^[12,2],ko^[12,3],ko^[12,4],quadrat);
  ModifyIDCMP (mywin,IDCMPFlagSet{mouseButtons,gadgetUp,vanillaKey});
  wahl:=0;
  altfarben:=anzfarben; altbreite:=xbreite; althoehe:=ybreite;
  altquadrat:=quadrat; altRaster:=RasterA;
  err:=ActivateGadget (hogad,mywin,NIL);
  REPEAT
    GetIMes (mywin,imes,TRUE);
    wahl:=0;
    IF gadgetUp IN imes.class THEN
      checkgad;
    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) AND (imes.code#32) THEN
      IF CAP(CHAR(imes.code))="H" THEN
        err:=ActivateGadget (hogad,mywin,NIL);
      ELSE
        wahl:=FirstPos (" B   F   R  QSOC",0,CAP(CHAR(imes.code)));
        CASE wahl OF
           1: wahl:=(xbreite DIV 16) MOD 4 +1;
          |5: wahl:=(bin (anzfarben)-1) MOD 4 + 5;
          |9: wahl:=(RasterA+1) MOD 3+9;
        ELSE
        END;
      END;
    END;
    CASE wahl OF
       1..4: FOR nr:=1 TO 4 DO
               rahmen (ko^[nr,1],ko^[nr,2],ko^[nr,3],ko^[nr,4],nr=wahl);
             END;
             xbreite:=wahl*16;
      |5..8: FOR nr:=5 TO 8 DO
               rahmen (ko^[nr,1],ko^[nr,2],ko^[nr,3],ko^[nr,4],nr=wahl);
             END;
             anzfarben:=SHIFT (1,wahl-4);
      |9..11: FOR nr:=9 TO 11 DO
                rahmen (ko^[nr,1],ko^[nr,2],ko^[nr,3],ko^[nr,4],nr=wahl);
              END;
              RasterA:=wahl-9;
      |12: quadrat:=NOT quadrat;
          rahmen (ko^[12,1],ko^[12,2],ko^[12,3],ko^[12,4],quadrat);
      |13: rahmen (ko^[13,1],ko^[13,2],ko^[13,3],ko^[13,4],TRUE);
           checkgad;
           saveEinstell (xbreite,ybreite,anzfarben,quadrat);
           rahmen (ko^[13,1],ko^[13,2],ko^[13,3],ko^[13,4],FALSE);
      |14: checkgad;                                            (* OK *)
      |15: anzfarben:=altfarben; xbreite:=altbreite; ybreite:=althoehe;
           quadrat:=altquadrat; RasterA:=altRaster;
      ELSE       (* ^ Cancel (14) *)
    END;
  UNTIL (wahl=14) OR (wahl=15);
  nr:=RemoveGadget (mywin,hogad);
  ModifyIDCMP (mywin,IDCMPFlagSet{mouseButtons,rawKey});
  SetAPen (rp,0);
  RectFill (rp,1,1,maxbreite+1,maxbreite+1);
  IF anzfarben<altfarben THEN
    wahl:=bin (anzfarben)-1;
    FOR nr:=0 TO anzbilder+1 DO
      WITH bilder^[nr] DO
        FOR xpos:=wahl TO 3 DO
          BltClear (planes[xpos],bytesPerRow*rows,LONGSET{});
        END;
      END;
    END;
  END;
  raster (anzfarben,quadrat);
END setEinstell;

VAR consoleDevice: DevicePtr;
    ioreq:  IOStdReq;

PROCEDURE DeadKeyConvert(msg:IntuiMessagePtr;VAR buf:ARRAY OF CHAR):LONGINT;
VAR ievent: InputEvent;
    len:LONGINT;
BEGIN
  WITH ievent DO
    nextEvent := NIL;
    class     := rawkey;
    subClass  := null;
    code      := msg^.code;
    qualifier := msg^.qualifier;
    eventAddress := msg^.iAddress;
  END;
  len:=RawKeyConvert(consoleDevice,ADR(ievent),ADR(buf),HIGH(buf),NIL);
  buf[len]:=0C;
  RETURN len;
END DeadKeyConvert;

BEGIN
  consoleDevice := NIL;
  OpenDevice(ADR("console.device"),-1,ADR(ioreq),LONGSET{});
  Assert(ioreq.error=0,ADR("ConsoleDevice nicht zu öffnen !"));
  consoleDevice := ioreq.device;
CLOSE
  IF consoleDevice # NIL THEN CloseDevice(ADR(ioreq)) END;
END BobHelp.