[Syntax10.Scn.Fnt;8FoldElemsNew#Syntax10.Scn.FntLL BEGIN Texts.WriteString(W, s); Texts.Append(Oberon.Log, W.buf) END LogStr; 8 }8#Syntax10.Scn.Fntaa BEGIN Texts.Write(W, " "); Texts.WriteInt(W, n, 0); Texts.Append(Oberon.Log, W.buf) END LogInt; 88#Syntax10.Scn.FntDD BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END LogLn; 8?|8#Syntax10.Scn.Fntbb BEGIN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); IF M.Y < F.Y THEN Display.ReplConst(Display.black, F.X, M.Y, F.W, F.Y - M.Y,Display.replace); END; IF(M.id = MenuViewers.extend)THEN Display.ReplConst(Display.black, F.X, F.Y + F.H, F.W, M.dY, Display.replace); Display.ReplConst(Display.black, F.X, F.Y, F.W, F.H, Display.replace); IF(F.pict#NIL)THEN F.clip.X:=F.X; F.clip.Y:=M.Y; F.clip.H:=M.H; F.clip.W:=F.W; F.pict.DrawC(F.clip,F.X,M.Y+M.H-F.pict.height,Display.replace) END; ELSE IF(F.pict#NIL)THEN F.pict.DrawC(F,F.X,F.Y-M.dY+F.H-F.pict.height,Display.replace) END; END; END Modify; 8 W8#Syntax10.Scn.Fnt VAR mainF,menuF:TextFrames.Frame; X,Y:INTEGER; v:Viewers.Viewer; V:MenuViewers.Viewer; S:Texts.Scanner; BEGIN v:=Viewers.This(F.X,F.Y); IF(v#NIL)&(v.dsc IS TextFrames.Frame)THEN Texts.OpenScanner(S,v.dsc(TextFrames.Frame).text,0); Texts.Scan(S); IF(S.class=Texts.Name)THEN S.s[26]:=0X; Strings.Append(".Text",S.s); ELSE S.s:="noname.Text"; END; ELSE S.s:="noname.Text"; END; mainF:=TextFrames.NewText(F.text,0); menuF:=TextFrames.NewMenu(S.s, "System.Close System.Copy System.Grow Edit.Store"); Oberon.AllocateUserViewer(Oberon.Mouse.X,X,Y); V:=MenuViewers.New(menuF,mainF,TextFrames.menuH,X,Y); END OpenSource; 8>m8#Syntax10.Scn.Fntqq VAR keysum:SET; F1:Frame; PROCEDURE Max(a,b:INTEGER):INTEGER; BEGIN IF(a>b)THEN RETURN(a) ELSE RETURN(b) END; END Max; BEGIN WITH F:Frame DO IF M IS Oberon.InputMsg THEN WITH M: Oberon.InputMsg DO IF M.id = Oberon.track THEN Oberon.DrawCursor(Oberon.Mouse,Oberon.Arrow, M.X, M.Y); IF(middle IN M.keys)THEN keysum:={}; REPEAT Oberon.DrawCursor(Oberon.Mouse,Oberon.Arrow, M.X, M.Y); Input.Mouse(M.keys,M.X,M.Y); keysum:=keysum+M.keys; UNTIL(M.keys={}); IF(keysum={middle,right})THEN OpenSource(F); END; END; END END ELSIF M IS MenuViewers.ModifyMsg THEN WITH M: MenuViewers.ModifyMsg DO Modify(F, M) END ELSIF M IS Oberon.CopyMsg THEN Oberon.RemoveMarks(F.X, F.Y, F.W, F.H); NEW(F1); F1^ := F^; M(Oberon.CopyMsg).F := F1 ELSIF M IS Pictures.UpdateMsg THEN WITH M:Pictures.UpdateMsg DO IF(F.pict=M.p)THEN F.clip.X:=F.X+M.x; F.clip.Y:=Max(F.Y+F.H-F.pict.height+M.y,F.Y); F.clip.W:=M.w; F.clip.H:=M.h; F.pict.DrawC(F.clip,F.X,F.Y+F.H-F.pict.height,Display.replace) END END END END END Handle; 898#Syntax10.Scn.Fnt BEGIN Display.ReplConst(Display.black,F.X,F.Y,F.W,F.H,Display.replace); F.pict.SetColorRGB(0,0,0); F.pict.ReplConst(F.X,F.Y,F.W,F.H,Display.replace); END Clear; 88#Syntax10.Scn.Fnt VAR S: Texts.Scanner; V: Viewers.Viewer; ch: CHAR; f:Files.File; s,t:Files.Rider; F:Frame; i:LONGINT; BEGIN V := NIL; IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN V := Oberon.Par.vwr ELSIF Oberon.Pointer.on THEN V := Oberon.MarkedViewer() END; IF (V # NIL) & (V IS MenuViewers.Viewer) & (V.dsc IS TextFrames.Frame) &( V.dsc.next IS Frame)THEN Texts.OpenScanner(S, V.dsc(TextFrames.Frame).text, 0); Texts.Scan(S); IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN F:=V.dsc.next(Frame); LogStr("World.Store "); LogStr(S.s); f:=Files.New(S.s); Files.Set(t,f,0); F.pict.Store(t); Texts.Store(t,F.text); Files.Close(f); Files.Register(f); LogInt(Files.Length(f)); LogLn; END END END Store; 88#Syntax10.Scn.FntUU VAR V: Viewers.Viewer; F:Frame; BEGIN V := NIL; IF Oberon.Par.frame = Oberon.Par.vwr.dsc THEN V := Oberon.Par.vwr ELSIF Oberon.Pointer.on THEN V := Oberon.MarkedViewer() END; IF (V # NIL) & (V IS MenuViewers.Viewer) & (V.dsc IS TextFrames.Frame) &( V.dsc.next IS Frame)THEN F:=V.dsc.next(Frame); OpenSource(F); END END Source; 8+m8#Syntax10.Scn.Fntqq VAR menuF: TextFrames.Frame; x,y: INTEGER; F:Frame; V:MenuViewers.Viewer; BEGIN NEW(F); NEW(V); NEW(F.clip); F.y:=0; menuF := TextFrames.NewMenu(name, "System.Close System.Grow World.Source World.Store"); F.handle := Handle; Oberon.AllocateUserViewer(Display.Left,x, y); V := MenuViewers.New(menuF, F, TextFrames.menuH,x, y); RETURN(F); END New; 8`8#Syntax10.Scn.Fnt~~ VAR S: Texts.Scanner; f:Files.File; r:Files.Rider; ch:CHAR; F:Frame; M:MenuViewers.ModifyMsg; text:Texts.Text; beg,end,time:LONGINT; res:INTEGER; li:Pictures.LoadInfo; pict:Pictures.Picture; BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(text, beg, end, time); IF time >= 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END END; IF S.line # 0 THEN S.class := Texts.Inval END; IF (S.class = Texts.Name) OR (S.class = Texts.String) THEN LogStr("World.Open "); f:=Files.Old(S.s); IF(f#NIL)THEN LogStr(S.s); Files.Set(r,f,0); NEW(pict); pict.Load(r,res); IF(res=0)THEN F:=New(S.s); F.pict:=pict; NEW(F.text); F.text.notify:=NIL; IF(~r.eof)THEN Texts.Load(r,F.text) END; M.id:=MenuViewers.extend; M.dY:=0; M.Y:=F.Y; M.H:=F.H; F.handle(F,M); NEW(li); li.picture:=F.pict; li.Completed; Files.Close(f); LogInt(Files.Length(f)); ELSE LogStr(" invalid file type !"); END; ELSE LogStr(" file not found !"); END; LogLn; END END Open; 8Dy8Syntax10.Scn.Fnt_08FoldElemsNew#Syntax10.Scn.Fnt VAR w, h: INTEGER; BEGIN w := SHORT(E.W DIV TextFrames.Unit); h := SHORT(E.H DIV TextFrames.Unit); Display.ReplConst(15, x0, y0 , w , h, Display.replace); END Disp; 88<8#Syntax10.Scn.Fnt VAR w, h: INTEGER; BEGIN w := SHORT(E.W DIV TextPrinter.Unit); h := SHORT(E.H DIV TextPrinter.Unit); Printer.ReplConst(x0 + 1, y0 + 2, w - 2, h) END Print; 8s VAR e: ErrorElem; PROCEDURE Disp (E: ErrorElem; F: Display.Frame; x0, y0: INTEGER); PROCEDURE Print (E: ErrorElem; x0, y0: INTEGER); BEGIN WITH E: ErrorElem DO IF msg IS TextFrames.DisplayMsg THEN WITH msg: TextFrames.DisplayMsg DO IF ~msg.prepare THEN Disp(E, msg.frame, msg.X0, msg.Y0) END END ELSIF msg IS TextPrinter.PrintMsg THEN WITH msg: TextPrinter.PrintMsg DO IF ~msg.prepare THEN Print(E, msg.X0, msg.Y0) END END ELSIF msg IS Texts.CopyMsg THEN NEW(e); Texts.CopyElem(E, e); msg(Texts.CopyMsg).e := e; END END; END HandleErrorElem; 8;8#Syntax10.Scn.Fnt VAR e: ErrorElem; BEGIN NEW(e); e.H := errorElemSize* TextFrames.Unit; e.W:= errorElemSize* TextFrames.Unit; e.handle := HandleErrorElem; Texts.WriteElem(W, e); Texts.Insert(T, pos, W.buf) END InsertErrorElem; 8)8#Syntax10.Scn.FntNN BEGIN Texts.OpenScanner(S,Oberon.Par.text,Oberon.Par.pos); END OpenScanner; 838#Syntax10.Scn.Fnt VAR pos:LONGINT; BEGIN pos:=Texts.Pos(S)-1; LogStr(" pos "); LogInt(pos); LogStr(" err "); LogInt(errorNr); LogLn; InsertErrorElem(Oberon.Par.text,pos); Texts.OpenScanner(S,Oberon.Par.text,pos+1); error:=TRUE; END Error; 88#Syntax10.Scn.Fnt VAR V:Viewers.Viewer; F:TextFrames.Frame; beg, pos: LONGINT; R: Texts.Reader; PROCEDURE Show (F: TextFrames.Frame; pos: LONGINT); VAR beg, end, delta: LONGINT; BEGIN delta := 200; LOOP beg := F.org; end := TextFrames.Pos(F, F.X, F.Y); IF (beg <= pos) & (pos < end) OR (beg = end) THEN EXIT END; TextFrames.Show(F, pos - delta); DEC(delta, 20) END END Show; BEGIN IF(Oberon.Pointer.on)THEN V:=Oberon.MarkedViewer() ELSE V:=Oberon.Par.vwr END; IF (V # NIL) & (V IS MenuViewers.Viewer) & (V.dsc.next IS TextFrames.Frame) THEN F:=V.dsc.next(TextFrames.Frame); IF F.hasCar THEN beg := F.carloc.pos ELSE beg := 0 END; Texts.OpenReader(R, F.text, beg); REPEAT Texts.ReadElem(R) UNTIL R.eot OR (R.elem IS ErrorElem); IF ~R.eot & (R.elem IS ErrorElem) THEN Oberon.PassFocus(Viewers.This(F.X, F.Y)); pos := Texts.Pos(R); Show(F, pos-1); TextFrames.SetCaret(F, pos) ELSE TextFrames.RemoveCaret(F) END END; END NextError; 88#Syntax10.Scn.Fnt"" VAR V:Viewers.Viewer; pos: LONGINT; R: Texts.Reader; text:Texts.Text; BEGIN IF(Oberon.Pointer.on)THEN V:=Oberon.MarkedViewer() ELSE V:=Oberon.Par.vwr; END; IF (V # NIL) & (V IS MenuViewers.Viewer) &(V.dsc.next IS TextFrames.Frame) THEN text:=V.dsc.next(TextFrames.Frame).text; Texts.OpenReader(R, text, 0); Texts.ReadElem(R); WHILE ~R.eot DO IF R.elem IS ErrorElem THEN pos := Texts.Pos(R); Texts.Delete(text, pos-1, pos); Texts.OpenReader(R, text, pos-1) END; Texts.ReadElem(R) END END; END UnmarkErrors; 8$8#Syntax10.Scn.Fnt PROCEDURE Comment; VAR ch0,ch1:CHAR; level:INTEGER; S1:Texts.Scanner; PROCEDURE Begin():BOOLEAN; BEGIN Texts.OpenScanner(S1,Oberon.Par.text,Texts.Pos(S)); Texts.Scan(S1); IF((S1.class=Char)&(S1.c="("))THEN Texts.Scan(S1); RETURN((S1.class=Char)&(S1.c="*")); END; RETURN(FALSE); END Begin; BEGIN WHILE(Begin())DO level:=1; ch0:=0X; ch1:=0X; WHILE((~S1.eot)&(level>0))DO IF((ch0="(")&(ch1="*"))THEN INC(level); END; IF((ch0="*")&(ch1=")"))THEN DEC(level); END; IF(level>0)THEN ch0:=ch1; Texts.Read(S1,ch1) END; END; Texts.OpenScanner(S,Oberon.Par.text,Texts.Pos(S1)); IF(S1.eot)THEN Error(S,20) END; END; END Comment; BEGIN Comment; Texts.Scan(S); IF(S.eot)THEN S.class:=Inval ELSE IF(S.class=Char)THEN IF(S.c="<")THEN Texts.Scan(S); IF(S.class=Real)THEN S.vector.x:=S.x; Texts.Scan(S); IF(S.class=Real)THEN S.vector.y:=S.x; Texts.Scan(S); IF(S.class=Real)THEN S.vector.z:=S.x; Texts.Scan(S); IF((S.class=Char)&(S.c=">"))THEN S.class:=Vector; ELSE S.class:=Inval; END; ELSE S.class:=Inval; END; ELSE S.class:=Inval; END; ELSE S.class:=Inval; END; ELSIF(S.c="(")THEN Texts.Scan(S); IF(S.class=Real)THEN S.color.r:=S.x; Texts.Scan(S); IF(S.class=Real)THEN S.color.g:=S.x; Texts.Scan(S); IF(S.class=Real)THEN S.color.b:=S.x; Texts.Scan(S); IF((S.class=Char)&(S.c=")"))THEN S.class:=Color; ELSE S.class:=Inval; END; ELSE S.class:=Inval; END; ELSE S.class:=Inval; END; ELSE S.class:=Inval; END; END; END; END; END Scan; 8*{8#Syntax10.Scn.Fntcc BEGIN obj.surface:=world.actualSurface; obj.next:=world.object; world.object:=obj; END AddObj; 8(g8#Syntax10.Scn.Fntww VAR arcCos: LONGREAL; BEGIN IF (x < -1) OR (x > 1) THEN IF x < 0 THEN arcCos := MathL.pi ELSE arcCos := 0 END; ELSIF x < -0.33 THEN arcCos := MathL.pi + MathL.arctan(MathL.sqrt(1 - (x*x))/x) ELSIF x < 0.33 THEN arcCos := MathL.pi/2 - MathL.arctan(x/MathL.sqrt(1 - (x*x))) ELSE arcCos := MathL.arctan(MathL.sqrt(1 - (x*x))/x) END; RETURN arcCos END ArcCos; 8(8#Syntax10.Scn.Fnt VAR arcSin: LONGREAL; BEGIN IF (x < -1) OR (x > 1) THEN IF x < 0 THEN arcSin := -MathL.pi/2 ELSE arcSin := MathL.pi/2 END; ELSE arcSin := MathL.pi/2 - ArcCos(x) END; RETURN arcSin END ArcSin; 88#Syntax10.Scn.FntWW CONST epsilon=1.0E-05; VAR t,help,l,m,n,orient:LONGREAL; BEGIN l:=RayTrace.VectDot(dir,dir); m:=2*dir.x*(point.x-sphere.vector.x) +2*dir.y*(point.y-sphere.vector.y) +2*dir.z*(point.z-sphere.vector.z); n:=RayTrace.VectDot(sphere.vector,sphere.vector)+RayTrace.VectDot(point,point) -2*RayTrace.VectDot(sphere.vector,point) -sphere.radius*sphere.radius; t:=m*m-4*l*n; IF(t<0)THEN RETURN(FALSE); END; IF(t=0)THEN t:=-m/(2*l); IF(t<=0)THEN RETURN(FALSE); END; RayTrace.VectMul(dir,t,hitPoint); RayTrace.VectAdd(hitPoint,point,hitPoint); RayTrace.VectSub(hitPoint,sphere.vector,normal); RayTrace.VectMul(normal,1.001,hitPoint); RayTrace.VectAdd(hitPoint,sphere.vector,hitPoint); RayTrace.VectNorm(normal,normal); RETURN(TRUE); ELSE orient:=1.0; help:=(-m+MathL.sqrt(t))/(2*l); t:=(-m-MathL.sqrt(t))/(2*l); IF(t0)THEN IF(help>0)THEN IF(help0)THEN orient:=-orient; t:=help; ELSE RETURN(FALSE); END; END; RayTrace.VectMul(dir,t,hitPoint); RayTrace.VectAdd(hitPoint,point,hitPoint); RayTrace.VectSub(hitPoint,sphere.vector,normal); RayTrace.VectNorm(normal,normal); RayTrace.VectMul(normal,orient,normal); RETURN(TRUE); END; END Intersection; 8Y#8#Syntax10.Scn.Fnt VAR rad:LONGREAL; BEGIN x:=hitPoint.x-sphere.vector.x; y:=hitPoint.y-sphere.vector.y; rad:=sphere.radius; x:=(ArcSin(x/rad)*rad+rad); y:=(ArcCos(y/rad)*rad+rad); END TexturePoint; 88#Syntax10.Scn.Fnt   VAR S:Scanner; sphere:SphereObj; BEGIN OpenScanner(S); Scan(S); NEW(sphere); IF(S.class=Vector)THEN sphere.vector:=S.vector; Scan(S); IF(S.class=Real)THEN sphere.radius:=S.x; AddObj(sphere); ELSE Error(S,4); END; ELSE Error(S,8); END; END Sphere; 88#Syntax10.Scn.FntCC CONST epsilon=1.0E-05; VAR vec0,vec1,vec2,a,b:RayTrace.Vector; help,t,innen:LONGREAL; edge:Edge; BEGIN vec0:=polygon.edge.vector; vec1:=polygon.edge.next.vector; vec2:=polygon.edge.next.next.vector; RayTrace.VectSub(vec1,vec0,a); RayTrace.VectSub(vec2,vec0,b); RayTrace.VectProd(a,b,normal); help:=-(RayTrace.VectDot(normal,point)-RayTrace.VectDot(normal,vec0)); IF(help>0)THEN RayTrace.VectMul(normal,-1/MathL.sqrt(RayTrace.VectDot(normal,normal)),normal); ELSE RayTrace.VectMul(normal,1/MathL.sqrt(RayTrace.VectDot(normal,normal)),normal); END; t:=RayTrace.VectDot(normal,dir); IF(t=0)THEN RETURN(FALSE); END; t:=-(RayTrace.VectDot(normal,point)-RayTrace.VectDot(vec0,normal))/t; IF(t<=0)THEN RETURN(FALSE); END; RayTrace.VectMul(dir,t,hitPoint); RayTrace.VectAdd(point,hitPoint,hitPoint); edge:=polygon.edge; t:=0; a:=hitPoint; WHILE(edge#NIL)DO RayTrace.VectSub(edge.vector,hitPoint,a); IF(edge.next#NIL)THEN RayTrace.VectSub(edge.next.vector,hitPoint,b); ELSE RayTrace.VectSub(polygon.edge.vector,hitPoint,b); END; RayTrace.VectNorm(a,a); RayTrace.VectNorm(b,b); innen:=RayTrace.VectDot(a,b); IF(innen>=-1)&(innen<=1)THEN t:=t+ArcCos(innen); ELSE RETURN(FALSE); END; edge:=edge.next; END; IF(ABS(t-MathL.pi*2)>epsilon)THEN RETURN(FALSE); END; RETURN(TRUE); END Intersection; 8ZJ8#Syntax10.Scn.Fnt VAR a,b,c,d,vec0,vec1:RayTrace.Vector; arc:LONGREAL; BEGIN vec0:=polygon.edge.vector; vec1:=polygon.edge.next.vector; RayTrace.VectSub(hitPoint,vec0,c); RayTrace.VectSub(vec1,vec0,a); RayTrace.VectNorm(a,b); RayTrace.VectNorm(c,d); arc:=RayTrace.VectDot(b,d); x:=MathL.sqrt(RayTrace.VectDot(c,c))*arc; arc:=MathL.sin(ArcCos(arc)); y:=MathL.sqrt(RayTrace.VectDot(c,c))*arc; END TexturePoint; 88#Syntax10.Scn.Fnt>> VAR polygon:PolygonObj; edge:Edge; S:Scanner; c:INTEGER; BEGIN OpenScanner(S); Scan(S); NEW(polygon); polygon.edge:=NIL; c:=0; WHILE(S.class=Vector)DO NEW(edge); edge.vector:=S.vector; edge.next:=polygon.edge; polygon.edge:=edge; INC(c); Scan(S); END; IF(c>2)THEN AddObj(polygon) END; END Polygon; 88#Syntax10.Scn.Fnt VAR S:Scanner; f:Files.File; r:Files.Rider; res:INTEGER; BEGIN OpenScanner(S); Scan(S); NEW(world.actualSurface); IF(S.class=Real)THEN world.actualSurface.material:=S.x; Scan(S); IF(S.class=Real)THEN world.actualSurface.mirror:=S.x; Scan(S); IF(S.class=Real)THEN world.actualSurface.trans:=S.x; Scan(S); IF(S.class=Real)THEN world.actualSurface.difConst:=S.x; Scan(S); IF(S.class=Real)THEN world.actualSurface.specConst:=S.x; Scan(S); IF(S.class=Real)THEN world.actualSurface.highConst:=S.x; Scan(S); IF(S.class=Real)THEN world.actualSurface.velocity:=S.x; Scan(S); IF(S.class=Color)THEN world.actualSurface.colorType:=RayTrace.COLOR; world.actualSurface.color:=S.color; ELSIF(S.class=String)THEN f:=Files.Old(S.s); IF(f#NIL)THEN Files.Set(r,f,0); NEW(world.actualSurface.texture.pict); world.actualSurface.texture.pict.Load(r,res); IF(res=0)THEN world.actualSurface.colorType:=RayTrace.TEXTURE; Scan(S); IF(S.class=Real)THEN world.actualSurface.texture.skale:=S.x; ELSE Error(S,4); END; ELSE Error(S,11); END; ELSE Error(S,10); END; ELSE Error(S,7); END; ELSE Error(S,4); END; ELSE Error(S,4); END; ELSE Error(S,4);END; ELSE Error(S,4);END; ELSE Error(S,4);END; ELSE Error(S,4);END; ELSE Error(S,4);END; END Surface; 88#Syntax10.Scn.Fnt TYPE Point=POINTER TO PointDesc; PointDesc=RECORD v:RayTrace.Vector; next:Point; END; VAR bottom,top:PolygonObj; edge:Edge; S:Scanner; n:INTEGER; bottomList,topList,point,pointBottom,pointTop,prev:Point; PROCEDURE Rectange(v0,v1,v2,v3:RayTrace.Vector); VAR polygon:PolygonObj; edge:Edge; BEGIN NEW(polygon); polygon.edge:=NIL; NEW(edge); edge.vector:=v0; edge.next:=polygon.edge; polygon.edge:=edge; NEW(edge); edge.vector:=v1; edge.next:=polygon.edge; polygon.edge:=edge; NEW(edge); edge.vector:=v2; edge.next:=polygon.edge; polygon.edge:=edge; NEW(edge); edge.vector:=v3; edge.next:=polygon.edge; polygon.edge:=edge; AddObj(polygon); END Rectange; BEGIN OpenScanner(S); Scan(S); n:=0; bottomList:=NIL; topList:=NIL; WHILE(S.class=Vector)DO NEW(point); point.v:=S.vector; IF(n MOD 2=0)THEN point.next:=bottomList; bottomList:=point; ELSE point.next:=topList; topList:=point; END; INC(n); Scan(S); END; IF((bottomList=NIL)OR(topList=NIL))THEN Error(S,8); ELSE NEW(point); point.v:=bottomList.v; prev:=bottomList; WHILE(prev.next#NIL)DO prev:=prev.next; END; prev.next:=point; point.next:=NIL; NEW(point); point.v:=topList.v; prev:=topList; WHILE(prev.next#NIL)DO prev:=prev.next; END; prev.next:=point; point.next:=NIL; NEW(bottom); bottom.edge:=NIL; NEW(top); top.edge:=NIL; pointBottom:=bottomList; pointTop:=topList; WHILE((pointBottom.next#NIL)&(pointTop.next#NIL))DO NEW(edge); edge.vector:=pointBottom.v; edge.next:=bottom.edge; bottom.edge:=edge; NEW(edge); edge.vector:=pointTop.v; edge.next:=top.edge; top.edge:=edge; Rectange(pointBottom.v, pointTop.v, pointTop.next.v, pointBottom.next.v); pointBottom:=pointBottom.next; pointTop:=pointTop.next; END; IF((pointBottom.next=NIL)&(pointTop.next=NIL))THEN AddObj(bottom); AddObj(top); ELSE Error(S,8); END; END; END Cylinder; 8H8#Syntax10.Scn.Fnt VAR S:Scanner; BEGIN OpenScanner(S); Scan(S); IF(S.class=Color)THEN world.background:=S.color; Scan(S); ELSE Error(S,7); END; END Background; 8N8#Syntax10.Scn.Fnt VAR S:Scanner; BEGIN OpenScanner(S); Scan(S); IF(S.class=Color)THEN world.ambient:=S.color; Scan(S); ELSE Error(S,7); END; END Ambient; 88#Syntax10.Scn.Fnt@@ VAR S:Scanner; BEGIN OpenScanner(S); Scan(S); IF(S.class=Int)THEN IF(S.i>MAX(INTEGER))THEN S.i:=MAX(INTEGER); END; world.pWidth:=SHORT(S.i); Scan(S); IF(S.class=Int)THEN IF(S.i>MAX(INTEGER))THEN S.i:=MAX(INTEGER); END; world.pHeight:=SHORT(S.i); ELSE Error(S,3); END; ELSE Error(S,3); END; END View; 8[8#Syntax10.Scn.Fnt VAR lamp:RayTrace.Lamp; S:Scanner; BEGIN OpenScanner(S); Scan(S); NEW(lamp); IF(S.class=Vector)THEN lamp.vector:=S.vector; Scan(S); IF(S.class=Color)THEN lamp.color:=S.color; Scan(S); IF(S.class=Real)THEN lamp.intens:=S.x; lamp.next:=world.lamp; world.lamp:=lamp; Scan(S); ELSE Error(S,4); END; ELSE Error(S,7); END; ELSE Error(S,8); END; END Lamp; 8J8#Syntax10.Scn.Fnt VAR S:Scanner; BEGIN OpenScanner(S); Scan(S); IF(S.class=Vector)THEN world.observer:=S.vector; Scan(S); ELSE Error(S,8); END; END Observer; 8U8#Syntax10.Scn.Fnt VAR S:Scanner; BEGIN OpenScanner(S); Scan(S); IF(S.class=Vector)THEN world.lookAt:=S.vector; ELSE Error(S,8); END; END LookAt; 8U8#Syntax10.Scn.Fnt VAR S:Scanner; BEGIN OpenScanner(S); Scan(S); IF(S.class=Vector)THEN world.viewUp:=S.vector; ELSE Error(S,8); END; END ViewUp; 8b8#Syntax10.Scn.Fnt|| VAR S:Scanner; BEGIN OpenScanner(S); Scan(S); IF(S.class=Real)THEN world.eye:=S.x; ELSE Error(S,4); END; END Eye; 8[8#Syntax10.Scn.Fnt VAR S:Scanner; BEGIN OpenScanner(S); Scan(S); IF(S.class=String)THEN COPY(S.s,world.name); ELSE Error(S,2); END; END Title; 8U8#Syntax10.Scn.Fnt VAR S:Scanner; BEGIN OpenScanner(S); Scan(S); IF(S.class=Name)THEN IF(S.s="fast")THEN world.calcInTask:=FALSE; Scan(S); IF(S.class=Int)THEN world.showFastPixel:=SHORT(S.i) ELSE Error(S,3) END; ELSIF(S.s="task")THEN world.calcInTask:=TRUE ELSIF(S.s="normal")THEN world.calcInTask:=FALSE; world.showFastPixel:=0 ELSE Error(S,1) END; ELSE Error(S,1); END; END CalcMode; 888(!MODULE World; IMPORT RayTrace,MathL,Display,Texts,Oberon,Pictures, TextFrames,Viewers,MenuViewers,Strings,Input, Files,TextPrinter,Printer; CONST Inval*= 0; Name *= 1; String* = 2; Int *= 3; Real *= 4; LongReal *= 5; Char *= 6; Color*=7; Vector*=8; left=2; middle=1; right=0; errorElemSize=8; TYPE SphereObj*=POINTER TO SphereDesc; SphereDesc*=RECORD(RayTrace.ObjectDesc); radius*:REAL; vector*:RayTrace.Vector; END; Edge*=POINTER TO EdgeDesc; EdgeDesc*=RECORD vector*:RayTrace.Vector; next*:Edge; END; PolygonObj*=POINTER TO PolygonDesc; PolygonDesc*=RECORD(RayTrace.ObjectDesc); edge*:Edge; END; Scanner*=RECORD(Texts.Scanner) color*:RayTrace.Color; vector*:RayTrace.Vector; END; Frame = POINTER TO FrameDesc; FrameDesc = RECORD (Display.FrameDesc) pict:Pictures.Picture; clip:Display.Frame; y:INTEGER; text:Texts.Text; END; World*=POINTER TO WorldDesc; WorldDesc*=RECORD(RayTrace.WorldDesc) actualSurface*:RayTrace.Surface; name*:ARRAY 32 OF CHAR; END; ErrorElem = POINTER TO ErrorElemDesc; ErrorElemDesc = RECORD(Texts.ElemDesc) END; VAR world:World; (* actual created world *) error:BOOLEAN; (* error in definition of word TRUE => dont calc it *) W:Texts.Writer; PROCEDURE LogStr (s: ARRAY OF CHAR); PROCEDURE LogInt (n: LONGINT); PROCEDURE LogLn; PROCEDURE Modify(F: Frame; VAR M: MenuViewers.ModifyMsg); PROCEDURE OpenSource(F:Frame); PROCEDURE Handle(F: Display.Frame; VAR M: Display.FrameMsg); PROCEDURE Clear(F:Frame); PROCEDURE Store*; PROCEDURE Source*; PROCEDURE New(name:ARRAY OF CHAR):Frame; PROCEDURE Open*; PROCEDURE HandleErrorElem (E: Texts.Elem; VAR msg: Texts.ElemMsg); PROCEDURE InsertErrorElem (T: Texts.Text; pos: LONGINT); PROCEDURE OpenScanner*(VAR S:Scanner); PROCEDURE Error*(VAR S:Scanner; errorNr:INTEGER); PROCEDURE NextError; PROCEDURE UnmarkErrors; PROCEDURE Scan*(VAR S:Scanner); PROCEDURE AddObj*(obj:RayTrace.Object); PROCEDURE ArcCos(x:LONGREAL):LONGREAL; PROCEDURE ArcSin(x:LONGREAL):LONGREAL; PROCEDURE (sphere:SphereObj)Intersection*(point,dir:RayTrace.Vector; VAR hitPoint,normal:RayTrace.Vector):BOOLEAN; PROCEDURE (sphere:SphereObj)TexturePoint*(hitPoint:RayTrace.Vector; VAR x,y:LONGREAL); PROCEDURE Sphere*; PROCEDURE (polygon:PolygonObj) Intersection*(point,dir:RayTrace.Vector; VAR hitPoint,normal:RayTrace.Vector):BOOLEAN; PROCEDURE (polygon:PolygonObj)TexturePoint*(hitPoint:RayTrace.Vector; VAR x,y:LONGREAL); PROCEDURE Polygon*; PROCEDURE Surface*; PROCEDURE Cylinder*; PROCEDURE Background*; PROCEDURE Ambient*; PROCEDURE View*; PROCEDURE Lamp*; PROCEDURE Observer*; PROCEDURE LookAt*; PROCEDURE ViewUp*; PROCEDURE Eye*; PROCEDURE Title*; PROCEDURE CalcMode*; PROCEDURE Define*; VAR res:INTEGER; S:Scanner; beg,end:LONGINT; R:Texts.Reader; ch:CHAR; F:Frame; BEGIN LogStr("World.Define "); LogLn; NEW(world); world.name:="noname"; world.background:=RayTrace.black; world.ambient:=RayTrace.black; world.lamp:=NIL; world.object:=NIL; world.pHeight:=100; world.pWidth:=100; world.eye:=57; world.observer.x:=0; world.observer.y:=0; world.observer.z:=0; world.lookAt.x:=0; world.lookAt.y:=0; world.lookAt.z:=1; world.viewUp.x:=0; world.viewUp.y:=0; world.viewUp.z:=1.0; world.showFastPixel:=1; world.calcInTask:=FALSE; world.background:=RayTrace.black; NEW(world.actualSurface); world.actualSurface.material:=1.0; world.actualSurface.mirror:=0.0; world.actualSurface.trans:=0.0; world.actualSurface.difConst:=0.7; world.actualSurface.specConst:=0.7; world.actualSurface.highConst:=1.0; world.actualSurface.velocity:=1.0; world.actualSurface.colorType:=RayTrace.COLOR; world.actualSurface.color.r:=1.0; world.actualSurface.color.b:=1.0; world.actualSurface.color.g:=1.0; OpenScanner(S); beg:=Texts.Pos(S); Scan(S); error:=FALSE; UnmarkErrors; WHILE((~S.eot)&((S.class#Char)OR(S.c#"~")))DO IF((S.class=Texts.Name)&(Strings.Pos(".",S.s,0)#-1))THEN Oberon.Par.pos:=Texts.Pos(S); Oberon.Call(S.s,Oberon.Par,FALSE,res); OpenScanner(S); IF(res#0)THEN Error(S,res+20); END; END; Scan(S); END; IF(error)THEN NextError ; ELSE F:=New(world.name); NEW(F.pict); F.pict.Init(world.pWidth,world.pHeight,24); IF(S.eot)THEN end:=Oberon.Par.text.len ELSE end:=Texts.Pos(S); END; Texts.OpenReader(R,Oberon.Par.text,beg-12); Texts.Read(R,ch); WHILE(~R.eot)&(Texts.Pos(R)