home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / e / amigae / rkrmsrc / intuition / windows / lines.e next >
Text File  |  1995-03-31  |  11KB  |  295 lines
  1. -> lines.e -- implements a superbitmap with scroll gadgets
  2. -> This program requires V37, as it uses calls to OpenWindowTags(),
  3. -> LockPubScreen().
  4.  
  5. OPT PREPROCESS  -> E-Note: enable use of macros
  6.  
  7. MODULE 'layers',  -> We are going to use the Layers library
  8.        'intuition/intuition', -> Intuition data structures and tags
  9.        'intuition/screens',   -> Screen data structures and tags
  10.        'graphics/rastport',   -> RastPort and other structures
  11.        'graphics/clip',       -> Layer and other structures
  12.        'graphics/gfx',        -> BitMap and other structures
  13.        'graphics/text',       -> TextFont and other structures
  14.        'exec/memory'          -> Memory flags
  15.  
  16. ENUM ERR_NONE, ERR_LIB, ERR_KICK, ERR_PUB, ERR_RAST, ERR_WIN
  17.  
  18. RAISE ERR_LIB  IF OpenLibrary()=NIL,
  19.       ERR_PUB  IF LockPubScreen()=NIL,
  20.       ERR_RAST IF AllocRaster()=NIL,
  21.       ERR_WIN  IF OpenWindowTagList()=NIL
  22.  
  23. CONST WIDTH_SUPER=800, HEIGHT_SUPER=600,
  24.       UP_DOWN_GADGET=0, LEFT_RIGHT_GADGET=1, NO_GADGET=2
  25. -> E-Note: MAXPOT and MAXBODY should be used instead of MAXPROPVAL
  26.  
  27. #define LAYERXOFFSET(x) (x.rport.layer.scroll_x)
  28. #define LAYERYOFFSET(x) (x.rport.layer.scroll_y)
  29.  
  30. -> E-Note: need objects like botGad to be zeroed, so use pointers here
  31. DEF win=NIL:PTR TO window, botGadInfo=NIL:PTR TO propinfo,
  32.     botGadImage=NIL:PTR TO image, botGad=NIL:PTR TO gadget,
  33.     sideGadInfo=NIL:PTR TO propinfo, sideGadImage=NIL:PTR TO image,
  34.     sideGad=NIL:PTR TO gadget
  35.  
  36. PROC main() HANDLE
  37.   DEF myscreen=NIL
  38.   IF KickVersion(37)=FALSE THEN Raise(ERR_KICK)
  39.  
  40.   -> E-Note: E automatically opens the Intuition and Graphics libraries
  41.   -> Open the Layers library for the program.
  42.   -> E-Note: automatically error-checked (automatic exception)
  43.   layersbase:=OpenLibrary('layers.library', 33)
  44.  
  45.   -> LockPubScreen()/UnlockPubScreen is only available under V36 and later.  Use
  46.   -> GetScreenData() under V34 systems to get a copy of the screen structure...
  47.   -> E-Note: automatically error-checked (automatic exception)
  48.   myscreen:=LockPubScreen(NIL)
  49.  
  50.   superWindow(myscreen)
  51.  
  52.   -> E-Note: exit and clean up via handler
  53. EXCEPT DO
  54.   IF myscreen THEN UnlockPubScreen(NIL, myscreen)
  55.   IF layersbase THEN CloseLibrary(layersbase)
  56.   -> E-Note: we can print a minimal error message
  57.   SELECT exception
  58.   CASE ERR_KICK; WriteF('Error: Needs Kickstart V37+\n')
  59.   CASE ERR_LIB;  WriteF('Error: Could not open layers.library\n')
  60.   CASE ERR_PUB;  WriteF('Error: Could not lock public screen\n')
  61.   CASE ERR_RAST; WriteF('Error: Ran out of memory in AllocRaster\n')
  62.   CASE ERR_WIN;  WriteF('Error: Failed to open window\n')
  63.   CASE "MEM";    WriteF('Error: Ran out of memory\n')
  64.   ENDSELECT
  65. ENDPROC
  66.  
  67. -> A string with this format will be found by the version command supplied by
  68. -> Commodore.  This will allow users to give version numbers with error reports.
  69. -> E-Note: labels can only be used after the first PROC line...
  70. vers: CHAR '$VER: lines 37.2',0
  71.  
  72. -> Create, initialise and process the super bitmap window. Cleanup if any error.
  73. PROC superWindow(myscreen:PTR TO screen) HANDLE
  74.   DEF bigBitMap=NIL:PTR TO bitmap, planeNum, mydepth
  75.  
  76.   -> Set-up the border prop gadgets for the OpenWindow() call.
  77.   initBorderProps(myscreen)
  78.  
  79.   -> The code relies on the allocation of the BitMap structure with the
  80.   -> MEMF_CLEAR flag.  This allows the assumption that all of the bitmap
  81.   -> pointers are NIL, except those successfully allocated by the program.
  82.   -> E-Note: NewM raises an exception if it fails
  83.   bigBitMap:=NewM(SIZEOF bitmap, MEMF_PUBLIC OR MEMF_CLEAR)
  84.  
  85.   mydepth:=myscreen.bitmap.depth
  86.   InitBitMap(bigBitMap, mydepth, WIDTH_SUPER, HEIGHT_SUPER)
  87.  
  88.   -> E-Note: we handle errors with exceptions
  89.   FOR planeNum:=0 TO mydepth-1
  90.     bigBitMap.planes[planeNum]:=AllocRaster(WIDTH_SUPER, HEIGHT_SUPER)
  91.   ENDFOR
  92.  
  93.   -> Only open the window if the bitplanes were successfully allocated.  Fail
  94.   -> via exception if they were not.
  95.  
  96.   -> OpenWindowTags() and OpenWindowTagList() are only available when the
  97.   -> library version is at least V36.  Under earlier versions of Intuition, use
  98.   -> OpenWindow() with a NewWindow structure.
  99.   win:=OpenWindowTagList(NIL,
  100.        [WA_WIDTH,  150,
  101.         WA_HEIGHT, (4*(myscreen.wbortop+myscreen.font.ysize+1)),
  102.         WA_MAXWIDTH,  WIDTH_SUPER,
  103.         WA_MAXHEIGHT, HEIGHT_SUPER,
  104.         WA_IDCMP, IDCMP_GADGETUP OR IDCMP_GADGETDOWN OR
  105.                   IDCMP_NEWSIZE  OR IDCMP_INTUITICKS OR IDCMP_CLOSEWINDOW,
  106.         WA_FLAGS, WFLG_SIZEGADGET OR WFLG_SIZEBRIGHT  OR WFLG_SIZEBBOTTOM OR
  107.                   WFLG_DRAGBAR    OR WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR
  108.                   WFLG_SUPER_BITMAP OR WFLG_GIMMEZEROZERO OR WFLG_NOCAREREFRESH,
  109.         WA_GADGETS,     sideGad,
  110.         WA_TITLE,       {vers}+6,  -> Take title from version string
  111.         WA_PUBSCREEN,   myscreen,
  112.         WA_SUPERBITMAP, bigBitMap,
  113.         NIL])
  114.  
  115.   -> Set-up the window display
  116.   SetRast(win.rport, 0)  -> Clear the bitplanes
  117.   SetDrMd(win.rport, RP_JAM1)
  118.  
  119.   doNewSize()  -> Adjust props to represent portion visible
  120.   doDrawStuff()
  121.  
  122.   -> Process the window, return on IDCMP_CLOSEWINDOW
  123.   doMsgLoop()
  124.  
  125.   -> E-Note: exit and clean up via handler
  126. EXCEPT DO
  127.   IF win THEN CloseWindow(win)
  128.   IF bigBitMap
  129.     FOR planeNum:=0 TO mydepth-1
  130.       -> Free only the bitplanes actually allocated...
  131.       IF bigBitMap.planes[planeNum]
  132.         FreeRaster(bigBitMap.planes[planeNum], WIDTH_SUPER, HEIGHT_SUPER)
  133.       ENDIF
  134.     ENDFOR
  135.     Dispose(bigBitMap)
  136.   ENDIF
  137.   ReThrow()  -> E-Note: pass exception on if it was an error
  138. ENDPROC
  139.  
  140. -> Set-up the prop gadgets -- initialise them to values that fit into the
  141. -> window border.  The height of the prop gadget on the side of the window
  142. -> takes the height of the title bar into account in its set-up.  Note the
  143. -> initialisation assumes a fixed size "sizing" gadget.
  144. ->
  145. -> Note also, that the size of the sizing gadget is dependent on the screen
  146. -> resolution.  The numbers given here are only valid if the screen is NOT
  147. -> lo-res.  These values must be re-worked slightly for lo-res screens.
  148. ->
  149. -> The PROPNEWLOOK flag is ignored by 1.3.
  150. PROC initBorderProps(myscreen:PTR TO screen)
  151.   DEF top  -> E-Note: temp variable for top calc
  152.   -> Initialises the two prop gadgets.
  153.   ->
  154.   -> Note where the PROPNEWLOOK flag goes.  Adding this flag requires no extra
  155.   -> storage, but tells the system that our program is expecting the new-look
  156.   -> prop gadgets under 2.0.
  157.   -> E-Note: we initialise using typed lists and NEW, so that we do not need
  158.   ->         to fill in every field (NEW will zero the trailing ones).
  159.   ->         Without NEW only a partial structure would be allocated...
  160.   -> E-Note: allocate zeroed images
  161.   NEW botGadImage, sideGadImage
  162.  
  163.   botGadInfo:=NEW [AUTOKNOB OR FREEHORIZ OR PROPNEWLOOK,
  164.                    0, 0, -1, -1]:propinfo
  165.  
  166.   botGad:=NEW [NIL, 3, -7, -23, 6,
  167.                GFLG_RELBOTTOM OR GFLG_RELWIDTH,
  168.                GACT_RELVERIFY OR GACT_IMMEDIATE OR GACT_BOTTOMBORDER,
  169.                GTYP_PROPGADGET OR GTYP_GZZGADGET,
  170.                botGadImage, NIL, NIL, NIL,
  171.                botGadInfo, LEFT_RIGHT_GADGET]:gadget
  172.  
  173.   sideGadInfo:=NEW [AUTOKNOB OR FREEVERT OR PROPNEWLOOK,
  174.                     0, 0, -1, -1]:propinfo
  175.  
  176.   -> NOTE the TopEdge adjustment for the border and the font for V36.
  177.   top:=myscreen.wbortop+myscreen.font.ysize+2
  178.   sideGad:=NEW [botGad, -14, top, 12, -top-11,
  179.                 GFLG_RELRIGHT OR GFLG_RELHEIGHT,
  180.                 GACT_RELVERIFY OR GACT_IMMEDIATE OR GACT_RIGHTBORDER,
  181.                 GTYP_PROPGADGET OR GTYP_GZZGADGET,
  182.                 sideGadImage, NIL, NIL, NIL,
  183.                 sideGadInfo, UP_DOWN_GADGET]:gadget
  184. ENDPROC
  185.  
  186. -> This function does all the work of drawing the lines
  187. PROC doDrawStuff()
  188.   DEF x1, y1, x2, y2, pen, ncolors, deltx, delty
  189.  
  190.   ncolors:=Shl(1, win.wscreen.bitmap.depth)
  191.   -> E-Note: Rnd could be seeded using VbeamPos...
  192.   deltx:=Rnd(6)+2
  193.   delty:=Rnd(6)+2
  194.  
  195.   pen:=Rnd(ncolors-1)+1
  196.   SetAPen(win.rport, pen)
  197.   x1:=0; y1:=0; x2:=WIDTH_SUPER-1; y2:=HEIGHT_SUPER-1
  198.   WHILE x1 < WIDTH_SUPER
  199.     Move(win.rport, x1, y1)
  200.     Draw(win.rport, x2, y2)
  201.     x1:=x1+deltx
  202.     x2:=x2-deltx
  203.   ENDWHILE
  204.  
  205.   pen:=Rnd(ncolors-1)+1
  206.   SetAPen(win.rport, pen)
  207.   x1:=0; y1:=0; x2:=WIDTH_SUPER-1; y2:=