home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / lambda / soundpot / p / windoman.lbr / DEMO.PZS / DEMO.PAS
Encoding:
Pascal/Delphi Source File  |  1993-10-25  |  9.5 KB  |  453 lines
  1.  
  2. { ********** Window Management Services Demonstration ********** }
  3. { **********           Version 1.0  8/6/84            ********** }
  4.  
  5. { (c) Copyright 1984  Timothy E. Ide  All commercial rights reserved }
  6.  
  7. {$C-}
  8. {$V-}
  9.  
  10. {$I WINDOW.PAS}  { Window Management Services }
  11.  
  12. const
  13.   MenuId = 201;
  14.   MenuX = 10;
  15.   MenuY = 1;
  16.   MenuW = 62;
  17.   MenuH = 12;
  18.   NoOfFunc = 24;
  19.   SelectId = 202;
  20.   SelectX = 1;
  21.   SelectY = 23;
  22.   SelectW = 78;
  23.   SelectH = 1;
  24.   BorderPrompt = 203;
  25.   BorderPromptW = 20;
  26.   BorderPromptH = 5;
  27.   ClearPrompt = 204;
  28.   ClearPromptW = 20;
  29.   ClearPromptH = 4;
  30.   ClosePrompt = 205;
  31.   ClosePromptW = 20;
  32.   ClosePromptH = 4;
  33.   ClreolPrompt = 206;
  34.   ClreolPromptW = 20;
  35.   ClreolPromptH = 4;
  36.   DellnPrompt = 207;
  37.   DellnPromptW = 20;
  38.   DellnPromptH = 5;
  39.   ErasePrompt = 208;
  40.   ErasePromptW = 20;
  41.   ErasePromptH = 4;
  42.   GetPrompt = 209;
  43.   GetPromptW = 20;
  44.   GetPromptH = 6;
  45.   GetlnPrompt = 210;
  46.   GetlnPromptW = 20;
  47.   GetlnPromptH = 6;
  48.   GetorgPrompt = 211;
  49.   GetorgPromptW = 20;
  50.   GetorgPromptH = 6;
  51.   GetposPrompt = 212;
  52.   GetposPromptW = 20;
  53.   GetposPromptH = 6;
  54.   HomePrompt = 213;
  55.   HomePromptW = 20;
  56.   HomePromptH = 4;
  57.   InslnPrompt = 214;
  58.   InslnPromptW = 20;
  59.   InslnPromptH = 5;
  60.   OpenPrompt = 215;
  61.   OpenPromptW = 20;
  62.   OpenPromptH = 9;
  63.   PutPrompt = 216;
  64.   PutPromptW = 20;
  65.   PutPromptH = 5;
  66.   PutlnPrompt = 217;
  67.   PutlnPromptW = 20;
  68.   PutlnPromptH = 5;
  69.   ReadPrompt = 218;
  70.   ReadPromptW = 20;
  71.   ReadPromptH = 6;
  72.   ReadlnPrompt = 219;
  73.   ReadlnPromptW = 20;
  74.   ReadlnPromptH = 6;
  75.   SetorgPrompt = 220;
  76.   SetorgPromptW = 21;
  77.   SetorgPromptH = 6;
  78.   SetposPrompt = 220;
  79.   SetposPromptW = 21;
  80.   SetposPromptH = 6;
  81.   ShowPrompt = 222;
  82.   ShowPromptW = 20;
  83.   ShowPromptH = 4;
  84.   WritePrompt = 223;
  85.   WritePromptW = 20;
  86.   WritePromptH = 5;
  87.   WritelnPrompt = 224;
  88.   WritelnPromptW = 20;
  89.   WritelnPromptH = 5;
  90.   BorderParam = 225;
  91.   BorderParamW = 8;
  92.   BorderParamH = 4;
  93.   ClearParam = 226;
  94.   ClearParamW = 6;
  95.   ClearParamH = 3;
  96.   CloseParam = 227;
  97.   CloseParamW = 6;
  98.   CloseParamH = 3;
  99.   ClreolParam = 228;
  100.   ClreolParamW = 6;
  101.   ClreolParamH = 3;
  102.   DellnParam = 229;
  103.   DellnParamW = 8;
  104.   DellnParamH = 4;
  105.   EraseParam = 230;
  106.   EraseParamW = 6;
  107.   EraseParamH = 3;
  108.   GetParam = 231;
  109.   GetParamW = 42;
  110.   GetParamH = 5;
  111.   GetlnParam = 232;
  112.   GetlnParamW = 42;
  113.   GetlnParamH = 5;
  114.   GetorgParam = 233;
  115.   GetorgParamW = 6;
  116.   GetorgParamH = 5;
  117.   GetposParam = 234;
  118.   GetposParamW = 6;
  119.   GetposParamH = 5;
  120.   HomeParam = 235;
  121.   HomeParamW = 6;
  122.   HomeParamH = 3;
  123.   InslnParam = 236;
  124.   InslnParamW = 6;
  125.   InslnParamH = 4;
  126.   OpenParam = 237;
  127.   OpenParamW = 6;
  128.   OpenParamH = 8;
  129.   PutParam = 238;
  130.   PutParamW = 42;
  131.   PutParamH = 5;
  132.   PutlnParam = 239;
  133.   PutlnParamW = 42;
  134.   PutlnParamH = 5;
  135.   ReadParam = 240;
  136.   ReadParamW = 42;
  137.   ReadParamH = 5;
  138.   ReadlnParam = 241;
  139.   ReadlnParamW = 42;
  140.   ReadlnParamH = 5;
  141.   SetorgParam = 242;
  142.   SetorgParamW = 6;
  143.   SetorgParamH = 5;
  144.   SetposParam = 243;
  145.   SetposParamW = 6;
  146.   SetposParamH = 5;
  147.   ShowParam = 244;
  148.   ShowParamW = 6;
  149.   ShowParamH = 3;
  150.   WriteParam = 245;
  151.   WriteParamW = 42;
  152.   WriteParamH = 4;
  153.   WritelnParam = 246;
  154.   WritelnParamW = 42;
  155.   WritelnParamH = 4;
  156.   StatusId = 247;
  157.   StatusX = 1;
  158.   StatusY = 22;
  159.   StatusW = 79;
  160.   StatusH = 1;
  161.   FuncBorder = 1;
  162.   FuncClear = 2;
  163.   FuncClose =3;
  164.   FuncClreol = 4;
  165.   FuncDelln = 5;
  166.   FuncErase = 6;
  167.   FuncGet = 7;
  168.   FuncGetln = 8;
  169.   FuncGetorg = 9;
  170.   FuncGetpos = 10;
  171.   FuncHome = 11;
  172.   FuncInsln = 12;
  173.   FuncOpen = 13;
  174.   FuncPut = 14;
  175.   FuncPutln = 15;
  176.   FuncRead = 16;
  177.   FuncReadln = 17;
  178.   FuncSetorg = 18;
  179.   FuncSetpos = 19;
  180.   FuncShow = 20;
  181.   FuncWrite = 21;
  182.   FuncWriteln = 22;
  183.   FuncClrscr = 23;
  184.   FuncExit = 24;
  185.   NumLen = 2;
  186.   BordLen = 4;
  187.  
  188. Type
  189.   NumberString = string[2];
  190.   BooleanString = string[5];
  191.  
  192. Var
  193.   MenuFunc : array [1..NoOfFunc] of string[16];
  194.   Row,
  195.   Column : integer;
  196.   StatusWindowPos,
  197.   StatusStatusPos,
  198.   StatusEolnPos,
  199.   StatusEowPos : integer;
  200.   SelectServicePos : integer;
  201.   FuncNo : integer;
  202.   BorderPos,
  203.   ClearPos,
  204.   ClosePos,
  205.   ClreolPos,
  206.   DellnPos,
  207.   ErasePos,
  208.   GetPos,
  209.   GetlnPos,
  210.   GetorgPos,
  211.   GetposPos,
  212.   HomePos,
  213.   InslnPos,
  214.   OpenPos,
  215.   PutPos,
  216.   PutlnPos,
  217.   ReadPos,
  218.   ReadlnPos,
  219.   SetorgPos,
  220.   SetposPos,
  221.   ShowPos,
  222.   WritePos,
  223.   WritelnPos : integer;
  224.   DemoId,
  225.   DemoX,
  226.   DemoY,
  227.   DemoW,
  228.   DemoH : integer;
  229.   NumStr : NumberString;
  230.   BordStr : string[4];
  231.   OutStr,
  232.   InpStr : string[80];
  233.   InpLen : integer;
  234.  
  235.  
  236. function NumVal(NumString : NumberString) : integer;
  237. var
  238.   Number,
  239.   NumFlag : integer;
  240. begin
  241.   Number := 0;
  242.   val(NumString,Number,NumFlag);
  243.   if (NumFlag = 2) then begin
  244.     val(NumString[1],Number,NumFlag);
  245.     if (NumFlag = 1) then begin
  246.       val(NumString[2],Number,NumFlag);
  247.       if (NumFlag = 1) then begin
  248.         Number := 0;
  249.       end;
  250.     end;
  251.   end;
  252.   NumVal := Number;
  253. end;
  254.  
  255. function StrVal(Number : integer) : NumberString;
  256. var
  257.   NStr : NumberString;
  258. begin
  259.   Str(Number,NStr);
  260.   StrVal := NStr;
  261. end;
  262.  
  263. function StrBool(flag : boolean) : BooleanString;
  264. begin
  265.   if (flag) then
  266.     StrBool := 'true '
  267.   else
  268.     StrBool := 'false';
  269. end;
  270.  
  271. procedure InitMenu;
  272. Var
  273.   i, j ,k : integer;
  274.   funcst : string[2];
  275. begin
  276.   MenuFunc[1] := 'wi_border';
  277.   MenuFunc[2] := 'wi_clear';
  278.   MenuFunc[3] := 'wi_close';
  279.   MenuFunc[4] := 'wi_clreol';
  280.   MenuFunc[5] := 'wi_delln';
  281.   MenuFunc[6] := 'wi_erase';
  282.   MenuFunc[7] := 'wi_get';
  283.   MenuFunc[8] := 'wi_getln';
  284.   MenuFunc[9] := 'wi_getorg';
  285.   MenuFunc[10] := 'wi_getpos';
  286.   MenuFunc[11] := 'wi_home';
  287.   MenuFunc[12] := 'wi_insln';
  288.   MenuFunc[13] := 'wi_open';
  289.   MenuFunc[14] := 'wi_put';
  290.   MenuFunc[15] := 'wi_putln';
  291.   MenuFunc[16] := 'wi_read';
  292.   MenuFunc[17] := 'wi_readln';
  293.   MenuFunc[18] := 'wi_setorg';
  294.   MenuFunc[19] := 'wi_setpos';
  295.   MenuFunc[20] := 'wi_show';
  296.   MenuFunc[21] := 'wi_write';
  297.   MenuFunc[22] := 'wi_writeln';
  298.   MenuFunc[23] := 'clrscr';
  299.   MenuFunc[24] := 'exit';
  300.  
  301.   wi_open(MenuId,MenuX,MenuY,MenuW,MenuH,'|-');
  302.   wi_putln(MenuId,'  Demonstration Functions:');
  303.   wi_putln(MenuId,'');
  304.   for j := 1 to 8 do begin
  305.     for i := 1 to 3 do begin
  306.       k := ((i-1)*8+j);
  307.       if (k <= NoOfFunc) then begin
  308.         wi_setpos(MenuId,((i-1)*20)+3,j+2);
  309.         str(k,funcst);
  310.         wi_put(MenuId,(funcst+' - '+MenuFunc[k]));
  311.       end;
  312.     end;
  313.   end;
  314. end;
  315.  
  316. procedure InitStatus;
  317. begin
  318.   wi_open(StatusId,StatusX,StatusY,StatusW,StatusY,'');
  319.   wi_put(StatusId,'    ');
  320.   wi_put(StatusId,'window = ');
  321.   wi_getpos(StatusId,StatusWindowPos,Row);
  322.   wi_put(StatusId,'     ');
  323.   wi_put(StatusId,'wi_status = ');
  324.   wi_getpos(StatusId,StatusStatusPos,Row);
  325.   wi_put(StatusId,'        ');
  326.   wi_put(StatusId,'wi_eoln = ');
  327.   wi_getpos(StatusId,StatusEolnPos,Row);
  328.   wi_put(StatusId,'        ');
  329.   wi_put(StatusId,'wi_eow = ');
  330.   wi_getpos(StatusId,StatusEowPos,Row);
  331.   wi_put(StatusId,'        ');
  332. end;
  333.  
  334. procedure InitSelect;
  335. begin
  336.   wi_open(SelectId,SelectX,SelectY,SelectW,SelectH,'');
  337.   wi_put(SelectId,'Enter function number: ');
  338.   wi_getpos(SelectId,SelectServicePos,Row);
  339. end;
  340.  
  341. procedure DemoStatus;
  342. var
  343.   SaveStatus,
  344.   SaveEoln,
  345.   SaveEow : boolean;
  346. begin
  347.   SaveStatus := wi_status;
  348.   SaveEoln := wi_eoln;
  349.   SaveEow := wi_eow;
  350.   wi_setpos(StatusId,StatusWindowPos,1);
  351.   wi_put(StatusId,StrVal(DemoId));
  352.   wi_setpos(StatusId,StatusStatusPos,1);
  353.   wi_put(StatusId,StrBool(SaveStatus));
  354.   wi_setpos(StatusId,StatusEolnPos,1);
  355.   wi_put(StatusId,StrBool(SaveEoln));
  356.   wi_setpos(StatusId,StatusEowPos,1);
  357.   wi_put(StatusId,StrBool(SaveEow));
  358.   wi_show(StatusId);
  359. end;
  360.  
  361. procedure WaitForAny;
  362. var
  363.   AnyChar : char;
  364. begin
  365.   gotoxy(1,24);
  366.   clreol;
  367.   write('Press any key to continue ');
  368.   read(kbd,AnyChar);
  369.   gotoxy(1,24);
  370.   clreol;
  371. end;
  372.  
  373. { (c) Copyright 1984  Timothy E. Ide  All commercial rights reserved }
  374.  
  375. procedure Copyright;
  376. begin
  377.   clrscr;
  378.   gotoxy(1,1);
  379.   writeln('Window Management Services Version 1.0');
  380.   writeln('(c) Copyright 1984 Timothy E. Ide  All commercial rights reserved');
  381.   delay(500);
  382. end;
  383.  
  384.  
  385. {$I DEMO1.PAS}   { service window initialization }
  386. {$I DEMO2.PAS}   { service demonstration routines }
  387.  
  388.  
  389. begin
  390.   Copyright;
  391.   InitMenu;
  392.   InitStatus;
  393.   InitSelect;
  394.   InitBorder;
  395.   InitClear;
  396.   InitClose;
  397.   InitClreol;
  398.   InitDelln;
  399.   InitErase;
  400.   InitGet;
  401.   InitGetln;
  402.   InitGetorg;
  403.   InitGetpos;
  404.   InitHome;
  405.   InitInsln;
  406.   InitOpen;
  407.   InitPut;
  408.   InitPutln;
  409.   InitRead;
  410.   InitReadln;
  411.   InitSetorg;
  412.   InitSetpos;
  413.   InitShow;
  414.   InitWrite;
  415.   Initwriteln;
  416.   clrscr;
  417.   repeat
  418.     wi_show(MenuId);
  419.     wi_erase(StatusId);
  420.     wi_setpos(SelectId,SelectServicePos,1);
  421.     wi_clreol(SelectId);
  422.     wi_show(SelectId);
  423.     NumStr := '';
  424.     wi_read(SelectId,NumLen,NumStr);
  425.     FuncNo := NumVal(NumStr);
  426.     case FuncNo of
  427.       FuncBorder :  DemoBorder;
  428.       FuncClear :   DemoClear;
  429.       FuncClose :   DemoClose;
  430.       FuncClreol :  DemoClreol;
  431.       FuncDelln :   DemoDelln;
  432.       FuncErase :   DemoErase;
  433.       FuncGet :     DemoGet;
  434.       FuncGetln :   DemoGetln;
  435.       FuncGetorg :  DemoGetorg;
  436.       FuncGetpos :  DemoGetpos;
  437.       FuncHome :    DemoHome;
  438.       FuncInsln :   DemoInsln;
  439.       FuncOpen :    DemoOpen;
  440.       FuncPut :     DemoPut;
  441.       FuncPutln :   DemoPutln;
  442.       FuncRead :    DemoRead;
  443.       FuncReadln :  DemoReadln;
  444.       FuncSetorg :  DemoSetorg;
  445.       FuncSetpos :  DemoSetpos;
  446.       FuncShow :    DemoShow;
  447.       FuncWrite :   DemoWrite;
  448.       FuncWriteln : DemoWriteln;
  449.       FuncClrscr :  clrscr;
  450.     end;
  451.   until FuncNo = FuncExit;
  452. end.
  453.