=begin
	Ruby X11 Client Library
	Copyright 2001 by Mathieu Bouchard

	X11/Type.rb: Meta-Types and Marshalling Basics

	$Id: Type.rb,v 1.58 2001/07/09 23:48:12 matju Exp $

	This library is free software; you can redistribute it and/or
	modify it under the terms of the GNU Lesser General Public
	License as published by the Free Software Foundation; either
	version 2 of the License, or (at your option) any later version.

	This library is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
	Lesser General Public License for more details.

	You should have received a copy of the GNU Lesser General Public
	License along with this library; if not, write to the Free Software
	Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

=end

#----------------------------------------------------------------#
# This is for easier debugging only!!!

# pragdave's solution
# plus my vt-100 colour
module Kernel; def _(&b)
	f=yield
	STDERR.puts "\e[0;32m#{f}: \e[1m#{eval(f,b).inspect}\e[0m"; end; end

#----------------------------------------------------------------#

class Object
	def assert_type(name,value,type)
		return if type===value
		raise TypeError,
			"%s is of type %s, not %s" % [name,value.type,type.to_s],
			caller
	end
end

# as seen in MetaRuby
if not Object.const_defined?(:Boolean) then
	module Boolean; end
	class TrueClass;  include Boolean; end
	class FalseClass; include Boolean; end
end

module X11 # The whole file goes in it, apart from the above
#----------------------------------------------------------------#

FAST = (::ENV["X11_LOG"].to_i < 0)

def self.add(sym,object)
	const_set(sym,object)
	if object.respond_to? :const_name_is then
		object.const_name_is(sym,self)
	end
end

# for use by Keysyms.rb
module MAssignForHash
	def []=(*ks)
		vso = ks.pop
		vs = vso.to_a
		ks = ks[0] if Array===ks[0] # oops
		ks.length.times {|i| super(ks[i],vs[i]) }
		vso
	end
end

module Type

	# the X11::Type protocol is explained in: ../Documentation

# category: naming stuff

	attr_reader :const_name
	def const_name_is(sym,holder); @const_name = "#{holder}::#{sym}"; end
	def to_s;    @const_name || super; end
	def inspect; to_s; end
#	def dup; r=super; r.instance_eval{@const_name=nil}; r; end
end

# sometimes the parameters of a method
# are insufficient to know the result.
class ItDependsError < RuntimeError; end

#----------------------------------------------------------------#

class XStringReader
	attr_reader :xdisplay, :pos

	def initialize(xdisplay,chunk,header=nil)
		@xdisplay,@chunk,@header = xdisplay,chunk,header
		@header = XStringReader.new(xdisplay,@header) if @header
		raise if not Display===@xdisplay
		@pos = 0
	end

	def header; @header or raise "no header here"; end
	def read(n); @pos+=n; @chunk[@pos-n,n]; end
	def pad; @pos += (4 - @pos%4) % 4; end
end

class XStringWriter
	attr_reader :xdisplay, :string

	def initialize(xdisplay)
		@xdisplay = xdisplay
		@string = ""
	end

	def write(data); @string << data; end
	def header; @header ||= type.new(xdisplay); end
#	def pad; X11.pad! @string; end
	def pad; @string << "\0"*((4 - @string.length%4) % 4); end
end

#----------------------------------------------------------------#
# Unused, Any

# use this as a metatype now
class Unused; include Type
	attr_reader :bytes
	def initialize(bytes); @bytes = bytes; end
	class<<self; alias [] new; end

	def xwrite(output,object); output.write "\0"*bytes; end
	def xread(input); input.read(bytes); nil; end

	def to_s; "#{type}[#{bytes}]"; end
	alias inspect to_s
end

#!@#$ does not cache its instances!
class Any; include Type

	class<<self
		alias [] new
		alias of new
	end

	def initialize(*args)
		@union = args
		@union.freeze
	end
	def ===(other)
		!! @union.find {|t| t === other }
	end

	# @xlength ||= @union.map {|t| t.xlength }.max

	def xwrite(output,object)
		good = @union.find {|t| t === object }
		if not good then
			raise "#{object.inspect} is not in #{@union.join ','} of #{self}"
		end
		good.xwrite(output,object)
		output.pad
	end

	#!@#$ not right
	def xread(input)
		@union[0].xread(input)
	end

	def to_s; "X11::Any[%s]" % [@union.join ","]; end
end

#----------------------------------------------------------------#
# Tuple, TupleField

# subclasses must define #tuple.
class TupleBase
	class<<self; alias [] new; end
#	def self.format; @format or raise "Format not defined"; end
#	def self.fields; @fields or raise "Fields not defined"; end
	class<<self; attr_reader :format, :fields; end

	def method_missing(sym,*args)
		if type.compile_fields then send(sym) else super end
	end

	def to_s; "#{type}[#{tuple.join ', '}]"; end
	def inspect; "#{type}#{tuple.inspect}"; end
end

# unfortunately, some things here are specific to the
# RequestFormat system.
class Tuple < TupleBase; extend Type
# category: class methods

	def self.fields_are(*fs)
		raise "Redefinition of a Tuple class' fields" if @format
		f=nil

		@format = fs.map {|f|
			case f
			when Array; TupleField[*f]
			when TupleField; f
			when Integer; f=TupleField[nil,Unused[f]]
			else raise "got #{f.inspect}, expected Array or TupleField"
			end
		}
		
		(@fields = [nil]).pop
		foo = {} # for length/data
		@format.each_with_index {|f,i|
			next if f.sym==nil or f.sym==:self
			if f.options & DATA >0
				j=foo[f.sym]
				raise "field not found for :data" if not j
				@fields[j] = TupleField[f.sym,f.vtype]
				@format[i].data_id = j
			elsif f.options & LENGTH >0
				foo[f.sym]=fields.length
				@fields << f
			else
				@fields << f
			end
		}
		#compile_fields
	end

	def self.compile_fields
		return false if @compiled_fields
		e=""
		fields.each_with_index {|f,i| e << "def #{f.sym};@tuple[#{i}]end;" }
		class_eval e
		@compiled_fields = true
	end

	def self.xwrite(output,object,receiver=nil)
		xwrite_compile if not @compiled
		return (if receiver
			then xwrite_compiled(output,object,receiver)
			else xwrite_compiled(output,object) end)

		assert_type "object", object, self unless X11::FAST
		i=0
		f=nil
		format.each {|f|
			target=output; target=target.header if f.in_header
			t=f.vtype

			v = if f.is_self then receiver
				elsif f.sym==nil then nil
				else i+=1; object[i-1] end

			if f.is_regular   then t.xwrite target,v
			elsif f.is_length then t.xwrite target,v.length
			elsif f.is_data   then t.xwrite target, object[f.data_id]
			end
		}
	end

	def self.xwrite_compile

		code="def self.xwrite_compiled(output,object,receiver=nil)"
		#code="def self.xwrite(output,object,receiver=nil)"
		code<<%{assert_type "object", object, self;} unless X11::FAST
		i=0
		format.each {|f|
			target="output"; target<<".header" if f.in_header
			t=f.vtype
			tt="#{t}"

			vc = if f.is_self then "receiver"
				elsif f.sym==nil then "nil"
				else i+=1; "object[#{i-1}]" end

			if f.is_regular   then code<<"#{tt}.xwrite #{target},#{vc}"
			elsif f.is_length then code<<"#{tt}.xwrite #{target},(#{vc}).length"
			elsif f.is_data   then code<<"#{tt}.xwrite #{target},object[#{f.data_id}]"
			end
			code<<";"
		}
		code<<";end"
		eval code
		@compiled = true
	end

	def self.xread(input)
		args = []
		format.each {|f|
			source=input; source=source.header if f.in_header
			t=f.vtype
			if f.is_regular;   r = t.xread(source); args<<r if f.sym
			elsif f.is_length; args<<t.xread(source)
			elsif f.is_data;   args[f.data_id]=t.xread(input,args[f.data_id])
			end
		}
		self.new(*args)
	end

	def self.check_types(*args)
		fields.length == args.length or raise ArgumentError,
			"wrong number of args: got #{args.length} "\
			"expecting #{fields.length} "\
			"while constructing a #{self}"
		fields.each_with_index {|f,i|
			if not f.vtype === args[i] then
				raise TypeError, "for an #{self}, "\
					"supplied #{f.sym}=#{args[i].inspect} "\
					"is not in type #{f.vtype.inspect}"
			end
		}
		args
	end

# category: instance methods

	def initialize(*args)
		if args.length==1 and Hash===args[0] then
			h = args[0]
			f=nil
			args=[]
			for f in type.fields; args << h[f.sym]; end
		end
		@tuple = args
		type.check_types(*args) unless X11::FAST
	end

	attr_reader :tuple

	def [](i); @tuple[i]; end
	def hash; tuple.hash; end
	def to_s; "#{type}[#{@tuple.join ', '}]"; end
	def inspect; "#{type}#{@tuple.inspect}"; end
	def to_a  ; tuple.dup; end
	def to_ary; tuple.dup; end

	def to_h
		foo={}
		type.fields.each_with_index {|(sym,vtype),i|
			foo[sym] = tuple[i]
		}
		foo
	end

	def ==(other); type == other.type && tuple == other.tuple; end
	alias eql? ==
end

IN_HEADER = 1<<0
LENGTH    = 1<<1
DATA      = 1<<2
SELF      = 1<<3

# although TupleField is a X11::Tuple, it's not meaningful to the
# X11 Server, so it is never encoded.

# this tuple is not defined by the same means than the others;
# this is because of a chicken-and-egg issue.
#!@#$ really? something can be done here.
class TupleField < Tuple
	class<<self; alias [] new; end

	attr_accessor :data_id

	def sym    ; @tuple[0]; end
	def vtype  ; @tuple[1]; end
	def options; @tuple[2]; end
	def initialize(sym,vtype=XID,options=0)
		options = case options
			when nil; 0
			when :in_header; IN_HEADER
			when :length; LENGTH
			when :length_in_header; LENGTH | IN_HEADER
			when :data; DATA
			when Integer; options
			else raise
		end
		options |= SELF if sym==:self
		@tuple = [sym,vtype,options]
	end

	def in_header ; @tuple[2][0]>0; end
	def is_length ; @tuple[2][1]>0; end
	def is_data   ; @tuple[2][2]>0; end
	def is_self   ; @tuple[2][3]>0; end
	def is_regular; @tuple[2]&0b110<1; end
	
	@format = @fields = [
		new(:sym,Any.of(Symbol,nil)),
			# nil = unused (fixed padding)
			# :self = the self of the request's receiver.
		new(:vtype,Type),
		new(:options,Any.of(nil,:in_header,:length,:length_in_header,:data)),
	]
end

#----------------------------------------------------------------#
# PartialTuple (no longer subclassing Tuple)

class PartialTuple < TupleBase; extend Type

	class<<self; attr_reader :fields_h; end

	def self.fields_are(*fs)
		raise "Redefinition of a PartialTuple class' fields" if @format
		f=nil

		@fields = @format = fs.map {|f|
			case f
			when Array; TupleField[*f]
			when TupleField; f
			when Integer; f=TupleField[nil,Unused[f]]
			else raise "got #{f.inspect}, expected Array or TupleField"
			end
		}

		@fields_h = {}
		@fields.each_with_index {|f,i| @fields_h[f.sym] = i }
	end

	def self.compile_fields
		return false if @compiled_fields
		e=""
		fields.each {|f| e << "def #{f.sym};@set[:#{f.sym}]end;" }
		class_eval e
		@compiled_fields = true
	end

	def self.xwrite(output,object)
		assert_type "object", object, self unless X11::FAST
		present = 0
		presenta = []
		s = object.set
		for k,v in s
			i = fields_h[k]
			present |= 1<<i
			presenta[i]=i,v
		end
		presenta.compact!
		Uint32.xwrite output,present
		for i,v in presenta
			fields[i].vtype.xwrite output,v
			output.pad
		end
	end

	def self.xread(input)
		present = Uint32.xread input
		i=0
		s={}
		for i in 0...fields.length
			next unless present[i]>0
			s[fields[i].sym] = fields[i].vtype.xread(input)
		end
		self.new(s)
	end

	def self.check_types(h)
		for k,v in h
			i = fields_h[k]
			f = fields[i]
			if not f.vtype === v then
				raise TypeError, "for an #{self}, "\
					"supplied #{k}=#{v.inspect} "\
					"is not in type #{f.vtype.inspect}"
			end
		end
	end

# category: instance methods

	attr_reader :set

	def tuple
		t=Array.new(type.fields.length)
		for k,v in @set; t[type.fields_h[k]]=v; end
		t
	end
			
	def [](i); @tuple[i]; end

	def initialize(h)
		type.check_types(h) unless X11::FAST
		@set=h.dup
	end

	def ==(other); type == other.type && tuple == other.tuple; end
	alias eql? ==

	def hash; tuple.hash; end
	alias to_a   tuple
	alias to_ary tuple
	def to_h; @set.dup; end
end

#----------------------------------------------------------------#
# IntType

class IntType; include Type
	def initialize \
		( range, packer, length)
		 @range,@packer,@length =
		  range, packer, length
	end
	attr_reader :range,:packer,:length

	def ===(obj)
		Integer === obj && @range === obj && (!@proc || @proc[obj])
	end
	def xwrite(output,object)
		output.write [object].pack(@packer)
	end
	def xread(input)
		input.read(@length).unpack(@packer)[0]
	end
	def such_that(&proc)
		r=dup
		r.instance_eval {@proc = proc}
		r
	end
end

#----------------------------------------------------------------#
# Length, ListType/List

class ListType; include Type

	@specializations = {}
	class<<self
		attr_reader :specializations
		def new(alpha,length=nil,options=nil)
			case options
			when nil, :unpadded; #ok
			else raise "bad List template option"; end
			specializations[[alpha,length,options]] ||=
					 super(alpha,length,options)
		end
		alias of new
	end

	def initialize(alpha,length,options)
		@alpha,@length,@options = alpha,length,options
	end

	attr_reader :alpha, :length

	def to_s; "X11::List.of(#{@alpha.inspect})"; end

	def ===(other)
		Array===other # no more checks than that.
	end

	def xwrite(output,object)
		# assert_type "object", object, self unless X11::FAST
		for e in object; alpha.xwrite output,e; end
		output.pad unless @options == :unpadded
	end

	def xread(input,count=nil)
		raise "count mismatch" if length and count==length
		count ||= length
		# count ||= chunk.length / l
		raise ItDependsError if not count
		(object = [nil]).pop
		count.times { object << alpha.xread(input) }
		input.pad unless @options == :unpadded
		object
	end
end

List = ListType # !@#$ ???

#----------------------------------------------------------------#
# ChoiceTypes and MultiChoiceTypes

# a ChoiceType object represents a set of symbols and a
# bijection of that set to integers 0...n. The mapping is
# applied back and forth during transmissions to the X11
# server.
	
# In C a choice is called an enum, but MIT-X11 uses macros instead.

# part one: copy+paste from RubyAST
class ChoiceType; include Type
	attr_accessor :const_name
	attr_reader :choices, :choices_r
	attr_accessor :base

	def initialize(*args)
		@choices = args
		@choices_r = {}
		@choices.each_with_index {|v,i| @choices_r[v] = i }
		@int_type = Uint8 # except this
		@base = 0
	end

	def lookup(v)
		base + (@choices_r[v] ||
			(raise TypeError, "symbol :#{v} not in type #{self}"))
	end

	def []    (v); @choices[v-base]; end
	alias to_s    const_name
	alias inspect const_name
	def ===(v); !! @choices_r[v]; end
	class<<self; alias [] new; end
end

# part two: RubyX11-specific.
class ChoiceType
	attr_accessor :int_type

	def xwrite(output,object)
		int_type.xwrite(output, lookup object)
	end

	def xread(input)
		v = int_type.xread(input)
		self[v].nil? and raise "#{self}[#{v}]"
		self[v]
	end
end

# MultiChoice objects are similar but instead of dealing with single
# elements, they deal with subsets. The power-set of the set has a
# bijection to integers 0...2**n. In X11 they are called masks; others
# call them bitsets.

# note: .base does not work with this subclass.
class MultiChoiceType < ChoiceType
	def initialize(*a)
		super
		@int_type = Uint32
		@range = 0...1<<@choices.length
	end

	def lookup(*v)
		k=0; v.each {|i| k |= 1<<super(i) }; k
	end

	def ===(v)
		int_type===v && @range===v
	end

	def xwrite(output,object); int_type.xwrite(output,object); end
	def xread(input);          int_type.xread(input);          end
end

#----------------------------------------------------------------#
# Remote Object Protocol

class RequestTuple < Tuple
	class<<self
		attr_accessor :qlass, :selector, :role
		def to_s; "X11::RequestTuple[#{selector.inspect},#{role.inspect}]"; end
	end
end

class RequestFormat < Tuple; fields_are \
	[:selector, Symbol],
	[:rid, Fixnum],
	[:in, Type], # actually a RequestTuple type
	[:out, Any.of(Type,NilClass)] # actually a RequestTuple type

	def initialize(sel,rid,i,o)
		i = make_request_tuple i, sel, :i if i
		o = make_request_tuple o, sel, :o if o
		super(sel,rid,i,o)
	end

	def make_request_tuple(arglist,selector,role)
		unless Class===arglist && arglist <= Tuple
			arglist = Class.new(RequestTuple).class_eval {
				fields_are *arglist; self
			}
		end
		arglist.role = role
		arglist.selector = selector
		arglist
	end

	def xrequest(xdisplay,receiver,args)
		sid = xdisplay.pick_sid
		printf "Request 0x%04x\n", sid if xdisplay.sock.log
		stuff = XStringWriter.new(xdisplay)
		Uint8.xwrite stuff.header,rid
		self.in.xwrite(stuff, self.in[*args], receiver)

		stuff.pad
		len = 1+stuff.string.length/4
		len <= 0x10000 or
			raise TypeError, "request too big (protocol limit: 256k)"
		len <= xdisplay.display_info.maximum_request_length or
			raise TypeError, "request too big (server limit)"

		h = stuff.header
		h.write " " if h.string.length==1

		Uint16.xwrite stuff.header, len
		xdisplay.sock.write(h.string + stuff.string)
		return sid
	end
end

# a list of all existing requests (filled at loadtime)
RTable = []

module RemoteClass
	attr_reader :rem_methods

	def def_rem(sym,rid,iargs,oargs)
		@rem_methods ||= {}
		if @rem_methods[sym] then raise "already defined" end

		@rem_methods[sym] = RequestFormat[sym,rid,iargs,oargs]
		module_eval %{def #{sym}(*args,&p); remote_send(:#{sym},args,&p); end}

		RTable[rid] = [self,sym]
	end

	def def_remote(sym,rid,iargs)
		def_rem(sym,rid,iargs,nil)
	end

	alias def_remote_with_reply def_rem
end

module RemoteObject

	attr_reader :xdisplay
	#def xdisplay; @xdisplay or raise "can't find xdisplay in #{self}"; end

	def remote_send(sym,args,&block)
		sig = nil
		type.ancestors.each {|t|
			sig = t.rem_methods[sym]
			break if sig
		}
		sig or raise "remote method not found: sym=#{sym}"
		seq = sig.xrequest(xdisplay,self,args) & 0xffff
		return nil if not sig.out
		done = false
		result = nil
		xdisplay.reply_set[seq] = proc {|input|
			result = sig.out.xread(input)
			done = true
			yield result if block
		}
		if block
			wf = @xdisplay.waiting_for
			wf << seq if wf
			nil
		else
			while not done; xdisplay.xreceive_blocking; end
			result
		end
	end
end

class XID; include RemoteObject; extend RemoteClass, Type
	class<<self
		#!@#$ remember that all remote resources shall have a
		# possible 'closed' status in their local incarnation.
		# this could be XID==-1 or XID==nil.

#		def xwrite(output,object); Uint32.xwrite(output,object.xid); end
		def xwrite(output,object)
			#output.write [object.xid].pack("L")
			output.write(object.xidp||=[object.xid].pack("L"))
		end
		def xread(input); new(input.xdisplay,Uint32.xread(input)); end
	end

	attr_accessor :xid, :xidp

	def initialize(xdisplay,xid=nil)
		assert_type "xdisplay", xdisplay, ::X11::Display unless X11::FAST
		xid ||= xdisplay.new_id
		assert_type "xid", xid, Uint32 unless X11::FAST
		@xdisplay,@xid = xdisplay,xid
	end

	def inspect
		sprintf "#<%s %08x@%s:%s.%s>",
			type,
			@xid,
			@xdisplay.host,
			@xdisplay.display_id,
			@xdisplay.screen_id
	end
end

#----------------------------------------------------------------#
# an array for number-to-class mapping.
EventTypeNumber = []

class Event < Tuple
	attr_accessor :sid

	class<<self
		attr_accessor :event_code, :const_name
		def code_is(blah); self.event_code = blah; end
		def event_code=(event_code)
			raise "already there" if @event_code
			@event_code = event_code
			EventTypeNumber[event_code] = self
		end
	end

	def self.xwrite(output,object)
		raise NotImplementedError
	end

	def self.xread(input)
		X11.log1 "Receiving a #{self}"
		chunk = input.read(32)
		chunk = XStringReader.new(input.xdisplay,chunk[4..-1],chunk[0,4])
		chunk.header.read(1)
		obj = super(chunk)
		chunk.header.read(1) if chunk.header.pos==1
		obj.sid = Uint16.xread chunk.header
		obj
	end
end

#----------------------------------------------------------------#
end # of module X11
