home *** CD-ROM | disk | FTP | other *** search
/ The CDPD Public Domain Collection for CDTV 4 / CDPD_IV.bin / e / mailinglists / binaries / agacc.lha / AGACC.e
Text File  |  1992-03-06  |  2KB  |  86 lines
  1. OPT OSVERSION=39
  2.  
  3. MODULE 'intuition/intuition'
  4.  
  5. DEF s,w:PTR TO window,rast,x,m,mx,my,r,g,b
  6.  
  7. PROC main()
  8.   IF s:=OpenS(320,256,8,$800,'AGA Colour Cube')
  9.     rast:=stdrast
  10.     IF w:=OpenW(0,11,320,245,0,WFLG_BORDERLESS,0,s,15,0)
  11.       fullcolour(0,0,0,0)
  12.       fullcolour(1,$40,$80,$c0)
  13.       fullcolour(11,0,0,0)
  14.       fullcolour(12,0,0,0)
  15.       fullcolour(13,0,0,0)
  16.       fullcolour(6,0,0,0)
  17.       r:=0
  18.       g:=0
  19.       b:=0
  20.       Line(0,16,0,79,11)
  21.       Line(70,16,70,79,12)
  22.       Line(140,16,140,79,13)
  23.       FOR x:=0 TO 63
  24.         Plot(1,16+x,192+x)
  25.         Plot(71,16+x,64+x)
  26.         Plot(141,16+x,128+x)
  27.         Line(2+x,16,2+x,79,64+x)
  28.         Line(72+x,16,72+x,79,128+x)
  29.         Line(142+x,16,142+x,79,192+x)
  30.       ENDFOR
  31.       Colour(6,0)
  32.       RectFill(w.rport,0,82,205,120)
  33.       Colour(5,0)
  34.       fullcolour(5,255,255,255)
  35.       TextF(44,10,'R:\z\h[2] G:\z\h[2] B:\z\h[2]',r,g,b)
  36.       TextF(0,130,'Left mouse on square changes')
  37.       TextF(0,138,'Red, Green or Blue colour')
  38.       TextF(0,146,'component. Right mouse exits.')
  39.       WHILE Mouse()<>2
  40.         Delay(1)
  41.         mx:=MouseX(w)
  42.         my:=MouseY(w)
  43.         m:=Mouse()
  44.         IF (m=1) AND (my>=16) AND (my<=79)
  45.           IF (mx>=2) AND (mx<=65)
  46.             b:=mx-2*4
  47.             g:=my-16*4
  48.           ENDIF
  49.           IF (mx>=72) AND (mx<=135)
  50.             r:=mx-72*4
  51.             b:=my-16*4
  52.           ENDIF
  53.           IF (mx>=142) AND (mx<=205)
  54.             g:=mx-142*4
  55.             r:=my-16*4
  56.           ENDIF
  57.           fullcolour(11,r,0,0)
  58.           fullcolour(12,0,g,0)
  59.           fullcolour(13,0,0,b)
  60.           fullcolour(6,r,g,b)
  61.           TextF(44,10,'R:\z\h[2] G:\z\h[2] B:\z\h[2]',r,g,b)
  62.         ENDIF
  63.       ENDWHILE
  64.       CloseWindow(w)
  65.     ENDIF
  66.     CloseScreen(s)
  67.   ENDIF
  68. ENDPROC
  69.  
  70. PROC fullcolour(nr,r,g,b)    /* a replacement for SetRGB32()   */
  71.   MOVE.L rast,A0        /* as the modules for 3.0 weren't */
  72.   SUB.L  #40,A0            /* available yet.                 */
  73.   MOVE.L nr,D0
  74.   MOVE.L r,D1
  75.   SWAP   D1
  76.   LSL.L  #8,D1            /* shift RGB to 32bit */
  77.   MOVE.L g,D2
  78.   SWAP   D2
  79.   LSL.L  #8,D2
  80.   MOVE.L b,D3
  81.   SWAP   D3
  82.   LSL.L  #8,D3
  83.   MOVE.L gfxbase,A6
  84.   JSR    -$354(A6)        /* SetRGB32(rast,nr,r32,g32,b32) */
  85. ENDPROC
  86.