(* Modified: Perry, Dave *)

structure Meaning : MEANING = 
struct

    exception Error of string

    type property = Word.word 

    datatype attribute = B | Em | I | S | Tt
    fun attrPos B = 0w0
      | attrPos Em = 0w1
      | attrPos I = 0w2
      | attrPos S = 0w3
      | attrPos Tt = 0w4

    (* shift amount, number of bits, max value - zero based *)
    val underlineInfo = (0w5, 0w2, 3)
    val sizeInfo = (0w7, 0w4, 9)
    val colorInfo = (0w11, 0w4, 7) (* 4 bits to support one unattainable value *)

    (* val null = 0wx0 *)
    (* New null propert has an unattainable color and size *)
    val null = Word.orb(Word.<<(0w10, 0w7),
			Word.<<(0w8, 0w11))

    (* Create sz 1 bits shifted left by sh *)
    fun mask(sz : Word.word, sh : Word.word) = 
	let val unshifted = Word.-(Word.<<(0w1, sz), 0w1)
	in  Word.<<(unshifted,sh)
	end

    fun setAttribute (prop, attr) = Word.orb(prop, mask(0w1, attrPos attr))
    fun invertAttribute (prop, attr) = Word.xorb(prop, mask(0w1, attrPos attr))
    fun clearAttribute (prop, attr) = Word.andb(prop, Word.notb(mask(0w1, attrPos attr)))

    fun makeSetter (shift, maxBit, maxVal) (prop, newValue) = 
	let val cleared = Word.andb(prop, Word.notb(mask(maxBit, shift)))
	    val newValue = if (newValue >= 0 andalso newValue <= maxVal)
			    then Word.fromInt newValue
			else raise (Error "Bad Value")
	in  Word.orb(cleared, Word.<<(newValue, shift))
	end
    val setUnderline = makeSetter underlineInfo
    val setSize = makeSetter sizeInfo
    val setColor = makeSetter colorInfo

    fun isSetAttribute (prop,attr) = Word.andb(0w1, Word.>>(prop, attrPos attr)) = 0w1
    fun makeGetter (shift,maxBit,maxVal) prop = Word.toInt(Word.andb(mask(maxBit, 0w0), 
								     Word.>>(prop,shift)))
    val getUnderline = makeGetter underlineInfo
    val getSize = makeGetter sizeInfo
    val getColor = makeGetter colorInfo

    fun isMaxUnderline p = (getUnderline p) = 3
    fun isPlain p =
      (not (isSetAttribute (p,I))) andalso
      (not (isSetAttribute (p,B))) andalso
      (not (isSetAttribute (p,Tt))) andalso
      (not (isSetAttribute (p,Em))) andalso
      (not (isSetAttribute (p,S))) andalso
      (getUnderline p = 0)

    fun addTags (prop, []) = prop
      | addTags (prop, tag::rest) = 
	let val prop = (case tag of
			    Token.EM => if (isSetAttribute(prop, S))
					    then prop
					else invertAttribute (prop, Em)
			  | Token.PL => let val prop = setUnderline(prop, 0)
					    val prop = clearAttribute(prop, B)
					    val prop = clearAttribute(prop, Em)
					    val prop = clearAttribute(prop, I)
					    val prop = clearAttribute(prop, S)
					    val prop = clearAttribute(prop, Tt)
					in  prop
					end
			  | Token.S => clearAttribute(setAttribute(prop, S), Em)
			  | Token.TT => setAttribute(prop, Tt)
			  | Token.U => let val cur = getUnderline prop
				       in  if (cur < 3)
					       then setUnderline(prop, 1 + cur)
					   else prop
				       end
			  | Token.Num sz => setSize(prop, sz)
			  | Token.Clr col => setColor(prop,col)
			  | Token.Att Token.B => setAttribute(prop,B)
			  | Token.Att Token.I => setAttribute(prop,I))
	in  addTags (prop, rest)
	end

    fun prop2SpaceProp prop = 
	let val prop = clearAttribute(prop, S)
	    val prop = clearAttribute(prop, Em)
	    val prop = clearAttribute(prop, I)
	    val prop = clearAttribute(prop, B)
	    val prop = if (getUnderline prop = 0)
			   then setColor(prop, 7)  (* 7 is white *)
		       else prop
	in  prop
	end

    (* --- Meaning of a document --- *)
    type decorated = Word.word
    (* Word.wordSize is 31 bits *)
    fun injectDecorated (p, c) = Word.orb(p, Word.<<(Word.fromInt(ord c), 0w23))
    fun projectDecorated d = (Word.andb(d, mask(0w23, 0w0)), 
			      chr(Word.toInt(Word.>>(d, 0w23))))

    type meaning = decorated array
    val decoratedList2meaning : decorated list -> meaning = Array.fromList
    fun printProperty p = 
	let val _ = print (if (isSetAttribute(p,B)) then "B " else "  ")
	    val _ = print (if (isSetAttribute(p,Em)) then "Em " else "   ")
	    val _ = print (if (isSetAttribute(p,I)) then "I " else "  ")
	    val _ = print (if (isSetAttribute(p,S)) then "S " else "  ")
	    val _ = print (if (isSetAttribute(p,Tt)) then "Tt " else "   ")
	    val _ = print (Int.toString (getUnderline p))
	    val _ = print " "
	    val _ = print (Int.toString (getSize p))
	    val _ = print " "
	    val _ = print (Int.toString (getColor p))
	    val _ = print " "
	in  ()
	end

    fun printMeaning (m : meaning) = Array.app (fn d => let val (p,c) = projectDecorated d
							in  print (Char.toString c);
							    print "  ";
							    printProperty p;
							    print "\n"
							end) m

    (* --- Equality --- *)
    fun propertyEqual (p1 : property, p2) = p1 = p2
    fun decoratedEqual (d1 : decorated, d2) = d1 = d2
    fun meaningEqual (m1, m2) = 
	let val l1 = Array.length m1
	    val l2 = Array.length m2
	    fun loop ~1 = true
	      | loop cur = 
		let val d1 = Array.sub(m1,cur)
		    val d2 = Array.sub(m2,cur)
		in  (decoratedEqual(d1,d2) andalso (loop (cur - 1)))
		end
	in  (l1 = l2) andalso loop (l1 - 1)
	end

end
