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:41:38 EST 1999


' b e g i n c r u d e I n f o C a l c B A S ------------------------------
DECLARE SUB DisplayITMFile ()
DECLARE SUB DisplayLTMFile ()
DECLARE SUB DispDer ()
DECLARE SUB ExhaustFirstDer ()
DECLARE SUB Vector ()
DECLARE SUB FirstDer ()
DECLARE SUB AnimateQuick ()
DECLARE SUB DisplayVector ()
DECLARE SUB AnimateVector ()
DECLARE SUB HistoQ ()
DECLARE SUB DisplayDer ()
DECLARE SUB SecDer ()
DECLARE SUB AnimateCol ()
DECLARE SUB HistogramSave ()
DECLARE SUB HistogramWipe ()
DECLARE SUB WriteMergedFile ()
DECLARE SUB MsgEnter ()
DECLARE SUB MsgLine (Msg$)
DECLARE SUB AddToSTM ()
DECLARE SUB AddMirror ()
DECLARE SUB AddDistortion ()
DECLARE SUB AddInvDistortion ()
DECLARE SUB WriteOutput ()
DECLARE SUB SortNewDerivs ()
DECLARE SUB SelectPrinter ()
DECLARE SUB Histogram ()
DECLARE SUB OpenFilesRead ()
DECLARE SUB AddressAlgor ()
DECLARE SUB SelectImage ()
DECLARE SUB PrintFirstDerivative ()
DECLARE SUB DisplayFirstDer ()
DECLARE SUB SetUp2 ()
DECLARE SUB SetUp ()
DECLARE SUB CapsOn ()

   ' $DYNAMIC ICY.BAS ALTERED VERSION OF IC.BAS - 15 OCT 93
    COMMON SHARED LUPE%, TABLE%, OFFSET%, IMG$, IMAGE%, IMAGSAV%, IMAGE$
    COMMON SHARED WATCH$, GTRACE$, TRACE$, NEWITM%, NEWITM$, LTMRECS%
    COMMON SHARED FAST%, SNORE%, DERPRT$, PEOJ$, CENTER%, FUNC%, V%

    DEFINT I-J: OPTION BASE 1
    DIM SHARED STM%(0 TO 8, 7, 7) ' Short-term DERIVATIVE SPACE
    DIM SHARED ITM%(30, 26) ' Intermediate-term  Derivative SPACE
    DIM SHARED LTM%(10, 26) ' Long-term Derivative SPACE

    SCREEN 12: COLOR 7: TABLE% = -1: OFFSET% = 3
    CapsOn
    SetUp
    OpenFilesRead
    IF FAST% < 1 THEN GOSUB FreSpc: ' QUERY FREE SPACE

Menu1: CLS : COLOR 7: PRINT : PRINT " INFOCALC FUNCTIONS:": PRINT
     PRINT "        1  calculate the 1st derivative for an existing image"
     PRINT "        2  query free space"
     PRINT "        3  turn image display and function trace on/off"
     PRINT "        4  "
     PRINT "        5  display an existing image"
     PRINT "        6  "
     PRINT "        7  "
     PRINT "        8  "
     PRINT "        9  select display menu"
     PRINT "       10  write output file"
     PRINT "       11  terminate session"
     PRINT : PRINT : INPUT ">>>Function"; FUNC%
     IF (FUNC% < 1) OR (FUNC% > 11) THEN PRINT "BAD FUNCTION NUMBER": GOTO
Menu1
     ON FUNC% GOSUB Calc, FreSpc, 1, NotImp, SlectImg, NotImp, NotImp, NotImp,
Menu2, WriOut, Quit
     GOTO Menu1

1    SetUp
     RETURN

Quit: END

NotImp: PRINT : PRINT "not yet implemented": IF SNORE% = 1 THEN SLEEP 1: RETURN

Calc: CLS

     SelectImage
     IF IMAGE% = 0 THEN RETURN

     FirstDer

     LOCATE 28, 1: COLOR 4
     LOCATE 28, 1: PRINT "                                                   "
     INPUT "2nd Derivative? (N) "; Branch$
     LOCATE 28, 1: PRINT "                                                   "
     COLOR 7
     SELECT CASE Branch$

        CASE "Y"
           SecDer
        CASE ELSE
           GOTO Calc

     END SELECT

Q2:  LOCATE 28, 1: COLOR 4
     INPUT "1 Redo 2nd Der 2 Vector Animation 3 Quick Col Repeat 4 Col
Animation  ", Branch$
     LOCATE 28, 1: PRINT "                                                     
                     "
     COLOR 7
     SELECT CASE Branch$

        CASE "1"
           SecDer
           GOTO Q2
        CASE "2"
           AnimateVector
           GOTO Q2
        CASE "3"
           AnimateQuick
           GOTO Q2
        CASE "4"
           AnimateCol
           GOTO Q2
        CASE ELSE
           GOTO Calc

     END SELECT

     RETURN

SlectImg: SelectImage: RETURN ' (26 DECEMBER,1983)

FreSpc: ' QUERY FREE SPACE
     PRINT : PRINT "number of free bytes "; FRE(0): SLEEP 1
     RETURN

6300 INPUT "ARE YOU SURE YOU WANT TO ERASE THE NEW Derivative FILE (N)"; An$
     IF An$ <> "Y" THEN RETURN
     ERASE ITM%: DIM ITM%(30, 26): NEWITM% = 0
     RETURN

Menu2: COLOR 4: CLS : PRINT : PRINT "DISPLAY/PRINT FUNCTIONS:": PRINT
    PRINT "        1  select INFOCALC menu"
    PRINT "        2  display a new/old Derivative"
    PRINT "        3  display the entire NEW Derivative file"
    PRINT "        4  display the entire OLD Derivative file"
    PRINT "        5  set display for eoj file write"
    PRINT "        6  sort new Derivative file"
    PRINT "        7  write new Derivative file to disk"
    PRINT "        8  select RUN-TIME menu"
    PRINT "        9  erase new Derivative file"
    PRINT "       10  terminate session"
    PRINT : PRINT : INPUT ">>>Function"; FUNC%
    IF (FUNC% < 1) OR (FUNC% > 10) THEN PRINT "bad function number": SLEEP 1:
GOTO Menu2
    ON FUNC% GOSUB Menu1, 2000, 2300, 2500, 100, 1700, NotImp, NotImp, 6300,
300
    GOTO Menu2

100 SetUp2: RETURN

300 IF TERMINATE$ = "Y" THEN END ELSE INPUT ">>> DO YOU REALLY WANT TO
TERMINATE WITHOUT FILE MAINTENANCE (Y OR N)"; An$
     IF An$ = "Y" THEN END ELSE RETURN

WriOut: WriteMergedFile
        RETURN
1700 SortNewDerivs
     RETURN
2000 DispDer
     RETURN
2300 DisplayITMFile
     RETURN
2500 DisplayLTMFile
     RETURN

SUB AddDistortion

SHARED STM%(), V%, IMAGE$, XOFF%, YOFF%, OFFSET%

   IF TRACE$ = "Y" THEN
      LOCATE 28, 1: PRINT "adding distortion                           "
      IF SNORE% = 1 THEN SLEEP 1
   END IF

   K% = OFFSET%
   FOR I% = 2 TO 6
      FOR J% = 2 TO 6
         WORK$ = MID$(IMAGE$, K% + 1, 1)
         IF WORK$ = "*" THEN
            STM%(V%, I% - XOFF%, J% - YOFF%) = STM%(V%, I% - XOFF%, J% - YOFF%)
+ 1
         END IF
         K% = K% + 1: IF K% = 25 THEN K% = 1
      NEXT J%
   NEXT I%

END SUB

REM $STATIC
SUB AddInvDistortion

SHARED STM%(), V%, IMAGE$, TRACE$, XOFF%, YOFF%, OFFSET%

   IF TRACE$ = "Y" THEN
      LOCATE 28, 1: PRINT "adding mirror distortion                          "
      IF SNORE% = 1 THEN SLEEP 1
   END IF

   K% = 25 - OFFSET%
   FOR I% = 2 TO 6
      FOR J% = 6 TO 2 STEP -1
         WORK$ = MID$(IMAGE$, K% + 1, 1)
         IF WORK$ = "*" THEN
            STM%(V%, I% + XOFF%, J% + YOFF%) = STM%(V%, I% + XOFF%, J% + YOFF%)
+ 1
         END IF
         K% = K% - 1: IF K% = 1 THEN K% = 25
      NEXT J%
   NEXT I%

END SUB

REM $DYNAMIC
SUB AddMirror

SHARED STM%(), V%, IMAGE$, TRACE$, XOFF%, YOFF%, OFFSET%

   IF TRACE$ = "Y" THEN
      LOCATE 28, 1: PRINT "adding mirror image                             "
      IF SNORE% = 1 THEN SLEEP 1
   END IF

   K% = 26
   FOR I% = 2 TO 6
      FOR J% = 2 TO 6
        WORK$ = MID$(IMAGE$, K% - 1, 1)
        IF WORK$ = "*" THEN
          STM%(V%, I% + XOFF%, J% + YOFF%) = STM%(V%, I% + XOFF%, J% + YOFF%) +
1
        END IF
        K% = K% - 1
      NEXT J%
   NEXT I%

END SUB

SUB AddressAlgor

 SHARED ITM%(), STM%(), V%, NEWITM%, ADDRESS%, PEOJ$, SNORE%, IMAGSAV%, TRACE$
 SHARED LTMRECS%, LFINITE$, IFINITE$, NEWITM$, FUNC%

      ' NEW Derivative HOLD ROUTINE 2 FEB 85

      IFINITE$ = "N": LFINITE$ = "N"
      IF TRACE$ = "Y" THEN
         LOCATE 16, 1: PRINT "addressing algorithm": IF SNORE% = 1 THEN SLEEP 1
      END IF

      IF NEWITM% > 0 THEN GOSUB 5200: ' ITM FINITIZATION CHECK
      IF IFINITE$ = "Y" THEN ADDRESS% = I%: GOTO 114
      GOSUB 5400: ' LTM FINITIZATION CHECK
      IF LFINITE$ = "Y" THEN ADDRESS% = I%: GOTO 114

      IF TRACE$ = "Y" THEN
         LOCATE 23, 1: PRINT "establishing new ITM": IF SNORE% = 1 THEN SLEEP 1
      END IF

      NEWITM% = NEWITM% + 1: ADDRESS% = NEWITM%

      IF FUNC% = 4 THEN GOTO ITM

      IF NEWITM% > 30 THEN
         COLOR 8
         LOCATE 27, 15
         PRINT "Zzzzzz  Zzzzzz  Zzzzzz...                ": COLOR 7
         WriteMergedFile
      END IF

      IF NEWITM% > 28 THEN
         COLOR 1: LOCATE 4, 75: PRINT "YAWN"
         LOCATE 17, 45: PRINT "Yawn"
         LOCATE 19, 65: PRINT "yawn"
         LOCATE 21, 70: PRINT "yawn": COLOR 7
      END IF
      IF NEWITM% > 29 THEN COLOR 3: LOCATE 27, 22: PRINT " I'm going to sleep!
(after this one)": COLOR 7


ITM:  ITM%(NEWITM%, 26) = IMAGSAV%: NEWITM$ = "Y": ' CREATE INTERMED TERM
Derivative
      LOCATE 24, 1
      K% = 1
      FOR I% = 2 TO 6
        FOR J% = 2 TO 6
          ITM%(NEWITM%, K%) = STM%(V%, I%, J%)
          IF PEOJ$ = "D" THEN PRINT ITM%(NEWITM%, K%);
          K% = K% + 1
        NEXT J%
      NEXT I%
      IF PEOJ$ = "D" THEN PRINT ITM%(NEWITM%, 26)
      GOTO 114

5200 ' ITM FINITIZATION CHECK
      IF TRACE$ = "Y" THEN LOCATE 17, 4: PRINT "ITM finitization check": IF
SNORE% = 1 THEN SLEEP 1
      MTCHCHK% = 0
      FOR I% = 1 TO NEWITM%
        IF STM%(V%, 2, 2) = ITM%(I%, 1) THEN GOSUB 5300: ' ITM MATCH CHECK
        IF IFINITE$ = "Y" THEN RETURN
      NEXT I%
      RETURN

5300 ' ITM MATCH CHECK
      MTCHCHK% = MTCHCHK% + 1
      IF TRACE$ = "Y" THEN LOCATE 18, 4: PRINT "ITM match check "; MTCHCHK%: IF
SNORE% = 1 THEN SLEEP 1
      K% = 1
      FOR P% = 2 TO 6
        FOR C% = 2 TO 6
          IF STM%(V%, P%, C%) <> ITM%(I%, K%) THEN RETURN
          K% = K% + 1
        NEXT C%
      NEXT P%
      IFINITE$ = "Y"
      RETURN

5400 ' LTM FINITIZATION CHECK
      IF TRACE$ = "Y" THEN LOCATE 19, 4: PRINT "LTM finitization check": IF
SNORE% = 1 THEN SLEEP 1
      MTCHCHK% = 0
      FOR I% = 1 TO LTMRECS%
        IF STM%(V%, 2, 2) = LTM%(I%, 1) THEN GOSUB 5500: ' LTM MATCH CHECK
        IF LFINITE$ = "Y" THEN RETURN
      NEXT I%
      RETURN

5500 ' LTM MATCH CHECK
      MTCHCHK% = MTCHCHK% + 1
      IF TRACE$ = "Y" THEN LOCATE 20, 4: PRINT "LTM match check "; MTCHCHK%: IF
SNORE% = 1 THEN SLEEP 1
      K% = 1
      FOR P% = 2 TO 6
        FOR C% = 2 TO 6
          IF STM%(V%, P%, C%) <> LTM%(I%, K%) THEN RETURN
          K% = K% + 1
        NEXT C%
      NEXT P%
      LFINITE$ = "Y"
      RETURN

114  IF IFINITE$ = "Y" THEN
        LOCATE 27, 1: PRINT "intermediate-term memory address ="; ADDRESS%
     ELSEIF LFINITE$ = "Y" THEN
        LOCATE 27, 1: PRINT "LONG-term memory address ="; ADDRESS%
     ELSE LOCATE 27, 1: PRINT "NEW intermediate-term memory address =";
ADDRESS%
     END IF

END SUB

SUB AddToSTM

SHARED STM%(), V%, IMAGE$, TRACE$, XOFF%, YOFF%, OFFSET%

   IF TRACE$ = "Y" THEN
      LOCATE 28, 1: PRINT "building working image"
      IF SNORE% = 1 THEN SLEEP 1
   END IF

   K% = 0
   FOR I% = 2 TO 6
      FOR J% = 2 TO 6
         WORK$ = MID$(IMAGE$, K% + 1, 1)
         IF WORK$ = "*" THEN
            STM%(V%, I% - XOFF%, J% - YOFF%) = STM%(V%, I% - XOFF%, J% - YOFF%)
+ 1
         END IF
         K% = K% + 1
      NEXT J%
   NEXT I%

END SUB

SUB AnimateCol

SHARED CENTER%, LUPE%, STM%(), V%

FOR J% = 1 TO LUPE%
  IF CENTER% = 1 THEN IMG$ = "0": V% = 0: GOSUB 7500: DisplayVector
  IMG$ = "1": V% = 1: GOSUB 7500: DisplayVector
  IF CENTER% = 1 THEN IMG$ = "0": V% = 0: GOSUB 7500: DisplayVector
  IMG$ = "2": V% = 2: GOSUB 7500: DisplayVector
  IF CENTER% = 1 THEN IMG$ = "0": V% = 0: GOSUB 7500: DisplayVector
  IMG$ = "3": V% = 3: GOSUB 7500: DisplayVector
  IF CENTER% = 1 THEN IMG$ = "0": V% = 0: GOSUB 7500: DisplayVector
  IMG$ = "4": V% = 4: GOSUB 7500: DisplayVector
  IF CENTER% = 1 THEN IMG$ = "0": V% = 0: GOSUB 7500: DisplayVector
  IMG$ = "5": V% = 5: GOSUB 7500: DisplayVector
  IF CENTER% = 1 THEN IMG$ = "0": V% = 0: GOSUB 7500: DisplayVector
  IMG$ = "6": V% = 6: GOSUB 7500: DisplayVector
  IF CENTER% = 1 THEN IMG$ = "0": V% = 0: GOSUB 7500: DisplayVector
  IMG$ = "7": V% = 7: GOSUB 7500: DisplayVector
  IF CENTER% = 1 THEN IMG$ = "0": V% = 0: GOSUB 7500: DisplayVector
  IMG$ = "8": V% = 8: GOSUB 7500: DisplayVector
NEXT

EXIT SUB

7500  HistogramWipe

  REDIM ISAVE(14000)
  DEF SEG = VARSEG(ISAVE(1))
  BLOAD "E:ISAVE" + IMG$ + ".MEM", VARPTR(ISAVE(1))
  DEF SEG
  PUT (250, 20), ISAVE
  RETURN

END SUB

SUB AnimateQuick

SHARED LUPE%, STM%()

LOCATE 3, 50: PRINT "                            "
LOCATE 4, 50: PRINT "                            "
LOCATE 5, 50: PRINT "                            "
LOCATE 6, 50: PRINT "                            "
LOCATE 7, 50: PRINT "                            "
LOCATE 8, 50: PRINT "                            "
LOCATE 9, 50: PRINT "                            "
LOCATE 10, 50: PRINT "                            "
LOCATE 11, 50: PRINT "                            "

FOR J% = 1 TO LUPE%
  IMG$ = "1": V% = 1: GOSUB HistW
  IMG$ = "2": V% = 2: GOSUB HistW
  IMG$ = "3": V% = 3: GOSUB HistW
  IMG$ = "4": V% = 4: GOSUB HistW
  IMG$ = "5": V% = 5: GOSUB HistW
  IMG$ = "6": V% = 6: GOSUB HistW
  IMG$ = "7": V% = 7: GOSUB HistW
  IMG$ = "8": V% = 8: GOSUB HistW
NEXT

EXIT SUB

HistW: HistogramWipe

  REDIM ISAVE(14000)
  DEF SEG = VARSEG(ISAVE(1))
  BLOAD "E:ISAVE" + IMG$ + ".MEM", VARPTR(ISAVE(1))
  DEF SEG
  PUT (250, 20), ISAVE
  RETURN

END SUB

SUB AnimateVector

SHARED STM%()

     K% = 27: P% = 39
QV:  COLOR 4
     LOCATE 26, 38: PRINT "187"
     LOCATE 27, 38: PRINT "2 6"
     LOCATE 28, 38: PRINT "345"
     COLOR 3

     LOCATE 28, 1: INPUT ">>> Select a motion vector 1 - 8 ", V%
     LOCATE 28, 1: PRINT "                                                     
 "
     SNORE% = 0

     SELECT CASE V%

        CASE 1
           IMG$ = "1": I% = 26: J% = 38
        CASE 2
           IMG$ = "2": I% = 27: J% = 38
        CASE 3
           IMG$ = "3": I% = 28: J% = 38
        CASE 4
           IMG$ = "4": I% = 28: J% = 39
        CASE 5
           IMG$ = "5": I% = 28: J% = 40
        CASE 6
           IMG$ = "6": I% = 27: J% = 40
        CASE 7
           IMG$ = "7": I% = 26: J% = 40
        CASE 8
           IMG$ = "8": I% = 26: J% = 39
        CASE ELSE
           CENTER% = 0
           LOCATE 26, 38: PRINT "   "
           LOCATE 27, 38: PRINT "   "
           LOCATE 28, 38: PRINT "   "
           EXIT SUB

     END SELECT

     LOCATE 26, 38: PRINT "ÛÛÛ"
     LOCATE 27, 38: PRINT "ÛÛÛ" ' 
     LOCATE 28, 38: PRINT "ÛÛÛ"

VLoop: CENTER% = 1
   LOCATE 28, 1: PRINT "Press any key to end animation"
   IMGHOLD$ = IMG$: VECHOLD% = V%
   DO WHILE INKEY$ = ""
      DisplayVector
      LOCATE I%, J%: COLOR 4: PRINT "Û": LOCATE K%, P%: COLOR 3: PRINT "Û"
      SWAP I%, K%: SWAP J%, P%
      GOSUB WipeV
      IMG$ = "0": V% = 0
      DisplayVector
      LOCATE I%, J%: COLOR 4: PRINT "Û": LOCATE K%, P%: COLOR 3: PRINT "Û"
      SWAP I%, K%: SWAP J%, P%
      GOSUB WipeV
      IMG$ = IMGHOLD$: V% = VECHOLD%
   LOOP

   GOTO QV

WipeV: HistogramWipe

  REDIM ISAVE(14000)
  DEF SEG = VARSEG(ISAVE(1))
  BLOAD "E:ISAVE" + IMG$ + ".MEM", VARPTR(ISAVE(1))
  DEF SEG
  PUT (250, 20), ISAVE
  RETURN

END SUB

SUB CapsOn STATIC

    DEF SEG = 0
    POKE &H417, PEEK(&H417) OR &H40 ' Set Caps Lock on (turn on bit 6 of
&H0417)
    DEF SEG

END SUB

SUB DispDer

SHARED NEWITM%, LTMRECS%, LTM%()

2100 PRINT ">>>display new/old? (DN/DO)"
     F$ = INPUT$(2)
     IF F$ <> "DN" AND F$ <> "DO" THEN GOTO 2100

2200 PRINT : INPUT ">>>enter Derivative recnum (0 to cancel) ", I%
     IF I% = 0 THEN EXIT SUB
     IF (F$ = "DN") AND (I% > NEWITM% OR I% < 1) THEN PRINT "bad recnum - <";
NEWITM%: GOTO 2200
     IF (F$ = "DO") AND (I% > LTMRECS% OR I% < 1) THEN PRINT "bad recnum - <";
LTMRECS%: GOTO 2200
     FOR C% = 1 TO 25
        IF F$ = "DN" THEN PRINT ITM%(I%, C%);
        IF F$ = "DO" THEN PRINT LTM%(I%, C%);
     NEXT C%
     PRINT : GOTO 2200

END SUB

SUB DisplayDer

SHARED IMAGSAV%, PCENT!, STM%(), WATCH$

'   IF WATCH$ = "Y" THEN HistoQ

   PCENT! = PCENT! + 2.777778
   LOCATE 1, 1: PRINT "  2nd derivative image "; IMAGSAV%; " ------ ";
   PRINT FIX(PCENT!); "% complete  ": ' PRINT

   LOCATE 3, 50
   PRINT "  1  2  3  4  5  6  7": PRINT

   FOR I% = 1 TO 7
     LOCATE 4 + I%, 50
     FOR J% = 1 TO 7
       PRINT USING " ##"; STM%(V%, I%, J%);
       IF J% = 7 THEN PRINT USING "     ## "; I%
     NEXT J%
   NEXT I%

END SUB

SUB DisplayFirstDer

SHARED STM%(), WATCH$, IMAGSAV%, PCENT!

'   IF WATCH$ = "Y" THEN HistoQ

   PCENT! = PCENT! + 25
   LOCATE 1, 1: PRINT "  1st derivative image "; IMAGSAV%; " ------ "; PCENT!;
"% complete  ": PRINT
   PRINT "  1  2  3  4  5  6  7": PRINT
   FOR I% = 1 TO 7
     FOR J% = 1 TO 7
       PRINT USING " ##"; STM%(V%, I%, J%);
       IF J% = 7 THEN PRINT USING "     ## "; I%
     NEXT J%
   NEXT I%

END SUB

SUB DisplayITMFile

SHARED NEWITM%, ITM%()

2400 FOR I% = 1 TO NEWITM%
       FOR J% = 1 TO 25
         PRINT ITM%(I%, J%);
       NEXT J%
       PRINT
     NEXT I%
     PRINT : INPUT ; An$

END SUB

SUB DisplayLTMFile

SHARED LTM%(), LTMRECS%

2600 FOR I% = 1 TO LTMRECS%
       FOR J% = 1 TO 25
         PRINT LTM%(I%, J%);
       NEXT J%
       PRINT
     NEXT I%
     PRINT ; : INPUT ; An$

END SUB

SUB DisplayVector

SHARED V%, STM%()

   LOCATE 3, 50
   PRINT "  1  2  3  4  5  6  7": PRINT
   FOR I% = 1 TO 7
     LOCATE 4 + I%, 50
     FOR J% = 1 TO 7
       PRINT USING " ##"; STM%(V%, I%, J%);
       IF J% = 7 THEN PRINT USING "     ## "; I%
     NEXT J%
   NEXT I%

END SUB

REM $STATIC
SUB FirstDer

SHARED IMG$, XOFF%, YOFF%, OFFSET%, PCENT!, STM%(), V%, WATCH$

     PCENT! = 0
     ERASE STM%: DIM STM%(0 TO 8, 7, 7)
     CLS
     IMG$ = "0": V% = 0: XOFF% = 0: YOFF% = 0

     AddToSTM
        IF WATCH$ = "Y" THEN HistoQ:  DisplayFirstDer

     AddMirror
        IF WATCH$ = "Y" THEN HistoQ:  DisplayFirstDer

     AddDistortion
        IF WATCH$ = "Y" THEN HistoQ:  DisplayFirstDer

     AddInvDistortion
        IF WATCH$ = "Y" THEN MsgEnter: Histogram: DisplayFirstDer ELSE
Histogram

     AddressAlgor

END SUB

REM $DYNAMIC
SUB Histogram

SHARED STM%(), V%, IMG$, FAST%, SNORE%, PCENT!

      ' CLS ' 3-D HISTOGRAM (ROUTINE COPIED FROM GRAPHICS TEXT) =============

      '  PLOT PARAMETERS -------------------------------
      XX1 = 6: XX2 = 8: YY = -6: MX = 4: XPO = 300: YPO = 250: ZPO = 0
      ICHECK = 1: XB = 1: YB = 1: XA = 7: YA = 7: XM = 7: YM = 7
      REDIM SA(XM, YM)
      GOSUB Hist1 ' INPUT DATA
      HistogramWipe
      GOSUB Hist2 ' DRAW BASE BOARD
      GOSUB Hist3 ' PRINT TITLES AND SCALE Z AXIS
      GOSUB Hist4 ' COMPUTE THE SCALES OF THE 3-D BAR
      HistogramSave
      EXIT SUB

Hist1: ' INPUT DATA -------------------------------------
       FOR I = 1 TO XM
          FOR J = 1 TO YM
             SA(I, J) = STM%(V%, I, J)
          NEXT: NEXT
       RETURN

Hist2: ' DRAW THE BASE BOARD ---------------------------------------------
       FOR J = 1 TO 2
          Y1% = YPO: X1% = XPO
          IF J = 1 THEN Y2% = YPO + YY * YM ELSE Y2% = YPO + YY * XM
          IF J = 1 THEN X2% = XPO + XX2 * YM ELSE X2% = XPO - XX1 * XM
          LINE (X1%, Y1%)-(X2%, Y2%)
          IF J = 1 THEN A = XM: B = 1: C = -1 ELSE A = 1: B = YM: C = 1
          FOR I = A TO B STEP C
             IF J = 1 THEN X1% = X1% - XX1: X2% = X2% - XX1 ELSE X1% = X1% +
XX2: X2% = X2% + XX2
             Y1% = Y1% + YY: Y2% = Y2% + YY
             LINE (X1%, Y1%)-(X2%, Y2%)
          NEXT
       NEXT
       LOCATE 16, 34: PRINT IMG$
       RETURN


Hist3: ' PRINT TITLES AND SCALE Z AXIS ------------------------------------
       IF ICHECK = 1 THEN ZPO = Y2% - 10
       Z1 = 5: Z2 = ZPO / 4: MZ = MX / 4
       X1% = X2% - XX2 * YM: Y1% = Y2% - YY * YM
       LINE (X1%, Y1%)-(X1%, Y1% - ZPO)
       FOR I = 1 TO 4
          Y1% = Y1% - Z2
          LINE (X1%, Y1%)-(X1% - Z1, Y1%)
          LOCATE Y1% / 8 + 1, (X1% - Z1) / 8 - 9
       NEXT
       RETURN

Hist4:  ' COMPUTE THE SCALES OF THE 3-D BAR ----------------------------------
       A2% = X2%: B2% = Y2%
       FOR I = YM TO 1 STEP -1
          A2% = A2% - XX2: B2% = B2% - YY
          X3% = A2%: Y3% = B2%
          FOR J = 1 TO XM
             X2% = X3%: Y2% = Y3%
             X3% = X2% + XX1: Y3% = Y2% - YY
             X4% = X3% + XX2: Y4% = Y2%
             X1% = X4% - XX1: Y1% = Y2% + YY
             IF SA(J, I) = 0 THEN GOTO HIST5
             IF I > YA OR I < YB THEN GOTO HIST5
             IF J > XA OR J < XB THEN GOTO HIST5
             Z% = (SA(J, I) / MX) * ZPO
             IF SA(J, I) = 1 THEN ATTRIB% = 11
             IF SA(J, I) = 2 THEN ATTRIB% = 13
             IF SA(J, I) = 3 THEN ATTRIB% = 14
             IF SA(J, I) = 4 THEN ATTRIB% = 12
             GOSUB Hist6 ' PLOT THE 3-D BAR
HIST5:    NEXT
       NEXT
      RETURN

Hist6: ' PLOT THE 3-D BAR -----------------------------------------------------
       IF GTRACE$ = "Y" THEN IF SNORE% = 1 THEN SLEEP 1
       An$ = INKEY$: IF LEN(Ans$) = 0 THEN GOTO Hist7
       IF An$ = "P" THEN LOCATE 1, 1: INPUT "", An$

Hist7: FOR K = X2% TO X4%
         IF K <= X1% THEN K1% = (K - X2%) * YY / XX2 ELSE K1% = (X4% - K) * YY
/ XX1
         LINE (K, Y2% - Z%)-(K, Y2% - Z% + K1%), 0
       NEXT
       LINE (X2%, Y2%)-(X4%, Y4% - Z%), 0, BF
       LINE (X3%, Y3%)-(X3%, Y3% + YY + YY), 0
       LINE (X2%, Y2%)-(X3%, Y3%), ATTRIB%
       LINE -(X4%, Y4%), ATTRIB%
       LINE -(X4%, Y4% - Z%), ATTRIB%
       LINE -(X1%, Y1% - Z%), ATTRIB%
       LINE -(X2%, Y2% - Z%), ATTRIB%
       LINE -(X3%, Y3% - Z%), ATTRIB%
       LINE -(X4%, Y4% - Z%), ATTRIB%
       LINE (X2%, Y2%)-(X2%, Y2% - Z%), ATTRIB%
       LINE (X3%, Y3%)-(X3%, Y3% - Z%), ATTRIB%
       RETURN

END SUB

SUB HistogramSave

SHARED IMG$

7000  LOCATE 16, 34: PRINT IMG$
      ' LOCATE 1, 1: INPUT "X "; XX: LOCATE 1, 1: INPUT "Y "; YY
      ' IF XX = 0 THEN GOTO 7100
      ' PSET (XX, YY): GOTO 7000

      REDIM ISAVE(14000)
      GET (250, 20)-(360, 255), ISAVE
      DEF SEG = VARSEG(ISAVE(1))
      BSAVE "E:ISAVE" + IMG$ + ".MEM", VARPTR(ISAVE(1)), 14000
      DEF SEG
      ERASE ISAVE

      EXIT SUB

END SUB

REM $STATIC
SUB HistogramWipe

      LOCATE 16, 34: PRINT IMG$
      REDIM ISAVE(14000)
      GET (250, 20)-(360, 255), ISAVE
      DEF SEG = VARSEG(ISAVE(1))
      BSAVE "E:W.IPE", VARPTR(ISAVE(1)), 14000
      DEF SEG
      ERASE ISAVE
      REDIM ISAVE(14000)
      DEF SEG = VARSEG(ISAVE(1))
      BLOAD "E:W.IPE", VARPTR(ISAVE(1))
      DEF SEG
      PUT (250, 20), ISAVE

END SUB

REM $DYNAMIC
SUB HistoQ

SHARED PCENT!, GTRACE$

   IF GTRACE$ = "Y" THEN Histogram: EXIT SUB

   IF PCENT! <= 100 THEN
      COLOR 4
      LOCATE 28, 1: PRINT "view developing histogram? (Y)";
      HistAn$ = INPUT$(1)
      COLOR 7
      LOCATE 28, 1: PRINT "                              "
   END IF

   IF HistAn$ = "Y" THEN Histogram

END SUB

SUB MsgEnter

LOCATE 28, 1
PRINT "                                                                     "
COLOR 4: LOCATE 28, 1: PRINT "<Enter>": An$ = INPUT$(1): COLOR 7
LOCATE 28, 1: PRINT "       "

END SUB

SUB MsgLine (Msg$)

LOCATE 28, 1: PRINT Msg$: SLEEP 1
LOCATE 28, 1
PRINT "                                                                     "

END SUB

SUB OpenFilesRead

SHARED LTM%(), LTMRECS%, FAST%, SNORE%, An$

     IF An$ = "1" THEN GOTO O1
1400 ' 29 JAN 85
     CLS : PRINT "------------------------- ADDRESSING EXPERIMENT 3.0
-------------------------": PRINT

     INPUT ">>> Enter version of STIMULI file to be used as input (1) ", An$
     IF An$ = "" THEN An$ = "1"
     IF An$ < "1" OR An$ > "99" THEN PRINT "bad version number": GOTO 1400

O1:  File$ = "STIMULI" + An$ + ".DAT"
     OPEN "R", #1, File$, 50
     FIELD #1, 25 AS IMAGE$, 25 AS QUALITIES$
     PRINT : PRINT "        file STIMULI" + An$ + ".DAT opened": PRINT

     IF An$ = "1" THEN GOTO O2
1500 INPUT ">>> Enter version of OLD Derivative file to be used as input (1) ",
An$
     IF An$ = "RAVEN" GOTO 1600
     IF An$ = "" THEN An$ = "1"
     IF An$ < "1" OR An$ > "99" THEN PRINT "bad version number": GOTO 1500

O2:  File$ = "ENGRAM" + An$ + ".DAT"
     OPEN "I", #2, File$
     PRINT : PRINT "        file ENGRAM"; An$; ".DAT opened"
     INPUT #2, LTMRECS%: PRINT "       "; LTMRECS%; "records"

     ERASE LTM%: DIM LTM%(LTMRECS%, 26)

     FOR I% = 1 TO LTMRECS%
       IF EOF(2) THEN PRINT "rec count out of sync... recreate file and
restart": END
         FOR J% = 1 TO 26
            INPUT #2, LTM%(I%, J%)
         NEXT J%
     NEXT I%

     CLOSE #2


1600 EXIT SUB

END SUB

SUB SecDer

SHARED IMG$, XOFF%, YOFF%, OFFSET%, PCENT!, STM%(), WORK$, WATCH$, V%

     CLS : COLOR 3: PCENT! = 12
     FOR V% = 1 TO 8: FOR I% = 1 TO 7: FOR J% = 1 TO 7
        STM%(V%, I%, J%) = 0
     NEXT: NEXT: NEXT

     IMG$ = "1": V% = 1: XOFF% = -1: YOFF% = -1: GOSUB 3400
     IMG$ = "2": V% = 2: XOFF% = 0: YOFF% = -1: GOSUB 3400
     IMG$ = "3": V% = 3: XOFF% = 1: YOFF% = -1: GOSUB 3400
     IMG$ = "4": V% = 4: XOFF% = 1: YOFF% = 0: GOSUB 3400
     IMG$ = "5": V% = 5: XOFF% = 1: YOFF% = 1: GOSUB 3400
     IMG$ = "6": V% = 6: XOFF% = 0: YOFF% = 1: GOSUB 3400
     IMG$ = "7": V% = 7: XOFF% = -1: YOFF% = 1: GOSUB 3400
     IMG$ = "8": V% = 8: XOFF% = -1: YOFF% = 0: GOSUB 3400

     IF WATCH$ = "Y" THEN AnimateCol ELSE AnimateQuick
     EXIT SUB

3400 AddToSTM
                IF WATCH$ = "Y" THEN HistoQ: DisplayDer
     AddMirror
                IF WATCH$ = "Y" THEN HistoQ: DisplayDer
     AddDistortion
                IF WATCH$ = "Y" THEN HistoQ: DisplayDer
     AddInvDistortion
                IF WATCH$ = "Y" THEN MsgEnter: Histogram: DisplayDer ELSE
Histogram

     RETURN

END SUB

SUB SelectImage

SHARED IMAGE$, IMAGE%, IMAGSAV%, FUNC%, WATCH$, PCENT!

     PCENT! = 0
3600 IF FUNC% = 5 OR WATCH$ = "Y" THEN CLS

     LOCATE 1, 1: INPUT ">>> enter image number (1 - 100) ", IMAGE%
     IF IMAGE% = 0 THEN EXIT SUB
     IMAGSAV% = IMAGE%
     IF (IMAGE% < 1) OR (IMAGE% > 100) THEN
        MsgLine "bad image number"
        GOTO 3600
        ELSE GET #1, IMAGE%
     END IF

     IF ASC(IMAGE$) = 255 THEN MsgLine "image matrix is blank": GOTO 3600

     LOCATE 1, 1: PRINT "                                           "
     LOCATE 1, 1
     PRINT "stimulus image"; IMAGSAV%: PRINT
     PRINT "   12345": PRINT
     PRINT " 1 "; MID$(IMAGE$, 1, 5)
     PRINT " 2 "; MID$(IMAGE$, 6, 5)
     PRINT " 3 "; MID$(IMAGE$, 11, 5)
     PRINT " 4 "; MID$(IMAGE$, 16, 5)
     PRINT " 5 "; MID$(IMAGE$, 21, 5)

     MsgEnter
     IF FUNC% = 5 THEN CLS : GOTO 3600

END SUB

SUB SetUp

    SHARED An$, WATCH$, GTRACE$, TRACE$, PEOJ$
    SHARED FAST%, SNORE%, DERPRT$, CENTER%, FUNC%, LUPE%
    SHARED COLOR0%, COLOR1%, COLOR2

    COLOR0% = 7: COLOR1% = 5: COLOR2% = 3

    CLS
     CLS : PRINT "------------------------- ADDRESSING EXPERIMENT 3.0
-------------------------": PRINT
    LOCATE 3, 30
    COLOR COLOR1%: PRINT "D"; : COLOR COLOR0%: PRINT "efault/";
    COLOR COLOR2%: PRINT "O"; : COLOR COLOR0%: PRINT "ption"

    LOCATE 5, 29: COLOR COLOR1%: PRINT "A"; : COLOR COLOR0%
    PRINT "ccept defaults ("; : COLOR COLOR2%: PRINT "N";
    COLOR COLOR0%: PRINT ") ": An$ = INPUT$(1)

    IF An$ <> "N" THEN
        An$ = "1": SNORE% = 0: LUPE% = 3: WATCH$ = "Y": TRACE$ = "Y"
        FAST% = 0: PEOJ$ = "D": GTRACE$ = "": CENTER% = 0
        EXIT SUB
    END IF

    COLOR COLOR2%: PRINT "F"; : COLOR COLOR0%: PRINT "ast or";
    COLOR COLOR1%: PRINT "S"; : COLOR COLOR0%: PRINT "low execution? "

    An$ = INPUT$(1)
    IF An$ <> "F" THEN
       FAST% = 0
    ELSE WATCH$ = "": TRACE$ = "": GTRACE$ = "": SNORE% = 0: LUPE% = 1: FAST% =
1: EXIT SUB
    END IF

    PRINT ">>>Do you want to WATCH the procedings? ("; : COLOR COLOR1%
    PRINT "Y"; : COLOR COLOR0%: PRINT "/"; : COLOR COLOR2%
    PRINT "N"; : COLOR COLOR0%: PRINT ")"

    WATCH$ = INPUT$(1)
    IF WATCH$ <> "N" THEN WATCH$ = "Y"

    PRINT ">>>Do you want program functions to be TRACED? (";
    COLOR COLOR1%: PRINT "Y"; : COLOR COLOR0%: PRINT "/";
    COLOR COLOR2%: PRINT "N"; : COLOR COLOR0%: PRINT ")"

    TRACE$ = INPUT$(1)
    IF TRACE$ <> "N" THEN TRACE$ = "Y"

       IF TRACE$ = "Y" THEN
       COLOR COLOR1%: PRINT "   F"; : COLOR COLOR0%: PRINT "ast or";
       COLOR COLOR2%: PRINT "S"; : COLOR COLOR0%: PRINT "low trace? "

       An$ = INPUT$(1)
       IF An$ <> "S" THEN SNORE% = 0 ELSE SNORE% = 1
       SetUp2
       END IF

     ' PRINT ">>>Do you want snapshot prints of the 1st derivative? (N)":
DERPRT$ = INPUT$(1)
     '   IF DERPRT$ = "Y" THEN INPUT ">>>select printer<<<", An$

     PRINT ">>>Do you want GRAPH output to be PAUSED? (N)": GTRACE$ = INPUT$(1)
     IF GTRACE$ = "Y" THEN
        LUPE% = 1: CENTER% = 0
     ELSE
        INPUT ">>>Turn on CENTER IMAGE in histogram animation (N)"; An$
        IF An$ = "Y" THEN CENTER% = 1 ELSE CENTER% = 0
        PRINT ">>>Number of LOOPS during animation (";
        IF CENTER% = 1 THEN PRINT "1)";  ELSE PRINT "3)";
        INPUT " "; LUPE%: IF LUPE% = 0 THEN IF CENTER% = 1 THEN LUPE% = 1 ELSE
LUPE% = 3
     END IF

END SUB

SUB SetUp2

SHARED PEOJ$

PRINT "   Do you want an EOJ file ";
COLOR 3: PRINT "D";
COLOR 7: PRINT "isplay";
COLOR 7: PRINT " (";
COLOR 5: PRINT "D";
COLOR 7: PRINT "/N)";

PEOJ$ = INPUT$(1)
IF PEOJ$ <> "N" THEN PEOJ$ = "D"

END SUB

REM $STATIC
SUB SleepMsg

   IF (FAST% <> 1 AND SNORE% = 1) THEN
      COLOR 4: LOCATE 28, 1
      PRINT "Hit any key to continue "
      COLOR 3

      SLEEP
      END IF

END SUB

REM $DYNAMIC
SUB SortNewDerivs

SHARED ITM%(), NEWITM%, NEWITM$, Dups%, TRACE$

     ' DESCENDING ORDER (LARGEST=1ST OCCURRENCE)
     NEWITM$ = "N": Dups% = 0
     FOR I% = 1 TO NEWITM% - 1
       IF TRACE$ = "Y" THEN LOCATE 27, 1: PRINT "sorting NEW Derivative
file..."; I%: IF SNORE% = 1 THEN SLEEP 1
       FOR K% = 1 TO NEWITM% - I%
         T% = 0: Dups% = 1
         FOR J% = 25 TO 1 STEP -1
     




More information about the Neur-sci mailing list