tel-ann-driver.red 8.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316
  1. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2. % TELERAY specIfic Procedures %
  3. % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  4. % Basic Teleray 1061 Plotter
  5. % Screen Range Is X := (-40,40) := (Left . . Right)
  6. % Y := (-12,12) := (Bottom . . Top)
  7. % Physical Size is D.X=~8inch, D.Y=~6inch
  8. % Want square asp[ect ratio for 100*100
  9. Procedure TEL!.OutChar x;
  10. PBOUT x;
  11. Procedure TEL!.OutCharString S; % Pbout a string
  12. For i:=0:Size S do TEL!.OutChar S[i];
  13. Procedure TEL!.NormX X;
  14. FIX(X)+40;
  15. Procedure TEL!.NormY Y;
  16. 12 - FIX(Y);
  17. Procedure TEL!.ChPrt(X,Y,Ch);
  18. <<TEL!.OutChar Char ESC;
  19. TEL!.OutChar 89;
  20. TEL!.OutChar (32+TEL!.NormY Y);
  21. TEL!.OutChar (32+ TEL!.NormX X);
  22. TEL!.OutChar Ch>>;
  23. Procedure TEL!.IdPrt(X,Y,Id);
  24. TEL!.ChPrt(X,Y,ID2Int ID);
  25. Procedure TEL!.StrPrt (X,Y,S);
  26. <<TEL!.OutChar Char ESC;
  27. TEL!.OutChar 89;
  28. TEL!.OutChar (32+TEL!.NormY Y);
  29. TEL!.OutChar (32+ TEL!.NormX X);
  30. TEL!.OutCharString S>>;
  31. Procedure TEL!.HOME (); % Home (0,0)
  32. <<TEL!.OutChar CHAR ESC;
  33. TEL!.OutChar 'H>>;
  34. Procedure TEL!.EraseS (); % Delete Entire Screen
  35. <<TEL!.OutChar CHAR ESC;
  36. TEL!.OutChar '!j>>;
  37. Procedure TEL!.DDA (X1,Y1,X2,Y2,dotter);
  38. Begin scalar Dx,Dy,Xc,Yc,I,R,S;
  39. % From N & S, Page 44, Draw Straight Pointset
  40. Dx := X2-X1; Dy := Y2-Y1; R := 0.5;
  41. If Dx >= 0 then Xc := 1 else <<Xc := -1;Dx := -Dx >>;
  42. If Dy >= 0 then Yc := 1 else <<Yc := -1;Dy := -Dy >>;
  43. If Dx <= Dy then Goto doy;
  44. S := FLOAT(Dy)/Dx;
  45. For I := 1:Dx do
  46. <<R := R+S;
  47. If R>=1.0 then <<Y1 := Y1+Yc;R := R-1.0 >>;
  48. X1 := X1+Xc;
  49. APPLY(dotter,LIST(X1,Y1)) >>;
  50. Return NIL;
  51. doy:S := float(Dx) / Dy;
  52. For I := 1:Dy do
  53. <<R := R+S;
  54. If R>=1.0 then <<X1 := X1+Xc;R := R-1 >>;
  55. Y1 := Y1+Yc;
  56. APPLY(dotter,LIST (X1,Y1)) >>;
  57. Return NIL
  58. end;
  59. Procedure Tel!.MoveS (X1,Y1);
  60. <<Xhere := X1;
  61. Yhere := Y1>>;
  62. Procedure Tel!.DrawS (X1,Y1);
  63. << TEL!.DDA (Xhere,Yhere, X1, Y1,function TEL!.dotc);
  64. Xhere :=X1; Yhere :=Y1>>;
  65. Procedure Idl2chl (X); % Convert Idlist To Char List
  66. Begin scalar Y;
  67. While Pairp (X) do <<Y := getv (Sfromid car X, 1) . Y;X := Cdr X >>;
  68. Return (Reverse (Y))
  69. end;
  70. FLUID '(Tchars);
  71. Procedure Texter (X1,Y1,X2,Y2,Txt);
  72. Begin scalar Tchars;
  73. Tchars := Idl2chl (Explode2 (Txt));
  74. Return (TEL!.DDA (X1,Y1,X2,Y2,function Tdotc))
  75. end;
  76. Procedure Tdotc (X1,Y1);
  77. Begin
  78. If Null Tchars then Return (Nil);
  79. If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
  80. If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
  81. TEL!.ChPrt (X1 , Y1,Car Tchars);
  82. No:Tchars := Cdr Tchars;
  83. Return ('T)
  84. end;
  85. Procedure TEL!.dotc (X1,Y1); % Draw And Clip An X
  86. TEL!.ChClip (X1,Y1,Char X) ;
  87. Procedure TEL!.ChClip (X1,Y1,Id);
  88. Begin
  89. If (X1 > X2clip) Or (X1 < X1clip) then Goto No;
  90. If (Y1 > Y2clip) Or (Y1 < Y1clip) then Goto No;
  91. TEL!.ChPrt (X1 , Y1,Id);
  92. No:Return ('T)
  93. end;
  94. Procedure Tel!.VwPort(X1,X2,Y1,Y2);
  95. <<X1clip := Max2 (-40,X1);
  96. X2clip := Min2 (40,X2);
  97. Y1clip := Max2 (-12,Y1);
  98. Y2clip := Min2 (12,Y2)>>;
  99. Procedure Tel!.Wfill (X1,X2,Y1,Y2,Id);
  100. Begin scalar X,Y;
  101. For Y := Y1 : Y2 do
  102. For X := X1 : X2 do TEL!.ChClip (X,Y,Id);
  103. end;
  104. Procedure TEL!.Wzap (X1,X2,Y1,Y2);
  105. TEL!.Wfill (X1,X2,Y1,Y2,'! ) ;
  106. Procedure TEL!.Delay;
  107. NIL;
  108. Procedure TEL!.GRAPHON();
  109. If not !*emode then echooff();
  110. Procedure TEL!.GRAPHOFF();
  111. If not !*emode then echoon();
  112. Procedure TEL!.INIT (); % Setup For TEL As Device;
  113. Begin
  114. Dev!. := 'TEL;
  115. FNCOPY('EraseS,'TEL!.EraseS);
  116. FNCOPY('MoveS,'TEL!.MoveS);
  117. FNCOPY('DrawS,'TEL!.DrawS);
  118. FNCOPY( 'NormX, 'TEL!.NormX)$
  119. FNCOPY( 'NormY, 'TEL!.NormY)$
  120. FNCOPY('VwPort,'TEL!.VwPort);
  121. FNCOPY('Delay,'TEL!.Delay);
  122. FNCOPY( 'GraphOn, 'TEL!.GraphOn)$
  123. FNCOPY( 'GraphOff, 'TEL!.GraphOff)$
  124. Erase();
  125. VwPort (-40,40,-12,12);
  126. Print "Device Now TEL";
  127. end;
  128. % Basic ANN ARBOR AMBASSADOR Plotter
  129. %
  130. % Screen Range Is X := (-40,40) := (Left . . Right)
  131. % Y := (-30,30) := (Bottom . . Top)
  132. Procedure ANN!.OutChar x;
  133. PBOUT x;
  134. Procedure ANN!.OutCharString S; % Pbout a string
  135. For i:=0:Size S do ANN!.OutChar S[i];
  136. Procedure ANN!.NormX X; % so --> X
  137. 40 + FIX(X+0.5);
  138. Procedure ANN!.NormY Y; % so ^
  139. 30 - FIX(Y+0.5); % | Y
  140. Procedure ANN!.XY(X,Y);
  141. << Ann!.OutChar(char ESC);
  142. Ann!.OutChar(char ![);
  143. x:=Ann!.NormX(x);
  144. y:=Ann!.NormY(y);
  145. % Use "quick and dirty" conversion to decimal digits.
  146. Ann!.OutChar(char 0 + (1 + Y)/10);
  147. Ann!.OutChar(char 0 + remainder(1 + Y, 10));
  148. Ann!.OutChar(char !;);
  149. % Delimiter between row digits and column digits.
  150. Ann!.OutChar(char 0 + (1 + X)/10);
  151. Ann!.OutChar(char 0 + remainder(1 + X, 10));
  152. Ann!.OutChar(char H); % Terminate the sequence
  153. >>;
  154. Procedure ANN!.ChPrt(X,Y,Ch);
  155. <<ANN!.XY(X,Y);
  156. ANN!.OutChar Ch>>;
  157. Procedure ANN!.IdPrt(X,Y,Id);
  158. ANN!.ChPrt(X,Y,ID2Int ID);
  159. Procedure ANN!.StrPrt(X,Y,S);
  160. <<ANN!.XY(X,Y);
  161. ANN!.OutCharString S>>;
  162. Procedure ANN!.EraseS(); % Delete Entire Screen
  163. <<ANN!.OutChar CHAR ESC;
  164. ANN!.OutChar Char '![;
  165. Ann!.OutChar Char 2;
  166. Ann!.OutChar Char J;
  167. Ann!.XY(0,0);>>;
  168. Procedure ANN!.DDA(X1,Y1,X2,Y2,dotter);
  169. Begin scalar Dx,Dy,Xc,Yc,I,R,S;
  170. % From N & S, Page 44, Draw Straight Pointset
  171. Dx := X2-X1; Dy := Y2-Y1; R := 0.5;
  172. If Dx >= 0 then Xc := 1 else <<Xc := -1;Dx := -Dx >>;
  173. If Dy >= 0 then Yc := 1 else <<Yc := -1;Dy := -Dy >>;
  174. If Dx <= Dy then Goto doy;
  175. S := FLOAT(Dy)/Dx;
  176. For I := 1:Dx do
  177. <<R := R+S;
  178. If R>=1.0 then <<Y1 := Y1+Yc;R := R-1.0 >>;
  179. X1 := X1+Xc;
  180. APPLY(dotter,LIST(X1,Y1)) >>;
  181. Return NIL;
  182. doy:S := float(Dx) / Dy;
  183. For I := 1:Dy do
  184. <<R := R+S;
  185. If R>=1.0 then <<X1 := X1+Xc;R := R-1 >>;
  186. Y1 := Y1+Yc;
  187. APPLY(dotter,LIST(X1,Y1)) >>;
  188. Return NIL
  189. end;
  190. Procedure ANN!.MoveS(X1,Y1);
  191. <<Xhere := X1;
  192. Yhere := Y1>>;
  193. Procedure ANN!.DrawS(X1,Y1);
  194. << ANN!.DDA(Xhere,Yhere, X1, Y1,function ANN!.dotc);
  195. Xhere :=X1; Yhere :=Y1>>;
  196. Procedure Idl2chl(X); % Convert Idlist To Char List
  197. Begin scalar Y;
  198. While Pairp(X) do <<Y := getv(Sfromid car X, 1) . Y;X := Cdr X >>;
  199. Return(Reverse(Y))
  200. end;
  201. FLUID '(Tchars);
  202. Procedure Texter(X1,Y1,X2,Y2,Txt);
  203. Begin scalar Tchars;
  204. Tchars := Idl2chl(Explode2(Txt));
  205. Return(ANN!.DDA(X1,Y1,X2,Y2,function ANN!.Tdotc))
  206. end;
  207. Procedure ANN!.Tdotc(X1,Y1);
  208. Begin
  209. If Null Tchars then Return(Nil);
  210. If(X1 > X2clip) Or(X1 < X1clip) then Goto No;
  211. If(Y1 > Y2clip) Or(Y1 < Y1clip) then Goto No;
  212. ANN!.ChPrt(X1 , Y1,Car Tchars);
  213. No:Tchars := Cdr Tchars;
  214. Return('T)
  215. end;
  216. Procedure ANN!.dotc(X1,Y1); % Draw And Clip An X
  217. ANN!.ChClip(X1,Y1,Char !*) ;
  218. Procedure ANN!.ChClip(X1,Y1,Id);
  219. Begin
  220. If(X1 > X2clip) Or(X1 < X1clip) then Goto No;
  221. If(Y1 > Y2clip) Or(Y1 < Y1clip) then Goto No;
  222. ANN!.ChPrt(X1 , Y1,Id);
  223. No:Return('T)
  224. end;
  225. Procedure ANN!.VwPort(X1,X2,Y1,Y2);
  226. <<X1clip := Max2(-40,X1);
  227. X2clip := Min2(40,X2);
  228. Y1clip := Max2(-30,Y1);
  229. Y2clip := Min2(30,Y2)>>;
  230. Procedure ANN!.Wfill(X1,X2,Y1,Y2,Id);
  231. Begin scalar X,Y;
  232. For Y := Y1 : Y2 do
  233. For X := X1 : X2 do ANN!.ChClip(X,Y,Id);
  234. end;
  235. Procedure ANN!.Wzap(X1,X2,Y1,Y2);
  236. ANN!.Wfill(X1,X2,Y1,Y2,'! ) ;
  237. Procedure ANN!.Delay;
  238. NIL;
  239. Procedure ANN!.GRAPHON();
  240. If not !*emode then echooff();
  241. Procedure ANN!.GRAPHOFF();
  242. If not !*emode then echoon();
  243. Procedure ANN!.INIT(); % Setup For ANN As Device;
  244. Begin
  245. Dev!. := 'ANN60;
  246. FNCOPY('EraseS,'ANN!.EraseS);
  247. FNCOPY('MoveS,'ANN!.MoveS);
  248. FNCOPY('DrawS,'ANN!.DrawS);
  249. FNCOPY('NormX, 'ANN!.NormX)$
  250. FNCOPY('NormY, 'ANN!.NormY)$
  251. FNCOPY('VwPort,'ANN!.VwPort);
  252. FNCOPY('Delay,'ANN!.Delay);
  253. FNCOPY('GraphOn, 'ANN!.GraphOn)$
  254. FNCOPY('GraphOff, 'ANN!.GraphOff)$
  255. Erase();
  256. VwPort(-40,40,-30,30);
  257. Print "Device Now ANN60";
  258. end;