Home My Page Projects Code Snippets Project Openings 3D graphics for Standard ML
Summary Activity SCM

SCM Repository

[sml3d] View of /src/common/sml3d-type-util.sml
ViewVC logotype

View of /src/common/sml3d-type-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 71 - (download) (annotate)
Tue Apr 8 13:57:39 2008 UTC (11 years, 8 months ago) by jhr
File size: 3258 byte(s)
  Added addAlpha/stripAlpha functions
(* sml3d-type-util.sml
 *
 * COPYRIGHT (c) 2006 John Reppy (http://www.cs.uchicago.edu/~jhr)
 * All rights reserved.
 *
 * Utility functions on the various vector types.
 *)

structure SML3dTypeUtil : SML3D_TYPE_UTIL =
  struct

    open SML3dTypes

  (* pack tuples as records *)
    fun packv2 (x, y)		= {x=x, y=y}
    fun packv3 (x, y, z)	= {x=x, y=y, z=z}
    fun packv4 (x, y, z, w)	= {x=x, y=y, z=z, w=w}

    fun packt2 (s, t)		= {s=s, t=t}
    fun packt3 (s, t, r)	= {s=s, t=t, r=r}
    fun packt4 (s, t, r, q)	= {s=s, t=t, r=r, q=q}

    fun packc3 (r, g, b)	= {r=r, g=g, b=b}
    fun packc4 (r, g, b, a)	= {r=r, g=g, b=b, a=a}

  (* add/strip an alpha channel *)
    fun addAlpha ({r, g, b}, a) = {r=r, g=g, b=b, a=a}
    fun stripAlpha {r, g, b, a} = {r=r, g=g, b=b}

  (* unpack records as tuples *)
    fun unpackv2 {x, y}		= (x, y)
    fun unpackv3 {x, y, z}	= (x, y, z)
    fun unpackv4 {x, y, z, w}	= (x, y, z, w)

    fun unpackt2 {s, t}		= (s, t)
    fun unpackt3 {s, t, r}	= (s, t, r)
    fun unpackt4 {s, t, r, q}	= (s, t, r, q)

    fun unpackc3 {r, g, b}	= (r, g, b)
    fun unpackc4 {r, g, b, a}	= (r, g, b, a)

  (* iterators *)
    fun mapv2 f {x, y} = {x = f x, y = f y}
    fun mapv3 f {x, y, z} = {x = f x, y = f y, z = f z}
    fun mapv4 f {x, y, z, w} = {x = f x, y = f y, z = f z, w = f w}

    fun mapt2 f {s, t} = {s = f s, t = f t}
    fun mapt3 f {s, t, r} = {s = f s, t = f t, r = f r}
    fun mapt4 f {s, t, r, q} = {s = f s, t = f t, r = f r, q = f q}

    fun mapc3 f {r, g, b} = {r = f r, g = f g, b = f b}
    fun mapc4 f {r, g, b, a} = {r = f r, g = f g, b = f b, a = f a}

    fun appv2 (f : 'a -> unit) {x, y} = (f x; f y)
    fun appv3 (f : 'a -> unit) {x, y, z} = (f x; f y; f z)
    fun appv4 (f : 'a -> unit) {x, y, z, w} = (f x; f y; f z; f w)

    fun appt2 (f : 'a -> unit) {s, t} = (f s; f t)
    fun appt3 (f : 'a -> unit) {s, t, r} = (f s; f t; f r)
    fun appt4 (f : 'a -> unit) {s, t, r, q} = (f s; f t; f r; f q)

    fun appc3 (f : 'a -> unit) {r, g, b} = (f r; f g; f b)
    fun appc4 (f : 'a -> unit) {r, g, b, a} = (f r; f g; f b; f a)

  (* string representations *)
    fun fmtv2 fmt {x, y} = String.concat[
	    "{x=", fmt x, ", y=", fmt y, "}"
	  ]
    fun fmtv3 fmt {x, y, z} = String.concat[
	    "{x=", fmt x, ", y=", fmt y, ", z=", fmt z, "}"
	  ]
    fun fmtv4 fmt {x, y, z, w} = String.concat[
	    "{x=", fmt x, ", y=", fmt y, ", z=", fmt z, ", w=", fmt w, "}"
	  ]

    fun fmtt2 fmt {s, t} = String.concat[
	    "{s=", fmt s, ", t=", fmt t, "}"
	  ]
    fun fmtt3 fmt {s, t, r} = String.concat[
	    "{s=", fmt s, ", t=", fmt t, ", r=", fmt r, "}"
	  ]
    fun fmtt4 fmt {s, t, r, q} = String.concat[
	    "{s=", fmt s, ", t=", fmt t, ", r=", fmt r, ", q=", fmt q, "}"
	  ]

    fun fmtc3 fmt {r,g,b} = String.concat[
	    "{r=", fmt r, ", g=", fmt g, ", b=", fmt b, "}"
	  ]
    fun fmtc4 fmt {r, g, b, a} = String.concat[
	    "{r=", fmt r, ", g=", fmt g, ", b=", fmt b, ", a=", fmt a, "}"
	  ]

    fun fmt2 fmt (a, b) = String.concat["(", fmt a, ", ", fmt b, ")"]
    fun fmt3 fmt (a, b, c) = String.concat[
	    "(", fmt a, ", ", fmt b, ", ", fmt c, ")"
	  ]
    fun fmt4 fmt (a, b, c, d) = String.concat[
	    "(", fmt a, ", ", fmt b, ", ", fmt c, ", ", fmt d, ")"
	  ]

  end

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0