home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 601-625 / apd616 / source / palette_proc_addon.amos / palette_proc_addon.amosSourceCode
AMOS Source Code  |  1994-05-23  |  8KB  |  346 lines

  1. '
  2. ' *** Palette Requester Procedure. 
  3. '
  4. Procedure _PALETTEREQUESTER[S]
  5.    '
  6.    '  S  -  This is the screen number to change the palette on. 
  7.    '
  8.    ' *** Backup Dialog String.  
  9.    '    
  10.    B_DLG$=_DIALOGBUTTON$
  11.    _DIALOGBUTTON$=""
  12.    '
  13.    SY=70
  14.    '  
  15.    _OPENDIALOGSCREEN[7,80,SY]
  16.    '
  17.    Screen S
  18.    SC=Screen Colour
  19.    If SC>64
  20.       SC=16
  21.       FF=16
  22.    Else 
  23.       FF=SC
  24.    End If 
  25.    C=1
  26.    '
  27.    Screen Open 6,320,20,SC,Lowres
  28.    Screen Display 6,,SY+81,,
  29.    Curs Off 
  30.    Flash Off 
  31.    Cls 0
  32.    '
  33.    Get Palette S
  34.    '    
  35.    STP=320/SC
  36.    LOP=0
  37.    While LOP<SC+1
  38.       Ink LOP
  39.       Bar LOP*STP,2 To LOP*STP+STP,20
  40.       Inc LOP
  41.    Wend 
  42.    Gosub _LINE
  43.    '
  44.    Screen 7
  45.    '
  46.    _DRAW3DBOX[0,0,639,79,"",0,0,3]
  47.    _DRAW3DBOX[46,0,639,12,"Palette Requester V1.0",1,_TEXT,_COLOUR]
  48.    '
  49.    _ADDBUTTON[0,0,44,12,"OK",11]
  50.    '
  51.    _DRAW3DBOX[10,16,38,34,"R",1,_TEXT,_BACK]
  52.    _DRAW3DBOX[10,36,38,54,"G",1,_TEXT,_BACK]
  53.    _DRAW3DBOX[10,56,38,74,"B",1,_TEXT,_BACK]
  54.    '
  55.    _HORIZONTALSLIDER[42,16,460,34,16,1,""]
  56.    _HORIZONTALSLIDER[42,36,460,54,16,1,""]
  57.    _HORIZONTALSLIDER[42,56,460,74,16,1,""]
  58.    '
  59.    _ADDBUTTON[462,19,476,31,"(S)LAR",1]
  60.    _ADDBUTTON[462,39,476,51,"(S)LAR",2]
  61.    _ADDBUTTON[462,59,476,71,"(S)LAR",3]
  62.    _ADDBUTTON[478,19,492,31,"(S)RAR",4]
  63.    _ADDBUTTON[478,39,492,51,"(S)RAR",5]
  64.    _ADDBUTTON[478,59,492,71,"(S)RAR",6]
  65.    '
  66.    _DRAW3DBOX[495,16,521,34,"",0,_TEXT,_COLOUR]
  67.    _DRAW3DBOX[495,36,521,54,"",0,_TEXT,_COLOUR]
  68.    _DRAW3DBOX[495,56,521,74,"",0,_TEXT,_COLOUR]
  69.    _DRAW3DBOX[497,17,519,33,"",1,_TEXT,_BACK]
  70.    _DRAW3DBOX[497,37,519,53,"",1,_TEXT,_BACK]
  71.    _DRAW3DBOX[497,57,519,73,"",1,_TEXT,_BACK]
  72.    '
  73.    _ADDBUTTON[525,16,629,30,"Spread",7]
  74.    _ADDBUTTON[525,31,629,45,"Swap",8]
  75.    _ADDBUTTON[525,46,629,60,"Copy",9]
  76.    _ADDBUTTON[525,61,629,75,"Reset",10]
  77.    '
  78.    Gosub _GET
  79.    Gosub _LINE
  80.    Gosub _R_SLIDER
  81.    Gosub _G_SLIDER
  82.    Gosub _B_SLIDER
  83.    '
  84.    Do 
  85.       '
  86.       _CHECKBUTTONS
  87.       ZN=Param
  88.       '      
  89.       _CHECKZONE[46,0,639,12,0]
  90.       If Param
  91.          YY=Y Screen(Y Mouse)
  92.          While Mouse Key
  93.             If Y Mouse>42 and Y Mouse<200
  94.                SY=Y Mouse
  95.                Screen Display 7,,SY-YY,,
  96.                Screen Display 6,,SY-YY+81,,
  97.             End If 
  98.          Wend 
  99.       End If 
  100.       '      
  101.       If ZN=11
  102.          Goto FIN
  103.       End If 
  104.       '    
  105.       If ZN=1 and R>0
  106.          Dec R
  107.          Gosub _R_SLIDER
  108.          Gosub _CHANGE
  109.       End If 
  110.       '
  111.       If ZN=4 and R<15
  112.          Inc R
  113.          Gosub _R_SLIDER
  114.          Gosub _CHANGE
  115.       End If 
  116.       '  
  117.       If ZN=2 and G>0
  118.          Dec G
  119.          Gosub _G_SLIDER
  120.          Gosub _CHANGE
  121.       End If 
  122.       '
  123.       If ZN=5 and G<15
  124.          Inc G
  125.          Gosub _G_SLIDER
  126.          Gosub _CHANGE
  127.       End If 
  128.       '
  129.       If ZN=3 and B>0
  130.          Dec B
  131.          Gosub _B_SLIDER
  132.          Gosub _CHANGE
  133.       End If 
  134.       '
  135.       If ZN=6 and B<15
  136.          Inc B
  137.          Gosub _B_SLIDER
  138.          Gosub _CHANGE
  139.       End If 
  140.       '
  141.       If ZN=7
  142.          '  
  143.          _DRAW3DBOX[26,0,639,12,"Select Colour To Spread To (ESC Exits)",2,_LIGHT,_COLOUR]
  144.          '  
  145.          CC=C
  146.          Screen 6
  147.          '
  148.          Repeat 
  149.             If Mouse Key
  150.                CC=Point(X Screen(6,X Mouse),Y Screen(6,Y Mouse))
  151.             End If 
  152.          Until Inkey$=Chr$(27) or(CC<>C and CC<FF)
  153.          '
  154.          If CC<>C
  155.             TC=C
  156.             E=CC
  157.             If TC>E
  158.                Swap TC,E
  159.             End If 
  160.             Screen 6
  161.             For A=TC+1 To E-1
  162.                CDIF=E-A+1
  163.                RDIF=((Colour(E) and 3840)/256)-((Colour(A-1) and 3840)/256)
  164.                RA=((Colour(A-1) and 3840)/256)+(RDIF/CDIF)
  165.                GDIF=((Colour(E) and 240)/16)-((Colour(A-1) and 240)/16)
  166.                GA=((Colour(A-1) and 240)/16)+(GDIF/CDIF)
  167.                BDIF=(Colour(E) and 15)-(Colour(A-1) and 15)
  168.                BA=(Colour(A-1) and 15)+(BDIF/CDIF)
  169.                Colour A,(RA*256+GA*16+BA)
  170.             Next A
  171.          End If 
  172.          '
  173.          Screen 7
  174.          _DRAW3DBOX[26,0,639,12,"Palette Requester V1.0",2,_TEXT,_COLOUR]
  175.          '
  176.          Gosub _GET
  177.          Gosub _R_SLIDER
  178.          Gosub _G_SLIDER
  179.          Gosub _B_SLIDER
  180.          '
  181.       End If 
  182.       '
  183.       If ZN=8
  184.          _DRAW3DBOX[26,0,639,12,"Select Colour To Swap With (ESC Exits)",2,_LIGHT,_COLOUR]
  185.          '  
  186.          CC=C
  187.          Screen 6
  188.          '  
  189.          Repeat 
  190.             If Mouse Key
  191.                CC=Point(X Screen(6,X Mouse),Y Screen(6,Y Mouse))
  192.             End If 
  193.          Until Inkey$=Chr$(27) or(CC<>C and CC<FF)
  194.          '
  195.          TMP=Colour(C)
  196.          Colour C,Colour(CC)
  197.          Colour CC,TMP
  198.          Screen 7
  199.          '
  200.          _DRAW3DBOX[26,0,639,12,"Palette Requester V1.0",2,_TEXT,_COLOUR]
  201.          '
  202.          Gosub _GET
  203.          Gosub _R_SLIDER
  204.          Gosub _G_SLIDER
  205.          Gosub _B_SLIDER
  206.          '
  207.       End If 
  208.       '
  209.       If ZN=9
  210.          '  
  211.          _DRAW3DBOX[26,0,639,12,"Select Colour To Copy To (ESC Exits)",2,_LIGHT,_COLOUR]
  212.          '  
  213.          CC=C
  214.          Screen 6
  215.          '
  216.          Repeat 
  217.             If Mouse Key
  218.                CC=Point(X Screen(6,X Mouse),Y Screen(6,Y Mouse))
  219.             End If 
  220.          Until Inkey$=Chr$(27) or(CC<>C and CC<FF)
  221.          '
  222.          Colour C,Colour(CC)
  223.          '
  224.          Screen 7
  225.          _DRAW3DBOX[26,0,639,12,"Palette Requester V1.0",2,_TEXT,_COLOUR]
  226.          '
  227.          Gosub _GET
  228.          Gosub _R_SLIDER
  229.          Gosub _G_SLIDER
  230.          Gosub _B_SLIDER
  231.          '
  232.       End If 
  233.       '
  234.       If ZN=10
  235.          Screen 6
  236.          Get Palette S
  237.          Screen 7
  238.          Gosub _GET
  239.          Gosub _R_SLIDER
  240.          Gosub _G_SLIDER
  241.          Gosub _B_SLIDER
  242.       End If 
  243.       '
  244.       If Scin(X Mouse,Y Mouse)=6
  245.          Gosub _PICK
  246.       End If 
  247.       '
  248.       _CHECKZONE[42+(R*26),16,42+(R*26)+24,34,0]
  249.       If Param
  250.          While Mouse Key and X Screen(X Mouse)>46 and X Screen(X Mouse)<454
  251.             R=(X Screen(X Mouse)-42)/26
  252.             Gosub _R_SLIDER
  253.             Gosub _CHANGE
  254.          Wend 
  255.       End If 
  256.       '
  257.       _CHECKZONE[42+(G*26),36,42+(G*26)+24,54,0]
  258.       If Param
  259.          While Mouse Key and X Screen(X Mouse)>46 and X Screen(X Mouse)<454
  260.             G=(X Screen(X Mouse)-42)/26
  261.             Gosub _G_SLIDER
  262.             Gosub _CHANGE
  263.          Wend 
  264.       End If 
  265.       '
  266.       _CHECKZONE[42+(B*26),56,42+(B*26)+24,74,0]
  267.       If Param
  268.          While Mouse Key and X Screen(X Mouse)>46 and X Screen(X Mouse)<454
  269.             B=(X Screen(X Mouse)-42)/26
  270.             Gosub _B_SLIDER
  271.             Gosub _CHANGE
  272.          Wend 
  273.       End If 
  274.       '
  275.    Loop 
  276.    '
  277.    FIN:
  278.    Screen S
  279.    Get Palette 6
  280.    Screen Close 7
  281.    Screen Close 6
  282.    '
  283.    _DIALOGBUTTON$=B_DLG$
  284.    B_DLG$=""
  285.    '    
  286.    Pop Proc
  287.    '  
  288.    _PICK:
  289.    While Scin(X Mouse,Y Mouse)=6
  290.       '    
  291.       Screen 6
  292.       '  
  293.       If Mouse Key
  294.          C=Point(X Screen(6,X Mouse),Y Screen(6,Y Mouse))
  295.          Gosub _GET
  296.          Gosub _LINE
  297.          Gosub _R_SLIDER
  298.          Gosub _G_SLIDER
  299.          Gosub _B_SLIDER
  300.       End If 
  301.       '  
  302.    Wend 
  303.    '
  304.    Screen 7
  305.    Return 
  306.    '    
  307.    _LINE:
  308.    Screen 6
  309.    Ink 0
  310.    Draw 0,0 To 319,0
  311.    Ink 1
  312.    Draw C*STP,0 To C*STP+STP,0
  313.    Screen 7
  314.    Return 
  315.    '
  316.    _GET:
  317.    R=Colour(C)/256
  318.    G=Colour(C)/16 mod 16
  319.    B=Colour(C) mod 16
  320.    Return 
  321.    '
  322.    _R_SLIDER:
  323.    _HORIZONTALSLIDER[42,16,460,34,16,R+1,""]
  324.    _DRAW3DBOX[497,17,519,33,Str$(R)-" ",2,_TEXT,_BACK]
  325.    Return 
  326.    '
  327.    _G_SLIDER:
  328.    _HORIZONTALSLIDER[42,36,460,54,16,G+1,""]
  329.    _DRAW3DBOX[496,37,519,53,Str$(G)-" ",2,_TEXT,_BACK]
  330.    Return 
  331.    '
  332.    _B_SLIDER:
  333.    _HORIZONTALSLIDER[42,56,460,74,16,B+1,""]
  334.    _DRAW3DBOX[497,57,519,73,Str$(B)-" ",2,_TEXT,_BACK]
  335.    Return 
  336.    '
  337.    _CHANGE:
  338.    R$=Hex$(R)
  339.    G$=Mid$(Hex$(G),2,1)
  340.    B$=Mid$(Hex$(B),2,1)
  341.    Screen 6
  342.    Colour C,Val(R$+G$+B$)
  343.    Screen 7
  344.    Return 
  345.    '
  346. End Proc