Jump to content
Compatible Support Forums
Sign in to follow this  
Followers 0
jdulmage

I don't mean to piss everyone off..........

By jdulmage, in Slack Space

Recommended Posts

Down8    0

Down8
Posted

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

 

-bZj

Share this post

Link to post

DeadCats    0

DeadCats
Posted

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

Share this post

Link to post

someone_nt    0

someone_nt
Posted

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!!!

Share this post

Link to post

FrogMaster    0

FrogMaster
Posted

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...

Share this post

Link to post

someone_nt    0

someone_nt
Posted

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?

Share this post

Link to post

FrogMaster    0

FrogMaster
Posted

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!

Share this post

Link to post

evil Homer    0

evil Homer
Posted

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...! wink

 

(BTW, my g/f is American and will probably slap me for saying that!)

 

evil Homer

Share this post

Link to post

someone_nt    0

someone_nt
Posted

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!

Share this post

Link to post

jdulmage    0

jdulmage
Posted

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 smile

 

[This message has been edited by jdulmage (edited 20 November 2000).]

Share this post

Link to post

CUViper    0

CUViper
Posted

pi = 3.1415926535897932384626433832795028841971693993751058209749445923078164062862089986280348253421170679821480865132823066470938446095505822317253594081284811174502841027019385211055 596446229489549303819644288109756659334461284756482337867831652712019091456485669234603486104543266482133936072602491412737245870066063155881748815209209628292540917153643678925903 600113305305488204665213841469519415116094330572703657595919530921861173819326117931051185480744623799627495673518857527248912279381830119491298336733624406566430860213949463952247 371907021798609437027705392171762931767523846748184676694051320005681271452635608277857713427577896091736371787214684409012249534301465495853710507922796892589235420199561121290219 608640344181598136297747713099605187072113499999983729780499510597317328160963185950244594553469083026425223082533446850352619311881710100031378387528865875332083814206171776691473 035982534904287554687311595628638823537875937519577818577805321712268066130019278766111959092164201989380952572010654858632788659361533818279682303019520353018529689957736225994138 912497217752834791315155748572424541506959508295331168617278558890750983817546374649393192550604009277016711390098488240128583616035637076601047101819429555961989467678374494482553 797747268471040475346462080466842590694912933136770289891521047521620569660240580381501935112533824300355876402474964732639141992726042699227967823547816360093417216412199245863150 302861829745557067498385054945885869269956909272107975093029553211653449872027559602364806654991198818347977535663698074265425278625518184175746728909777727938000816470600161452491 921732172147723501414419735685481613611573525521334757418494684385233239073941433345477624168625189835694855620992192221842725502542568876717904946016534668049886272327917860857843 838279679766814541009538837863609506800642251252051173929848960841284886269456042419652850222106611863067442786220391949450471237137869609563643719172874677646575739624138908658326 459958133904780275901

Share this post

Link to post
Guest
This topic is now closed to further replies.
Sign in to follow this  
Followers 0
Go To Topic Listing Slack Space
×