home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / VGATOOLS.ZIP / USEROO.ZIP / WINDOWS.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-12-29  |  26.8 KB  |  820 lines
  1.  
  2. {----------------------------------------------------------------------------}
  3. {                                                                            }
  4. {      Window Routines  -  By Marcos Della       12/13/89                    }
  5. {                                                                            }
  6. {                          D&M Enterprises                                   }
  7. {                          c/o Marcos R. Della                               }
  8. {                          PO Box 4251                                       }
  9. {                          Santa Rosa, CA 95402                              }
  10. {                                                                            }
  11. {      This unit is an object oriented system that is designed to have       }
  12. {      stackable windows.  Enclosed are a few additions to the system so     }
  13. {      that you can see how you can add your own routines to the standard    }
  14. {      windows object as defined by this unit.  Note the end routines that   }
  15. {      are NOT object oriented at the end of the code.  This is the user     }
  16. {      interface made to SIMPLIFY the programmers need for programming.      }
  17. {      You can use these for a simple window stack system, or you can        }
  18. {      create your own system of complexity for whatever reason you want...  }
  19. {                                                                            }
  20. { -------------------------------------------------------------------------- }
  21. {                                                                            }
  22. {    (c) Copyright D&M Enterprises, a general parternership, This program    }
  23. {      is CONFIDENTIAL, unpublished work of authorship created in 1989.      }
  24. {  IT IS A TRADE SECRET WHICH IS THE PROPERTY OF D&M ENTERPRISES, a general  }
  25. {   partnership.  ALL USE, DISCLOSURE, AND/OR REPRODUCTION NOT SPECIFICALLY  }
  26. {   AUTHORIZED BY D&M ENTERPRISES IS PROHIBITED.  This program may also be   }
  27. {       protected under copyright and similar laws of other countries.       }
  28. {                            All rights reserved.                            }
  29. {                                                                            }
  30. { -------------------------------------------------------------------------- }
  31. {                                                                            }
  32. {      The major procedures that are included with this unit are openwindow, }
  33. {      closewindow, change_title, change_border, and horizontal_line.        }
  34. {      The code to create a stack oriented window system is included. The    }
  35. {      procedures change_title, change_border, and horizontal_line are       }
  36. {      examples of how you can add to the basic unit.                        }
  37. {                                                                            }
  38. {      To use these procedures, you need the following...                    }
  39. {                                                                            }
  40. {      PROCEDURE openwindow(x1,y1,x2,y2,attr,shadow,borderchar,battr,        }
  41. {                           title,tattr);                                    }
  42. {                x1,y1      : upper left corner of the window                }
  43. {                x2,y2      : lower right corner of the window               }
  44. {                attr       : foreground/background attributes of the window }
  45. {                shadow     : True=creates a shadow effect                   }
  46. {                borderchar : ┌┐└┘──││┤├  characters. You can use the        }
  47. {                             constants std_border, dbl_border, or sp1_border}
  48. {                battr      : foreground/background attributes of the border }
  49. {                title      : title of the window                            }
  50. {                tattr      : fore/background attribute of the title         }
  51. {                                                                            }
  52. {      PROCEDURE closewindow  Removes the current window from the screen     }
  53. {      PROCEDURE change_title(title);        Changes the title string        }
  54. {      PROCEDURE change_border(borderchar);  Changes the border characters   }
  55. {      PROCEDURE horizontal_line(y,'├─┤');   Creates a horizontal line       }
  56. {                                                                            }
  57. { -------------------------------------------------------------------------- }
  58.  
  59. Unit Windows;
  60.  
  61. Interface
  62.  
  63. Uses Crt, Dos;
  64.  
  65. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  66. { Note: When you use the "stdopenwindow" these are the standard items that   }
  67. {       are used.  You can change them from your program to create your      }
  68. {       own standards.                                                       }
  69.  
  70. CONST std_border : STRING[13] = '┌┐└┘──││┤├├─┤';
  71.       std_attr   : BYTE       = blue * 16 + white;
  72.       std_battr  : BYTE       = blue * 16 + white;
  73.       std_tattr  : BYTE       = blue * 16 + white;
  74.       std_shadow : BOOLEAN    = TRUE;
  75.  
  76. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  77. { The following definitions are to be used when you call openwindow and need }
  78. { a border character design. These are just some that we have come up with   }
  79. { for you to use...                                                          }
  80.  
  81.       dbl_border = '╔╗╚╝══║║╡╞╟─╢';
  82.       sp1_border = '╒╕╘╛══││╡╞├─┤';
  83.       sp2_border = '┌┐└┘──││┤├├─┤';
  84.  
  85. TYPE  line       = STRING[80];
  86.       bstr       = STRING[13];
  87.  
  88.       baseptr    = ^base_elm;
  89.       base_elm   = OBJECT
  90.                       DESTRUCTOR done; VIRTUAL;
  91.                    END;
  92.  
  93.       nodeptr    = ^node;
  94.       node       = OBJECT(base_elm)
  95.                       prevptr : nodeptr;
  96.                       nextptr : nodeptr;
  97.                    END;
  98.  
  99.       nodelptr   = ^nodelist;
  100.       nodelist   = OBJECT(node)
  101.                       head : nodeptr;
  102.                       tail : nodeptr;
  103.                       FUNCTION  first : nodeptr;
  104.                       FUNCTION  last  : nodeptr;
  105.                       FUNCTION  prev(p : nodeptr) : nodeptr;
  106.                       FUNCTION  next(p : nodeptr) : nodeptr;
  107.                       FUNCTION  prev_wrap(p : nodeptr) : nodeptr;
  108.                       FUNCTION  next_wrap(p : nodeptr) : nodeptr;
  109.                       FUNCTION  empty : BOOLEAN;
  110.  
  111.                       PROCEDURE inserthead(p : nodeptr);
  112.                       PROCEDURE inserttail(p : nodeptr);
  113.                       PROCEDURE deleteptr(p : nodeptr);
  114.                       PROCEDURE initlist;
  115.                       PROCEDURE disposelist
  116.                    END;
  117.  
  118.       winptr     = ^windowelm;
  119.       windowelm  = OBJECT(node)
  120.                       cursor_x  : BYTE;
  121.                       cursor_y  : BYTE;
  122.                       win_min   : WORD;
  123.                       win_max   : WORD;
  124.                       text_attr : BYTE;
  125.                     { ----------------- }
  126.                       x1pos     : BYTE;
  127.                       y1pos     : BYTE;
  128.                       x2pos     : BYTE;
  129.                       y2pos     : BYTE;
  130.                       x_attr    : BYTE;
  131.                       shadow    : BOOLEAN;
  132.                       coverptr  : POINTER;
  133.                       restore   : BOOLEAN;
  134.  
  135.                       CONSTRUCTOR openwindow(x1,y1,x2,y2,attr : BYTE; makeshadow : BOOLEAN);
  136.                       DESTRUCTOR closewindow; VIRTUAL;
  137.                    END;
  138.  
  139.       windowptr  = ^windowobj;
  140.       windowobj  = OBJECT(windowelm)
  141.                       borders  : bstr;
  142.                       b_attr   : BYTE;
  143.                       titleptr : ^STRING;
  144.                       t_attr   : BYTE;
  145.                       CONSTRUCTOR openwindow(x1,y1,x2,y2,attr : BYTE;
  146.                                              makeshadow : BOOLEAN;
  147.                                              borderchar : bstr; battr : BYTE;
  148.                                              title : line; tattr : BYTE);
  149.                       DESTRUCTOR closewindow; VIRTUAL;
  150.                       PROCEDURE change_title(title : line);
  151.                       PROCEDURE change_border(borderchar : bstr);
  152.                       PROCEDURE horizontal_line(y : BYTE; onoff : BOOLEAN);
  153.                    END;
  154.  
  155.       wstackptr  = ^wstack;
  156.       wstack     = OBJECT(nodelist)
  157.                       CONSTRUCTOR initwindow;
  158.                       DESTRUCTOR done; VIRTUAL;
  159.                    END;
  160.  
  161. {$F+}
  162. PROCEDURE setfieldattr   (x,y,ln,atr : WORD );
  163. PROCEDURE setfieldstr    (x,y,ln     : WORD; s : line);
  164. PROCEDURE setfieldatrstr (x,y,ln,atr : WORD; s : line);
  165. PROCEDURE callproc(sub : POINTER);
  166. {$F-}
  167. PROCEDURE hidecursor;
  168. PROCEDURE showcursor;
  169. PROCEDURE linecursor;
  170. PROCEDURE bigcursor;
  171.  
  172. {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  173. { The following procedures save a segment of the screen as defined by the }
  174. { X1,Y1 and X2,Y2 coordinates.  The information is saved in the VAR item  }
  175. { and it is the users responsibility to GETMEM and FREEMEM the area.      }
  176.  
  177. PROCEDURE saveseg(X1,Y1,X2,Y2 : BYTE; VAR dest);
  178. PROCEDURE restoreseg(X1,Y1,X2,Y2 : BYTE; VAR source);
  179.  
  180. PROCEDURE savescreen(ns : INTEGER);
  181. PROCEDURE restorescreen(ns : INTEGER);
  182.  
  183. PROCEDURE fillscr(ch : CHAR);
  184. PROCEDURE writech(x,y : BYTE; ch : CHAR; attr : BYTE);
  185. PROCEDURE openwindow(x1,y1,x2,y2,attr : BYTE;
  186.                      shadow : BOOLEAN; borderchar : bstr;
  187.                      battr : BYTE; title : line; tattr : BYTE);
  188. PROCEDURE change_title(title : line);
  189. PROCEDURE change_border(borderchar : bstr);
  190. PROCEDURE horizontal_line(y : BYTE; onoff : BOOLEAN);
  191. PROCEDURE popwindow;
  192. PROCEDURE closewindow;
  193.  
  194. PROCEDURE stdopenwindow(x1,y1,x2,y2 : BYTE; title : line);
  195.  
  196. Implementation
  197.  
  198. {----------------------------------------------------------------------------}
  199.  
  200. TYPE  scrmap     = RECORD
  201.                       scrch : CHAR;
  202.                       scrat : BYTE
  203.                    END;
  204.       screen     = ARRAY[1..25,1..80] OF scrmap;
  205.  
  206. VAR   reg         : REGISTERS;
  207.       screenbase  : WORD;
  208.       windowstack : wstack;
  209.       colorscreen : screen ABSOLUTE $B800:$0000;
  210.       monoscreen  : screen ABSOLUTE $B000:$0000;
  211.       screenhold  : ARRAY[1..10] OF ^screen;
  212.  
  213. {----------------------------------------------------------------------------}
  214.  
  215. DESTRUCTOR base_elm.done;
  216. BEGIN
  217. END;
  218.  
  219. { -------------------------------------------------------------------------- }
  220.  
  221. FUNCTION nodelist.first;
  222. BEGIN
  223.    first := head
  224. END;
  225.  
  226. { -------------------------------------------------------------------------- }
  227.  
  228. FUNCTION nodelist.last;
  229. BEGIN
  230.    last := tail
  231. END;
  232.  
  233. { -------------------------------------------------------------------------- }
  234.  
  235. FUNCTION nodelist.prev;
  236. BEGIN
  237.    IF p = head THEN
  238.       prev := NIL
  239.    ELSE
  240.       prev := p^.prevptr
  241. END;
  242.  
  243. { -------------------------------------------------------------------------- }
  244.  
  245. FUNCTION nodelist.next;
  246. BEGIN
  247.    IF p = last THEN
  248.       next := NIL
  249.    ELSE
  250.       next := p^.nextptr
  251. END;
  252.  
  253. { -------------------------------------------------------------------------- }
  254.  
  255. FUNCTION nodelist.prev_wrap;
  256. BEGIN
  257.    prev_wrap := p^.prevptr
  258. END;
  259.  
  260. { -------------------------------------------------------------------------- }
  261.  
  262. FUNCTION nodelist.next_wrap;
  263. BEGIN
  264.    next_wrap := p^.nextptr
  265. END;
  266.  
  267. { -------------------------------------------------------------------------- }
  268.  
  269. FUNCTION nodelist.empty;
  270. BEGIN
  271.    empty := (head = NIL)
  272. END;
  273.  
  274. { -------------------------------------------------------------------------- }
  275.  
  276. PROCEDURE nodelist.inserthead;
  277. BEGIN
  278.    IF head = NIL THEN
  279.       BEGIN
  280.          p^.prevptr := p;
  281.          p^.nextptr := p;
  282.          tail := p
  283.       END
  284.    ELSE
  285.       BEGIN
  286.          p^.nextptr := head;
  287.          p^.prevptr := tail;
  288.          p^.nextptr^.prevptr := p;
  289.          p^.prevptr^.nextptr := p
  290.       END;
  291.    head := p
  292. END;
  293.  
  294. { -------------------------------------------------------------------------- }
  295.  
  296. PROCEDURE nodelist.inserttail;
  297. BEGIN
  298.    IF tail = NIL THEN
  299.       BEGIN
  300.          p^.prevptr := p;
  301.          p^.nextptr := p;
  302.          head := p
  303.       END
  304.    ELSE
  305.       BEGIN
  306.          p^.nextptr := head;
  307.          p^.prevptr := tail;
  308.          p^.nextptr^.prevptr := p;
  309.          p^.prevptr^.nextptr := p
  310.       END;
  311.    tail := p
  312. END;
  313.  
  314. { -------------------------------------------------------------------------- }
  315.  
  316. PROCEDURE nodelist.deleteptr;
  317. VAR   tptr : nodeptr;
  318. BEGIN
  319.    IF head <> NIL THEN
  320.       BEGIN
  321.          tptr := head;
  322.          WHILE (tptr^.nextptr <> p) AND (tptr^.nextptr <> head) DO
  323.             tptr := tptr^.nextptr;
  324.          IF tptr^.nextptr = p THEN
  325.             IF p^.nextptr = p THEN
  326.                initlist
  327.             ELSE
  328.                BEGIN
  329.                   tptr^.nextptr := p^.nextptr;
  330.                   tptr^.nextptr^.prevptr := tptr;
  331.                   IF head = p THEN
  332.                      BEGIN
  333.                         head := p^.nextptr;
  334.                         tail := head^.prevptr
  335.                      END;
  336.                   IF tail = p THEN
  337.                      BEGIN
  338.                         tail := p^.prevptr;
  339.                         head := tail^.nextptr
  340.                      END
  341.                END
  342.       END
  343. END;
  344.  
  345. { -------------------------------------------------------------------------- }
  346.  
  347. PROCEDURE nodelist.disposelist;
  348. VAR   p : nodeptr;
  349. BEGIN
  350.    WHILE head <> NIL DO BEGIN
  351.       p := head;
  352.       deleteptr(p);
  353.       DISPOSE(p,done)
  354.    END
  355. END;
  356.  
  357. { -------------------------------------------------------------------------- }
  358.  
  359. PROCEDURE nodelist.initlist;
  360. BEGIN
  361.    head := NIL;
  362.    tail := NIL
  363. END;
  364.  
  365. { -------------------------------------------------------------------------- }
  366.  
  367. PROCEDURE writech(x,y : BYTE; ch : CHAR; attr : BYTE);
  368. BEGIN
  369.    MEM[screenbase:PRED(x) * 2 + 160 * PRED(y)] := ORD(ch);
  370.    MEM[screenbase:PRED(x) * 2 + 160 * PRED(y) + 1] := attr;
  371. END;
  372.  
  373. {----------------------------------------------------------------------------}
  374.  
  375. PROCEDURE saveseg(X1,Y1,X2,Y2 : BYTE; VAR dest);
  376. VAR   i     : BYTE;
  377.       width : BYTE;
  378.       saddr : INTEGER;
  379. BEGIN
  380.    width := SUCC(x2 - x1);
  381.    FOR i := y1 TO y2 DO BEGIN
  382.      saddr := PRED(i) * 160 + PRED(x1) * 2;
  383.      MOVE(MEM[screenbase:saddr],
  384.           MEM[SEG(dest):OFS(dest) + (i - y1) * width * 2],
  385.           width * 2)
  386.    END
  387. END;
  388.  
  389. {----------------------------------------------------------------------------}
  390.  
  391. PROCEDURE restoreseg(X1,Y1,X2,Y2 : BYTE; VAR source);
  392. VAR   i     : BYTE;
  393.       width : BYTE;
  394.       saddr : INTEGER;
  395. BEGIN
  396.    width := SUCC(x2 - x1);
  397.    FOR i := y1 TO y2 DO BEGIN
  398.      saddr := PRED(i) * 160 + PRED(x1) * 2;
  399.      MOVE(MEM[SEG(source):OFS(source) + (i - y1) * width * 2],
  400.           MEM[screenbase:saddr],
  401.           width * 2)
  402.    END
  403. END;
  404.  
  405. {----------------------------------------------------------------------------}
  406.  
  407. PROCEDURE shadowseg(x1,y1,x2,y2 : INTEGER);
  408. VAR   i   : BYTE;
  409. BEGIN
  410.    IF y2 < 24 THEN
  411.       FOR i := x1 + 2 TO x2 DO
  412.          MEM[screenbase:PRED(i * 2) + y2 * 160] := LIGHTGRAY;
  413.  
  414.    IF x2 + 1 < 80 THEN
  415.       FOR i := y1 TO y2 DO BEGIN
  416.          MEM[screenbase:x2 * 2 + i * 160 + 1] := LIGHTGRAY;
  417.          MEM[screenbase:(x2 + 1) * 2 + i * 160 + 1] := LIGHTGRAY
  418.       END;
  419.  
  420.    IF (x2 + 1 < 80) AND (y2 < 24) THEN
  421.       BEGIN
  422.          MEM[screenbase:x2 * 2 + y2 * 160 + 1] := LIGHTGRAY;
  423.          MEM[screenbase:(x2 + 1) * 2 + y2 * 160 + 1] := LIGHTGRAY
  424.       END
  425. END;
  426.  
  427. {----------------------------------------------------------------------------}
  428.  
  429. CONSTRUCTOR windowelm.openwindow;
  430. VAR   size : WORD;
  431. BEGIN
  432.    cursor_x  := wherex;
  433.    cursor_y  := wherey;
  434.    win_min   := windmin;
  435.    win_max   := windmax;
  436.    text_attr := textattr;
  437.    x1pos     := x1;
  438.    y1pos     := y1;
  439.    x2pos     := x2;
  440.    y2pos     := y2;
  441.    x_attr    := attr;
  442.    shadow    := makeshadow;
  443.    coverptr  := NIL;
  444.    restore   := TRUE;
  445.  
  446.    IF ((x2 > 78) AND (x2 <= 80)) OR (y2 = 25) THEN
  447.       shadow := FALSE;
  448.  
  449.    IF (x1 < 0) OR (x2 > 80) OR
  450.       (y1 < 0) OR (y2 > 25) OR
  451.       (x1 > x2) OR (y1 > y2) OR
  452.       (x2 - x1 < 0) OR (y2 - y1 < 0) THEN
  453.       EXIT;
  454.  
  455.    IF shadow THEN
  456.       BEGIN
  457.          GETMEM(coverptr,SUCC(x2 - x1 + 2) * 2 * SUCC(y2 - y1 + 1));
  458.          saveseg(x1,y1,x2 + 2,y2 + 1,coverptr^)
  459.       END
  460.    ELSE
  461.       BEGIN
  462.          GETMEM(coverptr,SUCC(x2 - x1) * 2 * SUCC(y2 - y1));
  463.          saveseg(x1,y1,x2,y2,coverptr^)
  464.       END;
  465.    IF shadow THEN
  466.       shadowseg(x1,y1,x2,y2);
  467.    WINDOW(x1,y1,x2,y2);
  468.    textattr := attr;
  469.    GOTOXY(1,1);
  470.    clrscr
  471. END;
  472.  
  473. { -------------------------------------------------------------------------- }
  474.  
  475. DESTRUCTOR windowelm.closewindow;
  476. BEGIN
  477.    IF coverptr = NIL THEN
  478.       EXIT;
  479.  
  480.    IF shadow THEN
  481.       BEGIN
  482.          IF restore THEN
  483.             restoreseg(x1pos,y1pos,x2pos + 2,y2pos + 1,coverptr^);
  484.          FREEMEM(coverptr,SUCC(x2pos - x1pos + 2) * 2 * SUCC(y2pos - y1pos + 1))
  485.       END
  486.    ELSE
  487.       BEGIN
  488.          IF restore THEN
  489.             restoreseg(x1pos,y1pos,x2pos,y2pos,coverptr^);
  490.          FREEMEM(coverptr,SUCC(x2pos - x1pos) * 2 * SUCC(y2pos - y1pos))
  491.       END;
  492.    coverptr := NIL;
  493.    textattr := text_attr;
  494.    windmin := win_min;
  495.    windmax := win_max;
  496.    GOTOXY(cursor_x,cursor_y)
  497. END;
  498.  
  499. {----------------------------------------------------------------------------}
  500.  
  501. CONSTRUCTOR windowobj.openwindow;
  502. VAR   i      : BYTE;
  503.       offset : BYTE;
  504. BEGIN
  505.    windowelm.openwindow(x1,y1,x2,y2,attr,makeshadow);
  506.    IF battr = 0 THEN
  507.       b_attr := attr
  508.    ELSE
  509.       b_attr := battr;
  510.    IF tattr = 0 THEN
  511.       t_attr := attr
  512.    ELSE
  513.       t_attr := tattr;
  514.    GETMEM(titleptr,LENGTH(title) + 1);
  515.    titleptr^ := title;
  516.  
  517.    windowobj.change_border(borderchar);
  518. END;
  519.  
  520. { -------------------------------------------------------------------------- }
  521.  
  522. DESTRUCTOR windowobj.closewindow;
  523. BEGIN
  524.    FREEMEM(titleptr,LENGTH(titleptr^) + 1);
  525.    windowelm.closewindow
  526. END;
  527.  
  528. { -------------------------------------------------------------------------- }
  529.  
  530. PROCEDURE windowobj.change_title;
  531. VAR   offset : BYTE;
  532.       i      : BYTE;
  533. BEGIN
  534.    FOR i := x1pos + 1 TO x2pos - 1 DO
  535.       writech(i,y1pos,borders[5],b_attr);
  536.    offset := (x2pos - x1pos - LENGTH(title)) DIV 2;
  537.    IF (offset > 0) AND (LENGTH(title) > 0) THEN
  538.       BEGIN
  539.          writech(x1pos + offset,y1pos,borders[9],b_attr);
  540.          writech(x1pos + offset + LENGTH(title) + 1,y1pos,borders[10],b_attr);
  541.          FOR i := 1 TO LENGTH(title) DO
  542.             writech(x1pos + offset + i,y1pos,title[i],t_attr)
  543.       END;
  544.    FREEMEM(titleptr,LENGTH(titleptr^) + 1);
  545.    GETMEM(titleptr,LENGTH(title) + 1);
  546.    titleptr^ := title
  547. END;
  548.  
  549. { -------------------------------------------------------------------------- }
  550.  
  551. PROCEDURE windowobj.change_border;
  552. VAR   i : BYTE;
  553. BEGIN
  554.    FILLCHAR(borders,SIZEOF(borders),0);
  555.    borders := borderchar;
  556.    IF (LENGTH(borderchar) >= 8) AND (x2pos - x1pos > 2) AND (y2pos - y1pos > 1) THEN
  557.       BEGIN
  558.          writech(x1pos,y1pos,borders[1],b_attr);
  559.          writech(x2pos,y1pos,borders[2],b_attr);
  560.          writech(x1pos,y2pos,borders[3],b_attr);
  561.          writech(x2pos,y2pos,borders[4],b_attr);
  562.          FOR i := x1pos + 1 TO x2pos - 1 DO
  563.             writech(i,y2pos,borders[6],b_attr);
  564.          FOR i := y1pos + 1 TO y2pos - 1 DO BEGIN
  565.             writech(x1pos,i,borders[7],b_attr);
  566.             writech(x2pos,i,borders[8],b_attr)
  567.          END;
  568.          windowobj.change_title(titleptr^);
  569.          WINDOW(x1pos + 1,y1pos + 1,x2pos - 1,y2pos - 1)
  570.       END;
  571. END;
  572.  
  573. { -------------------------------------------------------------------------- }
  574.  
  575. PROCEDURE windowobj.horizontal_line;
  576. VAR   i  : BYTE;
  577.       ch : CHAR;
  578. BEGIN
  579.    IF (y > 0) AND (y < y2pos - y1pos) THEN
  580.       BEGIN
  581.          IF onoff THEN
  582.             IF LENGTH(borders) < 13 THEN
  583.                ch := '─'
  584.             ELSE
  585.                BEGIN
  586.                   writech(x1pos,y1pos + y,borders[11],b_attr);
  587.                   writech(x2pos,y1pos + y,borders[13],b_attr);
  588.                   ch := borders[12]
  589.                END
  590.          ELSE
  591.             BEGIN
  592.                writech(x1pos,y1pos + y,borders[7],b_attr);
  593.                writech(x2pos,y1pos + y,borders[8],b_attr);
  594.                ch := ' '
  595.             END;
  596.          FOR i := x1pos + 1 TO x2pos - 1 DO
  597.             writech(i,y1pos + y,ch,x_attr)
  598.       END
  599. END;
  600.  
  601. {----------------------------------------------------------------------------}
  602.  
  603. CONSTRUCTOR wstack.initwindow;
  604. BEGIN
  605.    windowstack.initlist
  606. END;
  607.  
  608. { -------------------------------------------------------------------------- }
  609.  
  610. DESTRUCTOR wstack.done;
  611. BEGIN
  612.    windowstack.disposelist
  613. END;
  614.  
  615. {----------------------------------------------------------------------------}
  616.  
  617. PROCEDURE openwindow;
  618. VAR   p : windowptr;
  619. BEGIN
  620.    NEW(p,openwindow(x1,y1,x2,y2,attr,shadow,borderchar,battr,title,tattr));
  621.    windowstack.inserttail(p)
  622. END;
  623.  
  624. { -------------------------------------------------------------------------- }
  625.  
  626. PROCEDURE change_title(title : line);
  627. BEGIN
  628.    windowptr(windowstack.tail)^.change_title(title)
  629. END;
  630.  
  631. { -------------------------------------------------------------------------- }
  632.  
  633. PROCEDURE change_border(borderchar : bstr);
  634. BEGIN
  635.    windowptr(windowstack.tail)^.change_border(borderchar)
  636. END;
  637.  
  638. { -------------------------------------------------------------------------- }
  639.  
  640. PROCEDURE horizontal_line(y : BYTE; onoff : BOOLEAN);
  641. BEGIN
  642.    windowptr(windowstack.tail)^.horizontal_line(y,onoff)
  643. END;
  644.  
  645. { -------------------------------------------------------------------------- }
  646.  
  647. PROCEDURE closewindow;
  648. BEGIN
  649.    IF NOT windowstack.empty THEN
  650.       BEGIN
  651.          windowptr(windowstack.last)^.closewindow;
  652.          windowstack.deleteptr(windowstack.last)
  653.       END
  654. END;
  655.  
  656. { -------------------------------------------------------------------------- }
  657.  
  658. PROCEDURE popwindow;
  659. BEGIN
  660.    IF windowstack.tail <> NIL THEN
  661.       BEGIN
  662.          winptr(windowstack.tail)^.restore := FALSE;
  663.          closewindow
  664.       END
  665. END;
  666.  
  667. { -------------------------------------------------------------------------- }
  668.  
  669. PROCEDURE stdopenwindow;
  670. VAR   p : windowptr;
  671. BEGIN
  672.    NEW(p,openwindow(x1,y1,x2,y2,std_attr,std_shadow,
  673.                     std_border,std_battr,title,std_tattr));
  674.    windowstack.inserttail(p)
  675. END;
  676.  
  677. {----------------------------------------------------------------------------}
  678.  
  679. PROCEDURE movetoscreen(VAR source,dest; len: INTEGER);
  680.  
  681. { Similar to Turbo Move but assumes the destination is in video  }
  682. { memory and thus writes only during retrace to avoid snow.      }
  683. { These are used only in Save and Restore Screen routines below. }
  684. { These routines are very fast and can be used as the basic      }
  685. { building blocks for other direct screen IO.  I have used Turbo }
  686. { Pascals regular Write routines whereever possible because they }
  687. { are sufficiently fast and much more understandable and stable. }
  688.  
  689. BEGIN
  690.    len := len SHR 1;
  691.    INLINE($1E/$55/$BA/$DA/$03/$C5/$B6/ source /$C4/$BE/ dest /$8B/$8E/
  692.           len /$FC/$AD/$89/$C5/$B4/$09/$EC/$D0/$D8/$72/$FB/$FA/$EC/
  693.           $20/$E0/$74/$FB/$89/$E8/$AB/$FB/$E2/$EA/$5D/$1F)
  694. END;
  695.  
  696. {----------------------------------------------------------------------------}
  697.  
  698. PROCEDURE movefromscreen(VAR source,dest; len : INTEGER);
  699.  
  700. { Similar to Turbo Move but assumes the source is in video  }
  701. { memory and thus writes only during retrace to avoid snow. }
  702.  
  703. BEGIN
  704.    len := len SHR 1;
  705.    INLINE($1E/$55/$BA/$DA/$03/$C5/$B6/ source /$C4/$BE/ dest /$8B/$8E/
  706.           len /$FC/$EC/$D0/$D8/$72/$FB/$FA/$EC/$D0/$D8/$73/$FB/$AD/
  707.           $FB/$AB/$E2/$F0/$5D/$1F)
  708. END;
  709.  
  710. {----------------------------------------------------------------------------}
  711.  
  712. PROCEDURE savescreen(ns : INTEGER);
  713. BEGIN
  714.    IF screenhold[ns] = NIL THEN
  715.       NEW(screenhold[ns]);
  716.    IF screenbase = $B800 THEN
  717.       movefromscreen(colorscreen,screenhold[ns]^,4000)
  718.    ELSE
  719.       movefromscreen(monoscreen,screenhold[ns]^,4000);
  720. END;
  721.  
  722. {----------------------------------------------------------------------------}
  723.  
  724. PROCEDURE restorescreen(ns : INTEGER);
  725. BEGIN
  726.    IF screenbase = $B800 THEN
  727.       movetoscreen(screenhold[ns]^,colorscreen,4000)
  728.    ELSE
  729.       movetoscreen(screenhold[ns]^,monoscreen,4000);
  730.    DISPOSE(screenhold[ns]);
  731.    screenhold[ns] := NIL
  732. END;
  733.  
  734. {----------------------------------------------------------------------------}
  735.  
  736. PROCEDURE fillscr(ch : CHAR);
  737. VAR   x,y : WORD;
  738. BEGIN
  739.    x := windmin;
  740.    y := windmax;
  741.    WINDOW(1,1,80,25);
  742.    GOTOXY(1,1);
  743.    reg.ah := $09;
  744.    reg.al := ORD(ch);
  745.    reg.bx := textattr;
  746.    reg.cx := 1920;
  747.    INTR($10,reg);
  748.    windmin := x;
  749.    windmax := y
  750. END;
  751.  
  752. { -------------------------------------------------------------------------- }
  753.  
  754. {$F+}
  755. PROCEDURE setfieldattr   (x,y,ln,atr : WORD );           EXTERNAL;{$L SETA.OBJ}
  756. PROCEDURE setfieldstr    (x,y,ln     : WORD; s : line);  EXTERNAL;{$L SETS.OBJ}
  757. PROCEDURE setfieldatrstr (x,y,ln,atr : WORD; s : line);  EXTERNAL;{$L SETAS.OBJ}
  758.  
  759. PROCEDURE callproc(sub : POINTER);
  760. BEGIN
  761.    INLINE($FF/$5E/$06)
  762. END;
  763. {$F-}
  764.  
  765. {----------------------------------------------------------------------------}
  766.  
  767. PROCEDURE hidecursor;
  768. BEGIN
  769.    reg.ah := $03;                 { Service 3 }
  770.    INTR($10,reg);                 { Intr 10. Get scan lines}
  771.    reg.cx := reg.cx OR $2000;     { Set bit 5 to 1}
  772.    reg.ah := $01;                 { Service 1 }
  773.    INTR($10,reg);                 { Intr 10 resets cursor}
  774. END;
  775.  
  776. {----------------------------------------------------------------------------}
  777.  
  778. PROCEDURE showcursor;
  779. BEGIN
  780.    reg.ah := $03;               { Service 3 }
  781.    INTR($10,reg);               { Intr 10. Get scan lines}
  782.    reg.cx := reg.cx AND $DFFF;  { Set bit 5 to 0}
  783.    reg.ah := $01;               { Service 1 }
  784.    INTR($10,reg);               { Intr 10 resets cursor}
  785. END;
  786.  
  787. {----------------------------------------------------------------------------}
  788.  
  789. PROCEDURE linecursor;
  790. BEGIN
  791.    reg.ah := $01;                        { Service 1 }
  792.    IF (MEM[0000:1040] AND 48) <> 48 THEN { Check for CGA }
  793.       reg.cx := $0607                    { Color Adapter }
  794.    ELSE
  795.       reg.cx := $0C0D;                   { Mono Adapter }
  796.    INTR($10,reg);                        { Interrupt 10 }
  797. END;
  798.  
  799. {----------------------------------------------------------------------------}
  800.  
  801. PROCEDURE bigcursor;
  802. BEGIN
  803.    reg.ah := $01;                        { Service 1 }
  804.    IF (MEM[0000:1040] AND 48) <> 48 THEN { Check for CGA }
  805.       reg.cx := $0107                    { Color Adapter }
  806.    ELSE
  807.       reg.cx := $010D;                   { Mono Adapter }
  808.    INTR($10,reg);                        { Interrupt 10 }
  809. END;
  810.  
  811. {----------------------------------------------------------------------------}
  812.  
  813. BEGIN
  814.    FILLCHAR(screenhold,SIZEOF(screenhold),0);
  815.    IF ((MEM[0000:1040] AND 48) <> 48) THEN
  816.       screenbase := $B800
  817.    ELSE
  818.       screenbase := $B000;
  819.    windowstack.initwindow;
  820. END.