home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / E / TFF-A32R.LZX / AmigaE3.2a / Src / Intui / ScrollerWindow.e < prev    next >
Encoding:
Text File  |  1992-09-02  |  9.4 KB  |  309 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 emodules 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) IS IF x>y THEN x ELSE y
  34. PROC min(x,y) IS IF x<y THEN x ELSE y
  35. PROC rassize(w,h) IS 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.       ENDIF
  53.     ENDIF
  54.   ENDIF
  55. ENDPROC bm
  56.  
  57. PROC deletebitmap(bm:PTR TO bitmap)
  58.   IF bm
  59.     IF v39
  60.       FreeBitMap(bm)
  61.      ELSE
  62.        FreeVec(Long(bm.planes))
  63.        Dispose(bm)
  64.      ENDIF
  65.   ENDIF
  66. ENDPROC
  67.  
  68. PROC bitmapdepth(bm:PTR TO bitmap) IS
  69.   IF v39 THEN GetBitMapAttr(bm,BMA_DEPTH) ELSE bm.depth
  70.  
  71. PROC sysisize() IS
  72.  IF screen.flags AND SCREENHIRES THEN SYSISIZE_MEDRES ELSE SYSISIZE_LOWRES
  73.  
  74. PROC newimageobject(which) IS
  75.   NewObjectA(NIL,'sysiclass',
  76.     [SYSIA_DRAWINFO,dri,SYSIA_WHICH,which,SYSIA_SIZE,sysisize(),NIL])
  77.  
  78. PROC newpropobject(freedom,taglist) IS
  79.   NewObjectA(NIL,'propgclass',
  80.     [ICA_TARGET,ICTARGET_IDCMP,PGA_FREEDOM,freedom,PGA_NEWLOOK,TRUE,
  81.      PGA_BORDERLESS,(dri.flags AND DRIF_NEWLOOK) AND (dri.depth<>1),
  82.      TAG_MORE,taglist])
  83.  
  84. PROC newbuttonobject(image:PTR TO object,taglist) IS
  85.   NewObjectA(NIL,'buttongclass',
  86.     [ICA_TARGET,ICTARGET_IDCMP,GA_IMAGE,image,TAG_MORE,taglist])
  87.  
  88. PROC openscrollerwindow(taglist)
  89.   DEF resolution,topborder,sf:PTR TO textattr,w,h,bw,bh,rw,rh,gw,gh,gap
  90.   resolution:=sysisize()
  91.   sf:=screen.font
  92.   topborder:=screen.wbortop+sf.ysize+1
  93.   w:=sizeimage.width
  94.   h:=sizeimage.height
  95.   bw:=IF resolution=SYSISIZE_LOWRES THEN 1 ELSE 2
  96.   bh:=IF resolution=SYSISIZE_HIRES THEN 2 ELSE 1
  97.   rw:=IF resolution=SYSISIZE_HIRES THEN 3 ELSE 2
  98.   rh:=IF resolution=SYSISIZE_HIRES THEN 2 ELSE 1
  99.   gh:=max(leftimage.height,h)
  100.   gh:=max(rightimage.height,gh)
  101.   gw:=max(upimage.width,w)
  102.   gw:=max(downimage.width,gw)
  103.   gap:=1
  104.   horizgadget:=newpropobject(FREEHORIZ,
  105.     [GA_LEFT,rw+gap,
  106.      GA_RELBOTTOM,bh-gh+2,
  107.      GA_RELWIDTH,(-gw)-gap-leftimage.width-rightimage.width-rw-rw,
  108.      GA_HEIGHT,gh-bh-bh-2,
  109.      GA_BOTTOMBORDER,TRUE,
  110.      GA_ID,HORIZ_GID,
  111.      PGA_TOTAL,htotal,
  112.      PGA_VISIBLE,hvisible,
  113.      NIL])
  114.   vertgadget:=newpropobject(FREEVERT,
  115.     [GA_RELRIGHT,bw-gw+3,
  116.      GA_TOP,topborder+rh,
  117.      GA_WIDTH,gw-bw-bw-4,
  118.      GA_RELHEIGHT,(-topborder)-h-upimage.height-downimage.height-rh-rh,
  119.      GA_RIGHTBORDER,TRUE,
  120.      GA_PREVIOUS,horizgadget,
  121.      GA_ID,VERT_GID,
  122.      PGA_TOTAL,vtotal,
  123.      PGA_VISIBLE,vvisible,
  124.      NIL])
  125.   leftgadget:=newbuttonobject(leftimage,
  126.     [GA_RELRIGHT,(1)-leftimage.width-rightimage.width-gw,
  127.      GA_RELBOTTOM,(1)-leftimage.height,
  128.      GA_BOTTOMBORDER,TRUE,
  129.      GA_PREVIOUS,vertgadget,
  130.      GA_ID,LEFT_GID,
  131.      NIL])
  132.   rightgadget:=newbuttonobject(rightimage,
  133.     [GA_RELRIGHT,(1)-rightimage.width-gw,
  134.      GA_RELBOTTOM,(1)-rightimage.height,
  135.      GA_BOTTOMBORDER,TRUE,
  136.      GA_PREVIOUS,leftgadget,
  137.      GA_ID,RIGHT_GID,
  138.      NIL])
  139.   upgadget:=newbuttonobject(upimage,
  140.     [GA_RELRIGHT,(1)-upimage.width,
  141.      GA_RELBOTTOM,(1)-upimage.height-downimage.height-h,
  142.      GA_RIGHTBORDER,TRUE,
  143.      GA_PREVIOUS,rightgadget,
  144.      GA_ID,UP_GID,
  145.      NIL])
  146.   downgadget:=newbuttonobject(downimage,
  147.     [GA_RELRIGHT,(1)-downimage.width,
  148.      GA_RELBOTTOM,(1)-downimage.height-h,
  149.      GA_RIGHTBORDER,TRUE,
  150.      GA_PREVIOUS,upgadget,
  151.      GA_ID,DOWN_GID,
  152.      NIL])
  153.   IF downgadget
  154.     window:=OpenWindowTagList(NIL,
  155.       [WA_GADGETS,horizgadget,
  156.        WA_MINWIDTH,max(80,gw+gap+leftimage.width+rightimage.width+rw+rw+KNOBHMIN),
  157.        WA_MINHEIGHT,max(50,topborder+h+upimage.height+downimage.height+rh+rh+KNOBVMIN),
  158.        TAG_MORE,taglist])
  159.   ENDIF
  160. ENDPROC
  161.  
  162. PROC closescrollerwindow()
  163.   IF window THEN CloseWindow(window)
  164.   DisposeObject(horizgadget)
  165.   DisposeObject(vertgadget)
  166.   DisposeObject(leftgadget)
  167.   DisposeObject(rightgadget)
  168.   DisposeObject(upgadget)
  169.   DisposeObject(downgadget)
  170. ENDPROC
  171.  
  172. PROC recalchvisible() IS window.width-window.borderleft-window.borderright
  173. PROC recalcvvisible() IS window.height-window.bordertop-window.borderbottom
  174.  
  175. PROC updateprop(gadget:PTR TO object,attr,value)
  176.   SetGadgetAttrsA(gadget,window,NIL,[attr,value,NIL])
  177. ENDPROC
  178.  
  179. PROC copybitmap()
  180.   DEF srcx,srcy
  181.   GetAttr(PGA_TOP,horizgadget,{srcx})
  182.   GetAttr(PGA_TOP,vertgadget,{srcy})
  183.   BltBitMapRastPort(bitmap,srcx,srcy,window.rport,window.borderleft,
  184.     window.bordertop,min(htotal,hvisible),min(vtotal,vvisible),$C0)
  185. ENDPROC
  186.  
  187. PROC updatescrollerwindow()
  188.   hvisible:=recalchvisible()
  189.   updateprop(horizgadget,PGA_VISIBLE,hvisible)
  190.   vvisible:=recalcvvisible()
  191.   updateprop(vertgadget,PGA_VISIBLE,vvisible)
  192.   copybitmap()
  193. ENDPROC
  194.  
  195. PROC handlescrollerwindow()
  196.   DEF imsg:PTR TO intuimessage,quit=FALSE,oldtop,cl,v
  197.   WHILE quit=FALSE
  198.     WHILE (quit=FALSE) AND (imsg:=GetMsg(window.userport))
  199.       cl:=imsg.class
  200.       SELECT cl
  201.         CASE IDCMP_CLOSEWINDOW
  202.           quit:=TRUE
  203.         CASE IDCMP_NEWSIZE
  204.           updatescrollerwindow()
  205.         CASE IDCMP_REFRESHWINDOW
  206.           BeginRefresh(window)
  207.           copybitmap()
  208.           EndRefresh(window,TRUE)
  209.         CASE IDCMP_IDCMPUPDATE
  210.           v:=GetTagData(GA_ID,0,imsg.iaddress)
  211.           SELECT v
  212.             CASE HORIZ_GID
  213.               copybitmap()
  214.             CASE VERT_GID
  215.               copybitmap()
  216.             CASE LEFT_GID
  217.               GetAttr(PGA_TOP,horizgadget,{oldtop})
  218.               IF oldtop>0
  219.                 updateprop(horizgadget,PGA_TOP,oldtop-1)
  220.                 copybitmap()
  221.               ENDIF
  222.             CASE RIGHT_GID
  223.               GetAttr(PGA_TOP,horizgadget,{oldtop})
  224.               IF oldtop<(htotal-hvisible)
  225.                 updateprop(horizgadget,PGA_TOP,oldtop+1)
  226.                 copybitmap()
  227.               ENDIF
  228.             CASE UP_GID
  229.               GetAttr(PGA_TOP,vertgadget,{oldtop})
  230.               IF oldtop>0
  231.                 updateprop(vertgadget,PGA_TOP,oldtop-1)
  232.                 copybitmap()
  233.               ENDIF
  234.             CASE DOWN_GID
  235.               GetAttr(PGA_TOP,vertgadget,{oldtop})
  236.               IF oldtop<(vtotal-vvisible)
  237.                 updateprop(vertgadget,PGA_TOP,oldtop+1)
  238.                 copybitmap()
  239.               ENDIF
  240.           ENDSELECT
  241.       ENDSELECT
  242.       ReplyMsg(imsg)
  243.     ENDWHILE
  244.     IF quit=FALSE THEN WaitPort(window.userport)
  245.   ENDWHILE
  246. ENDPROC
  247.  
  248. PROC doscrollerwindow()
  249.   DEF r:PTR TO rastport
  250.   IF screen:=LockPubScreen(NIL)
  251.     hvisible:=htotal:=screen.width
  252.     vvisible:=vtotal:=screen.height
  253.     r:=screen.rastport
  254.     IF bitmap:=createbitmap(htotal,vtotal,bitmapdepth(r.bitmap),0,r.bitmap)
  255.       BltBitMap(r.bitmap,0,0,bitmap,0,0,htotal,vtotal,$C0,-1,NIL)
  256.       IF dri:=GetScreenDrawInfo(screen)
  257.         sizeimage:=newimageobject(SIZEIMAGE)
  258.         leftimage:=newimageobject(LEFTIMAGE)
  259.         rightimage:=newimageobject(RIGHTIMAGE)
  260.         upimage:=newimageobject(UPIMAGE)
  261.         downimage:=newimageobject(DOWNIMAGE)
  262.         IF (sizeimage<>0) AND (leftimage<>0) AND (rightimage<>0) AND (upimage<>0) AND (downimage<>0)
  263.           openscrollerwindow([WA_PUBSCREEN,screen,
  264.             WA_TITLE,'ScrollerWindow',
  265.             WA_FLAGS,WFLG_CLOSEGADGET OR WFLG_SIZEGADGET OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_SIMPLE_REFRESH OR WFLG_ACTIVATE OR WFLG_NEWLOOKMENUS,
  266.             WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_NEWSIZE OR IDCMP_REFRESHWINDOW OR IDCMP_IDCMPUPDATE,
  267.             WA_INNERWIDTH,htotal,
  268.             WA_INNERHEIGHT,vtotal,
  269.             WA_MAXWIDTH,-1,
  270.             WA_MAXHEIGHT,-1,
  271.             NIL])
  272.           IF window
  273.             updatescrollerwindow()
  274.             handlescrollerwindow()
  275.           ELSE
  276.             WriteF('no window!\n')
  277.           ENDIF
  278.           closescrollerwindow()
  279.         ELSE
  280.           WriteF('no images!\n')
  281.         ENDIF
  282.         DisposeObject(sizeimage)
  283.         DisposeObject(leftimage)
  284.         DisposeObject(rightimage)
  285.         DisposeObject(upimage)
  286.         DisposeObject(downimage)
  287.         FreeScreenDrawInfo(screen,dri)
  288.       ELSE
  289.         WriteF('no draw infos!\n')
  290.       ENDIF
  291.       WaitBlit()
  292.       deletebitmap(bitmap)
  293.     ELSE
  294.       WriteF('no bitmap!\n')
  295.     ENDIF
  296.     UnlockPubScreen(NIL,screen)
  297.   ELSE
  298.     WriteF('no pub screen!\n')
  299.   ENDIF
  300. ENDPROC
  301.  
  302. PROC main()
  303.   v39:=KickVersion(39)
  304.   IF utilitybase:=OpenLibrary('utility.library',37)
  305.     doscrollerwindow()
  306.     CloseLibrary(utilitybase)
  307.   ENDIF
  308. ENDPROC
  309.