2
0

W3dClusterWatch.Mod 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377
  1. MODULE W3dClusterWatch; (** AUTHOR "TF"; PURPOSE "Simple 3d viewer"; *)
  2. IMPORT
  3. (* Low level *)
  4. KernelLog, Kernel, MathL, Streams, Modules, Files, Commands,
  5. Strings,
  6. (* Window Manager *)
  7. WM := WMWindowManager, Rect := WMRectangles, Raster, WMGraphics,
  8. (* Network *)
  9. IP, DNS, TCP,
  10. (* 3d framework *)
  11. Classes := TFClasses, Vectors := W3dVectors, Matrix := W3dMatrix,
  12. AbstractWorld := W3dAbstractWorld, World := W3dWorld, ObjectGenerator := W3dObjectGenerator,
  13. (* XML framework *)
  14. XML, Scanner := XMLScanner, XMLParser, Objects := XMLObjects;
  15. CONST CATPort = 9999;
  16. NoCAT = 0;
  17. AosCAT = 1;
  18. LinuxCAT = 2;
  19. WindowsCAT = 3;
  20. SuseCAT = 4;
  21. UnknownCAT = 5;
  22. BoxDistance = 250;
  23. VAR OSColor : ARRAY 6 OF LONGINT;
  24. OSImg : ARRAY 6 OF Raster.Image;
  25. TYPE
  26. UpdateProc = PROCEDURE {DELEGATE};
  27. Info = OBJECT
  28. VAR
  29. pos : Vectors.TVector3d;
  30. host : ARRAY 64 OF CHAR;
  31. os, oldos : ARRAY 32 OF CHAR;
  32. load : ARRAY 32 OF CHAR;
  33. running, oldrunning : LONGINT;
  34. obj : AbstractWorld.Object;
  35. timer : Kernel.Timer;
  36. interval : LONGINT;
  37. world : AbstractWorld.World;
  38. connection : TCP.Connection;
  39. alive : BOOLEAN;
  40. index : LONGINT;
  41. render : UpdateProc;
  42. PROCEDURE &Init*(world : AbstractWorld.World; pos : Vectors.TVector3d; host : ARRAY OF CHAR; interval : LONGINT;
  43. update: UpdateProc);
  44. BEGIN
  45. COPY(host, SELF.host); SELF.pos := pos; SELF.world := world; SELF.interval := interval; SELF.render := update;
  46. NEW(timer)
  47. END Init;
  48. PROCEDURE RefreshInfo(host: ARRAY OF CHAR; VAR osName, osLoad: ARRAY OF CHAR) : BOOLEAN;
  49. VAR res: WORD;
  50. fip: IP.Adr;
  51. in : Streams.Reader;
  52. out : Streams.Writer;
  53. BEGIN
  54. NEW(connection);
  55. DNS.HostByName(host, fip, res);
  56. IF res # 0 THEN RETURN FALSE END;
  57. connection.Open(TCP.NilPort, fip, CATPort, res);
  58. IF res # 0 THEN connection.Close; RETURN FALSE END;
  59. Streams.OpenReader(in, connection.Receive); Streams.OpenWriter(out, connection.Send);
  60. (* query os *)
  61. out.String("getOS"); out.Ln; out.Update; in.Ln(osName);
  62. (* query load *)
  63. out.String("getLoad"); out.Ln; out.Update; in.Ln(osLoad);
  64. IF connection # NIL THEN connection.Close END;
  65. RETURN in.res = 0
  66. END RefreshInfo;
  67. PROCEDURE Update;
  68. BEGIN
  69. IF RefreshInfo(host, os, load) THEN
  70. IF MatchI(os, "Aos") THEN running := AosCAT
  71. ELSIF MatchI(os, "Linux") OR MatchI(os, "RH_Linux") THEN running := LinuxCAT
  72. ELSIF MatchI(os, "WinNT") THEN running := WindowsCAT
  73. ELSIF MatchI(os, "SUSE") THEN running := SuseCAT
  74. ELSE running := UnknownCAT; KernelLog.String("FAH : "); KernelLog.String(os); KernelLog.Ln;
  75. END
  76. ELSE running := NoCAT
  77. END;
  78. IF running # oldrunning THEN
  79. IF obj = NIL THEN obj := world.CreateObject(); obj.SetIndex(index); world.AddObject(obj) END; obj.Clear;
  80. IF OSImg[running] # NIL THEN
  81. ObjectGenerator.TexBox(Matrix.Translation4x4(pos.x, pos.y, pos.z),
  82. 100, 100, 100, obj, OSColor[running], obj.AddTexture(OSImg[running]));
  83. ELSE
  84. ObjectGenerator.Box(Matrix.Translation4x4(pos.x, pos.y, pos.z),
  85. 100, 100, 100, obj, OSColor[running]);
  86. END;
  87. oldrunning := running;
  88. render
  89. END
  90. END Update;
  91. PROCEDURE Kill;
  92. BEGIN
  93. alive := FALSE;
  94. IF connection # NIL THEN connection.Close END;
  95. timer.Wakeup
  96. END Kill;
  97. BEGIN {ACTIVE}
  98. oldrunning := -1;
  99. alive := TRUE;
  100. WHILE alive DO
  101. Update;
  102. IF alive THEN timer.Sleep(interval) END
  103. END;
  104. END Info;
  105. Window = OBJECT ( WM.BufferWindow )
  106. VAR
  107. alive, dead:BOOLEAN;
  108. timer : Kernel.Timer;
  109. interval : LONGINT;
  110. (* Navigation *)
  111. lookat: Vectors.TVector3d;
  112. radius, angle, height : LONGREAL;
  113. mouseKeys : SET;
  114. oldX, oldY : LONGINT;
  115. (* 3d World *)
  116. world : World.World;
  117. mx, my, mz : LONGREAL;
  118. infoList : Classes.List;
  119. index : LONGINT;
  120. PROCEDURE ParseLine(line : XML.Element; pos: Vectors.TVector3d);
  121. VAR cont : Objects.Enumerator; p : ANY; el : XML.Element;s : Strings.String;
  122. x: Info;
  123. BEGIN
  124. cont := line.GetContents(); cont.Reset();
  125. WHILE cont.HasMoreElements() DO
  126. p := cont.GetNext();
  127. el := p(XML.Element);
  128. s := el.GetName(); IF s^ = "Entry" THEN
  129. s := el.GetAttributeValue("Host");
  130. NEW(x, world, pos, s^, interval, Render); x.index := index; INC(index); w.infoList.Add(x);
  131. x.pos := pos; mx := MAX(pos.x, mx);
  132. pos.x := pos.x + BoxDistance
  133. END
  134. END
  135. END ParseLine;
  136. PROCEDURE ParseLayer(layer : XML.Element; pos : Vectors.TVector3d);
  137. VAR cont : Objects.Enumerator; p : ANY; el : XML.Element;s : Strings.String;
  138. BEGIN
  139. cont := layer.GetContents(); cont.Reset();
  140. WHILE cont.HasMoreElements() DO
  141. p := cont.GetNext();
  142. el := p(XML.Element);
  143. s := el.GetName(); IF s^ = "Line" THEN
  144. ParseLine(el, pos); mz := MAX(pos.z, mz);
  145. pos.z := pos.z + BoxDistance
  146. END
  147. END
  148. END ParseLayer;
  149. PROCEDURE Load(filename: ARRAY OF CHAR);
  150. VAR f : Files.File;
  151. scanner : Scanner.Scanner;
  152. parser : XMLParser.Parser;
  153. reader : Files.Reader;
  154. doc : XML.Document;
  155. p : ANY;
  156. root: XML.Element;
  157. el : XML.Content;
  158. s : Strings.String;
  159. cont : Objects.Enumerator;
  160. pos : Vectors.TVector3d;
  161. BEGIN
  162. index := 1;
  163. f := Files.Old(filename);
  164. IF f # NIL THEN
  165. NEW(reader, f, 0);
  166. NEW(scanner, reader); NEW(parser, scanner); doc := parser.Parse()
  167. END;
  168. root := doc.GetRoot();
  169. cont := root.GetContents(); cont.Reset();
  170. WHILE cont.HasMoreElements() DO
  171. p := cont.GetNext();
  172. el := p(XML.Element);
  173. IF el IS XML.Element THEN
  174. s := el(XML.Element).GetName(); IF s^ = "Layer" THEN
  175. ParseLayer(el(XML.Element), pos); my := MAX(pos.z, my);
  176. pos.y := pos.y + BoxDistance;
  177. END
  178. END
  179. END;
  180. lookat := Vectors.Vector3d(mx / 2, my / 2, mz / 2)
  181. END Load;
  182. PROCEDURE &New*(interval: LONGINT; fileName: ARRAY OF CHAR);
  183. VAR xpos, ypos : LONGINT;
  184. w, h : LONGINT;
  185. BEGIN
  186. w := 400; h := 400;
  187. xpos := 20; ypos := 30;
  188. Init(w, h, FALSE);
  189. SELF.interval := interval;
  190. manager := WM.GetDefaultManager();
  191. manager.Add(xpos, ypos, SELF, {WM.FlagFrame});
  192. manager.SetWindowTitle(SELF, WM.NewString("Cluster Watch 3d"));
  193. (* Init navigation parameters *)
  194. radius := 2000; angle := 0; height := 0;
  195. (* Setup the 3d World *)
  196. NEW(world, w, h, 0);
  197. world.quality := 1;
  198. NEW(infoList);
  199. Load(fileName);
  200. (* Background box *)
  201. NEW(timer)
  202. END New;
  203. PROCEDURE Close*;
  204. VAR i : LONGINT; o : ANY; info : Info;
  205. BEGIN {EXCLUSIVE}
  206. infoList.Lock;
  207. FOR i := 0 TO infoList.GetCount() - 1 DO o := infoList.GetItem(i); info := o(Info); info.Kill END;
  208. infoList.Unlock;
  209. infoList.Clear;
  210. manager.Remove(SELF);
  211. (*alive:=FALSE; timer.Wakeup *)
  212. END Close;
  213. (* BEGIN Navigation and Rendering *)
  214. PROCEDURE Render;
  215. VAR pos, dir, up : Vectors.TVector3d;
  216. BEGIN {EXCLUSIVE}
  217. pos := Vectors.VAdd3(lookat, Vectors.Vector3d(MathL.cos(angle) * radius, 0, MathL.sin(angle) * radius)); pos.y := height;
  218. lookat := Vectors.Vector3d(lookat.x, height, lookat.z);
  219. dir := Vectors.VNormed3(Vectors.VSub3(lookat, pos));
  220. up := Vectors.Vector3d(0, 1, 0);
  221. world.SetCamera(pos, dir, up); world.Render(img, FALSE);
  222. Invalidate(Rect.MakeRect(0,0,img.width, img.height))
  223. END Render;
  224. PROCEDURE PointerDown*(x, y:LONGINT; keys:SET);
  225. BEGIN
  226. mouseKeys := (keys * {0, 1, 2});
  227. oldX := x; oldY := y;
  228. IF mouseKeys = {1} THEN
  229. KernelLog.Int(world.GetOwnerIndex(x, y), 8); KernelLog.Ln
  230. END
  231. END PointerDown;
  232. PROCEDURE PointerMove*(x, y: LONGINT; keys : SET);
  233. BEGIN
  234. IF mouseKeys * {0} # {} THEN
  235. IF mouseKeys * {2} # {} THEN
  236. radius := radius - (y - oldY) * 10; IF radius < 10 THEN radius := 10 END;
  237. ELSE
  238. height := height + (y - oldY)
  239. END;
  240. angle := angle - (x - oldX) / img.width * 3.141;
  241. Render
  242. END;
  243. oldX := x; oldY := y
  244. END PointerMove;
  245. PROCEDURE PointerUp*(x, y:LONGINT; keys:SET);
  246. BEGIN
  247. mouseKeys := (keys * {0, 1, 2});
  248. END PointerUp;
  249. (* END Navigation and Rendering *)
  250. END Window;
  251. VAR
  252. w: Window;
  253. timg: Raster.Image;
  254. mode : Raster.Mode;
  255. PROCEDURE MatchI(VAR buf: ARRAY OF CHAR; with: ARRAY OF CHAR): BOOLEAN;
  256. VAR i: LONGINT;
  257. BEGIN
  258. i := 0; WHILE (with[i] # 0X) & (CAP(buf[i]) = CAP(with[i])) DO INC(i) END;
  259. RETURN with[i] = 0X
  260. END MatchI;
  261. PROCEDURE Watch*(context : Commands.Context);
  262. VAR
  263. name : ARRAY 100 OF CHAR;
  264. i, interval : LONGINT;
  265. BEGIN
  266. context.arg.SkipWhitespace; context.arg.String(name);
  267. (* steps *)
  268. context.arg.SkipWhitespace; context.arg.Int(interval, FALSE);
  269. IF interval = 0 THEN interval := 30000; END;
  270. NEW(w, interval, name);
  271. END Watch;
  272. PROCEDURE Cleanup;
  273. END Cleanup;
  274. BEGIN
  275. timg := WMGraphics.LoadImage("W3dClusterWatchIcons.tar://tux.bmp", TRUE);
  276. IF timg # NIL THEN
  277. NEW(OSImg[LinuxCAT]); Raster.Create(OSImg[LinuxCAT], timg.width, timg.height, Raster.BGR565);
  278. Raster.InitMode(mode, Raster.srcCopy);
  279. Raster.Copy(timg, OSImg[LinuxCAT], 0, 0, timg.width, timg.height, 0, 0, mode)
  280. END;
  281. timg := WMGraphics.LoadImage("W3dClusterWatchIcons.tar://windows.bmp", TRUE);
  282. IF timg # NIL THEN
  283. NEW(OSImg[WindowsCAT]); Raster.Create(OSImg[WindowsCAT], timg.width, timg.height, Raster.BGR565);
  284. Raster.InitMode(mode, Raster.srcCopy);
  285. Raster.Copy(timg, OSImg[WindowsCAT], 0, 0, timg.width, timg.height, 0, 0, mode)
  286. END;
  287. timg := WMGraphics.LoadImage("W3dClusterWatchIcons.tar://aos.gif", TRUE);
  288. IF timg # NIL THEN
  289. NEW(OSImg[AosCAT]); Raster.Create(OSImg[AosCAT], timg.width, timg.height, Raster.BGR565);
  290. Raster.InitMode(mode, Raster.srcCopy);
  291. Raster.Copy(timg, OSImg[AosCAT], 0, 0, timg.width, timg.height, 0, 0, mode)
  292. END;
  293. timg := WMGraphics.LoadImage("W3dClusterWatchIcons.tar://suse.bmp", TRUE);
  294. IF timg # NIL THEN
  295. NEW(OSImg[SuseCAT]); Raster.Create(OSImg[SuseCAT], timg.width, timg.height, Raster.BGR565);
  296. Raster.InitMode(mode, Raster.srcCopy);
  297. Raster.Copy(timg, OSImg[SuseCAT], 0, 0, timg.width, timg.height, 0, 0, mode)
  298. END;
  299. timg := WMGraphics.LoadImage("W3dClusterWatchIcons.tar://nocat.bmp", TRUE);
  300. IF timg # NIL THEN
  301. NEW(OSImg[NoCAT]); Raster.Create(OSImg[NoCAT], timg.width, timg.height, Raster.BGR565);
  302. Raster.InitMode(mode, Raster.srcCopy);
  303. Raster.Copy(timg, OSImg[NoCAT], 0, 0, timg.width, timg.height, 0, 0, mode)
  304. END;
  305. timg := WMGraphics.LoadImage("W3dClusterWatchIcons.tar://unknowncat.bmp", TRUE);
  306. IF timg # NIL THEN
  307. NEW(OSImg[UnknownCAT]); Raster.Create(OSImg[UnknownCAT], timg.width, timg.height, Raster.BGR565);
  308. Raster.InitMode(mode, Raster.srcCopy);
  309. Raster.Copy(timg, OSImg[UnknownCAT], 0, 0, timg.width, timg.height, 0, 0, mode)
  310. END;
  311. OSColor[NoCAT] := 0AAAAAAH; OSColor[AosCAT] := 0FF0000H; OSColor[LinuxCAT] := 0FFFF00H;
  312. OSColor[WindowsCAT] := 008080H; OSColor[SuseCAT] := 0FFH; OSColor[UnknownCAT] := 0FFFFFFH;
  313. Modules.InstallTermHandler(Cleanup)
  314. END W3dClusterWatch.
  315. Aos.Call W3dClusterWatch.Watch Cluster.XML 60000~
  316. Compiler.Compile \s TFVectors.Mod TFMatrix.Mod TFGeometry.Mod TFAbstractWorld.Mod TFObjectGenerator.Mod
  317. Float.TFRasterizer3d.Mod TFWorld3d.Mod TFExplorer.Mod ClusterWatch3d.Mod~
  318. PC.Compile \s TFVectors.Mod TFMatrix.Mod TFGeometry.Mod TFAbstractWorld.Mod TFObjectGenerator.Mod
  319. Float.TFRasterizer3d.Mod TFWorld3d.Mod TFExplorer.Mod ClusterWatch3d.Mod ~
  320. ~
  321. System.Free W3dClusterWatch W3dWorld W3dRasterizer W3dObjectGenerator W3dAbstractWorld W3dGeometry W3dMatrix W3dVectors~
  322. (* FILES *)
  323. Cluster.XML ClusterWatch3d.Mod TFAbstractWorld.Mod TFWorld3d.Mod TFObjectGenerator.Mod
  324. EditTools.OpenUnix Cluster.XML~