IUBio Biosequences .. Software .. Molbio soft .. Network News .. FTP

q b a s i c p p o g r a m s [LONG!]

ken collins kckpaulc at aol.comABCXYZ
Sat Nov 6 16:34:14 EST 1999


'(c) copyright 1983, 1999 K. P. Collins
'license granted for non-comercial use =only=
'hi, here are some q b a s i c p r o g r a m s y o u w i l l h a v e to
'e d i t t h i s a s c i i f i l e i n a w o r d p r o c e s s o r l i k e
'W o r d P e r f e c t o r W o r d t h e b r e a k p o i n t s a r e
'c l e a r l y m a r k e d b e l o w i w i l l d i s c u s i n f o l l o w
'u p m e s s a g e s ( t h e k e y i s n o t i n h e r e )

'b e g i n s p h y . b a s -------------------------------------------------
DECLARE SUB QNumEnergy ()
DECLARE SUB Ratio1 ()
DECLARE SUB Ratio1.1 ()
DECLARE SUB PauseQ ()
DECLARE SUB Grid.0 ()
DECLARE SUB Spectrum.H1 ()

    SCREEN 12: COLOR 7
    WINDOW (150, 0)-(0, 15)

    pi# = 4 * ATN(1)                ' PI=3.14159265359...
    c# = 2.99792458# * 10 ^ 8       ' speed of light --- m / s
    h# = 6.626076 * 10 ^ -34        ' Plank's Constant --- J * s
    k# = 8.99 * 10 ^ 9              ' Coulomb constant --- (N * m ^ 2) / C ^ 2
    E0# = 1 / (4 * pi# * k#)        ' permitivity constant
    e# = 1.6 * 10 ^ -19             ' fundamental unit of charge
    me# = 9.10939 * 10 ^ -31        ' mass of electron --- kg
    mp# = 1.672623 * 10 ^ -27       ' mass of proton --- kg
    mn# = 1.674929 * 10 ^ -27       ' mass of neutron --- kg
    Avog# = 6.0221367# * 10 ^ 23
    Grav# = 6.67259 * 10 ^ -11      ' N * m ^ 2 / kg ^ 2
    Ryd# = 1.0973731534# * 10 ^ 7   ' Rydberg Constant --- m ^ -1
    Perm# = 4 * pi# * 10 ^ -7       ' permeability of free space N/A ^ 2
    e# = 1.602177 * 10 ^ -19        ' fundamental unit of charge --- Coulombs
    me# = 9.10939 * 10 ^ -31        ' mass of electron --- kg
    mp# = 1.672623 * 10 ^ -27       ' mass of proton --- kg
    mn# = 1.6749286# * 10 ^ -27     ' mass of neutron --- kg

begin: CLS

   Ratio1.1
   QNumEnergy
   Spectrum.H1

   GOTO begin

SUB Grid.0
SHARED xscale#, x#, yscale#, y#

    FOR G# = 0 TO xscale# STEP xscale# / 25#   ' ESTABLISH GRID LINES
       LINE (G#, 0)-(G#, yscale#), 8           ' DRAW X GRID
    NEXT

    FOR G# = 0 TO yscale# STEP yscale# / 25#   ' ESTABLISH GRID LINES
      LINE (0, G#)-(xscale#, G#), 8            ' DRAW Y GRID
    NEXT

    LINE (xscale# / 25 * 14, yscale# / 25 * 14)-(xscale# / 25 * 14, yscale# /
25 * 15), 3
    LINE (xscale# / 25 * 14, yscale# / 25 * 14)-(xscale# / 25 * 15, yscale# /
25 * 14), 3

    FOR XX# = 0 TO xscale# STEP xscale# / 100# ' ESTABLISH GRID POINTS
       FOR YY# = 0 TO yscale# STEP yscale# / 100#
           PSET (XX#, YY#), 8
       NEXT
    NEXT

    LOCATE 15, 45: PRINT xscale# / 25
    LOCATE 13, 47: PRINT yscale# / 25

'    LINE (0, y#)-(xscale#, y#), 7              ' DRAW X AXIS
'    LINE (x#, 0)-(x#, yscale#)                 ' DRAW Y AXIS

END SUB

SUB PauseQ

    COLOR 12: LOCATE 1, 79: PRINT "e"
114 A$ = INKEY$: IF A$ = "" THEN GOTO 114
    IF A$ = "C" OR A$ = "c" THEN CLS      ' ENTERING "C" CLEARS SCREEN
    IF A$ = "E" OR A$ = "e" THEN END      ' ENTERING "E" ENDS EXECUTION
    COLOR 0: LOCATE 1, 79: PRINT "e": COLOR 7

END SUB

SUB QNumEnergy

SHARED pi#, me#, e#, E0#, h#

    GOSUB Setup.Q1

    FOR n% = StartN% TO EndN% STEP -1
       Energy# = -((me# * e# ^ 4) / (8 * E0# ^ 2 * h#)) * (1 / n% ^ 2)
       Energy# = Energy# * scale#
       LOCATE 19, 30
       PRINT "n = "; n%; "Energy = "; Energy#; " "; : ' INPUT a$
       PSET (n%, -Energy#), attrib%: SLEEP 1
    NEXT n%

    PauseQ
       LOCATE 20, 30
       PRINT "                                            "

EXIT SUB

Setup.Q1:

     xscale# = 15#         ' X x Y window scale
     yscale# = 150#

     StartN% = 15          ' main variation
     EndN% = 1
     Incr1# = -1

     x# = xscale# / 2      ' X x Y window scale - center circle in window
     y# = yscale# / 2

     attrib% = 15          ' color for plot
     scale# = 10 ^ 53      ' align the overlay in Y

     WINDOW (0, 0)-(xscale#, yscale#)


LOCATE 2, 15
PRINT "QNumEnergy - This step traces Quantum Number (X scale = 15) "
LOCATE 3, 15
PRINT "against energy level (Y scale = 150 * 10^53). The last      "
LOCATE 4, 15
PRINT "factor is used to align the overlay - play with it.         "
LOCATE 5, 15
PRINT "The Quantum Numbers vary from 15 to 1 by -1. Look closely   "
LOCATE 6, 15
PRINT "for the 15 white dots against the prior spherical-volume-   "
LOCATE 7, 15
PRINT "surface-area trace - note the excellent goodness of fit.    "
RETURN

END SUB

SUB Ratio1.1
SHARED pi#, xscale#, x#, yscale#, y#

GOSUB Setup.R1.1

LOCATE 19, 30
PRINT "Vol/Area"
RS# = 15#                               ' starting "volume"
volsphere# = 4# / 3# * pi# * RS# ^ 3#   ' (Thanks, M. F.)

FOR r# = vr1# TO vr2# STEP -incr2#
   areasphere# = 4 * pi# * r# ^ 2
   var# = volsphere# / areasphere#
   PSET (r#, var#), 9
   LOCATE 19, 39
   PRINT var#
NEXT r#
PauseQ
EXIT SUB

Setup.R1.1:

        xscale# = .0005125#             ' X x Y window scale
        yscale# = 1000000000000#
        x# = xscale# / 2                ' used in grid
        y# = yscale# / 2

        vr1# = .0005125#                ' view variation
        vr2# = .000001#
        incr2# = .0000001#

        WINDOW (0, 0)-(xscale#, yscale#)

CLS

Grid.0
LOCATE 2, 15
PRINT "Ratio1 - This step traces the ratios of spherical volume to "
LOCATE 3, 15
PRINT "surface-area as the sphere is compressed while the 'volume' "
LOCATE 4, 15
PRINT "is held constant. The starting radius is 15. The compressed "
LOCATE 5, 15
PRINT "radii vary from 0.0005125 to 0.000001 by 0.0000001.         "

RETURN

END SUB

SUB Spectrum.H1
SHARED pi#, force#, c#, e#, me#, mp#, mn#, h#, Ryd#, E0#

DIM Sp#(15, 15)
GOSUB Sp.H1.1
' do the all-in-one traditional spectrum for hydrogen - save values in Sp#()
attrib% = 16: offset% = 1

FOR m% = 1 TO 15
   attrib% = attrib% - 1
   offset# = offset# + .25
   FOR n% = 15 TO m% STEP -1
      Wave# = Ryd# * ((1 / m% ^ 2) - (1 / n% ^ 2))
      Sp#(m%, n%) = Wave#
      LINE (0, Wave#)-(.25, Wave#), attrib%
   NEXT n%
'   PauseQ
NEXT m%
PauseQ
attrib% = 0: offset% = 15

GOSUB Sp.H1.2
' spread out the traditional spectrum for hydrogen in accord with Nonlinear
' Perspective at intervals matching the intervals of the QNumEnergy step
attrib% = 0
FOR m% = 15 TO 1 STEP -1
   LOCATE 19, 30
   PRINT "m ="; m%; "                            "
   attrib% = attrib% + 1
   offset# = offset# - .25
   FOR n% = 1 TO 15
      LINE (m% - .25, Sp#(m%, n%))-(m%, Sp#(m%, n%)), attrib%
   NEXT n%
   SLEEP 1
'   PauseQ
NEXT m%
LOCATE 19, 30
PRINT "                                  "
LOCATE 23, 23
COLOR 11: PRINT "There's a lot of 'same stuff' in here.": COLOR 7
PauseQ

EXIT SUB

Sp.H1.1:
        xscale# = 15#         ' X x Y window scale
        yscale# = 11400000#
        x# = xscale# / 2: y# = yscale# / 2
        WINDOW (0, 0)-(xscale#, yscale#)

LOCATE 19, 30
PRINT "                                     "
LOCATE 2, 15
PRINT "Spectrum.H1 - This step first presents the Hydrogen spectrum"
LOCATE 3, 15
PRINT "on the left. (X scale = 15. Y scale = 1.14^7.)              "
LOCATE 4, 15
PRINT "                                                            "
LOCATE 5, 15
PRINT "                                                            "
LOCATE 6, 15
PRINT "                                                            "
LOCATE 7, 15
PRINT "                                                            "
LOCATE 8, 15
PRINT "                                                            "
RETURN

Sp.H1.2:
LOCATE 2, 15
PRINT "Spectrum.H1 - Next, the Hydrogen spectrum is interpreted in "
LOCATE 3, 15
PRINT "accord with the volume - surface-area conceptualization.    "
LOCATE 4, 15
PRINT "(X scale = 15. Y scale = 1.14^7.) Again, the Y scale was    "
LOCATE 5, 15
PRINT "chosen to align the Y overlay - play with it.               "
RETURN

END SUB
'e n d s p h y . b a s -----------------------------------------------------

'b e g i n n o n c o n e . b a s -------------------------------------------
REM                          9:16 PM  6 DEC, 1987
' NONCONE0 - NONLINEAR PERSPECTIVE DEMO - USING LINE GRAPHIC; APPROACH ONLY
    KEY OFF
    SCREEN 9 ' EGA 16 COLORS
    WINDOW (-200, -200)-(200, 200)
    PI# = 4 * ATN(1):  TAN60 = TAN(60 / 57.2958)' PI#= 3.141592653589793
10  CLS
100 PSET (200, -200), 14                     ' YELLOW DOT MARKS "INPUT"
CONDITION
110 A$ = INKEY$: IF A$ = "" THEN GOTO 110
    IF A$ = "C" OR A$ = "c" THEN GOTO 10     ' ENTERING "C" CLEARS SCREEN
    IF A$ = "E" OR A$ = "e" THEN END         ' ENTERING "E" ENDS EXECUTION
    PSET (200, -200), 8                      ' OVERWRITES THE YELLOW DOT
    J = 0: C = 0: DISTANCE = 100: THETA.R = 0: C.DIST = 0: INTERVAL = 0:
INVERSION% = 0: SLOW = .15
    VFCOLOR% = 1: OBJCOLOR% = 1: OLD.C = 0
120 LOCATE 1, 1: PRINT "                                       "
    COLOR 8: LOCATE 1, 1: PRINT "RADIUS ANGLE (30) ": LOCATE 1, 20: INPUT "";
THETA.R
    LOCATE 1, 1: PRINT "                                              "
    IF THETA.R = 0 THEN THETA.R = 30
    THETA.R = THETA.R / 57.2958
    TAN.THETA.R = TAN(THETA.R)
    LOCATE 1, 1: PRINT "INIT DIST (100) ": LOCATE 1, 20: INPUT ""; C.DIST
    LOCATE 1, 1: PRINT "                                              "
    IF C.DIST = 0 THEN C.DIST = 100
    LOCATE 1, 1: PRINT "INTERVAL (.1) ": LOCATE 1, 20: INPUT ""; INTERVAL
    LOCATE 1, 1: PRINT "                     "
    IF INTERVAL = 0 THEN INTERVAL = .1
    IF INTERVAL < 1 THEN SLOW = 0
    LOCATE 1, 1: PRINT "                                              "
    LINE (-200, 0)-(200, 0), 7               ' DRAW UPPER X AXIS
    LINE (0, -200)-(0, 200), 7               ' DRAW RIGHT Y AXIS
    FOR X = -200 TO 200 STEP 20              ' ESTABLISH GRID POINTS
       FOR Y = -200 TO 200 STEP 20
           PSET (X, Y), 7
       NEXT
    NEXT
' APPROACHING OBJECTS
==========================================================
    WHILE DISTANCE >= .01
       R = (100 - C.DIST) * TAN.THETA.R' LENGTH OF RADIUS OF THE CIRCLE
       J = (C.AREA - O.AREA) / INTERVAL       ' CHANGE IN AREA PER UNIT TIME
       C.AREA = PI# * R ^ 2                   ' AREA OF CIRCLE @ CURRENT
DISTANCE
       J = (C.AREA - O.AREA) / INTERVAL       ' CHANGE IN AREA PER UNIT TIME

       C.VF.RADIUS = C.DIST * TAN60' RADIUS OF VISUAL FIELD @ CURRENT DISTANCE
       C.VF.AREA = PI# * C.VF.RADIUS ^ 2' AREA OF VISUAL FIELD @ CURRENT
DISTANCE
       C = C.AREA / C.VF.AREA' RATIO OF OBJECT'S AREA TO AREA OF VF @ CURRENT
DISTANCE

       IF R > C.VF.RADIUS AND NOT INVERSION% THEN GOSUB 2000 ELSE GOSUB 1000

       O.AREA = C.AREA:    C.DIST = C.DIST - INTERVAL:  DISTANCE = C.DIST
    WEND
    GOTO 100

1000 ' R<C.VF.RADIUS
===========================================================
     IF C < 10 * OLD.C THEN GOTO 1010
     VFCOLOR% = VFCOLOR% + 1:  OLD.C = C
     LINE (C.DIST, -200)-(C.DIST, 200), 4     ' MARK ORDER OF MAGNITUDE
1010 PSET (C.DIST, C.VF.RADIUS), VFCOLOR%     ' TRACE VF SIZE @ CURRENT
DISTANCE
     PSET (C.DIST, -C.VF.RADIUS), VFCOLOR%    ' TRACE VF SIZE @ CURRENT
DISTANCE
     PSET (C.DIST, R), OBJCOLOR%              ' TRACE OBJECT SIZE @ CURRENT
DISTANCE
     PSET (C.DIST, -R), OBJCOLOR%             ' TRACE OBJECT SIZE @ CURRENT
DISTANCE
1999 RETURN

2000 ' R=C.VF.RADIUS
===========================================================
     INVERSION% = -1
     FOR Y = -200 TO 200 STEP 5
        PSET (C.DIST, Y), 2
     NEXT
     RETURN
'e n d o f n o n c o n e . b a s -------------------------------------------


'b e g i n I C E D I T . B A S
---------------------------------------------------
50 GOSUB 4550
    CLS
100 PRINT : PRINT "FUNCTIONS:": PRINT
150 PRINT 1, ""
200 PRINT 2, "DISPLAY AN EXISTING IMAGE"
250 PRINT 3, "COPY AN EXISTING IMAGE"
300 PRINT 4, "EDIT AN EXISTING IMAGE"
350 PRINT 5, "CREATE A NEW IMAGE"
400 PRINT 6, "ERASE AN IMAGE"
450 PRINT 7, "OPEN A FILE"
500 PRINT 8, "INITIALIZE A FILE"
550 PRINT 9, "PRINT AN EXISTING IMAGE"
600 PRINT 10, "TERMINATE SESSION"
650 PRINT : PRINT : INPUT ">>>FUNCTION"; FUNC%
700 IF (FUNC% < 1) OR (FUNC% > 10) THEN PRINT "BAD FUNCTION NUMBER": GOTO 100
750 ON FUNC% GOSUB 850, 950, 1700, 2250, 3200, 4200, 4550, 5000, 5600, 6900
800 GOTO 100
850 PRINT : PRINT "NOT YET IMPLEMENTED"
900 RETURN
950 REM DISPLAY AN IMAGE ----------------------------- (26 DECEMBER,1983)
1000 INPUT ">>>ENTER IMAGE NUMBER (OR 99 TO CANCEL) ", IMAGE%: CLS
1050 IF IMAGE% = 99 THEN GOTO 1650
1100 IF (IMAGE% < 1) OR (IMAGE% > 100) THEN PRINT "BAD IMAGE NUMBER": GOTO 1000
ELSE GET #1, IMAGE%
1150 IF ASC(R1$) = 255 THEN PRINT "IMAGE MATRIX IS BLANK": GOTO 1000
1200 CLS
1250 PRINT USING "IMAGE NUMBER ###      12345"; IMAGE%: PRINT
1300 PRINT "                  1   "; R1$
1350 PRINT "                  2   "; R2$
1400 PRINT "                  3   "; R3$
1450 PRINT "                  4   "; R4$
1500 PRINT "                  5   "; R5$
1550 IF FUNC% = 4 THEN PRINT : GOTO 1650
1600 PRINT : GOTO 1000
1650 RETURN
1700 REM MAKE A COPY OF AN EXISTING IMAGE ------------- (26 DECEMBER, 1983)
1750 CLS : INPUT ">>>NUMBER OF THE IMAGE MATRIX TO BE COPIED TO (OR 99 TO
CANCEL)"; COPY%
1800 IF COPY% = 99 THEN GOTO 2200
1850 IF (COPY% < 1) OR (COPY% > 100) THEN PRINT "BAD IMAGE FIELD NUMBER": GOTO
1750 ELSE GET #1, COPY%
1900 IF ASC(R1$) <> 255 THEN PRINT "IMAGE MATRIX IS CURRENTLY FILLED": GOTO
1750
1950 PRINT : INPUT ">>>NUMBER OF IMAGE TO BE COPIED (OR 99 TO CANCEL)"; IMAGE%
2000 IF IMAGE% = 99 THEN GOTO 2200
2050 IF (IMAGE% < 1) OR (IMAGE% > 100) THEN PRINT "BAD IMAGE NUMBER": GOTO 1750
ELSE GET #1, IMAGE%
2100 IF ASC(R1$) = 255 THEN PRINT "IMAGE MATRIX IS BLANK": GOTO 1750 ELSE PUT
#1, COPY%
2150 PRINT : GOTO 1750
2200 RETURN
2250 REM EDIT AN EXISTING IMAGE ----------------------- (27 DECEMBER, 1983)
2300 CLS : PRINT "EDITING AN EXISTING IMAGE"
2350 GOSUB 950: REM DISPLAYS THE IMAGE
2400 IF IMAGE% = 99 THEN GOTO 3050
2450 INPUT ">>>ROW TO CHANGE (OR 99 TO CANCEL) "; R%
2500 IF R% = 99 THEN GOTO 3050
2550 IF (R% < 1) OR (R% > 5) THEN PRINT "BAD ROW NUMBER": GOTO 2450
2600 PRINT "    12345"
2650 PRINT USING "##"; R%; : INPUT ; ROW$
2700 IF R% = 1 THEN LSET R1$ = ROW$
2750 IF R% = 2 THEN LSET R2$ = ROW$
2800 IF R% = 3 THEN LSET R3$ = ROW$
2850 IF R% = 4 THEN LSET R4$ = ROW$
2900 IF R% = 5 THEN LSET R5$ = ROW$
2950 GOSUB 1200: REM DISPLAYS THE EDITED IMAGE
3000 PRINT : GOTO 2450
3050 INPUT ">>>SAVE THE ALTERED IMAGE "; A$
3100 IF A$ = "Y" THEN PUT #1, IMAGE%
3150 RETURN
3200 REM CREATE A NEW IMAGE --------------------------- (25 DECEMBER, 1983)
3250 CLS : PRINT "CREATING A NEW IMAGE": PRINT
3300 INPUT ">>>CREATING - ENTER IMAGE NUMBER (OR 99 TO CANCEL) ", IMAGE%
3350 IF IMAGE% = 99 THEN GOTO 4150
3400 IF (IMAGE% < 1) OR (IMAGE% > 100) THEN PRINT "BAD IMAGE NUMBER": GOTO 3300
ELSE GET #1, IMAGE%
3450 IF ASC(R1$) <> 255 THEN INPUT "OVERWRITE"; A$: IF A$ <> "Y" THEN GOTO 4150
3500 PRINT "                     12345   CREATING IMAGE"; IMAGE%
3550 INPUT "                  1"; ROW1$
3600 INPUT "                  2"; ROW2$
3650 INPUT "                  3"; ROW3$
3700 INPUT "                  4"; ROW4$
3750 INPUT "                  5"; ROW5$
3800 CLS
3850 PRINT , "12345 ------ DISPLAYING IMAGE NUMBER"; IMAGE%: PRINT
3900 ' PRINT 1, ROW1$: PRINT 2, ROW2$: PRINT 3, ROW3$: PRINT 4, ROW4$: PRINT 5,
ROW5$
     PRINT "           1  "; ROW1$
     PRINT "           2  "; ROW2$
     PRINT "           3  "; ROW3$
     PRINT "           4  "; ROW4$
     PRINT "           5  "; ROW5$
3950 PRINT : PRINT : INPUT "SAVE THE IMAGE (Y OR N) "; A$: IF A$ <> "Y" THEN
GOTO 3250
4000 LSET R1$ = ROW1$: LSET R2$ = ROW2$: LSET R3$ = ROW3$: LSET R4$ = ROW4$:
LSET R5$ = ROW5$
4050 PUT #1, IMAGE%
4100 GOTO 3250
4150 RETURN
4200 REM ERASE AN IMAGE ---------------------------- (26 DECEMBER, 1983)
4250 CLS : INPUT ">>>ARE YOU SURE YOU WANT TO ERASE AN IMAGE"; A$
4300 IF A$ <> "Y" THEN GOTO 4500
4350 PRINT : INPUT "NUMBER OF IMAGE TO BE ERASED"; IMAGE%
4400 LSET R1$ = CHR$(255)
4450 PUT #1, IMAGE%
4500 RETURN
4550 CLS : REM OPEN A FILE -------------------------------26 DECEMBER,1983
4700 FILE$ = "STIMULI1"
     FILENUM = FREEFILE
     IF FILENUM > 1 THEN
        CLOSE #1
        INPUT ">>>ENTER FILE NAME (OR 99 TO CANCEL)", FILE$: IF FILE$ = "99"
THEN GOTO 4950
        IF LEN(FILE$) > 8 THEN PRINT "FILE NAME CAN ONLY BE 8 CHARACTERS LONG":
GOTO 4550
     END IF
4750 FILE$ = FILE$ + ".DAT"
4800 OPEN "R", #1, FILE$, 50
4850 FIELD #1, 5 AS R1$, 5 AS R2$, 5 AS R3$, 5 AS R4$, 5 AS R5$, 25 AS R6$
4900 PRINT "FILE "; FILE$; " OPENED"
4950 RETURN
5000 REM INITIALIZE A FILE
5050 REM 25 DECEMBER, 1983 - HAPPY BIRTHDAY, BLESSED ONE!
5100 INPUT "ARE YOU SURE YOU WANT TO INITIALIZE A NEW FILE"; I$: IF I$ <> "Y"
THEN RETURN
5150 INPUT ">>> FILE NAME"; FILE$: IF LEN(FILE$) > 8 THEN PRINT "FILE NAME MUST
BE 8 CHARACTERS OR LESS": GOTO 5100
     FILENUM = FREEFILE
     IF FILENUM > 1 THEN CLOSE #1
5200 FILE$ = FILE$ + ".DAT"
5250 OPEN "R", #1, FILE$, 50
5300 FIELD #1, 5 AS R1$, 5 AS R2$, 5 AS R3$, 5 AS R4$, 5 AS R5$, 25 AS R6$
5350 LSET R1$ = CHR$(255)
5400 FOR I% = 1 TO 100
5450   PUT #1, I%
5500   NEXT I%
5550 RETURN
5600 CTR% = 1: REM OUTPUT A PRINTED IMAGE -------------------(26 DECEMBER,1983)
5650 CLS : PRINT "PRINTING AN EXISTING IMAGE": INPUT ">>>SELECT PRINTER NOW",
A$
5700 LPRINT CHR$(27); "Q"; CHR$(27); "B"; CHR$(27); "$": REM SELECTS 132 CPI
PRINTER
5750 INPUT ">>>ENTER IMAGE NUMBER (OR 99 TO CANCEL) ", IMAGE%
5800 IF IMAGE% = 99 THEN GOTO 6850
5850 IF (IMAGE% < 1) OR (IMAGE% > 100) THEN PRINT "BAD IMAGE NUMBER": GOTO 5750
ELSE GET #1, IMAGE%
5900 IF ASC(R1$) = 255 THEN PRINT USING "IMAGE ### IS BLANK"; IMAGE%: GOTO 5750
5950 IF CTR% = 1 THEN T% = 0
6000 IF CTR% = 2 THEN T% = 30
6050 IF CTR% = 3 THEN T% = 60
6100 IF CTR% = 4 THEN T% = 90
6150 LPRINT TAB(T%); "    12345 IMAGE"; IMAGE%: LPRINT
6200 LPRINT TAB(T%); " 1  "; R1$: LPRINT TAB(T%); " 2  "; R2$
6250 LPRINT TAB(T%); " 3  "; R3$: LPRINT TAB(T%); " 4  "; R4$
6300 LPRINT TAB(T%); " 5  "; R5$
6350 CLS : INPUT ">>>PRINT ANOTHER IMAGE? ", A$
6400 IF (CTR% > 3) AND (A$ = "Y") THEN LPRINT : LPRINT : LPRINT : CTR% = 1:
GOTO 5750
6450 IF (A$ = "Y") THEN GOSUB 6500: CTR% = CTR% + 1: GOTO 5750 ELSE GOTO 6850
6500 REM REVERSE LINE FEEDS THE PRINTER FOR THE OUTPUTTING OF THE NEXT IMAGE
6550 LPRINT CHR$(27); CHR$(114)
6600 FOR I% = 1 TO 7
6650   LPRINT
6700   NEXT I%
6750 LPRINT CHR$(27); CHR$(102)
6800 RETURN
6850 RETURN
6900 END
'E N D I C E D I T . B A S ---------------------------------------------------





More information about the Neur-sci mailing list

Send comments to us at biosci-help [At] net.bio.net