home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / program / compiler / stjo2122 / tutorial / gemdemo.mod next >
Encoding:
Text File  |  1993-11-28  |  8.0 KB  |  294 lines
  1. MODULE GemDemo;
  2.  
  3.  
  4. IMPORT S:=SYSTEM, GemApp, MVC, WinView, Evnt,
  5.        Graf, VC:=VDIControl, VA:=VDIAttributes,
  6.        VO:=VDIOutput, Menus, Rsrc, Form, Objc,
  7.        WDial:=WindowDialog, NumStr;
  8.  
  9.  
  10. CONST
  11.     BOX        = 0; (* form/dialog *)
  12.     OK         = 4; (* BUTTON in tree BOX *)
  13.     INPUT1     = 5; (* BUTTON in tree BOX *)
  14.     OUTPUT1    = 6; (* BUTTON in tree BOX *)
  15.  
  16.     MENU       = 1; (* menu *)
  17.     DESK       = 3; (* TITLE in tree MENU *)
  18.     FILE       = 4; (* TITLE in tree MENU *)
  19.     WORK       = 5; (* TITLE in tree MENU *)
  20.     INFO       = 8; (* STRING in tree MENU *)
  21.     QUIT       = 17; (* STRING in tree MENU *)
  22.     INPUT2     = 19; (* STRING in tree MENU *)
  23.     OUTPUT2    = 20; (* STRING in tree MENU *)
  24.  
  25.     INPUTBOX   = 2; (* form/dialog *)
  26.     CIRCLE     = 2; (* BUTTON in tree INPUTBOX *)
  27.     RECT       = 3; (* BUTTON in tree INPUTBOX *)
  28.     XPOS       = 4; (* FTEXT in tree INPUTBOX *)
  29.     YPOS       = 5; (* FTEXT in tree INPUTBOX *)
  30.     RADIUS     = 6; (* FTEXT in tree INPUTBOX *)
  31.     WIDTH      = 7; (* FTEXT in tree INPUTBOX *)
  32.     HEIGHT     = 8; (* FTEXT in tree INPUTBOX *)
  33.     DRAW       = 9; (* BUTTON in tree INPUTBOX *)
  34.  
  35.  
  36.  
  37. TYPE
  38.   Viewer    = POINTER TO ViewDesc;
  39.   ViewDesc  = RECORD(WinView.ViewDesc)
  40.               END;
  41.   Application = POINTER TO ApplDesc;
  42.   ApplDesc  = RECORD(GemApp.ApplDesc)
  43.               END;
  44.   Object    = POINTER TO ObjDesc;
  45.   ObjDesc   = RECORD
  46.                 next : Object;
  47.                 x,y  : INTEGER;
  48.               END;
  49.   Circle    = POINTER TO CircleDesc;
  50.   CircleDesc= RECORD(ObjDesc)
  51.                 r : INTEGER;
  52.               END;
  53.   Rect      = POINTER TO RectDesc;
  54.   RectDesc  = RECORD(ObjDesc)
  55.                 w,h  : INTEGER;
  56.               END;
  57.   MyModel   = POINTER TO ModelDesc;
  58.   ModelDesc = RECORD(MVC.ModelDesc)
  59.                 objects : Object;
  60.               END;
  61.  
  62.  
  63. VAR myApp : Application;
  64.     infoDial,inputDial : WDial.Dialog;
  65.     myModel : MyModel;
  66.     Station : INTEGER;
  67.     Workout : VC.workout;
  68.  
  69.  
  70. PROCEDURE(o : Object) Draw(v : Viewer);
  71.  BEGIN
  72.  END Draw;
  73.  
  74.  
  75. PROCEDURE(c : Circle) Draw(v : Viewer);
  76.  BEGIN
  77.   VO.VArc( Station, v.x - SHORT( v.xOff) + c.x,
  78.          v.y - SHORT( v.yOff) + c.y, c.r, 0, 3600 );
  79.  END Draw;
  80.  
  81.  
  82. PROCEDURE(r : Rect) Draw(v : Viewer);
  83.   VAR Edges : ARRAY 10 OF INTEGER;
  84.  BEGIN
  85.   Edges[0] := v.x - SHORT( v.xOff) + r.x;
  86.   Edges[1] := v.y - SHORT( v.yOff) + r.y;
  87.   Edges[2] := Edges[0];
  88.   Edges[3] := Edges[1] + r.h - 1;
  89.   Edges[4] := Edges[0] + r.w - 1;
  90.   Edges[5] := Edges[3];
  91.   Edges[6] := Edges[4];
  92.   Edges[7] := Edges[1];
  93.   Edges[8] := Edges[0];
  94.   Edges[9] := Edges[1];
  95.   VO.VPline( Station, 5, Edges);
  96.  END Draw;
  97.  
  98.  
  99. PROCEDURE(v : Viewer) Redraw(x,y,w,h : INTEGER);
  100.   VAR x2, y2 : INTEGER;
  101.       obj : Object;
  102.  BEGIN
  103.   x2 := x+w-1; y2 := y+h-1;
  104.   VC.VsClip( Station, TRUE, x, y, x2, y2);
  105.   VO.VBar( Station, x, y, x2, y2 );
  106.   obj := myModel.objects;
  107.   WHILE obj # NIL DO
  108.     obj.Draw(v); obj := obj.next;
  109.   END;
  110.  END Redraw;
  111.  
  112.  
  113. PROCEDURE(m : MyModel) Init;
  114.  BEGIN
  115.   m.objects := NIL; m.Init^;
  116.  END Init;
  117.  
  118.  
  119. PROCEDURE ShowInfo;
  120.  BEGIN
  121.   infoDial.Open;
  122.  END ShowInfo;
  123.  
  124.  
  125. PROCEDURE Exit;
  126.  BEGIN
  127.   GemApp.exit := TRUE; (* die saubere Methode *)
  128.  END Exit;
  129.  
  130.  
  131. PROCEDURE OpenInput;
  132.  BEGIN
  133.   inputDial.Open;
  134.  END OpenInput;
  135.  
  136.  
  137. PROCEDURE SetDWH(v : Viewer);
  138.   VAR obj : Object; maxX, maxY, dw, dh : INTEGER;
  139.  BEGIN
  140.   obj := myModel.objects;
  141.   dw := SHORT(v.dw); dh := SHORT(v.dh);
  142.   WHILE obj # NIL DO
  143.     IF obj IS Rect THEN
  144.       maxX := obj.x + obj(Rect).w;
  145.       maxY := obj.y + obj(Rect).h;
  146.     ELSE
  147.       maxX := obj.x + obj(Circle).r;
  148.       maxY := obj.y + obj(Circle).r;
  149.     END;
  150.     IF maxX > dw THEN dw := maxX END;
  151.     IF maxY > dh THEN dh := maxY END;
  152.     obj := obj.next;
  153.   END;
  154.   IF dw # v.dw THEN v.dw := dw; v.HSlider END;
  155.   IF dh # v.dh THEN v.dh := dh; v.VSlider END;
  156.  END SetDWH;
  157.  
  158.  
  159. PROCEDURE OpenOutput;
  160.   VAR outWin  : Viewer;
  161.  BEGIN
  162.   NEW( outWin); outWin.Init;
  163.   outWin.model := myModel; SetDWH(outWin);
  164.   outWin.SetTitle("Objektfenster");
  165.   outWin.SetFullSize( 0, 19, Workout.MaxX - 1,
  166.                       Workout.MaxY - 20);
  167.   outWin.Open;
  168.  END OpenOutput;
  169.  
  170.  
  171. PROCEDURE(v : Viewer) Update( aspect : LONGINT);
  172.  BEGIN
  173.   v.Update^( aspect); SetDWH(v);
  174.  END Update;
  175.  
  176. (*$T- wegen NEW( obj(Rect) ) bzw. NEW( obj(Circle) ),
  177.       denn Typcheck geht nur wenn das Objekt schon
  178.       alloziert ist ... *)
  179.  
  180. PROCEDURE EnterNewObject;
  181.   VAR x,y : INTEGER; obj : Object;
  182.       tep : Objc.tedinfoptr;
  183.  BEGIN
  184.   IF Objc.SELECTED IN
  185.      Objc.GetState( inputDial.objTree, RECT) THEN
  186.     NEW( obj(Rect) );
  187.     tep := Objc.GetSpec( inputDial.objTree, WIDTH);
  188.     obj(Rect).w := NumStr.ToInt( 10, tep.Text^);
  189.     tep := Objc.GetSpec( inputDial.objTree, HEIGHT);
  190.     obj(Rect).h := NumStr.ToInt( 10, tep.Text^);
  191.   ELSE
  192.     NEW( obj(Circle) );
  193.     tep := Objc.GetSpec( inputDial.objTree, RADIUS);
  194.     obj(Circle).r := NumStr.ToInt( 10, tep.Text^);
  195.   END;
  196.   tep := Objc.GetSpec( inputDial.objTree, XPOS);
  197.   obj.x := NumStr.ToInt( 10, tep.Text^);
  198.   tep := Objc.GetSpec( inputDial.objTree, YPOS);
  199.   obj.y := NumStr.ToInt( 10, tep.Text^);
  200.   obj.next := myModel.objects;
  201.   myModel.objects := obj;
  202.   myModel.Changed( 0);
  203.  END EnterNewObject;
  204.  
  205. (*$T= *)
  206.  
  207. PROCEDURE EnableCircle;
  208.  BEGIN
  209.   inputDial.SetCursor( XPOS);
  210.   Objc.SetFlags( inputDial.objTree, WIDTH,
  211.                  {Objc.EDITABLE, Objc.HIDDEN} );
  212.   inputDial.RedrawObj( WIDTH);
  213.   Objc.SetFlags( inputDial.objTree, HEIGHT,
  214.                  {Objc.EDITABLE, Objc.HIDDEN} );
  215.   inputDial.RedrawObj( HEIGHT);
  216.   Objc.SetFlags( inputDial.objTree, RADIUS,
  217.                  {Objc.EDITABLE} );
  218.   inputDial.RedrawObj( RADIUS);
  219.  END EnableCircle;
  220.  
  221.  
  222. PROCEDURE EnableRect;
  223.  BEGIN
  224.   inputDial.SetCursor( XPOS);
  225.   Objc.SetFlags( inputDial.objTree, RADIUS,
  226.                 {Objc.EDITABLE, Objc.HIDDEN} );
  227.   inputDial.RedrawObj( RADIUS);
  228.   Objc.SetFlags( inputDial.objTree, WIDTH,
  229.                 {Objc.EDITABLE} );
  230.   inputDial.RedrawObj( WIDTH);
  231.   Objc.SetFlags( inputDial.objTree, HEIGHT,
  232.                 {Objc.EDITABLE} );
  233.   inputDial.RedrawObj( HEIGHT);
  234.  END EnableRect;
  235.  
  236.  
  237. PROCEDURE(app: Application) Init;
  238.   VAR menu : Menus.Menu;
  239.       Workin  : VC.workin;
  240.  BEGIN
  241.   app.Init^; (* must come first! *)
  242.   Graf.ChangeMouse( Graf.ARROW);
  243.   IF NOT Rsrc.Load("GEMDEMO.RSC") THEN
  244.     app.Exit
  245.   END;
  246.   NEW(menu); menu.Init( Rsrc.GetAddr(MENU) );
  247.   menu.Set( FILE, QUIT, Exit );
  248.   menu.Set( DESK, INFO, ShowInfo );
  249.   menu.Set( WORK, OUTPUT2, OpenOutput );
  250.   menu.Set( WORK, INPUT2, OpenInput );
  251.   menu.Show;
  252.   Station := 1;
  253.   Workin.Id := 1; Workin.LineType := 1;
  254.   Workin.LineColor := 1; Workin.MarkType := 1;
  255.   Workin.MarkColor := 1; Workin.Font := 1;
  256.   Workin.TextColor := 1; Workin.FillStyle := 0;
  257.   Workin.FillPat := 0; Workin.FillColor := 1;
  258.   Workin.KoorType := 2;
  259.   VC.VOpnvwk(Workin,Station,Workout);
  260.   VA.VswrMode(Station,VA.REPLACE);
  261.   VA.VsfPerimeter(Station,FALSE);
  262.   NEW( myModel); myModel.Init;
  263.   NEW( infoDial);
  264.   infoDial.InitDialog( Rsrc.GetAddr(BOX) , 0, TRUE);
  265.   infoDial.SetWork(OK, NIL, { WDial.DESELECT,
  266.                               WDial.EXITONLY } );
  267.   infoDial.SetWork(INPUT1, OpenInput,
  268.              { WDial.DESELECT, WDial.REDRAWOBJ } );
  269.   infoDial.SetWork(OUTPUT1, OpenOutput,
  270.              { WDial.DESELECT, WDial.REDRAWOBJ } );
  271.   infoDial.SetTitle("Information");
  272.   NEW( inputDial);
  273.   inputDial.InitDialog( Rsrc.GetAddr(INPUTBOX),
  274.                        XPOS, TRUE);
  275.   inputDial.SetWork(DRAW, EnterNewObject,
  276.              { WDial.DESELECT, WDial.REDRAWOBJ } );
  277.   inputDial.SetWork(CIRCLE, EnableCircle, {} );
  278.   inputDial.SetWork(RECT, EnableRect, {} );
  279.   inputDial.SetTitle("Neues Objekt");
  280.   inputDial.SetText( XPOS, "");
  281.   inputDial.SetText( YPOS, "");
  282.   inputDial.SetText( WIDTH, "");
  283.   inputDial.SetText( HEIGHT, "");
  284.   inputDial.SetText( RADIUS, "");
  285.   Objc.SetState( inputDial.objTree, RECT,
  286.                  {Objc.SELECTED} );
  287.  END Init;
  288.  
  289.  
  290. BEGIN
  291.   NEW(myApp);
  292.   myApp.Init; myApp.Run; myApp.Exit
  293. END GemDemo.
  294.