' ******************
' *** GRAPH2.LST ***
' ******************
'
DEFWRD "a-z"
'
> PROCEDURE clip.rectangle(VAR rectangle$,x,y)
  ' *** cut rectangle (GET-string) from screen
  ' *** returns left upper corner (x,y) as well
  ' *** uses Procedure Click.point, Message.on and Message.off
  LOCAL clp.x2,clp.y2,x1,y1,mx,my,x2,y2,k
  @click.point("click on left upper corner of rectangle",x,y)
  @message.on("choose rectangle (confirm with click)")
  x1=MOUSEX
  y1=MOUSEY
  REPEAT
    MOUSE mx,my,k
  UNTIL mx<>x1 OR my<>y1
  @message.off
  GRAPHMODE 3
  MOUSE x2,y2,k
  REPEAT
    BOX x,y,x2,y2
    PLOT x,y
    REPEAT
      MOUSE clp.x2,clp.y2,k
    UNTIL (clp.x2<>x2 AND clp.x2>x) OR (clp.y2<>y2 AND clp.y2>y) OR k>0
    BOX x,y,x2,y2
    PLOT x,y
    x2=clp.x2
    y2=clp.y2
  UNTIL k>0
  GRAPHMODE 1
  GET x,y,clp.x2,clp.y2,rectangle$
  PAUSE 10                  ! short pause for release of button
RETURN
' **********
'
> PROCEDURE drag.clip
  ' *** drag GET-rectangle on screen
  ' *** original rectangle is not erased
  ' *** uses Procedure Clip.rectangle, Click.point, Message.on and Message.off
  LOCAL dx1,dy1,k,dx2,dy2,clip$
  @clip.rectangle(clip$,dx1,dy1)
  @message.on("move rectangle (place with click)")
  SETMOUSE dx1,dy1
  REPEAT
    MOUSE dx,dy,k
  UNTIL dx<>dx1 OR dy<>dy1
  @message.off
  HIDEM
  MOUSE dx1,dy1,k
  REPEAT
    PUT dx1,dy1,clip$,6
    REPEAT
      MOUSE dx2,dy2,k
    UNTIL dx2<>dx1 OR dy2<>dy1 OR k>0
    PUT dx1,dy1,clip$,6
    dx1=dx2
    dy1=dy2
  UNTIL k>0
  PUT dx1,dy1,clip$,3
  PAUSE 10
RETURN
' **********
'
> PROCEDURE load.clip(clip.file$,VAR clip$)
  ' *** load GET-rectangle from file and PUT on screen
  ' *** GET-rectangle saved with : BSAVE file$,V:pic$,LEN(pic$)
  ' *** use extension .PUT for these files
  ' *** uses Standard Global Variables
  LOCAL bytes,bit.planes,m$,k
  IF EXIST(clip.file$)
    OPEN "I",#90,clip.file$
    bytes=LOF(#90)
    CLOSE #90
    clip$=SPACE$(bytes)
    BLOAD clip.file$,VARPTR(clip$)
    bit.planes=DPEEK(VARPTR(clip$)+4)
    SELECT bit.planes
    CASE 1
      IF NOT high.res!
        m$="PUT-picture|suitable for|High resolution|only ???"
        ALERT 3,m$,1,"EDIT",k
        EDIT
      ENDIF
    CASE 2
      IF NOT med.res!
        m$="PUT-picture|suitable for|Medium resolution|only ???"
        ALERT 3,m$,1,"EDIT",k
        EDIT
      ENDIF
    CASE 4
      IF NOT low.res!
        m$="PUT-picture|suitable for|Low resolution|only ???"
        ALERT 3,m$,1,"EDIT",k
        EDIT
      ENDIF
    ENDSELECT
  ELSE
    m$=clip.file$+"| |not found !?"
    ALERT 3,m$,1,"EDIT",k
    EDIT
  ENDIF
RETURN
' **********
'
> PROCEDURE initio.picture
  ' *** draw picture on invisible logical screen and save in GET-string
  ' *** you probably should draw in a BOX
  ' *** the origin (left upper corner) is the point 0,0
  ' *** the following commands (with parameters) are allowed in DATA-lines :
  ' ***         DEFLINE , DEFTEXT , LINE , DRAW , BOX , RBOX , TEXT , END
  ' *** DRAW-format : DATA DRAW,number_of_points,x1,y1,x2,y2,x3,y3,etc.
  ' *** last DATA-line : END
  ' *** normal picture on screen : PUT x,y,picture$,3
  ' *** reverse picture on screen : PUT x,y,picture$,12 (don't use RBOX))
  '
  ' *** uses Procedure Initio.logical.screen etc.
  '
  @initio.logical.screen
  '
  ' *** here is an example of the different commands
  test.picture:
  DATA BOX,0,0,100,50
  DATA DEFTEXT,1,0,900,8
  DATA TEXT,9,45,test
  DATA DEFTEXT,1,0,2700,8
  DATA TEXT,90,5,test
  DATA LINE,0,0,100,50
  DATA DRAW,4,50,10,75,45,25,45,50,10
  DATA END
  RESTORE test.picture
  @initio.draw.picture(test.picture$)
  '
  @restore.physical.screen
RETURN
' ***
> PROCEDURE initio.draw.picture(VAR pic$)
  ' *** draw on invisible logical screen and put in GET-string
  LOCAL command$,s,w,b,e,c,s,angle,h,x1,y1,x2,y2
  LOCAL points,n,x,y,txt$,max.width,max.height
  CLS
  REPEAT
    READ command$
    command$=UPPER$(command$)
    IF command$="DEFLINE"
      READ s,w,b,e
      DEFLINE s,w,b,e
    ENDIF
    IF command$="DEFTEXT"
      READ c,s,angle,h
      DEFTEXT c,s,angle,h
    ENDIF
    IF command$="LINE"
      READ x1,y1,x2,y2
      LINE x1,y1,x2,y2
      @max.width.height
    ENDIF
    IF command$="DRAW"
      READ points,x1,y1
      PLOT x1,y1
      @max.width.height
      FOR n=1 TO points-1
        READ x2,y2
        DRAW  TO x2,y2
        @max.width.height
      NEXT n
    ENDIF
    IF command$="BOX"
      READ x1,y1,x2,y2
      BOX x1,y1,x2,y2
      @max.width.height
    ENDIF
    IF command$="RBOX"
      READ x1,y1,x2,y2
      RBOX x1,y1,x2,y2
      @max.width.height
    ENDIF
    IF command$="TEXT"
      ' *** correct size of text is not tested !
      READ x,y,txt$
      TEXT x,y,txt$
      IF angle=0
        x2=x+LEN(txt$)*h/2
        y2=y
      ENDIF
      IF angle=900
        x2=x
        y2=y
      ENDIF
      IF angle=2700
        x2=x+h
        y2=y+LEN(txt$)*h/2
      ENDIF
      @max.width.height
    ENDIF
  UNTIL command$="END"
  GET 0,0,width.max,height.max,pic$
RETURN
' ***
> PROCEDURE max.width.height
  width.max=MAX(width.max,x1)
  height.max=MAX(height.max,y1)
  width.max=MAX(width.max,x2)
  height.max=MAX(height.max,y2)
RETURN
' **********
'
> PROCEDURE cube(x,y,w,color,fill)
  ' *** draw cube (left upper corner x,y; fill=fillpattern)
  ' *** color of edges and pattern is the same
  LOCAL d,e
  d=w/3
  e=w+d
  ERASE cube.x(),cube.y()
  DIM cube.x(6),cube.y(6)
  cube.x(0)=x
  cube.x(1)=x
  cube.x(2)=x+d
  cube.x(3)=x+e
  cube.x(4)=x+e
  cube.x(5)=x+w
  cube.x(6)=x
  cube.y(0)=y
  cube.y(1)=y+w
  cube.y(2)=y+e
  cube.y(3)=y+e
  cube.y(4)=y+d
  cube.y(5)=y
  cube.y(6)=y
  DEFFILL color,2,fill
  POLYFILL 7,cube.x(),cube.y()
  COLOR color
  DRAW x,y+w TO x+w,y+w TO x+w,y
  DRAW x+w,y+w TO x+e,y+e
RETURN
' **********
'
> PROCEDURE mirror(get.pic$,mode,VAR mir.pic$)
  ' *** make mirror-image of GET-string
  ' *** mode : 0=vertical 1=horizontal
  LOCAL adr%,pic1%,pic2%,w,h,words,bit_rest
  '
  ' *** load MIRROR.INL (238 bytes) here
  INLINE mirror%,238
  '
  IF DIM?(mir%())=0
    DIM mir%(16)
  ENDIF
  mir.pic$=get.pic$
  pic2%=ADD(V:mir.pic$,6)
  adr%=V:get.pic$
  pic1%=ADD(adr%,6)
  w=SUCC(WORD{adr%})                    ! width (pixels)
  words=INT(ADD(w,15)/16)               ! width (words)
  bit_rest=SUB(MUL(words,16),w)         ! ignore these bits of last word of line
  mir%(0)=words
  mir%(1)=SUCC(WORD{ADD(adr%,2)})       ! height
  mir%(2)=bit_rest
  mir%(3)=mode
  mir%(8)=pic1%                         ! source
  mir%(9)=pic2%                         ! destination
  RCALL mirror%,mir%()
RETURN
' **********
'