'     *****************************************
'     *    3d viewing program VERSION 4.0     *
'     *                                       *
'     *          Peter K Scott 1988           *
'     *****************************************


LABEL initialise

      DIM x(500),y(500),z(500),a(500),b(500)
      scale=5:xx=4000:yy=2500
      one=0:two=45:three=45
      WINDOW OPEN :WINDOW FULL
      SCREEN #1 GRAPHICS 8500 FIXED,5000 FIXED
      ratio=YDEVICE/350

LABEL menu

      GOSUB new_screen
      WINDOW TITLE "** 3D VIEWING PROGRAM VERSION 4.0....P.K.SCOTT 1987 **"
      SET MODE 2
      SET FONT 3:SET COLOR 4
      PRINT AT (10;3)POINTS (18) "OPTION  1   *   ENTER A NEW SET OF DATA "
      PRINT AT (10;5)POINTS (18) "OPTION  2   *   LOAD AN IMAGE FROM DISC"
      PRINT AT (10;7)POINTS (18) "OPTION  3   *   SAVE AN IMAGE TO DISC"
      PRINT AT (10;9)POINTS (18) "OPTION  4   *   VIEW THE CURRENT IMAGE"
      PRINT AT (10;11)POINTS(18) "OPTION  5   *   PRINT-OUT COORDINATES"
      PRINT AT (10;13)POINTS(18) "OPTION  6   *   ADD TO COORDINATES"
      PRINT AT (10;15)POINTS(18) "OPTION  7   *   CHANGE COORDINATES"
      PRINT AT (10;17)POINTS(18) "OPTION  8   *   QUIT PROGRAM"
      SET FONT 1
      PRINT AT(20;19) COLOUR (1) "Please select one of the options 1-8"
      PRINT AT(18;20) COLOUR (1) "Locate the pointer on the star and click"
      SET MODE 1


LABEL mouse_point

      WHILE BUTTON=-1:WEND
      PRINT CHR$(7);
      ym=YMOUSE/ratio
      IF ym>=274 AND ym<=294 THEN GOTO new_data
      IF ym>=245 AND ym<=265 THEN GOTO load_image
      IF ym>=218 AND ym<=238 THEN GOTO save_image
      IF ym>=190 AND ym<=210 THEN GOTO view_image
      IF ym>=162 AND ym<=182 THEN GOTO print_coordinates
      IF ym>=134 AND ym<=154 THEN GOTO add_to
      IF ym>=106 AND ym<=126 THEN GOTO change_data
      IF ym>=80  AND ym<=100 THEN END

GOTO mouse_point


LABEL view_image

      OPTION DEGREES
      IF total=0 THEN GOSUB no_data:GOTO mouse_point
      WINDOW TITLE "bigger..smaller..rc..ra..higher..lower..right..left..up..down..flip..menu"
      PRINT AT (1;2)
      FOR i=1 TO total
      IF x(i)=999 THEN a(i)=999:GOTO 2
      GOSUB calculate
      2 NEXT i
      GOSUB new_screen
      i=0
      3 i=i+1
      GOSUB check_screen
      IF i=1 THEN MOVE a(i);b(i):GOTO 3
      IF a(i)=999 THEN i=i+1:GOSUB check_screen:MOVE a(i);b(i):IF i=total+1 THEN GOTO the_end ELSE GOTO 3
      GOSUB check_screen
      LINE a(i-1);b(i-1),a(i);b(i)
      IF i=total THEN GOTO the_end ELSE GOTO 3
      4 GOTO the_end



LABEL calculate

      k=x(i)-xrc
      l=y(i)-yrc
      n=z(i)-zrc
      o=k*COS(two)+l*SIN(two)
      p=-k*SIN(two)+l*COS(two)
      q=-o*SIN(three)+n*COS(three)
      a(i)=(p*COS(one)+q*SIN(one))*scale
      b(i)=(-p*SIN(one)+q*COS(one))*scale
      a(i)=xx+(a(i)*10)
      b(i)=yy+(b(i)*10)
      RETURN



LABEL new_data

      FOR i=1 TO total
      x(i)=0
      y(i)=0
      x(i)=0
      NEXT
      total=0
      i=1



LABEL add_to

      IF i=0 THEN GOSUB no_data:GOTO mouse_point
      i=total+1
      CLS
      WINDOW TITLE "Press 'f' to finish and 'n' for no line"
      PRINT
      PRINT" PLEASE ENTER YOUR COORDINATES"
      5 PRINT" Coordinate number ";i;
      PRINT TAB(35);
      INPUT "x=";z$;
      IF z$="f" OR z$="F" THEN total=i-1:GOTO 7
      IF z$="n" OR z$="N" THEN x(i)=999:PRINT:GOTO 6
      x(i)=VAL(z$)
      PRINT TAB(50);:INPUT "y=";y(i);
      PRINT TAB(65);:INPUT "z=";z(i)
      6 i=i+1
      GOTO 5
      7 CLS
      PRINT
      PRINT " ENTER THE X Y and Z VALUES FOR THE CENTRE OF ROTATION"
      INPUT" x=";xrc
      INPUT" y=";yrc
      INPUT" z=";zrc
      GOTO menu



LABEL the_end


      SET COLOR 1
      WHILE BUTTON=-1:WEND
      PRINT CHR$(7);
      IF XMOUSE>=30  AND XMOUSE <=95  THEN scale=scale+2
      IF XMOUSE>=96  AND XMOUSE <=167 THEN scale=scale-2
      IF scale<1 THEN scale=1
      IF XMOUSE>=168 AND XMOUSE <=199 THEN two=two+15
      IF XMOUSE>=200 AND XMOUSE <=230 THEN two=two-15
      IF XMOUSE>=231 AND XMOUSE <=295 THEN three=three+15
      IF XMOUSE>=296 AND XMOUSE <=351 THEN three=three-15
      IF XMOUSE>=352 AND XMOUSE <=407 THEN xx=xx+500
      IF XMOUSE>=408 AND XMOUSE <=453 THEN xx=xx-500
      IF XMOUSE>=454 AND XMOUSE <=485 THEN yy=yy+500
      IF XMOUSE>=486 AND XMOUSE <=534 THEN yy=yy-500
      IF XMOUSE>=535 AND XMOUSE <=564 THEN two=two+180
      IF XMOUSE>=565 AND XMOUSE <=614 THEN GOTO menu
      GOTO view_image



LABEL check_screen

      SET COLOR 2
      IF a(i)<0 OR a(i)>8500 THEN GOSUB too_big:GOTO the_end
      IF b(i)<0 OR b(i)>5000 THEN GOSUB too_big:GOTO the_end
      RETURN



LABEL save_image

      IF total=0 THEN GOSUB no_data:GOTO mouse_point
      CLS
      PRINT
      INPUT" What do you want to call your image";name$
      OPEN #3 OUTPUT name$
      PRINT #3,total
      FOR i=1 TO total
      PRINT #3,x(i),y(i),z(i)
      NEXT i
      PRINT #3,xx,yy,one,two,three,xrc,yrc,zrc,scale
      CLOSE
      GOTO menu



LABEL load_image

      CLS
      FILES
      PRINT
      INPUT" Please type in the name of the image and press return";name$
      ON ERROR GOTO error_check
      OPEN #3 INPUT name$
      INPUT #3,total
      FOR i=1 TO total
      INPUT #3,x(i),y(i),z(i)
      NEXT i
      INPUT #3,xx,yy,one,two,three,xrc,yrc,zrc,scale
      CLOSE
      GOTO view_image



LABEL print_coordinates

      IF total=0 THEN GOSUB no_data:GOTO mouse_point
      FOR i = 1 TO total
      LPRINT "Coordinate number ";i;
      IF x(i)=999 THEN LPRINT TAB(35) "NO LINE ":GOTO 8
      LPRINT TAB (35) "x=";x(i);
      LPRINT TAB (50) "y=";y(i);
      LPRINT TAB (65) "z=";z(i)
      8 NEXT i
      GOTO mouse_point



LABEL change_data


      IF total=0 THEN GOSUB no_data:GOTO mouse_point
      CLS
      PRINT
      INPUT" PLEASE ENTER THE NUMBER OF THE POINT YOU WANT TO CHANGE";i
      PRINT" COORDINATE NUMBER";i;" IS  PRESENTLY SET AT"
      IF x(i)=999 THEN PRINT " NO LINE":GOTO 9
      PRINT
      PRINT " x=";x(i),"y=";y(i),"z=";z(i)
      9 PRINT
      PRINT " ENTER THE NEW VALUES or press 'n' for NO LINE"
      INPUT" x=";z$
      IF z$="n" THEN x(i)=999:GOTO 10
      x(i)=VAL (z$)
      INPUT" y=";y(i)
      INPUT" z=";z(i)
      10 PRINT:PRINT" DO YOU WANT TO CHANGE ANY MORE"
      11 a$=INKEY$:IF a$="" THEN 11
      IF a$="y" THEN GOTO change_data
      IF a$="n" THEN GOTO menu
      GOTO 11



LABEL error_check

      CLS
      PRINT CHR$(7)
      PRINT" SORRY THERE IS NO IMAGE STORED UNDER THAT NAME"
      PRINT CHR$(7)
      GOSUB delay
      CLOSE
      RESUME load_image



LABEL delay

      FOR x=1 TO 5000
      NEXT
      RETURN



LABEL no_data

      PRINT CHR$(7);
      GOSUB delay
      RETURN



LABEL too_big

      PRINT AT (2;2) " COORDINATE OUTSIDE VIRTUAL SCREEN"
      PRINT CHR$(7)
      GOSUB delay
      RETURN


LABEL new_screen

      BOX 0;0,8500,5000 COLOUR 6 FILL WITH 5
      RETURN