! ************************************************************************
! *                                                                      *
! *                           D     R     A     W                        *
! *                     Extemely Useless Doodle Program                  *
! *                                                                      *
! ***********************************************************************
! Version 1.0 Written by Lee Pallmann for UltraSoft on 01/27/86
!
! This program is designed to run on an AM60/AM62/AM62A terminal.

MAPS:   MAP1 TEXT,S,10
       MAP1 I,F,6
       MAP1 KEY,S,1
       MAP1 R,F,6,3
       MAP1 C,F,6,3
       MAP1 R1,F,6
       MAP1 C1,F,6
       MAP1 FLAG,F,6
       MAP1 MSG,S,10
       MAP1 CHAR,S,3
       MAP1 H,F,6
       MAP1 V,F,6

       ON ERROR GOTO ERROR
       PRINT TAB(-1,12); "Ultra"; TAB(-1,11); "Draw "; TAB(-1,12); "1.0"
       FOR I = 1 TO 1000 : NEXT I
       PRINT TAB(-1,0);

HEADER: RESTORE
       PRINT TAB(1,1);
       FOR I = 1 TO 6
        READ TEXT
        PRINT SPACE(8); TAB(-1,12); TEXT[1;1];
        PRINT TAB(-1,11); TEXT[2;LEN(TEXT)];
        NEXT I
        PRINT
        DATA Box, Line, Fill, Text, Clear, Quit
       FOR I = 1 TO 10
        PRINT "--------";
        NEXT I
        PRINT TAB(-1,12);
       CALL DISPLAY

WAIT'FOR'COMMAND:
       XCALL GET,KEY
       KEY = UCS(KEY)
       IF KEY = "B" AND FLAG = 1 THEN RETURN
       IF KEY = "B" THEN CALL MSG : GOTO BOX
       IF KEY = "Q" THEN GOTO QUIT
       IF KEY = "L" AND FLAG = 2 THEN RETURN
       IF KEY = "L" THEN CALL MSG : GOTO LINE
       IF KEY = "F" AND FLAG = 1 THEN RETURN
       IF KEY = "F" THEN CALL MSG : GOTO FILL
       IF KEY = "T" THEN I = C : CALL MSG : GOTO TEXT
       IF KEY = "C" THEN GOTO CLEAR
       IF ASC(KEY) = 27 THEN GOTO QUIT
       IF ASC(KEY) = 11 THEN R=R-1     ! Up
       IF ASC(KEY) = 10 THEN R=R+1     ! Down
       IF ASC(KEY) = 8 THEN C=C-1      ! Left
       IF ASC(KEY) = 12 THEN C=C+1     ! Right
       IF ASC(KEY) = 13 THEN C=1 : R=R+1
       IF ASC(KEY) < 14 THEN CALL DISPLAY
       GOTO WAIT'FOR'COMMAND

DISPLAY:IF R > 24 THEN R=24
       IF C > 80 THEN C=80
       IF C < 1 THEN C=1
       IF R < 3 THEN R = 3
       PRINT TAB(R,C);
       RETURN

BOX:    R1 = R : C1 = C
       IF FLAG=0 PRINT TAB(R,C); "+"; TAB(-1,5);
       FLAG=1
       CALL WAIT'FOR'COMMAND
       FLAG=0 : I=0
         IF R < R1 THEN I=R : R=R1 : R1=I : I=1
         IF C < C1 THEN I=C : C=C1 : C1=I : I=I+1
         IF R1=R OR C1=C THEN PRINT CHR(7); : GOTO HEADER
       XCALL BOX,R1,C1,R,C
       IF I=1 OR I=3 THEN R=R1
       IF I > 1 THEN C=C1
       GOTO HEADER

LINE:   R1 = R : C1 = C
       PRINT TAB(-1,23);
       XCALL GET, KEY
       IF KEY = CHR(27) OR UCS(CHAR) = "L" THEN PRINT TAB(-1,24); : GOTO HEADER
       IF KEY = CHR(12) THEN C=C+1 : CHAR = "Z" : CALL PLINE : GOTO HORIZ
       IF KEY = CHR(8) THEN C=C-1 : CHAR = "Z" : CALL PLINE : GOTO HORIZ
       IF KEY = CHR(10) THEN R=R+1 : CHAR="6" : CALL PLINE : GOTO VERT
       IF KEY = CHR(11) THEN R=R-1 : CHAR="6" : CALL PLINE : GOTO VERT
       GOTO LINE
       HORIZ:
        XCALL GET, KEY
        IF KEY=CHR(27) OR UCS(CHAR)="L" THEN PRINT TAB(-1,24); : GOTO HEADER
        IF KEY=CHR(12) THEN C=C+1 : CHAR="Z" : CALL PLINE : H = 1
        IF KEY=CHR(8) THEN C=C-1 : CHAR="Z" : CALL PLINE : H = 0
        IF KEY=CHR(11) AND H=1 THEN CHAR="5" : CALL PLINE : GOTO VERT
        IF KEY=CHR(11) AND H=0 THEN CHAR="1" : CALL PLINE : GOTO VERT
        IF KEY=CHR(10) AND H=1 THEN CHAR="3" : CALL PLINE : GOTO VERT
        IF KEY=CHR(10) AND H=0 THEN CHAR="2" : CALL PLINE : GOTO VERT
        GOTO HORIZ
       VERT:
        XCALL GET, KEY
        IF KEY=CHR(27) OR UCS(CHAR)="L" THEN PRINT TAB(-1,24); : GOTO HEADER
        IF KEY=CHR(10) THEN R=R+1 : CHAR="6" : CALL PLINE : V = 1
        IF KEY=CHR(11) THEN R=R-1 : CHAR="6" : CALL PLINE : V = 0
        IF KEY=CHR(12) AND V=1 THEN CHAR="1" : CALL PLINE : GOTO HORIZ
        IF KEY=CHR(12) AND V=0 THEN CHAR="2" : CALL PLINE : GOTO HORIZ
        IF KEY=CHR(8) AND V=1 THEN CHAR="5" : CALL PLINE : GOTO HORIZ
        IF KEY=CHR(8) AND V=0 THEN CHAR="3" : CALL PLINE : GOTO HORIZ
        GOTO VERT

       PLINE:  IF R < 2 THEN R=2
               IF R > 24 THEN R=24
               IF C < 1 THEN C=1
               IF C > 80 THEN C=80
               PRINT TAB(R,C); CHAR; TAB(-1,5);
               R1 = R : C1 = C
               RETURN

CLEAR:  PRINT TAB(3,1); TAB(-1,10);
       CALL DISPLAY
       CALL HEADER

FILL:   R1 = R : C1 = C
       IF FLAG=0 PRINT TAB(R,C); "+"; TAB(-1,5);
       FLAG=1
FILL2:  CALL WAIT'FOR'COMMAND
       IF ABS(R-R1)<1 OR ABS(C-C1)<1 THEN PRINT CHR(7); : GOTO FILL2
       FLAG=0 : I=0
         IF R < R1 THEN I=R : R=R1 : R1=I : I=1
         IF C < C1 THEN I=C : C=C1 : C1=I : I=I+1
         IF R1=R OR C1=C THEN PRINT CHR(7); : GOTO HEADER
       FOR I=R1 TO R
           PRINT TAB(I,C); TAB(-1,33); TAB(I,C1); TAB(-1,32);
           NEXT I
       PRINT TAB(R1,C1);
       GOTO HEADER

TEXT:   XCALL GET,KEY
       IF KEY = CHR(13) THEN C = 1 : R = R + 1 : CALL DISPLAY
       IF KEY = CHR(27) THEN GOTO HEADER
       IF KEY = CHR(127) THEN PRINT TAB(-1,5); CHR(32); TAB(-1,5); : &
               C = C - 1 : GOTO TEXT                   ! Handle Delete
       PRINT KEY;
       C = C + 1
       GOTO TEXT

MSG:    PRINT TAB(-1,1); TAB(-1,9); SPACE(30); TAB(-1,11);
       IF KEY = "T" THEN PRINT "Text Mode (ESC to Exit)";
       IF KEY = "B" THEN PRINT "Box Mode ('B' to Finish)";
       IF KEY = "F" THEN PRINT "Fill Mode ('F' to Finish)";
       IF KEY = "L" THEN PRINT "Line Mode (ESC to Finish)";
       PRINT TAB(-1,12);
       CALL DISPLAY
       RETURN

ERROR:  PRINT TAB(-1,11); TAB(23,20);
       PRINT "This Program has Died an Unseemly Death!"

QUIT:   PRINT TAB(1,1); TAB(-1,9); TAB(2,1); TAB(-1,9);
       PRINT TAB(24,1); TAB(-1,12);
       END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.