(* 
MemMonII  Copyright by Andreas Gunßer, Großheppacherstr. 34,
                                       D-7056 Weinstadt-Endersbach,
                                       West-Germany

History-list:
  12-Oct-1990 -- Version 2.0 by Andreas Gunßer

                   
for more information refer to MemMonII.doc
*)                                     


MODULE MemMonII;

FROM SYSTEM       IMPORT ADR;
FROM Intuition    IMPORT NewWindow,WindowPtr,WindowFlags,WindowFlagSet,
                         IDCMPFlags,IDCMPFlagSet,ScreenFlagSet,wbenchScreen,
                         OpenWindow,CloseWindow,IntuiText,PrintIText,SizeWindow,
                         SetWindowTitles,IntuiMessage,
                         OpenIntuition,IntuitionBase;
FROM Exec         IMPORT GetMsg,ReplyMsg;
FROM Arts         IMPORT Assert;
FROM Dos          IMPORT Delay;
FROM Conversions  IMPORT ValToStr;
FROM Strings      IMPORT Insert;
FROM Heap         IMPORT Available;
FROM Graphics     IMPORT jam1,RastPortPtr,WritePixel,ScrollRaster,SetAPen;

TYPE String    = ARRAY [0..100] OF CHAR;

VAR Window        : NewWindow;
    WindowPter    : WindowPtr;
    class         : IDCMPFlagSet;
    IntuiMsg      : POINTER TO IntuiMessage;
    WindowTitle   : String;
    lauf          : LONGCARD;
    IntuiPtr      : POINTER TO IntuitionBase;
    actWindowPter : WindowPtr;
    WindowLarge   : BOOLEAN; (* TRUE = large, FALSE = klein*)        
    gesSpeicher   : LONGINT;
        
(* ---------------------------------------------------------------------------*)
(* -------------------------- Prozeduren -------------------------------------*)

PROCEDURE DumpGraphic (Speicher : LONGINT);
VAR wrPort    : RastPortPtr;
    dummyint  : INTEGER;
    speicherx : LONGINT;
       
BEGIN (* DumpGraphic *)          
  Speicher := Speicher DIV 2;
  wrPort := WindowPter^.rPort;
  SetAPen (wrPort,3);
  speicherx := (30 - (Speicher DIV 50000));
  IF (speicherx < 1) THEN 
    speicherx := 1;
  ELSIF (speicherx > 29) THEN 
    speicherx := 29;
  END (* IF *);    
  dummyint := WritePixel (wrPort,540,speicherx);
  dummyint := WritePixel (wrPort,541,speicherx);
  ScrollRaster (wrPort,2,0,175,11,542,29);
END DumpGraphic;
                                        
    
PROCEDURE Credits;
VAR TextZeile1,
    TextZeile2,
    TextZeile3    : IntuiText;
    TextZeile1Txt,
    TextZeile2Txt,
    TextZeile3Txt : ARRAY [0..50] OF CHAR;

BEGIN (* Credits *)
  Delay (5);
  TextZeile1Txt := "Memory Monitor";
  WITH TextZeile1 DO
    frontPen    := 3;
    backPen     := 0;
    drawMode    := jam1;
    leftEdge    := 28;
    topEdge     := 11;
    iTextFont   := NIL;
    iText       := ADR (TextZeile1Txt);
    nextText    := ADR (TextZeile2);
  END (* WITH *);
  
  TextZeile2Txt := "programmed by ";
  WITH TextZeile2 DO
    frontPen    := 3;
    backPen     := 0;
    drawMode    := jam1;
    leftEdge    := 28;
    topEdge     := 20;
    iTextFont   := NIL;
    iText       := ADR (TextZeile2Txt);
    nextText    := ADR (TextZeile3);
  END (* WITH *);    
  
  TextZeile3Txt := "Andreas Gunßer";
  WITH TextZeile3 DO
    frontPen    := 3;
    backPen     := 0;
    drawMode    := jam1;
    leftEdge    := 28;
    topEdge     := 30;
    iTextFont   := NIL;
    iText       := ADR (TextZeile3Txt);
    nextText    := NIL;
  END (* WITH *);
  
  PrintIText (WindowPter^.rPort,ADR (TextZeile1),0,0);  
   TextZeile1.frontPen := 2;
   TextZeile2.frontPen := 2;
   TextZeile3.frontPen := 2;
  PrintIText (WindowPter^.rPort,ADR (TextZeile1),1,1);     
END Credits;   
    
            

PROCEDURE CloseDown;
BEGIN
  CloseWindow (WindowPter);
END CloseDown;  


PROCEDURE DumpMem (WhichWindow : WindowPtr) : LONGINT;
VAR chipav,
    fastav,
    totalav        : LONGINT;
    SpeicherString : ARRAY [0..99] OF CHAR;
    chipstring,
    faststring,
    totalstring    : ARRAY [0..10] OF CHAR;
    dummychar      : CHAR;
    dummybool      : BOOLEAN;
    ScreenString   : ARRAY [0..79] OF CHAR;
    
BEGIN (* DumpMem *)
  chipav  := Available (TRUE);
  totalav := Available (FALSE);
  fastav  := totalav-chipav;
  dummychar := " ";
  ScreenString := "MemMon    © Copyright 15-Aug-1990 by Andreas Gunßer"; 
  ValToStr (chipav,TRUE,chipstring,10,10,dummychar,dummybool);
  ValToStr (fastav,TRUE,faststring,10,10,dummychar,dummybool);
  ValToStr (totalav,TRUE,totalstring,10,10,dummychar,dummybool);
  Insert (SpeicherString,0,"Total =");
  Insert (SpeicherString,7,totalstring);
  Insert (SpeicherString,18,"Fast =");
  Insert (SpeicherString,24,faststring);
  Insert (SpeicherString,35,"Chip =");
  Insert (SpeicherString,41,chipstring);
  SetWindowTitles (WhichWindow,ADR (SpeicherString),ADR (ScreenString));
  RETURN (totalav);
END DumpMem;
  
(* ---------------------------------------------------------------------------*)
(* --------------------------------- MemMon ----------------------------------*)


BEGIN (* MemMon *)
  IntuiPtr := OpenIntuition ();
  lauf := 1;
  WindowLarge := FALSE;
  WindowTitle := "MemMon © by Angus";
  WITH Window DO
    leftEdge    := 0;
    topEdge     := 0;
    width       := 550;
    height      := 10;
    detailPen   := 0;
    blockPen    := 1;
    idcmpFlags  := IDCMPFlagSet {closeWindow,menuPick,menuVerify};
    flags       := WindowFlagSet {windowDrag,windowDepth,windowClose,
                                  activate};
    firstGadget := NIL;
    checkMark   := NIL;
    title       := ADR (WindowTitle);
    bitMap      := NIL;
    type        := ScreenFlagSet {wbenchScreen};
    minWidth    := 220;
    maxWidth    := 550; 
    minHeight   := 10;
    maxHeight   := 40; 
  END;
 
  WindowPter := OpenWindow (Window);
  Assert (WindowPter # NIL, ADR ("Window nicht zu öffnen"));
  
  
  LOOP
    REPEAT
      lauf := (lauf +1);
      actWindowPter := IntuiPtr^.activeWindow;
      IF (lauf > 4000000000) THEN
        lauf := 1;
      ELSIF ((lauf MOD 25) = 0) THEN
        gesSpeicher := DumpMem (WindowPter);
        IF (WindowLarge = TRUE) THEN
          DumpGraphic (gesSpeicher);
        END (* IF *)  
      END;
      Delay (2);
      IntuiMsg := GetMsg (WindowPter^.userPort);
      WHILE IntuiMsg # NIL DO
        class := IntuiMsg^.class;
        ReplyMsg (IntuiMsg);
        IF (closeWindow IN class) THEN
          EXIT;
        ELSIF ((menuPick IN class) AND (WindowLarge = FALSE)) THEN
          SizeWindow (WindowPter,0,30);
          Credits;
          WindowLarge := TRUE;
        ELSIF ((menuPick IN class) AND (WindowLarge = TRUE)) THEN
          SizeWindow (WindowPter,0,-30);
          WindowLarge := FALSE;
        END (* IF *);
        IntuiMsg := GetMsg (WindowPter^.userPort);
      END (* WHILE *);
    UNTIL (lauf > 4000000005);
  END (* LOOP*);

  CloseDown;
END MemMonII.