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     ! 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.