' ******************
' *** GRAPH1.LST ***
' ******************
'
DEFWRD "a-z"
'
> PROCEDURE click.point(txt$,VAR x,y)
  ' *** choose point (x,y) with mouse-click
  ' *** uses Procedure Message.on and Message.off
  LOCAL x1,y1,x2,y2,k
  DEFMOUSE 3
  SHOWM
  @message.on(txt$)
  x1=MOUSEX
  y1=MOUSEY
  REPEAT
    MOUSE x2,y2,k
  UNTIL x2<>x1 OR y2<>y1
  @message.off
  REPEAT
  UNTIL MOUSEK               ! wait for click
  x=MOUSEX
  y=MOUSEY
  HIDEM
  DEFMOUSE 0
  PAUSE 10                   ! short pause for release of button
RETURN
' **********
'
> PROCEDURE rubber.line(x,y,VAR x2,y2)
  ' *** draw line from point (x,y) to position of mouse (x2,y2)
  ' *** confirm with mouse-click
  ' *** uses Procedure Message.on and Message.off
  LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k
  GRAPHMODE 3
  @message.on("draw line (confirm with click)")
  DEFMOUSE 3
  SHOWM
  mx1=MOUSEX
  my1=MOUSEY
  REPEAT
    MOUSE mx2,my2,k
  UNTIL mx2<>mx1 OR my2<>my1
  @message.off
  MOUSE x1,y1,k
  REPEAT
    LINE x,y,x1,y1
    REPEAT
      MOUSE x2,y2,k
    UNTIL x2<>x1 OR y2<>y1 OR k>0
    LINE x,y,x1,y1
    x1=x2
    y1=y2
  UNTIL k>0
  GRAPHMODE 1
  LINE x,y,x2,y2
  HIDEM
  DEFMOUSE 0
  PAUSE 10
RETURN
' **********
'
> PROCEDURE draw.line(VAR x1,y1,x2,y2)
  ' *** draw line
  ' *** uses Procedure Click.point and Rubber.line
  @click.point("click on starting point of line",x1,y1)
  @rubber.line(x1,y1,x2,y2)
RETURN
' **********
'
> PROCEDURE rubber.box(x,y,VAR width,heigth)
  ' *** draw rectangle (left upper corner already chosen)
  ' *** uses Procedure Message.on and Message.off
  LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k
  GRAPHMODE 3
  @message.on("draw rectangle (confirm with click)")
  mx1=MOUSEX
  my1=MOUSEY
  REPEAT
    MOUSE mx2,my2,k
  UNTIL mx2<>mx1 OR my2<>my1
  @message.off
  MOUSE x1,y1,k
  REPEAT
    BOX x,y,x1,y1
    PLOT x,y
    REPEAT
      MOUSE x2,y2,k
    UNTIL (x2<>x1 AND x2>x) OR (y2<>y1 AND y2>y) OR k>0
    BOX x,y,x1,y1
    PLOT x,y
    x1=x2
    y1=y2
  UNTIL k>0
  GRAPHMODE 1
  BOX x,y,x2,y2
  width=x2-x
  height=y2-y
  PAUSE 10
RETURN
' **********
'
> PROCEDURE draw.box(VAR x,y,width,height)
  ' *** draw rectangle
  ' *** uses Procedure Click.point and Rubber.box
  LOCAL x1,y1,width,height
  @click.point("click on left upper corner of rectangle",x,y)
  @rubber.box(x,y,width,height)
RETURN
' **********
'
> PROCEDURE rubber.square(x,y,VAR width)
  ' *** draw square (left upper corner already chosen)
  ' *** uses Procedure Message.on and Message.off
  LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k,side
  GRAPHMODE 3
  HIDEM
  @message.on("draw square (confirm with click)")
  mx1=MOUSEX
  my1=MOUSEY
  REPEAT
    MOUSE mx2,my2,k
  UNTIL mx2<>mx1 OR my2<>my1
  @message.off
  MOUSE x1,y1,k
  REPEAT
    IF (x1-x)>(y1-y)
      side=x1-x
    ELSE
      side=y1-y
    ENDIF
    BOX x,y,x+side,y+side
    PLOT x,y
    REPEAT
      MOUSE x2,y2,k
    UNTIL (x2<>x1 AND x2>x) OR (y2<>y1 AND y2>y) OR k>0
    BOX x,y,x+side,y+side
    PLOT x,y
    x1=x2
    y1=y2
  UNTIL k>0
  GRAPHMODE 1
  BOX x,y,x+side,y+side
  width=side
  PAUSE 10
RETURN
' **********
'
> PROCEDURE draw.square(VAR x,y,width)
  ' *** draw square
  ' *** uses Procedure Click.point and Rubber.square
  @click.point("click on left upper corner of square",x,y)
  @rubber.square(x,y,width)
RETURN
' **********
'
> PROCEDURE drag.box(width,height,VAR x,y)
  ' *** drag rectangle
  ' *** place rectangle after mouse-click
  ' *** uses Procedure Message.on and Message.off
  LOCAL mx1,my1,mx2,my2,x1,y1,x2,y2,k
  GRAPHMODE 3
  HIDEM
  @message.on("drag rectangle (place with click)")
  mx1=MOUSEX
  my1=MOUSEY
  REPEAT
    MOUSE mx2,my2,k
  UNTIL mx2<>mx1 OR my2<>my1
  @message.off
  MOUSE x1,y1,k
  REPEAT
    BOX x1,y1,x1+width,y1+height
    PLOT x1,y1
    REPEAT
      MOUSE x2,y2,k
    UNTIL x2<>x1 OR y2<>y1 OR k>0
    BOX x1,y1,x1+width,y1+height
    PLOT x1,y1
    x1=x2
    y1=y2
  UNTIL k>0
  GRAPHMODE 1
  BOX x2,y2,x2+width,y2+height
  x=x2
  y=y2
  PAUSE 10
RETURN
' **********
'
> PROCEDURE move.box(width,height,x1,y1,x2,y2)
  ' *** move rectangle from x1,y1 to x2,y2
  LOCAL x,y
  GRAPHMODE 3
  IF x1<x2 AND y1<y2
    @p1
  ELSE
    IF x1<x2 AND y1>=y2
      @p2
    ELSE
      IF x1>=x2 AND y1<y2
        @p3
      ELSE
        @p4
      ENDIF
    ENDIF
  ENDIF
  GRAPHMODE 1
  BOX x2,y2,x2+width,y2+height
RETURN
' ***
> PROCEDURE p1
  FOR x=x1 TO x2
    BOX x,y1,x+width,y1+height
    BOX x,y1,x+width,y1+height
  NEXT x
  FOR y=y1 TO y2
    BOX x,y,x+width,y+height
    BOX x,y,x+width,y+height
  NEXT y
RETURN
' ***
> PROCEDURE p2
  FOR x=x1 TO x2
    BOX x,y1,x+width,y1+height
    BOX x,y1,x+width,y1+height
  NEXT x
  FOR y=y1 DOWNTO y2
    BOX x,y,x+width,y+height
    BOX x,y,x+width,y+height
  NEXT y
RETURN
' ***
> PROCEDURE p3
  FOR x=x1 DOWNTO x2
    BOX x,y1,x+width,y1+height
    BOX x,y1,x+width,y1+height
  NEXT x
  FOR y=y1 TO y2
    BOX x,y,x+width,y+height
    BOX x,y,x+width,y+height
  NEXT y
RETURN
' ***
> PROCEDURE p4
  FOR x=x1 DOWNTO x2
    BOX x,y1,x+width,y1+height
    BOX x,y1,x+width,y1+height
  NEXT x
  FOR y=y1 DOWNTO y2
    BOX x,y,x+width,y+height
    BOX x,y,x+width,y+height
  NEXT y
RETURN
' **********
'
> PROCEDURE grow.box(width,height,x,y,pause)
  ' *** draw 'growing' rectangle
  ' *** pause determines grow-speed
  LOCAL x1,y1,l,step.x,step.y,n,delta.x,delta.y
  GRAPHMODE 3
  x1=x+width/2
  y1=y+height/2
  l=MIN(height/2,width/2)
  step.x=(width/2)/l
  step.y=(height/2)/l
  FOR n=1 TO l
    delta.x=n*step.x
    delta.y=n*step.y
    BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y
    PLOT x1-delta.x,y1-delta.y
    PAUSE pause
    BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y
    PLOT x1-delta.x,y1-delta.y
  NEXT n
  GRAPHMODE 1
  BOX x,y,x+width,y+height
RETURN
' **********
'
> PROCEDURE shrink.box(width,height,x,y,pause)
  ' *** draw 'shrinking' rectangle
  ' *** pause determines shrink-speed
  LOCAL x1,y1,l,step.x,step.y,n,delta.x,delta.y
  GRAPHMODE 3
  x1=x+width/2
  y1=y+height/2
  l=MIN(height/2,width/2)
  step.x=(width/2)/l
  step.y=(height/2)/l
  BOX x,y,x+width,y+height
  PLOT x,y
  BOX x,y,x+width,y+height
  PLOT x,y
  FOR n=l DOWNTO 1
    delta.x=n*step.x
    delta.y=n*step.y
    BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y
    PLOT x1-delta.x,y1-delta.y
    PAUSE pause
    BOX x1-delta.x,y1-delta.y,x1+delta.x,y1+delta.y
    PLOT x1-delta.x,y1-delta.y
  NEXT n
  GRAPHMODE 1
RETURN
' **********
'