MODULE M2Painter; (*--------------------------------------------------------------------------*) (* *) (* M2Painter Version 1.1d *) (* Das Amiga-Malprogramm in Modula-2 *) (* © April 1988 by Paul Lukowicz *) (* *) (* Geschrieben in M2Amiga Modula-2 mit Hilfe der *) (* AmigaTreasures-Biblitheksmodule *) (* *) (*--------------------------------------------------------------------------*) FROM WindowLib IMPORT ScrWin, CloseWin, backdrop, noSize, ClearWin, GetWinMouse, GetWinScr, GetWinRast, SimpleWin, noClose, noBack, WriteWin; FROM MenuLib IMPORT ReportMenu, SetTextItem, SimpleItem, noSub, SetExclude, InspMenu, SetMenu, SetImageItem; FROM WinGraphics IMPORT SetPixel, Line, Circle, Paint, Ellipse, Rectangle, Polygon, SetDrawMode, SetLinePattern, SetFillPattern, PatternRow, GetPenPos, GetPixel, SetPenPos, SetPens; FROM IntuitionL IMPORT DrawImage; FROM IntuitionD IMPORT WindowPtr, ImagePtr, ScreenPtr; FROM SYSTEM IMPORT CAST, LONGSET, ADR; FROM WinIOLib IMPORT ReportMButtons, InspMButtons, leftPress, noChange, ReportMouseDelta, rightPress, ReportChar, InspChar, wait, check, old; FROM ScreenLib IMPORT SetColReg, GetColReg; FROM UtilityLib IMPORT Coordinates, ColReg, ImageRow, MakeImage, UByte; FROM MathLib0 IMPORT sqrt; FROM GraphicsD IMPORT DrawModes, DrawModeSet, FontStyles, FontStyleSet, jam1, jam2; FROM GraphicsL IMPORT WritePixel, AreaEllipse, RectFill, SetSoftStyle; FROM FileSystem IMPORT Lookup, File, Response, WriteBytes, ReadBytes, Close; FROM WindowInOut IMPORT InitForIO, FinishIO, WWriteString, WReadString; FROM String IMPORT Occurs, Insert, Length; TYPE FillRow = ARRAY[0..3] OF PatternRow; BrushRow = RECORD Look : ARRAY[0..6] OF ImageRow; h, w : CARDINAL END; CONST invert = DrawModeSet{complement}; normal = DrawModeSet{dm0}; VAR Wind : WindowPtr; (* Pointer zum Fenster *) Extras,Menu,Item,SubItem : CARDINAL; (* Windowextras, Menuelemente *) Ende,FillFlag : BOOLEAN; (* Flags für beenden und fill *) CurrentColor : ColReg ; (* Die aktuele Farbe *) LPatterns : ARRAY[0..6] OF PatternRow;(* Linienmuster *) FPatterns : ARRAY[0..9] OF FillRow; (* Füllmuster *) Brush : ARRAY[0..5] OF BrushRow; (* Brushes *) Brushes : ARRAY[0..5] OF ImagePtr; (* Brushzeiger *) Buttons, PlaneSize : INTEGER; CurrentBrush : ImagePtr; (* Aktuelle Systembrush *) Style, StyleEna : FontStyleSet; PROCEDURE InitSystem ( Wind : WindowPtr; VAR Patterns : ARRAY OF PatternRow ); VAR S : ScreenPtr; BEGIN Patterns[0] :="AAAAAAAAAAAAAAAA"; (* Die verschiedenen Line-Patterns *) Patterns[1] :="A@@@A@@@A@@@A@@@"; Patterns[2] :="AA@@AA@@AA@@AA@@"; Patterns[3] :="AAAA@@@@AAAA@@@@"; Patterns[4] :="A@@@@@@@A@@@@@@A"; Patterns[5] :="AAAAAAAA@@@@@@@@"; SetLinePattern(Wind,Patterns[0]); FPatterns[0,0] :="AAAAAAAAAAAAAAAA"; (* Die verschiedenen Fill-Patterns *) FPatterns[0,1] :="AAAAAAAAAAAAAAAA"; FPatterns[0,2] :="AAAAAAAAAAAAAAAA"; FPatterns[0,3] :="AAAAAAAAAAAAAAAA"; FPatterns[1,0] :="AAAAAAAAAAAAAAAA"; FPatterns[1,1] :="@@@@@@@@@@@@@@@@"; FPatterns[1,2] :="AAAAAAAAAAAAAAAA"; FPatterns[1,3] :="@@@@@@@@@@@@@@@@"; FPatterns[2,0] :="AAAA@@@@@@@@AAAA"; FPatterns[2,1] :="@@@@AAAAAAAA@@@@"; FPatterns[2,2] :="@@@@AAAAAAAA@@@@"; FPatterns[2,3] :="AAAA@@@@@@@@AAAA"; FPatterns[3,0] :="AAAAAAAAAAAAAAAA"; FPatterns[3,1] :="@@AA@@AA@@AA@@AA"; FPatterns[3,2] :="AAAAAAAAAAAAAAAA"; FPatterns[3,3] :="@@AA@@AA@@AA@@AA"; FPatterns[4,0] :="@AA@@AA@@AA@@AA@"; FPatterns[4,1] :="@AA@@AA@@AA@@AA@"; FPatterns[4,2] :="@AA@@AA@@AA@@AA@"; FPatterns[4,3] :="@AA@@AA@@AA@@AA@"; FPatterns[5,0] :="AAAAAAAAAAAAAAAA"; FPatterns[5,1] :="@@@AA@@@@@@AA@@@"; FPatterns[5,2] :="A@@AA@@AA@@AA@@A"; FPatterns[5,3] :="@@@AA@@@@@@AA@@@"; FPatterns[6,0] :="@@@@AAAAAAAA@@@@"; FPatterns[6,1] :="AAAAAA@@@@AAAAAA"; FPatterns[6,2] :="AAAAAA@@@@AAAAAA"; FPatterns[6,3] :="@@@@AAAAAAAA@@@@"; FPatterns[7,0] :="AA@@@@@@AA@@@@@@"; FPatterns[7,1] :="@@AA@@@@@@AA@@@@"; FPatterns[7,2] :="@@@@AA@@@@@@AA@@"; FPatterns[7,3] :="@@@@@@AA@@@@@@AA"; FPatterns[8,0] :="A@@A@@A@@A@@A@@A"; FPatterns[8,1] :="@AA@AA@AA@AA@AA@"; FPatterns[8,2] :="A@@A@@A@@A@@A@@A"; FPatterns[8,3] :="@AA@AA@AA@AA@AA@"; FPatterns[9,0] :="AA@@@@@@@@@@@@AA"; FPatterns[9,1] :="@@AA@@@AA@@@AA@@"; FPatterns[9,2] :="@@@@AA@@@@AA@@@@"; FPatterns[9,3] :="@@@@@@AAAA@@@@@@"; Brush[0].Look[0] :="O"; (* Die vershiedenen "Brushes" *) Brush[0].h := 1; Brush[0].w :=1; Brush[1].Look[0] := "OOOO"; Brush[1].Look[1] := "OOOO"; Brush[1].h := 2; Brush[1].w :=4; Brush[2].Look[0] :="OOOOOOO"; Brush[2].Look[1] :="OOOOOOO"; Brush[2].Look[2] :="OOOOOOO"; Brush[2].h := 3; Brush[2].w :=6; Brush[3].Look[0] :="OOOOOOOOOOOOOOOO"; Brush[3].Look[1] :="OOOOOOOOOOOOOOOO"; Brush[3].Look[2] :="OOOOOOOOOOOOOOOO"; Brush[3].h := 3; Brush[3].w :=16; Brush[4].Look[0] :="OOOOOOOOOOOOOOOO"; Brush[4].h := 1; Brush[4].w :=16; Brush[5].h := 6; Brush[5].w :=16; Brush[5].Look[0] :="O@O@O@O@O@O@O@O@"; Brush[5].Look[1] :="@O@O@O@O@O@O@O@O"; Brush[5].Look[2] :="O@O@O@O@O@O@O@OO"; Brush[5].Look[3] :="@O@O@O@O@O@O@O@O"; Brush[5].Look[4] :="O@O@O@O@O@O@O@O@"; Brush[5].Look[5] :="@O@O@O@O@O@O@O@O"; S := GetWinScr(Wind); (* Farbregister des Screens initialisieren *) SetColReg(S,0,0,0,0);SetColReg(S,1,15,15,15);SetColReg(S,2,11,11,11); SetColReg(S,3,13,11,9);SetColReg(S,4,5,8,15);SetColReg(S,5,7,13,15); SetColReg(S,6,0,14,13);SetColReg(S,7,5,13,0);SetColReg(S,8,11,15,0); SetColReg(S,9,15,13,2);SetColReg(S,10,15,10,0);SetColReg(S,11,12,0,1); SetColReg(S,12,15,0,0);SetColReg(S,13,15,6,7);SetColReg(S,14,1,1,1); SetColReg(S,15,15,2,14); END InitSystem; PROCEDURE InitMenus ( Window : WindowPtr ); VAR n,j,i,k : [0..16]; ExList : LONGSET; Pat : ARRAY[0..9] OF ImageRow; Image : ImagePtr; BEGIN SetMenu(Window,0,"Project",0,60); (* 4 Menus erzeugen *) SetMenu(Window,1,"Draw Menu",100,100); SetMenu(Window,2,"Colors",230,90); SetMenu(Window,3,"Options",330,90); (* Menupunkte des Project-Menüs *) SimpleItem(Window,"Load","G",0,0,60,10,0,0,noSub); SimpleItem(Window,"Save","S",0,10,60,10,0,1,noSub); SimpleItem(Window,"New",CHR(0),0,20,60,10,0,2,noSub); SimpleItem(Window,"Quit",CHR(0),0,30,60,10,0,3,noSub); (* Menupunkte des Draw Menus *) SetTextItem(Window,"Draw ","",0,0,100,10,1,2,"D",0,1,NIL,1,0,noSub); SetTextItem(Window,"Box","",0,10,100,10,1,2,"B",0,1,NIL,1,1,noSub); SetTextItem(Window,"Line","",0,20,100,10,1,2,"L",0,1,NIL,1,2,noSub); SetTextItem(Window,"Circle","",0,30,100,10,1,2,"C",0,1,NIL,1,3,noSub); SetTextItem(Window,"Ellipse","",0,40,100,10,1,2,"E",0,1,NIL,1,4,noSub); SetTextItem(Window,"Polygon","",0,50,100,10,1,2,"Z",0,1,NIL,1,5,noSub); SetTextItem(Window,"Paint","",0,60,100,10,1,2,"P",0,1,NIL,1,6,noSub); SetTextItem(Window,"Write","",0,70,100,10,1,2,"W",0,1,NIL,1,7,noSub); SetTextItem(Window,"Color-Cycle","",0,80,100,10,1,2,"Y",0,1,NIL,1,8,noSub); (* Menüpunkte des Farbwahlmenu. Dies sind checkIt Items *) SetTextItem(Window," ","",0,0,40,10,2,3,CHR(0),0,0,NIL,2,0,noSub); j := 0; FOR n := 1 TO 15 DO i := n MOD 4; IF i = 0 THEN j := j +1 END; SetTextItem(Window," ","",i*40,j*12,40,10,2,3,CHR(0),n,n,NIL,2,n,noSub) END; SetTextItem(Window," ","",40,0,40,10,3,3,CHR(0),1,1,NIL,2,1,noSub); FOR n := 0 TO 15 DO (* Exclude bestimmen *) ExList := LONGSET{0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15} / LONGSET{n}; SetExclude(Window,2,n,noSub,ExList) END; (* Options Menupunkte *) SimpleItem(Window,"Line pattern",CHR(0),0,0,105,10,3,0,noSub); SimpleItem(Window,"Fill pattern",CHR(0),0,10,105,10,3,1,noSub); SimpleItem(Window,"Brushes",CHR(0),0,20,105,10,3,2,noSub); SimpleItem(Window,"Draw mode",CHR(0),0,30,105,10,3,3,noSub); SimpleItem(Window,"Styles",CHR(0),0,40,105,10,3,4,noSub); Pat[0] := "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@"; Pat[1] := Pat[0]; Pat[2] := Pat[0]; Pat[4] := Pat[0]; Pat[5] := Pat[0]; FOR n := 0 TO 4 DO (* 5 Line-Patterns Subitems erzeugen *) FOR j := 0 TO 15 DO (* Image Data für ein Pattern initialisieren *) Pat[3,j] := LPatterns[n,j]; Pat[3,16+j] := LPatterns[n,j] END; Image := MakeImage(Pat,0,0,32,6,4,1,0); IF n = 0 THEN k := 3 ELSE k := 2 END; SetImageItem(Window,Image,NIL,70,9*(n+1),50,9,k,2,CHR(0),3,0,n); SetExclude(Window,3,0,n,LONGSET{0,1,2,3,4,5}/LONGSET{n}); END; FOR n := 0 TO 9 DO (* 7 Fill-Pattern Subitems erzeugen *) FOR i := 0 TO 3 DO (* Image Data für ein Fill-Pattern initialisieren *) FOR j := 0 TO 15 DO Pat[i,j] := FPatterns[n,i,j]; Pat[i,16+j] := FPatterns[n,i,j]; Pat[4+i,j] := FPatterns[n,i,j]; Pat[4+i,16+j] := FPatterns[n,i,j] END END; Image := MakeImage(Pat,0,0,32,8,4,2,0); IF n = 0 THEN k := 3 ELSE k := 2 END; SetImageItem(Window,Image,NIL,70,10*(n+1),50,10,k,2,CHR(0),3,1,n); SetExclude(Window,3,1,n,LONGSET{0,1,2,3,4,5,6,7,8,9}/LONGSET{n}); END; FOR n := 0 TO 5 DO (* 5 Brushes Subitems erzeugen *) Brushes[n] := MakeImage(Brush[n].Look,0,0,Brush[n].w,Brush[n].h,4,2,0); IF n = 0 THEN k := 3 ELSE k := 2 END; SetImageItem(Window,Brushes[n],NIL,70,9*(n+1),50,9,k,2,CHR(0),3,2,n); SetExclude(Window,3,2,n,LONGSET{0,1,2,3,4}/LONGSET{n}); END; SetTextItem(Window,"Fill","",70,5,90,10,2,2,"F",0,1,NIL,3,3,0); SetTextItem(Window,"NoFill","",70,15,90,10,3,2,"N",0,1,NIL,3,3,1); SetExclude(Wind,3,3,0,LONGSET{1}); (* Fill und NoFill schließen sich aus *) SetExclude(Wind,3,3,1,LONGSET{0}); (* Style Subitems (Umschalten der Schriftarten *) SetTextItem(Window,"Plain","",70,0,100,10,3,2,CHR(0),0,1,NIL,3,4,0); SetTextItem(Window,"Bold","",70,10,100,10,2,2,CHR(0),0,1,NIL,3,4,1); SetTextItem(Window,"Italics","",70,20,100,10,2,2,CHR(0),0,1,NIL,3,4,2); SetTextItem(Window,"Underline","",70,30,100,10,2,2,CHR(0),0,1,NIL,3,4,3); SetExclude(Window,3,4,0,LONGSET{1,2,3}); FOR n := 1 TO 3 DO SetExclude(Window,3,4,n,LONGSET{0}) END; END InitMenus; (* Behandlung des Project Menus *) PROCEDURE Project(Item: CARDINAL; VAR Ende: BOOLEAN); PROCEDURE GetName(VAR s: ARRAY OF CHAR; f: BOOLEAN); (* Name des Files einlesen *) VAR W : WindowPtr; t : ARRAY[0..14] OF CHAR; BEGIN IF f THEN t := "Load Picture" ELSE t := "Save Picture" END; W := SimpleWin(Wind^.wScreen,t,150,95,300,30,noClose+noBack+noSize); InitForIO(W); (* Fenster als IO.Fenster initialisieren *) WWriteString(">"); WReadString(s); (* Filenamen einlesen *) FinishIO(W); CloseWin(W); END GetName; PROCEDURE Save; (* Ausführung des Menüpunktes save *) VAR f : File; i : INTEGER; j : LONGINT; Name : ARRAY[0..30] OF CHAR; BEGIN GetName(Name,FALSE); IF Length(Name) > 0 THEN Lookup(f,Name,0,TRUE); (* File zum schreiben öffnen *) IF f.res = done THEN (* File offen ? *) FOR i := 0 TO 3 DO (* Alle BitPlanes abspeichern *) WriteBytes(f,Wind^.wScreen^.bitMap.planes[i],PlaneSize,j) END; Close(f) END END END Save; PROCEDURE Load; VAR f : File; i : INTEGER; j : LONGINT; Name : ARRAY[0..30] OF CHAR; BEGIN GetName(Name,TRUE); IF Length(Name) > 0 THEN Lookup(f,Name,0,FALSE); (* File zum Lesen öffnen *) IF f.res = done THEN (* File offen ? *) FOR i := 0 TO 3 DO (* Alle BitPlanes laden *) ReadBytes(f,Wind^.wScreen^.bitMap.planes[i],PlaneSize,j) END; Close(f) END END END Load; BEGIN CASE Item OF 0: Load | 1: Save | 2: ClearWin(Wind) | (* Bei New Fenster löschen *) 3: Ende := TRUE (* Bei Ende, Ende Flag setzen *) END END Project; (*--------------------Behandlung des Draw Menus-------------------------------*) PROCEDURE DrawMenu(Item,SubItem: CARDINAL); PROCEDURE Draw; (* Ausführung des Menupunktes Draw *) VAR x,y : INTEGER; (* Position des Mauszeigers *) ImCol : POINTER TO UByte; BEGIN WHILE InspMButtons(Wind,wait) # leftPress DO (* auf linke Taste warten *) END; ImCol := ADR(CurrentColor); CurrentBrush^.planePick := ImCol^; ReportMouseDelta(Wind,TRUE); (* Bewegung der Maus wird auch gemeldet *) LOOP (* Punkte an der Zeigerposition zeichnen bis linke Taste gedrückt *) IF InspMButtons(Wind,wait) = leftPress THEN EXIT END; GetWinMouse(Wind,x,y); (* Mausposition *) DrawImage(Wind^.rPort,CurrentBrush,x,y) (* Punkt setzen *) END; ReportMouseDelta(Wind,FALSE); (* Bewegung der Mouse nicht melden *) CurrentBrush^.planePick := 2; END Draw; PROCEDURE PutLine; (* Ausführung des Menupunktes Line *) VAR x,y,ToX,ToY : INTEGER;(* Anfangs und End Koordinaten der Linie *) BEGIN x := InspMButtons(Wind,wait); (* auf linke Taste warten *) GetWinMouse(Wind,x,y); (* Mouseposition merken, mit Punkt makieren *) SetPixel(Wind,x,y,CurrentColor); ToX := x; ToY := y; SetDrawMode(Wind,invert); (* Linien werden invers gezeichnet *) ReportMouseDelta(Wind,TRUE); (* Mausbewegung melden *) WHILE InspMButtons(Wind,wait) # leftPress DO (* bis linke Taste gedrückt *) Line(Wind,x,y,ToX,ToY,CurrentColor); (* Linie löschen *) GetWinMouse(Wind,ToX,ToY); (* Mausposition *) Line(Wind,x,y,ToX,ToY,CurrentColor) (* Linie zeichnen *) END; ReportMouseDelta(Wind,FALSE); SetDrawMode(Wind,normal); (* Zeichenmodus wieder normal *) Line(Wind,x,y,ToX,ToY,CurrentColor); (* Linie Zeichnen *) END PutLine; PROCEDURE Box; (* Ausführung des Menüpunktes Box *) VAR x, y, dx, dy: INTEGER;(* Linke obere und rechte untere Ecke des Rechtecks *) BEGIN WHILE InspMButtons(Wind,wait) # leftPress DO (* Auf linke Taste warten *) END; GetWinMouse(Wind,x,y); (* Mouseposition merken, mit Punkt makieren *) SetPixel(Wind,x,y,CurrentColor); dx := x; dy := y; SetDrawMode(Wind,invert); ReportMouseDelta(Wind,TRUE); WHILE InspMButtons(Wind,wait) # leftPress DO Rectangle(Wind,x,y,dx-x,dy-y,CurrentColor,FALSE); (* Rechteck löschen *) GetWinMouse(Wind,dx,dy); (* neue Größe holen *) Rectangle(Wind,x,y,dx-x,dy-y,CurrentColor,FALSE); (* Rechteck zeichnen *) END; ReportMouseDelta(Wind,FALSE); SetDrawMode(Wind,normal); (* Zeichenmodus normal*) Rectangle(Wind,x,y,dx-x,dy-y,CurrentColor,FillFlag) (* Rechteck zeichnen *) END Box; PROCEDURE ACircle; (* Ausführung des Menüpunktes Circle *) VAR x, y, r1, r2 : INTEGER; r : CARDINAL; rr : REAL; PROCEDURE GetRadius(x, y : INTEGER) : CARDINAL; (* neneun Radies finden *) BEGIN GetWinMouse(Wind,r1,r2); (* Mausposition *) r1 := x - r1; r2 := y - r2; (* Veänderung berechnen *) rr := sqrt(FLOAT(r1 * r1 + r2*r2));(* Radius berechnen *) RETURN ABS(TRUNC(rr)) END GetRadius; BEGIN WHILE InspMButtons(Wind,wait) # leftPress DO END; GetWinMouse(Wind,x,y); SetPixel(Wind,x,y,CurrentColor); (* Mittelpunkt makieren *) r := 0; SetDrawMode(Wind,invert); ReportMouseDelta(Wind,TRUE); WHILE InspMButtons(Wind,wait) # leftPress DO ReportMouseDelta(Wind,FALSE); Circle(Wind,x,y,r,CurrentColor,FALSE); (* Kreis löschen *) r := GetRadius(x,y); (* neuen Radius holen *) Circle(Wind,x,y,r,CurrentColor,FALSE); (* Kreis mit dem nuen Radius *) ReportMouseDelta(Wind,TRUE); END; ReportMouseDelta(Wind,FALSE); SetDrawMode(Wind,normal); (* Zeichenmodus normal *) Circle(Wind,x,y,r,CurrentColor,FillFlag); (* Kreis Zeichnen *) END ACircle; PROCEDURE AEllipse; (* Ausführung des Menupunktes Ellipse *) VAR x, y, r1, r2 : INTEGER; BEGIN WHILE InspMButtons(Wind,wait) # leftPress DO END; GetWinMouse(Wind,x,y); SetPixel(Wind,x,y,CurrentColor); (* Mouseposition merken, makieren *) r1 := 0; r2 := 0; SetDrawMode(Wind,invert); (* Zeichenmodus invers *) ReportMouseDelta(Wind,TRUE); WHILE InspMButtons(Wind,wait) # leftPress DO ReportMouseDelta(Wind,FALSE); Ellipse(Wind,x,y,r1,r2,CurrentColor,FALSE); (* Ellipse löschen *) GetWinMouse(Wind,r1,r2); (* neuen Radius ermitteln *) r1 := ABS(x-r1); r2 := ABS(y-r2); Ellipse(Wind,x,y,r1,r2,CurrentColor,FALSE); (* Ellipse Zeichnen *) ReportMouseDelta(Wind,TRUE); END; ReportMouseDelta(Wind,FALSE); SetDrawMode(Wind,normal); (* Zeichenmodus Normal *) Ellipse(Wind,x,y,r1,r2,CurrentColor,FillFlag);(* Ellipse Zeichnen *) END AEllipse; PROCEDURE Poly; (* Ausführung des menupunktes Polygon *) VAR Pos : ARRAY[1..50] OF Coordinates; Buttons ,n : INTEGER; BEGIN n := 0; (* Eckenzahl 0 *) Buttons := 0; SetDrawMode(Wind,invert); (* Zeichenmodus invers *) Buttons := InspMButtons(Wind,wait); n := n+1; GetWinMouse(Wind,Pos[n].xK,Pos[n].yK); GetWinMouse(Wind,Pos[n+1].xK,Pos[n+1].yK); Polygon(Wind,Pos,n+1,CurrentColor,FALSE); (* Polygon zeichnen *) ReportMouseDelta(Wind,TRUE); WHILE (Buttons # rightPress) AND (n < 50) DO Buttons := InspMButtons(Wind,wait); (* Zustand der Maustasten *) ReportMouseDelta(Wind,FALSE); Polygon(Wind,Pos,n+1,CurrentColor,FALSE); (* Polygon löschen *) IF Buttons = leftPress THEN (* Linke Taste ? *) n := n+1 (* Ecke merken *) END; GetWinMouse(Wind,Pos[n+1].xK,Pos[n+1].yK); Polygon(Wind,Pos,n+1,CurrentColor,FALSE); (* Polygon zeichnen *) ReportMouseDelta(Wind,TRUE) END; Polygon(Wind,Pos,n+1,CurrentColor,FALSE); (* Polygon löschen *) ReportMouseDelta(Wind,FALSE); SetDrawMode(Wind,normal); (* Zeichenmodus normal *) SetPens(Wind,CurrentColor,0,CurrentColor); Polygon(Wind,Pos,n,CurrentColor,FillFlag) (* Polygon zeichnen *) END Poly; PROCEDURE AFill; (* Ausführung des Menüpunktes Paint *) VAR x,y : INTEGER; (* Position des Mauszeigers *) BEGIN WHILE InspMButtons(Wind,wait) # leftPress DO END; GetWinMouse(Wind,x,y); (* Mausposition holen *) Paint(Wind,x,y,CurrentColor,FALSE); (* Bereich drumherum füllen *) END AFill; PROCEDURE Write; (* Ausführung des Menüpunktes Write *) VAR x, y : INTEGER; (* Position des Mauszeigers *) a : ARRAY[0..1] OF CHAR; BEGIN a[1] := CHR(0); WHILE InspMButtons(Wind,wait) # leftPress DO END; GetWinMouse(Wind,x,y); (* Mausposition holen *) a[0] := CHR(0); ReportChar(Wind,TRUE); SetDrawMode(Wind,jam1); WHILE (a[0] # CHR(13)) AND (x < 620) DO(* Solnage "Return" nicht gedrückt*) a[0] := InspChar (Wind,wait); IF a[0] = CHR(8) THEN (* Backspace ? *) x := ABS(x - 8); (* Ja -> leztes Zeichen löschen. *) WriteWin(Wind," ",x,y,CurrentColor,0); SetPenPos(Wind,x,y) END; IF (a[0] # CHR(13)) AND (a[0] # CHR(8)) THEN WriteWin(Wind,a,x,y,CurrentColor,0) END; GetPenPos(Wind,x,y) END; ReportChar(Wind,FALSE); SetDrawMode(Wind,normal) END Write; PROCEDURE Cycle; (* Ausführung des Menüpunktes Col-Cycle *) VAR r,r1, g,g1, b,b1, i,j : CARDINAL; S : ScreenPtr; BEGIN S := GetWinScr(Wind); REPEAT GetColReg(S,0,r1,g1,b1); FOR i := 0 TO 15 DO (* Alle Farbregister *) GetColReg(S,(i+1) MOD 16,r1,g1,b1); SetColReg(S,(i+1) MOD 16,r,g,b); r := r1; g := g1; b := b1 END; FOR j := 0 TO 5000 DO END UNTIL InspMButtons(Wind,check)#noChange; (* bis linke Maustaste *) InitSystem(Wind,LPatterns) END Cycle; BEGIN ReportMButtons(Wind,TRUE,TRUE); (* linke Taste abfangen *) CASE Item OF (* Je nach Itemwahl die entsprechende Prozedur aufrufen *) 0: Draw | (* Freihandzeichnen *) 1: Box | (* Rechteck *) 2: PutLine | (* Linie *) 3: ACircle | (* Kreis *) 4: AEllipse | (* Ellypse *) 5: Poly | (* Polygon *) 6: AFill | (* Ausmalen *) 7: Write | (* Textausgabe *) 8: Cycle (* Color-Cycle ausführen *) END; ReportMButtons(Wind,FALSE,FALSE); (* keine Abfrage der Maustasten *) END DrawMenu; (*------------------------------------------------------------------------*) BEGIN (* Hauptprogramm: Initialiserung + Menuabfrage *) Extras := backdrop + noSize; (* backdrop und ohne sizing Gadget *) Wind := ScrWin("M2Painter Version 1.1d © 1988 by Paul Lukowicz",0,0,640, 256,2,4,Extras); WriteWin(Wind,"Bitte warten, System wird initialisiert !!!",140,120,1,0); WITH Wind^.rPort^.bitMap^ DO (* Größe der Bitplane berechnen *) PlaneSize := CAST(INTEGER,bytesPerRow*rows) END; InitSystem(Wind,LPatterns); (* Menus Aufbauen *) InitMenus(Wind); ReportMenu(Wind,TRUE); (* Menuabfrage anfordern *) Ende := FALSE; (* Systemflags initialisieren *) FillFlag := FALSE; CurrentColor := 1; (* Default Color setzen *) ClearWin(Wind); (* Fensterinhalt löschen *) Menu := 5; CurrentBrush := Brushes[1]; WHILE NOT Ende DO(* Hauptschleife. Soloange durchlaufen bis Ende ausgewählt *) InspMenu(Wind,wait,Menu,Item,SubItem); CASE Menu OF (* Auswertung der Menuwahl *) 0: Project(Item,Ende)| (* Behandlung des Project Menus *) 1: DrawMenu(Item,SubItem)| (* Behandlung des Draw Menus *) 2: CurrentColor := Item| (* Farbwahl treffen *) 3: CASE Item OF 0: SetLinePattern(Wind,LPatterns[SubItem]) | (* neues Line-Pattern *) 1: SetFillPattern(Wind,FPatterns[SubItem],4) | (* neues Fill-Pattern *) 2: CurrentBrush := Brushes[SubItem] | (* neues Zeichenmuster *) 3: IF SubItem = 0 THEN (* füllen /nicht füllen *) FillFlag := TRUE ELSE FillFlag := FALSE END | 4: CASE SubItem OF (* Schriftart umschalten *) 0: Style := FontStyleSet{ }; StyleEna := FontStyleSet{bold,italic,underlined} | 1: Style := FontStyleSet{bold}; StyleEna := Style | 2: Style := FontStyleSet{italic}; StyleEna := Style | 3: Style := FontStyleSet{underlined}; StyleEna := Style END; Style := SetSoftStyle(Wind^.rPort,Style,StyleEna) END ELSE Ende := FALSE (* keine Wahl, nichts tun *) END; END; CLOSE CloseWin(Wind) (* Fenster schließen, Programm beenden *) END M2Painter.