home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / procedures / _coloureffects.amos / _coloureffects.amosSourceCode
AMOS Source Code  |  1994-04-26  |  3KB  |  193 lines
  1. Screen Open 1,320,200,32,Lowres
  2. Wait 5 : Screen Hide 1
  3. Screen 0 : Wait 5
  4. Dim C(31)
  5. Global C()
  6. Flash Off : Curs Off 
  7. For X=0 To 31
  8.    Ink X : Bar X*10,10 To X*10+9,30
  9.    C(X)=Colour(X)
  10. Next 
  11. Locate 0,0 : Print "Normal" : Wait 100
  12.  
  13. DUBBLE:
  14. For X=0 To 31
  15.    A=Colour(X)*2
  16.    Colour X,A
  17. Next 
  18. INFO["Double Cols"]
  19.  
  20. HALVE:
  21. For X=0 To 31
  22.    A=Colour(X)/2
  23.    Colour X,A
  24. Next 
  25. INFO["Halve Cols"]
  26.  
  27. MIXPALETTEN:
  28. For X=0 To 31
  29.    Screen 1 : Wait 5
  30.    A1$=Hex$(Colour(X),3)
  31.    Screen 0 : Wait 5
  32.    A2$=Hex$(Colour(X),3)
  33.    A=(Val(A1$)+Val(A2$))/2
  34.    Colour X,A
  35. Next 
  36. INFO["Mix Palette"]
  37.  
  38. FULL_RED:
  39. For X=0 To 31
  40.    A$=Hex$(Colour(X),3)
  41.    Mid$(A$,2,1)="f"
  42.    Colour X,Val(A$)
  43. Next 
  44. INFO["Full Red"]
  45.  
  46. NO_RED:
  47. For X=0 To 31
  48.    A$=Hex$(Colour(X),3)
  49.    Mid$(A$,2,1)="0"
  50.    Colour X,Val(A$)
  51. Next 
  52. INFO["No Red"]
  53.  
  54. FULL_GREEN:
  55. For X=0 To 31
  56.    A$=Hex$(Colour(X),3)
  57.    Mid$(A$,3,1)="f"
  58.    Colour X,Val(A$)
  59. Next 
  60. INFO["Full Green"]
  61.  
  62. NO_GREEN:
  63. For X=0 To 31
  64.    A$=Hex$(Colour(X),3)
  65.    Mid$(A$,3,1)="0"
  66.    Colour X,Val(A$)
  67. Next 
  68. INFO["No Green"]
  69.  
  70. FULL_BLUE:
  71. For X=0 To 31
  72.    A$=Hex$(Colour(X),3)
  73.    Mid$(A$,4,1)="f"
  74.    Colour X,Val(A$)
  75. Next 
  76. INFO["Full Blue"]
  77.  
  78. NO_BLUE:
  79. For X=0 To 31
  80.    A$=Hex$(Colour(X),3)
  81.    Mid$(A$,4,1)="0"
  82.    Colour X,Val(A$)
  83. Next 
  84. INFO["No Blue"]
  85.  
  86. _ONLY_RED:
  87. For X=0 To 31
  88.    A$=Hex$(Colour(X),3)
  89.    Mid$(A$,3,2)="00"
  90.    Colour X,Val(A$)
  91. Next 
  92. INFO["Only Red"]
  93.  
  94. _ONLY_GREEN:
  95. For X=0 To 31
  96.    A$=Hex$(Colour(X),3)
  97.    Mid$(A$,2,1)="0"
  98.    Mid$(A$,4,1)="0"
  99.    Colour X,Val(A$)
  100. Next 
  101. INFO["Only Green"]
  102.  
  103. _ONLY_BLUE:
  104. For X=0 To 31
  105.    A$=Hex$(Colour(X),3)
  106.    Mid$(A$,2,2)="00"
  107.    Colour X,Val(A$)
  108. Next 
  109. INFO["Only Blue"]
  110.  
  111. PLUS_BLUE:
  112. For X=0 To 31
  113.    A$=Hex$(Colour(X),3)
  114.    Mid$(A$,3,2)="FF"
  115.    Colour X,Val(A$)
  116. Next 
  117. INFO["Plus Blue"]
  118.  
  119. PLUS_RED:
  120. For X=0 To 31
  121.    A$=Hex$(Colour(X),3)
  122.    Mid$(A$,2,1)="F"
  123.    Mid$(A$,4,1)="F"
  124.    Colour X,Val(A$)
  125. Next 
  126. INFO["Plus Red"]
  127.  
  128. PLUS_YELLOW:
  129. For X=0 To 31
  130.    A$=Hex$(Colour(X),3)
  131.    Mid$(A$,2,2)="FF"
  132.    Colour X,Val(A$)
  133. Next 
  134. INFO["Plus Yellow"]
  135.  
  136. NEGATIV:
  137. For X=0 To 31
  138.    C=Colour(X)
  139.    C= Not C
  140.    Colour X,C
  141. Next 
  142. INFO["Negativ"]
  143.  
  144. COMPLEMENT:
  145. For X=0 To 31
  146.    C$=Hex$(Colour(X),3)
  147.    R$=Mid$(C$,2,1)
  148.    B$=Mid$(C$,4,1)
  149.    Mid$(C$,2,1)=B$
  150.    Mid$(C$,4,1)=R$
  151.    Colour X,Val(C$)
  152. Next 
  153. INFO["Complement"]
  154.  
  155. BLACKWHITE:
  156. For X=0 To 31
  157.    C=Colour(X)
  158.    C1=C/256
  159.    C2=(C/16) mod 16
  160.    C3=C mod 16
  161.    C=C1+C2+C3
  162.    C1=C/3
  163.    C2=C/3
  164.    C3=C/3
  165.    C=(C1*256)+(C1*16)+C3
  166.    Colour X,C
  167. Next 
  168. INFO["Black & White"]
  169.  
  170. ANTIK:
  171. For X=0 To 31
  172.    C=Colour(X)
  173.    C1=C/256
  174.    C2=(C/16) mod 16
  175.    C3=C mod 16
  176.    C=C1+C2+C3
  177.    C1=C/3
  178.    C2=C/4
  179.    C3=C/5
  180.    C=(C1*256)+(C1*16)+C3
  181.    Colour X,C
  182. Next 
  183. INFO["Antik"]
  184.  
  185. Locate 0,0 : Print "Normal     " : Wait 100
  186.  
  187. Procedure INFO[A$]
  188.    A$= Extension_22_011A(A$,20,1)
  189.    Locate 0,0 : Print A$ : Wait 100
  190.    For X=0 To 31
  191.       Colour X,C(X)
  192.    Next 
  193. End Proc