home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / games / wordpuzsolve.amos / wordpuzsolve.amosSourceCode < prev   
AMOS Source Code  |  1990-10-26  |  9KB  |  317 lines
  1. Rem WORDSQUARE SOLVER AMIGA
  2. Rem By Jeff Tullin 
  3. Rem (c) 1990 
  4. Screen Open 0,320,300,16,Lowres
  5. Curs Off : Cls 0 : Hide 
  6. '  
  7. Dim A$(900)
  8. Global HEIGHT,WIDTH,A$(),I$,MK,FLAG,STRT,WORD$,FOUND,QUIT$
  9. '
  10. DISPLAY
  11. Repeat 
  12.    EMPTYARRAY
  13.    QUERYSIZE
  14.    MAINSCREEN
  15.    LETTERENTRY
  16.    WORDENTRY
  17. Until QUIT$="N"
  18. End 
  19. '
  20. Procedure DISPLAY
  21.    Unpack 1 To 1
  22.    Palette ,,,$F80
  23.    Wait Key 
  24.    Appear 0 To 1,109
  25.    Screen Close 1
  26.    Double Buffer 
  27.    Autoback 0
  28. End Proc
  29. Procedure EMPTYARRAY
  30.    For X=0 To 900 : A$(X)="." : Next 
  31.    A$(899)="@"
  32. End Proc
  33. '  
  34. Procedure QUERYSIZE
  35.    '                           ( double buffer needed to stop screen flicker) 
  36.    Screen Swap : Curs Off 
  37.    Cls 0 : Pen 2 : Paper 9
  38.    Locate 0,2 : Centre "Please select the size of the"
  39.    Locate 0,4 : Centre "wordsquare by moving the sliders"
  40.    Locate 0,6 : Centre "with the mouse.."
  41.    Pen 5 : Paper 0
  42.    Locate 0,10 : Centre "* CLICK HERE WHEN READY *"
  43.    Pen 2
  44.    Locate 4,15 : Centre " Chars across=    Chars Down=     "
  45.    Reserve Zone 3
  46.    '                             set up zones for mouse in sliders & exit box 
  47.    Set Zone 1,0,175 To 297,195
  48.    Set Zone 2,0,0 To 20,174
  49.    Set Zone 3,50,75 To 260,95
  50.    Ink 2 : Box 50,75 To 260,95
  51.    Set Slider 0,2,4,11,2,2,8,11
  52.    HSLIDE[9]
  53.    VSLIDE[9]
  54.    '                                    now show the people what we've done...  
  55.    Screen Copy Logic To Physic
  56.    Show 
  57.    '                              keep reading sliders until exit is selected.  
  58.    Repeat 
  59.       SREAD
  60.    Until Mouse Zone=3 and Mouse Key
  61.    Ink 5 : Box 50,75 To 260,95
  62.    '                                               flash box around exit text 
  63.    Bell 45
  64.    Screen Swap : Wait 10
  65. End Proc
  66. '
  67. Procedure SREAD
  68.    Rem: checks for mouse key in sliders, and redraws to suit
  69.    XM=X Screen(X Mouse)
  70.    YM=Y Screen(Y Mouse)
  71.    MK=Mouse Key
  72.    While Mouse Zone=1
  73.       MK=Mouse Key
  74.       X=X Screen(X Mouse)
  75.       If X<>XM and MK=1 Then HSLIDE[X/9] : XM=X
  76.       Screen Copy Logic To Physic
  77.    Wend 
  78.    While Mouse Zone=2
  79.       MK=Mouse Key
  80.       Y=Y Screen(Y Mouse)
  81.       If Y<>YM and MK=1 Then VSLIDE[Y/10] : YM=Y
  82.       Screen Copy Logic To Physic
  83.    Wend 
  84. End Proc[X]
  85. Procedure HSLIDE[X]
  86.    Hslider 0,180 To 297,190,33,X,1
  87.    Locate 17,15 : Print X+3;" "; : WIDTH=X+3
  88. End Proc
  89. Procedure VSLIDE[Y]
  90.    Vslider 0,0 To 10,174,17,Y,1
  91.    Locate 32,15 : Print Y+3;" "; : HEIGHT=Y+3
  92. End Proc
  93. '
  94. Procedure MAINSCREEN
  95.    '                                                         create main grid 
  96.    Cls 
  97.    Cls 7,11,11 To((WIDTH+3)*8+3),((HEIGHT+3)*8+3)
  98.    Cls 2,8,8 To(WIDTH+3)*8,(HEIGHT+3)*8
  99.    Ink 4
  100.    Box 10,10 To(WIDTH+3)*8-2,(HEIGHT+3)*8-2
  101.    Set Zone 2,17,17 To(WIDTH+2)*8-1,(HEIGHT+2)*8-1
  102. End Proc
  103. Procedure LETTERENTRY
  104.    '                                                     create main menu box 
  105.    Cls 7,62,184 To 254,198
  106.    Cls 4,60,181 To 252,196
  107.    Ink 2 : Box 62,182 To 249,193
  108.    Set Zone 1,62,182 To 249,193
  109.    Pen 2
  110.    Paper 4
  111.    Locate 8,23
  112.    Print " Please enter letters:"
  113.    Paper 6 : Pen 7
  114.    '                                 reset creates initial grid full of spots 
  115.    RESET
  116.    Screen Swap 
  117.    Screen Copy Physic To Logic
  118.    Autoback 0
  119.    '                                    now get the letters to fill the grid..
  120.    Repeat 
  121.       ACCEPTLETTERS
  122.    Until FLAG=0
  123. End Proc
  124. Procedure ACCEPTLETTERS
  125.    '                       FLAG is a once only signal to print 'click here..' 
  126.    If FLAG=0
  127.       Pen 2 : Paper 7
  128.       Locate 8,23 : Print " CLICK HERE WHEN READY ";
  129.       Pen 7 : Paper 6
  130.       FLAG=1
  131.    End If 
  132.    '
  133.    '                                                      grid begins at 2,2  
  134.    XPOS=2 : YPOS=2
  135.    Curs On 
  136.    Locate XPOS,YPOS
  137.    Repeat 
  138.       I$=Inkey$
  139.       I$=Upper$(I$)
  140.       '                                     only letters of A to Z acceptable  
  141.       If Asc(I$)>64 and Asc(I$)<91
  142.          A$((XPOS-2)+(YPOS-2)*WIDTH)=I$
  143.          '                      keep variable space down by garbage collection  
  144.          DUMMY=Free
  145.          Print I$;
  146.          Add XPOS,1,2 To WIDTH+1
  147.          If XPOS=2
  148.             Add YPOS,1,2 To HEIGHT+1
  149.          End If 
  150.          Locate XPOS,YPOS
  151.          Screen Copy Logic To Physic
  152.       End If 
  153.       '                             read mouse, and reposition cursor to suit
  154.       While Mouse Zone=2 and Mouse Key=1
  155.          XPOS=X Screen(X Mouse)/8
  156.          YPOS=Y Screen(Y Mouse)/8
  157.          Locate XPOS,YPOS
  158.          Screen Swap 
  159.          Screen Copy Physic To Logic
  160.       Wend 
  161.    Until Mouse Zone=1 and Mouse Key=1
  162.    FLAG=0
  163. End Proc
  164. Procedure WORDENTRY
  165.    Curs Off 
  166.    '                                              add reset box at this point 
  167.    Cls 7,14,184 To 61,198
  168.    Cls 5,12,181 To 59,196
  169.    Ink 0 : Box 13,182 To 57,193
  170.    Set Zone 2,13,182 To 56,193
  171.    Locate 2,23 : Paper 0 : Pen 2
  172.    Print "RESET";
  173.    '                                                         and add quit box 
  174.    Cls 7,255,184 To 302,198
  175.    Cls 5,253,181 To 300,196
  176.    Ink 0 : Box 254,182 To 297,193
  177.    Set Zone 3,254,182 To 297,193
  178.    Locate 32,23 : Print "QUIT!";
  179.    Paper 2 : Pen 0
  180.    Locate 8,23 : Print "  Enter 'hidden' word  "
  181.    Screen Copy Logic To Physic
  182.    '
  183.    '                    make sure that mouse button not pressed at this point 
  184.    Repeat : Until Mouse Key=0
  185.    Repeat 
  186.       If Mouse Zone=2 and Mouse Key
  187.          Bell 40
  188.          Ink 2 : Box 13,182 To 57,193
  189.          Screen Swap 
  190.          RESET
  191.          Paper 2 : Pen 0
  192.       End If 
  193.       '
  194.       If(Mouse Zone=1 and Mouse Key)
  195.          Ink 0 : Box 62,182 To 249,193
  196.          Screen Swap : Bell 45 : Wait 5
  197.          LIMINPUT[19,8,23]
  198.          WORD$=Param$
  199.          If Len(WORD$)>2
  200.             SEEK
  201.             Paper 2 : Pen 0
  202.             Locate 8,23 : Print "  Enter 'hidden' word  "
  203.             Screen Copy Logic To Physic
  204.          End If 
  205.       End If 
  206.    Until Mouse Zone=3 and Mouse Key=1
  207.    Ink 2 : Box 254,182 To 297,193
  208.    Screen Swap : Bell 48 : Wait 5
  209.    Locate 8,23 : Pen 3 : Print "  ANOTHER GRID? (Y/N)  "
  210.    Screen Swap 
  211.    Repeat : QUIT$=Upper$(Inkey$)
  212.    Until(QUIT$="Y") or(QUIT$="N")
  213. End Proc
  214. Procedure RESET
  215.    '                                     clear all letters to original colour 
  216.    Pen 7 : Paper 6
  217.    For H=1 To HEIGHT
  218.       Locate 2,H+1
  219.       For W=1 To WIDTH
  220.          Print A$(W-1+((H-1)*WIDTH));
  221.       Next 
  222.    Next 
  223.    Locate 2,2
  224.    Screen Swap 
  225.    Screen Copy Physic To Logic
  226. End Proc
  227. Procedure LIMINPUT[CHARS,X,Y]
  228.    '                                  accept CHARS characters at location X,Y 
  229.    Hide 
  230.    Repeat : Until Inkey$=""
  231.    A$=Space$(23) : Locate X,Y : Centre A$ : Centre "?"
  232.    LTH=0
  233.    Repeat 
  234.       I$=Upper$(Inkey$)
  235.       If(I$=>"A") and(I$<="Z")
  236.          Locate X,Y : Curs On 
  237.          If LTH<CHARS
  238.             Add LTH,1 : Mid$(A$,LTH,1)=I$
  239.          Else 
  240.             Bell 
  241.          End If 
  242.       End If 
  243.       If Scancode=65 and LTH<>0
  244.          Add LTH,-1
  245.       End If 
  246.       If LTH<>0
  247.          Locate 0,Y : Centre(" "+Left$(A$,LTH)+" "+Chr$(8))
  248.       End If 
  249.       Screen Copy Logic To Physic
  250.    Until I$=Chr$(13) and LTH>2 : Curs Off : Show 
  251. End Proc[Left$(A$,LTH)]
  252. Procedure SEEK
  253.    '                      check each letter until 1st letter of Word$ matches 
  254.    FOUND=False
  255.    For STRT=0 To(WIDTH*HEIGHT)
  256.       If Left$(WORD$,1)=A$(STRT)
  257.          CHECK_WHOLE_WORD
  258.       End If 
  259.       If FOUND
  260.          STRT=900
  261.       End If 
  262.    Next 
  263. End Proc
  264. Procedure CHECK_WHOLE_WORD
  265.    '                                   search in all eight compass directions 
  266.    SEARCH[0,1]
  267.    If Not FOUND
  268.       SEARCH[WIDTH,1]
  269.    End If 
  270.    If Not FOUND
  271.       SEARCH[WIDTH,0]
  272.    End If 
  273.    If Not FOUND
  274.       SEARCH[WIDTH,-1]
  275.    End If 
  276.    If Not FOUND
  277.       SEARCH[0,-1]
  278.    End If 
  279.    If Not FOUND
  280.       SEARCH[-WIDTH,-1]
  281.    End If 
  282.    If Not FOUND
  283.       SEARCH[-WIDTH,0]
  284.    End If 
  285.    If Not FOUND
  286.       SEARCH[-WIDTH,1]
  287.    End If 
  288. End Proc
  289. Procedure SEARCH[HDIR,WDIR]
  290.    '                     start at 2nd letter of word$, check letter by letter 
  291.    '                                    in direction HDIR and WDIR as vectors 
  292.    NXT=STRT
  293.    FOUND=True
  294.    For X=2 To Len(WORD$)
  295.       NXT=NXT+HDIR+WDIR
  296.       If NXT<0 or NXT>(WIDTH*HEIGHT)
  297.          NXT=899
  298.       End If 
  299.       If A$(NXT)<>Mid$(WORD$,X,1)
  300.          FOUND=False : X=255
  301.       End If 
  302.    Next X
  303.    '
  304.    If FOUND
  305.       HILITE[HDIR,WDIR]
  306.    End If 
  307. End Proc
  308. Procedure HILITE[HDIR,WDIR]
  309.    '                                    turn 'found' word white to show it up 
  310.    Pen 2 : Paper 6
  311.    STRT=STRT-(HDIR+WDIR)
  312.    For X=1 To Len(WORD$)
  313.       Add STRT,(HDIR+WDIR)
  314.       Locate(2+(STRT mod WIDTH)),(2+(STRT/WIDTH)) : Print A$(STRT);
  315.    Next X
  316.    Pen 0 : Paper 2
  317. End Proc