CP/M/CPM_CDROM.iso/lambda/soundpot/f/kpgraph.lbr/GRAPH1.BZS/GRAPH1.BAS

BASIC Source File | 1993-10-26 | 4.5 KB | 198 lines

VAR INVERSE,REDUCED,BLINKING,UNDERLINE,CURSOR = CHAR
INVERSE = '0'
REDUCED = '1'
BLINKING = '2'
UNDERLINE = '3'
CURSOR = '4'
PROCEDURE PAUSE
    VAR X = CHAR
    INPUT3"PRESS <RETURN> KEY TO CLEAR SCREEN.....";X
END

PROCEDURE SET.ON (ATT=CHAR)
    PRINT CHR(27); 'B'; ATT;
END

PROCEDURE SET.OFF (ATT=CHAR)
    PRINT CHR(27); 'C'; ATT;
END

PROCEDURE POSITION (VERT, HORZ = CHAR)
    PRINT CHR(27); '=' ; VERT+31; HORZ+31;
END

PROCEDURE PIXON (VERT1,HORZ1=CHAR)
    PRINT CHR(27);'*';(VERT1+31);(HORZ1+31);
END

PROCEDURE PIXOFF (VERT1,HORZ1=CHAR)
    PRINT CHR(27);' ';(VERT1+31);(HORZ1+31);
END

PROCEDURE LINEON (VERT1,HORZ1,VERT2,HORZ2=CHAR)
    PRINT CHR(27);'L';(VERT1+31); (HORZ1+31); (VERT2+31); (HORZ2+31);
END

PROCEDURE LINEOFF (VERT1,HORZ1,VERT2,HORZ2=CHAR)
    PRINT CHR(27);'D';(VERT1+31);(HORZ1+31);(VERT2+31);(HORZ2+31);
END

PROCEDURE CLEAR.SCREEN
    PRINT CHR(26)
END

FUNCTION SQRT(N=INTEGER) =INTEGER
    VAR ROOT1,ROOT2 = INTEGER

    ROOT1 = N
    ROOT2 = 1
    WHILE (ROOT1 > ROOT2) DO BEGIN
        ROOT1 = (ROOT1 + ROOT2)/2
        ROOT2 = N/ROOT1
    END
END = ROOT1

PROCEDURE CIRCLE (CENTER.Y, CENTER.X, RADIUS = INTEGER)
    VAR X, Y, OFFSET = INTEGER
    OFFSET = (RADIUS * 100) / 141

    PIXON CENTER.Y + RADIUS - 1, CENTER.X
    PIXON CENTER.Y - RADIUS + 1, CENTER.X

    FOR X = 1 TO OFFSET
        Y = SQRT(RADIUS^2 - X^2)

        PIXON CENTER.Y + Y , CENTER.X + X
        PIXON CENTER.Y + Y , CENTER.X - X
        PIXON CENTER.Y - Y , CENTER.X + X
        PIXON CENTER.Y - Y , CENTER.X - X
     NEXT

    PIXON CENTER.Y, CENTER.X + RADIUS - 1
    PIXON CENTER.Y, CENTER.X - RADIUS + 1

    FOR Y = 1 TO OFFSET
        X = SQRT(RADIUS^2 - Y^2 )

        PIXON CENTER.Y + Y , CENTER.X + X
        PIXON CENTER.Y + Y , CENTER.X - X
        PIXON CENTER.Y - Y , CENTER.X + X
        PIXON CENTER.Y - Y , CENTER.X - X
     NEXT
END

PROCEDURE RECTANGLE (Y, X, HEIGHT, WIDTH = INTEGER)
    LINEON Y, X, Y + HEIGHT, X
    LINEON Y, X + WIDTH, Y + HEIGHT, X + WIDTH
    LINEON Y, X, Y, X + WIDTH
    LINEON Y + HEIGHT, X, Y + HEIGHT, X + WIDTH
END

PROCEDURE SQUARE (Y, X, SIDE = INTEGER)
    RECTANGLE Y, X, SIDE, SIDE
END


PROCEDURE BAR(REF.Y,REF.X,HEIGHT,WIDTH,DEPTH,INSIDE,VERT.P,HORZ.P=INTEGER)
    VAR I, TEMP, EMPTY, FULL, X, Y = INTEGER
    DIM INTEGER REF(2) CENTER(2) REAR(2)

    X = 1
    Y = 2
    FULL = 1
    EMPTY = 0

    REF(X) = REF.X
    REF(Y) = REF.Y
    CENTER(X) = REF.X + (WIDTH * HORZ.P)
    CENTER(Y) = REF.Y + (HEIGHT * VERT.P)
    REAR(X) = CENTER(X) + (DEPTH * HORZ.P)
    REAR(Y) = CENTER(Y) + (DEPTH * VERT.P)

    IF (INSIDE = EMPTY) THEN BEGIN
        FOR I = REF(X) TO CENTER(X) STEP HORZ.P
            LINEOFF REF(Y), I, CENTER(Y), I
        NEXT I

        FOR I = 0 TO (WIDTH*HORZ.P) STEP HORZ.P
            LINEOFF CENTER(Y), CENTER(X)-I, REAR(Y), (REAR(X)-I)
         NEXT I
        FOR I = 0 TO (HEIGHT*VERT.P) STEP VERT.P
            LINEOFF CENTER(Y)-I, CENTER(X), (REAR(Y)-I), REAR(X)
        NEXT I

        LINEON REF(Y),REF(X),CENTER(Y),REF(X)
        LINEON REF(Y),REF(X),REF(Y),CENTER(X)
        LINEON CENTER(Y),CENTER(X),CENTER(Y),REF(X)
        LINEON CENTER(Y),CENTER(X),REF(Y),CENTER(X)

        LINEON CENTER(Y),CENTER(X),REAR(Y),REAR(X)

        LINEON REF(Y),CENTER(X),(REAR(Y)-HEIGHT*VERT.P),REAR(X)
        LINEON CENTER(Y),REF(X),REAR(Y),(REAR(X)-WIDTH*HORZ.P)

        LINEON REAR(Y),REAR(X),(REAR(Y)-HEIGHT*VERT.P),REAR(X)
        LINEON REAR(Y),REAR(X),REAR(Y),(REAR(X)-WIDTH*HORZ.P)

    END

    IF (INSIDE = FULL) THEN BEGIN
        FOR I = REF(X) TO CENTER(X) STEP HORZ.P
            LINEON REF(Y), I, CENTER(Y), I
        NEXT I

        FOR I = 0 TO (WIDTH*HORZ.P) STEP HORZ.P
            LINEON CENTER(Y), CENTER(X)-I, REAR(Y),(REAR(X)-I)
         NEXT I
        FOR I = 0 TO (HEIGHT*VERT.P) STEP VERT.P
            LINEON CENTER(Y)-I, CENTER(X), (REAR(Y)-I),REAR(X)
        NEXT I

        LINEOFF CENTER(Y),CENTER(X),CENTER(Y),REF(X)
        LINEOFF CENTER(Y),CENTER(X),REF(Y),CENTER(X)

        LINEOFF CENTER(Y),CENTER(X),REAR(Y),REAR(X)
    END
END

PROCEDURE ONE_THREE
    RECTANGLE 2,50,18,60
    LINEON 20,80,26,80
    LINEON 26,26,26,135
    LINEON 26,26,32,26
    LINEON 26,80,32,80
    LINEON 26,135,32,135
    RECTANGLE 32,2,36,48
    RECTANGLE 32,56,36,48
    RECTANGLE 32,110,36,48
END

PROCEDURE ONE_TWO
    RECTANGLE 2,50,18,60
    LINEON 20,80,26,80
    LINEON 26,40,26,120
    LINEON 26,40,32,40
    LINEON 26,120,32,120
    RECTANGLE 32,2,36,75
    RECTANGLE 32,83,36,75
END

PROCEDURE NEXT_VIEW
    POSITION 24,3
    PAUSE
    CLEAR.SCREEN
    POSITION 24,3
END

PROCEDURE DRAW_BOX

LINEON 2,2,    2,159
LINEON 2,2,    98,2
LINEON 98,2,   98,159
LINEON 2,159,  98,159

LINEON 19,2,   19,159
LINEON 19,51,  91,51
LINEON 91,2,    91,159

END
è