home *** CD-ROM | disk | FTP | other *** search
/ Vectronix 2 / VECTRONIX2.iso / FILES_01 / LATTIC_3.LZH / WTEST / WTEST.MOD < prev    next >
Text File  |  1988-08-31  |  6KB  |  210 lines
  1. MODULE WercTest;
  2. FROM Object IMPORT Object,ObjectStates,PObject,TEDINFO,G_BUTTON,objc_draw,
  3.         SELECTED;
  4. FROM MenuLib IMPORT menu_icheck,menu_bar,menu_tnormal;
  5. FROM Forms IMPORT form_dial,form_do,form_center,form_alert,
  6.         ReserveSpace,ExpandBox,ShrinkBox,FreeSpace;
  7. FROM Resource IMPORT rsrc_gaddr,rsrc_free,tree,string;
  8. FROM AesSupport IMPORT ApplicationControl;
  9. FROM Window IMPORT wind_get,wind_set_long;
  10. FROM SYSTEM IMPORT ADR,ADDRESS,TSIZE,BYTE;
  11. FROM Application IMPORT appl_exit;
  12. FROM Activity IMPORT EventRecord,GetActivity,EventClass,ExternalMouseControl;
  13. FROM Event IMPORT Message,EventSet,MN_SELECTED;
  14. FROM Strings IMPORT Length;
  15. FROM Graphics IMPORT graf_mouse;
  16. IMPORT WRSC;
  17.  
  18. CONST
  19.         WF_WORKXYWH=4;
  20.         WF_NEWDESK=14;
  21.  
  22. TYPE
  23.     PTEDINFO=POINTER TO TEDINFO;
  24.     PCHAR=POINTER TO CHAR;
  25.     PObjectArray=POINTER TO ARRAY[0..999] OF Object;
  26.  
  27. VAR
  28.     screenx,screeny,screenw,screenh:CARDINAL;
  29.     e:EventRecord;
  30.     DeskFlag,Finished,Checked:BOOLEAN;
  31.     MenuAdr:PObjectArray;
  32.     junk:CARDINAL;
  33.     TempAdr:PObject;
  34.     EditString:ARRAY[0..40] OF CHAR;
  35.     AlertString:ARRAY[0..80] OF CHAR;
  36.     RadioButton:CARDINAL;
  37. PROCEDURE Initialise;
  38. BEGIN
  39.     ExternalMouseControl:=TRUE;
  40.     ApplicationControl('WRSC');
  41.     junk:=graf_mouse(0,NIL);
  42.     junk:=rsrc_gaddr(tree,WRSC.Menu1,MenuAdr);
  43.     junk:=menu_bar(PObject(MenuAdr),TRUE);
  44.     junk:=wind_get(0,WF_WORKXYWH,screenx,screeny,screenw,screenh)
  45.     DeskFlag:=FALSE;
  46. END Initialise;
  47. (*     set or reset the desktop pattern *)
  48. PROCEDURE SetDesk(newdesk:ADDRESS);
  49. BEGIN
  50. junk:=wind_set_long(0,WF_NEWDESK,newdesk,ADDRESS(LONG(0)));
  51. (* cause the AES to re-draw the whole screen *)
  52. junk:=form_dial(FreeSpace,0,0,0,0,screenx,screeny,screenw,screenh);
  53. END SetDesk;
  54. PROCEDURE DeInitialise;
  55. BEGIN
  56.     IF DeskFlag THEN
  57.         SetDesk(ADDRESS(LONG(0)));
  58.         DeskFlag:=FALSE;
  59.     END;
  60.     junk:=menu_bar(PObject(MenuAdr),FALSE);
  61.     junk:=rsrc_free();
  62.     junk:=appl_exit();
  63. END DeInitialise;
  64. PROCEDURE HandleDialog(Dialog:PObjectArray;DefaultItem:CARDINAL):CARDINAL;
  65. VAR x,y,w,h,but:CARDINAL;
  66. BEGIN
  67.     form_center(Dialog,x,y,w,h);
  68.     junk:=form_dial(ReserveSpace,0,0,0,0,x,y,w,h);
  69.     junk:=form_dial(ExpandBox,x+w DIV 2,y+h DIV 2,0,0,x,y,w,h)
  70.     junk:=objc_draw(PObject(Dialog),0,10,x,y,w,h);
  71.     but:=form_do(Dialog,DefaultItem);
  72.     junk:=form_dial(ShrinkBox,x+w DIV 2,y+h DIV 2,0,0,x,y,w,h);
  73.     junk:=form_dial(FreeSpace,0,0,0,0,x,y,w,h);
  74.     WITH Dialog^[but] DO
  75.         IF ob_type=G_BUTTON THEN EXCL(ob_state,SELECTED); END;
  76.     END;
  77.     RETURN but;
  78. END HandleDialog;
  79.  
  80. PROCEDURE PcharToString(from:ADDRESS;VAR newstr:ARRAY OF CHAR);
  81. VAR pc:PCHAR;i:CARDINAL;
  82. BEGIN
  83.     i:=0;
  84.     pc:=from;
  85.  
  86.     WHILE (pc^<>0c) AND (i<HIGH(newstr)) DO
  87.         newstr[i]:=pc^;
  88.         pc:=PCHAR(LONGCARD(pc)+1);
  89.         INC(i);
  90.     END;
  91.     newstr[i]:=0c;    (* ensure null terminated *)
  92. END PcharToString;
  93.  
  94. PROCEDURE SetTedinfo(Dialog:PObjectArray;object:CARDINAL;VAR newted:ARRAY OF CHAR);
  95. VAR ted:PTEDINFO;
  96.     pc:PCHAR;
  97.     i:CARDINAL
  98. BEGIN
  99.     ted:=PTEDINFO(Dialog^[object].ob_spec);
  100.     pc:=PCHAR(ted^.te_ptext);
  101.     FOR i:=1 TO Length(newted) DO
  102.         pc^:=newted[i-1];
  103.         pc:=PCHAR(LONGCARD(pc)+1);
  104.     END;
  105.     pc^:=0c;    (* ensure null terminated *)
  106. END SetTedinfo;
  107.  
  108. PROCEDURE GetTedinfo(Dialog:PObjectArray;object:CARDINAL;VAR newted:ARRAY OF CHAR);
  109. VAR ted:PTEDINFO;
  110.     pc:PCHAR;
  111.     i:CARDINAL;
  112. BEGIN
  113.     ted:=PTEDINFO(Dialog^[object].ob_spec);
  114.     PcharToString(ted^.te_ptext,newted);
  115. END GetTedinfo;
  116.  
  117. PROCEDURE SetButton(Dialog:PObjectArray; parent,button:CARDINAL);
  118. VAR Cur:CARDINAL;
  119. BEGIN
  120.     Cur:=Dialog^[parent].ob_head;
  121.     WHILE Cur<>parent DO
  122.         WITH Dialog^[Cur] DO
  123.             IF Cur=button THEN
  124.                 INCL(ob_state,SELECTED);
  125.             ELSE
  126.                    EXCL(ob_state,SELECTED);
  127.             END;
  128.             Cur:=ob_next;
  129.         END;
  130.     END;
  131. END SetButton;
  132.  
  133. PROCEDURE GetButton(Dialog:PObjectArray; parent:CARDINAL):CARDINAL;
  134. VAR Cur:CARDINAL;
  135. BEGIN
  136.     Cur:=Dialog^[parent].ob_head;
  137.     WHILE    Cur<>parent DO
  138.         WITH Dialog^[Cur] DO
  139.             IF SELECTED IN ob_state  THEN
  140.                    RETURN Cur;
  141.             END;
  142.             Cur:=ob_next;
  143.         END;
  144.     END;
  145. END GetButton;
  146.  
  147. PROCEDURE TestDialog;
  148. VAR dialog:PObjectArray;
  149. BEGIN
  150.     junk:=rsrc_gaddr(tree,WRSC.TestDialog,TempAdr);
  151.     dialog:=ADDRESS(TempAdr);
  152.     SetTedinfo(dialog,WRSC.DEditable,EditString);
  153.     SetButton(dialog,WRSC.DParent,RadioButton);
  154.     IF HandleDialog(dialog,WRSC.DEditable)=WRSC.DOK THEN
  155.         GetTedinfo(dialog,WRSC.DEditable,EditString);
  156.         RadioButton:=GetButton(dialog,WRSC.DParent);
  157.     END;
  158. END TestDialog;
  159.  
  160. PROCEDURE HandleMenu(title,item:CARDINAL);
  161. BEGIN
  162.     CASE item OF
  163.     WRSC.MAbout:
  164.         junk:=rsrc_gaddr(string,WRSC.AAlert,TempAdr);
  165.         PcharToString(TempAdr,AlertString);
  166.         junk:=form_alert(1,AlertString); |
  167.     WRSC.MQuit: Finished:=TRUE;|
  168.     WRSC.MCheckme:
  169.         Checked:=NOT Checked;
  170.         junk:=menu_icheck(PObject(MenuAdr),WRSC.MCheckme,Checked);|
  171.     WRSC.MDialog:
  172.         TestDialog;|
  173.     WRSC.MInstall:
  174.         IF DeskFlag THEN
  175.             SetDesk(ADDRESS(LONG(0)));
  176.             DeskFlag:=FALSE;
  177.         ELSE
  178.             junk:=rsrc_gaddr(tree,WRSC.NewDesktop,TempAdr);
  179.             WITH TempAdr^ DO
  180.                 ob_x:=screenx; ob_y:=screeny;
  181.                 ob_width:=screenw; ob_height:=screenh;
  182.             END;
  183.             SetDesk(TempAdr);
  184.             DeskFlag:=TRUE;
  185.         END;|
  186.     END;
  187.     junk:=menu_tnormal(PObject(MenuAdr),title,TRUE); (* normal state *)
  188. END HandleMenu;
  189.  
  190. BEGIN
  191.     Initialise;
  192.     Finished:=FALSE;
  193.     Checked:=FALSE;
  194.     REPEAT
  195.         GetActivity(e);
  196.         WITH e DO
  197.             CASE Event OF
  198.             MessageEvent:
  199.                 WITH Mess DO
  200.                     CASE MessageType OF
  201.                     MN_SELECTED: HandleMenu(Message[0],Message[1]);|
  202.                     (* other messages here *)
  203.                     END;
  204.                 END;|
  205.             (* other types of event here *)
  206.             END;
  207.         END;
  208.     UNTIL Finished;
  209.     DeInitialise;
  210. END WercTest.