Topspeed_JPI/TS/EXAMPLES/PMJP.MOD

(*-------------------------------------------------------------------------*
*                                                                          *
*  PMJP.MOD - Presentation manager demo                                    *
*                                                                          *
*  COPYRIGHT (C) 1989..1992 Clarion Software Corporation.                  *
*  All Rights Reserved                                                     *
*                                                                          *
*--------------------------------------------------------------------------*)

MODULE PMJP;

(* Simple demonstation of a PM Application using Win and Gpi calls *)

(* This application can be used as the basis of a shell for your own
   application
*)
(*# call(same_ds => off) *)
(*# data(heap_size=> 3000) *)


IMPORT OS2DEF,Win,Gpi,Dos,Lib,SYSTEM;
FROM OS2DEF IMPORT HDC,HRGN,HAB,HPS,HBITMAP,HWND,HMODULE,HSEM,
                   POINTL,RECTL,PID,TID,LSET,NULL,
                   COLOR,NullVar,NullStr,BOOL ;

CONST
  WindowId = 255;

VAR
  Hab       : HAB;
  Hps       : HPS;
  BackColor : COLOR;
  ForeColor : COLOR;
  ChangeBack: BOOLEAN;




(*--------------------  Error reporting procedure  ---------------------*)
PROCEDURE Error;
VAR
  errinf : Win.PERRINFO;
(*# save,
    data(near_ptr=>off) *)
  emsg   : POINTER TO ARRAY[0..255] OF CHAR;
(*# restore *)
  mbid   : Win.MBID;
  win    : HWND;
BEGIN
  errinf := Win.GetErrorInfo(Hab);
  IF errinf=FarNIL THEN RETURN END;
  emsg := [SYSTEM.Seg(errinf^):CARDINAL([SYSTEM.Seg(errinf^):errinf^.Msg]^)];
  win := Win.QueryActiveWindow(Win.HWND_DESKTOP,B_FALSE);
  mbid := Win.MessageBox(Win.HWND_DESKTOP,win,emsg^,'Error Returned',0,
                         Win.MB_ICONHAND+Win.MB_CANCEL+Win.MB_MOVEABLE);
  IF Win.FreeErrorInfo(errinf^) THEN END;
END Error;

(*-------------------- JP drawing ---------------------------------------*)

PROCEDURE DrawTitle;
(* Creates font and displays message *)
CONST
  Title1 = 'TopSpeed Modula-2  Demonstration Program';
  Title2 = 'Mouse button 1 cycles Foreground';
  Title3 = 'Mouse button 2 cycles Background';
  Title4 = 'F3 exits program';
VAR
  pt  : POINTL;
  b   : Gpi.SIZEF;
BEGIN
  pt.x := 1; pt.y := 1;
  IF NOT Gpi.SetCharShear(Hps,pt) THEN Error END;
  pt.x := 20; pt.y := 220;
  IF Gpi.CharStringAt(Hps,pt,SIZE(Title1),Title1)<0 THEN Error END;
  pt.x := 20; pt.y := 200;
  IF Gpi.CharStringAt(Hps,pt,SIZE(Title2),Title2)<0 THEN Error END;
  pt.x := 20; pt.y := 190;
  IF Gpi.CharStringAt(Hps,pt,SIZE(Title3),Title3)<0 THEN Error END;
  pt.x := 20; pt.y := 180;
  IF Gpi.CharStringAt(Hps,pt,SIZE(Title4),Title4)<0 THEN Error END;
END DrawTitle;

PROCEDURE DrawJp;
TYPE
  Shade = (normal,light,dark);
  A10 = ARRAY[0..9] OF CARDINAL;
  A6  = ARRAY[0..5] OF CARDINAL;
  A4  = ARRAY[0..3] OF CARDINAL;
  A3  = ARRAY[0..2] OF CARDINAL;
CONST
  Lx  = A6(0,30,60,52,30,10);
  Ly  = A6(50,40,53,57,48,55);
  Jx  = A10(0, 30,30,0,0, 10,10,20,20,0);
  Jy  = A10(50,40,0,10,25,21,15,12,33,40);
  Px  = A6(60,30,30,40,40,60);
  Py  = A6(53,40,0,5,15,25);
  P1x = A4(10,10,20,20);
  P1y = A4(15,21,26,20);
  P2x = A3(40,50,40);
  P2y = A3(25,30,35);
  P3x = A4(0, 10,20,10);
  P3y = A4(25,21,26,30);
  P4x = A3(10,20,20);
  P4y = A3(15,20,12);
  P5x = A3(50,50,40);
  P5y = A3(40,30,35);

  PROCEDURE Xlat(x,y:CARDINAL;VAR xo,yo:CARDINAL);
  BEGIN
    xo := x*3+80; yo := y*3;
  END Xlat;


  PROCEDURE Polygon(xa,ya :ARRAY OF CARDINAL;
                    c:Shade);
  VAR
    xt,yt: A10;
    i,n : CARDINAL;
    pt  : POINTL;
  BEGIN
    n := HIGH(xa)+1;
    FOR i := 0 TO n-1 DO Xlat(xa[i],ya[i],xt[i],yt[i]); END;
    pt.x := LONGINT(xt[0]);
    pt.y := LONGINT(yt[0]);
    IF NOT Gpi.Move(Hps,pt) THEN Error END;
    CASE c OF
    | normal : IF NOT Gpi.SetPattern(Hps,Gpi.PATSYM_DENSE4) THEN Error END;
    | dark   : IF NOT Gpi.SetPattern(Hps,Gpi.PATSYM_DENSE2) THEN Error END;
    | light  : IF NOT Gpi.SetPattern(Hps,Gpi.PATSYM_DENSE6) THEN Error END;
    END;
    IF NOT Gpi.SetBackMix(Hps,Gpi.BM_OVERPAINT) THEN Error END;
    IF NOT Gpi.BeginArea(Hps,Gpi.BA_BOUNDARY) THEN Error END;
    FOR i := 1 TO n-1 DO
      pt.x := LONGINT(xt[i]);
      pt.y := LONGINT(yt[i]);
      IF Gpi.Line(Hps,pt)<0 THEN Error END;
    END ;
    IF Gpi.EndArea(Hps)<0 THEN Error END;
  END Polygon;

BEGIN
    Polygon(Lx,Ly,dark);
    Polygon(Jx,Jy,light);
    Polygon(Px,Py,normal);
    Polygon(P1x,P1y,normal);
    Polygon(P2x,P2y,dark);
    Polygon(P3x,P3y,dark);
    Polygon(P4x,P4y,dark);
    Polygon(P5x,P5y,light);
END DrawJp;



(*--------------------  Start of window procedure  ---------------------*)
(*# save,
    call(near_call=>off, reg_param=>(), reg_saved=>(di,si,ds,es,st1,st2)) *)
PROCEDURE WindowProc(hwnd : HWND;msg:CARDINAL;mp1,mp2:Win.MPARAM):Win.MRESULT;
VAR
  rc  : RECTL;
  pt  : POINTL;
  r   : CARDINAL;
  hr  : Gpi.HITSRET;
  cm  : Win.CHARMSG;
BEGIN
  CASE msg OF
  | Win.WM_PAINT:

      (*----------------------------------------------------------------*)
      (* Window contents are drawn here in WM_PAINT processing.         *)
      (*----------------------------------------------------------------*)

                                                        (* Obtain a cached micro PS     *)
      Hps := Win.BeginPaint( hwnd, HPS(NULL), rc );

      IF ChangeBack THEN
        IF NOT Win.FillRect( Hps, rc, BackColor ) THEN  (* Fill invalid rectangle       *)
          Error;
        END ;
      END ;
      ChangeBack := TRUE ;

      IF NOT Gpi.SetColor( Hps, Gpi.CLR_RED) THEN    (* Set color of the text *)
        Error;
      END;
      DrawTitle;

      IF NOT Gpi.SetColor( Hps, ForeColor) THEN    (* Set color of the Block *)
        Error;
      END;

      DrawJp;


      IF NOT Win.EndPaint( Hps ) THEN                    (* Drawing is complete   *)
        Error;
      END;

   | Win.WM_BUTTON1DOWN:

      (*---------------------------------------------------------------*)
      (* Mouse button 1 has been clicked, so first ensure we have the  *)
      (* input focus and then cycle the foreground color and cause the *)
      (* the window to be redrawn.                                     *)
      (*---------------------------------------------------------------*)

      IF NOT Win.SetFocus( Win.HWND_DESKTOP, hwnd ) THEN
        Error;
      END;

      REPEAT
        IF ForeColor=15 THEN ForeColor := 1 ELSE INC(ForeColor) END;
      UNTIL ForeColor<>BackColor;

      ChangeBack := FALSE ;
      IF NOT Win.InvalidateRect( hwnd, RECTL(NullVar), B_TRUE ) THEN
        Error;
      END;

   | Win.WM_BUTTON2DOWN:

      (*---------------------------------------------------------------*)
      (* Mouse button 2 has been clicked, so first ensure we have the  *)
      (* input focus and then cycle the background color and cause the *)
      (* the window to be redrawn.                                     *)
      (*---------------------------------------------------------------*)

      IF NOT Win.SetFocus( Win.HWND_DESKTOP, hwnd ) THEN
        Error;
      END;

      REPEAT
        IF BackColor=15 THEN BackColor := 1 ELSE INC(BackColor) END;
      UNTIL ForeColor<>BackColor;
      ChangeBack := TRUE;

      IF NOT Win.InvalidateRect( hwnd, RECTL(NullVar), B_TRUE ) THEN
        Error;
      END;

    | Win.WM_CHAR:

      (*----------------------------------------------------------------*)
      (* Character input is processed here.                             *)
      (* The first two bytes of message parameter 2 contain             *)
      (* the character code.                                            *)
      (*----------------------------------------------------------------*)

      cm := Win.CHARMSG(mp2);
      IF cm.vkey = Win.VK_F3 THEN                        (* If the key pressed is F3,*)
         IF NOT Win.PostMsg( hwnd, Win.WM_QUIT, 0, 0 ) THEN
            Error;
         END;                                            (* post a quit message to   *)
      END;                                               (* end the application.     *)

    | Win.WM_CLOSE:

      (*----------------------------------------------------------------*)
      (* This is the place to put your termination routines             *)
      (*----------------------------------------------------------------*)

      IF NOT Win.PostMsg( hwnd, Win.WM_QUIT, 0, 0 ) THEN  (* Cause termination        *)
        Error;
      END;

    ELSE

      (*----------------------------------------------------------------*)
      (* Everything else comes here.  This call MUST exist              *)
      (* in your window procedure.                                      *)
      (*----------------------------------------------------------------*)

      RETURN Win.DefWindowProc( hwnd, msg, mp1, mp2 );
    END;
    RETURN Win.MPARAM(FALSE);

END WindowProc;
(*# restore *)
(*---------------------  End of window procedure  ----------------------*)

PROCEDURE Main;
VAR
  hmq      : Win.HMQ;
  qmsg     : Win.QMSG;
  client   : HWND;
  frame    : HWND;
  createfl : LSET;
  b        : BOOLEAN;
  r        : Win.MRESULT;

BEGIN
  ForeColor   := Gpi.CLR_BLUE;
  BackColor   := Gpi.CLR_CYAN;
  ChangeBack := TRUE ;
  Hab := Win.Initialize( NULL );        (* Initialize PM                *)
  hmq := Win.CreateMsgQueue( Hab, 0 );  (* Create a message queue       *)

  IF NOT Win.RegisterClass(             (* Register window class        *)
     Hab,                               (* Anchor block handle          *)
     FarADR("MyWindow"),                (* Window class name            *)
     WindowProc,                        (* Address of window procedure  *)
     0,                                 (* No special Class Style       *)
     0                                  (* No extra window words        *)
     ) THEN Error END;

  createfl := Win.FCF_TITLEBAR;         (* Set Frame Control Flag       *)

  frame := Win.CreateStdWindow(
               Win.HWND_DESKTOP,        (* Desktop window is parent     *)
               Win.FS_TASKLIST,         (* Class Style                  *)
               createfl,                (* Frame control flag           *)
               FarADR("MyWindow"),      (* Client window class name     *)
               ', TopSpeed Demo',       (* Title                     *)
               0,                       (* No special class style       *)
               NULL,                    (* Resource is in .EXE file     *)
               WindowId,                (* Frame window identifier      *)
               client                   (* Client window handle         *)
               );

  IF NOT Win.SetWindowPos( frame,       (* Set the size and position of *)
                   Win.HWND_TOP,        (* the window before showing.   *)
                   100, 60, 350, 260,
                   Win.SWP_SIZE+Win.SWP_MOVE+Win.SWP_ACTIVATE+Win.SWP_SHOW
                 ) THEN Error END;

(*----------------------------------------------------------------------*)
(* Get and dispatch messages from the application message queue         *)
(* until WinGetMsg returns FALSE, indicating a WM_QUIT message.         *)
(*----------------------------------------------------------------------*)
  WHILE( Win.GetMsg( Hab, qmsg, HWND(NULL), 0, 0 ) ) DO
    r := Win.DispatchMsg( Hab, qmsg );
  END;

  IF NOT Win.DestroyWindow( frame ) THEN      (* Tidy up...                   *)
    Error;
  END;
  IF NOT Win.DestroyMsgQueue( hmq ) THEN      (* and                          *)
    Error;
  END;
  IF NOT Win.Terminate( Hab ) THEN            (* terminate the application    *)
    Error;
  END;

END Main;
(*----------------------  End of main procedure  -----------------------*)

BEGIN
  Main;
END PMJP.