Return to insan.p CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / pascal / tstpx / src

Annotation of 43BSDReno/pgrm/pascal/tstpx/src/insan.p, revision 1.1

1.1     ! root        1: program insane(input, output);
        !             2: label
        !             3:        1;
        !             4: type
        !             5:        alfa = packed array[1..10] of char;
        !             6:        metaface = (notaface, front, back, top, bottom, left, right);
        !             7:        face = front .. right;
        !             8:        metapair = (notapair, one2, three4, five6);
        !             9:        pair = one2 .. five6;
        !            10:        metacolor = (notacolor, red, blue, green, white);
        !            11:        color = red .. white;
        !            12:        blockno = 1..4;
        !            13: var
        !            14:        nosolutions: Boolean;
        !            15:        index, halfindex: integer;
        !            16:        pointr: integer;
        !            17:        datas: array[blockno, face] of alfa;
        !            18:        sum: array[blockno, pair, color] of integer;
        !            19:        halfsolution: array[blockno, 1..30] of pair;
        !            20: 
        !            21: function word(alf: alfa): color;
        !            22: begin
        !            23:        if alf = 'red' then
        !            24:                word := red else
        !            25:        if alf = 'blue' then
        !            26:                word := blue else
        !            27:        if alf = 'green' then
        !            28:                word := green else
        !            29:                word := white;
        !            30: end;
        !            31: 
        !            32: procedure readin;
        !            33: var
        !            34:        hue: alfa;
        !            35:        ch: char;
        !            36:        cube: blockno;
        !            37:        position: face;
        !            38: 
        !            39: procedure tone;
        !            40: begin
        !            41:        case ch of
        !            42:        'r': hue := 'red';
        !            43:        'w': hue := 'white';
        !            44:        'g': hue := 'green';
        !            45:        'b': hue := 'blue';
        !            46:        end;
        !            47: end;
        !            48: 
        !            49: begin
        !            50:        for cube := 1 to 4 do
        !            51:        begin
        !            52:                for position := front to right do
        !            53:                begin
        !            54:                        read(ch);
        !            55:                        tone;
        !            56:                        datas[cube, position] := hue;
        !            57:                end;
        !            58:                readln;
        !            59:        end;
        !            60: end;
        !            61: 
        !            62: procedure sumcolors;
        !            63: var
        !            64:        cube: blockno;
        !            65:        side: face;
        !            66: function facepair(aface: face): pair;
        !            67: begin
        !            68:        case aface of
        !            69:        front, back: facepair := one2;
        !            70:        top, bottom: facepair := three4;
        !            71:        left, right: facepair := five6
        !            72:        end;
        !            73: end;
        !            74: 
        !            75: procedure initializesum;
        !            76: var
        !            77:        cube: blockno;
        !            78:        side: face;
        !            79:        technicolor: color;
        !            80: begin
        !            81:        for cube := 1 to 4 do
        !            82:                for side :=  front to right do
        !            83:                        for technicolor := red to white do
        !            84:                                sum[cube, facepair(side), technicolor] := 0;
        !            85: end;
        !            86: 
        !            87: begin
        !            88:        initializesum;
        !            89:        for cube := 1 to 4 do
        !            90:                for side := front to right do
        !            91:                        sum[cube, facepair(side), word(datas[cube,side])] :=
        !            92:                        sum[cube, facepair(side), word(datas[cube,side])] + 1;
        !            93: end;
        !            94: 
        !            95: procedure find2222;
        !            96: var
        !            97:        subtotals: array[red..white] of integer;
        !            98:        pair1, pair2, pair3, pair4: pair;
        !            99: 
        !           100: function two222(pair1, pair2, pair3, pair4: pair): Boolean;
        !           101: var
        !           102:        hue: color;
        !           103: begin
        !           104:        for hue := red to white do
        !           105:                subtotals[hue] :=
        !           106:                        sum[1, pair1, hue]+
        !           107:                        sum[2, pair2, hue]+
        !           108:                        sum[3, pair3, hue]+
        !           109:                        sum[4, pair4, hue];
        !           110:        if (subtotals[red]=2) and
        !           111:           (subtotals[blue]=2) and
        !           112:           (subtotals[green]=2) and
        !           113:           (subtotals[white]=2) then
        !           114:                two222 := true else
        !           115:                two222 := false;
        !           116: end;
        !           117: 
        !           118: procedure listsolution;
        !           119: begin
        !           120:        halfsolution[1, halfindex] := pair1;
        !           121:        halfsolution[2, halfindex] := pair2;
        !           122:        halfsolution[3, halfindex] := pair3;
        !           123:        halfsolution[4, halfindex] := pair4;
        !           124:        halfindex := halfindex + 1;
        !           125: end;
        !           126: 
        !           127: begin
        !           128:        halfindex := 1;
        !           129:        for pair1 := one2 to five6 do
        !           130:        for pair2 := one2 to five6 do
        !           131:        for pair3 := one2 to five6 do
        !           132:        for pair4 := one2 to five6 do
        !           133:                if two222(pair1, pair2, pair3, pair4) then
        !           134:                        listsolution;
        !           135:        if halfindex <= 2 then
        !           136:        begin
        !           137:                nosolutions := true;
        !           138:                goto 1;
        !           139:        end;
        !           140: end;
        !           141: 
        !           142: procedure simultaneous;
        !           143: var
        !           144:        done: Boolean;
        !           145: begin
        !           146:        nosolutions := false;
        !           147:        pointr := 0;
        !           148:        done := false;
        !           149:        repeat
        !           150:                pointr := pointr + 1;
        !           151:                repeat
        !           152:                        index := succ(pointr);
        !           153:                        if (halfsolution[1, pointr]<>halfsolution[1,index]) and
        !           154:                           (halfsolution[2, pointr]<>halfsolution[2,index]) and
        !           155:                           (halfsolution[3, pointr]<>halfsolution[3,index]) and
        !           156:                           (halfsolution[4, pointr]<>halfsolution[4,index]) then
        !           157:                                done := true else
        !           158:                                index := index + 1;
        !           159:                until done or (index = pred(halfindex));
        !           160:        until done or (pointr = halfindex);
        !           161:        if pointr = halfindex then
        !           162:        begin
        !           163:                nosolutions := true;
        !           164:                goto 1;
        !           165:        end;
        !           166: end;
        !           167: 
        !           168: procedure rearrange;
        !           169: var
        !           170:        box: blockno;
        !           171:        a, b: pair;
        !           172: 
        !           173: procedure put(a, b: pair);
        !           174: var
        !           175:        old1, new1, old2, new2: face;
        !           176:        save1, save2: alfa;
        !           177: 
        !           178: procedure oldpair(c: pair);
        !           179: begin
        !           180:        case c of
        !           181:        one2:
        !           182:                begin
        !           183:                        old1 := front;
        !           184:                        old2 := back;
        !           185:                end;
        !           186:        three4:
        !           187:                begin
        !           188:                        old1 := top;
        !           189:                        old2 := bottom;
        !           190:                end;
        !           191:        five6:
        !           192:                begin
        !           193:                        old1 := left;
        !           194:                        old2 := right;
        !           195:                end
        !           196:        end;
        !           197: end;
        !           198: procedure newpair(d: pair);
        !           199: begin
        !           200:        oldpair(b);
        !           201:        new1 := old1;
        !           202:        new2 := old2;
        !           203: end;
        !           204: 
        !           205: begin
        !           206:        newpair(b);
        !           207:        oldpair(a);
        !           208:        save1 := datas[box, new1];
        !           209:        datas[box, new1] := datas[box, old1];
        !           210:        datas[box, old1] := save1;
        !           211:        save2 := datas[box, new2];
        !           212:        datas[box, new2] := datas[box, old2];
        !           213:        datas[box, old2] := save2;
        !           214: end;
        !           215: 
        !           216: begin
        !           217:        for box := 1 to 4 do
        !           218:        begin
        !           219:                a := halfsolution[box, pointr];
        !           220:                b := halfsolution[box, index];
        !           221:                if (a=one2) and (b=five6) then
        !           222:                        put(five6, three4) else
        !           223:                begin
        !           224:                        if a = three4 then
        !           225:                        begin
        !           226:                                if b = one2 then
        !           227:                                begin
        !           228:                                        put(one2, five6);
        !           229:                                        put(three4, one2);
        !           230:                                        put(five6, three4);
        !           231:                                end else
        !           232:                                begin
        !           233:                                        put(three4, one2);
        !           234:                                        put(five6, three4);
        !           235:                                end
        !           236:                        end else
        !           237:                        if b = one2 then
        !           238:                        begin
        !           239:                                put(one2, three4);
        !           240:                                put(five6, one2);
        !           241:                        end else
        !           242:                                put(five6, one2);
        !           243:                end;
        !           244:        end;
        !           245: end;
        !           246: 
        !           247: procedure correct;
        !           248: var
        !           249:        list: array[1..8] of integer;
        !           250:        done: Boolean;
        !           251:        side: face;
        !           252:        counter: integer;
        !           253: 
        !           254: procedure check;
        !           255: var
        !           256:        delux: array[red..white] of integer;
        !           257:        kolor: color;
        !           258:        counter: integer;
        !           259: begin
        !           260:        done := true;
        !           261:        for kolor := red to white do
        !           262:                for counter := 1 to 4 do
        !           263:                        delux[kolor] := 0;
        !           264:        for counter := 1 to 4 do
        !           265:        begin
        !           266:                delux[word(datas[counter,side])] :=
        !           267:                delux[word(datas[counter,side])] + 1;
        !           268:                if delux[word(datas[counter,side])] >= 2 then
        !           269:                        done := false;
        !           270:        end;
        !           271: end;
        !           272: 
        !           273: procedure rotate;
        !           274: var
        !           275:        save: alfa;
        !           276:        opposite: face;
        !           277: begin
        !           278:        if side = back then
        !           279:                opposite := front else
        !           280:        if side = front then
        !           281:                opposite := back else
        !           282:        if side = top then
        !           283:                opposite := bottom else
        !           284:        if side = bottom then
        !           285:                opposite := top;
        !           286:        save := datas[list[counter], side];
        !           287:        datas[list[counter], side] := datas[list[counter], opposite];
        !           288:        datas[list[counter], opposite] := save;
        !           289: end;
        !           290: 
        !           291: begin
        !           292:        list[1] := 4;
        !           293:        list[2] := 3;
        !           294:        list[3] := 4;
        !           295:        list[4] := 2;
        !           296:        list[5] := 4;
        !           297:        list[6] := 3;
        !           298:        list[7] := 4;
        !           299:        list[8] := 3;
        !           300:        for side := back to top do
        !           301:        begin
        !           302:                counter := 0;
        !           303:                check;
        !           304:                while not done do
        !           305:                begin
        !           306:                        counter := counter + 1;
        !           307:                        rotate;
        !           308:                        check;
        !           309:                end;
        !           310:        end
        !           311: end;
        !           312: 
        !           313: procedure printout;
        !           314: var
        !           315:        space: integer;
        !           316:        cube: integer;
        !           317:        side: face;
        !           318: begin
        !           319:        if nosolutions then
        !           320:                writeln('no solutions') else
        !           321:        begin
        !           322:                writeln('solution to instant insanity');
        !           323:                for cube := 1 to 4 do
        !           324:                begin
        !           325:                        write(cube, '   ');
        !           326:                        for side := front to bottom do
        !           327:                                write(datas[cube, side]);
        !           328:                        writeln;
        !           329:                end;
        !           330:        end;
        !           331: end;
        !           332: 
        !           333: begin
        !           334:        reset(input);
        !           335:        readin;
        !           336:        sumcolors;
        !           337:        find2222;
        !           338:        simultaneous;
        !           339:        rearrange;
        !           340:        correct;
        !           341: 1:
        !           342:        printout;
        !           343: end.
        !           344: {
        !           345: wbggrb
        !           346: wbrgrr
        !           347: wbgwrg
        !           348: wrgwbr
        !           349: }

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