MODULE M2Painter; (*--------------------------------------------------------------------------*) (* *) (* M2Painter Version 2.0d *) (* Das Amiga-Malprogramm in Modula-2 *) (* © Juli 1989 by Paul Lukowicz *) (* *) (* Geschrieben in M2Amiga Modula-2 mit Hilfe der *) (* AmigaTreasures und FileTreasures-Biblitheksmodule *) (* *) (*--------------------------------------------------------------------------*) (* Compileroptionen *) (* $F- $R- $S- $V- $N- *) FROM Arts IMPORT TermProcedure; 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 ImageIOLib IMPORT LoadWin, SaveWin, LoadWinCol, SaveWinCol, LMinTerm; FROM Intuition IMPORT WindowPtr, ImagePtr, ScreenPtr, DrawImage, SetMenuStrip, ClearMenuStrip; FROM SYSTEM IMPORT CAST, LONGSET, ADR, ADDRESS, BYTE; FROM Exec IMPORT UByte; FROM WinIOLib IMPORT ReportMButtons, InspMButtons, leftPress, ReportMouseDelta, rightPress, ReportChar, InspChar, wait, check, old, sleep; FROM ScreenLib IMPORT SetColReg, GetColReg; FROM UtilityLib IMPORT Coordinates, ColReg, ImageRow, MakeImage; FROM MathLib0 IMPORT sqrt; FROM Graphics IMPORT WritePixel, AreaEllipse, RectFill, DrawModes, DrawModeSet, SetSoftStyle, FontStyles, FontStyleSet, jam1, jam2, BltBitMap; FROM FileSystem IMPORT Lookup, File, Response, WriteBytes, ReadBytes, Close; FROM WindowInOut IMPORT InitForIO, FinishIO, WWriteString, WReadString; FROM Icon IMPORT GetDiskObject; FROM Strings IMPORT Occurs, Insert, Length; FROM Workbench IMPORT DiskObjectPtr; TYPE FillRow = ARRAY[0..3] OF PatternRow; BrushRow = RECORD Look : ARRAY[0..6] OF ImageRow; h, w : CARDINAL END; SmallSet = SET OF [0..7]; CONST invert = DrawModeSet{complement}; normal = DrawModeSet{dm0}; WinWidth = 640; WinHeight = 256; 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 : INTEGER; CurrentBrush : ImagePtr; (* Aktuelle Systembrush *) Style, StyleEna : FontStyleSet; BlitPat : BYTE; BlitModes : ARRAY[0..6] OF UByte; BlitPlanes : UByte; a : ARRAY[0..3] OF CHAR; succ : BOOLEAN; Men : ADDRESS; PROCEDURE InitSystem ( Wind : WindowPtr; VAR Patterns : ARRAY OF PatternRow ); VAR S : ScreenPtr; BEGIN (* Die Konstanten für verschiedene Blittermodi *) BlitModes[0] := 192; BlitModes[1] := 48; BlitModes[2] := 128; BlitModes[3] := 224; BlitModes[1] := 16; BlitModes[2] := 112; BlitPat := BlitModes[0]; (* Default Blittermodus (Kopieren) *) BlitPlanes := 15; (* Alle Bitplanes *) 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,100); (* 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,100,10,0,0,noSub); SimpleItem(Window,"Load Colors",CHR(0),0,10,100,10,0,1,noSub); SimpleItem(Window,"Load Part",CHR(0),0,20,100,10,0,2,noSub); SimpleItem(Window,"Load Icon",CHR(0),0,30,100,10,0,3,noSub); SimpleItem(Window,"Save All","S",0,40,100,10,0,4,noSub); SimpleItem(Window,"Save Part",CHR(0),0,50,100,10,0,5,noSub); SimpleItem(Window,"Save Colors",CHR(0),0,60,100,10,0,6,noSub); SimpleItem(Window,"New",CHR(0),0,70,100,10,0,7,noSub); SimpleItem(Window,"Quit",CHR(0),0,80,100,10,0,8,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); SetTextItem(Window,"Change","",0,90,100,10,1,2,CHR(0),0,1,NIL,1,9,noSub); SetTextItem(Window,"Copy","",0,100,100,10,1,2,CHR(0),0,1,NIL,1,10,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; SetTextItem(Window,"Edit Colors","",0,50,160,12,2,3,"U",0,1,NIL,2,16,noSub); (* 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); SimpleItem(Window,"Blitt Mode",CHR(0),0,50,105,10,3,5,noSub); SimpleItem(Window,"Blitt Planes",CHR(0),0,60,105,10,3,6,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; (* Subitems für Blittermodi erzeugen *) SetTextItem(Window,"Normal","",70,0,100,10,3,2,CHR(0),0,1,NIL,3,5,0); SetTextItem(Window,"Not Source","",70,10,100,10,2,2,CHR(0),0,1,NIL,3,5,1); SetTextItem(Window,"And","",70,20,100,10,2,2,CHR(0),0,1,NIL,3,5,2); SetTextItem(Window,"Or","",70,30,100,10,2,2,CHR(0),0,1,NIL,3,5,3); SetTextItem(Window,"Nor","",70,40,100,10,2,2,CHR(0),0,1,NIL,3,5,4); SetTextItem(Window,"Nand","",70,50,100,10,2,2,CHR(0),0,1,NIL,3,5,5); SetExclude(Window,3,5,0,LONGSET{1,2,3,4,5}); FOR n := 1 TO 5 DO SetExclude(Window,3,5,n,LONGSET{0}) END; a[1] := 0C; FOR n := 0 TO 3 DO (* Subitems für Bitplaneauswahl erzeugen *) a[0] := CHR(48+n); SetTextItem(Window,a,"",70,n*10,30,10,3,2,CHR(0),0,1,NIL,3,6,n); (*SetExclude(Window,3,6,n,LONGSET{n})*) END; END InitMenus; PROCEDURE MarkSqr ( VAR x, y, dx, dy : INTEGER ); (* Läßt einen Auschnitt des Bildes makieren und gibt die Maße zurück *) BEGIN ReportMouseDelta(Wind,TRUE); ReportMButtons(Wind,TRUE,FALSE); 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); Rectangle(Wind,x,y,dx-x,dy-y,CurrentColor,FALSE); (* Rechteck löschen *) dx := dx - x; dy := dy - y; SetDrawMode(Wind,normal); END MarkSqr; (* Behandlung des Project Menus *) PROCEDURE Project(Item: CARDINAL; VAR Ende: BOOLEAN); CONST PlaneSize = 16000; PROCEDURE GetName(VAR s : ARRAY OF CHAR; t : ARRAY OF CHAR); (* Name des Files einlesen *) VAR W : WindowPtr; BEGIN 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 (x, y, dx, dy : INTEGER) ; (* Ausführung des Menüpunktes save *) VAR Name : ARRAY[0..50] OF CHAR; Res : Response; i : INTEGER; BEGIN GetName(Name,"Speichern als ?"); LMinTerm := BlitPat; i := ORD(BlitPlanes); SaveWin(Wind,x,y,dx,dy,i,Name,Res) END Save; PROCEDURE Load(x,y,dx,dy: INTEGER); VAR Name : ARRAY[0..50] OF CHAR; Res : Response; i : INTEGER; BEGIN GetName(Name,"Welche Datei laden ? "); i := ORD(BlitPlanes); LoadWin(Wind,0,0,dx,dy,i,x,y,i,Name,Res) END Load; PROCEDURE LoadCols; (* Lädt die Farbpalette von Diskette *) VAR Res : Response; Name : ARRAY[0..50] OF CHAR; BEGIN GetName(Name,"Farben von wo laden ?"); LoadWinCol(Wind,16,Name,Res) END LoadCols; PROCEDURE SaveCols; (* Lädt die Farbpalette von Diskette *) VAR Res : Response; Name : ARRAY[0..50] OF CHAR; BEGIN GetName(Name,"Farben speichern als ? "); SaveWinCol(Wind,16,Name,Res) END SaveCols; PROCEDURE SavePart; (* Lädt die Farbpalette von Diskette *) VAR Res : Response; Name : ARRAY[0..50] OF CHAR; x, y , dx, dy : INTEGER; BEGIN MarkSqr(x,y,dx,dy); Save(x,y,dx,dy) END SavePart; PROCEDURE LoadPart; (* Lädt die Farbpalette von Diskette *) VAR Res : Response; Name : ARRAY[0..50] OF CHAR; x, y , dx, dy : INTEGER; BEGIN MarkSqr(x,y,dx,dy); Load(x,y,dx,dy) END LoadPart; PROCEDURE LoadIc; VAR Name : ARRAY[0..50] OF CHAR; Image : DiskObjectPtr; x, y : INTEGER; BEGIN GetName(Name,"Name des Icons"); Image := GetDiskObject(ADR(Name)); IF Image # NIL THEN ReportMButtons(Wind,TRUE,FALSE); WHILE InspMButtons(Wind,sleep) # leftPress DO END; GetWinMouse(Wind,x,y); DrawImage(Wind^.rPort,Image^.gadget.gadgetRender,x,y) END END LoadIc; BEGIN CASE Item OF 0: Load(0,0,WinWidth,WinHeight) | 1: LoadCols | 2: LoadPart | 3: LoadIc | 4: Save(0,0,WinWidth,WinHeight) | 5: SavePart | 6: SaveCols | 7: ClearWin(Wind) | (* Bei New Fenster löschen *) 8: Ende := TRUE (* Bei Ende, Ende Flag setzen *) END END Project; (*-------------------Behandlung des Colors Menus-----------------------------*) PROCEDURE EditCols(); (* Ausführung des Menüpunktes Edit Colors *) VAR W : WindowPtr; i, j, n, buttons, Col, x, y : INTEGER; r : ARRAY[0..2] OF CARDINAL; BEGIN W := SimpleWin(Wind^.wScreen,"Edit Colors",210,90,170,120,noClose+ noBack+noSize); ReportMButtons(W,TRUE,TRUE); j := 0; FOR n := 1 TO 15 DO i := n MOD 4; IF i = 0 THEN j := j +1 END; Rectangle(W,i*40+9,j*12+13,20,10,n,TRUE); END; Rectangle(W,13,65,40,20,1,FALSE); WriteWin(W,"R",30,80,CurrentColor,0); Rectangle(W,63,65,40,20,1,FALSE); WriteWin(W,"G",80,80,CurrentColor,0); Rectangle(W,113,65,40,20,1,FALSE); WriteWin(W,"B",130,80,CurrentColor,0); Rectangle(W,13,90,145,15,1,FALSE); WriteWin(W,"Quit",60,100,CurrentColor,0); y := 0; Col := CurrentColor; SetDrawMode(W,invert); Rectangle(W,(Col MOD 4)*40+32,(Col DIV 4)*12+15,10,5,Col,TRUE); SetDrawMode(W,normal); WHILE (y < 100) DO buttons := InspMButtons(W,sleep); GetWinMouse(W,x,y); IF (y < 60) THEN SetDrawMode(W,invert); Rectangle(W,(Col MOD 4)*40+32,(Col DIV 4)*12+15,10,5,Col,TRUE); Col := (x-9) DIV 40 + (y-13) DIV 12*4; Rectangle(W,(Col MOD 4)*40+32,(Col DIV 4)*12+15,10,5,Col,TRUE); SetDrawMode(W,normal); ELSIF (y > 65) AND (y<90) THEN GetColReg(Wind^.wScreen,Col,r[0],r[1],r[2]); IF ABS(buttons) = 2 THEN buttons := -1 ELSE buttons := 1 END; r[(x-10) DIV 50] := CARDINAL(INTEGER(r[(x-10) DIV 50]) +buttons); SetColReg(Wind^.wScreen,Col,r[0],r[1],r[2]) END END; ReportMButtons(W,FALSE,FALSE); CloseWin(W) END EditCols; (*--------------------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); WHILE InspMButtons(Wind,check) # leftPress DO (* bis linke Maustaste *) 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 END; InitSystem(Wind,LPatterns) END Cycle; PROCEDURE Change; VAR x, y, dx, dy : INTEGER; i : LONGCARD; BEGIN MarkSqr(x,y,dx,dy); WITH Wind^.wScreen^ DO i := BltBitMap(ADR(bitMap),x,y,ADR(bitMap), x,y,dx,dy,BlitPat,BlitPlanes,NIL) END END Change; PROCEDURE DoCopy; VAR x, y, dx, dy, tx, ty : INTEGER; i : LONGCARD; BEGIN MarkSqr(x,y,dx,dy); ReportMButtons(Wind,TRUE,FALSE); WHILE InspMButtons(Wind,sleep) # leftPress DO END; GetWinMouse(Wind,tx,ty); IF tx + dx > WinWidth THEN dx := WinWidth - tx END; IF ty + dy > WinHeight THEN dy := WinHeight - tx END; WITH Wind^.wScreen^ DO i := BltBitMap(ADR(bitMap),x,y,ADR(bitMap),tx,ty,dx,dy, BlitPat,BlitPlanes,NIL) END END DoCopy; 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 *) 9: Change | 10: DoCopy END; ReportMButtons(Wind,FALSE,FALSE); (* keine Abfrage der Maustasten *) END DrawMenu; (*------------------------------------------------------------------------*) PROCEDURE CleanUp; (* Bei Abbruch des Programms das Fenster und den Screen schliessen *) BEGIN IF Wind # NIL THEN CloseWin(Wind) END END CleanUp; BEGIN (* Hauptprogramm: Initialiserung + Menuabfrage *) Extras := backdrop + noSize; (* backdrop und ohne sizing Gadget *) Wind := ScrWin("M2Painter Version 2.0d © 1989 by Paul Lukowicz",0,0,640, 256,2,4,Extras); TermProcedure(CleanUp); (* Bei Abbruch Fenster schließen *) WriteWin(Wind,"Bitte warten, System wird initialisiert !!!",140,120,1,0); 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: IF Item < 16 THEN CurrentColor := Item (* Farbwahl treffen *) ELSE EditCols() (* Farbpalette neu erstellen *) END | 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) | 5: BlitPat := BlitModes[SubItem] | (* Blittermodus umschalten *) 6: IF SubItem IN CAST(SmallSet,BlitPlanes) THEN INC(BlitPlanes,SubItem); a[0] := CHR(48+SubItem); SetTextItem(Wind,a,"",70,SubItem*10,30,10,3,2, CHR(0),0,1,NIL,3,6,SubItem) ELSE DEC(BlitPlanes,SubItem); a[0] := CHR(48+SubItem); SetTextItem(Wind,a,"",70,SubItem*10,30,10,2,2, CHR(0),0,1,NIL,3,6,SubItem) END END ELSE Ende := FALSE (* keine Wahl, nichts tun *) END; END; END M2Painter.