Thursday, September 29, 2011
Monday, September 26, 2011
What is FreeBASIC ??
FreeBASIC is a free/open source (GPL), 32-bit BASIC compiler for Microsoft Windows, DOS and Linux.
When used in its "QB" language mode " -lang qb " for compatibility,, FreeBASIC provides a high level of support for programs written for QuickBASIC. Many programs written for QuickBASIC will compile and run in this mode with no changes needed. However, for compilation in the FreeBASIC default language mode, most substantial programs will require changes.
FreeBASIC is a self-hosting compiler which makes use of the GNU binutils programming tools as backends and can produce console, graphical/GUI executables, dynamic and static libraries. FreeBASIC fully supports the use of C libraries and has partial C++ library support. This lets programmers use and create libraries for C and many other languages. It supports a C style preprocessor, capable of multiline macros, conditional compiling and file inclusion.
FreeBASIC has been rated close in speed with mainstream tools, such as GCC.
http://www.freebasic.net/CONTINUOUS BEAM ANALYSIS - QBASIC / FREEBASIC - STRUCTURAL ANALYSIS / CIVIL ENGINEERING
REM SHEAR AND MOMENT ENVELOPES FOR A CONTINUOUS BEAM
REM ************************************************
DIM VS(10, 11), VE(10, 11), MS(10, 21), MN(10, 21), MP(10, 21)
DIM Length(20),MomentArea(20),NumberOfLoads(20),LoadWeight(20,20)
DIM LoadStart(20,20),LoadCover(20,20),DeadOrImposedLoad$(20,20)
DIM CantileverLeft(20),CantileverRight(20),MM(20),SM(20),K2(20)
DIM DVar(20),E(20),FLeft(20),FRight(20),WD(20,20),FVar(20),R(200)
DIM ML(200),MR(200)
REM *************************************** Input of data
PRINT "ENTER TITLE"
INPUT T$
REM *************************** Partial factors of safety
PRINT "ENTER PARTIAL FACTOR OF SAFETY FOR DEAD LOAD,GK"
INPUT GK
PRINT "ENTER PARTIAL FACTOR OF SAFETY FOR IMPOSED LOAD,QK"
INPUT QK
REM *********************************** Beam information
PRINT "ENTER NO. OF SPANS"
INPUT NumberOfSpan
FOR I = 1 TO NumberOfSpan
PRINT "SPAN NO"; I
PRINT "ENTER SPAN LENGTH-metres"
INPUT Length(I)
PRINT "ENTER '2ND MOMENT OF AREA OF SPAN'S SECTION,IZ-mm^4"
INPUT MomentArea(I)
NEXT I
REM ***************** Characteristic loading information
FOR I = 1 TO NumberOfSpan
PRINT "SPAN NO."; I
PRINT "ENTER NO. OF LOADS ON SPAN"; I
INPUT NumberOfLoads(I)
IF NumberOfLoads(I) = 0 THEN 390
FOR J = 1 TO NumberOfLoads(I)
PRINT "SPAN NO. "; I; "LOAD NO. "; J
PRINT "ENTER LOAD'S CHARACTERISTIC WEIGHT-kN"
INPUT LoadWeight(I, J)
PRINT "ENTER LOAD START DISTANCE,A-metres "
INPUT LoadStart(I, J)
PRINT "ENTER LOAD COVER DISTANCE,C-metres"
INPUT LoadCover(I, J)
PRINT "ENTER LOAD DEAD OR IMPOSED - D OR I"
INPUT DeadOrImposedLoad$(I, J)
NEXT J
390 NEXT I
REM ***************** Cantilevers characteristic moments
PRINT "ENTER CANTILEVER CHARACTERISTIC DEAD MOMENT AT L.H.S.-kN.m"
INPUT CantileverLeft(1)
PRINT "ENTER CANTILEVER CHARACTERISTIC IMPOSED MOMENT AT L.H.S.-kN.m"
INPUT CantileverLeft(2)
PRINT "ENTER CANTILEVER CHARACTERISTIC DEAD MOMENT AT R.H.S.-kN.m"
INPUT CantileverRight(1)
PRINT "ENTER CANTILEVER CHARACTERISTIC IMPOSED MOMENT AT R.H.S.-kN.m"
INPUT CantileverRight(2)
REM ***************************** Initialising variables
CL = 0: CR = 0
FOR I = 1 TO NumberOfSpan
MM(I) = 0: SM(I) = 0
FOR K = 1 TO 21
VE(I, (K + 1) / 2) = 0: MN(I, K) = 10 ^ 10: MP(I, K) = -(10 ^ 10)
NEXT K
NEXT I
REM ************************************* Beam stiffness
FOR I = 1 TO NumberOfSpan
K2(I) = MomentArea(I) / Length(I)
NEXT I
GOSUB 4000: REM ******* Subroutine for slope deflection equations -- L.H.S
REM No. of load patterns = NP
NP = NumberOfSpan + 1
IF CantileverLeft(1) + CantileverLeft(2) > 0 THEN NP = NP + 1
IF CantileverRight(1) + CantileverRight(2) > 0 THEN NP = NP + 1
REM ********************* Analysis for each load pattern
LP = 0
680 LP = LP + 1
GOSUB 9000: REM ***Subroutine to calculate design loads
GOSUB 5000: REM ****** Subroutine for fixed end moments
GOSUB 6000: REM ******* Subroutine for slope deflection equations - R.H.S.
GOSUB 7000: REM Subroutine for sol'n of eq'ons and c'tion of end moments
GOSUB 8000: REM Subroutine for span shear and moments
GOSUB 10000: REM Subroutine to sort for shear and moment envelopes
IF LP < NP THEN 680 REM *** Sort for maximum sagging moment and its position FOR I = 1 TO NumberOfSpan FOR K = 1 TO 21 IF MP(I, K) > MM(I) THEN MM(I) = MP(I, K): SM(I) = Length(I) * (K - 1) / 20
NEXT K
NEXT I
REM *********************** Printout of data and results
OPEN "BEAMOUT.TXT" FOR OUTPUT AS #1
PRINT #1, "TITLE "
PRINT #1, "PARTIAL FACTORS OF SAFETY"
PRINT #1, "FACTOR OF SAFETY FOR DEAD LOAD ="; GK
PRINT #1, "FACTOR OF SAFETY FOR DEAD LOAD ="; GK
PRINT #1, "FACTOR OF SAFETY FOR IMPOSED LOAD="; QK
PRINT #1,
PRINT #1, : PRINT #1, "STRUCTURE INFORMATION"
PRINT #1, "---------------------"
PRINT #1, "NO. OF SPANS "; NumberOfSpan
PRINT #1,
PRINT #1, " SPAN SPAN 2ND MOMENT"
PRINT #1, " NO. LENGTH(m) OF AREA(mm^4)"
FOR I = 1 TO NumberOfSpan
PRINT #1, USING " ## ####.## ####.##"; I; Length(I); MomentArea(I)
NEXT I
REM
PRINT #1, : PRINT #1, : PRINT #1, "LOADING INFORMATION"
PRINT #1, "-------------------"
PRINT #1, " SPAN LOAD START COVER DEAD "
PRINT #1, " NO. WEIGHT(kN) DISTANCE(m) DISTANCE(m) OR IMPOSED"
FOR I = 1 TO NumberOfSpan
IF NumberOfLoads(I) = 0 THEN 1080
FOR J = 1 TO NumberOfLoads(I)
PRINT #1, USING " ## ####.## ####.## ####.## \ \"; I; LoadWeight(I, J); LoadStart(I, J); LoadCover(I, J); DeadOrImposedLoad$(I, J)
NEXT J
1080 NEXT I
REM
PRINT #1, "CANTILEVER CHARACTERISTIC DEAD MOMENT AT L.H.S.="; CantileverLeft(1); "kN.m"
PRINT #1, "CANTILEVER CHARACTERISTIC IMPOSED MOMENT AT L.H.S.="; CantileverLeft(2); "kN.m"
PRINT #1, "CANTILEVER CHARACTERISTIC DEAD MOMENT AT R.H.S.="; CantileverRight(1); "kN.m"
PRINT #1, "CANTILEVER CHARACTERISTIC IMPOSED MOMENT AT R.H.S.="; CantileverRight(2); "kN.m"
REM ******************************* Printout of results
PRINT "PRINT RESULT IN BEAMOUT.TXT FILE"
PRINT #1, : PRINT #1, : PRINT #1, "SHEAR AND MOMENT ENVELOPES"
PRINT #1, "__________________________"
PRINT #1, "SHEARS,kN AND MOMENTS,kN.m AT 10TH INTERVALS ALONG SPANS"
FOR I = 1 TO NumberOfSpan
PRINT #1, : PRINT #1, "SPAN NO."; I
PRINT #1, "SECTION SHEAR HOGGING SAGGING"
PRINT #1, " NO. MOMENT MOMENT"
FOR K = 1 TO 21 STEP 2
PRINT #1, USING " ## ####.## ####.## ####.##"; (K + 1) / 2; VE(I, (K + 1) / 2); MN(I, K); MP(I, K)
REM
NEXT K
PRINT #1, "MAXIMUM SPAN MOMENT = "; INT(MM(I) * 100) / 100; "kN.m"
PRINT #1, "AT A DISTANCE = "; INT(SM(I) * 100) / 100; "metres"
NEXT I
CLOSE #1
END
REM ***************************************************
4000 REM Subroutine for slope deflection equations - L.H.S.
DVar(1) = 4 * K2(1): E(1) = 2 * K2(1)
FOR I = 2 TO NumberOfSpan
DVar(I) = 4 * (K2(I - 1) + K2(I))
E(I) = 2 * K2(I)
NEXT I
DVar(NumberOfSpan + 1) = 4 * K2(NumberOfSpan)
E(NumberOfSpan + 1) = 0
RETURN
REM ***************************************************
5000 REM ********* Subroutine to calculate fixed end moments
FOR I = 1 TO NumberOfSpan
FLeft(I) = 0: FRight(I) = 0
IF NumberOfLoads(I) = 0 THEN 5120
FOR J = 1 TO NumberOfLoads(I)
W = WD(I, J): A = LoadStart(I, J): C = LoadCover(I, J): L = Length(I)
S = A + C / 2: T = L - S
FL = W * (S * T ^ 2 + (S - 2 * T) * C ^ 2 / 12) / L ^ 2
FR = W * (T * S ^ 2 + (T - 2 * S) * C ^ 2 / 12) / L ^ 2
FLeft(I) = FLeft(I) + FL
FRight(I) = FRight(I) + FR
NEXT J
5120 NEXT I
RETURN
REM ***************************************************
6000 REM Subroutine for slope deflection equations - R.H.S.
FVar(1) = -(FLeft(1)) + CL
FOR I = 2 TO NumberOfSpan
FVar(I) = FRight(I - 1) - FLeft(I)
NEXT I
FVar(NumberOfSpan + 1) = FRight(NumberOfSpan) - CR
RETURN
REM ***************************************************
7000 REM *** Subroutine for equation solution and end moment calculation
D = DVar(1): F = FVar(1)
FOR I = 2 TO NumberOfSpan + 1
F = FVar(I) - E(I - 1) * F / D
D = DVar(I) - E(I - 1) ^ 2 / D
NEXT I
R(NumberOfSpan + 1) = F / D
R(NumberOfSpan) = (FVar(NumberOfSpan + 1) - DVar(NumberOfSpan + 1) * R(NumberOfSpan + 1)) / E(NumberOfSpan)
FOR I = NumberOfSpan TO 2 STEP -1
R(I - 1) = (FVar(I) - DVar(I) * R(I) - E(I) * R(I + 1)) / E(I - 1)
NEXT I
REM End moments
FOR I = 1 TO NumberOfSpan
ML(I) = (4 * R(I) + 2 * R(I + 1)) * K2(I) + FLeft(I)
MR(I) = (2 * R(I) + 4 * R(I + 1)) * K2(I) - FRight(I)
NEXT I
RETURN
REM ***************************************************
8000 REM *** Subroutine to calculate span shears and moments
FOR I = 1 TO NumberOfSpan
REM ***** Calculation of span shears and moments due to end moments
RL = (ML(I) + MR(I)) / Length(I)
FOR K = 1 TO 11: VS(I, K) = RL: NEXT K
FOR K = 1 TO 21: MS(I, K) = -ML(I) + RL * Length(I) * (K - 1) / 20: NEXT K
FOR J = 1 TO NumberOfLoads(I)
IF NumberOfLoads(I) = 0 THEN 8300
W = WD(I, J): A = LoadStart(I, J): C = LoadCover(I, J): L = Length(I)
S = L - A - C / 2
RL = W * S / L: RR = W - RL
REM ********************* Span shears at 10th intervals
FOR K = 1 TO 11
Z = (K - 1) * L / 10
IF Z <= A THEN VK = RL: GOTO 8180 IF Z > A + C THEN VK = -RR: GOTO 8180
Z1 = Z - A
VK = RL - W * Z1 / C
8180 VS(I, K) = VS(I, K) + VK
NEXT K
REM ******************** Span moments at 20th intervals
FOR K = 1 TO 21
Z = (K - 1) * L / 20
IF Z <= A THEN MK = RL * Z: GOTO 8270 IF Z >= A + C THEN MK = RR * (L - Z): GOTO 8270
Z1 = Z - A: WZ = W * Z1 / C
MK = RL * Z - WZ * Z1 / 2
8270 MS(I, K) = MS(I, K) + MK
NEXT K
NEXT J
8300 NEXT I
RETURN
REM ***************************************************
9000 REM ************** Subroutine to calculate design loads
FOR I = 1 TO NumberOfSpan
IF NumberOfLoads(I) = 0 THEN 9290
REM **************************** Partial safety factors
GG = 1: QG = 0
IF LP = 1 THEN 9090
IF LP = 2 THEN 9120
IF LP > 2 AND LP < NumberOfSpan + 2 THEN 9150
IF LP > NumberOfSpan + 1 THEN 9190
9090 REM ******* Odd numbered spans, maximum sagging moments
IF I / 2 > INT(I / 2) THEN 9230
GOTO 9240
9120 REM ****** Even numbered spans, maximum sagging moments
IF I / 2 = INT(I / 2) THEN 9230
GOTO 9240
9150 REM *************************** Maximum support moments
IF I = LP - 2 THEN 9230
IF I = LP - 1 THEN 9230
GOTO 9240
9190 REM **** Maximum shear at end supports with cantilevers
IF LP = NumberOfSpan + 2 AND I = 1 THEN 9230
IF LP = NumberOfSpan + 3 AND I = NumberOfSpan THEN 9230
GOTO 9240
9230 GG = GK: QG = QK
9240 REM ************************************** Design loads
FOR J = 1 TO NumberOfLoads(I)
IF UCASE$(DeadOrImposedLoad$(I, J)) = "D" THEN WD(I, J) = LoadWeight(I, J) * GG
IF UCASE$(DeadOrImposedLoad$(I, J)) = "I" THEN WD(I, J) = LoadWeight(I, J) * QG
NEXT J
9290 NEXT I
REM ************************* Cantilever design moments
IF CantileverLeft(1) + CantileverLeft(2) = 0 THEN 9370
GG = 1: QG = 0
REM *********************************** Left cantilever
IF LP = 2 THEN GG = GK: QG = QK
IF LP = NumberOfSpan + 2 THEN GG = GK: QG = QK
CL = CantileverLeft(1) * GG + CantileverLeft(2) * QG
9370 REM ********************************** Right cantilever
IF CantileverRight(1) + CantileverRight(2) = 0 THEN 9440
GG = 1: QG = 0
IF LP = 1 AND NumberOfSpan / 2 = INT(NumberOfSpan / 2) THEN GG = GK: QG = QK
IF LP = 2 AND NumberOfSpan / 2 > INT(NumberOfSpan / 2) THEN GG = GK: QG = QK
IF LP = NumberOfSpan + 3 THEN GG = GK: QG = QK
CR = CantileverRight(1) * GG + CantileverRight(2) * QG
9440 RETURN
REM ***************************************************
10000 REM *** Subroutine to sort for shear force and bending moment envelopes
REM *********************************** Shear envelope
FOR I = 1 TO NumberOfSpan
FOR K = 1 TO 11
IF ABS(VE(I, K)) < ABS(VS(I, K)) THEN VE(I, K) = VS(I, K)
NEXT K
NEXT I
REM ************************** Bending moment envelope
FOR I = 1 TO NumberOfSpan
FOR K = 1 TO 21
REM ********************************* Hogging envelope
IF MN(I, K) > MS(I, K) THEN MN(I, K) = MS(I, K)
IF MN(I, K) > 0 THEN MN(I, K) = 0
REM ********************************* Sagging envelope
IF MP(I, K) < MS(I, K) THEN MP(I, K) = MS(I, K)
IF MP(I, K) < 0 THEN MP(I, K) = 0
NEXT K
NEXT I
RETURN
REM **************************************************
A small Boulderdash design for QBasic / FreeBASIC by Movax
'A small Boulderdash design for QBasic by Movax
'----------------------------------------------
'hey wesker_re! (was bedeutet das eigentlich?)
'hab mich mal eben hingesetzt und dir schnell so 'nen boulder-dash-code
'hingehackt um dir zu zeigen, wie ich das meinte..
'du bewegst die figur mit den pfeil-tasten und mit esc ist schluss.
'man könnte natürlich jetzt noch eine abfrage einbauen, was passieren soll,
'wenn dem spieler ein stein auf den kopf fällt oder eine verzögerung ein-
'bauen, damit die steine nicht so *zack* unten sind..
'aber um nur mal die idee zu verstehen, sollte der code hier eigentlich
'reichen ;)
'ich hab auch schon direkt mit eingebaut, dass steine, welche auf steinen
'landen, NEBEN diesen landen, falls das feld dort frei ist (so ist's beim
'original boulder dash auch) ;) ..
'ich schreib jetzt noch ein paar kommentare dran, damit das alles (hoff ich)
'weitestgehend verständlich ist..
'
'und falls nicht -> movax@gmx.de ;)
'
' greetz,
' -movax-
DECLARE SUB check () '<--------- überprüft, ob ein stein "absinken" kann..
DECLARE SUB feldzeichnen () '<-- oh mein GOTT! was ist DAS?! ;)
SCREEN 13
CONST ESC = 27, UNTEN = 80, OBEN = 72, LINKS = 75, RECHTS = 77
CONST frei = 0, dreck = 1, stein = 2, monsieur = 3
TYPE figur '<- *hach*, ich liebe typen-definitionen :)
x AS INTEGER
y AS INTEGER
oldX AS INTEGER
oldy AS INTEGER
c AS STRING * 1 '<- das ist einfach nur das zeichen das den spieler darstellt
END TYPE
DIM SHARED player AS figur
DIM SHARED feld(16, 10) '<- das spielfeld
DIM SHARED offX
DIM SHARED offY
'Die Variablen oben sind SHARED, weil die zwei anderen SUBs ebenfalls darauf
'zugreifen..
offX = 10: offY = 5 '<- das spielfeld beginnt erst bei 10,5
FOR x = 1 TO 16 '<- wir füllen das feld mit dreck :)
FOR y = 1 TO 10
feld(x, y) = dreck
NEXT y
NEXT x
FOR i = 5 TO 10 '<- das sind die 2 steine-reihen
feld(i, 2) = stein
feld(i, 5) = stein
NEXT i
feldzeichnen '<- ??? *g*
COLOR 6 '<-------- das hier wird der braune spielfeld-rahmen.
FOR i = 10 TO 26 ' braucht man zwar nicht unbedingt aber..
LOCATE 5, i: PRINT CHR$(176)' ach was soll's, sieht schicker aus..
LOCATE 15, i: PRINT CHR$(176)
NEXT i
FOR i = 6 TO 14
LOCATE i, 10: PRINT CHR$(176)
LOCATE i, 26: PRINT CHR$(176)
NEXT i
player.x = 2: player.y = 2 '<- die spieler-variablen setzen..
player.oldX = 2: player.oldy = 2
player.c = CHR$(1) '<- ja, es ist der smiley [:D]
DO '<- mainloop
LOCATE 1, 1: PRINT "X:"; player.x '<- hm.. irgendwie muss ich sowas immer
LOCATE 2, 1: PRINT "Y:"; player.y ' irgendwo stehen haben :)
player.oldX = player.x
player.oldy = player.y
eingabe$ = RIGHT$(INKEY$, 1)
SELECT CASE eingabe$ '<- welche taste wurde gedrückt?
CASE CHR$(OBEN)
IF player.y > 1 AND feld(player.x, player.y - 1) <> stein THEN player.y = player.y - 1
CASE CHR$(UNTEN)
IF player.y < 9 AND feld(player.x, player.y + 1) <> stein THEN player.y = player.y + 1
CASE CHR$(LINKS)
IF player.x > 1 AND feld(player.x - 1, player.y) <> stein THEN player.x = player.x - 1
CASE CHR$(RECHTS)
IF player.x < 15 AND feld(player.x + 1, player.y) <> stein THEN player.x = player.x + 1
CASE CHR$(ESC): END
END SELECT
feld(player.oldX, player.oldy) = frei '<- is ja klar: der spieler geht weg,
' also wird das feld "frei"
feld(player.x, player.y) = monsieur '<- den spieler an die neue Koord.
' auf (oder in?) der karte setzen.
check '<--------------------------------- das ist die routine, die über-
' prüft, ob das feld unter einem
' stein frei ist..
feldzeichnen '<- und das feld zeichnen..
LOCATE player.y + offY, player.x + offX: COLOR 15: PRINT player.c
LOOP '<- hier endet die hauptschleife..
'-------------------------------
'Martijn's Boulder Dash Fan Site
'http://www.bd-fans.com
SUB check
'das hier ist die routine, wie ich sie dir mal in der mail beschrieben hab.
'das gesamte spielfeld wird durchlaufen. trifft die routine auf einen
'stein, dann wird überprüft, ob das feld darunter "frei" ist.
'ist dies der fall, dann wird das feld, auf dem der stein momentan liegt frei
'und der stein sinkt ein feld hinab..
'ist das feld unter einem stein EBENFALLS ein stein und ist rechts oder links
'daneben ein freies feld, dann fällt der stein in dieses leere feld NEBEN dem
'stein.. ist eigentlich gar nicht sooo kompliziert..
FOR x = 1 TO 16
FOR y = 1 TO 10
IF feld(x, y) = stein THEN
IF y + 1 < 11 THEN
SELECT CASE feld(x, y + 1)
CASE frei '<-- ist das feld unter dem stein frei?
feld(x, y) = frei: feld(x, y + 1) = stein
CASE stein '<-- ist der stein auf einen stein gefallen (*aua*) ?
IF feld(x - 1, y + 1) = frei AND feld(x - 1, y) = frei THEN '<- links?
feld(x, y) = frei: feld(x - 1, y + 1) = stein
END IF
IF feld(x + 1, y + 1) = frei AND feld(x + 1, y) = frei THEN '<- rechts?
feld(x, y) = frei: feld(x + 1, y + 1) = stein
END IF
END SELECT
END IF
END IF
NEXT y
NEXT x
END SUB
SUB feldzeichnen
'ich hab keine ahnung, was diese routine macht.. echt nicht! *g*
FOR x = 1 TO 15
FOR y = 1 TO 9
LOCATE y + offY, x + offX '<- ha! OffX und OffY tuen ihren Dienst :)
IF feld(x, y) = frei THEN PRINT " "
IF feld(x, y) = dreck THEN COLOR 7: PRINT CHR$(176)
IF feld(x, y) = stein THEN COLOR 8: PRINT CHR$(254)
IF feld(x, y) = monsieur THEN COLOR 15: PRINT player.c
NEXT y
NEXT x
END SUB
Sunday, September 25, 2011
QBASIC BREAKOUT SOURCE CODES !!
REM K.R. Sloan, Jr.
REM 1 January 1982
DIM BALL(14)
DIM PADDLE(9)
DIM BRICK(20, 4)
RANDOMIZE (VAL(RIGHT$(TIME$, 2)))
KEY OFF: PLAY "mb"
LOUD = 0
BRUNO$ = "l16o2b-o3cl8ddc+16do2fp1"
T = 8: B = 188: L = 8: R = 308
BH = 8: BW = (R - L) / 20
BT = T + (BH * 4): BB = BT + (BH * 4)
CLS
LOCATE 7, 12: PRINT "Welcome to Spinout";
LOCATE 8, 12: PRINT "ArchMach Version 1";
160 LOCATE 12, 1: PRINT "Choose a key to move the paddle right";
170 R$ = INKEY$: IF R$ = "" GOTO 170
LOCATE 12, 1: PRINT "Choose a key to move the paddle left ";
190 L$ = INKEY$: IF L$ = "" GOTO 190
IF R$ = L$ GOTO 160
LOCATE 12, 1: PRINT "Choose a key to serve ";
220 S$ = INKEY$: IF S$ = "" GOTO 220
IF (R$ = S$) OR (L$ = S$) GOTO 160
LOCATE 12, 1: PRINT "Choose a key to turn noise on/off ";
250 N$ = INKEY$: IF N$ = "" GOTO 250
IF (R$ = N$) OR (L$ = N$) OR (S$ = N$) GOTO 160
270 LOCATE 12, 1: INPUT ; "How good are you at this game (1-10)"; SKILL
IF SKILL < 1 GOTO 270
IF SKILL > 10 GOTO 270
SKILL = SKILL / 10
MAXVX = 6 + (4 * SKILL): MAXVY = MAXVX
G = SKILL / 5
DEF SEG = 0: EQUIPMENT% = PEEK(&H410): POKE &H410, EQUIPMENT% - &H10
WIDTH 40: WIDTH 80: SCREEN 0, 0, 0: SCREEN 1: COLOR 1, 0: CLS
LINE (0, 0)-(319, 199), 0, BF
FOR BY = 0 TO 3
FOR BX = 0 TO 19
BRICK(1 + BX, 1 + BY) = 10 + 50 * BY
LINE (L + 2 + (BW * BX), BT + 2 + (BH * BY))-STEP(BW - 4, BH - 4), 2 + INT(BY / 2), BF
NEXT BX, BY
SCORE = 0
LINE (L, T)-(R, T)
LINE -(R, B)
LINE -(L, B)
LINE -(L, T)
X = 160: Y = 100
LASTD$ = ""
FOR I = 1 TO 5
FOR J = 1 TO 5
IF ((I - 3) * (I - 3)) + ((J - 3) * (J - 3)) < 6.25 THEN PSET (X - 3 + I, Y - 3 + J)
NEXT J, I
GET (X - 2, Y - 2)-(X + 2, Y + 2), BALL
PL = 150: PR = 170: PY = B - 20
LINE (PL, PY)-(PR, PY), 1, BF
GET (PL, PY)-(PR, PY), PADDLE
REM main loop
IF LOUD = 1 THEN PLAY BRUNO$
FOR SHOT = 1 TO 4
LOCATE 25, 1
PRINT USING "#####"; SCORE;
LOCATE 25, 8
PRINT USING "Ball # "; SHOT;
LOCATE 25, 18
PRINT "K.R.Sloan,Jr. 1Jan82";
IF X > R THEN X = R
IF X < L THEN X = L
IF Y < T THEN Y = T
IF Y > B THEN Y = B
PUT (X - 2, Y - 2), BALL
X = L + RND(X) * (R - L)
Y = B - 10
PUT (X - 2, Y - 2), BALL
VX = 6 * RND(1) - 3
VY = -5 - 2 * RND(1)
SPIN = 0
FAST = 1 + SKILL
720 GOSUB 1410 'MOVE PADDLE
IF D$ <> S$ GOTO 720
740 OX = X: OY = Y: OBX = BX: OBY = BY
OVX = VX: OVY = VY
VX = OVX - (SPIN * OVY * .05): VY = OVY + (SPIN * OVX * .05) + G
SPIN = SPIN * .9999
IF VX > MAXVX THEN VX = MAXVX
IF VY > MAXVY THEN VY = MAXVY
IF VX < -MAXVX THEN VX = -MAXVX
IF VY < -MAXVY THEN VY = -MAXVY
X = X + VX: Y = Y + VY
BX = INT((X - L) / BW)
IF BX > 19 THEN BX = 19
IF BX < 0 THEN BX = 0
BY = INT((Y - BT) / BH)
IF BY > 3 GOTO 1050
IF BY < 0 GOTO 1050
IF BRICK(1 + BX, 1 + BY) <= 0 GOTO 1050
IF BY > 1 GOTO 890
VY = VY * FAST
890 IF (OBX <> BX) THEN VX = -VX
IF (OBY <> BY) THEN VY = -VY
SCORE = SCORE + BRICK(1 + BX, 1 + BY)
SOUND 440, 2 * LOUD
PUT (OX - 2, OY - 2), BALL, XOR
LINE (L + 2 + (BW * BX), BT + 2 + (BH * BY))-STEP(BW - 4, BH - 4), 0, BF
PUT (OX - 2, OY - 2), BALL, XOR
BRICK(1 + BX, 1 + BY) = -BRICK(1 + BX, 1 + BY)
IF SCORE < 6800 GOTO 1050
LOCATE 25, 1
PRINT USING "#####"; SCORE;
FOR FLASH = 1 TO 8
COLOR FLASH, .5 + RND(FLASH)
PLAY "mfaemb"
NEXT FLASH
GOTO 1340
1050 IF X <= L THEN X = L + L - X: VX = -VX: VY = VY + SPIN: SOUND 600, 2 * LOUD
IF X >= R THEN X = R + R - X: VX = -VX: VY = VY - SPIN: SOUND 1200, 2 * LOUD
IF Y <= T THEN Y = T + T - Y: VY = -VY: VX = VX - SPIN: SOUND 880, 2 * LOUD
IF Y >= B GOTO 1310
IF (Y < PY) OR (OY > PY) THEN GOTO 1270
IF ((PL - 2) < X) AND (X < (PR + 2)) GOTO 1130
IF ((PL - 2) < OX) AND (OX < (PR + 2)) GOTO 1130
GOTO 1270
1130 Y = PY + PY - Y
SOUND 300, 5 * LOUD
IF (RND(1) * 2) > SKILL GOTO 1210
BX = INT(RND(1) * 19.99): BY = INT(RND(1) * 3.99):
IF BRICK(1 + BX, 1 + BY) > 0 GOTO 1210
BRICK(1 + BX, 1 + BY) = -BRICK(1 + BX, 1 + BY)
LINE (L + 2 + (BW * BX), BT + 2 + (BH * BY))-STEP(BW - 4, BH - 4), 2 + INT(BY / 2), BF
SCORE = SCORE - BRICK(1 + BX, 1 + BY)
1210 LOCATE 25, 1
PRINT SCORE;
VY = -VY
MISS = (X - (PL + PR) / 2) / (PL - PR)
VX = VX + VY * MISS * SKILL * 5
SPIN = (SPIN * SKILL) + MISS * SKILL
1270 PUT (X - 2, Y - 2), BALL, XOR
PUT (OX - 2, OY - 2), BALL, XOR
TIMER ON
Start = TIMER
DO
LOOP UNTIL TIMER > Start + .1
TIMER OFF
GOSUB 1410 'move paddle
GOTO 740
1310 REM lost ball
IF LOUD = 1 THEN SOUND 200, 20
NEXT SHOT
1340 REM End of Game
DEF SEG = 0: POKE &H410, 125: WIDTH 40: WIDTH 80: SCREEN 0, 0, 0
WIDTH 80: SCREEN 0, 0, 0
LOCATE 12, 20
PRINT "Do you want to play another game?\";
1370 D$ = INKEY$
IF D$ = "y" THEN RUN
IF D$ = "n" THEN STOP
GOTO 1370
1410 REM move paddle routine
OPL = PL
1430 D$ = INKEY$
IF D$ = CHR$(27) THEN END
IF D$ = N$ THEN LOUD = -1 * LOUD + 1
IF D$ = L$ THEN PL = PL - 5: GOTO 1430
IF D$ = R$ THEN PL = PL + 5: GOTO 1430
IF PL < L THEN PL = L
IF PL > (R - 20) THEN PL = R - 20
IF OPL = PL THEN RETURN
PR = PL + 20
PUT (OPL, PY), PADDLE, XOR
PUT (PL, PY), PADDLE, XOR
RETURN
GWBASIC BREAKOUT SOURCE CODES
10 REM ibm pc spinout
20 REM K.R. Sloan, Jr.
30 REM 1 January 1982
40 DIM BALL(14)
50 DIM PADDLE(9)
60 DIM BRICK(20, 4)
65 RANDOMIZE (VAL(RIGHT$(TIME$, 2)))
70 KEY OFF: PLAY "mb"
80 LOUD = 0
90 BRUNO$ = "l16o2b-o3cl8ddc+16do2fp1"
110 T = 8: B = 188: L = 8: R = 308
120 BH = 8: BW = (R - L) / 20
130 BT = T + (BH * 4): BB = BT + (BH * 4)
135 CLS
140 LOCATE 7, 12: PRINT "Welcome to Spinout";
150 LOCATE 8, 12: PRINT "ArchMach Version 1";
160 LOCATE 12, 1: PRINT "Choose a key to move the paddle right";
170 R$ = INKEY$: IF R$ = "" GOTO 170
180 LOCATE 12, 1: PRINT "Choose a key to move the paddle left ";
190 L$ = INKEY$: IF L$ = "" GOTO 190
200 IF R$ = L$ GOTO 160
210 LOCATE 12, 1: PRINT "Choose a key to serve ";
220 S$ = INKEY$: IF S$ = "" GOTO 220
230 IF (R$ = S$) OR (L$ = S$) GOTO 160
240 LOCATE 12, 1: PRINT "Choose a key to turn noise on/off ";
250 N$ = INKEY$: IF N$ = "" GOTO 250
260 IF (R$ = N$) OR (L$ = N$) OR (S$ = N$) GOTO 160
270 LOCATE 12, 1: INPUT ; "How good are you at this game (1-10)"; SKILL
275 IF SKILL < 1 GOTO 270
276 IF SKILL > 10 GOTO 270
280 SKILL = SKILL / 10
290 MAXVX = 6 + (4 * SKILL): MAXVY = MAXVX
295 G = SKILL / 5
296 DEF SEG = 0: EQUIPMENT% = PEEK(&H410): POKE &H410, EQUIPMENT% - &H10
297 WIDTH 40: WIDTH 80: SCREEN 0, 0, 0: SCREEN 1: COLOR 1, 0: CLS
300 LINE (0, 0)-(319, 199), 0, BF
310 FOR BY = 0 TO 3
320 FOR BX = 0 TO 19
330 BRICK(1 + BX, 1 + BY) = 10 + 50 * BY
340 LINE (L + 2 + (BW * BX), BT + 2 + (BH * BY))-STEP(BW - 4, BH - 4), 2 + INT(BY / 2), BF
350 NEXT BX, BY
360 SCORE = 0
370 LINE (L, T)-(R, T)
380 LINE -(R, B)
390 LINE -(L, B)
400 LINE -(L, T)
410 X = 160: Y = 100
420 LASTD$ = ""
430 FOR I = 1 TO 5
440 FOR J = 1 TO 5
450 IF ((I - 3) * (I - 3)) + ((J - 3) * (J - 3)) < 6.25 THEN PSET (X - 3 + I, Y - 3 + J)
460 NEXT J, I
470 GET (X - 2, Y - 2)-(X + 2, Y + 2), BALL
480 PL = 150: PR = 170: PY = B - 20
490 LINE (PL, PY)-(PR, PY), 1, BF
500 GET (PL, PY)-(PR, PY), PADDLE
510 REM main loop
520 IF LOUD = 1 THEN PLAY BRUNO$
530 FOR SHOT = 1 TO 4
540 LOCATE 25, 1
550 PRINT USING "#####"; SCORE;
560 LOCATE 25, 8
570 PRINT USING "Ball # "; SHOT;
580 LOCATE 25, 18
590 PRINT "K.R.Sloan,Jr. 1Jan82";
600 IF X > R THEN X = R
610 IF X < L THEN X = L
620 IF Y < T THEN Y = T
630 IF Y > B THEN Y = B
640 PUT (X - 2, Y - 2), BALL
650 X = L + RND(X) * (R - L)
660 Y = B - 10
670 PUT (X - 2, Y - 2), BALL
680 VX = 6 * RND(1) - 3
690 VY = -5 - 2 * RND(1)
700 SPIN = 0
710 FAST = 1 + SKILL
720 GOSUB 1410 'MOVE PADDLE
730 IF D$ <> S$ GOTO 720
740 OX = X: OY = Y: OBX = BX: OBY = BY
750 OVX = VX: OVY = VY
760 VX = OVX - (SPIN * OVY * .05): VY = OVY + (SPIN * OVX * .05) + G
761 SPIN = SPIN * .9999
770 IF VX > MAXVX THEN VX = MAXVX
771 IF VY > MAXVY THEN VY = MAXVY
780 IF VX < -MAXVX THEN VX = -MAXVX
781 IF VY < -MAXVY THEN VY = -MAXVY
790 X = X + VX: Y = Y + VY
800 BX = INT((X - L) / BW)
810 IF BX > 19 THEN BX = 19
820 IF BX < 0 THEN BX = 0
830 BY = INT((Y - BT) / BH)
840 IF BY > 3 GOTO 1050
850 IF BY < 0 GOTO 1050
860 IF BRICK(1 + BX, 1 + BY) <= 0 GOTO 1050
870 IF BY > 1 GOTO 890
880 VY = VY * FAST
890 IF (OBX <> BX) THEN VX = -VX
900 IF (OBY <> BY) THEN VY = -VY
910 SCORE = SCORE + BRICK(1 + BX, 1 + BY)
920 SOUND 440, 2 * LOUD
930 PUT (OX - 2, OY - 2), BALL, XOR
940 LINE (L + 2 + (BW * BX), BT + 2 + (BH * BY))-STEP(BW - 4, BH - 4), 0, BF
950 PUT (OX - 2, OY - 2), BALL, XOR
960 BRICK(1 + BX, 1 + BY) = -BRICK(1 + BX, 1 + BY)
970 IF SCORE < 6800 GOTO 1050
972 LOCATE 25, 1
974 PRINT USING "#####"; SCORE;
980 FOR FLASH = 1 TO 8
990 COLOR FLASH, .5 + RND(FLASH)
1000 PLAY "mfaemb"
1010 NEXT FLASH
1040 GOTO 1340
1050 IF X <= L THEN X = L + L - X: VX = -VX: VY = VY + SPIN: SOUND 600, 2 * LOUD
1060 IF X >= R THEN X = R + R - X: VX = -VX: VY = VY - SPIN: SOUND 1200, 2 * LOUD
1070 IF Y <= T THEN Y = T + T - Y: VY = -VY: VX = VX - SPIN: SOUND 880, 2 * LOUD
1080 IF Y >= B GOTO 1310
1090 IF (Y < PY) OR (OY > PY) THEN GOTO 1270
1100 IF ((PL - 2) < X) AND (X < (PR + 2)) GOTO 1130
1110 IF ((PL - 2) < OX) AND (OX < (PR + 2)) GOTO 1130
1120 GOTO 1270
1130 Y = PY + PY - Y
1140 SOUND 300, 5 * LOUD
1150 IF (RND(1) * 2) > SKILL GOTO 1210
1160 BX = INT(RND(1) * 19.99): BY = INT(RND(1) * 3.99):
1170 IF BRICK(1 + BX, 1 + BY) > 0 GOTO 1210
1180 BRICK(1 + BX, 1 + BY) = -BRICK(1 + BX, 1 + BY)
1190 LINE (L + 2 + (BW * BX), BT + 2 + (BH * BY))-STEP(BW - 4, BH - 4), 2 + INT(BY / 2), BF
1200 SCORE = SCORE - BRICK(1 + BX, 1 + BY)
1210 LOCATE 25, 1
1220 PRINT SCORE;
1230 VY = -VY
1240 MISS = (X - (PL + PR) / 2) / (PL - PR)
1250 VX = VX + VY * MISS * SKILL * 5
1260 SPIN = (SPIN * SKILL) + MISS * SKILL
1270 PUT (X - 2, Y - 2), BALL, XOR
1280 PUT (OX - 2, OY - 2), BALL, XOR
1290 GOSUB 1410 'move paddle
1300 GOTO 740
1310 REM lost ball
1320 IF LOUD = 1 THEN SOUND 200, 20
1330 NEXT SHOT
1340 REM End of Game
1341 DEF SEG = 0: POKE &H410, 125: WIDTH 40: WIDTH 80: SCREEN 0, 0, 0
1342 WIDTH 80: SCREEN 0, 0, 0
1350 LOCATE 12, 20
1360 PRINT "Do you want to play another game?\";
1370 D$ = INKEY$
1380 IF D$ = "y" THEN RUN
1390 IF D$ = "n" THEN STOP
1400 GOTO 1370
1410 REM move paddle routine
1420 OPL = PL
1430 D$ = INKEY$
1440 IF D$ = N$ THEN LOUD = -1 * LOUD + 1
1450 IF D$ = L$ THEN PL = PL - 5: GOTO 1430
1460 IF D$ = R$ THEN PL = PL + 5: GOTO 1430
1470 IF PL < L THEN PL = L
1480 IF PL > (R - 20) THEN PL = R - 20
1490 IF OPL = PL THEN RETURN
1500 PR = PL + 20
1510 PUT (OPL, PY), PADDLE, XOR
1520 PUT (PL, PY), PADDLE, XOR
1530 RETURN
FREEBASIC BREAKOUT SOURCE CODES !!
'Recoded From K.R. Sloan, Jr. GWBASIC Spinout.
'GWBASIC version uses Screen 1 ( 320 x 200 Resolution - CGA Graphics )
'FreeBASIC Version uses Screen 19 ( 800 x 600 Resolution 256K colors to 256 attributes or direct color )
REM ibm pc spinout
REM K.R. Sloan, Jr.
REM 1 January 1982
Screen 19 ' ( 800x 600)
DIM BALL(100)
DIM PADDLE(300)
DIM BRICK(20, 4)
RANDOMIZE (VAL(RIGHT$(TIME$, 2)))
' KEY OFF: PLAY "mb"
LOUD = 0
'BRUNO$ = "l16o2b-o3cl8ddc+16do2fp1"
T = 24: B = 580: L = 20: R = 770 ' T=8 B=188 L = 8 R = 308
BH = 20: BW = (R - L) / 20 ' BH = 8: BW = (R - L) / 20
BT = T + (BH * 4): BB = BT + (BH * 4) ' BT = T + (BH * 4): BB = BT + (BH * 4)
CLS:COLOR 6
'BLOAD"BREAKFB.PIC"
160 LOCATE 32, 10: PRINT "Choose a key to move the paddle right";
170 R$ = INKEY$: IF R$ = "" GOTO 170
LOCATE 32, 10: PRINT "Choose a key to move the paddle left ";
190 L$ = INKEY$: IF L$ = "" GOTO 190
IF R$ = L$ GOTO 160
LOCATE 32, 10: PRINT "Choose a key to serve ";
220 S$ = INKEY$: IF S$ = "" GOTO 220
IF (R$ = S$) OR (L$ = S$) GOTO 160
LOCATE 32, 10: PRINT "Choose a key to turn noise on/off ";
250 N$ = INKEY$: IF N$ = "" GOTO 250
IF (R$ = N$) OR (L$ = N$) OR (S$ = N$) GOTO 160
270 LOCATE 32, 10: INPUT ; "How good are you at this game (1-10)"; SKILL
IF SKILL < 1 GOTO 270
IF SKILL > 10 GOTO 270
SKILL = SKILL / 10
MAXVX = 6 + (4 * SKILL): MAXVY = MAXVX
G = SKILL / 5
' DEF SEG = 0: EQUIPMENT% = PEEK(&H410): POKE &H410, EQUIPMENT% - &H10
SCREEN 19: COLOR 1, 0: CLS
LINE (0, 0)-(799, 599), 0, BF
FOR BY = 0 TO 3
FOR BX = 0 TO 19 '19
BRICK(1 + BX, 1 + BY) = 10 + 50 * BY
LINE (L + 2 + (BW * BX), BT + 2 + (BH * BY))-STEP(BW - 4, BH - 4), 2 + INT(BY / 2), BF
NEXT BX, BY
SCORE = 0
LINE (L, T)-(R, T)
LINE -(R, B)
LINE -(L, B)
LINE -(L, T)
X = 160: Y = 10
LASTD$ = ""
CIRCLE (X,Y),5,4
PAINT (X,Y),4,4
GET (X - 5, Y - 5)-(X + 5, Y + 5), BALL
CIRCLE (X,Y),5,0:PAINT (X,Y),0,0
PL = 120: PR = 170: PY = B - 20
LINE (PL, PY)-(PR, PY+10), 1, BF
GET (PL, PY)-(PR, PY+10), PADDLE
REM main loop
'IF LOUD = 1 THEN PLAY BRUNO$
COLOR 7
FOR SHOT = 1 TO 4
LOCATE 1, 1
PRINT USING "#####"; SCORE;
LOCATE 1, 20
PRINT USING "Ball # "; SHOT;
LOCATE 1, 40
PRINT "K.R.Sloan,Jr. 1st Jan 1982 , JALI Software 2011";
IF X > R THEN X = R
IF X < L THEN X = L
IF Y < T THEN Y = T
IF Y > B THEN Y = B
'PUT (X - 2, Y - 2), BALL
X = L + RND(X) * (R - L)
Y = B - 10
PUT (X - 2, Y - 2), BALL
VX = 6 * RND(1) - 3
VY = -5 - 2 * RND(1)
SPIN = 0
FAST = 1 + SKILL
720 GOSUB 1410 'MOVE PADDLE
IF D$ <> S$ GOTO 720
740 OX = X: OY = Y: OBX = BX: OBY = BY
OVX = VX: OVY = VY
VX = OVX - (SPIN * OVY * .05): VY = OVY + (SPIN * OVX * .05) + G
SPIN = SPIN * .9999
IF VX > MAXVX THEN VX = MAXVX
IF VY > MAXVY THEN VY = MAXVY
IF VX < -MAXVX THEN VX = -MAXVX
IF VY < -MAXVY THEN VY = -MAXVY
X = X + VX: Y = Y + VY
BX = INT((X - L) / BW)
IF BX > 19 THEN BX = 19
IF BX < 0 THEN BX = 0
BY = INT((Y - BT) / BH)
IF BY > 3 GOTO 1050
IF BY < 0 GOTO 1050
IF BRICK(1 + BX, 1 + BY) <= 0 GOTO 1050
IF BY > 1 GOTO 890
VY = VY * FAST
890 IF (OBX <> BX) THEN VX = -VX
IF (OBY <> BY) THEN VY = -VY
SCORE = SCORE + BRICK(1 + BX, 1 + BY)
' SOUND 440, 2 * LOUD
PUT (OX - 2, OY - 2), BALL, XOR
LINE (L + 2 + (BW * BX), BT + 2 + (BH * BY))-STEP(BW - 4, BH - 4), 0, BF
PUT (OX - 2, OY - 2), BALL, XOR
BRICK(1 + BX, 1 + BY) = -BRICK(1 + BX, 1 + BY)
IF SCORE < 6800 GOTO 1050
LOCATE 1, 1
PRINT USING "#####"; SCORE;
FOR FLASH = 1 TO 8
COLOR FLASH, .5 + RND(FLASH)
' PLAY "mfaemb"
NEXT FLASH
GOTO 1340
1050 IF X <= L THEN X = L + L - X: VX = -VX: VY = VY + SPIN: 'SOUND 600, 2 * LOUD
IF X >= R THEN X = R + R - X: VX = -VX: VY = VY - SPIN: 'SOUND 1200, 2 * LOUD
IF Y <= T THEN Y = T + T - Y: VY = -VY: VX = VX - SPIN: 'SOUND 880, 2 * LOUD
IF Y >= B GOTO 1310
IF (Y < PY) OR (OY > PY) THEN GOTO 1270
IF ((PL - 2) < X) AND (X < (PR + 2)) GOTO 1130
IF ((PL - 2) < OX) AND (OX < (PR + 2)) GOTO 1130
GOTO 1270
1130 Y = PY + PY - Y
' SOUND 300, 5 * LOUD
IF (RND(1) * 2) > SKILL GOTO 1210
BX = INT(RND(1) * 19.99): BY = INT(RND(1) * 3.99):
IF BRICK(1 + BX, 1 + BY) > 0 GOTO 1210
BRICK(1 + BX, 1 + BY) = -BRICK(1 + BX, 1 + BY)
LINE (L + 2 + (BW * BX), BT + 2 + (BH * BY))-STEP(BW - 4, BH - 4), 2 + INT(BY / 2), BF
SCORE = SCORE - BRICK(1 + BX, 1 + BY)
1210 LOCATE 1, 1
PRINT SCORE;
VY = -VY
MISS = (X - (PL + PR) / 2) / (PL - PR)
VX = VX + VY * MISS * SKILL * 5
SPIN = (SPIN * SKILL) + MISS * SKILL
1270 PUT (X - 2, Y - 2), BALL, XOR
PUT (OX - 2, OY - 2), BALL, XOR
Start = TIMER
DO
LOOP UNTIL TIMER > Start + .05
GOSUB 1410 'move paddle
GOTO 740
1310 REM lost ball
' IF LOUD = 1 THEN SOUND 200, 20
NEXT SHOT
1340 REM End of Game
' DEF SEG = 0: POKE &H410, 125: WIDTH 40: WIDTH 80: SCREEN 0, 0, 0
'WIDTH 80: SCREEN 0, 0, 0
LOCATE 12, 20
PRINT "Do you want to play another game? ";
1370 D$ = INKEY$
IF D$ = "y" THEN RUN"BRKFB.EXE"
IF D$ = "n" THEN STOP
GOTO 1370
1410 REM move paddle routine
OPL = PL
1430 D$ = INKEY$
IF D$ = CHR$(27) THEN END
IF D$ = N$ THEN LOUD = -1 * LOUD + 1
IF D$ = L$ THEN PL = PL - 5: GOTO 1430
IF D$ = R$ THEN PL = PL + 5: GOTO 1430
IF PL < L THEN PL = L
IF PL > (R - 50) THEN PL = R - 50
IF OPL = PL THEN RETURN
PR = PL + 50
PUT (OPL, PY), PADDLE, XOR
PUT (PL, PY), PADDLE, XOR
RETURN
Friday, September 23, 2011
Kisah 5 perkara aneh-kisah dan teladan
Maka salah seorang Nabi yang menerima wahyu melalui mimpi itu, pada suatu malam bermimpi diperintahkan yang berbunyi,
\"Esok engkau dikehendaki keluar dari rumah pada waktu pagi menghala ke barat. Engkau dikehendaki berbuat, pertama; apa yang engkau lihat (hadapi) maka makanlah, kedua; engkau sembunyikan, ketiga; engkau terimalah, keempat; jangan engkau putuskan harapan, yang kelima; larilah engkau daripadanya.\"
Pada keesokan harinya, Nabi itu pun keluar dari rumahnya menuju ke barat dan kebetulan yang pertama dihadapinya ialah sebuah bukit besar berwarna hitam. Nabi itu kebingungan sambil berkata,
\"Aku diperintahkan memakan perkara pertama yang aku hadapi, tapi sungguh aneh sesuatu yang mustahil yang tidak dapat dilaksanakan.\"
Maka Nabi itu terus berjalan menuju ke bukit itu dengan hasrat untuk memakannya. Ketika dia menghampirinya, tiba-tiba bukit itu mengecilkan diri sehingga menjadi sebesar sebuku roti.
Maka Nabi itu pun mengambilnya lalu disuapkan ke mulutnya. Bila ditelan terasa sungguh manis bagaikan madu. Dia pun mengucapkan syukur \'Alhamdulillah\'.
Kemudian Nabi itu meneruskan perjalanannya lalu bertemu pula dengan sebuah mangkuk emas. Dia teringat akan arahan mimpinya supaya disembunyikan, lantas Nabi itu pun menggali sebuah lubang lalu ditanamkan mangkuk emas itu, kemudian ditinggalkannya.
Tiba-tiba mangkuk emas itu terkeluar semula. Nabi itu pun menanamkannya semula sehingga tiga kali berturut-turut. Maka berkatalah Nabi itu, \"Aku telah melaksanakan perintahmu.\"
Lalu dia pun meneruskan perjalanannya tanpa disadari oleh Nabi itu yang mangkuk emas itu terkeluar semula dari tempat ia ditanam.
Ketika dia sedang berjalan, tiba-tiba dia ternampak seekor burung helang sedang mengejar seekor burung kecil. Kemudian terdengarlah burung kecil itu berkata, \"Wahai Nabi Allah, tolonglah aku.\"
Mendengar rayuan burung itu, hatinya merasa simpati lalu dia pun mengambil burung itu dan dimasukkan ke dalam bajunya. Melihatkan keadaan itu, lantas burung helang itu pun datang menghampiri Nabi itu sambil berkata, \"Wahai Nabi Allah, aku sangat lapar dan aku mengejar burung itu sejak pagi tadi. Oleh itu janganlah engkau patahkan harapanku dari rezekiku.\"
Nabi itu teringatkan pesanan arahan dalam mimpinya yang keempat, iaitu tidak boleh putuskan harapan. Dia menjadi kebingungan untuk menyelesaikan perkara itu.
Akhirnya dia membuat keputusan untuk mengambil pedangnya lalu memotong sedikit daging pehanya dan diberikan kepada helang itu. Setelah mendapat daging itu, helang pun terbang dan burung kecil tadi dilepaskan dari dalam bajunya. Selepas kejadian itu, Nabi meneruskan perjalannya.
Tidak lama kemudian dia bertemu dengan satu bangkai yang amat busuk baunya, maka dia pun bergegas lari dari situ kerana tidak tahan menghidu bau yang menyakitkan hidungnya.
Setelah menemui kelima-lima peristiwa itu, maka kembalilah Nabi ke rumahnya. Pada malam itu, Nabi pun berdoa. Dalam doanya dia berkata,
\"Ya Allah, aku telah pun melaksanakan perintah-Mu sebagaimana yang diberitahu di dalam mimpiku, maka jelaskanlah kepadaku erti semuanya ini.\"
Dalam mimpi beliau telah diberitahu oleh Allah S.W.T. bahwa, \"Yang pertama engkau makan itu ialah marah. Pada mulanya nampak besar seperti bukit tetapi pada akhirnya jika bersabar dan dapat mengawal serta menahannya, maka marah itu pun akan menjadi lebih manis daripada madu.
Kedua; semua amal kebaikan (budi), walaupun disembunyikan, maka ia tetap akan nampak jua.
Ketiga; jika sudah menerima amanah seseorang, maka janganlah kamu khianat kepadanya.
Keempat; jika orang meminta kepadamu, maka usahakanlah untuknya demi membantu kepadanya meskipun kau sendiri berhajat.
Kelima; bau yang busuk itu ialah ghibah (menceritakan hal seseorang). Maka larilah dari orang-orang yang sedang duduk berkumpul membuat ghibah.\"
Kelima-lima kisah ini hendaklah kita semaikan dalam diri kita, sebab kelima-lima perkara ini sentiasa saja berlaku dalam kehidupan kita sehari-hari.
Perkara yang tidak dapat kita elakkan setiap hari ialah mengata hal orang, memang menjadi tabiat seseorang itu suka mengata hal orang lain.
Haruslah kita ingat bahwa kata-mengata hal seseorang itu akan menghilangkan pahala kita, sebab ada sebuah hadis mengatakan di akhirat nanti ada seorang hamba Allah akan terkejut melihat pahala yang tidak pernah dikerjakannya. Lalu dia bertanya,
\"Wahai Allah, sesungguhnya pahala yang Kamu berikan ini tidak pernah aku kerjakan di dunia dulu.\"
Maka berkata Allah S.W.T., \"Ini adalah pahala orang yang mengata-ngata tentang dirimu.\"
Dengan ini haruslah kita sedar bahwa walaupun apa yang kita kata itu memang benar, tetapi kata-mengata itu akan merugikan diri kita sendiri. Oleh kerana itu, hendaklah kita jangan mengata hal orang walaupun ia benar.
Senyumlah Sayang...
seorang lelaki yang wajahnya kusam dan keningnya selalu berkerut.Dengan
murung lelaki itu mengadu,\'Tuan Guru, sepanjang hidup saya, rasanya tak
pernah lepas saya beribadah kepada Allah. Orang lain sudah lelap, saya
masih bermunajat. Isteri saya belum bangun, saya sudah mengaji. Saya juga
bukan pemalas yang enggan mencari rezeki. Tetapi mengapa saya selalu malang
dan kehidupan saya penuh kesulitan?\'
Sang Guru menjawab sederhana, \'Perbaiki penampilanmu dan ubahlah riak
mukamu. Kau tahu, Rasulullah SAW adalah penduduk dunia yang miskin namun
wajahnya tak pernah keruh dan selalu ceria. Sebab menurut Rasulullah SAW,
salah satu tanda penghuni neraka ialah muka masam yang membuat orang curiga
kepadanya.\' Lelaki itu tertunduk. Ia pun berjanji akan memperbaiki
penampilannya.
Mulai hari itu, wajahnya sentiasa berseri. Setiap kesedihan diterima dengan
sabar, tanpa mengeluh. Alhamdullilah sesudah itu ia tak pernah datang lagi
untuk berkeluh kesah. Keserasian selalu dijaga. Sikapnya ramah,wajahnya
sentiasa menguntum senyum bersahabat. Riak mukanya berseri.
Tak heran jika Imam Hasan Al Basri berpendapat, awal keberhasilan suatu
pekerjaan adalah air muka yang ramah dan penuh senyum.Bahkan Rasulullah SAW
menegaskan, senyum adalah sedekah paling murah tetapi paling besar
pahalanya.
Demikian pula seorang suami atau seorang isteri. Alangkah celakanya rumah
tangga jika suami isteri selalu berwajah tegang. Sebab tak ada persoalan
yang diselesaikan dengan mudah melalui kekeruhan dan ketegangan. Dalam hati
yang tenang, fikiran yang dingin dan wajah cerah, Insya Allah, apapun
persoalannya nescaya dapat di atasi. Inilah yang dinamakan keluarga
sakinah, yang didalamnya penuh dengan cinta dan kasih sayang.
Cerita anak Umar Abdul Aziz
Sebelum itu kita kembali secara ringkas kepada waktu dimana Umar Abdul Aziz selepas dilantik menjadi Khalifah. Selepas sahaja beliau dilantik menjadi khalifah dalam satu majlis selepas kematian Sulaiman Abdul Malik, beliau hendak balik ke rumah, tatkala itu dia terdengar bunyi kenderaan berkuda yang hebat dan kuat dibawa kepadanya dan disamping itu sejumlah pengawal-pengawal dan tentera-tentera datang mengelilingi beliau , maklumlah beliau merupakan Amirul Mukminin yang memerintah ¼ dunia pada waktu itu.
Lantas Umar Abdul Aziz berkata, \'apakah yang kamu bawa kepada aku ini? \'. Mereka berkata\' ini adalah kenderaan khalifah\'. Maka Umar Abdul Aziz berkata\' aku adalah salah seorang dari kamu iaitu kaum muslimin, pulangkan kenderaan itu ke Baitulmal, begitu juga kamu tentera-tentera, kamu pergilah bekerja dengan tentera kerajaan jika kamu mahu bekerja, jika tidak, kamu juga boleh ambil cuti\'. Lantas beliau menaiki baghal sebagai kenderaan dan balik ke rumah.
Setibanya beliau dirumah, beliau hendak berehat setelah letih menguruskan jenazah mantan khalifah iaitu bapa saudara beliau sendiri. Semasa itulah Abdul Malik(anak beliau) menegurnya dan bertanya \' Kemana ayah hendak pergi? \'. Lantas ayahnya berkata \'ayah letih, hendak berehat sebentar sebelum masuk waktu Zuhur\'. Lantas anaknya bertanya \'kenapa ayah tidak memulakan kerja dan mengembalikan hak-hak orang yang terinaya? \'. Umar pun berkata\' bagilah ayah berehat dahulu\'. Maka anaknya berkata \'Siapakah yang menjamin ayah akan hidup selepas ini dan apabila nanti hak-hak ini dituntut disisi Allah? \' Maka lantas Umar Abdul Aziz bangun dan mencium antara kedua kening anaknya dan berkata \' Segala puji bagi Allah yang mengurniakan aku Abdul Malik !\'.
Dikatakan anaknya yang ini mengheretnya kealam kezuhudan. Abdul Malik dihantar ke sempadan iaitu hampir-hampir dekat dengan tentera untuk melihat aktiviti –aktiviti tentera dalam membuka wilayah yang baru. Umar Abdul Aziz sangat sayang kepada anaknya ini.
Suatu hari terdengar ditelinga Umar abdul Azizi mengenai anaknya itu yang dikatakan ada sedikit \'ego\' dan ini menyebabkan beliau tidak merasa selesa. Lantas memanggil orang kanannya iaitu Maimun Bin Mahram lantas berkata \' Wahai Maimun, anakku ini telah menghiasi mataku (maksudnya segala-gala mengenai anaknya indah baginya), aku bimbang kecintaanku kepadanya membuatkan aku tidak dapat melihat kecacatannya, maka engkau pergilah jumpa dengannya, kerana orang kata dia ada sifat sombong\'.
Maka Maimun pun pergi kesempadan iaitu tempat anaknya tinggal, apa yang Maimun nampak apabila berjumpa dengan Abdul Malik ialah seorang pemuda yanag sangat tacap, sangat berakhlak dan sangat beradap. Tempat tidurnya sangat sederhana(tikar sahaja). Maimun bertanya \' dimanakah kau mengambil makanan setiap hari? \'. Abdul Malik menjawap \' Alhamdulliah makanan halal, aku bekerja diatas tanah bapa saudaraku setiap hari\'. Kemudian Abdul Malik menyatakan kebimbangan terhadap ayahnya iaitu \' aku bimbang kecintaan bapaku kepadaku menyebabkan beliau tidak dapat melihat kecacatanku! \'. Maka bertambah lagilah kekaguman Maimun kepada Abdul Malik kerana bapanya menyatakan perkara yang sama sebelum beliau datang ke sini.
Kemudiannya, samasa Maimun duduk sebentar disitu, tiba-tiba datanglah \'tokey\' tempat mandi awam (hammam- tempat mandi air panas – zaman tersebut tiada heater semasa musim sejuk) lantas memberi kunci kepada anak Umar Abdul Aziz. Lalu Maimun bertanya \' untuk apakah ini? \'. Maka Abul Malik menjawap, \'aku hendak mandi\'. Disamping itu juga \'tokey\' itu berkata \'kau pergilah mandi sekarang, aku telah mengeluarkan semua orang ramai dari tempat mandian tersebut\'.
Mendengarnya perkataan itu, Maimun berkata \'aku sangat mengkagumimu sehiggalah tadi , sebab apakah kau mengeluarkan semua orang ramai dari tempat mandian itu, kau sombong? \'. Abdul Aziz berkata \' saya tak sombong tapi saya sudah bayar kepada tuannya dengan kadar untuk semua orang\'. Lantas Maimun berkata \' kau membazir? \'. Anak Umar Abdul Azizi berkata \'saya bukan membazir, tetapi mereka ini orang kampong, kebiasaannya kadang-kadang mereka tidak menjaga aurat, susah saya, kalau ditegur, mereka kata saya sombong dan sebagainya. Jadi kan elok saya membayar untuk menjadikannya hanya saya sahaja mandi ditempat ini\'. \'Kau sombong !\' kata Maimun, \'kenapa kau sabar sahaja dan menunggu hingga mereka semua keluar, penghujungya baru kamu mandi, kenapa perlu membazir? \'.
Anak Umar Abdul Aziz pun berkata \' aku berjanji aku tidak akan membuatnya lagi kalau itu tanda ornag yang sombong \'. Kemudianya Maimun berkata \' macamana aku hendak melapurkan kepada bapa engkau ? \' ( Maimun ingin menguji lagi anak Umar Abdul Aziz). Lantas Abdul Malik berkata \' kau kata kepada ayahku, engkau ada melihat perkara yang kurang elok padaku, dan engkau telah menasihatku dan aku telah beristifar dan menginsafinya dan berjanji tidak akan mengulanginya lagi\'. \'Bagaimana pula jika ayah engkau bertanya apakah perkara tidak elok itu? \'. Lantas anak Umar Abdul Aziz berkata \'TIDAK!\', ‘Ayahku tidak akan bertanya sebab ayahku pun tahu Allah tidak menyuruh membuka aib orang\'. Tambahnya lagi \' Ayahku tidak akan bertanya aib orang termasuklah aib anaknya kerana ianya bukanlah keperluan\'. Maimun berkata didalam hatinya \' aku kagum kepada bapa dan anak yang kedua-duanya taat kepada Allah dan Rasulnya\'.
Begitulah sedikit coretan mengenai akhlak Umar dan anaknya, semoga ianya bermanafaat. Maka dapat disimpulkan bahawa:
1. Kita tidak boleh mendedahkah aib orang ( lebih kepada peribadi)
2. Kita boleh mendedahkan aib orang pada kadar-kadar tertentu sekiranya melibatkan hak-hak orang awam yang mana kalau dibiarkan akan merosakkan masyarakat awam ( contoh rasuah , mencuri dan sebagainya)
Thursday, September 22, 2011
Wudhu' Zahir dan Batin
solatnya. Namun, dia selalu khuatir kalau-kalau ibadahnya kurang khusyuk
dan selalu bertanya kepada orang yang dianggapnya lebih ibadahnya,
demi untuk memperbaiki dirinya yang selalu dirasainya kurang khusyuk.
Pada suatu hari, Isam menghadiri majlis seorang abid bernama Hatim Al-Assam
dan bertanya, "Wahai Aba Abdurrahman, bagaimanakah caranya tuan solat?"
Hatim berkata, "Apabila masuk waktu solat, aku berwudhu' zahir dan batin."
Isam bertanya, "Bagaimana wudhu' zahir dan batin itu?"
Hatim berkata, "Wudhu' zahir sebagaimana biasa iaitu membasuh semua anggota wudhu' dengan air".
Sementara wudhu' batin ialah membasuh anggota dengan tujuh perkara :-
* Bertaubat
* Menyesali dosa yang telah dilakukan
* Tidak tergila-gilakan dunia
* Tidak mencari/mengharap pujian orang (riya')
* Tinggalkan sifat berbangga
* Tinggalkan sifat khianat dan menipu
* Meninggalkan sifat dengki.
"Bertaqwalah kepada Allah di mana sahaja anda berasa, iringilah perbuatan yang tidak baik dengnan perbuatan yang baik nescaya terhapuslah dosanya, dan bergaul(berkawan) orang ramai dengan perangai(kelakuan) yang baik." - Diriwayatkan oleh Tarmizi dari Abi Zar