Dos makes the 400th post, and that's all he has to say?

Well, If you live in a place like Europe, then, speaking more than one language is important.

Oui, je parle le francias, un peu. Mais je suis tres mal. Je suis le grande macareau!
 
-bZj

up
 
------------------
"Being married to a programmer is like owning a cat. You talk to it but you're never really sure it hears you, much less comprehends what you say." -DeadCats, 1999

vous parlez français? Trés bien. Mon français c'est pas bon, pas que je havait etudiez seulemnt trois annes au lycée.
 
Une question pour les francophones: pour quou est-ce que vous avez "^"???????
 
I must learn more french. I almost forgot everything!!!

oui oui
c'est vrai

still going huh? http://www.ntcompatible.com/ubb/Forum1/HTML/001499.html

Nous avons le "^" juste pour rendre la vie plus compliquée à ceux qui veulent apprendre le Français.
C'est un privilège de parler cette langue. Cela se mérite monseigneur...

why not try the 6.47 drivers?

We need another pointless topic to lit up this thread again..so...lets talk about this:
 
WHY IS THE USA THE ONLY PLACE IN THE WORLD THAT DOESN'T WEIGHT IN KILOS, MEASURES DISTANCES IN METRES, AND TEMPEREATURES IN CELSIUS DEGREES?

We have enough trouble counting ballots. Stop trying to make things more confusing.

I do agree someone_nt, but at least Americans drive on the right side of the road.
What about the Brits?
 
Don't worry about the ballot in the US, OLEerror. They are all old sl*ts down in south Florida. No balls down there...
I travelled alot in the US, Texas rulz!

Ahhh, I must make a statement here....
 
Yes, Americans drive on the right side of the road...
 
Being British, we drive on the correct side of the road...!
 
(BTW, my g/f is American and will probably slap me for saying that!)
 
evil Homer

Movin' on up.

Windows 2000 suxs! DOS FOREVEEEEEEEEEERRRRRRRR!!!!!!

I just wanted to add that the UK now weights also in kilos (But it took them a long time to introduce them).
 
But still don't use the right currency...the EURO!!!!!!!!
 
ha ha ha, just joking. Join it when you want to!

AHHHHHHHHHHHH!!!
 
 
have to keep the post alive..
no one said anything for 2 days

don't mind this crap, i'm just putting it here to flood the post.
 
'$DYNAMIC
DEFINT A-Z
DECLARE SUB InitSprites ()
DECLARE SUB battle ()
DECLARE SUB astatus ()
DECLARE SUB statusbox ()
DECLARE SUB Crystal ()
DECLARE SUB ShowBox ()
DECLARE SUB TownBox ()
DECLARE SUB Story ()
DECLARE SUB LoadCastleTunlan ()
DECLARE SUB LoadTunlan ()
DECLARE SUB talktoman ()
DECLARE SUB LoopMIDI ()
DECLARE SUB LoadMIDI (Filename$)
DECLARE SUB PlayMIDI ()
DECLARE SUB StopMIDI ()
DECLARE FUNCTION int86qb$ (intnr%, flag%, AX%, BX%, CX%, DX%, DI%, SI%, BP%, DS%, ES%)
DECLARE FUNCTION int2str$ (sword%)
DECLARE SUB LoadFont ()
DECLARE SUB IntX (IntNum AS INTEGER, Regs AS ANY)
DECLARE SUB InternalGetIntVector (IntNum%, Segment&, Offset&)
DECLARE SUB SetCard (CardType%)
DECLARE SUB DetectSettings (BasePort%, IRQ%, LoDMA%, HiDMA%, CardType%, MPU401%)
DECLARE SUB DriversLoaded (SBMIDI%, SBSIM%)
DECLARE SUB InitVars ()
DECLARE SUB LoadMap ()
DECLARE SUB LoadTiles ()
DECLARE SUB MoveUp ()
DECLARE SUB MoveDown ()
DECLARE SUB MoveLeft ()
DECLARE SUB MoveRight ()
DECLARE SUB PutPlayerPic ()
DECLARE SUB PutTile (x%, y%, tilenumber%)
DECLARE SUB SetupPalette ()
DECLARE SUB ShowMap ()
DECLARE SUB LoadData ()
DECLARE SUB Delay2 (Secs%)
DECLARE SUB DialogBox ()
DECLARE SUB PutText (PosX%, PosY%, Sentence$)
DECLARE SUB GetHandLocation ()
DECLARE SUB TimerDelay (Seconds!)
DECLARE SUB StatsBox ()
DECLARE SUB ChoiceBox (BoxType%)
DECLARE SUB DrawBattleScreen (ScreenType%)
DECLARE SUB InitBattle ()
DECLARE SUB InitRandomStats ()
DECLARE SUB LoadKaipo ()
DECLARE SUB LoadTowerBabel ()
DECLARE SUB LoadWateryCastle ()
TYPE WorldDataType
Rows AS INTEGER
Cols AS INTEGER
TopRow AS INTEGER
TopCol AS INTEGER
Action AS INTEGER
AnimCycle AS INTEGER
Direc AS INTEGER
PlayerY AS INTEGER
END TYPE
TYPE MapType
Tile AS INTEGER
END TYPE
TYPE Registers
AX AS INTEGER
BX AS INTEGER
CX AS INTEGER
DX AS INTEGER
BP AS INTEGER
SI AS INTEGER
DI AS INTEGER
FLAGS AS INTEGER
DS AS INTEGER
ES AS INTEGER
END TYPE
IntXCodeData:
DATA &H55, &H8B, &HEC, &H83, &HEC, &H08, &H56, &H57, &H1E, &H55, &H8B, &H5E
DATA &H06, &H8B, &H47, &H10, &H3D, &HFF, &HFF, &H75, &H04, &H1E, &H8F, &H47
DATA &H10, &H8B, &H47, &H12, &H3D, &HFF, &HFF, &H75, &H04, &H1E, &H8F, &H47
DATA &H12, &H8B, &H47, &H08, &H89, &H46, &HF8, &H8B, &H07, &H8B, &H4F, &H04
DATA &H8B, &H57, &H06, &H8B, &H77, &H0A, &H8B, &H7F, &H0C, &HFF, &H77, &H12
DATA &H07, &HFF, &H77, &H02, &H1E, &H8F, &H46, &HFA, &HFF, &H77, &H10, &H1F
DATA &H8B, &H6E, &HF8, &H5B, &HCD, &H21, &H55, &H8B, &HEC, &H8B, &H6E, &H02
DATA &H89, &H5E, &HFC, &H8B, &H5E, &H06, &H1E, &H8F, &H46, &HFE, &HFF, &H76
DATA &HFA, &H1F, &H89, &H07, &H8B, &H46, &HFC, &H89, &H47, &H02, &H89, &H4F
DATA &H04, &H89, &H57, &H06, &H58, &H89, &H47, &H08, &H89, &H77, &H0A, &H89
DATA &H7F, &H0C, &H9C, &H8F, &H47, &H0E, &H06, &H8F, &H47, &H12, &H8B, &H46
DATA &HFE, &H89, &H47, &H10, &H5A, &H1F, &H5F, &H5E, &H8B, &HE5, &H5D, &HCA
DATA &H02, &H00
DIM SHARED QMIDIRegs AS Registers, MEM.SEGMENT AS INTEGER
DIM SHARED MIDI.PLAYTIME AS SINGLE, MIDI.ERROR AS INTEGER, PAUSED AS SINGLE
DIM SHARED SBMIDI.INTERRUPT AS INTEGER, MEM.ALLOCATED AS LONG
DIM SHARED SBSIM.INTERRUPT AS INTEGER, MIXER.CHIP AS INTEGER
DIM SHARED SB.BASEPORT AS INTEGER, SB.IRQ AS INTEGER
DIM SHARED SB.LODMA AS INTEGER, SB.HIDMA AS INTEGER, SB.CARDTYPE AS INTEGER
DIM SHARED SB.MPU401 AS INTEGER, BIT.STORAGE(0 TO 7) AS INTEGER
DIM SHARED SENSITIVE AS INTEGER, REVERSE.STEREO AS INTEGER
DIM SHARED SOUND.DISABLED AS INTEGER
DriversLoaded SBMIDI.INTERRUPT, SBSIM.INTERRUPT
IF SBMIDI.INTERRUPT = 0 THEN SBMIDI.INTERRUPT = &H80
IF SBSIM.INTERRUPT = 0 THEN SBSIM.INTERRUPT = &H81
DetectSettings SB.BASEPORT, SB.IRQ, SB.LODMA, SB.HIDMA, SB.CARDTYPE, SB.MPU401
IF SB.CARDTYPE = 0 THEN SetCard 2
IF SB.BASEPORT = 0 THEN SB.BASEPORT = &H220
IF SB.IRQ = 0 THEN SB.IRQ = 5
IF SB.LODMA = 0 THEN SB.LODMA = 1
IF SB.HIDMA = 0 AND SB.CARDTYPE = 6 THEN SB.HIDMA = 5
CONST True = -1, False = NOT True
CONST North = 1, South = 2, East = 3, West = 4
CONST TileDir$ = "images"
DIM SHARED Tree1(129), grass1(129), Water1(129), lcast(129), tree2(129), crystal1(129), bridge(129), town(129), homemid(129), hometop(129), homebot(129), towntile(129), townwall(129)
DIM SHARED man1(129), man2(129), man3(129), castbot(129), castlsid(129), castmid(129), castmtop(129), castrsid(129), kingtile(129), stairway(129), king(129), tuntile(129), tunwall(129), carpet(129), mantle(129)
DIM SHARED crystal2(129), mtain(129), cavern(129), dirt1(129), cwall(129), cdoor(129), leo(850), fusoya(850), crystal3(129), desert(129), paladin(129), twrbox(129)
DIM SHARED WorldData AS WorldDataType
DIM SHARED map(-9 TO 60, -9 TO 60) AS MapType
DIM SHARED HandX%, HandY%, EnemyThere%
DIM SHARED StoryMap(16, 10) AS INTEGER
DIM SHARED Speed(5) AS INTEGER
DIM SHARED Saved(5) AS STRING
DIM SHARED LevelUp(40) AS LONG
DIM SHARED Move AS INTEGER
DIM SHARED PlayerDead AS INTEGER
DIM SHARED EnemyDead AS INTEGER
DIM SHARED RunAway AS INTEGER
DIM SHARED ChrSet(33 TO 122, 1 TO 8, 1 TO 8) AS INTEGER
DIM SHARED Choice AS STRING * 1
DIM SHARED name$
DIM SHARED main AS INTEGER
DIM SHARED TextScroll AS INTEGER
DIM SHARED NoConfig AS INTEGER
DIM SHARED Hand%(258)
DIM SHARED Players%(4626)
DIM SHARED Enemies%(2570)
DIM SHARED BackSprite%(1028)
DIM SHARED BackHand%(129)
MaxX = 50: MaxY = 50
DIM SHARED Maze(MaxX, MaxY) AS INTEGER
DIM SHARED PlayerName$(1 TO 2), PlayerAlive%(1 TO 2), PlayerType%(1 TO 2)
DIM SHARED PlayerHP%(1 TO 2), PlayerMaxHP%(1 TO 2), PlayerMP%(1 TO 2), PlayerMaxMP%(1 TO 2)
DIM SHARED PlayerST%(1 TO 2), PlayerDF%(1 TO 2), PlayerAG%(1 TO 2)
DIM SHARED PlayerMS%(1 TO 2), PlayerMD%(1 TO 2)
DIM SHARED PlayerEXP&(1 TO 2), PlayerGold&
DIM SHARED PlayerX%(1 TO 2), PlayerY%(1 TO 2), PlayerGo%(1 TO 2)
DIM SHARED EnemyName$(1 TO 4), EnemyAlive%(1 TO 4), EnemyType%(1 TO 4)
DIM SHARED EnemyHP%(1 TO 4), EnemyMaxHP%(1 TO 4), EnemyMP%(1 TO 4), EnemyMaxMP%(1 TO 4)
DIM SHARED EnemyST%(1 TO 4), EnemyDF%(1 TO 4), EnemyAG%(1 TO 4)
DIM SHARED EnemyMS%(1 TO 4), EnemyMD%(1 TO 4)
DIM SHARED EnemyEXP%(1 TO 4), EnemyGold%(1 TO 4)
DIM SHARED EnemyX%(1 TO 4), EnemyY%(1 TO 4), EnemyGo%(1 TO 4)
DIM SHARED loadthis%
DIM SHARED SaveCol, SaveRow, fight%, justleftworld, justleftkaipo, alreadytalked, wep$, mag$, gotsword
DIM SHARED talkedman1, talkedman2, talkedman3, justlefttunlan, justleftcastletunlan, towerkey, water, earth
DIM SHARED thisstory, serpent, item6$, nex, chest, area, gotwater, gotearth, cost1, cost2, cost3, item5$
DIM SHARED item4$, item3$, item2$, item$, justleftcastle, justleftmountain, arm$, arm2$, wep2$, mag2$
DIM SHARED PlayerLV%(1), PlayerLV2%, dol, item7$, item8$, item9$, called, mapload, cost4, mag3$, mag4$, intro
DIM SHARED notob, noboss, mapname$, talkedman4, firearmor, ep, Loaded
 
 
DECLARE FUNCTION GetArraySize (WLeft, WRight, WTop, WBottom)
 
SCREEN 2
CLS
 
' Define a viewport and draw a border around it:
VIEW (20, 10)-(620, 190), , 1
 
CONST PI = 3.141592653589#
 
' Redefine the coordinates of the viewport with logical
' coordinates:
WINDOW (-3.15, -.14)-(3.56, 1.01)
 
' Arrays in program are now dynamic:
' $DYNAMIC
 
' Calculate the logical coordinates for the top and bottom of a
' rectangle large enough to hold the image that will be drawn
' with CIRCLE and PAINT:
WLeft = -.21
WRight = .21
WTop = .07
WBottom = -.07
 
' Call the GetArraySize function, passing it the rectangle's
' logical coordinates:
ArraySize% = GetArraySize(WLeft, WRight, WTop, WBottom)
 
DIM Array(1 TO ArraySize%) AS INTEGER
 
' Draw and paint the circle:
CIRCLE (0, 0), .18
PAINT (0, 0)
 
' Store the rectangle in Array:
GET (WLeft, WTop)-(WRight, WBottom), Array
CLS
 
' Draw a box and fill it with a pattern:
LINE (-3, .8)-(3.4, .2), , B
Pattern$ = CHR$(126) + CHR$(0) + CHR$(126) + CHR$(126)
PAINT (0, .5), Pattern$
 
LOCATE 21, 29
PRINT "Press any key to end"
 
' Initialize loop variables:
StepSize = .02
StartLoop = -PI
Decay = 1
 
DO
EndLoop = -StartLoop
FOR X = StartLoop TO EndLoop STEP StepSize
 
' Each time the ball "bounces" (hits the bottom of the
' viewport), the Decay variable gets smaller, making the
' height of the next bounce smaller:
Y = ABS(COS(X)) * Decay - .14
IF Y < -.13 THEN Decay = Decay * .9
 
' Stop if a key pressed or if Decay is less than .01:
Esc$ = INKEY$
IF Esc$ <> "" OR Decay < .01 THEN EXIT FOR
 
' Put the image on the screen. The StepSize offset is
' smaller than the border around the circle, so each time
' the image moves, it erases any traces left from the
' previous PUT (it also erases anything else on the
' screen):
PUT (X, Y), Array, PSET
NEXT X
 
' Reverse direction:
StepSize = -StepSize
StartLoop = -StartLoop
LOOP UNTIL Esc$ <> "" OR Decay < .01
 
Pause$ = INPUT$(1)
END
REM $STATIC
REM $DYNAMIC
FUNCTION GetArraySize (WLeft, WRight, WTop, WBottom) STATIC
 
' Map the logical coordinates passed to this function to
' their physical-coordinate equivalents:
VLeft = PMAP(WLeft, 0)
VRight = PMAP(WRight, 0)
VTop = PMAP(WTop, 1)
VBottom = PMAP(WBottom, 1)
 
' Calculate the height and width in pixels of the
' enclosing rectangle:
RectHeight = ABS(VBottom - VTop) + 1
RectWidth = ABS(VRight - VLeft) + 1
 
' Calculate size in bytes of array:
ByteSize = 4 + RectHeight * INT((RectWidth + 7) / 8)
 
' Array is integer, so divide bytes by two:
GetArraySize = ByteSize \ 2 + 1
END FUNCTION
 
DECLARE FUNCTION GetArraySize (WLeft, WRight, WTop, WBottom)
 
SCREEN 2
CLS
VIEW (20, 10)-(620, 190), , 1
 
CONST PI = 3.141592653589#
 
WINDOW (-3.15, -.14)-(3.56, 1.01)
 
' $DYNAMIC
' The rectangle is smaller than the one in the previous
' program, which means Array is also smaller:
WLeft = -.18
WRight = .18
WTop = .05
WBottom = -.05
 
ArraySize% = GetArraySize(WLeft, WRight, WTop, WBottom)
 
DIM Array(1 TO ArraySize%) AS INTEGER
 
CIRCLE (0, 0), .18
PAINT (0, 0)
 
GET (WLeft, WTop)-(WRight, WBottom), Array
CLS
 
LINE (-3, .8)-(3.4, .2), , B
Pattern$ = CHR$(126) + CHR$(0) + CHR$(126) + CHR$(126)
PAINT (0, .5), Pattern$
 
LOCATE 21, 29
PRINT "Press any key to end"
 
StepSize = .02
StartLoop = -PI
Decay = 1
 
DO
EndLoop = -StartLoop
FOR X = StartLoop TO EndLoop STEP StepSize
Y = ABS(COS(X)) * Decay - .14
 
' The first PUT statement places the image on
' the screen:
PUT (X, Y), Array, XOR
 
' An empty FOR...NEXT loop to delay the program and
' reduce image flicker:
FOR I = 1 TO 5: NEXT I
 
IF Y < -.13 THEN Decay = Decay * .9
Esc$ = INKEY$
IF Esc$ <> "" OR Decay < .01 THEN EXIT FOR
 
' The second PUT statement erases the image and
' restores the background:
PUT (X, Y), Array, XOR
NEXT X
 
StepSize = -StepSize
StartLoop = -StartLoop
LOOP UNTIL Esc$ <> "" OR Decay < .01
 
Pause$ = INPUT$(1)
END
REM $STATIC
REM $DYNAMIC
FUNCTION GetArraySize (WLeft, WRight, WTop, WBottom) STATIC
VLeft = PMAP(WLeft, 0)
VRight = PMAP(WRight, 0)
VTop = PMAP(WTop, 1)
VBottom = PMAP(WBottom, 1)
 
RectHeight = ABS(VBottom - VTop) + 1
RectWidth = ABS(VRight - VLeft) + 1
 
ByteSize = 4 + RectHeight * INT((RectWidth + 7) / 8)
GetArraySize = ByteSize \ 2 + 1
END FUNCTION
' Define type for the titles:
TYPE TitleType
MainTitle AS STRING * 40
XTitle AS STRING * 40
YTitle AS STRING * 18
END TYPE
 
DECLARE SUB InputTitles (T AS TitleType)
DECLARE FUNCTION DrawGraph$ (T AS TitleType, Label$(), Value!(), N%)
DECLARE FUNCTION InputData% (Label$(), Value!())
 
' Variable declarations for titles and bar data:
DIM Titles AS TitleType, Label$(1 TO 5), Value(1 TO 5)
 
CONST FALSE = 0, TRUE = NOT FALSE
 
DO
InputTitles Titles
N% = InputData%(Label$(), Value())
IF N% <> FALSE THEN
NewGraph$ = DrawGraph$(Titles, Label$(), Value(), N%)
END IF
LOOP WHILE NewGraph$ = "Y"
 
END
REM $STATIC
'
' ========================== DRAWGRAPH =========================
' Draws a bar graph from the data entered in the INPUTTITLES
' and INPUTDATA procedures.
' ==============================================================
'
FUNCTION DrawGraph$ (T AS TitleType, Label$(), Value(), N%) STATIC
 
' Set size of graph:
CONST GRAPHTOP = 24, GRAPHBOTTOM = 171
CONST GRAPHLEFT = 48, GRAPHRIGHT = 624
CONST YLENGTH = GRAPHBOTTOM - GRAPHTOP
 
' Calculate max/min values:
YMax = 0
YMin = 0
FOR I% = 1 TO N%
IF Value(I%) < YMin THEN YMin = Value(I%)
IF Value(I%) > YMax THEN YMax = Value(I%)
NEXT I%
 
' Calculate width of bars and space between them:
BarWidth = (GRAPHRIGHT - GRAPHLEFT) / N%
BarSpace = .2 * BarWidth
BarWidth = BarWidth - BarSpace
 
SCREEN 2
CLS
 
' Draw y axis:
LINE (GRAPHLEFT, GRAPHTOP)-(GRAPHLEFT, GRAPHBOTTOM), 1
 
' Draw main graph title:
Start% = 44 - (LEN(RTRIM$(T.MainTitle)) / 2)
LOCATE 2, Start%
PRINT RTRIM$(T.MainTitle);
 
' Annotate Y axis:
Start% = CINT(13 - LEN(RTRIM$(T.YTitle)) / 2)
FOR I% = 1 TO LEN(RTRIM$(T.YTitle))
LOCATE Start% + I% - 1, 1
PRINT MID$(T.YTitle, I%, 1);
NEXT I%
 
' Calculate scale factor so labels aren't bigger than 4 digits:
IF ABS(YMax) > ABS(YMin) THEN
Power = YMax
ELSE
Power = YMin
END IF
Power = CINT(LOG(ABS(Power) / 100) / LOG(10))
IF Power < 0 THEN Power = 0
 
' Scale min and max down:
ScaleFactor = 10 ^ Power
YMax = CINT(YMax / ScaleFactor)
YMin = CINT(YMin / ScaleFactor)
 
' If power isn't zero then put scale factor on chart:
IF Power <> 0 THEN
LOCATE 3, 2
PRINT "x 10^"; LTRIM$(STR$(Power))
END IF
 
' Put tic mark and number for Max point on Y axis:
LINE (GRAPHLEFT - 3, GRAPHTOP)-STEP(3, 0)
LOCATE 4, 2
PRINT USING "####"; YMax
 
' Put tic mark and number for Min point on Y axis:
LINE (GRAPHLEFT - 3, GRAPHBOTTOM)-STEP(3, 0)
LOCATE 22, 2
PRINT USING "####"; YMin
 
' Scale min and max back up for charting calculations:
YMax = YMax * ScaleFactor
YMin = YMin * ScaleFactor
 
' Annotate X axis:
Start% = 44 - (LEN(RTRIM$(T.XTitle)) / 2)
LOCATE 25, Start%
PRINT RTRIM$(T.XTitle);
 
' Calculate the pixel range for the Y axis:
YRange = YMax - YMin
 
' Define a diagonally striped pattern:
Tile$ = CHR$(1) + CHR$(2) + CHR$(4) + CHR$(8) + CHR$(16) + CHR$(32) + CHR$(64) + CHR$(128)
 
' Draw a zero line if appropriate:
IF YMin < 0 THEN
Bottom = GRAPHBOTTOM - ((-YMin) / YRange * YLENGTH)
LOCATE INT((Bottom - 1) / 8) + 1, 5
PRINT "0";
ELSE
Bottom = GRAPHBOTTOM
END IF
 
' Draw x axis:
LINE (GRAPHLEFT - 3, Bottom)-(GRAPHRIGHT, Bottom)
 
' Draw bars and labels:
Start% = GRAPHLEFT + (BarSpace / 2)
FOR I% = 1 TO N%
 
' Draw a bar label:
BarMid = Start% + (BarWidth / 2)
CharMid = INT((BarMid - 1) / 8) + 1
LOCATE 23, CharMid - INT(LEN(RTRIM$(Label$(I%))) / 2)
PRINT Label$(I%);
 
' Draw the bar and fill it with the striped pattern:
BarHeight = (Value(I%) / YRange) * YLENGTH
LINE (Start%, Bottom)-STEP(BarWidth, -BarHeight), , B
PAINT (BarMid, Bottom - (BarHeight / 2)), Tile$, 1
 
Start% = Start% + BarWidth + BarSpace
NEXT I%
 
LOCATE 1, 1, 1
PRINT "New graph? ";
DrawGraph$ = UCASE$(INPUT$(1))
 
END FUNCTION
'
' ========================= INPUTDATA ========================
' Gets input for the bar labels and their values
' ============================================================
'
FUNCTION InputData% (Label$(), Value()) STATIC
 
' Initialize the number of data values:
NumData% = 0
 
' Print data-entry instructions:
CLS
PRINT "Enter data for up to 5 bars:"
PRINT " * Enter the label and value for each bar."
PRINT " * Values can be negative."
PRINT " * Enter a blank label to stop."
PRINT
PRINT "After viewing the graph, press any key ";
PRINT "to end the program."
 
' Accept data until blank label or 5 entries:
Done% = FALSE
DO
NumData% = NumData% + 1
PRINT
PRINT "Bar("; LTRIM$(STR$(NumData%)); "):"
INPUT ; " Label? ", Label$(NumData%)
 
' Only input value if label isn't blank:
IF Label$(NumData%) <> "" THEN
LOCATE , 35
INPUT "Value? ", Value(NumData%)
 
' If label was blank, decrement data counter and
' set Done flag equal to TRUE:
ELSE
NumData% = NumData% - 1
Done% = TRUE
END IF
LOOP UNTIL (NumData% = 5) OR Done%
 
' Return the number of data values input:
InputData% = NumData%
 
END FUNCTION
'
' ======================= INPUTTITLES ========================
' Accepts input for the three different graph titles
' ============================================================
'
SUB InputTitles (T AS TitleType) STATIC
 
' Set text screen:
SCREEN 0, 0
 
' Input Titles
DO
CLS
INPUT "Enter main graph title: ", T.MainTitle
INPUT "Enter X-Axis title : ", T.XTitle
INPUT "Enter Y-Axis title : ", T.YTitle
 
' Check to see if titles are OK:
LOCATE 7, 1
PRINT "OK (Y to continue, N to change)? ";
LOCATE , , 1
OK$ = UCASE$(INPUT$(1))
LOOP UNTIL OK$ = "Y"
END SUB
DEFINT A-Z ' Default variable type is integer
 
' Define a data type for the names of the months and the
' number of days in each:
TYPE MonthType
Number AS INTEGER ' Number of days in the month
MName AS STRING * 9 ' Name of the month
END TYPE
 
' Declare procedures used:
DECLARE FUNCTION IsLeapYear% (N%)
DECLARE FUNCTION GetInput% (Prompt$, Row%, LowVal%, HighVal%)
 
DECLARE SUB PrintCalendar (Year%, Month%)
DECLARE SUB ComputeMonth (Year%, Month%, StartDay%, TotalDays%)
 
DIM MonthData(1 TO 12) AS MonthType
 
' Initialize month definitions from DATA statements below:
FOR I = 1 TO 12
READ MonthData(I).MName, MonthData(I).Number
NEXT
 
' Main loop, repeat for as many months as desired:
DO
 
CLS
 
' Get year and month as input:
Year = GetInput("Year (1899 to 2099): ", 1, 1899, 2099)
Month = GetInput("Month (1 to 12): ", 2, 1, 12)
 
' Print the calendar:
PrintCalendar Year, Month
 
' Another Date?
LOCATE 13, 1 ' Locate in 13th row, 1st column
PRINT "New Date? "; ' Keep cursor on same line
LOCATE , , 1, 0, 13 ' Turn cursor on and make it one
' character high
Resp$ = INPUT$(1) ' Wait for a key press
PRINT Resp$ ' Print the key pressed
 
LOOP WHILE UCASE$(Resp$) = "Y"
END
 
' Data for the months of a year:
DATA January, 31, February, 28, March, 31
DATA April, 30, May, 31, June, 30, July, 31, August, 31
DATA September, 30, October, 31, November, 30, December, 31
'
' ====================== COMPUTEMONTH ========================
' Computes the first day and the total days in a month.
' ============================================================
'
SUB ComputeMonth (Year, Month, StartDay, TotalDays) STATIC
SHARED MonthData() AS MonthType
CONST LEAP = 366 MOD 7
CONST NORMAL = 365 MOD 7
 
' Calculate total number of days (NumDays) since 1/1/1899.
 
' Start with whole years:
NumDays = 0
FOR I = 1899 TO Year - 1
IF IsLeapYear(I) THEN ' If year is leap, add
NumDays = NumDays + LEAP ' 366 MOD 7.
ELSE ' If normal year, add
NumDays = NumDays + NORMAL ' 365 MOD 7.
END IF
NEXT
 
' Next, add in days from whole months:
FOR I = 1 TO Month - 1
NumDays = NumDays + MonthData(I).Number
NEXT
 
' Set the number of days in the requested month:
TotalDays = MonthData(Month).Number
 
' Compensate if requested year is a leap year:
IF IsLeapYear(Year) THEN
 
' If after February, add one to total days:
IF Month > 2 THEN
NumDays = NumDays + 1
 
' If February, add one to the month's days:
ELSEIF Month = 2 THEN
TotalDays = TotalDays + 1
 
END IF
END IF
 
' 1/1/1899 was a Sunday, so calculating "NumDays MOD 7"
' gives the day of week (Sunday = 0, Monday = 1, Tuesday = 2,
' and so on) for the first day of the input month:
StartDay = NumDays MOD 7
END SUB
'
' ======================== GETINPUT ==========================
' Prompts for input, then tests for a valid range.
' ============================================================
'
FUNCTION GetInput (Prompt$, Row, LowVal, HighVal) STATIC
 
' Locate prompt at specified row, turn cursor on and
' make it one character high:
LOCATE Row, 1, 1, 0, 13
PRINT Prompt$;
 
' Save column position:
Column = POS(0)
 
' Input value until it's within range:
DO
LOCATE Row, Column ' Locate cursor at end of prompt
PRINT SPACE$(10) ' Erase anything already there
LOCATE Row, Column ' Relocate cursor at end of prompt
INPUT "", Value ' Input value with no prompt
LOOP WHILE (Value < LowVal OR Value > HighVal)
 
' Return valid input as value of function:
GetInput = Value
 
END FUNCTION
'
' ====================== ISLEAPYEAR ==========================
' Determines if a year is a leap year or not.
' ============================================================
'
FUNCTION IsLeapYear (N) STATIC
 
' If the year is evenly divisible by 4 and not divisible
' by 100, or if the year is evenly divisible by 400, then
' it's a leap year:
IsLeapYear = (N MOD 4 = 0 AND N MOD 100 <> 0) OR (N MOD 400 = 0)
END FUNCTION
'
' ===================== PRINTCALENDAR ========================
' Prints a formatted calendar given the year and month.
' ============================================================
'
SUB PrintCalendar (Year, Month) STATIC
SHARED MonthData() AS MonthType
 
' Compute starting day (Su M Tu ...) and total days
' for the month:
ComputeMonth Year, Month, StartDay, TotalDays
CLS
Header$ = RTRIM$(MonthData(Month).MName) + "," + STR$(Year)
 
' Calculates location for centering month and year:
LeftMargin = (35 - LEN(Header$)) \ 2
 
' Print header:
PRINT TAB(LeftMargin); Header$
PRINT
PRINT "Su M Tu W Th F Sa"
PRINT
 
' Recalculate and print tab to the first day
' of the month (Su M Tu ...):
LeftMargin = 5 * StartDay + 1
PRINT TAB(LeftMargin);
 
' Print out the days of the month:
FOR I = 1 TO TotalDays
PRINT USING "## "; I;
 
' Advance to the next line when the cursor
' is past column 32:
IF POS(0) > 32 THEN PRINT
NEXT
 
END SUB
DIM Amount(1 TO 100)
CONST FALSE = 0, TRUE = NOT FALSE
 
' Get account's starting balance:
CLS
INPUT "Type starting balance, then press <ENTER>: ", Balance
 
' Get transactions. Continue accepting input until the
' input is zero for a transaction, or until 100
' transactions have been entered:
FOR TransacNum% = 1 TO 100
PRINT TransacNum%;
PRINT ") Enter transaction amount (0 to end): ";
INPUT "", Amount(TransacNum%)
IF Amount(TransacNum%) = 0 THEN
TransacNum% = TransacNum% - 1
EXIT FOR
END IF
NEXT
 
' Sort transactions in ascending order,
' using a "bubble sort":
Limit% = TransacNum%
DO
Swaps% = FALSE
FOR I% = 1 TO (Limit% - 1)
 
' If two adjacent elements are out of order, switch
' those elements:
IF Amount(I%) < Amount(I% + 1) THEN
SWAP Amount(I%), Amount(I% + 1)
Swaps% = I%
END IF
NEXT I%
 
' Sort on next pass only to where the last switch was made:
IF Swaps% THEN Limit% = Swaps%
 
' Sort until no elements are exchanged:
LOOP WHILE Swaps%
 
' Print the sorted transaction array. If a transaction
' is greater than zero, print it as a "CREDIT"; if a
' transaction is less than zero, print it as a "DEBIT":
FOR I% = 1 TO TransacNum%
IF Amount(I%) > 0 THEN
PRINT USING "CREDIT: $$#####.##"; Amount(I%)
ELSEIF Amount(I%) < 0 THEN
PRINT USING "DEBIT: $$#####.##"; Amount(I%)
END IF
 
' Update balance:
Balance = Balance + Amount(I%)
NEXT I%
 
' Print the final balance:
PRINT
PRINT "--------------------------"
PRINT USING "Final Total: $$######.##"; Balance
END
SCREEN 1
 
Esc$ = CHR$(27)
 
' Draw three boxes and paint the interior of each
' box with a different color:
FOR ColorVal = 1 TO 3
LINE (X, Y)-STEP(60, 50), ColorVal, BF
X = X + 61
Y = Y + 51
NEXT ColorVal
 
LOCATE 21, 1
PRINT "Press ESC to end."
PRINT "Press any other key to continue."
 
' Restrict additional printed output to the twenty-third line:
VIEW PRINT 23 TO 23
 
DO
PaletteVal = 1
DO
 
' PaletteVal is either one or zero:
PaletteVal = 1 - PaletteVal
 
' Set the background color and choose the palette:
COLOR BackGroundVal, PaletteVal
PRINT "Background ="; BackGroundVal; "Palette ="; PaletteVal;
 
Pause$ = INPUT$(1) ' Wait for a keystroke.
PRINT
 
' Exit the loop if both palettes have been shown,
' or if the user pressed the ESC key:
LOOP UNTIL PaletteVal = 1 OR Pause$ = Esc$
 
BackGroundVal = BackGroundVal + 1
 
' Exit this loop if all sixteen background colors have been
' shown, or if the user pressed the ESC key:
LOOP UNTIL BackGroundVal > 15 OR Pause$ = Esc$
 
SCREEN 0 ' Restore text mode and
WIDTH 80 ' eighty-column screen width.
DEFINT A-Z ' Default variable type is integer
 
' The Backup$ FUNCTION makes a backup file with
' the same base as FileName$, plus a .BAK extension:
DECLARE FUNCTION Backup$ (FileName$)
 
' Initialize symbolic constants and variables:
CONST FALSE = 0, TRUE = NOT FALSE
 
CarReturn$ = CHR$(13)
LineFeed$ = CHR$(10)
 
DO
CLS
 
' Get the name of the file to change:
INPUT "Which file do you want to convert"; OutFile$
 
InFile$ = Backup$(OutFile$) ' Get the backup file's name.
 
ON ERROR GOTO ErrorHandler ' Turn on error trapping.
 
NAME OutFile$ AS InFile$ ' Copy the input file to the
' backup file.
 
ON ERROR GOTO 0 ' Turn off error trapping.
 
' Open the backup file for input and the old file
' for output:
OPEN InFile$ FOR INPUT AS #1
OPEN OutFile$ FOR OUTPUT AS #2
 
' The PrevCarReturn variable is a flag that is set to TRUE
' whenever the program reads a carriage-return character:
PrevCarReturn = FALSE
 
' Read from the input file until reaching
' the end of the file:
DO UNTIL EOF(1)
 
' Not the end of the file, so read a character:
FileChar$ = INPUT$(1, #1)
 
SELECT CASE FileChar$
 
CASE CarReturn$ ' The character is a CR.
 
' If the previous character was also a
' CR, put a LF before the character:
IF PrevCarReturn THEN
FileChar$ = LineFeed$ + FileChar$
END IF
 
' In any case, set the PrevCarReturn
' variable to TRUE:
PrevCarReturn = TRUE
 
CASE LineFeed$ ' The character is a LF.
 
' If the previous character was not a
' CR, put a CR before the character:
IF NOT PrevCarReturn THEN
FileChar$ = CarReturn$ + FileChar$
END IF
 
' In any case, set the PrevCarReturn
' variable to FALSE:
PrevCarReturn = FALSE
 
CASE ELSE ' Neither a CR nor a LF.
 
' If the previous character was a CR,
' set the PrevCarReturn variable to FALSE
' and put a LF before the current character:
IF PrevCarReturn THEN
PrevCarReturn = FALSE
FileChar$ = LineFeed$ + FileChar$
END IF
 
END SELECT
 
' Write the character(s) to the new file:
PRINT #2, FileChar$;
LOOP
 
' Write a LF if the last character in the file was a CR:
IF PrevCarReturn THEN PRINT #2, LineFeed$;
 
CLOSE ' Close both files.
PRINT "Another file (Y/N)?" ' Prompt to continue.
 
' Change the input to uppercase (capital letter):
More$ = UCASE$(INPUT$(1))
 
' Continue the program if the user entered a "y" or a "Y":
LOOP WHILE More$ = "Y"
END
 
ErrorHandler: ' Error-handling routine
CONST NOFILE = 53, FILEEXISTS = 58
 
' The ERR function returns the error code for last error:
SELECT CASE ERR
CASE NOFILE ' Program couldn't find file with
' input name.
PRINT "No such file in current directory."
INPUT "Enter new name: ", OutFile$
InFile$ = Backup$(OutFile$)
RESUME
CASE FILEEXISTS ' There is already a file named
' <filename>.BAK in this directory:
' remove it, then continue.
KILL InFile$
RESUME
CASE ELSE ' An unanticipated error occurred:
' stop the program.
ON ERROR GOTO 0
END SELECT
'
' ========================= BACKUP$ ==========================
' This procedure returns a file name that consists of the
' base name of the input file (everything before the ".")
' plus the extension ".BAK"
' ============================================================
'
FUNCTION Backup$ (FileName$) STATIC
 
' Look for a period:
Extension = INSTR(FileName$, ".")
 
' If there is a period, add .BAK to the base:
IF Extension > 0 THEN
Backup$ = LEFT$(FileName$, Extension - 1) + ".BAK"
 
' Otherwise, add .BAK to the whole name:
ELSE
Backup$ = FileName$ + ".BAK"
END IF
END FUNCTION
' The macro string to draw the cube and paint its sides:
Plot$ = "BR30 BU25 C1 R54 U45 L54 D45 BE20 P1,1 G20 C2 G20" + "R54 E20 L54 BD5 P2,2 U5 C4 G20 U45 E20 D45 BL5 P4,4"
 
APage% = 1 ' Initialize values for the active and visual
VPage% = 0 ' pages, as well as the angle of rotation.
Angle% = 0
 
DO
 
' Draw to the active page while showing
' the visual page:
SCREEN 7, , APage%, VPage%
CLS 1
 
' Rotate the cube "Angle%" degrees:
DRAW "TA" + STR$(Angle%) + Plot$
 
' Angle% is some multiple of 15 degrees:
Angle% = (Angle% + 15) MOD 360
 
' Switch the active and visual pages:
SWAP APage%, VPage%
 
LOOP WHILE INKEY$ = "" ' A key press ends the program.
 
END
DECLARE SUB DrawPattern ()
DECLARE SUB EditPattern ()
DECLARE SUB Initialize ()
DECLARE SUB ShowPattern (OK$)
 
DIM Bit%(0 TO 7), Pattern$, Esc$, PatternSize%
 
DO
Initialize
EditPattern
ShowPattern OK$
LOOP WHILE OK$ = "Y"
 
END
'
' ======================== DRAWPATTERN =======================
' Draws a patterned rectangle on the right side of screen
' ============================================================
'
SUB DrawPattern STATIC
SHARED Pattern$
 
VIEW (320, 24)-(622, 160), 0, 1 ' Set view to rectangle
PAINT (1, 1), Pattern$ ' Use PAINT to fill it
VIEW ' Set view to full screen
 
END SUB
'
' ======================== EDITPATTERN =======================
' Edits a tile-byte pattern
' ============================================================
'
SUB EditPattern STATIC
SHARED Pattern$, Esc$, Bit%(), PatternSize%
 
ByteNum% = 1 ' Starting position.
BitNum% = 7
Null$ = CHR$(0) ' CHR$(0) is the first byte of the
' two-byte string returned when a
' direction key such as UP or DOWN is
' pressed.
DO
 
' Calculate starting location on screen of this bit:
X% = ((7 - BitNum%) * 16) + 80
Y% = (ByteNum% + 2) * 8
 
' Wait for a key press (and flash cursor each 3/10 second):
State% = 0
RefTime = 0
DO
 
' Check timer and switch cursor state if 3/10 second:
IF ABS(TIMER - RefTime) > .3 THEN
RefTime = TIMER
State% = 1 - State%
 
' Turn the border of bit on and off:
LINE (X% - 1, Y% - 1)-STEP(15, 8), State%, B
END IF
 
Check$ = INKEY$ ' Check for key press.
 
LOOP WHILE Check$ = "" ' Loop until a key is pressed.
 
' Erase cursor:
LINE (X% - 1, Y% - 1)-STEP(15, 8), 0, B
 
SELECT CASE Check$ ' Respond to key press.
 
CASE CHR$(27) ' ESC key pressed:
EXIT SUB ' exit this subprogram
 
CASE CHR$(32) ' SPACEBAR pressed:
' reset state of bit
 
' Invert bit in pattern string:
CurrentByte% = ASC(MID$(Pattern$, ByteNum%, 1))
CurrentByte% = CurrentByte% XOR Bit%(BitNum%)
MID$ (Pattern$, ByteNum%) = CHR$(CurrentByte%)
 
' Redraw bit on screen:
IF (CurrentByte% AND Bit%(BitNum%)) <> 0 THEN
CurrentColor% = 1
ELSE
CurrentColor% = 0
END IF
LINE (X% + 1, Y% + 1)-STEP(11, 4), CurrentColor%, BF
 
CASE CHR$(13) ' ENTER key pressed:
DrawPattern ' draw pattern in box on right.
 
CASE Null$ + CHR$(75) ' LEFT key: move cursor left
 
BitNum% = BitNum% + 1
IF BitNum% > 7 THEN BitNum% = 0
 
CASE Null$ + CHR$(77) ' RIGHT key: move cursor right
 
BitNum% = BitNum% - 1
IF BitNum% < 0 THEN BitNum% = 7
 
CASE Null$ + CHR$(72) ' UP key: move cursor up
 
ByteNum% = ByteNum% - 1
IF ByteNum% < 1 THEN ByteNum% = PatternSize%
 
CASE Null$ + CHR$(80) ' DOWN key: move cursor down
 
ByteNum% = ByteNum% + 1
IF ByteNum% > PatternSize% THEN ByteNum% = 1
 
CASE ELSE
' User pressed a key other than ESC, SPACEBAR,
' ENTER, UP, DOWN, LEFT, or RIGHT, so don't
' do anything.
END SELECT
LOOP
END SUB
'
' ======================== INITIALIZE ========================
' Sets up starting pattern and screen
' ============================================================
'
SUB Initialize STATIC
SHARED Pattern$, Esc$, Bit%(), PatternSize%
 
Esc$ = CHR$(27) ' ESC character is ASCII 27.
 
' Set up an array holding bits in positions 0 to 7:
FOR I% = 0 TO 7
Bit%(I%) = 2 ^ I%
NEXT I%
 
CLS
 
' Input the pattern size (in number of bytes):
LOCATE 5, 5
PRINT "Enter pattern size (1-16 rows):";
DO
LOCATE 5, 38
PRINT " ";
LOCATE 5, 38
INPUT "", PatternSize%
LOOP WHILE PatternSize% < 1 OR PatternSize% > 16
 
' Set initial pattern to all bits set:
Pattern$ = STRING$(PatternSize%, 255)
 
SCREEN 2 ' 640 x 200 monochrome graphics mode.
 
' Draw dividing lines:
LINE (0, 10)-(635, 10), 1
LINE (300, 0)-(300, 199)
LINE (302, 0)-(302, 199)
 
' Print titles:
LOCATE 1, 13: PRINT "Pattern Bytes"
LOCATE 1, 53: PRINT "Pattern View"
 
' Draw editing screen for pattern:
FOR I% = 1 TO PatternSize%
 
' Print label on left of each line:
LOCATE I% + 3, 8
PRINT USING "##:"; I%
 
' Draw "bit" boxes:
X% = 80
Y% = (I% + 2) * 8
FOR J% = 1 TO 8
LINE (X%, Y%)-STEP(13, 6), 1, BF
X% = X% + 16
NEXT J%
NEXT I%
 
DrawPattern ' Draw "Pattern View" box.
 
LOCATE 21, 1
PRINT "DIRECTION keys........Move cursor"
PRINT "SPACEBAR............Changes point"
PRINT "ENTER............Displays pattern"
PRINT "ESC.........................Quits";
 
END SUB
'
' ======================== SHOWPATTERN =======================
' Prints the CHR$ values used by PAINT to make pattern
' ============================================================
'
SUB ShowPattern (OK$) STATIC
SHARED Pattern$, PatternSize%
 
' Return screen to 80-column text mode:
SCREEN 0, 0
WIDTH 80
 
PRINT "The following characters make up your pattern:"
PRINT
 
' Print out the value for each pattern byte:
FOR I% = 1 TO PatternSize%
PatternByte% = ASC(MID$(Pattern$, I%, 1))
PRINT "CHR$("; LTRIM$(STR$(PatternByte%)); ")"
NEXT I%
 
PRINT
LOCATE , , 1
PRINT "New pattern? ";
OK$ = UCASE$(INPUT$(1))
END SUB
' ENTAB.BAS
'
' Replace runs of spaces in a file with tabs.
'
DECLARE SUB SetTabPos ()
DECLARE SUB StripCommand (CLine$)
 
 
DEFINT A-Z
DECLARE FUNCTION ThisIsATab (Column AS INTEGER)
 
CONST MAXLINE = 255
CONST TABSPACE = 8
CONST NO = 0, YES = NOT NO
 
DIM SHARED TabStops(MAXLINE) AS INTEGER
 
StripCommand (COMMAND$)
 
' Set the tab positions (uses the global array TabStops).
SetTabPos
 
LastColumn = 1
 
DO
 
CurrentColumn = LastColumn
 
' Replace a run of blanks with a tab when you reach a tab
' column. CurrentColumn is the current column read.
' LastColumn is the last column that was printed.
DO
C$ = INPUT$(1,#1)
IF C$ <> " " AND C$ <> CHR$(9) THEN EXIT DO
CurrentColumn = CurrentColumn + 1
IF C$=CHR$(9) OR ThisIsATab(CurrentColumn) THEN
' Go to a tab column if we have a tab and this
' is not a tab column.
DO WHILE NOT ThisIsATab(CurrentColumn)
CurrentColumn=CurrentColumn+1
LOOP
PRINT #2, CHR$(9);
LastColumn = CurrentColumn
END IF
LOOP
 
' Print out any blanks left over.
DO WHILE LastColumn < CurrentColumn
PRINT #2, " ";
LastColumn = LastColumn + 1
LOOP
 
' Print the non-blank character.
PRINT #2, C$;
 
' Reset the column position if this is the end of a line.
IF C$ = CHR$(10) THEN
LastColumn = 1
ELSE
LastColumn = LastColumn + 1
END IF
 
LOOP UNTIL EOF(1)
CLOSE #1, #2
END
 
'------------------SUB SetTabPos-------------------------
' Set the tab positions in the array TabStops.
'
SUB SetTabPos STATIC
FOR I = 1 TO 255
TabStops(I) = ((I MOD TABSPACE) = 1)
NEXT I
END SUB
'
'------------------SUB StripCommand----------------------
'
SUB StripCommand (CommandLine$) STATIC
IF CommandLine$ = "" THEN
INPUT "File to entab: ", InFileName$
INPUT "Store entabbed file in: ", OutFileName$
ELSE
SpacePos = INSTR(CommandLine$, " ")
IF SpacePos > 0 THEN
InFileName$ = LEFT$(CommandLine$, SpacePos - 1)
OutFileName$ = LTRIM$(MID$(CommandLine$, SpacePos))
ELSE
InFileName$ = CommandLine$
INPUT "Store entabbed file in: ", OutFileName$
END IF
END IF
OPEN InFileName$ FOR INPUT AS #1
OPEN OutFileName$ FOR OUTPUT AS #2
END SUB
'---------------FUNCTION ThisIsATab----------------------
' Answer the question, "Is this a tab position?"
'
FUNCTION ThisIsATab (LastColumn AS INTEGER) STATIC
IF LastColumn > MAXLINE THEN
ThisIsATab = YES
ELSE
ThisIsATab = TabStops(LastColumn)
END IF
END FUNCTION
' Declare symbolic constants used in program:
CONST FALSE = 0, TRUE = NOT FALSE
 
DECLARE FUNCTION GetFileName$ ()
 
' Set up the ERROR trap, and specify the name of the
' error-handling routine:
ON ERROR GOTO ErrorProc
 
DO
Restart = FALSE
CLS
 
FileName$ = GetFileName$ ' Input file name.
 
IF FileName$ = "" THEN
END ' End if <ENTER> pressed.
ELSE
 
' Otherwise, open the file, assigning it the
' next available file number:
FileNum = FREEFILE
OPEN FileName$ FOR INPUT AS FileNum
END IF
 
IF NOT Restart THEN
 
' Input search string:
LINE INPUT "Enter string to locate: ", LocString$
LocString$ = UCASE$(LocString$)
 
' Loop through the lines in the file, printing them
' if they contain the search string:
LineNum = 1
DO WHILE NOT EOF(FileNum)
 
' Input line from file:
LINE INPUT #FileNum, LineBuffer$
 
' Check for string, printing the line and its
' number if found:
IF INSTR(UCASE$(LineBuffer$), LocString$) <> 0 THEN
PRINT USING "#### &"; LineNum, LineBuffer$
END IF
 
LineNum = LineNum + 1
LOOP
 
CLOSE FileNum ' Close the file.
 
END IF
LOOP WHILE Restart = TRUE
 
END
 
ErrorProc:
 
SELECT CASE ERR
 
CASE 64: ' Bad File Name
PRINT "** ERROR - Invalid file name"
 
' Get a new file name and try again:
FileName$ = GetFileName$
 
' Resume at the statement that caused the error:
RESUME
 
CASE 71: ' Disk not ready
PRINT "** ERROR - Disk drive not ready"
PRINT "Press C to continue, R to restart, Q to quit: "
DO
Char$ = UCASE$(INPUT$(1))
IF Char$ = "C" THEN
RESUME ' Resume where you left off
 
ELSEIF Char$ = "R" THEN
Restart = TRUE ' Resume at beginning
RESUME NEXT
 
ELSEIF Char$ = "Q" THEN
END ' Don't resume at all
END IF
LOOP
 
CASE 53, 76: ' File or path not found
PRINT "** ERROR - File or path not found"
FileName$ = GetFileName$
RESUME
 
CASE ELSE: ' Unforeseen error
 
' Disable error trapping and print standard
' system message:
ON ERROR GOTO 0
END SELECT
'
' ======================= GETFILENAME$ =======================
' Returns a file name from user input
' ============================================================
'
FUNCTION GetFileName$ STATIC
INPUT "Enter file to search (press ENTER to quit): ", FTemp$
GetFileName$ = FTemp$
END FUNCTION
'
' FLPT.BAS
'
' Displays how a given real value is stored in memory.
'
'
DEFINT A-Z
DECLARE FUNCTION MHex$ (X AS INTEGER)
DIM Bytes(3)
 
CLS
PRINT "Internal format of IEEE number (all values in hexadecimal)"
PRINT
DO
 
' Get the value and calculate the address of the variable.
INPUT "Enter a real number (or END to quit): ", A$
IF UCASE$(A$) = "END" THEN EXIT DO
RealValue! = VAL(A$)
' Convert the real value to a long without changing any of
' the bits.
AsLong& = CVL(MKS$(RealValue!))
' Make a string of hex digits, and add leading zeroes.
Strout$ = HEX$(AsLong&)
Strout$ = STRING$(8 - LEN(Strout$), "0") + Strout$
 
' Save the sign bit, and then eliminate it so it doesn't
' affect breaking out the bytes
SignBit& = AsLong& AND &H80000000
AsLong& = AsLong& AND &H7FFFFFFF
' Split the real value into four separate bytes
' --the AND removes unwanted bits; dividing by 256 shifts
' the value right 8 bit positions.
FOR I = 0 TO 3
Bytes(I) = AsLong& AND &HFF&
AsLong& = AsLong& \ 256&
NEXT I
' Display how the value appears in memory.
PRINT
PRINT "Bytes in Memory"
PRINT " High Low"
FOR I = 1 TO 7 STEP 2
PRINT " "; MID$(Strout$, I, 2);
NEXT I
PRINT : PRINT
 
' Set the value displayed for the sign bit.
Sign = ABS(SignBit& <> 0)
 
' The exponent is the right seven bits of byte 3 and the
' leftmost bit of byte 2. Multiplying by 2 shifts left and
' makes room for the additional bit from byte 2.
Exponent = Bytes(3) * 2 + Bytes(2) \ 128
 
' The first part of the mantissa is the right seven bits
' of byte 2. The OR operation makes sure the implied bit
' is displayed by setting the leftmost bit.
Mant1 = (Bytes(2) OR &H80)
PRINT " Bit 31 Bits 30-23 Implied Bit & Bits 22-0"
PRINT "Sign Bit Exponent Bits Mantissa Bits"
PRINT TAB(4); Sign; TAB(17); MHex$(Exponent);
PRINT TAB(33); MHex$(Mant1); MHex$(Bytes(1)); MHex$(Bytes(0))
PRINT
 
LOOP
 
' MHex$ makes sure we always get two hex digits.
FUNCTION MHex$ (X AS INTEGER) STATIC
D$ = HEX$(X)
IF LEN(D$) < 2 THEN D$ = "0" + D$
MHex$ = D$
END FUNCTION
 
 
Done
 
[This message has been edited by jdulmage (edited 20 November 2000).]

man, I shouldn't have done that...

Hmmm, i like it