home *** CD-ROM | disk | FTP | other *** search
/ Dream 57 / Amiga_Dream_57.iso / Amiga / Programmation / e / Exemples / BoopsiExamples.lha / BoopsiExamples / ScrollerWindow.e < prev    next >
Encoding:
Text File  |  1992-09-02  |  9.5 KB  |  302 lines
  1. /* ScrollerWindow.e
  2.  
  3.    Translated by Wouter from excellent example scrollerwindow.c
  4.    by Christoph Feck, TowerSystems (feck@informatik.uni-kl.de)
  5.  
  6.    needs E v2.1b_v39 with fixed icclass.m to compile
  7.  
  8. */
  9.  
  10. MODULE 'exec/memory', 'exec/libraries', 'utility', 'utility/tagitem',
  11.        'intuition/intuition', 'intuition/imageclass', 'intuition/screens',
  12.        'intuition/classes', 'intuition/icclass', 'intuition/gadgetclass',
  13.        'intuition/imageclass',
  14.        'graphics/gfx', 'graphics/text', 'graphics/rastport'
  15.  
  16. DEF screen:PTR TO screen,dri:PTR TO drawinfo,v39,bitmap:PTR TO bitmap
  17.  
  18. DEF horizgadget:PTR TO object,vertgadget:PTR TO object,
  19.     leftgadget:PTR TO object,rightgadget:PTR TO object,
  20.     upgadget:PTR TO object,downgadget:PTR TO object
  21.  
  22. ENUM HORIZ_GID=1,VERT_GID,LEFT_GID,RIGHT_GID,UP_GID,DOWN_GID
  23.  
  24. DEF window:PTR TO window
  25.  
  26. /* these are actually PTR TO object too */
  27.  
  28. DEF sizeimage:PTR TO image,leftimage:PTR TO image,rightimage:PTR TO image,
  29.     upimage:PTR TO image,downimage:PTR TO image
  30.  
  31. DEF htotal,vtotal,hvisible,vvisible
  32.  
  33. PROC max(x,y) RETURN IF x>y THEN x ELSE y
  34. PROC min(x,y) RETURN IF x<y THEN x ELSE y
  35. PROC rassize(w,h) RETURN Shr(w+15,3) AND $FFFE * h
  36.  
  37. PROC createbitmap(width,height,depth,flags,friend:PTR TO bitmap)
  38.   DEF bm:PTR TO bitmap,memflags,pl:PTR TO LONG,i
  39.   IF v39
  40.     bm:=AllocBitMap(width,height,depth,flags,friend)
  41.   ELSE
  42.     memflags:=MEMF_CHIP
  43.     IF bm:=New(SIZEOF bitmap)
  44.       InitBitMap(bm,depth,width,height)
  45.       pl:=bm.planes
  46.       IF flags AND BMF_CLEAR THEN memflags:=memflags OR MEMF_CLEAR
  47.       pl[0]:=AllocVec(depth*rassize(width,height),memflags)
  48.       IF pl[0]
  49.         FOR i:=1 TO depth-1 DO pl[i]:=pl[i-1]+rassize(width,height)
  50.       ELSE
  51.         Dispose(bm)
  52.         bm:=NIL
  53.       ENDIF
  54.     ENDIF
  55.   ENDIF
  56. ENDPROC bm
  57.  
  58. PROC deletebitmap(bm:PTR TO bitmap)
  59.   IF bm
  60.     IF v39
  61.       FreeBitMap(bm)
  62.      ELSE
  63.        FreeVec(Long(bm.planes))
  64.        Dispose(bm)
  65.      ENDIF
  66.   ENDIF
  67. ENDPROC
  68.  
  69. PROC bitmapdepth(bm:PTR TO bitmap) RETURN IF v39 THEN GetBitMapAttr(bm,BMA_DEPTH) ELSE bm.depth
  70. PROC sysisize() RETURN IF screen.flags AND SCREENHIRES THEN SYSISIZE_MEDRES ELSE SYSISIZE_LOWRES
  71.  
  72. PROC newimageobject(which) RETURN NewObjectA(NIL,'sysiclass',
  73.   [SYSIA_DRAWINFO,dri,SYSIA_WHICH,which,SYSIA_SIZE,sysisize(),NIL])
  74.  
  75. PROC newpropobject(freedom,taglist) RETURN NewObjectA(NIL,'propgclass',
  76.   [ICA_TARGET,ICTARGET_IDCMP,PGA_FREEDOM,freedom,PGA_NEWLOOK,TRUE,
  77.    PGA_BORDERLESS,(dri.flags AND DRIF_NEWLOOK) AND (dri.depth<>1),
  78.    TAG_MORE,taglist])
  79.  
  80. PROC newbuttonobject(image:PTR TO object,taglist) RETURN NewObjectA(NIL,'buttongclass',
  81.   [ICA_TARGET,ICTARGET_IDCMP,GA_IMAGE,image,TAG_MORE,taglist])
  82.  
  83. PROC openscrollerwindow(taglist)
  84.   DEF resolution,topborder,sf:PTR TO textattr,w,h,bw,bh,rw,rh,gw,gh,gap
  85.   resolution:=sysisize()
  86.   sf:=screen.font
  87.   topborder:=screen.wbortop+sf.ysize+1
  88.   w:=sizeimage.width
  89.   h:=sizeimage.height
  90.   bw:=IF resolution=SYSISIZE_LOWRES THEN 1 ELSE 2
  91.   bh:=IF resolution=SYSISIZE_HIRES THEN 2 ELSE 1
  92.   rw:=IF resolution=SYSISIZE_HIRES THEN 3 ELSE 2
  93.   rh:=IF resolution=SYSISIZE_HIRES THEN 2 ELSE 1
  94.   gh:=max(leftimage.height,h)
  95.   gh:=max(rightimage.height,gh)
  96.   gw:=max(upimage.width,w)
  97.   gw:=max(downimage.width,gw)
  98.   gap:=1
  99.   IF (horizgadget:=newpropobject(FREEHORIZ,
  100.     [GA_LEFT,rw+gap,
  101.      GA_RELBOTTOM,bh-gh+2,
  102.      GA_RELWIDTH,(-gw)-gap-leftimage.width-rightimage.width-rw-rw,
  103.      GA_HEIGHT,gh-bh-bh-2,
  104.      GA_BOTTOMBORDER,TRUE,
  105.      GA_ID,HORIZ_GID,
  106.      PGA_TOTAL,htotal,
  107.      PGA_VISIBLE,hvisible,
  108.      NIL]))=NIL THEN RETURN
  109.   IF (vertgadget:=newpropobject(FREEVERT,
  110.     [GA_RELRIGHT,bw-gw+3,
  111.      GA_TOP,topborder+rh,
  112.      GA_WIDTH,gw-bw-bw-4,
  113.      GA_RELHEIGHT,(-topborder)-h-upimage.height-downimage.height-rh-rh,
  114.      GA_RIGHTBORDER,TRUE,
  115.      GA_PREVIOUS,horizgadget,
  116.      GA_ID,VERT_GID,
  117.      PGA_TOTAL,vtotal,
  118.      PGA_VISIBLE,vvisible,
  119.      NIL]))=NIL THEN RETURN
  120.   IF (leftgadget:=newbuttonobject(leftimage,
  121.     [GA_RELRIGHT,(1)-leftimage.width-rightimage.width-gw,
  122.      GA_RELBOTTOM,(1)-leftimage.height,
  123.      GA_BOTTOMBORDER,TRUE,
  124.      GA_PREVIOUS,vertgadget,
  125.      GA_ID,LEFT_GID,
  126.      NIL]))=NIL THEN RETURN
  127.   IF (rightgadget:=newbuttonobject(rightimage,
  128.     [GA_RELRIGHT,(1)-rightimage.width-gw,
  129.      GA_RELBOTTOM,(1)-rightimage.height,
  130.      GA_BOTTOMBORDER,TRUE,
  131.      GA_PREVIOUS,leftgadget,
  132.      GA_ID,RIGHT_GID,
  133.      NIL]))=NIL THEN RETURN
  134.   IF (upgadget:=newbuttonobject(upimage,
  135.     [GA_RELRIGHT,(1)-upimage.width,
  136.      GA_RELBOTTOM,(1)-upimage.height-downimage.height-h,
  137.      GA_RIGHTBORDER,TRUE,
  138.      GA_PREVIOUS,rightgadget,
  139.      GA_ID,UP_GID,
  140.      NIL]))=NIL THEN RETURN
  141.   IF (downgadget:=newbuttonobject(downimage,
  142.     [GA_RELRIGHT,(1)-downimage.width,
  143.      GA_RELBOTTOM,(1)-downimage.height-h,
  144.      GA_RIGHTBORDER,TRUE,
  145.      GA_PREVIOUS,upgadget,
  146.      GA_ID,DOWN_GID,
  147.      NIL]))=NIL THEN RETURN
  148.   window:=OpenWindowTagList(NIL,
  149.     [WA_GADGETS,horizgadget,
  150.      WA_MINWIDTH,max(80,gw+gap+leftimage.width+rightimage.width+rw+rw+KNOBHMIN),
  151.      WA_MINHEIGHT,max(50,topborder+h+upimage.height+downimage.height+rh+rh+KNOBVMIN),
  152.      TAG_MORE,taglist])
  153. ENDPROC
  154.  
  155. PROC closescrollerwindow()
  156.   IF window THEN CloseWindow(window)
  157.   DisposeObject(horizgadget)
  158.   DisposeObject(vertgadget)
  159.   DisposeObject(leftgadget)
  160.   DisposeObject(rightgadget)
  161.   DisposeObject(upgadget)
  162.   DisposeObject(downgadget)
  163. ENDPROC
  164.  
  165. PROC recalchvisible() RETURN window.width-window.borderleft-window.borderright
  166. PROC recalcvvisible() RETURN window.height-window.bordertop-window.borderbottom
  167.  
  168. PROC updateprop(gadget:PTR TO object,attr,value)
  169.   SetGadgetAttrsA(gadget,window,NIL,[attr,value,NIL])
  170. ENDPROC
  171.  
  172. PROC copybitmap()
  173.   DEF srcx,srcy
  174.   GetAttr(PGA_TOP,horizgadget,{srcx})
  175.   GetAttr(PGA_TOP,vertgadget,{srcy})
  176.   BltBitMapRastPort(bitmap,srcx,srcy,window.rport,window.borderleft,
  177.     window.bordertop,min(htotal,hvisible),min(vtotal,vvisible),$C0)
  178. ENDPROC
  179.  
  180. PROC updatescrollerwindow()
  181.   hvisible:=recalchvisible()
  182.   updateprop(horizgadget,PGA_VISIBLE,hvisible)
  183.   vvisible:=recalcvvisible()
  184.   updateprop(vertgadget,PGA_VISIBLE,vvisible)
  185.   copybitmap()
  186. ENDPROC
  187.  
  188. PROC handlescrollerwindow()
  189.   DEF imsg:PTR TO intuimessage,quit=FALSE,oldtop,cl,v
  190.   WHILE quit=FALSE
  191.     WHILE (quit=FALSE) AND (imsg:=GetMsg(window.userport))
  192.       cl:=imsg.class
  193.       SELECT cl
  194.         CASE IDCMP_CLOSEWINDOW
  195.           quit:=TRUE
  196.         CASE IDCMP_NEWSIZE
  197.           updatescrollerwindow()
  198.         CASE IDCMP_REFRESHWINDOW
  199.           BeginRefresh(window)
  200.           copybitmap()
  201.           EndRefresh(window,TRUE)
  202.         CASE IDCMP_IDCMPUPDATE
  203.           v:=GetTagData(GA_ID,0,imsg.iaddress)
  204.           SELECT v
  205.             CASE HORIZ_GID
  206.               copybitmap()
  207.             CASE VERT_GID
  208.               copybitmap()
  209.             CASE LEFT_GID
  210.               GetAttr(PGA_TOP,horizgadget,{oldtop})
  211.               IF oldtop>0
  212.                 updateprop(horizgadget,PGA_TOP,oldtop-1)
  213.                 copybitmap()
  214.               ENDIF
  215.             CASE RIGHT_GID
  216.               GetAttr(PGA_TOP,horizgadget,{oldtop})
  217.               IF oldtop<(htotal-hvisible)
  218.                 updateprop(horizgadget,PGA_TOP,oldtop+1)
  219.                 copybitmap()
  220.               ENDIF
  221.             CASE UP_GID
  222.               GetAttr(PGA_TOP,vertgadget,{oldtop})
  223.               IF oldtop>0
  224.                 updateprop(vertgadget,PGA_TOP,oldtop-1)
  225.                 copybitmap()
  226.               ENDIF
  227.             CASE DOWN_GID
  228.               GetAttr(PGA_TOP,vertgadget,{oldtop})
  229.               IF oldtop<(vtotal-vvisible)
  230.                 updateprop(vertgadget,PGA_TOP,oldtop+1)
  231.                 copybitmap()
  232.               ENDIF
  233.           ENDSELECT
  234.       ENDSELECT
  235.       ReplyMsg(imsg)
  236.     ENDWHILE
  237.     IF quit=FALSE THEN WaitPort(window.userport)
  238.   ENDWHILE
  239. ENDPROC
  240.  
  241. PROC doscrollerwindow()
  242.   DEF r:PTR TO rastport
  243.   IF screen:=LockPubScreen(NIL)
  244.     hvisible:=htotal:=screen.width
  245.     vvisible:=vtotal:=screen.height
  246.     r:=screen.rastport
  247.     IF bitmap:=createbitmap(htotal,vtotal,bitmapdepth(r.bitmap),0,r.bitmap)
  248.       BltBitMap(r.bitmap,0,0,bitmap,0,0,htotal,vtotal,$C0,-1,NIL)
  249.       IF dri:=GetScreenDrawInfo(screen)
  250.         sizeimage:=newimageobject(SIZEIMAGE)
  251.         leftimage:=newimageobject(LEFTIMAGE)
  252.         rightimage:=newimageobject(RIGHTIMAGE)
  253.         upimage:=newimageobject(UPIMAGE)
  254.         downimage:=newimageobject(DOWNIMAGE)
  255.         IF (sizeimage<>0) AND (leftimage<>0) AND (rightimage<>0) AND (upimage<>0) AND (downimage<>0)
  256.           openscrollerwindow([WA_PUBSCREEN,screen,
  257.             WA_TITLE,'ScrollerWindow',
  258.             WA_FLAGS,WFLG_CLOSEGADGET OR WFLG_SIZEGADGET OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_SIMPLE_REFRESH OR WFLG_ACTIVATE OR WFLG_NEWLOOKMENUS,
  259.             WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_NEWSIZE OR IDCMP_REFRESHWINDOW OR IDCMP_IDCMPUPDATE,
  260.             WA_INNERWIDTH,htotal,
  261.             WA_INNERHEIGHT,vtotal,
  262.             WA_MAXWIDTH,-1,
  263.             WA_MAXHEIGHT,-1,
  264.             NIL])
  265.           IF window
  266.             updatescrollerwindow()
  267.             handlescrollerwindow()
  268.           ELSE
  269.             WriteF('no window!\n')
  270.           ENDIF
  271.           closescrollerwindow()
  272.         ELSE
  273.           WriteF('no images!\n')
  274.         ENDIF
  275.         DisposeObject(sizeimage)
  276.         DisposeObject(leftimage)
  277.         DisposeObject(rightimage)
  278.         DisposeObject(upimage)
  279.         DisposeObject(downimage)
  280.         FreeScreenDrawInfo(screen,dri)
  281.       ELSE
  282.         WriteF('no draw infos!\n')
  283.       ENDIF
  284.       WaitBlit()
  285.       deletebitmap(bitmap)
  286.     ELSE
  287.       WriteF('no bitmap!\n')
  288.     ENDIF
  289.     UnlockPubScreen(NIL,screen)
  290.   ELSE
  291.     WriteF('no pub screen!\n')
  292.   ENDIF
  293. ENDPROC
  294.  
  295. PROC main()
  296.   v39:=KickVersion(39)
  297.   IF utilitybase:=OpenLibrary('utility.library',37)
  298.     doscrollerwindow()
  299.     CloseLibrary(utilitybase)
  300.   ENDIF
  301. ENDPROC
  302.