home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TOOLKIT.ZIP / FASTWRIT.TTT < prev    next >
Encoding:
Text File  |  1986-09-28  |  8.4 KB  |  291 lines
  1. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  2. {                                                                           }
  3. {           T E C H N O J O C K S     T U R B O    T O O L K I T            }
  4. {                                                                           }
  5. {                      Module   :   Fastwrit.TTT                            }
  6. {                                                                           }
  7. {                      Version  :   3.0 , October 1, 1986                   }
  8. {                                                                           }
  9. {                      Purpose  :   All these procedures rely upon          }
  10. {                                   Fastwrite which is an inline procedure  }
  11. {                                   that enables very rapid screen updates. }
  12. {                                   The procedures are highly machine       }
  13. {                                   dependent and will only work on IBM and }
  14. {                                   true compatibles.                       }
  15. {                 Requirements  :   Decl.TTT                                }
  16. {                                                                           }
  17. {                                                                           }
  18. {  Proc   FastWrite(X,Y,attrib:byte;str:string80);       used internally    }
  19. {         Box(X1,Y1,X2,Y2,F,B,boxtype:integer);                             }
  20. {         Horizline(X1,X2,Y,F,B,linetype:integer);                          }
  21. {         VertLine(X,Y1,Y2,F,B,linetype:integer);                           }
  22. {         ClearText(X1,Y1,X2,Y2,F,B:integer);                               }
  23. {         WriteAT(X,Y,F,B:integer;St:string80);                             }
  24. {         WriteCenter(LineNo,F,B:integer:St:string80);                      }
  25. {         WriteBetween(X1,X2,Y,F,B:integer;St:string80);                    }
  26. {         WriteVert(X,Y,F,B:integer;St:string80);                           }
  27. {         TempMessage(Y,F,B:integer;St:string80);                           }
  28. {         FindCursor(X,Y,ScanTop,ScanBot : integer);                        }
  29. {         PosCursor(X,Y:integer);                                           }
  30. {         SizeCursor(ScanTop,ScanBot:integer);                              }
  31. {         OnCursor;                                                         }
  32. {         OffCursor;                                                        }
  33. {         VideoOff;                                                         }
  34. {         VideoOn;                                                          }
  35. {                                                                           }
  36. {  Func   Attr(Fore,Back:integer):byte;                   used internally   }
  37. {                                                                           }
  38. {                                                Bob Ainsbury               }
  39. {                                                Technojock                 }
  40. {                                                Houston                    }
  41. {                                                (713) 293-2760             }
  42. {+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++}
  43. Function Attr(F,B:integer):byte;
  44. begin
  45. F := F mod 16;
  46. B := B mod 16;
  47. attr := (B shl 4) or F;
  48. end;
  49.  
  50. Procedure Fastwrite(col,row,attrib:byte;Str:string80);
  51. var Strptr : ^string80;
  52. begin
  53. Strptr := ptr(seg(str),ofs(str));
  54. inline
  55. ($1E/$1E/$8A/$86/ROW/$48/$B3/$50/$F6/$E3/$2B/$DB/$8A/$9E/col/$4B/
  56.  $03/$C3/$03/$C0/$8B/$F8/$8A/$BE/attrib/$C4/$B6/strptr/
  57.  $2B/$C9/$26/$8A/$0C/$2B/$C0/$8E/$D8/$A0/$49/$04/
  58.  $1F/$20/$C9/$74/$34/$2C/$07/$74/$21/$BA/$00/$B8/$8E/$DA/$BA/$DA/$03/
  59.  $46/$26/$8A/$1C/$EC/$A8/$01/$75/$FB/$FA/$EC/$A8/$01/$74/$FB/$89/$1D/
  60.  $47/$47/$E2/$EB/$2A/$C0/$74/$0F/$BA/$00/$B0/$8E/$DA/$46/$26/$8A/$1C/
  61.  $89/$1D/$47/$47/$E2/$F6/$1F);
  62. end;  {proc fastwrite}
  63.  
  64. Procedure Box(X1,Y1,X2,Y2,F,B,boxtype:integer);
  65. var
  66. I:integer;
  67. corner1,corner2,corner3,corner4,
  68. horizline,
  69. vertline : char;
  70. attrib : byte;
  71. begin
  72. case boxtype of
  73. 0:begin
  74.    corner1:=' ';
  75.    corner2:=' ';
  76.    corner3:=' ';
  77.    corner4:=' ';
  78.    horizline:=' ';
  79.    vertline:=' ';
  80.   end;
  81. 2:begin
  82.    corner1:='╔';
  83.    corner2:='╗';
  84.    corner3:='╚';
  85.    corner4:='╝';
  86.    horizline:='═';
  87.    vertline:='║';
  88.   end;
  89. 3:begin
  90.    corner1:='╓';
  91.    corner2:='╖';
  92.    corner3:='╙';
  93.    corner4:='╜';
  94.    horizline:='─';
  95.    vertline:='║';
  96.   end;
  97. 4:begin
  98.    corner1:='╒';
  99.    corner2:='╕';
  100.    corner3:='╘';
  101.    corner4:='╛';
  102.    horizline:='═';
  103.    vertline:='│';
  104.   end;
  105. else
  106.    corner1:='┌';
  107.    corner2:='┐';
  108.    corner3:='└';
  109.    corner4:='┘';
  110.    horizline:='─';
  111.    vertline:='│';
  112. end;{case}
  113. attrib := attr(F,B);
  114. FastWrite(X1,Y1,attrib,corner1);
  115. For I := X1+1 to X2-1 do
  116. FastWrite(I,Y1,attrib,horizline);
  117. FastWrite(X2,Y1,attrib,corner2);
  118. For I := Y1 + 1 to Y2 - 1 do
  119. begin
  120.  FastWrite(X1,I,attrib,vertline);
  121.  FastWrite(X2,I,attrib,vertline);
  122. end;
  123. FastWrite(X1,Y2,attrib,corner3);
  124. For I := X1+1 to X2-1 do
  125. FastWrite(I,Y2,attrib,horizline);
  126. FastWrite(X2,Y2,attrib,corner4);
  127. end;        {box}
  128.  
  129. procedure HorizLine(X1,X2,Y,F,B,lineType : byte);
  130. var
  131. I : integer;
  132. Horizline : char;
  133. attrib : byte;
  134. begin
  135. If (lineType in [2,4]) then
  136.  horizline := '═'
  137. else
  138.  horizline := '─';
  139. Attrib := attr(F,B);
  140. If X2 > X1 then
  141.  For I := X1 to X2 do FastWrite(I,Y,attrib,Horizline)
  142. else
  143.  For I := X2 to X1 do FastWrite(I,Y,attrib,Horizline);
  144. end;   {horizline}
  145.  
  146. Procedure VertLine(X,Y1,Y2,F,B,lineType : byte);
  147. var
  148. I : integer;
  149. vertline : char;
  150. attrib : byte;
  151. begin
  152. If (linetype in [2,4])then
  153.  vertline := '║'
  154. else
  155.  vertline := '│';
  156. Attrib := attr(F,B);
  157. If Y2 > Y1 then
  158.  For I := Y1 to Y2 do Fastwrite(X,I,Attrib,Vertline)
  159. else
  160.  For I := Y2 to Y1 do Fastwrite(X,I,Attrib,Vertline);
  161. end;   {vertline}
  162.  
  163. Procedure ClearText(x1,y1,x2,y2,F,B:integer);
  164. var X,Y : integer;
  165. attrib : byte;
  166. begin
  167. If x2 > 80 then x2 := 80;
  168. Attrib := attr(F,B);
  169. For Y := y1 to y2 do
  170.  For X := x1 to x2 do
  171.   Fastwrite(X,Y,attrib,' ');
  172. end;   {cleartext}
  173.  
  174. Procedure WriteAT(X,Y,F,B:integer;St:string80);
  175. begin
  176. Fastwrite(X,Y,attr(F,B),St);
  177. end;
  178.  
  179. Procedure WriteCenter(LineNO,F,B:integer;St:string80);
  180. begin
  181. Fastwrite(40 - length(St) div 2,Lineno,attr(F,B),St);
  182. end;
  183.  
  184. Procedure WriteBetween(X1,X2,Y,F,B:byte;St:string80);
  185. var X : integer;
  186. begin
  187. If length(St) >= X2 - X1 + 1 then
  188.  WriteAT(X1,Y,F,B,St)
  189. else
  190. begin
  191.  x := X1 + (X2 - X1 + 1 - length(St)) div 2 ;
  192.  WriteAT(X,Y,F,B,St);
  193. end;
  194. end;
  195.  
  196. Procedure WriteVert(X,Y,F,B:integer;ST : string80);
  197. var I : integer;Tempstr:string2;
  198. begin
  199. If length(St) > 26 - Y then delete(St,27 - Y,80);
  200. For I := 1 to length(St) do
  201. begin
  202.  Tempstr := st[I];
  203.  Fastwrite(X,Y-1+I,attr(F,B),St[I]);
  204. end;
  205. end;
  206.  
  207. Procedure FindCursor(var X,Y,ScanTop,ScanBot:integer);
  208. var recpac : regpack;
  209. begin
  210.   Recpack.Ax := $0F00;              {get page in Bx}
  211.   Intr($10,recpack);
  212.   Recpack.Ax := $0300;
  213.   Intr($10,recpack);
  214.   With Recpack do
  215.   begin
  216.     X := lo(Dx) + 1;
  217.     Y := hi(Dx) + 1;
  218.     ScanTop := Hi(Cx) and $0F;
  219.     ScanBot := Lo(Cx) and $0F;
  220.   end;
  221. end;
  222.  
  223. Procedure PosCursor(X,Y: integer);
  224. var recpac : regpack;
  225. begin
  226.   Recpack.Ax := $0F00;              {get page in Bx}
  227.   Intr($10,recpack);
  228.   with recpack do
  229.   begin
  230.     Ax := $0200;
  231.     Dx := ((Y-1) shl 8) or ((X-1) and $00FF);
  232.   end;
  233.   Intr($10,recpack);
  234. end;
  235.  
  236. Procedure SizeCursor(ScanTop,ScanBot:byte);
  237. var recpack : regpack;
  238. begin
  239.   with recpack do
  240.     begin
  241.       ax := 1 shl 8;
  242.       cx := Scantop shl 8 + Scanbot;
  243.       INTR($10,recpack);
  244.     end;
  245. end;
  246.  
  247. Procedure OnCursor;
  248. begin
  249. If CRTmode = 7 then
  250.  SizeCursor(13,14)
  251. else
  252.  SizeCursor(6,7);
  253. end;
  254.  
  255. Procedure OffCursor;
  256. begin
  257. Sizecursor(14,0);
  258. end;
  259.  
  260. procedure TempMessage(Y,F,B:integer;St:string80);
  261. var CX,CY,CT,CB,I,locC:integer;
  262. begin
  263. For I := 1 to 80 do
  264. begin
  265.  LocC := (I-1)*2 + (Y-1)*160;
  266.  Savedline[I].C := chr(mem[$b800:LocC]);
  267.  Savedline[I].A := mem[$b800:LocC+1];
  268. end;
  269. FindCursor(CX,CY,CT,CB);
  270. WriteAT(1,Y,F,B,St);
  271. Read(kbd,Ch);
  272. while keypressed do read(kbd,Ch);
  273. For I := 1 to 80 do
  274. begin
  275.  LocC := (I-1)*2 + (Y-1)*160;
  276.  Mem[$B800:LocC] := ord(SavedLine[I].C);
  277.  Mem[$B800:LocC+1] := SavedLine[I].A;
  278. end;
  279. SizeCursor(CT,CB);
  280. PosCursor(CX,CY);
  281. end;
  282.  
  283. Procedure VideoOn;
  284. begin
  285.   Port[CRTadapter+4] := (Videomode or $08)
  286. end;
  287.  
  288. Procedure VideoOff;
  289. begin
  290.  Port[CRTadapter+4] := (Videomode - $08);
  291. end;