home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_PAS / XLIB_TP5.ZIP / DEMO / X_DEMO.PAS < prev   
Pascal/Delphi Source File  |  1993-12-19  |  14KB  |  400 lines
  1. (* All these Compiler-directives make the EXE smaler , but the error would
  2.    be more invisible . *)
  3. {$D-,Y-,R-,S-,O-}
  4.  
  5. uses crt,X_Const,X_Main,X_Text,X_Button,X_Bitmap,X_Keys,X_Mouse,X_Break,
  6.      X_Menu,X_polygon,X_Pal,X_Rect;
  7.  
  8. const Font0=2;
  9.       Font1=2;
  10.  
  11. var dummy:Boolean;
  12.  
  13. procedure Part_A;
  14. label A_End;  (* Ok, it's not fine - but easy to manage. *)
  15. var   a:Char;
  16.       s:String;
  17.       i:Byte;
  18.       r,x:Integer;
  19.       r1,r2:Word;
  20. begin;
  21.   ClrScr;
  22.   WriteLn('First you have to set the VideoMode :'#13#10);
  23.   WriteLn(' with  x_set_mode(mode,Screen_Width:Word);  from X_Lib'#13#10);
  24.   WriteLn('Modes are used by XLib (all with 256 Colors):');
  25.  
  26.   for i:=0 to x_Max_Modi do
  27.     begin;
  28.       x_Mode_Info(i,r1,r2);
  29.       Write(i:4,'  =  ',r1:3,' x ',r2:3,'                ');
  30.       if odd(i) then WriteLn;
  31.     end;
  32.  
  33.   WriteLn('Dont forget, we have only 256 KB  on VGA-card, you can calculate the');
  34.   WriteLn('numbers of videopages in any mode.');
  35.   WriteLn('With the 2ed argument, a virtuell Screen-Width will be set.');
  36.   WriteLn('But now, I will call x_set_mode(8,360);   (Space).');
  37.  
  38.   repeat a:=ReadKeys; until a in [Space,ESC];if a=ESC then goto A_End;
  39.  
  40.   x_set_mode(8,360);
  41.   x_ClearAll;
  42.   x_Set_RGB_Pal;
  43.   x_set_font(Font1);
  44.   E_Write(10,10,Gray5,Gray3,'Well, we are in Graphic Mode.');
  45.   E_Write(10,2*x_font_height,Gray5,Gray3,'I will show you the importenst variables of X_Const :');
  46.   E_Write(10,4*x_font_height,Gray5,Gray3,'InGraphics  :');
  47.   if InGraphics then s:='True' else s:='false';
  48.   E_Write(150,4*x_font_height,Gray5,Gray3,s);
  49.   E_Write(180,4*x_font_height,Gray5,Gray3,'CurrXMode  :');
  50.   E_WriteInt(330,4*x_font_height,Gray5,Gray3,CurrXMode);
  51.  
  52.   E_Write(10,5*x_font_height,Gray5,Gray3,'GetMaxX  :');
  53.   E_WriteInt(150,5*x_font_height,Gray5,Gray3,GetMaxX);
  54.   E_Write(180,5*x_font_height,Gray5,Gray3,'GetMaxY  :');
  55.   E_WriteInt(330,5*x_font_height,Gray5,Gray3,GetMaxY);
  56.  
  57.   E_Write(10,6*x_font_height,Gray5,Gray3,'MaxScrollX  :');
  58.   E_WriteInt(150,6*x_font_height,Gray5,Gray3,MaxScrollX);
  59.   E_Write(180,6*x_font_height,Gray5,Gray3,'MaxScrollY  :');
  60.   E_WriteInt(330,6*x_font_height,Gray5,Gray3,MaxScrollY);
  61.  
  62.   E_Write(10,7*x_font_height,Gray5,Gray3,'ScreenOfs is now 0, but this is the variable to the start-');
  63.   E_Write(10,8*x_font_height,Gray5,Gray3,'adress of the activ videopage. Every procedure, which work');
  64.   E_Write(10,9*x_font_height,Gray5,Gray3,'directly with the Videomemory begins on this address.');
  65.  
  66.   E_Write(10,10*x_font_height,Gray5,Gray3,'You wont to see the Power of Mode X now, Ok.');
  67.   repeat a:=ReadKeys; until a in ['Y','J',Space,ESC];if a=ESC then goto A_End;
  68.  
  69.  
  70.   E_Write(10,300,Gray5,Gray3,'ScreenOfs :');
  71.   E_Write(10,320,Gray5,Gray3,'x_set_visible_start_addr(0,');
  72.   i:=0;r:=1;x:=x_Length('x_set_visible_start_addr(0,')+10;
  73.   repeat
  74.     Inc(i,r);
  75.     if i+2>MaxScrollY then r:=-1;
  76.     if i=0 then r:=1;
  77.     {str(i,s);}s:=str(i)+');';
  78.     WaitVsyncStart;
  79.     x_set_visible_start_addr(0,i);
  80.     Box(x,300,x+100,340,0);
  81.     E_WriteInt(x,300,Gray5,Gray3,ScreenOfs);
  82.     E_Write(x,320,Gray5,Gray3,s);
  83.   until KeysPressed;
  84.   repeat a:=ReadKeys; until a in [Space,ESC];if a=ESC then goto A_End;
  85.  
  86.   Box(0,299,400,340,0);
  87.   x_set_visible_start_addr(0,0);
  88.   E_Write(10,12*x_font_height,Gray5,Gray3,'Now the same scrolling.');
  89.   repeat a:=ReadKeys; until a in ['Y','J',Space,ESC];if a=ESC then goto A_End;
  90.  
  91.   i:=0;r:=1;x:=x_Length('x_set_visible_start_addr(0,')+10;
  92.   if 10+x_Length('x_set_activ_start_addr(0,')>x then x:=x_Length('x_set_activ_start_addr(0,')+10;
  93.   i:=0;r:=2;
  94.   repeat
  95.     Inc(i,r);
  96.     if i+2>MaxScrollY then r:=-2;
  97.     if i<2 then r:=2;
  98.     {str(i,s);}s:=str(i)+');';
  99.     WaitVsyncStart;
  100.     x_set_visible_start_addr(0,i);
  101.     x_set_activ_start_addr(0,i);
  102.     Box(0,299,400,360,0);
  103.     E_Write(10,300,Gray5,Gray3,'ScreenOfs :');
  104.     E_WriteInt(100,300,Gray5,Gray3,ScreenOfs);
  105.     E_Write(10,320,Gray5,Gray3,'x_set_visible_start_addr(0,'+S);
  106.     E_Write(10,340,Gray5,Gray3,'x_set_activ_start_addr(0,'+s);
  107.   until KeysPressed;
  108.   repeat a:=ReadKeys; until a in [Space,ESC];if a=ESC then goto A_End;
  109.  
  110.   Box(0,250,getMaxX,GetMaxY,0);
  111.   x_set_visible_start_addr(0,0);
  112.   x_set_activ_start_addr(0,0);
  113.   E_Write(10,13*x_font_height,Gray5,Gray3,'Yeahh - flickering is terrible ? The Font is to Big.');
  114.   E_Write(10,14*x_font_height,Gray5,Gray3,'What the next function on X_Lib ?');
  115.  
  116.   E_Write(10,16*x_font_height,Gray5,Gray3,'PutPixel(x,y:Word;Color:Byte);    :');
  117.   for i:=1 to 255 do PutPixel(355-random(120),16*x_font_height+random(10),random(255));
  118.  
  119.   E_Write(10,17*x_font_height,Gray5,Gray3,'Line(x1,y1,x2,y2:Word); : ');
  120.   for i:=1 to 25 do Line(getMaxX-i*7,17*x_font_height,GetMaxX-60-I*7,19*x_font_height-1,252-i);
  121.  
  122.   E_Write(10,19*x_font_height,Gray5,Gray3,'rectangle(x1,y1,x2,y2,Color:Word);    (No fill)');
  123.   E_Write(10,20*x_font_height,Gray5,Gray3,'triangle(x1,y1,x2,y2,x3,y3,Color:Word);  (No fill)');
  124.   E_Write(10,21*x_font_height,Gray5,Gray3,'box(x1,y1,x2,y2,Color:Word);');
  125.   E_Write(10,22*x_font_height,Gray5,Gray3,'Shadow_Box(x1,y1,x2,y2,C1,C2,C3:Word); :');
  126.   Shadow_Box(260,22*x_font_height,340,23*x_font_height-1,Gray5,Gray4,Gray3);
  127.   E_Write(10,23*x_font_height,Gray5,Gray3,'x_circle(x1,y1,r,Color:Word);');
  128.   E_Write(10,24*x_font_height,Gray5,Gray3,'x_filled_circle(x1,y1,r,Color:Word);');
  129.  
  130.   repeat a:=ReadKeys; until a in [Space,ESC];if a=ESC then goto A_End;
  131.   x_Text_Mode;
  132.  
  133. A_End:x_Text_Mode;
  134. end;
  135.  
  136. procedure Part_B;
  137. label B_End;
  138. VAR A:Char;
  139.     Z:Byte;
  140.     i,x1,x2,x3:Word;
  141.     s:String;
  142. begin;
  143.   x_set_mode(9,400);
  144.   x_ClearAll;
  145.   x_Set_RGB_Pal;
  146.   x_set_font(Font0);
  147.   z:=x_font_height;
  148.   E_Write(20,1*z,Gray5,Gray3,'Now, I will init your Mouse for Mode X:');
  149.   E_Write(10,3*z,Gray5,Gray3,'MyMouseInit;                                Define event-handler for ModeX');
  150.   E_Write(10,4*z,Gray5,Gray3,'DefineMouseCursor(MyMouseForm,Gray5);     Define shape and Color');
  151.   E_Write(10,5*z,Gray5,Gray3,'SetMouseWindow(0,0,GetMaxX+4,getMaxY+4);   Ok. :-)');
  152.   E_Write(20,6*z,Gray5,Gray3,'And now ...');
  153.   repeat a:=ReadKeys; until a in [Space,ESC];if a=ESC then goto B_End;
  154.  
  155.   E_Write(10,7*z,Gray5,Gray3,'ShowMouse;   ');
  156.   E_Write(20,8*z,Gray5,Gray3,'Every Time, you draw to Screen, you hide the mousecursor !');
  157.   E_Write(20,9*z,Gray5,Gray3,'In the global variables Mouse_X,Mouse_Y and ButtonStatus');
  158.   E_Write(20,10*z,Gray5,Gray3,'from the X_Mouse-unit you can every time read the actuell');
  159.   E_Write(20,11*z,Gray5,Gray3,'Position.');
  160.  
  161.   MyMouseInit;
  162.   DefineMouseCursor(MyMouseForm,Gray5);
  163.   SetMouseWindow(0,0,GetMaxX+4,getMaxY+4);
  164.   OldMouseTyp:=true;a:=#0;
  165.  
  166.   ShowMouse;
  167.  
  168.   if IsMouseHidden then
  169.   begin;
  170.     E_Write(10,12*z,Gray5,Gray3,'if isMouseHidden then ...  If return IsMouseHidden after');
  171.     E_Write(20,13*z,Gray5,Gray3,'ShowMouse, no Mouse-device are installed. But the X_Mouse-');
  172.     E_Write(20,14*z,Gray5,Gray3,'unit do nothing (no hangup), if no mouse present.');
  173.   end else
  174.   begin;
  175.     x1:=x_Length('MouseX: ')+10;x2:=x_Length('MouseX:          MouseY: ')+10;
  176.     x3:=x_Length('MouseX:          MouseY:         ButtonStatus: ')+10;
  177.     E_Write(10,13*z,Gray5,Gray3,'MouseX:          MouseY:         ButtonStatus:');
  178.     a:=#0;
  179.     MouseAction:=False;
  180.     repeat
  181.       if MouseAction then
  182.       begin;
  183.         HideMouse;
  184.         Box(x1,13*z,x1+20,14*z,0);E_WriteInt(x1,13*z,Gray5,Gray3,MouseX);
  185.         Box(x2,13*z,x2+20,14*z,0);E_WriteInt(x2,13*z,Gray5,Gray3,MouseY);
  186.         Box(x3,13*z,x3+20,14*z,0);E_WriteInt(x3,13*z,Gray5,Gray3,ButtonStatus);
  187.         ShowMouse;
  188.         MouseAction:=False;
  189.       end;
  190.       if keyspressed then a:=ReadKeys;
  191.     until a in [Space,ESC];if a=ESC then goto B_End;
  192.     HideMouse;
  193.   end;
  194.  
  195.   E_Write(10,15*z,Gray5,Gray3,'function InBox(x1,y1,x2,y2):Boolean  return true, if Mouse in rectangle.');
  196.   E_Write(20,16*z,Gray5,Gray3,'With this function, we could program a Mouse-Button, but these is');
  197.   E_Write(20,17*z,Gray5,Gray3,'the X_Button unit.');
  198.   rectangle(100,Z*18,260,z*20,Gray4);
  199.   MouseAction:=false;a:=#0;
  200.   repeat
  201.  
  202.     if MouseAction then
  203.     begin;
  204.       if InBox(100,Z*18,260,z*20) then s:='InBox(..)=True'
  205.                                   else s:='InBox(..)=False';
  206.       HideMouse;
  207.       Box(1,z*19,99,z*20,0);
  208.       E_Write(1,z*19,Gray5,Gray3,s);
  209.       ShowMouse;
  210.       MouseAction:=False;
  211.     end;
  212.  
  213.     if keyspressed then a:=ReadKeys;
  214.   until a in [Space,ESC];if a=ESC then goto B_End;
  215.   HideMouse;
  216.   x_ClearAll;
  217.   x_Set_font(Font0);
  218.   E_Write(20,Z*2,Gray5,Gray3,'Now the mean idea of X_Button. It`s a dynamic Buttonmanager.');
  219.   E_Write(10,Z*3,Gray5,Gray3,'Add_Button(ID ,');E_Write(150,Z*3,Gray5,Gray3,'(* any number to identivication *)');
  220.   E_Write(10,Z*4,Gray5,Gray3,'           x,y : Word;');E_Write(150,Z*4,Gray5,Gray3,'(* Position *)');
  221.   E_Write(10,Z*5,Gray5,Gray3,'C1,C2,C3,high,low : Byte;');E_Write(150,Z*5,Gray5,Gray3,'(* Box 1-3,Char,CharShadow - Color *)');
  222.   E_Write(10,Z*6,Gray5,Gray3,'           Mask       : Byte;');E_Write(150,Z*6,Gray5,Gray3,'(* MouseButton - Mask  see doc *)');
  223.   E_Write(10,Z*7,Gray5,Gray3,'           S          : String);');E_Write(150,Z*7,Gray5,Gray3,'(* name on the Button *)');
  224.   E_Write(10,Z*8,Gray5,Gray3,'Add_Button_Gray(ID,x,y,mask,s);            (* In X_Const exist variables *)');
  225.   E_Write(10,Z*9,Gray5,Gray3,'                                                             (* named Gray0...Gray5        *)');
  226.   E_Write(20,Z*10,Gray5,Gray3,'For example: ');
  227.   E_Write(10,Z*11,Gray5,Gray3,'Add_Button_Gray(1,300,300,all,'#39'Hello'#39');');
  228.   dummy:=Add_Button_Gray(1,300,300,all,'Hello');
  229.   ShowMouse;
  230.   repeat a:=ReadKeys; until a in [Space,ESC];if a=ESC then goto B_End;
  231.   HideMouse;
  232.   E_Write(20,Z*12,Gray5,Gray3,'Uhhh - nothing happens on the button ?  Jeahh.');
  233.   E_Write(20,Z*13,Gray5,Gray3,'You have to <watch> the button with the function');
  234.   E_Write(10,Z*14,Gray5,Gray3,'Get_Pressed_Button :ID_Typ;  Returns the selected Button');
  235.   E_Write(20,Z*15,Gray5,Gray3,'or zero, if nothing chossed.');
  236.   E_Write(20,Z*16,Gray5,Gray3,'For example :');
  237.   E_Write(10,Z*17,Gray5,Gray3,'repeat; i:=Get_pressed_Button; until keyspressed;  (* Click now *)');
  238.   ShowMouse;
  239.   repeat; i:=Get_pressed_Button; until keyspressed;
  240.   Clear_Buffer;
  241.   HideMouse;
  242.   E_Write(10,Z*19,Gray5,Gray3,'Add_ButtonInt_Gray in a loop :');
  243.   x1:=10+x_Length('Add_ButtonInt_Gray in a loop :');
  244.   for i:=2 to 40 do dummy:=Add_ButtonInt_Gray(i,((i-2) mod 10)*36+10,((i-2) div 10)*z*2+Z*20+5,all,i*100);
  245.   E_Write(10,Z*25,Gray5,Gray3,'Kill_Button(ID)');               (* this is the end of a button *)
  246.   ShowMouse;
  247.   repeat;
  248.     i:=Get_pressed_Button;
  249.     if i<>0 then
  250.     begin;
  251.       HideMouse;
  252.       Box(x1,z*19,x1+100,z*20,0);
  253.       E_WriteInt(x1,z*19,Gray5,Gray3,i*100);
  254.       ShowMouse;
  255.     end;
  256.   until keyspressed;
  257.   Clear_Buffer;
  258.   HideMouse;
  259.   for i:=1 to 40 do dummy:=Kill_Button(i);
  260.  
  261. B_End:
  262.   MyMouseDestroy;
  263.   x_Text_Mode;
  264. end;
  265.  
  266. procedure Part_C;
  267. var M:X_Menu.Menu_Typ;
  268.     I:X_Menu.ID_Typ;
  269.     a:Char;
  270.     merk1,merk2:LongInt;
  271. label C_End;
  272. begin;
  273.   X_set_mode(8,400);
  274.   x_text_init;
  275.   x_ClearAll;
  276.   x_Set_RGB_Pal;
  277.   x_set_font(Font0);
  278.   MyMouseInit;
  279.   DefineMouseCursor(MyMouseForm,Gray5);
  280.   SetMouseWindow(0,0,GetMaxX+4,getMaxY+4);
  281.   OldMouseTyp:=true;
  282.  
  283.   (* Init the variable of the menu . *)
  284.   X_Init_Menu(M,Gray5,Gray4,Gray3,Gray2,Gray0,Gray2,3);
  285.  
  286.   (* Add the Menulines               *)
  287.   X_Add_Menu(M,1,'Hallo','H');
  288.   X_Add_Menu(M,2,'hIhghi','i');
  289.   X_Add_Menu(M,3,'hhhOhoho','o');
  290.   X_Add_Menu(M,4,'Jeah','j');
  291.   X_Add_Menu(M,5,'Juh«'+str(Gray5)+'»u','u');
  292.   X_Add_Menu(M,6,'J«'+str(Gray5)+'»e«o»llaug','e');
  293.   X_Add_Menu(M,7,'Ende (X)','x');
  294.  
  295.   X_Show_Menu(M,10,10);
  296.  
  297.   ShowMouse;
  298.   a:=#0;
  299.   repeat
  300.     i:=Wait_Selected_MenuLine(M); (* wait, until selected or abort *)
  301.  
  302.     if i<>0 then  (* What line are selectet ? *)
  303.     begin;
  304.       HideMouse;
  305.       Box(200,10,GetMaxX,30,0);
  306.       E_Write(150,10,Gray5,Gray3,'selected line :'+str(i));
  307.       ShowMouse;
  308.       delay(10);
  309.       if i=7 then a:=ESC;
  310.     end
  311.     else a:=ESC;
  312.   until a =ESC;
  313.  
  314. C_End:
  315.  
  316.   X_Kill_Menu(M);
  317.   HideMouse;
  318.   MyMouseDestroy;
  319.   x_Text_Mode;
  320.  
  321. end;
  322.  
  323. procedure Part_D;
  324. const Max_Points = 10;
  325. var i,j:Word;
  326.     P:Array[0..Max_Points] of Point;
  327.     a:Char;
  328.     Line_Color:Array[0..1100] of Byte;
  329. label D_End;
  330. begin;
  331.   x_set_mode(8,368);
  332.   x_set_rgb_pal;
  333.   for i:=0 to 1100 do Line_Color[i]:=(i div 8) and $FF;
  334.  
  335.   repeat;
  336.     x_triangleCol(random(GetMaxX-10)+5,random(GetMaxY-10)+5,
  337.                random(GetMaxX-10)+5,random(GetMaxY-10)+5,
  338.                random(GetMaxX-10)+5,random(GetMaxY-10)+5,
  339.                Line_Color[random(40)*16]);
  340.   until keyspressed;a:=ReadKeys;
  341.   x_ClearAll;
  342.   E_Write(10,GetMaxY-x_font_height,Gray5,Gray3,'Correct only with convex polygons.');
  343.  
  344.   repeat
  345.     j:=random(Max_Points-5)+4;
  346.     for i:=0 to j do
  347.     begin;
  348.       P[i].x:=random(GetMaxX-10)+5;
  349.       P[i].y:=random(GetMaxY-50)+5;
  350.     end;
  351.     X_poly(P,j,random(250));
  352.   until keyspressed;a:=ReadKeys;
  353.  
  354. D_End:
  355.   x_Text_Mode;
  356. end;
  357.  
  358. {$F+}
  359. procedure MyBreakProcedure;
  360. begin;
  361.   MyMouseDestroy;
  362.   x_Text_Mode;
  363.   WriteLn('He, what`s going on ? Do you like DOS more than Mode X ?');
  364.   Halt;
  365. end;
  366. {$F-}
  367.  
  368. {$I timpani.inc}   (* created by FEX *)
  369.  
  370. var a:Char;
  371.     P:Pointer;
  372. begin;
  373.  
  374.   InitBreak(MyBreakProcedure);
  375.   x_text_init;
  376.   x_register_userfont(Font_timpani);
  377.   x_set_font(2);
  378.  
  379.   repeat
  380.     ClrScr;
  381.     WriteLn('Mode X - Demo  :  How do you program with XLib in Turbo Pascal.');
  382.     WriteLn;
  383.     WriteLn('   A      : X_Const and X_Lib.');
  384.     WriteLn('   B      : X_Mouse and X_Button');
  385.     WriteLn('   C      : X_Menu     ');
  386.     WriteLn('   D      : X_Triangle and X_Triangle');
  387.  
  388.     WriteLn(#10#13'   End    : Anytime with Ctrl+Break or now with ESC');
  389.     WriteLn('Type Char to select');
  390.  
  391.     a:=Upcase(ReadKeys);
  392.     case a of
  393.       'A':Part_A;  'B':Part_B;  'C':Part_C;  'D':Part_D;
  394.     end;
  395.   until a=ESC;
  396.  
  397.   RestoreBreak;
  398.  
  399. end.
  400.