home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / aminet / jdlib4_6.lha / Procs / _Colour_Requester.AMOS / _Colour_Requester.amosSourceCode
AMOS Source Code  |  2008-12-10  |  11KB  |  452 lines
  1. Dim ZYCLUS(2)
  2. STDSCREEN
  3. CHANGERGB
  4. Procedure STDSCREEN
  5.    Default 
  6.    Close Editor 
  7.    Close Workbench 
  8.    Screen Open 0,680,257,4,Hires
  9.    Screen Offset 0,0,0
  10.    Limit Mouse 112,42 To 447,298
  11.    Curs Off : Flash Off 
  12.    Colour 0,0 : Colour 1,$90 : Colour 2,$8F8 : Colour 3,$E0 : Rem Gruen    
  13.    ' Colour 0,0 : Colour 1,$555 : Colour 2,$EEE : Colour 3,$AAA : Rem Grau      
  14.    RES_SCREEN[0]
  15. End Proc
  16. Procedure RES_SCREEN[X]
  17.    Gr Writing 1 : Ink 2,1 : Pen 2 : Paper 1
  18.    If X=0 Then Cls 
  19. End Proc
  20. Procedure CHANGERGB
  21.    Every Off 
  22.    Shared ZYCLUS()
  23.    Dim RGB(31)
  24.    FINDRES : NRES=Param+1 : RES=NRES
  25.    For A=0 To 31 : RGB(A)=Colour(A) : Next 
  26.    AGAIN:
  27.    Flash Off : Curs Off 
  28.    FC=2 : BC=0
  29.    Cls : Show 
  30.    Reserve Zone 58
  31.    Ink 0,0
  32.    Bar 13,8 To 317,179
  33.    Ink FC,BC
  34.    Bar 8,3 To 312,174
  35.    Ink BC,FC
  36.    Box 9,4 To 311,173
  37.    Ink BC,FC
  38.    Text 19,114,"R" : Text 39,114,"G" : Text 60,114,"B"
  39.    A=0 : Repeat 
  40.       Bar 15+A*20,6 To 30+A*20,104
  41.       Set Zone A+1,15+A*20,6 To 30+A*20,104
  42.       Inc A
  43.    Until A=3
  44.    A=0 : Repeat 
  45.       Draw 10,6+A*6 To 75,6+A*6
  46.       Inc A
  47.    Until A=17
  48.    A=0 : Repeat 
  49.       Ink A,A : X=A mod 8 : Y=A/8
  50.       Bar X*16+80,Y*16+8 To X*16+95,Y*16+23
  51.       Set Zone A+4,X*16+80,Y*16+8 To X*16+95,Y*16+23
  52.    Inc A : Until A>Min(31,Screen Colour-1)
  53.    Ink BC,FC
  54.    Box 79,7 To 96+16*X,24+16*Y
  55.    Box 80,90 To 140,100 : Text 86,98,"Cancel" : Set Zone 36,80,90 To 140,100
  56.    Box 152,90 To 202,100 : Text 165,98,"Use" : Set Zone 37,152,90 To 202,100
  57.    Box 80,105 To 202,115 : Text 121,113,"Reset" : Set Zone 38,80,105 To 202,115
  58.    Box 152,75 To 202,85 : Text 162,83,"Save" : Set Zone 39,152,75 To 202,85
  59.    Box 80,75 To 140,85 : Text 95,83,"Load" : Set Zone 40,80,75 To 140,85
  60.    Box 15,120 To 42,130 : Text 17,128,"B/W" : Set Zone 41,15,120 To 42,130
  61.    Box 47,120 To 74,130 : Text 49,128," A " : Set Zone 42,47,120 To 74,130
  62.    Box 15,135 To 68,145 : Text 25,143,"COPY" : Set Zone 43,15,135 To 68,145
  63.    Box 73,135 To 140,145 : Text 75,143,"EXCHANGE" : Set Zone 44,73,135 To 140,145
  64.    Box 145,135 To 202,145 : Text 150,143,"SPREAD" : Set Zone 45,145,135 To 202,145
  65.    Box 15,150 To 48,160 : Text 21,158,"NEG" : Set Zone 53,15,150 To 48,160
  66.    Box 51,150 To 84,160 : Text 52,158,"COMP" : Set Zone 54,51,150 To 84,160
  67.    Box 87,150 To 120,160 : Text 93,158,"RED" : Set Zone 55,87,150 To 120,160
  68.    Box 123,150 To 166,160 : Text 125,158,"GREEN" : Set Zone 56,123,150 To 166,160
  69.    Box 169,150 To 202,160 : Text 170,158,"BLUE" : Set Zone 57,169,150 To 202,160
  70.    Box 213,145 To 301,155 : Text 238,153,"RANGE" : Set Zone 58,213,145 To 301,155
  71.    Box 213,20 To 301,137 : Text 218,30,"CHANGE RES"
  72.    Box 215,35 To 299,45 : Text 222,43,"LOWRES  4" : Set Zone 46,215,35 To 299,45
  73.    Box 215,50 To 299,60 : Text 222,58,"LOWRES  8" : Set Zone 47,215,50 To 299,60
  74.    Box 215,65 To 299,75 : Text 222,73,"LOWRES 16" : Set Zone 48,215,65 To 299,75
  75.    Box 215,80 To 299,90 : Text 222,88,"LOWRES 32" : Set Zone 49,215,80 To 299,90
  76.    Box 215,95 To 299,105 : Text 222,103,"HIRES   4" : Set Zone 50,215,95 To 299,105
  77.    Box 215,110 To 299,120 : Text 222,118,"HIRES   8" : Set Zone 51,215,110 To 299,120
  78.    Box 215,125 To 299,135 : Text 222,133,"HIRES  16" : Set Zone 52,215,125 To 299,135
  79.    Ink SELCOL
  80.    Bar 195,120 To 201,129
  81.    Ink BC : Box 194,119 To 202,130
  82.    SFADERS[SELCOL]
  83.    AGAIN2:
  84.    OK=0 : While OK=0
  85.       While Mouse Key=0 : Wend : YM=Y Screen(Y Mouse) : Z=Mouse Zone
  86.       If Z>0 and Z<4
  87.          CFADERS[SELCOL,Z-1,YM]
  88.          SFADERS[SELCOL]
  89.       End If 
  90.       If Z>3 and Z<36
  91.          SELCOL=Z-4
  92.          Ink SELCOL
  93.          Bar 195,120 To 201,129
  94.          SFADERS[SELCOL]
  95.          Ink SELCOL
  96.       End If 
  97.       If Z=37
  98.          OK=1
  99.       End If 
  100.       If Z<>39 Then Goto T40
  101.       FINDRES : NRES=Param+1
  102.       DD$=Fsel$("","","Farben speichern")
  103.       If DD$="" Then Goto T40
  104.       Open Out 1,DD$
  105.       Print #1,NRES
  106.       For X=0 To 31
  107.          Print #1,Colour(X)
  108.       Next 
  109.       For X=0 To 2
  110.          Print #1,ZYCLUS(X)
  111.       Next 
  112.       Close 
  113.       T40:
  114.       If Z<>40 Then Goto E40
  115.       FINDRES : NRES=Param+1
  116.       DD$=Fsel$("","","Farben laden")
  117.       If DD$="" Then Goto E40
  118.       Open In 1,DD$
  119.       Input #1,NNRES
  120.       Close 1
  121.       If NRES<>NNRES Then CHANGERES[NNRES-1]
  122.       Open In 1,DD$
  123.       Input #1,NRES
  124.       For X=0 To 31
  125.          Input #1,FW
  126.          Colour X,FW
  127.       Next 
  128.       For X=0 To 2
  129.          Input #1,ZYCLUS(X)
  130.       Next 
  131.       Close 1
  132.       Goto AGAIN
  133.       E40:
  134.       If Z>52 Then Goto SPEC
  135.       If Z>45 Then Goto CRES
  136.       SPEC:
  137.       If Z=53 Then NEGATIV
  138.       If Z=54 Then COMPLEMENT
  139.       If Z=55 Then RED
  140.       If Z=56 Then GREEN
  141.       If Z=57 Then BLUE
  142.       If Z=58 Then RANGE
  143.       If Z=36 Then Gosub RESET : OK=1
  144.       If Z=38 Then Gosub RESET : Goto AGAIN
  145.       If Z=41 Then BW
  146.       If Z=42 Then ANTIK
  147.       If Z=43 Then Change Mouse 2 : COPCOL : Change Mouse 1
  148.       If Z=44 Then Change Mouse 2 : EXCOL : Change Mouse 1
  149.       If Z=45 Then Change Mouse 2 : SPREAD : Change Mouse 1
  150.       While Mouse Key=1 : Wend 
  151.       SFADERS[SELCOL]
  152.    Wend 
  153.    Cls : Flash Off : Curs Off 
  154.    Pop Proc
  155.    RESET:
  156.    FINDRES : If Param<>RES-1 Then CHANGERES[RES-1]
  157.    For A=0 To Screen Colour-1
  158.       Colour A,RGB(A) : SPCOL[A,RGB(A)]
  159.    Next 
  160.    Return 
  161.    CRES:
  162.    NRES=Z-46
  163.    FINDRES : If Param=NRES Then Goto AGAIN2
  164.    CRES2:
  165.    CHANGERES[NRES]
  166.    FINDRES : NRES=Param
  167.    Goto AGAIN
  168. End Proc
  169. Procedure CFADERS[S,F,YM]
  170.    Dim R(2)
  171.    C=Colour(S)
  172.    R(0)=C/256
  173.    R(1)=(C/16) mod 16
  174.    R(2)=C mod 16
  175.    V=Max(0,Min(15,15-(YM-7)/6))
  176.    R(F)=V
  177.    Colour S,(R(0)*256+R(1)*16+R(2))
  178.    SPCOL[S,Colour(S)]
  179. End Proc
  180. Procedure SFADERS[S]
  181.    Shared RGBO
  182.    FC=2 : BC=0
  183.    Dim R(2)
  184.    C=RGBO
  185.    R(0)=C/256
  186.    R(1)=(C/16) mod 16
  187.    R(2)=C mod 16
  188.    Ink BC,BC
  189.    A=0 : Repeat 
  190.       V=(15-R(A))*6 : Bar 17+20*A,7+V To 28+20*A,12+V
  191.       Inc A
  192.    Until A=3
  193.    C=Colour(S)
  194.    RGBO=C
  195.    R(0)=C/256
  196.    R(1)=(C/16) mod 16
  197.    R(2)=C mod 16
  198.    Ink BC,BC
  199.    Bar 80,121 To 191,128
  200.    Ink FC,BC
  201.    Text 80,128,"Col"+Right$(" "+Str$(S),2)+" Val:$"+Right$("000"+Mid$(Hex$(RGBO),2),3)
  202.    Ink BC,FC
  203.    A=0 : Repeat 
  204.       Ink FC,FC
  205.       V=(15-R(A))*6 : Box 17+20*A,7+V To 28+20*A,12+V
  206.       Ink S
  207.       Bar 18+20*A,8+V To 27+20*A,11+V
  208.       Inc A
  209.    Until A=3
  210. End Proc
  211. Procedure SPCOL[A,B]
  212.    If Length(1)>0
  213.       Doke Start(1)+2+8*Length(1)+2*A,B
  214.    End If 
  215. End Proc
  216. Procedure BW
  217.    For X=0 To Screen Colour-1
  218.       RGBA=Colour(X)
  219.       C1=RGBA/256
  220.       C2=(RGBA/16) mod 16
  221.       C3=RGBA mod 16
  222.       C=C1+C2+C3
  223.       C1=C/3
  224.       C2=C/3
  225.       C3=C/3
  226.       C=(C1*256)+(C1*16)+C3
  227.       Colour X,C
  228.       SPCOL[X,C]
  229.    Next 
  230. End Proc
  231. Procedure ANTIK
  232.    For X=0 To Screen Colour-1
  233.       RGBA=Colour(X)
  234.       C1=RGBA/256
  235.       C2=(RGBA/16) mod 16
  236.       C3=RGBA mod 16
  237.       C=C1+C2+C3
  238.       C1=C/3
  239.       C2=C/4
  240.       C3=C/5
  241.       C=(C1*256)+(C1*16)+C3
  242.       Colour X,C
  243.       SPCOL[X,C]
  244.    Next 
  245. End Proc
  246. Procedure RED
  247.    For X=0 To Screen Colour-1
  248.       RGB$=Hex$(Colour(X),3)
  249.       Mid$(RGB$,3,2)="00"
  250.       Colour X,Val(RGB$)
  251.    Next 
  252. End Proc
  253. Procedure GREEN
  254.    For X=0 To Screen Colour-1
  255.       RGB$=Hex$(Colour(X),3)
  256.       Mid$(RGB$,2,1)="0"
  257.       Mid$(RGB$,4,1)="0"
  258.       Colour X,Val(RGB$)
  259.    Next 
  260. End Proc
  261. Procedure BLUE
  262.    For X=0 To Screen Colour-1
  263.       RGB$=Hex$(Colour(X),3)
  264.       Mid$(RGB$,2,2)="00"
  265.       Colour X,Val(RGB$)
  266.    Next 
  267. End Proc
  268. Procedure NEGATIV
  269.    For X=0 To Screen Colour-1
  270.       RGB=Colour(X)
  271.       RGB= Not RGB
  272.       Colour X,RGB
  273.    Next 
  274. End Proc
  275. Procedure COMPLEMENT
  276.    For X=0 To Screen Colour-1
  277.       RGB$=Hex$(Colour(X),3)
  278.       R$=Mid$(RGB$,2,1)
  279.       B$=Mid$(RGB$,4,1)
  280.       Mid$(RGB$,2,1)=B$
  281.       Mid$(RGB$,4,1)=R$
  282.       Colour X,Val(RGB$)
  283.    Next 
  284. End Proc
  285. Procedure COPCOL
  286.    M$="COPY FROM:"
  287.    Text 15,170,M$
  288.    Z=0 : ZZ=0
  289.    CL1:
  290.    While Mouse Key=0 : Wend 
  291.    Z=Mouse Zone
  292.    If Z<4 Then Goto CL1
  293.    If Z>35 Then Goto CL1
  294.    Z=Z-4
  295.    RGBA=Colour(Z)
  296.    M$=M$+Str$(Z)+" TO:" : Text 15,170,M$
  297.    CL2:
  298.    While Mouse Key<>0 : Wend 
  299.    While Mouse Key=0 : Wend 
  300.    ZZ=Mouse Zone
  301.    If ZZ<4 Then Goto CL2
  302.    If ZZ>35 Then Goto CL2
  303.    ZZ=ZZ-4
  304.    Colour ZZ,RGBA
  305.    M$=M$+Str$(ZZ) : Text 15,170,M$ : Wait 20
  306.    For X=1 To Len(M$) : Mid$(M$,X,1)=" " : Next : Text 15,170,M$
  307. End Proc
  308. Procedure RANGE
  309.    Shared ZYCLUS()
  310.    M$="RANGE FROM:"
  311.    Text 15,170,M$
  312.    Z=0 : ZZ=0
  313.    CL1:
  314.    While Mouse Key=0 : Wend 
  315.    Z=Mouse Zone
  316.    If Z<4 Then Goto CL1
  317.    If Z>35 Then Goto CL1
  318.    Z=Z-4
  319.    M$=M$+Str$(Z)+" TO:" : Text 15,170,M$
  320.    CL2:
  321.    While Mouse Key<>0 : Wend 
  322.    While Mouse Key=0 : Wend 
  323.    ZZ=Mouse Zone
  324.    If ZZ<4 Then Goto CL2
  325.    If ZZ>35 Then Goto CL2
  326.    ZZ=ZZ-4
  327.    M$=M$+Str$(ZZ) : Text 15,170,M$ : Wait 20
  328.    For X=1 To Len(M$) : Mid$(M$,X,1)=" " : Next : Text 15,170,M$
  329.    ZYCLUS(2)=0
  330.    If ZYCLUS(0)<>ZYCLUS(1) Then ZYCLUS(2)=1
  331. End Proc
  332. Procedure EXCOL
  333.    M$="EXCHANGE:"
  334.    Text 15,170,M$
  335.    Z=0 : ZZ=0
  336.    CL1:
  337.    While Mouse Key=0 : Wend 
  338.    Z=Mouse Zone
  339.    If Z<4 Then Goto CL1
  340.    If Z>35 Then Goto CL1
  341.    Z=Z-4
  342.    RGBA=Colour(Z)
  343.    M$=M$+Str$(Z)+" WITH:" : Text 15,170,M$
  344.    CL2:
  345.    While Mouse Key<>0 : Wend 
  346.    While Mouse Key=0 : Wend 
  347.    ZZ=Mouse Zone
  348.    If ZZ<4 Then Goto CL2
  349.    If ZZ>35 Then Goto CL2
  350.    ZZ=ZZ-4
  351.    M$=M$+Str$(ZZ) : Text 15,170,M$ : Wait 20
  352.    RGBB=Colour(ZZ)
  353.    Colour ZZ,RGBA
  354.    Colour Z,RGBB
  355.    For X=1 To Len(M$) : Mid$(M$,X,1)=" " : Next : Text 15,170,M$
  356. End Proc
  357. Procedure SPREAD
  358.    M$="SPREAD FROM:"
  359.    Text 15,170,M$
  360.    CL1:
  361.    While Mouse Key=0 : Wend 
  362.    X=Mouse Zone
  363.    If X<4 Then Goto CL1
  364.    If X>35 Then Goto CL1
  365.    X=X-4
  366.    M$=M$+Str$(X)+" TO:" : Text 15,170,M$
  367.    CL2:
  368.    While Mouse Key<>0 : Wend 
  369.    While Mouse Key=0 : Wend 
  370.    Y=Mouse Zone
  371.    If Y<4 Then Goto CL2
  372.    If Y>35 Then Goto CL2
  373.    Y=Y-4
  374.    M$=M$+Str$(Y) : Text 15,170,M$ : Wait 20
  375.    If Y<X Then Swap X,Y
  376.    RGBA=Colour(X)
  377.    RGBB=Colour(Y)
  378.    DIFF=Y-X : If DIFF>-2 and DIFF<2 Then Goto EX
  379.    R1=RGBA/256
  380.    G1=(RGBA/16) mod 16
  381.    B1=RGBA mod 16
  382.    R2=RGBB/256
  383.    G2=(RGBB/16) mod 16
  384.    B2=RGBB mod 16
  385.    DIFF1=(R2-R1)/DIFF
  386.    DIFF2=(G2-G1)/DIFF
  387.    DIFF3=(B2-B1)/DIFF
  388.    DIFFER=(DIFF1*256)+(DIFF2*16)+DIFF3
  389.    X=X+1 : Y=Y-1
  390.    If X<=Y
  391.       For Z=X To Y
  392.          RGB=RGBA+DIFFER
  393.          RGBA=RGB
  394.          Colour Z,RGB
  395.          SPCOL[Z,RGB]
  396.       Next 
  397.    End If 
  398.    If X>Y
  399.       For Z=X To Y Step -1
  400.          RGB=RGBA+DIFFER
  401.          RGBA=RGB
  402.          Colour Z,RGB
  403.          SPCOL[Z,RGB]
  404.       Next 
  405.    End If 
  406.    EX:
  407.    For X=1 To Len(M$) : Mid$(M$,X,1)=" " : Next : Text 15,170,M$
  408. End Proc
  409. Procedure CHANGERES[REZ]
  410.    Restore INFO : For A=0 To REZ : Read SX,NC,ST : Next A
  411.    SW=Screen Width
  412.    If Extension_22_00AA =Hires Then If ST=Lowres Then SW=Screen Width/2
  413.    If Extension_22_00AA =Lowres Then If ST=Hires Then SW=Screen Width*2
  414.    Dim C(31)
  415.    For X=0 To 31
  416.       C(X)=Colour(X)
  417.    Next 
  418.    SS=Screen
  419.    INFO:
  420.    Data 320,4,Lowres
  421.    Data 320,8,Lowres
  422.    Data 320,16,Lowres
  423.    Data 320,32,Lowres
  424.    Data 640,4,Hires
  425.    Data 640,8,Hires
  426.    Data 640,16,Hires
  427.    Screen Open SS,SW,Screen Height,NC,ST
  428.    Curs Off : Flash Off 
  429.    For X=0 To 31
  430.       Colour X,C(X)
  431.    Next 
  432. End Proc
  433. Procedure FINDRES
  434.    B=Screen Colour : C= Extension_22_00AA 
  435.    RES=-1
  436.    Restore INFO
  437.    NR:
  438.    RES=RES+1
  439.    Read SX,NC,ST
  440.    If NC=B Then If ST=C Then Goto EX
  441.    If RES=6 Then Print "error" : Stop 
  442.    Goto NR
  443.    INFO:
  444.    Data 320,4,Lowres
  445.    Data 320,8,Lowres
  446.    Data 320,16,Lowres
  447.    Data 320,32,Lowres
  448.    Data 640,4,Hires
  449.    Data 640,8,Hires
  450.    Data 640,16,Hires
  451.    EX:
  452. End Proc[RES]