OS_Develop/dos_compilers
OS_Develop/dos_compilers
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Borland Turbo Basic v1.1

Browse Source
This commit is contained in:
davidly 2024-07-01 15:32:03 -07:00
parent c7aad48ec8
commit 259b1a1df8
26 changed files with 70650 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
Borland Turbo BASIC v11/001.BAS Normal file
View File

@ -0,0 +1,10 @@
screen 2
cls
line (111,111)-(222,222)
locate 20,20
input a$
locate 21,21
print a$
input a
end


10
Borland Turbo BASIC v11/003.BAS Normal file
View File

@ -0,0 +1,10 @@
cls
print falling
for n=1000 to 700 step -5
sound n,1
next n
for n=1 to 700
sound 50*rnd+37,.0015
next n
delay 1
end

9
Borland Turbo BASIC v11/004.BAS Normal file
View File

@ -0,0 +1,9 @@
print "clock"
for n=1 to 5
sound 500,.01
delay .4
sound 2000,.01
delay .4
next n
delay 1
end

122
Borland Turbo BASIC v11/BALL.BAS Normal file
View File

@ -0,0 +1,122 @@
'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'³ BALL.BAS ³
'³ VERSION 1.0 ³
'³ ³
'³ Turbo Basic ³
'³ (C) Copyright 1987 by Borland International ³
'³ ³
'³ System Requirements: ³
'³ - DOS Version 2.0 or later ³
'³ - 320K ³
'³ ³
'³ This program is a simple demonstration of the graphics capabilities ³
'³ of Turbo Basic. It displays a "bouncing ball" that uses random numbers ³
'³ to figure out which directions to bounce off to. ³
'³ ³
'³ In order to run this program do the following: ³
'³ 1. Load Turbo Basic by typing TB at the DOS prompt. ³
'³ 2. Load the file BALL.BAS from the Load option of the File ³
'³ pulldown menu. ³
'³ 3. Select Run from the Main menu ³
'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
' logic:
' draw the ball
' use GET to store pixels into an array
' set CurrentPosition = OldPosition = StartPoint
' DO
' Erase (PUT with XOR) the object at the OldPosition
' CurrentPosition = CurrentPosition + Increment
' Display (PUT) the object at the CurrentPosition
' DELAY a small amount of time
' OldPosition = CurrentPosition
' LOOP UNTIL any key is hit
' end of program
'
DEFINT A-Z
RANDOMIZE TIMER
'
' dimension the save buffer for the pixels
'
DIM GraphicsBuffer(1000)
SCREEN 1
'
' set screen min and max based on screen number
'
Max.X = 319 : Min.X = 0
Max.Y = 199 : Min.Y = 0
'
' set size of ball
'
SizeOfBall = 15
'
' set up the starting center position for the ball
'
Start.X = 15
Start.Y = 15
'
' build the ball on the screen
'
CIRCLE (Start.X,Start.Y),SizeOfBall,2
PAINT (Start.X,Start.Y),1,2
'
' store the pixels in a graphics save buffer
'
GET (Start.X-SizeOfBall,Start.Y-SizeOfBall)-(Start.X+SizeOfBall,Start.Y+SizeOfBall),GraphicsBuffer
'
' initialize the position of the ball
'
CurrentPosition.X = OldPosition.X = Start.X
CurrentPosition.Y = OldPosition.Y = Start.Y
'
' set current X direction to Right, Y direction to Down
'
Direction.X = 1
Direction.Y = 1
DO
'
' erase previous ball by doing a PUT at the old position
'
PUT (OldPosition.X,OldPosition.Y),GraphicsBuffer
'
' calculate new X position,
' if at right edge set direction to Left
' if at left edge set direction to right
' if ball hits an edge, make a sound
'
Increment.X = RND*8
IF CurrentPosition.X+Increment.X+30 > Max.X THEN Direction.X = -1 : sound 200+rnd*250,.5
IF CurrentPosition.X-Increment.X < Min.Y THEN Direction.X = 1 : sound 200+rnd*300,.5
CurrentPosition.X = CurrentPosition.X + (Increment.X*Direction.X)
'
' calculate new Y position,
' if at bottom edge set direction to the up
' if at top edge set direction to the down
' if ball hits an edge, make a sound
'
Increment.Y = RND*8
IF CurrentPosition.Y+Increment.Y+30 > Max.Y THEN Direction.Y = -1 : sound 200+rnd*275,.5
IF CurrentPosition.Y-Increment.Y < Min.Y THEN Direction.Y = 1 : sound 200+rnd*325,.5
CurrentPosition.Y = CurrentPosition.Y + (Increment.Y*Direction.Y)
'
' display the ball at the new position
'
PUT (CurrentPosition.X,CurrentPosition.Y),GraphicsBuffer
'
' wait some time for smoother animation
'
DELAY .03
'
' save current position so the ball can be erased before next move
'
OldPosition.X = CurrentPosition.X
OldPosition.Y = CurrentPosition.Y
'
' keep looping until any key is hit
'
LOOP UNTIL INSTAT
END


BIN
Borland Turbo BASIC v11/BASICA.EXE Normal file
View File

Binary file not shown.

68649
Borland Turbo BASIC v11/Borland_Turbo_BASIC_Owners_Handbook_1987.pdf Normal file
View File

File diff suppressed because one or more lines are too long

BIN
Borland Turbo BASIC v11/DJ941-3.WPS Normal file
View File

Binary file not shown.

BIN
Borland Turbo BASIC v11/DJ941-4.WPS Normal file
View File

Binary file not shown.

31
Borland Turbo BASIC v11/E.BAS Normal file
View File

@ -0,0 +1,31 @@
100 DIGITS% = 200
110 DIM A%( 200 )
120 HIGH% = DIGITS%
130 X% = 0
140 N% = HIGH% - 1
150 IF N% <= 0 GOTO 200
160 A%[ N% ] = 1
170 N% = N% - 1
180 GOTO 150
200 A%[ 1 ] = 2
210 A%[ 0 ] = 0
220 IF HIGH% <= 9 GOTO 400
230 HIGH% = HIGH% - 1
235 N% = HIGH%
240 IF N% = 0 GOTO 300
250 A%[ N% ] = X% MOD N%
255 rem PRINT "a[n-1]"; A%[ N% - 1 ]
260 X% = ( 10 * A%[ N% - 1 ] ) + ( X% \ N% )
265 rem PRINT "x: "; X%, "n: "; N%
270 N% = N% - 1
280 GOTO 240
300 IF X% >= 10 GOTO 330
310 PRINT USING "#"; X%;
320 GOTO 220
330 PRINT USING "##"; X%;
340 GOTO 220
400 PRINT ""
410 PRINT "done"
420 SYSTEM

2
Borland Turbo BASIC v11/HELLO.BAS Normal file
View File

@ -0,0 +1,2 @@
print "hello dave"


759
Borland Turbo BASIC v11/MUSIC.BAS Normal file
View File

@ -0,0 +1,759 @@
'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
'³ MUSIC.BAS ³
'³ VERSION 1.0 ³
'³ ³
'³ Turbo Basic ³
'³ (C) Copyright 1987 by Borland International ³
'³ ³
'³ System Requirements: ³
'³ - DOS Version 2.0 or later ³
'³ - 320K ³
'³ ³
'³ This program is a simple demonstration of the sound capabilities ³
'³ of Turbo Basic. It plays the classical "Two-Part Invention Number 4 in ³
'³ D-Minor by Johann Sebastian Bach. ³
'³ ³
'³ In order to run this program do the following: ³
'³ 1. Load Turbo Basic by typing TB at the DOS prompt. ³
'³ 2. Load the file MUSIC.BAS from the Load option of the File ³
'³ pulldown menu. ³
'³ 3. Select Run from the Main menu ³
'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
$SOUND 4096 ' set the sound buffer to the maximum size
DEFINT A-Z ' declare all variables integer type
READ Frequency,Duration ' read first Frequency and Duration pair
WHILE Frequency <> -1 ' keep playing notes until the end of song
DELAY .05 ' general delay for music clarity
IF Frequency = 0 THEN
'
' If Frequency is 0 then pause for the Duration
' value (in hundredths of a second)
'
SELECT CASE Duration
CASE 3
DELAY .03
CASE 6
DELAY .06
END SELECT
ELSE
'
' Otherwise, use the SOUND statement to play the Frequency for
' the proper Duration. Remember that the SOUND statement
' uses durations in Clock Tick. The values used in the
' following SOUND statements were pre-calculated for speed
' and are derived by:
' ClockTicks = Duration/100/0.0549
' note: 0.0549 = number of seconds per clock tick
'
SELECT CASE Duration
CASE 3
SOUND Frequency,0.5464
CASE 6
SOUND Frequency,1.0929
CASE 8
SOUND Frequency,1.4572
CASE 9
SOUND Frequency,1.6393
END SELECT
END IF
READ Frequency,Duration ' read in next Frequency and Duration pair
WEND
END
'
' Two-Part Invention Number 4 in D-Minor data
' Data is in Frequency and Duration Pairs:
' Frequency is the Note frequence to play
' Duration is the length (in 1/100 of a second) to play
' Data is terminated by Frequency and Duration = -1
'
DATA 586,6
DATA 0,6
DATA 658,6
DATA 0,6
DATA 697,6
DATA 0,6
DATA 782,6
DATA 0,6
DATA 878,6
DATA 0,6
DATA 930,6
DATA 0,6
DATA 553,6
DATA 0,6
DATA 930,6
DATA 0,6
DATA 878,6
DATA 0,6
DATA 782,6
DATA 0,6
DATA 697,6
DATA 0,6
DATA 658,6
DATA 0,6
DATA 697,6
DATA 293,6
DATA 0,6
DATA 329,6
DATA 878,6
DATA 348,6
DATA 0,6
DATA 391,6
DATA 1172,6
DATA 439,6
DATA 0,6
DATA 465,6
DATA 782,6
DATA 277,6
DATA 0,6
DATA 465,6
DATA 1106,6
DATA 439,6
DATA 0,6
DATA 391,6
DATA 1315,6
DATA 348,6
DATA 0,6
DATA 329,6
DATA 1172,6
DATA 348,6
DATA 1315,6
DATA 0,6
DATA 1394,6
DATA 439,6
DATA 1564,6
DATA 0,6
DATA 1756,6
DATA 586,6
DATA 1860,6
DATA 0,6
DATA 1106,6
DATA 329,6
DATA 1860,6
DATA 0,6
DATA 1756,6
DATA 391,6
DATA 1564,6
DATA 0,6
DATA 1394,6
DATA 553,6
DATA 1315,6
DATA 0,6
DATA 1394,6
DATA 293,6
DATA 1172,6
DATA 0,6
DATA 1315,6
DATA 586,6
DATA 1394,6
DATA 0,6
DATA 1564,6
DATA 348,6
DATA 1756,6
DATA 0,6
DATA 930,6
DATA 391,6
DATA 1756,6
DATA 0,6
DATA 1564,6
DATA 439,6
DATA 1394,6
DATA 0,6
DATA 1315,6
DATA 465,6
DATA 1172,6
DATA 0,6
DATA 1315,6
DATA 261,6
DATA 1044,6
DATA 0,6
DATA 1172,6
DATA 522,6
DATA 1315,6
DATA 0,6
DATA 1394,6
DATA 329,6
DATA 1564,6
DATA 0,6
DATA 878,6
DATA 348,6
DATA 1564,6
DATA 0,6
DATA 1394,6
DATA 391,6
DATA 1315,6
DATA 0,6
DATA 1172,6
DATA 439,6
DATA 1044,6
DATA 0,6
DATA 1172,6
DATA 465,6
DATA 1315,6
DATA 391,6
DATA 1394,6
DATA 439,6
DATA 1172,6
DATA 465,6
DATA 1315,6
DATA 522,6
DATA 1394,6
DATA 586,6
DATA 782,6
DATA 329,6
DATA 586,9
DATA 0,3
DATA 522,9
DATA 0,3
DATA 465,9
DATA 0,3
DATA 439,9
DATA 0,3
DATA 391,9
DATA 0,3
DATA 1044,6
DATA 439,6
DATA 1172,6
DATA 348,6
DATA 1315,6
DATA 391,6
DATA 1044,6
DATA 439,6
DATA 1172,6
DATA 465,6
DATA 1315,6
DATA 522,6
DATA 697,6
DATA 293,6
DATA 522,9
DATA 0,3
DATA 465,9
DATA 0,3
DATA 439,9
DATA 0,3
DATA 930,6
DATA 391,6
DATA 930,6
DATA 391,6
DATA 930,6
DATA 329,6
DATA 0,6
DATA 261,6
DATA 878,6
DATA 293,6
DATA 0,6
DATA 329,6
DATA 782,6
DATA 348,6
DATA 0,6
DATA 391,6
DATA 1044,6
DATA 219,6
DATA 930,6
DATA 391,6
DATA 878,6
DATA 348,6
DATA 782,6
DATA 329,6
DATA 697,6
DATA 293,6
DATA 658,6
DATA 261,6
DATA 697,6
DATA 293,6
DATA 782,6
DATA 233,6
DATA 782,6
DATA 261,6
DATA 782,6
DATA 261,6
DATA 782,6
DATA 131,6
DATA 697,6
DATA 123,6
DATA 697,6
DATA 174,6
DATA 0,6
DATA 196,6
DATA 1044,6
DATA 219,6
DATA 0,6
DATA 233,6
DATA 1044,6
DATA 261,6
DATA 0,6
DATA 293,6
DATA 1044,3
DATA 1172,3
DATA 164,6
DATA 1044,3
DATA 1172,3
DATA 293,6
DATA 1044,3
DATA 1172,3
DATA 261,6
DATA 1044,3
DATA 1172,3
DATA 233,6
DATA 1044,3
DATA 1172,3
DATA 219,6
DATA 1044,3
DATA 1172,3
DATA 196,6
DATA 1044,3
DATA 1172,3
DATA 219,6
DATA 1044,3
DATA 1172,3
DATA 233,6
DATA 1044,3
DATA 1172,3
DATA 261,6
DATA 1044,3
DATA 1172,3
DATA 293,6
DATA 1044,3
DATA 1172,3
DATA 329,6
DATA 1044,3
DATA 1172,3
DATA 348,6
DATA 1044,3
DATA 1172,3
DATA 196,6
DATA 1044,3
DATA 1172,3
DATA 348,6
DATA 1044,3
DATA 1172,3
DATA 329,6
DATA 1044,3
DATA 1172,3
DATA 293,6
DATA 1044,3
DATA 1172,3
DATA 261,6
DATA 1044,3
DATA 1172,3
DATA 233,6
DATA 1044,6
DATA 219,6
DATA 930,6
DATA 233,6
DATA 878,6
DATA 261,6
DATA 782,6
DATA 219,6
DATA 697,6
DATA 233,6
DATA 658,6
DATA 261,6
DATA 1044,6
DATA 185,6
DATA 586,6
DATA 0,6
DATA 658,6
DATA 0,6
DATA 738,6
DATA 0,6
DATA 782,6
DATA 0,6
DATA 878,6
DATA 0,6
DATA 930,6
DATA 196,6
DATA 878,6
DATA 219,6
DATA 782,6
DATA 233,6
DATA 697,6
DATA 196,6
DATA 658,6
DATA 219,6
DATA 586,6
DATA 233,6
DATA 930,6
DATA 164,6
DATA 522,6
DATA 0,6
DATA 586,6
DATA 0,6
DATA 658,6
DATA 0,6
DATA 697,6
DATA 0,6
DATA 782,6
DATA 174,6
DATA 878,6
DATA 0,6
DATA 985,6
DATA 348,6
DATA 1044,6
DATA 0,6
DATA 1172,6
DATA 293,6
DATA 1315,6
DATA 0,6
DATA 1394,6
DATA 246,6
DATA 829,6
DATA 0,6
DATA 1394,6
DATA 207,6
DATA 1315,6
DATA 0,6
DATA 1172,6
DATA 164,6
DATA 1044,6
DATA 0,6
DATA 985,6
DATA 219,6
DATA 1044,6
DATA 207,6
DATA 985,6
DATA 219,6
DATA 1172,6
DATA 246,6
DATA 1044,6
DATA 261,6
DATA 985,6
DATA 293,6
DATA 878,6
DATA 329,3
DATA 348,3
DATA 829,6
DATA 329,3
DATA 348,3
DATA 878,6
DATA 329,3
DATA 348,3
DATA 829,6
DATA 329,3
DATA 348,3
DATA 738,6
DATA 329,3
DATA 348,3
DATA 658,6
DATA 329,3
DATA 348,3
DATA 586,6
DATA 329,3
DATA 348,3
DATA 522,6
DATA 329,3
DATA 348,6
DATA 586,6
DATA 329,3
DATA 348,3
DATA 658,6
DATA 329,3
DATA 348,3
DATA 738,6
DATA 329,3
DATA 348,3
DATA 829,6
DATA 329,3
DATA 348,3
DATA 878,6
DATA 329,3
DATA 348,3
DATA 586,6
DATA 329,3
DATA 348,3
DATA 1044,6
DATA 329,3
DATA 348,3
DATA 985,6
DATA 329,3
DATA 348,3
DATA 878,6
DATA 329,3
DATA 348,3
DATA 829,6
DATA 329,3
DATA 348,3
DATA 738,6
DATA 329,3
DATA 348,3
DATA 658,6
DATA 329,3
DATA 348,3
DATA 738,6
DATA 329,3
DATA 348,3
DATA 829,6
DATA 329,3
DATA 348,3
DATA 878,6
DATA 329,3
DATA 348,3
DATA 985,6
DATA 329,3
DATA 348,3
DATA 1044,6
DATA 329,3
DATA 348,3
DATA 738,6
DATA 329,3
DATA 348,3
DATA 1315,6
DATA 329,3
DATA 348,3
DATA 1172,6
DATA 329,3
DATA 348,3
DATA 1044,6
DATA 329,3
DATA 348,3
DATA 985,6
DATA 329,3
DATA 348,3
DATA 878,6
DATA 829,6
DATA 329,6
DATA 878,6
DATA 0,6
DATA 985,6
DATA 658,6
DATA 1044,6
DATA 0,6
DATA 1172,6
DATA 586,6
DATA 1315,6
DATA 0,6
DATA 878,6
DATA 522,6
DATA 1394,6
DATA 0,6
DATA 1315,6
DATA 493,6
DATA 1172,6
DATA 0,6
DATA 1044,6
DATA 439,6
DATA 985,6
DATA 0,6
DATA 1756,6
DATA 586,6
DATA 1657,6
DATA 0,6
DATA 1476,6
DATA 658,6
DATA 1315,6
DATA 0,6
DATA 1756,6
DATA 697,6
DATA 1756,6
DATA 0,6
DATA 1756,6
DATA 586,6
DATA 1172,6
DATA 0,6
DATA 985,3
DATA 1044,3
DATA 658,6
DATA 985,3
DATA 1044,3
DATA 0,6
DATA 985,3
DATA 1044,3
DATA 329,6
DATA 878,6
DATA 0,6
DATA 878,6
DATA 439,6
DATA 878,6
DATA 219,6
DATA 878,6
DATA 233,6
DATA 878,6
DATA 261,6
DATA 930,6
DATA 293,6
DATA 1044,6
DATA 310,6
DATA 586,6
DATA 185,6
DATA 0,6
DATA 310,6
DATA 738,6
DATA 293,6
DATA 0,6
DATA 261,6
DATA 878,6
DATA 233,6
DATA 0,6
DATA 219,6
DATA 930,6
DATA 196,6
DATA 782,6
DATA 196,6
DATA 878,6
DATA 196,6
DATA 930,6
DATA 196,6
DATA 1044,6
DATA 219,6
DATA 1172,6
DATA 233,6
DATA 658,6
DATA 131,6
DATA 1172,6
DATA 0,6
DATA 1044,6
DATA 196,6
DATA 930,6
DATA 0,6
DATA 878,6
DATA 261,6
DATA 782,6
DATA 0,6
DATA 878,6
DATA 348,6
DATA 0,6
DATA 391,6
DATA 1394,6
DATA 439,6
DATA 1315,6
DATA 493,6
DATA 1394,6
DATA 553,6
DATA 0,6
DATA 586,6
DATA 782,6
DATA 329,6
DATA 0,6
DATA 586,6
DATA 1315,6
DATA 553,6
DATA 0,6
DATA 493,6
DATA 0,6
DATA 439,6
DATA 0,6
DATA 391,6
DATA 1172,6
DATA 348,6
DATA 1315,6
DATA 0,6
DATA 1394,6
DATA 439,6
DATA 1564,6
DATA 0,6
DATA 1756,6
DATA 586,6
DATA 1860,6
DATA 0,6
DATA 1106,6
DATA 329,6
DATA 1860,6
DATA 0,6
DATA 1756,6
DATA 391,6
DATA 1564,6
DATA 0,6
DATA 1394,6
DATA 553,6
DATA 1315,6
DATA 0,6
DATA 1394,6
DATA 293,6
DATA 0,6
DATA 329,6
DATA 1172,6
DATA 348,6
DATA 0,6
DATA 391,6
DATA 782,6
DATA 439,6
DATA 782,6
DATA 465,6
DATA 782,6
DATA 277,6
DATA 1172,6
DATA 465,6
DATA 1106,6
DATA 439,6
DATA 1315,6
DATA 391,6
DATA 878,6
DATA 348,6
DATA 1106,6
DATA 329,6
DATA 1172,6
DATA 348,6
DATA 985,6
DATA 391,6
DATA 1106,3
DATA 1172,3
DATA 439,6
DATA 1106,3
DATA 1172,3
DATA 0,6
DATA 1106,3
DATA 1172,3
DATA 219,6
DATA 1172,6
DATA 0,6
DATA 1172,6
DATA 233,6
DATA 1044,6
DATA 233,6
DATA 930,6
DATA 233,6
DATA 878,6
DATA 261,6
DATA 782,6
DATA 233,6
DATA 697,6
DATA 219,6
DATA 930,8
DATA 196,8
DATA 553,8
DATA 465,8
DATA 586,8
DATA 439,8
DATA 658,8
DATA 391,8
DATA 697,8
DATA 348,8
DATA 782,8
DATA 329,8
DATA 878,9
DATA 348,9
DATA 1172,9
DATA 391,9
DATA 697,9
DATA 439,9
DATA 697,9
DATA 439,9
DATA 658,9
DATA 219,9
DATA 586,9
DATA 219,9
DATA 586,6
DATA 146,6
DATA 586,6
DATA 146,6
DATA 586,6
DATA 146,6
DATA 586,6
DATA 146,6
DATA 586,6
DATA 146,6
DATA 586,6
DATA 146,6
DATA 586,6
DATA 146,6
DATA 586,6
DATA 146,6
DATA 586,6
DATA 146,6
DATA -1,-1
'
' end of data
'


BIN
Borland Turbo BASIC v11/QATTR.BIN Normal file
View File

Binary file not shown.

BIN
Borland Turbo BASIC v11/QFILL.BIN Normal file
View File

Binary file not shown.

BIN
Borland Turbo BASIC v11/QPRINT.BIN Normal file
View File

Binary file not shown.

BIN
Borland Turbo BASIC v11/QPRINTC.BIN Normal file
View File

Binary file not shown.

BIN
Borland Turbo BASIC v11/QREST.BIN Normal file
View File

Binary file not shown.

BIN
Borland Turbo BASIC v11/QSAVE.BIN Normal file
View File

Binary file not shown.

20
Borland Turbo BASIC v11/SIEVE.BAS Normal file
View File

@ -0,0 +1,20 @@
1 SIZE% = 8190
2 DIM FLAGS%(8191)
3 PRINT "10 iterations"
4 FOR X% = 1 TO 10
5 COUNT% = 0
6 FOR I% = 0 TO SIZE%
7 FLAGS%(I%) = 1
8 NEXT I%
9 FOR I% = 0 TO SIZE%
10 IF FLAGS%(I%) = 0 THEN 18
11 PRIME% = I% + I% + 3
12 K% = I% + PRIME%
13 IF K% > SIZE% THEN 17
14 FLAGS%(K%) = 0
15 K% = K% + PRIME%
16 GOTO 13
17 COUNT% = COUNT% + 1
18 NEXT I%
19 NEXT X%
20 PRINT COUNT%," PRIMES"

BIN
Borland Turbo BASIC v11/TB.EXE Normal file
View File

Binary file not shown.

BIN
Borland Turbo BASIC v11/TBCONFIG.TB Normal file
View File

Binary file not shown.

655
Borland Turbo BASIC v11/TBDEMO30.BAS Normal file
View File

@ -0,0 +1,655 @@
' TBWINDO
' MULTI-LEVEL WINDOWS
' FOR TURBO BASIC
' Version 3.0
'
'PURPOSE:
' This utility creates incredibly quick multi-level windows
' in Turbo Basic programs for IBM PC/XT/AT compatibles.
'
'TEST DRIVE:
' Compile and run the tutoring program TBDEMO30.BAS to get a
' feel for features and speed.
'
'
'FILES:
' TBWINDO.INC - Turbo Basic window include file
' TBMENU.INC - Menu include file
' QPRINT.BIN - Quick print inline subroutine
' QPRINTC.BIN - Quick print between columns
' QATTR.BIN - Re-attribute an area of the screen
' QFILL.BIN - Fill an area of the screen with a
' specified character and attribute
' QSAVE.BIN - Save portion of screen
' QREST.BIN - Restore portion of screen
' RECOLOR.BIN - Screen area recoloring
' TBDEMO30.BAS - Demonstration program source code
'
' Assembly language source code for all BIN files is
' included for all those interested. Any Suggestions for
' improvements to the code would be appreciated, as I do not
' profess to be good at Assembly language.
'
'USING TBWINDO
' Include the TBWINDO.INC program in your program with the
' following statement:
'
' $INCLUDE "TBWINDO.INC"
'
' Set MW% variable equal to the maximum number of windows
' you will have open at any one time.
'
' Set the ScrnArray variable equal to the estimated total
' memory required to save your screens. If you expreience a
' subscript out of range error in the include file, increase
' this variable. As a rough rule of thumb, start out with
' the variable equal to 250 times the maximum windows (mw%)
' variable.
'
' You invoke the routines by means of a CALL with a list of
' parameters, rather than a GOSUB.
'
' Using the MAKEWINDOW procedure:
'
' CALL
' MAKEWINDOW(ROW%,COL%,ROWS%,COLS%,ATTR%,BRDRSEL%,SHADOW%,ZO
' OM%)
'
' Where: ROW - the screen row of the upper left hand corner
' of your desired window. Value should be
' between 2 and 23 (for reasons explained
' below). WARNING - the subroutine does not
' check for proper values. You must check these
' yourself or accept the consequences.
'
' COL - the screen column of the upper left hand
' corner. Value should be between 2 and 79.
'
' ROWS - the number of rows long the window should be.
'
' COLS - the number of columns wide the window should
' be.
'
' ATTR - the attribute of the window colors.
'
' BRDRSEL - the border you desire around the window.
' Valid selections in this release are:
'
' 0 - No Frame (just a border of BACKground
' color.)
' 1 - Single Line Frame
' 2 - Double Line Frame
' 3 - Single Horizontal Line, Double Vertical
' Line
' 4 - Single Vertical Line, Double Horizontal
' Line
'
' SHADOW - Another "switch" to indicate if the window
' should have a black "shadow" under it offset
' down. This gives a three-dimensional effect
' that seems to "raise" the window away from the
' screen. A value of 1 indicates a shadow is
' desired on the left side, a value of 2
' indicates the right side, while a value of 0
' means no shadow.
'
' ZOOM - A "switch" used to indicate to the subroutine
' if the window should "grow" from a small box
' at the midpoints of the coordinates to full
' size. A value of 1 indicates the window should
' grow. A value of 0 indicates it should not.
'
'
'
' using the TITLEWINDOW procedure:
'
' CALL TITLEWINDOW(LOC%,TITLE$)
'
' Where: LOC - Indicates where the title should be placed.
' Valid selections are:
'
' 1 - Top left hand corner
' 2 - Top center
' 3 - Top right hand corner
' 4 - Lower left hand corner
' 5 - Lower center
' 6 - Lower right hand corner
'
' TITLE - The string data you would like printed.
'
' NOTE: The TITLEWINDOW procedure uses the coordinates from
' the most recent use of MAKEWINDOW. Use this
' procedure only after a call has been made to
' MAKEWINDOW.
'
'
' Using the RemoveWindow procedure:
'
' CALL REMOVEWINDOW
'
' There are no parameters passed to this procedure. The
' window created by the last call to MakeWindow is removed
' from the screen.
'
' Using the ClearWindow procedure:
'
' CALL CLEARWINDOW
'
' There are no parameters pass to this procedure. The
' window created by the last call to MakeWindow is cleared
' inside the frame.
'
' Using the PrtWindow procedure:
'
' CALL PRTWINDOW(ROW%,COL%,STRDAT%)
'
' Where: ROW - Is the row within the window you want to
' print on.
'
' COL - Is the column within the window where you
' want printing to start.
'
' NOTE: The ROW and COL coordinates are relative to the
' current window. Row 1 Col 1 refers to the first
' character position inside the frame in the upper
' left corner. No parameter checking is done so if
' the string data exceeds the width of the window it
' will spill out the right side.
'
' STRDAT - Is the string data you want printed inside
' the window.
'
'
' Using the PrtCWindow procedure:
'
' CALL PRTCWINDOW(ROW%,STRDAT$)
'
' Where: ROW - Is the row within the window you to have
' your string data centered on.
'
' STRDAT - Is the string data you want printed within
' the window.
'
' NOTE: This procedure uses the current window and will
' attempt to center the string data between the left
' border and the right border. No parameter checking
' is done so if the string data exceeds the width of
' the window, it will spill out the sides.
'
' Using the FNATTR% function:
'
' FNATTR%(FORE%,BACK%)
'
' Where: FORE - is the foreground color. Any Turbo Basic
' color number is valid.
'
' BACK - is the backgound color. Any Turbo Basic
' background color is valid.
'
' FNATTR% returns the attribute of the colors specified.
'
'
' Using the RECOLOR procedure:
'
' CALL RECOLOR(OLDATTR%,NEWATTR%,SNOCHK%)
'
' Where: OLDATTR - Is the attribute of the areas on the
' screen you wish to change.
'
' NEWATTR - Is the attribute of the color you want.
'
' X% = SCREEN(1,1,1) ' RETURNS CURRENT SCREEN
' ' ATTRIBUTE
' CALL RECOLOR(X%,FNATTR%(14,4))
'
' This will recolor everything on the screen that
' has the same attribute a the upper left corner of
' the screen to a foreground of 14 and a background
' of 4.
'
' Using the MAKEMENU procedure:
'
' CALL MAKEMENU
'
' You must define several variable before you call the
' MakeMenu procedure. First define the selections available
' to the user in a string array named item$(). If you want
' a title on your menu assign it to the variable mtitle$.
' Assign the total selections available to itemcount% and
' the starting selection number to startpos%. The remaining
' information required is almost identical to defining
' window in the MakeWindow procedure.
'
' Where: MROW - the screen row of the upper left hand corner
' of your desired menu. Value should be
' between 2 and 23 (for reasons explained
' below). WARNING - the subroutine does not
' check for proper values. You must check
' these yourself or accept the consequences.
'
' MCOL - the screen column of the upper left hand
' corner. Value should be between 2 and 79.
'
' MWIDTH - The width of the menu. Be sure this value
' is greater than the longest string assigned
' to a selection.
'
' MATTR - the attribute of the menu colors.
'
' MHIATTR - the attribute of the moving selection bar.
'
' MBRDRSEL - the border you desire around the menu. (See
' above)
'
' MSHADOW - Switch to indicate if the menu should have a
' shadow.
'
' MZOOM - Switch to indicate if the menu should grow.
'
' When a selection has be made in the MakeMenu procedure the
' item number selected will be assigned to the variable
' curntpos%. You can now use this number to direct the flow
' of you main program. Please see the source code of the
' demo program for a better understanding.
'
' All of the above variables with the exception of the
' string variables must either be declared globally as
' integers by means of a DEFINT statement early in the
' program; or must have the specific integer identifier
' (%) attached wherever they appear in the program. The
' BASIC compiler is picky about this; so be sure to
' verify that the type assignment is correct.
'
' TBWINDO requires no special handling when it comes to
' compiling your program. Just make certain that all of
' your variables passing parameters to the TBWINDO
' subroutine are identified as integers, and you will be
' able to proceed with the compile operation as with any
' other program.
'
'
' ACKNOWLEDGEMENTS
'
' I would like to express my thanks to Dave Evers
' (BASWIN22), Tom Hanlin (ADVBAS33) and Jim LeMay
' (WINDOW33).
'
' These utilities are released into the public domain for
' anyone to use as they see fit however, anyone who feels
' inspired and would like to contribute to my printer paper
' and computer supplies fund may feel free to do so.
'
' Rick Fothergill
' 141 Oak Hill Road
' Pittsfield, MA 01201
' (413) 442-2456
'
' GEnie Address: R.FOTHERGILL
' Compuserve: 76210,443
'
'
' TBWINDO QUICK REFERENCE
'
' MakeWindow(Row%,Col%,Rows%,Cols%,Attr%,BrdrSel%,Shadow%,Zoom%)
'
' TitleWindow(Loc%,Title$)
'
' RemoveWindow
'
' ClearWindow
'
' MakeMenu
'
' PrtWindow(Row%,Col%,StrDat$)
'
' PrtCWindow(Row%,StrDat$)
'
' FNAttr%(Fore%,Back%)
'
' Qsave(Row%,Col%,Rows%,Cols%,Scrn%(??))
'
' QRest(Row%,Col%,Rows%,Cols%,Scrn%(??))
'
' ReColor(OldAttr%,NewAttr%,SnoChk%)
'
' Qprint(Row%,Col%,StrDat$,Attr%)
'
' QprintC(Row%,ColLeft%,ColRight%,StrDat$,Attr%)
'
' QFill(Row%,Col%,Rows%,Cols%,Char%,Attr%)
'
' QAttr(Row%,Col%,Rows%,Cols%,Attr%)
'
' QBox(Row%,Col%,Rows%,Cols%,Attr%,BrdrSel%)
'
'
'Demonstration of TBWINDO
$INCLUDE "TBWINDO.INC"
$INCLUDE "TBMENU.INC"
key off
out &H3d9,1
call qfill(1,1,25,80,32,fnattr%(7,1))
for m% = 1 to 3
for i% = 1 to 29
j% = rnd(1)*69
k% = rnd(1)*19
f% = rnd(1)*14
b% = rnd(1)*6
call makewindow(k%+1,j%+1,5,11,fnattr%(f%+1,b%+1),2,0,0)
call prtcwindow(2,"WINDOW")
next
if (m = 3) then delay 3 else delay 1
for x = LI to 1 step -1
call removewindow
next
next
'Put up opening screen
'4 windows of different colors and a Title Window
call makewindow(4,15,10,30,fnattr%(4,3),4,1,1)
call makewindow(3,36,13,40,fnattr%(15,2),3,1,1)
call makewindow(9,10,13,40,fnattr%(0,5),2,1,1)
call makewindow(12,42,11,36,fnattr%(3,4),1,1,1)
call makewindow(3,5,7,40,fnattr%(0,7),2,1,1)
call prtcwindow(3,"Presenting...")
delay 4
call makewindow(8,20,7,40,fnattr%(0,7),2,1,1)
call prtcwindow(1,"T B W I N D O")
call prtcwindow(2,"2.0")
call prtcwindow(4,"Windowing Routines for the")
call prtcwindow(5,"Borland Turbo BASIC Compiler")
delay 3
call makewindow(17,55,7,24,fnattr%(0,6),1,1,1)
call prtwindow(1,2,"By:")
call prtcwindow(3,"Rick Fothergill")
call prtcwindow(4,"141 Oak Hill Road")
call prtcwindow(5,"Pittsfield, MA 01201")
delay 4
call makewindow(5,5,10,32,fnattr%(15,1),2,1,0)
call prtcwindow(1,"Including ...")
call prtcwindow(3,"*** Window Tools ***")
call prtcwindow(5,"A collection of routines")
call prtcwindow(6,"for integration into your")
call prtcwindow(7,"own programs.")
delay 4
call makewindow(8,25,10,32,fnattr%(15,1),2,1,0)
call prtwindow(1,2," * * * * * * * * * * * * * ")
call prtwindow(3,2,"Stand by for a guided tour")
call prtwindow(5,2,"through the many facets of")
call prtwindow(7,2,"this exciting program.")
delay 2
for x = 1 to 9
call removewindow
next
call makewindow(9,16,8,52,fnattr%(0,7),2,0,0)
call prtwindow(1,2,"The basic purpose of TBWINDO is to provide")
call prtwindow(2,2,"the fundamental routines for implementing")
call prtwindow(3,2,"simple 'windowing' into your Turbo BASIC pro-")
call prtwindow(4,2,"grams. With just a few simple statements,")
call prtwindow(5,2,"you can 'pop-up' a colored window onto the")
call prtwindow(6,2,"screen; just like this ...")
delay 3
call clearwindow
call prtwindow(2,2,"The window can be a solid panel of any of")
call prtwindow(4,2,"the BASIC background colors; such as ...")
delay 4
call makewindow(2,2,7,35,fnattr%(1,2),0,0,0)
delay 3
call removewindow
call clearwindow
call prtwindow(2,2,"or it can be surrounded by a 'frame' in any")
call prtwindow(4,2,"of five styles...")
delay 3
call makewindow(5,5,8,35,fnattr%(9,5),1,0,0)
call titlewindow(1,"[ Frame Style 1 ]")
call makewindow(8,8,8,35,fnattr%(12,3),2,0,0)
call titlewindow(2,"[ Frame Style 2 ]")
call makewindow(11,11,8,35,fnattr%(15,4),3,0,0)
call titlewindow(3,"[ Frame Style 3 ]")
call makewindow(14,14,8,35,fnattr%(0,6),4,0,0)
call titlewindow(1,"[ Frame Style 4 ]")
call makewindow(17,17,8,35,fnattr%(0,2),5,0,0)
call titlewindow(3,"[ Frame Style 5 ]")
delay 4
for x = 1 to 5
call removewindow
next
call clearwindow
call prtwindow(1,2,"The frame itself can be in any one of the")
call prtwindow(2,2,"BASIC foreground colors. It can even blink")
call prtwindow(3,2,"if you want...")
delay 3
for i%=0 to 15
label$="[ Color:"+str$(i%)+" ]"
j%=rnd(1)*50
k%=rnd(1)*12
call makewindow(k%+1,j%+1,7,25,fnattr%(i%,5),4,2,0)
call titlewindow(2,label$)
delay .5
next
call makewindow(7,20,7,25,fnattr%(31,5),4,2,0)
call titlewindow(2,"[ Color: 31 ]")
delay 4
for x = 1 to 17
call removewindow
next
call clearwindow
call prtcwindow(5,"The window itself can be presented in many")
call prtcwindow(6,"different ways. It can be flat...")
delay 3
call makewindow(1,2,11,30,fnattr%(15,4),1,0,0)
delay 3
call removewindow
call clearwindow
call prtcwindow(5,"or it can have a black shadow underneath; giving")
call prtcwindow(6,"a three-dimensional effect...")
delay 3
call makewindow(5,5,10,30,fnattr%(14,5),2,1,0)
call qprintc(7,5,35,"Left Shadow",fnattr%(15,5))
delay 2
call makewindow(5,40,10,30,fnattr%(0,2),2,2,0)
call qprintc(7,40,70,"Right Shadow",fnattr%(15,2))
delay 2
call removewindow
call removewindow
call clearwindow
call prtcwindow(2,"Titles may be placed in any")
call prtcwindow(3,"of six different locations,")
call prtcwindow(4,"or any combination.")
delay 2
call makewindow(2,5,10,70,fnattr%(15,5),2,1,0)
for x% = 1 to 6
title$ = "[ Location"+str$(x%)+" ]"
call titlewindow(x%,title$)
delay 1
next
delay 3
call removewindow
call clearwindow
call prtcwindow(3,"Windows can be zoomed")
call prtcwindow(4,"onto the screen.")
delay 2
call makewindow(2,2,15,60,fnattr%(0,2),2,0,1)
delay 2
call makewindow(13,10,10,60,fnattr%(1,3),3,0,1)
delay 2
call makewindow(7,33,10,45,fnattr%(14,5),1,0,1)
delay 2
call makewindow(7,10,12,63,fnattr%(15,4),2,1,1)
call prtcwindow(5,"W O W !!!")
delay 3
for x = 1 to 4
call removewindow
next
call clearwindow
call prtwindow(1,2,"Once you have your window on the screen, simply")
call prtwindow(2,2,"use calls to PrtWindow or PrtCWindow to put text")
call prtwindow(3,2,"in them. A call to ClearWindow will erase the")
call prtwindow(4,2,"contents of the window ... ")
delay 3
call clearwindow
call prtwindow(1,2,"Just as easily as you can create the window!")
call prtwindow(2,2,"In fact, all of the commands of TBWINDO are")
call prtwindow(3,2,"very easy to use. Here is a call to create")
call prtwindow(4,2,"this window ...")
call prtwindow(5,2," CALL MAKEWINDOW(8,14,8,52,fnattr%(0,7),2,0,1)")
delay 5
call clearwindow
call prtwindow(1,2,"Each window is stored as a result of a call to")
call prtwindow(2,2,"MakeWindow. To restore the screen to it's")
call prtwindow(3,2,"original contents, simply call RemoveWindow.")
call prtwindow(4,2,"Here is a good example . . .")
delay 5
call makewindow(3,5,15,45,fnattr%(0,2),4,1,1)
call prtcwindow(6,"This is the first level ...")
delay 2
call makewindow(6,29,17,50,fnattr%(15,4),4,1,1)
call prtcwindow(6,"This is the second level ...")
delay 2
call makewindow(9,22,15,35,fnattr%(0,3),4,1,1)
call prtcwindow(7,"This is the third level ...")
delay 2
call prtcwindow(7,"Now to go back ... ")
delay 1
call removewindow
delay 1
call removewindow
delay 1
call removewindow
delay 2
call clearwindow
call prtwindow(2,2,"Next is a demonstration of the MakeMenu")
call prtwindow(3,2,"procedure which will create a point and")
call prtwindow(4,2,"shoot type menu.")
delay 3
call removewindow
item$(1) = "Pop Screen 1"
item$(2) = "Pop Screen 2"
item$(3) = "Pop Screen 3"
item$(4) = "Exit"
itemcount% = 4
mtitle$ = "[ MENU DEMO ]"
mrow% = 5
mcol% = 20
mwidth% = 40
mattr% = fnattr%(15,1)
mhiattr% = fnattr%(0,7)
mbrdrsel% = 2
mshadow% = 2
mzoom% = 0
startpos% = 1
restart1:
out &H03d9,7
call qfill(1,1,25,80,32,fnattr%(0,7))
call makemenu
select case curntpos%
case 1 'screen 1
gosub popscreen1
goto restart1
case 2 ' screen 2
gosub popscreen2
goto restart1
case 3 ' screen 3
gosub popscreen3
goto restart1
case else
out &H03d9,1
call qfill(1,1,25,80,32,fnattr%(15,1))
color 0,7
call makewindow(9,16,8,52,fnattr%(0,7),2,0,0)
locate 10,18:print "Please see the source code and documentation"
locate 11,18:print "for how to create and use menu windows in"
locate 12,18:print "your programs...."
delay 5
end select
call makewindow(4,15,10,30,fnattr%(4,3),4,1,1)
call makewindow(3,36,13,40,fnattr%(15,2),3,1,1)
call makewindow(9,10,13,40,fnattr%(0,5),2,1,1)
call makewindow(12,42,11,36,fnattr%(3,4),1,1,1)
call makewindow(9,16,8,52,fnattr%(0,7),2,1,1)
call prtwindow(2,2,"The basic routines in the TBWINDO package")
call prtwindow(3,2,"give you all you need to create some power-")
call prtwindow(4,2,"ful 'toolbox' modules to integrate into your")
call prtwindow(5,2,"programs.")
delay 5
out &H3d9,0
end
popscreen1:
out &H03d9 ,6
call qfill(1,1,25,80,32,fnattr%(7,6))
call makewindow(8,10,7,60,fnattr(0,2),2,1,1)
call titlewindow(2,"[ SELECTION 1 ]")
call qprintc(10,10,70,"This is selection no. 1",fnattr(14,2))
call qprintc(11,10,70,"Press enter to return to main menu...",fnattr%(14,2))
while not instat
wend
a$=inkey$
call removewindow
return
popscreen2:
out &H03d9 ,3
call qfill(1,1,25,80,32,fnattr%(7,3))
call makewindow(8,10,7,60,fnattr(15,1),2,1,1)
call titlewindow(2,"[ SELECTION 2 ]")
call qprintc(10,10,70,"This is selection no. 2",fnattr(15,1))
call qprintc(11,10,70,"Press enter to return to main menu...",fnattr%(15,1))
while not instat
wend
a$=inkey$
call removewindow
return
popscreen3:
out &H03d9 ,5
call qfill(1,1,25,80,32,fnattr%(7,5))
call makewindow(8,10,7,60,fnattr(0,7),2,1,1)
call titlewindow(2,"[ SELECTION 3 ]")
call qprintc(10,10,70,"This is selection no. 3",fnattr(0,7))
call qprintc(11,10,70,"Press enter to return to main menu...",fnattr%(0,7))
while not instat
wend
a$=inkey$
call removewindow
return


BIN
Borland Turbo BASIC v11/TBHELP.TBH Normal file
View File

Binary file not shown.

37
Borland Turbo BASIC v11/TBMENU.INC Normal file
View File

@ -0,0 +1,37 @@
sub makemenu static
shared wrow%(),wrows%(),wcol%(),wcols%(),wattr%(),wbrdr%(),wshdw%(),scrn%(),wptr(),LI
shared mrow%,mcol%,mwidth%,mattr%,mhiattr%,mbrdrsel%,mshadow%,mzoom%,mtitle$
shared item$(),itemcount%,startpos%
shared curntpos%
call makewindow(mrow%,mcol%,itemcount%+2,mwidth%,mattr%,mbrdrsel%,mshadow%,mzoom%)
call titlewindow(2,mtitle$)
for mloop% = 1 to itemcount%
call qprintc(wrow%(LI)+mloop%,wcol%(LI),wcol%(LI)+wcols%(LI),item$(mloop%),wattr%(LI))
next
if curntpos% = 0 then if startpos% = 0 then curntpos% = 1 else curntpos% = startpos%
tryagain:
call qattr(wrow%(LI)+curntpos%,wcol%(LI)+1,1,wcols%(LI)-2,mhiattr%)
while not instat
wend
ans$=inkey$
if len(ans$)=2 then ans$=right$(ans$,1)
call qattr(wrow%(LI)+curntpos%,wcol%(LI)+1,1,wcols%(LI)-2,wattr%(LI))
select case ans$
case chr$(72),chr$(75),"-","8","4"
decr curntpos%
case chr$(80),chr$(77),"+","2","6"
incr curntpos%
case chr$(13)
call removewindow
exit sub
case chr$(27)
curntpos%=0
call removewindow
exit sub
case else
curntpos% = curntpos%
end select
if curntpos% > itemcount% then curntpos% = 1
if curntpos% < 1 then curntpos% = itemcount%
goto tryagain
end sub

202
Borland Turbo BASIC v11/TBWINDO.INC Normal file
View File

@ -0,0 +1,202 @@
mw% = 30
ScrnArray = 8000
dim wrow%(mw%),wrows%(mw%),wcol%(mw%),wcols%(mw%),wattr%(mw%),wbrdr%(mw%)
dim wshdw%(mw%),scrn%(ScrnArray),wptr(mw%)
sub MakeWindow(Row%,Col%,Rows%,Cols%,Attr%,BrdrSel%,Shadow%,Zoom%) static
shared wrow%(),wrows%(),wcol%(),wcols%(),wattr%(),wbrdr%(),wshdw%(),scrn%(),wptr(),LI
local r1%,r2%,c1%,c2%,colratio%,wsize
select case shadow%
Rem Left
case = 1
c1%=col%-2 : c2%=cols%+2 : r2%=rows%+1
Rem Right
case = 2
c1%=col% : c2%=cols%+2 : r2%=rows%+1
case else
c1%=col% : c2%=cols% : r2%=rows%
end select
wsize = (r2% * c2%) * 2
LI = LI + 1
Wptr(LI+1) = Wptr(LI)+WSize+1
WRow%(LI) = Row%
WCol%(LI) = Col%
WRows%(LI) = Rows%
WCols%(LI) = Cols%
Wattr%(LI) = Attr%
WBrdr%(LI) = BrdrSel%
WShdw%(LI) = Shadow%
Call Qsave(Row%,c1%,r2%,c2%,scrn%(Wptr(LI)))
if zoom% = 1 then
r1% = row% + (rows%\2)
r2% = row% + rows%-(rows%\2)
c1% = col% + (cols%\2)
c2% = col% + cols%-(cols%\2)
colratio% = (cols% \ rows%)+1
if colratio% > 4 then colratio%=4
do
if r1%>row% then r1%=r1%-1
if r2%<(row%+rows%) then r2%=r2%+1
if c1%>col% then c1%=c1%-colratio%
if c1%<col% then c1%=col%
if c2%<(col%+cols%) then c2%=c2%+colratio%
if c2%>(col%+cols%) then c2%=col%+cols%
call Qbox(r1%,c1%,r2%-r1%,c2%-c1%,attr%,brdrsel%)
loop until c1%=col% and c2%=col%+cols% and r1%=row% and r2%=row%+rows%
else
call Qbox(row%,col%,rows%,cols%,attr%,brdrsel%)
end if
select case shadow%
rem Left
case = 1
call qfill(row%+1 ,col%-2 ,rows%-1,2 ,asc(" "),0)
call qfill(row%+rows%,col%-2 ,1 ,cols%,asc(" "),0)
rem Right
case = 2
call qfill(row%+1 ,col%+cols%,rows%-1,2 ,asc(" "),0)
call qfill(row%+rows%,col%+2 ,1 ,cols%,asc(" "),0)
case else
end select
end sub
sub TitleWindow(dir%,title$) static
shared wrow%(),wcol%(),wrows%(),wcols%(),wattr%(),LI
select case dir%
rem UpperLeft
case = 1
call qprint(wrow%(LI),wcol%(LI)+2,title$,wattr%(LI))
rem UpperCenter
case = 2
call qprintc(wrow%(LI),wcol%(LI),wcol%(LI)+wcols%(LI)-1,title$,wattr%(LI))
rem UpperRight
case = 3
call qprint(wrow%(LI),wcol%(LI)+wcols%(LI)-len(title$)-2,title$,wattr%(LI))
rem LowerLeft
case = 4
call qprint(wrow%(LI)+wrows%(LI)-1,wcol%(LI)+2,title$,wattr%(LI))
rem LowerCenter
case = 5
call qprintc(wrow%(LI)+wrows%(LI)-1,wcol%(LI),wcol%(LI)+wcols%(LI)-1,title$,wattr%(LI))
rem LowerRight
case = 6
call qprint(wrow%(LI)+wrows%(LI)-1,wcol%(LI)+wcols%(LI)-len(title$)-2,title$,wattr%(LI))
case else
end select
end sub
sub RemoveWindow static
shared Wrow%(),WCol%(),WRows%(),Wcols%(),Wattr%(),WShdw%(),Scrn%(),Wptr(),LI
if LI = 0 then
print "NO WINDOW TO REMOVE"
else
select case WShdw%(LI)
case = 1
call qrest(Wrow%(LI),WCol%(LI)-2,WRows%(LI)+1,WCols%(LI)+2,Scrn%(Wptr(LI)))
case = 2
call qrest(WRow%(LI),WCol%(LI) ,WRows%(LI)+1,WCols%(LI)+2,Scrn%(Wptr(LI)))
case else
call qrest(WRow%(LI),Wcol%(LI) ,WRows%(LI) ,WCols%(LI) ,Scrn%(Wptr(LI)))
end select
LI = LI -1
end if
end sub
sub Qbox(Row%,Col%,Rows%,Cols%,attr%,BrdrSel%) static
if rows%>2 and cols%>2 then
if brdrsel% > 0 and brdrsel% < 6 then
on brdrsel% gosub single,double,mixed12,mixed21,doubleleftarrow
call qprint(row% ,col% ,tl$ ,attr%)
call qfill (row% ,col%+1 ,1 ,cols%-2,asc(th$),attr%)
call qprint(row% ,col%+cols%-1,tr$ ,attr%)
call qfill (row%+1 ,col% ,rows%-2,1 ,asc(lv$),attr%)
call qfill (row%+1 ,col%+cols%-1,rows%-2,1 ,asc(rv$),attr%)
call qprint(row%+rows%-1,Col% ,bl$ ,attr%)
call qfill (row%+rows%-1,Col%+1 ,1 ,cols%-2,asc(bh$),attr%)
call qprint(row%+rows%-1,col%+cols%-1,br$ ,attr%)
call qfill (row%+1 ,col%+1 ,rows%-2 ,cols%-2,asc(" "),attr%)
else
call qfill (row%,col%,rows%,cols%,asc(" "),attr%)
end if
end if
exit sub
Single:
TL$=CHR$(218):TH$=CHR$(196):TR$=CHR$(191)
LV$=CHR$(179):RV$=CHR$(179)
BL$=CHR$(192):BH$=CHR$(196):BR$=CHR$(217)
Return
Double:
TL$=CHR$(201):TH$=CHR$(205):TR$=CHR$(187)
LV$=CHR$(186):RV$=CHR$(186)
BL$=CHR$(200):BH$=CHR$(205):BR$=CHR$(188)
Return
Mixed12:
TL$=CHR$(214):TH$=CHR$(196):TR$=CHR$(183)
LV$=CHR$(186):RV$=CHR$(186)
BL$=CHR$(211):BH$=CHR$(196):BR$=CHR$(189)
Return
Mixed21:
TL$=CHR$(213):TH$=CHR$(205):TR$=CHR$(184)
LV$=CHR$(179):RV$=CHR$(179)
BL$=CHR$(212):BH$=CHR$(205):BR$=CHR$(190)
Return
DoubleLeftArrow:
TL$=CHR$(17):TH$=CHR$(205):TR$=CHR$(187)
LV$=CHR$(186):RV$=CHR$(186)
BL$=CHR$(200):BH$=CHR$(205):BR$=CHR$(188)
Return
end sub
sub ClearWindow static
shared wrow%(),wcol%(),wrows%(),wcols%(),wattr%(),LI
call qfill (wrow%(LI)+1,wcol%(LI)+1,wrows%(LI)-2,wcols%(LI)-2,asc(" "),wattr%(LI))
end sub
sub PrtWindow(row%,col%,StrDat$) static
shared wrow%(),wcol%(),wrows%(),wcols%(),wattr%(),LI
call qprint(wrow%(LI)+row%,wcol%(LI)+col%,StrDat$,wattr%(LI))
end sub
sub PrtCWindow(row%,StrDat$) static
shared wrow%(),wcol%(),wrows%(),wcols%(),wattr%(),LI
call qprintc(wrow%(LI)+row%,wcol%(LI),wcol%(LI)+wcols%(LI),StrDat$,wattr%(LI))
end sub
def fnattr%(fore%,back%)
local temp%
temp%=(back%*16)+fore%
if fore%>15 then temp% = temp% + 112
fnattr% = temp%
end def
SUB QPRINT INLINE
$INLINE "QPRINT.BIN"
END SUB
rem CALL QPRINT(ROW%,COL%,STR$,ATTR%)
SUB QPRINTC INLINE
$INLINE "QPRINTC.BIN"
END SUB
rem CALL QPRINTC(ROW%,COLL%,COLR%,STRDAT$,ATTR%)
SUB QFILL INLINE
$INLINE "QFILL.BIN"
END SUB
rem CALL QFILL(ROW%,COL%,ROWS%,COLS%,CHAR%,ATTR%)
SUB QATTR INLINE
$INLINE "QATTR.BIN"
END SUB
rem CALL QATTR(ROW%,COL%,ROWS%,COLS%,ATTR%)
SUB QSAVE INLINE
$INLINE "QSAVE.BIN"
END SUB
rem CALL QSAVE(ROW%,COL%,ROWS%,COLS%,SCRN%(??))
SUB QREST INLINE
$INLINE "QREST.BIN"
END SUB
rem CALL QREST(ROW%,COL%,ROWS%,COLS%,SCRN%(??))

142
Borland Turbo BASIC v11/TTT.BAS Normal file
View File

@ -0,0 +1,142 @@
1 rem Tic Tac Toe solving app that learns what WOPR learned: you can't win
2 rem Only three starting positions are examined. Others are just reflections of these
3 rem b% -- The board
4 rem al% -- Alpha, for pruning
5 rem be% -- Beta, for pruning
6 rem l% -- Top-level loop iteration
7 rem wi% -- The winning piece (0 none, 1 X, 2, O )
8 rem re% -- Resulting score of 4000/minmax board position. 5 draw, 6 X win, 4 Y win
9 rem sx% -- Stack array for "recursion" X can be P, V, A, or B for those variables.
10 rem v% -- Value of a board position
11 rem st% -- Stack Pointer. Even for alpha/beta pruning Minimize plys, Odd for Maximize
12 rem p% -- Current position where a new piece is played
14 rem rw% -- Row in the Winner function (2000)
15 rem cw% -- Column in the Winner function (2000)
18 rem mc% -- Move count total for debugging. Should be a multiple of 6493
19 rem Note: Can't use real recursion with GOSUB because stack is limited to roughly 5 deep
20 rem BASIC doesn't support goto/gosub using arrays for target line numbers
21 rem this version is modified for Turbo Basic to send results to the console
29 it% = 10
30 dim b%(9)
32 dim sp%(10)
34 dim sv%(10)
36 dim sa%(10)
37 dim sb%(10)
38 mc% = 0
39 s1$ = "start time: " + time$
40 for l% = 1 to it%
41 mc% = 0
42 al% = 2
43 be% = 9
44 b%(0) = 1
45 gosub 4000
58 al% = 2
59 be% = 9
60 b%(0) = 0
61 b%(1) = 1
62 gosub 4000
68 al% = 2
69 be% = 9
70 b%(1) = 0
71 b%(4) = 1
72 gosub 4000
73 b%(4) = 0
80 next l%
85 s2$ = "end time: " + time$
87 s$ = s1$
88 gosub 1000
89 s$ = s2$
90 gosub 1000
92 s$ = "for " + str$( it% ) + " iterations"
93 gosub 1000
94 s$ = "move count: " + str$( mc% )
95 gosub 1000
98 system
99 end
999 rem turbo basic sends print output to memory, which isn't helpful
1000 l% = len( s$ )
1010 for i% = 1 to l%
1020 c$ = mid$( s$, i%, 1 )
1040 reg 4, asc( c$)
1050 reg 1, &h0600
1060 call interrupt &h21
1070 next i%
1080 reg 4, 10
1090 reg 1, &h0600
1100 call interrupt &h21
1110 reg 4, 13
1120 reg 1, &h0600
1130 call interrupt &h21
1200 return
2000 wi% = b%( 0 )
2010 if 0 = wi% goto 2100
2020 if wi% = b%( 1 ) and wi% = b%( 2 ) then return
2030 if wi% = b%( 3 ) and wi% = b%( 6 ) then return
2100 wi% = b%( 3 )
2110 if 0 = wi% goto 2200
2120 if wi% = b%( 4 ) and wi% = b%( 5 ) then return
2200 wi% = b%( 6 )
2210 if 0 = wi% goto 2300
2220 if wi% = b%( 7 ) and wi% = b%( 8 ) then return
2300 wi% = b%( 1 )
2310 if 0 = wi% goto 2400
2320 if wi% = b%( 4 ) and wi% = b%( 7 ) then return
2400 wi% = b%( 2 )
2410 if 0 = wi% goto 2500
2420 if wi% = b%( 5 ) and wi% = b%( 8 ) then return
2500 wi% = b%( 4 )
2510 if 0 = wi% then return
2520 if wi% = b%( 0 ) and wi% = b%( 8 ) then return
2530 if wi% = b%( 2 ) and wi% = b%( 6 ) then return
2540 wi% = 0
2550 return
4000 rem minmax function to find score of a board position
4010 rem recursion is simulated with gotos
4030 st% = 0
4040 v% = 0
4060 re% = 0
4100 mc% = mc% + 1
4102 rem gosub 3000
4104 if st% < 4 then goto 4150
4105 gosub 2000
4106 if 0 = wi% then goto 4140
4110 if wi% = 1 then re% = 6: goto 4280
4115 re% = 4
4116 goto 4280
4140 if st% = 8 then re% = 5: goto 4280
4150 if st% and 1 then v% = 2 else v% = 9
4160 p% = 0
4180 if 0 <> b%(p%) then goto 4500
4200 if st% and 1 then b%(p%) = 1 else b%(p%) = 2
4210 sp%(st%) = p%
4230 sv%(st%) = v%
4245 sa%(st%) = al%
4246 sb%(st%) = be%
4260 st% = st% + 1
4270 goto 4100
4280 st% = st% - 1
4290 p% = sp%(st%)
4310 v% = sv%(st%)
4325 al% = sa%(st%)
4326 be% = sb%(st%)
4328 b%(p%) = 0
4330 if st% and 1 then goto 4340
4331 if re% = 4 then goto 4530
4332 if re% < v% then v% = re%
4334 if v% < be% then be% = v%
4336 if be% <= al% then goto 4520
4338 goto 4500
4340 if re% = 6 then goto 4530
4341 if re% > v% then v% = re%
4342 if v% > al% then al% = v%
4344 if al% >= be% then goto 4520
4500 p% = p% + 1
4505 if p% < 9 then goto 4180
4520 re% = v%
4530 if st% = 0 then return
4540 goto 4280


2
Borland Turbo BASIC v11/m.bat Normal file
View File

@ -0,0 +1,2 @@
rem turbo basic doesn't support command-line build. Use the app to load and compile