Font resizing using CTRL + Mouse Wheel

git-svn-id: https://svn.inf.ethz.ch/svn/lecturers/a2/trunk@7226 8c9fc860-2736-0410-a75d-ab315db34111

source/WMTextView.Mod

@@ -2721,8 +2721,14 @@ TYPE
 
 	(* navigation *)
 		PROCEDURE WheelMove*(dz: LONGINT); (** PROTECTED *)
-		BEGIN
-			IF mouseWheelScrollSpeedI # 0 THEN
+		VAR ddz: DZ; 
+		BEGIN
+			IF modifierFlags * Inputs.Ctrl # {} THEN (* CTRL pressed -> Resize Font*)
+				text.AcquireWrite;
+				NEW(ddz, dz); 
+				text.UpdateAttributes(0, text.GetLength(), ChangeAttribute, ddz);
+				text.ReleaseWrite;
+			ELSIF mouseWheelScrollSpeedI # 0 THEN
 				firstLine.Set(firstLine.Get() + mouseWheelScrollSpeedI * dz)
 			END;
 		END WheelMove;
@@ -4171,6 +4177,86 @@ BEGIN
 	RETURN x
 END Limit;
 
+(* Actually, this is a hack... but for now, do it.  *)
+PROCEDURE GetNewSize(CONST fontname : ARRAY OF CHAR; value, currentSize : LONGINT; VAR newSize : LONGINT);
+BEGIN
+	IF (fontname = "Oberon") THEN
+		IF (value >0) THEN
+			IF (currentSize <= 8) THEN newSize := 10;
+			ELSIF (currentSize <= 10) THEN newSize := 12;
+			ELSIF (currentSize <= 12) THEN newSize := 14;
+			ELSIF (currentSize <= 14) THEN newSize := 16;
+			ELSIF (currentSize <= 16) THEN newSize := 20;
+			ELSIF (currentSize <= 20) THEN newSize := 24;
+			ELSIF (currentSize <= 24) THEN newSize := 24;
+			ELSE (* go to default *)
+				newSize := 24; (* max. size of Oberon font *)
+			END;
+		ELSE
+			IF (currentSize <= 8) THEN newSize := 8;
+			ELSIF (currentSize <= 10) THEN newSize := 8;
+			ELSIF (currentSize <= 12) THEN newSize := 10;
+			ELSIF (currentSize <= 14) THEN newSize := 12;
+			ELSIF (currentSize <= 16) THEN newSize := 14;
+			ELSIF (currentSize <= 20) THEN newSize := 16;
+			ELSIF (currentSize <= 24) THEN newSize := 20;
+			ELSE
+				newSize := 24;
+			END;
+		END;
+	ELSIF (fontname = "Courier") THEN
+		IF (value > 0) THEN
+			IF (currentSize <= 8) THEN newSize := 10;
+			ELSIF (currentSize <= 10) THEN newSize := 12;
+			ELSE
+				newSize := 12;
+			END;
+		ELSE
+			IF (currentSize >= 12) THEN newSize := 10;
+			ELSIF (currentSize >= 10) THEN newSize := 8;
+			ELSE
+				newSize := 8;
+			END;
+		END;
+	ELSE
+		newSize := currentSize + value * currentSize DIV 4;
+	END;
+	IF (newSize < 8) THEN newSize := 8; END;
+END GetNewSize;
+
+TYPE 
+
+DZ = OBJECT (Texts.Attributes);
+VAR value: LONGINT;
+	PROCEDURE &Init(v: LONGINT);
+	BEGIN
+		value := v;
+	END Init;
+END DZ; 
+
+PROCEDURE EnsureAttribute(VAR attr : Texts.Attributes);
+BEGIN
+	IF (attr = NIL) THEN
+		NEW(attr); NEW(attr.fontInfo);
+		attr.fontInfo.name := "Vera";
+		attr.fontInfo.size := 16;
+		attr.fontInfo.style := {};
+		attr.color := 0000000FFH;
+		attr.bgcolor := 000000000H;
+	END
+END EnsureAttribute;
+
+PROCEDURE ChangeAttribute(VAR attr : Texts.Attributes; userData : ANY);
+VAR dz: DZ;
+BEGIN
+	IF (userData # NIL) & (userData IS DZ) THEN
+		EnsureAttribute(attr);
+		dz := userData(DZ);
+		GetNewSize(attr.fontInfo.name,-dz.value, attr.fontInfo.size, attr.fontInfo.size);
+		attr.fontInfo.fontcache := NIL;
+	END;
+END ChangeAttribute;
+
 PROCEDURE GetFontFromAttr(info : Texts.FontInfo) : WMGraphics.Font;
 BEGIN
 	RETURN WMGraphics.GetFont(info.name, info.size, info.style);