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 / BEEHIVE / UTILITYS / FONTM2A.ARC / SCRH.INC < prev    next >
Text File  |  1989-09-27  |  7KB  |  230 lines
  1. {this module needs to have defined several globals :
  2. TYPES:
  3. str80 = string [80]
  4.  
  5. VARS:
  6. scrn_x (integer)
  7. scrn_y (integer)
  8. scrn_attr (byte)
  9. scrn_color (byte)
  10. use_pcg (boolean)
  11. colour (boolean)
  12. premium (boolean)
  13.  
  14. In this module there are the following procedures:
  15.  
  16. Determine                Interrogates hardware to see if the program is running
  17.                          on a colour/premium or not!
  18. SetPcg(x)                selects pcg bank x and sets print routines to
  19.                          subsequently use that bank.
  20. SetColor(x)              sets the text colour to x.
  21. PutCurs(x,y)             puts the cursor at row y column x with the origin
  22.                          being 1,1.
  23. PutCursor                puts the cursor at the current print location.
  24. PutAt(x,y)               sets the current print location to x,y (origin 1,1)
  25.                          and places the cursor there.
  26. SetCursor(x)             sets the cursor to be (11-x) scan lines high.
  27.                          adding 64 sets the flash rate to speed 1, 64+32 uses
  28.                          speed 2. Illegal values (i.e. not in the range 0..10
  29.                          with(out) attribute bytes) switch the cursor off.
  30. ZapCursor                trashes the cursor. Same effect as SetCursor with an
  31.                          illegal value.
  32. Use(str)                 Sets text attributes. uppercase sets, lower case
  33.                          resets. 'F'- flashing. 'P'- use PCG.
  34. PutChar(x,y)             Puts character y at address x. Also sets attributes
  35.                          and colour. Address X should be a proper screen
  36.                          address (i.e. in[$F000..$F7FF]) if you want the
  37.                          character to display.
  38. Cls                      Clears screen in current colour and attribute type.
  39. Print(str)               Prints string in current colour and attribute type at
  40.                          current cursor position. Updates cursor position.
  41. PrintLn(str)             Same as print except relocates cursor to the start of
  42.                          the next line.
  43. Edit(var:str,x)          Edits the passed string at the current cursor
  44.                          position. Has nasty effects on the current cursor
  45.                          location, but can be fixed with a simple PutCursor.
  46.                          As a var parameter is used, then string constants
  47.                          can't be passed as arguments. x is a boolean. If x is
  48.                          true, then the editing cursor is placed at the end of
  49.                          the passed string, else at the beginning.
  50. }
  51.  
  52. procedure determine;
  53. var
  54.   old:byte;
  55. begin
  56.   colour:=false; premium:=false;
  57.   old:=mem[$ffff];
  58.   port[8]:=$40;
  59.   mem[$ffff]:=0;
  60.   port[8]:=0;
  61.   if mem[$ffff]<>0 then colour:=true;
  62.   mem[$ffff]:=old;
  63.   old:=mem[$f000];
  64.   mem[$f000]:=$20;
  65.   port[$1c]:=$90; {bank in attribute ram}
  66.   mem[$f000]:=$0;
  67.   port[$1c]:=$80;
  68.   if mem[$f000]<>0 then premium:=true;
  69.   mem[$f000]:=old;
  70. end;
  71.  
  72. procedure setpcg (set_p: byte);
  73. {banks in pcg and makes print routines use it}
  74. begin
  75.   scrn_attr := (scrn_attr and $0f0) or (set_p and $0f);
  76.   port [$1c] := $80 or (set_p and $0f);
  77. end;
  78.  
  79. procedure setcolor (i:byte);
  80. begin
  81.   scrn_color := i;
  82. end;
  83.  
  84. procedure putcurs (x,y:integer);
  85. var
  86.   temp: integer;
  87. begin
  88.   temp := $2000+ (y-1)*80 + x -1;
  89.   port [$0c] := 14; port [$0d] := (temp div 256);
  90.   port [$0c] := 15; port [$0d] := (temp mod 256);
  91. end;
  92.  
  93. procedure putcursor;
  94. begin
  95.   putcurs (scrn_x+1,scrn_y+1);
  96. end;
  97.  
  98. procedure putat(x,y:integer);
  99. begin
  100.   scrn_x:=x-1; scrn_y:=y-1; putcursor;
  101. end;
  102.  
  103. procedure setcursor (i:byte);
  104. begin
  105.   port [$0c] := 10; port [$0d] := i;
  106. end;
  107.  
  108. procedure zapcursor;
  109. begin
  110.   setcursor (18);
  111. end;
  112.  
  113. procedure use (txt: str80);
  114. var
  115.   i:integer;
  116. {send in 'P' to use pcgs, 'F' for flash on, 'p' for normal, 'f' for normal}
  117. begin
  118.   for i:=1 to length (txt) do
  119.   begin
  120.     case txt[i] of
  121.     'P': use_pcg := TRUE;
  122.     'p': use_pcg := FALSE;
  123.     'F': scrn_attr := scrn_attr or $80;
  124.     'f': scrn_attr := scrn_attr and $7f;
  125.     end; {case}
  126.   end; {for}
  127. end;
  128.  
  129. procedure putchar (i:integer;b:byte);
  130. begin
  131.     mem[i] := b; {space}
  132.     port [$1c] := port[$1c] or $10; {bank in attribute}
  133.     if premium then mem[i] := scrn_attr;
  134.     port [$1c] := port[$1c] and $0ef;
  135.     port [8] := $40; {colour}
  136.     if colour then mem[i+2048] := scrn_color;
  137.     port [8] := $0bf;
  138. end;
  139.  
  140. procedure cls;
  141. var
  142.   i: integer;
  143. begin
  144.   for i:=$f000 to $f000+80*24-1 do putchar(i,$20);
  145.   scrn_x := 0; scrn_y := 0; putcursor;
  146. end;
  147.  
  148. procedure print (txt:str80);
  149. var
  150.   i,j:integer;
  151.   b:byte;
  152. begin
  153.   j:=$f000+scrn_y*80+scrn_x;
  154.   for i:=1 to length(txt) do
  155.   begin
  156.     b:=ord(txt[i]);
  157.     if use_pcg then b:=b xor $80;
  158.     putchar(i+j-1,b);
  159.   end;
  160.   scrn_x:=scrn_x+i;
  161.   if scrn_x>80 then
  162.   begin
  163.     scrn_x:=scrn_x-80; scrn_y:=scrn_y+1;
  164.   end;
  165.   putcursor;
  166. end;
  167.  
  168. procedure println (txt:str80);
  169. begin
  170.   print (txt);
  171.   scrn_y :=scrn_y+1; scrn_x:=0; putcursor;
  172. end;
  173.  
  174. {this routine assumes that the cursor has already been placed where it
  175. should be}
  176. procedure edit(var text:str80;cursloc:boolean);
  177. var
  178.   z: integer;
  179.   cursor,i: integer;
  180.   ch:char;
  181.   alpha: boolean;
  182.  
  183. begin
  184.   z:=$f000+(scrn_y)*80+scrn_x; {starting address}
  185.   if cursloc then cursor := length(text)+1 else cursor := 1;
  186.   alpha:=true;
  187.   setcursor(96);
  188.   repeat
  189.   begin
  190.     if alpha then
  191.     begin
  192.       if length(text)>0 then
  193.         for i:=1 to length(text) do putchar(z+i-1,ord(text[i]));
  194.       putchar (z+length(text),32); {blank the last character on the line}
  195.       alpha:=FALSE;
  196.     end;
  197.     putcurs (scrn_x+cursor,scrn_y+1); {put the cursor where it should be}
  198.     read (kbd,ch); {now what?}
  199.     case ch of
  200.       ^S,#8   : if cursor>1 then cursor:=cursor-1;
  201.       ^D      : if cursor<length(text)+1 then cursor:=cursor+1;
  202.       ^G      : begin
  203.                   if cursor<length (text)+1 then
  204.                   begin
  205.                     delete (text,cursor,1);
  206.                     alpha:=true;
  207.                   end;
  208.                 end;
  209.       #127    : begin
  210.                   if cursor>1 then
  211.                   begin
  212.                     delete (text,cursor-1,1);
  213.                     cursor:=cursor-1; alpha:=true;
  214.                   end;
  215.                 end;
  216.       ^Y      : begin
  217.                   for i:=1 to length (text) do putchar (z+i-1,32);
  218.                   cursor :=1;
  219.                   text:='';
  220.                 end;
  221.     end; {case}
  222.     if ch in[' '..#126] then
  223.     begin
  224.       insert(ch,text,cursor);
  225.       alpha:=true; cursor:=cursor+1;
  226.     end;
  227.   end {repeat}
  228.   until ch=^M;
  229.   setcursor (11);
  230. end; {procedure}