home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / mar94 / util / misc / kalender.lha / Kalender / txt / window2.mod < prev    next >
Text File  |  1993-12-18  |  7KB  |  248 lines
  1.  IMPLEMENTATION MODULE Window2;
  2.  
  3.  (*$ StackChk       := FALSE *)
  4.  (*$ RangeChk       := FALSE *)
  5.  (*$ OverflowChk    := FALSE *)
  6.  (*$ NilChk         := FALSE *)
  7.  (*$ CaseChk        := FALSE *)
  8.  (*$ ReturnChk      := FALSE *)
  9.  (*$ LargeVars      := FALSE *)
  10.  (*$ EntryClear     := TRUE  *)
  11.  (*$ Volatile       := TRUE  *)
  12.  (*$ StackParms     := TRUE  *)
  13.  (*$ CStrings       := TRUE  *)
  14.  
  15.  
  16.  FROM Arts        IMPORT    Assert;
  17.  FROM SYSTEM        IMPORT    TAG,ADR,ADDRESS,LONGSET;
  18.  FROM String        IMPORT    Concat,Copy;
  19.  FROM ExecL        IMPORT    GetMsg,ReplyMsg;
  20.  FROM GraphicsD        IMPORT    Rectangle,invalidID,
  21.                  TextAttr,TextAttrPtr,
  22.                 FontStyleSet,FontStyles,
  23.                 FontFlagSet,FontFlags,
  24.                 DrawModeSet,DrawModes,
  25.                 GfxBasePtr,GfxBase;
  26.  FROM GraphicsL        IMPORT    GetVPModeID,
  27.                 RectFill,
  28.                 SetAPen,SetDrMd,
  29.                 graphicsBase;
  30.  FROM IntuitionD    IMPORT    Window,WindowPtr,
  31.                 WaTags,
  32.                 IDCMPFlagSet,IDCMPFlags,
  33.                 IntuiMessage,IntuiMessagePtr,
  34.                 IntuiText,IntuiTextPtr,
  35.                 Screen,ScreenPtr,
  36.                 oScanText;
  37.  FROM IntuitionL    IMPORT    intuitionVersion,
  38.                 OpenWindowTagList,CloseWindow,
  39.                 LockPubScreen,UnlockPubScreen,
  40.                 QueryOverscan,
  41.                 ZipWindow,ChangeWindowBox,
  42.                 ModifyIDCMP,
  43.                 PrintIText,IntuiTextLength,
  44.                 BeginRefresh,EndRefresh;
  45.  FROM UtilityD        IMPORT    tagDone;
  46.  FROM Datum        IMPORT    wtstring,GetDate,FormatDate,datestr;
  47.  
  48.  
  49.  TYPE
  50.     tstring    = ARRAY [1..80] OF CHAR;
  51.     wtxttyp    = RECORD
  52.             txt    : tstring;
  53.             col    : SHORTCARD;
  54.             rev    : BOOLEAN;
  55.           END;
  56.  
  57.  
  58.  VAR
  59.     window                : WindowPtr;
  60.     left,top,width,height        : INTEGER;
  61.     pos                : INTEGER;
  62.     woche,wt,tag,monat        : SHORTCARD;
  63.     jahr                : CARDINAL;
  64.     ActionMem            : action2mem;
  65.     wtstr                : wtstring;
  66.     datumstr            : datestr;
  67.     ypos                : SHORTCARD;
  68.     wtxt                : ARRAY [0..35] OF wtxttyp;
  69.     wpos                : SHORTCARD;
  70.     scrFontYSize,scrFontXSize    : CARDINAL;
  71.     winFontYSize,winFontXSize    : CARDINAL;
  72.     font                := TextAttr{name:ADR("topaz.font"),ySize:8,style:FontStyleSet{},flags:FontFlagSet{romFont}};
  73.     txt                := IntuiText{frontPen:1,backPen:0,drawMode:DrawModeSet{dm0},leftEdge:5,topEdge:12,iTextFont:NIL(*ADR(font)*),iText:NIL};
  74.     titletxt            := IntuiText{frontPen:1,backPen:0,drawMode:DrawModeSet{dm0},leftEdge:0,topEdge:0,iTextFont:NIL,iText:NIL};
  75.     titlewidth            : LONGINT;
  76.  
  77.  
  78.  PROCEDURE OpenWin2(zeilen,spalten : SHORTCARD; wintitle : ADDRESS) : SHORTCARD;
  79.  
  80.  VAR    screen            : ScreenPtr;
  81.      scrrec            : Rectangle;
  82.     scrmodeid        : LONGCARD;
  83.     tagbuffer        : ARRAY [1..16*2] OF LONGCARD;
  84.     zoombuffer        : RECORD
  85.                     LeftEdge    : INTEGER;
  86.                     TopEdge    : INTEGER;
  87.                     Width    : INTEGER;
  88.                     Height    : INTEGER;
  89.                   END;
  90.  
  91.  
  92.  BEGIN
  93.    screen := LockPubScreen(NIL);
  94.    IF screen # NIL THEN
  95.      scrmodeid := GetVPModeID(ADR(screen^.viewPort));
  96.      IF scrmodeid # invalidID THEN
  97.        IF QueryOverscan(scrmodeid,ADR(scrrec),oScanText) THEN
  98.          scrFontYSize := screen^.font^.ySize;
  99.          scrFontXSize := screen^.rastPort.font^.xSize;
  100.          winFontYSize := graphicsBase^.defaultFont^.ySize;
  101.          winFontXSize := graphicsBase^.defaultFont^.xSize;
  102.          width := INTEGER(spalten)*INTEGER(winFontXSize)+9;
  103.          height := INTEGER(zeilen)*INTEGER(winFontYSize)+INTEGER(scrFontYSize)+6;
  104.          IF height > scrrec.maxY - scrrec.minY +1 THEN
  105.            height := scrrec.maxY - scrrec.minY +1;
  106.          END;
  107.          titletxt.iTextFont := screen^.font;
  108.          titletxt.iText := wintitle;
  109.          titlewidth := IntuiTextLength(ADR(titletxt));
  110.          IF titlewidth + 90 > width THEN
  111.            width := INTEGER(titlewidth)+90;
  112.          END;
  113.          IF width > scrrec.maxX - scrrec.minX +1 THEN
  114.            width := scrrec.maxX - scrrec.minX +1;
  115.          END;
  116.          IF screen^.topEdge >= 0 THEN
  117.            top := 0;
  118.          ELSE
  119.            top := -screen^.topEdge;
  120.          END;
  121.          IF screen^.leftEdge >= 0 THEN
  122.            left := 0;
  123.          ELSE
  124.            left := -screen^.leftEdge +1;
  125.          END;
  126.          zoombuffer.Width := width;
  127.          zoombuffer.Height := scrFontYSize+3;
  128.          zoombuffer.LeftEdge := left;
  129.          zoombuffer.TopEdge := top;
  130.          window := OpenWindowTagList(NIL,TAG(tagbuffer,
  131.     waLeft,            left,
  132.     waTop,            top,
  133.     waWidth,        width,
  134.     waHeight,        height,
  135.     waTitle,        wintitle,
  136.     waScreenTitle,        ADR("Kalender V2.1 (C) 1991-1993 by Kai Hofmann"),
  137.     waPubScreen,        screen,
  138.     waDragBar,        TRUE,
  139.     waDepthGadget,        TRUE,
  140.     waCloseGadget,        TRUE,
  141.     waZoom,            ADR(zoombuffer),
  142.     waActivate,        TRUE,
  143.     waIDCMP,        IDCMPFlagSet{closeWindow,gadgetDown,gadgetUp,refreshWindow},
  144.     waSmartRefresh,        TRUE,
  145.     tagDone));
  146.          UnlockPubScreen(NIL,screen);
  147.          IF window # NIL THEN
  148.            ;
  149.        txt.leftEdge := window^.borderLeft+1;
  150.        txt.topEdge := window^.borderTop+1;
  151.            RETURN(window^.userPort^.sigBit);
  152.      END;
  153.        END;
  154.      END;
  155.    END;
  156.    RETURN(0);
  157.  END OpenWin2;
  158.  
  159.  
  160.  PROCEDURE CloseWin2;
  161.  
  162.  VAR intuimsg    : IntuiMessagePtr;
  163.  
  164.  BEGIN
  165.    LOOP
  166.      intuimsg := GetMsg(window^.userPort);
  167.      IF intuimsg = NIL THEN
  168.        EXIT;
  169.      END;
  170.      ReplyMsg(intuimsg);
  171.    END;
  172.    CloseWindow(window);
  173.  END CloseWin2;
  174.  
  175.  
  176.  PROCEDURE OutputWin2(text : ARRAY OF CHAR; col : SHORTCARD; rev : BOOLEAN);
  177.  
  178.  BEGIN
  179.    IF rev THEN
  180.      txt.frontPen := 0;
  181.      txt.backPen  := col;
  182.    ELSE
  183.      txt.frontPen := col;
  184.      txt.backPen  := 0;
  185.    END;
  186.    txt.iText := ADR(text);
  187.    IF INTEGER(ypos) < ((height-(INTEGER(scrFontYSize)+6)) DIV INTEGER(winFontXSize)) THEN
  188.      PrintIText(window^.rPort,ADR(txt),0,winFontYSize*ypos);
  189.      wtxt[ypos].col := col;
  190.      wtxt[ypos].rev := rev;
  191.      Copy(wtxt[ypos].txt,text);
  192.      INC(ypos);
  193.    END;
  194.  END OutputWin2;
  195.  
  196.  
  197.  PROCEDURE HandleAction2() : action2ptr;
  198.  
  199.  VAR    intuimsg    : IntuiMessagePtr;
  200.         code        : CARDINAL;
  201.         tagbuffer    : ARRAY [1..2*2] OF LONGCARD;
  202.  
  203.  BEGIN
  204.    intuimsg := GetMsg(window^.userPort);
  205.    WHILE intuimsg # NIL DO
  206.      IF intuimsg^.class = IDCMPFlagSet{closeWindow} THEN
  207.        ReplyMsg(intuimsg);
  208.        ActionMem.Action := close;
  209.        RETURN(ADR(ActionMem));
  210.      ELSIF intuimsg^.class = IDCMPFlagSet{refreshWindow} THEN
  211.        ReplyMsg(intuimsg);
  212.        wpos := ypos;
  213.        ypos := 0;
  214.        BeginRefresh(window);
  215.          REPEAT
  216.        OutputWin2(wtxt[ypos].txt,wtxt[ypos].col,wtxt[ypos].rev);
  217.      UNTIL ypos = wpos;
  218.        EndRefresh(window,TRUE);
  219.        ActionMem.Action := nothing;
  220.        RETURN(ADR(ActionMem));
  221.  (*    ELSIF intuimsg^.class = IDCMPFlagSet{} THEN *)
  222.      ELSE
  223.      END;
  224.      ReplyMsg(intuimsg);
  225.      intuimsg := GetMsg(window^.userPort);
  226.    END;
  227.    ActionMem.Action := nothing;
  228.    RETURN(ADR(ActionMem));
  229.  END HandleAction2;
  230.  
  231.  
  232.  PROCEDURE ClearWin2;
  233.  
  234.  BEGIN
  235.    SetAPen(window^.rPort,0);
  236.    SetDrMd(window^.rPort,DrawModeSet{});
  237.    RectFill(window^.rPort,left+4,top+INTEGER(scrFontYSize)+3,left+width-5,top+height-3);
  238.    SetAPen(window^.rPort,1);
  239.    ypos := 0;
  240.  END ClearWin2;
  241.  
  242.  
  243.  BEGIN
  244.    Assert(intuitionVersion >= 37,ADR("Es wird mindestens OS2.04 gebraucht!"));
  245.    GetDate(wt,tag,monat,jahr);
  246.  
  247.  END Window2.
  248.