axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / GRIMAGE.spad

)abbrev domain GRIMAGE GraphImage
++ Author: Jim Wen
++ Date Created: 27 April 1989
++ Date Last Updated: 1995 September 20, Mike Richardson (MGR)
++ Description:
++ TwoDimensionalGraph creates virtual two dimensional graphs 
++ (to be displayed on TwoDimensionalViewports).

GraphImage() : SIG == CODE where

  VIEW    ==> VIEWPORTSERVER$Lisp
  sendI   ==> SOCK_-SEND_-INT
  sendSF  ==> SOCK_-SEND_-FLOAT
  sendSTR ==> SOCK_-SEND_-STRING
  getI    ==> SOCK_-GET_-INT
  getSF   ==> SOCK_-GET_-FLOAT

  typeGRAPH  ==> 2
  typeVIEW2D ==> 3

  makeGRAPH  ==> (-1)$SingleInteger
  makeVIEW2D ==> (-1)$SingleInteger
 
  I   ==> Integer
  PI  ==> PositiveInteger
  NNI ==> NonNegativeInteger
  SF  ==> DoubleFloat
  F   ==> Float
  L   ==> List
  P   ==> Point(SF)
  V   ==> Vector
  SEG ==> Segment
  RANGESF   ==> L SEG SF
  RANGEF    ==> L SEG F
  UNITSF   ==> L SF
  UNITF    ==> L F
  PAL ==> Palette
  E   ==> OutputForm
  DROP ==> DrawOption
  PP ==> PointPackage(SF)
  COORDSYS ==> CoordinateSystems(SF)

  SIG ==> SetCategory with

    graphImage : () -> $
      ++ graphImage() returns an empty graph with 0 point lists 
      ++ of the domain \spadtype{GraphImage}.  A graph image contains
      ++ the graph data component of a two dimensional viewport.

    makeGraphImage : $ -> $ 
      ++ makeGraphImage(gi) takes the given graph, \spad{gi} of the
      ++ domain \spadtype{GraphImage}, and sends it's data to the
      ++ viewport manager where it waits to be included in a two-dimensional
      ++ viewport window.  \spad{gi} cannot be an empty graph, and it's
      ++ elements must have been created using the \spadfun{point} or
      ++ \spadfun{component} functions, not by a previous
      ++ \spadfun{makeGraphImage}.

    makeGraphImage : (L L P) -> $
      ++ makeGraphImage(llp) returns a graph of the domain 
      ++ \spadtype{GraphImage} which is composed of the points and 
      ++ lines from the list of lists of points, \spad{llp}, with 
      ++ default point size and default point and line colours. The graph
      ++ data is then sent to the viewport manager where it waits to be
      ++ included in a two-dimensional viewport window.

    makeGraphImage : (L L P,L PAL,L PAL,L PI) -> $ 
      ++ makeGraphImage(llp,lpal1,lpal2,lp) returns a graph of the
      ++ domain \spadtype{GraphImage} which is composed of the points
      ++ and lines from the list of lists of points, \spad{llp}, whose
      ++ point colors are indicated by the list of palette colors,
      ++ \spad{lpal1}, and whose lines are colored according to the list
      ++ of palette colors, \spad{lpal2}.  The paramater lp is a list of
      ++ integers which denote the size of the data points.  The graph
      ++ data is then sent to the viewport manager where it waits to be
      ++ included in a two-dimensional viewport window.

    makeGraphImage : (L L P,L PAL,L PAL,L PI,L DROP) -> $
      ++ makeGraphImage(llp,lpal1,lpal2,lp,lopt) returns a graph of
      ++ the domain \spadtype{GraphImage} which is composed of the 
      ++ points and lines from the list of lists of points, \spad{llp},
      ++ whose point colors are indicated by the list of palette colors,
      ++ \spad{lpal1}, and whose lines are colored according to the list
      ++ of palette colors, \spad{lpal2}.  The paramater lp is a list of
      ++ integers which denote the size of the data points, and \spad{lopt}
      ++ is the list of draw command options.  The graph data is then sent
      ++ to the viewport manager where it waits to be included in a 
      ++ two-dimensional viewport window.

    pointLists : $ -> L L P
      ++ pointLists(gi) returns the list of lists of points which compose
      ++ the given graph, \spad{gi}, of the domain \spadtype{GraphImage}.

    key : $ -> I
      ++ key(gi) returns the process ID of the given graph, \spad{gi},
      ++ of the domain \spadtype{GraphImage}.

    ranges : $ -> RANGEF
      ++ ranges(gi) returns the list of ranges of the point components from
      ++ the indicated graph, \spad{gi}, of the domain \spadtype{GraphImage}.

    ranges : ($,RANGEF) -> RANGEF
      ++ ranges(gi,lr) modifies the list of ranges for the given graph,
      ++ \spad{gi} of the domain \spadtype{GraphImage}, to be that of the
      ++ list of range segments, \spad{lr}, and returns the new range list
      ++ for \spad{gi}. 

    units : $ -> UNITF
      ++ units(gi) returns the list of unit increments for the x and y
      ++ axes of the indicated graph, \spad{gi}, of the domain
      ++ \spadtype{GraphImage}.

    units : ($,UNITF) -> UNITF
      ++ units(gi,lu) modifies the list of unit increments for the x and y
      ++ axes of the given graph, \spad{gi} of the domain
      ++ \spadtype{GraphImage}, to be that of the list of unit increments,
      ++ \spad{lu}, and returns the new list of units for \spad{gi}. 

    component : ($,L P,PAL,PAL,PI) -> Void
      ++ component(gi,lp,pal1,pal2,p) sets the components of the
      ++ graph, \spad{gi} of the domain \spadtype{GraphImage}, to the
      ++ values given.  The point list for \spad{gi} is set to the list
      ++ \spad{lp}, the color of the points in \spad{lp} is set to
      ++ the palette color \spad{pal1}, the color of the lines which
      ++ connect the points \spad{lp} is set to the palette color
      ++ \spad{pal2}, and the size of the points in \spad{lp} is given
      ++ by the integer p.

    component : ($,P) -> Void
      ++ component(gi,pt) modifies the graph \spad{gi} of the domain
      ++ \spadtype{GraphImage} to contain one point component, \spad{pt}
      ++ whose point color, line color and point size are determined by
      ++ the default functions \spadfun{pointColorDefault},
      ++ \spadfun{lineColorDefault}, and \spadfun{pointSizeDefault}.

    component : ($,P,PAL,PAL,PI) -> Void
      ++ component(gi,pt,pal1,pal2,ps) modifies the graph \spad{gi} of
      ++ the domain \spadtype{GraphImage} to contain one point component,
      ++ \spad{pt} whose point color is set to the palette color \spad{pal1},
      ++ line color is set to the palette color \spad{pal2}, and point
      ++ size is set to the positive integer \spad{ps}.

    appendPoint : ($,P) -> Void
      ++ appendPoint(gi,pt) appends the point \spad{pt} to the end
      ++ of the list of points component for the graph, \spad{gi}, which is
      ++ of the domain \spadtype{GraphImage}.

    point : ($,P,PAL) -> Void
      ++ point(gi,pt,pal) modifies the graph \spad{gi} of the domain
      ++ \spadtype{GraphImage} to contain one point component, \spad{pt}
      ++ whose point color is set to be the palette color \spad{pal}, and
      ++ whose line color and point size are determined by the default
      ++ functions \spadfun{lineColorDefault} and \spadfun{pointSizeDefault}.

    coerce : L L P -> $
      ++ coerce(llp)
      ++ component(gi,pt) creates and returns a graph of the domain
      ++ \spadtype{GraphImage} which is composed of the list of list
      ++ of points given by \spad{llp}, and whose point colors, line colors
      ++ and point sizes are determined by the default functions 
      ++ \spadfun{pointColorDefault}, \spadfun{lineColorDefault}, and
      ++ \spadfun{pointSizeDefault}.  The graph data is then sent to the 
      ++ viewport manager where it waits to be included in a two-dimensional
      ++ viewport window.

    coerce : $ -> E
      ++ coerce(gi) returns the indicated graph, \spad{gi}, of domain
      ++ \spadtype{GraphImage} as output of the domain \spadtype{OutputForm}.

    putColorInfo : (L L P,L PAL) -> L L P
      ++ putColorInfo(llp,lpal) takes a list of list of points, \spad{llp},
      ++ and returns the points with their hue and shade components
      ++ set according to the list of palette colors, \spad{lpal}.

    figureUnits : L L P -> UNITSF

  CODE ==> add

    import Color()
    import Palette()
    import ViewDefaultsPackage()
    import PlotTools()
    import DrawOptionFunctions0
    import P
    import PP
    import COORDSYS

    Rep := Record(key: I, rangesField: RANGESF, unitsField: UNITSF, _
       llPoints: L L P, pointColors: L PAL, _
       lineColors: L PAL, pointSizes: L PI, _
       optionsField: L DROP)

--%Internal Functions

    graph       : RANGEF                          -> $

    scaleStep   : SF                          -> SF

    makeGraph   :  $                          -> $

    numberCheck(nums:Point SF):Void ==
      for i in minIndex(nums)..maxIndex(nums) repeat
        COMPLEXP(nums.(i::PositiveInteger))$Lisp =>
          error _
           "An unexpected complex number was encountered in the calculations."
           

    doOptions(g:Rep):Void ==    
      lr : RANGEF := ranges(g.optionsField,ranges g)
      if (#lr > 1$I) then
        g.rangesField := [segment(convert(lo(lr.1))@SF,_
                                  convert(hi(lr.1))@SF)$(Segment(SF)), 
                           segment(convert(lo(lr.2))@SF,_
                                   convert(hi(lr.2))@SF)$(Segment(SF))]
      else
        g.rangesField := []
      lu : UNITF := units(g.optionsField,units g)
      if (#lu > 1$I) then
        g.unitsField := [convert(lu.1)@SF,convert(lu.2)@SF]
      else
        g.unitsField := []
    -- etc - graphimage specific stuff...

    putColorInfo(llp,listOfPalettes) ==
      llp2 : L L P := []
      for lp in llp for pal in listOfPalettes repeat
        lp2 : L P := []
        daHue   := (hue(hue pal))::SF
        daShade := (shade pal)::SF
        for p in lp repeat
          if (d := dimension p) < 3 then
            p := extend(p,[daHue,daShade])
          else
            p.3 := daHue
            d < 4 => p := extend(p,[daShade])
            p.4 := daShade
          lp2 := cons(p,lp2)
        llp2 := cons(reverse_! lp2,llp2)
      reverse_! llp2

    graph demRanges ==
      null demRanges =>  [ 0, [], [], [], [], [], [], [] ]
      demRangesSF : RANGESF := _
        [ segment(convert(lo demRanges.1)@SF,_
                  convert(hi demRanges.1)@SF)$(Segment(SF)), _
          segment(convert(lo demRanges.1)@SF,_
                  convert(hi demRanges.1)@SF)$(Segment(SF)) ]
      [ 0, demRangesSF, [], [], [], [], [], [] ]

    scaleStep(range) ==                        -- MGR
      adjust:NNI
      tryStep:SF
      scaleDown:SF
      numerals:String
      adjust := 0
      while range < 100.0::SF repeat
        adjust := adjust + 1
        range := range * 10.0::SF -- might as well take big steps
      tryStep := range/10.0::SF
      numerals := string(((retract(ceiling(tryStep)$SF)$SF)@I))$String
      scaleDown := (10@I **$I (((#(numerals)@I) - 1$I) pretend PI))::SF
      scaleDown*ceiling(tryStep/scaleDown - 0.5::SF)/((10 **$I adjust)::SF)

    figureUnits(listOfListsOfPoints) ==
        -- figure out the min/max and divide by 10 for unit markers
      xMin := xMax := xCoord first first listOfListsOfPoints
      yMin := yMax := yCoord first first listOfListsOfPoints
      if xMin ~= xMin then xMin:=max()
      if xMax ~= xMax then xMax:=min()
      if yMin ~= yMin then yMin:=max()
      if yMax ~= yMax then yMax:=min()
      for pL in listOfListsOfPoints repeat
        for p in pL repeat
          if ((px := (xCoord p)) < xMin) then
            xMin := px
          if px > xMax then
            xMax := px
          if ((py := (yCoord p)) < yMin) then
            yMin := py
          if py > yMax then
            yMax := py
      if xMin = xMax then
        xMin := xMin - convert(0.5)$Float
        xMax := xMax + convert(0.5)$Float
      if yMin = yMax then
        yMin := yMin - convert(0.5)$Float
        yMax := yMax + convert(0.5)$Float
      [scaleStep(xMax-xMin),scaleStep(yMax-yMin)]

    plotLists(graf:Rep,listOfListsOfPoints:L L P,listOfPointColors:L PAL,_
              listOfLineColors:L PAL,listOfPointSizes:L PI):$ ==
      givenLen := #listOfListsOfPoints
        -- take out point lists that are actually empty
      listOfListsOfPoints := [ l for l in listOfListsOfPoints | ^null l ]
      if (null listOfListsOfPoints) then
        error "GraphImage was given a list that contained no valid point lists"
      if ((len := #listOfListsOfPoints) ^= givenLen) then
        sayBrightly(_
         ["   Warning: Ignoring pointless point list"::E]$List(E))$Lisp
      graf.llPoints := listOfListsOfPoints
        -- do point colors
      if ((givenLen := #listOfPointColors) > len) then
         -- pad or discard elements if given list has 
         -- length different from the point list
        graf.pointColors := concat(listOfPointColors,
            new((len - givenLen)::NonNegativeInteger + 1, pointColorDefault()))
      else graf.pointColors := first(listOfPointColors, len)
        -- do line colors
      if ((givenLen := #listOfLineColors) > len) then
        graf.lineColors := concat(listOfLineColors,
             new((len - givenLen)::NonNegativeInteger + 1, lineColorDefault()))
      else graf.lineColors := first(listOfLineColors, len)
        -- do point sizes
      if ((givenLen := #listOfPointSizes) > len) then
        graf.pointSizes := concat(listOfPointSizes,
             new((len - givenLen)::NonNegativeInteger + 1, pointSizeDefault()))
      else graf.pointSizes := first(listOfPointSizes, len)
      graf

    makeGraph graf ==
      doOptions(graf)
      (s := #(graf.llPoints)) = 0 =>
        error "You are trying to make a graph with no points"
      key graf ^= 0 => 
        error "You are trying to draw over an existing graph"
      transform := _
        coord(graf.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0 
      graf.llPoints:= putColorInfo(graf.llPoints,graf.pointColors)
      if null(ranges graf) then  -- figure out best ranges for points
        graf.rangesField := calcRanges(graf.llPoints)  --::V SEG SF
      if null(units graf) then  -- figure out best ranges for points
        graf.unitsField := figureUnits(graf.llPoints)  --::V SEG SF
      sayBrightly(
       ["   Graph data being transmitted to the viewport manager..."::E]
        $List(E))$Lisp
      sendI(VIEW,typeGRAPH)$Lisp
      sendI(VIEW,makeGRAPH)$Lisp
      tonto := (graf.rangesField)::RANGESF
      sendSF(VIEW,lo(first tonto))$Lisp
      sendSF(VIEW,hi(first tonto))$Lisp
      sendSF(VIEW,lo(second tonto))$Lisp
      sendSF(VIEW,hi(second tonto))$Lisp
      sendSF(VIEW,first (graf.unitsField))$Lisp
      sendSF(VIEW,second (graf.unitsField))$Lisp
      sendI(VIEW,s)$Lisp     -- how many lists of points are being sent
      for aList in graf.llPoints _
       for pColor in graf.pointColors _
        for lColor in graf.lineColors for s in graf.pointSizes repeat
        sendI(VIEW,#aList)$Lisp  -- how many points in this list
        for p in aList repeat
          aPoint := transform p
          sendSF(VIEW,xCoord aPoint)$Lisp
          sendSF(VIEW,yCoord aPoint)$Lisp
          sendSF(VIEW,hue(p)$PP)$Lisp  -- ?use aPoint as well...?
          sendSF(VIEW,shade(p)$PP)$Lisp
        hueShade := hue hue pColor + shade pColor * numberOfHues() 
        sendI(VIEW,hueShade)$Lisp
        hueShade := (hue hue lColor -1)*5 + shade lColor
        sendI(VIEW,hueShade)$Lisp
        sendI(VIEW,s)$Lisp
      graf.key := getI(VIEW)$Lisp
      graf        

--%Exported Functions

    makeGraphImage(graf:$)    == makeGraph graf

    key graf                  == graf.key

    pointLists graf           == graf.llPoints

    ranges graf                == 
      null graf.rangesField => []
      [segment(convert(lo graf.rangesField.1)@F,_
               convert(hi graf.rangesField.1)@F), _
       segment(convert(lo graf.rangesField.2)@F,_
               convert(hi graf.rangesField.2)@F)]

    ranges(graf,rangesList)     == 
      graf.rangesField := 
        [segment(convert(lo rangesList.1)@SF,convert(hi rangesList.1)@SF), _
         segment(convert(lo rangesList.2)@SF,convert(hi rangesList.2)@SF)]
      rangesList

    units graf                == 
      null(graf.unitsField) => []
      [convert(graf.unitsField.1)@F,convert(graf.unitsField.2)@F]

    units (graf,unitsToBe)    == 
      graf.unitsField := [convert(unitsToBe.1)@SF,convert(unitsToBe.2)@SF]
      unitsToBe

    graphImage                == graph []

    makeGraphImage(llp) ==
      makeGraphImage(llp,
        [pointColorDefault() for i in 1..(l:=#llp)],
         [lineColorDefault() for i in 1..l], 
          [pointSizeDefault() for i in 1..l])

    makeGraphImage(llp,lpc,llc,lps) ==
      makeGraphImage(llp,lpc,llc,lps,[])

    makeGraphImage(llp,lpc,llc,lps,opts) ==
      graf := graph(ranges(opts,[]))
      graf.optionsField := opts
      graf := plotLists(graf,llp,lpc,llc,lps)
      transform := _
        coord(graf.optionsField,cartesian$COORDSYS)$DrawOptionFunctions0
      for aList in graf.llPoints repeat
        for p in aList repeat
          aPoint := transform p
          numberCheck aPoint
      makeGraph graf

    component (graf:$,ListOfPoints:L P,PointColor:PAL,_
               LineColor:PAL,PointSize:PI) ==
      graf.llPoints    := append(graf.llPoints,[ListOfPoints])
      graf.pointColors := append(graf.pointColors,[PointColor])
      graf.lineColors  := append(graf.lineColors,[LineColor])
      graf.pointSizes  := append(graf.pointSizes,[PointSize])     

    component (graf,aPoint) ==
      component(graf,aPoint,pointColorDefault(),_
                lineColorDefault(),pointSizeDefault())

    component (graf:$,aPoint:P,PointColor:PAL,LineColor:PAL,PointSize:PI) ==
      component (graf,[aPoint],PointColor,LineColor,PointSize)

    appendPoint (graf,aPoint) ==
      num : I  := #(graf.llPoints) - 1
      num < 0 => error "No point lists to append to!"
      (graf.llPoints.num) := append((graf.llPoints.num),[aPoint])

    point (graf,aPoint,PointColor) ==
      component(graf,aPoint,PointColor,lineColorDefault(),pointSizeDefault())

    coerce (llp : L L P) : $ ==
      makeGraphImage(llp,
          [pointColorDefault() for i in 1..(l:=#llp)],
           [lineColorDefault() for i in 1..l], 
            [pointSizeDefault() for i in 1..l])

    coerce (graf : $) : E ==
      hconcat( ["Graph with " :: E,(p := # pointLists graf) :: E, 
         (p=1 => " point list"; " point lists") :: E])