home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / procedures / edgedetection.amos / edgedetection.amosSourceCode
AMOS Source Code  |  1991-04-06  |  2KB  |  76 lines
  1. '   Edge Detection Program By Dominic Ramsey 
  2. '
  3. '                April 1991  
  4. '
  5. ' 2 The Paddocks, Haddenham, Bucks. HP17 8AG.
  6. '
  7. STRT:
  8. Screen Open 0,320,200,2,Lowres : Curs Off : Hide On : Palette 0,$FFF
  9. Print : Centre "This edge detection program will"
  10. Print : Centre "convert any non ham IFF image into a"
  11. Print : Centre "two colour line drawing. The Picture"
  12. Print : Centre "can then be saved to disk and"
  13. Print : Centre "used in any art or DTP program."
  14. Print : Print : Print : Centre "Press Mouse"
  15. While Mouse Key=0 : Wend 
  16. Cls 0
  17. EDG_DETEC
  18. Procedure EDG_DETEC
  19. Show On 
  20.  F$=Fsel$("DF0:","*","Choose A Non Ham Picture","For Edge Detection")
  21. Hide On 
  22. If F$="" Then End 
  23. Load Iff F$,0
  24. SW=Screen Width(0)
  25. SH=Screen Height(0)
  26. If Screen Colour=4096
  27. Cls 0 : Paper 0 : Pen 1
  28. Centre "Sorry, can't use ham pictures- try again"
  29. Wait 50
  30. EDG_DETEC
  31. End If 
  32. Wait 100
  33. If Screen Colour=32
  34. Screen Open 1,SW,SH,2,Lowres
  35. Else 
  36. Screen Open 1,SW,SH,2,Hires
  37. End If 
  38. Palette $FFF,0
  39. Centre " Enter sensitivity,  Press (0-3)"
  40. Print : Print : Centre "Try Low value for cartoons"
  41. Print : Centre "High value for digitised pictures"
  42. Print : Print : Centre "Try 1 for first attempt."
  43. Repeat 
  44. S$=Inkey$
  45. S=Asc(S$)
  46. Until S>47 and S<51
  47. S=S-48
  48. '
  49. 'Try increasing s for 16 col B/W digitised pictures. 
  50. '
  51. Cls 0
  52. Ink 1,0
  53. PP=15
  54. For Y=0 To SH-1
  55. For X=0 To SW-1
  56. Screen 0
  57. P=Point(X,Y)
  58. If P-PP>=S or PP-P=>S
  59.  Screen 1
  60.  Plot X,Y
  61. Screen 0
  62. End If 
  63. PY=Point(X,Y-1)
  64. If P-PY>S or PY-P>S
  65.  Screen 1
  66.  Plot X,Y
  67.  Screen 0
  68. End If 
  69. PP=P
  70. Next X
  71. Next Y
  72. End Proc
  73. F$=Fsel$("Savescreen.iff","","Save new screen")
  74. If F$="" Then End 
  75. Save Iff F$,1
  76. Goto STRT