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
Send comments to us at biosci-help [At] net.bio.net
