'===========================================================================
' Subject: FADES, FONTS & FUN                 Date: 05-18-96 (00:00)       
'  Author: John Rodgers                       Code: QB, QBasic, PDS        
'  Origin: www.flinet.com/~coolfool         Packet: DEMOS.ABC
'===========================================================================
                               'EIGHTBAL.BAS
                            'Wizard Productions
                               'John Rodgers
                               'Too Cool Fool
                            'coolfool@flinet.com

        'Eightball is a take off on the Plastic 8 ball you asked questions,
         'turned upside down and a different answer floated to the triangle
         'on the bottom.

'Magic Eightball was an attempt to add a little dimension to the old plastic 
'toy and then to incorporate some of the neat code I have picked up on the 
'FIDO Quick Basic Sub. The fade and font routines and the getKey$ function
'were posted in the FIDO sub and I extracted the code and deleted the mail 
'so I don't know who wrote what. Sorry guys but great code. Thanks! 
'This program and the source code are released to the Public Domain. 
'Code is released as is and is not guaranteed for any purpose. 
'If I get enough response I will update this with greater depth of 
'answers and better graphics.

'Thanks to Rick and Ruth, Dale and all the gang at AFAN for thier help.

                            'FADES FONTS AND FUN
DEFINT A-Z
DECLARE SUB am ()
DECLARE SUB who ()
DECLARE SUB was ()
DECLARE SUB what ()
DECLARE SUB would ()
DECLARE SUB should ()
DECLARE SUB could ()
DECLARE SUB how ()
DECLARE SUB when ()
DECLARE SUB will ()
DECLARE SUB where ()
DECLARE SUB why ()
DECLARE SUB did ()
DECLARE SUB isQ ()
DECLARE SUB ifQ ()
DECLARE SUB have ()
DECLARE SUB were ()
DECLARE SUB can ()
DECLARE SUB does ()
DECLARE SUB tellTime ()
            'the subs above this line cover the questions
DECLARE SUB yes ()                     'yes answers
DECLARE SUB no ()                      'no answers
DECLARE SUB amb ()                     'ambiguous answers
DECLARE SUB tri ()
DECLARE SUB delay (a!)
DECLARE SUB ballFade ()
DECLARE SUB getAns ()
DECLARE SUB getQuestKey ()
DECLARE SUB parseAnswer ()
DECLARE SUB displayAns ()
DECLARE SUB getName ()
DECLARE SUB getQuerry ()
DECLARE SUB eye (xp%, yp%)
DECLARE SUB delay (a!)
DECLARE SUB title ()
DECLARE SUB drawBall ()
DECLARE SUB triangle ()
DECLARE SUB getTime ()


             'Great SUBs & FUNCTIONs I got from the FIDO QuickBasic sub [TCF]
DECLARE SUB deFont ()
DECLARE SUB fadeinit ()
DECLARE SUB fadin (d%)
DECLARE SUB fade (d%)
DECLARE SUB font ()
DECLARE FUNCTION getKey$ (row%, col%, prompt$, default$, maxx!, minn!, blanker$, limit$)

                        'you need to DIM colourPalette for fade to work
DIM SHARED ColourPalette(1 TO 1024) AS INTEGER

COMMON SHARED kpres%, k$, f$, name$, querry$
COMMON SHARED prTime$, answer$, fir$, sec$
                     
                      'a$(letter) is the array that holds the font
DIM SHARED a$(122)
deFont                'define font

k$ = INKEY$
                                    'Alfred Hitchcock theme song
PLAY "MB"                            'background
PLAY "O2 L12 D N0 >D l32 E L12 DC+<B>C+ N0 DE< N0"
  
kpres% = 0
SCREEN 9
COLOR 7, 0
 
 
RANDOMIZE TIMER
PLAY "AD N0 >D l32 E l12 D C+<B>C+ N0 DE N0"

CLS

title

PLAY "<AD> N0 FA..GF N0 A >C..< A+A N0 >CEDC+<A+GFE"

drawBall
    
PLAY "<D> N0 D l32 E l12 DC+<B>C+ N0 DE< N0"

eye 110, 56

PLAY "AD N0 >D L32 E L12 DC+<B>C+ N0 DE N0.. F N0 A >C< A+AGF"
PLAY "D+GA+DC+DE N0 F L9 E. L12 D"
     DRAW "c14;s4 bm15,79"           'set cursor for font
     f$ = "Wizard Productions"             'c = color, s = size
     font                                   'bm15,79 = positions
 
    




 
fadeinit                      'I sorta know how this works
fade 100                       ' but I plugged it in and it does
CLS
delay 2
 
getName

fade 100
CLS
ballFade

DO                                 'main loop

getQuerry
fade 100
CLS
 
getAns
ballFade
tri
 
displayAns
fadin 100
delay 3
fade 100

CLS
tri

                           ' play again?
  
     
     f$ = name$ + ", need more answers?"
     DRAW "c13;s7 bm" + STR$(300 - ((LEN(f$) / 2) * 14)) + ",40"
     
     font
    
DO
LOOP WHILE LEN(INKEY$)

     again$ = getKey$(14, 35, "Y/n  :  ", "Y", 2, 1, " ", "yYnN")

IF UCASE$(again$) = "Y" OR UCASE$(again$) = "YY" THEN
CLS
ballFade
END IF

LOOP UNTIL UCASE$(again$) = "N" OR UCASE$(again$) = "YN" OR UCASE$(again$) = "NN"
CLS
PLAY "D+GA+DC+DE N0 F L9 E. L12 D"
ballFade
eye 300, 20
      f$ = "Wizard Productions"
      DRAW "c15;s12 bm" + STR$(100 - ((LEN(f$) / 2) * 6)) + ",45"
      font
     
      f$ = "Thanks for playing "
      DRAW "c14;s10 bm" + STR$(160 - ((LEN(f$) / 2) * 6)) + ",110"
      font
     
      f$ = name$
      DRAW "c13;s10 bm" + STR$(300 - ((LEN(f$) / 2) * 20)) + ",170"
      font
fadin 100
delay 2
fade 100
SCREEN 0                                  'reset old machines
COLOR 7, 0


SYSTEM

SUB am
RANDOMIZE TIMER
qNum% = INT(RND * 3) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
END SELECT
END SUB

SUB amb
RANDOMIZE TIMER
ansNum% = INT(RND * 8) + 1
SELECT CASE ansNum%
CASE 1
answer$ = name$ + ", the answer is dark."
CASE 2
answer$ = "It is you! " + name$ + ", that covet my icecream bar."
CASE 3
answer$ = "It is possible " + name$ + ", that no one cares."
CASE 4
answer$ = "Do not ask " + name$ + " it is not good."
CASE 5
answer$ = name$ + " your questions weary me."
CASE 6
answer$ = name$ + " " + name$ + " " + name$
CASE 7
answer$ = " The tree grows on the side of the mountain."
CASE 8
answer$ = "Seek that answer in the stars."


END SELECT

END SUB

SUB ballFade
drawBall
fadin 100
delay 1
fade 100
CLS

END SUB

SUB can
RANDOMIZE TIMER
qNum% = INT(RND * 3) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
END SELECT

END SUB

SUB could
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = "Coulda Woulda Shoulda "
CASE 5
answer$ = "It is not for " + name$ + " to know."
CASE 6
answer$ = "Could be."
CASE 7
answer$ = "No " + name$ + ", it couldn't."

END SELECT

END SUB

DEFSNG A-Z
SUB deFont                  'define font
                    'font is from FIDO QuickBasic sub
     a$(32) = "BR8"
     a$(33) = "BR2G2RED8BD2D2HR2HBU2U3LU3R2D3U5FBU2BR2"
     a$(34) = "BRBUGDRND2RULBR3DRND2RULUBR3"
     a$(35) = "BR7G2D6LDU6L2GR3D3L3GR3ND2R4UNL2D3EU5NL3UL2NUR3UD"
     a$(35) = a$(35) + "5R2EL3U3R3EL3U2EBR5"
     a$(36) = "BR5DND15G4D4RNU4E3R3D6LNU6DLDL3HL2NDE2GR2DR2U10RF"
     a$(36) = a$(36) + "URUNL3EBUBR3"
     a$(37) = "BR4LG3DED2ED2EDE3LEL2EL2EBR6G2RDLD2HD3HD3HD3HD2UB"
     a$(37) = a$(37) + "R6REL3EL2ELE3DED2ED3EUBU7BR2"
     a$(38) = "BR6RF2NG3L2UL2G2RGDEDRND3G2NR3G3RGDERGDERGD2EURE3"
     a$(38) = a$(38) + "H2R2D2F5REUGLNH4UH4E2R2D2RENL5BU8BR3"
     a$(39) = "BRD4UHR2UL2BUBR5"
     a$(40) = "BR6G4REG3REG3R2UG2ND5RD7RU4D5RU3FDBU16BR3"
     a$(41) = "BD17E4LGE3LGE3LGUE2DHENU3LNU5HNU5UHU3GDBU2BR7"
     a$(42) = "BR3D3ND3NL3NR3NG2NH2NF2E2BUBR3"
     a$(43) = "BR5BD4D4ND4NL4LND5NU3DL4R8UL3R4BU8BR3"
     a$(44) = "BRBD13D3GE2UL2RBU14BR5"
     a$(45) = "BD9NR6ER6BU8BR3"
     a$(46) = "BD15R2GU2BU14BR5"
     a$(47) = "BD16E2LELE2DHE2DHE2DHE2DHE2DHE2BR3"
     a$(48) = "BR4G3D8UHU4E4NR2DNR3FNR3FR2GR2D4LU4D6G3UNE3L2H2ED"
     a$(48) = a$(48) + "RDRBU12BR8"
     a$(49) = "BD2E2ND13GR2UD13H2R4GE2BU11BR3"
     a$(50) = "BD4E4L2D3HUR2ER2DRND5FD3NG3LNG7LG5D3GUENR6FNR4FR2"
     a$(50) = a$(50) + "E2HREBU10BR3"
     a$(51) = "BR3G3NF2RE2RNG3DRF2DHD2HD4H2ED2R2D4ENU2G4H3LE2D2E"
     a$(51) = a$(51) + "D2ED2EBU13BR6"
     a$(52) = "BR6D14FU14LG6DR8FL8R6D3FDEBU13BR3"
     a$(53) = "BR9G3L4U2R5GL4D6E3RG2RERGR2FND3L3FRD3G3LHNR3HNR5H"
     a$(53) = a$(53) + "LR4H2GRBU10BR10"
     a$(54) = "BR5F2RGH2LF2DH2LG2D9HNU6UE5D2EUD3EUND5FD3G5U3LU3B"
     a$(54) = a$(54) + "U11BR9"
     a$(55) = "BD3E2R7GNL7G2RG2RG2ERG3ERG2ERG2D2FU3ED4E2LBU13BR6"
     a$(56) = "BDBR6L3G3R2DL2FRED3HR3HD2R3HD3HR3ND3GD3G2NH4L2UR2"
     a$(56) = a$(56) + "NH4L3ULULUE8L2DEUL2UBR6"
     a$(57) = "BUBR4G4D3FNU4EUD3RU2FE4ND5GD6G2NL5G2HRU2L2EBU7BR4"
     a$(57) = a$(57) + "R2UH2LF2LNH2LHU2BR7"
     a$(58) = "BD7R2GU2BD6D2HR2BU13BR4"
     a$(59) = "BD7R2HD2BD4D3GE2UL2BU13BR6"
     a$(61) = "BD6R6EL6BD3R6GNL6BU9BR5"
     a$(63) = "BR3G3ER4HLD2R3DL2FRG4DBD2D2HR2BU13BR6"
     a$(65) = "BD6U3NE2RE3NR3DR4G3L2DEUR3EG2DGDG2NH3NR7DNR7G2NR3"
     a$(65) = a$(65) + "DNR4DFBR3HR2E3D3FNE2U14GND9E2BR3"
     a$(66) = "BD3UEDRUR3EG3D4L2GDER2D5LG2NDE2REU9FED8EU8EDER3GR"
     a$(66) = a$(66) + "2D2HD2G2HUND9D2R3ND5FD4LG2L5GE3R3DL3BU13BR8"
     a$(67) = "BDBR4G3RG2ND4RD6FNU4RNU2ED2NR4UR6NE2NUL3U12G3D6EU"
     a$(67) = a$(67) + "6ER5GLU2LUBR6"
     a$(68) = "BDBR2NR7FR8GR2GRD2NL2D3NL2D3GNL6GL6GE3U10G3D7G2E3"
     a$(68) = a$(68) + "U2L3GE2R2U4E2R2D5RGD2RGDBU11BR7"
     a$(69) = "BR4G3ND8RG2D4RED4RNU2FNU2NR4ER5NE2NUL3U12G3D6EU6E"
     a$(69) = a$(69) + "NR7ER2D2R3G4R4UNL3BU5BR3"
     a$(70) = "BD6E2DR3UL2EU2D14L2GR2ERURUHU11R7NUL2UL3ED13GU8R3"
     a$(70) = a$(70) + "EL4U4BUBR8"
     a$(71) = "BD6D4FDU8E3D9G2U2D3NR7ERD2R4HU12L2ND8R5HD2R2GR2G4"
     a$(71) = a$(71) + "R4HLD2R2ND3LD3G2BU13BR6"
     a$(72) = "BD3UNR5ER5EG4D9GRENU9FRNU11EU11E2NRG2D4RE3D2END9R"
     a$(72) = a$(72) + "D7G2LEBU13BR5"
     a$(73) = "BD3URUR2D12L2GDR2UEU11EBR3G2D12L2DRE2U12EBR3"
     a$(74) = "BD5BRRUL2U2E2R3DL4R6DL3R5LG3D9GL3G2ER3DRUR3U2RU10"
     a$(74) = a$(74) + "ED9BL3DU9E2RERBUBR3"
     a$(75) = "BD3E2R3NEGL2FD8G2LGE5DU8BR2NE2D8G3R4HLD2FURE3D2FU"
     a$(75) = a$(75) + "2FRDH4LF2EH2E3LEL3GE2RBU3BR6"
     a$(76) = "BD2E2R4EG2NL4D11L2G2ERENU9RNE3R2F2RNE3HRNE2UE2LHB"
     a$(76) = a$(76) + "L3NU7FU7EBU3BR7"
     a$(77) = "BR6LG4D11LUREU5L2UR2U4ERD11NG2U5R6D5EG3H2R3GNU12H"
     a$(77) = a$(77) + "U6LNR5RU5LHR2DR6H2GRGND5R2DR2D12NEHU11E2BUBR3"
     a$(78) = "BD3E2D2R3H2D14L3NDER2EU10RED11NG2U4E3R4GDGDGDGDR4"
     a$(78) = a$(78) + "EG2L2U2RHEUEUEU3L3FRU2L3G3E4RL5E2RGR2BUBR7"
     a$(79) = "BR9L4G5ND6RD8R8LGL4U2LUE2NU8LU7ER6FL3HGD10UE3R3DG"
     a$(79) = a$(79) + "3REU5FUL3NG2RE2DHULBU3BR6"
     a$(80) = "BUBD3E3D2LR2HD2LR2ND14GND13DG3R2GRDFGLNG2DR2D4R3U"
     a$(80) = a$(80) + "3NU13R4GU2L3R5EL2E2DNU7HU2L2G3FRLHE3REUL3NGR"
     a$(80) = a$(80) + "2EU2GU2GL2E2NDBR8"
     a$(81) = "BR8L3G5ND6RD8R10GR2EGHL3GL4UHUF2R2NU13R2E4G2DEU9L"
     a$(81) = a$(81) + "3HR3D2LFNG3DERD4L3G3UBL3NU8EU8EBR11"
     a$(82) = "BD14E5U8EG2L2GE2RD10G2E3FG2R5G2HRU2LUENU8ENE4F4DN"
     a$(82) = a$(82) + "E3H2R3H3LNF3UE2U4L4E2D3FR2UL2U2BUBR8"
     a$(83) = "BR11G6H3UE2R3D2REL6GF3NR6L2HG2DED2ED2NR7ENR5RE2L2"
     a$(83) = a$(83) + "R8GR2ND3GD3G3UGU4RNDG5L3HU2R7DH2RL5R2UBU10BR13"
     a$(84) = "BD3E2DE2NR5DR9EG2L5D6G3NU3LU7NE3RG2D3F2E2NU5G2NR2"
     a$(84) = a$(84) + "DR8NE2NULGNL4U12BUBR7"
     a$(85) = "BD3E2R6EG2L6R4G4ND4RNED6FU3FD2FU2FR3NE4GNL2U13G2D"
     a$(85) = a$(85) + "6GU5EBR4E3D13E2L3DU11FRBU3BR4"
     a$(86) = "BD3UE2RG2RD10NLENU11D2F2NE6H2R3GUHRUNE3U3NE3U6H2B"
     a$(86) = a$(86) + "R7NG3D9ENL3U3NL3U3NL2UHBR4"
     a$(87) = "BD3E3D14H2RU9LE2RFD12GU3FRE2U10GE2D14HUF2DU3RD2NE"
     a$(87) = a$(87) + "4U13BR2UED11EU9HBR4"
     a$(88) = "BD3E3D4FU4LGR2D6L3ER3U4D6GDG2ND2L3NDERFRBR4R4EG3R"
     a$(88) = a$(88) + "EL2U2LND2LU5R3GL3D3R2UL2U5EUE2LED3FU3FDE"
     a$(88) = a$(88) + "BU2BR4"
     a$(89) = "R3GRD10NG3LG2D2ED2NR3ER4HR5DGBU3L2BU2RL4U10FRUD9U"
     a$(89) = a$(89) + "E3R3D2G2LEURU4L3NGR4DU3GU2GU2GUL2BR8"
     a$(90) = "BD3UE2D2LR8U2GNL7D2NG5LG3L3R8L2GLDR3L8R4G2RERG3UG"
     a$(90) = a$(90) + "D2GUR8GU2R2L7RER5EBU11BR3"
     a$(97) = "BD6NE3F2G2D2F2U3HD2RFUR3D2EL2NU9EU8NEL3F2DGNLEU3H"
     a$(97) = a$(97) + "BU3BR6"
     a$(98) = "RD12NLFNU13FU2FURENU7RU6L2U2G3U6EBR7"
     a$(99) = "BD6NE3RD5GR5EG2LGU3LRU6E2D2ED2EBU5BR3"
     a$(100) = "BFGDERGR2GR2G4ND4RD5FU3FD3E3NU6LNGU5NE2ULURBU5BR5"
     a$(101) = "BD7RNE3D4GRFNU6F2NE3UEL2ELU2E4L3FU2LBU5BR6"
     a$(102) = "BR3G2D12LR3GU9L2R4L2U4EDED2EBU2BR3"
     a$(103) = "BD17R5EL5E6D5L2EU2L2GLEL2NU5EU4E3D2ED5EU4EBU4BR3"
     a$(104) = "BDFD13E2NL3HU10NE2D6E4GDED9G3ERE2U9BU5BR3"
     a$(105) = "BD6ED9FE2LGU9RHBU2URBUBR4"
     a$(106) = "BD5ED2ED10GE2U8H2BU2URBUBR4"
     a$(107) = "BDFD12HR4G2U13NE2D6E3R2FL3FRG4ER2GR2D4EUL2U3BU10"
     a$(107) = a$(107) + "BR5"
     a$(108) = "BDFD11NL2DFELU13EBR3"
     a$(109) = "BD6UED10HF2ELU9FNRE2D10FU10FNRE2D10RNE2U9FBU6BR3"
     a$(110) = "BD5NE2RED9FE2LGU9FNE2RED2RU2D9FE2LGU8EBU4BR4"
     a$(111) = "BD7NE4ND4RD5F2UHUF2E2NU6LU4H2EDFU2BU4BR4"
     a$(112) = "BD5E2D13LR2NFU5NL2U7FE2D2ED9GH3R5DL3FE2U6BU5BR3"
     a$(113) = "BD6NE3ND6RNE2D7FU2FE2D5NGR2HU9FG2DU5L2EBU4BR6"
     a$(114) = "BD5NE2RED8HF3E2LGU2GU8FE2D2ED3EUBU5BR3"
     a$(115) = "BD13NE8R6GLU2NL3BR3ENU2LU3LD2HL3EL2NU2EU2E2DR4GN"
     a$(115) = a$(115) + "L2E2BU3BR3"
     a$(116) = "BD4NE3RD9HR2D2EDNE2HU10FRBU4BR4"
     a$(117) = "BD5NE2RED8FNU9FU3FDEF2E2L3FU10G2R3G2D5U8BU4BR6"
     a$(118) = "BR3G3RDEUD10NLF2NE4U2RL2ELU7BR4NHD7EU5BU5BR3"
     a$(119) = "BR2G2D2RU3D12HF2EUGU9FE2ND9FD8F2E2RGNHEU9NG3FND8"
     a$(119) = a$(119) + "BU4BR3"
     a$(120) = "BD6E3DGRD2RU2D5G4U3FRE2RD2RD2E3GLHUHUE4D2HLE2BU3BR3"
     a$(121) = "BD5NE2RED10GDFR3EUGBH3RNU10EDE4NU6LU5G2BU6BR6"
     a$(122) = "BD7UE3D2ED2EDG4R4HLD2R3DL2D2EL2DL2GDFR2EBU16BR5"


END SUB

SUB delay (a!)              'real time delay, if a = 1 then delay = 1 second
 dela! = TIMER
 outvar = 0
 
DO
  
  lt& = lt& + 1
  IF lt& >= 65500 THEN outvar = 1          'MIDNIGHT FIX

 IF TIMER - dela! >= a! THEN outvar = 1

 k$ = INKEY$


 IF k$ = CHR$(27) THEN CLS : SYSTEM

IF LEN(k$) THEN outvar = 1


LOOP UNTIL outvar = 1
END SUB

DEFINT A-Z
SUB did
RANDOMIZE TIMER

qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = name$ + ", things do not just happen."
CASE 5
answer$ = "Well, Somethings do just happen " + name$ + "."
CASE 6
answer$ = "If it was possible."
CASE 7
answer$ = "No, you must ask something else " + name$ + "!"



END SELECT

END SUB

SUB displayAns
tri
PLAY "MB"
PLAY "D+GA   "
IF LEN(answer$) <= 25 THEN
triangle
    f$ = answer$
      DRAW "c14;s7 bm" + STR$(300 - ((LEN(f$) / 2) * 14)) + ",40"
     
     font
ELSE
parseAnswer
END IF
 delay 4
END SUB

SUB does
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = "Things do as they must " + name$
CASE 5
answer$ = name$ + ", it does"
CASE 6
answer$ = "Only if you are watching, " + name$
CASE 7
answer$ = "You may believe otherwise, " + name$



END SELECT

END SUB

DEFSNG A-Z
SUB doQ
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = name$ + ", things do not just happen."
CASE 5
answer$ = "Well, Somethings do just happen " + name$ + "."
CASE 6
answer$ = "If it was possible."
CASE 7
answer$ = "Silence is golden, " + name$ + "!"




END SELECT

END SUB

SUB drawBall

a8$ = "ллллллл"
b8$ = "лпмммпл"
c8$ = "лпмммпл"
d8$ = "ллмммлл"
 CIRCLE (315, 157), 57, 15
 PAINT STEP(1, 1), 15, 15
COLOR 15
LOCATE 10, 37
PRINT a8$
LOCATE 11, 37
PRINT b8$
LOCATE 12, 37
PRINT c8$
LOCATE 13, 37
PRINT d8$

 FOR x% = 56 TO 129
CIRCLE (315, 157), x%, 15

NEXT x%

FOR t% = 55 TO 126
CIRCLE (315, 157), t%, 0

NEXT t%
  

 
END SUB

SUB eye (xp%, yp%)                           'logo graphic

CIRCLE (xp%, yp%), 32, 14, , , 2 / 9
PAINT STEP(0, 0), 14
CIRCLE STEP(0, -1), 11, 0
PAINT STEP(0, 0), 0, 0
CIRCLE STEP(3, 2), 1, 12
 END SUB

REM $DYNAMIC
DEFINT A-Z
SUB fade (d%)
  FOR a = 0 TO 63
    ' --- in mode 13, use I=0 to 255
    FOR I = 0 TO 63
      OUT &H3C7, I
      p1 = INP(&H3C9)
      p2 = INP(&H3C9)
      p3 = INP(&H3C9)
      OUT &H3C8, I
      IF p1 - 1 >= 0 THEN OUT &H3C9, p1 - 1 ELSE OUT &H3C9, p1
      IF p2 - 1 >= 0 THEN OUT &H3C9, p2 - 1 ELSE OUT &H3C9, p2
      IF p3 - 1 >= 0 THEN OUT &H3C9, p3 - 1 ELSE OUT &H3C9, p3
      
     FOR delayer = 1 TO d%: NEXT delayer
    NEXT I
  FOR delayer = 1 TO d%: NEXT delayer
  NEXT a
 

END SUB

DEFSNG A-Z
SUB fadeinit
  FOR I = 0 TO 255
    '--- Save all colours although text mode only uses 0-63
    '    If time is important, reduce 255 to 63
    OUT &H3C7, I
    ColourPalette(I * 4 + 1) = I
    ColourPalette(I * 4 + 2) = INP(&H3C9)
    ColourPalette(I * 4 + 3) = INP(&H3C9)
    ColourPalette((I + 1) * 4) = INP(&H3C9)
  NEXT I
END SUB

DEFINT A-Z
SUB fadin (d%)
  FOR a = 0 TO 63
    ' --- in mode 13, use I=0 to 255
    FOR I = 0 TO 63
      OUT &H3C7, I
      p1 = INP(&H3C9)
      p2 = INP(&H3C9)
      p3 = INP(&H3C9)
      OUT &H3C8, I
      IF p1 + 1 <= ColourPalette(I * 4 + 2) THEN OUT &H3C9, p1 + 1 ELSE OUT H3C9, p1
      IF p2 + 1 <= ColourPalette(I * 4 + 3) THEN OUT &H3C9, p2 + 1 ELSE OUT &H3C9, p2
      IF p3 + 1 <= ColourPalette((I + 1) * 4) THEN OUT &H3C9, p3 + 1 ELSE OUT &H3C9, p3
    NEXT I
    FOR delayer = 1 TO d%: NEXT delayer
  NEXT a
END SUB

REM $STATIC
DEFSNG A-Z
SUB font                  'print(DRAW) f$ to screen

FOR x = 1 TO LEN(f$)
 y = ASC(MID$(f$, x, 1))
 DRAW a$(y)

NEXT

END SUB

DEFINT A-Z
SUB getAns
 
 querry$ = UCASE$(querry$)
IF INSTR(querry$, "TIME ") THEN
tellTime
EXIT SUB
END IF

IF INSTR(querry$, "WHO ") OR INSTR(querry$, "WHOM ") THEN
who
EXIT SUB
END IF

IF INSTR(querry$, "WAS ") THEN
was
EXIT SUB
END IF

IF INSTR(querry$, "IF ") THEN
ifQ
EXIT SUB
END IF

IF INSTR(querry$, "WHERE ") THEN
where
EXIT SUB
END IF

IF INSTR(querry$, "AM ") THEN
am
EXIT SUB
END IF


IF INSTR(querry$, "WHAT ") THEN
what
EXIT SUB
END IF

IF INSTR(querry$, "WHY ") THEN
why
EXIT SUB
END IF

IF INSTR(querry$, "WILL ") THEN
will
EXIT SUB
END IF

IF INSTR(querry$, "WERE ") THEN
were
EXIT SUB
END IF

IF INSTR(querry$, "DID ") THEN
did
EXIT SUB
END IF

IF INSTR(querry$, "WHEN ") THEN
when
EXIT SUB
END IF

IF INSTR(querry$, "HOW ") THEN
how
EXIT SUB
END IF


IF INSTR(querry$, "IS") THEN
isQ
EXIT SUB
END IF

IF INSTR(querry$, "CAN ") THEN
can
EXIT SUB
END IF
IF INSTR(querry$, "HAVE ") THEN
have
EXIT SUB
END IF

IF INSTR(querry$, "WOULD ") THEN
would
EXIT SUB
END IF

IF INSTR(querry$, "SHOULD ") THEN
should
EXIT SUB
END IF
IF INSTR(querry$, "COULD ") THEN
could
EXIT SUB
END IF
amb
 
END SUB

DEFSNG A-Z
'                   Get Key Function from FidoNet Quick Basic SUB
FUNCTION getKey$ (row%, col%, prompt$, default$, maxx, minn, blanker$, limit$)
fadin 150
DO
  LOCATE row%, col% + LEN(prompt$): PRINT STRING$(maxx, blanker$);
  LOCATE row%, col%, 1, 10, 11
  PRINT prompt$;
  default$ = LTRIM$(RTRIM$(default$))
  IF default$ = STRING$(LEN(default$), 0) THEN default$ = ""
  IF LEN(default$) <> 0 THEN
    LOCATE row%, col% + LEN(prompt$): PRINT default$;
    queue$ = default$
    LOCATE row%, col% + (LEN(prompt$) + LEN(default$))
  END IF
 
start:
  DO
    tmp$ = INKEY$
  triangle
   
    IF tmp$ <> "" THEN
    IF tmp$ = CHR$(27) THEN CLS : SYSTEM
  IF tmp$ = CHR$(13) THEN
  tmp$ = ""
   
  EXIT DO
     ELSEIF tmp$ = CHR$(8) THEN
    
       tmp$ = ""
      IF LEN(queue$) >= 1 THEN
    LOCATE , POS(0) - 1: PRINT blanker$; : LOCATE , POS(0) - 1
    queue$ = LEFT$(queue$, LEN(queue$) - 1)
      ELSE
    
    SOUND 500, 1
    WHILE INKEY$ <> "": WEND
      END IF
  ELSEIF LEN(tmp$) > 1 THEN
      SOUND 500, 1
      WHILE INKEY$ <> "": WEND
      tmp$ = ""
  ELSEIF ASC(tmp$) < 32 OR ASC(tmp$) > 126 THEN
      SOUND 500, 1
    
      WHILE INKEY$ <> "": WEND
      tmp$ = ""
   ELSEIF LEN(queue$) < maxx THEN
    IF limit$ <> "" THEN
      IF NOT INSTR(limit$, tmp$) <> 0 THEN GOTO start
    END IF
    queue$ = queue$ + tmp$
       PRINT tmp$;
     ELSE
    c% = INT(RND * 10) + 1
    k% = row%
    m% = col%

     COLOR 14
     LOCATE 16, 30
      PRINT "USE BACKSPACE TO CHANGE"
      SOUND 500, 1
      LOCATE k%, m% + LEN(prompt$) + 1 + LEN(queue$) - 1
      WHILE INKEY$ <> "": WEND
      tmp$ = ""
    END IF
    END IF
     
  LOOP


  IF LEN(queue$) >= MinLen% THEN
    EXIT DO
  ELSE
    SOUND 500, 1
  END IF
   
LOOP

getKey$ = queue$

'LOCATE , , 0
END FUNCTION

SUB getName
tri
delay 1
PLAY "MB"
PLAY "D+GA   "

     DRAW "c13;s7 bm180,10"
     f$ = "What is your name?"
     font


DO
LOOP WHILE LEN(INKEY$)
 
name$ = getKey$(7, 26, "NAME: ", " ", 22, 1, "_", " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890")
PLAY "D+GA+DC+DE N0 F L9 E. L12 D"
END SUB

SUB getQuerry
PLAY "MB"
PLAY "D+GA    "
 tri
 f$ = name$ + ", state your querry."
 DRAW "c12;s7 bm" + STR$(300 - ((LEN(f$) / 2) * 14)) + ",30"
 'DRAW "c13;s7 bm" + STR$(300 - ((LEN(f$) / 2) * 14)) + ",40"
     
     font


DO
LOOP WHILE LEN(INKEY$)
DO
querry$ = getKey$(6, 12, " ", " ", 55, 1, "_", " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890?")
LOOP UNTIL querry$ > ""
PLAY "D+GA+DC+DE N0 F L9 E. L12 D"

END SUB

DEFINT A-Z
SUB getTime

           'convert SYSTEM time and date to prTime$ and prDate$
                        'for program use
t$ = TIME$
Hr = VAL(t$)
IF Hr < 12 THEN Ampm$ = " AM" ELSE Ampm$ = " PM"
IF Hr > 12 THEN Hr = Hr - 12
IF Hr = 0 THEN Hr = 12

 prgTime$ = STR$(Hr) + RIGHT$(t$, 6) + Ampm$


 IF Ampm$ = " AM" THEN                      ' convert prgTime$ to 5 characters
   prTime$ = LEFT$(prgTime$, 5) + " AM"        'for AM
 END IF
                                            ' convert prgTime$ to 6 characters
 IF Ampm$ = " AM" AND VAL(LEFT$(prgTime$, 3)) >= 10 THEN
   prTime$ = LEFT$(prgTime$, 6) + " AM"        'for AM after 10
 END IF
 IF Ampm$ = " PM" THEN                       ' convert prgTime$ to 5 characters
prTime$ = LEFT$(prgTime$, 5) + " PM"           'for PM
 END IF
                                             ' convert prgTime$ to 6 characters
 IF Ampm$ = " PM" AND VAL(LEFT$(prgTime$, 3)) >= 10 THEN
prTime$ = LEFT$(prgTime$, 6) + " PM"             'for PM after 10
 END IF

END SUB

SUB have
RANDOMIZE TIMER
qNum% = INT(RND * 5) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = "No they haven't, " + name$
CASE 5
answer$ = "Yes I have"


END SELECT

END SUB

SUB how
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
answer$ = "You know."
CASE 2
answer$ = "If you don't know by now..."
CASE 3
amb
CASE 4
answer$ = "No how " + name$
CASE 5
answer$ = "By hook and by crook."
CASE 6
answer$ = "With outside aid," + name$
CASE 7
answer$ = "Not by any known method."



END SELECT

END SUB

SUB ifQ
RANDOMIZE TIMER
qNum% = INT(RND * 5) + 1
SELECT CASE qNum%
CASE 1
answer$ = "If wishes were horses-..."
CASE 2
answer$ = "If? HA! " + name$
CASE 3
amb
CASE 4
answer$ = "No " + name$ + " not hardly."
CASE 5
answer$ = "Yes " + name$ + "IF."
END SELECT
END SUB

SUB isQ
RANDOMIZE TIMER
qNum% = INT(RND * 5) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = "No it isn't."
CASE 5
answer$ = "Yes it is."


END SELECT

END SUB

SUB no
RANDOMIZE TIMER
ansNum% = INT(RND * 10) + 1
SELECT CASE ansNum%
CASE 1
answer$ = "No"
CASE 2
answer$ = "Not really "
CASE 3
answer$ = "Never."
CASE 4
answer$ = name$ + ", the probabitlity is less than 2%"
CASE 5
answer$ = "Not if you think about it."
CASE 6
answer$ = "Can't be."
CASE 7
answer$ = "That's a negatory Good Buddy."
CASE 8
answer$ = "Impossible " + name$ + "."
CASE 9
answer$ = "The answer is no."
CASE 10
answer$ = name$ + ", the probabitlity is less than 2%"





END SELECT

END SUB

SUB parseAnswer
triangle
FOR x% = 29 TO 21 STEP -1
IF MID$(answer$, x%, 1) = " " THEN
fir$ = LEFT$(answer$, (x% - 1))
sec$ = MID$(answer$, (x% + 1), (LEN(answer$)))
EXIT FOR
ELSE
fir$ = LEFT$(answer$, 24)
sec$ = MID$(answer$, 25, (LEN(answer$)))

END IF
NEXT x%

       f$ = fir$
       DRAW "c13;s7 bm" + STR$(300 - ((LEN(f$) / 2) * 14)) + ",40"
       
     font
      f$ = sec$
       DRAW "c13;s7 bm" + STR$(300 - ((LEN(f$) / 2) * 14)) + ",90"
       
     font

END SUB

SUB should
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = "Shoudda woudda coudda"
CASE 5
answer$ = "Somethings just should."
CASE 6
answer$ = "Shouldn't ask."
CASE 7
answer$ = "Not supposed to," + name$


END SELECT

END SUB

SUB tellTime
RANDOMIZE TIMER

getTime
qNum% = INT(RND * 4) + 1
SELECT CASE qNum%
CASE 1
answer$ = name$ + " it is" + prTime$
CASE 2
answer$ = prTime$ + " is the time."
CASE 3
amb
CASE 4
answer$ = name$ + " you should not be so obsessed with time"
END SELECT

END SUB

SUB test
CLS
eye 300, 20
     f$ = "Wizard Productions"
      DRAW "c13;s12 bm" + STR$(100 - ((LEN(f$) / 2) * 6)) + ",45"
     
     font
   
    
      f$ = "Thanks for playing "
     DRAW "c14;s10 bm" + STR$(160 - ((LEN(f$) / 2) * 6)) + ",100"
      
     font
      f$ = name$
    DRAW "c13;s10 bm" + STR$(220 - ((LEN(f$) / 2) * 6)) + ",160"
      
     font

fadin 100
     
 
END SUB

DEFSNG A-Z
SUB title                'display animated title page
r% = INT(RND * 15) + 1
k$ = INKEY$

IF r% = 8 THEN r% = 15
COLOR r%

LOCATE 1, 1
PRINT
PRINT "                          мллллллм млллллм млллллм оллн млллллм"
PRINT "                          лл лл лл ллмммлл лл  ммм  лл  лл"
PRINT "                          лл лл лл ллппплл лл   лл  лл  лл"
PRINT "                          лл лл лл лл   лл плллллп оллн плллллп"
r% = INT(RND * 15) + 1
IF r% = 8 THEN r% = 15
COLOR r%
delay .3

LOCATE 18, 1
PRINT "млллллл "
PRINT "ллмммм   "
PRINT "ллпппп   "
PRINT "плллллл "
r% = INT(RND * 15) + 1
IF r% = 8 THEN r% = 15
COLOR r%
delay .3

LOCATE 18, 1
PRINT "        оллн  "
PRINT "         лл  "
PRINT "         лл  "
PRINT "        оллн  "
r% = INT(RND * 15) + 1
IF r% = 8 THEN r% = 15
COLOR r%
delay .3

LOCATE 18, 1
PRINT "             млллллм  "
PRINT "             лл  ммм "
PRINT "             лл   лл  "
PRINT "             плллллп  "
r% = INT(RND * 15) + 1
IF r% = 8 THEN r% = 15
COLOR r%

 delay .3
LOCATE 18, 1
PRINT "                     лл   лл  "
PRINT "                     ллмммлл    "
PRINT "                     ллппплл    "
PRINT "                     лл   лл    "
r% = INT(RND * 15) + 1
IF r% = 8 THEN r% = 15
COLOR r%
delay .3

LOCATE 18, 1
PRINT "                             ллллллл  "
PRINT "                               олн    "
PRINT "                               олн   "
PRINT "                               олн    "
r% = INT(RND * 15) + 1
IF r% = 8 THEN r% = 15
COLOR r%
delay .3

LOCATE 18, 1
PRINT "                                     ллллллм млллллм лл      лл"
PRINT "                                     ллмммлп ллмммлл лл      лл"
PRINT "                                     ллппплл ллппплл лл      лл"
PRINT "                                     ллллллп лл   лл ллллллл ллллллл"
r% = INT(RND * 15) + 1
IF r% = 8 THEN r% = 15
COLOR r%
 delay .3
LOCATE 18, 1
PRINT "млллллл оллн млллллм лл   лл ллллллл ллллллм млллллм лл      лл"
PRINT "ллмммм   лл  лл  ммм ллмммлл   олн   ллмммлп ллмммлл лл      лл"
PRINT "ллпппп   лл  лл   лл ллппплл   олн   ллппплл ллппплл лл      лл"
PRINT "плллллл оллн плллллп лл   лл   олн   ллллллп лл   лл ллллллл ллллллл"

delay .3


END SUB

DEFINT A-Z
SUB tri
  DO
   t = t + 1
   c% = INT(RND * 15)
     LINE (x1pos%, y1pos%)-(x2pos%, y2pos%), c%
     LINE (x2pos%, y2pos%)-(x3pos%, y3pos%), c%
     LINE (x3pos%, y3pos%)-(x1pos%, y1pos%), c%
  x1pos% = x1pos% + 1
  y1pos% = y1pos% - 1
  x2pos% = x2pos% - 1
  y2pos% = y2pos% - 1
  y3pos% = y3pos% + 1

  LOOP UNTIL t >= 12
t = 0
LINE (2, 2)-(638, 2), 15
LINE (638, 2)-(319, 348), 15
LINE (319, 348)-(2, 2), 15

END SUB

DEFSNG A-Z
SUB triangle     'triangle draws an animated triangle and plays prompt music
STATIC v%, b%
v% = v% + 1           'STATIC variables keep events from happening everytime
b% = b% + 1            ' triangle is called

                      'play every 31000th time
IF b% >= 31000 THEN
 b% = 0
END IF
  x1pos% = 2
  y1pos% = 2
  x2pos% = 638
  y2pos% = 2
  x3pos% = 319
  y3pos% = 348
  RANDOMIZE TIMER
   
                             'draw triangle every 5250th time
IF v% = 1 OR v% >= 5250 THEN
 
  DO
   t = t + 1
   c% = INT(RND * 15)
     LINE (x1pos%, y1pos%)-(x2pos%, y2pos%), c%
     LINE (x2pos%, y2pos%)-(x3pos%, y3pos%), c%
     LINE (x3pos%, y3pos%)-(x1pos%, y1pos%), c%
  x1pos% = x1pos% + 1
  y1pos% = y1pos% - 1
  x2pos% = x2pos% - 1
  y2pos% = y2pos% - 1
  y3pos% = y3pos% + 1

  LOOP UNTIL t >= 12
t = 0
LINE (2, 2)-(638, 2), 15
LINE (638, 2)-(319, 348), 15
LINE (319, 348)-(2, 2), 15
IF v% = 1 THEN v% = 2
IF v% >= 5250 THEN v% = 0
END IF
END SUB

DEFINT A-Z
SUB was
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = "Time is a fickle thing."
CASE 5
answer$ = "Not in the real sense."
CASE 6
answer$ = "No, " + name$ + " it wasn't."
CASE 7
answer$ = name$ + ", the probabitlity is less than 18%"


END SELECT

END SUB

SUB were
RANDOMIZE TIMER
qNum% = INT(RND * 6) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
answer$ = "Yes, " + name$ + " there were"
CASE 3
amb
CASE 4
answer$ = "There were kittens."
CASE 5
answer$ = "Not then, " + name$
CASE 6
answer$ = "If there were, would you care?"



END SELECT

END SUB

SUB what
RANDOMIZE TIMER
qNum% = INT(RND * 6) + 1
SELECT CASE qNum%
CASE 1
answer$ = "What do I care, " + name$
CASE 2
answer$ = name$ + ", seek your answer elsewhere"
CASE 3
amb
CASE 4
answer$ = "What do you think?"
CASE 5
answer$ = "No one knows what."
CASE 6
answer$ = "Whatever."



END SELECT

END SUB

SUB when
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
answer$ = name$ + ", someday."
CASE 2
answer$ = "Some other time " + name$
CASE 3
amb
CASE 4
answer$ = "You should not be obsessed with time."
CASE 5
answer$ = "Time is fleeting, " + name$
CASE 6
answer$ = "When you give up."
CASE 7
answer$ = "Whenever " + name$

END SELECT

END SUB

SUB where
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
answer$ = "Did you look in your hand?"
CASE 2
answer$ = "Where you last left it."
CASE 3
amb
CASE 5
answer$ = "Over there."
CASE 6
answer$ = "On the cusp."
CASE 7
answer$ = name$ + " look within."



END SELECT

END SUB

SUB who
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
answer$ = "The one you think " + name$ + "."
CASE 2
answer$ = name$ + " it is the one you least suspect."
CASE 3
amb
CASE 4
answer$ = "One close to " + name$ + "."
CASE 5
answer$ = "A mere ghost."
CASE 6
answer$ = "Think about it " + name$ + "."
CASE 7
answer$ = "Silence is best " + name$ + "."



END SELECT

END SUB

SUB why
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
answer$ = name$ + "! Why not!"
CASE 2
answer$ = name$ + "because"
CASE 3
amb
CASE 4
answer$ = "Why not, " + name$ + "?"
CASE 5
answer$ = "Well."
CASE 6
answer$ = "Think about it " + name$ + "."
CASE 7
answer$ = "Because " + name$ + "."

END SELECT

END SUB

SUB will
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = "Never " + name$ + "."
CASE 5
answer$ = "Soon."
CASE 6
answer$ = "Not for you, " + name$ + "."
CASE 7
answer$ = "Silence is best " + name$ + "."

END SELECT

END SUB

SUB would
RANDOMIZE TIMER
qNum% = INT(RND * 7) + 1
SELECT CASE qNum%
CASE 1
yes
CASE 2
no
CASE 3
amb
CASE 4
answer$ = "woulda shoulda coulda"
CASE 5
answer$ = "If it could."
CASE 6
answer$ = "Maybe, " + name$ + "."
CASE 7
answer$ = "Would you, " + name$ + "?"

END SELECT

END SUB

SUB yes
RANDOMIZE TIMER
ansNum% = INT(RND * 5) + 1
SELECT CASE ansNum%
CASE 1
answer$ = "Possibly"
CASE 2
answer$ = "Yes, " + name$
CASE 3
answer$ = "Maybe."
CASE 4
answer$ = "Well of course."
CASE 5
answer$ = "It is a happening, " + name$

END SELECT

END SUB