home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progpas / tegl6b.arj / INTROPAK.EXE / lha / TWDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-14  |  17KB  |  497 lines
  1. {$I switches.inc}
  2. {-------------------------------------------------------------------}
  3. { TWDEMO.PAS                                                        }
  4. { Copyright 1991 TEGL SYSTEMS CORPORATION, All rights reserved.     }
  5. {-------------------------------------------------------------------}
  6.  
  7.  
  8. {$F+} {-- far  call is necessary for EVENTS }
  9.  
  10. Uses
  11.   teglfont,  {-- the graphics group }
  12.   fastgrph,
  13.   tgraph,
  14.  
  15.   virtmem,   {-- memory }
  16.  
  17.   teglintr,
  18.   teglunit,  {-- window manager, menus and micellaneous }
  19.   teglmenu,
  20.   teglmain,
  21.   teglspec,
  22.  
  23.   twcommon,  {-- high-level windows }
  24.   twkernel,
  25.   twwindow,
  26.   twworld,
  27.   twdialog,
  28.   twcontrl;
  29.  
  30.  
  31. {-- Global variables }
  32.  
  33. VAR
  34.   TechnaFont : Integer;
  35.   TallFont   : Integer;
  36.   mainmenu: ImageStkPtr;   {-- the main bar menu is only an ordinary frame}
  37.                {-- with option menu click areas placed on it. }
  38.   menufont: pointer;       {-- the font to use with all menus. Set once so }
  39.                {-- we can make the program look better on }
  40.                {-- a variety of video displays. }
  41.   fileom   : optionmptr;
  42.   devicesom: optionmptr;
  43.   dialogom : optionmptr;
  44.   worldom  : optionmptr;
  45.  
  46. {-- restores all the frames to being active and close the error }
  47. {-- message window. }
  48.  
  49. function errorclose(ifs: imagestkptr; ms: msclickptr): Word;
  50.   BEGIN
  51.     resetframeactive(stackptr,true);
  52.     twclose(findwinframe(ifs));
  53.   END;
  54.  
  55. {-- Display an error message and disable all other frames until }
  56. {-- the OK button is pressed. }
  57.  
  58. procedure SayError(s: String);
  59.   VAR wf : WinFramePtr;
  60.   BEGIN
  61.     { resetframeactive sets the activity of all the frames from }
  62.     { the one passed (here the topmost) to the bottom of the stack.}
  63.     { In this case all frames become inactive then we create one }
  64.     { active frame (the error message) that must be delt with, before}
  65.     { processing can continue. }
  66.     resetframeactive(stackptr,false);  {-- disable everything }
  67.     twdInit(wf,0,(getmaxy DIV 2) - 35,getmaxx,(getmaxy DIV 2) + 35);
  68.       twsetHeader(wf,'ERROR');  {-- set the header }
  69.       twSetMaximize(wf,false);  {-- disable MIN/MAX buttons }
  70.       {-- add a button that will acknowlege the error }
  71.       twdAddButton(wf,getmaxx DIV 2 - 20, 25, 'OK',errorclose);
  72.       twsetcloseevent(wf,errorclose);  {-- space bar menu CLOSE }
  73.     twDrawWindowFrame(wf);   {-- finally draw the window }
  74.     {-- display the message. }
  75.     prepareforupdate(wf^.ifs);  {-- going to write to the window }
  76.       settextjustify(centertext,toptext);
  77.       OutTextXY((getmaxx DIV 2) - (wf^.thickness *2),5,s);
  78.     commitupdate;              {-- finished writing to the window }
  79.   END;
  80. {---------------------------------------------------------}
  81. {-- These are some global variable for our dialog window to access }
  82.  
  83.   CONST wf : WinFramePtr = NIL;
  84.     strtd: string[20] = 'This is a string';
  85.         chkbox : boolean = TRUE;
  86.         radio : integer = 2;
  87.  
  88. {-- Note that closing a dialog calls twdClose not twClose, it must}
  89. {-- first dispose of the list of dialog entries before the window }
  90.  
  91. function dialogclose(ifs : ImageStkPtr; ms: MsClickPtr): Word;
  92.   begin
  93.     dialogclose := twdClose(ifs,ms);
  94.     wf := NIL;
  95.   end;
  96.  
  97. {-- Opens up a simple dialog window. }
  98.  
  99. Function OpenDialogDemo(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  100.   VAR tempifs : imagestkptr;
  101.   BEGIN
  102.     if wf <> NIL then     {-- only one allowed. }
  103.       begin
  104.     sayerror('The dialog demo is already running.');
  105.     exit;
  106.       end;
  107.     twdInit(wf,100,100,400,300);
  108.       twSetHeader(wf,'Simple Dialogue');
  109.  
  110.       twdAddLabel(wf,10,10,'Labels go anywhere');
  111.       {-- input lines are string items, the last parameter is the }
  112.       {-- length of the string. }
  113.       twdAddInputLine(wf,10,30,'Edit this ',strtd,20);
  114.       {-- check boxes are boolean values }
  115.       twdAddCheckBox(wf,10,50,'a check box',chkbox);
  116.       {-- radio buttons all access the same integer value. Their }
  117.       {-- order is important. The first one will be one the }
  118.       {-- second two, etc. Groups of radio buttons must be seperated }
  119.       {-- by either some other dialog item or a label, if nothing is }
  120.       {-- required use an empty label. }
  121.       twdAddRadioButton(wf,10,70,'a radio button (1)',radio);
  122.       twdAddRadioButton(wf,10,90,'a radio button (2)',radio);
  123.       twdAddRadioButton(wf,10,110,'a radio button (3)',radio);
  124.       {-- Buttons are associated with events, here the OK button does }
  125.       {-- nothing, but the cancel button closes the dialog. }
  126.       twdAddbutton(wf,50,150,'OK',nilunitproc);
  127.       twdAddButton(wf,180,150,'CANCEL',dialogclose);
  128.       twSetCloseEvent(wf,dialogclose);  {-- the space bar menu }
  129.  
  130.     {-- Note that the window is only drawn AFTER ALL THE DIALOG ITEMS }
  131.     {-- HAVE BEEN SET. }
  132.     twDrawWindowFrame(wf);
  133.   END;
  134.  
  135. {-- The key to using scaled text is by setting the usercharsize }
  136. {-- with the ratio of the working area to the screen size }
  137.  
  138. Function WorldTextRedraw(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  139.   VAR wf: WinFramePtr;
  140.   BEGIN
  141.     wf := FindWinFrame(ifs);
  142.     twSelect(wf);
  143.     twwDefineWorld(wf,0,0,1000,1000);
  144.     PrepareforUpdate(ifs);
  145.     SetTextJustify(lefttext,toptext);
  146.     SetTextStyle(TechnaFont,horizdir,2);
  147.     SetUserCharSize(wf^.wx2-wf^.wx1,getmaxx DIV 2,
  148.                      wf^.wy2-wf^.wy1,getmaxy DIV 2);
  149.     twwOutTextXY(wf,10,10,'Scaled text');
  150.     SetTextStyle(TallFont,Horizdir,5);
  151.     SetUserCharSize(wf^.wx2-wf^.wx1,getmaxx DIV 2,
  152.                      wf^.wy2-wf^.wy1,getmaxy DIV 2);
  153.     twwOutTextXY(wf,10,500,'Using Triplex & Small Font');
  154.     CommitUpDate;
  155.  
  156.   END;
  157.  
  158. Function OpenWorldTextDemo(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  159.   VAR wf : WinFramePtr;
  160.   BEGIN
  161.     twinit(wf,100,100,300,250);
  162.       twSetHeader(wf,'Scaling text');
  163.       twSetRedraw(wf,WorldTextRedraw);
  164.     twDrawWindowFrame(wf);
  165.   END;
  166.  
  167.  
  168. {---------------------------------------------------------}
  169. {-- Bar graph demo illustrates how to use the world coordinates }
  170. {-- to fit data into any sized window. }
  171. {---------------------------------------------------------}
  172.  
  173. CONST MaxBars = 10;
  174. TYPE BarDef = RECORD x1,y1,x2,y2,color: Integer; END;
  175. CONST Bars : Array[1..MaxBars] OF BarDef =
  176.     (
  177.     (x1:-99;y1:80;x2:-81;y2:0;Color:blue),
  178.     (x1:-80;y1:70;x2:-61;y2:0;Color:blue),
  179.     (x1:-60;y1:20;x2:-41;y2:0;Color:blue),
  180.     (x1:-40;y1:0;x2:-21;y2:-40;Color:red),
  181.     (x1:-20;y1:0;x2:-1;y2:-99;Color:red),
  182.     (x1:1;y1:0;x2:20;y2:-67;Color:red),
  183.     (x1:21;y1:8;x2:40;y2:0;Color:green),
  184.     (x1:41;y1:20;x2:60;y2:0;Color:yellow),
  185.     (x1:61;y1:75;x2:80;y2:0;Color:magenta),
  186.     (x1:81;y1:50;x2:99;y2:0;Color:blue));
  187.  
  188.  
  189.  
  190. Function rtos(r: real) : string;
  191.   var s : String;
  192.   BEGIN
  193.     str(r:5:1,s);
  194.     rtos := s;
  195.   END;
  196.  
  197. Function WorldBarRedraw(ifs : ImageStkPtr; ms : MsClickPtr): Word;
  198.   VAR wf: WinFramePtr;
  199.       I : Integer;
  200.   BEGIN
  201.     wf := FindWinFrame(ifs);
  202.     twwDefineWorld(wf,-100,100,100,-100);
  203.     twwLine(wf,-100,0,100,0);
  204.     twSetFont(wf,@f6x6norm);
  205.     for I := 1 to MaxBars DO
  206.       WITH BARS[I] DO
  207.         BEGIN
  208.           SetFillStyle(solidfill,color);
  209.           twwBar(wf,x1,y1,x2,y2);
  210.           SetColor(Black);
  211.           twwRectangle(wf,x1,y1,x2,y2);
  212.           {twwOutTextXy(wf,x1,y1,'('+rtos(x1)+','+rtos(y1)+')'); }
  213.  
  214.         END;
  215.     SetColor(BLACK);
  216.     {twwOutTextXy(wf,-10,-10,'(0,0)');}
  217.   END;
  218.  
  219. Function WorldSinRedraw(ifs : ImageStkPtr; ms : MsClickPtr): Word;
  220.   VAR wf: WinFramePtr;
  221.       t : real;
  222.   const
  223.     counter : real = 0.05;
  224.     range   : real = 8.0;
  225.   BEGIN
  226.     wf := FindWinFrame(ifs);
  227.     twwDefineWorld(wf,-(range * 1.2),(range * 1.2),(range * 1.2),-(range * 1.2));
  228.     twwline(wf,-range,0,range,0);
  229.     twwline(wf,0,-range,0,range);
  230.     twwline(wf,-range,range,-range,-range);
  231.     twwline(wf,-range,-range,range,-range);
  232.     setcolor(red);
  233.     t := -range;
  234.     while t <= range do
  235.       begin
  236.         { twwputpixel(wf,t,range * sin(t),red); }
  237.  
  238.         twwline(wf,t,range * sin(t),t+counter,range * sin(t+counter));
  239.         t := t + counter;
  240.       end;
  241.  
  242.     setcolor(black);
  243.   END;
  244.  
  245. Function OpenWorldBarDemo(ifs : ImageStkPtr; ms: MsClickPtr): Word;
  246.   VAR wf : WinFramePtr;
  247.   BEGIN
  248.     twInit(wf,100,100,400,400);
  249.       twSetThickness(wf,4);
  250.       twSetWinFrameColors(wf,lightgray,darkgray);
  251.       twSetHeader(wf,'Bar Graph (-100,100,100,-100)');
  252.       twSetRedraw(wf,worldBarredraw);
  253.       twSetWindowStyle(wf,stdBox);
  254.     twDrawWindowFrame(wf);
  255.   END;
  256.  
  257.  
  258. Function OpenWorldSinDemo(ifs: ImageStkPtr; Ms: MsClickPtr): Word;
  259.   VAR wf : WinFramePtr;
  260.   BEGIN
  261.     twInit(wf,200,200,400,400);
  262.       twSetThickness(wf,4);
  263.       twSetWinFrameColors(wf,lightblue,blue);
  264.       twSetHeader(wf,'Sine Wave');
  265.       twSetRedraw(wf,worldSinredraw);
  266.       twSetWindowStyle(wf,BevBox);
  267.     twDrawWindowFrame(wf);
  268.   END;
  269.  
  270.  
  271. {$F+}
  272. {$IFDEF wcFloatLInt}
  273. Function worldredraw(ifs : ImageStkPtr; ms : MsClickPtr): Word;
  274.   VAR wf : WinFramePtr;
  275.   BEGIN
  276.     twwDefineWorld(wf,-10000,10000,10000,-10000);
  277.     twwLine(wf,-10000,10000, 10000,-10000);
  278.     twwLine(wf,10000,10000,-10000,-10000);
  279.     twwrectangle(wf,-5000,-5000,5000,5000);
  280.  
  281.     setfillstyle(solidfill,blue);
  282.     twwbar(wf,-9000,9000,-5000,5000);
  283.     twwarc(wf,0,0,180,360,5000);
  284.     twwellipse(wf,0,0,180,360,6000,6000);
  285.     setcolor(red);
  286.     twwcircle(wf,0,0,6000);
  287.   END;
  288.  
  289.  
  290. {$ELSE}
  291.  
  292. Function worldredraw(ifs : ImageStkPtr; ms : MsClickPtr): Word;
  293.   VAR wf : WinFramePtr;
  294.   BEGIN
  295.     {-- the redrawing event should alway find the window then }
  296.     {-- select it. Selecting does a fix up in case the window has }
  297.     {-- been move and sets the view port to the working area of the }
  298.     {-- window. }
  299.     wf := FindWinFrame(ifs);
  300.     twselect(wf);
  301.     {-- twwDefineWorld sets the coordinate system, this must be set }
  302.     {-- after the window has been drawn (i.e. not before twDrawWindowFrame }
  303.     twwDefineWorld(wf,-10.0,10.0,10.0,-10.0);
  304.     {-- the world coordinate call all mimic the standard graphics calls }
  305.     {-- execpt they start with tww, have a winframeptr as the first parameter}
  306.     {-- and the arguments are real. Graphics functions that do not have  }
  307.     {-- coordinates have no equivalent. Just use the normal graphics call. }
  308.     setcolor(black);
  309.     twwLine(wf,-10.0,10.0, 10.0,-10.0);
  310.     twwLIne(wf,10.0,10.0,-10.0,-10.0);
  311.     twwrectangle(wf,-5,-5,5,5);
  312.     setfillstyle(solidfill,blue);
  313.     twwbar(wf,-9,9,-5,5);
  314.     {-- arcs may not work the way you expect, ellipse is better }
  315.  
  316.     twwarc(wf,0,0,360,180,5.0);
  317.     twwellipse(wf,0,0,180,360,4.0,4.0);
  318.     {-- here we draw an ellipse then a circle with the same center point }
  319.     {-- and radius, as you resize the window you can see the effect on the }
  320.     {-- aspect ratio. }
  321.     twwellipse(wf,0,0,1,360,6.0,6.0);
  322.     setcolor(red);
  323.     twwcircle(wf,0,0,6.0);
  324.   END;
  325.  
  326. {$ENDIF}
  327.  
  328. function openworlddemo(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  329. VAR wf : WinFramePtr;
  330.  
  331. BEGIN
  332.   {---------}
  333.   twInit(wf,100,100,400,300);
  334.     twSetThickness(wf,6);
  335.     twSetWinFrameColors(wf,lightgray,darkgray);
  336.     twSetHeader(wf,'World coordinates');
  337.     twSetRedraw(wf,worldredraw);
  338.     twSetWindowStyle(wf,StdBox);
  339.   twDrawWindowFrame(wf);
  340. END;
  341.  
  342. {---------------------------------------------------------}
  343. {-- Local menus in high level windows. }
  344. {-- This just draws the menus, no events are attached. }
  345.  
  346. function OpenMenuDemo(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  347.   VAR wf: WinFramePtr;
  348.   BEGIN
  349.     twInit(wf,50,50,250,250);
  350.     twSetDisplayFont(wf,@f8x8Bold);
  351.     twSetHeader(wf,'LOCAL MENU Demo');
  352.     {-- note that certain letters are surrounded by tildes, these }
  353.     {-- will be underlined when display and the appropriate key will }
  354.     {-- be captured. }
  355.   twMenuItem(wf,'~F~ile',true);
  356.     twSubMenuItem(wf,'~O~pen',true,NilUnitProc);
  357.     twSubMenuItem(wf,'~S~ave',true,NilUnitProc);
  358.     twSubMenuItem(wf,'Save ~a~s...',true,NilUnitProc);
  359.     twSubMenuItem(wf,'-',false,nilunitproc);
  360.  
  361.     twSubMenuItem(wf,'E~x~it',true,twmenucloseEvent);
  362.   twMenuItem(wf,'~E~dit ',true);
  363.     twSubMenuItem(wf,'~U~ndo',true,NilUnitProc);
  364.     twSubMenuItem(wf,'~S~elect',true,NilUnitProc);
  365.   twMenuItem(wf,'~W~indow',true);
  366.     twSubMenuItem(wf,'~T~ile',true,NilUnitProc);
  367.     twSubMenuItem(wf,'~S~elect',true,NilUnitProc);
  368.   twMenuItem(wf,'~H~elp',true);
  369.     twSubMenuItem(wf,'~C~ontents',true,NilUnitProc);
  370.     twSubMenuItem(wf,'~I~ndex',true,NilUnitProc);
  371.     twDrawWindowFrame(wf);
  372.   END;
  373.  
  374.  
  375. {---------------------------------------------------------}
  376. {-- Slider action in high level windows. The Window Frame }
  377. {-- maintains variables that are updated after a slider is}
  378. {-- moved or a slider end button is pressed. This is      }
  379. {-- looked after by some events in TWKERNEL. The user must}
  380. {-- still create an event for each slider that will then  }
  381. {-- interrogate these variables and take the appropriate  }
  382. {-- action. }
  383.  
  384.  
  385.  
  386. {-- this is the up down slider event that is called by tehe }
  387. {-- kernel after the slider is moved. }
  388.  
  389. function showUpDownAction(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  390.   VAR wf: WinFramePtr;
  391.   BEGIN
  392.     wf := FindWinFrame(ifs);
  393.     prepareforupdate(ifs);
  394.     twCrtAssign(wf);
  395.     twclear(wf);
  396.     twgotoxy(wf,1,2);
  397.     writeln(' Up Down Action');
  398.     writeln(' Slider percent: ',wf^.updnslideper);
  399.     writeln(' button up     : ',wf^.upbuttonpress);
  400.     writeln(' button down   : ',wf^.dnbuttonpress);
  401.     writeln(' Slider Range  : ',wf^.updownrange);
  402.     commitupdate;
  403.   END;
  404.  
  405. {-- this is the left right slider event that is called by the }
  406. {-- kernel after the slider is moved or the }
  407.  
  408. function showLeftRightAction(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  409.   VAR wf: WinFramePtr;
  410.   BEGIN
  411.     wf := FindWinFrame(ifs);
  412.     prepareforupdate(ifs);
  413.     twCrtAssign(wf);
  414.     twclear(wf);
  415.     twgotoxy(wf,1,2);
  416.     writeln(' Left Right Action');
  417.     writeln(' Slider percent: ',wf^.lfrtslideper);
  418.     writeln(' button left   : ',wf^.lfbuttonpress);
  419.     writeln(' button right  : ',wf^.rtbuttonpress);
  420.     writeln(' Slider Range  : ',wf^.leftrightrange);
  421.     commitupdate;
  422.   END;
  423.  
  424. {-- this event is called from a menu selection or a mouse click. }
  425. {-- It ignores the parameters and simply opens up a demo window }
  426. {-- for sliders. The WinFramePtr can be a local variable because }
  427. {-- it can be located in events that are attached to it (sliders }
  428. {-- here) by using findwinframe and the passed imagestkptr. }
  429.  
  430. function OpenSliderDemo(ifs: ImageStkPtr; ms: MsClickPtr): Word;
  431.   VAR wf: WinFramePtr;
  432.   BEGIN
  433.     twInit(wf,100,100,450,300);   {-- allocates memory and set size }
  434.     twSetUpDownRange(wf,2000,100);
  435.     twSetLeftRightRange(wf,2000,100);
  436.     twSetFont(wf,@f8x12bol);      {-- the font to use }
  437.     twSetHeader(wf,'A slider action example.');  {-- header on }
  438.     twSetUpDownSlider(wf,true);   {-- up down slider on }
  439.     twSetLeftRightSlider(wf,true);{-- left right slider on }
  440.     twSetUpDownEvent(wf,ShowUpDownAction);  {-- attach above event }
  441.     twSetLeftRightEvent(wf,showLeftRightAction);  {-- ditto }
  442.     twDrawWindowFrame(wf);      {-- finally draw it. }
  443.   END;
  444.  
  445.  
  446. BEGIN
  447.   {-- simple start up, minimal normal heap, TWCOMMON }
  448.   twEasyStart;
  449.   TechnaFont := InstallUserFont('TECHNA.CHR');
  450.   TallFont   := InstallUserFont('TALL.CHR');
  451.   setkeyboardmouse(false);
  452.   {-- MaxWindowSize is the resolution of the window manager. Try }
  453.   {-- changing this value between 32000 - 128000, larger values }
  454.   {-- are better but may cause program failure because of heap size }
  455.   {MaxWindowSize := 64000; }
  456.   {-- memory monitor, TWCONTRL, optional }
  457.   {twcInstallMonitor; }
  458.  
  459.   {-- grab standard io handles for redirection, TWWINDOW }
  460.   twcrton;
  461.  
  462.   {-- set the font to use in window headers, TWCOMMON }
  463.   twSetHeaderFont(@f8x12bol);
  464.  
  465.   menufont := @f8x12bol;   {-- set the font to use on the menu }
  466.  
  467.   FileOm    := CreateOptionMenu(MenuFont);
  468.     DefineOptions(FileOm,'-',true,NilUnitProc);
  469.     DefineOptions(FileOm,' E~x~it ',true,twExitOption);
  470.   DevicesOm := CreateOptionMenu(MenuFont);
  471.     DefineOptions(DevicesOm,'~M~enus'  ,True,OpenMenuDemo);
  472.     DefineOptions(DevicesOm,'~S~liders',True,OpenSliderDemo);
  473.  
  474.   DialogOm  := CreateOptionMenu(MenuFont);
  475.     DefineOptions(DialogOm,'~S~imple',True,OpenDialogDemo);
  476.   WorldOm   := CreateOptionMenu(MenuFont);
  477.     DefineOptions(WorldOm,'~S~ample',True,OpenWorldDemo);
  478.     DefineOptions(WorldOm,'~B~ar Graph ',True,OpenWorldBarDemo);
  479.     DefineOptions(WorldOm,'S~i~ne wave',True,OpenWorldSinDemo);
  480.     DefineOptions(WorldOm,'~T~ext (scaled)',True,OpenWorldTextDemo);
  481.  
  482.   {-- we create the bar menu last an attach all the option menus to }
  483.   {-- it, this is the only order that will work. }
  484.  
  485.   SetTeglFont(menufont);        {-- bar menu uses the current font }
  486.   CreateBarMenu(0,0,getmaxx);
  487.   MainMenu := StackPtr;       {-- just another frame }
  488.     OutBarOption(' ~F~ile ',     FileOm);
  489.     OutBarOption(' ~D~evices ',  DevicesOm);
  490.     OutBarOption(' Dia~l~ogues ',DialogOm);
  491.     OutBarOption(' ~W~orld ',      WorldOM);
  492.  
  493.   setautorotate(true);          {-- windows rotate to the top automatically }
  494.   teglsupervisor;          {-- do not adjust your set, the supervisor }
  495.                   {-- is in control! }
  496. END.
  497.