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 / TURBOPAS / TURBWIN3.LBR / OSBTWIND.IZC / OSBTWIND.INC
Text File  |  2000-06-30  |  18KB  |  509 lines
  1. (****************************************************************
  2.  file OSBTWIND.INC  -  Video and window primitives
  3.  (c) Copyright 1986 Claude Ostyn
  4.  Osborne 1 memory-mapped version 3/21/86
  5.  See file TURBWIN2.DOC for important information.
  6.  
  7.  ****************************************************************)
  8. const
  9.  
  10.     (*======= Terminal-dependent strings  =======*)
  11.     (* as shown, good for ADM3A, Osborne 1, etc. *)
  12.     ClrScrString  = #26;      (* string to clear screen          *)
  13.     ClrEolString  = #27'T';   (* string to clear to end of line  *)
  14.     DimVidString  = #27')';   (* string to start dim video       *)
  15.     BrightString  = #27'(';   (* string to end dim video         *)
  16.     InverseString = #27'l';   (* string to start inverse video   *)
  17.     NormalString  = #27'm';   (* string to end inverse video     *)
  18.       (* note:  since inverse video is not available on the      *)
  19.       (*        Osborne 1, underlining codes are used instead    *)
  20.     BlinkString   = #0;
  21.     NoBlinkString = #0;       (* blink not available on Osborne  *)
  22.  
  23.     (* Osborne only, replace with #0 for other terminals *)
  24.     GraphString   = #27'g';
  25.     NoGraphString = #27'G';
  26.  
  27.     (* graphic characters, if available (otherwise use ASCII)    *)
  28.  
  29.     (* these characters are special graphic characters for the   *)
  30.     (* Osborne 1.  They require that graphic mode be turned on.  *)
  31.     BoxTLCh   = #17; (* char used for top left corner of box     *)
  32.     BoxTRCh   = #05; (* char used for top right corner of box    *)
  33.     BoxBRCh   = #03; (* char used for bottom right corner of box *)
  34.     BoxBLCh   = #26; (* char used for bottom left corner of box  *)
  35.     BoxTHorCh = #23; (* char used for top of box                 *)
  36.     BoxBHorCh = #24; (* char used for bottom of box              *)
  37.     BoxLVerCh = #01; (* char used for left side of box           *)
  38.     BoxRVerCh = #04; (* char used for right side of box          *)
  39.     (*===========================================================*)
  40.  
  41.     (* You may also have to alter the procedure GotoXY below     *)
  42.  
  43.     (*=== Control constants ===*)
  44.  
  45.     ScreenMemSize = 3072;   (* size of video memory map (either  *)
  46.                             (* "ghost" video screen in RAM if not*)
  47.                             (* memory-mapped video, or video RAM *)
  48.                             (* area if memory-mapped video)      *)
  49.                             (* 3072 for Osborne 1 memory-mapped, *)
  50.                             (* usually 2000 otherwise            *)
  51.     ScrMemWidth   = 128;    (* line width in video memory        *)
  52.                             (* 128 if using Osborne video memory *)
  53.                             (* usually 80 otherwise              *)
  54.     MemMapVideo   = true ;  (* true if var ScreenMem is set to   *)
  55.                             (* same address as video screen map  *)
  56.                             (* (if using memory-mapped video)    *)
  57.     ScreenWidth   = 80;     (* actual screen width               *)
  58.  
  59.     (*=== initialized variables ===*)
  60.     CustomConout : boolean = false;
  61.                                 (* true if using special Conout *)
  62.     XTopLWindow : byte = 1;     (* 1..80 *)
  63.     YTopLWindow : byte = 1;     (* 1..25 *)
  64.     XBotRWindow : byte = 80;
  65.     YBotRWindow : byte = 24;    (* 25 on some terminals      *)
  66.     WindowWidth : byte = 80;
  67.     XNext       : byte = 1;     (* default position to write *)
  68.     YNext       : byte = 1;     (* next character (relative  *)
  69.                                 (* to current window         *)
  70.  
  71. type
  72.     String1 = string[1];
  73.  
  74.     VideoEffect = (NormalV,
  75.                    InverseV,
  76.                    BrightV, DimV,
  77.                    GraphV, NoGraphV,
  78.                    BlinkV, NoBlinkV);
  79.  
  80.     VidFXSet = set of VideoEffect;
  81.  
  82. const
  83.     VideoAttributes : VidFXSet
  84.                       = [NormalV, BrightV, NoGraphV, NoBlinkV];
  85.                          (* default video attributes *)
  86.  
  87. var
  88.     StdConOut   : integer; (* used to save address of standard  *)
  89.                            (* Turbo Pascal ConOut procedure     *)
  90.  
  91.     ScreenMem   : array[1..ScreenMemSize] of byte absolute $F000;
  92.                            (* This is a ghost screen in RAM,    *)
  93.                            (* necessary to implement scrolling  *)
  94.                            (* within window                     *)
  95.  
  96.  
  97. procedure GotoXY( X, Y: byte);
  98. (****************************************************************
  99.  Direct cursor addressing
  100.   Sets global vars YNext, XNext for next print position and
  101.   places cursor.  Erase old cursor if memory-mapped video.
  102.   Performs NO range checking on parameters.  If X or Y are outside
  103.   current window, the cursor position is unpredictable!
  104.   This procedure uses the cursor addressing sequence for Osborne,
  105.   ADM3A, Televideo, Epson, Kaypro, etc.  Change for others.
  106.   Note that char is output by direct call to BIOS.
  107.   Do NOT use Write since Conout is taken over by windows module!
  108.  ****************************************************************)
  109.     var OldX, OldY : byte;
  110.         Offset     : integer;
  111.  
  112. begin
  113.  
  114.   OldX  := XNext;
  115.   OldY  := YNext;
  116.   YNext := Y;
  117.   XNext := X;
  118.   Bios(3,27);                           (* ESC             *)
  119.   Bios(3,61);                           (* '='             *)
  120.   Bios(3,YNext + YTopLWindow + 30);     (* Row + offset    *)
  121.   Bios(3,XNext + XTopLWindow + 30);     (* Column + offset *)
  122.   if MemMapVideo and (not (InverseV in VideoAttributes)) then begin
  123.     Offset := (YTopLWindow + OldY - 2) * ScrMemWidth +
  124.                XTopLWindow + OldX - 1;
  125.     ScreenMem[Offset] := ScreenMem[Offset] and $7F;
  126.   end;
  127. end;
  128.  
  129.  
  130. function WhereX: byte;
  131. (****************************************************************
  132.  Returns current cursor X location.  If not available, return 255
  133.  ****************************************************************)
  134. begin
  135.   WhereX := XNext
  136. end;
  137.  
  138.  
  139. function WhereY: byte;
  140. (****************************************************************
  141.  Returns current cursor Y location.  If not available, return 255
  142.  ****************************************************************)
  143. begin
  144.   WhereY := YNext
  145. end;
  146.  
  147.  
  148. procedure PutVidChar(C : byte;  AdjustCursor : boolean);
  149. (****************************************************************
  150.  Output character value through operating system, so screen cursor
  151.  position is adjusted automatically and video attributes are
  152.  implemented.
  153.  Also write into the ghost video array if adjusting cursor
  154.  (i.e. if not part of a control sequence) and not memory-mapped.
  155.  ****************************************************************)
  156.  
  157. begin
  158.   Bios(3,C);
  159.   if AdjustCursor then begin
  160.     if not MemMapVideo then
  161.        ScreenMem[(YNext-1) * ScrMemWidth
  162.                   + (YTopLWindow -1) * ScrMemWidth
  163.                   + XTopLWindow - 1 + XNext] := C;
  164.     XNext := succ(XNext);
  165.   end;
  166. end;
  167.  
  168.  
  169. procedure ScrHome;
  170. (****************************************************************
  171.  Erase window and put cursor at top left of window
  172.  ****************************************************************)
  173.     var Height, Offset, R,C : integer;
  174.  
  175. begin
  176.   Height := YBotRWindow - YTopLWindow + 1;
  177.   Offset := (YTopLWindow -1) * ScrMemWidth + XTopLWindow;
  178.   if MemMapVideo then begin
  179.     GotoXY(1,1);
  180.     for R := 1 to Height do
  181.       FillChar(ScreenMem[Offset + (R-1) * ScrMemWidth],
  182.                WindowWidth,32);
  183.   end else begin
  184.     for R := 1 to Height do begin
  185.       GotoXY(1,R);
  186.       for C := 1 to WindowWidth do PutVidChar(32,true);
  187.     end;
  188.   end;
  189.   GotoXY(1,1);
  190. end;
  191.  
  192.  
  193. procedure ScrBackX;
  194. (****************************************************************
  195.  Move cursor position left (backspace)
  196.  ****************************************************************)
  197.  
  198. begin
  199.     if XNext > 1 then XNext := pred(XNext)
  200.     else
  201.       if YNext > 1 then begin
  202.         XNext := WindowWidth;
  203.         YNext := pred(YNext);
  204.       end;
  205.     GotoXY(XNext,YNext);
  206. end;
  207.  
  208.  
  209. procedure ScrNextLine;
  210. (****************************************************************
  211.  Move down one line if still within window else scroll
  212.  ****************************************************************)
  213.     var   Row, Col,
  214.           Height,
  215.           FirstCh   : byte;
  216.           Offset    : integer;
  217.  
  218. begin
  219.     Height := YBotRWindow - YTopLWindow ;
  220.     if YNext < Height + 1 then begin
  221.       GotoXY(XNext,YNext+1);
  222.     end else begin
  223.       (*  Scroll text within window.  Top line of text is lost.
  224.           Leaves cursor at end of bottom line of window.        *)
  225.       Offset := (YTopLWindow -1) * ScrMemWidth + XTopLWindow;
  226.       FirstCh := ScreenMem[Offset + ScrMemWidth];
  227.       if MemMapVideo then begin
  228.         GotoXY(1,1);  (* put cursor where it will be erased *)
  229.         for Row := 1 to Height do
  230.           Move(ScreenMem[Offset + Row * ScrMemWidth],
  231.                ScreenMem[Offset + (Row-1) * ScrMemWidth],
  232.                WindowWidth);
  233.         FillChar(ScreenMem[Offset + Height * ScrMemWidth],
  234.                WindowWidth,32);
  235.       end else begin
  236.         for Row := 1 to Height do begin
  237.           GotoXY(1,Row);
  238.           for Col := 0 to WindowWidth - 1 do begin
  239.             PutVidChar(ScreenMem[Offset + Row * ScrMemWidth + Col],
  240.                        true);
  241.           end;
  242.         end;
  243.         GotoXY(1,Height+1);
  244.         for Col := 1 to WindowWidth do
  245.           PutVidChar(32,true);
  246.       end;
  247.       GotoXY(1,Height+1);
  248.       ScreenMem[Offset] := FirstCh; (* erase ghost of cursor *)
  249.     end;
  250. end;
  251.  
  252.  
  253. procedure ScrWrite(C : integer);
  254. (****************************************************************
  255.  Replaces the Turbo ConOut driver for character output to the
  256.  screen within current window.
  257.  Assumes only a limited set of characters, filters out most
  258.  control characters and allows limited cursor movement.
  259.  If GraphV attribute is set, accepts any character w/out filtering.
  260.  The integer parameter C is required rather than a char parameter.
  261.  I could explain why, but it would be boring.  Just believe me.
  262.  ****************************************************************)
  263.  var Ch : char;
  264.  
  265. begin (* ScrWrite *)
  266.  
  267.     Ch := chr(Lo(C));
  268.     if (not (GraphV in VideoAttributes)) and
  269.        (Ch < ' ') then begin
  270.  
  271.       case Ch of
  272.         ^G       : PutVidChar(7,false);
  273.         ^H       : ScrBackX;
  274.         ^J       : ScrNextLine;          (* line feed *)
  275.         ^K       : if YNext > 1 then
  276.                      GotoXY(XNext,pred(YNext));
  277.         ^L       : if (XNext < WindowWidth) then
  278.                      GotoXY(succ(XNext),YNext);
  279.         ^M       : GotoXY(1,YNext);      (* CR        *)
  280.       end;
  281.  
  282.     end else begin
  283.  
  284.       if XNext > WindowWidth then begin
  285.         XNext := 1;
  286.         ScrNextLine;
  287.       end;
  288.  
  289.       PutVidChar(ord(Ch),true);
  290.  
  291.     end;
  292.  
  293. end; (* ScrWrite *)
  294.  
  295.  
  296. procedure SetVideo(Effect : VideoEffect);
  297. (****************************************************************
  298.  Turn video attributes on and off
  299.  (uses standard Turbo ConOut instead of ScrWrite)
  300.  Attributes affect whole window if scrolled
  301.  ****************************************************************)
  302.     var FX:  VidFXSet;
  303.  
  304. begin
  305.     if CustomConout then
  306.       ConOutPtr := StdConOut;
  307.  
  308.     case Effect of
  309.        NormalV  : begin
  310.                     write(Con,BrightString,
  311.                               NormalString,
  312.                               NoGraphString);
  313.                     FX := [NormalV, BrightV, NoGraphV,NoBlinkV];
  314.                   end;
  315.        InverseV : begin
  316.                     write(Con,#27,'l');  (* underline instead *)
  317.                     FX := FX - [NormalV] + [InverseV];
  318.                   end;
  319.        BrightV  : begin
  320.                     write(Con,BrightString);
  321.                     FX := FX - [DimV] + [BrightV];
  322.                   end;
  323.        DimV     : begin
  324.                     write(Con,DimVidString);
  325.                     FX := FX - [BrightV] + [DimV];
  326.                   end;
  327.        GraphV   : begin
  328.                     write(Con,GraphString);
  329.                     FX := FX - [NoGraphV] + [GraphV];
  330.                   end;
  331.        NoGraphV : begin
  332.                     write(Con,NoGraphString);
  333.                     FX := FX - [GraphV] + [NoGraphV];
  334.                   end;
  335.        BlinkV   : begin
  336.                     write(Con,BlinkString);
  337.                     FX := FX - [NoBlinkV] + [BlinkV];
  338.                   end  ;
  339.        NoBlinkV : begin
  340.                     write(Con,NoBlinkString);
  341.                     FX := FX - [BlinkV] + [NoBlinkV];
  342.                   end  ;
  343.  
  344.     end;
  345.     VideoAttributes := FX;
  346.     if CustomConout then
  347.       ConOutPtr := Addr(ScrWrite);
  348. end;
  349.  
  350.  
  351. (*===  Replacements for standard screen procedures  ===*)
  352.  
  353. procedure NormVideo;
  354. (****************************************************************
  355.  Set screen to "Normal video"
  356.  ****************************************************************)
  357. begin
  358.    SetVideo(NormalV);
  359. end;
  360.  
  361. procedure LowVideo;
  362. (****************************************************************
  363.  set video attributes to dim
  364.  ****************************************************************)
  365. begin
  366.    SetVideo(DimV);
  367. end;
  368.  
  369. procedure ClrScr;
  370. (****************************************************************
  371.  Erase screen or current window
  372.  ****************************************************************)
  373. begin
  374.   if CustomConout then ScrHome
  375.   else write(con, ClrScrString);
  376. end;
  377.  
  378. procedure ClrEol;
  379. (****************************************************************
  380.  Erase to end of line (or right edge of window) without moving
  381.  cursor
  382.  ****************************************************************)
  383.     var X, I : byte;
  384. begin
  385.     if CustomConout or (Length(ClrEolString) = 0) then begin
  386.        X := XNext;
  387.        for I := 1 to WindowWidth - XNext + 1 do write(' ');
  388.        GotoXY(X,YNext);
  389.     end else begin
  390.       write(con, ClrEolString);
  391.     end;
  392. end;
  393.  
  394.  
  395. procedure Window(XTopL,YTopL,XBotR,YBotR : integer);
  396. (****************************************************************
  397.  Set global variables for window parameters and places cursor
  398.  within window.
  399.  ****************************************************************)
  400.  
  401. begin
  402.   (* Reset screen position - Delete this *)
  403.   (* part if not using an Osborne 1      *)
  404.   Bios(3,27); Bios(3,83); Bios(3,32); Bios(3,32);
  405.  
  406.     XTopLWindow := XTopL;
  407.     YTopLWindow := YTopL;
  408.     XBotRWindow := XBotR;
  409.     YBotRWindow := YBotR;
  410.     WindowWidth := XBotR - XTopL + 1;
  411.     GotoXY(1,1);
  412. end;
  413.  
  414.  
  415. procedure FullScreen;
  416. (****************************************************************
  417.  Set active window screen to full screen
  418.  ****************************************************************)
  419. begin
  420.     Window(1,1,80,24);
  421.     WindowWidth := 80;
  422. end;
  423.  
  424.  
  425. procedure InitVideo;
  426. (****************************************************************
  427.  Initialize video writing routines
  428.  Must be called at least once to initialize window emulation
  429.  Does NOT clear the screen automatically.
  430.  ****************************************************************)
  431. begin
  432.     FullScreen;
  433.     SetVideo(NormalV);
  434.     if ConOutPtr <> Addr(ScrWrite) then
  435.       StdConOut := ConOutPtr;
  436.     ConOutPtr := Addr(ScrWrite);
  437.     CustomConout := true;
  438. end;
  439.  
  440.  
  441. procedure DeInitVideo;
  442. (****************************************************************
  443.  Return control to Turbo standard Conout driver
  444.  Must be called at end of program if you want to run it again
  445.  in memory (otherwise Turbo detects anomaly and quits)
  446.  ****************************************************************)
  447. begin
  448.     ConOutPtr    := StdConOut;
  449.     CustomConout := false;
  450. end;
  451.  
  452.  
  453. (*========  Additional goodies to make pretty windows  ========*)
  454.  
  455. procedure DrawBox (TLX,TLY,BRX,BRY: integer);
  456. (****************************************************************
  457.  Draw a box with TLX,TLY as top left corner and BRX,BRY as
  458.  bottom left corner.
  459.  Uses graphic characters defined above
  460.  BoxTLCh   = top left corner of box
  461.  BoxTRCh   = top right corner of box
  462.  BoxBRCh   = bottom right corner of box
  463.  BoxBLCh   = bottom left corner of box
  464.  BoxTHorCh = top of box
  465.  BoxBHorCh = bottom of box
  466.  BoxLVerCh = left side of box
  467.  BoxRVerCh = right side of box
  468.  ****************************************************************)
  469.     var Y,X : integer;
  470.  
  471. begin (* DrawBox *)
  472.     GotoXY(TLX,TLY);
  473.     SetVideo(GraphV);
  474.     Write(BoxTLCh);
  475.     for X := 1 to BRX-TLX-1 do Write(BoxTHorCh);
  476.     Write(BoxTRCh);
  477.     SetVideo(NoGraphV);
  478.     for Y := TLY+1 to BRY-1 do begin
  479.       GotoXY(TLX,Y); SetVideo(GraphV);
  480.       Write(BoxLVerCh); SetVideo(NoGraphV);
  481.       GotoXY(BRX,Y); SetVideo(GraphV);
  482.       Write(BoxRVerCh); SetVideo(NoGraphV);
  483.     end;
  484.     GotoXY(TLX,BRY);
  485.     SetVideo(GraphV);
  486.     Write(BoxBLCh);
  487.     for X := 1 to BRX-TLX-1 do Write(BoxBHorCh);
  488.     Write(BoxBRCh);
  489.     SetVideo(NoGraphV);
  490. end; (* DrawBox *)
  491.  
  492.  
  493. procedure MakeWindow (TLX,TLY,BRX,BRY: integer);
  494. (****************************************************************
  495.  Draw a window on screen at coordinates, and set a text window
  496.  that fits within the coordinates (i.e. window dimensions -1).
  497.  Also set global var WindowWidth.
  498.  ****************************************************************)
  499.  
  500. begin
  501.     FullScreen;
  502.     DrawBox(TLX, TLY, BRX, BRY);
  503.     Window(TLX+1, TLY+1, BRX-1, BRY-1);
  504.     ClrScr;
  505. end;
  506.  
  507. (********************* end of WINDOWS.INC ********************)
  508.  
  509.