home *** CD-ROM | disk | FTP | other *** search
/ Amiga MA Magazine 1998 #6 / amigamamagazinepolishissue1998.iso / coders / jËzyki_programowania / amigae / e_v3.2a / rkrmsrc / intuition / windows / lines.e next >
Text File  |  1977-12-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:=HEIGHT_SUPER-1
  208.   WHILE y1 < HEIGHT_SUPER
  209.     Move(win.rport, x1, y1)
  210.     Draw(win.rport, x2, y2)
  211.     y1:=y1+delty
  212.     y2:=y2-delty
  213.   ENDWHILE
  214. ENDPROC
  215.  
  216. -> This function provides a simple interface to ScrollLayer
  217. PROC slideBitMap(dx, dy)
  218.   ScrollLayer(0, win.rport.layer, dx, dy)
  219. ENDPROC
  220.  
  221. -> E-Note: define macros to compute fraction of Pot and Body
  222. -> E-Note: use Mul() and Div() since definitely over 16-bits
  223. #define FRACTIONPOT(n,d)  (Div(Mul(n, MAXPOT), d))
  224. #define FRACTIONBODY(n,d) (Div(Mul(n, MAXBODY), d))
  225.  
  226. -> Update the prop gadgets and bitmap positioning when the size changes.
  227. PROC doNewSize()
  228.   DEF tmp
  229.   tmp:=LAYERXOFFSET(win) + win.gzzwidth
  230.   IF tmp>=WIDTH_SUPER THEN slideBitMap(WIDTH_SUPER-tmp, 0)
  231.  
  232.   NewModifyProp(botGad, win, NIL, AUTOKNOB OR FREEHORIZ,
  233.       FRACTIONPOT(LAYERXOFFSET(win), WIDTH_SUPER - win.gzzwidth),
  234.       NIL,
  235.       FRACTIONBODY(win.gzzwidth, WIDTH_SUPER),
  236.       MAXBODY,
  237.       1)
  238.  
  239.   tmp:=LAYERYOFFSET(win) + win.gzzheight
  240.   IF tmp>=HEIGHT_SUPER THEN slideBitMap(0, HEIGHT_SUPER-tmp)
  241.  
  242.   NewModifyProp(sideGad, win, NIL, AUTOKNOB OR FREEVERT,
  243.       NIL,
  244.       FRACTIONPOT(LAYERYOFFSET(win), HEIGHT_SUPER - win.gzzheight),
  245.       MAXBODY,
  246.       FRACTIONBODY(win.gzzheight, HEIGHT_SUPER),
  247.       1)
  248. ENDPROC
  249.  
  250. -> E-Note: convert signed INT from a Pot to unsigned for calculations
  251. #define UNSIGNED(x) (x AND $FFFF)
  252. -> E-Note: define macro to compute layer offset from Pot value
  253. -> E-Note: use Mul() and Div() since definitely over 16-bits
  254. #define CALCOFFSET(size, pot) (Div(Mul(size, UNSIGNED(pot)), MAXPOT))
  255.  
  256. -> Process the currently selected gadget.  This is called from IDCMP_INTUITICKS
  257. -> and when the gadget is released IDCMP_GADGETUP.
  258. PROC checkGadget(gadgetID)
  259.   DEF tmp, dx=0, dy=0
  260.  
  261.   SELECT gadgetID
  262.   CASE UP_DOWN_GADGET
  263.     tmp:=CALCOFFSET(HEIGHT_SUPER-win.gzzheight, sideGadInfo.vertpot)
  264.     dy:=tmp - LAYERYOFFSET(win)
  265.   CASE LEFT_RIGHT_GADGET
  266.     tmp:=CALCOFFSET(WIDTH_SUPER-win.gzzwidth, botGadInfo.horizpot)
  267.     dx:=tmp - LAYERXOFFSET(win)
  268.   ENDSELECT
  269.  
  270.   IF dx OR dy THEN slideBitMap(dx, dy)
  271. ENDPROC
  272.  
  273. -> Main message loop for the window.
  274. -> E-Note: E version is simpler, since we use WaitIMessage
  275. PROC doMsgLoop()
  276.   DEF class, currentGadget=NO_GADGET, g:PTR TO gadget
  277.   -> E-Note: g is used to cast the type of MsgIaddr()
  278.   REPEAT
  279.     class:=WaitIMessage(win)
  280.     SELECT class
  281.     CASE IDCMP_NEWSIZE
  282.       doNewSize()
  283.       doDrawStuff()
  284.     CASE IDCMP_GADGETDOWN
  285.       g:=MsgIaddr()
  286.       currentGadget:=g.gadgetid
  287.     CASE IDCMP_GADGETUP
  288.       checkGadget(currentGadget)
  289.       currentGadget:=NO_GADGET
  290.     CASE IDCMP_INTUITICKS
  291.       checkGadget(currentGadget)
  292.     ENDSELECT
  293.   UNTIL class=IDCMP_CLOSEWINDOW
  294. ENDPROC
  295.