home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / subroutines / pic_dither.amos / pic_dither.amosSourceCode < prev   
AMOS Source Code  |  1978-01-04  |  821b  |  63 lines
  1. ' ****************** 
  2. ' *** PIC DITHER *** 
  3. ' ****************** 
  4.  
  5. ' *** This routine loads in a 32 colour lowres picture, then dithers it
  6. '     into 2 colours on a hires screen.
  7.  
  8. ' *** Load IFF picture.
  9.  
  10. F$=Fsel$("","","LOAD IFF PICTURE")
  11.  
  12. If F$<>""
  13.    Load Iff F$,0
  14. Else 
  15.    Direct 
  16. End If 
  17.  
  18. Screen Hide 0
  19.  
  20. ' *** get picture info.
  21.  
  22. W=Screen Width-1
  23. H=Screen Height-1
  24.  
  25. ' *** Open work screen.. 
  26.  
  27. Screen Open 1,W*2,H*2,2,Hires+Laced
  28. Palette $0,$FFF
  29. Cls 0
  30.  
  31. ' *** Dither picture.
  32.  
  33. For Y=0 To H
  34.    For X=0 To W
  35.       
  36.       Screen 0
  37.       C=Point(X,Y)
  38.       
  39.       C=Colour(C)/$111
  40.       
  41.       Screen 1
  42.       Paste Icon X*2,Y*2,C+1
  43.       
  44.    Next X
  45. Next Y
  46.  
  47. ' *** Close screen.
  48.  
  49. Screen Close 0
  50.  
  51. ' *** Save picture.
  52.  
  53. F$=Fsel$("","","SAVE IFF PICTURE")
  54.  
  55. If F$<>""
  56.    Save Iff F$,0
  57. Else 
  58.    Direct 
  59. End If 
  60.  
  61. ' *** Quit.
  62.  
  63. Direct