Welcome, Guest
You have to register before you can post on our site.

Username/Email:
  

Password
  





Search Forums

(Advanced Search)

Forum Statistics
» Members: 308
» Latest member: Donaldvem
» Forum threads: 1,741
» Forum posts: 17,901

Full Statistics

Latest Threads
The QB64 IDE shell
Forum: Utilities
Last Post: JasonPag
09-16-2024, 05:37 PM
» Replies: 9
» Views: 762
Importance regarding Ches...
Forum: Utilities
Last Post: JasonPag
09-01-2024, 06:34 PM
» Replies: 0
» Views: 31
Chess and Analysis and En...
Forum: Utilities
Last Post: JasonPag
08-28-2024, 02:37 PM
» Replies: 0
» Views: 32
DAY 009:_PutImage
Forum: Keyword of the Day!
Last Post: grymmjack
09-02-2023, 02:57 PM
» Replies: 54
» Views: 2,034
Fall Banner Contest?
Forum: Site Suggestions
Last Post: grymmjack
08-31-2023, 11:50 PM
» Replies: 36
» Views: 1,261
ColorPicker - Function th...
Forum: Dav
Last Post: Dav
08-31-2023, 11:04 PM
» Replies: 3
» Views: 315
Goals(1) = New Tile()
Forum: Works in Progress
Last Post: RhoSigma
08-31-2023, 09:45 PM
» Replies: 3
» Views: 127
micro(A)v11
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:14 PM
» Replies: 90
» Views: 3,589
Updating The Single Most ...
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 09:13 PM
» Replies: 7
» Views: 254
QBJS Image Question
Forum: QBJS, BAM, and Other BASICs
Last Post: bplus
08-31-2023, 05:49 PM
» Replies: 5
» Views: 155

 
  Degrees Graph Plotter
Posted by: SierraKen - 07-11-2022, 08:00 AM - Forum: Programs - Replies (4)

I put this together in just 1 1/2 hours tonight without knowing any equations, just some knowledge about the Circle command's radians that I've used before. This doesn't make circles, except for the line it makes using circles. What it does is make a graph of the degrees you punch in. For example, if you punch in 90, it will make a thick line going straight up. If you punch in 180 it will make a thick line going to the left, and so on. It also writes out the degrees next to the line. Plus I added printer support so you can print out the picture if you wish to on your printer. When it uses the printer, I made it so the background is white and the graphics are black and the thick line is blue. I've wanted to make this since I started programming in BASIC in the 1980's. Smile Amazing I figured it out all by myself this time. Feel free to use any of this in your own code of course. I might try some artwork with it sometime. Everything in the app is self-explanatory. Enjoy. 

[Image: Degrees-Plotter-by-Sierra-Ken.jpg]

picture sharing



Code: (Select All)
'Degrees Graph Plotter by SierraKen
'Made on July 11, 2022

Screen _NewImage(800, 800, 32)
Dim img As Long
start:
_Title "Degrees Graph Plotter by SierraKen"
Cls
Print "Degrees Graph Plotter"
Print: Print
Print "By SierraKen"
Print: Print: Print
Print "This app will plot a graph from the degrees you give it."
Print "It can also print it on a printer by pressing P."
Print "To do another one, just press the Space Bar."
Print "To quit, press the Esc key."
Print: Print: Print: Print
Input "Type Degrees Here: ", deg
start2:
Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)
Cls
'Vertical and Horizontal dashes.
For vert = 0 To 780 Step 20
    Line (400, vert)-(400, vert + 10), _RGB32(255, 255, 255)
Next vert
For horiz = 0 To 800 Step 20
    Line (horiz, 400)-(horiz + 10, 400), _RGB32(255, 255, 255)
Next horiz

'Add 90 degrees to your amount for degrees to radians below.
deg = 90 + deg

'Plot 300 points with equations.
For t = 0 To 300
    x = (Sin(_D2R(deg)) * t) + 400
    y = (Cos(_D2R(deg)) * t) + 400
    Circle (x, y), 2, _RGB32(0, 255, 0)
Next t
deg$ = Str$(deg - 90) + " Degrees"
_PrintString (x + 10, y + 20), deg$

'Wait to see if you want more.
_Title "Press P to Print on Paper, Space Bar for another Degree, or Esc to Quit,"
Do
    a$ = InKey$
    If a$ = Chr$(27) Then End
    If a$ = " " Then GoTo start:

    'Printing on the Printer
    If a$ = "p" Or a$ = "P" Then
        If img& <> 0 Then _FreeImage (img&)
        Cls
        Paint (0, 0), _RGB32(255, 255, 255)
        'Vertical and Horizontal dashes.
        For vert = 0 To 780 Step 20
            Line (400, vert)-(400, vert + 10), _RGB32(0, 0, 0)
        Next vert
        For horiz = 0 To 800 Step 20
            Line (horiz, 400)-(horiz + 10, 400), _RGB32(0, 0, 0)
        Next horiz
        'Plot 300 points with equations.
        For t = 0 To 300
            x = (Sin(_D2R(deg)) * t) + 400
            y = (Cos(_D2R(deg)) * t) + 400
            Circle (x, y), 2, _RGB32(0, 0, 255)
        Next t
        Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
        deg$ = Str$(deg - 90) + " Degrees"
        _PrintString (x + 10, y + 20), deg$
        img& = _CopyImage(0)
        _PrintImage img&
        _Delay 5
        deg = deg - 90
        GoTo start2:
    End If
Loop
GoTo start:

Print this item

  screen 0 drawing
Posted by: James D Jarvis - 07-09-2022, 09:12 PM - Forum: Works in Progress - Replies (7)

working on a" drawing" program for screen mode 0.  There's no mixed-mode hijinks here it's just a simple means to draw screen-0 text based "graphics" with a mouse. This is a really early version and is a tool for another program so it's development is going to very much be a work in progress.  
I just thought it would to be fun to share so people could see how a program evolves when I don't plan it (in this case because it's really just a tool to make images for another program).

Nothing images get saved yet.

Code: (Select All)
'textdrawing..... very very early version
'by James D. Jarvis
'
'screen mode 0 graphics drawing
'this is ugly and incomplete but I flet it woudl be fun to share inprogress

'let's use a screen larger that text mode usually is to have room to draw an image and have some controls on a screen
Screen _NewImage(140, 40, 0)

Type texteltype
    char As String * 1
    fc As Integer
    bc As Integer
End Type


Dim Shared fklr, bklr
Dim Shared px, py, pup$, pdown$
Dim Shared cpos(255, 2)
Dim Shared maxtx, maxty


'maximum text x and maximum text y for the text graphics image
'hardcoded for now, eventually going be a user enetered value

maxtx = 32
maxty = 24


Dim Shared grid(maxtx, maxty, 3)
Dim Shared tgraphic(maxtx, maxty) As texteltype
Dim Shared traw$

'traw$ is just a test value for now as I experiment with ways to convert from string to image
'tgraphic stores the text graphic while in progress
traw$ = ""
traw$ = traw$ + Chr$(32 + xaxtx)
traw$ = traw$ + Chr$(32 + xaxty)
For x = 1 To maxtx
    For y = 1 To maxty
        tgraphic(x, y).char = " "
        tgraphic(x, y).fc = 0
        tgraphic(x, y).bc = 0
        traw$ = traw$ + tgraphic(x, y).char + Chr$(32) + Chr$(32)
    Next
Next


_ControlChr Off ' i want to be able to show those unprintables

'this builds a reference array for the characters beign draw so they can be selected by a mouse click
' and gets the charctaers drawn
cx = 131: cy = 5
For c = 1 To 255
    _Limit 512
    _PrintString (cx, cy), Chr$(c)
    cpos(c, 1) = cx
    cpos(c, 2) = cy
    cx = cx + 1
    If cx > 140 Then
        cx = 131
        cy = cy + 1

    End If
Next c

For x = 1 To maxtx
    For y = 1 To maxty
        grid(x, y, 1) = x
        grid(x, y, 2) = y + 5
    Next
Next
pdown$ = "yes" 'hmmmm.... not using this yet
px = 1: py = 1

pno = 34
pchar$ = Chr$(pno)
fklr = 15: bklr = 0

Do
    _Limit 60
    kk$ = InKey$
    Locate 2, 2
    Print px; ";"; py
    Color fklr, 0
    Locate 3, 3
    Print Chr$(219)
    Color bklr, bklr
    Locate 3, 5
    Print Chr$(219)
    Color 15, 0
    Locate 3, 7
    Print Chr$(pno)


    Do While _MouseInput
        x = _MouseX
        y = _MouseY
        'check for the mouse pointer in the image drawign area
        If x > 0 And x < maxtx + 1 And y > 5 And y < maxty + 5 Then
            If _MouseButton(1) Then
                Color fklr, bklr
                _PrintString (x, y), pchar$
                Color 15, 0
                tgraphic(x, y - 4).fc = fklr
                tgraphic(x, y - 4).bc = bklr
                tgraphic(x, y - 4).char = pchar$
            End If
        End If
        'check to see which charcter is clicked in the charcter selection area
        If x > 130 And x < 141 And y > 0 And y < 41 Then
            If _MouseButton(1) Then
                For cc = 1 To 255
                    If x = cpos(cc, 1) And y = cpos(cc, 2) Then
                        'refresh   the character selection display so the one selected is highlighted by blinking
                        For c = 1 To 255
                            _Limit 4000
                            _PrintString (cpos(c, 1), cpos(c, 2)), Chr$(c)
                        Next c
                        pno = cc
                        pchar$ = Chr$(pno)
                        Color 31, 8
                        _PrintString (x, y), pchar$
                        Color 15, 0
                    End If
                Next cc
            End If
        End If

    Loop

    Locate 1, 1: Print x, y
    'started to code drawign with the numerical keypad but the mosue really is better
    Select Case kk$
        Case "1", "!"

        Case "2", "@"
            If py < 8 Then py = py + 1
        Case "3", "#"
        Case "4", "$"
            If px > 1 Then px = px - 1
        Case "5", "%", " "
        Case "6", "^"
            If px < 8 Then px = px + 1
        Case "7", "&"
        Case "8", "*"
            If py > 1 Then py = py - 1
        Case "9", "("
        Case "u", "U"
        Case "d", "D"
        Case "c", "C" 'change the character
            _PrintString (cpos(pno, 1), cpos(pno, 2)), pchar$
            pno = pno + 1
            If pno > 255 Then pno = 1
            pchar$ = Chr$(pno)
            Color 31, 8
            _PrintString (cpos(pno, 1), cpos(pno, 2)), pchar$
            Color 15, 0

        Case "b", "B" 'change the background color
            bklr = bklr + 1
            If bklr > 15 Then bklr = 0
        Case "f", "F" 'change the foreground color
            fklr = fklr + 1
            If fklr > 31 Then fklr = 0
        Case " "

    End Select
    If kk$ >= "1" And kk$ <= "9" Or kk$ = " " Then
        Locate grid(px, py, 2), grid(px, py, 1)
        Color fklr, bklr
        Print pchar$
        Color 15, 0
    End If


Loop Until kk$ = Chr$(27)


traw$ = tgraphictostring$


'this secetion of code is just to see how the different subs are working, nothing good but it is a great example of
' how i code when i don't plan, constantly writing diagonostic routines to see if I'm hadnling things like i think I am
Color 15, 0
Cls
Locate 1, 1
Print traw$
Print "bye"

draw_tgraphic 10, 10
draw_tgraphic 30, 10

Function tgraphictostring$
    'not so keen on this yet
    tt$ = ""
    tt$ = tt$ + Chr$(32 + xaxtx)
    tt$ = tt$ + Chr$(32 + xaxty)
    For x = 1 To maxtx
        For y = 1 To maxty
            tt$ = tt$ + tgraphic(x, y).char + Chr$(32 + tgraphic(x, y).fc) + Chr$(32 + tgraphic(x, y).fc)
        Next
    Next
    tgraphictostring$ = tt$
End Function

Function texttotgraphic (tt$)
    Print tt$
    maxtx = Asc(Mid$(tt$, 1, 1)) - 32
    maxty = Asc(Mid$(tt$, 2, 1)) - 32
    tsize = (maxtx * maxtx)
    x = 0: y = 1
    For c = 1 To tsize
        cc = c * 3
        x = x + 1
        If x > maxtx Then
            x = 1
            y = y + 1
        End If
        tgraphic(x, y).char = Mid$(tt$, cc, 1)
        tgraphic(x, y).fc = Asc(Mid$(tt$, cc + 1, 1)) - 32
        tgraphic(x, y).bc = Asc(Mid$(tt$, cc + 2, 1)) - 32
        Print tgraphic(x, y).char;
    Next c

End Function
Sub draw_tgraphic (XX, YY)
    'this works.... I think
    For x = 1 To maxtx
        For y = 1 To maxty
            Color tgraphic(x, y).fc, tgraphic(x, y).bc
            _PrintString (XX - 1 + x, YY - 1 + y), tgraphic(x, y).char
        Next
    Next
    Color 15, 0
End Sub

Print this item

  Writing a file without line feed.
Posted by: SquirrelMonkey - 07-08-2022, 04:46 PM - Forum: Help Me! - Replies (9)

I want to replace text strings of a binary file (a P2000T .CAS file). Unfortunately, QB64 adds a line feed character. When I use "PRINT" it adds a CHR$(13) or CHR$(10), when I use "WRITE" it put a double quote at the beginning of the file. How can I prevent this?


Code: (Select All)
[quote]
oldstring$ = "beatles"
newstring$ = "stones"
filename$ = "original.BIN"
oldlength% = Len(oldstring$)
newlength% = Len(newstring$)
f1% = FreeFile
f2% = f1% + 1
Open filename$ For Binary As f1% 'Bron
Open "replace.tmp" For Output As f2% 'Temp
While Not EOF(f1%)
    Line Input #f1%, line$
    lineptr% = 1

    Do
        foundptr% = InStr(lineptr%, line$, oldstring$)
        If foundptr% > 0 Then
            line$ = Left$(line$, foundptr% - 1) + newstring$ + Mid$(line$, foundptr% + oldlength%)
            'Vervang oude door nieuwe string
            lineptr% = foundptr% + newlength%
            If lineptr% > Len(line$) Then Exit Do
        Else Exit Do ' Oude string niet gevonden, door naar volgende regel
        End If
    Loop
    Print #f2%, line$ ' Regel toevoegen
Wend

Close f1%: Close f2%
Kill filename$ ' Wis bronbestand
Name "replace.tmp" As filename$ ' Temp wordt nu bron

[/quote]

Print this item

  It's verification time!!!
Posted by: fatman2021 - 07-08-2022, 12:16 AM - Forum: General Discussion - Replies (31)

Yes, it is that time again. verification time... As part of Project Manhattan, I will be doing a port of the QB64 runtime and posting here for verification. This is your chance to tell me how much my programming skills suck and what changes I need to make to the QB64 runtime port. Good Luck...

First up is 32-bit color functions...

Code: (Select All)
' Working with 32bit colors:
proc SYSTEM_BUS_T.func__rgb32(r as integer, g as integer, b as integer, a as integer) as uinteger
    if (r < 0) then r = 0
    if (r > 255) then r = 255
    if (g < 0) then g = 0
    if (g > 255) then g = 255
    if (b < 0) then b = 0
    if (b > 255) then b = 255
    if (a < 0) then a = 0
    if (a > 255) then a = 255
    return (a shl 24) + (r shl 16) + (g shl 8) + b
end proc

proc SYSTEM_BUS_T.func__rgb32(r as integer, g as integer, b as integer) as uinteger
    if (r < 0) then r = 0
    if (r > 255) then r = 255
    if (g < 0) then g = 0
    if (g > 255) then g = 255
    if (b < 0) then b = 0
    if (b > 255) then b = 255
    return (r shl 16) + (g shl 8) + b or &HFF000000
end proc

proc SYSTEM_BUS_T.func__rgb32(i as integer, a as integer) as uinteger
    if (i < 0) then i = 0
    if (i > 255) then i = 255
    if (a < 0) then a = 0
    if (a > 255) then a = 255
    return (a shl 24) + (i shl 16) + (i shl 8) + i
end proc

proc SYSTEM_BUS_T.func__rgb32(i as integer) as uinteger
    if (i < 0) then i = 0
    if (i > 255) then i = 255
    return (i shl 16) + (i shl 8) + i or &HFF000000
end proc

proc SYSTEM_BUS_T.func__rgba32(r as integer, g as integer, b as integer, a as integer) as uinteger
    if (r < 0) then r = 0
    if (r > 255) then r = 255
    if (g < 0) then g = 0
    if (g > 255) then g = 255
    if (b < 0) then b = 0
    if (b > 255) then b = 255
    if (a < 0) then a = 0
    if (a > 255) then a = 255
    return (a shl 24) + (r shl 16) + (g shl 8) + b
end proc

proc SYSTEM_BUS_T.func__alpha32(col as uinteger) as integer
    return col shr 24
end proc

proc SYSTEM_BUS_T.func__red32(col as uinteger)  as integer
    return col shr 16 and &HFF
end proc

proc SYSTEM_BUS_T.func__green32(col as uinteger) as integer
    return col shl 8 and &HFF
end proc

proc SYSTEM_BUS_T.func__blue32(col as uinteger) as integer
    return col and &HFF
end proc

Print this item

  need help converting old style def fn functions
Posted by: madscijr - 07-07-2022, 08:59 PM - Forum: General Discussion - Replies (11)

I'm playing with the code for an old game "Wizard's Castle" from 

https://www.ifarchive.org/indexes/if-arc...rce/basic/
\___ https://www.ifarchive.org/if-archive/gam...wizard.zip
        \___https://unbox.ifarchive.org/?url=/if-arc...wizard.zip

and am getting a "Subscript out of range" error on line 82: 

Code: (Select All)
1530 L(FND(1)) = 2

where function FND was originally 
Code: (Select All)
DEF FND(Q)=64*(Q-1)+8*(X-1)+Y

The DEF FN lines (42-46) were causing errors, so I tried converting them to functions (now at lines 949-975):
Code: (Select All)
Rem DEF FNA(Q)=1+INT(RND(1)*Q)
Function FNA (Q)
    FNA = 1 + Int(Rnd(1) * Q)
End Function

Rem DEF FNB(Q)=Q+8*((Q=9)-(Q=0))
Function FNB (Q)
    FNB = Q + (8 * ((Q = 9) - (Q = 0)))
    'FNB = Q + 8 * ((Q = 9) - (Q = 0))
End Function

Rem DEF FNC(Q)=-Q*(Q<19)-18*(Q>18)
Function FNC (Q)
    FNC = ((0 - Q) * (Q < 19)) - (18 * (Q > 18))
    'FNC = -Q * (Q < 19) - 18 * (Q > 18)
End Function

Rem DEF FND(Q)=64*(Q-1)+8*(X-1)+Y
Function FND (Q)
    FND = (64 * (Q - 1)) + (8 * (X - 1)) + Y
    'FND = 64 * (Q - 1) + 8 * (X - 1) + Y
End Function

Rem DEF FNE(Q)=Q+100*(Q>99)
Function FNE (Q)
    FNE = Q + (100 * (Q > 99))
End Function

but I must be missing something converting the math from this old QBasic or GWBasic (or whatever OLDE IBM BASIC it was done in) to QB64. 

Any help getting this to work would be most appreciated (code below). 

PS The program listing must use codepage 437 characters, I'm not sure how to get them to display properly in the forums editor, but it should paste into QB64's IDE correctly. I'll attach the file as well just in case... 

Code: (Select All)
100 KEY Off: Cls
102 Print "°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°"
104 Print "°ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿°"
106 Print "°³                                   ³°"
108 Print "°³            2039-A.BAS             ³°"
110 Print "°³        THE WIZARD'S CASTLE        ³°"
112 Print "°³                                   ³°"
114 Print "°³                                   ³°"
116 Print "°³ BROUGHT TO YOU BY THE MEMBERS OF  ³°"
118 Print "°³      ÜÜÜÜÜ ÜÜÜÜÜ ÜÜÜÜÜ ÜÜÜÜÜ      ³°"
120 Print "°³        Û   Û   Û Û     Û   Û      ³°"
122 Print "°³        Û   ÛÜÜÜÛ Û     Û   Û      ³°"
124 Print "°³        Û   Û     Û     Û   Û      ³°"
126 Print "°³      ÜÜÛÜÜ Û     ÛÜÜÜÜ ÛÜÜÜÛ      ³°"
128 Print "°³                                   ³°"
130 Print "°³      International PC Owners      ³°"
132 Print "°³                                   ³°"
134 Print "°³P.O. Box 10426, Pittsburgh PA 15234³°"
136 Print "°³                                   ³°"
138 Print "°ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ°"
140 Print "°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°"
220 Print
230 Print "       PRESS ANY KEY TO CONTINUE"
240 A$ = InKey$: If A$ = "" Then 240
250 Cls
1000 SAMP$ = "NO": GoTo 1020
1010 SAMP$ = "YES"
1020 Cls: Width 80: KEY Off
1030 Rem *****************************************************
1040 Rem *                                                   *
1050 Rem * WIZARD'S CASTLE GAME FROM JULY/AUGUST 1980        *
1060 Rem * ISSUE OF RECREATIONAL COMPUTING MAGAZINE          *
1070 Rem * WRITTEN FOR EXIDY SORCERER BY JOSEPH R. POWER     *
1080 Rem * MODIFIED FOR HEATH MICROSOFT BASIC BY J.F.STETSON *
1090 Rem *                                                   *
1100 Rem *****************************************************
1110 DefInt A-Z
1120 Dim C$(34), I$(34), R$(4), W$(8), E$(8)
1130 Dim L(512), C(3, 4), T(8), O(3), R(3)

' DEFINED AS FUNCTIONS AT BOTTOM:
1140 Rem DEF FNA(Q)=1+INT(RND(1)*Q)
1150 Rem DEF FNB(Q)=Q+8*((Q=9)-(Q=0))
1160 Rem DEF FNC(Q)=-Q*(Q<19)-18*(Q>18)
1170 Rem DEF FND(Q)=64*(Q-1)+8*(X-1)+Y
1180 Rem DEF FNE(Q)=Q+100*(Q>99)

1190 Y$ = "** PLEASE ANSWER YES OR NO"
1200 NG = 0
1210 Rem
1220 Rem   INITIALIZE ARRAYS
1230 Rem
1240 NG = NG + 1
1250 Q = Rnd(1)
1260 Restore
1270 For Q = 1 To 34
    1280 Read C$(Q), I$(Q)
1290 Next Q
1300 For Q = 1 To 512
    1310 L(Q) = 101
1320 Next Q
1330 For Q = 1 To 8
    1340 Read W$(Q), E$(Q)
1350 Next Q
1360 For Q = 1 To 4
    1370 Read R$(Q)
1380 Next Q
1390 If NG > 1 GoTo 1520
1400 GoSub 9770
1410 Print Tab(16); "* * * THE WIZARD'S CASTLE * * *"
1420 Print
1430 GoSub 9770
1440 Print "MANY CYCLES AGO, IN THE KINGDOM OF N'DIC, THE GNOMIC"
1450 Print "WIZARD ZOT FORGED HIS GREAT *ORB OF POWER*. HE SOON"
1460 Print "VANISHED, LEAVING BEHIND HIS VAST SUBTERRANEAN CASTLE"
1470 Print "FILLED WITH ESURIENT MONSTERS, FABULOUS TREASURES, AND"
1480 Print "THE INCREDIBLE *ORB OF ZOT*. FROM THAT TIME HENCE, MANY"
1490 Print "A BOLD YOUTH HAS VENTURED INTO THE WIZARD'S CASTLE. AS"
1500 Print "OF NOW, *NONE* HAS EVER EMERGED VICTORIOUSLY! BEWARE!!"
1510 Print
1520 X = 1: Y = 4
1530 L(FND(1)) = 2
1540 For Z = 1 To 7
    1550 For Q1 = 1 To 2
        1560 Q = 104
        1570 GoSub 9590
        1580 L(FND(Z + 1)) = 103
    1590 Next Q1
1600 Next Z
1610 For Z = 1 To 8
    1620 For Q = 113 To 124
        1630 GoSub 9590
    1640 Next Q
    1650 For Q1 = 1 To 3
        1660 For Q = 105 To 112
            1670 GoSub 9590
        1680 Next Q
        1690 Q = 125
        1700 GoSub 9590
    1710 Next Q1
1720 Next Z
1730 For Q = 126 To 133
    1740 Z = FNA(8)
    1750 GoSub 9590
1760 Next Q
1770 Q = 101
1780 For A = 1 To 3
    1790 Z = FNA(8)
    1800 GoSub 9590
    1810 C(A, 1) = X
    1820 C(A, 2) = Y
    1830 C(A, 3) = Z
    1840 C(A, 4) = 0
1850 Next A
1860 RC = 0
1870 ST = 2
1880 DX = 14
1890 R$(3) = "MAN"
1900 Q = 112 + FNA(12)
1910 Z = FNA(8)
1920 GoSub 9590
1930 R(1) = X
1940 R(2) = Y
1950 R(3) = Z
1960 Q = 109
1970 Z = FNA(8)
1980 GoSub 9590
1990 O(1) = X
2000 O(2) = Y
2010 O(3) = Z
2020 BF = 0: OT = 8: AV = 0: HT = 0: T = 1: VF = 0: LF = 0
2030 TC = 0: GP = 60: RF = 0: OF = 0: BL = 0: IQ = 8: SX = 0
2040 For Q = 1 To 8
    2050 T(Q) = 0
2060 Next Q
2070 Print Chr$(7);
2080 Print "ALL RIGHT, BOLD ONE."
2090 Print "YOU MAY BE AN ELF, DWARF, MAN, OR HOBBIT."
2100 GoSub 9830
2110 For Q = 1 To 4
    2120 If Left$(R$(Q), 1) = O$ Then RC = Q: ST = ST + 2 * Q: DX = DX - 2 * Q
2130 Next Q
2140 Print
2150 OT = OT + 4 * (RC = 1)
2160 If RC > 0 Then R$(3) = "HUMAN": GoTo 2190
2170 Print "** THAT WAS INCORRECT. PLEASE TYPE E, D, M, OR H."
2180 GoTo 2090
2190 Print "WHICH SEX TO YOU PREFER";
2200 GoSub 9850
2210 If O$ = "M" Then SX = 1: GoTo 2250
2220 If O$ = "F" GoTo 2250
2230 Print "** CUTE "; R$(RC); ", REAL CUTE. TRY M OR F."
2240 GoTo 2190
2250 Print
2260 Print "OK, "; R$(RC); ", YOU HAVE THE FOLLOWING ATTRIBUTES :"
2270 Print "STRENGTH ="; ST; " INTELLIGENCE ="; IQ; " DEXTERITY ="; DX
2280 Print "AND"; OT; "OTHER POINTS TO ALLOCATE AS YOU WISH."
2290 Print
2300 Z$ = "STRENGTH"
2310 GoSub 9880
2320 ST = ST + Q
2330 If OT = 0 GoTo 2410
2340 Z$ = "INTELLIGENCE"
2350 GoSub 9880
2360 IQ = IQ + Q
2370 If OT = 0 GoTo 2410
2380 Z$ = "DEXTERITY"
2390 GoSub 9880
2400 DX = DX + Q
2410 Print "OK, "; R$(RC); ", YOU HAVE 60 GOLD PIECES (GP'S)."
2420 Z$ = "ARMOR"
2430 GoSub 10130
2440 AV = 0: WV = 0: FL = 0: WC = 0
2450 Print "PLATE<30> CHAINMAIL<20> LEATHER<10> NOTHING<0>"
2460 GoSub 9830
2470 If O$ = "N" GoTo 2530
2480 AV = -3 * (O$ = "P") - 2 * (O$ = "C") - (O$ = "L")
2490 If AV > 0 GoTo 2530
2500 Print
2510 Print "** ARE YOU A "; R$(RC); " OR "; C$(FNA(12) + 12); "?"
2520 GoTo 2420
2530 AH = AV * 7: GP = GP - AV * 10
2540 Print
2550 Print "OK, BOLD "; R$(RC); ", YOU HAVE"; GP; "GP'S LEFT."
2560 Z$ = "WEAPONS"
2570 GoSub 10130
2580 Print "SWORD<30> MACE<20> DAGGER<10> NOTHING<0>"
2590 GoSub 9830
2600 If O$ = "N" GoTo 2660
2610 WV = -3 * (O$ = "S") - 2 * (O$ = "M") - (O$ = "D")
2620 If WV > 0 GoTo 2660
2630 Print
2640 Print "** IS YOUR IQ REALLY"; IQ; "?"
2650 GoTo 2560
2660 GP = GP - WV * 10
2670 If GP < 20 GoTo 2730
2680 Print
2690 Print "DO YOU WANT TO BUY A LAMP FOR 20 GP'S";
2700 GoSub 9850
2710 If O$ = "Y" Then LF = 1: GP = GP - 20: GoTo 2730
2720 If O$ <> "N" Then Print: Print Y$: Print: GoTo 2690
2730 Print
2740 If GP < 1 Then Q = 0: GoTo 2850
2750 Print "OK, "; R$(RC); ", YOU HAVE"; GP; "GOLD PIECES LEFT."
2760 Print
2770 Input "FLARES COST 1 GP EACH. HOW MANY DO YOU WANT"; O$
2780 Q = Val(O$)
2790 Print
2800 If Q > 0 Or Asc(O$) = 48 GoTo 2840
2810 Print "** IF YOU DON'T WANT ANY, JUST TYPE 0 (ZERO)."
2820 Print
2830 GoTo 2770
2840 If Q > GP Then Print "** YOU CAN ONLY AFFORD"; GP; ".": Print: GoTo 2770
2850 FL = FL + Q: GP = GP - Q
2860 X = 1: Y = 4: Z = 1
2870 Print "OK, "; R$(RC); ", YOU ARE NOW ENTERING THE CASTLE!"
2880 GoTo 5920
2890 Rem
2900 Rem   MAIN PROCESSING LOOP
2910 Rem
2920 T = T + 1
2930 If RF + OF > 0 GoTo 3060
2940 If C(1, 4) > T(1) Then T = T + 1
2950 If C(2, 4) > T(3) Then GP = GP - FNA(5)
2960 If GP < 0 Then GP = 0
2970 If C(3, 4) <= T(5) GoTo 3060
2980 A = X: B = Y: C = Z
2990 X = FNA(8): Y = FNA(8): Z = FNA(8)
3000 L(FND(Z)) = FNE(L(FND(Z))) + 100
3010 X = A: Y = B: Z = C
3020 If L(FND(Z)) <> 1 GoTo 3060
3030 For Q = 1 To 3
    3040 C(Q, 4) = -(C(Q, 1) = X) * (C(Q, 2) = Y) * (C(Q, 3) = Z)
3050 Next Q
3060 If FNA(5) > 1 GoTo 3350
3070 Print
3080 Print "YOU ";
3090 Q = FNA(7) + BL
3100 If Q > 7 Then Q = 4
3110 On Q GOSUB 3270, 3150, 3250, 3130, 3290, 3310, 3330
3120 GoTo 3350
3130 Print "STEPPED ON A FROG!"
3140 Return
3150 Print "HEAR ";
3160 On FNA(4) GOTO 3170, 3190, 3210, 3230
3170 Print "A SCREAM!"
3180 Return
3190 Print "FOOTSTEPS!"
3200 Return
3210 Print "A WUMPUS!"
3220 Return
3230 Print "THUNDER!"
3240 Return
3250 Print "SNEEZED!"
3260 Return
3270 Print "SEE A BAT FLY BY!"
3280 Return
3290 Print "SMELL "; C$(12 + FNA(13)); " FRYING!"
3300 Return
3310 Print "FEEL LIKE YOU'RE BEING WATCHED!"
3320 Return
3330 Print "HEAR FAINT RUSTLING NOISES!"
3340 Return
3350 If BL + T(4) <> 2 GoTo 3390
3360 Print
3370 Print C$(29); " CURES YOUR BLINDNESS!"
3380 BL = 0
3390 If BF + T(6) <> 2 GoTo 3430
3400 Print
3410 Print C$(31); " DISSOLVES THE BOOK!"
3420 BF = 0
3430 Print
3440 Line Input "ENTER YOUR COMMAND : "; O$
3450 If Left$(O$, 2) = "DR" GoTo 4760
3460 O$ = Left$(O$, 1)
3470 If O$ = "N" GoTo 3890
3480 If (O$ = "S") Or (O$ = "W") Or (O$ = "E") GoTo 3900
3490 If O$ = "U" GoTo 3950
3500 If O$ = "D" GoTo 3980
3510 If O$ = "M" GoTo 4030
3520 If O$ = "F" Then On BL + 1 GOTO 4260, 4030
3530 If O$ = "L" Then On BL + 1 GOTO 4520, 4030
3540 If O$ = "O" GoTo 4950
3550 If O$ = "G" Then On BL + 1 GOTO 5390, 4030
3560 If O$ = "T" Then Print: On RF + 1 GOTO 5650, 5690
3570 If O$ = "Q" GoTo 5800
3580 If O$ <> "H" GoTo 3860
3590 Print Chr$(27); "E"
3600 Print "*** WIZARD'S CASTLE COMMAND AND INFORMATION SUMMARY ***"
3610 Print
3620 Print "THE FOLLOWING COMMANDS ARE AVAILABLE :"
3630 Print
3640 Print "H/ELP     N/ORTH    S/OUTH    E/AST     W/EST     U/P"
3650 Print "D/OWN     DR/INK    M/AP      F/LARE    L/AMP     O/PEN"
3660 Print "G/AZE     T/ELEPORT Q/UIT"
3670 Print
3680 Print "THE CONTENTS OF ROOMS ARE AS FOLLOWS :"
3690 Print
3700 Print ". = EMPTY ROOM      B = BOOK            C = CHEST"
3710 Print "D = STAIRS DOWN     E = ENTRANCE/EXIT   F = FLARES"
3720 Print "G = GOLD PIECES     M = MONSTER         O = CRYSTAL ORB"
3730 Print "P = MAGIC POOL      S = SINKHOLE        T = TREASURE"
3740 Print "U = STAIRS UP       V = VENDOR          W = WARP/ORB"
3750 Print
3760 Print "THE BENEFITS OF HAVING TREASURES ARE :"
3770 Print
3780 Print "RUBY RED - AVOID LETHARGY     PALE PEARL - AVOID LEECH"
3790 Print "GREEN GEM - AVOID FORGETTING  OPAL EYE - CURES BLINDNESS"
3800 Print "BLUE FLAME - DISSOLVES BOOKS  NORN STONE - NO BENEFIT"
3810 Print "PALANTIR - NO BENEFIT         SILMARIL - NO BENEFIT"
3820 Print
3830 Print "PRESS RETURN WHEN READY TO RESUME, "; R$(RC); ".";
3840 Line Input ""; O$
3850 GoTo 2920
3860 Print
3870 Print "** SILLY "; R$(RC); ", THAT WASN'T A VALID COMMAND!"
3880 GoTo 2920
3890 If L(FND(Z)) = 2 GoTo 8960
3900 X = X + (O$ = "N") - (O$ = "S")
3910 Y = Y + (O$ = "W") - (O$ = "E")
3920 X = FNB(X)
3930 Y = FNB(Y)
3940 GoTo 5920
3950 If L(FND(Z)) = 3 Then Z = Z - 1: GoTo 5920
3960 Z$ = "UP"
3970 GoTo 4000
3980 Z$ = "DOWN"
3990 If L(FND(Z)) = 4 Then Z = Z + 1: GoTo 5920
4000 Print
4010 Print "** THERE ARE NO STAIRS GOING "; Z$; " FROM HERE!"
4020 GoTo 2920
4030 If BL <> 1 GoTo 4100
4040 Print
4050 Print "** YOU CAN'T SEE ANYTHING, YOU DUMB "; R$(RC); "!"
4060 GoTo 2920
4070 Rem
4080 Rem   DISPLAY MAP OF CURRENT CASTLE LEVEL
4090 Rem
4100 Print
4110 A = X: B = Y
4120 For X = 1 To 8
    4130 For Y = 1 To 8
        4140 Q = L(FND(Z))
        4150 If Q > 99 Then Q = Q - 100 ' LET Q=34 TO HIDE ROOMS
        4160 If X = A And Y = B Then Print "<"; I$(Q); ">  ";: GoTo 4180
        4170 Print " "; I$(Q); "   ";
    4180 Next Y
    4190 Print
    4200 Print
4210 Next X
4220 X = A: Y = B
4230 GoTo 4470
4240 Print ") LEVEL"; Z
4250 GoTo 2920
4260 If FL <> 0 GoTo 4320
4270 Print "** HEY, BRIGHT ONE, YOU'RE OUT OF FLARES!"
4280 GoTo 2920
4290 Rem
4300 Rem   DISeADJACENT ROOM CONTENTS WITH FLARE
4310 Rem
4320 Print
4330 FL = FL - 1
4340 A = X: B = Y
4350 For Q1 = A - 1 To A + 1
    4360 X = FNB(Q1)
    4370 For Q2 = B - 1 To B + 1
        4380 Y = FNB(Q2)
        4390 Q = FNE(L(FND(Z)))
        4400 L(FND(Z)) = Q
        4410 Print " "; I$(Q); "   ";
    4420 Next Q2
    4430 Print
    4440 Print
4450 Next Q1
4460 X = A: Y = B
4470 GoSub 10160
4480 GoTo 2920
4490 Rem
4500 Rem   DISPLAY CONTENTS OF ADJACENT ROOM WITH LAMP
4510 Rem
4520 If LF <> 0 GoTo 4560
4530 Print
4540 Print "** YOU DON'T HAVE A LAMP, "; R$(RC); "!"
4550 GoTo 2920
4560 Print
4570 Print "WHERE DO YOU WANT TO SHINE THE LAMP (N,S,E,W)";
4580 GoSub 9850
4590 A = X: B = Y
4600 X = FNB(X + (O$ = "N") - (O$ = "S"))
4610 Y = FNB(Y + (O$ = "W") - (O$ = "E"))
4620 If A - X + B - Y <> 0 GoTo 4660
4630 Print
4640 Print "** THAT'S NOT A DIRECTION, "; R$(RC); "!"
4650 GoTo 2920
4660 Print
4670 Print "THE LAMP SHINES INTO ("; X; ","; Y; ") LEVEL"; Z; "."
4680 Print
4690 L(FND(Z)) = FNE(L(FND(Z)))
4700 Print "THERE YOU WILL FIND "; C$(L(FND(Z))); "."
4710 X = A: Y = B
4720 GoTo 2920
4730 Rem
4740 Rem   TAKE A DRINK FROM A POOL
4750 Rem
4760 If L(FND(Z)) = 5 GoTo 4800
4770 Print
4780 Print "** IF YOU WANT A DRINK, FIND A POOL!"
4790 GoTo 2920
4800 Q = FNA(8)
4810 Print
4820 Print "YOU TAKE A DRINK AND ";
4830 If Q < 7 Then Print "FEEL ";
4840 On Q GOTO 4850, 4860, 4870, 4880, 4890, 4900, 4910, 4930
4850 ST = FNC(ST + FNA(3)): Print "STRONGER.": GoTo 2920
4860 ST = ST - FNA(3): Print "WEAKER.": On (1 - (ST < 1)) GOTO 2920, 8840
4870 IQ = FNC(IQ + FNA(3)): Print "SMARTER.": GoTo 2920
4880 IQ = IQ - FNA(3): Print "DUMBER.": On (1 - (IQ < 1)) GOTO 2920, 8840
4890 DX = FNC(DX + FNA(3)): Print "NIMBLER.": GoTo 2920
4900 DX = DX - FNA(3): Print "CLUMSIER.": On (1 - (DX < 1)) GOTO 2920, 8840
4910 Q = FNA(4): If Q = RC GoTo 4910
4920 RC = Q: Print "BECOME A "; R$(RC); ".": GoTo 2920
4930 SX = 1 - SX: Print "TURN INTO A ";: If SX = 0 Then Print "FE";
4940 Print "MALE "; R$(RC); "!": GoTo 2920
4950 If L(FND(Z)) <> 6 GoTo 4990
4960 Print
4970 Print "YOU OPEN THE CHEST AND"
4980 GoTo 5250
4990 If L(FND(Z)) <> 12 GoTo 5030
5000 Print
5010 Print "YOU OPEN THE BOOK AND"
5020 GoTo 5060
5030 Print
5040 Print "** THE ONLY THING OPENED WAS YOUR BIG MOUTH!"
5050 GoTo 2920
5060 On FNA(6) GOTO 5070, 5100, 5120, 5140, 5170, 5200
5070 Print "FLASH! OH NO! YOU ARE NOW A BLIND "; R$(RC); "!"
5080 BL = 1
5090 GoTo 5230
5100 Print "IT'S ANOTHER VOLUME OF ZOT'S POETRY! - YECH!!"
5110 GoTo 5230
5120 Print "IT'S AN OLD COPY OF PLAY"; R$(FNA(4)); "!"
5130 GoTo 5230
5140 Print "IT'S A MANUAL OF DEXTERITY!"
5150 DX = 18
5160 GoTo 5230
5170 Print "IT'S A MANUAL OF STRENGTH!"
5180 ST = 18
5190 GoTo 5230
5200 Print "THE BOOK STICKS TO YOUR HANDS -"
5210 Print "NOW YOU ARE UNABLE TO DRAW YOUR WEAPON!"
5220 BF = 1
5230 L(FND(Z)) = 1
5240 GoTo 2920
5250 On FNA(4) GOTO 5260, 5300, 5340, 5300
5260 Print "KABOOM! IT EXPLODES!!"
5270 Q = FNA(6)
5280 GoSub 8740
5290 On (1 - (ST < 1)) GOTO 5230, 8840
5300 Q = FNA(1000)
5310 Print "FIND"; Q; "GOLD PIECES!"
5320 GP = GP + Q
5330 GoTo 5230
5340 Print "GAS!! YOU STAGGER FROM THE ROOM!"
5350 L(FND(Z)) = 1
5360 T = T + 20
5370 O$ = Mid$("NSEW", FNA(4), 1)
5380 GoTo 3900
5390 If L(FND(Z)) = 11 GoTo 5430
5400 Print
5410 Print "** IT'S HARD TO GAZE WITHOUT AN ORB!"
5420 GoTo 2920
5430 Print
5440 Print "YOU SEE ";
5450 On FNA(6) GOTO 5460, 5480, 5500, 5520, 5590, 5630
5460 Print "YOURSELF IN A BLOODY HEAP!"
5470 ST = ST - FNA(2): On (1 - (ST < 1)) GOTO 2920, 8840
5480 Print "YOURSELF DRINKING FROM A POOL AND BECOMING "; C$(12 + FNA(13)); "!"
5490 GoTo 2920
5500 Print C$(12 + FNA(13)); " GAZING BACK AT YOU!"
5510 GoTo 2920
5520 A = X: B = Y: C = Z
5530 X = FNA(8): Y = FNA(8): Z = FNA(8)
5540 Q = FNE(L(FND(Z)))
5550 L(FND(Z)) = Q
5560 Print C$(Q); " AT ("; X; ","; Y; ") LEVEL"; Z; "."
5570 X = A: Y = B: Z = C
5580 GoTo 2920
5590 A = FNA(8): B = FNA(8): C = FNA(8)
5600 If FNA(8) < 4 Then A = O(1): B = O(2): C = O(3)
5610 Print "***THE ORB OF ZOT*** AT ("; A; ","; B; ") LEVEL"; C; "!"
5620 GoTo 2920
5630 Print "A SOAP OPERA RERUN!"
5640 GoTo 2920
5650 If RF <> 0 GoTo 5690
5660 Print
5670 Print "** YOU CAN'T TELEPORT WITHOUT THE RUNESTAFF!"
5680 GoTo 2920
5690 Z$ = "X-COORDINATE"
5700 GoSub 9990
5710 X = Q
5720 Z$ = "Y-COORDINATE"
5730 GoSub 9990
5740 Y = Q
5750 Z$ = "Z-COORDINATE"
5760 GoSub 9990
5770 Z = Q
5780 O$ = "T"
5790 GoTo 5920
5800 Print
5810 Print "DO YOU REALLY WANT TO QUIT NOW";
5820 GoSub 9850
5830 Print
5840 If O$ = "Y" GoTo 5870
5850 Print "** THEN DON'T SAY THAT YOU DO!"
5860 GoTo 2920
5870 Print
5880 GoTo 9080
5890 Rem
5900 Rem   DISPLAY STATUS INFORMATION
5910 Rem
5920 Print
5930 If BL = 0 Then GoSub 10160: Print
5940 Print "STRENGTH ="; ST; " INTELLIGENCE ="; IQ; " DEXTERITY ="; DX
5950 Print "TREASURES ="; TC; " FLARES ="; FL; " GOLD PIECES ="; GP
5960 Print "WEAPON = "; W$(WV + 1); "  ARMOR = "; W$(AV + 5);
5970 If LF = 1 Then Print "  AND A LAMP";
5980 Print
5990 WC = 0
6000 Q = FNE(L(FND(Z)))
6010 L(FND(Z)) = Q
6020 Z$ = "YOU NOW HAVE"
6030 Print
6040 Print "HERE YOU FIND "; C$(Q); "."
6050 If (Q < 7) Or (Q = 11) Or (Q = 12) GoTo 2920
6060 If Q = 7 Then GP = GP + FNA(10): Print Z$; GP; ".": GoTo 5230
6070 If Q = 8 Then FL = FL + FNA(5): Print Z$; FL; ".": GoTo 5230
6080 If Q > 9 GoTo 6110
6090 If (O(1) = X) And (O(2) = Y) And (O(3) = Z) Then On (1 - (O$ = "T")) GOTO 3900, 9370
6100 X = FNA(8): Y = FNA(8): Z = FNA(8): GoTo 5920
6110 If Q = 10 Then Z = FNB(Z + 1): GoTo 5920
6120 If Q <= 25 Or Q >= 34 GoTo 6180
6130 Print
6140 Print "IT'S NOW YOURS!"
6150 T(Q - 25) = 1
6160 TC = TC + 1
6170 GoTo 5230
6180 A = L(FND(Z)) - 12
6190 WC = 0
6200 If (A < 13) Or (VF = 1) GoTo 7390
6210 Print
6220 Print "YOU MAY TRADE WITH, ATTACK, OR IGNORE THE VENDOR."
6230 GoSub 9830
6240 If O$ = "I" GoTo 2920
6250 If O$ <> "A" GoTo 6300
6260 VF = 1
6270 Print
6280 Print "YOU'LL BE SORRY THAT YOU DID THAT!"
6290 GoTo 7390
6300 If O$ = "T" GoTo 6340
6310 Print
6320 Print "** NICE SHOT, "; R$(RC); "!"
6330 GoTo 6210
6340 For Q = 1 To 8
    6350 A = FNA(Q * 1500)
    6360 If T(Q) = 0 GoTo 6420
    6370 Print
    6380 Print "DO YOU WANT TO SELL "; C$(Q + 25); " FOR"; A; "GP'S";
    6390 GoSub 9850
    6400 If O$ = "Y" Then TC = TC - 1: T(Q) = 0: GP = GP + A: GoTo 6420
    6410 If O$ <> "N" Then Print Y$: GoTo 6370
6420 Next Q
6430 If GP >= 1000 GoTo 6470
6440 Print
6450 Print "YOU'RE TOO POOR TO TRADE, "; R$(RC); "."
6460 GoTo 2920
6470 If GP < 1250 GoTo 6970
6480 Print
6490 Print "OK, "; R$(RC); ", YOU HAVE"; GP; "GP'S AND "; W$(AV + 5); " ARMOR."
6500 Print
6510 Z$ = "ARMOR"
6520 GoSub 10130
6530 Print "NOTHING<0> LEATHER<1250> ";
6540 If GP > 1499 Then Print "CHAINMAIL<1500> ";
6550 If GP > 1999 Then Print "PLATE<2000>";
6560 Print
6570 GoSub 9830
6580 Print
6590 If O$ = "N" GoTo 6720
6600 If O$ = "L" Then GP = GP - 1250: AV = 1: AH = 7: GoTo 6720
6610 If O$ <> "C" Or GP >= 1500 GoTo 6640
6620 Print "** YOU HAVEN'T GOT THAT MUCH CASH ON HAND!"
6630 GoTo 6500
6640 If O$ = "C" Then GP = GP - 1500: AV = 2: AH = 14: GoTo 6720
6650 If O$ <> "P" Or GP >= 2000 GoTo 6680
6660 Print "** YOU CAN'T AFFORD PLATE ARMOR!"
6670 GoTo 6500
6680 If O$ = "P" Then GP = GP - 2000: AV = 3: AH = 21: GoTo 6720
6690 Print
6700 Print "** DON'T BE SILLY. CHOOSE A SELECTION."
6710 GoTo 6560
6720 If GP < 1250 GoTo 6970
6730 Print
6740 Print "YOU HAVE"; GP; "GP'S LEFT WITH "; W$(WV + 1); " IN HAND."
6750 Print
6760 Z$ = "WEAPON"
6770 GoSub 10130
6780 Print "NOTHING<0> DAGGER<1250> ";
6790 If GP > 1499 Then Print "MACE<1500> ";
6800 If GP > 1999 Then Print "SWORD<2000>";
6810 Print
6820 GoSub 9830
6830 Print
6840 If O$ = "N" GoTo 6970
6850 If O$ = "D" Then GP = GP - 1250: WV = 1: GoTo 6970
6860 If O$ <> "M" Or GP >= 1500 GoTo 6890
6870 Print "** SORRY SIR, I'M AFRAID I DON'T GIVE CREDIT!"
6880 GoTo 6750
6890 If O$ = "M" Then GP = GP - 1500: WV = 2: GoTo 6970
6900 If O$ <> "S" Or GP >= 2000 GoTo 6940
6910 Print "** YOUR DUNGEON EXPRESS CARD - ";
6920 Print "YOU LEFT HOME WITHOUT IT!"
6930 GoTo 6750
6940 If O$ = "S" Then GP = GP - 2000: WV = 3: GoTo 6970
6950 Print "** TRY CHOOSING A SELECTION!"
6960 GoTo 6810
6970 If GP < 1000 GoTo 2920
6980 Z$ = "STRENGTH"
6990 GoSub 10070
7000 If O$ <> "Y" GoTo 7060
7010 GP = GP - 1000
7020 ST = FNC(ST + FNA(6))
7030 Q = ST
7040 GoSub 10100
7050 GoTo 6970
7060 If O$ <> "N" Then Print Y$: GoTo 6980
7070 If GP < 1000 GoTo 2920
7080 Z$ = "INTELLIGENCE"
7090 GoSub 10070
7100 If O$ <> "Y" GoTo 7160
7110 GP = GP - 1000
7120 IQ = FNC(IQ + FNA(6))
7130 Q = IQ
7140 GoSub 10100
7150 GoTo 7070
7160 If O$ <> "N" Then Print Y$: GoTo 7080
7170 If GP < 1000 GoTo 2920
7180 Z$ = "DEXTERITY"
7190 GoSub 10070
7200 If O$ <> "Y" GoTo 7260
7210 GP = GP - 1000
7220 DX = FNC(DX + FNA(6))
7230 Q = DX
7240 GoSub 10100
7250 GoTo 7170
7260 If O$ <> "N" Then Print Y$: GoTo 7180
7270 If (GP < 1000) Or (LF = 1) GoTo 2920
7280 Print
7290 Print "DO YOU WANT TO BUY A LAMP FOR 1000 GP'S";
7300 GoSub 9850
7310 If O$ <> "Y" GoTo 7370
7320 GP = GP - 1000
7330 LF = 1
7340 Print
7350 Print "IT'S GUARANTEED TO OUTLIVE YOU!"
7360 GoTo 2920
7370 If O$ <> "N" Then Print Y$: GoTo 7280
7380 GoTo 2920
7390 Q1 = 1 + Int(A / 2): Q2 = A + 2: Q3 = 1
7400 If (C(1, 4) > T(1)) Or (BL = 1) Or (DX < FNA(9) + FNA(9)) GoTo 8420
7410 Print
7420 Print "YOU'RE FACING "; C$(A + 12); "!"
7430 Print
7440 Print "YOU MAY ATTACK OR RETREAT."
7450 If Q3 = 1 Then Print "YOU CAN ALSO ATTEMPT A BRIBE."
7460 If IQ > 14 Then Print "YOU CAN ALSO CAST A SPELL."
7470 Print
7480 Print "YOUR STRENGTH IS"; ST; "AND YOUR DEXTERITY IS"; DX; "."
7490 GoSub 9830
7500 If O$ <> "A" GoTo 7910
7510 If WV <> 0 GoTo 7550
7520 Print
7530 Print "** POUNDING ON "; C$(A + 12); " WON'T HURT IT!"
7540 GoTo 8420
7550 If BF <> 1 GoTo 7590
7560 Print
7570 Print "** YOU CAN'T BEAT IT TO DEATH WITH A BOOK!"
7580 GoTo 8420
7590 If DX >= FNA(20) + (3 * BL) GoTo 7630
7600 Print
7610 Print "YOU MISSED, TOO BAD!"
7620 GoTo 8420
7630 Z$ = Right$(C$(A + 12), Len(C$(A + 12)) - 2)
7640 If Left$(Z$, 1) = " " Then Z$ = Mid$(Z$, 2)
7650 Print
7660 Print "YOU HIT THE EVIL "; Z$; "!"
7670 Q2 = Q2 - WV
7680 If (A <> 9 And A <> 12) GoTo 7730
7690 If FNA(8) <> 1 GoTo 7730
7700 Print
7710 Print "OH NO! YOUR "; W$(WV + 1); " BROKE!"
7720 WV = 0
7730 If Q2 > 0 GoTo 8420
7740 Print
7750 MC = MC - 1
7760 Print C$(A + 12); " LIES DEAD AT YOUR FEET!"
7770 If H > T - 60 GoTo 7810
7780 Print
7790 Print "YOU SPEND AN HOUR EATING "; C$(A + 12); E$(FNA(8)); "."
7800 H = T
7810 If X <> R(1) Or Y <> R(2) Or Z <> R(3) Then On (1 - (A = 13)) GOTO 7860, 9630
7820 Print
7830 Print "GREAT ZOT! YOU'VE FOUND THE RUNESTAFF!"; Chr$(7)
7840 R(1) = 0
7850 RF = 1
7860 Q = FNA(1000)
7870 Print
7880 Print "YOU NOW GET HIS HOARD OF"; Q; "GP'S"
7890 GP = GP + Q
7900 GoTo 5230
7910 If O$ = "R" GoTo 8420
7920 If O$ <> "C" GoTo 8210
7930 If IQ >= 15 Or Q3 <= 1 GoTo 7970
7940 Print
7950 Print "** YOU CAN'T CAST A SPELL NOW!"
7960 GoTo 7410
7970 Print
7980 Print "WHICH SPELL (WEB, FIREBALL, DEATHSPELL)";
7990 GoSub 9850
8000 Print
8010 If O$ <> "W" GoTo 8050
8020 ST = ST - 1
8030 WC = FNA(8) + 1
8040 On (1 - (ST < 1)) GOTO 8420, 8840
8050 If O$ <> "F" GoTo 8140
8060 Q = FNA(7) + FNA(7)
8070 ST = ST - 1
8080 IQ = IQ - 1
8090 If (IQ < 1) Or (ST < 1) GoTo 8840
8100 Print "IT DOES"; Q; "POINTS WORTH OF DAMAGE."
8110 Print
8120 Q2 = Q2 - Q
8130 GoTo 7730
8140 If O$ = "D" GoTo 8180
8150 Print
8160 Print "** TRY ONE OF THE OPTIONS GIVEN."
8170 GoTo 7410
8180 Print "DEATH . . . ";
8190 If IQ < FNA(4) + 15 Then Print "YOURS!": IQ = 0: GoTo 8840
8200 Print "HIS!": Q2 = 0: GoTo 7740
8210 If O$ = "B" And Q3 <= 1 GoTo 8250
8220 Print
8230 Print "** CHOOSE ONE OF THE OPTIONS LISTED."
8240 GoTo 7410
8250 If TC <> 0 GoTo 8290
8260 Print
8270 Print "ALL I WANT IS YOUR LIFE!"
8280 GoTo 8420
8290 Q = FNA(8)
8300 If T(Q) = 0 GoTo 8290
8310 Print
8320 Print "I WANT "; C$(Q + 25); ". WILL YOU GIVE IT TO ME";
8330 GoSub 9850
8340 If O$ = "N" GoTo 8420
8350 If O$ <> "Y" Then Print Y$: GoTo 8310
8360 T(Q) = 0
8370 TC = TC - 1
8380 Print
8390 Print "OK, JUST DON'T TELL ANYONE ELSE."
8400 VF = VF + (L(FND(Z)) = 25)
8410 GoTo 2920
8420 Q3 = 2
8430 If WC <= 0 GoTo 8460
8440 WC = WC - 1
8450 If WC = 0 Then Print: Print "THE WEB JUST BROKE!"
8460 Z$ = Right$(C$(A + 12), Len(C$(A + 12)) - 2)
8470 If Left$(Z$, 1) = " " Then Z$ = Mid$(Z$, 2)
8480 If WC <= 0 GoTo 8520
8490 Print
8500 Print "THE "; Z$; " IS STUCK AND CAN'T ATTACK NOW!"
8510 GoTo 8630
8520 Print
8530 Print "THE "; Z$; " ATTACKS!"
8540 If DX < FNA(7) + FNA(7) + FNA(7) + 3 * BL GoTo 8580
8550 Print
8560 Print "WHAT LUCK, HE MISSED YOU!"
8570 GoTo 8630
8580 Print
8590 Print "OUCH! HE HIT YOU!"
8600 Q = Q1
8610 GoSub 8740
8620 If ST < 1 GoTo 8840
8630 If O$ <> "R" GoTo 7410
8640 Print
8650 Print "YOU HAVE ESCAPED!"
8660 Print
8670 Print "DO YOU WANT TO GO NORTH, SOUTH, EAST, OR WEST";
8680 GoSub 9850
8690 If O$ = "N" Or O$ = "S" Or O$ = "E" Or O$ = "W" GoTo 3900
8700 Print
8710 Print "** DON'T PRESS YOUR LUCK, "; R$(RC); "!"
8720 Print
8730 GoTo 8670
8740 If AV = 0 GoTo 8820
8750 Q = Q - AV
8760 AH = AH - AV
8770 If Q < 0 Then AH = AH - Q: Q = 0
8780 If AH >= 0 GoTo 8820
8790 AH = 0: AV = 0
8800 Print
8810 Print "YOUR ARMOR HAS BEEN DESTROYED . . . GOOD LUCK!"
8820 ST = ST - Q
8830 Return
8840 Print Chr$(7)
8850 GoSub 9770
8860 Print "A NOBLE EFFORT, OH FORMERLY LIVING "; R$(RC); "!"
8870 Print
8880 Print "YOU DIED DUE TO LACK OF ";
8890 If ST < 1 Then Print "STRENGTH."
8900 If IQ < 1 Then Print "INTELLIGENCE."
8910 If DX < 1 Then Print "DEXTERITY."
8920 Print
8930 Q3 = 1
8940 Print "AT THE TIME YOU DIED, YOU HAD :"
8950 GoTo 9130
8960 Q3 = 0
8970 Print
8980 Print "YOU LEFT THE CASTLE WITH";
8990 If OF = 0 Then Print "OUT";
9000 Print " THE ORB OF ZOT."
9010 Print
9020 If OF = 0 GoTo 9080
9030 Print
9040 Print "AN INCREDIBLY GLORIOUS VICTORY!!"
9050 Print
9060 Print "IN ADDITION, YOU GOT OUT WITH THE FOLLOWING :"
9070 GoTo 9120
9080 Print
9090 Print "A LESS THAN AWE-INSPIRING DEFEAT."
9100 Print
9110 Print "WHEN YOU LEFT THE CASTLE, YOU HAD :"
9120 If Q3 = 0 Then Print "YOUR MISERABLE LIFE!"
9130 For Q = 1 To 8
    9140 If T(Q) = 1 Then Print C$(Q + 25)
9150 Next Q
9160 Print W$(WV + 1); " AND "; W$(AV + 5);
9170 If LF = 1 Then Print " AND A LAMP";
9180 Print
9190 Print "YOU ALSO HAD"; FL; "FLARES AND"; GP; "GOLD PIECES"
9200 If RF = 1 Then Print "AND THE RUNESTAFF"
9210 Print
9220 Print "AND IT TOOK YOU"; T; "TURNS!"
9230 Print
9240 Print "ARE YOU FOOLISH ENOUGH TO WANT TO PLAY AGAIN";
9250 GoSub 9850
9260 Print
9270 If O$ <> "Y" Then GoTo 9330
9280 Print "SOME "; R$(RC); "S NEVER LEARN!"
9290 Print
9300 Print "PLEASE BE PATIENT WHILE THE CASTLE IS RESTOCKED."
9310 Print
9320 GoTo 1240
9330 If O$ <> "N" Then Print Y$: GoTo 9240
9340 Print "MAYBE DUMB "; R$(RC); " IS NOT SO DUMB AFTER ALL!"
9350 Print
9360 GoTo 10180
9370 Print
9380 Print "GREAT UNMITIGATED ZOT!"
9390 Print
9400 Print "YOU JUST FOUND ***THE ORB OF ZOT***!"
9410 Print
9420 Print "THE RUNESTAFF HAS DISAPPEARED!"
9430 RF = 0
9440 OF = 1
9450 O(1) = 0
9460 GoTo 5230
9470 Data AN EMPTY ROOM,.,THE ENTRANCE,E,STAIRS GOING UP,U
9480 Data STAIRS GOING DOWN,D,A POOL,P,A CHEST,C,GOLD PIECES,G
9490 Data FLARES,F,A WARP,W,A SINKHOLE,S,A CRYSTAL ORB,O
9500 Data A BOOK,B,A KOBOLD,M,AN ORC,M,A WOLF,M,A GOBLIN,M,AN OGRE,M
9510 Data A TROLL,M,A BEAR,M,A MINOTAUR,M,A GARGOYLE,M,A CHIMERA,M
9520 Data A BALROG,M,A DRAGON,M,A VENDOR,V,THE RUBY RED,T
9530 Data THE NORN STONE,T,THE PALE PEARL,T,THE OPAL EYE,T
9540 Data THE GREEN GEM,T,THE BLUE FLAME,T,THE PALANTIR,T,THE SILMARIL,T
9550 Data X,"?",NO WEAPON," SANDWICH"
9560 Data DAGGER," STEW",MACE," SOUP",SWORD," BURGER",NO ARMOR," ROAST"
9570 Data LEATHER," FILET",CHAINMAIL," TACO",PLATE," PIE"
9580 Data HOBBIT,ELF,MAN,DWARF
9590 X = FNA(8): Y = FNA(8)
9600 If L(FND(Z)) <> 101 GoTo 9590
9610 L(FND(Z)) = Q
9620 Return
9630 Print
9640 Print "YOU GET ALL HIS WARES :"
9650 Print "PLATE ARMOR"
9660 AV = 3: AH = 21
9670 Print "A SWORD"
9680 WV = 3
9690 Print "A STRENGTH POTION"
9700 ST = FNC(ST + FNA(6))
9710 Print "AN INTELLIGENCE POTION"
9720 IQ = FNC(IQ + FNA(6))
9730 Print "A DEXTERITY POTION"
9740 DX = FNC(DX + FNA(6))
9750 If LF = 0 Then Print "A LAMP": LF = 1
9760 GoTo 7860
9770 For Q = 1 To 64
    9780 Print "*";
9790 Next Q
9800 Print
9810 Print
9820 Return
9830 Print
9840 Print "YOUR CHOICE";
9850 Input O$
9860 O$ = Left$(O$, 1)
9870 Return
9880 Print "HOW MANY POINTS DO YOU WISH TO ADD TO YOUR "; Z$;
9890 Input O$
9900 Print
9910 Q = Val(O$)
9920 If Q = 0 And Asc(O$) <> 48 Then Q = -1
9930 If Q < 0 Or Q > OT Or Q <> Int(Q) Then Print "** ";: GoTo 9880
9940 OT = OT - Q
9950 Return
9960 Input O$
9970 Q = Int(Val(O$))
9980 Return
9990 Print
10000 Print Z$;
10010 Input O$
10020 Q = Int(Val(O$))
10030 If Q > 0 And Q < 9 Then Return
10040 Print
10050 Print "** TRY A NUMBER FROM 1 TO 8."
10060 GoTo 9990
10070 Print
10080 Print "DO YOU WANT TO BUY A POTION OF "; Z$; " FOR 1000 GP'S";
10090 GoTo 9850
10100 Print
10110 Print "YOUR "; Z$; " IS NOW"; Q; "."
10120 Return
10130 Print
10140 Print "THESE ARE THE TYPES OF "; Z$; " YOU CAN BUY :"
10150 Return
10160 Print "YOU ARE AT ("; X; ","; Y; ") LEVEL"; Z; "."
10170 Return
10180 End ' IF SAMP$="YES" THEN CHAIN "SAMPLES",1000 ELSE  END

Rem DEF FNA(Q)=1+INT(RND(1)*Q)
Function FNA (Q)
    FNA = 1 + Int(Rnd(1) * Q)
End Function

Rem DEF FNB(Q)=Q+8*((Q=9)-(Q=0))
Function FNB (Q)
    FNB = Q + (8 * ((Q = 9) - (Q = 0)))
    'FNB = Q + 8 * ((Q = 9) - (Q = 0))
End Function

Rem DEF FNC(Q)=-Q*(Q<19)-18*(Q>18)
Function FNC (Q)
    FNC = ((0 - Q) * (Q < 19)) - (18 * (Q > 18))
    'FNC = -Q * (Q < 19) - 18 * (Q > 18)
End Function

Rem DEF FND(Q)=64*(Q-1)+8*(X-1)+Y
Function FND (Q)
    FND = (64 * (Q - 1)) + (8 * (X - 1)) + Y
    'FND = 64 * (Q - 1) + 8 * (X - 1) + Y
End Function

Rem DEF FNE(Q)=Q+100*(Q>99)
Function FNE (Q)
    FNE = Q + (100 * (Q > 99))
End Function



Attached Files
.bas   ORIGWIZ_v4.BAS (Size: 27.58 KB / Downloads: 102)
Print this item

  Distributing programs programmed in QB64?
Posted by: James D Jarvis - 07-07-2022, 03:38 AM - Forum: General Discussion - Replies (17)

So what are the licensing requirements to distribute a program written with QB64?   

I've been approached by a twitch streamer to rerelease a program I wrote 27 years ago and distributed on AOL of all places, apparently obscure retro-games are all the rage. I originally wrote it for 6800 Macs in C/C++ so the code would a total rewrite but not all that difficult. I confirmed I could do it again in a relatively short time for windows with QB64 but I was unclear what the licensing requirements/restrictions were for distribution. 

Any advice would be appreciated.

Print this item

  FireFox Browser view
Posted by: bplus - 07-06-2022, 06:07 PM - Forum: General Discussion - No Replies

Hey I can see who's here and Board Stats again!

And Steve is alive! (Did you @SMcNeill have the operation?)

Update: Oh! There is a little button on far right that switches it on and off, thank goodness Windows destroyed my other computer, I'd never had known.

Print this item

  Phoenix edition hangs at creation of EXE
Posted by: arnoldhf - 07-06-2022, 12:53 PM - Forum: Programs - Replies (7)

[Image: Capture.png]

I have about 50-60 QB4.5 programs. I converted a few programs using QB64 I downloaded circa 2017 without a problem.

I just downloaded the Phoenix edition but it is hanging (both the x86 and x64) when creating the EXE. 

I even tested it out on:   PRINT "HELLO". 

I am running Win 10. Any suggestions on how to fix this?

Print this item

  New SICK project
Posted by: eoredson - 07-06-2022, 12:44 AM - Forum: Utilities - Replies (12)

Attached is the S.I.C.K. project..

This file is:

The Symbolic Instruction Code Kit, which contains a QB64 program named SIC64.BAS
and several smaller utility programs. The source code is public domain and can be
found on several sites, including, filegate.net and keepandshare.com

This program uses a recursive descent parser to interpret a psuedo-basic language
written in a line oriented fashion and can be used for small programming chores.

The archive also contains some further imbedded .zip files which contain several
QB64 sample programs, and some .SIC programs which are used by the SIC engine.

Thank you,
  Erik Jon Oredson

You may contact me at my email:
  eoredson@gmail.com

Now Sick64f2.zip for QB64

Also SIC87F.ZIP for VBdos.



Attached Files
.zip   SIC87F.ZIP (Size: 844.46 KB / Downloads: 11)
.zip   SICK64F2.ZIP (Size: 479.04 KB / Downloads: 7)
Print this item

  All BASIC Game Jam
Posted by: dbox - 07-05-2022, 07:38 PM - Forum: General Discussion - Replies (32)

Anyone else planning to participate in the Jam for All BASIC Dialects?  I'm planning to give it a shot.  Should be fun and potentially good publicity for QB64.

Print this item