/* Example of using the EXECLIST functions to do simple list scrolling */ x = addlib("apig.library",0,-30,0) portname = "example17_port" p = openport(portname) call set_apig_globals() /* Create Intuition Global constants */ scrtitle = "Hey Buddy, Yea You, This is Your New Screen !" wintitle = "This is your title" winidcmp = CLOSEWINDOW+GADGETDOWN+GADGETUP winflags = WINDOWCLOSE+WINDOWDRAG+WINDOWSIZING+WINDOWDEPTH+GIMMEZEROZERO scr = openscreen(0,0,640,400,3,4,5,LACE+HIRES,CUSTOMSCREEN,scrtitle) /* open window */ w1 = openwindow(portname,0,0,640,400,2,4,winidcmp,winflags,wintitle,scr,0,0,0) rpw1 = getwindowrastport(w1) call setrgb4(w1,0,4,4,4) call setrgb4(w1,1,0,15,15) call setrgb4(w1,2,15,10,1) call setrgb4(w1,3,8,9,8) call setrgb4(w1,4,6,6,6) call setrgb4(w1,5,15,15,15) call setrgb4(w1,6,0,0,0) call setrgb4(w1,7,15,0,0) image3 = loadimage("uparrow.bitmap",0,0,0) image4 = loadimage("downarrow.bitmap",0,0,0) call setrast(rpw1,4) call setapen(rpw1,3) if image3 = '0000 0000'x | image4 = '0000 0000'x then do say "couldnt find image" call closewindow(w1) call closescreen(scr) x = freeimage(image3) x = freeimage(image4) exit end devlist = builddevlist() /* Build our scrollable list */ potgad = getgadptr(w1,407,0) previouspotvalue = vertpot(potgad) z = pitext(rpw1,100,80,"Play with the scroll list below",1,0,JAM2,0) z = pitext(rpw1,100,90,"this aint too fancy, but you get the idea",1,0,JAM2,0) exitme = 0 do forever call waitpkt(portname) do forever msg = getpkt(portname) if msg = '0000 0000'x then leave class = getarg(msg,0) gadget = getarg(msg,8) gadid = getarg(msg,9) x = getarg(msg,3) y = getarg(msg,4) - 8 call reply(msg,0) select when class = CLOSEWINDOW then do exitme = 1 end when gadid > 0 then do if gadid = 402 then /* the uparrow */ do x = scrolldown(devlist,rpw1) end if gadid = 403 then /* the downarrow */ do x = scrollup(devlist,rpw1) end if gadid = 405 then /* within the border box gadget */ do scamt = getvalue(devlist,38,2,'n') /* scroll amount */ top = getvalue(devlist,32,2,'n') /* top display pixel */ lnum = (y - top) % scamt dnode = getvalue(devlist,14,4,'p') /* top display node */ do i = 1 to lnum if next(dnode) = '0000 0000'x then leave dnode = next(dnode) end dtext = getvalue(dnode,10,4,'S') gadptr = getgadptr(w1,406,0) call setstrgad(gadptr,dtext) call refreshglist(gadptr,w1,0,1) end if gadid = 407 then /* the propgad slider */ do potvalue = vertpot(potgad) say "oldpot" previouspotvalue "newpot" potvalue lnum = (potvalue - previouspotvalue) % vertbody(potgad) say "lnum=" lnum if potvalue > previouspotvalue then do do i = 1 to lnum x = scrollup(devlist,rpw1) end end if potvalue < previouspotvalue then do say " 2 oldpot" previouspotvalue "newpot" potvalue do i = lnum to 0 x = scrolldown(devlist,rpw1) end end previouspotvalue = potvalue end end otherwise nop end end if exitme = 1 then leave end x = freeimage(image3) x = freeimage(image4) a = closewindow(w1) a = closescreen(scr) x = freelistmem() exit /*-------------------------------------*/ /* Scroll list functions */ /* */ /* To facilitate list scrolling */ /* allocate an extended List structure */ /* as follows: */ /* */ /* listptr -> list structure offset */ /* *lh_head 0 */ /* *lh_tail 4 */ /* *lh_tailpred 8 */ /* lh_type 12 */ /* lh_pad 13 */ /**standard stuff, now for extensions **/ /* *topnode 14 */ /* *bottomnode 18 */ /* width 22 */ /* xmin 24 */ /* ymin 26 */ /* xmax 28 */ /* ymax 30 */ /* topline 32 */ /* bottomline 34 */ /* leftedge 36 */ /* scrollamount 38 */ /* listcount 40 */ /* */ /* (size is 42 bytes) */ /* (gonna allocate 60 bytes) */ /*-------------------------------------*/ /* ----------------------------------------------------------------- */ builddevlist: procedure expose w1 JAM2 rpw1 GADGHNONE GADGIMMEDIATE GADGIMAGE, GADGHCOMP RELVERIFY AUTOKNOB FREEVERT MAXPOT, MAXBODY image3 image4 /* ----------------------------------------------------------------- */ border = makeborder(w1,0,2,128,60,5,0,JAM2,0) call makeborder(w1,0,1,128,60,7,0,JAM2,border) border2 = makeborder(w1,0,2,128,11,5,0,JAM2,0) call makeborder(w1,0,1,128,11,7,0,JAM2,border2) z = makeboolgadget(w1,100,230,128,60,GADGHNONE,GADGIMMEDIATE,0,0,border,0,405,0) call makeboolgadget(w1,234,273,imgwidth(image3),imgheight(image3),GADGIMAGE+GADGHCOMP,GADGIMMEDIATE,0,0,image3,0,402,z) call makeboolgadget(w1,234,282,imgwidth(image4),imgheight(image4),GADGIMAGE+GADGHCOMP,GADGIMMEDIATE,0,0,image4,0,403,z) call makestrgadget(w1,100,294,128,9,GADGHCOMP,RELVERIFY,0,0,border2,0,406,z,33) pgad = makepropgadget(w1,234,230,imgwidth(image3),40,0,RELVERIFY,0,AUTOKNOB+FREEVERT,MAXPOT,0, ,407,z,0,1) call addglist(w1,z,-1,-1,0) call refreshgadgets(z,w1,0) alist = allocmem(60,'0001 0000'x) /* allocate 60 bytes for list struct */ call newlist(alist) call setvalue(alist,22,2,'n',125,0) /* set pixel width */ call setvalue(alist,24,2,'n',101,0) /* xmin */ call setvalue(alist,26,2,'n',234,0) /* ymin */ call setvalue(alist,28,2,'n',226,0) /* xmax */ call setvalue(alist,30,2,'n',286,0) /* ymax */ call setvalue(alist,32,2,'n',240,0) /* top */ call setvalue(alist,34,2,'n',284,0) /* bot */ call setvalue(alist,36,2,'n',102,0) /* left */ call setvalue(alist,38,2,'n',11,0) /* scroll amount */ count = 0 devlist = showlist('d') /* string of device names */ do forever if devlist = '' then leave /* parse devices names */ parse var devlist devname devlist anode = allocmem(14,'0001 0000'x) /* allocate NODE struct */ dl = length(devname) + 1 anodename = allocmem(dl,'0001 0000'x) /* mem to hold dev. name */ call export(anodename,devname) /* copy name into mem */ call setvalue(anode,10,4,'p',anodename,0) /* point LN_NAME to mem */ call addtail(alist,anode) /* add node to list */ count = count + 1 if count = 1 then listtop = anode /* keep track of topnode */ if count < 6 then /* display size is 5 */ do listbottom = anode /* keep track of bottom */ call setapen(rpw1,2) /* display dev name */ call setbpen(rpw1,4) call setdrmd(rpw1,JAM2) call move(rpw1,102,240+((count-1)*11)) call text(rpw1,devname,-1) end end call setvalue(alist,14,4,'p',listtop,0) call setvalue(alist,18,4,'p',listbottom,0) call setvalue(alist,40,2,'n',count,0) /* vbody = (MAXPOT * count) / (((284 - 240) + 11) / 11) */ vbody = MAXPOT % count call newmodifyprop(pgad,w1,0,AUTOKNOB+FREEVERT,MAXPOT,0,MAXBODY,vbody,1) return alist /* ----------------------------------------------------------------------- */ scrolldown: procedure expose JAM2 devlist rpw1 /* ----------------------------------------------------------------------- */ arg alist,rp alist = devlist rp = rpw1 listtop = getvalue(alist,14,4,'p') listbottom = getvalue(alist,18,4,'p') say "firstnode(alist,listtop) = " firstnode(alist,listtop) if firstnode(alist,listtop) = 1 then return 0 width = getvalue(alist,22,2,'n') /* get pixel width */ xmin = getvalue(alist,24,2,'n') /* xmin */ ymin = getvalue(alist,26,2,'n') /* ymin */ xmax = getvalue(alist,28,2,'n') /* xmax */ ymax = getvalue(alist,30,2,'n') /* ymax */ top = getvalue(alist,32,2,'n') /* top */ bot = getvalue(alist,34,2,'n') /* bot */ left = getvalue(alist,36,2,'n') /* left */ scamt = getvalue(alist,38,2,'n') /* scroll amount */ /* say "w = " width getvalue(alist,22,2,'n') say "xmin = " xmin getvalue(alist,24,2,'n') say "ymin = " ymin getvalue(alist,26,2,'n') say "xmax = " xmax getvalue(alist,28,2,'n') say "ymax = " ymax getvalue(alist,30,2,'n') say "top = " top getvalue(alist,32,2,'n') say "bot = " bot getvalue(alist,34,2,'n') say "left = " left getvalue(alist,36,2,'n') say "scamt = " scamt getvalue(alist,38,2,'n') */ topnode = next(listtop,4) /* NEXT() is an ARexx function */ listbottom = next(listbottom,4) devname = getvalue(topnode,10,4,'S') tl = width + 100 sl = length(devname) + 1 do until tl <= width /* 'clip' the text to fit within border */ sl = sl - 1 tl = textlength(rp,devname,sl) end call scrollraster(rp,0,( -1 * scamt),xmin,ymin,xmax,ymax) call move(rp,left,top) call setapen(rp,2) call setbpen(rp,4) call setdrmd(rp,JAM2) call text(rp,devname,sl) /* write name inside border */ call setvalue(alist,14,4,'p',topnode,0) call setvalue(alist,18,4,'p',listbottom,0) return 1 /* ----------------------------------------------------------------------- */ scrollup: procedure expose JAM2 devlist rpw1 /* ----------------------------------------------------------------------- */ arg alist,rp alist = devlist rp = rpw1 listtop = getvalue(alist,14,4,'p') listbottom = getvalue(alist,18,4,'p') if lastnode(alist,listbottom) = 1 then return 0 width = getvalue(alist,22,2,'n') /* get pixel width */ xmin = getvalue(alist,24,2,'n') /* xmin */ ymin = getvalue(alist,26,2,'n') /* ymin */ xmax = getvalue(alist,28,2,'n') /* xmax */ ymax = getvalue(alist,30,2,'n') /* ymax */ top = getvalue(alist,32,2,'n') /* top */ bot = getvalue(alist,34,2,'n') /* bot */ left = getvalue(alist,36,2,'n') /* left */ scamt = getvalue(alist,38,2,'n') /* scroll amount */ /* say "w = " getvalue(alist,22,2,'n') say "xmin = " getvalue(alist,24,2,'n') say "ymin = " getvalue(alist,26,2,'n') say "xmax = " getvalue(alist,28,2,'n') say "ymax = " getvalue(alist,30,2,'n') say "top = " getvalue(alist,32,2,'n') say "bot = " getvalue(alist,34,2,'n') say "left = " getvalue(alist,36,2,'n') */ topnode = next(listtop) listbottom = next(listbottom) devname = getvalue(listbottom,10,4,'S') tl = width + 100 sl = length(devname) + 1 do until tl <= width sl = sl - 1 tl = textlength(rp,devname,sl) end call scrollraster(rp,0,scamt,xmin,ymin,xmax,ymax) call move(rp,left,bot) call setapen(rp,2) call setbpen(rp,4) call setdrmd(rp,JAM2) call text(rp,devname,sl) call setvalue(alist,14,4,'p',topnode,0) call setvalue(alist,18,4,'p',listbottom,0) return 1 /* ----------------------------------------------------------------------- */ freelistmem: procedure expose devlist /* ----------------------------------------------------------------------- */ do forever anode = remhead(devlist) /* get node at head of list */ if anode = '0000 0000'x then leave /* if null list emptied */ namepointer = getvalue(anode,10,4,'p') /* GET POINTER TO name string */ if namepointer ~= '0000 0000'x then do nodename = getvalue(anode,10,4,'s') /* GET THE NAME STRING */ namelen = length(nodename) + 1 /* length of string plus null */ x = freemem(namepointer,namelen) /* free mem for name string */ end x = freemem(anode,14) /* free mem for the node */ end x = freemem(devlist,60) /* free list structure mem */ return 1