iSyntax10.Scn.Fnt8FoldElemsNew#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; 88#Syntax10.Scn.Fnt VAR S: Texts.Scanner; V: Viewers.Viewer; f:Files.File; t:Files.Rider; 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 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; 8l8#Syntax10.Scn.Fntrr VAR S: Texts.Scanner; f:Files.File; r:Files.Rider; 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; 83-8Syntax10.Scn.Fnt98FoldElemsNew#Syntax10.Scn.FntWW VAR S:Texts.Scanner; ch:CHAR; BEGIN Texts.Write(W," "); Texts.OpenScanner(S,errorText,0); Texts.Scan(S); WHILE((~S.eot)&((S.class#Texts.Int)OR(S.i#errorNr)))DO Texts.Scan(S) END; Texts.Read(S,ch); WHILE((~S.eot)&(ch#0DX))DO Texts.Write(W,ch); Texts.Read(S,ch); END; Texts.Append(Oberon.Log,W.buf); END ErrorText;8 VAR pos:LONGINT; PROCEDURE ErrorText(errorNr:INTEGER); BEGIN pos:=Texts.Pos(S)-1; LogStr(" pos "); LogInt(pos); ErrorText(errorNr); LogLn; InsertErrorElem(Oberon.Par.text,pos); Texts.OpenScanner(S,Oberon.Par.text,pos+1); error:=TRUE; END Error; 8!>8oSyntax10.Scn.Fnt8FoldElemsNewRSyntax10.Scn.FntT8FoldElemsNew#Syntax10.Scn.Fnt 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;8o VAR ch0,ch1:CHAR; level:INTEGER; S1:Texts.Scanner; PROCEDURE Begin():BOOLEAN; 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;8<T PROCEDURE 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; 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.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 a,b,n:RayTrace.Vector; help,innen,arc,t:LONGREAL; p:Point; BEGIN RayTrace.VectSub(polygon.point.next.vector,polygon.point.vector,a); RayTrace.VectSub(polygon.point.next.next.vector,polygon.point.vector,b); RayTrace.VectProd(b,a,normal); RayTrace.VectNorm(normal,normal); help:=-(RayTrace.VectDot(normal,point)-RayTrace.VectDot(normal,polygon.point.vector)); 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(polygon.point.vector,normal))/t; IF(t<=0)THEN RETURN(FALSE); END; RayTrace.VectMul(dir,t,hitPoint); RayTrace.VectAdd(point,hitPoint,hitPoint); arc:=0; p:=polygon.point; WHILE(p#NIL)DO RayTrace.VectSub(p.vector,hitPoint,a); IF(p.next=NIL)THEN RayTrace.VectSub(polygon.point.vector,hitPoint,b) ELSE RayTrace.VectSub(p.next.vector,hitPoint,b) END; RayTrace.VectProd(a,b,n); RayTrace.VectNorm(a,a); RayTrace.VectNorm(b,b); IF(RayTrace.VectDot(n,n)#0)THEN RayTrace.VectNorm(n,n); innen:=RayTrace.VectDot(a,b); IF(innen>=-1)&(innen<=1)THEN IF((ABS(normal.x-n.x)MathL.pi*2-epsilon)&(ABS(arc)2)THEN AddObj(polygon) END; END Polygon; 8 8B Syntax10.Scn.Fnt@8FoldElemsNewSyntax10.Scn.Fnt8FoldElemsNew#Syntax10.Scn.FntRR BEGIN Oberon.Par.text:=text; Oberon.Par.pos:=pos; Error(S,nr); END Err;8 VAR S0:Scanner; f:Files.File; r:Files.Rider; res:INTEGER; text:Texts.Text; pos:LONGINT; PROCEDURE Err(nr:INTEGER); BEGIN text:=Oberon.Par.text; pos:=Oberon.Par.pos; Oberon.Par.text:=surfaceText; Oberon.Par.pos:=0; OpenScanner(S0); Scan(S0); WHILE(~S0.eot)DO IF((S0.class=String)&(S0.s=name))THEN Scan(S0); NEW(world.actualSurface); IF(S0.class=Real)THEN world.actualSurface.material:=S0.x; Scan(S0); IF(S0.class=Real)THEN world.actualSurface.mirror:=S0.x; Scan(S0); IF(S0.class=Real)THEN world.actualSurface.trans:=S0.x; Scan(S0); IF(S0.class=Real)THEN world.actualSurface.difConst:=S0.x; Scan(S0); IF(S0.class=Real)THEN world.actualSurface.specConst:=S0.x; Scan(S0); IF(S0.class=Real)THEN world.actualSurface.highConst:=S0.x; Scan(S0); IF(S0.class=Real)THEN world.actualSurface.velocity:=S0.x; Scan(S0); IF(S0.class=Color)THEN world.actualSurface.colorType:=RayTrace.COLOR; world.actualSurface.color:=S0.color; Oberon.Par.text:=text; Oberon.Par.pos:=pos; ELSIF(S0.class=String)THEN f:=Files.Old(S0.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(S0); IF(S0.class=Real)THEN world.actualSurface.texture.scale:=S0.x; Oberon.Par.text:=text; Oberon.Par.pos:=pos; ELSE Err(10); END; ELSE Err(10); END; ELSE Err(10); END; ELSE Err(10); END; ELSE Err(10); END; ELSE Err(10); END; ELSE Err(10);END; ELSE Err(10);END; ELSE Err(10);END; ELSE Err(10);END; ELSE Err(10);END; RETURN; END; Scan(S0); END; Err(9); END SetSurface; 8s VAR S:Scanner; PROCEDURE SetSurface(name:ARRAY OF CHAR); BEGIN OpenScanner(S); Scan(S); IF(S.class=String)THEN SetSurface(S.s); ELSE Error(S,2) END; END Surface; 8 8#Syntax10.Scn.Fnt TYPE VAR bottom,top:PolygonObj; S:Scanner; n:INTEGER; bottomList,topList,point,pointBottom,pointTop,prev:Point; PROCEDURE Rectange(v0,v1,v2,v3:RayTrace.Vector); VAR polygon:PolygonObj; point:Point; BEGIN NEW(polygon); polygon.point:=NIL; NEW(point); point.vector:=v0; point.next:=polygon.point; polygon.point:=point; NEW(point); point.vector:=v1; point.next:=polygon.point; polygon.point:=point; NEW(point); point.vector:=v2; point.next:=polygon.point; polygon.point:=point; NEW(point); point.vector:=v3; point.next:=polygon.point; polygon.point:=point; AddObj(polygon); END Rectange; BEGIN OpenScanner(S); Scan(S); n:=0; bottomList:=NIL; topList:=NIL; WHILE(S.class=Vector)DO NEW(point); point.vector:=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.vector:=bottomList.vector; prev:=bottomList; WHILE(prev.next#NIL)DO prev:=prev.next; END; prev.next:=point; point.next:=NIL; NEW(point); point.vector:=topList.vector; prev:=topList; WHILE(prev.next#NIL)DO prev:=prev.next; END; prev.next:=point; point.next:=NIL; NEW(bottom); bottom.point:=NIL; NEW(top); top.point:=NIL; pointBottom:=bottomList; pointTop:=topList; WHILE((pointBottom.next#NIL)&(pointTop.next#NIL))DO NEW(point); point.vector:=pointBottom.vector; point.next:=bottom.point; bottom.point:=point; NEW(point); point.vector:=pointTop.vector; point.next:=top.point; top.point:=point; Rectange(pointBottom.vector, pointTop.vector, pointTop.next.vector, pointBottom.next.vector); 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; 8/8#Syntax10.Scn.Fnt 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; Texts.Open(surfaceText,"Surface.Text"); 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) dont calc it *) W:Texts.Writer; errorText,surfaceText:Texts.Text; 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 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 Scan*(VAR S:Scanner); PROCEDURE NextError; PROCEDURE UnmarkErrors; 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*; BEGIN Texts.OpenWriter(W); NEW(errorText); Texts.Open(errorText,"WorldErrors.Text"); NEW(surfaceText); END World.