58?^2a<.<5Lb{$X-}
PROGRAM QDSample;

  { QDSample -- Macintosh adaptation of Lisa QuickDraw example. }
  { by Paul Zemlin, Macintosh Technical Support                 }

   USES {$U-}
      {$U Obj/Memtypes    } Memtypes,
      {$U Obj/QuickDraw   } QuickDraw,
      {$U Obj/OSIntf      } OSIntf,
      {$U Obj/ToolIntf    } ToolIntf;

TYPE  IconData = ARRAY[0..95] OF INTEGER;

   CONST
      lastMenu = 2;   { number of menus }
      appleMenu = 1;  { menu ID for desk accessory menu }
      fileMenu = 256; { menu ID for File menu }

   VAR
      myMenus                           : ARRAY [1..lastMenu] OF MenuHandle;
      dragRect ,prect, growrect         : Rect;
      doneFlag,temp                     : BOOLEAN;
      myEvent                           : EventRecord;
      code, refNum, MyControl,t         : INTEGER;
      theMenu, theItem, whichIcon       : INTEGER;
      scale                             : INTEGER;
      wRecord                           : WindowRecord;
      theWindow, whichWindow            : WindowPtr;
      icons                             : ARRAY[0..5] OF IconData;
      hScroll, vScroll, whichControl    : ControlHandle;
      theOrigin                         : Point;
      theUpdateRgn                      : RgnHandle;


   PROCEDURE InitIcons;
   { Manually stuff some icons.  Normally we would read them from a file }
   BEGIN
     { Lisa }
     StuffHex(@icons[0, 0],'000000000000000000000000000000000000001FFFFFFFFC');
     StuffHex(@icons[0,12],'00600000000601800000000B0600000000130FFFFFFFFFA3');
     StuffHex(@icons[0,24],'18000000004311FFFFF00023120000080F231200000BF923');
     StuffHex(@icons[0,36],'120000080F23120000080023120000080023120000080F23');
     StuffHex(@icons[0,48],'1200000BF923120000080F2312000008002311FFFFF00023');
     StuffHex(@icons[0,60],'08000000004307FFFFFFFFA30100000000260FFFFFFFFE2C');
     StuffHex(@icons[0,72],'18000000013832AAAAA8A9F0655555515380C2AAAA82A580');
     StuffHex(@icons[0,84],'800000000980FFFFFFFFF300800000001600FFFFFFFFFC00');

     { Printer }
     StuffHex(@icons[1, 0],'000000000000000000000000000000000000000000000000');
     StuffHex(@icons[1,12],'00000000000000007FFFFF00000080000280000111514440');
     StuffHex(@icons[1,24],'0002000008400004454510400004000017C00004A5151000');
     StuffHex(@icons[1,36],'0004000010000004A54510000004000017FE00F4A5151003');
     StuffHex(@icons[1,48],'0184000013870327FFFFF10F06400000021B0CFFFFFFFC37');
     StuffHex(@icons[1,60],'18000000006B3000000000D77FFFFFFFFFABC00000000356');
     StuffHex(@icons[1,72],'8000000001AC87F000000158841000CCC1B087F000CCC160');
     StuffHex(@icons[1,84],'8000000001C0C000000003807FFFFFFFFF0007800001E000');

     { Trash Can }
     StuffHex(@icons[2, 0],'000001FC000000000E0600000000300300000000C0918000');
     StuffHex(@icons[2,12],'00013849800000026C4980000004C0930000000861260000');
     StuffHex(@icons[2,24],'0010064FE0000031199830000020E6301800002418E00800');
     StuffHex(@icons[2,36],'0033E3801C0000180E002C00000FF801CC0000047FFE0C00');
     StuffHex(@icons[2,48],'000500004C000005259A4C000005250A4C00000525FA4C00');
     StuffHex(@icons[2,60],'000524024C00000524924C00600524924C0090E524924C7C');
     StuffHex(@icons[2,72],'932524924C82A44524924D01C88524924CF10C4524924C09');
     StuffHex(@icons[2,84],'0784249258E70003049233100000E000E40800001FFFC3F0');

     { tray }
     StuffHex(@icons[3, 0],'000000000000000000000000000000000000000000000000');
     StuffHex(@icons[3,12],'0000000000000000000000000000000000000007FFFFFFF0');
     StuffHex(@icons[3,24],'000E00000018001A00000038003600000078006A000000D8');
     StuffHex(@icons[3,36],'00D7FFFFFFB801AC000003580358000006B807FC000FFD58');
     StuffHex(@icons[3,48],'040600180AB80403FFF00D58040000000AB8040000000D58');
     StuffHex(@icons[3,60],'040000000AB807FFFFFFFD5806AC00000AB8055800000D58');
     StuffHex(@icons[3,72],'06B000000AB807FC000FFD70040600180AE00403FFF00DC0');
     StuffHex(@icons[3,84],'040000000B80040000000F00040000000E0007FFFFFFFC00');

     { File Cabinet }
     StuffHex(@icons[4, 0],'0007FFFFFC00000800000C00001000001C00002000003400');
     StuffHex(@icons[4,12],'004000006C0000FFFFFFD40000800000AC0000BFFFFED400');
     StuffHex(@icons[4,24],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
     StuffHex(@icons[4,36],'00A00002AC0000A08082D40000A0FF82AC0000A00002D400');
     StuffHex(@icons[4,48],'00A00002AC0000BFFFFED40000800000AC0000BFFFFED400');
     StuffHex(@icons[4,60],'00A00002AC0000A07F02D40000A04102AC0000A07F02D400');
     StuffHex(@icons[4,72],'00A00002AC0000A08082D40000A0FF82AC0000A00002D800');
     StuffHex(@icons[4,84],'00A00002B00000BFFFFEE00000800000C00000FFFFFF8000');

     { drawer }
     StuffHex(@icons[5, 0],'000000000000000000000000000000000000000000000000');
     StuffHex(@icons[5,12],'000000000000000000000000000000000000000000000000');
     StuffHex(@icons[5,24],'000000000000000000000000000000000000000000000000');
     StuffHex(@icons[5,36],'00000000000000000000000000000000000000001FFFFFF0');
     StuffHex(@icons[5,48],'0000380000300000680000700000D80000D0003FFFFFF1B0');
     StuffHex(@icons[5,60],'0020000013500020000016B000201FE01D50002010201AB0');
     StuffHex(@icons[5,72],'00201FE01560002000001AC0002000001580002020101B00');
     StuffHex(@icons[5,84],'00203FF01600002000001C00002000001800003FFFFFF000');

   END;


   PROCEDURE DrawIcon(whichIcon,h,v: INTEGER);  {DrawAnIcon => DrawIcon}
   VAR
       srcBits           : BitMap;
       srcRect, dstRect  : Rect;

   BEGIN
     srcBits.baseAddr:=@icons[whichIcon];
     srcBits.rowBytes:=6;
     SetRect(srcBits.bounds,0,0,48,32);
     srcRect:=srcBits.bounds;
     dstRect:=srcRect;
     OffsetRect(dstRect,h,v);
     CopyBits(srcBits,theWindow^.portBits,srcRect,dstRect,srcOr,Nil);
   END;


   PROCEDURE DrawStuff;
   VAR i: INTEGER;
       tempRect   : Rect;
       myPoly     : PolyHandle;
       myRgn      : RgnHandle;
       myPattern  : Pattern;

   BEGIN

     StuffHex(@myPattern,'8040200002040800');

     { draw two horizontal lines across the top }
     MoveTo(0,18);
     LineTo(719,18);
     MoveTo(0,20);
     LineTo(719,20);

     { draw divider lines }
     MoveTo(0,134);
     LineTo(719,134);
     MoveTo(0,248);
     LineTo(719,248);
     MoveTo(240,21);
     LineTo(240,363);
     MoveTo(480,21);
     LineTo(480,363);

     { draw title }
     TextFont(0);
     MoveTo(210,14);
     DrawString('Look what you can draw with QuickDraw');



     {---------  draw text samples --------- }

     MoveTo(80,34);  DrawString('Text');

     TextFace([bold]);
     MoveTo(70,55);  DrawString('Bold');

     TextFace([italic]);
     MoveTo(70,70); DrawString('Italic');

     TextFace([underline]);
     MoveTo(70,85); DrawString('Underline');

     TextFace([outline]);
     MoveTo(70,100); DrawString('Outline');

     TextFace([shadow]);
     MoveTo(70,115); DrawString('Shadow');

     TextFace([]);   { restore to normal }



     { --------- draw line samples --------- }

     MoveTo(330,34);  DrawString('Lines');

     MoveTo(280,25);  Line(160,40);

     PenSize(3,2);
     MoveTo(280,35);  Line(160,40);

     PenSize(6,4);
     MoveTo(280,46);  Line(160,40);

     PenSize(12,8);
     PenPat(gray);
     MoveTo(280,61); Line(160,40);

     PenSize(15,10);
     PenPat(myPattern);
     MoveTo(280,80); Line(160,40);
     PenNormal;



     { --------- draw rectangle samples --------- }

     MoveTo(560,34);  DrawString('Rectangles');

     SetRect(tempRect,510,40,570,70);
     FrameRect(tempRect);

     OffsetRect(tempRect,25,15);
     PenSize(3,2);
     EraseRect(tempRect);
     FrameRect(tempRect);

     OffsetRect(tempRect,25,15);
     PaintRect(tempRect);

     OffsetRect(tempRect,25,15);
     PenNormal;
     FillRect(tempRect,gray);
     FrameRect(tempRect);

     OffsetRect(tempRect,25,15);
     FillRect(tempRect,myPattern);
     FrameRect(tempRect);


     { --------- draw roundRect samples --------- }

     MoveTo(70,148);  DrawString('RoundRects');

     SetRect(tempRect,30,150,90,180);
     FrameRoundRect(tempRect,30,20);

     OffsetRect(tempRect,25,15);
     PenSize(3,2);
     EraseRoundRect(tempRect,30,20);
     FrameRoundRect(tempRect,30,20);

     OffsetRect(tempRect,25,15);
     PaintRoundRect(tempRect,30,20);

     OffsetRect(tempRect,25,15);
     PenNormal;
     FillRoundRect(tempRect,30,20,gray);
     FrameRoundRect(tempRect,30,20);

     OffsetRect(tempRect,25,15);
     FillRoundRect(tempRect,30,20,myPattern);
     FrameRoundRect(tempRect,30,20);


     { --------- draw bitmap samples --------- }

     MoveTo(320,148);  DrawString('BitMaps');

     DrawIcon(0,266,156);
     DrawIcon(1,336,156);
     DrawIcon(2,406,156);
     DrawIcon(3,266,196);
     DrawIcon(4,336,196);
     DrawIcon(5,406,196);


     { --------- draw ARC samples --------- }

     MoveTo(570,148);  DrawString('Arcs');

     SetRect(tempRect,520,153,655,243);
     FillArc(tempRect,135,65,dkGray);
     FillArc(tempRect,200,130,myPattern);
     FillArc(tempRect,330,75,gray);
     FrameArc(tempRect,135,270);
     OffsetRect(tempRect,20,0);
     PaintArc(tempRect,45,90);


     { --------- draw polygon samples --------- }

     MoveTo(80,262);  DrawString('Polygons');

     myPoly:=OpenPoly;
       MoveTo(30,290);
       LineTo(30,280);
       LineTo(50,265);
       LineTo(90,265);
       LineTo(80,280);
       LineTo(95,290);
       LineTo(30,290);
     ClosePoly;       { end of definition }

     FramePoly(myPoly);

     OffsetPoly(myPoly,25,15);
     PenSize(3,2);
     ErasePoly(myPoly);
     FramePoly(myPoly);

     OffsetPoly(myPoly,25,15);
     PaintPoly(myPoly);

     OffsetPoly(myPoly,25,15);
     PenNormal;
     FillPoly(myPoly,gray);
     FramePoly(myPoly);

     OffsetPoly(myPoly,25,15);
     FillPoly(myPoly,myPattern);
     FramePoly(myPoly);

     KillPoly(myPoly);


     { --------- demonstrate regions --------- }

     MoveTo(320,262);  DrawString('Regions');

     myRgn:=NewRgn;
     OpenRgn;
       ShowPen;

       SetRect(tempRect,260,270,460,350);
       FrameRoundRect(tempRect,24,16);

       MoveTo(275,335);  { define triangular hole }
       LineTo(325,285);
       LineTo(375,335);
       LineTo(275,335);

       SetRect(tempRect,365,277,445,325);   { oval hole }
       FrameOval(tempRect);

       HidePen;
     CloseRgn(myRgn);       { end of definition }
     DisposeRgn(myRgn);


     { --------- draw oval samples --------- }

     MoveTo(580,262);  DrawString('Ovals');

     SetRect(tempRect,510,264,570,294);
     FrameOval(tempRect);

     OffsetRect(tempRect,25,15);
     PenSize(3,2);
     EraseOval(tempRect);
     FrameOval(tempRect);

     OffsetRect(tempRect,25,15);
     PaintOval(tempRect);

     OffsetRect(tempRect,25,15);
     PenNormal;
     FillOval(tempRect,gray);
     FrameOval(tempRect);

     OffsetRect(tempRect,25,15);
     FillOval(tempRect,myPattern);
     FrameOval(tempRect);

   END;  { DrawStuff }


   PROCEDURE MoveScrollBars;

      BEGIN
         WITH theWindow^.portRect DO
            BEGIN
            HideControl(vScroll);
            MoveControl(vScroll,right-15,top-1);
            SizeControl(vScroll,16,bottom-top-13);
            ShowControl(vScroll);
            HideControl(hScroll);
            MoveControl(hScroll,left-1,bottom-15);
            SizeControl(hScroll,right-left-13,16);
            ShowControl(hScroll)
            END
      END;

   PROCEDURE ResizePRect;

   { pRect is the window's content region, minus the scroll bars }

      BEGIN
         pRect := thePort^.portRect;
         pRect.right := pRect.right-15;
         pRect.bottom := pRect.bottom-15
      END;

   PROCEDURE GrowWnd (whichWindow: WindowPtr);

   { Handles growing and sizing the window and manipulating }
   { the update region. }

      VAR
         longResult: LongInt;
         height,width: INTEGER;
         tRect: Rect;

      BEGIN
         longResult := GrowWindow(whichWindow,myEvent.where,growRect);
         IF longResult=0 THEN EXIT(GrowWnd);
         height := HiWord(longResult); width := LoWord(longResult);

         { Add the old "scroll bar area" to the update region so it will }
         { be redrawn (for when the window is enlarged). }
         tRect := whichWindow^.portRect;
         tRect.left := tRect.right - 16;
         InvalRect(tRect);
         tRect := whichWindow^.portRect;
         tRect.top := tRect.bottom - 16;
         InvalRect(tRect);


         { Now draw the newly sized window. }
         SizeWindow(whichWindow,width,height,TRUE);
         MoveScrollBars;
         ResizePRect;

         { Add the new "scroll bar area" to the update region so it will }
         { be redrawn (for when the window is made smaller). }
         tRect := whichWindow^.portRect; tRect.left := tRect.right-16;
         InvalRect(tRect);
         tRect := whichWindow^.portRect; tRect.top := tRect.bottom-16;
         InvalRect(tRect);
      END; { of GrowWnd }

   PROCEDURE DrawWindow(whichWindow: WindowPtr);
   { Draws the content region of theWindow }

      VAR
         tRect    : Rect;

      BEGIN

         ClipRect (theWindow^.portRect);
         DrawGrowIcon(theWindow);
         IF theWindow = FrontWindow THEN DrawControls(theWindow);

         { Now set up a clip area which excludes the scroll bars }


         tRect := theWindow^.portRect;
         tRect.bottom := tRect.bottom - 16;
         tRect.right := tRect.right - 16;

         {Now compensate for any scrolling which has been done }

         OffsetRect (tRect, theOrigin.h, theOrigin.v);
         ClipRect (tRect);

         { Change the origin to compensate for any scrolling which has been done }

         SetOrigin (theOrigin.h, theOrigin.v);
         DrawStuff;
         SetOrigin (0, 0);
         ClipRect (theWindow^.portRect);  { Reset the clip area }
       END; { of DrawWindow }

   PROCEDURE ScrollBits;

      VAR
         oldOrigin   : point;
         dh,dv       : INTEGER;
         tRect       : Rect;

      BEGIN
            oldOrigin := theOrigin;
            theOrigin.h := 4 * GetCtlValue(hScroll);
            theOrigin.v := 4 * GetCtlValue(vScroll);
            dh := oldOrigin.h - theOrigin.h;
            dv := oldOrigin.v - theOrigin.v;
            theUpdateRgn := NewRgn;
            ScrollRect (pRect, dh, dv, theUpdateRgn);

            { Have scrolled in junk...need to redraw }

            SetOrigin (theOrigin.h, theOrigin.v);
            OffsetRect (theUpdateRgn^^.rgnBBox, theOrigin.h, theOrigin.v);
            ClipRect (theUpdateRgn^^.rgnBBox);
            DrawStuff;
            DisposeRgn (theUpdateRgn);
            SetOrigin (0, 0);
            ClipRect (theWindow^.portRect);
      END;

   PROCEDURE ScrollUp(whichControl: ControlHandle; theCode: INTEGER);

      BEGIN
         IF theCode=inUpButton THEN
            BEGIN
            SetCtlValue(whichControl,GetCtlValue(whichControl)-1);
            ScrollBits
            END
      END;

   PROCEDURE ScrollDown(whichControl: ControlHandle; theCode: INTEGER);

      BEGIN
         IF theCode=inDownButton THEN
            BEGIN
            SetCtlValue(whichControl,GetCtlValue(whichControl)+1);
            ScrollBits
            END
      END;

   PROCEDURE PageScroll(code,amount: INTEGER);

      VAR
         myPt: point;

      BEGIN
         REPEAT
            GetMouse(myPt);
            IF TestControl(whichControl,myPt)=code THEN
               BEGIN
               SetCtlValue(whichControl,GetCtlValue(whichControl)+amount);
               ScrollBits
               END
         UNTIL NOT StillDown;
      END;

   PROCEDURE SetUpMenus;
   { Once-only initialization for menus }

      VAR
         i: INTEGER;

      BEGIN
         InitMenus; { initialize Menu Manager }
         myMenus[1] := GetMenu(appleMenu);
         AddResMenu(myMenus[1],'DRVR'); { desk accessories }
         myMenus[2] := GetMenu(fileMenu);
         FOR i := 1 TO lastMenu DO InsertMenu(myMenus[i],0);
         DrawMenuBar;
      END; { of SetUpMenus }


   PROCEDURE DoCommand(mResult: LongInt);

      VAR
         name: STR255;

      BEGIN
         theMenu := HiWord(mResult); theItem := LoWord(mResult);
         CASE theMenu OF

            appleMenu:
               BEGIN
               GetItem(myMenus[1],theItem,name);
               refNum := OpenDeskAcc(name);
               END;

            fileMenu: doneFlag := TRUE; { Quit }


         END; { of menu case }

         HiliteMenu(0);

      END; { of DoCommand }

   BEGIN { main program }
      InitGraf(@thePort);
      InitFonts;
      FlushEvents(everyEvent,0);
      InitWindows;
      SetUpMenus;
      InitDialogs(NIL);
      SetCursor(arrow);
      SetRect(dragRect,4,24,508,338);
      SetRect(growRect,100,60,512,302);
      doneFlag := FALSE;
      InitCursor;
      InitIcons;

      theWindow := GetNewWindow(256,@wRecord,POINTER(-1));
      SetPort(theWindow);
      theWindow^.txFont := 2;

      ResizePRect;

      vScroll := GetNewControl(256,theWindow);
      hScroll := GetNewControl(257,theWindow);
      theOrigin.h := 0; theOrigin.v := 0;


      REPEAT
         SystemTask;
         temp := GetNextEvent(everyEvent,myEvent);
         CASE myEvent.what OF

            mouseDown:
               BEGIN
               code := FindWindow(myEvent.where,whichWindow);
               CASE code OF

                  inMenuBar: DoCommand(MenuSelect(myEvent.where));

                  inSysWindow: SystemClick(myEvent,whichWindow);

                  inDrag: DragWindow(whichWindow,myEvent.where,dragRect);

                  inGoAway:
                     IF TrackGoAway(whichWindow,myEvent.where) THEN
                        doneFlag := TRUE;

                  inGrow:
                     IF whichWindow=FrontWindow THEN
                        GrowWnd(whichWindow)
                     ELSE
                        SelectWindow(whichWindow);

                  inContent:
                     BEGIN
                     IF whichWindow<>FrontWindow THEN
                        SelectWindow(whichWindow)
                     ELSE
                        BEGIN {front}
                        GlobalToLocal(myEvent.where);
                        IF  NOT PtInRect(myEvent.where,pRect) THEN
                           BEGIN {controls}
                           MyControl := FindControl(myEvent.where,whichWindow,
                                                    whichControl);
                           CASE MyControl OF
                              inUpButton:
                                 t := TrackControl(whichControl,myEvent.where,
                                                   @ScrollUp);
                              inDownButton:
                                 t := TrackControl(whichControl,myEvent.where,
                                                   @ScrollDown);
                              inPageUP: PageScroll(MyControl,-10);
                              inPageDown: PageScroll(MyControl,10);
                              inThumb:
                                 BEGIN
                                 t := TrackControl(whichControl,myEvent.where,
                                      NIL);
                                 ScrollBits
                                 END
                           END {Case MyControl}
                           END {controls}
                        END {front}
                     END {in Content}
               END; { of code case }
               END; { of mouseDown }

            activateEvt:
               BEGIN
               SetPort (theWindow);
               DrawGrowIcon(theWindow);
               IF ODD(myEvent.modifiers) THEN { window is becoming active }
                  BEGIN
                  ShowControl(vScroll);
                  ShowControl(hScroll);
                  END
               ELSE
                  BEGIN
                  HideControl(vScroll);
                  HideControl(hScroll)
                  END
               END; { of activateEvt }

            updateEvt:
               BEGIN
               BeginUpdate(theWindow);
               EraseRect (theWindow^.portRect);
               DrawWindow(theWindow);
               EndUpdate(theWindow);
               END { of updateEvt }

         END { of event case }

      UNTIL doneFlag
   END.
