home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d6xx / d634 / apig.lha / APIG / apig33.lzh / e17_execlist.rexx < prev    next >
OS/2 REXX Batch file  |  1991-09-27  |  13KB  |  410 lines
  1. /* Example of using the EXECLIST functions to do simple list scrolling  */
  2.  
  3.  x = addlib("apig.library",0,-30,0)
  4.  
  5.  portname = "example17_port"
  6.  p = openport(portname)
  7.  
  8.  call set_apig_globals()      /* Create Intuition Global constants */
  9.  
  10.  scrtitle = "Hey Buddy, Yea You,  This is Your New Screen  !"
  11.  wintitle = "This is your title"
  12.  winidcmp = CLOSEWINDOW+GADGETDOWN+GADGETUP
  13.  winflags = WINDOWCLOSE+WINDOWDRAG+WINDOWSIZING+WINDOWDEPTH+GIMMEZEROZERO
  14.  
  15.  scr = openscreen(0,0,640,400,3,4,5,LACE+HIRES,CUSTOMSCREEN,scrtitle)
  16.  
  17.  /* open window */
  18.  w1  = openwindow(portname,0,0,640,400,2,4,winidcmp,winflags,wintitle,scr,0,0,0)
  19.   rpw1  = getwindowrastport(w1) 
  20.   
  21.   call setrgb4(w1,0,4,4,4)
  22.   call setrgb4(w1,1,0,15,15)
  23.   call setrgb4(w1,2,15,10,1)
  24.   call setrgb4(w1,3,8,9,8)
  25.   call setrgb4(w1,4,6,6,6)
  26.   call setrgb4(w1,5,15,15,15)
  27.   call setrgb4(w1,6,0,0,0)
  28.   call setrgb4(w1,7,15,0,0)
  29.   
  30.   image3 = loadimage("uparrow.bitmap",0,0,0)
  31.   image4 = loadimage("downarrow.bitmap",0,0,0)
  32.  
  33.   call setrast(rpw1,4)
  34.   call setapen(rpw1,3)
  35.   
  36.   
  37.   if image3 = '0000 0000'x | image4 = '0000 0000'x then
  38.      do
  39.         say "couldnt find image"
  40.         call closewindow(w1)
  41.         call closescreen(scr)
  42.         x = freeimage(image3)
  43.         x = freeimage(image4)
  44.         exit
  45.      end
  46.  
  47. devlist = builddevlist()           /* Build our scrollable list */
  48.  
  49. potgad = getgadptr(w1,407,0)
  50. previouspotvalue = vertpot(potgad)
  51.  
  52. z = pitext(rpw1,100,80,"Play with the scroll list below",1,0,JAM2,0)
  53. z = pitext(rpw1,100,90,"this aint too fancy, but you get the idea",1,0,JAM2,0)
  54.  
  55. exitme = 0
  56. do forever
  57.  
  58.      call waitpkt(portname)
  59.   
  60.      do forever 
  61.      
  62.         msg = getpkt(portname)
  63.         if msg = '0000 0000'x then leave
  64.         
  65.         class = getarg(msg,0)
  66.         gadget = getarg(msg,8)
  67.         gadid = getarg(msg,9)
  68.         x = getarg(msg,3)
  69.         y = getarg(msg,4) - 8
  70.         call reply(msg,0)
  71.         
  72.         select
  73.         when class = CLOSEWINDOW then 
  74.            do
  75.              exitme = 1
  76.            end
  77.         when gadid > 0 then 
  78.            do
  79.               if gadid = 402 then /* the uparrow */
  80.                  do
  81.                    x = scrolldown(devlist,rpw1)
  82.                  end
  83.               if gadid = 403 then  /* the downarrow */
  84.                  do
  85.                    x = scrollup(devlist,rpw1)
  86.                  end
  87.               if gadid = 405 then  /* within the border box gadget */
  88.                  do
  89.                    scamt = getvalue(devlist,38,2,'n')  /* scroll amount */
  90.                    top   = getvalue(devlist,32,2,'n')  /* top display pixel */
  91.                    lnum  = (y - top) % scamt
  92.                    dnode = getvalue(devlist,14,4,'p')  /* top display node */
  93.                    do i = 1 to lnum 
  94.                       if next(dnode) = '0000 0000'x then leave
  95.                       dnode = next(dnode)
  96.                    end
  97.                    dtext = getvalue(dnode,10,4,'S')
  98.                    gadptr = getgadptr(w1,406,0)
  99.                    call setstrgad(gadptr,dtext)
  100.                    call refreshglist(gadptr,w1,0,1)
  101.                 end
  102.               if gadid = 407 then /* the propgad slider */
  103.                  do
  104.                    potvalue = vertpot(potgad)
  105.                    say "oldpot" previouspotvalue "newpot" potvalue
  106.                    lnum = (potvalue - previouspotvalue) % vertbody(potgad)
  107.                    say "lnum=" lnum 
  108.                    if potvalue > previouspotvalue then
  109.                       do
  110.                          do i = 1 to lnum 
  111.                             x = scrollup(devlist,rpw1)
  112.                          end
  113.                       end
  114.                    if potvalue < previouspotvalue then
  115.                       do
  116.                    say " 2 oldpot" previouspotvalue "newpot" potvalue
  117.                          do i = lnum to 0 
  118.                             x = scrolldown(devlist,rpw1)
  119.                          end
  120.                       end
  121.                    previouspotvalue = potvalue
  122.                 end
  123.            end
  124.                 
  125.            otherwise nop
  126.            
  127.         end
  128.         
  129.      end  
  130.    if exitme = 1 then leave
  131. end
  132.  
  133.   x = freeimage(image3)
  134.   x = freeimage(image4)
  135.   
  136.   a = closewindow(w1)
  137.   a = closescreen(scr)
  138.   
  139.   x = freelistmem()
  140.  
  141.   exit
  142.  
  143.  
  144. /*-------------------------------------*/
  145. /* Scroll list functions               */
  146. /*                                     */
  147. /* To facilitate list scrolling        */
  148. /* allocate an extended List structure */
  149. /* as follows:                         */
  150. /*                                     */
  151. /* listptr -> list structure    offset */
  152. /*           *lh_head            0     */
  153. /*           *lh_tail            4     */
  154. /*           *lh_tailpred        8     */
  155. /*            lh_type           12     */
  156. /*            lh_pad            13     */
  157. /**standard stuff, now for extensions **/
  158. /*           *topnode           14     */
  159. /*           *bottomnode        18     */
  160. /*            width             22     */ 
  161. /*            xmin              24     */ 
  162. /*            ymin              26     */ 
  163. /*            xmax              28     */ 
  164. /*            ymax              30     */ 
  165. /*            topline           32     */ 
  166. /*            bottomline        34     */ 
  167. /*            leftedge          36     */ 
  168. /*            scrollamount      38     */ 
  169. /*            listcount         40     */
  170. /*                                     */
  171. /*          (size is 42 bytes)         */
  172. /*          (gonna allocate 60 bytes)  */
  173. /*-------------------------------------*/
  174.  
  175.  
  176. /* ----------------------------------------------------------------- */
  177.  
  178. builddevlist: procedure expose w1 JAM2 rpw1 GADGHNONE GADGIMMEDIATE GADGIMAGE,
  179.                                GADGHCOMP RELVERIFY AUTOKNOB FREEVERT MAXPOT,
  180.                                MAXBODY image3 image4
  181. /* ----------------------------------------------------------------- */
  182.  
  183. border = makeborder(w1,0,2,128,60,5,0,JAM2,0)
  184. call makeborder(w1,0,1,128,60,7,0,JAM2,border)
  185.  
  186. border2 = makeborder(w1,0,2,128,11,5,0,JAM2,0)
  187. call makeborder(w1,0,1,128,11,7,0,JAM2,border2)
  188.  
  189. z = makeboolgadget(w1,100,230,128,60,GADGHNONE,GADGIMMEDIATE,0,0,border,0,405,0)
  190. call makeboolgadget(w1,234,273,imgwidth(image3),imgheight(image3),GADGIMAGE+GADGHCOMP,GADGIMMEDIATE,0,0,image3,0,402,z)
  191. call makeboolgadget(w1,234,282,imgwidth(image4),imgheight(image4),GADGIMAGE+GADGHCOMP,GADGIMMEDIATE,0,0,image4,0,403,z)
  192. call makestrgadget(w1,100,294,128,9,GADGHCOMP,RELVERIFY,0,0,border2,0,406,z,33)
  193. pgad = makepropgadget(w1,234,230,imgwidth(image3),40,0,RELVERIFY,0,AUTOKNOB+FREEVERT,MAXPOT,0,
  194.                     ,407,z,0,1)
  195.  
  196. call addglist(w1,z,-1,-1,0)
  197. call refreshgadgets(z,w1,0)
  198.  
  199. alist   = allocmem(60,'0001 0000'x)   /* allocate 60 bytes for list struct */
  200. call newlist(alist)
  201. call setvalue(alist,22,2,'n',125,0)   /* set pixel width */
  202. call setvalue(alist,24,2,'n',101,0)   /* xmin   */
  203. call setvalue(alist,26,2,'n',234,0)   /* ymin   */
  204. call setvalue(alist,28,2,'n',226,0)   /* xmax   */
  205. call setvalue(alist,30,2,'n',286,0)   /* ymax   */
  206. call setvalue(alist,32,2,'n',240,0)   /* top    */
  207. call setvalue(alist,34,2,'n',284,0)   /* bot    */
  208. call setvalue(alist,36,2,'n',102,0)   /* left   */
  209. call setvalue(alist,38,2,'n',11,0)    /* scroll amount */
  210.  
  211. count = 0
  212.  
  213. devlist = showlist('d')                       /* string of device names */
  214.  
  215. do forever
  216.  
  217.    if devlist = '' then leave                 /* parse devices names   */
  218.    parse var devlist devname devlist 
  219.    
  220.    anode = allocmem(14,'0001 0000'x)          /* allocate NODE struct  */
  221.    
  222.    dl    = length(devname) + 1       
  223.    anodename = allocmem(dl,'0001 0000'x)      /* mem to hold dev. name */
  224.    
  225.    call export(anodename,devname)             /* copy name into mem    */
  226.    
  227.    call setvalue(anode,10,4,'p',anodename,0)  /* point LN_NAME to mem  */
  228.    
  229.    call addtail(alist,anode)                  /* add node to list      */
  230.    
  231.    count = count + 1
  232.    
  233.    if count = 1 then
  234.       listtop = anode                         /* keep track of topnode */
  235.  
  236.    if count < 6 then                          /* display size is 5     */
  237.    do
  238.      listbottom = anode                       /* keep track of bottom  */
  239.  
  240.      call setapen(rpw1,2)                     /* display dev name      */
  241.      call setbpen(rpw1,4)
  242.      call setdrmd(rpw1,JAM2)
  243.      call move(rpw1,102,240+((count-1)*11))
  244.      call text(rpw1,devname,-1)
  245.    end
  246.    
  247. end
  248.  
  249. call setvalue(alist,14,4,'p',listtop,0)
  250. call setvalue(alist,18,4,'p',listbottom,0)
  251. call setvalue(alist,40,2,'n',count,0)
  252.  
  253. /* vbody = (MAXPOT * count) / (((284 - 240) + 11) / 11) */
  254.    vbody = MAXPOT %  count
  255.  
  256. call newmodifyprop(pgad,w1,0,AUTOKNOB+FREEVERT,MAXPOT,0,MAXBODY,vbody,1)
  257.  
  258. return alist
  259.  
  260.  
  261. /* ----------------------------------------------------------------------- */
  262. scrolldown: procedure expose JAM2 devlist rpw1
  263. /* ----------------------------------------------------------------------- */
  264.  
  265. arg alist,rp
  266. alist = devlist
  267. rp    = rpw1
  268. listtop    = getvalue(alist,14,4,'p')
  269. listbottom = getvalue(alist,18,4,'p')
  270.  
  271. say "firstnode(alist,listtop) = "  firstnode(alist,listtop)
  272.  
  273. if firstnode(alist,listtop) = 1 then return 0
  274.  
  275. width = getvalue(alist,22,2,'n')   /* get pixel width */
  276. xmin  = getvalue(alist,24,2,'n')   /* xmin */
  277. ymin  = getvalue(alist,26,2,'n')   /* ymin */
  278. xmax  = getvalue(alist,28,2,'n')   /* xmax */
  279. ymax  = getvalue(alist,30,2,'n')   /* ymax */
  280. top   = getvalue(alist,32,2,'n')   /* top  */
  281. bot   = getvalue(alist,34,2,'n')   /* bot  */
  282. left  = getvalue(alist,36,2,'n')   /* left */
  283. scamt = getvalue(alist,38,2,'n')   /* scroll amount */
  284.  
  285. /*
  286. say "w    = " width getvalue(alist,22,2,'n')
  287. say "xmin = " xmin getvalue(alist,24,2,'n') 
  288. say "ymin = " ymin getvalue(alist,26,2,'n') 
  289. say "xmax = " xmax getvalue(alist,28,2,'n') 
  290. say "ymax = " ymax getvalue(alist,30,2,'n') 
  291. say "top  = " top getvalue(alist,32,2,'n')  
  292. say "bot  = " bot getvalue(alist,34,2,'n')  
  293. say "left = " left getvalue(alist,36,2,'n') 
  294. say "scamt = " scamt getvalue(alist,38,2,'n') 
  295. */
  296.  
  297. topnode    = next(listtop,4)      /* NEXT() is an ARexx function */
  298. listbottom = next(listbottom,4)
  299.  
  300. devname = getvalue(topnode,10,4,'S') 
  301.  
  302. tl = width + 100
  303. sl = length(devname) + 1
  304. do until tl <= width              /* 'clip' the text to fit within border */
  305.    sl = sl - 1
  306.    tl = textlength(rp,devname,sl)
  307. end
  308.  
  309. call scrollraster(rp,0,( -1 * scamt),xmin,ymin,xmax,ymax)
  310.  
  311. call move(rp,left,top)
  312. call setapen(rp,2)
  313. call setbpen(rp,4)
  314. call setdrmd(rp,JAM2)
  315. call text(rp,devname,sl)          /* write name inside border             */
  316.  
  317. call setvalue(alist,14,4,'p',topnode,0)
  318. call setvalue(alist,18,4,'p',listbottom,0)
  319.  
  320. return 1
  321.  
  322.  
  323. /* ----------------------------------------------------------------------- */
  324. scrollup: procedure expose JAM2 devlist rpw1
  325. /* ----------------------------------------------------------------------- */
  326.  
  327. arg alist,rp
  328. alist = devlist
  329. rp    = rpw1
  330.  
  331. listtop    = getvalue(alist,14,4,'p')
  332. listbottom = getvalue(alist,18,4,'p')
  333.  
  334. if lastnode(alist,listbottom) = 1 then return 0
  335.  
  336. width = getvalue(alist,22,2,'n')   /* get pixel width */
  337. xmin  = getvalue(alist,24,2,'n')   /* xmin */
  338. ymin  = getvalue(alist,26,2,'n')   /* ymin */
  339. xmax  = getvalue(alist,28,2,'n')   /* xmax */
  340. ymax  = getvalue(alist,30,2,'n')   /* ymax */
  341. top   = getvalue(alist,32,2,'n')   /* top  */
  342. bot   = getvalue(alist,34,2,'n')   /* bot  */
  343. left  = getvalue(alist,36,2,'n')   /* left */
  344. scamt = getvalue(alist,38,2,'n')   /* scroll amount */
  345.  
  346. /*
  347. say "w    = " getvalue(alist,22,2,'n')
  348. say "xmin = " getvalue(alist,24,2,'n') 
  349. say "ymin = " getvalue(alist,26,2,'n') 
  350. say "xmax = " getvalue(alist,28,2,'n') 
  351. say "ymax = " getvalue(alist,30,2,'n') 
  352. say "top  = " getvalue(alist,32,2,'n')  
  353. say "bot  = " getvalue(alist,34,2,'n')  
  354. say "left = " getvalue(alist,36,2,'n') 
  355. */
  356.  
  357. topnode  = next(listtop)
  358. listbottom = next(listbottom)
  359.  
  360. devname = getvalue(listbottom,10,4,'S')
  361.  
  362. tl = width + 100
  363. sl = length(devname) + 1
  364. do until tl <= width
  365.    sl = sl - 1
  366.    tl = textlength(rp,devname,sl)
  367. end
  368.  
  369. call scrollraster(rp,0,scamt,xmin,ymin,xmax,ymax)
  370.  
  371. call move(rp,left,bot)
  372. call setapen(rp,2)
  373. call setbpen(rp,4)
  374. call setdrmd(rp,JAM2)
  375. call text(rp,devname,sl)
  376.  
  377. call setvalue(alist,14,4,'p',topnode,0)
  378. call setvalue(alist,18,4,'p',listbottom,0)
  379.  
  380. return 1
  381.  
  382.  
  383.  
  384. /* ----------------------------------------------------------------------- */
  385. freelistmem: procedure expose devlist
  386. /* ----------------------------------------------------------------------- */
  387.  
  388. do forever
  389.     
  390.    anode = remhead(devlist)               /* get node at head of list   */
  391.    
  392.    if anode = '0000 0000'x then leave     /* if null list emptied       */
  393.    
  394.    namepointer = getvalue(anode,10,4,'p') /* GET POINTER TO name string */
  395.    
  396.    if namepointer ~= '0000 0000'x then 
  397.       do
  398.         nodename = getvalue(anode,10,4,'s') /* GET THE NAME STRING        */
  399.         namelen = length(nodename) + 1      /* length of string plus null */
  400.         x = freemem(namepointer,namelen)    /* free mem for name string   */
  401.       end
  402.       
  403.    x = freemem(anode,14)                    /* free mem for the node      */
  404.    
  405. end   
  406.  
  407. x = freemem(devlist,60)                   /* free list structure mem    */
  408.  
  409. return 1
  410.