home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / HISPEED2.LZH / GEMDEMO / DEMOINTE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-02  |  7KB  |  207 lines
  1. {---------------------------------------------------------------------
  2.         GEM Interface Procedures, Variables, etc. for GEMDEMO
  3.  
  4.                 Copyright (c) 1990 D-House I ApS
  5.                        All rights reserved
  6.  
  7.                  Programmed by Martin Eskildsen
  8. ---------------------------------------------------------------------}
  9.  
  10. {$D+}
  11.  
  12. unit DemoInterface;
  13.  
  14. INTERFACE
  15.  
  16. uses GemDecl, GemAES, GemVDI, Bios;
  17.  
  18. {$I GEMDEMO.H   - read resource constants }
  19.  
  20. type
  21.   Object   = record   { simple object type - o_spec should be extended }
  22.                o_next, o_start, o_end    : integer;
  23.                o_type, o_flags, o_status : integer;
  24.                o_spec                    : Pointer;
  25.                o_x, o_y, o_w, o_h        : integer
  26.              end;
  27.   Tree     = array [0..50] of Object;       { object tree }
  28.   TreePtr  = ^Tree;
  29.  
  30.   { Currently selected graphics demo }
  31.   DemoType = (BoxesDemo, LinesDemo, EllipsesDemo, PiesDemo);
  32.  
  33.   { WINMENU item status setting type }
  34.   SetState = (s_enable, s_disable, s_leave);
  35.   { s_enable  enables  a menu item;
  36.     s_disable disables a menu item;
  37.     s_leave   leaves   a menu item alone (no change)
  38.   }
  39.  
  40. var
  41.   menu          : TreePtr;      { the MEINMENU tree                 }
  42.   about         : TreePtr;      { the ABOUTBOX dialog tree          }
  43.   selection     : TreePtr;      { the SLCTDEMO dialog tree          }
  44.   VDI_handle    : Integer;      { VDI handle                        }
  45.   AES_handle    : Integer;      { application id                    }
  46.   textwindow    : Integer;      { text window id                    }
  47.   grafwindow    : Integer;      { graphics window id                }
  48.   demo          : DemoType;     { currently selected graphdemo      }
  49.   MinX, MinY    : Integer;      { smallest (x,y) a window can have  }
  50.   MaxW, MaxH    : Integer;      { largest (w,h) a window can have   }
  51.   quit          : boolean;      { TRUE = leave program              }
  52.   CharBoxHeight : Integer;      { height of a character box (pixels)}
  53.   CharHeight    : Integer;      { height of a character (pixels)    }
  54.  
  55. { Write the message and halt the program }
  56. procedure FatalError(message : String);
  57.  
  58. { Initialize GEM. Returns TRUE if ok }
  59. function Init_Gem : boolean;
  60.  
  61. { End GEM usage }
  62. procedure End_Gem;
  63.  
  64. { Load and set up resorces }
  65. procedure Init_Resource;
  66.  
  67. { Terminate resource usage }
  68. procedure End_Resource;
  69.  
  70. { Set new status of an object in a tree :
  71.     t         : object tree
  72.     index     : object tree element
  73.     newstatus : new object status
  74. }
  75. procedure SetObjectStatus(t : TreePtr; index, newstatus : Integer);
  76.  
  77. { Set WINMENU's state :
  78.     closecurrent        : set state of WINCLOSE
  79.     opentextwindow      : set state of TXTOPEN
  80.     closetextwindow     : set state of TXTCLOSE
  81.     opengraphicswindow  : set state of GRAOPEN
  82.     closegraphicswindow : set state of GRACLOSE
  83. }
  84. procedure SetMenuState(closecurrent, opentextwindow, closetextwindow,
  85.                        opengraphicswindow, closegraphicswindow
  86.                        : SetState);
  87.  
  88. {$F+,D-,S-,R-}
  89.  
  90. IMPLEMENTATION
  91.  
  92. procedure FatalError;
  93. var ch : char;
  94. begin
  95.   writeln;
  96.   ClrEol;  writeln;
  97.   ClrEol;  writeln('>>> Fatal error condition arised! <<<');
  98.   ClrEol;  writeln(message);
  99.   ClrEol;  write('Press a key to abort...');
  100.   ch := ReadKey;
  101.   halt(0)
  102. end;
  103.  
  104. function Init_Gem;
  105. var
  106.   workin  : IntIn_Array;   { workstation input parameters  }
  107.   workout : workout_Array; { workstation output parameters }
  108.   dummy   : Integer;
  109.   s       : string;        { string holding a message      }
  110. begin
  111.   if Bios.GetRez < 2 then begin   { low or medium rez.     }
  112.     s := '[0][ |Note! The icons will look a  |bit odd in this resolution.'
  113.        + ' |High res. looks nicest |][   Ok   ]';
  114.     dummy := form_alert(1, s[1])
  115.   end;
  116.   AES_handle := appl_init;        { get AES handle }
  117.   if AES_handle >= 0 then begin   { if legal then go on : }
  118.  
  119.     { get VDI handle and height of a character and its box : }
  120.     VDI_handle := graf_handle(CharHeight, dummy, CharBoxHeight, dummy);
  121.  
  122.     { initialize workstation input parameters : }
  123.     for dummy := 0 to 9 do workin[dummy] := 1;
  124.     workin[10] := 2;   { use Raster Coordinates }
  125.     
  126.     v_opnvwk(workin, VDI_handle, workout); { open virtual workstation }
  127.  
  128.     { get size of free desktop area : }
  129.     wind_get(0, WF_FULLXYWH, MinX, MinY, MaxW, MaxH);
  130.     graf_growbox(0, 0, 0, 0, MinX, MinY, MaxW, MaxH);    { nice! }
  131.     graf_mouse(ARROW, NIL)
  132.   end;
  133.   Init_Gem := AES_handle >= 0           { return TRUE if init ok }
  134. end;
  135.  
  136. procedure End_Gem;
  137. begin
  138.   graf_shrinkbox(0, 0, 0, 0, MinX, MinY, MaxW, MaxH);
  139.   v_clsvwk(VDI_handle);    { close virtual workstation  }
  140.   appl_exit                { exit application (GEMDEMO) }
  141. end;
  142.  
  143. procedure Init_Resource;
  144. var ResourceName : string;
  145. begin
  146.   ResourceName := 'GEMDEMO.RSC' + #0;   { Note #0  ! }
  147.   rsrc_load(ResourceName[1]);           { Note [1] ! }
  148.   if GemError = 0 then begin
  149.     ResourceName := 'GEMDEMO\GEMDEMO.RSC'#00;
  150.     rsrc_load(ResourceName[1]);
  151.     if GemError = 0 then begin
  152.       End_Gem;
  153.       FatalError('GEMDEMO.RSC is missing!')
  154.     end
  155.   end;
  156.   rsrc_gaddr(R_TREE, MAINMENU, menu);      { set menu tree ptr      }
  157.   rsrc_gaddr(R_TREE, ABOUTBOX, about);     { set aboutbox tree ptr  }
  158.   rsrc_gaddr(R_TREE, SLCTDEMO, selection); { set selection tree ptr }
  159.   
  160.   { set defaut states : }
  161.   SetMenuState(s_disable, s_enable, s_disable, s_enable, s_disable);
  162.   SetObjectStatus(about,     ABOUTOK,  NORMAL);
  163.   SetObjectStatus(selection, BOXES,    SELECTED);
  164.   SetObjectStatus(selection, LINES,    NORMAL);
  165.   SetObjectStatus(selection, ELLIPSES, NORMAL);
  166.   SetObjectStatus(selection, PIES,     NORMAL);
  167.   menu_bar(menu, 1)    { draw menu }
  168. end;
  169.  
  170. procedure End_Resource;
  171. begin
  172.   menu_bar(menu, 0);    { remove menu from screen }
  173.   rsrc_free             { release memory          }
  174. end;
  175.  
  176. procedure SetObjectStatus;
  177. begin
  178.   t^[index].o_status := newstatus   { quite simple... }
  179. end;
  180.  
  181. procedure SetMenuState(closecurrent, opentextwindow, closetextwindow,
  182.                        opengraphicswindow, closegraphicswindow
  183.                        : SetState);
  184.  
  185.   { Change a single menu item's state }
  186.   procedure Change(newstate : SetState; index : Integer);
  187.   begin
  188.     case newstate of
  189.       s_enable  : menu_ienable(menu, index, 1);  { enable item  }
  190.       s_disable : menu_ienable(menu, index, 0);  { disable item }
  191.       s_leave   :                                { do nothing   }
  192.     end
  193.   end;
  194.  
  195. begin { SetMenuState }
  196.   Change(closecurrent,        WINCLOSE);
  197.   Change(opentextwindow,      TXTOPEN);
  198.   Change(closetextwindow,     TXTCLOSE);
  199.   Change(opengraphicswindow,  GRAOPEN);
  200.   Change(closegraphicswindow, GRACLOSE)
  201. end;
  202.  
  203. begin { of unit }
  204.   demo       := BoxesDemo;   quit       := FALSE;
  205.   textwindow := -1;          grafwindow := -1      { no open windows }
  206. end.
  207.