Copyright (C) 1994, Digital Equipment Corp.
Created on Tue Jan 19 14:00:00 PST 1994 by najork
MODULE*************************************************************************** Help ***************************************************************************; IMPORT Matrix4, ObAux, ObCommand, ObLib, ObReal, ObValue, SynLocation; REVEAL T = ObValue.ValAnything BRANDED OBJECT matrix : Matrix4.T; OVERRIDES Is := DoIs; END; TYPE Code = {Id, Multiply, Translate, Scale, RotateX, RotateY, RotateZ}; OpCode = ObLib.OpCode OBJECT code: Code; END; Package = ObLib.T OBJECT OVERRIDES Eval := DoEval; END; CONST pkgname = "Matrix4"; PROCEDURE ObMatrix4 DoIs (self: T; other: ObValue.ValAnything): BOOLEAN = BEGIN TYPECASE other OF T (oth) => RETURN self.matrix = oth.matrix; ELSE RETURN FALSE END; END DoIs; PROCEDUREM3ToObliq (READONLY val : Matrix4.T) : T = BEGIN RETURN NEW (T, what := "<a Matrix4.T>", matrix := val); END M3ToObliq; PROCEDUREObliqToM3 (val : T) : Matrix4.T = BEGIN RETURN val.matrix; END ObliqToM3; PROCEDUREGetArg (args : ObValue.ArgArray; idx : INTEGER; package : ObLib.T; opCode : ObLib.OpCode; loc : SynLocation.T) : Matrix4.T RAISES {ObValue.Error} = BEGIN TYPECASE args[idx] OF | T (node) => RETURN node.matrix; ELSE ObValue.BadArgType (idx, pkgname, package.name, opCode.name, loc); RETURN Matrix4.Id; (* ... only to suppress compiler warning *) END; END GetArg; PROCEDURESetupPackage () = PROCEDURE NewOpCode (name: TEXT; arity: INTEGER; code: Code) : OpCode = BEGIN RETURN NEW (OpCode, name := name, arity := arity, code := code); END NewOpCode; TYPE OpCodes = ARRAY OF ObLib.OpCode; VAR opCodes: REF OpCodes; BEGIN opCodes := NEW (REF OpCodes, NUMBER (Code)); opCodes^ := OpCodes { NewOpCode ("Id", -1, Code.Id), NewOpCode ("Multiply", 2, Code.Multiply), NewOpCode ("Translate", 4, Code.Translate), NewOpCode ("Scale", 4, Code.Scale), NewOpCode ("RotateX", 2, Code.RotateX), NewOpCode ("RotateY", 2, Code.RotateY), NewOpCode ("RotateZ", 2, Code.RotateZ) }; ObLib.Register (NEW (Package, name := pkgname, opCodes := opCodes)); ObLib.RegisterHelp (pkgname, Help); END SetupPackage; PROCEDUREDoEval (self : Package; opCode : ObLib.OpCode; <* UNUSED *> arity : ObLib.OpArity; READONLY args: ObValue.ArgArray; <* UNUSED *> temp : BOOLEAN; loc : SynLocation.T) : ObValue.Val RAISES {ObValue.Error} = BEGIN CASE NARROW (opCode, OpCode).code OF | Code.Id => RETURN M3ToObliq (Matrix4.Id); | Code.Multiply => WITH m1 = GetArg (args, 1, self, opCode, loc), m2 = GetArg (args, 2, self, opCode, loc) DO RETURN M3ToObliq (Matrix4.Multiply (m1, m2)); END; | Code.Translate => WITH m = GetArg (args, 1, self, opCode, loc), x = ObReal.GetArg (args, 2, self, opCode, loc), y = ObReal.GetArg (args, 3, self, opCode, loc), z = ObReal.GetArg (args, 4, self, opCode, loc) DO RETURN M3ToObliq (Matrix4.Translate (m, x, y, z)); END; | Code.Scale => WITH m = GetArg (args, 1, self, opCode, loc), x = ObReal.GetArg (args, 2, self, opCode, loc), y = ObReal.GetArg (args, 3, self, opCode, loc), z = ObReal.GetArg (args, 4, self, opCode, loc) DO RETURN M3ToObliq (Matrix4.Scale (m, x, y, z)); END; | Code.RotateX => WITH m = GetArg (args, 1, self, opCode, loc), a = ObReal.GetArg (args, 2, self, opCode, loc) DO RETURN M3ToObliq (Matrix4.RotateX (m, a)); END; | Code.RotateY => WITH m = GetArg (args, 1, self, opCode, loc), a = ObReal.GetArg (args, 2, self, opCode, loc) DO RETURN M3ToObliq (Matrix4.RotateY (m, a)); END; | Code.RotateZ => WITH m = GetArg (args, 1, self, opCode, loc), a = ObReal.GetArg (args, 2, self, opCode, loc) DO RETURN M3ToObliq (Matrix4.RotateZ (m, a)); END; END; END DoEval;
PROCEDUREHelp (self : ObCommand.T; arg : TEXT; <* UNUSED *> data : REFANY) = BEGIN ObAux.Help (self, arg, pkgname); END Help; BEGIN END ObMatrix4.