home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / EDUCATIN / K-CHING.LBR / STATUSLN.MZD / STATUSLN.MOD
Text File  |  2000-06-30  |  10KB  |  312 lines
  1. IMPLEMENTATION MODULE StatusLn;
  2. FROM Terminal IMPORT WriteString, GotoXY, ReadChar, WriteChar;
  3. FROM Strings IMPORT Append, Length, Copy, Insert, Delete;
  4.  
  5.  
  6.  
  7. PROCEDURE CursorRecall(Mem: BOOLEAN);
  8.     (* If Mem is TRUE current cursor position is remembered
  9.     If Mem is FALSE  the cursor is returned to previously membered position!*)
  10. BEGIN
  11.     WriteChar(33C);
  12.     IF Mem=TRUE THEN WriteChar('B') ELSE WriteChar('C'); END;
  13.     WriteChar('6');
  14. END CursorRecall;
  15.  
  16.  
  17. PROCEDURE PreserveStatusLine(Mem: BOOLEAN);
  18.     (* I've got no idea what this function does. It's just mentioned
  19.     briefly in the Kaypro manual. In case I ever want to use it...
  20.     TRUE turns preservation on, FALSE turns it off. WOW! *)
  21. BEGIN
  22.     WriteChar(33C);
  23.     IF Mem=TRUE THEN WriteChar('B') ELSE WriteChar('C'); END;
  24.     WriteChar('7');
  25. END PreserveStatusLine;
  26.  
  27.  
  28. PROCEDURE GotoStatusX(x: CARDINAL);
  29.     (* Gets around m2's inability [ie BUG] to write to the status line
  30.     and have the editor behave as well by writing a Kaypro excape sequence
  31.     Notice that the statusline scrolls after every LF, so a WriteLn following
  32.     this routine will note give lasting results. Also, the cursor MUST be
  33.     dragged out of the statusline back to its proper position in the text
  34.     before continuing normal text output *)
  35. BEGIN
  36.     WriteChar(33C);
  37.     WriteChar('=');
  38.     WriteChar(CHR(24+32));
  39.     WriteChar(CHR(x+32));
  40. END GotoStatusX;
  41.  
  42.  
  43. PROCEDURE Blank(x: CARDINAL);
  44.     (* Blanks the screen and homes cursor if x=0
  45.     If x>99 prints x DIV 100 LINEFEEDS
  46.     then prints 1-99 [x MOD 100] blanks at current position
  47.     *)
  48. VAR y: CARDINAL;
  49. BEGIN
  50.     IF x=0 THEN WriteChar(32C); (*BLANK SCREEN*)
  51.     ELSE
  52.         FOR y:= 1 TO (x DIV 100) DO
  53.             WriteChar(15C);
  54.             WriteChar(12C);
  55.         END;
  56.  
  57.         FOR y:= 1 TO (x MOD 100) DO WriteChar(' '); END;
  58.     END;
  59. END Blank;
  60.  
  61.  
  62. PROCEDURE ErrorMessage(s: ARRAY OF CHAR);
  63.     (* Writes an errormessage to the programmer.
  64.     Program Execution can be halted at this point by pressing ^C
  65.     *)
  66. VAR c: CHAR;
  67. BEGIN
  68.     CursorRecall(TRUE);
  69.     GotoStatusX(0);
  70.     WriteString('ERROR : ');
  71.     WriteString(s);
  72.     WriteString(' (^C abort) ');
  73.     ReadChar(c);
  74.     IF (c=CHR(3)) THEN HALT; END;
  75.     GotoStatusX(0);
  76.     Blank(79);
  77.     CursorRecall(FALSE);
  78. END ErrorMessage;
  79.  
  80.  
  81. PROCEDURE InputED(VAR StringToEdit: ARRAY OF CHAR; Prompt: ARRAY OF CHAR;
  82.                   MaxLength   : CARDINAL) ;
  83.     (* This little gem enables you to input with editing, starting from
  84.     scratch [''] or from an assigned default StringToEdit.
  85.     Prompt is usually = '>' or '?'.
  86.  
  87.         <CR> with the cursor in col zero returns the original StringToEdit,
  88.         ignoring any changes that have been made during the procedure.
  89.  
  90.         <CR> anywhere else truncates the string at the character before the
  91.         cursor and returns that value.
  92.  
  93.         <ESC> returns the entire string as displayed, regardless of cursor
  94.         position.
  95.  
  96.         <DEL> Deletes the Char to the left of the cursor and closes the gap
  97.  
  98.         <TAB> (^I) Inserts a space at the current cursor position.
  99.  
  100.         <LEFTARROW> (^H or ^S) performs nondestructive backspace.
  101.  
  102.         <RIGHTARROW> (^L or ^D) performs nondestructive aheadspace upto
  103.         MaxLength.
  104.  
  105.         ^C halts the program.
  106.  
  107.         All printable characters are accepted into the displayed string,
  108.         overwriting the character under the cursor and advancing one position.
  109.  
  110.     If the Default StringToEdit is longer than MaxLength, it is truncated.
  111.     MaxLength MUST be <80.
  112.     Trailing blanks are stripped from result.
  113.  
  114.     *)
  115. VAR
  116.     x,xx: CARDINAL;
  117.     SafeString,TempString: ARRAY [0..79] OF CHAR;
  118.     c: CHAR;
  119. BEGIN
  120.     IF MaxLength>79 THEN
  121.         ErrorMessage('MaxLength > 79');
  122.     END;
  123.     IF Length(StringToEdit)>MaxLength
  124.         THEN Copy(StringToEdit,1,MaxLength,StringToEdit);
  125.         END;
  126.  
  127.     SafeString:=StringToEdit;
  128.     GotoStatusX(0);
  129.     Blank(80);
  130.     GotoStatusX(0);
  131.     WriteString(Prompt);
  132.     x:=Length(Prompt);
  133.     xx:=x;
  134.     GotoStatusX(xx);
  135.     WriteString(StringToEdit);
  136.     GotoStatusX(xx);
  137.     REPEAT
  138.         ReadChar(c);
  139.         IF ( (c=(10C)) OR (c=CHR(19)) ) AND (xx>x) THEN
  140.             xx:=xx-1;
  141.             GotoStatusX(xx);
  142.         ELSIF ( (c=(14C)) OR (c=(4C)) ) AND (xx-x<MaxLength)
  143.                 AND  ( xx-x<Length(StringToEdit) )
  144.           THEN
  145.             xx:=xx+1;
  146.             GotoStatusX(xx);
  147.         ELSIF (c=(33C))THEN StringToEdit:=StringToEdit;
  148.         ELSIF (c=(15C)) AND (xx=x) THEN StringToEdit:=SafeString;
  149.         ELSIF (c=(15C)) THEN
  150.               Copy(StringToEdit,0,(xx-x),TempString);
  151.               StringToEdit:=TempString;
  152.         ELSIF ( (ORD(c)=127) (*DEL*) AND (xx-x>0) ) THEN
  153.             Delete(StringToEdit,(xx-x-1),1);
  154.             xx:=xx-1;
  155.             GotoStatusX(x);
  156.             WriteString(StringToEdit);
  157.             WriteChar(' ');
  158.             GotoStatusX(xx);
  159.         ELSIF (ORD(c)=3) (*CTRL-C*) THEN HALT;
  160.         ELSIF ( ORD(c)=9 (*TAB*) ) THEN
  161.             Insert(' ',StringToEdit,xx-x);
  162.             IF (Length(StringToEdit)>MaxLength)
  163.                THEN Delete(StringToEdit,Length(StringToEdit),1);
  164.             END;
  165.             GotoStatusX(x);
  166.             WriteString(StringToEdit);
  167.             GotoStatusX(xx);
  168.         ELSIF ( (ORD(c)>31) AND (ORD(c)<127) ) THEN
  169.             IF ( (xx-x)<=Length(StringToEdit) ) AND (xx-x<=MaxLength)  THEN
  170.                     StringToEdit[xx-x]:=c;
  171.  
  172.             ELSIF (xx-x<=MaxLength) AND (xx-x>Length(StringToEdit)) THEN
  173.                     Append(' ',StringToEdit);
  174.                     StringToEdit[xx-x]:=c;
  175.             END;
  176.  
  177.             IF xx-x<=MaxLength THEN
  178.                 WriteChar(c);
  179.                 xx:=xx+1;
  180.             END;
  181.         END;
  182.     UNTIL ( (c=(15C)) OR (ORD(c)=27) );
  183.  
  184.     WHILE (StringToEdit[Length(StringToEdit)] = ' ') DO
  185.         Delete(StringToEdit, Length(StringToEdit), 1);
  186.     END; (* Remove Trailing Blanks *)
  187. END InputED;
  188.  
  189.  
  190. PROCEDURE HitAny;
  191. VAR c: CHAR;
  192.     (*
  193.     Calls a temporary halt in execution with the prompt
  194.     "Press ANY key to continue" on the statusline.
  195.     ^C will abort the program.
  196.     Cursor is returned to screenposition it occupied prior to HitAny
  197.     *)
  198. BEGIN
  199.     CursorRecall(TRUE);
  200.     GotoStatusX(0);
  201.     Blank(79);
  202.     GotoStatusX(0);
  203.     WriteString('Press ANY key to continue ');
  204.     ReadChar(c);
  205.     IF c=CHR(3) THEN HALT; END;
  206.     CursorRecall(FALSE);
  207. END HitAny;
  208.  
  209.  
  210. PROCEDURE UserWantsTo(Question: ARRAY OF CHAR): BOOLEAN;
  211.     (*
  212.     Cleverly worded PROCEDURE name forms an English phrase with clear meaning
  213.     if Question is worded to complete the option being queried:
  214.     e.g.
  215.         IF UserWantsTo('Continue') THEN . . . ELSE HALT;
  216.     displays
  217.         Continue? (Y/n)
  218.     on the statusline. N,n,<ESC>= FALSE. ^C aborts. Y,y,<SP>,<CR> = TRUE.
  219.     Nothing else is accepted.
  220.     Cursor is remembered and replaced.
  221.     NB: This function supplies its own questionmark!!
  222.     *)
  223. VAR c: CHAR;
  224. BEGIN
  225.     CursorRecall(TRUE);
  226.     GotoStatusX(0);
  227.     Blank(79);
  228.     GotoStatusX(0);
  229.     WriteString(Question);
  230.     WriteString('?  (Y/n) ');
  231.   LOOP;
  232.     ReadChar(c);
  233.     CursorRecall(FALSE);
  234.     IF c=CHR(3) THEN HALT;
  235.     ELSIF ( (c='N') OR (c='n') OR (c=CHR(27)) ) THEN RETURN FALSE;
  236.     ELSIF ( (c='Y') OR (c='y') OR (c=CHR(13)) OR (c=' ') ) THEN RETURN TRUE;
  237.     END;
  238.   END;
  239. END UserWantsTo;
  240.  
  241.  
  242. PROCEDURE Copyright
  243.     (ProgramName,Version,Date: ARRAY OF CHAR; PrivateDomain: BOOLEAN);
  244. VAR x: INTEGER;
  245.     (* Generates an opening screen complete with copyright notice
  246.     and version number. If PrivateDomain is FALSE, program is ceded to
  247.     the Public Domain.
  248.     ProgramName may be upto 80CHARs long and is displayed centered in a
  249.     prominant position. To ensure fit, Date should be 4-10 chars eg '1987'
  250.     *)
  251. BEGIN
  252.     WriteChar(CHR(26)); (*CLEARSCREEN*)
  253.  
  254. (*DRAW BOX*)
  255.     GotoXY(10,3);
  256.     FOR x:= 1 TO 30 DO WriteChar('*'); WriteChar(' '); END;
  257.     GotoXY(70,3); WriteChar('*');
  258.     FOR x := 4 TO 17 DO
  259.         GotoXY(10,x);WriteChar('*');
  260.         GotoXY(70,x);WriteChar('*');
  261.     END;
  262.     GotoXY(10,18);
  263.     FOR x:= 1 TO 30 DO WriteChar('*'); WriteChar(' '); END;
  264.     GotoXY(70,18); WriteChar('*');
  265.     x:= (80-Length(ProgramName)) DIV 2;
  266.     GotoXY(x,6);
  267.     WriteString(ProgramName);
  268.  
  269.     x:= ((80-Length(Version)-8) DIV 2);
  270.     GotoXY(x,8);
  271.     WriteString('version ');
  272.     WriteString(Version);
  273.  
  274.  
  275.     GotoXY(15,12);
  276.     IF PrivateDomain THEN
  277.         WriteString('(c) ');
  278.         WriteString(Date);
  279.         WriteString(' Copyright J. F. Cuff' );
  280.     ELSE
  281.         WriteString('(pd) ');
  282.         WriteString(Date);
  283.         WriteString(' placed in the Public Domain by J. F. Cuff' );
  284.     END;
  285.  
  286.     GotoXY(15,14);
  287.     WriteString('dba ZYQOTE Systems');
  288.     GotoXY(15,15);
  289.     WriteString('P. O. Box 1165 - Bonavista - Newfoundland - A0C 1B0');
  290.     GotoStatusX(0);
  291.  
  292. END Copyright;
  293.  
  294.  
  295. PROCEDURE Notice(s: ARRAY OF CHAR);
  296.     (*Blanks the Statusline then writes the message s to the statusline.
  297.     Returns Cursor to precall position on exit.
  298.     *)
  299. BEGIN
  300.     CursorRecall(TRUE);
  301.     GotoStatusX(0);
  302.     Blank(79);    (* to blankout any previous message *)
  303.     GotoStatusX(0);
  304.     WriteString(s);
  305.     CursorRecall(FALSE);
  306. END Notice;
  307.  
  308.  
  309.  
  310.  
  311. END StatusLn.
  312.