Return to gpack.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / lib

BSD 4.3

#	GPACK(2)
#
#	Graphics Package
#
#	Stephen B. Wampler
#
#	Last modified 7/10/83
#
### note - currently no clipping is performed.  needs work.

global _wno			# current window runner
global Window
global Wscale			# list of window attributes
global MODE, ESC                # chromatic commands
global OFF, ON
global DOT, VECTOR, RECTANGLE, CIRCLE, ARC, CONCVECT, INCDOT
global XMAX, YMAX
global BLACK, BLUE, GREEN, CYAN, RED, MAGENTA, YELLOW, WHITE, BLINK

#  set the mode
#
procedure clip(mode)
    suspend Window[_wno].cmode <- mode      # mode is ON/OFF
end

#  clip the object
#
procedure clipped(object)
   case type(object) of {
      default: return object
      }
end

#  set the color
#
procedure color(colr)
   if colr % 8 ~= Window[_wno].fc then {
      writes(MODE,"C",colr % 8)
      Window[_wno].fc := colr % 8
      }
   return
end

#  set the background color
#
procedure bckgrnd(colr)
   if colr % 8 ~= Window[_wno].bc then {
      writes(MODE,"M")
      writes(MODE,"C",colr % 8)
      Window[_wno].bc := colr % 8
      writes(MODE,"N")
      }
   return
end

#  set the cursor color
#
procedure curcol(colr)
   writes(MODE,"Q",colr % 8)
   return
end

#  enable particular color guns
#
procedure enable(colr)
   writes(MODE,":","0123456789ABCDEF"[colr+1])
   return
end




#  draw an object
#
procedure draw(object)
   local pts, p0
   if /object then fail
   object := clipped(object) | fail
   every _plot() do {                    #      switch to plot mode
      case type(object) of {
         "co-expression": while draw(@object)
         "motion":   {
                     _xydel(object.xdel,object.ydel)
                     }
         "point":    {
                     _point(object.x,object.y)
                     }
         "dot":      {
                     mode(DOT)
                     _point(object.x,object.y)
                     }
         "line":     {
                     mode(VECTOR)
                     _point(object.a.x,object.a.y)
                     _point(object.b.x,object.b.y)
                     }
         "box":      {
                     mode(RECTANGLE)
                     _point(object.a.x,object.a.y)
                     _point(object.b.x,object.b.y)
                     }
         "circle":   {
                     mode(CIRCLE)
                     _point(object.center.x,object.center.y)
                     _number(object.radius)
                     }
         "arc":      {
                     mode(ARC)
                     _point(object.center.x,object.center.y)
                     _number(object.radius)
                     _number(object.start)
                     _number(object.stop)
                     }
         "points":   {
                     mode(DOT)
                     every draw(!(object.pts))
                     }
         "lines":    {
                     pts := create !object.pts
                     p0 := @pts
                     mode(VECTOR)
                     while draw(line(.p0,p0 := @pts))
                     }
         "polygon":  {
                     mode(VECTOR)
                     draw(lines(object.pts))
                     draw(line(object.pts[0],object.pts[1]))
                     }
         "incdots":  {
                     mode(INCDOT)
                     draw(object.start)
                     every draw(!object.motions)
                     }
         default  :
              write(&errout,"don't know how to draw ",type(object))
         }
   }

   return
end


# clear the screen

procedure erase()
   writes("\014")
   return
end

#  switch to fill mode
#
procedure _fill()
   if Window[_wno].fmode == OFF then {
      writes(MODE,"F")
      suspend Window[_wno].fmode <- ON
      writes(MODE,"L")
      fail
      }
   return
end

#  leave fill mode
#
procedure _nofill()
   if Window[_wno].fmode == ON then {
      writes(MODE,"L")
      suspend Window[_wno].fmode <- OFF
      writes(MODE,"F")
      fail
      }
   return
end

#  initialize
#
procedure ginit()
   MODE         := "\01"
   ESC          := "\033"
   ON           := "on"
   OFF          := "off"
   XMAX         := 511
   YMAX         := 511
   Window := list(4)
   every Window[1 to 4] := wind(OFF,OFF,OFF,OFF,ON,"",-1,-1,point(0,0),point(511,511))
   every window(1 to 4) do {
      writes(MODE,"\25")                # plot off
      writes(MODE,"L")                  # fill off
      writes(MODE,"R")                  # roll on
      }
   Wscale := list(4)
   every Wscale[1 to 4] := scaling(1,0,1,0)
   _wno := 1
   DOT          := "%"
   VECTOR       := "'"
   RECTANGLE    := "+"
   CIRCLE       := "*"
   ARC          := ")"
   CONCVECT     := ")"
   INCDOT       := "&"
   BLACK        := 0
   BLUE         := 1
   GREEN        := 2
   CYAN         := 3
   RED          := 4
   MAGENTA      := 5
   YELLOW       := 6
   WHITE        := 7
   BLINK        := 8
end

# set plot submode (internal routine)
#
procedure mode(newmode)
   if newmode ~== Window[_wno].psubmode then {
      writes(newmode)
      suspend Window[_wno].psubmode <- newmode
      writes(Window[_wno].psubmode)
      fail
      }
   return
end

# move cursor to (x,y)  (internal routine)
#
procedure movcur(x,y)
   writes(MODE,"U")
   _point(x,y)
   return
end

#  switch to plot mode
#
procedure _plot()
   if Window[_wno].pmode == OFF then {
      Window[_wno].psubmode := " "
      writes(MODE,"G")
      suspend Window[_wno].pmode <- ON
      writes("\25")
      fail
      }
   return
end

#  switch to character mode
#
procedure _char()
   if Window[_wno].pmode == ON then {
      writes("\25")
      suspend Window[_wno].pmode <- OFF
      writes(MODE,"G")
      fail
      }
   return
end





# put out a point (x,y)  (internal routines)

#  write a point
#
procedure _point(x,y)
  _number(xfit(x))
  _number(yfit(y))
   return
end

#  write a number
#
procedure _number(n)
   if n <= 99 then
      writes(n,",")
   else
      writes(n)
   return
end


# graphic record types

record point(x,y)
record dot(x,y)
record line(a,b)
record box(a,b)
record circle(center,radius)
record arc(center,radius,start,stop)
record points(pts)
record lines(pts)
record polygon(pts)
record incdots(start,motions)
record motion(xdel,ydel)

# window records

record wind(pmode,smode,cmode,fmode,rmode,psubmode,fc,bc,lowerleft,upperright)
record scaling(xslope,xinter,yslope,yinter)


#  reset windows
#
procedure restore()

   every window(3 to 0 by -1) do {
      setscale(0,0,511,511,0,0,511,511)
      wsize(0,0,511,511)
      _char()
      _roll()
      enable(WHITE+BLINK)
      }

end


#  turn on roll
#
procedure _roll()
   if Window[_wno].rmode ~== ON then {
      writes(MODE,"R")
      suspend Window[_wno].rmode <- ON
      writes(MODE,"P")
      fail
      }
   return
end

#  turn off roll
#
procedure _noroll()
   if Window[_wno].rmode ~== OFF then {
      writes(MODE,"P")
      suspend Window[_wno].rmode <- OFF
      writes(MODE,"R")
      fail
      }
   return
end







procedure setscale(xmin,ymin,xmax,ymax,colmin,rowmin,colmax,rowmax)

   Wscale[_wno].xslope := real(colmax-colmin) / (xmax-xmin)
   Wscale[_wno].xinter := colmin - xmin * Wscale[_wno].xslope

   Wscale[_wno].yslope := real(rowmax-rowmin) / (ymax-ymin)
   Wscale[_wno].yinter := rowmin - (ymin * Wscale[_wno].yslope)
   return
end

procedure xfit(x)
   if Window[_wno].smode === ON then
      return integer(Wscale[_wno].xslope * x + Wscale[_wno].xinter + 0.5)
   else return integer(x + 0.5)
end

procedure yfit(y)
   if Window[_wno].smode === ON then
      return integer(Wscale[_wno].yslope * y + Wscale[_wno].yinter + 0.5)
   else return integer(y + 0.5)
end

procedure scale(pt)
   if Window[_wno].smode === ON then
      return point(
         integer(Wscale[_wno].xslope * pt.x + Wscale[_wno].xinter + 0.5),
         integer(Wscale[_wno].yslope * pt.y + Wscale[_wno].yinter + 0.5)
         )
   else return pt
end

procedure _scale(mode)
   suspend Window[_wno].smode <- mode
end

# place text on screen at (x,y)
#
procedure text(x,y,s)
   every _char() do {
      movcur(x,y)
      writes(s)
      }
   return
end

#  switch to window w (0-3)
#
procedure window(w)
   writes(ESC,"OA",w % 4)
   _wno := w % 4 + 1
   return
end

#  set new window size
#
procedure wsize(x0,y0,x1,y1)
   writes(MODE,"W")
   _point(x0,y0)
   _point(x1,y1)
   Window[_wno].lowerleft := point(x0,y0)
   Window[_wno].upperright := point(x1,y1)
   return
end

# output deltax, deltay to terminal
#
procedure _xydel(xdel,ydel)
   local signx, signy, byte
   static chars
   initial chars := string(&cset)
   signx := signy := 0
   if xdel < 0 then {
      signx := 32
      xdel := -xdel
      }
   if ydel < 0 then {
      signy := 4
      ydel := -ydel
      }
   byte := 64 + signx + xdel*8 + signy + ydel
   writes(chars[65 + signx + (xdel % 4)*8 + signy + (ydel % 4)])
   return
end

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