Return to cross.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / cmd

Annotation of 43BSD/contrib/icon/src/cmd/cross.icn, revision 1.1.1.1

1.1       root        1: #      CROSS(6)
                      2: #
                      3: #      Display intersection of words
                      4: #
                      5: #      William P. Malloy
                      6: #
                      7: #      Last modified 8/14/84
                      8: #
                      9: 
                     10: global fast, place, array, csave, fsave, number
                     11: 
                     12: procedure main()
                     13:    local opt, words, letter, line
                     14:    letter := &lcase ++ &ucase
                     15:    words := []
                     16:    while line := map(read()) do
                     17:       if upto(~letter,line) then stop("input contains nonletter")
                     18:       else put(words,line)
                     19:    number := *words
                     20:    kross(words)
                     21: end
                     22: 
                     23: procedure kross(words)
                     24:    local one, tst, t
                     25:    array := [get(words)]
                     26:    t := 0
                     27:    while one := get(words) do {
                     28:       tst := *words
                     29:       if fit(one,array,0 | 1) then
                     30:         t := 0
                     31:       else {
                     32:         t +:= 1
                     33:          put(words,one)
                     34:         if t > tst then
                     35:            break
                     36:         }
                     37:       }
                     38:    if *words = 0 then Print(array)
                     39:    else write("cannot construct puzzle")
                     40: end
                     41: 
                     42: procedure fit(word,matrix,where)
                     43:    local i, j, k, l, one, test, t, s
                     44:    s := *matrix
                     45:    t := *matrix[1]
                     46:    every k := gen(*word) do
                     47:       every i := gen(s) do
                     48:          every j := gen(t) do
                     49:            if matrix[i][j] == word[k] then {
                     50:                # test for vertical fit
                     51:                if where = 0 then {
                     52:                   test := 0
                     53:                   every l := (i - k + 1) to (i + (*word - k)) do
                     54:                      if tstv(matrix,i,j,l,s,t) then {
                     55:                         test := 1
                     56:                         break
                     57:                         }
                     58:                   if test = 0 then
                     59:                      return putvert(matrix,word,i,j,k)
                     60:                   }
                     61:                if where = 1 then {
                     62:                   test := 0
                     63:                   every l := (j - k + 1) to (j + (*word - k)) do
                     64:                      if tsth(matrix,i,j,l,s,t) then {
                     65:                         test := 1
                     66:                         break
                     67:                         }
                     68:                   if test = 0 then
                     69:                      return puthoriz(matrix,word,i,j,k)
                     70:                   }
                     71:                }
                     72: end
                     73: 
                     74: procedure tstv(matrix,i,j,l,s,t)
                     75:    return ((matrix[(l ~= i) & (s >= l) & (0 < l)][0 < j-1] ~== " ") |
                     76:       (matrix[(l ~= i) & (s >= l) & (0 < l)][t >= j + 1] ~== " ") |
                     77:       (matrix[(i ~= l-1) & (s >= l-1) & (0 < l-1)][j] ~== " ") |
                     78:       (matrix[(i ~= l + 1) & (s >= l+1) & (0 < l + 1)][j] ~== " ") |
                     79:       (matrix[(l ~= i) & (s >= l) & (0 < l)][j] ~== " "))
                     80: end
                     81: 
                     82: procedure tsth(matrix,i,j,l,s,t)
                     83:    return ((matrix[0 < i-1][(l ~= j) & (t >= l) & (0 < l)] ~== " ") |
                     84:       (matrix[s >= i + 1][(l ~= j) & (t >= l) & (0 < l)] ~== " ") |
                     85:       (matrix[i][(j ~= l-1) & (t >= l-1) & (0 < l-1)] ~== " ") |
                     86:       (matrix[i][(j ~= l + 1) & (t >= l + 1) & (0 < l + 1)] ~== " ") |
                     87:       (matrix[i][(l ~= j) & (t >= l) & (0 < l)] ~== " "))
                     88: end
                     89: 
                     90: procedure gen(i)
                     91:    local tmp, up, down
                     92:    tmp := i / 2
                     93:    if (i % 2) = 1 then
                     94:       tmp +:= 1
                     95:    suspend tmp
                     96:    up := tmp
                     97:    down := tmp
                     98:    while (up < i) do {
                     99:       suspend up +:= 1
                    100:       suspend (down > 1) & (down -:= 1)
                    101:       }
                    102: end
                    103: 
                    104: # put `word' in vertically at pos(i,j)
                    105: 
                    106: procedure putvert(matrix,word,i,j,k)
                    107:    local hdim, vdim, up, down, l, m, n
                    108:    vdim := *matrix
                    109:    hdim := *matrix[1]
                    110:    up := 0
                    111:    down := 0
                    112:    up := abs(0 > (i - k))
                    113:    down := abs(0 > ((vdim - i) - (*word - k)))
                    114:    every m := 1 to up do
                    115:       push(matrix,repl(" ",hdim))
                    116:    i +:= up
                    117:    every m := 1 to down do
                    118:       put(matrix,repl(" ",hdim))
                    119:    every l := 1 to *word do
                    120:       matrix[i + l - k][j] := word[l]
                    121:    return matrix
                    122: end
                    123: 
                    124: # put `word' in horizontally at position i,j in matrix
                    125: 
                    126: procedure puthoriz(matrix,word,i,j,k)
                    127:    local hdim, vdim, left, right, l, m, n
                    128:    vdim := *matrix
                    129:    hdim := *matrix[1]
                    130:    left := 0
                    131:    right := 0
                    132:    left := (abs(0 > (j - k))) | 0
                    133:    right := (abs(0 > ((hdim - j) - (*word - k)))) | 0
                    134:    every m := 1 to left do
                    135:       every l := 1 to vdim do
                    136:         matrix[l] := " " || matrix[l]
                    137:    j +:= left
                    138:    every m := 1 to right do
                    139:       every l := 1 to vdim do
                    140:         matrix[l] ||:= " "
                    141:    every l := 1 to *word do
                    142:       matrix[i][j + l - k] := word[l]
                    143:    return matrix
                    144: end
                    145: 
                    146: procedure Print(matrix)
                    147:    local i
                    148:    write("+",repl("-",*matrix[1]),"+")
                    149:    every i := 1 to *matrix do
                    150:       write("|",matrix[i],"|")
                    151:    write("+",repl("-",*matrix[1]),"+")
                    152: end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.