home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / ddjmag / ddj8904.arc / VIRSCR.ASC < prev   
Text File  |  1989-03-27  |  18KB  |  529 lines
  1. _STRUCTURED PROGRAMMING COLUMN_
  2. by Jeff Duntemann
  3.  
  4.  
  5. [LISTING ONE]
  6.  
  7. Screen = RECORD
  8.            ShowPtrs       : ARRAY[1..HEIGHT] OF LinePtr;
  9.            StorePtrs      : ARRAY[1..HEIGHT] OF LinePtr;
  10.            X,Y            : Byte;
  11.            TopLine        : 1..HEIGHT;
  12.            FollowCursor   : Boolean
  13.       END;
  14.  
  15.  
  16. [LISTING TWO]
  17.  
  18. {--------------------------------------------------------------}
  19. {                          SCREENS                             }
  20. {               Virtual screen management unit                 }
  21. {                                                              }
  22. {                                    by Jeff Duntemann KI6RA   }
  23. {                                    Turbo Pascal 5.0          }
  24. {                                    Last modified 12/24/88    }
  25. {--------------------------------------------------------------}
  26.  
  27. UNIT Screens;
  28.  
  29. INTERFACE
  30.  
  31. USES DOS,        { Standard Borland unit }
  32.      TextInfo;   { Given last issue; DDJ 3/89 }
  33.  
  34. CONST
  35.   WIDTH  = 80;   { These are the character sizes of the virtual screens }
  36.   HEIGHT = 66;   { KEEP IN MIND THAT THIS IS A 1-ORIGIN SYSTEM!!!!!!!!! }
  37.                  { I.e., we count rows and columns from *1*, not 0.     }
  38.   UP     = True; { Constants for glitching and panning }
  39.   DOWN   = False;
  40.  
  41.  
  42. TYPE
  43.   String5    = STRING[5];
  44.   String10   = STRING[10];
  45.   String80   = STRING[80];
  46.  
  47.   { Lines are made of these; helps us mix characters and attributes: }
  48.   ScreenAtom = RECORD
  49.                  CASE Boolean OF
  50.                    True  : (Ch   : Char;
  51.                             Attr : Byte);
  52.                    False : (Atom : Word);
  53.                END;
  54.  
  55.   LinePtr    = ^Line;
  56.   Line       = ARRAY[1..WIDTH] OF ScreenAtom;
  57.  
  58.   ScreenPtr  = ^Screen;
  59.   Screen     = RECORD
  60.                  ShowPtrs     : ARRAY[1..HEIGHT] OF LinePtr;
  61.                  StorePtrs  : ARRAY[1..HEIGHT] OF LinePtr;
  62.                  X,Y          : Byte;
  63.                  TopLine      : 1..HEIGHT;
  64.                  FollowCursor : Boolean
  65.                END;
  66.  
  67. CONST
  68.   ClearAtom : ScreenAtom = (Ch   : ' ';   { ASCII space char }
  69.                             Attr : $07);  { "Normal" screen attribute }
  70.  
  71. VAR
  72.   CurrentAttr : Byte;  { Exported global, *not* a function! }
  73.  
  74.  
  75. PROCEDURE ClearLine(LineTarget : LinePtr;
  76.                     VisibleX   : Byte;
  77.                     ClearAtom  : ScreenAtom);
  78.  
  79. INLINE
  80. ($58/         { POP AX }      { Pop filler char/attribute into AX }
  81.  $59/         { POP CX }      { Pop line length (repeat count) into CX }
  82.  $5F/         { POP ES }      { Pop line address segment into ES }
  83.  $07/         { POP DI }      { Pop line address offset into DI }
  84.  $8C/$C2/     { MOV DX,ES   } { Move ES into DX for test against 0 }
  85.  $81/$FA/0/0/ { CMP DX,0000 } { Compare ES value (in DX) against 0 }
  86.  $74/$02/     { JE  2       } { If Equal, jump ahead 2 bytes }
  87.  $F3/$AB);    { REP STOSW   } { Otherwise,  blast that line to atoms! }
  88.  
  89.  
  90. FUNCTION  BooStr(BooleanValue : Boolean) : String5;
  91. PROCEDURE ClrScreen(Target : ScreenPtr; ClearAtom : ScreenAtom);
  92. PROCEDURE DisposeOfScreen(VAR Target : ScreenPtr);
  93. PROCEDURE GotoXY(Target : ScreenPtr; NewX,NewY : Byte);
  94. PROCEDURE InitScreen(Target : ScreenPtr; Visible : Boolean);
  95. FUNCTION  IntStr(IntegerValue,FieldWidth : Integer) : String10;
  96. PROCEDURE Pan(Target : ScreenPtr; PanUp : Boolean; ByLines : Integer);
  97. FUNCTION  RealStr(RealValue : Real; Exponential : Boolean;
  98.                   FieldWidth,DecimalWidth : Integer) : String80;
  99. PROCEDURE WriteTo(Target : ScreenPtr; S : String);
  100. PROCEDURE WritelnTo(Target : ScreenPtr; S : String);
  101.  
  102.  
  103. IMPLEMENTATION
  104.  
  105. { Private to SCREENS--make it public if you need it. }
  106.  
  107. PROCEDURE GlitchDisplay(Up : Boolean; ByLines : Integer);
  108.  
  109. VAR
  110.   Service : Byte;
  111.   Regs    : Registers;
  112.  
  113. BEGIN
  114.   IF Up THEN Service := $06 ELSE Service := $07;
  115.   WITH Regs DO
  116.     BEGIN
  117.       AH := Service;
  118.       AL := ByLines;
  119.       BH := CurrentAttr;  { Attribute for blanked line(s)    }
  120.       CH := 0;            { CX & DX: Glitch the full display }
  121.       CL := 0;
  122.       DH := VisibleY-1;
  123.       DL := VisibleX-1;
  124.     END;
  125.   Intr($10,Regs);
  126. END;
  127.  
  128.  
  129. { Returns string equivalent of RealValue: }
  130.  
  131. FUNCTION RealStr(RealValue : Real; Exponential : Boolean;
  132.                  FieldWidth,DecimalWidth : Integer) : String80;
  133.  
  134. VAR
  135.   Dummy : String80;
  136.  
  137. BEGIN
  138.   IF Exponential THEN
  139.     Str(RealValue : FieldWidth,Dummy)
  140.   ELSE
  141.     Str(RealValue : FieldWidth : DecimalWidth,Dummy);
  142.   RealStr := Dummy
  143. END;
  144.  
  145.  
  146. { Returns string equivalent of BooleanValue: }
  147.  
  148. FUNCTION BooStr(BooleanValue : Boolean) : String5;
  149.  
  150. BEGIN
  151.   IF BooleanValue THEN BooStr := 'TRUE'
  152.     ELSE BooStr := 'FALSE'
  153. END;
  154.  
  155.  
  156. { Returns string equivalent of IntegerValue: }
  157.  
  158. FUNCTION IntStr(IntegerValue,FieldWidth : Integer) : String10;
  159.  
  160. VAR
  161.   Dummy : String10;
  162.  
  163. BEGIN
  164.   Str(IntegerValue : FieldWidth,Dummy);
  165.   IntStr := Dummy
  166. END;
  167.  
  168.  
  169. { Clears Target to the atom passed in ClearAtom: }
  170.  
  171. PROCEDURE ClrScreen(Target : ScreenPtr; ClearAtom : ScreenAtom);
  172.  
  173. VAR
  174.   I : Integer;
  175.  
  176. BEGIN
  177.   WITH Target^ DO
  178.     BEGIN          
  179.       { Brute force: Clear all lines at the ends of pointer        }
  180.       { referents, even though non-visible lines are cleared twice }
  181.       FOR I := 1 TO HEIGHT DO
  182.         ClearLine(ShowPtrs[I],VisibleX,ClearAtom);
  183.       FOR I := 1 TO HEIGHT DO
  184.         ClearLine(StorePtrs[I],VisibleX,ClearAtom);
  185.       X := 1; Y := 1;
  186.     END
  187. END;
  188.  
  189.  
  190. { Moves logical (*not* hardware!) cursor to NewX,NewY: }
  191.  
  192. PROCEDURE GotoXY(Target : ScreenPtr; NewX,NewY : Byte);
  193.  
  194. { Simply places new values in descriptor record's X & Y fields }
  195. BEGIN
  196.   WITH Target^ DO
  197.     BEGIN
  198.       X := NewX;
  199.       Y := NewY
  200.     END
  201. END;
  202.  
  203.  
  204. { V-Screen equivalent of Write: }
  205.  
  206. PROCEDURE WriteTo(Target : ScreenPtr; S : String);
  207.  
  208. VAR
  209.   I,K         : Integer;
  210.   TX          : Byte;
  211.   ShiftedAttr : Word;
  212.  
  213. BEGIN
  214.   { Put attribute in the high byte of a word: }
  215.   ShiftedAttr := CurrentAttr SHL 8;
  216.   WITH Target^ DO
  217.     BEGIN
  218.       TX := X;
  219.       K := 0;
  220.       FOR I := 0 TO Length(S)-1 DO
  221.         BEGIN
  222.           IF X+I > VisibleX THEN  { If string goes past end of line: }
  223.             BEGIN
  224.               Inc(Y);           { Increment Y value  }
  225.               X := 1; TX := 1;  { Reset X and temp X value to 1 }
  226.               K := 0;           { K is the line-offset counter  }
  227.             END;
  228.           { Here we combine the character from the string and the   }
  229.           { current attribute via OR, and assign it to its location }
  230.           { on the screen: }
  231.           Word(ShowPtrs[Y]^[X+K]) := Word(S[I+1]) OR ShiftedAttr;
  232.           Inc(TX); Inc(K);
  233.         END;
  234.       X := TX;   { Update X value in descriptor record }
  235.     END
  236. END;
  237.  
  238.  
  239. { V-Screen equivalent of Writeln: }
  240.  
  241. PROCEDURE WritelnTo(Target : ScreenPtr; S : String);
  242.  
  243. BEGIN
  244.   WriteTo(Target,S);
  245.   Inc(Target^.Y);    { These 2 lines are the equivalent of CR/LF }
  246.   Target^.X := 1
  247. END;
  248.  
  249.  
  250. { Moves the visible display as a window onto a full-page virtual screen: }
  251.  
  252. PROCEDURE Pan(Target : ScreenPtr; PanUp : Boolean; ByLines : Integer);
  253.  
  254. VAR
  255.   I : Integer;
  256.   YOffset : byte;
  257.  
  258. BEGIN
  259.   YOffset := VisibleY-1;  { Compensates for 1-based line numbering }
  260.   WITH Target^ DO
  261.     IF PanUp THEN    { If we want to pan the display up the screen }
  262.       BEGIN
  263.         { Don't do anything if we're at the top of the V-screen: }
  264.         IF TopLine > 1 THEN
  265.           BEGIN
  266.             { If we're not at the top but ByLines would take us out of }
  267.             { legal range, adjust ByLines to scroll the rest of the way: }
  268.             IF TopLine - ByLines < 1 THEN ByLines := TopLine - 1;
  269.             { Move newly-hidden lines into virtual screen buffer: }
  270.             FOR I := TopLine + YOffset DOWNTO
  271.                      TopLine + YOffset - (ByLines-1) DO
  272.               Move(ShowPtrs[I]^,StorePtrs[I]^,VisibleX * 2);
  273.             { Glitch the display pointer array up: }
  274.             Move(ShowPtrs[TopLine],ShowPtrs[TopLine-ByLines],VisibleY * 4);
  275.             { Repoint affected line pointers into virtual screen: }
  276.             FOR I := TopLine + YOffset DOWNTO
  277.                      TopLine + YOffset - (ByLines-1) DO
  278.               ShowPtrs[I] := StorePtrs[I];
  279.             { Glitch the display buffer down: }
  280.             GlitchDisplay(False,ByLines);
  281.             { Update virtual screen's TopLine counter: }
  282.             TopLine := TopLine - ByLines;
  283.             { Move newly-visible lines to display from virtual screen: }
  284.             FOR I := TopLine TO TopLine + (ByLines-1) DO
  285.               Move(StorePtrs[I]^,ShowPtrs[I]^,VisibleX * 2);
  286.           END
  287.       END
  288.     ELSE         { If we want to pan the display down the screen }
  289.       BEGIN
  290.         { First check if the pan would take us out of legal line range: }
  291.         IF TopLine + YOffset < Height THEN
  292.           BEGIN
  293.             { If we're not at bottom but ByLines would take us out of }
  294.             { legal range, adjust ByLines to scroll the rest of the way: }
  295.             IF TopLine + YOffset + ByLines > HEIGHT THEN
  296.               ByLines := HEIGHT - (TopLine + YOffset);
  297.             { Move newly-hidden lines into virtual screen buffer: }
  298.             FOR I := TopLine TO TopLine + (ByLines-1) DO
  299.               Move(ShowPtrs[I]^,StorePtrs[I]^,VisibleX * 2);
  300.             { Glitch the display pointer array down: }
  301.             Move(ShowPtrs[TopLine],ShowPtrs[TopLine+ByLines],VisibleY * 4);
  302.             { Repoint affected line pointers into virtual screen: }
  303.             FOR I := TopLine TO TopLine + (ByLines-1) DO
  304.               ShowPtrs[I] := StorePtrs[I];
  305.             { Glitch the display buffer up }
  306.             GlitchDisplay(True,ByLines);
  307.             { Move newly-visible lines to display from virtual screen: }
  308.             FOR I := TopLine + VisibleY TO TopLine + VisibleY + (ByLines-1) DO
  309.               Move(StorePtrs[I]^,ShowPtrs[I]^,VisibleX * 2);
  310.             { And finally, update virtual screen's TopLine counter: }
  311.             TopLine := TopLine + ByLines
  312.           END
  313.       END
  314. END;
  315.  
  316.  
  317. { You *must* init a V-Screen through this proc before using it: }
  318.  
  319. PROCEDURE InitScreen(Target : ScreenPtr; Visible : Boolean);
  320.  
  321. VAR
  322.   I : Integer;
  323.  
  324. BEGIN
  325.   WITH Target^ DO
  326.     BEGIN
  327.       FOR I := 1 TO HEIGHT DO
  328.         BEGIN
  329.           New(ShowPtrs[I]);            { Allocate a line on the heap }
  330.           StorePtrs[I] := ShowPtrs[I]  { Duplicate pointer }
  331.         END;
  332.       X := 1;
  333.       Y := 1;
  334.       TopLine := 1;
  335.       FollowCursor := True;
  336.         IF Visible THEN     { As opposed to a "ghost" screen on the heap }
  337.           FOR I := 0 TO VisibleY-1 DO
  338.             ShowPtrs[I+1] :=     { Repoint pointers into refresh buffer }
  339.               Ptr(Seg(TextBufferOrigin^),
  340.                   Ofs(TextBufferOrigin^) + (I * (VisibleX * 2)))
  341.     END
  342. END;
  343.  
  344.  
  345. { Frees up heapspace occupied by Target.  DON'T use if Target is the  }
  346. { address of a statically declared-record obtained with @ or Addr()!! }
  347.  
  348. PROCEDURE DisposeOfScreen(VAR Target : ScreenPtr);
  349.  
  350. VAR
  351.   I : Integer;
  352.  
  353. BEGIN
  354.   FOR I := 1 TO Height DO Dispose(Target^.ShowPtrs[I]);
  355.   Dispose(Target);
  356.   Target := NIL
  357. END;
  358.  
  359.  
  360. { SCREENS Initialization Section: }
  361.  
  362. BEGIN
  363.   CurrentAttr := $07;   { $07 is the "normal" video attribute }
  364. END.
  365.  
  366.  
  367. [LISTING THREE]
  368.  
  369.  
  370. {--------------------------------------------------------------}
  371. {                         SCREENTEST                           }
  372. {                Virtual screen demo program                   }
  373. {                                                              }
  374. {                                    by Jeff Duntemann KI6RA   }
  375. {                                    Turbo Pascal 5.0          }
  376. {                                    Last modified 12/24/88    }
  377. {--------------------------------------------------------------}
  378.  
  379. PROGRAM ScreenTest;
  380.  
  381. USES DOS,         { Standard Borland unit }
  382.      TextInfo,    { Given last issue; DDJ 3/89 }
  383.      Screens;     { Given this issue; DDJ 4/89 }
  384.  
  385. CONST
  386.   PanBy          = 1;   { Specifies # of lines to pan at once }
  387.  
  388. VAR
  389.   I              : Integer;
  390.   Check          : Integer;
  391.   Ch             : Char;
  392.   Extended       : Boolean;
  393.   Scancode       : Byte;
  394.   Shifts         : Byte;
  395.   TestScreen     : Screen;
  396.   MyScreen       : ScreenPtr;
  397.   FileName       : String80;
  398.   TestFile       : Text;
  399.   HalftoneAtom   : ScreenAtom;
  400.   InString       : String80;
  401.  
  402.  
  403. {->>>>GetKey<<<<-----------------------------------------------}
  404. {                                                              }
  405. { Filename: GETKEY.SRC -- Last modified 7/23/88                }
  406. {                                                              }
  407. { This routine uses ROM BIOS services to test for the presence }
  408. { of a character waiting in the keyboard buffer and, if one is }
  409. { waiting, return it.  The function itself returns a TRUE      }
  410. { if a character has been read.  The character is returned in  }
  411. { Ch.  If the key pressed was a "special" (non-ASCII) key, the }
  412. { Boolean variable Extended will be set to TRUE and the scan   }
  413. { code of the special key will be returned in Scan.  In        }
  414. { addition, GETKEY returns shift status each time it is called }
  415. { regardless of whether or not a character was read.  Shift    }
  416. { status is returned as eight flag bits in byte Shifts,        }
  417. { according to the bitmap below:                               }
  418. {                                                              }
  419. {             BITS                                             }
  420. {     7  6  5  4  3  2  1  0                                   }
  421. {     1  .  .  .  .  .  .  .  INSERT      (1=Active)           }
  422. {     .  1  .  .  .  .  .  .  CAPS LOCK   (1=Active)           }
  423. {     .  .  1  .  .  .  .  .  NUM LOCK    (1=Active)           }
  424. {     .  .  .  1  .  .  .  .  SCROLL LOCK (1=Active)           }
  425. {     .  .  .  .  1  .  .  .  ALT         (1=Depressed)        }
  426. {     .  .  .  .  .  1  .  .  CTRL        (1=Depressed)        }
  427. {     .  .  .  .  .  .  1  .  LEFT SHIFT  (1=Depressed)        }
  428. {     .  .  .  .  .  .  .  1  RIGHT SHIFT (1=Depressed)        }
  429. {                                                              }
  430. { Test for individual bits using masks and the AND operator:   }
  431. {                                                              }
  432. {   IF (Shifts AND $0A) = $0A THEN CtrlAndAltArePressed;       }
  433. {                                                              }
  434. {     From: COMPLETE TURBO PASCAL 5.0  by Jeff Duntemann       }
  435. {    Scott, Foresman & Co., Inc. 1988   ISBN 0-673-38355-5     }
  436. {--------------------------------------------------------------}
  437.  
  438. FUNCTION GetKey(VAR Ch       : Char;
  439.                 VAR Extended : Boolean;
  440.                 VAR Scan     : Byte;
  441.                 Var Shifts   : Byte) : Boolean;
  442.  
  443. VAR Regs  : Registers;
  444.     Ready : Boolean;
  445.  
  446. BEGIN
  447.   Extended := False; Scan := 0;
  448.   Regs.AH := $01;     { AH=1: Check for keystroke }
  449.   Intr($16,Regs);     { Interrupt $16: Keyboard services}
  450.   Ready := (Regs.Flags AND $40) = 0;
  451.   IF Ready THEN
  452.     BEGIN
  453.       Regs.AH := 0;        { Char is ready; go read it... }
  454.       Intr($16,Regs);      { ...using AH = 0: Read Char }
  455.       Ch := Chr(Regs.AL);  { The char is returned in AL }
  456.       Scan := Regs.AH;     { ...and scan code in AH.    }
  457.       IF Ch = Chr(0) THEN Extended := True ELSE Extended := False;
  458.     END;
  459.   Regs.AH := $02;          { AH=2: Get shift/alt/ctrl status }
  460.   Intr($16,Regs);
  461.   Shifts := Regs.AL;
  462.   GetKey := Ready
  463. END;
  464.  
  465.  
  466.  
  467. BEGIN
  468.   IF ParamCount < 1 THEN   { No file-ee, no work-ee }
  469.     BEGIN
  470.       Writeln('>>>SCRNTEST  by Jeff Duntemann ');
  471.       Writeln('   Virtual screen demo program');
  472.       Writeln('   Version of 12/24/88 -- Turbo Pascal 5.0');
  473.       Writeln('   Invoke:  SCRNTEST <textfile> <CR>');
  474.       Writeln('   Use up/down arrows to pan window;');
  475.       Writeln('   the DEL key to blank out a line.');
  476.       Writeln('   Press "Q" or "q" to quit...');
  477.     END
  478.   ELSE
  479.     BEGIN
  480.       FileName := ParamStr(1);    { See if named file can be opened }
  481.       Assign(TestFile,FileName);
  482.       {$I-} Reset(TestFile); {$I+}
  483.       Check := IOResult;
  484.       IF Check <> 0 THEN          { If not, complain: }
  485.         BEGIN
  486.           Writeln('>>Test file ',FileName,' Cannot be opened.');
  487.           Writeln('  Please invoke again with a valid file name.');
  488.         END
  489.       ELSE
  490.         BEGIN   { File can be opened; let's read it into a V-screen }
  491.           HalftoneAtom.Ch := Chr(177); HalftoneAtom.Attr := $07;
  492.           MyScreen := @TestScreen;
  493.           InitScreen(MyScreen,True);     { Allocate & init the screen }
  494.           ClrScreen(MyScreen,ClearAtom); { Clear the screen }
  495.  
  496.           IF NOT EOF(TestFile) THEN    { If the file isn't empty... }
  497.             BEGIN
  498.               I := 1;                  { Start from line 1 }
  499.               WHILE (NOT EOF(TestFile)) AND (I <= HEIGHT) DO
  500.                 BEGIN
  501.                   Readln(TestFile,InString);
  502.                   { Truncate each line at 70 columns: }
  503.                   InString := Copy(InString,1,70);
  504.                   { Write line number to the V-Screen: }
  505.                   WriteTo(MyScreen,IntStr(I,5));
  506.                   { Write the data line to the V-Screen: }
  507.                   WritelnTo(MyScreen,': '+InString);
  508.                   Inc(I)     { Increment the line counter }
  509.                 END;
  510.  
  511.               { Up to 66 lines of the file are on the screen. }
  512.               { Here we pan up on the up arrow, and down on   }
  513.               { the down arrow.  'Q' quits the program.       }
  514.               Extended := False;
  515.               REPEAT
  516.                 IF Extended THEN
  517.                   CASE Scancode OF
  518.        { DEL }     83 : WITH MyScreen^ DO
  519.                         ClearLine(ShowPtrs[TopLine + (VisibleY DIV 2)],
  520.                                   VisibleX,HalftoneAtom);
  521.    { Up Arrow }    72 : Pan(MyScreen,Up,PanBy);
  522.    { Down arrow }  80 : Pan(MyScreen,Down,PanBy);
  523.                   END; { CASE }
  524.                 REPEAT UNTIL GetKey(Ch,Extended,Scancode,Shifts);
  525.               UNTIL Ch IN ['Q','q'];
  526.             END
  527.         END
  528.     END
  529. END.