home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 October / usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso / games / volume1 / othello1 / part01 / regis.mod < prev    next >
Text File  |  1987-06-08  |  5KB  |  281 lines
  1. IMPLEMENTATION MODULE regis;
  2. (* Lo-level ReGIS graphics commands.                             *)
  3.  
  4. FROM     SysStreams    IMPORT    sysOut;
  5. FROM     CharCodes    IMPORT  EscapeCh;
  6. FROM    TextIO          IMPORT  WriteCHAR;
  7. FROM    InOut           IMPORT  Write;
  8. FROM    InOut           IMPORT  WriteInt;
  9. FROM    InOut           IMPORT  WriteString;
  10.  
  11.  
  12. PROCEDURE esc; (* Prints an escape character. *)
  13. BEGIN
  14.   WriteCHAR(sysOut,EscapeCh)
  15. END esc;
  16.  
  17. PROCEDURE ExitGr; (* Exit ReGIS mode. *)
  18. BEGIN
  19.   esc;
  20.   Write("S");
  21. END ExitGr;
  22.  
  23. PROCEDURE Reset; (* Sets defaults. *)
  24. BEGIN
  25.    esc;
  26.    WriteString('Pp;S(I0N0A)W(VI7A0S0M1N0P1M2)T(I0A0D0S1)P[0,0]\\');
  27. END Reset;
  28.  
  29. PROCEDURE Position(x,y:INTEGER); (* Position cursor  at x, y     *)
  30. BEGIN
  31.    esc;
  32.    WriteString('PpP[');
  33.    WriteInt(x ,1);
  34.    Write(',');
  35.    WriteInt(y,1);
  36.    WriteString(']\\');
  37. END Position;
  38.  
  39. PROCEDURE Circle(x,y:INTEGER); (* Draw circle of width x, hight y. *)
  40. BEGIN
  41.    esc;
  42.    WriteString('PpC[+');
  43.    WriteInt(x,1);
  44.    WriteString(',+');
  45.    WriteInt(y,1);
  46.    WriteString(']\\');
  47. END Circle;
  48.  
  49. PROCEDURE Arc(x,y,angle:INTEGER); (* Draw an arc. *)
  50. BEGIN
  51.    esc;
  52.    WriteString('PpC(A');
  53.    WriteInt(angle,1);
  54.    WriteString(')[');
  55.  
  56.    IF x >=0 THEN
  57.       Write('+');
  58.       WriteInt(x, 1);
  59.    ELSE
  60.       Write('-');
  61.       WriteInt(-x, 1);
  62.    END;
  63.    IF y >=0 THEN
  64.       Write('+');
  65.       WriteInt(y, 1);
  66.       WriteString(']\\');
  67.    ELSE
  68.       Write('-');
  69.       WriteInt(-y, 1);
  70.       WriteString(']\\');
  71.    END;
  72. END Arc;
  73.  
  74. PROCEDURE Pattern(p:String);
  75. BEGIN
  76.   esc;
  77.   WriteString('PpW(P"');
  78.   WriteString(p);
  79.   WriteString('")\\');
  80. END Pattern;
  81.  
  82. PROCEDURE Plot(x,y:INTEGER); (* Draw one pixel. *)
  83. BEGIN
  84.    Position(x,y);
  85.    esc;
  86.    WriteString('PpV[]\\');
  87. END Plot;
  88.  
  89. PROCEDURE DrawTo(x,y:INTEGER); (* Used after other command, draws line *)
  90. BEGIN
  91.    esc;
  92.    WriteString('PpV[');
  93.    WriteInt(x, 1);
  94.    Write(',');
  95.    WriteInt(y, 1);
  96.    WriteString(']\\');
  97. END DrawTo;
  98.  
  99. PROCEDURE Color(colr: CHAR); (* Use R(ed), G(reen), B(lue), or D(ark). *)
  100. BEGIN
  101.    esc;
  102.    WriteString('Pp W(I(H');
  103.    Write(colr);
  104.    WriteString('))\\');
  105. END Color;
  106.  
  107. PROCEDURE Box(width, height: INTEGER);
  108. BEGIN
  109.    esc;
  110.    WriteString('PpV[+');
  111.    WriteInt(width, 1);
  112.    WriteString(',+');
  113.    WriteInt(0, 1);
  114.    WriteString(']\\');
  115.    WriteString('PpV[+');
  116.    WriteInt(0, 1);
  117.    WriteString(',+');
  118.    WriteInt(height, 1);
  119.    WriteString(']\\');
  120.    WriteString('PpV[-');
  121.    WriteInt(width, 1);
  122.    WriteString(',+');
  123.    WriteInt(0, 1);
  124.    WriteString(']\\');
  125.    WriteString('PpV[+');
  126.    WriteInt(0, 1);
  127.    WriteString(',-');
  128.    WriteInt(height, 1);
  129.    WriteString(']\\');
  130. END Box;
  131.  
  132. PROCEDURE Scroll(dx,dy:INTEGER);
  133. BEGIN
  134.    esc;
  135.    WriteString('PpS[+');
  136.    WriteInt(dx, 1);
  137.    WriteString(',+');
  138.    WriteInt(dy, 1);
  139.    WriteString(']\\')
  140. END Scroll;
  141.  
  142. PROCEDURE ClearScreen; (* Clears graphic screen *)
  143. BEGIN
  144.    esc;
  145.    WriteString('PpS(E)\\');
  146. END ClearScreen;
  147.  
  148. PROCEDURE WriteText(message: String); 
  149. BEGIN
  150.    esc;
  151.    WriteString('PpT"');
  152.    WriteString(message);
  153.    WriteString('"\\');
  154. END WriteText;
  155.  
  156. PROCEDURE WriteNum(num : INTEGER);
  157. BEGIN
  158.    esc;
  159.    WriteString('PpT"');
  160.    WriteInt(num, 1);
  161.    WriteString('"\\');
  162. END WriteNum;
  163.  
  164. PROCEDURE WriteChr(chr : CHAR);
  165. BEGIN
  166.    esc;
  167.    WriteString('PpT"');
  168.    Write(chr);
  169.    WriteString('"\\');
  170. END WriteChr;
  171.  
  172. PROCEDURE TextDirection(angle: INTEGER); (* Write vertically, etc. *)
  173. BEGIN
  174.    esc;
  175.    WriteString('PpT(D');
  176.    WriteInt(angle, 1);
  177.    WriteString(')\\');
  178. END TextDirection;
  179.  
  180. PROCEDURE TextSlant(angle: INTEGER); (* -10 slants to right. *)
  181. BEGIN
  182.    esc;
  183.    WriteString('PpT(I');
  184.    WriteInt(angle, 1);
  185.    WriteString(')\\');
  186. END TextSlant;
  187.  
  188. PROCEDURE TextSize(size: INTEGER); (* 2 doubles size. *)
  189. BEGIN
  190.    esc;
  191.    WriteString('PpT(S');
  192.    WriteInt(size, 1);
  193.    WriteString(')\\');
  194. END TextSize;
  195.  
  196. (*
  197. PROCEDURE TextMatrixSize(x,y:INTEGER);
  198. BEGIN
  199.   esc;
  200.   WriteF2(sysOut,'PpT(S[%d,%d])\\',x,y);
  201. END TextMatrixSize;
  202.  
  203. PROCEDURE TextPixelMultiply(x,y:INTEGER);
  204. BEGIN
  205.   esc;
  206.   WriteF2(sysOut,'[PpT(M[%d,$d])\\',x,y);
  207. END TextPixelMultiply;
  208.  
  209. PROCEDURE TextAttributes(Width,Height,xMult,yMult,xDir,yDir,Slant : INTEGER);
  210. BEGIN
  211.   WriteF0(sysOut,'PpT(S[%d,%d] M[%d,%d] I%d ) [%d,%d]',
  212.                 Width,Height,xMult,yMult,Slant,xDir,yDir);
  213. END TextAttributes;
  214.  
  215. PROCEDURE TextSpacing(dx,dy:INTEGER);
  216. BEGIN
  217.    esc;
  218.    WriteF2(sysOut,'Pp[%d,%d]\\',dx,dy);
  219. END TextSpacing;
  220.  
  221. PROCEDURE SelectCharSet(n : INTEGER);
  222. BEGIN
  223.    esc;
  224.    WriteF1(sysOut,'PpT(A%d)\\',n);
  225. END SelectCharSet;
  226.  
  227. PROCEDURE RedefineChar(Cset : INTEGER; c : CHAR; pattern : String);
  228. VAR i : INTEGER;
  229. BEGIN
  230.    esc;
  231.    WriteF2(sysOut,'PpL(A%d) ''%c'' ',Cset,c);
  232.    FOR i:= 0 to high(pattern) DO 
  233.      esc;
  234.      WriteF1(sysOut,'%c',pattern[i]);
  235.    END;
  236.    esc;
  237.    WriteF0(sysOut,'\\');
  238. END RedefineChar;
  239. *)
  240.  
  241. PROCEDURE SetFill(y: INTEGER); (* Turns on fill at y. *)
  242. BEGIN
  243.    esc;
  244.    WriteString('PpW(S1)(S[,');
  245.    WriteInt(y,1);
  246.    WriteString(';])\\');
  247. END SetFill;
  248.  
  249. (*
  250. PROCEDURE SetFillChar(c: CHAR; y:INTEGER);
  251. BEGIN
  252.    esc;
  253.    WriteF2(sysOut,'PpW(S''%c''[,%d])\\',c,y);
  254. END SetFillChar;
  255. *)
  256.  
  257. PROCEDURE UnsetFill; (* Turns off fill. *)
  258. BEGIN
  259.    esc;
  260.    WriteString('PpW(S0)\\');
  261. END UnsetFill;
  262.  
  263. PROCEDURE BGColor(colr:CHAR); (* Back ground color. *)
  264. BEGIN
  265.    esc;
  266.    WriteString('PpS(I(H');
  267.    Write(colr);
  268.    WriteString('))\\');
  269. END BGColor;
  270.  
  271. PROCEDURE NormalText;
  272. BEGIN
  273.    esc;
  274.    WriteString('PpT(E)\\');
  275. END NormalText;
  276.  
  277.  
  278. END regis.
  279.  
  280.  
  281.