home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / general / pal.amos / pal.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1991-03-24  |  6.4 KB  |  248 lines
  1. '****       Palette SETTER      ****   
  2. '****             by            **** 
  3. '****       John J. Cassar      **** 
  4. '
  5. Dim DEX(32),CPX(32),CPY(32)
  6. Global DEX(),CPX(),CPY(),FSH,FP1,FP2,FRATE,FFLAG,BX
  7. Global C$,W1,W2,W3,DCL,CLR,CL,Y1,Y2,S,S2,MP
  8. Get Disc Fonts 
  9. PAL
  10. Run "AutoExec.AMOS"
  11. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  12. Procedure PAL
  13.    FP1=1 : FP2=16 : FSH=1 : FRATE=10
  14.    FFLAG=False : MP=1 : CL=1
  15.    CLR=Screen Colour
  16.    Colour 0,0 : Colour 1,$EEE
  17.    Curs Off : Flash Off : Cls 0
  18.    Set Font 1
  19.    Gr Writing 1
  20.    Curs Off : Flash Off 
  21.    Y1=80 : S=60 : S2=4
  22.    Get Cblock 1,106,56,120,130
  23.    Ink 0 : Bar 106,56 To 213,183
  24.    Paste Bob 106,56,7
  25.    Wait Vbl : Bob Off 
  26.    PALSETUP
  27.    U=S/8-2 : Y2=Y1+2 : Q=0 : PC=CLR-1 : SS=7
  28.    DCOL
  29. Ink 4
  30. '---------------------------------------------   
  31.    While K<>14
  32.       Repeat 
  33.       Until Mouse Key
  34.       K=Mouse Zone
  35.       If K=<3
  36.          SREAD[K]
  37.       End If 
  38.       If K=4 Then PALEX
  39.       If K=5 Then PALCOPY
  40.       If K=6 Then PSPREAD
  41.       If K=7 Then FSPREAD
  42.       If K=8 and FRATE>1 Then FRATE=FRATE-1 : PFLRATE
  43.       If K=9 and FRATE<1000 Then FRATE=FRATE+1 : PFLRATE
  44.       If K=10 Then PFTEST
  45.       If K=11 Then PFDIR
  46.       If K=12 Then Gosub PUNDO : K=14 : Goto PFIN
  47.       If K=13 Then Gosub PUNDO
  48.       If K=14 Then Goto PFIN
  49.       If K>14
  50.          CL=Point(X Screen(X Mouse),Y Screen(Y Mouse))
  51.          DCOL
  52.       End If 
  53. PFIN:
  54.    Wend 
  55.    Reset Zone 
  56.    Put Cblock 1,106,56
  57.    Del Cblock 1
  58.    Z=0
  59.    Pop Proc
  60. PUNDO:
  61.    For I=0 To CLR-1
  62.       Colour I,DEX(I)
  63.    Next I
  64.    DCOL
  65.    Return 
  66. End Proc
  67. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  68. Procedure PALSETUP
  69.    If FSH=1 Then T$="U" Else T$="D"
  70.    Ink 0,1 : Text 199,162,T$
  71.    PFLRATE
  72.    Reserve Zone 46
  73.    Set Zone 1,120,Y1 To 130,Y1+S
  74.    Set Zone 2,132,Y1 To 142,Y1+S
  75.    Set Zone 3,144,Y1 To 154,Y1+S
  76.    Set Zone 4,112,142 To 128,152
  77.    Set Zone 5,133,142 To 162,152
  78.    Set Zone 6,167,142 To 207,152
  79.    Set Zone 7,112,154 To 155,164
  80.    Set Zone 8,158,156 To 163,162
  81.    Set Zone 9,186,156 To 192,162
  82.    Set Zone 10,165,154 To 186,164
  83.    Set Zone 11,195,154 To 207,164
  84.    Set Zone 12,112,166 To 152,176
  85.    Set Zone 13,155,166 To 183,176
  86.    Set Zone 14,187,166 To 207,176
  87.    CLR=Screen Colour
  88.    U=5 : Y2=Y1+2 : Q=0 : PC=CLR-1 : SS=7 : DCL=1
  89.    If PC>32 Then PC=31
  90.    If SS>PC Then SS=PC
  91.    For T=0 To PC Step 8
  92.       For I=0+T To SS+T
  93.          Ink I
  94.          Bar 160+Q,Y2 To 170+Q,Y2+U
  95.          CPX(I)=160+Q : CPY(I)=Y2-1
  96.          DEX(I)=Colour(I)
  97.          Set Zone I+15,160+Q,Y2 To 170+Q,Y2+U
  98.          Y2=Y2+U+2
  99.       Next I
  100.       Y2=Y1+2 : Q=Q+12
  101.    Next T
  102.    Set Slider 0,1,0,0,0,1,0,1
  103.    Ink 1 : Draw CPX(DCL),CPY(DCL) To CPX(DCL)+10,CPY(DCL)
  104.    Draw CPX(DCL),CPY(DCL)+7 To CPX(DCL)+10,CPY(DCL)+7
  105.    End Proc
  106. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  107. Procedure PFLRATE
  108.    Ink 0
  109.    F$=Str$(FRATE)
  110.    If FRATE<10 Then F$=" "+Str$(FRATE)
  111.    F$=Right$(F$,3)
  112.    Ink 0,1 : Text 167,162,F$
  113.    FSTATE
  114.    Wait 10
  115. End Proc
  116. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  117. Procedure PFTEST
  118.       If FFLAG=True Then Shift Off : Wait 10 : FFLAG=False : Pop Proc
  119.       If FSH=1 Then Shift Up FRATE,FP1,FP2,1
  120.       If FSH=2 Then Shift Down FRATE,FP1,FP2,1
  121.       FFLAG=True : Wait 10
  122. End Proc
  123. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  124. Procedure PFDIR
  125.    If FSH=1
  126.       FSH=2 : Ink 0,1 : Text 199,162,"D"
  127.    Else 
  128.       FSH=1 : Ink 0,1 : Text 199,162,"U"
  129.    End If 
  130.    FSTATE
  131.    Wait 10
  132. End Proc
  133. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  134. Procedure PSPREAD
  135.    DCOL
  136.    CP1=CL : Change Mouse 7
  137.    R1#=W1 : G1#=W2 : B1#=W3
  138.    Wait 30
  139.    Repeat 
  140.    Until Mouse Key<>0 and Mouse Zone>14
  141.    Change Mouse MP
  142.    CL=Point(X Screen(X Mouse),Y Screen(Y Mouse))
  143.    DCOL
  144.    R2#=W1 : G2#=W2 : B2#=W3
  145.    If CP1>CL
  146.       Swap CP1,CL
  147.       Swap R1#,R2# : Swap G1#,G2# : Swap B1#,B2#
  148.    End If 
  149.    SPREAD=CL-CP1
  150.    If SPREAD<3 Then Pop Proc
  151.    RSTEP#=(R2#-R1#)/SPREAD
  152.    GSTEP#=(G2#-G1#)/SPREAD
  153.    BSTEP#=(B2#-B1#)/SPREAD
  154.    For SPREADING=0 To SPREAD-1
  155.       RNEW=R1#+SPREADING*RSTEP#
  156.       GNEW=G1#+SPREADING*GSTEP#
  157.       BNEW=B1#+SPREADING*BSTEP#
  158.       Colour SPREADING+CP1,RNEW*256+GNEW*16+BNEW
  159.    Next SPREADING
  160. End Proc
  161. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  162. Procedure FSTATE
  163.    If FFLAG=True and FSH=1 Then Shift Up FRATE,FP1,FP2,1
  164.    If FFLAG=True and FSH=2 Then Shift Down FRATE,FP1,FP2,1
  165. End Proc
  166. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  167. Procedure FSPREAD
  168.    Change Mouse 9
  169.    Repeat 
  170.    Until Mouse Key<>0 and Mouse Zone>14
  171.    CL=Point(X Screen(X Mouse),Y Screen(Y Mouse))
  172.    FP1=CL : DCOL
  173.    Change Mouse 7
  174.    Repeat 
  175.    Until Mouse Key<>0 and Mouse Zone>14
  176.    CL=Point(X Screen(X Mouse),Y Screen(Y Mouse))
  177.    FP2=CL : DCOL
  178.    If FP1>FP2 Then Swap FP1,FP2
  179.    Change Mouse MP
  180.    FSTATE
  181. End Proc
  182. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  183. Procedure PALEX
  184.    CP1$=C$ : CP1=CL : Change Mouse 7
  185.    Wait 30
  186.    Repeat 
  187.    Until Mouse Key<>0 and Mouse Zone>14
  188.    CL=Point(X Screen(X Mouse),Y Screen(Y Mouse))
  189.    CP2=CL : DCOL : CP2$=C$
  190.    Colour CP1,Val(CP2$) : DCOL
  191.    Colour CP2,Val(CP1$) : DCOL
  192.    Change Mouse MP
  193. End Proc
  194. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  195. Procedure PALCOPY
  196.    CP$=C$ : Change Mouse 7
  197.    Wait 30
  198.    Repeat 
  199.    Until Mouse Key<>0 and Mouse Zone>14
  200.    K=Mouse Zone : CL=K-15
  201.    Colour CL,Val(CP$)
  202.    DCOL
  203.    Change Mouse MP
  204. End Proc
  205. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  206. Procedure DCOL
  207.    C$=Hex$(Colour(CL),3)
  208.    W1=Val(Left$(C$,2)) : A=15-W1
  209.    VSLIDE[1,A*S2]
  210.    Q$="$"+Mid$(C$,3,1) : W2=Val(Q$) : A=15-W2
  211.    VSLIDE[2,A*S2]
  212.    Q$="$"+Right$(C$,1) : W3=Val(Q$) : A=15-W3
  213.    VSLIDE[3,A*S2]
  214. End Proc
  215. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  216. Procedure SREAD[Z]
  217.    YM=Y Screen(Y Mouse)
  218.    While Mouse Zone=Z
  219.       Y=Y Screen(Y Mouse)
  220.       If Y<>YM and Mouse Key=1 Then VSLIDE[Z,Y-Y1] : YM=Y
  221.    Wend 
  222. End Proc[Y]
  223. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= 
  224. Procedure VSLIDE[Z,Y]
  225.    Y2=S-Y
  226.    If Y<0 or Y>S Then Pop Proc
  227.    A$=Hex$(Y2/S2)
  228.    If Z=1
  229.       A$=A$+Right$(C$,2) : C$=A$
  230.       Vslider 125,Y1 To 130,Y1+S,S,Y,1
  231.    End If 
  232.    If Z=2
  233.       B$=Left$(C$,2)+Right$(A$,1)+Right$(C$,1) : C$=B$
  234.       Vslider 137,Y1 To 142,Y1+S,S,Y,1
  235.    End If 
  236.    If Z=3
  237.       B$=Left$(C$,3)+Right$(A$,1) : C$=B$
  238.       Vslider 149,Y1 To 154,Y1+S,S,Y,1
  239.    End If 
  240.    Colour CL,Val(C$)
  241.    Ink CL : Bar 161,Y1-7 To 180,Y1-3
  242.    Ink 1 : Draw CPX(DCL),CPY(DCL) To CPX(DCL)+10,CPY(DCL)
  243.    Draw CPX(DCL),CPY(DCL)+7 To CPX(DCL)+10,CPY(DCL)+7
  244.    Ink 0 : Draw CPX(CL),CPY(CL) To CPX(CL)+10,CPY(CL)
  245.    Draw CPX(CL),CPY(CL)+7 To CPX(CL)+10,CPY(CL)+7
  246.    Ink 0,1 : Text 184,Y1-2,C$
  247.    DCL=CL : Wait Vbl 
  248. End Proc