home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 2 / FFMCD02.bin / new / amigalibdisks / disk950 / bbsquick / bbsquick64.lha / Palette.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1993-06-13  |  8.5 KB  |  363 lines
  1. /*        $VER: 1.1 Palette.rexx 30 Sep 1992 (30.9.92)
  2.     copyright 1991 Richard Lee Stockton and Gramma Software.
  3.       FREELY DISTRIBUTABLE as long as this notice remains
  4.  
  5. USAGE: rx Palette [public_screen] [colors] [replyport]
  6.       defaults to Workbench with 4 colors, no replyport
  7.  
  8. ASYNCH example:  ADDRESS AREXX Palette MY8COLORSCREEN 8 MYPORT
  9.  
  10.   Palette.rexx will return 5 if the user selects "USE" and if
  11.   Palette.rexx was given a replyport name, the message 'NEW_COLORS'
  12.   is sent to the replyport. Otherwise no message is sent and the
  13.   function returns 0.
  14.  
  15.  
  16. WARNING! There is no way to check to see if colors is the correct
  17.           number for a particular screen.
  18.          Colors *MUST* be either 2, 4, 8, 16, or 32.
  19.  
  20.         requires these external libraries:
  21.                             arp.library
  22.                     rexxsupport.library
  23.                      rexxarplib.library
  24.                     screenshare.library
  25.  
  26.  
  27. NOTE! Palette.comments contains the same program, but heavily commented
  28.  
  29. */
  30.  
  31. IF ~SHOW('L','rexxsupport.library') THEN
  32.   CALL ADDLIB('rexxsupport.library',0,-30,0)
  33. IF ~SHOW('L','rexxarplib.library') THEN
  34.   CALL ADDLIB('rexxarplib.library',0,-30,0)
  35. CALL getversions()
  36.  
  37. PARSE ARG pscreen' 'colors' 'replyport .
  38. IF colors~=2 & colors~=8 & colors~=16 & colors~=32 THEN colors=4
  39. IF pscreen='' THEN pscreen='Workbench'
  40. IF pscreen='Workbench' & ksversion<37 THEN
  41.   CALL ALL_DONE('Can not open Palette on pre-2.0 WorkBench!')
  42.  
  43. host='PALETTEHOST'
  44. port='PALETTEPORT'
  45. IF replyport='' THEN
  46.   DO
  47.     DO i=1 WHILE SHOW('P',host||i)
  48.     END
  49.     host=host||i
  50.     port=port||i
  51.   END
  52. ELSE
  53.   DO
  54.     host=host'.'replyport
  55.     port=port'.'replyport
  56.     IF SHOW('P',port) THEN
  57.       DO
  58.         INTERPRET ADDRESS port FRONT
  59.         EXIT(0)
  60.       END
  61.   END
  62.  
  63. CALL setup_variables()
  64. CALL setup_host()
  65. w.=''
  66. w.idcmp='CLOSEWINDOW+MENUPICK+GADGETDOWN+GADGETUP+MOUSEBUTTONS'
  67. w.flags='WINDOWCLOSE+WINDOWDRAG'
  68. w.title=' ARexx Color Palette           '
  69. IF replyport~='' THEN
  70.   DO
  71.     t=LENGTH(replyport)
  72.     w.title=' 'LEFT(replyport,t-4)' Colors          '
  73.   END
  74. xmax=218
  75. ymax=126
  76. CALL OpenWindow(host,(ScreenCols(pscreen)-xmax)%2, ,
  77.                      (ScreenRows(pscreen)-ymax)%2, ,
  78.                      xmax,ymax,w.idcmp,w.flags,w.title)
  79. CALL SetFont(host,'topaz.font',8)
  80. p1=1
  81. p2=2
  82. IF ksversion<37 THEN
  83.   DO
  84.     p1=2
  85.     p2=1
  86.     CALL SetReqColor(host,'OKAYPEN',1)
  87.   END
  88. CALL ModifyHost(host,MOUSEBUTTONS,"%b %x %y")
  89.  
  90. CALL AddMenu(host,'ARexx Palette')
  91. CALL AddItem(host,'Use     ','OK','U')
  92. CALL AddItem(host,'Reset   ','RESET','R')
  93. CALL AddItem(host,'About   ','ABOUT')
  94. CALL AddItem(host,'Quit    ','CLOSEWINDOW','Q')
  95.  
  96. CALL AddGadget(host,15,26,1,'<','%l 1 -1')
  97. CALL AddGadget(host,51,26,2,'>','%l 1 1')
  98. CALL AddGadget(host,85,26,3,'<','%l 2 -1')
  99. CALL AddGadget(host,121,26,4,'>','%l 2 1')
  100. CALL AddGadget(host,155,26,5,'<','%l 3 -1')
  101. CALL AddGadget(host,191,26,6,'>','%l 3 1')
  102.  
  103. CALL SetAPen(host,1)
  104. CALL Move(host,27,22)
  105. CALL Text(host,'Red')
  106. CALL Move(host,89,22)
  107. CALL Text(host,'Green')
  108. CALL Move(host,163,22)
  109. CALL Text(host,'Blue')
  110.  
  111. DO i=1 TO 3
  112.   CALL box(host,p1,p1,8+(i-1)*70,13,61,26)
  113. END
  114. CALL box(host,p1,p2,53,42,108,10)
  115. CALL box(host,p1,p1,15,55,186,50)
  116. CALL read_colors()
  117.  
  118. CALL AddGadget(host,11,ymax-16,98,' USE ','OK')
  119. CALL AddGadget(host,xmax%2-24,ymax-16,99,'RESET','RESET')
  120. CALL AddGadget(host,xmax-64,ymax-16,99,'CANCEL','CLOSEWINDOW')
  121. CALL tofront()
  122.  
  123. keep_going=1
  124. DO WHILE keep_going=1
  125.   t=WAITPKT(port)
  126.   DO ff=1
  127.     p=GETPKT(port)
  128.     IF p='0000 0000'x THEN LEAVE ff    /* message port empty */
  129.     command=GETARG(p)
  130.     t=REPLY(p,0)
  131.     IF keep_going=0 THEN ITERATE ff
  132.     PARSE VAR command arg1' 'arg2' 'arg3' ' 
  133.     SELECT
  134.       WHEN arg1='CLOSEWINDOW'  THEN keep_going=0
  135.       WHEN arg1='RESET'        THEN CALL reset_colors()
  136.       WHEN arg1='OK'           THEN CALL do_ok()
  137.       WHEN arg1='FRONT'        THEN CALL tofront()
  138.       WHEN arg1='GADGETDOWN'   THEN CALL gadgetdown(arg2 arg3)
  139.       WHEN arg1='SELECTDOWN'   THEN CALL selectdown(arg2 arg3)
  140.       WHEN arg1='ABOUT'        THEN CALL Request(,,copyright,,,,pscreen)
  141.       WHEN arg1='GADGETUP'     THEN NOP
  142.       WHEN arg1='SELECTUP'     THEN NOP
  143.       WHEN arg1='CONTINUE'     THEN NOP
  144.       OTHERWISE CALL REQUEST(,100,arg1 arg2 arg3,,,,pscreen)
  145.     END
  146.   END
  147. END
  148. CALL ALL_DONE('RESET')
  149. EXIT(0)
  150.  
  151.  
  152.  
  153.  
  154. /* Functions */
  155.  
  156. ALL_DONE:
  157.   PARSE ARG air
  158.   changed=0
  159.   CALL PostMsg()
  160.   IF air='RESET' THEN CALL reset_colors()
  161.   ELSE IF air='NEW_COLORS' THEN changed=5
  162.   ELSE IF air~='' THEN
  163.     DO
  164.       CALL usermsg(air)
  165.       CALL waiting()
  166.     END
  167.   CALL clearport(port)
  168.   IF SHOW('P',host) THEN CALL Stop(host)
  169.   EXIT(changed)
  170. RETURN
  171.  
  172.  
  173. clearport:
  174. PARSE ARG portname
  175. p=1
  176. DO FOREVER
  177.   p=GETPKT(portname)
  178.   IF p='0000 0000'x THEN RETURN
  179.   t=REPLY(p,0)
  180. END
  181. RETURN
  182.  
  183.  
  184. do_ok:
  185.   IF replyport~='' THEN
  186.     IF SHOWLIST('P',replyport) THEN
  187.       INTERPRET ADDRESS replyport 'NEW_COLORS'
  188.   CALL ALL_DONE('NEW_COLORS')
  189. RETURN
  190.  
  191.  
  192. tofront:
  193.   CALL ActivateWindow(host)
  194.   CALL WindowToFront(host)
  195.   CALL ScreenToFront(pscreen)
  196. RETURN
  197.  
  198.  
  199. read_colors:
  200.   colors.=''
  201.   box_x=92
  202.   box_y=48
  203.   IF colors>8 THEN
  204.     DO
  205.       box_y=12
  206.       box_x=46
  207.       IF colors=32 THEN box_x=23
  208.     END
  209.   ELSE IF colors>2 THEN
  210.     DO
  211.       box_y=24
  212.       IF colors=8 THEN box_x=46
  213.     END
  214.   box_cols=184%box_x
  215.   box_rows=48%box_y
  216.   DO i=0 TO colors-1
  217.     colors.i=ScreenColor(pscreen,i)
  218.     CALL SetAPen(host,i)
  219.     CALL RectFill(host,16+(i//box_cols)*box_x,56+(i%box_cols)*box_y,16+box_x+(i//box_cols)*box_x,56+box_y+(i%box_cols)*box_y)
  220.   END
  221.   CALL SetAPen(host,1)
  222.  
  223.  
  224. reset_colors:
  225.   DO i=0 TO colors-1
  226.     DO j=1 TO 3
  227.       colors.i.j=WORD(colors.i,j)%1
  228.     END
  229.   END
  230.  
  231.  
  232. set_colors:
  233.   DO i=0 TO colors-1
  234.     CALL ScreenColor(pscreen,i,colors.i.1,colors.i.2,colors.i.3)
  235.   END
  236.  
  237.  
  238. update_colors:
  239.   register=register%1
  240.   CALL Move(host,22,50)
  241.   CALL Text(host,RIGHT(register,2))
  242.   CALL Move(host,xmax-44,50)
  243.   CALL Text(host,d2x(colors.register.1)||d2x(colors.register.2)||d2x(colors.register.3))
  244.   DO i=1 TO 3
  245.     CALL Move(host,31+(i-1)*70,33)
  246.     CALL Text(host,right(colors.register.i%1,2))
  247.   END
  248.   CALL SetAPen(host,register)
  249.   CALL RectFill(host,54,43,160,51)
  250.   CALL SetAPen(host,1)
  251. RETURN
  252.  
  253.  
  254. gadgetdown:
  255.   PARSE ARG rgb updown .
  256.   DO icount=1
  257.     colors.register.rgb=colors.register.rgb+updown
  258.     IF colors.register.rgb<0 THEN colors.register.rgb=15
  259.     IF colors.register.rgb>15 THEN colors.register.rgb=0
  260.     CALL ScreenColor(pscreen,register,colors.register.1,colors.register.2,colors.register.3)
  261.     CALL update_colors()
  262.     IF cpu>68000 THEN CALL DELAY(2)
  263.     p=GETPKT(port)
  264.     IF p~='0000 0000'x THEN
  265.       DO
  266.         arg1=GETARG(p)
  267.         t=REPLY(p,0)
  268.         PARSE VAR arg1 arg1 .
  269.         IF arg1="GADGETUP" | arg1="SELECTUP" | arg1='MOUSEBUTTONS' THEN
  270.           LEAVE icount
  271.       END
  272.   END
  273. RETURN
  274.  
  275.  
  276. selectdown:
  277.   IF arg2<14 | arg2>198 | arg3<55 | arg3>103 THEN RETURN
  278.   mx=(arg2-14)%box_x
  279.   my=(arg3-55)%box_y
  280.   IF mx>=box_cols THEN mx=box_cols-1
  281.   IF my>=box_rows THEN my=box_rows-1
  282.   register=mx+my*box_cols
  283.   CALL update_colors()
  284. RETURN
  285.  
  286.  
  287. box:
  288.   ARG boxhost,pen1,pen2,upleft,uptop,width,height
  289.   CALL SetAPen(boxhost,pen2)
  290.   CALL Move(boxhost,upleft+width+1,uptop)
  291.   CALL Draw(boxhost,upleft+width+1,uptop+height)
  292.   CALL Draw(boxhost,upleft-1,uptop+height)
  293.   CALL Move(boxhost,upleft+width,uptop+1)
  294.   CALL Draw(boxhost,upleft+width,uptop+height)
  295.   CALL SetAPen(boxhost,pen1)
  296.   CALL Move(boxhost,upleft,uptop)
  297.   CALL Draw(boxhost,upleft+width,uptop)
  298.   CALL Move(boxhost,upleft,uptop+height-1)
  299.   CALL Draw(boxhost,upleft,uptop)
  300.   CALL Move(boxhost,upleft-1,uptop)
  301.   CALL Draw(boxhost,upleft-1,uptop+height)
  302. RETURN
  303.  
  304.  
  305. setup_host:
  306.   CALL OPENPORT(port)
  307.   ADDRESS AREXX "'x=CreateHost("host","port","pscreen")'"
  308.   DO 200 WHILE ~SHOW('Ports',host)
  309.     CALL DELAY 10  /* 200 ms */
  310.   END
  311.   IF ~SHOW('Ports',host) THEN
  312.     CALL ALL_DONE('Could not open host 'host'.')
  313.   IF ~SHOW('Ports',port) THEN
  314.     CALL ALL_DONE('Could not open port 'port'.')
  315. RETURN
  316.  
  317.  
  318. usermsg:
  319.   PARSE ARG umsg
  320.   CALL PostMsg()
  321.   CALL PostMsg(0,160,umsg,pscreen)
  322. RETURN
  323.  
  324.  
  325. waiting:
  326.   CALL DELAY(200)
  327.   CALL PostMsg()
  328. RETURN
  329.  
  330.  
  331. setup_variables:
  332.   register=0
  333.   x=SOURCELINE(1)
  334.   copyright=''
  335.   DO i=3 TO 7
  336.     copyright=copyright WORD(x,i)
  337.   END
  338.   copyright=CENTER(STRIP(copyright),32)'\\
  339.   © 1991 Richard Lee Stockton\'CENTER('and',32)'\
  340.     Gramma Software Systems\
  341. 17730-15th Avenue NE, Suite 223\
  342.      Seattle WA 98155-3804\
  343.     Office: (206) 363-6417\
  344.        FAX:       361-0429\
  345.        BBS:       744-1254\
  346.       Tech:       776-1253\\
  347.       FREELY DISTRIBUTABLE'
  348. RETURN
  349.  
  350.  
  351. getversions:
  352.   ADDRESS COMMAND 'version >RAM:VERSION'
  353.   x=OPEN(f,'RAM:VERSION','R')
  354.   line=READLN(f)
  355.   CALL CLOSE(f)
  356.   CALL DELETE('RAM:VERSION')
  357.   ksversion=STRIP(WORD(line,3))
  358.   PARSE VERSION . . cpu .
  359. RETURN
  360.   
  361.  
  362. /* Palette.rexx */
  363.