(*********************************************************************
 
   -:Program.  	 show4096.mod
   -:Author.   	 Pit Burkhardt  
    :Address.    Stettinerstraße 25 7030 Böblingen
    :Phone.      ----
   -:shortcut. 	 [pit]
   -:Version.  	 1.0   
   -:Date.     	 01.03.1988
   -:Copyright.  PD
   -:Language. 	 Modula-II
   -:Translator. M2Amiga
   -:Imports.	 ----
   -:UpDate.	 ----
   -:Contents.	 Hold And Modify Demo
    :Remark.	 "AMOK - Amiga Modula-2 Klub / Stuttgart"
    
**********************************************************************
Kleines Demo-Programm zeigt den Hold-and-Modify (HAM) Mode des AMIGA.
Dieser Mode stellt uns 16 frei wählbare Farben zur Verfügung (0-15), 
die übrigen 48 Farben (16-63) modifizieren die Farbe im Pixel links 
des Pixels mit der "Modifikations-Farbe".
In diesem Demo wird für die frei wählbaren Farben eine Blau-Abstufung
gewählt. 
**********************************************************************)
MODULE show4096;

FROM SYSTEM IMPORT	ADDRESS, ADR;

FROM Arts IMPORT	Assert, TermProcedure;

FROM Intuition IMPORT	NewWindow, WindowPtr, OpenWindow, OpenScreen, 
			CloseWindow, IDCMPFlags, IDCMPFlagSet, WindowFlags, 
                        WindowFlagSet, ScreenFlags,ScreenFlagSet, NewScreen,
                        ScreenPtr, customScreen, CloseScreen, RemakeDisplay,
                        stdScreenHeight; 

FROM Graphics IMPORT	RastPortPtr, ViewPortPtr, ViewModeSet, ViewModes,
			TextAttr, FontStyleSet, FontFlagSet, RectFill, 
                        SetDrMd, jam1, SetAPen, SetRGB4;
	

VAR			rp		:RastPortPtr;
			vp		:ViewPortPtr;
			nWindow		:NewWindow;
        		nScreen		:NewScreen;   	 
			WindowP		:WindowPtr;
        		ScreenP		:ScreenPtr;
        		TAttr		:TextAttr;
        	

PROCEDURE CleanUp;
 BEGIN
  IF WindowP<>NIL THEN CloseWindow(WindowP) END;
  IF ScreenP<>NIL THEN CloseScreen(ScreenP) END;
  RemakeDisplay; 		
 END CleanUp;

PROCEDURE MakeScreen;
  BEGIN
   WITH TAttr DO
   	name:=ADR("topaz.font");
        ySize:=8;
        style:=FontStyleSet{};
        flags:=FontFlagSet{};
   END; (*WITH*)
   WITH nScreen DO
  	leftEdge:=0;	topEdge:=0;
        width:=320;	height:=256; 	(*stdScreenHeight;*)
        depth:=6;
        detailPen:=0;	blockPen:=1;
        viewModes:=ViewModeSet{ham};	(*extraHalfbrite, hires, lace*)
        type:=customScreen;		(*ScreenFlagSet{customBitMap};*)
        font:=ADR(TAttr);
        defaultTitle:=ADR("Screen Titel");
        gadgets:=NIL;
        customBitMap:=NIL;
   END; (*WITH*)
   ScreenP:=OpenScreen(nScreen);
   Assert(ScreenP<>NIL,ADR("konnte den HAM-Screen nicht öffnen"));
   vp:=ADR(ScreenP^.viewPort);
  END MakeScreen;
VAR	i	:LONGCARD;
  
PROCEDURE MakeWindow(titel: ADDRESS);
 CONST	Lagex=0;	Lagey=10;	Breite=320;	Hoehe=190;
 BEGIN
  TermProcedure(CleanUp);
  WITH nWindow DO
  	leftEdge:=Lagex;	topEdge:=Lagey; 
  	width:=Breite; 		height:=Hoehe;
  	detailPen:=0; 
  	blockPen:=1;
  	idcmpFlags:=IDCMPFlagSet{closeWindow};  
  	flags:=WindowFlagSet{	windowSizing, windowDrag, windowDepth,
        			gimmeZeroZero, activate, noCareRefresh	};
  	title:=titel;
  	type:=customScreen;	(*ScreenFlagSet{wbenchScreen};*)
  	firstGadget:=NIL; 
  	checkMark:=NIL; 
  	screen:=ScreenP; 
  	bitMap:=NIL;
  	minWidth:=5;     	
  	minHeight:=5; 		
  	maxWidth:=320; 		
  	maxHeight:=256;		
  END; (*WITH*)
  WindowP:=OpenWindow(nWindow);
  Assert(WindowP<>NIL,ADR("konnte Fenster nicht öffnen"));	
  rp:=WindowP^.rPort
END MakeWindow;

PROCEDURE SetUpColors;		(* legt den Blauverlauf auf die Farben 0-15 *)
 BEGIN
 FOR i:=0 TO 15 DO
 	SetRGB4(vp,i,0,0,i);
 END; (*FOR*)
 END SetUpColors;

(* 
Die Procedure Make4096 zeichnet die Boxes mit den jeweiligen Farben. Die Boxes
haben zum Teil die Größe von nur einem Pixel, man hätte sie also auch mit
WritePixel setzen können, aber so kann man das Programm leichter modifizieren.
*)

PROCEDURE Make4096;
 VAR	blue,red,green,y1,y2,x1,x2,xx1,xx2	:CARDINAL; 
 BEGIN 
 SetUpColors;
 SetDrMd(rp, jam1);
 FOR blue:=0 TO 15 DO
   SetAPen(rp, blue);
   y1:=10+2*blue;
   y2:=y1+1;
   RectFill(rp, 16,y1 , 303, y2);
   FOR red:=0 TO 15 DO
 	SetAPen(rp, 32+red);
        x1:=17+18*red;
        x2:=x1;
        RectFill(rp,x1 , y1, x2, y1);
   	FOR green:=0 TO 15 DO
        	SetAPen(rp, 48+green);
                xx1:=x1+1+green;
                xx2:=xx1;
                RectFill(rp,xx1 , y1, xx2, y1);
   	END; (*FOR green*)
   END; (*FOR red*)
 END; (*FOR blue*)
 END Make4096;
   
BEGIN
 MakeScreen;				(* --> Screen öffnen		*)
 MakeWindow(ADR('SimpleWindow'));	(* --> Window öffnen		*)
 Make4096;				(* --> Malen...			*)
 FOR i:=0 TO 2000000 BY 1 DO  END;	(* --> ..und warten		*) 
END show4096.