home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tvision / twi / twidemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-08-04  |  12.8 KB  |  281 lines
  1. Program TWIDemo;
  2.  
  3. (***********************************************************************)
  4. (**        Text Windowing Interface Copyright David Pabst 1992        **)
  5. (**                        All Rights Reserved                        **)
  6. (**   Compuserve: 76547,2643     Relaynet: Pascal to David Pabst      **)
  7. (**                                                                   **)
  8. (** You may use, test, and\or develop software that uses TWI for      **)
  9. (** up to 1 month (31 days).  You should not release software that    **)
  10. (** uses TWI before your register. If you do, your first registration **)
  11. (** for that software must be put towards registering TWI.  Either way**)
  12. (** you must register after 31 days of use and demoing TWI.           **)
  13. (** TWI is shareware.                      YOU must register if this  **)
  14. (** software meets your needs.  Registration is $15 (US) Check or     **)
  15. (** money order.                                                      **)
  16. (**                                                                   **)
  17. (** $15 - David Pabst, 18 McAdams Road, Framingham, MA 01701, USA     **)
  18. (***********************************************************************)
  19.  
  20.  
  21.  
  22. uses TWI2,CRt;
  23.  
  24. Var                                   (* Global Variables *)
  25.  SubA,SubB,SubC, Top, A, B, C, D, Bottom     : string;
  26.  Option               : char;
  27.  Done, Done2          : boolean;
  28.  
  29. (* ---------------- *)
  30. Procedure InitVars;                   (* Intialize varaibles *)
  31. Begin                                 (* Init vars *)
  32.  fccf := 1;                           (* Fill character Color ForeGround *)
  33.  fccb := 7;                           (* Fill Character Color BackGround *)
  34.  wcol := 4;                           (* Word Color *)
  35.  FGC := 1;   { Set some colors }      (* Foreground Color *)
  36.  BGC := 7;                            (* Background Color *)
  37.  lc  := 1;                            (* Line Color *)
  38.  Hfc := 1;                            (* Highlight Foreground Color *)
  39.  Hbc := 2;                            (* Highlight Background Color *)
  40.  Hc  := 2;                            (* Highlight Color *)
  41.  Done     := False;
  42.  FillChar := ('▒');                   (* The character for the BKG fill in *)
  43.  Top    := ('                                                                                ');
  44.  Bottom := ('ESC Quit  F1 Help  F10 Menu '); (* Bottom Status Line *)
  45.  MenuA := ' = ';                      (* First menu Option will be = *)
  46.  menub := ' Demo ';                   (* 2nd option will be Demo *)
  47.  MenuC := '';                         (* Clear the others *)
  48.  menud := '';
  49.  MenuE := '';
  50.  MenuF := '';
  51.  MenuG := '';
  52. End;                                  (* Intialize Variables *)
  53. (* ---------------- *)
  54. Procedure MoveAround;                 (* Move box on screen around - DEMO *)
  55. Var
  56.  StatusLine : String;
  57.  X, Y, K    : Integer;
  58.  
  59. Begin                                 (* Move Around *)
  60.  X:= 2;                               (* X cooridinate *)
  61.  Y:= 3;                               (* Y cooridinate *)
  62.  Statusline:=('Arrw. Keys Move Window  F10 Return to Main Environment                     ');
  63.  ChangeStatusLine('',Statusline);     (* Change the status line on bottom *)
  64.  k:=y;
  65.  
  66.  a:=('Use the arrow keys to move');   (* Setup a small Window *)
  67.  b:=('the window around the ');
  68.  c:=('screen.  F10 returns you');
  69.  d:=('back to the main environment.');
  70.  DrawSmallWindow(A,b,c,d,x,y);        (* Draw a small window with A,B,C,D *)
  71.  
  72.  repeat
  73.   option := readkey;                  (* Get direction to move arrow *)
  74.   option := upcase(option);           (* Upcase it just in case *)
  75.   case option of
  76.    #0 : Begin                         (* If an escape is pressed check for... *)
  77.          clearsmallwindow(x,y);       (* Clear original window *)
  78.          option := readkey;           (* Get direction *)
  79.          option := upcase(option);
  80.          case option of
  81.            #72 : Begin                (* If up is pressed *)
  82.                   y:=y-1;
  83.                   if y<=2 then y:=3;  (* If near the end of screen *)
  84.                   clearsmallwindow(x,y); (* Clear Old Window *)
  85.                   drawsmallwindow(a,b,c,d,x,y); (* Draw new window *)
  86.                   done2 := true;
  87.                  end;
  88.  
  89.            #77 : Begin                (* If right arrow is pressed *)
  90.                   x:=x+1;
  91.                   if x>=48 then x:=47;(* If near side of screen then *)
  92.                   clearsmallwindow(x,y); (* Clear Old Window *)
  93.                   drawsmallwindow(a,b,c,d,x,y); (* Place new window *)
  94.                   done2 := true;
  95.                  end;
  96.  
  97.            #75 : Begin                (* If left button is pressed *)
  98.                   x:=x-1;
  99.                   if x<=1 then x:=2;  (* If near side of screen then *)
  100.                   clearsmallwindow(x,y); (* Clear Old Window *)
  101.                   drawsmallwindow(a,b,c,d,x,y); (* Draw new window *)
  102.                   done2 := true;
  103.                  end;
  104.  
  105.            #80 : Begin                (* If down is pressed *)
  106.                   y:=y+1;
  107.                   if y>=18 then y:=17;(* If near side of screen then *)
  108.                   clearsmallwindow(x,y); (* Clear old window *)
  109.                   drawsmallwindow(a,b,c,d,x,y); (* Draw new window *)
  110.                   done2 := true;
  111.                  end;
  112.  
  113.           end;                        (* Case *)
  114.        end;                           (* Case *)
  115.      end;
  116.   until option = #68;                 (* Repeat until F10 is pressed *)
  117. end;                                  (* Move Around *)
  118. (* ----------- *)
  119. Procedure Information;                (* Small info Window *)
  120. Begin                                 (* Information *)
  121.  DrawSmallWindow('This is a demo of Twi 1.0','','','(C) David Pabst 1992',25,8);
  122.  WaitForReturn;                       (* Wait until return is pressed *)
  123.  ClearSmallWindow(25,8);              (* Clear window since its been read *)
  124. End;                                  (* Information *)
  125. (* ----------- *)
  126. Procedure SelectSubOption1;           (* The Procedure for the 1st submenu *)
  127. Var
  128.  whichway      : char;
  129.  WhereSub      : integer;
  130.  NewSelectMade : boolean;
  131.  
  132. Begin
  133.  WhereCursorIsReWrite(4,3,Suba);      (* Place the highlighted cursor on *)
  134.                                       (* the first submenu *)
  135.  WhereSub := 1;                       (* Set the placement the computer is at *)
  136.  repeat
  137.   whichway := readkey;                (* Get movement direction *)
  138.   case whichway of
  139.  #77,#75 : Begin                      (* Left\Right Move out of Submenu *)
  140.             ClearSmallWindow(1,2);    (* Clear Sub Menu Off Screen *)
  141.             NewSelectmade := True;    (* End submenu execution *)
  142.            End;
  143.  
  144.      ^M  : Begin                      (* If Option is selected *)
  145.              information;
  146.            End;
  147.  
  148.    End;                               (* Case  *)
  149.  Until NewSelectMade;                 (* Repeat until done *)
  150.  ClearSmallWindow(1,2);               (* Clear Sub Menu when Done *)
  151. End;                                  (* Select Sub Option 1 *)
  152. (* ----------- *)
  153. Procedure SelectSubOption2;           (* The DEMO sub menu *)
  154. Var
  155.  whichway : char;
  156.  WhereSub : integer;
  157.  NewSelectMade: boolean;
  158.  
  159. Begin
  160.  WhereCursorIsReWrite(11,3,Suba);     (* Place cursor on 1st option in sub *)
  161.  WhereSub := 1;                       (* Place the counter on 1st option *)
  162.  repeat
  163.   whichway:=' ';                      (* Get direction or command *)
  164.   whichway := readkey;
  165.   case whichway of
  166.  
  167. #77,#75 :  Begin                      (* If right\left is pressed clear *)
  168.             NewSelectMade := True;    (* Stop executing sub menu *)
  169.             ClearSmallWindow(1,2);    (* Clear Sub menu off screen *)
  170.            End;
  171.  
  172.   ^M  : Begin                         (* If option is selected *)
  173.         If WhereSub = 1 then Begin    (* If on first option *)
  174.           ClearSmallWindow(9,2);      (* Clear SUb Menu *)
  175.           MoveAround;                 (*  Call the move around Procedure *)
  176.           DrawSubMenu(SubA,Subb,Subc,SubC,SubC,SubC,Subc,Subc,9,2,2);
  177.           WhereCursorIsReWrite(11,3,Suba); (* Redraw sub after Move Around *)
  178.           WhereSub := 1;
  179.           MoveToLocal(2);
  180.          End;
  181.         If WhereSub = 2 then Begin    (* Exit TWIDEMO *)
  182.          TwiClose;                    (* Close down TWI *)
  183.         End;
  184.        End;
  185.  
  186.  
  187.   #72 : Begin                         (* Move cursor up on screen *)
  188.          If WhereSub = 1 then Begin
  189.           WhereCursorIsReWrite(11,4,Subb); (* Move cursor *)
  190.           OldPlaceReWrite(11,3,Suba);      (* Clear old cursor from screen *)
  191.          End;
  192.          If WhereSub = 2 then Begin
  193.           WhereCursorIsReWrite(11,3,Suba);
  194.           OldPlaceReWrite(11,4,Subb);
  195.          End;
  196.          If WhereSub = 1 then WhereSub :=3; (* If at top of menu goto bottom *)
  197.           WhereSub := WhereSub -1;
  198.         End;
  199.  
  200.   #80 : Begin                         (* Move cursor down on menu *)
  201.          If WhereSub = 1 then Begin
  202.           OldPlaceReWrite(11,3,Suba);
  203.           WhereCursorIsReWrite(11,4,Subb);
  204.          End;
  205.  
  206.          If WhereSub =2 then Begin
  207.           OldPlaceReWrite(11,4,Subb);
  208.           WhereCursorIsReWrite(11,3,Suba);
  209.          End;
  210.  
  211.          WhereSub:=WhereSub+1;        (* If at bottom move cursor to top *)
  212.          If WhereSub = 3 then WhereSub:=1;
  213.       End;
  214.     End;
  215.   Until NewSelectMade = True;         (* If Done *)
  216. End;                                  (* SelectSub Option 2 *)
  217. (* ---------------- *)
  218. var
  219.  oldLocation, Location : integer;
  220.  KeyHit2, KeyHit       : char;
  221.  SelectMade, going     : boolean;
  222.  
  223. Begin                                 (* Main Loop *)
  224.   Initvars;                           (* Initialize colors *)
  225.   QuickBkgDraw(Top, Bottom);          (* Use the quick Background draw command *)
  226.   DefaultColors;                      (* You can call this insted of INITVARS *)
  227.   DrawMenus;                          (* Draw menu bar on top of screen *)
  228.   SelectMade := False;                (* Make sure demo doesn't exit *)
  229.   oldLocation := 1;                   (* number 1 space on menu bar *)
  230.   Location := 1;                      (* Location of cursor on menu bar *)
  231.   movetolocal(Location);              (* Place cursor on 1st option on menu bar *)
  232.  
  233.   repeat                              (* Repeat Until you're done *)
  234.    option := readkey;                 (* Get direction of movement *)
  235.    option := upcase(option);
  236.    case option of
  237.     #27 : TWICLOSE;                   (* when escape is pressed = exit *)
  238.     #71 : Begin                       (* Jump to first place on menu bar *)
  239.            cleanoldLocation(oldLocation); (* Clean cursor off menu bar *)
  240.            Location := 1;             (* Set location to 1st option on menu bar *)
  241.            movetolocal(Location);     (* Move to space 1 on menu bar *)
  242.            oldLocation := Location;   (* Make new place the old place of cursor *)
  243.           End;
  244.  
  245.  
  246.     #77 : Begin                       (* If right arrow is pressed *)
  247.            cleanoldLocation(oldLocation); (* Remove cursor from menu bar *)
  248.            Location := Location +1;   (* Move location over one to right *)
  249.            If Location = 3 then Location := 1; (* if to far over go back *)
  250.            movetolocal(Location);     (* Place cursor on screen *)
  251.            oldLocation := Location;   (* Make new place the old place of cursor *)
  252.           End;
  253.  
  254.     #75 : Begin                       (* If Left arrow is pressed *)
  255.            cleanoldLocation(oldLocation); (* Remove cursor from menu bar *)
  256.            If Location = 1 then Location := 2; (* just in case your off screen *)
  257.            Location := Location -1;   (* Move cursor placement over 1 *)
  258.            movetolocal(Location);     (* move cursor to new place on screen *)
  259.            oldLocation := Location;   (* Make new location the old location *)
  260.           End;
  261.  
  262.  ^M,#80 : Begin                       (* If return or down is pressed *)
  263.            If Location = 1 then Begin (* If at 1st place on menu bar *)
  264.               Suba :=( 'Information');(* put INFO on sub menu *)
  265.               Subb := '';             (* Blank Space *)
  266.               DrawSubMenu(Suba,Subb,Subb,Subb,Subb,Subb,Subb,Subb,2,2,1);
  267.               SelectSubOption1;       (* Call Sub Menu procedure *)
  268.            End;
  269.  
  270.            If Location = 2 then Begin (* If at 2nd place on menu bar *)
  271.               Suba :=('Run Demo');    (* have run demo option *)
  272.               Subb :=('Exit  Ctrl-Q');(* have exit demo option *)
  273.               Subc := '';
  274.               DrawSubMenu(Suba,Subb,Subc,Subc,Subc,Subc,Subc,Subc,9,2,2);
  275.               SelectSubOption2;       (* Call Sub Menu 2 Procedure *)
  276.            End;
  277.         End;                          (* ^M, #80 *)
  278.      End;                             (* Case *)
  279.   Until SelectMade;                   (* Repeat until user is done *)
  280. end.                                  (* TWIDEmo *)
  281.