home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / extensions / jd / _newprogs / texterkennung.amos / texterkennung.amosSourceCode
AMOS Source Code  |  1994-03-12  |  4KB  |  168 lines
  1. Set Buffer 150
  2. Screen Open 0,640,256,4,Hires
  3. Cls 0
  4. Palette $FFF,$0 : Colour Back $FFF : Pen 1 : Paper 0
  5. Wait 5
  6. STA:
  7. Input "Shall I (r)ead a pictured text or shall I (l)earn a font? ";WHAT$
  8. Cls 0
  9. If WHAT$="r" Then Goto _READ
  10. If WHAT$="l" Then Goto _LEARN
  11. If WHAT$="" Then End 
  12. Goto STA
  13. _LEARN:
  14. Input "Which font shall I learn? ";F$
  15. Input "Which size shall I learn? ";G
  16. Ink 1,0 : Pen 1 : Paper 0 : Curs Off : Cls 0
  17. If F$="" Then F$="topaz.font" : G=8
  18. If Right$(F$,5)<>".font" Then F$=F$+".font"
  19. F2$=F$-".font"
  20.  Extension_22_0788 F$,G
  21. Wait 5
  22. L1= Extension_22_04A4 : L2= Extension_22_04B4 
  23. G$=Str$(G)-" "
  24. Dim WW$(L2)
  25. FL$="DH0:AMOS_Pro/TFonts/"+F2$+G$+".FDATA"
  26. If Exist(FL$) Then Print "Font is already known!" : End 
  27. If G<9 Then SL=1 : Goto SKIP
  28. Cls 0 : Locate 0,0 : Extension_22_079C Chr$(255)
  29. For LY=1 To L2
  30.    WW$(LY)="%"
  31.    For LX=1 To L1
  32.       W=Point(LX-1,LY-1)
  33.       WW$(LY)=WW$(LY)+Bin$(W,1)-"%"
  34.    Next 
  35. Next 
  36. For LY=1 To L2
  37.    If Val(WW$(LY))<>0 Then SL=LY : Exit 
  38. Next 
  39. SKIP:
  40. Open Out 1,FL$
  41. Print #1,L1
  42. Print #1,L2+1-SL
  43. For B=32 To 255
  44.    Cls 0 : Locate 0,0
  45.     Extension_22_079C Chr$(B)
  46.    For LY=1 To L2
  47.       WW$(LY)="%"
  48.       For LX=1 To L1
  49.          W=Point(LX-1,LY-1)
  50.          WW$(LY)=WW$(LY)+Bin$(W,1)-"%"
  51.       Next 
  52.    Next 
  53.    For S=SL To L2
  54.       Print #1,WW$(S)
  55.    Next 
  56. Next 
  57. Close 1
  58. End 
  59. _READ:
  60. Input "Which font shall I use? ";F$
  61. Input "Which size shall I use? ";G
  62. Input "What distance is used ? ";D
  63. If F$="" Then F$="default" : G=8
  64. If Right$(F$,5)=".font" Then F$=F$-".font"
  65. G$=Str$(G)-" "
  66. If Exist("SYS:AMOS_Pro/TFonts/"+F$+G$+".FDATA")=0 Then Print : Print "Font not known!" : Wait Key : Cls : Goto _READ
  67. IN2:
  68. Input "Name the IFF-Pic to load: ";FIFF$
  69. If FIFF$="" Then FIFF$=Fsel$("DH0:**","","FontPic to load")
  70. If Exist(FIFF$)=0 Then Print : Print "Pic not found!" : Goto IN2
  71. Print : Print "Please set range for examining!"
  72. Print "Left mousekey for top left point - right mousekey for bottom right point"
  73. Wait 50
  74. Load Iff FIFF$,1
  75. Wait 5
  76. Colour Back Colour(0)
  77. Wait 5
  78. Screen Close 0
  79. Screen Open 2,Screen Width,Screen Height,Screen Colour,Screen Mode
  80. Palette $FFF,$0 : Colour Back $FFF
  81. Get Palette 1
  82. Wait 5
  83. LOP1:
  84. Screen Copy 1 To 2
  85. _LOP:
  86. If Mouse Key=1 Then RX1=X Screen(X Mouse) : RY1=Y Screen(Y Mouse) : Goto SK
  87. Goto _LOP
  88. SK:
  89. While Mouse Key=1
  90. Wend 
  91. While Mouse Key=0
  92.    While X Screen(X Mouse)=RX1 and Y Screen(Y Mouse)=RY1
  93.    Wend 
  94.    Screen Copy 1 To 2
  95.    RX2=X Screen(X Mouse) : RY2=Y Screen(Y Mouse)
  96.    Box RX1,RY1 To RX2,RY2
  97.    If Mouse Key=2 Then Goto LOP1
  98.    If Mouse Key=1 Then Goto EN
  99. Wend 
  100. EN:
  101. Screen Close 2
  102. If RX1>RX2 Then Swap RX1,RX2
  103. If RY1>RY2 Then Swap RY1,RY2
  104. FL$="DH0:AMOS_Pro/TFonts/"+F$+G$+".FDATA"
  105. Open In 1,FL$
  106. Input #1,L1
  107. Input #1,L2
  108. KW=0 : If L1>8 Then KW=1
  109. Dim W2$(255,L2)
  110. For B=32 To 255
  111.    For LY=1 To L2
  112.       Input #1,W2$(B,LY)
  113.    Next 
  114. Next 
  115. Close 1
  116. Dim W$(L2)
  117. X1=RX1 : Y1=RY1
  118. T$=""
  119. FX=X1
  120. While Y1<RY2
  121.    While X1<RX2
  122.       For LY=Y1 To Y1+L2
  123.          W$(LY-Y1)="%"
  124.          For LX=X1 To X1+L1-1
  125.             W=Point(LX-KW,LY-1)
  126.             W$(LY-Y1)=W$(LY-Y1)+Bin$(W,1)-"%"
  127.          Next 
  128.       Next 
  129.       Box X1-1,Y1-KW To X1+L1-KW-1,Y1+L2-1
  130.       For B=32 To 255
  131.          Z=0
  132.          For LY=1 To L2
  133.             If W2$(B,LY)=W$(LY) Then Z=Z+1
  134.          Next 
  135.          If Z=L2 Then WERT=B : T$=T$+Chr$(WERT) : Exit 
  136.       Next 
  137.       If Z<L2 Then Gosub _NOTKNOWN
  138.       X1=X1+L1
  139.    Wend 
  140.    X1=FX : Y1=Y1+L2+D : T$=T$+Chr$(10)
  141. Wend 
  142. EX:
  143. Screen Open 0,Screen Width,Screen Height,4,Screen Mode
  144. Palette $FFF,$0 : Colour Back $FFF
  145. Screen Close 1
  146. Wait 5
  147. Cls 0
  148. Pen 1 : Paper 0
  149. Print T$
  150. F$=Fsel$("","","Save ASCII as")
  151. If F$="" Then End 
  152. Open Out 1,F$
  153. Print #1,T$;
  154. Close 1
  155. End 
  156. _NOTKNOWN:
  157. Screen Open 3,640,50,4,Hires
  158. Screen 3
  159. Palette $0,$FFF
  160. Wait 5
  161. Cls 0
  162. Bell 
  163. Pen 1 : Paper 0
  164. Print "I don't know this letter!"
  165. Input "Please type in via keyboard... ";K$
  166. T$=T$+K$
  167. Screen Close 3
  168. Return